return Kernel.Call implementation for native 486

diff --git a/src/native/posix/486/System/Mod/Kernel.cp b/src/native/posix/486/System/Mod/Kernel.cp
index 2039e1766ff3b0595b81a696846cc72f4dc58c3a..b4311ab3806cb2e76f31dc7dde9d587f577d203e 100644 (file)
--- a/src/native/posix/486/System/Mod/Kernel.cp
+++ b/src/native/posix/486/System/Mod/Kernel.cp
@@ -8,7 +8,6 @@ MODULE Kernel;
   (* init fpu? *)
   (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
   (* add BeepHook for Beep *)
   (* init fpu? *)
   (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
   (* add BeepHook for Beep *)

-  (* implement Call using libffi *)

 
   CONST
     nameLen* = 256;
 
   CONST
     nameLen* = 256;


@@ -910,10 +909,73 @@ MODULE Kernel;
 
   (* -------------------- dynamic procedure call  --------------------- *)
 
 
   (* -------------------- dynamic procedure call  --------------------- *)
 

+  PROCEDURE [code] PUSH (p: INTEGER) 050H;  (* push AX *)
+  PROCEDURE [code] CALL (a: INTEGER) 0FFH, 0D0H;  (* call AX *)
+  PROCEDURE [code] RETI (): LONGINT;
+  PROCEDURE [code] RETR (): REAL;
+
+  (*
+    type           par
+    32 bit scalar  value
+    64 bit scalar  low hi
+    var scalar     address
+    record         address tag
+    array          address size
+    open array     length_N-1 .. length_0
+  *)
+

   PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
   PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;

-  BEGIN
-    HALT(126); (* !!! *)
-    RETURN 0
+    VAR p, kind, sp, size: INTEGER; typ: Type; r: REAL;
+  BEGIN
+    p := sig.num;
+    WHILE p > 0 DO  (* push parameters from right to left *)
+      DEC(p);
+      typ := sig.par[p].struct;
+      kind := sig.par[p].id MOD 16;
+      IF (S.VAL(INTEGER, typ) DIV 256 = 0) OR (typ.id MOD 4 IN {0, 3}) THEN (* scalar, ANYREC *)
+        IF (kind = 10) & ((S.VAL(INTEGER, typ) = 8) OR (S.VAL(INTEGER, typ) = 10)) THEN (* 64 bit *)
+          DEC(n); PUSH(par[n])  (* push hi word *)
+        ELSIF S.VAL(INTEGER, typ) = 11 THEN   (* ANYREC *)
+          ASSERT(kind # 10); (* not a value par, also checked by compiler *)
+          DEC(n); PUSH(par[n]) (* push tag *)
+        END;
+        DEC(n); PUSH(par[n])  (* push value/address *)
+      ELSIF typ.id MOD 4 = 1 THEN (* record *)
+        IF kind # 10 THEN (* var par *)
+          DEC(n); PUSH(par[n]); (* push tag *)
+          DEC(n); PUSH(par[n])  (* push address *)
+        ELSE
+          DEC(n, 2);  (* skip tag *)
+          S.GETREG(SP, sp); sp := (sp - typ.size) DIV 4 * 4; S.PUTREG(SP, sp);  (* allocate space *)
+          S.MOVE(par[n], sp, typ.size)  (* copy to stack *)
+        END
+      ELSIF typ.size = 0 THEN (* open array *)
+        size := typ.id DIV 16 MOD 16; (* number of open dimensions *)
+        WHILE size > 0 DO
+          DEC(size); DEC(n); PUSH(par[n]) (* push length *)
+        END;
+        DEC(n); PUSH(par[n])  (* push address *)
+      ELSE  (* fix array *)
+        IF kind # 10 THEN (* var par *)
+          DEC(n, 2); PUSH(par[n]) (* push address *)
+        ELSE
+          DEC(n); size := par[n]; DEC(n);
+          S.GETREG(SP, sp); sp := (sp - size) DIV 4 * 4; S.PUTREG(SP, sp);  (* allocate space *)
+          S.MOVE(par[n], sp, size)  (* copy to stack *)
+        END
+      END
+    END;
+    ASSERT(n = 0);
+    IF S.VAL(INTEGER, sig.retStruct) = 7 THEN (* shortreal *)
+      CALL(adr);
+      RETURN S.VAL(INTEGER, SHORT(RETR()))  (* return value in fpu register *)
+    ELSIF S.VAL(INTEGER, sig.retStruct) = 8 THEN  (* real *)
+      CALL(adr); r := RETR();
+      RETURN S.VAL(LONGINT, r)  (* return value in fpu register *)
+    ELSE
+      CALL(adr);
+      RETURN RETI() (* return value in integer registers *)
+    END

   END Call;
 
   (* -------------------- reference information (portable) --------------------- *)
   END Call;
 
   (* -------------------- reference information (portable) --------------------- *)