-- file ObjectOut.Mesa
-- last modified by Satterthwaite, July 27, 1983 2:21 pm
-- last modified by Sweet, July 28, 1982 9:03 am
DIRECTORY
Alloc: TYPE USING [Base, Handle, Notifier, AddNotify, DropNotify, Bounds],
BcdDefs: TYPE USING [SGRecord, VersionStamp, FTNull],
ComData: TYPE USING [
catchBytes, codeByteOffsetList, codeOffsetList, compilerVersion,
codeSeg, defBodyLimit, fgTable, fixupLoc, globalFrameSize, importCtx, interface,
jumpIndirectList, mainCtx, moduleCtx, mtRoot, mtRootSize, nBodies, nInnerBodies,
objectBytes, objectVersion, ownSymbols, source, symSeg, typeAtomRecord],
CompilerUtil: TYPE USING [Address],
Environment: TYPE USING [bytesPerWord, wordsPerPage],
FileStream: TYPE USING [FileByteIndex, GetIndex, SetIndex],
Fixup: TYPE USING [JIHandle, PCHandle],
Inline: TYPE USING [LongCOPY],
Literals: TYPE USING [Base, STNull],
LiteralOps: TYPE USING [CopyLiteral, ForgetEntries, StringValue, TextType],
OSMiscOps: TYPE USING [FreeWords, Words],
PrincOps: TYPE USING [BytePC],
PackageSymbols: TYPE USING [
ConstRecord, OuterPackRecord, InnerPackRecord, IPIndex, IPNull, JIData],
RCMap: TYPE USING [Base],
RCMapOps: TYPE USING [Acquire, Finalize, GetBase, Initialize],
RTBcd: TYPE USING [
RefLitItem, RefLitList, RTHeader, StampIndex, StampList,TypeItem, TypeList,
UTInfo, AnyStamp],
Stream: TYPE USING [Block, Handle, PutBlock, PutWord],
Strings: TYPE USING [String, SubString, SubStringDescriptor, AppendSubString],
Symbols: TYPE USING [
Base, HashVector, Name, Type, MDIndex, BodyInfo, BTIndex, CBTIndex,
nullName, 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 [
HashBlock, NameForSe, SiblingBti, SonBti, SubStringForName],
SymLiteralOps: TYPE USING [
RefLitItem, DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes,
TypeIndex, UTypeId],
Table: TYPE USING [IPointer, Selector],
Tree: TYPE USING [Base, Index, Link, Map, Node, Null, NullIndex, treeType],
TreeOps: TYPE USING [FreeTree, NodeSize, UpdateLeaves],
TypeStrings: TYPE USING [Create];
ObjectOut: PROGRAM
IMPORTS
Alloc, FileStream, Inline, OSMiscOps, LiteralOps, RCMapOps,
Stream, Strings, SymbolOps, SymLiteralOps, TreeOps, TypeStrings,
dataPtr: ComData
EXPORTS CompilerUtil = {
PageSize: CARDINAL = Environment.wordsPerPage;
BytesPerWord: CARDINAL = Environment.bytesPerWord;
BytesPerPage: CARDINAL = PageSize*BytesPerWord;
ByteBlock: PROC [base: LONG POINTER, nw: CARDINAL] RETURNS [Stream.Block] = INLINE {
RETURN [[LOOPHOLE[base], 0, BytesPerWord*nw]]};
StreamIndex: TYPE = FileStream.FileByteIndex;
Address: TYPE = CompilerUtil.Address;
GetShortIndex: PROC [stream: Stream.Handle] RETURNS [CARDINAL] = INLINE {
RETURN [FileStream.GetIndex[stream]]};
stream: Stream.Handle ← NIL;
zone: UNCOUNTED ZONE ← NIL;
NextFilePage: PUBLIC PROC RETURNS [CARDINAL] = {
fill: ARRAY [0..8) OF WORD ← ALL[0];
r: INTEGER = (GetShortIndex[stream] 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];
stream.PutBlock[ByteBlock[fill.BASE, m]];
ENDLOOP;
RETURN [GetShortIndex[stream]/BytesPerPage + 1]};
WriteObjectWord: PROC [w: WORD] = INLINE {stream.PutWord[w]};
WriteObjectWords: PROC [addr: Address, n: CARDINAL] = {
stream.PutBlock[ByteBlock[addr, n]]};
RewriteObjectWords: PROC [index: StreamIndex, addr: Address, n: CARDINAL] = {
saveIndex: StreamIndex = FileStream.GetIndex[stream];
FileStream.SetIndex[stream, index];
stream.PutBlock[ByteBlock[addr, n]];
FileStream.SetIndex[stream, saveIndex]};
WriteTableBlock: PROC [p: Table.IPointer, size: CARDINAL] = {
stream.PutBlock[ByteBlock[p, size]]};
-- bcd i/o
bcdOffset: CARDINAL;
bcdIndex: StreamIndex;
BCDIndex: PROC [offset: CARDINAL] RETURNS [StreamIndex] = INLINE {
RETURN [bcdIndex + offset*BytesPerWord]};
StartBCD: PUBLIC PROC = {
[] ← NextFilePage[];
bcdIndex ← FileStream.GetIndex[stream];
bcdOffset ← 0};
ReadBCDOffset: PUBLIC PROC RETURNS [CARDINAL] = {RETURN [bcdOffset]};
ReadBCDIndex: PUBLIC PROC RETURNS [StreamIndex] = {
RETURN [BCDIndex[bcdOffset]]};
AppendBCDWord: PUBLIC PROC [word: UNSPECIFIED] = {
stream.PutWord[word]; bcdOffset ← bcdOffset + 1};
AppendBCDWords: PUBLIC PROC [addr: Address, n: CARDINAL] = {
WriteObjectWords[addr, n]; bcdOffset ← bcdOffset + n};
AppendBCDString: PUBLIC PROC [s: Strings.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[]};
-- symbol table i/o
PageCount: PROC [words: CARDINAL] RETURNS [CARDINAL] = {
RETURN [(words+(PageSize-1))/PageSize]};
SetFgt: PROC [d: SymbolSegment.WordOffset, sourceFile: Strings.SubString]
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};
-- tree i/o
litBias: CARDINAL;
WriteExtension: PROC [table: Alloc.Handle] RETURNS [size: CARDINAL] = {
OPEN SymbolSegment;
tb: Tree.Base;
ltb: Literals.Base;
treeLoc: Tree.Index;
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 THEN v ← Tree.Null
ELSE
WITH s SELECT FROM
subtree => {
node: Tree.Index = index;
nw: CARDINAL = TreeOps.NodeSize[@tb, node];
WriteTableBlock[@tb[node], nw];
[] ← TreeOps.FreeTree[TreeOps.UpdateLeaves[s, SetEmpty]];
v ← [subtree[index: treeLoc]]; treeLoc ← treeLoc + nw};
ENDCASE => v ← s};
ENDCASE => v ← link;
RETURN};
extb: SymbolSegment.Base;
extLimit: ExtIndex;
seb, ctxb: Symbols.Base;
table.AddNotify[OutputNotify];
WriteTableBlock[@tb[Tree.NullIndex], Tree.Node.SIZE];
treeLoc ← Tree.Index.FIRST + Tree.Node.SIZE;
[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]};
-- package table i/o
WritePackTables: PROC [table: Alloc.Handle] = {
OPEN Symbols, PackageSymbols;
bb: Symbols.Base;
OutputNotify: Alloc.Notifier = {bb ← base[SymbolSegment.bodyType]};
BodyLength: PROC [info: BodyInfo] RETURNS [CARDINAL] = INLINE {
RETURN [WITH info SELECT FROM External => bytes, ENDCASE => 0]};
nOuter: CARDINAL = dataPtr.nBodies - dataPtr.nInnerBodies + 1;
outer: LONG DESCRIPTOR FOR ARRAY OF OuterPackRecord ←
DESCRIPTOR[OSMiscOps.Words[nOuter*OuterPackRecord.SIZE], nOuter];
next: CARDINAL ← 0;
nextIP: IPIndex ← IPIndex.FIRST;
OuterBody: PROC [bti: CBTIndex, firstSon: IPIndex] = {
IF ~bb[bti].inline AND bb[bti].nesting # Catch THEN {
outer[next] ← OuterPackRecord[
hti: SymbolOps.NameForSe[bb[bti].id],
entryIndex: bb[bti].entryIndex,
length: BodyLength[bb[bti].info],
firstSon: firstSon,
resident: bb[bti].resident,
needsFixup: TRUE]; -- *** temporary ***
next ← next + 1}};
OuterCatch: PROC [firstSon: IPIndex] = INLINE {
outer[next] ← OuterPackRecord[
hti: nullName,
entryIndex: dataPtr.nBodies,
length: dataPtr.catchBytes,
firstSon: firstSon,
resident: bb[RootBti].resident,
needsFixup: TRUE]; -- *** temporary ***
next ← next + 1};
origin: IPIndex;
buffer: InnerPackRecord;
catchDepth: CARDINAL ← 0;
StartInner: PROC = INLINE {origin ← IPNull};
EndInner: PROC = {
IF origin # IPNull THEN {
buffer.lastSon ← TRUE; WriteObjectWords[@buffer, InnerPackRecord.SIZE]}};
ProcessBody: PROC [bti: CBTIndex] = INLINE {
IF ~bb[bti].inline AND bb[bti].nesting # Catch AND bb[bti].level > lL THEN {
IF origin # IPNull THEN WriteObjectWords[@buffer, InnerPackRecord.SIZE];
buffer ← InnerPackRecord[
entryIndex: bb[bti].entryIndex,
length: BodyLength[bb[bti].info],
needsFixup: TRUE, -- *** temporary ***
lastSon: FALSE];
IF origin = IPNull THEN origin ← nextIP;
nextIP ← nextIP + 1}};
EnumerateInner: PROC [parent: BTIndex, catch: BOOL] = {
FOR sonBti: BTIndex ← SymbolOps.SonBti[parent], SymbolOps.SiblingBti[sonBti]
UNTIL sonBti = BTNull DO
saveCatchDepth: CARDINAL = catchDepth;
WITH body: bb[sonBti] SELECT FROM
Callable => {
IF body.nesting = Catch THEN catchDepth ← catchDepth + 1
ELSE IF (catchDepth # 0) = catch THEN ProcessBody[LOOPHOLE[sonBti]]};
ENDCASE;
EnumerateInner[sonBti, catch];
catchDepth ← saveCatchDepth;
ENDLOOP};
InnerBodies: PROC [root: BTIndex, catch: BOOL] RETURNS [IPIndex] = {
StartInner[];
EnumerateInner[root, catch];
EndInner[];
RETURN [origin]};
table.AddNotify[OutputNotify];
StartInner[];
FOR bti: BTIndex ← SymbolOps.SonBti[Symbols.RootBti], SymbolOps.SiblingBti[bti]
UNTIL bti = BTNull DO
WITH body: bb[bti] SELECT FROM
Callable => NULL; -- outer bodies, see below
ENDCASE => EnumerateInner[bti, FALSE];
ENDLOOP;
EndInner[];
OuterBody[Symbols.RootBti, origin];
FOR bti: BTIndex ← SymbolOps.SonBti[Symbols.RootBti], SymbolOps.SiblingBti[bti]
UNTIL bti = BTNull DO
WITH body: bb[bti] SELECT FROM
Callable =>
IF body.nesting # Catch THEN OuterBody[LOOPHOLE[bti], InnerBodies[bti, FALSE]];
ENDCASE;
ENDLOOP;
OuterCatch[InnerBodies[Symbols.RootBti, TRUE]];
table.DropNotify[OutputNotify];
IF next # outer.LENGTH OR nextIP # dataPtr.nInnerBodies THEN ERROR;
SortPackInfo[outer, 1, outer.LENGTH-1];
WriteObjectWords[outer.BASE, nOuter*OuterPackRecord.SIZE];
OSMiscOps.FreeWords[outer.BASE]};
SortPackInfo: PROC [
a: LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.OuterPackRecord,
l, u: CARDINAL] = {
-- Shell sort of a[l..u)
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};
DoConstantTables: PROC [table: Alloc.Handle, write: BOOL] RETURNS [total: CARDINAL] = {
-- writes out sequences sorted by pc
DoPCList: PROC [handle: Fixup.PCHandle] = {
p, nextP: Fixup.PCHandle;
nw : CARDINAL ← 0;
FOR p ← handle, p.next UNTIL p = NIL DO
nw ← nw + PrincOps.BytePC.SIZE;
ENDLOOP;
total ← total + CARDINAL.SIZE + nw;
IF write THEN {
WriteObjectWord[nw/PrincOps.BytePC.SIZE];
FOR p ← handle, nextP UNTIL p = NIL DO
nextP ← p.next;
WriteObjectWord[LOOPHOLE[p.pc, CARDINAL]];
zone.FREE[@p];
ENDLOOP}};
DoJIList: PROC [handle: Fixup.JIHandle] = INLINE {
j, nextJ: Fixup.JIHandle;
nw: CARDINAL ← 0;
FOR j ← handle, j.next UNTIL j = NIL DO
nw ← nw + PackageSymbols.JIData.SIZE;
ENDLOOP;
total ← total + CARDINAL.SIZE + nw;
IF write THEN {
WriteObjectWord[nw/PackageSymbols.JIData.SIZE];
FOR j ← handle, nextJ UNTIL j = NIL DO
d: PackageSymbols.JIData ← [pc: j.pc, tableSize: j.tableSize];
nextJ ← j.next;
WriteObjectWords[@d, PackageSymbols.JIData.SIZE];
zone.FREE[@j];
ENDLOOP}};
base: Alloc.Base;
nw: CARDINAL;
[base, nw] ← table.Bounds[SymbolSegment.constType];
IF write THEN {
WriteObjectWord[nw/PackageSymbols.ConstRecord.SIZE];
WriteTableBlock[base, nw]};
total ← CARDINAL.SIZE + nw;
DoPCList[dataPtr.codeOffsetList];
DoPCList[dataPtr.codeByteOffsetList];
DoJIList[dataPtr.jumpIndirectList]};
-- main drivers
StartObjectFile: PUBLIC PROC [
objectStream: Stream.Handle, scratchZone: UNCOUNTED ZONE] = {
stream ← objectStream; zone ← scratchZone};
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 ← h.constBlock ← [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+1)*PackageSymbols.OuterPackRecord.SIZE);
h.constBlock.offset ← d;
d ← d + (h.constBlock.size ← DoConstantTables[table, FALSE])};
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 ← FileStream.GetIndex[stream]
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]; [] ← DoConstantTables[table, TRUE]};
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 ← WriteExtension[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.extBlock.offset ← d;
h.sLitBlock ← [d, 0];
WriteSubTable[extType];
d ← d + (h.extBlock.size ← table.Bounds[extType].size);
[h.fgRelPgBase, h.fgPgCount] ← SetFgt[d, @dataPtr.source.locator];
RewriteObjectWords[fixupLoc, @h, STHeader.SIZE]};
IF ~dataPtr.interface THEN {
fg: FGHeader;
s: Strings.String ← zone.NEW[StringBody[dataPtr.source.locator.length]];
Strings.AppendSubString[s, @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[@s.text, nw];
WriteObjectWords[dataPtr.fgTable.BASE, dataPtr.fgTable.LENGTH*FGTEntry.SIZE];
zone.FREE[@s];
OSMiscOps.FreeWords[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: NULL,
litLength: NULL,
rcMapBase: NULL,
rcMapLength: NULL,
stampTable: NULL,
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 [t1, t2: Strings.String] RETURNS [BOOL] = INLINE {
IF t1.length # t2.length THEN RETURN [FALSE];
FOR i: CARDINAL IN [0..t1.length) DO
IF t1[i] # t2[i] THEN RETURN [FALSE] ENDLOOP;
RETURN [TRUE]};
EnterText: PROC [s: Strings.String] RETURNS [loc: CARDINAL] = {
t: Strings.String;
nw: CARDINAL;
FOR loc ← 0, loc + StringBody[t.length].SIZE UNTIL loc >= textLoc DO
t ← textBase + loc;
IF EqText[s, t] THEN RETURN;
ENDLOOP;
nw ← StringBody[s.length].SIZE;
WHILE textLoc + nw > textLimit DO
newLimit: CARDINAL = PageCount[textLimit+MAX[MIN[textLimit/2, 512], 64]]*PageSize;
newBase: LONG POINTER = OSMiscOps.Words[newLimit];
IF textBase # NIL THEN {
Inline.LongCOPY[from: textBase, to: newBase, nwords: textLoc];
OSMiscOps.FreeWords[textBase]};
textBase ← newBase; textLimit ← newLimit;
ENDLOOP;
loc ← textLoc;
Inline.LongCOPY[from: s, to: textBase+loc, nwords: nw];
textLoc ← textLoc + nw;
RETURN};
stampList: LONG POINTER TO 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: LONG POINTER TO RTBcd.StampList =
zone.NEW[RTBcd.StampList[newSize]];
FOR i: NAT IN [1 .. MIN[oldSize, newSize]] DO newList[i] ← stampList[i] ENDLOOP;
IF stampList # NIL THEN zone.FREE[@stampList];
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: Strings.SubStringDescriptor;
s: Strings.String;
n: CARDINAL;
SymbolOps.SubStringForName[@desc, v.pName];
n ← desc.length + (desc.length MOD 2);
s ← zone.NEW[StringBody[n]];
Strings.AppendSubString[s, @desc]; IF s.length < n THEN s[n-1] ← 0c;
loc ← EnterText[s]; chars ← s.length;
type ← dataPtr.typeAtomRecord;
zone.FREE[@s]};
text => {
s: Strings.String = LiteralOps.StringValue[v.value];
loc ← EnterText[s]; chars ← s.length;
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[LONG[rtOffset]];
IF nTypes = 0 THEN header.rcMapLength ← 0
ELSE {
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: Strings.String ← TypeStrings.Create[dataPtr.ownSymbols, type, zone];
info: TypeItem ← [
table: dataPtr.mtRoot.sseg,
sei: type,
canonical: canonical,
rcMap: RCMapOps.Acquire[dataPtr.ownSymbols, type],
ct: [EnterText[s]],
ut: EnterUT[type]];
zone.FREE[@s];
AppendBCDWords[@info, TypeItem.SIZE]};
RCMapOps.Initialize[ptr: NIL, nPages: 0, expansionZone: zone];
[] ← EnterStamp[Symbols.OwnMdi];
SymLiteralOps.EnumerateTypes[WriteTypeItem];
header.rcMapLength ← RCMapOps.GetBase[].nWords;
AppendBCDWords[RCMapOps.GetBase[].base, header.rcMapLength];
rtOffset ← rtOffset + header.rcMapLength;
RCMapOps.Finalize[]};
header.stampTable ← LOOPHOLE[rtOffset];
AdjustStampList[nextStamp-1];
AppendBCDWords[stampList, StampList[nextStamp-1].SIZE];
rtOffset ← rtOffset + StampList[nextStamp-1].SIZE;
zone.FREE[@stampList];
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 = FileStream.GetIndex[stream];
FileStream.SetIndex[stream, dataPtr.fixupLoc];
stream.PutBlock[ByteBlock[@dataPtr.codeSeg, BcdDefs.SGRecord.SIZE]];
stream.PutBlock[ByteBlock[@dataPtr.symSeg, BcdDefs.SGRecord.SIZE]];
stream.PutBlock[ByteBlock[dataPtr.mtRoot, dataPtr.mtRootSize]];
FileStream.SetIndex[stream, saveIndex]};
IF dataPtr.mtRoot # NIL THEN zone.FREE[@dataPtr.mtRoot];
stream ← NIL; zone ← NIL};
}.