-- file PGSBcd.mesa
-- last modified by Satterthwaite, August 1, 1983 1:13 pm
DIRECTORY
BcdDefs: TYPE,
BcdOps: TYPE USING [EXPHandle, NameString],
Environment: TYPE USING [bytesPerPage, bytesPerWord],
FileSegment: TYPE USING [Pages],
FileStream: TYPE USING [FileByteIndex, GetIndex, SetIndex],
PGSConDefs: TYPE USING [
objectVersion, outeol, outstring, pgsVersion, resetoutstream, seterrstream,
sourceName, sourceVersion, warningsLogged, WriteSymbols],
Spaces: TYPE USING [Node, Free, FreeString, PagesForWords, String],
Stream: TYPE USING [Handle, PutByte, PutBlock],
Strings: TYPE USING [String, AppendChar, AppendString],
TableCommand: TYPE USING [FindInterface, FindItem, BadInterface];
PGSBcd: PROGRAM
IMPORTS FileStream, PGSConDefs, Spaces, Stream, Strings, TableCommand
EXPORTS PGSConDefs = {
StreamIndex: TYPE = FileStream.FileByteIndex;
bytesPerWord: CARDINAL = Environment.bytesPerWord;
-- BCD construction
bcdHeader: BcdDefs.BCD;
module: BcdDefs.MTRecord;
export: BcdOps.EXPHandle;
defsFile: BcdDefs.FTRecord;
codeSeg, symbolSeg: BcdDefs.SGRecord;
ssb: BcdOps.NameString ← NIL;
out: Stream.Handle;
moduleIndex, segIndex: StreamIndex; -- for fixup
moduleId: STRING ← [40];
InitializePackedString: PROC = {
ssb ← LOOPHOLE[Spaces.String[60]];
ssb.string.length ← 1; ssb.size[1] ← 0};
AddName: PROC [n: Strings.String] RETURNS [name: BcdDefs.NameRecord] = {
IF n = NIL THEN name ← BcdDefs.NullName
ELSE {
Strings.AppendChar[@ssb.string, LOOPHOLE[n.length]];
name ← BcdDefs.NameRecord[ssb.string.length];
Strings.AppendString[@ssb.string, 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,
spare: FALSE, framesize: 4,
tableCompiled: TRUE, long: FALSE,
frameRefs: FALSE, frameType: 0,
residentFrame: FALSE, crossJumped: FALSE, packageable: TRUE,
gfi: 1, variables: EVNull, ngfi: 1,
boundsChecks: FALSE, nilChecks: FALSE,
links: LFIndex.FIRST,
refLiterals: RFNull,
types: TFNull];
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 ← Spaces.Node[BcdDefs.EXPRecord.SIZE+size];
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.spare1 ← h.spare2 ← h.spare3 ← 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.string.length].SIZE; -- all strings must be entered by now
h.mtOffset ← h.ssOffset + LOOPHOLE[h.ssLimit, CARDINAL];
h.mtLimit ← BcdDefs.MTIndex.FIRST + BcdDefs.MTRecord.SIZE;
h.lfOffset ← h.mtOffset + LOOPHOLE[h.mtLimit, CARDINAL];
h.lfLimit ← LOOPHOLE[BcdDefs.LinkFrag[0].SIZE];
h.sgOffset ← h.lfOffset + LOOPHOLE[h.lfLimit, 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]};
WriteBcd: PROC [out: Stream.Handle] = {
linkFrag: ARRAY [0..BcdDefs.LinkFrag[0].SIZE) OF CARDINAL ← ALL[0];
out.PutBlock[[@bcdHeader, 0, BcdDefs.BCD.SIZE*bytesPerWord]];
out.PutBlock[[ssb, 0, StringBody[ssb.string.length].SIZE*bytesPerWord]];
Spaces.FreeString[LOOPHOLE[ssb]]; ssb ← NIL;
moduleIndex ← FileStream.GetIndex[out];
out.PutBlock[[@module, 0, BcdDefs.MTRecord.SIZE*bytesPerWord]];
out.PutBlock[[@linkFrag, 0, BcdDefs.LinkFrag[0].SIZE*bytesPerWord]];
segIndex ← FileStream.GetIndex[out];
out.PutBlock[[@codeSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
out.PutBlock[[@symbolSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
IF export # NIL THEN {
out.PutBlock[[@defsFile, 0, BcdDefs.FTRecord.SIZE*bytesPerWord]];
out.PutBlock[[export, 0, (BcdDefs.EXPRecord.SIZE+export.size)*bytesPerWord]];
Spaces.Free[export]}};
-- overall control
WriteBcdHeader: PUBLIC PROC [
outStream: Stream.Handle,
tableId, binaryId: Strings.String, -- file being written
interfaceId, fileId: Strings.String, -- interface being exported
altoCode: BOOL ← FALSE] = {
symbols: FileSegment.Pages;
out ← outStream; moduleId.length ← 0;
IF tableId # NIL THEN Strings.AppendString[moduleId, tableId]
ELSE
FOR i: CARDINAL IN [0 .. binaryId.length) DO
IF binaryId[i] = '. THEN EXIT;
Strings.AppendChar[moduleId, binaryId[i]];
ENDLOOP;
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"L];
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"L];
GO TO fail}];
FillInExport[dName, size, entry];
EXITS
fail => {
OPEN PGSConDefs;
outstring[" -- SELF used"L];
outeol[2]; resetoutstream[]; warningsLogged ← TRUE;
export ← NIL}};
FillInHeader[]; -- Do this after all strings entered
WriteBcd[out];
FileStream.SetIndex[out, Environment.bytesPerPage]};
FixupBcdHeader: PUBLIC PROC = {
bytesPerPage: CARDINAL = Environment.bytesPerPage;
endIndex: StreamIndex ← FileStream.GetIndex[out];
nBytes: CARDINAL = endIndex - bytesPerPage;
-- IF export # NIL THEN RETURN; ** from ModuleMaker ??
module.code.length ← nBytes;
codeSeg.pages ← Spaces.PagesForWords[(nBytes + (bytesPerWord-1))/bytesPerWord];
IF bcdHeader.nExports = 0 THEN {
startIndex: StreamIndex;
symbolBytes: CARDINAL;
UNTIL (startIndex ← FileStream.GetIndex[out]) MOD bytesPerPage = 0 DO
out.PutByte[0] ENDLOOP;
symbolSeg ← [
class: symbols, file: BcdDefs.FTSelf,
base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0];
PGSConDefs.WriteSymbols[out, moduleId];
endIndex ← FileStream.GetIndex[out];
symbolBytes ← endIndex-startIndex;
symbolSeg.pages ←
Spaces.PagesForWords[(symbolBytes + (bytesPerWord-1))/bytesPerWord]};
FileStream.SetIndex[out, moduleIndex];
out.PutBlock[[@module, 0, BcdDefs.MTRecord.SIZE*bytesPerWord]];
FileStream.SetIndex[out, segIndex];
out.PutBlock[[@codeSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
out.PutBlock[[@symbolSeg, 0, BcdDefs.SGRecord.SIZE*bytesPerWord]];
FileStream.SetIndex[out, endIndex]};
}.