mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 00:29:33 +02:00
palmos: new pascal startup code sketch. the code was tested elsewhere, but not as part of the RTL yet
git-svn-id: trunk@37216 -
This commit is contained in:
parent
b56a4bc800
commit
587471a0bb
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10017,6 +10017,7 @@ rtl/palmos/palmos.inc svneol=native#text/plain
|
||||
rtl/palmos/pilot.pp svneol=native#text/plain
|
||||
rtl/palmos/readme -text
|
||||
rtl/palmos/rtldefs.inc svneol=native#text/plain
|
||||
rtl/palmos/si_prc.pp svneol=native#text/plain
|
||||
rtl/palmos/sysdir.inc svneol=native#text/plain
|
||||
rtl/palmos/sysfile.inc svneol=native#text/plain
|
||||
rtl/palmos/sysheap.inc svneol=native#text/plain
|
||||
|
59
rtl/palmos/si_prc.pp
Normal file
59
rtl/palmos/si_prc.pp
Normal file
@ -0,0 +1,59 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2017 by the Free Pascal development team
|
||||
|
||||
System Entry point for PalmOS, Pascal only programs
|
||||
|
||||
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 palmos.inc}
|
||||
|
||||
var
|
||||
appInfo: SysAppInfoPtr; public name '__appInfo';
|
||||
StkLen: LongInt; external name '__stklen';
|
||||
sysinit_jmpbuf: jmp_buf;
|
||||
ExitCode: LongInt;
|
||||
|
||||
|
||||
procedure PascalMain; external name 'PASCALMAIN';
|
||||
|
||||
|
||||
{ this function must be the first in this unit which contains code }
|
||||
function _FPC_proc_start: longint; cdecl; public name '_start';
|
||||
var
|
||||
prevGlobals: Pointer;
|
||||
globalsPtr: Pointer;
|
||||
begin
|
||||
if SysAppStartup(appInfo, prevGlobals, globalsPtr) <> 0 then
|
||||
begin
|
||||
SndPlaySystemSound(sndError);
|
||||
exit(-1);
|
||||
end;
|
||||
|
||||
if setjmp(sysinit_jmpbuf) = 0 then
|
||||
PascalMain;
|
||||
|
||||
SysAppExit(appInfo, prevGlobals, globalsPtr);
|
||||
_FPC_proc_start:=ExitCode;
|
||||
end;
|
||||
|
||||
procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
|
||||
begin
|
||||
ExitCode:=_ExitCode;
|
||||
longjmp(sysinit_jmpbuf,1);
|
||||
end;
|
||||
|
||||
end.
|
Loading…
Reference in New Issue
Block a user