blob: 11b660944754f843a97da7a015cea43f485a47f5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
{
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(pd: PPD); cdecl; public name '_start';
begin
procdesc:=pd;
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';
begin
gemdos_pterm(_ExitCode);
end;
end.
|
