Dev0 removed

new/Cons/Mod/Interp.txt

@@ -1,128 +0,0 @@
-MODULE ConsInterp;
-
-	(*
-		A. V. Shiryaev, 2012.09
-	*)
-
-	IMPORT
-		Console,
-		Strings, Dialog,
-		DevCommanders, TextModels,
-		StdLog;
-
-	VAR
-		textR: TextModels.Reader;
-
-	PROCEDURE ShowStdLog;
-		VAR c: CHAR;
-	BEGIN
-		StdLog.text.Append(StdLog.buf);
-
-		textR.SetPos(0);
-		textR.ReadChar(c);
-		WHILE ~textR.eot DO
-			IF c = 0DX THEN
-				Console.WriteLn
-			ELSE
-				Console.WriteChar(c)
-			END;
-			textR.ReadChar(c)
-		END;
-		StdLog.text.Delete(0, StdLog.text.Length())
-	END ShowStdLog;
-
-	PROCEDURE Call1 (IN s: ARRAY OF CHAR; i: INTEGER): BOOLEAN;
-		VAR j: INTEGER;
-			res: INTEGER;
-			par: DevCommanders.Par;
-			m: TextModels.Model; w: TextModels.Writer;
-	BEGIN
-		(* ASSERT 0X in s[ i:LEN(s) ) *)
-		j := i;
-		WHILE s[j] # 0X DO INC(j) END;
-		IF j > i THEN
-			m := TextModels.dir.New();
-			w := m.NewWriter(NIL);
-			WHILE i < j DO
-				w.WriteChar(s[i]);
-				INC(i)
-			END;
-			NEW(par); par.text := m; par.beg := 0; par.end := m.Length() - 1;
-			DevCommanders.par := par
-		END;
-		Dialog.Call(s, " ", res);
-		DevCommanders.par := NIL;
-		ShowStdLog;
-	RETURN res = 0
-	END Call1;
-
-	PROCEDURE Call0 (VAR s: ARRAY OF CHAR): BOOLEAN;
-		VAR i: INTEGER;
-			res: BOOLEAN;
-			inStr: BOOLEAN;
-	BEGIN
-		(* ASSERT s is 0X terminated and not empty *)
-		i := 0;
-		WHILE (s[i] # 0X) & (s[i] # ' ') & (s[i] # '(') DO
-			INC(i)
-		END;
-		IF s[i] = 0X THEN
-			res := Call1(s, i)
-		ELSIF s[i] = ' ' THEN
-			s[i] := 0X;
-			res := Call1(s, i + 1)
-		ELSE (* s[i] = '(' *)
-			INC(i);
-			inStr := FALSE;
-			WHILE (s[i] # 0X) & ~(~inStr & (s[i] = ')')) DO
-				IF s[i] = "'" THEN inStr := ~inStr END;
-				INC(i)
-			END;
-			IF s[i] # 0X THEN
-				INC(i);
-				IF s[i] = 0X THEN
-					res := Call1(s, i)
-				ELSE
-					s[i] := 0X;
-					res := Call1(s, i + 1)
-				END
-			ELSE
-				res := FALSE
-			END
-		END;
-	RETURN res
-	END Call0;
-
-	PROCEDURE Call (VAR s: ARRAY OF CHAR): BOOLEAN;
-		VAR i: INTEGER;
-			res: BOOLEAN;
-	BEGIN
-		i := 0;
-		WHILE (i < LEN(s)) & (s[i] # 0AX) & (s[i] # 0DX) & (s[i] # 0X) DO
-			INC(i)
-		END;
-		IF (i < LEN(s)) & (s[i] # 0X) THEN
-			IF (i > 0) & (s[0] # '#') THEN
-				s[i] := 0X;
-				res := Call0(s)
-			ELSE (* skip empty strings and comments *)
-				res := TRUE
-			END
-		ELSE (* end of input *)
-			res := FALSE
-		END;
-	RETURN res
-	END Call;
-
-	PROCEDURE Run*;
-		VAR s: ARRAY 1024 OF CHAR;
-	BEGIN
-		Console.ReadLn(s);
-		WHILE Call(s) DO
-			Console.ReadLn(s)
-		END
-	END Run;
-
-BEGIN
-	textR := StdLog.text.NewReader(NIL)
-END ConsInterp.

new/Cons/Mod/Log.txt

@@ -1,193 +0,0 @@
-MODULE ConsLog;
-
-	(*
-		A. V. Shiryaev, 2012.10
-
-		Log.Hook implementation
-		based on StdLog
-	*)
-
-	IMPORT
-		Log, Views, Dialog,
-		TextModels, TextMappers,
-		Console;
-
-	TYPE
-		LogHook = POINTER TO RECORD (Log.Hook) END;
-
-	VAR
-		logAlerts: BOOLEAN;
-		subOut: TextMappers.Formatter;
-
-		buf: TextModels.Model;
-		textR: TextModels.Reader;
-
-	(* Sub support *)
-
-	PROCEDURE* Guard (o: ANYPTR): BOOLEAN;
-	BEGIN
-		RETURN o # NIL
-	END Guard;
-
-	PROCEDURE* ClearBuf;
-		VAR subBuf: TextModels.Model;
-	BEGIN
-		subBuf := subOut.rider.Base(); subBuf.Delete(0, subBuf.Length())
-	END ClearBuf;
-
-	PROCEDURE* FlushBuf;
-		VAR c: CHAR;
-	BEGIN
-		IF buf.Length() > 0 THEN
-			textR.SetPos(0);
-			textR.ReadChar(c);
-			WHILE ~textR.eot DO
-				IF c = 0DX THEN
-					Console.WriteLn
-				ELSE
-					Console.WriteChar(c)
-				END;
-				textR.ReadChar(c)
-			END;
-			buf.Delete(0, buf.Length())
-		END
-	END FlushBuf;
-
-	PROCEDURE* SubFlush;
-	BEGIN
-		IF Log.synch THEN
-			FlushBuf;
-			(* IF Log.force THEN Views.RestoreDomain(text.Domain()) END *)
-		END;
-	END SubFlush;
-
-	PROCEDURE (log: LogHook) Guard* (o: ANYPTR): BOOLEAN;
-	BEGIN RETURN Guard(o)
-	END Guard;
-
-	PROCEDURE (log: LogHook) ClearBuf*;
-	BEGIN ClearBuf
-	END ClearBuf;
-
-	PROCEDURE (log: LogHook) FlushBuf*;
-	BEGIN FlushBuf
-	END FlushBuf;
-
-	PROCEDURE (log: LogHook) Beep*;
-	BEGIN Dialog.Beep
-	END Beep;
-
-	PROCEDURE (log: LogHook) Char* (ch: CHAR);
-	BEGIN
-		subOut.WriteChar(ch); SubFlush
-	END Char;
-
-	PROCEDURE (log: LogHook) Int* (n: INTEGER);
-	BEGIN
-		subOut.WriteChar(" "); subOut.WriteInt(n); SubFlush
-	END Int;
-
-	PROCEDURE (log: LogHook) Real* (x: REAL);
-	BEGIN
-		subOut.WriteChar(" "); subOut.WriteReal(x); SubFlush
-	END Real;
-
-	PROCEDURE (log: LogHook) String* (IN str: ARRAY OF CHAR);
-	BEGIN
-		subOut.WriteString(str); SubFlush
-	END String;
-
-	PROCEDURE (log: LogHook) Bool* (x: BOOLEAN);
-	BEGIN
-		subOut.WriteChar(" "); subOut.WriteBool(x); SubFlush
-	END Bool;
-
-	PROCEDURE (log: LogHook) Set* (x: SET);
-	BEGIN
-		subOut.WriteChar(" "); subOut.WriteSet(x); SubFlush
-	END Set;
-
-	PROCEDURE (log: LogHook) IntForm* (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
-	BEGIN
-		subOut.WriteIntForm(x, base, minWidth, fillCh, showBase); SubFlush
-	END IntForm;
-
-	PROCEDURE (log: LogHook) RealForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
-	BEGIN
-		subOut.WriteRealForm(x, precision, minW, expW, fillCh); SubFlush
-	END RealForm;
-
-	PROCEDURE (log: LogHook) Tab*;
-	BEGIN
-		subOut.WriteTab; SubFlush
-	END Tab;
-
-	PROCEDURE (log: LogHook) Ln*;
-	BEGIN
-		subOut.WriteLn; SubFlush;
-		(* IF Log.synch THEN Views.RestoreDomain(text.Domain()) END *)
-	END Ln;
-
-	PROCEDURE (log: LogHook) Para*;
-	BEGIN
-		subOut.WritePara; SubFlush;
-		(* IF Log.synch THEN Views.RestoreDomain(text.Domain()) END *)
-	END Para;
-
-	PROCEDURE (log: LogHook) View* (v: ANYPTR);
-	BEGIN
-		IF (v # NIL) & (v IS Views.View) THEN
-			subOut.WriteView(v(Views.View)); SubFlush
-		END
-	END View;
-
-	PROCEDURE (log: LogHook) ViewForm* (v: ANYPTR; w, h: INTEGER);
-	BEGIN
-		ASSERT(v # NIL, 20);
-		IF (v # NIL) & (v IS Views.View) THEN
-			subOut.WriteViewForm(v(Views.View), w, h); SubFlush
-		END
-	END ViewForm;
-
-	PROCEDURE (log: LogHook) ParamMsg* (IN s, p0, p1, p2: ARRAY OF CHAR);
-		VAR msg: ARRAY 256 OF CHAR; i: INTEGER; ch: CHAR;
-	BEGIN
-		IF logAlerts THEN
-			(* IF Log.synch THEN Open END; *)
-			Dialog.MapParamString(s, p0, p1, p2, msg);
-			i := 0; ch := msg[0];
-			WHILE ch # 0X DO
-				IF ch = TextModels.line THEN subOut.WriteLn
-				ELSIF ch = TextModels.para THEN subOut.WritePara
-				ELSIF ch = TextModels.tab THEN subOut.WriteTab
-				ELSIF ch >= " " THEN subOut.WriteChar(ch)
-				END;
-				INC(i); ch := msg[i];
-			END;
-			subOut.WriteLn; SubFlush
-		(* ELSE
-			HostDialog.ShowParamMsg(s, p0, p1, p2) *)
-		END
-	END ParamMsg;
-
-
-	PROCEDURE AttachSubLog;
-		VAR h: LogHook;
-	BEGIN
-		subOut.ConnectTo(TextModels.dir.New());
-		buf := subOut.rider.Base();
-		textR := buf.NewReader(NIL);
-		NEW(h);
-		Log.SetHook(h);
-	END AttachSubLog;
-
-	PROCEDURE DetachSubLog;
-	BEGIN
-		Log.SetHook(NIL)
-	END DetachSubLog;
-
-BEGIN
-	AttachSubLog
-CLOSE
-	DetachSubLog;
-END ConsLog.

new/Dev/Mod/CPB.txt

@@ -1,2238 +0,0 @@
-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.

new/Dev/Mod/CPC486.txt

@@ -1,2333 +0,0 @@
-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.

new/Dev/Mod/CPE.txt

@@ -1,1105 +0,0 @@
-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.

new/Dev/Mod/CPH.txt

@@ -1,291 +0,0 @@
-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;
-		

new/Dev/Mod/CPL486.txt

@@ -1,1057 +0,0 @@
-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.

new/Dev/Mod/CPM.txt

@@ -1,853 +0,0 @@
-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.

new/Dev/Mod/CPP.txt

@@ -1,1650 +0,0 @@
-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.

new/Dev/Mod/CPS.txt

@@ -1,367 +0,0 @@
-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.

new/Dev/Mod/CPT.txt

@@ -1,1890 +0,0 @@
-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

new/Dev/Mod/CPV486.txt

@@ -1,1774 +0,0 @@
-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.

new/Dev/Mod/Commanders.txt

@@ -1,361 +0,0 @@
-MODULE DevCommanders;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Commanders.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT
-		Kernel, Fonts, Ports, Stores, Models, Views, Controllers, Properties, Dialog, Controls,
-		TextModels, TextSetters, TextMappers, Services, StdLog;
-
-	CONST
-		(* additional Scan types *)
-		ident = 19; qualident = 20; execMark = 21;
-
-		point = Ports.point;
-
-		minVersion = 0; maxVersion = 0; maxStdVersion = 0;
-
-
-	TYPE
-		View* = POINTER TO ABSTRACT RECORD (Views.View)
-		END;
-		EndView* = POINTER TO ABSTRACT RECORD (Views.View)
-		END;
-
-		Par* = POINTER TO RECORD
-			text*: TextModels.Model;
-			beg*, end*: INTEGER
-		END;
-
-		Directory* = POINTER TO ABSTRACT RECORD END;
-
-
-		StdView = POINTER TO RECORD (View) END;
-		StdEndView = POINTER TO RECORD (EndView) END;
-
-		StdDirectory = POINTER TO RECORD (Directory) END;
-
-		Scanner = RECORD
-			s: TextMappers.Scanner;
-			ident: ARRAY LEN(Kernel.Name) OF CHAR;
-			qualident: ARRAY LEN(Kernel.Name) * 2 - 1 OF CHAR
-		END;
-		
-		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
-
-	VAR
-		par*: Par;
-		dir-, stdDir-: Directory;
-		
-		cleaner: TrapCleaner;
-		cleanerInstalled: BOOLEAN;
-
-
-	(** Cleaner **)
-
-	PROCEDURE (c: TrapCleaner) Cleanup;
-	BEGIN
-		par := NIL;
-		cleanerInstalled := FALSE;
-	END Cleanup;
-	
-	(** View **)
-
-	PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
-	BEGIN
-		v.Externalize^(wr);
-		wr.WriteVersion(maxVersion);
-		wr.WriteXInt(execMark)
-	END Externalize;
-
-	PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
-		VAR thisVersion, type: INTEGER;
-	BEGIN
-		v.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxVersion, thisVersion);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadXInt(type)
-	END Internalize;
-
-
-	(** Directory **)
-
-	PROCEDURE (d: Directory) New* (): View, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewEnd* (): EndView, NEW, ABSTRACT;
-
-
-	(* auxilliary procedures *)
-
-	PROCEDURE IsIdent (VAR s: ARRAY OF CHAR): BOOLEAN;
-		VAR i: INTEGER; ch: CHAR;
-	BEGIN
-		ch := s[0]; i := 1;
-		IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
-			REPEAT
-				ch := s[i]; INC(i)
-			UNTIL ~( ("0" <= ch) & (ch <= "9") OR ("A" <= CAP(ch)) & (CAP(ch) <= "Z")
-						OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") );
-			RETURN (ch = 0X) & (i <= LEN(Kernel.Name))
-		ELSE
-			RETURN FALSE
-		END
-	END IsIdent;
-
-	PROCEDURE Scan (VAR s: Scanner);
-		VAR done: BOOLEAN;
-	BEGIN
-		s.s.Scan;
-		IF (s.s.type = TextMappers.view) THEN
-			IF Properties.ThisType(s.s.view, "DevCommanders.View") # NIL THEN s.s.type := execMark END
-		ELSIF (s.s.type = TextMappers.string) & TextMappers.IsQualIdent(s.s.string) THEN
-			s.s.type := qualident; s.qualident := s.s.string$
-		ELSIF (s.s.type = TextMappers.string) & IsIdent(s.s.string) THEN
-			s.ident := s.s.string$;
-			TextMappers.ScanQualIdent(s.s, s.qualident, done);
-			IF done THEN s.s.type := qualident ELSE s.s.type := ident END
-		END
-	END Scan;
-
-	PROCEDURE GetParExtend (r: TextModels.Reader; VAR end: INTEGER);
-		VAR v, v1: Views.View;
-	BEGIN
-		REPEAT r.ReadView(v); 
-			IF v # NIL THEN 
-				v1 := v;
-				v := Properties.ThisType(v1, "DevCommanders.View") ;
-				IF v = NIL THEN v := Properties.ThisType(v1, "DevCommanders.EndView")  END
-			END
-		UNTIL r.eot OR (v # NIL);
-		end := r.Pos(); IF ~r.eot THEN DEC(end) END
-	END GetParExtend;
-
-	PROCEDURE Unload (cmd: Dialog.String);
-		VAR modname: Kernel.Name; str: Dialog.String; i: INTEGER; ch: CHAR; mod: Kernel.Module;
-	BEGIN
-		i := 0; ch := cmd[0];
-		WHILE (ch # 0X) & (ch # ".") DO modname[i] := SHORT(ch); INC(i); ch := cmd[i] END;
-		modname[i] := 0X;
-		mod := Kernel.ThisLoadedMod(modname);
-		IF mod # NIL THEN
-			Kernel.UnloadMod(mod);
-			IF mod.refcnt < 0 THEN
-				str := modname$;
-				Dialog.MapParamString("#Dev:Unloaded", str, "", "", str);
-				StdLog.String(str); StdLog.Ln;
-				Controls.Relink
-			ELSE
-				str := modname$;
-				Dialog.ShowParamMsg("#Dev:UnloadingFailed", str, "", "")
-			END
-		END
-	END Unload;
-
-	PROCEDURE Execute (t: TextModels.Model; pos: INTEGER; VAR end: INTEGER; unload: BOOLEAN);
-		VAR s: Scanner; beg, res: INTEGER; cmd: Dialog.String;
-	BEGIN
-		end := t.Length();
-		s.s.ConnectTo(t); s.s.SetPos(pos); s.s.SetOpts({TextMappers.returnViews});
-		Scan(s); ASSERT(s.s.type = execMark, 100);
-		Scan(s);
-		IF s.s.type IN {qualident, TextMappers.string} THEN
-			beg := s.s.Pos() - 1; GetParExtend(s.s.rider, end);
-			ASSERT(~cleanerInstalled, 101);
-			Kernel.PushTrapCleaner(cleaner); cleanerInstalled := TRUE;
-			NEW(par); par.text := t; par.beg := beg; par.end := end;
-			IF s.s.type = qualident THEN cmd := s.qualident$ ELSE cmd := s.s.string$ END;
-			IF unload (* & (s.s.type = qualident)*) THEN Unload(cmd) END;
-			Dialog.Call(cmd, " ",  res);
-			par := NIL;
-			Kernel.PopTrapCleaner(cleaner); cleanerInstalled := FALSE;
-		END
-	END Execute;
-
-	PROCEDURE Track (v: View; f: Views.Frame; x, y: INTEGER; buttons: SET);
-		VAR c: Models.Context; w, h, end: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
-	BEGIN
-		c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
-		REPEAT
-			IF in # in0 THEN
-				f.MarkRect(0, 0, w, 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(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
-			WITH c:TextModels.Context DO
-				Execute(c.ThisModel(), c.Pos(), end,Controllers.modify IN buttons)
-			ELSE Dialog.Beep
-			END
-		END
-	END Track;
-
-	(* StdView *)
-
-	PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
-	BEGIN
-		v.Externalize^(wr);
-		wr.WriteVersion(maxStdVersion)
-	END Externalize;
-
-	PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		v.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxStdVersion, thisVersion)
-	END Internalize;
-
-	PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-		CONST u = point;
-		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
-			size, d, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
-	BEGIN
-		ASSERT(v.context # NIL, 20);
-		c := v.context;
-		WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
-		ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
-		END;
-		font.GetBounds(asc, dsc, fw);
-		size := asc + dsc; d := size DIV 2;
-		f.DrawOval(u, 0, u + size, size, Ports.fill, color);
-		s := "!";
-		w := font.StringWidth(s);
-		f.DrawString(u + d - w DIV 2, size - dsc, Ports.background, s, font)
-	END Restore;
-
-	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)
-		| msg: Controllers.PollCursorMsg DO
-			msg.cursor := Ports.refCursor
-		ELSE
-		END
-	END HandleCtrlMsg;
-
-	PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
-		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
-	BEGIN
-		WITH msg: Properties.Preference DO
-			WITH msg: Properties.SizePref 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, dsc, fw);
-				msg.h := asc + dsc; msg.w := msg.h + 2 * point
-			| msg: Properties.ResizePref DO
-				msg.fixed := TRUE
-			| msg: Properties.FocusPref DO
-				msg.hotFocus := TRUE
-			| 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, fw)
-			| msg: Properties.TypePref DO
-				IF Services.Is(v, msg.type) THEN msg.view := v END
-			ELSE
-			END
-		ELSE
-		END
-	END HandlePropMsg;
-	
-	
-	(* StdEndView *)
-
-	PROCEDURE (v: StdEndView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-		CONST u = point;
-		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
-			size, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
-			points: ARRAY 3 OF Ports.Point;
-	BEGIN
-		ASSERT(v.context # NIL, 20);
-		c := v.context;
-		WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
-		ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
-		END;
-		font.GetBounds(asc, dsc, fw);
-		size := asc + dsc;
-		points[0].x := 0; points[0].y := size;
-		points[1].x := u + (size DIV 2); points[1].y := size DIV 2;
-		points[2].x := u + (size DIV 2); points[2].y := size;     
-		f.DrawPath(points, 3, Ports.fill, color, Ports.closedPoly)
-	END Restore;
-	
-	PROCEDURE (v: StdEndView) HandlePropMsg (VAR msg: Properties.Message);
-		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
-	BEGIN
-		WITH msg: Properties.Preference DO
-			WITH msg: Properties.SizePref 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, dsc, fw);
-				msg.h := asc + dsc; msg.w := (msg.h + 2 * point) DIV 2
-			| msg: Properties.ResizePref DO
-				msg.fixed := TRUE
-			| msg: Properties.FocusPref DO
-				msg.hotFocus := TRUE
-			| 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, fw)
-			| msg: Properties.TypePref DO
-				IF Services.Is(v, msg.type) THEN msg.view := v END
-			ELSE
-			END
-		ELSE
-		END
-	END HandlePropMsg;
-
-	(* StdDirectory *)
-
-	PROCEDURE (d: StdDirectory) New (): View;
-		VAR v: StdView;
-	BEGIN
-		NEW(v); RETURN v
-	END New;
-	
-	PROCEDURE (d: StdDirectory) NewEnd (): EndView;
-		VAR v: StdEndView;
-	BEGIN
-		NEW(v); RETURN v
-	END NewEnd;
-
-	PROCEDURE Deposit*;
-	BEGIN
-		Views.Deposit(dir.New())
-	END Deposit;
-
-	PROCEDURE DepositEnd*;
-	BEGIN
-		Views.Deposit(dir.NewEnd())
-	END DepositEnd;
-
-	PROCEDURE SetDir* (d: Directory);
-	BEGIN
-		dir := d
-	END SetDir;
-
-	PROCEDURE Init;
-		VAR d: StdDirectory;
-	BEGIN
-		NEW(d); dir := d; stdDir := d;
-		NEW(cleaner); cleanerInstalled := FALSE;
-	END Init;
-
-BEGIN
-	Init
-END DevCommanders.

new/Dev/Mod/Compiler.txt

@@ -1,348 +0,0 @@
-MODULE DevCompiler;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Compiler.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT Kernel,
-		Files, Views, Dialog, Controls,
-		TextModels, TextMappers, TextViews, TextControllers,
-		StdLog, StdDialog,
-		DevMarkers, DevCommanders, DevSelectors,
-		DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPV := DevCPV486;
-
-	CONST
-		(* compiler options: *)
-		checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5; srcpos = 6; reallib = 7; signatures = 8;
-		hint = 29; oberon = 30; errorTrap = 31;
-		defopt = {checks, assert, obj, ref, allref, srcpos, signatures};
-
-		(* additional scanner types *)
-		import = 100; module = 101; semicolon = 102; becomes = 103; comEnd = 104;
-
-	VAR
-		sourceR: TextModels.Reader;
-		s: TextMappers.Scanner;
-		str: Dialog.String;
-		found: BOOLEAN;	(* DevComDebug was found -> DTC *)
-
-	PROCEDURE Module (source: TextModels.Reader; opt: SET; log: TextModels.Model; VAR error: BOOLEAN);
-		VAR ext, new: BOOLEAN; p: DevCPT.Node;
-	BEGIN
-		DevCPM.Init(source, log);
-		IF found THEN INCL(DevCPM.options, DevCPM.comAware) END;
-		IF errorTrap IN opt THEN INCL(DevCPM.options, DevCPM.trap) END;
-		IF oberon IN opt THEN INCL(DevCPM.options, DevCPM.oberon) END;
-		DevCPT.Init(opt);
-		DevCPB.typSize := DevCPV.TypeSize;
-		DevCPT.processor := DevCPV.processor;
-		DevCPP.Module(p);
-		IF DevCPM.noerr THEN
-			IF DevCPT.libName # "" THEN EXCL(opt, obj) END;
-(*
-			IF errorTrap IN opt THEN DevCPDump.DumpTree(p) END;
-*)
-			DevCPV.Init(opt); DevCPV.Allocate; DevCPT.Export(ext, new);
-			IF DevCPM.noerr & (obj IN opt) THEN
-				DevCPV.Module(p)
-			END;
-			DevCPV.Close
-		END;
-		IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
-		ELSE DevCPM.DeleteNewSym
-		END;
-		DevCPT.Close;
-		error := ~DevCPM.noerr;
-		DevCPM.Close;
-		p := NIL;
-		Kernel.FastCollect;
-		IF error THEN
-			DevCPM.InsertMarks(source.Base());
-			DevCPM.LogWLn; DevCPM.LogWStr(" ");
-			IF DevCPM.errors = 1 THEN
-				Dialog.MapString("#Dev:OneErrorDetected", str)
-			ELSE
-				DevCPM.LogWNum(DevCPM.errors, 0); Dialog.MapString("#Dev:ErrorsDetected", str)
-			END;
-			StdLog.String(str)
-		ELSE
-			IF hint IN opt THEN DevCPM.InsertMarks(source.Base()) END;
-			DevCPM.LogWStr("  "); DevCPM.LogWNum(DevCPE.pc, 8);
-			DevCPM.LogWStr("  "); DevCPM.LogWNum(DevCPE.dsize, 8)
-		END;
-		DevCPM.LogWLn
-	END Module;
-
-	PROCEDURE Scan (VAR s: TextMappers.Scanner);
-	BEGIN
-		s.Scan;
-		IF s.type = TextMappers.string THEN
-			IF s.string = "MODULE" THEN s.type := module END
-		ELSIF s.type = TextMappers.char THEN
-			IF s.char = "(" THEN
-				IF s.rider.char = "*" THEN
-					s.rider.Read;
-					REPEAT Scan(s) UNTIL (s.type = TextMappers.eot) OR (s.type = comEnd);
-					Scan(s)
-				END
-			ELSIF s.char = "*" THEN
-				IF s.rider.char = ")" THEN s.rider.Read; s.type := comEnd END
-			END
-		END
-	END Scan;
-
-	PROCEDURE Do (source, log: TextModels.Model; beg: INTEGER; opt: SET; VAR error: BOOLEAN);
-		VAR s: TextMappers.Scanner;
-	BEGIN
-		Dialog.MapString("#Dev:Compiling", str);
-		StdLog.String(str); StdLog.Char(" ");
-		s.ConnectTo(source); s.SetPos(beg);
-		Scan(s);
-		WHILE (s.type # TextMappers.eot) & (s.type # module) DO Scan(s) END;
-		IF s.type = module THEN
-			Scan(s);
-			IF s.type = TextMappers.string THEN
-				StdLog.Char('"'); StdLog.String(s.string); StdLog.Char('"')
-			END
-		END;
-		sourceR := source.NewReader(NIL); sourceR.SetPos(beg);
-		Module(sourceR, opt, log, error)
-	END Do;
-
-
-	PROCEDURE Open;
-	BEGIN
-		Dialog.ShowStatus("#Dev:Compiling");
-		StdLog.buf.Delete(0, StdLog.buf.Length())
-	END Open;
-
-	PROCEDURE Close;
-	BEGIN
-		StdLog.text.Append(StdLog.buf);
-		IF DevCPM.noerr THEN Dialog.ShowStatus("#Dev:Ok")
-		END;
-		sourceR := NIL;
-		Kernel.Cleanup
-	END Close;
-
-	PROCEDURE Compile*;
-		VAR t: TextModels.Model; error: BOOLEAN;
-	BEGIN
-		Open;
-		t := TextViews.FocusText();
-		IF t # NIL THEN
-			Do(t, StdLog.text, 0, defopt, error);
-			IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
-		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
-		END;
-		Close
-	END Compile;
-
-	PROCEDURE CompileOpt* (opt: ARRAY OF CHAR);
-		VAR t: TextModels.Model; error: BOOLEAN; i: INTEGER; opts: SET;
-	BEGIN
-		i := 0; opts := defopt;
-		WHILE opt[i] # 0X DO
-			IF opt[i] = "-" THEN
-				IF srcpos IN opts THEN EXCL(opts, srcpos)
-				ELSIF allref IN opts THEN EXCL(opts, allref)
-				ELSIF ref IN opts THEN EXCL(opts, ref)
-				ELSE EXCL(opts, obj)
-				END
-			ELSIF opt[i] = "!" THEN
-				IF assert IN opts THEN EXCL(opts, assert)
-				ELSE EXCL(opts, checks)
-				END
-			ELSIF opt[i] = "+" THEN INCL(opts, allchecks)
-			ELSIF opt[i] = "?" THEN INCL(opts, hint)
-			ELSIF opt[i] = "@" THEN INCL(opts, errorTrap)
-			ELSIF opt[i] = "$" THEN INCL(opts, oberon)
-			END;
-			INC(i)
-		END;
-		Open;
-		t := TextViews.FocusText();
-		IF t # NIL THEN
-			Do(t, StdLog.text, 0, opts, error);
-			IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
-		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
-		END;
-		Close
-	END CompileOpt;
-
-	PROCEDURE CompileText* (text: TextModels.Model; beg: INTEGER; OUT error: BOOLEAN);
-	BEGIN
-		ASSERT(text # NIL, 20); ASSERT((beg >= 0) & (beg < text.Length()), 21);
-		Open;
-		Do(text, StdLog.text, beg, defopt, error);
-		IF error THEN DevMarkers.ShowFirstError(text, TextViews.focusOnly) END;
-		Close
-	END CompileText;
-
-	PROCEDURE CompileAndUnload*;
-		VAR t: TextModels.Model; error: BOOLEAN; mod: Kernel.Module; n: ARRAY 256 OF CHAR;
-	BEGIN
-		Open;
-		t := TextViews.FocusText();
-		IF t # NIL THEN
-			Do(t, StdLog.text, 0, defopt, error);
-			IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly)
-			ELSE
-				mod := Kernel.ThisLoadedMod(DevCPT.SelfName);
-				IF mod # NIL THEN
-					Kernel.UnloadMod(mod);
-					n := DevCPT.SelfName$;
-					IF mod.refcnt < 0 THEN
-						Dialog.MapParamString("#Dev:Unloaded", n, "", "", str);
-						StdLog.String(str); StdLog.Ln;
-						Controls.Relink
-					ELSE
-						Dialog.MapParamString("#Dev:UnloadingFailed", n, "", "", str);
-						StdLog.String(str); StdLog.Ln
-					END
-				END
-			END
-		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
-		END;
-		Close
-	END CompileAndUnload;
-
-	PROCEDURE CompileSelection*;
-		VAR c: TextControllers.Controller; t: TextModels.Model; beg, end: INTEGER; error: BOOLEAN;
-	BEGIN
-		Open;
-		c := TextControllers.Focus();
-		IF c # NIL THEN
-			t := c.text;
-			IF c.HasSelection() THEN
-				c.GetSelection(beg, end); Do(t, StdLog.text, beg, defopt, error);
-				IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
-			ELSE Dialog.ShowMsg("#Dev:NoSelectionFound")
-			END
-		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
-		END;
-		Close
-	END CompileSelection;
-
-	PROCEDURE CompileList (beg, end: INTEGER; c: TextControllers.Controller);
-		VAR v: Views.View; i: INTEGER; error, one: BOOLEAN; name: Files.Name; loc: Files.Locator;
-			t: TextModels.Model; opts: SET; title, entry: ARRAY 64 OF CHAR;
-	BEGIN
-		s.SetPos(beg); s.Scan; one := FALSE;
-		WHILE (s.start < end) & (s.type = TextMappers.string) & (s.len < LEN(name)) DO
-			s.Scan; one := TRUE;
-			WHILE (s.start < end) & (s.type = TextMappers.char) &
-				((s.char = "-") OR (s.char = "+") OR
-				(s.char = "!") OR (s.char = "*") OR (s.char = "?") OR (s.char = "^") OR (s.char = "("))
-			DO
-				IF s.char = "(" THEN
-					WHILE (s.start < end) & ((s.type # TextMappers.char) OR (s.char # ")")) DO s.Scan END
-				END;
-				s.Scan
-			END
-		END;
-		IF one & (s.start >= end) THEN
-			s.SetPos(beg); s.Scan; error := FALSE;
-			WHILE (s.start < end) & (s.type = TextMappers.string) & ~error DO
-				i := 0; WHILE i < LEN(name) DO name[i] := 0X; INC(i) END;
-				StdDialog.GetSubLoc(s.string, "Mod", loc, name);
-				t := NIL;
-				IF loc # NIL THEN
-					v := Views.OldView(loc, name);
-					IF v # NIL THEN
-						WITH v: TextViews.View DO t := v.ThisModel()
-						ELSE Dialog.ShowParamMsg("#Dev:NoTextFileFound", name, "", ""); error := TRUE
-						END
-					ELSE Dialog.ShowParamMsg("#Dev:CannotOpenFile", name, "", ""); error := TRUE
-					END
-				ELSE Dialog.ShowParamMsg("#System:FileNotFound", name, "", ""); error := TRUE
-				END;
-				s.Scan; opts := defopt;
-				WHILE (s.start < end) & (s.type = TextMappers.char) DO
-					IF s.char = "-" THEN
-						IF srcpos IN opts THEN EXCL(opts, srcpos)
-						ELSIF allref IN opts THEN EXCL(opts, allref)
-						ELSIF ref IN opts THEN EXCL(opts, ref)
-						ELSE EXCL(opts, obj)
-						END
-					ELSIF s.char = "!" THEN
-						IF assert IN opts THEN EXCL(opts, assert)
-						ELSE EXCL(opts, checks)
-						END
-					ELSIF s.char = "+" THEN INCL(opts, allchecks)
-					ELSIF s.char = "?" THEN INCL(opts, hint)
-					ELSIF s.char = "@" THEN INCL(opts, errorTrap)
-					ELSIF s.char = "$" THEN INCL(opts, oberon)
-					ELSIF s.char = "(" THEN
-						s.Scan;
-						WHILE (s.start < end) & (s.type = TextMappers.string) DO
-							title := s.string$; s.Scan;
-							IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ":") THEN
-								s.Scan;
-								IF (s.start < end) & (s.type = TextMappers.string) THEN
-									entry := s.string$; s.Scan;
-									IF t # NIL THEN DevSelectors.ChangeTo(t, title, entry) END
-								END
-							END;
-							IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ",") THEN s.Scan END
-						END
-					END;
-					s.Scan
-				END;
-				IF t # NIL THEN
-					Do(t, StdLog.text, 0, opts, error)
-				END
-			END
-		ELSE Dialog.ShowMsg("#Dev:NotOnlyFileNames")
-		END;
-		s.ConnectTo(NIL);
-		IF error & (c # NIL) & c.HasSelection() & (s.start < end) THEN
-			c.SetSelection(s.start, end)
-		END;
-		IF error & (v # NIL) THEN
-			Views.Open(v, loc, name, NIL);
-			DevMarkers.ShowFirstError(t, TextViews.any)
-		END
-	END CompileList;
-
-	PROCEDURE CompileModuleList*;
-		VAR c: TextControllers.Controller; beg, end: INTEGER;
-	BEGIN
-		Open;
-		c := TextControllers.Focus();
-		IF c # NIL THEN
-			s.ConnectTo(c.text);
-			IF c.HasSelection() THEN c.GetSelection(beg, end)
-			ELSE beg := 0; end := c.text.Length()
-			END;
-			CompileList(beg, end, c)
-		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
-		END;
-		Close
-	END CompileModuleList;
-
-	PROCEDURE CompileThis*;
-		VAR p: DevCommanders.Par; beg, end: INTEGER;
-	BEGIN
-		Open;
-		p := DevCommanders.par;
-		IF p # NIL THEN
-			DevCommanders.par := NIL;
-			s.ConnectTo(p.text); beg := p.beg; end := p.end;
-			CompileList(beg, end, NIL)
-		ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
-		END;
-		Close
-	END CompileThis;
-
-	PROCEDURE Init;
-		VAR loc: Files.Locator; f: Files.File;
-	BEGIN
-		loc := Files.dir.This("Dev"); loc := loc.This("Code");
-		f := Files.dir.Old(loc, "ComDebug.ocf", TRUE);
-		found := f # NIL;
-		IF f # NIL THEN f.Close END
-	END Init;
-
-BEGIN
-	Init
-END DevCompiler.

new/Dev/Mod/Markers.txt

@@ -1,442 +0,0 @@
-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.

new/Dev/Mod/Selectors.txt

@@ -1,411 +0,0 @@
-MODULE DevSelectors;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Selectors.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT
-		Ports, Stores, Models, Views, Controllers, Fonts, Properties, TextModels, TextViews, TextSetters;
-		
-
-	CONST
-		left* = 1; middle* = 2; right* = 3;
-
-		minVersion = 0; currentVersion = 0;
-		
-		changeSelectorsKey = "#Dev:Change Selectors";
-
-
-	TYPE
-		Selector* = POINTER TO RECORD (Views.View)
-			position-: INTEGER;	(* left, middle, right *)
-			leftHidden: TextModels.Model;	(* valid iff (position = left) *)
-			rightHidden: TextModels.Model	(* valid iff (position = left) *)
-		END;
-
-		Directory* = POINTER TO ABSTRACT RECORD END;
-
-		StdDirectory = POINTER TO RECORD (Directory) END;
-		
-		
-	VAR
-		dir-, stdDir-: Directory;
-
-
-		PROCEDURE (d: Directory) New* (position: INTEGER): Selector, NEW, ABSTRACT;
-
-
-	PROCEDURE GetFirst (selector: Selector; OUT first: Selector; OUT pos: INTEGER);
-		VAR c: Models.Context; rd: TextModels.Reader; v: Views.View; nest: INTEGER;
-	BEGIN
-		c := selector.context; first := NIL; pos := 0;
-		WITH c: TextModels.Context DO
-			IF selector.position = left THEN
-				first := selector
-			ELSE
-				rd := c.ThisModel().NewReader(NIL); rd.SetPos(c.Pos());
-				nest := 1; pos := 1; rd.ReadPrevView(v);
-				WHILE (v # NIL) & (nest > 0) DO
-					WITH v: Selector DO
-						IF v.position = left THEN DEC(nest);
-							IF nest = 0 THEN first := v END
-						ELSIF v.position = right THEN INC(nest)
-						ELSIF nest = 1 THEN INC(pos)
-						END
-					ELSE
-					END;
-					rd.ReadPrevView(v)
-				END
-			END
-		ELSE (* selector not embedded in a text *)
-		END;
-		ASSERT((first = NIL) OR (first.position = left), 100)
-	END GetFirst;
-	
-	PROCEDURE GetNext (rd: TextModels.Reader; OUT next: Selector);
-		VAR nest: INTEGER; v: Views.View;
-	BEGIN
-		nest := 1; next := NIL; rd.ReadView(v);
-		WHILE v # NIL DO
-			WITH v: Selector DO
-				IF v.position = left THEN INC(nest)
-				ELSIF nest = 1 THEN next := v; RETURN
-				ELSIF v.position = right THEN DEC(nest)
-				END
-			ELSE
-			END;
-			rd.ReadView(v)
-		END
-	END GetNext;
-
-	PROCEDURE CalcSize (f: Selector; OUT w, h: INTEGER);
-		VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
-	BEGIN
-		c := f.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, fw);
-		h := asc + dsc; w := 3 * h DIV 4
-	END CalcSize;
-
-	PROCEDURE GetSection (first: Selector; rd: TextModels.Reader; n: INTEGER; OUT name: ARRAY OF CHAR);
-		VAR i, p0, p1: INTEGER; ch: CHAR; sel: Selector;
-	BEGIN
-		sel := first;
-		IF first.leftHidden.Length() > 0 THEN
-			rd := first.leftHidden.NewReader(rd); rd.SetPos(0);
-			REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL);
-			IF sel = NIL THEN INC(n) END;
-			p1 := rd.Pos() - 1
-		END;
-		IF n >= 0 THEN
-			rd := first.context(TextModels.Context).ThisModel().NewReader(rd);
-			rd.SetPos(first.context(TextModels.Context).Pos() + 1);
-			REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL) OR (sel.position = right);
-			p1 := rd.Pos() - 1
-		END;
-		IF (n >= 0) & (first.rightHidden.Length() > 0) THEN
-			rd := first.rightHidden.NewReader(rd); rd.SetPos(1);
-			REPEAT p0 := rd.Pos(); GetNext(rd, sel); DEC(n) UNTIL (n < 0) OR (sel = NIL);
-			p1 := rd.Pos() - 1;
-			IF sel = NIL THEN p1 := first.rightHidden.Length() END
-		END;
-		IF n < 0 THEN
-			rd.SetPos(p0); rd.ReadChar(ch); i := 0;
-			WHILE (ch <= " ") & (rd.Pos() <= p1) DO rd.ReadChar(ch) END;
-			WHILE (i < LEN(name) - 1) & (rd.Pos() <= p1) & (ch # 0X) DO
-				IF ch >= " " THEN name[i] := ch; INC(i) END;
-				rd.ReadChar(ch)
-			END;
-			WHILE (i > 0) & (name[i - 1] = " ") DO DEC(i) END;
-			name[i] := 0X
-		ELSE
-			name := 7FX + ""
-		END
-	END GetSection;
-	
-
-	PROCEDURE ChangeSelector (first: Selector; rd: TextModels.Reader; selection: INTEGER);
-		VAR pos, p0, len, s: INTEGER; text: TextModels.Model; sel: Selector;
-	BEGIN
-		text := rd.Base();
-		pos := first.context(TextModels.Context).Pos() + 1;
-		(* expand *)
-		rd.SetPos(pos);
-		REPEAT GetNext(rd, sel) UNTIL (sel = NIL) OR (sel.position = right);
-		IF sel # NIL THEN
-			len := first.rightHidden.Length();
-			IF len > 0 THEN text.Insert(rd.Pos() - 1, first.rightHidden, 0, len) END;
-			len := first.leftHidden.Length();
-			IF len > 0 THEN text.Insert(pos, first.leftHidden, 0, len) END;
-			IF selection # 0 THEN	(* collapse *)
-				rd.SetPos(pos); s := 0;
-				REPEAT GetNext(rd, sel); INC(s) UNTIL (s = selection) OR (sel = NIL) OR (sel.position = right);
-				IF (sel # NIL) & (sel.position = middle) THEN
-					first.leftHidden.Insert(0, text, pos, rd.Pos());
-					rd.SetPos(pos); GetNext(rd, sel);
-					p0 := rd.Pos() - 1;
-					WHILE (sel # NIL) & (sel.position # right) DO GetNext(rd, sel) END;
-					IF sel # NIL THEN
-						first.rightHidden.Insert(0, text, p0, rd.Pos() - 1)
-					END
-				END
-			END
-		END;
-		rd.SetPos(pos)
-	END ChangeSelector;
-	
-	PROCEDURE ChangeThis (
-		text: TextModels.Model; rd, rd1: TextModels.Reader; title: ARRAY OF CHAR; selection: INTEGER
-	);
-		VAR v: Views.View; str: ARRAY 256 OF CHAR;
-	BEGIN
-		rd := text.NewReader(rd);
-		rd.SetPos(0); rd.ReadView(v);
-		WHILE v # NIL DO
-			WITH v: Selector DO
-				IF v.position = left THEN
-					GetSection(v, rd1, 0, str);
-					IF str = title THEN
-						ChangeSelector(v, rd, selection)
-					END;
-					IF v.leftHidden.Length() > 0 THEN ChangeThis(v.leftHidden, NIL, rd1, title, selection) END;
-					IF v.rightHidden.Length() > 0 THEN ChangeThis(v.rightHidden, NIL, rd1, title, selection) END
-				END
-			ELSE
-			END;
-			rd.ReadView(v)
-		END
-	END ChangeThis;
-	
-	PROCEDURE Change* (text: TextModels.Model; title: ARRAY OF CHAR; selection: INTEGER);
-		VAR rd, rd1: TextModels.Reader; script: Stores.Operation;
-	BEGIN
-		rd := text.NewReader(NIL);
-		rd1 := text.NewReader(NIL);
-		Models.BeginModification(Models.clean, text);
-		Models.BeginScript(text, changeSelectorsKey, script);
-		ChangeThis(text, rd, rd1, title, selection);
-		Models.EndScript(text, script);
-		Models.EndModification(Models.clean, text);
-	END Change;
-	
-	PROCEDURE ChangeTo* (text: TextModels.Model; title, entry: ARRAY OF CHAR);
-		VAR rd, rd1: TextModels.Reader; str: ARRAY 256 OF CHAR; v: Views.View; sel: INTEGER;
-	BEGIN
-		rd := text.NewReader(NIL);
-		rd1 := text.NewReader(NIL);
-		rd.SetPos(0); rd.ReadView(v);
-		WHILE v # NIL DO
-			WITH v: Selector DO
-				IF v.position = left THEN
-					GetSection(v, rd1, 0, str);
-					IF title = str THEN
-						sel := 0;
-						REPEAT
-							INC(sel); GetSection(v, rd1, sel, str)
-						UNTIL (str[0] = 7FX) OR (str = entry);
-						IF str[0] # 7FX THEN
-							Change(text, title, sel);
-							RETURN
-						END
-					END
-				END
-			ELSE
-			END;
-			rd.ReadView(v)
-		END
-	END ChangeTo;
-
-
-	PROCEDURE (selector: Selector) HandlePropMsg- (VAR msg: Properties.Message);
-		VAR c: Models.Context; a: TextModels.Attributes; asc, w: INTEGER;
-	BEGIN
-		WITH msg: Properties.SizePref DO CalcSize(selector, msg.w, msg.h)
-		| msg: Properties.ResizePref DO msg.fixed := TRUE;
-		| msg: Properties.FocusPref DO msg.hotFocus := TRUE;
-		| msg: TextSetters.Pref DO c := selector.context;
-			IF (c # NIL) & (c IS TextModels.Context) THEN
-				a := c(TextModels.Context).Attr();
-				a.font.GetBounds(asc, msg.dsc, w)
-			END
-		ELSE (*selector.HandlePropMsg^(msg);*)
-		END
-	END HandlePropMsg;
-
-	PROCEDURE Track (selector: Selector; f: Views.Frame; x, y: INTEGER; buttons: SET; VAR hit: BOOLEAN);
-		VAR a: TextModels.Attributes; font: Fonts.Font; c: Models.Context;
-			w, h, asc, dsc, fw: INTEGER; isDown, in, in0: BOOLEAN; modifiers: SET;
-	BEGIN
-		c := selector.context; hit := FALSE;
-		WITH c: TextModels.Context DO
-			a := c.Attr(); font := a.font;
-			c.GetSize(w, h); in0 := FALSE;
-			in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
-			REPEAT
-				IF in # in0 THEN
-					f.MarkRect(0, 0, w, h, Ports.fill, Ports.hilite, FALSE); in0 := in
-				END;
-				f.Input(x, y, modifiers, isDown);
-				in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
-			UNTIL ~isDown;
-			IF in0 THEN hit := TRUE;
-				font.GetBounds(asc, dsc, fw);
-				f.MarkRect(0, 0, w, asc + dsc, Ports.fill, Ports.hilite, FALSE);
-			END
-		ELSE
-		END
-	END Track;
-
-	PROCEDURE (selector: Selector) HandleCtrlMsg* (
-		f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View
-	);
-		VAR hit: BOOLEAN; sel, pos: INTEGER; text: TextModels.Model; title: ARRAY 256 OF CHAR; first: Selector;
-	BEGIN
-		WITH msg: Controllers.TrackMsg DO
-			IF selector.context IS TextModels.Context THEN
-				Track(selector, f, msg.x, msg.y, msg.modifiers, hit);
-				IF hit THEN
-					text := selector.context(TextModels.Context).ThisModel();
-					GetFirst(selector, first, pos);
-					IF first # NIL THEN
-						GetSection(first, NIL, 0, title);
-						IF selector.position = middle THEN sel := pos ELSE sel := 0 END;
-						Change(text, title, sel);
-						text := selector.context(TextModels.Context).ThisModel();
-						IF TextViews.FocusText() = text THEN
-							pos := selector.context(TextModels.Context).Pos();
-							TextViews.ShowRange(text, pos, pos+1, TRUE)
-						END
-					END
-				END
-			END
-		| msg: Controllers.PollCursorMsg DO
-			msg.cursor := Ports.refCursor;
-		ELSE
-		END
-	END HandleCtrlMsg;
-
-	PROCEDURE (selector: Selector) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
-		VAR w, h, d: INTEGER;
-	BEGIN
-		selector.context.GetSize(w, h);
-(*
-		GetFirst(selector, first, pos);
-*)
-		w := w - w MOD f.unit; d := 2 * f.dot;
-		f.DrawLine(d, d, w - d, d, d, Ports.grey25);
-		f.DrawLine(d, h - d, w - d, h - d, d, Ports.grey25);
-		IF selector.position # right THEN f.DrawLine(d, d, d, h - d, d, Ports.grey25) END;
-		IF selector.position # left THEN f.DrawLine(w - d, d, w - d, h - d, d, Ports.grey25) END
-	END Restore;
-
-	PROCEDURE (selector: Selector) CopyFromSimpleView- (source: Views.View);
-	BEGIN
-		(* selector.CopyFrom^(source); *)
-		WITH source: Selector DO
-			selector.position := source.position;
-			IF source.leftHidden # NIL THEN
-				selector.leftHidden := TextModels.CloneOf(source.leftHidden);
-				selector.leftHidden.InsertCopy(0, source.leftHidden, 0, source.leftHidden.Length())
-			END;
-			IF source.rightHidden # NIL THEN
-				selector.rightHidden := TextModels.CloneOf(source.rightHidden);
-				selector.rightHidden.InsertCopy(0, source.rightHidden, 0, source.rightHidden.Length())
-			END
-		END
-	END CopyFromSimpleView;
-
-	PROCEDURE (selector: Selector) InitContext* (context: Models.Context);
-	BEGIN
-		selector.InitContext^(context);
-		IF selector.position = left THEN
-			WITH context: TextModels.Context DO
-				IF selector.leftHidden = NIL THEN 
-					selector.leftHidden := TextModels.CloneOf(context.ThisModel());
-					Stores.Join(selector, selector.leftHidden);
-				END;
-				IF selector.rightHidden = NIL THEN
-					selector.rightHidden := TextModels.CloneOf(context.ThisModel());
-					Stores.Join(selector, selector.rightHidden)
-				END
-			ELSE
-			END
-		END
-	END InitContext;
-	
-	PROCEDURE (selector: Selector) Internalize- (VAR rd: Stores.Reader);
-		VAR version: INTEGER; store: Stores.Store;
-	BEGIN
-		selector.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, currentVersion, version);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadInt(selector.position);
-		rd.ReadStore(store);
-		IF store # NIL THEN selector.leftHidden := store(TextModels.Model)
-		ELSE selector.leftHidden := NIL
-		END;
-		rd.ReadStore(store);
-		IF store # NIL THEN selector.rightHidden := store(TextModels.Model)
-		ELSE selector.rightHidden := NIL
-		END
-	END Internalize;
-
-	PROCEDURE (selector: Selector) Externalize- (VAR wr: Stores.Writer);
-	BEGIN
-		selector.Externalize^(wr);
-		wr.WriteVersion(currentVersion);
-		wr.WriteInt(selector.position);
-		wr.WriteStore(selector.leftHidden);
-		wr.WriteStore(selector.rightHidden)
-	END Externalize;
-
-
-	PROCEDURE (d: StdDirectory) New (position: INTEGER): Selector;
-		VAR selector: Selector;
-	BEGIN
-		NEW(selector);
-		selector.position := position;
-		RETURN selector
-	END  New;
-
-	PROCEDURE SetDir* (d: Directory);
-	BEGIN
-		ASSERT(d # NIL, 20);
-		dir := d
-	END SetDir;
-	
-
-	PROCEDURE DepositLeft*;
-	BEGIN
-		Views.Deposit(dir.New(left))
-	END DepositLeft;
-
-	PROCEDURE DepositMiddle*;
-	BEGIN
-		Views.Deposit(dir.New(middle))
-	END DepositMiddle;
-
-	PROCEDURE DepositRight*;
-	BEGIN
-		Views.Deposit(dir.New(right))
-	END DepositRight;
-
-
-	PROCEDURE InitMod;
-		VAR d: StdDirectory;
-	BEGIN
-		NEW(d); dir := d; stdDir := d;
-	END InitMod;
-
-BEGIN
-	InitMod
-END DevSelectors.
-
-
-	"Insert Left"	"*F5"	"DevSelectors.DepositLeft; StdCmds.PasteView"	"StdCmds.PasteViewGuard"
-	"Insert Middle"	"*F6"	"DevSelectors.DepositMiddle; StdCmds.PasteView"	"StdCmds.PasteViewGuard"
-	"Insert Right"	"*F7"	"DevSelectors.DepositRight; StdCmds.PasteView"	"StdCmds.PasteViewGuard"

new/Dev0/Mod/CPB.txt

@@ -1,2251 +0,0 @@
-MODULE Dev0CPB;
-
-	(* THIS IS TEXT COPY OF CPB.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems, Robert Campbell"
-	version	= "System/Rsrc/About"
-	copyright	= "System/Rsrc/About"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT DevCPT := Dev0CPT, DevCPM := Dev0CPM;
-
-	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 Dev0CPB.

new/Dev0/Mod/CPC486.txt

@@ -1,2347 +0,0 @@
-MODULE Dev0CPC486;
-
-	(* THIS IS TEXT COPY OF CPC486.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT SYSTEM, DevCPM := Dev0CPM, DevCPT := Dev0CPT, DevCPE := Dev0CPE, 
-		DevCPL486 := Dev0CPL486;
-
-	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.errorMes := DevCPM.errorMes + " AX" END;
-			IF BX IN reg THEN DevCPM.errorMes := DevCPM.errorMes  +" BX" END;
-			IF CX IN reg THEN DevCPM.errorMes := DevCPM.errorMes + " CX" END;
-			IF DX IN reg THEN DevCPM.errorMes := DevCPM.errorMes +" DX" END;
-			IF SI IN reg THEN DevCPM.errorMes := DevCPM.errorMes + " SI" END;
-			IF DI IN reg THEN DevCPM.errorMes := DevCPM.errorMes + " 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 Dev0CPC486.

new/Dev0/Mod/CPE.txt

@@ -1,1120 +0,0 @@
-MODULE Dev0CPE;
-
-	(* THIS IS TEXT COPY OF CPE.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems, Robert Campbell"
-	version	= "System/Rsrc/About"
-	copyright	= "System/Rsrc/About"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT SYSTEM, (* Dates, *) DevCPM := Dev0CPM, DevCPT := Dev0CPT;
-
-
-	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); *)
-		Out2(2007); Out2(5); Out2(25);
-		Out2(0); Out2(0); Out2(0);
-		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 Dev0CPE.

new/Dev0/Mod/CPH.txt

@@ -1,304 +0,0 @@
-MODULE Dev0CPH;
-
-	(* THIS IS TEXT COPY OF CPH.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT DevCPT := Dev0CPT;
-	
-	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 Dev0CPH.
-
-
-
-
-	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;
-		

new/Dev0/Mod/CPL486.txt

@@ -1,1070 +0,0 @@
-MODULE Dev0CPL486;
-
-	(* THIS IS TEXT COPY OF CPL486.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT DevCPM := Dev0CPM, DevCPT := Dev0CPT, DevCPE := Dev0CPE;
-	
-	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 Dev0CPL486.

new/Dev0/Mod/CPM.txt

@@ -1,809 +0,0 @@
-MODULE Dev0CPM;
-
-	(* THIS IS TEXT COPY OF CPM.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/About"
-	copyright	= "System/Rsrc/About"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	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 *)
-
-		errorMes*: ARRAY 4096 OF CHAR;
-
-		lastpos: INTEGER;
-		realpat: INTEGER;
-		lrealpat: RECORD H, L: INTEGER END;
-		fpi, fpj: SHORTINT; fp: ARRAY 4 OF SHORTCHAR;
-		ObjFName: Files.Name;
-
-		in: Files.Reader;
-		oldSymFile, symFile, objFile: Files.File;
-		inSym: Files.Reader;
-		outSym, outObj: Files.Writer;
-		
-		errNo-, errPos-: ARRAY maxErrors OF INTEGER;
-		
-		lineReader: Files.Reader;
-		lineNum: INTEGER;
-		
-		crc32tab: ARRAY 256 OF INTEGER;
-
-
-	PROCEDURE^ err* (n: INTEGER);
-
-	PROCEDURE Init* (source: Files.Reader);
-	BEGIN
-		in := source;
-		noerr := TRUE; options := {};
-		curpos := in.Pos(); errpos := curpos; lastpos := curpos - 11; errors := 0;
-		codeDir := OFdir; symDir := SFdir;
-		errorMes := ""
-	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: BYTE;
-	BEGIN
-		REPEAT
-			in.ReadByte(ch1);
-			ch := SYSTEM.VAL(SHORTCHAR, ch1);
-			INC(curpos)
-		UNTIL (ch < 100X)
-	END Get;
-	
-	PROCEDURE GetL* (VAR ch: CHAR);
-		VAR
-			sCh: SHORTCHAR;
-	BEGIN
-		Get(sCh);
-		ch := sCh
-	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;
-
-	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;
-
-	(* 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 Dev0CPM.

new/Dev0/Mod/CPP.txt

@@ -1,1662 +0,0 @@
-MODULE Dev0CPP;
-
-	(* THIS IS TEXT COPY OF CPP.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT
-		DevCPM := Dev0CPM, DevCPT := Dev0CPT, DevCPB := Dev0CPB, DevCPS := Dev0CPS;
-		
-	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.errorMes := DevCPM.errorMes + "  " + m.name^ + " not implemented";
-					IF typ.strobj # NIL THEN
-						DevCPM.errorMes :=  DevCPM.errorMes+ " in " + 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 Dev0CPP.

new/Dev0/Mod/CPS.txt

@@ -1,379 +0,0 @@
-MODULE Dev0CPS;
-
-	(* THIS IS TEXT COPY OF CPS.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT SYSTEM, Math, DevCPM := Dev0CPM, DevCPT := Dev0CPT;
-	
-	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", "_", "À".."Ö", "Ø".."ö", "ø".."ÿ": 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 Dev0CPS.

new/Dev0/Mod/CPT.txt

@@ -1,1904 +0,0 @@
-MODULE Dev0CPT;
-
-	(* THIS IS TEXT COPY OF CPT.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/About"
-	copyright	= "System/Rsrc/About"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT DevCPM := Dev0CPM;
-
-	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);	(* !!! *)
-		CONST
-			nl = 0DX;
-	BEGIN
-		IF errno = 249 THEN
-			DevCPM.errorMes := DevCPM.errorMes + nl + " ";
-			DevCPM.errorMes := DevCPM.errorMes + GlbMod[-obj.mnolev].name^;
-			DevCPM.errorMes := DevCPM.errorMes + "." + obj.name^;
-			DevCPM.errorMes := DevCPM.errorMes +" is not consistently imported";
-			err(249)
-		ELSIF obj = NIL THEN	(* changed module sys flags *)
-			IF ~symNew & sfpresent THEN
-				DevCPM.errorMes := DevCPM.errorMes + nl + "  changed library flag"
-			END
-		ELSIF obj.mnolev = 0 THEN	(* don't report changes in imported modules *)
-			IF sfpresent THEN
-				IF symChanges < 20 THEN
-					DevCPM.errorMes := DevCPM.errorMes + nl + " " + obj.name^;
-					IF errno = 250 THEN DevCPM.errorMes := DevCPM.errorMes + " is no longer in symbol file"
-					ELSIF errno = 251 THEN DevCPM.errorMes := DevCPM.errorMes + " is redefined internally "
-					ELSIF errno = 252 THEN DevCPM.errorMes := DevCPM.errorMes + " is redefined"
-					ELSIF errno = 253 THEN DevCPM.errorMes := DevCPM.errorMes + " is new in symbol file"
-					END
-				ELSIF symChanges = 20 THEN
-					DevCPM.errorMes := DevCPM.errorMes + nl + "  ..."
-				END;
-				INC(symChanges)
-			ELSIF (errno = 253) & ~symExtended THEN
-				DevCPM.errorMes := DevCPM.errorMes + nl + "  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 Dev0CPT.
-
-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

new/Dev0/Mod/CPV486.txt

@@ -1,1788 +0,0 @@
-MODULE Dev0CPV486;
-
-	(* THIS IS TEXT COPY OF CPV486.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
-	changes	= ""
-	issues	= ""
-
-**)
-
-	IMPORT SYSTEM, DevCPM := Dev0CPM, DevCPT := Dev0CPT, DevCPE := Dev0CPE, 
-		DevCPH := Dev0CPH, DevCPL486 := Dev0CPL486, DevCPC486 := Dev0CPC486;
-	
-	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 Dev0CPV486.

new/Dev0/Mod/Compiler.txt

@@ -1,140 +0,0 @@
-MODULE Dev0Compiler;
-
-	(* THIS IS TEXT COPY OF Compiler.odc *)
-	(* DO NOT EDIT *)
-
-	(*
-		A. V. Shiryaev, 2012.10
-
-		Based on DevCompiler
-	*)
-
-	IMPORT Files, Console, Kernel, Strings,
-		DevCPM := Dev0CPM, DevCPT:= Dev0CPT, DevCPB := Dev0CPB, DevCPP := Dev0CPP,
-		DevCPE := Dev0CPE, DevCPV := Dev0CPV486;
-
-	CONST
-		(* compiler options: *)
-		checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5; srcpos = 6; reallib = 7; signatures = 8;
-		hint = 29; oberon = 30; errorTrap = 31;
-		defopt = {checks, assert, obj, ref, allref, srcpos, signatures};
-
-	PROCEDURE WriteInt (x: INTEGER);
-		VAR s: ARRAY 16 OF CHAR;
-	BEGIN
-		Strings.IntToString(x, s);
-		Console.WriteStr(s)
-	END WriteInt;
-
-	PROCEDURE Module (source: Files.Reader; opt: SET; VAR error: BOOLEAN);
-		VAR ext, new: BOOLEAN; p: DevCPT.Node;
-			i: INTEGER;
-	BEGIN
-		DevCPM.Init(source);
-		(* IF found THEN INCL(DevCPM.options, DevCPM.comAware) END; *)
-		IF errorTrap IN opt THEN INCL(DevCPM.options, DevCPM.trap) END;
-		IF oberon IN opt THEN INCL(DevCPM.options, DevCPM.oberon) END;
-		DevCPT.Init(opt);
-		DevCPB.typSize := DevCPV.TypeSize;
-		DevCPT.processor := DevCPV.processor;
-		DevCPP.Module(p);
-		IF DevCPM.noerr THEN
-			IF DevCPT.libName # "" THEN EXCL(opt, obj) END;
-(*
-			IF errorTrap IN opt THEN DevCPDump.DumpTree(p) END;
-*)
-			DevCPV.Init(opt); DevCPV.Allocate; DevCPT.Export(ext, new);
-			IF DevCPM.noerr & (obj IN opt) THEN
-				DevCPV.Module(p)
-			END;
-			DevCPV.Close
-		END;
-		IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
-		ELSE DevCPM.DeleteNewSym
-		END;
-		DevCPT.Close;
-		error := ~DevCPM.noerr;
-		DevCPM.Close;
-		p := NIL;
-		Kernel.FastCollect;
-		IF error THEN
-			IF DevCPM.errors = 1 THEN
-				Console.WriteStr("one error detected")
-			ELSE
-				WriteInt(DevCPM.errors); Console.WriteStr(" errors detected")
-			END;
-			Console.WriteLn;
-			i := 0;
-			WHILE i < DevCPM.errors DO
-				Console.WriteStr("  pos = "); WriteInt(DevCPM.errPos[i]); Console.WriteStr("  err = ");
-					WriteInt(DevCPM.errNo[i]); Console.WriteLn;
-				INC(i)
-			END
-		ELSE
-			Console.WriteStr(" "); WriteInt(DevCPE.pc); Console.WriteStr(" "); WriteInt(DevCPE.dsize)
-		END;
-		Console.WriteLn
-	END Module;
-
-	PROCEDURE Do (IN path, name: ARRAY OF CHAR; opt: SET);
-		VAR loc: Files.Locator;
-			f: Files.File; r: Files.Reader; error: BOOLEAN;
-	BEGIN
-		loc := Files.dir.This(path);
-		IF loc # NIL THEN
-			f := Files.dir.Old(loc, name$, FALSE);
-			IF f # NIL THEN
-				r := f.NewReader(NIL);
-				Module(r, opt, error);
-				IF error THEN Console.WriteStr("error(s)"); Console.WriteLn END;
-				f.Close
-			ELSE
-				Console.WriteStr("file not found: ");
-					Console.WriteStr(path); Console.WriteStr(" "); Console.WriteStr(name); Console.WriteLn
-			END
-		ELSE
-			Console.WriteStr("path not found: ");
-				Console.WriteStr(path); Console.WriteLn
-		END
-	END Do;
-
-	PROCEDURE Compile* (IN path, name: ARRAY OF CHAR);
-	BEGIN
-		Console.WriteStr("compiling ");
-			Console.WriteStr(path); Console.WriteStr(" "); Console.WriteStr(name);
-			Console.WriteLn;
-		Do(path, name, defopt)
-	END Compile;
-
-	PROCEDURE CompileOpt* (IN path, name: ARRAY OF CHAR; IN opt: ARRAY OF CHAR);
-		VAR loc: Files.Locator;
-			f: Files.File; r: Files.Reader; error: BOOLEAN; i: INTEGER; opts: SET;
-	BEGIN
-		i := 0; opts := defopt;
-		WHILE opt[i] # 0X DO
-			IF opt[i] = "-" THEN
-				IF srcpos IN opts THEN EXCL(opts, srcpos)
-				ELSIF allref IN opts THEN EXCL(opts, allref)
-				ELSIF ref IN opts THEN EXCL(opts, ref)
-				ELSE EXCL(opts, obj)
-				END
-			ELSIF opt[i] = "!" THEN
-				IF assert IN opts THEN EXCL(opts, assert)
-				ELSE EXCL(opts, checks)
-				END
-			ELSIF opt[i] = "+" THEN INCL(opts, allchecks)
-			ELSIF opt[i] = "?" THEN INCL(opts, hint)
-			ELSIF opt[i] = "@" THEN INCL(opts, errorTrap)
-			ELSIF opt[i] = "$" THEN INCL(opts, oberon)
-			END;
-			INC(i)
-		END;
-
-		Console.WriteStr("compiling ");
-			Console.WriteStr(path); Console.WriteStr(" "); Console.WriteStr(name);
-			IF opt # "" THEN Console.WriteStr(" "); Console.WriteStr(opt); END;
-			Console.WriteLn;
-		Do(path, name, opts)
-	END CompileOpt;
-
-END Dev0Compiler.

new/Dev0/Mod/ElfLinker16.txt

@@ -1,1892 +0,0 @@
-MODULE Dev0ElfLinker;
-
-	(* THIS IS TEXT COPY OF ElfLinker16.odc *)
-	(* DO NOT EDIT *)
-
-(**
-	project	= "BlackBox"
-	organization	= "www.oberon.ch"
-	contributors	= "Oberon microsystems"
-	version	= "System/Rsrc/AboutBB"
-	copyright	= "System/Rsrc/AboutBB"
-	license	= "Docu/BB-License"
-	changes	= ""
-	issues	= ""
-
-**)
-
-(*
-	DevElfLinker version compatible with BlackBox Component Builder release 1.6.
-	This module will replace DevElfLinker, once the final version of BlackBox 1.6 will be released.
-*)
-
-(*
-	A. V. Shiryaev, 2012.09
-
-	Based on DevElfLinker16; modified to not depend on TextModels (TextModels -> Console)
-*)
-
-	IMPORT
-		Strings,
-		Kernel, Files, (* Dialog, TextMappers, StdLog, DevCommanders *) Console;
-
-	CONST
-		NewRecFP = 4E27A847H;
-		NewArrFP = 76068C78H;
-
-		OFdir = "Code";
-		SYSdir = "System";
-
-		(* meta interface consts *)
-		mConst = 1; mTyp = 2; mVar = 3; mProc = 4;
-		mInternal = 1; mExported = 4;
-
-		(* mod desc fields *)
-		modOpts = 4; modRefcnt = 8; modTerm = 40; modNames = 84; modImports = 92; modExports = 96;
-
-		(* .dynsym entries *)
-		stbLocal = 0; stbGlobal = 1;
-		sttNotype = 0; sttObject = 1; sttFunc = 2; sttSection = 3;
-		shnUnd = 0; shnAbs = 0FFF1H;
-
-		fixup = 0;
-		noSymbol = MIN(INTEGER);
-		noAddr = MIN(INTEGER);
-		firstDllSymbolVal = 12;
-
-		(* distinguished section header indexes. *)
-		textIndexVal = 1;	(* index of the .text section header in the section header table *)
-		rodataIndexVal = 3;	(* index of the .rodata section header in the section header table *)
-		dynsymIndexVal = 5;	(* index of the .dynsym section header in the section header table *)
-		dynstrIndexVal = 6;	(* index of the .dynstr section header in the section header table *)
-
-		(* fixed elements dimensions *)
-		elfHeaderSizeVal = 52;	(* size of the ELF file header *)
-		shEntrySizeVal = 40;	(* size of an entry in the section header table *)
-		dynsymEntrySizeVal = 16; (* size of a symbol table entry *)
-		dynamicEntrySizeVal = 8; (* size of an entry in the dynamic section *)
-		gotEntrySizeVal = 4; (* size of an entry in the got section *)
-		relEntrySizeVal = 8; (* size of an entry in a relocation section *)
-		phEntrySizeVal = 32; (* size of an entry in the program header *)
-
-		shNumVal = 12; (* number of entries in the section header table. See WriteSectionHeaderTable *)
-		shStrndxVal = shNumVal - 1; (* index of the string table for section names. See WriteSectionHeaderTable *)
-		phNumVal = 3; (* number of entries in the program header table *)
-
-		(* sections alignments (in bytes) *)
-		textAlign = 4H;
-		dynsymAlign = 4H;
-		dynstrAlign = 1H;
-		hashAlign = 4H;
-		gotAlign = 4H;
-		dynamicAlign = 4H;
-		shstrtabAlign = 1H;
-		bssAlign = 4H;
-		rodataAlign = 8H;
-		relAlign = 4H;
-
-		pageSize = 1000H; (* I386 page size *)
-
-		r38632 = 1; r386pc32 = 2; r386Relative = 8; (* ELF relocation types *)
-
-	
-		(* A. V. Shiryaev: Scanner *)
-		TMChar = 0; TMString = 1; TMEOT = 2;
-
-	TYPE
-		Name = ARRAY 40 OF SHORTCHAR;
-
-		Export = POINTER TO RECORD
-			next: Export;
-			name: Name;
-			adr: INTEGER
-		END;
-
-		Module = POINTER TO RECORD
-			next: Module;
-			name: Name;
-			fileName: Files.Name;
-			file: Files.File;
-			hs, ms, ds, cs, vs, ni, ma, ca, va: INTEGER;
-			dll, intf: BOOLEAN;
-			exp: Export;
-			imp: POINTER TO ARRAY OF Module;
-			data: POINTER TO ARRAY OF BYTE
-		END;
-
-		Strtab = RECORD
-			tab: ARRAY 4096 OF SHORTCHAR;
-			cur: INTEGER
-		END;
-
-		Relocation = RECORD
-			offset, type: INTEGER
-		END;
-
-		RelTab = RECORD
-			tab: ARRAY 65536 OF Relocation;
-			cur: INTEGER
-		END;
-
-		Section = RECORD
-			fileOffset,
-			memOffset,
-			size: INTEGER
-		END;
-
-		(* A. V. Shiryaev: Scanner *)
-			ScanRider = RECORD
-				s: POINTER TO ARRAY OF CHAR;
-				i: INTEGER
-			END;
-			Scanner = RECORD
-				rider: ScanRider;
-				start, type: INTEGER;
-
-				string: ARRAY 100 OF CHAR;
-				char: CHAR
-			END;
-	
-	VAR
-		Out: Files.File;
-		R: Files.Reader;
-		Ro: Files.Writer;
-		error, isDll, isStatic: BOOLEAN;
-		modList, kernel, main, last, impg, impd: Module;
-		numMod, lastTerm: INTEGER;
-		firstExp, lastExp: Export;
-		CodeSize, DataSize, ConSize: INTEGER;
-		maxCode, numExp: INTEGER;
-		newRec, newArr: Name;
-		code: POINTER TO ARRAY OF BYTE;
-
-		(* fixup positions *)
-		entryPos,
-		expPos,
-		shstrtabPos,
-		finiPos: INTEGER;
-
-		(* sections *)
-		text, reltext, relrodata, rodata, dynstr, shstrtab, hash, got, dynsym, dynamic, bss: Section;
-
-		(* distinguished file and memory offsets *)
-		shOffsetVal,	(* section header table file offset *)
-		phOffsetVal,	(* program header table file offset *)
-		finiMemOffsetVal: INTEGER;	(* memory offset (aka virtual address) of the finalization code (CLOSE sections) *)
-
-		dynsymInfoVal,	(* value of the info field for the .dynsym section *)
-		sonameStrIndexVal: INTEGER;	(* string table index of the name of hte library *)
-
-		(* segment dimensions *)
-		textSegmentSizeVal,
-		dataSegmentSizeVal,
-		dynamicSegmentSizeVal: INTEGER;
-
-		headerstrtab, dynstrtab: Strtab;
-		hashtab: ARRAY 256 OF Name;
-
-		neededIdx: ARRAY 256 OF INTEGER;
-
-		relTextTab, relRodataTab: RelTab;
-
-		soName: Name;
-
-		doWrite: BOOLEAN;
-
-	PROCEDURE (VAR t: Strtab) AddName (IN s: ARRAY OF SHORTCHAR; OUT idx: INTEGER), NEW;
-		VAR i: INTEGER;
-	BEGIN
-		ASSERT((t.cur + LEN(s$)) <= LEN(t.tab), 20); (* table buffer not large enough: TODO enlarge? *)
-		idx := t.cur;
-		i := 0;
-		WHILE s[i] # 0X DO
-			t.tab[t.cur] := s[i];
-			INC(i); INC(t.cur)
-		END;
-		t.tab[t.cur] := s[i]; (* copy the 0X *)
-		INC(t.cur)
-	END AddName;
-
-	PROCEDURE (VAR t: RelTab) Add (offset, type: INTEGER), NEW;
-	BEGIN
-		ASSERT(t.cur < LEN(t.tab), 20); (* table buffer not large enough: TODO enlarge? *)
-		t.tab[t.cur].offset := offset;		
-		t.tab[t.cur].type := type;
-		INC(t.cur)
-	END Add;
-
-	PROCEDURE AddNeededIdx (idx: INTEGER);
-		VAR i, len: INTEGER;
-	BEGIN
-		ASSERT(idx > 0, 20);	(* index must be positive *)
-		len := LEN(neededIdx);
-		i := 0;
-		WHILE (i # len) & (neededIdx[i] # 0) DO INC(i) END;
-		IF i # len THEN
-			neededIdx[i] := idx
-		ELSE
-			HALT(21)	(* no more space for indexes *)
-		END
-	END AddNeededIdx;
-
-	(* A. V. Shiryaev: Console *)
-
-		PROCEDURE WriteString (s: ARRAY OF CHAR);
-		BEGIN
-			Console.WriteStr(s)
-		END WriteString;
-
-		PROCEDURE WriteChar (c: CHAR);
-			VAR s: ARRAY 2 OF CHAR;
-		BEGIN
-			s[0] := c; s[1] := 0X;
-			Console.WriteStr(s)
-		END WriteChar;
-
-		PROCEDURE WriteSString (ss: ARRAY OF SHORTCHAR);
-		BEGIN
-			Console.WriteStr(ss$)
-		END WriteSString;
-
-		PROCEDURE WriteInt (x: INTEGER);
-			VAR s: ARRAY 16 OF CHAR;
-		BEGIN
-			Strings.IntToString(x, s);
-			Console.WriteStr(s)
-		END WriteInt;
-
-		PROCEDURE WriteLn;
-		BEGIN
-			Console.WriteLn
-		END WriteLn;
-
-		PROCEDURE FlushW;
-		BEGIN
-		END FlushW;
-
-	PROCEDURE ThisFile (modname: ARRAY OF CHAR): Files.File;
-		VAR dir, name: Files.Name; loc: Files.Locator; f: Files.File;
-	BEGIN
-		Kernel.SplitName(modname, dir, name);
-		Kernel.MakeFileName(name, Kernel.objType);
-		loc := Files.dir.This(dir); loc := loc.This(OFdir);
-		f := Files.dir.Old(loc, name, TRUE);
-		IF (f = NIL) & (dir = "") THEN
-			loc := Files.dir.This(SYSdir); loc := loc.This(OFdir);
-			f := Files.dir.Old(loc, name, TRUE)
-		END;
-		RETURN f
-	END ThisFile;
-
-	PROCEDURE Read4 (VAR x: INTEGER);
-		VAR b: BYTE;
-	BEGIN
-		R.ReadByte(b); x := b MOD 256;
-		R.ReadByte(b); x := x + 100H * (b MOD 256);
-		R.ReadByte(b); x := x + 10000H * (b MOD 256);
-		R.ReadByte(b); x := x + 1000000H * b
-	END Read4;
-
-	PROCEDURE ReadName (VAR name: ARRAY OF SHORTCHAR);
-		VAR i: INTEGER; b: BYTE;
-	BEGIN i := 0;
-		REPEAT
-			R.ReadByte(b); name[i] := SHORT(CHR(b)); INC(i)
-		UNTIL b = 0
-	END ReadName;
-
-	PROCEDURE RNum (VAR i: INTEGER);
-		VAR b: BYTE; s, y: INTEGER;
-	BEGIN
-		s := 0; y := 0; R.ReadByte(b);
-		WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); R.ReadByte(b) END;
-		i := ASH((b + 64) MOD 128 - 64, s) + y
-	END RNum;
-
-	PROCEDURE WriteCh (ch: SHORTCHAR);
-	BEGIN
-		IF doWrite THEN
-		Ro.WriteByte(SHORT(ORD(ch)))
-		END
-	END WriteCh;
-
-	PROCEDURE Write2 (x: INTEGER);
-	BEGIN
-		IF doWrite THEN
-			Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-			Ro.WriteByte(SHORT(SHORT(x MOD 256)))
-		END
-	END Write2;
-
-	PROCEDURE Write4 (x: INTEGER);
-	BEGIN
-		IF doWrite THEN
-			Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-			Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-			Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-			Ro.WriteByte(SHORT(SHORT(x MOD 256)))
-		END
-	END Write4;
-
-	PROCEDURE WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
-	BEGIN
-		IF doWrite THEN
-			Ro.WriteBytes(x, beg, len)
-		END
-	END WriteBytes;
-
-	PROCEDURE Align (alignment: INTEGER);
-	BEGIN
-		WHILE Ro.Pos() MOD alignment # 0 DO WriteCh(0X) END
-	END Align;
-	
-	PROCEDURE Aligned (pos, alignment: INTEGER): INTEGER;
-	BEGIN
-		RETURN (pos + (alignment - 1)) DIV alignment * alignment
-	END Aligned;
-	
-	PROCEDURE Put (mod: Module; a, x: INTEGER);
-	BEGIN
-		ASSERT((mod.data # NIL) & ((a >= 0) & (a <= LEN(mod.data))), 20);
-		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
-		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
-		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
-		mod.data[a] := SHORT(SHORT(x))
-	END Put;
-
-	PROCEDURE Get (mod: Module; a: INTEGER; VAR x: INTEGER);
-	BEGIN
-		ASSERT((mod.data # NIL) & ((a >= 0) & (a + 3 <= LEN(mod.data))), 20);
-		x := ((mod.data[a + 3] * 256 +
-			(mod.data[a + 2] MOD 256)) * 256 +
-			(mod.data[a + 1] MOD 256)) * 256 +
-			(mod.data[a] MOD 256)
-	END Get;
-
-	PROCEDURE CheckDllImports (mod: Module);
-		VAR i, x, y: INTEGER; name: Name; imp: Module; exp: Export;
-
-		PROCEDURE SkipLink;
-			VAR a: INTEGER;
-		BEGIN
-			RNum(a);
-			WHILE a # 0 DO RNum(a); RNum(a) END
-		END SkipLink;
-
-	BEGIN
-		R := mod.file.NewReader(R);
-		R.SetPos(mod.hs + mod.ms + mod.ds + mod.cs);
-		SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; SkipLink;
-		i := 0;
-		WHILE i < mod.ni DO
-			imp := mod.imp[i];
-			IF imp # NIL THEN
-				RNum(x);
-				WHILE x # 0 DO
-					ReadName(name); RNum(y);
-					IF x = mVar THEN
-						SkipLink;
-						IF imp.dll THEN
-							exp := imp.exp;
-							WHILE (exp # NIL) & (exp.name # name) DO exp := exp.next END;
-							IF exp = NIL THEN
-								NEW(exp); exp.name := name$;
-								exp.next := imp.exp; imp.exp := exp
-							 END
-						END
-					ELSIF x = mTyp THEN RNum(y);
-						IF imp.dll THEN
-							RNum(y);
-							IF y # 0 THEN
-								WriteString("type descriptor (");
-								WriteString(imp.name$); WriteChar(".");
-								WriteSString(name);
-								WriteString(") imported from DLL in ");
-								WriteString(mod.name$);
-								WriteLn; FlushW; error := TRUE;
-								RETURN
-							END
-						ELSE SkipLink
-						END
-					ELSIF x = mProc THEN
-						IF imp.dll THEN
-							SkipLink;
-							exp := imp.exp;
-							WHILE (exp # NIL) & (exp.name # name) DO exp := exp.next END;
-							IF exp = NIL THEN
-								NEW(exp); exp.name := name$;
-								exp.next := imp.exp; imp.exp := exp
-							 END
-						END
-					END;
-					RNum(x)
-				END
-			END;
-			INC(i)
-		END
-	END CheckDllImports;
-
-	PROCEDURE ReadHeaders;
-		VAR mod, im, t: Module; x, i, pos: INTEGER; impdll: BOOLEAN; name: Name;
-	BEGIN
-		ASSERT(isDll, 126);
-		mod := modList; modList := NIL; numMod := 0;
-		WHILE mod # NIL DO	(* reverse mod list & count modules *)
-			IF ~mod.dll THEN INC(numMod) END;
-			t := mod; mod := t.next; t.next := modList; modList := t
-		END;
-		IF isStatic THEN
-			CodeSize :=
-				6 + 5 * numMod + 2	(* _init() *)
-				+ 1 + 5 * numMod + 2	(* _fini() *)
-		ELSE
-			CodeSize :=
-				6 + 5 + 2	(* _init() *)
-				+ 1 + 5 + 2	(* _fini() *)
-		END;
-		DataSize := 0; ConSize := 0;
-		maxCode := 0; numExp := 0;
-		mod := modList;
-		WHILE mod # NIL DO
-			IF ~mod.dll THEN
-				mod.file := ThisFile(mod.fileName);
-				IF mod.file # NIL THEN
-					R := mod.file.NewReader(R); R.SetPos(0);
-					Read4(x);
-					IF x = 6F4F4346H THEN
-						Read4(x);
-						Read4(mod.hs); Read4(mod.ms); Read4(mod.ds); Read4(mod.cs);
-						Read4(mod.vs); RNum(mod.ni); ReadName(mod.name); impdll := FALSE;
-						IF mod.ni > 0 THEN
-							NEW(mod.imp, mod.ni);
-							x := 0;
-							WHILE x < mod.ni DO
-								ReadName(name);
-								IF name = "$$" THEN
-									IF (mod # kernel) & (kernel # NIL) THEN
-										mod.imp[x] := kernel
-									ELSE
-										WriteSString("no kernel"); WriteLn;
-										FlushW; error := TRUE
-									END
-								ELSIF name[0] = "$" THEN
-									(* StdLog.String(name$);  *)
-									Console.WriteStr(name$);
-									i := 1;
-									WHILE name[i] # 0X DO name[i-1] := name[i]; INC(i) END;
-									name[i-1] := 0X; 
-									IF i # 1 THEN
-										Strings.Find(name$, ".so", 0, pos);
-										IF pos = -1 THEN
-											name[i - 1] := "."; name[i] := "s"; name[i + 1] := "o"; name[i + 2] := 0X
-										END
-									END;
-									(* StdLog.String("  "); StdLog.String(name$); StdLog.Ln; *)
-									Console.WriteStr(" "); Console.WriteStr(name$); Console.WriteLn;
-									impdll := TRUE; im := modList;
-									WHILE (im # mod) & (im.name # name) DO im := im.next END;
-									IF (im = NIL) OR ~im.dll THEN
-										NEW(im); im.next := modList; modList := im;
-										im.dll := TRUE;
-										im.name := name$; 
-										dynstrtab.AddName(name, i);
-										AddNeededIdx(i)
-									END;
-									mod.imp[x] := im
-								ELSE
-									im := modList;
-									WHILE (im # mod) & (im.name # name) DO im := im.next END;
-									IF im # mod THEN
-										mod.imp[x] := im
-									ELSE
-										WriteSString(name);
-										WriteString(" not present (imported in ");
-										WriteString(mod.name$); WriteChar(")");
-										WriteLn; FlushW; error := TRUE
-									END
-								END;
-								INC(x)
-							END
-						END;
-						IF impdll & ~error THEN CheckDllImports(mod) END;
-						mod.ma := ConSize; INC(ConSize, mod.ms + mod.ds);
-						mod.va := DataSize; INC(DataSize, mod.vs);
-						mod.ca := CodeSize; INC(CodeSize, mod.cs);
-						IF mod.cs > maxCode THEN maxCode := mod.cs END
-					ELSE
-						WriteString(mod.name$); WriteString(": wrong file type"); 
-						WriteLn; FlushW; error := TRUE
-					END;
-					mod.file.Close; mod.file := NIL
-				ELSE
-					WriteString(mod.fileName$ (* A. V. Shiryaev *)); WriteString(" not found"); 
-					WriteLn; FlushW; error := TRUE
-				END;
-				last := mod
-			END;
-			mod := mod.next
-		END;
-		IF ~isStatic & (main = NIL) THEN
-			WriteSString("no main module specified"); WriteLn;
-			FlushW; error := TRUE
-		END;
-		IF DataSize = 0 THEN DataSize := 1 END
-	END ReadHeaders;
-
-	PROCEDURE WriteElfHeader;
-	BEGIN
-		ASSERT(Ro.Pos() = 0, 100);
-		dynstrtab.AddName(soName$, sonameStrIndexVal);
-		Write4(464C457FH); Write4(00010101H); Write4(0); Write4(0); (* Magic *)
-		Write2(3); (* ET_DYN e_type Object file type *)
-		Write2(3); (* EM_386 e_machine Architecture *)
-		Write4(1); (* EV_CURRENT e_version Object file version *)
-		Write4(text.memOffset); (* e_entry Entry point virtual address *)
-		entryPos := Ro.Pos();
-		Write4(fixup); (* e_phoff Program header table file offset *)
-		Write4(fixup); (* e_shoff: Section header table file offset *)
-		Write4(0); (* e_flags Processor-specific flags *)
-		Write2(elfHeaderSizeVal); (* e_ehsize ELF header size in bytes *)
-		Write2(phEntrySizeVal); (* e_phentsize Program header table entry size *)
-		Write2(phNumVal); (* e_phnum Program header table entry count *)
-		Write2(shEntrySizeVal); (* e_shentsize Section header table entry size *)
-		Write2(shNumVal); (* e_shnum Section header table entry count *)
-		Write2(shStrndxVal); (* e_shstrndx Section header string table index *)
-		ASSERT(Ro.Pos() = elfHeaderSizeVal, 101)
-	END WriteElfHeader;
-
-	PROCEDURE FixupElfHeader;
-	BEGIN
-		Ro.SetPos(entryPos);
-		Write4(phOffsetVal);
-		Write4(shOffsetVal)
-	END FixupElfHeader;
-
-	PROCEDURE WriteNullSectionHeader;
-	BEGIN
-		Write4(0); (* sh_name Section name (string tbl index) *)
-		Write4(0); (* SHT_NULL sh_type Section type *)
-		Write4(0); (* sh_flags Section flags *)
-		Write4(0); (* ELF header + program header table; sh_addr Section virtual addr at execution *)
-		Write4(0); (* sh_offset Section file offset *)
-		Write4(0); (* sh_size Section size in bytes *)
-		Write4(0); (* SHN_UNDEF sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(0); (* sh_addralign Section alignment *)
-		Write4(0) (* sh_entsize Entry size if section holds table *)
-	END WriteNullSectionHeader;
-
-	PROCEDURE WriteTextSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".text", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(1); (* SHT_PROGBITS sh_type Section type *)
-		Write4(2H + 4H); (* SHF_ALLOC + SHF_EXECINSTR sh_flags Section flags *)
-		Write4(text.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(text.fileOffset); (* sh_offset Section file offset *)
-		Write4(text.size); (* sh_size Section size in bytes *)
-		Write4(0); (* SHN_UNDEF sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(textAlign); (* sh_addralign Section alignment *)
-		Write4(0) (* sh_entsize Entry size if section holds table *)
-	END WriteTextSectionHeader;
-
-	PROCEDURE WriteRelTextSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".rel.text", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(9); (* SHT_REL sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(reltext.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(reltext.fileOffset); (* sh_offset Section file offset *)
-		Write4(reltext.size); (* sh_size Section size in bytes *)
-		Write4(dynsymIndexVal); (* sh_link Link to another section -> index of the associated symbol table *)
-		Write4(textIndexVal); (* sh_info Additional section information -> index of the relocated section *)
-		Write4(relAlign); (* sh_addralign Section alignment *)
-		Write4(relEntrySizeVal) (* sh_entsize Entry size if section holds table *)
-	END WriteRelTextSectionHeader;
-
-	PROCEDURE WriteRelRodataSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".rel.rodata", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(9); (* SHT_REL sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(relrodata.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(relrodata.fileOffset); (* sh_offset Section file offset *)
-		Write4(relrodata.size); (* sh_size Section size in bytes *)
-		Write4(dynsymIndexVal); (* sh_link Link to another section -> index of the associated symbol table *)
-		Write4(rodataIndexVal); (* sh_info Additional section information -> index of the relocated section *)
-		Write4(relAlign); (* sh_addralign Section alignment *)
-		Write4(relEntrySizeVal) (* sh_entsize Entry size if section holds table *)
-	END WriteRelRodataSectionHeader;
-
-	PROCEDURE WriteRodataSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".rodata", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(1); (* SHT_PROGBITS sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(rodata.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(rodata.fileOffset); (* sh_offset Section file offset *)
-		Write4(rodata.size); (* sh_size Section size in bytes *)
-		Write4(0); (* sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(rodataAlign); (* sh_addralign Section alignment *)
-		Write4(0) (* sh_entsize Entry size if section holds table *)
-	END WriteRodataSectionHeader;
-
-	PROCEDURE WriteDynsymSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".dynsym", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(11); (* SHT_DYNSYM sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(dynsym.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(dynsym.fileOffset); (* sh_offset Section file offset *)
-		Write4(dynsym.size); (* sh_size Section size in bytes *)
-		Write4(dynstrIndexVal); (* sh_link Link to another section -> index of the associated string table *)
-		expPos := Ro.Pos();
-		Write4(fixup); (* sh_info Additional section information -> see docu 4-17 *)
-		Write4(dynsymAlign); (* sh_addralign Section alignment *)
-		Write4(dynsymEntrySizeVal) (* sh_entsize Entry size if section holds table *)
-	END WriteDynsymSectionHeader;
-
-	PROCEDURE FixupDynsymSectionHeader;
-	BEGIN
-		Ro.SetPos(expPos);
-		Write4(dynsymInfoVal)
-	END FixupDynsymSectionHeader;
-	
-	PROCEDURE WriteDynstrSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".dynstr", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(3); (* SHT_STRTAB sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(dynstr.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(dynstr.fileOffset); (* sh_offset Section file offset *)
-		Write4(dynstr.size); (* sh_size Section size in bytes *)
-		Write4(0); (* SHN_UNDEF sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(dynstrAlign); (* sh_addralign Section alignment *)
-		Write4(0) (* sh_entsize Entry size if section holds table *)
-	END WriteDynstrSectionHeader;
-	
-	PROCEDURE WriteHashSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".hash", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(5); (* SHT_HASH sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(hash.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(hash.fileOffset); (* sh_offset Section file offset *)
-		Write4(hash.size); (* sh_size Section size in bytes *)
-		Write4(dynsymIndexVal); (* sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(hashAlign); (* sh_addralign Section alignment *)
-		Write4(4H) (* sh_entsize Entry size if section holds table *)
-	END WriteHashSectionHeader;
-
-	PROCEDURE WriteGotSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".got", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(1); (* SHT_PROGBITS sh_type Section type *)
-		Write4(2H + 1H); (* SHF_ALLOC + SHF_WRITE sh_flags Section flags *)
-		Write4(got.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(got.fileOffset); (* sh_offset Section file offset *)
-		Write4(got.size); (* sh_size Section size in bytes *)
-		Write4(0); (* SHN_UNDEF sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(gotAlign); (* sh_addralign Section alignment *)
-		Write4(gotEntrySizeVal) (* sh_entsize Entry size if section holds table *)
-	END WriteGotSectionHeader;
-	
-	PROCEDURE WriteBssSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".bss", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(8); (* SHT_NOBITS sh_type Section type *)
-		Write4(2H + 1H); (* SHF_ALLOC + SHF_WRITE sh_flags Section flags *)
-		Write4(bss.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(bss.fileOffset); (* sh_offset Section file offset *)
-		Write4(bss.size); (* sh_size Section size in bytes *)
-		Write4(0); (* SHN_UNDEF sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(bssAlign); (* sh_addralign Section alignment *)
-		Write4(0) (* sh_entsize Entry size if section holds table *)
-	END WriteBssSectionHeader;
-	
-	PROCEDURE WriteDynamicSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".dynamic", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(6); (* SHT_DYNAMIC sh_type Section type *)
-		Write4(2H); (* SHF_ALLOC sh_flags Section flags *)
-		Write4(dynamic.memOffset); (* sh_addr Section virtual addr at execution *)
-		Write4(dynamic.fileOffset); (* sh_offset Section file offset *)
-		Write4(dynamic.size); (* sh_size Section size in bytes *)
-		Write4(dynstrIndexVal); (* sh_link Link to another section -> index of the associated symbol table *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(dynamicAlign); (* sh_addralign Section alignment *)
-		Write4(dynamicEntrySizeVal) (* sh_entsize Entry size if section holds table *)
-	END WriteDynamicSectionHeader;
-	
-	PROCEDURE WriteShstrtabSectionHeader;
-		VAR i: INTEGER;
-	BEGIN
-		headerstrtab.AddName(".shstrtab", i);
-		Write4(i); (* sh_name Section name (string tbl index) *)
-		Write4(3); (* SHT_STRTAB sh_type Section type *)
-		Write4(0); (* sh_flags Section flags *)
-		Write4(0); (* sh_addr Section virtual addr at execution *)
-		Write4(shstrtab.fileOffset); (* sh_offset Section file offset *)
-		shstrtabPos := Ro.Pos();
-		Write4(fixup); (* sh_size Section size in bytes *)
-		Write4(0); (* SHN_UNDEF sh_link Link to another section *)
-		Write4(0); (* sh_info Additional section information *)
-		Write4(shstrtabAlign); (* sh_addralign Section alignment *)
-		Write4(0) (* sh_entsize Entry size if section holds table *)
-	END WriteShstrtabSectionHeader;
-	
-	PROCEDURE FixupShstrtabSectionHeader;
-	BEGIN
-		Ro.SetPos(shstrtabPos);
-		Write4(shstrtab.size)
-	END FixupShstrtabSectionHeader;
-
-	PROCEDURE WriteRelSectionHeaders;
-	BEGIN
-		WriteRelTextSectionHeader;
-		WriteRelRodataSectionHeader
-	END WriteRelSectionHeaders;
-	
-	PROCEDURE WriteSectionHeaderTable;
-	BEGIN
-		shOffsetVal := Ro.Pos();
-		WriteNullSectionHeader;
-		WriteTextSectionHeader;
-		WriteRodataSectionHeader;
-		WriteRelSectionHeaders;
-		WriteDynsymSectionHeader;
-		WriteDynstrSectionHeader;
-		WriteHashSectionHeader;
-		WriteGotSectionHeader;
-		WriteDynamicSectionHeader;
-		WriteBssSectionHeader;
-		WriteShstrtabSectionHeader	(* see shStrndxVal *)
-		(* see shNumVal *)
-	END WriteSectionHeaderTable;
-
-	PROCEDURE FixupSectionHeaderTable;
-	BEGIN
-		FixupDynsymSectionHeader;
-		FixupShstrtabSectionHeader
-	END FixupSectionHeaderTable;
-
-	PROCEDURE WriteTextSegment;
-	BEGIN
-		Write4(1); (* PT_LOAD *)
-		Write4(0); (* offset *)
-		Write4(0); (* vaddr *)
-		Write4(0); (* paddr *)
-		Write4(textSegmentSizeVal); (* file size *)
-		Write4(textSegmentSizeVal); (* mem size *)
-		Write4(4H + 1H + 2H); (* flags: R+E+W *)
-		Write4(pageSize) (* I386 page size *)
-	END WriteTextSegment;
-	
-	PROCEDURE WriteDataSegment;
-	BEGIN
-		Write4(1); (* PT_LOAD *)
-		Write4(got.fileOffset); (* offset text segment size *)
-		Write4(got.memOffset); (* vaddr: offset + alignment * nof pages of text segment *)
-		Write4(got.memOffset); (* paddr: offset + alignment * nof pages of text segment *)
-		Write4(dataSegmentSizeVal); (* file size *)
-		Write4(dataSegmentSizeVal + bss.size); (* mem size -> dataSegmentSizeVal + NOBITS sections *)
-		Write4(4H + 2H); (* flags: R+W *)
-		Write4(pageSize) (* I386 page size *)
-	END WriteDataSegment;
-	
-	PROCEDURE WriteDynamicSegment;
-	BEGIN
-		Write4(2); (* PT_DYNAMIC *)
-		Write4(dynamic.fileOffset); (* offset text segment size *)
-		Write4(dynamic.memOffset); (* vaddr: offset of .dynamic section *)
-		Write4(dynamic.memOffset); (* paddr: vaddr + alignment * nof pages of text segment *)
-		Write4(dynamicSegmentSizeVal); (* file size *)
-		Write4(dynamicSegmentSizeVal); (* mem size *)
-		Write4(4H + 2H); (* flags: R+W *)
-		Write4(dynamicAlign) (* dynamic section alignement*)
-	END WriteDynamicSegment;
-	
-	PROCEDURE WriteProgramHeaderTable;
-	BEGIN
-		phOffsetVal := Ro.Pos();
-		WriteTextSegment; (* .text .rel.text .rodata .dynsym .dynstr .hash *)
-		WriteDataSegment; (* .got .dynamic .bss *)
-		WriteDynamicSegment (* .dynamic *)
-	END WriteProgramHeaderTable;
-	
-	PROCEDURE SearchObj (mod: Module; VAR name: ARRAY OF SHORTCHAR; m, fp, opt: INTEGER; VAR adr: INTEGER);
-		VAR dir, len, ntab, f, id, l, r, p, n, i, j: INTEGER; nch, och: SHORTCHAR;
-	BEGIN
-		Get(mod, mod.ms + modExports, dir); DEC(dir, rodata.memOffset + mod.ma); Get(mod, dir, len); INC(dir, 4);
-		Get(mod, mod.ms + modNames, ntab); DEC(ntab, rodata.memOffset + mod.ma);
-		IF name # "" THEN
-			l := 0; r := len;
-			WHILE l < r DO	(* binary search *)
-				n := (l + r) DIV 2; p := dir + n * 16;
-				Get(mod, p + 8, id);
-				i := 0; j := ntab + id DIV 256; nch := name[0]; och := SHORT(CHR(mod.data[j]));
-				WHILE (nch = och) & (nch # 0X) DO INC(i); INC(j); nch := name[i]; och := SHORT(CHR(mod.data[j])) END;
-				IF och = nch THEN
-					IF id MOD 16 = m THEN
-						Get(mod, p, f);
-						IF m = mTyp THEN
-							IF ODD(opt) THEN Get(mod, p + 4, f) END;
-							IF (opt > 1) & (id DIV 16 MOD 16 # mExported) THEN
-								WriteString(mod.name$); WriteChar("."); WriteSString(name);
-								WriteString(" imported from "); WriteString(impg.name$);
-								WriteString(" has wrong visibility"); WriteLn; error := TRUE
-							END;
-							Get(mod, p + 12, adr)
-						ELSIF m = mVar THEN
-							Get(mod, p + 4, adr); INC(adr, bss.memOffset + mod.va)
-						ELSIF m = mProc THEN
-							Get(mod, p + 4, adr); INC(adr, text.memOffset + mod.ca)
-						END;
-						IF f # fp THEN
-							WriteString(mod.name$); WriteChar("."); WriteSString(name);
-							WriteString(" imported from "); WriteString(impg.name$);
-							WriteString(" has wrong fprint"); WriteLn; error := TRUE
-						END
-					ELSE
-						WriteString(mod.name$); WriteChar("."); WriteSString(name);
-						WriteString(" imported from "); WriteString(impg.name$);
-						WriteString(" has wrong class"); WriteLn; error := TRUE
-					END;
-					RETURN
-				END;
-				IF och < nch THEN l := n + 1 ELSE r := n END
-			END;
-			WriteString(mod.name$); WriteChar("."); WriteSString(name);
-			WriteString(" not found (imported from "); WriteString(impg.name$);
-			WriteChar(")"); WriteLn; error := TRUE
-		ELSE (* anonymous type *)
-			WHILE len > 0 DO
-				Get(mod, dir + 4, f); Get(mod, dir + 8, id);
-				IF (f = fp) & (id MOD 16 = mTyp) & (id DIV 256 = 0) THEN
-					Get(mod, dir + 12, adr); RETURN
-				END;
-				DEC(len); INC(dir, 16)
-			END;
-			WriteString("anonymous type in "); WriteString(mod.name$);
-			WriteString(" not found"); WriteLn; error := TRUE
-		END
-	END SearchObj;
-	
-	PROCEDURE CollectExports (mod: Module);
-		VAR dir, len, ntab, id, i, j, n: INTEGER; e, exp: Export;
-	BEGIN
-		ASSERT(mod.intf & ~mod.dll, 20);
-		Get(mod, mod.ms + modExports, dir);
-		DEC(dir, rodata.memOffset + mod.ma); Get(mod, dir, len); INC(dir, 4);
-		Get(mod, mod.ms + modNames, ntab); DEC(ntab, rodata.memOffset + mod.ma); n := 0;
-		WHILE n < len DO
-			Get(mod, dir + 8, id);
-			IF (id DIV 16 MOD 16 # mInternal) & (id MOD 16 = mProc) THEN	(* exported procedure *)
-				NEW(exp);
-				i := 0; j := ntab + id DIV 256;
-				WHILE mod.data[j] # 0 DO exp.name[i] := SHORT(CHR(mod.data[j])); INC(i); INC(j) END;
-				exp.name[i] := 0X;
-				Get(mod, dir + 4, exp.adr);
-				IF id MOD 16 = mProc THEN
-					INC(exp.adr, text.memOffset + mod.ca)
-				ELSE
-					HALT(126);
-					ASSERT(id MOD 16 = mVar); INC(exp.adr, bss.memOffset + mod.va)
-				END;
-				IF (firstExp = NIL) OR (exp.name < firstExp.name) THEN
-					exp.next := firstExp; firstExp := exp;
-					IF lastExp = NIL THEN lastExp := exp END
-				ELSE
-					e := firstExp;
-					WHILE (e.next # NIL) & (exp.name > e.next.name) DO e := e.next END;
-					exp.next := e.next; e.next := exp;
-					IF lastExp = e THEN lastExp := exp END
-				END;
-				INC(numExp)
-			END;
-			INC(n); INC(dir, 16)
-		END
-	END CollectExports;
-
-	PROCEDURE Relocate0 (link, adr, sym: INTEGER);
-		CONST
-			absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; (* BB fixup types *)
-			noElfType = MIN(INTEGER);
-		VAR
-			offset, linkadr, bbType, elfType, n, x: INTEGER; relText: BOOLEAN;
-	BEGIN
-		WHILE link # 0 DO
-			RNum(offset);
-			WHILE link # 0 DO
-				IF link > 0 THEN
-					n := (code[link] MOD 256) + (code[link+1] MOD 256) * 256 + code[link+2] * 65536;
-					bbType := code[link+3];
-					linkadr := text.memOffset + impg.ca + link
-				ELSE
-					n := (impg.data[-link] MOD 256) + (impg.data[-link+1] MOD 256) * 256 + impg.data[-link+2] * 65536;
-					bbType := impg.data[-link+3];
-					linkadr := rodata.memOffset + impg.ma - link
-				END;
-				elfType := noElfType;
-				IF bbType = absolute THEN
-					IF sym = noSymbol THEN
-						x := adr + offset;
-						elfType := r386Relative
-					ELSE
-						x := 0H;
-						elfType := r38632 + sym * 256
-					END
-				ELSIF bbType = relative THEN
-					IF sym = noSymbol THEN
-						x := adr + offset - linkadr - 4
-					ELSE
-						x := 0FFFFFFFCH;
-						elfType := r386pc32 + sym * 256
-					END
-				ELSIF bbType = copy THEN
-					Get(impd, adr + offset - rodata.memOffset - impd.ma, x);
-					IF x # 0 THEN elfType := r386Relative END
-				ELSIF bbType = table THEN
-					x := adr + n; n := link + 4;
-					elfType := r386Relative
-				ELSIF bbType = tableend THEN
-					x := adr + n; n := 0;
-					elfType := r386Relative
-				ELSE HALT(99)
-				END;
-				relText := link > 0; 
-				IF link > 0 THEN
-					code[link] := SHORT(SHORT(x));
-					code[link+1] := SHORT(SHORT(x DIV 100H));
-					code[link+2] := SHORT(SHORT(x DIV 10000H));
-					code[link+3] := SHORT(SHORT(x DIV 1000000H))
-				ELSE
-					link := -link;
-					impg.data[link] := SHORT(SHORT(x));
-					impg.data[link+1] := SHORT(SHORT(x DIV 100H));
-					impg.data[link+2] := SHORT(SHORT(x DIV 10000H));
-					impg.data[link+3] := SHORT(SHORT(x DIV 1000000H))
-				END;
-				IF elfType # noElfType THEN
-					IF relText THEN
-						relTextTab.Add(linkadr, elfType)
-					ELSE
-						relRodataTab.Add(linkadr, elfType)
-					END
-				END;
-				link := n
-			END;
-			RNum(link)
-		END
-	END Relocate0;
-	
-	PROCEDURE Relocate (adr: INTEGER);
-		VAR link: INTEGER;
-	BEGIN
-		RNum(link); Relocate0(link, adr, noSymbol)
-	END Relocate;
-
-	PROCEDURE RelocateSymbol (adr, sym: INTEGER);
-		VAR link: INTEGER;
-	BEGIN
-		RNum(link); Relocate0(link, adr, sym)
-	END RelocateSymbol;
-	
-	PROCEDURE SymbolIndex (IN name: Name): INTEGER;
-		VAR n: INTEGER; exp: Export; m: Module;
-	BEGIN
-		n := 0; exp := NIL;
-		m := modList;
-		WHILE (m # NIL) & (exp = NIL) DO
-			IF m.dll THEN
-				exp := m.exp;
-				WHILE (exp # NIL) & (exp.name$ # name$) DO
-					INC(n);
-					exp := exp.next
-				END
-			END;
-			m := m.next
-		END;
-		ASSERT((exp # NIL) & (exp.name$ = name$), 60);
-		RETURN firstDllSymbolVal + n
-	END SymbolIndex;
-
-	PROCEDURE WriteTextSection;
-		VAR mod, m: Module; i, x, a, sym, fp, opt: INTEGER; exp: Export; name: Name;
-	BEGIN
-		ASSERT(isDll, 126);
-		ASSERT(~doWrite OR (Ro.Pos() = text.fileOffset), 100);
-		WriteCh(053X);	(* push ebx *)	(* _init() *)
-		a := 1;
-		WriteCh(0BBX); Write4(rodata.memOffset  + last.ma + last.ms);	(* mov bx, modlist *)
-		relTextTab.Add(text.memOffset + a + 1, r386Relative);
-		INC(a, 5);
-		IF isStatic THEN
-			m := modList;
-			WHILE m # NIL DO
-				IF ~m.dll THEN
-					WriteCh(0E8X); INC(a, 5); Write4(m.ca - a)	(* call body *)
-				END;
-				m := m.next
-			END
-		ELSE
-			WriteCh(0E8X); INC(a, 5); Write4(main.ca - a)	(* call main *)
-		END;
-		WriteCh(05BX); 	(* pop ebx *)
-		WriteCh(0C3X);	(* ret *)
-		INC(a, 2);
-		finiMemOffsetVal := text.memOffset + a;
-		WriteCh(053X);	(* push ebx *)	(* _fini() *)
-		INC(a);
-		finiPos := text.memOffset + a;
-		IF isStatic THEN
-			i := 0;
-			WHILE i < numMod DO	(* nop for call terminator *)
-				WriteCh(02DX); Write4(0);	(* sub EAX, 0 *)
-				INC(i); INC(a, 5)
-			END
-		ELSE
-			WriteCh(02DX); Write4(0);	(* sub EAX, 0 *)
-			INC(a, 5)
-		END;
-		lastTerm := a;
-		WriteCh(05BX); 	(* pop ebx *)
-		WriteCh(0C3X);	(* ret *)	
-		IF ~doWrite THEN NEW(code, maxCode) END;
-		mod := modList;
-		WHILE mod # NIL DO
-			impg := mod;
-			impd := mod;
-			IF ~mod.dll THEN
-				mod.file := ThisFile(mod.fileName);
-				R := mod.file.NewReader(R);
-				R.SetPos(mod.hs);
-				IF ~doWrite THEN NEW(mod.data, mod.ms + mod.ds) END;
-				R.ReadBytes(mod.data^, 0, mod.ms + mod.ds);
-				R.ReadBytes(code^, 0, mod.cs);
-				RNum(x);
-				IF x # 0 THEN
-					IF (mod # kernel) & (kernel # NIL) THEN
-						SearchObj(kernel, newRec, mProc, NewRecFP, 0, a);
-						IF error THEN RETURN END;
-						Relocate0(x, a, noSymbol)
-					ELSE
-						WriteSString("no kernel"); WriteLn;
-						FlushW;
-						error := TRUE;
-						RETURN
-					END
-				END;
-				RNum(x);
-				IF x # 0 THEN
-					IF (mod # kernel) & (kernel # NIL) THEN
-						SearchObj(kernel, newArr, mProc, NewArrFP, 0, a);
-						IF error THEN RETURN END;
-						Relocate0(x, a, noSymbol)
-					ELSE
-						WriteSString("no kernel"); WriteLn;
-						FlushW; error := TRUE;
-						RETURN
-					END
-				END;
-				Relocate(rodata.memOffset + mod.ma); (* metalink *)
-				Relocate(rodata.memOffset + mod.ma + mod.ms); (* desclink *)
-				Relocate(text.memOffset + mod.ca); (* codelink *)
-				Relocate(bss.memOffset + mod.va); (* datalink *)
-				i := 0;
-				WHILE i < mod.ni DO
-					m := mod.imp[i]; impd := m; RNum(x);
-					WHILE x # 0 DO
-						ReadName(name); RNum(fp); opt := 0;
-						IF x = mTyp THEN RNum(opt) END;
-						sym := noSymbol;
-						IF m.dll THEN
-							IF (x = mProc) OR (x = mVar) THEN
-								exp := m.exp;
-								WHILE exp.name # name DO exp := exp.next END;
-								a := noAddr;
-								sym := SymbolIndex(name)
-							END
-						ELSE
-							SearchObj(m, name, x, fp, opt, a);
-							IF error THEN RETURN END
-						END;
-						IF x # mConst THEN
-							RelocateSymbol(a, sym)
-						END;
-						RNum(x)
-					END;
-					IF ~m.dll THEN
-						Get(mod, mod.ms + modImports, x); DEC(x, rodata.memOffset + mod.ma); INC(x, 4 * i);
-						Put(mod, x, rodata.memOffset + m.ma + m.ms);	(* imp ref *)
-						relRodataTab.Add(rodata.memOffset + mod.ma + x, r386Relative);
-						Get(m, m.ms + modRefcnt, x); Put(m, m.ms + modRefcnt, x + 1)	(* inc ref count *)
-					END;
-					INC(i)
-				END;
-				WriteBytes(code^, 0, mod.cs);
-				IF mod.intf THEN CollectExports(mod) END;
-				mod.file.Close; mod.file := NIL
-			END;
-			mod := mod.next
-		END;
-		ASSERT(~doWrite OR (text.size = Ro.Pos() - text.fileOffset), 101)
-	END WriteTextSection;
-
-	PROCEDURE WriteTermCode (m: Module; i: INTEGER);
-		VAR x: INTEGER;
-	BEGIN
-		IF m # NIL THEN
-			IF m.dll THEN WriteTermCode(m.next, i)
-			ELSE
-				IF isStatic THEN WriteTermCode(m.next, i + 1) END;
-				Get(m, m.ms + modTerm, x);	(* terminator address in mod desc*)
-				IF x = 0 THEN
-					WriteCh(005X); Write4(0)	(* add EAX, 0 (nop) *)
-				ELSE
-					WriteCh(0E8X); Write4(x - lastTerm + 5 * i - text.memOffset)	(* call term *)
-				END
-			END
-		END
-	END WriteTermCode;
-
-	PROCEDURE FixupTextSection;
-	BEGIN
-		ASSERT(isDll, 126);
-		Ro.SetPos(finiPos);
-		IF isStatic THEN
-			WriteTermCode(modList, 0)
-		ELSE
-			WriteTermCode(main, 0)
-		END
-	END FixupTextSection;
-
-	PROCEDURE WriteRelSection (IN s: Section; IN t: RelTab);
-		VAR i: INTEGER;
-	BEGIN
-		ASSERT(s.fileOffset = Ro.Pos(), 100);
-		i := 0;
-		WHILE i # t.cur DO
-			Write4(t.tab[i].offset);
-			Write4(t.tab[i].type);
-			INC(i)
-		END;
-		ASSERT(s.size = Ro.Pos() - s.fileOffset, 101)
-	END WriteRelSection;
-
-	PROCEDURE WriteRelSections;
-	BEGIN
-		WriteRelSection(reltext, relTextTab);
-		WriteRelSection(relrodata, relRodataTab)
-	END WriteRelSections;
-	
-	PROCEDURE WriteRodataSection;
-		VAR mod, lastMod: Module; x: INTEGER;
-	BEGIN
-		ASSERT(~doWrite OR (rodata.fileOffset = Ro.Pos()), 100);
-		mod := modList; lastMod := NIL;
-		WHILE mod # NIL DO
-			IF ~mod.dll THEN
-				IF lastMod # NIL THEN
-					Put(mod, mod.ms, rodata.memOffset + lastMod.ma + lastMod.ms);	(* mod list *)
-					relRodataTab.Add(rodata.memOffset + mod.ma + mod.ms, r386Relative)
-				END;
-				Get(mod, mod.ms + modOpts, x);
-				IF isStatic THEN INC(x, 10000H) END;	(* set init bit (16) *)
-				IF isDll THEN INC(x, 1000000H) END;	(* set dll bit (24) *)
-				Put(mod, mod.ms + modOpts, x);
-				WriteBytes(mod.data^, 0, mod.ms + mod.ds);
-				lastMod := mod
-			END;
-			mod := mod.next
-		END;		
-		ASSERT(~doWrite OR (rodata.size = Ro.Pos() - rodata.fileOffset), 101)
-	END WriteRodataSection;
-		
-	PROCEDURE WriteSymbolTableEntry (IN name: ARRAY OF SHORTCHAR; val, size: INTEGER; bind, type: BYTE; shndx: INTEGER);
-		VAR i: INTEGER; info: SHORTCHAR;
-	BEGIN
-		IF name # "" THEN dynstrtab.AddName(name, i)
-		ELSE i := 0
-		END;
-		Write4(i);
-		Write4(val);
-		Write4(size);
-		info := SHORT(CHR(bind * 16 + type));
-		WriteCh(info);
-		WriteCh(0X); (* Symbol visibility *)
-		Write2(shndx)
-	END WriteSymbolTableEntry;
-	
-	PROCEDURE FixupSymbolTableEntry (val, size: INTEGER; bind, type: BYTE; shndx: INTEGER);
-		VAR info: SHORTCHAR;
-	BEGIN
-		Ro.SetPos(Ro.Pos() + 4); (* skip name *)
-		Write4(val);
-		Write4(size);
-		info := SHORT(CHR(bind * 16 + type));
-		WriteCh(info);
-		WriteCh(0X); (* Symbol visibility *)
-		Write2(shndx)
-	END FixupSymbolTableEntry;
-	
-	PROCEDURE WriteDynsymSection;
-		VAR e: Export; m: Module; i: INTEGER;
-	BEGIN
-		ASSERT(Ro.Pos() = dynsym.fileOffset, 100);
-		WriteSymbolTableEntry("", 0, 0, 0, 0, 0);
-		WriteSymbolTableEntry("", text.memOffset, 0, stbLocal, sttSection, 1); (* .text section *)
-		WriteSymbolTableEntry("", rodata.memOffset, 0, stbLocal, sttSection, 2); (* .rodata section *)
-		WriteSymbolTableEntry("", reltext.memOffset, 0, stbLocal, sttSection, 3); (* .rel.text.section *)
-		WriteSymbolTableEntry("", relrodata.memOffset, 0, stbLocal, sttSection, 4); (* .rel.rodata section *)
-		WriteSymbolTableEntry("", dynsym.memOffset, 0, stbLocal, sttSection, 5); (* .dynsym section *)
-		WriteSymbolTableEntry("", dynstr.memOffset, 0, stbLocal, sttSection, 6); (* .dynstr section *)
-		WriteSymbolTableEntry("", hash.memOffset, 0, stbLocal, sttSection, 7); (* .hash section *)
-		WriteSymbolTableEntry("", got.memOffset, 0, stbLocal, sttSection, 8); (* .got section *)
-		WriteSymbolTableEntry("", dynamic.memOffset, 0, stbLocal, sttSection, 9); (* .dynamic section *)
-		WriteSymbolTableEntry("", bss.memOffset, 0, stbLocal, sttSection, 10); (* .bss section *)
-		dynsymInfoVal := 11;
-		i := dynsymInfoVal;
-		WriteSymbolTableEntry("_DYNAMIC", dynamic.memOffset, 0, stbGlobal, sttObject, shnAbs);
-		hashtab[i] := "_DYNAMIC";
-		INC(i);
-		ASSERT(i = firstDllSymbolVal);
-		m := modList;
-		WHILE m # NIL DO
-			IF m.dll THEN
-				e := m.exp;
-				WHILE e # NIL DO
-					WriteSymbolTableEntry(e.name, 0, 0, stbGlobal, sttNotype, shnUnd);
-					hashtab[i] := e.name$;
-					INC(i);
-					e := e.next
-				END
-			END;
-			m := m.next
-		END;
-		e := firstExp;
-		WHILE e # NIL DO
-			WriteSymbolTableEntry(e.name, fixup, 0, stbGlobal, sttFunc, textIndexVal);
-			hashtab[i] := e.name$; INC(i);
-			e := e.next
-		END;
-		WriteSymbolTableEntry("_GLOBAL_OFFSET_TABLE_", got.memOffset, 0, stbGlobal, sttObject, shnAbs);
-		hashtab[i] := "_GLOBAL_OFFSET_TABLE_";
-		ASSERT(dynsym.size = Ro.Pos() - dynsym.fileOffset, 101)
-	END WriteDynsymSection;
-	
-	PROCEDURE FixupDynsymSection;
-		VAR e: Export; m: Module;
-	BEGIN
-		Ro.SetPos(dynsym.fileOffset + dynsymEntrySizeVal * firstDllSymbolVal);
-		m := modList;
-		WHILE m # NIL DO
-			IF m.dll THEN
-				e := m.exp;
-				WHILE e # NIL DO
-					Ro.SetPos(Ro.Pos() + dynsymEntrySizeVal);
-					e := e.next
-				END
-			END;
-			m := m.next
-		END;
-		Ro.SetPos(Ro.Pos() + 4);
-		e := firstExp;
-		WHILE e # NIL DO
-			Write4(e.adr);
-			Ro.SetPos(Ro.Pos() + 12);
-			e := e.next
-		END
-	END FixupDynsymSection;
-
-	PROCEDURE WriteStringTable (IN t: Strtab);
-		VAR i: INTEGER;
-	BEGIN
-		i := 0;
-		WHILE i # t.cur DO
-			WriteCh(t.tab[i]);
-			INC(i)
-		END
-	END WriteStringTable;
-
-	PROCEDURE WriteDynstrSection;
-	BEGIN
-		ASSERT(Ro.Pos() = dynstr.fileOffset, 100);
-		WriteStringTable(dynstrtab);
-		ASSERT(dynstr.size = Ro.Pos() - dynstr.fileOffset, 101)
-	END WriteDynstrSection;
-
-	PROCEDURE Hash (name: ARRAY OF SHORTCHAR): INTEGER;
-		VAR i, h, g: INTEGER;
-	BEGIN
-		h := 0; i := 0;
-		WHILE name[i] # 0X DO
-			h := ASH(h, 4) + ORD(name[i]);
-			g := ORD(BITS(h) * BITS(0F0000000H));
-			IF g # 0 THEN
-				h := ORD(BITS(h) / BITS(SHORT((g MOD 100000000L) DIV 1000000H)))
-			END;
-			h := ORD(BITS(h) * (-BITS(g)));
-			INC(i)
-		END;
-		RETURN h
-	END Hash;
-
-	PROCEDURE AddToChain (VAR c: ARRAY OF INTEGER; i, idx: INTEGER);
-		VAR k: INTEGER;
-	BEGIN
-		IF c[i] # 0 THEN
-			k := i;
-			WHILE c[k] # 0 DO k := c[k] END;
-			c[k] := idx
-		ELSE
-			c[i] := idx
-		END
-	END AddToChain;
-
-	PROCEDURE WriteHashSection;
-		VAR n, i, hi: INTEGER; b, c: POINTER TO ARRAY OF INTEGER;
-	BEGIN
-		ASSERT(hash.fileOffset = Ro.Pos(), 100);
-		n := dynsym.size DIV dynsymEntrySizeVal; (* number of enties in the symbol table *)
-		NEW(b, n);
-		NEW(c, n);
-		i := 0;
-		WHILE i # n DO
-			c[i] := 0; (* STN_UNDEF *)
-			IF hashtab[i] # "" THEN
-				hi := Hash(hashtab[i]) MOD n;
-				IF b[hi] # 0 THEN (* another word has the same index *)
-					AddToChain(c, i, b[hi])  (*c[i] := b[hi]*)
-				END;
-				b[hi] := i
-			END;
-			INC(i)
-		END;
-		Write4(n); (* nbucket *)
-		Write4(n); (* nchain *)
-		i := 0;
-		WHILE i # n DO
-			Write4(b[i]);
-			INC(i)
-		END;
-		i := 0;
-		WHILE i # n DO
-			Write4(c[i]);
-			INC(i)
-		END;
-		ASSERT(hash.size = Ro.Pos() - hash.fileOffset, 101)
-	END WriteHashSection;
-	
-	PROCEDURE WriteGotSection;
-	BEGIN
-		ASSERT(got.fileOffset = Ro.Pos(), 100);
-		Write4(dynamic.memOffset); (* addr of .dynamic section *)
-		Write4(0); (* reserved for ? *)
-		Write4(0); (* reserved for ? *)
-		ASSERT(got.size = Ro.Pos() - got.fileOffset, 101)
-	END WriteGotSection;
-	
-	PROCEDURE WriteDynamicSectionEntry (tag, val: INTEGER);
-	BEGIN
-		Write4(tag);
-		Write4(val)
-	END WriteDynamicSectionEntry;
-	
-	PROCEDURE WriteDynamicSection;
-		CONST dtNull = 0; dtNeeded = 1; dtHash = 4; dtStrtab = 5; dtSymtab = 6;
-			dtStrsz = 10; dtSyment = 11; dtInit = 12; dtFini = 13; dtSoname = 14; dtRel = 17; dtRelsz = 18; dtRelent = 19;
-			dtTextrel = 22;
-		VAR i: INTEGER;
-	BEGIN
-		ASSERT(dynamic.fileOffset = Ro.Pos(), 100);
-		WriteDynamicSectionEntry(dtSoname, fixup);
-		WriteDynamicSectionEntry(dtFini, fixup);
-		WriteDynamicSectionEntry(dtInit, text.memOffset);
-		WriteDynamicSectionEntry(dtHash, hash.memOffset);
-		WriteDynamicSectionEntry(dtStrtab, dynstr.memOffset);
-		WriteDynamicSectionEntry(dtSymtab, dynsym.memOffset);
-		WriteDynamicSectionEntry(dtStrsz, dynstr.size);
-		WriteDynamicSectionEntry(dtSyment, dynsymEntrySizeVal);
-		WriteDynamicSectionEntry(dtRel, reltext.memOffset);
-		WriteDynamicSectionEntry(dtRelsz, reltext.size + relrodata.size);
-		WriteDynamicSectionEntry(dtRelent, relEntrySizeVal);
-		i := 0;
-		WHILE neededIdx[i] # 0 DO
-			WriteDynamicSectionEntry(dtNeeded, neededIdx[i]);
-			INC(i)
-		END;
-		WriteDynamicSectionEntry(dtTextrel, 0);
-		WriteDynamicSectionEntry(dtNull, 0); (* DT_NULL: marks the end *)
-		ASSERT(dynamic.size = Ro.Pos() - dynamic.fileOffset, 101)
-	END WriteDynamicSection;
-	
-	PROCEDURE FixupDynamicSection;
-		VAR i: INTEGER;
-	BEGIN
-		Ro.SetPos(dynamic.fileOffset + 4);
-		Write4(sonameStrIndexVal);
-		Ro.SetPos(Ro.Pos() + 4);
-		Write4(finiMemOffsetVal)
-	END FixupDynamicSection;
-	
-	PROCEDURE WriteBssSection;
-	BEGIN
-(*
-		The .bss section does not take space in the file.
-		This procedure serves consistency-check purposes.
-*)
-		ASSERT(bss.fileOffset = Ro.Pos(), 100)
-	END WriteBssSection;
-
-	PROCEDURE WriteShstrtabSection;
-	BEGIN
-		ASSERT(shstrtab.fileOffset = Ro.Pos(), 100);
-		WriteStringTable(headerstrtab);
-		shstrtab.size := Ro.Pos() - shstrtab.fileOffset
-	END WriteShstrtabSection;
-
-	PROCEDURE GetImpListSize (OUT len: INTEGER; OUT count: INTEGER);
-		VAR m: Module; e: Export;
-	BEGIN
-		len := 0; count := 0;
-		m := modList;
-		WHILE m # NIL DO
-			IF m.dll THEN
-				e := m.exp;
-				WHILE e # NIL DO
-					INC(len, LEN(e.name$) + 1);
-					INC(count);
-					e := e.next
-				END
-			END;
-			m := m.next
-		END
-	END GetImpListSize;
-	
-	PROCEDURE GetExpListSize (OUT len: INTEGER; OUT count: INTEGER);
-		VAR e: Export;
-	BEGIN
-		count := 0; len := 0;
-		e := firstExp;
-		WHILE e # NIL DO
-			INC(len, LEN(e.name$) + 1);
-			INC(count);
-			e := e.next
-		END
-	END GetExpListSize;
-	
-	PROCEDURE DynsymSize (init: INTEGER): INTEGER;
-		VAR size: INTEGER;
-	BEGIN
-		size := init;
-		INC(size, dynsymEntrySizeVal * 11); (* sections entries *)
-		INC(size, dynsymEntrySizeVal); (* _DYNAMIC symbol *)
-		INC(size, dynsymEntrySizeVal); (* _GLOBAL_OFFSET_TABLE_ symbol *)
-		RETURN size
-	END DynsymSize;
-	
-	PROCEDURE DynstrSize (init: INTEGER): INTEGER;
-		VAR size: INTEGER;
-	BEGIN
-		size := init + 1;
-		INC(size, dynstrtab.cur - 1);
-		INC(size, LEN(soName$) + 1); (* library name *)
-		INC(size, 9); (* "_DYNAMIC" symbol + 0X *)
-		INC(size, 21 + 1); (* "_GLOBAL_OFFSET_TABLE_" symbol + trailing 0X *)
-		RETURN size
-	END DynstrSize;
-	
-	PROCEDURE DynamicSize (init: INTEGER): INTEGER;
-		VAR i, size: INTEGER;
-	BEGIN
-		size := init;
-		i := 0;
-		WHILE neededIdx[i] # 0 DO
-			INC(size, dynamicEntrySizeVal);
-			INC(i)
-		END;
-		RETURN size
-	END DynamicSize;
-	
-	PROCEDURE CalculateLayout;
-		VAR headerSize, impCount, expCount, impLen, expLen: INTEGER;
-	BEGIN
-		ASSERT(~error, 20);
-		headerSize := elfHeaderSizeVal + shEntrySizeVal * shNumVal + phEntrySizeVal * phNumVal;
-		text.fileOffset := Aligned(headerSize, textAlign);
-		text.memOffset := text.fileOffset;
-		text.size := CodeSize;
-		rodata.fileOffset := Aligned(text.fileOffset + text.size, rodataAlign);
-		rodata.memOffset := rodata.fileOffset;
-		rodata.size := ConSize;
-		reltext.fileOffset := Aligned(rodata.fileOffset + rodata.size, relAlign);
-		reltext.memOffset := reltext.fileOffset;
-		doWrite := FALSE;
-		WriteTextSection;	(* this only calculates the number of text relocations *)
-		IF error THEN RETURN END;
-		reltext.size := relEntrySizeVal * relTextTab.cur;
-		relrodata.fileOffset := reltext.fileOffset + reltext.size;
-		relrodata.memOffset := relrodata.fileOffset;
-		IF ~error THEN
-			WriteRodataSection	(* this only calculates the number of data relocations *)
-		ELSE
-			RETURN
-		END;
-		relrodata.size := relEntrySizeVal * relRodataTab.cur;
-		dynsym.fileOffset := Aligned(relrodata.fileOffset + relrodata.size, dynsymAlign);
-		dynsym.memOffset := dynsym.fileOffset;
-		GetImpListSize(impLen, impCount);
-		GetExpListSize(expLen, expCount);
-		dynsym.size := DynsymSize((impCount + expCount) * dynsymEntrySizeVal);
-		dynstr.fileOffset := Aligned(dynsym.fileOffset + dynsym.size, dynstrAlign);
-		dynstr.memOffset := dynstr.fileOffset;
-		dynstr.size := DynstrSize(impLen + expLen);
-		hash.fileOffset := Aligned(dynstr.fileOffset + dynstr.size, hashAlign);
-		hash.memOffset := hash.fileOffset;
-		hash.size := 8 + dynsym.size DIV dynsymEntrySizeVal * 4 * 2;
-		got.fileOffset := Aligned(hash.fileOffset + hash.size, gotAlign);
-		got.memOffset := Aligned(got.fileOffset, pageSize) + got.fileOffset MOD pageSize;
-		got.size := 3 * gotEntrySizeVal;
-		dynamic.fileOffset := Aligned(got.fileOffset + got.size, dynamicAlign);
-		dynamic.memOffset := got.memOffset + dynamic.fileOffset - got.fileOffset;
-		dynamic.size := DynamicSize(13 * dynamicEntrySizeVal);
-		bss.fileOffset := Aligned(dynamic.fileOffset + dynamic.size, bssAlign);
-		bss.memOffset := dynamic.memOffset + bss.fileOffset - dynamic.fileOffset;		
-		bss.size := DataSize;
-		shstrtab.fileOffset := Aligned(bss.fileOffset, shstrtabAlign);
-		shstrtab.size := fixup;
-		textSegmentSizeVal := got.fileOffset;
-		dataSegmentSizeVal := shstrtab.fileOffset - got.fileOffset;
-		dynamicSegmentSizeVal := shstrtab.fileOffset - dynamic.fileOffset;
-		relTextTab.cur := 0;
-		relRodataTab.cur := 0;
-		firstExp := NIL; lastExp := NIL;
-		doWrite := TRUE
-	END CalculateLayout;
-
-	PROCEDURE WriteOut;
-		VAR res: INTEGER;
-	BEGIN
-		ASSERT(~error, 20);
-		Out := Files.dir.New(Files.dir.This(""), Files.ask);
-		IF Out # NIL THEN
-			Ro := Out.NewWriter(Ro); Ro.SetPos(0);
-			CalculateLayout;
-			IF ~error THEN WriteElfHeader END;
-			IF ~error THEN WriteSectionHeaderTable END;
-			IF ~error THEN WriteProgramHeaderTable END;
-			IF ~error THEN Align(textAlign); WriteTextSection END;
-			IF ~error THEN Align(rodataAlign); WriteRodataSection END;
-			IF ~error THEN Align(relAlign); WriteRelSections END;
-			IF ~error THEN Align(dynsymAlign); WriteDynsymSection END;
-			IF ~error THEN Align(dynstrAlign); WriteDynstrSection END;
-			IF ~error THEN Align(hashAlign); WriteHashSection END;
-			IF ~error THEN Align(gotAlign); WriteGotSection END;
-			IF ~error THEN Align(dynamicAlign); WriteDynamicSection END;
-			IF ~error THEN Align(bssAlign); WriteBssSection END;
-			IF ~error THEN Align(shstrtabAlign); WriteShstrtabSection END;
-
-			IF ~error THEN FixupElfHeader END;
-			IF ~error THEN FixupSectionHeaderTable END;
-			IF ~error THEN FixupTextSection END;
-			IF ~error THEN FixupDynsymSection END;
-			IF ~error THEN FixupDynamicSection END;
-			Out.Register(soName$, "so", Files.ask, res);
-			IF res # 0 THEN error := TRUE END
-		ELSE
-			error := TRUE
-		END
-	END WriteOut;
-	
-	PROCEDURE ResetHashtab;
-		VAR i: INTEGER;
-	BEGIN
-		i := 0;
-		WHILE i # LEN(hashtab) DO
-			hashtab[i] := "";
-			INC(i)
-		END
-	END ResetHashtab;
-
-	PROCEDURE ResetNeededIdx;
-		VAR i: INTEGER;
-	BEGIN
-		i := 0;
-		WHILE i # LEN(neededIdx) DO
-			neededIdx[i] := 0;
-			INC(i)
-		END
-	END ResetNeededIdx;
-
-	PROCEDURE MakeSoName (VAR name: ARRAY OF CHAR; type: ARRAY OF CHAR);
-		VAR i, j: INTEGER; ext: Files.Name; ch: CHAR;
-	BEGIN
-		ASSERT((type = "") OR (type[0] = "."), 20);
-		i := 0;
-		WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
-		IF name[i] = "." THEN
-			IF name[i + 1] = 0X THEN name[i] := 0X END
-		ELSIF i < LEN(name) - (LEN(type$) + 1) THEN
-			IF type = "" THEN ext := ".so" ELSE ext := type$ END;
-			j := 0; ch := ext[0];
-			WHILE ch # 0X DO
-				IF (ch >= "A") & (ch <= "Z") THEN
-					ch := CHR(ORD(ch) + ORD("a") - ORD("A"))
-				END;
-				name[i] := ch; INC(i); INC(j); ch := ext[j]
-			END;
-			name[i] := 0X
-		END
-	END MakeSoName;
-
-	(* A. V. Shiryaev: Scanner *)
-
-		PROCEDURE (VAR S: Scanner) SetPos (x: INTEGER), NEW;
-		BEGIN
-			S.rider.i := x
-		END SetPos;
-
-		PROCEDURE (VAR S: Scanner) ConnectTo (IN src: ARRAY OF CHAR), NEW;
-		BEGIN
-			NEW(S.rider.s, LEN(src$) + 1);
-			S.rider.s^ := src$;
-			S.rider.i := 0;
-			S.start := 0;
-			S.type := TMEOT
-		END ConnectTo;
-
-		PROCEDURE (VAR R: ScanRider) ReadPrevChar (VAR ch: CHAR), NEW;
-		BEGIN
-			ch := R.s[R.i]
-		END ReadPrevChar;
-
-		PROCEDURE (VAR R: ScanRider) ReadChar (VAR ch: CHAR), NEW;
-		BEGIN
-			ch := R.s[R.i];
-			INC(R.i)
-		END ReadChar;
-
-		PROCEDURE (VAR R: ScanRider) Pos (): INTEGER, NEW;
-		BEGIN
-			RETURN R.i
-		END Pos;
-
-		PROCEDURE (VAR S: Scanner) Scan, NEW;
-			VAR j: INTEGER;
-		
-			PROCEDURE IsLetter (c: CHAR): BOOLEAN;
-			BEGIN
-				RETURN ((c >= 'A') & (c <= 'Z')) OR ((c >= 'a') & (c <= 'z')) OR (c = '_')
-			END IsLetter;
-
-			PROCEDURE IsDigit (c: CHAR): BOOLEAN;
-			BEGIN
-				RETURN (c >= '0') & (c <= '9')
-			END IsDigit;
-
-		BEGIN
-			WHILE (S.rider.i < LEN(S.rider.s$)) & (S.rider.s[S.rider.i] = ' ') DO
-				INC(S.rider.i)
-			END;
-			IF S.rider.i < LEN(S.rider.s$) THEN
-				S.start := S.rider.i;
-				IF IsDigit(S.rider.s[S.rider.i]) THEN
-					S.type := TMEOT (* XXX *)
-				ELSIF IsLetter(S.rider.s[S.rider.i]) THEN
-					S.type := TMString;
-					j := 0;
-					WHILE (S.rider.i < LEN(S.rider.s$)) & (IsLetter(S.rider.s[S.rider.i]) OR IsDigit(S.rider.s[S.rider.i])) DO
-						S.string[j] := S.rider.s[S.rider.i];
-						INC(j);
-						INC(S.rider.i)
-					END;
-					S.string[j] := 0X
-				ELSE
-					S.type := TMChar;
-					S.char := S.rider.s[S.rider.i];
-					INC(S.rider.i)
-				END
-			ELSE
-				S.type := TMEOT
-			END
-		END Scan;
-
-	PROCEDURE ParseExt (IN S: Scanner; OUT ext: Files.Name);
-		VAR ch: CHAR; i: INTEGER;
-	BEGIN
-		ext := "";
-		S.rider.ReadPrevChar(ch);
-		IF ch = "." THEN
-			S.rider.ReadChar(ch);
-			i := 0;
-			WHILE (ch # 20X) & (ch # 9X) DO
-				ext[i] := ch;
-				INC(i);
-				S.rider.ReadChar(ch)
-			END;
-			ext[i] := 0X
-		ELSIF (ch # 20X) & (ch # 9X) THEN
-			WriteSString("Invalid character '");WriteChar(ch); WriteSString("' for file name.");
-			WriteLn; FlushW; error := TRUE
-		END;
-		S.SetPos(S.rider.Pos())
-	END ParseExt;
-
-	PROCEDURE ParseModList (S: Scanner; end: INTEGER);
-		VAR mod: Module;
-	BEGIN
-		WHILE (S.start < end) & (S.type = TMString) DO
-			NEW(mod); mod.fileName := S.string$;
-			mod.next := modList; modList := mod;
-			S.Scan;
-			WHILE (S.start < end) & (S.type = TMChar) &
-				((S.char = "*") OR (S.char = "+") OR (S.char = "$") OR (S.char = "#")) DO
-				IF S.char = "*" THEN mod.dll := TRUE
-				ELSIF S.char = "+" THEN kernel := mod
-				ELSIF S.char = "$" THEN main := mod
-				ELSE mod.intf := TRUE;
-					ASSERT(isDll, 126);
-					IF ~isDll THEN
-						WriteSString("Exports from Exe not possible. Use LinkDll or LinkDynDll.");
-						WriteLn; FlushW; error := TRUE
-					END
-				END;
-				S.Scan
-			END
-		END
-	END ParseModList;
-
-	PROCEDURE LinkIt (IN txt: ARRAY OF CHAR);
-		VAR S: Scanner; name, ext: Files.Name; end: INTEGER;
-	BEGIN
-		doWrite := TRUE;
-		headerstrtab.tab[0] := 0X;
-		headerstrtab.cur := 1;
-		dynstrtab.tab[0] := 0X;
-		dynstrtab.cur := 1;
-		relTextTab.cur := 0;
-		relRodataTab.cur := 0;
-		ResetHashtab;
-		ResetNeededIdx;
-		modList := NIL; kernel := NIL; main := NIL;
-		last := NIL; impg := NIL; impd := NIL;
-		firstExp := NIL; lastExp := NIL;
-		(* Dialog.ShowStatus("linking"); *)
-		Console.WriteStr("linking"); Console.WriteLn;
-		error := FALSE; modList := NIL;
-
-		(*
-		IF DevCommanders.par = NIL THEN RETURN END;
-		S.ConnectTo(DevCommanders.par.text);
-		S.SetPos(DevCommanders.par.beg);
-		end := DevCommanders.par.end;
-		DevCommanders.par := NIL;
-		*)
-
-		S.ConnectTo(txt);
-		S.SetPos(0);
-		end := LEN(txt$);
-
-		S.Scan;
-
-		IF S.type = TMString THEN
-			name := S.string$;
-			ext := "";
-			ParseExt(S, ext); S.Scan;
-			IF ~error THEN
-				MakeSoName(name, ext);
-				IF (S.type = TMChar) & (S.char = ":") THEN S.Scan;
-					IF (S.type = TMChar) & (S.char = "=") THEN S.Scan;
-						ParseModList(S, end);
-						ReadHeaders;
-						soName := SHORT(name$);
-						IF ~error THEN
-							WriteOut
-						END;
-						IF ~error THEN
-							WriteString("Library " + name + " written: ");
-							WriteInt(Out.Length()); WriteString("    "); WriteInt(text.size)
-						END
-					ELSE
-						error := TRUE;
-						WriteString(" := missing")
-					END
-				ELSE
-					error := TRUE;
-					WriteString(" := missing")
-				END;
-				WriteLn; FlushW
-			END
-		END;
-		(* IF error THEN Dialog.ShowStatus("Failed to write library") ELSE Dialog.ShowStatus("Ok") END; *)
-		IF error THEN Console.WriteStr("Failed to write library"); Console.WriteLn ELSE Console.WriteStr("Ok"); Console.WriteLn END;
-		S.ConnectTo("");
-		modList := NIL; kernel := NIL; main := NIL; firstExp := NIL; lastExp := NIL;
-		last := NIL; impg := NIL; impd := NIL; code := NIL
-	END LinkIt;
-
-(*
-	exes are not supported
-
-	PROCEDURE Link*;
-	BEGIN
-		HALT(126);
-		isDll := FALSE; isStatic := FALSE;
-		LinkIt
-	END Link;
-	
-	PROCEDURE LinkExe*;
-	BEGIN
-		HALT(126);
-		isDll := FALSE; isStatic := TRUE;
-		LinkIt
-	END LinkExe;
-*)
-	
-	PROCEDURE LinkDll* (IN txt: ARRAY OF CHAR);
-	BEGIN
-		isDll := TRUE; isStatic := TRUE;
-		LinkIt(txt)
-	END LinkDll;
-	
-	PROCEDURE LinkDynDll* (IN txt: ARRAY OF CHAR);
-	BEGIN
-		isDll := TRUE; isStatic := FALSE;
-		LinkIt(txt)
-	END LinkDynDll;
-		
-BEGIN
-	newRec := "NewRec"; newArr := "NewArr"
-END Dev0ElfLinker.
-
-LinTestSo LinTestSo2 LinKernel
-
-DevElfLinker.LinkDynDll libtestbb.so := LinKernel+$ LinTestSo2 LinTestSo# ~
-DevElfLinker.LinkDll libtestbb.so := LinTestSo2 LinTestSo# ~
-

new/Dev0/Mod/Interp.txt

@@ -1,56 +0,0 @@
-MODULE Dev0Interp;
-
-	(*
-		A. V. Shiryaev, 2012.10
-	*)
-
-	IMPORT Console, HostConsole (* required *), Strings, Dialog, StdInterpreter (* required (Dialog.SetCallHook) *);
-
-	PROCEDURE WriteInt (x: INTEGER);
-		VAR s: ARRAY 16 OF CHAR;
-	BEGIN
-		Strings.IntToString(x, s);
-		Console.WriteStr(s)
-	END WriteInt;
-
-	PROCEDURE Call (VAR s: ARRAY OF CHAR): BOOLEAN;
-		VAR i: INTEGER;
-			res: BOOLEAN;
-	BEGIN
-		i := 0;
-		WHILE (i < LEN(s)) & (s[i] # 0AX) & (s[i] # 0DX) & (s[i] # 0X) DO
-			INC(i)
-		END;
-		IF (i < LEN(s)) & (s[i] # 0X) THEN
-			IF (i > 0) & (s[0] # '#') THEN
-				s[i] := 0X;
-				Dialog.Call(s, "", i);
-				IF i = 0 THEN
-					res := TRUE
-				ELSE
-					WriteInt(i); Console.WriteLn;
-					res := FALSE (* stop on Dialog.Call error *)
-				END
-			ELSE (* skip empty strings and comments *)
-				res := TRUE
-			END
-		ELSE (* end of input *)
-			res := FALSE
-		END;
-	RETURN res
-	END Call;
-
-	PROCEDURE Init;
-		VAR s: ARRAY 1024 OF CHAR;
-	BEGIN
-		(* Dialog.SetLanguage("", FALSE); *)
-
-		Console.ReadLn(s);
-		WHILE Call(s) DO
-			Console.ReadLn(s)
-		END
-	END Init;
-
-BEGIN
-	Init
-END Dev0Interp.

new/Dev0/Mod/Linker.txt

@@ -1,1779 +0,0 @@
-MODULE Dev0Linker;
-
-	(* THIS IS TEXT COPY OF Linker.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT
-		Kernel, Files, (* Dates, Dialog, *) Strings,
-		(* TextModels, TextViews, TextMappers,
-		Log := StdLog, DevCommanders *) Console;
-	
-	CONST
-		NewRecFP = 4E27A847H;
-		NewArrFP = 76068C78H;
-
-		ImageBase = 00400000H;
-		ObjAlign = 1000H;
-		FileAlign = 200H;
-		HeaderSize = 400H;
-
-		FixLen = 30000;
-		
-		OFdir = "Code";
-		SYSdir = "System";
-		RsrcDir = "Rsrc";
-		WinDir = "Win";
-
-		(* meta interface consts *)
-		mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
-		mInternal = 1; mReadonly = 2; mExported = 4;
-
-		(* fixup types *)
-		absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104;
-		
-		(* mod desc fields *)
-		modOpts = 4; modRefcnt = 8; modTerm = 40; modNames = 84; modImports = 92; modExports = 96;
-		
-
-		(* A. V. Shiryaev: Scanner *)
-		TMChar = 0; TMString = 1; TMInt = 2; TMEOT = 3;
-
-	TYPE
-		Name = ARRAY 40 OF SHORTCHAR;
-		Export = POINTER TO RECORD
-			next: Export;
-			name: Name;
-			adr: INTEGER
-		END;
-		Resource = POINTER TO RECORD
-			next, local: Resource;
-			typ, id, lid, size, pos, x, y: INTEGER;
-			opts: SET;
-			file: Files.File;
-			name: Files.Name
-		END;
-		Module = POINTER TO RECORD
-			next: Module;
-			name: Files.Name;
-			file: Files.File;
-			hs, ms, ds, cs, vs, ni, ma, ca, va: INTEGER;
-			dll, intf: BOOLEAN;
-			exp: Export;
-			imp: POINTER TO ARRAY OF Module;
-			data: POINTER TO ARRAY OF BYTE;
-		END;
-		
-		(* A. V. Shiryaev: Scanner *)
-			ScanRider = RECORD
-				s: POINTER TO ARRAY OF CHAR;
-				i: INTEGER
-			END;
-			Scanner = RECORD
-				rider: ScanRider;
-				start, type: INTEGER;
-
-				string: ARRAY 100 OF CHAR;
-				char: CHAR;
-				int: INTEGER
-			END;
-
-	VAR
-(*
-		W: TextMappers.Formatter;
-*)
-		Out: Files.File;
-		R: Files.Reader;
-		Ro: Files.Writer;
-		error, isDll, isStatic, comLine: BOOLEAN;
-		modList, kernel, main, last, impg, impd: Module;
-		numMod, lastTerm: INTEGER;
-		resList: Resource;
-		numType, resHSize: INTEGER;
-		numId: ARRAY 32 OF INTEGER;
-		rsrcName: ARRAY 16 OF CHAR;	(* name of resource file *)
-		firstExp, lastExp: Export;
-		entryPos, isPos, fixPos, himpPos, hexpPos, hrsrcPos, termPos: INTEGER;
-		codePos, dataPos, conPos, rsrcPos, impPos, expPos, relPos: INTEGER;
-		CodeSize, DataSize, ConSize, RsrcSize, ImpSize, ImpHSize, ExpSize, RelocSize, DllSize: INTEGER;
-		CodeRva, DataRva, ConRva, RsrcRva, ImpRva, ExpRva, RelocRva, ImagesSize: INTEGER;
-		CodeBase, DataBase, ConBase, maxCode, numImp, numExp, noffixup, timeStamp: INTEGER;
-		newRec, newArr: Name;
-		fixups: POINTER TO ARRAY OF INTEGER;
-		code: POINTER TO ARRAY OF BYTE;
-		atab: POINTER TO ARRAY OF INTEGER;
-		ntab: POINTER TO ARRAY OF SHORTCHAR;
-
-	(* A. V. Shiryaev: Console *)
-
-		PROCEDURE WriteString (s: ARRAY OF CHAR);
-		BEGIN
-			Console.WriteStr(s)
-		END WriteString;
-
-		PROCEDURE WriteChar (c: CHAR);
-			VAR s: ARRAY 2 OF CHAR;
-		BEGIN
-			s[0] := c; s[1] := 0X;
-			Console.WriteStr(s)
-		END WriteChar;
-
-		PROCEDURE WriteSString (ss: ARRAY OF SHORTCHAR);
-		BEGIN
-			Console.WriteStr(ss$)
-		END WriteSString;
-
-		PROCEDURE WriteInt (x: INTEGER);
-			VAR s: ARRAY 16 OF CHAR;
-		BEGIN
-			Strings.IntToString(x, s);
-			Console.WriteStr(s)
-		END WriteInt;
-
-		PROCEDURE WriteLn;
-		BEGIN
-			Console.WriteLn
-		END WriteLn;
-
-		PROCEDURE FlushW;
-		BEGIN
-		END FlushW;
-
-(*
-	PROCEDURE TimeStamp (): INTEGER;	(* seconds since 1.1.1970 00:00:00 *)
-		VAR a: INTEGER; t: Dates.Time; d: Dates.Date;
-	BEGIN
-		Dates.GetTime(t); Dates.GetDate(d);
-		a := 12 * (d.year - 70) + d.month - 3;
-		a := a DIV 12 * 1461 DIV 4 + (a MOD 12 * 153 + 2) DIV 5 + d.day + 59;
-		RETURN ((a * 24 + t.hour) * 60 + t.minute) * 60 + t.second;
-	END TimeStamp;
-*)
-
-	PROCEDURE ThisFile (modname: ARRAY OF CHAR): Files.File;
-		VAR dir, name: Files.Name; loc: Files.Locator; f: Files.File;
-	BEGIN
-		Kernel.SplitName(modname, dir, name);
-		Kernel.MakeFileName(name, Kernel.objType);
-		loc := Files.dir.This(dir); loc := loc.This(OFdir);
-		f := Files.dir.Old(loc, name, TRUE);
-		IF (f = NIL) & (dir = "") THEN
-			loc := Files.dir.This(SYSdir); loc := loc.This(OFdir);
-			f := Files.dir.Old(loc, name, TRUE)
-		END;
-		RETURN f
-	END ThisFile;
-	
-	PROCEDURE ThisResFile (VAR name: Files.Name): Files.File;
-		VAR loc: Files.Locator; f: Files.File;
-	BEGIN
-		f := Files.dir.Old(Files.dir.This(RsrcDir), name, TRUE);
-		IF f = NIL THEN
-			loc := Files.dir.This(WinDir); loc := loc.This(RsrcDir);
-			f := Files.dir.Old(loc, name, TRUE);
-			IF f = NIL THEN
-				f := Files.dir.Old(Files.dir.This(""), name, TRUE)
-			END
-		END;
-		RETURN f
-	END ThisResFile;
-	
-	PROCEDURE Read2 (VAR x: INTEGER);
-		VAR b: BYTE;
-	BEGIN
-		R.ReadByte(b); x := b MOD 256;
-		R.ReadByte(b); x := x + 100H * (b MOD 256)
-	END Read2;
-	
-	PROCEDURE Read4 (VAR x: INTEGER);
-		VAR b: BYTE;
-	BEGIN
-		R.ReadByte(b); x := b MOD 256;
-		R.ReadByte(b); x := x + 100H * (b MOD 256);
-		R.ReadByte(b); x := x + 10000H * (b MOD 256);
-		R.ReadByte(b); x := x + 1000000H * b
-	END Read4;
-	
-	PROCEDURE ReadName (VAR name: ARRAY OF SHORTCHAR);
-		VAR i: INTEGER; b: BYTE;
-	BEGIN i := 0;
-		REPEAT
-			R.ReadByte(b); name[i] := SHORT(CHR(b)); INC(i)
-		UNTIL b = 0
-	END ReadName;
-		
-	PROCEDURE RNum (VAR i: INTEGER);
-		VAR b: BYTE; s, y: INTEGER;
-	BEGIN
-		s := 0; y := 0; R.ReadByte(b);
-		WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); R.ReadByte(b) END;
-		i := ASH((b + 64) MOD 128 - 64, s) + y
-	END RNum;
-	
-	PROCEDURE WriteCh (ch: SHORTCHAR);
-	BEGIN
-		Ro.WriteByte(SHORT(ORD(ch)))
-	END WriteCh;
-	
-	PROCEDURE Write2 (x: INTEGER);
-	BEGIN
-		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-		Ro.WriteByte(SHORT(SHORT(x MOD 256)))
-	END Write2;
-	
-	PROCEDURE Write4 (x: INTEGER);
-	BEGIN
-		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-		Ro.WriteByte(SHORT(SHORT(x MOD 256))); x := x DIV 256;
-		Ro.WriteByte(SHORT(SHORT(x MOD 256)))
-	END Write4;
-	
-	PROCEDURE WriteName (s: ARRAY OF SHORTCHAR; len: SHORTINT);
-		VAR i: SHORTINT;
-	BEGIN i := 0;
-		WHILE s[i] # 0X DO Ro.WriteByte(SHORT(ORD(s[i]))); INC(i) END;
-		WHILE i < len DO Ro.WriteByte(0); INC(i) END
-	END WriteName;
-	
-	PROCEDURE Reloc (a: INTEGER);
-		VAR p: POINTER TO ARRAY OF INTEGER; i: INTEGER;
-	BEGIN
-		IF noffixup >= LEN(fixups) THEN
-			NEW(p, 2 * LEN(fixups));
-			i := 0; WHILE i < LEN(fixups) DO p[i] := fixups[i]; INC(i) END;
-			fixups := p
-		END;
-		fixups[noffixup] := a; INC(noffixup)
-(*
-		ELSE
-			IF ~error THEN W.WriteSString("  too many fixups") END;
-			error := TRUE
-		END
-*)
-	END Reloc;
-	
-	PROCEDURE Put (mod: Module; a, x: INTEGER);
-	BEGIN
-		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
-		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
-		mod.data[a] := SHORT(SHORT(x)); INC(a); x := x DIV 256;
-		mod.data[a] := SHORT(SHORT(x))
-	END Put;
-	
-	PROCEDURE Get (mod: Module; a: INTEGER; VAR x: INTEGER);
-	BEGIN
-		x := ((mod.data[a + 3] * 256 +
-			(mod.data[a + 2] MOD 256)) * 256 +
-			(mod.data[a + 1] MOD 256)) * 256 +
-			(mod.data[a] MOD 256)
-	END Get;
-	
-	PROCEDURE GenName (VAR from, to: ARRAY OF SHORTCHAR; ext: ARRAY OF SHORTCHAR);
-		VAR i, j: INTEGER;
-	BEGIN
-		i := 0;
-		WHILE from[i] # 0X DO to[i] := from[i]; INC(i) END;
-		IF ext # "" THEN
-			to[i] := "."; INC(i); j := 0;
-			WHILE ext[j] # 0X DO to[i] := ext[j]; INC(i); INC(j) END
-		END;
-		to[i] := 0X
-	END GenName;
-	
-	PROCEDURE Fixup0 (link, adr: INTEGER);
-		VAR offset, linkadr, t, n, x: INTEGER;
-	BEGIN
-		WHILE link # 0 DO
-			RNum(offset);
-			WHILE link # 0 DO
-				IF link > 0 THEN
-					n := (code[link] MOD 256) + (code[link+1] MOD 256) * 256 + code[link+2] * 65536;
-					t := code[link+3]; linkadr := CodeBase + impg.ca + link
-				ELSE
-					n := (impg.data[-link] MOD 256) + (impg.data[-link+1] MOD 256) * 256 + impg.data[-link+2] * 65536;
-					t := impg.data[-link+3]; linkadr := ConBase + impg.ma - link
-				END;
-				IF t = absolute THEN x := adr + offset
-				ELSIF t = relative THEN x := adr + offset - linkadr - 4
-				ELSIF t = copy THEN Get(impd, adr + offset - ConBase - impd.ma, x)
-				ELSIF t = table THEN x := adr + n; n := link + 4
-				ELSIF t = tableend THEN x := adr + n; n := 0
-				ELSE HALT(99)
-				END;
-				IF link > 0 THEN
-					code[link] := SHORT(SHORT(x));
-					code[link+1] := SHORT(SHORT(x DIV 100H));
-					code[link+2] := SHORT(SHORT(x DIV 10000H));
-					code[link+3] := SHORT(SHORT(x DIV 1000000H))
-				ELSE
-					link := -link;
-					impg.data[link] := SHORT(SHORT(x));
-					impg.data[link+1] := SHORT(SHORT(x DIV 100H));
-					impg.data[link+2] := SHORT(SHORT(x DIV 10000H));
-					impg.data[link+3] := SHORT(SHORT(x DIV 1000000H))
-				END;
-				IF (t # relative) & ((t # copy) OR (x DIV 65536 # 0)) THEN Reloc(linkadr) END;
-				link := n
-			END;
-			RNum(link)
-		END
-	END Fixup0;
-	
-	PROCEDURE Fixup (adr: INTEGER);
-		VAR link: INTEGER;
-	BEGIN
-		RNum(link); Fixup0(link, adr)
-	END Fixup;
-	
-	PROCEDURE CheckDllImports (mod: Module);
-		VAR i, x, y: INTEGER; name: Name; imp: Module; exp: Export;
-		
-		PROCEDURE SkipLink;
-			VAR a: INTEGER;
-		BEGIN
-			RNum(a);
-			WHILE a # 0 DO RNum(a); RNum(a) END
-		END SkipLink;
-
-	BEGIN
-		R := mod.file.NewReader(R);
-		R.SetPos(mod.hs + mod.ms + mod.ds + mod.cs);
-		SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; SkipLink; i := 0;
-		WHILE i < mod.ni DO
-			imp := mod.imp[i];
-			IF imp # NIL THEN
-				RNum(x);
-				WHILE x # 0 DO
-					ReadName(name); RNum(y);
-					IF x = mVar THEN SkipLink;
-						IF imp.dll THEN
-							WriteString("variable (");
-							WriteString(imp.name); WriteChar(".");
-							WriteSString(name);
-							WriteString(") imported from DLL in ");
-							WriteString(mod.name);
-							WriteLn; FlushW; error := TRUE;
-							RETURN
-						END
-					ELSIF x = mTyp THEN RNum(y);
-						IF imp.dll THEN
-							RNum(y);
-							IF y # 0 THEN
-								WriteString("type descriptor (");
-								WriteString(imp.name); WriteChar(".");
-								WriteSString(name);
-								WriteString(") imported from DLL in ");
-								WriteString(mod.name);
-								WriteLn; FlushW; error := TRUE;
-								RETURN
-							END
-						ELSE SkipLink
-						END
-					ELSIF x = mProc THEN
-						IF imp.dll THEN
-							SkipLink; exp := imp.exp;
-							WHILE (exp # NIL) & (exp.name # name) DO exp := exp.next END;
-							IF exp = NIL THEN
-								NEW(exp); exp.name := name$;
-								exp.next := imp.exp; imp.exp := exp; INC(DllSize, 6)
-							 END
-						END
-					END;
-					RNum(x)
-				END
-			END;
-			INC(i)
-		END
-	END CheckDllImports;
-	
-	PROCEDURE ReadHeaders;
-		VAR mod, im, t: Module; x, i: INTEGER; impdll: BOOLEAN; exp: Export; name: Name;
-	BEGIN
-		mod := modList; modList := NIL; numMod := 0;
-		WHILE mod # NIL DO	(* reverse mod list & count modules *)
-			IF ~mod.dll THEN INC(numMod) END;
-			t := mod; mod := t.next; t.next := modList; modList := t
-		END;
-		IF isStatic THEN
-			IF isDll THEN
-				(* push ebx; cmp [12, esp], 1; jne L1; mov ebx, modlist; { call body; } jp L2 *)
-				(* L1: cmp [12, esp], 0; jne L2; { call term; } *)
-				(* L2: pop ebx; mov aex,1; ret 12 *)
-				CodeSize := 42 + 10 * numMod
-			ELSE
-				(* push ebx; push ebx; push ebx; mov ebx, modlist; { call body; } { call term; } *)
-				(* pop ebx; pop ebx; pop ebx; ret *)
-				CodeSize := 12 + 10 * numMod
-			END
-		ELSE
-			IF isDll THEN
-				(* push ebx; cmp [12, esp], 1; jne L1; mov ebx, modlist; call main; jp L2 *)
-				(* L1: cmp [12, esp], 0; jne L2; call mainTerm; *)
-				(* L2: pop ebx; mov aex,1; ret 12 *)
-				CodeSize := 41
-			ELSE
-				(* mov ebx, modlist; jmp main *)
-				CodeSize := 10
-			END
-		END;
-(*
-		IF isDll THEN
-			CodeSize := 24	(* push ebx, esi, edi; mov bx, modlist; call main; pop edi, esi, ebx; mov aex,1; ret 12 *)
-		ELSE
-			CodeSize := 10	(* mov bx, modlist; jmp main *)
-		END
-*)
-		DataSize := 0; ConSize := 0;
-		ImpSize := 0; ImpHSize := 0; ExpSize := 0;
-		RelocSize := 0; DllSize := 0; noffixup := 0; maxCode := 0; numImp := 0; numExp := 0;
-		mod := modList;
-		WHILE mod # NIL DO
-			IF ~mod.dll THEN
-				mod.file := ThisFile(mod.name);
-				IF mod.file # NIL THEN
-					R := mod.file.NewReader(R); R.SetPos(0); Read4(x);
-					IF x = 6F4F4346H THEN
-						Read4(x);
-						Read4(mod.hs); Read4(mod.ms); Read4(mod.ds); Read4(mod.cs);
-						Read4(mod.vs); RNum(mod.ni); ReadName(name); impdll := FALSE;
-						IF mod.ni > 0 THEN
-							NEW(mod.imp, mod.ni); x := 0;
-							WHILE x < mod.ni DO
-								ReadName(name);
-								IF name = "$$" THEN
-									IF (mod # kernel) & (kernel # NIL) THEN
-										mod.imp[x] := kernel
-									ELSE
-										WriteSString("no kernel"); WriteLn;
-										FlushW; error := TRUE
-									END
-								ELSIF name[0] = "$" THEN
-									i := 1;
-									WHILE name[i] # 0X DO name[i-1] := name[i]; INC(i) END;
-									name[i-1] := 0X; impdll := TRUE; im := modList;
-									WHILE (im # mod) & (im.name # name) DO im := im.next END;
-									IF (im = NIL) OR ~im.dll THEN
-										NEW(im); im.next := modList; modList := im;
-										im.name := name$;
-										im.dll := TRUE
-									END;
-									mod.imp[x] := im;
-								ELSE
-									im := modList;
-									WHILE (im # mod) & (im.name # name) DO im := im.next END;
-									IF im # mod THEN
-										mod.imp[x] := im;
-									ELSE
-										WriteSString(name);
-										WriteString(" not present (imported in ");
-										WriteString(mod.name); WriteChar(")");
-										WriteLn; FlushW; error := TRUE
-									END
-								END;
-								INC(x)
-							END
-						END;
-						IF impdll & ~error THEN CheckDllImports(mod) END;
-						mod.ma := ConSize; INC(ConSize, mod.ms + mod.ds);
-						mod.va := DataSize; INC(DataSize, mod.vs);
-						mod.ca := CodeSize; INC(CodeSize, mod.cs);
-						IF mod.cs > maxCode THEN maxCode := mod.cs END
-					ELSE
-						WriteString(mod.name); WriteString(": wrong file type"); 
-						WriteLn; FlushW; error := TRUE
-					END;
-					mod.file.Close; mod.file := NIL
-				ELSE
-					WriteString(mod.name); WriteString(" not found"); 
-					WriteLn; FlushW; error := TRUE
-				END;
-				last := mod
-			END;
-			mod := mod.next
-		END;
-		IF ~isStatic & (main = NIL) THEN
-			WriteSString("no main module specified"); WriteLn;
-			FlushW; error := TRUE
-		END;
-		(* calculate rva's *)
-		IF DataSize = 0 THEN DataSize := 1 END;
-		CodeRva := ObjAlign;
-		DataRva := CodeRva + (CodeSize + DllSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
-		ConRva := DataRva + (DataSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
-		RsrcRva := ConRva + (ConSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
-		CodeBase := ImageBase + CodeRva;
-		DataBase := ImageBase + DataRva;
-		ConBase := ImageBase + ConRva;
-		(* write dll export adresses *)
-		mod := modList; x := 0;
-		WHILE mod # NIL DO
-			IF mod.dll THEN
-				exp := mod.exp; INC(ImpSize, 20);
-				WHILE exp # NIL DO exp.adr := x; INC(x, 6); exp := exp.next END
-			END;
-			mod := mod.next
-		END;
-		ASSERT(x = DllSize); INC(ImpSize, 20); (* sentinel *)
-	END ReadHeaders;
-	
-	PROCEDURE MenuSize (r: Resource): INTEGER;
-		VAR s, i: INTEGER;
-	BEGIN
-		s := 0;
-		WHILE r # NIL DO
-			INC(s, 2);
-			IF r.local = NIL THEN INC(s, 2) END;
-			i := 0; WHILE r.name[i] # 0X DO INC(s, 2); INC(i) END;
-			INC(s, 2);
-			s := s + MenuSize(r.local);
-			r := r.next
-		END;
-		RETURN s
-	END MenuSize;
-	
-	PROCEDURE PrepResources;
-		VAR res, r, s: Resource; n, i, j, t, x: INTEGER; loc: Files.Locator;
-	BEGIN
-		r := resList;
-		WHILE r # NIL DO
-			IF r.lid = 0 THEN r.lid := 1033 END;
-			IF r.name = "MENU" THEN
-				r.typ := 4; r.size := 4 + MenuSize(r.local);
-			ELSIF r.name = "ACCELERATOR" THEN
-				r.typ := 9; r.size := 0; s := r.local;
-				WHILE s # NIL DO INC(r.size, 8); s := s.next END;
-			ELSE
-				r.file := ThisResFile(r.name);
-				IF r.file # NIL THEN
-					IF r.typ = -1 THEN	(* typelib *)
-						r.typ := 0; r.size := r.file.Length(); r.pos := 0; rsrcName := "TYPELIB"
-					ELSE
-						R := r.file.NewReader(R); R.SetPos(0); Read2(n);
-						IF n = 4D42H THEN	(* bitmap *)
-							Read4(n); r.typ := 2; r.size := n - 14; r.pos := 14;
-						ELSE
-							Read2(x);
-							IF x = 1 THEN	(* icon *)
-								Read2(n); r.typ := 14; r.size := 6 + 14 * n; r.pos := 0; i := 0;
-								WHILE i < n DO
-									NEW(s); s.typ := 3; s.id := 10 * r.id + i; s.lid := r.lid; s.name := r.name$; 
-									Read4(x); Read4(x); Read4(s.size); Read2(s.pos); Read2(x);
-									s.next := resList; resList := s;
-									INC(i)
-								END
-							ELSIF x = 2 THEN	(* cursor *)
-								Read2(n); r.typ := 12; r.size := 6 + 14 * n; r.pos := 0; i := 0;
-								WHILE i < n DO
-									NEW(s); s.typ := 1; s.id := 10 * r.id + i; s.lid := r.lid; s.name := r.name$; 
-									Read4(x); Read2(s.x); Read2(s.y); Read4(s.size); INC(s.size, 4); Read2(s.pos); Read2(x);
-									s.next := resList; resList := s;
-									INC(i)
-								END
-							ELSE
-								Read4(n);
-								IF (x = 0) & (n = 20H) THEN	(* resource file *)
-									Read4(n); Read4(n); Read4(n); Read4(n); Read4(n); Read4(n);	(* 32 bit marker *)
-									Read4(r.size); Read4(n); Read2(i); 
-									IF i = 0FFFFH THEN
-										Read2(j);
-										IF (j >= 4) & ((j <= 11) OR (j = 16)) THEN
-											r.typ := j; r.pos := n + 32;
-										ELSE
-											WriteString(r.name); WriteString(": invalid type"); WriteLn;
-											FlushW; error := TRUE
-										END
-									ELSE
-										j := 0;
-										WHILE i # 0 DO rsrcName[j] := CHR(i); INC(j); Read2(i) END;
-										rsrcName[j] := 0X;
-										r.typ := 0; r.pos := n + 32
-									END
-								ELSE
-									WriteString(r.name); WriteString(": unknown type"); WriteLn;
-									FlushW; error := TRUE
-								END
-							END
-						END
-					END;
-					r.file.Close; r.file := NIL
-				ELSE
-					WriteString(r.name); WriteString(" not found"); WriteLn;
-					FlushW; error := TRUE
-				END
-			END;
-			r := r.next
-		END;
-		res := resList; resList := NIL;	(* sort resources *)
-		WHILE res # NIL DO
-			r := res; res := res.next;
-			IF (resList = NIL) OR (r.typ < resList.typ) OR (r.typ = resList.typ) & ((r.id < resList.id) OR (r.id = resList.id) & (r.lid < resList.lid))
-			THEN
-				r.next := resList; resList := r
-			ELSE
-				s := resList;
-				WHILE (s.next # NIL) & (r.typ >= s.next.typ)
-					& ((r.typ # s.next.typ) OR (r.id >= s.next.id) & ((r.id # s.next.id) OR (r.lid >= s.next.lid))) DO s := s.next END;
-				r.next := s.next; s.next := r
-			END
-		END;
-		r := resList; numType := 0; resHSize := 16; t := 0; n := 0;	(* get resource size *)
-		WHILE t < LEN(numId) DO numId[t] := 0; INC(t) END;
-		WHILE r # NIL DO
-			INC(numType); INC(resHSize, 24); t := r.typ;
-			WHILE (r # NIL) & (r.typ = t) DO
-				INC(numId[t]); INC(resHSize, 24); i := r.id;
-				WHILE (r # NIL) & (r.typ = t) & (r.id = i) DO
-					INC(resHSize, 24); INC(n, (r.size + 3) DIV 4 * 4); r := r.next
-				END
-			END
-		END;
-		IF numId[0] > 0 THEN INC(n, (LEN(rsrcName$) + 1) * 2) END;
-		RsrcSize := resHSize + n;
-		ImpRva := RsrcRva + (RsrcSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign
-	END PrepResources;
-	
-	PROCEDURE WriteHeader(VAR name: Files.Name);
-	BEGIN
-		Out := Files.dir.New(Files.dir.This(""), Files.ask); Ro := Out.NewWriter(Ro); Ro.SetPos(0);
-
-		(* DOS header *)
-		Write4(905A4DH); Write4(3); Write4(4); Write4(0FFFFH);
-		Write4(0B8H); Write4(0); Write4(40H); Write4(0);
-		Write4(0); Write4(0); Write4(0); Write4(0);
-		Write4(0); Write4(0); Write4(0); Write4(80H);
-		Write4(0EBA1F0EH); Write4(0CD09B400H); Write4(4C01B821H); Write2(21CDH);
-		WriteName("This program cannot be run in DOS mode.", 39);
-		WriteCh(0DX); WriteCh(0DX); WriteCh(0AX);
-		Write4(24H); Write4(0);
-
-		(* Win32 header *)
-		WriteName("PE", 4); (* signature bytes *)
-		Write2(014CH); (* cpu type (386) *)
-		IF isDll THEN
-			Write2(7); (* 7 objects *)
-		ELSE
-			Write2(6); (* 6 objects *)
-		END;
-		Write4(timeStamp); (* time/date *)
-		Write4(0); Write4(0);
-		Write2(0E0H); (* NT header size *)
-		IF isDll THEN
-			Write2(0A38EH); (* library image flags *)
-		ELSE
-			Write2(838EH); (* program image flags *)
-		END;
-		Write2(10BH); (* magic (normal ececutable file) *)
-		Write2(0301H); (* linker version !!! *)
-		Write4(CodeSize); (* code size *)
-		Write4(ConSize); (* initialized data size *)
-		Write4(DataSize); (* uninitialized data size *)
-		entryPos := Ro.Pos();
-		Write4(0); (* entry point *)	(* !!! *)
-		Write4(CodeRva); (* base of code *)
-		Write4(ConRva); (* base of data *)
-		Write4(400000H); (* image base *)
-		Write4(ObjAlign); (* object align *)
-		Write4(FileAlign); (* file align *)
-		Write4(3); (* OS version *)
-		Write4(4); (* user version *)
-		Write4(4); (* subsys version *) (* mf 14.3.04: value changed from 0A0003H to 4. Corrects menubar pixel bug on Windows XP *)
-		Write4(0);
-		isPos := Ro.Pos();
-		Write4(0); (* image size *)	(* !!! *)
-		Write4(HeaderSize); (* header size !!! *)
-		Write4(0); (* checksum *)
-		IF comLine THEN
-			Write2(3) (* dos subsystem *)
-		ELSE
-			Write2(2) (* gui subsystem *)
-		END;
-		Write2(0); (* dll flags *)
-		Write4(200000H); (* stack reserve size *)
-		Write4(10000H); (* stack commit size *)
-		IF isDll THEN
-			Write4(00100000H); (* heap reserve size *)
-		ELSE
-			Write4(00400000H); (* heap reserve size *)
-		END;
-		Write4(10000H); (* heap commit size *)
-		Write4(0);
-		Write4(16); (* num of rva/sizes *)
-		hexpPos := Ro.Pos();
-		Write4(0); Write4(0); (* export table *)
-		himpPos := Ro.Pos();
-		Write4(0); Write4(0); (* import table *)	(* !!! *)
-		hrsrcPos := Ro.Pos();
-		Write4(0); Write4(0); (* resource table *)	(* !!! *)
-		Write4(0); Write4(0); (* exception table *)
-		Write4(0); Write4(0); (* security table *)
-		fixPos := Ro.Pos();
-		Write4(0); Write4(0); (* fixup table *)	(* !!! *)
-		Write4(0); Write4(0); (* debug table *)
-		Write4(0); Write4(0); (* image description *)
-		Write4(0); Write4(0); (* machine specific *)
-		Write4(0); Write4(0); (* thread local storage *)
-		Write4(0); Write4(0); (* ??? *)
-		Write4(0); Write4(0); (* ??? *)
-		Write4(0); Write4(0); (* ??? *)
-		Write4(0); Write4(0); (* ??? *)
-		Write4(0); Write4(0); (* ??? *)
-		Write4(0); Write4(0); (* ??? *)
-
-		(* object directory *)
-		WriteName(".text", 8); (* code object *)
-		Write4(0); (* object size (always 0) *)
-		codePos := Ro.Pos();
-		Write4(0); (* object rva *)
-		Write4(0); (* physical size *)
-		Write4(0); (* physical offset *)
-		Write4(0); Write4(0); Write4(0);
-		Write4(60000020H); (* flags: code, exec, read *)
-
-		WriteName(".var", 8); (* variable object *)
-		Write4(0); (* object size (always 0) *)
-		dataPos := Ro.Pos();
-		Write4(0); (* object rva *)
-		Write4(0); (* physical size *)
-		Write4(0); (* physical offset *)	(* zero! (noinit) *)
-		Write4(0); Write4(0); Write4(0);
-		Write4(0C0000080H); (* flags: noinit, read, write *)
-
-		WriteName(".data", 8); (* constant object *)
-		Write4(0); (* object size (always 0) *)
-		conPos := Ro.Pos();
-		Write4(0); (* object rva *)
-		Write4(0); (* physical size *)
-		Write4(0); (* physical offset *)
-		Write4(0); Write4(0); Write4(0);
-		Write4(0C0000040H); (* flags: data, read, write *)
-
-		WriteName(".rsrc", 8); (* resource object *)
-		Write4(0); (* object size (always 0) *)
-		rsrcPos := Ro.Pos();
-		Write4(0); (* object rva *)
-		Write4(0); (* physical size *)
-		Write4(0); (* physical offset *)
-		Write4(0); Write4(0); Write4(0);
-		Write4(0C0000040H); (* flags: data, read, write *)
-
-		WriteName(".idata", 8); (* import object *)
-		Write4(0); (* object size (always 0) *)
-		impPos := Ro.Pos();
-		Write4(0); (* object rva *)
-		Write4(0); (* physical size *)
-		Write4(0); (* physical offset *)
-		Write4(0); Write4(0); Write4(0);
-		Write4(0C0000040H); (* flags: data, read, write *)
-
-		IF isDll THEN
-			WriteName(".edata", 8); (* export object *)
-			Write4(0); (* object size (always 0) *)
-			expPos := Ro.Pos();
-			Write4(0); (* object rva *)
-			Write4(0); (* physical size *)
-			Write4(0); (* physical offset *)
-			Write4(0); Write4(0); Write4(0);
-			Write4(0C0000040H); (* flags: data, read, write *)
-		END;
-
-		WriteName(".reloc", 8); (* relocation object *)
-		Write4(0); (* object size (always 0) *)
-		relPos := Ro.Pos();
-		Write4(0); (* object rva *)
-		Write4(0); (* physical size *)
-		Write4(0); (* physical offset *)
-		Write4(0); Write4(0); Write4(0);
-		Write4(42000040H); (* flags: data, read, ? *)
-	END WriteHeader;
-	
-	PROCEDURE SearchObj (mod: Module; VAR name: ARRAY OF SHORTCHAR; m, fp, opt: INTEGER; VAR adr: INTEGER);
-		VAR dir, len, ntab, f, id, l, r, p, n, i, j: INTEGER; nch, och: SHORTCHAR;
-	BEGIN
-		Get(mod, mod.ms + modExports, dir); DEC(dir, ConBase + mod.ma); Get(mod, dir, len); INC(dir, 4);
-		Get(mod, mod.ms + modNames, ntab); DEC(ntab, ConBase + mod.ma);
-		IF name # "" THEN
-			l := 0; r := len;
-			WHILE l < r DO	(* binary search *)
-				n := (l + r) DIV 2; p := dir + n * 16;
-				Get(mod, p + 8, id);
-				i := 0; j := ntab + id DIV 256; nch := name[0]; och := SHORT(CHR(mod.data[j]));
-				WHILE (nch = och) & (nch # 0X) DO INC(i); INC(j); nch := name[i]; och := SHORT(CHR(mod.data[j])) END;
-				IF och = nch THEN
-					IF id MOD 16 = m THEN Get(mod, p, f);
-						IF m = mTyp THEN
-							IF ODD(opt) THEN Get(mod, p + 4, f) END;
-							IF (opt > 1) & (id DIV 16 MOD 16 # mExported) THEN
-								WriteString(mod.name); WriteChar("."); WriteSString(name);
-								WriteString(" imported from "); WriteString(impg.name);
-								WriteString(" has wrong visibility"); WriteLn; error := TRUE
-							END;
-							Get(mod, p + 12, adr)
-						ELSIF m = mVar THEN
-							Get(mod, p + 4, adr); INC(adr, DataBase + mod.va)
-						ELSIF m = mProc THEN
-							Get(mod, p + 4, adr); INC(adr, CodeBase + mod.ca)
-						END;
-						IF f # fp THEN
-							WriteString(mod.name); WriteChar("."); WriteSString(name);
-							WriteString(" imported from "); WriteString(impg.name);
-							WriteString(" has wrong fprint"); WriteLn; error := TRUE
-						END
-					ELSE
-						WriteString(mod.name); WriteChar("."); WriteSString(name);
-						WriteString(" imported from "); WriteString(impg.name);
-						WriteString(" has wrong class"); WriteLn; error := TRUE
-					END;
-					RETURN
-				END;
-				IF och < nch THEN l := n + 1 ELSE r := n END
-			END;
-			WriteString(mod.name); WriteChar("."); WriteSString(name);
-			WriteString(" not found (imported from "); WriteString(impg.name);
-			WriteChar(")"); WriteLn; error := TRUE
-		ELSE (* anonymous type *)
-			WHILE len > 0 DO
-				Get(mod, dir + 4, f); Get(mod, dir + 8, id);
-				IF (f = fp) & (id MOD 16 = mTyp) & (id DIV 256 = 0) THEN
-					Get(mod, dir + 12, adr); RETURN
-				END;
-				DEC(len); INC(dir, 16)
-			END;
-			WriteString("anonymous type in "); WriteString(mod.name);
-			WriteString(" not found"); WriteLn; error := TRUE
-		END
-	END SearchObj;
-	
-	PROCEDURE CollectExports (mod: Module);
-		VAR dir, len, ntab, id, i, j, n: INTEGER; e, exp: Export;
-	BEGIN
-		Get(mod, mod.ms + modExports, dir); DEC(dir, ConBase + mod.ma); Get(mod, dir, len); INC(dir, 4);
-		Get(mod, mod.ms + modNames, ntab); DEC(ntab, ConBase + mod.ma); n := 0;
-		WHILE n < len DO
-			Get(mod, dir + 8, id);
-			IF (id DIV 16 MOD 16 # mInternal) & ((id MOD 16 = mProc) OR (id MOD 16 = mVar))THEN	(* exported procedure & var *)
-				NEW(exp);
-				i := 0; j := ntab + id DIV 256;
-				WHILE mod.data[j] # 0 DO exp.name[i] := SHORT(CHR(mod.data[j])); INC(i); INC(j) END;
-				exp.name[i] := 0X;
-				Get(mod, dir + 4, exp.adr);
-				IF id MOD 16 = mProc THEN INC(exp.adr, CodeRva + mod.ca)
-				ELSE ASSERT(id MOD 16 = mVar); INC(exp.adr, DataRva + mod.va)
-				END;
-				IF (firstExp = NIL) OR (exp.name < firstExp.name) THEN
-					exp.next := firstExp; firstExp := exp;
-					IF lastExp = NIL THEN lastExp := exp END
-				ELSE
-					e := firstExp;
-					WHILE (e.next # NIL) & (exp.name > e.next.name) DO e := e.next END;
-					exp.next := e.next; e.next := exp;
-					IF lastExp = e THEN lastExp := exp END
-				END;
-				INC(numExp);
-			END;
-			INC(n); INC(dir, 16)
-		END
-	END CollectExports;
-
-	PROCEDURE WriteTermCode (m: Module; i: INTEGER);
-		VAR x: INTEGER;
-	BEGIN
-		IF m # NIL THEN
-			IF m.dll THEN WriteTermCode(m.next, i)
-			ELSE
-				IF isStatic THEN WriteTermCode(m.next, i + 1) END;
-				Get(m, m.ms + modTerm, x);	(* terminator address in mod desc*)
-				IF x = 0 THEN
-					WriteCh(005X); Write4(0)	(* add EAX, 0 (nop) *)
-				ELSE
-					WriteCh(0E8X); Write4(x - lastTerm + 5 * i - CodeBase)	(* call term *)
-				END
-			END
-		END
-	END WriteTermCode;
-	
-	PROCEDURE WriteCode;
-		VAR mod, m: Module; i, x, a, fp, opt: INTEGER; exp: Export; name: Name;
-	BEGIN
-		IF isStatic THEN
-			WriteCh(053X);	(* push ebx *)
-			a := 1;
-			IF isDll THEN
-				WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(001X);	(* cmp [12, esp], 1 *)
-				WriteCh(00FX); WriteCh(085X); Write4(10 + 5 * numMod);	(* jne L1 *)
-				INC(a, 11)
-			ELSE
-				WriteCh(053X); WriteCh(053X);	(* push ebx; push ebx *)
-				INC(a, 2)
-			END;
-			WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + a + 1);	(* mov bx, modlist *)
-			INC(a, 5); m := modList;
-			WHILE m # NIL DO
-				IF ~m.dll THEN
-					WriteCh(0E8X); INC(a, 5); Write4(m.ca - a)	(* call body *)
-				END;
-				m := m.next
-			END;
-			IF isDll THEN
-				WriteCh(0E9X); Write4(11 + 5 * numMod);	(* jp L2 *)
-				WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(000X);	(* L1: cmp [12, esp], 0 *)
-				WriteCh(00FX); WriteCh(085X); Write4(5 * numMod);	(* jne L2 *)
-				INC(a, 16)
-			END;
-			termPos := Ro.Pos(); i := 0;
-			WHILE i < numMod DO	(* nop for call terminator *)
-				WriteCh(02DX); Write4(0);	(* sub EAX, 0 *)
-				INC(i); INC(a, 5)
-			END;
-			lastTerm := a;
-			WriteCh(05BX); 	(* L2: pop ebx *)
-			IF isDll THEN
-				WriteCh(0B8X); Write4(1);	(* mov eax,1 *)
-				WriteCh(0C2X); Write2(12)	(* ret 12 *)
-			ELSE
-				WriteCh(05BX); WriteCh(05BX);	(* pop ebx; pop ebx *)
-				WriteCh(0C3X)	(* ret *)
-			END
-		ELSIF isDll THEN
-			WriteCh(053X);	(* push ebx *)
-			WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(001X);	(* cmp [12, esp], 1 *)
-			WriteCh(075X); WriteCh(SHORT(CHR(12)));	(* jne L1 *)
-			WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + 9);	(* mov bx, modlist *)
-			WriteCh(0E8X); Write4(main.ca - 18);	(* call main *)
-			WriteCh(0EBX); WriteCh(SHORT(CHR(12)));	(* jp L2 *)
-			WriteCh(083X); WriteCh(07CX); WriteCh(024X); WriteCh(00CX); WriteCh(000X);	(* L1: cmp [12, esp], 0 *)
-			WriteCh(075X); WriteCh(SHORT(CHR(5)));	(* jne L2 *)
-			termPos := Ro.Pos();
-			WriteCh(02DX); Write4(0);	(* sub EAX, 0 *)	(* nop for call terminator *)
-			lastTerm := 32;
-			WriteCh(05BX); 	(* L2: pop ebx *)
-			WriteCh(0B8X); Write4(1);	(* mov eax,1 *)
-			WriteCh(0C2X); Write2(12)	(* ret 12 *)
-		ELSE
-			WriteCh(0BBX); Write4(ConBase + last.ma + last.ms); Reloc(CodeBase + 1);	(* mov bx, modlist *)
-			WriteCh(0E9X); Write4(main.ca - 10);	(* jmp main *)
-		END;
-		NEW(code, maxCode);
-		mod := modList;
-		WHILE mod # NIL DO impg := mod; impd := mod;
-			IF ~mod.dll THEN
-				mod.file := ThisFile(mod.name);
-				R := mod.file.NewReader(R); R.SetPos(mod.hs);
-				NEW(mod.data, mod.ms + mod.ds);
-				R.ReadBytes(mod.data^, 0, mod.ms + mod.ds);
-				R.ReadBytes(code^, 0, mod.cs);
-				RNum(x);
-				IF x # 0 THEN
-					IF (mod # kernel) & (kernel # NIL) THEN
-						SearchObj(kernel, newRec, mProc, NewRecFP, -1, a); Fixup0(x, a)
-					ELSE
-						WriteSString("no kernel"); WriteLn;
-						FlushW; error := TRUE; RETURN
-					END
-				END;
-				RNum(x);
-				IF x # 0 THEN
-					IF (mod # kernel) & (kernel # NIL) THEN
-						SearchObj(kernel, newArr, mProc, NewArrFP, -1, a); Fixup0(x, a)
-					ELSE
-						WriteSString("no kernel"); WriteLn;
-						FlushW; error := TRUE; RETURN
-					END
-				END;
-				Fixup(ConBase + mod.ma);
-				Fixup(ConBase + mod.ma + mod.ms);
-				Fixup(CodeBase + mod.ca);
-				Fixup(DataBase + mod.va); i := 0;
-				WHILE i < mod.ni DO
-					m := mod.imp[i]; impd := m; RNum(x);
-					WHILE x # 0 DO
-						ReadName(name); RNum(fp); opt := 0;
-						IF x = mTyp THEN RNum(opt) END;
-						IF m.dll THEN
-							IF x = mProc THEN exp := m.exp;
-								WHILE exp.name # name DO exp := exp.next END;
-								a := exp.adr + CodeBase + CodeSize
-							END
-						ELSE
-							SearchObj(m, name, x, fp, opt, a)
-						END;
-						IF x # mConst THEN Fixup(a) END;
-						RNum(x)
-					END;
-					IF ~m.dll THEN
-						Get(mod, mod.ms + modImports, x); DEC(x, ConBase + mod.ma); INC(x, 4 * i);
-						Put(mod, x, ConBase + m.ma + m.ms);	(* imp ref *)
-						Reloc(ConBase + mod.ma + x);
-						Get(m, m.ms + modRefcnt, x); Put(m, m.ms + modRefcnt, x + 1)	(* inc ref count *)
-					END;
-					INC(i)
-				END;
-				Ro.WriteBytes(code^, 0, mod.cs);
-				IF mod.intf THEN CollectExports(mod) END;
-				mod.file.Close; mod.file := NIL
-			END;
-			mod := mod.next
-		END;
-		(* dll links *)
-		mod := modList; ImpHSize := ImpSize;
-		WHILE mod # NIL DO
-			IF mod.dll THEN
-				exp := mod.exp; 
-				WHILE exp # NIL DO
-					WriteCh(0FFX); WriteCh(25X); Write4(ImageBase + ImpRva + ImpSize);	(* JMP indirect *)
-					Reloc(CodeBase + CodeSize + exp.adr + 2);
-					INC(ImpSize, 4); INC(numImp); exp := exp.next
-				END;
-				INC(ImpSize, 4); INC(numImp) (* sentinel *)
-			END;
-			mod := mod.next
-		END
-	END WriteCode;
-	
-	PROCEDURE WriteConst;
-		VAR mod, last: Module; x: INTEGER;
-	BEGIN
-		mod := modList; last := NIL;
-		WHILE mod # NIL DO
-			IF ~mod.dll THEN
-				IF last # NIL THEN
-					Put(mod, mod.ms, ConBase + last.ma + last.ms);	(* mod list *)
-					Reloc(ConBase + mod.ma + mod.ms);
-				END;
-				Get(mod, mod.ms + modOpts, x);
-				IF isStatic THEN INC(x, 10000H) END;	(* set init bit (16) *)
-				IF isDll THEN INC(x, 1000000H) END;	(* set dll bit (24) *)
-				Put(mod, mod.ms + modOpts, x);
-				Ro.WriteBytes(mod.data^, 0, mod.ms + mod.ds);
-				last := mod
-			END;
-			mod := mod.next
-		END
-	END WriteConst;
-	
-	PROCEDURE WriteResDir (n, i: INTEGER);
-	BEGIN
-		Write4(0);	(* flags *)
-		Write4(timeStamp);
-		Write4(0);	(* version *)
-		Write2(n);	(* name entries *)
-		Write2(i);	(* id entries *)
-	END WriteResDir;
-	
-	PROCEDURE WriteResDirEntry (id, adr: INTEGER; dir: BOOLEAN);
-	BEGIN
-		IF id = 0 THEN id := resHSize + 80000000H END;	(* name Rva *)
-		Write4(id);
-		IF dir THEN Write4(adr + 80000000H) ELSE Write4(adr) END
-	END WriteResDirEntry;
-	
-	PROCEDURE WriteMenu (res: Resource);
-		VAR f, i: INTEGER;
-	BEGIN
-		WHILE res # NIL DO
-			IF res.next = NIL THEN f := 80H ELSE f := 0 END;
-			IF 29 IN res.opts THEN INC(f, 1) END;	(* = grayed *)
-			IF 13 IN res.opts THEN INC(f, 2) END;	(* - inctive *)
-			IF 3 IN res.opts THEN INC(f, 4) END;	(* # bitmap *)
-			IF 10 IN res.opts THEN INC(f, 8) END;	(* * checked *)
-			IF 1 IN res.opts THEN INC(f, 20H) END;	(* ! menubarbreak *)
-			IF 15 IN res.opts THEN INC(f, 40H) END;	(* / menubreak *)
-			IF 31 IN res.opts THEN INC(f, 100H) END;	(* ? ownerdraw *)
-			IF res.local # NIL THEN Write2(f + 10H) ELSE Write2(f); Write2(res.id) END;
-			i := 0; WHILE res.name[i] # 0X DO Write2(ORD(res.name[i])); INC(i) END;
-			Write2(0);
-			WriteMenu(res.local);
-			res := res.next
-		END
-	END WriteMenu;
-	
-	PROCEDURE WriteResource;
-		VAR r, s: Resource; i, t, a, x, n, nlen, nsize: INTEGER;
-	BEGIN
-		IF numId[0] > 0 THEN WriteResDir(1, numType - 1); nlen := LEN(rsrcName$); nsize := (nlen + 1) * 2;
-		ELSE WriteResDir(0, numType)
-		END;
-		a := 16 + 8 * numType; t := 0;
-		WHILE t < LEN(numId) DO
-			IF numId[t] > 0 THEN WriteResDirEntry(t, a, TRUE); INC(a, 16 + 8 * numId[t]) END;
-			INC(t)
-		END;
-		r := resList; t := -1;
-		WHILE r # NIL DO
-			IF t # r.typ THEN t := r.typ; WriteResDir(0, numId[t]) END;
-			WriteResDirEntry(r.id, a, TRUE); INC(a, 16); i := r.id;
-			WHILE (r # NIL) & (r.typ = t) & (r.id = i) DO INC(a, 8); r := r.next END
-		END;
-		r := resList;
-		WHILE r # NIL DO
-			n := 0; s := r;
-			WHILE (s # NIL) & (s.typ = r.typ) & (s.id = r.id) DO INC(n); s := s.next END;
-			WriteResDir(0, n);
-			WHILE r # s DO WriteResDirEntry(r.lid, a, FALSE); INC(a, 16); r := r.next END
-		END;
-		ASSERT(a = resHSize);
-		IF numId[0] > 0 THEN INC(a, nsize) END;	(* TYPELIB string *)
-		r := resList;
-		WHILE r # NIL DO
-			Write4(a + RsrcRva); INC(a, (r.size + 3) DIV 4 * 4);
-			Write4(r.size);
-			Write4(0); Write4(0);
-			r := r.next
-		END;
-		ASSERT(a = RsrcSize);
-		IF numId[0] > 0 THEN
-			Write2(nlen); i := 0;
-			WHILE rsrcName[i] # 0X DO Write2(ORD(rsrcName[i])); INC(i) END
-		END;
-		r := resList;
-		WHILE r # NIL DO
-			IF r.typ = 4 THEN	(* menu *)
-				Write2(0); Write2(0);
-				WriteMenu(r.local);
-				WHILE Ro.Pos() MOD 4 # 0 DO WriteCh(0X) END
-			ELSIF r.typ = 9 THEN	(* accelerator *)
-				s := r.local;
-				WHILE s # NIL DO
-					i := 0; a := 0;
-					IF 10 IN s.opts THEN INC(a, 4) END;	(* * shift *)
-					IF 16 IN s.opts THEN INC(a, 8) END;	(* ^ ctrl *)
-					IF 0 IN s.opts THEN INC(a, 16) END;	(* @ alt *)
-					IF 13 IN s.opts THEN INC(a, 2) END;	(* - noinv *)
-					IF s.next = NIL THEN INC(a, 80H) END;
-					IF (s.name[0] = "v") & (s.name[1] # 0X) THEN
-						s.name[0] := " "; Strings.StringToInt(s.name, x, n); INC(a, 1)
-					ELSE x := ORD(s.name[0])
-					END;
-					Write2(a); Write2(x); Write2(s.id); Write2(0); s := s.next
-				END
-			ELSE
-				r.file := ThisResFile(r.name);
-				IF r.file # NIL THEN
-					R := r.file.NewReader(R); R.SetPos(r.pos); i := 0;
-					IF r.typ = 12 THEN	(* cursor group *)
-						Read4(x); Write4(x); Read2(n); Write2(n);
-						WHILE i < n DO
-							Read4(x); Write2(x MOD 256); Write2(x DIV 256 MOD 256 * 2);
-							Write2(1); Write2(1); Read4(x);	(* ??? *)
-							Read4(x); Write4(x + 4); Read4(x); Write2(r.id * 10 + i); INC(i)
-						END;
-						IF ~ODD(n) THEN Write2(0) END
-					ELSIF r.typ = 14 THEN	(* icon group *)
-						Read4(x); Write4(x); Read2(n); Write2(n);
-						WHILE i < n DO
-							Read2(x); Write2(x); Read2(x);
-							IF (13 IN r.opts) & (x = 16) THEN x := 4 END;
-							Write2(x);
-							a := x MOD 256; Read4(x); Write2(1);
-							IF a <= 2 THEN Write2(1)
-							ELSIF a <= 4 THEN Write2(2)
-							ELSIF a <= 16 THEN Write2(4)
-							ELSE Write2(8)
-							END;
-							Read4(x);
-							IF (13 IN r.opts) & (x = 744) THEN x := 440 END;
-							IF (13 IN r.opts) & (x = 296) THEN x := 184 END;
-							Write4(x); Read4(x); Write2(r.id * 10 + i); INC(i)
-						END;
-						IF ~ODD(n) THEN Write2(0) END
-					ELSE
-						IF r.typ = 1 THEN Write2(r.x); Write2(r.y); i := 4 END;	(* cursor hot spot *)
-						WHILE i < r.size DO Read4(x); Write4(x); INC(i, 4) END
-					END;
-					r.file.Close; r.file := NIL
-				END
-			END;
-			r := r.next
-		END
-	END WriteResource;
-
-	PROCEDURE Insert(VAR name: ARRAY OF SHORTCHAR; VAR idx: INTEGER; hint: INTEGER);
-		VAR i: INTEGER;
-	BEGIN
-		IF hint >= 0 THEN
-			ntab[idx] := SHORT(CHR(hint)); INC(idx);
-			ntab[idx] := SHORT(CHR(hint DIV 256)); INC(idx);
-		END;
-		i := 0;
-		WHILE name[i] # 0X DO ntab[idx] := name[i]; INC(idx); INC(i) END;
-		IF (hint = -1) & ((ntab[idx-4] # ".") OR (CAP(ntab[idx-3]) # "D") OR (CAP(ntab[idx-2]) # "L") OR (CAP(ntab[idx-1]) # "L")) THEN
-			ntab[idx] := "."; INC(idx);
-			ntab[idx] := "d"; INC(idx);
-			ntab[idx] := "l"; INC(idx);
-			ntab[idx] := "l"; INC(idx);
-		END;
-		ntab[idx] := 0X; INC(idx);
-		IF ODD(idx) THEN ntab[idx] := 0X; INC(idx) END
-	END Insert;
-
-	PROCEDURE WriteImport;
-		VAR i, lt, at, nt, ai, ni: INTEGER; mod: Module; exp: Export; ss: ARRAY 256 OF SHORTCHAR;
-	BEGIN
-		IF numImp > 0 THEN NEW(atab, numImp) END;
-		IF numExp > numImp THEN i := numExp ELSE i := numImp END;
-		IF i > 0 THEN NEW(ntab, 40 * i) END;
-		at := ImpRva + ImpHSize; ai := 0; ni := 0;
-		lt := ImpRva + ImpSize; nt := lt + ImpSize - ImpHSize;
-		mod := modList;
-		WHILE mod # NIL DO
-			IF mod.dll THEN
-				Write4(lt); (* lookup table rva *)
-				Write4(0); (* time/data (always 0) *)
-				Write4(0); (* version (always 0) *)
-				Write4(nt + ni); (* name rva *)
-				ss := SHORT(mod.name$); Insert(ss, ni, -1);
-				Write4(at); (* addr table rva *)
-				exp := mod.exp;
-				WHILE exp # NIL DO
-					atab[ai] := nt + ni; (* hint/name rva *)
-					Insert(exp.name, ni, 0);
-					INC(lt, 4); INC(at, 4); INC(ai); exp := exp.next
-				END;
-				atab[ai] := 0; INC(lt, 4); INC(at, 4); INC(ai)
-			END;
-			mod := mod.next
-		END;
-		Write4(0); Write4(0); Write4(0); Write4(0); Write4(0);
-		i := 0;
-		WHILE i < ai DO Write4(atab[i]); INC(i) END; (* address table *)
-		i := 0;
-		WHILE i < ai DO Write4(atab[i]); INC(i) END; (* lookup table *)
-		i := 0;
-		WHILE i < ni DO WriteCh(ntab[i]); INC(i) END;
-		ASSERT(ai * 4 = ImpSize - ImpHSize);
-		INC(ImpSize, ai * 4 + ni);
-		ExpRva := ImpRva + (ImpSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
-		RelocRva := ExpRva;
-	END WriteImport;
-	
-	PROCEDURE WriteExport (VAR name: ARRAY OF CHAR);
-		VAR i, ni: INTEGER; e: Export; ss: ARRAY 256 OF SHORTCHAR;
-	BEGIN
-		Write4(0);	(* flags *)
-		Write4(timeStamp);	(* time stamp *)
-		Write4(0);	(* version *)
-		Write4(ExpRva + 40 + 10 * numExp);	(* name rva *)
-		Write4(1);	(* ordinal base *)
-		Write4(numExp);	(* # entries *)
-		Write4(numExp);	(* # name ptrs *)
-		Write4(ExpRva + 40);	(* address table rva *)
-		Write4(ExpRva + 40 + 4 * numExp);	(* name ptr table rva *)
-		Write4(ExpRva + 40 + 8 * numExp);	(* ordinal table rva *)
-		ExpSize := 40 + 10 * numExp;
-		(* adress table *)
-		e := firstExp;
-		WHILE e # NIL DO Write4(e.adr); e := e.next END;
-		(* name ptr table *)
-		ni := 0; e := firstExp;
-		ss := SHORT(name$); Insert(ss, ni, -2);
-		WHILE e # NIL DO
-			Write4(ExpRva + ExpSize + ni); Insert(e.name, ni, -2); e := e.next
-		END;
-		(* ordinal table *)
-		i := 0;
-		WHILE i < numExp DO Write2(i); INC(i) END;
-		(* name table *)
-		i := 0;
-		WHILE i < ni DO WriteCh(ntab[i]); INC(i) END;
-		ExpSize := (ExpSize + ni + 15) DIV 16 * 16;
-		RelocRva := ExpRva + (ExpSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
-	END WriteExport;
-
-	PROCEDURE Sort (l, r: INTEGER);
-		VAR i, j, x, t: INTEGER;
-	BEGIN
-		i := l; j := r; x := fixups[(l + r) DIV 2];
-		REPEAT
-			WHILE fixups[i] < x DO INC(i) END;
-			WHILE fixups[j] > x DO DEC(j) END;
-			IF i <= j THEN t := fixups[i]; fixups[i] := fixups[j]; fixups[j] := t; INC(i); DEC(j) END
-		UNTIL i > j;
-		IF l < j THEN Sort(l, j) END;
-		IF i < r THEN Sort(i, r) END
-	END Sort;
-
-	PROCEDURE WriteReloc;
-		VAR i, j, h, a, p: INTEGER;
-	BEGIN
-		Sort(0, noffixup - 1); i := 0;
-		WHILE i < noffixup DO
-			p := fixups[i] DIV 4096 * 4096; j := i; a := p + 4096;
-			WHILE (j < noffixup) & (fixups[j] < a) DO INC(j) END;
-			Write4(p - ImageBase); (* page rva *)
-			h := 8 + 2 * (j - i);
-			Write4(h + h MOD 4); (* block size *)
-			INC(RelocSize, h);
-			WHILE i < j DO Write2(fixups[i] - p + 3 * 4096); INC(i) END; (* long fix *)
-			IF h MOD 4 # 0 THEN Write2(0); INC(RelocSize, 2) END
-		END;
-		Write4(0); Write4(0); INC(RelocSize, 8);
-		ImagesSize := RelocRva + (RelocSize + (ObjAlign - 1)) DIV ObjAlign * ObjAlign;
-	END WriteReloc;
-	
-	PROCEDURE Align(VAR pos: INTEGER);
-	BEGIN
-		WHILE Ro.Pos() MOD FileAlign # 0 DO WriteCh(0X) END;
-		pos := Ro.Pos()
-	END Align;
-	
-	PROCEDURE WriteOut (VAR name: Files.Name);
-		VAR res, codepos, conpos, rsrcpos, imppos, exppos, relpos, relend, end: INTEGER;
-	BEGIN
-		IF ~error THEN Align(codepos); WriteCode END;
-		IF ~error THEN Align(conpos); WriteConst END;
-		IF ~error THEN Align(rsrcpos); WriteResource END;
-		IF ~error THEN Align(imppos); WriteImport END;
-		IF ~error & isDll THEN Align(exppos); WriteExport(name) END;
-		IF ~error THEN Align(relpos); WriteReloc END;
-		relend := Ro.Pos() - 8; Align(end);
-		
-		IF ~error THEN
-			Ro.SetPos(entryPos); Write4(CodeRva);
-			Ro.SetPos(isPos); Write4(ImagesSize);
-			IF isDll THEN
-				Ro.SetPos(hexpPos); Write4(ExpRva); Write4(ExpSize);
-			END;
-			Ro.SetPos(himpPos); Write4(ImpRva); Write4(ImpHSize);
-			Ro.SetPos(hrsrcPos); Write4(RsrcRva); Write4(RsrcSize);
-			Ro.SetPos(fixPos); Write4(RelocRva); Write4(relend - relpos);
-	
-			Ro.SetPos(codePos); Write4(CodeRva); Write4(conpos - HeaderSize); Write4(HeaderSize);
-			Ro.SetPos(dataPos); Write4(DataRva); Write4((DataSize + (FileAlign-1)) DIV FileAlign * FileAlign);
-			Ro.SetPos(conPos); Write4(ConRva); Write4(rsrcpos - conpos); Write4(conpos);
-			Ro.SetPos(rsrcPos); Write4(RsrcRva); Write4(imppos - rsrcpos); Write4(rsrcpos);
-			IF isDll THEN
-				Ro.SetPos(impPos); Write4(ImpRva); Write4(exppos - imppos); Write4(imppos);
-				Ro.SetPos(expPos); Write4(ExpRva); Write4(relpos - exppos); Write4(exppos)
-			ELSE
-				Ro.SetPos(impPos); Write4(ImpRva); Write4(relpos - imppos); Write4(imppos);
-			END;
-			Ro.SetPos(relPos); Write4(RelocRva); Write4(end - relpos); Write4(relpos);
-			IF isStatic THEN
-				Ro.SetPos(termPos); WriteTermCode(modList, 0)
-			ELSIF isDll THEN
-				Ro.SetPos(termPos); WriteTermCode(main, 0)
-			END
-		END;
-		
-		IF ~error THEN
-			Out.Register(name, "exe", Files.ask, res);
-			IF res # 0 THEN error := TRUE END
-		END
-	END WriteOut;
-
-	(* A. V. Shiryaev: Scanner *)
-
-		PROCEDURE (VAR S: Scanner) SetPos (x: INTEGER), NEW;
-		BEGIN
-			S.rider.i := x
-		END SetPos;
-
-		PROCEDURE (VAR S: Scanner) ConnectTo (IN src: ARRAY OF CHAR), NEW;
-		BEGIN
-			NEW(S.rider.s, LEN(src$) + 1);
-			S.rider.s^ := src$;
-			S.rider.i := 0;
-			S.start := 0;
-			S.type := TMEOT
-		END ConnectTo;
-
-		PROCEDURE (VAR R: ScanRider) ReadPrevChar (VAR ch: CHAR), NEW;
-		BEGIN
-			ch := R.s[R.i]
-		END ReadPrevChar;
-
-		PROCEDURE (VAR R: ScanRider) ReadChar (VAR ch: CHAR), NEW;
-		BEGIN
-			ch := R.s[R.i];
-			INC(R.i)
-		END ReadChar;
-
-		PROCEDURE (VAR R: ScanRider) Pos (): INTEGER, NEW;
-		BEGIN
-			RETURN R.i
-		END Pos;
-
-		PROCEDURE (VAR S: Scanner) Scan, NEW;
-			VAR j, res: INTEGER;
-		
-			PROCEDURE IsLetter (c: CHAR): BOOLEAN;
-			BEGIN
-				RETURN ((c >= 'A') & (c <= 'Z')) OR ((c >= 'a') & (c <= 'z')) OR (c = '_')
-			END IsLetter;
-
-			PROCEDURE IsDigit (c: CHAR): BOOLEAN;
-			BEGIN
-				RETURN (c >= '0') & (c <= '9')
-			END IsDigit;
-
-		BEGIN
-			WHILE (S.rider.i < LEN(S.rider.s$)) & (S.rider.s[S.rider.i] = ' ') DO
-				INC(S.rider.i)
-			END;
-			IF S.rider.i < LEN(S.rider.s$) THEN
-				S.start := S.rider.i;
-				IF IsDigit(S.rider.s[S.rider.i]) THEN
-					j := 0;
-					WHILE (S.rider.i < LEN(S.rider.s$)) & IsDigit(S.rider.s[S.rider.i]) DO
-						S.string[j] := S.rider.s[S.rider.i];
-						INC(j);
-						INC(S.rider.i)
-					END;
-					S.string[j] := 0X;
-					Strings.StringToInt(S.string, S.int, res);
-					IF res # 0 THEN S.type := TMEOT
-					ELSE S.type := TMInt
-					END
-				ELSIF IsLetter(S.rider.s[S.rider.i]) THEN
-					S.type := TMString;
-					j := 0;
-					WHILE (S.rider.i < LEN(S.rider.s$)) & (IsLetter(S.rider.s[S.rider.i]) OR IsDigit(S.rider.s[S.rider.i])) DO
-						S.string[j] := S.rider.s[S.rider.i];
-						INC(j);
-						INC(S.rider.i)
-					END;
-					S.string[j] := 0X
-				ELSE
-					S.type := TMChar;
-					S.char := S.rider.s[S.rider.i];
-					INC(S.rider.i)
-				END
-			ELSE
-				S.type := TMEOT
-			END
-		END Scan;
-
-	PROCEDURE ScanRes (VAR S: Scanner; end: INTEGER; VAR list: Resource);
-		VAR res, tail: Resource; n: INTEGER;
-	BEGIN
-		tail := NIL;
-		WHILE (S.start < end) & (S.type = TMInt) DO
-			NEW(res); res.id := S.int; S.Scan;
-			IF (S.type = TMChar) & (S.char = "[") THEN
-				S.Scan;
-				IF S.type = TMInt THEN res.lid := S.int; S.Scan END;
-				IF (S.type = TMChar) & (S.char = "]") THEN S.Scan
-				ELSE WriteSString("missing ']'"); error := TRUE
-				END
-			END;
-			WHILE S.type = TMChar DO
-				IF S.char = "@" THEN n := 0
-				ELSIF S.char = "^" THEN n := 16
-				ELSIF S.char = "~" THEN n := 17
-				ELSIF S.char <= "?" THEN n := ORD(S.char) - ORD(" ")
-				END;
-				INCL(res.opts, n); S.Scan
-			END;
-			IF S.type = TMString THEN
-				res.name := S.string$; S.Scan;
-				IF (S.type = TMChar) & (S.char = ".") THEN S.Scan;
-					IF S.type = TMString THEN
-						IF (S.string = "tlb") OR (S.string = "TLB") THEN res.typ := -1 END;
-						Kernel.MakeFileName(res.name, S.string); S.Scan
-					END
-				END;
-				IF (S.type = TMChar) & (S.char = "(") THEN S.Scan;
-					ScanRes(S, end, res.local);
-					IF (S.type = TMChar) & (S.char = ")") THEN S.Scan
-					ELSE WriteSString("missing ')'"); error := TRUE
-					END
-				END;
-				IF tail = NIL THEN list := res ELSE tail.next := res END;
-				tail := res
-			ELSE
-				WriteSString("wrong resource name"); error := TRUE
-			END
-		END;
-	END ScanRes;
-
-	PROCEDURE LinkIt (IN txt: ARRAY OF CHAR);
-		VAR S: Scanner; name: Files.Name; mod: Module; end: INTEGER;
-	BEGIN
-		comLine := FALSE;
-		modList := NIL; kernel := NIL; main := NIL;
-		last := NIL; impg := NIL; impd := NIL; resList := NIL;
-		firstExp := NIL; lastExp := NIL;
-		NEW(fixups, FixLen);
-
-(*
-		Dialog.ShowStatus("linking");
-*)
-		Console.WriteStr("linking"); Console.WriteLn;
-
-(*
-		timeStamp := TimeStamp();
-*)
-		timeStamp := 0;
-
-		error := FALSE; modList := NIL; resList := NIL;
-
-(*
-		IF DevCommanders.par = NIL THEN RETURN END;
-		S.ConnectTo(DevCommanders.par.text);
-		S.SetPos(DevCommanders.par.beg);
-		end := DevCommanders.par.end;
-		DevCommanders.par := NIL;
-		W.ConnectTo(Log.buf);
-*)
-
-		S.ConnectTo(txt);
-		S.SetPos(0);
-		end := LEN(txt$);
-		
-		S.Scan;
-		IF S.type = TMString THEN
-			IF S.string = "dos" THEN comLine := TRUE; S.Scan END;
-			name := S.string$; S.Scan;
-			IF (S.type = TMChar) & (S.char = ".") THEN S.Scan;
-				IF S.type = TMString THEN
-					Kernel.MakeFileName(name, S.string); S.Scan
-				END
-			ELSE Kernel.MakeFileName(name, "EXE");
-			END;
-			IF (S.type = TMChar) & (S.char = ":") THEN S.Scan;
-				IF (S.type = TMChar) & (S.char = "=") THEN S.Scan;
-					WHILE (S.start < end) & (S.type = TMString) DO
-						NEW(mod); mod.name := S.string$;
-						mod.next := modList; modList := mod;
-						S.Scan;
-						WHILE (S.start < end) & (S.type = TMChar) &
-							((S.char = "*") OR (S.char = "+") OR (S.char = "$") OR (S.char = "#")) DO
-							IF S.char = "*" THEN mod.dll := TRUE
-							ELSIF S.char = "+" THEN kernel := mod
-							ELSIF S.char = "$" THEN main := mod
-							ELSE mod.intf := TRUE;
-								IF ~isDll THEN
-									WriteSString("Exports from Exe not possible. Use LinkDll or LinkDynDll.");
-									WriteLn; FlushW; error := TRUE
-								END
-							END;
-							S.Scan
-						END
-					END;
-					ScanRes(S, end, resList);
-					ReadHeaders;
-					PrepResources;
-					IF ~error THEN WriteHeader(name) END;
-					IF ~error THEN WriteOut(name) END;
-					IF ~error THEN	
-						WriteString(name); WriteString(" written  ");
-						WriteInt(Out.Length()); WriteString("  "); WriteInt(CodeSize)
-					END
-				ELSE WriteString(" := missing")
-				END
-			ELSE WriteString(" := missing")
-			END;
-			WriteLn; FlushW
-		END;
-(*
-		IF error THEN Dialog.ShowStatus("failed") ELSE Dialog.ShowStatus("ok") END;
-		W.ConnectTo(NIL); S.ConnectTo(NIL);
-*)
-		IF error THEN Console.WriteStr("failed") ELSE Console.WriteStr("ok") END; Console.WriteLn;
-		S.ConnectTo("");
-
-		modList := NIL; kernel := NIL; main := NIL; firstExp := NIL; lastExp := NIL;
-		last := NIL; impg := NIL; impd := NIL; resList := NIL; code := NIL; atab := NIL; ntab := NIL;
-		fixups := NIL
-	END LinkIt;
-	
-	PROCEDURE Link* (IN txt: ARRAY OF CHAR);
-	BEGIN
-		isDll := FALSE; isStatic := FALSE;
-		LinkIt(txt)
-	END Link;
-	
-	PROCEDURE LinkExe* (IN txt: ARRAY OF CHAR);
-	BEGIN
-		isDll := FALSE; isStatic := TRUE;
-		LinkIt(txt)
-	END LinkExe;
-	
-	PROCEDURE LinkDll* (IN txt: ARRAY OF CHAR);
-	BEGIN
-		isDll := TRUE; isStatic := TRUE;
-		LinkIt(txt)
-	END LinkDll;
-	
-	PROCEDURE LinkDynDll* (IN txt: ARRAY OF CHAR);
-	BEGIN
-		isDll := TRUE; isStatic := FALSE;
-		LinkIt(txt)
-	END LinkDynDll;
-	
-(*
-	PROCEDURE Show*;
-		VAR S: TextMappers.Scanner; name: Name; mod: Module; t: TextModels.Model;
-	BEGIN
-		t := TextViews.FocusText(); IF t = NIL THEN RETURN END;
-		W.ConnectTo(Log.buf); S.ConnectTo(t); S.Scan;
-		IF S.type = TextMappers.string THEN
-			mod := modList;
-			WHILE (mod # NIL) & (mod.name # S.string) DO mod := mod.next END;
-			IF mod # NIL THEN
-				W.WriteString(S.string);
-				W.WriteString(" ca = ");
-				W.WriteIntForm(CodeBase + mod.ca, TextMappers.hexadecimal, 8, "0", TRUE);
-				W.WriteLn; Log.text.Append(Log.buf)
-			END
-		END;
-		W.ConnectTo(NIL); S.ConnectTo(NIL)
-	END Show;
-*)
-		
-BEGIN
-	newRec := "NewRec"; newArr := "NewArr"
-END Dev0Linker.
-
-
-(!)DevLinker.Link Usekrnl.exe := TestKernel$+ Usekrnl ~	(!)"DevDecExe.Decode('', 'Usekrnl.exe')"
-
-(!)DevLinker.LinkDynDll MYDLL.dll := TestKernel+ MYDLL$# ~	(!)"DevDecExe.Decode('', 'MYDLL.dll')"
-
-(!)DevLinker.LinkExe Usekrnl.exe := TestKernel+ Usekrnl ~	(!)"DevDecExe.Decode('', 'Usekrnl.exe')"
-
-(!)DevLinker.LinkDll MYDLL.dll := TestKernel+ MYDLL# ~	(!)"DevDecExe.Decode('', 'MYDLL.dll')"
-
-
-MODULE TestKernel;
-	IMPORT KERNEL32;
-
-	PROCEDURE Beep*;
-	BEGIN
-		KERNEL32.Beep(500, 200)
-	END Beep;
-	
-BEGIN
-CLOSE
-	KERNEL32.ExitProcess(0)
-END TestKernel.
-
-MODULE Usekrnl;
-(* empty windows application using BlackBox Kernel *)
-(* Ominc (!) *)
-
-	IMPORT KERNEL32, USER32, GDI32, S := SYSTEM, Kernel := TestKernel;
-	
-	VAR Instance, MainWnd: USER32.Handle;
-		
-	PROCEDURE WndHandler (wnd, message, wParam, lParam: INTEGER): INTEGER;
-		VAR res: INTEGER; ps: USER32.PaintStruct; dc: GDI32.Handle;
-	BEGIN
-		IF message = USER32.WMDestroy THEN
-			USER32.PostQuitMessage(0)
-		ELSIF message = USER32.WMPaint THEN
-			dc := USER32.BeginPaint(wnd, ps);
-			res := GDI32.TextOutA(dc, 50, 50, "Hello World", 11);
-			res := USER32.EndPaint(wnd, ps)
-		ELSIF message = USER32.WMChar THEN
-			Kernel.Beep
-		ELSE
-			RETURN USER32.DefWindowProcA(wnd, message, wParam, lParam)
-		END;
-		RETURN 0
-	END WndHandler;
-	
-	PROCEDURE OpenWindow;
-		VAR class: USER32.WndClass; res: INTEGER;
-	BEGIN
-		class.cursor := USER32.LoadCursorA(0, USER32.MakeIntRsrc(USER32.IDCArrow));
-		class.icon := USER32.LoadIconA(Instance, USER32.MakeIntRsrc(1));
-		class.menuName := NIL;
-		class.className := "Simple";
-		class.backgnd := GDI32.GetStockObject(GDI32.WhiteBrush);
-		class.style := {0, 1, 5, 7};
-		class.instance := Instance;
-		class.wndProc := WndHandler;
-		class.clsExtra := 0;
-		class.wndExtra := 0;
-		USER32.RegisterClassA(class);
-		MainWnd := USER32.CreateWindowExA({}, "Simple", "Empty Windows Application",
-														{16..19, 22, 23, 25},
-														USER32.CWUseDefault, USER32.CWUseDefault,
-														USER32.CWUseDefault, USER32.CWUseDefault,
-														0, 0, Instance, 0);
-		res := USER32.ShowWindow(MainWnd, 10);
-		res := USER32.UpdateWindow(MainWnd);
-	END OpenWindow;
-	
-	PROCEDURE MainLoop;
-		VAR msg: USER32.Message; res: INTEGER;
-	BEGIN
-		WHILE USER32.GetMessageA(msg, 0, 0, 0) # 0 DO
-			res := USER32.TranslateMessage(msg);
-			res := USER32.DispatchMessageA(msg);
-		END;
-(*
-		KERNEL32.ExitProcess(msg.wParam)
-*)
-	END MainLoop;
-	
-BEGIN
-	Instance := KERNEL32.GetModuleHandleA(NIL);
-	OpenWindow;
-	MainLoop
-CLOSE
-	Kernel.Beep
-END Usekrnl.
-
-
-MODULE MYDLL;
-(* sample module to be linked into a dll *)
-(* Ominc (!) *)
-
-	IMPORT SYSTEM, KERNEL32;
-	
-	VAR expVar*: INTEGER;
-	
-	PROCEDURE GCD* (a, b: INTEGER): INTEGER;
-	BEGIN
-		WHILE a # b DO
-			IF a < b THEN b := b - a ELSE a := a - b END
-		END;
-		expVar := a;
-		RETURN a
-	END GCD;
-
-	PROCEDURE Beep*;
-	BEGIN
-		KERNEL32.Beep(500, 200)
-	END Beep;
-	
-CLOSE
-	Beep
-END MYDLL.
-
-
-
-Resource = Id [ "[" Language "]" ] Options name [ "." ext ] [ "(" { Resource } ")" ]
-Id = number
-Language = number
-Options = { "@" | "!" .. "?" | "^" | "~" }
-
-names
-
-MENU
-	1 MENU (0 File (11 New 12 Open 13 Save 0 "" 14 Exit) 0 Edit (21 Cut 22 Copy 23 Paste))
-		= grayed
-		- inctive
-		# bitmap
-		* checked
-		! menuBarBreak
-		/ menuBreak
-		? ownerDraw
-
-ACCELERATOR
-	1 ACCELERATOR (11 ^N 12 ^O 13 ^S 21 ^X 22 ^C 23 ^V)
-		* shift
-		^ ctrl
-		@ alt
-		- noInvert
-
-filename.ico
-
-filename.cur
-
-filname.bmp
-
-filename.res
-
-filename.tlb

new/Dev0/Views.txt

@@ -1,14 +0,0 @@
-MODULE Views;
-
-	(* TO COMPILE StdInterpreter *)
-
-	PROCEDURE Available* (): INTEGER;
-	BEGIN
-	RETURN 0
-	END Available;
-
-	PROCEDURE ClearQueue*;
-	BEGIN
-	END ClearQueue;
-
-END Views.

new/System/Mod/Console.txt

@@ -1,58 +0,0 @@
-MODULE Console;
-
-	(* THIS IS TEXT COPY OF Console.odc *)
-	(* DO NOT EDIT *)
-
-	(*
-		A. V. Shiryaev, 2012.10
-
-		Interface based on OpenBUGS Console
-	*)
-
-	TYPE
-		Console* = POINTER TO ABSTRACT RECORD END;
-
-	VAR
-		cons: Console;
-
-	(* Console *)
-
-	PROCEDURE (c: Console) WriteStr- (IN s: ARRAY OF CHAR), NEW, ABSTRACT;
-	PROCEDURE (c: Console) WriteChar- (ch: CHAR), NEW, ABSTRACT;
-	PROCEDURE (c: Console) WriteLn-, NEW, ABSTRACT;
-
-	(*
-		post:
-			s = "": end of input or input error
-			s # "": line with end of line postfix
-	*)
-	PROCEDURE (c: Console) ReadLn- (OUT s: ARRAY OF CHAR), NEW, ABSTRACT;
-
-
-	PROCEDURE WriteStr* (IN text: ARRAY OF CHAR);
-	BEGIN
-		cons.WriteStr(text)
-	END WriteStr;
-
-	PROCEDURE WriteChar* (c: CHAR);
-	BEGIN
-		cons.WriteChar(c)
-	END WriteChar;
-
-	PROCEDURE WriteLn*;
-	BEGIN
-		cons.WriteLn
-	END WriteLn;
-
-	PROCEDURE ReadLn* (OUT text: ARRAY OF CHAR);
-	BEGIN
-		cons.ReadLn(text)
-	END ReadLn;
-
-
-	PROCEDURE SetConsole* (c: Console);
-	BEGIN
-		cons := c
-	END SetConsole;
-
-END Console.

new/System/Mod/Containers.txt

@@ -1,1381 +0,0 @@
-MODULE Containers;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Containers.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT Kernel, Services, Ports, Dialog, Stores, Models, Views, Controllers, Properties, Mechanisms;
-
-	CONST
-		(** Controller.opts **)
-		noSelection* = 0; noFocus* = 1; noCaret* = 2;
-		mask* = {noSelection, noCaret}; layout* = {noFocus};
-		modeOpts = {noSelection, noFocus, noCaret};
-
-		(** Controller.SelectAll select **)
-		deselect* = FALSE; select* = TRUE;
-
-		(** Controller.PollNativeProp/etc. selection **)
-		any* = FALSE; selection* = TRUE;
-
-		(** Mark/MarkCaret/MarkSelection/MarkSingleton show **)
-		hide* = FALSE; show* = TRUE;
-
-		indirect = FALSE; direct = TRUE;
-
-		TAB = 9X; LTAB = 0AX; ENTER = 0DX; ESC = 01BX;
-		PL = 10X; PR = 11X; PU = 12X; PD = 13X;
-		DL = 14X; DR = 15; DU = 16X; DD = 17X;
-		AL = 1CX; AR = 1DX; AU = 1EX; AD = 1FX;
-
-		minVersion = 0; maxModelVersion = 0; maxViewVersion = 0; maxCtrlVersion = 0;
-
-		(* buttons *)
-		left = 16; middle = 17; right = 18; alt = 28;	(* same as in HostPorts! *)
-
-
-	TYPE
-		Model* = POINTER TO ABSTRACT RECORD (Models.Model) END;
-
-		View* = POINTER TO ABSTRACT RECORD (Views.View)
-			model: Model;
-			controller: Controller;
-			alienCtrl: Stores.Store	(* alienCtrl = NIL  OR  controller = NIL *)
-		END;
-
-		Controller* = POINTER TO ABSTRACT RECORD (Controllers.Controller)
-			opts-: SET;
-			model: Model;	(* connected iff model # NIL *)
-			view: View;
-			focus, singleton: Views.View;
-			bVis: BOOLEAN	(* control visibility of focus/singleton border *)
-		END;
-
-		Directory* = POINTER TO ABSTRACT RECORD END;
-
-		PollFocusMsg = RECORD (Controllers.PollFocusMsg)
-			all: BOOLEAN;
-			ctrl: Controller
-		END;
-		
-		ViewOp = POINTER TO RECORD (Stores.Operation)
-			v: View;
-			controller: Controller;	(* may be NIL *)
-			alienCtrl: Stores.Store
-		END;
-
-		ControllerOp = POINTER TO RECORD (Stores.Operation)
-			c: Controller;
-			opts: SET
-		END;
-
-		ViewMessage = ABSTRACT RECORD (Views.Message) END;
-
-		FocusMsg = RECORD (ViewMessage)
-			set: BOOLEAN
-		END;
-
-		SingletonMsg = RECORD (ViewMessage)
-			set: BOOLEAN
-		END;
-
-		FadeMsg = RECORD (ViewMessage)
-			show: BOOLEAN
-		END;
-		
-		DropPref* = RECORD (Properties.Preference)
-			mode-: SET;
-			okToDrop*: BOOLEAN
-		END;
-		
-		GetOpts* = RECORD (Views.PropMessage)
-			valid*, opts*: SET
-		END;
-		
-		SetOpts* = RECORD (Views.PropMessage)
-			valid*, opts*: SET
-		END;
-	
-
-	PROCEDURE ^ (v: View) SetController* (c: Controller), NEW;
-	PROCEDURE ^ (v: View) InitModel* (m: Model), NEW;
-
-	PROCEDURE ^ Focus* (): Controller;
-	PROCEDURE ^ ClaimFocus (v: Views.View): BOOLEAN;
-	PROCEDURE ^ MarkFocus (c: Controller; f: Views.Frame; show: BOOLEAN);
-	PROCEDURE ^ MarkSingleton* (c: Controller; f: Views.Frame; show: BOOLEAN);
-	PROCEDURE ^ FadeMarks* (c: Controller; show: BOOLEAN);
-	PROCEDURE ^ CopyView (source: Controller; VAR view: Views.View; VAR w, h: INTEGER);
-	PROCEDURE ^ ThisProp (c: Controller; direct: BOOLEAN): Properties.Property;
-	PROCEDURE ^ SetProp (c: Controller; old, p: Properties.Property; direct: BOOLEAN);
-
-
-	PROCEDURE ^ (c: Controller) InitView* (v: Views.View), NEW;
-	PROCEDURE (c: Controller) InitView2* (v: Views.View), NEW, EMPTY;
-	PROCEDURE ^ (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
-	PROCEDURE ^ (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
-	PROCEDURE ^ (c: Controller) ConsiderFocusRequestBy* (view: Views.View), NEW;
-	PROCEDURE ^ (c: Controller) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER), NEW;
-	PROCEDURE ^ (c: Controller) Neutralize*, NEW;
-	(** called by view's Neutralize **)
-	PROCEDURE ^ (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
-	(** called by view's HandleModelMsg after handling msg **)
-	PROCEDURE ^ (c: Controller) HandleViewMsg* (f: Views.Frame; VAR msg: Views.Message), NEW, EXTENSIBLE;
-	(** called by view's HandleViewMsg after handling msg **)
-	PROCEDURE ^ (c: Controller) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View), NEW, EXTENSIBLE;
-	(** called by view's HandleCtrlMsg *before* handling msg; focus is respected/used by view **)
-	PROCEDURE ^ (c: Controller) HandlePropMsg* (VAR msg: Views.PropMessage), NEW, EXTENSIBLE;
-	(** called by view's HandlePropMsg after handling msg; controller can override view **)
-
-	(** Model **)
-
-	PROCEDURE (m: Model) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
-		VAR thisVersion: INTEGER;
-	BEGIN
-		m.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxModelVersion, thisVersion)
-	END Internalize;
-
-	PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
-	BEGIN
-		m.Externalize^(wr);
-		wr.WriteVersion(maxModelVersion)
-	END Externalize;
-
-	PROCEDURE (m: Model) GetEmbeddingLimits* (OUT minW, maxW, minH, maxH: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (m: Model) ReplaceView* (old, new: Views.View), NEW, ABSTRACT;
-	PROCEDURE (m: Model) InitFrom- (source: Model), NEW, EMPTY;
-
-	(** View **)
-
-	PROCEDURE (v: View) AcceptableModel- (m: Model): BOOLEAN, NEW, ABSTRACT;
-	PROCEDURE (v: View) InitModel2- (m: Model), NEW, EMPTY;
-	PROCEDURE (v: View) InitModel* (m: Model), NEW;
-	BEGIN
-		ASSERT((v.model = NIL) OR (v.model = m), 20);
-		ASSERT(m # NIL, 21);
-		ASSERT(v.AcceptableModel(m), 22);
-		v.model := m;
-		Stores.Join(v, m);
-		v.InitModel2(m)
-	END InitModel;
-	
-	
-	PROCEDURE (v: View) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
-	PROCEDURE(v: View) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
-
-	PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader);
-		VAR st: Stores.Store; c: Controller; m: Model; thisVersion: INTEGER;
-	BEGIN
-		v.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxViewVersion, thisVersion);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadStore(st); ASSERT(st # NIL, 100);
-		IF ~(st IS Model) THEN
-			rd.TurnIntoAlien(Stores.alienComponent);
-			Stores.Report("#System:AlienModel", "", "", "");
-			RETURN
-		END;
-		m := st(Model);
-		rd.ReadStore(st);
-		IF st = NIL THEN c := NIL; v.alienCtrl := NIL
-		ELSIF st IS Stores.Alien THEN
-			c := NIL; v.alienCtrl := st; Stores.Join(v, v.alienCtrl);
-			Stores.Report("#System:AlienControllerWarning", "", "", "")
-		ELSE c := st(Controller); v.alienCtrl := NIL
-		END;
-		v.InitModel(m);
-		IF c # NIL THEN v.SetController(c) ELSE v.controller := NIL END;
-		v.Internalize2(rd)
-	END Internalize;
-
-	PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer);
-	BEGIN
-		ASSERT(v.model # NIL, 20);
-		v.Externalize^(wr);
-		wr.WriteVersion(maxViewVersion);
-		wr.WriteStore(v.model);
-		IF v.controller # NIL THEN wr.WriteStore(v.controller)
-		ELSE wr.WriteStore(v.alienCtrl)
-		END;
-		v.Externalize2(wr)
-	END Externalize;
-
-	PROCEDURE (v: View) CopyFromModelView2- (source: Views.View; model: Models.Model), NEW, EMPTY;
-	
-	PROCEDURE (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
-		VAR c: Controller;
-	BEGIN
-		WITH source: View DO
-			v.InitModel(model(Model));
-			IF source.controller # NIL THEN
-				c := Stores.CopyOf(source.controller)(Controller)
-			ELSE
-				c := NIL
-			END;
-			IF source.alienCtrl # NIL THEN v.alienCtrl := Stores.CopyOf(source.alienCtrl)(Stores.Alien) END;
-			IF c # NIL THEN v.SetController(c) ELSE v.controller := NIL END
-		END;
-		v.CopyFromModelView2(source, model)
-	END CopyFromModelView;
-
-	PROCEDURE (v: View) ThisModel* (): Model, EXTENSIBLE;
-	BEGIN
-		RETURN v.model
-	END ThisModel;
-
-	PROCEDURE (v: View) SetController* (c: Controller), NEW;
-		VAR op: ViewOp;
-	BEGIN
-		ASSERT(v.model # NIL, 20);
-		IF v.controller # c THEN
-			Stores.Join(v, c);
-			NEW(op); op.v := v; op.controller := c; op.alienCtrl := NIL;
-			Views.Do(v, "#System:ViewSetting", op)
-		END
-	END SetController;
-
-	PROCEDURE (v: View) ThisController* (): Controller, NEW, EXTENSIBLE;
-	BEGIN
-		RETURN v.controller
-	END ThisController;
-	
-	PROCEDURE (v: View) GetRect* (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER), NEW, ABSTRACT;
-
-	PROCEDURE (v: View) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		IF v.controller # NIL THEN v.controller.RestoreMarks(f, l, t, r, b) END
-	END RestoreMarks;
-
-	PROCEDURE (v: View) Neutralize*;
-	BEGIN
-		IF v.controller # NIL THEN v.controller.Neutralize END
-	END Neutralize;
-
-	PROCEDURE (v: View) ConsiderFocusRequestBy- (view: Views.View);
-	BEGIN
-		IF v.controller # NIL THEN v.controller.ConsiderFocusRequestBy(view) END
-	END ConsiderFocusRequestBy;
-
-
-	PROCEDURE (v: View) HandleModelMsg2- (VAR msg: Models.Message), NEW, EMPTY;
-	PROCEDURE (v: View) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
-	PROCEDURE (v: View) HandlePropMsg2- (VAR p: Properties.Message), NEW, EMPTY;
-	PROCEDURE (v: View) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Controllers.Message; 
-																					VAR focus: Views.View), NEW, EMPTY;
-
-
-	PROCEDURE (v: View) HandleModelMsg- (VAR msg: Models.Message);
-	BEGIN
-		v.HandleModelMsg2(msg);
-		IF v.controller # NIL THEN v.controller.HandleModelMsg(msg) END
-	END HandleModelMsg;
-
-	PROCEDURE (v: View) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
-	BEGIN
-		v.HandleViewMsg2(f, msg);
-		IF v.controller # NIL THEN v.controller.HandleViewMsg(f, msg) END
-	END HandleViewMsg;
-
-	PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
-	BEGIN
-		IF v.controller # NIL THEN v.controller.HandleCtrlMsg(f, msg, focus) END;
-		v.HandleCtrlMsg2(f, msg, focus);
-		WITH msg: Controllers.PollSectionMsg DO
-			IF ~msg.focus THEN focus := NIL END
-		| msg: Controllers.ScrollMsg DO
-			IF ~msg.focus THEN focus := NIL END
-		ELSE
-		END
-	END HandleCtrlMsg;
-
-	PROCEDURE (v: View) HandlePropMsg- (VAR p: Properties.Message);
-	BEGIN
-		v.HandlePropMsg2(p);
-		IF v.controller # NIL THEN v.controller.HandlePropMsg(p) END
-	END HandlePropMsg ;
-
-
-	(** Controller **)
-
-	PROCEDURE (c: Controller) Externalize2- (VAR rd: Stores.Writer), NEW, EMPTY;
-	PROCEDURE(c: Controller) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
-
-	PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader);
-		VAR v: INTEGER;
-	BEGIN
-		c.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxCtrlVersion, v);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadSet(c.opts);
-		c.Internalize2(rd)
-	END Internalize;
-
-	PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer);
-	BEGIN
-		c.Externalize^(wr);
-		wr.WriteVersion(maxCtrlVersion);
-		wr.WriteSet(c.opts);
-		c.Externalize2(wr)
-	END Externalize;
-
-	PROCEDURE (c: Controller) CopyFrom- (source: Stores.Store), EXTENSIBLE;
-	BEGIN
-		WITH source: Controller DO
-			c.opts := source.opts;
-			c.focus := NIL; c.singleton := NIL;
-			c.bVis := FALSE
-		END
-	END CopyFrom;
-
-	PROCEDURE (c: Controller) InitView* (v: Views.View), NEW;
-		VAR view: View; model: Model;
-	BEGIN
-		ASSERT((v = NIL) # (c.view = NIL) OR (v = c.view), 21);
-		IF c.view = NIL THEN
-			ASSERT(v IS View, 22);	(* subclass may assert narrower type *)
-			view := v(View);
-			model := view.ThisModel(); ASSERT(model # NIL, 24);
-			c.view := view; c.model := model;
-			Stores.Join(c, c.view)
-		ELSE
-			c.view.Neutralize; c.view := NIL; c.model := NIL
-		END;
-		c.focus := NIL; c.singleton := NIL; c.bVis := FALSE;
-		c.InitView2(v)
-	END InitView;
-
-	PROCEDURE (c: Controller) ThisView* (): View, NEW, EXTENSIBLE;
-	BEGIN
-		RETURN c.view
-	END ThisView;
-
-
-	(** options **)
-
-	PROCEDURE (c: Controller) SetOpts* (opts: SET), NEW, EXTENSIBLE;
-		VAR op: ControllerOp;
-	BEGIN
-		IF c.view # NIL THEN
-			NEW(op); op.c := c; op.opts := opts;
-			Views.Do(c.view, "#System:ChangeOptions", op)
-		ELSE
-			c.opts := opts
-		END
-	END SetOpts;
-
-
-	(** subclass hooks **)
-
-	PROCEDURE (c: Controller) GetContextType* (OUT type: Stores.TypeName), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) GetValidOps* (OUT valid: SET), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) NativeModel* (m: Models.Model): BOOLEAN, NEW, ABSTRACT;
-	PROCEDURE (c: Controller) NativeView* (v: Views.View): BOOLEAN, NEW, ABSTRACT;
-	PROCEDURE (c: Controller) NativeCursorAt* (f: Views.Frame; x, y: INTEGER): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (c: Controller) PickNativeProp* (f: Views.Frame; x, y: INTEGER; VAR p: Properties.Property), NEW, EMPTY;
-	PROCEDURE (c: Controller) PollNativeProp* (selection: BOOLEAN; VAR p: Properties.Property; VAR truncated: BOOLEAN), NEW, EMPTY;
-	PROCEDURE (c: Controller) SetNativeProp* (selection: BOOLEAN; old, p: Properties.Property), NEW, EMPTY;
-
-	PROCEDURE (c: Controller) MakeViewVisible* (v: Views.View), NEW, EMPTY;
-	
-	PROCEDURE (c: Controller) GetFirstView* (selection: BOOLEAN; OUT v: Views.View), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) GetNextView* (selection: BOOLEAN; VAR v: Views.View), NEW, ABSTRACT;
-
-	PROCEDURE (c: Controller) GetPrevView* (selection: BOOLEAN; VAR v: Views.View), NEW, EXTENSIBLE;
-		VAR p, q: Views.View;
-	BEGIN
-		ASSERT(v # NIL, 20);
-		c.GetFirstView(selection, p);
-		IF p # v THEN
-			WHILE (p # NIL) & (p # v) DO q := p; c.GetNextView(selection, p) END;
-			ASSERT(p # NIL, 21);
-			v := q
-		ELSE
-			v := NIL
-		END
-	END GetPrevView;
-	
-	PROCEDURE (c: Controller) CanDrop* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, EXTENSIBLE;
-	BEGIN
-		RETURN TRUE
-	END CanDrop;
-
-	PROCEDURE (c: Controller) GetSelectionBounds* (f: Views.Frame; OUT x, y, w, h: INTEGER), NEW, EXTENSIBLE;
-		VAR g: Views.Frame; v: Views.View;
-	BEGIN
-		x := 0; y := 0; w := 0; h := 0;
-		v := c.singleton;
-		IF v # NIL THEN
-			g := Views.ThisFrame(f, v);
-			IF g # NIL THEN
-				x := g.gx - f.gx; y := g.gy - f.gy;
-				v.context.GetSize(w, h)
-			END
-		END
-	END GetSelectionBounds;
-
-	PROCEDURE (c: Controller) MarkDropTarget* (src, dst: Views.Frame;
-															sx, sy, dx, dy, w, h, rx, ry: INTEGER;
-															type: Stores.TypeName;
-															isSingle, show: BOOLEAN), NEW, EMPTY;
-
-	PROCEDURE (c: Controller) Drop* (src, dst: Views.Frame; sx, sy, dx, dy, w, h, rx, ry: INTEGER;
-													view: Views.View; isSingle: BOOLEAN), NEW, ABSTRACT;
-
-	PROCEDURE (c: Controller) MarkPickTarget* (src, dst: Views.Frame;
-															sx, sy, dx, dy: INTEGER; show: BOOLEAN), NEW, EMPTY;
-
-	PROCEDURE (c: Controller) TrackMarks* (f: Views.Frame; x, y: INTEGER; units, extend, add: BOOLEAN), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) Resize* (view: Views.View; l, t, r, b: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) DeleteSelection*, NEW, ABSTRACT;
-	PROCEDURE (c: Controller) MoveLocalSelection* (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) CopyLocalSelection* (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) SelectionCopy* (): Model, NEW, ABSTRACT;
-	PROCEDURE (c: Controller) NativePaste* (m: Models.Model; f: Views.Frame), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) ArrowChar* (f: Views.Frame; ch: CHAR; units, select: BOOLEAN), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) ControlChar* (f: Views.Frame; ch: CHAR), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) PasteChar* (ch: CHAR), NEW, ABSTRACT;
-	PROCEDURE (c: Controller) PasteView* (f: Views.Frame; v: Views.View; w, h: INTEGER), NEW, ABSTRACT;
-
-
-	(** selection **)
-
-	PROCEDURE (c: Controller) HasSelection* (): BOOLEAN, NEW, EXTENSIBLE;
-	(** extended by subclass to include intrinsic selections **)
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		RETURN c.singleton # NIL
-	END HasSelection;
-
-	PROCEDURE (c: Controller) Selectable* (): BOOLEAN, NEW, ABSTRACT;
-
-	PROCEDURE (c: Controller) Singleton* (): Views.View, NEW;	(* LEAF *)
-	BEGIN
-		IF c = NIL THEN RETURN NIL
-		ELSE RETURN c.singleton
-		END
-	END Singleton;
-
-	PROCEDURE (c: Controller) SetSingleton* (s: Views.View), NEW, EXTENSIBLE;
-	(** extended by subclass to adjust intrinsic selections **)
-		VAR con: Models.Context; msg: SingletonMsg;
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		ASSERT(~(noSelection IN c.opts), 21);
-		IF c.singleton # s THEN
-			IF s # NIL THEN
-				con := s.context;
-				ASSERT(con # NIL, 22); ASSERT(con.ThisModel() = c.model, 23);
-				c.view.Neutralize
-			ELSIF c.singleton # NIL THEN
-				c.bVis := FALSE; msg.set := FALSE; Views.Broadcast(c.view, msg)
-			END;
-			c.singleton := s;
-			IF s # NIL THEN c.bVis := TRUE; msg.set := TRUE; Views.Broadcast(c.view, msg) END
-		END
-	END SetSingleton;
-	
-	PROCEDURE (c: Controller) SelectAll* (select: BOOLEAN), NEW, ABSTRACT;
-	(** replaced by subclass to include intrinsic selections **)
-
-	PROCEDURE (c: Controller) InSelection* (f: Views.Frame; x, y: INTEGER): BOOLEAN, NEW, ABSTRACT;
-	(** replaced by subclass to include intrinsic selections **)
-
-	PROCEDURE (c: Controller) MarkSelection* (f: Views.Frame; show: BOOLEAN), NEW, EXTENSIBLE;
-	(** replaced by subclass to include intrinsic selections **)
-	BEGIN
-		MarkSingleton(c, f, show)
-	END MarkSelection;
-
-
-	(** focus **)
-
-	PROCEDURE (c: Controller) ThisFocus* (): Views.View, NEW, EXTENSIBLE;
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		RETURN c.focus
-	END ThisFocus;
-
-	PROCEDURE (c: Controller) SetFocus* (focus: Views.View), NEW;	(* LEAF *)
-		VAR focus0: Views.View; con: Models.Context; msg: FocusMsg;
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		focus0 := c.focus;
-		IF focus # focus0 THEN
-			IF focus # NIL THEN
-				con := focus.context;
-				ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.model, 22);
-				IF focus0 = NIL THEN c.view.Neutralize END
-			END;
-			IF focus0 # NIL THEN
-				IF ~Views.IsInvalid(focus0) THEN focus0.Neutralize END;
-				c.bVis := FALSE; msg.set := FALSE; Views.Broadcast(c.view, msg)
-			END;
-			c.focus := focus;
-			IF focus # NIL THEN
-				c.MakeViewVisible(focus);
-				c.bVis := TRUE; msg.set := TRUE; Views.Broadcast(c.view, msg)
-			END
-		END
-	END SetFocus;
-
-	PROCEDURE (c: Controller) ConsiderFocusRequestBy* (view: Views.View), NEW;
-		VAR con: Models.Context;
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		ASSERT(view # NIL, 21); con := view.context;
-		ASSERT(con # NIL, 22); ASSERT(con.ThisModel() = c.model, 23);
-		IF c.focus = NIL THEN c.SetFocus(view) END
-	END ConsiderFocusRequestBy;
-
-
-	(** caret **)
-
-	PROCEDURE (c: Controller) HasCaret* (): BOOLEAN, NEW, ABSTRACT;
-	PROCEDURE (c: Controller) MarkCaret* (f: Views.Frame; show: BOOLEAN), NEW, ABSTRACT;
-
-
-	(** general marking protocol **)
-
-	PROCEDURE CheckMaskFocus (c: Controller; f: Views.Frame; VAR focus: Views.View);
-		VAR v: Views.View;
-	BEGIN
-		IF f.mark & (c.opts * modeOpts = mask) & (c.model # NIL) & ((focus = NIL) OR ~ClaimFocus(focus)) THEN
-			c.GetFirstView(any, v);
-			WHILE (v # NIL) & ~ClaimFocus(v) DO c.GetNextView(any, v) END;
-			IF v # NIL THEN
-				c.SetFocus(v);
-				focus := v
-			ELSE c.SetFocus(NIL); focus := NIL
-			END
-		END
-	END CheckMaskFocus;
-	
-	PROCEDURE (c: Controller) Mark* (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN), NEW, EXTENSIBLE;
-	BEGIN
-		MarkFocus(c, f, show); c.MarkSelection(f, show); c.MarkCaret(f, show)
-	END Mark;
-
-	PROCEDURE (c: Controller) RestoreMarks2- (f: Views.Frame; l, t, r, b: INTEGER), NEW, EMPTY;
-	PROCEDURE (c: Controller) RestoreMarks* (f: Views.Frame; l, t, r, b: INTEGER), NEW;
-	BEGIN
-		IF f.mark THEN
-			c.Mark(f, l, t, r, b, show);
-			c.RestoreMarks2(f, l, t, r, b)
-		END
-	END RestoreMarks;
-
-	PROCEDURE (c: Controller) Neutralize2-, NEW, EMPTY;
-	(** caret needs to be removed by this method **)
-
-	PROCEDURE (c: Controller) Neutralize*, NEW;
-	BEGIN
-		c.SetFocus(NIL); c.SelectAll(deselect);
-		c.Neutralize2
-	END Neutralize;
-
-
-	(** message handlers **)
-
-	PROCEDURE (c: Controller) HandleModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
-	BEGIN
-		ASSERT(c.model # NIL, 20)
-	END HandleModelMsg;
-
-	PROCEDURE (c: Controller) HandleViewMsg* (f: Views.Frame; VAR msg: Views.Message), NEW, EXTENSIBLE;
-		VAR g: Views.Frame; mark: Controllers.MarkMsg;
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		IF msg.view = c.view THEN
-			WITH msg: ViewMessage DO
-				WITH msg: FocusMsg DO
-					g := Views.ThisFrame(f, c.focus);
-					IF g # NIL THEN
-						IF msg.set THEN
-							MarkFocus(c, f, show);
-							mark.show := TRUE; mark.focus := TRUE;
-							Views.ForwardCtrlMsg(g, mark)
-						ELSE
-							mark.show := FALSE; mark.focus := TRUE;
-							Views.ForwardCtrlMsg(g, mark);
-							MarkFocus(c, f, hide)
-						END
-					END
-				| msg: SingletonMsg DO
-					MarkSingleton(c, f, msg.set)
-				| msg: FadeMsg DO
-					MarkFocus(c, f, msg.show);
-					MarkSingleton(c, f, msg.show)
-				END
-			ELSE
-			END
-		END
-	END HandleViewMsg;
-
-
-	PROCEDURE CollectControlPref (c: Controller; focus: Views.View; ch: CHAR; cyclic: BOOLEAN;
-												VAR v: Views.View; VAR getFocus, accepts: BOOLEAN);
-		VAR first, w: Views.View; p: Properties.ControlPref; back: BOOLEAN;
-	BEGIN
-		back := (ch = LTAB) OR (ch = AL) OR (ch = AU); first := c.focus;
-		IF first = NIL THEN
-			c.GetFirstView(any, first);
-			IF back THEN w := first;
-				WHILE w # NIL DO first := w; c.GetNextView(any, w) END
-			END
-		END;
-		v := first;
-		WHILE v # NIL DO
-			p.char := ch; p.focus := focus;
-			p.getFocus := (v # focus) & ((ch = TAB) OR (ch = LTAB)) & ClaimFocus(v);
-			p.accepts := (v = focus) & (ch # TAB) & (ch # LTAB);
-			Views.HandlePropMsg(v, p);
-			IF p.accepts OR (v # focus) & p.getFocus THEN
-				getFocus := p.getFocus; accepts := p.accepts;
-				RETURN
-			END;
-			IF back THEN c.GetPrevView(any, v) ELSE c.GetNextView(any, v) END;
-			IF cyclic & (v = NIL) THEN
-				c.GetFirstView(any, v);
-				IF back THEN w := v;
-					WHILE w # NIL DO v := w; c.GetNextView(any, w) END
-				END
-			END;
-			IF v = first THEN v := NIL END
-		END;
-		getFocus := FALSE; accepts := FALSE
-	END CollectControlPref;
-	
-	PROCEDURE (c: Controller) HandlePropMsg* (VAR msg: Properties.Message), NEW, EXTENSIBLE;
-		VAR v: Views.View;
-	BEGIN
-		ASSERT(c.model # NIL, 20);
-		WITH msg: Properties.PollMsg DO
-			msg.prop := ThisProp(c, indirect)
-		| msg: Properties.SetMsg DO
-			SetProp(c, msg.old, msg.prop, indirect)
-		| msg: Properties.FocusPref DO
-			IF {noSelection, noFocus, noCaret} - c.opts # {} THEN msg.setFocus := TRUE END
-		| msg: GetOpts DO
-			msg.valid := modeOpts; msg.opts := c.opts
-		| msg: SetOpts DO
-			c.SetOpts(c.opts - msg.valid + (msg.opts * msg.valid))
-		| msg: Properties.ControlPref DO
-			IF c.opts * modeOpts = mask THEN
-				v := msg.focus;
-				IF v = c.view THEN v := c.focus END;
-				CollectControlPref(c, v, msg.char, FALSE, v, msg.getFocus, msg.accepts);
-				IF msg.getFocus THEN msg.accepts := TRUE END
-			END
-		ELSE
-		END
-	END HandlePropMsg;
-
-
-	(** Directory **)
-
-	PROCEDURE (d: Directory) NewController* (opts: SET): Controller, NEW, ABSTRACT;
-
-	PROCEDURE (d: Directory) New* (): Controller, NEW, EXTENSIBLE;
-	BEGIN
-		RETURN d.NewController({})
-	END New;
-
-
-	(* ViewOp *)
-
-	PROCEDURE (op: ViewOp) Do;
-		VAR v: View; c0, c1: Controller; a0, a1: Stores.Store;
-	BEGIN
-		v := op.v; c0 := v.controller; a0 := v.alienCtrl; c1 := op.controller; a1 := op.alienCtrl;
-		IF c0 # NIL THEN c0.InitView(NIL) END;
-		v.controller := c1; v.alienCtrl := a1;
-		op.controller := c0; op.alienCtrl := a0;
-		IF c1 # NIL THEN c1.InitView(v) END;
-		Views.Update(v, Views.keepFrames)
-	END Do;
-
-
-	(* ControllerOp *)
-
-	PROCEDURE (op: ControllerOp) Do;
-		VAR c: Controller; opts: SET;
-	BEGIN
-		c := op.c;
-		opts := c.opts; c.opts := op.opts; op.opts := opts;
-		Views.Update(c.view, Views.keepFrames)
-	END Do;
-
-
-	(* Controller implementation support *)
-
-	PROCEDURE BorderVisible (c: Controller; f: Views.Frame): BOOLEAN;
-	BEGIN
-		IF 31 IN c.opts THEN RETURN TRUE END;
-		IF f IS Views.RootFrame THEN RETURN FALSE END;
-		IF Services.Is(c.focus, "OleClient.View") THEN RETURN FALSE END;
-		RETURN TRUE
-	END BorderVisible;
-
-	PROCEDURE MarkFocus (c: Controller; f: Views.Frame; show: BOOLEAN);
-		VAR focus: Views.View; f1: Views.Frame; l, t, r, b: INTEGER;
-	BEGIN
-		focus := c.focus;
-		IF f.front & (focus # NIL) & (~show OR c.bVis) & BorderVisible(c, f) & ~(noSelection IN c.opts) THEN
-			f1 := Views.ThisFrame(f, focus);
-			IF f1 # NIL THEN
-				c.bVis := show;
-				c.view.GetRect(f, focus, l, t, r, b);
-				IF (l # MAX(INTEGER)) & (t # MAX(INTEGER)) THEN
-					Mechanisms.MarkFocusBorder(f, focus, l, t, r, b, show)
-				END
-			END
-		END
-	END MarkFocus;
-
-	PROCEDURE MarkSingleton* (c: Controller; f: Views.Frame; show: BOOLEAN);
-		VAR l, t, r, b: INTEGER;
-	BEGIN
-		IF (*(f.front OR f.target) &*) (~show OR c.bVis) & (c.singleton # NIL) THEN
-			c.bVis := show;
-			c.view.GetRect(f, c.singleton, l, t, r, b);
-			IF (l # MAX(INTEGER)) & (t # MAX(INTEGER)) THEN
-				Mechanisms.MarkSingletonBorder(f, c.singleton, l, t, r, b, show)
-			END
-		END
-	END MarkSingleton;
-
-	PROCEDURE FadeMarks* (c: Controller; show: BOOLEAN);
-		VAR msg: FadeMsg; v: Views.View; fc: Controller;
-	BEGIN
-		IF (c.focus # NIL) OR (c.singleton # NIL) THEN
-			IF c.bVis # show THEN
-				IF ~show THEN
-					v := c.focus;
-					WHILE (v # NIL) & (v IS View) DO
-						fc := v(View).ThisController();
-						fc.bVis := FALSE; v := fc.focus
-					END
-				END;
-				c.bVis := show; msg.show := show; Views.Broadcast(c.view, msg)
-			END
-		END
-	END FadeMarks;
-
-
-	(* handle controller messages in editor mode *)
-
-	PROCEDURE ClaimFocus (v: Views.View): BOOLEAN;
-		VAR p: Properties.FocusPref;
-	BEGIN
-		p.atLocation := FALSE;
-		p.hotFocus := FALSE; p.setFocus := FALSE;
-		Views.HandlePropMsg(v, p);
-		RETURN p.setFocus
-	END ClaimFocus;
-	
-	PROCEDURE ClaimFocusAt (v: Views.View; f, g: Views.Frame; x, y: INTEGER; mask: BOOLEAN): BOOLEAN;
-		VAR p: Properties.FocusPref;
-	BEGIN
-		p.atLocation := TRUE; p.x := x + f.gx - g.gx; p.y := y + f.gy - g.gy;
-		p.hotFocus := FALSE; p.setFocus := FALSE;
-		Views.HandlePropMsg(v, p);
-		RETURN p.setFocus & (mask OR ~p.hotFocus)
-	END ClaimFocusAt;
-	
-	PROCEDURE NeedFocusAt (v: Views.View; f, g: Views.Frame; x, y: INTEGER): BOOLEAN;
-		VAR p: Properties.FocusPref;
-	BEGIN
-		p.atLocation := TRUE; p.x := x + f.gx - g.gx; p.y := y + f.gy - g.gy;
-		p.hotFocus := FALSE; p.setFocus := FALSE;
-		Views.HandlePropMsg(v, p);
-		RETURN p.hotFocus OR p.setFocus
-	END NeedFocusAt;
-
-
-	PROCEDURE TrackToResize (c: Controller; f: Views.Frame; v: Views.View; x, y: INTEGER; buttons: SET);
-		VAR minW, maxW, minH, maxH,  l, t, r, b,  w0, h0,  w, h: INTEGER; op: INTEGER; sg, fc: Views.View;
-	BEGIN
-		c.model.GetEmbeddingLimits(minW, maxW, minH, maxH);
-		c.view.GetRect(f, v, l, t, r, b);
-		w0 := r - l; h0 := b - t; w := w0; h := h0;
-		Mechanisms.TrackToResize(f, v, minW, maxW, minH, maxH, l, t, r, b, op, x, y, buttons);
-		IF op = Mechanisms.resize THEN
-			sg := c.singleton; fc := c.focus;
-			c.Resize(v, l, t, r, b);
-			IF c.singleton # sg THEN c.SetSingleton(sg) END;
-			IF c.focus # fc THEN c.focus := fc; c.bVis := FALSE END	(* delayed c.SetFocus(fc) *)
-		END
-	END TrackToResize;
-
-	PROCEDURE TrackToDrop (c: Controller; f: Views.Frame; VAR x, y: INTEGER; buttons: SET;
-									VAR pass: BOOLEAN);
-		VAR dest: Views.Frame; m: Models.Model; v: Views.View;
-			x0, y0, x1, y1, w, h, rx, ry, destX, destY: INTEGER; op: INTEGER; isDown, isSingle: BOOLEAN; mo: SET;
-	BEGIN	(* drag and drop c's selection: mouse is in selection *)
-		x0 := x; y0 := y;
-		REPEAT
-			f.Input(x1, y1, mo, isDown)
-		UNTIL ~isDown OR (ABS(x1 - x) > 3 * Ports.point) OR (ABS(y1 - y) > 3 * Ports.point);
-		pass := ~isDown;
-		IF ~pass THEN
-			v := c.Singleton();
-			IF v = NIL THEN v := c.view; isSingle := FALSE
-			ELSE isSingle := TRUE
-			END;
-			c.GetSelectionBounds(f, rx, ry, w, h);
-			rx := x0 - rx; ry := y0 - ry;
-			IF rx < 0 THEN rx := 0 ELSIF rx > w THEN rx := w END;
-			IF ry < 0 THEN ry := 0 ELSIF ry > h THEN ry := h END;
-			IF noCaret IN c.opts THEN op := Mechanisms.copy ELSE op := 0 END;
-			Mechanisms.TrackToDrop(f, v, isSingle, w, h, rx, ry, dest, destX, destY, op, x, y, buttons);
-			IF (op IN {Mechanisms.copy, Mechanisms.move}) THEN	(* copy or move selection *)
-				IF dest # NIL THEN
-					m := dest.view.ThisModel();
-					IF (dest.view = c.view) OR (m # NIL) & (m = c.view.ThisModel()) THEN	(* local drop *)
-						IF op = Mechanisms.copy THEN	(* local copy *)
-							c.CopyLocalSelection(f, dest, x0, y0, destX, destY)
-						ELSIF op = Mechanisms.move THEN	(* local move *)
-							c.MoveLocalSelection(f, dest, x0, y0, destX, destY)
-						END
-					ELSE	(* non-local drop *)
-						CopyView(c, v, w, h);	(* create copy of selection *)
-						IF (op = Mechanisms.copy) OR (noCaret IN c.opts) THEN	(* drop copy *)
-							Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry)
-						ELSIF op = Mechanisms.move THEN	(* drop copy and delete original *)
-							Controllers.Drop(x, y, f, x0, y0, v, isSingle, w, h, rx, ry);
-							c.DeleteSelection;
-						END
-					END
-				ELSIF (op = Mechanisms.move) & ~(noCaret IN c.opts) THEN
-					c.DeleteSelection
-				END
-			END
-		END
-	END TrackToDrop;
-
-	PROCEDURE TrackToPick (c: Controller; f: Views.Frame; x, y: INTEGER; buttons: SET;
-									VAR pass: BOOLEAN);
-		VAR p: Properties.Property; dest: Views.Frame; x0, y0, x1, y1, destX, destY: INTEGER;
-			op: INTEGER; isDown: BOOLEAN; m: SET;
-	BEGIN
-		x0 := x; y0 := y;
-		REPEAT
-			f.Input(x1, y1, m, isDown)
-		UNTIL ~isDown OR (ABS(x1 - x) > 3 * Ports.point) OR (ABS(y1 - y) > 3 * Ports.point);
-		pass := ~isDown;
-		IF ~pass THEN
-			Mechanisms.TrackToPick(f, dest, destX, destY, op, x, y, buttons);
-			IF op IN {Mechanisms.pick, Mechanisms.pickForeign} THEN
-				Properties.Pick(x, y, f, x0, y0, p);
-				IF p # NIL THEN SetProp(c, NIL, p, direct) END
-			END
-		END
-	END TrackToPick;
-
-	PROCEDURE MarkViews (f: Views.Frame);
-		VAR x, y: INTEGER; isDown: BOOLEAN; root: Views.RootFrame; m: SET;
-	BEGIN
-		root := Views.RootOf(f);
-		Views.MarkBorders(root);
-		REPEAT f.Input(x, y, m, isDown) UNTIL ~isDown;
-		Views.MarkBorders(root)
-	END MarkViews;
-
-	PROCEDURE Track (c: Controller; f: Views.Frame; VAR msg: Controllers.TrackMsg; VAR focus: Views.View);
-		VAR res, l, t, r, b: INTEGER; cursor: INTEGER; sel: Views.View; obj: Views.Frame;
-			inSel, pass, extend, add, double, popup: BOOLEAN;
-	BEGIN
-		cursor := Mechanisms.outside; sel := c.Singleton();
-		IF focus # NIL THEN
-			c.view.GetRect(f, focus, l, t, r, b);
-			IF (BorderVisible(c, f) OR (f IS Views.RootFrame)) & ~(noSelection IN c.opts) THEN
-				cursor := Mechanisms.FocusBorderCursor(f, focus, l, t, r, b, msg.x, msg.y)
-			ELSIF (msg.x >= l) & (msg.x <= r) & (msg.y >= t) & (msg.y <= b) THEN
-				cursor := Mechanisms.inside
-			END
-		ELSIF sel # NIL THEN
-			c.view.GetRect(f, sel, l, t, r, b);
-			cursor := Mechanisms.SelBorderCursor(f, sel, l, t, r, b, msg.x, msg.y)
-		END;
-		IF cursor >= 0 THEN
-			IF focus # NIL THEN
-				(* resize focus *)
-				TrackToResize(c, f, focus, msg.x, msg.y, msg.modifiers);
-				focus := NIL
-			ELSE
-				(* resize singleton *)
-				TrackToResize(c, f, sel, msg.x, msg.y, msg.modifiers)
-			END
-		ELSIF (focus # NIL) & (cursor = Mechanisms.inside) THEN
-			(* forward to focus *)
-		ELSE
-			IF (focus # NIL) & (c.opts * modeOpts # mask) THEN c.SetFocus(NIL) END;
-			focus := NIL;
-			inSel := c.InSelection(f, msg.x, msg.y);
-			extend := Controllers.extend IN msg.modifiers;
-			add := Controllers.modify IN msg.modifiers;
-			double := Controllers.doubleClick IN msg.modifiers;
-			popup := right IN msg.modifiers;
-			obj := Views.FrameAt(f, msg.x, msg.y);
-			IF ~inSel & (~extend OR (noSelection IN c.opts)) THEN 
-				IF obj # NIL THEN
-					IF ~(noFocus IN c.opts) & NeedFocusAt(obj.view, f, obj, msg.x, msg.y)
-							& (~(alt IN msg.modifiers) OR (noSelection IN c.opts)) THEN
-						(* set hot focus *)
-						focus := obj.view;
-						IF ClaimFocusAt(focus, f, obj, msg.x, msg.y, c.opts * modeOpts = mask) THEN
-							(* set permanent focus *)
-							c.SelectAll(deselect);
-							c.SetFocus(focus)
-						END
-					END;
-					IF (focus = NIL) & ~add & ~(noSelection IN c.opts) THEN
-						(* select object *)
-						c.SelectAll(deselect);
-						c.SetSingleton(obj.view); inSel := TRUE
-					END
-				ELSIF ~add THEN c.SelectAll(deselect)
-				END
-			END;
-			IF focus = NIL THEN
-				IF inSel & double & (popup OR (alt IN msg.modifiers)) THEN (* properties *)
-					Dialog.Call("StdCmds.ShowProp", "", res)
-				ELSIF inSel & double & (obj # NIL) THEN (* primary verb *)
-					Dialog.Call("HostMenus.PrimaryVerb", "", res)
-				ELSIF ~inSel & (alt IN msg.modifiers) & extend THEN
-					MarkViews(f)
-				ELSE
-					IF inSel & ~extend THEN (* drag *)
-						IF (alt IN msg.modifiers) OR (middle IN msg.modifiers) THEN
-							IF ~(noCaret IN c.opts) THEN
-								TrackToPick(c, f, msg.x, msg.y, msg.modifiers, pass)
-							END
-						ELSE
-							TrackToDrop(c, f, msg.x, msg.y, msg.modifiers, pass)
-						END;
-						IF ~pass THEN RETURN END
-					END;
-					IF ~(noSelection IN c.opts) & (~inSel OR extend OR add OR (obj = NIL) & ~popup) THEN (* select *)
-						c.TrackMarks(f, msg.x, msg.y, double, extend, add)
-					END;
-					IF popup THEN Dialog.Call("HostMenus.PopupMenu", "", res) END
-				END
-			END
-		END
-	END Track;
-
-	PROCEDURE CopyView (source: Controller; VAR view: Views.View; VAR w, h: INTEGER);
-		VAR s: Views.View; m: Model; v: View; p: Properties.BoundsPref;
-	BEGIN
-		s := source.Singleton();
-		IF s # NIL THEN	(* create a copy of singular selection *)
-			view := Views.CopyOf(s, Views.deep); s.context.GetSize(w, h)
-		ELSE	(* create a copy of view with a copy of whole selection as contents *)
-			m := source.SelectionCopy();
-			v := Views.CopyWithNewModel(source.view, m)(View);
-			p.w := Views.undefined; p.h := Views.undefined; Views.HandlePropMsg(v, p);
-			view := v; w := p.w; h := p.h
-		END
-	END CopyView;
-
-	PROCEDURE Paste (c: Controller; f: Views.Frame; v: Views.View; w, h: INTEGER);
-		VAR m: Models.Model;
-	BEGIN
-		m := v.ThisModel();
-		IF (m # NIL) & c.NativeModel(m) THEN
-			(* paste whole contents of source view *)
-			c.NativePaste(m, f)
-		ELSE
-			(* paste whole view *)
-			c.PasteView(f, v (* Views.CopyOf(v, Views.deep) *), w, h)
-		END
-	END Paste;
-
-	PROCEDURE GetValidOps (c: Controller; VAR valid: SET);
-	BEGIN
-		valid := {}; c.GetValidOps(valid);
-		IF noCaret IN c.opts THEN
-			valid := valid
-				- {Controllers.pasteChar, Controllers.pasteChar,
-					Controllers.paste, Controllers.cut}
-		END
-	END GetValidOps;
-
-
-	PROCEDURE Transfer (c: Controller; f: Views.Frame;
-								VAR msg: Controllers.TransferMessage; VAR focus: Views.View);
-		VAR g: Views.Frame; inSelection: BOOLEAN; dMsg: DropPref;
-	BEGIN
-		focus := NIL;
-		g := Views.FrameAt(f, msg.x, msg.y);
-		WITH msg: Controllers.PollDropMsg DO
-			inSelection := c.InSelection(f, msg.x, msg.y);
-			dMsg.mode := c.opts; dMsg.okToDrop := FALSE;
-			IF g # NIL THEN Views.HandlePropMsg(g.view, dMsg) END;
-			IF (g # NIL) & ~inSelection & (dMsg.okToDrop OR ~(noFocus IN c.opts))THEN
-				focus := g.view
-			ELSIF ~(noCaret IN c.opts) & c.CanDrop(f, msg.x, msg.y) THEN
-				msg.dest := f;
-				IF msg.mark THEN
-					c.MarkDropTarget(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.w, msg.h, msg.rx, msg.ry,
-											msg.type, msg.isSingle, msg.show)
-				END
-			END
-		| msg: Controllers.DropMsg DO
-			inSelection := c.InSelection(f, msg.x, msg.y);
-			dMsg.mode := c.opts; dMsg.okToDrop := FALSE;
-			IF g # NIL THEN Views.HandlePropMsg(g.view, dMsg) END;
-			IF (g # NIL) & ~inSelection & (dMsg.okToDrop OR ~(noFocus IN c.opts))THEN
-				focus := g.view
-			ELSIF ~(noCaret IN c.opts) & c.CanDrop(f, msg.x, msg.y) THEN
-				c.Drop(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.w, msg.h,
-							msg.rx, msg.ry, msg.view, msg.isSingle)
-			END
-		| msg: Properties.PollPickMsg DO
-			IF g # NIL THEN
-				focus := g.view
-			ELSE
-				msg.dest := f;
-				IF msg.mark THEN
-					c.MarkPickTarget(msg.source, f, msg.sourceX, msg.sourceY, msg.x, msg.y, msg.show)
-				END
-			END
-		| msg: Properties.PickMsg DO
-			IF g # NIL THEN
-				focus := g.view
-			ELSE
-				c.PickNativeProp(f, msg.x, msg.y, msg.prop)
-			END
-		ELSE
-			IF g # NIL THEN focus := g.view END
-		END
-	END Transfer;
-
-	PROCEDURE FocusHasSel (): BOOLEAN;
-		VAR msg: Controllers.PollOpsMsg;
-	BEGIN
-		Controllers.PollOps(msg);
-		RETURN msg.selectable & (Controllers.copy IN msg.valid)
-	END FocusHasSel;
-	
-	PROCEDURE FocusEditor (): Controller;
-		VAR msg: PollFocusMsg;
-	BEGIN
-		msg.focus := NIL; msg.ctrl := NIL; msg.all := FALSE;
-		Controllers.Forward(msg);
-		RETURN msg.ctrl
-	END FocusEditor;
-
-	PROCEDURE Edit (c: Controller; f: Views.Frame;
-								VAR msg: Controllers.EditMsg; VAR focus: Views.View);
-		VAR g: Views.Frame; v: Views.View; res: INTEGER;
-			valid: SET; select, units, getFocus, accepts: BOOLEAN;
-			sel: Controllers.SelectMsg;
-	BEGIN
-		IF (c.opts * modeOpts # mask) & (focus = NIL) THEN
-			IF (msg.op = Controllers.pasteChar) & (msg.char = ESC) THEN
-				c.SelectAll(FALSE)
-			ELSIF (c.Singleton() # NIL) & (msg.op = Controllers.pasteChar) &
-					(msg.char = ENTER) THEN
-				Dialog.Call("HostMenus.PrimaryVerb", "", res)
-			ELSE
-				GetValidOps(c, valid);
-				IF msg.op IN valid THEN
-					CASE msg.op OF
-					| Controllers.pasteChar:
-						IF msg.char >= " " THEN
-							c.PasteChar(msg.char)
-						ELSIF (AL <= msg.char) & (msg.char <= AD) OR
-							(PL <= msg.char) & (msg.char <= DD) THEN
-							select := Controllers.extend IN msg.modifiers;
-							units := Controllers.modify IN msg.modifiers;
-							c.ArrowChar(f, msg.char, units, select)
-						ELSE c.ControlChar(f, msg.char)
-						END
-					| Controllers.cut, Controllers.copy:
-						CopyView(c, msg.view, msg.w, msg.h);
-						msg.isSingle := c.Singleton() # NIL;
-						IF msg.op = Controllers.cut THEN c.DeleteSelection END
-					| Controllers.paste:
-						IF msg.isSingle THEN
-							c.PasteView(f, msg.view (* Views.CopyOf(msg.view, Views.deep) *), msg.w, msg.h)
-						ELSE
-							Paste(c, f, msg.view, msg.w, msg.h)
-						END
-					ELSE
-					END
-				END
-			END
-		ELSIF (c.opts * modeOpts # mask)
-				& (msg.op = Controllers.pasteChar) & (msg.char = ESC)
-				& (~(f IS Views.RootFrame) OR (31 IN c.opts))
-				& (c = FocusEditor()) 
-				& ((Controllers.extend IN msg.modifiers) OR ~FocusHasSel()) THEN
-			IF 31 IN c.opts THEN INCL(msg.modifiers, 31)
-			ELSE c.SetSingleton(focus)
-			END;
-			focus := NIL
-		ELSIF (c.opts * modeOpts # mask) & (c = Focus()) THEN
-			(* do some generic processing for non-container views *)
-			IF (msg.op = Controllers.pasteChar) & (msg.char = ESC) THEN
-				g := Views.ThisFrame(f, focus);
-				IF g # NIL THEN sel.set := FALSE; Views.ForwardCtrlMsg(g, sel) END
-			END
-		ELSIF (c.opts * modeOpts = mask) & (msg.op = Controllers.pasteChar) THEN
-			IF alt IN msg.modifiers THEN
-				CollectControlPref (c, NIL, msg.char, TRUE, v, getFocus, accepts)
-			ELSE
-				CollectControlPref (c, focus, msg.char, TRUE, v, getFocus, accepts)
-			END;
-			 IF v = NIL THEN
-				CheckMaskFocus(c, f, focus);
-				CollectControlPref(c, focus, msg.char, TRUE, v, getFocus, accepts)
-			END;
-			IF v # NIL THEN
-				IF getFocus & (v # focus) THEN
-					c.SetFocus(v)
-				END;
-				IF accepts THEN
-					g := Views.ThisFrame(f, v);
-					IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
-				END;
-				focus := NIL
-			END
-		END
-	END Edit;
-
-	PROCEDURE PollCursor (c: Controller; f: Views.Frame; VAR msg: Controllers.PollCursorMsg; VAR focus: Views.View);
-		VAR l, t, r, b: INTEGER; cursor: INTEGER; sel: Views.View; obj: Views.Frame; inSel: BOOLEAN;
-	BEGIN
-		cursor := Mechanisms.outside; sel := c.Singleton();
-		IF focus # NIL THEN
-			c.view.GetRect(f, focus, l, t, r, b);
-			IF (BorderVisible(c, f) OR (f IS Views.RootFrame)) & ~(noSelection IN c.opts) THEN
-				cursor := Mechanisms.FocusBorderCursor(f, focus, l, t, r, b, msg.x, msg.y)
-			ELSIF (msg.x >= l) & (msg.x <= r) & (msg.y >= t) & (msg.y <= b) THEN
-				cursor := Mechanisms.inside
-			END
-		ELSIF sel # NIL THEN
-			c.view.GetRect(f, sel, l, t, r, b);
-			cursor := Mechanisms.SelBorderCursor(f, sel, l, t, r, b, msg.x, msg.y)
-		END;
-		IF cursor >= 0 THEN
-			msg.cursor := cursor; focus := NIL
-		ELSIF (focus # NIL) & (cursor = Mechanisms.inside) THEN
-			msg.cursor := Ports.arrowCursor
-		ELSE
-			IF noCaret IN c.opts THEN msg.cursor := Ports.arrowCursor 
-			ELSE msg.cursor := c.NativeCursorAt(f, msg.x, msg.y)	(* if nothing else, use native cursor *)
-			END;
-			focus := NIL; inSel := FALSE;
-			IF ~(noSelection IN c.opts) THEN inSel := c.InSelection(f, msg.x, msg.y) END;
-			IF ~inSel THEN
-				obj := Views.FrameAt(f, msg.x, msg.y);
-				IF obj # NIL THEN
-					IF ~(noFocus IN c.opts) & NeedFocusAt(obj.view, f, obj, msg.x, msg.y) THEN
-						focus := obj.view;
-						msg.cursor := Ports.arrowCursor
-					ELSIF ~(noSelection IN c.opts) THEN
-						inSel := TRUE
-					END
-				END
-			END;
-			IF focus = NIL THEN
-				IF inSel THEN
-					msg.cursor := Ports.arrowCursor
-				END
-			END
-		END
-	END PollCursor;
-
-	PROCEDURE PollOps (c: Controller; f: Views.Frame;
-								VAR msg: Controllers.PollOpsMsg; VAR focus: Views.View);
-	BEGIN
-		IF focus = NIL THEN
-			msg.type := "";
-			IF ~(noSelection IN c.opts) THEN c.GetContextType(msg.type) END;
-			msg.selectable := ~(noSelection IN c.opts) & c.Selectable();
-			GetValidOps(c, msg.valid);
-			msg.singleton := c.Singleton()
-		END
-	END PollOps;
-
-	PROCEDURE ReplaceView (c: Controller; old, new: Views.View);
-	BEGIN
-		ASSERT(old.context # NIL, 20);
-		ASSERT((new.context = NIL) OR (new.context = old.context), 22);
-		IF old.context.ThisModel() = c.model THEN
-			c.model.ReplaceView(old, new)
-		END;
-		IF c.singleton = old THEN c.singleton := new END;
-		IF c.focus = old THEN c.focus := new END
-	END ReplaceView;
-
-	PROCEDURE ViewProp (v: Views.View): Properties.Property;
-		VAR poll: Properties.PollMsg;
-	BEGIN
-		poll.prop := NIL; Views.HandlePropMsg(v, poll); RETURN poll.prop
-	END ViewProp;
-
-	PROCEDURE SetViewProp (v: Views.View; old, p: Properties.Property);
-		VAR set: Properties.SetMsg;
-	BEGIN
-		set.old := old; set.prop := p; Views.HandlePropMsg(v, set)
-	END SetViewProp;
-
-	PROCEDURE SizeProp (v: Views.View): Properties.Property;
-		VAR sp: Properties.SizeProp;
-	BEGIN
-		NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
-		v.context.GetSize(sp.width, sp.height);
-		RETURN sp
-	END SizeProp;
-
-	PROCEDURE SetSizeProp (v: Views.View; p: Properties.SizeProp);
-		VAR w, h: INTEGER;
-	BEGIN
-		IF p.valid # {Properties.width, Properties.height} THEN
-			v.context.GetSize(w, h)
-		END;
-		IF Properties.width IN p.valid THEN w := p.width END;
-		IF Properties.height IN p.valid THEN h := p.height END;
-		v.context.SetSize(w, h)
-	END SetSizeProp;
-
-	PROCEDURE ThisProp (c: Controller; direct: BOOLEAN): Properties.Property;
-		CONST scanCutoff = MAX(INTEGER) (* 50 *);	(* bound number of polled embedded views *)
-		VAR v: Views.View; np, vp, p: Properties.Property; k: INTEGER; trunc, equal: BOOLEAN;
-	BEGIN
-		trunc := FALSE; k := 1;
-		np := NIL; c.PollNativeProp(direct, np, trunc);
-		v := NIL; c.GetFirstView(direct, v);
-		IF v # NIL THEN
-			Properties.Insert(np, SizeProp(v));
-			vp := ViewProp(v);
-			k := scanCutoff; c.GetNextView(direct, v);
-			WHILE (v # NIL) & (k > 0) DO
-				DEC(k);
-				Properties.Insert(np, SizeProp(v));
-				Properties.Intersect(vp, ViewProp(v), equal);
-				c.GetNextView(direct, v)
-			END;
-			IF c.singleton # NIL THEN Properties.Merge(np, vp); vp := np
-			ELSE Properties.Merge(vp, np)
-			END
-		ELSE vp := np
-		END;
-		IF trunc OR (k = 0) THEN
-			p := vp; WHILE p # NIL DO p.valid := {}; p := p.next END
-		END;
-		IF noCaret IN c.opts THEN
-			p := vp; WHILE p # NIL DO p.readOnly := p.valid; p := p.next END
-		END;
-		RETURN vp
-	END ThisProp;
-
-	PROCEDURE SetProp (c: Controller; old, p: Properties.Property; direct: BOOLEAN);
-		TYPE
-			ViewList = POINTER TO RECORD next: ViewList; view: Views.View END;
-		VAR v: Views.View; q, sp: Properties.Property; equal: BOOLEAN; s: Stores.Operation;
-			list, last: ViewList;
-	BEGIN
-		IF noCaret IN c.opts THEN RETURN END;
-		Views.BeginScript(c.view, "#System:SetProp", s);
-		q := p; WHILE (q # NIL) & ~(q IS Properties.SizeProp) DO q := q.next END;
-		list := NIL; v := NIL; c.GetFirstView(direct, v);
-		WHILE v # NIL DO
-			IF list = NIL THEN NEW(list); last := list
-			ELSE NEW(last.next); last := last.next
-			END;
-			last.view := v;
-			c.GetNextView(direct, v)
-		END;
-		c.SetNativeProp(direct, old, p);
-		WHILE list # NIL DO
-			v := list.view; list := list.next;
-			SetViewProp(v, old, p);
-			IF direct & (q # NIL) THEN
-				(* q IS Properties.SizeProp *)
-				IF old # NIL THEN
-					sp := SizeProp(v);
-					Properties.Intersect(sp, old, equal);
-					Properties.Intersect(sp, old, equal)
-				END;
-				IF (old = NIL) OR equal THEN
-					SetSizeProp(v, q(Properties.SizeProp))
-				END
-			END
-		END;
-		Views.EndScript(c.view, s)
-	END SetProp;
-
-	PROCEDURE (c: Controller) HandleCtrlMsg* (f: Views.Frame;
-														 VAR msg: Controllers.Message; VAR focus: Views.View), NEW, EXTENSIBLE;
-	BEGIN
-		focus := c.focus;
-		WITH msg: Controllers.PollCursorMsg DO
-			PollCursor(c, f, msg, focus)
-		| msg: Controllers.PollOpsMsg DO
-			PollOps(c, f, msg, focus)
-		| msg: PollFocusMsg DO
-			IF msg.all OR (c.opts * modeOpts # mask) & (c.focus # NIL) THEN msg.ctrl := c END
-		| msg: Controllers.TrackMsg DO
-			Track(c, f, msg, focus)
-		| msg: Controllers.EditMsg DO
-			Edit(c, f, msg, focus)
-		| msg: Controllers.TransferMessage DO
-			Transfer(c, f, msg, focus)
-		| msg: Controllers.SelectMsg DO
-			IF focus = NIL THEN c.SelectAll(msg.set) END
-		| msg: Controllers.TickMsg DO
-			FadeMarks(c, show);
-			CheckMaskFocus(c, f, focus)
-		| msg: Controllers.MarkMsg DO
-			c.bVis := msg.show;
-			c.Mark(f, f.l, f.t, f.r, f.b, msg.show)
-		| msg: Controllers.ReplaceViewMsg DO
-			ReplaceView(c, msg.old, msg.new)
-		| msg: Properties.CollectMsg DO
-			IF focus = NIL THEN
-				msg.poll.prop := ThisProp(c, direct)
-			END
-		| msg: Properties.EmitMsg DO
-			IF focus = NIL THEN
-				SetProp(c, msg.set.old, msg.set.prop, direct)
-			END
-		ELSE
-		END
-	END HandleCtrlMsg;
-
-
-	(** miscellaneous **)
-
-	PROCEDURE Focus* (): Controller;
-		VAR msg: PollFocusMsg;
-	BEGIN
-		msg.focus := NIL; msg.ctrl := NIL; msg.all := TRUE;
-		Controllers.Forward(msg);
-		RETURN msg.ctrl
-	END Focus;
-
-	PROCEDURE FocusSingleton* (): Views.View;
-		VAR c: Controller; v: Views.View;
-	BEGIN
-		c := Focus();
-		IF c # NIL THEN v := c.Singleton() ELSE v := NIL END;
-		RETURN v
-	END FocusSingleton;
-	
-	PROCEDURE CloneOf* (m: Model): Model;
-		VAR h: Model;
-	BEGIN
-		ASSERT(m # NIL, 20);
-		Kernel.NewObj(h, Kernel.TypeOf(m));
-		h.InitFrom(m);
-		RETURN h
-	END CloneOf;
-
-END Containers.

new/System/Mod/Controllers.txt

@@ -1,426 +0,0 @@
-MODULE Controllers;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controllers.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT Kernel, Services, Ports, Stores, Models, Views;
-
-	CONST
-		(** Forward target **)
-		targetPath* = TRUE; frontPath* = FALSE;
-
-		(** ScrollMsg.op **)
-		decLine* = 0; incLine* = 1; decPage* = 2; incPage* = 3; gotoPos* = 4;
-
-		(** PageMsg.op **)
-		nextPageX* = 0; nextPageY* = 1; gotoPageX* = 2; gotoPageY* = 3;
-
-		(** PollOpsMsg.valid, EditMsg.op **)
-		cut* = 0; copy* = 1;
-		pasteChar* = 2; (* pasteLChar* = 3; *) paste* = 4; (* pasteView* = 5; *)
-
-		(** TrackMsg.modifiers, EditMsg.modifiers **)
-		doubleClick* = 0;	(** clicking history **)
-		extend* = 1; modify* = 2;	(** modifier keys **)
-		(* extend = Sub.extend; modify = Sub.modify *)
-
-		(** PollDropMsg.mark, PollDrop mark **)
-		noMark* = FALSE; mark* = TRUE;
-		(** PollDropMsg.show, PollDrop show **)
-		hide* = FALSE; show* = TRUE;
-
-		minVersion = 0; maxVersion = 0;
-
-
-	TYPE
-
-		(** messages **)
-
-		Message* = Views.CtrlMessage;
-
-		PollFocusMsg* = EXTENSIBLE RECORD (Message)
-			focus*: Views.Frame	(** OUT, preset to NIL **)
-		END;
-
-		PollSectionMsg* = RECORD (Message)
-			focus*, vertical*: BOOLEAN;	(** IN **)
-			wholeSize*: INTEGER;	(** OUT, preset to 1 **)
-			partSize*: INTEGER;	(** OUT, preset to 1 **)
-			partPos*: INTEGER;	(** OUT, preset to 0 **)
-			valid*, done*: BOOLEAN	(** OUT, preset to (FALSE, FALSE) **)
-		END;
-
-		PollOpsMsg* = RECORD (Message)
-			type*: Stores.TypeName;	(** OUT, preset to "" **)
-			pasteType*: Stores.TypeName;	(** OUT, preset to "" **)
-			singleton*: Views.View;	(** OUT, preset to NIL **)
-			selectable*: BOOLEAN;	(** OUT, preset to FALSE **)
-			valid*: SET	(** OUT, preset to {} **)
-		END;
-
-		ScrollMsg* = RECORD (Message)
-			focus*, vertical*: BOOLEAN;	(** IN **)
-			op*: INTEGER;	(** IN **)
-			pos*: INTEGER;	(** IN **)
-			done*: BOOLEAN	(** OUT, preset to FALSE **)
-		END;
-
-		PageMsg* = RECORD (Message)
-			op*: INTEGER;	(** IN **)
-			pageX*, pageY*: INTEGER;	(** IN **)
-			done*, eox*, eoy*: BOOLEAN	(** OUT, preset to (FALSE, FALSE, FALSE) **)
-		END;
-
-		TickMsg* = RECORD (Message)
-			tick*: INTEGER	(** IN **)
-		END;
-
-		MarkMsg* = RECORD (Message)
-			show*: BOOLEAN;	(** IN **)
-			focus*: BOOLEAN	(** IN **)
-		END;
-
-		SelectMsg* = RECORD (Message)
-			set*: BOOLEAN	(** IN **)
-		END;
-
-
-		RequestMessage* = ABSTRACT RECORD (Message)
-			requestFocus*: BOOLEAN	(** OUT, preset (by framework) to FALSE **)
-		END;
-
-		EditMsg* = RECORD (RequestMessage)
-			op*: INTEGER;	(** IN **)
-			modifiers*: SET;	(** IN, valid if op IN {pasteChar, pasteLchar} **)
-			char*: CHAR;	(** IN, valid if op = pasteChar **)
-			view*: Views.View; w*, h*: INTEGER;	(** IN, valid if op  = paste **)
-														(** OUT, valid if op IN {cut, copy} **)
-			isSingle*: BOOLEAN;	(** dito **)
-			clipboard*: BOOLEAN	(** IN, valid if op IN {cut, copy, paste} **)
-		END;
-
-		ReplaceViewMsg* = RECORD (RequestMessage)
-			old*, new*: Views.View	(** IN **)
-		END;
-
-
-		CursorMessage* = ABSTRACT RECORD (RequestMessage)
-			x*, y*: INTEGER	(** IN, needs translation when passed on **)
-		END;
-
-		PollCursorMsg* = RECORD (CursorMessage)
-			cursor*: INTEGER;	(** OUT, preset to Ports.arrowCursor **)
-			modifiers*: SET	(** IN **)
-		END;
-
-		TrackMsg* = RECORD (CursorMessage)
-			modifiers*: SET	(** IN **)
-		END;
-
-		WheelMsg* = RECORD (CursorMessage)
-			done*: BOOLEAN; 		(** must be set if the message is handled **)
-			op*, nofLines*: INTEGER;
-		END;
-
-
-		TransferMessage* = ABSTRACT RECORD (CursorMessage)
-			source*: Views.Frame;	(** IN, home frame of transfer originator, may be NIL if unknown **)
-			sourceX*, sourceY*: INTEGER	(** IN, reference point in source frame, defined if source # NIL **)
-		END;
-
-		PollDropMsg* = RECORD (TransferMessage)
-			mark*: BOOLEAN;	(** IN, request to mark drop target **)
-			show*: BOOLEAN;	(** IN, if mark then show/hide target mark **)
-			type*: Stores.TypeName;	(** IN, type of view to drop **)
-			isSingle*: BOOLEAN;	(** IN, view to drop is singleton **)
-			w*, h*: INTEGER;	(** IN, size of view to drop, may be 0, 0 **)
-			rx*, ry*: INTEGER;	(** IN, reference point in view **)
-			dest*: Views.Frame	(** OUT, preset to NIL, set if DropMsg is acceptable **)
-		END;
-
-		DropMsg* = RECORD (TransferMessage)
-			view*: Views.View;	(** IN, drop this *)
-			isSingle*: BOOLEAN;	(** IN, view to drop is singleton **)
-			w*, h*: INTEGER;	(** IN, proposed size *)
-			rx*, ry*: INTEGER	(** IN, reference point in view **)
-		END;
-
-
-		(** controllers **)
-
-		Controller* = POINTER TO ABSTRACT RECORD (Stores.Store) END;
-
-
-		(** forwarders **)
-
-		Forwarder* = POINTER TO ABSTRACT RECORD
-			next: Forwarder
-		END;
-
-		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
-		PathInfo = POINTER TO RECORD
-			path: BOOLEAN; prev: PathInfo
-		END;
-		
-		BalanceCheckAction = POINTER TO RECORD (Services.Action) 
-			wait: WaitAction
-		END;
-		WaitAction = POINTER TO RECORD (Services.Action) 
-			check: BalanceCheckAction
-		END;
-
-	VAR
-		path-: BOOLEAN;
-
-		list: Forwarder;
-		
-		cleaner: TrapCleaner;
-		prevPath, cache: PathInfo;
-		
-
-
-	(** BalanceCheckAction **)
-	
-	PROCEDURE (a: BalanceCheckAction) Do;
-	BEGIN
-		Services.DoLater(a.wait, Services.resolution);
-		ASSERT(prevPath = NIL, 100);
-	END Do;
-	
-	PROCEDURE (a: WaitAction) Do;
-	BEGIN
-		Services.DoLater(a.check, Services.immediately)
-	END Do;
-
-	(** Cleaner **)
-
-	PROCEDURE (c: TrapCleaner) Cleanup;
-	BEGIN
-		path := frontPath;
-		prevPath := NIL
-	END Cleanup;
-
-	PROCEDURE NewPathInfo(): PathInfo;
-		VAR c: PathInfo;
-	BEGIN
-		IF cache = NIL THEN NEW(c)
-		ELSE c := cache; cache := cache.prev
-		END;
-		RETURN c
-	END NewPathInfo;
-	
-	PROCEDURE DisposePathInfo(c: PathInfo);
-	BEGIN
-		c.prev := cache; cache := c
-	END DisposePathInfo;
-
-
-	(** Controller **)
-
-	PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
-	(** pre: ~c.init **)
-	(** post: c.init **)
-		VAR thisVersion: INTEGER;
-	BEGIN
-		c.Internalize^(rd);
-		rd.ReadVersion(minVersion, maxVersion, thisVersion)
-	END Internalize;
-
-	PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
-	(** pre: c.init **)
-	BEGIN
-		c.Externalize^(wr);
-		wr.WriteVersion(maxVersion)
-	END Externalize;
-
-
-	(** Forwarder **)
-
-	PROCEDURE (f: Forwarder) Forward* (target: BOOLEAN; VAR msg: Message), NEW, ABSTRACT;
-	PROCEDURE (f: Forwarder) Transfer* (VAR msg: TransferMessage), NEW, ABSTRACT;
-
-	PROCEDURE Register* (f: Forwarder);
-		VAR t: Forwarder;
-	BEGIN
-		ASSERT(f # NIL, 20);
-		t := list; WHILE (t # NIL) & (t # f) DO t := t.next END;
-		IF t = NIL THEN f.next := list; list := f END
-	END Register;
-
-	PROCEDURE Delete* (f: Forwarder);
-		VAR t: Forwarder;
-	BEGIN
-		ASSERT(f # NIL, 20);
-		IF f = list THEN
-			list := list.next
-		ELSE
-			t := list; WHILE (t # NIL) & (t.next # f) DO t := t.next END;
-			IF t # NIL THEN t.next := f.next END
-		END;
-		f.next := NIL
-	END Delete;
-
-
-	PROCEDURE ForwardVia* (target: BOOLEAN; VAR msg: Message);
-		VAR t: Forwarder;
-	BEGIN
-		t := list; WHILE t # NIL DO t.Forward(target, msg); t := t.next END
-	END ForwardVia;
-
-	PROCEDURE SetCurrentPath* (target: BOOLEAN);
-		VAR p: PathInfo;
-	BEGIN
-		IF prevPath = NIL THEN Kernel.PushTrapCleaner(cleaner) END;
-		p := NewPathInfo(); p.prev := prevPath; prevPath := p; p.path := path;
-		path := target
-	END SetCurrentPath;
-	
-	PROCEDURE ResetCurrentPath*;
-		VAR p: PathInfo;
-	BEGIN
-		IF prevPath # NIL THEN (* otherwise trap cleaner may have already removed prefPath objects *)
-			p := prevPath; prevPath := p.prev; path := p.path;
-			IF prevPath = NIL THEN Kernel.PopTrapCleaner(cleaner) END;
-			DisposePathInfo(p)
-		END
-	END ResetCurrentPath;
-
-	PROCEDURE Forward* (VAR msg: Message);
-	BEGIN
-		ForwardVia(path, msg)
-	END Forward;
-
-	PROCEDURE PollOps* (VAR msg: PollOpsMsg);
-	BEGIN
-		msg.type := "";
-		msg.pasteType := "";
-		msg.singleton := NIL;
-		msg.selectable := FALSE;
-		msg.valid := {};
-		Forward(msg)
-	END PollOps;
-
-	PROCEDURE PollCursor* (x, y: INTEGER; modifiers: SET; OUT cursor: INTEGER);
-		VAR msg: PollCursorMsg;
-	BEGIN
-		msg.x := x; msg.y := y; msg.cursor := Ports.arrowCursor; msg.modifiers := modifiers;
-		Forward(msg);
-		cursor := msg.cursor
-	END PollCursor;
-
-	PROCEDURE Transfer* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER; VAR msg: TransferMessage);
-		VAR t: Forwarder;
-	BEGIN
-		ASSERT(source # NIL, 20);
-		msg.x := x; msg.y := y;
-		msg.source := source; msg.sourceX := sourceX; msg.sourceY := sourceY;
-		t := list; WHILE t # NIL DO t.Transfer(msg); t := t.next END
-	END Transfer;
-
-	PROCEDURE PollDrop* (x, y: INTEGER;
-							source: Views.Frame; sourceX, sourceY: INTEGER;
-							mark, show: BOOLEAN;
-							type: Stores.TypeName;
-							isSingle: BOOLEAN;
-							w, h, rx, ry: INTEGER;
-							OUT dest: Views.Frame; OUT destX, destY: INTEGER);
-		VAR msg: PollDropMsg;
-	BEGIN
-		ASSERT(source # NIL, 20);
-		msg.mark := mark; msg.show := show; msg.type := type; msg.isSingle := isSingle;
-		msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry; msg.dest := NIL;
-		Transfer(x, y, source, sourceX, sourceY, msg);
-		dest := msg.dest; destX := msg.x; destY := msg.y
-	END PollDrop;
-
-	PROCEDURE Drop* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER;
-									view: Views.View; isSingle: BOOLEAN; w, h, rx, ry: INTEGER);
-		VAR msg: DropMsg;
-	BEGIN
-		ASSERT(source # NIL, 20); ASSERT(view # NIL, 21);
-		msg.view := view; msg.isSingle := isSingle;
-		msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry;
-		Transfer(x, y, source, sourceX, sourceY, msg)
-	END Drop;
-
-	PROCEDURE PasteView* (view: Views.View; w, h: INTEGER; clipboard: BOOLEAN);
-		VAR msg: EditMsg;
-	BEGIN
-		ASSERT(view # NIL, 20);
-		msg.op := paste; msg.isSingle := TRUE;
-		msg.clipboard := clipboard;
-		msg.view := view; msg.w := w; msg.h := h;
-		Forward(msg)
-	END PasteView;
-
-
-	PROCEDURE FocusFrame* (): Views.Frame;
-		VAR msg: PollFocusMsg;
-	BEGIN
-		msg.focus := NIL; Forward(msg); RETURN msg.focus
-	END FocusFrame;
-
-	PROCEDURE FocusView* (): Views.View;
-		VAR focus: Views.Frame;
-	BEGIN
-		focus := FocusFrame();
-		IF focus # NIL THEN RETURN focus.view ELSE RETURN NIL END
-	END FocusView;
-
-	PROCEDURE FocusModel* (): Models.Model;
-		VAR focus: Views.Frame;
-	BEGIN
-		focus := FocusFrame();
-		IF focus # NIL THEN RETURN focus.view.ThisModel() ELSE RETURN NIL END
-	END FocusModel;
-
-
-	PROCEDURE HandleCtrlMsgs (op: INTEGER; f, g: Views.Frame; VAR msg: Message; VAR mark, front, req: BOOLEAN);
-	(* g = f.up OR g = NIL *)
-		CONST pre = 0; translate = 1; backoff = 2; final = 3;
-	BEGIN
-		CASE op OF
-		  pre:
-			WITH msg: MarkMsg DO
-				IF msg.show & (g # NIL) THEN mark := TRUE; front := g.front END
-			| msg: RequestMessage DO
-				msg.requestFocus := FALSE
-			ELSE
-			END
-		| translate:
-			WITH msg: CursorMessage DO
-				msg.x := msg.x + f.gx - g.gx;
-				msg.y := msg.y + f.gy - g.gy
-			ELSE
-			END
-		| backoff:
-			WITH msg: MarkMsg DO
-				IF ~msg.show THEN mark := FALSE; front := FALSE END
-			| msg: RequestMessage DO
-				req := msg.requestFocus
-			ELSE
-			END
-		| final:
-			WITH msg: PollFocusMsg DO
-				IF msg.focus = NIL THEN msg.focus := f END
-			| msg: MarkMsg DO
-				IF ~msg.show THEN mark := FALSE; front := FALSE END
-			| msg: RequestMessage DO
-				req := msg.requestFocus
-			ELSE
-			END
-		END
-	END HandleCtrlMsgs;
-
-
-	PROCEDURE Init;
-		VAR action: BalanceCheckAction; w: WaitAction;
-	BEGIN
-		Views.InitCtrl(HandleCtrlMsgs);
-		NEW(cleaner);
-		NEW(action); NEW(w); action.wait := w; w.check := action; Services.DoLater(action, Services.immediately);
-	END Init;
-
-BEGIN
-	Init
-END Controllers.

new/System/Mod/Controls.txt

@@ -1,3163 +0,0 @@
-MODULE Controls;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controls.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT
-		Kernel, Dates, Dialog, Meta, Services, Stores, Views, Properties, 
-		Strings, Fonts, Ports, Controllers, Windows, StdCFrames;
-
-	CONST
-		(** elements of Property.valid **)
-		opt0* = 0; opt1* = 1; opt2* = 2; opt3* = 3; opt4* = 4;
-		link* = 5; label* = 6; guard* = 7; notifier* = 8; level* = 9;
-
-		default* = opt0; cancel* = opt1;
-		left* = opt0; right* = opt1; multiLine* = opt2; password* = opt3;
-		sorted* = opt0;
-		haslines* = opt1; hasbuttons* = opt2; atroot* = opt3; foldericons* = opt4;
-
-		minVersion = 0; maxBaseVersion = 4;
-		pbVersion = 0; cbVersion = 0; rbVersion = 0; fldVersion = 0; 
-		dfldVersion = 0; tfldVersion = 0; cfldVersion = 0;
-		lbxVersion = 0; sbxVersion = 0; cbxVersion = 0; capVersion = 1; grpVersion = 0; 
-		tfVersion = 0; 
-
-		rdel = 07X; ldel = 08X;  tab = 09X; ltab = 0AX; lineChar = 0DX; esc = 01BX;
-		arrowLeft = 1CX; arrowRight = 1DX; arrowUp = 1EX; arrowDown = 1FX;
-
-		update = 2;	(* notify options *)
-		listUpdate = 3;
-		guardCheck = 4;
-		flushCaches = 5;	(* re-map labels for flushed string resources, after a language change *)
-		
-		maxAdr = 8;
-
-	TYPE
-		Prop* = POINTER TO RECORD (Properties.Property)
-			opt*: ARRAY 5 OF BOOLEAN;
-			link*: Dialog.String;
-			label*: Dialog.String;
-			guard*: Dialog.String;
-			notifier*: Dialog.String;
-			level*: INTEGER
-		END;
-		
-		Directory* = POINTER TO ABSTRACT RECORD END;
-
-		Control* = POINTER TO ABSTRACT RECORD (Views.View)
-			item-: Meta.Item;
-			disabled-, undef-, readOnly-, customFont-: BOOLEAN;
-			font-: Fonts.Font;
-			label-: Dialog.String;
-			prop-: Prop;
-			adr: ARRAY maxAdr OF INTEGER;
-			num: INTEGER;
-			stamp: INTEGER;
-			shortcut: CHAR;
-			guardErr, notifyErr: BOOLEAN
-		END;
-
-		DefaultsPref* = RECORD (Properties.Preference)
-			disabled*: BOOLEAN;	(** OUT, preset to ~c.item.Valid() *)
-			undef*: BOOLEAN;	(** OUT, preset to FALSE *)
-			readOnly*: BOOLEAN	(** OUT, preset to c.item.vis = readOnly *)
-		END;
-
-		PropPref* = RECORD (Properties.Preference)
-			valid*: SET	(** OUT, preset to {link, label, guard, notifier, customFont} *)
-		END;
-
-		PushButton = POINTER TO RECORD (Control) END;
-
-		CheckBox = POINTER TO RECORD (Control) END;
-
-		RadioButton = POINTER TO RECORD (Control) END;
-
-		Field = POINTER TO RECORD (Control)
-			maxLen: INTEGER
-		END;
-
-		UpDownField = POINTER TO RECORD (Control)
-			min, max, inc: INTEGER
-		END;
-
-		DateField = POINTER TO RECORD (Control) 
-			selection: INTEGER	(* 0: no selection, 1..n-1: this part selected, -1: part n selected *)
-		END;
-
-		TimeField = POINTER TO RECORD (Control) 
-			selection: INTEGER
-		END;
-
-		ColorField = POINTER TO RECORD (Control) END;
-
-		ListBox = POINTER TO RECORD (Control) END;
-
-		SelectionBox = POINTER TO RECORD (Control) END;
-
-		ComboBox = POINTER TO RECORD (Control) END;
-
-		Caption = POINTER TO RECORD (Control) END;
-
-		Group = POINTER TO RECORD (Control) END;
-
-		TreeControl = POINTER TO RECORD (Control) END;
-
-		StdDirectory = POINTER TO RECORD (Directory) END;
-
-		Op = POINTER TO RECORD (Stores.Operation)
-			ctrl: Control;
-			prop: Prop
-		END;
-
-		FontOp = POINTER TO RECORD (Stores.Operation)
-			ctrl: Control;
-			font: Fonts.Font;
-			custom: BOOLEAN
-		END;
-
-		NotifyMsg = RECORD (Views.NotifyMsg)
-			frame: Views.Frame;
-			op, from, to: INTEGER
-		END;
-
-		UpdateCachesMsg = RECORD (Views.UpdateCachesMsg) END;
-
-		SelectPtr = POINTER TO Dialog.Selection;
-		
-		ProcValue = RECORD (Meta.Value) p*: PROCEDURE END;
-		SelectValue = RECORD (Meta.Value) p*: SelectPtr END;
-		GuardProcVal = RECORD (Meta.Value) p*: Dialog.GuardProc END;
-		NotifyProcValOld = RECORD (Meta.Value) p*: PROCEDURE (op, from, to: INTEGER) END;
-		GuardProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n: INTEGER; VAR p: Dialog.Par) END;
-		NotifyProcPVal = RECORD (Meta.Value) p*: PROCEDURE(n, op, f, t: INTEGER) END;
-
-		Param = RECORD from, to, i: INTEGER; n: Dialog.String END;
-		
-		TVParam = RECORD l: INTEGER; e: BOOLEAN; nodeIn, nodeOut: Dialog.TreeNode END; 
-
-		Action = POINTER TO RECORD (Services.Action) 
-			w: Windows.Window;
-			resolution, cnt: INTEGER
-		END;
-
-		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
-
-	VAR
-		dir-, stdDir-: Directory;
-		par-: Control;
-		stamp: INTEGER;
-		action: Action;
-		cleaner:  TrapCleaner;
-		cleanerInstalled: INTEGER;
-
-
-	(** Cleaner **)
-
-	PROCEDURE (c: TrapCleaner) Cleanup;
-	BEGIN
-		par := NIL;
-		cleanerInstalled := 0
-	END Cleanup;
-
-
-	PROCEDURE (c: Control) Update- (f: Views.Frame; op, from, to: INTEGER), NEW, EMPTY;
-	PROCEDURE (c: Control) UpdateList- (f: Views.Frame), NEW, EMPTY;
-	PROCEDURE (c: Control) CheckLink- (VAR ok: BOOLEAN), NEW, EMPTY;
-	PROCEDURE (c: Control) HandlePropMsg2- (VAR p: Views.PropMessage), NEW, EMPTY;
-	PROCEDURE (c: Control) HandleViewMsg2- (f: Views.Frame; VAR msg: Views.Message), NEW, EMPTY;
-	PROCEDURE (c: Control) HandleCtrlMsg2- (f: Views.Frame; VAR msg: Views.CtrlMessage;
-																	VAR focus: Views.View), NEW, EMPTY;
-	PROCEDURE (c: Control) Externalize2- (VAR wr: Stores.Writer), NEW, EMPTY;
-	PROCEDURE (c: Control) Internalize2- (VAR rd: Stores.Reader), NEW, EMPTY;
-
-
-	(* auxiliary procedures *)
-
-	PROCEDURE IsShortcut (ch: CHAR; c: Control): BOOLEAN;
-	BEGIN
-		IF (ch >= "a") & (ch <= "z") OR (ch >= 0E0X) THEN ch := CAP(ch) END;
-		RETURN ch = c.shortcut
-	END IsShortcut;
-
-	PROCEDURE ExtractShortcut (c: Control);
-		VAR label: Dialog.String; i: INTEGER; ch, sCh: CHAR;
-	BEGIN
-		Dialog.MapString(c.label, label);
-		i := 0; ch := label[0]; sCh := "&";
-		WHILE sCh = "&" DO
-			WHILE (ch # 0X) & (ch # "&") DO INC(i); ch := label[i] END;
-			IF ch = 0X THEN sCh := 0X
-			ELSE INC(i); sCh := label[i]; INC(i); ch := label[i]
-			END
-		END;
-		IF (sCh >= "a") & (sCh <= "z") OR (sCh >= 0E0X) THEN sCh := CAP(sCh) END;
-		c.shortcut := sCh
-	END ExtractShortcut;
-
-	PROCEDURE GetGuardProc (name: ARRAY OF CHAR; VAR i: Meta.Item; VAR err: BOOLEAN;
-												VAR par: BOOLEAN; VAR n: INTEGER);
-		VAR j, k, e: INTEGER; num: ARRAY 32 OF CHAR;
-	BEGIN
-		j := 0;
-		WHILE (name[j] # 0X) & (name[j] # "(") DO INC(j) END;
-		IF name[j] = "(" THEN
-			INC(j); k := 0;
-			WHILE (name[j] # 0X) & (name[j] # ")") DO num[k] := name[j]; INC(j); INC(k) END;
-			IF (name[j] = ")") & (name[j+1] = 0X) THEN
-				num[k] := 0X; Strings.StringToInt(num, n, e);
-				IF e = 0 THEN
-					name[j - k - 1] := 0X;
-					Meta.LookupPath(name, i); par := TRUE
-				ELSE
-					IF ~err THEN
-						Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
-						err := TRUE
-					END;
-					Meta.Lookup("", i);
-					RETURN
-				END
-			ELSE
-				IF ~err THEN
-					Dialog.ShowParamMsg("#System:SyntaxErrorIn", name, "", "");
-					err := TRUE
-				END;
-				Meta.Lookup("", i);
-				RETURN
-			END
-		ELSE
-			Meta.LookupPath(name, i); par := FALSE
-		END;
-		IF (i.obj = Meta.procObj) OR (i.obj = Meta.varObj) & (i.typ = Meta.procTyp) THEN (*ok *)
-		ELSE
-			IF ~err THEN
-				IF i.obj = Meta.undef THEN
-					Dialog.ShowParamMsg("#System:NotFound", name, "", "")
-				ELSE
-					Dialog.ShowParamMsg("#System:HasWrongType", name, "", "")
-				END;
-				err := TRUE
-			END;
-			Meta.Lookup("", i)
-		END
-	END GetGuardProc;
-	
-	PROCEDURE CallGuard (c: Control);
-		VAR ok, up: BOOLEAN; n: INTEGER; dpar: Dialog.Par; p: Control;
-			v: GuardProcVal; vp: GuardProcPVal; i: Meta.Item; pref: DefaultsPref;
-	BEGIN
-		Controllers.SetCurrentPath(Controllers.targetPath);
-		pref.disabled := ~c.item.Valid();
-		pref.undef := FALSE;
-		pref.readOnly := c.item.vis = Meta.readOnly;
-		Views.HandlePropMsg(c, pref);
-		c.disabled := pref.disabled;
-		c.undef := pref.undef;
-		c.readOnly := pref.readOnly;
-		c.label := c.prop.label$;
-		IF ~c.disabled & (c.prop.guard # "") & ~c.guardErr THEN
-			IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
-			INC(cleanerInstalled);
-			p := par; par := c;
-			dpar.disabled := FALSE; dpar.undef := FALSE;
-			dpar.readOnly := c.readOnly;
-			dpar.checked := FALSE; dpar.label := c.label$;
-			GetGuardProc(c.prop.guard, i, c.guardErr, up, n);
-			IF i.obj # Meta.undef THEN
-				IF up THEN	(* call with numeric parameter *)
-					i.GetVal(vp, ok);
-					IF ok THEN vp.p(n, dpar) END
-				ELSE
-					i.GetVal(v, ok);
-					IF ok THEN v.p(dpar) END
-				END;
-				IF ok THEN
-					c.disabled := dpar.disabled;
-					c.undef := dpar.undef;
-					IF dpar.readOnly THEN c.readOnly := TRUE END;
-					IF dpar.label # c.label THEN c.label := dpar.label END
-				ELSIF ~c.guardErr THEN
-					Dialog.ShowParamMsg("#System:HasWrongType", c.prop.guard, "", "");
-					c.guardErr := TRUE
-				END
-			END;
-			par := p;
-			DEC(cleanerInstalled);
-			IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
-		END;
-		ExtractShortcut(c);
-		Controllers.ResetCurrentPath()
-	END CallGuard;
-
-	PROCEDURE CallNotifier (c: Control; op, from, to: INTEGER);
-		VAR ok, up: BOOLEAN; n: INTEGER; vold: NotifyProcValOld; vp: NotifyProcPVal;
-			i: Meta.Item; p: Control;
-	BEGIN
-		IF c.prop.notifier # "" THEN
-			IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
-			INC(cleanerInstalled);
-			p := par; par := c;
-			IF c.prop.notifier[0] = "!" THEN
-				IF op = Dialog.pressed THEN
-					c.prop.notifier[0] := " ";
-					Dialog.ShowStatus(c.prop.notifier);
-					c.prop.notifier[0] := "!"
-				ELSIF op = Dialog.released THEN
-					Dialog.ShowStatus("")
-				END
-			ELSE
-				GetGuardProc(c.prop.notifier, i, c.notifyErr, up, n);
-				IF i.obj # Meta.undef THEN
-					IF up THEN	(* call with numeric parameter *)
-						i.GetVal(vp, ok);
-						IF ok THEN vp.p(n, op, from, to) END
-					ELSE
-						i.GetVal(vold, ok);
-						IF ok THEN vold.p(op, from, to) END
-					END;
-					IF ~ok & ~c.notifyErr THEN
-						Dialog.ShowParamMsg("#System:HasWrongType", c.prop.notifier, "", "");
-						c.notifyErr := TRUE
-					END
-				END
-			END;
-			par := p;
-			DEC(cleanerInstalled);
-			IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
-		END
-	END CallNotifier;
-
-	PROCEDURE DCHint (modifiers: SET): INTEGER;
-	BEGIN
-		IF Controllers.doubleClick IN modifiers THEN RETURN 1
-		ELSE RETURN 0
-		END
-	END DCHint;
-
-	PROCEDURE Notify* (c: Control; f: Views.Frame; op, from, to: INTEGER);
-		VAR msg: NotifyMsg;
-	BEGIN
-		IF ~c.readOnly & ~ c.disabled THEN
-			CallNotifier(c, op, from, to);
-			IF op >= Dialog.changed THEN
-				msg.id0 := c.item.adr; msg.id1 := msg.id0 + c.item.Size(); msg.frame := f;
-				msg.op := op; msg.from := from; msg.to := to;
-				msg.opts := {update, guardCheck};
-				Views.Omnicast(msg)
-			END
-		END
-	END Notify;
-
-	PROCEDURE NotifyFlushCaches*;
-		VAR msg: NotifyMsg;
-	BEGIN
-		msg.opts := {flushCaches}; msg.id0 := 0; msg.id1 := 0;
-		Views.Omnicast(msg)
-	END NotifyFlushCaches;
-	
-	PROCEDURE GetName (VAR path, name: ARRAY OF CHAR; VAR i: INTEGER);
-		VAR j: INTEGER; ch: CHAR;
-	BEGIN
-		j := 0; ch := path[i];
-		WHILE (j < LEN(name) - 1) & ((ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z")
-												OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_")) DO
-			name[j] := ch; INC(i); INC(j); ch := path[i]
-		END;
-		IF (ch = 0X) OR (ch = ".") OR (ch = "[") OR (ch = "^") THEN name[j] := 0X
-		ELSE name[0] := 0X
-		END
-	END GetName;
-
-	PROCEDURE LookupPath (path: ARRAY OF CHAR; VAR i: Meta.Item;
-												VAR adr: ARRAY OF INTEGER; VAR num: INTEGER);
-		VAR j, n: INTEGER; name: Meta.Name; ch: CHAR;
-	BEGIN
-		path[LEN(path) - 1] := 0X; j := 0; num := 0;
-		GetName(path, name, j); Meta.Lookup(name, i);
-		IF (i.obj = Meta.modObj) & (path[j] = ".") THEN
-			INC(j); GetName(path, name, j);
-			i.Lookup(name, i); ch := path[j]; INC(j);
-			WHILE i.obj = Meta.varObj DO
-				adr[num] := i.adr;
-				IF num < LEN(adr) - 1 THEN INC(num) END;
-				IF ch = 0X THEN RETURN 
-				ELSIF i.typ = Meta.ptrTyp THEN
-					IF ch = "^" THEN ch := path[j]; INC(j) END;
-					i.Deref(i)
-				ELSIF (i.typ = Meta.recTyp) & (ch = ".") THEN
-					GetName(path, name, j); i.Lookup(name, i);
-					ch := path[j]; INC(j)
-				ELSIF (i.typ = Meta.arrTyp) & (ch = "[") THEN
-					ch := path[j]; INC(j); n := 0;
-					WHILE (ch >= "0") & (ch <= "9") DO n := 10 * n + ORD(ch) - ORD("0"); ch := path[j]; INC(j) END;
-					IF ch = "]" THEN ch := path[j]; INC(j); i.Index(n, i) ELSE Meta.Lookup("", i) END
-				ELSE Meta.Lookup("", i)
-				END
-			END
-		ELSE
-			Meta.LookupPath(path, i); num := 0;
-			IF i.obj = Meta.varObj THEN adr[0] := i.adr; num := 1
-			ELSIF i.obj # Meta.procObj THEN Meta.Lookup("", i)
-			END
-		END
-	END LookupPath;
-
-	PROCEDURE Sort (VAR adr: ARRAY OF INTEGER; num: INTEGER);
-		VAR i, j, p: INTEGER;
-	BEGIN
-		i := 1;
-		WHILE i < num DO
-			p := adr[i]; j := i;
-			WHILE (j >= 1) & (adr[j - 1] > p) DO adr[j] := adr[j - 1]; DEC(j) END;
-			adr[j] := p; INC(i)
-		END
-	END Sort;
-
-	PROCEDURE GetTypeName (IN item: Meta.Item; OUT name: Meta.Name);
-		VAR mod: Meta.Name;
-	BEGIN
-		IF (item.typ = Meta.recTyp) THEN
-			item.GetTypeName(mod, name);
-			IF (mod = "Dialog") OR (mod = "Dates") THEN (* ok *)
-			ELSE name := ""
-			END
-		ELSE name := ""
-		END
-	END GetTypeName;
-
-	PROCEDURE OpenLink* (c: Control; p: Prop);
-		VAR ok: BOOLEAN;
-	BEGIN
-		ASSERT(c # NIL, 20); ASSERT(p # NIL, 21);
-		c.num := 0;
-		c.prop := Properties.CopyOf(p)(Prop);
-		IF c.font = NIL THEN
-			IF c.customFont THEN c.font := StdCFrames.defaultLightFont
-			ELSE c.font := StdCFrames.defaultFont
-			END
-		END;
-		c.guardErr := FALSE; c.notifyErr := FALSE;
-		LookupPath(p.link, c.item, c.adr, c.num);
-		IF c.item.obj = Meta.varObj THEN
-			Sort(c.adr, c.num);
-			ok := TRUE; c.CheckLink(ok);
-			IF ~ok THEN
-				Meta.Lookup("", c.item);
-				Dialog.ShowParamMsg("#System:HasWrongType", p.link, "", "")
-			END
-		ELSE
-			Meta.Lookup("", c.item); c.num := 0
-		END;
-		CallGuard(c);
-		c.stamp := stamp
-	END OpenLink;
-
-
-	(** Prop **)
-
-	PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
-		VAR valid: SET;
-	BEGIN
-		WITH q: Prop DO
-			valid := p.valid * q.valid; equal := TRUE;
-			IF p.link # q.link THEN EXCL(valid, link) END;
-			IF p.label # q.label THEN EXCL(valid, label) END;
-			IF p.guard # q.guard THEN EXCL(valid, guard) END;
-			IF p.notifier # q.notifier THEN EXCL(valid, notifier) END;
-			IF p.level # q.level THEN EXCL(valid, level) END;
-			IF p.opt[0] # q.opt[0] THEN EXCL(valid, opt0) END;
-			IF p.opt[1] # q.opt[1] THEN EXCL(valid, opt1) END;
-			IF p.opt[2] # q.opt[2] THEN EXCL(valid, opt2) END;
-			IF p.opt[3] # q.opt[3] THEN EXCL(valid, opt3) END;
-			IF p.opt[4] # q.opt[4] THEN EXCL(valid, opt4) END;
-			IF p.valid # valid THEN p.valid := valid; equal := FALSE END
-		END
-	END IntersectWith;
-
-
-	(* Control *)
-
-	PROCEDURE (c: Control) CopyFromSimpleView2- (source: Control), NEW, EMPTY;
-
-	PROCEDURE (c: Control) CopyFromSimpleView- (source: Views.View);
-	BEGIN
-		WITH source: Control DO
-			c.item := source.item;
-			c.adr := source.adr;
-			c.num := source.num;
-			c.disabled := source.disabled;
-			c.undef := source.undef;
-			c.readOnly := source.readOnly;
-			c.shortcut := source.shortcut;
-			c.customFont := source.customFont;
-			c.font := source.font;
-			c.label := source.label$;
-			c.prop := Properties.CopyOf(source.prop)(Prop);
-			c.CopyFromSimpleView2(source)
-		END
-	END CopyFromSimpleView;
-
-	PROCEDURE (c: Control) Internalize- (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER; x, def, canc, sort: BOOLEAN;
-	BEGIN
-		c.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxBaseVersion, thisVersion);
-		IF rd.cancelled THEN RETURN END;
-		NEW(c.prop);
-		IF thisVersion >= 3 THEN
-			rd.ReadString(c.prop.link);
-			rd.ReadString(c.prop.label);
-			rd.ReadString(c.prop.guard);
-			rd.ReadString(c.prop.notifier);
-			rd.ReadInt(c.prop.level);
-			rd.ReadBool(c.customFont);
-			rd.ReadBool(c.prop.opt[0]);
-			rd.ReadBool(c.prop.opt[1]);
-			rd.ReadBool(c.prop.opt[2]);
-			rd.ReadBool(c.prop.opt[3]);
-			rd.ReadBool(c.prop.opt[4]);
-			IF c.customFont & (thisVersion = 4) THEN
-				Views.ReadFont(rd, c.font)
-			END
-		ELSE
-			rd.ReadXString(c.prop.link);
-			rd.ReadXString(c.prop.label);
-			rd.ReadXString(c.prop.guard);
-			c.prop.notifier := "";
-			c.prop.opt[2] := FALSE;
-			c.prop.opt[3] := FALSE;
-			c.prop.opt[4] := FALSE;
-			sort := FALSE;
-			IF thisVersion = 2 THEN
-				rd.ReadXString(c.prop.notifier);
-				rd.ReadBool(sort);
-				rd.ReadBool(c.prop.opt[multiLine])
-			ELSIF thisVersion = 1 THEN
-				rd.ReadXString(c.prop.notifier);
-				rd.ReadBool(sort)
-			END;
-			rd.ReadBool(x);	(* free, was sed for prop.element *)
-			rd.ReadBool(def); 
-			rd.ReadBool(canc);
-			rd.ReadXInt(c.prop.level);
-			rd.ReadBool(c.customFont);
-			c.prop.opt[default] := def OR sort OR (c IS Field);
-			c.prop.opt[cancel] := canc
-		END;
-		c.Internalize2(rd);
-		OpenLink(c, c.prop)
-	END Internalize;
-
-	PROCEDURE (c: Control) Externalize- (VAR wr: Stores.Writer);
-	BEGIN
-		c.Externalize^(wr);
-		wr.WriteVersion(maxBaseVersion);
-		wr.WriteString(c.prop.link);
-		wr.WriteString(c.prop.label);
-		wr.WriteString(c.prop.guard);
-		wr.WriteString(c.prop.notifier);
-		wr.WriteInt(c.prop.level);
-		wr.WriteBool(c.customFont);
-		wr.WriteBool(c.prop.opt[0]);
-		wr.WriteBool(c.prop.opt[1]);
-		wr.WriteBool(c.prop.opt[2]);
-		wr.WriteBool(c.prop.opt[3]);
-		wr.WriteBool(c.prop.opt[4]);
-		IF c.customFont THEN Views.WriteFont(wr, c.font) END;
-		c.Externalize2(wr)
-	END Externalize;
-
-	PROCEDURE (c: Control) HandleViewMsg- (f: Views.Frame; VAR msg: Views.Message);
-		VAR disabled, undef, readOnly, done, allDone: BOOLEAN; i: INTEGER; lbl: Dialog.String;
-	BEGIN
-		WITH msg: Views.NotifyMsg DO
-			done := FALSE; allDone := FALSE;
-			IF guardCheck IN msg.opts THEN
-				(* should call c.Update for each frame but Views.Update only once *)
-				WITH f: StdCFrames.Caption DO lbl := f.label$
-				| f: StdCFrames.PushButton DO lbl := f.label$
-				| f: StdCFrames.RadioButton DO lbl := f.label$
-				| f: StdCFrames.CheckBox DO lbl := f.label$
-				| f: StdCFrames.Group DO lbl := f.label$
-				ELSE lbl := c.label$
-				END;
-				WITH f: StdCFrames.Frame DO
-					disabled := f.disabled; undef := f.undef; readOnly := f.readOnly
-				ELSE
-					disabled := c.disabled; undef := c.undef; readOnly := c.readOnly
-				END;
-				CallGuard(c);
-				IF (c.disabled # disabled) OR (c.undef # undef)
-				OR (c.readOnly # readOnly) OR (c.label # lbl) THEN
-					WITH f: StdCFrames.Frame DO
-						IF f.noRedraw THEN
-							f.disabled := c.disabled;
-							f.undef := c.undef;
-							f.readOnly := c.readOnly;
-							c.Update(f, 0, 0, 0); done := TRUE
-						ELSE Views.Update(c, Views.rebuildFrames); allDone := TRUE
-						END
-					ELSE Views.Update(c, Views.keepFrames); done := TRUE
-					END
-				END
-			END;
-			IF flushCaches IN msg.opts THEN
-				Views.Update(c, Views.rebuildFrames)
-			END;
-			i := 0; WHILE (i < c.num) & (c.adr[i] < msg.id0) DO INC(i) END;
-			IF (i < c.num) & (c.adr[i] < msg.id1) & ~allDone THEN
-				IF (update IN msg.opts) & ~done THEN
-					WITH msg: NotifyMsg DO
-						IF msg.frame # f THEN	(* don't update origin frame *)
-							c.Update(f, msg.op, msg.from, msg.to)
-						END
-					ELSE
-						c.Update(f, 0, 0, 0)
-					END
-				END;
-				IF listUpdate IN msg.opts THEN
-					c.UpdateList(f)
-				END
-			END
-		| msg: Views.UpdateCachesMsg DO
-			IF c.stamp # stamp THEN
-				OpenLink(c, c.prop);
-				IF msg IS UpdateCachesMsg THEN
-					Views.Update(c, Views.rebuildFrames)
-				END
-			END
-		ELSE
-		END;
-		c.HandleViewMsg2(f, msg)
-	END HandleViewMsg;
-
-	PROCEDURE (c: Control) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message;
-																							VAR focus: Views.View);
-		VAR sp: Properties.SizeProp; p: Control; dcOk: BOOLEAN;
-	BEGIN
-		IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
-		INC(cleanerInstalled);
-		p := par; par := c;
-		WITH msg: Properties.PollPickMsg DO
-			msg.dest := f
-		| msg: Properties.PickMsg DO
-			NEW(sp); sp.known := {Properties.width, Properties.height}; sp.valid := sp.known;
-			c.context.GetSize(sp.width, sp.height);
-			Properties.Insert(msg.prop, sp)
-		| msg: Controllers.TrackMsg DO
-			IF ~c.disabled THEN
-				dcOk := TRUE;
-				IF f IS StdCFrames.Frame THEN dcOk := f(StdCFrames.Frame).DblClickOk(msg.x, msg.y) END;
-				IF (DCHint(msg.modifiers) = 1)  & dcOk THEN
-					(* double click *)
-					Notify(c, f, Dialog.pressed, 1, 0)
-				ELSE
-					Notify(c, f, Dialog.pressed, 0, 0)
-				END
-			END
-		ELSE
-		END;
-		c.HandleCtrlMsg2(f, msg, focus);
-		WITH msg: Controllers.TrackMsg DO
-			IF ~c.disabled THEN
-				Notify(c, f, Dialog.released, 0, 0)
-			END
-		ELSE
-		END;
-		par := p;
-		DEC(cleanerInstalled);
-		IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
-	END HandleCtrlMsg;
-
-	PROCEDURE (c: Control) HandlePropMsg- (VAR msg: Properties.Message);
-		VAR fpref: Properties.FocusPref; stp: Properties.StdProp;
-			cp: Prop; ppref: PropPref; op: Op; valid: SET; p: Properties.Property;
-			fop: FontOp; face: Fonts.Typeface; size, weight: INTEGER; style: SET;
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN
-				fpref.hotFocus := FALSE; fpref.setFocus := FALSE; fpref.atLocation := FALSE;
-				Views.HandlePropMsg(c, fpref);
-				IF fpref.setFocus THEN msg.getFocus := TRUE END
-			END
-		| msg: Properties.PollMsg DO
-			ppref.valid := {link, label, notifier, guard};
-			Views.HandlePropMsg(c, ppref);
-			cp := Properties.CopyOf(c.prop)(Prop);
-			cp.valid := ppref.valid; cp.known := cp.valid; cp.readOnly := {};
-			Properties.Insert(msg.prop, cp);
-			NEW(stp);
-			stp.valid := {Properties.typeface..Properties.weight};
-			stp.known := stp.valid;
-			IF c.customFont THEN stp.typeface := c.font.typeface$
-			ELSE stp.typeface := Fonts.default
-			END;
-			stp.size := c.font.size; stp.style.val := c.font.style; stp.weight := c.font.weight;
-			stp.style.mask := {Fonts.italic, Fonts.strikeout, Fonts.underline};
-			Properties.Insert(msg.prop, stp)
-		| msg: Properties.SetMsg DO
-			p := msg.prop; op := NIL; fop := NIL;
-			WHILE (p # NIL) & (op = NIL) DO
-				WITH p: Prop DO
-					ppref.valid := {link, label, notifier, guard};
-					Views.HandlePropMsg(c, ppref);
-					valid := p.valid * ppref.valid;
-					IF valid # {} THEN
-						NEW(op); 
-						op.ctrl := c; 
-						op.prop := Properties.CopyOf(p)(Prop); op.prop.valid := valid
-					END
-				| p: Properties.StdProp DO
-					valid := p.valid * {Properties.typeface..Properties.weight};
-					IF valid # {} THEN
-						NEW(fop); fop.ctrl := c;
-						face := c.font.typeface$; size := c.font.size; style := c.font.style; weight := c.font.weight;
-						IF Properties.typeface IN p.valid THEN face := p.typeface$;
-							IF face = Fonts.default THEN face := StdCFrames.defaultFont.typeface END
-						END;
-						IF Properties.size IN p.valid THEN size := p.size END;
-						IF Properties.style IN p.valid THEN
-							style := (p.style.val * p.style.mask) + (style - p.style.mask)
-						END;
-						IF Properties.weight IN p.valid THEN weight := p.weight END;
-						fop.custom := TRUE;
-						fop.font := Fonts.dir.This(face, size, style, weight);
-						IF (fop.font.typeface = StdCFrames.defaultFont.typeface)
-						& (fop.font.size = StdCFrames.defaultFont.size)
-						& (fop.font.style = StdCFrames.defaultFont.style)
-						& (fop.font.weight = StdCFrames.defaultFont.weight) THEN
-							fop.custom := FALSE;
-							fop.font := StdCFrames.defaultFont
-						END
-					END
-				ELSE
-				END;
-				p := p.next
-			END;
-			IF op # NIL THEN Views.Do(c, "#System:SetProp", op) END;
-			IF fop # NIL THEN Views.Do(c, "#System:SetProp", fop) END
-		| msg: Properties.TypePref DO
-			IF Services.Is(c, msg.type) THEN msg.view := c END
-		ELSE
-		END;
-		c.HandlePropMsg2(msg)
-	END HandlePropMsg;
-
-
-	(* Op *)
-
-	PROCEDURE (op: Op) Do;
-		VAR c: Control; prop: Prop;
-	BEGIN
-		c := op.ctrl;
-		prop := Properties.CopyOf(c.prop)(Prop);
-		prop.valid := op.prop.valid;	(* fields to be restored *)
-		IF link IN op.prop.valid THEN c.prop.link := op.prop.link END;
-		IF label IN op.prop.valid THEN c.prop.label := op.prop.label END;
-		IF guard IN op.prop.valid THEN c.prop.guard := op.prop.guard END;
-		IF notifier IN op.prop.valid THEN c.prop.notifier := op.prop.notifier END;
-		IF level IN op.prop.valid THEN c.prop.level := op.prop.level END;
-		IF opt0 IN op.prop.valid THEN c.prop.opt[0] := op.prop.opt[0] END;
-		IF opt1 IN op.prop.valid THEN c.prop.opt[1] := op.prop.opt[1] END;
-		IF opt2 IN op.prop.valid THEN c.prop.opt[2] := op.prop.opt[2] END;
-		IF opt3 IN op.prop.valid THEN c.prop.opt[3] := op.prop.opt[3] END;
-		IF opt4 IN op.prop.valid THEN c.prop.opt[4] := op.prop.opt[4] END;
-		IF c.prop.guard # prop.guard THEN c.guardErr := FALSE END;
-		IF c.prop.notifier # prop.notifier THEN c.notifyErr := FALSE END;
-		IF c.prop.link # prop.link THEN OpenLink(c, c.prop) ELSE CallGuard(c) END;
-		op.prop := prop;
-		Views.Update(c, Views.rebuildFrames)
-	END Do;
-
-	PROCEDURE (op: FontOp) Do;
-		VAR c: Control; custom: BOOLEAN; font: Fonts.Font;
-	BEGIN
-		c := op.ctrl;
-		custom := c.customFont; c.customFont := op.custom; op.custom := custom;
-		font := c.font; c.font := op.font; op.font := font;
-		Views.Update(c, Views.rebuildFrames)
-	END Do;
-
-
-	(* ------------------------- standard controls ------------------------- *)
-
-	PROCEDURE CatchCtrlMsg (c: Control; f: Views.Frame; VAR msg: Controllers.Message;
-																				VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled THEN
-			WITH f: StdCFrames.Frame DO
-				WITH msg: Controllers.PollCursorMsg DO
-					f.GetCursor(msg.x, msg.y, msg.modifiers, msg.cursor)
-				| msg: Controllers.PollOpsMsg DO
-					msg.valid := {Controllers.pasteChar}
-				| msg: Controllers.TrackMsg DO
-					f.MouseDown(msg.x, msg.y, msg.modifiers)
-				| msg: Controllers.MarkMsg DO
-					f.Mark(msg.show, msg.focus)
-				|msg: Controllers.WheelMsg DO
-					f.WheelMove(msg.x, msg.y, msg.op, msg.nofLines, msg.done)
-				ELSE
-				END
-			END
-		END
-	END CatchCtrlMsg;
-	
-
-	(** Directory **)
-
-	PROCEDURE (d: Directory) NewPushButton* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewCheckBox* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewRadioButton* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewField* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewUpDownField* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewDateField* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewTimeField* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewColorField* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewListBox* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewSelectionBox* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewComboBox* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewCaption* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewGroup* (p: Prop): Control, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) NewTreeControl* (p: Prop): Control, NEW, ABSTRACT;
-
-
-	(* PushButton *)
-
-	PROCEDURE Call (c: PushButton);
-		VAR res: INTEGER; p: Control; ok: BOOLEAN; msg: Views.NotifyMsg;
-	BEGIN
-		IF c.item.Valid() & ((c.item.obj = Meta.procObj) OR (c.item.obj = Meta.varObj) & (c.item.typ = Meta.procTyp)) THEN
-			IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
-			INC(cleanerInstalled);
-			p := par; c.item.Call(ok); par := p;
-			DEC(cleanerInstalled);
-			IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END;
-			IF ~ok THEN Dialog.ShowMsg("#System:BehaviorNotAccessible") END
-		ELSIF c.prop.link # "" THEN
-			IF cleanerInstalled = 0 THEN Kernel.PushTrapCleaner(cleaner) END;
-			INC(cleanerInstalled);
-			p := par; par := c; Dialog.Call(c.prop.link, " ", res); par := p;
-			DEC(cleanerInstalled);
-			IF cleanerInstalled = 0 THEN Kernel.PopTrapCleaner(cleaner) END
-		ELSE Dialog.ShowMsg("#System:NoBehaviorBound")
-		END;
-		msg.opts := {guardCheck};
-		Views.Omnicast(msg)
-	END Call;
-	
-	PROCEDURE Do (f: StdCFrames.PushButton);
-	BEGIN
-		Call(f.view(PushButton))
-	END Do;
-
-	PROCEDURE (c: PushButton) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, pbVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: PushButton) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(pbVersion)
-	END Externalize2;
-
-	PROCEDURE (c: PushButton) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.PushButton;
-	BEGIN
-		f := StdCFrames.dir.NewPushButton();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.label := c.label$;
-		f.default := c.prop.opt[default];
-		f.cancel := c.prop.opt[cancel];
-		f.Do := Do;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: PushButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: PushButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																				VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled THEN
-			WITH f: StdCFrames.Frame DO
-				WITH msg: Controllers.EditMsg DO
-					IF (msg.op = Controllers.pasteChar)
-						& ((msg.char = lineChar)
-							OR (msg.char = " ")
-							OR (msg.char = esc) & c.prop.opt[cancel]
-							OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: PushButton) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			msg.accepts := ~c.disabled & ((msg.char = lineChar) & c.prop.opt[default]
-				OR (msg.char = esc) & c.prop.opt[cancel]
-				OR IsShortcut(msg.char, c))
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~ c.readOnly THEN
-				msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetPushButtonSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, default, cancel}
-		| msg: DefaultsPref DO
-			IF c.prop.link # "" THEN msg.disabled := FALSE END
-		ELSE
-		END
-	END HandlePropMsg2;
-	
-	PROCEDURE (c: PushButton) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.PushButton).label := c.label$;
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-	PROCEDURE (c: PushButton) CheckLink (VAR ok: BOOLEAN);
-	BEGIN
-		ok := c.item.typ = Meta.procTyp
-	END CheckLink;
-
-
-	(* CheckBox *)
-
-	PROCEDURE GetCheckBox (f: StdCFrames.CheckBox; OUT x: BOOLEAN);
-		VAR c: CheckBox;
-	BEGIN
-		x := FALSE;
-		c := f.view(CheckBox);
-		IF c.item.Valid() THEN
-			IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal()
-			ELSIF c.item.typ = Meta.setTyp THEN x := c.prop.level IN c.item.SetVal()
-			END
-		END
-	END GetCheckBox;
-
-	PROCEDURE SetCheckBox (f: StdCFrames.CheckBox; x: BOOLEAN);
-		VAR c: CheckBox; s: SET;
-	BEGIN
-		c := f.view(CheckBox);
-		IF c.item.Valid() & ~c.readOnly THEN
-			IF c.item.typ = Meta.boolTyp THEN
-				c.item.PutBoolVal(x); Notify(c, f, Dialog.changed, 0, 0)
-			ELSIF c.item.typ = Meta.setTyp THEN
-				s := c.item.SetVal();
-				IF x THEN INCL(s, c.prop.level) ELSE EXCL(s, c.prop.level) END;
-				c.item.PutSetVal(s);
-				IF x THEN Notify(c, f, Dialog.included, c.prop.level, c.prop.level)
-				ELSE Notify(c, f, Dialog.excluded, c.prop.level, c.prop.level)
-				END
-			END
-		END
-	END SetCheckBox;
-
-	PROCEDURE (c: CheckBox) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, cbVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: CheckBox) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(cbVersion)
-	END Externalize2;
-
-	PROCEDURE (c: CheckBox) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.CheckBox;
-	BEGIN
-		f :=  StdCFrames.dir.NewCheckBox();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.label := c.label$;
-		f.Get := GetCheckBox;
-		f.Set := SetCheckBox;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: CheckBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: CheckBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled & ~c.readOnly THEN
-			WITH f: StdCFrames.Frame DO
-				WITH msg: Controllers.EditMsg DO
-					IF (msg.op = Controllers.pasteChar)
-						& ((msg.char = " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: CheckBox) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				IF (msg.char = tab) OR (msg.char = ltab) THEN
-					(* tabs set focus to first checkbox only *)
-					IF (msg.focus # NIL) & (msg.focus IS CheckBox)
-							& (msg.focus(CheckBox).item.adr = c.item.adr) THEN
-						msg.getFocus := FALSE
-					END
-				ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
-					(* arrows set focus to next checkbox bound to same variable *)
-					msg.getFocus := StdCFrames.setFocus
-						& (msg.focus # NIL)
-						& (msg.focus IS CheckBox)
-						& (msg.focus(CheckBox).item.adr = c.item.adr);
-					msg.accepts := msg.getFocus & (msg.focus # c)
-				ELSIF IsShortcut(msg.char, c) THEN
-					msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
-				ELSIF msg.char # " " THEN
-					msg.accepts := FALSE
-				END
-			END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetCheckBoxSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, level}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: CheckBox) CheckLink (VAR ok: BOOLEAN);
-	BEGIN
-		ok := (c.item.typ = Meta.boolTyp) OR (c.item.typ = Meta.setTyp)
-	END CheckLink;
-
-	PROCEDURE (c: CheckBox) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		IF (op = 0) OR (c.item.typ = Meta.boolTyp) OR (c.prop.level = to) THEN
-			f(StdCFrames.CheckBox).label := c.label$;
-			f(StdCFrames.Frame).Update
-		END
-	END Update;
-	
-
-	(* RadioButton *)
-
-	PROCEDURE GetRadioButton (f: StdCFrames.RadioButton; OUT x: BOOLEAN);
-		VAR c: RadioButton;
-	BEGIN
-		x := FALSE;
-		c := f.view(RadioButton);
-		IF c.item.Valid() THEN
-			IF c.item.typ = Meta.boolTyp THEN x := c.item.BoolVal() = (c.prop.level # 0)
-			ELSE x := c.item.IntVal() = c.prop.level
-			END
-		END
-	END GetRadioButton;
-
-	PROCEDURE SetRadioButton (f: StdCFrames.RadioButton; x: BOOLEAN);
-		VAR c: RadioButton; old: INTEGER;
-	BEGIN
-		IF x THEN
-			c := f.view(RadioButton);
-			IF c.item.Valid() & ~c.readOnly THEN
-				IF c.item.typ = Meta.boolTyp THEN
-					IF c.item.BoolVal() THEN old := 1 ELSE old := 0 END;
-					IF c.prop.level # old THEN
-						c.item.PutBoolVal(c.prop.level # 0);
-						Notify(c, f, Dialog.changed, old, c.prop.level)
-					END
-				ELSE
-					old := c.item.IntVal();
-					IF c.prop.level # old THEN
-						c.item.PutIntVal(c.prop.level);
-						Notify(c, f, Dialog.changed, old, c.prop.level)
-					END
-				END
-			END
-		END
-	END SetRadioButton;
-
-	PROCEDURE (c: RadioButton) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, rbVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: RadioButton) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(rbVersion)
-	END Externalize2;
-
-	PROCEDURE (c: RadioButton) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.RadioButton;
-	BEGIN
-		f := StdCFrames.dir.NewRadioButton();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.label := c.label$;
-		f.Get := GetRadioButton;
-		f.Set := SetRadioButton;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: RadioButton) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: RadioButton) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																			VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled & ~c.readOnly THEN
-			WITH f: StdCFrames.Frame DO
-				WITH msg: Controllers.EditMsg DO
-					IF (msg.op = Controllers.pasteChar)
-						& ((msg.char <= " ") OR IsShortcut(msg.char, c)) THEN f.KeyDown(msg.char) END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: RadioButton) HandlePropMsg2 (VAR msg: Properties.Message);
-		VAR hot: BOOLEAN;
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				IF (msg.char = tab) OR (msg.char = ltab) THEN
-					(* tabs set focus to active radio button only *)
-					IF c.item.Valid() THEN
-						IF c.item.typ = Meta.boolTyp THEN hot := c.item.BoolVal() = (c.prop.level # 0)
-						ELSE hot := c.item.IntVal() = c.prop.level
-						END
-					ELSE hot := FALSE
-					END;
-					IF ~hot THEN msg.getFocus := FALSE END
-				ELSIF (msg.char >= arrowLeft) & (msg.char <= arrowDown) THEN
-					(* arrows set focus to next radio button bound to same variable *)
-					msg.getFocus := StdCFrames.setFocus
-						& (msg.focus # NIL) & (msg.focus IS RadioButton)
-						& (msg.focus(RadioButton).item.adr = c.item.adr);
-					msg.accepts := msg.getFocus & (msg.focus # c)
-				ELSIF IsShortcut(msg.char, c) THEN
-					msg.accepts := TRUE; msg.getFocus := StdCFrames.setFocus
-				ELSIF msg.char # " " THEN
-					msg.accepts := FALSE
-				END
-			END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
- 			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetRadioButtonSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, level}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: RadioButton) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		IF name = "List" THEN c.item.Lookup("index", c.item) END;
-		ok := (c.item.typ >= Meta.byteTyp) & (c.item.typ <= Meta.intTyp) OR (c.item.typ = Meta.boolTyp)
-	END CheckLink;
-
-	PROCEDURE (c: RadioButton) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		IF (op = 0) OR (c.prop.level = to) OR (c.prop.level = from) THEN
-			f(StdCFrames.RadioButton).label := c.label$;
-			f(StdCFrames.Frame).Update
-		END
-	END Update;
-	
-
-	(* Field *)
-
-	PROCEDURE LongToString (x: LONGINT; OUT s: ARRAY OF CHAR);
-		VAR d: ARRAY 24 OF CHAR; i, j: INTEGER;
-	BEGIN
-		IF x = MIN(LONGINT) THEN
-			s := "-9223372036854775808"
-		ELSE
-			i := 0; j := 0;
-			IF x < 0 THEN s[0] := "-"; i := 1; x := -x END;
-			REPEAT d[j] := CHR(x MOD 10 + ORD("0")); INC(j); x := x DIV 10 UNTIL x = 0;
-			WHILE j > 0 DO DEC(j); s[i] := d[j]; INC(i) END;
-			s[i] := 0X
-		END
-	END LongToString;
-
-	PROCEDURE StringToLong (IN s: ARRAY OF CHAR; OUT x: LONGINT; OUT res: INTEGER);
-		VAR i, sign, d: INTEGER;
-	BEGIN
-		i := 0; sign := 1; x := 0; res := 0;
-		WHILE s[i] = " " DO INC(i) END;
-		IF s[i] = "-" THEN sign := -1; INC(i) END;
-		WHILE s[i] = " " DO INC(i) END;
-		IF s[i] = 0X THEN res := 2 END;
-		WHILE (s[i] >= "0") & (s[i] <= "9") DO
-			d := ORD(s[i]) - ORD("0"); INC(i);
-			IF x <= (MAX(LONGINT) - d) DIV 10 THEN x := 10 * x + d
-			ELSE res := 1
-			END
-		END;
-		x := x * sign;
-		IF s[i] # 0X THEN res := 2 END
-	END StringToLong;
-
-	PROCEDURE FixToInt (fix: ARRAY OF CHAR; OUT int: ARRAY OF CHAR; scale: INTEGER);
-		VAR i, j: INTEGER;
-	BEGIN
-		IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
-		i := 0; j := 0;
-		WHILE (fix[i] # ".") & (fix[i] # 0X) DO int[j] := fix[i]; INC(i); INC(j) END;
-		IF fix[i] = "." THEN INC(i) END;
-		WHILE (scale > 0) & (fix[i] >= "0") & (fix[i] <= "9") DO int[j] := fix[i]; INC(i); INC(j); DEC(scale) END;
-		WHILE scale > 0 DO int[j] := "0"; INC(j); DEC(scale) END;
-		int[j] := 0X
-	END FixToInt;
-
-	PROCEDURE IntToFix (int: ARRAY OF CHAR; OUT fix: ARRAY OF CHAR; scale: INTEGER);
-		VAR i, j, n: INTEGER;
-	BEGIN
-		IF scale > 24 THEN scale := 24 ELSIF scale < 0 THEN scale := 0 END;
-		n := LEN(int$); i := 0; j := 0;
-		WHILE int[i] < "0" DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
-		IF n > scale THEN
-			WHILE n > scale DO fix[j] := int[i]; INC(i); INC(j); DEC(n) END
-		ELSE
-			fix[j] := "0"; INC(j)
-		END;
-		fix[j] := "."; INC(j);
-		WHILE n < scale DO fix[j] := "0"; INC(j); DEC(scale) END;
-		WHILE n > 0 DO  fix[j] := int[i]; INC(i); INC(j); DEC(n) END;
-		fix[j] := 0X
-	END IntToFix;
-
-	PROCEDURE GetField (f: StdCFrames.Field; OUT x: ARRAY OF CHAR);
-		VAR c: Field; ok: BOOLEAN; b, v: Meta.Item; mod, name: Meta.Name;
-	BEGIN
-		x := "";
-		c := f.view(Field);
-		IF c.item.Valid() THEN
-			IF c.item.typ = Meta.arrTyp THEN
-				c.item.GetStringVal(x, ok)
-			ELSIF c.item.typ IN {Meta.byteTyp, Meta.sIntTyp, Meta.intTyp} THEN
-				Strings.IntToString(c.item.IntVal(), x);
-				IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
-			ELSIF c.item.typ = Meta.longTyp THEN
-				LongToString(c.item.LongVal(), x);
-				IF c.prop.level > 0 THEN IntToFix(x, x, c.prop.level) END
-			ELSIF c.item.typ = Meta.sRealTyp THEN
-				IF c.prop.level <= 0 THEN
-					Strings.RealToStringForm(c.item.RealVal(), 7, 0, c.prop.level, " ", x)
-				ELSE
-					Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
-				END
-			ELSIF c.item.typ = Meta.realTyp THEN
-				IF c.prop.level <= 0 THEN
-					Strings.RealToStringForm(c.item.RealVal(), 16, 0, c.prop.level, " ", x)
-				ELSE
-					Strings.RealToStringForm(c.item.RealVal(), c.prop.level, 0, 1, " ", x)
-				END
-			ELSIF c.item.typ = Meta.recTyp THEN
-				c.item.GetTypeName(mod, name);
-				IF mod = "Dialog" THEN
-					IF name = "Currency" THEN
-						c.item.Lookup("val", v); c.item.Lookup("scale", b);
-						LongToString(v.LongVal(), x); IntToFix(x, x, b.IntVal())
-					ELSE (* Combo *)
-						c.item.Lookup("item", v); (* Combo *)
-						IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
-					END
-				END
-			END
-		ELSE
-			x := c.label$
-		END
-	END GetField;
-
-	PROCEDURE SetField (f: StdCFrames.Field; IN x: ARRAY OF CHAR);
-		VAR c: Field; ok: BOOLEAN; i, res, old: INTEGER; r, or: REAL; b, v: Meta.Item;
-			mod, name: Meta.Name; long, long0: LONGINT;
-			s: ARRAY 1024 OF CHAR;
-	BEGIN
-		c := f.view(Field);
-		IF c.item.Valid() & ~c.readOnly THEN
-			CASE c.item.typ OF
-			| Meta.arrTyp:
-				c.item.GetStringVal(s, ok);
-				IF ~ok OR (s$ # x$) THEN
-					c.item.PutStringVal(x, ok);
-					IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
-				END
-			| Meta.byteTyp:
-				IF x = "" THEN i := 0; res := 0
-				ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
-				ELSE Strings.StringToInt(x, i, res)
-				END;
-				IF (res = 0) & (i >= MIN(BYTE)) & (i <= MAX(BYTE)) THEN
-					old := c.item.IntVal();
-					IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
-				ELSIF x # "-" THEN
-					Dialog.Beep
-				END
-			| Meta.sIntTyp:
-				IF x = "" THEN i := 0; res := 0
-				ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
-				ELSE Strings.StringToInt(x, i, res)
-				END;
-				IF (res = 0) & (i >= MIN(SHORTINT)) & (i <= MAX(SHORTINT)) THEN
-					old := c.item.IntVal();
-					IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
-				ELSIF x # "-" THEN
-					Dialog.Beep
-				END
-			| Meta.intTyp:
-				IF x = "" THEN i := 0; res := 0
-				ELSIF c.prop.level > 0 THEN FixToInt(x, s, c.prop.level); Strings.StringToInt(s, i, res)
-				ELSE Strings.StringToInt(x, i, res)
-				END;
-				IF res = 0 THEN
-					old := c.item.IntVal();
-					IF i # old THEN c.item.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
-				ELSIF x # "-" THEN
-					Dialog.Beep
-				END
-			| Meta.longTyp:
-				IF x = "" THEN long := 0; res := 0
-				ELSE FixToInt(x, s, c.prop.level); StringToLong(s, long, res)
-				END;
-				IF res = 0 THEN
-					long0 := c.item.LongVal();
-					IF long # long0 THEN c.item.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
-				ELSIF x # "-" THEN
-					Dialog.Beep
-				END
-			| Meta.sRealTyp:
-				IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
-				IF (res = 0) & (r >= MIN(SHORTREAL)) & (r <= MAX(SHORTREAL)) THEN
-					or := c.item.RealVal();
-					IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
-				ELSIF x # "-" THEN
-					Dialog.Beep
-				END
-			| Meta.realTyp:
-				IF (x = "") OR (x = "-") THEN r := 0; res := 0 ELSE Strings.StringToReal(x, r, res) END;
-				IF res = 0 THEN
-					or := c.item.RealVal();
-					IF r # or THEN c.item.PutRealVal(r); Notify(c, f, Dialog.changed, 0, 0) END
-				ELSIF x # "-" THEN
-					Dialog.Beep
-				END
-			| Meta.recTyp:
-				c.item.GetTypeName(mod, name);
-				IF mod = "Dialog" THEN
-					IF name = "Currency" THEN
-						c.item.Lookup("val", v); c.item.Lookup("scale", b);
-						IF x = "" THEN long := 0; res := 0
-						ELSE FixToInt(x, s, b.IntVal()); StringToLong(s, long, res)
-						END;
-						IF res = 0 THEN
-							long0 := v.LongVal();
-							IF long # long0 THEN v.PutLongVal(long); Notify(c, f, Dialog.changed, 0, 0) END
-						ELSIF x # "-" THEN
-							Dialog.Beep
-						END
-					ELSE	(* name = "Combo" *)
-						c.item.Lookup("item", v);
-						IF v.typ = Meta.arrTyp THEN
-							v.GetStringVal(s, ok);
-							IF ~ok OR (s$ # x$) THEN
-								v.PutStringVal(x, ok);
-								IF ok THEN Notify(c, f, Dialog.changed, 0, 0) ELSE Dialog.Beep END
-							END
-						END
-					END
-				END
-			END
-		END
-	END SetField;
-
-	PROCEDURE EqualField (f: StdCFrames.Field; IN s1, s2: ARRAY OF CHAR): BOOLEAN;
-		VAR c: Field; i1, i2, res1, res2: INTEGER; r1, r2: REAL; l1, l2: LONGINT;
-			mod, name: Meta.Name; t1, t2: ARRAY 64 OF CHAR; b: Meta.Item;
-	BEGIN
-		c := f.view(Field);
-		CASE c.item.typ OF
-		| Meta.arrTyp:
-			RETURN s1 = s2
-		| Meta.byteTyp, Meta.sIntTyp, Meta.intTyp:
-			IF c.prop.level > 0 THEN
-				FixToInt(s1, t1, c.prop.level); Strings.StringToInt(t1, i1, res1);
-				FixToInt(s2, t2, c.prop.level); Strings.StringToInt(t2, i2, res2)
-			ELSE
-				Strings.StringToInt(s1, i1, res1);
-				Strings.StringToInt(s2, i2, res2)
-			END;
-			RETURN (res1 = 0) & (res2 = 0) & (i1 = i2) 
-		| Meta.longTyp:
-			IF c.prop.level > 0 THEN
-				FixToInt(s1, t1, c.prop.level); StringToLong(t1, l1, res1);
-				FixToInt(s2, t2, c.prop.level); StringToLong(t2, l2, res2)
-			ELSE
-				StringToLong(s1, l1, res1);
-				StringToLong(s2, l2, res2)
-			END;
-			RETURN (res1 = 0) & (res2 = 0) & (l1 = l2) 
-		| Meta.sRealTyp, Meta.realTyp:
-			Strings.StringToReal(s1, r1, res1);
-			Strings.StringToReal(s2, r2, res2);
-			RETURN (res1 = 0) & (res2 = 0) & (r1 = r2) 
-		| Meta.recTyp:
-			c.item.GetTypeName(mod, name);
-			IF mod = "Dialog" THEN
-				IF name = "Currency" THEN
-					c.item.Lookup("scale", b); i1 := b.IntVal();
-					FixToInt(s1, t1, i1); StringToLong(t1, l1, res1);
-					FixToInt(s2, t2, i1); StringToLong(t2, l2, res2);
-					RETURN (res1 = 0) & (res2 = 0) & (l1 =l2)
-				ELSE (* name = "Combo" *)
-					RETURN s1 = s2
-				END
-			END
-		ELSE RETURN s1 = s2
-		END
-	END EqualField;
-
-	PROCEDURE (c: Field) CopyFromSimpleView2 (source: Control);
-	BEGIN
-		WITH source: Field DO c.maxLen := source.maxLen END
-	END CopyFromSimpleView2;
-
-	PROCEDURE (c: Field) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, fldVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: Field) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(fldVersion)
-	END Externalize2;
-
-	PROCEDURE (c: Field) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.Field;
-	BEGIN
-		f := StdCFrames.dir.NewField();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.maxLen := c.maxLen;
-		f.left := c.prop.opt[left];
-		f.right := c.prop.opt[right];
-		f.multiLine := c.prop.opt[multiLine];
-		f.password := c.prop.opt[password];
-		f.Get := GetField;
-		f.Set := SetField;
-		f.Equal := EqualField;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: Field) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: Field) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-		VAR ch: CHAR; mod, name: Meta.Name;
-	BEGIN
-		WITH f: StdCFrames.Field DO
-			IF ~c.disabled & ~c.readOnly THEN
-				WITH msg: Controllers.PollOpsMsg DO
-					msg.selectable := TRUE;
-					(* should ask Frame if there is a selection for cut or copy! *)
-					msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
-				| msg: Controllers.TickMsg DO
-					f.Idle
-				| msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN
-						ch := msg.char;
-						IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
-							OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
-							OR (c.item.typ = Meta.arrTyp)
-							OR (c.item.typ IN {Meta.sRealTyp, Meta.realTyp}) & ((ch = ".") OR (ch = "E"))
-							OR (c.prop.level > 0) & (ch = ".")
-							THEN f.KeyDown(ch)
-						ELSIF c.item.typ = Meta.recTyp THEN
-							c.item.GetTypeName(mod, name);
-							IF (mod = "Dialog") & (name = "Combo") OR (ch = ".") THEN
-								f.KeyDown(ch)
-							ELSE Dialog.Beep
-							END
-						ELSE Dialog.Beep
-						END
-					ELSE
-						f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
-					END
-				| msg: Controllers.SelectMsg DO
-					IF msg.set THEN f.Select(0, MAX(INTEGER))
-					ELSE f.Select(-1, -1)
-					END
-				| msg: Controllers.MarkMsg DO
-					f.Mark(msg.show, msg.focus);
-					IF ~msg.show & msg.focus THEN f.Update END;
-					IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			ELSIF ~c.disabled THEN
-				WITH msg: Controllers.TrackMsg DO
-					f.MouseDown(msg.x, msg.y, msg.modifiers)
-				ELSE
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: Field) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF msg.char = lineChar THEN msg.accepts := c.prop.opt[multiLine] & (msg.focus = c)
-			ELSIF msg.char = esc THEN msg.accepts := FALSE
-			END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			ELSIF~c.disabled THEN
-				msg.hotFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetFieldSize(c.maxLen, msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, level, notifier, left, right, multiLine, password}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: Field) CheckLink (VAR ok: BOOLEAN);
-		VAR t: INTEGER; name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name); t := c.item.typ;
-		IF (t = Meta.arrTyp) & (c.item.BaseTyp() = Meta.charTyp) THEN c.maxLen := SHORT(c.item.Len() - 1)
-		ELSIF t = Meta.byteTyp THEN c.maxLen := 6
-		ELSIF t = Meta.sIntTyp THEN c.maxLen := 9
-		ELSIF t = Meta.intTyp THEN c.maxLen := 13
-		ELSIF t = Meta.longTyp THEN c.maxLen := 24
-		ELSIF t = Meta.sRealTyp THEN c.maxLen := 16
-		ELSIF t = Meta.realTyp THEN c.maxLen := 24
-		ELSIF name = "Combo" THEN c.maxLen := 64
-		ELSIF name = "Currency" THEN c.maxLen := 16
-		ELSE ok := FALSE
-		END
-	END CheckLink;
-
-	PROCEDURE (c: Field) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* UpDownField *)
-
-	PROCEDURE GetUpDownField (f: StdCFrames.UpDownField; OUT val: INTEGER);
-		VAR c: UpDownField;
-	BEGIN
-		val := 0;
-		c := f.view(UpDownField);
-		IF c.item.Valid() THEN val := c.item.IntVal() END
-	END GetUpDownField;
-
-	PROCEDURE SetUpDownField (f: StdCFrames.UpDownField; val: INTEGER);
-		VAR c: UpDownField; old: INTEGER;
-	BEGIN
-		c := f.view(UpDownField);
-		IF c.item.Valid() & ~c.readOnly THEN
-			IF (val >= c.min) & (val <= c.max) THEN
-				old := c.item.IntVal();
-				IF old # val THEN c.item.PutIntVal(val); Notify(c, f, Dialog.changed, old, val) END
-			ELSE Dialog.Beep
-			END
-		END
-	END SetUpDownField;
-	
-	PROCEDURE (c: UpDownField) CopyFromSimpleView2 (source: Control);
-	BEGIN
-		WITH source: UpDownField DO
-			c.min := source.min;
-			c.max := source.max;
-			c.inc := source.inc
-		END
-	END CopyFromSimpleView2;
-
-	PROCEDURE (c: UpDownField) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, fldVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: UpDownField) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(fldVersion)
-	END Externalize2;
-
-	PROCEDURE (c: UpDownField) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.UpDownField;
-	BEGIN
-		f := StdCFrames.dir.NewUpDownField();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.min := c.min;
-		f.max := c.max;
-		f.inc := c.inc;
-		f.Get := GetUpDownField;
-		f.Set := SetUpDownField;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: UpDownField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: UpDownField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-		VAR ch: CHAR;
-	BEGIN
-		IF ~c.disabled & ~c.readOnly THEN
-			WITH f: StdCFrames.UpDownField DO
-				WITH msg: Controllers.PollOpsMsg DO
-					msg.selectable := TRUE;
-					(* should ask view if there is a selection for cut or copy! *)
-					msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
-				| msg: Controllers.TickMsg DO
-					f.Idle
-				| msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN
-						ch := msg.char;
-						IF (ch = ldel) OR (ch = rdel) OR (ch >= 10X) & (ch <= 1FX)
-							OR ("0" <= ch) & (ch <= "9") OR (ch = "+") OR (ch = "-")
-							OR (c.item.typ = Meta.arrTyp)
-							THEN f.KeyDown(ch)
-						ELSE Dialog.Beep
-						END
-					ELSE
-						f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
-					END
-				| msg: Controllers.SelectMsg DO
-					IF msg.set THEN f.Select(0, MAX(INTEGER))
-					ELSE f.Select(-1, -1)
-					END
-				| msg: Controllers.MarkMsg DO
-					f.Mark(msg.show, msg.focus);
-					IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: UpDownField) HandlePropMsg2 (VAR msg: Properties.Message);
-		VAR m: INTEGER; n: INTEGER;
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			m := -c.min;
-			IF c.max > m THEN m := c.max END;
-			n := 3;
-			WHILE m > 99 DO INC(n); m := m DIV 10 END;
-			StdCFrames.dir.GetUpDownFieldSize(n, msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: UpDownField) CheckLink (VAR ok: BOOLEAN);
-	BEGIN
-		IF c.item.typ = Meta.byteTyp THEN c.min := MIN(BYTE); c.max := MAX(BYTE)
-		ELSIF c.item.typ = Meta.sIntTyp THEN c.min := MIN(SHORTINT); c.max := MAX(SHORTINT)
-		ELSIF c.item.typ = Meta.intTyp THEN c.min := MIN(INTEGER); c.max := MAX(INTEGER)
-		ELSE ok := FALSE
-		END;
-		c.inc := 1
-	END CheckLink;
-
-	PROCEDURE (c: UpDownField) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* DateField *)
-
-	PROCEDURE GetDateField (f: StdCFrames.DateField; OUT date: Dates.Date);
-		VAR c: DateField; v: Meta.Item;
-	BEGIN
-		date.year := 1; date.month := 1; date.day := 1;
-		c := f.view(DateField);
-		IF c.item.Valid() THEN
-			c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN date.year := SHORT(v.IntVal()) END;
-			c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN date.month := SHORT(v.IntVal()) END;
-			c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN date.day := SHORT(v.IntVal()) END
-		END
-	END GetDateField;
-	
-	PROCEDURE SetDateField(f:  StdCFrames.DateField; IN date: Dates.Date);
-		VAR c: DateField; v: Meta.Item;
-	BEGIN
-		c := f.view(DateField);
-		IF c.item.Valid() & ~c.readOnly THEN
-			c.item.Lookup("year", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.year) END;
-			c.item.Lookup("month", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.month) END;
-			c.item.Lookup("day", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.day) END;
-			Notify(c, f, Dialog.changed, 0, 0)
-		END
-	END SetDateField;
-	
-	PROCEDURE GetDateFieldSelection (f: StdCFrames.DateField; OUT sel: INTEGER);
-	BEGIN
-		sel := f.view(DateField).selection
-	END GetDateFieldSelection;
-	
-	PROCEDURE SetDateFieldSelection (f: StdCFrames.DateField; sel: INTEGER);
-	BEGIN
-		f.view(DateField).selection := sel
-	END SetDateFieldSelection;
-	
-	PROCEDURE (c: DateField) CopyFromSimpleView2 (source: Control);
-	BEGIN
-		WITH source: DateField DO c.selection := source.selection END
-	END CopyFromSimpleView2;
-
-	PROCEDURE (c: DateField) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, dfldVersion, thisVersion);
-		c.selection := 0
-	END Internalize2;
-
-	PROCEDURE (c: DateField) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(dfldVersion)
-	END Externalize2;
-
-	PROCEDURE (c: DateField) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.DateField;
-	BEGIN
-		f := StdCFrames.dir.NewDateField();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.Get := GetDateField;
-		f.Set := SetDateField;
-		f.GetSel := GetDateFieldSelection;
-		f.SetSel := SetDateFieldSelection;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: DateField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: DateField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled & ~c.readOnly THEN
-			WITH f: StdCFrames.DateField DO
-				WITH msg: Controllers.PollOpsMsg DO
-					msg.valid := {Controllers.pasteChar, Controllers.copy}
-				| msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN
-						f.KeyDown(msg.char)
-					ELSE
-						f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
-					END
-				| msg: Controllers.TickMsg DO
-					IF f.mark THEN
-						IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
-					END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: DateField) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN
-				msg.accepts := FALSE
-			ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
-				msg.accepts := ((msg.focus # c) & (~c.disabled & ~c.readOnly)) OR 
-					(msg.focus = c) & ((msg.char = tab) & (c.selection # -1) OR (msg.char = ltab) & (c.selection # 1));
-				msg.getFocus := msg.accepts
-			END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetDateFieldSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: DateField) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := name = "Date"
-	END CheckLink;
-
-	PROCEDURE (c: DateField) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* TimeField *)
-
-	PROCEDURE GetTimeField (f: StdCFrames.TimeField; OUT time: Dates.Time);
-		VAR c: TimeField; v: Meta.Item;
-	BEGIN
-		time.hour := 0; time.minute := 0; time.second := 0;
-		c := f.view(TimeField);
-		IF c.item.Valid() THEN
-			c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN time.hour := SHORT(v.IntVal()) END;
-			c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN time.minute := SHORT(v.IntVal()) END;
-			c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN time.second := SHORT(v.IntVal()) END
-		END
-	END GetTimeField;
-	
-	PROCEDURE SetTimeField(f:  StdCFrames.TimeField; IN date: Dates.Time);
-		VAR c: TimeField; v: Meta.Item;
-	BEGIN
-		c := f.view(TimeField);
-		IF c.item.Valid() & ~c.readOnly THEN
-			c.item.Lookup("hour", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.hour) END;
-			c.item.Lookup("minute", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.minute) END;
-			c.item.Lookup("second", v); IF v.typ = Meta.intTyp THEN v.PutIntVal(date.second) END;
-			Notify(c, f, Dialog.changed, 0, 0)
-		END
-	END SetTimeField;
-	
-	PROCEDURE GetTimeFieldSelection (f: StdCFrames.TimeField; OUT sel: INTEGER);
-	BEGIN
-		sel := f.view(TimeField).selection
-	END GetTimeFieldSelection;
-	
-	PROCEDURE SetTimeFieldSelection (f: StdCFrames.TimeField; sel: INTEGER);
-	BEGIN
-		f.view(TimeField).selection := sel
-	END SetTimeFieldSelection;
-	
-	PROCEDURE (c: TimeField) CopyFromSimpleView2 (source: Control);
-	BEGIN
-		WITH source: TimeField DO c.selection := source.selection END
-	END CopyFromSimpleView2;
-
-	PROCEDURE (c: TimeField) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, tfldVersion, thisVersion);
-		c.selection := 0
-	END Internalize2;
-
-	PROCEDURE (c: TimeField) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(tfldVersion)
-	END Externalize2;
-
-	PROCEDURE (c: TimeField) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.TimeField;
-	BEGIN
-		f := StdCFrames.dir.NewTimeField();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.Get := GetTimeField;
-		f.Set := SetTimeField;
-		f.GetSel := GetTimeFieldSelection;
-		f.SetSel := SetTimeFieldSelection;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: TimeField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: TimeField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled & ~c.readOnly THEN
-			WITH f: StdCFrames.TimeField DO
-				WITH msg: Controllers.PollOpsMsg DO
-					msg.valid := {Controllers.pasteChar, Controllers.copy}
-				| msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN
-						f.KeyDown(msg.char)
-					ELSE
-						f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
-					END
-				| msg: Controllers.TickMsg DO
-					IF f.mark THEN
-						IF c.selection = 0 THEN c.selection := 1; Views.Update(c, Views.keepFrames) END
-					END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: TimeField) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN
-				msg.accepts := FALSE
-			ELSIF (msg.char = tab) OR (msg.char = ltab) THEN
-				msg.accepts := (msg.focus # c) OR 
-					((msg.char = tab) & (c.selection # -1)) OR ((msg.char = ltab) & (c.selection # 1))
-			END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetTimeFieldSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: TimeField) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := name = "Time"
-	END CheckLink;
-
-	PROCEDURE (c: TimeField) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* ColorField *)
-
-	PROCEDURE GetColorField (f: StdCFrames.ColorField; OUT col: INTEGER);
-		VAR c: ColorField; v: Meta.Item;
-	BEGIN
-		col := Ports.defaultColor;
-		c := f.view(ColorField);
-		IF c.item.Valid() THEN
-			IF c.item.typ = Meta.intTyp THEN
-				col := c.item.IntVal()
-			ELSE
-				c.item.Lookup("val", v); IF v.typ = Meta.intTyp THEN col := v.IntVal() END
-			END
-		END
-	END GetColorField;
-	
-	PROCEDURE SetColorField(f:  StdCFrames.ColorField; col: INTEGER);
-		VAR c: ColorField; v: Meta.Item; old: INTEGER;
-	BEGIN
-		c := f.view(ColorField);
-		IF c.item.Valid() & ~c.readOnly THEN
-			IF c.item.typ = Meta.intTyp THEN
-				old := c.item.IntVal();
-				IF old # col THEN c.item.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
-			ELSE
-				c.item.Lookup("val", v); 
-				IF v.typ = Meta.intTyp THEN 
-					old := v.IntVal();
-					IF old # col THEN v.PutIntVal(col); Notify(c, f, Dialog.changed, old, col) END
-				END
-			END
-		END
-	END SetColorField;
-	
-	PROCEDURE (c: ColorField) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, cfldVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: ColorField) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(cfldVersion)
-	END Externalize2;
-
-	PROCEDURE (c: ColorField) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.ColorField;
-	BEGIN
-		f := StdCFrames.dir.NewColorField();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.Get := GetColorField;
-		f.Set := SetColorField;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: ColorField) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: ColorField) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-	BEGIN
-		IF ~c.disabled & ~c.readOnly THEN
-			WITH f: StdCFrames.ColorField DO
-				WITH msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN
-						f.KeyDown(msg.char)
-					ELSE
-						f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
-					END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: ColorField) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			msg.accepts := ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c)
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.hotFocus := TRUE; msg.setFocus := StdCFrames.setFocus
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetColorFieldSize(msg.w, msg.h)
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: ColorField) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := (name = "Color") OR (c.item.typ = Meta.intTyp)
-	END CheckLink;
-
-	PROCEDURE (c: ColorField) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* ListBox *)
-
-	PROCEDURE GetListBox (f: StdCFrames.ListBox; OUT i: INTEGER);
-		VAR c: ListBox; v: Meta.Item;
-	BEGIN
-		i := -1;
-		c := f.view(ListBox);
-		IF c.item.Valid() THEN
-			c.item.Lookup("index", v);
-			IF v.typ = Meta.intTyp THEN i := v.IntVal() END
-		END
-	END GetListBox;
-
-	PROCEDURE SetListBox (f: StdCFrames.ListBox; i: INTEGER);
-		VAR c: ListBox; v: Meta.Item; old: INTEGER;
-	BEGIN
-		c := f.view(ListBox);
-		IF c.item.Valid() & ~c.readOnly THEN
-			c.item.Lookup("index", v);
-			IF v.typ = Meta.intTyp THEN
-				old := v.IntVal();
-				IF i # old THEN v.PutIntVal(i); Notify(c, f, Dialog.changed, old, i) END
-			END
-		END
-	END SetListBox;
-	
-	PROCEDURE GetFName (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: Param DO
-			WITH rec: Dialog.List DO rec.GetItem(par.i, par.n)
-			| rec: Dialog.Selection DO rec.GetItem(par.i, par.n)
-			| rec: Dialog.Combo DO rec.GetItem(par.i, par.n)
-			ELSE par.n := ""
-			END
-		END
-	END GetFName;
-	
-	PROCEDURE GetListName (f: StdCFrames.ListBox; i: INTEGER; VAR name: ARRAY OF CHAR);
-		VAR c: ListBox; par: Param;
-	BEGIN
-		par.n := "";
-		c := f.view(ListBox);
-		IF c.item.Valid() THEN
-			par.i := i;
-			c.item.CallWith(GetFName, par)
-		END;
-		name := par.n$
-	END GetListName;
-
-	PROCEDURE (c: ListBox) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, lbxVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: ListBox) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(lbxVersion)
-	END Externalize2;
-
-	PROCEDURE (c: ListBox) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.ListBox;
-	BEGIN
-		f := StdCFrames.dir.NewListBox();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.sorted := c.prop.opt[sorted];
-		f.Get := GetListBox;
-		f.Set := SetListBox;
-		f.GetName := GetListName;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: ListBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: ListBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																		VAR focus: Views.View);
-	BEGIN
-		WITH f: StdCFrames.ListBox DO
-			IF ~c.disabled & ~c.readOnly THEN
-				WITH msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			ELSIF ~c.disabled THEN
-				WITH msg: Controllers.TrackMsg DO
-					f.MouseDown(msg.x, msg.y, msg.modifiers)
-				ELSE
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: ListBox) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			ELSIF~c.disabled THEN
-				msg.hotFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetListBoxSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, sorted}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: ListBox) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := name = "List"
-	END CheckLink;
-
-	PROCEDURE (c: ListBox) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-	PROCEDURE (c: ListBox) UpdateList (f: Views.Frame);
-	BEGIN
-		f(StdCFrames.Frame).UpdateList
-	END UpdateList;
-	
-
-	(* SelectionBox *)
-
-	PROCEDURE InLargeSet (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: Param DO
-			WITH rec: Dialog.Selection DO
-				IF rec.In(par.i) THEN par.i := 1 ELSE par.i := 0 END
-			ELSE par.i := 0
-			END
-		END
-	END InLargeSet;
-	
-	PROCEDURE GetSelectionBox (f: StdCFrames.SelectionBox; i: INTEGER; OUT in: BOOLEAN);
-		VAR c: SelectionBox; lv: SelectValue; par: Param;
-	BEGIN
-		in := FALSE;
-		c := f.view(SelectionBox);
-		IF c.item.Valid() THEN
-			IF c.item.Is(lv) THEN
-				par.i := i;
-				c.item.CallWith(InLargeSet, par);
-				in := par.i # 0
-			END
-		END
-	END GetSelectionBox;
-
-	PROCEDURE InclLargeSet (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: Param DO
-			WITH rec: Dialog.Selection DO
-				IF (par.from # par.to) OR ~rec.In(par.from) THEN
-					rec.Incl(par.from, par.to); par.i := 1
-				ELSE par.i := 0
-				END
-			ELSE par.i := 0
-			END
-		END
-	END InclLargeSet;
-	
-	PROCEDURE InclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
-		VAR c: SelectionBox; lv: SelectValue; par: Param;
-	BEGIN
-		c := f.view(SelectionBox);
-		IF c.item.Valid() & ~c.readOnly THEN
-			IF c.item.Is(lv) THEN
-				par.from := from; par.to := to;
-				c.item.CallWith(InclLargeSet, par);
-				IF par.i # 0 THEN Notify(c, f, Dialog.included, from, to) END
-			END
-		END
-	END InclSelectionBox;
-	
-	PROCEDURE ExclLargeSet (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: Param DO
-			WITH rec: Dialog.Selection DO
-				IF (par.from # par.to) OR rec.In(par.from) THEN
-					rec.Excl(par.from, par.to); par.i := 1
-				ELSE par.i := 0
-				END
-			ELSE par.i := 0
-			END
-		END
-	END ExclLargeSet;
-	
-	PROCEDURE ExclSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
-		VAR c: SelectionBox; lv: SelectValue; par: Param;
-	BEGIN
-		c := f.view(SelectionBox);
-		IF c.item.Valid() & ~c.readOnly THEN
-			IF c.item.Is(lv) THEN
-				par.from := from; par.to := to;
-				c.item.CallWith(ExclLargeSet, par);
-				IF par.i # 0 THEN Notify(c, f, Dialog.excluded, from, to) END
-			END
-		END
-	END ExclSelectionBox;
-	
-	PROCEDURE SetSelectionBox (f: StdCFrames.SelectionBox; from, to: INTEGER);
-		VAR c: SelectionBox; lv: SelectValue; par: Param;
-	BEGIN
-		c := f.view(SelectionBox);
-		IF c.item.Valid() & ~c.readOnly THEN
-			IF c.item.Is(lv) THEN
-				par.from := 0; par.to := MAX(INTEGER);
-				c.item.CallWith(ExclLargeSet, par);
-				par.from := from; par.to := to;
-				c.item.CallWith(InclLargeSet, par);
-				Notify(c, f, Dialog.set, from, to)
-			END
-		END
-	END SetSelectionBox;
-	
-	PROCEDURE GetSelName (f: StdCFrames.SelectionBox; i: INTEGER; VAR name: ARRAY OF CHAR);
-		VAR c: SelectionBox; par: Param;
-	BEGIN
-		par.n := "";
-		c := f.view(SelectionBox);
-		IF c.item.Valid() THEN
-			par.i := i;
-			c.item.CallWith(GetFName, par)
-		END;
-		name := par.n$
-	END GetSelName;
-
-	PROCEDURE (c: SelectionBox) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, sbxVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: SelectionBox) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(sbxVersion)
-	END Externalize2;
-
-	PROCEDURE (c: SelectionBox) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.SelectionBox;
-	BEGIN
-		f := StdCFrames.dir.NewSelectionBox();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.sorted := c.prop.opt[sorted];
-		f.Get := GetSelectionBox;
-		f.Incl := InclSelectionBox;
-		f.Excl := ExclSelectionBox;
-		f.Set := SetSelectionBox;
-		f.GetName := GetSelName;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: SelectionBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: SelectionBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																				VAR focus: Views.View);
-	BEGIN
-		WITH f: StdCFrames.SelectionBox DO
-			IF ~c.disabled & ~c.readOnly THEN
-				WITH msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN f.KeyDown(msg.char) END
-				| msg: Controllers.SelectMsg DO
-					IF msg.set THEN f.Select(0, MAX(INTEGER))
-					ELSE f.Select(-1, -1)
-					END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			ELSIF ~c.disabled THEN
-				WITH msg: Controllers.TrackMsg DO
-					f.MouseDown(msg.x, msg.y, msg.modifiers)
-				ELSE
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: SelectionBox) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
-				msg.getFocus := StdCFrames.setFocus
-			END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			ELSIF~c.disabled THEN
-				msg.hotFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetSelectionBoxSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, sorted}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: SelectionBox) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := name = "Selection"
-	END CheckLink;
-
-	PROCEDURE (c: SelectionBox) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		IF (op >= Dialog.included) & (op <= Dialog.set) THEN
-			f(StdCFrames.SelectionBox).UpdateRange(op, from, to)
-		ELSE
-			f(StdCFrames.Frame).Update
-		END
-	END Update;
-	
-	PROCEDURE (c: SelectionBox) UpdateList (f: Views.Frame);
-	BEGIN
-		f(StdCFrames.Frame).UpdateList
-	END UpdateList;
-	
-
-	(* ComboBox *)
-
-	PROCEDURE GetComboBox (f: StdCFrames.ComboBox; OUT x: ARRAY OF CHAR);
-		VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item;
-	BEGIN
-		x := "";
-		c := f.view(ComboBox);
-		IF c.item.Valid() THEN
-			c.item.Lookup("item", v);
-			IF v.typ = Meta.arrTyp THEN v.GetStringVal(x, ok) END
-		END
-	END GetComboBox;
-
-	PROCEDURE SetComboBox (f: StdCFrames.ComboBox; IN x: ARRAY OF CHAR);
-		VAR c: ComboBox; ok: BOOLEAN; v: Meta.Item; s: ARRAY 1024 OF CHAR;
-	BEGIN
-		c := f.view(ComboBox);
-		IF c.item.Valid() & ~c.readOnly THEN
-			c.item.Lookup("item", v);
-			IF v.typ = Meta.arrTyp THEN
-				v.GetStringVal(s, ok);
-				IF ~ok OR (s$ # x$) THEN
-					v.PutStringVal(x, ok);
-					IF ok THEN Notify(c, f, Dialog.changed, 0, 0) END
-				END
-			END
-		END
-	END SetComboBox;
-
-	PROCEDURE GetComboName (f: StdCFrames.ComboBox; i: INTEGER; VAR name: ARRAY OF CHAR);
-		VAR c: ComboBox; par: Param;
-	BEGIN
-		par.n := "";
-		c := f.view(ComboBox);
-		IF c.item.Valid() THEN
-			par.i := i;
-			c.item.CallWith(GetFName, par)
-		END;
-		name := par.n$
-	END GetComboName;
-
-	PROCEDURE (c: ComboBox) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, cbxVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: ComboBox) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(cbxVersion)
-	END Externalize2;
-
-	PROCEDURE (c: ComboBox) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.ComboBox;
-	BEGIN
-		f := StdCFrames.dir.NewComboBox();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.sorted := c.prop.opt[sorted];
-		f.Get := GetComboBox;
-		f.Set := SetComboBox;
-		f.GetName := GetComboName;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: ComboBox) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: ComboBox) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																			VAR focus: Views.View);
-	BEGIN
-		WITH f: StdCFrames.ComboBox DO
-			IF ~c.disabled & ~c.readOnly THEN
-				WITH msg: Controllers.PollOpsMsg DO
-					msg.selectable := TRUE;
-					(* should ask Frame if there is a selection for cut or copy! *)
-					msg.valid := {Controllers.pasteChar, Controllers.cut, Controllers.copy, Controllers.paste}
-				| msg: Controllers.TickMsg DO
-					f.Idle
-				| msg: Controllers.EditMsg DO
-					IF msg.op = Controllers.pasteChar THEN
-						f.KeyDown(msg.char)
-					ELSE
-						f.Edit(msg.op, msg.view, msg.w, msg.h, msg.isSingle, msg.clipboard)
-					END
-				| msg: Controllers.SelectMsg DO
-					IF msg.set THEN f.Select(0, MAX(INTEGER))
-					ELSE f.Select(-1, -1)
-					END
-				| msg: Controllers.MarkMsg DO
-					f.Mark(msg.show, msg.focus);
-					IF msg.show & msg.focus THEN f.Select(0, MAX(INTEGER)) END
-				| msg: Controllers.TrackMsg DO
-					f.MouseDown(msg.x, msg.y, msg.modifiers)
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: ComboBox) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) THEN msg.getFocus := TRUE END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetComboBoxSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, sorted}
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: ComboBox) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := name = "Combo"
-	END CheckLink;
-
-	PROCEDURE (c: ComboBox) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-	PROCEDURE (c: ComboBox) UpdateList (f: Views.Frame);
-	BEGIN
-		f(StdCFrames.Frame).UpdateList
-	END UpdateList;
-	
-
-	(* Caption *)
-
-	PROCEDURE (c: Caption) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, capVersion, thisVersion);
-		IF thisVersion < 1 THEN c.prop.opt[left] := TRUE END
-	END Internalize2;
-
-	PROCEDURE (c: Caption) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		(* Save old version for captions that are compatible with the old version *)
-		IF c.prop.opt[left] THEN wr.WriteVersion(0) ELSE wr.WriteVersion(capVersion) END
-	END Externalize2;
-
-	PROCEDURE (c: Caption) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.Caption;
-	BEGIN
-		f := StdCFrames.dir.NewCaption();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.label := c.label$;
-		f.left := c.prop.opt[left];
-		f.right := c.prop.opt[right];
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: Caption) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: Caption) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.SizePref DO
-			StdCFrames.dir.GetCaptionSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, left, right}
-		| msg: DefaultsPref DO
-			IF c.prop.link = "" THEN msg.disabled := FALSE END
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: Caption) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Caption).label := c.label$;
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* Group *)
-
-	PROCEDURE (c: Group) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, grpVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: Group) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(grpVersion)
-	END Externalize2;
-
-	PROCEDURE (c: Group) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.Group;
-	BEGIN
-		f := StdCFrames.dir.NewGroup();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.label := c.label$;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: Group) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-
-	PROCEDURE (c: Group) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN
-		WITH msg: Properties.SizePref DO
-			StdCFrames.dir.GetGroupSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard}
-		| msg: DefaultsPref DO
-			IF c.prop.link = "" THEN msg.disabled := FALSE END
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: Group) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Group).label := c.label$;
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-	
-	(* TreeControl *)
-	
-	PROCEDURE (c: TreeControl) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, tfVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (c: TreeControl) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(tfVersion)
-	END Externalize2;
-
-	PROCEDURE TVNofNodesF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			WITH rec: Dialog.Tree DO par.l := rec.NofNodes()
-			ELSE par.l := 0
-			END
-		END
-	END TVNofNodesF;
-	
-	PROCEDURE TVNofNodes (f: StdCFrames.TreeFrame): INTEGER;
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.l := 0;
-		IF c.item.Valid() THEN c.item.CallWith(TVNofNodesF, par) END;
-		RETURN par.l
-	END TVNofNodes;
-	
-	PROCEDURE TVChildF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			WITH rec: Dialog.Tree DO par.nodeOut := rec.Child(par.nodeIn, Dialog.firstPos)
-			ELSE par.nodeOut := NIL
-			END
-		END
-	END TVChildF;
-	
-	PROCEDURE TVChild (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
-		IF c.item.Valid() THEN c.item.CallWith(TVChildF, par) END;
-		RETURN par.nodeOut
-	END TVChild;
-	
-	PROCEDURE TVParentF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			WITH rec: Dialog.Tree DO par.nodeOut := rec.Parent(par.nodeIn)
-			ELSE par.nodeOut := NIL
-			END
-		END
-	END TVParentF;
-	
-	PROCEDURE TVParent (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
-		IF c.item.Valid() THEN c.item.CallWith(TVParentF, par) END;
-		RETURN par.nodeOut
-	END TVParent;
-	
-	PROCEDURE TVNextF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			WITH rec: Dialog.Tree DO par.nodeOut := rec.Next(par.nodeIn)
-			ELSE par.nodeOut := NIL
-			END
-		END
-	END TVNextF;
-	
-	PROCEDURE TVNext (f: StdCFrames.TreeFrame; node: Dialog.TreeNode): Dialog.TreeNode;
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.nodeIn := node; par.nodeOut := NIL;
-		IF c.item.Valid() THEN c.item.CallWith(TVNextF, par) END;
-		RETURN par.nodeOut
-	END TVNext;
-	
-	PROCEDURE TVSelectF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			WITH rec: Dialog.Tree DO rec.Select(par.nodeIn) END
-		END
-	END TVSelectF;
-	
-	PROCEDURE TVSelect (f: StdCFrames.TreeFrame; node: Dialog.TreeNode);
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.nodeIn := node;
-		IF c.item.Valid() THEN 
-			c.item.CallWith(TVSelectF, par);
-			Notify(c, f, Dialog.changed, 0, 0)
-		END
-	END TVSelect;
-	
-	PROCEDURE TVSelectedF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			WITH rec: Dialog.Tree DO par.nodeOut := rec.Selected()
-			ELSE par.nodeOut := NIL
-			END
-		END
-	END TVSelectedF;
-	
-	PROCEDURE TVSelected (f: StdCFrames.TreeFrame): Dialog.TreeNode;
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.nodeOut := NIL;
-		IF c.item.Valid() THEN c.item.CallWith(TVSelectedF, par) END;
-		RETURN par.nodeOut
-	END TVSelected;
-	
-	PROCEDURE TVSetExpansionF (VAR rec, par: ANYREC);
-	BEGIN
-		WITH par: TVParam DO 
-			par.nodeIn.SetExpansion(par.e)
-		END
-	END TVSetExpansionF;
-	
-	PROCEDURE TVSetExpansion (f: StdCFrames.TreeFrame; tn: Dialog.TreeNode; expanded: BOOLEAN);
-		VAR c: TreeControl; par: TVParam;
-	BEGIN
-		c := f.view(TreeControl); par.e := expanded; par.nodeIn := tn;
-		IF c.item.Valid() THEN c.item.CallWith(TVSetExpansionF, par) END
-	END TVSetExpansion;
-
-	PROCEDURE (c: TreeControl) GetNewFrame (VAR frame: Views.Frame);
-		VAR f: StdCFrames.TreeFrame;
-	BEGIN
-		f := StdCFrames.dir.NewTreeFrame();
-		f.disabled := c.disabled;
-		f.undef := c.undef;
-		f.readOnly := c.readOnly;
-		f.font := c.font;
-		f.sorted := c.prop.opt[sorted];
-		f.haslines := c.prop.opt[haslines];
-		f.hasbuttons := c.prop.opt[hasbuttons];
-		f.atroot := c.prop.opt[atroot];
-		f.foldericons := c.prop.opt[foldericons];
-		f.NofNodes := TVNofNodes;
-		f.Child := TVChild;
-		f.Parent := TVParent;
-		f.Next := TVNext;
-		f.Select := TVSelect;
-		f.Selected := TVSelected;
-		f.SetExpansion := TVSetExpansion;
-		frame := f
-	END GetNewFrame;
-
-	PROCEDURE (c: TreeControl) UpdateList (f: Views.Frame);
-	BEGIN
-		f(StdCFrames.Frame).UpdateList()
-	END UpdateList;
-	
-	PROCEDURE (c: TreeControl) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		WITH f: StdCFrames.Frame DO f.Restore(l, t, r, b) END
-	END Restore;
-	
-	PROCEDURE (c: TreeControl) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																			VAR focus: Views.View);
-	BEGIN
-		WITH f: StdCFrames.TreeFrame DO
-			IF ~c.disabled & ~c.readOnly THEN
-				WITH msg: Controllers.EditMsg DO
-					IF (msg.op = Controllers.pasteChar) THEN 
-						f.KeyDown(msg.char)
-					END
-				ELSE
-					CatchCtrlMsg(c, f, msg, focus)
-				END
-			ELSIF ~c.disabled THEN
-				WITH msg: Controllers.TrackMsg DO
-					f.MouseDown(msg.x, msg.y, msg.modifiers)
-				ELSE
-				END
-			END
-		END
-	END HandleCtrlMsg2;
-
-	PROCEDURE (c: TreeControl) HandlePropMsg2 (VAR msg: Properties.Message);
-	BEGIN			
-		WITH msg: Properties.ControlPref DO
-			IF (msg.char = lineChar) OR (msg.char = esc) THEN msg.accepts := FALSE END;
-			IF ~c.disabled & ~c.readOnly & IsShortcut(msg.char, c) OR msg.getFocus THEN
-				msg.getFocus := StdCFrames.setFocus
-			END
-		| msg: Properties.FocusPref DO
-			IF ~c.disabled & ~c.readOnly THEN
-				msg.setFocus := TRUE
-			ELSIF~c.disabled THEN
-				msg.hotFocus := TRUE
-			END
-		| msg: Properties.SizePref DO
-			StdCFrames.dir.GetTreeFrameSize(msg.w, msg.h)
-		| msg: PropPref DO
-			msg.valid := {link, label, guard, notifier, sorted, haslines, hasbuttons, atroot, foldericons}
-		| msg: Properties.ResizePref DO
-			msg.horFitToWin := TRUE; msg.verFitToWin := TRUE
-		ELSE
-		END
-	END HandlePropMsg2;
-
-	PROCEDURE (c: TreeControl) CheckLink (VAR ok: BOOLEAN);
-		VAR name: Meta.Name;
-	BEGIN
-		GetTypeName(c.item, name);
-		ok := name = "Tree"
-	END CheckLink;
-
-	PROCEDURE (c: TreeControl) Update (f: Views.Frame; op, from, to: INTEGER);
-	BEGIN
-		f(StdCFrames.Frame).Update
-	END Update;
-	
-
-	(* StdDirectory *)
-
-	PROCEDURE (d: StdDirectory) NewPushButton (p: Prop): Control;
-		VAR c: PushButton;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewPushButton;
-
-	PROCEDURE (d: StdDirectory) NewCheckBox (p: Prop): Control;
-		VAR c: CheckBox;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewCheckBox;
-
-	PROCEDURE (d: StdDirectory) NewRadioButton (p: Prop): Control;
-		VAR c: RadioButton;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewRadioButton;
-
-	PROCEDURE (d: StdDirectory) NewField (p: Prop): Control;
-		VAR c: Field;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewField;
-	
-	PROCEDURE (d: StdDirectory) NewUpDownField (p: Prop): Control;
-		VAR c: UpDownField;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewUpDownField;
-	
-	PROCEDURE (d: StdDirectory) NewDateField (p: Prop): Control;
-		VAR c: DateField;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewDateField;
-
-	PROCEDURE (d: StdDirectory) NewTimeField (p: Prop): Control;
-		VAR c: TimeField;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewTimeField;
-	
-	PROCEDURE (d: StdDirectory) NewColorField (p: Prop): Control;
-		VAR c: ColorField;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewColorField;
-
-	PROCEDURE (d: StdDirectory) NewListBox (p: Prop): Control;
-		VAR c: ListBox;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewListBox;
-
-	PROCEDURE (d: StdDirectory) NewSelectionBox (p: Prop): Control;
-		VAR c: SelectionBox;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewSelectionBox;
-
-	PROCEDURE (d: StdDirectory) NewComboBox (p: Prop): Control;
-		VAR c: ComboBox;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewComboBox;
-
-	PROCEDURE (d: StdDirectory) NewCaption (p: Prop): Control;
-		VAR c: Caption;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewCaption;
-
-	PROCEDURE (d: StdDirectory) NewGroup (p: Prop): Control;
-		VAR c: Group;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewGroup;
-
-	PROCEDURE (d: StdDirectory) NewTreeControl (p: Prop): Control;
-		VAR c: TreeControl;
-	BEGIN
-		NEW(c); OpenLink(c, p); RETURN c
-	END NewTreeControl;
-
-	PROCEDURE SetDir* (d: Directory);
-	BEGIN
-		ASSERT(d # NIL, 20); dir := d
-	END SetDir;
-
-	PROCEDURE InitProp (VAR p: Prop);
-	BEGIN
-		NEW(p);
-		p.link := ""; p.label := ""; p.guard := ""; p.notifier := "";
-		p.level := 0;
-		p.opt[0] := FALSE; p.opt[1] := FALSE;
-		p.opt[2] := FALSE; p.opt[3] := FALSE;
-		p.opt[4] := FALSE
-	END InitProp;
-
-	PROCEDURE DepositPushButton*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		p.label := "#System:untitled";
-		Views.Deposit(dir.NewPushButton(p))
-	END DepositPushButton;
-
-	PROCEDURE DepositCheckBox*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		p.label := "#System:untitled";
-		Views.Deposit(dir.NewCheckBox(p))
-	END DepositCheckBox;
-
-	PROCEDURE DepositRadioButton*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		p.label := "#System:untitled";
-		Views.Deposit(dir.NewRadioButton(p))
-	END DepositRadioButton;
-
-	PROCEDURE DepositField*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p); p.opt[left] := TRUE;
-		Views.Deposit(dir.NewField(p))
-	END DepositField;
-	
-	PROCEDURE DepositUpDownField*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewUpDownField(p))
-	END DepositUpDownField;
-	
-	PROCEDURE DepositDateField*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewDateField(p))
-	END DepositDateField;
-
-	PROCEDURE DepositTimeField*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewTimeField(p))
-	END DepositTimeField;
-
-	PROCEDURE DepositColorField*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewColorField(p))
-	END DepositColorField;
-
-	PROCEDURE DepositListBox*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewListBox(p))
-	END DepositListBox;
-
-	PROCEDURE DepositSelectionBox*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewSelectionBox(p))
-	END DepositSelectionBox;
-
-	PROCEDURE DepositComboBox*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		Views.Deposit(dir.NewComboBox(p))
-	END DepositComboBox;
-
-	PROCEDURE DepositCancelButton*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		p.link := "StdCmds.CloseDialog"; p.label := "#System:Cancel"; p.opt[cancel] := TRUE;
-		Views.Deposit(dir.NewPushButton(p))
-	END DepositCancelButton;
-
-	PROCEDURE DepositCaption*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p); p.opt[left] := TRUE;
-		p.label := "#System:Caption";
-		Views.Deposit(dir.NewCaption(p))
-	END DepositCaption;
-
-	PROCEDURE DepositGroup*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		p.label := "#System:Caption";
-		Views.Deposit(dir.NewGroup(p))
-	END DepositGroup;
-	
-	PROCEDURE DepositTreeControl*;
-		VAR p: Prop;
-	BEGIN
-		InitProp(p);
-		p.opt[haslines] := TRUE; p.opt[hasbuttons] := TRUE; p.opt[atroot] := TRUE; p.opt[foldericons] := TRUE;
-		Views.Deposit(dir.NewTreeControl(p))
-	END DepositTreeControl;
-
-	PROCEDURE Relink*;
-		VAR msg: UpdateCachesMsg;
-	BEGIN
-		INC(stamp);
-		Views.Omnicast(msg)
-	END Relink;
-
-
-	PROCEDURE Init;
-		VAR d: StdDirectory;
-	BEGIN
-		par := NIL; stamp := 0;
-		NEW(d); stdDir := d; dir := d;
-		NEW(cleaner); cleanerInstalled := 0
-	END Init;
-
-
-	(* check guards action *)
-
-	PROCEDURE (a: Action) Do;
-		VAR msg: Views.NotifyMsg;
-	BEGIN
-		IF Windows.dir # NIL THEN
-			IF a.w # NIL THEN
-				INC(a.cnt);
-				msg.id0 := 0; msg.id1 := 0; msg.opts := {guardCheck};
-				IF a.w.seq # NIL THEN a.w.seq.Handle(msg) END;
-				a.w := Windows.dir.Next(a.w);
-				WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
-			ELSE
-				IF a.cnt = 0 THEN a.resolution := Services.resolution
-				ELSE a.resolution := Services.resolution DIV a.cnt DIV 2
-				END;
-				a.cnt := 0;
-				a.w := Windows.dir.First();
-				WHILE (a.w # NIL) & a.w.sub DO a.w := Windows.dir.Next(a.w) END
-			END
-		END;
-		Services.DoLater(a, Services.Ticks() + a.resolution)
-	END Do;
-
-BEGIN
-	Init;
-	NEW(action); action.w := NIL; action.cnt := 0; Services.DoLater(action, Services.now)
-CLOSE
-	Services.RemoveAction(action)
-END Controls.

new/System/Mod/Converters.txt

@@ -1,105 +0,0 @@
-MODULE Converters;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Converters.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT Meta, Files, Stores, Dialog;
-
-	CONST
-		(* hints *)
-		importAll* = 0;	(* can import all file types *)
-		canceled = 8;
-
-	TYPE
-		Importer* = PROCEDURE (f: Files.File; OUT s: Stores.Store);
-		Exporter* = PROCEDURE (s: Stores.Store; f: Files.File);
-		Converter* = POINTER TO RECORD
-			next-: Converter;
-			imp-, exp-: Dialog.String;
-			storeType-: Stores.TypeName;
-			fileType-: Files.Type;
-			opts-: SET
-		END;
-
-		ImpVal = RECORD (Meta.Value) p: Importer END;
-		ExpVal = RECORD (Meta.Value) p: Exporter END;
-
-	VAR
-		list-: Converter;
-		doc: Converter;
-
-	PROCEDURE GetCommand (name: Dialog.String; VAR val: Meta.Value; VAR ok: BOOLEAN);
-		VAR i: Meta.Item;
-	BEGIN
-		Meta.LookupPath(name, i);
-		IF (i.obj = Meta.procObj) OR (i.obj = Meta.varObj) & (i.typ = Meta.procTyp) THEN
-			i.GetVal(val, ok)
-		ELSE ok := FALSE
-		END
-	END GetCommand;
-
-
-	PROCEDURE Register* (imp, exp: Dialog.String; storeType: Stores.TypeName; fileType: Files.Type; opts: SET);
-		VAR e, f: Converter;
-	BEGIN
-		ASSERT((imp # "") OR (exp # ""), 20); ASSERT(fileType # "", 21);
-		NEW(e); e.next := NIL;
-		e.imp := imp; e.exp := exp; e.fileType := fileType; e.storeType := storeType; e.opts := opts;
-		IF (storeType = "") & (doc = NIL) THEN doc := e END;
-		IF list = NIL THEN list := e
-		ELSE f := list;
-			WHILE f.next # NIL DO f := f.next END;
-			f.next := e
-		END
-	END Register;
-
-
-	PROCEDURE Import* (loc: Files.Locator; name: Files.Name; VAR conv: Converter; OUT s: Stores.Store);
-		VAR file: Files.File; val: ImpVal; ok: BOOLEAN;
-	BEGIN
-		ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
-		file := Files.dir.Old(loc, name, Files.shared); s := NIL;
-		IF file # NIL THEN
-			IF conv = NIL THEN
-				conv := list;
-				WHILE (conv # NIL) & ((conv.fileType # file.type) OR (conv.imp = "")) DO conv := conv.next END;
-				IF conv = NIL THEN
-					conv := list; WHILE (conv # NIL) & ~(importAll IN conv.opts) DO conv := conv.next END
-				END
-			ELSE ASSERT(conv.imp # "", 22)
-			END;
-			IF conv # NIL THEN
-				GetCommand(conv.imp, val, ok);
-				IF ok THEN val.p(file, s)
-				ELSE Dialog.ShowMsg("#System:ConverterFailed")
-				END
-			ELSE Dialog.ShowMsg("#System:NoConverterFound")
-			END
-		END
-	END Import;
-
-	PROCEDURE Export* (loc: Files.Locator; name: Files.Name; conv: Converter; s: Stores.Store);
-		VAR res: INTEGER; file: Files.File; val: ExpVal; ok: BOOLEAN;
-	BEGIN
-		ASSERT(s # NIL, 20); ASSERT(~(s IS Stores.Alien), 21);
-		ASSERT(loc # NIL, 22); ASSERT(name # "", 23);
-		file := Files.dir.New(loc, Files.ask); (* fileLoc := loc; *)
-		IF file # NIL THEN
-			IF conv = NIL THEN
-				conv := doc
-			ELSE ASSERT(conv.exp # "", 24)
-			END;
-			GetCommand(conv.exp, val, ok);
-			IF ok THEN
-				val.p(s, file);
-				IF loc.res # canceled THEN
-					file.Register(name, conv.fileType, Files.ask, res); loc.res := res
-				END
-			ELSE Dialog.ShowMsg("#System:ConverterFailed"); loc.res := canceled
-			END
-		END
-	END Export;
-
-BEGIN
-	list := NIL
-END Converters.

new/System/Mod/Dates.txt

@@ -1,191 +0,0 @@
-MODULE Dates;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Dates.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT Kernel;
-
-	CONST
-		monday* = 0;
-		tuesday* = 1;
-		wednesday* = 2;
-		thursday* = 3;
-		friday* = 4;
-		saturday* = 5;
-		sunday* = 6;
-
-		short* = 0;
-		long* = 1;
-		abbreviated* = 2;
-		plainLong* = 3;
-		plainAbbreviated* = 4;
-
-	TYPE
-		Date* = RECORD
-			year*, month*, day*: INTEGER
-		END;
-
-		Time* = RECORD
-			hour*, minute*, second*: INTEGER
-		END;
-
-		Hook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
-
-	VAR M, N: ARRAY 8 OF INTEGER; hook: Hook;
-
-	PROCEDURE (h: Hook) GetTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
-	PROCEDURE (h: Hook) GetUTCTime* (OUT d: Date; OUT t: Time), NEW, ABSTRACT;
-	PROCEDURE (h: Hook) GetUTCBias* (OUT bias: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (h: Hook) DateToString* (d: Date; format: INTEGER; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
-	PROCEDURE (h: Hook) TimeToString* (t: Time; OUT str: ARRAY OF CHAR), NEW, ABSTRACT;
-
-	PROCEDURE SetHook* (h: Hook);
-	BEGIN
-		hook := h
-	END SetHook;
-
-	PROCEDURE  ValidTime* (IN t: Time): BOOLEAN;
-	BEGIN
-		RETURN
-			(t.hour >= 0) & (t.hour <= 23)
-			& (t.minute >= 0) & (t.minute <= 59)
-			& (t.second >= 0) & (t.second <= 59)
-	END ValidTime;
-	
-	PROCEDURE ValidDate* (IN d: Date): BOOLEAN;
-		VAR y, m, d1: INTEGER;
-	BEGIN
-		IF (d.year < 1) OR (d.year > 9999) OR (d.month < 1) OR (d.month > 12) OR (d.day < 1) THEN
-			RETURN FALSE
-		ELSE
-			y := d.year; m := d.month;
-			IF m = 2 THEN
-				IF (y < 1583) & (y MOD 4 = 0)
-				OR (y MOD 4 = 0) & ((y MOD 100 # 0) OR (y MOD 400 = 0)) THEN
-					d1 := 29
-				ELSE d1 := 28
-				END
-			ELSIF m IN {1, 3, 5, 7, 8, 10, 12} THEN d1 := 31
-			ELSE d1 := 30
-			END;
-			IF (y = 1582) & (m = 10) & (d.day > 4) & (d.day < 15) THEN RETURN FALSE END;
-			RETURN d.day <= d1
-		END
-	END ValidDate;
-
-	PROCEDURE Day* (IN d: Date): INTEGER;
-		VAR y, m, n: INTEGER;
-	BEGIN
-		y := d.year; m := d.month - 3;
-		IF m < 0 THEN INC(m, 12); DEC(y) END;
-		n := y * 1461 DIV 4 + (m * 153 + 2) DIV 5 + d.day - 306;
-		IF n > 577737 THEN n := n - (y DIV 100 * 3 - 5) DIV 4 END;
-		RETURN n
-	END Day;
-
-	PROCEDURE DayToDate* (n: INTEGER; OUT d: Date);
-		VAR c, y, m: INTEGER;
-	BEGIN
-		IF n > 577737 THEN
-			n := n * 4 + 1215; c := n DIV 146097; n := n MOD 146097 DIV 4
-		ELSE
-			n := n + 305; c := 0
-		END;
-		n := n * 4 + 3; y := n DIV 1461; n := n MOD 1461 DIV 4;
-		n := n * 5 + 2; m := n DIV 153; n := n MOD 153 DIV 5;
-		IF m > 9 THEN m := m - 12; INC(y) END;
-		d.year := SHORT(100 * c + y);
-		d.month := SHORT(m + 3);
-		d.day := SHORT(n + 1)
-	END DayToDate;
-
-	PROCEDURE GetDate* (OUT d: Date);
-		VAR t: Time;
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.GetTime(d, t)
-	END GetDate;
-
-	PROCEDURE GetTime* (OUT t: Time);
-		VAR d: Date;
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.GetTime(d, t)
-	END GetTime;
-
-	(* UTC = Coordinated Universal Time, also konown as Greenwich Mean time (GMT). *)
-
-	PROCEDURE GetUTCDate* (OUT d: Date);
-		VAR t: Time;
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.GetUTCTime(d, t)
-	END GetUTCDate;
-
-	PROCEDURE GetUTCTime* (OUT t: Time);
-		VAR d: Date;
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.GetUTCTime(d, t)
-	END GetUTCTime;
-	
-	PROCEDURE GetUTCBias* (OUT bias: INTEGER);
-	(*
-		Returns the current bias, in minutes, for local time translation on this computer. The bias is the difference, 
-		in minutes, between Coordinated Universal Time (UTC) and local time. All translations between UTC and
-		local time are based on the following formula: 
-			UTC = local time + bias 
- 	*)		
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.GetUTCBias(bias)
-	END GetUTCBias;
-	
-
-	PROCEDURE GetEasterDate* (year: INTEGER; OUT d: Date);
-		VAR  k, m, n, a, b, c, d0, e, o: INTEGER; month, day: INTEGER;
-	BEGIN
-		ASSERT((year >= 1583) & (year <= 2299), 20);
-		k := year DIV 100 - 15;
-		m := M[k]; n := N[k];
-		a := year MOD 19; b := year MOD 4; c := year MOD 7;
-		d0 := (19*a + m) MOD 30; e := (2*b+4*c+6*d0+n) MOD 7;
-		o := 21+d0+e; month := 3+o DIV 31; day := o MOD 31+1;
-		IF month = 4 THEN
-			IF day = 26 THEN day := 19
-			ELSIF (day = 25) & (d0=28) & (e = 6) & (a > 10) THEN day := 18
-			END
-		END;
-		d.year := year;
-		d.month := month;
-		d.day := day
-	END GetEasterDate;
-
-	PROCEDURE  DayOfWeek* (IN d: Date): INTEGER;
-	(** post: res = 0: Monday .. res = 6: Sunday **)
-	BEGIN
-		RETURN SHORT((4+Day(d)) MOD 7)
-	END DayOfWeek;
-
-	PROCEDURE DateToString* (IN d: Date; format: INTEGER; OUT str: ARRAY OF CHAR);
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.DateToString(d, format, str)
-	END DateToString;
-
-	PROCEDURE TimeToString* (IN t: Time; OUT str: ARRAY OF CHAR);
-	BEGIN
-		ASSERT(hook # NIL, 100);
-		hook.TimeToString(t, str)
-	END TimeToString;
-
-BEGIN
-	M[0] := 22; N[0] := 2;
-	M[1] := 22; N[1] := 2;
-	M[2] := 23; N[2] := 3;
-	M[3] := 23; N[3] := 4;
-	M[4] := 24; N[4] := 5;
-	M[5] := 24; N[5] := 5;
-	M[6] := 24; N[6] := 6;
-	M[7] := 25; N[7] := 0;
-END Dates.

new/System/Mod/Dialog.txt

@@ -1,1202 +0,0 @@
-MODULE Dialog;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Dialog.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT SYSTEM, Kernel, Files;
-
-	CONST
-		pressed* = 1; released* = 2; changed* = 3; included* = 5; excluded* = 6; set* = 7;	(** notify ops **)
-		ok* = 1; yes* = 2; no* = 3; cancel* = 4;	(** GetOK forms & results **)
-		persistent* = TRUE; nonPersistent* = FALSE;	(** constants for SetLanguage **)
-
-		stringLen = 256;
-		bufLen = 252;
-
-		rsrcDir = "Rsrc";
-		stringFile = "Strings";
-		TAB = 09X; CR = 0DX;
-		update = 2;	(* notify options *)
-		listUpdate = 3;
-		guardCheck = 4;
-
-		windows32s* = 11;
-		windows95* = 12;
-		windowsNT3* = 13;
-		windowsNT4* = 14;
-		windows2000* = 15;
-		windows98* = 16;
-		windowsXP* = 17;
-		windowsVista* = 18;
-		macOS* = 21;
-		macOSX* = 22;
-		linux* = 30;
-		tru64* = 40;
-
-		firstPos* = 0;
-		lastPos* = -1;
-
-	TYPE
-		String* = ARRAY stringLen OF CHAR;
-
-		Buf = POINTER TO RECORD
-			next: Buf;
-			s: ARRAY bufLen OF CHAR
-		END;
-
-		StrList = RECORD
-			len, max: INTEGER;	(* number of items, max number of items *)
-			strings: Buf;	(* string buffer list. strings[0] = 0X -> uninitialized items appear as empty *)
-			end: INTEGER;	(* next free position in string buffer list *)
-			scnt: INTEGER;	(* number of strings in list, including unused entries *)
-			items: POINTER TO ARRAY OF INTEGER	(* indices into string buffer list *)
-		END;
-
-		List* = RECORD
-			index*: INTEGER;	(** val IN [0, n-1] **)
-			len-: INTEGER;
-			l: StrList
-		END;
-
-		Combo* = RECORD
-			item*: String;
-			len-: INTEGER;
-			l: StrList
-		END;
-
-		Selection* = RECORD
-			len-: INTEGER;
-			sel: POINTER TO ARRAY OF SET;
-			l: StrList
-		END;
-
-		Currency* = RECORD	(* number = val * 10^-scale *)
-			val*: LONGINT;
-			scale*: INTEGER
-		END;
-
-		Color* = RECORD
-			val*: INTEGER
-		END;
-
-		TreeNode* = POINTER TO LIMITED RECORD
-			nofChildren: INTEGER;
-			name: String;
-			parent, next, prev, firstChild: TreeNode;
-			viewAsFolder, expanded: BOOLEAN;
-			data: ANYPTR;
-			tree: INTEGER
-		END;
-
-		Tree* = RECORD
-			nofRoots, nofNodes: INTEGER;
-			firstRoot, selected: TreeNode
-		END;
-
-		(** command procedure types**)
-
-		Par* = RECORD	(** parameter for guard procedures **)
-			disabled*: BOOLEAN;	(** OUT, preset to FALSE **)
-			checked*: BOOLEAN;	(** OUT, preset to default **)
-			undef*: BOOLEAN;	(** OUT, preset to default **)
-			readOnly*: BOOLEAN;	(** OUT, preset to default **)
-			label*: String	(** OUT, preset to "" **)
-		END;
-
-		GuardProc* = PROCEDURE (VAR par: Par);
-		NotifierProc* = PROCEDURE (op, from, to: INTEGER);
-
-		StringPtr = POINTER TO ARRAY [untagged] OF CHAR;
-		StringTab = POINTER TO RECORD
-			next: StringTab;
-			name: Files.Name;
-			key: POINTER TO ARRAY OF StringPtr;
-			str: POINTER TO ARRAY OF StringPtr;
-			data: POINTER TO ARRAY OF CHAR
-		END;
-
-		LangNotifier* = POINTER TO ABSTRACT RECORD next: LangNotifier END;
-		Language* = ARRAY 3 OF CHAR;
-
-		LangTrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
-
-		GetHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
-		ShowHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
-		CallHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
-		NotifyHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
-		LanguageHook* = POINTER TO ABSTRACT RECORD (Kernel.Hook) END;
-
-	VAR
-		metricSystem*: BOOLEAN;
-		showsStatus*: BOOLEAN;
-		platform*: INTEGER;
-		commandLinePars*: String;
-		version*: INTEGER;
-		appName*: ARRAY 32 OF CHAR;
-		language-: Language;
-		user*: ARRAY 32 OF CHAR;
-		caretPeriod*: INTEGER;
-		thickCaret*: BOOLEAN;
-
-		tabList: StringTab;
-		langNotifiers: LangNotifier;
-		currentNotifier: LangNotifier;
-
-		gethook: GetHook;
-		showHook: ShowHook;
-		callHook: CallHook;
-		notifyHook: NotifyHook;
-		languageHook: LanguageHook;
-
-	PROCEDURE (h: GetHook) GetOK* (IN str, p0, p1, p2: ARRAY OF CHAR; form: SET;
-															OUT res: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (h: GetHook) GetColor* (in: INTEGER; OUT out: INTEGER;
-																OUT set: BOOLEAN), NEW, ABSTRACT;
-	PROCEDURE (h: GetHook) GetIntSpec* (IN defType: Files.Type; VAR loc: Files.Locator;
-														OUT name: Files.Name), NEW, ABSTRACT;
-	PROCEDURE (h: GetHook) GetExtSpec* (IN defName: Files.Name; IN defType: Files.Type;
-																VAR loc: Files.Locator; OUT name: Files.Name), NEW, ABSTRACT;
-
-	PROCEDURE SetGetHook*(h: GetHook);
-	BEGIN
-		gethook := h
-	END SetGetHook;
-
-	PROCEDURE (h: ShowHook) ShowParamMsg* (IN str, p0, p1, p2: ARRAY OF CHAR), NEW, ABSTRACT;
-	PROCEDURE (h: ShowHook) ShowParamStatus* (IN str, p0, p1, p2: ARRAY OF CHAR), NEW, ABSTRACT;
-
-	PROCEDURE SetShowHook* (h: ShowHook);
-	BEGIN
-		showHook := h
-	END SetShowHook;
-
-	PROCEDURE (h: CallHook) Call* (IN proc, errorMsg: ARRAY OF CHAR; VAR res: INTEGER), NEW, ABSTRACT;
-
-	PROCEDURE SetCallHook* (h: CallHook);
-	BEGIN
-		callHook := h
-	END SetCallHook;
-
-	PROCEDURE (h: NotifyHook) Notify* (id0, id1: INTEGER; opts: SET), NEW, ABSTRACT;
-
-	PROCEDURE SetNotifyHook* (h: NotifyHook);
-	BEGIN
-		notifyHook := h
-	END SetNotifyHook;
-
-	PROCEDURE (h: LanguageHook) SetLanguage* (lang: Language; persistent: BOOLEAN;
-																				OUT ok: BOOLEAN), NEW, ABSTRACT;
-	PROCEDURE (h: LanguageHook) GetPersistentLanguage* (OUT lang: Language), NEW, ABSTRACT;
-
-	PROCEDURE SetLanguageHook* (h: LanguageHook);
-	BEGIN
-		languageHook := h
-	END SetLanguageHook;
-
-	PROCEDURE ReadStringFile (subsys: Files.Name; f: Files.File; VAR tab: StringTab);
-		VAR i, j, h, n, s, x, len, next, down, end: INTEGER; in, in1: Files.Reader;
-			ch: CHAR; b: BYTE; p, q: StringPtr;
-			
-		PROCEDURE ReadInt (OUT x: INTEGER);
-			VAR b: BYTE;
-		BEGIN
-			in.ReadByte(b); x := b MOD 256;
-			in.ReadByte(b); x := x + (b MOD 256) * 100H;
-			in.ReadByte(b); x := x + (b MOD 256) * 10000H;
-			in.ReadByte(b); x := x + b * 1000000H
-		END ReadInt;
-		
-		PROCEDURE ReadHead (OUT next, down, end: INTEGER);
-			VAR b, t: BYTE; n: INTEGER;
-		BEGIN
-			in.ReadByte(b);
-			REPEAT
-				in.ReadByte(t);
-				IF t = -14 THEN ReadInt(n)
-				ELSE
-					REPEAT in.ReadByte(b) UNTIL b = 0
-				END
-			UNTIL t # -15;
-			ReadInt(n);
-			ReadInt(next); next := next + in.Pos();
-			ReadInt(down); down := down + in.Pos();
-			ReadInt(end); end := end + in.Pos()
-		END ReadHead;
-	
-	BEGIN
-		tab := NIL;
-		IF f # NIL THEN	(* read text file *)
-			in := f.NewReader(NIL); in1 :=  f.NewReader(NIL);
-			IF (in # NIL) & (in1 # NIL) THEN
-				in.SetPos(8); ReadHead(next, down, end);	(* document view *)
-				in.SetPos(down); ReadHead(next, down, end);	(* document model *)
-				in.SetPos(down); ReadHead(next, down, end);	(* text view *)
-				in.SetPos(down); ReadHead(next, down, end);	(* text model *)
-				in.ReadByte(b); in.ReadByte(b); in.ReadByte(b);	(* versions *)
-				in.ReadByte(b); in.ReadByte(b); in.ReadByte(b);
-				ReadInt(x); in1.SetPos(in.Pos() + x);	(* text offset *)
-				next := down;
-				NEW(tab); tab.name := subsys$;
-				NEW(tab.data, f.Length());
-				n := 0; i := 0; s := 0; in.ReadByte(b);
-				WHILE b # -1 DO
-					IF next = in.Pos() THEN ReadHead(next, down, end); in.SetPos(end) END;	(* skip attributes *)
-					ReadInt(len);
-					IF len > 0 THEN	(* shortchar run *)
-						WHILE len > 0 DO
-							in1.ReadByte(b); ch := CHR(b MOD 256);
-							IF ch >= " " THEN
-								IF s = 0 THEN j := i; s := 1 END;	(* start of left part *)
-								tab.data[j] := ch; INC(j)
-							ELSIF (s = 1) & (ch = TAB) THEN
-								tab.data[j] := 0X; INC(j);
-								s := 2	(* start of right part *)
-							ELSIF (s = 2) & (ch = CR) THEN
-								tab.data[j] := 0X; INC(j);
-								INC(n); i := j; s := 0	(* end of line *)
-							ELSE
-								s := 0	(* reset *)
-							END;
-							DEC(len)
-						END
-					ELSIF len < 0 THEN		(* longchar run *)
-						WHILE len < 0 DO
-							in1.ReadByte(b); x := b MOD 256; in1.ReadByte(b); ch := CHR(x + 256 * (b + 128));
-							IF s = 0 THEN j := i; s := 1 END;	(* start of left part *)
-							tab.data[j] := ch; INC(j);
-							INC(len, 2)
-						END
-					ELSE	(* view *)
-						ReadInt(x); ReadInt(x); in1.ReadByte(b);	(* ignore *)
-					END;
-					IF next = in.Pos() THEN ReadHead(next, down, end); in.SetPos(end) END;	(* skip view data *)
-					in.ReadByte(b);
-				END;
-				IF n > 0 THEN
-					NEW(tab.key, n); NEW(tab.str, n); i := 0; j := 0;
-					WHILE j < n DO
-						tab.key[j] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[i]));
-						WHILE tab.data[i] >= " " DO INC(i) END;
-						INC(i);
-						tab.str[j] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[i]));
-						WHILE tab.data[i] >= " " DO INC(i) END;
-						INC(i); INC(j)
-					END;
-					(* sort keys (shellsort) *)
-					h := 1; REPEAT h := h*3 + 1 UNTIL h > n;
-					REPEAT h := h DIV 3; i := h;
-						WHILE i < n DO p := tab.key[i]; q := tab.str[i]; j := i;
-							WHILE (j >= h) & (tab.key[j-h]^ > p^) DO
-								tab.key[j] := tab.key[j-h]; tab.str[j] := tab.str[j-h]; j := j-h
-							END;
-							tab.key[j] := p; tab.str[j] := q; INC(i)
-						END
-					UNTIL h = 1
-				END
-			END
-		END
-	END ReadStringFile;
-
-	PROCEDURE MergeTabs (VAR master, extra: StringTab): StringTab;
-		VAR tab: StringTab; nofKeys, datalength, di, mi, ei, ml, el, ti, i: INTEGER;
-	BEGIN
-		IF (extra = NIL) OR (extra.key = NIL) THEN RETURN master END;
-		IF (master = NIL) OR (master.key = NIL)  THEN RETURN extra END;
-		ml := LEN(master.key); el := LEN(extra.key);
-		mi := 0; ei := 0; datalength := 0; nofKeys := 0;
-		(* find out how big the resulting table will be *)
-		WHILE (mi < ml) OR (ei < el) DO
-			INC(nofKeys);
-			IF (mi < ml) & (ei < el) & (master.key[mi]$ = extra.key[ei]$) THEN
-				datalength := datalength + LEN(master.key[mi]$) + LEN(master.str[mi]$) + 2; INC(mi); INC(ei)
-			ELSIF (ei < el) & ((mi >= ml) OR (master.key[mi]$ > extra.key[ei]$)) THEN
-				datalength := datalength + LEN(extra.key[ei]$) + LEN(extra.str[ei]$) + 2; INC(ei)
-			ELSE
-				datalength := datalength + LEN(master.key[mi]$) + LEN(master.str[mi]$) + 2; INC(mi)
-			END
-		END;
-		NEW(tab); tab.name := master.name;
-		NEW(tab.key, nofKeys); NEW(tab.str, nofKeys); NEW(tab.data, datalength);
-		mi := 0; ei := 0; di := 0; ti := 0;
-		(* do the merge *)
-		WHILE (mi < ml) OR (ei < el) DO
-			IF  (mi < ml) & (ei < el) & (master.key[mi]$ = extra.key[ei]$)  THEN
-				i := 0; tab.key[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
-				WHILE  master.key[mi][i] # 0X DO tab.data[di] := master.key[mi][i]; INC(di); INC(i) END;
-				tab.data[di] :=0X; INC(di); i := 0;
-				tab.str[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
-				WHILE master.str[mi][i] # 0X DO tab.data[di] := master.str[mi][i]; INC(di); INC(i) END;
-				 tab.data[di] :=0X; INC(di);
-				INC(mi); INC(ei)
-			ELSIF (ei < el) & ((mi >= ml) OR (master.key[mi]$ > extra.key[ei]$)) THEN
-				i := 0; tab.key[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
-				WHILE extra.key[ei][i] # 0X DO tab.data[di] := extra.key[ei][i]; INC(di); INC(i) END;
-				tab.data[di] :=0X; INC(di); i := 0;
-				tab.str[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
-				WHILE  extra.str[ei][i] # 0X DO tab.data[di] := extra.str[ei][i]; INC(di); INC(i) END;
-				 tab.data[di] :=0X; INC(di);
-				INC(ei)
-			ELSE
-				i := 0; tab.key[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
-				WHILE master.key[mi][i] # 0X DO  tab.data[di] := master.key[mi][i]; INC(di); INC(i) END;
-				tab.data[di] :=0X; INC(di); i := 0;
-				tab.str[ti] := SYSTEM.VAL(StringPtr, SYSTEM.ADR(tab.data[di]));
-				WHILE master.str[mi][i] # 0X DO  tab.data[di] := master.str[mi][i]; INC(di); INC(i) END;
-				 tab.data[di] :=0X; INC(di);
-				INC(mi)
-			END;
-			INC(ti)
-		END;
-		RETURN tab
-	END MergeTabs;
-
-	PROCEDURE LoadStringTab (subsys: Files.Name; VAR tab: StringTab);
-		VAR loc: Files.Locator; f: Files.File; name: Files.Name; ltab: StringTab;
-	BEGIN
-		tab := NIL;
-		name := stringFile; Kernel.MakeFileName(name, "");
-		loc := Files.dir.This(subsys); loc := loc.This(rsrcDir);
-		IF loc # NIL THEN
-			 f := Files.dir.Old(loc, name, Files.shared);
-			ReadStringFile(subsys, f, tab);
-			IF language # "" THEN
-				loc := loc.This(language);
-				IF loc # NIL THEN
-					 f := Files.dir.Old(loc, name, Files.shared);
-					ReadStringFile(subsys, f, ltab);
-					tab := MergeTabs(ltab, tab)
-				END
-			END;
-			IF tab # NIL THEN tab.next := tabList; tabList := tab END
-		END
-	END LoadStringTab;
-
-	PROCEDURE SearchString (VAR in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
-		VAR i, j, k, len: INTEGER; ch: CHAR; subsys: Files.Name; tab: StringTab;
-	BEGIN
-		out := "";
-		IF in[0] = "#" THEN
-			i := 0; ch := in[1];
-			WHILE (ch # 0X) (* & (ch # ".") *) & (ch # ":") DO subsys[i] := ch; INC(i); ch := in[i + 1] END;
-			subsys[i] := 0X;
-			IF ch # 0X THEN
-				INC(i, 2); ch := in[i]; j := 0;
-				WHILE (ch # 0X) DO in[j] := ch; INC(i); INC(j); ch := in[i] END;
-				in[j] := 0X
-			ELSE
-				RETURN
-			END;
-			tab := tabList;
-			WHILE (tab # NIL) & (tab.name # subsys) DO tab := tab.next END;
-			IF tab = NIL THEN LoadStringTab(subsys, tab) END;
-			IF tab # NIL THEN
-				i := 0;
-				IF tab.key = NIL THEN j := 0 ELSE j := LEN(tab.key^) END;
-				WHILE i < j DO	(* binary search *)
-					k := (i + j) DIV 2;
-					IF tab.key[k]^ < in THEN i := k + 1 ELSE j := k END
-				END;
-				IF (tab.key # NIL) & (j < LEN(tab.key^)) & (tab.key[j]^ = in) THEN
-					k := 0; len := LEN(out)-1;
-					WHILE (k < len) & (tab.str[j][k] # 0X) DO
-						out[k] := tab.str[j][k]; INC(k)
-					END;
-					out[k] := 0X
-				END
-			END
-		END
-	END SearchString;
-
-
-	PROCEDURE Init (VAR l: StrList);
-	BEGIN
-		l.len := 0; l.max := 0; l.end := 0; l.scnt := 0
-	END Init;
-
-	PROCEDURE Compact (VAR l: StrList);
-		VAR i, j, k: INTEGER; ibuf, jbuf: Buf; ch: CHAR;
-	BEGIN
-		i := 1; ibuf := l.strings; j := 1; jbuf := l.strings;
-		WHILE j < l.end DO
-			(* find index entry k pointing to position j *)
-			k := 0; WHILE (k < l.len) & (l.items[k] # j) DO INC(k) END;
-			IF k < l.len THEN	(* copy string *)
-				l.items[k] := i;
-				REPEAT
-					ch := jbuf.s[j MOD bufLen]; INC(j);
-					IF j MOD bufLen = 0 THEN jbuf := jbuf.next END;
-					ibuf.s[i MOD bufLen] := ch; INC(i);
-					IF i MOD bufLen = 0 THEN ibuf := ibuf.next END
-				UNTIL ch = 0X
-			ELSE (* skip next string *)
-				REPEAT
-					ch := jbuf.s[j MOD bufLen]; INC(j);
-					IF j MOD bufLen = 0 THEN jbuf := jbuf.next END
-				UNTIL ch = 0X
-			END
-		END;
-		ibuf.next := NIL;	(* release superfluous buffers *)
-		l.end := i; l.scnt := l.len
-	END Compact;
-
-	PROCEDURE SetLen (VAR l: StrList; len: INTEGER);
-		CONST D = 32;
-		VAR i, newmax: INTEGER;
-			items: POINTER TO ARRAY OF INTEGER;
-	BEGIN
-		IF l.items = NIL THEN Init(l) END;
-		IF (l.max - D < len) & (len <= l.max) THEN
-			(* we do not reallocate anything *)
-		ELSE
-			newmax := (len + D-1) DIV D * D;
-			IF newmax > 0 THEN
-				IF l.strings = NIL THEN NEW(l.strings); (* l.strings[0] := 0X; *) l.end := 1 END;
-				NEW(items, newmax);
-				IF len < l.len THEN i := len ELSE i := l.len END;
-				WHILE i > 0 DO DEC(i); items[i] := l.items[i] END;
-				l.items := items
-			END;
-			l.max := newmax
-		END;
-		l.len := len;
-		IF (l.scnt > 32) & (l.scnt > 2 * l.len) THEN Compact(l) END
-	END SetLen;
-
-	PROCEDURE GetItem (VAR l: StrList; index: INTEGER; VAR item: String);
-		VAR i, j, k: INTEGER; b: Buf; ch: CHAR;
-	BEGIN
-		IF l.items = NIL THEN Init(l) END;
-		IF (index >= 0) & (index < l.len) THEN
-			i := l.items[index]; j := i MOD bufLen; i := i DIV bufLen;
-			b := l.strings; WHILE i # 0 DO b := b.next; DEC(i) END;
-			k := 0;
-			REPEAT
-				ch := b.s[j]; INC(j); IF j = bufLen THEN j := 0; b := b.next END;
-				item[k] := ch; INC(k)
-			UNTIL ch = 0X
-		ELSE
-			item := ""
-		END
-	END GetItem;
-
-	PROCEDURE SetItem (VAR l: StrList; index: INTEGER; item: ARRAY OF CHAR);
-		VAR len, i, j, k: INTEGER; b: Buf; ch: CHAR;
-	BEGIN
-		IF l.items = NIL THEN Init(l) END;
-		IF index >= l.len THEN SetLen(l, index + 1) END;
-		IF (l.scnt > 32) & (l.scnt > 2 * l.len) THEN Compact(l) END;
-		len := 0; WHILE item[len] # 0X DO INC(len) END;
-		IF len >= stringLen THEN len := stringLen - 1; item[len] := 0X END;	(* clip long strings *)
-		l.items[index] := l.end;
-		i := l.end; j := i MOD bufLen; i := i DIV bufLen;
-		b := l.strings; WHILE i # 0 DO b := b.next; DEC(i) END;
-		k := 0;
-		REPEAT
-			ch := item[k]; INC(k); INC(l.end);
-			b.s[j] := ch; INC(j); IF j = bufLen THEN j := 0; NEW(b.next); b := b.next END
-		UNTIL ch = 0X;
-		INC(l.scnt)
-	END SetItem;
-
-	PROCEDURE SetResources (VAR l: StrList; IN key: ARRAY OF CHAR);
-		VAR i, k, j, x: INTEGER; ch: CHAR; s, a: ARRAY 16 OF CHAR; h, item: ARRAY 256 OF CHAR;
-	BEGIN
-		IF l.items = NIL THEN Init(l) END;
-		i := 0;
-		REPEAT
-			x := i;
-			j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0;
-			k := 0; REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
-			s[k] := 0X;
-			h := key + "[" + s + "]";
-			SearchString(h, item);
-			IF item # "" THEN SetItem(l, i, item) END;
-			INC(i)
-		UNTIL item = ""
-	END SetResources;
-
-
-	(** List **)
-
-	PROCEDURE (VAR l: List) SetLen* (len: INTEGER), NEW;
-	BEGIN
-		ASSERT(len >= 0, 20);
-		SetLen(l.l, len);
-		l.len := l.l.len
-	END SetLen;
-
-	PROCEDURE (VAR l: List) GetItem* (index: INTEGER; OUT item: String), NEW;
-	BEGIN
-		GetItem(l.l, index, item);
-		l.len := l.l.len
-	END GetItem;
-
-	PROCEDURE (VAR l: List) SetItem* (index: INTEGER; IN item: ARRAY OF CHAR), NEW;
-	BEGIN
-		ASSERT(index >= 0, 20); ASSERT(item # "", 21);
-		SetItem(l.l, index, item);
-		l.len := l.l.len
-	END SetItem;
-
-	PROCEDURE (VAR l: List) SetResources* (IN key: ARRAY OF CHAR), NEW;
-	BEGIN
-		ASSERT(key # "", 20);
-		SetResources(l.l, key);
-		l.len := l.l.len
-	END SetResources;
-
-
-	(** Selection **)
-
-	PROCEDURE (VAR s: Selection) SetLen* (len: INTEGER), NEW;
-		VAR sel: POINTER TO ARRAY OF SET; i: INTEGER;
-	BEGIN
-		ASSERT(len >= 0, 20);
-		SetLen(s.l, len);
-		len := len + (MAX(SET) - 1) DIV MAX(SET);
-		IF len  = 0 THEN s.sel := NIL
-		ELSIF s.sel = NIL THEN NEW(s.sel, len)
-		ELSIF LEN(s.sel^) # len THEN
-			NEW(sel, len);
-			IF LEN(s.sel^) < len THEN len := LEN(s.sel^) END;
-			i := 0; WHILE i < len DO sel[i] := s.sel[i]; INC(i) END;
-			s.sel := sel
-		END;
-		s.len := s.l.len
-	END SetLen;
-
-	PROCEDURE (VAR s: Selection) GetItem* (index: INTEGER; OUT item: String), NEW;
-	BEGIN
-		GetItem(s.l, index, item);
-		s.len := s.l.len
-	END GetItem;
-
-	PROCEDURE (VAR s: Selection) SetItem* (index: INTEGER; IN item: ARRAY OF CHAR), NEW;
-	BEGIN
-		ASSERT(index >= 0, 20); (*ASSERT(index < s.l.len, 21);*) ASSERT(item # "", 21);
-		SetItem(s.l, index, item);
-		IF s.l.len > s.len THEN s.SetLen(s.l.len) END
-	END SetItem;
-
-	PROCEDURE (VAR s: Selection) SetResources* (IN key: ARRAY OF CHAR), NEW;
-	BEGIN
-		ASSERT(key # "", 20);
-		SetResources(s.l, key);
-		IF s.l.len > s.len THEN s.SetLen(s.l.len) END
-	END SetResources;
-
-	PROCEDURE (VAR s: Selection) In* (index: INTEGER): BOOLEAN, NEW;
-	BEGIN
-		IF s.l.items = NIL THEN Init(s.l); s.len := s.l.len END;
-		IF s.sel # NIL THEN RETURN (index MOD 32) IN (s.sel[index DIV 32]) ELSE RETURN FALSE END
-	END In;
-
-	PROCEDURE (VAR s: Selection) Excl* (from, to: INTEGER), NEW;
-	BEGIN
-		IF s.l.items = NIL THEN Init(s.l); s.len := s.l.len END;
-		IF from < 0 THEN from := 0 END;
-		IF to >= s.l.len THEN to := s.l.len - 1 END;
-		WHILE from <= to DO EXCL(s.sel[from DIV 32], from MOD 32); INC(from) END
-	END Excl;
-
-	PROCEDURE (VAR s: Selection) Incl* (from, to: INTEGER), NEW;
-	BEGIN
-		IF s.l.items = NIL THEN Init(s.l); s.len := s.l.len END;
-		IF from < 0 THEN from := 0 END;
-		IF to >= s.l.len THEN to := s.l.len - 1 END;
-		WHILE from <= to DO INCL(s.sel[from DIV 32], from MOD 32); INC(from) END
-	END Incl;
-
-
-	(** Combo **)
-
-	PROCEDURE (VAR c: Combo) SetLen* (len: INTEGER), NEW;
-	BEGIN
-		ASSERT(len >= 0, 20);
-		SetLen(c.l, len);
-		c.len := c.l.len
-	END SetLen;
-
-	PROCEDURE (VAR c: Combo) GetItem* (index: INTEGER; OUT item: String), NEW;
-	BEGIN
-		GetItem(c.l, index, item);
-		c.len := c.l.len
-	END GetItem;
-
-	PROCEDURE (VAR c: Combo) SetItem* (index: INTEGER; IN item: ARRAY OF CHAR), NEW;
-	BEGIN
-		ASSERT(index >= 0, 20); ASSERT(item # "", 21);
-		SetItem(c.l, index, item);
-		c.len := c.l.len
-	END SetItem;
-
-	PROCEDURE (VAR c: Combo) SetResources* (IN key: ARRAY OF CHAR), NEW;
-	BEGIN
-		ASSERT(key # "", 20);
-		SetResources(c.l, key);
-		c.len := c.l.len
-	END SetResources;
-
-
-	(* Tree and TreeNode *)
-
-	PROCEDURE (tn: TreeNode) SetName* (name: String), NEW;
-	BEGIN
-		tn.name := name
-	END SetName;
-
-	PROCEDURE (tn: TreeNode) GetName* (OUT name: String), NEW;
-	BEGIN
-		name := tn.name
-	END GetName;
-
-	PROCEDURE (tn: TreeNode) SetData* (data: ANYPTR), NEW;
-	BEGIN
-		tn.data := data
-	END SetData;
-
-	PROCEDURE (tn: TreeNode) Data* (): ANYPTR, NEW;
-	BEGIN
-		RETURN tn.data
-	END Data;
-
-	PROCEDURE (tn: TreeNode) NofChildren* (): INTEGER, NEW;
-	BEGIN
-		RETURN tn.nofChildren
-	END NofChildren;
-
-	PROCEDURE (tn: TreeNode) SetExpansion* (expanded: BOOLEAN), NEW;
-	BEGIN
-		tn.expanded := expanded
-	END SetExpansion;
-
-	PROCEDURE (tn: TreeNode) IsExpanded* (): BOOLEAN, NEW;
-	BEGIN
-		RETURN tn.expanded
-	END IsExpanded;
-
-	PROCEDURE (tn: TreeNode) IsFolder* (): BOOLEAN, NEW;
-	BEGIN
-		IF (~tn.viewAsFolder) & (tn.firstChild = NIL) THEN
-			RETURN FALSE
-		ELSE
-			RETURN TRUE
-		END
-	END IsFolder;
-
-	PROCEDURE (tn: TreeNode) ViewAsFolder* (isFolder: BOOLEAN), NEW;
-	BEGIN
-		tn.viewAsFolder := isFolder
-	END ViewAsFolder;
-
-	PROCEDURE (VAR t: Tree) NofNodes* (): INTEGER, NEW;
-	BEGIN
-		IF t.firstRoot = NIL THEN
-			RETURN 0
-		ELSE
-			RETURN MAX(0, t.nofNodes)
-		END
-	END NofNodes;
-
-	PROCEDURE (VAR t: Tree) NofRoots* (): INTEGER, NEW;
-	BEGIN
-		IF t.firstRoot = NIL THEN
-			RETURN 0
-		ELSE
-			RETURN MAX(0, t.nofRoots)
-		END
-	END NofRoots;
-
-	PROCEDURE (VAR t: Tree) Parent* (node: TreeNode): TreeNode, NEW;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
-		RETURN node.parent
-	END Parent;
-
-	PROCEDURE (VAR t: Tree) Next* (node: TreeNode): TreeNode, NEW;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
-		RETURN node.next
-	END Next;
-
-	PROCEDURE (VAR t: Tree) Prev* (node: TreeNode): TreeNode, NEW;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
-		RETURN node.prev
-	END Prev;
-
-	PROCEDURE (VAR t: Tree) Child* (node: TreeNode; pos: INTEGER): TreeNode, NEW;
-		VAR cur: TreeNode;
-	BEGIN
-		ASSERT(pos >= lastPos, 20); ASSERT((node = NIL) OR (node.tree = SYSTEM.ADR(t)), 21);
-		IF node = NIL THEN cur := t.firstRoot
-		ELSE cur := node.firstChild END;
-		IF pos = lastPos THEN
-			WHILE (cur # NIL) & (cur.next # NIL) DO cur := cur.next END
-		ELSE
-			WHILE (cur # NIL) & (pos > 0) DO cur := cur.next; DEC(pos) END
-		END;
-		RETURN cur
-	END Child;
-
-	PROCEDURE (VAR t: Tree) Selected* (): TreeNode, NEW;
-	BEGIN
-		RETURN t.selected
-	END Selected;
-
-	PROCEDURE (VAR t: Tree) Select* (node: TreeNode), NEW;
-	BEGIN
-		ASSERT((node = NIL) OR (node.tree = SYSTEM.ADR(t)), 20);
-		IF (node # NIL) OR (t.nofRoots = 0) THEN
-			t.selected := node
-		ELSE
-			t.selected := t.Child(NIL, 0)
-		END
-	END Select;
-
-	PROCEDURE Include (IN t: Tree; node: TreeNode);
-		VAR c: TreeNode;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(node.tree = 0, 100);
-		node.tree := SYSTEM.ADR(t);
-		c := node.firstChild;
-		WHILE c # NIL DO Include(t, c); c := c.next END
-	END Include;
-
-	PROCEDURE (VAR t: Tree) InsertAt (parent: TreeNode; pos: INTEGER; node: TreeNode), NEW;
-		VAR
-			cur, prev: TreeNode;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(pos >= lastPos, 21);
-		ASSERT((parent = NIL) OR (parent.tree = SYSTEM.ADR(t)), 22); ASSERT(node.tree = 0, 23);
-		Include(t, node);
-		IF parent = NIL THEN	(* Add new root *)
-			IF (t.firstRoot = NIL) OR (pos = 0) THEN
-				node.next := t.firstRoot; node.prev := NIL;
-				IF t.firstRoot # NIL THEN t.firstRoot.prev := node END;
-				t.firstRoot := node
-			ELSE
-				cur := t.firstRoot;
-				IF pos = lastPos THEN pos := t.nofRoots END;
-				WHILE (cur # NIL) & (pos > 0) DO
-					prev := cur; cur := t.Next(cur); DEC(pos)
-				END;
-				IF cur = NIL THEN
-					prev.next := node; node.prev := prev
-				ELSE
-					node.next := cur; node.prev := cur.prev; cur.prev := node; prev.next := node
-				END
-			END;
-			INC(t.nofRoots)
-		ELSE	(* Add child *)
-			IF pos = lastPos THEN pos := parent.nofChildren END;
-			IF (parent.firstChild = NIL) OR (pos = 0) THEN
-				IF parent.firstChild # NIL THEN parent.firstChild.prev := node END;
-				node.prev := NIL; node.next := parent.firstChild; parent.firstChild := node
-			ELSE
-				cur := parent.firstChild;
-				WHILE (cur # NIL) & (pos > 0) DO
-					prev := cur; cur := t.Next(cur); DEC(pos)
-				END;
-				IF cur = NIL THEN
-					prev.next := node; node.prev := prev
-				ELSE
-					node.next := cur; node.prev := cur.prev; cur.prev := node; prev.next := node
-				END
-			END;
-			INC(parent.nofChildren)
-		END;
-		node.parent := parent;
-		INC(t.nofNodes)
-	END InsertAt;
-
-	PROCEDURE (VAR t: Tree) NewChild* (parent: TreeNode; pos: INTEGER; name: String): TreeNode, NEW;
-		VAR
-			new: TreeNode;
-	BEGIN
-		NEW(new); new.tree := 0;
-		new.SetName(name); new.expanded := FALSE; new.nofChildren := 0;
-		new.viewAsFolder := FALSE;
-		t.InsertAt(parent, pos, new);
-		RETURN new
-	END NewChild;
-
-	PROCEDURE (VAR t: Tree) CountChildren (node: TreeNode): INTEGER, NEW;
-		VAR tot, nofc, i: INTEGER;
-	BEGIN
-		tot := 0;
-		IF node # NIL THEN
-			nofc := node.nofChildren; tot := nofc;
-			FOR i := 0 TO nofc -1 DO
-				tot := tot + t.CountChildren(t.Child(node, i))
-			END
-		END;
-		RETURN tot
-	END CountChildren;
-
-	PROCEDURE Exclude (IN t: Tree; node: TreeNode);
-		VAR c: TreeNode;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 100);
-		IF t.Selected() = node THEN t.Select(NIL) END;
-		node.tree := 0;
-		c := node.firstChild;
-		WHILE c # NIL DO Exclude(t, c); c := c.next END
-	END Exclude;
-
-	PROCEDURE (VAR t: Tree) Delete* (node: TreeNode): INTEGER, NEW;
-		VAR
-			ndel: INTEGER;
-	BEGIN
-		ASSERT(node # NIL, 20); ASSERT(node.tree = SYSTEM.ADR(t), 21);
-		ndel := t.CountChildren(node);
-		IF node.parent = NIL THEN	(* root node *)
-			IF node.prev = NIL THEN
-				IF node.next # NIL THEN
-					t.firstRoot := node.next;
-					node.next.prev := NIL
-				ELSE
-					t.firstRoot := NIL
-				END
-			ELSE
-				node.prev.next := node.next;
-				IF node.next # NIL THEN node.next.prev := node.prev END
-			END;
-			DEC(t.nofRoots)
-		ELSE
-			IF node.prev = NIL THEN
-				IF node.next # NIL THEN
-					node.parent.firstChild := node.next;
-					node.next.prev := NIL
-				ELSE
-					node.parent.firstChild := NIL
-				END
-			ELSE
-				node.prev.next := node.next;
-				IF node.next # NIL THEN node.next.prev := node.prev END
-			END;
-			DEC(node.parent.nofChildren)
-		END;
-		node.parent := NIL; node.next := NIL; node.prev := NIL;
-		Exclude(t, node);
-		ndel := ndel + 1;
-		t.nofNodes := t.nofNodes - ndel;
-		RETURN ndel
-	END Delete;
-
-	PROCEDURE (VAR t: Tree) Move* (node, parent: TreeNode; pos: INTEGER), NEW;
-		VAR ndel, nofn: INTEGER; s: TreeNode;
-	BEGIN
-		ASSERT(node # NIL, 20);  ASSERT(pos >= lastPos, 21);
-		ASSERT(node.tree = SYSTEM.ADR(t), 22);
-		nofn := t.NofNodes();
-		s := t.Selected();
-		ndel := t.Delete(node); t.InsertAt(parent, pos, node);
-		t.nofNodes := t.nofNodes + ndel - 1;
-		IF (s # NIL) & (t.Selected() # s) THEN t.Select(s) END;
-		ASSERT(nofn = t.NofNodes(), 60)
-	END Move;
-
-	PROCEDURE (VAR t: Tree) DeleteAll*, NEW;
-	BEGIN
-		t.nofRoots := 0; t.nofNodes := 0; t.firstRoot := NIL; t.selected := NIL
-	END DeleteAll;
-
-
-	PROCEDURE Notify* (id0, id1: INTEGER; opts: SET);
-	BEGIN
-		ASSERT(notifyHook # NIL, 100);
-		notifyHook.Notify(id0, id1, opts)
-	END Notify;
-
-	PROCEDURE Update* (IN x: ANYREC);
-		VAR type: Kernel.Type; adr, size: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		type := Kernel.TypeOf(x);
-		size := type.size;
-		IF size = 0 THEN size := 1 END;
-		Notify(adr, adr + size, {update, guardCheck})
-	END Update;
-
-	PROCEDURE UpdateBool* (VAR x: BOOLEAN);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(BOOLEAN), {update, guardCheck})
-	END UpdateBool;
-
-	PROCEDURE UpdateSChar* (VAR x: SHORTCHAR);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(SHORTCHAR), {update, guardCheck})
-	END UpdateSChar;
-
-	PROCEDURE UpdateChar* (VAR x: CHAR);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(CHAR), {update, guardCheck})
-	END UpdateChar;
-
-	PROCEDURE UpdateByte* (VAR x: BYTE);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(BYTE), {update, guardCheck})
-	END UpdateByte;
-
-	PROCEDURE UpdateSInt* (VAR x: SHORTINT);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(SHORTINT), {update, guardCheck})
-	END UpdateSInt;
-
-	PROCEDURE UpdateInt* (VAR x: INTEGER);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(INTEGER), {update, guardCheck})
-	END UpdateInt;
-
-	PROCEDURE UpdateLInt* (VAR x: LONGINT);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(LONGINT), {update, guardCheck})
-	END UpdateLInt;
-
-	PROCEDURE UpdateSReal* (VAR x: SHORTREAL);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(SHORTREAL), {update, guardCheck})
-	END UpdateSReal;
-
-	PROCEDURE UpdateReal* (VAR x: REAL);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(REAL), {update, guardCheck})
-	END UpdateReal;
-
-	PROCEDURE UpdateSet* (VAR x: SET);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + SIZE(SET), {update, guardCheck})
-	END UpdateSet;
-
-	PROCEDURE UpdateSString* (IN x: ARRAY OF SHORTCHAR);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + LEN(x) * SIZE(SHORTCHAR), {update, guardCheck})
-	END UpdateSString;
-
-	PROCEDURE UpdateString* (IN x: ARRAY OF CHAR);
-		VAR adr: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		Notify(adr, adr + LEN(x) * SIZE(CHAR), {update, guardCheck})
-	END UpdateString;
-
-	PROCEDURE UpdateList* (IN x: ANYREC);
-		VAR type: Kernel.Type; adr, size: INTEGER;
-	BEGIN
-		adr := SYSTEM.ADR(x);
-		type := Kernel.TypeOf(x);
-		size := type.size;
-		IF size = 0 THEN size := 1 END;
-		Notify(adr, adr + size, {listUpdate, guardCheck})
-	END UpdateList;
-
-
-	PROCEDURE GetOK* (IN str, p0, p1, p2: ARRAY OF CHAR; form: SET; OUT res: INTEGER);
-	BEGIN
-		ASSERT(((yes IN form) = (no IN form)) & ((yes IN form) # (ok IN form)), 20);
-		ASSERT(gethook # NIL, 100);
-		gethook.GetOK(str, p0, p1, p2, form, res)
-	END GetOK;
-
-	PROCEDURE GetIntSpec* (defType: Files.Type; VAR loc: Files.Locator; OUT name: Files.Name);
-	BEGIN
-		ASSERT(gethook # NIL, 100);
-		gethook.GetIntSpec(defType, loc, name)
-	END GetIntSpec;
-
-	PROCEDURE GetExtSpec* (defName: Files.Name; defType: Files.Type; VAR loc: Files.Locator;
-												OUT name: Files.Name);
-	BEGIN
-		ASSERT(gethook # NIL, 100);
-		gethook.GetExtSpec(defName, defType, loc, name)
-	END GetExtSpec;
-
-	PROCEDURE GetColor* (in: INTEGER; OUT out: INTEGER; OUT set: BOOLEAN);
-	BEGIN
-		ASSERT(gethook # NIL, 100);
-		gethook.GetColor(in, out, set)
-	END GetColor;
-
-
-	PROCEDURE Subst (in: ARRAY OF CHAR; IN p0, p1, p2: ARRAY OF CHAR; VAR out: ARRAY OF CHAR);
-		VAR len, i, j, k: INTEGER; ch, c: CHAR;
-	BEGIN
-		i := 0; ch := in[i]; j := 0; len := LEN(out) - 1;
-		WHILE (ch # 0X) & (j < len) DO
-			IF ch = "^" THEN
-				INC(i); ch := in[i];
-				IF ch = "0" THEN
-					k := 0; c := p0[0];
-					WHILE (c # 0X) & (j < len) DO out[j] := c; INC(j); INC(k); c := p0[k] END;
-					INC(i); ch := in[i]
-				ELSIF ch = "1" THEN
-					k := 0; c := p1[0];
-					WHILE (c # 0X) & (j < len) DO out[j] := c; INC(j); INC(k); c := p1[k] END;
-					INC(i); ch := in[i]
-				ELSIF ch = "2" THEN
-					k := 0; c := p2[0];
-					WHILE (c # 0X) & (j < len) DO out[j] := c; INC(j); INC(k); c := p2[k] END;
-					INC(i); ch := in[i]
-				ELSE out[j] := "^"; INC(j)
-				END
-			ELSE out[j] := ch; INC(j); INC(i); ch := in[i]
-			END
-		END;
-		out[j] := 0X
-	END Subst;
-
-	PROCEDURE FlushMappings*;
-	BEGIN
-		tabList := NIL
-	END FlushMappings;
-
-	PROCEDURE MapParamString* (in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
-	(* use in as key in string table file, and return corresponding string in out.
-		If the resource lookup fails, return in in out *)
-	BEGIN
-		SearchString(in, out);
-		IF out # "" THEN Subst(out, p0, p1, p2, out)
-		ELSE Subst(in, p0, p1, p2, out)
-		END
-	END MapParamString;
-
-	PROCEDURE MapString* (in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
-		VAR len, k: INTEGER;
-	BEGIN
-		SearchString(in, out);
-		IF out = "" THEN
-			k := 0; len := LEN(out)-1;
-			WHILE (k < len) & (in[k] # 0X) DO out[k] := in[k]; INC(k) END;
-			out[k] := 0X
-		END
-	END MapString;
-
-	PROCEDURE ShowMsg* (IN str: ARRAY OF CHAR);
-	BEGIN
-		ASSERT(str # "", 20);
-		ASSERT(showHook # NIL, 100);
-		showHook.ShowParamMsg(str, "", "", "")
-	END ShowMsg;
-
-	PROCEDURE ShowParamMsg* (IN str, p0, p1, p2: ARRAY OF CHAR);
-	BEGIN
-		ASSERT(str # "", 20);
-		ASSERT(showHook # NIL, 100);
-		showHook.ShowParamMsg(str,p0, p1, p2)
-	END ShowParamMsg;
-
-	PROCEDURE ShowStatus* (IN str: ARRAY OF CHAR);
-	BEGIN
-		ASSERT(showHook # NIL, 100);
-		showHook.ShowParamStatus(str, "", "", "")
-	END ShowStatus;
-
-	PROCEDURE ShowParamStatus* (IN str, p0, p1, p2: ARRAY OF CHAR);
-	BEGIN
-		ASSERT(showHook # NIL, 100);
-		showHook.ShowParamStatus(str, p0, p1, p2)
-	END ShowParamStatus;
-
-
-	PROCEDURE Call* (IN proc, errorMsg: ARRAY OF CHAR; OUT res: INTEGER);
-	BEGIN
-		ASSERT(callHook # NIL, 100);
-		callHook.Call(proc, errorMsg, res)
-	END Call;
-
-	PROCEDURE Beep*;
-	BEGIN
-		Kernel.Beep
-	END Beep;
-
-	PROCEDURE (n: LangNotifier) Notify-(), NEW, ABSTRACT;
-
-	PROCEDURE RegisterLangNotifier* (notifier: LangNotifier);
-		VAR nl: LangNotifier;
-	BEGIN
-		ASSERT(notifier # NIL, 20);
-		nl := langNotifiers;
-		WHILE (nl # NIL) & (nl # notifier) DO nl := nl.next END;
-		IF nl = NIL THEN
-			notifier.next := langNotifiers; langNotifiers := notifier
-		END
-	END RegisterLangNotifier;
-
-	PROCEDURE RemoveLangNotifier* (notifier: LangNotifier);
-		VAR nl, prev: LangNotifier;
-	BEGIN
-		ASSERT(notifier # NIL, 20);
-		nl := langNotifiers; prev := NIL;
-		WHILE (nl # NIL) & (nl # notifier) DO prev := nl; nl := nl.next END;
-		IF nl # NIL THEN
-			IF prev = NIL THEN  langNotifiers := langNotifiers.next ELSE prev.next := nl.next END;
-			nl.next := NIL
-		END
-	END RemoveLangNotifier;
-
-	PROCEDURE Exec (a, b, c: INTEGER);
-		VAR nl: LangNotifier;
-	BEGIN
-		nl := currentNotifier; currentNotifier := NIL;
-		nl.Notify;
-		currentNotifier := nl
-	END Exec;
-
-	PROCEDURE SetLanguage* (lang: Language; persistent: BOOLEAN);
-		VAR nl, t: LangNotifier; ok: BOOLEAN;
-	BEGIN
-		ASSERT((lang = "") OR (LEN(lang$) = 2), 20);
-		ASSERT(languageHook # NIL, 100);
-		IF lang # language THEN
-			languageHook.SetLanguage(lang, persistent, ok);
-			IF ok THEN
-				language := lang; FlushMappings;
-				nl := langNotifiers;
-				WHILE nl # NIL DO
-					currentNotifier := nl;
-					Kernel.Try(Exec, 0, 0, 0);
-					IF currentNotifier = NIL THEN
-						t := nl; nl := nl.next; RemoveLangNotifier(t)	(* Notifier trapped, remove it *)
-					ELSE
-						nl := nl.next
-					END
-				END
-			END;
-			currentNotifier := NIL
-		END
-	END SetLanguage;
-
-	PROCEDURE ResetLanguage*;
-		VAR lang: Language;
-	BEGIN
-		ASSERT(languageHook # NIL, 100);
-		languageHook.GetPersistentLanguage(lang);
-		SetLanguage(lang, nonPersistent)
-	END ResetLanguage;
-
-BEGIN
-	appName := "BlackBox"; showsStatus := FALSE; caretPeriod := 500; thickCaret := FALSE; user := ""
-END Dialog.

new/System/Mod/Documents.txt

@@ -1,1286 +0,0 @@
-MODULE Documents;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Documents.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT
-		Kernel, Files, Ports, Dates, Printers,
-		Stores, Sequencers, Models, Views, Controllers, Properties,
-		Dialog, Printing, Containers;
-
-	CONST
-		(** Document.SetPage/PollPage decorate **)
-		plain* = FALSE; decorate* = TRUE;
-		
-		(** Controller.opts **)
-		pageWidth* = 16; pageHeight* = 17; winWidth* = 18; winHeight* = 19;
-
-		point = Ports.point;
-		mm = Ports.mm;
-
-		defB = 8 * point;	(* defB also used by HostWindows in DefBorders *)
-
-		scrollUnit = 16 * point;
-		abort = 1;
-
-		resizingKey = "#System:Resizing";
-		pageSetupKey = "#System:PageSetup";
-		
-		docTag = 6F4F4443H; docVersion = 0;
-
-		minVersion = 0; maxModelVersion = 0; maxCtrlVersion = 0;
-		maxDocVersion = 0; maxStdDocVersion = 0;
-
-
-	TYPE
-		Document* = POINTER TO ABSTRACT RECORD (Containers.View) END;
-
-		Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
-
-		Directory* = POINTER TO ABSTRACT RECORD END;
-
-
-		Model = POINTER TO RECORD (Containers.Model)
-			doc: StdDocument;
-			view: Views.View;
-			l, t, r, b: INTEGER	(* possibly  r, b >= Views.infinite *)
-			(* l, t: constant (= defB) *)
-			(* r-l, b-t: invalid in some cases, use PollRect *)
-		END;
-
-		Controller = POINTER TO RECORD (Containers.Controller)
-			doc: StdDocument
-		END;
-
-		StdDocument = POINTER TO RECORD (Document)
-			model: Model;
-			original: StdDocument;	(* original # NIL => d IS copy of original *)
-			pw, ph, pl, pt, pr, pb: INTEGER;	(* invalid if original # NIL, use PollPage *)
-			decorate: BOOLEAN;
-			x, y: INTEGER	(* scroll state *)
-		END;
-
-		StdContext = POINTER TO RECORD (Context)
-			model: Model
-		END;
-
-		StdDirectory = POINTER TO RECORD (Directory) END;
-		
-		SetRectOp = POINTER TO RECORD (Stores.Operation)
-			model: Model;
-			w, h: INTEGER
-		END;
-		SetPageOp = POINTER TO RECORD (Stores.Operation)
-			d: StdDocument;
-			pw, ph, pl, pt, pr, pb: INTEGER;
-			decorate: BOOLEAN
-		END;
-		ReplaceViewOp = POINTER TO RECORD (Stores.Operation)
-			model: Model;
-			new: Views.View
-		END;
-
-		PrinterContext = POINTER TO RECORD (Models.Context)
-			param: Printing.Par;
-			date: Dates.Date;
-			time: Dates.Time;
-			pr: Printers.Printer;
-			l, t, r, b: INTEGER;	(* frame *)
-			pw, ph: INTEGER	(* paper *)
-		END;
-		
-		UpdateMsg = RECORD (Views.Message)
-			doc: StdDocument
-		END;
-		
-		
-		PContext = POINTER TO RECORD (Models.Context)
-			view: Views.View;
-			w, h: INTEGER	(* content size *)
-		END;
-		Pager = POINTER TO RECORD (Views.View)
-			con: PContext;
-			w, h: INTEGER;	(* page size *)
-			x, y: INTEGER	(* origin *)
-		END;
-		
-		PrintingHook = POINTER TO RECORD (Printing.Hook) END;
-
-		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
-
-	VAR
-		dir-, stdDir-: Directory;
-		cleaner: TrapCleaner;
-		current: INTEGER;
-
-
-	(** Cleaner **)
-
-	PROCEDURE (c: TrapCleaner) Cleanup;
-	BEGIN
-		Printing.par := NIL; current := -1
-	END Cleanup;
-
-
-	(** Document **)
-
-	PROCEDURE (d: Document) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
-		VAR thisVersion: INTEGER;
-	BEGIN
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxDocVersion, thisVersion)
-	END Internalize2;
-
-	PROCEDURE (d: Document) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
-	BEGIN
-		wr.WriteVersion(maxDocVersion)
-	END Externalize2;
-
-	PROCEDURE (d: Document) GetNewFrame* (VAR frame: Views.Frame);
-		VAR f: Views.RootFrame;
-	BEGIN
-		NEW(f); frame := f
-	END GetNewFrame;
-
-	PROCEDURE (d: Document) GetBackground* (VAR color: Ports.Color);
-	BEGIN
-		color := Ports.background
-	END GetBackground;
-	
-	PROCEDURE (d: Document) DocCopyOf* (v: Views.View): Document, NEW, ABSTRACT;
-	PROCEDURE (d: Document) SetView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (d: Document) ThisView* (): Views.View, NEW, ABSTRACT;
-	PROCEDURE (d: Document) OriginalView* (): Views.View, NEW, ABSTRACT;
-
-	PROCEDURE (d: Document) SetRect* (l, t, r, b: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (d: Document) PollRect* (VAR l, t, r, b: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (d: Document) SetPage* (w, h, l, t, r, b: INTEGER; decorate: BOOLEAN), NEW, ABSTRACT;
-	PROCEDURE (d: Document) PollPage* (VAR w, h, l, t, r, b: INTEGER;
-																VAR decorate: BOOLEAN), NEW, ABSTRACT;
-
-
-	(** Context **)
-
-	PROCEDURE (c: Context) ThisDoc* (): Document, NEW, ABSTRACT;
-
-
-	(** Directory **)
-
-	PROCEDURE (d: Directory) New* (view: Views.View; w, h: INTEGER): Document, NEW, ABSTRACT;
-
-
-	(* operations *)
-
-	PROCEDURE (op: SetRectOp) Do;
-		VAR m: Model; w, h: INTEGER; upd: UpdateMsg;
-	BEGIN
-		m := op.model;
-		w := m.r - m.l; h := m.b - m.t;
-		m.r := m.l + op.w; m.b := m.t + op.h;
-		op.w := w; op.h := h;
-		IF m.doc.context # NIL THEN
-			upd.doc := m.doc;
-			Views.Domaincast(m.doc.Domain(), upd)
-		END
-	END Do;
-
-	PROCEDURE (op: SetPageOp) Do;
-		VAR d: StdDocument; pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN; upd: UpdateMsg;
-	BEGIN
-		d := op.d;
-		pw := d.pw; ph := d.ph; pl := d.pl; pt := d.pt; pr := d.pr; pb := d.pb;
-		decorate := d.decorate;
-		d.pw := op.pw; d.ph := op.ph; d.pl := op.pl; d.pt := op.pt; d.pr := op.pr; d.pb := op.pb;
-		d.decorate := op.decorate;
-		op.pw := pw; op.ph := d.ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
-		op.decorate := decorate;
-		IF d.context # NIL THEN
-			upd.doc := d;
-			Views.Domaincast(d.Domain(), upd)
-		END
-	END Do;
-
-	PROCEDURE (op: ReplaceViewOp) Do;
-		VAR new: Views.View; upd: UpdateMsg;
-	BEGIN
-		new := op.new; op.new := op.model.view; op.model.view := new;
-		upd.doc := op.model.doc;
-		IF upd.doc.context # NIL THEN
-			Views.Domaincast(upd.doc.Domain(), upd)
-		END
-	END Do;
-
-
-	(* printing support for StdDocument *)
-
-	PROCEDURE CheckOrientation (d: Document; prt: Printers.Printer);
-		VAR w, h, l, t, r, b: INTEGER; decorate: BOOLEAN;
-	BEGIN
-		d.PollPage(w, h, l, t, r, b, decorate);
-		prt.SetOrientation(w > h)
-	END CheckOrientation;
-
-	PROCEDURE NewPrinterContext (d: Document; prt: Printers.Printer; p: Printing.Par): PrinterContext;
-		VAR c: PrinterContext;
-			pw, ph,  x0, y0, x1, y1, l, t, r, b: INTEGER; decorate: BOOLEAN;
-	BEGIN
-		prt.GetRect(x0, y0, x1, y1);
-		d.PollPage(pw, ph, l, t, r, b, decorate);
-		INC(l, x0); INC(t, y0); INC(r, x0); INC(b, y0);
-		NEW(c); (* c.Domain() := d.Domain(); (* dom *)*) c.param := p; Dates.GetDate(c.date); Dates.GetTime(c.time);
-		c.pr := prt;
-		c.l := l; c.t := t; c.r := r; c.b := b;
-		c.pw := pw + 2 * x0; c.ph := ph + 2 * y0;	(* paper reduced to printer range *)
-		RETURN c
-	END NewPrinterContext;
-
-	PROCEDURE Decorate (c: PrinterContext; f: Views.Frame);
-		VAR p: Printing.Par; x0, x1, y, asc, dsc, w: INTEGER; alt: BOOLEAN;
-	BEGIN
-		p := c.param;
-		alt := p.page.alternate & ~ODD(p.page.first + Printing.Current() (* p.page.current *));
-		IF alt THEN x0 := c.pw - c.r; x1 := c.pw - c.l
-		ELSE x0 := c.l; x1 := c.r
-		END;
-		IF (alt & (p.header.left # "")) OR (~alt & (p.header.right # "")) THEN
-			p.header.font.GetBounds(asc, dsc, w);
-			y := c.t - p.header.gap - dsc;
-			Printing.PrintBanner(f, p.page, p.header, c.date, c.time, x0, x1, y)
-		END;
-		IF (alt & (p.footer.left # "")) OR (~alt & (p.footer.right # "")) THEN
-			p.footer.font.GetBounds(asc, dsc, w);
-			y := c.b + p.footer.gap + asc;
-			Printing.PrintBanner(f, p.page, p.footer, c.date, c.time, x0, x1, y)
-		END
-	END Decorate;
-
-
-	(* support for StdDocument paging *)
-
-	PROCEDURE HasFocus (v: Views.View; f: Views.Frame): BOOLEAN;
-		VAR focus: Views.View; dummy: Controllers.PollFocusMsg;
-	BEGIN
-		focus := NIL; dummy.focus := NIL;
-		v.HandleCtrlMsg(f, dummy, focus);
-		RETURN focus # NIL
-	END HasFocus;
-	
-	PROCEDURE ScrollDoc(v: StdDocument; x, y: INTEGER);
-	BEGIN
-		IF (x # v.x) OR (y # v.y) THEN
-			Views.Scroll(v, x - v.x, y - v.y);
-			v.x := x; v.y := y
-		END
-	END ScrollDoc;
-
-	PROCEDURE PollSection (v: StdDocument; f: Views.Frame; VAR msg: Controllers.PollSectionMsg);
-		VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
-	BEGIN
-		mv := v.model.view;
-		g := Views.ThisFrame(f, mv);
-		c := v.ThisController();
-		IF c.Singleton() # NIL THEN g := NIL END;
-		IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
-		IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
-			v.PollRect(l, t, r, b);
-			IF msg.vertical THEN
-				ps := f.b - f.t; vs := b + t; p := -v.y
-			ELSE
-				ps := f.r - f.l; vs := r + l;  p := -v.x
-			END;
-			IF ps > vs THEN ps := vs END;
-			ws := vs - ps;
-			IF p > ws THEN
-				p := ws;
-				IF msg.vertical THEN ScrollDoc(v, v.x, -p)
-				ELSE ScrollDoc(v, -p, v.y)
-				END
-			END;
-			msg.wholeSize := vs;
-			msg.partSize := ps;
-			msg.partPos := p;
-			msg.valid := ws > Ports.point
-		END;
-		msg.done := TRUE
-	END PollSection;
-
-	PROCEDURE Scroll (v: StdDocument; f: Views.Frame; VAR msg: Controllers.ScrollMsg);
-		VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
-	BEGIN
-		mv := v.model.view;
-		g := Views.ThisFrame(f, mv);
-		c := v.ThisController();
-		IF c.Singleton() # NIL THEN g := NIL END;
-		IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
-		IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
-			v.PollRect(l, t, r, b);
-			IF msg.vertical THEN
-				ps := f.b - f.t; vs := b + t; p := -v.y
-			ELSE
-				ps := f.r - f.l; vs := r + l; p := -v.x
-			END;
-			ws := vs - ps;
-			CASE msg.op OF
-			  Controllers.decLine: p := MAX(0, p - scrollUnit)
-			| Controllers.incLine: p := MIN(ws, p + scrollUnit)
-			| Controllers.decPage: p := MAX(0, p - ps + scrollUnit)
-			| Controllers.incPage: p := MIN(ws, p + ps - scrollUnit)
-			| Controllers.gotoPos: p := MAX(0, MIN(ws, msg.pos))
-			ELSE
-			END;
-			IF msg.vertical THEN ScrollDoc(v, v.x, -p)
-			ELSE ScrollDoc(v, -p, v.y)
-			END
-		END;
-		msg.done := TRUE
-	END Scroll;
-	
-	PROCEDURE MakeVisible* (d: Document; f: Views.Frame; l, t, r, b: INTEGER);
-		VAR x, y, w, h, dw, dh, ml, mt, mr, mb: INTEGER;
-	BEGIN
-		WITH d: StdDocument DO
-			d.context.GetSize(w, h);
-			x := -d.x; y := -d.y;
-			d.PollRect(ml, mt, mr, mb);
-			dw := mr + ml - w; dh := mb + mt - h;
-			IF dw > 0 THEN
-				IF r > x + w - 2 * ml THEN x := r - w + 2 * ml END;
-				IF l < x THEN x := l END;
-				IF x < 0 THEN x := 0 ELSIF x > dw THEN x := dw END
-			END;
-			IF dh > 0 THEN
-				IF b > y + h - 2 * mt THEN y := b - h + 2 * mt END;
-				IF t < y THEN y := t END;
-				IF y < 0 THEN y := 0 ELSIF y > dh THEN y := dh END
-			END;
-			ScrollDoc(d, -x, -y)
-		END
-	END MakeVisible;
-
-	PROCEDURE Page (d: StdDocument; f: Views.Frame;
-								VAR msg: Controllers.PageMsg);
-		VAR g: Views.Frame;
-	BEGIN
-		g := Views.ThisFrame(f, d.model.view);
-		IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
-	END Page;
-	
-
-	(* Model *)
-
-	PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
-		VAR c: StdContext; thisVersion: INTEGER; l, t, r, b: INTEGER;
-	BEGIN
-		m.Internalize^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxModelVersion, thisVersion);
-		IF rd.cancelled THEN RETURN END;
-		Views.ReadView(rd, m.view);
-		rd.ReadInt(l); rd.ReadInt(t); rd.ReadInt(r); rd.ReadInt(b);
-		m.l := defB; m.t := defB; m.r := defB + r - l; m.b := defB + b - t;
-		NEW(c); c.model := m; m.view.InitContext(c)
-	END Internalize;
-
-	PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
-	BEGIN
-		ASSERT(m.doc.original = NIL, 100);
-		m.Externalize^(wr);
-		wr.WriteVersion(maxModelVersion);
-		Views.WriteView(wr, m.view);
-		wr.WriteInt(m.l); wr.WriteInt(m.t); wr.WriteInt(m.r); wr.WriteInt(m.b)
-	END Externalize;
-
-	PROCEDURE (m: Model) CopyFrom (source: Stores.Store);
-		VAR c: StdContext;
-	BEGIN
-		WITH source: Model DO
-			m.view := Stores.CopyOf(source.view)(Views.View);
-			m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
-			NEW(c); c.model := m; m.view.InitContext(c)
-		END
-	END CopyFrom;
-	
-	PROCEDURE (m: Model) InitFrom (source: Containers.Model);
-		VAR c: StdContext;
-	BEGIN
-		WITH source: Model DO
-			m.view := Stores.CopyOf(source.view)(Views.View);
-			m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
-			NEW(c); c.model := m; m.view.InitContext(c)
-		END
-	END InitFrom;
-
-	PROCEDURE (m: Model) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
-	BEGIN
-		minW := 5 * mm; minH := 5 * mm;
-		maxW := MAX(INTEGER) DIV 2; maxH := MAX(INTEGER) DIV 2
-	END GetEmbeddingLimits;
-
-	PROCEDURE (m: Model) ReplaceView (old, new: Views.View);
-		VAR con: Models.Context; op: ReplaceViewOp;
-	BEGIN
-		ASSERT(old # NIL, 20); con := old.context;
-		ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = m, 22);
-		ASSERT(new # NIL, 23);
-		ASSERT((new.context = NIL) OR (new.context = con), 24);
-		IF new # old THEN
-			IF new.context = NIL THEN new.InitContext(con) END;
-			Stores.Join(m, new);
-			NEW(op); op.model := m; op.new := new;
-			Models.Do(m, "#System:ReplaceView", op)
-		END
-	END ReplaceView;
-
-
-	(* StdDocument *)
-
-	PROCEDURE (d: StdDocument) Internalize2 (VAR rd: Stores.Reader);
-		VAR thisVersion: INTEGER; c: Containers.Controller;
-	BEGIN
-		d.Internalize2^(rd);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadVersion(minVersion, maxStdDocVersion, thisVersion);
-		IF rd.cancelled THEN RETURN END;
-		rd.ReadInt(d.pw); rd.ReadInt(d.ph);
-		rd.ReadInt(d.pl); rd.ReadInt(d.pt); rd.ReadInt(d.pr); rd.ReadInt(d.pb);
-		rd.ReadBool(d.decorate);
-		(* change infinite height to "fit to window" *)
-		c := d.ThisController();
-		IF (c # NIL) & (d.model.b >= 29000 * Ports.mm) & (c.opts * {winHeight, pageHeight} = {}) THEN
-			c.SetOpts(c.opts + {winHeight})
-		END;
-		c.SetOpts(c.opts - {Containers.noSelection});
-		d.x := 0; d.y := 0;
-		Stores.InitDomain(d)
-	END Internalize2;
-
-	PROCEDURE (d: StdDocument) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		ASSERT(d.original = NIL, 100);
-		d.Externalize2^(wr);
-		wr.WriteVersion(maxStdDocVersion);
-		wr.WriteInt(d.pw); wr.WriteInt(d.ph);
-		wr.WriteInt(d.pl); wr.WriteInt(d.pt); wr.WriteInt(d.pr); wr.WriteInt(d.pb);
-		wr.WriteBool(d.decorate)
-	END Externalize2;
-
-	PROCEDURE (d: StdDocument) CopyFromModelView2 (source: Views.View; model: Models.Model);
-	BEGIN
-		WITH source: StdDocument DO
-			d.pw := source.pw; d.ph := source.ph;
-			d.pl := source.pl; d.pt := source.pt; d.pr := source.pr; d.pb := source.pb;
-			d.decorate := source.decorate
-		END
-	END CopyFromModelView2;
-	
-	PROCEDURE (d: StdDocument) AcceptableModel (m: Containers.Model): BOOLEAN;
-	BEGIN
-		RETURN m IS Model
-	END AcceptableModel;
-	
-	PROCEDURE (d: StdDocument) InitModel2 (m: Containers.Model);
-	BEGIN
-		ASSERT((d.model = NIL) OR (d.model = m), 20);
-		ASSERT(m IS Model, 23);
-		WITH m: Model DO d.model := m; m.doc := d END
-	END InitModel2;
-	
-	PROCEDURE (d: StdDocument) PollRect (VAR l, t, r, b: INTEGER);
-		VAR c: Containers.Controller; doc: StdDocument; ww, wh, pw, ph: INTEGER;
-	BEGIN
-		IF d.original = NIL THEN doc := d ELSE doc := d.original END;
-		l := d.model.l; t := d.model.t;
-		pw := doc.pr - doc.pl; ph := doc.pb - doc.pt;
-		IF d.context = NIL THEN ww := 0; wh := 0
-		ELSIF d.context IS PrinterContext THEN ww := pw; wh := ph
-		ELSE d.context.GetSize(ww, wh); DEC(ww, 2 * l); DEC(wh, 2 * t)
-		END;
-		c := d.ThisController();
-		IF pageWidth IN c.opts THEN r := l + pw
-		ELSIF winWidth IN c.opts THEN
-			IF ww > 0 THEN r := l + ww ELSE r := d.model.r END
-		ELSE r := l + doc.model.r - doc.model.l
-		END;
-		IF pageHeight IN c.opts THEN b := t + ph
-		ELSIF winHeight IN c.opts THEN 
-			IF wh > 0 THEN b := t + wh ELSE b := d.model.b END
-		ELSE b := t + doc.model.b - doc.model.t
-		END;
-		ASSERT(r > l, 60); ASSERT(b > t, 61)
-	END PollRect;
-
-	PROCEDURE (d: StdDocument) PollPage (VAR w, h, l, t, r, b: INTEGER; VAR decorate: BOOLEAN);
-		VAR doc: StdDocument;
-	BEGIN
-		IF d.original = NIL THEN doc := d ELSE doc := d.original END;
-		w := doc.pw; h := doc.ph;
-		l := doc.pl; t := doc.pt; r := doc.pr; b := doc.pb;
-		decorate := doc.decorate
-	END PollPage;
-
-	PROCEDURE (d: StdDocument) DocCopyOf (v: Views.View): Document;
-		VAR c0, c1: Containers.Controller; u: Views.View; new: Document; w, h: INTEGER;
-	BEGIN
-		ASSERT(v # NIL, 20);
-		ASSERT(~(v IS Document), 21);
-		ASSERT(d.Domain() = v.Domain(), 22);
-		ASSERT(d.Domain() # NIL, 23);
-		Views.BeginModification(3, v);  
-		u := Views.CopyOf(v, Views.shallow);
-		v.context.GetSize(w, h);
-		new := dir.New(u, w, h);
-		WITH new: StdDocument DO
-			IF d.original # NIL THEN new.original := d.original ELSE new.original := d END
-		END;
-		c0 := d.ThisController();
-		c1 := new.ThisController();
-		c1.SetOpts(c0.opts);
-		Views.EndModification(3, v);
-		RETURN new
-	END DocCopyOf;
-
-	PROCEDURE (d: StdDocument) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-		VAR c: Containers.Controller; m: Model; con: Models.Context; s: Views.View;
-	BEGIN
-		m := d.model; con := d.context;
-		WITH con: PrinterContext DO
-			IF con.param.page.alternate & ~ODD(con.param.page.first + Printing.Current()) THEN
-				Views.InstallFrame(f, m.view, con.pw - con.r, con.t, 0, FALSE)
-			ELSE
-				Views.InstallFrame(f, m.view, con.l, con.t, 0, FALSE)
-			END
-		ELSE
-			c := d.ThisController(); s := c.Singleton();
-			Views.InstallFrame(f, m.view, m.l + d.x, m.t + d.y, 0, s = NIL)
-		END
-	END Restore;
-
-	PROCEDURE (d: StdDocument) GetRect (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER);
-		VAR l0, t0, r0, b0: INTEGER;
-	BEGIN
-		d.PollRect(l0, t0, r0, b0);
-		l := l0 + d.x; t := t0 + d.y; r := r0 + d.x; b := b0 + d.y
-	END GetRect;
-
-	PROCEDURE (d: StdDocument) SetView (view: Views.View; w, h: INTEGER);
-		CONST
-			wA4 = 210 * mm; hA4 = 296 * mm;	(* A4 default paper size *)
-			lm = 20 * mm; tm = 20 * mm; rm = 20 * mm; bm = 20 * mm;
-		VAR m: Model; c: StdContext; prt: Printers.Printer;
-			ctrl: Containers.Controller; opts: SET; rp: Properties.ResizePref;
-			u, minW, maxW, minH, maxH,  defW, defH,  dw, dh,  pw, ph,
-			pageW, pageH,  paperW, paperH,  leftM, topM, rightM, botM: INTEGER;
-			l, t, r, b: INTEGER; port: Ports.Port;
-	BEGIN
-		ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
-		ASSERT(d.original = NIL, 100);
-		m := d.model;
-		NEW(c); c.model := m; view.InitContext(c);
-		IF d.context # NIL THEN Stores.Join(d, view) END;
-		IF Printers.dir # NIL THEN prt := Printers.dir.Current() ELSE prt := NIL END;
-		IF prt # NIL THEN
-			prt.SetOrientation(FALSE);
-			port := prt.ThisPort(); prt.GetRect(l, t, r, b);
-			port.GetSize(pw, ph); u := port.unit;
-			paperW := r - l; paperH := b - t;
-			pageW := paperW - lm - rm; pageH := paperH - tm - bm;
-			leftM := lm; topM := tm; rightM := rm; botM := bm;
-			IF pageW > pw * u THEN pageW := pw * u END;
-			IF pageH > ph * u THEN pageH := ph * u END;
-			IF leftM + l < 0 THEN dw := -(leftM + l)
-			ELSIF paperW - rightM + l > pw * u THEN dw := pw * u - (paperW - rightM + l)
-			ELSE dw := 0
-			END;
-			IF topM + t < 0 THEN dh := -(topM + t)
-			ELSIF paperH - botM + t > ph * u THEN dh := ph * u - (paperH - botM + t)
-			ELSE dh := 0
-			END;
-			INC(leftM, dw); INC(topM, dh); INC(rightM, dw); INC(botM, dh)
-		ELSE
-			paperW := wA4; paperH := hA4;
-			pageW := paperW - lm - rm; pageH := paperH - tm - bm;
-			leftM := lm; topM := tm; rightM := rm; botM := bm
-		END;
-		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
-		defW := MAX(minW, pageW - m.l - defB);
-		defH := MAX(minH, pageH - m.t - defB);
-		Properties.PreferredSize(view, minW, maxW, minH, maxH, defW, defH, w, h);
-		opts := {}; rp.fixed := FALSE;
-		rp.horFitToPage := FALSE;
-		rp.verFitToPage := FALSE;
-		rp.horFitToWin := FALSE;
-		rp.verFitToWin := FALSE;
-		Views.HandlePropMsg(view, rp);
-		IF rp.horFitToPage THEN INCL(opts, pageWidth)
-		ELSIF rp.horFitToWin THEN INCL(opts, winWidth)
-		END;
-		IF rp.verFitToPage THEN INCL(opts, pageHeight)
-		ELSIF rp.verFitToWin THEN INCL(opts, winHeight)
-		END;
-		Views.BeginModification(Views.notUndoable, d);
-		m.view := view; d.x := 0; d.y := 0;
-		ctrl := d.ThisController();
-		ctrl.SetOpts(ctrl.opts - {pageWidth..winHeight});
-		d.SetPage(paperW, paperH, leftM, topM, paperW - rightM, paperH - botM, plain);
-		ASSERT(w > 0, 100); ASSERT(h > 0, 101);
-		d.SetRect(m.l, m.t, m.l + w, m.t + h);
-		ctrl.SetOpts(ctrl.opts + opts);
-		Views.EndModification(Views.notUndoable, d);
-		Stores.Join(d, view);
-		Views.Update(d, Views.rebuildFrames)
-	END SetView;
-
-	PROCEDURE (d: StdDocument) ThisView (): Views.View;
-	BEGIN
-		RETURN d.model.view
-	END ThisView;
-	
-	PROCEDURE (d: StdDocument) OriginalView (): Views.View;
-	BEGIN
-		IF d.original = NIL THEN RETURN d.model.view
-		ELSE RETURN d.original.model.view
-		END
-	END OriginalView;
-
-	PROCEDURE (d: StdDocument) SetRect (l, t, r, b: INTEGER);
-		VAR m: Model; op: SetRectOp; c: Containers.Controller; w, h: INTEGER;
-	BEGIN
-		ASSERT(l < r, 22); ASSERT(t < b, 25);
-		m := d.model;
-		IF (m.l # l) OR (m.t # t) THEN
-			m.r := l + m.r - m.l; m.l := l;
-			m.b := t + m.b - m.t; m.t := t;
-			Views.Update(d, Views.rebuildFrames)
-		END;
-		IF d.original # NIL THEN m := d.original.model END;
-		c := d.ThisController(); w := r - l; h := b - t;
-		IF (pageWidth IN c.opts) OR (winWidth IN c.opts) THEN w := m.r - m.l END;
-		IF (pageHeight IN c.opts) OR (winHeight IN c.opts) THEN h := m.b - m.t END;
-		IF (w # m.r - m.l) OR (h # m.b - m.t) THEN
-			NEW(op); op.model := m; op.w:= w; op.h := h;
-			Views.Do(d, resizingKey, op)
-		END
-	END SetRect;
-
-	PROCEDURE (d: StdDocument) SetPage (pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN);
-		VAR op: SetPageOp; doc: StdDocument;
-	BEGIN
-		IF d.original = NIL THEN doc := d ELSE doc := d.original END;
-		IF (doc.pw # pw) OR (doc.ph # ph) OR (doc.decorate # decorate)
-		OR (doc.pl # pl) OR (doc.pt # pt) OR (doc.pr # pr) OR (doc.pb # pb) THEN
-			ASSERT(0 <= pw, 20);
-			ASSERT(0 <= ph, 22);
-			ASSERT(0 <= pl, 24); ASSERT(pl < pr, 25); ASSERT(pr <= pw, 26);
-			ASSERT(0 <= pt, 27); ASSERT(pt < pb, 28); ASSERT(pb <= ph, 29);
-			NEW(op);
-			op.d := doc;
-			op.pw := pw; op.ph := ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
-			op.decorate := decorate;
-			Views.Do(doc, pageSetupKey, op)
-		END
-	END SetPage;
-
-	PROCEDURE (v: StdDocument) HandleViewMsg2 (f: Views.Frame; VAR msg: Views.Message);
-	BEGIN
-		WITH msg: UpdateMsg DO
-			IF (msg.doc = v) OR (msg.doc = v.original) THEN
-				Views.Update(v, Views.rebuildFrames)
-			END
-		ELSE
-		END
-	END HandleViewMsg2;
-
-	PROCEDURE (d: StdDocument) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
-																				VAR focus: Views.View);
-	BEGIN
-		WITH f: Views.RootFrame DO
-			WITH msg: Controllers.PollSectionMsg DO
-				PollSection(d, f, msg); focus := NIL
-			| msg: Controllers.ScrollMsg DO
-				Scroll(d, f, msg); focus := NIL
-			| msg: Controllers.PageMsg DO
-				Page(d, f, msg); focus := NIL
-			ELSE
-			END
-		END
-	END HandleCtrlMsg2;
-
-
-	(* Controller *)
-
-	PROCEDURE (c: Controller) Internalize2 (VAR rd: Stores.Reader);
-		VAR v: INTEGER;
-	BEGIN
-		rd.ReadVersion(minVersion, maxCtrlVersion, v)
-	END Internalize2;
-
-	PROCEDURE (c: Controller) Externalize2 (VAR wr: Stores.Writer);
-	BEGIN
-		wr.WriteVersion(maxCtrlVersion)
-	END Externalize2;
-
-	PROCEDURE (c: Controller) InitView2 (v: Views.View);
-	BEGIN
-		IF v # NIL THEN c.doc := v(StdDocument) ELSE c.doc := NIL END
-	END InitView2;
-
-	PROCEDURE (c: Controller) GetContextType (OUT type: Stores.TypeName);
-	END GetContextType;
-
-	PROCEDURE (c: Controller) GetValidOps (OUT valid: SET);
-	BEGIN
-		IF c.Singleton() # NIL THEN
-			valid := {Controllers.copy}
-		END
-	END GetValidOps;
-
-	PROCEDURE (c: Controller) NativeModel (m: Models.Model): BOOLEAN;
-	BEGIN
-		RETURN m IS Model
-	END NativeModel;
-
-	PROCEDURE (c: Controller) NativeView (v: Views.View): BOOLEAN;
-	BEGIN
-		RETURN v IS StdDocument
-	END NativeView;
-
-	PROCEDURE (c: Controller) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
-	BEGIN
-		RETURN Ports.arrowCursor
-	END NativeCursorAt;
-
-	PROCEDURE (c: Controller) PollNativeProp (selection: BOOLEAN; VAR p: Properties.Property;
-																		VAR truncated: BOOLEAN);
-	END PollNativeProp;
-
-	PROCEDURE (c: Controller) SetNativeProp (selection: BOOLEAN; p, old: Properties.Property);
-	END SetNativeProp;
-
-	PROCEDURE (c: Controller) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
-	BEGIN
-		IF selection THEN v := c.Singleton() ELSE v := c.doc.model.view END
-	END GetFirstView;
-
-	PROCEDURE (c: Controller) GetNextView (selection: BOOLEAN; VAR v: Views.View);
-	BEGIN
-		v := NIL
-	END GetNextView;
-
-	PROCEDURE (c: Controller) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
-	BEGIN
-		v := NIL
-	END GetPrevView;
-
-	PROCEDURE (c: Controller) TrackMarks (f: Views.Frame; x, y: INTEGER;
-															units, extend, add: BOOLEAN);
-	BEGIN
-		c.Neutralize
-	END TrackMarks;
-	
-	PROCEDURE (c: Controller) RestoreMarks2 (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		IF c.doc.context IS PrinterContext THEN Decorate(c.doc.context(PrinterContext), f) END
-	END RestoreMarks2;
-
-	PROCEDURE (c: Controller) Resize (view: Views.View; l, t, r, b: INTEGER);
-		VAR d: StdDocument; l0, t0: INTEGER;
-	BEGIN
-		d := c.doc;
-		ASSERT(view = d.model.view, 20);
-		l0 := d.model.l; t0 := d.model.t;
-		d.SetRect(l0, t0, l0 + r - l, t0 + b - t)
-	END Resize;
-
-	PROCEDURE (c: Controller) DeleteSelection;
-	END DeleteSelection;
-
-	PROCEDURE (c: Controller) MoveLocalSelection (f, dest: Views.Frame; x, y: INTEGER;
-														dx, dy: INTEGER);
-		VAR m: Model; l, t, r, b: INTEGER;
-	BEGIN
-		IF f = dest THEN
-			m := c.doc.model; DEC(dx, x); DEC(dy, y);
-			l := m.l + dx; t := m.t + dy;
-			r := m.r + dx; b := m.b + dy;
-			c.Resize(m.view, l, t, r, b);
-			IF c.Singleton() = NIL THEN c.SetSingleton(m.view) END
-		END
-	END MoveLocalSelection;
-
-	PROCEDURE (c: Controller) SelectionCopy (): Model;
-	BEGIN
-		RETURN NIL
-	END SelectionCopy;
-
-	PROCEDURE (c: Controller) NativePaste (m: Models.Model; f: Views.Frame);
-		VAR m0: Model;
-	BEGIN
-		WITH m: Model DO
-			m0 := c.doc.model;
-			m0.ReplaceView(m0.view, m.view);
-			c.doc.SetRect(m.l, m.t, m.r, m.b)
-		END
-	END NativePaste;
-
-	PROCEDURE (c: Controller) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
-		VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
-	BEGIN
-		m := c.doc.model;
-		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
-		defW := m.r - m.l; defH := m.b - m.t;
-		Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
-		m.ReplaceView(m.view, v);
-		c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
-	END PasteView;
-
-	PROCEDURE (c: Controller) Drop (src, dst: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
-												v: Views.View; isSingle: BOOLEAN);
-		VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
-	BEGIN
-		m := c.doc.model;
-		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
-		defW := m.r - m.l; defH := m.b - m.t;
-		Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
-		m.ReplaceView(m.view, v);
-		c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
-	END Drop;
-
-	(* selection *)
-
-	PROCEDURE (c: Controller) Selectable (): BOOLEAN;
-	BEGIN
-		RETURN TRUE
-	END Selectable;
-
-	PROCEDURE (c: Controller) SelectAll (select: BOOLEAN);
-	BEGIN
-		IF ~select & (c.Singleton() # NIL) THEN
-			c.SetSingleton(NIL)
-		ELSIF select & (c.Singleton() = NIL) THEN
-			c.SetSingleton(c.doc.model.view)
-		END
-	END SelectAll;
-
-	PROCEDURE (c: Controller) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
-	BEGIN
-		RETURN c.Singleton() # NIL
-	END InSelection;
-
-	(* caret *)
-
-	PROCEDURE (c: Controller) HasCaret (): BOOLEAN;
-	BEGIN
-		RETURN FALSE
-	END HasCaret;
-
-	PROCEDURE (c: Controller) MarkCaret (f: Views.Frame; show: BOOLEAN);
-	END MarkCaret;
-
-	PROCEDURE (c: Controller) CanDrop (f: Views.Frame; x, y: INTEGER): BOOLEAN;
-	BEGIN
-		RETURN FALSE
-	END CanDrop;
-
-	(* handlers *)
-
-	PROCEDURE (c: Controller) HandleCtrlMsg (f: Views.Frame;
-								 VAR msg: Controllers.Message; VAR focus: Views.View);
-		VAR l, t, r, b: INTEGER;
-	BEGIN
-		IF ~(Containers.noFocus IN c.opts) THEN
-			WITH msg: Controllers.TickMsg DO
-				IF c.Singleton() = NIL THEN c.SetFocus(c.doc.model.view) END
-			| msg: Controllers.CursorMessage DO
-				IF c.Singleton() = NIL THEN	(* delegate to focus, even if not directly hit *)
-					focus := c.ThisFocus();
-					c.doc.GetRect(f, focus, l, t, r, b);	(* except for resize in lower right corner *)
-					IF (c.opts * {pageWidth..winHeight} # {})
-						OR (msg.x < r) OR (msg.y < b) THEN RETURN END
-				END
-			ELSE
-			END
-		END;
-		c.HandleCtrlMsg^(f, msg, focus)
-	END HandleCtrlMsg;
-	
-	
-	PROCEDURE (c: Controller) PasteChar (ch: CHAR);
-	END PasteChar;
-	
-	PROCEDURE (c: Controller) ControlChar (f: Views.Frame; ch: CHAR);
-	END ControlChar;
-	
-	PROCEDURE (c: Controller) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
-	END ArrowChar;
-	
-	PROCEDURE (c: Controller) CopyLocalSelection (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER);
-	END CopyLocalSelection;
-
-
-	(* StdContext *)
-
-	PROCEDURE (c: StdContext) ThisModel (): Models.Model;
-	BEGIN
-		RETURN c.model
-	END ThisModel;
-
-	PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
-		VAR m: Model; dc: Models.Context; l, t, r, b: INTEGER;
-	BEGIN
-		m := c.model;
-		m.doc.PollRect(l, t, r, b); w := r - l; h := b - t;
-		dc := m.doc.context;
-		IF dc # NIL THEN
-			WITH dc: PrinterContext DO
-				w := MIN(w, dc.r - dc.l); h := MIN(h, dc.b - dc.t)
-			ELSE
-			END
-		END;
-		ASSERT(w > 0, 60); ASSERT(h > 0, 61)
-	END GetSize;
-
-	PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
-		VAR m: Model; d: StdDocument; minW, maxW, minH, maxH,  defW, defH: INTEGER;
-	BEGIN
-		m := c.model; d := m.doc; ASSERT(d # NIL, 20);
-		m.GetEmbeddingLimits(minW, maxW, minH, maxH);
-		defW := m.r - m.l; defH := m.b - m.t;
-		Properties.PreferredSize(m.view, minW, maxW, minH, maxH, defW, defH, w, h);
-		d.SetRect(m.l, m.t, m.l + w, m.t + h)
-	END SetSize;
-
-	PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
-	BEGIN
-		RETURN TRUE
-	END Normalize;
-
-	PROCEDURE (c: StdContext) ThisDoc (): Document;
-	BEGIN
-		RETURN c.model.doc
-	END ThisDoc;
-
-	PROCEDURE (c: StdContext) MakeVisible (l, t, r, b: INTEGER);
-	BEGIN
-		MakeVisible(c.model.doc, NIL, l, t, r, b)
-	END MakeVisible;
-
-
-	(* PrinterContext *)
-
-	PROCEDURE (c: PrinterContext) GetSize (OUT w, h: INTEGER);
-		VAR p: Ports.Port;
-	BEGIN
-		p := c.pr.ThisPort();
-		p.GetSize(w, h);
-		w := w * p.unit;
-		h := h * p.unit
-	END GetSize;
-
-	PROCEDURE (c: PrinterContext) Normalize (): BOOLEAN;
-	BEGIN
-		RETURN TRUE
-	END Normalize;
-	
-	PROCEDURE (c: PrinterContext) SetSize (w, h: INTEGER);
-	END SetSize;
-	
-	PROCEDURE (c: PrinterContext) ThisModel (): Models.Model;
-	BEGIN
-		RETURN NIL
-	END ThisModel;
-
-
-	(* StdDirectory *)
-
-	PROCEDURE (d: StdDirectory) New (view: Views.View; w, h: INTEGER): Document;
-		VAR doc: StdDocument; m: Model; c: Controller;
-	BEGIN
-		ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
-		NEW(m);
-		NEW(doc); doc.InitModel(m);
-		NEW(c); doc.SetController(c);
-		doc.SetRect(defB, defB, defB + 1, defB + 1);	(* set top-left point *)
-		doc.SetView(view, w, h);	(* joins store graphs of doc and view *)
-		Stores.InitDomain(doc);	(* domains of new documents are bound *)
-		RETURN doc
-	END New;
-
-
-	(** PContext **)
-
-	PROCEDURE (c: PContext) GetSize (OUT w, h: INTEGER);
-	BEGIN
-		w := c.w; h := c.h
-	END GetSize;
-	
-	PROCEDURE (c: PContext) Normalize (): BOOLEAN;
-	BEGIN
-		RETURN TRUE
-	END Normalize;
-	
-	PROCEDURE (c: PContext) SetSize (w, h: INTEGER);
-	END SetSize;
-	
-	PROCEDURE (c: PContext) ThisModel (): Models.Model;
-	BEGIN
-		RETURN NIL
-	END ThisModel;
-	
-
-	(** Pager **)
-	
-
-	PROCEDURE (p: Pager) Restore (f: Views.Frame; l, t, r, b: INTEGER);
-	BEGIN
-		Views.InstallFrame(f, p.con.view, -p.x, -p.y, 0, FALSE)
-	END Restore;
-	
-	PROCEDURE (p: Pager) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
-		VAR v: Views.View; g: Views.Frame;
-	BEGIN
-		WITH msg: Controllers.PageMsg DO
-			v := p.con.view; g := Views.ThisFrame(f, v);
-			IF g = NIL THEN
-				Views.InstallFrame(f, v, 0, 0, 0, FALSE);
-				g := Views.ThisFrame(f, v)
-			END;
-			IF g # NIL THEN
-				Views.ForwardCtrlMsg(g, msg);
-				IF ~msg.done THEN
-					IF p.con.w > p.w THEN 	(* needs horizontal paging *)
-						IF msg.op = Controllers.gotoPageX THEN p.x := msg.pageX * p.w; msg.done := TRUE
-						ELSIF msg.op = Controllers.nextPageX THEN p.x := p.x + p.w; msg.done := TRUE
-						END;
-						IF p.x >= p.con.w THEN msg.eox := TRUE; p.x := 0 END
-					END;
-					IF p.con.h > p.h THEN	(* needs vertical paging *)
-						IF msg.op = Controllers.gotoPageY THEN p.y := msg.pageY * p.h; msg.done := TRUE
-						ELSIF msg.op = Controllers.nextPageY THEN p.y := p.y + p.h; msg.done := TRUE
-						END;
-						IF p.y >= p.con.h THEN msg.eoy := TRUE; p.y := 0 END
-					END
-				END
-			END
-		ELSE focus := p.con.view
-		END
-	END HandleCtrlMsg;
-	
-	PROCEDURE NewPager (v: Views.View; w, h, pw, ph: INTEGER): Pager;
-		VAR p: Pager; c: PContext;
-	BEGIN
-		NEW(c); c.view := v; c.w := w; c.h := h; v.InitContext(c);
-		NEW(p); p.con := c; p.w := pw; p.h := ph; p.x := 0; p.y := 0;
-		Stores.Join(v, p);
-		RETURN p
-	END NewPager;
-	
-	PROCEDURE PrinterDoc (d: Document; c: PrinterContext): Document;
-		VAR v, u, p: Views.View; w, h, l, t, r, b, pw, ph: INTEGER; pd: Document;
-			ct: Containers.Controller; dec: BOOLEAN; seq: ANYPTR;
-	BEGIN
-		v := d.ThisView();
-
-		IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
-			IF seq#NIL THEN seq(Sequencers.Sequencer).BeginModification(Sequencers.invisible, d) END
-		END;
-		u := Views.CopyOf(v, Views.shallow);
-		IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
-			IF seq#NIL THEN seq(Sequencers.Sequencer).EndModification(Sequencers.invisible, d) END
-		END;
-
-		d.PollPage(w, h, l, t, r, b, dec); pw := r - l; ph := b - t;	(* page size *)
-		v.context.GetSize(w, h);
-		ct := d.ThisController();
-		IF winWidth IN ct.opts THEN w := pw END;	(* fit to win -> fit to page *)
-		IF winHeight IN ct.opts THEN h := ph END;
-		p := NewPager(u, w, h, pw, ph);
-		ASSERT(Stores.Joined(p, d), 100);
-		pd := dir.New(p, pw, ph);
-		pd.InitContext(c);
-		RETURN pd
-	END PrinterDoc;
-	
-
-	(** miscellaneous **)
-
-	PROCEDURE Print* (d: Document; p: Printers.Printer; par: Printing.Par);
-		VAR dom: Stores.Domain; d1: Document; f: Views.RootFrame; g: Views.Frame;
-			c: PrinterContext; from, to, this, copies, w, h, u, k: INTEGER; page: Controllers.PageMsg;
-			title: Views.Title; port: Ports.Port;
-	BEGIN
-		ASSERT(d # NIL, 20); ASSERT(p # NIL, 21);
-		ASSERT(par # NIL, 22);
-		ASSERT(par.page.from >= 0, 23); ASSERT(par.page.from <= par.page.to, 24);
-		ASSERT(par.copies > 0, 25);
-		IF (par.header.right # "") OR (par.page.alternate & (par.header.left # "")) THEN
-			ASSERT(par.header.font # NIL, 26)
-		END;
-		IF (par.footer.right # "") OR (par.page.alternate & (par.footer.left # "")) THEN
-			ASSERT(par.footer.font # NIL, 27)
-		END;
-		IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
-		from := par.page.from; to := par.page.to;
-		copies := par.copies;
-		CheckOrientation(d, p);
-		p.OpenJob(copies, title);
-		IF p.res = 0 THEN
-			dom := d.Domain();
-			ASSERT(dom # NIL, 100);
-			c := NewPrinterContext(d, p, par);
-			d1 := PrinterDoc(d, c);
-			CheckOrientation(d, p);	(* New in PrinterDoc resets printer orientation *)
-			d1.GetNewFrame(g); f := g(Views.RootFrame); f.ConnectTo(p.ThisPort());
-			Views.SetRoot(f, d1, FALSE, {}); Views.AdaptRoot(f);
-			current := 0; (*par.page.current := 0; *)
-			d1.Restore(f, 0, 0, 0, 0);	(* install frame for doc's view *)
-			Kernel.PushTrapCleaner(cleaner);
-			port := p.ThisPort();
-			Printing.par := par;
-			page.op := Controllers.gotoPageX; page.pageX := 0;
-			page.done := FALSE; page.eox := FALSE;
-			Views.ForwardCtrlMsg(f, page);
-			IF page.done THEN this := 0 ELSE this := from END;
-			page.op := Controllers.gotoPageY; page.pageY := this;
-			page.done := FALSE; page.eoy := FALSE;
-			Views.ForwardCtrlMsg(f, page);
-			IF ~page.done & (from > 0) OR page.eox OR page.eoy THEN to := -1 END;
-			WHILE this <= to DO
-				IF this >= from THEN
-					current := this; (*par.page.current := this;*)
-					port.GetSize(w, h); u := port.unit;
-					FOR k := copies TO par.copies DO
-						p.OpenPage;
-						IF p.res = 0 THEN
-							Views.RemoveFrames(f, 0, 0, w * u, h * u);
-							Views.RestoreRoot(f, 0, 0, w * u, h * u)
-						END;
-						p.ClosePage
-					END
-				END;
-				IF p.res # abort THEN INC(this) ELSE to := -1 END;
-				IF this <= to THEN
-					page.op := Controllers.nextPageX;
-					page.done := FALSE; page.eox := FALSE;
-					Views.ForwardCtrlMsg(f, page);
-					IF ~page.done OR page.eox THEN
-						IF page.done THEN
-							page.op := Controllers.gotoPageX; page.pageX := 0;
-							page.done := FALSE; page.eox := FALSE;
-							Views.ForwardCtrlMsg(f, page)
-						END;
-						page.op := Controllers.nextPageY;
-						page.done := FALSE; page.eoy := FALSE;
-						Views.ForwardCtrlMsg(f, page);
-						IF ~page.done OR page.eoy THEN to := -1 END
-					END
-				END
-			END;
-			Printing.par := NIL;
-			Kernel.PopTrapCleaner(cleaner)
-		ELSE Dialog.ShowMsg("#System:FailedToOpenPrintJob")
-		END;
-		p.CloseJob
-	END Print;
-
-	PROCEDURE (hook: PrintingHook) Current(): INTEGER;
-	BEGIN
-		RETURN current
-	END Current;
-	
-	PROCEDURE (hook: PrintingHook) Print (v: Views.View; par: Printing.Par);
-		VAR dom: Stores.Domain;  d: Document; f: Views.RootFrame; c: PrinterContext;
-			w, h, u: INTEGER; p: Printers.Printer; g: Views.Frame; title: Views.Title;
-			k, copies: INTEGER; port: Ports.Port;
-	BEGIN
-		ASSERT(v # NIL, 20);
-		p := Printers.dir.Current();
-		ASSERT(p # NIL, 21);
-		IF v IS Document THEN Print(v(Document), p, par); RETURN END;
-		IF (v.context # NIL) & (v.context IS Context) THEN
-			Print(v.context(Context).ThisDoc(), p, par); RETURN
-		END;
-		p.SetOrientation(FALSE);
-		IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
-		copies := par.copies;
-		p.OpenJob(copies, title);
-		IF p.res = 0 THEN
-			Printing.par := par;
-			Stores.InitDomain(v);
-			dom := v.Domain();
-			v := Views.CopyOf(v, Views.shallow) ;
-			d := dir.New(v, Views.undefined, Views.undefined);
-			c := NewPrinterContext(d, (* dom, *) p, par);
-			d.InitContext(c); (* Stores.InitDomain(d, c.Domain()); (* nicht mehr noetig *) *)
-			d.GetNewFrame(g); f := g(Views.RootFrame); 
-			port := p.ThisPort(); f.ConnectTo(port);
-			Views.SetRoot(f, d, FALSE, {}); Views.AdaptRoot(f);
-			port.GetSize(w, h); u := port.unit;
-			FOR k := copies TO par.copies DO
-				p.OpenPage;
-				IF p.res = 0 THEN
-					Views.RemoveFrames(f, 0, 0, w * u, h * u); Views.RestoreRoot(f, 0, 0, w * u, h * u)
-				END;
-				p.ClosePage
-			END
-		END;
-		Printing.par := NIL;
-		p.CloseJob
-	END Print;
-
-
-	PROCEDURE ImportDocument* (f: Files.File; OUT s: Stores.Store);
-		VAR r: Stores.Reader; tag, version: INTEGER;
-	BEGIN
-		ASSERT(f # NIL, 20);
-		r.ConnectTo(f);
-		r.ReadInt(tag);
-		IF tag = docTag THEN
-			r.ReadInt(version);
-			ASSERT(version = docVersion, 100);
-			r.ReadStore(s);
-			IF s IS Document THEN s := s(Document).ThisView()
-			ELSE s := NIL
-			END
-		END
-	END ImportDocument;
-
-	PROCEDURE ExportDocument* (s: Stores.Store; f: Files.File);
-		VAR w: Stores.Writer; v: Views.View;
-	BEGIN
-		ASSERT(s # NIL, 20);
-		ASSERT(s IS Views.View, 21);
-		ASSERT(f # NIL, 22);
-		v := s(Views.View);
-		IF (v.context # NIL) & (v.context IS Context) THEN
-			v := v.context(Context).ThisDoc()
-		END;
-		IF ~(v IS Document) THEN
-			IF v.context # NIL THEN
-				v := Views.CopyOf(v, Views.shallow)
-			END;
-			v := dir.New(v, Views.undefined, Views.undefined)
-		END;
-		w.ConnectTo(f);
-		w.WriteInt(docTag); w.WriteInt(docVersion);
-		w.WriteStore(v)
-	END ExportDocument;
-
-
-	PROCEDURE SetDir* (d: Directory);
-	BEGIN
-		ASSERT(d # NIL, 20);
-		dir := d;
-		IF stdDir = NIL THEN stdDir := d END
-	END SetDir;
-	
-	PROCEDURE Init;
-		VAR d: StdDirectory; h: PrintingHook;
-	BEGIN
-		NEW(d); SetDir(d);
-		NEW(h); Printing.SetHook(h);
-		NEW(cleaner)
-	END Init;
-
-BEGIN
-	Init
-END Documents.

new/System/Mod/Files.txt

@@ -1,110 +0,0 @@
-MODULE Files;
-
-	(* THIS IS TEXT COPY OF BlackBox-1.6 System/Mod/Files.odc *)
-	(* DO NOT EDIT *)
-
-	IMPORT Kernel;
-
-	CONST 
-		shared* = TRUE; exclusive* = FALSE;
-		dontAsk* = FALSE; ask* = TRUE; (** File.Register, Directory.New and Directory.Rename  **)
-
-	CONST
-		readOnly* = 0;
-		hidden* = 1;
-		system* = 2;
-		archive* = 3;
-		stationery* = 4;
-
-	TYPE
-		Name* = ARRAY 256 OF CHAR;
-		Type* = ARRAY 16 OF CHAR;
-
-		FileInfo* = POINTER TO RECORD
-			next*: FileInfo;
-			name*: Name;
-			length*: INTEGER;
-			type*: Type;
-			modified*: RECORD year*, month*, day*, hour*, minute*, second*: INTEGER END;
-			attr*: SET
-		END;
-
-		LocInfo* = POINTER TO RECORD
-			next*: LocInfo;
-			name*: Name;
-			attr*: SET;
-		END;
-
-		Locator* = POINTER TO ABSTRACT RECORD
-			res*: INTEGER;
-		END;
-
-		File* = POINTER TO ABSTRACT RECORD
-			type-: Type;
-			init: BOOLEAN;
-		END;
-
-		Reader* = POINTER TO ABSTRACT RECORD
-			eof*: BOOLEAN;
-		END;
-
-		Writer* = POINTER TO ABSTRACT RECORD END;
-
-		Directory* = POINTER TO ABSTRACT RECORD END;
-
-	VAR dir-, stdDir-: Directory;
-		objType-, symType-, docType- : Type;	(* file types *)
-
-
-	PROCEDURE (l: Locator) This* (IN path: ARRAY OF CHAR): Locator, NEW, ABSTRACT;
-
-	PROCEDURE (f: File) InitType* (type: Type), NEW;
-	BEGIN
-		ASSERT(~f.init, 20);
-		f.type := type$; f.init := TRUE
-	END InitType;
-
-	PROCEDURE (f: File) Length* (): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (f: File) NewReader* (old: Reader): Reader, NEW, ABSTRACT;
-	PROCEDURE (f: File) NewWriter* (old: Writer): Writer, NEW, ABSTRACT;
-	PROCEDURE (f: File) Flush* (), NEW, ABSTRACT;
-	PROCEDURE (f: File) Register* (name: Name; type: Type; ask: BOOLEAN;
-													OUT res: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (f: File) Close* (), NEW, ABSTRACT;
-	
-	PROCEDURE (r: Reader) Base* (): File, NEW, ABSTRACT;
-	PROCEDURE (r: Reader) Pos* (): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (r: Reader) SetPos* (pos: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (r: Reader) ReadByte* (OUT x: BYTE), NEW, ABSTRACT;
-	PROCEDURE (r: Reader) ReadBytes* (VAR x: ARRAY OF BYTE; beg, len: INTEGER), NEW, ABSTRACT;
-	
-	PROCEDURE (w: Writer) Base* (): File, NEW, ABSTRACT;
-	PROCEDURE (w: Writer) Pos* (): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (w: Writer) SetPos* (pos: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (w: Writer) WriteByte* (x: BYTE), NEW, ABSTRACT;
-	PROCEDURE (w: Writer) WriteBytes* (IN x: ARRAY OF BYTE; beg, len: INTEGER), NEW, ABSTRACT;
-	
-	PROCEDURE (d: Directory) This* (IN path: ARRAY OF CHAR): Locator, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) New* (loc: Locator; ask: BOOLEAN): File, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) Old* (loc: Locator; name: Name; shared: BOOLEAN): File, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) Temp* (): File, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) Delete* (loc: Locator; name: Name), NEW, ABSTRACT;
-	PROCEDURE (d: Directory) Rename* (loc: Locator; old, new: Name; ask: BOOLEAN), NEW, ABSTRACT;
-	PROCEDURE (d: Directory) SameFile* (loc0: Locator; name0: Name; loc1: Locator;
-																name1: Name): BOOLEAN, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) FileList* (loc: Locator): FileInfo, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) LocList* (loc: Locator): LocInfo, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) GetFileName* (name: Name; type: Type; OUT filename: Name), NEW, ABSTRACT;
-			
-	PROCEDURE SetDir* (d: Directory);
-	BEGIN
-		ASSERT(d # NIL, 20);
-		dir := d;
-		IF stdDir = NIL THEN stdDir := d END
-	END SetDir;
-
-BEGIN
-	objType := Kernel.objType;
-	symType := Kernel.symType;
-	docType := Kernel.docType;
-END Files.

new/System/Mod/Fonts.txt

@@ -1,59 +0,0 @@
-MODULE Fonts;
-
-	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Fonts.odc *)
-	(* DO NOT EDIT *)
-
-	CONST
-		(** universal units **)
-		mm* = 36000;
-		point* = 12700;	(** 1/72 inch **)
-
-		italic* = 0; underline* = 1; strikeout* = 2;	(** style elements **)
-
-		normal* = 400; bold* = 700;
-		
-		default* = "*";
-
-	TYPE
-		Typeface* = ARRAY 64 OF CHAR;
-
-		Font* = POINTER TO ABSTRACT RECORD
-			typeface-: Typeface;
-			size-: INTEGER;
-			style-: SET;
-			weight-: INTEGER
-		END;
-
-		TypefaceInfo* = POINTER TO RECORD
-			next*: TypefaceInfo;
-			typeface*: Typeface
-		END;
-
-		Directory* = POINTER TO ABSTRACT RECORD
-		END;
-		
-	VAR dir-: Directory;
-
-	PROCEDURE (f: Font) Init* (typeface: Typeface; size: INTEGER; style: SET; weight: INTEGER), NEW;
-	BEGIN
-		ASSERT(f.size = 0, 20); ASSERT(size # 0, 21);
-		f.typeface := typeface$; f.size := size; f.style := style; f.weight := weight
-	END Init;
-
-	PROCEDURE (f: Font) GetBounds* (OUT asc, dsc, w: INTEGER), NEW, ABSTRACT;
-	PROCEDURE (f: Font) StringWidth* (IN s: ARRAY OF CHAR): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (f: Font) SStringWidth* (IN s: ARRAY OF SHORTCHAR): INTEGER, NEW, ABSTRACT;
-	PROCEDURE (f: Font) IsAlien* (): BOOLEAN, NEW, ABSTRACT;
-	
-	PROCEDURE (d: Directory) This* (typeface: Typeface; size: INTEGER; style: SET; weight: INTEGER): Font, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) Default* (): Font, NEW, ABSTRACT;
-	PROCEDURE (d: Directory) TypefaceList* (): TypefaceInfo, NEW, ABSTRACT;
-	
-	PROCEDURE SetDir* (d: Directory);
-	BEGIN
-		ASSERT(d # NIL, 20);
-		dir := d
-	END SetDir;
-
-END Fonts.
-