<<>> <> <> <> <> <> <> DIRECTORY Ascii, C2CAccess, C2CBasics, C2CCodePlaces, C2CCodeDefsPrivate, C2CCodeUtils, C2CDefs, C2CEmit, C2CTarget, C2CTypes, IntCodeDefs, IO, RefText, Rope; C2CEmitImpl: CEDAR PROGRAM IMPORTS C2CAccess, C2CEmit, C2CBasics, C2CCodeUtils, C2CTypes, IO, RefText, Rope EXPORTS C2CEmit, C2CDefs = BEGIN OPEN C2CDefs, C2CEmit, IntCodeDefs; remark: SIGNAL = CODE; signalOnRemark: BOOL Ź TRUE; nest: PUBLIC ROPE Ź "@("; unNest: PUBLIC ROPE Ź "@)"; line: PUBLIC ROPE Ź "\n"; optionalLine: PUBLIC ROPE Ź "@."; twoLines: PUBLIC ROPE Ź "@!"; noIndent: PUBLIC ROPE Ź "@_"; nestNLine: PUBLIC ROPE Ź "@(\n"; unNestNLine: PUBLIC ROPE Ź "@)\n"; nullClass: IntCodeDefs.ArithClass = [lastExtension, FALSE, 0]; Code: TYPE = REF CodeRep; CodeRep: PUBLIC TYPE = C2CCodeDefsPrivate.CodeRec; STREAM: TYPE = IO.STREAM; ROPE: TYPE = Rope.ROPE; maxPos: CARD = LAST[INT]/2; ROPEorTEXT: TYPE = REF; CodePlaceRec: TYPE = RECORD [c: Code Ź NIL, block: REF CodeBlock Ź NIL, blockPos: INT Ź LAST[INT]]; CodePlaces: TYPE = ARRAY C2CCodePlaces.CodePlace OF CodePlaceRec; codeBlockSize: NAT = 120; CodeBlock: TYPE = RECORD [ item: ARRAY [0..codeBlockSize) OF REF ANY Ź ALL[NIL] ]; <<--ROPE or REF TEXT; not REF CodeBlock>> freeList: LIST OF REF ANY Ź NIL; NewListPiece: PROC [foo: REF ANY] RETURNS [l: LIST OF REF ANY] = { <> l Ź freeList; IF l=NIL THEN RETURN [LIST[foo]]; freeList Ź freeList.rest; l.rest Ź NIL; l.first Ź foo; }; FreeList: PROC [list, last: LIST OF REF ANY] = { <> IF list#NIL THEN { IF last=NIL THEN last Ź list; last.rest Ź freeList; list.first Ź NIL; --incomplete! repeat on new freeList Ź list }; }; codeBlockCnt: INT Ź 0; codeBlockCntMax: INT = 80; freeCodeBlocks: REF CodeBlock Ź NIL; NewCodeBlock: PROC [] RETURNS [cb: REF CodeBlock] = { cb Ź freeCodeBlocks; IF cb=NIL THEN RETURN [NEW[CodeBlock]]; WITH cb.item[0] SELECT FROM b: REF CodeBlock => { codeBlockCnt Ź codeBlockCnt-1; freeCodeBlocks Ź b; }; ENDCASE => { codeBlockCnt Ź 0; freeCodeBlocks Ź NIL; }; cb.item[0] Ź NIL; }; FreeCodeBlock: PROC [cb: REF CodeBlock] = { IF cb#NIL AND codeBlockCnt=leng THEN RETURN [r]; r Ź Rope.Replace[base: r, start: next, len: 0, with: "@"]; leng Ź leng+1; next Ź next+2; ENDLOOP; }; CComment: PUBLIC PROC [r: ROPE] RETURNS [comment: Code] = { comment Ź RopeCode[Rope.Cat["/* ", CleanUpComment[Internalize[r]], " */ "]]; comment.whiteSpaceOnly Ź TRUE; }; CleanUpComment: PROC [r: ROPE] RETURNS [ROPE] = { <<--replaces characters which are not legal in C comments>> <<--also replaces characters used by C2CEmit for formating>> IF C2CAccess.params.extraShortAndUgly THEN RETURN [""] ELSE { leng: INT Ź Rope.Length[r]; FOR i: INT IN [0..leng) DO SELECT Rope.Fetch[r, i] FROM '/ => IF i+1=leng THEN r Ź Rope.Concat[r, "_"] ELSE IF Rope.Fetch[r, i+1]='* THEN r Ź Rope.Replace[r, i+1, 1, "."]; '* => IF i+1 r Ź Rope.Replace[r, i, 1, "_"]; ENDCASE => NULL; ENDLOOP; }; RETURN [r]; }; lParam: ROPE = Rope.Flatten[Rope.Concat["(", C2CEmit.nest]]; rParam: ROPE = Rope.Flatten[Rope.Concat[")", C2CEmit.unNest]]; lLParam: ROPE = Rope.Flatten[Rope.Concat["(", C2CEmit.nestNLine]]; rLParam: ROPE = Rope.Flatten[Rope.Cat[C2CEmit.line, ")", C2CEmit.unNest]]; Parentize: PUBLIC PROC [c: CodeOrRope] RETURNS [code: Code] = { isAdress: BOOL Ź FALSE; adressable: BOOL Ź FALSE; dead: BOOL Ź FALSE; class: IntCodeDefs.ArithClass Ź [lastExtension, FALSE, 0]; WITH c SELECT FROM cr: REF C2CCodeDefsPrivate.CodeRec => { IF cr.precedence>=parenPrecedence THEN RETURN [cr]; isAdress Ź cr.isAdress; adressable Ź cr.adressable; class Ź cr.class; dead Ź cr.dead; }; ENDCASE => {}; code Ź C2CEmit.Cat[lParam, c, rParam]; code.precedence Ź parenPrecedence; code.isAdress Ź isAdress; code.adressable Ź adressable; code.class Ź class; code.dead Ź dead; }; ParentizeAndLn: PUBLIC PROC [c: CodeOrRope] RETURNS [code: Code] = { isAdress: BOOL Ź FALSE; adressable: BOOL Ź FALSE; dead: BOOL Ź FALSE; class: IntCodeDefs.ArithClass Ź [lastExtension, FALSE, 0]; WITH c SELECT FROM cr: REF C2CCodeDefsPrivate.CodeRec => { IF cr.precedence>=parenPrecedence THEN RETURN [cr]; isAdress Ź cr.isAdress; adressable Ź cr.adressable; class Ź cr.class; dead Ź cr.dead; }; ENDCASE => {}; code Ź C2CEmit.Cat[lLParam, c, rLParam]; code.precedence Ź parenPrecedence; code.isAdress Ź isAdress; code.adressable Ź adressable; code.class Ź class; code.dead Ź dead; }; nestLimit: INT = 10; --must be such that spaces is large enough spaces: Rope.ROPE = Rope.Flatten[" "]; maxLineLeng: INT Ź 120; TrustAsRope: PROC [x: REF ANY] RETURNS [ROPE] = { WITH x SELECT FROM r: ROPE => RETURN [r]; rt: REF TEXT => RETURN [RefText.TrustTextAsRope[rt]]; ENDCASE => IF x=NIL THEN RETURN[""] ELSE ERROR; }; lineStreamHeader: Rope.ROPE = "Positions 001 \000"; lineStreamTrailer: Rope.ROPE = "\000\000\000\000\000\000\000\000"; pieceCount, piceSum: INT Ź 0; ProcessAndOutputCode: PUBLIC PROC [stream: IO.STREAM, lineStream: IO.STREAM, c: Code, lineChar: CHAR, allowUnIndent: BOOL Ź TRUE] = { <<--removes formatting instructions of code>> nesting: INT Ź 0; lineEmpty: BOOL Ź TRUE; doubleEmpty: BOOL Ź TRUE; --must be defined defined while lineEmpty=TRUE chars: INT Ź 0; lineNumber: CARD Ź 1; doLineStream: BOOL Ź C2CAccess.params.generateLineNumberStream; extraUgly: BOOL Ź C2CAccess.params.extraShortAndUgly; PutLineFileNumber: PROC [i: CARD] = TRUSTED { block: PACKED ARRAY [0..4) OF BYTE; block[0] Ź i / 100000000B MOD 256; block[1] Ź i / 200000B MOD 256; block[2] Ź i / 256 MOD 256; block[3] Ź i MOD 256; TRUSTED { bp: LONG POINTER = @block; IO.UnsafePutBlock[lineStream, [LOOPHOLE[bp], 0, 4]] }; }; PutLineFileRope: PROC [r: Rope.ROPE] = { n: CARD Ź Rope.Length[r]; all: CARD Ź ((n + 7) / 8) * 8; PutLineFileNumber[n]; IO.PutRope[lineStream, r]; FOR i: CARD IN [n..all) DO IO.PutChar[lineStream, 0C] ENDLOOP; }; PutSpaces: PROC [nesting: INT] = INLINE { IF nesting>0 AND ~extraUgly THEN { IF nesting>=nestLimit THEN { IO.PutText[stream, "/*"]; IO.PutRope[stream, C2CCodeUtils.RopeFromInt[nesting / nestLimit]]; IO.PutText[stream, "*/"]; nesting Ź (nesting MOD nestLimit) + 1; }; IO.PutRope[stream, spaces, 0, nesting*3]; }; }; Out: PROC [r: ROPE, start: INT Ź 0, len: INT] = INLINE { IF lineEmpty THEN {PutSpaces[nesting]; lineEmpty Ź FALSE}; IO.PutRope[stream, r, start, len]; chars Ź chars+len; }; NewLine: PROC [] = { IF ~lineEmpty THEN { lineEmpty Ź TRUE; doubleEmpty Ź FALSE; IO.PutChar[stream, lineChar]; lineNumber Ź lineNumber+1; chars Ź 0; } }; SeparationLine: PROC [] = { IF ~lineEmpty THEN NewLine[]; IF ~doubleEmpty THEN IO.PutChar[stream, lineChar]; doubleEmpty Ź TRUE; }; HandlePosition: PROC [r: Rope.ROPE, pos: INT, isStart: BOOL] = { Template: TYPE = --WORD8 MSBIT MACHINE DEPENDEND-- PACKED RECORD [cA, cB: BYTE, fA, fB, fC: BYTE, sA, sB, sC: BYTE]; template: Template; start, chars: CARD; NewLine[]; <<--scan in values>> start Ź ORD[Rope.Fetch[r, pos+0]] * 100000000B + ORD[Rope.Fetch[r, pos+1]] * 200000B + ORD[Rope.Fetch[r, pos+2]] * 256 + ORD[Rope.Fetch[r, pos+3]]; chars Ź ORD[Rope.Fetch[r, pos+4]] * 100000000B + ORD[Rope.Fetch[r, pos+5]] * 200000B + ORD[Rope.Fetch[r, pos+6]] * 256 + ORD[Rope.Fetch[r, pos+7]]; <<--check in rangeness and compute nextPos>> IF lineNumber<1 OR lineNumber>LAST[CARD16] THEN ERROR; IF start<0 OR chars<0 THEN ERROR; IF start>maxPos OR chars>maxPos THEN ERROR; chars Ź chars+start; IF chars>maxPos THEN ERROR; <<--c line>> template.cA Ź lineNumber / 256 MOD 256; template.cB Ź lineNumber MOD 256; <<--start pos and code>> template.fA Ź start / 65536 MOD 256; IF ~isStart THEN template.fA Ź template.fA + 128; template.fB Ź start / 256 MOD 256; template.fC Ź start MOD 256; <<--stop pos>> template.sA Ź chars / 65536 MOD 256; template.sB Ź chars / 256 MOD 256; template.sC Ź chars MOD 256; <<--output>> TRUSTED { tp: LONG POINTER = @template; IO.UnsafePutBlock[lineStream, [LOOPHOLE[tp], 0, 8]] }; }; IF c.delayedX THEN C2CBasics.CantHappen; IF doLineStream THEN { IO.PutRope[lineStream, lineStreamHeader]; PutLineFileRope[C2CAccess.params.moduleName]; PutLineFileRope[C2CAccess.params.versionStamp]; }; FOR list: LIST OF REF ANY Ź c.base, list.rest WHILE list#NIL DO blockIdx: INT Ź 0; next, leng: INT; DO --loop over list.first [CodeBlock or single string] IterationNext: PROC [x: REF ANY] RETURNS [ROPE] = INLINE { <> <> IF blockIdx>=codeBlockSize THEN RETURN[NIL]; WITH x SELECT FROM seq: REF CodeBlock => { WHILE blockIdx RETURN [r]; rt: REF TEXT => TRUSTED { RETURN [RefText.TrustTextAsRope[LOOPHOLE[rt]]] }; ENDCASE => IF y#NIL THEN ERROR; ENDLOOP; FreeCodeBlock[seq]; RETURN [NIL]; }; r: ROPE => {blockIdx Ź codeBlockSize; RETURN [r]}; rt: REF TEXT => TRUSTED { blockIdx Ź codeBlockSize; RETURN [RefText.TrustTextAsRope[LOOPHOLE[rt]]] }; ENDCASE => IF x=NIL THEN RETURN[NIL] ELSE ERROR; }; firstPos: INT Ź 0; r: ROPE Ź IterationNext[list.first]; IF r=NIL THEN EXIT; --exits loop over list.first leng Ź Rope.Length[r]; WHILE firstPosfirstPos THEN Out[r: r, start: firstPos, len: next-firstPos]; IF next {NewLine[]; next Ź next+1}; C2CEmit.breakChar => { IF next+1>=leng THEN NewLine[] ELSE SELECT Rope.Fetch[r, next+1] FROM '( => { nesting Ź nesting+1; IF chars>maxLineLeng THEN NewLine[]; }; ') => { nesting Ź nesting-1; IF chars>maxLineLeng THEN NewLine[]; }; '/ => NewLine[]; '_ => {NewLine[]; IF allowUnIndent THEN lineEmpty Ź FALSE}; '! => SeparationLine[]; '# => IF doLineStream THEN { HandlePosition[r, next+2, TRUE]; next Ź next+8 }; '% => IF doLineStream THEN { HandlePosition[r, next+2, FALSE]; next Ź next+8 }; '. => { IF chars>maxLineLeng THEN NewLine[]; }; C2CEmit.breakChar => Out["@", 0, 1]; ENDCASE => NewLine[]; next Ź next+2; }; ENDCASE => C2CBasics.CantHappen; firstPos Ź next; ENDLOOP --WHILE--; ENDLOOP --DO--; ENDLOOP --FOR--; IF doLineStream THEN { IO.PutRope[lineStream, lineStreamTrailer]; }; }; Deref: PUBLIC PROC [c: Code, pointeeBits: INT] RETURNS [Code] = { IF c=NIL OR c.usageInhibited OR c.whiteSpaceOnly OR c.dead THEN C2CBasics.CantHappen; c.delayedCWord Ź c.delayedCRef Ź FALSE; c Ź DCleanCode[c]; c Ź MinPrecedence[c, unaryPrecedence]; c.delayedDeref Ź c.delayedX Ź TRUE; c.pointeeBits Ź pointeeBits; c.adressable Ź TRUE; c.precedence Ź unaryPrecedence; c.class Ź IF pointeeBits>0 AND pointeeBits<=LAST[ArithPrecision] THEN [unsigned, FALSE, pointeeBits] ELSE nullClass; RETURN [c] }; IsDelayedDeref: PUBLIC PROC [c: Code] RETURNS [BOOL] = { RETURN [ c.delayedX AND c.delayedDeref ]; }; TakeAddr: PUBLIC PROC [c: Code, preventCastingToWord: BOOL] RETURNS [Code] = { IF c=NIL OR c.usageInhibited OR c.whiteSpaceOnly OR c.dead THEN C2CBasics.CantHappen; IF c.isAdress THEN {c.isAdress Ź FALSE; RETURN [c]}; IF c.delayedX THEN { IF c.delayedDeref THEN { c.class Ź [address, FALSE, C2CTarget.bitsPerWord]; c.delayedDeref Ź c.delayedCRef Ź FALSE; c.delayedX Ź c.delayedCWord Ź ~preventCastingToWord; RETURN [c]; }; c.delayedX Ź c.delayedDeref Ź c.delayedCWord Ź c.delayedCRef Ź FALSE; }; c Ź MinPrecedence[c, unaryPrecedence]; c Ź Cat["&", c]; c Ź SetPrecedence[c, unaryPrecedence]; c.class Ź [address, FALSE, C2CTarget.bitsPerWord]; c.hasCRef Ź c.hasCWord Ź FALSE; c.delayedX Ź c.delayedCWord Ź ~preventCastingToWord; RETURN [c]; }; PreventCastingToWord: PUBLIC PROC [c: Code] RETURNS [Code] = { c.delayedCWord Ź FALSE; c.delayedX Ź c.delayedDeref OR c.delayedCRef; RETURN [c]; }; CastWord: PUBLIC PROC [c: CodeOrRope] RETURNS [code: Code] = { done: BOOL Ź FALSE; WITH c SELECT FROM co: REF CodeRep => {code Ź co}; r: ROPE => code Ź IdentCode[r]; rt: REF TEXT => code Ź IdentCode[Rope.FromRefText[rt]]; ENDCASE => C2CBasics.CantHappen; code.delayedCRef Ź FALSE; IF code.delayedX THEN { IF code.delayedDeref THEN { bits: INT Ź code.pointeeBits; code Ź DCleanCode[code]; IF bits=C2CTarget.bitsPerWord THEN RETURN [code]; IF bits>C2CTarget.bitsPerWord THEN C2CBasics.CantHappen; }; code.delayedCRef Ź FALSE; code.pointeeBits Ź -1; } ELSE IF code.hasCWord THEN RETURN [code]; code Ź MinPrecedence[code, unaryPrecedence]; code.delayedCWord Ź code.delayedX Ź TRUE; }; CastRef: PUBLIC PROC [c: Code, pointeeBits: INT] RETURNS [Code] = { c.delayedCWord Ź c.hasCWord Ź FALSE; c Ź MinPrecedence[c, unaryPrecedence]; IF c.delayedX THEN { IF c.delayedDeref THEN { bits: INT Ź c.pointeeBits; c Ź DCleanCode[c]; IF bits#C2CTarget.bitsPerWord THEN C2CBasics.CantHappen; c.hasCRef Ź FALSE; }; } ELSE IF c.hasCRef AND c.hasCRefBits=pointeeBits THEN { RETURN [c]; }; c.pointeeBits Ź pointeeBits; c.delayedDeref Ź c.delayedCWord Ź FALSE; c.delayedX Ź c.delayedCRef Ź TRUE; RETURN [c]; }; <<>> SetWord: PUBLIC PROC [c: Code] RETURNS [Code] = { c Ź MinPrecedence[c, unaryPrecedence]; IF c.delayedX THEN { IF c.delayedDeref THEN { bits: INT Ź c.pointeeBits; c Ź DCleanCode[c]; c.delayedDeref Ź FALSE; IF bits#C2CTarget.bitsPerWord THEN C2CBasics.CantHappen; }; IF c.delayedCWord THEN RETURN [c]; }; c.delayedX Ź c.delayedDeref Ź c.delayedCRef Ź c.delayedCWord Ź c.hasCRef Ź FALSE; c.hasCRefBits Ź -1; c.hasCWord Ź TRUE; RETURN [c]; }; <<>> SetRef: PUBLIC PROC [c: Code, pointeeBits: INT] RETURNS [Code] = { c Ź MinPrecedence[c, unaryPrecedence]; IF c.delayedX THEN { IF c.delayedDeref THEN C2CBasics.CantHappen; IF c.delayedCRef THEN { IF c.pointeeBits#pointeeBits THEN C2CBasics.CantHappen; RETURN [c]; }; }; c.delayedX Ź c.delayedDeref Ź c.delayedCRef Ź c.delayedCWord Ź c.hasCWord Ź FALSE; c.hasCRefBits Ź pointeeBits; c.hasCRef Ź TRUE; RETURN [c]; }; <<>> CodeToRope: PUBLIC PROC [c: CodeOrRope] RETURNS [r: ROPE] = { WITH c SELECT FROM co: REF CodeRep => RETURN [RealCodeToRope[co]]; r: ROPE => RETURN [r]; rt: REF TEXT => RETURN [Rope.FromRefText[rt]]; ENDCASE => IF c=NIL THEN RETURN [NIL] ELSE C2CBasics.CantHappen; }; CodeToRopeD: PUBLIC PROC [c: CodeOrRope] RETURNS [r: ROPE] = { WITH c SELECT FROM co: REF CodeRep => { r Ź RealCodeToRope[co]; FreeCode[co]; RETURN [r]; }; r: ROPE => RETURN [r]; rt: REF TEXT => RETURN [Rope.FromRefText[rt]]; ENDCASE => IF c=NIL THEN RETURN [NIL] ELSE C2CBasics.CantHappen; }; PutList: PROC [s: IO.STREAM, lora: LIST OF REF ANY] = { FOR l: LIST OF REF ANY Ź lora, l.rest WHILE l#NIL DO WITH l.first SELECT FROM r: ROPE => IO.PutRope[s, r]; rt: REF TEXT => IO.PutText[s, rt]; ENDCASE => IF l.first#NIL THEN ERROR; ENDLOOP; }; RealCodeToRope: PROC [c: Code] RETURNS [r: ROPE] = { -- non destructive ros: STREAM Ź NIL; suf: REF TEXT Ź NIL; IF c=NIL THEN RETURN [NIL]; IF c.usageInhibited THEN C2CBasics.CantHappen; ros Ź IO.ROS[]; IF c.delayedX THEN { IF c.delayedDeref THEN { IF c.hasCRef AND c.hasCRefBits=c.pointeeBits THEN { IF c.precedence> IF c=NIL THEN RETURN [NewCode[]]; IF c.usageInhibited OR c.isAdress THEN C2CBasics.CantHappen; IF c.delayedX THEN { IF c.delayedDeref THEN { IF c.precedence> <<--Large to delay reuse for increase chance of detection of usageInhibited.>> freeCodeSeq: REF FreeCodeSeq Ź NEW[FreeCodeSeq]; FreeCodeSeq: TYPE = RECORD [ in, out: NAT Ź 0, --equal = empty items: ARRAY [0..freeCodeCount) OF Code ]; FreeCode: PROC [c: Code] = { IF c#NIL THEN { nextIn: NAT; c.usageInhibited Ź TRUE; c.base Ź c.last Ź NIL; nextIn Ź (freeCodeSeq.in + 1) MOD freeCodeCount; IF nextIn#freeCodeSeq.out THEN {--don't make it look empty freeCodeSeq.items[freeCodeSeq.in] Ź c; freeCodeSeq.in Ź nextIn; }; }; }; NewCodeCopy: PROC [c: Code] RETURNS [cc: Code] = { IF c.usageInhibited THEN C2CBasics.CantHappen; cc Ź NewCode[]; cc.precedence Ź c.precedence; cc.delayedDeref Ź c.delayedDeref; cc.delayedCRef Ź c.delayedCRef; cc.delayedCWord Ź c.delayedCWord; cc.delayedX Ź cc.delayedDeref OR cc.delayedCRef OR cc.delayedCWord; cc.hasCRefBits Ź c.hasCRefBits; cc.hasCRef Ź c.hasCRef; cc.hasCWord Ź c.hasCWord; cc.pointeeBits Ź c.pointeeBits; cc.adressable Ź c.adressable; cc.isAdress Ź c.isAdress; cc.whiteSpaceOnly Ź c.whiteSpaceOnly; cc.class Ź c.class; }; MinPrecedence: PUBLIC PROC [c: Code, minimum: PrecedenceŹassignPrecedence] RETURNS [modifiedC: Code] = { IF c=NIL OR c.usageInhibited THEN C2CBasics.CantHappen; IF c.precedence> IF C2CAccess.params.extraShortAndUgly THEN RETURN [c]; IF c=NIL OR c.base=NIL THEN RETURN [CComment[r]]; IF c.usageInhibited THEN C2CBasics.CantHappen; c.last.rest Ź NewListPiece[Rope.Cat["/* ", CleanUpComment[Internalize[r]], " */ "]]; c.last Ź c.last.rest; RETURN [c]; }; CatDebugInfo: PUBLIC PROC [c: Code, r: ROPE, key: REF Ź NIL] RETURNS [Code] = { IF C2CAccess.params.debuggingCode AND c#NIL THEN { c Ź CatRemark[c, r]; }; RETURN [c]; }; debugPat: ROPE Ź NIL; debug: SIGNAL = CODE; DCatCode: PROC [c1, c2: Code] RETURNS [c: Code] = { <<--returned code has has... type fields from c1, if non NIL>> IF c1=NIL THEN RETURN[c2]; IF c1.usageInhibited THEN C2CBasics.CantHappen; IF c2=NIL THEN RETURN[c1]; IF c2.usageInhibited THEN C2CBasics.CantHappen; <<--assert we know that c1 and c2 are non-nil>> IF c1.base=NIL THEN {FreeCode[c1]; RETURN[c2]}; IF c2.base=NIL THEN {FreeCode[c2]; RETURN[c1]}; <<--assert there is real appending to do>> IF debugPat#NIL THEN IF Rope.Match[debugPat, TrustAsRope[c2.base.first]] THEN debug; c1.last.rest Ź c2.base; c1.last Ź c2.last; c1.precedence Ź notExpressionPrecedence; c1.adressable Ź FALSE; c1.class Ź nullClass; c1.dead Ź c2.dead; FreeCode[c2]; RETURN[c1]; }; DCatRef: PROC [c1: Code, ref: REF] RETURNS [c: Code] = { <<--returned code has type fields from c1, if non NIL>> dead: BOOL Ź FALSE; c2: Code Ź NIL; piece: REF ANY Ź NIL; IF c1#NIL AND (c1.usageInhibited OR c1.whiteSpaceOnly) THEN C2CBasics.CantHappen; IF ref = NIL THEN RETURN [c1]; IF c1 = NIL OR c1.base = NIL THEN RETURN [DToC[ref]]; WITH ref SELECT FROM co: REF CodeRep => { c2 Ź DCleanCode[co]; IF c2.base = NIL THEN RETURN [c1]; IF c2.whiteSpaceOnly THEN dead Ź c1.dead ELSE dead Ź c2.dead; }; rr: ROPE => piece Ź rr; rt: REF TEXT => piece Ź rt; ENDCASE => C2CBasics.CantHappen; <> IF c2 # NIL THEN { c1.last.rest Ź c2.base; c1.last Ź c2.last; FreeCode[c2]; } ELSE { IF debugPat # NIL THEN IF Rope.Match[debugPat, TrustAsRope[piece]] THEN debug; c1.last Ź c1.last.rest Ź NewListPiece[piece]; }; c1.precedence Ź notExpressionPrecedence; c1.adressable Ź FALSE; c1.class Ź nullClass; c1.dead Ź dead; RETURN [c1]; }; DEncloseCode: PROC [prefix: ROPEorTEXT, c1: Code, suffix: ROPEorTEXTŹNIL] RETURNS [Code] = { <<--ignores delayed mumbo>> <<--modifies c1 inline>> pl: LIST OF REF ANY Ź NewListPiece[prefix]; IF c1=NIL OR c1.usageInhibited THEN C2CBasics.CantHappen; c1.whiteSpaceOnly Ź FALSE; IF c1.base=NIL THEN {c1.base Ź c1.last Ź pl} ELSE { l: LIST OF REF ANY Ź pl; l.rest Ź c1.base; c1.base Ź l }; IF suffix#NIL THEN { sl: LIST OF REF ANY Ź NewListPiece[suffix]; c1.last.rest Ź sl; c1.last Ź sl; }; c1.dead Ź FALSE; RETURN [c1]; }; Cat: PUBLIC PROC [c1, c2, c3, c4, c5: REF Ź NIL] RETURNS [c: Code Ź NIL] = { Each: PROC [x: REF] = INLINE { IF x#NIL THEN { IF c = NIL THEN {c Ź DToC[x]; c.class Ź nullClass} ELSE {c Ź DCatRef[c, x];}; }; }; Each[c1]; Each[c2]; Each[c3]; Each[c4]; Each[c5]; }; DToC: PROC [c: REF Ź NIL] RETURNS [Code Ź NIL] = { <<--converts refs to code>> IF c#NIL THEN WITH c SELECT FROM co: REF CodeRep => RETURN [DCleanCode[co]]; rr: ROPE => RETURN [RopeCode[rr]]; rt: REF TEXT => RETURN [RefTextCode[rt]]; ENDCASE => C2CBasics.CantHappen; }; <> emittedCodes: REF CodePlaces Ź NIL; ResetEmittedCodes: PROC[] = { emittedCodes Ź NEW[CodePlaces]; }; AppendCode: PUBLIC PROC [place: C2CCodePlaces.CodePlace, code: CodeOrRope] = { IF code#NIL THEN { WITH code SELECT FROM cr: REF CodeRep => cr.hasCRef Ź cr.hasCWord Ź FALSE; ENDCASE => {}; IF simplify[place] THEN { newCode: Code Ź DToC[code]; oldCode: Code Ź emittedCodes[place].c; IF oldCode=NIL THEN { oldCode Ź emittedCodes[place].c Ź NewCode[] }; FOR l: LIST OF REF ANY Ź newCode.base, l.rest WHILE l#NIL DO IF emittedCodes[place].blockPos>=codeBlockSize THEN { block: REF CodeBlock Ź NewCodeBlock[]; newPiece: LIST OF REF ANY Ź NewListPiece[block]; emittedCodes[place].block Ź block; emittedCodes[place].blockPos Ź 0; IF oldCode.last=NIL THEN oldCode.base Ź newPiece ELSE oldCode.last.rest Ź newPiece; oldCode.last Ź newPiece; }; emittedCodes[place].block[emittedCodes[place].blockPos] Ź l.first; emittedCodes[place].blockPos Ź emittedCodes[place].blockPos + 1; ENDLOOP; FreeList[newCode.base, newCode.last]; } ELSE { emittedCodes[place].c Ź DCatRef[emittedCodes[place].c, code]; }; }; }; simplify: ARRAY C2CCodePlaces.CodePlace OF BOOL = [TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE]; CollectCode: PUBLIC PROC [place: C2CCodePlaces.CodePlace, final: BOOL] RETURNS [c: Code] = { IF final # simplify[place] THEN ERROR; c Ź emittedCodes[place].c; emittedCodes[place] Ź [c: NIL, block: NIL, blockPos: LAST[INT]]; }; <<>> C2CBasics.CallbackWhenC2CIsCalled[ResetEmittedCodes]; C2CBasics.CallbackWhenC2CIsCalled[ResePointerCastCache]; IF Rope.Length[lineStreamHeader]#16 THEN ERROR; IF Rope.Length[lineStreamTrailer]#8 THEN ERROR; END.