DIRECTORY
C2CAccess,
C2CAddressing,
C2CAddressingOps,
C2CBasics,
C2CCodePlaces,
C2CDefs,
C2CEmit,
C2CIntCodeUtils,
C2CMain,
C2CMode,
C2CNames,
C2CRunTime,
C2CSingleFloat,
C2CStateUtils,
C2CTarget,
IntCodeDefs, 
Rope;

C2CSingleFloatImpl: CEDAR PROGRAM
IMPORTS C2CAccess, C2CAddressingOps, C2CBasics, C2CEmit, C2CIntCodeUtils, C2CNames, C2CStateUtils, C2CTarget, Rope
EXPORTS C2CSingleFloat =
BEGIN
OPEN IntCodeDefs, C2CAddressingOps, C2CDefs, C2CMain, C2CMode;

ROPE: TYPE = Rope.ROPE;
TrialCC: TYPE = RECORD [
ok: BOOL,
cc: CodeCont
];
fail: TrialCC = [FALSE, [NIL, NIL, NIL]];

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]]
};

UseInline: PUBLIC PROC [] RETURNS [BOOL] = {
RETURN [C2CAccess.params.supportInlineFloatingPoint]
};

GoodToUseFloatType: PUBLIC PROC [n: IntCodeDefs.Node] RETURNS [BOOL¬FALSE] = {
IF n.bits#C2CTarget.bitsPerWord THEN RETURN;
WITH n SELECT FROM
applyNode: ApplyNode => 
WITH applyNode.proc SELECT FROM
operNode: OperNode => 
WITH operNode.oper SELECT FROM
arithOp: ArithOper => 
IF arithOp.class.precision=C2CTarget.bitsPerWord AND arithOp.class.kind=real THEN
SELECT arithOp.select FROM
add, sub, mul, div, mod, neg => RETURN [TRUE];
ENDCASE => {};
ENDCASE => {};
ENDCASE => {};
ENDCASE => {};
};

TryLoadNodeAsFloat: PROC [node: Node] RETURNS [tc: TrialCC ¬ fail] = {
IF node.bits#C2CTarget.bitsPerWord THEN RETURN;
WITH node SELECT FROM
applyNode: ApplyNode => 
WITH applyNode.proc SELECT FROM
operNode: OperNode => tc ¬ TryApplyOperAsFloat[applyNode, operNode];
ENDCASE => {};
ENDCASE => {};
};

TryApplyOperAsFloat: PROC [xApp: ApplyNode, operNode: OperNode] RETURNS [tc: TrialCC ¬ fail] = {
WITH operNode.oper SELECT FROM
arithOp: ArithOper => {
IF arithOp.class.precision#C2CTarget.bitsPerWord THEN RETURN;
IF arithOp.class.kind#real THEN RETURN;
SELECT arithOp.select FROM
add, sub, mul, div, mod, neg, abs, min, max => {
tc.cc ¬ SomeFloatArithOp[xApp, arithOp, TRUE];
tc.ok ¬ TRUE;
};
ENDCASE => {};
};
convertOp: ConvertOper => {
IF convertOp.from.precision#C2CTarget.bitsPerWord THEN RETURN;
IF convertOp.to.precision#C2CTarget.bitsPerWord THEN RETURN;
IF convertOp.to.kind#real THEN RETURN;
tc.cc ¬ SomeFloatConvertOp[xApp, convertOp, TRUE];
tc.ok ¬ TRUE;
};
ENDCASE => {};
};

FPTemporary: PROC [] RETURNS [name: Rope.ROPE] = {
name ¬ C2CNames.InternalName["tf"];
C2CEmit.AppendCode[temporaryDeclarations, C2CEmit.Cat["float ", name, ";\n"]];
};

LoadAsFloat: PUBLIC PROC [node: IntCodeDefs.Node, simple: BOOL ¬ FALSE] RETURNS [cc: CodeCont] = {
tc: TrialCC;
IF node.bits#C2CTarget.bitsPerWord THEN ERROR C2CBasics.CantHappen;
tc ¬ TryLoadNodeAsFloat[node];
IF tc.ok 
THEN {
cc ¬ tc.cc;
IF simple THEN  cc ¬ ForceAFloatTemporary[cc];
}
ELSE {
cc ¬ LoadArithNode[node];
IF simple AND C2CEmit.GetAddressable[cc.ec] AND C2CIntCodeUtils.UseTemporaryIfReused[node] 
THEN {
cc.ec ¬ C2CEmit.Cat[" *(float*) ", C2CEmit.TakeAddr[cc.ec, TRUE]];
cc ¬ ForceAFloatTemporary[cc];
}
ELSE {
cc.ec ¬ LoopholeWordWithTemporary[cc.ec, wordToFloat]; 
};
};
};

LoopholeTarget: TYPE = {floatToWord, wordToFloat};
LoopholeWordWithTemporary: PROC [c: Code, direction: LoopholeTarget] RETURNS [Code] = {
temp, into: ROPE;
IF direction=floatToWord 
THEN {
into ¬ C2CTarget.word; 
temp ¬ FPTemporary[];
}
ELSE {
into ¬ "float";
temp ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerWord];
};
c ¬ C2CEmit.MinPrecedence[c, assignPrecedence];
c ¬ C2CEmit.Cat[temp, " = ", c, ",  *("];
c ¬ C2CEmit.Cat[c, into, "*)&", temp];
RETURN [ C2CEmit.ParentizeAndLn[c] ];
};

LoopholeWord: PROC [c: Code, direction: LoopholeTarget] RETURNS [Code] = {
IF C2CEmit.GetAddressable[c] 
THEN {
into: ROPE ¬ IF direction=floatToWord THEN C2CTarget.word ELSE "float";
c ¬ C2CEmit.Cat["*(", into, "*)", C2CEmit.TakeAddr[c, TRUE]];
c ¬ C2CEmit.SetPrecedence[c, unaryPrecedence];
}
ELSE {
c ¬ LoopholeWordWithTemporary[c, direction];
};
RETURN [c];
};

SomeFloatCompareOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, compOp: IntCodeDefs.CompareOper] RETURNS [cc: C2CMain.CodeCont] = {
cc1, cc2: CodeCont; op: ROPE;
precedence: Precedence ¬ orderPrecedence; 
precision: INT ¬ compOp.class.precision;
IF precision#C2CTarget.bitsPerWord THEN C2CBasics.CantHappen;
IF compOp.class.kind#real THEN C2CBasics.CantHappen;
IF precision<xApp.args.first.bits OR precision<xApp.args.rest.first.bits THEN C2CBasics.CantHappen;
C2CIntCodeUtils.CheckArgCount[xApp.args, 2];
cc1 ¬ LoadAsFloat[node: xApp.args.first];
cc2 ¬ LoadAsFloat[node: xApp.args.rest.first];
cc.sc ¬ Cat2[cc1.sc, cc2.sc];
cc1.ec ¬ C2CEmit.MinPrecedence[cc1.ec, additionPrecedence];
cc2.ec ¬ C2CEmit.MinPrecedence[cc2.ec, additionPrecedence];
SELECT compOp.sense FROM
lt => {op ¬ " < "};
le => {op ¬ " <= "};
ge => {op ¬ " >= "};
gt => {op ¬ " > "};
eq => {op ¬ " == "; precedence ¬ equalityPrecedence};
ne => {op ¬ " != "; precedence ¬ equalityPrecedence};
ENDCASE => C2CBasics.CaseMissing;
cc.ec ¬ C2CEmit.BinOp[cc1.ec, op, cc2.ec, precedence];
};

SomeFloatConvertOp: PUBLIC PROC [xApp: ApplyNode, convertOp: ConvertOper, leaveFloat: BOOL ¬ FALSE] RETURNS [cc: CodeCont] = {
cc1, cc2: CodeCont;
IF convertOp.to.precision#C2CTarget.bitsPerWord THEN C2CBasics.CantHappen;
IF convertOp.from.precision#C2CTarget.bitsPerWord THEN C2CBasics.CantHappen;
SELECT convertOp.to.kind FROM
signed, unsigned, address => {
IF convertOp.from.kind#real THEN C2CBasics.CantHappen;
cc ¬ LoadAsFloat[xApp.args.first];
cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence];
SELECT convertOp.to.kind FROM
signed => cc.ec ¬ C2CEmit.Cat["(int)", cc.ec];
unsigned => cc.ec ¬ C2CEmit.Cat["(unsigned)", cc.ec];
ENDCASE => C2CBasics.CantHappen;
cc.ec ¬ C2CEmit.CastWord[cc.ec];
};
real => {
cc ¬ LoadArithNode[xApp.args.first];
cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence];
SELECT convertOp.from.kind FROM
signed => cc.ec ¬ C2CEmit.Cat["(float)(int)", cc.ec];
unsigned, address => cc.ec ¬ C2CEmit.Cat["(float)(unsigned)", cc.ec];
ENDCASE => C2CBasics.CantHappen;
cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, unaryPrecedence];
IF ~leaveFloat THEN cc.ec ¬ LoopholeWord[cc.ec, floatToWord];
};
ENDCASE => C2CBasics.CantHappen;
};

ForceAFloatTemporary: PROC [cc: CodeCont] RETURNS [CodeCont] = {
name: Rope.ROPE ¬ FPTemporary[];
cc.sc ¬ C2CEmit.Cat[cc.sc, name, " = ", cc.ec, ";\n"];
cc.ec ¬ C2CEmit.IdentCode[name];
RETURN [cc];
};

SomeFloatArithOp: PUBLIC PROC [xApp: ApplyNode, arithOp: ArithOper, leaveFloat: BOOL ¬ FALSE] RETURNS [cc: CodeCont] = {
cc1, cc2: CodeCont;
IF arithOp.class.precision#C2CTarget.bitsPerWord THEN C2CBasics.CantHappen;
IF arithOp.class.kind#real THEN C2CBasics.CantHappen;
SELECT arithOp.select FROM
add, sub, mul, div, mod => {
C2CIntCodeUtils.CheckArgCount[xApp.args, 2];
cc1 ¬ LoadAsFloat[node: xApp.args.first];
cc2 ¬ LoadAsFloat[node: xApp.args.rest.first];
cc.sc ¬ Cat2[cc1.sc, cc2.sc];
cc1.ec ¬ C2CEmit.MinPrecedence[cc1.ec, multiplicationPrecedence];
cc2.ec ¬ C2CEmit.MinPrecedence[cc2.ec, multiplicationPrecedence];
SELECT arithOp.select FROM
add => {cc.ec ¬ C2CEmit.Cat[cc1.ec, " + ", cc2.ec]};
sub => {cc.ec ¬ C2CEmit.Cat[cc1.ec, " - ", cc2.ec]};
mul => {cc.ec ¬ C2CEmit.Cat[cc1.ec, " * ", cc2.ec]};
div => {cc.ec ¬ C2CEmit.Cat[cc1.ec, " / ", cc2.ec]};
ENDCASE => C2CBasics.CaseMissing;
cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, additionPrecedence];
};
neg => {
C2CIntCodeUtils.CheckArgCount[xApp.args, 1];
cc ¬ LoadAsFloat[node: xApp.args.first];
cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, unaryPrecedence];
cc.ec ¬ C2CEmit.Cat[" - ", cc.ec];
cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, additionPrecedence];
};
abs => {
tempName: Rope.ROPE ¬ FPTemporary[];
C2CIntCodeUtils.CheckArgCount[xApp.args, 1];
cc ¬ LoadAsFloat[xApp.args.first];
cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, unaryPrecedence];
cc.ec ¬ C2CEmit.CatCall[C2CStateUtils.MacroName[floatAbsMacro], cc.ec, ", ", tempName];
};
min, max => {
Access: PROC [arg: Node] RETURNS [c: Code] = {
cc2: CodeCont ¬ LoadAsFloat[arg];
cc.sc ¬ Cat2[cc.sc, cc2.sc]; 
c ¬ C2CEmit.MinPrecedence[cc2.ec, unaryPrecedence]; 
};
macroName: Rope.ROPE ¬ SELECT arithOp.select FROM 
min => C2CStateUtils.MacroName[fMinMacro], 
max => C2CStateUtils.MacroName[fMaxMacro]
ENDCASE => ERROR;
args: NodeList ¬ xApp.args; 
cc.ec ¬ Access[args.first]; args ¬ args.rest;
WHILE args#NIL DO --we could improve this by not simply using a linear list
tx: Rope.ROPE ¬ FPTemporary[];
ty: Rope.ROPE ¬ FPTemporary[];
c2: Code ¬ Access[args.first]; args ¬ args.rest;
cc.ec ¬ C2CEmit.CatCall[macroName, cc.ec, ", ", c2, ", ", Rope.Cat[tx, ", ", ty]];
IF args#NIL THEN cc ¬ ForceAFloatTemporary[cc];
ENDLOOP;
};
ENDCASE => ERROR C2CBasics.NotYetImpl;
IF ~leaveFloat THEN cc.ec ¬ LoopholeWord[cc.ec, floatToWord];
};

floatAbsMacro: C2CStateUtils.Macro ¬ C2CStateUtils.DefineMacro["FABS", 
"(f, t) ( ((t=(f)) >= (float) 0.0) ? (t) : (- (t)) )"
];

fMinMacro: C2CStateUtils.Macro ¬ C2CStateUtils.DefineMacro["FMIN",
"(x, y, tx, ty)  ( (tx=((float) x)) <= (ty=((float) y)) ? tx : ty )"
];

fMaxMacro: C2CStateUtils.Macro ¬ C2CStateUtils.DefineMacro["FMAX",
"(x, y, tx, ty)  ( (tx=((float) x)) >= (ty=((float) y)) ? tx : ty )"
];


END.

\
C2CSingleFloatImpl.mesa
Copyright Σ 1988..1993 by Xerox Corporation.  All rights reserved.
Christian Jacobi, August 31, 1988 12:01:57 pm PDT
Christian Jacobi, January 25, 1993 10:05 am PST
Willie-s, February 17, 1992 12:42 pm PST
--detour of using address for case of float 
--detour of using address for case of float 
--screws mode; leaves result as value; 
--if leaveFloat type is float else type is standard
assumes cc.ec being floating point; assigns it into a temporary and returns temporary in ec
--screws mode; leaves result as value; 
--if leaveFloat type is float else type is standard
Κ
‚–
(cedarcode) style•NewlineDelimiter

™
codeš
œ™Kšœ
Οe
œ7™BKš
œ1™1K™/K™(—K˜š
Οk	˜	Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ
˜
Kš
œ˜K˜—šΟnœžœ
ž˜!Kšžœk˜rKšžœ˜—š
ž˜Kšžœ:˜>K˜—Kšžœžœžœ
˜šœ	žœžœ˜Kšœžœ
˜	Kš
œ˜K˜—Kš	œžœžœžœžœ˜)K˜šŸœžœžœ˜/Kšžœžœ
žœ
žœ˜Kšžœžœ
žœ
žœ˜Kšžœ˜Kš
œ˜—K˜šŸ	œžœžœžœ˜,Kšžœ.˜4K˜—K˜š
Ÿœžœ
žœžœž
œ˜NKšžœžœ
žœ
˜,šžœžœ
ž˜š
œ˜šžœžœ
ž˜š
œ˜šžœžœ
ž˜š
œ˜šžœ/žœž˜Qšžœž˜Kšœ žœžœ˜.Kšžœ˜———Kšžœ˜——Kšžœ˜——Kšžœ˜—K˜—K˜šŸœžœžœ˜FKšžœ!žœ
žœ
˜/šžœžœ
ž˜š
œ˜šžœžœ
ž˜Kš
œD˜DKšžœ˜——Kšžœ˜—K˜—K˜šŸœžœ'žœ˜`šžœžœ
ž˜š
œ˜Kšžœ/žœ
žœ
˜=Kšžœžœ
žœ
˜'šžœž˜š
œ0˜0Kšœ(žœ˜.Kšœžœ
˜
K˜—Kšžœ˜—K˜—š
œ˜Kšžœ0žœ
žœ
˜>Kšžœ.žœ
žœ
˜<Kšžœžœ
žœ
˜&Kšœ,žœ˜2Kšœžœ
˜
K˜—Kšžœ˜—K˜K˜—šŸœžœžœ
žœ˜2Kš
œ#˜#Kš
œN˜NKš
œ˜—K˜šŸœžœ
žœ"žœžœžœ˜bKš
œ˜Kšžœ!žœ
žœ˜CKš
œ˜šžœ˜	šžœ˜Kš
œ˜Kšžœžœ ˜.K˜
—šžœ˜Kš
œ˜šžœžœžœ,˜[šžœ˜Kšœ;žœ˜BKš
œ˜K˜
—šžœ˜Kš
œ7˜7K˜——K˜——K˜—K˜Kšœžœ˜2šŸœžœ&žœ˜WKš
Οc,™,Kšœžœ
˜šžœ˜šžœ˜Kš
œ˜Kš
œ˜K˜
—šžœ˜Kš
œ˜Kš
œS˜SK˜——Kš
œ/˜/Kš
œ)˜)Kš
œ&˜&Kšžœ˜%K˜—K˜šŸœžœ&žœ˜JKš
 ,™,šžœ˜šžœ˜Kš	œžœžœžœžœ	˜GKšœ6žœ˜=Kš
œ.˜.Kš
œ
˜
—šžœ˜Kš
œ,˜,Kš
œ˜——Kšžœ˜K˜—K˜šŸœžœ
žœ@žœ˜
Kšœžœ
˜Kš
œ*˜*Kšœžœ˜(Kšžœ!žœ˜=Kšžœžœ˜4Kšžœ žœ%žœ˜cKš
œ,˜,Kš
œ)˜)Kš
œ.˜.Kš
œ˜Kš
œ;˜;Kš
œ;˜;šžœž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ5˜5Kš
œ5˜5Kšžœ˜!—Kš
œ6˜6K˜—K˜šŸœžœ
žœ7žœžœžœ˜~Kš
 '™'Kš
 3™3Kš
œ˜Kšžœ.žœ˜JKšžœ0žœ˜Lšžœž˜š
œ˜Kšžœžœ˜6Kš
œ"˜"Kš
œ8˜8šžœž˜Kš
œ.˜.Kš
œ5˜5Kšžœ˜ —Kš
œ ˜ K˜—š
œ	˜	Kš
œ$˜$K˜8šžœž˜Kš
œ5˜5Kš
œE˜EKšžœ˜ —Kš
œ6˜6Kšžœ
žœ*˜=Kš
œ˜—Kšžœ˜ —K˜—K˜šŸœžœžœ˜@Kš
œ[™[Kšœžœ˜ Kš
œ6˜6Kš
œ ˜ Kšžœ˜K˜—K˜š
Ÿœžœ3žœžœžœ˜xKš
 '™'Kš
 3™3Kš
œ˜Kšžœ/žœ˜KKšžœžœ˜5šžœž˜š
œ˜Kš
œ,˜,Kš
œ)˜)Kš
œ.˜.Kš
œ˜Kš
œA˜AKš
œA˜Ašžœž˜Kš
œ4˜4Kš
œ4˜4Kš
œ4˜4Kš
œ4˜4Kšžœ˜!—Kš
œ9˜9K˜—š
œ˜Kš
œ,˜,Kš
œ(˜(Kš
œ6˜6Kš
œ"˜"Kš
œ9˜9K˜—š
œ˜Kšœžœ˜$Kš
œ,˜,Kš
œ"˜"Kš
œ6˜6Kš
œW˜WK˜—š
œ
˜
šŸœžœ
žœ˜.Kš
œ!˜!Kš
œ˜Kš
œ4˜4K˜—šœžœžœžœ
˜2Kš
œ+˜+Kš
œ)˜)Kšžœžœ
˜—Kš
œ˜Kš
œ-˜-šžœžœ
žœ
 9˜KKšœ	žœ˜Kšœ	žœ˜Kš
œ0˜0Kš
œR˜RKšžœžœ
žœ˜/Kšžœ
˜—K˜—Kšžœžœ˜&—Kšžœ
žœ*˜=K˜—š
œG˜GKš
œ5˜5Kš
œ˜K˜—š
œB˜BKš
œD˜DK˜—K˜š
œB˜BKš
œD˜DK˜—K˜K˜Kšžœ
˜K˜—…—#’0p