DIRECTORY
Alloc: TYPE USING [Base, Handle, Notifier, AddNotify, DropNotify, Bias, Bounds, Top],
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],
Host: TYPE MachineParms USING [bitsPerByte, bitsPerWord],
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, ExtFirst, ExtRecord, ExtIndex, STHeader, WordOffset, VersionID, ltType, htType, ssType, seType, ctxType, mdType, bodyType, extType, constType],
SymbolOps: TYPE USING [EnumerateBodies, HashBlock, NameForSe, SiblingBti, SonBti, SubStringForName],
SymLiteralOps: TYPE USING [RefLitItem, DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes, TypeIndex, UTypeId],
Table: TYPE USING [IndexRep, IPointer, Selector, Tag],
Tree: TYPE USING [Base, Index, Link, Map, Node, firstIndex, Null, treeTag, treeType],
TreeOps: TYPE USING [FreeTree, GetTag, UpdateLeaves],
TypeStrings: TYPE USING [Create],
UnsafeStorage: TYPE USING [GetSystemUZone];
ObjectOut:
PROGRAM
IMPORTS Alloc, ConvertUnsafe, IO, PrincOpsUtils, OSMiscOps, LiteralOps, RCMapOps, Rope, SymbolOps, SymLiteralOps, TreeOps, TypeStrings, dataPtr: ComData, UnsafeStorage
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 = Host.bitsPerWord/Host.bitsPerByte;
bytesPerPage: CARDINAL = pageSize*bytesPerWord;
treeTag: Table.Tag = Tree.treeTag;
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:
CARD] = {
stream.UnsafePutBlock[[base: addr, startIndex: 0, count: n*bytesPerWord]]};
RewriteObjectWords:
PROC[index: StreamIndex, addr: Address, n:
CARD] = {
saveIndex: StreamIndex = stream.GetIndex[];
stream.SetIndex[index];
stream.UnsafePutBlock[[addr, 0, n*bytesPerWord]];
stream.SetIndex[saveIndex]};
WriteTableBlock:
PROC[p: Table.IPointer, size:
CARD] = {
WriteObjectWords[LOOPHOLE[p], size]};
StartObjectFile:
PUBLIC
PROC[objectStream:
IO.
STREAM] = {
stream ← objectStream};
TableOut:
PUBLIC
PROC[table: Alloc.Handle] = {
OPEN SymbolSegment;
h: STHeader;
fixupLoc: StreamIndex;
d: WordOffset;
nw: CARD;
WriteSubTable:
PROC[selector: Table.Selector] = {
base: Alloc.Base;
size: CARD;
[base, size] ← table.Bounds[selector];
WriteTableBlock[base + table.Bias[selector], 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+table.Bias[ltType]+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: CARD = 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];
WriteObjectWords[@dataPtr.codeSeg, BcdDefs.SGRecord.SIZE];
WriteObjectWords[@dataPtr.symSeg, BcdDefs.SGRecord.SIZE];
WriteObjectWords[dataPtr.mtRoot, dataPtr.mtRootSize];
stream.SetIndex[saveIndex]};
stream ← NIL};
}.