mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 21:29:41 +01:00
79 lines
1.7 KiB
ObjectPascal
79 lines
1.7 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2016 by the Free Pascal development team
|
|
|
|
System Entry point for Atari/TOS
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
|
|
unit si_prc;
|
|
|
|
interface
|
|
|
|
implementation
|
|
|
|
{$i gemdos.inc}
|
|
|
|
var
|
|
procdesc: PPD; public name '__base';
|
|
tpasize: longint;
|
|
stacktop: pointer; public name '__stktop';
|
|
stklen: longint; external name '__stklen';
|
|
|
|
|
|
procedure PascalMain; external name 'PASCALMAIN';
|
|
|
|
|
|
{ this function must be the first in this unit which contains code }
|
|
{$OPTIMIZATION OFF}
|
|
procedure _FPC_proc_start; cdecl; public name '_start';
|
|
var pd: PPD;
|
|
begin
|
|
asm
|
|
move.l a0,d0
|
|
beq @Lapp
|
|
moveq #0,d1
|
|
bra @Lacc
|
|
@Lapp:
|
|
move.l 8(a6),a0
|
|
moveq #1,d1
|
|
@Lacc:
|
|
move.b d1,AppFlag
|
|
move.l a0,procdesc
|
|
end;
|
|
pd:=procdesc;
|
|
tpasize:=align(sizeof(pd^) + pd^.p_tlen + pd^.p_dlen + pd^.p_blen + stklen, sizeof(pointer));
|
|
|
|
if gemdos_mshrink(0, pd, tpasize) < 0 then
|
|
begin
|
|
gemdos_cconws('Not enough memory.'#13#10);
|
|
gemdos_pterm(-39);
|
|
end
|
|
else
|
|
begin
|
|
stacktop:=pd^.p_lowtpa + tpasize;
|
|
asm
|
|
move.l stacktop, sp
|
|
end;
|
|
PascalMain;
|
|
|
|
{ this should be unreachable... }
|
|
gemdos_pterm(-1);
|
|
end;
|
|
end;
|
|
|
|
procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc'; noreturn;
|
|
begin
|
|
gemdos_pterm(_ExitCode);
|
|
end;
|
|
|
|
|
|
end.
|