DIRECTORY
Alloc USING [Notifier],
Basics USING [BITOR, BITSHIFT, charsPerWord, RawBytes],
BcdDefs USING [PageSize],
Code USING [bodyStartLoc, codeptr],
CodeDefs USING [Base, Byte, CCIndex, CCItem, CCNull, codeType, LabelCCIndex],
ComData USING [codeSeg, fgTable, globalFrameSize, linkCount, mtRoot, nBodies, nSigCodes, stopping],
CompilerUtil USING [AcquireStream, NextFilePage, ReleaseStream],
FOpCodes USING [qBLTC, qLCO, qGADRB, qLADRB],
IO USING [GetIndex, SetIndex, GetLength, SetLength, STREAM, UnsafePutBlock],
Literals USING [Base, MSTIndex, STIndex, stType],
LiteralOps USING [EnumerateLocalStrings, EnumerateMasterStrings],
Log USING [ErrorTree],
OSMiscOps USING [FreePages, FreeWords, Pages, Words, pageSize],
P5 USING [C1W, P5Error],
P5U USING [FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, RecordConstant, WordsForSei, WordsForString],
PrincOps USING [AllocationVectorSize, CSegPrefix, EPRange, EntryVectorItem, InstWord, MaxFrameSize, MaxNGfi, MaxNLinks, PrefixHeader, zJIB, zJIW],
SourceMap USING [Loc, nullLoc, Incr, Up, Val],
Stack USING [Dump],
Symbols USING [Base, BodyInfo, bodyType, CBTIndex, RootBti],
SymbolOps USING [TransferTypes],
SymbolSegment USING [FGTEntry, ObjectStep, SourceStep, Stride],
Table USING [IPointer];
OutCode:
PROGRAM
IMPORTS Basics, MPtr: ComData, CPtr: Code, CompilerUtil, IO, LiteralOps, Log, OSMiscOps, P5, P5U, SourceMap, Stack, SymbolOps
EXPORTS CodeDefs, P5 = { OPEN CodeDefs;
imported definitions
PageSize: CARDINAL = OSMiscOps.pageSize;
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 = {
called by allocator whenever table area is repacked
cb ← base[codeType];
bb ← base[Symbols.bodyType];
stb ← base[Literals.stType];
};
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: CARDINAL;
lastSource: INT;
StartCodeFile:
PUBLIC
PROC = {
called to set up bodytable and init binary file header
OPEN MPtr;
prefix: PrincOps.PrefixHeader --CSegPrefix--;
nGfi: CARDINAL = (MAX[nBodies, nSigCodes] + (PrincOps.EPRange-1))/PrincOps.EPRange;
IF ~(nGfi IN [1..PrincOps.MaxNGfi]) THEN P5.P5Error[833];
IF linkCount > PrincOps.MaxNLinks THEN P5.P5Error[834];
objectStream ← CompilerUtil.AcquireStream[object];
prefix.--header.--swapinfo ← 0;
prefix.
--header.--info
← [stops: MPtr.stopping, fill: 0, altoCode: FALSE, ngfi: nGfi, nlinks: linkCount];
codeSeg.base ← CompilerUtil.NextFilePage[];
fgti ← -1; fgtPages ← 1;
IF mtRoot.code.offset # 0
THEN {
PutWord[objectStream, mtRoot.code.offset];
THROUGH (1..mtRoot.code.offset] DO PutWord[objectStream, 0] ENDLOOP;
};
codeBase ← objectStream.GetIndex[];
IO.UnsafePutBlock[objectStream, [LOOPHOLE[(@prefix).LONG, LONG POINTER TO Basics.RawBytes], 0, Basics.charsPerWord*PrincOps.PrefixHeader.SIZE]];
entryBase ← objectStream.GetIndex[];
codeIndex ← PrincOps.PrefixHeader.SIZE+nBodies*PrincOps.EntryVectorItem.SIZE;
parity ← even;
IF objectStream.GetLength[] < codeBase + 2*codeIndex
THEN objectStream.SetLength[codeBase + 2*codeIndex];
objectStream.SetIndex[codeBase + 2*codeIndex];
fgt ← DESCRIPTOR[OSMiscOps.Pages[fgtPages], (fgtPages*PageSize)/FGTEntry.SIZE];
entryVector ←
DESCRIPTOR[
OSMiscOps.Words[nBodies*PrincOps.EntryVectorItem.SIZE], nBodies];
};
MoveToCodeWord:
PUBLIC
PROC
RETURNS [
CARDINAL] = {
IF parity = odd
THEN {
buffer.oddbyte ← 377B;
PutWord[objectStream, LOOPHOLE[buffer, WORD]];
parity ← even; codeIndex ← codeIndex+1;
};
RETURN [codeIndex]
};
WriteCodeWord:
PUBLIC
PROC [w:
WORD] = {
IF parity # even THEN P5.P5Error[835];
PutWord[objectStream, w];
codeIndex ← codeIndex+1;
};
WriteCodeByte:
PROC [b: Byte] = {
IF parity = odd
THEN{
buffer.oddbyte ← b;
PutWord[objectStream, LOOPHOLE[buffer, WORD]];
parity ← even; codeIndex ← codeIndex+1;
}
ELSE {buffer.evenbyte ← b; parity ← odd};
};
PutWord:
PROC[stream:
IO.
STREAM, word:
UNSPECIFIED] =
INLINE {
IO.UnsafePutBlock[stream, [LOOPHOLE[(@word).LONG, LONG POINTER TO Basics.RawBytes], 0, 2]];
};
NewFgtEntry:
PROC [source:
INT, object:
CARDINAL] = {
enters new value into fgt
AddEntry:
PROC [e: SymbolSegment.FGTEntry] = {
IF (fgti ← fgti+1) >= fgt.
LENGTH
THEN {
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];
};
fgt[fgti] ← e;
};
t: CARDINAL;
dSource: INT ← 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;
};
OutBinary:
PUBLIC
PROC [bti: CBTIndex, start: LabelCCIndex] = {
outputs binary bytes for body bti starting at start
c, cj, nextC: CCIndex;
offset, e, fs, nw: CARDINAL;
byteTable, even: BOOL;
leftByte: WORD;
bodyOrigin: INT;
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 => {
OPEN Basics;
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 {
jBytes is surprisingly correct for both forward and backward jumps.
jBytes: WORD ← LOOPHOLE[cb[destlabel].pc - pc + 3, WORD];
IF byteTable
THEN {
IF even
THEN leftByte ← BITSHIFT[jBytes, 8]
ELSE WriteCodeWord[BITOR[leftByte, jBytes]];
even ← ~even;
}
ELSE WriteCodeWord[jBytes];
}
ELSE EXIT;
ENDCASE => EXIT;
ENDLOOP;
IF byteTable AND ~even THEN WriteCodeWord[BITOR[leftByte,377B]];
bodyStart ← codeIndex;
};
ENDCASE;
ENDCASE;
ENDLOOP;
e ← bb[bti].entryIndex;
bodyOrigin ← SourceMap.Up[bb[bti].sourceIndex].Val[];
lastSource ← MIN[bodyOrigin, CARDINAL.LAST];
bb[bti].sourceIndex ← CARDINAL[lastSource];
WITH bi: bb[bti].info
SELECT
FROM
Internal => {
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;
};
ENDCASE => P5.P5Error[836];
bb[bti].info ← BodyInfo[External[bytes: , startIndex: fgti+1, indexLength: ]];
NewFgtEntry[source: bodyOrigin, object: lastObject];
entryVector[e].info.nparams ←
P5U.WordsForSei[SymbolOps.TransferTypes[bb[bti].ioType].typeIn];
entryVector[e].info.defaults ← FALSE;
entryVector[e].initialpc ← [bodyStart]; -- currently a WordPC
FOR c ← start, nextC
UNTIL c = CCNull
DO
WITH cc:cb[c]
SELECT
FROM
code => {
IF ~cc.realinst THEN ERROR;
SELECT cc.isize
FROM
0 => IF cc.realinst THEN ERROR;
1 => {
WriteCodeByte[cc.inst];
};
2 => {
WriteCodeByte[cc.inst];
WriteCodeByte[cc.parameters[1]];
};
3 => {
WriteCodeByte[cc.inst];
WriteCodeByte[cc.parameters[1]];
WriteCodeByte[cc.parameters[2]];
};
ENDCASE => {
only from MACHINE CODE inlines
WriteCodeByte[cc.inst];
FOR i:
CARDINAL
IN [1..cc.isize)
DO
WriteCodeByte[cc.parameters[i]];
ENDLOOP;
};
offset ← offset+cc.isize;
};
other =>
WITH cc
SELECT
FROM
table => {
CPtr.codeptr ← c;
P5.C1W[IF btab THEN PrincOps.zJIB ELSE PrincOps.zJIW, taboffset];
};
markbody =>
IF start
THEN {
immediately prior chunk was source
bb[index].sourceIndex ← MIN[SourceMap.Up[bb[index].sourceIndex].Val[], CARDINAL.LAST];
bb[index].info ← BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
WITH br: bb[index]
SELECT
FROM
Other => br.relOffset ← offset - bodyStart*2;
ENDCASE => ERROR;
}
ELSE {
WITH bi: bb[index].info
SELECT
FROM
External => {
bi.indexLength ← fgti-bi.startIndex+1;
WITH br: bb[index]
SELECT
FROM
Other => bi.bytes ← offset - br.relOffset - bodyStart*2;
ENDCASE => ERROR;
};
ENDCASE;
};
absSource =>
IF loc # SourceMap.nullLoc
THEN {
index: INT = loc.Val[];
IF index > lastSource
OR (index = lastSource
AND offset # lastObject)
THEN
NewFgtEntry[index, offset];
};
relSource => {
index: INT = CPtr.bodyStartLoc.Incr[relLoc].Val[];
IF index > lastSource
OR (index = lastSource
AND offset # lastObject)
THEN
NewFgtEntry[index, offset];
};
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;
};
ByteableJumps:
PROC [j: CCIndex]
RETURNS [
BOOL] = {
DO
WITH cb[j]
SELECT
FROM
jump =>
IF jtype = JumpC
THEN {
jBytes: INTEGER = cb[destlabel].pc - pc + 3;
IF ~forward OR jBytes > Byte.LAST THEN RETURN [FALSE];
j ← cb[j].flink;
}
ELSE EXIT;
ENDCASE => EXIT
ENDLOOP;
RETURN [TRUE];
};
WriteCodeString:
PROC [s: Table.IPointer, nw:
CARDINAL] = {
objectStream.UnsafePutBlock[[s, 0, 2*nw]];
};
ProcessGlobalStrings:
PUBLIC
PROC [framestart:
CARDINAL]
RETURNS [nextnewframe:
CARDINAL] = {
firstNewCode, nextNewCode: CARDINAL ← MoveToCodeWord[];
stSize, litSize: CARDINAL;
DoString:
PROC [msti: MSTIndex] = {
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;
};
nextnewframe ← framestart;
LiteralOps.EnumerateMasterStrings[DoString];
litSize ← nextNewCode - firstNewCode; stSize ← nextnewframe - framestart;
IF litSize > 0
THEN {
P5U.RecordConstant[firstNewCode, litSize];
IF stSize > 0 THEN BLTStrings[firstNewCode, stSize, framestart, FALSE];
};
};
ProcessLocalStrings:
PUBLIC
PROC [framestart:
CARDINAL, first: STIndex]
RETURNS [nextnewframe:
CARDINAL] = {
nStrings: CARDINAL ← 0;
CountStrings:
PROC [msti: MSTIndex] = {
IF stb[msti].local AND stb[msti].codeIndex # 0 THEN nStrings ← nStrings+1;
};
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] = {
IF stb[msti].local
THEN {
co: CARDINAL = stb[msti].codeIndex;
IF co # 0
THEN {
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;
}
ELSE {
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;
};
};
}; -- 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 {
BLTStrings[firstNewCode, stSize, framestart, TRUE];
P5U.RecordConstant[firstNewCode, stSize];
};
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];
};
BLTStrings:
PROC [coffset, length, foffset:
CARDINAL, local:
BOOL] = {
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];
};
EndCodeFile:
PUBLIC
PROC
RETURNS [nbytes:
CARDINAL] = {
saveindex: StreamIndex;
[] ← MoveToCodeWord[];
MPtr.fgTable ← DESCRIPTOR[fgt.BASE, fgti+1];
MPtr.codeSeg.pages ←
((codeIndex + MPtr.mtRoot.code.offset)+(BcdDefs.PageSize-1))/BcdDefs.PageSize;
saveindex ← objectStream.GetIndex[];
objectStream.SetIndex[entryBase];
objectStream.UnsafePutBlock[[
LOOPHOLE[entryVector.BASE, LONG POINTER TO Basics.RawBytes],
0, Basics.charsPerWord*entryVector.LENGTH*PrincOps.EntryVectorItem.SIZE]];
OSMiscOps.FreeWords[entryVector.BASE];
MPtr.mtRoot.framesize ← MPtr.globalFrameSize;
MPtr.mtRoot.code.length ← codeIndex*2;
objectStream.SetIndex[saveindex];
CompilerUtil.ReleaseStream[object]; objectStream ← NIL;
RETURN [codeIndex*2]
};
}.