old file removed

new/_Linux_/System/Mod/Kernel.txt

@@ -1,2072 +0,0 @@
-MODULE Kernel;
-
-	(* THIS IS TEXT COPY OF Kernel.odc *)
-	(* DO NOT EDIT *)
-
-	(* A. V. Shiryaev, 2012.11
-		Linux Kernel
-		Based on 1.6-rc6 Windows Kernel
-		+ 20120822 Marc changes
-		Some parts taken from OpenBUGS linKernel
-
-		Most Windows-specific code removed
-		Some Windows-specific code commented and marked red
-		Windows COM-specific code re-marked from green to gray
-		Linux(/OpenBSD)-specific code marked green
-
-		TODO:
-			handle stack overflow exceptions
-			Quit from TrapHandler
-	*)
-
-	IMPORT S := SYSTEM, Libc := LinLibc, Dl := LinDl;
-
-	CONST
-		strictStackSweep = TRUE;
-
-		nameLen* = 256;
-
-		littleEndian* = TRUE;
-		timeResolution* = 1000;	(* ticks per second *)
-
-		processor* = 10;	(* i386 *)
-
-		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 *)
-
-		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;
-
-		debug = FALSE;
-
-
-(*
-		sigStackSize = MAX(Libc.SIGSTKSZ, 65536);
-*)
-
-		trapReturn = 1; (* Return value for sigsetjmp given from siglongjmp *)
-
-		(* constants for the message boxes *) 
-		mbClose* = -1; mbOk* = 0; mbCancel* =1; mbRetry* = 2; mbIgnore* = 3; mbYes* = 4; mbNo* = 5;
-
-	TYPE
-		Name* = 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-: Name
-		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;
-
-		GuiHook* = POINTER TO ABSTRACT RECORD (Hook) END; (* Implemented by HostGnome *)
-
-		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
-			(* 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;
-
-		(* Linux specific boot loader info. Record must be identical to struct in the loader. *)
-		BootInfo* = POINTER TO RECORD [untagged]
-			modList: Module;
-			argc-: INTEGER;
-			argv-: Libc.StrArray
-		END;
-
-	VAR
-		baseStack: INTEGER;	(* modList, root, and baseStack must be together for remote debugging *)
-		root: Cluster;	(* cluster list *)
-		modList-: Module;	(* root of module list *)
-		trapCount-: INTEGER;
-		err-, pc-, sp-, fp-, stack-, val-: INTEGER;
-
-		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 *)
-
-		res: INTEGER;	(* auxiliary global variables used for trap handling *)
-		old: INTEGER;
-
-		trapViewer, trapChecker: Handler;
-		trapped, guarded, secondTrap: BOOLEAN;
-		interrupted: BOOLEAN;
-		static, inDll, terminating: BOOLEAN;
-		restart: Command;
-
-		told, shift: INTEGER;	(* used in Time() *)
-
-		loader: LoaderHook;
-		loadres: INTEGER;
-
-		wouldFinalize: BOOLEAN;
-
-		watcher*: PROCEDURE (event: INTEGER);	(* for debugging *)
-
-
-(*
-		sigStack: Libc.PtrVoid;
-*)
-		
-		zerofd: INTEGER;
-		pageSize: INTEGER;
-
-		loopContext: Libc.sigjmp_buf; (* trap return context, if no Kernel.Try has been used. *)
-		currentTryContext: POINTER TO Libc.sigjmp_buf; (* trap return context, if Kernel.Try has been used. *)
-		isReadableContext: Libc.sigjmp_buf; (* for IsReadable *)
-		isReadableCheck: BOOLEAN;
-
-		guiHook: GuiHook;
-
-		(* !!! This variable has to be the last variable in the list.  !!! *)
-		bootInfo-: BootInfo;
-
-	(* code procedures for fpu *)
-
-	PROCEDURE [1] FINIT 0DBH, 0E3H;
-	PROCEDURE [1] FLDCW 0D9H, 06DH, 0FCH;	(* -4, FP *)
-	PROCEDURE [1] FSTCW 0D9H, 07DH, 0FCH;	(* -4, FP *)
-
-	(* code procedure for memory erase *)
-
-	PROCEDURE [code] Erase (adr, words: INTEGER)	
-		089H, 0C7H,	(* MOV EDI, EAX *)
-		031H, 0C0H,	(* XOR EAX, EAX *)
-		059H,			(* POP ECX *)
-		0F2H, 0ABH;	(* REP STOS *)
-
-	(* code procedure for stack allocate *)
-
-	PROCEDURE [code] ALLOC (* argument in CX *)
-	(*
-		PUSH	EAX
-		ADD	ECX,-5
-		JNS	L0
-		XOR	ECX,ECX
-	L0: AND	ECX,-4	(n-8+3)/4*4
-		MOV	EAX,ECX
-		AND	EAX,4095
-		SUB	ESP,EAX
-		MOV	EAX,ECX
-		SHR	EAX,12
-		JEQ	L2
-	L1: PUSH	0
-		SUB	ESP,4092
-		DEC	EAX
-		JNE	L1
-	L2: ADD	ECX,8
-		MOV	EAX,[ESP,ECX,-4]
-		PUSH	EAX
-		MOV	EAX,[ESP,ECX,-4]
-		SHR	ECX,2
-		RET
-	*);
-
-	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 Msg (IN str: ARRAY OF CHAR);
-		VAR ss: ARRAY 1024 OF SHORTCHAR; res, l: INTEGER;
-	BEGIN
-		ss := SHORT(str);
-		l := LEN(ss$);
-		ss[l] := 0AX; ss[l + 1] := 0X;
-		res := Libc.printf(ss)
-	END Msg;
-
-	PROCEDURE Int (x: LONGINT);
-		VAR j, k: INTEGER; ch: CHAR; a, s: ARRAY 32 OF CHAR;
-	BEGIN
-		IF x # MIN(LONGINT) THEN
-			IF x < 0 THEN s[0] := "-"; k := 1; x := -x ELSE k := 0 END;
-			j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0
-		ELSE
-			a := "8085774586302733229"; s[0] := "-"; k := 1;
-			j := 0; WHILE a[j] # 0X DO INC(j) END
-		END;
-		ASSERT(k + j < LEN(s), 20);
-		REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
-		s[k] := 0X;
-		Msg(s);
-	END Int;
-	
-	PROCEDURE (h: GuiHook)  MessageBox* (
-		title, msg: ARRAY OF CHAR; buttons: SET): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (h: GuiHook)  Beep*, NEW, ABSTRACT;
-
-	(* Is extended by HostGnome to show dialogs. If no dialog is present or
-	    if the dialog is not closed by using one button, then "mbClose" is returned *)
-	PROCEDURE MessageBox* (title, msg: ARRAY OF CHAR; buttons: SET): INTEGER;
-		VAR res: INTEGER;
-	BEGIN
-		IF guiHook # NIL THEN
-			res := guiHook.MessageBox(title, msg, buttons)
-		ELSE
-			Msg(" ");
-			Msg("****");
-			Msg("* " + title);
-			Msg("* " + msg);
-			Msg("****");
-			res := mbClose;
-		END;
-		RETURN res
-	END MessageBox;
-
-	PROCEDURE SetGuiHook* (hook: GuiHook);
-	BEGIN
-		guiHook := hook
-	END SetGuiHook;
-
-	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 >= "A") & (ch <= "Z") OR (ch >= "À") & (ch # "×") & (ch <= "Þ"))
-					& ((lch < "A") OR (lch > "Z") & (lch < "À") OR (lch = "×") OR (lch > "Þ"));
-			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
-		ELSIF i < LEN(name) - 4 THEN
-			IF type = "" THEN ext := docType ELSE ext := type$ END;
-			name[i] := "."; INC(i); j := 0; ch := ext[0];
-			WHILE ch # 0X DO
-				IF (ch >= "A") & (ch <= "Z") THEN
-					ch := CHR(ORD(ch) + ORD("a") - ORD("A"))
-				END;
-				name[i] := ch; INC(i); INC(j); ch := ext[j]
-			END;
-			name[i] := 0X
-		END
-	END MakeFileName;
-
-	PROCEDURE Time* (): LONGINT;
-		VAR t: INTEGER;
-	BEGIN
-		(* t := WinApi.GetTickCount(); *)
-
-		(* Linux *)
-		t := Libc.clock() DIV (Libc.CLOCKS_PER_SECOND DIV 1000); (* processor time to milliseconds *)
-
-		IF t < told THEN INC(shift) END;
-		told := t;
-		RETURN shift * 100000000L + t
-	END Time;
-
-	PROCEDURE Beep* ();
-		VAR ss: ARRAY 2 OF SHORTCHAR;
-	BEGIN
-		IF guiHook # NIL THEN
-			guiHook.Beep
-		ELSE
-			ss[0] := 007X; ss[1] := 0X;
-			res := Libc.printf(ss); res := Libc.fflush(Libc.NULL)
-		END
-	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 --------------------- *)
-
-	(* A. V. Shiryaev, 2012.10: NOTE: it seems that GC works correctly with positive addesses only *)
-
-(*
-	PROCEDURE HeapAlloc (adr: INTEGER; size: INTEGER; prot: SET): Libc.PtrVoid;
-		VAR
-			x: Libc.PtrVoid;
-			res: INTEGER;
-	BEGIN
-		x := Libc.calloc(1, size); (* calloc initialize allocated space to zero *)
-		IF x # Libc.NULL THEN
-			res := Libc.mprotect(x, size, prot);
-			IF res # 0 THEN
-				Libc.free(x);
-				x := Libc.NULL;
-				Msg("Kernel.HeapAlloc: mprotect failed!");
-				HALT(100)
-			END
-		END;
-		RETURN x
-	END HeapAlloc;
-*)
-	PROCEDURE HeapAlloc (adr: Libc.PtrVoid; size: INTEGER; prot: SET): Libc.PtrVoid;
-		VAR x: Libc.PtrVoid;
-	BEGIN
-		x := Libc.mmap(adr, size, prot, Libc.MAP_PRIVATE + Libc.MAP_ANON, zerofd, 0);
-		IF x = Libc.MAP_FAILED THEN
-			x := Libc.NULL
-		ELSE
-			ASSERT(size MOD 4 = 0, 100);
-			Erase(x, size DIV 4)
-		END;
-		RETURN x
-	END HeapAlloc;
-
-(*
-	PROCEDURE HeapFree (adr: Libc.PtrVoid; size: INTEGER);
-		VAR res: INTEGER;
-	BEGIN
-(*
-		ASSERT(size MOD 4 = 0, 100);
-		Erase(adr, size DIV 4);
-		res := Libc.mprotect(adr, size, Libc.PROT_NONE);
-		ASSERT(res = 0, 101);
-*)
-		Libc.free(adr)
-	END HeapFree;
-*)
-	PROCEDURE HeapFree (adr: Libc.PtrVoid; size: INTEGER);
-		VAR res: INTEGER;
-	BEGIN
-(*
-		ASSERT(size MOD 4 = 0, 100);
-		Erase(adr, size DIV 4);
-		res := Libc.mprotect(adr, size, Libc.PROT_NONE);
-		ASSERT(res = 0, 101);
-*)
-		res := Libc.munmap(adr, size);
-		ASSERT(res = 0, 102)
-	END HeapFree;
-
-	PROCEDURE AllocHeapMem (size: INTEGER; VAR c: Cluster);
-		(* allocate at least size bytes, typically at least 256 kbytes are allocated *)
-		CONST N = 65536;	(* cluster size for dll *)
-			prot = Libc.PROT_READ + Libc.PROT_WRITE (* + Libc.PROT_EXEC *);
-		VAR adr: INTEGER;
-			allocated: INTEGER;
-	BEGIN
-		INC(size, 16);
-		ASSERT(size > 0, 100); adr := 0;
-		IF size < N THEN adr := HeapAlloc(65536, N, prot) END;
-		IF adr = 0 THEN adr := HeapAlloc(65536, size, prot); allocated := size ELSE allocated := N 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
-		(* 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);
-		HeapFree(c.max, (S.VAL(INTEGER, c) - c.max) + c.size)
-	END FreeHeapMem;
-
-	PROCEDURE AllocModMem* (descSize, modSize: INTEGER; VAR descAdr, modAdr: INTEGER);
-		CONST
-			prot = Libc.PROT_READ + Libc.PROT_WRITE (* + Libc.PROT_EXEC *);
-	BEGIN
-		descAdr := HeapAlloc(0, descSize, prot);
-		IF descAdr # 0 THEN
-			modAdr := HeapAlloc(0, modSize, prot);
-			IF modAdr # 0 THEN INC(used, descSize + modSize)
-			ELSE HeapFree(descAdr, descSize); descAdr := 0
-			END
-		ELSE modAdr := 0
-		END
-	END AllocModMem;
-
-	PROCEDURE DeallocModMem* (descSize, modSize, descAdr, modAdr: INTEGER);
-	BEGIN
-		DEC(used, descSize + modSize);
-		HeapFree(descAdr, descSize);
-		HeapFree(modAdr, modSize)
-	END DeallocModMem;
-
-	PROCEDURE InvalModMem (modSize, modAdr: INTEGER);
-	BEGIN
-		DEC(used, modSize);
-		HeapFree(modAdr, modSize)
-	END InvalModMem;
-
-(*
-	PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
-		(* check wether memory between from (incl.) and to (excl.) may be read *)
-	BEGIN
-		RETURN WinApi.IsBadReadPtr(from, to - from) = 0
-	END IsReadable;
-*)
-
-	(* Alexander Shiryaev, 2012.10: Linux: can be implemented through mincore/madvise *)
-	(* This procedure can be called from TrapHandler also *)
-	PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
-		(* check wether memory between from (incl.) and to (excl.) may be read *)
-		VAR res: BOOLEAN; res1: INTEGER;
-			x: SHORTCHAR;
-			mask, omask: Libc.sigset_t;
-	BEGIN
-		(* save old sigmask and unblock SIGSEGV *)
-			res1 := Libc.sigemptyset(S.ADR(mask));
-			ASSERT(res1 = 0, 100);
-			res1 := Libc.sigaddset(S.ADR(mask), Libc.SIGSEGV);
-			ASSERT(res1 = 0, 101);
-			res1 := Libc.sigprocmask(Libc.SIG_UNBLOCK, S.ADR(mask), S.ADR(omask));
-			ASSERT(res1 = 0, 102);
-
-		res := FALSE;
-		res1 := Libc.sigsetjmp(isReadableContext, Libc.TRUE);
-		IF res1 = 0 THEN
-			isReadableCheck := TRUE;
-			(* read memory *)
-			REPEAT
-				S.GET(from, x);
-				INC(from)
-			UNTIL from = to;
-			res := TRUE
-		ELSE
-			ASSERT(res1 = 1, 103)
-		END;
-		isReadableCheck := FALSE;
-
-		(* restore saved sigmask *)
-			res1 := Libc.sigprocmask(Libc.SIG_SETMASK, S.ADR(omask), Libc.NULL);
-			ASSERT(res1 = 0, 104);
-
-		RETURN res
-	END IsReadable;
-
-	(* --------------------- NEW implementation (portable) -------------------- *)
-
-	PROCEDURE^ NewBlock (size: INTEGER): Block;
-
-	PROCEDURE NewRec* (typ: INTEGER): INTEGER;	(* implementation of NEW(ptr) *)
-		VAR size: INTEGER; b: Block; tag: Type; l: FList;
-	BEGIN
-		IF ODD(typ) THEN	(* record contains interface pointers *)
-			tag := S.VAL(Type, typ - 1);
-			b := NewBlock(tag.size);
-			IF b = NIL THEN RETURN 0 END;
-			b.tag := tag;
-			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.iptr := TRUE; l.next := finalizers; finalizers := l;
-			RETURN S.ADR(b.last)
-		ELSE
-			tag := S.VAL(Type, typ);
-			b := NewBlock(tag.size);
-			IF b = NIL THEN RETURN 0 END;
-			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;
-			RETURN S.ADR(b.last)
-		END
-	END NewRec;
-
-	PROCEDURE NewArr* (eltyp, nofelem, nofdim: INTEGER): INTEGER;	(* impl. of NEW(ptr, dim0, dim1, ...) *)
-		VAR b: Block; size, headSize: INTEGER; t: Type; fin: BOOLEAN; l: FList;
-	BEGIN
-		IF (nofdim < 0)OR(nofdim>1FFFFFFCH) THEN RETURN 0 END;(*20120822 Marc*)
-		headSize := 4 * nofdim + 12; fin := FALSE;
-		CASE eltyp OF
-(*
-		| -1: eltyp := S.ADR(IntPtrType); fin := TRUE
-*)
-		| -1: HALT(100)
-		| 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: eltyp := S.ADR(UPtrType)
-		ELSE	(* eltyp is desc *)
-			IF ODD(eltyp) THEN DEC(eltyp); fin := TRUE END
-		END;
-		t := S.VAL(Type, eltyp);
-		ASSERT(t .size> 0,100);
-		IF (nofelem < 0) OR( (7FFFFFFFH-headSize) DIV t.size < nofelem) THEN (* 20120822 Marc*)
-			RETURN 0 
-		END; 
-		size := headSize + nofelem * t.size;
-		b := NewBlock(size);
-		IF b = NIL THEN RETURN 0 END;
-		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 *)
-		IF fin THEN
-			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.aiptr := TRUE; l.next := finalizers; finalizers := l
-		END;
-		RETURN S.ADR(b.last)
-	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 SHORTCHAR): Module, NEW, ABSTRACT;
-
-	PROCEDURE SetLoaderHook*(h: LoaderHook);
-	BEGIN
-		loader := h
-	END SetLoaderHook;
-
-	PROCEDURE InitModule (mod: Module);	(* initialize linked modules *)
-		VAR body: Command;
-			res: INTEGER; errno: INTEGER;
-	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;
-
-			(* A. V. Shiryaev: Allow execution on code pages *)
-			(* Linux: must be page-aligned *)
-				res := Libc.mprotect(
-					(mod.code DIV pageSize) * pageSize,
-					((mod.csize + mod.code MOD pageSize - 1) DIV pageSize) * pageSize + pageSize,
-					Libc.PROT_READ + Libc.PROT_WRITE + Libc.PROT_EXEC);
-				IF res = -1 THEN
-					S.GET( Libc.__errno_location(), errno );
-					Msg("ERROR: Kernel.InitModule: mprotect failed!");
-					Msg(mod.name$); Int(mod.code); Int(mod.csize); Int(errno);
-					HALT(100)
-				ELSE ASSERT(res = 0)
-				END;
-
-			body(); actual := NIL
-		END
-	END InitModule;
-
-	PROCEDURE ThisLoadedMod* (IN name: ARRAY OF SHORTCHAR): Module;	(* loaded modules only *)
-		VAR m: Module;
-	BEGIN
-		loadres := done;
-		m := modList;
-		WHILE (m # NIL) & ((m.name # name) 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;
-		VAR n : Name;
-	BEGIN
-		n := SHORT(name$);
-		IF loader # NIL THEN
-			loader.res := done;
-			RETURN loader.ThisMod(n)
-		ELSE
-			RETURN ThisLoadedMod(n)
-		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; name: ARRAY OF SHORTCHAR): Object;
-		VAR l, r, m: INTEGER; p: StrPtr;
-	BEGIN
-		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^ = name THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[m])) END;
-			IF p^ < name 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; name: ARRAY OF SHORTCHAR): Object;
-		VAR n: INTEGER; p: StrPtr; obj: Object; m: Module;
-	BEGIN
-		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^ = name THEN RETURN obj END;
-			DEC(n); INC(S.VAL(INTEGER, obj), 16)
-		END;
-		RETURN NIL
-	END ThisField;
-
-	PROCEDURE ThisCommand* (mod: Module; name: ARRAY OF SHORTCHAR): 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; name: ARRAY OF SHORTCHAR): 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 GetObjName* (mod: Module; obj: Object; VAR name: Name);
-		VAR p: StrPtr;
-	BEGIN
-		p := S.VAL(StrPtr, S.ADR(mod.names[obj.id DIV 256]));
-		name := p^$
-	END GetObjName;
-
-	PROCEDURE GetTypeName* (t: Type; VAR name: Name);
-		VAR p: StrPtr;
-	BEGIN
-		p := S.VAL(StrPtr, S.ADR(t.mod.names[t.id DIV 256]));
-		name := p^$
-	END GetTypeName;
-
-	PROCEDURE RegisterMod* (mod: Module);
-		VAR i: INTEGER;
-			t: Libc.time_t; tm: Libc.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;
-
-		t := Libc.time(NIL);
-		tm := Libc.localtime(t);
-		mod.loadTime[0] := SHORT(tm.tm_year + 1900); (* Linux counts years from 1900 but BlackBox from 0000 *)
-		mod.loadTime[1] := SHORT(tm.tm_mon + 1) (* Linux month range 0-11 but BB month range 1-12 *);
-		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); 
-		tm := NIL;
-
-		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;
-(*
-			ReleaseIPtrs(mod);	(* release global interface pointers *)
-*)
-			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  --------------------- *)	(* COMPILER DEPENDENT *)
-
-	PROCEDURE [1] PUSH (p: INTEGER) 050H;	(* push AX *)
-	PROCEDURE [1] CALL (a: INTEGER) 0FFH, 0D0H;	(* call AX *)
-	PROCEDURE [1] RETI (): LONGINT;
-	PROCEDURE [1] RETR (): REAL;
-	
-	(*
-		type				par
-		32 bit scalar	value
-		64 bit scalar	low hi
-		var scalar		address
-		record			address tag
-		array			  address size
-		open array	   address length .. length
-	*)
-	
-	PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
-		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 *)
-				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 *)
-				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 RefCh (VAR ref: INTEGER; VAR ch: SHORTCHAR);
-	BEGIN
-		S.GET(ref, ch); INC(ref)
-	END RefCh;
-
-	PROCEDURE RefNum (VAR ref: INTEGER; VAR 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; VAR n: Name);
-		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; VAR adr: INTEGER; VAR name: Name);
-		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;
-
-	(* A. V. Shiryaev, 2012.11 *)
-	PROCEDURE CheckRefVarReadable (ref: INTEGER): BOOLEAN;
-		VAR ok: BOOLEAN; ch: SHORTCHAR;
-			p: INTEGER; (* address *)
-
-		PROCEDURE Get;
-		BEGIN
-			IF ok THEN
-				IF IsReadable(ref, ref+1) THEN (* S.GET(ref, ch); INC(ref) *) RefCh(ref, ch)
-				ELSE ok := FALSE
-				END
-			END
-		END Get;
-
-		PROCEDURE Num;
-		BEGIN
-			Get; WHILE ok & (ORD(ch) >= 128) DO Get END
-		END Num;
-
-		PROCEDURE Name;
-		BEGIN
-			Get; WHILE ok & (ch # 0X) DO Get END
-		END Name;
-
-	BEGIN
-		ok := TRUE;
-		Get; (* mode *)
-		IF ok & (ch >= 0FDX) THEN
-			Get; (* form *)
-			IF ok & (ch = 10X) THEN
-				IF IsReadable(ref, ref + 4) THEN (* desc *)
-					S.GET(ref, p); INC(ref, 4);
-					ok := IsReadable(p + 2 * 4, p + 3 * 4) (* desc.id *)
-				ELSE ok := FALSE
-				END
-			END;
-			Num; Name
-		END;
-		RETURN ok
-	END CheckRefVarReadable;
-
-	PROCEDURE GetRefVar* (VAR ref: INTEGER; VAR mode, form: SHORTCHAR; VAR desc: Type;
-																VAR adr: INTEGER; VAR name: Name);
-	BEGIN
-		IF CheckRefVarReadable(ref) THEN
-			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
-		ELSE
-			Msg("Kernel.GetRefVar failed!"); Int(ref);
-			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: Name;
-	BEGIN
-		ref := mod.refs; pos := 0; ad := 0; S.GET(ref, ch);
-		WHILE ch # 0X DO
-			WHILE (ch > 0X) & (ch < 0FCX) DO
-				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 INC(ref); RefNum(ref, d); RefName(ref, name); S.GET(ref, ch) END;
-			WHILE ch >= 0FDX DO	(* skip variables *)
-				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;
-		RETURN -1
-	END SourcePos;
-
-	(* -------------------- dynamic link libraries --------------------- *)
-
-(*
-	PROCEDURE DlOpen (name: ARRAY OF SHORTCHAR): Dl.HANDLE;
-		CONST flags = Dl.RTLD_LAZY + Dl.RTLD_GLOBAL;
-		VAR h: Dl.HANDLE;
-			i: INTEGER;
-	BEGIN
-		h := Dl.NULL;
-		i := 0; WHILE (i < LEN(name)) & (name[i] # 0X) DO INC(i) END;
-		IF i < LEN(name) THEN
-			h := Dl.dlopen(name, flags);
-			WHILE (h = Dl.NULL) & (i > 0) DO
-				DEC(i);
-				WHILE (i > 0) & (name[i] # '.') DO DEC(i) END;
-				IF i > 0 THEN
-					name[i] := 0X;
-					h := Dl.dlopen(name, flags);
-					(* IF h # Dl.NULL THEN Msg(name$) END *)
-				END
-			END
-		END;
-		RETURN h
-	END DlOpen;
-*)
-
-	PROCEDURE LoadDll* (IN name: ARRAY OF SHORTCHAR; VAR ok: BOOLEAN);
-		VAR h: Dl.HANDLE;
-	BEGIN
-		ok := FALSE;
-		h := Dl.dlopen(name, Dl.RTLD_LAZY +  Dl.RTLD_GLOBAL);
-		IF h # Dl.NULL THEN ok := TRUE END
-	END LoadDll;
-	
-	PROCEDURE ThisDllObj* (mode, fprint: INTEGER; IN dll, name: ARRAY OF SHORTCHAR): INTEGER;
-		VAR ad: INTEGER; h: Dl.HANDLE;
-	BEGIN
-		ad := 0;
-		IF mode IN {mVar, mProc} THEN
-			h := Dl.dlopen(dll, Dl.RTLD_LAZY+  Dl.RTLD_GLOBAL);
-			IF h # Dl.NULL THEN
-				ad := Dl.dlsym(h, name);
-			END
-		END;
-		RETURN ad
-	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;
-
-(*  This is the specification for the code procedure following below:
-
-	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 [code] Next (b: Block): Block	(* next block in same cluster *)
-	(*
-		MOV	ECX,[EAX]	b.tag
-		AND	CL,0FCH	b.tag DIV * 4
-		MOV	ECX,[ECX]	size
-		TESTB	[EAX],02H	ODD(b.tag DIV 2)
-		JE	L1
-		ADD	ECX,[EAX,4]	size + b.last
-		SUB	ECX,EAX
-		SUB	ECX,4	size + b.last - ADR(b.last)
-		L1:
-		ADD	ECX,19	size + 19
-		AND	CL,0F0H	(size + 19) DIV 16 * 16
-		ADD	EAX,ECX	b + size
-	*)
-	08BH, 008H,
-	080H, 0E1H, 0FCH,
-	08BH, 009H,
-	0F6H, 000H, 002H,
-	074H, 008H,
-	003H, 048H, 004H,
-	029H, 0C1H,
-	083H, 0E9H, 004H,
-	083H, 0C1H, 013H,
-	080H, 0E1H, 0F0H,
-	001H, 0C8H;
-
-	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
-		S.GETREG(FP, 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);
-		IF f.aiptr THEN (* ArrFinalizer(S.VAL(ANYPTR, S.ADR(f.blk.last))) *)
-		ELSE
-			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;
-(*
-			IF f.iptr THEN RecFinalizer(S.VAL(ANYPTR, S.ADR(f.blk.last))) END
-*)
-		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 *)
-			IF debug & (watcher # NIL) THEN watcher(1) END;
-			MarkGlobals;
-			MarkLocals;
-			CheckFinalizers;
-			Sweep(TRUE);
-			CallFinalizers
-		END
-	END Collect;
-	
-	PROCEDURE FastCollect*;
-	BEGIN
-		IF root # NIL THEN
-			IF debug & (watcher # NIL) THEN watcher(2) END;
-			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
-		IF debug & (watcher # NIL) THEN watcher(3) END;
-		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 >7FFFFFECH THEN RETURN NIL END; (*20120822 Marc*)
-		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^ InitFpu;
-
-	PROCEDURE Start* (code: Command);
-	BEGIN
-		restart := code;
-		S.GETREG(SP, baseStack);	(* save base stack *)
-		res := Libc.sigsetjmp(loopContext, Libc.TRUE);
-		code()
-	END Start;
-
-	PROCEDURE Quit* (exitCode: INTEGER);
-		VAR m: Module; term: Command; t: BOOLEAN;
-			res: INTEGER;
-	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;
-(*
-			ReleaseIPtrs(m);
-*)
-			m := m.next
-		END;
-		CallFinalizers;
-		hotFinalizers := finalizers; finalizers := NIL;
-		CallFinalizers;
-(*
-		IF ~inDll THEN
-			RemoveExcp(excpPtr^);
-			WinApi.ExitProcess(exitCode)	(* never returns *)
-		END
-*)
-
-		res := Libc.fflush(0);
-		Libc.exit(exitCode)
-	END Quit;
-
-	PROCEDURE FatalError* (id: INTEGER; str: ARRAY OF CHAR);
-		VAR res: INTEGER; 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 := WinApi.MessageBoxW(0, str, title, {});
-*)
-		text := SHORT(str$);
-		res := MessageBox(title$, SHORT(str), {mbOk});
-(*
-		IF ~inDll THEN RemoveExcp(excpPtr^) END;
-*)
-(*
-		WinApi.ExitProcess(1)
-*)
-		Libc.exit(1)
-		(* never returns *)
-	END FatalError;
-
-	PROCEDURE DefaultTrapViewer;
-		VAR len, ref, end, x, a, b, c: INTEGER; mod: Module;
-			name: Name; out: ARRAY 1024 OF SHORTCHAR;
-
-		PROCEDURE WriteString (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 (* 0DX on Windows *); INC(len) END
-		END WriteLn;
-
-	BEGIN
-		len := 0;
-		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 = 200 THEN WriteString("keyboard interrupt")
-		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 < 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;
-		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
-					WriteString(mod.name); ref := mod.refs;
-					REPEAT GetRefProc(ref, end, name) UNTIL (end = 0) OR (a < end);
-					IF a < end THEN
-						WriteString("."); WriteString(name)
-					END
-				ELSE
-					WriteString("("); WriteString(mod.name); 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;
-		x := MessageBox("BlackBox", out$, {mbOk})
-	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 res: INTEGER; context: Libc.sigjmp_buf; oldContext: POINTER TO Libc.sigjmp_buf;
-	BEGIN
-		oldContext := currentTryContext;
-		res := Libc.sigsetjmp(context, Libc.TRUE);
-		currentTryContext := S.ADR(context);
-		IF res = 0 THEN (* first time around *)
-			h(a, b, c);
-		ELSIF res = trapReturn THEN  (* after a trap *)
-		ELSE
-			HALT(100)
-		END;
-		currentTryContext := oldContext;
-	END Try;
-
-	(* -------------------- Initialization --------------------- *)
-
-	PROCEDURE InitFpu;	(* COMPILER DEPENDENT *)
-		(* could be eliminated, delayed for backward compatibility *)
-		VAR cw: SET;
-	BEGIN
-		FINIT;
-		FSTCW;
-		(* denorm, underflow, precision, zero div, overflow masked *)
-		(* invalid trapped *)
-		(* round to nearest, temp precision *)
-		cw := cw - {0..5, 8..11} + {1, 2, 3, 4, 5, 8, 9};
-		FLDCW
-	END InitFpu;
-
-	PROCEDURE [ccall] TrapHandler (sig: INTEGER; siginfo: Libc.Ptrsiginfo_t; context: Libc.Ptrucontext_t);
-	BEGIN
-		IF isReadableCheck THEN
-			isReadableCheck := FALSE;
-			Msg("~IsReadable");
-			Libc.siglongjmp(isReadableContext, 1)
-		END;
-
-	(*
-		S.GETREG(SP, sp);
-		S.GETREG(FP, fp);
-	*)
-		stack := baseStack;
-
-		sp := context.uc_mcontext.gregs[7]; (* TODO: is the stack pointer really stored in register 7? *)
-		fp := context.uc_mcontext.gregs[6]; (* TODO: is the frame pointer really stored in register 6? *)
-		pc := context.uc_mcontext.gregs[14]; (* TODO: is the pc really stored in register 14? *)
-		val := siginfo.si_addr;
-
-	(*
-		Int(sig); Int(siginfo.si_signo); Int(siginfo.si_code); Int(siginfo.si_errno);
-		Int(siginfo.si_status); Int(siginfo.si_value); Int(siginfo.si_int);
-	*)
-		err := sig;
-		IF trapped THEN DefaultTrapViewer END;
-		CASE sig OF
-			Libc.SIGINT: 
-				err := 200 (* Interrupt (ANSI). *)
-			| Libc.SIGILL: (* Illegal instruction (ANSI). *)
-				err := 202; val := 0;
-				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
-			| Libc.SIGFPE: 
-				CASE siginfo.si_code OF
-					0: (* TODO: ?????? *)
-						IF siginfo.si_int = 8 THEN
-							err := 139
-						ELSIF siginfo.si_int = 0 THEN
-							err := 143
-						END
-					| Libc.FPE_INTDIV: err := 139 (* Integer divide by zero.  *)
-					| Libc.FPE_INTOVF: err := 138 (* Integer overflow.  *)
-					| Libc.FPE_FLTDIV: err := 140 (* Floating point divide by zero.  *)
-					| Libc.FPE_FLTOVF: err := 142 (* Floating point overflow.  *)
-					| Libc.FPE_FLTUND: err := 141 (* Floating point underflow.  *)
-					| Libc.FPE_FLTRES: err := 143 (* Floating point inexact result.  *)
-					| Libc.FPE_FLTINV: err := 143 (* Floating point invalid operation.  *)
-					| Libc.FPE_FLTSUB: err := 134 (* Subscript out of range.  *)
-				ELSE
-				END
-			| Libc.SIGSEGV: (* Segmentation violation (ANSI). *) 
-				err := 203
-		ELSE
-		END;
-		INC(trapCount);
-		InitFpu;
-		TrapCleanup;
-		IF err # 128 THEN
-			IF (trapViewer = NIL) OR trapped THEN
-				DefaultTrapViewer
-			ELSE
-				trapped := TRUE;
-				trapViewer();
-				trapped := FALSE
-			END
-		END;
-		IF currentTryContext # NIL THEN (* Try failed *)
-			Libc.siglongjmp(currentTryContext, trapReturn)
-		ELSE
-			IF restart # NIL THEN (* Start failed *)
-				Libc.siglongjmp(loopContext, trapReturn)
-			END;
-			Quit(1); (* FIXME *)
-		END;
-		trapped := FALSE
-	END TrapHandler;
-
-	PROCEDURE InstallSignals*;
-		VAR sa, old: Libc.sigaction_t; res, i: INTEGER;
-(*
-			sigstk: Libc.stack_t;
-			errno: INTEGER;
-*)
-	BEGIN
-(*
-		(* A. V. Shiryaev: Set alternative stack on which signals are to be processed *)
-			sigstk.ss_sp := sigStack;
-			sigstk.ss_size := sigStackSize;
-			sigstk.ss_flags := 0;
-			res := Libc.sigaltstack(sigstk, NIL);
-			IF res # 0 THEN Msg("ERROR: Kernel.InstallSignals: sigaltstack failed!");
-				S.GET( Libc.__errno_location(), errno );
-				Int(errno);
-				Libc.exit(1)
-			END;
-*)
-
-		sa.sa_sigaction := TrapHandler;
-(*
-		res := LinLibc.sigemptyset(S.ADR(sa.sa_mask));
-*)
-		res := Libc.sigfillset(S.ADR(sa.sa_mask));
-		sa.sa_flags := (* Libc.SA_ONSTACK + *) Libc.SA_SIGINFO; (* TrapHandler takes three arguments *)
-		(*
-		IF LinLibc.sigaction(LinLibc.SIGINT, sa, old) # 0 THEN Msg("failed to install SIGINT") END;
-		IF LinLibc.sigaction(LinLibc.SIGILL, sa, old) # 0 THEN Msg("failed to install SIGILL") END;
-		IF LinLibc.sigaction(LinLibc.SIGFPE, sa, old) # 0 THEN Msg("failed to install SIGFPE") END;
-		IF LinLibc.sigaction(LinLibc.SIGSEGV, sa, old) # 0 THEN Msg("failed to install SIGSEGV") END;
-		IF LinLibc.sigaction(LinLibc.SIGPIPE, sa, old) # 0 THEN Msg("failed to install SIGPIPE") END;
-		IF LinLibc.sigaction(LinLibc.SIGTERM, sa, old) # 0 THEN Msg("failed to install SIGTERM") END;
-		*)
-		(* respond to all possible signals *)
-		FOR i := 1 TO Libc._NSIG - 1 DO
-			IF (i # Libc.SIGKILL)
-				& (i # Libc.SIGSTOP)
-				& (i # Libc.SIGWINCH)
-			THEN
-				IF Libc.sigaction(i, sa, old) # 0 THEN (* Msg("failed to install signal"); Int(i) *) END;
-			END
-		END
-	END InstallSignals;
-
-	PROCEDURE Init;
-		VAR i: INTEGER;
-	BEGIN
-(*
-		(* for sigaltstack *)
-			sigStack := Libc.calloc(1, sigStackSize);
-			IF sigStack = Libc.NULL THEN
-				Msg("ERROR: Kernel.Init: calloc(1, sigStackSize) failed!");
-				Libc.exit(1)
-			END;
-*)
-		(* for mmap *)
-			zerofd := Libc.open("/dev/zero", Libc.O_RDWR, {0..8});
-			IF zerofd < 0 THEN
-				Msg("ERROR: Kernel.Init: can not open /dev/zero!");
-				Libc.exit(1)
-			END;
-		(* for mprotect *)
-			pageSize := Libc.sysconf(Libc._SC_PAGESIZE);
-			IF pageSize < 0 THEN
-				Msg("ERROR: Kernel.Init: pageSize < 0!");
-				Libc.exit(1)
-			END;
-
-		isReadableCheck := FALSE;
-
-		InstallSignals; (* init exception handling *)
-		currentTryContext := NIL;
-
-		allocated := 0; total := 0; used := 0;
-		sentinelBlock.size := MAX(INTEGER);
-		sentinel := S.ADR(sentinelBlock);
-
-(*
-		S.PUTREG(ML, S.ADR(modList));
-*)
-
-		i := N;
-		REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
-
-		IF inDll THEN
-(*
-			baseStack := FPageWord(4);	(* begin of stack segment *)
-*)
-		END;
-		InitFpu;
-		IF ~static THEN
-			InitModule(modList);
-			IF ~inDll THEN Quit(1) END
-		END;
-		told := 0; shift := 0
-	END Init;
-
-BEGIN
-	IF modList = NIL THEN	(* only once *)
-		S.GETREG(SP, baseStack); (* TODO: Check that this is ok. *)
-		IF bootInfo # NIL THEN
-			modList := bootInfo.modList (* boot loader initializes the bootInfo struct *)
-		ELSE
-			S.GETREG(ML, modList)	(* linker loads module list to BX *)
-		END;
-		static := init IN modList.opts;
-		inDll := dll IN modList.opts;
-		Init
-	END
-CLOSE
-	IF ~terminating THEN
-		terminating := TRUE;
-		Quit(0)
-	END
-END Kernel.