DEADSOFTWARE

remove Kernel duplicate
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Sat, 27 Jul 2019 15:47:11 +0000 (18:47 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Sat, 27 Jul 2019 15:47:11 +0000 (18:47 +0300)
src/native/linux/486/System/Mod/Kernel.cp [deleted file]
src/native/posix/486/System/Mod/Kernel.cp [moved from src/native/posix/generic/System/Mod/Kernel.cp with 100% similarity]

diff --git a/src/native/linux/486/System/Mod/Kernel.cp b/src/native/linux/486/System/Mod/Kernel.cp
deleted file mode 100644 (file)
index 4c8688e..0000000
+++ /dev/null
@@ -1,1717 +0,0 @@
-MODULE Kernel;
-
-  IMPORT S := SYSTEM, stdlib := PosixCstdlib, stdio := PosixCstdio,
-    time := PosixCtime, wctype := PosixCwctype, sysmman := PosixCsys_mman,
-    dlfcn := PosixCdlfcn, types := PosixCtypes, fcntl := PosixCfcntl,
-    unistd := PosixCunistd, signal := PosixCsignal, setjmp := PosixCsetjmp;
-
-  (* init fpu? *)
-  (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
-  (* add BeepHook for Beep *)
-  (* implement Call using libffi *)
-
-  CONST
-    nameLen* = 256;
-
-    littleEndian* = TRUE;
-    timeResolution* = 1000; (* ticks per second *)
-
-    processor* = 1;  (* generic c *)
-
-    objType* = "ocf"; (* file types *)
-    symType* = "osf";
-    docType* = "odc";
-
-    (* loader constants *)
-    done* = 0;
-    fileNotFound* = 1;
-    syntaxError* = 2;
-    objNotFound* = 3;
-    illegalFPrint* = 4;
-    cyclicImport* = 5;
-    noMem* = 6;
-    commNotFound* = 7;
-    commSyntaxError* = 8;
-    moduleNotFound* = 9;
-
-    any = 1000000;
-
-    CX = 1;
-    SP = 4; (* register number of stack pointer *)
-    FP = 5; (* register number of frame pointer *)
-    ML = 3; (* register which holds the module list at program start *)
-
-    strictStackSweep = FALSE;
-    N = 128 DIV 16; (* free lists *)
-
-    (* kernel flags in module desc *)
-    init = 16; dyn = 17; dll = 24; iptrs = 30;
-
-    (* meta interface consts *)
-    mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
-
-  TYPE
-    Name* = ARRAY nameLen OF CHAR;
-    Utf8Name* = ARRAY nameLen OF SHORTCHAR;
-    Command* = PROCEDURE;
-
-    Module* = POINTER TO RECORD [untagged]
-      next-: Module;
-      opts-: SET; (* 0..15: compiler opts, 16..31: kernel flags *)
-      refcnt-: INTEGER; (* <0: module invalidated *)
-      compTime-, loadTime-: ARRAY 6 OF SHORTINT;
-      ext-: INTEGER;  (* currently not used *)
-      term-: Command; (* terminator *)
-      nofimps-, nofptrs-: INTEGER;
-      csize-, dsize-, rsize-: INTEGER;
-      code-, data-, refs-: INTEGER;
-      procBase-, varBase-: INTEGER; (* meta base addresses *)
-      names-: POINTER TO ARRAY [untagged] OF SHORTCHAR; (* names[0] = 0X *)
-      ptrs-: POINTER TO ARRAY [untagged] OF INTEGER;
-      imports-: POINTER TO ARRAY [untagged] OF Module;
-      export-: Directory; (* exported objects (name sorted) *)
-      name-: Utf8Name
-    END;
-
-    Type* = POINTER TO RECORD [untagged]
-      (* record: ptr to method n at offset - 4 * (n+1) *)
-      size-: INTEGER; (* record: size, array: #elem, dyn array: 0, proc: sigfp *)
-      mod-: Module;
-      id-: INTEGER; (* name idx * 256 + lev * 16 + attr * 4 + form *)
-      base-: ARRAY 16 OF Type;  (* signature if form = ProcTyp *)
-      fields-: Directory; (* new fields (declaration order) *)
-      ptroffs-: ARRAY any OF INTEGER  (* array of any length *)
-    END;
-
-    Object* = POINTER TO ObjDesc;
-
-    ObjDesc* = RECORD [untagged]
-      fprint-: INTEGER;
-      offs-: INTEGER; (* pvfprint for record types *)
-      id-: INTEGER; (* name idx * 256 + vis * 16 + mode *)
-      struct-: Type (* id of basic type or pointer to typedesc/signature *)
-    END;
-
-    Directory* = POINTER TO RECORD [untagged]
-      num-: INTEGER;  (* number of entries *)
-      obj-: ARRAY any OF ObjDesc  (* array of any length *)
-    END;
-    
-    Signature* = POINTER TO RECORD [untagged]
-      retStruct-: Type; (* id of basic type or pointer to typedesc or 0 *)
-      num-: INTEGER;  (* number of parameters *)
-      par-: ARRAY any OF RECORD [untagged]  (* parameters *)
-        id-: INTEGER; (* name idx * 256 + kind *)
-        struct-: Type (* id of basic type or pointer to typedesc *)
-      END
-    END;
-
-    Handler* = PROCEDURE;
-
-    Reducer* = POINTER TO ABSTRACT RECORD
-      next: Reducer
-    END;
-
-    Identifier* = ABSTRACT RECORD
-      typ*: INTEGER;
-      obj-: ANYPTR
-    END;
-
-    TrapCleaner* = POINTER TO ABSTRACT RECORD
-      next: TrapCleaner
-    END;
-
-    TryHandler* = PROCEDURE (a, b, c: INTEGER);
-
-    (* meta extension suport *)
-
-    ItemExt* = POINTER TO ABSTRACT RECORD END;
-
-    ItemAttr* = RECORD
-      obj*, vis*, typ*, adr*: INTEGER;
-      mod*: Module;
-      desc*: Type;
-      ptr*: S.PTR;
-      ext*: ItemExt
-    END;
-
-    Hook* = POINTER TO ABSTRACT RECORD END;
-
-    LoaderHook* = POINTER TO ABSTRACT RECORD (Hook) 
-      res*: INTEGER;
-      importing*, imported*, object*: ARRAY 256 OF CHAR
-    END;
-
-    Block = POINTER TO RECORD [untagged]
-      tag: Type;
-      last: INTEGER;    (* arrays: last element *)
-      actual: INTEGER;  (* arrays: used during mark phase *)
-      first: INTEGER    (* arrays: first element *)
-    END;
-
-    FreeBlock = POINTER TO FreeDesc;
-
-    FreeDesc = RECORD [untagged]
-      tag: Type;    (* f.tag = ADR(f.size) *)
-      size: INTEGER;
-      next: FreeBlock
-    END;
-
-    Cluster = POINTER TO RECORD [untagged]
-      size: INTEGER;  (* total size *)
-      next: Cluster;
-      max: INTEGER  (* exe: reserved size, dll: original address *)
-      (* start of first block *)
-    END;
-
-    FList = POINTER TO RECORD
-      next: FList;
-      blk: Block;
-      iptr, aiptr: BOOLEAN
-    END;
-
-    CList = POINTER TO RECORD
-      next: CList;
-      do: Command;
-      trapped: BOOLEAN
-    END;
-
-
-    PtrType = RECORD v: S.PTR END;  (* used for array of pointer *)
-    Char8Type = RECORD v: SHORTCHAR END;
-    Char16Type = RECORD v: CHAR END;
-    Int8Type = RECORD v: BYTE END;
-    Int16Type = RECORD v: SHORTINT END;
-    Int32Type = RECORD v: INTEGER END;
-    Int64Type = RECORD v: LONGINT END;
-    BoolType = RECORD v: BOOLEAN END;
-    SetType = RECORD v: SET END;
-    Real32Type = RECORD v: SHORTREAL END;
-    Real64Type = RECORD v: REAL END;
-    ProcType = RECORD v: PROCEDURE END;
-    UPtrType = RECORD v: INTEGER END;
-    StrPtr = POINTER TO ARRAY [untagged] OF SHORTCHAR;
-
-    ArrStrPtr = POINTER TO ARRAY [untagged] OF StrPtr;
-
-    ADDRESS* = types.Pvoid;
-
-  VAR
-    baseStack: INTEGER;
-    root: Cluster;
-    modList-: Module;
-    trapCount-: INTEGER;
-    err-, pc-, sp-, fp-, stack-, val-: INTEGER;
-
-    isTry, testRead: BOOLEAN;
-    startEnv: setjmp.sigjmp_buf;
-    tryEnv, readEnv: setjmp.jmp_buf;
-
-    argc-: INTEGER;
-    argv-: ArrStrPtr;
-    pagesize: unistd.long;
-
-    free: ARRAY N OF FreeBlock; (* free list *)
-    sentinelBlock: FreeDesc;
-    sentinel: FreeBlock;
-    candidates: ARRAY 1024 OF INTEGER;
-    nofcand: INTEGER;
-    allocated: INTEGER; (* bytes allocated on BlackBox heap *)
-    total: INTEGER; (* current total size of BlackBox heap *)
-    used: INTEGER;  (* bytes allocated on system heap *)
-    finalizers: FList;
-    hotFinalizers: FList;
-    cleaners: CList;
-    reducers: Reducer;
-    trapStack: TrapCleaner;
-    actual: Module; (* valid during module initialization *)
-
-    trapViewer, trapChecker: Handler;
-    trapped, guarded, secondTrap: BOOLEAN;
-    interrupted: BOOLEAN;
-    static, inDll, terminating: BOOLEAN;
-    restart: Command;
-
-    loader: LoaderHook;
-    loadres: INTEGER;
-
-    wouldFinalize: BOOLEAN;
-
-    watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
-
-    intTrap*: BOOLEAN;
-
-  PROCEDURE Erase (adr, words: INTEGER);
-  BEGIN
-    ASSERT(words >= 0, 20);
-    WHILE words > 0 DO
-      S.PUT(adr, 0);
-      INC(adr, 4);
-      DEC(words)
-    END
-  END Erase;
-
-
-  PROCEDURE (VAR id: Identifier) Identified* (): BOOLEAN, NEW, ABSTRACT;
-  PROCEDURE (r: Reducer) Reduce* (full: BOOLEAN), NEW, ABSTRACT;
-  PROCEDURE (c: TrapCleaner) Cleanup*,  NEW, EMPTY;
-
-  (* meta extension suport *)
-
-  PROCEDURE (e: ItemExt) Lookup* (name: ARRAY OF CHAR; VAR i: ANYREC), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) Index* (index: INTEGER; VAR elem: ANYREC), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) Deref* (VAR ref: ANYREC), NEW, ABSTRACT;
-
-  PROCEDURE (e: ItemExt) Valid* (): BOOLEAN, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) Size* (): INTEGER, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) BaseTyp* (): INTEGER, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) Len* (): INTEGER, NEW, ABSTRACT;
-
-  PROCEDURE (e: ItemExt) Call* (OUT ok: BOOLEAN), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) BoolVal* (): BOOLEAN, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutBoolVal* (x: BOOLEAN), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) CharVal* (): CHAR, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutCharVal* (x: CHAR), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) IntVal* (): INTEGER, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutIntVal* (x: INTEGER), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) LongVal* (): LONGINT, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutLongVal* (x: LONGINT), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) RealVal* (): REAL, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutRealVal* (x: REAL), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) SetVal* (): SET, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutSetVal* (x: SET), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PtrVal* (): ANYPTR, NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutPtrVal* (x: ANYPTR), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) GetSStringVal* (OUT x: ARRAY OF SHORTCHAR;
-                                  OUT ok: BOOLEAN), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutSStringVal* (IN x: ARRAY OF SHORTCHAR;
-                                  OUT ok: BOOLEAN), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) GetStringVal* (OUT x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
-  PROCEDURE (e: ItemExt) PutStringVal* (IN x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
-
-  (* -------------------- miscellaneous tools -------------------- *)
-
-  PROCEDURE IsUpper* (ch: CHAR): BOOLEAN;
-  BEGIN
-    RETURN wctype.iswupper(ORD(ch)) # 0
-  END IsUpper;
-
-  PROCEDURE Upper* (ch: CHAR): CHAR;
-  BEGIN
-    RETURN CHR(wctype.towupper(ORD(ch)))
-  END Upper;
-
-  PROCEDURE IsLower* (ch: CHAR): BOOLEAN;
-  BEGIN
-    RETURN wctype.iswlower(ORD(ch)) # 0
-  END IsLower;
-
-  PROCEDURE Lower* (ch: CHAR): CHAR;
-  BEGIN
-    RETURN CHR(wctype.towlower(ORD(ch)))
-  END Lower;
-
-  PROCEDURE IsAlpha* (ch: CHAR): BOOLEAN;
-  BEGIN
-    RETURN wctype.iswalpha(ORD(ch)) # 0
-  END IsAlpha;
-
-  PROCEDURE Utf8ToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR;  OUT res: INTEGER);
-    VAR i, j, val, max: INTEGER; ch: SHORTCHAR;
-    
-    PROCEDURE FormatError();
-    BEGIN out := in$; res := 2 (*format error*)
-    END FormatError;
-    
-  BEGIN
-    ch := in[0]; i := 1; j := 0; max := LEN(out) - 1;
-    WHILE (ch # 0X) & (j < max) DO
-      IF ch < 80X THEN
-        out[j] := ch; INC(j)
-      ELSIF ch < 0E0X THEN
-        val := ORD(ch) - 192;
-        IF val < 0 THEN FormatError; RETURN END ;
-        ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
-        IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
-        out[j] := CHR(val); INC(j)
-      ELSIF ch < 0F0X THEN 
-        val := ORD(ch) - 224;
-        ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
-        IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
-        ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
-        IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
-        out[j] := CHR(val); INC(j)
-      ELSE
-        FormatError; RETURN
-      END ;
-      ch := in[i]; INC(i)
-    END;
-    out[j] := 0X;
-    IF ch = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
-  END Utf8ToString;
-
-  PROCEDURE StringToUtf8* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; OUT res: INTEGER);
-    VAR i, j, val, max: INTEGER;
-  BEGIN
-    i := 0; j := 0; max := LEN(out) - 3;
-    WHILE (in[i] # 0X) & (j < max) DO
-      val := ORD(in[i]); INC(i);
-      IF val < 128 THEN
-        out[j] := SHORT(CHR(val)); INC(j)
-      ELSIF val < 2048 THEN
-        out[j] := SHORT(CHR(val DIV 64 + 192)); INC(j);
-        out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
-      ELSE
-        out[j] := SHORT(CHR(val DIV 4096 + 224)); INC(j); 
-        out[j] := SHORT(CHR(val DIV 64 MOD 64 + 128)); INC(j);
-        out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
-      END;
-    END;
-    out[j] := 0X;
-    IF in[i] = 0X THEN res := 0 (*ok*) ELSE res :=  1 (*truncated*) END
-  END StringToUtf8;
-
-  PROCEDURE SplitName* (name: ARRAY OF CHAR; VAR head, tail: ARRAY OF CHAR);
-    (* portable *)
-    VAR i, j: INTEGER; ch, lch: CHAR;
-  BEGIN
-    i := 0; ch := name[0];
-    IF ch # 0X THEN
-      REPEAT
-        head[i] := ch; lch := ch; INC(i); ch := name[i]
-      UNTIL (ch = 0X) OR (ch = ".") OR IsUpper(ch) & ~IsUpper(lch);
-      IF ch = "." THEN i := 0; ch := name[0] END;
-      head[i] := 0X; j := 0;
-      WHILE ch # 0X DO tail[j] := ch; INC(i); INC(j); ch := name[i] END;
-      tail[j] := 0X;
-      IF tail = "" THEN tail := head$; head := "" END
-    ELSE head := ""; tail := ""
-    END
-  END SplitName;
-
-  PROCEDURE MakeFileName* (VAR name: ARRAY OF CHAR; type: ARRAY OF CHAR);
-    VAR i, j: INTEGER; ext: ARRAY 8 OF CHAR; ch: CHAR;
-  BEGIN
-    i := 0;
-    WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
-    IF name[i] = "." THEN
-      IF name[i + 1] = 0X THEN name[i] := 0X END
-    ELSE
-      IF type = "" THEN ext := docType ELSE ext := type$ END;
-      IF i < LEN(name) - LEN(ext$) - 1 THEN
-        name[i] := "."; INC(i); j := 0; ch := ext[0];
-        WHILE ch # 0X DO
-          name[i] := Lower(ch); INC(i); INC(j); ch := ext[j]
-        END;
-        name[i] := 0X
-      END
-    END
-  END MakeFileName;
-
-  PROCEDURE Time* (): LONGINT;
-    VAR res: time.int; tp: time.struct_timespec;
-  BEGIN
-    ASSERT(timeResolution >= 1);
-    ASSERT(timeResolution <= 1000000000);
-    res := time.clock_gettime(time.CLOCK_MONOTONIC, tp);
-    ASSERT(res = 0, 100);
-    RETURN tp.tv_sec * LONG(timeResolution) + tp.tv_nsec DIV LONG(1000000000 DIV timeResolution)
-  END Time;
-
-  PROCEDURE Beep*;
-    (* !!! *)
-  END Beep;
-
-  PROCEDURE SearchProcVar* (var: INTEGER; VAR m: Module; VAR adr: INTEGER);
-  BEGIN
-    adr := var; m := NIL;
-    IF var # 0 THEN
-      m := modList;
-      WHILE (m # NIL) & ((var < m.code) OR (var >= m.code + m.csize)) DO m := m.next END;
-      IF m # NIL THEN DEC(adr, m.code) END
-    END
-  END SearchProcVar;
-
-  (* -------------------- system memory management --------------------- *)
-
-  PROCEDURE AllocMem (size: sysmman.size_t; VAR max: sysmman.size_t): ADDRESS;
-    VAR fd, flags, res: fcntl.int; ptr: ADDRESS;
-  BEGIN
-    max := (size + pagesize - 1) DIV pagesize * pagesize;
-    fd := fcntl.open("/dev/zero", fcntl.O_RDWR, 0);
-    IF fd # -1 THEN
-      flags := sysmman.PROT_READ + sysmman.PROT_WRITE;
-      ptr := sysmman.mmap(0, max, flags, sysmman.MAP_PRIVATE, fd, 0);
-      IF ptr = sysmman.MAP_FAILED THEN ptr := 0 END;
-      res := unistd.close(fd);
-      ASSERT(res = 0, 100)
-    ELSE
-      ptr := 0
-    END;
-    RETURN ptr
-  END AllocMem;
-
-  PROCEDURE FreeMem (adr: ADDRESS; size: sysmman.size_t);
-    VAR res: types.int;
-  BEGIN
-    size := (size + pagesize - 1) DIV pagesize * pagesize;
-    res := sysmman.munmap(adr, size);
-    ASSERT(res = 0, 100)
-  END FreeMem;
-
-  PROCEDURE AllocHeapMem (size: INTEGER; VAR c: Cluster);
-    CONST N = 65536;  (* cluster size for dll *)
-    VAR adr, allocated, newsize: INTEGER;
-  BEGIN
-    INC(size, 16);
-    ASSERT(size > 0, 100); adr := 0;
-    IF size < N THEN
-      adr := AllocMem(N, newsize);
-      allocated := newsize
-    END;
-    IF adr = 0 THEN
-      adr := AllocMem(size, newsize);
-      allocated := newsize
-    END;
-    IF adr = 0 THEN c := NIL
-    ELSE
-      c := S.VAL(Cluster, (adr + 15) DIV 16 * 16); c.max := adr;
-      c.size := allocated - (S.VAL(INTEGER, c) - adr);
-      INC(used, c.size); INC(total, c.size)
-    END;
-    ASSERT((adr = 0) OR (adr MOD 16 = 0) & (c.size >= size), 101);
-    (* post: (c = NIL) OR (c MOD 16 = 0) & (c.size >= size) *)
-  END AllocHeapMem;
-
-  PROCEDURE FreeHeapMem (c: Cluster);
-  BEGIN
-    DEC(used, c.size); DEC(total, c.size);
-    FreeMem(S.VAL(ADDRESS, c.max), c.size)
-  END FreeHeapMem;
-
-  PROCEDURE HeapFull (size: INTEGER): BOOLEAN;
-  BEGIN
-    RETURN TRUE
-  END HeapFull;
-
-  PROCEDURE AllocModMem* (descSize, modSize: INTEGER; VAR descAdr, modAdr: INTEGER);
-  BEGIN
-    descAdr := 0; modAdr := 0;
-    descAdr := AllocMem(descSize, descSize);
-    IF descAdr # 0 THEN
-      modAdr := AllocMem(modSize, modSize);
-      IF modAdr = 0 THEN
-        FreeMem(descAdr, descSize)
-      ELSE
-        INC(used, descSize + modSize)
-      END
-    END
-  END AllocModMem;
-
-  PROCEDURE DeallocModMem* (descSize, modSize, descAdr, modAdr: INTEGER);
-  BEGIN
-    FreeMem(descAdr, descSize);
-    FreeMem(modAdr, modSize);
-    DEC(used, descSize + modSize)
-  END DeallocModMem;
-
-  PROCEDURE InvalModMem (modSize, modAdr: INTEGER);
-  BEGIN
-    FreeMem(modAdr, modSize)
-  END InvalModMem;
-
-  PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
-    VAR i: INTEGER; x: BYTE; res: setjmp.int;
-  BEGIN
-    testRead := TRUE;
-    res := setjmp.setjmp(readEnv);
-    IF res = 0 THEN
-      IF from <= to THEN
-        FOR i := from TO to - 1 DO
-          S.GET(i, x)
-        END
-      ELSE
-        FOR i := to - 1 TO from BY -1 DO
-          S.GET(i, x)
-        END
-      END;
-    END;
-    testRead := FALSE;
-    RETURN res = 0
-  END IsReadable;
-
-  (* --------------------- NEW implementation (portable) -------------------- *)
-
-  PROCEDURE^ NewBlock (size: INTEGER): Block;
-
-  PROCEDURE NewRec* (typ: INTEGER): INTEGER;  (* implementation of NEW(ptr) *)
-    VAR size, adr: INTEGER; b: Block; tag: Type; l: FList;
-  BEGIN
-    IF ~ODD(typ) THEN
-      tag := S.VAL(Type, typ);
-      b := NewBlock(tag.size);
-      IF b # NIL THEN
-        b.tag := tag;
-        S.GET(typ - 4, size);
-        IF size # 0 THEN (* record uses a finalizer *)
-          l := S.VAL(FList, S.ADR(b.last)); (* anchor new object! *)
-          l := S.VAL(FList, NewRec(S.TYP(FList)));  (* NEW(l) *)
-          l.blk := b; l.next := finalizers; finalizers := l
-        END;
-        adr := S.ADR(b.last)
-      ELSE
-        adr := 0
-      END
-    ELSE
-      HALT(100)  (* COM interface pointers not supported *)
-    END;
-    RETURN adr
-  END NewRec;
-
-  PROCEDURE NewArr* (eltyp, nofelem, nofdim: INTEGER): INTEGER; (* impl. of NEW(ptr, dim0, dim1, ...) *)
-    VAR b: Block; size, headSize: INTEGER; t: Type;
-  BEGIN
-    CASE eltyp OF
-    | -1: HALT(100)  (* COM interface pointers not supported *)
-    | 0: eltyp := S.ADR(PtrType)
-    | 1: eltyp := S.ADR(Char8Type)
-    | 2: eltyp := S.ADR(Int16Type)
-    | 3: eltyp := S.ADR(Int8Type)
-    | 4: eltyp := S.ADR(Int32Type)
-    | 5: eltyp := S.ADR(BoolType)
-    | 6: eltyp := S.ADR(SetType)
-    | 7: eltyp := S.ADR(Real32Type)
-    | 8: eltyp := S.ADR(Real64Type)
-    | 9: eltyp := S.ADR(Char16Type)
-    | 10: eltyp := S.ADR(Int64Type)
-    | 11: eltyp := S.ADR(ProcType)
-    | 12: HALT(101)  (* COM interface pointers not supported *)
-    ELSE
-      ASSERT(~ODD(eltyp), 102)  (* COM interface pointers not supported *)
-    END;
-    t := S.VAL(Type, eltyp);
-    headSize := 4 * nofdim + 12;
-    size := headSize + nofelem * t.size;
-    b := NewBlock(size);
-    IF b # NIL THEN
-      b.tag := S.VAL(Type, eltyp + 2);  (* tag + array mark *)
-      b.last := S.ADR(b.last) + size - t.size;  (* pointer to last elem *)
-      b.first := S.ADR(b.last) + headSize;  (* pointer to first elem *)
-      RETURN S.ADR(b.last)
-    ELSE
-      RETURN 0
-    END;
-  END NewArr;
-
-  (* -------------------- handler installation (portable) --------------------- *)
-
-  PROCEDURE ThisFinObj* (VAR id: Identifier): ANYPTR;
-    VAR l: FList;
-  BEGIN
-    ASSERT(id.typ # 0, 100);
-    l := finalizers;
-    WHILE l # NIL DO
-      IF S.VAL(INTEGER, l.blk.tag) = id.typ THEN
-        id.obj := S.VAL(ANYPTR, S.ADR(l.blk.last));
-        IF id.Identified() THEN RETURN id.obj END
-      END;
-      l := l.next
-    END;
-    RETURN NIL
-  END ThisFinObj;
-
-  PROCEDURE InstallReducer* (r: Reducer);
-  BEGIN
-    r.next := reducers; reducers := r
-  END InstallReducer;
-
-  PROCEDURE InstallTrapViewer* (h: Handler);
-  BEGIN
-    trapViewer := h
-  END InstallTrapViewer;
-
-  PROCEDURE InstallTrapChecker* (h: Handler);
-  BEGIN
-    trapChecker := h
-  END InstallTrapChecker;
-
-  PROCEDURE PushTrapCleaner* (c: TrapCleaner);
-    VAR t: TrapCleaner;
-  BEGIN
-    t := trapStack; WHILE (t # NIL) & (t # c) DO t := t.next END;
-    ASSERT(t = NIL, 20);
-    c.next := trapStack; trapStack := c
-  END PushTrapCleaner;
-
-  PROCEDURE PopTrapCleaner* (c: TrapCleaner);
-    VAR t: TrapCleaner;
-  BEGIN
-    t := NIL;
-    WHILE (trapStack # NIL) & (t # c) DO
-      t := trapStack; trapStack := trapStack.next
-    END
-  END PopTrapCleaner;
-
-  PROCEDURE InstallCleaner* (p: Command);
-    VAR c: CList;
-  BEGIN
-    c := S.VAL(CList, NewRec(S.TYP(CList)));  (* NEW(c) *)
-    c.do := p; c.trapped := FALSE; c.next := cleaners; cleaners := c
-  END InstallCleaner;
-
-  PROCEDURE RemoveCleaner* (p: Command);
-    VAR c0, c: CList;
-  BEGIN
-    c := cleaners; c0 := NIL;
-    WHILE (c # NIL) & (c.do # p) DO c0 := c; c := c.next END;
-    IF c # NIL THEN
-      IF c0 = NIL THEN cleaners := cleaners.next ELSE c0.next := c.next END
-    END
-  END RemoveCleaner;
-
-  PROCEDURE Cleanup*;
-    VAR c, c0: CList;
-  BEGIN
-    c := cleaners; c0 := NIL;
-    WHILE c # NIL DO
-      IF ~c.trapped THEN
-        c.trapped := TRUE; c.do; c.trapped := FALSE; c0 := c
-      ELSE
-        IF c0 = NIL THEN cleaners := cleaners.next
-        ELSE c0.next := c.next
-        END
-      END;
-      c := c.next
-    END
-  END Cleanup;
-
-  (* -------------------- meta information (portable) --------------------- *)
-
-  PROCEDURE (h: LoaderHook) ThisMod* (IN name: ARRAY OF CHAR): Module, NEW, ABSTRACT;
-
-  PROCEDURE SetLoaderHook*(h: LoaderHook);
-  BEGIN
-    loader := h
-  END SetLoaderHook;
-
-  PROCEDURE InitModule (mod: Module); (* initialize linked modules *)
-    VAR body: Command;
-  BEGIN
-    IF ~(dyn IN mod.opts) & (mod.next # NIL) & ~(init IN mod.next.opts) THEN InitModule(mod.next) END;
-    IF ~(init IN mod.opts) THEN
-      body := S.VAL(Command, mod.code);
-      INCL(mod.opts, init);
-      actual := mod;
-      body(); actual := NIL
-    END
-  END InitModule;
-
-  PROCEDURE ThisLoadedMod* (IN name: ARRAY OF CHAR): Module;  (* loaded modules only *)
-    VAR m: Module; res: INTEGER; n: Utf8Name;
-  BEGIN
-    StringToUtf8(name, n, res); ASSERT(res = 0);
-    loadres := done;
-    m := modList;
-    WHILE (m # NIL) & ((m.name # n) OR (m.refcnt < 0)) DO m := m.next END;
-    IF (m # NIL) & ~(init IN m.opts) THEN InitModule(m) END;
-    IF m = NIL THEN loadres := moduleNotFound END;
-    RETURN m
-  END ThisLoadedMod;
-
-  PROCEDURE ThisMod* (IN name: ARRAY OF CHAR): Module;
-  BEGIN
-    IF loader # NIL THEN
-      loader.res := done;
-      RETURN loader.ThisMod(name)
-    ELSE
-      RETURN ThisLoadedMod(name)
-    END
-  END ThisMod;
-
-  PROCEDURE LoadMod* (IN name: ARRAY OF CHAR);
-    VAR m: Module;
-  BEGIN
-    m := ThisMod(name)
-  END LoadMod;
-
-  PROCEDURE GetLoaderResult* (OUT res: INTEGER; OUT importing, imported, object: ARRAY OF CHAR);
-  BEGIN
-    IF loader # NIL THEN
-      res := loader.res;
-      importing := loader.importing$;
-      imported := loader.imported$;
-      object := loader.object$
-    ELSE
-      res := loadres;
-      importing := "";
-      imported := "";
-      object := ""
-    END
-  END GetLoaderResult;
-
-  PROCEDURE ThisObject* (mod: Module; IN name: ARRAY OF CHAR): Object;
-    VAR l, r, m, res: INTEGER; p: StrPtr; n: Utf8Name;
-  BEGIN
-    StringToUtf8(name, n, res); ASSERT(res = 0);
-    l := 0; r := mod.export.num;
-    WHILE l < r DO  (* binary search *)
-      m := (l + r) DIV 2;
-      p := S.VAL(StrPtr, S.ADR(mod.names[mod.export.obj[m].id DIV 256]));
-      IF p^ = n THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[m])) END;
-      IF p^ < n THEN l := m + 1 ELSE r := m END
-    END;
-    RETURN NIL
-  END ThisObject;
-
-  PROCEDURE ThisDesc* (mod: Module; fprint: INTEGER): Object;
-    VAR i, n: INTEGER;
-  BEGIN
-    i := 0; n := mod.export.num;
-    WHILE (i < n) & (mod.export.obj[i].id DIV 256 = 0) DO 
-      IF mod.export.obj[i].offs = fprint THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[i])) END;
-      INC(i)
-    END;
-    RETURN NIL
-  END ThisDesc;
-
-  PROCEDURE ThisField* (rec: Type; IN name: ARRAY OF CHAR): Object;
-    VAR n, res: INTEGER; p: StrPtr; obj: Object; m: Module; nn: Utf8Name;
-  BEGIN
-    StringToUtf8(name, nn, res); ASSERT(res = 0);
-    m := rec.mod;
-    obj := S.VAL(Object, S.ADR(rec.fields.obj[0])); n := rec.fields.num;
-    WHILE n > 0 DO
-      p := S.VAL(StrPtr, S.ADR(m.names[obj.id DIV 256]));
-      IF p^ = nn THEN RETURN obj END;
-      DEC(n); INC(S.VAL(INTEGER, obj), 16)
-    END;
-    RETURN NIL
-  END ThisField;
-
-  PROCEDURE ThisCommand* (mod: Module; IN name: ARRAY OF CHAR): Command;
-    VAR x: Object; sig: Signature;
-  BEGIN
-    x := ThisObject(mod, name);
-    IF (x # NIL) & (x.id MOD 16 = mProc) THEN
-      sig := S.VAL(Signature, x.struct);
-      IF (sig.retStruct = NIL) & (sig.num = 0) THEN RETURN S.VAL(Command, mod.procBase + x.offs) END
-    END;
-    RETURN NIL
-  END ThisCommand;
-
-  PROCEDURE ThisType* (mod: Module; IN name: ARRAY OF CHAR): Type;
-    VAR x: Object;
-  BEGIN
-    x := ThisObject(mod, name);
-    IF (x # NIL) & (x.id MOD 16 = mTyp) & (S.VAL(INTEGER, x.struct) DIV 256 # 0) THEN
-      RETURN x.struct
-    ELSE
-      RETURN NIL
-    END
-  END ThisType;
-
-  PROCEDURE TypeOf* (IN rec: ANYREC): Type;
-  BEGIN
-    RETURN S.VAL(Type, S.TYP(rec))
-  END TypeOf;
-
-  PROCEDURE LevelOf* (t: Type): SHORTINT;
-  BEGIN
-    RETURN SHORT(t.id DIV 16 MOD 16)
-  END LevelOf;
-
-  PROCEDURE NewObj* (VAR o: S.PTR; t: Type);
-    VAR i: INTEGER;
-  BEGIN
-    IF t.size = -1 THEN o := NIL
-    ELSE
-      i := 0; WHILE t.ptroffs[i] >= 0 DO INC(i) END;
-      IF t.ptroffs[i+1] >= 0 THEN INC(S.VAL(INTEGER, t)) END; (* with interface pointers *)
-      o := S.VAL(S.PTR, NewRec(S.VAL(INTEGER, t)))  (* generic NEW *)
-    END
-  END NewObj;
-
-  PROCEDURE GetModName* (mod: Module; OUT name: Name);
-    VAR res: INTEGER;
-  BEGIN
-    Utf8ToString(mod.name, name, res); ASSERT(res = 0)
-  END GetModName;
-
-  PROCEDURE GetObjName* (mod: Module; obj: Object; OUT name: Name);
-    VAR p: StrPtr; res: INTEGER;
-  BEGIN
-    p := S.VAL(StrPtr, S.ADR(mod.names[obj.id DIV 256]));
-    Utf8ToString(p^$, name, res); ASSERT(res = 0)
-  END GetObjName;
-
-  PROCEDURE GetTypeName* (t: Type; OUT name: Name);
-    VAR p: StrPtr; res: INTEGER;
-  BEGIN
-    p := S.VAL(StrPtr, S.ADR(t.mod.names[t.id DIV 256]));
-    Utf8ToString(p^$, name, res); ASSERT(res = 0)
-  END GetTypeName;
-
-  PROCEDURE RegisterMod* (mod: Module);
-    VAR i: INTEGER; epoch: time.time_t; tm: time.struct_tm; ptm: time.Pstruct_tm;
-  BEGIN
-    mod.next := modList; modList := mod; mod.refcnt := 0; INCL(mod.opts, dyn); i := 0;
-    WHILE i < mod.nofimps DO
-      IF mod.imports[i] # NIL THEN INC(mod.imports[i].refcnt) END;
-      INC(i)
-    END;
-    epoch := time.time(NIL);
-    ptm := time.localtime_r(epoch, tm);
-    IF ptm # NIL THEN
-      mod.loadTime[0] := SHORT(tm.tm_year + 1900);
-      mod.loadTime[1] := SHORT(tm.tm_mon + 1);
-      mod.loadTime[2] := SHORT(tm.tm_mday);
-      mod.loadTime[3] := SHORT(tm.tm_hour);
-      mod.loadTime[4] := SHORT(tm.tm_min);
-      mod.loadTime[5] := SHORT(tm.tm_sec)
-    ELSE
-      mod.loadTime[0] := 0;
-      mod.loadTime[1] := 0;
-      mod.loadTime[2] := 0;
-      mod.loadTime[3] := 0;
-      mod.loadTime[4] := 0;
-      mod.loadTime[5] := 0
-    END;
-    IF ~(init IN mod.opts) THEN InitModule(mod) END
-  END RegisterMod;
-
-  PROCEDURE^ Collect*;
-
-  PROCEDURE UnloadMod* (mod: Module);
-    VAR i: INTEGER; t: Command;
-  BEGIN
-    IF mod.refcnt = 0 THEN
-      t := mod.term; mod.term := NIL;
-      IF t # NIL THEN t() END;  (* terminate module *)
-      i := 0;
-      WHILE i < mod.nofptrs DO  (* release global pointers *)
-        S.PUT(mod.varBase + mod.ptrs[i], 0); INC(i)
-      END;
-      Collect;  (* call finalizers *)
-      i := 0;
-      WHILE i < mod.nofimps DO  (* release imported modules *)
-        IF mod.imports[i] # NIL THEN DEC(mod.imports[i].refcnt) END;
-        INC(i)
-      END;
-      mod.refcnt := -1;
-      IF dyn IN mod.opts THEN (* release memory *)
-        InvalModMem(mod.data + mod.dsize - mod.refs, mod.refs)
-      END
-    END
-  END UnloadMod;
-
-  (* -------------------- dynamic procedure call  --------------------- *)
-
-  PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
-  BEGIN
-    HALT(126); (* !!! *)
-    RETURN 0
-  END Call;
-
-  (* -------------------- reference information (portable) --------------------- *)
-
-  PROCEDURE RefCh (VAR ref: INTEGER; OUT ch: SHORTCHAR);
-  BEGIN
-    S.GET(ref, ch); INC(ref)
-  END RefCh;
-
-  PROCEDURE RefNum (VAR ref: INTEGER; OUT x: INTEGER);
-    VAR s, n: INTEGER; ch: SHORTCHAR;
-  BEGIN
-    s := 0; n := 0; RefCh(ref, ch);
-    WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); RefCh(ref, ch) END;
-    x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s)
-  END RefNum;
-
-  PROCEDURE RefName (VAR ref: INTEGER; OUT n: Utf8Name);
-    VAR i: INTEGER; ch: SHORTCHAR;
-  BEGIN
-    i := 0; RefCh(ref, ch);
-    WHILE ch # 0X DO n[i] := ch; INC(i); RefCh(ref, ch) END;
-    n[i] := 0X
-  END RefName;
-
-  PROCEDURE GetRefProc* (VAR ref: INTEGER; OUT adr: INTEGER; OUT name: Utf8Name);
-    VAR ch: SHORTCHAR;
-  BEGIN
-    S.GET(ref, ch);
-    WHILE ch >= 0FDX DO (* skip variables *)
-      INC(ref); RefCh(ref, ch);
-      IF ch = 10X THEN INC(ref, 4) END;
-      RefNum(ref, adr); RefName(ref, name); S.GET(ref, ch)
-    END;
-    WHILE (ch > 0X) & (ch < 0FCX) DO  (* skip source refs *)
-      INC(ref); RefNum(ref, adr); S.GET(ref, ch)
-    END;
-    IF ch = 0FCX THEN INC(ref); RefNum(ref, adr); RefName(ref, name)
-    ELSE adr := 0
-    END
-  END GetRefProc;
-
-  PROCEDURE GetRefVar* (VAR ref: INTEGER; OUT mode, form: SHORTCHAR; OUT desc: Type; OUT adr: INTEGER; OUT name: Utf8Name);
-  BEGIN
-    S.GET(ref, mode); desc := NIL;
-    IF mode >= 0FDX THEN
-      mode := SHORT(CHR(ORD(mode) - 0FCH));
-      INC(ref); RefCh(ref, form);
-      IF form = 10X THEN
-        S.GET(ref, desc); INC(ref, 4); form := SHORT(CHR(16 + desc.id MOD 4))
-      END;
-      RefNum(ref, adr); RefName(ref, name)
-    ELSE
-      mode := 0X; form := 0X; adr := 0
-    END
-  END GetRefVar;
-
-  PROCEDURE SourcePos* (mod: Module; codePos: INTEGER): INTEGER;
-    VAR ref, pos, ad, d: INTEGER; ch: SHORTCHAR; name: Utf8Name;
-  BEGIN
-    IF mod # NIL THEN (* mf, 12.02.04 *)
-      ref := mod.refs; pos := 0; ad := 0; S.GET(ref, ch);
-      WHILE ch # 0X DO
-        WHILE (ch > 0X) & (ch < 0FCX) DO  (* srcref: {dAdr,dPos} *)
-          INC(ad, ORD(ch)); INC(ref); RefNum(ref, d);
-          IF ad > codePos THEN RETURN pos END;
-          INC(pos, d); S.GET(ref, ch)
-        END;
-        IF ch = 0FCX THEN (* proc: 0FCX,Adr,Name *)
-          INC(ref); RefNum(ref, d); RefName(ref, name); S.GET(ref, ch);
-          IF (d > codePos) & (pos > 0) THEN RETURN pos END 
-        END;
-        WHILE ch >= 0FDX DO (* skip variables: Mode, Form, adr, Name *)
-          INC(ref); RefCh(ref, ch);
-          IF ch = 10X THEN INC(ref, 4) END;
-          RefNum(ref, d); RefName(ref, name); S.GET(ref, ch)
-        END
-      END;
-    END;
-    RETURN -1
-  END SourcePos;
-
-  PROCEDURE LoadDll* (IN name: ARRAY OF CHAR; VAR ok: BOOLEAN);
-    VAR h: ADDRESS; file: Utf8Name; res: INTEGER;
-  BEGIN
-    StringToUtf8(name, file, res);
-    IF res = 0 THEN
-      h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
-      ok := h # 0
-    ELSE
-      ok := FALSE
-    END
-  END LoadDll;
-
-  PROCEDURE ThisDllObj* (mode, fprint: INTEGER; IN dll, name: ARRAY OF CHAR): INTEGER;
-    VAR h, p: ADDRESS; file, sym: Utf8Name; res: INTEGER; err: dlfcn.int;
-  BEGIN
-    StringToUtf8(dll, file, res);
-    IF res = 0 THEN
-      h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
-      IF h # 0 THEN
-        StringToUtf8(name, sym, res);
-        IF res = 0 THEN
-          p := dlfcn.dlsym(h, sym)
-        ELSE
-          p := 0
-        END;
-        err := dlfcn.dlclose(h);
-        ASSERT(err = 0, 100)
-      ELSE
-        p := 0
-      END
-    ELSE
-      p := 0
-    END;
-    RETURN p
-  END ThisDllObj;
-
-  (* -------------------- garbage collector (portable) --------------------- *)
-
-  PROCEDURE Mark (this: Block);
-    VAR father, son: Block; tag: Type; flag, offset, actual: INTEGER;
-  BEGIN
-    IF ~ODD(S.VAL(INTEGER, this.tag)) THEN
-      father := NIL;
-      LOOP
-        INC(S.VAL(INTEGER, this.tag));
-        flag := S.VAL(INTEGER, this.tag) MOD 4;
-        tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
-        IF flag >= 2 THEN actual := this.first; this.actual := actual
-        ELSE actual := S.ADR(this.last)
-        END;
-        LOOP
-          offset := tag.ptroffs[0];
-          IF offset < 0 THEN
-            INC(S.VAL(INTEGER, tag), offset + 4); (* restore tag *)
-            IF (flag >= 2) & (actual < this.last) & (offset < -4) THEN  (* next array element *)
-              INC(actual, tag.size); this.actual := actual
-            ELSE  (* up *)
-              this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
-              IF father = NIL THEN RETURN END;
-              son := this; this := father;
-              flag := S.VAL(INTEGER, this.tag) MOD 4;
-              tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
-              offset := tag.ptroffs[0];
-              IF flag >= 2 THEN actual := this.actual ELSE actual := S.ADR(this.last) END;
-              S.GET(actual + offset, father); S.PUT(actual + offset, S.ADR(son.last));
-              INC(S.VAL(INTEGER, tag), 4)
-            END
-          ELSE
-            S.GET(actual + offset, son);
-            IF son # NIL THEN
-              DEC(S.VAL(INTEGER, son), 4);
-              IF ~ODD(S.VAL(INTEGER, son.tag)) THEN (* down *)
-                this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
-                S.PUT(actual + offset, father); father := this; this := son;
-                EXIT
-              END
-            END;
-            INC(S.VAL(INTEGER, tag), 4)
-          END
-        END
-      END
-    END
-  END Mark;
-
-  PROCEDURE MarkGlobals;
-    VAR m: Module; i, p: INTEGER;
-  BEGIN
-    m := modList;
-    WHILE m # NIL DO
-      IF m.refcnt >= 0 THEN
-        i := 0;
-        WHILE i < m.nofptrs DO
-          S.GET(m.varBase + m.ptrs[i], p); INC(i);
-          IF p # 0 THEN Mark(S.VAL(Block, p - 4)) END
-        END
-      END;
-      m := m.next
-    END
-  END MarkGlobals;
-
-  PROCEDURE Next (b: Block): Block; (* next block in same cluster *)
-    VAR size: INTEGER;
-  BEGIN
-    S.GET(S.VAL(INTEGER, b.tag) DIV 4 * 4, size);
-    IF ODD(S.VAL(INTEGER, b.tag) DIV 2) THEN INC(size, b.last - S.ADR(b.last)) END;
-    RETURN S.VAL(Block, S.VAL(INTEGER, b) + (size + 19) DIV 16 * 16)
-  END Next;
-
-  PROCEDURE CheckCandidates;
-  (* pre: nofcand > 0 *)
-    VAR i, j, h, p, end: INTEGER; c: Cluster; blk, next: Block;
-  BEGIN
-    (* sort candidates (shellsort) *)
-    h := 1; REPEAT h := h*3 + 1 UNTIL h > nofcand;
-    REPEAT h := h DIV 3; i := h;
-      WHILE i < nofcand DO p := candidates[i]; j := i;
-        WHILE (j >= h) & (candidates[j-h] > p) DO
-          candidates[j] := candidates[j-h]; j := j-h
-        END;
-        candidates[j] := p; INC(i)
-      END
-    UNTIL h = 1;
-    (* sweep *)
-    c := root; i := 0;
-    WHILE c # NIL DO
-      blk := S.VAL(Block, S.VAL(INTEGER, c) + 12);
-      end := S.VAL(INTEGER, blk) + (c.size - 12) DIV 16 * 16;
-      WHILE candidates[i] < S.VAL(INTEGER, blk) DO
-        INC(i);
-        IF i = nofcand THEN RETURN END
-      END;
-      WHILE S.VAL(INTEGER, blk) < end DO
-        next := Next(blk);
-        IF candidates[i] < S.VAL(INTEGER, next) THEN
-          IF (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last))  (* not a free block *)
-              & (~strictStackSweep OR (candidates[i] = S.ADR(blk.last))) THEN
-            Mark(blk)
-          END;
-          REPEAT
-            INC(i);
-            IF i = nofcand THEN RETURN END
-          UNTIL candidates[i] >= S.VAL(INTEGER, next)
-        END;
-        IF (S.VAL(INTEGER, blk.tag) MOD 4 = 0) & (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last))
-            & (blk.tag.base[0] = NIL) & (blk.actual > 0) THEN (* referenced interface record *)
-          Mark(blk)
-        END;
-        blk := next
-      END;
-      c := c.next
-    END
-  END CheckCandidates;
-
-  PROCEDURE MarkLocals;
-    VAR sp, p, min, max: INTEGER; c: Cluster;
-  BEGIN
-    sp := S.ADR(sp); nofcand := 0; c := root;
-    WHILE c.next # NIL DO c := c.next END;
-    min := S.VAL(INTEGER, root); max := S.VAL(INTEGER, c) + c.size;
-    WHILE sp < baseStack DO
-      S.GET(sp, p);
-      IF (p > min) & (p < max) & (~strictStackSweep OR (p MOD 16 = 0)) THEN
-        candidates[nofcand] := p; INC(nofcand);
-        IF nofcand = LEN(candidates) - 1 THEN CheckCandidates; nofcand := 0 END
-      END;
-      INC(sp, 4)
-    END;
-    candidates[nofcand] := max; INC(nofcand); (* ensure complete scan for interface mark*)
-    IF nofcand > 0 THEN CheckCandidates END
-  END MarkLocals;
-
-  PROCEDURE MarkFinObj;
-    VAR f: FList;
-  BEGIN
-    wouldFinalize := FALSE;
-    f := finalizers;
-    WHILE f # NIL DO
-      IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
-      Mark(f.blk);
-      f := f.next
-    END;
-    f := hotFinalizers;
-    WHILE f # NIL DO IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
-      Mark(f.blk);
-      f := f.next
-    END
-  END MarkFinObj;
-
-  PROCEDURE CheckFinalizers;
-    VAR f, g, h, k: FList;
-  BEGIN
-    f := finalizers; g := NIL;
-    IF hotFinalizers = NIL THEN k := NIL
-    ELSE
-      k := hotFinalizers;
-      WHILE k.next # NIL DO k := k.next END
-    END;
-    WHILE f # NIL DO
-      h := f; f := f.next;
-      IF ~ODD(S.VAL(INTEGER, h.blk.tag)) THEN
-        IF g = NIL THEN finalizers := f ELSE g.next := f END;
-        IF k = NIL THEN hotFinalizers := h ELSE k.next := h END;
-        k := h; h.next := NIL
-      ELSE g := h
-      END
-    END;
-    h := hotFinalizers;
-    WHILE h # NIL DO Mark(h.blk); h := h.next END
-  END CheckFinalizers;
-
-  PROCEDURE ExecFinalizer (a, b, c: INTEGER);
-    VAR f: FList; fin: PROCEDURE(this: ANYPTR);
-  BEGIN
-    f := S.VAL(FList, a);
-    S.GET(S.VAL(INTEGER, f.blk.tag) - 4, fin);  (* method 0 *)
-    IF (fin # NIL) & (f.blk.tag.mod.refcnt >= 0) THEN fin(S.VAL(ANYPTR, S.ADR(f.blk.last))) END;
-  END ExecFinalizer;
-
-  PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER);  (* COMPILER DEPENDENT *)
-
-  PROCEDURE CallFinalizers;
-    VAR f: FList;
-  BEGIN
-    WHILE hotFinalizers # NIL DO
-      f := hotFinalizers; hotFinalizers := hotFinalizers.next;
-      Try(ExecFinalizer, S.VAL(INTEGER, f), 0, 0)
-    END;
-    wouldFinalize := FALSE
-  END CallFinalizers;
-
-  PROCEDURE Insert (blk: FreeBlock; size: INTEGER); (* insert block in free list *)
-    VAR i: INTEGER;
-  BEGIN
-    blk.size := size - 4; blk.tag := S.VAL(Type, S.ADR(blk.size));
-    i := MIN(N - 1, (blk.size DIV 16));
-    blk.next := free[i]; free[i] := blk
-  END Insert;
-
-  PROCEDURE Sweep (dealloc: BOOLEAN);
-    VAR cluster, last, c: Cluster; blk, next: Block; fblk, b, t: FreeBlock; end, i: INTEGER;
-  BEGIN
-    cluster := root; last := NIL; allocated := 0;
-    i := N;
-    REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
-    WHILE cluster # NIL DO
-      blk := S.VAL(Block, S.VAL(INTEGER, cluster) + 12);
-      end := S.VAL(INTEGER, blk) + (cluster.size - 12) DIV 16 * 16;
-      fblk := NIL;
-      WHILE S.VAL(INTEGER, blk) < end DO
-        next := Next(blk);
-        IF ODD(S.VAL(INTEGER, blk.tag)) THEN
-          IF fblk # NIL THEN
-            Insert(fblk, S.VAL(INTEGER, blk) - S.VAL(INTEGER, fblk));
-            fblk := NIL
-          END;
-          DEC(S.VAL(INTEGER, blk.tag)); (* unmark *)
-          INC(allocated, S.VAL(INTEGER, next) - S.VAL(INTEGER, blk))
-        ELSIF fblk = NIL THEN
-          fblk := S.VAL(FreeBlock, blk)
-        END;
-        blk := next
-      END;
-      IF dealloc & (S.VAL(INTEGER, fblk) = S.VAL(INTEGER, cluster) + 12) THEN (* deallocate cluster *)
-        c := cluster; cluster := cluster.next;
-        IF last = NIL THEN root := cluster ELSE last.next := cluster END;
-        FreeHeapMem(c)
-      ELSE
-        IF fblk # NIL THEN Insert(fblk, end - S.VAL(INTEGER, fblk)) END;
-        last := cluster; cluster := cluster.next
-      END
-    END;
-    (* reverse free list *)
-    i := N;
-    REPEAT
-      DEC(i);
-      b := free[i]; fblk := sentinel;
-      WHILE b # sentinel DO t := b; b := t.next; t.next := fblk; fblk := t END;
-      free[i] := fblk
-    UNTIL i = 0
-  END Sweep;
-
-  PROCEDURE Collect*;
-  BEGIN
-    IF root # NIL THEN
-      CallFinalizers; (* trap cleanup *)
-      MarkGlobals;
-      MarkLocals;
-      CheckFinalizers;
-      Sweep(TRUE);
-      CallFinalizers
-    END
-  END Collect;
-  
-  PROCEDURE FastCollect*;
-  BEGIN
-    IF root # NIL THEN
-      MarkGlobals;
-      MarkLocals;
-      MarkFinObj;
-      Sweep(FALSE)
-    END
-  END FastCollect;
-
-  PROCEDURE WouldFinalize* (): BOOLEAN;
-  BEGIN
-    RETURN wouldFinalize
-  END WouldFinalize;
-
-  (* --------------------- memory allocation (portable) -------------------- *)
-
-  PROCEDURE OldBlock (size: INTEGER): FreeBlock;  (* size MOD 16 = 0 *)
-    VAR b, l: FreeBlock; s, i: INTEGER;
-  BEGIN
-    s := size - 4;
-    i := MIN(N - 1, s DIV 16);
-    WHILE (i # N - 1) & (free[i] = sentinel) DO INC(i) END;
-    b := free[i]; l := NIL;
-    WHILE b.size < s DO l := b; b := b.next END;
-    IF b # sentinel THEN
-      IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
-    ELSE b := NIL
-    END;
-    RETURN b
-  END OldBlock;
-
-  PROCEDURE LastBlock (limit: INTEGER): FreeBlock;  (* size MOD 16 = 0 *)
-    VAR b, l: FreeBlock; s, i: INTEGER;
-  BEGIN
-    s := limit - 4;
-    i := 0;
-    REPEAT
-      b := free[i]; l := NIL;
-      WHILE (b # sentinel) & (S.VAL(INTEGER, b) + b.size # s) DO l := b; b := b.next END;
-      IF b # sentinel THEN
-        IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
-      ELSE b := NIL
-      END;
-      INC(i)
-    UNTIL (b # NIL) OR (i = N);
-    RETURN b
-  END LastBlock;
-
-  PROCEDURE NewBlock (size: INTEGER): Block;
-    VAR tsize, a, s: INTEGER; b: FreeBlock; new, c: Cluster; r: Reducer;
-  BEGIN
-    ASSERT(size >= 0, 20);
-    IF size > MAX(INTEGER) - 19 THEN RETURN NIL END;
-    tsize := (size + 19) DIV 16 * 16;
-    b := OldBlock(tsize); (* 1) search for free block *)
-    IF b = NIL THEN
-      FastCollect; b := OldBlock(tsize);  (* 2) collect *)
-      IF b = NIL THEN
-        Collect; b := OldBlock(tsize);  (* 2a) fully collect *)
-      END;
-      IF b = NIL THEN
-        AllocHeapMem(tsize + 12, new);  (* 3) allocate new cluster *)
-        IF new # NIL THEN
-          IF (root = NIL) OR (S.VAL(INTEGER, new) < S.VAL(INTEGER, root)) THEN
-            new.next := root; root := new
-          ELSE
-            c := root;
-            WHILE (c.next # NIL) & (S.VAL(INTEGER, new) > S.VAL(INTEGER, c.next)) DO c := c.next END;
-            new.next := c.next; c.next := new
-          END;
-          b := S.VAL(FreeBlock, S.VAL(INTEGER, new) + 12);
-          b.size := (new.size - 12) DIV 16 * 16 - 4
-        ELSE
-          RETURN NIL  (* 4) give up *)
-        END
-      END
-    END;
-    (* b # NIL *)
-    a := b.size + 4 - tsize;
-    IF a > 0 THEN Insert(S.VAL(FreeBlock, S.VAL(INTEGER, b) + tsize), a) END;
-    IF size > 0 THEN Erase(S.ADR(b.size), (size + 3) DIV 4) END;
-    INC(allocated, tsize);
-    RETURN S.VAL(Block, b)
-  END NewBlock;
-
-  PROCEDURE Allocated* (): INTEGER;
-  BEGIN
-    RETURN allocated
-  END Allocated;
-
-  PROCEDURE Used* (): INTEGER;
-  BEGIN
-    RETURN used
-  END Used;
-
-  PROCEDURE Root* (): INTEGER;
-  BEGIN
-    RETURN S.VAL(INTEGER, root)
-  END Root;
-
-  (* -------------------- Trap Handling --------------------- *)
-
-  PROCEDURE Start* (code: Command);
-    VAR res: setjmp.int;
-  BEGIN
-    restart := code;
-    S.GETREG(SP, baseStack);
-    res := setjmp.sigsetjmp(startEnv, 1);
-    restart
-  END Start;
-
-  PROCEDURE Quit* (exitCode: INTEGER);
-    VAR m: Module; term: Command; t: BOOLEAN;
-  BEGIN
-    trapViewer := NIL; trapChecker := NIL; restart := NIL;
-    t := terminating; terminating := TRUE; m := modList;
-    WHILE m # NIL DO  (* call terminators *)
-      IF ~static OR ~t THEN
-        term := m.term; m.term := NIL;
-        IF term # NIL THEN term() END
-      END;
-      m := m.next
-    END;
-    CallFinalizers;
-    hotFinalizers := finalizers; finalizers := NIL;
-    CallFinalizers;
-    stdlib.exit(exitCode)
-  END Quit;
-
-  PROCEDURE FatalError* (id: INTEGER; str: ARRAY OF CHAR);
-    VAR res: stdio.int; title: ARRAY 16 OF CHAR; text: ARRAY 256 OF SHORTCHAR;
-  BEGIN
-    title := "Error xy";
-    title[6] := CHR(id DIV 10 + ORD("0"));
-    title[7] := CHR(id MOD 10 + ORD("0"));
-    res := unistd.write(2, S.ADR(title), 8);
-    stdlib.abort
-  END FatalError;
-
-  PROCEDURE DefaultTrapViewer;
-    VAR out: ARRAY 2048 OF SHORTCHAR; a, b, c, len, ref, end: INTEGER; mod: Module;
-      modName, name: Name; n: Utf8Name; res: unistd.int;
-
-    PROCEDURE WriteString (IN s: ARRAY OF SHORTCHAR);
-      VAR i: INTEGER;
-    BEGIN
-      i := 0;
-      WHILE (len < LEN(out) - 1) & (s[i] # 0X) DO out[len] := s[i]; INC(i); INC(len) END
-    END WriteString;
-
-    PROCEDURE WriteHex (x, n: INTEGER);
-      VAR i, y: INTEGER;
-    BEGIN
-      IF len + n < LEN(out) THEN
-        i := len + n - 1;
-        WHILE i >= len DO
-          y := x MOD 16; x := x DIV 16;
-          IF y > 9 THEN y := y + (ORD("A") - ORD("0") - 10) END;
-          out[i] := SHORT(CHR(y + ORD("0"))); DEC(i)
-        END;
-        INC(len, n)
-      END
-    END WriteHex;
-
-    PROCEDURE WriteLn;
-    BEGIN
-      IF len < LEN(out) - 1 THEN out[len] := 0AX; INC(len) END
-    END WriteLn;
-
-  BEGIN
-    len := 0;
-    WriteString("====== ");
-    IF err = 129 THEN WriteString("invalid with")
-    ELSIF err = 130 THEN WriteString("invalid case")
-    ELSIF err = 131 THEN WriteString("function without return")
-    ELSIF err = 132 THEN WriteString("type guard")
-    ELSIF err = 133 THEN WriteString("implied type guard")
-    ELSIF err = 134 THEN WriteString("value out of range")
-    ELSIF err = 135 THEN WriteString("index out of range")
-    ELSIF err = 136 THEN WriteString("string too long")
-    ELSIF err = 137 THEN WriteString("stack overflow")
-    ELSIF err = 138 THEN WriteString("integer overflow")
-    ELSIF err = 139 THEN WriteString("division by zero")
-    ELSIF err = 140 THEN WriteString("infinite real result")
-    ELSIF err = 141 THEN WriteString("real underflow")
-    ELSIF err = 142 THEN WriteString("real overflow")
-    ELSIF err = 143 THEN WriteString("undefined real result")
-    ELSIF err = 144 THEN WriteString("not a number")
-    ELSIF err = 200 THEN WriteString("keyboard interrupt")
-    ELSIF err = 201 THEN WriteString("NIL dereference")
-    ELSIF err = 202 THEN WriteString("illegal instruction:  ");
-      WriteHex(val, 4)
-    ELSIF err = 203 THEN WriteString("illegal memory read [ad = ");
-      WriteHex(val, 8); WriteString("]")
-    ELSIF err = 204 THEN WriteString("illegal memory write [ad = ");
-      WriteHex(val, 8); WriteString("]")
-    ELSIF err = 205 THEN WriteString("illegal execution [ad = ");
-      WriteHex(val, 8); WriteString("]")
-    ELSIF err = 257 THEN WriteString("out of memory")
-    ELSIF err = 10001H THEN WriteString("bus error")
-    ELSIF err = 10002H THEN WriteString("address error")
-    ELSIF err = 10007H THEN WriteString("fpu error")
-    ELSIF err < 0 THEN WriteString("exception #"); WriteHex(-err, 2)
-    ELSE err := err DIV 100 * 256 + err DIV 10 MOD 10 * 16 + err MOD 10;
-      WriteString("trap #"); WriteHex(err, 3)
-    END;
-    WriteString(" ======");
-    a := pc; b := fp; c := 12;
-    REPEAT
-      WriteLn; WriteString("- ");
-      mod := modList;
-      WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
-      IF mod # NIL THEN
-        DEC(a, mod.code);
-        IF mod.refcnt >= 0 THEN
-          GetModName(mod, modName); WriteString(SHORT(modName)); ref := mod.refs;
-          REPEAT GetRefProc(ref, end, n) UNTIL (end = 0) OR (a < end);
-          IF a < end THEN
-            Utf8ToString(n, name, res); WriteString("."); WriteString(SHORT(name))
-          END
-        ELSE
-          GetModName(mod, modName); WriteString("("); WriteString(SHORT(modName)); WriteString(")")
-        END;
-        WriteString("  ")
-      END;
-      WriteString("(pc="); WriteHex(a, 8);
-      WriteString(", fp="); WriteHex(b, 8); WriteString(")");
-      IF (b >= sp) & (b < stack) THEN
-        S.GET(b+4, a);  (* stacked pc *)
-        S.GET(b, b);  (* dynamic link *)
-        DEC(c)
-      ELSE c := 0
-      END
-    UNTIL c = 0;
-    out[len] := 0X;
-    res := unistd.write(2, S.ADR(out), len)
-  END DefaultTrapViewer;
-
-  PROCEDURE TrapCleanup;
-    VAR t: TrapCleaner;
-  BEGIN
-    WHILE trapStack # NIL DO
-      t := trapStack; trapStack := trapStack.next; t.Cleanup
-    END;
-    IF (trapChecker # NIL) & (err # 128) THEN trapChecker END
-  END TrapCleanup;
-
-  PROCEDURE SetTrapGuard* (on: BOOLEAN);
-  BEGIN
-    guarded := on
-  END SetTrapGuard;
-
-  PROCEDURE Try* (h: TryHandler; a, b, c: INTEGER);
-    VAR oldIsTry: BOOLEAN; oldTryEnv: setjmp.jmp_buf; res: setjmp.int;
-  BEGIN
-    oldIsTry := isTry; oldTryEnv := tryEnv;
-    isTry := TRUE;
-    res := setjmp._setjmp(tryEnv);
-    IF res = 0 THEN h(a, b, c) END;
-    isTry := oldIsTry; tryEnv := oldTryEnv
-  END Try;
-
-  PROCEDURE Trap* (n: INTEGER);
-  BEGIN
-    IF trapped THEN
-      DefaultTrapViewer;
-      IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
-    END;
-    IF n >= 0 THEN err := n
-    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) OR (err = 200) & ~intTrap THEN (* do nothing *)
-    ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
-      trapped := TRUE; trapViewer()
-    ELSE DefaultTrapViewer
-    END;
-    trapped := FALSE; secondTrap := FALSE;
-    IF restart # NIL THEN
-      setjmp.siglongjmp(startEnv, 1)
-    END;
-    stdlib.abort
-  END Trap;
-
-  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)
-    END;
-    IF trapped THEN
-      DefaultTrapViewer;
-      IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
-    END;
-    err := -signo;
-    uc := S.VAL(signal.Pucontext_t, context);
-    pc := uc.uc_mcontext.gregs[14]; (* %eip *)
-    sp := uc.uc_mcontext.gregs[7]; (* %esp *)
-    fp := uc.uc_mcontext.gregs[6]; (* %ebp *)
-    stack := baseStack;
-    val := info.info.sigsegv.si_addr;
-    CASE signo OF
-    | signal.SIGFPE:
-        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 *)
-        | signal.FPE_FLTDIV: err := 140 (* fpu: division by zero *)
-        | signal.FPE_FLTOVF: err := 142 (* fpu: overflow *)
-        | signal.FPE_FLTUND: err := 141 (* fpu: underflow *)
-        (* !!! | signal.FPE_FLTRES: err := ??? (* fpu: *) *)
-        | signal.FPE_FLTINV: err := 143 (* val := opcode *) (* fpu: invalid op *)
-        (* !!! | signal.FPE_FLTSUB: err := ??? (* fpu: *) *)
-        ELSE (* unknown *)
-        END
-    | signal.SIGINT:
-        val := info.si_code;
-        err := 200 (* keyboard interrupt *)
-    | signal.SIGSEGV:
-        val := info.info.sigsegv.si_addr;
-        err := 203 (* illigal read *)
-    | signal.SIGBUS:
-        val := info.info.sigbus.si_addr;
-        err := 10001H (* bus error *)
-    | signal.SIGILL:
-        pc := info.info.sigill.si_addr;
-        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 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;
-    INC(trapCount);
-    (* !!! InitFPU *)
-    TrapCleanup;
-    IF isTry THEN
-      setjmp._longjmp(tryEnv, 1)
-    END;
-    IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
-    ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
-      trapped := TRUE; trapViewer()
-    ELSE DefaultTrapViewer
-    END;
-    trapped := FALSE; secondTrap := FALSE;
-    IF restart # NIL THEN
-      setjmp.siglongjmp(startEnv, 1)
-    END;
-    stdlib.abort
-  END TrapHandler;
-
-  (* -------------------- Initialization --------------------- *)
-
-  PROCEDURE InstallTrap (signo: signal.int);
-    VAR act: signal.struct_sigaction; res: signal.int;
-  BEGIN
-    act.handler.sa_handler := NIL;
-    res := signal.sigemptyset(act.sa_mask);
-    act.sa_flags := signal.SA_NODEFER + signal.SA_SIGINFO;
-    act.handler.sa_sigaction := TrapHandler;
-    res := signal.sigaction(signo, act, NIL);
-  END InstallTrap;
-
-  PROCEDURE InstallTrapVectors;
-  BEGIN
-    InstallTrap(signal.SIGFPE);
-    InstallTrap(signal.SIGINT);
-    InstallTrap(signal.SIGSEGV);
-    InstallTrap(signal.SIGBUS);
-    InstallTrap(signal.SIGILL)
-  END InstallTrapVectors;
-
-  PROCEDURE RemoveTrapVectors;
-  END RemoveTrapVectors;
-
-  PROCEDURE Init;
-    VAR i: INTEGER;
-  BEGIN
-    intTrap := TRUE;
-    pagesize := unistd.sysconf(unistd._SC_PAGESIZE);
-
-    (* init heap *)
-    allocated := 0; total := 0; used := 0;
-    sentinelBlock.size := MAX(INTEGER);
-    sentinel := S.ADR(sentinelBlock);
-    i := N;
-    REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
-
-    IF ~inDll THEN
-      InstallTrapVectors
-    END;
-
-    (* !!! InitFPU *)
-    IF ~static THEN
-      InitModule(modList);
-      IF ~inDll THEN Quit(1) END
-    END
-  END Init;
-
-BEGIN
-  IF modList = NIL THEN (* only once *)
-    S.GETREG(SP, baseStack);
-    S.GET(baseStack + 16, argc);
-    argv := S.VAL(ArrStrPtr, baseStack + 20);
-    S.GETREG(ML, modList);  (* linker loads module list to BX *)
-    static := init IN modList.opts;
-    inDll := dll IN modList.opts;
-    Init
-  END
-CLOSE
-  IF ~terminating THEN
-    terminating := TRUE;
-    Quit(0)
-  END
-END Kernel.