X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fnative%2Fposix%2F486%2FSystem%2FMod%2FKernel.cp;h=2ffbe43c520daa3c7c64038e9572b6f5c931fe8d;hb=b90cbbdc859d9aa7436fe5a6e5ae1fc3d76965d1;hp=2039e1766ff3b0595b81a696846cc72f4dc58c3a;hpb=0e546c1e6f408deae672e1333a0d16cd90425910;p=cpc.git diff --git a/src/native/posix/486/System/Mod/Kernel.cp b/src/native/posix/486/System/Mod/Kernel.cp index 2039e17..2ffbe43 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; @@ -203,8 +202,8 @@ MODULE Kernel; 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; @@ -520,28 +519,27 @@ MODULE Kernel; 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) -------------------- *) @@ -589,9 +587,9 @@ MODULE Kernel; | 9: eltyp := S.ADR(Char16Type) | 10: eltyp := S.ADR(Int64Type) | 11: eltyp := S.ADR(ProcType) - | 12: HALT(101) (* COM interface pointers not supported *) + | 12: eltype := S.ADR(UPtrType) ELSE - ASSERT(~ODD(eltyp), 102) (* COM interface pointers not supported *) + ASSERT(~ODD(eltyp), 101) (* COM interface pointers not supported *) END; t := S.VAL(Type, eltyp); headSize := 4 * nofdim + 12; @@ -910,10 +908,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) --------------------- *) @@ -1583,6 +1644,9 @@ MODULE Kernel; 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 @@ -1616,8 +1680,14 @@ MODULE Kernel; 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;