Browse Source

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

git-svn-id: trunk@45711 -
Károly Balogh 5 years ago
parent
commit
df42716665
2 changed files with 90 additions and 1 deletions
  1. 85 0
      rtl/amiga/m68k/legacyexec.inc
  2. 5 1
      rtl/amiga/m68k/legacyexech.inc

+ 85 - 0
rtl/amiga/m68k/legacyexec.inc

@@ -48,6 +48,91 @@ end;
 
 
 {$ENDIF NOT AMIGA_V2_0_ONLY}
 {$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
 type
   TAmigaLegacyPoolEntry = record
   TAmigaLegacyPoolEntry = record
     pe_node: TMinNode;
     pe_node: TMinNode;

+ 5 - 1
rtl/amiga/m68k/legacyexech.inc

@@ -21,6 +21,10 @@ function AllocVec(byteSize    : Cardinal;
                   requirements: Cardinal): Pointer; external name '_fpc_amiga_allocvec';
                   requirements: Cardinal): Pointer; external name '_fpc_amiga_allocvec';
 procedure FreeVec(memoryBlock: Pointer); external name '_fpc_amiga_freevec';
 procedure FreeVec(memoryBlock: Pointer); external name '_fpc_amiga_freevec';
 {$ENDIF}
 {$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;
 function CreatePool(requirements: Cardinal;
                     puddleSize  : Cardinal;
                     puddleSize  : Cardinal;
                     threshSize  : Cardinal): Pointer; external name '_fpc_amiga_createpool';
                     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}
 {$IFNDEF AMIGA_V2_0_ONLY}
 procedure StackSwap(newStack: PStackSwapStruct); external name '_fpc_amiga_stackswap';
 procedure StackSwap(newStack: PStackSwapStruct); external name '_fpc_amiga_stackswap';
 procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore); external name '_fpc_amiga_obtainsemaphoreshared';
 procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore); external name '_fpc_amiga_obtainsemaphoreshared';
-{$ENDIF}
+{$ENDIF}