index 2039e1766ff3b0595b81a696846cc72f4dc58c3a..93ccf251f7e6b00207a1dbe799004268b0f7b6ae 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: BOOLEAN;
- startEnv: setjmp.sigjmp_buf;
+ isTry, checkReadable: BOOLEAN;
+ startEnv, checkReadableEnv: setjmp.sigjmp_buf;
tryEnv: setjmp.jmp_buf;
argc-: INTEGER;
FreeMem(modAdr, modSize)
END InvalModMem;
- PROCEDURE TryRead (from, to, c: INTEGER);
- VAR i: INTEGER; x: BYTE;
+ PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
+ VAR r: BOOLEAN; jmp: setjmp.sigjmp_buf; res: setjmp.int; i: INTEGER; x: BYTE;
BEGIN
- IF from <= to THEN
- FOR i := from TO to DO
- S.GET(i, x)
- END
- ELSE
- FOR i := to TO from BY -1 DO
- S.GET(i, x)
+ r := checkReadable;
+ jmp := checkReadableEnv;
+ checkReadable := TRUE;
+ res := setjmp.sigsetjmp(checkReadableEnv, 1);
+ IF res = 0 THEN
+ IF from <= to THEN
+ FOR i := from TO to DO
+ S.GET(i, x)
+ END
+ ELSE
+ FOR i := to TO from BY -1 DO
+ S.GET(i, x)
+ END
END
END;
- END TryRead;
-
- PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER);
-
- PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
- VAR i: INTEGER;
- BEGIN
- i := trapCount;
- Try(TryRead, from, to, 0);
- RETURN trapCount = i
+ checkReadableEnv := jmp;
+ checkReadable := r;
+ RETURN res = 0
END IsReadable;
(* --------------------- NEW implementation (portable) -------------------- *)
(* -------------------- 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) --------------------- *)
PROCEDURE [ccall] TrapHandler (signo: signal.int; IN info: signal.siginfo_t; context: ADDRESS);
VAR res: signal.int;
BEGIN
+ IF checkReadable THEN
+ setjmp.siglongjmp(checkReadableEnv, 1)
+ END;
IF trapped THEN
DefaultTrapViewer;
IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
pc := info.info.sigill.si_addr;
err := 202; (* illigal instruction *)
IF IsReadable(pc, pc + 4) THEN
- S.GET(pc, val)
- (* !!! err := halt code *)
+ S.GET(pc, val);
+ IF val MOD 100H = 8DH THEN (* lea reg,reg *)
+ IF val DIV 100H MOD 100H = 0F0H THEN
+ 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;
ELSE (* unknown *)
END;