amunits: move DoMethod/DoSuperMethod to intuition, Hook Helper to Utility, exec helper to exec, commodities macros to commodities, mark amigalib as deprecated

git-svn-id: trunk@36778 -

packages/amunits/src/coreunits/amigalib.pas

@@ -47,61 +47,60 @@
 
     [email protected]
 }
-
+{$INLINE ON}
 {$mode objfpc}
-{$I useamigasmartlink.inc}
-{$ifdef use_amiga_smartlink}
-    {$smartlink on}
-{$endif use_amiga_smartlink}
-
-unit amigalib;
+unit amigalib
+  deprecated 'Unit will be removed. Functions are moved to exec, intuition, utility and commodities unit.';
 
 
 INTERFACE
 
 uses exec,intuition,utility,commodities,inputevent,amigados;
 
+// moved to exec, use them from there
 {*  Exec support functions from amiga.lib  *}
 
-procedure BeginIO (ioRequest: pIORequest);
-function CreateExtIO (port: pMsgPort; size: Longint): pIORequest;
-procedure DeleteExtIO (ioReq: pIORequest);
-function CreateStdIO (port: pMsgPort): pIOStdReq;
-procedure DeleteStdIO (ioReq: pIOStdReq);
-function CreatePort (name: PChar; pri: longint): pMsgPort;
-procedure DeletePort (port: pMsgPort);
+procedure BeginIO (ioRequest: pIORequest); inline;
+function CreateExtIO (port: pMsgPort; size: Longint): pIORequest; inline;
+procedure DeleteExtIO (ioReq: pIORequest); inline;
+function CreateStdIO (port: pMsgPort): pIOStdReq; inline;
+procedure DeleteStdIO (ioReq: pIOStdReq); inline;
+function CreatePort (name: PChar; pri: longint): pMsgPort; inline;
+procedure DeletePort (port: pMsgPort); inline;
 function CreateTask (name: STRPTR; pri: longint;
                      initPC : Pointer;
-             stackSize : ULONG): pTask;
-procedure DeleteTask (task: pTask);
-procedure NewList (list: pList);
+             stackSize : ULONG): pTask; inline;
+procedure DeleteTask (task: pTask); inline;
+procedure NewList (list: pList); inline;
 
+// moved to commodities, use them from there
 {* Commodities support functions from amiga.lib *}
-procedure FreeIEvents (events: pInputEvent);
+procedure FreeIEvents (events: pInputEvent); inline;
 function CxCustom
                 (action: pointer;
-                id: longint): pCxObj;
+                id: longint): pCxObj; inline;
 
-function CxDebug (id: long): pCxObj;
-function CxFilter (d: STRPTR): pCxObj;
+function CxDebug (id: long): pCxObj; inline;
+function CxFilter (d: STRPTR): pCxObj; inline;
 function CxSender
                 (port: pMsgPort;
-                id: longint): pCxObj;
+                id: longint): pCxObj; inline;
 
 function CxSignal
                 (task: pTask;
-                sig: byte): pCxObj;
-
-function CxTranslate (ie: pInputEvent): pCxObj;
+                sig: byte): pCxObj; inline;
 
+function CxTranslate (ie: pInputEvent): pCxObj; inline;
 
-function DoMethodA(obj : pObject_; msg : APTR): ulong;
-function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
-function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
-function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong;
+// moved to intuition, use them from there
+function DoMethodA(obj : pObject_; msg : APTR): ulong; inline;
+function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong; inline;
+function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong; inline;
+function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong; inline;
 
 function DoMethod(obj: PObject_; Params: array of DWord): LongWord; inline;
 
+// moved to utility, use them from there
 procedure HookEntry;
 procedure HookEntryPas;
 
@@ -171,231 +170,115 @@ IMPLEMENTATION
 
 {*  Exec support functions from amiga.lib  *}
 
-procedure BeginIO (ioRequest: pIORequest);
+procedure BeginIO (ioRequest: pIORequest); inline;
 begin
-   asm
-      move.l  a6,-(a7)
-      move.l  ioRequest,a1    ; get IO Request
-      move.l  20(a1),a6      ; extract Device ptr
-      jsr     -30(a6)        ; call BEGINIO directly
-      move.l  (a7)+,a6
-   end;
+  Exec.BeginIO(ioRequest);
 end;
 
-function CreateExtIO (port: pMsgPort; size: Longint): pIORequest;
-var
-   IOReq: pIORequest;
+function CreateExtIO (port: pMsgPort; size: Longint): pIORequest; inline;
 begin
-    IOReq := NIL;
-    if port <> NIL then
-    begin
-        IOReq := ExecAllocMem(size, MEMF_CLEAR or MEMF_PUBLIC);
-        if IOReq <> NIL then
-        begin
-            IOReq^.io_Message.mn_Node.ln_Type   := NT_REPLYMSG;
-            IOReq^.io_Message.mn_Length    := size;
-            IOReq^.io_Message.mn_ReplyPort := port;
-        end;
-    end;
-    CreateExtIO := IOReq;
+  CreateExtIO := Exec.CreateExtIO(port, size);
 end;
 
-
-procedure DeleteExtIO (ioReq: pIORequest);
+procedure DeleteExtIO (ioReq: pIORequest); inline;
 begin
-    if ioReq <> NIL then
-    begin
-        ioReq^.io_Message.mn_Node.ln_Type := $FF;
-        ioReq^.io_Message.mn_ReplyPort    := pMsgPort(-1);
-        ioReq^.io_Device                  := pDevice(-1);
-        ExecFreeMem(ioReq, ioReq^.io_Message.mn_Length);
-    end
+  Exec.DeleteExtIO(ioReq);
 end;
 
-
-function CreateStdIO (port: pMsgPort): pIOStdReq;
+function CreateStdIO (port: pMsgPort): pIOStdReq; inline;
 begin
-    CreateStdIO := pIOStdReq(CreateExtIO(port, sizeof(tIOStdReq)))
+    CreateStdIO := Exec.CreateStdIO(port)
 end;
 
-
-procedure DeleteStdIO (ioReq: pIOStdReq);
+procedure DeleteStdIO (ioReq: pIOStdReq); inline;
 begin
-    DeleteExtIO(pIORequest(ioReq))
+    Exec.DeleteStdIO(ioReq)
 end;
 
-
-function Createport(name : PChar; pri : longint): pMsgPort;
-var
-   sigbit : Byte;
-   port    : pMsgPort;
+function Createport(name : PChar; pri : longint): pMsgPort; inline;
 begin
-   sigbit := AllocSignal(-1);
-   if sigbit = -1 then CreatePort := nil;
-   port := ExecAllocmem(sizeof(tMsgPort),MEMF_CLEAR or MEMF_PUBLIC);
-   if port = nil then begin
-      FreeSignal(sigbit);
-      CreatePort := nil;
-   end;
-   with port^ do begin
-       if assigned(name) then
-       mp_Node.ln_Name := name
-       else mp_Node.ln_Name := nil;
-       mp_Node.ln_Pri := pri;
-       mp_Node.ln_Type := NT_MsgPort;
-       mp_Flags := PA_Signal;
-       mp_SigBit := sigbit;
-       mp_SigTask := FindTask(nil);
-   end;
-   if assigned(name) then AddPort(port)
-   else NewList(addr(port^.mp_MsgList));
-   CreatePort := port;
+  Createport := Exec.Createport(name, pri);
 end;
 
-procedure DeletePort (port: pMsgPort);
+procedure DeletePort (port: pMsgPort); inline;
 begin
-    if port <> NIL then
-    begin
-        if port^.mp_Node.ln_Name <> NIL then
-            RemPort(port);
-
-        port^.mp_Node.ln_Type     := $FF;
-        port^.mp_MsgList.lh_Head  := pNode(-1);
-        FreeSignal(port^.mp_SigBit);
-        ExecFreeMem(port, sizeof(tMsgPort));
-    end;
+  Exec.DeletePort(port);
 end;
 
-
-function CreateTask (name: STRPTR; pri: longint;
-        initPC: pointer; stackSize: ULONG): pTask;
-var
-   memlist : pMemList;
-   task    : pTask;
-   totalsize : Longint;
+function CreateTask (name: STRPTR; pri: longint; initPC: pointer; stackSize: ULONG): pTask; inline;
 begin
-    task  := NIL;
-    stackSize   := (stackSize + 3) and not 3;
-    totalsize := sizeof(tMemList) + sizeof(tTask) + stackSize;
-
-    memlist := ExecAllocMem(totalsize, MEMF_PUBLIC + MEMF_CLEAR);
-    if memlist <> NIL then begin
-       memlist^.ml_NumEntries := 1;
-       memlist^.ml_ME[0].me_Un.meu_Addr := Pointer(memlist + 1);
-       memlist^.ml_ME[0].me_Length := totalsize - sizeof(tMemList);
-
-       task := pTask(memlist + sizeof(tMemList) + stackSize);
-       task^.tc_Node.ln_Pri := pri;
-       task^.tc_Node.ln_Type := NT_TASK;
-       task^.tc_Node.ln_Name := name;
-       task^.tc_SPLower := Pointer(memlist + sizeof(tMemList));
-       task^.tc_SPUpper := Pointer(task^.tc_SPLower + stackSize);
-       task^.tc_SPReg := task^.tc_SPUpper;
-
-       NewList(@task^.tc_MemEntry);
-       AddTail(@task^.tc_MemEntry,@memlist^.ml_Node);
-
-       AddTask(task,initPC,NIL)
-    end;
-    CreateTask := task;
+  CreateTask := Exec.CreateTask(name, pri, initPC, stacksize);
 end;
 
-
-procedure DeleteTask (task: pTask);
+procedure DeleteTask (task: pTask); inline;
 begin
-    RemTask(task)
+  Exec.DeleteTask(task)
 end;
 
-
-procedure NewList (list: pList);
+procedure NewList (list: pList); inline;
 begin
-    with list^ do
-    begin
-        lh_Head     := pNode(@lh_Tail);
-        lh_Tail     := NIL;
-        lh_TailPred := pNode(@lh_Head)
-    end
+  Exec.NewList(list);
 end;
 
-procedure FreeIEvents (events: pInputEvent);
+
+procedure FreeIEvents (events: pInputEvent); inline;
 begin
-        while events <> NIL do
-        begin
-                FreeMem (events, sizeof (tInputEvent));
-                events := events^.ie_NextEvent
-        end
+  Commodities.FreeIEvents(events);
 end;
 
-function CxCustom
-                (action: pointer;
-                id: longint): pCxObj;
+function CxCustom(action: pointer; id: longint): pCxObj; inline;
 begin
-        CxCustom := CreateCxObj(CX_CUSTOM, longint(action), id)
+  CxCustom := Commodities.CxCustom(action, id)
 end;
 
-function CxDebug (id: long): pCxObj;
+function CxDebug(id: long): pCxObj; inline;
 begin
-        CxDebug := CreateCxObj(CX_DEBUG, id, 0)
+  CxDebug := Commodities.CxDebug(id)
 end;
 
-function CxFilter (d: STRPTR): pCxObj;
+function CxFilter(d: STRPTR): pCxObj; inline;
 begin
-        CxFilter := CreateCxObj(CX_FILTER, longint(d), 0)
+  CxFilter := Commodities.CxFilter(d);
 end;
 
-function CxSender
-                (port: pMsgPort;
-                id: longint): pCxObj;
+function CxSender(port: pMsgPort; id: longint): pCxObj; inline;
 begin
-        CxSender := CreateCxObj(CX_SEND, longint(port), id)
+  CxSender := Commodities.CxSender(port, id)
 end;
 
-function CxSignal
-                (task: pTask;
-                sig: byte): pCxObj;
+function CxSignal(task: pTask; sig: byte): pCxObj; inline;
 begin
-        CxSignal:= CreateCxObj(CX_SIGNAL, longint(task), sig)
+  CxSignal:= Commodities.CxSignal(task, sig)
 end;
 
 function CxTranslate (ie: pInputEvent): pCxObj;
 begin
-        CxTranslate := CreateCxObj(CX_TRANSLATE, longint(ie), 0)
+  CxTranslate := Commodities.CxTranslate(ie)
 end;
 
-function DoMethodA(obj : pObject_; msg : APTR): ulong;
+function DoMethodA(obj : pObject_; msg : APTR): ulong; inline;
 begin
-    if assigned(obj) then begin
-       DoMethodA := CallHookPkt(@THook(OCLASS(obj)^.cl_Dispatcher), obj, msg);
-    end else DoMethodA := 0;
+  DoMethodA := Intuition.DoMethodA(obj, msg);
 end;
 
-function DoMethod(obj: PObject_; Params: array of DWord): LongWord;
+function DoMethod(obj: PObject_; Params: array of DWord): LongWord; inline;
 begin
-  DoMethod := DoMethodA(obj, @Params);
+  DoMethod := Intuition.DoMethodA(obj, @Params);
 end;
 
-function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
+function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong; inline;
 begin
-    if assigned(obj) and assigned(cl) then
-       DoSuperMethodA := CallHookPkt(@cl^.cl_Super^.cl_Dispatcher,obj,msg)
-    else DoSuperMethodA := 0;
+  DoSuperMethodA := Intuition.DoSuperMethodA(cl, obj, msg);
 end;
 
-function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
+function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong; inline;
 begin
-    if assigned(cl) and assigned(obj) then
-       CoerceMethodA := CallHookPkt(@cl^.cl_Dispatcher,obj,msg)
-    else CoerceMethodA := 0;
+  CoerceMethodA := Intuition.CoerceMethodA(cl, obj, msg);
 end;
 
-function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong;
-var
-    arr : array[0..2] of longint;
+function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong; inline;
 begin
-    arr[0] := OM_SET;
-    arr[1] := longint(msg);
-    arr[2] := 0;
-    SetSuperAttrsA := DoSuperMethodA(cl, obj, @arr);
+  SetSuperAttrsA := Intuition.SetSuperAttrsA(cl, obj, msg);
 end;
 
 { Do *NOT* change this to nostackframe! }

packages/amunits/src/coreunits/commodities.pas

@@ -262,6 +262,13 @@ PROCEDURE SetTranslate(translator : pCxObj location 'a0'; events : pInputEvent l
 FUNCTION ParseIX(description : rawbytestring; ix : pInputXpression) : LONGINT;
 PROCEDURE SetFilter(filter : pCxObj; text : rawbytestring);
 
+procedure FreeIEvents(Events: PInputEvent);
+function CxCustom(Action: Pointer; Id: LongInt): PCxObj;
+function CxDebug(Id: LongInt): PCxObj;
+function CxFilter(d: STRPTR): PCxObj;
+function CxSender(Port: PMsgPort; Id: LongInt): PCxObj;
+function CxSignal(Task: PTask; Sig: Byte): PCxObj;
+function CxTranslate(Ie: PInputEvent): PCxObj;
 
 IMPLEMENTATION
 
@@ -276,6 +283,45 @@ begin
   SetFilter(filter,pchar(text));
 end;
 
+procedure FreeIEvents(Events: PInputEvent);
+begin
+  while Events <> nil do
+  begin
+    FreeMem(Events, SizeOf(TInputEvent));
+    Events := Events^.ie_NextEvent;
+  end
+end;
+
+function CxCustom(Action: Pointer; Id: LongInt): PCxObj;
+begin
+  CxCustom := CreateCxObj(CX_CUSTOM, LongInt(Action), Id);
+end;
+
+function CxDebug(Id: LongInt): PCxObj;
+begin
+  CxDebug := CreateCxObj(CX_DEBUG, Id, 0);
+end;
+
+function CxFilter(d: STRPTR): PCxObj;
+begin
+  CxFilter := CreateCxObj(CX_FILTER, LongInt(d), 0);
+end;
+
+function CxSender(Port: PMsgPort; Id: LongInt): PCxObj;
+begin
+  CxSender := CreateCxObj(CX_SEND, LongInt(Port), Id);
+end;
+
+function CxSignal(Task: PTask; Sig: Byte): PCxObj;
+begin
+  CxSignal:= CreateCxObj(CX_SIGNAL, LongInt(Task), Sig);
+end;
+
+function CxTranslate(Ie: PInputEvent): PCxObj;
+begin
+  CxTranslate := CreateCxObj(CX_TRANSLATE, LongInt(Ie), 0);
+end;
+
 const
     { Change VERSION and LIBVERSION to proper values }
     VERSION : string[2] = '0';

packages/amunits/src/coreunits/exec.pas

@@ -1321,6 +1321,17 @@ function BitMask(no :shortint): longint;
 function IsListEmpty( list : pList): boolean;
 function IsMsgPortEmpty( mp : pMsgPort): boolean;
 
+procedure BeginIO(IORequest: PIORequest);
+function CreateExtIO(Port: PMsgPort; Size: LongInt): PIORequest;
+procedure DeleteExtIO(IOReq: PIORequest);
+function CreateStdIO(Port: PMsgPort): PIOStdReq;
+procedure DeleteStdIO(IOReq: PIOStdReq);
+function CreatePort(Name: PChar; Pri: LongInt): PMsgPort;
+procedure DeletePort(Port: PMsgPort);
+function CreateTask(Name: STRPTR; Pri: LongInt; InitPC: Pointer; StackSize: LongWord): PTask;
+procedure DeleteTask(Task: PTask);
+procedure NewList(List: PList);
+
 IMPLEMENTATION
 
 function BitMask(no :shortint): longint; inline;
@@ -1390,4 +1401,158 @@ BEGIN
     RawDoFmt := RawDoFmt(PChar(RawByteString(formatString)),dataStream,putChProc,putChData);
 END;
 
+
+procedure BeginIO(IORequest: PIORequest);
+begin
+  asm
+    move.l  a6,-(a7)
+    move.l  ioRequest,a1    ; get IO Request
+    move.l  20(a1),a6      ; extract Device ptr
+    jsr     -30(a6)        ; call BEGINIO directly
+    move.l  (a7)+,a6
+  end;
+end;
+
+function CreateExtIO(Port: PMsgPort; Size: LongInt): PIORequest;
+var
+   IOReq: PIORequest;
+begin
+  IOReq := nil;
+  if port <> nil then
+  begin
+    IOReq := ExecAllocMem(Size, MEMF_CLEAR or MEMF_PUBLIC);
+    if IOReq <> nil then
+    begin
+      IOReq^.io_Message.mn_Node.ln_Type := NT_REPLYMSG;
+      IOReq^.io_Message.mn_Length := Size;
+      IOReq^.io_Message.mn_ReplyPort := Port;
+    end;
+  end;
+  CreateExtIO := IOReq;
+end;
+
+
+procedure DeleteExtIO(IOReq: PIORequest);
+begin
+  if IOReq <> nil then
+  begin
+    IOReq^.io_Message.mn_Node.ln_Type := $FF;
+    IOReq^.io_Message.mn_ReplyPort := PMsgPort(-1);
+    IOReq^.io_Device := PDevice(-1);
+    ExecFreeMem(IOReq, IOReq^.io_Message.mn_Length);
+  end
+end;
+
+
+function CreateStdIO(Port: PMsgPort): PIOStdReq;
+begin
+  CreateStdIO := PIOStdReq(CreateExtIO(Port, SizeOf(TIOStdReq)))
+end;
+
+
+procedure DeleteStdIO(IOReq: PIOStdReq);
+begin
+  DeleteExtIO(PIORequest(IOReq))
+end;
+
+
+function CreatePort(Name: PChar; Pri: LongInt): PMsgPort;
+var
+  SigBit: Byte;
+  Port: PMsgPort;
+begin
+  SigBit := AllocSignal(-1);
+  if SigBit = -1 then
+  begin
+    CreatePort := nil;
+    Exit;
+  end;
+  Port := ExecAllocmem(SizeOf(TMsgPort), MEMF_CLEAR or MEMF_PUBLIC);
+  if Port = nil then
+  begin
+    FreeSignal(SigBit);
+    CreatePort := nil;
+    Exit;
+  end;
+  with Port^ do
+  begin
+    if Assigned(Name) then
+      mp_Node.ln_Name := Name
+    else
+      mp_Node.ln_Name := nil;
+    mp_Node.ln_Pri := Pri;
+    mp_Node.ln_Type := NT_MsgPort;
+    mp_Flags := PA_Signal;
+    mp_SigBit := SigBit;
+    mp_SigTask := FindTask(nil);
+  end;
+  if Assigned(Name) then
+    AddPort(Port)
+  else
+    NewList(Addr(Port^.mp_MsgList));
+  CreatePort := Port;
+end;
+
+procedure DeletePort(Port: PMsgPort);
+begin
+  if Port <> nil then
+  begin
+    if Port^.mp_Node.ln_Name <> nil then
+      RemPort(port);
+    Port^.mp_Node.ln_Type := $FF;
+    Port^.mp_MsgList.lh_Head := PNode(-1);
+    FreeSignal(Port^.mp_SigBit);
+    ExecFreeMem(Port, SizeOf(TMsgPort));
+  end;
+end;
+
+function CreateTask(Name: STRPTR; Pri: LongInt; InitPC: Pointer; StackSize: LongWord): PTask;
+var
+  Memlist: PMemList;
+  Task: PTask;
+  TotalSize: LongInt;
+begin
+  task := nil;
+  StackSize := (StackSize + 3) and not 3;
+  TotalSize := SizeOf(TMemList) + SizeOf(TTask) + StackSize;
+
+  Memlist := ExecAllocMem(TotalSize, MEMF_PUBLIC + MEMF_CLEAR);
+  if MemList <> nil then
+  begin
+    MemList^.ml_NumEntries := 1;
+    MemList^.ml_ME[0].me_Un.meu_Addr := Pointer(MemList + 1);
+    MemList^.ml_ME[0].me_Length := TotalSize - SizeOf(TMemList);
+
+    Task := PTask(MemList + SizeOf(TMemList) + StackSize);
+    Task^.tc_Node.ln_Pri := Pri;
+    Task^.tc_Node.ln_Type := NT_TASK;
+    Task^.tc_Node.ln_Name := Name;
+    Task^.tc_SPLower := Pointer(MemList + SizeOf(TMemList));
+    Task^.tc_SPUpper := Pointer(Task^.tc_SPLower + StackSize);
+    Task^.tc_SPReg := Task^.tc_SPUpper;
+
+    NewList(@Task^.tc_MemEntry);
+    AddTail(@Task^.tc_MemEntry,@MemList^.ml_Node);
+
+    AddTask(Task, InitPC, nil)
+  end;
+  CreateTask := Task;
+end;
+
+procedure DeleteTask (task: pTask);
+begin
+    RemTask(task)
+end;
+
+
+procedure NewList (list: pList);
+begin
+    with list^ do
+    begin
+        lh_Head     := pNode(@lh_Tail);
+        lh_Tail     := NIL;
+        lh_TailPred := pNode(@lh_Head)
+    end
+end;
+
 END. (* UNIT EXEC *)

packages/amunits/src/coreunits/intuition.pas

@@ -4227,6 +4227,13 @@ PROCEDURE SetDefaultPubScreen(const name : string);
 FUNCTION TimedDisplayAlert(alertNumber : ULONG;const string_ : string; height : ULONG; time : ULONG) : BOOLEAN;
 PROCEDURE UnlockPubScreen(const name : string; screen : pScreen);
 
+function DoMethodA(Obj: PObject_; Msg: APTR): PtrUInt;
+function DoSuperMethodA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt;
+function CoerceMethodA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt;
+function SetSuperAttrsA(Cl: PIClass; Obj: PObject_; Msg : APTR): PtrUInt;
+
+function DoMethod(Obj: PObject_; Params: array of PtrUInt): LongWord; inline;
+
 IMPLEMENTATION
 
 function OpenScreenTags(newScreen : pNewScreen; tagList : array of PtrUInt) : pScreen;
@@ -4413,6 +4420,48 @@ begin
       UnlockPubScreen(PChar(RawByteString(name)),screen);
 end;
 
+
+function DoMethodA(Obj: PObject_; Msg: APTR): PtrUInt;
+begin
+  if Assigned(Obj) then
+  begin
+    DoMethodA := CallHookPkt(@THook(OCLASS(Obj)^.cl_Dispatcher), Obj, Msg);
+  end
+  else
+    DoMethodA := 0;
+end;
+
+function DoMethod(Obj: PObject_; Params: array of PtrUInt): PtrUInt;
+begin
+  DoMethod := DoMethodA(Obj, @Params);
+end;
+
+function DoSuperMethodA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt;
+begin
+  if Assigned(Obj) and Assigned(Cl) then
+    DoSuperMethodA := CallHookPkt(@Cl^.cl_Super^.cl_Dispatcher, Obj, Msg)
+  else
+    DoSuperMethodA := 0;
+end;
+
+function CoerceMethodA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt;
+begin
+  if Assigned(Cl) and Assigned(Obj) then
+    CoerceMethodA := CallHookPkt(@Cl^.cl_Dispatcher, Obj, Msg)
+  else
+    CoerceMethodA := 0;
+end;
+
+function SetSuperAttrsA(Cl: PIClass; Obj: PObject_; Msg: APTR): PtrUInt;
+var
+  arr: array[0..2] of PtrUInt;
+begin
+  arr[0] := OM_SET;
+  arr[1] := PtrUInt(Msg);
+  arr[2] := 0;
+  SetSuperAttrsA := DoSuperMethodA(Cl, Obj, @arr);
+end;
+
 initialization
   IntuitionBase := pIntuitionBase(_IntuitionBase);
 END. (* UNIT INTUITION *)

packages/amunits/src/coreunits/utility.pas

@@ -403,6 +403,9 @@ function AsTag(value: boolean): PtrUInt; overload; inline;
 function AsTag(value: LongInt): PtrUInt; overload; inline;
 function AsTag(Value: LongWord): PtrUInt; overload; inline;
 
+procedure HookEntry;
+procedure HookEntryPas;
+
 IMPLEMENTATION
 
 function AllocNamedObject(name : STRPTR; Const argv : array of PtrUInt) : pNamedObject;
@@ -507,6 +510,35 @@ begin
   AsTag := PtrUInt(Value);
 end;
 
+{ Do *NOT* change this to nostackframe! }
+{ The compiler will build a stackframe with link/unlk. So that will actually correct
+  the stackpointer for both Pascal/StdCall and Cdecl functions, so the stackpointer
+  will be correct on exit. It also needs no manual RTS. The argument push order is
+  also correct for both. (KB) }
+procedure HookEntry; assembler;
+asm
+  move.l a1,-(a7)    // Msg
+  move.l a2,-(a7)    // Obj
+  move.l a0,-(a7)    // PHook
+  move.l 12(a0),a0   // h_SubEntry = Offset 12
+  jsr (a0)           // Call the SubEntry
+end;
+
+{ This is to be used with when the subentry function uses FPC's register calling
+  convention, also see the comments above HookEntry. It is advised to actually
+  declare Hook functions with cdecl instead of using this function, especially
+  when writing code which is platform independent. (KB) }
+procedure HookEntryPas; assembler;
+asm
+  move.l a2,-(a7)
+  move.l a1,-(a7)    // Msg
+  move.l a2,a1       // Obj
+                     // PHook is in a0 already
+  move.l 12(a0),a2   // h_SubEntry = Offset 12
+  jsr (a2)           // Call the SubEntry
+  move.l (a7)+,a2
+end;
+
 initialization
   UtilityBase := _UtilityBase;
 end.