A2OS/source/PCOF.Mod

(* Paco, Copyright 2000 - 2002, Patrik Reali, ETH Zurich *)

MODULE PCOF; (** AUTHOR "prk / be"; PURPOSE "Parallel Compiler: object file plug-in"; *)

IMPORT
	SYSTEM, KernelLog,
	StringPool, PCDebug, PCBT, PCLIR, PCM, PCT, PCOM;

CONST
	AddressSize = SIZEOF(ADDRESS);

	TraceUse = FALSE;
	Optimize = FALSE;

	NewRefSection = TRUE;

	Sentinel = LONGINT(0FFFFFFFFH);

	EUEnd = 0X; EURecord = 1X; EUProcFlag = LONGINT(080000000H);


TYPE
	StringBuf = ARRAY 256 OF CHAR;

	OffsetList = POINTER TO RECORD
		offset : LONGINT;
		nextOffset : OffsetList
	END;

	ExTableEntry = POINTER TO RECORD
		pcFrom, pcTo, pcHandler: LONGINT;
		next: ExTableEntry;
	END;


VAR
	refSize: LONGINT;
	nofCmds, nofImp, nofVarCons, nofLinks: INTEGER;
	dsize: LONGINT;

	globR: PCM.Rider;	(* used for OutReference *)

		(* stat counters *)
	Nreschedule0, Nreschedule1, Nreschedule2: LONGINT;

	exTable: ExTableEntry;
	exTableLen: LONGINT;

(* ---------- Helper Procedures -------------- *)

PROCEDURE OutRefType(t: PCT.Struct; procHeader: BOOLEAN);
VAR val, off, dim, td: LONGINT; u: PCT.Struct; tdptr: PCBT.GlobalVariable;
BEGIN
	td := 0; off := 0; dim := 0;
	IF ~procHeader (*& (t IS PCT.Array) *) THEN
		IF (t IS PCT.Array) THEN  (** fof  *)
		WITH t: PCT.Array DO
			off := 80H;
			u := t.base;
			IF ~(u IS PCT.Basic) THEN u := PCT.Ptr END;
			IF t.mode = PCT.static THEN  dim := t.len  END
		END;
		t := u
(** fof >> *)
		ELSIF (t IS PCT.EnhArray) THEN
			WITH t: PCT.EnhArray DO
				off := 80H;  u := t.base;
				IF ~(u IS PCT.Basic) THEN u := PCT.Ptr END;
				IF (t.mode = PCT.static) THEN dim := t.len END
			END;
			t := u
		ELSIF (t IS PCT.Tensor) THEN
			WITH t: PCT.Tensor DO
				off := 80H;  u := t.base;
				 u := PCT.Ptr ;
			END;
			t := u
		END;
(** << fof  *)
	END;
	IF t = PCT.Int64 THEN
		val := 10H
	ELSIF t = PCT.Char16 THEN
		val := PCT.Int16.sym(PCOM.Struct).fp
	ELSIF t = PCT.Char32 THEN
		val := PCT.Int32.sym(PCOM.Struct).fp
	ELSIF t IS PCT.Basic THEN
		val := t.sym(PCOM.Struct).fp
	ELSIF t = PCT.NoType THEN
		val := 0
	ELSIF t IS PCT.Record THEN
		val := 16H;
		tdptr := t.size(PCBT.RecSize).td;
		IF tdptr # NIL THEN  td := tdptr.offset  ELSE  val := 6  END
	ELSIF procHeader & PCT.IsPointer(t) THEN
		val := 0DH
	ELSIF t IS PCT.Pointer THEN
		WITH t: PCT.Pointer DO
			IF t.baseR # NIL  (* IS PCT.Record *) THEN
				val := 1DH;
				tdptr := t.base.size(PCBT.RecSize).td;
				IF tdptr # NIL THEN  td := tdptr.offset  ELSE  val := 0DH  END
			ELSE
				val := 0DH
			END
		END;
	ELSIF t = PCT.Ptr THEN
		val := 0DH;
	ELSIF t IS PCT.Delegate THEN
		val := 0EH
	ELSIF procHeader & (t IS PCT.Array) THEN
		WITH t: PCT.Array DO
			IF t.mode = PCT.static THEN val := 12H
			ELSIF t.mode = PCT.open THEN val := 15H
			ELSE HALT(98)
			END
		END
(** fof >> *)
	ELSIF procHeader & (t IS PCT.EnhArray) THEN
		WITH t: PCT.EnhArray DO
			IF t.mode = PCT.static THEN val := 12H
			ELSIF t.mode = PCT.open THEN val := 15H
			ELSE HALT( 98 )
			END
		END
	ELSIF procHeader & (t IS PCT.Tensor) THEN
		val := 15H; (* ???? *)
(** << fof  *)
	ELSE
		HALT(99)
	END;
	IF procHeader THEN
		PCM.RefW(globR, CHR(val))
	ELSE
		PCM.RefW(globR, CHR(off+val));
		IF off = 80H THEN  PCM.RefWNum(globR, dim)
		ELSIF td # 0 THEN  PCM.RefWNum(globR, td)
		END
	END
END OutRefType;

PROCEDURE OutRefVar(p: PCT.Variable; isRef: BOOLEAN);
VAR arr: PCT.Array; dim, off: LONGINT; type: PCT.Struct; name: StringBuf;earr: PCT.EnhArray;   (*fof*)
BEGIN
	StringPool.GetString(p.name, name);
	IF NewRefSection THEN
		IF isRef THEN PCM.RefW(globR, 3X) ELSE PCM.RefW(globR, 1X) END;
		OutRefType(p.type, FALSE);
		PCM.RefWNum(globR, p.adr(PCBT.Variable).offset);
		PCM.RefWString(globR, name)
	ELSE
		type := p.type;
		IF (type IS PCT.Record) THEN
			(*skip*)
		ELSIF (type IS PCT.Array) & ~(type(PCT.Array).base IS PCT.Basic) THEN
			(*skip*)
(** fof >> *)
		ELSIF (type IS PCT.EnhArray) & (type( PCT.EnhArray ).base IS PCT.Basic) THEN
		(* skip *)
(** << fof  *)
		ELSIF (type = PCT.Int64) THEN
			(*skip*)
		ELSE
			IF isRef THEN PCM.RefW(globR, 3X) ELSE PCM.RefW(globR, 1X) END;
			off := 0; dim := 0;
			IF type IS PCT.Array THEN
				off := 80H; dim := 1;
				REPEAT
					arr := type(PCT.Array);
					dim := dim * arr.len;
					type := arr.base
				UNTIL ~(type IS PCT.Array)
			END;
(** fof >> *)
			IF type IS PCT.EnhArray THEN
				off := 80H;  dim := 1;
				REPEAT earr := type( PCT.EnhArray );  dim := dim * earr.len;  type := earr.base UNTIL ~(type IS PCT.EnhArray)
			END;
(** << fof  *)
			IF type = PCT.Byte THEN PCM.RefW(globR, CHR(off+1))
			ELSIF type = PCT.Bool THEN PCM.RefW(globR, CHR(off+2))
			ELSIF type = PCT.Char8 THEN PCM.RefW(globR, CHR(off+3))
			ELSIF type = PCT.Char16 THEN PCM.RefW(globR, CHR(off+5))
			ELSIF type = PCT.Char32 THEN PCM.RefW(globR, CHR(off+6))
			ELSIF type = PCT.Int8 THEN PCM.RefW(globR, CHR(off+4))
			ELSIF type = PCT.Int16 THEN PCM.RefW(globR, CHR(off+5))
			ELSIF type = PCT.Int32 THEN PCM.RefW(globR, CHR(off+6))
			ELSIF type = PCT.Float32 THEN PCM.RefW(globR, CHR(off+7))
			ELSIF type = PCT.Float64 THEN PCM.RefW(globR, CHR(off+8))
			ELSIF type = PCT.Set THEN PCM.RefW(globR, CHR(off+9))
			ELSIF PCT.IsPointer(type) THEN PCM.RefW(globR, CHR(off+0DH))
			ELSIF type IS PCT.Delegate THEN PCM.RefW(globR, CHR(off+0EH))
			END;
			IF off = 80H THEN PCM.RefW(globR, CHR(dim)) END;
			PCM.RefWNum(globR, p.adr(PCBT.Variable).offset);
			PCM.RefWString(globR, name);
		END
	END;
END OutRefVar;

(* fof 070731 moved warnings to PCP : removed CheckAll, CheckModules here *)
PROCEDURE OutReference(scope: PCT.Scope);
VAR  owner: PCT.Proc; i: LONGINT; var: PCT.Variable; par: PCT.Parameter; name: StringBuf; entry: ExTableEntry; mod: PCT.Module;
BEGIN
(*
	IF (scope.code = NIL) THEN RETURN  END;
*)

	IF scope IS PCT.ModScope THEN
		PCM.RefW(globR, 0F8X);
		COPY("$$", name);
		PCM.RefWNum(globR, 0); (* offset *)
		PCM.RefWString(globR, "$$"); (* name *)
		var := scope.firstVar;
		WHILE var # NIL DO OutRefVar(var, FALSE); var := var.nextVar END;

		mod := scope(PCT.ModScope).owner;

		IF mod.adr(PCBT.Module).finallyOff > -1 THEN

			NEW(entry);
			entry.pcFrom := 0;
			entry.pcTo := mod.adr(PCBT.Module).finallyOff;
			entry.pcHandler := mod.adr(PCBT.Module).finallyOff;
			entry.next := NIL;

			IF exTable # NIL THEN
				entry.next := exTable;
			END;

			exTable := entry;

			INC(exTableLen);
		END;

	ELSIF scope IS PCT.ProcScope THEN
		WITH scope: PCT.ProcScope DO
			owner := scope.ownerO;
			IF ~(PCT.Inline IN owner.flags) THEN
				IF NewRefSection THEN
					PCM.RefW(globR, 0F9X);
					PCM.RefWNum(globR, owner.adr(PCBT.Procedure).codeoffset);
					PCM.RefWNum(globR, scope.parCount);
					OutRefType(owner.type, TRUE);
					PCM.RefWNum(globR, owner.level);
					PCM.RefWNum(globR, 0)
				ELSE
					PCM.RefW(globR, 0F8X);
					PCM.RefWNum(globR, owner.adr(PCBT.Procedure).codeoffset);
				END;
				IF owner IS PCT.Method THEN
					WITH owner: PCT.Method DO
						PCT.GetTypeName(owner.boundTo, name);
						i := 0;
						WHILE name[i] # 0X DO PCM.RefW(globR, name[i]); INC(i) END;
						PCM.RefW(globR, ".")
					END
				END;
				StringPool.GetString(owner.name, name);
				PCM.RefWString(globR, name);
				par := scope.firstPar;
				WHILE par # NIL DO OutRefVar(par, par.ref); par := par.nextPar END;
				var := scope.firstVar;
				WHILE var # NIL DO OutRefVar(var, FALSE); var := var.nextVar END
			END;

			IF owner.adr(PCBT.Procedure). finallyOff > -1 THEN

				NEW(entry);
				entry.pcFrom := owner.adr(PCBT.Procedure).codeoffset;
				entry.pcTo := owner.adr(PCBT.Procedure).finallyOff;
				entry.pcHandler := owner.adr(PCBT.Procedure).finallyOff;
				entry.next := NIL;

				IF exTable # NIL THEN
					entry.next := exTable;
				END;

				exTable := entry;
				INC(exTableLen);
			END;
		END;
	END
END OutReference;

PROCEDURE Generate*(VAR R: PCM.Rider; scope: PCT.ModScope;  VAR codeSize: LONGINT);
VAR commands: ARRAY 128 OF PCT.Proc;
	i, nofptrs, nofProcs, maxPtrs, EntriesPos, PtrPos, nofProcsPos, maxPtrsPos, LinksPos, VarConsPos: LONGINT;
	typeDescsSize, typeDescsSizePos: LONGINT; (* ug: temporary *)
	adr: PCBT.Module; mod: PCT.Module;  sym: PCOM.Module; emptyR: PCM.Rider;
	code: PCLIR.CodeArray; str: StringBuf; hdrCodeSize, addressFactor: LONGINT;

	PROCEDURE UseModule(m: PCBT.Module);
	BEGIN
		IF m.nr = 0 THEN
			INC(nofImp);
			m.nr := -1	(*mark*)
		END
	END UseModule;

	PROCEDURE FindCommands;
	VAR proc : PCT.Proc;
	BEGIN
		nofCmds := 0;
		proc := scope.firstProc;
		WHILE (proc # NIL) DO
			IF (proc.vis = PCT.Public) & (~(PCT.Inline IN proc.flags) OR (PCT.Indexer IN proc.flags)) THEN
				IF PCT.GetProcedureAllowed(proc.scope, proc.type) THEN
					commands[nofCmds] := proc; INC(nofCmds);
				END;
			END;
			proc := proc.nextProc
		END;
	END FindCommands;

	PROCEDURE CollectInfo;
	VAR proc: PCT.Proc; o: PCT.Symbol; p: PCBT.GlobalVariable; rec: PCT.Record; bsym: PCOM.Struct;
	BEGIN
		globR := R;  PCT.TraverseScopes(scope, OutReference);  R := globR; globR := emptyR;
		FindCommands;

		(* detect imported modules *)
		IF mod.imports # NIL THEN
			i := 0;
			WHILE (i < LEN(mod.imports)) & (mod.imports[i] # NIL) DO
				mod.imports[i].adr(PCBT.Module).nr := 0;
				INC(i)
			END;
			nofImp := 0;
			o := scope.sorted;
			WHILE o # NIL DO
				IF (o IS PCT.Module) & (o.adr # PCT.System.adr) THEN  UseModule(o.adr(PCBT.Module)) END;
				o := o.sorted;
			END;
			p := adr.ExtVars;
			WHILE p # PCBT.sentinel DO
				IF p.link # NIL THEN UseModule(p.owner) END;
				p := p.next
			END;
			rec := scope.records;
			WHILE rec # NIL DO
				IF (rec.brec # NIL) & (rec.brec.sym # NIL) THEN
					bsym := rec.brec.sym(PCOM.Struct);
					IF bsym.mod # scope.owner THEN UseModule(bsym.mod.adr(PCBT.Module)) END
				END;
				rec := rec.link;
 				ASSERT(rec # scope.records, MAX(INTEGER));
 					(* Fix bug, sometimes this assertion fails. *)
 					(* fof 070920: done, cf. PCC.MakeTD *)
			END
		END;
(*
		IF mod.imports # NIL THEN
			nofImp := SHORT(LEN(mod.imports));
			WHILE (mod.imports[nofImp-1] = NIL) DO DEC(nofImp) END
		END
*)
	END CollectInfo;

	PROCEDURE OutPtrs(offset: LONGINT;  type: PCT.Struct; debug : BOOLEAN);
	VAR  i, n, off: LONGINT;  f: PCT.Variable; scope: PCT.Scope;  base: PCT.Struct; size: PCBT.Size;
		name: StringBuf; state: LONGINT;
	BEGIN
		IF type.size(PCBT.Size).containPtrs THEN
			IF PCT.IsPointer(type) THEN
				PCM.ObjWNum(R, offset); INC(nofptrs);
				IF debug THEN
					KernelLog.Int(offset, 0); KernelLog.String(" "); (* KernelLog.Ln; *)
				END
			ELSIF PCT.IsDynamicDelegate(type) THEN
				PCM.ObjWNum(R, offset+4); INC(nofptrs);
				IF debug THEN
					KernelLog.Int(offset+4, 0); KernelLog.String(" "); (* KernelLog.Ln; *)
				END
			ELSIF type IS PCT.Record THEN
				WITH type: PCT.Record DO
					IF type.brec # NIL THEN OutPtrs(offset, type.brec, debug)  END;
					scope := type.scope;
				END;
				f := scope.firstVar;
				WHILE  f # NIL  DO
					IF ~(PCM.Untraced IN f.flags) THEN
						StringPool.GetString(f.name, name); state := scope.state;
						ASSERT(state >= PCT.structallocated);
						type := f.type;  off := f.adr(PCBT.Variable).offset;
						OutPtrs(offset+off, type, debug)
					END;
					f := f.nextVar
				END;
			ELSIF type IS PCT.Array THEN
				WITH type: PCT.Array DO
					IF type.mode = PCT.static THEN
						n := type.len;
						base := type.base;
						WHILE (base IS PCT.Array) DO
							type := base(PCT.Array); base := type.base;
							ASSERT(type.mode = PCT.static);
							n := n * type.len
						END;
						size := base.size(PCBT.Size);
						IF size.containPtrs THEN
							FOR i := 0 TO n-1 DO OutPtrs(offset+i*size.size, base, debug)  END
						END
					ELSE
						PCDebug.ToDo(PCDebug.NotImplemented);	(*find pointers in the array, call NewPtr for each one*)
					END
				END
(** fof >> *)
				ELSIF type IS PCT.EnhArray THEN
					WITH type: PCT.EnhArray DO
						IF type.mode = PCT.static THEN
							n := type.len;  base := type.base;
							WHILE (base IS PCT.EnhArray) DO type := base( PCT.EnhArray );  base := type.base;
								ASSERT ( (type.mode = PCT.static) );
								n := n * type.len
							END;
							size := base.size( PCBT.Size );
							IF size.containPtrs THEN
								FOR i := 0 TO n - 1 DO OutPtrs( offset + i * size.size, base,FALSE ) END
							END
						ELSE
							PCM.ObjWNum( R, offset );  INC( nofptrs );
							(* pointer to array in heap is located at first position ! *)
							(*
							PCDebug.ToDo( PCDebug.NotImplemented );   (*find pointers in the array, call NewPtr for each one*)
							*)
						END
					END
				ELSIF type IS PCT.Tensor THEN
					WITH type: PCT.Tensor DO
						PCM.ObjWNum(R,offset); INC(nofptrs);
					END;
(** << fof  *)
			END
		END
	END OutPtrs;

	PROCEDURE FixupList(l: PCBT.Fixup;  addressFactor: LONGINT; base: ADDRESS; sentinel: LONGINT; prev: PCBT.Fixup; VAR tail: PCBT.Fixup);
	(* Insert fixup list into code *)
		VAR offset: LONGINT;
	BEGIN
		tail := NIL;
		IF l # NIL THEN
			IF prev # NIL THEN
				SYSTEM.PUT(base + prev.offset*addressFactor, l.offset);
			END;
			offset := l.offset;
			tail := l;
			l := l.next;
			WHILE l # NIL DO
				SYSTEM.PUT(base+offset*addressFactor, l.offset);
				offset := l.offset;
				tail := l;
				l := l.next;
			END;
			SYSTEM.PUT(base+offset*addressFactor, sentinel);
		END;
	END FixupList;

	PROCEDURE InsertFixupLists(addressFactor: LONGINT);
		VAR p: PCBT.Procedure; i: LONGINT; codebase: ADDRESS; dummy : PCBT.Fixup;
	BEGIN
		codebase := ADDRESSOF(code[0]);
		FOR i := 0 TO PCBT.NofSysCalls-1 DO
			IF i # PCBT.casetable THEN
				FixupList(adr.syscalls[i], addressFactor, codebase, Sentinel, NIL, dummy)
			END
		END;
		p := adr.ExtProcs;
		WHILE p # PCBT.psentinel DO
			ASSERT(p.owner # PCBT.context);
			FixupList(p.link, addressFactor, codebase, Sentinel, NIL, dummy);
			p := p.next
		END;
	END InsertFixupLists;

	PROCEDURE EntryBlock(addressFactor: LONGINT);
	VAR nofEntries, firstOffset: LONGINT; codebase: ADDRESS;

		PROCEDURE Traverse(p: PCBT.Procedure);
		VAR prev, tail : PCBT.Fixup;
		BEGIN
			prev := NIL;
			WHILE p # PCBT.psentinel DO
				IF (p.public) OR (p.link # NIL) OR (p IS PCBT.Method) THEN
					PCM.ObjWNum(R, p.codeoffset);
					p.entryNr := nofEntries;
					INC(nofEntries);
					FixupList(p.link, addressFactor, codebase, Sentinel, prev, tail);
					IF tail # NIL THEN
						prev := tail
					END;
					IF (p.link # NIL) & (firstOffset = -1) THEN
						firstOffset := p.link.offset
					END;
				END;
				p := p.next
			END
		END Traverse;

	BEGIN
		PCM.ObjW(R, 82X);
		nofEntries := 0;
		codebase := ADDRESSOF(code[0]);
		firstOffset := -1;
		Traverse(adr.OwnProcs);
(*
		Traverse(adr.ExtProcs);
*)
		IF firstOffset # -1 THEN adr.UseSyscall(PCBT.procaddr, firstOffset) END;
		IF nofEntries # 0 THEN PCM.ObjWLIntAt(R, EntriesPos, nofEntries) END
	END EntryBlock;

	PROCEDURE CommandBlock;
	VAR i: LONGINT; str: StringBuf;

		PROCEDURE WriteType(type : PCT.Struct);
		VAR size : PCBT.RecSize; num : LONGINT;
		BEGIN
			ASSERT((type # NIL) & ((type = PCT.NoType) OR (type IS PCT.Record) OR ((type IS PCT.Pointer) & (type(PCT.Pointer).baseR # NIL))));
			num := 0;
			IF (type = PCT.NoType) THEN
				(* num = 0 *)
			ELSIF (type IS PCT.Record) THEN
				size := type(PCT.Record).size(PCBT.RecSize);
			ELSE
				size := type(PCT.Pointer).baseR.size(PCBT.RecSize);
			END;
			IF (type # PCT.NoType) THEN
				IF (size.td # NIL) THEN
					num := size.td.offset;
				ELSE
					KernelLog.String("ERROR: size.td = NIL"); KernelLog.Ln; (* TODO: CHECK WHY THIS HAPPENS *)
				END;
			END;
			PCM.ObjWNum(R, num);
		END WriteType;

	BEGIN
		PCM.ObjW(R, 83X);
		i := 0;
		WHILE i < nofCmds DO

			IF (commands[i].scope.formalParCount = 0) THEN
				PCM.ObjWNum(R, 0);
			ELSIF (commands[i].scope.formalParCount = 1) & (commands[i].scope.firstPar.type = PCT.Ptr) THEN
				PCM.ObjWNum(R, 1); (* ANY , TO BE REMOVED *)
			ELSE
				WriteType(commands[i].scope.firstPar.type);
			END;

			IF (commands[i].type = PCT.Ptr) THEN
				PCM.ObjWNum(R, 1); (* ANY, TO BE REMOVED *)
			ELSE
				WriteType(commands[i].type);
			END;

			(* cmdName cmdOffset 4) *)
			StringPool.GetString(commands[i].name, str);
			PCM.ObjWName(R, str);
			PCM.ObjWNum(R, commands[i].adr(PCBT.Procedure).codeoffset);
			INC(i);
		END;
	END CommandBlock;

	PROCEDURE PointerBlock;
	VAR   p: PCT.Variable;
	BEGIN
		PCM.ObjW(R, 84X);
		nofptrs := 0;
		p := scope.firstVar;
		WHILE p # NIL DO
			IF ~(PCM.Untraced IN p.flags) & (p.adr # NIL) THEN
				OutPtrs(p.adr(PCBT.GlobalVariable).offset, p.type, FALSE)  (* debug = FALSE *)
			END;
			p := p.nextVar
		END;
		p := scope.firstHiddenVar;
		WHILE p # NIL DO
			IF p.adr # NIL THEN (* ug: checking for PCM.Untraced not necessary here, flags of hidden variables always {} *)
				OutPtrs(p.adr(PCBT.GlobalVariable).offset, p.type, FALSE)	(* debug = FALSE *)
			END;
			p := p.nextVar
		END;
		IF nofptrs > MAX(INTEGER) THEN PCM.Error(222, 0, "") END;
		IF nofptrs # 0 THEN PCM.ObjWLIntAt(R, PtrPos, nofptrs) END;
	END PointerBlock;

	PROCEDURE ImportBlock;
	VAR  i, j, k: LONGINT;  m: PCT.Module;  str: StringBuf; adr: PCBT.Module;
	BEGIN
		PCM.ObjW(R, 85X);
		IF mod.imports # NIL THEN
			i := 0; j := 0;
			k := LEN(mod.imports);
			WHILE (i < k) & (mod.imports[i] # NIL) DO
				m := mod.imports[i];
				adr := m.adr(PCBT.Module);
				IF adr.nr = -1 THEN
					INC(j); adr.nr := SHORT(j);
					StringPool.GetString(m.name, str); PCM.ObjWName(R, str);
				END;
				INC(i)
			END
		END;
		ASSERT(j = nofImp);
	END ImportBlock;
(*
	PROCEDURE ImportBlock;
	VAR  i, j, k, len: LONGINT;  m: PCT.Module;  str: StringBuf; adr: PCBT.Module;
	BEGIN
		PCM.ObjW(R, 85X);
		IF mod.imports # NIL THEN
			j := 0;
			k := LEN(mod.imports);
			REPEAT  DEC(k)  UNTIL (k < 0) OR (mod.imports[k] # NIL);
			i := 0;
			WHILE (i <= k) DO
				m := mod.imports[i];
				adr := m.adr(PCBT.Module);
				IF adr.nr = -1 THEN
					INC(j); adr.nr := SHORT(j);
					StringPool.GetString(m.name, str); PCM.ObjWName(R, str);
				END;
				INC(i)
			END
		END;
		ASSERT(j = nofImp);
	END ImportBlock;
*)
	PROCEDURE VarConsBlock;
	VAR p: PCBT.GlobalVariable;  pos, count: LONGINT;

		PROCEDURE FixList(p: PCBT.Fixup);
		BEGIN
			WHILE p # NIL DO
				PCM.ObjWNum(R, p.offset); p := p.next; INC(count)
			END
		END FixList;

	BEGIN
		PCM.ObjW(R, 8DX);
		(*first pass: local GVars*)
		nofVarCons := 0;
		PCM.ObjW(R, 0X);  PCM.ObjWNum(R, -1);  PCM.ObjWGetPos(R, pos);  PCM.ObjWLInt(R, -1);
		p := adr.OwnVars;  count := 0;
		WHILE p # PCBT.sentinel DO
			FixList(p.link);
			ASSERT(p.entryNo = PCBT.UndefEntryNo);
			p := p.next
		END;
		PCM.ObjWLIntAt(R, pos, count);
		INC(nofVarCons);

		(*second pass: imported GVars*)
		p := adr.ExtVars;
		WHILE p # PCBT.sentinel DO
			IF (p.link # NIL) THEN
				p.entryNo := nofVarCons;	(* remember the position for the UseSection *)
				count := 0;  INC(nofVarCons);
				PCM.ObjW(R, CHR(p.owner.nr));  PCM.ObjWNum(R, 0);  PCM.ObjWGetPos(R, pos);  PCM.ObjWLInt(R, -1);
				FixList(p.link);
				PCM.ObjWLIntAt(R, pos, count);
			END;
			p := p.next
		END;
	END VarConsBlock;

	PROCEDURE LinkBlock;
		VAR nofLinks: LONGINT; p: PCBT.Procedure; count : LONGINT;

		(* ug *)
		PROCEDURE CountFixups(p: PCBT.Procedure; VAR count: LONGINT);
		VAR f : PCBT.Fixup;
		BEGIN
			count := 0;
			f := p.link;
			WHILE f # NIL DO
				INC(count);
				f := f.next;
			END
		END CountFixups;

	BEGIN
		PCM.ObjW(R, 86X);
		FOR i := 0 TO PCBT.NofSysCalls-1 DO
			IF adr.syscalls[i] # NIL THEN
				PCM.ObjW(R, 0X);  PCM.ObjW(R, PCLIR.CG.SysCallMap[i]);  PCM.ObjWNum(R, adr.syscalls[i].offset);
				INC(nofLinks)
			END
		END;
		(* ug *)
		p := adr.OwnProcs;
		WHILE p # PCBT.psentinel DO
			IF (p.public) OR (p.link # NIL) OR (p IS PCBT.Method) THEN
				CountFixups(p, count);
				PCM.ObjWNum(R, count)
			END;
			p := p.next;
		END;
		PCM.ObjWNum(R, adr.casetablesize);
		IF nofLinks # 0 THEN PCM.ObjWLIntAt(R, LinksPos, nofLinks) END
	END LinkBlock;

	PROCEDURE UseBlock;
	VAR  m: PCT.Module;
		e, i: LONGINT; modname, name: StringBuf;
		v: PCT.Variable; p: PCT.Proc; t: PCT.Type; c: PCT.Value;

		PROCEDURE UseEntry(m: PCT.Module; p: PCT.Symbol; offset: LONGINT);
		BEGIN
			StringPool.GetString(p.name, name);
			PCOM.FPrintObj(p, m);
			PCM.ObjWNum(R, p.sym(PCOM.Symbol).fp);
			PCM.ObjWName(R, name);
			PCM.ObjWNum(R, offset);
		END UseEntry;

		PROCEDURE UseType(t: PCT.Struct);
			VAR size: PCBT.RecSize; sym: PCOM.Struct; j: LONGINT;
		BEGIN
			LOOP
				IF t IS PCT.Pointer THEN	t := t(PCT.Pointer).base
				ELSIF t IS PCT.Array THEN	t := t(PCT.Array).base
(** fof >> *)
				ELSIF t IS PCT.EnhArray THEN
					t := t( PCT.EnhArray ).base
				ELSIF t IS PCT.Tensor THEN
					t := t( PCT.Tensor).base
(** << fof  *)
				ELSE	EXIT
				END
			END;
			IF (t IS PCT.Record) THEN
				WITH t: PCT.Record DO
					size := t.size(PCBT.RecSize);
					IF (size.td # NIL) THEN
						IF (t.scope.module = m) THEN
							sym := t.sym(PCOM.Struct);
							IF (t.owner # NIL) & (t.owner.sym = NIL) THEN  PCOM.FPrintObj(t.owner, m)  END;
							PCM.ObjW(R, EURecord);
							PCM.ObjWNum(R, -size.td.offset);
							(*! fof: weakened consistency for new compiler, should  be replaced by new fp rules
							IF t.pvused THEN
								PCM.ObjWNum(R, sym.pvfp);
								PCM.ObjWName(R, "@");
							ELSIF t.pbused THEN
								PCM.ObjWNum(R, sym.pbfp);
								PCM.ObjWName(R, "@")
							END;
							*)
							PCM.ObjW(R, EUEnd);
							size.td := NIL;	(*avoid double tracing*)
						ELSE
							(* aliasing of imported type: schedule module for emission in use list *)
							j := i+1;
							LOOP
								IF j = LEN(mod.imports) THEN
									INC(Nreschedule0);
									PCT.ExtendModArray(mod.imports);
									mod.imports[j] := t.scope.module;
									EXIT
								ELSIF mod.imports[j] = NIL THEN
									INC(Nreschedule1);
									mod.imports[j] := t.scope.module;
									EXIT
								ELSIF mod.imports[j] = t.scope.module THEN
									INC(Nreschedule2);
									EXIT
								END;
								INC(j)
							END
						END
					END
				END
			END
		END UseType;

	BEGIN
		PCM.ObjW(R, 8AX);
		IF mod.imports # NIL THEN
			i := 0;
			WHILE (i < LEN(mod.imports)) & (mod.imports[i] # NIL) DO
				m := mod.imports[i];
				ASSERT(m = m.scope.owner);
				StringPool.GetString(m.name, modname);
				PCM.ObjWName(R, modname);
				IF TraceUse THEN  PCM.LogWLn; PCM.LogWStr("Use: "); PCM.LogWStr(modname)  END;

				c := m.scope.firstValue;
				WHILE c # NIL DO
					IF (PCT.used IN c.flags) & (c.vis # PCT.Internal) THEN UseEntry(m, c, 0) END;
					EXCL(c.flags, PCT.used);
					c := c.nextVal
				END;
				v := m.scope.firstVar;
				WHILE v # NIL DO
					e := v.adr(PCBT.GlobalVariable).entryNo;
					IF (e # PCBT.UndefEntryNo) THEN
						UseEntry(m, v, e); UseType(v.type);
						IF Optimize THEN
							v.adr(PCBT.GlobalVariable).entryNo := PCBT.UndefEntryNo
						ELSE
							ASSERT(v.adr(PCBT.GlobalVariable).next # NIL, 500);
							ASSERT(v.adr(PCBT.GlobalVariable).link # NIL, 501);
						END
					END;
					v := v.nextVar
				END;
				t := m.scope.firstType;
				WHILE t # NIL DO
					IF (PCT.used IN t.flags) & (t.vis # PCT.Internal) THEN UseEntry(m, t, 0); UseType(t.type) END;
					EXCL(t.flags, PCT.used);
					t := t.nextType
				END;
				p := m.scope.firstProc;
				WHILE p # NIL DO
					IF (p.adr # NIL) & (p.adr(PCBT.Procedure).link # NIL) THEN
						UseEntry(m, p, p.adr(PCBT.Procedure).link.offset + EUProcFlag)
					ELSIF (p.flags * {PCT.used, PCT.Inline} = {PCT.used, PCT.Inline}) & (p.vis # PCT.Internal) THEN
						UseEntry(m, p, 0)
					END;
					p := p.nextProc
				END;
				PCM.ObjW(R, 0X);
				INC(i)
			END
		END;
		PCM.ObjW(R, 0X)
	END UseBlock;

	(*
		ExportSection = count { fp link [ Type ] }
		Type = 1 ( ref | (link count pbfp pvfp [Type] {fldfp [Type] | mthfp} 0 ) )

		Vars: link < 0 (offset[SB])
		Proc: link > 0 (offset[code base])
		Other: link = 0
	*)
	PROCEDURE ExportBlock;
	TYPE ExpList = POINTER TO ARRAY OF LONGINT;
	VAR count, nofstr: INTEGER;  pos: LONGINT;
		explist: ExpList; exppos, explen: LONGINT;
		v: PCT.Variable; p: PCT.Proc; t: PCT.Type; c: PCT.Value;

		PROCEDURE ExportType(t: PCT.Struct);
		VAR count: INTEGER;  pos: LONGINT;  sym: PCOM.Struct;  p: PCT.Proc; v: PCT.Variable;
		BEGIN
			WHILE (t IS PCT.Pointer) OR (t IS PCT.Array) DO
				IF t IS PCT.Pointer THEN  t := t(PCT.Pointer).base  ELSE  t := t(PCT.Array).base  END
			END;
(** fof >> *)
			WHILE (t IS PCT.EnhArray) DO t := t( PCT.EnhArray ).base END;
			IF (t IS PCT.Tensor) THEN t := t(PCT.Tensor).base END;
(** << fof  *)
			sym := t.sym(PCOM.Struct);
			IF (t IS PCT.Record) & ((sym.mod = NIL)OR(sym.mod = mod)) THEN
				WITH t: PCT.Record DO
					PCM.ObjW(R, EURecord);
					IF sym.uref # 0 THEN
						PCM.ObjWNum(R, -sym.uref)
					ELSE
						count := 0;
						INC(nofstr);  sym.uref := nofstr;	(*remember it's exported*)
						PCM.ObjWNum(R, t.size(PCBT.RecSize).td.offset);	(* link address in the constant section*)
						PCM.ObjWGetPos(R, pos);  PCM.ObjWLInt(R, 2);	(* number of entries *)
						ExportType(t.btyp);
						PCM.ObjWNum(R, sym.pbfp);  PCM.ObjWNum(R, sym.pvfp);
						v := t.scope.firstVar;
						WHILE v # NIL DO
							IF v.vis # PCT.Internal THEN
								PCM.ObjWNum(R, v.sym(PCOM.Symbol).fp); ExportType(v.type); INC(count);
							END;
							v := v.nextVar
						END;
						p := t.scope.firstProc;
						WHILE p # NIL DO
							IF (p.vis # PCT.Internal) & (p # t.scope.body) THEN
								PCM.ObjWNum(R, p.sym(PCOM.Symbol).fp); INC(count);
							END;
							p := p.nextProc
						END;
						IF count # 0 THEN  PCM.ObjWLIntAt(R, pos, count+2) END;
						PCM.ObjW(R, EUEnd)
					END
				END
			END;
		END ExportType;

		PROCEDURE ExportSymbol(p: PCT.Symbol; offset: LONGINT; s: PCT.Symbol);
			VAR i, fp: LONGINT; name,prefix: ARRAY 256 OF CHAR; explist2: ExpList;
		BEGIN
			StringPool.GetString(p.name, name);
			fp := p.sym(PCOM.Symbol).fp;

			IF s # NIL THEN
				StringPool.GetString(s.name,prefix);

				PCOM.FPrintName(fp,prefix);

			END;
			FOR i := 0 TO exppos-1 DO
				IF fp = explist[i] THEN  PCM.ErrorN(280, PCM.InvalidPosition, p.name) END
			END;
			IF exppos >= explen THEN
				NEW(explist2, 2*explen);
				SYSTEM.MOVE(ADDRESSOF(explist[0]), ADDRESSOF(explist2[0]), 4*explen);
				explist := explist2; explen := 2*explen
			END;
			explist[exppos] := fp; INC(exppos);
			PCM.ObjWNum(R, fp);
			PCM.ObjWNum(R, offset);
			INC(count);
		END ExportSymbol;

		PROCEDURE ExportMethods(s: PCT.Symbol);
		VAR sym: PCOM.Struct;  p: PCT.Proc; t: PCT.Struct;
		BEGIN
			t := s.type;
			WHILE (t IS PCT.Pointer) OR (t IS PCT.Array) DO
				IF t IS PCT.Pointer THEN  t := t(PCT.Pointer).base  ELSE  t := t(PCT.Array).base  END
			END;
			WHILE (t IS PCT.EnhArray) DO t := t( PCT.EnhArray ).base END;
			IF (t IS PCT.Tensor) THEN t := t(PCT.Tensor).base END;

			sym := t.sym(PCOM.Struct);
			IF (t IS PCT.Record) & ((sym.mod = NIL)OR(sym.mod = mod)) THEN
				WITH t: PCT.Record DO
					p := t.scope.firstProc;
					WHILE p # NIL DO
						IF (p.vis # PCT.Internal) (*& ~(PCT.Inline IN p.flags)*) THEN
							ExportSymbol(p, p.adr(PCBT.Procedure).codeoffset,s);
						END;
						p := p.nextProc
					END
				END
			END;
		END ExportMethods;

	BEGIN
		PCM.ObjW(R, 88X);
		PCM.ObjWGetPos(R, pos);  PCM.ObjWLInt(R, 0);
		nofstr := 0;  count := 0;  exppos := 0;
		NEW(explist, 256); explen := 256;
		c := scope.firstValue;
		WHILE c # NIL DO
			IF c.vis # PCT.Internal THEN
				ExportSymbol(c, 0,NIL);
			END;
			c := c.nextVal
		END;
		v := scope.firstVar;
		WHILE v # NIL DO
			IF v.vis # PCT.Internal THEN
				ExportSymbol(v, v.adr(PCBT.GlobalVariable).offset,NIL);
				ExportType(v.type)
			END;
			v := v.nextVar
		END;
		t := scope.firstType;
		WHILE t # NIL DO
			IF t.vis # PCT.Internal THEN
				ExportSymbol(t, 0,NIL);
				ExportType(t.type)
			END;
			t:= t.nextType
		END;
		p := scope.firstProc;
		WHILE p # NIL DO
			IF (p.vis # PCT.Internal) (*& ~(PCT.Inline IN p.flags)*) THEN
				ExportSymbol(p, p.adr(PCBT.Procedure).codeoffset,NIL);
			END;
			p := p.nextProc
		END;
		t := scope.firstType;
		WHILE t # NIL DO
			IF t.vis # PCT.Internal THEN
				ExportMethods(t);
			END;
			t:= t.nextType
		END;

		IF count # 0 THEN  PCM.ObjWLIntAt(R, pos, count)  END;
		PCM.ObjW(R, EUEnd)
	END ExportBlock;

	PROCEDURE RawBlock(tag: CHAR;  size: LONGINT;  VAR block: ARRAY OF CHAR);
	VAR i: LONGINT;
	BEGIN
		PCM.ObjW(R, tag);
		i := 0;
		WHILE i < size DO PCM.ObjW(R, block[i]); INC(i)  END
	END RawBlock;

	PROCEDURE WriteType(rec: PCT.Record; VAR tdSize: LONGINT (* ug *));
	CONST MaxTags = 16; (* ug: temporary solution, Modules.MaxTags *)
	VAR  size: PCBT.RecSize;  nofptrsPos, tdSizePos, oldmth: LONGINT;  base: PCT.Record;  m: PCT.Method;
		adr: PCBT.Method;  bsym: PCOM.Struct;  name, name2: StringBuf;
		basenr: INTEGER; baseid: LONGINT;
		upperPartTdSize, lowerPartTdSize: LONGINT;
	BEGIN
		PCT.GetTypeName(rec, name);
		size := rec.size(PCBT.RecSize);
		PCM.ObjWNum(R, size.size);
		PCM.ObjWNum(R, size.td.offset);
		IF rec.brec = NIL THEN
			oldmth := 0;
			basenr := -1;
			baseid := -1
		ELSE
			base := rec.brec;
			basenr := 0;
			IF (base.sym # NIL) THEN
				bsym := base.sym(PCOM.Struct);
				ASSERT(bsym.mod # NIL);
				IF bsym.mod # scope.owner THEN basenr := SHORT(bsym.mod.adr(PCBT.Module).nr) END
			END;
			IF basenr = 0 THEN
				baseid := base.size(PCBT.RecSize).td.offset
			ELSIF base.owner = NIL THEN
				baseid := base.ptr.owner.sym(PCOM.Symbol).fp
			ELSE
				StringPool.GetString(base.owner.name, name2);
				baseid := base.owner.sym(PCOM.Symbol).fp
			END;
			oldmth := base.size(PCBT.RecSize).nofMethods;
		END;
		PCM.ObjWNum(R, basenr);
		PCM.ObjWNum(R, baseid);
		IF rec.scope.IsProtected () THEN
			PCM.ObjWNum(R, -size.nofMethods);			(* NofMethods *)
		ELSE
			PCM.ObjWNum(R, size.nofMethods);			(* NofMethods *)
		END;
		PCM.ObjWNum(R, oldmth);					(* InheritedMethods *)
		PCM.ObjWNum(R, size.nofLocalMethods);	(* NewMethods *)
		PCM.ObjWGetPos(R, nofptrsPos);
		PCM.ObjWLInt(R, 0);
		PCM.ObjWName(R, name);
		PCM.ObjWGetPos(R, tdSizePos);
		PCM.ObjWLInt(R, 0);

		(*New Methods in Record*)
		i := 0; m := rec.scope.firstMeth;
		WHILE m # NIL DO
			IF ~(PCT.Inline IN m.flags) OR (PCT.Indexer IN m.flags) THEN
				adr := m.adr(PCBT.Method);
				PCM.ObjWNum(R, adr.mthNo);
				PCM.ObjWNum(R, adr.entryNr);
				INC(i);
			END;
			m := m.nextMeth
		END;
		ASSERT(i = size.nofLocalMethods, 500);	(*sanity check*)

		(* Ptrs in Record *)
		nofptrs := 0;
		OutPtrs(0, rec, FALSE);  (* debug = FALSE *)
		IF nofptrs > MAX(INTEGER) THEN PCM.Error(221, 0, "") END;
		IF nofptrs # 0 THEN PCM.ObjWLIntAt(R, nofptrsPos, nofptrs) END;

(* ug *)	upperPartTdSize := AddressSize * (MaxTags + size.nofMethods + 1 + 1); (* tags, methods, methods end marker (sentinel), address of TypeInfo *)
(* ug *)	(* lowerPartTdSize := AddressSize * (1 + nofptrs + 1); (* recsize, no. pointers and sentinel *)  *)
(* ug *)	lowerPartTdSize := AddressSize * (2 + (4 + nofptrs) + 1); (* SIZEOF(Heaps.StaticTypeDesc), data part of dynamic array of pointer offsets,
																 padding field to observe 0 mod 8 boundary of dynamic array *)
(* ug *)	tdSize := upperPartTdSize + lowerPartTdSize;

(* ug *)	PCM.ObjWLIntAt(R, tdSizePos, tdSize)
	END WriteType;

	PROCEDURE WriteInterface(rec: PCT.Record);
	VAR  size: PCBT.RecSize; name: StringBuf;
	BEGIN
		PCT.GetTypeName(rec, name);
		size := rec.size(PCBT.RecSize);
		PCM.ObjWNum(R, 4 + 4*rec.scope.procCount);
		PCM.ObjWNum(R, size.td.offset);
		PCM.ObjWNum(R, -1);
		PCM.ObjWNum(R, -1);
		PCM.ObjWNum(R, 0);	(* NofMethods *)
		PCM.ObjWNum(R, 0);	(* InheritedMethods *)
		PCM.ObjWNum(R, 0);	(* NewMethods *)
		PCM.ObjWLInt(R, 0);      	(* no. pointers (fixed size) *)
		PCM.ObjWName(R, name);
	END WriteInterface;

	PROCEDURE TypeBlock;
	VAR  rec: PCT.Record; tdSize: LONGINT; (* ug *)
	BEGIN  PCM.ObjW(R, 8BX);
		typeDescsSize := 0; (* ug *)
		rec := scope.records;
		WHILE rec # NIL DO
			IF PCT.interface IN rec.mode THEN
				WriteInterface(rec)
			ELSE
				WriteType(rec, tdSize); (* ug *)
				typeDescsSize := typeDescsSize + tdSize (* ug *)
			END;
			rec := rec.link
		END;
		PCM.ObjWLIntAt(R, typeDescsSizePos, typeDescsSize); (* ug *)
		rec := scope.records;
		WHILE rec # NIL DO
			rec.size(PCBT.RecSize).td := NIL;
			rec := rec.link
		END;
	END TypeBlock;

	(* 	Stores the exception handle table in the following format
		ExceptionHandlerTable 	::= 8EX {ExceptionTableEntry}
		ExceptionTableEntry 	::= 0FFX pcFrom(4 bytes) pcTo(4 bytes) pcHandler(4 bytes)

		Since there is only one FINALLY  in every procedure, method, body, ... we don't need
		to obtain an order for nesting.
	*)
	PROCEDURE ExTableBlock;
	VAR
		entry: ExTableEntry;
	BEGIN
		PCM.ObjW(R, 8EX);
		entry := exTable;
		WHILE entry # NIL DO
			PCM.ObjW(R, 0FEX);
			PCM.ObjWNum(R, entry.pcFrom);
			PCM.ObjWNum(R, entry.pcTo);
			PCM.ObjWNum(R, entry.pcHandler);
			entry := entry.next;
		END;
	END ExTableBlock;

	(* ug *)
	PROCEDURE PointerInProcBlock;

		PROCEDURE PointerOffsets(s : PCT.Scope; codeoffset, beginOffset, endOffset: LONGINT);
		VAR v: PCT.Variable; p: PCT.Proc; t: PCT.Type; par: PCT.Parameter;
			rs: PCT.RecScope; adr: PCBT.Procedure;
			nofPtrPos : LONGINT;
		BEGIN
			IF s # NIL THEN
				IF s IS PCT.ModScope THEN
					PCM.ObjWNum(R, codeoffset);
					PCM.ObjWNum(R, beginOffset);
					PCM.ObjWNum(R, endOffset);
					PCM.ObjWLInt(R, 0);			(* nofptrs *)
					INC(nofProcs);
				ELSIF s IS PCT.ProcScope THEN
					PCM.ObjWNum(R, codeoffset);
					PCM.ObjWNum(R, beginOffset);
					PCM.ObjWNum(R, endOffset);
					nofptrs := 0;
					PCM.ObjWGetPos(R, nofPtrPos); PCM.ObjWLInt(R, nofptrs);
					v := s.firstVar;
					WHILE v # NIL DO
						IF (v.adr # NIL) & ~(PCM.Untraced IN v.flags) THEN OutPtrs(v.adr(PCBT.Variable).offset, v.type, FALSE) (* debug = FALSE *) END;
						v := v.nextVar
					END;
					v := s.firstHiddenVar;
					WHILE v # NIL DO
						IF v.adr # NIL THEN OutPtrs(v.adr(PCBT.Variable).offset, v.type, FALSE) (* debug = FALSE *) END;
						v := v.nextVar
					END;
					par := s(PCT.ProcScope).firstPar;
					WHILE par # NIL DO
						IF ~par.ref THEN
							OutPtrs(par.adr(PCBT.Variable).offset, par.type, FALSE) (* debug = FALSE *)
						END;
						par := par.nextPar
					END;
					PCM.ObjWLIntAt(R, nofPtrPos, nofptrs);
 					IF nofptrs > maxPtrs THEN maxPtrs := nofptrs END;
					INC(nofProcs);
				END;
				p := s.firstProc;
				WHILE p # NIL DO
					adr := p.adr(PCBT.Procedure);
					IF adr.codeoffset # 0 THEN
						PointerOffsets(p.scope, adr.codeoffset, adr.beginOffset, adr.endOffset)
					END;
					p := p.nextProc
				END;
				t := s.firstType;
				WHILE t # NIL DO
					IF (t.type IS PCT.Pointer) & (t.type(PCT.Pointer).base IS PCT.Record)THEN
						rs := t.type(PCT.Pointer).baseR.scope;
						PointerOffsets(rs, 0, 0, 0)
					END;
					t := t.nextType
				END
			END
		END PointerOffsets;

	BEGIN
		PCM.ObjW(R, 8FX);
		nofProcs := 0;
		maxPtrs := 0;
		PointerOffsets(scope, adr.codeoffset, adr.beginOffset, adr.endOffset);
		PCM.ObjWLIntAt(R, nofProcsPos, nofProcs);
		PCM.ObjWLIntAt(R, maxPtrsPos, maxPtrs);
	END PointerInProcBlock;
	(* ug *)

BEGIN
	exTable := NIL; exTableLen := 0;
	mod := scope.owner;
	adr := mod.adr(PCBT.Module);
	sym := NIL;
	IF mod.sym # NIL THEN  sym := mod.sym(PCOM.Module)  END;
	PCLIR.CG.GetCode(code, codeSize, hdrCodeSize, addressFactor);
	InsertFixupLists(addressFactor);
	CollectInfo;
	dsize := adr.locsize;
	ASSERT(codeSize < PCLIR.CG.MaxCodeSize);	(*objfile restriction*)
(* header block *)
	PCM.ObjWLInt (R, PCM.RefSize(R)+1);
	PCM.ObjWGetPos(R, EntriesPos); PCM.ObjWLInt (R, 0);
	PCM.ObjWLInt (R, nofCmds);
	PCM.ObjWGetPos(R, PtrPos); PCM.ObjWLInt (R, 0);
	PCM.ObjWLInt (R, scope.nofRecs);
	PCM.ObjWLInt (R, nofImp);
	PCM.ObjWGetPos(R, VarConsPos); PCM.ObjWLInt (R, 0);
	PCM.ObjWGetPos(R, LinksPos); PCM.ObjWLInt (R, 0);
	PCM.ObjWLInt (R, dsize);
	PCM.ObjWLInt (R, adr.constsize);
	PCM.ObjWLInt (R, hdrCodeSize);
	PCM.ObjWLInt(R, exTableLen);
	PCM.ObjWGetPos(R, nofProcsPos); PCM.ObjWLInt(R, 0); (* ug *)
	PCM.ObjWGetPos(R, maxPtrsPos); PCM.ObjWLInt(R, 0); (* ug *)
	PCM.ObjWGetPos(R, typeDescsSizePos); PCM.ObjWLInt(R, 0); (* ug *)
	StringPool.GetString(mod.name, str); PCM.ObjWName (R, str);

	EntryBlock(addressFactor);
	CommandBlock;
	PointerBlock;
	ImportBlock;
	VarConsBlock;
	IF nofVarCons # 0 THEN PCM.ObjWLIntAt(R, VarConsPos, nofVarCons) END;
	LinkBlock;
	RawBlock(87X, adr.constsize, adr.const^);
	ExportBlock;
	RawBlock(89X, codeSize, code^);
	UseBlock;
	TypeBlock;
	ExTableBlock;
	PointerInProcBlock; (* ug *)
(* ref block *)
	PCM.ObjW(R, 8CX);

	PCM.CloseObj(R);

	adr.ResetLists;
END Generate;

PROCEDURE Init*;
BEGIN
	refSize := 0;
	nofCmds := 0;
	nofImp := 0;
	nofVarCons := 0;  nofLinks := 0;
	dsize := 0;
END Init;

PROCEDURE Install*;
BEGIN
	Init();
	PCBT.generate := Generate
END Install;

BEGIN
	IF TraceUse THEN PCM.LogWLn; PCM.LogWStr("PCOF.TraceUse on") END;
	PCBT.generate := Generate
END PCOF.

(*
	20.02.02	be	refinement in the code generator plugin
	13.04.02	prk	export and use of inlined assembler procedures fixed
	18.03.02	prk	PCBT code cleanup and redesign
	20.02.02	be	refinement in the code generator plugin
	23.01.02	prk	fixed bug in use list with aliases of imported types
	22.01.02	prk	ToDo list moved to PCDebug
	28.11.01	prk	import section: list only used modules
	27.08.01	prk	scope.unsorted list removed; use var, proc, const and type lists instead
	16.08.01	prk	keep PCBT.Variable offset, ignore for imported vars
	11.08.01	prk	Fixup and use lists for procedures in PCBT cleaned up
	10.08.01	prk	PCBT.Procedure: imported: BOOLEAN replaced by owner: Module
	06.08.01	prk	make code generator and object file generator indipendent
	02.08.01	prk	Aos-Style Commands added to the Command list (by pjm)
	02.07.01	prk	access flags, new design
	27.06.01	prk	StringPool cleaned up
	14.06.01	prk	type descs for dynamic arrays of ptrs generated by the compiler
	06.06.01	prk	use string pool for object names
	29.05.01    be	syscall structures moved to backend (PCLIR & code generators)
	28.05.01	prk	don't insert invisible symbols in the "use" section
	28.05.01	prk	issue error 221/222 when more than MAX(INTEGER) pointers in global data / record
	03.05.01	be	Installable code generators
	26.03.01	prk	New Reference Section format
	25.03.01	prk	limited HUGEINT implementation (as abstract type)
	14.03.01	prk	OutRefs, don't list ARRAYs of user defined types
	14.03.01	prk	OutRefs, don't list inlined procedures
*)