
<<file OutCode.mesa>>
<<last modified by Sweet, July 29, 1982 3:54 pm>>
<<last modified by Satterthwaite, March 20, 1986 10:23:28 am PST>>

DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [BytePair, bytesPerWord],
BcdDefs: TYPE USING [PageSize],
CatchFormat: TYPE USING [EnableItem],
Code: TYPE USING [codeptr, enableList],
CodeDefs: TYPE USING [
Base, BYTE, CCIndex, CCItem, CCNull, codeType, EINull, 
EnableIndex, LabelCCIndex, TableCodeBytes],
ComData: TYPE USING [
catchBytes, catchIndex, codeByteOffsetList, codeOffsetList, 
codeSeg, fgTable, globalFrameSize, jumpIndirectList,
linkCount, mtRoot, nBodies, nSigCodes, 
stopping, switches],
CompilerUtil: TYPE USING [AcquireStream, NextFilePage, ReleaseStream],
IO: TYPE USING [
UnsafeBlock, GetIndex, GetLength, PutChar, SetIndex, SetLength, STREAM, UnsafePutBlock],
Fixup: TYPE USING [JIHandle, JIRec, PCHandle, PCRec],
FOpCodes: TYPE USING [qBLTC, qLCO, qGA, qLA],
Literals: TYPE USING [Base, MSTIndex, STIndex, stType],
LiteralOps: TYPE USING [EnumerateLocalStrings, EnumerateMasterStrings],
Log: TYPE USING [ErrorTree],
OSMiscOps: TYPE USING [FreePages, FreeWords, Pages, Words, pageSize],
P5: TYPE USING [C1W, P5Error],
P5U: TYPE USING [
FreeChunk, Out0, Out1, ComputeFrameSize, PushLitVal, RecordConstant,
WordsForString],
PrincOps: TYPE USING [
bytesPerPage, wordsPerPage,
AVHeapSize, BytePC, CSegPrefix, EntryVectorItem, EPRange, GlobalOverhead,
MaxFrameSize, PrefixHeader,
zJIB, zJIW, zLIW],
SourceMap: TYPE USING [Loc, nullLoc, Incr, Up, Val],
Stack: TYPE USING [Dump],
Symbols: TYPE USING [Base, BodyInfo, bodyType, CBTIndex, RootBti],
SymbolSegment: TYPE USING [FGTEntry, ObjectStep, SourceStep, Stride];

OutCode: PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, CompilerUtil, IO, LiteralOps, Log,
OSMiscOps, P5, P5U, SourceMap, Stack 
EXPORTS CodeDefs, P5 =
BEGIN
OPEN CodeDefs;

<<imported definitions>>

Address: TYPE = CARDINAL;
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 =
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;

PutBlock: PROC [stream: IO.STREAM, base: LONG POINTER, nw: CARDINAL] = {
stream.UnsafePutBlock[[base: base, startIndex: 0, count: nw*Basics.bytesPerWord]]};

PutByte: PROC[stream: IO.STREAM, b: BYTE] = INLINE {
stream.PutChar[VAL[b]]};

PutWord: PROC[stream: IO.STREAM, w: WORD] = {
pair: Basics.BytePair = LOOPHOLE[w];
PutByte[stream, pair.high];  PutByte[stream, pair.low]};    -- order is machine dependent

fgt: LONG DESCRIPTOR FOR ARRAY OF FGTEntry;
fgti: INTEGER;
fgtPages: CARDINAL;

LabelPcInfo: TYPE = RECORD [label: LabelCCIndex, pc: Address];
LabelPcSeq: TYPE = RECORD [
count: NAT, 
data: SEQUENCE max: [0 .. NAT.LAST/LabelPcInfo.SIZE) OF LabelPcInfo];
LabelPcList: TYPE = REF LabelPcSeq;
labelPcList: LabelPcList _ NIL;

SetLabelPc: PROC [label: LabelCCIndex, pc: Address] =
BEGIN
count: NAT _ IF labelPcList = NIL THEN 0 ELSE labelPcList.count;
FOR i: NAT IN [0..count) DO
IF labelPcList[i].label = label THEN {labelPcList[i].pc _ pc; RETURN};
ENDLOOP;
IF labelPcList = NIL OR count = labelPcList.max THEN {
new: LabelPcList _ --MPtr.zone.--NEW[LabelPcSeq[count+20] _ 
[count: count, data:]];
FOR j: NAT IN [0..count) DO new[j] _ labelPcList[j] ENDLOOP;
IF labelPcList # NIL THEN --MPtr.zone.--FREE[@labelPcList];
labelPcList _ new};
labelPcList[count] _ [label: label, pc: pc];
labelPcList.count _ count+1;
END;

GetLabelPc: PROC [label: LabelCCIndex] RETURNS [Address] =
BEGIN
IF labelPcList = NIL THEN ERROR;
FOR i: NAT IN [0..labelPcList.count) DO
IF labelPcList[i].label = label THEN RETURN [labelPcList[i].pc];
ENDLOOP;
ERROR;
END;

objectStream: IO.STREAM _ NIL;
codeBase: StreamIndex;
entryVector: LONG DESCRIPTOR FOR ARRAY OF PrincOps.EntryVectorItem;

catchEntry: LONG DESCRIPTOR FOR ARRAY OF PrincOps.BytePC;

codeByteIndex: CARDINAL;

lastSource: INT;
lastObject: CARDINAL;

StartCodeFile: PUBLIC PROC =
BEGIN -- called to set up bodytable and init binary file header
OPEN MPtr, PrincOps;
nGfi: CARDINAL = (MAX[nBodies, nSigCodes] + (PrincOps.EPRange-1))/PrincOps.EPRange;
IF ~(nGfi IN [1..4]) THEN P5.P5Error[833];
IF linkCount > 377B THEN P5.P5Error[834];
objectStream _ CompilerUtil.AcquireStream[object];
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 _ objectStream.GetIndex[];
codeByteIndex _ (PrincOps.CSegPrefix[nBodies].SIZE+1*WORD.SIZE)*2;
    IF objectStream.GetLength[] < codeBase + codeByteIndex THEN
        objectStream.SetLength[codeBase + codeByteIndex];
objectStream.SetIndex[codeBase + codeByteIndex];
fgt _ DESCRIPTOR[OSMiscOps.Pages[fgtPages], (fgtPages*PageSize)/FGTEntry.SIZE];
entryVector _ DESCRIPTOR[
OSMiscOps.Words[nBodies*EntryVectorItem.SIZE], 
nBodies];
catchEntry _ DESCRIPTOR [
OSMiscOps.Words[MPtr.catchIndex*PrincOps.BytePC.SIZE], MPtr.catchIndex];
firstCatch _ lastCatch _ CCNull;
END;

MoveToCodeWord: PUBLIC PROC RETURNS [CARDINAL] = 
BEGIN
IF codeByteIndex MOD 2 = 1 THEN {
PutByte[objectStream, 377B]; codeByteIndex _ codeByteIndex+1};
RETURN [codeByteIndex/2]
END;


WriteCodeWord: PUBLIC PROC [w: WORD] =
BEGIN
pair: Basics.BytePair = LOOPHOLE[w];
IF codeByteIndex MOD 2 = 1 THEN P5.P5Error[835];
<<order is machine dependent>>
PutByte[objectStream, pair.high];  PutByte[objectStream, pair.low];
codeByteIndex _ codeByteIndex+2;
END;


WriteCodeByte: PROC [b: BYTE] = {
PutByte[objectStream, b]; codeByteIndex _ codeByteIndex+1};


NewFgtEntry: PROC [source: INT, 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: 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;
END;


OutJumpTables: PUBLIC PROC [start: CCIndex] RETURNS [bodyStart: Address] =
BEGIN -- outputs binary bytes starting at start
c, cj: CCIndex;
offset: CARDINAL;
byteTable: BOOL;
bodyStart _ codeByteIndex;
offset _ bodyStart;
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
offset _ offset + TableCodeBytes;
taboffset _ MoveToCodeWord[];
byteTable _ btab _ ByteableJumps[flink];
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;
jBytes _ jBytes+2;
IF byteTable THEN WriteCodeByte[jBytes]
ELSE WriteCodeWord[jBytes];
END
ELSE EXIT;
ENDCASE => EXIT;
ENDLOOP;
IF byteTable THEN [] _ MoveToCodeWord[];
bodyStart _ codeByteIndex;
END;
ENDCASE;
ENDCASE;
ENDLOOP;
END;


OutChunks: PUBLIC PROC [start: CCIndex] =
BEGIN -- outputs binary bytes for body bti starting at start
c, nextC: CCIndex;
offset, nw: CARDINAL;
bodyStart: Address _ codeByteIndex;
labelToKeep: BOOL;
offset _ bodyStart;
FOR c _ start, nextC UNTIL c = CCNull DO
labelToKeep _ FALSE;
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
IF cc.inst = PrincOps.zLIW AND cc.lco THEN {
new: Fixup.PCHandle = --MPtr.zone.--NEW [Fixup.PCRec _ [
pc: [offset], next: ]];
IF MPtr.codeOffsetList = NIL THEN new.next _ new
ELSE {
new.next _ MPtr.codeOffsetList.next;
MPtr.codeOffsetList.next _ new};
MPtr.codeOffsetList _ new;
fixupThisProc _ TRUE}; 
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;
label => IF cc.offsetLoaded THEN 
{SetLabelPc[label: LOOPHOLE[c], pc: offset]; labelToKeep _ TRUE};
jump => IF cc.jtype = JumpLIO THEN
BEGIN
val: RECORD [SELECT OVERLAID * FROM
card => [c: CARDINAL],
pair => [b1, b2: [0..256)],
ENDCASE];
new: Fixup.PCHandle = --MPtr.zone.--NEW [Fixup.PCRec _ [
pc: [offset], next: ]];
IF MPtr.codeByteOffsetList = NIL THEN new.next _ new 
ELSE {
new.next _ MPtr.codeByteOffsetList.next;
MPtr.codeByteOffsetList.next _ new};
MPtr.codeByteOffsetList _ new;
val.c _ GetLabelPc[cc.destlabel];
WriteCodeByte[PrincOps.zLIW];
WriteCodeByte[val.b1];
WriteCodeByte[val.b2];
offset _ offset + 3;
fixupThisProc _ TRUE;
END;
other => WITH cc SELECT FROM
table =>
BEGIN
new: Fixup.JIHandle = --MPtr.zone.--NEW [Fixup.JIRec _ [
pc: [offset], tableSize: tableSize, next: ]];
IF MPtr.jumpIndirectList = NIL THEN new.next _ new
ELSE {
new.next _ MPtr.jumpIndirectList.next;
MPtr.jumpIndirectList.next _ new};
MPtr.jumpIndirectList _ new;
CPtr.codeptr _ c;
P5.C1W[IF btab THEN PrincOps.zJIB ELSE PrincOps.zJIW, taboffset];
fixupThisProc _ TRUE;
END;
markbody =>
IF start THEN
BEGIN -- immediately prior chunk was source unless catch
WITH br: bb[index] SELECT FROM
Other => br.relOffset _ offset - bodyStart;
Callable => WITH brc: br SELECT FROM
Catch => {
catchEntry[brc.index] _ [offset];
lastSource _ brc.sourceIndex;
lastObject _ bodyStart _ offset;
NewFgtEntry[lastSource, lastObject]}; -- a [0,0] for this body
ENDCASE => ERROR;
ENDCASE => ERROR;
bb[index].info _ BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
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;
Callable => WITH brc: br SELECT FROM
Catch => bi.bytes _ offset - catchEntry[brc.index];
ENDCASE => ERROR;
ENDCASE => ERROR;
END;
ENDCASE;
END;
markCatch =>
IF start THEN cb[index].startPC _ offset
ELSE cb[index].bytes _ offset - cb[index].startPC;
source => IF loc # SourceMap.nullLoc THEN
BEGIN
index: INT = loc.Val[];
IF index > lastSource OR (index = lastSource AND offset # lastObject) THEN 
NewFgtEntry[index, offset];
END;
ENDCASE;
ENDCASE;
nextC _ cb[c].flink;
IF ~labelToKeep THEN {
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 => CCItem.other.SIZE,
ENDCASE => ERROR;
P5U.FreeChunk[c, nw]};
ENDLOOP;
END;


fixupThisProc: BOOL;

OutBinary: PUBLIC PROC [bti: CBTIndex, start: CCIndex] =
BEGIN -- outputs binary bytes for body bti starting at start
e, fs: CARDINAL;
bodyOrigin: INT;
bodyStart: Address;
fixupThisProc _ FALSE;
bodyStart _ OutJumpTables[start];
RemoveCatchCode[start];
e _ bb[bti].entryIndex;
bodyOrigin _ SourceMap.Up[bb[bti].sourceIndex].Val[];
lastSource _ MIN[bodyOrigin, CARDINAL.LAST];
bb[bti].sourceIndex _ CARDINAL[lastSource];
lastObject _ bodyStart;
WITH bi: bb[bti].info SELECT FROM
Internal =>
BEGIN
fs _ P5U.ComputeFrameSize[bi.frameSize];
IF bb[bti].resident THEN fs _ fs+PrincOps.AVHeapSize;
END;
ENDCASE => P5.P5Error[836];
NewFgtEntry[source: bodyOrigin, object: lastObject];
entryVector[e].pc _ [bodyStart];
bb[bti].info _ BodyInfo[External[bytes: , startIndex: fgti, indexLength: ]];
WriteCodeByte[fs];
OutChunks[start]; 
WITH bb[bti].info SELECT FROM
External => {
indexLength _ fgti - startIndex+1; 
bytes _ codeByteIndex - bodyStart};
ENDCASE;
<<bb[bti].hints.needsFixup _ fixupThisProc;>>
END;



RemoveCatchCode: PROC [start: CCIndex] =
BEGIN
c: CCIndex;
FOR c _ start, cb[c].flink UNTIL c = CCNull DO
WITH cc:cb[c] SELECT FROM
other => WITH cc SELECT FROM
markbody =>
IF start THEN
BEGIN
WITH br: bb[index] SELECT FROM
Other => NULL;
Callable => WITH brc: br SELECT FROM
Catch => {DelinkCatch[c]; RETURN};
ENDCASE;
ENDCASE;
END;
ENDCASE;
ENDCASE;
ENDLOOP;
END;

firstCatch, lastCatch: CCIndex;

DelinkCatch: PROC [c: CCIndex] =
BEGIN
prev: CCIndex = cb[c].blink;
IF firstCatch = CCNull THEN firstCatch _ c
ELSE cb[lastCatch].flink _ c; 
cb[c].blink _ lastCatch;
cb[prev].flink _ CCNull;
lastCatch _ c;
WHILE cb[lastCatch].flink # CCNull DO 
lastCatch _ cb[lastCatch].flink;
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: LONG POINTER, nw: CARDINAL] = INLINE
BEGIN
PutBlock[objectStream, s, 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];
codeByteIndex _ codeByteIndex + nw*Basics.bytesPerWord;
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 BLTStrings[firstNewCode, stSize, framestart, FALSE];
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;
firstCode: BOOL _ TRUE;
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]]]]];
IF firstCode THEN {
firstCode _ FALSE; firstNewCode _ nextNewCode _ MoveToCodeWord[]};
stb[msti].codeIndex _ nextNewCode;
nextNewCode _ nextNewCode + nw;
WriteCodeString[@stb[msti].string, nw];
codeByteIndex _ codeByteIndex + nw*2;
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 qLA ELSE qGA, foffset];
P5U.Out0[qBLTC];
END;

OutputCatchBodies: PROC =
BEGIN
IF firstCatch # CCNull THEN OutChunks[firstCatch];
MPtr.catchBytes _ codeByteIndex - catchOffset*Basics.bytesPerWord; -- count CEV, etc
END;

OutputCatchTables: PROC =
BEGIN
maxLevel: CARDINAL = CPtr.enableList.LENGTH-1;
OutEnableLevel: PROC [i: CARDINAL] =
BEGIN
n: CARDINAL _ 0;
ei: EnableIndex;
ee: CatchFormat.EnableItem;
lei: EnableIndex = CPtr.enableList[i];
lnei: EnableIndex;
FOR ei _ lei, cb[ei].next UNTIL ei = EINull DO 
n _ n+1;
ENDLOOP;
WriteCodeWord[n];
FOR ei _ lei, cb[ei].next UNTIL ei = EINull DO 
ee _ [
start: [cb[ei].startPC], length: cb[ei].bytes,
index: bb[cb[ei].bti].index, alsoNested: FALSE];
IF i < maxLevel AND (lnei _ CPtr.enableList[i+1]) # EINull THEN
BEGIN -- look for nexted catch phrases
FOR nei: EnableIndex _ lnei, cb[nei].next UNTIL nei = EINull DO
ns: CARDINAL = cb[nei].startPC;
IF ns >= ee.start THEN {
IF ns < ee.start + ee.length THEN ee.alsoNested _ TRUE;
EXIT};
ENDLOOP;
END;
PutBlock[objectStream, (@ee).LONG, CatchFormat.EnableItem.SIZE];
ENDLOOP;
END;

SortEnableLists[];
WriteCodeWord[catchEntry.LENGTH];
IF catchEntry.LENGTH # 0 THEN
PutBlock[objectStream, catchEntry.BASE, catchEntry.LENGTH*PrincOps.BytePC.SIZE];
IF CPtr.enableList[0] = EINull THEN WriteCodeWord[0];
FOR l: CARDINAL IN [0..maxLevel] WHILE CPtr.enableList[l] # EINull DO
OutEnableLevel[l];
ENDLOOP;
END;

SortEnableLists: PROC = {
FOR l: CARDINAL IN [0..CPtr.enableList.LENGTH) WHILE CPtr.enableList[l] # EINull DO
new: EnableIndex _ EINull;
next: EnableIndex;
<<do simple insertion sort of each list>>
FOR ei: EnableIndex _ CPtr.enableList[l], next UNTIL ei = EINull DO
next _ cb[ei].next;
IF new = EINull OR cb[ei].startPC < cb[new].startPC THEN {cb[ei].next _ new; new _ ei}
ELSE {
prevEi: EnableIndex _ new;
WHILE cb[prevEi].next # EINull AND cb[cb[prevEi].next].startPC < cb[ei].startPC DO
prevEi _ cb[prevEi].next;
ENDLOOP;
cb[ei].next _ cb[prevEi].next;
cb[prevEi].next _ ei};
CPtr.enableList[l] _ new;
ENDLOOP;
ENDLOOP};


catchOffset: CARDINAL;

EndCodeFile: PUBLIC PROC RETURNS [nbytes: CARDINAL] =
BEGIN
maxLevel: CARDINAL = CPtr.enableList.LENGTH-1;
saveindex, catchIndex: StreamIndex;
noCatch: BOOL = (catchEntry.LENGTH = 0);
ctSize: CARDINAL _ 1 + catchEntry.LENGTH*PrincOps.BytePC.SIZE + 1;
prefix: PrincOps.PrefixHeader --CSegPrefix--;
nGfi: CARDINAL =
(MAX[MPtr.nBodies, MPtr.nSigCodes] + (PrincOps.EPRange-1))/PrincOps.EPRange;
fs: CARDINAL;
IF nGfi NOT IN [1..4] THEN P5.P5Error[833];
IF noCatch THEN {catchOffset _ 0; MPtr.catchBytes _ 0}
ELSE {
lei: EnableIndex;
catchOffset _ MoveToCodeWord[];
catchIndex _ objectStream.GetIndex[];
FOR l: CARDINAL IN [0..maxLevel] WHILE (lei _ CPtr.enableList[l]) # EINull DO
IF l # 0 THEN ctSize _ ctSize + 1;
FOR ei: EnableIndex _ lei, cb[ei].next WHILE ei # EINull DO 
ctSize _ ctSize + CatchFormat.EnableItem.SIZE;
ENDLOOP;
ENDLOOP;
codeByteIndex _ codeByteIndex + ctSize*2; -- make room for catch entry, enables
    IF objectStream.GetLength[] < codeBase + codeByteIndex THEN
        objectStream.SetLength[codeBase + codeByteIndex];
objectStream.SetIndex[codeBase + codeByteIndex];
OutputCatchBodies[]};
MPtr.mtRoot.code.length _ codeByteIndex;
[] _ MoveToCodeWord[];
saveindex _ objectStream.GetIndex[];
IF ~noCatch THEN {
objectStream.SetIndex[catchIndex]; codeByteIndex _ catchOffset*2;
OutputCatchTables[]};
MPtr.fgTable _ DESCRIPTOR[fgt.BASE, fgti+1];
MPtr.codeSeg.pages _ 
(2*MPtr.mtRoot.code.offset + MPtr.mtRoot.code.length + (2*BcdDefs.PageSize-1))/
(2*BcdDefs.PageSize);
objectStream.SetIndex[codeBase];
fs _ P5U.ComputeFrameSize[MPtr.globalFrameSize];
IF bb[Symbols.RootBti].resident THEN fs _ fs+PrincOps.AVHeapSize;
prefix--.header-- _ [
globalFsi: fs,
nEntries: MPtr.nBodies,
info: [
available: 0, 
stops: MPtr.stopping, ngfi: nGfi, nlinks: MPtr.linkCount]
];
PutBlock[objectStream, (@prefix).LONG, PrincOps.PrefixHeader.SIZE];
PutBlock[
objectStream, entryVector.BASE, entryVector.LENGTH*PrincOps.EntryVectorItem.SIZE];
PutWord[objectStream, catchOffset*2];
OSMiscOps.FreeWords[entryVector.BASE];
OSMiscOps.FreeWords[catchEntry.BASE];
MPtr.mtRoot.framesize _ MPtr.globalFrameSize + PrincOps.GlobalOverhead.SIZE;
MPtr.mtRoot.crossJumped _ MPtr.switches['j];
objectStream.SetIndex[saveindex];
CompilerUtil.ReleaseStream[object];  objectStream _ NIL;
IF labelPcList # NIL THEN {
FOR i: NAT IN [0..labelPcList.count) DO
P5U.FreeChunk[labelPcList[i].label, CCItem.label.SIZE];
ENDLOOP;
--MPtr.zone.--FREE[@labelPcList]};
IF MPtr.codeOffsetList # NIL THEN {
p: Fixup.PCHandle = MPtr.codeOffsetList.next;
MPtr.codeOffsetList.next _ NIL; MPtr.codeOffsetList _ p};
IF MPtr.codeByteOffsetList # NIL THEN {
p: Fixup.PCHandle = MPtr.codeByteOffsetList.next;
MPtr.codeByteOffsetList.next _ NIL; MPtr.codeByteOffsetList _ p};
IF MPtr.jumpIndirectList # NIL THEN {
j: Fixup.JIHandle = MPtr.jumpIndirectList.next;
MPtr.jumpIndirectList.next _ NIL; MPtr.jumpIndirectList _ j};
RETURN [MPtr.mtRoot.code.length]
END;

END.

