blackbox-linux-console/BlackBox/System/Mod/Meta.txt

MODULE Meta;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc System/Mod/Meta.odc *)
	(* DO NOT EDIT *)

	IMPORT SYSTEM, Kernel;

	CONST
		(** result codes for object classes, type classes, visibility classes **)
		undef* = 0;

		(** object classes **)
		typObj* = 2; varObj* = 3; procObj* = 4; fieldObj* = 5; modObj* = 6; parObj* = 7;

		(** type classes **)
		boolTyp* = 1; sCharTyp* = 2; charTyp* = 3;
		byteTyp* = 4; sIntTyp* = 5; intTyp* = 6;
		sRealTyp* = 7; realTyp* = 8; setTyp* = 9;
		longTyp* = 10; anyRecTyp* = 11; anyPtrTyp* = 12;
		sysPtrTyp = 13; 
		procTyp* = 16; recTyp* = 17; arrTyp* = 18; ptrTyp* = 19;
		
		(** record attributes **)
		final* = 0; extensible* = 1; limited* = 2; abstract* = 3;
		
		(** visibility **)
		hidden* = 1; readOnly* = 2; private = 3; exported* = 4;
		value* = 10; in* = 11; out* = 12; var* = 13;

		(* scanner modes *)
		modScan = 1; globScan = 2; recVarScan = 3; recTypeScan = 4;

	TYPE
		Name* = ARRAY 256 OF CHAR;

		Value* = ABSTRACT RECORD END;	(* to be extended once with a single field of any type *)
		
		ArrayPtr = POINTER TO Array;

		Item* = RECORD (Value)
			obj-: INTEGER;			(* typObj, varObj, procObj, fieldObj, modObj, parObj *)
			typ-: INTEGER;			(* typObj, varObj, fieldObj, parObj: type;	else: 0 *)
			vis-: INTEGER;			(* varObj, procObj, fieldObj, parObj: vis;	else: 0 *)
			adr-: INTEGER;			(* varObj, procObj: adr;	fieldObj: offs;	parObj: num;	else: 0 *)
			mod: Kernel.Module;	(* static varObj, procObj, modObj: mod;	else: NIL *)
			desc: Kernel.Type;		(* typObj, varObj, fieldObj, parObj: struct;	procObj: sig;	else: NIL *)
			ptr: ArrayPtr;				  (* # NIL => item valid;	dynamic varObj: ptr;	else: dummy *)
			ext: Kernel.ItemExt		(* all method calls forwarded if # NIL *)
		END;

		Scanner* = RECORD
			this-: Item;
			eos-: BOOLEAN;	(* end of scan *)
			mode: INTEGER;	(* modScan, globScan, recVarScan, recTypeScan *)
			base: INTEGER;	(* recVarScan, recTypeScan: base level index *)
			vis: INTEGER;		(* recVarScan: record vis *)
			adr: INTEGER;		(* recVarScan: record adr *)
			idx: INTEGER;		(* globScan, recVarScan, recTypeScan: object index *)
			desc: Kernel.Type;	(* recVarScan, recTypeScan: record desc *)
			mod: Kernel.Module;	(* modScan: next mod;	globScan, recVarScan: source mod *)
			obj: Kernel.Object	(* globScan, recVarScan, recTypeScan: actual object *)
		END;
		
		LookupFilter* = PROCEDURE (IN path: ARRAY OF CHAR; OUT i: Item; OUT done: BOOLEAN);
	
		FilterHook = POINTER TO RECORD
			next: FilterHook;
			filter: LookupFilter
		END;

		Array = EXTENSIBLE RECORD
			w0, w1, w2: INTEGER;	(* gc header *)
			len: ARRAY 16 OF INTEGER	(* dynamic array length table *)
		END;
		
		SStringPtr = POINTER TO ARRAY [1] OF SHORTCHAR;
		StringPtr = POINTER TO ARRAY [1] OF CHAR;
	
	VAR
		dummy: ArrayPtr;	(* dummy object for item.ptr *)
		filterHook: FilterHook;


	(* preconditions:
		ASSERT(i.ptr # NIL, 20);	(* invalid item *)
		ASSERT(i.typ >= recTyp, 21);	(* wrong type *)
		ASSERT(i.obj = varObj, 22);	(* wrong object class *)
		ASSERT((i.mod = NIL) OR (i.mod.refcnt >= 0), 23);	(* unloaded object module *)
		ASSERT(i.desc.mod.refcnt >= 0, 24);	(* unloaded type module *)
		ASSERT(d.id DIV 16 MOD 16 = 1, 25);	(* value not extended once *)
		ASSERT(d.fields.num = 1, 26);	(* not a single value field *)
		ASSERT(i.vis = exported, 27);	(* write protected destination *)
		ASSERT(type.desc.base[t.id DIV 16 MOD 16] = t, 28);	(* wrong pointer type *)
		ASSERT((i < n) & (d.obj[i].id DIV 16 MOD 16 = exported), 29);	(* unexported type *)
		ASSERT(type.desc.id DIV 4 MOD 4 < limited, 30);	(* limited or abstract type *)
		ASSERT(i.ext = NIL, 31);	(* unsupported extension *)
	*)


	PROCEDURE DescOf (IN x: ANYREC): Kernel.Type;
	BEGIN
		RETURN SYSTEM.VAL(Kernel.Type, SYSTEM.TYP(x))
	END DescOf;

	PROCEDURE TypOf (struct: Kernel.Type): INTEGER;
	BEGIN
		IF SYSTEM.VAL(INTEGER, struct) DIV 256 = 0 THEN
			RETURN SYSTEM.VAL(INTEGER, struct)
		ELSE
			RETURN 16 + struct.id MOD 4
		END
	END TypOf;
	
	PROCEDURE LenOf (IN i: Item): INTEGER;
	BEGIN
		IF i.desc.size # 0 THEN RETURN i.desc.size
		ELSIF i.ptr = dummy THEN RETURN 0
		ELSE RETURN i.ptr.len[i.desc.id DIV 16 MOD 16 - 1]
		END
	END LenOf;
	
	PROCEDURE SizeOf (IN i: Item): INTEGER;
		VAR el: Item;
	BEGIN
		CASE i.typ OF
		| anyRecTyp: RETURN 0
		| boolTyp, sCharTyp, byteTyp: RETURN 1
		| charTyp, sIntTyp: RETURN 2
		| longTyp, realTyp: RETURN 8
		| recTyp: RETURN i.desc.size
		| arrTyp:
			el.desc := i.desc.base[0]; el.typ := TypOf(el.desc); el.ptr := i.ptr; 
			RETURN LenOf(i) * SizeOf(el)
		ELSE RETURN 4
		END
	END SizeOf;
	
	PROCEDURE SignatureOf (IN i: Item): Kernel.Signature;
	BEGIN
		IF i.obj = procObj THEN
			RETURN SYSTEM.VAL(Kernel.Signature, i.desc)
		ELSE
			RETURN SYSTEM.VAL(Kernel.Signature, i.desc.base[0])
		END
	END SignatureOf;
	
	
	PROCEDURE GetName (IN path: ARRAY OF CHAR; OUT 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 LegalName (IN name: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; ch := name[0];
		WHILE (i < LEN(name) - 1) & ((ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z")
											OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_")) DO
			INC(i); ch := name[i]
		END;
		RETURN (i > 0) & (ch = 0X)
	END LegalName;
	

	(* ---------- Item properties ---------- *)
	
	PROCEDURE (VAR i: Item) Valid* (): BOOLEAN, NEW;
	BEGIN
		IF i.ext # NIL THEN RETURN i.ext.Valid() END;
		RETURN (i.ptr # NIL) & ((i.mod = NIL) OR (i.mod.refcnt >= 0)) & ((i.typ < recTyp) OR (i.desc.mod.refcnt >= 0))
	END Valid;

	PROCEDURE (VAR i: Item) GetTypeName* (OUT mod, type: Name), NEW;
		VAR n: Kernel.Name;
	BEGIN
		ASSERT(i.ext = NIL, 31);
		ASSERT(i.ptr # NIL, 20);
		ASSERT(i.typ >= recTyp, 21);
		ASSERT(i.desc.mod.refcnt >= 0, 24);
		mod := i.desc.mod.name$;
		Kernel.GetTypeName(i.desc, n);
		type := n$
	END GetTypeName;

	PROCEDURE (VAR i: Item) BaseTyp* (): INTEGER, NEW;
	BEGIN
		IF i.ext # NIL THEN RETURN i.ext.BaseTyp() END;
		ASSERT(i.ptr # NIL, 20);
		ASSERT(i.typ IN {arrTyp, recTyp, ptrTyp}, 21);
		RETURN TypOf(i.desc.base[0])
	END BaseTyp;

	PROCEDURE (VAR i: Item) Level* (): INTEGER, NEW;
	BEGIN
		ASSERT(i.ext = NIL, 31);
		ASSERT(i.ptr # NIL, 20);
		ASSERT(i.typ IN {recTyp, arrTyp}, 21);
		RETURN i.desc.id DIV 16 MOD 16
	END Level;

	PROCEDURE (VAR i: Item) Attribute* (): INTEGER, NEW;
	BEGIN
		ASSERT(i.ext = NIL, 31);
		ASSERT(i.ptr # NIL, 20);
		ASSERT(i.typ = recTyp, 21);
		RETURN i.desc.id DIV 4 MOD 4
	END Attribute;

	PROCEDURE (VAR i: Item) Size* (): INTEGER, NEW;
	BEGIN
		IF i.ext # NIL THEN RETURN i.ext.Size() END;
		ASSERT(i.ptr # NIL, 20);
		ASSERT(i.typ # undef, 21);
		RETURN SizeOf(i)
	END Size;
	
	PROCEDURE (VAR arr: Item) Len* (): INTEGER, NEW;
	BEGIN
		IF arr.ext # NIL THEN RETURN arr.ext.Len() END;
		ASSERT(arr.ptr # NIL, 20);
		ASSERT(arr.typ = arrTyp, 21);
		RETURN LenOf(arr)
	END Len;
	
	(* ---------- Item generation ---------- *)

	PROCEDURE SetUndef (VAR i: Item);
	BEGIN
		i.typ := undef; i.obj := undef; i.vis := undef;
		i.adr := undef; i.mod := NIL; i.desc := NIL; i.ptr := NIL; i.ext := NIL;
	END SetUndef;
	
	PROCEDURE SetItem (VAR i: Item; obj: Kernel.Object; mod: Kernel.Module);
		VAR t: Kernel.Type;
	BEGIN
		i.obj := obj.id MOD 16;
		i.vis := obj.id DIV 16 MOD 16;
		IF i.obj = procObj THEN
			i.typ := undef; i.desc := SYSTEM.VAL(Kernel.Type, obj.struct);
			i.adr := mod.procBase + obj.offs; i.mod := mod
		ELSE
			i.typ := TypOf(obj.struct); i.desc := obj.struct;
			IF i.obj = varObj THEN i.adr := mod.varBase + obj.offs; i.mod := mod
			ELSIF i.obj = fieldObj THEN i.adr := obj.offs; i.mod := NIL
			ELSE i.adr := undef; i.mod := NIL
			END
		END;
		i.ext := NIL
	END SetItem;
	
	PROCEDURE SetMod (VAR i: Item; mod: Kernel.Module);
	BEGIN
		i.obj := modObj; i.typ := undef; i.vis := undef;
		i.adr := undef; i.mod := mod; i.desc := NIL; i.ptr := dummy; i.ext := NIL
	END SetMod;


	PROCEDURE GetItem* (obj: ANYPTR; OUT i: Item);
	BEGIN
		ASSERT(obj # NIL, 28);
		i.obj := varObj; i.typ := recTyp; i.vis := exported;
		i.adr := SYSTEM.ADR(obj^); i.ptr := SYSTEM.VAL(ArrayPtr, obj);
		i.mod := NIL; i.desc := Kernel.TypeOf(obj); i.ext := NIL
	END GetItem;

	PROCEDURE Lookup* (IN name: ARRAY OF CHAR; OUT mod: Item);
		VAR m: Kernel.Module; done: BOOLEAN; filter: FilterHook;
	BEGIN
		done := FALSE; filter := filterHook;
		WHILE ~done & (filter # NIL) DO filter.filter(name, mod, done); filter := filter.next END;
		IF ~done & LegalName(name) THEN
			m := Kernel.ThisMod(name);
			IF m # NIL THEN SetMod(mod, m)
			ELSE SetUndef(mod)
			END
		ELSE SetUndef(mod)
		END
	END Lookup;

	PROCEDURE (VAR in: Item) Lookup* (IN name: ARRAY OF CHAR; VAR i: Item), NEW;
		VAR obj: Kernel.Object; o, v, lev, j, a: INTEGER; m: Kernel.Module; n: Kernel.Name;
	BEGIN
		IF in.ext # NIL THEN in.ext.Lookup(name, i); RETURN END;
		ASSERT(in.ptr # NIL, 20);
		IF LegalName(name) THEN
			IF in.obj = modObj THEN
				n := SHORT(name$);
				obj := Kernel.ThisObject(in.mod, n);
				IF obj # NIL THEN
					SetItem(i, obj, in.mod); i.ptr := dummy;
					IF (i.vis = hidden) OR (i.obj < typObj) THEN SetUndef(i) END
				ELSE SetUndef(i)
				END	
			ELSIF in.typ = recTyp THEN
				ASSERT(in.desc.mod.refcnt >= 0, 24);
				lev := in.desc.id DIV 16 MOD 16; j := 0;
				n := SHORT(name$);
				REPEAT
					obj := Kernel.ThisField(in.desc.base[j], n); INC(j)
				UNTIL (obj # NIL) OR (j > lev);
				IF obj # NIL THEN
					o := in.obj; a := in.adr; v := in.vis; m := in.mod;
					SetItem(i, obj, m); i.ptr := in.ptr;
					IF i.vis # hidden THEN
						IF o = varObj THEN
							i.obj := varObj; INC(i.adr, a); i.mod := m;
							IF v < i.vis THEN i.vis := v END
						END
					ELSE SetUndef(i)
					END
				ELSE SetUndef(i)
				END
			ELSE HALT(21)
			END
		ELSE SetUndef(i)
		END
	END Lookup;
	
	PROCEDURE (VAR i: Item) GetBaseType* (VAR base: Item), NEW;
		VAR n: INTEGER;
	BEGIN
		ASSERT(i.ext = NIL, 31);
		ASSERT(i.ptr # NIL, 20);
		ASSERT(i.typ IN {arrTyp, recTyp, ptrTyp}, 21); n := 0;
		IF i.typ = recTyp THEN n := i.desc.id DIV 16 MOD 16 - 1 END;
		IF n >= 0 THEN
			base.obj := typObj; base.vis := undef; base.adr := undef;
			base.mod := NIL; base.ptr := dummy; base.ext := NIL;
			base.desc := i.desc.base[n];
			base.typ := TypOf(base.desc)
		ELSE
			SetUndef(base)
		END
	END GetBaseType;

	PROCEDURE (VAR rec: Item) GetThisBaseType* (level: INTEGER; VAR base: Item), NEW;
	BEGIN
		ASSERT(rec.ext = NIL, 31);
		ASSERT(rec.ptr # NIL, 20);
		ASSERT(rec.typ = recTyp, 21);
		ASSERT((level >= 0) & (level < 16), 28);
		IF level <= rec.desc.id DIV 16 MOD 16 THEN
			base.obj := typObj; base.vis := undef; base.adr := undef;
			base.mod := NIL; base.ptr := dummy; base.ext := NIL;
			base.desc := rec.desc.base[level];
			base.typ := TypOf(base.desc)
		ELSE
			SetUndef(base)
		END
	END GetThisBaseType;
	
	PROCEDURE (VAR proc: Item) NumParam* (): INTEGER, NEW;
		VAR sig: Kernel.Signature;
	BEGIN
		ASSERT(proc.ext = NIL, 31);
		ASSERT(proc.ptr # NIL, 20);
		ASSERT((proc.obj = procObj) OR (proc.typ = procTyp), 21);
		sig := SignatureOf(proc);
		IF sig # NIL THEN RETURN sig.num ELSE RETURN -1 END
	END NumParam;

	PROCEDURE (VAR proc: Item) GetParam* (n: INTEGER; VAR par: Item), NEW;
		VAR sig: Kernel.Signature;
	BEGIN
		ASSERT(proc.ext = NIL, 31);
		ASSERT(proc.ptr # NIL, 20);
		ASSERT((proc.obj = procObj) OR (proc.typ = procTyp), 21);
		sig := SignatureOf(proc);
		IF (sig # NIL) & (n >= 0) & (n < sig.num) THEN
			par.obj := parObj; par.adr := n;
			par.vis := sig.par[n].id MOD 16; 
			par.mod := NIL; par.ptr := dummy; par.ext := NIL;
			par.desc := sig.par[n].struct; par.typ := TypOf(par.desc)
		ELSE
			SetUndef(par)
		END
	END GetParam;

	PROCEDURE (VAR proc: Item) GetParamName* (n: INTEGER; OUT name: Name), NEW;
		VAR sig: Kernel.Signature; mod: Kernel.Module; nm: Kernel.Name;
	BEGIN
		ASSERT(proc.ext = NIL, 31);
		ASSERT(proc.ptr # NIL, 20);
		IF proc.obj = procObj THEN mod := proc.mod
		ELSE ASSERT(proc.typ = procTyp, 21); mod := proc.desc.mod
		END;
		ASSERT(mod.refcnt >= 0, 23);
		sig := SignatureOf(proc);
		IF (sig # NIL) & (n >= 0) & (n < sig.num) THEN
			Kernel.GetObjName(mod, SYSTEM.VAL(Kernel.Object, SYSTEM.ADR(sig.par[n]) - 8), nm);
			name := nm$
		ELSE
			name := ""
		END
	END GetParamName;

	PROCEDURE (VAR proc: Item) GetReturnType* (VAR type: Item), NEW;
		VAR sig: Kernel.Signature;
	BEGIN
		ASSERT(proc.ext = NIL, 31);
		ASSERT(proc.ptr # NIL, 20);
		ASSERT((proc.obj = procObj) OR (proc.typ = procTyp), 21);
		sig := SignatureOf(proc);
		IF sig # NIL THEN
			type.obj := typObj; type.vis := undef; type.adr := undef;
			type.mod := NIL; type.ptr := dummy; type.ext := NIL;
			type.desc := sig.retStruct; type.typ := TypOf(type.desc)
		ELSE
			SetUndef(type)
		END
	END GetReturnType;

	PROCEDURE (VAR rec: Item) Is* (IN type: Value): BOOLEAN, NEW;
		VAR d: Kernel.Type;
	BEGIN
		ASSERT(rec.ext = NIL, 31);
		ASSERT(rec.ptr # NIL, 20);
		ASSERT(rec.typ = recTyp, 21);
		WITH type: Item DO
			ASSERT(type.ptr # NIL, 20);
			ASSERT(type.typ = recTyp, 21);
			d := type.desc
		ELSE
			d := DescOf(type);	(* type of value rec *)
			ASSERT(d.id DIV 16 MOD 16 = 1, 25);	(* level of type = 1*)
			ASSERT(d.fields.num = 1, 26);	(* one field in type *)
			d := d.fields.obj[0].struct;	(* type of field *)
			ASSERT(SYSTEM.VAL(INTEGER, d) DIV 256 # 0, 21);	(* type is structured *)
			IF d.id MOD 4 = 3 THEN d := d.base[0] END	(* deref ptr *)
		END;
		RETURN rec.desc.base[d.id DIV 16 MOD 16] = d	(* rec IS d *)
	END Is;

	PROCEDURE (VAR ptr: Item) Deref* (VAR ref: Item), NEW;
	BEGIN
		IF ptr.ext # NIL THEN ptr.ext.Deref(ref); RETURN END;
		ASSERT(ptr.ptr # NIL, 20);
		ASSERT(ptr.typ IN {sysPtrTyp, anyPtrTyp, ptrTyp}, 21);
		ASSERT(ptr.obj = varObj, 22);
		ASSERT((ptr.mod = NIL) OR (ptr.mod.refcnt >= 0), 23);
		SYSTEM.GET(ptr.adr, ref.adr);
		IF ref.adr # 0 THEN
			IF ptr.typ # ptrTyp THEN ref.typ := recTyp
			ELSE ref.desc := ptr.desc.base[0]; ref.typ := TypOf(ref.desc)
			END;
			ref.obj := varObj; ref.mod := NIL; ref.vis := exported;	(* !!! *)
			ref.ptr := SYSTEM.VAL(ArrayPtr, ref.adr);
			IF ref.typ = recTyp THEN
				ref.desc := DescOf(ref.ptr^);	(* dynamic type *)
			ELSIF ref.typ = arrTyp THEN
				ref.adr := SYSTEM.ADR(ref.ptr.len[ref.desc.id DIV 16 MOD 16]);	(* descriptor offset *)
			ELSE HALT(100)
			END
		ELSE SetUndef(ref)
		END
	END Deref;
	
	PROCEDURE (VAR arr: Item) Index* (index: INTEGER; VAR elem: Item), NEW;
	BEGIN
		IF arr.ext # NIL THEN arr.ext.Index(index, elem); RETURN END;
		ASSERT(arr.ptr # NIL, 20);
		ASSERT(arr.typ = arrTyp, 21);
		ASSERT(arr.obj = varObj, 22);
		IF (index >= 0) & (index < LenOf(arr)) THEN
			elem.obj := varObj; elem.vis := arr.vis;
			elem.mod := arr.mod; elem.ptr := arr.ptr; elem.ext := NIL;
			elem.desc := arr.desc.base[0]; elem.typ := TypOf(elem.desc);
			elem.adr := arr.adr + index * SizeOf(elem)
		ELSE
			SetUndef(elem)
		END
	END Index;
	
	PROCEDURE LookupPath* (IN path: ARRAY OF CHAR; OUT i: Item);
		VAR j, n: INTEGER; name: Name; ch: CHAR; done: BOOLEAN; filter: FilterHook;
	BEGIN
		done := FALSE; filter := filterHook;
		WHILE ~done & (filter # NIL) DO filter.filter(path, i, done); filter := filter.next END;
		IF ~done THEN
			j := 0;
			GetName(path, name, j);
			Lookup(name, i);
			IF (i.obj = modObj) & (path[j] = ".") THEN
				INC(j); GetName(path, name, j);
				i.Lookup(name, i); ch := path[j]; INC(j);
				WHILE (i.obj = varObj) & (ch # 0X) DO
					IF i.typ = ptrTyp THEN i.Deref(i) END;
					IF ch = "." THEN
						GetName(path, name, j);
						IF i.typ = recTyp THEN i.Lookup(name, i) ELSE SetUndef(i) END
					ELSIF ch = "[" THEN
						n := 0; ch := path[j]; INC(j);
						WHILE (ch >= "0") & (ch <= "9") DO n := 10 * n + ORD(ch) - ORD("0"); ch := path[j]; INC(j) END;
						IF (ch = "]") & (i.typ = arrTyp) THEN i.Index(n, i) ELSE SetUndef(i) END
					END;
					ch := path[j]; INC(j)
				END
			END
		END
	END LookupPath;

	(* ---------- Scanner ---------- *)

	PROCEDURE (VAR s: Scanner) ConnectToMods*, NEW;
	BEGIN
		SetUndef(s.this);
		s.this.ptr := dummy;
		s.mod := Kernel.modList;
		s.mode := modScan;
		s.eos := FALSE
	END ConnectToMods;

	PROCEDURE (VAR s: Scanner) ConnectTo* (IN obj: Item), NEW;
	BEGIN
		ASSERT(obj.ptr # NIL, 20);
		SetUndef(s.this); s.vis := obj.vis;
		s.this.ptr := obj.ptr; s.mod := obj.mod; s.idx := 0;
		IF obj.obj = modObj THEN
			ASSERT(s.mod.refcnt >= 0, 23);
			s.mode := globScan
		ELSIF obj.typ = recTyp THEN
			ASSERT(obj.desc.mod.refcnt >= 0, 24);
			s.desc := obj.desc; s.base := 0;
			IF obj.obj = varObj THEN s.mode := recVarScan; s.adr := obj.adr
			ELSE s.mode := recTypeScan
			END
		ELSE HALT(21)
		END;
		s.eos := FALSE
	END ConnectTo;

	PROCEDURE (VAR s: Scanner) Scan*, NEW;
		VAR desc: Kernel.Type;
	BEGIN
		ASSERT(s.this.ptr # NIL, 20);
		IF s.mode = modScan THEN
			IF s.mod # NIL THEN SetMod(s.this, s.mod); s.mod := s.mod.next
			ELSE SetUndef(s.this); s.eos := TRUE
			END
		ELSIF s.mode = globScan THEN
			ASSERT(s.mod.refcnt >= 0, 23);
			REPEAT
				IF s.idx >= s.mod.export.num THEN SetUndef(s.this); s.eos := TRUE; RETURN END;
				s.obj := SYSTEM.VAL(Kernel.Object, SYSTEM.ADR(s.mod.export.obj[s.idx]));
				SetItem(s.this, s.obj, s.mod); INC(s.idx)
			UNTIL (s.this.obj IN {procObj, varObj, typObj}) & (s.this.vis # hidden)
		ELSE
			ASSERT(s.desc.mod.refcnt >= 0, 24);
			desc := s.desc.base[s.base];
			REPEAT
				WHILE s.idx >= desc.fields.num DO
					IF desc = s.desc THEN SetUndef(s.this); s.eos := TRUE; RETURN END;
					INC(s.base); desc := s.desc.base[s.base]; s.idx := 0
				END;
				s.obj := SYSTEM.VAL(Kernel.Object, SYSTEM.ADR(desc.fields.obj[s.idx]));
				SetItem(s.this, s.obj, s.mod); INC(s.idx)
			UNTIL s.this.vis # hidden;
			IF s.mode = recVarScan THEN
				s.this.obj := varObj; INC(s.this.adr, s.adr); s.this.mod := s.mod; 
				IF s.vis < s.this.vis THEN s.this.vis := s.vis END
			END
		END
	END Scan;

	PROCEDURE (VAR s: Scanner) GetObjName* (OUT name: Name), NEW;
		VAR mod: Kernel.Module; n: Kernel.Name;
	BEGIN
		ASSERT(s.this.ptr # NIL, 20);
		IF s.mode = modScan THEN
			name := s.this.mod.name$	(* mf 24.08.2004 *)
		ELSE
			IF s.mode = globScan THEN mod := s.mod
			ELSE mod := s.desc.base[s.base].mod
			END;
			ASSERT(mod.refcnt >= 0, 23);
			Kernel.GetObjName(mod, s.obj, n);
			name := n$;
		END
	END GetObjName;
	
	PROCEDURE (VAR s: Scanner) Level* (): INTEGER, NEW;
	BEGIN
		ASSERT(s.this.ptr # NIL, 20);
		ASSERT(s.mode >= recVarScan, 22);
		RETURN s.base
	END Level;

	(* ---------- access to item values ---------- *)

	PROCEDURE ValToItem (IN x: Value; VAR i: Item);
		VAR desc: Kernel.Type;
	BEGIN
		desc := DescOf(x);
		ASSERT(desc.id DIV 16 MOD 16 = 1, 25);	(* level of x = 1*)
		ASSERT(desc.fields.num = 1, 26);	(* one field in x *)
		i.desc := desc.fields.obj[0].struct;
		i.typ := TypOf(i.desc); i.obj := varObj; i.ext := NIL; i.vis := exported;
		i.ptr := dummy; i.adr := SYSTEM.ADR(x)
	END ValToItem;
	
	PROCEDURE^ EqualSignature (a, b: Kernel.Signature): BOOLEAN;
	
	PROCEDURE EqualType (a, b: Kernel.Type): BOOLEAN;
	BEGIN
		LOOP
			IF a = b THEN RETURN TRUE END;
			IF (SYSTEM.VAL(INTEGER, a) DIV 256 = 0)
				OR (SYSTEM.VAL(INTEGER, b) DIV 256 = 0)
				OR (a.id MOD 4 # b.id MOD 4) THEN RETURN FALSE END;
			CASE a.id MOD 4 OF
			| recTyp - 16: RETURN FALSE
			| arrTyp - 16: IF (a.size # 0) OR (b.size # 0) THEN RETURN FALSE END
			| procTyp - 16: RETURN EqualSignature(SYSTEM.VAL(Kernel.Signature, a.base[0]),
																	 SYSTEM.VAL(Kernel.Signature, b.base[0]))
			ELSE (* ptrTyp *)
			END;
			a := a.base[0]; b := b.base[0]
		END
	END EqualType;
	
	PROCEDURE EqualSignature (a, b: Kernel.Signature): BOOLEAN;
		VAR i: INTEGER;
	BEGIN
		IF (a.num # b.num) OR ~EqualType(a.retStruct, b.retStruct) THEN RETURN FALSE END;
		i := 0;
		WHILE i < a.num DO
			IF (a.par[i].id MOD 256 # b.par[i].id MOD 256)
				OR ~EqualType(a.par[i].struct, b.par[i].struct) THEN RETURN FALSE END;
			INC(i)
		END;
		RETURN TRUE
	END EqualSignature;
	
	PROCEDURE Copy (IN a, b: Item; OUT ok: BOOLEAN);	(* b := a *)
		VAR n: INTEGER; at, bt: Item;
	BEGIN
		ok := FALSE;
		IF a.obj = procObj THEN
			IF (b.typ # procTyp)
				OR ~EqualSignature(SignatureOf(a), SignatureOf(b)) THEN RETURN END;
			SYSTEM.PUT(b.adr, a.adr); 
		ELSE	(* a.obj = varObj *)
			IF a.typ # b.typ THEN RETURN END;
			IF a.typ >= recTyp THEN
				IF a.typ = ptrTyp THEN
					at.desc := a.desc.base[0]; at.typ := TypOf(at.desc); at.ptr := dummy; at.ext := NIL;
					bt.desc := b.desc.base[0]; bt.typ := TypOf(bt.desc); bt.ptr := dummy; bt.ext := NIL;
					SYSTEM.GET(a.adr, n);
					IF (at.typ = recTyp) & (n # 0) THEN
						SYSTEM.GET(SYSTEM.VAL(INTEGER, n) - 4, at.desc);	(* dynamic type *)
						at.desc :=  at.desc.base[bt.desc.id DIV 16 MOD 16]	(* projection to b *)
					END
				ELSE at := a; bt := b
				END;
				WHILE (at.typ = arrTyp) & (bt.typ = arrTyp) DO
					IF LenOf(at) # LenOf(bt) THEN RETURN END;
					at.desc := at.desc.base[0]; at.typ := TypOf(at.desc);
					bt.desc := bt.desc.base[0]; bt.typ := TypOf(bt.desc)
				END;
				IF (at.desc # bt.desc) &
					~((at.typ = procTyp) & (bt.typ = procTyp)
						& EqualSignature(SignatureOf(at), SignatureOf(bt))) THEN RETURN END
			END;
			SYSTEM.MOVE(a.adr, b.adr, SizeOf(b))
		END;
		ok := TRUE
	END Copy;
	
	PROCEDURE (VAR proc: Item) Call* (OUT ok: BOOLEAN), NEW;
		VAR p: Kernel.Command; sig: Kernel.Signature;
	BEGIN
		IF proc.ext # NIL THEN proc.ext.Call(ok); RETURN END;
		ASSERT(proc.ptr # NIL, 20);
		IF proc.obj = procObj THEN
			p := SYSTEM.VAL(Kernel.Command, proc.adr)
		ELSE ASSERT((proc.obj = varObj) & (proc.typ = procTyp), 22);
			SYSTEM.GET(proc.adr, p)
		END;
		ASSERT((proc.mod = NIL) OR (proc.mod.refcnt >= 0), 23);
		sig := SignatureOf(proc);
		IF (sig.retStruct = NIL) & (sig.num = 0) & (p # NIL) THEN p(); ok := TRUE
		ELSE ok := FALSE
		END
	END Call;
	
	PROCEDURE PutParam (IN par: Item; sig: Kernel.Signature; p: INTEGER;
										VAR data: ARRAY OF INTEGER; VAR n: INTEGER;
										OUT ok: BOOLEAN);	(* check & assign a parameter *)
		VAR mode, fTyp, aTyp, padr, i: INTEGER; fDesc, aDesc: Kernel.Type;
			l: LONGINT; s: SHORTINT; b: BYTE;
	BEGIN
		ok := FALSE;
		ASSERT(par.ext = NIL, 31);
		ASSERT(par.ptr # NIL, 20);
		ASSERT(par.obj = varObj, 22);
		ASSERT((par.mod = NIL) OR (par.mod.refcnt >= 0), 23);
		mode := sig.par[p].id MOD 16;
		IF mode >= out THEN ASSERT(par.vis = exported, 27) END;
		fDesc := sig.par[p].struct;
		fTyp := TypOf(fDesc);
		aDesc := par.desc;
		aTyp := TypOf(aDesc);
		padr := par.adr;
		IF (fTyp = recTyp) OR (fTyp = anyRecTyp) THEN
			IF (aTyp # recTyp)
				OR (mode = value) & (aDesc # fDesc)
				OR (fTyp = recTyp) & (aDesc.base[fDesc.id DIV 16 MOD 16] # fDesc) THEN RETURN END;
			data[n] := padr; INC(n);
			data[n] := SYSTEM.VAL(INTEGER, aDesc); INC(n)
		ELSIF fTyp = arrTyp THEN
			data[n] := padr; INC(n);
			IF fDesc.size # 0 THEN data[n] := SizeOf(par); INC(n) END;
			WHILE (TypOf(fDesc) = arrTyp) & (TypOf(aDesc) = arrTyp) DO
				IF aDesc.size # 0 THEN i := aDesc.size	(* actual static size *)
				ELSE i := par.ptr.len[aDesc.id DIV 16 MOD 16 - 1]	(* actual dynamic size *)
				END;
				IF fDesc.size = 0 THEN data[n] := i; INC(n)
				ELSIF fDesc.size # i THEN RETURN
				END;
				fDesc := fDesc.base[0]; aDesc := aDesc.base[0]
			END;
			IF fDesc # aDesc THEN RETURN END
		ELSIF fTyp >= anyPtrTyp THEN	(* pointer *)
			IF fTyp = ptrTyp THEN
				fDesc := fDesc.base[0];	(* formal base type *)
				IF (mode = value) & (TypOf(fDesc) = recTyp) THEN
					IF (aTyp # ptrTyp) & (aTyp # anyPtrTyp) THEN RETURN END;
					SYSTEM.GET(padr, i); SYSTEM.GET(i - 4, aDesc);	(* dynamic record type *)
					aDesc := aDesc.base[fDesc.id DIV 16 MOD 16]	(* projection *)
				ELSE
					IF aTyp # ptrTyp THEN RETURN END;
					aDesc := aDesc.base[0];	(* actual base type *)
					WHILE (TypOf(fDesc) = arrTyp) & (TypOf(aDesc) = arrTyp) DO
						IF fDesc.size # aDesc.size THEN RETURN END;
						fDesc := fDesc.base[0]; aDesc := aDesc.base[0]
					END
				END;
				IF fDesc # aDesc THEN RETURN END
			ELSIF fTyp = anyPtrTyp THEN
				IF (aTyp # anyPtrTyp) & ((aTyp # ptrTyp) OR (TypOf(aDesc.base[0]) # recTyp)) THEN RETURN END
			ELSIF fTyp = procTyp THEN
				IF (aTyp # procTyp) OR (fDesc.size # aDesc.size) THEN RETURN END	(* same fingerprint *)
			END;
			IF mode = value THEN SYSTEM.GET(padr, data[n]); INC(n)
			ELSE data[n] := padr; INC(n)
			END
		ELSE	(* basic type *)
			IF fTyp # aTyp THEN RETURN END;
			IF mode = value THEN
				CASE SizeOf(par) OF
				| 1: SYSTEM.GET(padr, b); data[n] := b; INC(n)
				| 2: SYSTEM.GET(padr, s); data[n] := s; INC(n)
				| 4: SYSTEM.GET(padr, i); data[n] := i; INC(n)
				| 8: SYSTEM.GET(padr, l); data[n] := SHORT(l); INC(n); data[n] := SHORT(l DIV 100000000L); INC(n)
				END
			ELSE	(* var par *)
				data[n] := padr; INC(n)
			END
		END;
		ok := TRUE
	END PutParam;
	
	PROCEDURE GetResult (ret: LONGINT; VAR dest: Item; sig: Kernel.Signature;
											OUT ok: BOOLEAN);	(* assign return value *)
		VAR x: Item; i: INTEGER; s: SHORTINT; b: BYTE;
	BEGIN
		ASSERT(dest.ext = NIL, 31);
		ASSERT(dest.ptr # NIL, 20);
		ASSERT(dest.obj = varObj, 22);
		ASSERT((dest.mod = NIL) OR (dest.mod.refcnt >= 0), 23);
		ASSERT(dest.vis = exported, 27);
		x.desc := sig.retStruct; x.typ := TypOf(x.desc);
		x.obj := varObj; x.ptr := dummy;
		CASE TypOf(sig.retStruct) OF
		| boolTyp, sCharTyp, byteTyp: b := SHORT(SHORT(SHORT(ret))); x.adr := SYSTEM.ADR(b);
		| charTyp, sIntTyp: s := SHORT(SHORT(ret)); x.adr := SYSTEM.ADR(s);
		| longTyp, realTyp: x.adr := SYSTEM.ADR(ret);
		| intTyp, sRealTyp, setTyp, anyPtrTyp, procTyp, ptrTyp: i := SHORT(ret); x.adr := SYSTEM.ADR(i);
		END;
		Copy(x, dest, ok)
	END GetResult;
	
	PROCEDURE (VAR proc: Item) ParamCall* (IN par: ARRAY OF Item; VAR dest: Item;
																			OUT ok: BOOLEAN), NEW;
		VAR n, p, adr, padr: INTEGER; ret: LONGINT;
			data: ARRAY 256 OF INTEGER; sig: Kernel.Signature;
	BEGIN
		ok := TRUE;
		ASSERT(proc.ext = NIL, 31);
		ASSERT(proc.ptr # NIL, 20);
		IF proc.obj = procObj THEN adr := proc.adr
		ELSE ASSERT((proc.obj = varObj) & (proc.typ = procTyp), 22);
			SYSTEM.GET(proc.adr, adr);
			IF adr = 0 THEN ok := FALSE; RETURN END
		END;
		ASSERT((proc.mod = NIL) OR (proc.mod.refcnt >= 0), 23);
		sig := SignatureOf(proc);
		ASSERT((sig # NIL) & (LEN(par) >= sig.num), 32);
		n := 0; p := 0;
		WHILE ok & (p < sig.num) DO	(* check & assign parameters *)
			PutParam(par[p], sig, p, data, n, ok);
			INC(p)
		END;
		IF ok THEN
			ret := Kernel.Call(adr, sig, data, n);
			IF sig.retStruct # NIL THEN GetResult(ret, dest, sig, ok) END
		END
	END ParamCall;

	PROCEDURE (VAR proc: Item) ParamCallVal* (IN par: ARRAY OF POINTER TO Value; VAR dest: Value;
																			OUT ok: BOOLEAN), NEW;
		TYPE IP = POINTER TO Item;
		VAR n, p, adr, padr: INTEGER; ret: LONGINT; x: Item;
			data: ARRAY 256 OF INTEGER; sig: Kernel.Signature;
	BEGIN
		ok := TRUE;
		ASSERT(proc.ext = NIL, 31);
		ASSERT(proc.ptr # NIL, 20);
		IF proc.obj = procObj THEN adr := proc.adr
		ELSE ASSERT((proc.obj = varObj) & (proc.typ = procTyp), 22);
			SYSTEM.GET(proc.adr, adr);
			IF adr = 0 THEN ok := FALSE; RETURN END
		END;
		ASSERT((proc.mod = NIL) OR (proc.mod.refcnt >= 0), 23);
		sig := SignatureOf(proc);
		ASSERT((sig # NIL) & (LEN(par) >= sig.num), 32);
		n := 0; p := 0;
		WHILE ok & (p < sig.num) DO	(* check & assign parameters *)
			IF par[p] IS IP THEN
				PutParam(par[p](IP)^, sig, p, data, n, ok)
			ELSE
				ValToItem(par[p]^, x);
				PutParam(x, sig, p, data, n, ok)
			END;
			INC(p)
		END;
		IF ok THEN
			ret := Kernel.Call(adr, sig, data, n);
			IF sig.retStruct # NIL THEN
				WITH dest: Item DO
					GetResult(ret, dest, sig, ok)
				ELSE
					ValToItem(dest, x);
					GetResult(ret, x, sig, ok)
				END
			END
		END
	END ParamCallVal;

	PROCEDURE (VAR var: Item) GetVal* (VAR x: Value; OUT ok: BOOLEAN), NEW;
		VAR xi: Item;
	BEGIN
		ASSERT(var.ext = NIL, 31);
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj IN {varObj, procObj}, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		WITH x: Item DO
			ASSERT(x.ptr # NIL, 20);
			ASSERT(x.obj = varObj, 22);
			ASSERT((x.mod = NIL) OR (x.mod.refcnt >= 0), 23);
			ASSERT(x.vis = exported, 27);
			Copy(var, x, ok)
		ELSE
			ValToItem(x, xi); Copy(var, xi, ok)
		END
	END GetVal;

	PROCEDURE (VAR var: Item) PutVal* (IN x: Value; OUT ok: BOOLEAN), NEW;
		VAR xi: Item;
	BEGIN
		ASSERT(var.ext = NIL, 31);
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		WITH x: Item DO
			ASSERT(x.ptr # NIL, 20);
			ASSERT(x.obj IN {varObj, procObj}, 22);
			ASSERT((x.mod = NIL) OR (x.mod.refcnt >= 0), 23);
			Copy(x, var, ok)
		ELSE
			ValToItem(x, xi); Copy(xi, var, ok)
		END
	END PutVal;

	PROCEDURE (VAR var: Item) GetStringVal* (OUT x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW;
		VAR i, n: INTEGER; p: StringPtr;
	BEGIN
		IF var.ext # NIL THEN var.ext.GetStringVal(x, ok); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT((var.typ = arrTyp) & (SYSTEM.VAL(INTEGER, var.desc.base[0]) = charTyp), 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		p := SYSTEM.VAL(StringPtr, var.adr); i := 0; n := LenOf(var);
		WHILE (i < n) & (p[i] # 0X) DO INC(i) END;
		IF (i < n) & (i < LEN(x)) THEN x := p^$; ok := TRUE
		ELSE x := ""; ok := FALSE
		END
	END GetStringVal;

	PROCEDURE (VAR var: Item) GetSStringVal* (OUT x: ARRAY OF SHORTCHAR; OUT ok: BOOLEAN), NEW;
		VAR i, n: INTEGER; p: SStringPtr;
	BEGIN
		IF var.ext # NIL THEN var.ext.GetSStringVal(x, ok); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT((var.typ = arrTyp) & (SYSTEM.VAL(INTEGER, var.desc.base[0]) = sCharTyp), 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		p := SYSTEM.VAL(SStringPtr, var.adr); i := 0; n := LenOf(var);
		WHILE (i < n) & (p[i] # 0X) DO INC(i) END;
		IF (i < n) & (i < LEN(x)) THEN x := p^$; ok := TRUE
		ELSE x := ""; ok := FALSE
		END
	END GetSStringVal;

	PROCEDURE (VAR var: Item) PutStringVal* (IN x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW;
		VAR i: INTEGER; p: StringPtr;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutStringVal(x, ok); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT((var.typ = arrTyp) & (SYSTEM.VAL(INTEGER, var.desc.base[0]) = charTyp), 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		p := SYSTEM.VAL(StringPtr, var.adr); i := 0;
		WHILE (i < LEN(x)) & (x[i] # 0X) DO INC(i) END;
		IF (i < LEN(x)) & (i < LenOf(var)) THEN p^ := x$; ok := TRUE
		ELSE ok := FALSE
		END
	END PutStringVal;

	PROCEDURE (VAR var: Item) PutSStringVal* (IN x: ARRAY OF SHORTCHAR; OUT ok: BOOLEAN), NEW;
		VAR i: INTEGER; p: SStringPtr;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutSStringVal(x, ok); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT((var.typ = arrTyp) & (SYSTEM.VAL(INTEGER, var.desc.base[0]) = sCharTyp), 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		p := SYSTEM.VAL(SStringPtr, var.adr); i := 0;
		WHILE (i < LEN(x)) & (x[i] # 0X) DO INC(i) END;
		IF (i < LEN(x)) & (i < LenOf(var)) THEN p^ := x$; ok := TRUE
		ELSE ok := FALSE
		END
	END PutSStringVal;

	PROCEDURE  (VAR var: Item) PtrVal* (): ANYPTR, NEW;
		VAR p: ANYPTR;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.PtrVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ IN {anyPtrTyp, ptrTyp}, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		SYSTEM.GET(var.adr, p);
		RETURN p
	END PtrVal;

	PROCEDURE (VAR var: Item) PutPtrVal* (x: ANYPTR), NEW;
		VAR vt, xt: Kernel.Type;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutPtrVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ IN {anyPtrTyp, ptrTyp}, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		IF (x # NIL) & (var.typ = ptrTyp) THEN
			vt := var.desc.base[0]; xt := Kernel.TypeOf(x);
			ASSERT(xt.base[vt.id DIV 16 MOD 16] = vt, 28);	(* xt IS vt *)
		END;
		SYSTEM.PUT(var.adr, x)
	END PutPtrVal;

	PROCEDURE (VAR var: Item) IntVal* (): INTEGER, NEW;
		VAR sc: SHORTCHAR; ch: CHAR; s: BYTE; i: SHORTINT; x: INTEGER;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.IntVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		IF var.typ = sCharTyp THEN SYSTEM.GET(var.adr, sc); x := ORD(sc)
		ELSIF var.typ = charTyp THEN SYSTEM.GET(var.adr, ch); x := ORD(ch)
		ELSIF var.typ = byteTyp THEN SYSTEM.GET(var.adr, s); x := s
		ELSIF var.typ = sIntTyp THEN SYSTEM.GET(var.adr, i); x := i
		ELSIF var.typ = intTyp THEN SYSTEM.GET(var.adr, x)
		ELSE HALT(21)
		END;
		RETURN x
	END IntVal;

	PROCEDURE (VAR var: Item) PutIntVal* (x: INTEGER), NEW;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutIntVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		IF var.typ = sCharTyp THEN SYSTEM.PUT(var.adr, SHORT(CHR(x)))
		ELSIF var.typ = charTyp THEN SYSTEM.PUT(var.adr, CHR(x))
		ELSIF var.typ = byteTyp THEN SYSTEM.PUT(var.adr, SHORT(SHORT(x)))
		ELSIF var.typ = sIntTyp THEN SYSTEM.PUT(var.adr, SHORT(x))
		ELSIF var.typ = intTyp THEN SYSTEM.PUT(var.adr, x)
		ELSE HALT(21)
		END
	END PutIntVal;

	PROCEDURE (VAR var: Item) RealVal* (): REAL, NEW;
		VAR r: SHORTREAL; x: REAL;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.RealVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		IF var.typ = sRealTyp THEN SYSTEM.GET(var.adr, r); x := r
		ELSIF var.typ = realTyp THEN SYSTEM.GET(var.adr, x)
		ELSE HALT(21)
		END;
		RETURN x
	END RealVal;

	PROCEDURE (VAR var: Item) PutRealVal* (x: REAL), NEW;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutRealVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		IF var.typ = sRealTyp THEN SYSTEM.PUT(var.adr, SHORT(x))
		ELSIF var.typ = realTyp THEN SYSTEM.PUT(var.adr, x)
		ELSE HALT(21)
		END
	END PutRealVal;

	PROCEDURE (VAR var: Item) LongVal* (): LONGINT, NEW;
		VAR x: LONGINT;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.LongVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ = longTyp, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		SYSTEM.GET(var.adr, x);
		RETURN x
	END LongVal;

	PROCEDURE (VAR var: Item) PutLongVal* (x: LONGINT), NEW;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutLongVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ = longTyp, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		SYSTEM.PUT(var.adr, x)
	END PutLongVal;

	PROCEDURE (VAR var: Item) CharVal* (): CHAR, NEW;
		VAR x: CHAR; s: SHORTCHAR;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.CharVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		IF var.typ = sCharTyp THEN SYSTEM.GET(var.adr, s); x := s
		ELSIF var.typ = charTyp THEN SYSTEM.GET(var.adr, x)
		ELSE HALT(21)
		END;
		RETURN x
	END CharVal;

	PROCEDURE (VAR var: Item) PutCharVal* (x: CHAR), NEW;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutCharVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		IF var.typ = sCharTyp THEN SYSTEM.PUT(var.adr, SHORT(x))
		ELSIF var.typ = charTyp THEN SYSTEM.PUT(var.adr, x)
		ELSE HALT(21)
		END
	END PutCharVal;

	PROCEDURE (VAR var: Item) BoolVal* (): BOOLEAN, NEW;
		VAR x: BOOLEAN;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.BoolVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ = boolTyp, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		SYSTEM.GET(var.adr, x);
		RETURN x
	END BoolVal;

	PROCEDURE (VAR var: Item) PutBoolVal* (x: BOOLEAN), NEW;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutBoolVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ = boolTyp, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		SYSTEM.PUT(var.adr, x)
	END PutBoolVal;

	PROCEDURE (VAR var: Item) SetVal* (): SET, NEW;
		VAR x: SET;
	BEGIN
		IF var.ext # NIL THEN RETURN var.ext.SetVal() END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ = setTyp, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		SYSTEM.GET(var.adr, x);
		RETURN x
	END SetVal;

	PROCEDURE (VAR var: Item) PutSetVal* (x: SET), NEW;
	BEGIN
		IF var.ext # NIL THEN var.ext.PutSetVal(x); RETURN END;
		ASSERT(var.ptr # NIL, 20);
		ASSERT(var.typ = setTyp, 21);
		ASSERT(var.obj = varObj, 22);
		ASSERT((var.mod = NIL) OR (var.mod.refcnt >= 0), 23);
		ASSERT(var.vis = exported, 27);
		SYSTEM.PUT(var.adr, x)
	END PutSetVal;

	PROCEDURE (VAR  type: Item) New* (): ANYPTR, NEW;
		VAR p: ANYPTR; i, n, id: INTEGER; d: Kernel.Directory; desc: Kernel.Type;
	BEGIN
		ASSERT(type.ext = NIL, 31);
		ASSERT(type.ptr # NIL, 20);
		desc := type.desc;
		IF type.typ = ptrTyp THEN desc := desc.base[0] END;
		ASSERT(TypOf(desc) = recTyp, 21);
		ASSERT(desc.mod.refcnt >= 0, 24);
		i := 0; d := type.desc.mod.export; n := d.num; id := type.desc.id DIV 256;
		WHILE (i < n) & (d.obj[i].id DIV 256 # id) DO INC(i) END;
		ASSERT((i < n) & (d.obj[i].id DIV 16 MOD 16 = exported), 29);
		ASSERT(desc.id DIV 4 MOD 4 < limited, 30);
		Kernel.NewObj(p, desc);
		RETURN p
	END New;

	PROCEDURE (VAR  val: Item) Copy* (): ANYPTR, NEW;
		VAR p: ANYPTR; i, n, id: INTEGER; d: Kernel.Directory;
	BEGIN
		ASSERT(val.ext = NIL, 31);
		ASSERT(val.ptr # NIL, 20);
		ASSERT(val.typ = recTyp, 21);
		ASSERT(val.obj = varObj, 22);
		ASSERT(val.desc.mod.refcnt >= 0, 24);
		i := 0; d := val.desc.mod.export; n := d.num; id := val.desc.id DIV 256;
		WHILE (i < n) & (d.obj[i].id DIV 256 # id) DO INC(i) END;
		ASSERT((i < n) & (d.obj[i].id DIV 16 MOD 16 = exported), 29);
		ASSERT(val.desc.id DIV 4 MOD 4 < limited, 30);
		Kernel.NewObj(p, val.desc);
		SYSTEM.MOVE(val.adr, p, val.desc.size);
		RETURN p
	END Copy;

	PROCEDURE (VAR rec: Item) CallWith* (proc: PROCEDURE(VAR rec, par: ANYREC); VAR par: ANYREC), NEW;
	BEGIN
		ASSERT(rec.ext = NIL, 31);
		ASSERT(rec.ptr # NIL, 20);
		ASSERT(rec.typ = recTyp, 21);
		ASSERT(rec.obj = varObj, 22);
		ASSERT((rec.mod = NIL) OR (rec.mod.refcnt >= 0), 23);
		proc(SYSTEM.THISRECORD(rec.adr, SYSTEM.VAL(INTEGER, rec.desc)), par)
	END CallWith;


	PROCEDURE InstallFilter* (filter: LookupFilter);
		VAR h: FilterHook;
	BEGIN
		ASSERT(filter # NIL, 20);
		NEW(h); h.filter := filter; h.next := filterHook; filterHook := h
	END InstallFilter;

	PROCEDURE UninstallFilter* (filter: LookupFilter);
		VAR h, a: FilterHook;
	BEGIN
		ASSERT(filter # NIL, 20);
		h := filterHook; a := NIL;
		WHILE (h # NIL) & (h.filter # filter) DO a := h; h := h.next END;
		IF h # NIL THEN
			IF a = NIL THEN filterHook := h.next ELSE a.next := h.next END
		END
	END UninstallFilter;

	PROCEDURE GetThisItem* (IN attr: ANYREC; OUT i: Item);
	BEGIN
		WITH attr: Kernel.ItemAttr DO
			i.obj := attr.obj; i.vis := attr.vis; i.typ := attr.typ; i.adr := attr.adr;
			i.mod := attr.mod; i.desc := attr.desc; i.ptr := attr.ptr; i.ext := attr.ext;
			IF i.ptr = NIL THEN i.ptr := dummy END
		END
	END GetThisItem;

BEGIN
	NEW(dummy)
END Meta.