blackbox-linux-console/BlackBox/Dev/Mod/CPC486.txt

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.