DIRECTORY Basics, BitTwiddling, Convert, ImagerFont, IO, PrincOpsUtils, Real, Rope, RoseBehavior, RoseControl, RoseWireClasses, RoseWireFormats, RoseWireTypes, RoseWireTypeUse, RoseWiring, VFonts; RoseBasicSequenceImpl: CEDAR PROGRAM IMPORTS BitTwiddling, IO, PrincOpsUtils, Rope, RoseControl, RoseWireFormats, RoseWireTypes, RoseWiring EXPORTS RoseWireClasses = BEGIN OPEN RoseWireTypes; SwitchVal: TYPE = RoseBehavior.SwitchVal; Level: TYPE = RoseBehavior.Level; BasicSeqClass: TYPE = REF BasicSeqClassPrivate; BasicSeqClassPrivate: TYPE = RECORD [ rwc: RoseWireClass, name: ROPE, repAux: Mesa _ [], ewc: RoseWireClass, length: NAT, leftPad, wordLength: NAT ]; BasicSeqType: TYPE = REF BasicSeqTypePrivate; BasicSeqTypePrivate: TYPE = RECORD [ rwt: RoseWireType, ewt: RoseWireType ]; GetBasicSequence: PUBLIC PROC [prototype: Wire] RETURNS [rwc: RoseWireClass] = { name: ROPE = RoseWiring.WireName[prototype]; flavor: WireFlavor = simple; length: NAT = prototype.elements.size; cedarTypeName: ROPE = name.Cat[WireFlavorName[flavor]]; ewc: RoseWireClass = RoseWiring.GetWiring[prototype.elements[0], flavor]; eltsPerWord: NAT = Basics.bitsPerWord; wordLength: NAT = (length + eltsPerWord-1)/eltsPerWord; bsc: BasicSeqClass _ NEW [BasicSeqClassPrivate _ [ rwc: NIL, name: cedarTypeName, ewc: ewc, length: length, leftPad: wordLength*Basics.bitsPerWord - length, wordLength: wordLength ]]; IF StructureOfWire[prototype] # sequence THEN ERROR; IF ewc # RoseControl.boolType.class THEN ERROR; bsc.repAux _ [mesa: NIL]; bsc.rwc _ rwc _ NEW [RoseWireClassRec _ [ structure: sequence, dereference: FALSE, addressContaining: ewc.dereference OR ewc.addressContaining, classData: bsc, super: basicSeqSuperClass]]; }; basicSeqSuperClass: RoseWireSuperClass _ NEW[RoseWireSuperClassRec _ [ GetType: BasicSeqGetType, ListFormats: BasicSeqListFormats, GetFormat: BasicSeqGetFormat, SelectorOffset: BasicSeqSelectorOffset, SubType: BasicSeqSubType, SubClass: BasicSeqSubClass, Bits: BasicSeqBits, MesaRepresentation: BasicSeqMesaRepresentation, MesaRepAux: BasicSeqMesaRepAux, flavor: simple, Initialize: BasicSeqInitialize, Transduce: BasicSeqTransduce ]]; BasicSeqGetType: PROC [rwc: RoseWireClass, wire: Wire] RETURNS [rwt: RoseWireType] = { bsc: BasicSeqClass = NARROW[rwc.classData]; bst: BasicSeqType = NEW [BasicSeqTypePrivate _ [ rwt: rwt _ NEW [RoseWireTypeRec _ [ class: rwc, typeData: NIL, length: bsc.length ]], ewt: bsc.ewc.super.GetType[bsc.ewc, wire.elements[0]] ]]; rwt.typeData _ bst; }; BasicSeqListFormats: PROC [rwt: RoseWireType] RETURNS [lor: LOR] = { lor _ LIST["2", "4", "8", "16", "idiosyncratic"]; }; BasicSeqGetFormat: PROC [rwt: RoseWireType, formatName: ROPE] RETURNS [format: Format] = { basic: BOOL = rwt.class.super.SubClass[rwt.class, [subscript[0]]].structure = atom; switch: BOOL = rwt.class.super.flavor = switch; Do: PROC [lgBase: NAT] RETURNS [format: Format] = { format _ ( IF NOT basic THEN RoseWireFormats.constructNumericSequence ELSE IF switch THEN RoseWireFormats.numericBasicSwitchSequence ELSE RoseWireFormats.numericBasicSimpleSequence) [lgBase]; }; format _ SELECT TRUE FROM formatName.Equal["idiosyncratic"] => RoseWireFormats.constructIdiosyncraticSequence, formatName.Equal["2"] => Do[1], formatName.Equal["2"] => Do[2], formatName.Equal["8"] => Do[3], formatName.Equal["16"], formatName=NIL => Do[4], ENDCASE => ERROR; }; BasicSeqSelectorOffset: PROC [rwt: RoseWireType, sel: Selector] RETURNS [dBits: NAT] = { bsc: BasicSeqClass = NARROW[rwt.class.classData]; WITH sel SELECT FROM whole => RETURN [0]; field => ERROR; subscript => RETURN [SuboffI[bsc, index]]; ENDCASE => ERROR; }; Suboff: PROC [bsc: BasicSeqClass, i: NAT] RETURNS [dBits: NAT] = {dBits _ SuboffI[bsc, i]}; SuboffI: PROC [bsc: BasicSeqClass, i: NAT] RETURNS [dBits: NAT] = INLINE { dBits _ bsc.leftPad + i; }; WordSP: TYPE = LONG POINTER TO WordSeq; WordSeq: TYPE = RECORD [elts: SEQUENCE length: NAT OF WORD]; BasicSeqSubType: PROC [rwt: RoseWireType, sel: Selector] RETURNS [RoseWireType] = { bst: BasicSeqType = NARROW[rwt.typeData]; WITH sel SELECT FROM whole => RETURN [rwt]; field => ERROR; subscript => RETURN [bst.ewt]; ENDCASE => ERROR; }; BasicSeqSubClass: PROC [rwc: RoseWireClass, sel: Selector] RETURNS [RoseWireClass] = { bsc: BasicSeqClass = NARROW[rwc.classData]; WITH sel SELECT FROM whole => RETURN [rwc]; field => ERROR; subscript => RETURN [bsc.ewc]; ENDCASE => ERROR; }; BasicSeqBits: PROC [rwc: RoseWireClass] RETURNS [n: INT] = { bsc: BasicSeqClass = NARROW[rwc.classData]; n _ Basics.bitsPerWord * bsc.wordLength; }; BasicSeqMesaRepresentation: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = { bsc: BasicSeqClass = NARROW[rwc.classData]; mesa _ SELECT bsc.wordLength FROM =1 => [mesa: "BitOps.BitWord", directory: LIST["BitOps"]], =2 => [mesa: "BitOps.BitDWord", directory: LIST["BitOps"]], >2 => [ mesa: IO.PutFR[ "ARRAY [0 .. %g) OF CARDINAL", [integer[bsc.wordLength]] ] ], ENDCASE => ERROR; }; BasicSeqMesaRepAux: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = { bsc: BasicSeqClass = NARROW[rwc.classData]; mesa _ bsc.repAux; }; BasicSeqInitialize: PROC [rwt: RoseWireType, p: Ptr, steady: BOOL] = TRUSTED { bsc: BasicSeqClass = NARROW[rwt.class.classData]; ap: ArrPtr = ToArrPtr[p]; PrincOpsUtils.LongZero[LOOPHOLE[ap], bsc.wordLength]; steady _ steady; }; ArrPtr: TYPE = LONG POINTER TO ARRAY NAT OF CARDINAL; ToArrPtr: PROC [p: Ptr] RETURNS [ap: ArrPtr] = TRUSTED { ap _ p.word; IF p.bit # 0 THEN ERROR; }; BasicSeqTransduce: PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = { bsc: BasicSeqClass = NARROW[fromT.class.classData]; IF fromT.class.structure # sequence THEN ERROR; IF toT.class.structure # sequence THEN ERROR; IF fromT.length # toT.length THEN ERROR; IF toT.class.super.flavor # switch THEN ERROR; IF toT.class.dereference THEN toP _ BitTwiddling.DeReferencePtr[toP]; FOR i: NAT IN [0 .. bsc.length) DO subFrom: Ptr = BitTwiddling.OffsetPtr[fromP, SuboffI[bsc, i]]; sel: Selector = [subscript[i]]; subTo: Ptr = BitTwiddling.OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]; RoseControl.WriteSwitch[ subTo, SELECT RoseControl.ReadBool[subFrom] FROM FALSE => [s: [q: fromS, u: none, d: fromS], val: L], TRUE => [s: [q: fromS, u: fromS, d: none], val: H], ENDCASE => ERROR ]; ENDLOOP; toT _ toT; }; END. ΄RoseBasicSequenceImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Barth, September 5, 1985 6:37:22 pm PDT Spreitzer, November 18, 1985 10:21:25 pm PST Κ– "cedar" style˜codešœ™Kšœ Οmœ1™Kšžœ,˜0—K˜ —K˜—šœ žœžœž˜KšœT˜TK˜K˜K˜Kšœ#žœ ˜0Kšžœžœ˜—Kšœ˜K˜—š œžœ$žœ žœ˜XKšœžœ˜1šžœžœž˜Kšœ žœ˜Kšœ žœ˜Kšœ žœ˜*Kšžœžœ˜—Kšœ˜K˜—š  œžœžœžœ žœ˜@Kšœ˜—K˜š  œžœžœžœ žœžœ˜JKšœ˜K˜—K˜Kš œžœžœžœžœ ˜'Kš œ žœžœžœ žœžœžœ˜˜>Kšœ˜KšœS˜Sšœ˜Kšœ˜šžœž˜)Kšžœ/˜4Kšžœ/˜3Kšžœž˜—K˜—Kšžœ˜—Kšœ ˜ K˜K˜—Kšžœ˜—…—€!_