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

sinclairql: changed startup code to be able to run directly as job without a BASIC loader. based on a patch by Marcel Kilgus in qlforum.co.uk

Browse Source 
git-svn-id: trunk@47570 -
This commit is contained in:
Károly Balogh 2020-11-25 04:42:44 +00:00
parent 6a88f2fc28
commit 2294472ac7
1 changed files with 22 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
rtl/sinclairql/si_prc.pp
View File

@ -22,29 +22,25 @@ implementation
{$i qdosfuncs.inc} {$i qdosfuncs.inc}
var var
stacktop: pointer;
setjmpbuf: jmp_buf;
stklen: longint; external name '__stklen';
binstart: byte; external name '_stext'; binstart: byte; external name '_stext';
binend: byte; external name '_etext'; binend: byte; external name '_etext';
bssstart: byte; external name '_sbss'; bssstart: byte; external name '_sbss';
bssend: byte; external name '_ebss'; bssend: byte; external name '_ebss';
{ this is const, so it will go into the .data section, not .bss }
const
stackorig: pointer = nil;
procedure PascalMain; external name 'PASCALMAIN'; procedure PascalMain; external name 'PASCALMAIN';
procedure PascalStart; forward;
{ this function must be the first in this unit which contains code } { this function must be the first in this unit which contains code }
{$OPTIMIZATION OFF} {$OPTIMIZATION OFF}
function _FPC_proc_start: longint; cdecl; public name '_start'; function _FPC_proc_start: longint; cdecl; assembler; nostackframe; public name '_start';
var asm
newstack: pointer; bra @start
begin dc.l $0
_FPC_proc_start:=0; dc.w $4afb
asm dc.w 3
move.l d7,-(sp) dc.l $46504300 { Job name, just FPC for now }
@start:
{ relocation code } { relocation code }
{ get our actual position in RAM } { get our actual position in RAM }
@ -80,36 +76,22 @@ begin
bne @relocloop bne @relocloop
@noreloc: @noreloc:
move.l (sp)+,d7 jsr PascalStart
{ save the original stack pointer }
move.l a7,stackorig
end;
{ initialize .bss }
FillChar(bssstart,PtrUInt(@bssend)-PtrUInt(@bssstart),#0);
newstack:=mt_alchp(stklen,nil,-1);
if not assigned(newstack) then
_FPC_proc_start:=ERR_OM
else
begin
stacktop:=pbyte(newstack)+stklen;
asm
move.l stacktop,sp
end;
if setjmp(setjmpbuf) = 0 then
PascalMain;
asm
move.l stackorig,sp
end;
mt_rechp(newstack);
end;
end; end;
procedure _FPC_proc_halt(_ExitCode: longint); public name '_haltproc'; procedure _FPC_proc_halt(_ExitCode: longint); public name '_haltproc';
begin begin
longjmp(setjmpbuf,1); mt_frjob(-1, _ExitCode);
end;
procedure PascalStart;
begin
{ initialize .bss }
FillChar(bssstart,PtrUInt(@bssend)-PtrUInt(@bssstart),#0);
PascalMain;
Halt; { this should never be reached }
end; end;