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],
FOpCodes: TYPE USING [qBLTC, qLCO, qGADRB, qLADRB],
IO: TYPE USING [GetIndex, SetIndex, STREAM, UnsafePutBlock],
Literals: TYPE USING [Base, MSTIndex, STIndex, stType],
LiteralOps: TYPE USING [EnumerateLocalStrings, EnumerateMasterStrings],
Log: TYPE USING [ErrorTree],
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, wordsPerPage, zJIB, zJIW],
PrincOpsUtils: TYPE USING [BITOR, BITSHIFT],
Stack: TYPE USING [Dump],
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,
IO,
LiteralOps, Log, OSMiscOps, P5, P5U, PrincOpsUtils, Stack, SymbolOps
EXPORTS CodeDefs, P5 =
BEGIN
OPEN CodeDefs;
imported definitions
PageSize: CARDINAL = PrincOps.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 = INT; -- FileStream.FileByteIndex
fgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry;
fgti: INTEGER;
fgtPages: CARDINAL;
objectStream: IO.STREAM ← 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
PutWord[objectStream, mtRoot.code.offset];
THROUGH (1..mtRoot.code.offset] DO PutWord[objectStream, 0] ENDLOOP;
END;
codeBase ← IO.GetIndex[objectStream];
objectStream.UnsafePutBlock[[@prefix, 0, 2*CSegPrefix.SIZE]];
entryBase ← IO.GetIndex[objectStream];
codeIndex ← CSegPrefix.SIZE+nBodies*EntryVectorItem.SIZE;
parity ← even;
IO.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;
PutWord[objectStream, 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];
PutWord[objectStream, w];
codeIndex ← codeIndex+1;
END;
WriteCodeByte:
PROC [b: Byte] =
BEGIN
IF parity = odd
THEN
BEGIN
buffer.oddbyte ← b;
PutWord[objectStream, LOOPHOLE[buffer, WORD]];
parity ← even; codeIndex ← codeIndex+1;
END
ELSE {buffer.evenbyte ← b; parity ← odd};
END;
PutWord:
PROC[stream:
IO.
STREAM, word:
UNSPECIFIED] =
INLINE
BEGIN
stream.UnsafePutBlock[[@word, 0, 1]];
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 PrincOpsUtils;
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 PrincOps.zJIB ELSE PrincOps.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.UnsafePutBlock[[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 ← IO.GetIndex[objectStream];
IO.SetIndex[objectStream, entryBase];
objectStream.UnsafePutBlock[[
entryVector.BASE,
0, 2*entryVector.LENGTH*PrincOps.EntryVectorItem.SIZE]];
OSMiscOps.FreeWords[entryVector.BASE];
MPtr.mtRoot.framesize ← MPtr.globalFrameSize;
MPtr.mtRoot.code.length ← codeIndex*2;
IO.SetIndex[objectStream, saveindex];
CompilerUtil.ReleaseStream[object]; objectStream ← NIL;
RETURN [codeIndex*2]
END;
END.