DEADSOFTWARE
GIT / REPO / FRED-BOY

Projects / cpc.git / blobdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
fix trap handling
[cpc.git] / src / cpfront / posix / generic / System / Mod / Kernel.cp
diff --git a/src/cpfront/posix/generic/System/Mod/Kernel.cp b/src/cpfront/posix/generic/System/Mod/Kernel.cp
index 279fef9483a2960fa170d6ef66c71e7771eae372..87ea635fc7524de0eca557d825ed0fc6dfee3f8c 100644 (file)
--- a/src/cpfront/posix/generic/System/Mod/Kernel.cp
+++ b/src/cpfront/posix/generic/System/Mod/Kernel.cp
@@ -9,7 +9,6 @@ MODULE Kernel;
   (* init fpu? *)
   (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
   (* add BeepHook for Beep *)
   (* init fpu? *)
   (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
   (* add BeepHook for Beep *)
-  (* implement Call using libffi *)
 
   CONST
     nameLen* = 256;
 
   CONST
     nameLen* = 256;
@@ -204,8 +203,8 @@ MODULE Kernel;
     trapCount-: INTEGER;
     err-, pc-, sp-, fp-, stack-, val-: INTEGER;
 
     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;
     startDLink, tryDLink: DLink;
 
     tryEnv: setjmp.jmp_buf;
     startDLink, tryDLink: DLink;
 
@@ -522,28 +521,27 @@ MODULE Kernel;
     FreeMem(modAdr, modSize)
   END InvalModMem;
 
     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
   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
     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) -------------------- *)
   END IsReadable;
 
   (* --------------------- NEW implementation (portable) -------------------- *)
@@ -961,17 +959,25 @@ MODULE Kernel;
       farg[cn] := S.VAL(Ptype, S.ADR(typ));
     END SetType;
 
       farg[cn] := S.VAL(Ptype, S.ADR(typ));
     END SetType;
 
-    PROCEDURE PushVal (size: INTEGER);
+    PROCEDURE PushAdr (size: INTEGER);
     BEGIN
       ASSERT(size IN {1, 2, 4, 8}, 20);
     BEGIN
       ASSERT(size IN {1, 2, 4, 8}, 20);
-      ASSERT(littleEndian); (* !!! swap 64bit value *)
+      ASSERT(littleEndian OR (size <= 4), 100); (* !!! swap 64bit value *)
       varg[cn] := S.ADR(par[d]);
       INC(cn); INC(d, MAX(1, size DIV 4))
       varg[cn] := S.ADR(par[d]);
       INC(cn); INC(d, MAX(1, size DIV 4))
+    END PushAdr;
+
+    PROCEDURE PushVal (size: INTEGER);
+    BEGIN
+      ASSERT(size IN {1, 2, 4, 8}, 20);
+      ASSERT(littleEndian OR (size <= 4), 100); (* !!! swap 64bit value *)
+      varg[cn] := par[d];
+      INC(cn); INC(d, MAX(1, size DIV 4))
     END PushVal;
 
     PROCEDURE Push (IN typ: LibFFI.type);
     BEGIN
     END PushVal;
 
     PROCEDURE Push (IN typ: LibFFI.type);
     BEGIN
-      SetType(typ); PushVal(typ.size)
+      SetType(typ); PushAdr(typ.size)
     END Push;
 
   BEGIN
     END Push;
 
   BEGIN
@@ -1015,7 +1021,7 @@ MODULE Kernel;
              targ[ut].type := LibFFI.TYPE_STRUCT;
              targ[ut].elements := S.VAL(PPtype, S.ADR(earg[ue]));
              SetType(targ[ut]); INC(ut);
              targ[ut].type := LibFFI.TYPE_STRUCT;
              targ[ut].elements := S.VAL(PPtype, S.ADR(earg[ue]));
              SetType(targ[ut]); INC(ut);
-             size := MIN(1, typ.size);
+             size := MAX(1, typ.size);
              (* !!! better to pass original layout *)
              WHILE size >= 8 DO
                earg[ue] := S.VAL(Ptype, S.ADR(LibFFI.type_uint64));
              (* !!! better to pass original layout *)
              WHILE size >= 8 DO
                earg[ue] := S.VAL(Ptype, S.ADR(LibFFI.type_uint64));
@@ -1050,6 +1056,8 @@ MODULE Kernel;
              FOR i := 0 TO typ.id DIV 16 - 1 DO
                Push(LibFFI.type_sint32) (* dim size *)
              END
              FOR i := 0 TO typ.id DIV 16 - 1 DO
                Push(LibFFI.type_sint32) (* dim size *)
              END
+           ELSE (* fix array *)
+             INC(d) (* skip size *)
            END
         END
       END;
            END
         END
       END;
@@ -1745,20 +1753,21 @@ MODULE Kernel;
     stdlib.abort
   END Trap;
 
     stdlib.abort
   END Trap;
 
-  PROCEDURE [ccall] TrapHandler (signo: signal.int; IN _info: signal.siginfo_t; context: ADDRESS);
-    TYPE SigInfo = POINTER [untagged] TO signal._siginfo_t;
-    VAR res: signal.int; info: SigInfo;
+  PROCEDURE [ccall] TrapHandler (signo: signal.int; IN info: signal.siginfo_t; context: ADDRESS);
+    VAR res: signal.int;
   BEGIN
   BEGIN
-    info := S.VAL(SigInfo, S.ADR(_info)); (* !!! hack for CPfront *)
+    IF checkReadable THEN
+      setjmp.siglongjmp(checkReadableEnv, 1)
+    END;
     IF trapped THEN
       DefaultTrapViewer;
       IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
     END;
     IF trapped THEN
       DefaultTrapViewer;
       IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
     END;
-    err := -signo; pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
+    err := -signo; pc := 0; sp := 0; fp := 0; stack := baseStack; val := 0;
     CASE signo OF
     | signal.SIGFPE:
     CASE signo OF
     | signal.SIGFPE:
-        pc := info.si_addr;
         val := info.si_code;
         val := info.si_code;
+        pc := info.info.sigfpe.si_addr;
         CASE info.si_code OF
         | signal.FPE_INTDIV: err := 139 (* division by zero *)
         | signal.FPE_INTOVF: err := 138 (* integer overflow *)
         CASE info.si_code OF
         | signal.FPE_INTDIV: err := 139 (* division by zero *)
         | signal.FPE_INTOVF: err := 138 (* integer overflow *)
@@ -1774,17 +1783,16 @@ MODULE Kernel;
         val := info.si_code;
         err := 200 (* keyboard interrupt *)
     | signal.SIGSEGV:
         val := info.si_code;
         err := 200 (* keyboard interrupt *)
     | signal.SIGSEGV:
-        val := info.si_addr;
+        val := info.info.sigsegv.si_addr;
         err := 203 (* illigal read *)
     | signal.SIGBUS:
         err := 203 (* illigal read *)
     | signal.SIGBUS:
-        val := info.si_addr;
+        val := info.info.sigbus.si_addr;
         err := 10001H (* bus error *)
     | signal.SIGILL:
         err := 10001H (* bus error *)
     | signal.SIGILL:
-        pc := info.si_addr;
+        pc := info.info.sigill.si_addr;
         err := 202; (* illigal instruction *)
         IF IsReadable(pc, pc + 4) THEN
           S.GET(pc, val)
         err := 202; (* illigal instruction *)
         IF IsReadable(pc, pc + 4) THEN
           S.GET(pc, val)
-          (* !!! err := halt code *)
         END;
     ELSE (* unknown *)
     END;
         END;
     ELSE (* unknown *)
     END;
@@ -1792,7 +1800,6 @@ MODULE Kernel;
     (* !!! InitFPU *)
     TrapCleanup;
     IF isTry THEN
     (* !!! InitFPU *)
     TrapCleanup;
     IF isTry THEN
-      SetDLink(tryDLink);
       setjmp._longjmp(tryEnv, 1)
     END;
     IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
       setjmp._longjmp(tryEnv, 1)
     END;
     IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
@@ -1802,7 +1809,6 @@ MODULE Kernel;
     END;
     trapped := FALSE; secondTrap := FALSE;
     IF restart # NIL THEN
     END;
     trapped := FALSE; secondTrap := FALSE;
     IF restart # NIL THEN
-      SetDLink(startDLink);
       setjmp.siglongjmp(startEnv, 1)
     END;
     stdlib.abort
       setjmp.siglongjmp(startEnv, 1)
     END;
     stdlib.abort
A command line Component Pascal Compiler
DEADSOFTWARE 2012-2025