index 115a773f82860be78230ca4b089622ee056e17aa..339c640058e4331b420c560eda57e85186474d25 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;
trapCount-: INTEGER;
err-, pc-, sp-, fp-, stack-, val-: INTEGER;
- isTry, testRead: BOOLEAN;
- startEnv: setjmp.sigjmp_buf;
- tryEnv, readEnv: setjmp.jmp_buf;
+ isTry, checkReadable: BOOLEAN;
+ startEnv, checkReadableEnv: setjmp.sigjmp_buf;
+ tryEnv: setjmp.jmp_buf;
argc-: INTEGER;
argv-: ArrStrPtr;
wouldFinalize: BOOLEAN;
- watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+ watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+
+ intTrap*: BOOLEAN;
PROCEDURE Erase (adr, words: INTEGER);
BEGIN
END InvalModMem;
PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
- VAR i: INTEGER; x: BYTE; res: setjmp.int;
+ VAR r: BOOLEAN; jmp: setjmp.sigjmp_buf; res: setjmp.int; i: INTEGER; x: BYTE;
BEGIN
- testRead := TRUE;
- res := setjmp.setjmp(readEnv);
+ r := checkReadable;
+ jmp := checkReadableEnv;
+ checkReadable := TRUE;
+ res := setjmp.sigsetjmp(checkReadableEnv, 1);
IF res = 0 THEN
IF from <= to THEN
- FOR i := from TO to - 1 DO
+ FOR i := from TO to DO
S.GET(i, x)
END
ELSE
- FOR i := to - 1 TO from BY -1 DO
+ FOR i := to TO from BY -1 DO
S.GET(i, x)
END
- END;
+ END
END;
- testRead := FALSE;
+ checkReadableEnv := jmp;
+ checkReadable := r;
RETURN res = 0
END IsReadable;
(* -------------------- 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) --------------------- *)
ELSE err := -n + 128
END;
pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
- S.GETREG(SP, sp); S.GETREG(FP, fp);
INC(trapCount);
(* !!! InitFPU *)
TrapCleanup;
IF isTry THEN
setjmp._longjmp(tryEnv, 1)
END;
- IF err = 128 THEN (* do nothing *)
+ IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
trapped := TRUE; trapViewer()
ELSE DefaultTrapViewer
PROCEDURE [ccall] TrapHandler (signo: signal.int; IN info: signal.siginfo_t; context: ADDRESS);
VAR res: signal.int; uc: signal.Pucontext_t;
BEGIN
- IF testRead THEN
- setjmp.longjmp(readEnv, 1)
+ IF checkReadable THEN
+ setjmp.siglongjmp(checkReadableEnv, 1)
END;
IF trapped THEN
DefaultTrapViewer;
err := 202; (* illigal instruction *)
IF IsReadable(pc, pc + 4) THEN
S.GET(pc, val);
- IF val MOD 100H = 8DH THEN (* lea reg,reg *)
+ IF val MOD 100H = 8DH THEN (* lea reg,reg *)
IF val DIV 100H MOD 100H = 0F0H THEN
- err := val DIV 10000H MOD 100H (* trap *)
+ err := val DIV 10000H MOD 100H (* trap *)
ELSIF val DIV 1000H MOD 10H = 0EH THEN
err := 128 + val DIV 100H MOD 10H (* run time error *)
END
END
- END
+ END;
ELSE (* unknown *)
END;
INC(trapCount);
IF isTry THEN
setjmp._longjmp(tryEnv, 1)
END;
- IF err = 128 THEN (* do nothing *)
+ IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
trapped := TRUE; trapViewer()
ELSE DefaultTrapViewer
PROCEDURE Init;
VAR i: INTEGER;
BEGIN
+ intTrap := TRUE;
pagesize := unistd.sysconf(unistd._SC_PAGESIZE);
(* init heap *)