Morphunits: move DoMethod/DoSuperMethod to intuition, Hook Helper to Utility, mark amigalib as deprecated

git-svn-id: trunk@36777 -

packages/morphunits/src/amigalib.pas

@@ -16,15 +16,16 @@
 
  **********************************************************************}
 {$INLINE ON}
-unit amigalib;
+unit amigalib
+  deprecated 'Unit will be removed. Functions are moved to intuition, utility unit.';
 
 interface
 
-function DoMethod(obj : longword; const msg : array of LongWord): longword;
-function DoMethod(obj : pointer; const msg : array of LongWord): longword;
+function DoMethod(obj : longword; const msg : array of LongWord): longword; inline;
+function DoMethod(obj : pointer; const msg : array of LongWord): longword; inline;
 function DoMethodA(obj : longword; msg1 : Pointer): longword; inline;
 
-function DoSuperMethod(class_: longword; obj : longword; const msg : array of LongWord): longword;
+function DoSuperMethod(class_: longword; obj : longword; const msg : array of LongWord): longword; inline;
 function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; inline;
 function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
 
@@ -33,118 +34,57 @@ function DoSuperNew(class_: pointer; obj: pointer; const tags: array of LongWord
 { This procedure is used to pop Dispatcher arguments from the EmulHandle }
 procedure DISPATCHERARG(var cl; var obj; var msg);
 
-function HookEntry: longword;
+function HookEntry: PtrUInt;
 
 implementation
 
-uses exec, intuition, utility;
-
-
-function DoMethodA(obj : longword; msg1 : Pointer): longword;
-var
-  hook: PHook;
-begin
-  hook:=@THook(OCLASS(p_Object(obj))^.cl_Dispatcher);
-  with GetEmulHandle^ do
-    begin
-      reg[regA0]:=longword(hook);
-      reg[regA1]:=longword(msg1);
-      reg[regA2]:=obj;
-
-      { This is magic, but it essentially calls the class Dispatcher Hook entry point }
-      DoMethodA:=EmulCallDirect68k(hook^.h_Entry);
-    end;
-end;
-{
-// the old assembler implementation which trashes r31, kept for reference
-asm
-  mflr r31
-
-  lwz r9,-4(r3)
-  stw r9,32(r2)
-  stw r4,36(r2)
-  stw r3,40(r2)
-
-  lwz r11,104(r2)
-  lwz r3,8(r9)
-  mtlr r11
-  blrl
+uses
+  exec, intuition, utility;
 
-  mtlr r31
-end ['R31'];
-}
 function DoMethod(obj : longword; const msg : array of LongWord): longword; inline;
 begin
-  DoMethod:=DoMethodA(obj, @msg);
+  DoMethod := Intuition.DoMethod(PObject_(Obj), Msg);
 end;
 
 function DoMethod(obj : pointer; const msg : array of LongWord): longword; inline;
 begin
-  DoMethod:=DoMethodA(DWord(obj), @msg);
+  DoMethod := Intuition.DoMethod(PObject_(Obj), Msg);
 end;
 
-function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; inline;
-var
-  hook: PHook;
+function DoMethodA(obj : longword; msg1 : Pointer): longword; inline;
 begin
-  hook:=@PIClass(class_)^.cl_Super^.cl_Dispatcher;
-  with GetEmulHandle^ do
-    begin
-      reg[regA0]:=longword(hook);
-      reg[regA1]:=longword(msg1);
-      reg[regA2]:=obj;
-
-      { This is magic, but it calls the superclass Dispatcher hook entry point }
-      DoSuperMethodA:=EmulCallDirect68k(hook^.h_Entry);
-    end;
+  DoMethodA := Intuition.DoMethodA(PObject_(Obj), msg1);
 end;
-{
-// the old assembler implementation which trashes r31, kept for reference
-asm
-  mflr r31
-
-  lwz r9,24(r3)
-  stw r9,32(r2)
-  stw r5,36(r2)
-  stw r4,40(r2)
 
-  lwz r11,104(r2)
-  lwz r3,8(r9)
-  mtlr r11
-  blrl
-
-  mtlr r31
-end ['R31'];
-}
+function DoSuperMethod(class_: longword; obj : longword; const msg : array of LongWord): longword; inline;
+begin
+  DoSuperMethod := Intuition.DoSuperMethod(PIClass(Class_), PObject_(Obj), Msg);
+end;
 
-function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
+function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; inline;
 begin
-  DoSuperMethodA:=DoSuperMethodA(DWord(class_),DWord(obj),msg1);
+  DoSuperMethodA := Intuition.DoSuperMethodA(PIClass(class_), PObject_(obj), msg1);
 end;
 
-function DoSuperMethod(class_: longword; obj : longword; const msg : array of LongWord): longword;
+function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
 begin
-  DoSuperMethod:=DoSuperMethodA(class_, obj, @msg);
+  DoSuperMethodA := Intuition.DoSuperMethodA(PIClass(class_), PObject_(Obj), Msg1);
 end;
 
 function DoSuperNew(class_: pointer; obj: pointer; const tags: array of LongWord): longword;
-var opSet: topSet;
 begin
-  opSet.MethodID := OM_NEW;
-  opSet.ops_AttrList := @tags;
-  opSet.ops_GInfo := nil;
-  DoSuperNew:=DoSuperMethodA(class_,obj,@opset);
+  DoSuperNew := Intuition.DoSuperNew(PIClass(class_), PObject_(Obj), Tags);
 end;
 
 { This procedure is used to pop Dispatcher arguments from the EmulHandle }
 procedure DISPATCHERARG(var cl; var obj; var msg);
 begin
   with GetEmulHandle^ do
-    begin
-      DWord(cl):=reg[regA0];
-      DWord(obj):=reg[regA2];
-      DWord(msg):=reg[regA1];
-    end;
+  begin
+    PtrUInt(cl) := reg[regA0];
+    PtrUInt(obj) := reg[regA2];
+    PtrUInt(msg) := reg[regA1];
+  end;
 end;
 {
 // assembler implementation, kept for reference
@@ -158,14 +98,14 @@ asm
 end;}
 
 type
-  THookSubEntryFunc = function(a, b, c: Pointer): longword;
+  THookSubEntryFunc = function(a, b, c: Pointer): PtrUInt;
 
-function HookEntry: longword;
+function HookEntry: PtrUInt;
 var
   hook: PHook;
 begin
-  hook:=REG_A0;
-  HookEntry:=THookSubEntryFunc(hook^.h_SubEntry)(hook, REG_A2, REG_A1);
+  hook := REG_A0;
+  HookEntry := THookSubEntryFunc(hook^.h_SubEntry)(hook, REG_A2, REG_A1);
 end;
 
 end.

packages/morphunits/src/intuition.pas

@@ -19,7 +19,7 @@
 
  **********************************************************************}
 {$PACKRECORDS 2}
-
+{$INLINE ON}
 unit intuition;
 
 interface
@@ -3646,6 +3646,13 @@ function ScreenbarControl(const Tags: array of PtrUInt): LongWord; inline;
 { Helper calls }
 function InitIntuitionLibrary : boolean;
 
+function DoMethodA(Obj: PObject_; Msg: Pointer): PtrUInt;
+function DoMethod(obj: PObject_; const Msg: array of PtrUInt): PtrUInt; inline;
+
+function DoSuperMethodA(Cl: PIClass; Obj: PObject_; Message: Pointer): PtrUInt; inline;
+function DoSuperMethod(Cl: PIClass; Obj: PObject_; const Msg: array of PtrUInt): PtrUInt;
+
+function DoSuperNew(Cl: PIClass; Obj: PObject_; const Tags: array of PtrUInt): PtrUInt;
 
 implementation
 
@@ -3799,6 +3806,93 @@ begin
   SUBNUM := (N shr 11) and $1f
 end;
 
+function DoMethodA(Obj: PObject_; Msg: Pointer): PtrUInt;
+var
+  Hook: PHook;
+begin
+  Hook := @THook(OCLASS(P_Object(Obj))^.cl_Dispatcher);
+  with GetEmulHandle^ do
+  begin
+    reg[regA0] := PtrUInt(Hook);
+    reg[regA1] := PtrUInt(Msg);
+    reg[regA2] := PtrUInt(Obj);
+    { This is magic, but it essentially calls the class Dispatcher Hook entry point }
+    DoMethodA := EmulCallDirect68k(hook^.h_Entry);
+  end;
+end;
+{
+// the old assembler implementation which trashes r31, kept for reference
+asm
+  mflr r31
+
+  lwz r9,-4(r3)
+  stw r9,32(r2)
+  stw r4,36(r2)
+  stw r3,40(r2)
+
+  lwz r11,104(r2)
+  lwz r3,8(r9)
+  mtlr r11
+  blrl
+
+  mtlr r31
+end ['R31'];
+}
+
+function DoMethod(obj: PObject_; const Msg: array of PtrUInt): PtrUInt; inline;
+begin
+  DoMethod := DoMethodA(obj, @Msg);
+end;
+
+function DoSuperMethodA(Cl: PIClass; Obj: PObject_; Message: Pointer): PtrUInt; inline;
+var
+  Hook: PHook;
+begin
+  Hook := @PIClass(Cl)^.cl_Super^.cl_Dispatcher;
+  with GetEmulHandle^ do
+  begin
+    reg[regA0] := LongWord(Hook);
+    reg[regA1] := LongWord(Message);
+    reg[regA2] := LongWord(Obj);
+    { This is magic, but it calls the superclass Dispatcher hook entry point }
+    DoSuperMethodA := EmulCallDirect68k(hook^.h_Entry);
+  end;
+end;
+{
+// the old assembler implementation which trashes r31, kept for reference
+asm
+  mflr r31
+
+  lwz r9,24(r3)
+  stw r9,32(r2)
+  stw r5,36(r2)
+  stw r4,40(r2)
+
+  lwz r11,104(r2)
+  lwz r3,8(r9)
+  mtlr r11
+  blrl
+
+  mtlr r31
+end ['R31'];
+}
+
+function DoSuperMethod(Cl: PIClass; Obj: PObject_; const Msg: array of PtrUInt): PtrUInt;
+begin
+  DoSuperMethod:=DoSuperMethodA(Cl, obj, @msg);
+end;
+
+function DoSuperNew(Cl: PIClass; Obj: PObject_; const Tags: array of PtrUInt): PtrUInt;
+var
+  OpSet: TopSet;
+begin
+  OpSet.MethodID := OM_NEW;
+  OpSet.ops_AttrList := @Tags;
+  OpSet.ops_GInfo := nil;
+  DoSuperNew := DoSuperMethodA(Cl, Obj, @OpSet);
+end;
+
+
 const
   { Change VERSION and LIBVERSION to proper values }
   VERSION : string[2] = '50';

packages/morphunits/src/utility.pas

@@ -223,6 +223,11 @@ function AsTag(Value: Boolean): PtrUInt; overload; inline;
 function AsTag(Value: LongInt): PtrUInt; overload; inline;
 function AsTag(Value: LongWord): PtrUInt; overload; inline;
 
+// Hook and Dispatcher Helper
+{ This procedure is used to pop Dispatcher arguments from the EmulHandle }
+procedure DISPATCHERARG(var cl; var obj; var msg);
+function HookEntry: PtrUInt;
+
 implementation
 
 function AllocNamedObject(Name: STRPTR; const Tags: array of PtrUInt): PNamedObject; inline;
@@ -286,6 +291,38 @@ begin
   AsTag := PtrUInt(Value);
 end;
 
+{ This procedure is used to pop Dispatcher arguments from the EmulHandle }
+procedure DISPATCHERARG(var cl; var obj; var msg);
+begin
+  with GetEmulHandle^ do
+  begin
+    PtrUInt(cl) := reg[regA0];
+    PtrUInt(obj) := reg[regA2];
+    PtrUInt(msg) := reg[regA1];
+  end;
+end;
+{
+// assembler implementation, kept for reference
+asm
+  lwz r6,32(r2) // REG_a0
+  stw r6,(r3)   // cl
+  lwz r6,40(r2) // REG_a2
+  stw r6,(r4)   // obj
+  lwz r6,36(r2) // REG_a1
+  stw r6,(r5)   // msg
+end;}
+
+type
+  THookSubEntryFunc = function(a, b, c: Pointer): PtrUInt;
+
+function HookEntry: PtrUInt;
+var
+  hook: PHook;
+begin
+  hook := REG_A0;
+  HookEntry := THookSubEntryFunc(hook^.h_SubEntry)(hook, REG_A2, REG_A1);
+end;
+
 begin
   UtilityBase := MOS_UtilityBase;
 end.