DIRECTORY AMBridge, AMMiniModel, AMTypes, Atom, FS, Basics, BasicTime, BitTwiddling, IO, EnumTypes, NumTypes, Rope, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypes, VFonts; EnumTypesImpl: CEDAR PROGRAM IMPORTS AMBridge, AMMiniModel, AMTypes, Atom, FS, Basics, BasicTime, IO, NumTypes, Rope, RoseTranslateTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypes, VFonts EXPORTS EnumTypes = BEGIN ROPE: TYPE = Rope.ROPE; Ptr: TYPE = RoseTypes.Ptr; NodeType: TYPE = RoseTypes.NodeType; NodeTypeRep: TYPE = RoseTypes.NodeTypeRep; Format: TYPE = RoseTypes.Format; Node: TYPE = RoseTypes.Node; NodeTest: TYPE = RoseTypes.NodeTest; ETData: TYPE = REF ETDataRep; ETDataRep: TYPE = RECORD [ fileSinceEpoch: LONG CARDINAL, interface, type: ROPE, amType: AMTypes.Type, initialValue, bits: CARDINAL ]; enumTypeProcs: RoseTypes.NodeProcs _ NEW [RoseTypes.NodeProcsRep _ [ UserDescription: EnumTypeUserDescription, ListFormats: EnumTypeListFormats, GetFormat: EnumTypeGetFormat, MesaForSelf: EnumTypeMesaForSelf, SelectorOffset: EnumTypeSelectorOffset, SubType: EnumTypeSubType, Bits: EnumTypeBits, MesaRepresentation: EnumTypeMesaRepresentation, MesaRepAux: EnumTypeMesaRepAux, Equivalent: EnumTypeEquivalent, SwitchEquivalent: EnumTypeSwitchEquivalent, Transduce: SwitchNumConvert.Transduce ]]; ConstructEnumType: PROC [parms: REF ANY --UNION [BindingList, Args]--] RETURNS [type: NodeType] --RoseTranslateTypes.NodeTypeConstructor-- = BEGIN name: RoseTranslateTypes.Quoted _ NARROW[RoseTranslateTypes.GetParm[n: 1, name: "name", parms: parms]]; type _ EnumType[name.rope]; END; EnumType: PUBLIC PROC [etName: ROPE] RETURNS [nt: NodeType] = BEGIN interface, type: ROPE; atom: ATOM; md: ETData; fileTime: BasicTime.GMT; fileSinceEpoch: LONG CARDINAL; fileExists: BOOLEAN _ TRUE; periodPos: INT; iType, enumType: AMTypes.Type; iv: AMTypes.TV; nComponents, fieldIndex: NAT; maxValue, initialValue: CARDINAL _ 0; bits: CARDINAL _ 0; powBits: INT; atom _ Atom.MakeAtom[etName]; nt _ NARROW[Atom.GetProp[atom: atom, prop: $enumTypeRoseImpl]]; periodPos _ etName.Find["."]; WHILE periodPos<0 DO etName _ Rope.Concat["Dragon.", etName]; periodPos _ etName.Find["."]; ENDLOOP; interface _ etName.Substr[0, periodPos]; type _ etName.Substr[periodPos+1, etName.Length[]-(periodPos+1)]; IF interface.Length=0 OR type.Length=0 THEN ERROR RoseTranslateTypes.TypeConstructionError["EnumType arg not of form \"Interface.Type\""]; fileTime _ FS.FileInfo[interface.Concat[".bcd"] ! FS.Error => {fileExists _ FALSE; CONTINUE}].created; IF NOT fileExists THEN ERROR RoseTranslateTypes.TypeConstructionError[IO.PutFR["File %g.bcd doesn't exist", IO.rope[interface]]]; fileSinceEpoch _ BasicTime.Period[from: BasicTime.earliestGMT, to: fileTime]; IF nt # NIL THEN BEGIN et: ETData _ NARROW[nt.typeData]; IF fileSinceEpoch = et.fileSinceEpoch THEN RETURN; -- it's still good END; iType _ AMMiniModel.AcquireIRType[defsName: interface]; nComponents _ AMTypes.NComponents[iType]; fieldIndex _ AMTypes.NameToIndex[iType, type]; IF NOT fieldIndex IN [1 .. nComponents] THEN ERROR RoseTranslateTypes.TypeConstructionError["fieldIndex NOT IN [1 .. nComponents] --- shouldn't ever happen"]; enumType _ AMTypes.UnderType[AMTypes.TVToType[AMTypes.IndexToDefaultInitialValue[iType, fieldIndex]]]; IF AMTypes.TypeClass[enumType] # enumerated THEN ERROR RoseTranslateTypes.TypeConstructionError[IO.PutFR["TYPE %g.%g isn't enumerated", IO.rope[interface], IO.rope[type]]]; TRUSTED {maxValue _ AMBridge.TVToLC[AMTypes.Last[enumType]]}; powBits _ 2; FOR bits _ 1, bits+1 DO IF maxValue index, whole => 0, range => IF up THEN first ELSE (first + 1 - count), ENDCASE => ERROR; }; EnumTypeSubType: PROC [nt: NodeType, s: RoseTypes.Selector] RETURNS [snt: NodeType] = { snt _ WITH s SELECT FROM whole => nt, number => NumTypes.boolType, range => NumTypes.NumType[count], ENDCASE => ERROR; }; EnumTypeBits: PROC [nt: NodeType] RETURNS [container, data, leftPad: INT] = {md: ETData _ NARROW[nt.typeData]; container _ data _ md.bits; leftPad _ 0}; EnumTypeMesaRepresentation: PROC [nt: NodeType] RETURNS [m: RoseTypes.Mesa] = {md: ETData _ NARROW[nt.typeData]; m _ [md.type]}; EnumTypeMesaRepAux: PROC [nt: NodeType] RETURNS [m: RoseTypes.Mesa] = { md: ETData _ NARROW[nt.typeData]; m _ [ mesa: md.type.Cat[": TYPE = ", md.interface, ".", md.type], directory: LIST[md.interface]]}; EnumTypeEquivalent: PROC [self, other: NodeType] RETURNS [eqv: BOOL] = { md: ETData _ NARROW[self.typeData]; eqv _ SELECT TRUE FROM NumTypes.Numeric[other] => md.bits = Length[other], Enumerated[other] => md.bits = Length[other], ENDCASE => FALSE; }; Length: PROC [nt: NodeType] RETURNS [len: INT] = { len _ WITH nt SELECT FROM ant: RoseTypes.AtomNodeType => 1, ant: RoseTypes.ArrayNodeType => ant.length, ENDCASE => ERROR; }; EnumTypeSwitchEquivalent: PROC [self: NodeType] RETURNS [other: NodeType] = { md: ETData _ NARROW[self.typeData]; other _ SwitchTypes.Bundle[md.bits]; }; enumTypeFormat: RoseTypes.Format _ NEW [RoseTypes.FormatRep _ [ FormatValue: EnumTypeFormatValue, ParseValue: EnumTypeParseValue, FormatTest: EnumTypeFormatTest, ParseTest: EnumTypeParseTest, MaxWidth: EnumTypeMaxWidth, formatData: NIL, key: "et"]]; initFormat: RoseTypes.Format _ NEW [RoseTypes.FormatRep _ [ ParseValue: EnumTypeParseInitValue, key: "init"]]; bpw: NAT = Basics.bitsPerWord; Pointer: TYPE = RECORD [ p: LONG POINTER TO CARDINAL, leftPad: [0 .. bpw)]; EnumTypeFormatValue: PROC [node: Node, format: Format, where: Ptr] RETURNS [rope: ROPE] = BEGIN md: ETData _ NARROW[node.type.typeData]; p: Pointer _ ToPointer[where]; index: CARDINAL _ Read[p, md.bits]; tv: AMTypes.TV _ AMTypes.New[md.amType]; TRUSTED {AMBridge.SetTVFromLC[tv, index]}; rope _ AMTypes.TVToName[tv]; END; ToPointer: PROC [ptr: Ptr] RETURNS [p: Pointer] = TRUSTED { p _ [ p: LOOPHOLE[ptr.word], leftPad: ptr.bit]; }; Read: PROC [p: Pointer, bits: NAT] RETURNS [card: CARDINAL] = TRUSTED { IF p.leftPad + bits > bpw THEN ERROR; card _ Basics.BITSHIFT[p.p^, INTEGER[bits + p.leftPad] - bpw]; card _ Basics.BITAND[card, BitTwiddling.oneLessThanTwoToThe[bits]]; }; Write: PROC [p: Pointer, bits: NAT, card: CARDINAL] = TRUSTED { shift: INTEGER _ bpw - (bits + p.leftPad); mask: CARDINAL _ BitTwiddling.oneLessThanTwoToThe[bits]; IF p.leftPad + bits > bpw THEN ERROR; IF card > mask THEN ERROR; card _ Basics.BITSHIFT[card, shift]; mask _ Basics.BITSHIFT[mask, shift]; p.p^ _ Basics.BITOR[card, Basics.BITAND[p.p^, Basics.BITNOT[mask]]]; }; EnumTypeParseValue: PROC [node: Node, format: Format, where: Ptr, from: IO.STREAM] RETURNS [success: BOOLEAN] = BEGIN md: ETData _ NARROW[node.type.typeData]; p: Pointer _ ToPointer[where]; i: CARDINAL; rope: ROPE _ from.GetTokenRope[].token; [i, success] _ Lookup[md, rope]; IF success THEN Write[p, md.bits, i]; END; EnumTypeParseInitValue: PROC [node: Node, format: Format, where: Ptr, from: IO.STREAM] RETURNS [success: BOOLEAN] = BEGIN md: ETData _ NARROW[node.type.typeData]; p: Pointer _ ToPointer[where]; rope: ROPE _ from.GetTokenRope[].token; IF NOT (rope.Equal["initial"] OR rope.Equal["steady"]) THEN ERROR; Write[p, md.bits, md.initialValue]; END; Lookup: PROC [md: ETData, rope: ROPE] RETURNS [index: CARDINAL, success: BOOLEAN] = BEGIN FOR tv: AMTypes.TV _ AMTypes.First[md.amType], AMTypes.Next[tv] WHILE tv#NIL DO BEGIN IF Rope.Equal[rope, AMTypes.TVToName[tv ! AMTypes.Error => IF reason=badIndex THEN GOTO NoName ELSE REJECT]] THEN TRUSTED BEGIN value: CARDINAL = AMBridge.TVToLC[tv]; RETURN[value, TRUE]; END; EXITS NoName => NULL; END; ENDLOOP; success _ FALSE; index _ 0; END; EnumTypeMaxWidth: PROC [nodeType: NodeType, format: Format, font: VFonts.Font] RETURNS [INT] = BEGIN md: ETData _ NARROW[nodeType.typeData]; mw: INT _ VFonts.StringWidth["??"]; FOR tv: AMTypes.TV _ AMTypes.First[md.amType], AMTypes.Next[tv] WHILE tv#NIL DO mw _ MAX[mw, VFonts.StringWidth[AMTypes.TVToName[tv ! AMTypes.Error => IF reason=badIndex THEN CONTINUE ELSE REJECT], font]]; ENDLOOP; RETURN [mw]; END; EnumTypeParseTest: PROC [nodeType: NodeType, format: Format, from: IO.STREAM] RETURNS [success: BOOLEAN, test: NodeTest] = BEGIN md: ETData _ NARROW[nodeType.typeData]; i: CARDINAL; rope: ROPE _ from.GetTokenRope[].token; [i, success] _ Lookup[md, rope]; test.data _ IF success THEN NEW [CARDINAL _ i] ELSE NIL; test.proc _ TestEnumType; END; EnumTypeFormatTest: PROC [nodeType: NodeType, format: Format, test: NodeTest] RETURNS [rope: ROPE] = BEGIN md: ETData _ NARROW[nodeType.typeData]; rc: REF CARDINAL _ NARROW[test.data]; IF rc # NIL THEN BEGIN ENABLE AMTypes.Error => IF reason=badIndex THEN GOTO NoName ELSE REJECT; RETURN[AMTypes.TVToName[AMTypes.Value[md.amType, rc^+1]]]; EXITS NoName => NULL; END; RETURN["??"]; END; TestEnumType: PROC [where: Ptr, testData: REF ANY, nodeType: NodeType] RETURNS [passes: BOOLEAN] --RoseTypes.NodeTestProc-- = BEGIN rc: REF CARDINAL _ NARROW[testData]; md: ETData _ NARROW[nodeType.typeData]; p: Pointer _ ToPointer[where]; index: CARDINAL _ Read[p, md.bits]; passes _ rc^ = index; END; SignalTypeRegistration.RegisterNodeTypeConstructor["EnumType", ConstructEnumType]; END. ˆEnumTypesImpl.Mesa Last Edited by: Spreitzer, May 6, 1985 2:39:39 pm PDT Last Edited by: McCreight, March 8, 1984 7:02:23 pm PST Κ κ– "cedar" style˜Icode™K™5K™7K˜KšΟk œ'œ#œz˜ΡK˜šΠbx œœ˜Kšœ'œœc˜ͺKšœ ˜—K˜Kš˜K˜Kšœœœ˜K˜Kšœœ˜Kšœ œ˜$Kšœ œ˜*Kšœœ˜ Kšœœ˜Kšœ œ˜$K˜Kšœœœ ˜šœ œœ˜Kšœœœ˜Kšœœ˜Kšœ˜Kšœ˜K˜—K˜šœ%œ˜DKšœ)˜)Kšœ!˜!Kšœ˜Kšœ!˜!Kšœ'˜'Kšœ˜Kšœ˜Kšœ/˜/Kšœ˜Kšœ˜Kšœ+˜+Kšœ%˜%Kšœ˜—K˜šΟnœœ œœΟcœœ *œ˜ŒKš˜Kšœ"œ?˜gK˜Kšœ˜—K˜š Ÿœœœ œœ˜=Kš˜Kšœœ˜Kšœœ˜ K˜ Kšœœ˜Kšœœœ˜Kšœ œœ˜Kšœ œ˜Kšœ˜Kšœ œ˜Kšœœ˜Kšœœ˜%Kšœœ˜Kšœ œ˜ K˜Kšœ˜Kšœœ4˜?K˜šœ ˜Kšœ(˜(Kšœ˜Kšœ˜—Kšœ(˜(KšœA˜AKšœœœœY˜ŠK˜Kš œ œ%œœœ ˜fK˜Kš œœ œœ*œ$œ˜KšœM˜Mšœœ˜Kš˜Kšœ œ˜!Kšœ$œœ ˜EKšœ˜—K˜Kšœ7˜7Kšœ)˜)Kšœ.˜.Kš œœ œœœl˜žKšœf˜fKš œ*œœ*œ&œœ˜¬Kšœ6˜=Kšœ ˜ šœ˜Kšœœœ˜Kšœ˜Kšœ˜—Kšœ+˜+Kšœœœ˜.Kšœ&˜-K˜šœœ˜Kšœ˜Kšœ˜Kšœ ˜ Kšœ˜Kšœ˜Kšœ ˜ —K˜šœœ˜Kšœ˜K˜ Kšœœ˜5—Kšœ;˜;Kšœ˜—K˜š Ÿ œœœœœ˜:Kšœœœœ˜8—K˜šŸœœœœ˜AKšœœ˜"KšœE˜E—K˜šŸœœ œ˜GKšœœ˜—K˜šŸœœœœ ˜BKš œœœœ œ˜B—K˜šŸœœœ˜FKšœœ˜"šœ˜KšœO˜OKšœ œ˜——K˜šŸœœ'œœ˜Wšœœœ˜K˜K˜ Kšœ œœœ˜3Kšœœ˜—K˜—K˜šŸœœ'œ˜Wšœœœ˜K˜ K˜K˜!Kšœœ˜—K˜—K˜šŸ œœœœ˜KKšœœ8˜L—K˜šŸœœœ˜MKšœœ˜2—K˜šŸœœœ˜GKšœ œ˜!šœ˜Kšœ;˜;Kšœ œ˜ ——K˜šŸœœœœ˜HKšœ œ˜#šœœœ˜Kšœ3˜3K˜-Kšœœ˜—Kšœ˜—K˜šŸœœœœ˜2šœœœ˜K˜!K˜+Kšœœ˜—K˜—K˜šŸœœœ˜MKšœ œ˜#K˜$K˜—K˜šœ#œ˜?Kšœ!˜!Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ œ˜Kšœ ˜ —K˜šœœ˜;Kšœ#˜#Kšœ˜—K˜Kšœœ˜K˜šœ œœ˜Kš œœœœœ˜K˜—K˜šŸœœ*œœ˜YKš˜Kšœ œ˜(K˜Kšœœ˜#K˜(Kšœ#˜*Kšœ˜Kšœ˜—K˜šŸ œœ œœ˜;˜Kšœœ ˜K˜—K˜—K˜š Ÿœœœœœœ˜GKšœœœ˜%Kšœœœ˜>Kšœœ/˜CK˜—K˜š Ÿœœœœœ˜?Kšœœ˜*Kšœœ*˜8Kšœœœ˜%Kšœ œœ˜Kšœœ˜$Kšœœ˜$Kšœœœœ ˜DK˜—K˜š Ÿœœ0œœœ œ˜oKš˜Kšœ œ˜(K˜Kšœœ˜ Kšœœ˜'K˜ Kšœ œ˜%Kšœ˜—K˜š Ÿœœ0œœœ œ˜sKš˜Kšœ œ˜(K˜Kšœœ˜'Kš œœœœœ˜BKšœ#˜#Kšœ˜—K˜š Ÿœœœœ œ œ˜SKš˜š œ œ.œœ˜OKš˜š œ9œœœœœ˜qKšœ˜ Kšœœ˜&Kšœœ˜Kšœ˜—Kšœ œ˜Kšœ˜Kšœ˜—Kšœ œ ˜Kšœ˜—K˜šŸœœ9œœ˜^Kš˜Kšœ œ˜'Kšœœ˜#š œ œ.œœ˜Ošœœ+˜3Kš œœœœœœ ˜I—Kšœ˜—Kšœ˜ Kšœ˜—K˜š Ÿœœ,œœœ œ˜zKš˜Kšœ œ˜'Kšœœ˜ Kšœœ˜'K˜ Kš œ œ œœœœœ˜8K˜Kšœ˜—K˜šŸœœ6œœ˜dKš˜Kšœ œ˜'Kšœœœœ ˜%šœœ˜Kšœœœœœœœ˜NKšœ4˜:Kšœ œ˜Kšœ˜—Kšœ˜ Kšœ˜—K˜šŸ œœœœœ œ œ˜}Kš˜Kšœœœœ ˜$Kšœ œ˜'K˜Kšœœ˜#Kšœ˜Kšœ˜—K˜KšœR˜RK˜Kšœ˜—…—)6„