C2CAppliesImpl.mesa
Copyright Ó 1987, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, 1987
Christian Jacobi, April 20, 1993 1:59 pm PDT
JKF July 28, 1988 4:43:06 pm PDT
Willie-s, September 24, 1991 6:07 pm PDT
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;
Utilities
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];
};
Macros
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
IF ~C2CTarget.rightShiftSignedIsOk THEN NotYetImpl;
"(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;
};
Syntactical procs
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<bitsPerWord; size of templates...]
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<bitsPerWord; size of templates...]
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 => {
There is also an arithmetic operator for compare !
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] = {
There is also a mesa operator for compare !
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] = {
Find out whether the ref counting primitives ought to be used.
Sorry, we put the burden inside here instead of C2CRuntime because that allows ommiting the typecodes.
RETURN [C2CAccess.params.supportReferenceCounting]
};
AssignRefInline: PROC [dstPtr: Code, src: Code] RETURNS [Code] = {
Generats code for "dstPtr^ ← src"
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<C2CTarget.bitsPerWord OR (constVal MOD C2CTarget.bitsPerWord)#0 THEN
CantHappenCedar;
words ¬ constVal/C2CTarget.bitsPerWord;
};
CommonSimpleAssign: PROC [rtProc: PROC [dstPtr: Code, src: Code] RETURNS [Code]] = {
dstC: Code ¬ First[2];
srcC: Code ¬ Second[];
srcNode: Node ¬ xApp.args.rest.first;
IF ~UseReferenceCounting[] THEN rtProc ¬ AssignRefInline;
IF GetAMode[mode]=skip THEN c ¬ rtProc[dstC, srcC]
ELSE {
preCode, copySourceC: Code ¬ NIL;
IF C2CIntCodeUtils.UseTemporaryIfReused[srcNode] THEN {
temp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.TemporaryBits[srcNode.bits]];
preCode ¬ C2CEmit.Cat[temp, " = ", srcC, ",\n"];
srcC ¬ C2CEmit.IdentCode[temp];
};
copySourceC ¬ C2CEmit.CopyC[srcC];
cc.ec ¬ C2CEmit.Cat[rtProc[dstC, srcC], ",\n", copySourceC];
IF preCode#NIL THEN {
cc.ec ¬ C2CEmit.Cat[preCode, cc.ec];
cc.ec ¬ C2CEmit.ParentizeAndLn[cc.ec];
};
callModize ¬ TRUE;
};
};
CommonComplexAssign: PROC [] = {
c ¬ C2CRunTime.MoveWords[dst: First[4], src: Second[], nWords: WordsFromFourth[]];
};
callModize: BOOL ¬ FALSE;
c: Code ¬ NIL;
SELECT cedarOp.cedar FROM
simpleAssign => 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<C2CTarget.bitsPerWord AND arithOp.class.kind=signed;
useTemp: BOOL ¬ signExt OR C2CIntCodeUtils.UseTemporaryIfReused[arg];
cc2: CodeCont ¬ LoadArithNode[arg];
cc.sc ¬ Cat2[cc.sc, cc2.sc];
c ¬ C2CEmit.MinPrecedence[cc2.ec, assignPrecedence];
IF useTemp THEN {
temp: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.TemporaryBits[precision]];
IF signExt THEN c ¬ SignExtend[c, precision, dontCare];
preCode ¬ C2CEmit.Cat[preCode, temp, " = ", c, ",\n"];
c ¬ C2CEmit.IdentCode[temp];
};
c ¬ C2CEmit.MinPrecedence[c, unaryPrecedence];
};
cnt: INT ¬ C2CIntCodeUtils.CountNodes[xApp.args];
key: ROPE ¬ IF arithOp.class.kind=real THEN NIL ELSE
IF arithOp.select=min
THEN C2CStateUtils.MacroName[minMacro]
ELSE C2CStateUtils.MacroName[maxMacro];
args: NodeList ¬ xApp.args;
c1, c: Code;
IF precision=C2CTarget.bitsPerWord AND arithOp.class.kind=real AND C2CSingleFloat.UseInline[] THEN {
cc ¬ C2CSingleFloat.SomeFloatArithOp[xApp, arithOp, FALSE];
cc ¬ ModizeArithCode[cc, mode, xApp.bits];
RETURN
};
IF cnt<2 THEN CantHappen;
c1 ¬ Access[args.first];
args ¬ args.rest;
--we could improve this by not simply using a linear list
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 => {
prevent C compiuler bug, as for multiplication
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] = {
If we are masking out a left adjusted field and then sign extend it, it might be faster to do this in one step instead of separately.
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;
we have only a procedure for unsigned now
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] = {
Destructive append rope to end of list of 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<leng AND Rope.Fetch[r, fromPos]#Ascii.LF DO
fromPos ¬ fromPos+1
ENDLOOP;
RETURN [fromPos];
};
PreprocessMachineCode: PROC [mc: ROPE] RETURNS [proc: ROPE ¬ NIL, parens: BOOL ¬ TRUE, declare: BOOL ¬ FALSE, forgetVoid: BOOL ¬ FALSE, ansiCasts: LIST OF Rope.ROPE ¬ NIL] = {
Current syntax:
machineCode ::= prefix "." useName | useName.
useName ::= {letterExceptDot}.
prefix ::= "%" {sep {sep} prefixPart} {sep} | prefixPart.
prefixPart := "<" letters | """" letters | "*" letters | "+" letters | letters.
letters ::= {letter}.
letterExceptDot ::=
letter ::=
sep ::= "/n" | "/r" | "/l".
Meaning:
prefixPart:
is included just once
<, ": prepend #include
#include <foo> 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
other: [think modulename]: make include .h file from standard Cedar place
standard Cedar place: Rope.Cat["<cedar/", other, ".h>"];
RemoveSpacesFromBothEnds: PROC [line: Rope.ROPE] RETURNS [Rope.ROPE ¬ NIL] = {
leng: INT ¬ Rope.Length[line];
start: INT ¬ 0;
WHILE start<leng DO
SELECT Rope.Fetch[line, start] FROM
Ascii.SP, Ascii.TAB => 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["<cedar/", Rope.Substr[prefix, 1], ".h>"]
};
'= => {
prefix ¬ Rope.Cat["<xr/", Rope.Substr[prefix, 1], ".h>"]
};
ENDCASE => prefix ¬ Rope.Cat["<cedar/", prefix, ".h>"];
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<leng THEN proc ¬ Rope.Substr[base: contents, start: procPos];
};
FunctionResult: PROC [mode: Mode, ccIn: CodeCont, returnBits: INT, tempRetName: ROPE, forgetVoid: BOOL ¬ FALSE] RETURNS [cc: CodeCont] = {
cc ¬ ccIn;
cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, primaryPrecedence];
IF tempRetName#NIL THEN {
IF cc.ec#NIL THEN {
IF ~forgetVoid THEN cc.ec ¬ C2CEmit.Cat["(void) ", cc.ec];
cc.sc ¬ C2CEmit.Cat[cc.sc, cc.ec, ";\n"];
};
IF GetAMode[mode]=skip
THEN cc.ec ¬ NIL
ELSE cc.ec ¬ C2CEmit.IdentCode[tempRetName];
};
SELECT TRUE FROM
returnBits=0 =>{
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.