-- file OutCode.mesa
-- last modified by Sandman, Jan 18, 1980 7:04 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [Address, BYTE, PageSize],
Code: FROM "code" USING [CodePassInconsistency, codeptr, dStar],
CodeDefs: FROM "codedefs" USING [CCIndex, CCItem, CCNull, NULLfileindex],
ComData: FROM "comdata" USING [
codeSeg, fgTable, linkCount, mainBody, mtRoot, nBodies, nSigCodes,
objectFrameSize, objectStream, stopping, switches],
CompilerUtil: FROM "compilerutil" USING [nextFilePage],
ControlDefs: FROM "controldefs" USING [
AllocationVectorSize, CSegPrefix, EntryVectorItem, EPRange,
InstWord],
FOpCodes: FROM "fopcodes" USING [qBLTC, qGADRB, qLADRB, qNOOP],
InlineDefs: FROM "inlinedefs" USING [BITOR, BITSHIFT],
Literals: FROM "literals" USING [MSTIndex, STIndex, stType],
LiteralOps: FROM "literalops" USING [
EnumerateLocalStrings, EnumerateMasterStrings],
Mopcodes: FROM "mopcodes" USING [zJIB, zJIW, zNOOP],
P5: FROM "p5" USING [C1W, P5Error],
P5U: FROM "p5u" USING [
FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, WordsForSei],
PrincOps: FROM "PrincOps" USING [InstWord],
Stack: FROM "stack" USING [Dump],
StreamDefs: FROM "streamdefs" USING [
GetIndex, SetIndex, StreamIndex, WriteBlock],
StringDefs: FROM "stringdefs" USING [WordsForString],
Symbols: FROM "symbols" USING [
BodyInfo, bodyType, BTIndex, CBTIndex, CSEIndex, CTXIndex, HTIndex,
ISEIndex, RecordSEIndex, SEIndex, SERecord, seType],
SymbolOps: FROM "symbolops" USING [UnderType],
SymbolSegment: FROM "symbolsegment" USING [ByteIndex, FGTEntry],
SystemDefs: FROM "systemdefs" USING [
AllocateHeapNode, AllocatePages, AllocateSegment, FreeHeapNode,
FreePages, FreeSegment],
Table: FROM "table" USING [Base, Limit, Notifier],
Tree: FROM "tree" USING [treeType];
OutCode: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, CompilerUtil, InlineDefs, LiteralOps, P5, P5U, Stack, StreamDefs, StringDefs,
SymbolOps, SystemDefs
EXPORTS CodeDefs, P5
SHARES Literals =
BEGIN
OPEN CodeDefs;
-- imported definitions
Address: TYPE = AltoDefs.Address;
BYTE: TYPE = AltoDefs.BYTE;
PageSize: INTEGER = AltoDefs.PageSize;
MyInstWord: TYPE = RECORD [SELECT COMPUTED BOOLEAN FROM
FALSE => [w: ControlDefs.InstWord],
TRUE => [w: PrincOps.InstWord],
ENDCASE];
BodyInfo: TYPE = Symbols.BodyInfo;
BTIndex: TYPE = Symbols.BTIndex;
CBTIndex: TYPE = Symbols.CBTIndex;
ByteIndex: TYPE = SymbolSegment.ByteIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
CTXIndex: TYPE = Symbols.CTXIndex;
FGTEntry: TYPE = SymbolSegment.FGTEntry;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
SEIndex: TYPE = Symbols.SEIndex;
SERecord: TYPE = Symbols.SERecord;
STIndex: TYPE = Literals.STIndex;
MSTIndex: TYPE = Literals.MSTIndex;
cb: Table.Base; -- code base (local copy)
seb: Table.Base;
bb: Table.Base;
stb: Table.Base;
OutCodeNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
cb ← base[Tree.treeType];
seb ← base[Symbols.seType]; bb ← base[Symbols.bodyType];
stb ← base[Literals.stType];
RETURN
END;
FileSequenceError: SIGNAL = CODE;
fgt: DESCRIPTOR FOR ARRAY OF FGTEntry;
fgti: INTEGER;
fgtPages: CARDINAL;
codeBase, entryBase: StreamDefs.StreamIndex;
entryVector: DESCRIPTOR FOR ARRAY OF ControlDefs.EntryVectorItem;
parity: {even, odd};
codeIndex: CARDINAL;
buffer: MyInstWord;
dStarSwitch: BOOLEAN;
StartCodeFile: PUBLIC PROCEDURE =
BEGIN -- called to set up bodytable and init binary file header
OPEN MPtr, ControlDefs, SystemDefs, StreamDefs;
prefix: CSegPrefix;
ngfi: CARDINAL = (MAX[nBodies, nSigCodes] + (EPRange-1))/EPRange;
IF ngfi ~IN [1..4] THEN P5.P5Error[833];
-- should be 256 (fix ControlDefs)
IF linkCount > 377B THEN P5.P5Error[834];
dStarSwitch ← CPtr.dStar;
prefix ← [header:[
swapinfo: 0,
info: [stops: MPtr.stopping, fill: 0, altoCode: ~dStarSwitch,
ngfi: ngfi, nlinks: linkCount]],
entry: ];
codeSeg.base ← CompilerUtil.nextFilePage[];
fgti ← -1; fgtPages ← 1;
codeBase ← GetIndex[objectStream];
[] ← WriteBlock[objectStream, @prefix, SIZE[CSegPrefix]];
entryBase ← GetIndex[objectStream];
codeIndex ← SIZE[CSegPrefix]+nBodies*SIZE[EntryVectorItem];
parity ← even;
SetIndex[objectStream, StreamIndex[page: codeBase.page, byte: 2*codeIndex]];
fgt ← DESCRIPTOR[AllocatePages[fgtPages], (fgtPages*PageSize)/SIZE[FGTEntry]];
entryVector ← DESCRIPTOR[AllocateSegment[nBodies*SIZE[EntryVectorItem]], nBodies];
RETURN
END;
MoveToCodeWord: PUBLIC PROCEDURE RETURNS [CARDINAL] =
BEGIN
IF parity = odd THEN
BEGIN
WITH buffer SELECT dStarSwitch FROM
FALSE => w.oddbyte ← 377B;
TRUE => w.oddbyte ← 377B;
ENDCASE;
MPtr.objectStream.put[MPtr.objectStream, buffer];
parity ← even; codeIndex ← codeIndex+1;
END;
RETURN [codeIndex]
END;
WriteCodeWord: PUBLIC PROCEDURE [w: WORD] =
BEGIN
IF parity # even THEN P5.P5Error[835];
MPtr.objectStream.put[MPtr.objectStream, w];
codeIndex ← codeIndex+1;
RETURN
END;
WriteCodeByte: PROCEDURE [b: BYTE] =
BEGIN
IF parity = odd THEN
BEGIN
WITH buffer SELECT dStarSwitch FROM
FALSE => w.oddbyte ← b;
TRUE => w.oddbyte ← b;
ENDCASE;
MPtr.objectStream.put[MPtr.objectStream, buffer];
parity ← even; codeIndex ← codeIndex+1;
END
ELSE
BEGIN
WITH buffer SELECT dStarSwitch FROM
FALSE => w.evenbyte ← b;
TRUE => w.evenbyte ← b;
ENDCASE;
parity ← odd; END;
RETURN
END;
NewFgtEntry: PROCEDURE [fi, ci: ByteIndex] =
BEGIN -- enters new value into fgt
i: INTEGER;
oldfgt: DESCRIPTOR FOR ARRAY OF FGTEntry;
IF (fgti ← fgti+1) >= LENGTH[fgt] THEN
BEGIN
OPEN SystemDefs;
oldfgt ← fgt; fgtPages ← fgtPages+1;
fgt ← DESCRIPTOR[
AllocatePages[fgtPages],
(fgtPages*PageSize)/SIZE[FGTEntry]];
FOR i IN [0..LENGTH[oldfgt]) DO fgt[i] ← oldfgt[i] ENDLOOP;
FreePages[BASE[oldfgt]];
END;
fgt[fgti] ← FGTEntry[fIndex: fi, cIndex: ci];
RETURN
END;
OutBinary: PUBLIC PROCEDURE [bti: CBTIndex, start: CCIndex] =
BEGIN -- outputs binary bytes for body bti starting at start
cfi: ByteIndex;
c, cj, nextc: CCIndex;
bodystart: Address;
offset, e, fs, nw: CARDINAL;
bytetable, even: BOOLEAN;
leftbyte: WORD;
bodysei: Table.Base RELATIVE POINTER [0..Table.Limit) TO transfer cons SERecord;
sei: RecordSEIndex;
bodystart ← MoveToCodeWord[];
offset ← bodystart * 2;
FOR c ← start, cb[c].flink UNTIL c = CCNull DO
WITH cc:cb[c] SELECT FROM
code => offset ← offset + cc.isize + cc.pad;
other => WITH cc SELECT FROM
table =>
BEGIN
OPEN InlineDefs;
offset ← offset + tablecodebytes + pad;
taboffset ← bodystart;
bytetable ← btab ← dStarSwitch AND ByteableJumps[flink];
even ← TRUE;
FOR cj ← flink, cb[cj].flink DO
WITH cb[cj] SELECT FROM
jump =>
IF jtype = JumpC THEN
BEGIN
-- jbytes is surprisingly correct for both forward
-- and backward jumps.
jbytes: INTEGER ← cb[destlabel].pc - pc+1;
IF dStarSwitch THEN jbytes ← jbytes+2;
IF bytetable THEN
BEGIN
IF even THEN
leftbyte ← BITSHIFT[jbytes, 8]
ELSE
WriteCodeWord[BITOR[leftbyte, jbytes]];
even ← ~even;
END
ELSE WriteCodeWord[jbytes];
END
ELSE EXIT;
ENDCASE => EXIT;
ENDLOOP;
IF bytetable AND ~even THEN
WriteCodeWord[BITOR[leftbyte,377B]];
bodystart ← codeIndex;
END;
ENDCASE;
ENDCASE;
ENDLOOP;
e ← bb[bti].entryIndex;
WITH bb[bti].info SELECT FROM
Internal =>
BEGIN
IF bti = MPtr.mainBody THEN
BEGIN
WriteCodeWord[MPtr.objectFrameSize];
bodystart ← bodystart+1;
END;
fs ← P5U.ComputeFrameSize[frameSize];
IF bb[bti].resident THEN fs ← fs+ControlDefs.AllocationVectorSize;
offset ← bodystart*2;
entryVector[e].info.framesize ← fs;
NewFgtEntry[cfi ← sourceIndex, offset];
END;
ENDCASE => P5.P5Error[836];
bodysei ← LOOPHOLE[SymbolOps.UnderType[bb[bti].ioType]];
sei ← seb[bodysei].inRecord;
entryVector[e].info.nparams ← P5U.WordsForSei[sei];
entryVector[e].info.defaults ← FALSE;
entryVector[e].initialpc ← [bodystart];
bb[bti].info ←
BodyInfo[External[origin: offset, bytes: , startIndex: fgti, indexLength: ]];
FOR c ← start, nextc UNTIL c = CCNull DO
WITH cc:cb[c] SELECT FROM
code =>
BEGIN
IF cc.sourcefileindex # NULLfileindex THEN
BEGIN
IF cfi < cc.sourcefileindex THEN
NewFgtEntry[cfi ← cc.sourcefileindex, offset];
IF cfi > cc.sourcefileindex THEN
BEGIN SIGNAL FileSequenceError; cfi ← cc.sourcefileindex; END;
END;
IF ~cc.realinst AND cc.inst # FOpCodes.qNOOP THEN ERROR;
SELECT cc.isize FROM
0 => IF cc.realinst OR cc.inst#FOpCodes.qNOOP THEN ERROR;
1 =>
BEGIN
WriteCodeByte[cc.inst];
IF cc.pad # 0 THEN [] ← MoveToCodeWord[];
END;
2 =>
BEGIN
IF cc.pad # 0 THEN
BEGIN
IF parity = even THEN SIGNAL CPtr.CodePassInconsistency;
WriteCodeByte[Mopcodes.zNOOP];
END;
WriteCodeByte[cc.inst];
WriteCodeByte[cc.parameters[1]];
END;
3 =>
BEGIN
WriteCodeByte[cc.inst];
IF cc.pad # 0 THEN
BEGIN
IF parity = even THEN SIGNAL CPtr.CodePassInconsistency;
[] ← MoveToCodeWord[];
END;
IF dStarSwitch THEN
BEGIN
WriteCodeByte[cc.parameters[1]];
WriteCodeByte[cc.parameters[2]];
END
ELSE
BEGIN
WriteCodeByte[cc.parameters[2]];
WriteCodeByte[cc.parameters[1]];
END;
END;
ENDCASE => P5.P5Error[837];
offset ← offset+cc.isize+cc.pad;
END;
other => WITH cc SELECT FROM
table =>
BEGIN
CPtr.codeptr ← c;
P5.C1W[IF btab THEN Mopcodes.zJIB ELSE Mopcodes.zJIW, taboffset];
cb[CPtr.codeptr].pad ← pad;
END;
startbody =>
BEGIN
WITH bb[index].info SELECT FROM
Internal =>
NewFgtEntry[cfi ← sourceIndex, offset];
ENDCASE => P5.P5Error[838];
bb[index].info ← BodyInfo[External[origin: offset, bytes: ,
startIndex: fgti, indexLength: ]];
END;
endbody =>
BEGIN
WITH bb[index].info SELECT FROM
External =>
BEGIN
indexLength ← fgti-startIndex+1;
bytes ← offset - origin;
END;
ENDCASE;
END;
ENDCASE;
ENDCASE;
nextc ← cb[c].flink;
WITH cb[c] SELECT FROM
code => nw ← MAX[isize, 1]-1+SIZE[code CCItem];
label => nw ← SIZE[label CCItem];
jump => nw ← SIZE[jump CCItem];
other => nw ← SIZE[other CCItem];
ENDCASE;
P5U.FreeChunk[c, nw];
WITH bb[bti].info SELECT FROM
External =>
BEGIN
indexLength ← fgti-startIndex+1;
bytes ← offset - (bodystart*2);
END;
ENDCASE;
ENDLOOP;
RETURN
END;
ByteableJumps: PROCEDURE [j: CCIndex] RETURNS [BOOLEAN] =
BEGIN -- called only when dStarSwitch = TRUE
DO
WITH cb[j] SELECT FROM
jump =>
IF jtype = JumpC THEN
BEGIN
jbytes: INTEGER ← cb[destlabel].pc - pc + 3;
IF ~forward THEN
RETURN[FALSE];
IF jbytes > LAST[BYTE] THEN RETURN[FALSE];
j ← cb[j].flink;
END
ELSE RETURN[TRUE];
ENDCASE => RETURN[TRUE]
ENDLOOP
END;
ProcessGlobalStrings: PUBLIC PROCEDURE [framestart: CARDINAL] RETURNS [nextnewframe: CARDINAL] =
BEGIN
firstnewcode, nextnewcode: CARDINAL ← MoveToCodeWord[];
stsize: CARDINAL;
dostring: PROCEDURE [msti: MSTIndex] =
BEGIN
nw: CARDINAL;
IF stb[msti].info = 0 THEN
BEGIN stb[msti].local ← TRUE; RETURN END;
nw ← StringDefs.WordsForString[stb[msti].string.length];
stb[msti].info ← nextnewframe;
nextnewframe ← nextnewframe+nw;
stb[msti].codeIndex ← nextnewcode;
nextnewcode ← nextnewcode + nw;
[] ← StreamDefs.WriteBlock[MPtr.objectStream, @stb[msti].string, nw];
codeIndex ← codeIndex+nw;
END; -- of dostring
nextnewframe ← framestart;
LiteralOps.EnumerateMasterStrings[dostring];
stsize ← nextnewframe - framestart;
IF stsize > 0 THEN BLTStrings[firstnewcode, stsize, framestart, FALSE];
END;
ProcessLocalStrings: PUBLIC PROCEDURE [framestart: CARDINAL, first: STIndex] RETURNS [nextnewframe: CARDINAL] =
BEGIN
nstrings: CARDINAL ← 0;
countstrings: PROCEDURE [msti: MSTIndex] =
BEGIN
IF stb[msti].local AND stb[msti].codeIndex # 0 THEN
nstrings ← nstrings+1;
END;
firstnewcode, nextnewcode: CARDINAL ← MoveToCodeWord[];
stsize, i, nw: CARDINAL;
cursize: CARDINAL ← 0;
StringInfo: TYPE = RECORD [offset: CARDINAL, sti: MSTIndex];
star: DESCRIPTOR FOR ARRAY OF StringInfo;
insertstrings: PROCEDURE [msti: MSTIndex] =
BEGIN
i, co, nw: CARDINAL;
IF stb[msti].local THEN
BEGIN
co ← stb[msti].codeIndex;
IF co # 0 THEN
BEGIN
FOR i ← cursize, i-1 WHILE i>0 AND co < star[i-1].offset DO
star[i] ← star[i-1];
ENDLOOP;
star[i] ← [co, msti];
cursize ← cursize+1;
END
ELSE
BEGIN
nw ← StringDefs.WordsForString[stb[msti].string.length];
stb[msti].info ← nextnewframe;
nextnewframe ← nextnewframe+nw;
stb[msti].codeIndex ← nextnewcode;
nextnewcode ← nextnewcode + nw;
[] ← StreamDefs.WriteBlock[MPtr.objectStream, @stb[msti].string, nw];
codeIndex ← codeIndex+nw;
END;
END;
END; -- of insertstrings
nextnewframe ← framestart;
LiteralOps.EnumerateLocalStrings[first, countstrings];
IF nstrings # 0 THEN
star ← DESCRIPTOR[
SystemDefs.AllocateHeapNode[nstrings*SIZE[StringInfo]],
nstrings];
LiteralOps.EnumerateLocalStrings[first, insertstrings];
stsize ← nextnewframe - framestart;
IF stsize > 0 THEN BLTStrings[firstnewcode, stsize, framestart, TRUE];
i ← 0;
WHILE i < nstrings DO
framestart ← nextnewframe;
nextnewcode ← firstnewcode ← star[i].offset;
WHILE i < nstrings AND star[i].offset = nextnewcode DO
nw ← StringDefs.WordsForString[stb[star[i].sti].string.length];
nextnewcode ← nextnewcode + nw;
stb[star[i].sti].info ← nextnewframe;
nextnewframe ← nextnewframe+nw;
i ← i+1;
ENDLOOP;
stsize ← nextnewframe - framestart;
BLTStrings[firstnewcode, stsize, framestart, TRUE];
ENDLOOP;
IF nstrings # 0 THEN SystemDefs.FreeHeapNode[BASE[star]];
END;
BLTStrings: PROCEDURE [coffset, length, foffset: CARDINAL, local: BOOLEAN] =
BEGIN OPEN FOpCodes;
Stack.Dump[];
P5U.PushLitVal[coffset];
P5U.PushLitVal[length];
P5U.Out1[IF local THEN qLADRB ELSE qGADRB, foffset];
P5U.Out0[qBLTC];
END;
EndCodeFile: PUBLIC PROCEDURE RETURNS [nbytes: CARDINAL] =
BEGIN
OPEN SystemDefs, StreamDefs;
saveindex: StreamIndex;
[] ← MoveToCodeWord[];
MPtr.fgTable ← DESCRIPTOR[BASE[fgt], fgti+1];
MPtr.codeSeg.pages ← (codeIndex+(PageSize-1))/PageSize;
saveindex ← GetIndex[MPtr.objectStream];
SetIndex[MPtr.objectStream, entryBase];
[] ← WriteBlock[MPtr.objectStream,
BASE[entryVector],
LENGTH[entryVector]*SIZE[ControlDefs.EntryVectorItem]];
FreeSegment[BASE[entryVector]];
MPtr.mtRoot.framesize ← MPtr.objectFrameSize;
MPtr.mtRoot.code.length ← codeIndex*2;
MPtr.mtRoot.crossJumped ← MPtr.switches['j];
SetIndex[MPtr.objectStream, saveindex];
RETURN [codeIndex*2]
END;
END...