DIRECTORYAtoms,CCTypes USING [CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, CreateCedarType, ExtractIdField, GetIndirectType, GetProcDataFromGroundType, GetProcDataFromType, LR, Operator, SelectIdField],CirioTypes USING [BasicTypeInfo, CompilerContext, Mem, Node, Type, TypedCode],CedarCode USING [Code, CreateCedarNode, OperationsBody, GetDataFromNode, GetTypeOfNode, Operator, LoadThroughIndirectNode, ShowNode, ExtractFieldFromNode, CodeToLoadThroughIndirect, ConcatCode],IO,RefTypes USING [CreateNilRefNode],Rope USING[ROPE];AtomsImpl: CEDAR PROGRAMIMPORTS CCTypes, CedarCode, IO, RefTypesEXPORTS Atoms= BEGIN OPEN CCTypes;CC: TYPE = CirioTypes.CompilerContext;Code: TYPE = CedarCode.Code;BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo;Type: TYPE = CirioTypes.Type;TypedCode: TYPE = CirioTypes.TypedCode;Mem: TYPE = CirioTypes.Mem;Node: TYPE = CirioTypes.Node;CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;Operator: TYPE = CedarCode.Operator;AtomTypeInfo: TYPE = REF AtomTypeInfoBody;AtomTypeInfoBody: TYPE = RECORD [recType: Type,bti: BasicTypeInfo];CreateAtomType: PUBLIC PROC [cc: CC, bti: BasicTypeInfo] RETURNS [Type] = {info: AtomTypeInfo _  NEW [AtomTypeInfoBody _ [NIL, bti]];RETURN [CCTypes.CreateCedarType[$atom, AtomTypeCCTypeProcs, IndirectAtomTypeCCTypeProcs, cc, info]]};SetAtomRecType: PUBLIC PROC [atomType, recType: Type, cc: CC] ~ {info: AtomTypeInfo ~ NARROW[CCTypes.GetProcDataFromType[atomType]];IF info.recType#NIL THEN CCE[cirioError, "Re-SetAtomRecType"];info.recType _ recType;RETURN};AtomTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[checkConformance: AtomCCTypesCheckConformance,operand: AtomCCTypesOperand,unaryOp: AtomCCTypesUnaryOp,extractIdField: AtomCCTypesExtractIdField,getTypeRepresentation: AtomGetTypeRep,printType: AtomCCTypesPrintType]];AtomCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =BEGINvalInfo: AtomTypeInfo _ NARROW[procData];WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROMvarInfo: AtomTypeInfo => RETURN [CCTypes.CheckConformance[valInfo.recType, varInfo.recType, cc]];ENDCASE => RETURN[no];END;AtomCCTypesOperand: PROC [op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS [TypedCode] =BEGINSELECT op FROM$dot , $extractId, $uparrow => RETURN[tc];ENDCASE => CCE[operation]; -- client error, invalid operationEND;AtomCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =BEGINinfo: AtomTypeInfo _ NARROW[procData];SELECT op FROM$uparrow => BEGINcode2: Code _ CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[info.recType]];code: Code _ CedarCode.ConcatCode[arg.code, code2];RETURN[[code, info.recType]];END;ENDCASE => CCE[typeConformity]; -- client type errorEND;AtomCCTypesExtractIdField: PROC[id: Rope.ROPE, fieldContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =BEGINinfo: AtomTypeInfo _ NARROW[procData];tc: TypedCode _ CCTypes.ExtractIdField[id, info.recType, cc];RETURN [tc];END;IndirectAtomTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[createIndirectNode: AtomCreateIndirect,getBitSize: AtomBitSize,operand: IndirectAtomCCTypesOperand,selectIdField: AtomCCTypesSelectIdField,printType: AtomCCTypesPrintType]];AtomCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {info: AtomTypeInfo _ NARROW[procData];RETURN info.bti.createIndirectNode[info.bti, cc, indirectType, targetType, mem]};AtomBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {info: AtomTypeInfo _ NARROW[procData];RETURN info.bti.getBitSize[info.bti, cc, indirectType, targetType]};IndirectAtomCCTypesOperand: PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =BEGINSELECT op FROM$selectId, $address => RETURN[tc];ENDCASE => CCE[operation]; -- client error; invalid operationEND;AtomCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = {info: AtomTypeInfo _ NARROW[procData];tc: TypedCode _ CCTypes.SelectIdField[id, CCTypes.GetIndirectType[info.recType], cc];RETURN [tc];};AtomGetTypeRep: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[REF ANY] ~ {info: AtomTypeInfo _ NARROW[procData];RETURN[info.bti]};AtomCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {info: AtomTypeInfo _ NARROW[procData];to.PutRope["ATOM"]};CreateAtomNode: PUBLIC PROC [type: Type, info: Atoms.AtomNodeInfo, cc: CC] RETURNS [Node] = {RETURN [CedarCode.CreateCedarNode[AtomOps, type, info]];};AtomOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[load: AtomLoad,extractField: AtomExtractField,show: AtomShow,getNodeRepresentation: AtomNodeGetRepresentation]];AtomLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {info: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]];RETURN [CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc]];};AtomExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] =BEGINinfo: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];rec: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc];RETURN [CedarCode.ExtractFieldFromNode[id, info.atomRecType, rec, cc]];END;AtomShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {info: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];rec: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc];recType: Type _ CedarCode.GetTypeOfNode[rec];pName: Node _ CedarCode.ExtractFieldFromNode["pName", recType, rec, cc];to.PutChar['$];CedarCode.ShowNode[to, pName, depth, width, cc];RETURN};AtomNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =BEGINdata: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];RETURN[data];END;CreateNilAtomNode: PUBLIC PROC [type: Type, cc: CC] RETURNS [Node] =BEGINRETURN [CedarCode.CreateCedarNode[NilAtomOps, type, NIL]];END;NilAtomOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[load: NilAtomLoad,show: NilAtomShow]];NilAtomLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {RETURN [RefTypes.CreateNilRefNode[cc]];};NilAtomShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC]= {to.PutRope["NIL"]};END.     AtomsImpl.mesaCreated by Theimer: August 4, 1989 10:05:46 pm PDTLast changed by Theimer on August 7, 1989 1:19:02 pm PDTSpreitze, January 8, 1992 1:13 pm PSTType operationscode2: Code _ CedarCode.ConcatCode[code1, tc.code];RETURN [[code2, tc.type]];Node operations.  ‌ت¨  •NewlineDelimiter™ codeڑœ™K™2K™8K™%—Kک Kک ڑدk	ک	KڑœکKڑœ‌œ«‌œکصKڑœ‌œ>کNKڑœ
‌œ³کآKڑ‌œکKڑœ	‌œک"Kڑœ‌œ‌œک—Kک Kک Kک ڑذln	œ‌کKڑ‌œ‌œ
ک(Kڑ‌œک—ڑœ‌
œ	کKک Kڑ‌œ‌œک&Kڑœ‌œکKڑœ‌œک/Kڑœ‌œکKڑœ‌œک'Kڑœ‌œکKڑœ‌œکKڑ‌œ‌œ&‌œ‌œکNKڑœ
‌œک$Kک K™K™ Kڑœ‌œ‌œک*ڑœ‌œ‌œک!KڑœکKڑœک—Kک ڑ
دnœ‌œ‌œ‌œ‌œکKKڑœ‌œ‌œک:Kڑ‌œ_کe—Kک ڑںœ‌œ‌œ‌œکAKڑœ‌œ(کCKڑ‌œ‌œ‌œ‌œ"ک>KکKڑ‌œکKک —ڑدb‌ œ‌œکIKک.KکKکKڑœ*ک*Kڑœ&ک&Kڑœ"ک"—Kک ڑ ںœ‌œ‌œ‌œ‌œ‌œکxKڑ‌کKڑœ‌œک)ڑ‌œ0‌œ‌ک?Kڑœ‌œBکaKڑ‌œ‌œک—Kڑ‌œک—Kک ڑ œ‌œ‌œ‌œ‌œ‌œ‌œکwKڑ‌کڑ‌œ‌کKڑœ‌œک*Kڑ‌œ‌œدc"ک=—Kڑ‌œک—Kک ڑںœ‌œ+‌œ‌œ‌œ‌œکnKڑ‌کKڑœ‌œک&ڑ‌œ‌کڑœ‌کKڑœYکYKک3Kڑ‌œکKڑ‌œک—Kڑ‌œ‌œ،ک4—Kڑ‌œک—Kک ڑ ںœ‌œ
‌œ‌œ‌œ‌œ‌œکrKڑ‌کKڑœ‌œک&Kک=K™3Kڑ‌œ™Kڑ‌œکKڑ‌œک—Kک ڑ ‌ œ‌œکQKک'KکKک$Kک(Kڑœ"ک"—Kک ڑںœ‌œ‌œ‌œ‌œ,‌œکqKڑœ‌œک&Kڑ‌œKکQ—Kک ڑںœ‌œ%‌œ‌œ‌œ‌œ‌œک^Kڑœ‌œک&Kڑ‌œ>کD—Kک ڑ ںœ‌œ‌œ‌œ‌œ‌œ‌œک}Kڑ‌کڑ‌œ‌کKڑœ‌œک"Kڑ‌œ‌œ،"ک=—Kڑ‌œک—Kک ڑ ںœ‌œ
‌œ"‌œ‌œ‌œ‌œ‌ک{Kڑœ‌œک&KڑœUکUKڑ‌œکKڑ‌œک—Kک ڑںœ‌œ‌œ‌œ‌œ‌œ‌œ‌œکPKڑœ‌œک&Kڑ‌œک—Kک ڑذbnœ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکwKڑœ‌œک&Kڑœک—Kک Kک Kک K™K™ ڑ
ںœ‌œ‌œ,‌œ‌œک]Kڑ‌œ2ک8Kک—Kک ڑ œ‌œ‌œکGKکKکKکKک0Kک—Kک ڑںœ‌œ.‌œ‌œکRKڑœ‌œ*کKKڑ‌œfکlKک—Kک ڑ
ںœ‌œ
‌œ‌œ‌œکUKڑ‌کKڑœ‌œ"کCKڑœoکoKڑ‌œAکGKڑ‌œک—Kک ڑ¢œ‌œ‌œ‌œ‌œ	‌œ‌œکNKڑœ‌œ"کCKڑœoکoKک-KکHKکKڑœ0ک0Kڑ‌œک—Kک ڑںœ‌œ‌œ‌œ‌œ‌œکFKڑ‌کKڑœ‌œ"کCKڑ‌œکKڑ‌œک—Kک Kک ڑںœ‌œ‌œ‌œ	کDKڑ‌کKڑ‌œ.‌œک:Kڑ‌œک—Kک ڑ 
œ‌œ‌œکJKکKکKک—Kک ڑ	 ںœ‌œ.‌œ‌œکUKڑ‌œ!ک'Kک—Kک ڑ¢œ‌œ‌œ‌œ‌œ	‌œ‌œکMKڑœک——Kک Kڑ‌œک— …—    ڑ  #^  