morphos: take two on the Pascal startup code. this version works as a drop-in replacement for the asm one, and doesn't need system unit patching. this will be important when linking against LibC and when the approach gets ported to other Amiga-like platforms

git-svn-id: trunk@35065 -

rtl/morphos/si_prc.pp

@@ -23,15 +23,54 @@ const
   abox_signature: dword = 1; public name '__abox__';
 
 var
-  ExecBase: Pointer; public name '_ExecBase';
+  MOS_ExecBase: Pointer; public name '_ExecBase';
   realExecBase: Pointer absolute $4;
+  StkLen: LongInt; external name '__stklen';
+  sysinit_jmpbuf: jmp_buf;
+  ExitCode: LongInt;
 
-function PascalSysInit: longint; external name 'PASCALSYSINIT';
+{ the definitions in there need MOS_Execbase }
+{$include execd.inc}
+{$include execf.inc}
 
-function _FPC_proc_start: longint; public name '_start';
+procedure PascalMainEntry; cdecl; forward;
+
+{ this function must be the first in this unit which contains code }
+function _FPC_proc_start: longint; cdecl; public name '_start';
+var
+  sst: TStackSwapStruct;
+  newStack: Pointer;
+  newStackAligned: Pointer;
 begin
-  ExecBase:=realExecBase;
-  _FPC_proc_start:=PascalSysInit;
+  MOS_ExecBase:=realExecBase;
+
+  newStack:=AllocVecTaskPooled(StkLen+16);
+  newStackAligned:=align(newStack,16);
+
+  sst.stk_Lower:=newStackAligned;
+  sst.stk_Upper:=newStackAligned+StkLen;
+  sst.stk_Pointer:=newStackAligned+StkLen;
+
+  NewPPCStackSwap(@sst,@PascalMainEntry,nil);
+
+  FreeVecTaskPooled(newStack);
+  _FPC_proc_start:=ExitCode;
 end;
 
+procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+  ExitCode:=_ExitCode;
+  longjmp(sysinit_jmpbuf,1);
+end;
+
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+procedure PascalMainEntry; cdecl;
+begin
+  if setjmp(sysinit_jmpbuf) = 0 then
+    PascalMain;
+end;
+
+
 end.

rtl/morphos/system.pp

@@ -24,7 +24,6 @@ unit System;
 interface
 
 {$define FPC_IS_SYSTEM}
-{$define PASCAL_SYSINIT}
 
 {$I systemh.inc}
 {$I osdebugh.inc}
@@ -115,18 +114,7 @@ type
                        Misc. System Dependent Functions
 *****************************************************************************}
 
-{$IFDEF PASCAL_SYSINIT}
-var
-  sysinit_jmpbuf: jmp_buf;
-
-procedure haltproc(e:longint);
-begin
-  longjmp(sysinit_jmpbuf,1);
-end;
-
-{$ELSE}
 procedure haltproc(e:longint);cdecl;external name '_haltproc';
-{$ENDIF}
 
 procedure System_exit;
 var
@@ -253,34 +241,6 @@ begin
   result := stklen;
 end;
 
-{$IFDEF PASCAL_SYSINIT}
-procedure PascalMain; external name 'PASCALMAIN';
-
-procedure PascalSysInitCallMain;
-begin
-  if setjmp(sysinit_jmpbuf) = 0 then
-    PascalMain;
-end;
-
-function PascalSysInit: LongInt; public name 'PASCALSYSINIT';
-var
-  sst: TStackSwapStruct;
-  newStack: Pointer;
-  newStackAligned: Pointer;
-begin
-  newStack:=AllocVecTaskPooled(InitialStkLen+16);
-  newStackAligned:=align(newStack,16);
-
-  sst.stk_Lower:=newStackAligned;
-  sst.stk_Upper:=newStackAligned+InitialStkLen;
-  sst.stk_Pointer:=newStackAligned+InitialStkLen;
-
-  NewPPCStackSwap(@sst,@PascalSysInitCallMain,nil);
-
-  FreeVecTaskPooled(newStack);
-  result:=ExitCode;
-end;
-{$ENDIF}
 
 begin
   IsConsole := TRUE;