-- file OutCode.mesa
-- last modified by Sweet, July 24, 1980 11:04 AM
-- last modified by Satterthwaite, January 10, 1983 10:52 am
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [bodyFileIndex, codeptr],
CodeDefs: TYPE USING [
Base, Byte, CCIndex, CCItem, CCNull, codeType, LabelCCIndex, NULLfileindex],
ComData: TYPE USING [
codeSeg, fgTable, globalFrameSize, linkCount, mtRoot,
nBodies, nSigCodes, stopping],
CompilerUtil: TYPE USING [AcquireStream, NextFilePage, ReleaseStream],
Environment: TYPE USING [wordsPerPage],
FileStream: TYPE USING [FileByteIndex, GetIndex, SetIndex],
FOpCodes: TYPE USING [qBLTC, qLCO, qGADRB, qLADRB],
Inline: TYPE USING [BITOR, BITSHIFT],
Literals: TYPE USING [Base, MSTIndex, STIndex, stType],
LiteralOps: TYPE USING [EnumerateLocalStrings, EnumerateMasterStrings],
Log: TYPE USING [ErrorTree],
Mopcodes: TYPE USING [zJIB, zJIW],
OSMiscOps: TYPE USING [FreePages, FreeWords, Pages, Words],
P5: TYPE USING [C1W, P5Error],
P5U: TYPE USING [
FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, RecordConstant,
WordsForSei, WordsForString],
PrincOps: TYPE USING [
AllocationVectorSize, CSegPrefix, EPRange, EntryVectorItem, InstWord,
MaxFrameSize, MaxNLinks],
Stack: TYPE USING [Dump],
Stream: TYPE USING [Handle, PutBlock, PutWord],
Symbols: TYPE USING [Base, BodyInfo, bodyType, CBTIndex, RootBti],
SymbolOps: TYPE USING [TransferTypes],
SymbolSegment: TYPE USING [FGTEntry, ObjectStep, SourceStep, Stride],
Table: TYPE USING [IPointer];
OutCode: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, CompilerUtil, FileStream, Inline,
LiteralOps, Log, OSMiscOps, P5, P5U, Stack, Stream, SymbolOps
EXPORTS CodeDefs, P5 =
BEGIN
OPEN CodeDefs;
-- imported definitions
PageSize: CARDINAL = Environment.wordsPerPage;
BodyInfo: TYPE = Symbols.BodyInfo;
CBTIndex: TYPE = Symbols.CBTIndex;
FGTEntry: TYPE = SymbolSegment.FGTEntry;
STIndex: TYPE = Literals.STIndex;
MSTIndex: TYPE = Literals.MSTIndex;
cb: CodeDefs.Base; -- code base (local copy)
bb: Symbols.Base;
stb: Literals.Base;
OutCodeNotify: PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
cb ← base[codeType];
bb ← base[Symbols.bodyType];
stb ← base[Literals.stType];
END;
FileSequenceError: SIGNAL = CODE;
StreamIndex: TYPE = FileStream.FileByteIndex;
fgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry;
fgti: INTEGER;
fgtPages: CARDINAL;
objectStream: Stream.Handle ← NIL;
codeBase, entryBase: StreamIndex;
entryVector: LONG DESCRIPTOR FOR ARRAY OF PrincOps.EntryVectorItem;
parity: {even, odd};
codeIndex: CARDINAL;
buffer: PrincOps.InstWord;
lastObject, lastSource: CARDINAL;
StartCodeFile: PUBLIC PROC =
BEGIN -- called to set up bodytable and init binary file header
OPEN MPtr, PrincOps;
prefix: CSegPrefix;
nGfi: CARDINAL = (MAX[nBodies, nSigCodes] + (PrincOps.EPRange-1))/PrincOps.EPRange;
IF ~(nGfi IN [1..4]) THEN P5.P5Error[833];
IF linkCount > PrincOps.MaxNLinks THEN P5.P5Error[834];
objectStream ← CompilerUtil.AcquireStream[object];
prefix ← [header: [
swapinfo: 0,
info: [stops: MPtr.stopping, fill: 0, altoCode: FALSE,
ngfi: nGfi, nlinks: linkCount]],
entry: ];
codeSeg.base ← CompilerUtil.NextFilePage[];
fgti ← -1; fgtPages ← 1;
IF mtRoot.code.offset # 0 THEN
BEGIN
objectStream.PutWord[mtRoot.code.offset];
THROUGH (1..mtRoot.code.offset] DO objectStream.PutWord[0] ENDLOOP;
END;
codeBase ← FileStream.GetIndex[objectStream];
objectStream.PutBlock[[@prefix, 0, 2*CSegPrefix.SIZE]];
entryBase ← FileStream.GetIndex[objectStream];
codeIndex ← CSegPrefix.SIZE+nBodies*EntryVectorItem.SIZE;
parity ← even;
FileStream.SetIndex[objectStream, codeBase + 2*codeIndex];
fgt ← DESCRIPTOR[OSMiscOps.Pages[fgtPages], (fgtPages*PageSize)/FGTEntry.SIZE];
entryVector ← DESCRIPTOR[OSMiscOps.Words[nBodies*EntryVectorItem.SIZE], nBodies];
END;
MoveToCodeWord: PUBLIC PROC RETURNS [CARDINAL] =
BEGIN
IF parity = odd THEN
BEGIN
buffer.oddbyte ← 377B;
objectStream.PutWord[LOOPHOLE[buffer, WORD]];
parity ← even; codeIndex ← codeIndex+1;
END;
RETURN [codeIndex]
END;
WriteCodeWord: PUBLIC PROC [w: WORD] =
BEGIN
IF parity # even THEN P5.P5Error[835];
objectStream.PutWord[w];
codeIndex ← codeIndex+1;
END;
WriteCodeByte: PROC [b: Byte] =
BEGIN
IF parity = odd THEN
BEGIN
buffer.oddbyte ← b;
objectStream.PutWord[LOOPHOLE[buffer, WORD]];
parity ← even; codeIndex ← codeIndex+1;
END
ELSE {buffer.evenbyte ← b; parity ← odd};
END;
NewFgtEntry: PROC [source, object: CARDINAL] =
BEGIN -- enters new value into fgt
AddEntry: PROC [e: SymbolSegment.FGTEntry] =
BEGIN
IF (fgti ← fgti+1) >= fgt.LENGTH THEN
BEGIN
oldfgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry ← fgt;
fgtPages ← fgtPages+1;
fgt ← DESCRIPTOR[
OSMiscOps.Pages[fgtPages],
(fgtPages*PageSize)/FGTEntry.SIZE];
FOR i: CARDINAL IN [0..oldfgt.LENGTH) DO fgt[i] ← oldfgt[i] ENDLOOP;
OSMiscOps.FreePages[oldfgt.BASE];
END;
fgt[fgti] ← e;
END;
t: CARDINAL;
dSource: CARDINAL ← source - lastSource;
dObject: CARDINAL ← object - lastObject;
WHILE dSource > SymbolSegment.SourceStep DO
t ← MIN[dSource, SymbolSegment.Stride];
AddEntry[[step[which: source, delta: t]]];
dSource ← dSource - t;
ENDLOOP;
WHILE dObject > SymbolSegment.ObjectStep DO
t ← MIN[dObject, SymbolSegment.Stride];
AddEntry[[step[which: object, delta: t]]];
dObject ← dObject - t;
ENDLOOP;
AddEntry[[normal[deltaObject: dObject, deltaSource: dSource]]];
lastSource ← source; lastObject ← object;
END;
OutBinary: PUBLIC PROC [bti: CBTIndex, start: LabelCCIndex] =
BEGIN -- outputs binary bytes for body bti starting at start
c, cj, nextC: CCIndex;
offset, e, fs, nw: CARDINAL;
byteTable, even: BOOL;
leftByte: WORD;
bodyStart: CARDINAL ← 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;
other => WITH cc SELECT FROM
table =>
BEGIN
OPEN Inline;
offset ← offset + tablecodebytes;
taboffset ← bodyStart;
byteTable ← btab ← 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 + 3;
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;
lastSource ← bb[bti].sourceIndex;
WITH bi: bb[bti].info SELECT FROM
Internal =>
BEGIN
IF bti = Symbols.RootBti THEN
{WriteCodeWord[MPtr.globalFrameSize]; bodyStart ← bodyStart+1};
fs ← P5U.ComputeFrameSize[bi.frameSize];
IF bb[bti].resident THEN fs ← fs+PrincOps.AllocationVectorSize;
offset ← lastObject ← bodyStart*2;
entryVector[e].info.framesize ← fs;
END;
ENDCASE => P5.P5Error[836];
NewFgtEntry[source: lastSource, object: lastObject]; -- put out [0,0]
entryVector[e].info.nparams ←
P5U.WordsForSei[SymbolOps.TransferTypes[bb[bti].ioType].typeIn];
entryVector[e].info.defaults ← FALSE;
entryVector[e].initialpc ← [bodyStart]; -- currently a WordPC
bb[bti].info ← BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
FOR c ← start, nextC UNTIL c = CCNull DO
WITH cc:cb[c] SELECT FROM
code =>
BEGIN
IF ~cc.realinst THEN ERROR;
SELECT cc.isize FROM
0 => IF cc.realinst THEN ERROR;
1 =>
BEGIN
WriteCodeByte[cc.inst];
END;
2 =>
BEGIN
WriteCodeByte[cc.inst];
WriteCodeByte[cc.parameters[1]];
END;
3 =>
BEGIN
WriteCodeByte[cc.inst];
WriteCodeByte[cc.parameters[1]]; WriteCodeByte[cc.parameters[2]];
END;
ENDCASE => -- only from MACHINE CODE inlines
BEGIN
WriteCodeByte[cc.inst];
FOR i: CARDINAL IN [1..cc.isize) DO WriteCodeByte[cc.parameters[i]] ENDLOOP;
END;
offset ← offset+cc.isize;
END;
other => WITH cc SELECT FROM
table =>
BEGIN
CPtr.codeptr ← c;
P5.C1W[IF btab THEN Mopcodes.zJIB ELSE Mopcodes.zJIW, taboffset];
END;
markbody =>
IF start THEN
BEGIN -- immediately prior chunk was source
bb[index].info ← BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
WITH br: bb[index] SELECT FROM
Other => br.relOffset ← offset - bodyStart*2;
ENDCASE => ERROR;
END
ELSE
BEGIN
WITH bi: bb[index].info SELECT FROM
External =>
BEGIN
bi.indexLength ← fgti-bi.startIndex+1;
WITH br: bb[index] SELECT FROM
Other => bi.bytes ← offset - br.relOffset - bodyStart*2;
ENDCASE => ERROR;
END;
ENDCASE;
END;
absSource => IF index # NULLfileindex THEN
BEGIN
IF index > lastSource OR
(index = lastSource AND offset # lastObject) THEN NewFgtEntry[index, offset];
END;
relSource =>
BEGIN
index: CARDINAL = CPtr.bodyFileIndex + relIndex;
IF index > lastSource OR
(index = lastSource AND offset # lastObject) THEN NewFgtEntry[index, offset];
END;
ENDCASE;
ENDCASE;
nextC ← cb[c].flink;
nw ← WITH cc: cb[c] SELECT FROM
code => MAX[cc.isize, 1]-1+CCItem.code.SIZE,
label => CCItem.label.SIZE,
jump => CCItem.jump.SIZE,
other => WITH cc SELECT FROM
absSource => CCItem.other.absSource.SIZE,
relSource => CCItem.other.relSource.SIZE,
ENDCASE => CCItem.other.SIZE, -- NB: see CCellAllocate
ENDCASE => ERROR;
P5U.FreeChunk[c, nw];
WITH bb[bti].info SELECT FROM
External => {indexLength ← fgti-startIndex+1; bytes ← offset - (bodyStart*2)};
ENDCASE;
ENDLOOP;
END;
ByteableJumps: PROC [j: CCIndex] RETURNS [BOOL] =
BEGIN
DO
WITH cb[j] SELECT FROM
jump =>
IF jtype = JumpC THEN
BEGIN
jBytes: INTEGER = cb[destlabel].pc - pc + 3;
IF ~forward OR jBytes > Byte.LAST THEN RETURN [FALSE];
j ← cb[j].flink;
END
ELSE RETURN [TRUE];
ENDCASE => RETURN [TRUE]
ENDLOOP
END;
WriteCodeString: PROC [s: Table.IPointer, nw: CARDINAL] =
BEGIN
objectStream.PutBlock[[s, 0, 2*nw]];
END;
ProcessGlobalStrings: PUBLIC PROC [framestart: CARDINAL]
RETURNS [nextnewframe: CARDINAL] =
BEGIN
firstNewCode, nextNewCode: CARDINAL ← MoveToCodeWord[];
stSize, litSize: CARDINAL;
DoString: PROC [msti: MSTIndex] =
BEGIN
nw: CARDINAL;
IF stb[msti].info = 0 THEN {stb[msti].local ← TRUE; RETURN};
nw ← P5U.WordsForString[stb[msti].string.length];
stb[msti].info ← nextnewframe;
nextnewframe ← nextnewframe+nw;
IF nextnewframe > PrincOps.MaxFrameSize THEN
Log.ErrorTree[addressOverflow, [literal[[string[msti]]]]];
stb[msti].codeIndex ← nextNewCode;
nextNewCode ← nextNewCode + nw;
WriteCodeString[@stb[msti].string, nw];
codeIndex ← codeIndex+nw;
END; -- of doglobal
nextnewframe ← framestart;
LiteralOps.EnumerateMasterStrings[DoString];
litSize ← nextNewCode - firstNewCode; stSize ← nextnewframe - framestart;
IF litSize > 0 THEN
BEGIN
P5U.RecordConstant[firstNewCode, litSize];
IF stSize > 0 THEN
BEGIN
BLTStrings[firstNewCode, stSize, framestart, FALSE];
END;
END;
END;
ProcessLocalStrings: PUBLIC PROC [framestart: CARDINAL, first: STIndex]
RETURNS [nextnewframe: CARDINAL] =
BEGIN
nStrings: CARDINAL ← 0;
CountStrings: PROC [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: LONG DESCRIPTOR FOR ARRAY OF StringInfo;
InsertStrings: PROC [msti: MSTIndex] =
BEGIN
IF stb[msti].local THEN
BEGIN
co: CARDINAL = 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: CARDINAL = P5U.WordsForString[stb[msti].string.length];
stb[msti].info ← nextnewframe;
nextnewframe ← nextnewframe+nw;
IF nextnewframe > PrincOps.MaxFrameSize THEN
Log.ErrorTree[addressOverflow, [literal[[string[msti]]]]];
stb[msti].codeIndex ← nextNewCode;
nextNewCode ← nextNewCode + nw;
WriteCodeString[@stb[msti].string, nw];
codeIndex ← codeIndex+nw;
END;
END;
END; -- of InsertStrings
nextnewframe ← framestart;
LiteralOps.EnumerateLocalStrings[first, CountStrings];
IF nStrings # 0 THEN
star ← DESCRIPTOR[OSMiscOps.Words[nStrings*StringInfo.SIZE], nStrings];
LiteralOps.EnumerateLocalStrings[first, InsertStrings];
stSize ← nextnewframe - framestart;
IF stSize > 0 THEN
BEGIN
BLTStrings[firstNewCode, stSize, framestart, TRUE];
P5U.RecordConstant[firstNewCode, stSize];
END;
i ← 0;
WHILE i < nStrings DO
framestart ← nextnewframe;
nextNewCode ← firstNewCode ← star[i].offset;
WHILE i < nStrings AND star[i].offset = nextNewCode DO
nw ← P5U.WordsForString[stb[star[i].sti].string.length];
nextNewCode ← nextNewCode + nw;
stb[star[i].sti].info ← nextnewframe;
nextnewframe ← nextnewframe+nw;
IF nextnewframe > PrincOps.MaxFrameSize THEN
Log.ErrorTree[addressOverflow, [literal[[string[star[i].sti]]]]];
i ← i+1;
ENDLOOP;
stSize ← nextnewframe - framestart;
BLTStrings[firstNewCode, stSize, framestart, TRUE];
ENDLOOP;
IF nStrings # 0 THEN OSMiscOps.FreeWords[star.BASE];
END;
BLTStrings: PROC [coffset, length, foffset: CARDINAL, local: BOOL] =
BEGIN OPEN FOpCodes;
Stack.Dump[]; -- though I don't see how it could be non-empty now
P5U.Out1[qLCO, coffset];
P5U.PushLitVal[length];
P5U.Out1[IF local THEN qLADRB ELSE qGADRB, foffset];
P5U.Out0[qBLTC];
END;
EndCodeFile: PUBLIC PROC RETURNS [nbytes: CARDINAL] =
BEGIN
saveindex: StreamIndex;
[] ← MoveToCodeWord[];
MPtr.fgTable ← DESCRIPTOR[fgt.BASE, fgti+1];
MPtr.codeSeg.pages ← ((codeIndex + MPtr.mtRoot.code.offset)+(PageSize-1))/PageSize;
saveindex ← FileStream.GetIndex[objectStream];
FileStream.SetIndex[objectStream, entryBase];
objectStream.PutBlock[[
entryVector.BASE,
0, 2*entryVector.LENGTH*PrincOps.EntryVectorItem.SIZE]];
OSMiscOps.FreeWords[entryVector.BASE];
MPtr.mtRoot.framesize ← MPtr.globalFrameSize;
MPtr.mtRoot.code.length ← codeIndex*2;
FileStream.SetIndex[objectStream, saveindex];
CompilerUtil.ReleaseStream[object]; objectStream ← NIL;
RETURN [codeIndex*2]
END;
END.