
    <<RoseBasicSequenceImpl.mesa>>
        <<Copyright © 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>>

    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.