<> <> <> <> <> 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; <> 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 = { <> 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 = { <> 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] = { <> 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] = { <> 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: 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 => { <> 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 { <> 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] }; }.