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

git-svn-id: trunk@49201 -

rtl/sinclairql/si_prc.pp

@@ -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;

rtl/sinclairql/sysos.inc

@@ -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;

rtl/sinclairql/system.pp

@@ -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;