<<>> <> <> <> <> <> <> DIRECTORY Basics USING [BITAND, BITNOT, BITOR, BITSHIFT, BITXOR], 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, Rope USING [Cat, FromChar, ROPE], Real USING [Fix], RefTab USING [Fetch]; <> <> CNumericTypesImpl: CEDAR PROGRAM IMPORTS Basics, CCTypes, CedarCode, Convert, IO, 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; [] ¬ Basics.BITXOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]]; newINT ¬ SELECT op FROM $plus => li­ + ri­, $minus => li­ - ri­, $mult => li­ * ri­, $div => li­ / ri­, $mod => li­ MOD ri­, $bitor => LOOPHOLE[Basics.BITOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitand => LOOPHOLE[Basics.BITAND[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitxor => LOOPHOLE[Basics.BITXOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitshiftleft => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], ri­], INT], $bitshiftright => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, 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[Basics.BITOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitand => LOOPHOLE[Basics.BITAND[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitxor => LOOPHOLE[Basics.BITXOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitshiftleft => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitshiftright => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[-ri­, 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[Basics.BITOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitand => LOOPHOLE[Basics.BITAND[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitxor => LOOPHOLE[Basics.BITXOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitshiftleft => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], INT], $bitshiftright => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[-ri­, 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[Basics.BITOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitand => LOOPHOLE[Basics.BITAND[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitxor => LOOPHOLE[Basics.BITXOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitshiftleft => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitshiftright => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[-ri­, 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[Basics.BITOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitand => LOOPHOLE[Basics.BITAND[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitxor => LOOPHOLE[Basics.BITXOR[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitshiftleft => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[ri­, WORD]], CARD], $bitshiftright => LOOPHOLE[Basics.BITSHIFT[LOOPHOLE[li­, WORD], LOOPHOLE[-ri­, 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[Basics.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[Basics.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[Basics.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[Basics.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[Basics.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.PutF1["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 }; }..