paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 10:19:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

m68k-amiga: startup code to print a console message and quit, when the OS is known to be too old for the RTL

Browse Source 
git-svn-id: trunk@44736 -
This commit is contained in:
Károly Balogh 2020-04-16 20:59:08 +00:00
parent c577e290d1
commit 4f14f0f4e5
1 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
rtl/amiga/m68k/si_prc.pp
View File

@ -21,6 +21,7 @@ implementation
var
AOS_ExecBase: Pointer; public name '_ExecBase';
AOS_DosBase: Pointer; external name '_DOSBase';
realExecBase: Pointer absolute $4;
StkLen: LongInt; external name '__stklen';
sysinit_jmpbuf: jmp_buf;
@ -29,6 +30,9 @@ var
{ the definitions in there need AOS_Execbase }
{$include execd.inc}
{$include execf.inc}
{$include timerd.inc}
{$include doslibd.inc}
{$include doslibf.inc}
{$if defined(AMIGA_V1_0_ONLY) or defined(AMIGA_V1_2_ONLY)}
{$define AMIGA_LEGACY}
@ -44,6 +48,21 @@ var
var
sst: TStackSwapStruct;
const
{$if defined(AMIGA_V1_0_ONLY)}
NEEDS_NEWER_OS = 'This program needs newer OS.'+LineEnding;
{$else}
{$if defined(AMIGA_V1_2_ONLY)}
NEEDS_NEWER_OS = 'This program needs OS 1.2 or newer.'+LineEnding;
{$else}
{$if defined(AMIGA_V2_0_ONLY)}
NEEDS_NEWER_OS = 'This program needs OS 2.04 or newer.'+LineEnding;
{$else}
NEEDS_NEWER_OS = 'This program needs OS 3.0 or newer.'+LineEnding;
{$endif}
{$endif}
{$endif}
procedure PascalMain; external name 'PASCALMAIN';
@ -60,8 +79,19 @@ begin
end;
{$ENDIF}
AOS_ExecBase:=realExecBase;
newStack:=nil;
if PLibrary(AOS_ExecBase)^.lib_Version < AMIGA_OS_MINVERSION then
begin
AOS_DOSBase:=OpenLibrary('dos.library',0);
if AOS_DOSBase <> nil then
begin
dosWrite(dosOutput,PChar(NEEDS_NEWER_OS),length(NEEDS_NEWER_OS));
CloseLibrary(AOS_DOSBase);
end;
exit(20);
end;
newStack:=nil;
task:=FindTask(nil);
if (task^.tc_SPUpper-task^.tc_SPLower < StkLen) then
begin