
    <<RoseWireTwiddlingImpl.Mesa>>
<<Last Edited by: Spreitzer, September 24, 1985 3:54:57 pm PDT>>

    DIRECTORY Basics, BitTwiddling, PrincOps, PrincOpsUtils, RoseBehavior, RoseWireTwiddling, RoseWireTypes, UnsafeStorage;

    RoseWireTwiddlingImpl: CEDAR PROGRAM
        IMPORTS BitTwiddling, PrincOpsUtils, UnsafeStorage
        EXPORTS RoseWireTwiddling

         = {OPEN BitTwiddling, RoseWireTwiddling;

        Selector: TYPE = RoseWireTypes.Selector;

        disableCopy: BOOL _ FALSE;
        uz: UNCOUNTED ZONE _ GetZone[];

        GetZone: PROC RETURNS [UNCOUNTED ZONE] =
            TRUSTED {RETURN [UnsafeStorage.GetSystemUZone[]]};

        RefToPtr: PUBLIC PROC [ra: REF ANY, referentType: RoseWireType] RETURNS [p: Ptr] = {
            bits: NAT = referentType.class.super.Bits[referentType];
            p _ OffsetPtr[
                PtrFromRef[ra],
                altRem[Basics.bitsPerWord - (bits MOD Basics.bitsPerWord)]
                ]
            };

        CopyVal: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr, bbTable: PrincOps.BitBltTablePtr] = {
            blt: BOOL _ toT.class.structure = atom OR (fromT = toT AND NOT fromT.class.addressContaining);
            IF fromT.class.structure # toT.class.structure THEN ERROR;
            IF fromT.class.dereference THEN fromP _ DeReferencePtr[fromP];
            IF toT.class.dereference THEN toP _ DeReferencePtr[toP];
            IF blt THEN TRUSTED {
                bitCount: NAT = toT.class.super.Bits[toT];
                lineWidth: NAT _ PrincOpsUtils.BITAND[(bitCount+31), WORD.LAST-31];
                IF bitCount #  fromT.class.super.Bits[fromT] THEN ERROR;
                bbTable^ _ [
                    dst: toP,
                    dstBpl: lineWidth,
                    src: fromP,
                    srcDesc: [srcBpl[lineWidth]],
                    width: bitCount,
                    height: 1,
                    flags: []];
                IF NOT disableCopy THEN PrincOpsUtils.BITBLT[bbTable];
                blt _ blt;
                }
            ELSE {
                IF fromT.length # toT.length THEN ERROR;
                FOR i: NAT IN [0 .. toT.length) DO
                    sel: Selector = SELECT fromT.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    CopyVal[
                        fromT: fromT.class.super.SubType[fromT, sel],
                        toT: toT.class.super.SubType[toT, sel],
                        fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
                        toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]],
                        bbTable: bbTable];
                    ENDLOOP;
                toP _ toP;
                };
            };

        CopyAndLimitDrive: PUBLIC PROC [type: RoseWireType, fromP, toP: Ptr, min: Drive] = {
            base: BOOL _ type.class.structure = atom;
            IF type.class.dereference THEN fromP _ DeReferencePtr[fromP];
            IF type.class.dereference THEN toP _ DeReferencePtr[toP];
            IF base THEN {
                read: Drive _ ReadDrive[fromP];
                limited: Drive _ MAX[read, min];
                WriteDrive[toP, limited];
                }
            ELSE {
                fromP _ fromP;
                FOR i: NAT IN [0 .. type.length) DO
                    sel: Selector = SELECT type.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    offset: INTEGER = type.class.super.SelectorOffset[type, sel];
                    CopyAndLimitDrive[
                        type: type.class.super.SubType[type, sel],
                        fromP: OffsetPtr[fromP, offset],
                        toP: OffsetPtr[toP, offset],
                        min: min];
                    ENDLOOP;
                toP _ toP;
                };
            };

        CopyQ: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] = {
            base: BOOL _ toT.class.structure = atom;
            IF fromT.class.structure # toT.class.structure THEN ERROR;
            IF base THEN {
                IF fromT # toT THEN ERROR;
                toT.class.super.CopyQ[toT, fromP, toP];
                }
            ELSE {
                IF fromT.class.dereference THEN fromP _ DeReferencePtr[fromP];
                IF toT.class.dereference THEN toP _ DeReferencePtr[toP];
                IF fromT.length # toT.length THEN ERROR;
                FOR i: NAT IN [0 .. toT.length) DO
                    sel: Selector = SELECT fromT.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    CopyQ[
                        fromT: fromT.class.super.SubType[fromT, sel],
                        toT: toT.class.super.SubType[toT, sel],
                        fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
                        toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
                        ];
                    ENDLOOP;
                toP _ toP;
                };
            };

        CopyUD: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] = {
            base: BOOL _ toT.class.structure = atom;
            IF fromT.class.structure # toT.class.structure THEN ERROR;
            IF base THEN {
                IF fromT # toT THEN ERROR;
                toT.class.super.CopyUD[toT, fromP, toP];
                }
            ELSE {
                IF fromT.class.dereference THEN fromP _ DeReferencePtr[fromP];
                IF toT.class.dereference THEN toP _ DeReferencePtr[toP];
                IF fromT.length # toT.length THEN ERROR;
                FOR i: NAT IN [0 .. toT.length) DO
                    sel: Selector = SELECT fromT.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    CopyUD[
                        fromT: fromT.class.super.SubType[fromT, sel],
                        toT: toT.class.super.SubType[toT, sel],
                        fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
                        toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
                        ];
                    ENDLOOP;
                toP _ toP;
                };
            };

        CopyLevel: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] = {
            base: BOOL _ toT.class.structure = atom;
            IF fromT.class.structure # toT.class.structure THEN ERROR;
            IF base THEN {
                IF fromT # toT THEN ERROR;
                toT.class.super.CopyLevel[toT, fromP, toP];
                }
            ELSE {
                IF fromT.class.dereference THEN fromP _ DeReferencePtr[fromP];
                IF toT.class.dereference THEN toP _ DeReferencePtr[toP];
                IF fromT.length # toT.length THEN ERROR;
                FOR i: NAT IN [0 .. toT.length) DO
                    sel: Selector = SELECT fromT.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    CopyLevel[
                        fromT: fromT.class.super.SubType[fromT, sel],
                        toT: toT.class.super.SubType[toT, sel],
                        fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
                        toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
                        ];
                    ENDLOOP;
                toP _ toP;
                };
            };

        EqualVal: PUBLIC PROC [t1, t2: RoseWireType, p1, p2: Ptr] RETURNS [equal: BOOL] = {
            block: BOOL _ t2.class.structure = atom OR (t1 = t2 AND NOT t1.class.addressContaining);
            IF t1.class.structure # t2.class.structure THEN ERROR;
            IF t1.class.dereference THEN p1 _ DeReferencePtr[p1];
            IF t2.class.dereference THEN p2 _ DeReferencePtr[p2];
            IF block THEN {
                bitCount: NAT = t2.class.super.Bits[t2];
                IF bitCount #  t1.class.super.Bits[t1] THEN ERROR;
                equal _ Equal[p1, p2, bitCount];
                }
            ELSE {
                IF t1.length # t2.length THEN ERROR;
                FOR i: NAT IN [0 .. t2.length) DO
                    sel: Selector = SELECT t1.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    IF NOT EqualVal[
                        t1: t1.class.super.SubType[t1, sel],
                        t2: t2.class.super.SubType[t2, sel],
                        p1: OffsetPtr[p1, t1.class.super.SelectorOffset[t1, sel]],
                        p2: OffsetPtr[p2, t2.class.super.SelectorOffset[t2, sel]]
                        ]
                    THEN RETURN [FALSE];
                    ENDLOOP;
                equal _ TRUE;
                };
            };

        EqualUD: PUBLIC PROC [t1, t2: RoseWireType, p1, p2: Ptr] RETURNS [equal: BOOL] = {
            base: BOOL _ t2.class.structure = atom;
            IF t1.class.structure # t2.class.structure THEN ERROR;
            IF base THEN {
                IF t1 #  t2 THEN ERROR;
                equal _ t1.class.super.EqualUD[t1, p1, p2];
                }
            ELSE {
                IF t1.class.dereference THEN p1 _ DeReferencePtr[p1];
                IF t2.class.dereference THEN p2 _ DeReferencePtr[p2];
                IF t1.length # t2.length THEN ERROR;
                FOR i: NAT IN [0 .. t2.length) DO
                    sel: Selector = SELECT t1.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    IF NOT EqualUD[
                        t1: t1.class.super.SubType[t1, sel],
                        t2: t2.class.super.SubType[t2, sel],
                        p1: OffsetPtr[p1, t1.class.super.SelectorOffset[t1, sel]],
                        p2: OffsetPtr[p2, t2.class.super.SelectorOffset[t2, sel]]
                        ]
                    THEN RETURN [FALSE];
                    ENDLOOP;
                equal _ TRUE;
                };
            };

        MaxinQ: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] RETURNS [increase: BOOL] = {
            base: BOOL _ toT.class.structure = atom;
            IF fromT.class.structure # toT.class.structure THEN ERROR;
            IF base THEN {
                IF fromT # toT THEN ERROR;
                increase _ toT.class.super.MaxinQ[toT, fromP, toP];
                }
            ELSE {
                IF fromT.class.dereference THEN fromP _ DeReferencePtr[fromP];
                IF toT.class.dereference THEN toP _ DeReferencePtr[toP];
                IF fromT.length # toT.length THEN ERROR;
                increase _ FALSE;
                FOR i: NAT IN [0 .. toT.length) DO
                    sel: Selector = SELECT fromT.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    IF MaxinQ[
                        fromT: fromT.class.super.SubType[fromT, sel],
                        toT: toT.class.super.SubType[toT, sel],
                        fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
                        toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
                        ]
                    THEN increase _ TRUE;
                    ENDLOOP;
                toP _ toP;
                };
            };

        MaxinUD: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] RETURNS [increase: BOOL] = {
            base: BOOL _ toT.class.structure = atom;
            IF fromT.class.structure # toT.class.structure THEN ERROR;
            IF base THEN {
                IF fromT # toT THEN ERROR;
                increase _ toT.class.super.MaxinUD[toT, fromP, toP];
                }
            ELSE {
                IF fromT.class.dereference THEN fromP _ DeReferencePtr[fromP];
                IF toT.class.dereference THEN toP _ DeReferencePtr[toP];
                IF fromT.length # toT.length THEN ERROR;
                increase _ FALSE;
                FOR i: NAT IN [0 .. toT.length) DO
                    sel: Selector = SELECT fromT.class.structure FROM
                        atom => ERROR,
                        record => [field[i]],
                        sequence => [subscript[i]],
                        ENDCASE => ERROR;
                    IF MaxinUD[
                        fromT: fromT.class.super.SubType[fromT, sel],
                        toT: toT.class.super.SubType[toT, sel],
                        fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
                        toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
                        ]
                    THEN increase _ TRUE;
                    ENDLOOP;
                toP _ toP;
                };
            };

        bitsPerDrive: NAT = SIZE[PACKED ARRAY [0 .. 32) OF Drive]/SIZE[PACKED ARRAY [0 .. 32) OF BOOL];
        drivesPerWord: NAT = 480/SIZE[PACKED ARRAY [0 .. 480) OF Drive];
            <<480 is LCM [Floor[32/1], Floor[32/2], Floor[32/3], ... Floor[32/32]].>>
        <<>>
        ReadDrive: PUBLIC PROC [p: Ptr] RETURNS [d: Drive] = TRUSTED {
            di: NAT = p.bit/bitsPerDrive;
            ap: LONG POINTER TO PACKED ARRAY [0 .. drivesPerWord) OF Drive = LOOPHOLE[p.word];
            IF di*bitsPerDrive # p.bit THEN ERROR;
            d _ ap[di];
            };

        WriteDrive: PUBLIC PROC [p: Ptr, d: Drive] = TRUSTED {
            di: NAT = p.bit/bitsPerDrive;
            ap: LONG POINTER TO PACKED ARRAY [0 .. drivesPerWord) OF Drive = LOOPHOLE[p.word];
            IF di*bitsPerDrive # p.bit THEN ERROR;
            ap[di] _ d;
            };

        CreateUntypedInstance: PUBLIC PROC [rwt: RoseWireType] RETURNS [p: Ptr] = {
            Setup: PROC [rwt: RoseWireType, p: Ptr, bits: INT] = TRUSTED {
                rwc: RoseWireTypes.RoseWireClass = rwt.class;
                rws: RoseWireTypes.RoseWireSuperClass = rwc.super;
                q: Ptr _ p;
                IF rwc.dereference THEN {
                    lplp: LONG POINTER TO LONG POINTER = LOOPHOLE[p.word];
                    IF p.bit # 0 THEN ERROR;
                    IF bits # SIZE[LONG POINTER] * Basics.bitsPerWord THEN ERROR;
                    q _ [
                        word: rws.CreateReferent[rwt],
                        bit: 0];
                    lplp^ _ q.word;
                    };
                IF rwc.addressContaining THEN {
                    rwt _ rwt;
                    FOR i: NAT IN [0 .. rwt.length) DO
                        sel: Selector = SELECT rwc.structure FROM
                            sequence => [subscript[i]],
                            record => [field[i]],
                            ENDCASE => ERROR;
                        swt: RoseWireType = rws.SubType[rwt, sel];
                        sp: Ptr = BitTwiddling.OffsetPtr[q, rws.SelectorOffset[rwt, sel]];
                        Setup[swt, sp, swt.class.super.Bits[swt]];
                        ENDLOOP;
                    rwt _ rwt;
                    };
                rwt _ rwt;
                };
            bits: NAT = rwt.class.super.Bits[rwt];
            words: NAT = (bits + Basics.bitsPerWord-1) / Basics.bitsPerWord;
            TRUSTED {
                p _ [
                    word: UnsafeStorage.NewUObject[words, uz],
                    bit: (Basics.bitsPerWord - (bits MOD Basics.bitsPerWord)) MOD Basics.bitsPerWord
                    ];
                PrincOpsUtils.LongZero[p.word, words];
                };
            Setup[rwt, p, bits];
            };

        }.