paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 20:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35065 -
This commit is contained in:
Károly Balogh 2016-12-04 14:02:01 +00:00
parent 114a43e6ef
commit 1701f06a0e
2 changed files with 44 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
rtl/morphos/si_prc.pp
View File

@ -23,15 +23,54 @@ const
abox_signature: dword = 1; public name '__abox__'; abox_signature: dword = 1; public name '__abox__';
var var
ExecBase: Pointer; public name '_ExecBase'; MOS_ExecBase: Pointer; public name '_ExecBase';
realExecBase: Pointer absolute $4; 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 begin
ExecBase:=realExecBase; MOS_ExecBase:=realExecBase;
_FPC_proc_start:=PascalSysInit;
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; 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. end.

40
rtl/morphos/system.pp
View File

@ -24,7 +24,6 @@ unit System;
interface interface
{$define FPC_IS_SYSTEM} {$define FPC_IS_SYSTEM}
{$define PASCAL_SYSINIT}
{$I systemh.inc} {$I systemh.inc}
{$I osdebugh.inc} {$I osdebugh.inc}
@ -115,18 +114,7 @@ type
Misc. System Dependent Functions 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'; procedure haltproc(e:longint);cdecl;external name '_haltproc';
{$ENDIF}
procedure System_exit; procedure System_exit;
var var
@ -253,34 +241,6 @@ begin
result := stklen; result := stklen;
end; 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 begin
IsConsole := TRUE; IsConsole := TRUE;