<<>> <> <> <> <> <> <> DIRECTORY Ascii, C2CAccess, C2CAddressing, C2CAddressingOps, C2CBasics, C2CCodePlaces, C2CCodeUtils, C2CDefs, C2CDouble, C2CEmit, C2CEnables, C2CIntCodeUtils, C2CMain, C2CMode, C2CNames, C2CRunTime, C2CStateUtils, C2CSingleFloat, C2CTarget, C2CTypes, Convert, IntCodeDefs, IntCodeStuff, IntCodeUtils, IntToIntTab, IO, Rope, SymTab; C2CAppliesImpl: CEDAR MONITOR IMPORTS C2CAccess, C2CAddressing, C2CAddressingOps, C2CBasics, C2CCodeUtils, C2CDouble, C2CEmit, C2CEnables, C2CIntCodeUtils, C2CMain, C2CMode, C2CNames, C2CRunTime, C2CSingleFloat, C2CStateUtils, C2CTarget, C2CTypes, Convert, IntCodeStuff, IntCodeUtils, IntToIntTab, IO, Rope, SymTab EXPORTS C2CMain = BEGIN OPEN IntCodeDefs, C2CAddressingOps, C2CBasics, C2CDefs, C2CMain, C2CMode; ROPE: TYPE = Rope.ROPE; <<>> checkForAbstractionFaults: BOOL ¬ FALSE; <<>> <> Cat2: PROC [c1, c2: Code] RETURNS [c: Code] = { IF c2=NIL THEN RETURN [c1]; IF c1=NIL THEN RETURN [c2]; RETURN [C2CEmit.Cat[c1, c2]] }; DeclDummyReturnBlock: PROC [bits: INT] RETURNS [name: ROPE] = { type: ROPE ¬ C2CTypes.DefineType[bits]; name ¬ C2CNames.InternalName[class: "retTmp"]; C2CEmit.AppendCode[procedureDeclarations, C2CEmit.Cat[type, " ", name, ";\n"]]; }; MakeNot: PROC [c: Code] RETURNS [Code] = { <<--prepends a not operator>> c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence]; c ¬ C2CEmit.Cat[" ! ", c]; c ¬ C2CEmit.SetPrecedence[c, unaryPrecedence]; RETURN [c]; }; <<>> <> Macro: TYPE = C2CStateUtils.Macro; nilCkMacro: Macro ¬ C2CStateUtils.DefineMacro["NCK", <<--expects argument is dereferencing; voids result >> "(p) ( (void) p)" ]; bckMacro: Macro ¬ C2CStateUtils.DefineMacro["BCK", C2CEmit.Cat[ "(idx, lim) ( ((unsigned) idx) >= ((unsigned) lim) ? (", C2CRunTime.RaiseBoundsFault[], ") : (idx) )" ]]; intAbsMacro: Macro ¬ C2CStateUtils.DefineMacro["IABS", "(i) ( ((int)(word)(i) > 0) ? (i) : (word)(-(int)(word)(i)) )" ]; signExtendMacro: Macro ¬ C2CStateUtils.DefineMacro["SGNXT", <<--We do not have checked which way is faster [for what machine?]>> <<--1) left shift - right shift>> <<--2) x _ (x XOR Mask[signbit])-Mask[signbit] iff leading bits 0...>> <<--the (word) cast is supposed to enforce size so that (int) is a loophole>> <<--leave the result as int>> <> "(i, bits) (( ((int)(word)(i)) << bits) >> bits)" ]; Cast: PROC [type: ROPE, c: Code] RETURNS [Code] = { <<--just make a cast; use more specific procedure to cast to "word">> c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence]; c ¬ C2CEmit.Cat[" (", type, ")", c]; c ¬ C2CEmit.SetPrecedence[c, unaryPrecedence]; RETURN [c] }; SignExtend: PROC [c: Code, signPosition: INT, resultType: {int, canonical, dontCare}¬dontCare] RETURNS [Code] = { <<--cast to output type only if not noop!>> <<--dontCare makes sense, since int<->unsigned are compatible and the sign bit is on >> <<--the right place>> <<-->> <<--speed up if unit is full word>> IF signPosition=C2CTarget.bitsPerWord THEN { IF resultType=int THEN { c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence]; c ¬ Cast[C2CTarget.signedWord, c]; c ¬ C2CEmit.SetArithClass[c, [signed, TRUE, C2CTarget.bitsPerWord]]; }; RETURN [c] }; <<-->> <<--speed up if unit is half word>> IF signPosition=C2CTarget.bitsPerHalfWord AND C2CTarget.hasHalfWords THEN { IF C2CEmit.IsDelayedDeref[c] THEN { c ¬ C2CEmit.TakeAddr[c, TRUE]; c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence]; c ¬ C2CEmit.Cat["*(", C2CTarget.signedHalf, "*)", c]; c ¬ C2CEmit.SetPrecedence[c, unaryPrecedence]; } ELSE { c ¬ Cast[C2CTarget.signedHalf, c]; }; c ¬ Cast[C2CTarget.signedWord, c]; IF resultType=canonical THEN c ¬ Cast[C2CTarget.word, c] ELSE c ¬ C2CEmit.SetArithClass[c, [signed, TRUE, C2CTarget.bitsPerWord]]; RETURN [c] }; <<-->> <<--speed up if unit is byte>> IF signPosition=8 AND C2CTarget.hasBytes THEN { IF C2CEmit.IsDelayedDeref[c] THEN { c ¬ C2CEmit.TakeAddr[c, TRUE]; c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence]; c ¬ C2CEmit.Cat["*(", C2CTarget.signedByte, "*)", c]; c ¬ C2CEmit.SetPrecedence[c, unaryPrecedence]; } ELSE c ¬ Cast[C2CTarget.signedByte, c]; c ¬ Cast[C2CTarget.signedWord, c]; IF resultType=canonical THEN c ¬ Cast[C2CTarget.word, c] ELSE c ¬ C2CEmit.SetArithClass[c, [signed, TRUE, C2CTarget.bitsPerWord]]; RETURN [c] }; <<-->> <<--general case>> c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence]; c ¬ C2CEmit.CatCall[C2CStateUtils.MacroName[signExtendMacro], c, ", ", C2CCodeUtils.ConstI[C2CTarget.bitsPerWord-signPosition]]; IF resultType=canonical THEN c ¬ Cast[C2CTarget.word, c] ELSE c ¬ C2CEmit.SetArithClass[c, [signed, TRUE, C2CTarget.bitsPerWord]]; RETURN [c] }; signCheckMacro: Macro ¬ C2CStateUtils.DefineMacro["SGNCK", C2CEmit.Cat[ <<--double cast since no cast by caller and possible size increase>> "(i) ((int) (word) (i) < 0 ? ", C2CRunTime.RaiseArithmeticFault[], ": i )" ]]; intBinOpMacro: Macro ¬ C2CStateUtils.DefineMacro["IOP2", <<--the word cast does the size change if necessary>> <<--the int cast then is a loophole to get the right operation>> <<--Operands casted to int by caller!>> "(op, x, y) ( (word) ((x) op (y)) )" ]; intNegMacro: Macro ¬ C2CStateUtils.DefineMacro["INEG", <<--double cast since no cast by caller and possible size increase>> "(x) ( (word) ( - ((int) (word) (x)) ) )" ]; minMacro: Macro ¬ C2CStateUtils.DefineMacro["MIN", "(cast, x, y) ( ( cast x) < ( cast y) ? (x) : (y) )" ]; maxMacro: Macro ¬ C2CStateUtils.DefineMacro["MAX", "(cast, x, y) ( ( cast x) > ( cast y) ? (x) : (y) )" ]; GenNodeNCast: PUBLIC PROC [node: IntCodeDefs.Node, class: ArithClass] RETURNS [cc: CodeCont] = { <<--generates code with type as needed for operations of class>> <<--as needed does not mean equal!>> <<-->> <<--Everything larger then single precision is left canonical [unsigned]>> <<--Types smaller or equal to single precision>> <<-- unsigned, address, float: left canonical [unsigned]>> <<-- signed: (sign extend) and cast to signed [full word]>> codeClass: ArithClass; cc ¬ LoadArithNode[node]; codeClass ¬ C2CEmit.GetArithClass[cc.ec]; IF class.precision=0 THEN CantHappenCedar; IF node.bits>class.precision THEN CantHappen; IF class.precision>C2CTarget.bitsPerWord THEN { IF class.precision#node.bits THEN CantHappenCedar; RETURN }; SELECT class.kind FROM unsigned => {}; --thats default and it 0 extends perfectly address => {}; real => {IF class.precision#node.bits OR node.bits#C2CTarget.bitsPerWord THEN NotYetImpl}; signed => { DO IF codeClass.kind=signed THEN { <<--code already of type int>> EXIT; }; IF class.precision#node.bits THEN NotYetImpl; IF node.bits=C2CTarget.bitsPerWord --IntCode says the sign bit is on right position-- OR class.precision=C2CTarget.bitsPerWord --Caller says the sign bit is on right position-- THEN { cc.ec ¬ Cast["int", cc.ec]; EXIT; }; <<--We have to actualy move the sign bit>> cc.ec ¬ SignExtend[cc.ec, class.precision, int]; EXIT; ENDLOOP; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [signed, TRUE, C2CTarget.bitsPerWord]]; }; ENDCASE => CaseMissing; }; <> LoadParameter: PROC [node: Node, mode: Mode¬NIL, ansiCast: Rope.ROPE ¬ NIL] RETURNS [cc: CodeCont] = { <<--Generates node such that it can be passed as a parameter>> <<--mode might be used to find out whether statement code may be generated>> bits: INT ¬ node.bits; SELECT TRUE FROM bits>C2CTarget.maxBitsForValueParams => { cc ¬ ForceToAddressableRhs[node]; cc.ec ¬ C2CEmit.TakeAddr[cc.ec, TRUE]; }; bits<=C2CTarget.bitsPerWord => cc ¬ LoadArithNode[node]; bits>C2CTarget.bitsPerWord => cc ¬ ForceToAddressableRhs[node]; --slightly too restrictive ENDCASE => ERROR; IF cc.ec=NIL THEN CantHappen; IF ansiCast=NIL THEN cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, shiftPrecedence] --high for readability ELSE { cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence]; --high because we don't know what is used in the cast cc.ec ¬ C2CEmit.Cat[ansiCast, " ", cc.ec] }; }; ForceToAddressableRhs: PROC [node: Node] RETURNS [cc: CodeCont] = { <<--Use only if node.bits are well defined>> <<--Use only if node.bits>=bitsPerWord>> <<-- [lousy inconsistencies if node.bits> template: ROPE ¬ NIL; rAdj: INT ¬ 0; AllocTemplate: PROC [] = { bits: INT ¬ C2CTarget.RoundUpToWordBoundary[node.bits]; IF node.bits=0 THEN NotYetImpl; rAdj ¬ bits-node.bits; template ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, bits]; }; propMode: Mode ¬ C2CAddressing.ProposedMode[node, FALSE, FALSE, node.bits]; propAMode: C2CAddressing.AddressMode ¬ GetAMode[propMode]; propMode ¬ DSetBaseSize[propMode, node.bits]; SELECT propAMode FROM plain => { cc ¬ GenNode[node, propMode]; }; getAddr => { cc ¬ GenNode[node, propMode]; cc.ec ¬ C2CEmit.Deref[cc.ec, node.bits]; }; value => { tC: Code; cc ¬ GenNode[node, propMode]; IF cc.ec=NIL THEN CantHappen; AllocTemplate[]; tC ¬ C2CEmit.Cat[template, " = ", cc.ec, ",\n"]; tC ¬ C2CEmit.Cat[tC, C2CEmit.IdentCode[template], "\n"]; tC ¬ C2CEmit.ParentizeAndLn[tC]; cc.ec ¬ C2CEmit.SetAddressable[tC, TRUE]; }; assBitAddr => { <<--convert to right adjust (WORD) since used as value>> ac: C2CAddressing.AddressContainer ¬ C2CStateUtils.ANewBitAddress[]; propMode ¬ SetAssBitAddr[m: propMode, ac: ac]; cc ¬ GenNode[node, propMode]; AllocTemplate[]; IF rAdj#0 THEN cc.sc ¬ C2CEmit.Cat[cc.sc, "*(ptr) &", template, " = 0;\n"]; cc.sc ¬ C2CEmit.Cat[cc.sc, C2CRunTime.MoveField[ dst: [Rope.Concat["&", template], Convert.RopeFromInt[rAdj]], src: ac, bits: node.bits ], ";\n" ]; cc.ec ¬ C2CEmit.IdentCode[template]; }; getBitAddr => { <<--convert to right adjust (WORD) since used as value>> tC: Code; AllocTemplate[]; cc ¬ GenNode[node, propMode]; tC ¬ C2CRunTime.MoveField[ dst: [Rope.Concat["&", template], Convert.RopeFromInt[rAdj]], src: [ words: C2CEmit.CodeToRopeD[cc.ec], bits: IF cc.xbc=NIL THEN " 0" ELSE C2CEmit.CodeToRopeD[cc.xbc] ], bits: node.bits ]; IF rAdj#0 THEN tC ¬ C2CEmit.Cat["*(ptr) &", template, " = 0,\n", tC]; tC ¬ C2CEmit.Cat[tC, ",\n", C2CEmit.IdentCode[template]]; tC ¬ C2CEmit.ParentizeAndLn[tC]; cc.ec ¬ C2CEmit.SetAddressable[tC, TRUE]; }; assUnits => { AllocTemplate[]; propMode ¬ SetTemplate[propMode, template]; cc ¬ GenNode[node, propMode]; IF cc.ec#NIL THEN CantHappen; cc.ec ¬ C2CEmit.IdentCode[template]; }; dummy => { tC: Code; AllocTemplate[]; SELECT TRUE FROM node.bits<=C2CTarget.bitsPerWord => tC ¬ C2CEmit.Cat[template, " = 0"]; node.bits<=C2CTarget.maxWordsForInlineFillWords*C2CTarget.bitsPerWord => { tC ¬ C2CEmit.Cat[template, ".f0 = 0"]; FOR i: INT IN [1..(node.bits+C2CTarget.bitsPerWord-1)/C2CTarget.bitsPerWord) DO tC ¬ C2CEmit.Cat[tC, ",\n", template, IO.PutFR1[".f%g = 0", IO.int[i]]]; ENDLOOP }; ENDCASE => { tC ¬ C2CRunTime.FillWords[ dst: C2CEmit.Cat["&", template], times: C2CTarget.BitsToWords[node.bits], --ok to round up: did allocate template large enough value: C2CCodeUtils.ConstI[0] ]; }; tC ¬ C2CEmit.Cat[tC, ",\n", C2CEmit.IdentCode[template]]; tC ¬ C2CEmit.ParentizeAndLn[tC]; cc.ec ¬ C2CEmit.SetAddressable[tC, TRUE]; }; skip => CantHappen; ENDCASE => CaseMissing; FreeMode[propMode]; }; ForceToBitAddress: PROC [node: Node] RETURNS [cc: CodeCont] = { <<--Use only if node.bits are well defined>> <<--Use only if node.bits>=bitsPerWord>> <<-- [lousy inconsistencies if node.bits> propMode: Mode ¬ C2CAddressing.ProposedMode[node, FALSE, FALSE, node.bits]; SELECT GetAMode[propMode] FROM assBitAddr => { ac: C2CAddressing.AddressContainer ¬ C2CStateUtils.ANewBitAddress[]; propMode ¬ DSetBaseSize[propMode, node.bits]; propMode ¬ SetAssBitAddr[m: propMode, ac: ac]; cc ¬ GenNode[node, propMode]; IF cc.ec#NIL OR cc.xbc#NIL THEN CantHappen; cc.ec ¬ C2CEmit.IdentCode[ac.words]; cc.xbc ¬ C2CEmit.IdentCode[ac.bits]; }; getBitAddr => { propMode ¬ DSetBaseSize[propMode, node.bits]; cc ¬ GenNode[node, propMode]; }; ENDCASE => { cc ¬ ForceToAddressableRhs[node]; cc.ec ¬ C2CEmit.TakeAddr[cc.ec]; }; FreeMode[propMode]; }; ActualParameterList: PROC [nodeList: IntCodeDefs.NodeList, mode: Mode¬NIL, ansiCasts: LIST OF Rope.ROPE ¬ NIL] RETURNS [cc: CodeCont] = { <<--does not put paranthesis around the list>> <<--mode might be used to find out whether statement code may be generated>> count: INT ¬ 0; cc1: CodeCont; isFirst: BOOL ¬ TRUE; cast: Rope.ROPE ¬ NIL; FOR nl: IntCodeDefs.NodeList ¬ nodeList, nl.rest WHILE nl#NIL DO IF ansiCasts#NIL THEN {cast ¬ ansiCasts.first; ansiCasts ¬ ansiCasts.rest}; cc1 ¬ LoadParameter[nl.first, mode, cast]; cc.sc ¬ Cat2[cc.sc, cc1.sc]; IF isFirst THEN {cc.ec ¬ cc1.ec; isFirst ¬ FALSE} ELSE cc.ec ¬ C2CEmit.Cat[cc.ec, ", ", cc1.ec]; IF (count¬count+1)>5 AND nl.rest#NIL THEN { cc.ec ¬ C2CEmit.Cat[cc.ec, C2CEmit.line]; count ¬ 0; }; ENDLOOP; IF cc.ec#NIL THEN { cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, notExpressionPrecedence]; } }; GAppliedCodeOp: PROC [xApp: ApplyNode, codeOp: CodeOper, mode: Mode] RETURNS [cc: CodeCont] = { <<-- Fancy name for procedure call>> retName: ROPE ¬ NIL; returnBits: INT ¬ xApp.bits; procName: ROPE ¬ C2CNames.LabName[codeOp.label.id, "call"]; mode ¬ SetExpr[mode, TRUE]; IF codeOp.offset#0 THEN CantHappenCedar; --ignore direct cc ¬ ActualParameterList[xApp.args, mode]; [retName, cc.ec] ¬ CheckNCookTempReturn[xApp, cc.ec]; cc.ec ¬ C2CEmit.Cat[procName, C2CEmit.Parentize[cc.ec]]; cc ¬ FunctionResult[mode, cc, returnBits, retName]; FreeMode[mode]; }; IsConst: PROC [node: IntCodeDefs.Node] RETURNS [BOOL ¬ FALSE] = { <<--conservative>> WITH node SELECT FROM constNode: ConstNode => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; GenerateTemplate: PROC [bits: INT, global: BOOL, proposedName: ROPE¬NIL] RETURNS [name: ROPE] = { type, decl: ROPE; IF bits<=0 THEN CantHappen; IF proposedName=NIL THEN proposedName ¬ "temporary"; name ¬ C2CNames.InternalName[proposedName]; type ¬ C2CTypes.DefineType[C2CTarget.TemporaryBits[bits]]; decl ¬ Rope.Cat[type, " ", name, ";\n"]; IF global THEN C2CEmit.AppendCode[moduleDeclarations, C2CEmit.Cat["static ", decl]] ELSE C2CEmit.AppendCode[temporaryDeclarations, C2CEmit.Cat[decl]]; }; GenAllOp: PUBLIC PROC [xApp: ApplyNode, mode: Mode] RETURNS [cc: CodeCont] = { argcc: CodeCont; sc, code: Code¬NIL; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; IF xApp.bits=0 THEN CantHappen; BEGIN easyCaseAssUnits: BOOL ¬ FALSE; bits: INT ¬ xApp.bits; tBits: INT ¬ C2CTarget.TemporaryBits[bits]; fillC: Code ¬ NIL; argMode: Mode; template, destination: ROPE; cntNode: Node ¬ xApp.args.rest.first; argNode: Node ¬ xApp.args.first; times: CARD; usedArgBits: INT; simpleConst: BOOL; IF ~IsConst[cntNode] THEN CantHappenCedar; [simpleConst, times] ¬ C2CIntCodeUtils.IsSimpleConst[cntNode]; IF ~simpleConst THEN CantHappenCedar; IF GetAMode[mode]=assUnits AND tBits=bits --so template used only once-- THEN { template ¬ GetTemplate[mode]; easyCaseAssUnits ¬ TRUE; } ELSE { template ¬ GenerateTemplate[tBits, FALSE, "allTemplate"]; }; destination ¬ Rope.Concat["&", template]; IF argNode.bits=0 THEN CantHappen; IF argNode.bits<=C2CTarget.bitsPerWord THEN argMode ¬ UseValue[argNode.bits] ELSE { argMode ¬ C2CAddressing.ProposedMode[argNode, FALSE, FALSE, argNode.bits]; argMode ¬ DSetBaseSize[argMode, argNode.bits]; }; usedArgBits ¬ xApp.bits/times; IF (LOOPHOLE[bits, CARD] MOD times)#0 OR usedArgBits=0 THEN CantHappen; <<--code to prepare the template>> SELECT GetAMode[argMode] FROM value => { argcc ¬ C2CMain.GenNode[argNode, argMode]; IF usedArgBits>C2CTarget.bitsPerWord THEN {NotYetImpl} ELSE IF usedArgBits=C2CTarget.bitsPerWord THEN { IF tBits#bits THEN CantHappen; SELECT TRUE FROM times=1 => fillC ¬ C2CEmit.Cat[template, " = ", argcc.ec]; times<=8 AND INT[times]<=C2CTarget.maxWordsForInlineFillWords AND ~C2CIntCodeUtils.UseTemporaryIfReused[argNode] => { FOR i: CARD IN [1..times) DO fillC ¬ C2CEmit.Cat[fillC, ";\n", template, IO.PutFR1[".f%g = ", IO.card[i]], C2CEmit.CopyC[argcc.ec]]; ENDLOOP; fillC ¬ C2CEmit.Cat[template, ".f0 = ", argcc.ec, fillC]; }; ENDCASE => fillC ¬ C2CRunTime.FillWords[dst: C2CEmit.IdentCode[destination], times: times, value: argcc.ec]; } ELSE { offset: INT ¬ tBits-bits; fillC ¬ C2CRunTime.FillFields[ dst: [words: destination, bits: Convert.RopeFromInt[offset]], times: times, bits: usedArgBits, value: argcc.ec ]; IF offset#0 THEN { --fill left since right adjust in template! preFillC: Code; SELECT TRUE FROM tBits<=C2CTarget.bitsPerWord => preFillC ¬ C2CEmit.Cat[template, " = 0"]; offset<=C2CTarget.bitsPerWord AND tBits<=C2CTarget.maxBitsForSimpleStructs => preFillC ¬ C2CEmit.Cat[template, ".f0 = 0"]; offset<=C2CTarget.bitsPerWord => preFillC ¬ C2CEmit.Cat["*(ptr)&", template, " = 0"]; ENDCASE => preFillC ¬ C2CRunTime.FillFields[dst: [words: destination, bits: "0"], times: offset, bits: 1, value: C2CCodeUtils.ConstI[0]]; fillC ¬ C2CEmit.Cat[preFillC, ";\n", fillC]; }; }; }; plain => { IF argNode.bits<=C2CTarget.bitsPerWord THEN CantHappen; IF tBits#bits THEN CantHappen; IF (usedArgBits MOD C2CTarget.bitsPerWord)#0 THEN CantHappen; argcc ¬ C2CMain.GenNode[argNode, argMode]; fillC ¬ C2CEmit.Cat[C2CRunTime.FillLongWords[ dst: C2CEmit.IdentCode[destination], src: C2CEmit.TakeAddr[argcc.ec, TRUE], times: times, nWords: C2CTarget.BitsToWords[usedArgBits] ]]; }; assBitAddr => NotYetImpl ENDCASE => CaseMissing; cc.sc ¬ C2CEmit.Cat[cc.sc, argcc.sc, fillC, ";\n"]; <<--code to access the template>> IF ~easyCaseAssUnits THEN { cc.ec ¬ C2CEmit.IdentCode[template]; cc ¬ C2CAddressingOps.ModizeArithCode[cc, mode, xApp.bits]; }; END; }; GAppliedMesaOp: PROC [xApp: ApplyNode, mesaOp: MesaOper, mode: Mode] RETURNS [cc: CodeCont] = { cc1, cc2: CodeCont; requestedMode: Mode ¬ mode; requestedAM: C2CAddressing.AddressMode ¬ GetAMode[requestedMode]; mode ¬ SetExpr[mode]; SELECT mesaOp.mesa FROM addr => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; SELECT requestedAM FROM assUnits => { <<--optimization>> IF ContainerSize[requestedMode]#C2CTarget.bitsPerWord THEN CantHappen; mode ¬ DSetAMode[mode, assAddr]; --keep the template mode ¬ DSetBaseSize[mode, 0]; cc ¬ GenNode[node: xApp.args.first, mode: mode]; RETURN; }; getAddr, assAddr => CantHappen; ENDCASE => { <<--all cases because mode processing at the end>> getAddrMode: Mode ¬ SetAModeNC[UseValue[0], getAddr]; cc ¬ GenNode[node: xApp.args.first, mode: getAddrMode]; IF cc.ec=NIL THEN CantHappen; cc.ec ¬ C2CEmit.CastWord[cc.ec]; }; }; all => { cc ¬ GenAllOp[xApp, mode]; <<--already finished [modized]>> RETURN }; equal, notEqual => { <> left: Node ¬ xApp.args.first; right: Node ¬ xApp.args.rest.first; precision: INT ¬ mesaOp.info; IF precision=0 THEN CantHappenCedar; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; IF precision#left.bits OR precision#right.bits THEN NotYetImpl; IF precision<=C2CTarget.bitsPerWord THEN { oper: ROPE; cc ¬ LoadArithNode[node: left]; cc1 ¬ LoadArithNode[node: right]; cc.sc ¬ Cat2[cc.sc, cc1.sc]; SELECT mesaOp.mesa FROM equal => oper ¬ " == "; notEqual => oper ¬ " != "; ENDCASE => CantHappen; cc.ec ¬ C2CEmit.BinOp[cc.ec, oper, cc1.ec, equalityPrecedence]; } ELSE { nWords: INT ¬ C2CTarget.BitsToWords[precision];--rounded up propModeL: Mode ¬ C2CAddressing.ProposedMode[left, FALSE, FALSE, left.bits]; propModeR: Mode ¬ C2CAddressing.ProposedMode[right, FALSE, FALSE, right.bits]; SELECT GetAMode[propModeL] FROM assBitAddr, getBitAddr => { cc1 ¬ ForceToBitAddress[left]; } ENDCASE => { cc1 ¬ ForceToAddressableRhs[left]; cc1.ec ¬ C2CEmit.TakeAddr[cc1.ec, TRUE]; }; SELECT GetAMode[propModeR] FROM assBitAddr, getBitAddr => { cc2 ¬ ForceToBitAddress[right]; } ENDCASE => { cc2 ¬ ForceToAddressableRhs[right]; cc2.ec ¬ C2CEmit.TakeAddr[cc2.ec, TRUE]; }; cc.sc ¬ Cat2[cc1.sc, cc2.sc]; IF cc1.xbc=NIL AND cc2.xbc=NIL AND nWords*C2CTarget.bitsPerWord=precision THEN { cc.ec ¬ C2CRunTime.EqualWords[x: cc1.ec, y: cc2.ec, nWords: nWords]; } ELSE { lac: C2CAddressing.AddressContainer ¬ C2CAddressing.ACFromCodes[cc1.ec, cc1.xbc]; rac: C2CAddressing.AddressContainer ¬ C2CAddressing.ACFromCodes[cc2.ec, cc2.xbc]; cc.ec ¬ C2CRunTime.EqualFields[x: lac, y: rac, bits: precision]; }; cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, primaryPrecedence]; SELECT mesaOp.mesa FROM equal => {}; notEqual => cc.ec ¬ MakeNot[cc.ec]; ENDCASE => CantHappen; }; }; nilck => { copyC, preCode: Code ¬ NIL; useTemp: BOOL ¬ C2CIntCodeUtils.UseTemporaryIfReused[xApp.args.first]; C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; IF useTemp THEN { temp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerWord]; preCode ¬ C2CEmit.Cat[preCode, temp, " = ", cc.ec, ",\n"]; cc.ec ¬ C2CEmit.IdentCode[temp]; }; cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, unaryPrecedence]; copyC ¬ C2CEmit.CopyC[cc.ec]; <<--make nil check simply by dereferencing; nil will cause an address fault.>> cc.ec ¬ C2CEmit.Cat[ C2CEmit.CatCall[C2CStateUtils.MacroName[nilCkMacro], C2CEmit.Deref[copyC, 8]], ",\n", cc.ec ]; IF preCode#NIL THEN cc.ec ¬ C2CEmit.Cat[preCode, cc.ec]; cc.ec ¬ C2CEmit.ParentizeAndLn[cc.ec]; }; alloc => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CRunTime.ExtensionAlloc[cc.ec]; }; free => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CRunTime.ExtensionFree[cc.ec]; }; fork => { processptrcc, proccc: CodeCont; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; processptrcc ¬ LoadArithNode[node: xApp.args.first]; proccc ¬ LoadArithNode[node: xApp.args.rest.first]; cc.sc ¬ C2CEmit.Cat[ processptrcc.sc, proccc.sc, "(void) ", C2CRunTime.Fork[processptrcc.ec, proccc.ec], ";\n" ]; }; join => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadParameter[node: xApp.args.first]; cc.ec ¬ C2CRunTime.Join[cc.ec]; }; monitorEntry => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CRunTime.MonitorEntry[cc.ec]; }; monitorExit => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CRunTime.MonitorExit[cc.ec]; }; notify => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CRunTime.Notify[cc.ec]; }; broadcast => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CRunTime.Broadcast[cc.ec]; }; wait => { cond, lock: CodeCont; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; cond ¬ LoadArithNode[node: xApp.args.first]; lock ¬ LoadArithNode[node: xApp.args.rest.first]; cc.sc ¬ Cat2[cond.sc, lock.sc]; cc.ec ¬ C2CRunTime.Wait[cond.ec, lock.ec]; }; signal => { which, rtns, args: CodeCont; C2CIntCodeUtils.CheckArgCount[xApp.args, 3]; which ¬ LoadArithNode[node: xApp.args.first]; rtns ¬ LoadArithNode[node: xApp.args.rest.first]; cc.sc ¬ Cat2[which.sc, rtns.sc]; args ¬ LoadArithNode[node: xApp.args.rest.rest.first]; cc.sc ¬ Cat2[cc.sc, args.sc]; cc.ec ¬ C2CRunTime.RaiseSignal[which.ec, rtns.ec, args.ec]; }; error => { specialCased: BOOL ¬ FALSE; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; <<--Check for plain ERROR. >> <<--This is frequent enough to warrant shorter special code>> WITH xApp.args.first SELECT FROM oper: IntCodeDefs.OperNode => { WITH oper.oper SELECT FROM mesa: IntCodeDefs.MesaOper => IF mesa.mesa=unnamedError THEN { is: BOOL; val: CARD; [is, val] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.rest.first]; specialCased ¬ is AND val=0; }; ENDCASE => {}; }; ENDCASE => {}; IF specialCased THEN {cc.sc ¬ NIL; cc.ec ¬ C2CRunTime.RaiseUnnamedError[]} ELSE { which, args: CodeCont; which ¬ LoadArithNode[node: xApp.args.first]; args ¬ LoadArithNode[node: xApp.args.rest.first]; cc.sc ¬ Cat2[which.sc, args.sc]; cc.ec ¬ C2CRunTime.RaiseError[which.ec, args.ec]; }; <<--make C type correct!>> SELECT GetAMode[mode] FROM skip, assBitAddr, assUnits, assBits, assAddr => { cc.sc ¬ C2CEmit.Cat[cc.sc, "(void) ", cc.ec, ";\n"]; cc.ec ¬ NIL }; maskNShift, getAddr, getBitAddr => { cc.ec ¬ C2CEmit.ParentizeAndLn[C2CEmit.Cat[cc.ec, ", 0"]]; cc.xbc ¬ NIL; }; value, plain => { IF xApp.bits>C2CTarget.bitsPerWord THEN { name: ROPE ¬ MakeOrFindRHSDummy[xApp.bits]; fillerAddr: Code ¬ C2CEmit.PreventCastingToWord[C2CEmit.TakeAddr[C2CEmit.IdentCode[name], TRUE]]; cc.ec ¬ C2CEmit.ParentizeAndLn[C2CEmit.Cat[cc.ec, ", ", fillerAddr]]; cc.ec ¬ C2CEmit.CastRef[cc.ec, xApp.bits]; cc.ec ¬ C2CEmit.Deref[cc.ec, xApp.bits]; } ELSE { cc.ec ¬ C2CEmit.ParentizeAndLn[C2CEmit.Cat[cc.ec, ", 0"]]; }; }; ENDCASE => CaseMissing; RETURN [cc]; --don't modize twice }; unwind, resume, reject => { CantHappen; --dealt with in front end }; unnamedError, unwindError, abortedError, uncaughtError, boundsError, narrowFault, globalFrame => { CantHappen; --should never be seen applied }; startGlobal => { retpcc, modcc, argscc: CodeCont; C2CIntCodeUtils.CheckArgCount[xApp.args, 3]; retpcc ¬ LoadArithNode[node: xApp.args.first]; modcc ¬ LoadArithNode[node: xApp.args.rest.first]; argscc ¬ LoadArithNode[node: xApp.args.rest.rest.first]; cc.sc ¬ C2CEmit.Cat[ retpcc.sc, modcc.sc, argscc.sc, C2CRunTime.StartModule[retpcc.ec, modcc.ec, argscc.ec], ";\n" ]; }; copyGlobal, restartGlobal, stopGlobal, checkInit => { NotYetImpl; }; ENDCASE => CaseMissing; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; FreeMode[mode]; }; GAppliedCompareOp: PROC [xApp: ApplyNode, compOp: CompareOper, mode: Mode] RETURNS [cc: CodeCont] = { <> cc1, cc2: CodeCont; op: ROPE; precision: INT ¬ compOp.class.precision; opPrecision: INT; precedence: Precedence ¬ orderPrecedence; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; opPrecision ¬ xApp.args.first.bits; IF opPrecision#xApp.args.rest.first.bits THEN CantHappen; IF opPrecision>C2CTarget.bitsPerWord THEN { IF opPrecision#C2CTarget.bitsPerDoubleWord THEN CantHappen; cc ¬ C2CDouble.GAppliedDCompareOp[xApp, compOp, mode]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN; }; IF compOp.class.kind=real AND opPrecision=C2CTarget.bitsPerWord AND C2CSingleFloat.UseInline[] THEN { cc ¬ C2CSingleFloat.SomeFloatCompareOp[xApp, compOp]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN }; cc1 ¬ GenNodeNCast[node: xApp.args.first, class: compOp.class]; cc2 ¬ GenNodeNCast[node: xApp.args.rest.first, class: compOp.class]; cc.sc ¬ Cat2[cc1.sc, cc2.sc]; IF compOp.class.kind=real THEN { SELECT compOp.sense FROM lt => {cc.ec ¬ C2CRunTime.RealGt[cc2.ec, cc1.ec]}; le => {cc.ec ¬ C2CRunTime.RealGe[cc2.ec, cc1.ec]}; ge => {cc.ec ¬ C2CRunTime.RealGe[cc1.ec, cc2.ec]}; gt => {cc.ec ¬ C2CRunTime.RealGt[cc1.ec, cc2.ec]}; eq => {cc.ec ¬ C2CRunTime.RealEq[cc1.ec, cc2.ec]}; ne => {cc.ec ¬ MakeNot[C2CRunTime.RealEq[cc1.ec, cc2.ec]]}; ENDCASE => CaseMissing; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; } <<--use same code for signed and unsigned; there was already a cast !!>> ELSE { SELECT compOp.sense FROM eq => {op ¬ " == "; precedence ¬ equalityPrecedence}; ne => {op ¬ " != "; precedence ¬ equalityPrecedence}; lt => {op ¬ " < "}; le => {op ¬ " <= "}; ge => {op ¬ " >= "}; gt => {op ¬ " > "}; ENDCASE => CaseMissing; cc.ec ¬ C2CEmit.BinOp[cc1.ec, op, cc2.ec, precedence]; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [signed, TRUE, C2CTarget.bitsPerWord]]; }; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; }; UseReferenceCounting: PROC [] RETURNS [use: BOOL] = { <> <> RETURN [C2CAccess.params.supportReferenceCounting] }; AssignRefInline: PROC [dstPtr: Code, src: Code] RETURNS [Code] = { <> dst: Code ¬ C2CEmit.Deref[dstPtr, C2CTarget.bitsPerWord]; c: Code ¬ C2CEmit.MinPrecedence[C2CEmit.CastWord[src], assignPrecedence]; c ¬ C2CEmit.Cat[dst, " = ", c]; c ¬ C2CEmit.SetPrecedence[c, assignPrecedence]; RETURN [c] }; GAppliedCedarOp: PROC [xApp: ApplyNode, cedarOp: CedarOper, mode: Mode] RETURNS [cc: CodeCont] = { First: PROC [number: INT¬1] RETURNS [ec: Code] = { temp: CodeCont; C2CIntCodeUtils.CheckArgCount[xApp.args, number]; temp ¬ LoadArithNode[xApp.args.first]; cc.sc ¬ Cat2[cc.sc, temp.sc]; ec ¬ temp.ec; }; Second: PROC [] RETURNS [ec: Code] = { temp: CodeCont ¬ LoadArithNode[xApp.args.rest.first]; cc.sc ¬ Cat2[cc.sc, temp.sc]; ec ¬ temp.ec; }; Third: PROC [] RETURNS [ec: Code] = { temp: CodeCont ¬ LoadArithNode[xApp.args.rest.rest.first]; cc.sc ¬ Cat2[cc.sc, temp.sc]; ec ¬ temp.ec; }; WordsFromFourth: PROC [] RETURNS [words: INT] = { isConst: BOOL; constVal: CARD; [isConst, constVal] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.rest.rest.rest.first]; IF ~isConst THEN NotYetImpl; IF constVal CommonSimpleAssign[C2CRunTime.AssignRef]; simpleAssignInit => CommonSimpleAssign[C2CRunTime.AssignRefInit]; complexAssign => { IF UseReferenceCounting[] THEN { c ¬ C2CRunTime.AssignRefComposite[dst: First[4], src: Second[], type: Third[], words: WordsFromFourth[]]; } ELSE CommonComplexAssign[]; IF GetAMode[mode]#skip THEN NotYetImpl; }; complexAssignInit => { IF UseReferenceCounting[] THEN { c ¬ C2CRunTime.AssignRefCompositeInit[dst: First[4], src: Second[], type: Third[], words: WordsFromFourth[]]; } ELSE CommonComplexAssign[]; IF GetAMode[mode]#skip THEN NotYetImpl; }; new => { type: Code ¬ First[2]; nWords: Code ¬ Second[]; cc.ec ¬ C2CRunTime.NewObject[nWords: nWords, type: type]; callModize ¬ TRUE; }; code => CantHappen; narrow => { cc.ec ¬ C2CRunTime.Narrow[First[2], Second[]]; callModize ¬ TRUE; }; referentType => { cc.ec ¬ C2CRunTime.GetReferentType[First[1]]; callModize ¬ TRUE; }; procCheck => { cc.ec ¬ C2CRunTime.CheckProc[First[1]]; callModize ¬ TRUE; }; ENDCASE => CaseMissing; IF c#NIL THEN cc.sc ¬ C2CEmit.Cat[cc.sc, c, ";\n"]; IF callModize THEN cc ¬ ModizeArithCode[cc, mode, xApp.bits]; }; plusOperator: ROPE = Rope.Flatten[Rope.Concat[" + ", C2CEmit.optionalLine]]; <<--prevent too long lines>> GAppliedArithOp: PROC [xApp: ApplyNode, arithOp: ArithOper, mode: Mode] RETURNS [cc: CodeCont] = { cc1, cc2: CodeCont; precision: INT ¬ arithOp.class.precision; IF precision>C2CTarget.bitsPerWord THEN { IF precision#C2CTarget.bitsPerDoubleWord THEN CantHappen; cc ¬ C2CDouble.GAppliedDArithOp[xApp, arithOp, mode]; RETURN; }; IF precision=0 THEN CantHappenCedar; SELECT arithOp.select FROM min, max => { preCode: Code ¬ NIL; Access: PROC [arg: Node] RETURNS [c: Code ¬ NIL] = { temp: ROPE ¬ NIL; signExt: BOOL ¬ precision> WHILE args#NIL DO c2: Code ¬ Access[args.first]; SELECT precision FROM <=C2CTarget.bitsPerWord => { SELECT arithOp.class.kind FROM real => { IF arithOp.select=min THEN c ¬ C2CRunTime.RealMin[c1, c2] ELSE c ¬ C2CRunTime.RealMax[c1, c2] }; signed => { c ¬ C2CEmit.CatCall[key, "(int)(word)", ", ", c1, ", ", c2]; }; unsigned, address => { c ¬ C2CEmit.CatCall[key, C2CTarget.unsignedWordCast, ", ", c1, ", ", c2]; }; ENDCASE => CantHappenCedar; }; C2CTarget.bitsPerDoubleWord => { NotYetImpl;--the generated code is WRONG SELECT arithOp.class.kind FROM real => { IF arithOp.select=min THEN key ¬ "MINFloatD" ELSE key ¬ "MAXFloatD" }; signed => { IF arithOp.select=min THEN key ¬ "MINIntD" ELSE key ¬ "MAXIntD" }; unsigned => { IF arithOp.select=min THEN key ¬ "MINCardD" ELSE key ¬ "MAXCardD" }; ENDCASE => CantHappenCedar; c ¬ C2CEmit.CatCall[key, c1, ", ", c2]; }; ENDCASE => CantHappenCedar; args ¬ args.rest; IF args#NIL THEN { temp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.TemporaryBits[precision]]; preCode ¬ C2CEmit.Cat[preCode, temp, " = ", c, ",\n"]; c1 ¬ C2CEmit.IdentCode[temp]; }; ENDLOOP; IF preCode#NIL THEN c ¬ C2CEmit.Cat[preCode, c]; cc.ec ¬ C2CEmit.Parentize[c]; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; }; add, sub, mul, div, mod => { precedence: Precedence ¬ orderPrecedence; op: ROPE; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; IF arithOp.class.kind=real AND arithOp.class.precision=C2CTarget.bitsPerWord AND C2CSingleFloat.UseInline[] THEN { cc ¬ C2CSingleFloat.SomeFloatArithOp[xApp, arithOp, FALSE]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN }; cc1 ¬ GenNodeNCast[node: xApp.args.first, class: arithOp.class]; cc2 ¬ GenNodeNCast[node: xApp.args.rest.first, class: arithOp.class]; cc.sc ¬ Cat2[cc1.sc, cc2.sc]; SELECT arithOp.class.kind FROM real => { cc1.ec ¬ C2CEmit.MinPrecedence[cc1.ec, multiplicationPrecedence]; cc2.ec ¬ C2CEmit.MinPrecedence[cc2.ec, multiplicationPrecedence]; SELECT arithOp.select FROM add => {cc.ec ¬ C2CRunTime.RealAdd[cc1.ec, cc2.ec]}; sub => {cc.ec ¬ C2CRunTime.RealSub[cc1.ec, cc2.ec]}; mul => {cc.ec ¬ C2CRunTime.RealMul[cc1.ec, cc2.ec]}; div => {cc.ec ¬ C2CRunTime.RealDiv[cc1.ec, cc2.ec]}; mod => {NotYetImpl}; ENDCASE => CaseMissing; cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, additionPrecedence]; }; signed => { macro: ROPE ¬ C2CStateUtils.MacroName[intBinOpMacro]; op: ROPE; cc1.ec ¬ C2CEmit.MinPrecedence[cc1.ec, additionPrecedence];--the macro puts parens! cc2.ec ¬ C2CEmit.MinPrecedence[cc2.ec, additionPrecedence];--the macro puts parens! SELECT arithOp.select FROM add => op ¬ plusOperator; sub => op ¬ " - "; mul => op ¬ " * "; div => op ¬ " / "; mod => op ¬ " % "; ENDCASE => CaseMissing; cc.ec ¬ C2CEmit.CatCall[macro, op, ", ", cc1.ec, ", ", cc2.ec]; }; unsigned, address => { SELECT arithOp.select FROM <<--SPACES!! prevent tokenizing, eg: x = a/*b /* division */>> add => {op ¬ plusOperator; precedence ¬ additionPrecedence}; sub => {op ¬ " - "; precedence ¬ additionPrecedence}; mul => { <<--test whether a constant multiplication is a shift>> <<--Well, C might optimize it anyway, but in fact we did meat a >> <<--C compiler which entered an infinite loop for x*231>> isConst: BOOL; constVal: CARD; [isConst, constVal] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.first]; IF isConst THEN { cc.ec ¬ C2CCodeUtils.ConstMul[cc2.ec, constVal]; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN; }; [isConst, constVal] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.rest.first]; IF isConst THEN { cc.ec ¬ C2CCodeUtils.ConstMul[cc1.ec, constVal]; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN; }; <<--normal case>> op ¬ " * "; precedence ¬ multiplicationPrecedence }; div => { <> isConst: BOOL; constVal: CARD; [isConst, constVal] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.rest.first]; IF isConst THEN { cc.ec ¬ C2CCodeUtils.ConstDiv[cc1.ec, constVal]; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN; }; <<--normal case>> op ¬ " / "; precedence ¬ multiplicationPrecedence }; mod => { isConst: BOOL; constVal: CARD; [isConst, constVal] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.rest.first]; IF isConst THEN { cc.ec ¬ C2CCodeUtils.ConstMod[cc1.ec, constVal]; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN; }; <<--normal case>> op ¬ " % "; precedence ¬ multiplicationPrecedence }; ENDCASE => CaseMissing; cc.ec ¬ C2CEmit.BinOp[cc1.ec, op, cc2.ec, precedence]; }; ENDCASE => NotYetImpl; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; }; neg => { C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; IF arithOp.class.kind=real AND arithOp.class.precision=C2CTarget.bitsPerWord AND C2CSingleFloat.UseInline[] THEN { cc ¬ C2CSingleFloat.SomeFloatArithOp[xApp, arithOp, FALSE]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN }; cc ¬ LoadArithNode[node: xApp.args.first]; --cast inside macro [file space] cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, unaryPrecedence]; SELECT arithOp.class.kind FROM signed => { macro: ROPE ¬ C2CStateUtils.MacroName[intNegMacro]; cc.ec ¬ C2CEmit.CatCall[macro, cc.ec]; }; real => {cc.ec ¬ C2CRunTime.RealNeg[cc.ec]}; ENDCASE => NotYetImpl; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; }; abs => { preCode: Code ¬ NIL; C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; IF arithOp.class.kind=real AND arithOp.class.precision=C2CTarget.bitsPerWord AND C2CSingleFloat.UseInline[] THEN { cc ¬ C2CSingleFloat.SomeFloatArithOp[xApp, arithOp, FALSE]; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; RETURN }; cc ¬ LoadArithNode[node: xApp.args.first]; cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, unaryPrecedence]; IF C2CIntCodeUtils.UseTemporaryIfReused[xApp.args.first] THEN { <<--Value needs a temporary>> tmp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.TemporaryBits[precision]]; preCode ¬ C2CEmit.Cat[preCode, tmp, " = ", cc.ec, ",\n"]; cc.ec ¬ C2CEmit.IdentCode[tmp]; }; SELECT arithOp.class.kind FROM signed => {cc.ec ¬ C2CEmit.CatCall[C2CStateUtils.MacroName[intAbsMacro], cc.ec]}; real => {cc.ec ¬ C2CRunTime.RealAbs[cc.ec]}; ENDCASE => CaseMissing; IF preCode#NIL THEN { cc.ec ¬ C2CEmit.ParentizeAndLn[C2CEmit.Cat[preCode, cc.ec]]; }; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; }; pow => { <<--no mixed mode power operation: base and exponent of same type>> C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; cc1 ¬ GenNodeNCast[node: xApp.args.first, class: arithOp.class]; cc.sc ¬ Cat2[cc.sc, cc1.sc]; cc1.ec ¬ C2CEmit.MinPrecedence[cc1.ec, unaryPrecedence]; cc2 ¬ GenNodeNCast[node: xApp.args.rest.first, class: arithOp.class]; cc.sc ¬ Cat2[cc.sc, cc2.sc]; cc2.ec ¬ C2CEmit.MinPrecedence[cc2.ec, unaryPrecedence]; SELECT arithOp.class.kind FROM signed => { cc.ec ¬ C2CRunTime.SignedPwr[cc1.ec, cc2.ec]; }; unsigned => { is: BOOL; val: CARD; [is, val] ¬ C2CIntCodeUtils.IsSimpleConst[xApp.args.first]; IF is AND val=2 THEN { IF arithOp.class.checked THEN cc2.ec ¬ C2CEmit.CatCall[C2CStateUtils.MacroName[bckMacro], cc2.ec, ", ", C2CCodeUtils.ConstC[C2CTarget.bitsPerWord-1]]; cc.ec ¬ C2CEmit.SetPrecedence[C2CEmit.Cat[" (unsigned) 1 << ", cc2.ec], shiftPrecedence]; } ELSE { cc.ec ¬ C2CRunTime.UnsignedPwr[cc1.ec, cc2.ec]; }; }; real => { cc.ec ¬ C2CRunTime.RealPwr[cc1.ec, cc2.ec]; }; ENDCASE => CaseMissing; cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [unsigned, TRUE, C2CTarget.bitsPerWord]]; }; ENDCASE => NotYetImpl; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; }; GAppliedConvertOp: PROC [xApp: ApplyNode, convertOp: ConvertOper, mode: Mode] RETURNS [cc: CodeCont] = { ConvertUnsignedToSigned: PROC [] = { setType ¬ TRUE; <<--zero extend to make sure the C compiler doesn't complain about size problems>> cc.ec ¬ C2CEmit.PreventCastingToWord[cc.ec]; --do it myself, allways cc.ec ¬ C2CEmit.Cat[C2CTarget.unsignedWordCast, cc.ec]; IF convertOp.to.precision=convertOp.from.precision AND checked THEN { prefix, exp: Code ¬ NIL; cc.ec ¬ SignExtend[cc.ec, convertOp.from.precision, dontCare]; IF C2CIntCodeUtils.UseTemporaryIfReused[xApp.args.first] THEN { temp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerWord, "ctmp"]; prefix ¬ C2CEmit.Cat[temp, " = ", cc.ec, ",\n"]; exp ¬ C2CEmit.IdentCode[temp]; } ELSE { exp ¬ cc.ec; }; cc.ec ¬ C2CEmit.Cat[prefix, C2CEmit.CatCall[C2CStateUtils.MacroName[signCheckMacro], exp]]; cc.ec ¬ C2CEmit.ParentizeAndLn[cc.ec]; }; }; ConvertSignedToUnsigned: PROC [] = { IF checked THEN { prefix, exp: Code ¬ NIL; cc.ec ¬ SignExtend[cc.ec, convertOp.from.precision, dontCare]; setType ¬ FALSE; IF C2CIntCodeUtils.UseTemporaryIfReused[xApp.args.first] THEN { temp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerWord, "ctmp"]; prefix ¬ C2CEmit.Cat[temp, " = ", cc.ec, ",\n"]; exp ¬ C2CEmit.IdentCode[temp]; } ELSE { exp ¬ cc.ec; }; cc.ec ¬ C2CEmit.Cat[prefix, C2CEmit.CatCall[C2CStateUtils.MacroName[signCheckMacro], exp]]; cc.ec ¬ C2CEmit.ParentizeAndLn[cc.ec]; }; }; ConservativeRHSAddressable: PROC [node: Node] RETURNS [BOOL] = { mode: Mode ¬ C2CAddressing.ProposedMode[node: node, lhs: FALSE, wrongSize: FALSE, usedSz: node.bits]; SELECT GetAMode[mode] FROM plain => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; TryFastSignExtend: PROC [convertOp: ConvertOper, node: Node, mode: Mode] RETURNS [cc: CodeCont, allIsDone: BOOL ¬ FALSE] = { <> FinishUp: PROC [] = { cc.ec ¬ Cast[C2CTarget.word, cc.ec]; cc ¬ ModizeArithCode[cc, mode, convertOp.to.precision]; allIsDone ¬ TRUE; }; DirectIdxOrDeref: PROC [] = { replacement: Node; type: Rope.ROPE; IF C2CTarget.PointeeBits[node.bits]#node.bits THEN RETURN; IF ~ConservativeRHSAddressable[node] THEN RETURN; replacement ¬ IntCodeStuff.GenAddr[NARROW[node]]; cc ¬ LoadArithNode[replacement]; type ¬ SELECT TRUE FROM node.bits=C2CTarget.bitsPerHalfWord AND C2CTarget.hasHalfWords => C2CTarget.signedHalf, node.bits=8 AND C2CTarget.hasBytes => C2CTarget.signedByte, ENDCASE => ERROR CantHappen; cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence]; cc.ec ¬ C2CEmit.SetWord[cc.ec]; --avoid repeated casting cc.ec ¬ C2CEmit.Cat[" * ( (", type, "*) ", cc.ec, " )"]; cc.ec ¬ Cast[C2CTarget.signedWord, cc.ec]; FinishUp[]; }; IF ~C2CTarget.bigEndian THEN NotYetImpl; IF node.bits#convertOp.from.precision THEN { nodeBits: INT ¬ node.bits; convertOpFromBits: INT ¬ convertOp.from.precision; convertOpToBits: INT ¬ convertOp.to.precision; CantHappen; }; IF convertOp.from.kind#signed OR convertOp.to.kind#signed THEN RETURN; IF convertOp.to.precision#C2CTarget.bitsPerWord THEN RETURN; WITH node SELECT FROM var: Var => WITH var.location SELECT FROM idx: IndexedLocation => DirectIdxOrDeref[]; deref: DerefLocation => DirectIdxOrDeref[]; field: FieldLocation => { replacement: Node; subStart: INT ¬ field.start MOD C2CTarget.bitsPerWord; IF subStart#0 THEN RETURN; IF ConservativeRHSAddressable[var] THEN RETURN; replacement ¬ IF field.base.bits=C2CTarget.bitsPerWord THEN field.base ELSE IntCodeStuff.GenField[field.base, field.start, C2CTarget.bitsPerWord]; IF ~ConservativeRHSAddressable[replacement] THEN RETURN; cc ¬ LoadArithNode[replacement]; cc.ec ¬ Cast[C2CTarget.signedWord, cc.ec]; cc.ec ¬ C2CEmit.BinOp[cc.ec, " >> ", C2CCodeUtils.ConstI[C2CTarget.bitsPerWord-node.bits], shiftPrecedence]; FinishUp[]; }; ENDCASE => RETURN; ENDCASE => RETURN; }; <<-->> <<-- Thats the goal we try to program in C>> <<-- S: Signed, U: Unsigned>> <<-- LH: loophole, 0E: zero extend, SE: sign extend>> <<-- SC: sign check, performed only if convertOp.to.checked>> <<-- =: equal precision, <: increasing precision>> <<-- decreasing precision not implemented>> <<-- This is NOT used to set the right types! It is used to set the right bits!>> <<-->> <<-- | to S | to U |>> <<-- -------+-------+----------+>> <<-- from S | = LH | = LH+SC |>> <<-- | < SE | < SE+SC |>> <<-- -------+-------+----------+>> <<-- from U | = SC | = LH |>> <<-- | < 0E | < 0E |>> <<-- -------+-------+----------+>> <<-->> setType: BOOL ¬ FALSE; checked: BOOL ¬ convertOp.to.checked; C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; IF convertOp.to.precision>C2CTarget.bitsPerWord OR convertOp.from.precision>C2CTarget.bitsPerWord THEN { IF convertOp.to.precision#C2CTarget.bitsPerDoubleWord AND convertOp.from.precision#C2CTarget.bitsPerDoubleWord THEN CantHappen; cc ¬ C2CDouble.GAppliedDConvertOp[xApp, convertOp, mode]; RETURN }; IF convertOp.from.kind=signed AND convertOp.to.kind=signed AND convertOp.to.precision=C2CTarget.bitsPerWord THEN { allIsDone: BOOL; [cc, allIsDone] ¬ TryFastSignExtend[convertOp, xApp.args.first, mode]; IF allIsDone THEN RETURN; }; IF convertOp.to.precision=C2CTarget.bitsPerWord AND convertOp.from.precision=C2CTarget.bitsPerWord AND (convertOp.to.kind=real OR convertOp.from.kind=real) AND C2CSingleFloat.UseInline[] THEN { cc ¬ C2CSingleFloat.SomeFloatConvertOp[xApp, convertOp, FALSE]; cc ¬ ModizeArithCode[cc, mode, convertOp.to.precision]; RETURN }; cc ¬ LoadArithNode[xApp.args.first]; cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence]; IF convertOp.from#convertOp.to THEN { SELECT convertOp.to.kind FROM signed => SELECT convertOp.from.kind FROM signed => cc.ec ¬ SignExtend[cc.ec, convertOp.from.precision, dontCare]; unsigned => ConvertUnsignedToSigned[]; address => { IF convertOp.to.precision#convertOp.from.precision THEN NotYetImpl; IF convertOp.to.precision#C2CTarget.bitsPerWord THEN NotYetImpl; setType ¬ TRUE; } ENDCASE => CantHappenCedar; unsigned => SELECT convertOp.from.kind FROM unsigned => { toCont: INT ¬ C2CTarget.PointeeBits[convertOp.to.precision]; fromCont: INT ¬ C2CTarget.PointeeBits[convertOp.from.precision]; IF toCont>fromCont THEN { cast: Rope.ROPE ¬ SELECT toCont FROM C2CTarget.bitsPerWord => C2CTarget.unsignedWordCast, C2CTarget.bitsPerHalfWord => C2CTarget.halfWordCast, 8 => C2CTarget.byteCast, ENDCASE => ERROR CantHappen; cc.ec ¬ C2CEmit.Cat[cast, cc.ec]; cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, unaryPrecedence]; }; }; signed => ConvertSignedToUnsigned[]; address => { IF convertOp.to.precision#convertOp.from.precision THEN NotYetImpl; IF convertOp.to.precision#C2CTarget.bitsPerWord THEN NotYetImpl; }; ENDCASE => CantHappenCedar; address => SELECT convertOp.from.kind FROM unsigned => IF convertOp.to.precision#convertOp.from.precision THEN NotYetImpl; signed => IF convertOp.to.precision#convertOp.from.precision THEN NotYetImpl; ENDCASE => CantHappenCedar; real => { IF convertOp.to.precision#C2CTarget.bitsPerWord THEN NotYetImpl; SELECT convertOp.from.kind FROM signed => { cc.ec ¬ SignExtend[cc.ec, convertOp.from.precision, dontCare]; cc.ec ¬ C2CRunTime.FloatInt[cc.ec] }; unsigned => cc.ec ¬ C2CRunTime.FloatCard[cc.ec]; ENDCASE => CantHappenCedar; }; ENDCASE => CantHappenCedar; IF setType AND convertOp.to.kind=signed THEN cc.ec ¬ C2CEmit.SetArithClass[cc.ec, [signed, TRUE, C2CTarget.bitsPerWord]] }; cc ¬ ModizeArithCode[cc, mode, convertOp.to.precision]; }; UsesBoundsCheck: PROC [n: Node] RETURNS [yes: BOOL ¬ FALSE] = { Visit: IntCodeUtils.Visitor = { WITH node SELECT FROM oper: OperNode => WITH oper.oper SELECT FROM checkOp: CheckOper => yes ¬ TRUE ENDCASE => {}; ENDCASE => {}; IF ~yes THEN IntCodeUtils.MapNode[node, Visit]; RETURN [node]; }; [] ¬ Visit[n]; }; GAppliedCheckOp: PROC [xApp: ApplyNode, checkOp: CheckOper, mode: Mode] RETURNS [cc: CodeCont] = { C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; IF checkOp.class.precision>C2CTarget.bitsPerWord THEN NotYetImpl; IF checkOp.class.kind#unsigned THEN NotYetImpl; <> SELECT checkOp.sense FROM lt => { preCode: Code ¬ NIL; isconst: BOOL; val: CARD; arg: Node ¬ xApp.args.first; limit: Node ¬ xApp.args.rest.first; argcc: CodeCont ¬ GenNodeNCast[node: arg, class: checkOp.class]; IF C2CIntCodeUtils.UseTemporaryIfReused[arg] THEN { <<--Value needs a temporary>> valueTemp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, arg.bits, "idx"]; preCode ¬ C2CEmit.Cat[preCode, valueTemp, " = ", C2CEmit.CastWord[argcc.ec], ",\n"]; argcc.ec ¬ C2CEmit.IdentCode[valueTemp]; }; argcc.ec ¬ C2CEmit.MinPrecedence[argcc.ec, assignPrecedence]; cc.sc ¬ argcc.sc; [isconst, val] ¬ C2CIntCodeUtils.IsSimpleConst[limit]; IF isconst AND val = C2CTarget.firstOfINT THEN { <<--special case more efficient>> cc.ec ¬ C2CEmit.CatCall[C2CStateUtils.MacroName[signCheckMacro], argcc.ec]; } ELSE { limitcc: CodeCont ¬ GenNodeNCast[node: limit, class: checkOp.class];--unsigned anyway! limitcc.ec ¬ C2CEmit.MinPrecedence[limitcc.ec, assignPrecedence]; cc.sc ¬ Cat2[cc.sc, limitcc.sc]; IF ~IntCodeUtils.SideEffectFree[limit, TRUE] THEN { <<--Limit needs a temporary>> limitTemp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerWord, "limit"]; preCode ¬ C2CEmit.Cat[preCode, limitTemp, " = ", C2CEmit.CastWord[limitcc.ec], ",\n"]; limitcc.ec ¬ C2CEmit.IdentCode[limitTemp]; }; cc.ec ¬ C2CEmit.CatCall[C2CStateUtils.MacroName[bckMacro], argcc.ec, ", ", limitcc.ec]; }; IF preCode#NIL THEN { cc.ec ¬ C2CEmit.ParentizeAndLn[C2CEmit.Cat[preCode, cc.ec]]; }; cc ¬ ModizeArithCode[cc, mode, checkOp.class.precision]; }; ENDCASE => CaseMissing; }; GAppliedBoolOp: PROC [xApp: ApplyNode, boolOper: BooleanOper, mode: Mode] RETURNS [cc: CodeCont] = { <<--number of bits ???>> hackBool: BOOL; IF xApp.bits#1 THEN NotYetImpl; IF boolOper.class=not THEN { hackBool ¬ C2CIntCodeUtils.IsFieldVar[xApp.args.first]; C2CIntCodeUtils.CheckArgCount[xApp.args, 1]; IF hackBool THEN C2CBasics.PushContext[[$BoolBitHackOk, NIL, NIL]]; cc ¬ LoadArithNode[node: xApp.args.first]; IF hackBool THEN C2CBasics.PopContext[]; cc.ec ¬ MakeNot[cc.ec]; } ELSE { cc1, cc2: CodeCont; precedence: Precedence ¬ orderPrecedence; op: ROPE; C2CIntCodeUtils.CheckArgCount[xApp.args, 2]; hackBool ¬ C2CIntCodeUtils.IsFieldVar[xApp.args.first]; IF hackBool THEN C2CBasics.PushContext[[$BoolBitHackOk, NIL, NIL]]; cc1 ¬ LoadArithNode[node: xApp.args.first]; IF hackBool THEN C2CBasics.PopContext[]; SELECT boolOper.class FROM and => {op ¬ " && "; precedence ¬ bitAndPrecedence}; not => CantHappen; or => {op ¬ " || "; precedence ¬ bitOrPrecedence}; xor => NotYetImpl; ENDCASE => CaseMissing; hackBool ¬ C2CIntCodeUtils.IsFieldVar[xApp.args.first]; IF hackBool THEN C2CBasics.PushContext[[$BoolBitHackOk, NIL, NIL]]; cc2 ¬ LoadArithNode[node: xApp.args.rest.first]; IF hackBool THEN C2CBasics.PopContext[]; cc.sc ¬ Cat2[cc1.sc, cc2.sc]; cc.ec ¬ C2CEmit.BinOp[cc1.ec, op, cc2.ec, precedence]; cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, parenPrecedence]; }; cc ¬ ModizeArithCode[cc, mode, xApp.bits]; }; GenApplyOper: PROC [xApp: ApplyNode, operNode: OperNode, mode: Mode] RETURNS [cc: CodeCont] = { WITH operNode.oper SELECT FROM codeOp: CodeOper => cc ¬ GAppliedCodeOp[xApp: xApp, codeOp: codeOp, mode: mode]; arithOp: ArithOper => cc ¬ GAppliedArithOp[xApp: xApp, arithOp: arithOp, mode: mode]; boolOp: BooleanOper => cc ¬ GAppliedBoolOp[xApp: xApp, boolOper: boolOp, mode: mode]; convertOp: ConvertOper => cc ¬ GAppliedConvertOp[xApp: xApp, convertOp: convertOp, mode: mode]; checkOp: CheckOper => cc ¬ GAppliedCheckOp[xApp: xApp, checkOp: checkOp, mode: mode]; compOp: CompareOper => cc ¬ GAppliedCompareOp[xApp: xApp, compOp: compOp, mode: mode]; mesaOp: MesaOper => cc ¬ GAppliedMesaOp[xApp: xApp, mesaOp: mesaOp, mode: mode]; cedarOp: CedarOper => cc ¬ GAppliedCedarOp[xApp: xApp, cedarOp: cedarOp, mode: mode]; escapeOp: EscapeOper => NotYetImpl; ENDCASE => CaseMissing; }; CheckNCookTempReturn: PROC [applyNode: ApplyNode, paramCode: Code] RETURNS [tempName: ROPE¬NIL, paramC: Code] = { paramC ¬ paramCode; IF applyNode.bits>C2CTarget.maxBitsForReturns THEN { tempName ¬ DeclDummyReturnBlock[applyNode.bits]; IF applyNode.args#NIL THEN paramC ¬ C2CEmit.Cat[", ", paramC]; paramC ¬ C2CEmit.Cat["&", tempName, paramC]; }; }; globalPerModuleIncludeStuffTab: SymTab.Ref; globalPerModuleDeclaredStuffTab: SymTab.Ref; CompileNewModule: PROC [] = { globalPerModuleIncludeStuffTab ¬ NIL; globalPerModuleDeclaredStuffTab ¬ NIL; }; MakeIncludeFile: PROC [r: ROPE] = { GetIncludeTable: PROC [] RETURNS [SymTab.Ref] = { IF globalPerModuleIncludeStuffTab=NIL THEN { globalPerModuleIncludeStuffTab ¬ SymTab.Create[]; }; RETURN [globalPerModuleIncludeStuffTab]; }; tab: SymTab.Ref ¬ GetIncludeTable[]; Translator: Rope.TranslatorType = { <<--translate any line break char into \n; this is translated into right choice at emit time>> RETURN[SELECT old FROM Ascii.LF, Ascii.CR => '\n, ENDCASE => old] }; r ¬ Rope.Translate[base: r, translator: Translator]; IF Rope.Length[r]>0 AND SymTab.Insert[tab, r, NIL] THEN { place: C2CCodePlaces.CodePlace ¬ moduleHeader; includeC: Code; SELECT Rope.Fetch[r, 0] FROM '* => {includeC ¬ C2CEmit.Cat[Rope.Substr[r, 1], "\n"]; place ¬ moduleHeader}; '+ => {includeC ¬ C2CEmit.Cat[Rope.Substr[r, 1], "\n"]; place ¬ userTypeDeclaration}; ENDCASE => {includeC ¬ C2CEmit.Cat["#include ", r, "\n"]; place ¬ moduleHeader}; C2CEmit.AppendCode[place, includeC]; } }; DRAppend: PROC [list: LIST OF Rope.ROPE, r: Rope.ROPE] RETURNS [LIST OF Rope.ROPE] = { <> l: LIST OF Rope.ROPE ¬ list; IF l=NIL THEN RETURN [LIST[r]]; WHILE l.rest#NIL DO l ¬ l.rest ENDLOOP; l.rest ¬ LIST[r]; RETURN [list]; }; argumentCastPattern: Rope.ROPE = "^ArgumentCast *"; argumentCastPatternLength: INT = Rope.Length[argumentCastPattern]; FindCR: PROC [r: Rope.ROPE, fromPos: INT ¬ 0] RETURNS [INT] = { leng: INT ~ Rope.Length[r]; WHILE fromPos> <> <> <> <> <> <> <> <> <> <> <> <<<, ": prepend #include>> <<#include look in standard place>> <<#include "foo" look in exact place>> <<*: include as is in front>> <<+: include as is after types>> <<^: use complete ident to find purpose>> <<~: include .h file from standard Cedar place>> <<=: include .h file from standard xr place>> <> <"];>> RemoveSpacesFromBothEnds: PROC [line: Rope.ROPE] RETURNS [Rope.ROPE ¬ NIL] = { leng: INT ¬ Rope.Length[line]; start: INT ¬ 0; WHILE start start ¬ start+1; ENDCASE => EXIT; ENDLOOP; WHILE leng>start DO SELECT Rope.Fetch[line, leng-1] FROM Ascii.SP, Ascii.TAB => leng ¬ leng-1; ENDCASE => EXIT; ENDLOOP; IF leng>start THEN RETURN [Rope.Substr[line, start, leng-start]]; }; contents: ROPE ¬ RemoveSpacesFromBothEnds[mc]; leng: INT ¬ Rope.Length[contents]; dotPos, procPos: INT; DO IF leng<=0 THEN FatalError["empty machine code procedure"]; SELECT Rope.Fetch[contents, 0] FROM '^ => { SELECT TRUE FROM Rope.Equal[Rope.Substr[contents, 0, 14], "^ExternalNames", FALSE] => RETURN; --already handled in C2CNamesImpl Rope.Match[pattern: argumentCastPattern, object: contents, case: FALSE] => { ansiHeader: Rope.ROPE; pos: INT ¬ FindCR[contents, argumentCastPatternLength]; IF pos>=leng THEN C2CBasics.FatalError["bad machine code"]; ansiHeader ¬ Rope.Substr[contents, argumentCastPatternLength-1, pos-argumentCastPatternLength+1]; contents ¬ Rope.Substr[contents, pos+1]; leng ¬ Rope.Length[contents]; ansiCasts ¬ DRAppend[ansiCasts, ansiHeader]; }; ENDCASE => C2CBasics.FatalError["unknown ^ in machine code"]; }; ENDCASE => {EXIT}; ENDLOOP; dotPos ¬ Rope.FindBackward[contents, "."]; procPos ¬ dotPos+1; IF dotPos>0 THEN { PrefixLine: PROC [prefix: ROPE] = { IF Rope.IsEmpty[prefix] THEN RETURN; SELECT Rope.Fetch[prefix, 0] FROM '", '<, '*, '+ => {}; '~ => { prefix ¬ Rope.Cat[""] }; '= => { prefix ¬ Rope.Cat[""] }; ENDCASE => prefix ¬ Rope.Cat[""]; MakeIncludeFile[prefix]; }; IF Rope.Fetch[contents, 0]#'% THEN PrefixLine[Rope.Substr[base: contents, start: 0, len: dotPos]] ELSE { rest: ROPE ¬ Rope.Substr[base: contents, start: 1, len: dotPos-1]; WHILE ~Rope.IsEmpty[rest] DO n: INT ¬ Rope.SkipTo[s: rest, skip: "\n\l\r"]; IF n>0 THEN PrefixLine[Rope.Substr[base: rest, start: 0, len: n]]; IF n>=Rope.Length[rest] THEN rest ¬ NIL ELSE rest ¬ Rope.Substr[base: rest, start: n+1]; ENDLOOP; }; }; DO IF procPos>=leng THEN EXIT; SELECT Rope.Fetch[contents, procPos] FROM '$ => {parens ¬ FALSE; procPos ¬ procPos+1}; '& => {forgetVoid ¬ TRUE; procPos ¬ procPos+1}; '@ => {forgetVoid ¬ TRUE; parens ¬ FALSE; procPos ¬ procPos+1}; '! => {declare ¬ TRUE; procPos ¬ procPos+1}; ': => {procPos ¬ procPos+1; EXIT}; ENDCASE => EXIT; ENDLOOP; IF procPos{ SELECT GetAMode[mode] FROM skip => { IF cc.ec#NIL THEN { IF ~forgetVoid THEN cc.ec ¬ C2CEmit.Cat["(void) ", cc.ec]; cc.sc ¬ C2CEmit.Cat[cc.sc, cc.ec, ";\n"]; }; cc.ec ¬ NIL; }; ENDCASE => CantHappen; }; returnBits<=C2CTarget.bitsPerWord => { cc.ec ¬ C2CEmit.CastWord[cc.ec]; cc ¬ ModizeArithCode[cc, mode, returnBits]; }; returnBits>C2CTarget.bitsPerWord => { cc ¬ ModizeArithCode[cc, mode, returnBits]; }; ENDCASE => CaseMissing; }; GenApplyNode: PUBLIC PROC [applyNode: ApplyNode, mode: Mode] RETURNS [cc: CodeCont] = { hsc, preCode, postCode: Code ¬ NIL; returnBits: INT ¬ applyNode.bits; IF applyNode.handler#NIL THEN C2CEnables.IncEnableNesting[]; WITH applyNode.proc SELECT FROM operNode: OperNode => { cc ¬ GenApplyOper[xApp: applyNode, operNode: operNode, mode: mode]; }; machineCodeNode: MachineCodeNode => { procName: ROPE; parens, declare, forgetVoid: BOOL; ansiCasts: LIST OF Rope.ROPE; [procName, parens, declare, forgetVoid, ansiCasts] ¬ PreprocessMachineCode[machineCodeNode.bytes]; IF Rope.IsEmpty[procName] THEN { IF returnBits#0 OR applyNode.args#NIL THEN FatalError["empty machine code procedure"]; } ELSE { proc: Code ¬ C2CEmit.IdentCode[procName]; cc ¬ ActualParameterList[nodeList: applyNode.args, mode: mode, ansiCasts: ansiCasts]; IF parens THEN cc.ec ¬ C2CEmit.Parentize[cc.ec]; cc.ec ¬ C2CEmit.Cat[proc, cc.ec]; cc ¬ FunctionResult[mode, cc, returnBits, NIL, forgetVoid]; IF declare THEN { GetDeclareTable: PROC [] RETURNS [tab: SymTab.Ref] = { IF globalPerModuleDeclaredStuffTab=NIL THEN globalPerModuleDeclaredStuffTab ¬ SymTab.Create[]; RETURN [globalPerModuleDeclaredStuffTab] }; tab: SymTab.Ref ¬ GetDeclareTable[]; WITH SymTab.Fetch[tab, procName].val SELECT FROM ri: REF INT => IF ri­#returnBits THEN FatalError["contradicting machine code declarations"]; ENDCASE => { type: ROPE ¬ IF returnBits>0 THEN C2CTypes.DefineType[returnBits] ELSE "void"; c: Code ¬ C2CEmit.Cat["extern ", type, " ", procName]; IF parens THEN c ¬ C2CEmit.Cat[c, "()"]; c ¬ C2CEmit.Cat[c, ";\n"]; C2CEmit.AppendCode[moduleDeclarationsP, c]; [] ¬ SymTab.Insert[tab, procName, NEW[INT ¬ returnBits]]; }; }; }; }; ENDCASE => { <<--call a procedure descriptor>> retName: ROPE ¬ NIL; descAccessC, procC, paramC, callC: Code ¬ NIL; proccc, paramcc: CodeCont; separator: ROPE ¬ IF ExpMode[mode] THEN ", " ELSE "; "; proccc ¬ LoadArithNode[applyNode.proc]; procC ¬ C2CEmit.MinPrecedence[proccc.ec, identPrecedence]; cc.sc ¬ proccc.sc; IF C2CIntCodeUtils.UseTemporaryIfReused[applyNode.proc] THEN { descC: Code ¬ C2CEmit.IdentCode[C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerWord, "pd"]]; cc.sc ¬ C2CEmit.Cat[cc.sc, C2CEmit.CopyC[descC], " = ", C2CEmit.CastWord[procC], ";\n"]; procC ¬ descC; }; descAccessC ¬ C2CEmit.Parentize[ C2CEmit.Deref[C2CEmit.CopyC[procC], C2CTarget.bitsPerWord] ]; paramcc ¬ ActualParameterList[nodeList: applyNode.args, mode: mode]; cc.sc ¬ Cat2[cc.sc, paramcc.sc]; [retName, paramC] ¬ CheckNCookTempReturn[applyNode, paramcc.ec]; <<--include an additional descriptor parameter [which is ignored except>> <<--for intermediate level procedures] >> paramC ¬ IF applyNode.args#NIL OR retName#NIL THEN C2CEmit.Cat[paramC, ", ", procC] ELSE procC; cc.ec ¬ C2CEmit.Cat["( *(", C2CTypes.DefineFTypeCast[], descAccessC, "))"]; cc.ec ¬ C2CEmit.Cat[cc.ec, C2CEmit.Parentize[paramC]]; cc ¬ FunctionResult[mode, cc, returnBits, retName]; }; IF applyNode.handler#NIL THEN { IF cc.ec#NIL THEN CantHappen; C2CEnables.DecEnableNesting[]; [hsc, preCode, postCode] ¬ GenHandlerNode[handler: applyNode.handler, mode: mode, innerIsLive: ~C2CEmit.GetIsDead[cc.sc]]; cc.sc ¬ C2CEmit.Cat[hsc, preCode, cc.sc, postCode]; }; }; GenHandlerNode: PUBLIC PROC [handler: Handler, mode: Mode, innerIsLive: BOOL ¬ TRUE] RETURNS [sc, preCode, postCode: Code¬NIL] = { contextcc: CodeCont; IF handler#NIL THEN { enableCall: Code; IF handler.context=NIL THEN contextcc.ec ¬ C2CEmit.IdentCode["0"] ELSE contextcc ¬ C2CMain.GenNode[node: handler.context, mode: UseValue[handler.context.bits]]; sc ¬ contextcc.sc; IF handler.proc=NIL THEN { IF handler.context=NIL THEN CantHappen; enableCall ¬ C2CRunTime.PushHandler[contextcc.ec, C2CEmit.IdentCode["0"]]; preCode ¬ C2CEmit.Cat[enableCall, ";\n"]; postCode ¬ C2CEmit.Cat[C2CRunTime.PopHandler[], ";\n"]; } ELSE WITH handler.proc SELECT FROM gotoNode: GotoNode => { EachUpLabel: IntToIntTab.EachPairAction = { labelName: ROPE ¬ C2CNames.LabName[key, "uplabel"]; IF IntToIntTab.Fetch[myOwnLabels.definedLabels, key].found THEN { <<--jump into this procedure>> code: Code ¬ C2CEmit.Cat[C2CRunTime.PopHandler[], "; goto ", labelName, ";\n"]; FOR i: INT IN [0..C2CEnables.PopsForJump[key]) DO code ¬ C2CEmit.Cat[C2CRunTime.PopHandler[], ";\n", code]; ENDLOOP; code ¬ C2CEmit.Cat[C2CEmit.nest, code, C2CEmit.unNest]; postCode ¬ C2CEmit.Cat[postCode, IO.PutFR1["case %g: ", IO.int[val]], code]; RETURN; }; IF myOwnLabels.purposeOfLambda=enableHandler AND IntToIntTab.Fetch[myOwnLabels.upLabels, key].found THEN { <<--jump one more level up>> retCode: INT ¬ IntToIntTab.Fetch[myOwnLabels.upLabels, key].val; name: ROPE; code: Code; WITH C2CBasics.labelWithLambda.label.node SELECT FROM lambdaNode: LambdaNode => { arg: Var; formalArgs: VarList ~ lambdaNode.formalArgs; IF formalArgs=NIL THEN CantHappen; arg ¬ formalArgs.first; IF arg.bits#C2CTarget.bitsPerWord THEN CantHappen; IF arg.id=nullVariableId THEN CantHappen; name ¬ C2CNames.VarName[id: arg.id, class: "var"]; }; ENDCASE => CantHappen; code ¬ C2CEmit.Cat[C2CRunTime.PopHandler[], ";\n"]; code ¬ C2CEmit.Cat[code, "* ((ptr)", name, ") = 2; /*exit*/\n"]; code ¬ C2CEmit.Cat[code, "* (((ptr)", name, ")+1) = "]; code ¬ C2CEmit.Cat[code, Convert.RopeFromInt[retCode], "; /*", labelName, "*/\n"]; code ¬ C2CEmit.Cat[code, "return;\n"]; FOR i: INT IN [0..C2CEnables.PopsForReturns[]) DO code ¬ C2CEmit.Cat[C2CRunTime.PopHandler[], ";\n", code]; ENDLOOP; code ¬ C2CEmit.Cat[C2CEmit.nest, code, C2CEmit.unNest]; postCode ¬ C2CEmit.Cat[postCode, IO.PutFR1["case %g: ", IO.int[val]], code]; RETURN; }; CantHappen; }; myOwnLabels: C2CEnables.LabelUsage ¬ C2CEnables.LambdaLabelUsage[C2CBasics.labelWithLambda.label.id]; handlerLabels: C2CEnables.LabelUsage ¬ C2CEnables.LambdaLabelUsage[gotoNode.dest.id]; handlerName: ROPE ¬ C2CNames.LabName[gotoNode.dest.id, "handler"]; handlerAdr: ROPE ¬ C2CStateUtils.DefineProcDesc[handlerName]; enableCall ¬ C2CRunTime.PushHandler[contextcc.ec, C2CEmit.IdentCode[handlerAdr]]; IF handlerLabels=NIL OR handlerLabels.purposeOfLambda#enableHandler OR gotoNode.backwards THEN CantHappenCedar; preCode ¬ C2CEmit.Cat["switch (", enableCall, ") { ", C2CEmit.nest]; preCode ¬ C2CEmit.Cat[preCode, "\ncase 0: ", C2CEmit.nest]; IF innerIsLive THEN postCode ¬ C2CEmit.Cat[C2CRunTime.PopHandler[], "; break;\n"]; postCode ¬ C2CEmit.Cat[postCode, C2CEmit.unNest]; [] ¬ IntToIntTab.Pairs[handlerLabels.upLabels, EachUpLabel]; IF checkForAbstractionFaults THEN postCode ¬ C2CEmit.Cat[postCode, "default: ", C2CRunTime.RaiseAbstractionFault[], ";\n"]; postCode ¬ C2CEmit.Cat[postCode, "};\n", C2CEmit.unNest] }; commentNode: CommentNode => { preCode ¬ C2CEmit.Cat[C2CEmit.CComment[commentNode.bytes]]; postCode ¬ NIL; }; ENDCASE => CantHappenCedar; }; }; C2CBasics.CallbackWhenC2CIsCalled[CompileNewModule]; END.