paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-26 05:11:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

* changed address parameter/return values to pointer instead

Browse Source 
of longint
This commit is contained in:
peter 2003-03-17 14:30:11 +00:00
parent 7fd4b571ce
commit 1e86b585f9
8 changed files with 93 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rtl/i386/i386.inc
View File

@ -942,14 +942,14 @@ function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LE
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
movl %ebp,%eax
end ['EAX'];
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
movl framebp,%eax
orl %eax,%eax
@ -960,7 +960,7 @@ end ['EAX'];
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
movl framebp,%eax
orl %eax,%eax
@ -1174,7 +1174,11 @@ end;
{
$Log$
Revision 1.39 2003-02-18 17:56:06 jonas
Revision 1.40 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.39 2003/02/18 17:56:06 jonas
- removed buggy i386-specific FPC_CHARARRAY_TO_SHORTSTR
* fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug 2382)
* fixed some potential range errors in indexchar/word/dword

10
rtl/inc/compproc.inc
View File

@ -265,12 +265,12 @@ procedure fpc_InitializeUnits; compilerproc;
{
Procedure fpc_do_exit; compilerproc;
Procedure fpc_lib_exit; compilerproc;
Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : longint); compilerproc;
Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
Procedure fpc_HandleError (Errno : longint); compilerproc;
}
procedure fpc_AbstractErrorIntern;compilerproc;
procedure fpc_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); compilerproc;
procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); compilerproc;
Procedure fpc_reset_typed(var f : TypedFile;Size : Longint); compilerproc;
Procedure fpc_rewrite_typed(var f : TypedFile;Size : Longint); compilerproc;
@ -286,7 +286,11 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
{
$Log$
Revision 1.35 2003-01-11 00:17:29 florian
Revision 1.36 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.35 2003/01/11 00:17:29 florian
* uncommented the variant<->dyn. array stuff
Revision 1.34 2003/01/09 20:14:20 florian

25
rtl/inc/heaptrc.pp
View File

@ -118,7 +118,7 @@ type
release_sig : longword;
prev_valid : pheap_mem_info;
{$endif EXTRA}
calls : array [1..tracesize] of longint;
calls : array [1..tracesize] of pointer;
exact_info_size : word;
extra_info_size : word;
extra_info : pheap_extra_info;
@ -235,7 +235,7 @@ var
begin
writeln(ptext,'Call trace for block 0x',hexstr(longint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
for i:=1 to tracesize do
if pp^.calls[i]<>0 then
if pp^.calls[i]<>nil then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
{ the check is done to be sure that the procvar is not overwritten }
if assigned(pp^.extra_info) and
@ -251,11 +251,11 @@ var
begin
writeln(ptext,'Call trace for block at 0x',hexstr(longint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
for i:=1 to tracesize div 2 do
if pp^.calls[i]<>0 then
if pp^.calls[i]<>nil then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
writeln(ptext,' was released at ');
for i:=(tracesize div 2)+1 to tracesize do
if pp^.calls[i]<>0 then
if pp^.calls[i]<>nil then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
{ the check is done to be sure that the procvar is not overwritten }
if assigned(pp^.extra_info) and
@ -343,9 +343,10 @@ end;
Function TraceGetMem(size:longint):pointer;
var
allocsize,i,bp : longint;
allocsize,i : longint;
bp : pointer;
pl : pdword;
p : pointer;
p : pointer;
pp : pheap_mem_info;
begin
inc(getmem_size,size);
@ -426,7 +427,8 @@ end;
function TraceFreeMemSize(p:pointer;size:longint):longint;
var
i,bp, ppsize : longint;
i,ppsize : longint;
bp : pointer;
pp : pheap_mem_info;
{$ifdef EXTRA}
pp2 : pheap_mem_info;
@ -582,7 +584,8 @@ var
newP: pointer;
oldsize,
allocsize,
i,bp : longint;
i : longint;
bp : pointer;
pl : pdword;
pp : pheap_mem_info;
oldextrasize,
@ -1149,7 +1152,11 @@ finalization
end.
{
$Log$
Revision 1.22 2002-12-26 10:46:54 peter
Revision 1.23 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.22 2002/12/26 10:46:54 peter
* set p to nil when 0 is passed to reallocmem
Revision 1.21 2002/11/30 23:34:43 carl

10
rtl/inc/lineinfo.pp
View File

@ -739,7 +739,7 @@ begin
end;
function StabBackTraceStr(addr:longint):shortstring;
function StabBackTraceStr(addr:Pointer):shortstring;
var
func,
source : string;
@ -752,7 +752,7 @@ begin
BackTraceStrFunc:=@SysBackTraceStr;
GetLineInfo(dword(addr),func,source,line);
{ create string }
StabBackTraceStr:=' 0x'+HexStr(addr,8);
StabBackTraceStr:=' 0x'+HexStr(Longint(addr),8);
if func<>'' then
StabBackTraceStr:=StabBackTraceStr+' '+func;
if source<>'' then
@ -781,7 +781,11 @@ finalization
end.
{
$Log$
Revision 1.15 2003-02-07 20:55:06 marco
Revision 1.16 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.15 2003/02/07 20:55:06 marco
* fix from oco
Revision 1.14 2003/02/01 22:31:34 marco

39
rtl/inc/system.inc
View File

@ -27,7 +27,7 @@
{$i textrec.inc}
Procedure HandleError (Errno : Longint); forward;
Procedure HandleErrorFrame (Errno : longint;frame : longint); forward;
Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
type
FileFunc = Procedure(var t : TextRec);
@ -42,7 +42,7 @@ const
Seed3 : Cardinal = 0;
{ For Error Handling.}
ErrorBase : Longint = 0;
ErrorBase : Pointer = nil;
{ Used by the ansistrings and maybe also other things in the future }
var
@ -558,7 +558,7 @@ Begin
Begin
Writeln(stdout,'Runtime error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
{ to get a nice symify }
Writeln(stdout,BackTraceStrFunc(Longint(Erroraddr)));
Writeln(stdout,BackTraceStrFunc(Erroraddr));
dump_stack(stdout,ErrorBase);
Writeln(stdout,'');
End;
@ -585,24 +585,24 @@ Begin
end;
function SysBackTraceStr (Addr: longint): ShortString;
function SysBackTraceStr (Addr: Pointer): ShortString;
begin
SysBackTraceStr:=' 0x'+HexStr(addr,8);
SysBackTraceStr:=' 0x'+HexStr(Longint(addr),8);
end;
Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : longint);[public,alias:'FPC_BREAK_ERROR'];
Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer);[public,alias:'FPC_BREAK_ERROR'];
begin
If pointer(ErrorProc)<>Nil then
ErrorProc(Errno,pointer(addr),pointer(frame));
ErrorProc(Errno,addr,frame);
errorcode:=word(Errno);
exitcode:=word(Errno);
erroraddr:=pointer(addr);
erroraddr:=addr;
errorbase:=frame;
halt(errorcode);
end;
Procedure HandleErrorFrame (Errno : longint;frame : longint);
Procedure HandleErrorFrame (Errno : longint;frame : Pointer);
{
Procedure to handle internal errors, i.e. not user-invoked errors
Internal function should ALWAYS call HandleError instead of RunError.
@ -627,7 +627,7 @@ procedure runerror(w : word);[alias: 'FPC_RUNERROR'];
begin
errorcode:=w;
exitcode:=w;
erroraddr:=pointer(get_caller_addr(get_frame));
erroraddr:=get_caller_addr(get_frame);
errorbase:=get_caller_frame(get_frame);
halt(errorcode);
end;
@ -647,11 +647,12 @@ End;
function do_isdevice(handle:longint):boolean;forward;
Procedure dump_stack(var f : text;bp : Longint);
Procedure dump_stack(var f : text;bp : Pointer);
var
i, prevbp : Longint;
i : Longint;
prevbp : Pointer;
is_dev : boolean;
caller_addr : longint;
caller_addr : Pointer;
Begin
prevbp:=bp-1;
i:=0;
@ -659,7 +660,7 @@ Begin
while bp > prevbp Do
Begin
caller_addr := get_caller_addr(bp);
if caller_addr <> 0 then
if caller_addr <> nil then
Writeln(f,BackTraceStrFunc(caller_addr));
Inc(i);
If ((i>max_frame_dump) and is_dev) or (i>256) Then
@ -723,7 +724,7 @@ end;
procedure fpc_AbstractErrorIntern; compilerproc; external name 'FPC_ABSTRACTERROR';
{$endif hascompilerproc}
Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); [SaveRegisters,Public,Alias : 'FPC_ASSERT']; {$ifdef hascompilerproc} compilerproc; {$endif}
Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); [SaveRegisters,Public,Alias : 'FPC_ASSERT']; {$ifdef hascompilerproc} compilerproc; {$endif}
begin
if pointer(AssertErrorProc)<>nil then
AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
@ -732,7 +733,7 @@ begin
end;
Procedure SysAssert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint);
Procedure SysAssert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer);
begin
If msg='' then
write(stderr,'Assertion failed')
@ -765,7 +766,11 @@ end;
{
$Log$
Revision 1.39 2003-02-05 21:48:34 mazen
Revision 1.40 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.39 2003/02/05 21:48:34 mazen
* fixing run time errors related to unimplemented abstract methods in CG
+ giving empty emplementations for some RTL functions

22
rtl/inc/systemh.inc
View File

@ -584,9 +584,9 @@ Procedure getdir(drivenr:byte;Var dir:ansistring);
*****************************************************************************}
{ os independent calls to allow backtraces }
function get_frame:longint;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_addr(framebp:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_frame(framebp:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Sptr:Longint;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -598,7 +598,7 @@ Function Sptr:Longint;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Paramcount:Longint;
Function ParamStr(l:Longint):string;
Procedure Dump_Stack(var f : text;bp:Longint);
Procedure Dump_Stack(var f : text;bp:pointer);
Procedure RunError(w:Word);
Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
Procedure halt(errnum:byte);
@ -615,15 +615,15 @@ Procedure SysResetFPU;
*****************************************************************************}
procedure AbstractError;
Function SysBackTraceStr(Addr: Longint): ShortString;
Procedure SysAssert(Const Msg,FName:ShortString;LineNo,ErrorAddr:Longint);
Function SysBackTraceStr(Addr:Pointer): ShortString;
Procedure SysAssert(Const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
{ Error handlers }
Type
TBackTraceStrFunc = Function (Addr: Longint): ShortString;
TBackTraceStrFunc = Function (Addr: Pointer): ShortString;
TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
TAbstractErrorProc = Procedure;
TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno,erroraddr:longint);
TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
@ -665,7 +665,11 @@ const
{
$Log$
Revision 1.63 2003-01-13 14:37:11 florian
Revision 1.64 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.63 2003/01/13 14:37:11 florian
* cpu defines fixed
* ... = type ...; stuff reactived, should work now with 1.1

12
rtl/powerpc/powerpc.inc
View File

@ -852,7 +852,7 @@ function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LE
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:longint;assembler;
function get_frame:pointer;assembler;
asm
{ all abi's I know use r1 as stack pointer }
mr r3, r1
@ -860,7 +860,7 @@ end ['R3'];
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:longint):longint;assembler;
function get_caller_addr(framebp:pointer):pointer;assembler;
asm
{$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!!
@ -868,7 +868,7 @@ end ['R3'];
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:longint):longint;assembler;
function get_caller_frame(framebp:pointer):pointer;assembler;
asm
{$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!!
@ -948,7 +948,11 @@ end ['R3','R10'];
{
$Log$
Revision 1.30 2003-03-12 19:21:29 jonas
Revision 1.31 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.30 2003/03/12 19:21:29 jonas
+ implemented get_frame()
* fixed bug in IndexDWord()

12
rtl/sparc/sparc.inc
View File

@ -1,17 +1,17 @@
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:longint;{assembler;}
function get_frame:pointer;{assembler;}
begin{asm}
{$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!!
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:longint):longint;{assembler;}
function get_caller_addr(framebp:pointer):pointer;{assembler;}
begin{asm}
{$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!!
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:longint):longint;{assembler;}
function get_caller_frame(framebp:pointer):pointer;{assembler;}
begin{asm}
{$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!!
@ -31,7 +31,11 @@ begin{asm}
end;
{
$Log$
Revision 1.2 2003-02-05 21:48:34 mazen
Revision 1.3 2003-03-17 14:30:11 peter
* changed address parameter/return values to pointer instead
of longint
Revision 1.2 2003/02/05 21:48:34 mazen
* fixing run time errors related to unimplemented abstract methods in CG
+ giving empty emplementations for some RTL functions