bcdHeader: BcdDefs.BCD;
module: BcdDefs.MTRecord.direct;
export: BcdDefs.EXPHandle;
defsFile: BcdDefs.FTRecord;
codeSeg, symbolSeg: BcdDefs.SGRecord;
ssb: Rope.ROPE;
out: IO.STREAM;
moduleIndex, segIndex: StreamIndex; -- for fixup
moduleId: Rope.ROPE;
systemZone: UNCOUNTED ZONE ← UnsafeStorage.GetSystemUZone[];
InitializePackedString:
PROC = {ssb ← Rope.FromChar[
LOOPHOLE[0]]};
ssb.string.length ← 1; ssb.size[1] ← 0};
AddName:
PROC[n: Rope.
ROPE]
RETURNS[name: BcdDefs.NameRecord] = {
IF n = NIL THEN name ← BcdDefs.NullName
ELSE {
lengthChar: CHAR ← VAL[CARDINAL[n.Length[]]];
name ← BcdDefs.NameRecord[ssb.Length[]+1];
ssb ← Rope.Cat[ssb, Rope.FromChar[lengthChar], n]};
RETURN};
FillInModule:
PROC[name: BcdDefs.NameRecord, altoCode:
BOOL] = {
OPEN BcdDefs;
module ← MTRecord[
name: name, namedInstance: FALSE, initial: FALSE,
file: FTSelf, linkLoc: frame, config: CTNull,
code: [
sgi: SGIndex.FIRST, linkspace: FALSE, packed: FALSE,
offset: 0, length: 0],
sseg: SGIndex.FIRST+SGRecord.SIZE,
frameRefs: FALSE, frameType: 0, framesize: 4,
tableCompiled: TRUE, altoCode: altoCode, long: FALSE,
residentFrame: FALSE, crossJumped: FALSE, packageable: TRUE,
gfi: 1, variables: EVNull, ngfi: 1,
boundsChecks: FALSE, nilChecks: FALSE,
extension: direct[length: 0, frag: ]];
codeSeg ← [class: code, file: FTSelf, base: 2, pages: 0, extraPages: 0];
symbolSeg ← [class: symbols, file: FTNull, base: 0, pages: 0, extraPages: 0]};
FillInExport:
PROC[name: BcdDefs.NameRecord, size, entry:
CARDINAL] = {
export ← UnsafeStorage.NewUObject[BcdDefs.EXPRecord.SIZE+size, systemZone];
export^ ← BcdDefs.EXPRecord[
name: name, size: size, port: interface,
namedInstance: FALSE, typeExported: FALSE,
file: BcdDefs.FTIndex.FIRST, links:];
FOR i: CARDINAL IN [0..size) DO export.links[i] ← BcdDefs.NullLink ENDLOOP;
export.links[entry] ← BcdDefs.Link[variable[vgfi:1, var:0, vtag:var]]};
FillInHeader:
PROC = {
OPEN h: bcdHeader;
clear all fields
LOOPHOLE[bcdHeader, ARRAY [0..BcdDefs.BCD.SIZE) OF CARDINAL] ← ALL[0];
h.versionIdent ← BcdDefs.VersionID;
h.version ← PGSConDefs.objectVersion;
h.creator ← PGSConDefs.pgsVersion;
h.sourceVersion ← PGSConDefs.sourceVersion;
h.source ←
IF PGSConDefs.sourceName =
NIL
THEN BcdDefs.NullName ELSE AddName[PGSConDefs.sourceName];
h.nPages ← 1;
h.nConfigs ← 0; h.nModules ← 1;
h.nImports ← 0; h.nExports ← IF export = NIL THEN 0 ELSE 1;
h.definitions ← h.repackaged ← h.typeExported ← FALSE;
h.tableCompiled ← TRUE;
h.versions ← FALSE;
h.extended ← TRUE;
h.spare1 ← TRUE; -- large eval stack
h.spare2 ← FALSE;
h.firstdummy ← 2; h.nDummies ← 0;
h.ctOffset ← h.impOffset ← h.ntOffset ← BcdDefs.BCD.SIZE;
h.ssOffset ← BcdDefs.BCD.SIZE;
h.ssLimit ← StringBody[ssb.Length[]].SIZE; -- all strings must be entered by now
h.mtOffset ← h.ssOffset + LOOPHOLE[h.ssLimit, CARDINAL];
h.mtLimit ← BcdDefs.MTIndex.FIRST + BcdDefs.MTRecord.direct.SIZE;
h.sgOffset ← h.mtOffset + LOOPHOLE[h.mtLimit, CARDINAL];
h.sgLimit ← BcdDefs.SGIndex.FIRST + 2*BcdDefs.SGRecord.SIZE;
IF export #
NIL
THEN {
h.ftOffset ← h.sgOffset + LOOPHOLE[h.sgLimit, CARDINAL];
h.ftLimit ← BcdDefs.FTIndex.FIRST + BcdDefs.FTRecord.SIZE;
h.expOffset ← h.ftOffset + LOOPHOLE[h.ftLimit, CARDINAL];
h.expLimit ← BcdDefs.EXPIndex.FIRST + BcdDefs.EXPRecord.SIZE+export.size};
h.rtPages ← [0, 0]};
PutWords:
PROC[out:
IO.
STREAM, base:
LONG
POINTER, words:
NAT] = {
out.UnsafePutBlock[[base: base, count: words*bytesPerWord]]};
PadToIndex:
PROC[out:
IO.
STREAM, index:
INT] = {
here: INT ~ out.GetIndex[];
IF here>index THEN ERROR;
THROUGH [here..index) DO out.PutChar[VAL[0]] ENDLOOP};
WriteBcd:
PROC[out:
IO.
STREAM] = {
ssb ← Rope.Flatten[ssb]; -- so we can blt it out
PutWords[out, @bcdHeader, BcdDefs.BCD.SIZE];
PutWords[out, LOOPHOLE[ssb], StringBody[ssb.Length[]].SIZE];
moduleIndex ← IO.GetIndex[out];
PutWords[out, @module, BcdDefs.MTRecord.direct.SIZE];
segIndex ← IO.GetIndex[out];
PutWords[out, @codeSeg, BcdDefs.SGRecord.SIZE];
PutWords[out, @symbolSeg, BcdDefs.SGRecord.SIZE];
IF export #
NIL
THEN {
PutWords[out, @defsFile, BcdDefs.FTRecord.SIZE];
PutWords[out, export, (BcdDefs.EXPRecord.SIZE+export.size)];
systemZone.FREE[@export]}
};
PagesForWords:
PROC[nWords:
CARDINAL]
RETURNS[
CARDINAL] =
INLINE {
RETURN[(nWords + (PrincOps.wordsPerPage-1))/PrincOps.wordsPerPage]};
WriteBcdHeader:
PUBLIC
PROC[
outStream: IO.STREAM,
tableId, binaryId: Rope.ROPE, -- file being written
interfaceId, fileId: Rope.ROPE, -- interface being exported
altoCode: BOOL←TRUE] = {
symbols: FileSegment.Pages;
out ← outStream;
IF tableId # NIL THEN moduleId ← tableId
ELSE {
dot: INT ~ binaryId.Find["."];
IF dot < 0 THEN moduleId ← binaryId
ELSE moduleId ← binaryId.Substr[len: dot];
};
InitializePackedString[];
FillInModule[AddName[moduleId], altoCode];
fill in interface info
IF interfaceId = NIL THEN export ← NIL
ELSE {
dName: BcdDefs.NameRecord = AddName[interfaceId];
size, entry: CARDINAL;
[defsFile.version, symbols] ←
TableCommand.FindInterface[interfaceId, fileId
! TableCommand.BadInterface => {
OPEN PGSConDefs;
seterrstream[]; outeol[1];
outstring[id]; outstring[" cannot be opened"];
GO TO fail}];
defsFile.name ← IF fileId = NIL THEN dName ELSE AddName[fileId];
[size, entry] ← TableCommand.FindItem[symbols, moduleId
! TableCommand.BadInterface => {
OPEN PGSConDefs;
seterrstream[]; outeol[1];
outstring[moduleId]; outstring[" not found"];
GO TO fail}];
FillInExport[dName, size, entry];
EXITS
fail => {
OPEN PGSConDefs;
outstring[" -- SELF used"];
outeol[2]; resetoutstream[]; warningsLogged ← TRUE;
export ← NIL}};
FillInHeader[]; -- Do this after all strings entered
WriteBcd[out];
PadToIndex[out, PrincOps.bytesPerPage]};
FixupBcdHeader:
PUBLIC
PROC = {
bytesPerPage: CARDINAL = PrincOps.bytesPerPage;
endIndex: StreamIndex ← IO.GetIndex[out];
nBytes: CARDINAL = endIndex - bytesPerPage;
IF export # NIL THEN RETURN; ** from ModuleMaker ??
module.code.length ← nBytes;
codeSeg.pages ← PagesForWords[(nBytes + (bytesPerWord-1))/bytesPerWord];
IF bcdHeader.nExports = 0
THEN {
startIndex: StreamIndex;
symbolBytes: CARDINAL;
UNTIL (startIndex ←
IO.GetIndex[out])
MOD bytesPerPage = 0
DO
out.PutChar[000C]; ENDLOOP;
symbolSeg ← [
class: symbols, file: BcdDefs.FTSelf,
base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0];
PGSConDefs.WriteSymbols[out, moduleId];
endIndex ← IO.GetIndex[out];
symbolBytes ← endIndex-startIndex;
symbolSeg.pages ← PagesForWords[(symbolBytes + (bytesPerWord-1))/bytesPerWord]};
IO.SetIndex[out, moduleIndex];
PutWords[out, @module, BcdDefs.MTRecord.direct.SIZE];
IO.SetIndex[out, segIndex];
PutWords[out, @codeSeg, BcdDefs.SGRecord.SIZE];
PutWords[out, @symbolSeg, BcdDefs.SGRecord.SIZE];
IO.SetIndex[out, endIndex]
};