
<<RoseTestingImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reversed.>>
<<Barth, August 1, 1985 2:31:39 pm PDT>>
    <<Spreitzer, October 2, 1985 9:41:26 pm PDT>>

    DIRECTORY Asserting, BasicTime, BitTwiddling, Core, CoreFlatten, CoreOps, CoreProperties, CoreRecord, CoreUnspecified, GetMe, IO, 
    PrincOps, PrincOpsUtils, Rope, RoseBehavior, RoseBind, RoseBindPrivate, RoseControl, RoseEngine, RosePrivates, RoseSimTypes, 
    RoseWireTwiddling, RoseWireTypes, TimeStamp;

    RoseTestingImpl: CEDAR PROGRAM
        IMPORTS Asserting, BasicTime, BitTwiddling, CoreOps, CP: CoreProperties, CoreRecord, CoreUnspecified, GetMe, PrincOpsUtils, Rope, 
        RoseBind, RoseBindPrivate, RoseEngine, RoseSimTypes, RoseWireTwiddling
        EXPORTS RoseBind, RoseControl, RoseEngine
        =

    BEGIN OPEN RoseWireTypes, RoseSimTypes, RoseEngine;

    BehaviorClass: TYPE = REF BehaviorClassRec;
    BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
    SimulationRec: PUBLIC TYPE = RoseSimTypes.SimulationRec;

    TestRootType: TYPE = REF TestRootTypeRec;
    TestRootTypeRec: TYPE = RECORD [
        testerCT, testeeCT: CellType,
        testerCI, testeeCI: CellInstance,
        testerRCT, testeeRCT: RoseCellType
        ];

    testeeTypeToTesterType: ATOM = CP.RegisterProperty[$RoseTesteeTypeToTesterType];
    testeeTypeToRootType: ATOM = CP.RegisterProperty[$RoseTesteeTypeToRootType];
    testeeBehaviorClassToTesterBehaviorClass: ATOM = $RoseTesteeBehaviorClassToTesterBehaviorClass;
    trtKey: ATOM = CP.RegisterProperty[$RoseTestRootTypeKey];

    myStamp: TimeStamp.Stamp _ GetMe.GetVersion[];

    GetTestRootType: PUBLIC PROC [testeeType: CellType] RETURNS [rootType: CellType] = {
        testerType: CellType;
        iw: Wire;
        trt: TestRootType;
        rootType _ NARROW[CP.GetCellTypeProp[testeeType, testeeTypeToRootType]];
        IF rootType # NIL THEN RETURN;
        testerType _ NARROW[CP.GetCellTypeProp[testeeType, testeeTypeToTesterType]];
        IF testerType = NIL THEN {
            testeeBehaviorClass, testerBehaviorClass: BehaviorClass;
            testerPW: Wire;
            goodPrivate: BOOL;
            [class: testeeBehaviorClass, goodPrivate: goodPrivate] _ RoseBindPrivate.GetBehaviorClass[testeeType, FALSE, TRUE, TRUE];
            IF NOT goodPrivate THEN ERROR;
            testerBehaviorClass _ NARROW[Asserting.FnVal[
                testeeBehaviorClassToTesterBehaviorClass,
                testeeBehaviorClass.other]];
            testerPW _ CoreOps.CopyWire[testeeType.publicWire];
            IF testerBehaviorClass = NIL THEN {
                testerBehaviorClass _ RoseBind.EnsureBehaviorClass[
                    name: testeeBehaviorClass.name.Cat["Tester"],
                    publicWirePrototype: Convert[testeeBehaviorClass.publicWirePrototype]
                    ];
                testerBehaviorClass.detailsStamp _ myStamp;
                testerBehaviorClass.detailsTime _ BasicTime.Now[];
                testerBehaviorClass.details _ testerBehaviorDetails;
                testerBehaviorClass.unusualDerivation _ [details: TRUE];
                [] _ RoseBindPrivate.EnsureBCParts[testerBehaviorClass, FALSE, FALSE, TRUE];
                testeeBehaviorClass.other _ Asserting.AssertFn1[
                    testeeBehaviorClassToTesterBehaviorClass,
                    testerBehaviorClass,
                    testeeBehaviorClass.other,
                    NIL,
                    TRUE];
                };
            testerType _ NEW [Core.CellTypeRec _ [
                name: testeeType.name.Cat["Tester"],
                publicWire: testerPW,
                class: CoreUnspecified.unspecifiedCellClass,
                data: NIL,
                properties: CP.Props[[RoseBind.classKey, testerBehaviorClass]]
                ]];
            CP.PutCellTypeProp[testeeType, testeeTypeToTesterType, testerType];
            }
        ELSE ERROR;
        iw _ CoreOps.CopyWire[testeeType.publicWire];
        trt _ NEW [TestRootTypeRec _ [
            testerCT: testerType,
            testeeCT: testeeType,
            testerCI: NEW [CoreRecord.CellInstanceRec _ [
                name: testerName,
                actualWire: iw,
                type: testerType
                ]],
            testeeCI: NEW [CoreRecord.CellInstanceRec _ [
                name: testeeName,
                actualWire: iw,
                type: testeeType
                ]],
            testerRCT: GetRoseCellType[testerType, FALSE, TRUE],
            testeeRCT: GetRoseCellType[testeeType, FALSE, FALSE]
            ]];
        CP.PutCellTypeProp[testerType, RoseBind.argsKey, trt];
        rootType _ NEW [Core.CellTypeRec _ [
            name: testeeType.name.Cat[" Test Root"],
            class: CoreRecord.recordCellClass,
            publicWire: CoreOps.CreateSequenceWire["public wire", NIL],
            data: NEW [CoreRecord.RecordCellTypeRec _ [
                internalWire: iw,
                instances: LIST[trt.testerCI, trt.testeeCI]
                ]],
            properties: CP.Props[[trtKey, trt]]
            ]];
        CP.PutCellTypeProp[testeeType, testeeTypeToRootType, rootType];
        };

    testerName: ROPE = "tester";
    testeeName: ROPE = "testee";

    Convert: PROC [testeePWP: Wire] RETURNS [testerPWP: Wire] = {
        ConvertProps: PROC [wire: Wire] RETURNS [notSubWires: BOOL _ FALSE, quit: BOOL _ FALSE] = {
            Do: PROC [to, from: ATOM] = {
                CP.PutWireProp[wire, to, CP.GetWireProp[wire, from]];
                };
            Do[RoseBind.switchWire, RoseBind.testerSwitchWire];
            Do[RoseBind.complexDrive, RoseBind.testerComplexDrive];
            Do[RoseBind.simpleDrive, RoseBind.testerSimpleDrive];
            };
        testerPWP _ CoreOps.CopyWire[testeePWP];
        CoreOps.VisitWire[testerPWP, ConvertProps];
        };

    testerBehaviorDetails: RoseBehavior.Details _ NEW [RoseBehavior.DetailsRec _ [
        EvalSimple: EvalTesterSimple,
        ValsChanged: TesterValsChanged,
        InitQ: NIL,
        PropQ: PropTesterQUD,
        InitUD: NIL,
        PropUD: PropTesterQUD,
        FinalUD: NIL,
        EnumerateVicinity: NIL,
        CreateState: CreateTesterState
        ]];

    EvalTesterSimple: PROC [argsAny, switchAny, simpleAny, strengthAny, stateAny: REF ANY, perturb: PROC [portPath: PortPath]] 
    --EvalProc-- = {
        cth: CellTestHandle = NARROW[stateAny];
        driveType: RoseWireType = cth.testerRCT.wireTypes[drive];
        RoseWireTwiddling.CopyAndLimitDrive[
            type: driveType,
            fromP: cth.driveInstructionsAsPtr,
            toP: RoseWireTwiddling.RefToPtr[cth.testerRCI.newDrive, driveType],
            min: FIRST[Strength]
            ];
        CopyIO[from: cth.instructionFields, to: cth.testerRCI.effectivePorts, what: moveByDrive, flavor: simple];
        argsAny _ argsAny;
        };

    TesterValsChanged: PROC [argsAny, switchAny, simpleAny, strengthAny, stateAny: REF ANY, perturb: PROC [portPath: PortPath]] 
    --EvalProc-- = {
        cth: CellTestHandle = NARROW[stateAny];
        CopyIO[from: cth.testerRCI.effectivePorts, to: cth.instructionFields, what: levelForward, flavor: switch];
        argsAny _ argsAny;
        };

    PropTesterQUD: PROC [argsAny, switchAny, simpleAny, strengthAny, stateAny: REF ANY, perturb: PROC [portPath: PortPath]] 
    --EvalProc-- = {
        cth: CellTestHandle _ NARROW[stateAny];
        CopyIO[from: cth.instructionFields, to: cth.testerRCI.effectivePorts, what: forward, flavor: switch];
        argsAny _ argsAny;
        };

    DirectionInstruction: TYPE = {none, forward, backward, check, moveByDrive, checkTests, checkIns, levelForward};

    CopyIO: PROC [from, to: EffectivePortS, what: DirectionInstruction, flavor: WireFlavor] = {
        bbTableSpace: PrincOps.BBTableSpace;
        bbTable: PrincOps.BitBltTablePtr;
        TRUSTED {bbTable _ PrincOpsUtils.AlignedBBTable[@bbTableSpace]};
        IF from.length # to.length THEN ERROR;
        FOR epi: EffectivePortIndex IN [0 .. to.length) DO
            rwt: RoseWireType _ to[epi].type;
            di: DirectionInstruction;
            IF rwt.class.super.flavor # flavor THEN LOOP;
            {
            fromPtr: Ptr _ SELECT rwt.class.super.flavor FROM
                simple => from[epi].newSimple,
                switch => from[epi].switch,
                ENDCASE => ERROR;
            toPtr: Ptr _ SELECT rwt.class.super.flavor FROM
                simple => to[epi].newSimple,
                switch => to[epi].switch,
                ENDCASE => ERROR;
            fromDrivePtr: Ptr = from[epi].newDrive;
            SELECT what FROM
                moveByDrive => SELECT rwt.class.super.flavor FROM
                    simple => {
                        di _ SELECT RoseWireTwiddling.ReadDrive[fromDrivePtr] FROM
                            test => none,
                            see => backward,
                            none => none,
                            chargeWeak, chargeMediumWeak, charge, chargeMediumStrong, chargeStrong, chargeVeryStrong, driveWeak, driveMediumWeak, drive, 
                            driveMediumStrong, driveStrong, driveVeryStrong, input => forward,
                            ENDCASE => ERROR;
                        };
                    ENDCASE => ERROR;
                checkTests => SELECT rwt.class.super.flavor FROM
                    simple => {
                        di _ SELECT RoseWireTwiddling.ReadDrive[fromDrivePtr] FROM
                            test => check,
                            see => none,
                            none => none,
                            chargeWeak, chargeMediumWeak, charge, chargeMediumStrong, chargeStrong, chargeVeryStrong, driveWeak, driveMediumWeak, drive, 
                            driveMediumStrong, driveStrong, driveVeryStrong, input => none,
                            ENDCASE => ERROR;
                        };
                    ENDCASE => ERROR;
                checkIns => SELECT rwt.class.super.flavor FROM
                    simple => {
                        di _ SELECT RoseWireTwiddling.ReadDrive[fromDrivePtr] FROM
                            test => check,
                            see => check,
                            none => none,
                            chargeWeak, chargeMediumWeak, charge, chargeMediumStrong, chargeStrong, chargeVeryStrong, driveWeak, driveMediumWeak, drive, 
                            driveMediumStrong, driveStrong, driveVeryStrong, input => none,
                            ENDCASE => ERROR;
                        };
                    ENDCASE => ERROR;
                none, forward, backward, check, levelForward => di _ what;
                ENDCASE => ERROR;
            SELECT di FROM
                none => NULL;
                forward => RoseWireTwiddling.CopyVal[rwt, rwt, fromPtr, toPtr, bbTable];
                levelForward => RoseWireTwiddling.CopyLevel[rwt, rwt, fromPtr, toPtr];
                backward => RoseWireTwiddling.CopyVal[rwt, rwt, toPtr, fromPtr, bbTable];
                check => IF NOT RoseWireTwiddling.EqualVal[rwt, rwt, fromPtr, toPtr] THEN SIGNAL Warning["test failed"];
                moveByDrive, checkTests, checkIns => ERROR;
                ENDCASE => ERROR;
            }
            ENDLOOP;
        what _ what;
        };

    CreateTesterState: PROC [argsAny: REF ANY _ NIL] RETURNS [stateAny: REF ANY _ NIL] = {
        trt: TestRootType = NARROW[argsAny];
        cth: CellTestHandle = NEW [CellTestHandleRep _ [
            sim: NIL,
            testerCT: trt.testerCT,
            testeeCT: trt.testeeCT,
            testerCI: trt.testerCI,
            testeeCI: trt.testeeCI,
            switchInstructions: trt.testerRCT.behaviorClass.private.createSwitch[trt.testeeCT.publicWire],
            simpleInstructions: trt.testerRCT.behaviorClass.private.createSimple[trt.testeeCT.publicWire],
            driveInstructions: trt.testerRCT.behaviorClass.private.createDrive[trt.testeeCT.publicWire],
            testerRCT: trt.testerRCT,
            testeeRCT: trt.testeeRCT,
            testerRCI: NIL,
            testeeRCI: NIL
            ]];
        cth.driveInstructionsAsPtr _ RoseWireTwiddling.RefToPtr[cth.driveInstructions, trt.testerRCT.wireTypes[drive]];
        stateAny _ cth;
        };

    FinishTestInstantiation: PUBLIC PROC [sim: Simulation, rootCellType: CellType] = {
        trt: TestRootType = NARROW[CP.GetCellTypeProp[rootCellType, trtKey]];
        testerRCI: RoseCellInstance = LookupCI[sim, NEW [CoreFlatten.InstanceSourceRec _ [NIL, trt.testerCI]]];
        cth: CellTestHandle = NARROW[testerRCI.state];
        cth.sim _ sim;
        cth.testerRCI _ testerRCI;
        cth.testeeRCI _ LookupCI[sim, NEW [CoreFlatten.InstanceSourceRec _ [NIL, trt.testeeCI]]];
        cth.instructionFields _ NEW [EffectivePortSeq[cth.testerRCI.effectivePorts.length]];
        FOR epi: EffectivePortIndex IN [0 .. cth.instructionFields.length) DO
            cep: EffectivePort = cth.testerRCI.effectivePorts[epi];
            cth.instructionFields[epi] _ [
                switch: Subscript[
                    RoseWireTwiddling.RefToPtr[cth.switchInstructions, cth.testerRCT.wireTypes[switch]],
                    cth.testerRCT.wireTypes[switch],
                    cep.path],
                newSimple: Subscript[
                    RoseWireTwiddling.RefToPtr[cth.simpleInstructions, cth.testerRCT.wireTypes[simple]],
                    cth.testerRCT.wireTypes[simple],
                    cep.path],
                oldSimple: nilPtr,
                newDrive: Subscript[
                    RoseWireTwiddling.RefToPtr[cth.driveInstructions, cth.testerRCT.wireTypes[drive]],
                    cth.testerRCT.wireTypes[drive],
                    cep.path],
                oldDrive: nilPtr,
                type: cep.type,
                implType: cep.implType,
                path: cep.path,
                input: cep.input,
                output: cep.output,
                XPhobic: cep.XPhobic,
                transduced: cep.transduced
                ];
            ENDLOOP;
        sim.cth _ cth;
        };

    Subscript: PROC [p: Ptr, rwt: RoseWireType, path: PortPath] RETURNS [q: Ptr] = {
        IF path = NIL THEN RETURN [p];
        {
        sel: Selector = SELECT rwt.class.structure FROM
            record => [field[path.first]],
            sequence => [subscript[path.first]],
            ENDCASE => ERROR;
        q _ Subscript[
            BitTwiddling.OffsetPtr[p, rwt.class.super.SelectorOffset[rwt, sel]],
            rwt.class.super.SubType[rwt, sel],
            path.rest
            ];
        };
        };

    Test: PUBLIC PROC [simulation: Simulation, testProc: RoseControl.TestProc, testData: REF ANY _ NIL, stateToo: BOOL _ FALSE, steady: 
    BOOL _ TRUE] =
        BEGIN
        cth: CellTestHandle = simulation.cth;
        test: CellTest = NEW [CellTestRec _ [testProc, testData, stateToo]];
        ctl: TestControl = NEW [TestControlRec _ []];
        Eval: PROC = {
            tester: RoseCellInstance _ NIL;
            ScheduleCell[cth.testerRCI];
            PerturbDifferences[cth, cth.testerRCI];
            IF cth.ctl.stopBefore THEN SIGNAL Stop["About to eval"];
            WHILE StepSim[simulation] # noStep DO NULL ENDLOOP;
            tester _ cth.testerRCI;
            CopyIO[from: cth.instructionFields, to: tester.effectivePorts, what: checkTests, flavor: simple];
            IF cth.ctl.stopAfter THEN SIGNAL Stop["Just eval'd"];
            };
        state: REF ANY _ NIL;
        IF cth.test # NIL OR cth.ctl # NIL THEN Error["Currently in use"];
        cth.test _ test;
        cth.ctl _ ctl;
        {ENABLE UNWIND => {cth.test _ NIL; cth.ctl _ NIL};
        InitSimulator[simulation, steady];
        IF test.stateToo THEN state _ IF cth.testeeRCI # NIL THEN cth.testeeRCI.state ELSE ERROR;
        test.testProc[
            testeeType: cth.testeeCT,
            testData: test.testData,
            switchInstructions: cth.switchInstructions,
            simpleInstructions: cth.simpleInstructions,
            driveInstructions: cth.driveInstructions,
            stateAny: state,
            Eval: Eval
            ];
        WHILE StepSim[simulation] # noStep DO NULL ENDLOOP;
        };
        cth.test _ NIL;
        cth.ctl _ NIL;
        END;

    PerturbDifferences: PROC [cth: CellTestHandle, cell: RoseCellInstance] = {
        cell _ cell;
        FOR epi: EffectivePortIndex IN [0 .. cell.effectivePorts.length) DO
            rwt: RoseWireType _ cell.effectivePorts[epi].type;
            different: BOOL _ FALSE;
            SELECT rwt.class.super.flavor FROM
                simple => LOOP;
                switch => NULL;
                drive => ERROR;
                ENDCASE => ERROR;
            different _ NOT RoseWireTwiddling.EqualUD[
                rwt,
                rwt,
                cell.effectivePorts[epi].switch,
                cth.instructionFields[epi].switch];
            IF different THEN PerturbWire[rw: cell.connectedWires[epi], agitator: nilModelSlot, evenIfInput: TRUE];
            ENDLOOP;
        cth _ cth;
        };

    END.