paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 20:29:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

m68k-amiga: added four new exec legacy support functions, these exec calls will be used in some DOS and AThreads rework

Browse Source 
git-svn-id: trunk@45711 -
This commit is contained in:
Károly Balogh 2020-06-28 22:05:05 +00:00
parent c29a0d029b
commit df42716665
2 changed files with 90 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
rtl/amiga/m68k/legacyexec.inc
View File

@ -48,6 +48,91 @@ end;
{$ENDIF NOT AMIGA_V2_0_ONLY}
procedure NewList(list: PList);
begin
with list^ do
begin
lh_Head := pNode(@lh_Tail);
lh_Tail := nil;
lh_TailPred := pNode(@lh_Head);
end;
end;
function CreateMsgPort: PMsgPort; public name '_fpc_amiga_createmsgport';
var
sigbit : ShortInt;
msgPort : PMsgPort;
begin
CreateMsgPort:=nil;
sigbit := AllocSignal(-1);
if sigbit = -1 then
exit;
msgPort := execAllocMem(sizeof(TMsgPort),MEMF_CLEAR);
if not assigned(msgPort) then
begin
FreeSignal(sigbit);
exit;
end;
with msgPort^ do
begin
mp_Node.ln_Name := nil;
mp_Node.ln_Pri := 0;
mp_Node.ln_Type := 4;
mp_Flags := 0;
mp_SigBit := sigbit;
mp_SigTask := FindTask(nil);
end;
NewList(addr(msgPort^.mp_MsgList));
CreateMsgPort := msgPort;
end;
procedure DeleteMsgPort(const msgPort: PMsgPort); public name '_fpc_amiga_deletemsgport';
begin
if assigned(msgPort) then
with msgPort^ do
begin
mp_Node.ln_Type := $FF;
mp_MsgList.lh_Head := PNode(PtrUInt(-1));
FreeSignal(mp_SigBit);
execFreeMem(msgPort, sizeof(TMsgPort));
end;
end;
function CreateIORequest(const msgPort: PMsgPort; size: Longint): PIORequest; public name '_fpc_amiga_createiorequest';
var
IOReq: PIORequest;
begin
IOReq:=nil;
if assigned(msgPort) then
begin
IOReq := execAllocMem(size, MEMF_CLEAR);
if assigned(IOReq) then
with IOReq^ do
begin
io_Message.mn_Node.ln_Type := 7;
io_Message.mn_Length := size;
io_Message.mn_ReplyPort := msgPort;
end;
end;
CreateIORequest := IOReq;
end;
procedure DeleteIORequest(IOReq: PIORequest); public name '_fpc_amiga_deleteiorequest';
begin
if assigned(IOReq) then
with IOReq^ do
begin
io_Message.mn_Node.ln_Type := $FF;
io_Message.mn_ReplyPort := PMsgPort(PtrUInt(-1));
io_Device := PDevice(PtrUInt(-1));
execFreeMem(ioReq, io_Message.mn_Length);
end;
end;
type
TAmigaLegacyPoolEntry = record
pe_node: TMinNode;

6
rtl/amiga/m68k/legacyexech.inc
View File

@ -21,6 +21,10 @@ function AllocVec(byteSize : Cardinal;
requirements: Cardinal): Pointer; external name '_fpc_amiga_allocvec';
procedure FreeVec(memoryBlock: Pointer); external name '_fpc_amiga_freevec';
{$ENDIF}
function CreateMsgPort: PMsgPort; external name '_fpc_amiga_createmsgport';
procedure DeleteMsgPort(const msgPort: PMsgPort); external name '_fpc_amiga_deletemsgport';
function CreateIORequest(const msgPort: PMsgPort; size: Longint): PIORequest; external name '_fpc_amiga_createiorequest';
procedure DeleteIORequest(IOReq: PIORequest); external name '_fpc_amiga_deleteiorequest';
function CreatePool(requirements: Cardinal;
puddleSize : Cardinal;
threshSize : Cardinal): Pointer; external name '_fpc_amiga_createpool';
@ -33,4 +37,4 @@ procedure DeletePool(poolHeader: Pointer); external name '_fpc_amiga_deletepool'
{$IFNDEF AMIGA_V2_0_ONLY}
procedure StackSwap(newStack: PStackSwapStruct); external name '_fpc_amiga_stackswap';
procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore); external name '_fpc_amiga_obtainsemaphoreshared';
{$ENDIF}
{$ENDIF}