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] = {
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 => {
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] = {
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
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 => {
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;
};
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 {
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.

   D  
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
--D: does not worry about not generating statement code
plain => {
cc _ GenNode[node, mode];
cc.ec _ C2CEmit.TakeAddr[cc.ec, TRUE];
};
--never needs temporary because all double expression results in variables
--we could improve this by not simply using a linear list
--no mixed mode power operation: base and exponent of same type
--from word to double word
--from double to double
‌ت	ڈ  –(cedarcode) style•NewlineDelimiter
™ ڑœ™Icodeڑœ
دeœ=™HKڑœ0™0Kڑœ0™0—ڑدk	ک	KڑœکKڑœکKڑœ
ک
KڑœکKڑœکKڑœ
ک
KڑœکKڑœکKڑœ
ک
KڑœکKڑœکKڑœکKڑœکKک —ڑدnœ‍œ‍کKڑ‍œsکzKڑ‍œک—ڑ‍کKڑ‍œEکI—Kڑ‍œ‍œ‍œکKک Kک ڑں
œ‍œ‍œ‍œک,Kڑœ^ک^Kڑœک—Kک ڑںœ‍œ‍œ‍
œکMKڑ‍œ'‍œ‍œک5ڑ‍œ‍œ‍کڑœکKڑ
‍œ‍œ‍œ‍œ‍œک-ڑ‍œ‍œ‍کڑœکڑ‍œ‍œ‍کKڑœ‍œ5‍œ‍œ‍œ‍œک|Kڑ‍œک—Kڑœک—Kڑ‍œک—Kک—Kڑ‍œک—Kک—Kک ڑںœ‍œ‍œکFKڑدc7™7Kڑœ9‍œ‍œکeKڑœ>ک>ڑ‍œ‍کڑœ
™
Kڑœ™Kڑœ ‍œ™&K™—ڑœ
ک
Kڑœ ک KڑœکKک—ڑœکKڑœکKڑœک—ڑ‍œکKڑœ‍œ&ک-Kڑœ
‍œ<کJKڑœ4ک4Kڑ‍œ‍œ‍œکKڑœ$ک$Kڑœ ‍œک&Kڑœک——KڑœکKڑœک—Kک Kک ڑںœ‍œ‍œS‍œکٹKڑœ&‍œ‍œ‍œکNKڑœ6ک6ڑ‍œ‍کڑœکKڑœ$‍œک)Kڑœک—ڑ‍œکKڑœکKڑœک——Kڑœ!ک!Kڑ‍œ5‍œ‍œکBKڑœ$ک$ڑ‍œ‍کڑœکKڑœ‍œکڑں
œ‍œ‍œک/Kڑ J™JKڑœ"ک"Kڑœ$ک$Kڑ‍œ
کKک—Kڑœ$ک$Kڑœ6ک6ڑ‍œ&‍œ‍œ‍ک7Kڑ 9™9Kڑœ9‍œک?Kڑœ7‍œک=Kڑœکڑ‍œ‍کKڑœ4ک4Kڑœ4ک4Kڑ‍œ‍œک—Kڑœ&ک&Kڑœ‍œکKڑ‍œک—KڑœکKڑœ
‍œکKڑœک—ڑœکKڑœ-ک-Kک—ڑœکKڑœ-ک-Kک—ڑœ!ک!Kڑœ)ک)ڑ‍œ‍کKڑœ>ک>Kڑœ>ک>Kڑœ>ک>Kڑœ>ک>Kڑœ>ک>ڑœکKڑ ?™?Kڑœ5ک5Kڑœک—Kڑ‍œک—Kک—Kڑ‍œک—Kڑ‍œ‍œ‍œک(Kڑœ.ک.ڑ‍œ	کKڑ‍œ	‍œکڑ‍œکKڑœ ک Kڑœ*ک*Kک——KڑœکKک —ڑںœ‍œ‍œT‍œکچKڑœکKڑœ5ک5Kڑ‍œ4‍œ کOKڑœ$ک$Kڑœ)ک)Kڑœ$ک$ڑ‍œ‍کKڑœ7ک7Kڑœ7ک7Kڑœ7ک7Kڑœ7ک7Kڑœ7ک7ڑœکKڑœDکDKڑœ6ک6Kڑœک—Kڑ‍œک—Kک—Kک ڑںذlnں	œ‍œW‍œکگKڑœ‍œ‍ک+ڑ‍œ1‍œک9Kڑ‍œ.‍œ6‍œکxKڑœ#ک#ڑ‍œ‍کڑœ	ک	ڑ‍œ‍کKڑœ/ک/Kڑ‍œک—Kڑœک—ڑœکڑ‍œ‍کKڑœ.ک.Kڑœ1ک1Kڑœ.ک.Kڑ‍œک—Kڑœک—ڑœکڑ‍œ‍کKڑœ/ک/Kڑœ2ک2Kڑœ/ک/Kڑ‍œک—Kڑœک—Kڑ‍œک—Kڑ‍œکKک—Kڑ‍œ4‍œکFڑ‍œ‍کڑœکKڑœ(‍œک-Kڑœک—ڑ‍œکKڑœکKڑœک——ڑ‍œ1‍œک9ڑ‍œ0‍œک8ڑ‍œ‍کKڑœکKڑ‍œک—Kک—Kڑœ™Kڑœ*ک*Kڑœ8ک8ڑ‍œ‍کڑœ
ک
ڑ‍œ‍کKڑœکKڑœکKڑ‍œک——ڑœکڑ‍œ‍کKڑœکKڑœکKڑ‍œک——ڑœ	ک	ڑ‍œ‍کKڑœکKڑœکKڑœکKڑ‍œک—Kک—Kڑ‍œک—Kک—ڑ‍œ‍œ6‍œکCKڑ ™Kڑœ#ک#Kڑœ8ک8ڑ‍œ‍کڑœ	ک	ڑ‍œ‍کKڑœکKڑœ!ک!Kڑ‍œک—Kک—ڑœ
ک
ڑ‍œ‍کKڑœکKڑ‍œک——ڑœکڑ‍œ‍کKڑœکKڑ‍œک——Kڑ‍œک—Kڑœک—Kڑ‍œکKڑ‍œ‍œ‍œکKڑœ0ک0Kڑœ9ک9ڑ‍œ‍کڑœکKڑœ)ک)Kڑœ‍œکKڑœک—ڑ‍œکKڑœ)ک)Kڑœ$ک$Kڑœ7ک7Kک——KکKک —Iimpڑ‍œکKک — …—    F  *  