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

sinclairql: implemented StackTop, this results in working stacktraces and working stack checking. Implemented a custom 5% stack safety margin and a system specific SysBackTraceStr()

Browse Source 
git-svn-id: trunk@49201 -
This commit is contained in:
Károly Balogh 2021-04-14 04:05:33 +00:00
parent 7b9ed5fe46
commit 2f90dbbd44
3 changed files with 30 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/sinclairql/si_prc.pp
View File

@ -26,7 +26,7 @@ var
binend: byte; external name '_etext';
bssstart: byte; external name '_sbss';
bssend: byte; external name '_ebss';
jobStackDataPtr: pointer; public name '__job_stack_data_ptr';
stackpointer_on_entry: pointer; public name '__stackpointer_on_entry';
procedure PascalMain; external name 'PASCALMAIN';
procedure PascalStart(a7_on_entry: pointer); noreturn; forward;
@ -102,7 +102,7 @@ begin
{ initialize .bss }
FillChar(bssstart,PtrUInt(@bssend)-PtrUInt(@bssstart),#0);
jobStackDataPtr:=a7_on_entry;
stackpointer_on_entry:=a7_on_entry;
PascalMain;
end;

22
rtl/sinclairql/sysos.inc
View File

@ -45,3 +45,25 @@ begin
ERR_BL : InOutRes := 1; { UNLIKELY! Bad line of Basic. }
end;
end;
var
stackpointer_on_entry: pointer; external name '__stackpointer_on_entry';
function StackTop: Pointer;
begin
StackTop:=stackpointer_on_entry;
end;
var
binstart: byte; external name '_stext';
binend: byte; external name '_etext';
function SysBackTraceStr (Addr: CodePointer): ShortString;
begin
if (addr<@binstart) or (addr>@binend) then
SysBackTraceStr:=' Addr $'+hexstr(addr)
else
SysBackTraceStr:=' Offs $'+hexstr(pointer(addr-@binstart));
end;

7
rtl/sinclairql/system.pp
View File

@ -77,6 +77,9 @@ function GetQLJobNamePtr: pointer;
implementation
{$define FPC_SYSTEM_HAS_STACKTOP}
{$define FPC_SYSTEM_HAS_BACKTRACESTR}
{$if defined(FPUSOFT)}
{$define fpc_softfpu_implementation}
@ -266,7 +269,7 @@ end;
System Dependent Entry code
*****************************************************************************}
var
jobStackDataPtr: pointer; external name '__job_stack_data_ptr';
jobStackDataPtr: pointer; external name '__stackpointer_on_entry';
program_name: shortstring; external name '__fpc_program_name';
{ QL/QDOS specific startup }
@ -341,6 +344,8 @@ end;
begin
StackLength := CheckInitialStkLen (InitialStkLen);
StackBottom := StackTop - StackLength;
StackMargin := min(align(StackLength div 20,2),STACK_MARGIN_MAX);
{ Initialize ExitProc }
ExitProc:=Nil;
SysInitQDOS;