mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 09:50:38 +02:00
* synchronize with trunk
git-svn-id: branches/z80@44428 -
This commit is contained in:
nickysn
commit
a340a39ae3
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -10095,6 +10095,9 @@ rtl/amiga/doslibd.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/doslibf.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/execd.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/execf.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/legacydos.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/legacyexec.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/legacyutil.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/m68kamiga.inc svneol=native#text/plain
|
||||
rtl/amiga/m68k/prt0.as svneol=native#text/plain
|
||||
rtl/amiga/m68k/si_prc.pp svneol=native#text/plain
|
||||
|
||||
@ -2136,9 +2136,9 @@ function AllocPooled(poolHeader: Pointer location 'a0';
|
||||
memSize : Cardinal location 'd0'): Pointer;
|
||||
SysCall MOS_ExecBase 708;
|
||||
|
||||
function FreePooled(poolHeader: Pointer location 'a0';
|
||||
memory : Pointer location 'a1';
|
||||
memSize : Cardinal location 'd0'): Pointer;
|
||||
procedure FreePooled(poolHeader: Pointer location 'a0';
|
||||
memory : Pointer location 'a1';
|
||||
memSize : Cardinal location 'd0');
|
||||
SysCall MOS_ExecBase 714;
|
||||
|
||||
function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
|
||||
|
||||
@ -230,7 +230,7 @@ begin
|
||||
dosSetProtection:=SetProtection(buffer,mask) <> 0;
|
||||
end;
|
||||
|
||||
function dosSetFileDate(name: string; p : PDateStamp): Boolean;
|
||||
function dosSetFileDate(const name: string; p : PDateStamp): Boolean;
|
||||
var
|
||||
buffer : array[0..255] of Char;
|
||||
begin
|
||||
@ -405,11 +405,11 @@ begin
|
||||
tr^.tr_node.io_Command := TR_GETSYSTIME;
|
||||
DoIO(pIORequest(tr));
|
||||
|
||||
{ structure assignment }
|
||||
tv^ := tr^.tr_time;
|
||||
{ structure assignment }
|
||||
tv^ := tr^.tr_time;
|
||||
|
||||
delete_timer(tr);
|
||||
get_sys_time := 0;
|
||||
delete_timer(tr);
|
||||
get_sys_time := 0;
|
||||
end;
|
||||
|
||||
procedure GetDate(Var Year, Month, MDay, WDay: Word);
|
||||
|
||||
@ -22,6 +22,7 @@
|
||||
*********************************************************************
|
||||
* }
|
||||
|
||||
{$PACKRECORDS 2}
|
||||
|
||||
const
|
||||
DOSNAME = 'dos.library';
|
||||
@ -57,7 +58,7 @@ const
|
||||
|
||||
type
|
||||
PDateStamp = ^TDateStamp;
|
||||
TDateStamp = packed record
|
||||
TDateStamp = record
|
||||
ds_Days : LongInt;
|
||||
ds_Minute: LongInt;
|
||||
ds_Tick : LongInt;
|
||||
@ -69,7 +70,7 @@ const
|
||||
|
||||
type
|
||||
PFileInfoBlock = ^TFileInfoBlock;
|
||||
TFileInfoBlock = packed record
|
||||
TFileInfoBlock = record
|
||||
fib_DiskKey : LongInt;
|
||||
fib_DirEntryType: LongInt;
|
||||
fib_FileName : Array[0..107] Of Char;
|
||||
@ -132,7 +133,7 @@ type
|
||||
|
||||
type
|
||||
PInfoData = ^TInfoData;
|
||||
TInfoData = packed record
|
||||
TInfoData = record
|
||||
id_NumSoftErrors: LongInt;
|
||||
id_UnitNumber : LongInt;
|
||||
id_DiskState : LongInt;
|
||||
@ -268,7 +269,7 @@ const
|
||||
type
|
||||
{ * Required to avoid conflict with default types * }
|
||||
_PDateTime = ^_TDateTime;
|
||||
_TDateTime = packed record
|
||||
_TDateTime = record
|
||||
dat_Stamp : TDateStamp;
|
||||
dat_Format : Byte;
|
||||
dat_Flags : Byte;
|
||||
@ -303,7 +304,7 @@ const
|
||||
|
||||
type
|
||||
PProcess = ^TProcess;
|
||||
TProcess = packed record
|
||||
TProcess = record
|
||||
pr_Task : TTask;
|
||||
pr_MsgPort : TMsgPort;
|
||||
pr_Pad : Word;
|
||||
@ -354,7 +355,7 @@ const
|
||||
|
||||
type
|
||||
PFileHandle = ^TFileHandle;
|
||||
TFileHandle = packed record
|
||||
TFileHandle = record
|
||||
fh_Flags : DWord;
|
||||
fh_Interactive: LongInt;
|
||||
fh_Type : PMsgPort;
|
||||
@ -373,7 +374,7 @@ type
|
||||
|
||||
type
|
||||
PDOSPacket = ^TDOSPacket;
|
||||
TDOSPacket = packed record
|
||||
TDOSPacket = record
|
||||
dp_Link: PMessage;
|
||||
dp_Port: PMsgPort;
|
||||
case Byte of
|
||||
@ -397,7 +398,7 @@ type
|
||||
|
||||
type
|
||||
PStandardPacket = ^TStandardPacket;
|
||||
TStandardPacket = packed record
|
||||
TStandardPacket = record
|
||||
sp_Msg: TMessage;
|
||||
sp_Pkt: TDOSPacket;
|
||||
end;
|
||||
@ -483,14 +484,14 @@ const
|
||||
|
||||
type
|
||||
PErrorString = ^TErrorString;
|
||||
TErrorString = packed record
|
||||
TErrorString = record
|
||||
estr_Nums: Pointer; { ^LongInt }
|
||||
estr_Byte: Pointer; { ^Byte }
|
||||
end;
|
||||
|
||||
type
|
||||
PRootNode = ^TRootNode;
|
||||
TRootNode = packed record
|
||||
TRootNode = record
|
||||
rn_TaskArray : DWord; { BPTR }
|
||||
rn_ConsoleSegment : DWord; { BPTR }
|
||||
rn_Time : TDateStamp;
|
||||
@ -505,7 +506,7 @@ type
|
||||
|
||||
type
|
||||
PDOSLibrary = ^TDOSLibrary;
|
||||
TDOSLibrary = packed record
|
||||
TDOSLibrary = record
|
||||
dl_Lib : TLibrary;
|
||||
dl_Root : PRootNode;
|
||||
dl_GU : Pointer;
|
||||
@ -529,7 +530,7 @@ const
|
||||
|
||||
type
|
||||
PCliProcList = ^TCliProcList;
|
||||
TCliProcList = packed record
|
||||
TCliProcList = record
|
||||
cpl_Node : TMinNode;
|
||||
cpl_First: LongInt;
|
||||
cpl_Array: Array[0..0] Of PMsgPort;
|
||||
@ -537,7 +538,7 @@ type
|
||||
|
||||
type
|
||||
PDOSInfo = ^TDOSInfo;
|
||||
TDOSInfo = packed record
|
||||
TDOSInfo = record
|
||||
case Byte of
|
||||
0 : ( di_ResList: DWord; { BPTR }
|
||||
);
|
||||
@ -554,7 +555,7 @@ type
|
||||
|
||||
type
|
||||
PSegment = ^TSegment;
|
||||
TSegment = packed record
|
||||
TSegment = record
|
||||
seg_Next : DWord; { BPTR }
|
||||
seg_UC : LongInt;
|
||||
seg_Seg : DWord; { BPTR }
|
||||
@ -572,7 +573,7 @@ const
|
||||
|
||||
type
|
||||
PCommandLineInterface = ^TCommandLineInterface;
|
||||
TCommandLineInterface = packed record
|
||||
TCommandLineInterface = record
|
||||
cli_Result2 : LongInt;
|
||||
cli_SetName : DWord; { BSTR }
|
||||
cli_CommandDir : DWord; { BPTR }
|
||||
@ -593,7 +594,7 @@ type
|
||||
|
||||
type
|
||||
PDeviceList = ^TDeviceList;
|
||||
TDeviceList = packed record
|
||||
TDeviceList = record
|
||||
dl_Next : DWord; { BPTR }
|
||||
dl_Type : LongInt;
|
||||
dl_Task : PMsgPort;
|
||||
@ -607,7 +608,7 @@ type
|
||||
|
||||
type
|
||||
PDevInfo = ^TDevInfo;
|
||||
TDevInfo = packed record
|
||||
TDevInfo = record
|
||||
dvi_Next : DWord; { BPTR }
|
||||
dvi_Type : LongInt;
|
||||
dvi_Task : Pointer;
|
||||
@ -623,14 +624,14 @@ type
|
||||
|
||||
type
|
||||
PAssignList = ^TAssignList;
|
||||
TAssignList = packed record
|
||||
TAssignList = record
|
||||
al_Next: PAssignList;
|
||||
al_Lock: DWord; { BPTR }
|
||||
end;
|
||||
|
||||
type
|
||||
PDOSList = ^TDOSList;
|
||||
TDOSList = packed record
|
||||
TDOSList = record
|
||||
dol_Next: DWord; { BPTR }
|
||||
dol_Type: LongInt;
|
||||
dol_Task: PMsgPort;
|
||||
@ -673,7 +674,7 @@ const
|
||||
|
||||
type
|
||||
PDevProc = ^TDevProc;
|
||||
TDevProc = packed record
|
||||
TDevProc = record
|
||||
dvp_Port : PMsgPort;
|
||||
dvp_Lock : DWord; { BPTR }
|
||||
dvp_Flags : DWord;
|
||||
@ -715,7 +716,7 @@ const
|
||||
|
||||
type
|
||||
PFileLock = ^TFileLock;
|
||||
TFileLock = packed record
|
||||
TFileLock = record
|
||||
fl_Link : DWord; { BPTR }
|
||||
fl_Key : LongInt;
|
||||
fl_Access: LongInt;
|
||||
@ -758,7 +759,7 @@ const
|
||||
|
||||
type
|
||||
PAChain = ^TAChain;
|
||||
TAChain = packed record
|
||||
TAChain = record
|
||||
an_Child : PAChain;
|
||||
an_Parent: PAChain;
|
||||
an_Lock : DWord; { BPTR }
|
||||
@ -770,7 +771,7 @@ type
|
||||
|
||||
type
|
||||
PAnchorPath = ^TAnchorPath;
|
||||
TAnchorPath = packed record
|
||||
TAnchorPath = record
|
||||
case Byte of
|
||||
0 : ( ap_First: PAChain;
|
||||
ap_Last : PAChain;
|
||||
@ -964,7 +965,7 @@ const
|
||||
|
||||
type
|
||||
PExAllData = ^TExAllData;
|
||||
TExAllData = packed record
|
||||
TExAllData = record
|
||||
ed_Next : PExAllData;
|
||||
ed_Name : PChar;
|
||||
ed_Type : LongInt;
|
||||
@ -980,7 +981,7 @@ type
|
||||
|
||||
type
|
||||
PExAllControl = ^TExAllControl;
|
||||
TexAllControl = packed record
|
||||
TexAllControl = record
|
||||
eac_Entries : Cardinal;
|
||||
eac_LastKey : Cardinal;
|
||||
eac_MatchString: PChar;
|
||||
@ -1004,7 +1005,7 @@ const
|
||||
|
||||
type
|
||||
PRecordLock = ^TRecordLock;
|
||||
TRecordLock = packed record
|
||||
TRecordLock = record
|
||||
rec_FH : LongInt;
|
||||
rec_Offset: Cardinal;
|
||||
rec_Length: Cardinal;
|
||||
@ -1122,7 +1123,7 @@ const
|
||||
|
||||
type
|
||||
PLocalVar = ^TLocalVar;
|
||||
TLocalVar = packed record
|
||||
TLocalVar = record
|
||||
lv_Node : TNode;
|
||||
lv_Flags: Word;
|
||||
lv_Value: PChar;
|
||||
@ -1162,7 +1163,7 @@ const
|
||||
|
||||
type
|
||||
PCSource = ^TCSource;
|
||||
TCSource = packed record
|
||||
TCSource = record
|
||||
CS_Buffer: PChar;
|
||||
CS_Length: LongInt;
|
||||
CS_CurChr: LongInt;
|
||||
@ -1170,7 +1171,7 @@ type
|
||||
|
||||
type
|
||||
PRDArgs = ^TRDArgs;
|
||||
TRDArgs = packed record
|
||||
TRDArgs = record
|
||||
RDA_Source : TCSource;
|
||||
RDA_DAList : LongInt;
|
||||
RDA_Buffer : PChar;
|
||||
@ -1203,7 +1204,7 @@ const
|
||||
|
||||
type
|
||||
PDosEnvec = ^TDosEnvec;
|
||||
TDosEnvec = packed record
|
||||
TDosEnvec = record
|
||||
de_TableSize : Cardinal;
|
||||
de_SizeBlock : Cardinal;
|
||||
de_SecOrg : Cardinal;
|
||||
@ -1253,7 +1254,7 @@ const
|
||||
|
||||
type
|
||||
PFileSysStartupMsg = ^TFileSysStartupMsg;
|
||||
TFileSysStartupMsg = packed record
|
||||
TFileSysStartupMsg = record
|
||||
fssm_Unit : Cardinal;
|
||||
fssm_Device : LongInt;
|
||||
fssm_Environ: LongInt;
|
||||
@ -1262,7 +1263,7 @@ type
|
||||
|
||||
type
|
||||
PDeviceNode = ^TDeviceNode;
|
||||
TDeviceNode = packed record
|
||||
TDeviceNode = record
|
||||
dn_Next : LongInt;
|
||||
dn_Type : Cardinal;
|
||||
dn_Task : PMsgPort;
|
||||
@ -1290,7 +1291,7 @@ const
|
||||
|
||||
type
|
||||
PNotifyRequest = ^TNotifyRequest;
|
||||
TNotifyRequest = packed record
|
||||
TNotifyRequest = record
|
||||
nr_Name : PChar;
|
||||
nr_FullName: PChar;
|
||||
nr_UserData: Cardinal;
|
||||
@ -1313,7 +1314,7 @@ type
|
||||
|
||||
type
|
||||
PNotifyMessage = ^TNotifyMessage;
|
||||
TNotifyMessage = packed record
|
||||
TNotifyMessage = record
|
||||
nm_ExecMessage: TMessage;
|
||||
nm_Class : Cardinal;
|
||||
nm_Code : Word;
|
||||
@ -1355,7 +1356,7 @@ const
|
||||
|
||||
type
|
||||
PSegSem = ^TSegSem;
|
||||
TSegSem = packed record
|
||||
TSegSem = record
|
||||
seg_Semaphore: TSignalSemaphore;
|
||||
seg_Find : Procedure; { Name = seg_Find(REG(a0, ULONG Address), REG(a1, ULONG *SegNum), REG(a2, ULONG *Offset)) }
|
||||
seg_List : TMinList;
|
||||
@ -1363,18 +1364,16 @@ type
|
||||
|
||||
type
|
||||
PSegArray = ^TSegArray;
|
||||
TSegArray = packed record
|
||||
TSegArray = record
|
||||
seg_Address: Cardinal;
|
||||
seg_Size : Cardinal;
|
||||
end;
|
||||
|
||||
type
|
||||
PSegNode = ^TSegNode;
|
||||
TSegNode = packed record
|
||||
TSegNode = record
|
||||
seg_Node : TMinNode;
|
||||
seg_Name : PChar;
|
||||
seg_Array: Array[0..0] Of TSegArray;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
@ -406,9 +406,9 @@ function AllocPooled(poolHeader: Pointer location 'a0';
|
||||
memSize : Cardinal location 'd0'): Pointer;
|
||||
SysCall AOS_ExecBase 708;
|
||||
|
||||
function FreePooled(poolHeader: Pointer location 'a0';
|
||||
memory : Pointer location 'a1';
|
||||
memSize : Cardinal location 'd0'): Pointer;
|
||||
procedure FreePooled(poolHeader: Pointer location 'a0';
|
||||
memory : Pointer location 'a1';
|
||||
memSize : Cardinal location 'd0');
|
||||
SysCall AOS_ExecBase 714;
|
||||
|
||||
function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
|
||||
|
||||
187
rtl/amiga/m68k/legacydos.inc
Normal file
187
rtl/amiga/m68k/legacydos.inc
Normal file
@ -0,0 +1,187 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2020 Karoly Balogh, Free Pascal Development team
|
||||
|
||||
Amiga dos.library legacy (OS 1.x/2.x) support functions
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
This unit implements some missing functions of OS 1.x (and some OS 2.x)
|
||||
dos.library, so the legacy OS support can be implemented with minimal
|
||||
changes to the normal system unit and common Amiga-like code
|
||||
|
||||
Please note that this code doesn't aim to be API feature complete, just
|
||||
functional enough for the RTL code.
|
||||
}
|
||||
|
||||
|
||||
function CreateNewProc(tags: PTagItem): PProcess;
|
||||
begin
|
||||
{$warning CreateNewProc unimplemented!}
|
||||
CreateNewProc:=nil;
|
||||
end;
|
||||
|
||||
function NameFromLock(lock : LongInt;
|
||||
buffer: PChar;
|
||||
len : LongInt): LongBool;
|
||||
var
|
||||
fib_area: array[1..sizeof(TFileInfoBlock) + sizeof(longint)] of byte;
|
||||
fib: pfileinfoblock;
|
||||
namelen: longint;
|
||||
blen: longint;
|
||||
begin
|
||||
NameFromLock:=false;
|
||||
if len <= 0 then
|
||||
exit;
|
||||
|
||||
if (lock = 0) and (len >= 5) then
|
||||
begin
|
||||
buffer:='SYS:';
|
||||
NameFromLock:=true;
|
||||
exit;
|
||||
end;
|
||||
|
||||
fib:=align(@fib_area[1],sizeof(longint));
|
||||
buffer[0]:=#0;
|
||||
dec(len); // always preserve one byte for zero term
|
||||
blen:=0;
|
||||
repeat
|
||||
if Examine(lock,fib) <> 0 then
|
||||
begin
|
||||
namelen:=strlen(@fib^.fib_FileName[0]);
|
||||
if (namelen+1) > (len-blen) then
|
||||
exit;
|
||||
|
||||
move(buffer[0],buffer[namelen+1],blen);
|
||||
move(fib^.fib_FileName[0],buffer[0],namelen);
|
||||
lock:=ParentDir(lock);
|
||||
if lock = 0 then
|
||||
buffer[namelen]:=':'
|
||||
else
|
||||
buffer[namelen]:='/';
|
||||
inc(blen,namelen+1);
|
||||
buffer[blen]:=#0;
|
||||
end
|
||||
else
|
||||
exit;
|
||||
until lock = 0;
|
||||
|
||||
if buffer[blen-1]='/' then
|
||||
buffer[blen-1]:=#0;
|
||||
|
||||
NameFromLock:=true;
|
||||
end;
|
||||
|
||||
function NameFromFH(fh : BPTR;
|
||||
buffer: PChar;
|
||||
len : LongInt): LongBool;
|
||||
begin
|
||||
{$warning NameFromFH unimplemented!}
|
||||
NameFromFH:=false;
|
||||
end;
|
||||
|
||||
function ExamineFH(fh : BPTR;
|
||||
fib: PFileInfoBlock): LongBool;
|
||||
begin
|
||||
{$warning ExamineFH unimplemented!}
|
||||
ExamineFH:=false;
|
||||
end;
|
||||
|
||||
function LockDosList(flags: Cardinal): PDosList;
|
||||
begin
|
||||
{$warning LockDosList unimplemented!}
|
||||
LockDosList:=nil;
|
||||
end;
|
||||
|
||||
procedure UnLockDosList(flags: Cardinal);
|
||||
begin
|
||||
{$warning UnlockDosList unimplemented!}
|
||||
end;
|
||||
|
||||
function NextDosEntry(dlist: PDosList;
|
||||
flags: Cardinal): PDosList;
|
||||
begin
|
||||
{$warning NextDosEntry unimplemented!}
|
||||
NextDosEntry:=nil;
|
||||
end;
|
||||
|
||||
function MatchFirst(pat : PChar;
|
||||
anchor: PAnchorPath): LongInt;
|
||||
begin
|
||||
{$warning MatchFirst unimplemented!}
|
||||
MatchFirst:=-1;
|
||||
end;
|
||||
|
||||
function MatchNext(anchor: PAnchorPath): LongInt;
|
||||
begin
|
||||
{$warning MatchNext unimplemented!}
|
||||
MatchNext:=-1;
|
||||
end;
|
||||
|
||||
procedure MatchEnd(anchor: PAnchorPath);
|
||||
begin
|
||||
{$warning MatchEnd unimplemented!}
|
||||
end;
|
||||
|
||||
function SystemTagList(command: PChar;
|
||||
tags : PTagItem): LongInt;
|
||||
begin
|
||||
{$warning SystemTagList unimplemented!}
|
||||
SystemTagList:=-1;
|
||||
end;
|
||||
|
||||
function GetVar(name : PChar;
|
||||
buffer: PChar;
|
||||
size : LongInt;
|
||||
flags : LongInt): LongInt;
|
||||
begin
|
||||
{$warning GetVar unimplemented!}
|
||||
GetVar:=-1;
|
||||
end;
|
||||
|
||||
function SetFileDate(name: PChar;
|
||||
date: PDateStamp): LongBool;
|
||||
begin
|
||||
{$warning SetFileDate unimplemented!}
|
||||
SetFileDate:=false;
|
||||
end;
|
||||
|
||||
function SetFileSize(fh : LongInt;
|
||||
pos : LongInt;
|
||||
mode: LongInt): LongInt;
|
||||
begin
|
||||
{$warning SetFileSize unimplemented!}
|
||||
SetFileSize:=-1;
|
||||
end;
|
||||
|
||||
|
||||
function GetProgramDir: LongInt;
|
||||
begin
|
||||
{$warning GetProgramDir unimplemented!}
|
||||
GetProgramDir:=0;
|
||||
end;
|
||||
|
||||
|
||||
function GetProgramName(buf: PChar;
|
||||
len: LongInt): LongBool;
|
||||
begin
|
||||
{$warning GetProgramName unimplemented!}
|
||||
GetProgramName:=false;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
__fpc_global_args: pchar; external name '__fpc_args';
|
||||
|
||||
function GetArgStr: PChar;
|
||||
begin
|
||||
GetArgStr:=__fpc_global_args;
|
||||
end;
|
||||
136
rtl/amiga/m68k/legacyexec.inc
Normal file
136
rtl/amiga/m68k/legacyexec.inc
Normal file
@ -0,0 +1,136 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2020 Karoly Balogh, Free Pascal Development team
|
||||
|
||||
Amiga exec.library legacy (OS 1.x/2.x) support functions
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
This unit implements some missing functions of OS 1.x (and some OS 2.x)
|
||||
exec.library, so the legacy OS support can be implemented with minimal
|
||||
changes to the normal system unit and common Amiga-like code
|
||||
|
||||
Please note that this code doesn't aim to be API feature complete, just
|
||||
functional enough for the RTL code.
|
||||
}
|
||||
|
||||
|
||||
function AllocVec(byteSize : Cardinal;
|
||||
requirements: Cardinal): Pointer;
|
||||
var
|
||||
p: pointer;
|
||||
begin
|
||||
p:=execAllocMem(byteSize + sizeof(DWord), requirements);
|
||||
if p <> nil then
|
||||
begin
|
||||
PDWord(p)^:=byteSize + sizeof(DWord);
|
||||
inc(p, sizeof(DWord));
|
||||
end;
|
||||
AllocVec:=p;
|
||||
end;
|
||||
|
||||
procedure FreeVec(memoryBlock: Pointer);
|
||||
begin
|
||||
if memoryBlock <> nil then
|
||||
begin
|
||||
dec(memoryBlock, sizeof(DWord));
|
||||
execFreeMem(memoryBlock,PDWord(memoryBlock)^);
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
TAmigaLegacyPoolEntry = record
|
||||
pe_node: TMinNode;
|
||||
pe_size: dword;
|
||||
end;
|
||||
PAmigaLegacyPoolEntry = ^TAmigaLegacyPoolEntry;
|
||||
|
||||
TAmigaLegacyPool = record
|
||||
pool_requirements: cardinal;
|
||||
pool_chain: PAmigaLegacyPoolEntry;
|
||||
end;
|
||||
PAmigaLegacyPool = ^TAmigaLegacyPool;
|
||||
|
||||
|
||||
function CreatePool(requirements: Cardinal;
|
||||
puddleSize : Cardinal;
|
||||
threshSize : Cardinal): Pointer;
|
||||
var
|
||||
p: PAmigaLegacyPool;
|
||||
begin
|
||||
p:=execAllocMem(sizeof(TAmigaLegacyPool),requirements);
|
||||
if p <> nil then
|
||||
begin
|
||||
p^.pool_requirements:=requirements;
|
||||
p^.pool_chain:=nil;
|
||||
end;
|
||||
CreatePool:=p;
|
||||
end;
|
||||
|
||||
procedure DeletePool(poolHeader: Pointer);
|
||||
begin
|
||||
|
||||
{$warning DeletePool unimplemented!}
|
||||
end;
|
||||
|
||||
function AllocPooled(poolHeader: Pointer;
|
||||
memSize : Cardinal): Pointer;
|
||||
var
|
||||
p: PAmigaLegacyPoolEntry;
|
||||
ph: PAmigaLegacyPool absolute poolHeader;
|
||||
begin
|
||||
p:=execAllocMem(memSize + sizeof(TAmigaLegacyPoolEntry), ph^.pool_requirements);
|
||||
if p <> nil then
|
||||
begin
|
||||
if ph^.pool_chain <> nil then
|
||||
ph^.pool_chain^.pe_node.mln_Pred:=PMinNode(p);
|
||||
p^.pe_node.mln_Succ:=PMinNode(ph^.pool_chain);
|
||||
p^.pe_node.mln_Pred:=nil;
|
||||
p^.pe_size:=memSize + sizeof(TAmigaLegacyPoolEntry);
|
||||
ph^.pool_chain:=p;
|
||||
inc(pointer(p),sizeof(TAmigaLegacyPoolEntry));
|
||||
end;
|
||||
AllocPooled:=p;
|
||||
end;
|
||||
|
||||
procedure FreePooled(poolHeader: Pointer;
|
||||
memory : Pointer;
|
||||
memSize : Cardinal);
|
||||
var
|
||||
p: PAmigaLegacyPoolEntry;
|
||||
ph: PAmigaLegacyPool absolute poolHeader;
|
||||
begin
|
||||
if memory <> nil then
|
||||
begin
|
||||
p:=PAmigaLegacyPoolEntry(memory-sizeof(TAmigaLegacyPoolEntry));
|
||||
if p^.pe_node.mln_Succ <> nil then
|
||||
PAmigaLegacyPoolEntry(p^.pe_node.mln_Succ)^.pe_node.mln_Pred:=p^.pe_node.mln_Pred;
|
||||
if p^.pe_node.mln_Pred <> nil then
|
||||
PAmigaLegacyPoolEntry(p^.pe_node.mln_Pred)^.pe_node.mln_Succ:=p^.pe_node.mln_Succ;
|
||||
if p = ph^.pool_chain then
|
||||
ph^.pool_chain:=PAmigaLegacyPoolEntry(p^.pe_node.mln_Succ);
|
||||
execFreeMem(p,p^.pe_size);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure StackSwap(newStack: PStackSwapStruct);
|
||||
begin
|
||||
{$warning StackSwap unimplemented!}
|
||||
end;
|
||||
|
||||
procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore);
|
||||
begin
|
||||
{ NOTE: this still needs v33+ (OS v1.2 or later) }
|
||||
{ ObtainSemaphoreShared is used by athreads, and simply replacing
|
||||
it by ObtainSemaphore works, just with a slight performance hit,
|
||||
at least in the way it's currently used in athreads. }
|
||||
ObtainSemaphore(sigSem);
|
||||
end;
|
||||
35
rtl/amiga/m68k/legacyutil.inc
Normal file
35
rtl/amiga/m68k/legacyutil.inc
Normal file
@ -0,0 +1,35 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2020 Karoly Balogh, Free Pascal Development team
|
||||
|
||||
Amiga utility.library legacy (OS 1.x/2.x) support functions
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
This unit implements some of the utility.library functions for OS 1.x,
|
||||
where this library is missing, so the legacy OS support can be implemented
|
||||
with minimal changes to the normal system unit and common Amiga-like code
|
||||
|
||||
Please note that this code doesn't aim to be API feature complete, just
|
||||
functional enough for the RTL code.
|
||||
}
|
||||
|
||||
procedure Amiga2Date(seconds: Cardinal;
|
||||
result : PClockData);
|
||||
begin
|
||||
{$warning Amiga2Date unimplemented!}
|
||||
end;
|
||||
|
||||
function Date2Amiga(date: PClockData): Cardinal;
|
||||
begin
|
||||
{$warning Date2Amiga unimplemented!}
|
||||
Date2Amiga:=0;
|
||||
end;
|
||||
@ -21,6 +21,7 @@
|
||||
*********************************************************************
|
||||
* }
|
||||
|
||||
{$PACKRECORDS 2}
|
||||
|
||||
const
|
||||
UNIT_MICROHZ = 0;
|
||||
@ -38,21 +39,21 @@ const
|
||||
|
||||
type
|
||||
PTimeVal = ^TTimeVal;
|
||||
TTimeVal = packed record
|
||||
TTimeVal = record
|
||||
tv_secs : DWord;
|
||||
tv_micro: DWord;
|
||||
end;
|
||||
|
||||
type
|
||||
PEClockVal = ^TEClockVal;
|
||||
TEClockVal = packed record
|
||||
TEClockVal = record
|
||||
ev_hi: DWord;
|
||||
ev_lo: DWord;
|
||||
end;
|
||||
|
||||
type
|
||||
PTimeRequest = ^TTimeRequest;
|
||||
TTimeRequest = packed record
|
||||
TTimeRequest = record
|
||||
tr_node: TIORequest;
|
||||
tr_time: TTimeVal;
|
||||
end;
|
||||
@ -63,5 +64,3 @@ const
|
||||
TR_GETSYSTIME = (CMD_NONSTD + 1);
|
||||
TR_SETSYSTIME = (CMD_NONSTD + 2);
|
||||
|
||||
|
||||
|
||||
|
||||
@ -403,9 +403,9 @@ function AllocPooled(poolHeader: Pointer location 'a0';
|
||||
memSize : Cardinal location 'd0'): Pointer;
|
||||
SysCall MOS_ExecBase 708;
|
||||
|
||||
function FreePooled(poolHeader: Pointer location 'a0';
|
||||
memory : Pointer location 'a1';
|
||||
memSize : Cardinal location 'd0'): Pointer;
|
||||
procedure FreePooled(poolHeader: Pointer location 'a0';
|
||||
memory : Pointer location 'a1';
|
||||
memSize : Cardinal location 'd0');
|
||||
SysCall MOS_ExecBase 714;
|
||||
|
||||
function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user