morphunits: amigalib rework

* use Pascal implementations instead of assembler for DoMethodA, DoSuperMethodA and DISPATCHERARG
* the above fixed trasing of register r31 in DoMethodA and DoSuperMethodA
* these implementations might not be that optimal, but easier to understand and more maintainable on the long run
* depends on the newly added EmulHandle stuff in exec
* use const arguments for array of ... stuff where possible

git-svn-id: trunk@32701 -

packages/morphunits/src/amigalib.pas

@@ -1,11 +1,11 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2005 Karoly Balogh
+    Copyright (c) 2005-2015 Karoly Balogh
 
     abox.lib implementation for MorphOS/PowerPC
 
     MorphOS port was done on a free Pegasos II/G4 machine
-    provided by Genesi S.a.r.l. <www.genesi.lu>
+    provided by Genesi
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -15,23 +15,23 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
+{$INLINE ON}
 unit amigalib;
 
 interface
 
-function DoMethod(obj : longword; msg : array of LongWord): longword;
-function DoMethod(obj : pointer; msg : array of LongWord): longword; inline;
-function DoMethodA(obj : longword; msg1 : Pointer): longword; assembler;
+function DoMethod(obj : longword; const msg : array of LongWord): longword;
+function DoMethod(obj : pointer; const msg : array of LongWord): longword;
+function DoMethodA(obj : longword; msg1 : Pointer): longword; inline;
 
-function DoSuperMethod(class_: longword; obj : longword; msg : array of LongWord): longword;
-function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; assembler;
+function DoSuperMethod(class_: longword; obj : longword; const msg : array of LongWord): longword;
+function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; inline;
 function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
 
-function DoSuperNew(class_: pointer; obj: pointer; tags: array of LongWord): longword;
+function DoSuperNew(class_: pointer; obj: pointer; const tags: array of LongWord): longword;
 
-// This procedure is used to pop dispatcher args from emulstruc
-procedure DISPATCHERARG(var cl; var obj; var msg); assembler;
+{ This procedure is used to pop Dispatcher arguments from the EmulHandle }
+procedure DISPATCHERARG(var cl; var obj; var msg);
 
 function HookEntry: longword;
 
@@ -39,7 +39,24 @@ implementation
 
 uses exec, intuition, utility;
 
-function DoMethodA(obj : longword; msg1 : Pointer): longword; assembler;
+
+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
 
@@ -55,18 +72,34 @@ asm
 
   mtlr r31
 end ['R31'];
-
-function DoMethod(obj : longword; msg : array of LongWord): longword;
+}
+function DoMethod(obj : longword; const msg : array of LongWord): longword; inline;
 begin
   DoMethod:=DoMethodA(obj, @msg);
 end;
 
-function DoMethod(obj : pointer; msg : array of LongWord): longword; inline;
+function DoMethod(obj : pointer; const msg : array of LongWord): longword; inline;
 begin
   DoMethod:=DoMethodA(DWord(obj), @msg);
 end;
 
-function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; assembler;
+function DoSuperMethodA(class_: longword; obj : longword; msg1 : Pointer): longword; inline;
+var
+  hook: PHook;
+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;
+end;
+{
+// the old assembler implementation which trashes r31, kept for reference
 asm
   mflr r31
 
@@ -82,18 +115,19 @@ asm
 
   mtlr r31
 end ['R31'];
+}
 
 function DoSuperMethodA(class_: pointer; obj : pointer; msg1 : Pointer): longword; inline;
 begin
   DoSuperMethodA:=DoSuperMethodA(DWord(class_),DWord(obj),msg1);
 end;
 
-function DoSuperMethod(class_: longword; obj : longword; msg : array of LongWord): longword;
+function DoSuperMethod(class_: longword; obj : longword; const msg : array of LongWord): longword;
 begin
   DoSuperMethod:=DoSuperMethodA(class_, obj, @msg);
 end;
 
-function DoSuperNew(class_: pointer; obj: pointer; tags: array of LongWord): longword;
+function DoSuperNew(class_: pointer; obj: pointer; const tags: array of LongWord): longword;
 var opSet: topSet;
 begin
   opSet.MethodID := OM_NEW;
@@ -102,8 +136,18 @@ begin
   DoSuperNew:=DoSuperMethodA(class_,obj,@opset);
 end;
 
-// This procedure is used to pop dispatcher args from emulstruc
-procedure DISPATCHERARG(var cl; var obj; var msg); assembler;
+{ 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;
+end;
+{
+// assembler implementation, kept for reference
 asm
   lwz r6,32(r2) // REG_a0
   stw r6,(r3)   // cl
@@ -111,7 +155,7 @@ asm
   stw r6,(r4)   // obj
   lwz r6,36(r2) // REG_a1
   stw r6,(r5)   // msg
-end;
+end;}
 
 type
   THookSubEntryFunc = function(a, b, c: Pointer): longword;