<<>> <> <> <> <> <> DIRECTORY CedarCode USING [CodeToCoerce, CodeToDoBinaryOp, CodeToDoUnaryOp, ConcatCode, CreateCedarNode, GetDataFromNode, GetTypeOfNode, OperationsBody], CCTypes USING [BinaryTargetTypes, CCError, CCErrorCase, CCTypeProcs, CreateCedarType, ConformanceCheck, GetProcDataFromGroundType, GetProcDataFromType, GetTypeClass, GetWrongType, LR, Operator], CirioTypes USING [BasicTypeInfo, CompilerContext, Mem, Node, Type, TypeClass, TypedCode], CNumericTypes USING [NumericDescriptor, NumericDescriptorBody, PrimaryTag, SecondaryTag], Convert USING [RopeFromCard, RopeFromInt, RopeFromReal], IO, PBasics USING [BITAND, BITNOT, BITOR, BITSHIFT, BITXOR, Word], Rope USING [Cat, FromChar, ROPE], Real USING [Fix], RefTab USING [Fetch]; <> <> CNumericTypesImpl: CEDAR PROGRAM IMPORTS CCTypes, CedarCode, Convert, IO, PBasics, Real, RefTab, Rope EXPORTS CNumericTypes = { Type: TYPE = CirioTypes.Type; Node: TYPE = CirioTypes.Node; Mem: TYPE = CirioTypes.Mem; BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo; NumericDescriptor: TYPE = CNumericTypes.NumericDescriptor; ShortInt: TYPE ~ INT; LongInt: TYPE ~ INT; ShortCard: TYPE ~ CARD; LongCard: TYPE ~ CARD; InlineFixI: PROC [r: REAL] RETURNS [INTEGER] = INLINE { RETURN[Real.Fix[r]]; }; <<... converts REAL to INTEGER by truncating (mode rz).>> InlineFixC: PROC [r: REAL] RETURNS [CARDINAL] = INLINE { RETURN[Real.Fix[r]]; }; <<... converts REAL to CARDINAL by truncating (mode rz).>> CC: TYPE = CirioTypes.CompilerContext; CCError: ERROR[case: CCTypes.CCErrorCase _ syntax, msg:Rope.ROPE _ NIL] _ CCTypes.CCError; CreateNumericType: PUBLIC PROC[desc: NumericDescriptor, cc: CC, bti: BasicTypeInfo] RETURNS[Type] = {RETURN CCTypes.CreateCedarType[$numeric, NumericCCTypeProcs, IndirectNumericCCTypeProcs, cc, NEW[NumericTypePrivate _ [desc, bti]] ]}; NumericType: TYPE ~ REF NumericTypePrivate; NumericTypePrivate: TYPE ~ RECORD [ desc: NumericDescriptor, bti: BasicTypeInfo]; GetDescriptorFromCNumericType: PUBLIC PROC[type: Type, cc: CC] RETURNS[NumericDescriptor] = { nt: NumericType _ NARROW[CCTypes.GetProcDataFromGroundType[type, cc]]; RETURN[nt.desc]}; IndirectNumericCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ createIndirectNode: NumericCreateIndirect, getBitSize: NumericBitSize ]]; NumericCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _ [ checkConformance: NumericCheckConformance, binaryOperandTypes: NumericBinaryOperandTypes, asIndexSet: NIL, operand: NumericOperand, coerceToType: NumericCoerceToType, binaryOp: NumericBinaryOp, unaryOp: NumericUnaryOp, nAryOperandType: NIL, nAryOp: NIL, getNElements: NIL, printType: NumericPrintType ]]; NumericCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ { nt: NumericType ~ NARROW[procData]; IF nt.bti=NIL THEN CCError[cirioError, "bti-less numeric type asked to createIndirect"]; RETURN nt.bti.createIndirectNode[nt.bti, cc, indirectType, targetType, mem]}; NumericBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ { nt: NumericType ~ NARROW[procData]; IF nt.bti=NIL THEN CCError[cirioError, "bti-less numeric type asked to getBitSize"]; RETURN nt.bti.getBitSize[nt.bti, cc, indirectType, targetType]}; NumericPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] ~ { WITH procData SELECT FROM nt: NumericType => SELECT nt.desc.primary FROM signed, unsigned => to.PutRope[PrimaryName[nt.desc.primary].Cat[" ", SecondaryName[nt.desc.secondary]]]; float, double, longDouble => to.PutRope[PrimaryName[nt.desc.primary]]; ENDCASE => ERROR; ENDCASE => to.PutRope["?strange C numeric descriptor"]}; PrimaryName: ARRAY CNumericTypes.PrimaryTag OF Rope.ROPE ~ ["signed", "unsigned", "float", "double", "longDouble"]; SecondaryName: ARRAY CNumericTypes.SecondaryTag OF Rope.ROPE ~ ["character", "shortInteger", "integer", "enumeration", "longInteger", "null"]; NumericCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = { WITH CCTypes.GetProcDataFromType[varType] SELECT FROM varNt: NumericType => { valNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[valType]]; RETURN[IF CompareNumericDescriptors[valNt.desc, varNt.desc] THEN yes ELSE no]}; ENDCASE => RETURN[no]; }; CompareNumericDescriptors: PROC [left, right: NumericDescriptor] RETURNS [eq: BOOLEAN] ~ { SELECT left.primary FROM float => { RETURN [right.primary = float]; }; double => { RETURN [right.primary = double]; }; longDouble => { RETURN [right.primary = longDouble]; }; signed => SELECT right.primary FROM float, double, longDouble, unsigned => { RETURN[FALSE]; }; signed => { RETURN[left.secondary = right.secondary]; } ENDCASE => CCError[cirioError]; unsigned => SELECT right.primary FROM float, double, longDouble, signed => { RETURN[FALSE]; }; unsigned => { RETURN[left.secondary = right.secondary]; }; ENDCASE => CCError[cirioError]; ENDCASE => CCError[cirioError] }; NumericBinaryOperandTypes: PROC[op: CCTypes.Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] = { leftNt: NumericType _ NARROW[procData]; leftDesc: NumericDescriptor _ leftNt.desc; rightClass: CirioTypes.TypeClass _ CCTypes.GetTypeClass[right]; SELECT op FROM $plus, $minus, $div, $mult, $mod, $le, $lt, $eq, $ne, $gt, $ge, $and, $or, $bitor, $bitand, $bitxor, $bitshiftleft, $bitshiftright => SELECT rightClass FROM $wrong, $amnode => RETURN[[right, right]]; $numeric => { OperandCases: TYPE = { leftOther, rightOther, leftInteger, rightInteger, leftLongInteger, rightLongInteger, promote, leftFloat, rightFloat, leftDouble, rightDouble, leftLongDouble, rightLongDouble}; case: OperandCases; rightNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[right]]; rightDesc: NumericDescriptor _ rightNt.desc; case _ MAX[ SELECT leftDesc.primary FROM longDouble => leftLongDouble, double => leftDouble, float => leftFloat, ENDCASE => promote, SELECT rightDesc.primary FROM longDouble => rightLongDouble, double => rightDouble, float => rightFloat, ENDCASE => promote]; SELECT case FROM leftLongDouble, leftDouble, leftFloat => RETURN[[left,left]]; rightLongDouble, rightDouble, rightFloat => RETURN[[right,right]]; ENDCASE => { leftDesc _ IntegerPromotions[leftDesc]; rightDesc _ IntegerPromotions[rightDesc]; <> case _ MAX[ SELECT leftDesc.primary FROM unsigned => SELECT leftDesc.secondary FROM longInteger => leftLongInteger, integer => leftInteger, ENDCASE => leftOther, signed => SELECT leftDesc.secondary FROM longInteger => leftLongInteger, ENDCASE => rightOther, ENDCASE => CCError[cirioError], SELECT rightDesc.primary FROM unsigned => SELECT rightDesc.secondary FROM longInteger => rightLongInteger, integer => rightInteger, ENDCASE => rightOther, signed => SELECT rightDesc.secondary FROM longInteger => rightLongInteger, ENDCASE => rightOther, ENDCASE => CCError[cirioError]]; SELECT case FROM leftLongInteger, leftInteger => RETURN[[left,left]]; rightLongInteger, rightInteger => RETURN[[right,right]]; leftOther, rightOther => { intType: Type _ CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]], cc, NIL]; RETURN[[intType,intType]] }; ENDCASE => CCError[cirioError]; } }; ENDCASE => CCError[cirioError]; ENDCASE => CCError[cirioError] }; IntegerPromotions: PROC [desc: NumericDescriptor] RETURNS [NumericDescriptor] ~ { <> SELECT desc.primary FROM float, double, longDouble => { CCError[cirioError]; }; signed => { SELECT desc.secondary FROM character, shortInteger, enumeration => { RETURN [NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]]]; }; ENDCASE => RETURN[desc] }; unsigned => { SELECT desc.secondary FROM character, shortInteger => { RETURN [NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]]] }; ENDCASE => RETURN[desc] }; ENDCASE => CCError[cirioError] }; NumericOperand: PROC[op: CCTypes.Operator, lr: CCTypes.LR, tc: CirioTypes.TypedCode, cc: CC, procData: REF ANY] RETURNS[CirioTypes.TypedCode] <> = {RETURN [tc]}; NumericCoerceToType: PROC[targetType: Type, tc: CirioTypes.TypedCode, cc: CC, procData: REF ANY] RETURNS[CirioTypes.TypedCode] = BEGIN targetClass: CirioTypes.TypeClass _ CCTypes.GetTypeClass[targetType]; SELECT targetClass FROM $wrong => RETURN[[tc.code, CCTypes.GetWrongType[cc]]]; $numeric => BEGIN targetNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[targetType]]; targetDescriptor: NumericDescriptor _ targetNt.desc; sourceNt: NumericType _ NARROW[procData]; sourceDescriptor: NumericDescriptor _ sourceNt.desc; IF CompareNumericDescriptors[targetDescriptor, sourceDescriptor] THEN RETURN[tc] ELSE RETURN[[CedarCode.ConcatCode[tc.code, CedarCode.CodeToCoerce[tc.type, targetType]], targetType]]; <> <>> <> <>> <> <>> <> < >> <> < CCError[cirioError];>> END; ENDCASE => CCError[typeConformity]; END; NumericBinaryOp: PROC[op: CCTypes.Operator, left, right: CirioTypes.TypedCode, cc: CC, procData: REF ANY] RETURNS[CirioTypes.TypedCode] = BEGIN <> <> targetType: Type _ SELECT op FROM $plus, $minus, $div, $mult, $mod, $le, $lt, $eq, $gt, $ge, $ne, $and, $or, $bitor, $bitand, $bitxor, $bitshiftleft, $bitshiftright => left.type, ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[[CedarCode.ConcatCode[ left.code, CedarCode.ConcatCode[ right.code, CedarCode.CodeToDoBinaryOp[op, left.type, right.type]]], targetType]]; END; NumericUnaryOp: PROC[op: CCTypes.Operator, arg: CirioTypes.TypedCode, cc: CC, procData: REF ANY] RETURNS[CirioTypes.TypedCode] = BEGIN targetType: Type _ SELECT op FROM $minus, $not, $bitnot => arg.type, ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[[CedarCode.ConcatCode[ arg.code, CedarCode.CodeToDoUnaryOp[op, arg.type]], targetType]]; END; CreateNumericNode: PUBLIC PROC[type: Type, rep: REF ANY] RETURNS[Node] = BEGIN RETURN[CedarCode.CreateCedarNode[NumericalOps, type, rep]]; END; NumericalOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _ [ examineBoolean: NumericalExamineBoolean, coerce: NumericalCoerce, binaryOp: NumericalBinaryOp, unaryOp: NumericalUnaryOp, asIndex: NIL, show: NumericalShow, getNodeRepresentation: NumericalGetNodeRepresentation]]; IntFromBool: PROC [b:BOOL] RETURNS [INT] ~ { <> IF b THEN RETURN[1] ELSE RETURN[0] }; NumericalGetNodeRepresentation: PROC [node: Node, cc: CC] RETURNS [REF ANY] ~ {RETURN CedarCode.GetDataFromNode[node]}; NumericalCoerce: PROC[sourceType, targetType: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN expectedSourceNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[sourceType]]; expectedSourceDescriptor: NumericDescriptor _ expectedSourceNt.desc; actualSourceNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[CedarCode.GetTypeOfNode[node]]]; actualSourceDescriptor: NumericDescriptor _ actualSourceNt.desc; targetNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[targetType]]; targetDescriptor: NumericDescriptor _ targetNt.desc; <<( The following comment has been commented out )>> <<************************************************************************>> <<* WARNING - The following line was temporarily commented out to solve the problem>> <<* with the variant record compiler bug.>> CheckEqualDescriptors[expectedSourceDescriptor, actualSourceDescriptor]; <<************************************************************************>> SELECT targetDescriptor.primary FROM double => BEGIN targetReal: REAL _ 0.0; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => targetReal _ lit^; lit: REF INT => targetReal _ lit^; lit: REF CARD => BEGIN -- must be a large CARD reduced: CARD _ (lit^ - CARD[LAST[INT]])-CARD[1]; reducedReal: REAL _ reduced; targetReal _ (reducedReal+REAL[LAST[INT]])+1.0; END; lit: REF CHAR => targetReal _ CARD[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen; RETURN[CreateNumericNode[targetType, NEW[REAL _ targetReal]]]; END; float => BEGIN targetReal: REAL _ 0.0; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => targetReal _ lit^; lit: REF INT => targetReal _ lit^; lit: REF CARD => BEGIN -- must be a large CARD reduced: CARD _ (lit^ - CARD[LAST[INT]])-CARD[1]; reducedReal: REAL _ reduced; targetReal _ (reducedReal+REAL[LAST[INT]])+1.0; END; lit: REF CHAR => targetReal _ CARD[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen; RETURN[CreateNumericNode[targetType, NEW[REAL _ targetReal]]]; END; signed => BEGIN SELECT targetDescriptor.secondary FROM character => { targetCHAR: CHAR; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { temp:CARDINAL _ InlineFixC[lit^]; IF temp<=ORD[LAST[CHAR]] THEN targetCHAR _ VAL[temp] ELSE CCError[cirioError] }; lit: REF INT => { IF lit^>=0 AND lit^<=ORD[LAST[CHAR]] THEN targetCHAR _ VAL[BYTE[lit^]] ELSE CCError[cirioError] }; lit: REF INTEGER => { IF lit^>=0 AND lit^<=ORD[LAST[CHAR]] THEN targetCHAR _ VAL[lit^] ELSE CCError[cirioError] }; lit: REF CARD => { IF lit^<=ORD[LAST[CHAR]] THEN targetCHAR _ VAL[BYTE[lit^]] ELSE CCError[cirioError] }; lit: REF CARDINAL => { IF lit^<=ORD[LAST[CHAR]] THEN targetCHAR _ VAL[lit^] ELSE CCError[cirioError] }; lit: REF CHAR => targetCHAR _ lit^; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[CHAR _ targetCHAR]]]; }; shortInteger => { targetINTEGER: INTEGER; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { targetINTEGER _ InlineFixI[lit^] }; lit: REF INT => { IF lit^>=FIRST[INTEGER] AND lit^<=LAST[INTEGER] THEN targetINTEGER _ lit^ ELSE CCError[cirioError] }; lit: REF INTEGER => { targetINTEGER _ lit^ }; lit: REF CARD => { IF lit^<=LAST[INTEGER] THEN targetINTEGER _ lit^ ELSE CCError[cirioError] }; lit: REF CARDINAL => { IF CARD[lit^]<=CARD[LAST[INTEGER]] THEN targetINTEGER _ lit^ ELSE CCError[cirioError] }; lit: REF CHAR => targetINTEGER _ INTEGER[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[ShortInt _ targetINTEGER]]]; }; integer => { targetINT: INT; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { targetINT _ Real.Fix[lit^] }; lit: REF INT => { targetINT _ lit^ }; lit: REF INTEGER => { targetINT _ lit^ }; lit: REF CARD => { IF lit^<=CARD[LAST[INT]] THEN targetINT _ lit^ ELSE CCError[cirioError] }; lit: REF CARDINAL => { targetINT _ lit^ }; lit: REF CHAR => targetINT _ INT[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[LongInt _ targetINT]]]; }; longInteger => { targetINT: INT; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { targetINT _ Real.Fix[lit^] }; lit: REF INT => { targetINT _ lit^ }; lit: REF INTEGER => { targetINT _ lit^ }; lit: REF CARD => { IF lit^<=CARD[LAST[INT]] THEN targetINT _ lit^ ELSE CCError[cirioError] }; lit: REF CARDINAL => { targetINT _ lit^ }; lit: REF CHAR => targetINT _ INT[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[LongInt _ targetINT]]]; }; enumeration => { targetINT: INT; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { targetINT _ Real.Fix[lit^] }; lit: REF INT => { targetINT _ lit^ }; lit: REF INTEGER => { targetINT _ lit^ }; lit: REF CARD => { IF lit^<=CARD[LAST[INT]] THEN targetINT _ lit^ ELSE CCError[cirioError] }; lit: REF CARDINAL => { targetINT _ lit^ }; lit: REF CHAR => targetINT _ INT[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[LongInt _ targetINT]]]; }; ENDCASE => CCError[cirioError]; END; unsigned => BEGIN SELECT targetDescriptor.secondary FROM character => { targetCHAR: CHAR; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { temp:CARDINAL _ Real.Fix[lit^]; IF temp<=ORD[LAST[CHAR]]/2 THEN targetCHAR _ VAL[temp] ELSE CCError[cirioError] }; lit: REF INT => { IF lit^>=0 AND lit^<=ORD[LAST[CHAR]]/2 THEN targetCHAR _ VAL[BYTE[lit^]] ELSE CCError[cirioError] }; lit: REF INTEGER => { IF lit^>=0 AND lit^<=ORD[LAST[CHAR]]/2 THEN targetCHAR _ VAL[lit^] ELSE CCError[cirioError] }; lit: REF CARD => { IF lit^<=ORD[LAST[CHAR]]/2 THEN targetCHAR _ VAL[BYTE[lit^]] ELSE CCError[cirioError] }; lit: REF CARDINAL => { IF lit^<=ORD[LAST[CHAR]]/2 THEN targetCHAR _ VAL[lit^] ELSE CCError[cirioError] }; lit: REF CHAR => IF ORD[lit^]>=0 AND lit^<=VAL[ORD[LAST[CHAR]]/2] THEN targetCHAR _ lit^ ELSE CCError[cirioError] ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[CHAR _ targetCHAR]]]; }; shortInteger => { targetCARDINAL: CARDINAL; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { targetCARDINAL _ Real.Fix[lit^] }; lit: REF INT => { IF lit^>=INT[FIRST[CARD16]] AND lit^<=INT[LAST[CARD16]] THEN targetCARDINAL _ lit^ ELSE CCError[cirioError] }; lit: REF INTEGER => { targetCARDINAL _ lit^ }; lit: REF CARD => { IF lit^>=CARD[FIRST[CARDINAL]] AND lit^<=CARD[LAST[CARDINAL]] THEN targetCARDINAL _ lit^ ELSE CCError[cirioError] }; lit: REF CARDINAL => { targetCARDINAL _ lit^ }; lit: REF CHAR => targetCARDINAL _ CARDINAL[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[ShortCard _ targetCARDINAL]]]; }; integer => { targetCARD: CARD; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { IF lit^<0 THEN targetCARD _ Real.Fix[-lit^] ELSE targetCARD _ Real.Fix[lit^] }; lit: REF INT => { IF lit^ >= INT[FIRST[CARD]] THEN targetCARD _ lit^ ELSE CCError[cirioError] }; lit: REF INTEGER => { targetCARD _ lit^ }; lit: REF CARD => { targetCARD _ lit^ }; lit: REF CARDINAL => { targetCARD _ lit^ }; lit: REF CHAR => targetCARD _ CARD[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[LongCard _ targetCARD]]]; }; longInteger => { targetCARD: CARD; WITH CedarCode.GetDataFromNode[node] SELECT FROM lit: REF REAL => { IF lit^<0 THEN targetCARD _ Real.Fix[-lit^] ELSE targetCARD _ Real.Fix[lit^] }; lit: REF INT => { IF lit^ >= INT[FIRST[CARD]] THEN targetCARD _ lit^ ELSE CCError[cirioError] }; lit: REF INTEGER => { targetCARD _ lit^ }; lit: REF CARD => { targetCARD _ lit^ }; lit: REF CARDINAL => { targetCARD _ lit^ }; lit: REF CHAR => targetCARD _ CARD[ORD[lit^]]; ENDCASE => CCError[cirioError]; -- shouldn't happen RETURN[CreateNumericNode[targetType, NEW[LongCard _ targetCARD]]]; }; ENDCASE => CCError[cirioError]; END; ENDCASE => CCError[cirioError]; -- shouldn't happen END; NumericalBinaryOp: PROC[op: CCTypes.Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] = { leftTNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[leftType]]; rightTNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[rightType]]; leftNNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[CedarCode.GetTypeOfNode[leftNode]]]; rightNNt: NumericType _ NARROW[CCTypes.GetProcDataFromType[CedarCode.GetTypeOfNode[rightNode]]]; CheckEqualDescriptors[leftTNt.desc, leftNNt.desc]; CheckEqualDescriptors[rightTNt.desc, rightNNt.desc]; CheckEqualDescriptors[rightTNt.desc, leftTNt.desc]; <> SELECT leftTNt.desc.primary FROM double => { li: REF REAL _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF REAL _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod => BEGIN newREAL: REAL _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[REAL _ newREAL]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; float => { li: REF REAL _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF REAL _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod => BEGIN newREAL: REAL _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[REAL _ newREAL]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; signed => { SELECT leftTNt.desc.secondary FROM character, shortInteger => { CCError[cirioError] -- Because of int promotions, should never have expressions of characters }; integer => { li: REF INT _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF INT _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod, $bitor, $bitand, $bitxor, $bitshiftleft, $bitshiftright => BEGIN newINT: INT; [] _ PBasics.BITXOR[ LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]]; newINT _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, $mod => li^ MOD ri^, $bitor => LOOPHOLE[PBasics.BITOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitand => LOOPHOLE[PBasics.BITAND[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitxor => LOOPHOLE[PBasics.BITXOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitshiftleft => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], ri^], INT], $bitshiftright => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], -ri^], INT], ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[LongInt _ newINT]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; longInteger => { li: REF INT _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF INT _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod, $bitshiftleft, $bitshiftright => BEGIN newINT: INT _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, $mod => li^ MOD ri^, $bitor => LOOPHOLE[PBasics.BITOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitand => LOOPHOLE[PBasics.BITAND[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitxor => LOOPHOLE[PBasics.BITXOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitshiftleft => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitshiftright => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[-ri^, PBasics.Word]], INT], ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[LongInt _ newINT]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; enumeration => { li: REF INT _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF INT _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod, $bitshiftleft, $bitshiftright => BEGIN newINT: INT _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, $mod => li^ MOD ri^, $bitor => LOOPHOLE[PBasics.BITOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitand => LOOPHOLE[PBasics.BITAND[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitxor => LOOPHOLE[PBasics.BITXOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitshiftleft => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], INT], $bitshiftright => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[-ri^, PBasics.Word]], INT], ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[LongInt _ newINT]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; ENDCASE => CCError[cirioError]; }; unsigned => { SELECT leftTNt.desc.secondary FROM character, shortInteger => { CCError[cirioError] }; integer => { li: REF CARD _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF CARD _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod, $bitshiftleft, $bitshiftright => BEGIN newCARD: CARD _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, $mod => li^ MOD ri^, $bitor => LOOPHOLE[PBasics.BITOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitand => LOOPHOLE[PBasics.BITAND[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitxor => LOOPHOLE[PBasics.BITXOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitshiftleft => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitshiftright => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[-ri^, PBasics.Word]], CARD], ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[LongCard _ newCARD]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; longInteger => { li: REF CARD _ NARROW[CedarCode.GetDataFromNode[leftNode]]; ri: REF CARD _ NARROW[CedarCode.GetDataFromNode[rightNode]]; SELECT op FROM $plus, $minus, $mult, $div, $mod, $bitshiftleft, $bitshiftright => BEGIN newCARD: CARD _ SELECT op FROM $plus => li^ + ri^, $minus => li^ - ri^, $mult => li^ * ri^, $div => li^ / ri^, $mod => li^ MOD ri^, $bitor => LOOPHOLE[PBasics.BITOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitand => LOOPHOLE[PBasics.BITAND[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitxor => LOOPHOLE[PBasics.BITXOR[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitshiftleft => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[ri^, PBasics.Word]], CARD], $bitshiftright => LOOPHOLE[PBasics.BITSHIFT[LOOPHOLE[li^, PBasics.Word], LOOPHOLE[-ri^, PBasics.Word]], CARD], ENDCASE => CCError[cirioError]; RETURN[CreateNumericNode[leftType, NEW[LongCard _ newCARD]]]; END; $and, $or => BEGIN newINT: INT _ SELECT op FROM $and => IntFromBool[li^ # 0 AND ri^ # 0], $or => IntFromBool[li^ # 0 OR ri^ # 0], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]] END; $le, $lt, $eq, $ne, $gt, $ge => BEGIN newINT: INT _ SELECT op FROM $le => IntFromBool[li^ <= ri^], $lt => IntFromBool[li^ < ri^], $eq => IntFromBool[li^ = ri^], $ne => IntFromBool[li^ # ri^], $gt => IntFromBool[li^ > ri^], $ge => IntFromBool[li^ >= ri^], ENDCASE => CCError[cirioError]; RETURN[CreateInt[newINT, cc]]; END; ENDCASE => CCError[cirioError]; }; ENDCASE => CCError[cirioError]; }; ENDCASE => CCError[cirioError] }; NumericalUnaryOp: PROC [op: CCTypes.Operator, type:Type, node:Node, cc:CC] RETURNS [Node] ~ { nt: NumericType _ NARROW[CCTypes.GetProcDataFromType[type]]; descriptor: NumericDescriptor _ nt.desc; SELECT descriptor.primary FROM double => { li: REF REAL _ NARROW[CedarCode.GetDataFromNode[node]]; SELECT op FROM $minus => { newREAL: REAL _ -li^; RETURN[CreateNumericNode[type, NEW[REAL _ newREAL]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; float => { li: REF REAL _ NARROW[CedarCode.GetDataFromNode[node]]; SELECT op FROM $minus => { newREAL: REAL _ -li^; RETURN[CreateNumericNode[type, NEW[REAL _ newREAL]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; signed => { li: REF INT _ NARROW[CedarCode.GetDataFromNode[node]]; SELECT descriptor.secondary FROM character, shortInteger => CCError[cirioError]; integer => { SELECT op FROM $minus => { newINT: INT _ -li^; RETURN[CreateNumericNode[type, NEW[LongInt _ newINT]]] }; $bitnot => { newINT: INT _ LOOPHOLE[PBasics.BITNOT[li^], INT]; RETURN[CreateNumericNode[type, NEW[LongInt _ newINT]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; longInteger => { SELECT op FROM $minus => { newINT: INT _ -li^; RETURN[CreateNumericNode[type, NEW[LongInt _ newINT]]] }; $bitnot => { newINT: INT _ LOOPHOLE[PBasics.BITNOT[li^], INT]; RETURN[CreateNumericNode[type, NEW[LongInt _ newINT]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; enumeration => { SELECT op FROM $minus => { newINT: INT _ -li^; RETURN[CreateNumericNode[type, NEW[LongInt _ newINT]]] }; $bitnot => { newINT: INT _ LOOPHOLE[PBasics.BITNOT[li^], INT]; RETURN[CreateNumericNode[type, NEW[LongInt _ newINT]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; ENDCASE => CCError[cirioError]; }; unsigned => { li: REF CARD _ NARROW[CedarCode.GetDataFromNode[node]]; SELECT descriptor.secondary FROM character, shortInteger => CCError[cirioError]; integer => { SELECT op FROM $minus => { newCARD: CARD _ -li^; RETURN[CreateNumericNode[type, NEW[LongCard _ newCARD]]] }; $bitnot => { newCARD: CARD _ LOOPHOLE[PBasics.BITNOT[li^], CARD]; RETURN[CreateNumericNode[type, NEW[LongCard _ newCARD]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; longInteger => { SELECT op FROM $minus => { newCARD: CARD _ -li^; RETURN[CreateNumericNode[type, NEW[LongCard _ newCARD]]] }; $bitnot => { newCARD: CARD _ LOOPHOLE[PBasics.BITNOT[li^], CARD]; RETURN[CreateNumericNode[type, NEW[LongCard _ newCARD]]] }; $not => { newINT: INT _ IntFromBool[li^ = 0]; RETURN[CreateInt[newINT, cc]] }; ENDCASE => CCError[cirioError]; }; ENDCASE => CCError[cirioError]; }; ENDCASE => CCError[cirioError]; }; CreateInt: PROC [newINT: LongInt, cc: CC] RETURNS [Node] ~ { type: Type ~ CreateNumericType[ NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]], cc, NIL]; RETURN CreateNumericNode[type, NEW[LongInt _ newINT]]}; CheckEqualDescriptors: PROC[left, right: NumericDescriptor] = {IF NOT CompareNumericDescriptors[left, right] THEN CCError[cirioError]}; NumericalExamineBoolean: PROC [node: Node, cc: CC] RETURNS [BOOLEAN] ~ { nt: NumericType _ NARROW[CCTypes.GetProcDataFromType[CedarCode.GetTypeOfNode[node]]]; descriptor: NumericDescriptor _ nt.desc; SELECT descriptor.primary FROM signed => SELECT descriptor.secondary FROM character => RETURN [NARROW[CedarCode.GetDataFromNode[node], REF CHAR]^ # 0C]; shortInteger => RETURN [NARROW[CedarCode.GetDataFromNode[node], REF ShortInt]^ # 0]; integer, longInteger, enumeration => RETURN [NARROW[CedarCode.GetDataFromNode[node], REF LongInt]^ # 0]; ENDCASE => CCError[cirioError, "NumericalExamineBoolean: unrecognized signed secondary"]; unsigned => SELECT descriptor.secondary FROM character => RETURN [NARROW[CedarCode.GetDataFromNode[node], REF CHAR]^ # 0C]; shortInteger => RETURN [NARROW[CedarCode.GetDataFromNode[node], REF ShortCard]^ # 0]; integer, longInteger => RETURN [NARROW[CedarCode.GetDataFromNode[node], REF LongCard]^ # 0]; ENDCASE => CCError[cirioError, "NumericalExamineBoolean: unrecognized unsigned secondary"]; double, float => CCError[operation, "floating-point numbers can't be considered as booleans"]; ENDCASE => CCError[cirioError, "NumericalExamineBoolean: unrecognized primary"]; }; NumericalShow: PROC[to: IO.STREAM, node:Node, depth: INT, width: INT, cc: CC] = { nt: NumericType _ NARROW[CCTypes.GetProcDataFromType[CedarCode.GetTypeOfNode[node]]]; descriptor: NumericDescriptor _ nt.desc; SELECT descriptor.primary FROM double => to.PutRope[Convert.RopeFromReal[NARROW[CedarCode.GetDataFromNode[node], REF REAL]^]]; float => to.PutRope[Convert.RopeFromReal[NARROW[CedarCode.GetDataFromNode[node], REF REAL]^]]; signed => SELECT descriptor.secondary FROM character => to.PutRope[Rope.FromChar[NARROW[CedarCode.GetDataFromNode[node], REF CHAR]^]]; shortInteger => to.PutRope[Convert.RopeFromInt[INT[NARROW[CedarCode.GetDataFromNode[node], REF ShortInt]^]]]; integer, longInteger => to.PutRope[Convert.RopeFromInt[NARROW[CedarCode.GetDataFromNode[node], REF LongInt]^]]; enumeration => { code: REF LongInt ~ NARROW[CedarCode.GetDataFromNode[node]]; val: REF ANY ~ RefTab.Fetch[descriptor.enumerationConstants, code].val; IF val # NIL THEN to.PutRope[NARROW[val]]; to.PutF["VAL[0x%x]??", [integer[code^]] ]; }; ENDCASE => CCError[cirioError]; unsigned => SELECT descriptor.secondary FROM character => to.PutRope[Rope.FromChar[NARROW[CedarCode.GetDataFromNode[node], REF CHAR]^]]; shortInteger => to.PutRope[Convert.RopeFromCard[CARD[ORD[NARROW[CedarCode.GetDataFromNode[node], REF ShortCard]^]]]]; integer, longInteger => to.PutRope[Convert.RopeFromCard[NARROW[CedarCode.GetDataFromNode[node], REF LongCard]^]]; ENDCASE => CCError[cirioError]; ENDCASE => CCError[cirioError]; -- shouldn't happen }; }..