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. X AtomsImpl.mesa Copyright Σ 1992 by Xerox Corporation. All rights reserved. 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 –(cedarcode) style™codešœ™Kšœ Οeœ1™˜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˜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˜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˜oKšžœA˜GKšžœ˜—K˜š£œžœžœžœžœ žœžœ˜NKšœžœ"˜CK˜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šžœ˜—…—š#ͺ