HostDates implemented

Texts works
Views works
Dev works

BlackBox/Dev/Mod/CPB.txt

@@ -0,0 +1,2238 @@
+MODULE DevCPB;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPB.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT DevCPT, DevCPM;
+
+	CONST
+		(* symbol values or ops *)
+		times = 1; slash = 2; div = 3; mod = 4;
+		and = 5; plus = 6; minus = 7; or = 8; eql = 9;
+		neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
+		in = 15; is = 16; ash = 17; msk = 18; len = 19;
+		conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
+		(*SYSTEM*)
+		adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
+		min = 34; max = 35; typfn = 36; size = 37;
+		
+		(* object modes *)
+		Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
+		SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
+
+		(* Structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18;
+		intSet = {Int8..Int32, Int64}; realSet = {Real32, Real64}; charSet = {Char8, Char16};
+
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+
+		(* nodes classes *)
+		Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
+		Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
+		Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
+		Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
+		Nreturn = 26; Nwith = 27; Ntrap = 28;
+
+		(*function number*)
+		assign = 0;
+		haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
+		entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
+		shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
+		inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
+		lchrfn = 33; lentierfcn = 34; bitsfn = 37; bytesfn = 38;
+		
+		(*SYSTEM function number*)
+		adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
+		getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
+		bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31;
+		thisrecfn = 45; thisarrfn = 46;
+
+		(* COM function number *)
+		validfn = 40; iidfn = 41; queryfn = 42;
+		
+		(* module visibility of objects *)
+		internal = 0; external = 1; externalR = 2; inPar = 3; outPar = 4;
+
+		(* procedure flags (conval.setval) *)
+		hasBody = 1; isRedef = 2; slNeeded = 3; imVar = 4;
+		
+		(* attribute flags (attr.adr, struct.attribute, proc.conval.setval)*)
+		newAttr = 16; absAttr = 17; limAttr = 18; empAttr = 19; extAttr = 20;
+		
+		(* case statement flags (conval.setval) *)
+		useTable = 1; useTree = 2;
+		
+		(* sysflags *)
+		nilBit = 1; inBit = 2; outBit = 4; newBit = 8; iidBit = 16; interface = 10; jint = -11; jstr = -13;
+
+		AssertTrap = 0;	(* default trap number *)
+
+		covarOut = FALSE;
+		
+		
+	VAR
+		typSize*: PROCEDURE(typ: DevCPT.Struct);
+		zero, one, two, dummy, quot: DevCPT.Const;
+
+	PROCEDURE err(n: SHORTINT);
+	BEGIN DevCPM.err(n)
+	END err;
+	
+	PROCEDURE NewLeaf*(obj: DevCPT.Object): DevCPT.Node;
+		VAR node: DevCPT.Node; typ: DevCPT.Struct;
+	BEGIN
+		typ := obj.typ;
+		CASE obj.mode OF
+		  Var:
+				node := DevCPT.NewNode(Nvar); node.readonly := (obj.vis = externalR) & (obj.mnolev < 0)
+		| VarPar:
+				node := DevCPT.NewNode(Nvarpar); node.readonly := obj.vis = inPar;
+		| Con:
+				node := DevCPT.NewNode(Nconst); node.conval := DevCPT.NewConst();
+				node.conval^ := obj.conval^	(* string is not copied, only its ref *)
+		| Typ:
+				node := DevCPT.NewNode(Ntype)
+		| LProc..IProc, TProc:
+				node := DevCPT.NewNode(Nproc)
+		ELSE err(127); node := DevCPT.NewNode(Nvar); typ := DevCPT.notyp
+		END ;
+		node.obj := obj; node.typ := typ;
+		RETURN node
+	END NewLeaf;
+	
+	PROCEDURE Construct*(class: BYTE; VAR x: DevCPT.Node;  y: DevCPT.Node);
+		VAR node: DevCPT.Node;
+	BEGIN
+		node := DevCPT.NewNode(class); node.typ := DevCPT.notyp;
+		node.left := x; node.right := y; x := node
+	END Construct;
+	
+	PROCEDURE Link*(VAR x, last: DevCPT.Node; y: DevCPT.Node);
+	BEGIN
+		IF x = NIL THEN x := y ELSE last.link := y END ;
+		WHILE y.link # NIL DO y := y.link END ;
+		last := y
+	END Link;
+	
+	PROCEDURE BoolToInt(b: BOOLEAN): INTEGER;
+	BEGIN
+		IF b THEN RETURN 1 ELSE RETURN 0 END
+	END BoolToInt;
+	
+	PROCEDURE IntToBool(i: INTEGER): BOOLEAN;
+	BEGIN
+		IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END
+	END IntToBool;
+	
+	PROCEDURE NewBoolConst*(boolval: BOOLEAN): DevCPT.Node;
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.typ := DevCPT.booltyp;
+		x.conval := DevCPT.NewConst(); x.conval.intval := BoolToInt(boolval); RETURN x
+	END NewBoolConst;
+	
+	PROCEDURE OptIf*(VAR x: DevCPT.Node);	(* x.link = NIL *)
+		VAR if, pred: DevCPT.Node;
+	BEGIN
+		if := x.left;
+		WHILE if.left.class = Nconst DO
+			IF IntToBool(if.left.conval.intval) THEN x := if.right; RETURN
+			ELSIF if.link = NIL THEN x := x.right; RETURN
+			ELSE if := if.link; x.left := if
+			END
+		END ;
+		pred := if; if := if.link;
+		WHILE if # NIL DO
+			IF if.left.class = Nconst THEN
+				IF IntToBool(if.left.conval.intval) THEN
+					pred.link := NIL; x.right := if.right; RETURN
+				ELSE if := if.link; pred.link := if
+				END
+			ELSE pred := if; if := if.link
+			END
+		END
+	END OptIf;
+
+	PROCEDURE Nil*(): DevCPT.Node;
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.typ := DevCPT.niltyp;
+		x.conval := DevCPT.NewConst(); x.conval.intval := 0; RETURN x
+	END Nil;
+
+	PROCEDURE EmptySet*(): DevCPT.Node;
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.typ := DevCPT.settyp;
+		x.conval := DevCPT.NewConst(); x.conval.setval := {}; RETURN x
+	END EmptySet;
+	
+	PROCEDURE MarkAsUsed (node: DevCPT.Node);
+		VAR c: BYTE;
+	BEGIN
+		c := node.class;
+		WHILE (c = Nfield) OR (c = Nindex) OR (c = Nguard) OR (c = Neguard) DO node := node.left; c := node.class END;
+		IF (c = Nvar) & (node.obj.mnolev > 0) THEN node.obj.used := TRUE END
+	END MarkAsUsed;
+	
+	
+	PROCEDURE GetTempVar* (name: ARRAY OF SHORTCHAR; typ: DevCPT.Struct; VAR obj: DevCPT.Object);
+		VAR n: DevCPT.Name; o: DevCPT.Object;
+	BEGIN
+		n := "@@  "; DevCPT.Insert(n, obj); obj.name^ := name$;	(* avoid err 1 *)
+		obj.mode := Var; obj.typ := typ;
+		o := DevCPT.topScope.scope;
+		IF o = NIL THEN DevCPT.topScope.scope := obj
+		ELSE
+			WHILE o.link # NIL DO o := o.link END;
+			o.link := obj
+		END
+	END GetTempVar;
+
+
+	(* ---------- constant operations ---------- *)
+	
+	PROCEDURE Log (x: DevCPT.Node): INTEGER;
+		VAR val, exp: INTEGER;
+	BEGIN
+		exp := 0;
+		IF x.typ.form = Int64 THEN
+			RETURN -1
+		ELSE
+			val := x.conval.intval;
+			IF val > 0 THEN
+				WHILE ~ODD(val) DO val := val DIV 2; INC(exp) END
+			END;
+			IF val # 1 THEN exp := -1 END
+		END;
+		RETURN exp
+	END Log;
+
+	PROCEDURE Floor (x: REAL): REAL;
+		VAR y: REAL;
+	BEGIN
+		IF ABS(x) > 9007199254740992.0 (* 2^53 *) THEN RETURN x
+		ELSIF (x >= MAX(INTEGER) + 1.0) OR (x < MIN(INTEGER)) THEN
+			y := Floor(x / (MAX(INTEGER) + 1.0)) * (MAX(INTEGER) + 1.0);
+			RETURN SHORT(ENTIER(x - y)) + y
+		ELSE RETURN SHORT(ENTIER(x))
+		END
+	END Floor;
+
+	PROCEDURE SetToInt (s: SET): INTEGER;
+		VAR x, i: INTEGER;
+	BEGIN
+		i := 31; x := 0;
+		IF 31 IN s THEN x := -1 END;
+		WHILE i > 0 DO
+			x := x * 2; DEC(i);
+			IF i IN s THEN INC(x) END
+		END;
+		RETURN x
+	END SetToInt;
+
+	PROCEDURE IntToSet (x: INTEGER): SET;
+		VAR i: INTEGER; s: SET;
+	BEGIN
+		i := 0; s := {};
+		WHILE i < 32 DO
+			IF ODD(x) THEN INCL(s, i) END;
+			x := x DIV 2; INC(i)
+		END;
+		RETURN s
+	END IntToSet;
+
+	PROCEDURE GetConstType (x: DevCPT.Const; form: INTEGER; errno: SHORTINT; VAR typ: DevCPT.Struct);
+		CONST MAXL = 9223372036854775808.0; (* 2^63 *)
+	BEGIN
+		IF (form IN intSet + charSet) & (x.realval + x.intval >= MIN(INTEGER))
+				& (x.realval + x.intval <= MAX(INTEGER)) THEN
+			x.intval := SHORT(ENTIER(x.realval + x.intval)); x.realval := 0
+		END;
+		IF form IN intSet THEN
+			IF x.realval = 0 THEN typ := DevCPT.int32typ
+			ELSIF (x.intval >= -MAXL - x.realval) & (x.intval < MAXL - x.realval) THEN typ := DevCPT.int64typ
+			ELSE err(errno); x.intval := 1; x.realval := 0; typ := DevCPT.int32typ
+			END
+		ELSIF form IN realSet THEN	(* SR *)
+			typ := DevCPT.real64typ
+		ELSIF form IN charSet THEN
+			IF x.intval <= 255 THEN typ := DevCPT.char8typ
+			ELSE typ := DevCPT.char16typ
+			END
+		ELSE typ := DevCPT.undftyp
+		END
+	END GetConstType;
+	
+	PROCEDURE CheckConstType (x: DevCPT.Const; form: INTEGER; errno: SHORTINT);
+		VAR type: DevCPT.Struct;
+	BEGIN
+		GetConstType(x, form, errno, type);
+		IF  ~DevCPT.Includes(form, type.form)
+		& ((form # Int8) OR (x.realval # 0) OR (x.intval < -128) OR (x.intval > 127))
+		& ((form # Int16) OR (x.realval # 0) OR (x.intval < -32768) OR (x.intval > 32767)) 
+		& ((form # Real32) OR (ABS(x.realval) > DevCPM.MaxReal32) & (ABS(x.realval) # DevCPM.InfReal)) THEN
+			err(errno); x.intval := 1; x.realval := 0
+		END
+(*
+		IF (form IN intSet + charSet) & (x.realval + x.intval >= MIN(INTEGER))
+				& (x.realval + x.intval <= MAX(INTEGER)) THEN
+			x.intval := SHORT(ENTIER(x.realval + x.intval)); x.realval := 0
+		END;
+		IF (form = Int64) & ((x.intval < -MAXL - x.realval) OR (x.intval >= MAXL - x.realval))
+		OR (form = Int32) & (x.realval # 0)
+		OR (form = Int16) & ((x.realval # 0) OR (x.intval < -32768) OR (x.intval > 32767))
+		OR (form = Int8) & ((x.realval # 0) OR (x.intval < -128) OR (x.intval > 127))
+		OR (form = Char16) & ((x.realval # 0) OR (x.intval < 0) OR (x.intval > 65535))
+		OR (form = Char8) & ((x.realval # 0) OR (x.intval < 0) OR (x.intval > 255))
+		OR (form = Real32) & (ABS(x.realval) > DevCPM.MaxReal32) & (ABS(x.realval) # DevCPM.InfReal) THEN
+			err(errno); x.intval := 1; x.realval := 0
+		END
+*)
+	END CheckConstType;
+	
+	PROCEDURE ConvConst (x: DevCPT.Const; from, to: INTEGER);
+		VAR sr: SHORTREAL;
+	BEGIN
+		IF from = Set THEN
+			x.intval := SetToInt(x.setval); x.realval := 0; x.setval := {};
+		ELSIF from IN intSet + charSet THEN
+			IF to = Set THEN CheckConstType(x, Int32, 203); x.setval := IntToSet(x.intval)
+			ELSIF to IN intSet THEN CheckConstType(x, to, 203)
+			ELSIF to IN realSet THEN x.realval := x.realval + x.intval; x.intval := DevCPM.ConstNotAlloc
+			ELSE (*to IN charSet*) CheckConstType(x, to, 220)
+			END
+		ELSIF from IN realSet THEN
+			IF to IN realSet THEN CheckConstType(x, to, 203);
+				IF to = Real32 THEN sr := SHORT(x.realval); x.realval := sr END	(* reduce precision *)
+			ELSE x.realval := Floor(x.realval); x.intval := 0; CheckConstType(x, to, 203)
+			END
+		END
+	END ConvConst;
+	
+	PROCEDURE Prepare (x: DevCPT.Const);
+		VAR r: REAL;
+	BEGIN
+		x.realval := x.realval + x.intval DIV 32768 * 32768;
+		x.intval := x.intval MOD 32768;
+		r := Floor(x.realval / 4096) * 4096;
+		x.intval := x.intval + SHORT(ENTIER(x.realval - r));
+		x.realval := r
+		(* ABS(x.intval) < 2^15  &  ABS(x.realval) MOD 2^12 = 0 *)
+	END Prepare;
+	
+	PROCEDURE AddConst (x, y, z: DevCPT.Const; VAR type: DevCPT.Struct);	(* z := x + y *)
+	BEGIN
+		IF type.form IN intSet THEN
+			Prepare(x); Prepare(y);
+			z.intval := x.intval + y.intval; z.realval := x.realval + y.realval
+		ELSIF type.form IN realSet THEN
+			IF (ABS(x.realval) = DevCPM.InfReal) & (x.realval = - y.realval) THEN err(212)
+			ELSE z.realval := x.realval + y.realval
+			END
+		ELSE HALT(100)
+		END;
+		GetConstType(z, type.form, 206, type)
+	END AddConst;
+	
+	PROCEDURE NegateConst (y, z: DevCPT.Const; VAR type: DevCPT.Struct);	(* z := - y *)
+	BEGIN
+		IF type.form IN intSet THEN Prepare(y); z.intval :=  -y.intval; z.realval := -y.realval
+		ELSIF type.form IN realSet THEN z.realval := -y.realval
+		ELSE HALT(100)
+		END;
+		GetConstType(z, type.form, 207, type)
+	END NegateConst;
+	
+	PROCEDURE SubConst (x, y, z: DevCPT.Const; VAR type: DevCPT.Struct);	(* z := x - y *)
+	BEGIN
+		IF type.form IN intSet THEN
+			Prepare(x); Prepare(y);
+			z.intval := x.intval - y.intval; z.realval := x.realval - y.realval
+		ELSIF type.form IN realSet THEN
+			IF (ABS(x.realval) = DevCPM.InfReal) & (x.realval =  y.realval) THEN err(212)
+			ELSE z.realval := x.realval - y.realval
+			END
+		ELSE HALT(100)
+		END;
+		GetConstType(z, type.form, 207, type)
+	END SubConst;
+	
+	PROCEDURE MulConst (x, y, z: DevCPT.Const; VAR type: DevCPT.Struct);	(* z := x * y *)
+	BEGIN
+		IF type.form IN intSet THEN
+			Prepare(x); Prepare(y);
+			z.realval := x.realval * y.realval + x.intval * y.realval + x.realval * y.intval;
+			z.intval := x.intval * y.intval
+		ELSIF type.form IN realSet THEN
+			IF (ABS(x.realval) = DevCPM.InfReal) & ( y.realval = 0.0) THEN err(212)
+			ELSIF (ABS(y.realval) = DevCPM.InfReal) & (x.realval = 0.0) THEN err(212)
+			ELSE z.realval := x.realval * y.realval
+			END
+		ELSE HALT(100)
+		END;
+		GetConstType(z, type.form, 204, type)
+	END MulConst;
+	
+	PROCEDURE DivConst (x, y, z: DevCPT.Const; VAR type: DevCPT.Struct);	(* z := x / y *)
+	BEGIN
+		IF type.form IN realSet THEN
+			IF (x.realval = 0.0) & (y.realval = 0.0) THEN err(212)
+			ELSIF (ABS(x.realval) =  DevCPM.InfReal) & (ABS(y.realval) =  DevCPM.InfReal) THEN err(212)
+			ELSE z.realval := x.realval / y.realval
+			END
+		ELSE HALT(100)
+		END;
+		GetConstType(z, type.form, 204, type)
+	END DivConst;
+	
+	PROCEDURE DivModConst (x, y: DevCPT.Const; div: BOOLEAN; VAR type: DevCPT.Struct);
+	(* x := x DIV y | x MOD y *)
+	BEGIN
+		IF type.form IN intSet THEN
+			IF y.realval + y.intval # 0 THEN
+				Prepare(x); Prepare(y);
+				quot.realval := Floor((x.realval + x.intval) / (y.realval + y.intval));
+				quot.intval := 0; Prepare(quot);
+				x.realval := x.realval - quot.realval * y.realval - quot.realval * y.intval - quot.intval * y.realval;
+				x.intval := x.intval - quot.intval * y.intval;
+				IF y.realval + y.intval > 0 THEN
+					WHILE x.realval + x.intval > 0 DO SubConst(x, y, x, type); INC(quot.intval) END;
+					WHILE x.realval + x.intval < 0 DO AddConst(x, y, x, type); DEC(quot.intval) END
+				ELSE
+					WHILE x.realval + x.intval < 0 DO SubConst(x, y, x, type); INC(quot.intval) END;
+					WHILE x.realval + x.intval > 0 DO AddConst(x, y, x, type); DEC(quot.intval) END
+				END;
+				IF div THEN x.realval := quot.realval; x.intval := quot.intval END;
+				GetConstType(x, type.form, 204, type)
+			ELSE err(205)
+			END
+		ELSE HALT(100)
+		END
+	END DivModConst;
+	
+	PROCEDURE EqualConst (x, y: DevCPT.Const; form: INTEGER): BOOLEAN;	(* x = y *)
+		VAR res: BOOLEAN;
+	BEGIN
+		CASE form OF
+		| Undef: res := TRUE
+		| Bool, Byte, Char8..Int32, Char16: res := x.intval = y.intval
+		| Int64: Prepare(x); Prepare(y); res := (x.realval - y.realval) + (x.intval - y.intval) = 0
+		| Real32, Real64: res := x.realval = y.realval
+		| Set: res := x.setval = y.setval
+		| String8, String16, Comp (* guid *): res := x.ext^ = y.ext^
+		| NilTyp, Pointer, ProcTyp: res := x.intval = y.intval
+		END;
+		RETURN res
+	END EqualConst;
+	
+	PROCEDURE LessConst (x, y: DevCPT.Const; form: INTEGER): BOOLEAN;	(* x < y *)
+		VAR res: BOOLEAN;
+	BEGIN
+		CASE form OF
+		| Undef: res := TRUE
+		| Byte, Char8..Int32, Char16: res := x.intval < y.intval
+		| Int64: Prepare(x); Prepare(y); res := (x.realval - y.realval) + (x.intval - y.intval) < 0
+		| Real32, Real64: res := x.realval < y.realval
+		| String8, String16: res := x.ext^ < y.ext^
+		| Bool, Set, NilTyp, Pointer, ProcTyp, Comp: err(108)
+		END;
+		RETURN res
+	END LessConst;
+	
+	PROCEDURE IsNegConst (x: DevCPT.Const; form: INTEGER): BOOLEAN;	(* x < 0  OR x = (-0.0) *)
+		VAR res: BOOLEAN;
+	BEGIN
+		CASE form OF
+		| Int8..Int32: res := x.intval < 0
+		| Int64: Prepare(x); res := x.realval + x.intval < 0
+		| Real32, Real64: res := (x.realval <= 0.) & (1. / x.realval <= 0.)
+		END;
+		RETURN res
+	END IsNegConst;
+
+
+	PROCEDURE NewIntConst*(intval: INTEGER): DevCPT.Node;
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.conval := DevCPT.NewConst();
+		x.conval.intval := intval; x.conval.realval := 0; x.typ := DevCPT.int32typ; RETURN x
+	END NewIntConst;
+	
+	PROCEDURE NewLargeIntConst* (intval: INTEGER; realval: REAL): DevCPT.Node;
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.conval := DevCPT.NewConst();
+		x.conval.intval := intval; x.conval.realval := realval; x.typ := DevCPT.int64typ; RETURN x
+	END NewLargeIntConst;
+	
+	PROCEDURE NewRealConst*(realval: REAL; typ: DevCPT.Struct): DevCPT.Node;
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.conval := DevCPT.NewConst();
+		x.conval.realval := realval; x.conval.intval := DevCPM.ConstNotAlloc;
+		IF typ = NIL THEN typ := DevCPT.real64typ END;
+		x.typ := typ;
+		RETURN x
+	END NewRealConst;
+	
+	PROCEDURE NewString*(str: DevCPT.String; lstr: POINTER TO ARRAY OF CHAR; len: INTEGER): DevCPT.Node;
+		VAR i, j, c: INTEGER; x: DevCPT.Node; ext: DevCPT.ConstExt;
+	BEGIN
+		x := DevCPT.NewNode(Nconst); x.conval := DevCPT.NewConst();
+		IF lstr # NIL THEN
+			x.typ := DevCPT.string16typ;
+			NEW(ext, 3 * len); i := 0; j := 0;
+			REPEAT c := ORD(lstr[i]); INC(i); DevCPM.PutUtf8(ext^, c, j) UNTIL c = 0;
+			x.conval.ext := ext
+		ELSE
+			x.typ := DevCPT.string8typ; x.conval.ext := str
+		END;
+		x.conval.intval := DevCPM.ConstNotAlloc; x.conval.intval2 := len;
+		RETURN x
+	END NewString;
+	
+	PROCEDURE CharToString8(n: DevCPT.Node);
+		VAR ch: SHORTCHAR;
+	BEGIN
+		n.typ := DevCPT.string8typ; ch := SHORT(CHR(n.conval.intval)); NEW(n.conval.ext, 2);
+		IF ch = 0X THEN n.conval.intval2 := 1 ELSE n.conval.intval2 := 2; n.conval.ext[1] := 0X END ;
+		n.conval.ext[0] := ch; n.conval.intval := DevCPM.ConstNotAlloc; n.obj := NIL
+	END CharToString8;
+	
+	PROCEDURE CharToString16 (n: DevCPT.Node);
+		VAR ch, ch1: SHORTCHAR; i: INTEGER;
+	BEGIN
+		n.typ := DevCPT.string16typ; NEW(n.conval.ext, 4);
+		IF n.conval.intval = 0 THEN
+			n.conval.ext[0] := 0X; n.conval.intval2 := 1
+		ELSE
+			i := 0; DevCPM.PutUtf8(n.conval.ext^, n.conval.intval, i);
+			n.conval.ext[i] := 0X; n.conval.intval2 := 2
+		END;
+		n.conval.intval := DevCPM.ConstNotAlloc; n.obj := NIL
+	END CharToString16;
+	
+	PROCEDURE String8ToString16 (n: DevCPT.Node);
+		VAR i, j, x: INTEGER; ext, new: DevCPT.ConstExt;
+	BEGIN
+		n.typ := DevCPT.string16typ; ext := n.conval.ext;
+		NEW(new, 2 * n.conval.intval2); i := 0; j := 0; 
+		REPEAT x := ORD(ext[i]); INC(i); DevCPM.PutUtf8(new^, x, j) UNTIL x = 0;
+		n.conval.ext := new; n.obj := NIL
+	END String8ToString16;
+	
+	PROCEDURE String16ToString8 (n: DevCPT.Node);
+		VAR i, j, x: INTEGER; ext, new: DevCPT.ConstExt;
+	BEGIN
+		n.typ := DevCPT.string8typ; ext := n.conval.ext;
+		NEW(new, n.conval.intval2); i := 0; j := 0;
+		REPEAT DevCPM.GetUtf8(ext^, x, i); new[j] := SHORT(CHR(x MOD 256)); INC(j) UNTIL x = 0;
+		n.conval.ext := new; n.obj := NIL
+	END String16ToString8;
+	
+	PROCEDURE StringToGuid (VAR n: DevCPT.Node);
+	BEGIN
+		ASSERT((n.class = Nconst) & (n.typ.form = String8));
+		IF ~DevCPM.ValidGuid(n.conval.ext^) THEN err(165) END;
+		n.typ := DevCPT.guidtyp
+	END StringToGuid;
+	
+	PROCEDURE CheckString (n: DevCPT.Node; typ: DevCPT.Struct; e: SHORTINT);
+		VAR ntyp: DevCPT.Struct;
+	BEGIN
+		ntyp := n.typ;
+		IF (typ = DevCPT.guidtyp) & (n.class = Nconst) & (ntyp.form = String8) THEN StringToGuid(n)
+		ELSIF (typ.comp IN {Array, DynArr}) & (typ.BaseTyp.form = Char8) OR (typ.form = String8) THEN
+			IF (n.class = Nconst) & (ntyp.form = Char8) THEN CharToString8(n)
+			ELSIF (ntyp.comp IN {Array, DynArr}) & (ntyp.BaseTyp.form = Char8) OR (ntyp.form = String8) THEN (* ok *)
+			ELSE err(e)
+			END
+		ELSIF (typ.comp IN {Array, DynArr}) & (typ.BaseTyp.form = Char16) OR (typ.form = String16) THEN
+			IF (n.class = Nconst) & (ntyp.form IN charSet) THEN CharToString16(n)
+			ELSIF (n.class = Nconst) & (ntyp.form = String8) THEN String8ToString16(n)
+			ELSIF (ntyp.comp IN {Array, DynArr}) & (ntyp.BaseTyp.form = Char16) OR (ntyp.form = String16) THEN
+				(* ok *)
+			ELSE err(e)
+			END
+		ELSE err(e)
+		END
+	END CheckString;
+	
+	
+	PROCEDURE BindNodes(class: BYTE; typ: DevCPT.Struct; VAR x: DevCPT.Node; y: DevCPT.Node);
+		VAR node: DevCPT.Node;
+	BEGIN
+		node := DevCPT.NewNode(class); node.typ := typ;
+		node.left := x; node.right := y; x := node
+	END BindNodes;
+
+	PROCEDURE NotVar(x: DevCPT.Node): BOOLEAN;
+	BEGIN
+		RETURN (x.class >= Nconst) & ((x.class # Nmop) OR (x.subcl # val) OR (x.left.class >= Nconst))
+			OR (x.typ.form IN {String8, String16})
+	END NotVar;
+
+
+	PROCEDURE Convert(VAR x: DevCPT.Node; typ: DevCPT.Struct);
+		VAR node: DevCPT.Node; f, g: SHORTINT; k: INTEGER; r: REAL;
+	BEGIN f := x.typ.form; g := typ.form;
+		IF x.class = Nconst THEN
+			IF g = String8 THEN
+				IF f = String16 THEN String16ToString8(x)
+				ELSIF f IN charSet THEN CharToString8(x)
+				ELSE typ := DevCPT.undftyp
+				END
+			ELSIF g = String16 THEN
+				IF f = String8 THEN String8ToString16(x)
+				ELSIF f IN charSet THEN CharToString16(x)
+				ELSE typ := DevCPT.undftyp
+				END
+			ELSE ConvConst(x.conval, f, g)
+			END;
+			x.obj := NIL
+		ELSIF (x.class = Nmop) & (x.subcl = conv) & (DevCPT.Includes(f, x.left.typ.form) OR DevCPT.Includes(f, g))
+		THEN
+			(* don't create new node *)
+			IF x.left.typ.form = typ.form THEN (* and suppress existing node *) x := x.left END
+		ELSE
+			IF (x.class = Ndop) & (x.typ.form IN {String8, String16}) THEN	(* propagate to leaf nodes *)
+				Convert(x.left, typ); Convert(x.right, typ)
+			ELSE
+				node := DevCPT.NewNode(Nmop); node.subcl := conv; node.left := x; x := node;
+			END
+		END;
+		x.typ := typ
+	END Convert;
+
+	PROCEDURE Promote (VAR left, right: DevCPT.Node; op: INTEGER);	(* check expression compatibility *)
+		VAR f, g: INTEGER; new: DevCPT.Struct;
+	BEGIN
+		f := left.typ.form; g := right.typ.form; new := left.typ;
+		IF f IN intSet + realSet THEN
+			IF g IN intSet + realSet THEN
+				IF (f = Real32) & (right.class = Nconst) & (g IN realSet) & (left.class # Nconst)
+					(* & ((ABS(right.conval.realval) <= DevCPM.MaxReal32)
+							OR (ABS(right.conval.realval) = DevCPM.InfReal)) *)
+				OR (g = Real32) & (left.class = Nconst) & (f IN realSet) & (right.class # Nconst)
+					(* & ((ABS(left.conval.realval) <= DevCPM.MaxReal32)
+							OR (ABS(left.conval.realval) = DevCPM.InfReal)) *) THEN
+						new := DevCPT.real32typ	(* SR *)
+				ELSIF (f = Real64) OR (g = Real64) THEN new := DevCPT.real64typ
+				ELSIF (f = Real32) OR (g = Real32) THEN new := DevCPT.real32typ	(* SR *)
+				ELSIF op = slash THEN new := DevCPT.real64typ
+				ELSIF (f = Int64) OR (g = Int64) THEN new := DevCPT.int64typ
+				ELSE new := DevCPT.int32typ
+				END
+			ELSE err(100)
+			END
+		ELSIF (left.typ = DevCPT.guidtyp) OR (right.typ = DevCPT.guidtyp) THEN
+			IF f = String8 THEN StringToGuid(left) END;
+			IF g = String8 THEN StringToGuid(right) END;
+			IF left.typ # right.typ THEN err(100) END;
+			f := Comp
+		ELSIF f IN charSet + {String8, String16} THEN
+			IF g IN charSet + {String8, String16} THEN
+				IF (f = String16) OR (g = String16) OR (f = Char16) & (g = String8) OR (f = String8) & (g = Char16) THEN
+					new := DevCPT.string16typ
+				ELSIF (f = Char16) OR (g = Char16) THEN new := DevCPT.char16typ
+				ELSIF (f = String8) OR (g = String8) THEN new := DevCPT.string8typ
+				ELSIF op = plus THEN
+					IF (f = Char16) OR (g = Char16) THEN new := DevCPT.string16typ
+					ELSE new := DevCPT.string8typ
+					END
+				END;
+				IF (new.form IN {String8, String16})
+					& ((f IN charSet) & (left.class # Nconst) OR (g IN charSet) & (right.class # Nconst))
+				THEN
+					err(100)
+				END
+			ELSE err(100)
+			END
+		ELSIF (f IN {NilTyp, Pointer, ProcTyp}) & (g IN {NilTyp, Pointer, ProcTyp}) THEN
+			IF ~DevCPT.SameType(left.typ, right.typ) & (f # NilTyp) & (g # NilTyp)
+				& ~((f = Pointer) & (g = Pointer)
+					& (DevCPT.Extends(left.typ, right.typ) OR DevCPT.Extends(right.typ, left.typ))) THEN err(100) END
+		ELSIF f # g THEN err(100)
+		END;
+		IF ~(f IN {NilTyp, Pointer, ProcTyp, Comp}) THEN
+			IF g # new.form THEN Convert(right, new) END;
+			IF f # new.form THEN Convert(left, new) END
+		END
+	END Promote;
+
+	PROCEDURE CheckParameters* (fp, ap: DevCPT.Object; checkNames: BOOLEAN); (* checks par list match *)
+		VAR ft, at: DevCPT.Struct;
+	BEGIN
+		WHILE fp # NIL DO
+			IF ap # NIL THEN
+				ft := fp.typ; at := ap.typ;
+				IF fp.ptyp # NIL THEN ft := fp.ptyp END;	(* get original formal type *)
+				IF ap.ptyp # NIL THEN at := ap.ptyp END;	(* get original formal type *)
+				IF ~DevCPT.EqualType(ft, at)
+					OR (fp.mode # ap.mode) OR (fp.sysflag # ap.sysflag) OR (fp.vis # ap.vis)
+					OR checkNames & (fp.name^ # ap.name^) THEN err(115) END ;
+				ap := ap.link
+			ELSE err(116)
+			END;
+			fp := fp.link
+		END;
+		IF ap # NIL THEN err(116) END
+	END CheckParameters;
+
+	PROCEDURE CheckNewParamPair* (newPar, iidPar: DevCPT.Node);
+		VAR ityp, ntyp: DevCPT.Struct;
+	BEGIN
+		ntyp := newPar.typ.BaseTyp;
+		IF (newPar.class = Nvarpar) & ODD(newPar.obj.sysflag DIV newBit) THEN
+			IF (iidPar.class = Nvarpar) & ODD(iidPar.obj.sysflag DIV iidBit) & (iidPar.obj.mnolev = newPar.obj.mnolev)
+			THEN (* ok *)
+			ELSE err(168)
+			END
+		ELSIF ntyp.extlev = 0 THEN	(* ok *)
+		ELSIF (iidPar.class = Nconst) & (iidPar.obj # NIL) & (iidPar.obj.mode = Typ) THEN
+			IF ~DevCPT.Extends(iidPar.obj.typ, ntyp) THEN err(168) END
+		ELSE err(168)
+		END
+	END CheckNewParamPair;
+
+	
+	PROCEDURE DeRef*(VAR x: DevCPT.Node);
+		VAR strobj, bstrobj: DevCPT.Object; typ, btyp: DevCPT.Struct;
+	BEGIN
+		typ := x.typ;
+		IF (x.class = Nconst) OR (x.class = Ntype) OR (x.class = Nproc) THEN err(78)
+		ELSIF typ.form = Pointer THEN
+			btyp := typ.BaseTyp; strobj := typ.strobj; bstrobj := btyp.strobj;
+			IF (strobj # NIL) & (strobj.name # DevCPT.null) & (bstrobj # NIL) & (bstrobj.name # DevCPT.null) THEN
+				btyp.pbused := TRUE
+			END ;
+			BindNodes(Nderef, btyp, x, NIL); x.subcl := 0
+		ELSE err(84)
+		END
+	END DeRef;
+
+	PROCEDURE StrDeref*(VAR x: DevCPT.Node);
+		VAR typ, btyp: DevCPT.Struct;
+	BEGIN
+		typ := x.typ;
+		IF (x.class = Nconst) OR (x.class = Ntype) OR (x.class = Nproc) THEN err(78)
+		ELSIF ((typ.comp IN {Array, DynArr}) & (typ.BaseTyp.form IN charSet)) OR (typ.sysflag = jstr) THEN
+			IF (typ.BaseTyp # NIL) & (typ.BaseTyp.form = Char8) THEN btyp := DevCPT.string8typ
+			ELSE btyp := DevCPT.string16typ
+			END;
+			BindNodes(Nderef, btyp, x, NIL); x.subcl := 1
+		ELSE err(90)
+		END
+	END StrDeref;
+
+	PROCEDURE Index*(VAR x: DevCPT.Node; y: DevCPT.Node);
+		VAR f: SHORTINT; typ: DevCPT.Struct;
+	BEGIN
+		f := y.typ.form;
+		IF (x.class = Nconst) OR (x.class = Ntype) OR (x.class = Nproc) THEN err(79)
+		ELSIF ~(f IN intSet) OR (y.class IN {Nproc, Ntype}) THEN err(80); y.typ := DevCPT.int32typ END ;
+		IF f = Int64 THEN Convert(y, DevCPT.int32typ) END;
+		IF x.typ.comp = Array THEN typ := x.typ.BaseTyp;
+			IF (y.class = Nconst) & ((y.conval.intval < 0) OR (y.conval.intval >= x.typ.n)) THEN err(81) END
+		ELSIF x.typ.comp = DynArr THEN typ := x.typ.BaseTyp;
+			IF (y.class = Nconst) & (y.conval.intval < 0) THEN err(81) END
+		ELSE err(82); typ := DevCPT.undftyp
+		END ;
+		BindNodes(Nindex, typ, x, y); x.readonly := x.left.readonly
+	END Index;
+	
+	PROCEDURE Field*(VAR x: DevCPT.Node; y: DevCPT.Object);
+	BEGIN (*x.typ.comp = Record*)
+		IF (x.class = Nconst) OR (x.class = Ntype) OR (x.class = Nproc) THEN err(77) END ;
+		IF (y # NIL) & (y.mode IN {Fld, TProc}) THEN
+			BindNodes(Nfield, y.typ, x, NIL); x.obj := y;
+			x.readonly := x.left.readonly OR ((y.vis = externalR) & (y.mnolev < 0))
+		ELSE err(83); x.typ := DevCPT.undftyp
+		END
+	END Field;
+	
+	PROCEDURE TypTest*(VAR x: DevCPT.Node; obj: DevCPT.Object; guard: BOOLEAN);
+
+		PROCEDURE GTT(t0, t1: DevCPT.Struct);
+			VAR node: DevCPT.Node;
+		BEGIN
+			IF (t0 # NIL) & DevCPT.SameType(t0, t1) & (guard OR (x.class # Nguard)) THEN
+				IF ~guard THEN x := NewBoolConst(TRUE) END
+			ELSIF (t0 = NIL) OR DevCPT.Extends(t1, t0) OR (t0.sysflag = jint) OR (t1.sysflag = jint)
+					OR (t1.comp = DynArr) & (DevCPM.java IN DevCPM.options) THEN
+				IF guard THEN BindNodes(Nguard, NIL, x, NIL); x.readonly := x.left.readonly
+				ELSE node := DevCPT.NewNode(Nmop); node.subcl := is; node.left := x; node.obj := obj; x := node
+				END
+			ELSE err(85)
+			END
+		END GTT;
+
+	BEGIN
+		IF (x.class = Nconst) OR (x.class = Ntype) OR (x.class = Nproc) THEN err(112)
+		ELSIF x.typ.form = Pointer THEN
+			IF x.typ = DevCPT.sysptrtyp THEN
+				IF obj.typ.form = Pointer THEN GTT(NIL, obj.typ.BaseTyp)
+				ELSE err(86)
+				END
+			ELSIF x.typ.BaseTyp.comp # Record THEN err(85)
+			ELSIF obj.typ.form = Pointer THEN GTT(x.typ.BaseTyp, obj.typ.BaseTyp)
+			ELSE err(86)
+			END
+		ELSIF (x.typ.comp = Record) & (x.class = Nvarpar) & (x.obj.vis # outPar) & (obj.typ.comp = Record) THEN
+			GTT(x.typ, obj.typ)
+		ELSE err(87)
+		END ;
+		IF guard THEN x.typ := obj.typ ELSE x.typ := DevCPT.booltyp END
+	END TypTest;
+	
+	PROCEDURE In*(VAR x: DevCPT.Node; y: DevCPT.Node);
+		VAR f: SHORTINT; k: INTEGER;
+	BEGIN f := x.typ.form;
+		IF (x.class = Ntype) OR (x.class = Nproc) OR (y.class = Ntype) OR (y.class = Nproc) THEN err(126)
+		ELSIF (f IN intSet) & (y.typ.form = Set) THEN
+			IF f = Int64 THEN Convert(x, DevCPT.int32typ) END;
+			IF x.class = Nconst THEN
+				k := x.conval.intval;
+				IF (k < 0) OR (k > DevCPM.MaxSet) THEN err(202)
+				ELSIF y.class = Nconst THEN x.conval.intval := BoolToInt(k IN y.conval.setval); x.obj := NIL
+				ELSE BindNodes(Ndop, DevCPT.booltyp, x, y); x.subcl := in
+				END
+			ELSE BindNodes(Ndop, DevCPT.booltyp, x, y); x.subcl := in
+			END
+		ELSE err(92)
+		END ;
+		x.typ := DevCPT.booltyp
+	END In;
+
+	PROCEDURE MOp*(op: BYTE; VAR x: DevCPT.Node);
+		VAR f: SHORTINT; typ: DevCPT.Struct; z: DevCPT.Node;
+		
+		PROCEDURE NewOp(op: BYTE; typ: DevCPT.Struct; z: DevCPT.Node): DevCPT.Node;
+			VAR node: DevCPT.Node;
+		BEGIN
+			node := DevCPT.NewNode(Nmop); node.subcl := op; node.typ := typ;
+			node.left := z; RETURN node
+		END NewOp;
+
+	BEGIN z := x;
+		IF ((z.class = Ntype) OR (z.class = Nproc)) & (op # adr) & (op # typfn) & (op # size) THEN err(126)	(* !!! *)
+		ELSE
+			typ := z.typ; f := typ.form;
+			CASE op OF
+			| not:
+				IF f = Bool THEN
+					IF z.class = Nconst THEN
+						z.conval.intval := BoolToInt(~IntToBool(z.conval.intval)); z.obj := NIL
+					ELSE z := NewOp(op, typ, z)
+					END
+				ELSE err(98)
+				END
+			| plus:
+				IF ~(f IN intSet + realSet) THEN err(96) END
+			| minus:
+				IF f IN intSet + realSet + {Set} THEN
+					IF z.class = Nconst THEN
+						IF f = Set THEN z.conval.setval := -z.conval.setval
+						ELSE NegateConst(z.conval, z.conval, z.typ)
+						END;
+						z.obj := NIL
+					ELSE
+						IF f < Int32 THEN Convert(z, DevCPT.int32typ) END;
+						z := NewOp(op, z.typ, z)
+					END
+				ELSE err(97)
+				END
+			| abs:
+				IF f IN intSet + realSet THEN
+					IF z.class = Nconst THEN
+						IF IsNegConst(z.conval, f) THEN NegateConst(z.conval, z.conval, z.typ) END;
+						z.obj := NIL
+					ELSE
+						IF f < Int32 THEN Convert(z, DevCPT.int32typ) END;
+						z := NewOp(op, z.typ, z)
+					END
+				ELSE err(111)
+				END
+			| cap:
+				IF f IN charSet THEN
+					IF z.class = Nconst THEN
+						IF ODD(z.conval.intval DIV 32) THEN DEC(z.conval.intval, 32) END;
+						z.obj := NIL
+					ELSE z := NewOp(op, typ, z)
+					END
+				ELSE err(111); z.typ := DevCPT.char8typ
+				END
+			| odd:
+				IF f IN intSet THEN
+					IF z.class = Nconst THEN
+						DivModConst(z.conval, two, FALSE, z.typ);	(* z MOD 2 *)
+						z.obj := NIL
+					ELSE z := NewOp(op, typ, z)
+					END
+				ELSE err(111)
+				END ;
+				z.typ := DevCPT.booltyp
+			| adr: (*ADR*)
+				IF z.class = Nproc THEN
+					IF z.obj.mnolev > 0 THEN err(73)
+					ELSIF z.obj.mode = LProc THEN z.obj.mode := XProc
+					END;
+					z := NewOp(op, typ, z)
+				ELSIF z.class = Ntype THEN
+					IF z.obj.typ.untagged THEN err(111) END;
+					z := NewOp(op, typ, z)
+				ELSIF (z.class < Nconst) OR (z.class = Nconst) & (f IN {String8, String16}) THEN
+					z := NewOp(op, typ, z)
+				ELSE err(127)
+				END ;
+				z.typ := DevCPT.int32typ
+			| typfn, size: (*TYP, SIZE*)
+				z := NewOp(op, typ, z);
+				z.typ := DevCPT.int32typ
+			| cc: (*SYSTEM.CC*)
+				IF (f IN intSet) & (z.class = Nconst) THEN
+					IF (0 <= z.conval.intval) & (z.conval.intval <= DevCPM.MaxCC) & (z.conval.realval = 0) THEN
+						z := NewOp(op, typ, z)
+					ELSE err(219)
+					END
+				ELSE err(69)
+				END;
+				z.typ := DevCPT.booltyp
+			END
+		END;
+		x := z
+	END MOp;
+	
+	PROCEDURE ConstOp(op: SHORTINT; x, y: DevCPT.Node);
+		VAR f: SHORTINT; i, j: INTEGER; xval, yval: DevCPT.Const; ext: DevCPT.ConstExt; t: DevCPT.Struct;
+	BEGIN
+		f := x.typ.form;
+		IF f = y.typ.form THEN
+			xval := x.conval; yval := y.conval;
+			CASE op OF
+			| times:
+				IF f IN intSet + realSet THEN MulConst(xval, yval, xval, x.typ)
+				ELSIF f = Set THEN xval.setval := xval.setval * yval.setval
+				ELSIF f # Undef THEN err(101)
+				END
+			| slash:
+				IF f IN realSet THEN DivConst(xval, yval, xval, x.typ)
+				ELSIF f = Set THEN xval.setval := xval.setval / yval.setval
+				ELSIF f # Undef THEN err(102)
+				END
+			| div:
+				IF f IN intSet THEN DivModConst(xval, yval, TRUE, x.typ)
+				ELSIF f # Undef THEN err(103)
+				END
+			| mod:
+				IF f IN intSet THEN DivModConst(xval, yval, FALSE, x.typ)
+				ELSIF f # Undef THEN err(104)
+				END
+			| and:
+				IF f = Bool THEN xval.intval := BoolToInt(IntToBool(xval.intval) & IntToBool(yval.intval))
+				ELSE err(94)
+				END
+			| plus:
+				IF f IN intSet + realSet THEN AddConst(xval, yval, xval, x.typ)
+				ELSIF f = Set THEN xval.setval := xval.setval + yval.setval
+				ELSIF (f IN {String8, String16}) & (xval.ext # NIL) & (yval.ext # NIL) THEN
+					NEW(ext, LEN(xval.ext^) + LEN(yval.ext^));
+					i := 0; WHILE xval.ext[i] # 0X DO ext[i] := xval.ext[i]; INC(i) END;
+					j := 0; WHILE yval.ext[j] # 0X DO ext[i] := yval.ext[j]; INC(i); INC(j) END;
+					ext[i] := 0X; xval.ext := ext; INC(xval.intval2, yval.intval2 - 1)
+				ELSIF f # Undef THEN err(105)
+				END
+			| minus:
+				IF f IN intSet + realSet THEN SubConst(xval, yval, xval, x.typ)
+				ELSIF f = Set THEN xval.setval := xval.setval - yval.setval
+				ELSIF f # Undef THEN err(106)
+				END
+			| min:
+				IF f IN intSet + realSet THEN
+					IF LessConst(yval, xval, f) THEN xval^ := yval^ END
+				ELSIF f # Undef THEN err(111)
+				END
+			| max:
+				IF f IN intSet + realSet THEN
+					IF LessConst(xval, yval, f) THEN xval^ := yval^ END
+				ELSIF f # Undef THEN err(111)
+				END
+			| or:
+				IF f = Bool THEN xval.intval := BoolToInt(IntToBool(xval.intval) OR IntToBool(yval.intval))
+				ELSE err(95)
+				END
+			| eql: xval.intval := BoolToInt(EqualConst(xval, yval, f)); x.typ := DevCPT.booltyp
+			| neq: xval.intval := BoolToInt(~EqualConst(xval, yval, f)); x.typ := DevCPT.booltyp
+			| lss: xval.intval := BoolToInt(LessConst(xval, yval, f)); x.typ := DevCPT.booltyp
+			| leq: xval.intval := BoolToInt(~LessConst(yval, xval, f)); x.typ := DevCPT.booltyp
+			| gtr: xval.intval := BoolToInt(LessConst(yval, xval, f)); x.typ := DevCPT.booltyp
+			| geq: xval.intval := BoolToInt(~LessConst(xval, yval, f)); x.typ := DevCPT.booltyp
+			END
+		ELSE err(100)
+		END;
+		x.obj := NIL
+	END ConstOp;
+	
+	PROCEDURE Op*(op: BYTE; VAR x: DevCPT.Node; y: DevCPT.Node);
+		VAR f, g: SHORTINT; t, z: DevCPT.Node; typ: DevCPT.Struct; do: BOOLEAN; val: INTEGER;
+
+		PROCEDURE NewOp(op: BYTE; typ: DevCPT.Struct; VAR x: DevCPT.Node; y: DevCPT.Node);
+			VAR node: DevCPT.Node;
+		BEGIN
+			node := DevCPT.NewNode(Ndop); node.subcl := op; node.typ := typ;
+			node.left := x; node.right := y; x := node
+		END NewOp;
+
+	BEGIN z := x;
+		IF (z.class = Ntype) OR (z.class = Nproc) OR (y.class = Ntype) OR (y.class = Nproc) THEN err(126)
+		ELSE
+			Promote(z, y, op);
+			IF (z.class = Nconst) & (y.class = Nconst) THEN ConstOp(op, z, y)
+			ELSE
+				typ := z.typ; f := typ.form; g := y.typ.form;
+				CASE op OF
+				| times:
+					do := TRUE;
+					IF f IN intSet THEN
+						IF z.class = Nconst THEN
+							IF EqualConst(z.conval, one, f) THEN do := FALSE; z := y
+							ELSIF EqualConst(z.conval, zero, f) THEN do := FALSE
+							ELSE val := Log(z);
+								IF val >= 0 THEN
+									t := y; y := z; z := t;
+									op := ash; y.typ := DevCPT.int32typ; y.conval.intval := val; y.obj := NIL
+								END
+							END
+						ELSIF y.class = Nconst THEN
+							IF EqualConst(y.conval, one, f) THEN do := FALSE
+							ELSIF EqualConst(y.conval, zero, f) THEN do := FALSE; z := y
+							ELSE val := Log(y);
+								IF val >= 0 THEN
+									op := ash; y.typ := DevCPT.int32typ; y.conval.intval := val; y.obj := NIL
+								END
+							END
+						END
+					ELSIF ~(f IN {Undef, Real32..Set}) THEN err(105); typ := DevCPT.undftyp
+					END ;
+					IF do THEN NewOp(op, typ, z, y) END;
+				| slash:
+					IF f IN realSet THEN (* OK *)
+					ELSIF (f # Set) & (f # Undef) THEN err(102); typ := DevCPT.undftyp
+					END ;
+					NewOp(op, typ, z, y)
+				| div:
+					do := TRUE;
+					IF f IN intSet THEN
+						IF y.class = Nconst THEN
+							IF EqualConst(y.conval, zero, f) THEN err(205)
+							ELSIF EqualConst(y.conval, one, f) THEN do := FALSE
+							ELSE val := Log(y);
+								IF val >= 0 THEN
+									op := ash; y.typ := DevCPT.int32typ; y.conval.intval := -val; y.obj := NIL
+								END
+							END
+						END
+					ELSIF f # Undef THEN err(103); typ := DevCPT.undftyp
+					END ;
+					IF do THEN NewOp(op, typ, z, y) END;
+				| mod:
+					IF f IN intSet THEN
+						IF y.class = Nconst THEN
+							IF EqualConst(y.conval, zero, f) THEN err(205)
+							ELSE val := Log(y);
+								IF val >= 0 THEN
+									op := msk; y.conval.intval := ASH(-1, val); y.obj := NIL
+								END
+							END
+						END
+					ELSIF f # Undef THEN err(104); typ := DevCPT.undftyp
+					END ;
+					NewOp(op, typ, z, y);
+				| and:
+					IF f = Bool THEN
+						IF z.class = Nconst THEN
+							IF IntToBool(z.conval.intval) THEN z := y END
+						ELSIF (y.class = Nconst) & IntToBool(y.conval.intval) THEN (* optimize z & TRUE -> z *)
+						ELSE NewOp(op, typ, z, y)
+						END
+					ELSIF f # Undef THEN err(94); z.typ := DevCPT.undftyp
+					END
+				| plus:
+					IF ~(f IN {Undef, Int8..Set, Int64, String8, String16}) THEN err(105); typ := DevCPT.undftyp END;
+					do := TRUE;
+					IF f IN intSet THEN
+						IF (z.class = Nconst) & EqualConst(z.conval, zero, f) THEN do := FALSE; z := y END ;
+						IF (y.class = Nconst) & EqualConst(y.conval, zero, f) THEN do := FALSE END
+					ELSIF f IN {String8, String16} THEN
+						IF (z.class = Nconst) & (z.conval.intval2 = 1) THEN do := FALSE; z := y END ;
+						IF (y.class = Nconst) & (y.conval.intval2 = 1) THEN do := FALSE END;
+						IF do THEN
+							IF z.class = Ndop THEN
+								t := z; WHILE t.right.class = Ndop DO t := t.right END;
+								IF (t.right.class = Nconst) & (y.class = Nconst) THEN
+									ConstOp(op, t.right, y); do := FALSE
+								ELSIF (t.right.class = Nconst) & (y.class = Ndop) & (y.left.class = Nconst) THEN
+									ConstOp(op, t.right, y.left); y.left := t.right; t.right := y; do := FALSE
+								ELSE
+									NewOp(op, typ, t.right, y); do := FALSE
+								END
+							ELSE
+								IF (z.class = Nconst) & (y.class = Ndop) & (y.left.class = Nconst) THEN
+									ConstOp(op, z, y.left); y.left := z; z := y; do := FALSE
+								END
+							END
+						END
+					END ;
+					IF do THEN NewOp(op, typ, z, y) END;
+				| minus:
+					IF ~(f IN {Undef, Int8..Set, Int64}) THEN err(106); typ := DevCPT.undftyp END;
+					IF ~(f IN intSet) OR (y.class # Nconst) OR ~EqualConst(y.conval, zero, f) THEN NewOp(op, typ, z, y)
+					END;
+				| min, max:
+					IF ~(f IN {Undef} + intSet + realSet + charSet) THEN err(111); typ := DevCPT.undftyp END;
+					NewOp(op, typ, z, y);
+				| or:
+					IF f = Bool THEN
+						IF z.class = Nconst THEN
+							IF ~IntToBool(z.conval.intval) THEN z := y END
+						ELSIF (y.class = Nconst) & ~IntToBool(y.conval.intval) THEN (* optimize z OR FALSE -> z *)
+						ELSE NewOp(op, typ, z, y)
+						END
+					ELSIF f # Undef THEN err(95); z.typ := DevCPT.undftyp
+					END
+				| eql, neq, lss, leq, gtr, geq:
+					IF f IN {String8, String16} THEN
+						IF (f = String16) & (z.class = Nmop) & (z.subcl = conv) & (y.class = Nmop) & (y.subcl = conv) THEN
+							z := z.left; y := y.left	(* remove LONG on both sides *)
+						ELSIF (z.class = Nconst) & (z.conval.intval2 = 1) & (y.class = Nderef) THEN (* y$ = "" -> y[0] = 0X *)
+							y := y.left; Index(y, NewIntConst(0)); z.typ := y.typ; z.conval.intval := 0
+						ELSIF (y.class = Nconst) & (y.conval.intval2 = 1) & (z.class = Nderef) THEN (* z$ = "" -> z[0] = 0X *)
+							z := z.left; Index(z, NewIntConst(0)); y.typ := z.typ; y.conval.intval := 0
+						END;
+						typ := DevCPT.booltyp
+					ELSIF (f IN {Undef, Char8..Real64, Char16, Int64})
+							OR (op <= neq) & ((f IN {Bool, Set, NilTyp, Pointer, ProcTyp}) OR (typ = DevCPT.guidtyp)) THEN
+						typ := DevCPT.booltyp
+					ELSE err(107); typ := DevCPT.undftyp
+					END;
+					NewOp(op, typ, z, y)
+				END
+			END
+		END;
+		x := z
+	END Op;
+
+	PROCEDURE SetRange*(VAR x: DevCPT.Node; y: DevCPT.Node);
+		VAR k, l: INTEGER;
+	BEGIN
+		IF (x.class = Ntype) OR (x.class = Nproc) OR (y.class = Ntype) OR (y.class = Nproc) THEN err(126)	
+		ELSIF (x.typ.form IN intSet) & (y.typ.form IN intSet) THEN
+			IF x.typ.form = Int64 THEN Convert(x, DevCPT.int32typ) END;
+			IF y.typ.form = Int64 THEN Convert(y, DevCPT.int32typ) END;
+			IF x.class = Nconst THEN
+				k := x.conval.intval;
+				IF (0 > k) OR (k > DevCPM.MaxSet) OR (x.conval.realval # 0) THEN err(202) END
+			END ;
+			IF y.class = Nconst THEN
+				l := y.conval.intval;
+				IF (0 > l) OR (l > DevCPM.MaxSet) OR (y.conval.realval # 0) THEN err(202) END
+			END ;
+			IF (x.class = Nconst) & (y.class = Nconst) THEN
+				IF k <= l THEN
+					x.conval.setval := {k..l}
+				ELSE err(201); x.conval.setval := {l..k}
+				END ;
+				x.obj := NIL
+			ELSE BindNodes(Nupto, DevCPT.settyp, x, y)
+			END
+		ELSE err(93)
+		END ;
+		x.typ := DevCPT.settyp
+	END SetRange;
+
+	PROCEDURE SetElem*(VAR x: DevCPT.Node);
+		VAR k: INTEGER;
+	BEGIN
+		IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126) END;
+		IF x.typ.form IN intSet THEN
+			IF x.typ.form = Int64 THEN Convert(x, DevCPT.int32typ) END;
+			IF x.class = Nconst THEN
+				k := x.conval.intval;
+				IF (0 <= k) & (k <= DevCPM.MaxSet) & (x.conval.realval = 0) THEN x.conval.setval := {k}
+				ELSE err(202)
+				END ;
+				x.obj := NIL
+			ELSE BindNodes(Nmop, DevCPT.settyp, x, NIL); x.subcl := bit
+			END ;
+		ELSE err(93)
+		END;
+		x.typ := DevCPT.settyp
+	END SetElem;
+	
+	PROCEDURE CheckAssign* (x: DevCPT.Struct; VAR ynode: DevCPT.Node);
+	(* x := y, checks assignment compatibility *)
+		VAR f, g: SHORTINT; y, b: DevCPT.Struct;
+	BEGIN
+		y := ynode.typ; f := x.form; g := y.form;
+		IF (ynode.class = Ntype) OR (ynode.class = Nproc) & (f # ProcTyp) THEN err(126) END ;
+		CASE f OF
+		| Undef, String8, String16, Byte:
+		| Bool, Set:
+			IF g # f THEN err(113) END
+		| Int8, Int16, Int32, Int64, Real32, Real64:	(* SR *)
+			IF (g IN intSet) OR (g IN realSet) & (f IN realSet) THEN
+				IF ynode.class = Nconst THEN Convert(ynode, x)
+				ELSIF ~DevCPT.Includes(f, g) THEN err(113)
+				END
+			ELSE err(113)
+			END
+(*			
+			IF ~(g IN intSet + realSet) OR ~DevCPT.Includes(f, g) & (~(g IN intSet) OR (ynode.class # Nconst)) THEN
+				err(113)
+			ELSIF ynode.class = Nconst THEN Convert(ynode, x)
+			END
+*)
+		| Char8, Char16:
+			IF ~(g IN charSet) OR ~DevCPT.Includes(f, g) THEN err(113)
+			ELSIF ynode.class = Nconst THEN Convert(ynode, x)
+			END
+		| Pointer:
+			b := x.BaseTyp;
+			IF DevCPT.Extends(y, x)
+				OR (g = NilTyp)
+				OR (g = Pointer)
+					& ((x = DevCPT.sysptrtyp) OR (DevCPM.java IN DevCPM.options) & (x = DevCPT.anyptrtyp))
+			THEN (* ok *)
+			ELSIF (b.comp = DynArr) & b.untagged THEN	(* pointer to untagged open array *)
+				IF ynode.class = Nconst THEN CheckString(ynode, b, 113)
+				ELSIF ~(y.comp IN {Array, DynArr}) OR ~DevCPT.EqualType(b.BaseTyp, y.BaseTyp) THEN err(113)
+				END
+			ELSIF b.untagged & (ynode.class = Nmop) & (ynode.subcl = adr) THEN	(* p := ADR(r) *)
+				IF (b.comp = DynArr) & (ynode.left.class = Nconst) THEN CheckString(ynode.left, b, 113)
+				ELSIF ~DevCPT.Extends(ynode.left.typ, b) THEN err(113)
+				END
+			ELSIF (b.sysflag = jstr) & ((g = String16) OR (ynode.class = Nconst) & (g IN {Char8, Char16, String8}))
+			THEN
+				IF g # String16 THEN Convert(ynode, DevCPT.string16typ) END
+			ELSE err(113)
+			END
+		| ProcTyp:
+			IF DevCPT.EqualType(x, y) OR (g = NilTyp) THEN (* ok *)
+			ELSIF (ynode.class = Nproc) & (ynode.obj.mode IN {XProc, IProc, LProc}) THEN
+				IF ynode.obj.mode = LProc THEN
+					IF ynode.obj.mnolev = 0 THEN ynode.obj.mode := XProc ELSE err(73) END
+				END;
+				IF (x.sysflag = 0) & (ynode.obj.sysflag >= 0) OR (x.sysflag = ynode.obj.sysflag) THEN
+					IF DevCPT.EqualType(x.BaseTyp, ynode.obj.typ) THEN CheckParameters(x.link, ynode.obj.link, FALSE)
+					ELSE err(117)
+					END
+				ELSE err(113)
+				END
+			ELSE err(113)
+			END
+		| NoTyp, NilTyp: err(113)
+		| Comp:
+			x.pvused := TRUE;	(* idfp of y guarantees assignment compatibility with x *)
+			IF x.comp = Record THEN
+				IF ~DevCPT.EqualType(x, y) OR (x.attribute # 0) THEN err(113) END
+			ELSIF g IN {Char8, Char16, String8, String16} THEN
+				IF (x.BaseTyp.form = Char16) & (g = String8) THEN Convert(ynode, DevCPT.string16typ)
+				ELSE CheckString(ynode, x, 113);
+				END;
+				IF (x # DevCPT.guidtyp) & (x.comp = Array) & (ynode.class = Nconst) & (ynode.conval.intval2 > x.n) THEN
+					err(114)
+				END
+			ELSIF (x.comp = Array) & DevCPT.EqualType(x, y) THEN (* ok *)
+			ELSE err(113)
+			END
+		END
+	END CheckAssign;
+	
+	PROCEDURE AssignString (VAR x: DevCPT.Node; str: DevCPT.Node);	(* x := str or x[0] := 0X *)
+	BEGIN
+		ASSERT((str.class = Nconst) & (str.typ.form IN {String8, String16}));
+		IF (x.typ.comp IN {Array, DynArr}) & (str.conval.intval2 = 1) THEN	(* x := "" -> x[0] := 0X *)
+			Index(x, NewIntConst(0));
+			str.typ := x.typ; str.conval.intval := 0;
+		END;
+		BindNodes(Nassign, DevCPT.notyp, x, str); x.subcl := assign
+	END AssignString;
+	
+	PROCEDURE CheckLeaf(x: DevCPT.Node; dynArrToo: BOOLEAN);
+	BEGIN
+		IF (x.class = Nmop) & (x.subcl = val) THEN x := x.left END ;
+		IF x.class = Nguard THEN x := x.left END ;	(* skip last (and unique) guard *)
+		IF (x.class = Nvar) & (dynArrToo OR (x.typ.comp # DynArr)) THEN x.obj.leaf := FALSE END
+	END CheckLeaf;
+	
+	PROCEDURE CheckOldType (x: DevCPT.Node);
+	BEGIN
+		IF ~(DevCPM.oberon IN DevCPM.options)
+			& ((x.typ = DevCPT.lreal64typ) OR (x.typ = DevCPT.lint64typ) OR (x.typ = DevCPT.lchar16typ)) THEN
+			err(198)
+		END
+	END CheckOldType;
+	
+	PROCEDURE StPar0*(VAR par0: DevCPT.Node; fctno: SHORTINT);	(* par0: first param of standard proc *)
+		VAR f: SHORTINT; typ: DevCPT.Struct; x, t: DevCPT.Node;
+	BEGIN x := par0; f := x.typ.form;
+		CASE fctno OF
+		  haltfn: (*HALT*)
+				IF (f IN intSet - {Int64}) & (x.class = Nconst) THEN
+					IF (DevCPM.MinHaltNr <= x.conval.intval) & (x.conval.intval <= DevCPM.MaxHaltNr) THEN
+						BindNodes(Ntrap, DevCPT.notyp, x, x)
+					ELSE err(218)
+					END
+				ELSIF (DevCPM.java IN DevCPM.options)
+					& ((x.class = Ntype) OR (x.class = Nvar))
+					& (x.typ.form = Pointer)
+				THEN
+					BindNodes(Ntrap, DevCPT.notyp, x, x)
+				ELSE err(69)
+				END ;
+				x.typ := DevCPT.notyp
+		| newfn: (*NEW*)
+				typ := DevCPT.notyp;
+				IF NotVar(x) THEN err(112)
+				ELSIF f = Pointer THEN
+					IF DevCPM.NEWusingAdr THEN CheckLeaf(x, TRUE) END ;
+					IF x.readonly THEN err(76)
+					ELSIF (x.typ.BaseTyp.attribute = absAttr)
+						OR (x.typ.BaseTyp.attribute = limAttr) & (x.typ.BaseTyp.mno # 0) THEN err(193)
+					ELSIF (x.obj # NIL) & ODD(x.obj.sysflag DIV newBit) THEN err(167)
+					END ;
+					MarkAsUsed(x);
+					f := x.typ.BaseTyp.comp;
+					IF f IN {Record, DynArr, Array} THEN
+						IF f = DynArr THEN typ := x.typ.BaseTyp END ;
+						BindNodes(Nassign, DevCPT.notyp, x, NIL); x.subcl := newfn
+					ELSE err(111)
+					END
+				ELSE err(111)
+				END ;
+				x.typ := typ
+		| absfn: (*ABS*)
+				MOp(abs, x)
+		| capfn: (*CAP*)
+				MOp(cap, x)
+		| ordfn: (*ORD*) 
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f = Char8 THEN Convert(x, DevCPT.int16typ)
+				ELSIF f = Char16 THEN Convert(x, DevCPT.int32typ)
+				ELSIF f = Set THEN Convert(x, DevCPT.int32typ)
+				ELSE err(111)
+				END
+		| bitsfn: (*BITS*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN {Int8, Int16, Int32} THEN Convert(x, DevCPT.settyp)
+				ELSE err(111)
+				END
+		| entierfn: (*ENTIER*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN realSet THEN Convert(x, DevCPT.int64typ)
+				ELSE err(111)
+				END ;
+				x.typ := DevCPT.int64typ
+		| lentierfcn: (* LENTIER *)
+				IF ~(DevCPM.oberon IN DevCPM.options) THEN err(199) END;
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN realSet THEN Convert(x, DevCPT.int64typ)
+				ELSE err(111)
+				END ;
+				x.typ := DevCPT.int64typ
+		| oddfn: (*ODD*)
+				MOp(odd, x)
+		| minfn: (*MIN*)
+				IF x.class = Ntype THEN
+					CheckOldType(x);
+					CASE f OF
+					  Bool:  x := NewBoolConst(FALSE)
+					| Char8:  x := NewIntConst(0); x.typ := DevCPT.char8typ
+					| Char16:  x := NewIntConst(0); x.typ := DevCPT.char8typ
+					| Int8:  x := NewIntConst(-128)
+					| Int16:   x := NewIntConst(-32768)
+					| Int32:  x := NewIntConst(-2147483648)
+					| Int64:  x := NewLargeIntConst(0, -9223372036854775808.0E0)	(* -2^63 *)
+					| Set:   x := NewIntConst(0) (*; x.typ := DevCPT.int16typ *)
+					| Real32:  x := NewRealConst(DevCPM.MinReal32, DevCPT.real64typ)
+					| Real64: x := NewRealConst(DevCPM.MinReal64, DevCPT.real64typ)
+					ELSE err(111)
+					END;
+					x.hint := 1
+				ELSIF ~(f IN intSet + realSet + charSet) THEN err(111)
+				END
+		| maxfn: (*MAX*)
+				IF x.class = Ntype THEN
+					CheckOldType(x);
+					CASE f OF
+					  Bool:  x := NewBoolConst(TRUE)
+					| Char8:  x := NewIntConst(0FFH); x.typ := DevCPT.char8typ
+					| Char16:  x := NewIntConst(0FFFFH); x.typ := DevCPT.char16typ
+					| Int8:  x := NewIntConst(127)
+					| Int16:   x := NewIntConst(32767)
+					| Int32:  x := NewIntConst(2147483647)
+					| Int64:  x := NewLargeIntConst(-1, 9223372036854775808.0E0)	(* 2^63 - 1 *)
+					| Set:   x := NewIntConst(31) (*; x.typ := DevCPT.int16typ *)
+					| Real32:  x := NewRealConst(DevCPM.MaxReal32, DevCPT.real64typ)
+					| Real64: x := NewRealConst(DevCPM.MaxReal64, DevCPT.real64typ)
+					ELSE err(111)
+					END;
+					x.hint := 1
+				ELSIF ~(f IN intSet + realSet + charSet) THEN err(111)
+				END
+		| chrfn: (*CHR*) 
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN {Undef, Int8..Int32, Int64} THEN Convert(x, DevCPT.char16typ)
+				ELSE err(111); x.typ := DevCPT.char16typ
+				END
+		| lchrfn: (* LCHR *)
+				IF ~(DevCPM.oberon IN DevCPM.options) THEN err(199) END;
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN {Undef, Int8..Int32, Int64} THEN Convert(x, DevCPT.char16typ)
+				ELSE err(111); x.typ := DevCPT.char16typ
+				END
+		| shortfn: (*SHORT*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSE
+					IF (x.typ.comp IN {Array, DynArr}) & (x.typ.BaseTyp.form IN charSet) THEN StrDeref(x); f := x.typ.form
+					END;
+					IF f = Int16 THEN Convert(x, DevCPT.int8typ)
+					ELSIF f = Int32 THEN Convert(x, DevCPT.int16typ)
+					ELSIF f = Int64 THEN Convert(x, DevCPT.int32typ)
+					ELSIF f = Real64 THEN Convert(x, DevCPT.real32typ)
+					ELSIF f = Char16 THEN Convert(x, DevCPT.char8typ)
+					ELSIF f = String16 THEN Convert(x, DevCPT.string8typ)
+					ELSE err(111)
+					END
+				END
+		| longfn: (*LONG*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSE
+					IF (x.typ.comp IN {Array, DynArr}) & (x.typ.BaseTyp.form IN charSet) THEN StrDeref(x); f := x.typ.form
+					END;
+					IF f = Int8 THEN Convert(x, DevCPT.int16typ)
+					ELSIF f = Int16 THEN Convert(x, DevCPT.int32typ)
+					ELSIF f = Int32 THEN Convert(x, DevCPT.int64typ)
+					ELSIF f = Real32 THEN Convert(x, DevCPT.real64typ)
+					ELSIF f = Char8 THEN Convert(x, DevCPT.char16typ)
+					ELSIF f = String8 THEN Convert(x, DevCPT.string16typ)
+					ELSE err(111)
+					END
+				END
+		| incfn, decfn: (*INC, DEC*) 
+				IF NotVar(x) THEN err(112)
+				ELSIF ~(f IN intSet) THEN err(111)
+				ELSIF x.readonly THEN err(76)
+				END;
+				MarkAsUsed(x)
+		| inclfn, exclfn: (*INCL, EXCL*)
+				IF NotVar(x) THEN err(112)
+				ELSIF f # Set THEN err(111); x.typ := DevCPT.settyp
+				ELSIF x.readonly THEN err(76)
+				END;
+				MarkAsUsed(x)
+		| lenfn: (*LEN*)
+				IF (* (x.class = Ntype) OR *) (x.class = Nproc) THEN err(126)	(* !!! *)
+				(* ELSIF x.typ.sysflag = jstr THEN StrDeref(x) *)
+				ELSE
+					IF x.typ.form = Pointer THEN DeRef(x) END;
+					IF x.class = Nconst THEN
+						IF x.typ.form = Char8 THEN CharToString8(x)
+						ELSIF x.typ.form = Char16 THEN CharToString16(x)
+						END
+					END;
+					IF ~(x.typ.comp IN {DynArr, Array}) & ~(x.typ.form IN {String8, String16}) THEN err(131) END
+				END
+		| copyfn: (*COPY*)
+				IF ~(DevCPM.oberon IN DevCPM.options) THEN err(199) END;
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126) END
+		| ashfn: (*ASH*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN intSet THEN
+					IF f < Int32 THEN Convert(x, DevCPT.int32typ) END
+				ELSE err(111); x.typ := DevCPT.int32typ
+				END
+		| adrfn: (*ADR*)
+				IF x.class = Ntype THEN CheckOldType(x) END;
+				CheckLeaf(x, FALSE); MOp(adr, x)
+		| typfn: (*TYP*)
+				CheckLeaf(x, FALSE);
+				IF x.class = Ntype THEN
+					CheckOldType(x);
+					IF x.typ.form = Pointer THEN x := NewLeaf(x.typ.BaseTyp.strobj) END;
+					IF x.typ.comp # Record THEN err(111) END;
+					MOp(adr, x)
+				ELSE
+					IF x.typ.form = Pointer THEN DeRef(x) END;
+					IF x.typ.comp # Record THEN err(111) END;
+					MOp(typfn, x)
+				END
+		| sizefn: (*SIZE*)
+				IF x.class # Ntype THEN err(110); x := NewIntConst(1)
+				ELSIF (f IN {Byte..Set, Pointer, ProcTyp, Char16, Int64}) OR (x.typ.comp IN {Array, Record}) THEN
+					CheckOldType(x); x.typ.pvused := TRUE;
+					IF typSize # NIL THEN
+						typSize(x.typ); x := NewIntConst(x.typ.size)
+					ELSE
+						MOp(size, x)
+					END
+				ELSE err(111); x := NewIntConst(1)
+				END
+		| thisrecfn, (*THISRECORD*)
+		  thisarrfn: (*THISARRAY*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN {Int8, Int16} THEN Convert(x, DevCPT.int32typ)
+				ELSIF f # Int32 THEN err(111)
+				END
+		| ccfn: (*SYSTEM.CC*)
+				MOp(cc, x)
+		| lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF ~(f IN intSet + charSet + {Byte, Set}) THEN err(111)
+				END
+		| getfn, putfn, bitfn, movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF (x.class = Nconst) & (f IN {Int8, Int16}) THEN Convert(x, DevCPT.int32typ)
+				ELSIF ~(f IN {Int32, Pointer}) THEN err(111); x.typ := DevCPT.int32typ
+				END
+		| getrfn, putrfn: (*SYSTEM.GETREG, SYSTEM.PUTREG*)
+				IF (f IN intSet) & (x.class = Nconst) THEN
+					IF (x.conval.intval < DevCPM.MinRegNr) OR (x.conval.intval > DevCPM.MaxRegNr) THEN err(220)
+					END
+				ELSE err(69)
+				END
+		| valfn: (*SYSTEM.VAL*)
+				IF x.class # Ntype THEN err(110)
+				ELSIF (f IN {Undef, String8, String16, NoTyp, NilTyp}) (* OR (x.typ.comp = DynArr) *) THEN err(111)
+				ELSE CheckOldType(x)
+				END
+		| assertfn: (*ASSERT*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126); x := NewBoolConst(FALSE)
+				ELSIF f # Bool THEN err(120); x := NewBoolConst(FALSE)
+				ELSE MOp(not, x)
+				END
+		| validfn: (* VALID *)
+				IF (x.class = Nvarpar) & ODD(x.obj.sysflag DIV nilBit) THEN
+					MOp(adr, x); x.typ := DevCPT.sysptrtyp; Op(neq, x, Nil())
+				ELSE err(111)
+				END;
+				x.typ := DevCPT.booltyp
+		| iidfn: (* COM.IID *)
+				IF (x.class = Nconst) & (f = String8) THEN StringToGuid(x)
+				ELSE
+					typ := x.typ;
+					IF typ.form = Pointer THEN typ := typ.BaseTyp END;
+					IF (typ.sysflag = interface) & (typ.ext # NIL) & (typ.strobj # NIL) THEN
+						IF x.obj # typ.strobj THEN x := NewLeaf(typ.strobj) END
+					ELSE err(111)
+					END;
+					x.class := Nconst; x.typ := DevCPT.guidtyp
+				END
+		| queryfn: (* COM.QUERY *)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f # Pointer THEN err(111)
+				END
+		END ;
+		par0 := x
+	END StPar0;
+
+	PROCEDURE StPar1*(VAR par0: DevCPT.Node; x: DevCPT.Node; fctno: BYTE);
+	(* x: second parameter of standard proc *)
+		VAR f, n, L, i: INTEGER; typ, tp1: DevCPT.Struct; p, t: DevCPT.Node;
+		
+		PROCEDURE NewOp(class, subcl: BYTE; left, right: DevCPT.Node): DevCPT.Node;
+			VAR node: DevCPT.Node;
+		BEGIN
+			node := DevCPT.NewNode(class); node.subcl := subcl;
+			node.left := left; node.right := right; RETURN node
+		END NewOp;
+		
+	BEGIN p := par0; f := x.typ.form;
+		CASE fctno OF
+		  incfn, decfn: (*INC DEC*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126); p.typ := DevCPT.notyp
+				ELSE
+					IF f # p.typ.form THEN
+						IF f IN intSet THEN Convert(x, p.typ)
+						ELSE err(111)
+						END
+					END ;
+					p := NewOp(Nassign, fctno, p, x);
+					p.typ := DevCPT.notyp
+				END
+		| inclfn, exclfn: (*INCL, EXCL*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN intSet THEN
+					IF f = Int64 THEN Convert(x, DevCPT.int32typ) END;
+					IF (x.class = Nconst) & ((0 > x.conval.intval) OR (x.conval.intval > DevCPM.MaxSet)) THEN err(202)
+					END ;
+					p := NewOp(Nassign, fctno, p, x)
+				ELSE err(111)
+				END ;
+				p.typ := DevCPT.notyp
+		| lenfn: (*LEN*)
+				IF ~(f IN intSet) OR (x.class # Nconst) THEN err(69)
+				ELSE
+					IF f = Int64 THEN Convert(x, DevCPT.int32typ) END;
+					L := SHORT(x.conval.intval); typ := p.typ;
+					WHILE (L > 0) & (typ.comp IN {DynArr, Array}) DO typ := typ.BaseTyp; DEC(L) END ;
+					IF (L # 0) OR ~(typ.comp IN {DynArr, Array}) THEN err(132)
+					ELSE x.obj := NIL;
+						IF typ.comp = DynArr THEN
+							WHILE p.class = Nindex DO
+								p := p.left; INC(x.conval.intval) (* possible side effect ignored *)
+							END;
+							p := NewOp(Ndop, len, p, x); p.typ := DevCPT.int32typ
+						ELSE p := x; p.conval.intval := typ.n; p.typ := DevCPT.int32typ
+						END
+					END
+				END
+		| copyfn: (*COPY*)
+				IF NotVar(x) THEN err(112)
+				ELSIF x.readonly THEN err(76)
+				ELSE
+					CheckString(p, x.typ, 111); t := x; x := p; p := t;
+					IF (x.class = Nconst) & (x.typ.form IN {String8, String16}) THEN AssignString(p, x)
+					ELSE p := NewOp(Nassign, copyfn, p, x)
+					END
+				END ;
+				p.typ := DevCPT.notyp; MarkAsUsed(x)
+		| ashfn: (*ASH*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN intSet THEN
+					IF (x.class = Nconst) & ((x.conval.intval > 64) OR (x.conval.intval < -64)) THEN err(208)
+					ELSIF (p.class = Nconst) & (x.class = Nconst) THEN
+						n := x.conval.intval;
+						IF n > 0 THEN
+							WHILE n > 0 DO MulConst(p.conval, two, p.conval, p.typ); DEC(n) END
+						ELSE
+							WHILE n < 0 DO DivModConst(p.conval, two, TRUE, p.typ); INC(n) END
+						END;
+						p.obj := NIL
+					ELSE
+						IF f = Int64 THEN Convert(x, DevCPT.int32typ) END;
+						typ := p.typ; p := NewOp(Ndop, ash, p, x); p.typ := typ
+					END
+				ELSE err(111)
+				END
+		| minfn: (*MIN*)
+				IF p.class # Ntype THEN Op(min, p, x) ELSE err(64) END
+		| maxfn: (*MAX*)
+				IF p.class # Ntype THEN Op(max, p, x) ELSE err(64) END
+		| newfn: (*NEW(p, x...)*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF p.typ.comp = DynArr THEN
+					IF f IN intSet THEN
+						IF f = Int64 THEN Convert(x, DevCPT.int32typ) END;
+						IF (x.class = Nconst) & (x.conval.intval <= 0)
+							& (~(DevCPM.java IN DevCPM.options) OR (x.conval.intval < 0))THEN err(63) END
+					ELSE err(111)
+					END ;
+					p.right := x; p.typ := p.typ.BaseTyp
+				ELSIF (p.left # NIL) & (p.left.typ.form = Pointer) THEN
+					typ := p.left.typ;
+					WHILE (typ # DevCPT.undftyp) & (typ.BaseTyp # NIL) DO typ := typ.BaseTyp END;
+					IF typ.sysflag = interface THEN
+						typ := x.typ;
+						WHILE (typ # DevCPT.undftyp) & (typ.BaseTyp # NIL) DO typ := typ.BaseTyp END;
+						IF (f = Pointer) & (typ.sysflag = interface) THEN
+							p.right := x
+						ELSE err(169)
+						END
+					ELSE err(64)
+					END
+				ELSE err(111)
+				END
+		| thisrecfn, (*THISRECORD*)
+		  thisarrfn: (*THISARRAY*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN {Int8, Int16, Int32} THEN
+					IF f < Int32 THEN Convert(x, DevCPT.int32typ) END;
+					p := NewOp(Ndop, fctno, p, x); p.typ := DevCPT.undftyp
+				ELSE err(111)
+				END
+		| lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF ~(f IN intSet) THEN err(111)
+				ELSE
+					IF fctno = lshfn THEN p := NewOp(Ndop, lsh, p, x) ELSE p := NewOp(Ndop, rot, p, x) END ;
+					p.typ := p.left.typ
+				END
+		| getfn, putfn, getrfn, putrfn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.GETREG, SYSTEM.PUTREG*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN {Undef..Set, NilTyp, Pointer, ProcTyp, Char16, Int64} THEN
+					IF (fctno = getfn) OR (fctno = getrfn) THEN
+						IF NotVar(x) THEN err(112) END ;
+						t := x; x := p; p := t
+					END ;
+					p := NewOp(Nassign, fctno, p, x)
+				ELSE err(111)
+				END ;
+				p.typ := DevCPT.notyp
+		| bitfn: (*SYSTEM.BIT*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF f IN intSet THEN
+					p := NewOp(Ndop, bit, p, x)
+				ELSE err(111)
+				END ;
+				p.typ := DevCPT.booltyp
+		| valfn: (*SYSTEM.VAL*)	(* type is changed without considering the byte ordering on the target machine *)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF x.typ.comp = DynArr THEN
+					IF x.typ.untagged & ((p.typ.comp # DynArr) OR p.typ.untagged) THEN	(* ok *)
+					ELSIF (p.typ.comp = DynArr) & (x.typ.n = p.typ.n) THEN
+						typ := x.typ;
+						WHILE typ.comp = DynArr DO typ := typ.BaseTyp END;
+						tp1 := p.typ;
+						WHILE tp1.comp = DynArr DO tp1 := tp1.BaseTyp END;
+						IF typ.size # tp1.size THEN err(115) END
+					ELSE err(115)
+					END
+				ELSIF p.typ.comp = DynArr THEN err(115)
+				ELSIF (x.class = Nconst) & (f = String8) & (p.typ.form = Int32) & (x.conval.intval2 <= 5) THEN
+					i := 0; n := 0;
+					WHILE i < x.conval.intval2 - 1 DO n := 256 * n + ORD(x.conval.ext[i]); INC(i) END;
+					x := NewIntConst(n)
+				ELSIF (f IN {Undef, NoTyp, NilTyp}) OR (f IN {String8, String16}) & ~(DevCPM.java IN DevCPM.options) THEN err(111)
+				END ;
+				IF (x.class = Nconst) & (x.typ = p.typ) THEN	(* ok *)
+				ELSIF (x.class >= Nconst) OR ((f IN realSet) # (p.typ.form IN realSet))
+						OR (DevCPM.options * {DevCPM.java, DevCPM.allSysVal} # {}) THEN
+					t := DevCPT.NewNode(Nmop); t.subcl := val; t.left := x; x := t
+				ELSE x.readonly := FALSE
+				END ;
+				x.typ := p.typ; p := x
+		| movefn: (*SYSTEM.MOVE*)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF (x.class = Nconst) & (f IN {Int8, Int16}) THEN Convert(x, DevCPT.int32typ)
+				ELSIF ~(f IN {Int32, Pointer}) THEN err(111); x.typ := DevCPT.int32typ
+				END ;
+				p.link := x
+		| assertfn: (*ASSERT*)
+				IF (f IN intSet - {Int64}) & (x.class = Nconst) THEN
+					IF (DevCPM.MinHaltNr <= x.conval.intval) & (x.conval.intval <= DevCPM.MaxHaltNr) THEN
+						BindNodes(Ntrap, DevCPT.notyp, x, x);
+						Construct(Nif, p, x); Construct(Nifelse, p, NIL); OptIf(p);
+					ELSE err(218)
+					END
+				ELSIF
+					(DevCPM.java IN DevCPM.options) & ((x.class = Ntype) OR (x.class = Nvar)) & (x.typ.form = Pointer)
+				THEN
+					BindNodes(Ntrap, DevCPT.notyp, x, x);
+					Construct(Nif, p, x); Construct(Nifelse, p, NIL); OptIf(p);
+				ELSE err(69)
+				END;
+				IF p = NIL THEN	(* ASSERT(TRUE) *)
+				ELSIF p.class = Ntrap THEN err(99)
+				ELSE p.subcl := assertfn
+				END
+		| queryfn: (* COM.QUERY *)
+				IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+				ELSIF x.typ # DevCPT.guidtyp THEN err(111); x.typ := DevCPT.guidtyp
+				END;
+				p.link := x
+		ELSE err(64)
+		END ;
+		par0 := p
+	END StPar1;
+
+	PROCEDURE StParN*(VAR par0: DevCPT.Node; x: DevCPT.Node; fctno, n: SHORTINT);
+	(* x: n+1-th param of standard proc *)
+		VAR node: DevCPT.Node; f: SHORTINT; p: DevCPT.Node; typ: DevCPT.Struct;
+	BEGIN p := par0; f := x.typ.form;
+		IF fctno = newfn THEN (*NEW(p, ..., x...*)
+			IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+			ELSIF p.typ.comp # DynArr THEN err(64)
+			ELSIF f IN intSet THEN
+				IF f = Int64 THEN Convert(x, DevCPT.int32typ) END;
+				IF (x.class = Nconst) & (x.conval.intval <= 0) THEN err(63) END;
+				node := p.right; WHILE node.link # NIL DO node := node.link END;
+				node.link := x; p.typ := p.typ.BaseTyp
+			ELSE err(111)
+			END
+		ELSIF (fctno = movefn) & (n = 2) THEN (*SYSTEM.MOVE*)
+			IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+			ELSIF f IN intSet THEN
+				node := DevCPT.NewNode(Nassign); node.subcl := movefn; node.right := p;
+				node.left := p.link; p.link := x; p := node
+			ELSE err(111)
+			END ;
+			p.typ := DevCPT.notyp
+		ELSIF (fctno = queryfn) & (n = 2) THEN (* COM.QUERY *)
+			IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+			ELSIF (x.class < Nconst) & (f = Pointer) & (x.typ.sysflag = interface) THEN
+				IF ~DevCPT.Extends(p.typ, x.typ) THEN err(164) END;
+				IF x.readonly THEN err(76) END;
+				CheckNewParamPair(x, p.link);
+				MarkAsUsed(x);
+				node := DevCPT.NewNode(Ndop); node.subcl := queryfn;
+				node.left := p; node.right := p.link; p.link := NIL; node.right.link := x; p := node
+			ELSE err(111)
+			END;
+			p.typ := DevCPT.booltyp
+		ELSE err(64)
+		END ;
+		par0 := p
+	END StParN;
+
+	PROCEDURE StFct*(VAR par0: DevCPT.Node; fctno: BYTE; parno: SHORTINT);
+		VAR dim: SHORTINT; x, p: DevCPT.Node;
+	BEGIN p := par0;
+		IF fctno <= ashfn THEN
+			IF (fctno = newfn) & (p.typ # DevCPT.notyp) THEN
+				IF p.typ.comp = DynArr THEN err(65) END ;
+				p.typ := DevCPT.notyp
+			ELSIF (fctno = minfn) OR (fctno = maxfn) THEN
+				IF (parno < 1) OR (parno = 1) & (p.hint # 1) THEN err(65) END;
+				p.hint := 0
+			ELSIF fctno <= sizefn THEN (* 1 param *)
+				IF parno < 1 THEN err(65) END
+			ELSE (* more than 1 param *)
+				IF ((fctno = incfn) OR (fctno = decfn)) & (parno = 1) THEN (*INC, DEC*)
+					BindNodes(Nassign, DevCPT.notyp, p, NewIntConst(1)); p.subcl := fctno; p.right.typ := p.left.typ
+				ELSIF (fctno = lenfn) & (parno = 1) THEN (*LEN*)
+					IF p.typ.form IN {String8, String16} THEN
+						IF p.class = Nconst THEN p := NewIntConst(p.conval.intval2 - 1)
+						ELSIF (p.class = Ndop) & (p.subcl = plus) THEN	(* propagate to leaf nodes *)
+							StFct(p.left, lenfn, 1); StFct(p.right, lenfn, 1); p.typ := DevCPT.int32typ
+						ELSE
+							WHILE (p.class = Nmop) & (p.subcl = conv) DO p := p.left END;
+							IF DevCPM.errors = 0 THEN ASSERT(p.class = Nderef) END;
+							BindNodes(Ndop, DevCPT.int32typ, p, NewIntConst(0)); p.subcl := len
+						END
+					ELSIF p.typ.comp = DynArr THEN dim := 0;
+						WHILE p.class = Nindex DO p := p.left; INC(dim) END ;	(* possible side effect ignored *)
+						BindNodes(Ndop, DevCPT.int32typ, p, NewIntConst(dim)); p.subcl := len
+					ELSE
+						p := NewIntConst(p.typ.n)
+					END
+				ELSIF parno < 2 THEN err(65)
+				END
+			END
+		ELSIF fctno = assertfn THEN
+			IF parno = 1 THEN x := NIL;
+				BindNodes(Ntrap, DevCPT.notyp, x, NewIntConst(AssertTrap));
+				Construct(Nif, p, x); Construct(Nifelse, p, NIL); OptIf(p);
+				IF p = NIL THEN	(* ASSERT(TRUE) *)
+				ELSIF p.class = Ntrap THEN err(99)
+				ELSE p.subcl := assertfn
+				END
+			ELSIF parno < 1 THEN err(65)
+			END
+		ELSIF (fctno >= lchrfn) & (fctno <= bytesfn) THEN
+			IF parno < 1 THEN err(65) END
+		ELSIF fctno < validfn THEN (*SYSTEM*)
+			IF (parno < 1) OR
+				(fctno > ccfn) & (parno < 2) OR
+				(fctno = movefn) & (parno < 3) THEN err(65)
+			END
+		ELSIF (fctno = thisrecfn) OR (fctno = thisarrfn) THEN
+			IF parno < 2 THEN err(65) END
+		ELSE (* COM *)
+			IF fctno = queryfn THEN
+				IF parno < 3 THEN err(65) END
+			ELSE
+				IF parno < 1 THEN err(65) END
+			END
+		END ;
+		par0 := p
+	END StFct;
+	
+	PROCEDURE DynArrParCheck (ftyp: DevCPT.Struct; VAR ap: DevCPT.Node; fvarpar: BOOLEAN);
+	(* check array compatibility *)
+		VAR atyp: DevCPT.Struct;
+	BEGIN (* ftyp.comp = DynArr *)
+		atyp := ap.typ;
+		IF atyp.form IN {Char8, Char16, String8, String16} THEN
+			IF ~fvarpar & (ftyp.BaseTyp.form = Char16) & (atyp.form = String8) THEN Convert(ap, DevCPT.string16typ)
+			ELSE CheckString(ap, ftyp, 67)
+			END
+		ELSE		
+			WHILE (ftyp.comp = DynArr) & ((atyp.comp IN {Array, DynArr}) OR (atyp.form IN {String8, String16})) DO
+				ftyp := ftyp.BaseTyp; atyp := atyp.BaseTyp
+			END;
+			IF ftyp.comp = DynArr THEN err(67)
+			ELSIF ~fvarpar & (ftyp.form = Pointer) & DevCPT.Extends(atyp, ftyp) THEN (* ok *)
+			ELSIF ~DevCPT.EqualType(ftyp, atyp) THEN err(66)
+			END
+		END
+	END DynArrParCheck;
+
+	PROCEDURE PrepCall*(VAR x: DevCPT.Node; VAR fpar: DevCPT.Object);
+	BEGIN
+		IF (x.obj # NIL) & (x.obj.mode IN {LProc, XProc, TProc, CProc}) THEN
+			fpar := x.obj.link;
+			IF x.obj.mode = TProc THEN
+				IF fpar.typ.form = Pointer THEN
+					IF x.left.class = Nderef THEN x.left := x.left.left (*undo DeRef*) ELSE err(71) END
+				END;
+				fpar := fpar.link
+			END
+		ELSIF (x.class # Ntype) & (x.typ # NIL) & (x.typ.form = ProcTyp) THEN
+			fpar := x.typ.link
+		ELSE err(121); fpar := NIL; x.typ := DevCPT.undftyp
+		END
+	END PrepCall;
+
+	PROCEDURE Param* (VAR ap: DevCPT.Node; fp: DevCPT.Object);	(* checks parameter compatibilty *)
+		VAR at, ft: DevCPT.Struct;
+	BEGIN
+		at := ap.typ; ft := fp.typ;
+		IF fp.ptyp # NIL THEN ft := fp.ptyp END;	(* get original formal type *)
+		IF ft.form # Undef THEN
+			IF (ap.class = Ntype) OR (ap.class = Nproc) & (ft.form # ProcTyp) THEN err(126) END;
+			IF fp.mode = VarPar THEN
+				IF ODD(fp.sysflag DIV nilBit) & (at = DevCPT.niltyp) THEN (* ok *)
+				ELSIF (ft.comp = Record) & ~ft.untagged & (ap.class = Ndop) & (ap.subcl = thisrecfn) THEN (* ok *)
+				ELSIF (ft.comp = DynArr) & ~ft.untagged & (ft.n = 0) & (ap.class = Ndop) & (ap.subcl = thisarrfn) THEN
+					(* ok *)
+				ELSE
+					IF fp.vis = inPar THEN
+						IF (ft = DevCPT.guidtyp) & (ap.class = Nconst) & (at.form = String8) THEN
+							StringToGuid(ap); at := ap.typ
+(*
+						ELSIF ((at.form IN charSet + {String8, String16}) OR (at = DevCPT.guidtyp))
+								& ((ap.class = Nderef) OR (ap.class = Nconst)) THEN (* ok *)
+						ELSIF NotVar(ap) THEN err(122)
+*)
+						END;
+						IF ~NotVar(ap) THEN CheckLeaf(ap, FALSE) END
+					ELSE
+						IF NotVar(ap) THEN err(122)
+						ELSIF ap.readonly THEN err(76)
+						ELSIF (ap.obj # NIL) & ODD(ap.obj.sysflag DIV newBit) & ~ODD(fp.sysflag DIV newBit) THEN		
+							err(167)
+						ELSE MarkAsUsed(ap); CheckLeaf(ap, FALSE)
+						END
+					END;
+					IF ft.comp = DynArr THEN DynArrParCheck(ft, ap, fp.vis # inPar)
+					ELSIF ODD(fp.sysflag DIV newBit) THEN
+						IF ~DevCPT.Extends(at, ft) THEN err(123) END
+					ELSIF (ft = DevCPT.sysptrtyp) & (at.form = Pointer) THEN (* ok *)
+					ELSIF (fp.vis # outPar) & (ft.comp = Record) & DevCPT.Extends(at, ft) THEN (* ok *)
+					ELSIF covarOut & (fp.vis = outPar) & (ft.form = Pointer) & DevCPT.Extends(ft, at) THEN (* ok *)
+					ELSIF fp.vis = inPar THEN CheckAssign(ft, ap)
+					ELSIF ~DevCPT.EqualType(ft, at) THEN err(123)
+					END
+				END
+			ELSIF ft.comp = DynArr THEN DynArrParCheck(ft, ap, FALSE)
+			ELSE CheckAssign(ft, ap)
+			END
+		END
+	END Param;
+	
+	PROCEDURE StaticLink*(dlev: BYTE; var: BOOLEAN);
+		VAR scope: DevCPT.Object;
+	BEGIN
+		scope := DevCPT.topScope;
+		WHILE dlev > 0 DO DEC(dlev);
+			INCL(scope.link.conval.setval, slNeeded);
+			scope := scope.left
+		END;
+		IF var THEN INCL(scope.link.conval.setval, imVar) END	(* !!! *)
+	END StaticLink;
+
+	PROCEDURE Call*(VAR x: DevCPT.Node; apar: DevCPT.Node; fp: DevCPT.Object);
+		VAR typ: DevCPT.Struct; p: DevCPT.Node; lev: BYTE;
+	BEGIN
+		IF x.class = Nproc THEN typ := x.typ;
+			lev := x.obj.mnolev;
+			IF lev > 0 THEN StaticLink(SHORT(SHORT(DevCPT.topScope.mnolev-lev)), FALSE) END ;	(* !!! *)
+			IF x.obj.mode = IProc THEN err(121) END
+		ELSIF (x.class = Nfield) & (x.obj.mode = TProc) THEN typ := x.typ;
+			x.class := Nproc; p := x.left; x.left := NIL; p.link := apar; apar := p; fp := x.obj.link
+		ELSE typ := x.typ.BaseTyp
+		END ;
+		BindNodes(Ncall, typ, x, apar); x.obj := fp
+	END Call;
+
+	PROCEDURE Enter*(VAR procdec: DevCPT.Node; stat: DevCPT.Node; proc: DevCPT.Object);
+		VAR x: DevCPT.Node;
+	BEGIN
+		x := DevCPT.NewNode(Nenter); x.typ := DevCPT.notyp; x.obj := proc;
+		x.left := procdec; x.right := stat; procdec := x
+	END Enter;
+	
+	PROCEDURE Return*(VAR x: DevCPT.Node; proc: DevCPT.Object);
+		VAR node: DevCPT.Node;
+	BEGIN
+		IF proc = NIL THEN (* return from module *)
+			IF x # NIL THEN err(124) END
+		ELSE
+			IF x # NIL THEN CheckAssign(proc.typ, x)
+			ELSIF proc.typ # DevCPT.notyp THEN err(124)
+			END
+		END ;
+		node := DevCPT.NewNode(Nreturn); node.typ := DevCPT.notyp; node.obj := proc; node.left := x; x := node
+	END Return;
+
+	PROCEDURE Assign*(VAR x: DevCPT.Node; y: DevCPT.Node);
+		VAR z: DevCPT.Node;
+	BEGIN
+		IF (x.class >= Nconst) OR (x.typ.form IN {String8, String16}) THEN err(56) END ;
+		CheckAssign(x.typ, y);
+		IF x.readonly THEN err(76)
+		ELSIF (x.obj # NIL) & ODD(x.obj.sysflag DIV newBit) THEN err(167)
+		END ;
+		MarkAsUsed(x);
+		IF (y.class = Nconst) & (y.typ.form IN {String8, String16}) & (x.typ.form # Pointer) THEN AssignString(x, y)
+		ELSE BindNodes(Nassign, DevCPT.notyp, x, y); x.subcl := assign
+		END
+	END Assign;
+	
+	PROCEDURE Inittd*(VAR inittd, last: DevCPT.Node; typ: DevCPT.Struct);
+		VAR node: DevCPT.Node;
+	BEGIN
+		node := DevCPT.NewNode(Ninittd); node.typ := typ;
+		node.conval := DevCPT.NewConst(); node.conval.intval := typ.txtpos;
+		IF inittd = NIL THEN inittd := node ELSE last.link := node END ;
+		last := node
+	END Inittd;
+	
+	(* handling of temporary variables for string operations *)
+	
+	PROCEDURE Overlap (left, right: DevCPT.Node): BOOLEAN;
+	BEGIN
+		IF right.class = Nconst THEN
+			RETURN FALSE
+		ELSIF (right.class = Ndop) & (right.subcl = plus) THEN
+			RETURN Overlap(left, right.left) OR Overlap(left, right.right)
+		ELSE
+			WHILE right.class = Nmop DO right := right.left END;
+			IF right.class = Nderef THEN right := right.left END;
+			IF left.typ.BaseTyp # right.typ.BaseTyp THEN RETURN FALSE END;
+			LOOP
+				IF left.class = Nvarpar THEN
+					WHILE (right.class = Nindex) OR (right.class = Nfield) OR (right.class = Nguard) DO
+						right := right.left
+					END;
+					RETURN (right.class # Nvar) OR (right.obj.mnolev < left.obj.mnolev)
+				ELSIF right.class = Nvarpar THEN
+					WHILE (left.class = Nindex) OR (left.class = Nfield) OR (left.class = Nguard) DO left := left.left END;
+					RETURN (left.class # Nvar) OR (left.obj.mnolev < right.obj.mnolev)
+				ELSIF (left.class = Nvar) & (right.class = Nvar) THEN
+					RETURN left.obj = right.obj
+				ELSIF (left.class = Nderef) & (right.class = Nderef) THEN
+					RETURN TRUE
+				ELSIF (left.class = Nindex) & (right.class = Nindex) THEN
+					IF (left.right.class = Nconst) & (right.right.class = Nconst)
+						& (left.right.conval.intval # right.right.conval.intval) THEN RETURN FALSE END;
+					left := left.left; right := right.left
+				ELSIF (left.class = Nfield) & (right.class = Nfield) THEN
+					IF left.obj # right.obj THEN RETURN FALSE END;
+					left := left.left; right := right.left;
+					WHILE left.class = Nguard DO left := left.left END;
+					WHILE right.class = Nguard DO right := right.left END
+				ELSE
+					RETURN FALSE
+				END
+			END
+		END
+	END Overlap;
+
+	PROCEDURE GetStaticLength (n: DevCPT.Node; OUT length: INTEGER);
+		VAR x: INTEGER;
+	BEGIN
+		IF n.class = Nconst THEN
+			length := n.conval.intval2 - 1
+		ELSIF (n.class = Ndop) & (n.subcl = plus) THEN
+			GetStaticLength(n.left, length); GetStaticLength(n.right, x);
+			IF (length >= 0) & (x >= 0) THEN length := length + x ELSE length := -1 END
+		ELSE
+			WHILE (n.class = Nmop) & (n.subcl = conv) DO n := n.left END;
+			IF (n.class = Nderef) & (n.subcl = 1) THEN n := n.left END;
+			IF n.typ.comp = Array THEN
+				length := n.typ.n - 1
+			ELSIF n.typ.comp = DynArr THEN
+				length := -1
+			ELSE	(* error case *)
+				length := 4
+			END
+		END
+	END GetStaticLength;
+
+	PROCEDURE GetMaxLength (n: DevCPT.Node; VAR stat, last: DevCPT.Node; OUT length: DevCPT.Node);
+		VAR x: DevCPT.Node; d: INTEGER; obj: DevCPT.Object;
+	BEGIN
+		IF n.class = Nconst THEN
+			length := NewIntConst(n.conval.intval2 - 1)
+		ELSIF (n.class = Ndop) & (n.subcl = plus) THEN
+			GetMaxLength(n.left, stat, last, length); GetMaxLength(n.right, stat, last, x);
+			IF (length.class = Nconst) & (x.class = Nconst) THEN ConstOp(plus, length, x)
+			ELSE BindNodes(Ndop, length.typ, length, x); length.subcl := plus
+			END
+		ELSE
+			WHILE (n.class = Nmop) & (n.subcl = conv) DO n := n.left END;
+			IF (n.class = Nderef) & (n.subcl = 1) THEN n := n.left END;
+			IF n.typ.comp = Array THEN
+				length := NewIntConst(n.typ.n - 1)
+			ELSIF n.typ.comp = DynArr THEN
+				d := 0;
+				WHILE n.class = Nindex DO n := n.left; INC(d) END;
+				ASSERT((n.class = Nderef) OR (n.class = Nvar) OR (n.class = Nvarpar));
+				IF (n.class = Nderef) & (n.left.class # Nvar) & (n.left.class # Nvarpar) THEN
+					GetTempVar("@tmp", n.left.typ, obj);
+					x := NewLeaf(obj); Assign(x, n.left); Link(stat, last, x);
+					n.left := NewLeaf(obj);	(* tree is manipulated here *)
+					n := NewLeaf(obj); DeRef(n)
+				END;
+				IF n.typ.untagged & (n.typ.comp = DynArr) & (n.typ.BaseTyp.form IN {Char8, Char16}) THEN
+					StrDeref(n);
+					BindNodes(Ndop, DevCPT.int32typ, n, NewIntConst(d)); n.subcl := len;
+					BindNodes(Ndop, DevCPT.int32typ, n, NewIntConst(1)); n.subcl := plus
+				ELSE
+					BindNodes(Ndop, DevCPT.int32typ, n, NewIntConst(d)); n.subcl := len;
+				END;
+				length := n
+			ELSE	(* error case *)
+				length := NewIntConst(4)
+			END
+		END
+	END GetMaxLength;
+
+	PROCEDURE CheckBuffering* (
+		VAR n: DevCPT.Node; left: DevCPT.Node; par: DevCPT.Object; VAR stat, last: DevCPT.Node
+	);
+		VAR length, x: DevCPT.Node; obj: DevCPT.Object; typ: DevCPT.Struct; len, xlen: INTEGER;
+	BEGIN
+		IF (n.typ.form IN {String8, String16}) & ~(DevCPM.java IN DevCPM.options)
+			& ((n.class = Ndop) & (n.subcl = plus) & ((left = NIL) OR Overlap(left, n.right))
+				OR (n.class = Nmop) & (n.subcl = conv) & (left = NIL)
+				OR (par # NIL) & (par.vis = inPar) & (par.typ.comp = Array)) THEN
+			IF (par # NIL) & (par.typ.comp = Array) THEN
+				len := par.typ.n - 1
+			ELSE
+				IF left # NIL THEN GetStaticLength(left, len) ELSE len := -1 END;
+				GetStaticLength(n, xlen);
+				IF (len = -1) OR (xlen # -1) & (xlen < len) THEN len := xlen END
+			END;
+			IF len # -1 THEN
+				typ := DevCPT.NewStr(Comp, Array); typ.n := len + 1; typ.BaseTyp := n.typ.BaseTyp;
+				GetTempVar("@str", typ, obj);
+				x := NewLeaf(obj); Assign(x, n); Link(stat, last, x);
+				n := NewLeaf(obj)
+			ELSE
+				IF left # NIL THEN GetMaxLength(left, stat, last, length)
+				ELSE GetMaxLength(n, stat, last, length)
+				END;
+				typ := DevCPT.NewStr(Pointer, Basic);
+				typ.BaseTyp := DevCPT.NewStr(Comp, DynArr); typ.BaseTyp.BaseTyp := n.typ.BaseTyp;
+				GetTempVar("@ptr", typ, obj);
+				x := NewLeaf(obj); Construct(Nassign, x, length); x.subcl := newfn; Link(stat, last, x);
+				x := NewLeaf(obj); DeRef(x); Assign(x, n); Link(stat, last, x);
+				n := NewLeaf(obj); DeRef(n)
+			END;
+			StrDeref(n)
+		ELSIF (n.typ.form = Pointer) & (n.typ.sysflag = interface) & (left = NIL)
+				& ((par # NIL) OR (n.class = Ncall))
+				& ((n.class # Nvar) OR (n.obj.mnolev <= 0)) THEN
+			GetTempVar("@cip", DevCPT.punktyp, obj);
+			x := NewLeaf(obj); Assign(x, n); Link(stat, last, x);
+			n := NewLeaf(obj)
+		END
+	END CheckBuffering;
+	
+	PROCEDURE CheckVarParBuffering* (VAR n: DevCPT.Node; VAR stat, last: DevCPT.Node);
+		VAR x: DevCPT.Node; obj: DevCPT.Object;
+	BEGIN
+		IF (n.class # Nvar) OR (n.obj.mnolev <= 0) THEN
+			GetTempVar("@ptr", n.typ, obj);
+			x := NewLeaf(obj); Assign(x, n); Link(stat, last, x);
+			n := NewLeaf(obj)
+		END
+	END CheckVarParBuffering;
+
+	
+	(* case optimization *)
+
+	PROCEDURE Evaluate (n: DevCPT.Node; VAR min, max, num, dist: INTEGER; VAR head: DevCPT.Node);
+		VAR a: INTEGER;
+	BEGIN
+		IF n.left # NIL THEN
+			a := MIN(INTEGER); Evaluate(n.left, min, a, num, dist, head);
+			IF n.conval.intval - a > dist THEN dist := n.conval.intval - a; head := n END
+		ELSIF n.conval.intval < min THEN
+			min := n.conval.intval
+		END;
+		IF n.right # NIL THEN
+			a := MAX(INTEGER); Evaluate(n.right, a, max, num, dist, head);
+			IF a - n.conval.intval2 > dist THEN dist := a - n.conval.intval2; head := n END
+		ELSIF n.conval.intval2 > max THEN
+			max := n.conval.intval2
+		END;
+		INC(num);
+		IF n.conval.intval < n.conval.intval2 THEN
+			INC(num);
+			IF n.conval.intval2 - n.conval.intval > dist THEN dist := n.conval.intval2 - n.conval.intval; head := n END
+		END
+	END Evaluate;
+	
+	PROCEDURE Rebuild (VAR root: DevCPT.Node; head: DevCPT.Node);
+		VAR n: DevCPT.Node;
+	BEGIN
+		IF root # head THEN
+			IF head.conval.intval2 < root.conval.intval THEN
+				Rebuild(root.left, head);
+				root.left := head.right; head.right := root; root := head
+			ELSE
+				Rebuild(root.right, head);
+				root.right := head.left; head.left := root; root := head
+			END
+		END
+	END Rebuild;
+	
+	PROCEDURE OptimizeCase* (VAR n: DevCPT.Node);
+		VAR min, max, num, dist, limit: INTEGER; head: DevCPT.Node;
+	BEGIN
+		IF n # NIL THEN
+			min := MAX(INTEGER); max := MIN(INTEGER); num := 0; dist := 0; head := n;
+			Evaluate(n, min, max, num, dist, head);
+			limit := 6 * num;
+			IF limit < 100 THEN limit := 100 END;
+			IF (num > 4) & ((min > MAX(INTEGER) - limit) OR (max < min + limit)) THEN
+				INCL(n.conval.setval, useTable)
+			ELSE
+				IF num > 4 THEN Rebuild(n, head) END;
+				INCL(n.conval.setval, useTree);
+				OptimizeCase(n.left);
+				OptimizeCase(n.right)
+			END
+		END
+	END OptimizeCase;
+(*	
+	PROCEDURE ShowTree (n: DevCPT.Node; opts: SET);
+	BEGIN
+		IF n # NIL THEN
+			IF opts = {} THEN opts := n.conval.setval END;
+			IF useTable IN opts THEN
+				IF n.left # NIL THEN ShowTree(n.left, opts); DevCPM.LogW(",") END;
+				DevCPM.LogWNum(n.conval.intval, 1);
+				IF n.conval.intval2 > n.conval.intval THEN DevCPM.LogW("-"); DevCPM.LogWNum(n.conval.intval2, 1)
+				END;
+				IF n.right # NIL THEN DevCPM.LogW(","); ShowTree(n.right, opts) END
+			ELSIF useTree IN opts THEN
+				DevCPM.LogW("("); ShowTree(n.left, {}); DevCPM.LogW("|"); DevCPM.LogWNum(n.conval.intval, 1);
+				IF n.conval.intval2 > n.conval.intval THEN DevCPM.LogW("-"); DevCPM.LogWNum(n.conval.intval2, 1)
+				END;
+				DevCPM.LogW("|"); ShowTree(n.right, {}); DevCPM.LogW(")")
+			ELSE
+				ShowTree(n.left, opts); DevCPM.LogW(" "); DevCPM.LogWNum(n.conval.intval, 1);
+				IF n.conval.intval2 > n.conval.intval THEN DevCPM.LogW("-"); DevCPM.LogWNum(n.conval.intval2, 1)
+				END;
+				DevCPM.LogW(" "); ShowTree(n.right, opts)
+			END
+		END
+	END ShowTree;
+*)
+BEGIN
+	zero := DevCPT.NewConst(); zero.intval := 0; zero.realval := 0;
+	one := DevCPT.NewConst(); one.intval := 1; one.realval := 0;
+	two := DevCPT.NewConst(); two.intval := 2; two.realval := 0;
+	dummy := DevCPT.NewConst();
+	quot := DevCPT.NewConst()
+END DevCPB.

BlackBox/Dev/Mod/CPC486.txt

@@ -0,0 +1,2333 @@
+MODULE DevCPC486;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPC486.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, DevCPM, DevCPT, DevCPE, DevCPL486;
+
+	CONST
+		initializeAll = FALSE;	(* initialize all local variable to zero *)
+		initializeOut = FALSE;	(* initialize all OUT parameters to zero *)
+		initializeDyn = FALSE;	(* initialize all open array OUT parameters to zero *)
+		initializeStr = FALSE;	(* initialize rest of string value parameters to zero *)
+		
+		FpuControlRegister = 33EH;	(* value for fpu control register initialization *)
+		
+		(* structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18; Guid = 23;
+		VString16to8 = 29; VString8 = 30; VString16 = 31;
+		intSet = {Int8..Int32, Int64}; realSet = {Real32, Real64};
+
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+
+		(* item base modes (=object modes) *)
+		Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; CProc = 9; IProc = 10; TProc = 13;
+
+		(* item modes for i386 *)
+		Ind = 14; Abs = 15; Stk = 16; Cond = 17; Reg = 18; DInd = 19;
+		
+		(* symbol values and ops *)
+		times = 1; slash = 2; div = 3; mod = 4;
+		and = 5; plus = 6; minus = 7; or = 8; eql = 9;
+		neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
+		in = 15; is = 16; ash = 17; msk = 18; len = 19;
+		conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
+		adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
+		getrfn = 26; putrfn = 27;
+		min = 34; max = 35; typ = 36;
+
+		(* procedure flags (conval.setval) *)
+		hasBody = 1; isRedef = 2; slNeeded = 3; imVar = 4; isGuarded = 30; isCallback = 31;
+
+		(* attribute flags (attr.adr, struct.attribute, proc.conval.setval) *)
+		newAttr = 16; absAttr = 17; limAttr = 18; empAttr = 19; extAttr = 20;
+		
+		false = 0; true = 1; nil = 0;
+
+		(* registers *)
+		AX = 0; CX = 1; DX = 2; BX = 3; SP = 4; BP = 5; SI = 6; DI = 7; AH = 4; CH = 5; DH = 6; BH = 7;
+		stk = 31; mem = 30; con = 29; float = 28; high = 27; short = 26; deref = 25; wreg = {AX, BX, CX, DX, SI, DI};
+	
+		(* GenShiftOp *)
+		ROL = 0; ROR = 8H; SHL = 20H; SHR = 28H; SAR = 38H;
+
+		(* GenBitOp *)
+		BT = 20H; BTS = 28H; BTR = 30H;
+		
+		(* GenFDOp *)
+		FADD = 0; FMUL = 8H; FCOM = 10H; FCOMP = 18H; FSUB = 20H; FSUBR = 28H; FDIV = 30H; FDIVR = 38H; 
+		
+		(* GenFMOp *)
+		FABS = 1E1H; FCHS = 1E0H; FTST = 1E4H; FSTSW = 7E0H; FUCOM = 2E9H;
+
+		(* GenCode *)
+		SAHF = 9EH; WAIT = 9BH;
+
+		(* condition codes *)
+		ccB = 2; ccAE = 3; ccBE = 6; ccA = 7; (* unsigned *)
+		ccL = 12; ccGE = 13; ccLE = 14; ccG = 15; (* signed *)
+		ccE = 4; ccNE = 5; ccS = 8; ccNS = 9; ccO = 0; ccNO = 1;
+		ccAlways = -1; ccNever = -2; ccCall = -3;
+
+		(* sysflag *)
+		untagged = 1; callback = 2; noAlign = 3; union = 7;
+		interface = 10; ccall = -10; guarded = 10; noframe = 16;
+		nilBit = 1; enumBits = 8; new = 1; iid = 2;
+		stackArray = 120;
+		
+		(* system trap numbers *)
+		withTrap = -1; caseTrap = -2; funcTrap = -3; typTrap = -4;
+		recTrap = -5; ranTrap = -6; inxTrap = -7; copyTrap = -8;
+		
+		(* module visibility of objects *)
+		internal = 0; external = 1; externalR = 2; inPar = 3; outPar = 4;
+
+		(* pointer init limits *)
+		MaxPtrs = 10; MaxPush = 4;
+		
+		Tag0Offset = 12;
+		Mth0Offset = -4;
+		ArrDOffs = 8;
+		numPreIntProc = 2;
+		
+		stackAllocLimit = 2048;
+
+		
+	VAR
+		imLevel*: ARRAY 64 OF BYTE;
+		intHandler*: DevCPT.Object;
+		inxchk, ovflchk, ranchk, typchk, ptrinit, hints: BOOLEAN;
+		WReg, BReg, AllReg: SET; FReg: INTEGER;
+		ptrTab: ARRAY MaxPtrs OF INTEGER;
+		stkAllocLbl: DevCPL486.Label;
+		procedureUsesFpu: BOOLEAN;
+
+	
+	PROCEDURE Init* (opt: SET);
+		CONST chk = 0; achk = 1; hint = 29;
+	BEGIN
+		inxchk := chk IN opt; ovflchk := achk IN opt; ranchk := achk IN opt; typchk := chk IN opt; ptrinit := chk IN opt;
+		hints := hint IN opt;
+		stkAllocLbl := DevCPL486.NewLbl
+	END Init;
+
+	PROCEDURE Reversed (cond: BYTE): BYTE;	(* reversed condition *)
+	BEGIN
+		IF cond = lss THEN RETURN gtr
+		ELSIF cond = gtr THEN RETURN lss
+		ELSIF cond = leq THEN RETURN geq
+		ELSIF cond = geq THEN RETURN leq
+		ELSE RETURN cond
+		END
+	END Reversed;
+	
+	PROCEDURE Inverted (cc: INTEGER): INTEGER;	(* inverted sense of condition code *)
+	BEGIN
+		IF ODD(cc) THEN RETURN cc-1 ELSE RETURN cc+1 END
+	END Inverted;
+
+	PROCEDURE setCC* (VAR x: DevCPL486.Item; rel: BYTE; reversed, signed: BOOLEAN);
+	BEGIN
+		IF reversed THEN rel := Reversed(rel) END;
+		CASE rel OF
+		   false: x.offset := ccNever
+		| true: x.offset := ccAlways
+		| eql: x.offset := ccE
+		| neq: x.offset := ccNE
+		| lss: IF signed THEN x.offset := ccL ELSE x.offset := ccB END
+		| leq: IF signed THEN x.offset := ccLE ELSE x.offset := ccBE END
+		| gtr: IF signed THEN x.offset := ccG ELSE x.offset := ccA END
+		| geq: IF signed THEN x.offset := ccGE ELSE x.offset := ccAE END
+		END;
+		x.mode := Cond; x.form := Bool; x.reg := 0;
+		IF reversed THEN x.reg := 1 END;
+		IF signed THEN INC(x.reg, 2) END
+	END setCC;
+
+	PROCEDURE StackAlloc*;	(* pre: len = CX bytes; post: len = CX words *)
+	BEGIN
+		DevCPL486.GenJump(ccCall, stkAllocLbl, FALSE)
+	END StackAlloc;
+	
+	PROCEDURE^ CheckAv* (reg: INTEGER);
+
+	PROCEDURE AdjustStack (val: INTEGER);
+		VAR c, sp: DevCPL486.Item;
+	BEGIN
+		IF val < -stackAllocLimit THEN
+			CheckAv(CX);
+			DevCPL486.MakeConst(c, -val, Int32); DevCPL486.MakeReg(sp, CX, Int32); DevCPL486.GenMove(c, sp);
+			StackAlloc
+		ELSIF val # 0 THEN
+			DevCPL486.MakeConst(c, val, Int32); DevCPL486.MakeReg(sp, SP, Int32); DevCPL486.GenAdd(c, sp, FALSE)
+		END
+	END AdjustStack;
+	
+	PROCEDURE DecStack (form: INTEGER);
+	BEGIN
+		IF form IN {Real64, Int64} THEN AdjustStack(-8) ELSE AdjustStack(-4) END
+	END DecStack;
+	
+	PROCEDURE IncStack (form: INTEGER);
+	BEGIN
+		IF form IN {Real64, Int64} THEN AdjustStack(8) ELSE AdjustStack(4) END
+	END IncStack;
+	
+	(*-----------------register handling------------------*)
+	
+	PROCEDURE SetReg* (reg: SET);
+	BEGIN
+		AllReg := reg; WReg := reg; BReg := reg * {0..3} + SYSTEM.LSH(reg * {0..3}, 4); FReg := 8
+	END SetReg;
+	
+	PROCEDURE CheckReg*;
+		VAR reg: SET;
+	BEGIN
+		reg := AllReg - WReg;
+		IF reg # {} THEN
+			DevCPM.err(-777); (* register not released *)
+			IF AX IN reg THEN DevCPM.LogWStr(" AX") END;
+			IF BX IN reg THEN DevCPM.LogWStr(" BX") END;
+			IF CX IN reg THEN DevCPM.LogWStr(" CX") END;
+			IF DX IN reg THEN DevCPM.LogWStr(" DX") END;
+			IF SI IN reg THEN DevCPM.LogWStr(" SI") END;
+			IF DI IN reg THEN DevCPM.LogWStr(" DI") END;
+			WReg := AllReg; BReg := AllReg * {0..3} + SYSTEM.LSH(AllReg * {0..3}, 4)
+		END;
+		IF FReg < 8 THEN DevCPM.err(-778); FReg := 8	 (* float register not released *)
+		ELSIF FReg > 8 THEN DevCPM.err(-779); FReg := 8
+		END
+	END CheckReg;
+	
+	PROCEDURE CheckAv* (reg: INTEGER);
+	BEGIN
+		ASSERT(reg IN WReg)
+	END CheckAv; 
+	
+	PROCEDURE GetReg (VAR x: DevCPL486.Item; f: BYTE; hint, stop: SET);
+		VAR n: INTEGER; s, s1: SET;
+	BEGIN
+		CASE f OF
+		| Byte, Bool, Char8, Int8:
+			s := BReg * {0..3} - stop;
+			IF (high IN stop) OR (high IN hint) & (s - hint  # {}) THEN n := 0;
+				IF s = {} THEN DevCPM.err(215); WReg := wreg; BReg := {0..7}; s := {0..7} END;
+				IF s - hint # {} THEN s := s - hint END;
+				WHILE ~(n IN s) DO INC(n) END
+			ELSE
+				s := BReg - (stop * {0..3}) - SYSTEM.LSH(stop * {0..3}, 4); n := 0;
+				IF s = {} THEN DevCPM.err(215); WReg := wreg; BReg := {0..7}; s := {0..7} END;
+				s1 := s - (hint * {0..3}) - SYSTEM.LSH(hint * {0..3}, 4);
+				IF s1 # {} THEN s := s1 END;
+				WHILE ~(n IN s) & ~(n + 4 IN s) DO INC(n) END;
+				IF ~(n IN s) THEN n := n + 4 END
+			END;
+			EXCL(BReg, n); EXCL(WReg, n MOD 4)
+		| Int16, Int32, Set, String8, NilTyp, Pointer, ProcTyp, Comp, Char16, String16: 
+			s := WReg - stop;
+			IF high IN stop THEN s := s * {0..3} END;
+			IF s = {} THEN DevCPM.err(215); WReg := wreg; BReg := {0..7}; s := wreg END;
+			s1 := s - hint;
+			IF high IN hint THEN s1 := s1 * {0..3} END;
+			IF s1 # {} THEN s := s1 END;
+			IF 0 IN s THEN n := 0
+			ELSIF 2 IN s THEN n := 2
+			ELSIF 6 IN s THEN n := 6
+			ELSIF 7 IN s THEN n := 7
+			ELSIF 1 IN s THEN n := 1
+			ELSE n := 3
+			END;
+			EXCL(WReg, n);
+			IF n < 4 THEN EXCL(BReg, n); EXCL(BReg, n + 4) END
+		| Real32, Real64:
+			IF (FReg = 0) OR (float IN stop) THEN DevCPM.err(216); FReg := 99 END;
+			DEC(FReg); n := 0
+		END;
+		DevCPL486.MakeReg(x, n, f);
+	END GetReg;
+	
+	PROCEDURE FreeReg (n, f: INTEGER);
+	BEGIN
+		IF f <= Int8 THEN
+			INCL(BReg, n);
+			IF (n + 4) MOD 8 IN BReg THEN INCL(WReg, n MOD 4) END
+		ELSIF f IN realSet THEN
+			INC(FReg)
+		ELSIF n IN AllReg THEN
+			INCL(WReg, n);
+			IF n < 4 THEN INCL(BReg, n); INCL(BReg, n + 4) END
+		END
+	END FreeReg;
+	
+	PROCEDURE FreeWReg (n: INTEGER);
+	BEGIN
+		IF n IN AllReg THEN
+			INCL(WReg, n);
+			IF n < 4 THEN INCL(BReg, n); INCL(BReg, n + 4) END
+		END
+	END FreeWReg;
+	
+	PROCEDURE Free* (VAR x: DevCPL486.Item);
+	BEGIN
+		CASE x.mode OF
+		| Var, VarPar, Abs: IF x.scale # 0 THEN FreeWReg(x.index) END
+		| Ind: FreeWReg(x.reg);
+			IF x.scale # 0 THEN FreeWReg(x.index) END
+		| Reg: FreeReg(x.reg, x.form);
+			IF x.form = Int64 THEN FreeWReg(x.index) END
+		ELSE
+		END
+	END Free;
+	
+	PROCEDURE FreeHi (VAR x: DevCPL486.Item);	(* free hi byte of word reg *)
+	BEGIN
+		IF x.mode = Reg THEN
+			IF x.form = Int64 THEN FreeWReg(x.index)
+			ELSIF x.reg < 4 THEN INCL(BReg, x.reg + 4)
+			END
+		END
+	END FreeHi;
+
+	PROCEDURE Fits* (VAR x: DevCPL486.Item; stop: SET): BOOLEAN;	(* x.mode = Reg *)
+	BEGIN
+		IF (short IN stop) & (x.form <= Int8) THEN RETURN FALSE END;
+		IF x.form <= Int8 THEN RETURN ~(x.reg MOD 4 IN stop) & ((x.reg < 4) OR ~(high IN stop))
+		ELSIF x.form IN realSet THEN RETURN ~(float IN stop)
+		ELSIF x.form = Int64 THEN RETURN ~(x.reg IN stop) & ~(x.index IN stop)
+		ELSE RETURN ~(x.reg IN stop) & ((x.reg < 4) OR ~(high IN stop))
+		END
+	END Fits;
+	
+	PROCEDURE Pop* (VAR r: DevCPL486.Item; f: BYTE; hint, stop: SET);
+		VAR rh: DevCPL486.Item;
+	BEGIN
+		IF f = Int64 THEN
+			GetReg(r, Int32, hint, stop); DevCPL486.GenPop(r);
+			GetReg(rh, Int32, hint, stop); DevCPL486.GenPop(rh);
+			r.form := Int64; r.index := rh.reg
+		ELSE
+			IF f < Int16 THEN INCL(stop, high) END;
+			GetReg(r, f, hint, stop); DevCPL486.GenPop(r)
+		END
+	END Pop;
+	
+	PROCEDURE^ LoadLong (VAR x: DevCPL486.Item; hint, stop: SET);
+	
+	PROCEDURE Load* (VAR x: DevCPL486.Item; hint, stop: SET);	(* = Assert(x, hint, stop + {mem, stk}) *)
+		VAR r: DevCPL486.Item; f: BYTE;
+	BEGIN
+		f := x.typ.form;
+		IF x.mode = Con THEN
+			IF (short IN stop) & (x.form IN {Int8, Int16, Bool, Char8, Char16}) THEN f := Int32; x.form := Int32 END;
+			IF con IN stop THEN
+				IF f = Int64 THEN LoadLong(x, hint, stop)
+				ELSE
+					GetReg(r, f, hint, stop); DevCPL486.GenMove(x, r);
+					x.mode := Reg; x.reg := r.reg; x.form := f
+				END
+			END
+		ELSIF x.mode = Stk THEN
+			IF f IN realSet THEN
+				GetReg(r, f, hint, stop); DevCPL486.GenFLoad(x); IncStack(x.form)
+			ELSE
+				Pop(r, f, hint, stop)
+			END;
+			x.mode := Reg; x.reg := r.reg; x.index := r.index; x.form := f
+		ELSIF (short IN stop) & (x.form IN {Int8, Int16, Bool, Char8, Char16}) THEN
+			Free(x); GetReg(r, Int32, hint, stop); DevCPL486.GenExtMove(x, r);
+			x.mode := Reg; x.reg := r.reg; x.form := Int32
+		ELSIF (x.mode # Reg) OR ~Fits(x, stop) THEN
+			IF f = Int64 THEN LoadLong(x, hint, stop)
+			ELSE
+				Free(x); GetReg(r, f, hint, stop);
+				IF f IN realSet THEN DevCPL486.GenFLoad(x) ELSE DevCPL486.GenMove(x, r) END;
+				x.mode := Reg; x.reg := r.reg; x.form := f
+			END
+		END
+	END Load;
+	
+	PROCEDURE Push* (VAR x: DevCPL486.Item);
+		VAR y: DevCPL486.Item;
+	BEGIN
+		IF x.form IN realSet THEN
+			Load(x, {}, {}); DecStack(x.form);
+			Free(x); x.mode := Stk;
+			IF x.typ = DevCPT.intrealtyp THEN x.form := Int64 END;
+			DevCPL486.GenFStore(x, TRUE)
+		ELSIF x.form = Int64 THEN
+			Free(x); x.form := Int32; y := x;
+			IF x.mode = Reg THEN y.reg := x.index ELSE INC(y.offset, 4) END;
+			DevCPL486.GenPush(y); DevCPL486.GenPush(x);
+			x.mode := Stk; x.form := Int64
+		ELSE
+			IF x.form < Int16 THEN Load(x, {}, {high})
+			ELSIF x.form = Int16 THEN Load(x, {}, {})
+			END;
+			Free(x); DevCPL486.GenPush(x); x.mode := Stk
+		END
+	END Push;
+	
+	PROCEDURE Assert* (VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR r: DevCPL486.Item;
+	BEGIN
+		IF (short IN stop) & (x.form IN {Int8, Int16, Bool, Char8, Char16}) & (x.mode # Con) THEN
+			IF (wreg - stop = {}) & ~(stk IN stop) THEN Load(x, {}, {short}); Push(x)
+			ELSE Load(x, hint, stop);
+			END
+		ELSE
+			CASE x.mode OF
+			| Var, VarPar: IF ~(mem IN stop) THEN RETURN END
+			| Con: IF ~(con IN stop) THEN RETURN END
+			| Ind: IF ~(mem IN stop) & ~(x.reg IN stop) & ((x.scale = 0) OR ~(x.index IN stop)) THEN RETURN END
+			| Abs: IF ~(mem IN stop) & ((x.scale = 0) OR ~(x.index IN stop)) THEN RETURN END
+			| Stk: IF ~(stk IN stop) THEN RETURN END
+			| Reg: IF Fits(x, stop) THEN RETURN END
+			ELSE RETURN
+			END;
+			IF ((float IN stop) OR ~(x.typ.form IN realSet) & (wreg - stop = {})) & ~(stk IN stop) THEN Push(x)
+			ELSE Load(x, hint, stop)
+			END
+		END
+	END Assert;
+	
+	(*------------------------------------------------*)
+
+	PROCEDURE LoadR (VAR x: DevCPL486.Item);
+	BEGIN
+		IF x.mode # Reg THEN
+			Free(x); DevCPL486.GenFLoad(x);
+			IF x.mode = Stk THEN IncStack(x.form) END;
+			GetReg(x, Real32, {}, {})
+		END
+	END LoadR;
+
+	PROCEDURE PushR (VAR x: DevCPL486.Item);
+	BEGIN
+		IF x.mode # Reg THEN LoadR(x) END;
+		DecStack(x.form);
+		Free(x); x.mode := Stk; DevCPL486.GenFStore(x, TRUE)
+	END PushR;
+	
+	PROCEDURE LoadW (VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR r: DevCPL486.Item;
+	BEGIN
+		IF x.mode = Stk THEN
+			Pop(x, x.form, hint, stop)
+		ELSE
+			Free(x); GetReg(r, x.form, hint, stop);
+			DevCPL486.GenMove(x, r);
+			x.mode := Reg; x.reg := r.reg
+		END
+	END LoadW;
+
+	PROCEDURE LoadL (VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR r: DevCPL486.Item;
+	BEGIN
+		IF x.mode = Stk THEN
+			Pop(x, x.form, hint, stop);
+			IF (x.form < Int32) OR (x.form = Char16) THEN
+				r := x; x.form := Int32; DevCPL486.GenExtMove(r, x)
+			END
+		ELSE
+			Free(x);
+			IF (x.form < Int32) OR (x.form = Char16) THEN GetReg(r, Int32, hint, stop) ELSE GetReg(r, x.form, hint, stop) END;
+			IF x.mode = Con THEN x.form := r.form END;
+			IF x.form # r.form THEN DevCPL486.GenExtMove(x, r) ELSE DevCPL486.GenMove(x, r) END;
+			x.mode := Reg; x.reg := r.reg; x.form := r.form
+		END
+	END LoadL;
+	
+	PROCEDURE LoadLong (VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR r, rh, c: DevCPL486.Item; offs: INTEGER;
+	BEGIN
+		IF x.form = Int64 THEN
+			IF  x.mode = Stk THEN
+				Pop(x, x.form, hint, stop)
+			ELSIF x.mode = Reg THEN
+				FreeReg(x.reg, Int32); GetReg(r, Int32, hint, stop);
+				FreeReg(x.index, Int32); GetReg(rh, Int32, hint, stop);
+				x.form := Int32; DevCPL486.GenMove(x, r);
+				x.reg := x.index; DevCPL486.GenMove(x, rh);
+				x.reg := r.reg; x.index := rh.reg
+			ELSE
+				GetReg(rh, Int32, hint, stop + {AX});
+				Free(x);
+				GetReg(r, Int32, hint, stop); 
+				x.form := Int32; offs := x.offset;
+				IF x.mode = Con THEN x.offset := x.scale ELSE INC(x.offset, 4) END;
+				DevCPL486.GenMove(x, rh);
+				x.offset := offs;
+				DevCPL486.GenMove(x, r);
+				x.mode := Reg; x.reg := r.reg; x.index := rh.reg
+			END
+		ELSE
+			LoadL(x, hint, stop); GetReg(rh, Int32, hint, stop); DevCPL486.GenSignExt(x, rh);
+			x.index := rh.reg
+		END;
+		x.form := Int64
+	END LoadLong;
+	
+	(*------------------------------------------------*)
+	
+	PROCEDURE CopyReg* (VAR x, y: DevCPL486.Item; hint, stop: SET);
+	BEGIN
+		ASSERT(x.mode = Reg);
+		GetReg(y, x.form, hint, stop);
+		DevCPL486.GenMove(x, y)
+	END CopyReg;
+
+	PROCEDURE GetAdr* (VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR r: DevCPL486.Item;
+	BEGIN
+		IF x.mode = DInd THEN
+			x.mode := Ind
+		ELSIF (x.mode = Ind) & (x.offset = 0) & (x.scale = 0) & (x.reg IN wreg) THEN
+			x.mode := Reg
+		ELSE
+			Free(x); GetReg(r, Pointer, hint, stop);
+			IF x.mode = Con THEN DevCPL486.GenMove(x, r) ELSE DevCPL486.GenLoadAdr(x, r) END;
+			x.mode := Reg; x.reg := r.reg; x.form := Pointer
+		END;
+		x.form := Pointer; x.typ := DevCPT.anyptrtyp;
+		Assert(x, hint, stop)
+	END GetAdr;
+	
+	PROCEDURE PushAdr (VAR x: DevCPL486.Item; niltest: BOOLEAN);
+		VAR r, v: DevCPL486.Item;
+	BEGIN
+		IF (x.mode = Abs) & (x.scale = 0) THEN x.mode := Con; x.form := Pointer
+		ELSIF niltest THEN
+			GetAdr(x, {}, {mem, stk});
+			DevCPL486.MakeReg(r, AX, Int32);
+			v.mode := Ind; v.form := Int32; v.offset := 0; v.scale := 0; v.reg := x.reg;
+			DevCPL486.GenTest(r, v)
+		ELSIF x.mode = DInd THEN x.mode := Ind; x.form := Pointer
+		ELSE GetAdr(x, {}, {})
+		END;
+		Free(x); DevCPL486.GenPush(x)
+	END PushAdr;
+
+	PROCEDURE LevelBase (VAR a: DevCPL486.Item; lev: INTEGER; hint, stop: SET);
+		VAR n: BYTE;
+	BEGIN
+		a.mode := Ind; a.scale := 0; a.form := Int32; a.typ := DevCPT.int32typ;
+		IF lev = DevCPL486.level THEN a.reg := BP
+		ELSE
+			a.reg := BX; n := SHORT(SHORT(imLevel[DevCPL486.level] - imLevel[lev]));
+			WHILE n > 0 DO
+				a.offset := -4; LoadL(a, hint, stop); a.mode := Ind; DEC(n)
+			END
+		END
+	END LevelBase;
+	
+	PROCEDURE LenDesc (VAR x, len: DevCPL486.Item; typ: DevCPT.Struct); (* set len to LEN(x, -typ.n) *)
+	BEGIN
+		IF x.tmode = VarPar THEN
+			LevelBase(len, x.obj.mnolev, {}, {}); len.offset := x.obj.adr;
+		ELSE ASSERT((x.tmode = Ind) & (x.mode = Ind));
+			len := x; len.offset := ArrDOffs; len.scale := 0; len.form := Int32
+		END;
+		INC(len.offset, typ.n * 4 + 4);
+		IF typ.sysflag = stackArray THEN len.offset := -4 END
+	END LenDesc;
+	
+	PROCEDURE Tag* (VAR x, tag: DevCPL486.Item);
+		VAR typ: DevCPT.Struct;
+	BEGIN
+		typ := x.typ;
+		IF typ.form = Pointer THEN typ := typ.BaseTyp END;
+		IF (x.typ # DevCPT.sysptrtyp) & (typ.attribute = 0) & ~(DevCPM.oberon IN DevCPM.options) THEN	(* final type *)
+			DevCPL486.MakeConst(tag, 0, Pointer); tag.obj := DevCPE.TypeObj(typ)
+		ELSIF x.typ.form = Pointer THEN
+			ASSERT(x.mode = Reg);
+			tag.mode := Ind; tag.reg := x.reg; tag.offset := -4;
+			IF x.typ.sysflag = interface THEN tag.offset := 0 END
+		ELSIF x.tmode = VarPar THEN
+			LevelBase(tag, x.obj.mnolev, {}, {}); tag.offset := x.obj.adr + 4;
+			Free(tag)	(* ??? *)
+		ELSIF x.tmode = Ind THEN
+			ASSERT(x.mode = Ind);
+			tag := x; tag.offset := -4
+		ELSE
+			DevCPL486.MakeConst(tag, 0, Pointer); tag.obj := DevCPE.TypeObj(x.typ)
+		END;
+		tag.scale := 0; tag.form := Pointer; tag.typ := DevCPT.sysptrtyp
+	END Tag;
+	
+	PROCEDURE NumOfIntProc (typ: DevCPT.Struct): INTEGER;
+	BEGIN
+		WHILE (typ # NIL) & (typ.sysflag # interface) DO typ := typ.BaseTyp END;
+		IF typ # NIL THEN RETURN typ.n
+		ELSE RETURN 0
+		END
+	END NumOfIntProc;
+	
+	PROCEDURE ContainsIPtrs* (typ: DevCPT.Struct): BOOLEAN;
+		VAR fld: DevCPT.Object;
+	BEGIN
+		WHILE typ.comp IN {DynArr, Array} DO typ := typ.BaseTyp END;
+		IF (typ.form = Pointer) & (typ.sysflag = interface) THEN RETURN TRUE
+		ELSIF (typ.comp = Record) & (typ.sysflag # union) THEN
+			REPEAT
+				fld := typ.link;
+				WHILE (fld # NIL) & (fld.mode = Fld) DO
+					IF (fld.sysflag = interface) & (fld.name^ = DevCPM.HdUtPtrName) 
+						OR ContainsIPtrs(fld.typ) THEN RETURN TRUE END;
+					fld := fld.link
+				END;
+				typ := typ.BaseTyp
+			UNTIL typ = NIL
+		END;
+		RETURN FALSE
+	END ContainsIPtrs;
+	
+	PROCEDURE GuidFromString* (str: DevCPT.ConstExt; VAR x: DevCPL486.Item);
+		VAR cv: DevCPT.Const;
+	BEGIN
+		IF ~DevCPM.ValidGuid(str^) THEN DevCPM.err(165) END;
+		cv := DevCPT.NewConst();
+		cv.intval := DevCPM.ConstNotAlloc; cv.intval2 := 16; cv.ext := str;
+		DevCPL486.AllocConst(x, cv, Guid); x.typ := DevCPT.guidtyp
+	END GuidFromString;
+	
+	PROCEDURE IPAddRef* (VAR x: DevCPL486.Item; offset: INTEGER; nilTest: BOOLEAN);
+		VAR r, p, c: DevCPL486.Item; lbl: DevCPL486.Label;
+	BEGIN
+		ASSERT(x.mode IN {Reg, Ind, Abs});
+		ASSERT({AX, CX, DX} - WReg = {});
+		IF hints THEN
+			IF nilTest THEN DevCPM.err(-701) ELSE DevCPM.err(-700) END
+		END;
+		IF x.mode # Reg THEN 
+			GetReg(r, Pointer, {}, {});
+			p := x; INC(p.offset, offset); p.form := Pointer; DevCPL486.GenMove(p, r);
+		ELSE r := x
+		END;
+		IF nilTest THEN
+			DevCPL486.MakeConst(c, 0, Pointer); DevCPL486.GenComp(c, r);
+			lbl := DevCPL486.NewLbl; DevCPL486.GenJump(ccE, lbl, TRUE)
+		END;
+		DevCPL486.GenPush(r); p := r;
+		IF x.mode # Reg THEN Free(r) END;
+		GetReg(r, Pointer, {}, {});
+		p.mode := Ind; p.offset := 0; p.scale := 0; p.form := Pointer; DevCPL486.GenMove(p, r);
+		p.offset := 4; p.reg := r.reg; Free(r); DevCPL486.GenCall(p);
+		IF nilTest THEN DevCPL486.SetLabel(lbl) END;
+	END IPAddRef;
+	
+	PROCEDURE IPRelease* (VAR x: DevCPL486.Item; offset: INTEGER; nilTest, nilSet: BOOLEAN);
+		VAR r, p, c: DevCPL486.Item; lbl: DevCPL486.Label;
+	BEGIN
+		ASSERT(x.mode IN {Ind, Abs});
+		ASSERT({AX, CX, DX} - WReg = {});
+		IF hints THEN
+			IF nilTest THEN DevCPM.err(-703) ELSE DevCPM.err(-702) END
+		END;
+		GetReg(r, Pointer, {}, {});
+		p := x; INC(p.offset, offset); p.form := Pointer; DevCPL486.GenMove(p, r);
+		DevCPL486.MakeConst(c, 0, Pointer);
+		IF nilTest THEN
+			DevCPL486.GenComp(c, r);
+			lbl := DevCPL486.NewLbl; DevCPL486.GenJump(ccE, lbl, TRUE)
+		END;
+		IF nilSet THEN DevCPL486.GenMove(c, p) END;
+		DevCPL486.GenPush(r);
+		p.mode := Ind; p.reg := r.reg; p.offset := 0; p.scale := 0; DevCPL486.GenMove(p, r);
+		p.offset := 8; Free(r); DevCPL486.GenCall(p);
+		IF nilTest THEN DevCPL486.SetLabel(lbl) END;
+	END IPRelease;
+	
+	PROCEDURE Prepare* (VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR n, i, lev: INTEGER; len, y: DevCPL486.Item; typ: DevCPT.Struct;
+	BEGIN
+		IF (x.mode IN {Var, VarPar, Ind, Abs}) & (x.scale # 0) THEN
+			DevCPL486.MakeReg(y, x.index, Int32); typ := x.typ;
+			WHILE typ.comp = DynArr DO (* complete dynamic array iterations *)
+				LenDesc(x, len, typ); DevCPL486.GenMul(len, y, FALSE); typ := typ.BaseTyp;
+				IF x.tmode = VarPar THEN Free(len) END;	(* ??? *)
+			END;
+			n := x.scale; i := 0;
+			WHILE (n MOD 2 = 0) & (i < 3) DO n := n DIV 2; INC(i) END;
+			IF n > 1 THEN (* assure scale factor in {1, 2, 4, 8} *)
+				DevCPL486.MakeConst(len, n, Int32); DevCPL486.GenMul(len, y, FALSE); x.scale := x.scale DIV n 
+			END
+		END;
+		CASE x.mode OF
+		   Var, VarPar:
+				lev := x.obj.mnolev;
+				IF lev <= 0 THEN
+					x.mode := Abs
+				ELSE
+					LevelBase(y, lev, hint, stop);
+					IF x.mode # VarPar THEN
+						x.mode := Ind
+					ELSIF (deref IN hint) & (x.offset = 0) & (x.scale = 0) THEN
+						x.mode := DInd; x.offset := x.obj.adr
+					ELSE
+						y.offset := x.obj.adr; Load(y, hint, stop); x.mode := Ind
+					END;
+					x.reg := y.reg
+				END;
+				x.form := x.typ.form
+		| LProc, XProc, IProc:
+				x.mode := Con; x.offset := 0; x.form := ProcTyp
+		| TProc, CProc:
+				x.form := ProcTyp
+		| Ind, Abs, Stk, Reg:
+				IF ~(x.typ.form IN {String8, String16}) THEN x.form := x.typ.form END
+		END
+	END Prepare;
+	
+	PROCEDURE Field* (VAR x: DevCPL486.Item; field: DevCPT.Object);
+	BEGIN
+		INC(x.offset, field.adr); x.tmode := Con
+	END Field;
+	
+	PROCEDURE DeRef* (VAR x: DevCPL486.Item);
+		VAR btyp: DevCPT.Struct;
+	BEGIN
+		x.mode := Ind; x.tmode := Ind; x.scale := 0;
+		btyp := x.typ.BaseTyp;
+		IF btyp.untagged OR (btyp.sysflag = stackArray) THEN x.offset := 0
+		ELSIF btyp.comp = DynArr THEN x.offset := ArrDOffs + btyp.size
+		ELSIF btyp.comp = Array THEN x.offset := ArrDOffs + 4 
+		ELSE x.offset := 0
+		END
+	END DeRef;
+	
+	PROCEDURE Index* (VAR x, y: DevCPL486.Item; hint, stop: SET);	(* x[y] *)
+		VAR idx, len: DevCPL486.Item; btyp: DevCPT.Struct; elsize: INTEGER;
+	BEGIN
+		btyp := x.typ.BaseTyp; elsize := btyp.size;
+		IF elsize = 0 THEN Free(y)
+		ELSIF x.typ.comp = Array THEN
+			len.mode := Con; len.obj := NIL;
+			IF y.mode = Con THEN
+				INC(x.offset, y.offset * elsize)
+			ELSE
+				Load(y, hint, stop + {mem, stk, short});
+				IF inxchk THEN
+					DevCPL486.MakeConst(len, x.typ.n, Int32);
+					DevCPL486.GenComp(len, y); DevCPL486.GenAssert(ccB, inxTrap)
+				END;
+				IF x.scale = 0 THEN x.index := y.reg
+				ELSE
+					IF x.scale MOD elsize # 0 THEN
+						IF (x.scale MOD 4 = 0) & (elsize MOD 4 = 0) THEN elsize := 4
+						ELSIF (x.scale MOD 2 = 0) & (elsize MOD 2 = 0) THEN elsize := 2
+						ELSE elsize := 1
+						END;
+						DevCPL486.MakeConst(len, btyp.size DIV elsize, Int32);
+						DevCPL486.GenMul(len, y, FALSE)
+					END;
+					DevCPL486.MakeConst(len, x.scale DIV elsize, Int32);
+					DevCPL486.MakeReg(idx, x.index, Int32);
+					DevCPL486.GenMul(len, idx, FALSE); DevCPL486.GenAdd(y, idx, FALSE); Free(y)
+				END;
+				x.scale := elsize
+			END;
+			x.tmode := Con
+		ELSE (* x.typ.comp = DynArr *)
+			IF (btyp.comp = DynArr) & x.typ.untagged THEN DevCPM.err(137) END;
+			LenDesc(x, len, x.typ);
+			IF x.scale # 0 THEN
+				DevCPL486.MakeReg(idx, x.index, Int32); 
+				DevCPL486.GenMul(len, idx, FALSE)
+			END;
+			IF (y.mode # Con) OR (y.offset # 0) THEN
+				IF (y.mode # Con) OR (btyp.comp = DynArr) & (x.scale = 0) THEN
+					Load(y, hint, stop + {mem, stk, con, short})
+				ELSE y.form := Int32
+				END;
+				IF inxchk & ~x.typ.untagged THEN
+					DevCPL486.GenComp(y, len); DevCPL486.GenAssert(ccA, inxTrap)
+				END;
+				IF (y.mode = Con) & (btyp.comp # DynArr) THEN
+					INC(x.offset, y.offset * elsize)
+				ELSIF x.scale = 0 THEN
+					WHILE btyp.comp = DynArr DO btyp := btyp.BaseTyp END;
+					x.index := y.reg; x.scale := btyp.size
+				ELSE
+					DevCPL486.GenAdd(y, idx, FALSE); Free(y)
+				END
+			END;
+			IF x.tmode = VarPar THEN Free(len) END;	(* ??? *)
+			IF x.typ.BaseTyp.comp # DynArr THEN x.tmode := Con END
+		END
+	END Index;
+	
+	PROCEDURE TypTest* (VAR x: DevCPL486.Item; testtyp: DevCPT.Struct; guard, equal: BOOLEAN);
+		VAR tag, tdes, r: DevCPL486.Item; typ: DevCPT.Struct;
+	BEGIN
+		typ := x.typ;
+		IF typ.form = Pointer THEN testtyp := testtyp.BaseTyp; typ := typ.BaseTyp END;
+		IF ~guard & typ.untagged THEN DevCPM.err(139)
+		ELSIF ~guard OR typchk & ~typ.untagged THEN
+			IF testtyp.untagged THEN DevCPM.err(139)
+			ELSE
+				IF (x.typ.form = Pointer) & (x.mode # Reg) THEN
+					GetReg(r, Pointer, {}, {}); DevCPL486.GenMove(x, r); Free(r); r.typ := x.typ; Tag(r, tag)
+				ELSE Tag(x, tag)
+				END;
+				IF ~guard THEN Free(x) END;
+				IF ~equal THEN
+					GetReg(r, Pointer, {}, {}); DevCPL486.GenMove(tag, r); Free(r);
+					tag.mode := Ind; tag.reg := r.reg; tag.scale := 0; tag.offset := Tag0Offset + 4 * testtyp.extlev
+				END;
+				DevCPL486.MakeConst(tdes, 0, Pointer); tdes.obj := DevCPE.TypeObj(testtyp);
+				DevCPL486.GenComp(tdes, tag);
+				IF guard THEN
+					IF equal THEN DevCPL486.GenAssert(ccE, recTrap) ELSE DevCPL486.GenAssert(ccE, typTrap) END
+				ELSE setCC(x, eql, FALSE, FALSE)
+				END
+			END
+		END
+	END TypTest;
+	
+	PROCEDURE ShortTypTest* (VAR x: DevCPL486.Item; testtyp: DevCPT.Struct);
+		VAR tag, tdes: DevCPL486.Item;
+	BEGIN
+		(* tag must be in AX ! *)
+		IF testtyp.form = Pointer THEN testtyp := testtyp.BaseTyp END;
+		IF testtyp.untagged THEN DevCPM.err(139)
+		ELSE
+			tag.mode := Ind; tag.reg := AX; tag.scale := 0; tag.offset := Tag0Offset + 4 * testtyp.extlev; tag.form := Pointer;
+			DevCPL486.MakeConst(tdes, 0, Pointer); tdes.obj := DevCPE.TypeObj(testtyp);
+			DevCPL486.GenComp(tdes, tag);
+			setCC(x, eql, FALSE, FALSE)
+		END
+	END ShortTypTest;
+
+	PROCEDURE Check (VAR x: DevCPL486.Item; min, max: INTEGER);
+		VAR c: DevCPL486.Item;
+	BEGIN
+		ASSERT((x.mode # Reg) OR (max > 255) OR (max = 31) OR (x.reg < 4));
+		IF ranchk & (x.mode # Con) THEN
+			DevCPL486.MakeConst(c, max, x.form); DevCPL486.GenComp(c, x);
+			IF min # 0 THEN
+				DevCPL486.GenAssert(ccLE, ranTrap);
+				c.offset := min; DevCPL486.GenComp(c, x);
+				DevCPL486.GenAssert(ccGE, ranTrap)
+			ELSIF max # 0 THEN
+				DevCPL486.GenAssert(ccBE, ranTrap)
+			ELSE
+				DevCPL486.GenAssert(ccNS, ranTrap)
+			END
+		END
+	END Check;
+
+	PROCEDURE Floor (VAR x: DevCPL486.Item; useSt1: BOOLEAN);
+		VAR c: DevCPL486.Item; local: DevCPL486.Label;
+	BEGIN
+		IF useSt1 THEN DevCPL486.GenFMOp(5D1H);	(* FST ST1 *)
+		ELSE DevCPL486.GenFMOp(1C0H);	(* FLD ST0 *)
+		END;
+		DevCPL486.GenFMOp(1FCH);	(* FRNDINT *)
+		DevCPL486.GenFMOp(0D1H);	(* FCOM *)
+		CheckAv(AX);
+		DevCPL486.GenFMOp(FSTSW);
+		DevCPL486.GenFMOp(5D9H);	(* FSTP ST1 *)
+		(* DevCPL486.GenCode(WAIT); *) DevCPL486.GenCode(SAHF);
+		local := DevCPL486.NewLbl; DevCPL486.GenJump(ccBE, local, TRUE);
+		DevCPL486.AllocConst(c, DevCPL486.one, Real32);
+		DevCPL486.GenFDOp(FSUB, c);
+		DevCPL486.SetLabel(local);
+	END Floor;
+	
+	PROCEDURE Entier(VAR x: DevCPL486.Item; typ: DevCPT.Struct; hint, stop: SET);
+	BEGIN
+		IF typ # DevCPT.intrealtyp THEN Floor(x, FALSE) END;
+		DevCPL486.GenFStore(x, TRUE);
+		IF (x.mode = Stk) & (stk IN stop) THEN Pop(x, x.form, hint, stop) END
+	END Entier;
+
+	PROCEDURE ConvMove (VAR x, y: DevCPL486.Item; sysval: BOOLEAN; hint, stop: SET);	(* x := y *)
+		(* scalar values only, y.mode # Con, all kinds of conversions, x.mode = Undef => convert y only *)
+		VAR f, m: BYTE; s: INTEGER; z: DevCPL486.Item;
+	BEGIN
+		f := x.form; m := x.mode; ASSERT(m IN {Undef, Reg, Abs, Ind, Stk});
+		IF y.form IN {Real32, Real64} THEN
+			IF f IN {Real32, Real64} THEN
+				IF m = Undef THEN
+					IF (y.form = Real64) & (f = Real32) THEN
+						IF y.mode # Reg THEN LoadR(y) END;
+						Free(y); DecStack(Real32); y.mode := Stk; y.form := Real32; DevCPL486.GenFStore(y, TRUE)
+					END
+				ELSE
+					IF y.mode # Reg THEN LoadR(y) END;
+					IF m = Stk THEN DecStack(f) END;
+					IF m # Reg THEN Free(y); DevCPL486.GenFStore(x, TRUE) END;
+				END
+			ELSE (* x not real *)
+				IF sysval THEN
+					IF y.mode = Reg THEN Free(y);
+						IF (m # Stk) & (m # Undef) & (m # Reg) & (f >= Int32) THEN
+							x.form := y.form; DevCPL486.GenFStore(x, TRUE); x.form := f
+						ELSE
+							ASSERT(y.form # Real64);
+							DecStack(y.form); y.mode := Stk; DevCPL486.GenFStore(y, TRUE); y.form := Int32;
+							IF m # Stk THEN
+								Pop(y, y.form, hint, stop);
+								IF f < Int16 THEN ASSERT(y.reg < 4) END;
+								y.form := f;
+								IF m # Undef THEN Free(y); DevCPL486.GenMove(y, x) END
+							END
+						END
+					ELSE (* y.mode # Reg *)
+						y.form := f;
+						IF m # Undef THEN LoadW(y, hint, stop); Free(y);
+							IF m = Stk THEN DevCPL486.GenPush(y) ELSE DevCPL486.GenMove(y, x) END
+						END
+					END
+				ELSE (* not sysval *)
+					IF y.mode # Reg THEN LoadR(y) END;
+					Free(y);
+					IF (m # Stk) & (m # Undef) & (m # Reg) & (f >= Int16) & (f # Char16) THEN
+						Entier(x, y.typ, hint, stop);
+					ELSE
+						DecStack(f); y.mode := Stk;
+						IF (f < Int16) OR (f = Char16) THEN y.form := Int32 ELSE y.form := f END;
+						IF m = Stk THEN Entier(y, y.typ, {}, {})
+						ELSIF m = Undef THEN Entier(y, y.typ, hint, stop)
+						ELSE Entier(y, y.typ, hint, stop + {stk})
+						END;
+						IF f = Int8 THEN Check(y, -128, 127); FreeHi(y)
+						ELSIF f = Char8 THEN Check(y, 0, 255); FreeHi(y)
+						ELSIF f = Char16 THEN Check(y, 0, 65536); FreeHi(y)
+						END;
+						y.form := f;
+						IF (m # Undef) & (m # Stk) THEN
+							IF f = Int64 THEN
+								Free(y); y.form := Int32; z := x; z.form := Int32; DevCPL486.GenMove(y, z);
+								IF z.mode = Reg THEN z.reg := z.index ELSE INC(z.offset, 4) END;
+								y.reg := y.index; DevCPL486.GenMove(y, z);
+							ELSE
+								Free(y); DevCPL486.GenMove(y, x);
+							END
+						END
+					END
+				END
+			END
+		ELSE (* y not real *)
+			IF sysval THEN
+				IF (y.form < Int16) & (f >= Int16) OR (y.form IN {Int16, Char16}) & (f >= Int32) & (f < Char16) THEN LoadL(y, hint, stop) END;
+				IF (y.form >= Int16) & (f < Int16) THEN FreeHi(y) END
+			ELSE
+				CASE y.form OF
+				| Byte, Bool:
+						IF f = Int64 THEN LoadLong(y, hint, stop)
+						ELSIF f >= Int16 THEN LoadL(y, hint, stop)
+						END
+				| Char8:
+						IF f = Int8 THEN Check(y, 0, 0)
+						ELSIF f = Int64 THEN LoadLong(y, hint, stop)
+						ELSIF f >= Int16 THEN LoadL(y, hint, stop)
+						END
+				| Char16:
+						IF f = Char8 THEN Check(y, 0, 255); FreeHi(y)
+						ELSIF f = Int8 THEN Check(y, -128, 127); FreeHi(y)
+						ELSIF f = Int16 THEN Check(y, 0, 0)
+						ELSIF f = Char16 THEN (* ok *)
+						ELSIF f = Int64 THEN LoadLong(y, hint, stop)
+						ELSIF f >= Int32 THEN LoadL(y, hint, stop)
+						END
+				| Int8:
+						IF f = Char8 THEN Check(y, 0, 0)
+						ELSIF f = Int64 THEN LoadLong(y, hint, stop)
+						ELSIF f >= Int16 THEN LoadL(y, hint, stop)
+						END
+				| Int16:
+						IF f = Char8 THEN Check(y, 0, 255); FreeHi(y)
+						ELSIF f = Char16 THEN Check(y, 0, 0)
+						ELSIF f = Int8 THEN Check(y, -128, 127); FreeHi(y)
+						ELSIF f = Int64 THEN LoadLong(y, hint, stop)
+						ELSIF (f = Int32) OR (f = Set) THEN LoadL(y, hint, stop)
+						END
+				| Int32, Set, Pointer, ProcTyp:
+						IF f = Char8 THEN Check(y, 0, 255); FreeHi(y)
+						ELSIF f = Char16 THEN Check(y, 0, 65536)
+						ELSIF f = Int8 THEN Check(y, -128, 127); FreeHi(y)
+						ELSIF f = Int16 THEN Check(y, -32768, 32767)
+						ELSIF f = Int64 THEN LoadLong(y, hint, stop)
+						END
+				| Int64:
+						IF f IN {Bool..Int32, Char16} THEN
+							(* make range checks !!! *)
+							FreeHi(y)
+						END
+				END
+			END;
+			IF f IN {Real32, Real64} THEN
+				IF sysval THEN
+					IF (m # Undef) & (m # Reg) THEN
+						IF y.mode # Reg THEN LoadW(y, hint, stop) END;
+						Free(y);
+						IF m = Stk THEN DevCPL486.GenPush(y)
+						ELSE x.form := Int32; DevCPL486.GenMove(y, x); x.form := f
+						END
+					ELSE
+						IF y.mode = Reg THEN Push(y) END;
+						y.form := f;
+						IF m = Reg THEN LoadR(y) END
+					END
+				ELSE (* not sysval *) (* int -> float *)
+					IF y.mode = Reg THEN Push(y) END;
+					IF m = Stk THEN
+						Free(y); DevCPL486.GenFLoad(y); s := -4;
+						IF f = Real64 THEN DEC(s, 4) END;
+						IF y.mode = Stk THEN
+							IF y.form = Int64 THEN INC(s, 8) ELSE INC(s, 4) END
+						END;
+						IF s # 0 THEN AdjustStack(s) END;
+						GetReg(y, Real32, {}, {});
+						Free(y); DevCPL486.GenFStore(x, TRUE)
+					ELSIF m = Reg THEN
+						LoadR(y)
+					ELSIF m # Undef THEN
+						LoadR(y); Free(y); DevCPL486.GenFStore(x, TRUE) 
+					END
+				END
+			ELSE
+				y.form := f;
+				IF m = Stk THEN
+					IF ((f < Int32) OR (f = Char16)) & (y.mode # Reg) THEN LoadW(y, hint, stop) END;
+					Push(y)
+				ELSIF m # Undef THEN
+					IF f = Int64 THEN
+						IF y.mode # Reg THEN LoadLong(y, hint, stop) END;
+						Free(y); y.form := Int32; z := x; z.form := Int32; DevCPL486.GenMove(y, z);
+						IF z.mode = Reg THEN ASSERT(z.reg # y.index); z.reg := z.index ELSE INC(z.offset, 4) END;
+						y.reg := y.index; DevCPL486.GenMove(y, z);
+					ELSE
+						IF y.mode # Reg THEN LoadW(y, hint, stop) END;
+						Free(y); DevCPL486.GenMove(y, x)
+					END
+				END
+			END
+		END	
+	END ConvMove;
+
+	PROCEDURE Convert* (VAR x: DevCPL486.Item; f: BYTE; size: INTEGER; hint, stop: SET);	(* size >= 0: sysval *)
+		VAR y: DevCPL486.Item;
+	BEGIN
+		ASSERT(x.mode # Con);
+		IF (size >= 0)
+			& ((size # x.typ.size) & ((size > 4) OR (x.typ.size > 4))
+				OR (f IN {Comp, Real64, Int64}) & (x.mode IN {Reg, Stk})) THEN DevCPM.err(220) END;
+(*
+		IF sysval & ((x.form = Real64) & ~(f IN {Comp, Int64}) OR (f = Real64) & ~(x.form  IN {Comp, Int64})) THEN DevCPM.err(220) END;
+*)
+		y.mode := Undef; y.form := f; ConvMove(y, x, size >= 0, hint, stop)
+	END Convert;
+
+	PROCEDURE LoadCond* (VAR x, y: DevCPL486.Item; F, T: DevCPL486.Label; hint, stop: SET);
+		VAR end, T1: DevCPL486.Label; c, r: DevCPL486.Item;
+	BEGIN
+		IF mem IN stop THEN GetReg(x, Bool, hint, stop) END;
+		IF (F = DevCPL486.NewLbl) & (T = DevCPL486.NewLbl) THEN (* no label used *)
+			DevCPL486.GenSetCC(y.offset, x)
+		ELSE
+			end := DevCPL486.NewLbl; T1 := DevCPL486.NewLbl;
+			DevCPL486.GenJump(y.offset, T1, TRUE);	(* T1 to enable short jump *)
+			DevCPL486.SetLabel(F);
+			DevCPL486.MakeConst(c, 0, Bool); DevCPL486.GenMove(c, x);
+			DevCPL486.GenJump(ccAlways, end, TRUE);
+			DevCPL486.SetLabel(T); DevCPL486.SetLabel(T1); 
+			DevCPL486.MakeConst(c, 1, Bool); DevCPL486.GenMove(c, x);
+			DevCPL486.SetLabel(end)
+		END;
+		IF x.mode # Reg THEN Free(x) END
+	END LoadCond;
+	
+	PROCEDURE IntDOp* (VAR x, y: DevCPL486.Item; subcl: BYTE; rev: BOOLEAN);
+		VAR local: DevCPL486.Label;
+	BEGIN
+		ASSERT((x.mode = Reg) OR (y.mode = Reg) OR (y.mode = Con));
+		CASE subcl OF
+		| eql..geq:
+				DevCPL486.GenComp(y, x); Free(x);
+				setCC(x, subcl, rev, x.typ.form IN {Int8..Int32})
+		| times: 
+				IF x.form = Set THEN DevCPL486.GenAnd(y, x) ELSE DevCPL486.GenMul(y, x, ovflchk) END
+		| slash:
+				DevCPL486.GenXor(y, x)
+		| plus:
+				IF x.form = Set THEN DevCPL486.GenOr(y, x) ELSE DevCPL486.GenAdd(y, x, ovflchk) END
+		| minus, msk:
+				IF (x.form = Set) OR (subcl = msk) THEN (* and not *)
+					IF rev THEN DevCPL486.GenNot(x); DevCPL486.GenAnd(y, x)								(* y and not x *)
+					ELSIF y.mode = Con THEN y.offset := -1 - y.offset; DevCPL486.GenAnd(y, x)	(* x and y' *)
+					ELSIF y.mode = Reg THEN DevCPL486.GenNot(y); DevCPL486.GenAnd(y, x)			(* x and not y *)
+					ELSE DevCPL486.GenNot(x); DevCPL486.GenOr(y, x); DevCPL486.GenNot(x)					(* not (not x or y) *)
+					END
+				ELSE	(* minus *)
+					IF rev THEN	(* y - x *)
+						IF (y.mode = Con) & (y.offset = -1) THEN DevCPL486.GenNot(x)
+						ELSE DevCPL486.GenNeg(x, ovflchk); DevCPL486.GenAdd(y, x, ovflchk)	(* ??? *)
+						END
+					ELSE	(* x - y *)
+						DevCPL486.GenSub(y, x, ovflchk)
+					END
+				END
+		| min, max:
+				local := DevCPL486.NewLbl;
+				DevCPL486.GenComp(y, x);
+				IF subcl = min THEN 
+					IF x.typ.form IN {Char8, Char16} THEN DevCPL486.GenJump(ccBE, local, TRUE)
+					ELSE DevCPL486.GenJump(ccLE, local, TRUE)
+					END
+				ELSE
+					IF x.typ.form IN {Char8, Char16} THEN DevCPL486.GenJump(ccAE, local, TRUE)
+					ELSE DevCPL486.GenJump(ccGE, local, TRUE)
+					END
+				END;
+				DevCPL486.GenMove(y, x);
+				DevCPL486.SetLabel(local)
+		END;
+		Free(y);
+		IF x.mode # Reg THEN Free(x) END
+	END IntDOp;
+	
+	PROCEDURE LargeInc* (VAR x, y: DevCPL486.Item; dec: BOOLEAN);	(* INC(x, y) or DEC(x, y) *)
+	BEGIN
+		ASSERT(x.form = Int64);
+		IF ~(y.mode IN {Reg, Con}) THEN LoadLong(y, {}, {}) END;
+		Free(x); Free(y); x.form := Int32; y.form := Int32;
+		IF dec THEN DevCPL486.GenSubC(y, x, TRUE, FALSE) ELSE DevCPL486.GenAddC(y, x, TRUE, FALSE) END;
+		INC(x.offset, 4);
+		IF y.mode = Reg THEN y.reg := y.index ELSE y.offset := y.scale END;
+		IF dec THEN DevCPL486.GenSubC(y, x, FALSE, ovflchk) ELSE DevCPL486.GenAddC(y, x, FALSE, ovflchk) END;
+	END LargeInc;
+	
+	PROCEDURE FloatDOp* (VAR x, y: DevCPL486.Item; subcl: BYTE; rev: BOOLEAN);
+		VAR local: DevCPL486.Label; a, b: DevCPL486.Item;
+	BEGIN
+		ASSERT(x.mode = Reg);
+		IF y.form = Int64 THEN LoadR(y) END;
+		IF y.mode = Reg THEN rev := ~rev END;
+		CASE subcl OF
+		| eql..geq: DevCPL486.GenFDOp(FCOMP, y)
+		| times: DevCPL486.GenFDOp(FMUL, y)
+		| slash: IF rev THEN DevCPL486.GenFDOp(FDIVR, y) ELSE DevCPL486.GenFDOp(FDIV, y) END
+		| plus: DevCPL486.GenFDOp(FADD, y)
+		| minus: IF rev THEN DevCPL486.GenFDOp(FSUBR, y) ELSE DevCPL486.GenFDOp(FSUB, y) END
+		| min, max:
+			IF y.mode = Reg THEN
+				DevCPL486.GenFMOp(0D1H);	(* FCOM ST1 *)
+				CheckAv(AX); DevCPL486.GenFMOp(FSTSW); (* DevCPL486.GenCode(WAIT); *) DevCPL486.GenCode(SAHF);
+				local := DevCPL486.NewLbl;
+				IF subcl = min THEN DevCPL486.GenJump(ccAE, local, TRUE) ELSE DevCPL486.GenJump(ccBE, local, TRUE) END;
+				DevCPL486.GenFMOp(5D1H);	(* FST ST1 *)
+				DevCPL486.SetLabel(local);
+				DevCPL486.GenFMOp(5D8H)	(* FSTP ST0 *)
+			ELSE
+				DevCPL486.GenFDOp(FCOM, y);
+				CheckAv(AX); DevCPL486.GenFMOp(FSTSW); (* DevCPL486.GenCode(WAIT); *) DevCPL486.GenCode(SAHF);
+				local := DevCPL486.NewLbl;
+				IF subcl = min THEN DevCPL486.GenJump(ccBE, local, TRUE) ELSE DevCPL486.GenJump(ccAE, local, TRUE) END;
+				DevCPL486.GenFMOp(5D8H);	(* FSTP ST0 *)
+				DevCPL486.GenFLoad(y);
+				DevCPL486.SetLabel(local)
+			END
+		(* largeint support *)
+		| div:
+			IF rev THEN DevCPL486.GenFDOp(FDIVR, y) ELSE DevCPL486.GenFDOp(FDIV, y) END;
+			Floor(y, FALSE)
+		| mod:
+			IF y.mode # Reg THEN LoadR(y); rev := ~rev END;
+			IF rev THEN DevCPL486.GenFMOp(1C9H); (* FXCH ST1 *) END;
+			DevCPL486.GenFMOp(1F8H);	(* FPREM *)
+			DevCPL486.GenFMOp(1E4H);	(* FTST *)
+			CheckAv(AX);
+			DevCPL486.GenFMOp(FSTSW);
+			DevCPL486.MakeReg(a, AX, Int32); GetReg(b, Int32, {}, {AX});
+			DevCPL486.GenMove(a, b);
+			DevCPL486.GenFMOp(0D1H);	(* FCOM *)
+			DevCPL486.GenFMOp(FSTSW);
+			DevCPL486.GenXor(b, a); Free(b);
+			(* DevCPL486.GenCode(WAIT); *) DevCPL486.GenCode(SAHF);
+			local := DevCPL486.NewLbl; DevCPL486.GenJump(ccBE, local, TRUE);
+			DevCPL486.GenFMOp(0C1H);	(* FADD ST1 *)
+			DevCPL486.SetLabel(local);
+			DevCPL486.GenFMOp(5D9H);	(* FSTP ST1 *)
+		| ash:
+			IF y.mode # Reg THEN LoadR(y); rev := ~rev END;
+			IF rev THEN DevCPL486.GenFMOp(1C9H); (* FXCH ST1 *) END;
+			DevCPL486.GenFMOp(1FDH);	(* FSCALE *)
+			Floor(y, TRUE)
+		END;
+		IF y.mode = Stk THEN IncStack(y.form) END;
+		Free(y);
+		IF (subcl >= eql) & (subcl <= geq) THEN
+			Free(x); CheckAv(AX);
+			DevCPL486.GenFMOp(FSTSW);
+			(* DevCPL486.GenCode(WAIT); *) DevCPL486.GenCode(SAHF);
+			setCC(x, subcl, rev, FALSE)
+		END
+	END FloatDOp;
+	
+	PROCEDURE IntMOp* (VAR x: DevCPL486.Item; subcl: BYTE);
+		VAR L: DevCPL486.Label; c: DevCPL486.Item;
+	BEGIN
+		CASE subcl OF
+		| minus:
+				IF x.form = Set THEN DevCPL486.GenNot(x) ELSE DevCPL486.GenNeg(x, ovflchk) END
+		| abs:
+				L := DevCPL486.NewLbl; DevCPL486.MakeConst(c, 0, x.form);
+				DevCPL486.GenComp(c, x);
+				DevCPL486.GenJump(ccNS, L, TRUE);
+				DevCPL486.GenNeg(x, ovflchk);
+				DevCPL486.SetLabel(L)
+		| cap:
+				DevCPL486.MakeConst(c, -1 - 20H, x.form);
+				DevCPL486.GenAnd(c, x)
+		| not:
+				DevCPL486.MakeConst(c, 1, x.form);
+				DevCPL486.GenXor(c, x)
+		END;
+		IF x.mode # Reg THEN Free(x) END
+	END IntMOp;
+	
+	PROCEDURE FloatMOp* (VAR x: DevCPL486.Item; subcl: BYTE);
+	BEGIN
+		ASSERT(x.mode = Reg);
+		IF subcl = minus THEN DevCPL486.GenFMOp(FCHS)
+		ELSE ASSERT(subcl = abs); DevCPL486.GenFMOp(FABS)
+		END
+	END FloatMOp;
+
+	PROCEDURE MakeSet* (VAR x: DevCPL486.Item; range, neg: BOOLEAN; hint, stop: SET);
+		(* range neg	result
+				F	F		{x}
+				F	T		-{x}
+				T	F		{x..31}
+				T	T		-{0..x}	*)
+		VAR c, r: DevCPL486.Item; val: INTEGER;
+	BEGIN
+		IF x.mode = Con THEN
+			IF range THEN
+				IF neg THEN val := -2 ELSE val := -1 END;
+				x.offset := SYSTEM.LSH(val, x.offset)
+			ELSE
+				val := 1; x.offset := SYSTEM.LSH(val, x.offset);
+				IF neg THEN x.offset := -1 - x.offset END
+			END
+		ELSE
+			Check(x, 0, 31);
+			IF neg THEN val := -2
+			ELSIF range THEN val := -1
+			ELSE val := 1
+			END;
+			DevCPL486.MakeConst(c, val, Set); GetReg(r, Set, hint, stop); DevCPL486.GenMove(c, r);
+			IF range THEN DevCPL486.GenShiftOp(SHL, x, r) ELSE DevCPL486.GenShiftOp(ROL, x, r) END;
+			Free(x); x.reg := r.reg
+		END;
+		x.typ := DevCPT.settyp; x.form := Set
+	END MakeSet;
+	
+	PROCEDURE MakeCond* (VAR x: DevCPL486.Item);
+		VAR c: DevCPL486.Item;
+	BEGIN
+		IF x.mode = Con THEN
+			setCC(x, SHORT(SHORT(x.offset)), FALSE, FALSE)
+		ELSE
+			DevCPL486.MakeConst(c, 0, x.form);
+			DevCPL486.GenComp(c, x); Free(x);
+			setCC(x, neq, FALSE, FALSE)
+		END
+	END MakeCond;
+	
+	PROCEDURE Not* (VAR x: DevCPL486.Item);
+		VAR a: INTEGER;
+	BEGIN
+		x.offset := Inverted(x.offset); (* invert cc *)
+	END Not;
+	
+	PROCEDURE Odd* (VAR x: DevCPL486.Item);
+		VAR c: DevCPL486.Item;
+	BEGIN
+		IF x.mode = Stk THEN Pop(x, x.form, {}, {}) END;
+		Free(x); DevCPL486.MakeConst(c, 1, x.form);
+		IF x.mode = Reg THEN
+			IF x.form IN {Int16, Int64} THEN x.form := Int32; c.form := Int32 END;
+			DevCPL486.GenAnd(c, x)
+		ELSE
+			c.form := Int8; x.form := Int8; DevCPL486.GenTest(c, x)
+		END;
+		setCC(x, neq, FALSE, FALSE)
+	END Odd;
+	
+	PROCEDURE In* (VAR x, y: DevCPL486.Item);
+	BEGIN
+		IF y.form = Set THEN Check(x, 0, 31) END;
+		DevCPL486.GenBitOp(BT, x, y); Free(x); Free(y);
+		setCC(x, lss, FALSE, FALSE); (* carry set *)
+	END In;
+	
+	PROCEDURE Shift* (VAR x, y: DevCPL486.Item; subcl: BYTE);	(* ASH, LSH, ROT *)
+		VAR L1, L2: DevCPL486.Label; c: DevCPL486.Item; opl, opr: INTEGER;
+	BEGIN
+		IF subcl = ash THEN opl := SHL; opr := SAR
+		ELSIF subcl = lsh THEN opl := SHL; opr := SHR
+		ELSE opl := ROL; opr := ROR
+		END;
+		IF y.mode = Con THEN
+			IF y.offset > 0 THEN
+				DevCPL486.GenShiftOp(opl, y, x)
+			ELSIF y.offset < 0 THEN
+				y.offset := -y.offset;
+				DevCPL486.GenShiftOp(opr, y, x)
+			END
+		ELSE
+			ASSERT(y.mode = Reg);
+			Check(y, -31, 31);
+			L1 := DevCPL486.NewLbl; L2 := DevCPL486.NewLbl; 
+			DevCPL486.MakeConst(c, 0, y.form); DevCPL486.GenComp(c, y);
+			DevCPL486.GenJump(ccNS, L1, TRUE);
+			DevCPL486.GenNeg(y, FALSE);
+			DevCPL486.GenShiftOp(opr, y, x);
+			DevCPL486.GenJump(ccAlways, L2, TRUE);
+			DevCPL486.SetLabel(L1);
+			DevCPL486.GenShiftOp(opl, y, x);
+			DevCPL486.SetLabel(L2);
+			Free(y)
+		END;
+		IF x.mode # Reg THEN Free(x) END
+	END Shift;
+
+	PROCEDURE DivMod* (VAR x, y: DevCPL486.Item; mod: BOOLEAN);
+		VAR s: SET; r: DevCPL486.Item; pos: BOOLEAN;
+	BEGIN
+		ASSERT((x.mode = Reg) & (x.reg = AX)); pos := FALSE;
+		IF y.mode = Con THEN pos := (y.offset > 0) & (y.obj = NIL); Load(y, {}, {AX, DX, con}) END;
+		DevCPL486.GenDiv(y, mod, pos); Free(y);
+		IF mod THEN
+			r := x; GetReg(x, x.form, {}, wreg - {AX, DX}); Free(r) (* ax -> dx; al -> ah *)	(* ??? *)
+		END
+	END DivMod;
+
+	PROCEDURE Mem* (VAR x: DevCPL486.Item; offset: INTEGER; typ: DevCPT.Struct);	(* x := Mem[x+offset] *)
+	BEGIN
+		IF x.mode = Con THEN x.mode := Abs; x.obj := NIL; INC(x.offset, offset)
+		ELSE ASSERT(x.mode = Reg); x.mode := Ind; x.offset := offset
+		END;
+		x.scale := 0; x.typ := typ; x.form := typ.form
+	END Mem;
+	
+	PROCEDURE SysMove* (VAR len: DevCPL486.Item);	(* implementation of SYSTEM.MOVE *)
+	BEGIN
+		IF len.mode = Con THEN
+			IF len.offset > 0 THEN DevCPL486.GenBlockMove(1, len.offset) END
+		ELSE
+			Load(len, {}, wreg - {CX} + {short, mem, stk}); DevCPL486.GenBlockMove(1, 0); Free(len)
+		END;
+		FreeWReg(SI); FreeWReg(DI)
+	END SysMove;
+	
+	PROCEDURE Len* (VAR x, y: DevCPL486.Item);
+		VAR typ: DevCPT.Struct; dim: INTEGER;
+	BEGIN
+		dim := y.offset; typ := x.typ;
+		IF typ.untagged THEN DevCPM.err(136) END;
+		WHILE dim > 0 DO typ := typ.BaseTyp; DEC(dim) END;
+		LenDesc(x, x, typ);
+	END Len;
+	
+	PROCEDURE StringWSize (VAR x: DevCPL486.Item): INTEGER;
+	BEGIN
+		CASE x.form OF
+		| String8, VString8: RETURN 1
+		| String16, VString16: RETURN 2
+		| VString16to8: RETURN 0
+		| Comp: RETURN x.typ.BaseTyp.size
+		END
+	END StringWSize;
+
+	PROCEDURE CmpString* (VAR x, y: DevCPL486.Item; rel: BYTE; rev: BOOLEAN);
+		VAR sw, dw: INTEGER;
+	BEGIN
+		CheckAv(CX);
+		IF (x.typ = DevCPT.guidtyp) OR (y.typ = DevCPT.guidtyp) THEN
+			DevCPL486.GenBlockComp(4, 4)
+		ELSIF x.form = String8 THEN DevCPL486.GenBlockComp(1, x.index)
+		ELSIF y.form = String8 THEN DevCPL486.GenBlockComp(1, y.index)
+		ELSIF x.form = String16 THEN DevCPL486.GenBlockComp(2, x.index)
+		ELSIF y.form = String16 THEN DevCPL486.GenBlockComp(2, y.index)
+		ELSE DevCPL486.GenStringComp(StringWSize(y), StringWSize(x))
+		END;
+		FreeWReg(SI); FreeWReg(DI); setCC(x, rel, ~rev, FALSE);
+	END CmpString;
+
+	PROCEDURE VarParDynArr (ftyp: DevCPT.Struct; VAR y: DevCPL486.Item);
+		VAR len, z: DevCPL486.Item; atyp: DevCPT.Struct;
+	BEGIN
+		atyp := y.typ;
+		WHILE ftyp.comp = DynArr DO
+			IF ftyp.BaseTyp = DevCPT.bytetyp THEN
+				IF atyp.comp = DynArr THEN
+					IF atyp.untagged THEN DevCPM.err(137) END;
+					LenDesc(y, len, atyp);
+					IF y.tmode = VarPar THEN Free(len) END;	(* ??? *)
+					GetReg(z, Int32, {}, {}); DevCPL486.GenMove(len, z);
+					len.mode := Reg; len.reg := z.reg; atyp := atyp.BaseTyp;
+					WHILE atyp.comp = DynArr DO
+						LenDesc(y, z, atyp); DevCPL486.GenMul(z, len, FALSE);
+						IF y.tmode = VarPar THEN Free(z) END;	(* ??? *)
+						atyp := atyp.BaseTyp
+					END;
+					DevCPL486.MakeConst(z, atyp.size, Int32); DevCPL486.GenMul(z, len, FALSE);
+					Free(len)
+				ELSE
+					DevCPL486.MakeConst(len, atyp.size, Int32)
+				END
+			ELSE
+				IF atyp.comp = DynArr THEN LenDesc(y, len, atyp);
+					IF atyp.untagged THEN DevCPM.err(137) END;
+					IF y.tmode = VarPar THEN Free(len) END;	(* ??? *)
+				ELSE DevCPL486.MakeConst(len, atyp.n, Int32)
+				END
+			END;
+			DevCPL486.GenPush(len);
+			ftyp := ftyp.BaseTyp; atyp := atyp.BaseTyp
+		END
+	END VarParDynArr;
+
+	PROCEDURE Assign* (VAR x, y: DevCPL486.Item); (* x := y *)
+	BEGIN
+		IF y.mode = Con THEN
+			IF y.form IN {Real32, Real64} THEN
+				DevCPL486.GenFLoad(y); GetReg(y, Real32, {}, {});
+				IF x.mode # Reg THEN Free(y); DevCPL486.GenFStore(x, TRUE) END	(* ??? move const *)
+			ELSIF x.form = Int64 THEN
+				ASSERT(x.mode IN {Ind, Abs});
+				y.form := Int32; x.form := Int32; DevCPL486.GenMove(y, x);
+				y.offset := y.scale; INC(x.offset, 4); DevCPL486.GenMove(y, x);
+				DEC(x.offset, 4); x.form := Int64
+			ELSE
+				DevCPL486.GenMove(y, x)
+			END
+		ELSE
+			IF y.form IN {Comp, String8, String16, VString8, VString16} THEN	(* convert to pointer *)
+				ASSERT(x.form = Pointer);
+				GetAdr(y, {}, {}); y.typ := x.typ; y.form := Pointer
+			END;
+			IF ~(x.form IN realSet) OR ~(y.form IN intSet) THEN Assert(y, {}, {stk}) END;
+			ConvMove(x, y, FALSE, {}, {})
+		END;
+		Free(x)
+	END Assign;
+	
+	PROCEDURE ArrayLen* (VAR x, len: DevCPL486.Item; hint, stop: SET);
+		VAR c: DevCPL486.Item;
+	BEGIN
+		IF x.typ.comp = Array THEN DevCPL486.MakeConst(c, x.typ.n, Int32); GetReg(len, Int32, hint, stop); DevCPL486.GenMove(c, len)
+		ELSIF ~x.typ.untagged THEN LenDesc(x, c, x.typ); GetReg(len, Int32, hint, stop); DevCPL486.GenMove(c, len)
+		ELSE len.mode := Con
+		END;
+		len.typ := DevCPT.int32typ
+	END ArrayLen;
+
+(*
+(!)		src		dest	zero
+sx	= sy	x b		y b
+SHORT(lx)	= sy	x b+	x w	y b
+SHORT(lx)	= SHORT(ly)	x b+	x w	y b+
+
+lx	= ly	x w		y w
+LONG(sx)	= ly	x b		y w	*
+LONG(SHORT(lx))	= ly	x b+	x w*	y w	*
+
+sx	:= sy	y b		x b
+sx	:= SHORT(ly)	y b+	y w	x b
+
+lx	:= ly	y w		x w
+lx	:= LONG(sy)	y b		x w	*
+lx	:= LONG(SHORT(ly))	y b+	y w*	x w	*
+(!)*)
+	
+	PROCEDURE AddCopy* (VAR x, y: DevCPL486.Item; last: BOOLEAN); (* x := .. + y + .. *)
+	BEGIN
+		IF (x.typ.comp = DynArr) & x.typ.untagged THEN
+			DevCPL486.GenStringMove(~last, StringWSize(y), StringWSize(x), -1)
+		ELSE
+			DevCPL486.GenStringMove(~last, StringWSize(y), StringWSize(x), 0)
+		END;
+		FreeWReg(SI); FreeWReg(DI)
+	END AddCopy;
+	
+	PROCEDURE Copy* (VAR x, y: DevCPL486.Item; short: BOOLEAN); (* x := y *)
+		VAR sx, sy, sy2, sy4: INTEGER; c, r: DevCPL486.Item;
+	BEGIN
+		sx := x.typ.size; CheckAv(CX);
+		IF y.form IN {String8, String16} THEN
+			sy := y.index * y.typ.BaseTyp.size;
+			IF x.typ.comp = Array THEN	(* adjust size for optimal performance *)
+				sy2 := sy + sy MOD 2; sy4 := sy2 + sy2 MOD 4;
+				IF sy4 <= sx THEN sy := sy4
+				ELSIF sy2 <= sx THEN sy := sy2
+				ELSIF sy > sx THEN DevCPM.err(114); sy := 1
+				END
+			ELSIF inxchk & ~x.typ.untagged THEN	(* check array length *)
+				Free(x); LenDesc(x, c, x.typ);
+				DevCPL486.MakeConst(y, y.index, Int32);
+				DevCPL486.GenComp(y, c); DevCPL486.GenAssert(ccAE, copyTrap);
+				Free(c)
+			END;
+			DevCPL486.GenBlockMove(1, sy)
+		ELSIF x.typ.comp = DynArr THEN
+			IF x.typ.untagged THEN
+				DevCPL486.GenStringMove(FALSE, StringWSize(y), StringWSize(x), -1)
+			ELSE
+				Free(x); LenDesc(x, c, x.typ); DevCPL486.MakeReg(r, CX, Int32); DevCPL486.GenMove(c, r); Free(c);
+				DevCPL486.GenStringMove(FALSE, StringWSize(y), StringWSize(x), 0)
+			END
+		ELSIF y.form IN {VString16to8, VString8, VString16} THEN
+			DevCPL486.GenStringMove(FALSE, StringWSize(y), StringWSize(x), x.typ.n);
+			ASSERT(y.mode # Stk)
+		ELSIF short THEN	(* COPY *)
+			sy := y.typ.size;
+			IF (y.typ.comp # DynArr) & (sy < sx) THEN sx := sy END;
+			DevCPL486.GenStringMove(FALSE, StringWSize(y), StringWSize(x), x.typ.n);
+			IF y.mode = Stk THEN AdjustStack(sy) END
+		ELSE	(* := *)
+			IF sx > 0 THEN DevCPL486.GenBlockMove(1, sx) END;
+			IF y.mode = Stk THEN AdjustStack(sy) END
+		END;
+		FreeWReg(SI); FreeWReg(DI)
+	END Copy;
+	
+	PROCEDURE StrLen* (VAR x: DevCPL486.Item; typ: DevCPT.Struct; incl0x: BOOLEAN);
+		VAR c: DevCPL486.Item;
+	BEGIN
+		CheckAv(AX); CheckAv(CX);
+		DevCPL486.GenStringLength(typ.BaseTyp.size, -1);
+		Free(x); GetReg(x, Int32, {}, wreg - {CX});
+		DevCPL486.GenNot(x);
+		IF ~incl0x THEN DevCPL486.MakeConst(c, 1, Int32); DevCPL486.GenSub(c, x, FALSE) END;
+		FreeWReg(DI)
+	END StrLen;
+
+	PROCEDURE MulDim* (VAR y, z: DevCPL486.Item; VAR fact: INTEGER; dimtyp: DevCPT.Struct);	(* z := z * y *)
+		VAR c: DevCPL486.Item;
+	BEGIN
+		IF y.mode = Con THEN fact := fact * y.offset
+		ELSE
+			IF ranchk OR inxchk THEN
+				DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenComp(c, y); DevCPL486.GenAssert(ccG, ranTrap)
+			END;
+			DevCPL486.GenPush(y);
+			IF z.mode = Con THEN z := y
+			ELSE DevCPL486.GenMul(y, z, ovflchk OR inxchk); Free(y)
+			END
+		END
+	END MulDim;
+	
+	PROCEDURE SetDim* (VAR x, y: DevCPL486.Item; dimtyp: DevCPT.Struct); (* set LEN(x^, -dimtyp.n) *)
+		(* y const or on stack *) 
+		VAR z: DevCPL486.Item; end: DevCPL486.Label;
+	BEGIN
+		ASSERT((x.mode = Reg) & (x.form = Pointer));
+		z.mode := Ind; z.reg := x.reg; z.offset := ArrDOffs + 4 + dimtyp.n * 4; z.scale := 0; z.form := Int32;
+		IF y.mode = Con THEN y.form := Int32
+		ELSE Pop(y, Int32, {}, {})
+		END;
+		end := DevCPL486.NewLbl; DevCPL486.GenJump(ccE, end, TRUE);	(* flags set in New *)
+		DevCPL486.GenMove(y, z);
+		DevCPL486.SetLabel(end);
+		IF y.mode = Reg THEN Free(y) END
+	END SetDim;
+
+	PROCEDURE SysNew* (VAR x: DevCPL486.Item);
+	BEGIN
+		DevCPM.err(141)
+	END SysNew;
+
+	PROCEDURE New* (VAR x, nofel: DevCPL486.Item; fact: INTEGER);
+		(* x.typ.BaseTyp.comp IN {Record, Array, DynArr} *)
+		VAR p, tag, c: DevCPL486.Item; nofdim, dlen, n: INTEGER; typ, eltyp: DevCPT.Struct; lbl: DevCPL486.Label;
+	BEGIN
+		typ := x.typ.BaseTyp;
+		IF typ.untagged THEN DevCPM.err(138) END;
+		IF typ.comp = Record THEN	(* call to Kernel.NewRec(tag: Tag): ADDRESS *)
+			DevCPL486.MakeConst(tag, 0, Pointer); tag.obj := DevCPE.TypeObj(typ);
+			IF ContainsIPtrs(typ) THEN INC(tag.offset) END;
+			DevCPL486.GenPush(tag);
+			p.mode := XProc; p.obj := DevCPE.KNewRec;
+		ELSE eltyp := typ.BaseTyp;
+			IF typ.comp = Array THEN
+				nofdim := 0; nofel.mode := Con; nofel.form := Int32; fact := typ.n
+			ELSE (* DynArr *)
+				nofdim := typ.n+1;
+				WHILE eltyp.comp = DynArr DO eltyp := eltyp.BaseTyp END
+			END ;
+			WHILE eltyp.comp = Array DO fact := fact * eltyp.n; eltyp := eltyp.BaseTyp END;
+			IF eltyp.comp = Record THEN
+				IF eltyp.untagged THEN DevCPM.err(138) END;
+				DevCPL486.MakeConst(tag, 0, Pointer); tag.obj := DevCPE.TypeObj(eltyp);
+				IF ContainsIPtrs(eltyp) THEN INC(tag.offset) END;
+			ELSIF eltyp.form = Pointer THEN
+				IF ~eltyp.untagged THEN
+					DevCPL486.MakeConst(tag, 0, Pointer)	(* special TDesc in Kernel for ARRAY OF pointer *)
+				ELSIF eltyp.sysflag = interface THEN
+					DevCPL486.MakeConst(tag, -1, Pointer)	(* special TDesc in Kernel for ARRAY OF interface pointer *)
+				ELSE
+					DevCPL486.MakeConst(tag, 12, Pointer)
+				END
+			ELSE	(* eltyp is pointerless basic type *)
+				CASE eltyp.form OF
+				| Undef, Byte, Char8: n := 1;
+				| Int16: n := 2;
+				| Int8: n := 3;
+				| Int32: n := 4;
+				| Bool: n := 5;
+				| Set: n := 6;
+				| Real32: n := 7;
+				| Real64: n := 8;
+				| Char16: n := 9;
+				| Int64: n := 10;
+				| ProcTyp: n := 11;
+				END;
+				DevCPL486.MakeConst(tag, n, Pointer)
+(*
+				DevCPL486.MakeConst(tag, eltyp.size, Pointer)
+*)
+			END;
+			IF nofel.mode = Con THEN nofel.offset := fact; nofel.obj := NIL
+			ELSE DevCPL486.MakeConst(p, fact, Int32); DevCPL486.GenMul(p, nofel, ovflchk OR inxchk)
+			END;
+			DevCPL486.MakeConst(p, nofdim, Int32); DevCPL486.GenPush(p);
+			DevCPL486.GenPush(nofel); Free(nofel); DevCPL486.GenPush(tag);
+			p.mode := XProc; p.obj := DevCPE.KNewArr;
+		END;
+		DevCPL486.GenCall(p); GetReg(x, Pointer, {}, wreg - {AX});
+		IF typ.comp = DynArr THEN	(* set flags for nil test *)
+			DevCPL486.MakeConst(c, 0, Pointer); DevCPL486.GenComp(c, x)
+		ELSIF typ.comp = Record THEN
+			n := NumOfIntProc(typ);
+			IF n > 0 THEN	(* interface method table pointer setup *)
+				DevCPL486.MakeConst(c, 0, Pointer); DevCPL486.GenComp(c, x);
+				lbl := DevCPL486.NewLbl; DevCPL486.GenJump(ccE, lbl, TRUE);
+				tag.offset := - 4 * (n + numPreIntProc);
+				p.mode := Ind; p.reg := AX; p.offset := 0; p.scale := 0; p.form := Pointer;
+				DevCPL486.GenMove(tag, p);
+				IF nofel.mode # Con THEN	(* unk pointer setup *)
+					p.offset := 8;
+					DevCPL486.GenMove(nofel, p);
+					Free(nofel)
+				END;
+				DevCPL486.SetLabel(lbl);
+			END
+		END
+	END New;
+
+	PROCEDURE Param* (fp: DevCPT.Object; rec, niltest: BOOLEAN; VAR ap, tag: DevCPL486.Item);	(* returns tag if rec *)
+		VAR f: BYTE; s, ss: INTEGER; par, a, c: DevCPL486.Item; recTyp: DevCPT.Struct;
+	BEGIN
+		par.mode := Stk; par.typ := fp.typ; par.form := par.typ.form;
+		IF ODD(fp.sysflag DIV nilBit) THEN niltest := FALSE END;
+		IF ap.typ = DevCPT.niltyp THEN
+			IF ((par.typ.comp = Record) OR (par.typ.comp = DynArr)) & ~par.typ.untagged THEN
+				DevCPM.err(142)
+			END;
+			DevCPL486.GenPush(ap)
+		ELSIF par.typ.comp = DynArr THEN
+			IF ap.form IN {String8, String16} THEN
+				IF ~par.typ.untagged THEN
+					DevCPL486.MakeConst(c, ap.index (* * ap.typ.BaseTyp.size *), Int32); DevCPL486.GenPush(c)
+				END;
+				ap.mode := Con; DevCPL486.GenPush(ap);
+			ELSIF ap.form IN {VString8, VString16} THEN
+				DevCPL486.MakeReg(a, DX, Pointer); DevCPL486.GenLoadAdr(ap, a);
+				IF ~par.typ.untagged THEN
+					DevCPL486.MakeReg(c, DI, Pointer); DevCPL486.GenMove(a, c);
+					Free(ap); StrLen(c, ap.typ, TRUE);
+					DevCPL486.GenPush(c); Free(c)
+				END;
+				DevCPL486.GenPush(a)
+			ELSE
+				IF ~par.typ.untagged THEN
+					IF ap.typ.comp = DynArr THEN niltest := FALSE END;	(* ap dereferenced for length descriptor *)
+					VarParDynArr(par.typ, ap)
+				END;
+				PushAdr(ap, niltest)
+			END
+		ELSIF fp.mode = VarPar THEN
+			recTyp := ap.typ;
+			IF recTyp.form = Pointer THEN recTyp := recTyp.BaseTyp END;
+			IF (par.typ.comp = Record) & (~fp.typ.untagged) THEN
+				Tag(ap, tag);
+				IF rec & (tag.mode # Con) THEN
+					GetReg(c, Pointer, {}, {}); DevCPL486.GenMove(tag, c); tag := c
+				END;
+				DevCPL486.GenPush(tag);
+				IF tag.mode # Con THEN niltest := FALSE END;
+				PushAdr(ap, niltest);
+				IF rec THEN Free(tag) END
+			ELSE PushAdr(ap, niltest)
+			END;
+			tag.typ := recTyp
+		ELSIF par.form = Comp THEN
+			s := par.typ.size;
+			IF initializeStr & (ap.form IN {String8, String16, VString8, VString16, VString16to8}) THEN
+				s := (s + 3) DIV 4 * 4; AdjustStack(-s);
+				IF ap.form IN {String8, String16} THEN
+					IF ap.index > 1 THEN	(* nonempty string *)
+						ss := (ap.index * ap.typ.BaseTyp.size + 3) DIV 4 * 4;
+						DevCPL486.MakeReg(c, SI, Pointer); DevCPL486.GenLoadAdr(ap, c); Free(ap);
+						DevCPL486.MakeReg(c, DI, Pointer); DevCPL486.GenLoadAdr(par, c);
+						DevCPL486.GenBlockMove(1, ss);
+					ELSE
+						ss := 0;
+						DevCPL486.MakeReg(c, DI, Pointer); DevCPL486.GenLoadAdr(par, c)
+					END;
+					IF s > ss THEN
+						DevCPL486.MakeReg(a, AX, Int32); DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenMove(c, a);
+						DevCPL486.GenBlockStore(1, s - ss)
+					END;
+				ELSE
+					DevCPL486.MakeReg(c, SI, Pointer); DevCPL486.GenLoadAdr(ap, c); Free(ap);
+					DevCPL486.MakeReg(c, DI, Pointer); DevCPL486.GenLoadAdr(par, c);
+					DevCPL486.GenStringMove(TRUE, StringWSize(ap), StringWSize(par), par.typ.n);
+					DevCPL486.MakeReg(a, AX, Int32); DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenMove(c, a);
+					DevCPL486.GenBlockStore(StringWSize(par), 0)
+				END
+			ELSE
+				IF (ap.form IN {String8, String16}) & (ap.index = 1) THEN	(* empty string *)
+					AdjustStack((4 - s) DIV 4 * 4);
+					DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenPush(c)
+				ELSE
+					AdjustStack((-s) DIV 4 * 4);
+					DevCPL486.MakeReg(c, SI, Pointer); DevCPL486.GenLoadAdr(ap, c); Free(ap);
+					DevCPL486.MakeReg(c, DI, Pointer); DevCPL486.GenLoadAdr(par, c);
+					IF ap.form IN {String8, String16} THEN
+						DevCPL486.GenBlockMove(1, (ap.index * ap.typ.BaseTyp.size + 3) DIV 4 * 4)
+					ELSIF ap.form IN {VString8, VString16, VString16to8} THEN
+						DevCPL486.GenStringMove(FALSE, StringWSize(ap), StringWSize(par), par.typ.n)
+					ELSE
+						DevCPL486.GenBlockMove(1, (s + 3) DIV 4 * 4)
+					END
+				END
+			END
+		ELSIF ap.mode = Con THEN
+			IF ap.form IN {Real32, Real64} THEN	(* ??? push const *)
+				DevCPL486.GenFLoad(ap); DecStack(par.typ.form); DevCPL486.GenFStore(par, TRUE)
+			ELSE
+				ap.form := Int32;
+				IF par.form = Int64 THEN DevCPL486.MakeConst(c, ap.scale, Int32); DevCPL486.GenPush(c) END;
+				DevCPL486.GenPush(ap)
+			END
+		ELSIF ap.typ.form = Pointer THEN
+			recTyp := ap.typ.BaseTyp;
+			IF rec THEN
+				Load(ap, {}, {}); Tag(ap, tag);
+				IF tag.mode = Con THEN	(* explicit nil test needed *)
+					DevCPL486.MakeReg(a, AX, Int32);
+					c.mode := Ind; c.form := Int32; c.offset := 0; c.scale := 0; c.reg := ap.reg;
+					DevCPL486.GenTest(a, c)
+				END
+			END;
+			DevCPL486.GenPush(ap); Free(ap);
+			tag.typ := recTyp
+		ELSIF ap.form IN {Comp, String8, String16, VString8, VString16} THEN	(* convert to pointer *)
+			ASSERT(par.form = Pointer);
+			PushAdr(ap, FALSE)
+		ELSE
+			ConvMove(par, ap, FALSE, {}, {high});
+		END
+	END Param;
+	
+	PROCEDURE Result* (proc: DevCPT.Object; VAR res: DevCPL486.Item);
+		VAR r: DevCPL486.Item;
+	BEGIN
+		DevCPL486.MakeReg(r, AX, proc.typ.form);	(* don't allocate AX ! *)
+		IF res.mode = Con THEN
+			IF r.form IN {Real32, Real64} THEN DevCPL486.GenFLoad(res);
+			ELSIF r.form = Int64 THEN
+				r.form := Int32; res.form := Int32; DevCPL486.GenMove(res, r);
+				r.reg := DX; res.offset := res.scale; DevCPL486.GenMove(res, r)
+			ELSE DevCPL486.GenMove(res, r);
+			END
+		ELSIF res.form IN {Comp, String8, String16, VString8, VString16} THEN	(* convert to pointer *)
+			ASSERT(r.form = Pointer);
+			GetAdr(res, {}, wreg - {AX})
+		ELSE
+			r.index := DX;	(* for int64 *)
+			ConvMove(r, res, FALSE, wreg - {AX} + {high}, {});
+		END;
+		Free(res)
+	END Result;
+	
+	PROCEDURE InitFpu;
+		VAR x: DevCPL486.Item;
+	BEGIN
+		DevCPL486.MakeConst(x, FpuControlRegister, Int32); DevCPL486.GenPush(x);
+		DevCPL486.GenFMOp(12CH); DevCPL486.GenCode(24H);	(* FLDCW 0(SP) *)
+		DevCPL486.MakeReg(x, CX, Int32); DevCPL486.GenPop(x);	(* reset stack *)
+	END InitFpu;
+	
+	PROCEDURE PrepCall* (proc: DevCPT.Object);
+		VAR lev: BYTE; r: DevCPL486.Item;
+	BEGIN
+		lev := proc.mnolev;
+		IF (slNeeded IN proc.conval.setval) & (imLevel[lev] > 0) & (imLevel[DevCPL486.level] > imLevel[lev]) THEN
+			DevCPL486.MakeReg(r, BX, Pointer); DevCPL486.GenPush(r)
+		END
+	END PrepCall;
+	
+	PROCEDURE Call* (VAR x, tag: DevCPL486.Item);	(* TProc: tag.typ = actual receiver type *)
+		VAR i, n: INTEGER; r, y: DevCPL486.Item; typ: DevCPT.Struct; lev: BYTE; saved: BOOLEAN; p: DevCPT.Object;
+	BEGIN
+		IF x.mode IN {LProc, XProc, IProc} THEN
+			lev := x.obj.mnolev; saved := FALSE;
+			IF (slNeeded IN x.obj.conval.setval) & (imLevel[lev] > 0) THEN	(* pass static link *)
+				n := imLevel[DevCPL486.level] - imLevel[lev];
+				IF n > 0 THEN
+					saved := TRUE;
+					y.mode := Ind; y.scale := 0; y.form := Pointer; y.reg := BX; y.offset := -4;
+					DevCPL486.MakeReg(r, BX, Pointer);
+					WHILE n > 0 DO DevCPL486.GenMove(y, r); DEC(n) END
+				END
+			END;
+			DevCPL486.GenCall(x);
+			IF x.obj.sysflag = ccall THEN	(* remove parameters *)
+				p := x.obj.link; n := 0;
+				WHILE p # NIL DO
+					IF p.mode = VarPar THEN INC(n, 4)
+					ELSE INC(n, (p.typ.size + 3) DIV 4 * 4)
+					END;
+					p := p.link
+				END;
+				AdjustStack(n)
+			END;
+			IF saved THEN DevCPL486.GenPop(r) END;
+		ELSIF x.mode = TProc THEN
+			IF x.scale = 1 THEN (* super *)
+				DevCPL486.MakeConst(tag, 0, Pointer); tag.obj := DevCPE.TypeObj(tag.typ.BaseTyp)
+			ELSIF x.scale = 2 THEN (* static call *)
+				DevCPL486.MakeConst(tag, 0, Pointer); typ := x.obj.link.typ;
+				IF typ.form = Pointer THEN typ := typ.BaseTyp END;
+				tag.obj := DevCPE.TypeObj(typ)
+			ELSIF x.scale = 3 THEN (* interface method call *)
+				DevCPM.err(200)
+			END;
+			IF tag.mode = Con THEN
+				y.mode := Abs; y.offset := tag.offset; y.obj := tag.obj; y.scale := 0
+			ELSIF (x.obj.conval.setval * {absAttr, empAttr, extAttr} = {}) & ~(DevCPM.oberon IN DevCPM.options) THEN	(* final method *)
+				y.mode := Abs; y.offset := 0; y.obj := DevCPE.TypeObj(tag.typ); y.scale := 0;
+				IF tag.mode = Ind THEN	(* nil test *)
+					DevCPL486.MakeReg(r, AX, Int32); tag.offset := 0; DevCPL486.GenTest(r, tag)
+				END
+			ELSE
+				IF tag.mode = Reg THEN y.reg := tag.reg
+				ELSE GetReg(y, Pointer, {}, {}); DevCPL486.GenMove(tag, y)
+				END;
+				y.mode := Ind; y.offset := 0; y.scale := 0
+			END;
+			IF (tag.typ.sysflag = interface) & (y.mode = Ind) THEN y.offset := 4 * x.offset
+			ELSIF tag.typ.untagged THEN DevCPM.err(140)
+			ELSE
+				IF x.obj.link.typ.sysflag = interface THEN	(* correct method number *)
+					x.offset := numPreIntProc + NumOfIntProc(tag.typ) - 1 - x.offset
+				END;
+				INC(y.offset, Mth0Offset - 4 * x.offset)
+			END;
+			DevCPL486.GenCall(y); Free(y)
+		ELSIF x.mode = CProc THEN
+			IF x.obj.link # NIL THEN	(* tag = first param *)
+				IF x.obj.link.mode = VarPar THEN
+					GetAdr(tag, {}, wreg - {AX} + {stk, mem, con}); Free(tag)
+				ELSE 
+					(* Load(tag, {}, wreg - {AX} + {con}); Free(tag) *)
+					Result(x.obj.link, tag)	(* use result load for first parameter *)
+				END
+			END;
+			i := 1; n := ORD(x.obj.conval.ext^[0]);
+			WHILE i <= n DO DevCPL486.GenCode(ORD(x.obj.conval.ext^[i])); INC(i) END
+		ELSE	(* proc var *)
+			DevCPL486.GenCall(x); Free(x);
+			IF x.typ.sysflag = ccall THEN	(* remove parameters *)
+				p := x.typ.link; n := 0;
+				WHILE p # NIL DO
+					IF p.mode = VarPar THEN INC(n, 4)
+					ELSE INC(n, (p.typ.size + 3) DIV 4 * 4)
+					END;
+					p := p.link
+				END;
+				AdjustStack(n)
+			END;
+			x.typ := x.typ.BaseTyp
+		END;
+		IF procedureUsesFpu & (x.mode = XProc) & (x.obj.mnolev < 0) & (x.obj.mnolev > -128)
+				& ((x.obj.library # NIL) OR (DevCPT.GlbMod[-x.obj.mnolev].library # NIL)) THEN	(* restore fpu *)
+			InitFpu
+		END;
+		CheckReg;
+		IF x.typ.form = Int64 THEN
+			GetReg(x, Int32, {}, wreg - {AX}); GetReg(y, Int32, {}, wreg - {DX});
+			x.index := y.reg; x.form := Int64
+		ELSIF x.typ.form # NoTyp THEN GetReg(x, x.typ.form, {}, wreg - {AX} + {high})
+		END
+	END Call;
+	
+	PROCEDURE CopyDynArray* (adr: INTEGER; typ: DevCPT.Struct);	(* needs CX, SI, DI *)
+		VAR len, ptr, c, sp, src, dst: DevCPL486.Item; bt: DevCPT.Struct;
+	BEGIN
+		IF typ.untagged THEN DevCPM.err(-137) END;
+		ptr.mode := Ind; ptr.reg := BP; ptr.offset := adr+4; ptr.scale := 0; ptr.form := Pointer;
+		DevCPL486.MakeReg(len, CX, Int32); DevCPL486.MakeReg(sp, SP, Int32);
+		DevCPL486.MakeReg(src, SI, Int32); DevCPL486.MakeReg(dst, DI, Int32);
+		DevCPL486.GenMove(ptr, len); bt := typ.BaseTyp;
+		WHILE bt.comp = DynArr DO
+			INC(ptr.offset, 4); DevCPL486.GenMul(ptr, len, FALSE); bt := bt.BaseTyp
+		END;
+		ptr.offset := adr; DevCPL486.GenMove(ptr, src);
+		DevCPL486.MakeConst(c, bt.size, Int32); DevCPL486.GenMul(c, len, FALSE);
+		(* CX = length in bytes *)
+		StackAlloc; 
+		(* CX = length in 32bit words *)
+		DevCPL486.GenMove(sp, dst); DevCPL486.GenMove(dst, ptr);
+		DevCPL486.GenBlockMove(4, 0)  (* 32bit moves *)
+	END CopyDynArray;
+	
+	PROCEDURE Sort (VAR tab: ARRAY OF INTEGER; VAR n: INTEGER);
+		VAR i, j, x: INTEGER;
+	BEGIN
+		(* align *)
+		i := 1;
+		WHILE i < n DO
+			x := tab[i]; j := i-1;
+			WHILE (j >= 0) & (tab[j] < x) DO tab[j+1] := tab[j]; DEC(j) END;
+			tab[j+1] := x; INC(i)
+		END;
+		(* eliminate equals *)
+		i := 1; j := 1;
+		WHILE i < n DO
+			IF tab[i] # tab[i-1] THEN tab[j] := tab[i]; INC(j) END;
+			INC(i)
+		END;
+		n := j
+	END Sort;
+	
+	PROCEDURE FindPtrs (typ: DevCPT.Struct; adr: INTEGER; VAR num: INTEGER);
+		VAR fld: DevCPT.Object; btyp: DevCPT.Struct; i, n: INTEGER;
+	BEGIN
+		IF typ.form IN {Pointer, ProcTyp} THEN
+			IF num < MaxPtrs THEN ptrTab[num] := adr DIV 4 * 4 END;
+			INC(num);
+			IF adr MOD 4 # 0 THEN
+				IF num < MaxPtrs THEN ptrTab[num] := adr DIV 4 * 4 + 4 END;
+				INC(num)
+			END
+		ELSIF typ.comp = Record THEN
+			btyp := typ.BaseTyp;
+			IF btyp # NIL THEN FindPtrs(btyp, adr, num) END ;
+			fld := typ.link;
+			WHILE (fld # NIL) & (fld.mode = Fld) DO
+				IF (fld.name^ = DevCPM.HdPtrName) OR
+					(fld.name^ = DevCPM.HdUtPtrName) OR
+					(fld.name^ = DevCPM.HdProcName) THEN
+					FindPtrs(DevCPT.sysptrtyp, fld.adr + adr, num)
+				ELSE FindPtrs(fld.typ, fld.adr + adr, num)
+				END;
+				fld := fld.link
+			END
+		ELSIF typ.comp = Array THEN
+			btyp := typ.BaseTyp; n := typ.n;
+			WHILE btyp.comp = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END ;
+			IF (btyp.form = Pointer) OR (btyp.comp = Record) THEN
+				i := num; FindPtrs(btyp, adr, num);
+				IF num # i THEN i := 1;
+					WHILE (i < n) & (num <= MaxPtrs) DO
+						INC(adr, btyp.size); FindPtrs(btyp, adr, num); INC(i)
+					END
+				END
+			END
+		END
+	END FindPtrs;
+
+	PROCEDURE InitOutPar (par: DevCPT.Object; VAR zreg: DevCPL486.Item);
+		VAR x, y, c, len: DevCPL486.Item; lbl: DevCPL486.Label; size, s: INTEGER; bt: DevCPT.Struct;
+	BEGIN
+		x.mode := Ind; x.reg := BP; x.scale := 0; x.form := Pointer; x.offset := par.adr;
+		DevCPL486.MakeReg(y, DI, Int32);
+		IF par.typ.comp # DynArr THEN
+			DevCPL486.GenMove(x, y);
+			lbl := DevCPL486.NewLbl;
+			IF ODD(par.sysflag DIV nilBit) THEN
+				DevCPL486.GenComp(zreg, y);
+				DevCPL486.GenJump(ccE, lbl, TRUE)
+			END;
+			size := par.typ.size;
+			IF size <= 16 THEN
+				x.mode := Ind; x.reg := DI; x.form := Int32; x.offset := 0;
+				WHILE size > 0 DO
+					IF size = 1 THEN x.form := Int8; s := 1
+					ELSIF size = 2 THEN x.form := Int16; s := 2
+					ELSE x.form := Int32; s := 4
+					END;
+					zreg.form := x.form; DevCPL486.GenMove(zreg, x); INC(x.offset, s); DEC(size, s)
+				END;
+				zreg.form := Int32
+			ELSE
+				DevCPL486.GenBlockStore(1, size)
+			END;
+			DevCPL486.SetLabel(lbl)
+		ELSIF initializeDyn & ~par.typ.untagged THEN	(* untagged open arrays not initialized !!! *)
+			DevCPL486.GenMove(x, y);
+			DevCPL486.MakeReg(len, CX, Int32);
+			INC(x.offset, 4); DevCPL486.GenMove(x, len); (* first len *)
+			bt := par.typ.BaseTyp;
+			WHILE bt.comp = DynArr DO
+				INC(x.offset, 4); DevCPL486.GenMul(x, len, FALSE); bt := bt.BaseTyp
+			END;
+			size := bt.size;
+			IF size MOD 4 = 0 THEN size := size DIV 4; s := 4
+			ELSIF size MOD 2 = 0 THEN size := size DIV 2; s := 2
+			ELSE s := 1
+			END;
+			DevCPL486.MakeConst(c, size, Int32); DevCPL486.GenMul(c, len, FALSE);
+			DevCPL486.GenBlockStore(s, 0)
+		END
+	END InitOutPar;
+
+	PROCEDURE AllocAndInitAll (proc: DevCPT.Object; adr, size: INTEGER; VAR nofptrs: INTEGER);
+		VAR x, y, z, zero: DevCPL486.Item; par: DevCPT.Object; op: INTEGER;
+	BEGIN
+		op := 0; par := proc.link;
+		WHILE par # NIL DO	(* count out parameters [with COM pointers] *)
+			IF (par.mode = VarPar) & (par.vis = outPar) & (initializeOut OR ContainsIPtrs(par.typ)) THEN INC(op) END;
+			par := par.link
+		END;
+		DevCPL486.MakeConst(zero, 0, Int32);
+		IF (op = 0) & (size <= 8) THEN	(* use PUSH 0 *)
+			WHILE size > 0 DO DevCPL486.GenPush(zero); DEC(size, 4) END
+		ELSE
+			DevCPL486.MakeReg(z, AX, Int32); DevCPL486.GenMove(zero, z);
+			IF size <= 32 THEN	(* use PUSH reg *)
+				WHILE size > 0 DO DevCPL486.GenPush(z); DEC(size, 4) END
+			ELSE	(* use string store *)
+				AdjustStack(-size);
+				DevCPL486.MakeReg(x, SP, Int32); DevCPL486.MakeReg(y, DI, Int32); DevCPL486.GenMove(x, y);
+				DevCPL486.GenBlockStore(1, size)
+			END;
+			IF op > 0 THEN
+				par := proc.link;
+				WHILE par # NIL DO	(* init out parameters [with COM pointers] *)
+					IF (par.mode = VarPar) & (par.vis = outPar) & (initializeOut OR ContainsIPtrs(par.typ)) THEN InitOutPar(par, z) END;
+					par := par.link
+				END
+			END
+		END
+	END AllocAndInitAll;
+	
+	PROCEDURE AllocAndInitPtrs1 (proc: DevCPT.Object; adr, size: INTEGER; VAR nofptrs: INTEGER);	(* needs AX *)
+		VAR i, base, a, gaps: INTEGER; x, z: DevCPL486.Item; obj: DevCPT.Object;
+	BEGIN
+		IF ptrinit & (proc.scope # NIL) THEN
+			nofptrs := 0; obj := proc.scope.scope;	(* local variables *)
+			WHILE (obj # NIL) & (nofptrs <= MaxPtrs) DO
+				FindPtrs(obj.typ, obj.adr, nofptrs);
+				obj := obj.link
+			END;
+			IF (nofptrs > 0) & (nofptrs <= MaxPtrs) THEN
+				base := proc.conval.intval2;
+				Sort(ptrTab, nofptrs); i := 0; a := size + base; gaps := 0;
+				WHILE i < nofptrs DO
+					DEC(a, 4);
+					IF a # ptrTab[i] THEN a := ptrTab[i]; INC(gaps) END;
+					INC(i)
+				END;
+				IF a # base THEN INC(gaps) END;
+				IF (gaps <= (nofptrs + 1) DIV 2) & (size < stackAllocLimit) THEN
+					DevCPL486.MakeConst(z, 0, Pointer);
+					IF (nofptrs > 4) THEN x := z; DevCPL486.MakeReg(z, AX, Int32); DevCPL486.GenMove(x, z) END;
+					i := 0; a := size + base;
+					WHILE i < nofptrs DO
+						DEC(a, 4);
+						IF a # ptrTab[i] THEN AdjustStack(ptrTab[i] - a); a := ptrTab[i] END;
+						DevCPL486.GenPush(z); INC(i)
+					END;
+					IF a # base THEN AdjustStack(base - a) END
+				ELSE
+					AdjustStack(-size);
+					DevCPL486.MakeConst(x, 0, Pointer); DevCPL486.MakeReg(z, AX, Int32); DevCPL486.GenMove(x, z);
+					x.mode := Ind; x.reg := BP; x.scale := 0; x.form := Pointer; i := 0; 
+					WHILE i < nofptrs DO
+						x.offset := ptrTab[i]; DevCPL486.GenMove(z, x); INC(i)
+					END
+				END
+			ELSE
+				AdjustStack(-size)
+			END
+		ELSE
+			nofptrs := 0;
+			AdjustStack(-size)
+		END
+	END AllocAndInitPtrs1;
+
+	PROCEDURE InitPtrs2 (proc: DevCPT.Object; adr, size, nofptrs: INTEGER);	(* needs AX, CX, DI *)
+		VAR x, y, z, zero: DevCPL486.Item; obj: DevCPT.Object; zeroed: BOOLEAN; i: INTEGER; lbl: DevCPL486.Label;
+	BEGIN
+		IF ptrinit THEN
+			zeroed := FALSE; DevCPL486.MakeConst(zero, 0, Pointer);
+			IF nofptrs > MaxPtrs THEN
+				DevCPL486.MakeReg(z, AX, Int32); DevCPL486.GenMove(zero, z); zeroed := TRUE;
+				x.mode := Ind; x.reg := BP; x.scale := 0; x.form := Pointer; x.offset := adr;
+				DevCPL486.MakeReg(y, DI, Int32); DevCPL486.GenLoadAdr(x, y);
+				DevCPL486.GenStrStore(size)
+			END;
+			obj := proc.link;	(* parameters *)
+			WHILE obj # NIL DO
+				IF (obj.mode = VarPar) & (obj.vis = outPar) THEN
+					nofptrs := 0;
+					IF obj.typ.comp = DynArr THEN	(* currently not initialized *)
+					ELSE FindPtrs(obj.typ, 0, nofptrs)
+					END;
+					IF nofptrs > 0 THEN
+						IF ~zeroed THEN
+							DevCPL486.MakeReg(z, AX, Int32); DevCPL486.GenMove(zero, z); zeroed := TRUE
+						END;
+						x.mode := Ind; x.reg := BP; x.scale := 0; x.form := Pointer; x.offset := obj.adr;
+						DevCPL486.MakeReg(y, DI, Int32); DevCPL486.GenMove(x, y);
+						IF ODD(obj.sysflag DIV nilBit) THEN
+							DevCPL486.GenComp(zero, y);
+							lbl := DevCPL486.NewLbl; DevCPL486.GenJump(ccE, lbl, TRUE)
+						END;
+						IF nofptrs > MaxPtrs THEN
+							DevCPL486.GenStrStore(obj.typ.size)
+						ELSE
+							Sort(ptrTab, nofptrs);
+							x.reg := DI; i := 0;
+							WHILE i < nofptrs DO
+								x.offset := ptrTab[i]; DevCPL486.GenMove(z, x); INC(i)
+							END
+						END;
+						IF ODD(obj.sysflag DIV nilBit) THEN DevCPL486.SetLabel(lbl) END
+					END
+				END;
+				obj := obj.link
+			END
+		END
+	END InitPtrs2;
+	
+	PROCEDURE NeedOutPtrInit (proc: DevCPT.Object): BOOLEAN;
+		VAR obj: DevCPT.Object; nofptrs: INTEGER;
+	BEGIN
+		IF ptrinit THEN
+			obj := proc.link;
+			WHILE obj # NIL DO
+				IF (obj.mode = VarPar) & (obj.vis = outPar) THEN
+					nofptrs := 0;
+					IF obj.typ.comp = DynArr THEN	(* currently not initialized *)
+					ELSE FindPtrs(obj.typ, 0, nofptrs)
+					END;
+					IF nofptrs > 0 THEN RETURN TRUE END
+				END;
+				obj := obj.link
+			END
+		END;
+		RETURN FALSE
+	END NeedOutPtrInit;
+	
+	PROCEDURE Enter* (proc: DevCPT.Object; empty, useFpu: BOOLEAN);
+		VAR sp, fp, r, r1: DevCPL486.Item; par: DevCPT.Object; adr, size, np: INTEGER;
+	BEGIN
+		procedureUsesFpu := useFpu;
+		SetReg({AX, CX, DX, SI, DI});
+		DevCPL486.MakeReg(fp, BP, Pointer); DevCPL486.MakeReg(sp, SP, Pointer);
+		IF proc # NIL THEN (* enter proc *)
+			DevCPL486.SetLabel(proc.adr);
+			IF (~empty OR NeedOutPtrInit(proc)) & (proc.sysflag # noframe) THEN
+				DevCPL486.GenPush(fp);
+				DevCPL486.GenMove(sp, fp);
+				adr := proc.conval.intval2; size := -adr;
+				IF isGuarded IN proc.conval.setval THEN
+					DevCPL486.MakeReg(r, BX, Pointer); DevCPL486.GenPush(r);
+					DevCPL486.MakeReg(r, DI, Pointer); DevCPL486.GenPush(r);
+					DevCPL486.MakeReg(r, SI, Pointer); DevCPL486.GenPush(r);
+					r1.mode := Con; r1.form := Int32; r1.offset := proc.conval.intval - 8; r1.obj := NIL;
+					DevCPL486.GenPush(r1);
+					intHandler.used := TRUE;
+					r1.mode := Con; r1.form := Int32; r1.offset := 0; r1.obj := intHandler;
+					DevCPL486.GenPush(r1);
+					r1.mode := Abs; r1.form := Int32; r1.offset := 0; r1.scale := 0; r1.obj := NIL;
+					DevCPL486.GenCode(64H); DevCPL486.GenPush(r1);
+					DevCPL486.GenCode(64H); DevCPL486.GenMove(sp, r1);
+					DEC(size, 24)
+				ELSE
+					IF imVar IN proc.conval.setval THEN	(* set down pointer *)
+						DevCPL486.MakeReg(r, BX, Pointer); DevCPL486.GenPush(r); DEC(size, 4)
+					END;
+					IF isCallback IN proc.conval.setval THEN
+						DevCPL486.MakeReg(r, DI, Pointer); DevCPL486.GenPush(r);
+						DevCPL486.MakeReg(r, SI, Pointer); DevCPL486.GenPush(r); DEC(size, 8)
+					END
+				END;
+				ASSERT(size >= 0);
+				IF initializeAll THEN
+					AllocAndInitAll(proc, adr, size, np)
+				ELSE
+					AllocAndInitPtrs1(proc, adr, size, np);	(* needs AX *)
+					InitPtrs2(proc, adr, size, np);	(* needs AX, CX, DI *)
+				END;
+				par := proc.link;	(* parameters *)
+				WHILE par # NIL DO
+					IF (par.mode = Var) & (par.typ.comp = DynArr) THEN 
+						CopyDynArray(par.adr, par.typ)
+					END;
+					par := par.link
+				END;
+				IF imVar IN proc.conval.setval THEN
+					DevCPL486.MakeReg(r, BX, Pointer); DevCPL486.GenMove(fp, r)
+				END
+			END
+		ELSIF ~empty THEN (* enter module *)
+			DevCPL486.GenPush(fp);
+			DevCPL486.GenMove(sp, fp);
+			DevCPL486.MakeReg(r, DI, Int32); DevCPL486.GenPush(r);
+			DevCPL486.MakeReg(r, SI, Int32); DevCPL486.GenPush(r)
+		END;
+		IF useFpu THEN InitFpu END
+	END Enter;
+	
+	PROCEDURE Exit* (proc: DevCPT.Object; empty: BOOLEAN);
+		VAR sp, fp, r, x: DevCPL486.Item; mode: SHORTINT; size: INTEGER;
+	BEGIN
+		DevCPL486.MakeReg(sp, SP, Pointer); DevCPL486.MakeReg(fp, BP, Pointer);
+		IF proc # NIL THEN (* exit proc *)
+			IF proc.sysflag # noframe THEN
+				IF ~empty OR NeedOutPtrInit(proc) THEN
+					IF isGuarded IN proc.conval.setval THEN	(* remove exception frame *)
+						x.mode := Ind; x.reg := BP; x.offset := -24; x.scale := 0; x.form := Int32;
+						DevCPL486.MakeReg(r, CX, Int32); DevCPL486.GenMove(x, r);
+						x.mode := Abs; x.offset := 0; x.scale := 0; x.form := Int32; x.obj := NIL;
+						DevCPL486.GenCode(64H); DevCPL486.GenMove(r, x);
+						size := 12
+					ELSE
+						size := 0;
+						IF imVar IN proc.conval.setval THEN INC(size, 4) END;
+						IF isCallback IN proc.conval.setval THEN INC(size, 8) END
+					END;
+					IF size > 0 THEN
+						x.mode := Ind; x.reg := BP; x.offset := -size; x.scale := 0; x.form := Int32;
+						DevCPL486.GenLoadAdr(x, sp);
+						IF size > 4 THEN
+							DevCPL486.MakeReg(r, SI, Int32); DevCPL486.GenPop(r);
+							DevCPL486.MakeReg(r, DI, Int32); DevCPL486.GenPop(r)
+						END;
+						IF size # 8 THEN
+							DevCPL486.MakeReg(r, BX, Int32); DevCPL486.GenPop(r)
+						END
+					ELSE
+						DevCPL486.GenMove(fp, sp)
+					END;
+					DevCPL486.GenPop(fp)
+				END;
+				IF proc.sysflag = ccall THEN DevCPL486.GenReturn(0)
+				ELSE DevCPL486.GenReturn(proc.conval.intval - 8)
+				END
+			END
+		ELSE (* exit module *)
+			IF ~empty THEN
+				DevCPL486.MakeReg(r, SI, Int32); DevCPL486.GenPop(r);
+				DevCPL486.MakeReg(r, DI, Int32); DevCPL486.GenPop(r);
+				DevCPL486.GenMove(fp, sp); DevCPL486.GenPop(fp)
+			END;
+			DevCPL486.GenReturn(0)
+		END
+	END Exit;
+	
+	PROCEDURE InstallStackAlloc*;
+		VAR name: ARRAY 32 OF SHORTCHAR; ax, cx, sp, c, x: DevCPL486.Item; l1, l2: DevCPL486.Label;
+	BEGIN
+		IF stkAllocLbl # DevCPL486.NewLbl THEN
+			DevCPL486.SetLabel(stkAllocLbl);
+			DevCPL486.MakeReg(ax, AX, Int32);
+			DevCPL486.MakeReg(cx, CX, Int32);
+			DevCPL486.MakeReg(sp, SP, Int32);
+			DevCPL486.GenPush(ax);
+			DevCPL486.MakeConst(c, -5, Int32); DevCPL486.GenAdd(c, cx, FALSE);
+			l1 := DevCPL486.NewLbl; DevCPL486.GenJump(ccNS, l1, TRUE);
+			DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenMove(c, cx);
+			DevCPL486.SetLabel(l1);
+			DevCPL486.MakeConst(c, -4, Int32); DevCPL486.GenAnd(c, cx);
+			DevCPL486.GenMove(cx, ax);
+			DevCPL486.MakeConst(c, 4095, Int32); DevCPL486.GenAnd(c, ax);
+			DevCPL486.GenSub(ax, sp, FALSE);
+			DevCPL486.GenMove(cx, ax);
+			DevCPL486.MakeConst(c, 12, Int32); DevCPL486.GenShiftOp(SHR, c, ax);
+			l2 := DevCPL486.NewLbl; DevCPL486.GenJump(ccE, l2, TRUE);
+			l1 := DevCPL486.NewLbl; DevCPL486.SetLabel(l1);
+			DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenPush(c);
+			DevCPL486.MakeConst(c, 4092, Int32); DevCPL486.GenSub(c, sp, FALSE);
+			DevCPL486.MakeConst(c, -1, Int32); DevCPL486.GenAdd(c, ax, FALSE);
+			DevCPL486.GenJump(ccNE, l1, TRUE);
+			DevCPL486.SetLabel(l2);
+			DevCPL486.MakeConst(c, 8, Int32); DevCPL486.GenAdd(c, cx, FALSE);
+			x.mode := Ind; x.form := Int32; x.offset := -4; x.index := CX; x.reg := SP; x.scale := 1;
+			DevCPL486.GenMove(x, ax);
+			DevCPL486.GenPush(ax);
+			DevCPL486.GenMove(x, ax);
+			DevCPL486.MakeConst(c, 2, Int32); DevCPL486.GenShiftOp(SHR, c, cx);
+			DevCPL486.GenReturn(0);
+			name := "$StackAlloc"; DevCPE.OutRefName(name);
+		END
+	END InstallStackAlloc;
+
+	PROCEDURE Trap* (n: INTEGER);
+	BEGIN
+		DevCPL486.GenAssert(ccNever, n)
+	END Trap;
+	
+	PROCEDURE Jump* (VAR L: DevCPL486.Label);
+	BEGIN
+		DevCPL486.GenJump(ccAlways, L, FALSE)
+	END Jump;
+
+	PROCEDURE JumpT* (VAR x: DevCPL486.Item; VAR L: DevCPL486.Label);
+	BEGIN
+		DevCPL486.GenJump(x.offset, L, FALSE);
+	END JumpT; 
+	
+	PROCEDURE JumpF* (VAR x: DevCPL486.Item; VAR L: DevCPL486.Label);
+	BEGIN
+		DevCPL486.GenJump(Inverted(x.offset), L, FALSE);
+	END JumpF;
+	
+	PROCEDURE CaseTableJump* (VAR x: DevCPL486.Item; low, high: INTEGER; VAR else: DevCPL486.Label);
+		VAR c: DevCPL486.Item; n: INTEGER;
+	BEGIN
+		n := high - low + 1;
+		DevCPL486.MakeConst(c, low, Int32); DevCPL486.GenSub(c, x, FALSE);
+		DevCPL486.MakeConst(c, n, Int32); DevCPL486.GenComp(c, x);
+		DevCPL486.GenJump(ccAE, else, FALSE);
+		DevCPL486.GenCaseJump(x)
+	END CaseTableJump;
+	
+	PROCEDURE CaseJump* (VAR x: DevCPL486.Item; low, high: INTEGER; VAR this, else: DevCPL486.Label; tree, first: BOOLEAN);
+		VAR c: DevCPL486.Item;
+	BEGIN
+		IF high = low THEN
+			DevCPL486.MakeConst(c, low, Int32); DevCPL486.GenComp(c, x);
+			IF tree THEN DevCPL486.GenJump(ccG, else, FALSE) END;
+			DevCPL486.GenJump(ccE, this, FALSE)
+		ELSIF first THEN
+			DevCPL486.MakeConst(c, low, Int32); DevCPL486.GenComp(c, x);
+			DevCPL486.GenJump(ccL, else, FALSE);
+			DevCPL486.MakeConst(c, high, Int32); DevCPL486.GenComp(c, x);
+			DevCPL486.GenJump(ccLE, this, FALSE);
+		ELSE
+			DevCPL486.MakeConst(c, high, Int32); DevCPL486.GenComp(c, x);
+			DevCPL486.GenJump(ccG, else, FALSE);
+			DevCPL486.MakeConst(c, low, Int32); DevCPL486.GenComp(c, x);
+			DevCPL486.GenJump(ccGE, this, FALSE);
+		END
+	END CaseJump;
+
+BEGIN
+	imLevel[0] := 0
+END DevCPC486.

BlackBox/Dev/Mod/CPE.txt

@@ -0,0 +1,1105 @@
+MODULE DevCPE;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPE.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, Dates, DevCPM, DevCPT;
+
+
+	CONST
+		(* item base modes (=object modes) *)
+		Var = 1; VarPar = 2; Con = 3; LProc = 6; XProc = 7; CProc = 9; IProc = 10; TProc = 13;
+	
+		(* structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18; Guid = 23;
+		
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+		
+		(* object modes *)
+		Fld = 4; Typ = 5; Head = 12;
+		
+		(* module visibility of objects *)
+		internal = 0; external = 1; externalR = 2; inPar = 3; outPar = 4;
+
+		(* history of imported objects *)
+		inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5;
+		
+		(* attribute flags (attr.adr, struct.attribute, proc.conval.setval)*)
+		newAttr = 16; absAttr = 17; limAttr = 18; empAttr = 19; extAttr = 20;
+		
+		(* meta interface consts *)
+		mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
+		mBool = 1; mChar8 = 2; mChar16 = 3; mInt8 = 4; mInt16 = 5; mInt32 = 6;
+		mReal32 = 7; mReal64 = 8; mSet = 9; mInt64 = 10; mAnyRec = 11; mAnyPtr = 12; mSysPtr = 13;
+		mProctyp = 0; mRecord = 1; mArray = 2; mPointer = 3;
+		mInternal = 1; mReadonly = 2; mPrivate = 3; mExported = 4;
+		mValue = 10; mInPar = 11; mOutPar = 12; mVarPar = 13;
+		mInterface = 32; mGuid = 33; mResult = 34;
+
+		(* sysflag *)
+		untagged = 1; noAlign = 3; union = 7; interface = 10;
+		
+		(* fixup types *)
+		absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; short = 105;
+		
+		(* kernel flags *)
+		iptrs = 30;
+		
+		expAllFields = TRUE;
+		
+		(* implementation restrictions *)
+		CodeBlocks = 512;
+		CodeLength = 16384;
+		MaxNameTab = 800000H;
+		
+		useAllRef = FALSE;
+		outSignatures = TRUE;
+	
+	TYPE
+		CodeBlock = POINTER TO ARRAY CodeLength OF SHORTCHAR;
+	
+	VAR
+		pc*: INTEGER;
+		dsize*: INTEGER;	(* global data size *)
+		KNewRec*, KNewArr*: DevCPT.Object;
+		closeLbl*: INTEGER;
+		CaseLinks*: DevCPT.LinkList;
+		
+		processor: INTEGER;
+		bigEndian: BOOLEAN;
+		procVarIndirect: BOOLEAN;
+		idx8, idx16, idx32, idx64, namex, nofptrs, headSize: INTEGER;
+		Const8, Const16, Const32, Const64, Code, Data, Meta, Mod, Proc, nameList, descList, untgd: DevCPT.Object;
+		outRef, outAllRef, outURef, outSrc, outObj: BOOLEAN;
+		codePos, srcPos: INTEGER;
+		options: SET;
+		code: ARRAY CodeBlocks OF CodeBlock;
+		actual: CodeBlock;
+		actIdx, blkIdx: INTEGER;
+		CodeOvF: BOOLEAN;
+		zero: ARRAY 16 OF SHORTCHAR;	(* all 0X *)
+		imports: INTEGER;
+		dllList, dllLast: DevCPT.Object;
+		
+		
+	PROCEDURE GetLongWords* (con: DevCPT.Const; OUT hi, low: INTEGER);
+		CONST N = 4294967296.0; (* 2^32 *)
+		VAR rh, rl: REAL;
+	BEGIN
+		rl := con.intval; rh := con.realval / N;
+		IF rh >= MAX(INTEGER) + 1.0 THEN rh := rh - 1; rl := rl + N
+		ELSIF rh < MIN(INTEGER) THEN rh := rh + 1; rl := rl - N
+		END;
+		hi := SHORT(ENTIER(rh));
+		rl := rl + (rh - hi) * N;
+		IF rl < 0 THEN hi := hi - 1; rl := rl + N
+		ELSIF rl >= N THEN hi := hi + 1; rl := rl - N
+		END;
+		IF rl >= MAX(INTEGER) + 1.0 THEN rl := rl - N END;
+		low := SHORT(ENTIER(rl))
+(*
+		hi := SHORT(ENTIER((con.realval + con.intval) / 4294967296.0));
+		r := con.realval + con.intval - hi * 4294967296.0;
+		IF r > MAX(INTEGER) THEN r := r - 4294967296.0 END;
+		low := SHORT(ENTIER(r))
+*)
+	END GetLongWords;
+	
+	PROCEDURE GetRealWord* (con: DevCPT.Const; OUT x: INTEGER);
+		VAR r: SHORTREAL;
+	BEGIN
+		r := SHORT(con.realval); x := SYSTEM.VAL(INTEGER, r)
+	END GetRealWord;
+		
+	PROCEDURE GetRealWords* (con: DevCPT.Const; OUT hi, low: INTEGER);
+		TYPE A = ARRAY 2 OF INTEGER;
+		VAR a: A;
+	BEGIN
+		a := SYSTEM.VAL(A, con.realval);
+		IF DevCPM.LEHost THEN hi := a[1]; low := a[0] ELSE hi := a[0]; low := a[1] END
+	END GetRealWords;
+		
+	PROCEDURE IsSame (x, y: REAL): BOOLEAN;
+	BEGIN
+		RETURN  (x = y) & ((x #  0.) OR (1. / x = 1. / y))
+	END IsSame;
+	
+	PROCEDURE AllocConst* (con: DevCPT.Const; form: BYTE; VAR obj: DevCPT.Object; VAR adr: INTEGER);
+		VAR c: DevCPT.Const;
+	BEGIN
+		INCL(con.setval, form);
+		CASE form OF
+		| String8:
+			obj := Const8; c := obj.conval;
+			WHILE (c # NIL) & ((con.setval # c.setval) OR (con.intval2 # c.intval2) OR (con.ext^ # c.ext^)) DO c := c.link END;
+			IF c = NIL THEN adr := idx8; INC(idx8, (con.intval2 + 3) DIV 4 * 4) END
+		| String16:
+			obj := Const16; c := obj.conval;
+			WHILE (c # NIL) & ((con.setval # c.setval) OR (con.intval2 # c.intval2) OR (con.ext^ # c.ext^)) DO c := c.link END;
+			IF c = NIL THEN adr := idx16; INC(idx16, (con.intval2 + 1) DIV 2 * 4) END
+		| Int64:
+			obj := Const64; c := obj.conval;
+			WHILE (c # NIL) & ((con.setval # c.setval) OR (con.intval # c.intval2) OR (con.realval # c.realval)) DO
+				c := c.link
+			END;
+			IF c = NIL THEN con.intval2 := con.intval; adr := idx64; INC(idx64, 8) END
+		| Real32:
+			obj := Const32; c := obj.conval;
+			WHILE (c # NIL) & ((con.setval # c.setval) OR ~IsSame(con.realval, c.realval)) DO c := c.link END;
+			IF c = NIL THEN adr := idx32; INC(idx32, 4) END
+		| Real64:
+			obj := Const64; c := obj.conval;
+			WHILE (c # NIL) & ((con.setval # c.setval) OR ~IsSame(con.realval, c.realval)) DO c := c.link END;
+			IF c = NIL THEN adr := idx64; INC(idx64, 8) END
+		| Guid:
+			obj := Const32; c := obj.conval;
+			WHILE (c # NIL) & ((con.setval # c.setval) OR (con.intval2 # c.intval2) OR (con.ext^ # c.ext^)) DO c := c.link END;
+			IF c = NIL THEN adr := idx32; INC(idx32, 16) END
+		END;
+		IF c = NIL THEN con.link := obj.conval; obj.conval := con ELSE adr := c.intval END;
+		con.intval := adr
+	END AllocConst;
+
+
+	PROCEDURE AllocTypDesc* (typ: DevCPT.Struct);	 (* typ.comp = Record *)
+		VAR obj: DevCPT.Object; name: DevCPT.Name;
+	BEGIN
+		IF typ.strobj = NIL THEN
+			name := "@"; DevCPT.Insert(name, obj); obj.name := DevCPT.null;	(* avoid err 1 *)
+			obj.mode := Typ; obj.typ := typ; typ.strobj := obj
+		END
+	END AllocTypDesc; 
+
+
+	PROCEDURE PutByte* (a, x: INTEGER);
+	BEGIN
+		code[a DIV CodeLength]^[a MOD CodeLength] := SHORT(CHR(x MOD 256))
+	END PutByte;
+	
+	PROCEDURE PutShort* (a, x: INTEGER);
+	BEGIN
+		IF bigEndian THEN
+			PutByte(a, x DIV 256); PutByte(a + 1, x)
+		ELSE
+			PutByte(a, x); PutByte(a + 1, x DIV 256)
+		END
+	END PutShort;
+	
+	PROCEDURE PutWord* (a, x: INTEGER);
+	BEGIN
+		IF bigEndian THEN
+			PutByte(a, x DIV 1000000H); PutByte(a + 1, x DIV 10000H);
+			PutByte(a + 2, x DIV 256); PutByte(a + 3, x)
+		ELSE
+			PutByte(a, x); PutByte(a + 1, x DIV 256);
+			PutByte(a + 2, x DIV 10000H); PutByte(a + 3, x DIV 1000000H)
+		END
+	END PutWord;
+	
+	PROCEDURE ThisByte* (a: INTEGER): INTEGER;
+	BEGIN
+		RETURN ORD(code[a DIV CodeLength]^[a MOD CodeLength])
+	END ThisByte;
+	
+	PROCEDURE ThisShort* (a: INTEGER): INTEGER;
+	BEGIN
+		IF bigEndian THEN
+			RETURN ThisByte(a) * 256 + ThisByte(a+1)
+		ELSE
+			RETURN ThisByte(a+1) * 256 + ThisByte(a)
+		END
+	END ThisShort;
+	
+	PROCEDURE ThisWord* (a: INTEGER): INTEGER;
+	BEGIN
+		IF bigEndian THEN
+			RETURN ((ThisByte(a) * 256 + ThisByte(a+1)) * 256 + ThisByte(a+2)) * 256 + ThisByte(a+3)
+		ELSE
+			RETURN ((ThisByte(a+3) * 256 + ThisByte(a+2)) * 256 + ThisByte(a+1)) * 256 + ThisByte(a)
+		END
+	END ThisWord;
+	
+	PROCEDURE GenByte* (x: INTEGER);
+	BEGIN
+		IF actIdx >= CodeLength THEN
+			IF blkIdx < CodeBlocks THEN
+				NEW(actual); code[blkIdx] := actual; INC(blkIdx); actIdx := 0
+			ELSE
+				IF ~CodeOvF THEN DevCPM.err(210); CodeOvF := TRUE END;
+				actIdx := 0; pc := 0
+			END
+		END;
+		actual^[actIdx] := SHORT(CHR(x MOD 256)); INC(actIdx); INC(pc)
+	END GenByte;
+	
+	PROCEDURE GenShort* (x: INTEGER);
+	BEGIN
+		IF bigEndian THEN
+			GenByte(x DIV 256); GenByte(x)
+		ELSE
+			GenByte(x); GenByte(x DIV 256)
+		END
+	END GenShort;
+	
+	PROCEDURE GenWord* (x: INTEGER);
+	BEGIN
+		IF bigEndian THEN
+			GenByte(x DIV 1000000H); GenByte(x DIV 10000H); GenByte(x DIV 256); GenByte(x)
+		ELSE
+			GenByte(x); GenByte(x DIV 256); GenByte(x DIV 10000H); GenByte(x DIV 1000000H)
+		END
+	END GenWord;
+	
+	PROCEDURE WriteCode;
+		VAR i, j, k, n: INTEGER; b: CodeBlock;
+	BEGIN
+		j := 0; k := 0;
+		WHILE j < pc DO
+			n := pc - j; i := 0; b := code[k];
+			IF n > CodeLength THEN n := CodeLength END;
+			WHILE i < n DO DevCPM.ObjW(b^[i]); INC(i) END;
+			INC(j, n); INC(k)
+		END
+	END WriteCode;
+
+
+	PROCEDURE OffsetLink* (obj: DevCPT.Object; offs: INTEGER): DevCPT.LinkList;
+		VAR link: DevCPT.LinkList; m: DevCPT.Object;
+	BEGIN
+		ASSERT((obj.mode # Typ) OR (obj.typ # DevCPT.int32typ));
+		ASSERT((obj.mode # Typ) OR (obj.typ # DevCPT.iunktyp) & (obj.typ # DevCPT.guidtyp));
+		IF obj.mnolev >= 0 THEN	(* not imported *)
+			CASE obj.mode OF
+			| Typ: IF obj.links = NIL THEN obj.link := descList; descList := obj END
+			| TProc: IF obj.adr = -1 THEN obj := obj.nlink ELSE offs := offs + obj.adr; obj := Code END
+			| Var: offs := offs + dsize; obj := Data
+			| Con, IProc, XProc, LProc:
+			END
+		ELSIF obj.mode = Typ THEN
+			IF obj.typ.untagged THEN	(* add desc for imported untagged types *)
+				IF obj.links = NIL THEN obj.link := descList; descList := obj END
+			ELSE
+				m := DevCPT.GlbMod[-obj.mnolev];
+				IF m.library # NIL THEN RETURN NIL END	(* type import from dll *)
+			END
+		END;
+		link := obj.links;
+		WHILE (link # NIL) & (link.offset # offs) DO link := link.next END;
+		IF link = NIL THEN
+			NEW(link); link.offset := offs; link.linkadr := 0;
+			link.next := obj.links; obj.links := link
+		END;
+		RETURN link
+	END OffsetLink;
+
+
+	PROCEDURE TypeObj* (typ: DevCPT.Struct): DevCPT.Object;
+		VAR obj: DevCPT.Object;
+	BEGIN
+		obj := typ.strobj;
+		IF obj = NIL THEN
+			obj := DevCPT.NewObj(); obj.leaf := TRUE; obj.mnolev := 0;
+			obj.name := DevCPT.null; obj.mode := Typ; obj.typ := typ; typ.strobj := obj
+		END;
+		RETURN obj
+	END TypeObj;
+
+
+	PROCEDURE Align (n: INTEGER);
+		VAR p: INTEGER;
+	BEGIN
+		p := DevCPM.ObjLen();
+		DevCPM.ObjWBytes(zero, (-p) MOD n)
+	END Align;
+	
+	PROCEDURE OutName (VAR name: ARRAY OF SHORTCHAR);
+		VAR ch: SHORTCHAR; i: SHORTINT;
+	BEGIN i := 0;
+		REPEAT ch := name[i]; DevCPM.ObjW(ch); INC(i) UNTIL ch = 0X
+	END OutName;
+	
+	PROCEDURE Out2 (x: INTEGER);	(* byte ordering must correspond to target machine *)
+	BEGIN
+		IF bigEndian THEN
+			DevCPM.ObjW(SHORT(CHR(x DIV 256))); DevCPM.ObjW(SHORT(CHR(x)))
+		ELSE
+			DevCPM.ObjW(SHORT(CHR(x))); DevCPM.ObjW(SHORT(CHR(x DIV 256)))
+		END
+	END Out2;
+	
+	PROCEDURE Out4 (x: INTEGER);	(* byte ordering must correspond to target machine *)
+	BEGIN
+		IF bigEndian THEN
+			DevCPM.ObjW(SHORT(CHR(x DIV 1000000H))); DevCPM.ObjW(SHORT(CHR(x DIV 10000H)));
+			DevCPM.ObjW(SHORT(CHR(x DIV 256))); DevCPM.ObjW(SHORT(CHR(x)))
+		ELSE
+			DevCPM.ObjWLInt(x)
+		END
+	END Out4;
+
+	PROCEDURE OutReference (obj: DevCPT.Object; offs, typ: INTEGER);
+		VAR link: DevCPT.LinkList;
+	BEGIN
+		link := OffsetLink(obj, offs);
+		IF link # NIL THEN
+			Out4(typ * 1000000H + link.linkadr MOD 1000000H);
+			link.linkadr := -(DevCPM.ObjLen() - headSize - 4)
+		ELSE Out4(0)
+		END
+	END OutReference;
+	
+	PROCEDURE FindPtrs (typ: DevCPT.Struct; adr: INTEGER; ip: BOOLEAN; VAR num: INTEGER);
+		VAR fld: DevCPT.Object; btyp: DevCPT.Struct; i, n: INTEGER;
+	BEGIN
+		IF typ.form = Pointer THEN
+			IF ip & (typ.sysflag = interface)
+				OR ~ip & ~typ.untagged THEN Out4(adr); INC(num) END
+		ELSIF (typ.comp = Record) & (typ.sysflag # union) THEN
+			btyp := typ.BaseTyp;
+			IF btyp # NIL THEN FindPtrs(btyp, adr, ip, num) END ;
+			fld := typ.link;
+			WHILE (fld # NIL) & (fld.mode = Fld) DO
+				IF ip & (fld.name^ = DevCPM.HdUtPtrName) & (fld.sysflag = interface)
+					OR ~ip & (fld.name^ = DevCPM.HdPtrName) THEN Out4(fld.adr + adr); INC(num)
+				ELSE FindPtrs(fld.typ, fld.adr + adr, ip, num)
+				END;
+				fld := fld.link
+			END
+		ELSIF typ.comp = Array THEN
+			btyp := typ.BaseTyp; n := typ.n;
+			WHILE btyp.comp = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END ;
+			IF (btyp.form = Pointer) OR (btyp.comp = Record) THEN
+				i := num; FindPtrs(btyp, adr, ip, num);
+				IF num # i THEN i := 1;
+					WHILE i < n DO
+						INC(adr, btyp.size); FindPtrs(btyp, adr, ip, num); INC(i)
+					END
+				END
+			END
+		END
+	END FindPtrs;
+	
+
+	PROCEDURE OutRefName* (VAR name: ARRAY OF SHORTCHAR);
+	BEGIN
+		DevCPM.ObjW(0FCX); DevCPM.ObjWNum(pc); OutName(name)
+	END OutRefName;
+
+	PROCEDURE OutRefs* (obj: DevCPT.Object);
+		VAR f: BYTE;
+	BEGIN
+		IF outRef & (obj # NIL) THEN
+			OutRefs(obj.left);
+			IF ((obj.mode = Var) OR (obj.mode = VarPar)) & (obj.history # removed) & (obj.name[0] # "@") THEN
+				f := obj.typ.form;
+				IF (f IN {Byte .. Set, Pointer, ProcTyp, Char16, Int64}) 
+						OR outURef & (obj.typ.comp # DynArr)
+						OR outAllRef & ~obj.typ.untagged
+						OR (obj.typ.comp = Array) & (obj.typ.BaseTyp.form = Char8) THEN
+					IF obj.mode = Var THEN DevCPM.ObjW(0FDX) ELSE DevCPM.ObjW(0FFX) END;
+					IF obj.typ = DevCPT.anyptrtyp THEN DevCPM.ObjW(SHORT(CHR(mAnyPtr)))
+					ELSIF obj.typ = DevCPT.anytyp THEN DevCPM.ObjW(SHORT(CHR(mAnyRec)))
+					ELSIF obj.typ = DevCPT.sysptrtyp THEN DevCPM.ObjW(SHORT(CHR(mSysPtr)))
+					ELSIF f = Char16 THEN DevCPM.ObjW(SHORT(CHR(mChar16)))
+					ELSIF f = Int64 THEN DevCPM.ObjW(SHORT(CHR(mInt64)))
+					ELSIF obj.typ = DevCPT.guidtyp THEN DevCPM.ObjW(SHORT(CHR(mGuid)))
+					ELSIF obj.typ = DevCPT.restyp THEN DevCPM.ObjW(SHORT(CHR(mResult)))
+					ELSIF f = Pointer THEN
+						IF obj.typ.sysflag = interface THEN DevCPM.ObjW(SHORT(CHR(mInterface)))
+						ELSIF obj.typ.untagged THEN DevCPM.ObjW(SHORT(CHR(mSysPtr)))
+						ELSE DevCPM.ObjW(10X); OutReference(TypeObj(obj.typ), 0, absolute)
+						END
+					ELSIF (f = Comp) & outAllRef & (~obj.typ.untagged OR outURef & (obj.typ.comp # DynArr)) THEN
+						DevCPM.ObjW(10X); OutReference(TypeObj(obj.typ), 0, absolute)
+					ELSIF f < Int8 THEN DevCPM.ObjW(SHORT(CHR(f - 1)))
+					ELSE DevCPM.ObjW(SHORT(CHR(f)))
+					END;
+					IF obj.mnolev = 0 THEN DevCPM.ObjWNum(obj.adr + dsize) ELSE DevCPM.ObjWNum(obj.adr) END;
+					OutName(obj.name^)
+				END
+			END ;
+			OutRefs(obj.right)
+		END
+	END OutRefs;
+	
+	PROCEDURE OutSourceRef* (pos: INTEGER);
+	BEGIN
+		IF outSrc & (pos # 0) & (pos # srcPos) & (pc > codePos) THEN
+			WHILE pc > codePos + 250 DO
+				DevCPM.ObjW(SHORT(CHR(250)));
+				INC(codePos, 250);
+				DevCPM.ObjWNum(0)
+			END;
+			DevCPM.ObjW(SHORT(CHR(pc - codePos)));
+			codePos := pc;
+			DevCPM.ObjWNum(pos - srcPos);
+			srcPos := pos
+		END
+	END OutSourceRef;
+
+	
+	PROCEDURE OutPLink (link: DevCPT.LinkList; adr: INTEGER);
+	BEGIN
+		WHILE link # NIL DO
+			ASSERT(link.linkadr # 0);
+			DevCPM.ObjWNum(link.linkadr);
+			DevCPM.ObjWNum(adr + link.offset);
+			link := link.next
+		END
+	END OutPLink;
+
+	PROCEDURE OutLink (link: DevCPT.LinkList);
+	BEGIN
+		OutPLink(link, 0); DevCPM.ObjW(0X)
+	END OutLink;
+	
+	PROCEDURE OutNames;
+		VAR a, b, c: DevCPT.Object;
+	BEGIN
+		a := nameList; b := NIL;
+		WHILE a # NIL DO c := a; a := c.nlink; c.nlink := b; b := c END;
+		DevCPM.ObjW(0X);	(* names[0] = 0X *)
+		WHILE b # NIL DO
+			OutName(b.name^);
+			b := b.nlink
+		END;
+	END OutNames;
+	
+	PROCEDURE OutGuid* (VAR str: ARRAY OF SHORTCHAR);
+		
+		PROCEDURE Copy (n: INTEGER);
+			VAR x, y: INTEGER;
+		BEGIN
+			x := ORD(str[n]); y := ORD(str[n + 1]);
+			IF x >= ORD("a") THEN DEC(x, ORD("a") - 10)
+			ELSIF x >= ORD("A") THEN DEC(x, ORD("A") - 10)
+			ELSE DEC(x, ORD("0"))
+			END;
+			IF y >= ORD("a") THEN DEC(y, ORD("a") - 10)
+			ELSIF y >= ORD("A") THEN DEC(y, ORD("A") - 10)
+			ELSE DEC(y, ORD("0"))
+			END;
+			DevCPM.ObjW(SHORT(CHR(x * 16 + y)))
+		END Copy;
+		
+	BEGIN
+		IF bigEndian THEN
+			Copy(1); Copy(3); Copy(5); Copy(7); Copy(10); Copy(12); Copy(15); Copy(17)
+		ELSE
+			Copy(7); Copy(5); Copy(3); Copy(1); Copy(12); Copy(10); Copy(17); Copy(15)
+		END;
+		Copy(20); Copy(22); Copy(25); Copy(27); Copy(29); Copy(31); Copy(33); Copy(35)
+	END OutGuid;
+
+	PROCEDURE OutConst (obj: DevCPT.Object);
+		TYPE A4 = ARRAY 4 OF SHORTCHAR; A8 = ARRAY 8 OF SHORTCHAR;
+		VAR a, b, c: DevCPT.Const; r: SHORTREAL; lr: REAL; a4: A4; a8: A8; ch: SHORTCHAR; i, x, hi, low: INTEGER;
+	BEGIN
+		a := obj.conval; b := NIL;
+		WHILE a # NIL DO c := a; a := c.link; c.link := b; b := c END;
+		WHILE b # NIL DO
+			IF String8 IN b.setval THEN
+				DevCPM.ObjWBytes(b.ext^, b.intval2);
+				Align(4)
+			ELSIF String16 IN b.setval THEN
+				i := 0; REPEAT DevCPM.GetUtf8(b.ext^, x, i); Out2(x) UNTIL x = 0;
+				Align(4)
+			ELSIF Real32 IN b.setval THEN
+				r := SHORT(b.realval); a4 := SYSTEM.VAL(A4, r);
+				IF DevCPM.LEHost = bigEndian THEN
+					ch := a4[0]; a4[0] := a4[3]; a4[3] := ch;
+					ch := a4[1]; a4[1] := a4[2]; a4[2] := ch
+				END;
+				DevCPM.ObjWBytes(a4, 4)
+			ELSIF Real64 IN b.setval THEN
+				a8 := SYSTEM.VAL(A8, b.realval);
+				IF DevCPM.LEHost = bigEndian THEN
+					ch := a8[0]; a8[0] := a8[7]; a8[7] := ch;
+					ch := a8[1]; a8[1] := a8[6]; a8[6] := ch;
+					ch := a8[2]; a8[2] := a8[5]; a8[5] := ch;
+					ch := a8[3]; a8[3] := a8[4]; a8[4] := ch
+				END;
+				DevCPM.ObjWBytes(a8, 8)
+			ELSIF Int64 IN b.setval THEN
+				(* intval moved to intval2 by AllocConst *)
+				x := b.intval; b.intval := b.intval2; GetLongWords(b, hi, low); b.intval := x;
+				IF bigEndian THEN Out4(hi); Out4(low) ELSE Out4(low); Out4(hi) END
+			ELSIF Guid IN b.setval THEN
+				OutGuid(b.ext^)
+			END;
+			b := b.link
+		END
+	END OutConst;
+	
+	PROCEDURE OutStruct (typ: DevCPT.Struct; unt: BOOLEAN);
+	BEGIN
+		IF typ = NIL THEN Out4(0)
+		ELSIF typ = DevCPT.sysptrtyp THEN Out4(mSysPtr)
+		ELSIF typ = DevCPT.anytyp THEN Out4(mAnyRec)
+		ELSIF typ = DevCPT.anyptrtyp THEN Out4(mAnyPtr)
+		ELSIF typ = DevCPT.guidtyp THEN Out4(mGuid)
+		ELSIF typ = DevCPT.restyp THEN Out4(mResult)
+		ELSE
+			CASE typ.form OF
+			| Undef, Byte, String8, NilTyp, NoTyp, String16: Out4(0)
+			| Bool, Char8: Out4(typ.form - 1)
+			| Int8..Set: Out4(typ.form)
+			| Char16: Out4(mChar16)
+			| Int64: Out4(mInt64)
+			| ProcTyp: OutReference(TypeObj(typ), 0, absolute)
+			| Pointer:
+				IF typ.sysflag = interface THEN Out4(mInterface)
+				ELSIF typ.untagged THEN Out4(mSysPtr)
+				ELSE OutReference(TypeObj(typ), 0, absolute)
+				END
+			| Comp:
+				IF ~typ.untagged OR (outURef & unt) THEN OutReference(TypeObj(typ), 0, absolute)
+				ELSE Out4(0)
+				END
+			END
+		END
+	END OutStruct;
+	
+	PROCEDURE NameIdx (obj: DevCPT.Object): INTEGER;
+		VAR n: INTEGER;
+	BEGIN
+		n := 0;
+		IF obj.name # DevCPT.null THEN
+			IF obj.num = 0 THEN
+				obj.num := namex;
+				WHILE obj.name[n] # 0X DO INC(n) END;
+				INC(namex, n + 1);
+				obj.nlink := nameList; nameList := obj
+			END;
+			n := obj.num;
+		END;
+		RETURN n
+	END NameIdx;
+	
+	PROCEDURE OutSignature (par: DevCPT.Object; retTyp: DevCPT.Struct; OUT pos: INTEGER);
+		VAR p: DevCPT.Object; n, m: INTEGER;
+	BEGIN
+		pos := DevCPM.ObjLen() - headSize;
+		OutStruct(retTyp, TRUE);
+		p := par; n := 0;
+		WHILE p # NIL DO INC(n); p := p.link END;
+		Out4(n); p := par;
+		WHILE p # NIL DO
+			IF p.mode # VarPar THEN m := mValue
+			ELSIF p.vis = inPar THEN m := mInPar
+			ELSIF p.vis = outPar THEN m := mOutPar
+			ELSE m := mVarPar
+			END;
+			Out4(NameIdx(p) * 256 + m);
+			OutStruct(p.typ, TRUE);
+			p := p.link
+		END
+	END OutSignature;
+	
+	PROCEDURE PrepObject (obj: DevCPT.Object);
+	BEGIN
+		IF (obj.mode IN {LProc, XProc, IProc}) & outSignatures THEN	(* write param list *)
+			OutSignature(obj.link, obj.typ, obj.conval.intval)
+		END
+	END PrepObject;
+	
+	PROCEDURE OutObject (mode, fprint, offs: INTEGER; typ: DevCPT.Struct; obj: DevCPT.Object);
+		VAR vis: INTEGER;
+	BEGIN
+		Out4(fprint);
+		Out4(offs);
+		IF obj.vis = internal THEN vis := mInternal
+		ELSIF obj.vis = externalR THEN vis := mReadonly
+		ELSIF obj.vis = external THEN vis := mExported
+		END;
+		Out4(mode + vis * 16 + NameIdx(obj) * 256);
+		IF (mode = mProc) & outSignatures THEN OutReference(Meta, obj.conval.intval, absolute)	(* ref to par list *)
+		ELSE OutStruct(typ, mode = mField)
+		END
+	END OutObject;
+	
+	PROCEDURE PrepDesc (desc: DevCPT.Struct);
+		VAR fld: DevCPT.Object; n: INTEGER; l: DevCPT.LinkList; b: DevCPT.Struct;
+	BEGIN
+		IF desc.comp = Record THEN	(* write field list *)
+			desc.strobj.adr := DevCPM.ObjLen() - headSize;
+			n := 0; fld := desc.link;
+			WHILE (fld # NIL) & (fld.mode = Fld) DO
+				IF expAllFields OR (fld.vis # internal) THEN INC(n) END;
+				fld := fld.link
+			END;
+			Out4(n); fld := desc.link;
+			WHILE (fld # NIL) & (fld.mode = Fld) DO
+				IF expAllFields OR (fld.vis # internal) THEN
+					OutObject(mField, 0, fld.adr, fld.typ, fld)
+				END;
+				fld := fld.link
+			END
+		ELSIF (desc.form = ProcTyp) & outSignatures THEN	(* write param list *)
+			OutSignature(desc.link, desc.BaseTyp, desc.n)
+		END;
+		(* assert name and base type are included *)
+		IF desc.untagged THEN n := NameIdx(untgd)
+		ELSE n := NameIdx(desc.strobj)
+		END;
+		IF desc.form # ProcTyp THEN b := desc.BaseTyp;
+			IF (b # NIL) & (b # DevCPT.anytyp) & (b # DevCPT.anyptrtyp) & (b.form IN {Pointer, Comp, ProcTyp})
+					& (b.sysflag # interface) & (b # DevCPT.guidtyp)
+					& (~b.untagged OR outURef & (b.form = Comp)) THEN
+				l := OffsetLink(TypeObj(b), 0)
+			END
+		END
+	END PrepDesc;
+	
+	PROCEDURE NumMeth (root: DevCPT.Object; num: INTEGER): DevCPT.Object;
+		VAR obj: DevCPT.Object;
+	BEGIN
+		IF (root = NIL) OR (root.mode = TProc) & (root.num = num) THEN RETURN root END;
+		obj := NumMeth(root.left, num);
+		IF obj = NIL THEN obj := NumMeth(root.right, num) END;
+		RETURN obj
+	END NumMeth;
+	
+	PROCEDURE OutDesc (desc: DevCPT.Struct);
+		VAR m: DevCPT.Object; i, nofptr, flddir, size: INTEGER; t, xb: DevCPT.Struct; form, lev, attr: BYTE;
+			name: DevCPT.Name;
+	BEGIN
+		ASSERT(~desc.untagged);
+		IF desc.comp = Record THEN
+			xb := desc; flddir := desc.strobj.adr;
+			REPEAT xb := xb.BaseTyp UNTIL (xb = NIL) OR (xb.mno # 0) OR xb.untagged;
+			Out4(-1); i := desc.n;
+			WHILE i > 0 DO DEC(i); t := desc;
+				REPEAT
+					m := NumMeth(t.link, i); t := t.BaseTyp
+				UNTIL (m # NIL) OR (t = xb);
+				IF m # NIL THEN 
+					IF absAttr IN m.conval.setval THEN Out4(0)
+					ELSE OutReference(m, 0, absolute)
+					END
+				ELSIF (xb = NIL) OR xb.untagged THEN Out4(0)	(* unimplemented ANYREC method *)
+				ELSE OutReference(xb.strobj, -4 - 4 * i, copy)
+				END
+			END;
+			desc.strobj.adr := DevCPM.ObjLen() - headSize;	(* desc adr *)
+			Out4(desc.size);
+			OutReference(Mod, 0, absolute);
+			IF desc.untagged THEN m := untgd ELSE m := desc.strobj END;
+			IF desc.attribute = extAttr THEN attr := 1
+			ELSIF desc.attribute = limAttr THEN attr := 2
+			ELSIF desc.attribute = absAttr THEN attr := 3
+			ELSE attr := 0
+			END;
+			Out4(mRecord + attr * 4 + desc.extlev * 16 + NameIdx(m) * 256); i := 0;
+			WHILE i <= desc.extlev DO
+				t := desc;
+				WHILE t.extlev > i DO t := t.BaseTyp END;
+				IF t.sysflag = interface THEN Out4(0)
+				ELSIF t.untagged THEN OutReference(TypeObj(t), 0, absolute)
+				ELSIF (t.mno = 0) THEN OutReference(t.strobj, 0, absolute)
+				ELSIF t = xb THEN OutReference(xb.strobj, 0, absolute)
+				ELSE OutReference(xb.strobj, 12 + 4 * i, copy)
+				END;
+				INC(i)
+			END;
+			WHILE i <= DevCPM.MaxExts DO Out4(0); INC(i) END;
+			OutReference(Meta, flddir, absolute);	(* ref to field list *)
+			nofptr := 0; FindPtrs(desc, 0, FALSE, nofptr);
+			Out4(-(4 * nofptr + 4));
+			nofptr := 0; FindPtrs(desc, 0, TRUE, nofptr);
+			Out4(-1)
+		ELSE
+			desc.strobj.adr := DevCPM.ObjLen() - headSize;
+			lev := 0; size := 0;
+			IF desc.comp = Array THEN
+				size := desc.n; form := mArray
+			ELSIF desc.comp = DynArr THEN
+				form := mArray; lev := SHORT(SHORT(desc.n + 1))
+			ELSIF desc.form = Pointer THEN
+				form := mPointer
+			ELSE ASSERT(desc.form = ProcTyp);
+				DevCPM.FPrint(size, XProc); DevCPT.FPrintSign(size, desc.BaseTyp, desc.link); form := mProctyp;
+			END;
+			Out4(size);
+			OutReference(Mod, 0, absolute);
+			IF desc.untagged THEN m := untgd ELSE m := desc.strobj END;
+			Out4(form + lev * 16 + NameIdx(m) * 256);
+			IF desc.form # ProcTyp THEN OutStruct(desc.BaseTyp, TRUE)
+			ELSIF outSignatures THEN OutReference(Meta, desc.n, absolute)	(* ref to par list *)
+			END
+		END
+	END OutDesc;
+
+	PROCEDURE OutModDesc (nofptr, refSize, namePos, ptrPos, expPos, impPos: INTEGER);
+		VAR i: INTEGER; t: Dates.Time; d: Dates.Date;
+	BEGIN
+		Out4(0);	(* link *)
+		Out4(ORD(options));	(* opts *)
+		Out4(0);	(* refcnt *)
+		Dates.GetDate(d); Dates.GetTime(t); 	(* compile time *)
+		Out2(d.year); Out2(d.month); Out2(d.day);
+		Out2(t.hour); Out2(t.minute); Out2(t.second);
+		Out4(0); Out4(0); Out4(0); 	(* load time *)
+		Out4(0);	(* ext *)
+		IF closeLbl # 0 THEN OutReference(Code, closeLbl, absolute);	(* terminator *)
+		ELSE Out4(0)
+		END;
+		Out4(imports);	(* nofimps *)
+		Out4(nofptr);	(* nofptrs *)
+		Out4(pc);	(* csize *)
+		Out4(dsize);	(* dsize *)
+		Out4(refSize);	(* rsize *)
+		OutReference(Code, 0, absolute);	(* code *)
+		OutReference(Data, 0, absolute);	(* data *)
+		OutReference(Meta, 0, absolute);	(* refs *)
+		IF procVarIndirect THEN
+			OutReference(Proc, 0, absolute);	(* procBase *)
+		ELSE
+			OutReference(Code, 0, absolute);	(* procBase *)
+		END;
+		OutReference(Data, 0, absolute);	(* varBase *)
+		OutReference(Meta, namePos, absolute);	(* names *)
+		OutReference(Meta, ptrPos, absolute);	(* ptrs *)
+		OutReference(Meta, impPos, absolute);	(* imports *)
+		OutReference(Meta, expPos, absolute);	(* export *)
+		i := 0;	(* name *)
+		WHILE DevCPT.SelfName[i] # 0X DO DevCPM.ObjW(DevCPT.SelfName[i]); INC(i) END;
+		DevCPM.ObjW(0X);
+		Align(4)
+	END OutModDesc;
+
+	PROCEDURE OutProcTable (obj: DevCPT.Object);	(* 68000 *)
+	BEGIN
+		IF obj # NIL THEN
+			OutProcTable(obj.left);
+			IF obj.mode IN {XProc, IProc} THEN
+				Out2(4EF9H); OutReference(Code, obj.adr, absolute); Out2(0);
+			END;
+			OutProcTable(obj.right);
+		END;
+	END OutProcTable;
+
+	PROCEDURE PrepExport (obj: DevCPT.Object);
+	BEGIN
+		IF obj # NIL THEN
+			PrepExport(obj.left);
+			IF (obj.mode IN {LProc, XProc, IProc}) & (obj.history # removed) & (obj.vis # internal) THEN
+				PrepObject(obj)
+			END;
+			PrepExport(obj.right)
+		END
+	END PrepExport;
+	
+	PROCEDURE OutExport (obj: DevCPT.Object);
+		VAR num: INTEGER;
+	BEGIN
+		IF obj # NIL THEN
+			OutExport(obj.left);
+			IF (obj.history # removed) & ((obj.vis # internal) OR
+						(obj.mode = Typ) & (obj.typ.strobj = obj) & (obj.typ.form = Comp)) THEN
+				DevCPT.FPrintObj(obj);
+				IF obj.mode IN {LProc, XProc, IProc} THEN
+					IF procVarIndirect THEN
+						ASSERT(obj.nlink = NIL);
+						num := obj.num; obj.num := 0;
+						OutObject(mProc, obj.fprint, num, NIL, obj);
+						obj.num := num
+					ELSE
+						OutObject(mProc, obj.fprint, obj.adr, NIL, obj)
+					END
+				ELSIF obj.mode = Var THEN
+					OutObject(mVar, obj.fprint, dsize + obj.adr, obj.typ, obj)
+				ELSIF obj.mode = Typ THEN
+					OutObject(mTyp, obj.typ.pbfp, obj.typ.pvfp, obj.typ, obj)
+				ELSE ASSERT(obj.mode IN {Con, CProc});
+					OutObject(mConst, obj.fprint, 0, NIL, obj)
+				END
+			END;
+			OutExport(obj.right)
+		END
+	END OutExport;
+	
+	PROCEDURE OutCLinks (obj: DevCPT.Object);
+	BEGIN
+		IF obj # NIL THEN
+			OutCLinks(obj.left);
+			IF obj.mode IN {LProc, XProc, IProc} THEN OutPLink(obj.links, obj.adr) END;
+			OutCLinks(obj.right)
+		END
+	END OutCLinks;
+
+	PROCEDURE OutCPLinks (obj: DevCPT.Object; base: INTEGER);
+	BEGIN
+		IF obj # NIL THEN
+			OutCPLinks(obj.left, base);
+			IF obj.mode IN {LProc, XProc, IProc} THEN OutPLink(obj.links, obj.num + base) END;
+			OutCPLinks(obj.right, base)
+		END
+	END OutCPLinks;
+
+	PROCEDURE OutImport (obj: DevCPT.Object);
+		VAR typ: DevCPT.Struct; strobj: DevCPT.Object; opt: INTEGER;
+	BEGIN
+		IF obj # NIL THEN
+			OutImport(obj.left);
+			IF obj.mode = Typ THEN typ := obj.typ;
+				IF obj.used OR
+					(typ.form IN {Pointer, Comp}) & (typ.strobj = obj) &
+						((obj.links # NIL) OR (obj.name # DevCPT.null) & (typ.pvused OR typ.pbused)) THEN
+					DevCPT.FPrintStr(typ);
+					DevCPM.ObjW(SHORT(CHR(mTyp))); OutName(obj.name^);
+					IF obj.used THEN opt := 2 ELSE opt := 0 END;
+					IF (typ.form = Comp) & ((typ.pvused) OR (obj.name = DevCPT.null)) THEN
+						DevCPM.ObjWNum(typ.pvfp); DevCPM.ObjW(SHORT(CHR(opt + 1)));
+						IF obj.history = inconsistent THEN DevCPT.FPrintErr(obj, 249) END
+					ELSE DevCPM.ObjWNum(typ.pbfp); DevCPM.ObjW(SHORT(CHR(opt)))
+					END;
+					OutLink(obj.links)
+				END
+			ELSIF obj.used THEN
+				DevCPT.FPrintObj(obj);
+				IF obj.mode = Var THEN
+					DevCPM.ObjW(SHORT(CHR(mVar))); OutName(obj.name^);
+					DevCPM.ObjWNum(obj.fprint); OutLink(obj.links)
+				ELSIF obj.mode IN {XProc, IProc} THEN
+					DevCPM.ObjW(SHORT(CHR(mProc))); OutName(obj.name^);
+					DevCPM.ObjWNum(obj.fprint); OutLink(obj.links)
+				ELSE ASSERT(obj.mode IN {Con, CProc});
+					DevCPM.ObjW(SHORT(CHR(mConst))); OutName(obj.name^); DevCPM.ObjWNum(obj.fprint)
+				END
+			END;
+			OutImport(obj.right)
+		END
+	END OutImport;
+	
+	PROCEDURE OutUseBlock;
+		VAR m, obj: DevCPT.Object; i: INTEGER;
+	BEGIN
+		m := dllList;
+		WHILE m # NIL DO
+			obj := m.nlink;
+			WHILE obj # NIL DO
+				IF obj.mode = Var THEN DevCPM.ObjW(SHORT(CHR(mVar)))
+				ELSE DevCPM.ObjW(SHORT(CHR(mProc)))
+				END;
+				IF obj.entry # NIL THEN OutName(obj.entry^)
+				ELSE OutName(obj.name^);
+				END;
+				DevCPT.FPrintObj(obj); DevCPM.ObjWNum(obj.fprint); OutLink(obj.links);
+				obj := obj.nlink
+			END;
+			DevCPM.ObjW(0X); m := m.link
+		END;
+		i := 1;
+		WHILE i < DevCPT.nofGmod DO
+			obj := DevCPT.GlbMod[i];
+			IF obj.library = NIL THEN OutImport(obj.right); DevCPM.ObjW(0X) END;
+			INC(i)
+		END;
+	END OutUseBlock;
+
+	PROCEDURE CollectDll (obj: DevCPT.Object; mod: DevCPT.String);
+		VAR name: DevCPT.String; dll: DevCPT.Object;
+	BEGIN
+		IF obj # NIL THEN
+			CollectDll(obj.left, mod);
+			IF obj.used & (obj.mode IN {Var, XProc, IProc}) THEN
+				IF obj.library # NIL THEN name := obj.library
+				ELSE name := mod
+				END;
+				dll := dllList;
+				WHILE (dll # NIL) & (dll.library^ # name^) DO dll := dll.link END;
+				IF dll = NIL THEN
+					NEW(dll); dll.library := name; INC(imports);
+					IF dllList = NIL THEN dllList := dll ELSE dllLast.link := dll END;
+					dllLast := dll; dll.left := dll;
+				END;
+				dll.left.nlink := obj; dll.left := obj
+			END;
+			CollectDll(obj.right, mod)
+		END
+	END CollectDll;
+	
+	PROCEDURE EnumXProc(obj: DevCPT.Object; VAR num: INTEGER);
+	BEGIN
+		IF obj # NIL THEN
+			EnumXProc(obj.left, num);
+			IF obj.mode IN {XProc, IProc} THEN
+				obj.num := num; INC(num, 8);
+			END;
+			EnumXProc(obj.right, num)
+		END;
+	END EnumXProc;
+	
+	PROCEDURE OutHeader*;
+		VAR i: INTEGER; m: DevCPT.Object;
+	BEGIN
+		DevCPM.ObjWLInt(processor);	(* processor type *)
+		DevCPM.ObjWLInt(0); DevCPM.ObjWLInt(0); DevCPM.ObjWLInt(0);
+		DevCPM.ObjWLInt(0); DevCPM.ObjWLInt(0);	(* sizes *)
+		imports := 0; i := 1;
+		WHILE i < DevCPT.nofGmod DO
+			m := DevCPT.GlbMod[i];
+			IF m.library # NIL THEN	(* dll import *)
+				CollectDll(m.right, m.library);
+			ELSE INC(imports)	(* module import *)
+			END;
+			INC(i)
+		END;
+		DevCPM.ObjWNum(imports);	(* num of import *)
+		OutName(DevCPT.SelfName); 
+		m := dllList;
+		WHILE m # NIL DO DevCPM.ObjW("$"); OutName(m.library^); m := m.link END;
+		i := 1;
+		WHILE i < DevCPT.nofGmod DO
+			m := DevCPT.GlbMod[i];
+			IF m.library = NIL THEN OutName(m.name^) END;
+			INC(i)
+		END;
+		Align(16); headSize := DevCPM.ObjLen();
+		IF procVarIndirect THEN
+			i := 0; EnumXProc(DevCPT.topScope.right, i)
+		END
+	END OutHeader;
+
+	PROCEDURE OutCode*;
+		VAR i, j, refSize, expPos, ptrPos, impPos, namePos, procPos,
+			con8Pos, con16Pos, con32Pos, con64Pos, modPos, codePos: INTEGER;
+			m, obj, dlist: DevCPT.Object;
+	BEGIN
+	(* Ref *)
+		DevCPM.ObjW(0X); (* end mark *)
+		refSize := DevCPM.ObjLen() - headSize;
+	(* Export *)
+		Align(4);
+		IF outSignatures THEN PrepExport(DevCPT.topScope.right) END;	(* procedure signatures *)
+		Align(8); expPos := DevCPM.ObjLen(); 
+		Out4(0);
+		OutExport(DevCPT.topScope.right);	(* export objects *)
+		i := DevCPM.ObjLen(); DevCPM.ObjSet(expPos); Out4((i - expPos - 4) DIV 16); DevCPM.ObjSet(i);
+	(* Pointers *)
+		ptrPos := DevCPM.ObjLen();
+		obj := DevCPT.topScope.scope; nofptrs := 0;
+		WHILE obj # NIL DO FindPtrs(obj.typ, dsize + obj.adr, FALSE, nofptrs); obj := obj.link END;
+		obj := DevCPT.topScope.scope; i := 0;
+		WHILE obj # NIL DO FindPtrs(obj.typ, dsize + obj.adr, TRUE, i); obj := obj.link END;
+		IF i > 0 THEN Out4(-1); INCL(options, iptrs) END;
+	(* Prepare Type Descriptors *)
+		dlist := NIL;
+		WHILE descList # NIL DO
+			obj := descList; descList := descList.link;
+			PrepDesc(obj.typ);
+			obj.link := dlist; dlist := obj
+		END;
+	(* Import List *)
+		impPos := DevCPM.ObjLen(); i := 0;
+		WHILE i < imports DO Out4(0); INC(i) END;
+	(* Names *)
+		namePos := DevCPM.ObjLen(); OutNames;
+	(* Const *)
+		Align(4); con8Pos := DevCPM.ObjLen();
+		OutConst(Const8); con16Pos := DevCPM.ObjLen();
+		ASSERT(con16Pos MOD 4 = 0); ASSERT(con16Pos - con8Pos = idx8);
+		OutConst(Const16); con32Pos := DevCPM.ObjLen();
+		ASSERT(con32Pos MOD 4 = 0); ASSERT(con32Pos - con16Pos = idx16);
+		OutConst(Const32); con64Pos := DevCPM.ObjLen();
+		ASSERT(con64Pos MOD 4 = 0); ASSERT(con64Pos - con32Pos = idx32);
+		IF ODD(con64Pos DIV 4) THEN Out4(0); INC(con64Pos, 4) END;
+		OutConst(Const64); ASSERT(DevCPM.ObjLen() - con64Pos = idx64);
+	(* Module Descriptor *)
+		Align(16); modPos := DevCPM.ObjLen();
+		OutModDesc(nofptrs, refSize, namePos - headSize, ptrPos - headSize, expPos - headSize, impPos - headSize);
+	(* Procedure Table *)
+		procPos := DevCPM.ObjLen();
+		OutProcTable(DevCPT.topScope.right);
+		Out4(0); Out4(0); (* at least one entry in ProcTable *)
+		Out4(0); (* sentinel *)
+	(* Type Descriptors *)
+		obj := dlist;
+		WHILE obj # NIL DO OutDesc(obj.typ); obj := obj.link END;
+	(* Code *)
+		codePos := DevCPM.ObjLen(); WriteCode;
+		WHILE pc MOD 4 # 0 DO DevCPM.ObjW(90X); INC(pc) END;
+	(* Fixups *)
+		OutLink(KNewRec.links); OutLink(KNewArr.links);
+		(* metalink *)
+		OutPLink(Const8.links, con8Pos - headSize);
+		OutPLink(Const16.links, con16Pos - headSize);
+		OutPLink(Const32.links, con32Pos - headSize);
+		OutPLink(Const64.links, con64Pos - headSize);
+		OutLink(Meta.links);
+		(* desclink *)
+		obj := dlist; i := modPos - headSize;
+		WHILE obj # NIL DO OutPLink(obj.links, obj.adr - i); obj.links := NIL; obj := obj.link END;
+		IF procVarIndirect THEN
+			OutPLink(Proc.links, procPos - modPos);
+			OutCPLinks(DevCPT.topScope.right, procPos - modPos)
+		END;
+		OutLink(Mod.links);
+		(* codelink *)
+		IF ~procVarIndirect THEN OutCLinks(DevCPT.topScope.right) END;
+		OutPLink(CaseLinks, 0); OutLink(Code.links);
+		(* datalink *)
+		OutLink(Data.links);
+	(* Use *)
+		OutUseBlock;
+	(* Header Fixups *)
+		DevCPM.ObjSet(8);
+		DevCPM.ObjWLInt(headSize);
+		DevCPM.ObjWLInt(modPos - headSize);
+		DevCPM.ObjWLInt(codePos - modPos);
+		DevCPM.ObjWLInt(pc);
+		DevCPM.ObjWLInt(dsize);
+		IF namex > MaxNameTab THEN DevCPM.err(242) END;
+		IF DevCPM.noerr & outObj THEN DevCPM.RegisterObj END
+	END OutCode;
+
+	PROCEDURE Init* (proc: INTEGER; opt: SET);
+		CONST obj = 3; ref = 4; allref = 5; srcpos = 6; bigEnd = 15; pVarInd = 14;
+	BEGIN
+		processor := proc;
+		bigEndian := bigEnd IN opt; procVarIndirect := pVarInd IN opt;
+		outRef := ref IN opt; outAllRef := allref IN opt; outObj := obj IN opt;
+		outURef := useAllRef & outAllRef & (DevCPM.comAware IN DevCPM.options);
+		outSrc := srcpos IN opt;
+		pc := 0; actIdx := CodeLength; blkIdx := 0; 
+		idx8 := 0; idx16 := 0; idx32 := 0; idx64 := 0; namex := 1;
+		options := opt * {0..15}; CodeOvF := FALSE;
+		KNewRec.links := NIL; KNewArr.links := NIL; CaseLinks := NIL;
+		Const8.links := NIL; Const8.conval := NIL; Const16.links := NIL; Const16.conval := NIL;
+		Const32.links := NIL; Const32.conval := NIL; Const64.links := NIL; Const64.conval := NIL;
+		Code.links := NIL; Data.links := NIL; Mod.links := NIL; Proc.links := NIL; Meta.links := NIL;
+		nameList := NIL; descList := NIL; dllList := NIL; dllLast := NIL;
+		codePos := 0; srcPos := 0;
+		NEW(untgd); untgd.name := DevCPT.NewName("!");
+		closeLbl := 0
+	END Init;
+
+	PROCEDURE Close*;
+	BEGIN
+		KNewRec.links := NIL; KNewArr.links := NIL; CaseLinks := NIL;
+		Const8.links := NIL; Const8.conval := NIL; Const16.links := NIL; Const16.conval := NIL;
+		Const32.links := NIL; Const32.conval := NIL; Const64.links := NIL; Const64.conval := NIL;
+		Code.links := NIL; Data.links := NIL; Mod.links := NIL; Proc.links := NIL; Meta.links := NIL;
+		nameList := NIL; descList := NIL; dllList := NIL; dllLast := NIL;
+		WHILE blkIdx > 0 DO DEC(blkIdx); code[blkIdx] := NIL END;
+		actual := NIL; untgd := NIL;
+	END Close;
+
+BEGIN
+	NEW(KNewRec); KNewRec.mnolev := -128;
+	NEW(KNewArr); KNewArr.mnolev := -128;
+	NEW(Const8); Const8.mode := Con; Const8.mnolev := 0;
+	NEW(Const16); Const16.mode := Con; Const16.mnolev := 0;
+	NEW(Const32); Const32.mode := Con; Const32.mnolev := 0;
+	NEW(Const64); Const64.mode := Con; Const64.mnolev := 0;
+	NEW(Code); Code.mode := Con; Code.mnolev := 0;
+	NEW(Data); Data.mode := Con; Data.mnolev := 0;
+	NEW(Mod); Mod.mode := Con; Mod.mnolev := 0;
+	NEW(Proc); Proc.mode := Con; Proc.mnolev := 0;
+	NEW(Meta); Meta.mode := Con; Mod.mnolev := 0;
+END DevCPE.

BlackBox/Dev/Mod/CPH.txt

@@ -0,0 +1,291 @@
+MODULE DevCPH;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPH.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT DevCPT;
+	
+	CONST
+		(* UseCalls options *)
+		longMop* = 0; longDop* = 1; longConv* = 2; longOdd* = 3;
+		realMop* = 8; realDop* = 9; realConv* = 10;
+		intMulDiv* = 11;
+		force = 16; hide = 17;
+	
+		(* nodes classes *)
+		Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
+		Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
+		Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
+		Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
+		Nreturn = 26; Nwith = 27; Ntrap = 28; Ncomp = 30;
+		Ndrop = 50; Nlabel = 51; Ngoto = 52; Njsr = 53; Nret = 54; Ncmp = 55;
+		
+		(*function number*)
+		assign = 0; newfn = 1; incfn = 13; decfn = 14;
+		inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
+		getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31;
+		
+		(* symbol values and ops *)
+		times = 1; slash = 2; div = 3; mod = 4;
+		and = 5; plus = 6; minus = 7; or = 8; eql = 9;
+		neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
+		in = 15; is = 16; ash = 17; msk = 18; len = 19;
+		conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
+		adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
+		min = 34; max = 35; typfn = 36;
+		thisrecfn = 45; thisarrfn = 46;
+		shl = 50; shr = 51; lshr = 52; xor = 53;
+
+		(* structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18;
+		VString16to8 = 29; VString8 = 30; VString16 = 31;
+		realSet = {Real32, Real64};
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+
+		
+
+	PROCEDURE UseThisCall (n: DevCPT.Node; IN name: ARRAY OF SHORTCHAR);
+		VAR mod, nm, moda: DevCPT.Name; mobj, obj: DevCPT.Object; done: BOOLEAN;
+	BEGIN
+		IF (n.typ.form = Real64) OR (n.left.typ.form = Real64) THEN mod := "Real"
+		ELSIF (n.typ.form = Real32) OR (n.left.typ.form = Real32) THEN mod := "SReal"
+		ELSIF (n.typ.form = Int64) OR (n.left.typ.form = Int64) THEN mod := "Long"
+		ELSE mod := "Int"
+		END;
+		moda := mod + "%";
+		DevCPT.Find(moda, mobj);
+		IF mobj = NIL THEN
+			DevCPT.Import(moda, mod, done);
+			IF done THEN DevCPT.Find(moda, mobj) END
+		END;
+		nm := name$; DevCPT.FindImport(nm, mobj, obj);
+		n.class := Ncall; n.subcl := 0; n.obj := obj.link;
+		n.left.link := n.right; n.right := n.left;
+		n.left := DevCPT.NewNode(Nproc);
+		n.left.obj := obj; n.left.typ := obj.typ;
+		ASSERT(n.typ.form = obj.typ.form)
+	END UseThisCall;
+	
+	PROCEDURE Convert (n: DevCPT.Node; typ: DevCPT.Struct);
+		VAR new: DevCPT.Node; r: REAL;
+	BEGIN
+		IF n.class = Nconst THEN
+			ASSERT((n.typ.form IN {Int32, Int64}) & (typ = DevCPT.intrealtyp));
+			r := n.conval.realval + n.conval.intval;
+			IF r = n.conval.realval + n.conval.intval THEN
+				n.conval.realval := r; n.conval.intval := -1; n.typ := typ; n.obj := NIL
+			END
+		END;
+		IF (n.typ # typ)
+			& ((n.class # Nmop) OR (n.subcl # conv)
+				OR ~DevCPT.Includes(n.typ.form, n.left.typ.form) & ~DevCPT.Includes(n.typ.form, typ.form)) THEN
+			new := DevCPT.NewNode(0); new^ := n^;
+			n.class := Nmop; n.subcl := conv; n.left := new; n.right := NIL; n.obj := NIL
+		END;
+		n.typ := typ
+	END Convert;
+	
+	PROCEDURE UseCallForComp (n: DevCPT.Node);
+		VAR new: DevCPT.Node;
+	BEGIN
+		new := DevCPT.NewNode(0);
+		new.left := n.left; new.right := n.right;
+		new.typ := DevCPT.int32typ;
+		UseThisCall(new, "Comp");
+		n.left := new;
+		n.right := DevCPT.NewNode(Nconst); n.right.conval := DevCPT.NewConst();
+		n.right.conval.intval := 0; n.right.conval.realval := 0; n.right.typ := DevCPT.int32typ;
+	END UseCallForComp;
+	
+	PROCEDURE UseCallForConv (n: DevCPT.Node; opts: SET);
+		VAR f, g: INTEGER; typ: DevCPT.Struct;
+	BEGIN
+		typ := n.typ; f := typ.form; g := n.left.typ.form;
+		IF realConv IN opts THEN
+			IF f IN realSet THEN
+				IF g = Real32 THEN UseThisCall(n, "Long")
+				ELSIF g = Real64 THEN UseThisCall(n, "Short")
+				ELSIF g = Int64 THEN UseThisCall(n, "LFloat")
+				ELSIF g = Int32 THEN UseThisCall(n, "Float")
+				ELSE Convert(n.left, DevCPT.int32typ); UseThisCall(n, "Float")
+				END
+			ELSIF g IN realSet THEN
+				IF f = Int64 THEN UseThisCall(n, "LFloor")
+				ELSIF f = Int32 THEN UseThisCall(n, "Floor")
+				ELSE n.typ := DevCPT.int32typ; UseThisCall(n, "Floor"); Convert(n, typ)
+				END
+			END
+		END;
+		IF longConv IN opts THEN
+			IF f = Int64 THEN
+				IF g = Int32 THEN UseThisCall(n, "Long")
+				ELSIF ~(g IN realSet) THEN Convert(n.left, DevCPT.int32typ); UseThisCall(n, "IntToLong")
+				END
+			ELSIF g = Int64 THEN
+				IF f = Int32 THEN UseThisCall(n, "Short")
+				ELSIF ~(f IN realSet) THEN n.typ := DevCPT.int32typ; UseThisCall(n, "LongToInt"); Convert(n, typ)
+				END
+			END
+		END
+	END UseCallForConv;
+		
+	PROCEDURE UseCallForMop (n: DevCPT.Node; opts: SET);
+	BEGIN
+		CASE n.subcl OF
+		| minus:
+			IF (realMop IN opts) & (n.typ.form IN realSet) OR (longMop IN opts) & (n.typ.form = Int64) THEN
+				UseThisCall(n, "Neg")
+			END
+		| abs:
+			IF (realMop IN opts) & (n.typ.form IN realSet) OR (longMop IN opts) & (n.typ.form = Int64) THEN
+				UseThisCall(n, "Abs")
+			END
+		| odd:
+			IF (longOdd IN opts) & (n.left.typ.form = Int64) THEN UseThisCall(n, "Odd") END
+		| conv:
+			UseCallForConv(n, opts)
+		ELSE
+		END
+	END UseCallForMop;
+		
+	PROCEDURE UseCallForDop (n: DevCPT.Node; opts: SET);
+	BEGIN
+		IF (realDop IN opts) & (n.left.typ.form IN realSet)
+				OR (longDop IN opts) & (n.left.typ.form = Int64)
+				OR (intMulDiv IN opts) & (n.subcl IN {times, div, mod}) & (n.typ.form = Int32) THEN
+			CASE n.subcl OF
+			| times: UseThisCall(n, "Mul")
+			| slash: UseThisCall(n, "Div")
+			| div: UseThisCall(n, "Div")
+			| mod: UseThisCall(n, "Mod")
+			| plus: UseThisCall(n, "Add")
+			| minus: UseThisCall(n, "Sub")
+			| ash: UseThisCall(n, "Ash")
+			| min: UseThisCall(n, "Min")
+			| max: UseThisCall(n, "Max")
+			| eql..geq: UseCallForComp(n)
+			ELSE
+			END
+		END
+	END UseCallForDop;
+	
+	PROCEDURE UseCallForMove (n: DevCPT.Node; typ: DevCPT.Struct; opts: SET);
+		VAR f, g: INTEGER;
+	BEGIN
+		f := n.typ.form; g := typ.form;
+		IF f # g THEN
+			IF (realConv IN opts) & ((f IN realSet) OR (g IN realSet))
+					OR (longConv IN opts) & ((f = Int64) OR (g = Int64)) THEN
+				Convert(n, typ);
+				UseCallForConv(n, opts)
+			END
+		END
+	END UseCallForMove;
+		
+	PROCEDURE UseCallForAssign (n: DevCPT.Node; opts: SET);
+	BEGIN
+		IF n.subcl = assign THEN UseCallForMove(n.right, n.left.typ, opts) END
+	END UseCallForAssign;
+	
+	PROCEDURE UseCallForReturn (n: DevCPT.Node; opts: SET);
+	BEGIN
+		IF (n.left # NIL) & (n.obj # NIL) THEN UseCallForMove(n.left, n.obj.typ, opts) END
+	END UseCallForReturn;
+	
+	PROCEDURE UseCallForParam (n: DevCPT.Node; fp: DevCPT.Object; opts: SET);
+	BEGIN
+		WHILE n # NIL DO
+			UseCallForMove(n, fp.typ, opts);
+			n := n.link; fp := fp.link
+		END
+	END UseCallForParam;
+	
+	PROCEDURE UseCalls* (n: DevCPT.Node; opts: SET);
+	BEGIN
+		WHILE n # NIL DO
+			CASE n.class OF
+			| Nmop:
+				UseCalls(n.left, opts); UseCallForMop(n, opts)
+			| Ndop:
+				UseCalls(n.left, opts); UseCalls(n.right, opts); UseCallForDop(n, opts)
+			| Ncase:
+				UseCalls(n.left, opts); UseCalls(n.right.left, opts); UseCalls(n.right.right, opts)
+			| Nassign:
+				UseCalls(n.left, opts); UseCalls(n.right, opts); UseCallForAssign(n, opts)
+			| Ncall:
+				UseCalls(n.left, opts); UseCalls(n.right, opts); UseCallForParam(n.right, n.obj, opts)
+			| Nreturn:
+				UseCalls(n.left, opts); UseCallForReturn(n, opts)
+			| Ncasedo:
+				UseCalls(n.right, opts)
+			| Ngoto, Ndrop, Nloop, Nfield, Nderef, Nguard:
+				UseCalls(n.left, opts)
+			| Nenter, Nifelse, Nif, Nwhile, Nrepeat, Nwith, Ncomp, Nupto, Nindex:
+				UseCalls(n.left, opts); UseCalls(n.right, opts)
+			| Njsr, Nret, Nlabel, Ntrap, Nexit, Ninittd, Ntype, Nproc, Nconst, Nvar, Nvarpar:
+			END;
+			n := n.link
+		END
+	END UseCalls;
+	
+		
+	PROCEDURE UseReals* (n: DevCPT.Node; opts: SET);
+	BEGIN
+		WHILE n # NIL DO
+			CASE n.class OF
+			| Nmop:
+				IF (longMop IN opts) & (n.typ.form = Int64) & ((n.subcl = abs) OR (n.subcl = minus)) THEN
+					UseReals(n.left, opts - {hide} + {force}); n.typ := DevCPT.intrealtyp
+				ELSIF n.subcl = conv THEN UseReals(n.left, opts - {force} + {hide})
+				ELSE UseReals(n.left, opts - {force, hide})
+				END
+			| Ndop:
+				IF (longDop IN opts) & (n.left.typ.form = Int64) THEN
+					UseReals(n.left, opts - {hide} + {force}); UseReals(n.right, opts - {hide} + {force});
+					IF n.typ.form = Int64 THEN n.typ := DevCPT.intrealtyp END
+				ELSE UseReals(n.left, opts - {force, hide}); UseReals(n.right, opts - {force, hide})
+				END
+			| Ncase:
+				UseReals(n.left, opts - {force, hide}); UseReals(n.right.left, opts - {force, hide});
+				UseReals(n.right.right, opts - {force, hide})
+			| Ncasedo:
+				UseReals(n.right, opts - {force, hide})
+			| Ngoto, Ndrop, Nloop, Nreturn, Nfield, Nderef, Nguard:
+				UseReals(n.left, opts - {force, hide})
+			| Nenter, Nassign, Ncall, Nifelse, Nif, Nwhile, Nrepeat, Nwith, Ncomp, Nupto, Nindex:
+				UseReals(n.left, opts - {force, hide}); UseReals(n.right, opts - {force, hide})
+			| Njsr, Nret, Nlabel, Ntrap, Nexit, Ninittd, Ntype, Nproc, Nconst, Nvar, Nvarpar:
+			END;
+			IF force IN opts THEN Convert(n, DevCPT.intrealtyp)
+			ELSIF ~(hide IN opts) & (n.typ = DevCPT.intrealtyp) THEN Convert(n, DevCPT.int64typ)
+			END;
+			n := n.link
+		END
+	END UseReals;
+		
+END DevCPH.
+
+
+
+
+	PROCEDURE Traverse (n: DevCPT.Node; opts: SET);
+	BEGIN
+		WHILE n # NIL DO
+			CASE n.class OF
+			| Ncase:
+				Traverse(n.left, opts); Traverse(n.right.left, opts); Traverse(n.right.right, opts)
+			| Ncasedo:
+				Traverse(n.right, opts)
+			| Ngoto, Ndrop, Nloop, Nreturn, Nmop, Nfield, Nderef, Nguard:
+				Traverse(n.left, opts)
+			| Nenter, Nassign, Ncall, Nifelse, Nif, Nwhile, Nrepeat, Nwith, Ncomp, Ndop, Nupto, Nindex:
+				Traverse(n.left, opts); Traverse(n.right, opts)
+			| Njsr, Nret, Nlabel, Ntrap, Nexit, Ninittd, Ntype, Nproc, Nconst, Nvar, Nvarpar:
+			END;
+			n := n.link
+		END
+	END Traverse;
+		

BlackBox/Dev/Mod/CPL486.txt

@@ -0,0 +1,1057 @@
+MODULE DevCPL486;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPL486.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT DevCPM, DevCPT, DevCPE;
+	
+	TYPE
+		Item* = RECORD
+			mode*,  tmode*, form*: BYTE;
+			offset*, index*, reg*, scale*: INTEGER; (* adr = offset + index * scale *)
+			typ*: DevCPT.Struct;
+			obj*: DevCPT.Object
+		END ;
+		
+(* Items:
+
+	 mode	| offset	index		scale		reg     obj
+------------------------------------------------
+ 1 Var	 | adr		 xreg		 scale					  obj  (ea = FP + adr + xreg * scale)
+ 2 VarPar| off     xreg     scale            obj  (ea = [FP + obj.adr] + off + xreg * scale)
+ 3 Con	 | val              (val2)           NIL
+   Con   | off                               obj  (val = adr(obj) + off)
+	 Con	 | id														    NIL  (for predefined reals)
+ 6 LProc |                                   obj
+ 7 XProc |                                   obj
+ 9 CProc |                                   obj						
+10 IProc |                                   obj
+13 TProc | mthno						0/1		          obj	(0 = normal / 1 = super call)
+14 Ind	 | off		 xreg		 scale		Reg	      	(ea = Reg + off + xreg * scale)
+15 Abs	 | adr		 xreg		 scale				    NIL  (ea = adr + xreg * scale) 
+   Abs	 | off		 xreg		 scale				    obj  (ea = adr(obj) + off + xreg * scale)
+   Abs   | off     len      0                obj  (for constant strings and reals)
+16 Stk	 |																      	(ea = ESP)
+17 Cond	| CC
+18 Reg	 |				(Reg2)						 Reg
+19 DInd	| off		 xreg		 scale		Reg	      	(ea = [Reg + off + xreg * scale])
+
+	tmode	| record tag     array desc
+-------------------------------------
+  VarPar | [FP + obj.adr + 4]  [FP + obj.adr]
+  Ind    | [Reg - 4]         [Reg + 8]
+  Con    | Adr(typ.strobj)
+
+*)
+
+	CONST
+		processor* = 10; (* for i386 *)
+		NewLbl* = 0;
+
+	TYPE
+		Label* = INTEGER; (* 0: unassigned, > 0: address, < 0: - (linkadr + linktype * 2^24) *)
+		
+	VAR
+		level*: BYTE;
+		one*: DevCPT.Const;
+
+	CONST
+		(* item base modes (=object modes) *)
+		Var = 1; VarPar = 2; Con = 3; LProc = 6; XProc = 7; CProc = 9; IProc = 10; TProc = 13;
+	
+		(* item modes for i386 (must not overlap item basemodes,	> 13) *)
+		Ind = 14; Abs = 15; Stk = 16; Cond = 17; Reg = 18; DInd = 19;
+	
+		(* structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18; Guid = 23;
+		
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+		
+		(* condition codes *)
+		ccB = 2; ccAE = 3; ccBE = 6; ccA = 7; (* unsigned *)
+		ccL = 12; ccGE = 13; ccLE = 14; ccG = 15; (* signed *)
+		ccE = 4; ccNE = 5; ccS = 8; ccNS = 9; ccO = 0; ccNO = 1;
+		ccAlways = -1; ccNever = -2; ccCall = -3;
+		
+		(* registers *)
+		AX = 0; CX = 1; DX = 2; BX = 3; SP = 4; BP = 5; SI = 6; DI = 7; AH = 4; CH = 5; DH = 6; BH = 7;
+		
+		(* fixup types *)
+		absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; short = 105;
+		
+		(* system trap numbers *)
+		withTrap = -1; caseTrap = -2; funcTrap = -3; typTrap = -4;
+		recTrap = -5; ranTrap = -6; inxTrap = -7; copyTrap = -8;
+		
+
+	VAR
+		Size: ARRAY 32 OF INTEGER;	(* Size[typ.form] == +/- typ.size *)
+		a1, a2: Item;
+
+
+	PROCEDURE MakeReg* (VAR x: Item; reg: INTEGER; form: BYTE);
+	BEGIN
+		ASSERT((reg >= 0) & (reg < 8));
+		x.mode := Reg; x.reg := reg; x.form := form
+	END MakeReg;
+	
+	PROCEDURE MakeConst* (VAR x: Item; val: INTEGER; form: BYTE);
+	BEGIN
+		x.mode := Con; x.offset := val; x.form := form; x.obj := NIL;
+	END MakeConst;
+
+	PROCEDURE AllocConst* (VAR x: Item; con: DevCPT.Const; form: BYTE);
+		VAR r: REAL; short: SHORTREAL; c: DevCPT.Const; i: INTEGER;
+	BEGIN
+		IF form IN {Real32, Real64} THEN
+			r := con.realval;
+			IF ABS(r) <= MAX(SHORTREAL) THEN
+				short := SHORT(r);
+				IF short = r THEN form := Real32	(* a shortreal can represent the exact value *)
+				ELSE form := Real64	(* use a real *)
+				END
+			ELSE form := Real64	(* use a real *)
+			END
+		ELSIF form IN {String8, String16, Guid} THEN
+			x.index := con.intval2	(* string length *)
+		END;
+		DevCPE.AllocConst(con, form, x.obj, x.offset);
+		x.form := form; x.mode := Abs; x.scale := 0
+	END AllocConst;
+
+	(*******************************************************)
+	
+	PROCEDURE BegStat*; (* general-purpose procedure which is called before each statement *)
+	BEGIN
+	END BegStat;
+
+	PROCEDURE EndStat*; (* general-purpose procedure which is called after each statement *)
+	BEGIN
+	END EndStat;
+
+	(*******************************************************)
+	
+	PROCEDURE SetLabel* (VAR L: Label);
+		VAR link, typ, disp, x: INTEGER; c: SHORTCHAR;
+	BEGIN
+		ASSERT(L <= 0); link := -L;
+		WHILE link # 0 DO
+			typ := link DIV 1000000H; link := link MOD 1000000H;
+			IF typ = short THEN
+				disp := DevCPE.pc - link - 1; ASSERT(disp < 128);
+				DevCPE.PutByte(link, disp); link := 0
+			ELSIF typ = relative THEN
+				x := DevCPE.ThisWord(link); DevCPE.PutWord(link, DevCPE.pc - link - 4); link := x
+			ELSE
+				x := DevCPE.ThisWord(link); DevCPE.PutWord(link, DevCPE.pc + typ * 1000000H); link := x
+			END
+		END;		
+		L := DevCPE.pc;
+		a1.mode := 0; a2.mode := 0
+	END SetLabel;
+	
+
+	(*******************************************************)
+	
+	PROCEDURE GenWord (x: INTEGER);
+	BEGIN
+		DevCPE.GenByte(x); DevCPE.GenByte(x DIV 256)
+	END GenWord;
+
+	PROCEDURE GenDbl (x: INTEGER);
+	BEGIN
+		DevCPE.GenByte(x); DevCPE.GenByte(x DIV 256); DevCPE.GenByte(x DIV 10000H); DevCPE.GenByte(x DIV 1000000H)
+	END GenDbl;
+	
+	PROCEDURE CaseEntry* (tab, from, to: INTEGER);
+		VAR a, e: INTEGER;
+	BEGIN
+		a := tab + 4 * from; e := tab + 4 * to;
+		WHILE a <= e DO
+			DevCPE.PutByte(a, DevCPE.pc);
+			DevCPE.PutByte(a + 1, DevCPE.pc DIV 256);
+			DevCPE.PutByte(a + 2, DevCPE.pc DIV 65536);
+			INC(a, 4)
+		END;
+		a1.mode := 0; a2.mode := 0
+	END CaseEntry;
+
+	PROCEDURE GenLinked (VAR x: Item; type: BYTE);
+		VAR link: DevCPT.LinkList;
+	BEGIN
+		IF x.obj = NIL THEN GenDbl(x.offset)
+		ELSE
+			link := DevCPE.OffsetLink(x.obj, x.offset);
+			IF link # NIL THEN
+				GenDbl(type * 1000000H + link.linkadr MOD 1000000H);
+				link.linkadr := DevCPE.pc - 4
+			ELSE GenDbl(0)
+			END
+		END
+	END GenLinked;
+	
+	PROCEDURE CheckSize (form: BYTE; VAR w: INTEGER);
+	BEGIN
+		IF form IN {Int16, Char16} THEN DevCPE.GenByte(66H); w := 1
+		ELSIF form >= Int32 THEN ASSERT(form IN {Int32, Set, NilTyp, Pointer, ProcTyp}); w := 1
+		ELSE w := 0
+		END
+	END CheckSize;
+	
+	PROCEDURE CheckForm (form: BYTE; VAR mf: INTEGER);
+	BEGIN
+		IF form = Real32 THEN mf := 0
+		ELSIF form = Real64 THEN mf := 4
+		ELSIF form = Int32 THEN mf := 2
+		ELSE ASSERT(form = Int16); mf := 6
+		END
+	END CheckForm;
+	
+	PROCEDURE CheckConst (VAR x: Item; VAR s: INTEGER);
+	BEGIN
+		IF (x.form > Int8) & (x.offset >= -128) & (x.offset < 128) & (x.obj = NIL) THEN s := 2
+		ELSE s := 0
+		END 
+	END CheckConst;
+	
+	PROCEDURE GenConst (VAR x: Item; short: BOOLEAN);
+	BEGIN
+		IF x.obj # NIL THEN GenLinked(x, absolute)
+		ELSIF x.form <= Int8 THEN DevCPE.GenByte(x.offset)
+		ELSIF short & (x.offset >= -128) & (x.offset < 128) THEN DevCPE.GenByte(x.offset)
+		ELSIF x.form IN {Int16, Char16} THEN GenWord(x.offset)
+		ELSE GenDbl(x.offset)
+		END
+	END GenConst;
+	
+	PROCEDURE GenCExt (code: INTEGER; VAR x: Item);
+		VAR disp, mod, base, scale: INTEGER;
+	BEGIN
+		ASSERT(x.mode IN {Reg, Ind, Abs, Stk});
+		ASSERT((code MOD 8 = 0) & (code < 64));
+		disp := x.offset; base := x.reg; scale := x.scale;
+		IF x.mode = Reg THEN mod := 0C0H; scale := 0
+		ELSIF x.mode = Stk THEN base := SP; mod := 0; disp := 0; scale := 0
+		ELSIF x.mode = Abs THEN
+			IF scale = 1 THEN base := x.index; mod := 80H; scale := 0
+			ELSE base := BP; mod := 0
+			END
+		ELSIF (disp = 0) & (base # BP) THEN mod := 0
+		ELSIF (disp >= -128) & (disp < 128) THEN mod := 40H
+		ELSE mod := 80H
+		END;
+		IF scale # 0 THEN
+			DevCPE.GenByte(mod + code + 4); base := base + x.index * 8;
+			IF scale = 8 THEN DevCPE.GenByte(0C0H + base);
+			ELSIF scale = 4 THEN DevCPE.GenByte(80H + base);
+			ELSIF scale = 2 THEN DevCPE.GenByte(40H + base);
+			ELSE ASSERT(scale = 1); DevCPE.GenByte(base);
+			END;
+		ELSE
+			DevCPE.GenByte(mod + code + base);
+			IF (base = SP) & (mod <= 80H) THEN DevCPE.GenByte(24H) END
+		END;
+		IF x.mode = Abs THEN GenLinked(x, absolute)
+		ELSIF mod = 80H THEN GenDbl(disp)
+		ELSIF mod = 40H THEN DevCPE.GenByte(disp)
+		END
+	END GenCExt;
+	
+	PROCEDURE GenDExt (VAR r, x: Item);
+	BEGIN
+		ASSERT(r.mode = Reg);
+		GenCExt(r.reg * 8, x)
+	END GenDExt;
+	
+	(*******************************************************)
+	
+	PROCEDURE GenMove* (VAR from, to: Item);
+		VAR w: INTEGER;
+	BEGIN
+		ASSERT(Size[from.form] = Size[to.form]);
+		IF to.mode = Reg THEN
+			IF from.mode = Con THEN
+				IF to.reg = AX THEN
+
+					IF (a1.mode = Con) & (from.offset = a1.offset) & (from.obj = a1.obj) & (from.form = a1.form) THEN
+						RETURN
+					END;
+
+					a1 := from; a2.mode := 0
+				END;
+				CheckSize(from.form, w);
+				IF (from.offset = 0) & (from.obj = NIL) THEN
+					DevCPE.GenByte(30H + w); DevCPE.GenByte(0C0H + 9 * to.reg) (* XOR r,r *)
+				ELSE
+					DevCPE.GenByte(0B0H + w * 8 + to.reg); GenConst(from, FALSE)
+				END;
+			ELSIF (to.reg = AX) & (from.mode = Abs) & (from.scale = 0) THEN
+
+				IF (a1.mode = Abs) & (from.offset = a1.offset) & (from.obj = a1.obj) & (from.form = a1.form)
+					OR (a2.mode = Abs) & (from.offset = a2.offset) & (from.obj = a2.obj) & (from.form = a2.form) THEN
+					RETURN
+				END;
+
+				a1 := from; a2.mode := 0;
+				CheckSize(from.form, w);
+				DevCPE.GenByte(0A0H + w); GenLinked(from, absolute);
+			ELSIF (from.mode # Reg) OR (from.reg # to.reg) THEN
+				IF to.reg = AX THEN
+					IF (from.mode = Ind) & (from.scale = 0) & ((from.reg = BP) OR (from.reg = BX)) THEN
+
+						IF (a1.mode = Ind) & (from.offset = a1.offset) & (from.reg = a1.reg) & (from.form = a1.form)
+							OR (a2.mode = Ind) & (from.offset = a2.offset) & (from.reg = a2.reg) & (from.form = a2.form) THEN
+							RETURN
+						END;
+
+						a1 := from
+					ELSE a1.mode := 0
+					END;
+					a2.mode := 0
+				END;
+				CheckSize(from.form, w);
+				DevCPE.GenByte(8AH + w); GenDExt(to, from)
+			END 
+		ELSE
+			CheckSize(from.form, w);
+			IF from.mode = Con THEN
+				DevCPE.GenByte(0C6H + w); GenCExt(0, to); GenConst(from, FALSE);
+				a1.mode := 0; a2.mode := 0
+			ELSIF (from.reg = AX) & (to.mode = Abs) & (to.scale = 0) THEN
+				DevCPE.GenByte(0A2H + w); GenLinked(to, absolute);
+				a2 := to
+			ELSE
+				DevCPE.GenByte(88H + w); GenDExt(from, to);
+				IF from.reg = AX THEN
+					IF (to.mode = Ind) & (to.scale = 0) & ((to.reg = BP) OR (to.reg = BX)) THEN a2 := to END
+				ELSE a1.mode := 0; a2.mode := 0
+				END
+			END
+		END
+	END GenMove;
+	
+	PROCEDURE GenExtMove* (VAR from, to: Item);
+		VAR w, op: INTEGER;
+	BEGIN
+		ASSERT(from.mode # Con);
+		IF from.form IN {Byte, Char8, Char16} THEN op := 0B6H (* MOVZX *)
+		ELSE op := 0BEH (* MOVSX *)
+		END;
+		IF from.form IN {Int16, Char16} THEN INC(op) END;
+		DevCPE.GenByte(0FH); DevCPE.GenByte(op); GenDExt(to, from);
+		IF to.reg = AX THEN a1.mode := 0; a2.mode := 0 END
+	END GenExtMove;
+	
+	PROCEDURE GenSignExt* (VAR from, to: Item);
+	BEGIN
+		ASSERT(to.mode = Reg);
+		IF (from.mode = Reg) & (from.reg = AX) & (to.reg = DX) THEN
+			DevCPE.GenByte(99H)	(* cdq *)
+		ELSE
+			GenMove(from, to);	(* mov to, from *)
+			DevCPE.GenByte(0C1H); GenCExt(38H, to); DevCPE.GenByte(31)	(* sar to, 31 *)
+		END
+	END GenSignExt;
+	
+	PROCEDURE GenLoadAdr* (VAR from, to: Item);
+	BEGIN
+		ASSERT(to.form IN {Int32, Pointer, ProcTyp});
+		IF (from.mode = Abs) & (from.scale = 0) THEN
+			DevCPE.GenByte(0B8H + to.reg); GenLinked(from, absolute)
+		ELSIF from.mode = Stk THEN
+			DevCPE.GenByte(89H); GenCExt(SP * 8, to)
+		ELSIF (from.mode # Ind) OR (from.offset # 0) OR (from.scale # 0) THEN
+			DevCPE.GenByte(8DH); GenDExt(to, from)
+		ELSIF from.reg # to.reg THEN
+			DevCPE.GenByte(89H); GenCExt(from.reg * 8, to)
+		ELSE RETURN
+		END;
+		IF to.reg = AX THEN a1.mode := 0; a2.mode := 0 END
+	END GenLoadAdr;
+
+	PROCEDURE GenPush* (VAR src: Item);
+		VAR s: INTEGER;
+	BEGIN
+		IF src.mode = Con THEN
+			ASSERT(src.form >= Int32);
+			CheckConst(src, s); DevCPE.GenByte(68H + s); GenConst(src, TRUE)
+		ELSIF src.mode = Reg THEN
+			ASSERT((src.form >= Int16) OR (src.reg < 4));
+			DevCPE.GenByte(50H + src.reg)
+		ELSE
+			ASSERT(src.form >= Int32);
+			DevCPE.GenByte(0FFH); GenCExt(30H, src)
+		END
+	END GenPush;
+	
+	PROCEDURE GenPop* (VAR dst: Item);
+	BEGIN
+		IF dst.mode = Reg THEN
+			ASSERT((dst.form >= Int16) OR (dst.reg < 4));
+			DevCPE.GenByte(58H + dst.reg);
+			IF dst.reg = AX THEN a1.mode := 0; a2.mode := 0 END
+		ELSE
+			DevCPE.GenByte(08FH); GenCExt(0, dst) 
+		END
+	END GenPop;
+	
+	PROCEDURE GenConOp (op: INTEGER; VAR src, dst: Item);
+		VAR w, s: INTEGER;
+	BEGIN
+		ASSERT(Size[src.form] = Size[dst.form]);
+		CheckSize(src.form, w);
+		CheckConst(src, s);
+		IF (dst.mode = Reg) & (dst.reg = AX) & (s = 0) THEN
+			DevCPE.GenByte(op + 4 + w); GenConst(src, FALSE)
+		ELSE
+			DevCPE.GenByte(80H + s + w); GenCExt(op, dst); GenConst(src, TRUE)
+		END
+	END GenConOp;
+	
+	PROCEDURE GenDirOp (op: INTEGER; VAR src, dst: Item);
+		VAR w: INTEGER;
+	BEGIN
+		ASSERT(Size[src.form] = Size[dst.form]);
+		CheckSize(src.form, w);
+		IF dst.mode = Reg THEN
+			DevCPE.GenByte(op + 2 + w); GenDExt(dst, src)
+		ELSE
+			DevCPE.GenByte(op + w); GenDExt(src, dst)
+		END
+	END GenDirOp;
+
+	PROCEDURE GenAdd* (VAR src, dst: Item; ovflchk: BOOLEAN);
+		VAR w: INTEGER;
+	BEGIN
+		ASSERT(Size[src.form] = Size[dst.form]);
+		IF src.mode = Con THEN
+			IF src.obj = NIL THEN
+				IF src.offset = 1 THEN
+					IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(40H + dst.reg) (* inc *)
+					ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(0, dst)
+					END
+				ELSIF src.offset = -1 THEN
+					IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(48H + dst.reg) (* dec *)
+					ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(8, dst)
+					END
+				ELSIF src.offset # 0 THEN
+					GenConOp(0, src, dst)
+				ELSE RETURN
+				END
+			ELSE
+				GenConOp(0, src, dst)
+			END
+		ELSE
+			GenDirOp(0, src, dst)
+		END;
+		IF ovflchk THEN DevCPE.GenByte(0CEH) END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenAdd;
+	
+	PROCEDURE GenAddC* (VAR src, dst: Item; first, ovflchk: BOOLEAN);
+		VAR op: INTEGER;
+	BEGIN
+		ASSERT(Size[src.form] = Size[dst.form]);
+		IF first THEN op := 0 ELSE op := 10H END;
+		IF src.mode = Con THEN GenConOp(op, src, dst)
+		ELSE GenDirOp(op, src, dst)
+		END;
+		IF ovflchk THEN DevCPE.GenByte(0CEH) END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenAddC;
+	
+	PROCEDURE GenSub* (VAR src, dst: Item; ovflchk: BOOLEAN);
+		VAR w: INTEGER;
+	BEGIN
+		ASSERT(Size[src.form] = Size[dst.form]);
+		IF src.mode = Con THEN
+			IF src.obj = NIL THEN
+				IF src.offset = 1 THEN
+					IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(48H + dst.reg) (* dec *)
+					ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(8, dst)
+					END
+				ELSIF src.offset = -1 THEN
+					IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(40H + dst.reg) (* inc *)
+					ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(0, dst)
+					END
+				ELSIF src.offset # 0 THEN
+					GenConOp(28H, src, dst)
+				ELSE RETURN
+				END
+			ELSE
+				GenConOp(28H, src, dst)
+			END
+		ELSE
+			GenDirOp(28H, src, dst)
+		END;
+		IF ovflchk THEN DevCPE.GenByte(0CEH) END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenSub;
+
+	PROCEDURE GenSubC* (VAR src, dst: Item; first, ovflchk: BOOLEAN);
+		VAR op: INTEGER;
+	BEGIN
+		ASSERT(Size[src.form] = Size[dst.form]);
+		IF first THEN op := 28H ELSE op := 18H END;
+		IF src.mode = Con THEN GenConOp(op, src, dst)
+		ELSE GenDirOp(op, src, dst)
+		END;
+		IF ovflchk THEN DevCPE.GenByte(0CEH) END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenSubC;
+
+	PROCEDURE GenComp* (VAR src, dst: Item);
+		VAR w: INTEGER;
+	BEGIN
+		IF src.mode = Con THEN
+			IF (src.offset = 0) & (src.obj = NIL) & (dst.mode = Reg) THEN 
+				CheckSize(dst.form, w); DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * dst.reg) (* or r,r *)
+			ELSE GenConOp(38H, src, dst)
+			END
+		ELSE
+			GenDirOp(38H, src, dst)
+		END
+	END GenComp;
+	
+	PROCEDURE GenAnd* (VAR src, dst: Item);
+	BEGIN
+		IF src.mode = Con THEN
+			IF (src.obj # NIL) OR (src.offset # -1) THEN GenConOp(20H, src, dst) END
+		ELSE GenDirOp(20H, src, dst)
+		END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenAnd;
+	
+	PROCEDURE GenOr* (VAR src, dst: Item);
+	BEGIN
+		IF src.mode = Con THEN
+			IF (src.obj # NIL) OR (src.offset # 0) THEN GenConOp(8H, src, dst) END
+		ELSE GenDirOp(8H, src, dst)
+		END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenOr;
+	
+	PROCEDURE GenXor* (VAR src, dst: Item);
+	BEGIN
+		IF src.mode = Con THEN
+			IF (src.obj # NIL) OR (src.offset # 0) THEN GenConOp(30H, src, dst) END
+		ELSE GenDirOp(30H, src, dst)
+		END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenXor;
+	
+	PROCEDURE GenTest* (VAR x, y: Item);
+		VAR w: INTEGER;
+	BEGIN
+		ASSERT(Size[x.form] = Size[y.form]);
+		CheckSize(x.form, w);
+		IF x.mode = Con THEN
+			IF (x.mode = Reg) & (x.reg = AX) THEN
+				DevCPE.GenByte(0A8H + w); GenConst(x, FALSE)
+			ELSE
+				DevCPE.GenByte(0F6H + w); GenCExt(0, y); GenConst(x, FALSE)
+			END
+		ELSE
+			DevCPE.GenByte(84H + w);
+			IF y.mode = Reg THEN GenDExt(y, x) ELSE GenDExt(x, y) END
+		END
+	END GenTest;
+	
+	PROCEDURE GenNeg* (VAR dst: Item; ovflchk: BOOLEAN);
+		VAR w: INTEGER;
+	BEGIN
+		CheckSize(dst.form, w); DevCPE.GenByte(0F6H + w); GenCExt(18H, dst);
+		IF ovflchk THEN DevCPE.GenByte(0CEH) END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenNeg;
+	
+	PROCEDURE GenNot* (VAR dst: Item);
+		VAR w: INTEGER;
+	BEGIN
+		CheckSize(dst.form, w); DevCPE.GenByte(0F6H + w); GenCExt(10H, dst);
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenNot;
+	
+	PROCEDURE GenMul* (VAR src, dst: Item; ovflchk: BOOLEAN);
+		VAR w, s, val, f2, f5, f9: INTEGER;
+	BEGIN
+		ASSERT((dst.mode = Reg) & (Size[src.form] = Size[dst.form]));
+		IF (src.mode = Con) & (src.offset = 1) THEN RETURN END;
+		IF src.form <= Int8 THEN
+			ASSERT(dst.reg = 0);
+			DevCPE.GenByte(0F6H); GenCExt(28H, src)
+		ELSIF src.mode = Con THEN
+			val := src.offset;
+			IF (src.obj = NIL) & (val # 0) & ~ovflchk THEN
+				f2 := 0; f5 := 0; f9 := 0;
+				WHILE ~ODD(val) DO val := val DIV 2; INC(f2) END;
+				WHILE val MOD 9 = 0 DO val := val DIV 9; INC(f9) END;
+				WHILE val MOD 5 = 0 DO val := val DIV 5; INC(f5) END;
+				IF ABS(val) <= 3 THEN
+					WHILE f9 > 0 DO
+						DevCPE.GenByte(8DH);
+						DevCPE.GenByte(dst.reg * 8 + 4);
+						DevCPE.GenByte(0C0H + dst.reg * 9);
+						DEC(f9)
+					END;
+					WHILE f5 > 0 DO
+						DevCPE.GenByte(8DH);
+						DevCPE.GenByte(dst.reg * 8 + 4);
+						DevCPE.GenByte(80H + dst.reg * 9);
+						DEC(f5)
+					END;
+					IF ABS(val) = 3 THEN
+						DevCPE.GenByte(8DH); DevCPE.GenByte(dst.reg * 8 + 4); DevCPE.GenByte(40H + dst.reg * 9)
+					END;
+					IF f2 > 1 THEN DevCPE.GenByte(0C1H); DevCPE.GenByte(0E0H + dst.reg); DevCPE.GenByte(f2)
+					ELSIF f2 = 1 THEN DevCPE.GenByte(1); DevCPE.GenByte(0C0H + dst.reg * 9)
+					END;
+					IF val < 0 THEN DevCPE.GenByte(0F7H); GenCExt(18H, dst) END;
+					IF dst.reg = AX THEN a1.mode := 0; a2.mode := 0 END;
+					RETURN
+				END
+			END;
+			CheckSize(src.form, w); CheckConst(src, s);
+			DevCPE.GenByte(69H + s); GenDExt(dst, dst); GenConst(src, TRUE)
+		ELSE
+			CheckSize(src.form, w);
+			DevCPE.GenByte(0FH); DevCPE.GenByte(0AFH); GenDExt(dst, src)
+		END;
+		IF ovflchk THEN DevCPE.GenByte(0CEH) END;
+		IF dst.reg = AX THEN a1.mode := 0; a2.mode := 0 END
+	END GenMul;
+	
+	PROCEDURE GenDiv* (VAR src: Item; mod, pos: BOOLEAN);
+		VAR w, rem: INTEGER;
+	BEGIN
+		ASSERT(src.mode = Reg);
+		IF src.form >= Int32 THEN DevCPE.GenByte(99H) (* cdq *)
+		ELSIF src.form = Int16 THEN DevCPE.GenByte(66H); DevCPE.GenByte(99H) (* cwd *)
+		ELSE DevCPE.GenByte(66H); DevCPE.GenByte(98H) (* cbw *)
+		END;
+		CheckSize(src.form, w); DevCPE.GenByte(0F6H + w); GenCExt(38H, src); (* idiv src *)
+		IF src.form > Int8 THEN rem := 2 (* edx *) ELSE rem := 4 (* ah *) END;
+		IF pos THEN (* src > 0 *)
+			CheckSize(src.form, w); DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * rem); (* or rem,rem *)
+			IF mod THEN
+				DevCPE.GenByte(79H); DevCPE.GenByte(2);	(* jns end *)
+				DevCPE.GenByte(2 + w); GenCExt(8 * rem, src); (* add rem,src *)
+			ELSE
+				DevCPE.GenByte(79H); DevCPE.GenByte(1);	(* jns end *)
+				DevCPE.GenByte(48H);					(* dec eax *)
+			END
+		ELSE
+			CheckSize(src.form, w); DevCPE.GenByte(30H + w); GenCExt(8 * rem, src); (* xor src,rem *)
+			IF mod THEN
+				DevCPE.GenByte(79H);	(* jns end *)
+				IF src.form = Int16 THEN DevCPE.GenByte(9); DevCPE.GenByte(66H) ELSE DevCPE.GenByte(8) END;
+				DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * rem); (* or rem,rem *)
+				DevCPE.GenByte(74H); DevCPE.GenByte(4);	(* je end *)
+				DevCPE.GenByte(30H + w); GenCExt(8 * rem, src); (* xor src,rem *)
+				DevCPE.GenByte(2 + w); GenCExt(8 * rem, src); (* add rem,src *)
+			ELSE
+				DevCPE.GenByte(79H);	(* jns end *)
+				IF src.form = Int16 THEN DevCPE.GenByte(6); DevCPE.GenByte(66H) ELSE DevCPE.GenByte(5) END;
+				DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * rem); (* or rem,rem *)
+				DevCPE.GenByte(74H); DevCPE.GenByte(1);	(* je end *)
+				DevCPE.GenByte(48H);					(* dec eax *)
+			END
+(*
+			CheckSize(src.form, w); DevCPE.GenByte(3AH + w); GenCExt(8 * rem, src); (* cmp rem,src *)
+			IF mod THEN
+				DevCPE.GenByte(72H); DevCPE.GenByte(4);	(* jb end *)
+				DevCPE.GenByte(7FH); DevCPE.GenByte(2);	(* jg end *)
+				DevCPE.GenByte(2 + w); GenCExt(8 * rem, src); (* add rem,src *)
+			ELSE
+				DevCPE.GenByte(72H); DevCPE.GenByte(3);	(* jb end *)
+				DevCPE.GenByte(7FH); DevCPE.GenByte(1);	(* jg end *)
+				DevCPE.GenByte(48H);					(* dec eax *)
+			END
+*)
+		END;
+		a1.mode := 0; a2.mode := 0
+	END GenDiv;
+
+	PROCEDURE GenShiftOp* (op: INTEGER; VAR cnt, dst: Item);
+		VAR w: INTEGER;
+	BEGIN
+		CheckSize(dst.form, w);
+		IF cnt.mode = Con THEN
+			ASSERT(cnt.offset >= 0); ASSERT(cnt.obj = NIL);
+			IF cnt.offset = 1 THEN
+				IF (op = 10H) & (dst.mode = Reg) THEN (* shl r *)
+					DevCPE.GenByte(w); GenDExt(dst, dst) (* add r, r *)
+				ELSE
+					DevCPE.GenByte(0D0H + w); GenCExt(op, dst)
+				END
+			ELSIF cnt.offset > 1 THEN
+				DevCPE.GenByte(0C0H + w); GenCExt(op, dst); DevCPE.GenByte(cnt.offset)
+			END
+		ELSE
+			ASSERT((cnt.mode = Reg) & (cnt.reg = CX));
+			DevCPE.GenByte(0D2H + w); GenCExt(op, dst)
+		END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenShiftOp;
+	
+	PROCEDURE GenBitOp* (op: INTEGER; VAR num, dst: Item);
+	BEGIN
+		DevCPE.GenByte(0FH);
+		IF num.mode = Con THEN
+			ASSERT(num.obj = NIL);
+			DevCPE.GenByte(0BAH); GenCExt(op, dst); DevCPE.GenByte(num.offset)
+		ELSE
+			ASSERT((num.mode = Reg) & (num.form = Int32));
+			DevCPE.GenByte(83H + op); GenDExt(num, dst)
+		END;
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenBitOp;
+	
+	PROCEDURE GenSetCC* (cc: INTEGER; VAR dst: Item);
+	BEGIN
+		ASSERT((dst.form = Bool) & (cc >= 0));
+		DevCPE.GenByte(0FH); DevCPE.GenByte(90H + cc); GenCExt(0, dst);
+		IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
+	END GenSetCC;
+	
+	PROCEDURE GenFLoad* (VAR src: Item);
+		VAR mf: INTEGER;
+	BEGIN
+		IF src.mode = Con THEN (* predefined constants *)
+			DevCPE.GenByte(0D9H); DevCPE.GenByte(0E8H + src.offset)
+		ELSIF src.form = Int64 THEN
+			DevCPE.GenByte(0DFH); GenCExt(28H, src)
+		ELSE
+			CheckForm(src.form, mf);
+			DevCPE.GenByte(0D9H + mf); GenCExt(0, src)
+		END
+	END GenFLoad;
+	
+	PROCEDURE GenFStore* (VAR dst: Item; pop: BOOLEAN);
+		VAR mf: INTEGER;
+	BEGIN
+		IF dst.form = Int64 THEN ASSERT(pop);
+			DevCPE.GenByte(0DFH); GenCExt(38H, dst); DevCPE.GenByte(9BH)	(* wait *)
+		ELSE
+			CheckForm(dst.form, mf); DevCPE.GenByte(0D9H + mf);
+			IF pop THEN GenCExt(18H, dst); DevCPE.GenByte(9BH)	(* wait *)
+			ELSE GenCExt(10H, dst)
+			END
+		END;
+		a1.mode := 0; a2.mode := 0
+	END GenFStore;
+	
+	PROCEDURE GenFDOp* (op: INTEGER; VAR src: Item);
+		VAR mf: INTEGER;
+	BEGIN
+		IF src.mode = Reg THEN
+			DevCPE.GenByte(0DEH); DevCPE.GenByte(0C1H + op)
+		ELSE
+			CheckForm(src.form, mf);
+			DevCPE.GenByte(0D8H + mf); GenCExt(op, src)
+		END
+	END GenFDOp;
+	
+	PROCEDURE GenFMOp* (op: INTEGER);
+	BEGIN
+		DevCPE.GenByte(0D8H + op DIV 256);
+		DevCPE.GenByte(op MOD 256);
+		IF op = 07E0H THEN a1.mode := 0; a2.mode := 0 END	(* FSTSW AX *)
+	END GenFMOp;
+	
+	PROCEDURE GenJump* (cc: INTEGER; VAR L: Label; shortjmp: BOOLEAN);
+	BEGIN
+		IF cc # ccNever THEN
+			IF shortjmp OR (L > 0) & (DevCPE.pc + 2 - L <= 128) & (cc # ccCall) THEN
+				IF cc = ccAlways THEN DevCPE.GenByte(0EBH)
+				ELSE DevCPE.GenByte(70H + cc)
+				END;
+				IF L > 0 THEN DevCPE.GenByte(L - DevCPE.pc - 1)
+				ELSE ASSERT(L = 0); L := -(DevCPE.pc + short * 1000000H); DevCPE.GenByte(0)
+				END
+			ELSE
+				IF cc = ccAlways THEN DevCPE.GenByte(0E9H)
+				ELSIF cc = ccCall THEN DevCPE.GenByte(0E8H)
+				ELSE DevCPE.GenByte(0FH); DevCPE.GenByte(80H + cc)
+				END;
+				IF L > 0 THEN GenDbl(L - DevCPE.pc - 4)
+				ELSE GenDbl(-L); L := -(DevCPE.pc - 4 + relative * 1000000H)
+				END
+			END
+		END
+	END GenJump;
+	
+	PROCEDURE GenExtJump* (cc: INTEGER; VAR dst: Item);
+	BEGIN
+		IF cc = ccAlways THEN DevCPE.GenByte(0E9H)
+		ELSE DevCPE.GenByte(0FH); DevCPE.GenByte(80H + cc)
+		END;
+		dst.offset := 0; GenLinked(dst, relative)
+	END GenExtJump;
+	
+	PROCEDURE GenIndJump* (VAR dst: Item);
+	BEGIN
+		DevCPE.GenByte(0FFH); GenCExt(20H, dst)
+	END GenIndJump;
+	
+	PROCEDURE GenCaseJump* (VAR src: Item);
+		VAR link: DevCPT.LinkList; tab: INTEGER;
+	BEGIN
+		ASSERT((src.form = Int32) & (src.mode = Reg));
+		DevCPE.GenByte(0FFH); DevCPE.GenByte(24H); DevCPE.GenByte(85H + 8 * src.reg);
+		tab := (DevCPE.pc + 7) DIV 4 * 4;
+		NEW(link); link.offset := tab; link.linkadr := DevCPE.pc;
+		link.next := DevCPE.CaseLinks; DevCPE.CaseLinks := link;
+		GenDbl(absolute * 1000000H + tab);
+		WHILE DevCPE.pc < tab DO DevCPE.GenByte(90H) END;
+	END GenCaseJump;
+(*	
+	PROCEDURE GenCaseJump* (VAR src: Item; num: LONGINT; VAR tab: LONGINT);
+		VAR link: DevCPT.LinkList; else, last: LONGINT;
+	BEGIN
+		ASSERT((src.form = Int32) & (src.mode = Reg));
+		DevCPE.GenByte(0FFH); DevCPE.GenByte(24H); DevCPE.GenByte(85H + 8 * src.reg);
+		tab := (DevCPE.pc + 7) DIV 4 * 4;
+		else := tab + num * 4; last := else - 4;
+		NEW(link); link.offset := tab; link.linkadr := DevCPE.pc;
+		link.next := CaseLinks; CaseLinks := link;
+		GenDbl(absolute * 1000000H + tab);
+		WHILE DevCPE.pc < tab DO DevCPE.GenByte(90H) END;
+		WHILE DevCPE.pc < last DO GenDbl(table * 1000000H + else) END;
+		GenDbl(tableend * 1000000H + else)
+	END GenCaseJump;
+*)	
+	PROCEDURE GenCaseEntry* (VAR L: Label; last: BOOLEAN);
+		VAR typ: INTEGER;
+	BEGIN
+		IF last THEN typ := tableend * 1000000H ELSE typ := table * 1000000H END;
+		IF L > 0 THEN GenDbl(L + typ) ELSE GenDbl(-L); L := -(DevCPE.pc - 4 + typ) END
+	END GenCaseEntry;
+	
+	PROCEDURE GenCall* (VAR dst: Item);
+	BEGIN
+		IF dst.mode IN {LProc, XProc, IProc} THEN
+			DevCPE.GenByte(0E8H);
+			IF dst.obj.mnolev >= 0 THEN (* local *)
+				IF dst.obj.adr > 0 THEN GenDbl(dst.obj.adr - DevCPE.pc - 4)
+				ELSE GenDbl(-dst.obj.adr); dst.obj.adr := -(DevCPE.pc - 4 + relative * 1000000H)
+				END
+			ELSE (* imported *)
+				dst.offset := 0; GenLinked(dst, relative)
+			END
+		ELSE DevCPE.GenByte(0FFH); GenCExt(10H, dst)
+		END;
+		a1.mode := 0; a2.mode := 0
+	END GenCall;
+	
+	PROCEDURE GenAssert* (cc, no: INTEGER);
+	BEGIN
+		IF cc # ccAlways THEN
+			IF cc >= 0 THEN
+				DevCPE.GenByte(70H + cc); (* jcc end *)
+				IF no < 0 THEN DevCPE.GenByte(2) ELSE DevCPE.GenByte(3) END
+			END;
+			IF no < 0 THEN
+				DevCPE.GenByte(8DH); DevCPE.GenByte(0E0H - no)
+			ELSE
+				DevCPE.GenByte(8DH); DevCPE.GenByte(0F0H); DevCPE.GenByte(no)
+			END
+		END
+	END GenAssert;
+	
+	PROCEDURE GenReturn* (val: INTEGER);
+	BEGIN
+		IF val = 0 THEN DevCPE.GenByte(0C3H)
+		ELSE DevCPE.GenByte(0C2H); GenWord(val)
+		END;
+		a1.mode := 0; a2.mode := 0
+	END GenReturn;
+	
+	PROCEDURE LoadStr (size: INTEGER);
+	BEGIN
+		IF size = 2 THEN DevCPE.GenByte(66H) END;
+		IF size <= 1 THEN DevCPE.GenByte(0ACH) ELSE DevCPE.GenByte(0ADH) END (* lods *)
+	END LoadStr;
+	
+	PROCEDURE StoreStr (size: INTEGER);
+	BEGIN
+		IF size = 2 THEN DevCPE.GenByte(66H) END;
+		IF size <= 1 THEN DevCPE.GenByte(0AAH) ELSE DevCPE.GenByte(0ABH) END (* stos *)
+	END StoreStr;
+	
+	PROCEDURE ScanStr (size: INTEGER; rep: BOOLEAN);
+	BEGIN
+		IF size = 2 THEN DevCPE.GenByte(66H) END;
+		IF rep THEN DevCPE.GenByte(0F2H) END;
+		IF size <= 1 THEN DevCPE.GenByte(0AEH) ELSE DevCPE.GenByte(0AFH) END (* scas *)
+	END ScanStr;
+	
+	PROCEDURE TestNull (size: INTEGER);
+	BEGIN
+		IF size = 2 THEN DevCPE.GenByte(66H) END;
+		IF size <= 1 THEN DevCPE.GenByte(8); DevCPE.GenByte(0C0H); (* or al,al *)
+		ELSE DevCPE.GenByte(9); DevCPE.GenByte(0C0H); (* or ax,ax *)
+		END
+	END TestNull;
+	
+	PROCEDURE GenBlockMove* (wsize, len: INTEGER);	(* len = 0: len in ECX *)
+		VAR w: INTEGER;
+	BEGIN
+		IF len = 0 THEN (* variable size move *)
+			IF wsize = 4 THEN w := 1 ELSIF wsize = 2 THEN w := 1; DevCPE.GenByte(66H) ELSE w := 0 END;
+			DevCPE.GenByte(0F3H); DevCPE.GenByte(0A4H + w); (* rep:movs *)
+		ELSE (* fixed size move *)
+			len := len * wsize;
+			IF len >= 16 THEN
+				DevCPE.GenByte(0B9H); GenDbl(len DIV 4); (* ld ecx,len/4 *)
+				DevCPE.GenByte(0F3H); DevCPE.GenByte(0A5H); (* rep:movs long*)
+				len := len MOD 4
+			END;
+			WHILE len >= 4 DO DevCPE.GenByte(0A5H); DEC(len, 4) END; (* movs long *);
+			IF len >= 2 THEN DevCPE.GenByte(66H); DevCPE.GenByte(0A5H) END; (* movs word *);
+			IF ODD(len) THEN DevCPE.GenByte(0A4H) END; (* movs byte *)
+		END
+	END GenBlockMove;
+	
+	PROCEDURE GenBlockStore* (wsize, len: INTEGER);	(* len = 0: len in ECX *)
+		VAR w: INTEGER;
+	BEGIN
+		IF len = 0 THEN (* variable size move *)
+			IF wsize = 4 THEN w := 1 ELSIF wsize = 2 THEN w := 1; DevCPE.GenByte(66H) ELSE w := 0 END;
+			DevCPE.GenByte(0F3H); DevCPE.GenByte(0AAH + w); (* rep:stos *)
+		ELSE (* fixed size move *)
+			len := len * wsize;
+			IF len >= 16 THEN
+				DevCPE.GenByte(0B9H); GenDbl(len DIV 4); (* ld ecx,len/4 *)
+				DevCPE.GenByte(0F3H); DevCPE.GenByte(0ABH); (* rep:stos long*)
+				len := len MOD 4
+			END;
+			WHILE len >= 4 DO DevCPE.GenByte(0ABH); DEC(len, 4) END; (* stos long *);
+			IF len >= 2 THEN DevCPE.GenByte(66H); DevCPE.GenByte(0ABH) END; (* stos word *);
+			IF ODD(len) THEN DevCPE.GenByte(0ABH) END; (* stos byte *)
+		END
+	END GenBlockStore;
+	
+	PROCEDURE GenBlockComp* (wsize, len: INTEGER);	(* len = 0: len in ECX *)
+		VAR w: INTEGER;
+	BEGIN
+		ASSERT(len >= 0);
+		IF len > 0 THEN DevCPE.GenByte(0B9H); GenDbl(len) END; (* ld ecx,len *)
+		IF wsize = 4 THEN w := 1 ELSIF wsize = 2 THEN w := 1; DevCPE.GenByte(66H) ELSE w := 0 END;
+		DevCPE.GenByte(0F3H); DevCPE.GenByte(0A6H + w) (* repe:cmps *)
+	END GenBlockComp;
+	
+	PROCEDURE GenStringMove* (excl: BOOLEAN; wsize, dsize, len: INTEGER);
+	(*
+	len = 0: len in ECX, len = -1: len undefined; wsize # dsize -> convert; size = 0: opsize = 1, incsize = 2; excl: don't move 0X
+	*)
+		VAR loop, end: Label;
+	BEGIN
+		IF len > 0 THEN DevCPE.GenByte(0B9H); GenDbl(len) END; (* ld ecx,len *)
+		(* len >= 0: len IN ECX *)
+		IF (dsize = 2) & (wsize < 2) THEN DevCPE.GenByte(31H); DevCPE.GenByte(0C0H) END; (* xor eax,eax *)
+		loop := NewLbl; end := NewLbl;
+		SetLabel(loop); LoadStr(wsize);
+		IF wsize = 0 THEN DevCPE.GenByte(46H) END; (* inc esi *)
+		IF len < 0 THEN (* no limit *)
+			StoreStr(dsize); TestNull(wsize); GenJump(ccNE, loop, TRUE);
+			IF excl THEN (* dec edi *)
+				DevCPE.GenByte(4FH);
+				IF dsize # 1 THEN DevCPE.GenByte(4FH) END
+			END;
+		ELSE	(* cx limit *)
+			IF excl THEN TestNull(wsize); GenJump(ccE, end, TRUE); StoreStr(dsize)
+			ELSE StoreStr(dsize); TestNull(wsize); GenJump(ccE, end, TRUE)
+			END;
+			DevCPE.GenByte(49H); (* dec ecx *)
+			GenJump(ccNE, loop, TRUE);
+			GenAssert(ccNever, copyTrap); (* trap *)
+			SetLabel(end)
+		END;
+		a1.mode := 0; a2.mode := 0
+	END GenStringMove;
+	
+	PROCEDURE GenStringComp* (wsize, dsize: INTEGER);
+	(* wsize # dsize -> convert; size = 0: opsize = 1, incsize = 2; *)
+		VAR loop, end: Label;
+	BEGIN
+		IF (dsize = 2) & (wsize < 2) THEN DevCPE.GenByte(31H); DevCPE.GenByte(0C0H); (* xor eax,eax *) END;
+		loop := NewLbl; end := NewLbl;
+		SetLabel(loop); LoadStr(wsize);
+		IF wsize = 0 THEN DevCPE.GenByte(46H) END; (* inc esi *)
+		ScanStr(dsize, FALSE); GenJump(ccNE, end, TRUE);
+		IF dsize = 0 THEN DevCPE.GenByte(47H) END; (* inc edi *)
+		TestNull(wsize); GenJump(ccNE, loop, TRUE);
+		SetLabel(end);
+		a1.mode := 0; a2.mode := 0
+	END GenStringComp;
+
+	PROCEDURE GenStringLength* (wsize, len: INTEGER);	(* len = 0: len in ECX, len = -1: len undefined *)
+	BEGIN
+		DevCPE.GenByte(31H); DevCPE.GenByte(0C0H); (* xor eax,eax *)
+		IF len # 0 THEN DevCPE.GenByte(0B9H); GenDbl(len) END; (* ld ecx,len *)
+		ScanStr(wsize, TRUE);
+		a1.mode := 0; a2.mode := 0
+	END GenStringLength;
+	
+	PROCEDURE GenStrStore* (size: INTEGER);
+		VAR w: INTEGER;
+	BEGIN
+		IF size # 0 THEN
+			IF size MOD 4 = 0 THEN w := 1; size := size DIV 4
+			ELSIF size MOD 2 = 0 THEN w := 2; size := size DIV 2
+			ELSE w := 0
+			END;
+			DevCPE.GenByte(0B9H); GenDbl(size); (* ld ecx,size *)
+			IF w = 2 THEN DevCPE.GenByte(66H); w := 1 END
+		ELSE w := 0
+		END;
+		DevCPE.GenByte(0F3H); DevCPE.GenByte(0AAH + w); (* rep:stos *)
+		a1.mode := 0; a2.mode := 0
+	END GenStrStore;
+
+	PROCEDURE GenCode* (op: INTEGER);
+	BEGIN
+		DevCPE.GenByte(op);
+		a1.mode := 0; a2.mode := 0
+	END GenCode;
+
+
+	PROCEDURE Init*(opt: SET);
+	BEGIN
+		DevCPE.Init(processor, opt);
+		level := 0;
+		NEW(one); one.realval := 1.0; one.intval := DevCPM.ConstNotAlloc;
+	END Init;
+
+	PROCEDURE Close*;
+	BEGIN
+		a1.obj := NIL; a1.typ := NIL; a2.obj := NIL; a2.typ := NIL; one := NIL;
+		DevCPE.Close
+	END Close;
+
+BEGIN
+	Size[Undef] := 0;
+	Size[Byte] := 1;
+	Size[Bool] := 1;
+	Size[Char8] := 1;
+	Size[Int8] := 1;
+	Size[Int16] := 2;
+	Size[Int32] := 4;
+	Size[Real32] := -4;
+	Size[Real64] := -8;
+	Size[Set] := 4;
+	Size[String8] := 0;
+	Size[NilTyp] := 4;
+	Size[NoTyp] := 0;
+	Size[Pointer] := 4;
+	Size[ProcTyp] := 4;
+	Size[Comp] := 0;
+	Size[Char16] := 2;
+	Size[Int64] := 8;
+	Size[String16] := 0
+END DevCPL486.

BlackBox/Dev/Mod/CPM.txt

@@ -0,0 +1,853 @@
+MODULE DevCPM;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPM.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, Kernel, Files, Stores, Models, Views, TextModels, TextMappers, StdLog, DevMarkers;
+
+	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;
+		
+TYPE
+	File = POINTER TO RECORD next: File; f: Files.File 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 *)
+		codeDir*: ARRAY 16 OF CHAR;
+		symDir*: ARRAY 16 OF CHAR;
+		checksum*: INTEGER;	(* symbol file checksum *)
+		
+		lastpos: INTEGER;
+		realpat: INTEGER;
+		lrealpat: RECORD H, L: INTEGER END;
+		fpi, fpj: SHORTINT; fp: ARRAY 4 OF SHORTCHAR;
+		ObjFName: Files.Name;
+
+		in: TextModels.Reader;
+		oldSymFile, symFile, objFile: Files.File;
+		inSym: Files.Reader;
+		outSym, outObj: Files.Writer;
+		
+		errNo, errPos: ARRAY maxErrors OF INTEGER;
+		
+		lineReader: TextModels.Reader;
+		lineNum: INTEGER;
+		
+		crc32tab: ARRAY 256 OF INTEGER;
+
+
+	PROCEDURE^ err* (n: INTEGER);
+
+	PROCEDURE Init* (source: TextModels.Reader; logtext: TextModels.Model);
+	BEGIN
+		in := source;
+		DevMarkers.Unmark(in.Base());
+		noerr := TRUE; options := {};
+		curpos := in.Pos(); errpos := curpos; lastpos := curpos - 11; errors := 0;
+		codeDir := OFdir; symDir := SFdir
+	END Init;
+	
+	PROCEDURE Close*;
+	BEGIN
+		oldSymFile := NIL; inSym := NIL;
+		symFile := NIL; outSym := NIL;
+		objFile := NIL; outObj := NIL;
+		in := NIL; lineReader := NIL
+	END Close;
+
+	PROCEDURE Get* (VAR ch: SHORTCHAR);
+		VAR ch1: CHAR;
+	BEGIN
+		REPEAT in.ReadChar(ch1); INC(curpos) UNTIL (ch1 < 100X) & (ch1 # TextModels.viewcode);
+		ch := SHORT(ch1)
+	END Get;
+	
+	PROCEDURE GetL* (VAR ch: CHAR);
+	BEGIN
+		REPEAT in.ReadChar(ch); INC(curpos) UNTIL ch # TextModels.viewcode;
+	END GetL;
+	
+	PROCEDURE LineOf* (pos: INTEGER): INTEGER;
+		VAR ch: CHAR;
+	BEGIN
+		IF lineReader = NIL THEN lineReader := in.Base().NewReader(NIL); lineReader.SetPos(0); lineNum := 0 END;
+		IF lineReader.Pos() > pos THEN lineReader.SetPos(0); lineNum := 0 END;
+		WHILE lineReader.Pos() < pos DO
+			lineReader.ReadChar(ch);
+			IF ch = 0DX THEN INC(lineNum) END
+		END;
+		RETURN lineNum
+	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* (VAR str: ARRAY OF SHORTCHAR): BOOLEAN;
+		VAR i: SHORTINT; 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* (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 = "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, 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* (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* (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* (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* (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* (id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+	BEGIN
+		IF ((num = -10) OR (id = "ccall")) & (options * {sys386, interface} # {}) THEN flag := -10
+		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* (VAR 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: SHORTCHAR);
+	BEGIN
+		StdLog.Char(ch)
+	END LogW;
+	
+	PROCEDURE LogWStr* (s: ARRAY OF SHORTCHAR);
+		VAR str: ARRAY 256 OF CHAR;
+	BEGIN
+		str := s$; StdLog.String(str)
+	END LogWStr;
+	
+	PROCEDURE LogWNum* (i, len: INTEGER);
+	BEGIN
+		StdLog.Int(i)
+	END LogWNum;
+
+	PROCEDURE LogWLn*;
+	BEGIN
+		StdLog.Ln
+	END LogWLn;
+(*	
+	PROCEDURE LogW* (ch: CHAR);
+	BEGIN
+		out.WriteChar(ch);
+	END LogW;
+	
+	PROCEDURE LogWStr* (s: ARRAY OF CHAR);
+	BEGIN
+		out.WriteString(s);
+	END LogWStr;
+	
+	PROCEDURE LogWNum* (i, len: LONGINT);
+	BEGIN
+		out.WriteChar(" "); out.WriteInt(i);
+	END LogWNum;
+
+	PROCEDURE LogWLn*;
+	BEGIN
+		out.WriteLn;
+		Views.RestoreDomain(logbuf.Domain())
+	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 InsertMarks* (text: TextModels.Model);
+		VAR i, j, x, y, n: INTEGER; script: Stores.Operation;
+	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 *)
+		Models.BeginModification(Models.clean, text);
+		Models.BeginScript(text, "#Dev:InsertMarkers", script);
+		WHILE n > 0 DO DEC(n);
+			DevMarkers.Insert(text, errPos[n], DevMarkers.dir.New(errNo[n]))
+		END;
+		Models.EndScript(text, script);
+		Models.EndModification(Models.clean, text);
+	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);
+		VAR l, h: INTEGER;
+	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* (VAR modName: ARRAY OF SHORTCHAR; VAR done: BOOLEAN);
+		VAR tag: INTEGER; loc: Files.Locator; dir, name: Files.Name;
+	BEGIN
+		done := FALSE;
+		IF modName = "@file" THEN
+			oldSymFile := file
+		ELSE
+			name := modName$; Kernel.SplitName(name, dir, name);
+			Kernel.MakeFileName(name, Kernel.symType); 
+			loc := Files.dir.This(dir); loc := loc.This(symDir);
+			oldSymFile := Files.dir.Old(loc, name, Files.shared);
+			IF (oldSymFile = NIL) & (dir = "") THEN
+				loc := Files.dir.This(SYSdir); loc := loc.This(symDir);
+				oldSymFile := Files.dir.Old(loc, name, Files.shared)
+			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* (VAR r: SHORTREAL);
+	BEGIN
+		WriteReal(outSym, r)
+	END SymWReal;
+
+	PROCEDURE SymWLReal* (VAR r: REAL);
+	BEGIN
+		WriteLReal(outSym, r)
+	END SymWLReal;
+
+	PROCEDURE SymReset*;
+	BEGIN
+		outSym.SetPos(4)
+	END SymReset;
+
+	PROCEDURE NewSym* (VAR modName: ARRAY OF SHORTCHAR);
+		VAR loc: Files.Locator; dir: Files.Name;
+	BEGIN
+		ObjFName := modName$; Kernel.SplitName(ObjFName, dir, ObjFName);
+		loc := Files.dir.This(dir); loc := loc.This(symDir);
+		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* (VAR 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* (VAR modName: ARRAY OF SHORTCHAR);
+		VAR loc: Files.Locator; dir: Files.Name;
+	BEGIN
+		errpos := 0;
+		ObjFName := modName$; Kernel.SplitName(ObjFName, dir, ObjFName);
+		loc := Files.dir.This(dir); loc := loc.This(codeDir);
+		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.

BlackBox/Dev/Mod/CPP.txt

@@ -0,0 +1,1650 @@
+MODULE DevCPP;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPP.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT
+		DevCPM, DevCPT, DevCPB, DevCPS;
+		
+	CONST
+		anchorVarPar = TRUE;
+	
+		(* numtyp values *)
+		char = 1; integer = 2; real = 4; int64 = 5; real32 = 6; real64 = 7;
+
+		(*symbol values*)
+		null = 0; times = 1; slash = 2; div = 3; mod = 4;
+		and = 5; plus = 6; minus = 7; or = 8; eql = 9;
+		neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
+		in = 15; is = 16; arrow = 17; dollar = 18; period = 19;
+		comma = 20; colon = 21; upto = 22; rparen = 23; rbrak = 24;
+		rbrace = 25; of = 26; then = 27; do = 28; to = 29;
+		by = 30; not = 33;
+		lparen = 40; lbrak = 41; lbrace = 42; becomes = 44;
+		number = 45; nil = 46; string = 47; ident = 48; semicolon = 49;
+		bar = 50; end = 51; else = 52; elsif = 53; until = 54;
+		if = 55; case = 56; while = 57; repeat = 58; for = 59;
+		loop = 60; with = 61; exit = 62; return = 63; array = 64;
+		record = 65; pointer = 66; begin = 67; const = 68; type = 69;
+		var = 70; out = 71; procedure = 72; close = 73; import = 74;
+		module = 75; eof = 76;
+
+		(* object modes *)
+		Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
+		SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; Attr = 20;
+
+		(* Structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18;
+		intSet = {Int8..Int32, Int64}; charSet = {Char8, Char16};
+		
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+
+		(*function number*)
+		haltfn = 0; newfn = 1; incfn = 13; sysnewfn = 30;
+
+		(* nodes classes *)
+		Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
+		Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
+		Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
+		Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
+		Nreturn = 26; Nwith = 27; Ntrap = 28; Ncomp = 30;
+
+		(* node subclasses *)
+		super = 1;
+		
+		(* module visibility of objects *)
+		internal = 0; external = 1; externalR = 2; inPar = 3; outPar = 4;
+
+		(* procedure flags (conval.setval) *)
+		hasBody = 1; isRedef = 2; slNeeded = 3; imVar = 4;
+		
+		(* attribute flags (attr.adr, struct.attribute, proc.conval.setval)*)
+		newAttr = 16; absAttr = 17; limAttr = 18; empAttr = 19; extAttr = 20;
+		
+		(* case statement flags (conval.setval) *)
+		useTable = 1; useTree = 2;
+		
+		(* sysflags *)
+		nilBit = 1; inBit = 2; outBit = 4; newBit = 8; iidBit = 16; interface = 10; som = 20; jstr = -13;
+		
+		
+	TYPE
+		Elem = POINTER TO RECORD
+			next: Elem;
+			struct: DevCPT.Struct;
+			obj, base: DevCPT.Object;
+			pos: INTEGER;
+			name: DevCPT.String
+		END;
+		
+		
+	VAR
+		sym, level: BYTE;
+		LoopLevel: SHORTINT;
+		TDinit, lastTDinit: DevCPT.Node;
+		userList: Elem;
+		recList: Elem;
+		hasReturn: BOOLEAN;
+		numUsafeVarPar, numFuncVarPar: INTEGER;
+		
+
+	PROCEDURE^ Type(VAR typ: DevCPT.Struct; VAR name: DevCPT.String);
+	PROCEDURE^ Expression(VAR x: DevCPT.Node);
+	PROCEDURE^ Block(VAR procdec, statseq: DevCPT.Node);
+	
+	(* forward type handling *)
+	
+	PROCEDURE IncompleteType (typ: DevCPT.Struct): BOOLEAN;
+	BEGIN
+		IF typ.form = Pointer THEN typ := typ.BaseTyp END;
+		RETURN (typ = DevCPT.undftyp) OR (typ.comp = Record) & (typ.BaseTyp = DevCPT.undftyp)
+	END IncompleteType;
+	
+	PROCEDURE SetType (struct: DevCPT.Struct; obj: DevCPT.Object; typ: DevCPT.Struct; name: DevCPT.String);
+		VAR u: Elem;
+	BEGIN
+		IF obj # NIL THEN obj.typ := typ ELSE struct.BaseTyp := typ END;
+		IF name # NIL THEN
+			NEW(u); u.struct := struct; u.obj := obj; u.pos := DevCPM.errpos; u.name := name;
+			u.next := userList; userList := u
+		END
+	END SetType;
+
+	PROCEDURE CheckAlloc (VAR typ: DevCPT.Struct; dynAllowed: BOOLEAN; pos: INTEGER);
+	BEGIN
+		typ.pvused := TRUE;
+		IF typ.comp = DynArr THEN
+			IF ~dynAllowed THEN DevCPM.Mark(88, pos); typ := DevCPT.undftyp END
+		ELSIF typ.comp = Record THEN
+			IF (typ.attribute = absAttr) OR (typ.attribute = limAttr) & (typ.mno # 0) THEN
+				DevCPM.Mark(193, pos); typ := DevCPT.undftyp
+			END
+		END
+	END CheckAlloc;
+
+	PROCEDURE CheckRecursiveType (outer, inner: DevCPT.Struct; pos: INTEGER);
+		VAR fld: DevCPT.Object;
+	BEGIN
+		IF outer = inner THEN DevCPM.Mark(58, pos)
+		ELSIF inner.comp IN {Array, DynArr} THEN CheckRecursiveType(outer, inner.BaseTyp, pos)
+		ELSIF inner.comp = Record THEN
+			fld := inner.link;
+			WHILE (fld # NIL) & (fld.mode = Fld) DO
+				CheckRecursiveType(outer, fld.typ, pos);
+				fld := fld.link
+			END;
+			IF inner.BaseTyp # NIL THEN CheckRecursiveType(outer, inner.BaseTyp, pos) END
+		END
+	END CheckRecursiveType;
+	
+	PROCEDURE FixType (struct: DevCPT.Struct; obj: DevCPT.Object; typ: DevCPT.Struct; pos: INTEGER);
+	(* fix forward reference *)
+		VAR t: DevCPT.Struct; f, bf: DevCPT.Object; i: SHORTINT;
+	BEGIN
+		IF obj # NIL THEN
+			IF obj.mode = Var THEN	(* variable type *)
+				IF struct # NIL THEN	(* receiver type *)
+					IF (typ.form # Pointer) OR (typ.BaseTyp # struct) THEN DevCPM.Mark(180, pos) END;
+				ELSE CheckAlloc(typ, obj.mnolev > level, pos)	(* TRUE for parameters *)
+				END
+			ELSIF obj.mode = VarPar THEN	(* varpar type *)
+				IF struct # NIL THEN	(* varpar receiver type *)
+					IF typ # struct THEN DevCPM.Mark(180, pos) END
+				END
+			ELSIF obj.mode = Fld THEN	(* field type *)
+				CheckAlloc(typ, FALSE, pos);
+				CheckRecursiveType(struct, typ, pos)
+			ELSIF obj.mode = TProc THEN	(* proc return type *)
+				IF typ.form = Comp THEN typ := DevCPT.undftyp; DevCPM.Mark(54, pos) END
+			ELSIF obj.mode = Typ THEN	(* alias type *)
+				IF typ.form IN {Byte..Set, Char16, Int64} THEN	(* make alias structure *)
+					t := DevCPT.NewStr(typ.form, Basic); i := t.ref;
+					t^ := typ^; t.ref := i; t.strobj := obj; t.mno := 0;
+					t.BaseTyp := typ; typ := t
+				END;
+				IF obj.vis # internal THEN
+					IF typ.comp = Record THEN typ.exp := TRUE
+					ELSIF typ.form = Pointer THEN typ.BaseTyp.exp := TRUE
+					END
+				END
+			ELSE HALT(100)
+			END;
+			obj.typ := typ
+		ELSE
+			IF struct.form = Pointer THEN	(* pointer base type *)
+				IF typ.comp = Record THEN DevCPM.PropagateRecPtrSysFlag(typ.sysflag, struct.sysflag)
+				ELSIF typ.comp IN {Array, DynArr} THEN DevCPM.PropagateArrPtrSysFlag(typ.sysflag, struct.sysflag)
+				ELSE typ := DevCPT.undftyp; DevCPM.Mark(57, pos)
+				END;
+				struct.untagged := struct.sysflag > 0;
+				IF (struct.strobj # NIL) & (struct.strobj.vis # internal) THEN typ.exp := TRUE END;
+			ELSIF struct.comp = Array THEN	(* array base type *)
+				CheckAlloc(typ, FALSE, pos);
+				CheckRecursiveType(struct, typ, pos)
+			ELSIF struct.comp = DynArr THEN	(* array base type *)
+				CheckAlloc(typ, TRUE, pos);
+				CheckRecursiveType(struct, typ, pos)
+			ELSIF struct.comp = Record THEN	(* record base type *)
+				IF typ.form = Pointer THEN typ := typ.BaseTyp END;
+				typ.pvused := TRUE; struct.extlev := SHORT(SHORT(typ.extlev + 1));
+				DevCPM.PropagateRecordSysFlag(typ.sysflag, struct.sysflag);
+				IF (typ.attribute = 0) OR (typ.attribute = limAttr) & (typ.mno # 0) THEN DevCPM.Mark(181, pos)
+				ELSIF (struct.attribute = absAttr) & (typ.attribute # absAttr) THEN DevCPM.Mark(191, pos)
+				ELSIF (typ.attribute = limAttr) & (struct.attribute # limAttr) THEN DevCPM.Mark(197, pos)
+				END;
+				f := struct.link;
+				WHILE f # NIL DO	(* check for field name conflicts *)
+					DevCPT.FindField(f.name, typ, bf);
+					IF bf # NIL THEN DevCPM.Mark(1, pos) END;
+					f := f.link
+				END;
+				CheckRecursiveType(struct, typ, pos);
+				struct.untagged := struct.sysflag > 0;
+			ELSIF struct.form = ProcTyp THEN	(* proc type return type *)
+				IF typ.form = Comp THEN typ := DevCPT.undftyp; DevCPM.Mark(54, pos) END;
+			ELSE HALT(100)
+			END;
+			struct.BaseTyp := typ
+		END
+	END FixType;
+
+	PROCEDURE CheckForwardTypes;
+		VAR u, next: Elem; progress: BOOLEAN;
+	BEGIN
+		u := userList; userList := NIL;
+		WHILE u # NIL DO
+			next := u.next; DevCPS.name := u.name^$; DevCPT.Find(DevCPS.name, u.base);
+			IF u.base = NIL THEN DevCPM.Mark(0, u.pos)
+			ELSIF u.base.mode # Typ THEN DevCPM.Mark(72, u.pos)
+			ELSE u.next := userList; userList := u	(* reinsert *)
+			END;
+			u := next
+		END;
+		REPEAT	(* iteration for multy level alias *)
+			u := userList; userList := NIL; progress := FALSE;
+			WHILE u # NIL DO
+				next := u.next;
+				IF IncompleteType(u.base.typ) THEN
+					u.next := userList; userList := u	(* reinsert *)
+				ELSE
+					progress := TRUE;
+					FixType(u.struct, u.obj, u.base.typ, u.pos)
+				END;
+				u := next
+			END
+		UNTIL (userList = NIL) OR ~progress;
+		u := userList;	(* remaining type relations are cyclic *)
+		WHILE u # NIL DO
+			IF (u.obj = NIL) OR (u.obj.mode = Typ) THEN DevCPM.Mark(58, u.pos) END;
+			u := u.next
+		END;
+	END CheckForwardTypes;
+	
+	PROCEDURE CheckUnimpl (m: DevCPT.Object; typ: DevCPT.Struct; pos: INTEGER);
+		VAR obj: DevCPT.Object;
+	BEGIN
+		IF m # NIL THEN
+			IF (m.mode = TProc) & (absAttr IN m.conval.setval) THEN
+				DevCPT.FindField(m.name^, typ, obj);
+				IF (obj = NIL) OR (obj.mode # TProc) OR (absAttr IN obj.conval.setval) THEN
+					DevCPM.Mark(192, pos);
+					DevCPM.LogWLn; DevCPM.LogWStr("  "); DevCPM.LogWStr(m.name^);
+					DevCPM.LogWStr(" not implemented");
+					IF typ.strobj # NIL THEN
+						DevCPM.LogWStr(" in "); DevCPM.LogWStr(typ.strobj.name^)
+					END
+				END
+			END;
+			CheckUnimpl(m.left, typ, pos);
+			CheckUnimpl(m.right, typ, pos)
+		END
+	END CheckUnimpl;
+	
+	PROCEDURE CheckRecords (rec: Elem);
+		VAR b: DevCPT.Struct;
+	BEGIN
+		WHILE rec # NIL DO	(* check for unimplemented methods in base type *)
+			b := rec.struct.BaseTyp;
+			WHILE (b # NIL) & (b # DevCPT.undftyp) DO
+				CheckUnimpl(b.link, rec.struct, rec.pos);
+				b := b.BaseTyp
+			END;
+			rec := rec.next
+		END
+	END CheckRecords;
+
+
+	PROCEDURE err(n: SHORTINT);
+	BEGIN DevCPM.err(n)
+	END err;
+
+	PROCEDURE CheckSym(s: SHORTINT);
+	BEGIN
+		IF sym = s THEN DevCPS.Get(sym) ELSE DevCPM.err(s) END
+	END CheckSym;
+
+	PROCEDURE qualident(VAR id: DevCPT.Object);
+		VAR obj: DevCPT.Object; lev: BYTE;
+	BEGIN (*sym = ident*)
+		DevCPT.Find(DevCPS.name, obj); DevCPS.Get(sym);
+		IF (sym = period) & (obj # NIL) & (obj.mode = Mod) THEN
+			DevCPS.Get(sym);
+			IF sym = ident THEN
+				DevCPT.FindImport(DevCPS.name, obj, obj); DevCPS.Get(sym)
+			ELSE err(ident); obj := NIL
+			END
+		END ;
+		IF obj = NIL THEN err(0);
+			obj := DevCPT.NewObj(); obj.mode := Var; obj.typ := DevCPT.undftyp; obj.adr := 0
+		ELSE lev := obj.mnolev;
+			IF (obj.mode IN {Var, VarPar}) & (lev # level) THEN
+				obj.leaf := FALSE;
+				IF lev > 0 THEN DevCPB.StaticLink(SHORT(SHORT(level-lev)), TRUE) END	(* !!! *)
+			END
+		END ;
+		id := obj
+	END qualident;
+
+	PROCEDURE ConstExpression(VAR x: DevCPT.Node);
+	BEGIN Expression(x);
+		IF x.class # Nconst THEN
+			err(50); x := DevCPB.NewIntConst(1) 
+		END
+	END ConstExpression;
+
+	PROCEDURE CheckMark(obj: DevCPT.Object);	(* !!! *)
+		VAR n: INTEGER; mod: ARRAY 256 OF DevCPT.String;
+	BEGIN DevCPS.Get(sym);
+		IF (sym = times) OR (sym = minus) THEN
+			IF (level > 0) OR ~(obj.mode IN {Var, Fld, TProc}) & (sym = minus) THEN err(41) END ;
+			IF sym = times THEN obj.vis := external ELSE obj.vis := externalR END ;
+			DevCPS.Get(sym)
+		ELSE obj.vis := internal
+		END;
+		IF (obj.mode IN {TProc, LProc, XProc, CProc, Var, Typ, Con, Fld}) & (sym = lbrak) THEN
+			DevCPS.Get(sym);
+			IF (sym = number) & (DevCPS.numtyp = char) THEN
+				NEW(DevCPS.str, 2); DevCPS.str[0] := SHORT(CHR(DevCPS.intval)); DevCPS.str[1] := 0X; sym := string
+			END;
+			IF sym = string THEN
+				IF DevCPS.str^ # "" THEN obj.entry := DevCPS.str END;
+				DevCPS.Get(sym); n := 0;
+				IF (sym = comma) & (obj.mode IN {LProc, XProc, CProc, Var, Con}) THEN
+					DevCPS.Get(sym);
+					IF (sym = number) & (DevCPS.numtyp = char) THEN
+						NEW(DevCPS.str, 2); DevCPS.str[0] := SHORT(CHR(DevCPS.intval)); DevCPS.str[1] := 0X; sym := string
+					END;
+					IF sym = string THEN
+						obj.library := obj.entry; obj.entry := NIL;
+						IF DevCPS.str^ # "" THEN obj.entry := DevCPS.str END;
+						DevCPS.Get(sym);
+					ELSE err(string)
+					END
+				END;
+				WHILE sym = comma DO
+					DevCPS.Get(sym);
+					IF (sym = number) & (DevCPS.numtyp = char) THEN
+						NEW(DevCPS.str, 2); DevCPS.str[0] := SHORT(CHR(DevCPS.intval)); DevCPS.str[1] := 0X; sym := string
+					END;
+					IF sym = string THEN
+						IF n < LEN(mod) THEN mod[n] := DevCPS.str; INC(n)
+						ELSE err(235)
+						END;
+						DevCPS.Get(sym)
+					ELSE err(string)
+					END
+				END;
+				IF n > 0 THEN
+					NEW(obj.modifiers, n);
+					WHILE n > 0 DO DEC(n); obj.modifiers[n] := mod[n] END
+				END
+			ELSE err(string)
+			END;
+			CheckSym(rbrak);
+			IF DevCPM.options * {DevCPM.interface, DevCPM.java} = {} THEN err(225) END
+		END
+	END CheckMark;
+
+	PROCEDURE CheckSysFlag (VAR sysflag: SHORTINT;
+										GetSF: PROCEDURE(id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT));
+		VAR x: DevCPT.Object; i: SHORTINT;
+	BEGIN
+		sysflag := 0;
+		IF sym = lbrak THEN
+			DevCPS.Get(sym);
+			WHILE (sym = number) OR (sym = ident) OR (sym = string) DO
+				IF sym = number THEN
+					IF DevCPS.numtyp = integer THEN
+						i := SHORT(DevCPS.intval); GetSF("", i, sysflag)
+					ELSE err(225)
+					END
+				ELSIF sym = ident THEN
+					DevCPT.Find(DevCPS.name, x);
+					IF (x # NIL) & (x.mode = Con) & (x.typ.form IN {Int8, Int16, Int32}) THEN 
+						i := SHORT(x.conval.intval); GetSF("", i, sysflag)
+					ELSE
+						GetSF(DevCPS.name, 0, sysflag)
+					END
+				ELSE
+					GetSF(DevCPS.str^, 0, sysflag)
+				END;
+				DevCPS.Get(sym);
+				IF (sym = comma) OR (sym = plus) THEN DevCPS.Get(sym) END
+			END;
+			CheckSym(rbrak)
+		END
+	END CheckSysFlag;
+	
+	PROCEDURE Receiver(VAR mode, vis: BYTE; VAR name: DevCPT.Name; VAR typ, rec: DevCPT.Struct);
+		VAR obj: DevCPT.Object; tname: DevCPT.String;
+	BEGIN typ := DevCPT.undftyp; rec := NIL; vis := 0;
+		IF sym = var THEN DevCPS.Get(sym); mode := VarPar;
+		ELSIF sym = in THEN DevCPS.Get(sym); mode := VarPar; vis := inPar	(* ??? *)
+		ELSE mode := Var
+		END ;
+		name := DevCPS.name; CheckSym(ident); CheckSym(colon);
+		IF sym # ident THEN err(ident) END;
+		Type(typ, tname);
+		IF tname = NIL THEN
+			IF typ.form = Pointer THEN  rec := typ.BaseTyp ELSE rec := typ END;
+			IF ~((mode = Var) & (typ.form = Pointer) & (rec.comp = Record) OR
+				(mode = VarPar) & (typ.comp = Record)) THEN err(70); rec := NIL END;
+			IF (rec # NIL) & (rec.mno # level) THEN err(72); rec := NIL END
+		ELSE err(0)
+		END;
+		CheckSym(rparen);
+		IF rec = NIL THEN rec := DevCPT.NewStr(Comp, Record); rec.BaseTyp := NIL END
+	END Receiver;
+	
+	PROCEDURE FormalParameters(
+		VAR firstPar: DevCPT.Object; VAR resTyp: DevCPT.Struct; VAR name: DevCPT.String
+	);
+		VAR mode, vis: BYTE; sys: SHORTINT;
+				par, first, last, res, newPar, iidPar: DevCPT.Object; typ: DevCPT.Struct;
+	BEGIN
+		first := NIL; last := firstPar;
+		newPar := NIL; iidPar := NIL;
+		IF (sym = ident) OR (sym = var) OR (sym = in) OR (sym = out) THEN
+			LOOP
+				sys := 0; vis := 0;
+				IF sym = var THEN DevCPS.Get(sym); mode := VarPar
+				ELSIF sym = in THEN DevCPS.Get(sym); mode := VarPar; vis := inPar
+				ELSIF sym = out THEN DevCPS.Get(sym); mode := VarPar; vis := outPar
+				ELSE mode := Var
+				END ;
+				IF mode = VarPar THEN CheckSysFlag(sys, DevCPM.GetVarParSysFlag) END;
+				IF ODD(sys DIV inBit) THEN vis := inPar
+				ELSIF ODD(sys DIV outBit) THEN vis := outPar
+				END;
+				IF ODD(sys DIV newBit) & (vis # outPar) THEN err(225)
+				ELSIF ODD(sys DIV iidBit) & (vis # inPar) THEN err(225)
+				END;
+				LOOP
+					IF sym = ident THEN
+						DevCPT.Insert(DevCPS.name, par); DevCPS.Get(sym);
+						par.mode := mode; par.link := NIL; par.vis := vis; par.sysflag := SHORT(sys);
+						IF first = NIL THEN first := par END ;
+						IF firstPar = NIL THEN firstPar := par ELSE last.link := par END ;
+						last := par
+					ELSE err(ident)
+					END;
+					IF sym = comma THEN DevCPS.Get(sym)
+					ELSIF sym = ident THEN err(comma)
+					ELSIF sym = var THEN err(comma); DevCPS.Get(sym)
+					ELSE EXIT
+					END
+				END ;
+				CheckSym(colon); Type(typ, name);
+				IF mode # VarPar THEN CheckAlloc(typ, TRUE, DevCPM.errpos) END;
+				IF (mode = VarPar) & (vis = inPar) & (typ.form # Undef) & (typ.form # Comp) & (typ.sysflag = 0) THEN err(177)
+				END;
+				(* typ.pbused is set when parameter type name is parsed *)
+				WHILE first # NIL DO
+					SetType (NIL, first, typ, name);
+					IF DevCPM.com IN DevCPM.options THEN
+						IF ODD(sys DIV newBit) THEN
+							IF (newPar # NIL) OR (typ.form # Pointer) OR (typ.sysflag # interface) THEN err(168) END;
+							newPar := first
+						ELSIF ODD(sys DIV iidBit) THEN
+							IF (iidPar # NIL) OR (typ # DevCPT.guidtyp) THEN err(168) END;
+							iidPar := first
+						END
+					END;
+					first := first.link
+				END;
+				IF sym = semicolon THEN DevCPS.Get(sym)
+				ELSIF sym = ident THEN err(semicolon)
+				ELSE EXIT
+				END
+			END
+		END;
+		CheckSym(rparen);
+		IF (newPar = NIL) # (iidPar = NIL) THEN err(168) END;
+		name := NIL;
+		IF sym = colon THEN
+			DevCPS.Get(sym);
+			Type(resTyp, name);
+			IF resTyp.form = Comp THEN resTyp := DevCPT.undftyp; err(54) END
+		ELSE resTyp := DevCPT.notyp
+		END
+	END FormalParameters;
+	
+	PROCEDURE CheckOverwrite (proc, base: DevCPT.Object; rec: DevCPT.Struct);
+		VAR o, bo: DevCPT.Object;
+	BEGIN
+		IF base # NIL THEN
+			IF base.conval.setval * {absAttr, empAttr, extAttr} = {} THEN err(182) END;
+			IF (proc.link.mode # base.link.mode) OR (proc.link.vis # base.link.vis)
+				OR ~DevCPT.Extends(proc.link.typ, base.link.typ) THEN err(115) END;
+			o := proc.link; bo := base.link;
+			WHILE (o # NIL) & (bo # NIL) DO
+				IF (bo.sysflag # 0) & (o.sysflag = 0) THEN	(* propagate sysflags *)
+					o.sysflag := bo.sysflag
+				END;
+				o := o.link; bo := bo.link
+			END;
+			DevCPB.CheckParameters(proc.link.link, base.link.link, FALSE);
+			IF ~DevCPT.Extends(proc.typ, base.typ) THEN err(117) END;
+			IF (base.vis # proc.vis) & ((proc.vis # internal) OR rec.exp) THEN err(183) END;
+			INCL(proc.conval.setval, isRedef)
+		END;
+	END CheckOverwrite;
+
+	PROCEDURE GetAttributes (proc, base: DevCPT.Object; owner: DevCPT.Struct);	(* read method attributes *)
+		VAR attr, battr: SET; o: DevCPT.Object;
+	BEGIN
+		attr := {};
+		IF sym = comma THEN	(* read attributes *)
+			DevCPS.Get(sym);
+			IF sym = ident THEN
+				DevCPT.Find(DevCPS.name, o);
+				IF (o # NIL) & (o.mode = SProc) & (o.adr = newfn) THEN
+					IF ~(DevCPM.oberon IN DevCPM.options) THEN INCL(attr, newAttr) ELSE err(178) END;
+					DevCPS.Get(sym);
+					IF sym = comma THEN
+						DevCPS.Get(sym);
+						IF sym = ident THEN DevCPT.Find(DevCPS.name, o) ELSE o := NIL; err(ident) END
+					ELSE o := NIL
+					END
+				END;
+				IF o # NIL THEN
+					IF (o.mode # Attr) OR (o.adr = limAttr) OR (DevCPM.oberon IN DevCPM.options) THEN err(178)
+					ELSE INCL(attr, o.adr)
+					END;
+					DevCPS.Get(sym)
+				END
+			ELSE err(ident)
+			END
+		END;
+		IF (base = NIL) & ~(newAttr IN attr) THEN err(185); INCL(attr, newAttr)
+		ELSIF (base # NIL) & (newAttr IN attr) THEN err(186)
+		END;
+		IF absAttr IN attr THEN
+			IF owner.attribute # absAttr THEN err(190) END;
+			IF (proc.vis = internal) & owner.exp THEN err(179) END
+		END;
+		IF (owner.attribute = 0) OR (owner.attribute = limAttr) THEN
+			IF (empAttr IN attr) & (newAttr IN attr) THEN err(187)
+(*
+			ELSIF extAttr IN attr THEN err(188)
+*)
+			END
+		END;
+		IF base # NIL THEN
+			battr := base.conval.setval;
+			IF empAttr IN battr THEN
+				IF absAttr IN attr THEN err(189) END
+			ELSIF ~(absAttr IN battr) THEN
+				IF (absAttr IN attr) OR (empAttr IN attr) THEN err(189) END
+			END
+		END;
+		IF empAttr IN attr THEN
+			IF proc.typ # DevCPT.notyp THEN err(195)
+			ELSE
+				o := proc.link; WHILE (o # NIL) & (o.vis # outPar) DO o := o.link END;
+				IF o # NIL THEN err(195) END
+			END
+		END;
+		IF (owner.sysflag = interface) & ~(absAttr IN attr) THEN err(162) END;
+		proc.conval.setval := attr
+	END GetAttributes;
+	
+	PROCEDURE RecordType(VAR typ: DevCPT.Struct; attr: DevCPT.Object);
+		VAR fld, first, last, base: DevCPT.Object; r: Elem; ftyp: DevCPT.Struct; name: DevCPT.String;
+	BEGIN typ := DevCPT.NewStr(Comp, Record); typ.BaseTyp := NIL;
+		CheckSysFlag(typ.sysflag, DevCPM.GetRecordSysFlag);
+		IF attr # NIL THEN
+			IF ~(DevCPM.oberon IN DevCPM.options) & (attr.adr # empAttr) THEN typ.attribute := SHORT(SHORT(attr.adr))
+			ELSE err(178)
+			END
+		END;
+		IF typ.sysflag = interface THEN
+			IF (DevCPS.str # NIL) & (DevCPS.str[0] = "{") THEN typ.ext := DevCPS.str END;
+			IF typ.attribute # absAttr THEN err(163) END;
+			IF sym # lparen THEN err(160) END
+		END;
+		IF sym = lparen THEN
+			DevCPS.Get(sym); (*record extension*)
+			IF sym = ident THEN
+				Type(ftyp, name);
+				IF ftyp.form = Pointer THEN ftyp := ftyp.BaseTyp END;
+				SetType(typ, NIL, ftyp, name);
+				IF (ftyp.comp = Record) & (ftyp # DevCPT.anytyp) THEN
+					ftyp.pvused := TRUE; typ.extlev := SHORT(SHORT(ftyp.extlev + 1));
+					DevCPM.PropagateRecordSysFlag(ftyp.sysflag, typ.sysflag);
+					IF (ftyp.attribute = 0) OR (ftyp.attribute = limAttr) & (ftyp.mno # 0) THEN err(181)
+					ELSIF (typ.attribute = absAttr) & (ftyp.attribute # absAttr) & ~(DevCPM.java IN DevCPM.options) THEN err(191)
+					ELSIF (ftyp.attribute = limAttr) & (typ.attribute # limAttr) THEN err(197)
+					END
+				ELSIF ftyp # DevCPT.undftyp THEN err(53)
+				END
+			ELSE err(ident)
+			END ;
+			IF typ.attribute # absAttr THEN	(* save typ for unimplemented method check *)
+				NEW(r); r.struct := typ; r.pos := DevCPM.errpos; r.next := recList; recList := r
+			END;
+			CheckSym(rparen)
+		END;
+(*
+		DevCPT.OpenScope(0, NIL);
+*)
+		first := NIL; last := NIL;
+		LOOP
+			IF sym = ident THEN
+				LOOP
+					IF sym = ident THEN
+						IF (typ.BaseTyp # NIL) & (typ.BaseTyp # DevCPT.undftyp) THEN
+							DevCPT.FindBaseField(DevCPS.name, typ, fld);
+							IF fld # NIL THEN err(1) END
+						END ;
+						DevCPT.InsertField(DevCPS.name, typ, fld);
+						fld.mode := Fld; fld.link := NIL; fld.typ := DevCPT.undftyp;
+						CheckMark(fld);
+						IF first = NIL THEN first := fld END ;
+						IF last = NIL THEN typ.link := fld ELSE last.link := fld END ;
+						last := fld
+					ELSE err(ident)
+					END ;
+					IF sym = comma THEN DevCPS.Get(sym)
+					ELSIF sym = ident THEN err(comma)
+					ELSE EXIT
+					END
+				END ;
+				CheckSym(colon); Type(ftyp, name);
+				CheckAlloc(ftyp, FALSE, DevCPM.errpos);
+				WHILE first # NIL DO
+					SetType(typ, first, ftyp, name); first := first.link
+				END;
+				IF typ.sysflag = interface THEN err(161) END
+			END;
+			IF sym = semicolon THEN DevCPS.Get(sym)
+			ELSIF sym = ident THEN err(semicolon)
+			ELSE EXIT
+			END
+		END;
+(*
+		IF typ.link # NIL THEN ASSERT(typ.link = DevCPT.topScope.right) END;
+		typ.link := DevCPT.topScope.right; DevCPT.CloseScope;
+*)
+		typ.untagged := typ.sysflag > 0;
+		DevCPB.Inittd(TDinit, lastTDinit, typ); CheckSym(end)
+	END RecordType;
+
+	PROCEDURE ArrayType(VAR typ: DevCPT.Struct);
+		VAR x: DevCPT.Node; n: INTEGER; sysflag: SHORTINT; name: DevCPT.String;
+	BEGIN CheckSysFlag(sysflag, DevCPM.GetArraySysFlag);
+		IF sym = of THEN	(*dynamic array*)
+			typ := DevCPT.NewStr(Comp, DynArr); typ.mno := 0; typ.sysflag := sysflag;
+			DevCPS.Get(sym); Type(typ.BaseTyp, name); SetType(typ, NIL, typ.BaseTyp, name);
+			CheckAlloc(typ.BaseTyp, TRUE, DevCPM.errpos);
+			IF typ.BaseTyp.comp = DynArr THEN typ.n := typ.BaseTyp.n + 1 ELSE typ.n := 0 END
+		ELSE
+			typ := DevCPT.NewStr(Comp, Array); typ.sysflag := sysflag; ConstExpression(x);
+			IF x.typ.form IN {Int8, Int16, Int32} THEN n := x.conval.intval;
+				IF (n <= 0) OR (n > DevCPM.MaxIndex) THEN err(63); n := 1 END
+			ELSE err(42); n := 1
+			END ;
+			typ.n := n;
+			IF sym = of THEN
+				DevCPS.Get(sym); Type(typ.BaseTyp, name); SetType(typ, NIL, typ.BaseTyp, name);
+				CheckAlloc(typ.BaseTyp, FALSE, DevCPM.errpos)
+			ELSIF sym = comma THEN
+				DevCPS.Get(sym);
+				IF sym # of THEN ArrayType(typ.BaseTyp) END
+			ELSE err(35)
+			END
+		END;
+		typ.untagged := typ.sysflag > 0
+	END ArrayType;
+
+	PROCEDURE PointerType(VAR typ: DevCPT.Struct);
+		VAR id: DevCPT.Object; name: DevCPT.String;
+	BEGIN typ := DevCPT.NewStr(Pointer, Basic); CheckSysFlag(typ.sysflag, DevCPM.GetPointerSysFlag);
+		CheckSym(to);
+		Type(typ.BaseTyp, name);
+		SetType(typ, NIL, typ.BaseTyp, name);
+		IF (typ.BaseTyp # DevCPT.undftyp) & (typ.BaseTyp.comp = Basic) THEN
+			typ.BaseTyp := DevCPT.undftyp; err(57)
+		END;
+		IF typ.BaseTyp.comp = Record THEN DevCPM.PropagateRecPtrSysFlag(typ.BaseTyp.sysflag, typ.sysflag)
+		ELSIF typ.BaseTyp.comp IN {Array, DynArr} THEN DevCPM.PropagateArrPtrSysFlag(typ.BaseTyp.sysflag, typ.sysflag)
+		END;
+		typ.untagged := typ.sysflag > 0
+	END PointerType;
+	
+	PROCEDURE Type (VAR typ: DevCPT.Struct; VAR name: DevCPT.String);	(* name # NIL => forward reference *)
+		VAR id: DevCPT.Object; tname: DevCPT.String;
+	BEGIN
+		typ := DevCPT.undftyp; name := NIL;
+		IF sym < lparen THEN err(12);
+			REPEAT DevCPS.Get(sym) UNTIL sym >= lparen
+		END ;
+		IF sym = ident THEN
+			DevCPT.Find(DevCPS.name, id);
+			IF (id = NIL) OR (id.mode = -1) OR (id.mode = Typ) & IncompleteType(id.typ) THEN	(* forward type definition *)
+				name := DevCPT.NewName(DevCPS.name); DevCPS.Get(sym);
+				IF (id = NIL) & (sym = period) THEN	(* missing module *)
+					err(0); DevCPS.Get(sym); name := NIL;
+					IF sym = ident THEN DevCPS.Get(sym) END
+				ELSIF sym = record THEN	(* wrong attribute *)
+					err(178); DevCPS.Get(sym); name := NIL; RecordType(typ, NIL)
+				END
+			ELSE
+				qualident(id);
+				IF id.mode = Typ THEN
+					IF ~(DevCPM.oberon IN DevCPM.options)
+						& ((id.typ = DevCPT.lreal64typ) OR (id.typ = DevCPT.lint64typ) OR (id.typ = DevCPT.lchar16typ)) THEN
+						err(198)
+					END;
+					typ := id.typ
+				ELSIF id.mode = Attr THEN
+					IF sym = record THEN
+						DevCPS.Get(sym); RecordType(typ, id)
+					ELSE err(12)
+					END
+				ELSE err(52)
+				END
+			END
+		ELSIF sym = array THEN
+			DevCPS.Get(sym); ArrayType(typ)
+		ELSIF sym = record THEN
+			DevCPS.Get(sym); RecordType(typ, NIL)
+		ELSIF sym = pointer THEN
+			DevCPS.Get(sym); PointerType(typ)
+		ELSIF sym = procedure THEN
+			DevCPS.Get(sym); typ := DevCPT.NewStr(ProcTyp, Basic);
+			CheckSysFlag(typ.sysflag, DevCPM.GetProcTypSysFlag);
+			typ.untagged := typ.sysflag > 0;
+			IF sym = lparen THEN
+				DevCPS.Get(sym); DevCPT.OpenScope(level, NIL);
+				FormalParameters(typ.link, typ.BaseTyp, tname); SetType(typ, NIL, typ.BaseTyp, tname); DevCPT.CloseScope
+			ELSE typ.BaseTyp := DevCPT.notyp; typ.link := NIL
+			END
+		ELSE err(12)
+		END ;
+		LOOP
+			IF (sym >= semicolon) & (sym <= else) OR (sym = rparen) OR (sym = eof)
+				OR (sym = number) OR (sym = comma) OR (sym = string) THEN EXIT END;
+			err(15); IF sym = ident THEN EXIT END;
+			DevCPS.Get(sym)
+		END
+	END Type;
+	
+	PROCEDURE ActualParameters(VAR aparlist: DevCPT.Node; fpar: DevCPT.Object; VAR pre, lastp: DevCPT.Node);
+		VAR apar, last, newPar, iidPar, n: DevCPT.Node;
+	BEGIN
+		aparlist := NIL; last := NIL;
+		IF sym # rparen THEN
+			newPar := NIL; iidPar := NIL;
+			LOOP Expression(apar);
+				IF fpar # NIL THEN
+					IF (apar.typ.form = Pointer) & (fpar.typ.form = Comp) THEN DevCPB.DeRef(apar) END;
+					DevCPB.Param(apar, fpar);
+					IF (fpar.mode = Var) OR (fpar.vis = inPar) THEN DevCPB.CheckBuffering(apar, NIL, fpar, pre, lastp) END;
+					DevCPB.Link(aparlist, last, apar);
+					IF ODD(fpar.sysflag DIV newBit) THEN newPar := apar
+					ELSIF ODD(fpar.sysflag DIV iidBit) THEN iidPar := apar
+					END;
+					IF (newPar # NIL) & (iidPar # NIL) THEN DevCPB.CheckNewParamPair(newPar, iidPar) END;
+					IF anchorVarPar & (fpar.mode = VarPar) & ~(DevCPM.java IN DevCPM.options)
+						OR (DevCPM.allSysVal IN DevCPM.options)	(* source output: avoid double evaluation *)
+							 & ((fpar.mode = VarPar) & (fpar.typ.comp = Record) & ~fpar.typ.untagged
+								OR (fpar.typ.comp = DynArr) & ~fpar.typ.untagged) THEN
+						n := apar;
+						WHILE n.class IN {Nfield, Nindex, Nguard} DO n := n.left END;
+						IF (n.class = Nderef) & (n.subcl = 0) THEN
+							IF n.left.class = Nguard THEN n := n.left END;
+							DevCPB.CheckVarParBuffering(n.left, pre, lastp)
+						END
+					END;
+					fpar := fpar.link
+				ELSE err(64)
+				END;
+				IF sym = comma THEN DevCPS.Get(sym)
+				ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
+				ELSE EXIT
+				END
+			END
+		END;
+		IF fpar # NIL THEN err(65) END
+	END ActualParameters;
+
+	PROCEDURE selector(VAR x: DevCPT.Node);
+		VAR obj, proc, p, fpar: DevCPT.Object; y, apar, pre, lastp: DevCPT.Node; typ: DevCPT.Struct; name: DevCPT.Name;
+	BEGIN
+		LOOP
+			IF sym = lbrak THEN DevCPS.Get(sym);
+				LOOP
+					IF (x.typ # NIL) & (x.typ.form = Pointer) THEN DevCPB.DeRef(x) END ;
+					Expression(y); DevCPB.Index(x, y);
+					IF sym = comma THEN DevCPS.Get(sym) ELSE EXIT END
+				END ;
+				CheckSym(rbrak)
+			ELSIF sym = period THEN DevCPS.Get(sym);
+				IF sym = ident THEN name := DevCPS.name; DevCPS.Get(sym);
+					IF x.typ # NIL THEN
+						IF x.typ.form = Pointer THEN DevCPB.DeRef(x) END ;
+						IF x.typ.comp = Record THEN
+							typ := x.typ; DevCPT.FindField(name, typ, obj); DevCPB.Field(x, obj);
+							IF (obj # NIL) & (obj.mode = TProc) THEN
+								IF sym = arrow THEN  (* super call *) DevCPS.Get(sym);
+									y := x.left;
+									IF y.class = Nderef THEN y := y.left END ;	(* y = record variable *)
+									IF y.obj # NIL THEN
+										proc := DevCPT.topScope;	(* find innermost scope which owner is a TProc *)
+										WHILE (proc.link # NIL) & (proc.link.mode # TProc) DO proc := proc.left END ;
+										IF (proc.link = NIL) OR (proc.link.link # y.obj) (* OR (proc.link.name^ # name) *) THEN err(75)
+										END ;
+										typ := y.obj.typ;
+										IF typ.form = Pointer THEN typ := typ.BaseTyp END ;
+										DevCPT.FindBaseField(x.obj.name^, typ, p);
+										IF p # NIL THEN
+											x.subcl := super; x.typ := p.typ;	(* correct result type *)
+											IF p.conval.setval * {absAttr, empAttr} # {} THEN err(194) END;
+											IF (p.vis = externalR) & (p.mnolev < 0) & (proc.link.name^ # name) THEN err(196) END;
+										ELSE err(74)
+										END
+									ELSE err(75)
+									END
+								ELSE
+									proc := obj;
+									WHILE (proc.mnolev >= 0) & ~(newAttr IN proc.conval.setval) & (typ.BaseTyp # NIL) DO
+										(* find base method *)
+										typ := typ.BaseTyp; DevCPT.FindField(name, typ, proc);
+									END;
+									IF (proc.vis = externalR) & (proc.mnolev < 0) THEN err(196) END;
+								END ;
+								IF (obj.typ # DevCPT.notyp) & (sym # lparen) THEN err(lparen) END
+							END
+						ELSE err(53)
+						END
+					ELSE err(52)
+					END
+				ELSE err(ident)
+				END
+			ELSIF sym = arrow THEN DevCPS.Get(sym); DevCPB.DeRef(x)
+			ELSIF sym = dollar THEN
+				IF x.typ.form = Pointer THEN DevCPB.DeRef(x) END;
+				DevCPS.Get(sym); DevCPB.StrDeref(x)
+			ELSIF sym = lparen THEN
+				IF (x.obj # NIL) & (x.obj.mode IN {XProc, LProc, CProc, TProc}) THEN typ := x.obj.typ
+				ELSIF x.typ.form = ProcTyp THEN typ := x.typ.BaseTyp
+				ELSIF x.class = Nproc THEN EXIT	(* standard procedure *)
+				ELSE typ := NIL
+				END;
+				IF typ # DevCPT.notyp THEN
+					DevCPS.Get(sym);
+					IF typ = NIL THEN	(* type guard *)
+						IF sym = ident THEN
+							qualident(obj);
+							IF obj.mode = Typ THEN DevCPB.TypTest(x, obj, TRUE)
+							ELSE err(52)
+							END
+						ELSE err(ident)
+						END
+					ELSE	(* function call *)
+						pre := NIL; lastp := NIL;
+						DevCPB.PrepCall(x, fpar);
+						IF (x.obj # NIL) & (x.obj.mode = TProc) THEN DevCPB.CheckBuffering(x.left, NIL, x.obj.link, pre, lastp)
+						END;
+						ActualParameters(apar, fpar, pre, lastp);
+						DevCPB.Call(x, apar, fpar);
+						IF pre # NIL THEN DevCPB.Construct(Ncomp, pre, x); pre.typ := x.typ; x := pre END;
+						IF level > 0 THEN DevCPT.topScope.link.leaf := FALSE END
+					END;
+					CheckSym(rparen)
+				ELSE EXIT
+				END
+(*
+			ELSIF (sym = lparen) & (x.class # Nproc) & (x.typ.form # ProcTyp) &
+					((x.obj = NIL) OR (x.obj.mode # TProc)) THEN
+				DevCPS.Get(sym);
+				IF sym = ident THEN
+					qualident(obj);
+					IF obj.mode = Typ THEN DevCPB.TypTest(x, obj, TRUE)
+					ELSE err(52)
+					END
+				ELSE err(ident)
+				END ;
+				CheckSym(rparen)
+*)
+			ELSE EXIT
+			END
+		END
+	END selector;
+
+	PROCEDURE StandProcCall(VAR x: DevCPT.Node);
+		VAR y: DevCPT.Node; m: BYTE; n: SHORTINT;
+	BEGIN m := SHORT(SHORT(x.obj.adr)); n := 0;
+		IF sym = lparen THEN DevCPS.Get(sym);
+			IF sym # rparen THEN
+				LOOP
+					IF n = 0 THEN Expression(x); DevCPB.StPar0(x, m); n := 1
+					ELSIF n = 1 THEN Expression(y); DevCPB.StPar1(x, y, m); n := 2
+					ELSE Expression(y); DevCPB.StParN(x, y, m, n); INC(n)
+					END ;
+					IF sym = comma THEN DevCPS.Get(sym)
+					ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
+					ELSE EXIT
+					END
+				END ;
+				CheckSym(rparen)
+			ELSE DevCPS.Get(sym)
+			END ;
+			DevCPB.StFct(x, m, n)
+		ELSE err(lparen)
+		END ;
+		IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN DevCPT.topScope.link.leaf := FALSE END
+	END StandProcCall;
+	
+	PROCEDURE Element(VAR x: DevCPT.Node);
+		VAR y: DevCPT.Node;
+	BEGIN Expression(x);
+		IF sym = upto THEN
+			DevCPS.Get(sym); Expression(y); DevCPB.SetRange(x, y)
+		ELSE DevCPB.SetElem(x)
+		END
+	END Element;
+
+	PROCEDURE Sets(VAR x: DevCPT.Node);
+		VAR y: DevCPT.Node;
+	BEGIN
+		IF sym # rbrace THEN
+			Element(x);
+			LOOP
+				IF sym = comma THEN DevCPS.Get(sym)
+				ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
+				ELSE EXIT
+				END ;
+				Element(y); DevCPB.Op(plus, x, y)
+			END
+		ELSE x := DevCPB.EmptySet()
+		END ;
+		CheckSym(rbrace)
+	END Sets;
+	
+	PROCEDURE Factor(VAR x: DevCPT.Node);
+		VAR fpar, id: DevCPT.Object; apar: DevCPT.Node;
+	BEGIN
+		IF sym < not THEN err(13);
+			REPEAT DevCPS.Get(sym) UNTIL sym >= lparen
+		END ;
+		IF sym = ident THEN
+			qualident(id); x := DevCPB.NewLeaf(id); selector(x);
+			IF (x.class = Nproc) & (x.obj.mode = SProc) THEN StandProcCall(x)	(* x may be NIL *)
+(*
+			ELSIF sym = lparen THEN
+				DevCPS.Get(sym); DevCPB.PrepCall(x, fpar);
+				ActualParameters(apar, fpar);
+				DevCPB.Call(x, apar, fpar);
+				CheckSym(rparen);
+				IF level > 0 THEN DevCPT.topScope.link.leaf := FALSE END
+*)
+			END
+		ELSIF sym = number THEN
+			CASE DevCPS.numtyp OF
+			   char:
+				x := DevCPB.NewIntConst(DevCPS.intval); x.typ := DevCPT.char8typ;
+				IF DevCPS.intval > 255 THEN x.typ := DevCPT.char16typ END
+			| integer: x := DevCPB.NewIntConst(DevCPS.intval)
+			| int64: x := DevCPB.NewLargeIntConst(DevCPS.intval, DevCPS.realval)
+			| real: x := DevCPB.NewRealConst(DevCPS.realval, NIL)
+			| real32: x := DevCPB.NewRealConst(DevCPS.realval, DevCPT.real32typ)
+			| real64: x := DevCPB.NewRealConst(DevCPS.realval, DevCPT.real64typ)
+			END ;
+			DevCPS.Get(sym)
+		ELSIF sym = string THEN
+			x := DevCPB.NewString(DevCPS.str, DevCPS.lstr, DevCPS.intval);
+			DevCPS.Get(sym)
+		ELSIF sym = nil THEN
+			x := DevCPB.Nil(); DevCPS.Get(sym)
+		ELSIF sym = lparen THEN
+			DevCPS.Get(sym); Expression(x); CheckSym(rparen)
+		ELSIF sym = lbrak THEN
+			DevCPS.Get(sym); err(lparen); Expression(x); CheckSym(rparen)
+		ELSIF sym = lbrace THEN DevCPS.Get(sym); Sets(x)
+		ELSIF sym = not THEN
+			DevCPS.Get(sym); Factor(x); DevCPB.MOp(not, x)
+		ELSE err(13); DevCPS.Get(sym); x := NIL
+		END ;
+		IF x = NIL THEN x := DevCPB.NewIntConst(1); x.typ := DevCPT.undftyp END
+	END Factor;
+
+	PROCEDURE Term(VAR x: DevCPT.Node);
+		VAR y: DevCPT.Node; mulop: BYTE;
+	BEGIN Factor(x);
+		WHILE (times <= sym) & (sym <= and) DO
+			mulop := sym; DevCPS.Get(sym);
+			Factor(y); DevCPB.Op(mulop, x, y)
+		END
+	END Term;
+
+	PROCEDURE SimpleExpression(VAR x: DevCPT.Node);
+		VAR y: DevCPT.Node; addop: BYTE;
+	BEGIN
+		IF sym = minus THEN DevCPS.Get(sym); Term(x); DevCPB.MOp(minus, x)
+		ELSIF sym = plus THEN DevCPS.Get(sym); Term(x); DevCPB.MOp(plus, x)
+		ELSE Term(x)
+		END ;
+		WHILE (plus <= sym) & (sym <= or) DO
+			addop := sym; DevCPS.Get(sym); Term(y); 
+			IF x.typ.form = Pointer THEN DevCPB.DeRef(x) END;
+			IF (x.typ.comp IN {Array, DynArr}) & (x.typ.BaseTyp.form IN charSet) (* OR (x.typ.sysflag = jstr) *) THEN
+				DevCPB.StrDeref(x)
+			END;
+			IF y.typ.form = Pointer THEN DevCPB.DeRef(y) END;
+			IF (y.typ.comp IN {Array, DynArr}) & (y.typ.BaseTyp.form IN charSet) (* OR (y.typ.sysflag = jstr) *) THEN
+				DevCPB.StrDeref(y)
+			END;
+			DevCPB.Op(addop, x, y)
+		END
+	END SimpleExpression;
+
+	PROCEDURE Expression(VAR x: DevCPT.Node);
+		VAR y, pre, last: DevCPT.Node; obj: DevCPT.Object; relation: BYTE;
+	BEGIN SimpleExpression(x);
+		IF (eql <= sym) & (sym <= geq) THEN
+			relation := sym; DevCPS.Get(sym); SimpleExpression(y);
+			pre := NIL; last := NIL;
+			IF (x.typ.comp IN {Array, DynArr}) & (x.typ.BaseTyp.form IN charSet) THEN
+				DevCPB.StrDeref(x)
+			END;
+			IF (y.typ.comp IN {Array, DynArr}) & (y.typ.BaseTyp.form IN charSet) THEN
+				DevCPB.StrDeref(y)
+			END;
+			DevCPB.CheckBuffering(x, NIL, NIL, pre, last);
+			DevCPB.CheckBuffering(y, NIL, NIL, pre, last);
+			DevCPB.Op(relation, x, y);
+			IF pre # NIL THEN DevCPB.Construct(Ncomp, pre, x); pre.typ := x.typ; x := pre END
+		ELSIF sym = in THEN
+			DevCPS.Get(sym); SimpleExpression(y); DevCPB.In(x, y)
+		ELSIF sym = is THEN
+			DevCPS.Get(sym);
+			IF sym = ident THEN
+				qualident(obj);
+				IF obj.mode = Typ THEN DevCPB.TypTest(x, obj, FALSE)
+				ELSE err(52)
+				END
+			ELSE err(ident)
+			END
+		END
+	END Expression;
+
+	PROCEDURE ProcedureDeclaration(VAR x: DevCPT.Node);
+		VAR proc, fwd: DevCPT.Object;
+			name: DevCPT.Name;
+			mode: BYTE;
+			forward: BOOLEAN;
+			sys: SHORTINT;
+
+		PROCEDURE GetCode;
+			VAR ext: DevCPT.ConstExt; i, n, c: INTEGER; s: ARRAY 256 OF SHORTCHAR;
+		BEGIN
+			n := 0;
+			IF sym = string THEN
+				NEW(ext, DevCPS.intval);
+				WHILE DevCPS.str[n] # 0X DO ext[n+1] := DevCPS.str[n]; INC(n) END ;
+				ext^[0] := SHORT(CHR(n)); DevCPS.Get(sym);
+			ELSE
+				LOOP
+					IF sym = number THEN c := DevCPS.intval; INC(n);
+						IF (c < 0) OR (c > 255) OR (n = 255) THEN
+							err(64); c := 1; n := 1
+						END ;
+						DevCPS.Get(sym); s[n] := SHORT(CHR(c))
+					END ;
+					IF sym = comma THEN DevCPS.Get(sym)
+					ELSIF sym = number THEN err(comma)
+					ELSE s[0] := SHORT(CHR(n)); EXIT
+					END
+				END;
+				NEW(ext, n + 1); i := 0;
+				WHILE i <= n DO ext[i] := s[i]; INC(i) END;
+			END;
+			proc.conval.ext := ext;
+			INCL(proc.conval.setval, hasBody)
+		END GetCode;
+
+		PROCEDURE GetParams;
+			VAR name: DevCPT.String;
+		BEGIN
+			proc.mode := mode; proc.typ := DevCPT.notyp;
+			proc.sysflag := SHORT(sys);
+			proc.conval.setval := {};
+			IF sym = lparen THEN
+				DevCPS.Get(sym); FormalParameters(proc.link, proc.typ, name);
+				IF name # NIL THEN err(0) END
+			END;
+			CheckForwardTypes; userList := NIL;
+			IF fwd # NIL THEN
+				DevCPB.CheckParameters(proc.link, fwd.link, TRUE);
+				IF ~DevCPT.EqualType(proc.typ, fwd.typ) THEN err(117) END ;
+				proc := fwd; DevCPT.topScope := proc.scope;
+				IF mode = IProc THEN proc.mode := IProc END
+			END
+		END GetParams;
+
+		PROCEDURE Body;
+			VAR procdec, statseq: DevCPT.Node; c: INTEGER;
+		BEGIN
+			c := DevCPM.errpos;
+			INCL(proc.conval.setval, hasBody);
+			CheckSym(semicolon); Block(procdec, statseq);
+			DevCPB.Enter(procdec, statseq, proc); x := procdec;
+			x.conval := DevCPT.NewConst(); x.conval.intval := c; x.conval.intval2 := DevCPM.startpos;
+			CheckSym(end);
+			IF sym = ident THEN
+				IF DevCPS.name # proc.name^ THEN err(4) END ;
+				DevCPS.Get(sym)
+			ELSE err(ident)
+			END
+		END Body;
+
+		PROCEDURE TProcDecl;
+			VAR baseProc, o, bo: DevCPT.Object;
+				objTyp, recTyp: DevCPT.Struct;
+				objMode, objVis: BYTE;
+				objName: DevCPT.Name;
+				pnode: DevCPT.Node;
+				fwdAttr: SET;
+		BEGIN
+			DevCPS.Get(sym); mode := TProc;
+			IF level > 0 THEN err(73) END;
+			Receiver(objMode, objVis, objName, objTyp, recTyp);
+			IF sym = ident THEN
+				name := DevCPS.name;
+				DevCPT.FindField(name, recTyp, fwd);
+				DevCPT.FindBaseField(name, recTyp, baseProc);
+				IF (baseProc # NIL) & (baseProc.mode # TProc) THEN baseProc := NIL; err(1) END ;
+				IF fwd = baseProc THEN fwd := NIL END ;
+				IF (fwd # NIL) & (fwd.mnolev # level) THEN fwd := NIL END ;
+				IF (fwd # NIL) & (fwd.mode = TProc) & (fwd.conval.setval * {hasBody, absAttr, empAttr} = {}) THEN
+					(* there exists a corresponding forward declaration *)
+					proc := DevCPT.NewObj(); proc.leaf := TRUE;
+					proc.mode := TProc; proc.conval := DevCPT.NewConst();
+					CheckMark(proc);
+					IF fwd.vis # proc.vis THEN err(118) END;
+					fwdAttr := fwd.conval.setval
+				ELSE
+					IF fwd # NIL THEN err(1); fwd := NIL END ;
+					DevCPT.InsertField(name, recTyp, proc);
+					proc.mode := TProc; proc.conval := DevCPT.NewConst();
+					CheckMark(proc);
+					IF recTyp.strobj # NIL THEN	(* preserve declaration order *)
+						o := recTyp.strobj.link;
+						IF o = NIL THEN recTyp.strobj.link := proc
+						ELSE
+							WHILE o.nlink # NIL DO o := o.nlink END;
+							o.nlink := proc
+						END
+					END
+				END;
+				INC(level); DevCPT.OpenScope(level, proc);
+				DevCPT.Insert(objName, proc.link); proc.link.mode := objMode; proc.link.vis := objVis; proc.link.typ := objTyp;
+				ASSERT(DevCPT.topScope # NIL);
+				GetParams;	(* may change proc := fwd !!! *)
+				ASSERT(DevCPT.topScope # NIL);
+				GetAttributes(proc, baseProc, recTyp);
+				IF (fwd # NIL) & (fwdAttr / proc.conval.setval * {absAttr, empAttr, extAttr} # {}) THEN err(184) END;
+				CheckOverwrite(proc, baseProc, recTyp);
+				IF ~forward THEN
+					IF empAttr IN proc.conval.setval THEN	(* insert empty procedure *)
+						pnode := NIL; DevCPB.Enter(pnode, NIL, proc);
+						pnode.conval := DevCPT.NewConst();
+						pnode.conval.intval := DevCPM.errpos;
+						pnode.conval.intval2 := DevCPM.errpos;
+						x := pnode;
+					ELSIF DevCPM.noCode IN DevCPM.options THEN INCL(proc.conval.setval, hasBody)
+					ELSIF ~(absAttr IN proc.conval.setval) THEN Body
+					END;
+					proc.adr := 0
+				ELSE
+					proc.adr := DevCPM.errpos;
+					IF proc.conval.setval * {empAttr, absAttr} # {} THEN err(184) END
+				END;
+				DEC(level); DevCPT.CloseScope;
+			ELSE err(ident)
+			END;
+		END TProcDecl;
+	
+	BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc; sys := 0;
+		IF (sym # ident) & (sym # lparen) THEN
+			CheckSysFlag(sys, DevCPM.GetProcSysFlag);
+			IF sys # 0 THEN
+				IF ODD(sys DIV DevCPM.CProcFlag) THEN mode := CProc END
+			ELSE
+				IF sym = times THEN	(* mode set later in DevCPB.CheckAssign *)
+				ELSIF sym = arrow THEN forward := TRUE
+				ELSE err(ident)
+				END;
+				DevCPS.Get(sym)
+			END
+		END ;
+		IF sym = lparen THEN TProcDecl
+		ELSIF sym = ident THEN DevCPT.Find(DevCPS.name, fwd);
+			name := DevCPS.name;
+			IF (fwd # NIL) & ((fwd.mnolev # level) OR (fwd.mode = SProc)) THEN fwd := NIL END ;
+			IF (fwd # NIL) & (fwd.mode IN {LProc, XProc}) & ~(hasBody IN fwd.conval.setval) THEN
+				(* there exists a corresponding forward declaration *)
+				proc := DevCPT.NewObj(); proc.leaf := TRUE;
+				proc.mode := mode; proc.conval := DevCPT.NewConst();
+				CheckMark(proc);
+				IF fwd.vis # proc.vis THEN err(118) END
+			ELSE
+				IF fwd # NIL THEN err(1); fwd := NIL END ;
+				DevCPT.Insert(name, proc);
+				proc.mode := mode; proc.conval := DevCPT.NewConst();
+				CheckMark(proc);
+			END ;
+			IF (proc.vis # internal) & (mode = LProc) THEN mode := XProc END ;
+			IF (mode # LProc) & (level > 0) THEN err(73) END ;
+			INC(level); DevCPT.OpenScope(level, proc);
+			proc.link := NIL; GetParams;	(* may change proc := fwd !!! *)
+			IF mode = CProc THEN GetCode
+			ELSIF DevCPM.noCode IN DevCPM.options THEN INCL(proc.conval.setval, hasBody)
+			ELSIF ~forward THEN Body; proc.adr := 0
+			ELSE proc.adr := DevCPM.errpos
+			END ;
+			DEC(level); DevCPT.CloseScope
+		ELSE err(ident)
+		END
+	END ProcedureDeclaration;
+
+	PROCEDURE CaseLabelList(VAR lab, root: DevCPT.Node; LabelForm: SHORTINT; VAR min, max: INTEGER);
+		VAR x, y, lastlab: DevCPT.Node; i, f: SHORTINT; xval, yval: INTEGER;
+		
+		PROCEDURE Insert(VAR n: DevCPT.Node);	(* build binary tree of label ranges *)	(* !!! *)
+		BEGIN
+			IF n = NIL THEN
+				IF x.hint # 1 THEN n := x END
+			ELSIF yval < n.conval.intval THEN Insert(n.left)
+			ELSIF xval > n.conval.intval2 THEN Insert(n.right)
+			ELSE err(63)
+			END
+		END Insert;
+		
+	BEGIN lab := NIL; lastlab := NIL;
+		LOOP ConstExpression(x); f := x.typ.form;
+			IF f IN {Int8..Int32} + charSet THEN  xval := x.conval.intval
+			ELSE err(61); xval := 1
+			END ;
+			IF (f IN {Int8..Int32}) # (LabelForm IN {Int8..Int32}) THEN err(60) END;
+			IF sym = upto THEN
+				DevCPS.Get(sym); ConstExpression(y); yval := y.conval.intval;
+				IF (y.typ.form IN {Int8..Int32}) # (LabelForm IN {Int8..Int32}) THEN err(60) END;
+				IF yval < xval THEN err(63); yval := xval END
+			ELSE yval := xval
+			END ;
+			x.conval.intval2 := yval;
+			IF xval < min THEN min := xval END;
+			IF yval > max THEN max := yval END;
+			IF lab = NIL THEN lab := x; Insert(root)
+			ELSIF yval < lab.conval.intval - 1 THEN x.link := lab; lab := x; Insert(root)
+			ELSIF yval = lab.conval.intval - 1 THEN x.hint := 1; Insert(root); lab.conval.intval := xval
+			ELSIF xval = lab.conval.intval2 + 1 THEN x.hint := 1; Insert(root); lab.conval.intval2 := yval
+			ELSE
+				y := lab;
+				WHILE (y.link # NIL) & (xval > y.link.conval.intval2 + 1) DO y := y.link END;
+				IF y.link = NIL THEN y.link := x; Insert(root)
+				ELSIF yval < y.link.conval.intval - 1 THEN x.link := y.link; y.link := x; Insert(root)
+				ELSIF yval = y.link.conval.intval - 1 THEN x.hint := 1; Insert(root); y.link.conval.intval := xval
+				ELSIF xval = y.link.conval.intval2 + 1 THEN x.hint := 1; Insert(root); y.link.conval.intval2 := yval
+				END
+			END;
+			IF sym = comma THEN DevCPS.Get(sym)
+			ELSIF (sym = number) OR (sym = ident) THEN err(comma)
+			ELSE EXIT
+			END
+		END
+	END CaseLabelList;
+	
+	PROCEDURE StatSeq(VAR stat: DevCPT.Node);
+		VAR fpar, id, t, obj: DevCPT.Object; idtyp: DevCPT.Struct; e: BOOLEAN;
+				s, x, y, z, apar, last, lastif, pre, lastp: DevCPT.Node; pos, p: INTEGER; name: DevCPT.Name;
+
+		PROCEDURE CasePart(VAR x: DevCPT.Node);
+			VAR low, high: INTEGER; e: BOOLEAN; cases, lab, y, lastcase, root: DevCPT.Node; 
+		BEGIN
+			Expression(x);
+			IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
+			ELSIF x.typ.form = Int64 THEN err(260)
+			ELSIF ~(x.typ.form IN {Int8..Int32} + charSet) THEN err(125)
+			END ;
+			CheckSym(of); cases := NIL; lastcase := NIL; root := NIL;
+			low := MAX(INTEGER); high := MIN(INTEGER);
+			LOOP
+				IF sym < bar THEN
+					CaseLabelList(lab, root, x.typ.form, low, high);
+					CheckSym(colon); StatSeq(y);
+					DevCPB.Construct(Ncasedo, lab, y); DevCPB.Link(cases, lastcase, lab)
+				END ;
+				IF sym = bar THEN DevCPS.Get(sym) ELSE EXIT END
+			END;
+			e := sym = else;
+			IF e THEN DevCPS.Get(sym); StatSeq(y) ELSE y := NIL END ;
+			DevCPB.Construct(Ncaselse, cases, y); DevCPB.Construct(Ncase, x, cases);
+			cases.conval := DevCPT.NewConst();
+			cases.conval.intval := low; cases.conval.intval2 := high;
+			IF e THEN cases.conval.setval := {1} ELSE cases.conval.setval := {} END;
+			DevCPB.OptimizeCase(root); cases.link := root	(* !!! *)
+		END CasePart;
+		
+		PROCEDURE SetPos(x: DevCPT.Node);
+		BEGIN
+			x.conval := DevCPT.NewConst(); x.conval.intval := pos
+		END SetPos;
+
+		PROCEDURE CheckBool(VAR x: DevCPT.Node);
+		BEGIN
+			IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126); x := DevCPB.NewBoolConst(FALSE)
+			ELSIF x.typ.form # Bool THEN err(120); x := DevCPB.NewBoolConst(FALSE)
+			END
+		END CheckBool;
+
+	BEGIN stat := NIL; last := NIL;
+		LOOP x := NIL;
+			IF sym < ident THEN err(14);
+				REPEAT DevCPS.Get(sym) UNTIL sym >= ident
+			END ;
+			pos := DevCPM.startpos;
+			IF sym = ident THEN
+				qualident(id); x := DevCPB.NewLeaf(id); selector(x);
+				IF sym = becomes THEN
+					DevCPS.Get(sym); Expression(y);
+					IF (y.typ.form = Pointer) & (x.typ.form = Comp) THEN DevCPB.DeRef(y) END;
+					pre := NIL; lastp := NIL;
+					DevCPB.CheckBuffering(y, x, NIL, pre, lastp);
+					DevCPB.Assign(x, y);
+					IF pre # NIL THEN SetPos(x); DevCPB.Construct(Ncomp, pre, x); x := pre END;
+				ELSIF sym = eql THEN
+					err(becomes); DevCPS.Get(sym); Expression(y); DevCPB.Assign(x, y)
+				ELSIF (x.class = Nproc) & (x.obj.mode = SProc) THEN
+					StandProcCall(x);
+					IF (x # NIL) & (x.typ # DevCPT.notyp) THEN err(55) END;
+					IF (x # NIL) & (x.class = Nifelse) THEN	(* error pos for ASSERT *)
+						SetPos(x.left); SetPos(x.left.right)
+					END
+				ELSIF x.class = Ncall THEN err(55)
+				ELSE
+					pre := NIL; lastp := NIL;
+					DevCPB.PrepCall(x, fpar);
+					IF (x.obj # NIL) & (x.obj.mode = TProc) THEN DevCPB.CheckBuffering(x.left, NIL, x.obj.link, pre, lastp) END;
+					IF sym = lparen THEN
+						DevCPS.Get(sym); ActualParameters(apar, fpar, pre, lastp); CheckSym(rparen)
+					ELSE apar := NIL;
+						IF fpar # NIL THEN err(65) END
+					END ;
+					DevCPB.Call(x, apar, fpar);
+					IF x.typ # DevCPT.notyp THEN err(55) END;
+					IF pre # NIL THEN SetPos(x); DevCPB.Construct(Ncomp, pre, x); x := pre END;
+					IF level > 0 THEN DevCPT.topScope.link.leaf := FALSE END
+				END
+			ELSIF sym = if THEN
+				DevCPS.Get(sym); pos := DevCPM.startpos; Expression(x); CheckBool(x); CheckSym(then); StatSeq(y);
+				DevCPB.Construct(Nif, x, y); SetPos(x); lastif := x;
+				WHILE sym = elsif DO
+					DevCPS.Get(sym); pos := DevCPM.startpos; Expression(y); CheckBool(y); CheckSym(then); StatSeq(z);
+					DevCPB.Construct(Nif, y, z); SetPos(y); DevCPB.Link(x, lastif, y)
+				END ;
+				pos := DevCPM.startpos;
+				IF sym = else THEN DevCPS.Get(sym); StatSeq(y) ELSE y := NIL END ;
+				DevCPB.Construct(Nifelse, x, y); CheckSym(end); DevCPB.OptIf(x);
+			ELSIF sym = case THEN
+				DevCPS.Get(sym); pos := DevCPM.startpos; CasePart(x); CheckSym(end)
+			ELSIF sym = while THEN
+				DevCPS.Get(sym); pos := DevCPM.startpos; Expression(x); CheckBool(x); CheckSym(do); StatSeq(y);
+				DevCPB.Construct(Nwhile, x, y); CheckSym(end)
+			ELSIF sym = repeat THEN
+				DevCPS.Get(sym); StatSeq(x);
+				IF sym = until THEN DevCPS.Get(sym); pos := DevCPM.startpos; Expression(y); CheckBool(y)
+				ELSE err(43)
+				END ;
+				DevCPB.Construct(Nrepeat, x, y)
+			ELSIF sym = for THEN
+				DevCPS.Get(sym); pos := DevCPM.startpos;
+				IF sym = ident THEN qualident(id);
+					IF ~(id.typ.form IN intSet) THEN err(68) END ;
+					CheckSym(becomes); Expression(y);
+					x := DevCPB.NewLeaf(id); DevCPB.Assign(x, y); SetPos(x);
+					CheckSym(to); pos := DevCPM.startpos; Expression(y);
+					IF y.class # Nconst THEN
+						DevCPB.GetTempVar("@for", x.left.typ, t);
+						z := DevCPB.NewLeaf(t); DevCPB.Assign(z, y); SetPos(z); DevCPB.Link(stat, last, z);
+						y := DevCPB.NewLeaf(t)
+					ELSE
+						DevCPB.CheckAssign(x.left.typ, y)
+					END ;
+					DevCPB.Link(stat, last, x);
+					p := DevCPM.startpos;
+					IF sym = by THEN DevCPS.Get(sym); ConstExpression(z) ELSE z := DevCPB.NewIntConst(1) END ;
+					x := DevCPB.NewLeaf(id);
+					IF z.conval.intval > 0 THEN DevCPB.Op(leq, x, y)
+					ELSIF z.conval.intval < 0 THEN DevCPB.Op(geq, x, y)
+					ELSE err(63); DevCPB.Op(geq, x, y)
+					END ;
+					CheckSym(do); StatSeq(s);
+					y := DevCPB.NewLeaf(id); DevCPB.StPar1(y, z, incfn); pos := DevCPM.startpos; SetPos(y);
+					IF s = NIL THEN s := y
+					ELSE z := s;
+						WHILE z.link # NIL DO z := z.link END ;
+						z.link := y
+					END ;
+					CheckSym(end); DevCPB.Construct(Nwhile, x, s); pos := p
+				ELSE err(ident)
+				END
+			ELSIF sym = loop THEN
+				DevCPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel);
+				DevCPB.Construct(Nloop, x, NIL); CheckSym(end)
+			ELSIF sym = with THEN
+				DevCPS.Get(sym); idtyp := NIL; x := NIL;
+				LOOP
+					IF sym < bar THEN
+						pos := DevCPM.startpos;
+						IF sym = ident THEN
+							qualident(id); y := DevCPB.NewLeaf(id);
+							IF (id # NIL) & (id.typ.form = Pointer) & ((id.mode = VarPar) OR ~id.leaf) THEN
+								err(-302)	(* warning 302 *)
+							END ;
+							CheckSym(colon);
+							IF sym = ident THEN qualident(t);
+								IF t.mode = Typ THEN
+									IF id # NIL THEN
+										idtyp := id.typ; DevCPB.TypTest(y, t, FALSE); id.typ := t.typ;
+										IF id.ptyp = NIL THEN id.ptyp := idtyp END
+									ELSE err(130)
+									END
+								ELSE err(52)
+								END
+							ELSE err(ident)
+							END
+						ELSE err(ident)
+						END ;
+						CheckSym(do); StatSeq(s); DevCPB.Construct(Nif, y, s); SetPos(y);
+						IF idtyp # NIL THEN
+							IF id.ptyp = idtyp THEN id.ptyp := NIL END;
+							id.typ := idtyp; idtyp := NIL
+						END ;
+						IF x = NIL THEN x := y; lastif := x ELSE DevCPB.Link(x, lastif, y) END
+					END;
+					IF sym = bar THEN DevCPS.Get(sym) ELSE EXIT END
+				END;
+				e := sym = else; pos := DevCPM.startpos;
+				IF e THEN DevCPS.Get(sym); StatSeq(s) ELSE s := NIL END ;
+				DevCPB.Construct(Nwith, x, s); CheckSym(end);
+				IF e THEN x.subcl := 1 END
+			ELSIF sym = exit THEN
+				DevCPS.Get(sym);
+				IF LoopLevel = 0 THEN err(46) END ;
+				DevCPB.Construct(Nexit, x, NIL)
+			ELSIF sym = return THEN DevCPS.Get(sym);
+				IF sym < semicolon THEN Expression(x) END ;
+				IF level > 0 THEN DevCPB.Return(x, DevCPT.topScope.link)
+				ELSE (* not standard Oberon *) DevCPB.Return(x, NIL)
+				END;
+				hasReturn := TRUE
+			END ;
+			IF x # NIL THEN SetPos(x); DevCPB.Link(stat, last, x) END ;
+			IF sym = semicolon THEN DevCPS.Get(sym)
+			ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN err(semicolon)
+			ELSE EXIT
+			END
+		END
+	END StatSeq;
+
+	PROCEDURE Block(VAR procdec, statseq: DevCPT.Node);
+		VAR typ: DevCPT.Struct;
+			obj, first, last, o: DevCPT.Object;
+			x, lastdec: DevCPT.Node;
+			i: SHORTINT;
+			rname: DevCPT.Name;
+			name: DevCPT.String;
+			rec: Elem;
+
+	BEGIN
+		IF ((sym < begin) OR (sym > var)) & (sym # procedure) & (sym # end) & (sym # close) THEN err(36) END;
+		first := NIL; last := NIL; userList := NIL; recList := NIL;
+		LOOP
+			IF sym = const THEN
+				DevCPS.Get(sym);
+				WHILE sym = ident DO
+					DevCPT.Insert(DevCPS.name, obj);
+					obj.mode := Con; CheckMark(obj);
+					obj.typ := DevCPT.int8typ; obj.mode := Var;	(* Var to avoid recursive definition *)
+					IF sym = eql THEN
+						DevCPS.Get(sym); ConstExpression(x)
+					ELSIF sym = becomes THEN
+						err(eql); DevCPS.Get(sym); ConstExpression(x)
+					ELSE err(eql); x := DevCPB.NewIntConst(1)
+					END ;
+					obj.mode := Con; obj.typ := x.typ; obj.conval := x.conval; (* ConstDesc ist not copied *)
+					CheckSym(semicolon)
+				END
+			END ;
+			IF sym = type THEN
+				DevCPS.Get(sym);
+				WHILE sym = ident DO
+					DevCPT.Insert(DevCPS.name, obj); obj.mode := Typ; obj.typ := DevCPT.undftyp;
+					CheckMark(obj); obj.mode := -1;
+					IF sym # eql THEN err(eql) END;
+					IF (sym = eql) OR (sym = becomes) OR (sym = colon) THEN
+						DevCPS.Get(sym); Type(obj.typ, name); SetType(NIL, obj, obj.typ, name);
+					END;
+					obj.mode := Typ;
+					IF obj.typ.form IN {Byte..Set, Char16, Int64} THEN	(* make alias structure *)
+						typ := DevCPT.NewStr(obj.typ.form, Basic); i := typ.ref;
+						typ^ := obj.typ^; typ.ref := i; typ.strobj := NIL; typ.mno := 0; typ.txtpos := DevCPM.errpos;
+						typ.BaseTyp := obj.typ; obj.typ := typ;
+					END;
+					IF obj.typ.strobj = NIL THEN obj.typ.strobj := obj END ;
+					IF obj.typ.form = Pointer THEN	(* !!! *)
+						typ := obj.typ.BaseTyp;
+						IF (typ # NIL) & (typ.comp = Record) & (typ.strobj = NIL) THEN
+							(* pointer to unnamed record: name record as "pointerName^" *)
+							rname := obj.name^$; i := 0;
+							WHILE rname[i] # 0X DO INC(i) END;
+							rname[i] := "^"; rname[i+1] := 0X;
+							DevCPT.Insert(rname, o); o.mode := Typ; o.typ := typ; typ.strobj := o
+						END
+					END;
+					IF obj.vis # internal THEN
+						typ := obj.typ;
+						IF typ.form = Pointer THEN typ := typ.BaseTyp END;
+						IF typ.comp = Record THEN typ.exp := TRUE END
+					END;
+					CheckSym(semicolon)
+				END
+			END ;
+			IF sym = var THEN
+				DevCPS.Get(sym);
+				WHILE sym = ident DO
+					LOOP
+						IF sym = ident THEN
+							DevCPT.Insert(DevCPS.name, obj);
+							obj.mode := Var; obj.link := NIL; obj.leaf := obj.vis = internal; obj.typ := DevCPT.undftyp;
+							CheckMark(obj);
+							IF first = NIL THEN first := obj END ;
+							IF last = NIL THEN DevCPT.topScope.scope := obj ELSE last.link := obj END ;
+							last := obj
+						ELSE err(ident)
+						END ;
+						IF sym = comma THEN DevCPS.Get(sym)
+						ELSIF sym = ident THEN err(comma)
+						ELSE EXIT
+						END
+					END ;
+					CheckSym(colon); Type(typ, name);
+					CheckAlloc(typ, FALSE, DevCPM.errpos);
+					WHILE first # NIL DO SetType(NIL, first, typ, name); first := first.link END ;
+					CheckSym(semicolon)
+				END
+			END ;
+			IF (sym < const) OR (sym > var) THEN EXIT END ;
+		END ;
+		CheckForwardTypes;
+		userList := NIL; rec := recList; recList := NIL;
+		DevCPT.topScope.adr := DevCPM.errpos;
+		procdec := NIL; lastdec := NIL;
+		IF (sym # procedure) & (sym # begin) & (sym # end) & (sym # close) THEN err(37) END;
+		WHILE sym = procedure DO
+			DevCPS.Get(sym); ProcedureDeclaration(x);
+			IF x # NIL THEN
+				IF lastdec = NIL THEN procdec := x ELSE lastdec.link := x END ;
+				lastdec := x
+			END ;
+			CheckSym(semicolon)
+		END ;
+		IF DevCPM.noerr & ~(DevCPM.oberon IN DevCPM.options) THEN CheckRecords(rec) END;
+		hasReturn := FALSE;
+		IF (sym # begin) & (sym # end) & (sym # close) THEN err(38) END;
+		IF sym = begin THEN DevCPS.Get(sym); StatSeq(statseq)
+		ELSE statseq := NIL
+		END ;
+		IF (DevCPT.topScope.link # NIL) & (DevCPT.topScope.link.typ # DevCPT.notyp)
+			& ~hasReturn & (DevCPT.topScope.link.sysflag = 0) THEN err(133) END;
+		IF (level = 0) & (TDinit # NIL) THEN
+			lastTDinit.link := statseq; statseq := TDinit
+		END
+	END Block;
+
+	PROCEDURE Module*(VAR prog: DevCPT.Node);
+		VAR impName, aliasName: DevCPT.Name;
+				procdec, statseq: DevCPT.Node;
+				c, sf: INTEGER; done: BOOLEAN;
+	BEGIN
+		DevCPS.Init; LoopLevel := 0; level := 0; DevCPS.Get(sym);
+		IF sym = module THEN DevCPS.Get(sym) ELSE err(16) END ;
+		IF sym = ident THEN
+			DevCPT.Open(DevCPS.name); DevCPS.Get(sym);
+			DevCPT.libName := "";
+			IF sym = lbrak THEN
+				INCL(DevCPM.options, DevCPM.interface); DevCPS.Get(sym);
+				IF sym = eql THEN DevCPS.Get(sym)
+				ELSE INCL(DevCPM.options, DevCPM.noCode)
+				END;
+				IF sym = string THEN DevCPT.libName := DevCPS.str^$; DevCPS.Get(sym)
+				ELSE err(string)
+				END;
+				CheckSym(rbrak)
+			END;
+			CheckSym(semicolon);
+			IF sym = import THEN DevCPS.Get(sym);
+				LOOP
+					IF sym = ident THEN
+						aliasName := DevCPS.name$; impName := aliasName$; DevCPS.Get(sym);
+						IF sym = becomes THEN DevCPS.Get(sym);
+							IF sym = ident THEN impName := DevCPS.name$; DevCPS.Get(sym) ELSE err(ident) END
+						END ;
+						DevCPT.Import(aliasName, impName, done)
+					ELSE err(ident)
+					END ;
+					IF sym = comma THEN DevCPS.Get(sym)
+					ELSIF sym = ident THEN err(comma)
+					ELSE EXIT
+					END
+				END ;
+				CheckSym(semicolon)
+			END ;
+			IF DevCPM.noerr THEN TDinit := NIL; lastTDinit := NIL; c := DevCPM.errpos;
+				Block(procdec, statseq); DevCPB.Enter(procdec, statseq, NIL); prog := procdec;
+				prog.conval := DevCPT.NewConst(); prog.conval.intval := c; prog.conval.intval2 := DevCPM.startpos;
+				IF sym = close THEN DevCPS.Get(sym); StatSeq(prog.link) END;
+				prog.conval.realval := DevCPM.startpos;
+				CheckSym(end);
+				IF sym = ident THEN
+					IF DevCPS.name # DevCPT.SelfName THEN err(4) END ;
+					DevCPS.Get(sym)
+				ELSE err(ident)
+				END;
+				IF sym # period THEN err(period) END
+			END
+		ELSE err(ident)
+		END ;
+		TDinit := NIL; lastTDinit := NIL;
+		DevCPS.str := NIL
+	END Module;
+
+END DevCPP.

BlackBox/Dev/Mod/CPS.txt

@@ -0,0 +1,367 @@
+MODULE DevCPS;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPS.odc *)
+	(* DO NOT EDIT *)
+	(* SEE XXX *)
+
+	IMPORT SYSTEM, Math, DevCPM, DevCPT;
+	
+	CONST
+		MaxIdLen = 256;
+	
+	TYPE
+(*
+		Name* = ARRAY MaxIdLen OF SHORTCHAR;
+		String* = POINTER TO ARRAY OF SHORTCHAR;
+*)
+
+	(* name, str, numtyp, intval, realval, realval are implicit results of Get *)
+
+	VAR
+		name*: DevCPT.Name;
+		str*: DevCPT.String;
+		lstr*: POINTER TO ARRAY OF CHAR;
+		numtyp*: SHORTINT; (* 1 = char, 2 = integer, 4 = real, 5 = int64, 6 = real32, 7 = real64 *)
+		intval*: INTEGER;	(* integer value or string length (incl. 0X) *)
+		realval*: REAL;
+
+
+	CONST
+		(* numtyp values *)
+		char = 1; integer = 2; real = 4; int64 = 5; real32 = 6; real64 = 7;
+
+		(*symbol values*)
+		null = 0; times = 1; slash = 2; div = 3; mod = 4;
+		and = 5; plus = 6; minus = 7; or = 8; eql = 9;
+		neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
+		in = 15; is = 16; arrow = 17; dollar = 18; period = 19;
+		comma = 20; colon = 21; upto = 22; rparen = 23; rbrak = 24;
+		rbrace = 25; of = 26; then = 27; do = 28; to = 29;
+		by = 30; not = 33;
+		lparen = 40; lbrak = 41; lbrace = 42; becomes = 44;
+		number = 45; nil = 46; string = 47; ident = 48; semicolon = 49;
+		bar = 50; end = 51; else = 52; elsif = 53; until = 54;
+		if = 55; case = 56; while = 57; repeat = 58; for = 59;
+		loop = 60; with = 61; exit = 62; return = 63; array = 64;
+		record = 65; pointer = 66; begin = 67; const = 68; type = 69;
+		var = 70; out = 71; procedure = 72; close = 73; import = 74;
+		module = 75; eof = 76;
+
+	VAR
+		ch: SHORTCHAR;     (*current character*)
+
+	PROCEDURE err(n: SHORTINT);
+	BEGIN DevCPM.err(n)
+	END err;
+	
+	PROCEDURE Str(VAR sym: BYTE);
+		VAR i: SHORTINT; och: SHORTCHAR; lch: CHAR; long: BOOLEAN;
+			s: ARRAY 256 OF CHAR; t: POINTER TO ARRAY OF CHAR;
+	BEGIN i := 0; och := ch; long := FALSE;
+		LOOP DevCPM.GetL(lch);
+			IF lch = och THEN EXIT END ;
+			IF (lch < " ") & (lch # 9X) THEN err(3); EXIT END;
+			IF lch > 0FFX THEN long := TRUE END;
+			IF i < LEN(s) - 1 THEN s[i] := lch
+			ELSIF i = LEN(s) - 1 THEN s[i] := 0X; NEW(lstr, 2 * LEN(s)); lstr^ := s$; lstr[i] := lch
+			ELSIF i < LEN(lstr^) - 1 THEN lstr[i] := lch
+			ELSE t := lstr; t[i] := 0X; NEW(lstr, 2 * LEN(t^)); lstr^ := t^$; lstr[i] := lch
+			END;
+			INC(i)
+		END ;
+		IF i = 1 THEN sym := number; numtyp := 1; intval := ORD(s[0])
+		ELSE
+			sym := string; numtyp := 0; intval := i + 1; NEW(str, intval);
+			IF long THEN
+				IF i < LEN(s) THEN s[i] := 0X; NEW(lstr, intval); lstr^ := s$
+				ELSE lstr[i] := 0X
+				END;
+				str^ := SHORT(lstr$)
+			ELSE
+				IF i < LEN(s) THEN s[i] := 0X; str^ := SHORT(s$);
+				ELSE lstr[i] := 0X; str^ := SHORT(lstr$)
+				END;
+				lstr := NIL
+			END
+		END;
+		DevCPM.Get(ch)
+	END Str;
+
+	PROCEDURE Identifier(VAR sym: BYTE);
+		VAR i: SHORTINT;
+	BEGIN i := 0;
+		REPEAT
+			name[i] := ch; INC(i); DevCPM.Get(ch)
+		UNTIL (ch < "0")
+			OR ("9" < ch) & (CAP(ch) < "A")
+			OR ("Z" < CAP(ch)) & (ch # "_") & (ch < "À")
+			OR (ch = "×")
+			OR (ch = "÷")
+			OR (i = MaxIdLen);
+		IF i = MaxIdLen THEN err(240); DEC(i) END ;
+		name[i] := 0X; sym := ident
+	END Identifier;
+
+	PROCEDURE Number;
+		VAR i, j, m, n, d, e, a: INTEGER; f, g, x: REAL; expCh, tch: SHORTCHAR; neg: BOOLEAN; r: SHORTREAL;
+			dig: ARRAY 30 OF SHORTCHAR; arr: ARRAY 2 OF INTEGER;
+
+		PROCEDURE Ord(ch: SHORTCHAR; hex: BOOLEAN): SHORTINT;
+		BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
+			IF ch <= "9" THEN RETURN SHORT(ORD(ch) - ORD("0"))
+			ELSIF hex THEN RETURN SHORT(ORD(ch) - ORD("A") + 10)
+			ELSE err(2); RETURN 0
+			END
+		END Ord;
+		
+	BEGIN (* ("0" <= ch) & (ch <= "9") *)
+		i := 0; m := 0; n := 0; d := 0;
+		LOOP (* read mantissa *)
+			IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
+				IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
+					IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
+					INC(m)
+				END;
+				DevCPM.Get(ch); INC(i)
+			ELSIF ch = "." THEN DevCPM.Get(ch);
+				IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
+				ELSIF d = 0 THEN (* i > 0 *) d := i
+				ELSE err(2)
+				END
+			ELSE EXIT
+			END
+		END; (* 0 <= n <= m <= i, 0 <= d <= i *)
+		IF d = 0 THEN (* integer *) realval := 0; numtyp := integer;
+			IF n = m THEN intval := 0; i := 0;
+				IF ch = "X" THEN (* character *) DevCPM.Get(ch); numtyp := char;
+					IF n <= 4 THEN
+						WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
+					ELSE err(203)
+					END
+				ELSIF (ch = "H") OR (ch = "S") THEN	(* hex 32bit *)
+					tch := ch; DevCPM.Get(ch);
+					IF (ch = "L") & (DevCPM.oberon IN DevCPM.options) THEN	(* old syntax: hex 64bit *)
+						DevCPM.searchpos := DevCPM.curpos - 2; DevCPM.Get(ch);
+						IF n <= 16 THEN
+							IF (n = 16) & (dig[0] > "7") THEN realval := -1 END;
+							WHILE (i < n) & (i < 10) DO realval := realval * 10H + Ord(dig[i], TRUE); INC(i) END;
+							WHILE i < n DO realval := realval * 10H; intval := intval * 10H + Ord(dig[i], TRUE); INC(i) END;
+							numtyp := int64
+						ELSE err(203)
+						END
+					ELSIF n <= 8 THEN
+						IF (n = 8) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
+						WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END;
+						IF tch = "S" THEN	(* 32 bit hex float *)
+							r := SYSTEM.VAL(SHORTREAL, intval);
+							realval := r; intval := 0; numtyp := real32
+						END
+					ELSE err(203)
+					END
+				ELSIF ch = "L" THEN	(* hex 64bit *)
+					DevCPM.searchpos := DevCPM.curpos - 1; DevCPM.Get(ch);
+					IF n <= 16 THEN
+						IF (n = 16) & (dig[0] > "7") THEN realval := -1 END;
+						WHILE (i < n) & (i < 10) DO realval := realval * 10H + Ord(dig[i], TRUE); INC(i) END;
+						WHILE i < n DO realval := realval * 10H; intval := intval * 10H + Ord(dig[i], TRUE); INC(i) END;
+						numtyp := int64
+					ELSE err(203)
+					END
+				ELSIF ch = "R" THEN	(* hex float 64bit *)
+					DevCPM.searchpos := DevCPM.curpos - 1; DevCPM.Get(ch);
+					IF n <= 16 THEN
+						a := 0; IF (n = 16) & (dig[0] > "7") THEN (* prevent overflow *) a := -1 END;
+						WHILE i < n-8 DO a := a*10H + Ord(dig[i], TRUE); INC(i) END;
+						IF DevCPM.LEHost THEN arr[1] := a ELSE arr[0] := a END;
+						a := 0; IF (n >= 8) & (dig[i] > "7") THEN (* prevent overflow *) a := -1 END;
+						WHILE i < n DO a := a*10H + Ord(dig[i], TRUE); INC(i) END;
+						IF DevCPM.LEHost THEN arr[0] := a ELSE arr[1] := a END;
+						realval := SYSTEM.VAL(REAL, arr);
+						intval := 0; numtyp := real64
+					ELSE err(203)
+					END
+				ELSE	(* decimal *) 
+					WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
+						a := (MAX(INTEGER) - d) DIV 10;
+						IF intval > a THEN
+							a := (intval - a + 65535) DIV 65536 * 65536;
+							realval := realval + a; intval := intval - a
+						END;
+						realval := realval * 10; intval := intval * 10 + d
+					END;
+					IF realval = 0 THEN numtyp := integer
+					ELSIF intval < 9223372036854775808.0E0 - realval THEN numtyp := int64	(* 2^63 *)
+					ELSE intval := 0; err(203)
+					END
+				END
+			ELSE err(203)
+			END
+		ELSE (* fraction *)
+			f := 0; g := 0; e := 0; j := 0; expCh := "E";
+			WHILE (j < 15) & (j < n) DO g := g * 10 + Ord(dig[j], FALSE); INC(j) END;	(* !!! *)
+			WHILE n > j DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
+			IF (ch = "E") OR (ch = "D") & (DevCPM.oberon IN DevCPM.options) THEN
+				expCh := ch; DevCPM.searchpos := DevCPM.curpos - 1; DevCPM.Get(ch); neg := FALSE;
+				IF ch = "-" THEN neg := TRUE; DevCPM.Get(ch)
+				ELSIF ch = "+" THEN DevCPM.Get(ch)
+				END;
+				IF ("0" <= ch) & (ch <= "9") THEN
+					REPEAT n := Ord(ch, FALSE); DevCPM.Get(ch);
+						IF e <= (MAX(SHORTINT) - n) DIV 10 THEN e := SHORT(e*10 + n)
+						ELSE err(203)
+						END
+					UNTIL (ch < "0") OR ("9" < ch);
+					IF neg THEN e := -e END
+				ELSE err(2)
+				END
+			END;
+			DEC(e, i-d-m); (* decimal point shift *)
+			IF e < -308 - 16 THEN
+				realval := 0.0
+			ELSIF e < -308 + 14 THEN
+				realval := (f + g) / Math.IntPower(10, j-e-30) / 1.0E15 / 1.0E15
+			ELSIF e < j THEN
+				realval := (f + g) / Math.IntPower(10, j-e)	(* Ten(j-e) *)
+			ELSIF e <= 308 THEN
+				realval := (f + g) * Math.IntPower(10, e-j)	(* Ten(e-j) *)
+			ELSIF e = 308 + 1 THEN
+				realval := (f + g) * (Math.IntPower(10, e-j) / 16);
+				IF realval <= DevCPM.MaxReal64 / 16 THEN realval := realval * 16
+				ELSE err(203)
+				END
+			ELSE err(203)
+			END;
+			numtyp := real
+		END
+	END Number;
+
+	PROCEDURE Get*(VAR sym: BYTE);
+		VAR s: BYTE; old: INTEGER;
+
+		PROCEDURE Comment;	(* do not read after end of file *)
+		BEGIN DevCPM.Get(ch);
+			LOOP
+				LOOP
+					WHILE ch = "(" DO DevCPM.Get(ch);
+						IF ch = "*" THEN Comment END
+					END ;
+					IF ch = "*" THEN DevCPM.Get(ch); EXIT END ;
+					IF ch = DevCPM.Eot THEN EXIT END ;
+					DevCPM.Get(ch)
+				END ;
+				IF ch = ")" THEN DevCPM.Get(ch); EXIT END ;
+				IF ch = DevCPM.Eot THEN err(5); EXIT END
+			END
+		END Comment;
+
+	BEGIN
+		DevCPM.errpos := DevCPM.curpos-1;
+		WHILE (ch <= " ") OR (ch = 0A0X) DO (*ignore control characters*)
+			IF ch = DevCPM.Eot THEN sym := eof; RETURN
+			ELSE DevCPM.Get(ch)
+			END
+		END ;
+		DevCPM.startpos := DevCPM.curpos - 1;
+		CASE ch OF   (* ch > " " *)
+			| 22X, 27X  : Str(s)
+			| "#"  : s := neq; DevCPM.Get(ch)
+			| "&"  : s :=  and; DevCPM.Get(ch)
+			| "("  : DevCPM.Get(ch);
+					 IF ch = "*" THEN Comment; old := DevCPM.errpos; Get(s); DevCPM.errpos := old; 
+					 ELSE s := lparen
+					 END
+			| ")"  : s := rparen; DevCPM.Get(ch)
+			| "*"  : s :=  times; DevCPM.Get(ch)
+			| "+"  : s :=  plus; DevCPM.Get(ch)
+			| ","  : s := comma; DevCPM.Get(ch)
+			| "-"  : s :=  minus; DevCPM.Get(ch)
+			| "."  : DevCPM.Get(ch);
+							 IF ch = "." THEN DevCPM.Get(ch); s := upto ELSE s := period END
+			| "/"  : s := slash;  DevCPM.Get(ch)
+			| "0".."9": Number; s := number
+			| ":"  : DevCPM.Get(ch);
+							 IF ch = "=" THEN DevCPM.Get(ch); s := becomes ELSE s := colon END
+			| ";"  : s := semicolon; DevCPM.Get(ch)
+			| "<"  : DevCPM.Get(ch);
+							 IF ch = "=" THEN DevCPM.Get(ch); s := leq ELSE s := lss END
+			| "="  : s :=  eql; DevCPM.Get(ch)
+			| ">"  : DevCPM.Get(ch);
+							 IF ch = "=" THEN DevCPM.Get(ch); s := geq ELSE s := gtr END
+			| "A": Identifier(s); IF name = "ARRAY" THEN s := array END
+			| "B": Identifier(s);
+						IF name = "BEGIN" THEN s := begin
+						ELSIF name = "BY" THEN s := by
+						END
+			| "C": Identifier(s);
+						IF name = "CASE" THEN s := case
+						ELSIF name = "CONST" THEN s := const
+						ELSIF name = "CLOSE" THEN s := close
+						END
+			| "D": Identifier(s);
+						IF name = "DO" THEN s := do
+						ELSIF name = "DIV" THEN s := div
+						END
+			| "E": Identifier(s);
+						IF name = "END" THEN s := end
+						ELSIF name = "ELSE" THEN s := else
+						ELSIF name = "ELSIF" THEN s := elsif
+						ELSIF name = "EXIT" THEN s := exit
+						END
+			| "F": Identifier(s); IF name = "FOR" THEN s := for END
+			| "I": Identifier(s);
+						IF name = "IF" THEN s := if
+						ELSIF name = "IN" THEN s := in
+						ELSIF name = "IS" THEN s := is
+						ELSIF name = "IMPORT" THEN s := import
+						END
+			| "L": Identifier(s); IF name = "LOOP" THEN s := loop END
+			| "M": Identifier(s);
+						IF name = "MOD" THEN s := mod
+						ELSIF name = "MODULE" THEN s := module
+						END
+			| "N": Identifier(s); IF name = "NIL" THEN s := nil END
+			| "O": Identifier(s);
+						IF name = "OR" THEN s := or
+						ELSIF name = "OF" THEN s := of
+						ELSIF name = "OUT" THEN s := out
+						END
+			| "P": Identifier(s);
+						IF name = "PROCEDURE" THEN s := procedure
+						ELSIF name = "POINTER" THEN s := pointer
+						END
+			| "R": Identifier(s);
+						IF name = "RECORD" THEN s := record
+						ELSIF name = "REPEAT" THEN s := repeat
+						ELSIF name = "RETURN" THEN s := return
+						END
+			| "T": Identifier(s);
+						IF name = "THEN" THEN s := then
+						ELSIF name = "TO" THEN s := to
+						ELSIF name = "TYPE" THEN s := type
+						END
+			| "U": Identifier(s); IF name = "UNTIL" THEN s := until END
+			| "V": Identifier(s); IF name = "VAR" THEN s := var END
+			| "W": Identifier(s);
+						IF name = "WHILE" THEN s := while
+						ELSIF name = "WITH" THEN s := with
+						END
+			| "G".."H", "J", "K", "Q", "S", "X".."Z", "a".."z", "_" (* XXX *): Identifier(s)
+			| "["  : s := lbrak; DevCPM.Get(ch)
+			| "]"  : s := rbrak; DevCPM.Get(ch)
+			| "^"  : s := arrow; DevCPM.Get(ch)
+			| "$"  : s := dollar; DevCPM.Get(ch)
+			| "{"  : s := lbrace; DevCPM.Get(ch);
+			| "|"  : s := bar; DevCPM.Get(ch)
+			| "}"  : s := rbrace; DevCPM.Get(ch)
+			| "~"  : s := not; DevCPM.Get(ch)
+			| 7FX  : s := upto; DevCPM.Get(ch)
+		ELSE s :=  null; DevCPM.Get(ch)
+		END ;
+		sym := s
+	END Get;
+
+	PROCEDURE Init*;
+	BEGIN ch := " "
+	END Init;
+
+END DevCPS.

BlackBox/Dev/Mod/CPT.txt

@@ -0,0 +1,1890 @@
+MODULE DevCPT;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPT.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT DevCPM;
+
+	CONST
+		MaxIdLen = 256;
+	
+	TYPE
+		Name* = ARRAY MaxIdLen OF SHORTCHAR;
+		String* = POINTER TO ARRAY OF SHORTCHAR;
+		Const* = POINTER TO ConstDesc;
+		Object* = POINTER TO ObjDesc;
+		Struct* = POINTER TO StrDesc;
+		Node* = POINTER TO NodeDesc;
+		ConstExt* = String;
+		LinkList* = POINTER TO LinkDesc;
+
+		ConstDesc* = RECORD
+			ext*: ConstExt;	(* string or code for code proc (longstring in utf8) *)
+			intval*: INTEGER;	(* constant value or adr, proc par size, text position or least case label *)
+			intval2*: INTEGER;	(* string length (#char, incl 0X), proc var size or larger case label *)
+			setval*: SET;	(* constant value, procedure body present or "ELSE" present in case *)
+			realval*: REAL;	(* real or longreal constant value *)
+			link*: Const	(* chain of constants present in obj file *)
+		END ;
+
+		LinkDesc* = RECORD
+			offset*, linkadr*: INTEGER;
+			next*: LinkList;
+		END;
+
+		ObjDesc* = RECORD
+			left*, right*, link*, scope*: Object;
+			name*: String;	(* name = null OR name^ # "" *)
+			leaf*: BOOLEAN;
+			sysflag*: BYTE;
+			mode*, mnolev*: BYTE;	(* mnolev < 0 -> mno = -mnolev *)
+			vis*: BYTE;	(* internal, external, externalR, inPar, outPar *)
+			history*: BYTE;	(* relevant if name # "" *)
+			used*, fpdone*: BOOLEAN;
+			fprint*: INTEGER;
+			typ*: Struct;	(* actual type, changed in with statements *)
+			ptyp*: Struct;	(* original type if typ is changed *)
+			conval*: Const;
+			adr*, num*: INTEGER;	(* mthno *)
+			links*: LinkList;
+			nlink*: Object;	(* link for name list, declaration order for methods, library link for imp obj *)
+			library*, entry*: String;	(* library name, entry name *)
+			modifiers*: POINTER TO ARRAY OF String;	(* additional interface strings *)
+			linkadr*: INTEGER;	(* used in ofront *)
+			red: BOOLEAN;
+		END ;
+
+		StrDesc* = RECORD
+			form*, comp*, mno*, extlev*: BYTE;
+			ref*, sysflag*: SHORTINT;
+			n*, size*, align*, txtpos*: INTEGER;	(* align is alignment for records and len offset for dynarrs *)
+			untagged*, allocated*, pbused*, pvused*, exp*, fpdone, idfpdone: BOOLEAN;
+			attribute*: BYTE;
+			idfp, pbfp*, pvfp*:INTEGER;
+			BaseTyp*: Struct;
+			link*, strobj*: Object;
+			ext*: ConstExt	(* id string for interface records *)
+		END ;
+		
+		NodeDesc* = RECORD
+			left*, right*, link*: Node;
+			class*, subcl*, hint*: BYTE;
+			readonly*: BOOLEAN;
+			typ*: Struct;
+			obj*: Object;
+			conval*: Const
+		END ;
+	
+	CONST
+		maxImps = 127;	(* must be <= MAX(SHORTINT) *)
+		maxStruct = DevCPM.MaxStruct;	(* must be < MAX(INTEGER) DIV 2 *)
+		FirstRef = 32;
+		FirstRef0 = 16;	(* correction for version 0 *)
+		actVersion = 1;
+
+	VAR
+		topScope*: Object;
+		undftyp*, bytetyp*, booltyp*, char8typ*, int8typ*, int16typ*, int32typ*,
+		real32typ*, real64typ*, settyp*, string8typ*, niltyp*, notyp*, sysptrtyp*,
+		anytyp*, anyptrtyp*, char16typ*, string16typ*, int64typ*,
+		restyp*, iunktyp*, punktyp*, guidtyp*,
+		intrealtyp*, lreal64typ*, lint64typ*, lchar16typ*: Struct;
+		nofGmod*: BYTE;	(*nof imports*)
+		GlbMod*: ARRAY maxImps OF Object;	(* .right = first object, .name = module import name (not alias) *)
+		SelfName*: Name;	(* name of module being compiled *)
+		SYSimported*: BOOLEAN;
+		processor*, impProc*: SHORTINT;
+		libName*: Name;	(* library alias of module being compiled *)
+		null*: String;	(* "" *)
+		
+	CONST
+		(* object modes *)
+		Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
+		SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; Attr = 20;
+
+		(* structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		AnyPtr = 14; AnyRec = 15;	(* sym file only *)
+		Char16 = 16; String16 = 17; Int64 = 18;
+		Res = 20; IUnk = 21; PUnk = 22; Guid = 23;
+		
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+
+		(*function number*)
+		assign = 0;
+		haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
+		entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
+		shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
+		inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
+		lchrfn = 33; lentierfcn = 34; typfn = 36; bitsfn = 37; bytesfn = 38;
+		
+		(*SYSTEM function number*)
+		adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
+		getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
+		bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31;
+		thisrecfn = 45; thisarrfn = 46;
+		
+		(* COM function number *)
+		validfn = 40; iidfn = 41; queryfn = 42;
+		
+		(* attribute flags (attr.adr, struct.attribute, proc.conval.setval) *)
+		newAttr = 16; absAttr = 17; limAttr = 18; empAttr = 19; extAttr = 20;
+		
+		(* procedure flags (conval.setval) *)
+		isHidden = 29;
+
+		(* module visibility of objects *)
+		internal = 0; external = 1; externalR = 2; inPar = 3; outPar = 4;
+
+		(* history of imported objects *)
+		inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5;
+
+		(* sysflags *)
+		inBit = 2; outBit = 4; interface = 10; 
+
+		(* symbol file items *)
+		Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22;
+		Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30;
+		Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40;
+		Shdutptr = 41; Slib = 42; Sentry = 43; Sinpar = 25; Soutpar = 26;
+		Slimrec = 25; Sabsrec = 26; Sextrec = 27; Slimpro = 31; Sabspro = 32; Semppro = 33; Sextpro = 34; Simpo = 22;
+		
+	TYPE
+		ImpCtxt = RECORD
+			nextTag, reffp: INTEGER;
+			nofr, minr, nofm: SHORTINT;
+			self: BOOLEAN;
+			ref: ARRAY maxStruct OF Struct;
+			old: ARRAY maxStruct OF Object;
+			pvfp: ARRAY maxStruct OF INTEGER;	(* set only if old # NIL *)
+			glbmno: ARRAY maxImps OF BYTE	(* index is local mno *)
+		END ;
+
+		ExpCtxt = RECORD
+			reffp: INTEGER;
+			ref: SHORTINT;
+			nofm: BYTE;
+			locmno: ARRAY maxImps OF BYTE	(* index is global mno *)
+		END ;
+
+	VAR
+		universe, syslink, comlink, infinity: Object;
+		impCtxt: ImpCtxt;
+		expCtxt: ExpCtxt;
+		nofhdfld: INTEGER;
+		sfpresent, symExtended, symNew: BOOLEAN;
+		version: INTEGER;
+		symChanges: INTEGER;
+		portable: BOOLEAN;
+		depth: INTEGER;
+		
+
+	PROCEDURE err(n: SHORTINT);
+	BEGIN DevCPM.err(n)
+	END err;
+	
+	PROCEDURE NewConst*(): Const;
+		VAR const: Const;
+	BEGIN NEW(const); RETURN const
+	END NewConst;
+	
+	PROCEDURE NewObj*(): Object;
+		VAR obj: Object;
+	BEGIN NEW(obj); obj.name := null; RETURN obj
+	END NewObj;
+	
+	PROCEDURE NewStr*(form, comp: BYTE): Struct;
+		VAR typ: Struct;
+	BEGIN NEW(typ); typ.form := form; typ.comp := comp; typ.ref := maxStruct; (* ref >= maxStruct: not exported yet *)
+		typ.txtpos := DevCPM.errpos; typ.size := -1; typ.BaseTyp := undftyp; RETURN typ
+	END NewStr;
+	
+	PROCEDURE NewNode*(class: BYTE): Node;
+		VAR node: Node;
+	BEGIN
+		NEW(node); node.class := class; RETURN node
+	END NewNode;
+(*	
+	PROCEDURE NewExt*(): ConstExt;
+		VAR ext: ConstExt;
+	BEGIN NEW(ext); RETURN ext
+	END NewExt;
+*)	
+	PROCEDURE NewName* ((*IN*) name: ARRAY OF SHORTCHAR): String;
+		VAR i: INTEGER; p: String;
+	BEGIN
+		i := 0; WHILE name[i] # 0X DO INC(i) END;
+		IF i > 0 THEN NEW(p, i + 1); p^ := name$; RETURN p
+		ELSE RETURN null
+		END
+	END NewName;
+
+	PROCEDURE OpenScope*(level: BYTE; owner: Object);
+		VAR head: Object;
+	BEGIN head := NewObj();
+		head.mode := Head; head.mnolev := level; head.link := owner;
+		IF owner # NIL THEN owner.scope := head END ;
+		head.left := topScope; head.right := NIL; head.scope := NIL; topScope := head
+	END OpenScope;
+
+	PROCEDURE CloseScope*;
+	BEGIN topScope := topScope.left
+	END CloseScope;
+
+	PROCEDURE Init*(opt: SET);
+	BEGIN
+		topScope := universe; OpenScope(0, NIL); SYSimported := FALSE;
+		GlbMod[0] := topScope; nofGmod := 1;
+		sfpresent := TRUE;	(* !!! *)
+		symChanges := 0;
+		infinity.conval.intval := DevCPM.ConstNotAlloc;
+		depth := 0
+	END Init;
+	
+	PROCEDURE Open* (name: Name);
+	BEGIN
+		SelfName := name$; topScope.name := NewName(name);
+	END Open;
+
+	PROCEDURE Close*;
+		VAR i: SHORTINT;
+	BEGIN	(* garbage collection *)
+		CloseScope;
+		i := 0; WHILE i < maxImps DO GlbMod[i] := NIL; INC(i) END ;
+		i := FirstRef; WHILE i < maxStruct DO impCtxt.ref[i] := NIL; impCtxt.old[i] := NIL; INC(i) END
+	END Close;
+
+	PROCEDURE SameType* (x, y: Struct): BOOLEAN;
+	BEGIN
+		RETURN (x = y) OR (x.form = y.form) & ~(x.form IN {Pointer, ProcTyp, Comp}) OR (x = undftyp) OR (y = undftyp)
+	END SameType;
+	
+	PROCEDURE EqualType* (x, y: Struct): BOOLEAN;
+		VAR xp, yp: Object; n: INTEGER;
+	BEGIN
+		n := 0;
+		WHILE (n < 100) & (x # y)
+			& (((x.comp = DynArr) & (y.comp = DynArr) & (x.sysflag = y.sysflag))
+				OR ((x.form = Pointer) & (y.form = Pointer))
+				OR ((x.form = ProcTyp) & (y.form = ProcTyp))) DO
+			IF x.form = ProcTyp THEN
+				IF x.sysflag # y.sysflag THEN RETURN FALSE END;
+				xp := x.link; yp := y.link;
+				INC(depth);
+				WHILE (xp # NIL) & (yp # NIL) & (xp.mode = yp.mode) & (xp.sysflag = yp.sysflag)
+						& (xp.vis = yp.vis) & (depth < 100) & EqualType(xp.typ, yp.typ) DO
+					xp := xp.link; yp := yp.link
+				END;
+				DEC(depth);
+				IF (xp # NIL) OR (yp # NIL) THEN RETURN FALSE END
+			END;
+			x := x.BaseTyp; y := y.BaseTyp; INC(n)
+		END;
+		RETURN SameType(x, y)
+	END EqualType;
+	
+	PROCEDURE Extends* (x, y: Struct): BOOLEAN;
+	BEGIN
+		IF (x.form = Pointer) & (y.form = Pointer) THEN x := x.BaseTyp; y := y.BaseTyp END;
+		IF (x.comp = Record) & (y.comp = Record) THEN
+			IF (y = anytyp) & ~x.untagged THEN RETURN TRUE END;
+			WHILE (x # NIL) & (x # undftyp) & (x # y) DO x := x.BaseTyp END
+		END;
+		RETURN (x # NIL) & EqualType(x, y)
+	END Extends;
+	
+	PROCEDURE Includes* (xform, yform: INTEGER): BOOLEAN;
+	BEGIN
+		CASE xform OF
+		| Char16: RETURN yform IN {Char8, Char16, Int8}
+		| Int16: RETURN yform IN {Char8, Int8, Int16}
+		| Int32: RETURN yform IN {Char8, Char16, Int8, Int16, Int32}
+		| Int64: RETURN yform IN {Char8, Char16, Int8, Int16, Int32, Int64}
+		| Real32: RETURN yform IN {Char8, Char16, Int8, Int16, Int32, Int64, Real32}
+		| Real64: RETURN yform IN {Char8, Char16, Int8, Int16, Int32, Int64, Real32, Real64}
+		| String16: RETURN yform IN {String8, String16}
+		ELSE RETURN xform = yform
+		END
+	END Includes;
+	
+	PROCEDURE FindImport*(VAR name: Name; mod: Object; VAR res: Object);
+		VAR obj: Object; (* i: INTEGER; n: Name; *)
+	BEGIN obj := mod.scope.right;
+		LOOP
+			IF obj = NIL THEN EXIT END ;
+			IF name < obj.name^ THEN obj := obj.left
+			ELSIF name > obj.name^ THEN obj := obj.right
+			ELSE (*found*)
+				IF (obj.mode = Typ) & (obj.vis = internal) THEN obj := NIL
+				ELSE obj.used := TRUE
+				END ;
+				EXIT
+			END
+		END ;
+		res := obj;
+(*	bh: checks usage of non Unicode WinApi functions and types
+		IF (res # NIL) & (mod.scope.library # NIL)
+				& ~(DevCPM.interface IN DevCPM.options)
+				& (SelfName # "Kernel") & (SelfName # "HostPorts") THEN
+			n := name + "W";
+			FindImport(n, mod, obj);
+			IF obj # NIL THEN
+				DevCPM.err(733)
+			ELSE
+				i := LEN(name$);
+				IF name[i - 1] = "A" THEN
+					n[i - 1] := "W"; n[i] := 0X;
+					FindImport(n, mod, obj);
+					IF obj # NIL THEN
+						DevCPM.err(734)
+					END
+				END
+			END
+		END;
+*)
+	END FindImport;
+
+	PROCEDURE Find*(VAR name: Name; VAR res: Object);
+		VAR obj, head: Object;
+	BEGIN head := topScope;
+		LOOP obj := head.right;
+			LOOP
+				IF obj = NIL THEN EXIT END ;
+				IF name < obj.name^ THEN obj := obj.left
+				ELSIF name > obj.name^ THEN obj := obj.right
+				ELSE (* found, obj.used not set for local objects *) EXIT
+				END
+			END ;
+			IF obj # NIL THEN EXIT END ;
+			head := head.left;
+			IF head = NIL THEN EXIT END
+		END ;
+		res := obj
+	END Find;
+
+	PROCEDURE FindFld (VAR name: ARRAY OF SHORTCHAR; typ: Struct; VAR res: Object);
+		VAR obj: Object;
+	BEGIN 
+		WHILE (typ # NIL) & (typ # undftyp) DO obj := typ.link;
+			WHILE obj # NIL DO
+				IF name < obj.name^ THEN obj := obj.left
+				ELSIF name > obj.name^ THEN obj := obj.right
+				ELSE (*found*) res := obj; RETURN
+				END
+			END ;
+			typ := typ.BaseTyp
+		END;
+		res := NIL
+	END FindFld;
+	
+	PROCEDURE FindField* (VAR name: ARRAY OF SHORTCHAR; typ: Struct; VAR res: Object);
+	BEGIN
+		FindFld(name, typ, res);
+		IF (res = NIL) & ~typ.untagged THEN FindFld(name, anytyp, res) END
+	END FindField;
+	
+	PROCEDURE FindBaseField* (VAR name: ARRAY OF SHORTCHAR; typ: Struct; VAR res: Object);
+	BEGIN
+		FindFld(name, typ.BaseTyp, res);
+		IF (res = NIL) & ~typ.untagged THEN FindFld(name, anytyp, res) END
+	END FindBaseField;
+	
+(*
+	PROCEDURE Rotated (y: Object; name: String): Object;
+		VAR c, gc: Object;
+	BEGIN
+		IF name^ < y.name^ THEN
+			c := y.left;
+			IF name^ < c.name^ THEN gc := c.left; c.left := gc.right; gc.right := c
+			ELSE gc := c.right; c.right := gc.left; gc.left := c
+			END;
+			y.left := gc
+		ELSE
+			c := y.right;
+			IF name^ < c.name^ THEN gc := c.left; c.left := gc.right; gc.right := c
+			ELSE gc := c.right; c.right := gc.left; gc.left := c
+			END;
+			y.right := gc
+		END;
+		RETURN gc
+	END Rotated;
+	
+	PROCEDURE InsertIn (obj, scope: Object; VAR old: Object);
+		VAR gg, g, p, x: Object; name, sname: String;
+	BEGIN
+		sname := scope.name; scope.name := null;
+		gg := scope; g := gg; p := g; x := p.right; name := obj.name;
+		WHILE x # NIL DO
+			IF (x.left # NIL) & (x.right # NIL) & x.left.red & x.right.red THEN
+				x.red := TRUE; x.left.red := FALSE; x.right.red := FALSE;
+				IF p.red THEN
+					g.red := TRUE;
+					IF (name^ < g.name^) # (name^ < p.name^) THEN p := Rotated(g, name) END;
+					x := Rotated(gg, name); x.red := FALSE
+				END
+			END;
+			gg := g; g := p; p := x;
+			IF name^ < x.name^ THEN x := x.left
+			ELSIF name^ > x.name^ THEN x := x.right
+			ELSE old := x; scope.right.red := FALSE; scope.name := sname; RETURN
+			END
+		END;
+		x := obj; old := NIL;
+		IF name^ < p.name^ THEN p.left := x ELSE p.right := x END;
+		x.red := TRUE;
+		IF p.red THEN
+			g.red := TRUE;
+			IF (name^ < g.name^) # (name^ < p.name^) THEN p := Rotated(g, name) END;
+			x := Rotated(gg, name);
+			x.red := FALSE
+		END;
+		scope.right.red := FALSE; scope.name := sname
+	END InsertIn;
+*)	
+	PROCEDURE InsertIn (obj, scope: Object; VAR old: Object);
+		VAR ob0, ob1: Object; left: BOOLEAN; name: String;
+	BEGIN
+		ASSERT((scope # NIL) & (scope.mode = Head), 100);
+		ob0 := scope; ob1 := scope.right; left := FALSE; name := obj.name;
+		WHILE ob1 # NIL DO
+			IF name^ < ob1.name^ THEN ob0 := ob1; ob1 := ob1.left; left := TRUE
+			ELSIF name^ > ob1.name^ THEN ob0 := ob1; ob1 := ob1.right; left := FALSE
+			ELSE old := ob1; RETURN
+			END
+		END;
+		IF left THEN ob0.left := obj ELSE ob0.right := obj END ;
+		obj.left := NIL; obj.right := NIL; old := NIL
+	END InsertIn;
+
+	PROCEDURE Insert* (VAR name: Name; VAR obj: Object);
+		VAR old: Object;
+	BEGIN
+		obj := NewObj(); obj.leaf := TRUE;
+		obj.name := NewName(name);
+		obj.mnolev := topScope.mnolev;
+		InsertIn(obj, topScope, old);
+		IF old # NIL THEN err(1) END	(*double def*)
+	END Insert;
+	
+	PROCEDURE InsertThisField (obj: Object; typ: Struct; VAR old: Object);
+		VAR ob0, ob1: Object; left: BOOLEAN; name: String;
+	BEGIN
+		IF typ.link = NIL THEN typ.link := obj
+		ELSE
+			ob1 := typ.link; name := obj.name;
+			REPEAT
+				IF name^ < ob1.name^ THEN ob0 := ob1; ob1 := ob1.left; left := TRUE
+				ELSIF name^ > ob1.name^ THEN ob0 := ob1; ob1 := ob1.right; left := FALSE
+				ELSE old := ob1; RETURN
+				END
+			UNTIL ob1 = NIL;
+			IF left THEN ob0.left := obj ELSE ob0.right := obj END
+		END
+	END InsertThisField;
+
+	PROCEDURE InsertField* (VAR name: Name; typ: Struct; VAR obj: Object);
+		VAR old: Object;
+	BEGIN
+		obj := NewObj(); obj.leaf := TRUE;
+		obj.name := NewName(name);
+		InsertThisField(obj, typ, old);
+		IF old # NIL THEN err(1) END	(*double def*)
+	END InsertField;
+
+
+(*-------------------------- Fingerprinting --------------------------*)
+
+	PROCEDURE FPrintName(VAR fp: INTEGER; VAR name: ARRAY OF SHORTCHAR);
+		VAR i: SHORTINT; ch: SHORTCHAR;
+	BEGIN i := 0;
+		REPEAT ch := name[i]; DevCPM.FPrint(fp, ORD(ch)); INC(i) UNTIL ch = 0X
+	END FPrintName;
+
+	PROCEDURE ^IdFPrint*(typ: Struct);
+
+	PROCEDURE FPrintSign*(VAR fp: INTEGER; result: Struct; par: Object);
+	(* depends on assignment compatibility of params only *)
+	BEGIN
+		IdFPrint(result); DevCPM.FPrint(fp, result.idfp);
+		WHILE par # NIL DO
+			DevCPM.FPrint(fp, par.mode); IdFPrint(par.typ); DevCPM.FPrint(fp, par.typ.idfp);
+			IF (par.mode = VarPar) & (par.vis # 0) THEN DevCPM.FPrint(fp, par.vis) END;	(* IN / OUT *)
+			IF par.sysflag # 0 THEN DevCPM.FPrint(fp, par.sysflag) END;
+			(* par.name and par.adr not considered *)
+			par := par.link
+		END
+	END FPrintSign;
+
+	PROCEDURE IdFPrint*(typ: Struct);	(* idfp codifies assignment compatibility *)
+		VAR btyp: Struct; strobj: Object; idfp: INTEGER; f, c: SHORTINT;
+	BEGIN
+		IF ~typ.idfpdone THEN
+			typ.idfpdone := TRUE;	(* may be recursive, temporary idfp is 0 in that case *)
+			idfp := 0; f := typ.form; c := typ.comp; DevCPM.FPrint(idfp, f); DevCPM.FPrint(idfp, c);
+			btyp := typ.BaseTyp; strobj := typ.strobj;
+			IF (strobj # NIL) & (strobj.name # null) THEN
+				FPrintName(idfp, GlbMod[typ.mno].name^); FPrintName(idfp, strobj.name^)
+			END ;
+			IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN
+				IdFPrint(btyp); DevCPM.FPrint(idfp, btyp.idfp)
+			ELSIF c = Array THEN IdFPrint(btyp); DevCPM.FPrint(idfp, btyp.idfp); DevCPM.FPrint(idfp, typ.n)
+			ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ.link)
+			END ;
+			typ.idfp := idfp
+		END
+	END IdFPrint;
+
+	PROCEDURE FPrintStr*(typ: Struct);
+		VAR f, c: SHORTINT; btyp: Struct; strobj, bstrobj: Object; pbfp, pvfp: INTEGER;
+
+		PROCEDURE ^FPrintFlds(fld: Object; adr: INTEGER; visible: BOOLEAN);
+
+		PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: INTEGER);	(* modifies pvfp only *)
+			VAR i, j, n: INTEGER; btyp: Struct;
+		BEGIN
+			IF typ.comp = Record THEN FPrintFlds(typ.link, adr, FALSE)
+			ELSIF typ.comp = Array THEN btyp := typ.BaseTyp; n := typ.n;
+				WHILE btyp.comp = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END ;
+				IF (btyp.form = Pointer) OR (btyp.comp = Record) THEN
+					j := nofhdfld; FPrintHdFld(btyp, fld, adr);
+					IF j # nofhdfld THEN i := 1;
+						WHILE (i < n) (* & (nofhdfld <= DevCPM.MaxHdFld) *) DO	(* !!! *)
+							INC(adr, btyp.size); FPrintHdFld(btyp, fld, adr); INC(i)
+						END
+					END
+				END
+			ELSIF DevCPM.ExpHdPtrFld &
+				((typ.form = Pointer) & ~typ.untagged OR (fld.name^ = DevCPM.HdPtrName)) THEN	(* !!! *)
+				DevCPM.FPrint(pvfp, Pointer); DevCPM.FPrint(pvfp, adr); INC(nofhdfld)
+			ELSIF DevCPM.ExpHdUtPtrFld &
+				((typ.form = Pointer) & typ.untagged OR (fld.name^ = DevCPM.HdUtPtrName)) THEN	(* !!! *)
+				DevCPM.FPrint(pvfp, Pointer); DevCPM.FPrint(pvfp, adr); INC(nofhdfld);
+				IF typ.form = Pointer THEN DevCPM.FPrint(pvfp, typ.sysflag) ELSE DevCPM.FPrint(pvfp, fld.sysflag) END
+			ELSIF DevCPM.ExpHdProcFld & ((typ.form = ProcTyp) OR (fld.name^ = DevCPM.HdProcName)) THEN
+				DevCPM.FPrint(pvfp, ProcTyp); DevCPM.FPrint(pvfp, adr); INC(nofhdfld)
+			END
+		END FPrintHdFld;
+
+		PROCEDURE FPrintFlds(fld: Object; adr: INTEGER; visible: BOOLEAN);	(* modifies pbfp and pvfp *)
+		BEGIN
+			WHILE (fld # NIL) & (fld.mode = Fld) DO
+				IF (fld.vis # internal) & visible THEN
+					DevCPM.FPrint(pvfp, fld.vis); FPrintName(pvfp, fld.name^); DevCPM.FPrint(pvfp, fld.adr);
+					DevCPM.FPrint(pbfp, fld.vis); FPrintName(pbfp, fld.name^); DevCPM.FPrint(pbfp, fld.adr);
+					FPrintStr(fld.typ); DevCPM.FPrint(pbfp, fld.typ.pbfp); DevCPM.FPrint(pvfp, fld.typ.pvfp)
+				ELSE FPrintHdFld(fld.typ, fld, fld.adr + adr)
+				END ;
+				fld := fld.link
+			END
+		END FPrintFlds;
+
+		PROCEDURE FPrintTProcs(obj: Object);	(* modifies pbfp and pvfp *)
+			VAR fp: INTEGER;
+		BEGIN
+			IF obj # NIL THEN
+				FPrintTProcs(obj.left);
+				IF obj.mode = TProc THEN
+					IF obj.vis # internal THEN
+						fp := 0;
+						IF obj.vis = externalR THEN DevCPM.FPrint(fp, externalR) END;
+						IF limAttr IN obj.conval.setval THEN DevCPM.FPrint(fp, limAttr)
+						ELSIF absAttr IN obj.conval.setval THEN DevCPM.FPrint(fp, absAttr)
+						ELSIF empAttr IN obj.conval.setval THEN DevCPM.FPrint(fp, empAttr)
+						ELSIF extAttr IN obj.conval.setval THEN DevCPM.FPrint(fp, extAttr)
+						END;
+						DevCPM.FPrint(fp, TProc); DevCPM.FPrint(fp, obj.num);
+						FPrintSign(fp, obj.typ, obj.link); FPrintName(fp, obj.name^);
+						IF obj.entry # NIL THEN FPrintName(fp, obj.entry^) END;
+						DevCPM.FPrint(pvfp, fp); DevCPM.FPrint(pbfp, fp)
+					ELSIF DevCPM.ExpHdTProc THEN
+						DevCPM.FPrint(pvfp, TProc); DevCPM.FPrint(pvfp, obj.num)
+					END
+				END;
+				FPrintTProcs(obj.right)
+			END
+		END FPrintTProcs;
+
+	BEGIN
+		IF ~typ.fpdone THEN
+			IdFPrint(typ); pbfp := typ.idfp;
+			IF typ.sysflag # 0 THEN DevCPM.FPrint(pbfp, typ.sysflag) END;
+			IF typ.ext # NIL THEN FPrintName(pbfp, typ.ext^) END;
+			IF typ.attribute # 0 THEN DevCPM.FPrint(pbfp, typ.attribute) END;
+			pvfp := pbfp; typ.pbfp := pbfp; typ.pvfp := pvfp;	(* initial fprints may be used recursively *)
+			typ.fpdone := TRUE;
+			f := typ.form; c := typ.comp; btyp := typ.BaseTyp;
+			IF f = Pointer THEN
+				strobj := typ.strobj; bstrobj := btyp.strobj;
+				IF (strobj = NIL) OR (strobj.name = null) OR (bstrobj = NIL) OR (bstrobj.name = null) THEN
+					FPrintStr(btyp); DevCPM.FPrint(pbfp, btyp.pbfp); pvfp := pbfp
+				(* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *)
+				END
+			ELSIF f = ProcTyp THEN (* use idfp as pbfp and as pvfp *)
+			ELSIF c IN {Array, DynArr} THEN FPrintStr(btyp); DevCPM.FPrint(pbfp, btyp.pvfp); pvfp := pbfp
+			ELSE (* c = Record *)
+				IF btyp # NIL THEN FPrintStr(btyp); DevCPM.FPrint(pbfp, btyp.pbfp); DevCPM.FPrint(pvfp, btyp.pvfp) END ;
+				DevCPM.FPrint(pvfp, typ.size); DevCPM.FPrint(pvfp, typ.align); DevCPM.FPrint(pvfp, typ.n);
+				nofhdfld := 0; FPrintFlds(typ.link, 0, TRUE);
+				FPrintTProcs(typ.link); (* DevCPM.FPrint(pvfp, pbfp); *) strobj := typ.strobj;
+				IF (strobj = NIL) OR (strobj.name = null) THEN pbfp := pvfp END
+			END ;
+			typ.pbfp := pbfp; typ.pvfp := pvfp
+		END
+	END FPrintStr;
+
+	PROCEDURE FPrintObj*(obj: Object);
+		VAR fprint: INTEGER; f, m: SHORTINT; rval: SHORTREAL; ext: ConstExt; mod: Object; r: REAL; x: INTEGER;
+	BEGIN
+		IF ~obj.fpdone THEN
+			fprint := 0; obj.fpdone := TRUE;
+			DevCPM.FPrint(fprint, obj.mode);
+			IF obj.mode = Con THEN
+				f := obj.typ.form; DevCPM.FPrint(fprint, f);
+				CASE f OF
+				| Bool, Char8, Char16, Int8, Int16, Int32:
+					DevCPM.FPrint(fprint, obj.conval.intval)
+				| Int64:
+					x := SHORT(ENTIER((obj.conval.realval + obj.conval.intval) / 4294967296.0));
+					r := obj.conval.realval + obj.conval.intval - x * 4294967296.0;
+					IF r > MAX(INTEGER) THEN r := r - 4294967296.0 END;
+					DevCPM.FPrint(fprint, SHORT(ENTIER(r)));
+					DevCPM.FPrint(fprint, x)
+				| Set:
+					DevCPM.FPrintSet(fprint, obj.conval.setval)
+				| Real32:
+					rval := SHORT(obj.conval.realval); DevCPM.FPrintReal(fprint, rval)
+				| Real64:
+					DevCPM.FPrintLReal(fprint, obj.conval.realval)
+				| String8, String16:
+					FPrintName(fprint, obj.conval.ext^)
+				| NilTyp:
+				ELSE err(127)
+				END
+			ELSIF obj.mode = Var THEN
+				DevCPM.FPrint(fprint, obj.vis); FPrintStr(obj.typ); DevCPM.FPrint(fprint, obj.typ.pbfp)
+			ELSIF obj.mode IN {XProc, IProc}  THEN
+				FPrintSign(fprint, obj.typ, obj.link)
+			ELSIF obj.mode = CProc THEN
+				FPrintSign(fprint, obj.typ, obj.link); ext := obj.conval.ext;
+				m := ORD(ext^[0]); f := 1; DevCPM.FPrint(fprint, m);
+				WHILE f <= m DO DevCPM.FPrint(fprint, ORD(ext^[f])); INC(f) END
+			ELSIF obj.mode = Typ THEN
+				FPrintStr(obj.typ); DevCPM.FPrint(fprint, obj.typ.pbfp)
+			END ;
+			IF obj.sysflag < 0 THEN DevCPM.FPrint(fprint, obj.sysflag) END;
+			IF obj.mode IN {LProc, XProc, CProc, Var, Typ, Con} THEN
+				IF obj.library # NIL THEN
+					FPrintName(fprint, obj.library^)
+				ELSIF obj.mnolev < 0 THEN
+					mod := GlbMod[-obj.mnolev];
+					IF (mod.library # NIL) THEN
+						FPrintName(fprint, mod.library^)
+					END
+				ELSIF obj.mnolev = 0 THEN
+					IF libName # "" THEN FPrintName(fprint, libName) END
+				END;
+				IF obj.entry # NIL THEN FPrintName(fprint, obj.entry^) END
+			END;
+			obj.fprint := fprint
+		END
+	END FPrintObj;
+
+	PROCEDURE FPrintErr* (obj: Object; errno: SHORTINT);	(* !!! *)
+	BEGIN
+		IF errno = 249 THEN
+			DevCPM.LogWLn; DevCPM.LogWStr("  ");
+			DevCPM.LogWStr(GlbMod[-obj.mnolev].name^);
+			DevCPM.LogW("."); DevCPM.LogWStr(obj.name^);
+			DevCPM.LogWStr(" is not consistently imported");
+			err(249)
+		ELSIF obj = NIL THEN	(* changed module sys flags *)
+			IF ~symNew & sfpresent THEN
+				DevCPM.LogWLn; DevCPM.LogWStr("  changed library flag")
+			END
+		ELSIF obj.mnolev = 0 THEN	(* don't report changes in imported modules *)
+			IF sfpresent THEN
+				IF symChanges < 20 THEN
+					DevCPM.LogWLn; DevCPM.LogWStr("  "); DevCPM.LogWStr(obj.name^);
+					IF errno = 250 THEN DevCPM.LogWStr(" is no longer in symbol file")
+					ELSIF errno = 251 THEN DevCPM.LogWStr(" is redefined internally ")
+					ELSIF errno = 252 THEN DevCPM.LogWStr(" is redefined")
+					ELSIF errno = 253 THEN DevCPM.LogWStr(" is new in symbol file")
+					END
+				ELSIF symChanges = 20 THEN
+					DevCPM.LogWLn; DevCPM.LogWStr("  ...")
+				END;
+				INC(symChanges)
+			ELSIF (errno = 253) & ~symExtended THEN
+				DevCPM.LogWLn; 
+				DevCPM.LogWStr("  new symbol file")
+			END
+		END;
+		IF errno = 253 THEN symExtended := TRUE ELSE symNew := TRUE END
+	END FPrintErr;
+
+(*-------------------------- Import --------------------------*)
+
+	PROCEDURE InName(VAR name: String);
+		VAR i: SHORTINT; ch: SHORTCHAR; n: Name;
+	BEGIN i := 0;
+		REPEAT
+			DevCPM.SymRCh(ch); n[i] := ch; INC(i)
+		UNTIL ch = 0X;
+		IF i > 1 THEN NEW(name, i); name^ := n$ ELSE name := null END
+	END InName;
+	
+	PROCEDURE InMod(tag: INTEGER; VAR mno: BYTE);	(* mno is global *)
+		VAR head: Object; name: String; mn: INTEGER; i: BYTE; lib: String;
+	BEGIN
+		IF tag = 0 THEN mno := impCtxt.glbmno[0]
+		ELSIF tag > 0 THEN
+			lib := NIL;
+			IF tag = Slib THEN InName(lib); tag := DevCPM.SymRInt() END;
+			ASSERT(tag = Smname);
+			InName(name);
+			IF (name^ = SelfName) & ~impCtxt.self & ~(DevCPM.interface IN DevCPM.options) THEN err(154) END ;
+			i := 0;
+			WHILE (i < nofGmod) & (name^ # GlbMod[i].name^) DO INC(i) END ;
+			IF i < nofGmod THEN mno := i	(*module already present*)
+			ELSE
+				head := NewObj(); head.mode := Head; head.name := name;
+				mno := nofGmod; head.mnolev := SHORT(SHORT(-mno));
+				head.library := lib;
+				IF nofGmod < maxImps THEN
+					GlbMod[mno] := head; INC(nofGmod)
+				ELSE err(227)
+				END
+			END ;
+			impCtxt.glbmno[impCtxt.nofm] := mno; INC(impCtxt.nofm)
+		ELSE
+			mno := impCtxt.glbmno[-tag]
+		END
+	END InMod;
+
+	PROCEDURE InConstant(f: INTEGER; conval: Const);
+		VAR ch, ch1: SHORTCHAR; ext, t: ConstExt; rval: SHORTREAL; r, s: REAL; i, x, y: INTEGER; str: Name;
+	BEGIN
+		CASE f OF
+		| Byte, Char8, Bool:
+			DevCPM.SymRCh(ch); conval.intval := ORD(ch)
+		| Char16:
+			DevCPM.SymRCh(ch); conval.intval := ORD(ch);
+			DevCPM.SymRCh(ch); conval.intval := conval.intval + ORD(ch) * 256
+		| Int8, Int16, Int32:
+			conval.intval := DevCPM.SymRInt()
+		| Int64:
+			DevCPM.SymRCh(ch); x := 0; y := 1; r := 0; s := 268435456 (*2^28*);
+			WHILE (y < 268435456 (*2^28*)) & (ch >= 80X) DO
+				x := x + (ORD(ch) - 128) * y; y := y * 128; DevCPM.SymRCh(ch)
+			END;
+			WHILE ch >= 80X DO r := r + (ORD(ch) - 128) * s; s := s * 128; DevCPM.SymRCh(ch) END;
+			conval.realval := r + x + ((LONG(ORD(ch)) + 64) MOD 128 - 64) * s;
+			conval.intval := SHORT(ENTIER(r + x + ((LONG(ORD(ch)) + 64) MOD 128 - 64) * s - conval.realval))
+		| Set:
+			DevCPM.SymRSet(conval.setval)
+		| Real32:
+			DevCPM.SymRReal(rval); conval.realval := rval;
+			conval.intval := DevCPM.ConstNotAlloc
+		| Real64:
+			DevCPM.SymRLReal(conval.realval);
+			conval.intval := DevCPM.ConstNotAlloc
+		| String8, String16:
+			i := 0;
+			REPEAT
+				DevCPM.SymRCh(ch);
+				IF i < LEN(str) - 1 THEN str[i] := ch
+				ELSIF i = LEN(str) - 1 THEN str[i] := 0X; NEW(ext, 2 * LEN(str)); ext^ := str$; ext[i] := ch
+				ELSIF i < LEN(ext^) - 1 THEN ext[i] := ch
+				ELSE t := ext; t[i] := 0X; NEW(ext, 2 * LEN(t^)); ext^ := t^$; ext[i] := ch
+				END;
+				INC(i)
+			UNTIL ch = 0X;
+			IF i < LEN(str) THEN NEW(ext, i); ext^ := str$ END;
+			conval.ext := ext; conval.intval := DevCPM.ConstNotAlloc;
+			IF f = String8 THEN conval.intval2 := i
+			ELSE
+				i := 0; y := 0;
+				REPEAT DevCPM.GetUtf8(ext^, x, i); INC(y) UNTIL x = 0;
+				conval.intval2 := y
+			END
+(*		
+			ext := NewExt(); conval.ext := ext; i := 0;
+			REPEAT
+				DevCPM.SymRCh(ch); ext^[i] := ch; INC(i)
+			UNTIL ch = 0X;
+			conval.intval2 := i;
+			conval.intval := DevCPM.ConstNotAlloc
+		| String16:
+			ext := NewExt(); conval.ext := ext; i := 0;
+			REPEAT
+				DevCPM.SymRCh(ch); ext^[i] := ch; INC(i);
+				DevCPM.SymRCh(ch1); ext^[i] := ch1; INC(i)
+			UNTIL (ch = 0X) & (ch1 = 0X);
+			conval.intval2 := i;
+			conval.intval := DevCPM.ConstNotAlloc
+*)
+		| NilTyp:
+			conval.intval := 0
+(*
+		| Guid:
+			ext := NewExt(); conval.ext := ext; i := 0;
+			WHILE i < 16 DO
+				DevCPM.SymRCh(ch); ext^[i] := ch; INC(i)
+			END;
+			ext[16] := 0X;
+			conval.intval2 := 16;
+			conval.intval := DevCPM.ConstNotAlloc;
+*)
+		END
+	END InConstant;
+
+	PROCEDURE ^InStruct(VAR typ: Struct);
+
+	PROCEDURE InSign(mno: BYTE; VAR res: Struct; VAR par: Object);
+		VAR last, new: Object; tag: INTEGER;
+	BEGIN
+		InStruct(res);
+		tag := DevCPM.SymRInt(); last := NIL;
+		WHILE tag # Send DO
+			new := NewObj(); new.mnolev := SHORT(SHORT(-mno));
+			IF last = NIL THEN par := new ELSE last.link := new END ;
+			IF tag = Ssys THEN
+				new.sysflag := SHORT(SHORT(DevCPM.SymRInt())); tag := DevCPM.SymRInt();
+				IF ODD(new.sysflag DIV inBit) THEN new.vis := inPar
+				ELSIF ODD(new.sysflag DIV inBit) THEN new.vis := outPar
+				END
+			END;
+			IF tag = Svalpar THEN new.mode := Var
+			ELSE new.mode := VarPar;
+				IF tag = Sinpar THEN new.vis := inPar
+				ELSIF tag = Soutpar THEN new.vis := outPar
+				END
+			END ;
+			InStruct(new.typ); new.adr := DevCPM.SymRInt(); InName(new.name);
+			last := new; tag := DevCPM.SymRInt()
+		END
+	END InSign;
+
+	PROCEDURE InFld(): Object;	(* first number in impCtxt.nextTag, mno set outside *)
+		VAR tag: INTEGER; obj: Object;
+	BEGIN
+		tag := impCtxt.nextTag; obj := NewObj();
+		IF tag <= Srfld THEN
+			obj.mode := Fld;
+			IF tag = Srfld THEN obj.vis := externalR ELSE obj.vis := external END ;
+			InStruct(obj.typ); InName(obj.name);
+			obj.adr := DevCPM.SymRInt()
+		ELSE
+			obj.mode := Fld;
+			IF tag = Shdptr THEN obj.name := NewName(DevCPM.HdPtrName)
+			ELSIF tag = Shdutptr THEN obj.name := NewName(DevCPM.HdUtPtrName);	(* !!! *)
+				obj.sysflag := 1
+			ELSIF tag = Ssys THEN
+				obj.name := NewName(DevCPM.HdUtPtrName); obj.sysflag := SHORT(SHORT(DevCPM.SymRInt()))
+			ELSE obj.name := NewName(DevCPM.HdProcName)
+			END;
+			obj.typ := undftyp; obj.vis := internal;
+			obj.adr := DevCPM.SymRInt()
+		END;
+		RETURN obj
+	END InFld;
+
+	PROCEDURE InTProc(mno: BYTE): Object;	(* first number in impCtxt.nextTag *)
+		VAR tag: INTEGER; obj: Object;
+	BEGIN
+		tag := impCtxt.nextTag;
+		obj := NewObj(); obj.mnolev := SHORT(SHORT(-mno));
+		IF tag = Shdtpro THEN
+			obj.mode := TProc; obj.name := NewName(DevCPM.HdTProcName);
+			obj.link := NewObj();	(* dummy, easier in Browser *)
+			obj.typ := undftyp; obj.vis := internal;
+			obj.num := DevCPM.SymRInt()
+		ELSE
+			obj.vis := external;
+			IF tag = Simpo THEN obj.vis := externalR; tag := DevCPM.SymRInt() END;
+			obj.mode := TProc; obj.conval := NewConst(); obj.conval.intval := -1;
+			IF tag = Sentry THEN InName(obj.entry); tag := DevCPM.SymRInt() END;
+			InSign(mno, obj.typ, obj.link); InName(obj.name);
+			obj.num := DevCPM.SymRInt();
+			IF tag = Slimpro THEN INCL(obj.conval.setval, limAttr)
+			ELSIF tag = Sabspro THEN INCL(obj.conval.setval, absAttr)
+			ELSIF tag = Semppro THEN INCL(obj.conval.setval, empAttr)
+			ELSIF tag = Sextpro THEN INCL(obj.conval.setval, extAttr)
+			END
+		END ;
+		RETURN obj
+	END InTProc;
+
+	PROCEDURE InStruct(VAR typ: Struct);
+		VAR mno: BYTE; ref: SHORTINT; tag: INTEGER; name: String;
+			t: Struct; obj, last, fld, old, dummy: Object;
+	BEGIN
+		tag := DevCPM.SymRInt();
+		IF tag # Sstruct THEN
+			tag := -tag;
+			IF (version = 0) & (tag >= FirstRef0) THEN tag := tag + FirstRef - FirstRef0 END;	(* correction for new FirstRef *)
+			typ := impCtxt.ref[tag]
+		ELSE
+			ref := impCtxt.nofr; INC(impCtxt.nofr);
+			IF ref < impCtxt.minr THEN impCtxt.minr := ref END ;
+			tag := DevCPM.SymRInt();
+			InMod(tag, mno); InName(name); obj := NewObj();
+			IF name = null THEN
+				IF impCtxt.self THEN old := NIL	(* do not insert type desc anchor here, but in OPL *)
+				ELSE obj.name := NewName("@"); InsertIn(obj, GlbMod[mno], old(*=NIL*)); obj.name := null
+				END ;
+				typ := NewStr(Undef, Basic)
+			ELSE obj.name := name; InsertIn(obj, GlbMod[mno], old);
+				IF old # NIL THEN	(* recalculate fprints to compare with old fprints *)
+					FPrintObj(old); impCtxt.pvfp[ref] := old.typ.pvfp;
+					IF impCtxt.self THEN	(* do not overwrite old typ *)
+						typ := NewStr(Undef, Basic)
+					ELSE	(* overwrite old typ for compatibility reason *)
+						typ := old.typ; typ.link := NIL; typ.sysflag := 0; typ.ext := NIL;
+						typ.fpdone := FALSE; typ.idfpdone := FALSE
+					END
+				ELSE typ := NewStr(Undef, Basic)
+				END
+			END ;
+			impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; typ.ref := SHORT(ref + maxStruct);
+			(* ref >= maxStruct: not exported yet, ref used for err 155 *)
+			typ.mno := mno; typ.allocated := TRUE;
+			typ.strobj := obj; obj.mode := Typ; obj.typ := typ;
+			obj.mnolev := SHORT(SHORT(-mno)); obj.vis := internal; (* name not visible here *)
+			tag := DevCPM.SymRInt();
+			IF tag = Ssys THEN
+				typ.sysflag := SHORT(DevCPM.SymRInt()); tag := DevCPM.SymRInt()
+			END;
+			typ.untagged := typ.sysflag > 0;
+			IF tag = Slib THEN
+				InName(obj.library); tag := DevCPM.SymRInt()
+			END;
+			IF tag = Sentry THEN
+				InName(obj.entry); tag := DevCPM.SymRInt()
+			END;
+			IF tag = String8 THEN
+				InName(typ.ext); tag := DevCPM.SymRInt()
+			END;
+			CASE tag OF
+			| Sptr:
+				typ.form := Pointer; typ.size := DevCPM.PointerSize; typ.n := 0; InStruct(typ.BaseTyp)
+			| Sarr:
+				typ.form := Comp; typ.comp := Array; InStruct(typ.BaseTyp); typ.n := DevCPM.SymRInt();
+				typ.size := typ.n * typ.BaseTyp.size	(* !!! *)
+			| Sdarr:
+				typ.form := Comp; typ.comp := DynArr; InStruct(typ.BaseTyp);
+				IF typ.BaseTyp.comp = DynArr THEN typ.n := typ.BaseTyp.n + 1
+				ELSE typ.n := 0
+				END ;
+				typ.size := DevCPM.DArrSizeA + DevCPM.DArrSizeB * typ.n;	(* !!! *)
+				IF typ.untagged THEN typ.size := DevCPM.PointerSize END
+			| Srec, Sabsrec, Slimrec, Sextrec:
+				typ.form := Comp; typ.comp := Record; InStruct(typ.BaseTyp);
+				(* correction by ETH 18.1.96 *)
+				IF typ.BaseTyp = notyp THEN typ.BaseTyp := NIL END;
+				typ.extlev := 0; t := typ.BaseTyp;
+				WHILE (t # NIL) & (t.comp = Record) DO INC(typ.extlev); t := t.BaseTyp END;
+				typ.size := DevCPM.SymRInt(); typ.align := DevCPM.SymRInt();
+				typ.n := DevCPM.SymRInt();
+				IF tag = Sabsrec THEN typ.attribute := absAttr
+				ELSIF tag = Slimrec THEN typ.attribute := limAttr
+				ELSIF tag = Sextrec THEN typ.attribute := extAttr
+				END;
+				impCtxt.nextTag := DevCPM.SymRInt(); last := NIL;
+				WHILE (impCtxt.nextTag >= Sfld) & (impCtxt.nextTag <= Shdpro)
+						OR (impCtxt.nextTag = Shdutptr) OR (impCtxt.nextTag = Ssys) DO
+					fld := InFld(); fld.mnolev := SHORT(SHORT(-mno));
+					IF last # NIL THEN last.link := fld END ;
+					last := fld;
+					InsertThisField(fld, typ, dummy);
+					impCtxt.nextTag := DevCPM.SymRInt()
+				END ;
+				WHILE impCtxt.nextTag # Send DO fld := InTProc(mno);
+					InsertThisField(fld, typ, dummy);
+					impCtxt.nextTag := DevCPM.SymRInt()
+				END
+			| Spro:
+				typ.form := ProcTyp; typ.size := DevCPM.ProcSize; InSign(mno, typ.BaseTyp, typ.link)
+			| Salias:
+				InStruct(t);
+				typ.form := t.form; typ.comp := Basic; typ.size := t.size;
+				typ.pbfp := t.pbfp; typ.pvfp := t.pvfp; typ.fpdone := TRUE;
+				typ.idfp := t.idfp; typ.idfpdone := TRUE; typ.BaseTyp := t
+			END ;
+			IF ref = impCtxt.minr THEN
+				WHILE ref < impCtxt.nofr DO
+					t := impCtxt.ref[ref]; FPrintStr(t);
+					obj := t.strobj;	(* obj.typ.strobj = obj, else obj.fprint differs (alias) *)
+					IF obj.name # null THEN FPrintObj(obj) END ;
+					old := impCtxt.old[ref];
+					IF old # NIL THEN t.strobj := old;	(* restore strobj *)
+						IF impCtxt.self THEN
+							IF old.mnolev < 0 THEN
+								IF old.history # inconsistent THEN
+									IF old.fprint # obj.fprint THEN old.history := pbmodified
+									ELSIF impCtxt.pvfp[ref] # t.pvfp THEN old.history := pvmodified
+									END
+								(* ELSE remain inconsistent *)
+								END
+							ELSIF old.fprint # obj.fprint THEN old.history := pbmodified
+							ELSIF impCtxt.pvfp[ref] # t.pvfp THEN old.history := pvmodified
+							ELSIF old.vis = internal THEN old.history := same	(* may be changed to "removed" in InObj *)
+							ELSE old.history := inserted	(* may be changed to "same" in InObj *)
+							END
+						ELSE
+							(* check private part, delay error message until really used *)
+							IF impCtxt.pvfp[ref] # t.pvfp THEN old.history := inconsistent END ;
+							IF old.fprint # obj.fprint THEN FPrintErr(old, 249) END
+						END
+					ELSIF impCtxt.self THEN obj.history := removed
+					ELSE obj.history := same
+					END ;
+					INC(ref)
+				END ;
+				impCtxt.minr := maxStruct
+			END
+		END
+	END InStruct;
+
+	PROCEDURE InObj(mno: BYTE): Object;	(* first number in impCtxt.nextTag *)
+		VAR ch: SHORTCHAR; obj, old: Object; typ: Struct;
+			tag, i, s: INTEGER; ext: ConstExt;
+	BEGIN
+		tag := impCtxt.nextTag;
+		IF tag = Stype THEN
+			InStruct(typ); obj := typ.strobj;
+			IF ~impCtxt.self THEN obj.vis := external END	(* type name visible now, obj.fprint already done *)
+		ELSE
+			obj := NewObj(); obj.mnolev := SHORT(SHORT(-mno)); obj.vis := external;
+			IF tag = Ssys THEN obj.sysflag := SHORT(SHORT(DevCPM.SymRInt())); tag := DevCPM.SymRInt() END;
+			IF tag = Slib THEN
+				InName(obj.library); tag := DevCPM.SymRInt()
+			END;
+			IF tag = Sentry THEN
+				InName(obj.entry); tag := DevCPM.SymRInt()
+			END;
+			IF tag >= Sxpro THEN
+				IF obj.conval = NIL THEN obj.conval := NewConst() END;
+				obj.conval.intval := -1;
+				InSign(mno, obj.typ, obj.link);
+				CASE tag OF
+				| Sxpro: obj.mode := XProc
+				| Sipro: obj.mode := IProc
+				| Scpro: obj.mode := CProc;
+					s := DevCPM.SymRInt();
+					NEW(ext, s + 1); obj.conval.ext := ext;
+					ext^[0] := SHORT(CHR(s)); i := 1;
+					WHILE i <= s DO DevCPM.SymRCh(ext^[i]); INC(i) END
+				END
+			ELSIF tag = Salias THEN
+				obj.mode := Typ; InStruct(obj.typ)
+			ELSIF (tag = Svar) OR (tag = Srvar) THEN
+				obj.mode := Var;
+				IF tag = Srvar THEN obj.vis := externalR END ;
+				InStruct(obj.typ)
+			ELSE	(* Constant *)
+				obj.conval := NewConst(); InConstant(tag, obj.conval);
+				IF (tag = Int8) OR (tag = Int16) THEN tag := Int32 END;
+				obj.mode := Con; obj.typ := impCtxt.ref[tag]; 
+			END ;
+			InName(obj.name)
+		END ;
+		FPrintObj(obj);
+		IF (obj.mode = Var) & ((obj.typ.strobj = NIL) OR (obj.typ.strobj.name = null)) THEN
+			(* compute a global fingerprint to avoid structural type equivalence for anonymous types *)
+			DevCPM.FPrint(impCtxt.reffp, obj.typ.ref - maxStruct)
+		END ;
+		IF tag # Stype THEN
+			InsertIn(obj, GlbMod[mno], old);
+			IF impCtxt.self THEN
+				IF old # NIL THEN
+					(* obj is from old symbol file, old is new declaration *)
+					IF old.vis = internal THEN old.history := removed
+					ELSE FPrintObj(old); FPrintStr(old.typ);	(* FPrint(obj) already called *)
+						IF obj.fprint # old.fprint THEN old.history := pbmodified
+						ELSIF obj.typ.pvfp # old.typ.pvfp THEN old.history := pvmodified
+						ELSE old.history := same
+						END
+					END
+				ELSE obj.history := removed	(* OutObj not called if mnolev < 0 *)
+				END
+			(* ELSE old = NIL, or file read twice, consistent, OutObj not called *)
+			END
+		ELSE	(* obj already inserted in InStruct *)
+			IF impCtxt.self THEN	(* obj.mnolev = 0 *)
+				IF obj.vis = internal THEN obj.history := removed
+				ELSIF obj.history = inserted THEN obj.history := same
+				END
+			(* ELSE OutObj not called for obj with mnolev < 0 *)
+			END
+		END ;
+		RETURN obj
+	END InObj;
+
+	PROCEDURE Import*(aliasName: Name; VAR name: Name; VAR done: BOOLEAN);
+		VAR obj, h: Object; mno: BYTE; tag, p: INTEGER; lib: String;	(* done used in Browser *)
+	BEGIN
+		IF name = "SYSTEM" THEN
+			SYSimported := TRUE;
+			p := processor;
+			IF (p < 10) OR (p > 30) THEN p := DevCPM.sysImp END;
+			INCL(DevCPM.options, p);	(* for sysflag handling *)
+			Insert(aliasName, obj); obj.mode := Mod; obj.mnolev := 0; obj.scope := syslink; obj.typ := notyp;
+			h := NewObj(); h.mode := Head; h.right := syslink; obj.scope := h
+		ELSIF name = "COM" THEN
+			IF DevCPM.comAware IN DevCPM.options THEN
+				INCL(DevCPM.options, DevCPM.com);	(* for sysflag handling *)
+				Insert(aliasName, obj); obj.mode := Mod; obj.mnolev := 0; obj.scope := comlink; obj.typ := notyp;
+				h := NewObj(); h.mode := Head; h.right := comlink; obj.scope := h;
+			ELSE err(151)
+			END;
+		ELSIF name = "JAVA" THEN
+			INCL(DevCPM.options, DevCPM.java)
+		ELSE
+			impCtxt.nofr := FirstRef; impCtxt.minr := maxStruct; impCtxt.nofm := 0;
+			impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0;
+			DevCPM.OldSym(name, done);
+			IF done THEN
+				lib := NIL;
+				impProc := SHORT(DevCPM.SymRInt());
+				IF (impProc # 0) & (processor # 0) & (impProc # processor) THEN err(151) END;
+				DevCPM.checksum := 0;	(* start checksum here to avoid problems with proc id fixup *)
+				tag := DevCPM.SymRInt();
+				IF tag < Smname THEN version := tag; tag := DevCPM.SymRInt()
+				ELSE version := 0
+				END;
+				IF tag = Slib THEN InName(lib); tag := DevCPM.SymRInt() END;
+				InMod(tag, mno);
+				IF (name[0] # "@") & (GlbMod[mno].name^ # name) THEN	(* symbol file name conflict *)
+					GlbMod[mno] := NIL; nofGmod := mno; DEC(impCtxt.nofm);
+					DevCPM.CloseOldSym; done := FALSE
+				END;
+			END;
+			IF done THEN
+				GlbMod[mno].library := lib;
+				impCtxt.nextTag := DevCPM.SymRInt();
+				WHILE ~DevCPM.eofSF() DO
+					obj := InObj(mno); impCtxt.nextTag := DevCPM.SymRInt()
+				END ;
+				Insert(aliasName, obj);
+				obj.mode := Mod; obj.scope := GlbMod[mno](*.right*);
+				GlbMod[mno].link := obj;
+				obj.mnolev  := SHORT(SHORT(-mno)); obj.typ := notyp;
+				DevCPM.CloseOldSym
+			ELSIF impCtxt.self THEN
+				sfpresent := FALSE
+			ELSE err(152)	(*sym file not found*)
+			END
+		END
+	END Import;
+
+(*-------------------------- Export --------------------------*)
+
+	PROCEDURE OutName(VAR name: ARRAY OF SHORTCHAR);
+		VAR i: SHORTINT; ch: SHORTCHAR;
+	BEGIN i := 0;
+		REPEAT ch := name[i]; DevCPM.SymWCh(ch); INC(i) UNTIL ch = 0X
+	END OutName;
+	
+	PROCEDURE OutMod(mno: SHORTINT);
+		VAR mod: Object;
+	BEGIN
+		IF expCtxt.locmno[mno] < 0 THEN (* new mod *)
+			mod := GlbMod[mno];
+			IF mod.library # NIL THEN
+				DevCPM.SymWInt(Slib); OutName(mod.library^)
+			END;
+			DevCPM.SymWInt(Smname);
+			expCtxt.locmno[mno] := expCtxt.nofm; INC(expCtxt.nofm);
+			OutName(mod.name^)
+		ELSE DevCPM.SymWInt(-expCtxt.locmno[mno])
+		END
+	END OutMod;
+
+	PROCEDURE ^OutStr(typ: Struct);
+	PROCEDURE ^OutFlds(fld: Object; adr: INTEGER; visible: BOOLEAN);
+
+	PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: INTEGER);
+		VAR i, j, n: INTEGER; btyp: Struct;
+	BEGIN
+		IF typ.comp = Record THEN OutFlds(typ.link, adr, FALSE)
+		ELSIF typ.comp = Array THEN btyp := typ.BaseTyp; n := typ.n;
+			WHILE btyp.comp = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END ;
+			IF (btyp.form = Pointer) OR (btyp.comp = Record) THEN
+				j := nofhdfld; OutHdFld(btyp, fld, adr);
+				IF j # nofhdfld THEN i := 1;
+					WHILE (i < n) (* & (nofhdfld <= DevCPM.MaxHdFld) *) DO	(* !!! *)
+						INC(adr, btyp.size); OutHdFld(btyp, fld, adr); INC(i)
+					END
+				END
+			END
+		ELSIF DevCPM.ExpHdPtrFld &
+			((typ.form = Pointer) & ~typ.untagged OR (fld.name^ = DevCPM.HdPtrName)) THEN	(* !!! *)
+			DevCPM.SymWInt(Shdptr); DevCPM.SymWInt(adr); INC(nofhdfld)
+		ELSIF DevCPM.ExpHdUtPtrFld &
+			((typ.form = Pointer) & typ.untagged OR (fld.name^ = DevCPM.HdUtPtrName)) THEN	(* !!! *)
+			DevCPM.SymWInt(Ssys);	(* DevCPM.SymWInt(Shdutptr); *)
+			IF typ.form = Pointer THEN n := typ.sysflag ELSE n := fld.sysflag END;
+			DevCPM.SymWInt(n);
+			DevCPM.SymWInt(adr); INC(nofhdfld);
+			IF n > 1 THEN portable := FALSE END	(* hidden untagged pointer are portable *)
+		ELSIF DevCPM.ExpHdProcFld & ((typ.form = ProcTyp) OR (fld.name^ = DevCPM.HdProcName)) THEN
+			DevCPM.SymWInt(Shdpro); DevCPM.SymWInt(adr); INC(nofhdfld)
+		END
+	END OutHdFld;
+
+	PROCEDURE OutFlds(fld: Object; adr: INTEGER; visible: BOOLEAN);
+	BEGIN
+		WHILE (fld # NIL) & (fld.mode = Fld) DO
+			IF (fld.vis # internal) & visible THEN
+				IF fld.vis = externalR THEN DevCPM.SymWInt(Srfld) ELSE DevCPM.SymWInt(Sfld) END ;
+				OutStr(fld.typ); OutName(fld.name^); DevCPM.SymWInt(fld.adr)
+			ELSE OutHdFld(fld.typ, fld, fld.adr + adr)
+			END ;
+			fld := fld.link
+		END
+	END OutFlds;
+
+	PROCEDURE OutSign(result: Struct; par: Object);
+	BEGIN
+		OutStr(result);
+		WHILE par # NIL DO
+			IF par.sysflag # 0 THEN DevCPM.SymWInt(Ssys); DevCPM.SymWInt(par.sysflag) END;	
+			IF par.mode = Var THEN DevCPM.SymWInt(Svalpar)
+			ELSIF par.vis = inPar THEN DevCPM.SymWInt(Sinpar)
+			ELSIF par.vis = outPar THEN DevCPM.SymWInt(Soutpar)
+			ELSE DevCPM.SymWInt(Svarpar)
+			END ;
+			OutStr(par.typ);
+			DevCPM.SymWInt(par.adr);
+			OutName(par.name^); par := par.link
+		END ;
+		DevCPM.SymWInt(Send)
+	END OutSign;
+
+	PROCEDURE OutTProcs(typ: Struct; obj: Object);
+		VAR bObj: Object;
+	BEGIN
+		IF obj # NIL THEN
+			IF obj.mode = TProc THEN
+(*
+				IF (typ.BaseTyp # NIL) & (obj.num < typ.BaseTyp.n) & (obj.vis = internal) & (obj.scope # NIL) THEN
+					FindBaseField(obj.name^, typ, bObj);
+					ASSERT((bObj # NIL) & (bObj.num = obj.num));
+					IF bObj.vis # internal THEN DevCPM.Mark(109, typ.txtpos) END
+					(* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *)
+				END;
+*)
+				IF obj.vis # internal THEN
+					IF obj.vis = externalR THEN DevCPM.SymWInt(Simpo) END;
+					IF obj.entry # NIL THEN
+						DevCPM.SymWInt(Sentry); OutName(obj.entry^); portable := FALSE
+					END;
+					IF limAttr IN obj.conval.setval THEN DevCPM.SymWInt(Slimpro)
+					ELSIF absAttr IN obj.conval.setval THEN DevCPM.SymWInt(Sabspro)
+					ELSIF empAttr IN obj.conval.setval THEN DevCPM.SymWInt(Semppro)
+					ELSIF extAttr IN obj.conval.setval THEN DevCPM.SymWInt(Sextpro)
+					ELSE DevCPM.SymWInt(Stpro)
+					END;
+					OutSign(obj.typ, obj.link); OutName(obj.name^);
+					DevCPM.SymWInt(obj.num)
+				ELSIF DevCPM.ExpHdTProc THEN
+					DevCPM.SymWInt(Shdtpro);
+					DevCPM.SymWInt(obj.num)
+				END
+			END;
+			OutTProcs(typ, obj.left);
+			OutTProcs(typ, obj.right)
+		END
+	END OutTProcs;
+
+	PROCEDURE OutStr(typ: Struct);	(* OPV.TypeAlloc already applied *)
+		VAR strobj: Object;
+	BEGIN
+		IF typ.ref < expCtxt.ref THEN DevCPM.SymWInt(-typ.ref)
+		ELSE
+			DevCPM.SymWInt(Sstruct);
+			typ.ref := expCtxt.ref; INC(expCtxt.ref);
+			IF expCtxt.ref >= maxStruct THEN err(228) END ;
+			OutMod(typ.mno); strobj := typ.strobj;
+			IF (strobj # NIL) & (strobj.name # null) THEN OutName(strobj.name^);
+				CASE strobj.history OF
+				| pbmodified: FPrintErr(strobj, 252)
+				| pvmodified: FPrintErr(strobj, 251)
+				| inconsistent: FPrintErr(strobj, 249)
+				ELSE (* checked in OutObj or correct indirect export *)
+				END
+			ELSE DevCPM.SymWCh(0X)	(* anonymous => never inconsistent, pvfp influences the client fp *)
+			END;
+			IF typ.sysflag # 0 THEN	(* !!! *)
+				DevCPM.SymWInt(Ssys); DevCPM.SymWInt(typ.sysflag);
+				IF typ.sysflag > 0 THEN portable := FALSE END
+			END;
+			IF strobj # NIL THEN
+				IF strobj.library # NIL THEN
+					DevCPM.SymWInt(Slib); OutName(strobj.library^); portable := FALSE
+				END;
+				IF strobj.entry # NIL THEN
+					DevCPM.SymWInt(Sentry); OutName(strobj.entry^); portable := FALSE
+				END
+			END;
+			IF typ.ext # NIL THEN
+				DevCPM.SymWInt(String8); OutName(typ.ext^); portable := FALSE
+			END;
+			CASE typ.form OF
+			| Pointer:
+				DevCPM.SymWInt(Sptr); OutStr(typ.BaseTyp)
+			| ProcTyp:
+				DevCPM.SymWInt(Spro); OutSign(typ.BaseTyp, typ.link)
+			| Comp:
+				CASE typ.comp OF
+				| Array:
+					DevCPM.SymWInt(Sarr); OutStr(typ.BaseTyp); DevCPM.SymWInt(typ.n)
+				| DynArr:
+					DevCPM.SymWInt(Sdarr); OutStr(typ.BaseTyp)
+				| Record:
+					IF typ.attribute = limAttr THEN DevCPM.SymWInt(Slimrec)
+					ELSIF typ.attribute = absAttr THEN DevCPM.SymWInt(Sabsrec)
+					ELSIF typ.attribute = extAttr THEN DevCPM.SymWInt(Sextrec)
+					ELSE DevCPM.SymWInt(Srec)
+					END;
+					IF typ.BaseTyp = NIL THEN OutStr(notyp) ELSE OutStr(typ.BaseTyp) END ;
+					(* BaseTyp should be Notyp, too late to change *)
+					DevCPM.SymWInt(typ.size); DevCPM.SymWInt(typ.align); DevCPM.SymWInt(typ.n);
+					nofhdfld := 0; OutFlds(typ.link, 0, TRUE);
+(*
+					IF nofhdfld > DevCPM.MaxHdFld THEN DevCPM.Mark(223, typ.txtpos) END ;	(* !!! *)
+*)
+					OutTProcs(typ, typ.link); DevCPM.SymWInt(Send)
+				END
+			ELSE	(* alias structure *)
+				DevCPM.SymWInt(Salias); OutStr(typ.BaseTyp)
+			END
+		END
+	END OutStr;
+
+	PROCEDURE OutConstant(obj: Object);
+		VAR f, i: SHORTINT; rval: SHORTREAL; a, b, c: INTEGER; r: REAL;
+	BEGIN
+		f := obj.typ.form;
+(*
+		IF obj.typ = guidtyp THEN f := Guid END;
+*)
+		IF f = Int32 THEN
+			IF (obj.conval.intval >= -128) & (obj.conval.intval <= -127) THEN f := Int8
+			ELSIF (obj.conval.intval >= -32768) & (obj.conval.intval <= -32767) THEN f := Int16
+			END
+		END;
+		DevCPM.SymWInt(f);
+		CASE f OF
+		| Bool, Char8:
+			DevCPM.SymWCh(SHORT(CHR(obj.conval.intval)))
+		| Char16:
+			DevCPM.SymWCh(SHORT(CHR(obj.conval.intval MOD 256)));
+			DevCPM.SymWCh(SHORT(CHR(obj.conval.intval DIV 256)))
+		| Int8, Int16, Int32:
+			DevCPM.SymWInt(obj.conval.intval)
+		| Int64:
+			IF ABS(obj.conval.realval + obj.conval.intval) <= MAX(INTEGER) THEN
+				a := SHORT(ENTIER(obj.conval.realval + obj.conval.intval)); b := -1; c := -1
+			ELSIF ABS(obj.conval.realval + obj.conval.intval) <= 1125899906842624.0 (*2^50*) THEN
+				a := SHORT(ENTIER((obj.conval.realval + obj.conval.intval) /  2097152.0 (*2^21*)));
+				b := SHORT(ENTIER(obj.conval.realval + obj.conval.intval - a * 2097152.0 (*2^21*))); c := -1
+			ELSE
+				a := SHORT(ENTIER((obj.conval.realval + obj.conval.intval) / 4398046511104.0 (*2^42*)));
+				r := obj.conval.realval + obj.conval.intval - a * 4398046511104.0 (*2^42*);
+				b := SHORT(ENTIER(r /  2097152.0 (*2^21*)));
+				c := SHORT(ENTIER(r - b * 2097152.0 (*2^21*)))
+			END;
+			IF c >= 0 THEN
+				DevCPM.SymWCh(SHORT(CHR(c MOD 128 + 128))); c := c DIV 128;
+				DevCPM.SymWCh(SHORT(CHR(c MOD 128 + 128))); c := c DIV 128;
+				DevCPM.SymWCh(SHORT(CHR(c MOD 128 + 128)))
+			END;
+			IF b >= 0 THEN
+				DevCPM.SymWCh(SHORT(CHR(b MOD 128 + 128))); b := b DIV 128;
+				DevCPM.SymWCh(SHORT(CHR(b MOD 128 + 128))); b := b DIV 128;
+				DevCPM.SymWCh(SHORT(CHR(b MOD 128 + 128)))
+			END;
+			DevCPM.SymWInt(a)
+		| Set:
+			DevCPM.SymWSet(obj.conval.setval)
+		| Real32:
+			rval := SHORT(obj.conval.realval); DevCPM.SymWReal(rval)
+		| Real64:
+			DevCPM.SymWLReal(obj.conval.realval)
+		| String8, String16:
+			OutName(obj.conval.ext^)
+		| NilTyp:
+(*
+		| Guid:
+			i := 0;
+			WHILE i < 16 DO DevCPM.SymWCh(obj.conval.ext[i]); INC(i) END
+*)
+		ELSE err(127)
+		END
+	END OutConstant;
+
+	PROCEDURE OutObj(obj: Object);
+		VAR i, j: SHORTINT; ext: ConstExt;
+	BEGIN
+		IF obj # NIL THEN
+			OutObj(obj.left);
+			IF obj.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN
+				IF obj.history = removed THEN FPrintErr(obj, 250)
+				ELSIF obj.vis # internal THEN
+					CASE obj.history OF
+					| inserted: FPrintErr(obj, 253)
+					| same:	(* ok *)
+					| pbmodified:
+						IF (obj.mode # Typ) OR (obj.typ.strobj # obj) THEN FPrintErr(obj, 252) END
+					| pvmodified:
+						IF (obj.mode # Typ) OR (obj.typ.strobj # obj) THEN FPrintErr(obj, 251) END
+					END ;
+					IF obj.sysflag < 0 THEN DevCPM.SymWInt(Ssys); DevCPM.SymWInt(obj.sysflag); portable := FALSE END;
+					IF obj.mode IN {LProc, XProc, CProc, Var, Con} THEN
+						(* name alias for types handled in OutStr *)
+						IF obj.library # NIL THEN
+							DevCPM.SymWInt(Slib); OutName(obj.library^); portable := FALSE
+						END;
+						IF obj.entry # NIL THEN
+							DevCPM.SymWInt(Sentry); OutName(obj.entry^); portable := FALSE
+						END
+					END;
+					CASE obj.mode OF
+					| Con:
+						OutConstant(obj); OutName(obj.name^)
+					| Typ:
+						IF obj.typ.strobj = obj THEN DevCPM.SymWInt(Stype); OutStr(obj.typ)
+						ELSE DevCPM.SymWInt(Salias); OutStr(obj.typ); OutName(obj.name^)
+						END
+					| Var:
+						IF obj.vis = externalR THEN DevCPM.SymWInt(Srvar) ELSE DevCPM.SymWInt(Svar) END ;
+						OutStr(obj.typ); OutName(obj.name^);
+						IF (obj.typ.strobj = NIL) OR (obj.typ.strobj.name = null) THEN
+							(* compute fingerprint to avoid structural type equivalence *)
+							DevCPM.FPrint(expCtxt.reffp, obj.typ.ref)
+						END
+					| XProc:
+						DevCPM.SymWInt(Sxpro); OutSign(obj.typ, obj.link); OutName(obj.name^)
+					| IProc:
+						DevCPM.SymWInt(Sipro); OutSign(obj.typ, obj.link); OutName(obj.name^)
+					| CProc:
+						DevCPM.SymWInt(Scpro); OutSign(obj.typ, obj.link); ext := obj.conval.ext;
+						j := ORD(ext^[0]); i := 1; DevCPM.SymWInt(j);
+						WHILE i <= j DO DevCPM.SymWCh(ext^[i]); INC(i) END ;
+						OutName(obj.name^); portable := FALSE
+					END
+				END
+			END ;
+			OutObj(obj.right)
+		END
+	END OutObj;
+
+	PROCEDURE Export*(VAR ext, new: BOOLEAN);
+			VAR i: SHORTINT; nofmod: BYTE; done: BOOLEAN; old: Object; oldCSum: INTEGER;
+	BEGIN
+		symExtended := FALSE; symNew := FALSE; nofmod := nofGmod;
+		Import("@self", SelfName, done); nofGmod := nofmod;
+		oldCSum := DevCPM.checksum;
+		ASSERT(GlbMod[0].name^ = SelfName);
+		IF DevCPM.noerr THEN	(* ~DevCPM.noerr => ~done *)
+			DevCPM.NewSym(SelfName);
+			IF DevCPM.noerr THEN
+				DevCPM.SymWInt(0);	(* portable symfile *)
+				DevCPM.checksum := 0;	(* start checksum here to avoid problems with proc id fixup *)
+				DevCPM.SymWInt(actVersion);
+				old := GlbMod[0]; portable := TRUE;
+ 				IF libName # "" THEN
+					DevCPM.SymWInt(Slib); OutName(libName); portable := FALSE;
+					IF done & ((old.library = NIL) OR (old.library^ # libName)) THEN
+						FPrintErr(NIL, 252)
+					END
+				ELSIF done & (old.library # NIL) THEN FPrintErr(NIL, 252)
+				END;
+				DevCPM.SymWInt(Smname); OutName(SelfName);
+				expCtxt.reffp := 0; expCtxt.ref := FirstRef;
+				expCtxt.nofm := 1; expCtxt.locmno[0] := 0;
+				i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ;
+				OutObj(topScope.right);
+				ext := sfpresent & symExtended;
+				new := ~sfpresent OR symNew OR (DevCPM.checksum # oldCSum);
+				IF DevCPM.noerr & ~portable THEN
+					DevCPM.SymReset;
+					DevCPM.SymWInt(processor)	(* nonportable symfile *)
+				END;
+				IF DevCPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN
+					new := TRUE
+				END ;
+				IF ~DevCPM.noerr THEN DevCPM.DeleteNewSym END
+				(* DevCPM.RegisterNewSym is called in OP2 after writing the object file *)
+			END
+		END
+	END Export;	(* no new symbol file if ~DevCPM.noerr *)
+
+
+	PROCEDURE InitStruct(VAR typ: Struct; form: BYTE);
+	BEGIN
+		typ := NewStr(form, Basic); typ.ref := form; typ.size := 1; typ.allocated := TRUE;
+		typ.strobj := NewObj(); typ.pbfp := form; typ.pvfp := form; typ.fpdone := TRUE;
+		typ.idfp := form; typ.idfpdone := TRUE
+	END InitStruct;
+
+	PROCEDURE EnterBoolConst(name: Name; val: INTEGER);
+		VAR obj: Object;
+	BEGIN
+		Insert(name, obj); obj.conval := NewConst();
+		obj.mode := Con; obj.typ := booltyp; obj.conval.intval := val
+	END EnterBoolConst;
+
+	PROCEDURE EnterRealConst(name: Name; val: REAL; VAR obj: Object);
+	BEGIN
+		Insert(name, obj); obj.conval := NewConst();
+		obj.mode := Con; obj.typ := real32typ; obj.conval.realval := val
+	END EnterRealConst;
+
+	PROCEDURE EnterTyp(name: Name; form: BYTE; size: SHORTINT; VAR res: Struct);
+		VAR obj: Object; typ: Struct;
+	BEGIN
+		Insert(name, obj);
+		typ := NewStr(form, Basic); obj.mode := Typ; obj.typ := typ; obj.vis := external;
+		typ.strobj := obj; typ.size := size; typ.ref := form; typ.allocated := TRUE;
+		typ.pbfp := form; typ.pvfp := form; typ.fpdone := TRUE;
+		typ.idfp := form; typ.idfpdone := TRUE; res := typ
+	END EnterTyp;
+
+	PROCEDURE EnterProc(name: Name; num: SHORTINT);
+		VAR obj: Object;
+	BEGIN Insert(name, obj);
+		obj.mode := SProc; obj.typ := notyp; obj.adr := num
+	END EnterProc;
+	
+	PROCEDURE EnterAttr(name: Name; num: SHORTINT);
+		VAR obj: Object;
+	BEGIN Insert(name, obj);
+		obj.mode := Attr; obj.adr := num
+	END EnterAttr;
+
+	PROCEDURE EnterTProc(ptr, rec: Struct; name: Name; num, typ: SHORTINT);
+		VAR obj, par: Object;
+	BEGIN
+		InsertField(name, rec, obj);
+		obj.mnolev := -128;	(* for correct implement only behaviour *)
+		obj.mode := TProc; obj.num := num; obj.conval := NewConst();
+		obj.conval.setval := obj.conval.setval + {newAttr};
+		IF typ = 0 THEN	(* FINALIZE, RELEASE *)
+			obj.typ := notyp; obj.vis := externalR;
+			INCL(obj.conval.setval, empAttr)
+		ELSIF typ = 1 THEN	(* QueryInterface *)
+			par := NewObj(); par.name := NewName("int"); par.mode := VarPar; par.vis := outPar;
+			par.sysflag := 8; par.adr := 16; par.typ := punktyp;
+			par.link := obj.link; obj.link := par;
+			par := NewObj(); par.name := NewName("iid"); par.mode := VarPar; par.vis := inPar;
+			par.sysflag := 16; par.adr := 12; par.typ := guidtyp;
+			par.link := obj.link; obj.link := par;
+			obj.typ := restyp; obj.vis := external;
+			INCL(obj.conval.setval, extAttr)
+		ELSIF typ = 2 THEN	(* AddRef, Release *)
+			obj.typ := notyp; obj.vis := externalR;
+			INCL(obj.conval.setval, isHidden);
+			INCL(obj.conval.setval, extAttr)
+		END;
+		par := NewObj(); par.name := NewName("this"); par.mode := Var;
+		par.adr := 8; par.typ := ptr;
+		par.link := obj.link; obj.link := par;
+	END EnterTProc;
+
+	PROCEDURE EnterHdField(VAR root: Object; offs: SHORTINT);
+		VAR obj: Object;
+	BEGIN
+		obj := NewObj(); obj.mode := Fld;
+		obj.name := NewName(DevCPM.HdPtrName); obj.typ := undftyp; obj.adr := offs;
+		obj.link := root; root := obj
+	END EnterHdField;
+
+BEGIN
+	NEW(null, 1); null^ := "";
+	topScope := NIL; OpenScope(0, NIL); DevCPM.errpos := 0;
+	InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
+	InitStruct(string8typ, String8); InitStruct(niltyp, NilTyp); niltyp.size := DevCPM.PointerSize;
+	InitStruct(string16typ, String16);
+	undftyp.BaseTyp := undftyp;
+
+	(*initialization of module SYSTEM*)
+(*
+	EnterTyp("BYTE", Byte, 1, bytetyp);
+	EnterProc("NEW", sysnewfn);
+*)
+	EnterTyp("PTR", Pointer, DevCPM.PointerSize, sysptrtyp);
+	EnterProc("ADR", adrfn);
+	EnterProc("TYP", typfn);
+	EnterProc("CC", ccfn);
+	EnterProc("LSH", lshfn);
+	EnterProc("ROT", rotfn);
+	EnterProc("GET", getfn);
+	EnterProc("PUT", putfn);
+	EnterProc("GETREG", getrfn);
+	EnterProc("PUTREG", putrfn);
+	EnterProc("BIT", bitfn);
+	EnterProc("VAL", valfn);
+	EnterProc("MOVE", movefn);
+	EnterProc("THISRECORD", thisrecfn);
+	EnterProc("THISARRAY", thisarrfn);
+	syslink := topScope.right; topScope.right := NIL;
+	
+	(* initialization of module COM *)
+	EnterProc("ID", iidfn);
+	EnterProc("QUERY", queryfn);
+	EnterTyp("RESULT", Int32, 4, restyp);
+	restyp.ref := Res;
+	EnterTyp("GUID", Guid, 16, guidtyp);
+	guidtyp.form := Comp; guidtyp.comp := Array; guidtyp.n := 16;
+	EnterTyp("IUnknown^", IUnk, 12, iunktyp);
+	iunktyp.form := Comp; iunktyp.comp := Record; iunktyp.n := 3;
+	iunktyp.attribute := absAttr;
+(*
+	EnterHdField(iunktyp.link, 12);
+*)
+	iunktyp.BaseTyp := NIL; iunktyp.align := 4;
+	iunktyp.sysflag := interface; iunktyp.untagged := TRUE;
+	NEW(iunktyp.ext, 40); iunktyp.ext^ := "{00000000-0000-0000-C000-000000000046}";
+	EnterTyp("IUnknown", PUnk, DevCPM.PointerSize, punktyp);
+	punktyp.form := Pointer; punktyp.BaseTyp := iunktyp;
+	punktyp.sysflag := interface; punktyp.untagged := TRUE;
+	EnterTProc(punktyp, iunktyp, "QueryInterface", 0, 1);
+	EnterTProc(punktyp, iunktyp, "AddRef", 1, 2);
+	EnterTProc(punktyp, iunktyp, "Release", 2, 2);
+	comlink := topScope.right; topScope.right := NIL;
+	
+	universe := topScope;
+	EnterProc("LCHR", lchrfn);
+	EnterProc("LENTIER", lentierfcn);
+	EnterTyp("ANYREC", AnyRec, 0, anytyp);
+	anytyp.form := Comp; anytyp.comp := Record; anytyp.n := 1;
+	anytyp.BaseTyp := NIL; anytyp.extlev := -1;	(* !!! *)
+	anytyp.attribute := absAttr;
+	EnterTyp("ANYPTR", AnyPtr, DevCPM.PointerSize, anyptrtyp);
+	anyptrtyp.form := Pointer; anyptrtyp.BaseTyp := anytyp;
+	EnterTProc(anyptrtyp, anytyp, "FINALIZE", 0, 0);
+	EnterTProc(anyptrtyp, iunktyp, "RELEASE", 1, 0);
+	EnterProc("VALID", validfn);
+
+	EnterTyp("SHORTCHAR", Char8, 1, char8typ);
+	string8typ.BaseTyp := char8typ;
+	EnterTyp("CHAR", Char16, 2, char16typ);
+	EnterTyp("LONGCHAR", Char16, 2, lchar16typ);
+	string16typ.BaseTyp := char16typ;
+	EnterTyp("SET", Set, 4, settyp);
+	EnterTyp("BYTE", Int8, 1, int8typ);
+	guidtyp.BaseTyp := int8typ;
+	EnterTyp("SHORTINT", Int16, 2, int16typ);
+	EnterTyp("INTEGER",  Int32, 4, int32typ);
+	EnterTyp("LONGINT", Int64, 8, int64typ);
+	EnterTyp("LARGEINT", Int64, 8, lint64typ);
+	EnterTyp("SHORTREAL", Real32, 4, real32typ);
+	EnterTyp("REAL", Real64, 8, real64typ);
+	EnterTyp("LONGREAL", Real64, 8, lreal64typ);
+	EnterTyp("BOOLEAN", Bool, 1, booltyp);
+	EnterBoolConst("FALSE", 0);	(* 0 and 1 are compiler internal representation only *)
+	EnterBoolConst("TRUE",  1);
+	EnterRealConst("INF", DevCPM.InfReal, infinity);
+	EnterProc("HALT", haltfn);
+	EnterProc("NEW", newfn);
+	EnterProc("ABS", absfn);
+	EnterProc("CAP", capfn);
+	EnterProc("ORD", ordfn);
+	EnterProc("ENTIER", entierfn);
+	EnterProc("ODD", oddfn);
+	EnterProc("MIN", minfn);
+	EnterProc("MAX", maxfn);
+	EnterProc("CHR", chrfn);
+	EnterProc("SHORT", shortfn);
+	EnterProc("LONG", longfn);
+	EnterProc("SIZE", sizefn);
+	EnterProc("INC", incfn);
+	EnterProc("DEC", decfn);
+	EnterProc("INCL", inclfn);
+	EnterProc("EXCL", exclfn);
+	EnterProc("LEN", lenfn);
+	EnterProc("COPY", copyfn);
+	EnterProc("ASH", ashfn);
+	EnterProc("ASSERT", assertfn);
+(*
+	EnterProc("ADR", adrfn);
+	EnterProc("TYP", typfn);
+*)
+	EnterProc("BITS", bitsfn);
+	EnterAttr("ABSTRACT", absAttr);
+	EnterAttr("LIMITED", limAttr);
+	EnterAttr("EMPTY", empAttr);
+	EnterAttr("EXTENSIBLE", extAttr);
+	NEW(intrealtyp); intrealtyp^ := real64typ^;
+	impCtxt.ref[Undef] := undftyp; impCtxt.ref[Byte] := bytetyp;
+	impCtxt.ref[Bool] := booltyp;  impCtxt.ref[Char8] := char8typ;
+	impCtxt.ref[Int8] := int8typ;  impCtxt.ref[Int16] := int16typ;
+	impCtxt.ref[Int32] := int32typ;  impCtxt.ref[Real32] := real32typ;
+	impCtxt.ref[Real64] := real64typ;  impCtxt.ref[Set] := settyp;
+	impCtxt.ref[String8] := string8typ; impCtxt.ref[NilTyp] := niltyp;
+	impCtxt.ref[NoTyp] := notyp; impCtxt.ref[Pointer] := sysptrtyp;
+	impCtxt.ref[AnyPtr] := anyptrtyp; impCtxt.ref[AnyRec] := anytyp;
+	impCtxt.ref[Char16] := char16typ; impCtxt.ref[String16] := string16typ;
+	impCtxt.ref[Int64] := int64typ;
+	impCtxt.ref[IUnk] := iunktyp; impCtxt.ref[PUnk] := punktyp; 
+	impCtxt.ref[Guid] := guidtyp; impCtxt.ref[Res] := restyp;
+END DevCPT.
+
+Objects:
+
+    mode  | adr    conval  link     scope    leaf
+   ------------------------------------------------
+    Undef |                                         Not used
+    Var   | vadr           next              regopt Glob or loc var or proc value parameter
+    VarPar| vadr           next              regopt Var parameter (vis = 0 | inPar | outPar)
+    Con   |        val                              Constant
+    Fld   | off            next                     Record field
+    Typ   |                                         Named type
+    LProc | entry  sizes   firstpar scope    leaf   Local procedure, entry adr set in back-end
+    XProc | entry  sizes   firstpar scope    leaf   External procedure, entry adr set in back-end
+    SProc | fno    sizes                            Standard procedure
+    CProc |        code    firstpar scope           Code procedure
+    IProc | entry  sizes            scope    leaf   Interrupt procedure, entry adr set in back-end
+    Mod   |                         scope           Module
+    Head  | txtpos         owner    firstvar        Scope anchor
+    TProc | entry  sizes   firstpar scope    leaf   Bound procedure, mthno = obj.num
+                                                    
+		Structures:
+
+    form    comp  | n      BaseTyp   link     mno  txtpos   sysflag
+	----------------------------------------------------------------------------------
+    Undef   Basic |
+    Byte    Basic |
+    Bool    Basic |
+    Char8   Basic |
+    Int8    Basic |
+    Int16   Basic |
+    Int32   Basic |
+    Real32  Basic |
+    Real64  Basic |
+    Set     Basic |
+    String8 Basic |
+    NilTyp  Basic |
+    NoTyp   Basic |
+    Pointer Basic |        PBaseTyp           mno  txtpos   sysflag
+    ProcTyp Basic |        ResTyp    params   mno  txtpos   sysflag
+    Comp    Array | nofel  ElemTyp            mno  txtpos   sysflag
+    Comp    DynArr| dim    ElemTyp            mno  txtpos   sysflag
+    Comp    Record| nofmth RBaseTyp  fields   mno  txtpos   sysflag
+    Char16  Basic |
+    String16Basic |
+    Int64   Basic |
+
+Nodes:
+
+design   = Nvar|Nvarpar|Nfield|Nderef|Nindex|Nguard|Neguard|Ntype|Nproc.
+expr     = design|Nconst|Nupto|Nmop|Ndop|Ncall.
+nextexpr = NIL|expr.
+ifstat   = NIL|Nif.
+casestat = Ncaselse.
+sglcase  = NIL|Ncasedo.
+stat     = NIL|Ninittd|Nenter|Nassign|Ncall|Nifelse|Ncase|Nwhile|Nrepeat|
+           Nloop|Nexit|Nreturn|Nwith|Ntrap.
+
+
+              class     subcl     obj      left      right     link      
+              ---------------------------------------------------------
+
+design        Nvar                var                          nextexpr
+              Nvarpar             varpar                       nextexpr
+              Nfield              field    design              nextexpr
+              Nderef    ptr/str            design              nextexpr
+              Nindex                       design    expr      nextexpr
+              Nguard                       design              nextexpr (typ = guard type)
+              Neguard                      design              nextexpr (typ = guard type)
+              Ntype               type                         nextexpr
+              Nproc     normal    proc                         nextexpr
+                        super     proc                         nextexpr
+
+
+expr          design
+              Nconst              const                                 (val = node.conval)
+              Nupto                        expr      expr      nextexpr 
+              Nmop      not                expr                nextexpr
+                        minus              expr                nextexpr
+                        is        tsttype  expr                nextexpr
+                        conv               expr                nextexpr
+                        abs                expr                nextexpr
+                        cap                expr                nextexpr
+                        odd                expr                nextexpr
+                        bit                expr                nextexpr {x}
+                        adr                expr                nextexpr SYSTEM.ADR
+                        typ                expr                nextexpr SYSTEM.TYP
+                        cc                 Nconst              nextexpr SYSTEM.CC
+                        val                expr                nextexpr SYSTEM.VAL
+              Ndop      times              expr      expr      nextexpr
+                        slash              expr      expr      nextexpr
+                        div                expr      expr      nextexpr
+                        mod                expr      expr      nextexpr
+                        and                expr      expr      nextexpr
+                        plus               expr      expr      nextexpr
+                        minus              expr      expr      nextexpr
+                        or                 expr      expr      nextexpr
+                        eql                expr      expr      nextexpr
+                        neq                expr      expr      nextexpr
+                        lss                expr      expr      nextexpr
+                        leq                expr      expr      nextexpr
+                        grt                expr      expr      nextexpr
+                        geq                expr      expr      nextexpr
+                        in                 expr      expr      nextexpr
+                        ash                expr      expr      nextexpr
+                        msk                expr      Nconst    nextexpr
+                        len                design    Nconst    nextexpr
+                        min                expr      expr      nextexpr MIN
+                        max                expr      expr      nextexpr MAX
+                        bit                expr      expr      nextexpr SYSTEM.BIT
+                        lsh                expr      expr      nextexpr SYSTEM.LSH
+                        rot                expr      expr      nextexpr SYSTEM.ROT
+              Ncall               fpar     design    nextexpr  nextexpr
+              Ncomp                        stat      expr      nextexpr
+
+nextexpr      NIL
+              expr
+
+ifstat        NIL
+              Nif                          expr      stat      ifstat
+
+casestat      Ncaselse                     sglcase   stat           (minmax = node.conval)
+
+sglcase       NIL
+              Ncasedo                      Nconst    stat      sglcase
+
+stat          NIL
+              Ninittd                                          stat     (of node.typ)
+              Nenter              proc     stat      stat      stat     (proc=NIL for mod)
+              Nassign   assign             design    expr      stat
+                        newfn              design    nextexp   stat
+                        incfn              design    expr      stat
+                        decfn              design    expr      stat
+                        inclfn             design    expr      stat
+                        exclfn             design    expr      stat
+                        copyfn             design    expr      stat
+                        getfn              design    expr      stat     SYSTEM.GET
+                        putfn              expr      expr      stat     SYSTEM.PUT
+                        getrfn             design    Nconst    stat     SYSTEM.GETREG
+                        putrfn             Nconst    expr      stat     SYSTEM.PUTREG
+                        sysnewfn           design    expr      stat     SYSTEM.NEW
+                        movefn             expr      expr      stat     SYSTEM.MOVE
+                                                                        (right.link = 3rd par)
+              Ncall               fpar     design    nextexpr  stat
+              Nifelse                      ifstat    stat      stat
+              Ncase                        expr      casestat  stat
+              Nwhile                       expr      stat      stat
+              Nrepeat                      stat      expr      stat
+              Nloop                        stat                stat 
+              Nexit                                            stat 
+              Nreturn             proc     nextexpr            stat     (proc = NIL for mod)
+              Nwith                        ifstat    stat      stat
+              Ntrap                                  expr      stat
+              Ncomp                        stat      stat      stat

BlackBox/Dev/Mod/CPV486.txt

@@ -0,0 +1,1774 @@
+MODULE DevCPV486;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/CPV486.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT SYSTEM, DevCPM, DevCPT, DevCPE, DevCPH, DevCPL486, DevCPC486;
+	
+	CONST
+		processor* = 10; (* for i386 *)
+
+		(* object modes *)
+		Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
+		SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
+		
+		(* item modes for i386 *)
+		Ind = 14; Abs = 15; Stk = 16; Cond = 17; Reg = 18; DInd = 19;
+
+		(* symbol values and ops *)
+		times = 1; slash = 2; div = 3; mod = 4;
+		and = 5; plus = 6; minus = 7; or = 8; eql = 9;
+		neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
+		in = 15; is = 16; ash = 17; msk = 18; len = 19;
+		conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
+		(*SYSTEM*)
+		adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
+		min = 34; max = 35; typfn = 36;
+		thisrecfn = 45; thisarrfn = 46;
+		shl = 50; shr = 51; lshr = 52; xor = 53;
+
+		(* structure forms *)
+		Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
+		Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
+		Pointer = 13; ProcTyp = 14; Comp = 15;
+		Char16 = 16; String16 = 17; Int64 = 18;
+		VString16to8 = 29; VString8 = 30; VString16 = 31;
+		realSet = {Real32, Real64};
+
+		(* composite structure forms *)
+		Basic = 1; Array = 2; DynArr = 3; Record = 4;
+
+		(* nodes classes *)
+		Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
+		Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
+		Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
+		Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
+		Nreturn = 26; Nwith = 27; Ntrap = 28; Ncomp = 30;
+		Ndrop = 50; Nlabel = 51; Ngoto = 52; Njsr = 53; Nret = 54; Ncmp = 55;
+
+		(*function number*)
+		assign = 0; newfn = 1; incfn = 13; decfn = 14;
+		inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
+
+		(*SYSTEM function number*)
+		getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31;
+		
+		(* COM function number *)
+		validfn = 40; queryfn = 42;
+		
+		(* procedure flags (conval.setval) *)
+		hasBody = 1; isRedef = 2; slNeeded = 3; imVar = 4; isHidden = 29; isGuarded = 30; isCallback = 31;
+
+		(* attribute flags (attr.adr, struct.attribute, proc.conval.setval) *)
+		newAttr = 16; absAttr = 17; limAttr = 18; empAttr = 19; extAttr = 20;
+		
+		(* case statement flags (conval.setval) *)
+		useTable = 1; useTree = 2;
+		
+		(* registers *)
+		AX = 0; CX = 1; DX = 2; BX = 3; SP = 4; BP = 5; SI = 6; DI = 7; AH = 4; CH = 5; DH = 6; BH = 7;
+		stk = 31; mem = 30; con = 29; float = 28; high = 27; short = 26; deref = 25; loaded = 24;
+		wreg = {AX, BX, CX, DX, SI, DI};
+
+		(* module visibility of objects *)
+		internal = 0; external = 1; externalR = 2; inPar = 3; outPar = 4;
+
+		(* sysflag *)
+		untagged = 1; noAlign = 3; align2 = 4; align8 = 6; union = 7;
+		interface = 10; guarded = 8; noframe = 16;
+		nilBit = 1; enumBits = 8; new = 1; iid = 2;
+		stackArray = 120;
+		
+		(* system trap numbers *)
+		withTrap = -1; caseTrap = -2; funcTrap = -3; typTrap = -4;
+		recTrap = -5; ranTrap = -6; inxTrap = -7; copyTrap = -8;
+		
+		ParOff = 8;
+		interfaceSize = 16;	(* SIZE(Kernel.Interface) *)
+		addRefFP = 4E27A847H;	(* fingerprint of AddRef and Release procedures *)
+		intHandlerFP = 24B0EAE3H;	(* fingerprint of InterfaceTrapHandler *)
+		numPreIntProc = 2;
+		
+		
+	VAR
+		Exit, Return: DevCPL486.Label;
+		assert, sequential: BOOLEAN;
+		nesting, actual: INTEGER;
+		query, addRef, release, release2: DevCPT.Object;
+		
+	PROCEDURE Init*(opt: SET);
+		CONST ass = 2;
+	BEGIN
+		DevCPL486.Init(opt); DevCPC486.Init(opt);
+		assert := ass IN opt;
+		DevCPM.breakpc := MAX(INTEGER);
+		query := NIL; addRef := NIL; release := NIL; release2 := NIL; DevCPC486.intHandler := NIL;
+	END Init;
+	
+	PROCEDURE Close*;
+	BEGIN
+		DevCPL486.Close
+	END Close;
+
+	PROCEDURE Align(VAR offset: INTEGER; align: INTEGER);
+	BEGIN
+		CASE align OF
+		   1: (* ok *)
+		| 2: INC(offset, offset MOD 2)
+		| 4: INC(offset, (-offset) MOD 4)
+		| 8: INC(offset, (-offset) MOD 8)
+		END
+	END Align;
+	
+	PROCEDURE NegAlign(VAR offset: INTEGER; align: INTEGER);
+	BEGIN
+		CASE align OF
+		   1: (* ok *)
+		| 2: DEC(offset, offset MOD 2)
+		| 4: DEC(offset, offset MOD 4)
+		| 8: DEC(offset, offset MOD 8)
+		END
+	END NegAlign;
+	
+	PROCEDURE Base(typ: DevCPT.Struct; limit: INTEGER): INTEGER;	(* typ.comp # DynArr *)
+		VAR align: INTEGER;
+	BEGIN
+		WHILE typ.comp = Array DO typ := typ.BaseTyp END ;
+		IF typ.comp = Record THEN
+			align := typ.align
+		ELSE
+			align := typ.size;
+		END;
+		IF align > limit THEN RETURN limit ELSE RETURN align END
+	END Base;
+
+(* -----------------------------------------------------
+	reference implementation of TypeSize for portable symbol files
+	mandatory for all non-system structures
+
+	PROCEDURE TypeSize (typ: DevCPT.Struct);
+		VAR f, c: SHORTINT; offset: LONGINT; fld: DevCPT.Object; btyp: DevCPT.Struct;
+	BEGIN
+		IF typ.size = -1 THEN
+			f := typ.form; c := typ.comp; btyp := typ.BaseTyp;
+			IF c = Record THEN
+				IF btyp = NIL THEN offset := 0 ELSE TypeSize(btyp); offset := btyp.size END;
+				fld := typ.link;
+				WHILE (fld # NIL) & (fld.mode = Fld) DO
+					btyp := fld.typ; TypeSize(btyp);
+					IF btyp.size >= 4 THEN INC(offset, (-offset) MOD 4)
+					ELSIF btyp.size >= 2 THEN INC(offset, offset MOD 2)
+					END;
+					fld.adr := offset; INC(offset, btyp.size);
+					fld := fld.link
+				END;
+				IF offset > 2 THEN INC(offset, (-offset) MOD 4) END;
+				typ.size := offset; typ.align := 4;
+				typ.n := -1  (* methods not counted yet *)
+			ELSIF c = Array THEN
+				TypeSize(btyp);
+				typ.size := typ.n * btyp.size
+			ELSIF f = Pointer THEN
+				typ.size := DevCPM.PointerSize
+			ELSIF f = ProcTyp THEN
+				typ.size := DevCPM.ProcSize
+			ELSE (* c = DynArr *)
+				TypeSize(btyp);
+				IF btyp.comp = DynArr THEN typ.size := btyp.size + 4
+				ELSE typ.size := 8
+				END
+			END
+		END
+	END TypeSize;
+
+----------------------------------------------------- *)
+
+	PROCEDURE GTypeSize (typ: DevCPT.Struct; guarded: BOOLEAN);
+		VAR f, c: BYTE; offset, align, falign, alignLimit: INTEGER;
+			fld: DevCPT.Object; btyp: DevCPT.Struct; name: DevCPT.Name;
+	BEGIN
+		IF typ.untagged THEN guarded := TRUE END;
+		IF typ = DevCPT.undftyp THEN DevCPM.err(58)
+		ELSIF typ.size = -1 THEN
+			f := typ.form; c := typ.comp; btyp := typ.BaseTyp;
+			IF c = Record THEN
+				IF btyp = NIL THEN offset := 0; align := 1;
+				ELSE GTypeSize(btyp, guarded); offset := btyp.size; align := btyp.align
+				END ;
+				IF typ.sysflag = noAlign THEN alignLimit := 1
+				ELSIF typ.sysflag = align2 THEN alignLimit := 2
+				ELSIF typ.sysflag = align8 THEN alignLimit := 8
+				ELSE alignLimit := 4
+				END;
+				fld := typ.link;
+				WHILE (fld # NIL) & (fld.mode = Fld) DO
+					btyp := fld.typ; GTypeSize(btyp, guarded);
+					IF typ.sysflag > 0 THEN falign := Base(btyp, alignLimit)
+					ELSIF btyp.size >= 4 THEN falign := 4
+					ELSIF btyp.size >= 2 THEN falign := 2
+					ELSE falign := 1
+					END;
+					IF typ.sysflag = union THEN
+						fld.adr := 0;
+						IF btyp.size > offset THEN offset := btyp.size END;
+					ELSE
+						Align(offset, falign);
+						fld.adr := offset;
+						IF offset <= MAX(INTEGER) - 4 - btyp.size THEN INC(offset, btyp.size)
+						ELSE offset := 4; DevCPM.Mark(214, typ.txtpos)
+						END						
+					END;
+					IF falign > align THEN align := falign END ;
+					fld := fld.link
+				END;
+(*
+				IF (typ.sysflag = interface) & (typ.BaseTyp = NIL) THEN
+					fld := DevCPT.NewObj(); fld.name^ := DevCPM.HdPtrName; fld.mode := Fld;
+					fld.typ := DevCPT.undftyp; fld.adr := 8;
+					fld.right := typ.link; typ.link := fld;
+					fld := DevCPT.NewObj(); fld.name^ := DevCPM.HdPtrName; fld.mode := Fld;
+					fld.typ := DevCPT.undftyp; fld.adr := 12;
+					typ.link.link := fld; typ.link.left := fld;
+					offset := interfaceSize; align := 4
+				END;
+*)
+				IF typ.sysflag <= 0 THEN align := 4 END;
+				typ.align := align;
+				IF (typ.sysflag > 0) OR (offset > 2) THEN Align(offset, align) END;
+				typ.size := offset;
+				typ.n := -1  (* methods not counted yet *)
+			ELSIF c = Array THEN
+				GTypeSize(btyp, guarded);
+				IF (btyp.size = 0) OR (typ.n <= MAX(INTEGER) DIV btyp.size) THEN typ.size := typ.n * btyp.size
+				ELSE typ.size := 4; DevCPM.Mark(214, typ.txtpos)
+				END
+			ELSIF f = Pointer THEN
+				typ.size := DevCPM.PointerSize;
+				IF guarded & ~typ.untagged THEN DevCPM.Mark(143, typ.txtpos) END
+			ELSIF f = ProcTyp THEN
+				typ.size := DevCPM.ProcSize
+			ELSE (* c = DynArr *)
+				GTypeSize(btyp, guarded);
+				IF (typ.sysflag = untagged) OR typ.untagged THEN typ.size := 4
+				ELSE
+					IF btyp.comp = DynArr THEN typ.size := btyp.size + 4
+					ELSE typ.size := 8
+					END
+				END
+			END
+		END
+	END GTypeSize;
+	
+	PROCEDURE TypeSize*(typ: DevCPT.Struct);	(* also called from DevCPT.InStruct for arrays *)
+	BEGIN
+		GTypeSize(typ, FALSE)
+	END TypeSize;
+	
+	PROCEDURE GetComKernel;
+		VAR name: DevCPT.Name; mod: DevCPT.Object;
+	BEGIN
+		IF addRef = NIL THEN
+			DevCPT.OpenScope(SHORT(SHORT(-DevCPT.nofGmod)), NIL);
+			DevCPT.topScope.name := DevCPT.NewName("$$");
+			name := "AddRef"; DevCPT.Insert(name, addRef);
+			addRef.mode := XProc;
+			addRef.fprint := addRefFP;
+			addRef.fpdone := TRUE;
+			name := "Release"; DevCPT.Insert(name, release);
+			release.mode := XProc;
+			release.fprint := addRefFP;
+			release.fpdone := TRUE;
+			name := "Release2"; DevCPT.Insert(name, release2);
+			release2.mode := XProc;
+			release2.fprint := addRefFP;
+			release2.fpdone := TRUE;
+			name := "InterfaceTrapHandler"; DevCPT.Insert(name, DevCPC486.intHandler);
+			DevCPC486.intHandler.mode := XProc;
+			DevCPC486.intHandler.fprint := intHandlerFP;
+			DevCPC486.intHandler.fpdone := TRUE;
+			DevCPT.GlbMod[DevCPT.nofGmod] := DevCPT.topScope;
+			INC(DevCPT.nofGmod);
+			DevCPT.CloseScope;
+		END
+	END GetComKernel;
+
+	PROCEDURE EnumTProcs(rec: DevCPT.Struct);	(* method numbers in declaration order *)
+		VAR btyp: DevCPT.Struct; obj, redef: DevCPT.Object;
+	BEGIN
+		IF rec.n = -1 THEN
+			rec.n := 0; btyp := rec.BaseTyp;
+			IF btyp # NIL THEN
+				EnumTProcs(btyp); rec.n := btyp.n;
+			END;
+			obj := rec.strobj.link;
+			WHILE obj # NIL DO
+				DevCPT.FindBaseField(obj.name^, rec, redef);
+				IF redef # NIL THEN obj.num := redef.num (*mthno*);
+					IF ~(isRedef IN obj.conval.setval) OR (redef.conval.setval * {extAttr, absAttr, empAttr} = {}) THEN
+						DevCPM.Mark(119, rec.txtpos)
+					END
+				ELSE obj.num := rec.n; INC(rec.n)
+				END ;
+				IF obj.conval.setval * {hasBody, absAttr, empAttr} = {} THEN DevCPM.Mark(129, obj.adr) END;
+				obj := obj.nlink
+			END
+		END
+	END EnumTProcs;
+
+	PROCEDURE CountTProcs(rec: DevCPT.Struct);
+		VAR btyp: DevCPT.Struct; comProc: INTEGER; m, rel: DevCPT.Object; name: DevCPT.Name;
+
+		PROCEDURE TProcs(obj: DevCPT.Object);	(* obj.mnolev = 0, TProcs of base type already counted *)
+			VAR redef: DevCPT.Object;
+		BEGIN
+			IF obj # NIL THEN
+				TProcs(obj.left);
+				IF obj.mode = TProc THEN
+					DevCPT.FindBaseField(obj.name^, rec, redef);
+					(* obj.adr := 0 *)
+					IF redef # NIL THEN
+						obj.num := redef.num (*mthno*);
+						IF (redef.link # NIL) & (redef.link.typ.sysflag = interface) THEN
+							obj.num := numPreIntProc + comProc - 1 - obj.num
+						END;
+						IF ~(isRedef IN obj.conval.setval) OR (redef.conval.setval * {extAttr, absAttr, empAttr} = {}) THEN
+							DevCPM.Mark(119, rec.txtpos)
+						END
+					ELSE obj.num := rec.n; INC(rec.n)
+					END ;
+					IF obj.conval.setval * {hasBody, absAttr, empAttr} = {} THEN DevCPM.Mark(129, obj.adr) END
+				END ;
+				TProcs(obj.right)
+			END
+		END TProcs;
+
+	BEGIN
+		IF rec.n = -1 THEN
+			comProc := 0;
+			IF rec.untagged THEN rec.n := 0 ELSE rec.n := DevCPT.anytyp.n END;
+			btyp := rec.BaseTyp;
+			IF btyp # NIL THEN
+				IF btyp.sysflag = interface THEN
+					EnumTProcs(btyp); rec.n := btyp.n + numPreIntProc; comProc := btyp.n;
+				ELSE
+					CountTProcs(btyp); rec.n := btyp.n
+				END
+			END;
+			WHILE (btyp # NIL) & (btyp # DevCPT.undftyp) & (btyp.sysflag # interface) DO btyp := btyp.BaseTyp END;
+			IF (btyp # NIL) & (btyp.sysflag = interface) THEN
+				IF comProc > 0 THEN
+					name := "QueryInterface"; DevCPT.FindField(name, rec, m);
+					IF m.link.typ.sysflag = interface THEN
+						DevCPT.InsertField(name, rec, m); m.mode := TProc; m.typ := rec;
+						m.conval := DevCPT.NewConst(); m.conval.setval := {isRedef, hasBody, isCallback, extAttr};
+						m.nlink := query; query := m
+					END;
+					name := "AddRef";
+					DevCPT.InsertField(name, rec, m); m.mode := TProc; m.mnolev := 0;
+					m.conval := DevCPT.NewConst(); m.conval.setval := {isRedef, hasBody, isCallback, isHidden, extAttr};
+					GetComKernel; addRef.used := TRUE; m.adr := -1; m.nlink := addRef;
+				END;
+				name := "RELEASE";
+				DevCPT.FindField(name, rec, rel);
+				IF (rel # NIL) & (rel.link.typ = DevCPT.anyptrtyp) THEN rel := NIL END;
+				IF (comProc > 0) OR (rel # NIL) THEN
+					name := "Release";
+					DevCPT.InsertField(name, rec, m); m.mode := TProc; m.mnolev := 0;
+					m.conval := DevCPT.NewConst(); m.conval.setval := {isRedef, hasBody, isCallback, isHidden, extAttr};
+					GetComKernel; m.adr := -1;
+					IF rel # NIL THEN release2.used := TRUE; m.nlink := release2
+					ELSE release.used := TRUE; m.nlink := release
+					END
+				END
+			END;
+			TProcs(rec.link);
+		END
+	END CountTProcs;
+	
+	PROCEDURE ^Parameters(firstPar, proc: DevCPT.Object);
+
+	PROCEDURE ^TProcedures(obj: DevCPT.Object);
+
+	PROCEDURE TypeAlloc(typ: DevCPT.Struct);
+		VAR f, c: SHORTINT; fld: DevCPT.Object; btyp: DevCPT.Struct;
+	BEGIN
+		IF ~typ.allocated THEN	(* not imported, not predefined, not allocated yet *)
+			typ.allocated := TRUE;
+			TypeSize(typ);
+			f := typ.form; c := typ.comp; btyp := typ.BaseTyp;
+			IF c = Record THEN
+				IF typ.sysflag = interface THEN
+					EnumTProcs(typ);
+				ELSE
+					CountTProcs(typ)
+				END;
+				IF typ.extlev > 14 THEN DevCPM.Mark(233, typ.txtpos) END;
+				IF btyp # NIL THEN TypeAlloc(btyp) END;
+				IF ~typ.untagged THEN DevCPE.AllocTypDesc(typ) END;
+				fld := typ.link;
+				WHILE (fld # NIL) & (fld.mode = Fld) DO
+					TypeAlloc(fld.typ); fld := fld.link
+				END;
+				TProcedures(typ.link)
+			ELSIF f = Pointer THEN
+				IF btyp = DevCPT.undftyp THEN DevCPM.Mark(128, typ.txtpos)
+				ELSE TypeAlloc(btyp);
+				END
+			ELSIF f = ProcTyp THEN
+				TypeAlloc(btyp);
+				Parameters(typ.link, NIL)
+			ELSE (* c IN {Array, DynArr} *) 
+				TypeAlloc(btyp);
+				IF (btyp.comp = DynArr) & btyp.untagged & ~typ.untagged THEN DevCPM.Mark(225, typ.txtpos) END;
+			END
+		END
+	END TypeAlloc;
+
+	PROCEDURE NumOfIntProc (typ: DevCPT.Struct): INTEGER;
+	BEGIN
+		WHILE (typ # NIL) & (typ.sysflag # interface) DO typ := typ.BaseTyp END;
+		IF typ # NIL THEN RETURN typ.n
+		ELSE RETURN 0
+		END
+	END NumOfIntProc;
+	
+	PROCEDURE Parameters(firstPar, proc: DevCPT.Object);
+	(* firstPar.mnolev = 0 *)
+		VAR par: DevCPT.Object; typ: DevCPT.Struct; padr, vadr: INTEGER;
+	BEGIN
+		padr := ParOff; par := firstPar;
+		WHILE par # NIL DO
+			typ := par.typ; TypeAlloc(typ);
+			par.adr := padr;
+			IF (par.mode = VarPar) & (typ.comp # DynArr) THEN
+				IF (typ.comp = Record) & ~typ.untagged THEN INC(padr, 8)
+				ELSE INC(padr, 4)
+				END
+			ELSE
+				IF (par.mode = Var) & (typ.comp = DynArr) & typ.untagged THEN DevCPM.err(145) END;
+				INC(padr, typ.size); Align(padr, 4)
+			END;
+			par := par.link
+		END;
+		IF proc # NIL THEN
+			IF proc.mode = XProc THEN
+				INCL(proc.conval.setval, isCallback)
+			ELSIF (proc.mode = TProc)
+				& (proc.num >= numPreIntProc)
+				& (proc.num < numPreIntProc + NumOfIntProc(proc.link.typ))
+			THEN
+				INCL(proc.conval.setval, isCallback);
+				INCL(proc.conval.setval, isGuarded)
+			END;
+			IF proc.sysflag = guarded THEN INCL(proc.conval.setval, isGuarded) END;
+			IF isGuarded IN proc.conval.setval THEN
+				GetComKernel; vadr := -24
+			ELSE
+				vadr := 0;
+				IF imVar IN proc.conval.setval THEN DEC(vadr, 4) END;
+				IF isCallback IN proc.conval.setval THEN DEC(vadr, 8) END
+			END;
+			proc.conval.intval := padr; proc.conval.intval2 := vadr;
+		END
+	END Parameters;
+	
+	PROCEDURE Variables(var: DevCPT.Object; VAR varSize: INTEGER);
+	(* allocates only offsets, regs allocated in DevCPC486.Enter *)
+		VAR adr: INTEGER; typ: DevCPT.Struct;
+	BEGIN
+		adr := varSize;
+		WHILE var # NIL DO
+			typ := var.typ; TypeAlloc(typ);
+			DEC(adr, typ.size); NegAlign(adr, Base(typ, 4));
+			var.adr := adr;
+			var := var.link
+		END;
+		NegAlign(adr, 4); varSize := adr
+	END Variables;
+	
+	PROCEDURE ^Objects(obj: DevCPT.Object);
+
+	PROCEDURE Procedure(obj: DevCPT.Object);
+	(* obj.mnolev = 0 *)
+		VAR oldPos: INTEGER;
+	BEGIN
+		oldPos := DevCPM.errpos; DevCPM.errpos := obj.scope.adr;
+		TypeAlloc(obj.typ);
+		Parameters(obj.link, obj);
+		IF ~(hasBody IN obj.conval.setval) THEN DevCPM.Mark(129, obj.adr) END ;
+		Variables(obj.scope.scope, obj.conval.intval2);	(* local variables *)
+		Objects(obj.scope.right);
+		DevCPM.errpos := oldPos
+	END Procedure;
+
+	PROCEDURE TProcedures(obj: DevCPT.Object);
+	(* obj.mnolev = 0 *)
+		VAR par: DevCPT.Object; psize: INTEGER;
+	BEGIN
+		IF obj # NIL THEN
+			TProcedures(obj.left);
+			IF (obj.mode = TProc) & (obj.scope # NIL) THEN
+				TypeAlloc(obj.typ);
+				Parameters(obj.link, obj);
+				Variables(obj.scope.scope, obj.conval.intval2);	(* local variables *)
+				Objects(obj.scope.right);
+			END ;
+			TProcedures(obj.right)
+		END
+	END TProcedures;
+
+	PROCEDURE Objects(obj: DevCPT.Object);
+	BEGIN
+		IF obj # NIL THEN
+			Objects(obj.left);
+			IF obj.mode IN {Con, Typ, LProc, XProc, CProc, IProc} THEN
+				IF (obj.mode IN {Con, Typ}) THEN TypeAlloc(obj.typ);
+				ELSE Procedure(obj)
+				END
+			END ;
+			Objects(obj.right)
+		END
+	END Objects;
+
+	PROCEDURE Allocate*;
+		VAR gvarSize: INTEGER; name: DevCPT.Name;
+	BEGIN
+		DevCPM.errpos := DevCPT.topScope.adr;	(* text position of scope used if error *)
+		gvarSize := 0;
+		Variables(DevCPT.topScope.scope, gvarSize); DevCPE.dsize := -gvarSize;
+		Objects(DevCPT.topScope.right)
+	END Allocate;
+	
+	(************************)
+
+	PROCEDURE SameExp (n1, n2: DevCPT.Node): BOOLEAN;
+	BEGIN
+		WHILE (n1.class = n2.class) & (n1.typ = n2.typ) DO
+			CASE n1.class OF
+			| Nvar, Nvarpar, Nproc: RETURN n1.obj = n2.obj
+			| Nconst: RETURN (n1.typ.form IN {Int8..Int32}) & (n1.conval.intval = n2.conval.intval)
+			| Nfield: IF n1.obj # n2.obj THEN RETURN FALSE END
+			| Nderef, Nguard:
+			| Nindex: IF ~SameExp(n1.right, n2.right) THEN RETURN FALSE END
+			| Nmop: IF (n1.subcl # n2.subcl) OR (n1.subcl = is) THEN RETURN FALSE END
+			| Ndop: IF (n1.subcl # n2.subcl) OR ~SameExp(n1.right, n2.right) THEN RETURN FALSE END
+			ELSE RETURN FALSE
+			END ;
+			n1 := n1.left; n2 := n2.left
+		END;
+		RETURN FALSE
+	END SameExp;
+	
+	PROCEDURE Check (n: DevCPT.Node; VAR used: SET; VAR size: INTEGER);
+		VAR ux, uy: SET; sx, sy, sf: INTEGER; f: BYTE;
+	BEGIN
+		used := {}; size := 0;
+		WHILE n # NIL DO
+			IF n.class # Ncomp THEN
+				Check(n.left, ux, sx);
+				Check(n.right, uy, sy)
+			END;
+			ux := ux + uy; sf := 0;
+			CASE n.class OF
+			| Nvar, Nvarpar:
+					IF (n.class = Nvarpar) OR  (n.typ.comp = DynArr) OR
+						(n.obj.mnolev > 0) &
+						(DevCPC486.imLevel[n.obj.mnolev] < DevCPC486.imLevel[DevCPL486.level]) THEN sf := 1 END
+			| Nguard: sf := 2
+			| Neguard, Nderef: sf := 1
+			| Nindex:
+					IF (n.right.class # Nconst) OR (n.left.typ.comp = DynArr) THEN sf := 1 END;
+					IF sx > 0 THEN INC(sy) END
+			| Nmop:
+					CASE n.subcl OF
+					| is, adr, typfn, minus, abs, cap, val: sf := 1
+					| bit: sf := 2; INCL(ux, CX)
+					| conv:
+							IF n.typ.form = Int64 THEN sf := 2
+							ELSIF ~(n.typ.form IN realSet) THEN sf := 1;
+								IF n.left.typ.form IN realSet THEN INCL(ux, AX) END
+							END
+					| odd, cc, not:
+					END
+			| Ndop:
+					f := n.left.typ.form;
+					IF f # Bool THEN
+						CASE n.subcl OF
+						| times:
+								sf := 1;
+								IF f = Int8 THEN INCL(ux, AX) END
+						| div, mod:
+								sf := 3; INCL(ux, AX);
+								IF f > Int8 THEN INCL(ux, DX) END
+						| eql..geq:
+								IF f IN {String8, String16, Comp} THEN ux := ux + {AX, CX, SI, DI}; sf := 4
+								ELSIF f IN realSet THEN INCL(ux, AX); sf := 1
+								ELSE sf := 1
+								END
+						| ash, lsh, rot:
+								IF n.right.class = Nconst THEN sf := 1 ELSE sf := 2; INCL(ux, CX) END
+						| slash, plus, minus, msk, in, bit:
+								sf := 1
+						| len:
+								IF f IN {String8, String16} THEN ux := ux + {AX, CX, DI}; sf := 3
+								ELSE sf := 1
+								END
+						| min, max:
+								sf := 1;
+								IF f IN realSet THEN INCL(ux, AX) END
+						| queryfn:
+								ux := ux + {CX, SI, DI}; sf := 4
+						END;
+						IF sy > sx THEN INC(sx) ELSE INC(sy) END
+					END
+			| Nupto:
+					IF (n.right.class = Nconst) OR (n.left.class = Nconst) THEN sf := 2
+					ELSE sf := 3
+					END;
+					INCL(ux, CX); INC(sx)
+			| Ncall, Ncomp:
+					sf := 10; ux := wreg + {float}
+			| Nfield, Nconst, Nproc, Ntype:
+			END;
+			used := used + ux;
+			IF sx > size THEN size := sx END;
+			IF sy > size THEN size := sy END;
+			IF sf > size THEN size := sf END;
+			n := n.link
+		END;
+		IF size > 10 THEN size := 10 END
+	END Check;
+	
+	PROCEDURE^ expr (n: DevCPT.Node; VAR x: DevCPL486.Item; hint, stop: SET);
+	
+	PROCEDURE DualExp (left, right: DevCPT.Node; VAR x, y: DevCPL486.Item; hx, hy, stpx, stpy: SET);
+		VAR ux, uy: SET; sx, sy: INTEGER;
+	BEGIN
+		Check(left, ux, sx); Check(right, uy, sy);
+		IF sy > sx THEN
+			expr(right, y, hy + stpy, ux + stpy * {AX, CX});
+			expr(left, x, hx, stpx);
+			DevCPC486.Assert(y, hy, stpy)
+		ELSE
+			expr(left, x, hx + stpx, uy);
+			expr(right, y, hy, stpy);
+			DevCPC486.Assert(x, hx, stpx)
+		END;
+	END DualExp;
+
+	PROCEDURE IntDOp (n: DevCPT.Node; VAR x: DevCPL486.Item; hint: SET);
+		VAR y: DevCPL486.Item; rev: BOOLEAN;
+	BEGIN
+		DualExp(n.left, n.right, x, y, hint, hint, {stk}, {stk});
+		IF (x.mode = Reg) & DevCPC486.Fits(x, hint) THEN
+			DevCPC486.IntDOp(x, y, n.subcl, FALSE)
+		ELSIF (y.mode = Reg) & DevCPC486.Fits(y, hint) THEN
+			DevCPC486.IntDOp(y, x, n.subcl, TRUE); x := y
+		ELSIF x.mode # Reg THEN
+			DevCPC486.Load(x, hint, {con}); DevCPC486.IntDOp(x, y, n.subcl, FALSE)
+		ELSIF y.mode # Reg THEN
+			DevCPC486.Load(y, hint, {con}); DevCPC486.IntDOp(y, x, n.subcl, TRUE); x := y
+		ELSE
+			DevCPC486.IntDOp(x, y, n.subcl, FALSE)
+		END
+	END IntDOp;
+	
+	PROCEDURE FloatDOp (n: DevCPT.Node; VAR x: DevCPL486.Item);
+		VAR y: DevCPL486.Item; ux, uy, uf: SET; sx, sy: INTEGER;
+	BEGIN
+		Check(n.left, ux, sx); Check(n.right, uy, sy);
+		IF (n.subcl = min) OR (n.subcl = max) THEN uf := {AX} ELSE uf := {} END;
+		IF (sy > sx) OR (sy = sx) & ((n.subcl = mod) OR (n.subcl = ash)) THEN
+			expr(n.right, x, {}, ux + {mem, stk});
+			expr(n.left, y, {}, uf);
+			DevCPC486.FloatDOp(x, y, n.subcl, TRUE)
+		ELSIF float IN uy THEN (* function calls in both operands *)
+			expr(n.left, y, {}, uy + {mem});
+			expr(n.right, x, {}, {mem, stk});
+			DevCPC486.FloatDOp(x, y, n.subcl, TRUE)
+		ELSE
+			expr(n.left, x, {}, uy + {mem, stk});
+			expr(n.right, y, {}, uf);
+			DevCPC486.FloatDOp(x, y, n.subcl, FALSE)
+		END
+	END FloatDOp;
+	
+	PROCEDURE design (n: DevCPT.Node; VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR obj: DevCPT.Object; y: DevCPL486.Item; ux, uy: SET; sx, sy: INTEGER;
+	BEGIN
+		CASE n.class OF
+		  Nvar, Nvarpar:
+				obj := n.obj; x.mode := obj.mode; x.obj := obj; x.scale := 0;
+				IF obj.typ.comp = DynArr THEN x.mode := VarPar END;
+				IF obj.mnolev < 0 THEN x.offset := 0; x.tmode := Con
+				ELSIF x.mode = Var THEN x.offset := obj.adr; x.tmode := Con
+				ELSE x.offset := 0; x.tmode := VarPar
+				END
+		| Nfield:
+				design(n.left, x, hint, stop); DevCPC486.Field(x, n.obj)
+		| Nderef:
+				IF n.subcl # 0 THEN
+					expr(n.left, x, hint, stop);
+					IF n.typ.form = String8 THEN x.form := VString8 ELSE x.form := VString16 END
+				ELSE
+					expr(n.left, x, hint, stop + {mem} - {loaded}); DevCPC486.DeRef(x)
+				END
+		| Nindex:
+				Check(n.left, ux, sx); Check(n.right, uy, sy);
+				IF wreg - uy = {} THEN
+					expr(n.right, y, hint + stop, ux);
+					design(n.left, x, hint, stop);
+					IF x.scale # 0 THEN DevCPC486.Index(x, y, {}, {}) ELSE DevCPC486.Index(x, y, hint, stop) END
+				ELSE
+					design(n.left, x, hint, stop + uy);
+					IF x.scale # 0 THEN expr(n.right, y, {}, {}); DevCPC486.Index(x, y, {}, {})
+					ELSE expr(n.right, y, hint, stop); DevCPC486.Index(x, y, hint, stop)
+					END
+				END
+		| Nguard, Neguard:
+				IF n.typ.form = Pointer THEN
+					IF loaded IN stop THEN expr(n.left, x, hint, stop) ELSE expr(n.left, x, hint, stop + {mem}) END
+				ELSE design(n.left, x, hint, stop)
+				END;
+				DevCPC486.TypTest(x, n.typ, TRUE, n.class = Neguard)
+		| Nproc:
+				obj := n.obj; x.mode := obj.mode; x.obj := obj;
+				IF x.mode = TProc THEN x.offset := obj.num; (*mthno*) x.scale := n.subcl (* super *) END
+		END;
+		x.typ := n.typ
+	END design;
+	
+	PROCEDURE IsAllocDynArr (x: DevCPT.Node): BOOLEAN;
+	BEGIN
+		IF (x.typ.comp = DynArr) & ~x.typ.untagged THEN
+			WHILE x.class = Nindex DO x := x.left END;
+			IF x.class = Nderef THEN RETURN TRUE END
+		END;
+		RETURN FALSE
+	END IsAllocDynArr;
+	
+	PROCEDURE StringOp (left, right: DevCPT.Node; VAR x, y: DevCPL486.Item; useLen: BOOLEAN);
+		VAR ax, ay: DevCPL486.Item; ux: SET; sx: INTEGER;
+	BEGIN
+		Check(left, ux, sx);
+		expr(right, y, wreg - {SI} + ux, {});
+		ay := y; DevCPC486.GetAdr(ay, wreg - {SI} + ux, {}); DevCPC486.Assert(ay, wreg - {SI}, ux);
+		IF useLen & IsAllocDynArr(left) THEN	(* keep len descriptor *)
+			design(left, x, wreg - {CX}, {loaded});
+			DevCPC486.Prepare(x, wreg - {CX} + {deref}, {DI})
+		ELSE
+			expr(left, x, wreg - {DI}, {})
+		END;
+		ax := x; DevCPC486.GetAdr(ax, {}, wreg - {DI} + {stk, con});
+		DevCPC486.Load(ay, {}, wreg - {SI} + {con});
+		DevCPC486.Free(ax); DevCPC486.Free(ay)
+	END StringOp;
+	
+	PROCEDURE AdrExpr (n: DevCPT.Node; VAR x: DevCPL486.Item; hint, stop: SET);
+	BEGIN
+		IF n.class < Nconst THEN
+			design(n, x, hint + stop, {loaded}); DevCPC486.Prepare(x, hint + {deref}, stop)
+		ELSE expr(n, x, hint, stop)
+		END
+	END AdrExpr;
+	
+	(* ---------- interface pointer reference counting ---------- *)
+	
+	PROCEDURE HandleIPtrs (typ: DevCPT.Struct; VAR x, y: DevCPL486.Item; add, rel, init: BOOLEAN);
+	
+		PROCEDURE FindPtrs (typ: DevCPT.Struct; adr: INTEGER);
+			VAR fld: DevCPT.Object; btyp: DevCPT.Struct; i, n: INTEGER;
+		BEGIN
+			IF (typ.form = Pointer) & (typ.sysflag = interface) THEN
+				IF add THEN DevCPC486.IPAddRef(y, adr, TRUE) END;
+				IF rel THEN DevCPC486.IPRelease(x, adr, TRUE, init) END
+			ELSIF (typ.comp = Record) & (typ.sysflag # union) THEN
+				btyp := typ.BaseTyp;
+				IF btyp # NIL THEN FindPtrs(btyp, adr) END ;
+				fld := typ.link;
+				WHILE (fld # NIL) & (fld.mode = Fld) DO
+					IF (fld.sysflag = interface) & (fld.name^ = DevCPM.HdUtPtrName) THEN
+						IF add THEN DevCPC486.IPAddRef(y, fld.adr + adr, TRUE) END;
+						IF rel THEN DevCPC486.IPRelease(x, fld.adr + adr, TRUE, init) END
+					ELSE FindPtrs(fld.typ, fld.adr + adr)
+					END;
+					fld := fld.link
+				END
+			ELSIF typ.comp = Array THEN
+				btyp := typ.BaseTyp; n := typ.n;
+				WHILE btyp.comp = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END ;
+				IF DevCPC486.ContainsIPtrs(btyp) THEN
+					i := 0;
+					WHILE i < n DO FindPtrs(btyp, adr); INC(adr, btyp.size); INC(i) END
+				END
+			ELSIF typ.comp = DynArr THEN 
+				IF DevCPC486.ContainsIPtrs(typ) THEN DevCPM.err(221) END
+			END
+		END FindPtrs;
+	
+	BEGIN
+		FindPtrs(typ, 0)
+	END HandleIPtrs;
+	
+	PROCEDURE CountedPtr (n: DevCPT.Node): BOOLEAN;
+	BEGIN
+		RETURN (n.typ.form = Pointer) & (n.typ.sysflag = interface)
+			& ((n.class = Ncall) OR (n.class = Ncomp) & (n.right.class = Ncall))
+	END CountedPtr;
+	
+	PROCEDURE IPAssign (nx, ny: DevCPT.Node; VAR x, y: DevCPL486.Item; ux: SET);
+		(* nx.typ.form = Pointer & nx.typ.sysflag = interface *)
+	BEGIN
+		expr(ny, y, {}, wreg - {SI} + {mem, stk});
+		IF (ny.class # Nconst) & ~CountedPtr(ny) THEN
+			DevCPC486.IPAddRef(y, 0, TRUE)
+		END;
+		IF nx # NIL THEN
+			DevCPC486.Assert(y, {}, wreg - {SI} + ux);
+			expr(nx, x, wreg - {DI}, {loaded});
+			IF (x.mode = Ind) & (x.reg IN wreg - {SI, DI}) OR (x.scale # 0) THEN
+				DevCPC486.GetAdr(x, {}, wreg - {DI} + {con});
+				x.mode := Ind; x.offset := 0; x.scale := 0
+			END;
+			DevCPC486.IPRelease(x, 0, TRUE, FALSE);
+		END
+	END IPAssign;
+	
+	PROCEDURE IPStructAssign (typ: DevCPT.Struct);
+		VAR x, y: DevCPL486.Item;
+	BEGIN
+		IF typ.comp = DynArr THEN DevCPM.err(270) END;
+		(* addresses in SI and DI *)
+		x.mode := Ind; x.reg := DI; x.offset := 0; x.scale := 0;
+		y.mode := Ind; y.reg := SI; y.offset := 0; y.scale := 0;
+		HandleIPtrs(typ, x, y, TRUE, TRUE, FALSE)
+	END IPStructAssign;
+
+	PROCEDURE IPFree (nx: DevCPT.Node; VAR x: DevCPL486.Item);
+	BEGIN
+		expr(nx, x, wreg - {DI}, {loaded}); DevCPC486.GetAdr(x, {}, wreg - {DI} + {con});
+		x.mode := Ind; x.offset := 0; x.scale := 0;
+		IF nx.typ.form = Comp THEN
+			HandleIPtrs(nx.typ, x, x, FALSE, TRUE, TRUE)
+		ELSE	(* nx.typ.form = Pointer & nx.typ.sysflag = interface *)
+			DevCPC486.IPRelease(x, 0, TRUE, TRUE);
+		END
+	END IPFree;
+	
+	(* unchanged val parameters allways counted because of aliasing problems REMOVED! *)
+	
+	PROCEDURE InitializeIPVars (proc: DevCPT.Object);
+		VAR x: DevCPL486.Item; obj: DevCPT.Object;
+	BEGIN
+		x.mode := Ind; x.reg := BP; x.scale := 0; x.form := Pointer;
+		obj := proc.link;
+		WHILE obj # NIL DO
+			IF (obj.mode = Var) & obj.used THEN	(* changed value parameters *)
+				x.offset := obj.adr;
+				HandleIPtrs(obj.typ, x, x, TRUE, FALSE, FALSE)
+			END;
+			obj := obj.link
+		END
+	END InitializeIPVars;
+	
+	PROCEDURE ReleaseIPVars (proc: DevCPT.Object);
+		VAR x, ax, dx, si, di: DevCPL486.Item; obj: DevCPT.Object;
+	BEGIN
+		obj := proc.link;
+		WHILE (obj # NIL) & ((obj.mode # Var) OR ~obj.used OR ~DevCPC486.ContainsIPtrs(obj.typ)) DO
+			obj := obj.link
+		END;
+		IF obj = NIL THEN
+			obj := proc.scope.scope;
+			WHILE (obj # NIL) & ~DevCPC486.ContainsIPtrs(obj.typ) DO obj := obj.link END;
+			IF obj = NIL THEN RETURN END
+		END;
+		DevCPL486.MakeReg(ax, AX, Int32); DevCPL486.MakeReg(si, SI, Int32);
+		DevCPL486.MakeReg(dx, DX, Int32); DevCPL486.MakeReg(di, DI, Int32);
+		IF ~(proc.typ.form IN {Real32, Real64, NoTyp}) THEN DevCPL486.GenMove(ax, si) END;
+		IF proc.typ.form = Int64 THEN DevCPL486.GenMove(dx, di) END;
+		x.mode := Ind; x.reg := BP; x.scale := 0; x.form := Pointer;
+		obj := proc.link;
+		WHILE obj # NIL DO
+			IF (obj.mode = Var) & obj.used THEN	(* value parameters *)
+				x.offset := obj.adr;
+				HandleIPtrs(obj.typ, x, x, FALSE, TRUE, FALSE)
+			END;
+			obj := obj.link
+		END;
+		obj := proc.scope.scope;
+		WHILE obj # NIL DO	(* local variables *)
+			IF obj.used THEN
+				x.offset := obj.adr;
+				HandleIPtrs(obj.typ, x, x, FALSE, TRUE, FALSE);
+			END;
+			obj := obj.link
+		END;
+		IF ~(proc.typ.form IN {Real32, Real64, NoTyp}) THEN DevCPL486.GenMove(si, ax) END;
+		IF proc.typ.form = Int64 THEN DevCPL486.GenMove(di, dx) END
+	END ReleaseIPVars;
+	
+	PROCEDURE CompareIntTypes (
+		typ: DevCPT.Struct; VAR id: DevCPL486.Item; VAR exit: DevCPL486.Label; VAR num: INTEGER
+	);
+		VAR x, y: DevCPL486.Item; local: DevCPL486.Label;
+	BEGIN
+		local := DevCPL486.NewLbl;
+		typ := typ.BaseTyp; num := 0;
+		WHILE (typ # NIL) & (typ # DevCPT.undftyp) DO
+			IF (typ.sysflag = interface) & (typ.ext # NIL) THEN
+				IF num > 0 THEN DevCPC486.JumpT(x, local) END;
+				DevCPC486.GuidFromString(typ.ext, y);
+				x := id; DevCPC486.GetAdr(x, wreg - {SI}, {mem});
+				x := y; DevCPC486.GetAdr(x, wreg - {DI}, {});
+				x := id; DevCPC486.CmpString(x, y, eql, FALSE);
+				INC(num)
+			END;
+			typ := typ.BaseTyp
+		END;
+		IF num > 0 THEN DevCPC486.JumpF(x, exit) END;
+		IF num > 1 THEN DevCPL486.SetLabel(local) END
+	END CompareIntTypes;
+	
+	PROCEDURE InstallQueryInterface (typ: DevCPT.Struct; proc: DevCPT.Object);
+		VAR this, id, int, unk, c: DevCPL486.Item; nil, end: DevCPL486.Label; num: INTEGER;
+	BEGIN
+		nil := DevCPL486.NewLbl; end := DevCPL486.NewLbl;
+		this.mode := Ind; this.reg := BP; this.offset := 8; this.scale := 0; this.form := Pointer; this.typ := DevCPT.anyptrtyp;
+		id.mode := DInd; id.reg := BP; id.offset := 12; id.scale := 0; id.form := Pointer;
+		int.mode := DInd; int.reg := BP; int.offset := 16; int.scale := 0; int.form := Pointer;
+		DevCPC486.GetAdr(int, {}, {AX, CX, SI, DI, mem}); int.mode := Ind; int.offset := 0;
+		DevCPL486.MakeConst(c, 0, Pointer); DevCPC486.Assign(int, c);
+		unk.mode := Ind; unk.reg := BP; unk.offset := 8; unk.scale := 0; unk.form := Pointer; unk.typ := DevCPT.punktyp;
+		DevCPC486.Load(unk, {}, {});
+		unk.mode := Ind; unk.offset := 8;
+		DevCPC486.Load(unk, {}, {});
+		DevCPL486.GenComp(c, unk);
+		DevCPL486.GenJump(4, nil, TRUE);
+		DevCPL486.MakeReg(c, int.reg, Pointer);
+		DevCPL486.GenPush(c);
+		c.mode := Ind; c.reg := BP; c.offset := 12; c.scale := 0; c.form := Pointer;
+		DevCPL486.GenPush(c);
+		DevCPL486.GenPush(unk);
+		c.mode := Ind; c.reg := unk.reg; c.offset := 0; c.scale := 0; c.form := Pointer;
+		DevCPL486.GenMove(c, unk);
+		unk.mode := Ind; unk.offset := 0; unk.scale := 0; unk.form := Pointer;
+		DevCPL486.GenCall(unk);
+		DevCPC486.Free(unk);
+		DevCPL486.GenJump(-1, end, FALSE);
+		DevCPL486.SetLabel(nil);
+		DevCPL486.MakeConst(c, 80004002H, Int32);	(* E_NOINTERFACE *)
+		DevCPC486.Result(proc, c);
+		CompareIntTypes(typ, id, end, num);
+		IF num > 0 THEN
+			DevCPC486.Load(this, {}, {});
+			DevCPC486.Assign(int, this);
+			DevCPC486.IPAddRef(this, 0, FALSE);
+			DevCPL486.MakeConst(c, 0, Int32);	(* S_OK *)
+			DevCPC486.Result(proc, c);
+		END;
+		DevCPL486.SetLabel(end)
+	END InstallQueryInterface;
+
+	(* -------------------- *)
+
+	PROCEDURE ActualPar (n: DevCPT.Node; fp: DevCPT.Object; rec: BOOLEAN; VAR tag: DevCPL486.Item);
+		VAR ap: DevCPL486.Item; x: DevCPT.Node; niltest: BOOLEAN;
+	BEGIN
+		IF n # NIL THEN
+			ActualPar(n.link, fp.link, FALSE, ap);
+			niltest := FALSE;
+			IF fp.mode = VarPar THEN
+				IF (n.class = Ndop) & ((n.subcl = thisarrfn) OR (n.subcl = thisrecfn)) THEN
+					expr(n.right, ap, {}, {}); DevCPC486.Push(ap);	(* push type/length *)
+					expr(n.left, ap, {}, {}); DevCPC486.Push(ap);	(* push adr *)
+					RETURN
+				ELSIF (fp.vis = outPar) & DevCPC486.ContainsIPtrs(fp.typ) & (ap.typ # DevCPT.niltyp) THEN
+					IPFree(n, ap)
+				ELSE
+					x := n;
+					WHILE (x.class = Nfield) OR (x.class = Nindex) DO x := x.left END;
+					niltest := x.class = Nderef;	(* explicit nil test needed *)
+					AdrExpr(n, ap, {}, {})
+				END
+			ELSIF (n.class = Nmop) & (n.subcl = conv) THEN
+				IF n.typ.form IN {String8, String16} THEN expr(n, ap, {}, {}); DevCPM.err(265)
+				ELSIF (DevCPT.Includes(n.typ.form, n.left.typ.form) OR DevCPT.Includes(n.typ.form, fp.typ.form))
+					& (n.typ.form # Set) & (fp.typ # DevCPT.bytetyp) THEN expr(n.left, ap, {}, {high});
+				ELSE expr(n, ap, {}, {high});
+				END
+			ELSE expr(n, ap, {}, {high});
+				IF CountedPtr(n) THEN DevCPM.err(270) END
+			END;
+			DevCPC486.Param(fp, rec, niltest, ap, tag)
+		END
+	END ActualPar;
+	
+	PROCEDURE Call (n: DevCPT.Node; VAR x: DevCPL486.Item);
+		VAR tag: DevCPL486.Item; proc: DevCPT.Object; m: BYTE;
+	BEGIN
+		IF n.left.class = Nproc THEN
+			proc := n.left.obj; m := proc.mode;
+		ELSE proc := NIL; m := 0
+		END;
+		IF (m = CProc) & (n.right # NIL) THEN
+			ActualPar(n.right.link, n.obj.link, FALSE, tag);
+			expr(n.right, tag, wreg - {AX}, {});	(* tag = first param *)
+		ELSE
+			IF proc # NIL THEN DevCPC486.PrepCall(proc) END;
+			ActualPar(n.right, n.obj, (m = TProc) & (n.left.subcl = 0), tag);
+		END;
+		IF proc # NIL THEN design(n.left, x, {}, {}) ELSE expr(n.left, x, {}, {}) END;
+		DevCPC486.Call(x, tag)
+	END Call;
+
+	PROCEDURE Mem (n: DevCPT.Node; VAR x: DevCPL486.Item; typ: DevCPT.Struct; hint, stop: SET);
+		VAR offset: INTEGER;
+	BEGIN
+		IF (n.class = Ndop) & (n.subcl IN {plus, minus}) & (n.right.class = Nconst) THEN
+			expr(n.left, x, hint, stop + {mem}); offset := n.right.conval.intval;
+			IF n.subcl = minus THEN offset := -offset END
+		ELSE
+			expr(n, x, hint, stop + {mem}); offset := 0
+		END;
+		DevCPC486.Mem(x, offset, typ)
+	END Mem;
+	
+	PROCEDURE^ CompStat (n: DevCPT.Node);
+	PROCEDURE^ CompRelease (n: DevCPT.Node; VAR res: DevCPL486.Item);
+
+	PROCEDURE condition (n: DevCPT.Node; VAR x: DevCPL486.Item; VAR false, true: DevCPL486.Label);
+		VAR local: DevCPL486.Label; y, z: DevCPL486.Item; ux: SET; sx, num: INTEGER; f: BYTE; typ: DevCPT.Struct;
+	BEGIN
+		IF n.class = Nmop THEN
+			CASE n.subcl OF
+			   not: condition(n.left, x, true, false); DevCPC486.Not(x)
+			| is: IF n.left.typ.form = Pointer THEN expr(n.left, x, {}, {mem})
+					ELSE design(n.left, x, {}, {})
+					END;
+					DevCPC486.TypTest(x, n.obj.typ, FALSE, FALSE)
+			| odd: expr(n.left, x, {}, {}); DevCPC486.Odd(x)
+			| cc: expr(n.left, x, {}, {}); x.mode := Cond; x.form := Bool
+			| val: DevCPM.err(220)
+			END
+		ELSIF n.class = Ndop THEN
+			CASE n.subcl OF
+			   and: local := DevCPL486.NewLbl; condition(n.left, y, false, local);
+					DevCPC486.JumpF(y, false);
+					IF local # DevCPL486.NewLbl THEN DevCPL486.SetLabel(local) END;
+					condition(n.right, x, false, true)
+			| or: local := DevCPL486.NewLbl; condition(n.left, y, local, true);
+					DevCPC486.JumpT(y, true);
+					IF local # DevCPL486.NewLbl THEN DevCPL486.SetLabel(local) END;
+					condition(n.right, x, false, true)
+			| eql..geq:
+					f := n.left.typ.form;
+					IF f = Int64 THEN DevCPM.err(260)
+					ELSIF f IN {String8, String16, Comp} THEN
+						IF (n.left.class = Nmop) & (n.left.subcl = conv) THEN	(* converted must be source *)
+							StringOp(n.right, n.left, x, y, FALSE); DevCPC486.CmpString(x, y, n.subcl, TRUE)
+						ELSE
+							StringOp(n.left, n.right, x, y, FALSE); DevCPC486.CmpString(x, y, n.subcl, FALSE)
+						END
+					ELSIF f IN {Real32, Real64} THEN FloatDOp(n, x)
+					ELSE
+						IF CountedPtr(n.left) OR CountedPtr(n.right) THEN DevCPM.err(270) END;
+						DualExp(n.left, n.right, x, y, {}, {}, {stk}, {stk});
+						IF (x.mode = Reg) OR (y.mode = Con) THEN DevCPC486.IntDOp(x, y, n.subcl, FALSE)
+						ELSIF (y.mode = Reg) OR (x.mode = Con) THEN DevCPC486.IntDOp(y, x, n.subcl, TRUE); x := y
+						ELSE DevCPC486.Load(x, {}, {}); DevCPC486.IntDOp(x, y, n.subcl, FALSE)
+						END 
+					END
+			| in: DualExp(n.left, n.right, x, y, {}, {}, {short, mem, stk}, {con, stk});
+					DevCPC486.In(x, y)
+			| bit: Check(n.left, ux, sx);
+					expr(n.right, x, {}, ux + {short});
+					Mem(n.left, y, DevCPT.notyp, {}, {});
+					DevCPC486.Load(x, {}, {short});
+					DevCPC486.In(x, y)
+			| queryfn:
+					AdrExpr(n.right, x, {}, {CX, SI, DI});
+					CompareIntTypes(n.left.typ, x, false, num);
+					IF num > 0 THEN 
+						Check(n.right.link, ux, sx); IPAssign(n.right.link, n.left, x, y, ux); DevCPC486.Assign(x, y);
+						x.offset := 1	(* true *)
+					ELSE x.offset := 0	(* false *)
+					END;
+					x.mode := Con; DevCPC486.MakeCond(x)
+			END
+		ELSIF n.class = Ncomp THEN
+			CompStat(n.left); condition(n.right, x, false, true); CompRelease(n.left, x);
+			IF x.mode = Stk THEN DevCPL486.GenCode(9DH); (* pop flags *) x.mode := Cond END
+		ELSE expr(n, x, {}, {}); DevCPC486.MakeCond(x)	(* const, var, or call *)
+		END
+	END condition;
+	
+	PROCEDURE expr(n: DevCPT.Node; VAR x: DevCPL486.Item; hint, stop: SET);
+		VAR y, z: DevCPL486.Item; f, g: BYTE; cval: DevCPT.Const; false, true: DevCPL486.Label;
+			uy: SET; sy: INTEGER; r: REAL;
+	BEGIN
+		f := n.typ.form;
+		IF (f = Bool) & (n.class IN {Ndop, Nmop}) THEN
+			false := DevCPL486.NewLbl; true := DevCPL486.NewLbl;
+			condition(n, y, false, true);
+			DevCPC486.LoadCond(x, y, false, true, hint, stop + {mem})
+		ELSE
+			CASE n.class OF
+			   Nconst:
+					IF n.obj = NIL THEN cval := n.conval ELSE cval := n.obj.conval END;
+					CASE f OF
+					   Byte..Int32, NilTyp, Pointer, Char16: DevCPL486.MakeConst(x, cval.intval, f)
+					| Int64:
+						DevCPL486.MakeConst(x, cval.intval, f);
+						DevCPE.GetLongWords(cval, x.scale, x.offset)
+					| Set: DevCPL486.MakeConst(x, SYSTEM.VAL(INTEGER, cval.setval), Set)
+					| String8, String16, Real32, Real64: DevCPL486.AllocConst(x, cval, f)
+					| Comp: 
+						ASSERT(n.typ = DevCPT.guidtyp);
+						IF n.conval # NIL THEN DevCPC486.GuidFromString(n.conval.ext, x)
+						ELSE DevCPC486.GuidFromString(n.obj.typ.ext, x)
+						END
+					END
+			| Nupto:	(* n.typ = DevCPT.settyp *)
+					Check(n.right, uy, sy);
+					expr(n.left, x, {}, wreg - {CX} + {high, mem, stk});
+					DevCPC486.MakeSet(x, TRUE, FALSE, hint + stop + uy, {});
+					DevCPC486.Assert(x, {}, uy);
+					expr(n.right, y, {}, wreg - {CX} + {high, mem, stk});
+					DevCPC486.MakeSet(y, TRUE, TRUE, hint + stop, {});
+					DevCPC486.Load(x, hint + stop, {});
+					IF x.mode = Con THEN DevCPC486.IntDOp(y, x, msk, TRUE); x := y
+					ELSE DevCPC486.IntDOp(x, y, msk, FALSE)
+					END
+			| Nmop:
+					CASE n.subcl OF
+					| bit:
+							expr(n.left, x, {}, wreg - {CX} + {high, mem, stk});
+							DevCPC486.MakeSet(x, FALSE, FALSE, hint + stop, {})
+					| conv:
+							IF f IN {String8, String16} THEN
+								expr(n.left, x, hint, stop);
+								IF f = String8 THEN x.form := VString16to8 END	(* SHORT *)
+							ELSE
+								IF n.left.class = Nconst THEN	(* largeint -> longreal *)
+									ASSERT((n.left.typ.form = Int64) & (f = Real64));
+									DevCPL486.AllocConst(x, n.left.conval, n.left.typ.form);
+								ELSE
+									expr(n.left, x, hint + stop, {high});
+								END;
+								DevCPC486.Convert(x, f, -1, hint + stop, {})	(* ??? *)
+							END
+					| val:
+							expr(n.left, x, hint + stop, {high, con}); DevCPC486.Convert(x, f, n.typ.size, hint, stop)	(* ??? *)
+					| adr:
+							IF n.left.class = Ntype THEN
+								x.mode := Con; x.offset := 0; x.obj := n.left.obj; x.form := Int32; x.typ := n.left.typ;
+							ELSE
+								AdrExpr(n.left, x, hint + stop, {});
+							END;
+							DevCPC486.GetAdr(x, hint + stop, {})
+					| typfn:
+							IF n.left.class = Ntype THEN
+								x.mode := Con; x.offset := 0; x.obj := n.left.obj; x.form := Int32; x.typ := n.left.typ;
+								IF x.obj.typ.untagged THEN DevCPM.err(111) END
+							ELSE
+								expr(n.left, x, hint + stop, {});
+								DevCPC486.Tag(x, y); DevCPC486.Free(x); x := y
+							END;
+							DevCPC486.Load(x, hint + stop, {})
+					| minus, abs, cap:
+							expr(n.left, x, hint + stop, {mem, stk});
+							IF f = Int64 THEN DevCPM.err(260)
+							ELSIF f IN realSet THEN DevCPC486.FloatMOp(x, n.subcl)
+							ELSE DevCPC486.IntMOp(x, n.subcl)
+							END
+					END
+			| Ndop:
+					IF (f IN realSet) & (n.subcl # lsh) & (n.subcl # rot) THEN
+						IF (n.subcl = ash) & (n.right.class = Nconst) & (n.right.conval.realval >= 0) THEN
+							expr(n.left, x, {}, {mem, stk});
+							cval := n.right.conval; sy := SHORT(ENTIER(cval.realval)); cval.realval := 1;
+							WHILE sy > 0 DO cval.realval := cval.realval * 2; DEC(sy) END;
+							DevCPL486.AllocConst(y, cval, Real32);
+							DevCPC486.FloatDOp(x, y, times, FALSE)
+						ELSE FloatDOp(n, x)
+						END
+					ELSIF (f = Int64) OR (n.typ = DevCPT.intrealtyp) THEN DevCPM.err(260); expr(n.left, x, {}, {})
+					ELSE
+						CASE n.subcl OF
+						   times:
+								IF f = Int8 THEN
+									DualExp(n.left, n.right, x, y, {}, {}, wreg - {AX} + {high, mem, stk, con}, {AX, con, stk});
+									DevCPC486.IntDOp(x, y, times, FALSE)
+								ELSE IntDOp(n, x, hint + stop)
+								END
+						| div, mod:
+								DualExp(n.left, n.right, x, y, {}, {}, wreg - {AX} + {high, mem, stk, con}, {AX, DX, mem, stk});
+								DevCPC486.DivMod(x, y, n.subcl = mod)
+						| plus:
+								IF n.typ.form IN {String8, String16} THEN DevCPM.err(265); expr(n.left, x, {}, {})
+								ELSE IntDOp(n, x, hint + stop)
+								END
+						| slash, minus, msk, min, max:
+								IntDOp(n, x, hint + stop)
+						| ash, lsh, rot:
+								uy := {}; IF n.right.class # Nconst THEN uy := {CX} END;
+								DualExp(n^.right, n^.left, y, x, {}, hint + stop, wreg - {CX} + {high, mem, stk}, uy + {con, mem, stk});
+								DevCPC486.Shift(x, y, n^.subcl)
+						| len:
+								IF n.left.typ.form IN {String8, String16} THEN
+									expr(n.left, x, wreg - {DI} , {}); DevCPC486.GetAdr(x, {}, wreg - {DI} + {con});
+									DevCPC486.StrLen(x, n.left.typ, FALSE)
+								ELSE
+									design(n.left, x, hint + stop, {}); expr(n.right, y, {}, {}); DevCPC486.Len(x, y)
+								END
+						END
+					END
+			| Ncall:
+					Call(n, x)
+			| Ncomp:
+					CompStat(n.left); expr(n.right, x, hint, stop); CompRelease(n.left, x);
+					IF x.mode = Stk THEN DevCPC486.Pop(x, x.form, hint, stop) END
+			ELSE
+				design(n, x, hint + stop, stop * {loaded}); DevCPC486.Prepare(x, hint + stop, {})	(* ??? *)
+			END
+		END;
+		x.typ := n.typ;
+		DevCPC486.Assert(x, hint, stop)
+	END expr;
+	
+	PROCEDURE AddCopy (n: DevCPT.Node; VAR dest, dadr, len: DevCPL486.Item; last: BOOLEAN);
+		VAR adr, src: DevCPL486.Item; u: SET; s: INTEGER;
+	BEGIN
+		Check(n, u, s);
+		DevCPC486.Assert(dadr, wreg - {DI}, u + {SI, CX});
+		IF len.mode # Con THEN DevCPC486.Assert(len, wreg - {CX}, u + {SI, DI}) END;
+		expr(n, src, wreg - {SI}, {});
+		adr := src; DevCPC486.GetAdr(adr, {}, wreg - {SI} + {con});
+		IF len.mode # Con THEN DevCPC486.Load(len, {}, wreg - {CX} + {con}) END;
+		DevCPC486.Load(dadr, {}, wreg - {DI} + {con});
+		DevCPC486.AddCopy(dest, src, last)
+	END AddCopy;
+	
+	PROCEDURE StringCopy (left, right: DevCPT.Node);
+		VAR x, y, ax, ay, len: DevCPL486.Item;
+	BEGIN
+		IF IsAllocDynArr(left) THEN expr(left, x, wreg - {CX}, {DI})	(* keep len descriptor *)
+		ELSE expr(left, x, wreg - {DI}, {})
+		END;
+		ax := x; DevCPC486.GetAdr(ax, {}, wreg - {DI});
+		DevCPC486.Free(x); DevCPC486.ArrayLen(x, len, wreg - {CX}, {});
+		WHILE right.class = Ndop DO
+			ASSERT(right.subcl = plus);
+			AddCopy(right.left, x, ax, len, FALSE);
+			right := right.right
+		END;
+		AddCopy(right, x, ax, len, TRUE);
+		DevCPC486.Free(len)
+	END StringCopy;
+	
+	PROCEDURE Checkpc;
+	BEGIN
+		DevCPE.OutSourceRef(DevCPM.errpos)
+	END Checkpc;
+
+	PROCEDURE^ stat (n: DevCPT.Node; VAR end: DevCPL486.Label);
+	
+	PROCEDURE CondStat (if, last: DevCPT.Node; VAR hint: INTEGER; VAR else, end: DevCPL486.Label);
+		VAR local: DevCPL486.Label; x: DevCPL486.Item; cond, lcond: DevCPT.Node;
+	BEGIN
+		local := DevCPL486.NewLbl;
+		DevCPM.errpos := if.conval.intval; Checkpc; cond := if.left;
+		IF (last # NIL) & (cond.class = Ndop) & (cond.subcl >= eql) & (cond.subcl <= geq)
+				& (last.class = Ndop) & (last.subcl >= eql) & (last.subcl <= geq)
+				& SameExp(cond.left, last.left) & SameExp(cond.right, last.right) THEN	(*  reuse comparison *)
+			DevCPC486.setCC(x, cond.subcl, ODD(hint), hint >= 2)
+		ELSIF (last # NIL) & (cond.class = Nmop) & (cond.subcl = is) & (last.class = Nmop) & (last.subcl = is)
+				& SameExp(cond.left, last.left) THEN
+			DevCPC486.ShortTypTest(x, cond.obj.typ)	(* !!! *)
+		ELSE condition(cond, x, else, local)
+		END;
+		hint := x.reg;
+		DevCPC486.JumpF(x, else);
+		IF local # DevCPL486.NewLbl THEN DevCPL486.SetLabel(local) END;
+		stat(if.right, end);
+	END CondStat;
+
+	PROCEDURE IfStat (n: DevCPT.Node; withtrap: BOOLEAN; VAR end: DevCPL486.Label);
+		VAR else, local: DevCPL486.Label; if, last: DevCPT.Node; hint: INTEGER;
+	BEGIN	(* n.class = Nifelse *)
+		if := n.left; last := NIL;
+		WHILE (if # NIL) & ((if.link # NIL) OR (n.right # NIL) OR withtrap) DO
+			else := DevCPL486.NewLbl; 
+			CondStat(if, last, hint, else, end);
+			IF sequential THEN DevCPC486.Jump(end) END;
+			DevCPL486.SetLabel(else); last := if.left; if := if.link
+		END;
+		IF n.right # NIL THEN stat(n.right, end)
+		ELSIF withtrap THEN DevCPM.errpos := n.conval.intval; Checkpc; DevCPC486.Trap(withTrap); sequential := FALSE
+		ELSE CondStat(if, last, hint, end, end)
+		END
+	END IfStat;
+	
+	PROCEDURE CasePart (n: DevCPT.Node; VAR x: DevCPL486.Item; VAR else: DevCPL486.Label; last: BOOLEAN);
+		VAR this, higher: DevCPL486.Label; m: DevCPT.Node; low, high: INTEGER;
+	BEGIN
+		IF n # NIL THEN
+			this := SHORT(ENTIER(n.conval.realval));
+			IF useTree IN n.conval.setval THEN
+				IF n.left # NIL THEN
+					IF n.right # NIL THEN
+						higher := DevCPL486.NewLbl;
+						DevCPC486.CaseJump(x, n.conval.intval, n.conval.intval2, this, higher, TRUE, FALSE);
+						CasePart(n.left, x, else, FALSE);
+						DevCPL486.SetLabel(higher);
+						CasePart(n.right, x, else, last)
+					ELSE
+						DevCPC486.CaseJump(x, n.conval.intval, n.conval.intval2, this, else, FALSE, FALSE);
+						CasePart(n.left, x, else, last);
+					END
+				ELSE
+					DevCPC486.CaseJump(x, n.conval.intval, n.conval.intval2, this, else, FALSE, TRUE);
+					IF n.right # NIL THEN CasePart(n.right, x, else, last)
+					ELSIF ~last THEN DevCPC486.Jump(else)
+					END
+				END
+			ELSE
+				IF useTable IN n.conval.setval THEN
+					m := n; WHILE m.left # NIL DO m := m.left END; low := m.conval.intval;
+					m := n; WHILE m.right # NIL DO m := m.right END; high := m.conval.intval2;
+					DevCPC486.CaseTableJump(x, low, high, else);
+					actual := low; last := TRUE
+				END;
+				CasePart(n.left, x, else, FALSE);
+				WHILE actual < n.conval.intval DO
+					DevCPL486.GenCaseEntry(else, FALSE); INC(actual)
+				END;
+				WHILE actual < n.conval.intval2 DO
+					DevCPL486.GenCaseEntry(this, FALSE); INC(actual)
+				END;
+				DevCPL486.GenCaseEntry(this, last & (n.right = NIL)); INC(actual);
+				CasePart(n.right, x, else, last)
+			END;
+			n.conval.realval := this
+		END
+	END CasePart;
+	
+	PROCEDURE CaseStat (n: DevCPT.Node; VAR end: DevCPL486.Label);
+		VAR x: DevCPL486.Item; case, lab: DevCPT.Node; low, high, tab: INTEGER; else, this: DevCPL486.Label;
+	BEGIN
+		expr(n.left, x, {}, {mem, con, short, float, stk}); else := DevCPL486.NewLbl;
+		IF (n.right.right # NIL) & (n.right.right.class = Ngoto) THEN	(* jump to goto optimization *)
+			CasePart(n.right.link, x, else, FALSE); DevCPC486.Free(x);
+			n.right.right.right.conval.intval2 := else; sequential := FALSE
+		ELSE
+			CasePart(n.right.link, x, else, TRUE); DevCPC486.Free(x);
+			DevCPL486.SetLabel(else);
+			IF n.right.conval.setval # {} THEN stat(n.right.right, end)
+			ELSE DevCPC486.Trap(caseTrap); sequential := FALSE
+			END
+		END;
+		case := n.right.left;
+		WHILE case # NIL DO	(* case.class = Ncasedo *)
+			IF sequential THEN DevCPC486.Jump(end) END;
+			lab := case.left;
+			IF (case.right # NIL) & (case.right.class = Ngoto) THEN	(* jump to goto optimization *)
+				case.right.right.conval.intval2 := SHORT(ENTIER(lab.conval.realval));
+				ASSERT(lab.link = NIL); sequential := FALSE
+			ELSE
+				WHILE lab # NIL DO
+					this := SHORT(ENTIER(lab.conval.realval)); DevCPL486.SetLabel(this); lab := lab.link
+				END;
+				stat(case.right, end)
+			END;
+			case := case.link
+		END
+	END CaseStat;
+
+	PROCEDURE Dim(n: DevCPT.Node; VAR x, nofel: DevCPL486.Item; VAR fact: INTEGER; dimtyp: DevCPT.Struct);
+		VAR len: DevCPL486.Item; u: SET; s: INTEGER;
+	BEGIN
+		Check(n, u, s);
+		IF (nofel.mode = Reg) & (nofel.reg IN u) THEN DevCPC486.Push(nofel) END;
+		expr(n, len, {}, {mem, short});
+		IF nofel.mode = Stk THEN DevCPC486.Pop(nofel, Int32, {}, {}) END;
+		IF len.mode = Stk THEN DevCPC486.Pop(len, Int32, {}, {}) END;
+		DevCPC486.MulDim(len, nofel, fact, dimtyp);
+		IF n.link # NIL THEN
+			Dim(n.link, x, nofel, fact, dimtyp.BaseTyp);
+		ELSE
+			DevCPC486.New(x, nofel, fact)
+		END;
+		DevCPC486.SetDim(x, len, dimtyp)
+	END Dim;
+
+	PROCEDURE CompStat (n: DevCPT.Node);
+		VAR x, y, sp, old, len, nofel: DevCPL486.Item; fact: INTEGER; typ: DevCPT.Struct;
+	BEGIN
+		Checkpc;
+		WHILE (n # NIL) & DevCPM.noerr DO
+			ASSERT(n.class = Nassign);
+			IF n.subcl = assign THEN
+				IF n.right.typ.form IN {String8, String16} THEN
+					StringCopy(n.left, n.right)
+				ELSE
+					IF (n.left.typ.sysflag = interface) & ~CountedPtr(n.right) THEN
+						IPAssign(NIL, n.right, x, y, {});	(* no Release *)
+					ELSE expr(n.right, y, {}, {})
+					END;
+					expr(n.left, x, {}, {});
+					DevCPC486.Assign(x, y)
+				END
+			ELSE ASSERT(n.subcl = newfn);
+				typ := n.left.typ.BaseTyp;
+				ASSERT(typ.comp = DynArr);
+				ASSERT(n.right.link = NIL);
+				expr(n.right, y, {}, wreg - {CX} + {mem, stk});
+				DevCPL486.MakeReg(sp, SP, Int32);
+				DevCPC486.CopyReg(sp, old, {}, {CX});
+				DevCPC486.CopyReg(y, len, {}, {CX});
+				IF typ.BaseTyp.form = Char16 THEN
+					DevCPL486.MakeConst(x, 2, Int32); DevCPL486.GenMul(x, y, FALSE)
+				END;
+				DevCPC486.StackAlloc;
+				DevCPC486.Free(y);
+				expr(n.left, x, {}, {}); DevCPC486.Assign(x, sp);
+				DevCPC486.Push(len);
+				DevCPC486.Push(old);
+				typ.sysflag := stackArray
+			END;
+			n := n.link
+		END
+	END CompStat;
+	
+	PROCEDURE CompRelease (n: DevCPT.Node; VAR res: DevCPL486.Item);
+		VAR x, y, sp: DevCPL486.Item;
+	BEGIN
+		IF n.link # NIL THEN CompRelease(n.link, res) END;
+		ASSERT(n.class = Nassign);
+		IF n.subcl = assign THEN
+			IF (n.left.typ.form = Pointer) & (n.left.typ.sysflag = interface) THEN
+				IF res.mode = Cond THEN
+					DevCPL486.GenCode(9CH); (* push flags *)
+					res.mode := Stk
+				ELSIF res.mode = Reg THEN
+					IF res.form < Int16 THEN DevCPC486.Push(res)
+					ELSE DevCPC486.Assert(res, {}, {AX, CX, DX})
+					END
+				END;
+				expr(n.left, x, wreg - {DI}, {loaded});
+				DevCPC486.IPRelease(x, 0, TRUE, TRUE);
+				n.left.obj.used := FALSE
+			END
+		ELSE ASSERT(n.subcl = newfn);
+			DevCPL486.MakeReg(sp, SP, Int32); DevCPL486.GenPop(sp);
+			DevCPL486.MakeConst(y, 0, Pointer);
+			expr(n.left, x, {}, {}); DevCPC486.Assign(x, y)
+		END
+	END CompRelease;
+	
+	PROCEDURE Assign(n: DevCPT.Node; ux: SET);
+		VAR r: DevCPT.Node; f: BYTE; false, true: DevCPL486.Label; x, y, z: DevCPL486.Item; uf, uy: SET; s: INTEGER;
+	BEGIN
+		r := n.right; f := r.typ.form; uf := {};
+		IF (r.class IN {Nmop, Ndop}) THEN
+			IF (r.subcl = conv) & (f # Set) &
+(*
+				(DevCPT.Includes(f, r.left.typ.form) OR DevCPT.Includes(f, n.left.typ.form)) THEN r := r.left;
+				IF ~(f IN realSet) & (r.typ.form IN realSet) & (r.typ # DevCPT.intrealtyp) THEN uf := {AX} END (* entier *)
+*)
+				(DevCPT.Includes(f, r.left.typ.form) OR DevCPT.Includes(f, n.left.typ.form)) &
+				((f IN realSet) OR ~(r.left.typ.form IN realSet)) THEN r := r.left
+			ELSIF (f IN {Char8..Int32, Set, Char16, String8, String16}) & SameExp(n.left, r.left) THEN
+				IF r.class = Ndop THEN
+					IF (r.subcl IN {slash, plus, minus, msk}) OR (r.subcl = times) & (f = Set) THEN
+						expr(r.right, y, {}, ux); expr(n.left, x, {}, {});
+						DevCPC486.Load(y, {}, {}); DevCPC486.IntDOp(x, y, r.subcl, FALSE);
+						RETURN
+					ELSIF r.subcl IN {ash, lsh, rot} THEN
+						expr(r.right, y, wreg - {CX} + {high, mem}, ux); expr(n.left, x, {}, {});
+						DevCPC486.Load(y, {}, wreg - {CX} + {high}); DevCPC486.Shift(x, y, r.subcl);
+						RETURN
+					END
+				ELSE
+					IF r.subcl IN {minus, abs, cap} THEN
+						expr(n.left, x, {}, {}); DevCPC486.IntMOp(x, r.subcl); RETURN
+					END
+				END
+			ELSIF f = Bool THEN
+				IF (r.subcl = not) & SameExp(n.left, r.left) THEN
+					expr(n.left, x, {}, {}); DevCPC486.IntMOp(x, not); RETURN
+				END
+			END
+		END;
+		IF (n.left.typ.sysflag = interface) & (n.left.typ.form = Pointer) THEN IPAssign(n.left, r, x, y, ux)
+		ELSE expr(r, y, {high}, ux); expr(n.left, x, {}, uf + {loaded});	(* high ??? *)
+		END;
+		DevCPC486.Assign(x, y)
+	END Assign;
+	
+	PROCEDURE stat (n: DevCPT.Node; VAR end: DevCPL486.Label);
+		VAR x, y, nofel: DevCPL486.Item; local, next, loop, prevExit: DevCPL486.Label; fact, sx, sz: INTEGER; ux, uz: SET;
+	BEGIN
+		sequential := TRUE; INC(nesting);
+		WHILE (n # NIL) & DevCPM.noerr DO
+			IF n.link = NIL THEN next := end ELSE next := DevCPL486.NewLbl END;
+			DevCPM.errpos := n.conval.intval; DevCPL486.BegStat;
+			CASE n.class OF
+			| Ninittd:
+					(* done at load-time *)
+			| Nassign:
+					Checkpc;
+					Check(n.left, ux, sx);
+					CASE n.subcl OF
+					   assign:
+							IF n.left.typ.form = Comp THEN
+								IF (n.right.class = Ndop) & (n.right.typ.form IN {String8, String16}) THEN
+									StringCopy(n.left, n.right)
+								ELSE
+									StringOp(n.left, n.right, x, y, TRUE);
+									IF DevCPC486.ContainsIPtrs(n.left.typ) THEN IPStructAssign(n.left.typ) END;
+									DevCPC486.Copy(x, y, FALSE)
+								END
+							ELSE Assign(n, ux)
+							END
+					| getfn:
+							Mem(n.right, y, n.left.typ, {}, ux);
+							expr(n.left, x, {}, {loaded});
+							DevCPC486.Assign(x, y)
+					| putfn:
+							expr(n.right, y, {}, ux);
+							Mem(n.left, x, n.right.typ, {}, {});
+							DevCPC486.Assign(x, y)
+					| incfn, decfn:
+							expr(n.right, y, {}, ux); expr(n.left, x, {}, {});
+							IF n.left.typ.form = Int64 THEN 
+								DevCPC486.LargeInc(x, y, n.subcl = decfn)
+							ELSE
+								DevCPC486.Load(y, {}, {}); DevCPC486.IntDOp(x, y, SHORT(SHORT(plus - incfn + n.subcl)), FALSE)
+							END
+					| inclfn:
+							expr(n.right, y, {}, wreg - {CX} + {high, mem, stk}); DevCPC486.MakeSet(y, FALSE, FALSE, ux, {});
+							DevCPC486.Assert(y, {}, ux); expr(n.left, x, {}, {});
+							DevCPC486.Load(y, {}, {}); DevCPC486.IntDOp(x, y, plus, FALSE)
+					| exclfn:
+							expr(n.right, y, {}, wreg - {CX} + {high, mem, stk}); DevCPC486.MakeSet(y, FALSE, TRUE, ux, {});
+							DevCPC486.Assert(y, {}, ux); expr(n.left, x, {}, {});
+							DevCPC486.Load(y, {}, {}); DevCPC486.IntDOp(x, y, times, FALSE)
+					| getrfn:
+							expr(n.right, y, {}, {});
+							IF y.offset < 8 THEN	
+								DevCPL486.MakeReg(y, y.offset, n.left.typ.form);	(* ??? *)
+								expr(n.left, x, {}, {loaded}); DevCPC486.Assign(x, y)
+							ELSE DevCPM.err(220)
+							END
+					| putrfn:
+							expr(n.left, x, {}, {});
+							IF x.offset < 8 THEN
+								DevCPL486.MakeReg(x, x.offset, n.right.typ.form);	(* ??? *)
+								expr(n.right, y, wreg - {x.reg}, {}); DevCPC486.Assign(x, y)
+							ELSE DevCPM.err(220)
+							END
+					| newfn:
+							y.typ := n.left.typ;
+							IF n.right # NIL THEN
+								IF y.typ.BaseTyp.comp = Record THEN
+									expr(n.right, nofel, {}, {AX, CX, DX, mem, stk});
+									DevCPC486.New(y, nofel, 1);
+								ELSE (*open array*)
+									nofel.mode := Con; nofel.form := Int32; fact := 1;
+									Dim(n.right, y, nofel, fact, y.typ.BaseTyp)
+								END
+							ELSE
+								DevCPL486.MakeConst(nofel, 0, Int32);
+								DevCPC486.New(y, nofel, 1);
+							END;
+							DevCPC486.Assert(y, {}, ux); expr(n.left, x, {}, {loaded}); DevCPC486.Assign(x, y)
+					| sysnewfn:
+							expr(n.right, y, {}, {mem, short}); DevCPC486.SysNew(y);
+							DevCPC486.Assert(y, {}, ux); expr(n.left, x, {}, {}); DevCPC486.Assign(x, y)
+					| copyfn:
+							StringOp(n.left, n.right, x, y, TRUE);
+							DevCPC486.Copy(x, y, TRUE)
+					| movefn:
+							Check(n.right.link, uz, sz);
+							expr(n.right, y, {}, wreg - {SI} + {short} + ux + uz);
+							expr(n.left, x, {}, wreg - {DI} + {short} + uz);
+							expr(n.right.link, nofel, {}, wreg - {CX} + {mem, stk, short});
+							DevCPC486.Load(x, {}, wreg - {DI} + {con});
+							DevCPC486.Load(y, {}, wreg - {SI} + {con}); 
+							DevCPC486.SysMove(nofel)
+					END;
+					sequential := TRUE
+			| Ncall:
+					Checkpc;
+					Call(n, x); sequential := TRUE
+			| Nifelse:
+					IF (n.subcl # assertfn) OR assert THEN IfStat(n, FALSE, next) END
+			| Ncase:
+					Checkpc;
+					CaseStat(n, next)
+			| Nwhile:
+					local := DevCPL486.NewLbl;
+					IF n.right # NIL THEN DevCPC486.Jump(local) END;
+					loop := DevCPL486.NewLbl; DevCPL486.SetLabel(loop);
+					stat(n.right, local); DevCPL486.SetLabel(local);
+					DevCPM.errpos := n.conval.intval; Checkpc;
+					condition(n.left, x, next, loop); DevCPC486.JumpT(x, loop); sequential := TRUE
+			| Nrepeat:
+					loop := DevCPL486.NewLbl; DevCPL486.SetLabel(loop);
+					local := DevCPL486.NewLbl; stat(n.left, local); DevCPL486.SetLabel(local);
+					DevCPM.errpos := n.conval.intval; Checkpc;
+					condition(n.right, x, loop, next); DevCPC486.JumpF(x, loop); sequential := TRUE
+			| Nloop:
+					prevExit := Exit; Exit := next;
+					loop := DevCPL486.NewLbl; DevCPL486.SetLabel(loop); stat(n.left, loop);
+					IF sequential THEN DevCPC486.Jump(loop) END;
+					next := Exit; Exit := prevExit; sequential := FALSE
+			| Nexit:
+					Checkpc;
+					DevCPC486.Jump(Exit); sequential := FALSE
+			| Nreturn:
+					IF n.left # NIL THEN
+						Checkpc;
+						IF (n.obj.typ.sysflag = interface) & (n.obj.typ.form = Pointer)
+							& (n.left.class # Nconst) & ~CountedPtr(n.left) THEN IPAssign(NIL, n.left, y, x, {})
+						ELSE expr(n.left, x, wreg - {AX}, {})
+						END;
+						DevCPC486.Result(n.obj, x)
+					END;
+					IF (nesting > 1) OR (n.link # NIL) THEN DevCPC486.Jump(Return) END;
+					sequential := FALSE
+			| Nwith:
+					IfStat(n, n.subcl = 0, next)
+			| Ntrap:
+					Checkpc;
+					DevCPC486.Trap(n.right.conval.intval); sequential := TRUE
+			| Ncomp:
+					CompStat(n.left); stat(n.right, next); x.mode := 0; CompRelease(n.left, x)
+			| Ndrop:
+					Checkpc;
+					expr(n.left, x, {}, {}); DevCPC486.Free(x)
+			| Ngoto:
+					IF n.left # NIL THEN
+						Checkpc;
+						condition(n.left, x, next, n.right.conval.intval2);
+						DevCPC486.JumpT(x, n.right.conval.intval2)
+					ELSE
+						DevCPC486.Jump(n.right.conval.intval2);
+						sequential := FALSE
+					END
+			| Njsr:
+					DevCPL486.GenJump(-3, n.right.conval.intval2, FALSE)	(* call n.right *)
+			| Nret:
+					DevCPL486.GenReturn(0); sequential := FALSE	(* ret 0 *)
+			| Nlabel:
+					DevCPL486.SetLabel(n.conval.intval2)
+			END;
+			DevCPC486.CheckReg; DevCPL486.EndStat; n := n.link;
+			IF n = NIL THEN end := next
+			ELSIF next # DevCPL486.NewLbl THEN DevCPL486.SetLabel(next)
+			END
+		END;
+		DEC(nesting)
+	END stat;
+	
+	PROCEDURE CheckFpu (n: DevCPT.Node; VAR useFpu: BOOLEAN);
+	BEGIN
+		WHILE n # NIL DO
+			IF n.typ.form IN {Real32, Real64} THEN useFpu := TRUE END;
+			CASE n.class OF
+			| Ncase:
+				CheckFpu(n.left, useFpu); CheckFpu(n.right.left, useFpu); CheckFpu(n.right.right, useFpu)
+			| Ncasedo:
+				CheckFpu(n.right, useFpu)
+			| Ngoto, Ndrop, Nloop, Nreturn, Nmop, Nfield, Nderef, Nguard:
+				CheckFpu(n.left, useFpu)
+			| Nassign, Ncall, Nifelse, Nif, Nwhile, Nrepeat, Nwith, Ncomp, Ndop, Nupto, Nindex:
+				CheckFpu(n.left, useFpu); CheckFpu(n.right, useFpu)
+			| Njsr, Nret, Nlabel, Ntrap, Nexit, Ninittd, Ntype, Nproc, Nconst, Nvar, Nvarpar:
+			END;
+			n := n.link
+		END
+	END CheckFpu;
+	
+	PROCEDURE procs(n: DevCPT.Node);
+		VAR proc, obj: DevCPT.Object; i, j: INTEGER; end: DevCPL486.Label;
+			ch: SHORTCHAR; name: DevCPT.Name; useFpu: BOOLEAN;
+	BEGIN
+		INC(DevCPL486.level); nesting := 0;
+		WHILE (n # NIL) & DevCPM.noerr DO
+			DevCPC486.imLevel[DevCPL486.level] := DevCPC486.imLevel[DevCPL486.level - 1]; proc := n.obj; 
+			IF imVar IN proc.conval.setval THEN INC(DevCPC486.imLevel[DevCPL486.level]) END;
+			procs(n.left);
+			DevCPM.errpos := n.conval.intval;
+			useFpu := FALSE; CheckFpu(n.right, useFpu);
+			DevCPC486.Enter(proc, n.right = NIL, useFpu);
+			InitializeIPVars(proc);
+			end := DevCPL486.NewLbl; Return := DevCPL486.NewLbl; stat(n.right, end);
+			DevCPM.errpos := n.conval.intval2; Checkpc;
+			IF sequential OR (end # DevCPL486.NewLbl) THEN
+				DevCPL486.SetLabel(end);
+				IF (proc.typ # DevCPT.notyp) & (proc.sysflag # noframe) THEN DevCPC486.Trap(funcTrap) END
+			END;
+			DevCPL486.SetLabel(Return);
+			ReleaseIPVars(proc);
+			DevCPC486.Exit(proc, n.right = NIL);
+			IF proc.mode = TProc THEN
+				name := proc.link.typ.strobj.name^$; i := 0;
+				WHILE name[i] # 0X DO INC(i) END;
+				name[i] := "."; INC(i); j := 0; ch := proc.name[0];
+				WHILE (ch # 0X) & (i < LEN(name)-1) DO name[i] := ch; INC(i); INC(j); ch := proc.name[j] END ;
+				name[i] := 0X;
+			ELSE name := proc.name^$
+			END;
+			DevCPE.OutRefName(name); DevCPE.OutRefs(proc.scope.right);
+			n := n.link
+		END;
+		DEC(DevCPL486.level)
+	END procs;
+	
+	PROCEDURE Module*(prog: DevCPT.Node);
+		VAR end: DevCPL486.Label; name: DevCPT.Name; obj, p: DevCPT.Object; n: DevCPT.Node;
+			aAd, rAd: INTEGER; typ: DevCPT.Struct; useFpu: BOOLEAN;
+	BEGIN
+		DevCPH.UseReals(prog, {DevCPH.longDop, DevCPH.longMop});
+		DevCPM.NewObj(DevCPT.SelfName);
+		IF DevCPM.noerr THEN
+			DevCPE.OutHeader; n := prog.right;
+			WHILE (n # NIL) & (n.class = Ninittd) DO n := n.link END;
+			useFpu := FALSE; CheckFpu(n, useFpu);
+			DevCPC486.Enter(NIL, n = NIL, useFpu);
+			end := DevCPL486.NewLbl; stat(n, end); DevCPL486.SetLabel(end);
+			DevCPM.errpos := prog.conval.intval2; Checkpc;
+			DevCPC486.Exit(NIL, n = NIL);
+			IF prog.link # NIL THEN	(* close section *)
+				DevCPL486.SetLabel(DevCPE.closeLbl);
+				useFpu := FALSE; CheckFpu(prog.link, useFpu);
+				DevCPC486.Enter(NIL, FALSE, useFpu);
+				end := DevCPL486.NewLbl; stat(prog.link, end); DevCPL486.SetLabel(end);
+				DevCPM.errpos := SHORT(ENTIER(prog.conval.realval)); Checkpc;
+				DevCPC486.Exit(NIL, FALSE)
+			END;
+			name := "$$"; DevCPE.OutRefName(name); DevCPE.OutRefs(DevCPT.topScope.right);
+			DevCPM.errpos := prog.conval.intval;
+			WHILE query # NIL DO
+				typ := query.typ; query.typ := DevCPT.int32typ;
+				query.conval.intval := 20;	(* parameters *)
+				query.conval.intval2 := -8;	(* saved registers *)
+				DevCPC486.Enter(query, FALSE, FALSE);
+				InstallQueryInterface(typ, query);
+				DevCPC486.Exit(query, FALSE);
+				name := "QueryInterface"; DevCPE.OutRefName(name);
+				query := query.nlink
+			END;
+			procs(prog.left);
+			DevCPC486.InstallStackAlloc;
+			addRef := NIL; release := NIL; release2 := NIL;
+			DevCPC486.intHandler := NIL;
+			IF DevCPM.noerr THEN DevCPE.OutCode END;
+			IF ~DevCPM.noerr THEN DevCPM.DeleteObj END
+		END
+	END Module;
+
+END DevCPV486.

BlackBox/Dev/Mod/Markers.txt

@@ -0,0 +1,442 @@
+MODULE DevMarkers;
+
+	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Markers.odc *)
+	(* DO NOT EDIT *)
+
+	IMPORT
+		Kernel, Files, Stores, Fonts, Ports, Models, Views, Controllers, Properties, Dialog,
+		TextModels, TextSetters, TextViews, TextControllers, TextMappers;
+
+	CONST
+		(** View.mode **)
+		undefined* = 0; mark* = 1; message* = 2; 
+		firstMode = 1; lastMode = 2;
+
+		(** View.err **)
+		noCode* = 9999;
+
+		errFile = "Errors"; point = Ports.point;
+
+	TYPE
+		View* = POINTER TO ABSTRACT RECORD (Views.View)
+			mode-: INTEGER;
+			err-: INTEGER;
+			msg-: POINTER TO ARRAY OF CHAR;
+			era: INTEGER
+		END;
+
+		Directory* = POINTER TO ABSTRACT RECORD END;
+
+
+		StdView = POINTER TO RECORD (View) END;
+
+		StdDirectory = POINTER TO RECORD (Directory) END;
+
+		SetModeOp = POINTER TO RECORD (Stores.Operation)
+			view: View;
+			mode: INTEGER
+		END;
+		
+
+	VAR
+		dir-, stdDir-: Directory;
+
+		globR: TextModels.Reader; globW: TextModels.Writer;	(* recycling done in Load, Insert *)
+		
+		thisEra: INTEGER;
+
+
+	(** View **)
+
+	PROCEDURE (v: View) CopyFromSimpleView- (source: Views.View), EXTENSIBLE;
+	BEGIN
+		(* v.CopyFrom^(source); *)
+		WITH source: View DO
+			v.err := source.err; v.mode := source.mode;
+			IF source.msg # NIL THEN
+				NEW(v.msg, LEN(source.msg^)); v.msg^ := source.msg^$
+			END
+		END
+	END CopyFromSimpleView;
+
+(*
+	PROCEDURE (v: View) InitContext* (context: Models.Context), EXTENSIBLE;
+	BEGIN
+		ASSERT(v.mode # undefined, 20);
+		v.InitContext^(context)
+	END InitContext;
+*)
+
+	PROCEDURE (v: View) InitErr* (err: INTEGER), NEW, EXTENSIBLE;
+	BEGIN
+		ASSERT(v.msg = NIL, 20);
+		IF v.err # err THEN v.err := err; v.mode := mark END;
+		IF v.mode = undefined THEN v.mode := mark END
+	END InitErr;
+
+	PROCEDURE (v: View) InitMsg* (msg: ARRAY OF CHAR), NEW, EXTENSIBLE;
+		VAR i: INTEGER; str: ARRAY 1024 OF CHAR;
+	BEGIN
+		ASSERT(v.msg = NIL, 20);
+		Dialog.MapString(msg, str);
+		i := 0; WHILE str[i] # 0X DO INC(i) END;
+		NEW(v.msg, i + 1); v.msg^ := str$;
+		v.mode := mark
+	END InitMsg;
+
+	PROCEDURE (v: View) SetMode* (mode: INTEGER), NEW, EXTENSIBLE;
+		VAR op: SetModeOp;
+	BEGIN
+		ASSERT((firstMode <= mode) & (mode <= lastMode), 20);
+		IF v.mode # mode THEN
+			NEW(op); op.view := v; op.mode := mode;
+			Views.Do(v, "#System:ViewSetting", op)
+		END
+	END SetMode;
+
+
+	(** Directory **)
+
+	PROCEDURE (d: Directory) New* (type: INTEGER): View, NEW, ABSTRACT;
+	PROCEDURE (d: Directory) NewMsg* (msg: ARRAY OF CHAR): View, NEW, ABSTRACT;
+
+
+	(* SetModeOp *)
+
+	PROCEDURE (op: SetModeOp) Do;
+		VAR v: View; mode: INTEGER;
+	BEGIN
+		v := op.view;
+		mode := v.mode; v.mode := op.mode; op.mode := mode;
+		Views.Update(v, Views.keepFrames);
+		IF v.context # NIL THEN v.context.SetSize(Views.undefined, Views.undefined) END
+	END Do;
+
+	PROCEDURE ToggleMode (v: View);
+		VAR mode: INTEGER;
+	BEGIN
+		IF ABS(v.err) # noCode THEN
+			IF v.mode < lastMode THEN mode := v.mode + 1 ELSE mode := firstMode END
+		ELSE
+			IF v.mode < message THEN mode := v.mode + 1 ELSE mode := firstMode END
+		END;
+		v.SetMode(mode)
+	END ToggleMode;
+
+
+	(* primitives for StdView *)
+
+	PROCEDURE NumToStr (x: INTEGER; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
+		VAR j: INTEGER; m: ARRAY 32 OF CHAR;
+	BEGIN
+		ASSERT(x >= 0, 20);
+		j := 0; REPEAT m[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0;
+		i := 0; REPEAT DEC(j); s[i] := m[j]; INC(i) UNTIL j = 0;
+		s[i] := 0X
+	END NumToStr;
+
+	PROCEDURE Load (v: StdView);
+		VAR view: Views.View; t: TextModels.Model; s: TextMappers.Scanner;
+			err: INTEGER; i: INTEGER; ch: CHAR; loc: Files.Locator;
+			msg: ARRAY 1024 OF CHAR;
+	BEGIN
+		err := ABS(v.err); NumToStr(err, msg, i);
+		loc := Files.dir.This("Dev"); IF loc = NIL THEN RETURN END;
+		loc := loc.This("Rsrc"); IF loc = NIL THEN RETURN END;
+		view := Views.OldView(loc, errFile);
+		IF (view # NIL) & (view IS TextViews.View) THEN
+			t := view(TextViews.View).ThisModel();
+			IF t # NIL THEN
+				s.ConnectTo(t);
+				REPEAT
+					s.Scan
+				UNTIL ((s.type = TextMappers.int) & (s.int = err)) OR (s.type = TextMappers.eot);
+				IF s.type = TextMappers.int THEN
+					s.Skip(ch); i := 0;
+					WHILE (ch >= " ") & (i < LEN(msg) - 1) DO
+						msg[i] := ch; INC(i); s.rider.ReadChar(ch)
+					END;
+					msg[i] := 0X
+				END
+			END
+		END;
+		NEW(v.msg, i + 1); v.msg^ := msg$
+	END Load;
+
+	PROCEDURE DrawMsg (v: StdView; f: Views.Frame; font: Fonts.Font; color: Ports.Color);
+		VAR w, h, asc, dsc: INTEGER;
+	BEGIN
+		CASE v.mode OF
+		  mark:
+			v.context.GetSize(w, h);
+			f.DrawLine(point, 0, w - 2 * point, h, 0, color);
+			f.DrawLine(w - 2 * point, 0, point, h, 0, color)
+		| message:
+			font.GetBounds(asc, dsc, w);
+			f.DrawString(2 * point, asc, color, v.msg^, font)
+		END
+	END DrawMsg;
+	
+	PROCEDURE ShowMsg (v: StdView);
+	BEGIN
+		IF v.msg = NIL THEN Load(v) END;
+		Dialog.ShowStatus(v.msg^)
+	END ShowMsg;
+
+	PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);
+		VAR c: Models.Context; t: TextModels.Model; u, w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
+	BEGIN
+		v.context.GetSize(w, h); u := f.dot; in0 := FALSE;
+		in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
+		REPEAT
+			IF in # in0 THEN
+				f.MarkRect(u, 0, w - u, h, Ports.fill, Ports.invert, Ports.show); in0 := in
+			END;
+			f.Input(x, y, m, isDown);
+			in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
+		UNTIL ~isDown;
+		IF in0 THEN
+			f.MarkRect(u, 0, w - u, h, Ports.fill, Ports.invert, Ports.hide);
+			IF Dialog.showsStatus & ~(Controllers.modify IN buttons) & ~(Controllers.doubleClick IN buttons) THEN
+				ShowMsg(v)
+			ELSE
+				ToggleMode(v)
+			END;
+			c := v.context;
+			WITH c: TextModels.Context DO
+				t := c.ThisModel();
+				TextControllers.SetCaret(t, c.Pos() + 1)
+			ELSE
+			END
+		END
+	END Track;
+
+	PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);
+		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, w: INTEGER;
+	BEGIN
+		c := v.context;
+		IF (c # NIL) & (c IS TextModels.Context) THEN a := c(TextModels.Context).Attr(); font := a.font
+		ELSE font := Fonts.dir.Default()
+		END;
+		font.GetBounds(asc, dsc, w);
+		p.h := asc + dsc;
+		CASE v.mode OF
+		  mark:
+			p.w := p.h + 2 * point
+		| message:
+			IF v.msg = NIL THEN Load(v) END;
+			p.w := font.StringWidth(v.msg^) + 4 * point
+		END
+	END SizePref;
+
+
+	(* StdView *)
+
+	PROCEDURE (v: StdView) ExternalizeAs (VAR s1: Stores.Store);
+	BEGIN
+		s1 := NIL
+	END ExternalizeAs;
+
+	PROCEDURE (v: StdView) SetMode(mode: INTEGER);
+	BEGIN v.SetMode^(mode); ShowMsg(v)
+	END SetMode;
+
+	PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
+		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
+			w, h: INTEGER;
+	BEGIN
+		c := v.context; c.GetSize(w, h);
+		WITH c: TextModels.Context DO a := c.Attr(); font := a.font ELSE font := Fonts.dir.Default() END;
+		IF TRUE (*f.colors >= 4*) THEN color := Ports.grey50 ELSE color := Ports.defaultColor END;
+		IF v.err >= 0 THEN
+			f.DrawRect(point, 0, w - point, h, Ports.fill, color);
+			DrawMsg(v, f, font, Ports.background)
+		ELSE
+			f.DrawRect(point, 0, w - point, h, 0, color);
+			DrawMsg(v, f, font, Ports.defaultColor)
+		END
+	END Restore;
+
+	PROCEDURE (v: StdView) GetBackground (VAR color: Ports.Color);
+	BEGIN
+		color := Ports.background
+	END GetBackground;
+
+	PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
+																		VAR focus: Views.View);
+	BEGIN
+		WITH msg: Controllers.TrackMsg DO
+			Track(v, f, msg.x, msg.y, msg.modifiers)
+		ELSE
+		END
+	END HandleCtrlMsg;
+
+	PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
+		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, w: INTEGER;
+	BEGIN
+		WITH msg: Properties.Preference DO
+			WITH msg: Properties.SizePref DO
+				SizePref(v, msg)
+			| msg: Properties.ResizePref DO
+				msg.fixed := TRUE
+			| msg: Properties.FocusPref DO
+				msg.hotFocus := TRUE
+(*
+			| msg: Properties.StorePref DO
+				msg.view := NIL
+*)
+			| msg: TextSetters.Pref DO
+				c := v.context;
+				IF (c # NIL) & (c IS TextModels.Context) THEN
+					a := c(TextModels.Context).Attr(); font := a.font
+				ELSE
+					font := Fonts.dir.Default()
+				END;
+				font.GetBounds(asc, msg.dsc, w)
+			ELSE
+			END
+		ELSE
+		END
+	END HandlePropMsg;
+
+
+	(* StdDirectory *)
+
+	PROCEDURE (d: StdDirectory) New (err: INTEGER): View;
+		VAR v: StdView;
+	BEGIN
+		NEW(v); v.InitErr(err); RETURN v
+	END New;
+
+	PROCEDURE (d: StdDirectory) NewMsg (msg: ARRAY OF CHAR): View;
+		VAR v: StdView;
+	BEGIN
+		NEW(v); v.InitErr(noCode); v.InitMsg(msg); RETURN v
+	END NewMsg;
+
+
+	(** Cleaner **)
+
+	PROCEDURE Cleanup;
+	BEGIN
+		globR := NIL; globW := NIL
+	END Cleanup;
+	
+
+	(** miscellaneous **)
+
+	PROCEDURE Insert* (text: TextModels.Model; pos: INTEGER; v: View);
+		VAR w: TextModels.Writer; r: TextModels.Reader;
+	BEGIN
+		ASSERT(v.era = 0, 20);
+		Models.BeginModification(Models.clean, text);
+		v.era := thisEra;
+		IF pos > text.Length() THEN pos := text.Length() END;
+		globW := text.NewWriter(globW); w := globW; w.SetPos(pos);
+		IF pos > 0 THEN DEC(pos) END;
+		globR := text.NewReader(globR); r := globR; r.SetPos(pos); r.Read;
+		IF r.attr # NIL THEN w.SetAttr(r.attr) END;
+		w.WriteView(v, Views.undefined, Views.undefined);
+		Models.EndModification(Models.clean, text);
+	END Insert;
+
+	PROCEDURE Unmark* (text: TextModels.Model);
+		VAR r: TextModels.Reader; v: Views.View; pos: INTEGER;
+			script: Stores.Operation;
+	BEGIN
+		Models.BeginModification(Models.clean, text);
+		Models.BeginScript(text, "#Dev:DeleteMarkers", script);
+		r := text.NewReader(NIL); r.ReadView(v);
+		WHILE ~r.eot DO
+			IF r.view IS View THEN
+				pos := r.Pos() - 1; text.Delete(pos, pos + 1); r.SetPos(pos)
+			END;
+			r.ReadView(v)
+		END;
+		INC(thisEra);
+		Models.EndScript(text, script);
+		Models.EndModification(Models.clean, text);
+	END Unmark;
+
+	PROCEDURE ShowFirstError* (text: TextModels.Model; focusOnly: BOOLEAN);
+		VAR v1: Views.View; pos: INTEGER;
+	BEGIN
+		globR := text.NewReader(globR); globR.SetPos(0);
+		REPEAT globR.ReadView(v1) UNTIL globR.eot OR (v1 IS View);
+		IF ~globR.eot THEN
+			pos := globR.Pos();
+			TextViews.ShowRange(text, pos, pos, focusOnly);
+			TextControllers.SetCaret(text, pos);
+			v1(View).SetMode(v1(View).mode)
+		END
+	END ShowFirstError;
+
+
+	(** commands **)
+
+	PROCEDURE UnmarkErrors*;
+		VAR t: TextModels.Model;
+	BEGIN
+		t := TextViews.FocusText();
+		IF t # NIL THEN Unmark(t) END
+	END UnmarkErrors;
+
+	PROCEDURE NextError*;
+		VAR c: TextControllers.Controller; t: TextModels.Model; v1: Views.View;
+			beg, pos: INTEGER;
+	BEGIN
+		c := TextControllers.Focus();
+		IF c # NIL THEN
+			t := c.text;
+			IF c.HasCaret() THEN pos := c.CaretPos()
+			ELSIF c.HasSelection() THEN c.GetSelection(beg, pos)
+			ELSE pos := 0
+			END;
+			TextControllers.SetSelection(t, TextControllers.none, TextControllers.none);
+			globR := t.NewReader(globR); globR.SetPos(pos);
+			REPEAT globR.ReadView(v1) UNTIL globR.eot OR (v1 IS View);
+			IF ~globR.eot THEN
+				pos := globR.Pos(); v1(View).SetMode(v1(View).mode);
+				TextViews.ShowRange(t, pos, pos, TextViews.focusOnly)
+			ELSE
+				pos := 0; Dialog.Beep
+			END;
+			TextControllers.SetCaret(t, pos);
+			globR := NIL
+		END
+	END NextError;
+
+	PROCEDURE ToggleCurrent*;
+		VAR c: TextControllers.Controller; t: TextModels.Model; v: Views.View; pos: INTEGER;
+	BEGIN
+		c := TextControllers.Focus();
+		IF (c # NIL) & c.HasCaret() THEN
+			t := c.text; pos := c.CaretPos();
+			globR := t.NewReader(globR); globR.SetPos(pos); globR.ReadPrev;
+			v := globR.view;
+			IF (v # NIL) & (v IS View) THEN ToggleMode(v(View)) END;
+			TextViews.ShowRange(t, pos, pos, TextViews.focusOnly);
+			TextControllers.SetCaret(t, pos);
+			globR := NIL
+		END
+	END ToggleCurrent;
+
+
+	PROCEDURE SetDir* (d: Directory);
+	BEGIN
+		dir := d
+	END SetDir;
+
+
+	PROCEDURE Init;
+		VAR d: StdDirectory;
+	BEGIN
+		thisEra := 1;
+		NEW(d); dir := d; stdDir := d
+	END Init;
+
+BEGIN
+	Init; Kernel.InstallCleaner(Cleanup)
+CLOSE
+	Kernel.RemoveCleaner(Cleanup)
+END DevMarkers.

BlackBox/HostDialog.txt

@@ -0,0 +1,41 @@
+MODULE HostDialog;
+
+	(* for StdLog and Dialog.SetShowHook *)
+
+	IMPORT Dialog, Console;
+
+	TYPE
+		ShowHook = POINTER TO RECORD (Dialog.ShowHook) END;
+
+	PROCEDURE ShowParamMsg* (IN str, p0, p1, p2: ARRAY OF CHAR);
+	BEGIN
+		Console.WriteStr(str$ + " " + p0$ + " " + p1$ + " " + p2$);
+		Console.WriteLn
+	END ShowParamMsg;
+
+	PROCEDURE ShowParamStatus* (IN str, p0, p1, p2: ARRAY OF CHAR);
+	BEGIN
+		Console.WriteStr(str$ + " " + p0$ + " " + p1$ + " " + p2$);
+		Console.WriteLn
+	END ShowParamStatus;
+
+	PROCEDURE (h: ShowHook) ShowParamMsg (IN str, p0, p1, p2: ARRAY OF CHAR);
+	BEGIN
+		ShowParamMsg(str, p0, p1, p2)
+	END ShowParamMsg;
+
+	PROCEDURE (h: ShowHook) ShowParamStatus (IN str, p0, p1, p2: ARRAY OF CHAR);
+	BEGIN
+		ShowParamStatus(str, p0, p1, p2)
+	END ShowParamStatus;
+
+	PROCEDURE Init;
+		VAR
+			showHook: ShowHook;
+	BEGIN
+		NEW(showHook); Dialog.SetShowHook(showHook)
+	END Init;
+
+BEGIN
+	Init
+END HostDialog.

BlackBox/HostFonts.txt

@@ -0,0 +1,72 @@
+MODULE HostFonts;
+
+	(* for Texts *)
+
+	IMPORT Fonts;
+
+	CONST
+		defTypeface = "*";
+		defSize = 12 * Fonts.point;
+		defW = 161925;
+		defAsc = 142875;
+		defDsc = 28575;
+
+	TYPE
+		Font = POINTER TO RECORD (Fonts.Font) END;
+
+		Directory = POINTER TO RECORD (Fonts.Directory) END;
+
+	VAR
+		f: Font;
+		ti: Fonts.TypefaceInfo;
+		dir: Directory;
+
+	PROCEDURE (f: Font) GetBounds (OUT asc, dsc, w: INTEGER);
+	BEGIN
+		asc := defAsc;
+		dsc := defDsc;
+		w := defW
+	END GetBounds;
+
+	PROCEDURE (f: Font) StringWidth (IN s: ARRAY OF CHAR): INTEGER;
+	BEGIN
+		RETURN LEN(s$) * defW
+	END StringWidth;
+
+	PROCEDURE (f: Font) SStringWidth (IN s: ARRAY OF SHORTCHAR): INTEGER;
+	BEGIN
+		RETURN LEN(s$) * defW
+	END SStringWidth;
+
+	PROCEDURE (f: Font) IsAlien (): BOOLEAN;
+	BEGIN
+		RETURN TRUE
+	END IsAlien;
+
+	PROCEDURE (d: Directory) This (typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER): Font;
+	BEGIN
+		RETURN f
+	END This;
+
+	PROCEDURE (d: Directory) Default (): Font;
+	BEGIN
+		RETURN f
+	END Default;
+
+	PROCEDURE (d: Directory) TypefaceList (): Fonts.TypefaceInfo;
+	BEGIN
+		RETURN ti
+	END TypefaceList;
+
+	PROCEDURE Init;
+	BEGIN
+		NEW(f);
+		f.Init(defTypeface, defSize, {}, Fonts.normal);
+		NEW(ti);
+		ti.typeface := defTypeface;
+		NEW(dir); Fonts.SetDir(dir)
+	END Init;
+
+BEGIN
+	Init
+END HostFonts.

BlackBox/HostWindows.txt

@@ -0,0 +1,143 @@
+MODULE HostWindows;
+
+	(* for Views *)
+
+	IMPORT Windows, Controllers, Views, Files, Converters, Documents, Ports;
+
+	TYPE
+		Window = POINTER TO EXTENSIBLE RECORD (Windows.Window)
+			next: Window;	(* window ring, to prevent garbage collection of windows *)
+		END;
+
+		Directory = POINTER TO EXTENSIBLE RECORD (Windows.Directory)
+		END;
+
+	VAR
+		dir: Directory;
+		winAnchor: Window;	(* list of all windows, from top to bottom, first is dumy header *)
+
+	(** Window **)
+
+	PROCEDURE (w: Window) ForwardCtrlMsg (VAR msg: Controllers.Message), EXTENSIBLE;
+	BEGIN
+		HALT(126)
+	END ForwardCtrlMsg;
+
+	PROCEDURE (w: Window) SetSize (width, height: INTEGER);
+	BEGIN
+		HALT(126)
+	END SetSize;
+
+	PROCEDURE (w: Window) SetTitle (title: Views.Title);
+	BEGIN
+		HALT(126)
+	END SetTitle;
+
+	PROCEDURE (w: Window) RefreshTitle;
+	BEGIN
+		HALT(126)
+	END RefreshTitle;
+
+	PROCEDURE (w: Window) GetTitle (OUT title: Views.Title);
+	BEGIN
+		HALT(126)
+	END GetTitle;
+
+	PROCEDURE (w: Window) SetSpec (loc: Files.Locator; name: Files.Name; conv: Converters.Converter);
+	BEGIN
+		HALT(126)
+	END SetSpec;
+
+	PROCEDURE (w: Window) MouseDown (x, y, time: INTEGER; modifiers: SET);
+	BEGIN
+		HALT(126)
+	END MouseDown;
+
+	PROCEDURE (w: Window) KeyDown (ch: CHAR; buttons: SET);
+	BEGIN
+		HALT(126)
+	END KeyDown;
+
+	PROCEDURE (w: Window) Close;
+	BEGIN
+		ASSERT(w.frame # NIL, 20);
+		HALT(126);
+		w.Close^;
+		ASSERT(w.frame = NIL, 60)
+	END Close;
+
+	(* Directory *)
+
+	PROCEDURE (d: Directory) Open (
+		w: Windows.Window; doc: Documents.Document; flags: SET; name: Views.Title;
+		loc: Files.Locator; fname: Files.Name; conv: Converters.Converter
+	);
+		VAR p: Ports.Port;
+	BEGIN
+		WITH w: Window DO
+		END
+	END Open;
+
+	PROCEDURE (d: Directory) First (): Window;
+	BEGIN
+		RETURN winAnchor.next
+	END First;
+
+	PROCEDURE (d: Directory) Next (w: Windows.Window): Window;
+	BEGIN
+		IF w # NIL THEN RETURN w(Window).next ELSE RETURN NIL END
+	END Next;
+
+	PROCEDURE (d: Directory) New (): Window, EXTENSIBLE;
+		VAR w: Window;
+	BEGIN
+		NEW(w); RETURN w
+	END New;
+
+	PROCEDURE (d: Directory) Focus (target: BOOLEAN): Window;
+	BEGIN
+		HALT(126);
+		RETURN NIL
+	END Focus;
+
+	PROCEDURE (d: Directory) Select (w: Windows.Window; lazy: BOOLEAN);
+	BEGIN
+		WITH w: Window DO
+			HALT(126)
+		END
+	END Select;
+
+	PROCEDURE (d: Directory) GetThisWindow (p: Ports.Port; px, py: INTEGER;
+																		OUT x, y: INTEGER; OUT w: Windows.Window);
+	BEGIN
+		w := NIL
+	END GetThisWindow;
+
+	PROCEDURE (d: Directory) Close (w: Windows.Window);
+		VAR v, u: Windows.Window; h: Window;
+	BEGIN
+		h := winAnchor; WHILE (h.next # NIL) & (h.next # w) DO h := h.next END;
+		IF h.next = w THEN
+			IF ~w.sub THEN
+				v := w.link;
+				WHILE v # w DO u := v.link; v.Close; v := u END
+			END;
+			w.Close
+		END
+	END Close;
+
+	PROCEDURE (d: Directory) GetBounds (OUT w, h: INTEGER);
+	BEGIN
+		HALT(126)
+	END GetBounds;
+
+	PROCEDURE Init;
+		VAR d: Directory;
+	BEGIN
+		NEW(d); d.l := -1; d.t := -1; d.r := -1; d.b := -1; dir := d; Windows.SetDir(d);
+		NEW(winAnchor); winAnchor.next := NIL;	(* dummy header *)
+	END Init;
+
+BEGIN
+	Init
+END HostWindows.

BlackBox/Init-Interp.txt

@@ -1,7 +1,9 @@
 MODULE Init;
 
-	IMPORT Interp;
+	IMPORT Interp, HostFonts (* required for Texts *), HostWindows (* required for Windows *), HostDates (* for Dates.SetHook *), HostDialog (* required for Dialog.SetShowHook *), StdLog, StdDialog (* required for Views *), Converters (* .odc *);
 
 BEGIN
+	(* StdLog.Open; *)
+	Converters.Register("Documents.ImportDocument", "Documents.ExportDocument", "", "odc", {});
 	Interp.Init
 END Init.

BlackBox/Interp.txt

@@ -26,11 +26,11 @@ MODULE Interp;
 		IF (i < LEN(s)) & (s[i] # 0X) THEN
 			IF (i > 0) & (s[0] # '#') THEN
 				s[i] := 0X;
-				Dialog.Call(s, "", i);
+				Dialog.Call(s, " ", i);
 				IF i = 0 THEN
 					res := TRUE
 				ELSE
-					WriteInt(i); Console.WriteLn;
+					(* WriteInt(i); Console.WriteLn; *)
 					res := FALSE (* stop on Dialog.Call error *)
 				END
 			ELSE (* skip empty strings and comments *)

BlackBox/Lin/Mod/Dates.txt

@@ -0,0 +1,82 @@
+MODULE HostDates;
+
+	(* THIS IS TEXT COPY OF Dates.odc *)
+	(* DO NOT EDIT *)
+
+IMPORT	Dates, Strings, SYSTEM,Libc := LinLibc ;
+TYPE
+	DatesHook = POINTER TO RECORD (Dates.Hook) END;
+
+	
+	(*
+	Some conversions are needed between the Linux and the BlackBox representations of  dates. The following table shows the differences:
+(!)		Linux	BlackBox
+	year	from year 1900	from year 0000
+	month	range 0-11	range 1-12
+	weekday	0:sunday - 6:satruday	0:monday - 6:sunday
+	(!)	*)
+		
+	PROCEDURE (h: DatesHook) DateToString (d: Dates.Date; format: INTEGER; OUT str: ARRAY OF CHAR);
+		VAR sstr: ARRAY 64 OF SHORTCHAR; 
+			tm: Libc.tm; 
+			res: INTEGER; 
+	BEGIN
+		tm.tm_year := d.year - 1900; (* Linux counts years from 1900 but BlackBox from 0000 *)
+		tm.tm_mon := d.month - 1; tm.tm_mday := d.day;
+		tm.tm_wday := (Dates.DayOfWeek(d) + 1) MOD 7;		
+		CASE format OF
+		| Dates.short :	res := Libc.strftime(sstr, LEN(sstr), "%x", tm)
+		| Dates.abbreviated : res := Libc.strftime(sstr, LEN(sstr), "%a, %b %d, %Y", tm)
+		| Dates.long : 	res := Libc.strftime(sstr, LEN(sstr), "%A, %B %d, %Y", tm)
+		| Dates.plainAbbreviated :	res := Libc.strftime(sstr, LEN(sstr), "%b %d, %Y", tm)
+		| Dates.plainLong:	res := Libc.strftime(sstr, LEN(sstr), "%B %d, %Y", tm)
+		END;
+		IF res > 0 THEN str := sstr$ ELSE str := "invalid date"  END
+	END DateToString;
+
+		(** time **)
+	PROCEDURE (h: DatesHook) GetTime (OUT d: Dates.Date; OUT t: Dates.Time);
+		VAR time: Libc.time_t; tm: Libc.tm;
+	BEGIN
+		time := Libc.time(NIL);
+		tm := Libc.localtime(time);
+		d.year := tm.tm_year + 1900; (* Linux counts years from 1900 but BlackBox from 0000 *)
+		d.month := tm.tm_mon + 1;  d.day := tm.tm_mday;
+		t.hour := tm.tm_hour; t.minute := tm.tm_min; t.second := tm.tm_sec
+	END GetTime;
+
+	PROCEDURE (h: DatesHook) GetUTCBias (OUT bias: INTEGER);
+		VAR time: Libc.time_t; tm: Libc.tm;
+	BEGIN
+		time := Libc.time(NIL);
+		tm := Libc.localtime(time); 
+		bias := tm.tm_gmtoff DIV 60;
+	END GetUTCBias; 
+
+	PROCEDURE (h: DatesHook) GetUTCTime (OUT d: Dates.Date; OUT t: Dates.Time);
+		VAR time: Libc.time_t; tm: Libc.tm;
+	BEGIN
+		time := Libc.time(NIL);
+		tm := Libc.gmtime(time);
+		d.year := tm.tm_year + 1900; (* Linux counts years from 1900 but BlackBox from 0000 *)
+		d.month := tm.tm_mon + 1;  d.day := tm.tm_mday;
+		t.hour := tm.tm_hour; t.minute := tm.tm_min; t.second := tm.tm_sec
+	END GetUTCTime;
+
+	PROCEDURE (h: DatesHook) TimeToString (t: Dates.Time; OUT str: ARRAY OF CHAR);
+		VAR tm: Libc.tm; sstr: ARRAY 64 OF SHORTCHAR; res: INTEGER;
+	BEGIN
+		tm.tm_hour := t.hour; tm.tm_min := t.minute; tm.tm_sec := t.second;
+		res := Libc.strftime(sstr, LEN(sstr), "%X", tm);
+		IF res > 0 THEN str := sstr$ELSE str := "invalid time"  END
+	END TimeToString;
+
+	PROCEDURE Init;
+	VAR 	datesHook: DatesHook; 
+	BEGIN
+		NEW(datesHook); Dates.SetHook(datesHook);
+	END Init;
+BEGIN
+	Init
+END HostDates.
+

BlackBox/StdLog.txt

@@ -0,0 +1,29 @@
+MODULE StdLog;
+
+	(* for Dev *)
+
+	IMPORT Console, Strings;
+
+	PROCEDURE Char* (c: CHAR);
+	BEGIN
+		Console.WriteChar(c)
+	END Char;
+
+	PROCEDURE String* (IN s: ARRAY OF CHAR);
+	BEGIN
+		Console.WriteStr(s)
+	END String;
+
+	PROCEDURE Int* (x: LONGINT);
+		VAR s: ARRAY 32 OF CHAR;
+	BEGIN
+		Strings.IntToString(x, s);
+		Console.WriteStr(s)
+	END Int;
+
+	PROCEDURE Ln*;
+	BEGIN
+		Console.WriteLn
+	END Ln;
+
+END StdLog.

BlackBox/build

@@ -81,21 +81,45 @@ LindevCompiler.Compile('Lindev/Mod', 'CPV486.txt')
 LindevCompiler.Compile('Lindev/Mod', 'Compiler.txt')
 LindevCompiler.Compile('Lindev/Mod', 'ElfLinker16.txt')
 
+# LindevCompiler.Compile('Std/Mod', 'Log.txt')
+LindevCompiler.Compile('', 'StdLog.txt')
+# LindevCompiler.Compile('Std/Mod', 'Out.txt')
+
+LindevCompiler.Compile('Dev/Mod', 'Markers.txt')
+# LindevCompiler.Compile('Dev/Mod', 'Commanders.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPM.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPT.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPH.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPB.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPE.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPS.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPP.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPL486.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPC486.txt')
+LindevCompiler.Compile('Dev/Mod', 'CPV486.txt')
+
 ### simple dev interpreter (include LindevCompiler and LindevElfLinker)
 
 LindevCompiler.Compile('', 'Views.txt')
 LindevCompiler.Compile('Std/Mod', 'Interpreter.txt')
 
 LindevCompiler.Compile('', 'Interp.txt')
-LindevCompiler.Compile('', 'Init-Interp.txt')
 
 # LindevElfLinker.LinkDll('libBBInterp.so := Kernel+ Kernel_so_init# Console Math Strings LinConsole Files HostFiles LindevCPM LindevCPT LindevCPS LindevCPH LindevCPB LindevCPP LindevCPE LindevCPL486 LindevCPC486 LindevCPV486 LindevCompiler LindevElfLinker Dialog Meta Views StdInterpreter Interp#')
 LindevElfLinker.LinkDll('libBBInterp.so := Kernel+ Console Math Strings LinConsole Files HostFiles LindevCPM LindevCPT LindevCPS LindevCPH LindevCPB LindevCPP LindevCPE LindevCPL486 LindevCPC486 LindevCPV486 LindevCompiler LindevElfLinker Dialog Meta Views StdInterpreter Interp#')
 
-### BlackBox
-
 LindevCompiler.Compile('System/Mod', 'Views.txt')
 LindevCompiler.Compile('Std/Mod', 'Interpreter.txt')
 
+### BlackBox
+
+LindevCompiler.Compile('', 'HostFonts.txt')
+LindevCompiler.Compile('', 'HostDialog.txt')
+LindevCompiler.Compile('', 'HostWindows.txt')
+# HostDates:
+LindevCompiler.Compile('Lin/Mod', 'Dates.txt')
+
+LindevCompiler.Compile('', 'Init-Interp.txt')
+
 LindevElfLinker.LinkDll('libBB.so := Kernel+ Files HostFiles StdLoader')
 DATA