C2CDoubleImpl.mesa
Copyright Ó 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 15, 1989 11:41:46 am PST
Christian Jacobi, October 5, 1990 1:49:01 pm PDT
DIRECTORY
C2CAddressing,
C2CAddressingOps,
C2CBasics,
C2CDefs,
C2CDRunTime,
C2CDouble,
C2CMode,
C2CStateUtils,
C2CTarget,
C2CEmit,
C2CMain,
Rope,
IntCodeDefs;
C2CDoubleImpl: CEDAR PROGRAM
IMPORTS C2CAddressing, C2CAddressingOps, C2CBasics, C2CEmit, C2CDRunTime, C2CMain, C2CMode, C2CStateUtils, C2CTarget, Rope
EXPORTS C2CDouble =
BEGIN
OPEN IntCodeDefs, C2CAddressingOps, C2CBasics, C2CDefs, C2CMain, C2CMode;
ROPE: TYPE = Rope.ROPE;
DTemporary: PROC [] RETURNS [name: ROPE] = {
name ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerDoubleWord, "D"];
};
IsSimpleDFloatArithOp: PROC [node: IntCodeDefs.Node] RETURNS [BOOL¬FALSE] = {
IF node.bits#C2CTarget.bitsPerDoubleWord THEN RETURN;
WITH node SELECT FROM
applyNode: ApplyNode => {
IF applyNode.handler#NIL THEN RETURN [FALSE];
WITH applyNode.proc SELECT FROM
operNode: OperNode => {
WITH operNode.oper SELECT FROM
arithOp: ArithOper => IF arithOp.class.precision=C2CTarget.bitsPerDoubleWord AND arithOp.class.kind=real THEN RETURN [TRUE];
ENDCASE => {};
};
ENDCASE => {};
};
ENDCASE => {};
};
LoadAddrRHSD: PROC [node: IntCodeDefs.Node] RETURNS [cc: CodeCont] = {
--D: does not worry about not generating statement code
mode: Mode ¬ C2CAddressing.ProposedMode[node: node, lhs: FALSE, wrongSize: FALSE, usedSz: node.bits];
mode ¬ DSetBaseSize[mode, C2CTarget.TemporaryBits[node.bits]];
SELECT GetAMode[mode] FROM
plain => {
cc ← GenNode[node, mode];
cc.ec ← C2CEmit.TakeAddr[cc.ec, TRUE];
};
plain => {
mode ¬ DSetAMode[mode, getAddr];
cc ¬ GenNode[node, mode];
};
getAddr => {
cc ¬ GenNode[node, mode];
};
ENDCASE => {
sz: INT ¬ C2CTarget.TemporaryBits[node.bits];
tempName: ROPE ¬ C2CStateUtils.DeclareVariable[temporaryDeclarations, sz];
cc ¬ GenNode[node, SetAssUnits[mode, tempName, sz]];
IF cc.ec#NIL THEN CantHappen;
cc.ec ¬ C2CEmit.IdentCode[tempName];
cc.ec ¬ C2CEmit.TakeAddr[cc.ec, TRUE];
};
FreeMode[mode];
};
GAppliedDArithOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, arithOp: IntCodeDefs.ArithOper, mode: C2CDefs.Mode] RETURNS [cc: CodeCont]
= {
cc1, cc2: CodeCont; c: Code; assMode: BOOL ¬ FALSE; name: ROPE; resAddr: Code;
kind: IntCodeDefs.ArithClassKind ¬ arithOp.class.kind;
SELECT GetAMode[mode] FROM
assUnits => {
name ¬ GetTemplate[mode]; assMode ¬ TRUE;
};
ENDCASE => {
name ¬ DTemporary[];
};
resAddr ¬ C2CEmit.Cat["&", name];
IF arithOp.class.precision#C2CTarget.bitsPerDoubleWord THEN ERROR;
cc1 ¬ LoadAddrRHSD[xApp.args.first];
SELECT arithOp.select FROM
min, max => {
copy: ROPE ¬ DTemporary[];
AccessAddr: PROC [arg: Node] RETURNS [Code] = {
--never needs temporary because all double expression results in variables
ccl: CodeCont ¬ LoadAddrRHSD[arg];
cc.sc ¬ C2CEmit.Cat[cc.sc, ccl.sc];
RETURN [ccl.ec];
};
cc ¬ LoadArithNode[xApp.args.first];
cc.sc ¬ C2CEmit.Cat[cc.sc, copy, " = ", cc.ec, ";\n"];
FOR m: NodeList ¬ xApp.args.rest, m.rest WHILE m#NIL DO
--we could improve this by not simply using a linear list
resPtr: Code ¬ C2CEmit.TakeAddr[C2CEmit.IdentCode[copy], TRUE];
addr: Code ¬ C2CEmit.TakeAddr[C2CEmit.IdentCode[copy], TRUE];
c ¬ AccessAddr[m.first];
SELECT arithOp.select FROM
min => c ¬ C2CDRunTime.DMinI[kind, resPtr, addr, c];
max => c ¬ C2CDRunTime.DMaxI[kind, resPtr, addr, c];
ENDCASE => ERROR;
cc.sc ¬ C2CEmit.Cat[cc.sc, c, ";\n"];
c ¬ NIL;
ENDLOOP;
name ¬ copy;
assMode ¬ FALSE;
};
neg => {
c ¬ C2CDRunTime.DNegI[kind, resAddr, cc1.ec];
};
abs => {
c ¬ C2CDRunTime.DAbsI[kind, resAddr, cc1.ec];
};
add, sub, mul, div, pow, mod => {
cc2 ¬ LoadAddrRHSD[xApp.args.rest.first];
SELECT arithOp.select FROM
add => {c ¬ C2CDRunTime.DAddI[kind, resAddr, cc1.ec, cc2.ec]};
sub => {c ¬ C2CDRunTime.DSubI[kind, resAddr, cc1.ec, cc2.ec]};
mul => {c ¬ C2CDRunTime.DMulI[kind, resAddr, cc1.ec, cc2.ec]};
div => {c ¬ C2CDRunTime.DDivI[kind, resAddr, cc1.ec, cc2.ec]};
mod => {c ¬ C2CDRunTime.DModI[kind, resAddr, cc1.ec, cc2.ec]};
pow => {
--no mixed mode power operation: base and exponent of same type
c ¬ C2CDRunTime.DPwrI[kind, resAddr, cc1.ec, cc2.ec];
};
ENDCASE => CaseMissing;
};
ENDCASE => NotYetImpl;
IF c#NIL THEN c ¬ C2CEmit.Cat[c, ";\n"];
cc.sc ¬ C2CEmit.Cat[cc1.sc, cc.sc, cc2.sc, c];
IF assMode
THEN cc.ec ¬ NIL
ELSE {
cc.ec ¬ C2CEmit.IdentCode[name];
cc ¬ ModizeArithCode[cc, mode, xApp.bits];
};
};
GAppliedDCompareOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, compOp: IntCodeDefs.CompareOper, mode: C2CDefs.Mode] RETURNS [cc: CodeCont] = {
cc1, cc2: CodeCont;
kind: IntCodeDefs.ArithClassKind ¬ compOp.class.kind;
IF compOp.class.precision#C2CTarget.bitsPerDoubleWord THEN NotYetImpl; --ERROR;
cc1 ¬ LoadAddrRHSD[xApp.args.first];
cc2 ¬ LoadAddrRHSD[xApp.args.rest.first];
cc.sc ¬ C2CEmit.Cat[cc1.sc, cc2.sc];
SELECT compOp.sense FROM
ge => {cc.ec ¬ C2CDRunTime.DGeI[kind, cc1.ec, cc2.ec]};
gt => {cc.ec ¬ C2CDRunTime.DGtI[kind, cc1.ec, cc2.ec]};
eq => {cc.ec ¬ C2CDRunTime.DEqI[kind, cc1.ec, cc2.ec]};
lt => {cc.ec ¬ C2CDRunTime.DGtI[kind, cc2.ec, cc1.ec]};
le => {cc.ec ¬ C2CDRunTime.DGeI[kind, cc2.ec, cc1.ec]};
ne => {
cc.ec ¬ C2CEmit.Cat[" ! ", C2CDRunTime.DEqI[kind, cc1.ec, cc2.ec]];
cc.ec ¬ C2CEmit.SetPrecedence[cc.ec, unaryPrecedence];
};
ENDCASE => CaseMissing;
};
GAppliedDConvertOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, convertOp: IntCodeDefs.ConvertOper, mode: C2CDefs.Mode] RETURNS [cc: CodeCont] = {
template, key: ROPE; assMode: BOOL ¬ FALSE;
IF convertOp.to.precision<convertOp.from.precision THEN {
IF convertOp.to.precision#C2CTarget.bitsPerWord OR convertOp.from.precision#C2CTarget.bitsPerDoubleWord THEN CantHappen;
cc ¬ LoadAddrRHSD[xApp.args.first];
SELECT convertOp.from.kind FROM
real => {
SELECT convertOp.to.kind FROM
real => cc.ec ¬ C2CDRunTime.FloatDRealI[cc.ec];
ENDCASE => CantHappen;
};
signed => {
SELECT convertOp.to.kind FROM
signed => cc.ec ¬ C2CDRunTime.IntDIntI[cc.ec];
unsigned => cc.ec ¬ C2CDRunTime.CardDIntI[cc.ec];
real => cc.ec ¬ C2CDRunTime.FloatDIntI[cc.ec];
ENDCASE => CantHappen;
};
unsigned => {
SELECT convertOp.to.kind FROM
signed => cc.ec ¬ C2CDRunTime.IntDCardI[cc.ec];
unsigned => cc.ec ¬ C2CDRunTime.CardDCardI[cc.ec];
real => cc.ec ¬ C2CDRunTime.FloatDCardI[cc.ec];
ENDCASE => CantHappen;
};
ENDCASE => CantHappen;
RETURN;
};
IF convertOp.to.precision#C2CTarget.bitsPerDoubleWord THEN CantHappen;
SELECT GetAMode[mode] FROM
assUnits => {
template ¬ GetTemplate[mode]; assMode ¬ TRUE;
};
ENDCASE => {
template ¬ DTemporary[];
};
IF convertOp.from.precision<=C2CTarget.bitsPerWord THEN {
IF convertOp.from.precision<C2CTarget.bitsPerWord THEN {
SELECT convertOp.from.kind FROM
unsigned => {};
ENDCASE => CantHappenCedar;
};
--from word to double word
cc ¬ LoadArithNode[node: xApp.args.first];
cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence];
SELECT convertOp.to.kind FROM
signed =>
SELECT convertOp.from.kind FROM
signed => key ¬ "DIntInt";
unsigned => key ¬ "DIntCard";
ENDCASE => CantHappenCedar;
unsigned =>
SELECT convertOp.from.kind FROM
signed => key ¬ "DCardInt";
unsigned => key ¬ "DCardCard";
ENDCASE => CantHappenCedar;
real => {
SELECT convertOp.from.kind FROM
signed => key ¬ "DFloatInt";
unsigned => key ¬ "DFloatCard";
real => key ¬ "DFloatReal";
ENDCASE => CantHappenCedar;
};
ENDCASE => CantHappenCedar;
}
ELSE IF convertOp.from.precision=C2CTarget.bitsPerDoubleWord THEN {
--from double to double
cc ¬ LoadAddrRHSD[xApp.args.first];
cc.ec ¬ C2CEmit.MinPrecedence[cc.ec, primaryPrecedence];
SELECT convertOp.to.kind FROM
real => {
SELECT convertOp.from.kind FROM
signed => key ¬ "DFloatDIntI";
unsigned => key ¬ "DFloatDCardI";
ENDCASE => CantHappen;
};
signed =>
SELECT convertOp.from.kind FROM
unsigned => key ¬ "DIntDCardI";
ENDCASE => CantHappen;
unsigned =>
SELECT convertOp.from.kind FROM
signed => key ¬ "DCardDIntI";
ENDCASE => CantHappen;
ENDCASE => CantHappen;
}
ELSE CantHappenCedar;
IF key=NIL THEN CantHappen;
key ¬ Rope.Concat[C2CTarget.runtimePrefix, key];
cc.ec ¬ C2CEmit.CatCall[key, "&", template, ", ", cc.ec];
SELECT GetAMode[mode] FROM
assUnits => {
cc.sc ¬ C2CEmit.Cat[cc.sc, cc.ec, ";\n"];
cc.ec ¬ NIL;
};
ENDCASE => {
cc.sc ¬ C2CEmit.Cat[cc.sc, cc.ec, ";\n"];
cc.ec ¬ C2CEmit.IdentCode[template];
cc ¬ ModizeArithCode[cc, mode, convertOp.to.precision];
};
};
END.