DIRECTORY AMBridge, AMMiniModel, AMTypes, Atom, FS, Basics, BasicTime, IO, EnumTypes, Rope, RoseTranslateTypes, RoseTypes, RuntimeError, SignalTypeRegistration, VFonts; EnumTypesImpl: CEDAR PROGRAM IMPORTS AMBridge, AMMiniModel, AMTypes, Atom, FS, Basics, BasicTime, IO, Rope, RoseTranslateTypes, RuntimeError, SignalTypeRegistration, VFonts EXPORTS EnumTypes = BEGIN ROPE: TYPE = Rope.ROPE; WordPtr: TYPE = RoseTypes.WordPtr; NodeType: TYPE = RoseTypes.NodeType; NodeTypeRep: TYPE = RoseTypes.NodeTypeRep; Format: TYPE = RoseTypes.Format; Node: TYPE = RoseTypes.Node; NodeTestProc: TYPE = RoseTypes.NodeTestProc; NodeTestData: TYPE = RoseTypes.NodeTestData; ETData: TYPE = REF ETDataRep; ETDataRep: TYPE = RECORD [ fileSinceEpoch: LONG CARDINAL, interface, type: ROPE, amType: AMTypes.Type, bits: CARDINAL ]; enumTypeProcs: RoseTypes.NodeProcs _ NEW [RoseTypes.NodeProcsRep _ [ Bits: EnumTypeBits, MesaUse: EnumTypeMesaUse, MesaDefinition: EnumTypeMesaDefinition, UserDescription: EnumTypeUserDescription, MesaDescription: EnumTypeMesaDescription, ListFormats: EnumTypeListFormats, GetFormat: EnumTypeGetFormat]]; ConstructEnumType: RoseTranslateTypes.NodeTypeConstructor--PROC [parms: REF ANY - -UNION [BindingList, Args]- -] RETURNS [type: NodeType]-- = 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; nComponents: NAT; maxValue: 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; fileTime _ FS.FileInfo[interface.Concat[".bcd"] ! FS.Error => {fileExists _ FALSE; CONTINUE}].created; IF NOT fileExists THEN ERROR; 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.Concat[".bcd"]]; nComponents _ AMTypes.NComponents[iType]; FOR i: NAT IN [1..nComponents] DO BEGIN ENABLE RuntimeError.UNCAUGHT => LOOP; compType: AMTypes.Type = AMTypes.IndexToType[iType, i]; SELECT AMTypes.UnderClass[compType] FROM type => IF Rope.Equal[AMTypes.IndexToName[iType, i], type] THEN BEGIN enumType _ AMTypes.UnderType[AMTypes.TVToType[AMTypes.IndexToDefaultInitialValue[iType, i]]]; IF AMTypes.TypeClass[enumType]#enumerated THEN LOOP; maxValue _ AMTypes.NValues[enumType]-1; EXIT; -- we found our type END; ENDCASE => NULL; END; -- of ENABLE block REPEAT FINISHED => ERROR; -- couldn't find that type ENDLOOP; powBits _ 2; FOR bits _ 1, bits+1 DO IF maxValue IF reason=badIndex THEN GOTO NoName ELSE REJECT; RETURN[AMTypes.TVToName[AMTypes.Value[md.amType, index+1]]]; EXITS NoName => NULL; END; RETURN ["??"]; END; masks: ARRAY [0..16] OF CARDINAL = [0, 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767, 65535]; EnumTypeParseValue: PROC [node: Node, format: Format, where: WordPtr, from: IO.STREAM] RETURNS [success: BOOLEAN] = BEGIN md: ETData _ NARROW[node.type.typeData]; i: CARDINAL; rope: ROPE _ from.GetTokenRope[].token; [i, success] _ Lookup[md, rope]; IF success THEN TRUSTED {where^ _ i}; 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.TVToCardinal[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, testProc: NodeTestProc, testData: NodeTestData] = BEGIN md: ETData _ NARROW[nodeType.typeData]; i: CARDINAL; rope: ROPE _ from.GetTokenRope[].token; [i, success] _ Lookup[md, rope]; IF success THEN testData _ NEW [CARDINAL _ i] ELSE testData _ NIL; testProc _ TestEnumType; END; EnumTypeFormatTest: PROC [nodeType: NodeType, format: Format, testProc: NodeTestProc, testData: NodeTestData] RETURNS [rope: ROPE] = BEGIN md: ETData _ NARROW[nodeType.typeData]; rc: REF CARDINAL _ NARROW[testData]; 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: RoseTypes.NodeTestProc--PROC [where: WordPtr, testData: NodeTestData, nodeType: NodeType] RETURNS [passes: BOOLEAN]-- = BEGIN rc: REF CARDINAL _ NARROW[testData]; md: ETData _ NARROW[nodeType.typeData]; TRUSTED {passes _ rc^ = Basics.BITAND[where^, masks[md.bits]]}; END; SignalTypeRegistration.RegisterNodeTypeConstructor["EnumType", ConstructEnumType]; END. ŠEnumTypesImpl.Mesa Last Edited by: Spreitzer, March 10, 1984 1:26:35 pm PST Last Edited by: McCreight, March 8, 1984 7:02:23 pm PST Κ Ν˜J™J™8J™7Icode˜KšΟk œ'œœ_˜¨K˜šΠbx œœ˜Kšœ'œœH˜Kšœ ˜—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˜šΟnœ(ΟcRœ˜Kš˜Kšœ"œ?˜gK˜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šœœœœ˜2K˜Kš œ œ%œœœ ˜fK˜Kšœœ œœ˜KšœM˜Mšœœ˜Kš˜Kšœ œ˜!Kšœ$œœ ˜EKšœ˜—K˜JšœF˜FJšœ)˜)šœœœ˜!Jšœœœœ˜+Jšœ7˜7šœ˜(šœ˜šœ1˜7Jš˜Jšœ]˜]Jšœ(œœ˜4Jšœ'˜'Jšœ ˜Jšœ˜——Jšœœ˜—Jšœ ˜š˜Jšœœ ˜-—Jšœ˜—K˜K˜Kšœ ˜ šœ˜Kšœœœ˜Kšœ˜Kšœ˜K˜—šœœ˜Kšœ˜Kšœ˜Kšœ ˜ Kšœ˜Kšœ ˜ —K˜šœœ˜Kšœ˜K˜ K˜—Kšœ;˜;Kšœ˜—K˜šŸ œœœœ˜;Kšœœ˜3—K˜šŸœœœ˜BKšœœ˜2—K˜šŸœœœ˜KKšœ œ˜!šœ˜Kšœ;˜;Kšœ œ˜ ——K˜šŸœœœœ˜AKšœœ˜"KšœE˜E—K˜šŸœœœ˜JKšœœ˜"šœ˜KšœO˜OKšœ œ˜——K˜šŸœœ œ˜GKšœœ˜—K˜šŸœœ œœ ˜;Kšœœ˜—K˜šœ#œ˜?Kšœ!˜!Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ œ˜Kšœ ˜ —K˜šŸœœ.œœ˜]Kš˜Kšœ œ˜(Kšœœ˜šœœ˜8Jšœœœœœœœ˜NJšœ6˜