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
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] = {
--detour of using address for case of float
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] = {
--detour of using address for case of float
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] = {
--screws mode; leaves result as value;
--if leaveFloat type is float else type is standard
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] = {
assumes cc.ec being floating point; assigns it into a temporary and returns temporary in ec
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] = {
--screws mode; leaves result as value;
--if leaveFloat type is float else type is standard
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.