From b3b6bda116f414a5cb857bf73a41a75e9d48c837 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Sat, 27 Jul 2019 18:56:35 +0300 Subject: [PATCH] return Kernel.Call implementation for native 486 --- src/native/posix/486/System/Mod/Kernel.cp | 70 +++++++++++++++++++++-- 1 file changed, 66 insertions(+), 4 deletions(-) diff --git a/src/native/posix/486/System/Mod/Kernel.cp b/src/native/posix/486/System/Mod/Kernel.cp index 2039e17..b4311ab 100644 --- 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 *) - (* implement Call using libffi *) CONST nameLen* = 256; @@ -910,10 +909,73 @@ MODULE Kernel; (* -------------------- 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; - 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) --------------------- *) -- 2.29.2