mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 17:11:08 +02:00
m68k-amiga: startup code to print a console message and quit, when the OS is known to be too old for the RTL
git-svn-id: trunk@44736 -
This commit is contained in:
parent
c577e290d1
commit
4f14f0f4e5
@ -21,6 +21,7 @@ implementation
|
|||||||
|
|
||||||
var
|
var
|
||||||
AOS_ExecBase: Pointer; public name '_ExecBase';
|
AOS_ExecBase: Pointer; public name '_ExecBase';
|
||||||
|
AOS_DosBase: Pointer; external name '_DOSBase';
|
||||||
realExecBase: Pointer absolute $4;
|
realExecBase: Pointer absolute $4;
|
||||||
StkLen: LongInt; external name '__stklen';
|
StkLen: LongInt; external name '__stklen';
|
||||||
sysinit_jmpbuf: jmp_buf;
|
sysinit_jmpbuf: jmp_buf;
|
||||||
@ -29,6 +30,9 @@ var
|
|||||||
{ the definitions in there need AOS_Execbase }
|
{ the definitions in there need AOS_Execbase }
|
||||||
{$include execd.inc}
|
{$include execd.inc}
|
||||||
{$include execf.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)}
|
{$if defined(AMIGA_V1_0_ONLY) or defined(AMIGA_V1_2_ONLY)}
|
||||||
{$define AMIGA_LEGACY}
|
{$define AMIGA_LEGACY}
|
||||||
@ -44,6 +48,21 @@ var
|
|||||||
var
|
var
|
||||||
sst: TStackSwapStruct;
|
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';
|
procedure PascalMain; external name 'PASCALMAIN';
|
||||||
|
|
||||||
|
|
||||||
@ -60,8 +79,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
AOS_ExecBase:=realExecBase;
|
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);
|
task:=FindTask(nil);
|
||||||
if (task^.tc_SPUpper-task^.tc_SPLower < StkLen) then
|
if (task^.tc_SPUpper-task^.tc_SPLower < StkLen) then
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user