<<>> <> <> <> <> <> <> <> <> <> DIRECTORY CCTypes USING[ApplyOperand, BinaryTargetTypes, Conforms, CCError, CCErrorCase, CCTypeProcs, CheckConformance, CoerceToType, ConformanceCheck, CreateCedarType, CreateNodeFromRefAny, GetBooleanType, GetCirioAddressType, GetIndirectType, GetTypeClass, GetNilPointerType, GetNodeType, GetProcDataFromGroundType, GetProcDataFromType, GetRTargetType, GetTargetTypeOfIndirect, Index, Load, LR, Operand, Operator, SelectIdField, UnaryOp, PrintType, GetGroundTypeClass], CedarCode USING[CodeToLoadContentsOfAMNode, CodeToLoadThroughIndirect, CodeToCoerce, CodeToDoBinaryOp, CodeToDoUnaryOp, CodeToStoreUnpopped, ConcatCode, CreateCedarNode, ForceNodeIn, GetDataFromNode, GetNodeRepresentation, GetTypeOfNode, LoadThroughIndirectNode, OperationsBody, ShowNode, StoreThroughIndirectNode, ExtractFieldFromNode, SelectFieldFromNode, Coerce], CedarNumericTypes USING [CreateNumericNode, CreateNumericType], CedarOtherPureTypes USING[CreateBooleanNode, CreateParseTreeNode], CirioSyntacticOperations USING[ParseTree], CirioTypes USING[CirioAddress, BasicTypeInfo, Code, CompilerContext, Mem, Node, Type, TypedCode, TypeClass], IO, PointerTypes USING[PointerNodeInfo], Rope USING[ROPE]; PointerTypesImpl: CEDAR PROGRAM IMPORTS CedarNumericTypes, CCTypes, CedarCode, CedarOtherPureTypes, IO EXPORTS PointerTypes = BEGIN CC: TYPE = CirioTypes.CompilerContext; Type: TYPE = CirioTypes.Type; TypedCode: TYPE = CirioTypes.TypedCode; BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo; Code: TYPE = CirioTypes.Code; Mem: TYPE = CirioTypes.Mem; Node: TYPE = CirioTypes.Node; CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError; PointerInfo: TYPE = REF PointerInfoBody; PointerInfoBody: TYPE = RECORD[ target: Type, bti: BasicTypeInfo]; <> GetReferentType: PUBLIC PROC[pointerType: Type] RETURNS[Type] ~ { pointerInfo: PointerInfo _ NARROW[CCTypes.GetProcDataFromType[pointerType]]; RETURN[pointerInfo.target]}; CreatePointerType: PUBLIC PROC[clientTargetType: Type, cc: CC, bti: BasicTypeInfo] RETURNS[Type] = BEGIN pointerInfo: PointerInfo _ NEW[PointerInfoBody_[clientTargetType, bti]]; type: Type _ CCTypes.CreateCedarType[$pointer, PointerTypeCCTypeProcs, IndirectPointerTypeCCTypeProcs, cc, pointerInfo]; RETURN[type]; END; CreateNilPointerType: PUBLIC PROC[cc: CC] RETURNS[Type] = BEGIN nominal: Type _ CCTypes.GetNilPointerType[cc]; IF nominal # NIL THEN RETURN[nominal]; BEGIN --MJS, May 22, 1991: I think we never make an indirect NilPointer Type, because that would mean there's some memory constrainted by the Type system to have a NIL pointer in it always, which I think doesn't happen. So we can have a NIL bti and no createIndirectNode or getBitSize procs in IndirectNilPointerTypeCCTypeProcs. pointerInfo: PointerInfo _ NEW[PointerInfoBody_[NIL, NIL]]; type: Type _ CCTypes.CreateCedarType[$nilPointer, NilPointerTypeCCTypeProcs, IndirectNilPointerTypeCCTypeProcs, cc, pointerInfo]; RETURN[type]; END; END; PointerTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: PointerCCTypesCheckConformance, binaryOperandTypes: PointerCCTypesBinaryOperandTypes, getRTargetType: PointerCCTypesGetRTargetType, operand: PointerCCTypesOperand, indexOperand: PointerCCTypesIndexOperand, coerceToType: PointerCCTypesCoerceToType, binaryOp: PointerCCTypesBinaryOp, unaryOp: PointerCCTypesUnaryOp, selectIdField: PointerCCTypesSelectIdField, index: PointerCCTypesIndex, printType: PointerCCTypesPrintType]]; PointerCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = BEGIN valInfo: PointerInfo _ NARROW[procData]; WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM varInfo: PointerInfo => BEGIN IF varInfo.target = NIL THEN RETURN[no]; -- var is NIL POINTER, we are not. IF CCTypes.GetTypeClass[varInfo.target] = $unknown THEN RETURN [yes]; RETURN[CCTypes.CheckConformance[CCTypes.GetIndirectType[valInfo.target], CCTypes.GetIndirectType[varInfo.target], cc]]; END; ENDCASE => RETURN[no]; END; PointerCCTypesBinaryOperandTypes: PROC[op: CCTypes.Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] = BEGIN leftInfo: PointerInfo _ NARROW[procData]; rightClass: CirioTypes.TypeClass _ CCTypes.GetGroundTypeClass[right, cc]; SELECT op FROM $assign => <> <> RETURN[[CCTypes.GetIndirectType[leftInfo.target], leftInfo.target]]; $plus, $minus => BEGIN SELECT rightClass FROM $numeric => BEGIN ptrOffsetType: Type _ PointerAddType[cc]; RETURN [[left, ptrOffsetType]]; END; $pointer => BEGIN ptrDiffType: Type _ PointerDiffType[cc]; IF op # $minus THEN CCE[cirioError]; RETURN [[ptrDiffType, ptrDiffType]]; END; ENDCASE => CCE[cirioError]; END; $eq, $ne, $lt, $gt, $le, $ge => RETURN [[left, left]]; ENDCASE => CCE[cirioError]; END; <<>> <> PointerCCTypesGetRTargetType: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] = BEGIN pointerTypeInfo: PointerInfo _ NARROW[procData]; RETURN[pointerTypeInfo.target]; END; PointerCCTypesOperand: PROC[op: CCTypes.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN pointerTypeInfo: PointerInfo _ NARROW[procData]; IF pointerTypeInfo.target = NIL THEN -- we are dealing with a POINTER TO UNSPECIFIED. <> <> RETURN[CCTypes.CoerceToType[CCTypes.GetNodeType[cc], tc, cc]] ELSE -- we are not dealing with a POINTER TO UNSPECIFIED. SELECT op FROM $selectId, $uparrow, $index, $leftSideuparrow => RETURN[tc]; $plus, $minus => RETURN[tc]; $dot, $extractId, $apply => -- try dereferencing first BEGIN tc1: TypedCode _ CCTypes.UnaryOp[$uparrow, tc, cc]; RETURN[CCTypes.Operand[op, lr, tc1, cc]]; END; $eq, $ne, $lt, $gt, $le, $ge => RETURN[tc]; ENDCASE => CCE[operation]; -- client error, invalid operation END; PointerCCTypesIndexOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN pointerTypeInfo: PointerInfo _ NARROW[procData]; IF pointerTypeInfo.target = NIL THEN -- we are dealing with a POINTER TO UNSPECIFIED. <> <> BEGIN node: Node _ CedarOtherPureTypes.CreateParseTreeNode[operand, cc]; code: CirioTypes.Code _ CedarCode.CodeToLoadContentsOfAMNode[node]; type: Type _ CCTypes.GetNodeType[cc]; RETURN[[code, type]]; END ELSE -- we are not dealing with a POINTER TO UNSPECIFIED. <> RETURN[CCTypes.ApplyOperand[pointerTypeInfo.target, operand, cc]]; END; <> <> <> PointerCCTypesCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN IF CCTypes.Conforms[CCTypes.GetCirioAddressType[cc], targetType, cc] OR CCTypes.Conforms[PointerDiffType[cc], targetType, cc] THEN BEGIN code: Code _ CedarCode.ConcatCode[tc.code, CedarCode.CodeToCoerce[tc.type, targetType]]; RETURN [[code, targetType]]; END ELSE CCE[typeConformity]; END; PointerCCTypesBinaryOp: PROC[op: CCTypes.Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN rightClass: CirioTypes.TypeClass _ CCTypes.GetGroundTypeClass[right.type, cc]; finalOp: CCTypes.Operator _ SELECT TRUE FROM op = $plus AND rightClass = $numeric => $incrementPointer, op = $minus AND rightClass = $numeric => $decrementPointer, op = $minus AND rightClass = $pointer => $pointerDifference, op = $eq AND rightClass = $pointer => $pointerEq, op = $ne AND rightClass = $pointer => $pointerNe, op = $lt AND rightClass = $pointer => $pointerLt, op = $gt AND rightClass = $pointer => $pointerGt, op = $le AND rightClass = $pointer => $pointerLe, op = $ge AND rightClass = $pointer => $pointerGe, ENDCASE => CCE[operation]; finalType: Type _ SELECT TRUE FROM op = $plus AND rightClass = $numeric => left.type, op = $minus AND rightClass = $numeric => left.type, op = $minus AND rightClass = $pointer => PointerDiffType[cc], rightClass = $pointer AND (op = $eq OR op = $ne OR op = $lt OR op = $gt OR op = $le OR op = $ge) => CCTypes.GetBooleanType[cc], ENDCASE => CCE[operation]; code: CirioTypes.Code _ CedarCode.ConcatCode[left.code, CedarCode.ConcatCode[right.code, CedarCode.CodeToDoBinaryOp[finalOp, left.type, right.type]]]; RETURN [[code, finalType]]; END; PointerCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN pointerTypeInfo: PointerInfo _ NARROW[procData]; SELECT op FROM $leftSideuparrow => BEGIN type: Type _ CCTypes.GetIndirectType[pointerTypeInfo.target]; RETURN[[arg.code, type]]; END; $uparrow => BEGIN code2: Code _ CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[pointerTypeInfo.target]]; code: Code _ CedarCode.ConcatCode[arg.code, code2]; RETURN[[code, pointerTypeInfo.target]]; END; ENDCASE => CCE[typeConformity]; -- client type error END; <> PointerCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN pointerTypeInfo: PointerInfo _ NARROW[procData]; type1: Type _ CCTypes.GetIndirectType[pointerTypeInfo.target]; tc2: TypedCode _ CCTypes.SelectIdField[id, type1, cc]; RETURN[[tc2.code, tc2.type]]; END; PointerCCTypesIndex: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN pointerTypeInfo: PointerInfo _ NARROW[procData]; type1: Type _ CCTypes.GetIndirectType[pointerTypeInfo.target]; tc1: TypedCode _ [operator.code, type1]; RETURN[CCTypes.Index[tc1, operand, cc]]; END; PointerCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = { pointerTypeInfo: PointerInfo _ NARROW[procData]; pointerTypeClass: CirioTypes.TypeClass _ CCTypes.GetGroundTypeClass[type, cc]; to.PutRope["LONG POINTER TO "]; CCTypes.PrintType[to, pointerTypeInfo.target, printDepth, printWidth, cc]; RETURN}; NilPointerTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: NilPointerCCTypesCheckConformance]]; NilPointerCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = BEGIN valInfo: PointerInfo _ NARROW[procData]; WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM varInfo: PointerInfo => RETURN[yes]; -- NIL POINTER conforms to all POINTER types. ENDCASE => RETURN[no]; END; IndirectPointerTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ createIndirectNode: PointerCreateIndirect, getBitSize: PointerBitSize, operand: IPointerCCTypesOperand, unaryOp: IPointerCCTypesUnaryOp, store: IPointerCCTypesStore, load: IPointerCCTypesLoad, printType: PointerCCTypesPrintType]]; IndirectNilPointerTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ store: INilPointerCCTypesStore, load: INilPointerCCTypesLoad]]; <> PointerCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ { pointerInfo: PointerInfo ~ NARROW[procData]; IF pointerInfo.bti=NIL THEN CCE[cirioError, "a pointer Type not connected to the target world is being asked to CreateIndirect"]; RETURN pointerInfo.bti.createIndirectNode[pointerInfo.bti, cc, indirectType, targetType, mem]}; PointerBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ { pointerInfo: PointerInfo ~ NARROW[procData]; IF pointerInfo.bti=NIL THEN CCE[cirioError, "a pointer Type not connected to the target world is being asked to GetBitSize"]; RETURN pointerInfo.bti.getBitSize[pointerInfo.bti, cc, indirectType, targetType]}; IPointerCCTypesOperand: PROC[op: CCTypes.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN SELECT op FROM $selectId, $index, $leftSideuparrow => -- try dereferencing first BEGIN tc1: TypedCode _ CCTypes.Load[tc, cc]; RETURN[CCTypes.Operand[op, lr, tc1, cc]]; END; $address => RETURN[tc]; ENDCASE => CCE[operation]; -- client error, invalid operation END; <> IPointerCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN SELECT op FROM $address => BEGIN code: CirioTypes.Code _ CedarCode.ConcatCode[ arg.code, CedarCode.CodeToDoUnaryOp[op, arg.type]]; ptrType: Type _ CreatePointerType[CCTypes.GetTargetTypeOfIndirect[arg.type], cc, NIL--it's OK to give a NIL bti because the resultant pointer Type will never be asked to CreateIndirectNode or GetBitSize--]; RETURN [[code, ptrType]]; END; ENDCASE => CCE[cirioError]; END; IPointerCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.ConcatCode[ value.code, CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]]; RETURN[[code, value.type]]; END; IPointerCCTypesLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.CodeToLoadThroughIndirect[indirect.type]]; type: Type _ CCTypes.GetRTargetType[indirect.type, cc]; RETURN[[code, type]]; END; INilPointerCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.ConcatCode[ value.code, CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]]; RETURN[[code, value.type]]; END; INilPointerCCTypesLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.CodeToLoadThroughIndirect[indirect.type]]; type: Type _ CCTypes.GetRTargetType[indirect.type, cc]; RETURN[[code, type]]; END; <> <<>> <> <> <> <<>> <> <> <> <<>> <> CreatePointerNode: PUBLIC PROC[type: Type, info: PointerTypes.PointerNodeInfo, cc: CC] RETURNS[Node] = BEGIN RETURN[CedarCode.CreateCedarNode[PointerNodeOps, type, info]]; END; CreateNilPointerNode: PUBLIC PROC[cc: CC] RETURNS[Node] = {RETURN[CedarCode.CreateCedarNode[NilPointerNodeOps, CreateNilPointerType[cc], NIL]]}; PointerNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ getCurrentType: PointerNodeGetCurrentType, coerce: PointerNodeCoerce, binaryOp: PointerNodeBinaryOp, store: PointerNodeStore, load: PointerNodeLoad, selectField: PointerNodeSelectField, show: PointerNodeShow, getNodeRepresentation: PointerNodeGetRepresentation]]; <> PointerNodeGetCurrentType: PROC[node: Node, cc: CC] RETURNS[Type] = {RETURN[CedarCode.GetTypeOfNode[node]]}; PointerNodeCoerce: PROC [sourceType, targetType: Type, node: Node, cc: CC] RETURNS [Node] = BEGIN indirectNodeData: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]]; targetClass: CirioTypes.TypeClass _ CCTypes.GetGroundTypeClass[targetType, cc]; IF targetClass = $pointer THEN RETURN [CreatePointerNode[targetType, indirectNodeData, cc]] ELSE IF CCTypes.Conforms[CCTypes.GetCirioAddressType[cc], targetType, cc] THEN BEGIN <> address: CirioTypes.CirioAddress _ indirectNodeData.getAddress[indirectNodeData.data, cc]; RETURN[CCTypes.CreateNodeFromRefAny[NEW[CirioTypes.CirioAddress_address], cc]]; END ELSE BEGIN <> ptrCardValue: CARD _ indirectNodeData.pointerCardValue[indirectNodeData.data]; refInt: REF INT _ NEW [INT _ ptrCardValue]; intType: Type _ PointerDiffType[cc]; intNode: Node _ CedarNumericTypes.CreateNumericNode[intType, refInt]; RETURN [CedarCode.Coerce[intType, targetType, intNode, cc]]; END; END; <<>> PointerNodeBinaryOp: PROC[op: CCTypes.Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] = BEGIN indirectLeftNodeData: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[leftNode]]; SELECT op FROM $incrementPointer, $decrementPointer => BEGIN refNominalOffset: REF ANY _ CedarCode.GetNodeRepresentation[rightNode, cc]; nominalOffset: INT _ WITH refNominalOffset SELECT FROM refint: REF INT => refint^, refcard: REF CARD => IF refcard^ > CARD[LAST[INT]] THEN CCE[cirioError] ELSE refcard^, ENDCASE => CCE[cirioError]; offset: INT _ SELECT op FROM $incrementPointer => nominalOffset, $decrementPointer => - nominalOffset, ENDCASE => CCE[cirioError]; newPointer: Node _ indirectLeftNodeData.pointerAdd[offset, indirectLeftNodeData.data, cc]; RETURN [newPointer]; END; $pointerDifference => BEGIN abs1: INT _ INT[indirectLeftNodeData.pointerCardValue[indirectLeftNodeData.data]]; indirectRightNodeData: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[rightNode]]; abs2: INT _ INT[indirectRightNodeData.pointerCardValue[indirectRightNodeData.data]]; refDelta: REF INT _ NEW[INT_(abs2-abs1)]; RETURN[CedarNumericTypes.CreateNumericNode[PointerDiffType[cc], refDelta]]; END; $pointerEq, $pointerNe, $pointerLt, $pointerGt, $pointerLe, $pointerGe => BEGIN abs1: INT _ INT[indirectLeftNodeData.pointerCardValue[indirectLeftNodeData.data]]; indirectRightNodeData: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[rightNode]]; abs2: INT _ INT[indirectRightNodeData.pointerCardValue[indirectRightNodeData.data]]; ans: BOOL _ SELECT op FROM $pointerEq => abs1 = abs2, $pointerNe => abs1 # abs2, $pointerLt => abs1 < abs2, $pointerGt => abs1 > abs2, $pointerLe => abs1 <= abs2, $pointerGe => abs1 >= abs2, ENDCASE => CCE[cirioError]; RETURN[CedarOtherPureTypes.CreateBooleanNode[ans, cc]]; END; ENDCASE => CCE[cirioError]; END; <<>> PointerNodeStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = BEGIN indirectData: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; indirectBody: Node _ indirectData.indirectToClientTarget; CedarCode.StoreThroughIndirectNode[valType, valNode, indirectType, indirectBody, cc]; END; PointerNodeLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN -- note: indirectType is compile time, and does not know the actual type. valType: Type _ CCTypes.GetRTargetType[CedarCode.GetTypeOfNode[indirectNode], cc]; data: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; RETURN[CreatePTNode[valType, DelayedLoadExtractBody, data, cc, FALSE]]; END; PointerNodeSelectField: PROC[id: Rope.ROPE, indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN indirectData: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; indirectBody: Node _ indirectData.indirectToClientTarget; RETURN [CedarCode.SelectFieldFromNode[id, indirectType, indirectBody, cc]]; END; PointerNodeShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = { data: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]]; IF depth < 4 THEN { ptrVal: CARD _ data.pointerCardValue[data.data]; to.PutF["%xH@", [cardinal[ptrVal]] ]; } ELSE { pointerType: Type _ CedarCode.GetTypeOfNode[node]; pointerTypeInfo: PointerInfo _ NARROW[CCTypes.GetProcDataFromGroundType[pointerType, cc]]; target: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[pointerTypeInfo.target], data.indirectToClientTarget, cc]; to.PutChar['^]; CedarCode.ShowNode[to, target, depth-1, width, cc]; }; }; PointerNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] = BEGIN data: PointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]]; RETURN[data]; END; NilPointerNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ getCurrentType: NilPointerNodeGetCurrentType, extractField: NilPointerNodeExtractField, show: NilPointerNodeShow, getNodeRepresentation: NilPointerNodeGetRepresentation]]; NilPointerNodeGetCurrentType: PROC[node: Node, cc: CC] RETURNS[Type] = {CCE[cirioError]}; <> NilPointerNodeExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] = {CCE[operation, "NIL fault"]}; <> NilPointerNodeShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {to.PutRope["NIL"]}; NilPointerNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] = {RETURN[NIL]}; <> DelayedLoadExtractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node] = BEGIN data: PointerTypes.PointerNodeInfo _ NARROW[procData]; indirectBody: Node _ data.indirectToClientTarget; indirectBodyType: Type _ CedarCode.GetTypeOfNode[indirectBody]; RETURN[CedarCode.LoadThroughIndirectNode[indirectBodyType, indirectBody, cc]]; END; <> PTData: TYPE = RECORD[ type: Type, alreadyIn: BOOLEAN, extractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node], procData: REF ANY]; CreatePTNode: PROC[type: Type, extractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node], procData: REF ANY, cc: CC, alreadyIn: BOOLEAN] RETURNS[Node] = BEGIN rtData: REF PTData _ NEW[PTData_[type, alreadyIn, extractBody, procData]]; node: Node _ CedarCode.CreateCedarNode[PTOps, type, rtData]; RETURN[node]; END; PTOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ forceIn: PTForceIn, extractField: PTExtractField, show: PTShow]]; PTForceIn: PROC[type: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN rtData: REF PTData _ NARROW[CedarCode.GetDataFromNode[node]]; IF rtData.alreadyIn THEN RETURN[node] ELSE BEGIN nominalBody: Node _ rtData.extractBody[rtData.procData, cc]; bodyType: Type _ CedarCode.GetTypeOfNode[nominalBody]; body: Node _ CedarCode.ForceNodeIn[bodyType, nominalBody, cc]; RETURN[ConstructPTNode[type, body, cc]]; END; END; PTExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN rtData: REF PTData _ NARROW[CedarCode.GetDataFromNode[node]]; body: Node _ rtData.extractBody[rtData.procData, cc]; RETURN [CedarCode.ExtractFieldFromNode[id, type, body, cc]]; END; PTShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = { rtData: REF PTData _ NARROW[CedarCode.GetDataFromNode[node]]; body: Node _ rtData.extractBody[rtData.procData, cc]; CedarCode.ShowNode[to, body, depth, width, cc]; RETURN}; <> CPTNodeData: TYPE = RECORD[ body: Node]; ConstructPTNode: PROC[type: Type, body: Node, cc: CC] RETURNS[Node] = BEGIN data: REF CPTNodeData _ NEW[CPTNodeData_[body]]; RETURN[CreatePTNode[type, CPTNodeExtractBody, data, cc, TRUE]]; END; CPTNodeExtractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node] = BEGIN data: REF CPTNodeData _ NARROW[procData]; RETURN[NARROW[data.body]]; END; <> PointerAddType: PROC [cc: CC] RETURNS [Type] = BEGIN RETURN [CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL]]; END; PointerDiffType: PROC [cc: CC] RETURNS [Type] = BEGIN RETURN [CedarNumericTypes.CreateNumericType[[32, signed[full[]]], cc, NIL]]; END; END..