MODULE DevCPM; 

	IMPORT SYSTEM, Kernel, Files, Console, Strings;

	CONST
		ProcSize* = 4;	(* PROCEDURE type *)
		PointerSize* = 4;	(* POINTER type *)
		DArrSizeA* = 8;	(* dyn array descriptor *)
		DArrSizeB* = 4;	(* size = A + B * typ.n *)

		MaxSet* = 31;
		MaxIndex* = 7FFFFFFFH;	(* maximal index value for array declaration *)

		MinReal32Pat = 0FF7FFFFFH;	(* most positive, 32-bit pattern *)
		MinReal64PatL = 0FFFFFFFFH;	(* most  negative, lower 32-bit pattern *)
		MinReal64PatH = 0FFEFFFFFH;	(* most  negative, higher 32-bit pattern *)
		MaxReal32Pat = 07F7FFFFFH;	(* most positive, 32-bit pattern *)
		MaxReal64PatL = 0FFFFFFFFH;	(* most positive, lower 32-bit pattern *)
		MaxReal64PatH = 07FEFFFFFH;	(* most positive, higher 32-bit pattern *)
		InfRealPat = 07F800000H;	(* real infinity pattern *)


		(* inclusive range of parameter of standard procedure HALT *)
		MinHaltNr* = 0;
		MaxHaltNr* = 128;

		(* inclusive range of register number of procedures SYSTEM.GETREG and SYSTEM.PUTREG *)
		MinRegNr* = 0;
		MaxRegNr* = 31;

		(* maximal value of flag used to mark interface structures *)
		MaxSysFlag* = 127;	(* shortint *)
		CProcFlag* = 1;	(* code procedures *)

		(* maximal condition value of parameter of SYSTEM.CC *)
		MaxCC* = 15;

		(* initialization of constant address, must be different from any valid constant address *)
		ConstNotAlloc* = -1;

		(* whether hidden pointer fields have to be nevertheless exported *)
		ExpHdPtrFld* = TRUE;
		HdPtrName* = "@ptr";

		(* whether hidden untagged pointer fields have to be nevertheless exported *)
		ExpHdUtPtrFld* = TRUE;
		HdUtPtrName* = "@utptr";

		(* whether hidden procedure fields have to be nevertheless exported (may be used for System.Free) *)
		ExpHdProcFld* = TRUE;
		HdProcName* = "@proc";

		(* whether hidden bound procedures have to be nevertheless exported *)
		ExpHdTProc* = FALSE;
		HdTProcName* = "@tproc";

		(* maximal number of exported stuctures: *)
		MaxStruct* = 16000;	(* must be < MAX(INTEGER) DIV 2 in object model *)
		
		(* maximal number of record extensions: *)
		MaxExts* = 15;	(* defined by type descriptor layout *)
		
		(* whether field leaf of pointer variable p has to be set to FALSE, when NEW(p) or SYSTEM.NEW(p, n) is used *)
		NEWusingAdr* = FALSE;

		(* special character (< " ") returned by procedure Get, if end of text reached *)
		Eot* = 0X;
		
		(* warnings *)
		longreal* = 0; largeint* = 1; realConst* = 2; copy* = 3; lchr* = 4; lentier* = 5; invar* = 6; outvar* = 7;
		
		(* language options *)
		interface* = 1;
		com* = 2; comAware* = 3;
		som* = 4; somAware* = 5;
		oberon* = 6;
		java* = 7; javaAware* = 8;
		noCode* = 9;
		allSysVal* = 14;
		sysImp* = 15;
		trap* = 31;
		sys386 = 10; sys68k = 20;	(* processor type in options if system imported *)
		
	CONST
		SFdir = "Sym";
		OFdir = "Code";
		SYSdir = "System";
		SFtag = 6F4F5346H;	(* symbol file tag *)
		OFtag = 6F4F4346H;	(* object file tag *)
		maxErrors = 64;
		errFile = "Errors";

	TYPE
		Directory* = POINTER TO RECORD
			path*: Files.Name;
			legacy*: BOOLEAN;
			next*: Directory
		END;
		
	VAR
		LEHost*: BOOLEAN;	(* little or big endian host *)
		MinReal32*, MaxReal32*, InfReal*,
		MinReal64*, MaxReal64*: REAL;
		noerr*: BOOLEAN;	(* no error found until now *)
		curpos*, startpos*, errpos*: INTEGER;	(* character, start, and error position in source file *)
		searchpos*: INTEGER;	(* search position in source file *)
		errors*: INTEGER;
		breakpc*: INTEGER;	(* set by OPV.Init *)
		options*: SET;	(* language options *)
		file*: Files.File;	(* used for sym file import *)
		legacy*: BOOLEAN;	(* use BlackBox subsystems *)
		symList*: Directory;
		codePath*: Files.Name;
		symPath*: Files.Name;
		codeDir*: ARRAY 16 OF CHAR;
		symDir*: ARRAY 16 OF CHAR;
		name*: Files.Name;	(* source name *)
		checksum*: INTEGER;	(* symbol file checksum *)
		verbose*: INTEGER;
		
		lastpos: INTEGER;
		ObjFName: Files.Name;

		in: POINTER TO ARRAY OF CHAR;
		oldSymFile, symFile, objFile: Files.File;
		inSym: Files.Reader;
		outSym, outObj: Files.Writer;
		
		errNo, errPos: ARRAY maxErrors OF INTEGER;
		
		crc32tab: ARRAY 256 OF INTEGER;


	PROCEDURE^ err* (n: INTEGER);

	PROCEDURE Init* (source: POINTER TO ARRAY OF CHAR);
	BEGIN
		in := source;
		noerr := TRUE; options := {};
		curpos := 0; errpos := curpos; lastpos := curpos - 11; errors := 0;
		codePath := ""; symPath := ""; name := "";
		codeDir := OFdir; symDir := SFdir;
	END Init;
	
	PROCEDURE Close*;
	BEGIN
		oldSymFile := NIL; inSym := NIL;
		symFile := NIL; outSym := NIL;
		objFile := NIL; outObj := NIL;
		in := NIL
	END Close;

	PROCEDURE Get* (VAR ch: CHAR);
	BEGIN
		ch := in[curpos]; INC(curpos)
	END Get;

	PROCEDURE LineColOf (pos: INTEGER; OUT line, col, beg, end: INTEGER);
		VAR i: INTEGER;
	BEGIN
		i := 0; line := 1; col := 1; beg := 0; end := 0;
		WHILE i < pos DO
			IF in[i] = 0DX THEN
				INC(i);
				IF in[i] = 0AX THEN
					INC(i)
				END;
				INC(line);
				beg := i;
				col := 1
			ELSIF in[i] = 0AX THEN
				INC(i);
				INC(line);
				beg := i;
				col := 1
			ELSIF in[i] = 09X THEN
				INC(i); INC(col, 2)
			ELSE
				INC(i); INC(col)
			END;
		END;
		WHILE (in[i] # 0DX) & (in[i] # 0AX) & (in[i] # 0X) DO
			INC(i)
		END;
		end := i - 1
	END LineColOf;
	
	PROCEDURE LineOf* (pos: INTEGER): INTEGER;
		VAR line, col, beg, end: INTEGER;
	BEGIN
		LineColOf(pos, line, col, beg, end);
		RETURN line
	END LineOf;

	PROCEDURE LoWord (r: REAL): INTEGER;
		VAR x: INTEGER;
	BEGIN
		x := SYSTEM.ADR(r);
		IF ~LEHost THEN INC(x, 4) END;
		SYSTEM.GET(x, x);
		RETURN x
	END LoWord;

	PROCEDURE HiWord (r: REAL): INTEGER;
		VAR x: INTEGER;
	BEGIN
		x := SYSTEM.ADR(r);
		IF LEHost THEN INC(x, 4) END;
		SYSTEM.GET(x, x);
		RETURN x
	END HiWord;
	
	PROCEDURE Compound (lo, hi: INTEGER): REAL;
		VAR r: REAL;
	BEGIN
		IF LEHost THEN
			SYSTEM.PUT(SYSTEM.ADR(r), lo); SYSTEM.PUT(SYSTEM.ADR(r) + 4, hi)
		ELSE
			SYSTEM.PUT(SYSTEM.ADR(r) + 4, lo); SYSTEM.PUT(SYSTEM.ADR(r), hi)
		END;
		RETURN r
	END Compound;


	(* sysflag control *)
	
	PROCEDURE ValidGuid* (IN str: ARRAY OF SHORTCHAR): BOOLEAN;
		VAR i: INTEGER; ch: SHORTCHAR;
	BEGIN
		IF (LEN(str$) # 38) OR (str[0] # "{") & (str[37] # "}") THEN RETURN FALSE END;
		i := 1;
		WHILE i < 37 DO
			ch := str[i];
			IF (i = 9) OR (i = 14) OR (i = 19) OR (i = 24) THEN
				IF ch # "-" THEN RETURN FALSE END
			ELSE
				IF (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z") THEN RETURN FALSE END
			END;
			INC(i)
		END;
		RETURN TRUE
	END ValidGuid;
	
	PROCEDURE GetProcSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
	BEGIN
		IF id # "" THEN
			IF id = "code" THEN num := 1
			ELSIF id = "callback" THEN num := 2
			ELSIF id = "nostkchk" THEN num := 4
			ELSIF id = "ccall" THEN num := -10
			ELSIF id = "ccall16" THEN num := -12
			ELSIF id = "guarded" THEN num := 8
			ELSIF id = "noframe" THEN num := 16
			ELSIF id = "native" THEN num := -33
			ELSIF id = "bytecode" THEN num := -35
			END
		END;
		IF (options * {sysImp, sys386, sys68k} # {}) & ((num = 1) OR (num = 2)) THEN INC(flag, num)
		ELSIF (sys68k IN options) & (num = 4) THEN INC(flag, num)
		ELSIF (options * {sys386, interface} # {}) & (num = -10) & (flag = 0) THEN flag := -10
		ELSIF (options * {sys386, interface} # {}) & (num = -12) & (flag = 0) THEN flag := -12
		ELSIF (options * {sys386, com} # {}) & (num = 8) & (flag = 0) THEN flag := 8
		ELSIF (options * {sysImp, sys386} # {}) & (num = 16) & (flag = 0) THEN flag := 16
		ELSIF ({sysImp, java} - options = {}) & ((num= -33) OR (num = -35)) & (flag = 0) THEN flag := num
		ELSE err(225); flag := 0
		END
	END GetProcSysFlag;
	
	PROCEDURE GetVarParSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
		VAR old: SHORTINT;
	BEGIN
		old := flag; flag := 0;
		IF (options * {sys386, sys68k, interface, com} # {}) THEN
			IF (num = 1) OR (id = "nil") THEN
				IF ~ODD(old) THEN flag := SHORT(old + 1) END
			ELSIF ((num = 2) OR (id = "in")) & (oberon IN options) THEN
				IF old <= 1 THEN flag := SHORT(old + 2) END
			ELSIF ((num = 4) OR (id = "out")) & (oberon IN options) THEN
				IF old <= 1 THEN flag := SHORT(old + 4) END
			ELSIF ((num = 8) OR (id = "new")) & (options * {com, interface} # {}) THEN
				IF old <= 1 THEN flag := SHORT(old + 8) END
			ELSIF ((num = 16) OR (id = "iid")) & (com IN options) THEN
				IF old <= 1 THEN flag := SHORT(old + 16) END
			END
		END;
		IF flag = 0 THEN err(225) END
	END GetVarParSysFlag;
	
	PROCEDURE GetRecordSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
		VAR old: SHORTINT;
	BEGIN
		old := flag; flag := 0;
		IF (num = 1) OR (id = "untagged") THEN
			IF (options * {sysImp, sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 1 END
		ELSIF (num = 3) OR (id = "noalign") THEN
			IF (options * {sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 3 END
		ELSIF (num = 4) OR (id = "align2") THEN
			IF (options * {sys386, interface, com} # {}) & (old = 0) THEN flag := 4 END
		ELSIF (num = 5) OR (id = "align4") THEN
			IF (options * {sys386, interface, com} # {}) & (old = 0) THEN flag := 5 END
		ELSIF (num = 6) OR (id = "align8") THEN
			IF (options * {sys386, interface, com} # {}) & (old = 0) THEN flag := 6 END
		ELSIF (num = 7) OR (id = "union") THEN
			IF (options * {sys386, sys68k, interface, com} # {}) & (old = 0) THEN flag := 7 END
		ELSIF (num = 10) OR (id = "interface") OR ValidGuid(id) THEN
			IF (com IN options) & (old = 0) THEN flag := 10 END
		ELSIF (num = -11) OR (id = "jint") THEN
			IF (java IN options) & (old = 0) THEN flag := -11 END
		ELSIF (num = -13) OR (id = "jstr") THEN
			IF (java IN options) & (old = 0) THEN flag := -13 END
		ELSIF (num = 20) OR (id = "som") THEN
			IF (som IN options) & (old = 0) THEN flag := 20 END
		END;
		IF flag = 0 THEN err(225) END
	END GetRecordSysFlag;
	
	PROCEDURE GetArraySysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
		VAR old: SHORTINT;
	BEGIN
		old := flag; flag := 0;
		IF (num = 1) OR (id = "untagged") THEN
			IF (options * {sysImp, sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 1 END
		ELSIF (num = -12) OR (id = "jarr") THEN
			IF (java IN options) & (old = 0) THEN flag := -12 END
		ELSIF (num = -13) OR (id = "jstr") THEN
			IF (java IN options) & (old = 0) THEN flag := -13 END
		END;
		IF flag = 0 THEN err(225) END
	END GetArraySysFlag;
	
	PROCEDURE GetPointerSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
		VAR old: SHORTINT;
	BEGIN
		old := flag; flag := 0;
		IF (num = 1) OR (id = "untagged") THEN
			IF (options * {sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 1 END
		ELSIF (num = 2) OR (id = "handle") THEN
			IF (sys68k IN options) & (old = 0) THEN flag := 2 END
		ELSIF (num = 10) OR (id = "interface") THEN
			IF (com IN options) & (old = 0) THEN flag := 10 END
		ELSIF (num = 20) OR (id = "som") THEN
			IF (som IN options) & (old = 0) THEN flag := 20 END
		END;
		IF flag = 0 THEN err(225) END
	END GetPointerSysFlag;
	
	PROCEDURE GetProcTypSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
	BEGIN
		IF ((num = -10) OR (id = "ccall")) & (options * {sys386, interface} # {}) THEN flag := -10
		ELSIF ((num = -12) OR (id = "ccall16")) & (options * {sys386, interface} # {}) THEN flag := -12
		ELSE err(225); flag := 0
		END
	END GetProcTypSysFlag;
	
	PROCEDURE PropagateRecordSysFlag* (baseFlag: SHORTINT; VAR flag: SHORTINT);
	BEGIN
		IF (baseFlag = 1) OR (baseFlag >= 3) & (baseFlag <= 7) THEN	(* propagate untagged .. union *)
			IF flag = 0 THEN flag := baseFlag
			ELSIF (flag = 6) & (baseFlag < 6) THEN (* OK *)	(* special case for 8 byte aligned records *)
			ELSIF flag # baseFlag THEN err(225); flag := 0
			END
		ELSIF (baseFlag # 10) & (flag = 10) THEN err(225)
		END
	END PropagateRecordSysFlag;
	
	PROCEDURE PropagateRecPtrSysFlag* (baseFlag: SHORTINT; VAR flag: SHORTINT);
	BEGIN
		IF (baseFlag = 1) OR (baseFlag >= 3) & (baseFlag <= 7) THEN	(* pointer to untagged .. union is untagged *)
			IF flag = 0 THEN flag := 1
			ELSIF (flag # 1) & (flag # 2) THEN err(225); flag := 0
			END
		ELSIF baseFlag = 10 THEN	(* pointer to interface is interface *)
			IF flag = 0 THEN flag := 10
			ELSIF flag # 10 THEN err(225); flag := 0
			END
		ELSIF baseFlag = -11 THEN	(* pointer to java interface is java interface *)
			IF flag # 0 THEN err(225) END;
			flag := -11
		ELSIF baseFlag = -13 THEN	(* pointer to java string is java string *)
			IF flag # 0 THEN err(225) END;
			flag := -13
		END
	END PropagateRecPtrSysFlag;
	
	PROCEDURE PropagateArrPtrSysFlag* (baseFlag: SHORTINT; VAR flag: SHORTINT);
	BEGIN
		IF baseFlag = 1 THEN	(* pointer to untagged or guid is untagged *)
			IF flag = 0 THEN flag := 1
			ELSIF (flag # 1) & (flag # 2) THEN err(225); flag := 0
			END
		ELSIF baseFlag = -12 THEN	(* pointer to java array is java array *)
			IF flag # 0 THEN err(225) END;
			flag := -12
		ELSIF baseFlag = -13 THEN	(* pointer to java string is java string *)
			IF flag # 0 THEN err(225) END;
			flag := -13
		END
	END PropagateArrPtrSysFlag;
	
	
	(* utf8 strings *)
	
	PROCEDURE PutUtf8* (VAR str: ARRAY OF SHORTCHAR; val: INTEGER; VAR idx: INTEGER);
	BEGIN
		ASSERT((val >= 0) & (val < 65536));
		IF val < 128 THEN
			str[idx] := SHORT(CHR(val)); INC(idx)
		ELSIF val < 2048 THEN
			str[idx] := SHORT(CHR(val DIV 64 + 192)); INC(idx);
			str[idx] := SHORT(CHR(val MOD 64 + 128)); INC(idx)
		ELSE
			str[idx] := SHORT(CHR(val DIV 4096 + 224)); INC(idx); 
			str[idx] := SHORT(CHR(val DIV 64 MOD 64 + 128)); INC(idx);
			str[idx] := SHORT(CHR(val MOD 64 + 128)); INC(idx)
		END
	END PutUtf8;
	
	PROCEDURE GetUtf8* (IN str: ARRAY OF SHORTCHAR; VAR val, idx: INTEGER);
		VAR ch: SHORTCHAR;
	BEGIN
		ch := str[idx]; INC(idx);
		IF ch < 80X THEN
			val := ORD(ch)
		ELSIF ch < 0E0X THEN
			val := ORD(ch) - 192;
			ch := str[idx]; INC(idx); val := val * 64 + ORD(ch) - 128
		ELSE
			val := ORD(ch) - 224;
			ch := str[idx]; INC(idx); val := val * 64 + ORD(ch) - 128;
			ch := str[idx]; INC(idx); val := val * 64 + ORD(ch) - 128
		END
	END GetUtf8;
	
	
	(* log output *)

	PROCEDURE LogW* (ch: CHAR);
	BEGIN
		Console.WriteChar(ch)
	END LogW;
	
	PROCEDURE LogWStr* (IN s: ARRAY OF CHAR);
	BEGIN
		Console.WriteStr(s)
	END LogWStr;
	
	PROCEDURE LogWPar* (IN key: ARRAY OF CHAR; IN p0, p1: ARRAY OF SHORTCHAR);
		VAR s, s0, s1: ARRAY 256 OF CHAR; i, res: INTEGER;
	BEGIN
		Kernel.Utf8ToString(p0, s0, res);
		Kernel.Utf8ToString(p1, s1, res);
		IF key = "#Dev:NotImplementedIn" THEN s := "^0 not implemented in ^1"
		ELSIF key = "#Dev:NotImplemented" THEN s := "^0 not implemented"
		ELSIF key = "#Dev:InconsistentImport" THEN s := "^0.^1 is not consistently imported"
		ELSIF key = "#Dev:ChangedLibFlag" THEN s := "changed library flag"
		ELSIF key = "#Dev:IsNoLongerInSymFile" THEN s := "^0 is no longer in symbol file"
		ELSIF key = "#Dev:IsRedefinedInternally" THEN s := "^0 is redefined internally"
		ELSIF key = "#Dev:IsRedefined" THEN s := "^0 is redefined"
		ELSIF key = "#Dev:IsNewInSymFile" THEN s := "^0 is new in symbol file"
		ELSIF key = "#Dev:NewSymFile" THEN s := "new symbol file"
		ELSE s := key$
		END;
		i := 0;
		WHILE s[i] # 0X DO
			IF s[i] = "^" THEN
				CASE s[i + 1] OF
				| "0": Console.WriteStr(s0)
				| "1": Console.WriteStr(s1)
				| "2": (* skip *)
				ELSE Console.WriteChar("^")
				END;
				INC(i, 2)
			ELSE
				Console.WriteChar(s[i]);
				INC(i)
			END
		END
	END LogWPar;
	
	PROCEDURE LogWNum* (i, len: INTEGER);
		VAR s: ARRAY 32 OF CHAR;
	BEGIN
		Strings.IntToStringForm(i, 10, len, " ", FALSE, s);
		Console.WriteStr(s)
	END LogWNum;

	PROCEDURE LogWLn*;
	BEGIN
		Console.WriteLn
	END LogWLn;

	PROCEDURE Mark* (n, pos: INTEGER);
	BEGIN
		IF (n >= 0) & ~((oberon IN options) & (n >= 181) & (n <= 190)) THEN
			noerr := FALSE;
			IF pos < 0 THEN pos := 0 END;
			IF (pos < lastpos) OR (lastpos + 9 < pos) THEN
				lastpos := pos;
				IF errors < maxErrors THEN
					errNo[errors] := n; errPos[errors] := pos
				END;
				INC(errors)
			END;
			IF trap IN options THEN HALT(100) END;
		ELSIF (n <= -700) & (errors < maxErrors) THEN
			errNo[errors] := n; errPos[errors] := pos; INC(errors)
		END
	END Mark;
	
	PROCEDURE err* (n: INTEGER);
	BEGIN
		Mark(n, errpos)
	END err;
	
	PROCEDURE GetErrorMsg (err: INTEGER; OUT msg: ARRAY OF CHAR);
	BEGIN
		CASE ABS(err) OF
		| 0: msg := 'undeclared identifier'
		| 1: msg := 'multiply defined identifier'
		| 2: msg := 'illegal character in number'
		| 3: msg := 'illegal character in string'
		| 4: msg := 'identifier does not match procedure name'
		| 5: msg := 'comment not closed'
		| 9: msg := '"=" expected'
		| 12: msg := 'type definition starts with incorrect symbol'
		| 13: msg := 'factor starts with incorrect symbol'
		| 14: msg := 'statement starts with incorrect symbol'
		| 15: msg := 'declaration followed by incorrect symbol'
		| 16: msg := 'MODULE expected'
		| 19: msg := '"." missing'
		| 20: msg := '"," missing'
		| 21: msg := '":" missing'
		| 23: msg := '")" missing'
		| 24: msg := '"]" missing'
		| 25: msg := '"}" missing'
		| 26: msg := 'OF missing'
		| 27: msg := 'THEN missing'
		| 28: msg := 'DO missing'
		| 29: msg := 'TO missing'
		| 35: msg := '"," or OF expected'
		| 36: msg := 'CONST, TYPE, VAR, PROCEDURE, BEGIN, or END missing'
		| 37: msg := 'PROCEDURE, BEGIN, or END missing'
		| 38: msg := 'BEGIN or END missing'
		| 40: msg := '"(" missing'
		| 41: msg := 'illegally marked identifier'
		| 42: msg := 'constant not an integer'
		| 43: msg := 'UNTIL missing'
		| 44: msg := '":=" missing'
		| 46: msg := 'EXIT not within loop statement'
		| 47: msg := 'string expected'
		| 48: msg := 'identifier expected'
		| 49: msg := '";" missing'
		| 50: msg := 'expression should be constant'
		| 51: msg := 'END missing'
		| 52: msg := 'identifier does not denote a type'
		| 53: msg := 'identifier does not denote a record type'
		| 54: msg := 'result type of procedure is not a basic type'
		| 55: msg := 'procedure call of a function'
		| 56: msg := 'assignment to non-variable'
		| 57: msg := 'pointer not bound to record or array type'
		| 58: msg := 'recursive type definition'
		| 59: msg := 'illegal open array parameter'
		| 60: msg := 'wrong type of case label'
		| 61: msg := 'inadmissible type of case label'
		| 62: msg := 'case label defined more than once'
		| 63: msg := 'illegal value of constant'
		| 64: msg := 'more actual than formal parameters'
		| 65: msg := 'fewer actual than formal parameters'
		| 66: msg := 'element types of actual array and formal open array differ'
		| 67: msg := 'actual parameter corresponding to open array is not an array'
		| 68: msg := 'control variable must be integer'
		| 69: msg := 'parameter must be an integer constant'
		| 70: msg := 'pointer or VAR / IN record required as formal receiver'
		| 71: msg := 'pointer expected as actual receiver'
		| 72: msg := 'procedure must be bound to a record of the same scope'
		| 73: msg := 'procedure must have level 0'
		| 74: msg := 'procedure unknown in base type'
		| 75: msg := 'invalid call of base procedure'
		| 76: msg := 'this variable (field) is read only'
		| 77: msg := 'object is not a record'
		| 78: msg := 'dereferenced object is not a variable'
		| 79: msg := 'indexed object is not a variable'
		| 80: msg := 'index expression is not an integer'
		| 81: msg := 'index out of specified bounds'
		| 82: msg := 'indexed variable is not an array'
		| 83: msg := 'undefined record field'
		| 84: msg := 'dereferenced variable is not a pointer'
		| 85: msg := 'guard or test type is not an extension of variable type'
		| 86: msg := 'guard or testtype is not a pointer'
		| 87: msg := 'guarded or tested variable is neither a pointer nor a VAR- or IN-parameter record'
		| 88: msg := 'open array not allowed as variable, record field or array element'
		| 89: msg := 'ANYRECORD may not be allocated'
		| 90: msg := 'dereferenced variable is not a character array'
		| 92: msg := 'operand of IN not an integer, or not a set'
		| 93: msg := 'set element type is not an integer'
		| 94: msg := 'operand of & is not of type BOOLEAN'
		| 95: msg := 'operand of OR is not of type BOOLEAN'
		| 96: msg := 'operand not applicable to (unary) +'
		| 97: msg := 'operand not applicable to (unary) -'
		| 98: msg := 'operand of ~ is not of type BOOLEAN'
		| 99: msg := 'ASSERT fault'
		| 100: msg := 'incompatible operands of dyadic operator'
		| 101: msg := 'operand type inapplicable to *'
		| 102: msg := 'operand type inapplicable to /'
		| 103: msg := 'operand type inapplicable to DIV'
		| 104: msg := 'operand type inapplicable to MOD'
		| 105: msg := 'operand type inapplicable to +'
		| 106: msg := 'operand type inapplicable to -'
		| 107: msg := 'operand type inapplicable to = or #'
		| 108: msg := 'operand type inapplicable to relation'
		| 109: msg := 'overriding method must be exported'
		| 110: msg := 'operand is not a type'
		| 111: msg := 'operand inapplicable to (this) function'
		| 112: msg := 'operand is not a variable'
		| 113: msg := 'incompatible assignment'
		| 114: msg := 'string too long to be assigned'
		| 115: msg := 'parameter does not match'
		| 116: msg := 'number of parameters does not match'
		| 117: msg := 'result type does not match'
		| 118: msg := 'export mark does not match with forward declaration'
		| 119: msg := 'redefinition textually precedes procedure bound to base type'
		| 120: msg := 'type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN'
		| 121: msg := 'called object is not a procedure'
		| 122: msg := 'actual VAR-, IN-, or OUT-parameter is not a variable'
		| 123: msg := 'type is not identical with that of formal VAR-, IN-, or OUT-parameter'
		| 124: msg := 'type of result expression differs from that of procedure'
		| 125: msg := 'type of case expression is neither INTEGER nor CHAR'
		| 126: msg := 'this expression cannot be a type or a procedure'
		| 127: msg := 'illegal use of object'
		| 128: msg := 'unsatisfied forward reference'
		| 129: msg := 'unsatisfied forward procedure'
		| 130: msg := 'WITH clause does not specify a variable'
		| 131: msg := 'LEN not applied to array'
		| 132: msg := 'dimension in LEN too large or negative'
		| 133: msg := 'function without RETURN'
		| 135: msg := 'SYSTEM not imported'
		| 136: msg := 'LEN applied to untagged array'
		| 137: msg := 'unknown array length'
		| 138: msg := 'NEW not allowed for untagged structures'
		| 139: msg := 'Test applied to untagged record'
		| 140: msg := 'untagged receiver'
		| 141: msg := 'SYSTEM.NEW not implemented'
		| 142: msg := 'tagged structures not allowed for NIL compatible var parameters'
		| 143: msg := 'tagged pointer not allowed in untagged structure'
		| 144: msg := 'no pointers allowed in BYTES argument'
		| 145: msg := 'untagged open array not allowed as value parameter'
		| 150: msg := 'key inconsistency of imported module'
		| 151: msg := 'incorrect symbol file'
		| 152: msg := 'symbol file of imported module not found'
		| 153: msg := 'object or symbol file not opened (disk full?)'
		| 154: msg := 'recursive import not allowed'
		| 155: msg := 'generation of new symbol file not allowed'
		| 160: msg := 'interfaces must be extensions of IUnknown'
		| 161: msg := 'interfaces must not have fields'
		| 162: msg := 'interface procedures must be abstract'
		| 163: msg := 'interface records must be abstract'
		| 164: msg := 'pointer must be extension of queried interface type'
		| 165: msg := 'illegal guid constant'
		| 166: msg := 'AddRef & Release may not be used'
		| 167: msg := 'illegal assignment to [new] parameter'
		| 168: msg := 'wrong [iid] - [new] pair'
		| 169: msg := 'must be an interface pointer'
		| 177: msg := 'IN only allowed for records and arrays'
		| 178: msg := 'illegal attribute'
		| 179: msg := 'abstract methods of exported records must be exported'
		| 180: msg := 'illegal receiver type'
		| 181: msg := 'base type is not extensible'
		| 182: msg := 'base procedure is not extensible'
		| 183: msg := 'non-matching export'
		| 184: msg := 'Attribute does not match with forward declaration'
		| 185: msg := 'missing NEW attribute'
		| 186: msg := 'illegal NEW attribute'
		| 187: msg := 'new empty procedure in non extensible record'
		| 188: msg := 'extensible procedure in non extensible record'
		| 189: msg := 'illegal attribute change'
		| 190: msg := 'record must be abstract'
		| 191: msg := 'base type must be abstract'
		| 192: msg := 'unimplemented abstract procedures in base types'
		| 193: msg := 'abstract or limited records may not be allocated'
		| 194: msg := 'no supercall allowed to abstract or empty procedures'
		| 195: msg := 'empty procedures may not have out parameters or return a value'
		| 196: msg := 'procedure is implement-only exported'
		| 197: msg := 'extension of limited type must be limited'
		| 198: msg := 'obsolete oberon type'
		| 199: msg := 'obsolete oberon function'
		| 200: msg := 'not yet implemented'
		| 201: msg := 'lower bound of set range greater than higher bound'
		| 202: msg := 'set element greater than MAX(SET) or less than 0'
		| 203: msg := 'number too large'
		| 204: msg := 'product too large'
		| 205: msg := 'division by zero'
		| 206: msg := 'sum too large'
		| 207: msg := 'difference too large'
		| 208: msg := 'overflow in arithmetic shift'
		| 209: msg := 'case range too large'
		| 210: msg := 'code too long'
		| 211: msg := 'jump distance too large'
		| 212: msg := 'illegal real operation'
		| 213: msg := 'too many cases in case statement'
		| 214: msg := 'structure too large'
		| 215: msg := 'not enough registers: simplify expression'
		| 216: msg := 'not enough floating-point registers: simplify expression'
		| 217: msg := 'unimplemented SYSTEM function'
		| 218: msg := 'illegal value of parameter  (0 <= p < 128)'
		| 219: msg := 'illegal value of parameter  (0 <= p < 16)'
		| 220: msg := 'illegal value of parameter'
		| 221: msg := 'too many pointers in a record'
		| 222: msg := 'too many global pointers'
		| 223: msg := 'too many record types'
		| 224: msg := 'too many pointer types'
		| 225: msg := 'illegal sys flag'
		| 226: msg := 'too many exported procedures'
		| 227: msg := 'too many imported modules'
		| 228: msg := 'too many exported structures'
		| 229: msg := 'too many nested records for import'
		| 230: msg := 'too many constants (strings) in module'
		| 231: msg := 'too many link table entries (external procedures)'
		| 232: msg := 'too many commands in module'
		| 233: msg := 'record extension hierarchy too high'
		| 235: msg := 'too many modifiers	'
		| 240: msg := 'identifier too long'
		| 241: msg := 'string too long'
		| 242: msg := 'too many meta names'
		| 243: msg := 'too many imported variables'
		| 249: msg := 'inconsistent import'
		| 250: msg := 'code proc must not be exported'
		| 251: msg := 'too many nested function calls'
		| 254: msg := 'debug position not found'
		| 255: msg := 'debug position'
		| 260: msg := 'illegal LONGINT operation'
		| 261: msg := 'unsupported mode or size of second argument of SYSTEM.VAL'
		| 265: msg := 'unsupported string operation'
		| 270: msg := 'interface pointer reference counting restriction violated'
		| 301: msg := 'implicit type cast'
		| 302: msg := 'guarded variable can be side-effected'
		| 303: msg := 'open array (or pointer to array) containing pointers'
		| 401: msg := 'bytecode restriction: no structured assignment'
		| 402: msg := 'bytecode restriction: no procedure types'
		| 403: msg := 'bytecode restriction: no nested procedures'
		| 404: msg := 'bytecode restriction: illegal SYSTEM function'
		| 410: msg := 'variable may not have been assigned'
		| 411: msg := 'no proofable return'
		| 412: msg := 'illegal constructor call'
		| 413: msg := 'missing constructor call'
		| 501: msg := 'user defined error'
(* COM-related
                | 700: msg := '700'
                | 701: msg := '701'
                | 702: msg := '702'
                | 703: msg := '703'
*)
                | 777: msg := 'register not released'
                | 778: msg := 'float register not released'
                | 779: msg := 'float register overallocated'
		| 900: msg := 'never used'
		| 901: msg := 'never set'
		| 902: msg := 'used before set'
		| 903: msg := 'set but never used'
		| 904: msg := 'used as varpar, possibly not set'
		| 905: msg := 'also declared in outer scope'
		| 906: msg := 'access/assignment to intermediate'
		| 907: msg := 'redefinition'
		| 908: msg := 'new definition'
		| 909: msg := 'statement after RETURN/EXIT'
		| 910: msg := 'for loop variable set'
		| 911: msg := 'implied type guard'
		| 912: msg := 'superfluous type guard'
		| 913: msg := 'call might depend on evaluation sequence of params.'
		| 930: msg := 'superfluous semicolon'
		ELSE Strings.IntToString(err, msg)
		END
	END GetErrorMsg;

	PROCEDURE InsertMarks*;
		VAR i, j, x, y, n, line, col, beg, end: INTEGER; s: ARRAY 128 OF CHAR;
	BEGIN
		n := errors;
		IF n > maxErrors THEN n := maxErrors END;
		(* sort *)
		i := 1;
		WHILE i < n DO
			x := errPos[i]; y := errNo[i]; j := i-1;
			WHILE (j >= 0) & (errPos[j] < x) DO
				errPos[j+1] := errPos[j];
				errNo[j+1] := errNo[j];
				DEC(j)
			END;
			errPos[j+1] := x; errNo[j+1] := y; INC(i)
		END;
		(* insert *)
		IF n > 0 THEN
			WHILE n > 0 DO DEC(n);
				LineColOf(errPos[n], line, col, beg, end);
				IF name = "" THEN Console.WriteStr("???")
				ELSE Console.WriteStr(name)
				END;
				Console.WriteChar(":");
				Strings.IntToString(line, s); Console.WriteStr(s);
				Console.WriteChar(":");
				Strings.IntToString(col, s); Console.WriteStr(s);
				Console.WriteChar(":");
				Strings.IntToString(errPos[n], s); Console.WriteStr(s);
				Console.WriteStr(": ");
				IF errNo[n] >= 0 THEN Console.WriteStr("error: ")
				ELSE Console.WriteStr("warning: ")
				END;
				GetErrorMsg(errNo[n], s);
				Console.WriteStr(s);
				Console.WriteLn;
				Console.WriteStr("  ");
				FOR i := beg TO end DO
					IF in[i] = 09X THEN Console.WriteStr("  ")
					ELSE Console.WriteChar(in[i])
					END
				END;
				Console.WriteLn;
				Console.WriteStr("  ");
				FOR i := 1 TO col - 2 DO
					Console.WriteChar(" ")
				END;
				Console.WriteChar("^");
				Console.WriteLn;
				Console.WriteLn
			END;
		END
	END InsertMarks;


	(* fingerprinting *)

	PROCEDURE InitCrcTab;
		(* CRC32, high bit first, pre & post inverted *)
		CONST poly = {0, 1, 2, 4, 5, 7, 8, 10, 11, 12, 16, 22, 23, 26};	(* CRC32 polynom *)
		VAR x, c, i: INTEGER;
	BEGIN
		x := 0;
		WHILE x < 256 DO
			c := x * 1000000H; i := 0;
			WHILE i < 8 DO
				IF c < 0 THEN c := ORD(BITS(c * 2) / poly)
				ELSE c := c * 2
				END;
				INC(i)
			END;
			crc32tab[ORD(BITS(x) / BITS(255))] := ORD(BITS(c) / BITS(255));
			INC(x)
		END
	END InitCrcTab;
	
	PROCEDURE FPrint* (VAR fp: INTEGER; val: INTEGER);
		VAR c: INTEGER;
	BEGIN
(*
		fp := SYSTEM.ROT(ORD(BITS(fp) / BITS(val)), 1)	(* bad collision detection *)
*)
		(* CRC32, high bit first, pre & post inverted *)
		c := ORD(BITS(fp * 256) / BITS(crc32tab[ORD(BITS(fp DIV 1000000H) / BITS(val DIV 1000000H)) MOD 256]));
		c := ORD(BITS(c * 256) / BITS(crc32tab[ORD(BITS(c DIV 1000000H) / BITS(val DIV 10000H)) MOD 256]));
		c := ORD(BITS(c * 256) / BITS(crc32tab[ORD(BITS(c DIV 1000000H) / BITS(val DIV 100H)) MOD 256]));
		fp := ORD(BITS(c * 256) / BITS(crc32tab[ORD(BITS(c DIV 1000000H) / BITS(val)) MOD 256]));
	END FPrint;

	PROCEDURE FPrintSet* (VAR fp: INTEGER; set: SET);
	BEGIN FPrint(fp, ORD(set))
	END FPrintSet;

	PROCEDURE FPrintReal* (VAR fp: INTEGER; real: SHORTREAL);
	BEGIN FPrint(fp, SYSTEM.VAL(INTEGER, real))
	END FPrintReal;

	PROCEDURE FPrintLReal* (VAR fp: INTEGER; lr: REAL);
	BEGIN
		FPrint(fp, LoWord(lr)); FPrint(fp, HiWord(lr))
	END FPrintLReal;

	PROCEDURE ChkSum (VAR fp: INTEGER; val: INTEGER);	(* symbolfile checksum *)
	BEGIN
		(* same as FPrint, 8 bit only *)
		fp := ORD(BITS(fp * 256) / BITS(crc32tab[ORD(BITS(fp DIV 1000000H) / BITS(val)) MOD 256]))
	END ChkSum;



	(* compact format *)
	
	PROCEDURE WriteLInt (w: Files.Writer; i: INTEGER);
	BEGIN
		ChkSum(checksum, i);
		w.WriteByte(SHORT(SHORT(i MOD 256))); i := i DIV 256;
		ChkSum(checksum, i);
		w.WriteByte(SHORT(SHORT(i MOD 256))); i := i DIV 256;
		ChkSum(checksum, i);
		w.WriteByte(SHORT(SHORT(i MOD 256))); i := i DIV 256;
		ChkSum(checksum, i);
		w.WriteByte(SHORT(SHORT(i MOD 256)))
	END WriteLInt;

	PROCEDURE ReadLInt (r: Files.Reader; VAR i: INTEGER);
		VAR b: BYTE; x: INTEGER;
	BEGIN
		r.ReadByte(b); x := b MOD 256;
		ChkSum(checksum, b);
		r.ReadByte(b); x := x + 100H * (b MOD 256);
		ChkSum(checksum, b);
		r.ReadByte(b); x := x + 10000H * (b MOD 256);
		ChkSum(checksum, b);
		r.ReadByte(b); i := x + 1000000H * b;
		ChkSum(checksum, b)
	END ReadLInt;

	PROCEDURE WriteNum (w: Files.Writer; i: INTEGER);
	BEGIN	(* old format of Oberon *)
		WHILE (i < -64) OR (i > 63) DO ChkSum(checksum, i MOD 128 - 128); w.WriteByte(SHORT(SHORT(i MOD 128 - 128))); i := i DIV 128 END;
		ChkSum(checksum, i MOD 128);
		w.WriteByte(SHORT(SHORT(i MOD 128)))
	END WriteNum;

	PROCEDURE ReadNum (r: Files.Reader; VAR i: INTEGER);
		VAR b: BYTE; s, y: INTEGER;
	BEGIN
		s := 0; y := 0; r.ReadByte(b);
		IF ~r.eof THEN ChkSum(checksum, b) END;
		WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); r.ReadByte(b); ChkSum(checksum, b) END;
		i := ASH((b + 64) MOD 128 - 64, s) + y;
	END ReadNum;
	
	PROCEDURE WriteNumSet (w: Files.Writer; x: SET);
	BEGIN
		WriteNum(w, ORD(x))
	END WriteNumSet;

	PROCEDURE ReadNumSet (r: Files.Reader; VAR x: SET);
		VAR i: INTEGER;
	BEGIN
		ReadNum(r, i); x := BITS(i)
	END ReadNumSet;

	PROCEDURE WriteReal (w: Files.Writer; x: SHORTREAL);
	BEGIN
		WriteLInt(w, SYSTEM.VAL(INTEGER, x))
	END WriteReal;

	PROCEDURE ReadReal (r: Files.Reader; VAR x: SHORTREAL);
		VAR i: INTEGER;
	BEGIN
		ReadLInt(r, i); x := SYSTEM.VAL(SHORTREAL, i)
	END ReadReal;

	PROCEDURE WriteLReal (w: Files.Writer; x: REAL);
	BEGIN
		WriteLInt(w, LoWord(x)); WriteLInt(w, HiWord(x))
	END WriteLReal;

	PROCEDURE ReadLReal (r: Files.Reader; VAR x: REAL);
		VAR h, l: INTEGER;
	BEGIN
		ReadLInt(r, l); ReadLInt(r, h); x := Compound(l, h)
	END ReadLReal;


	(* read symbol file *)

	PROCEDURE SymRCh* (VAR ch: SHORTCHAR);
		VAR b: BYTE;
	BEGIN
		inSym.ReadByte(b); ch := SHORT(CHR(b));
		ChkSum(checksum, b)
	END SymRCh;
	
	PROCEDURE SymRInt* (): INTEGER;
		VAR k: INTEGER;
	BEGIN
		ReadNum(inSym, k); RETURN k
	END SymRInt;
		
	PROCEDURE SymRSet* (VAR s: SET);
	BEGIN
		ReadNumSet(inSym, s)
	END SymRSet;

	PROCEDURE SymRReal* (VAR r: SHORTREAL);
	BEGIN
		ReadReal(inSym, r)
	END SymRReal;
	
	PROCEDURE SymRLReal* (VAR lr: REAL);
	BEGIN
		ReadLReal(inSym, lr)
	END SymRLReal;
	
	PROCEDURE eofSF* (): BOOLEAN;
	BEGIN
		RETURN inSym.eof
	END eofSF;
	
	PROCEDURE OldSym* (IN modName: ARRAY OF SHORTCHAR; VAR done: BOOLEAN);
		VAR tag: INTEGER; d: Directory;

		PROCEDURE Old (IN path: Files.Name; IN modName: ARRAY OF SHORTCHAR; legacy: BOOLEAN): Files.File;
			VAR f: Files.File; res: INTEGER; loc: Files.Locator; dir, name: Files.Name;
		BEGIN
			Kernel.Utf8ToString(modName, name, res);
			loc := Files.dir.This(path);
			IF legacy THEN
				Kernel.SplitName(name, dir, name);
				Kernel.MakeFileName(name, Kernel.symType); 
				loc := loc.This(dir).This(symDir);
				f := Files.dir.Old(loc, name, Files.shared);
				IF (f = NIL) & (dir = "") THEN
					loc := Files.dir.This(path).This(SYSdir).This(symDir);
					f := Files.dir.Old(loc, name, Files.shared)
				END
			ELSE
				Kernel.MakeFileName(name, Kernel.symType);
				f := Files.dir.Old(loc, name, Files.shared)
			END;
			RETURN f
		END Old;

	BEGIN
		done := FALSE;
		IF modName = "@file" THEN
			oldSymFile := file
		ELSE
			oldSymFile := Old(symPath, modName, legacy);
			d := symList;
			WHILE (oldSymFile = NIL) & (d # NIL) DO
				oldSymFile := Old(d.path, modName, d.legacy);
				d := d.next
			END
		END;
		IF oldSymFile # NIL THEN
			inSym := oldSymFile.NewReader(inSym);
			IF inSym # NIL THEN
				ReadLInt(inSym, tag);
				IF tag = SFtag THEN done := TRUE ELSE err(151) END
			END
		END
	END OldSym;

	PROCEDURE CloseOldSym*;
	BEGIN
		IF oldSymFile # NIL THEN oldSymFile.Close; oldSymFile := NIL END
	END CloseOldSym;


	(* write symbol file *)

	PROCEDURE SymWCh* (ch: SHORTCHAR);
	BEGIN
		ChkSum(checksum, ORD(ch));
		outSym.WriteByte(SHORT(ORD(ch)))
	END SymWCh;

	PROCEDURE SymWInt* (i: INTEGER);
	BEGIN
		WriteNum(outSym, i)
	END SymWInt;

	PROCEDURE SymWSet* (s: SET);
	BEGIN
		WriteNumSet(outSym, s)
	END SymWSet;

	PROCEDURE SymWReal* (r: SHORTREAL);
	BEGIN
		WriteReal(outSym, r)
	END SymWReal;

	PROCEDURE SymWLReal* (r: REAL);
	BEGIN
		WriteLReal(outSym, r)
	END SymWLReal;

	PROCEDURE SymReset*;
	BEGIN
		outSym.SetPos(4)
	END SymReset;

	PROCEDURE NewSym* (IN modName: ARRAY OF SHORTCHAR);
		VAR res: INTEGER; loc: Files.Locator; dir: Files.Name;
	BEGIN
		Kernel.Utf8ToString(modName, ObjFName, res);
		loc := Files.dir.This(symPath);
		IF legacy THEN
			Kernel.SplitName(ObjFName, dir, ObjFName);
			loc := loc.This(dir).This(symDir)
		END;
		symFile := Files.dir.New(loc, Files.ask);
		IF symFile # NIL THEN
			outSym := symFile.NewWriter(NIL);
			WriteLInt(outSym, SFtag)
		ELSE
			err(153)
		END
	END NewSym;
	
	PROCEDURE RegisterNewSym*;
		VAR res: INTEGER; name: Files.Name;
	BEGIN
		IF symFile # NIL THEN
			name := ObjFName$;
			Kernel.MakeFileName(name, Kernel.symType);
			symFile.Register(name, Kernel.symType, Files.ask, res);
			symFile := NIL
		END
	END RegisterNewSym;
	
	PROCEDURE DeleteNewSym*;
	BEGIN
		IF symFile # NIL THEN symFile.Close; symFile := NIL END
	END DeleteNewSym;


	(* write object file *)

	PROCEDURE ObjW* (ch: SHORTCHAR);
	BEGIN
		outObj.WriteByte(SHORT(ORD(ch)))
	END ObjW;

	PROCEDURE ObjWNum* (i: INTEGER);
	BEGIN
		WriteNum(outObj, i)
	END ObjWNum;

	PROCEDURE ObjWInt (i: SHORTINT);
	BEGIN
		outObj.WriteByte(SHORT(SHORT(i MOD 256)));
		outObj.WriteByte(SHORT(SHORT(i DIV 256)))
	END ObjWInt;

	PROCEDURE ObjWLInt* (i: INTEGER);
	BEGIN
		ObjWInt(SHORT(i MOD 65536));
		ObjWInt(SHORT(i DIV 65536))
	END ObjWLInt;

	PROCEDURE ObjWBytes* (IN bytes: ARRAY OF SHORTCHAR; n: INTEGER);
		TYPE P = POINTER TO ARRAY [untagged] 100000H OF BYTE;
		VAR p: P;
	BEGIN
		p := SYSTEM.VAL(P, SYSTEM.ADR(bytes));
		outObj.WriteBytes(p^, 0, n)
	END ObjWBytes;
	
	PROCEDURE ObjLen* (): INTEGER;
	BEGIN
		RETURN outObj.Pos()
	END ObjLen;
	
	PROCEDURE ObjSet* (pos: INTEGER);
	BEGIN
		outObj.SetPos(pos)
	END ObjSet;

	PROCEDURE NewObj* (IN modName: ARRAY OF SHORTCHAR);
		VAR res: INTEGER; loc: Files.Locator; dir: Files.Name;
	BEGIN
		errpos := 0;
		Kernel.Utf8ToString(modName, ObjFName, res);
		loc := Files.dir.This(codePath);
		IF legacy THEN
			Kernel.SplitName(ObjFName, dir, ObjFName);
			loc := loc.This(dir).This(codeDir)
		END;
		objFile := Files.dir.New(loc, Files.ask);
		IF objFile # NIL THEN
			outObj := objFile.NewWriter(NIL);
			WriteLInt(outObj, OFtag)
		ELSE
			err(153)
		END
	END NewObj;

	PROCEDURE RegisterObj*;
		VAR res: INTEGER; name: Files.Name;
	BEGIN
		IF objFile # NIL THEN
			name := ObjFName$;
			Kernel.MakeFileName(name, Kernel.objType);
			objFile.Register(name, Kernel.objType, Files.ask, res);
			objFile := NIL; outObj := NIL
		END
	END RegisterObj;

	PROCEDURE DeleteObj*;
	BEGIN
		IF objFile # NIL THEN objFile.Close; objFile := NIL END
	END DeleteObj;


	PROCEDURE InitHost;
		VAR test: SHORTINT; lo: SHORTCHAR;
	BEGIN
		test := 1; SYSTEM.GET(SYSTEM.ADR(test), lo); LEHost := lo = 1X;
		InfReal := SYSTEM.VAL(SHORTREAL, InfRealPat);
		MinReal32 := SYSTEM.VAL(SHORTREAL, MinReal32Pat);
		MaxReal32 := SYSTEM.VAL(SHORTREAL, MaxReal32Pat);
		MinReal64 := Compound(MinReal64PatL, MinReal64PatH);
		MaxReal64 := Compound(MaxReal64PatL, MaxReal64PatH)
	END InitHost;

BEGIN
	InitCrcTab;
	InitHost
END DevCPM.