paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-31 13:31:40 +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} {$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 asm
movl %ebp,%eax movl %ebp,%eax
end ['EAX']; end ['EAX'];
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} {$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 asm
movl framebp,%eax movl framebp,%eax
orl %eax,%eax orl %eax,%eax
@ -960,7 +960,7 @@ end ['EAX'];
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} {$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 asm
movl framebp,%eax movl framebp,%eax
orl %eax,%eax orl %eax,%eax
@ -1174,7 +1174,11 @@ end;
{ {
$Log$ $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 - removed buggy i386-specific FPC_CHARARRAY_TO_SHORTSTR
* fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug 2382) * fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug 2382)
* fixed some potential range errors in indexchar/word/dword * 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_do_exit; compilerproc;
Procedure fpc_lib_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_HandleError (Errno : longint); compilerproc;
} }
procedure fpc_AbstractErrorIntern;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_reset_typed(var f : TypedFile;Size : Longint); compilerproc;
Procedure fpc_rewrite_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$ $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 * uncommented the variant<->dyn. array stuff
Revision 1.34 2003/01/09 20:14:20 florian Revision 1.34 2003/01/09 20:14:20 florian

23
rtl/inc/heaptrc.pp
View File

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

10
rtl/inc/lineinfo.pp
View File

@ -739,7 +739,7 @@ begin
end; end;
function StabBackTraceStr(addr:longint):shortstring; function StabBackTraceStr(addr:Pointer):shortstring;
var var
func, func,
source : string; source : string;
@ -752,7 +752,7 @@ begin
BackTraceStrFunc:=@SysBackTraceStr; BackTraceStrFunc:=@SysBackTraceStr;
GetLineInfo(dword(addr),func,source,line); GetLineInfo(dword(addr),func,source,line);
{ create string } { create string }
StabBackTraceStr:=' 0x'+HexStr(addr,8); StabBackTraceStr:=' 0x'+HexStr(Longint(addr),8);
if func<>'' then if func<>'' then
StabBackTraceStr:=StabBackTraceStr+' '+func; StabBackTraceStr:=StabBackTraceStr+' '+func;
if source<>'' then if source<>'' then
@ -781,7 +781,11 @@ finalization
end. end.
{ {
$Log$ $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 * fix from oco
Revision 1.14 2003/02/01 22:31:34 marco Revision 1.14 2003/02/01 22:31:34 marco

39
rtl/inc/system.inc
View File

@ -27,7 +27,7 @@
{$i textrec.inc} {$i textrec.inc}
Procedure HandleError (Errno : Longint); forward; Procedure HandleError (Errno : Longint); forward;
Procedure HandleErrorFrame (Errno : longint;frame : longint); forward; Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
type type
FileFunc = Procedure(var t : TextRec); FileFunc = Procedure(var t : TextRec);
@ -42,7 +42,7 @@ const
Seed3 : Cardinal = 0; Seed3 : Cardinal = 0;
{ For Error Handling.} { For Error Handling.}
ErrorBase : Longint = 0; ErrorBase : Pointer = nil;
{ Used by the ansistrings and maybe also other things in the future } { Used by the ansistrings and maybe also other things in the future }
var var
@ -558,7 +558,7 @@ Begin
Begin Begin
Writeln(stdout,'Runtime error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8)); Writeln(stdout,'Runtime error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
{ to get a nice symify } { to get a nice symify }
Writeln(stdout,BackTraceStrFunc(Longint(Erroraddr))); Writeln(stdout,BackTraceStrFunc(Erroraddr));
dump_stack(stdout,ErrorBase); dump_stack(stdout,ErrorBase);
Writeln(stdout,''); Writeln(stdout,'');
End; End;
@ -585,24 +585,24 @@ Begin
end; end;
function SysBackTraceStr (Addr: longint): ShortString; function SysBackTraceStr (Addr: Pointer): ShortString;
begin begin
SysBackTraceStr:=' 0x'+HexStr(addr,8); SysBackTraceStr:=' 0x'+HexStr(Longint(addr),8);
end; 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 begin
If pointer(ErrorProc)<>Nil then If pointer(ErrorProc)<>Nil then
ErrorProc(Errno,pointer(addr),pointer(frame)); ErrorProc(Errno,addr,frame);
errorcode:=word(Errno); errorcode:=word(Errno);
exitcode:=word(Errno); exitcode:=word(Errno);
erroraddr:=pointer(addr); erroraddr:=addr;
errorbase:=frame; errorbase:=frame;
halt(errorcode); halt(errorcode);
end; end;
Procedure HandleErrorFrame (Errno : longint;frame : longint); Procedure HandleErrorFrame (Errno : longint;frame : Pointer);
{ {
Procedure to handle internal errors, i.e. not user-invoked errors Procedure to handle internal errors, i.e. not user-invoked errors
Internal function should ALWAYS call HandleError instead of RunError. Internal function should ALWAYS call HandleError instead of RunError.
@ -627,7 +627,7 @@ procedure runerror(w : word);[alias: 'FPC_RUNERROR'];
begin begin
errorcode:=w; errorcode:=w;
exitcode:=w; exitcode:=w;
erroraddr:=pointer(get_caller_addr(get_frame)); erroraddr:=get_caller_addr(get_frame);
errorbase:=get_caller_frame(get_frame); errorbase:=get_caller_frame(get_frame);
halt(errorcode); halt(errorcode);
end; end;
@ -647,11 +647,12 @@ End;
function do_isdevice(handle:longint):boolean;forward; function do_isdevice(handle:longint):boolean;forward;
Procedure dump_stack(var f : text;bp : Longint); Procedure dump_stack(var f : text;bp : Pointer);
var var
i, prevbp : Longint; i : Longint;
prevbp : Pointer;
is_dev : boolean; is_dev : boolean;
caller_addr : longint; caller_addr : Pointer;
Begin Begin
prevbp:=bp-1; prevbp:=bp-1;
i:=0; i:=0;
@ -659,7 +660,7 @@ Begin
while bp > prevbp Do while bp > prevbp Do
Begin Begin
caller_addr := get_caller_addr(bp); caller_addr := get_caller_addr(bp);
if caller_addr <> 0 then if caller_addr <> nil then
Writeln(f,BackTraceStrFunc(caller_addr)); Writeln(f,BackTraceStrFunc(caller_addr));
Inc(i); Inc(i);
If ((i>max_frame_dump) and is_dev) or (i>256) Then 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'; procedure fpc_AbstractErrorIntern; compilerproc; external name 'FPC_ABSTRACTERROR';
{$endif hascompilerproc} {$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 begin
if pointer(AssertErrorProc)<>nil then if pointer(AssertErrorProc)<>nil then
AssertErrorProc(Msg,FName,LineNo,ErrorAddr) AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
@ -732,7 +733,7 @@ begin
end; end;
Procedure SysAssert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); Procedure SysAssert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer);
begin begin
If msg='' then If msg='' then
write(stderr,'Assertion failed') write(stderr,'Assertion failed')
@ -765,7 +766,11 @@ end;
{ {
$Log$ $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 * fixing run time errors related to unimplemented abstract methods in CG
+ giving empty emplementations for some RTL functions + 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 } { os independent calls to allow backtraces }
function get_frame:longint;{$ifdef SYSTEMINLINE}inline;{$endif} function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_addr(framebp:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif} function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
function get_caller_frame(framebp:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif} function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif} Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Sptr:Longint;{$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 Paramcount:Longint;
Function ParamStr(l:Longint):string; 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(w:Word);
Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif} Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
Procedure halt(errnum:byte); Procedure halt(errnum:byte);
@ -615,15 +615,15 @@ Procedure SysResetFPU;
*****************************************************************************} *****************************************************************************}
procedure AbstractError; procedure AbstractError;
Function SysBackTraceStr(Addr: Longint): ShortString; Function SysBackTraceStr(Addr:Pointer): ShortString;
Procedure SysAssert(Const Msg,FName:ShortString;LineNo,ErrorAddr:Longint); Procedure SysAssert(Const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
{ Error handlers } { Error handlers }
Type Type
TBackTraceStrFunc = Function (Addr: Longint): ShortString; TBackTraceStrFunc = Function (Addr: Pointer): ShortString;
TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer); TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
TAbstractErrorProc = Procedure; 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$ $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 * cpu defines fixed
* ... = type ...; stuff reactived, should work now with 1.1 * ... = 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} {$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:longint;assembler; function get_frame:pointer;assembler;
asm asm
{ all abi's I know use r1 as stack pointer } { all abi's I know use r1 as stack pointer }
mr r3, r1 mr r3, r1
@ -860,7 +860,7 @@ end ['R3'];
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:longint):longint;assembler; function get_caller_addr(framebp:pointer):pointer;assembler;
asm asm
{$warning FIX ME!} {$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!! // !!!!!!! depends on ABI !!!!!!!!
@ -868,7 +868,7 @@ end ['R3'];
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:longint):longint;assembler; function get_caller_frame(framebp:pointer):pointer;assembler;
asm asm
{$warning FIX ME!} {$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!! // !!!!!!! depends on ABI !!!!!!!!
@ -948,7 +948,11 @@ end ['R3','R10'];
{ {
$Log$ $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() + implemented get_frame()
* fixed bug in IndexDWord() * fixed bug in IndexDWord()

12
rtl/sparc/sparc.inc
View File

@ -1,17 +1,17 @@
{$define FPC_SYSTEM_HAS_GET_FRAME} {$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:longint;{assembler;} function get_frame:pointer;{assembler;}
begin{asm} begin{asm}
{$warning FIX ME!} {$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!! // !!!!!!! depends on ABI !!!!!!!!
end; end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} {$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} begin{asm}
{$warning FIX ME!} {$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!! // !!!!!!! depends on ABI !!!!!!!!
end; end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} {$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} begin{asm}
{$warning FIX ME!} {$warning FIX ME!}
// !!!!!!! depends on ABI !!!!!!!! // !!!!!!! depends on ABI !!!!!!!!
@ -31,7 +31,11 @@ begin{asm}
end; end;
{ {
$Log$ $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 * fixing run time errors related to unimplemented abstract methods in CG
+ giving empty emplementations for some RTL functions + giving empty emplementations for some RTL functions