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..

4
PointerTypesImpl.mesa
Copyright Σ 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
theimer May 1, 1989 10:23:36 pm PDT
Last changed by Theimer on August 27, 1989 11:47:25 pm PDT
Sturgis, September 13, 1989 3:56:58 pm PDT
Hopcroft July 26, 1989 11:04:13 am PDT
Spreitze, January 9, 1992 9:31 am PST
Laurie Horton, February 3, 1992 12:38 pm PST
Started by theimer by copying from PointerTypesImpl.mesa at May 1, 1989 4:56:50 pm PDT.
target = NIL is used for NIL POINTER;  target = UNKNOWN type is used for POINTER TO UNSPECIFIED.
someone is trying to store through the POINTER
arrange to give him an indirect to the body

Someone is trying to do an assignment through a POINTER and needs a (tentative) target type for the compilation of the right hand side. Lets give him the client target type.
True Cedar would reject this situation
We package everything up into nodes and try again at run time
True Cedar would reject this situation
generate code to package the operand into a node.  This will cause the caller to package the operator into a node and try again at run time.
treat the operand the same as would be done for an ApplyOperand of the pointer target type
By the time we get here, we know that we do not conform
So we try handing out an indirect to the body of the target
This is exactly what PointerCCTypesBinaryOperandTypes is expecting us to do when we are the left hand side of an assignment.
hopefully, the id will be recognized by the body
The code for load and store seems to be common to a lot of types.  How can we make use of this fact?
note: this is identical to the code for DefaultIndirect.  How might we safely take advantage of this?
Nodes begin here

There are four types which are candidates for node constructions.  Not all are necessary here.  Currently (December 15, 1988) PrincOpsFrameContextImpl provides a general mechanism for indirects to fields from which atomic loads and stores will be made.  This mechanism suffices for Indirects to Pointers.  (Eventually, that mechanism will be moved to a more general location that is not target world specific.  However, it should still be a general machanism that will cover indirects to Pointers.)
That leaves nodes of three varieties: Pointers, indirects to PointerTargets, and PointerTargets.
Pointer nodes

PointerNodeData: TYPE = RECORD[
indirectToPointerTarget: Node,
info: PointerTypes.PointerNodeInfo];

We can compute the actualPointerType safely since the target of a POINTER cannot change its type.  Or, another way to say this, is that if type is for  a POINTER TO UNSPECIFIED, then type is a union type, and the rule is that when loading a union type, we construct a node whose type is the type of the actually loaded value.
since pointer targets never change type, when this node was created it acquired a type that will always be good.
We are coercing to a CirioAddress; which is intended to represent a Cirio address.  Manufacture a CirioAddress from the pointer's value.
We are coercing to a numeric type.


Not sure what I should implement.  A NARROW should always succeed.  Not sure if there are other clients.
hmm, if the rope was "&indirectToBody" maybe I should have returned a nilIndirectToClientBody, which would have rejected whatever the subsequent operation was.
The interface says this returns NIL.
PointerTarget nodes
Constructed PTNodes
Useful routines
Κ•NewlineDelimiter

™
codeš
œ™K™HKš
œ#™#K™:K™*K™&K™%K™,—K˜Kš
œW™WK˜š
Οk	˜	KšœœςœL˜ΝKšœ
œί˜ξKšœœ(˜?Kšœœ)˜BKšœœ˜*Kšœœ\˜lKšœ
˜Kšœ
œ˜$Kšœœ
œ˜—K˜šΟnœœ
˜Kšœ=˜FKšœ
˜—Kšœ˜Kšœœ˜&Kšœœ˜Kšœœ˜'Kšœœ˜/Kšœœ˜Kšœœ˜Kšœœ˜šœœ&œœ˜NK˜—˜Kšœ
œœ˜(šœœœ
˜Kš
œ
˜
Kš
œ˜Kš
œ`™`—K˜šžœœ
œœ
˜AKšœœ+˜LKšœ˜—K˜š
žœœ
œœœ˜bKš
˜Kšœœ*˜HK˜xKšœ˜
Kšœ
˜—K˜š
žœœ
œœœ˜9Kš
˜K˜.šœœ
œ
œ
˜&Kšœ
ΟcΓ˜ΙKšœœœœ˜;K˜
Kšœ˜
Kšœ
˜—Kšœ
˜—K˜šžœœœ˜LK˜1K˜5K˜-K˜K˜)K˜)K˜!K˜K˜+K˜K˜%—K˜šžœœœœ
œœ˜{Kš
˜Kšœœ˜(šœ0œ
˜?˜Kš
˜Kš	œœ
œ
œŸ"˜KKšœ1œ
œ˜EKšœq˜wKšœ
˜—Kšœœ˜—Kšœ
˜—K˜šž œœ.œœ
œœ˜
Kš
˜Kšœœ˜)K˜Išœ˜˜
Kš
œ.™.Kš
œ+™+Kšœ>˜D—š
œ˜Kš
˜šœ˜š
œ˜Kš
˜K˜)Kšœ˜Kšœ
˜—š
œ˜Kš
˜K˜(Kšœ
œ
œ
˜$Kšœ˜$Kšœ
˜—Kšœœ
˜—Kšœ
˜—Kšœ œ˜6Kšœœ
˜—Kšœ
˜—K˜™Kš
œ­
™­
—šžœœœœ
œœ˜YKš
˜Kšœœ˜0Kšœ˜Kšœ
˜—K˜šžœœ#œœœ
œœ
˜€
Kš
˜Kšœœ˜0šœœ
œ
Ÿ0˜UKš
œ&™&Kš
œ=™=Kšœ7˜=šœ
Ÿ4˜9šœ˜Kšœ1œ˜<Kšœœ˜šœŸ˜6Kš
˜K˜3Kšœ#˜)Kšœ
˜—Kšœ œ˜+Kšœœ
Ÿ"˜=———Kšœ
˜—K˜šžœœFœœ
œœ
˜‘
Kš
˜Kšœœ˜0šœœ
œ
Ÿ0˜UKš
œ&™&Kš
œŒ
™Œ
Kš
˜K˜BK˜CK˜%Kšœ˜Kš
˜šœ
Ÿ4˜9Kš
œZ™ZKšœ<˜B——Kšœ
˜—˜Kš
œ7™7š
œ;™;Kš
œ|™|——šžœœ&œœ
œœ
˜qKš
˜šœCœ7˜‚
Kš
˜Kš
œX˜XKšœ˜Kš
˜—šœ
˜Kšœ˜—Kšœ
˜—K˜šžœœ3œœ
œœ
˜zKš
˜K˜Nšœœ
œ
˜,Kšœœ,˜:Kšœœ,˜;Kšœœ-˜<Kšœ	œ%˜1Kšœ	œ%˜1Kšœ	œ%˜1Kšœ	œ%˜1Kšœ	œ%˜1Kšœ	œ%˜1Kšœœ
˜—šœœ
œ
˜"Kšœœ$˜2Kšœœ$˜3Kšœœ.˜=Kš
œœœ
œ
œ
œ
œ)˜Kšœœ˜—Kš
œ–
˜–
Kšœ˜Kšœ
˜—K˜šžœœ+œœ
œœ
˜qKš
˜Kšœœ˜0šœ˜˜Kš
˜Kš
œ=˜=Kšœ˜Kšœ
˜—˜Kš
˜Kš
œc˜cK˜3Kšœ!˜'Kšœ
˜—KšœœŸ˜4—Kšœ
˜—K˜˜Kš
œ0™0—šžœœ
œ"œœ
œœ
˜|Kš
˜Kšœœ˜0Kš
œ>˜>K˜6Kšœ˜Kšœ
˜—K˜šžœœ.œœ
œœ
˜rKš
˜Kšœœ˜0Kš
œ>˜>K˜(Kšœ"˜(Kšœ
˜—K˜šžœœœ
œœœœœ
œ˜zKšœœ˜0K˜NKš
œ˜Kš
œJ˜JKšœ˜—K˜šžœœœ˜OK˜6—K˜šž!œœœœ
œœ˜~Kš
˜Kšœœ˜(šœ0œ
˜?˜KšœŸ-˜:—Kšœœ˜—Kšœ
˜—K˜K˜K˜šžœœœ˜TK˜*K˜K˜ K˜ K˜K˜K˜%—K˜šž!œœœ˜WK˜K˜—˜Kš
œd™d—K˜šžœœœœ
œ,œ˜tKšœœ˜,Kšœœ
œ
œb˜
KšœY˜_—K˜šžœœ%œœ
œœ
œ˜aKšœœ˜,Kšœœ
œ
œ^˜}KšœL˜R—K˜šžœœ#œœœ
œœ
˜
Kš
˜šœ˜šœ'Ÿ˜AKš
˜K˜&Kšœ#˜)Kšœ
˜—Kšœœ˜Kšœœ
Ÿ"˜=—Kšœ
˜—˜K™e—šžœœ+œœ
œœ
˜rKš
˜šœ˜š
œ˜Kš
˜˜-K˜	Kš
œ)˜)—KšœQŸxœ˜Ξ
Kšœ˜Kšœ
˜—Kšœœ
˜—Kšœ
˜—šžœœ,œœ
œœ
˜qKš
˜˜"K˜˜K˜K˜;——Kšœ˜Kšœ
˜—K˜šžœœœœ
œœ
˜^Kš
˜˜"K˜K˜4—K˜7Kšœ˜Kšœ
˜—K˜šžœœ,œœ
œœ
˜tKš
˜˜"K˜˜K˜K˜;——Kšœ˜Kšœ
˜—K˜šžœœœœ
œœ
˜aKš
˜˜"K˜K˜4—K˜7Kšœ˜Kšœ
˜——K˜š
œ™K™—˜Kš
œς™ςKš
œ`™`K˜K˜Kš
œ
™
™šœœœ
™K™K™$K™Kš
œΕ™Ε—š
žœœ
œ5œœ˜fKš
˜Kšœ8˜>Kšœ
˜—K˜š
žœœ
œœœ˜9Kšœ
œHœ˜V—K˜K˜šžœœœ˜MK˜*K˜K˜K˜K˜K˜$K˜K˜6—K˜˜Kš
œp™p—šžœœœœ˜CKšœ
œ!˜(—K˜šΠbnœœ0œœ	˜[Kš
˜Kšœ1œ"˜YKš
œO˜Ošœœ
˜Kšœ6˜<—šœ
œC˜NKš
˜K™ˆ
Kš
œZ˜ZKšœœ(˜OKš
˜—šœ
˜Kš
˜K™"Kšœœ<˜NKš	œœ
œœœ˜,K˜$Kš
œE˜EKšœ6˜<Kšœ
˜—Kšœ
˜—K™šžœœQœœ˜}Kš
˜Kšœ5œ&˜ašœ˜š
œ(˜(Kš
˜Kšœœ
œ2˜Kšœœœœ
˜6Kšœœ
œ˜Kšœ	œ
œœœ
œ
œœ
œ
œ
˜VKšœœ
˜—šœœœ˜Kš
œ#˜#Kš
œ%˜%Kšœœ
˜—Kš
œZ˜ZKšœ˜Kšœ
˜—š
œ˜Kš
˜KšœœœC˜RKšœ6œ'˜cKšœœœE˜TKš	œ
œ
œœ
œ˜)KšœE˜KKšœ
˜—š
œJ˜JKš
˜KšœœœC˜RKšœ6œ'˜cKšœœœE˜Tšœœœœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœœ
˜—Kšœ1˜7Kšœ
˜—Kšœœ
˜—Kšœ
˜—K™K˜šžœœKœ˜fKš
˜Kšœ-œ*˜]Kš
œ9˜9K˜UKšœ
˜—K˜šžœœ-œœ˜UKšœŸI˜PK˜RKšœ%œ*˜UKšœ9œ˜GKšœ
˜—K˜š
žœœ
œ.œœ˜kKš
˜Kšœ-œ*˜]Kš
œ9˜9KšœE˜KKšœ
˜—K˜šžœœœ
œœ	œœ˜TKšœ%œ"˜Mšœœ˜Kšœœ$˜0Kš
œ%˜%Kš
œ
˜
—šœ˜K˜2Kšœœ5˜ZK˜ƒ
K˜Kš
œ3˜3Kš
œ˜—Kš
œ˜—K˜šžœœœœ
œ
œ˜IKš
˜Kšœ%œ"˜MKšœ˜
Kšœ
˜—K˜K˜šžœœœ˜PK˜-K˜)K˜K˜9—K˜šžœœœœ˜Fšœ
œ˜Kš
œh™h——K˜š
žœœ
œœœ˜_šœ
œ˜Kš
œŸ
™Ÿ
——K˜Kšžœœœ
œœ	œœ˜jK˜šžœœœœ
œ
œ˜Lšœ
œ
œ˜Kš
œ$™$———K˜K˜šžœœœ
œœœ˜GKš
˜Kšœ%œ˜6K˜1K˜?KšœH˜NKšœ
˜—K˜K˜K˜š
œ™K˜šœœœ
˜K˜Kšœœ
˜Kšœ
œœ
œœœ˜;Kšœ
œ
œ˜—K˜šžœœœœ
œœœœ
œœ
œœ˜™
Kš
˜Kšœœ
œ2˜JK˜<Kšœ˜
Kšœ
˜—K˜šžœœœ˜DK˜K˜K˜K˜—šž	œœœœ˜?Kš
˜Kšœœ
œ"˜=šœœ
œ˜%š
˜Kš
˜K˜<K˜6K˜>Kšœ"˜(Kšœ
˜——K˜Kšœ
˜—K˜š
žœœ
œœœ˜SKš
˜Kšœœ
œ"˜=Kš
œ5˜5Kšœ6˜<Kšœ
˜—K˜šžœœœ
œœ	œœ˜KKšœœ
œ"˜=K˜5Kš
œ/˜/Kšœ˜—K˜K˜K˜—š
œ™K˜šœ
œœ
˜K˜—K˜šžœœœœ˜EKš
˜Kšœœœ˜0Kšœ2œ˜?Kšœ
˜—K˜šžœœœ
œœœ˜CKš
˜Kšœœœ˜)Kšœ
œ
˜Kšœ
˜———K˜K˜™K˜šžœœœœ	˜.Kš
˜Kšœ@œ˜LKšœ
˜—K˜šžœœœœ	˜/Kš
˜Kšœ@œ˜LKšœ
˜——˜K˜—Kšœ˜—…—VΠ{