
<<file OutCode.mesa>>
<<last modified by Sweet, July 24, 1980  11:04 AM>>
<<last modified by Satterthwaite, January 10, 1983 10:52 am>>
<<Last Edited by: Maxwell, July 28, 1983 3:42 pm>>

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.