

DIRECTORY
CCTypes USING[BinaryTargetTypes, BreakPrintType, CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, CreateCedarType, GetIndirectType, GetProcDataFromGroundType, GetTypeClass, LR, Operator],
CedarCode USING[CodeToDoBinaryOp, CodeToLoadThroughIndirect, ConcatCode, CreateCedarNode, GetDataFromNode, LoadThroughIndirectNode, OperationsBody, ShowNode],
CirioTypes USING[BasicTypeInfo, Code, CompilerContext, Mem, Node, Type, TypedCode, TypeClass],
CNumericTypes USING [CreateNumericType, GetDescriptorFromCNumericType, NumericDescriptor, NumericDescriptorBody],
CPointerTypes USING[PointerNodeInfo],
IO,
Rope;

CPointerTypesImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, CNumericTypes, IO
EXPORTS CPointerTypes
= BEGIN
CC: TYPE = CirioTypes.CompilerContext;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
Code: TYPE = CirioTypes.Code;
Node: TYPE = CirioTypes.Node;
Mem: TYPE = CirioTypes.Mem;
BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;
PointerInfo: TYPE = REF PointerInfoBody;
PointerInfoBody: TYPE = RECORD[
target: Type,
bti: BasicTypeInfo];

pointerClass: ATOM = $pointer;
numberClass: ATOM = $numeric;

CreatePointerType: PUBLIC PROC[clientTargetType: Type, cc: CC, bti: BasicTypeInfo] RETURNS[Type] = {
pointerInfo: PointerInfo _ NEW[PointerInfoBody_[clientTargetType, bti]];
type: Type _ CCTypes.CreateCedarType[pointerClass, PointerTypeCCTypeProcs, IndirectPointerTypeCCTypeProcs, cc, pointerInfo];
RETURN[type]};

IndirectPointerTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
createIndirectNode: PointerCreateIndirect,
getBitSize: PointerBitSize]];

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]};

PointerTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
checkConformance: PointerCCTypesCheckConformance,
binaryOperandTypes: PointerCCTypesBinaryOperandTypes,
getRTargetType: PointerCCTypesGetRTargetType,
operand: PointerCCTypesOperand,
coerceToType: PointerCCTypesCoerceToType,
unaryOp: PointerCCTypesUnaryOp,
binaryOp: PointerCCTypesBinaryOp,
printType: PointerCCTypesPrintType]];

PointerCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = {
valInfo: PointerInfo _ NARROW[procData];
varClass: ATOM _ CCTypes.GetTypeClass[varType];
SELECT varClass FROM
pointerClass => {
varInfo: PointerInfo ~ NARROW[CCTypes.GetProcDataFromGroundType[varType, cc]];
RETURN[CCTypes.CheckConformance[
CCTypes.GetIndirectType[valInfo.target],
CCTypes.GetIndirectType[varInfo.target],
cc]]};
numberClass => {
intType: CirioTypes.Type _ CNumericTypes.CreateNumericType[
NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]],
cc, NIL];
RETURN[CCTypes.CheckConformance[intType, varType, cc]]};
ENDCASE => RETURN[no];
};

PointerCCTypesBinaryOperandTypes: PROC[op: CCTypes.Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] = {
rightClass: ATOM _ CCTypes.GetTypeClass[right];
SELECT rightClass FROM
pointerClass => RETURN[[left,right]];
numberClass => {
intType: CirioTypes.Type _ CNumericTypes.CreateNumericType[
NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]],
cc, NIL];
RETURN[[left, intType]]};
ENDCASE => CCE[operation, "illegal pointer / something binary operation"];
};

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
RETURN[tc];
END;

PointerCCTypesCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
pointerTypeInfo: PointerInfo _ NARROW[procData];
IF pointerTypeInfo.target # targetType THEN 
CCE[typeConformity]
ELSE
RETURN[tc]
END;

PointerCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
pointerTypeInfo: PointerInfo _ NARROW[procData];
SELECT op FROM
$uparrow =>
BEGIN
RETURN[[CedarCode.ConcatCode[
arg.code, CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[pointerTypeInfo.target]]],
pointerTypeInfo.target]];
END
ENDCASE => CCE[typeConformity];
END;

PointerCCTypesBinaryOp: PROC[op: CCTypes.Operator, left, right: CirioTypes.TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
pointerTypeInfo: PointerInfo ~ NARROW[procData];
SELECT op FROM
$minus, $eq, $ne, $lt, $gt, $le, $ge => {
RETURN[[CedarCode.ConcatCode[
left.code,
CedarCode.ConcatCode[right.code, 
CedarCode.CodeToDoBinaryOp[op, left.type, right.type]]], CreateBoolType[cc]]]
};
$plus => {
RETURN[[CedarCode.ConcatCode[
left.code,
CedarCode.ConcatCode[right.code, 
CedarCode.CodeToDoBinaryOp[op, left.type, right.type]]], left.type]];
};
ENDCASE => CCE[unimplemented, IO.PutFR["the binary op `%g' is not implemented for C pointers", [atom[op]] ]];
END;

CreateBoolType: PROC [cc: CC] RETURNS [CirioTypes.Type]
~{RETURN CNumericTypes.CreateNumericType[
NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: integer]],
cc, NIL]};

PointerCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
pointerTypeInfo: PointerInfo _ NARROW[procData];
to.PutRope["POINTER TO"];
CCTypes.BreakPrintType[to, pointerTypeInfo.target, printDepth, printWidth, cc, " "];
RETURN};


CreatePointerNode: PUBLIC PROC[type: Type, info: CPointerTypes.PointerNodeInfo, cc: CC] RETURNS[Node] =
BEGIN
RETURN[CedarCode.CreateCedarNode[PointerNodeOps, type, info]];
END;

PointerNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[
binaryOp: PointerNodeBinaryOp,
load: PointerNodeLoad,
show: PointerNodeShow]];

PointerNodeBinaryOp: PROC[op: CCTypes.Operator, leftType, rightType: Type, leftNode, rightNode: CirioTypes.Node, cc: CC] RETURNS[Node] = {
leftData: CPointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[leftNode]];
rightClass: CirioTypes.TypeClass _ CCTypes.GetTypeClass[rightType];
SELECT rightClass FROM
numberClass => {
rightDescriptor:  CNumericTypes.NumericDescriptor _ CNumericTypes.GetDescriptorFromCNumericType[rightType, cc];
SELECT op FROM
$plus => {
IF rightDescriptor.primary = signed AND 
rightDescriptor.secondary = integer THEN {
newIndirectNode: CirioTypes.Node _ leftData.add[leftNode, rightNode, leftData, cc];
RETURN[newIndirectNode]}
ELSE CCE[typeConformity]};
ENDCASE => CCE[typeConformity];
};
pointerClass => {
SELECT op FROM
$le, $lt, $eq, $ne, $gt, $ge =>
RETURN[leftData.compare[leftNode, rightNode, op, cc]];
$minus => {
IF leftType = rightType THEN
RETURN[leftData.subtract[leftNode, rightNode, cc]]
ELSE CCE[typeConformity]};
ENDCASE => CCE[typeConformity]};
ENDCASE => CCE[typeConformity];
};

PointerNodeLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] ~
BEGIN
data: CPointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]];
RETURN[CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[data.clientTargetType], data.indirectToClientTarget, cc]]
END;

PointerNodeShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
data: CPointerTypes.PointerNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
target: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[data.clientTargetType], data.indirectToClientTarget, cc];
to.PutChar['^];
CedarCode.ShowNode[to, target, depth, width, cc];
RETURN};

END..
  z  
CPointerTypesImpl.mesa
Copyright س 1990 by Xerox Corporation.  All rights reserved.
Hopcroft August 18, 1989 6:25:13 pm PDT
Last changed by Theimer on September 28, 1989 10:57:04 am PDT
Last tweaked by Mike Spreitzer on January 9, 1992 10:20 am PST
Started by theimer by copying from PointerTypesImpl.mesa at May 1, 1989 4:56:50 pm PDT.

Nodes begin here
Pointer nodes

 ‌ت‚  •NewlineDelimiter
™ codeڑœ™K™<K™'K™=K™>—Kک KڑœW™WKک ڑدk	ک	Kڑœ‌œ¶‌œکرKڑœ
‌œڈک‍Kڑœ‌œNک^Kڑœ‌œ^کqKڑœ‌œک%Kڑ‌œکKڑœک—Kک ڑدnœ‌œ‌ک Kڑ‌œ$‌ک-Kڑ‌œک—Kڑœ‌کKڑ‌œ‌œک&Kڑœ‌œکKڑœ‌œک'Kڑœ‌œکKڑœ‌œکKڑœ‌œکKڑœ‌œک/ڑ‌œ‌œ&‌œ‌œکNK™ —Kڑœ‌œ‌œک(ڑœ‌œ‌œکKڑœکڑœکKک ——Kڑœ‌œکKڑœ‌œکKک ڑ
‍œ‌œ‌œ‌œ‌œ
کdKڑœ‌œ*کHKڑœ|ک|Kڑ‌œک—Kک ڑ‍œ‌œ‌œکTKک*Kڑœک—Kک ڑ‍œ‌œ‌œ‌œ‌œ,‌œکtKڑœ‌œک,Kڑ‌œ‌œ‌œ‌œbکپKڑ‌œYک_—Kک ڑ‍œ‌œ%‌œ‌œ‌œ‌œ‌œکaKڑœ‌œک,Kڑ‌œ‌œ‌œ‌œ^ک}Kڑ‌œLکR—Kک ڑ‍œ‌œ‌œکLKک1Kک5Kک-KکKک)KکKک!Kک%—Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œک}Kڑœ‌œک(Kڑœ
‌œ!ک/ڑ‌œ
‌کڑœکKڑœ‌œ1کNڑ‌œک Kڑœ(ک(Kڑœ(ک(Kڑœک——ڑœکڑœ;ک;Kڑ‌œNکQKڑœ‌œک	—Kڑ‌œ2ک8—Kڑ‌œ‌œک—Kڑœک—Kک ڑ‍ œ‌œ.‌œ‌œ‌œ‌œک‘Kڑœ‌œک/ڑ‌œ‌کKڑœ‌œک%ڑœکڑœ;ک;Kڑ‌œNکQKڑœ‌œک	—Kڑ‌œک—Kڑ‌œ‌œ<کJ—Kڑœک—Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œکYKڑ‌کKڑœ‌œک0Kڑ‌œکKڑ‌œک—Kک ڑ‍œ‌œ#‌œ‌œ‌œ‌œ‌œک€Kڑ‌کKڑ‌œکKڑ‌œک—Kک ڑ‍œ‌œ&‌œ‌œ‌œ‌œکqKڑ‌کKڑœ‌œک0ڑ‌œ%‌œک,Kڑ‌œک—ڑ‌کKڑ‌œک
—Kڑ‌œک—Kک ڑ‍œ‌œ+‌œ‌œ‌œ‌œکqKڑ‌کKڑœ‌œک0ڑ‌œ‌ککKڑ‌کڑ‌œکKڑœ`ک`Kڑœک—Kڑ‌ک—Kڑ‌œ‌œک—Kڑ‌œکKک —ڑ‍œ‌œ>‌œ‌œ‌œ‌œک…Kڑ‌کKڑœ‌œک0ڑ‌œ‌کک)ڑ‌œکKڑœ
ک
ڑœ!ک!KڑœMکM——Kڑœک—ک
ڑ‌œکKڑœ
ک
ڑœ!ک!KڑœEکE——Kڑœک—Kڑ‌œ‌œ‌œMکm—Kڑ‌œک—Kک ڑ‍œ‌œ‌œ‌œک7ڑœ‌œ!ک)Kڑ‌œNکQKڑœ‌œک
——Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکzKڑœ‌œک0KکKڑœTکTKڑ‌œک—Kک ڑœ™ک Kڑœ™™ Kک —ڑ
‍œ‌œ‌œ6‌œ‌œکgKڑ‌کKڑ‌œ8ک>Kڑ‌œکKک —ڑ‍œ‌œ‌œکMKکKکKک—Kک ڑ‍œ‌œ\‌œ‌œ
کٹKڑœ*‌œ&کVKکCڑ‌œ‌کڑœکKڑœoکoڑ‌œ‌کڑœ
ک
ڑ‌œ"‌œ&‌œکSKڑœSکSKڑ‌œک—Kڑ‌œ‌œک—Kڑ‌œ‌œک—Kڑœک—ڑœکڑ‌œ‌ککKڑ‌œ0ک6—ڑœکڑ‌œ‌کKڑ‌œ,ک2—Kڑ‌œ‌œک—Kڑ‌œ‌œک ——Kڑ‌œ‌œک—Kڑœک—Kک ڑ‍œ‌œ.‌œ‌œ	کWKڑ‌کKڑœ&‌œ*کVKڑ‌œtکzKڑ‌œک—Kک ڑ‍œ‌œ‌œ‌œ‌œ	‌œ‌œکTKڑœ&‌œ"کNKک‚KکKڑœ1ک1Kڑ‌œک—Kک ——Kڑ‌œک— …—     z  *v  