DIRECTORY
Alloc: TYPE USING [Base, Handle, Notifier, AddNotify, DropNotify, Bounds, Failure, Top],
Basics: TYPE USING [bytesPerWord, RawBytes],
BcdDefs: TYPE USING [SGRecord, VersionStamp, FTNull, PageSize],
ComData: TYPE USING [compilerVersion, codeSeg, defBodyLimit, fgTable, fixupLoc, globalFrameSize, importCtx, interface, mainCtx, moduleCtx, mtRoot, mtRootSize, nBodies, nInnerBodies, objectBytes, objectVersion, ownSymbols, source, symSeg, typeAtomRecord],
CompilerUtil: TYPE USING [Address],
ConvertUnsafe: TYPE USING [SubString, AppendSubStringToRefText],
FileParms: TYPE USING [Name],
IO: TYPE USING [GetIndex, SetIndex, STREAM, UnsafePutBlock],
Literals: TYPE USING [Base, STNull],
LiteralOps: TYPE USING [CopyLiteral, ForgetEntries, StringValue, TextType],
OSMiscOps: TYPE USING [FreePages, FreeWords, Words],
PackageSymbols: TYPE USING [OuterPackRecord, InnerPackRecord, IPIndex, IPNull],
PrincOpsUtils: TYPE USING [LongCopy],
RCMap: TYPE USING [Base],
RCMapOps: TYPE USING [RCMT, Acquire, Create, Destroy, GetSpan],
Rope: TYPE USING [Flatten, Length, Text],
RTBcd: TYPE USING [RefLitItem, RefLitList, RTHeader, StampIndex, StampList,TypeItem, TypeList, UTInfo, AnyStamp],
Symbols: TYPE USING [Base, HashVector, Name, Type, MDIndex, BodyInfo, BTIndex, MDNull, OwnMdi, BTNull, RootBti, lL],
SymbolSegment: TYPE USING [Base, FGHeader, FGTEntry, ExtRecord, ExtIndex, STHeader, WordOffset, VersionID, ltType, htType, ssType, seType, ctxType, mdType, bodyType, extType, constType],
SymbolOps: TYPE USING [EnumerateBodies, HashBlock, NameForSe, SiblingBti, SonBti, SubStringForName, UnderType],
SymLiteralOps: TYPE USING [RefLitItem, DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes, TypeIndex, UTypeId],
Table: TYPE USING [IPointer, Selector],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType],
TreeOps: TYPE USING [FreeTree, UpdateLeaves],
TypeStrings: TYPE USING [Create],
UnsafeStorage: TYPE USING [GetSystemUZone],
XSymbolSegment: TYPE SymbolSegment USING [ExtRecord],
XTree: TYPE Tree USING [Index, Link, Node],
XTreeOps: TYPE USING [ForEachSon, LinkToX];

ObjectOut: PROGRAM
IMPORTS Alloc, ConvertUnsafe, IO, PrincOpsUtils, OSMiscOps, LiteralOps, RCMapOps, Rope, SymbolOps, SymLiteralOps, TreeOps, TypeStrings, dataPtr: ComData, UnsafeStorage, XTreeOps
EXPORTS CompilerUtil = {

StreamIndex: TYPE = INT; -- FileStream.FileByteIndex
Address: TYPE = CompilerUtil.Address;

stream: IO.STREAM _ NIL;
zone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];

PageSize: CARDINAL = BcdDefs.PageSize;
BytesPerWord: CARDINAL = Basics.bytesPerWord;
BytesPerPage: CARDINAL = PageSize*BytesPerWord;

NextFilePage: PUBLIC PROC RETURNS[CARDINAL] = {
fill: ARRAY [0..8) OF WORD _ ALL[0];
r: INTEGER = (stream.GetIndex[] MOD BytesPerPage)/BytesPerWord;
m: INTEGER;
IF r # 0 THEN
FOR n: INTEGER _ PageSize-r, n-m WHILE n > 0 DO
m _ MIN[n, fill.LENGTH];
WriteObjectWords[LOOPHOLE[fill.BASE.LONG], m];
ENDLOOP;
RETURN[stream.GetIndex[]/BytesPerPage + 1]};

WriteObjectWords: PROC[addr: Address, n: CARDINAL] = {
stream.UnsafePutBlock[[base: addr, startIndex: 0, count: n*BytesPerWord]]};

RewriteObjectWords: PROC[index: StreamIndex, addr: Address, n: CARDINAL] = {
saveIndex: StreamIndex = stream.GetIndex[];
stream.SetIndex[index];
stream.UnsafePutBlock[[addr, 0, n*BytesPerWord]];
stream.SetIndex[saveIndex]};

WriteTableBlock: PROC[p: Table.IPointer, size: CARDINAL] = {
WriteObjectWords[LOOPHOLE[p], size]};


bcdOffset: CARDINAL;
bcdIndex: StreamIndex;

BCDIndex: PROC[offset: CARDINAL] RETURNS[StreamIndex] = INLINE {
RETURN[bcdIndex + offset*BytesPerWord]};

StartBCD: PUBLIC PROC = {
[] _ NextFilePage[];
bcdIndex _ stream.GetIndex[];
bcdOffset _ 0};

ReadBCDOffset: PUBLIC PROC RETURNS[CARDINAL] = {RETURN[bcdOffset]};

ReadBCDIndex: PUBLIC PROC RETURNS[StreamIndex] = {
RETURN[BCDIndex[bcdOffset]]};

AppendBCDWord: PUBLIC PROC[word: UNSPECIFIED] = {
stream.UnsafePutBlock[[@word, 0, 2]]; bcdOffset _ bcdOffset + 1};

AppendBCDWords: PUBLIC PROC[addr: Address, n: CARDINAL] = {
WriteObjectWords[addr, n]; bcdOffset _ bcdOffset + n};

AppendBCDString: PUBLIC PROC[s: LONG STRING] = {
header: StringBody _ [length: s.length, maxlength: s.length, text:];
AppendBCDWords[@header, StringBody[0].SIZE];
AppendBCDWords[@s.text, StringBody[s.length].SIZE - StringBody[0].SIZE]};

FillBCDPage: PUBLIC PROC = {
IF bcdOffset MOD PageSize # 0 THEN {
[] _ NextFilePage[]; bcdOffset _ bcdOffset + (PageSize - bcdOffset MOD PageSize)}
};

UpdateBCDWords: PUBLIC PROC[offset: CARDINAL, addr: Address, n: CARDINAL] = {
RewriteObjectWords[BCDIndex[offset], addr, n]};

EndBCD: PUBLIC PROC = {[] _ NextFilePage[]};



PageCount: PROC[words: CARDINAL] RETURNS[CARDINAL] = {
RETURN[(words+(PageSize-1))/PageSize]};

SetFgt: PROC[d: SymbolSegment.WordOffset, sourceFile: FileParms.Name]
RETURNS[fgBase, fgPages: CARDINAL] = {
np: CARDINAL = PageCount[d];
dataPtr.symSeg.pages _ np;
IF dataPtr.interface THEN {
fgBase _ 0;
dataPtr.symSeg.extraPages _ fgPages _ 0;
dataPtr.codeSeg.file _ BcdDefs.FTNull;
dataPtr.codeSeg.base _ dataPtr.codeSeg.pages _ 0;
dataPtr.objectBytes _ 0;
dataPtr.mtRoot.framesize _ dataPtr.globalFrameSize _ 0}
ELSE { 
fgBase _ np;
dataPtr.symSeg.extraPages _ fgPages _ PageCount[
(StringBody[sourceFile.Length[]].SIZE-StringBody[0].SIZE) +
dataPtr.fgTable.LENGTH*SymbolSegment.FGTEntry.SIZE +
SymbolSegment.FGHeader.SIZE]};
dataPtr.codeSeg.class _ code;  dataPtr.codeSeg.extraPages _ 0;
RETURN};



litBias: CARDINAL;

WriteExtensions: PROC[table: Alloc.Handle] RETURNS[size: CARDINAL] = {
OPEN SymbolSegment;
tb: Tree.Base;
ltb: Literals.Base;
treeLoc: Tree.Index _ Tree.Index.FIRST;
initialized: BOOL _ FALSE;	-- set after rep of Tree.Null is written

OutputNotify: Alloc.Notifier = {
tb _ base[Tree.treeType];  ltb _ base[ltType];
seb _ base[seType];   ctxb _ base[ctxType];
extb _ base[extType]};

OutputLiteral: PROC[t: Tree.Link.literal] RETURNS[Tree.Link] = {
OPEN LiteralOps;
WITH lit: t.index SELECT FROM
word => lit.lti _ CopyLiteral[[baseP:@ltb, index:lit]].lti-litBias;
string => lit.sti _ Literals.STNull;	-- temporary
ENDCASE => ERROR;
RETURN[t]};

SetEmpty: Tree.Map = {RETURN[Tree.Null]};

OutputTree: Tree.Map = {
WITH link: t SELECT FROM
literal => v _ OutputLiteral[link];
subtree => {
s: Tree.Link = TreeOps.UpdateLeaves[link, OutputTree];
IF s = Tree.Null AND initialized THEN v _ Tree.Null
ELSE
WITH s SELECT FROM
subtree => {
node: Tree.Index = index;
header: XTree.Node--[0]--;
nw: CARDINAL;

WriteSon: Tree.Scan = {
link: XTree.Link _ XTreeOps.LinkToX[t];
nw _ nw +  XTree.Link.SIZE;
WriteTableBlock[@link, XTree.Link.SIZE]};

header _ [
free: FALSE,
name: tb[node].name,
attr1: tb[node].attr1, attr2: tb[node].attr2, attr3: tb[node].attr3,
shared: FALSE,
nSons: tb[node].nSons,
info: tb[node].info,
son: ];
SELECT header.name FROM
IN [apply..typecode], textlit, exlist, shorten, IN [ord..val] =>
header.info _ SymbolOps.UnderType[header.info];
ENDCASE;
nw _ XTree.Node.SIZE;
WriteTableBlock[@header, XTree.Node.SIZE];	-- common header
XTreeOps.ForEachSon[[@tb, s], WriteSon];
[] _ TreeOps.FreeTree[TreeOps.UpdateLeaves[s, SetEmpty]];
v _ [subtree[index: treeLoc]];  treeLoc _ treeLoc + nw;
IF treeLoc-Tree.Index.FIRST > XTree.Index.LAST-XTree.Index.FIRST THEN
ERROR Alloc.Failure[table, Tree.treeType]
};
ENDCASE => v _ s};
ENDCASE => v _ link;
RETURN};

extb: SymbolSegment.Base;
extLimit: ExtIndex;
seb, ctxb: Symbols.Base;
table.AddNotify[OutputNotify];
[] _ OutputTree[Tree.Null];  initialized _ TRUE;
[extb, LOOPHOLE[extLimit, CARDINAL]] _ table.Bounds[extType];
FOR exti: ExtIndex _ ExtIndex.FIRST, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
extb[exti].tree _
IF dataPtr.interface OR extb[exti].type = value OR extb[exti].type = default
THEN OutputTree[extb[exti].tree]
ELSE Tree.Null;
ENDLOOP;
table.DropNotify[OutputNotify];
RETURN[treeLoc-Tree.Index.FIRST]};


WriteExtensionTable: PROC[table: Alloc.Handle] RETURNS[size: CARDINAL] = {
OPEN SymbolSegment;
extb: SymbolSegment.Base;
extLimit: ExtIndex;

OutputNotify: Alloc.Notifier = {extb _ base[extType]};

table.AddNotify[OutputNotify];
extLimit _ table.Top[extType];  size _ 0;
FOR exti: ExtIndex _ ExtIndex.FIRST, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
IF extb[exti].tree # Tree.Null THEN {
extRecord: XSymbolSegment.ExtRecord _ [
type: extb[exti].type,
sei: extb[exti].sei,
tree: XTreeOps.LinkToX[extb[exti].tree]];
size _ size + XSymbolSegment.ExtRecord.SIZE;
WriteTableBlock[@extRecord, XSymbolSegment.ExtRecord.SIZE]};
ENDLOOP;
table.DropNotify[OutputNotify];
RETURN};



WritePackTables: PROC[table: Alloc.Handle] = {
OPEN Symbols, PackageSymbols;
bb: Symbols.Base;

OutputNotify: Alloc.Notifier = {bb _ base[SymbolSegment.bodyType]};

BodyLength: PROC[info: Symbols.BodyInfo] RETURNS[CARDINAL] = INLINE {
RETURN[WITH info SELECT FROM External => bytes, ENDCASE => 0]};

nOuter: CARDINAL = dataPtr.nBodies - dataPtr.nInnerBodies;
outer: LONG DESCRIPTOR FOR ARRAY OF OuterPackRecord _
DESCRIPTOR[OSMiscOps.Words[nOuter*OuterPackRecord.SIZE], nOuter];
next: CARDINAL _ 0;
nextIP: IPIndex _ IPIndex.FIRST;

OuterBody: PROC[bti: BTIndex] = {
WITH body: bb[bti] SELECT FROM
Callable =>
IF ~body.inline THEN {
outer[next] _ OuterPackRecord[
hti: SymbolOps.NameForSe[body.id],
entryIndex: body.entryIndex,
length: BodyLength[body.info],
firstSon: InnerBodies[bti],
resident: body.resident];
next _ next + 1};
ENDCASE
};

InnerBodies: PROC[root: BTIndex] RETURNS[origin: IPIndex] = {
buffer: InnerPackRecord;

ProcessBody: PROC[bti: BTIndex] RETURNS[BOOL] = {
WITH body: bb[bti] SELECT FROM
Callable =>
IF ~body.inline AND body.level > Symbols.lL THEN {
IF origin # IPNull THEN WriteObjectWords[@buffer, InnerPackRecord.SIZE];
buffer _ InnerPackRecord[
entryIndex: body.entryIndex,
length:  BodyLength[body.info],
lastSon: FALSE];
IF origin = IPNull THEN origin _ nextIP;
nextIP _ nextIP + 1};
ENDCASE => NULL;
RETURN[FALSE]};

origin _ IPNull;
IF root # Symbols.RootBti THEN [] _ SymbolOps.EnumerateBodies[root, ProcessBody]
ELSE
FOR sonBti: BTIndex _ SymbolOps.SonBti[root], SymbolOps.SiblingBti[sonBti]
UNTIL sonBti = BTNull DO
WITH body: bb[sonBti] SELECT FROM
Callable => NULL;	-- processed as an outer body
ENDCASE => [] _ SymbolOps.EnumerateBodies[sonBti, ProcessBody];
ENDLOOP;
IF origin # IPNull THEN {
buffer.lastSon _ TRUE; WriteObjectWords[@buffer, InnerPackRecord.SIZE]};
RETURN};

table.AddNotify[OutputNotify];
OuterBody[Symbols.RootBti];
FOR bti: BTIndex _ SymbolOps.SonBti[Symbols.RootBti], SymbolOps.SiblingBti[bti]
UNTIL bti = BTNull DO
OuterBody[bti] ENDLOOP;
table.DropNotify[OutputNotify];
IF next # outer.LENGTH OR nextIP # dataPtr.nInnerBodies THEN ERROR;
SortPackInfo[outer, 1, outer.LENGTH];
WriteObjectWords[outer.BASE, nOuter*OuterPackRecord.SIZE];
OSMiscOps.FreeWords[outer.BASE]};

SortPackInfo: PROC[
a: LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.OuterPackRecord,
l, u: CARDINAL] = {
h, i, j, k: CARDINAL;
key: Symbols.Name;
t: PackageSymbols.OuterPackRecord;
h _ u - l;
DO
h _ h/2;
FOR k IN [l+h .. u) DO
i _ k;  j _ k-h;  key _ a[k].hti;  t _ a[k];
WHILE key < a[j].hti DO
a[i] _ a[j];  i _ j;
IF j < l+h THEN EXIT;  j _ j-h;
ENDLOOP;
a[i] _ t;
ENDLOOP;
IF h <= 1 THEN EXIT;
ENDLOOP
};



StartObjectFile: PUBLIC PROC[objectStream: IO.STREAM] = {
stream _ objectStream};


TableOut: PUBLIC PROC[table: Alloc.Handle] = {
OPEN SymbolSegment;
h: STHeader;
fixupLoc: StreamIndex;
d: WordOffset;
nw: CARDINAL;

WriteSubTable: PROC[selector: Table.Selector] = {
base: Alloc.Base;
size: CARDINAL;
[base, size] _ table.Bounds[selector];
WriteTableBlock[base, size]};

dataPtr.symSeg.class _ symbols;
dataPtr.symSeg.base _ NextFilePage[];
h.versionIdent _ SymbolSegment.VersionID;
h.version _ dataPtr.objectVersion;
h.sourceVersion _ dataPtr.source.version;
h.creator _ dataPtr.compilerVersion;
h.definitionsFile _ dataPtr.interface;
h.extended _ TRUE;
h.directoryCtx _ dataPtr.moduleCtx;
h.importCtx _ dataPtr.importCtx;
h.outerCtx _ dataPtr.mainCtx;
d _ STHeader.SIZE;
h.hvBlock.offset _ d;
d _ d + (h.hvBlock.size _ Symbols.HashVector.SIZE);
h.htBlock.offset _ d;  d _ d + (h.htBlock.size _ table.Bounds[htType].size);
h.ssBlock.offset _ d;  d _ d + (h.ssBlock.size _ table.Bounds[ssType].size);
IF dataPtr.interface THEN h.innerPackBlock _ h.outerPackBlock _ [d, 0]
ELSE {
h.innerPackBlock.offset _ d;
d _ d + (h.innerPackBlock.size _ dataPtr.nInnerBodies*PackageSymbols.InnerPackRecord.SIZE);
h.outerPackBlock.offset _ d;
d _ d + (h.outerPackBlock.size _
(dataPtr.nBodies-dataPtr.nInnerBodies)*PackageSymbols.OuterPackRecord.SIZE)};
h.constBlock.offset _ d;  d _ d + (h.constBlock.size _ table.Bounds[constType].size);
h.seBlock.offset _ d;  d _ d + (h.seBlock.size _ table.Bounds[seType].size);
h.ctxBlock.offset _ d;  d _ d + (h.ctxBlock.size _ table.Bounds[ctxType].size);  
h.mdBlock.offset _ d;  d _ d + (h.mdBlock.size _ table.Bounds[mdType].size);
h.bodyBlock.offset _ d;  d _ d + table.Bounds[bodyType].size;
h.bodyBlock.size _ dataPtr.defBodyLimit;
h.epMapBlock _ h.spareBlock _ [d, 0];
IF table.Bounds[extType].size # 0 THEN fixupLoc _ stream.GetIndex[]
ELSE {
h.treeBlock _ h.litBlock _ h.sLitBlock _ h.extBlock _ [d, 0];
[h.fgRelPgBase, h.fgPgCount] _ SetFgt[d, dataPtr.source.locator]};
WriteObjectWords[@h, STHeader.SIZE];
WriteObjectWords[SymbolOps.HashBlock[], h.hvBlock.size];
WriteSubTable[htType];
WriteSubTable[ssType];
IF ~dataPtr.interface THEN WritePackTables[table];
WriteSubTable[constType];
WriteSubTable[seType];
WriteSubTable[ctxType];
WriteSubTable[mdType];
WriteSubTable[bodyType];
IF table.Bounds[extType].size # 0 THEN {
litBias _ LiteralOps.ForgetEntries[];
h.treeBlock.offset _ d;
h.treeBlock.size _ WriteExtensions[table];
d _ d + h.treeBlock.size;
h.litBlock.offset _ d;
nw _ table.Bounds[ltType].size - litBias;
WriteTableBlock[table.Bounds[ltType].base+litBias, nw];
d _ d + (h.litBlock.size _ nw);
h.sLitBlock _ [d, 0];
h.extBlock.offset _ d;
h.extBlock.size _ WriteExtensionTable[table];
d _ d + h.extBlock.size;
[h.fgRelPgBase, h.fgPgCount] _ SetFgt[d, dataPtr.source.locator];
RewriteObjectWords[fixupLoc, @h, STHeader.SIZE]};
IF ~dataPtr.interface THEN {
fg: FGHeader;
s: Rope.Text _ Rope.Flatten[dataPtr.source.locator];
[] _ NextFilePage[];
nw _ StringBody[s.Length].SIZE-StringBody[0].SIZE;
fg.offset _ FGHeader.SIZE + nw;
fg.length _ dataPtr.fgTable.LENGTH;
fg.sourceFile _ StringBody[
length: s.Length,
maxlength: s.Length,
text: -- written separately -- ];
WriteObjectWords[@fg, FGHeader.SIZE];
WriteObjectWords[LOOPHOLE[s, LONG POINTER]+Rope.Text.SIZE, nw];
WriteObjectWords[dataPtr.fgTable.BASE, dataPtr.fgTable.LENGTH*FGTEntry.SIZE];
OSMiscOps.FreePages[dataPtr.fgTable.BASE]}
};



RTTableOut: PUBLIC PROC[table: Alloc.Handle] = {
nLits: CARDINAL = SymLiteralOps.DescribeRefLits[].length;
nTypes: CARDINAL = SymLiteralOps.DescribeTypes[].length;
IF nLits + nTypes # 0 THEN {
OPEN RTBcd;
rtOffset: CARDINAL _ RTHeader.SIZE;
header: RTHeader _ [
refLitTable: LOOPHOLE[rtOffset],
litBase: TRASH,
litLength: TRASH,
rcMapBase: TRASH,
rcMapLength: TRASH,
stampTable: TRASH,
typeTable: LOOPHOLE[rtOffset + RefLitList[nLits].SIZE]];
fixupOffset: CARDINAL = ReadBCDOffset[];


textBase: LONG POINTER _ NIL;  -- to a sequence of StringBody's
textLimit: CARDINAL _ 0;
textLoc: CARDINAL _ 0;

EqText: PROC[rt: REF TEXT, pt: LONG POINTER TO TEXT] RETURNS[BOOL] = INLINE {
IF rt.length # pt.length THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..rt.length) DO
IF rt[i] # pt[i] THEN RETURN[FALSE] ENDLOOP;
RETURN[TRUE]};

EnterText: PROC[s: REF TEXT] RETURNS[loc: CARDINAL] = {
t: LONG POINTER TO TEXT;
nw: CARDINAL;
FOR loc _ 0, loc + TEXT[t.length].SIZE UNTIL loc >= textLoc DO
t _ textBase + loc;
IF EqText[s, t] THEN RETURN;
ENDLOOP;
nw _ TEXT[s.length].SIZE;
WHILE textLoc + nw > textLimit DO
newLimit: CARDINAL = PageCount[textLimit+MAX[MIN[textLimit/2, 512], 64]];
newBase: LONG POINTER _ OSMiscOps.Words[newLimit*PageSize];
IF textBase # NIL THEN {
PrincOpsUtils.LongCopy[from: textBase, to: newBase, nwords: textLoc];
OSMiscOps.FreeWords[textBase]};
textBase _ newBase;  textLimit _ newLimit*PageSize;
ENDLOOP;
loc _ textLoc;
PrincOpsUtils.LongCopy
[from: LOOPHOLE[s, LONG POINTER], to: textBase+loc, nwords: nw];
textLoc _ textLoc + nw;
RETURN};


stampList: REF RTBcd.StampList _ NIL;
nextStamp: NAT _ 1;

EnterStamp: PROC[mdi: Symbols.MDIndex] RETURNS[index: RTBcd.StampIndex] = {
IF mdi = Symbols.MDNull THEN index _ RTBcd.AnyStamp
ELSE {
stamp: BcdDefs.VersionStamp = table.Bounds[SymbolSegment.mdType].base[mdi].stamp;
FOR i: NAT IN [1 .. nextStamp) DO
IF stamp = stampList[i] THEN RETURN[[i]];
ENDLOOP;  
IF stampList = NIL OR nextStamp >= stampList.limit THEN ExpandStampList[];
index _ [nextStamp];  stampList[nextStamp] _ stamp;  nextStamp _ nextStamp + 1};
RETURN};

ExpandStampList: PROC = INLINE {
oldSize: NAT = nextStamp - 1;
AdjustStampList[oldSize + MAX[MIN[oldSize/2, 128], 32]]};

AdjustStampList: PROC[newSize: NAT] = {
oldSize: NAT = nextStamp - 1;
newList: REF RTBcd.StampList = NEW[RTBcd.StampList[newSize]];
FOR i: NAT IN [1 .. MIN[oldSize, newSize]] DO newList[i] _ stampList[i] ENDLOOP;
stampList _ newList};


AppendBCDWords[@header, RTHeader.SIZE];
AppendBCDWord[nLits];
IF nLits # 0 THEN {

WriteLitItem: PROC[item: SymLiteralOps.RefLitItem] = {
info: RefLitItem;
loc, chars: CARDINAL;
type: Symbols.Type;
WITH v: item SELECT FROM
atom => {
desc: ConvertUnsafe.SubString;
s: REF TEXT;
n: CARDINAL;
desc _ SymbolOps.SubStringForName[v.pName];
n _ desc.length + (desc.length MOD 2);
s _ NEW[TEXT[n]];
ConvertUnsafe.AppendSubStringToRefText[s, desc];  
IF s.length < n THEN s[n-1] _ 0c;
loc _ EnterText[s];  chars _ s.length;
type _ dataPtr.typeAtomRecord;
s _ NIL};
text => {
s: LONG STRING = LiteralOps.StringValue[v.value];
loc _ EnterText[LOOPHOLE[s, REF TEXT]];  chars _ s.length;  -- ARRGGH
type _ LiteralOps.TextType[v.value]};
ENDCASE;
info _ [
referentType: SymLiteralOps.TypeIndex[type, FALSE],
offset: loc, length: TEXT[chars].SIZE];
AppendBCDWords[@info, RefLitItem.SIZE]};

SymLiteralOps.EnumerateRefLits[WriteLitItem]};

AppendBCDWord[nTypes];
rtOffset _ rtOffset + RefLitList[nLits].SIZE + TypeList[nTypes].SIZE;
header.rcMapBase _ LOOPHOLE[rtOffset.LONG];
IF nTypes = 0 THEN header.rcMapLength _ 0
ELSE {
rcmt: RCMapOps.RCMT = RCMapOps.Create[
zone: zone, ptr: NIL, nPages: 0, expansionOK: TRUE];

EnterUT: PROC[type: Symbols.Type] RETURNS[RTBcd.UTInfo] = {
mdi: Symbols.MDIndex;
sei: Symbols.Type;
[mdi, sei] _ SymLiteralOps.UTypeId[type];
RETURN[[version: EnterStamp[mdi], sei: sei]]};

WriteTypeItem: PROC[canonical: BOOL, type: Symbols.Type] = {
s: LONG STRING _ TypeStrings.Create[dataPtr.ownSymbols, type, zone];
info: TypeItem _ [
table: dataPtr.mtRoot.sseg,
sei: type,
canonical: canonical,
rcMap: rcmt.Acquire[dataPtr.ownSymbols, type],
ct: [EnterText[LOOPHOLE[s, REF TEXT]]],  -- ARRGGH
ut: EnterUT[type]];
zone.FREE[@s];
AppendBCDWords[@info, TypeItem.SIZE]};

[] _ EnterStamp[Symbols.OwnMdi];

SymLiteralOps.EnumerateTypes[WriteTypeItem];

header.rcMapLength _ rcmt.GetSpan[].size;
AppendBCDWords[rcmt.GetSpan[].base, header.rcMapLength];
rtOffset _ rtOffset + header.rcMapLength;
[] _ RCMapOps.Destroy[rcmt]};

header.stampTable _ LOOPHOLE[rtOffset];
AdjustStampList[nextStamp-1];
AppendBCDWords[LOOPHOLE[stampList, LONG POINTER], StampList[nextStamp-1].SIZE];
rtOffset _ rtOffset + StampList[nextStamp-1].SIZE;
stampList _ NIL;

header.litBase _ LOOPHOLE[rtOffset];
header.litLength _ textLoc;
IF textBase # NIL THEN {
AppendBCDWords[textBase, textLoc]; OSMiscOps.FreeWords[textBase]};
UpdateBCDWords[fixupOffset, @header, RTHeader.SIZE]}
};


EndObjectFile: PUBLIC PROC[update: BOOL] = {
IF stream # NIL AND update THEN {
saveIndex: StreamIndex = stream.GetIndex[];
stream.SetIndex[dataPtr.fixupLoc];
stream.UnsafePutBlock[[LOOPHOLE[(@dataPtr.codeSeg).LONG, LONG POINTER TO Basics.RawBytes], 0, BcdDefs.SGRecord.SIZE*BytesPerWord]];
stream.UnsafePutBlock[[LOOPHOLE[(@dataPtr.symSeg).LONG, LONG POINTER TO Basics.RawBytes], 0, BcdDefs.SGRecord.SIZE*BytesPerWord]];
stream.UnsafePutBlock[[LOOPHOLE[dataPtr.mtRoot, LONG POINTER TO Basics.RawBytes], 0, dataPtr.mtRootSize*BytesPerWord]];
stream.SetIndex[saveIndex]};
stream _ NIL};

}.

°ObjectOut.Mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Satterthwaite, May 8, 1986 4:41:52 pm PDT
Sweet, September 2, 1980  3:05 PM
Maxwell, August 11, 1983 8:38 am
Rovner, November 21, 1983 11:11 am
Russ Atkinson (RRA) March 6, 1985 9:58:17 pm PST
bcd i/o
-- stream.PutWord[word];
symbol table i/o 
tree i/o
temporary patch for backward compatibility
package table i/o
Shell sort of a[l..u)
main drivers

ΚΆ˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ)™)Kš
œ!™!K™ K™"K™0—K˜š
Οk	˜	Kšœžœ
žœG˜XKšœžœ
žœ˜,Kšœ	žœ
žœ,˜?Kšœ	žœ
žœλ
˜ώ
Kšœžœ
žœ˜#Kšœžœ
žœ'˜@Kšœžœ
žœ˜Kšžœžœ
žœžœ˜<Kšœ
žœ
žœ˜$Kšœžœ
žœ5˜KKšœžœ
žœ˜4Kšœžœ
žœ5˜OKšœžœ
žœ˜%Kšœžœ
žœ˜Kšœ
žœ
žœžœ%˜?Kšœžœ
žœ˜)Kšœžœ
žœ`˜qKšœ	žœ
žœa˜tKšœžœ
žœ‘
˜Ί
Kšœžœ
žœZ˜oKšœžœ
žœd˜}Kšœžœ
žœ˜'Kšœžœ
žœ0˜@Kšœ	žœ
žœ˜-Kšœ
žœ
žœ
˜!Kšœžœ
žœ˜+Kšœžœžœ
˜5Kšœžœžœ˜+Kšœ
žœ
žœ˜+K˜—šœž˜Kšžœžœ‘
˜±
Kšžœ˜K˜Kšœ
žœžœΟc˜4Kšœ	žœ˜%K˜Kšœžœ
žœžœ
˜Kšœž	œ
žœ"˜6K˜Kšœ
žœ˜&Kšœžœ˜-Kšœžœ˜/K˜š
Οnœžœ
žœ
žœ
žœ˜/Kš	œžœžœ
žœžœ˜$Kšœžœžœ˜?Kšœžœ
˜šžœž˜
šžœžœžœž˜/Kšœžœ	žœ˜Kšœžœžœ
žœ˜.Kšžœ
˜——Kšžœ&˜,K˜—š œžœžœ˜6Kš
œK˜KK˜—š œžœ'žœ˜LKš
œ+˜+Kš
œ˜Kš
œ1˜1Kš
œ˜K˜—š œžœžœ˜<Kšœžœ˜%K˜—Kš
œ™˜Kšœžœ
˜K˜K˜š
 œžœ	žœžœžœ˜@Kšžœ"˜(K˜—š œžœ
žœ˜K˜Kš
œ˜K˜K˜—Kš 
œžœ
žœ
žœ
žœžœ
˜CK˜š œžœ
žœ
žœ˜2Kšžœ˜K˜—š 
œžœ
žœžœ˜1Kš
Ÿ™K˜AK˜—š œžœ
žœžœ˜;K˜6K˜—š
 œžœ
žœžœ
žœ˜0K˜DKšœ&žœ˜,Kšœ-žœžœ˜IK˜—š œžœ
žœ˜šžœžœžœ˜$KšœCžœ˜Q—š
œ˜K˜——š
 œžœ
žœ	žœžœ˜MK˜/K˜—Kš œžœ
žœ˜,K˜K˜—Kš
œ™˜š
 	œžœžœžœ
žœ˜6Kšžœ!˜'K˜—š œžœ9˜EKšžœžœ˜&Kšœžœ˜K˜šžœžœ˜K˜K˜(K˜&K˜1K˜K˜7—šžœ˜K˜˜0šœ!žœžœ˜;Kšœžœžœ˜4Kšœžœ˜———K˜>Kšžœ˜K˜K˜——Kš
œ™˜Kšœ	žœ
˜K˜š œžœžœžœ˜FKšžœ˜K˜K˜Kšœ!žœ
˜'Kšœ
žœžœŸ(˜CK˜˜ K˜.K˜+K˜K˜—š 
œžœžœ˜@Kšžœ˜šžœžœ
ž˜K˜CKšœ%Ÿ˜1Kšžœžœ
˜—Kšžœ˜K˜—Kšœžœ
˜)K˜˜šžœ	žœ
ž˜K˜#˜K˜6Kšžœžœ
žœ˜3š
ž˜šžœžœ
ž˜˜K˜K˜Kšœžœ
˜
K˜˜K˜'Kšœž˜Kšœ"žœ˜)K˜—˜
K˜K˜K˜DK˜K˜K˜K˜—š
œ*™*šžœ
ž˜šžœ.žœ˜@Kš
œ/˜/—Kšžœ
˜——Kšœž˜Kšœ$žœŸ˜;Kš
œ(˜(K˜9K˜7š	žœžœžœ
žœ
ž˜EKšžœ$˜)—Kš
œ˜—Kšžœ˜———Kšžœ
˜—Kšžœ˜K˜—K˜K˜K˜K˜Kšœ+žœ
˜0Kšœžœžœ˜=š	žœžœžœ
žœž˜S˜šžœžœžœ˜LKšžœ˜ Kšžœ˜——Kšžœ
˜—K˜Kšžœžœ˜"K˜K˜—š œžœžœžœ˜JKšžœ˜K˜Kš
œ˜K˜˜6K˜—Kš
œ˜Kš
œ)˜)š	žœžœžœ
žœž˜Sšžœžœ˜%˜'K˜K˜K˜)—Kšœ'žœ
˜,Kšœ5žœ˜<—Kšžœ
˜—Kš
œ˜Kšžœ˜K˜K˜——Kš
œ™˜š œžœ˜.Kšžœ˜K˜K˜K˜CK˜š
 
œžœžœ
žœžœ˜EKš
žœ
žœžœ
žœžœ˜?K˜—Kšœžœ*˜:šœžœ
ž
œ
žœ
žœ
žœ˜5Kšž
œ(žœ˜A—Kšœžœ˜Kšœžœ
˜ K˜š 	œžœ˜!šžœžœ
ž˜˜šžœžœ˜˜K˜"K˜K˜K˜K˜—K˜——Kš
ž˜—š
œ˜K˜——š œžœžœ˜=K˜K˜š œžœžœ
žœ˜1šžœžœ
ž˜˜šžœžœžœ˜2Kšžœžœ+žœ˜H˜K˜K˜Kšœ	žœ˜—Kšžœžœ˜(K˜——Kšžœžœ
˜—Kšžœ
žœ˜K˜—K˜Kšžœžœ2˜Pš
ž˜šžœG˜Jšžœž˜šžœžœ
ž˜!KšœžœŸ˜/Kšžœ8˜?—Kšžœ
˜———šžœžœ˜Kšœžœ,žœ˜H—Kšžœ˜K˜—K˜K˜šžœL˜Ošžœž˜Kšœžœ
˜——K˜Kš
žœžœ
žœžœ
žœ
˜CKšœžœ˜%Kšœžœžœ˜:Kšœžœ˜!K˜—š œžœ
˜Kšœžœ
ž
œ
žœ
žœ
žœ ˜?Kšœžœ˜Kš
œ™Kšœžœ
˜K˜K˜"K˜
š
ž˜K˜šžœžœž˜K˜,šžœž˜K˜Kšžœ	žœ
žœ˜Kšžœ
˜—K˜	Kšžœ
˜—Kšžœžœ
žœ
˜Kš
ž˜—š
œ˜K˜K˜———Kš
œ™˜š
 œžœ
žœžœ
žœ˜9K˜K˜K˜—š œžœ
žœ˜.Kšžœ˜K˜K˜K˜Kšœžœ
˜
K˜š 
œžœ˜1K˜Kšœžœ
˜K˜&K˜K˜—K˜K˜%K˜)K˜"K˜)K˜$K˜&Kšœ
žœ
˜K˜#K˜ K˜Kšœ
žœ
˜˜Kšœ-žœ˜3—K˜LK˜LKšžœžœ-˜Fšžœ˜K˜KšœUžœ˜[K˜˜ KšœFžœ˜M——K˜UK˜LK˜QK˜LK˜=K˜(K˜%Kšžœ žœ˜Cšžœ˜K˜=K˜B—Kšœžœ˜$K˜8K˜K˜Kšžœžœ˜2K˜K˜K˜K˜K˜šžœ žœ˜(K˜%K˜K˜*K˜K˜K˜)K˜7K˜K˜K˜Kš
œ-˜-K˜K˜AKšœ*žœ˜1—šžœžœ˜K˜
Kš
œ4˜4K˜Kšœžœžœ
˜2Kšœžœ˜Kšœžœ
˜#˜K˜K˜KšœŸœ˜!—Kšœžœ˜%Kš	œžœžœ
žœžœ˜?Kšœ!žœžœ
žœ˜MKšœ$žœ˜*—š
œ˜K˜K˜K˜——š 
œžœ
žœ˜0Kšœžœ*˜9Kšœžœ(˜8šžœžœ˜Kšžœ˜Kšœ
žœžœ
˜#˜Kšœ
žœ˜ Kšœ	žœ
˜Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kšœžœžœ˜8—Kšœ
žœ˜(K˜K˜Kšœ
žœ
žœžœŸ ˜?Kšœžœ˜Kšœ	žœ˜K˜š œžœžœžœ
žœžœ
žœžœ˜MKšžœžœ
žœ
žœ˜,šžœžœ
žœž˜$Kš
žœžœ
žœ
žœžœ
˜,—Kšžœ
žœ˜K˜—š 	œžœžœ
žœžœžœ˜7Kš	œžœ
žœ
žœ
žœ
˜Kšœžœ
˜
š	žœžœžœ
žœž˜>K˜Kšžœžœ
žœ
˜Kšžœ
˜—Kšœžœžœ
˜šžœž˜!Kšœ
žœžœ
žœ˜IKšœ	žœ
žœ&˜;šžœžœ
žœ˜Kš
œE˜EK˜—Kš
œ3˜3Kšžœ
˜—K˜š
œ˜Kšœžœžœ
žœ!˜@—K˜Kšžœ˜K˜K˜—Kšœžœžœ
˜%Kšœžœ˜K˜š 
œžœžœ˜KKšžœžœ˜3šžœ˜K˜Qšžœžœ
žœž˜!Kšžœžœ
žœ˜)Kšžœ˜
—Kšžœ
žœ
žœžœ˜JK˜P—Kšžœ˜K˜—š œžœžœ˜ Kšœ	žœ˜Kšœžœ
žœ˜9K˜—š œžœ
žœ˜'Kšœ	žœ˜Kšœ	žœžœ˜=Kšžœžœ
žœžœžœžœ
˜PK˜K˜K˜—Kšœ!žœ˜'K˜Kšžœžœ˜˜š œžœ$˜6K˜Kšœžœ
˜K˜šžœ	žœ
ž˜˜	Kš
œ˜Kšœžœ
˜Kšœžœ
˜K˜+Kšœžœ˜&Kšœžœ
žœ˜Kš
œ2˜2Kšžœžœ
˜!K˜&K˜Kšœžœ˜	—˜	Kšœžœ
žœ#˜1Kšœžœžœ
žœŸ	˜EK˜%—Kšžœ
˜—˜Kšœ,žœ˜3Kšœžœžœ˜'—Kšœ!žœ˜(K˜—K˜.K˜—K˜Kšœ(žœžœ
˜EKšœžœ
žœ˜+Kšžœžœ˜)šžœ˜šœžœ˜&Kšœžœžœ˜4——˜š œžœžœ˜;K˜K˜K˜)Kšžœ(˜.K˜—š 
œžœžœ˜<Kšœžœ
žœ6˜D˜K˜K˜
K˜Kš
œ.˜.Kšœžœžœ
žœŸ	˜2K˜—Kšœžœ˜Kšœžœ˜&K˜—K˜ K˜K˜,K˜K˜)K˜8K˜)Kš
œ˜K˜—Kšœžœ˜'K˜Kš	œžœžœ
žœžœ˜OKšœ-žœ
˜2Kšœžœ
˜K˜Kšœžœ˜$K˜šžœžœ
žœ˜K˜B—Kšœ.žœ˜4—š
œ˜K˜K˜——š 
œžœ
žœ	žœ˜,šžœ
žœ
žœžœ˜!Kš
œ+˜+Kš
œ"˜"Kš
œžœžœžœ
žœ
žœ'žœ˜ƒ
Kš
œžœžœžœ
žœ
žœ'žœ˜‚
Kš	œžœžœ
žœ
žœ8˜wKš
œ˜—Kšœ	žœ˜K˜——K˜—K™—…—N€eζ