summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 0e546c1)
raw | patch | inline | side by side (parent: 0e546c1)
author | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
Sat, 27 Jul 2019 15:56:35 +0000 (18:56 +0300) | ||
committer | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
Sat, 27 Jul 2019 15:56:35 +0000 (18:56 +0300) |
src/native/posix/486/System/Mod/Kernel.cp | patch | blob | history |
index 2039e1766ff3b0595b81a696846cc72f4dc58c3a..b4311ab3806cb2e76f31dc7dde9d587f577d203e 100644 (file)
(* init fpu? *)
(* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
(* add BeepHook for Beep *)
- (* implement Call using libffi *)
CONST
nameLen* = 256;
(* -------------------- 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) --------------------- *)