
    <<DiskTool.mesa: test program for investigating/patching raw disk pages.>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) June 25, 1985 11:41:48 am PDT>>
        <<Willie-Sue, November 12, 1985 11:01:57 am PST>>
        <<Dave Rumph, October 6, 1986 7:51:12 pm PDT>>

    DIRECTORY
        Atom USING[ GetPName, MakeAtom ],
        Buttons USING[ Button, ButtonProc, Create, Destroy, SetDisplayStyle ],
        Commander USING[ CommandProc, Register ],
        Containers USING[ ChildXBound, ChildYBound, Create ],
        Convert USING [Error, IntFromRope],
        Disk,
        DiskFace USING[ Op ],
        IO USING[ EndOfStream, GetCedarTokenRope, GetChar, GetInt, PutChar, PutF, PutFR, RIS, RopeFromROS, ROS, STREAM, Error ],
        Labels USING[ Create, Set ],
        MBQueue USING[ Create, CreateButton, Queue, QueueClientAction ],
        Menus USING[ MouseButton ],
        Rope USING[ Cat, ROPE ],
        Rules USING[ Create ],
        VolumeFormat USING[ Attributes ],
        ViewerClasses USING[ Viewer ],
        ViewerOps USING[ OpenIcon ],
        ViewerTools USING[ GetContents, InhibitUserEdits, MakeNewTextViewer, SetContents, SetSelection],
        VM USING[ Allocate, Interval, AddressForPageNumber, Pin, Unpin ];

    DiskTool: CEDAR MONITOR
        IMPORTS Atom, Buttons, Commander, Containers, Convert, Disk, IO, Labels, MBQueue, Rope, Rules, ViewerOps, ViewerTools, VM
        EXPORTS DiskFace--Attributes-- =

    BEGIN

    DriveRec: TYPE = RECORD[channel: Disk.Channel, name: ATOM];
    drives: LIST OF DriveRec _ NIL;

    GetDrives: ENTRY PROC RETURNS[l: LIST OF ATOM _ NIL] = TRUSTED
        BEGIN
        IF drives = NIL
        THEN BEGIN
            FOR h: Disk.Channel _ Disk.NextChannel[NIL],
                Disk.NextChannel[h]
            UNTIL h = NIL
            DO drives _ CONS[
                first: [
                    channel: h,
                    name: Atom.MakeAtom[
                        IO.PutFR["RD%g", [integer[Disk.DriveAttributes[h].ordinal]]]]
                    ],
                rest: drives];
            ENDLOOP;
            END;
        FOR dr: LIST OF DriveRec _ drives, dr.rest UNTIL dr = NIL
        DO l _ CONS[first: dr.first.name, rest: l] ENDLOOP;
        END;

    LookupDrive: ENTRY PROC[name: ATOM] RETURNS[Disk.Channel] =
        BEGIN
        FOR dr: LIST OF DriveRec _ drives, dr.rest UNTIL dr = NIL
        DO IF dr.first.name = name THEN RETURN[dr.first.channel]; ENDLOOP;
        ERROR
        END;

    dataInterval: VM.Interval = VM.Allocate[1];
    label: Disk.Label;

    VRR: Buttons.ButtonProc = TRUSTED {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        DoCommand[d, [header: verify, label: read, data: read], mouseButton ];
        };

    VVR: Buttons.ButtonProc = TRUSTED {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        DoCommand[d, [header: verify, label: verify, data: read], mouseButton ];
        };

    VVW: Buttons.ButtonProc = TRUSTED {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        DoCommand[d, [header: verify, label: verify, data: write], mouseButton ];
        };

    VWW: Buttons.ButtonProc = TRUSTED {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        DoCommand[d, [header: verify, label: write, data: write], mouseButton ];
        };

    BadPageNumber: ERROR = CODE;

    GetPageNumber: PROC[d: MyData] RETURNS[Disk.PageNumber] = TRUSTED
        BEGIN
        pageR: Rope.ROPE = ViewerTools.GetContents[d.pageT];
        in: IO.STREAM = IO.RIS[pageR];
        RETURN[[in.GetInt[! IO.EndOfStream, IO.Error =>
            { Msg[d, "Invalid page number"]; ERROR BadPageNumber[] } ]]]
        END;

    --DiskFace.--Attributes: PUBLIC TYPE = VolumeFormat.Attributes;

    DoCommand: PROC[d: MyData, command: Disk.Command, mouseButton: Menus.MouseButton] = TRUSTED
        BEGIN
        data: LONG POINTER = VM.AddressForPageNumber[dataInterval.page];
        delta: INT = IF command.header = write OR command.label = write OR command.data = write
            THEN 0
            ELSE SELECT mouseButton FROM
                red => 0,
                yellow => +1,
                blue => -1,
                ENDCASE => ERROR;
        page: Disk.PageNumber _ [GetPageNumber[d ! BadPageNumber => GOTO bad] + delta];
        msg: Rope.ROPE = IO.PutFR["Page %g (%bB): %g%g%g ... ",
            [integer[page]], [integer[page]],
            [character[Op[command.header]]],
            [character[Op[command.label]]],
            [character[Op[command.data]]] ];
        handle: Disk.Channel _ LookupDrive[d.drive^];
        req: Disk.Request _ [
            diskPage: page,
            data: data, -- first data page
            command: command,
            count: 1 ];
        status: Disk.Status;
        countDone: Disk.PageCount;
        IF command.label # read
        AND NOT ParseArray[d, d.labelT, LOOPHOLE[LONG[@label]], SIZE[Disk.Label]] THEN GOTO bad;
        IF command.data # read
        AND NOT ParseArray[d, d.dataT, LOOPHOLE[data], 256] THEN GOTO bad;
        ViewerTools.SetContents[d.pageT, IO.PutFR["%g", [integer[page]]]];
        Msg[d, msg];
        TRUSTED BEGIN
            ENABLE UNWIND => VM.Unpin[dataInterval];
            VM.Pin[dataInterval];
            [status, countDone] _ Disk.DoIO[handle, @label, @req];
            VM.Unpin[dataInterval];
        END;
        Msg[d, Rope.Cat[msg, WITH s: status SELECT FROM
            changed => "bad changeCount",
            unchanged => SELECT s.status FROM
                inProgress => "inProgress",
                goodCompletion => "ok",
                notReady => "notReady",
                recalibrateError => "recalibrateError",
                seekTimeout => "seekTimeout",
                headerCRCError => "headerCRCError",
                labelCRCError => "labelCRCError",
                dataCRCError => "dataCRCError",
                headerNotFound => "headerNotFound",
                labelVerifyError => "labelVerifyError",
                dataVerifyError => "dataVerifyError",
                overrunError => "overrunError",
                writeFault => "writeFault",
                memoryError => "memoryError",
                memoryFault => "memoryFault",
                clientError => "clientError",
                operationReset => "operationReset",
                otherError => "otherError",
                ENDCASE => "\"unchanged\"?",
            ENDCASE => "bad status"] ];
        SetArray[d.labelT, LOOPHOLE[LONG[@label]], SIZE[Disk.Label], FALSE];
        BEGIN
            attr: Attributes = label.attributes;
            ViewerTools.SetContents[d.labelDetailsT, IO.PutFR["type = %g, page = %g (%bB)",
            SELECT attr FROM
                physicalRoot => [rope["physical root"]],
                badPageList => [rope["bad page list"]],
                badPage => [rope["bad page"]],
                subVolumeMarker => [rope["marker page"]],
                logicalRoot => [rope["logical root"]],
                freePage => [rope["free page"]],
                header => [rope["header"]],
                data => [rope["data"]],
                ENDCASE => [integer[LOOPHOLE[attr, CARDINAL]]],
            [integer[label.filePage]], [integer[label.filePage]]
            ]];
        END;
        SetArray[d.dataT, LOOPHOLE[data], 256, TRUE];
        EXITS bad => NULL;
        END;

    Op: PROC[op: DiskFace.Op] RETURNS[CHAR] =
        { RETURN[SELECT op FROM noOp => 'n, read => 'r, write => 'w, verify => 'v, ENDCASE => ERROR] };

    SetArray: PROC[v: ViewerClasses.Viewer,
        p: LONG POINTER TO ARRAY OF CARDINAL, n: INT, label: BOOL] =
        TRUSTED BEGIN
        out: IO.STREAM = IO.ROS[];
        FOR i: CARDINAL IN CARDINAL[0..n)
        DO IF (i MOD 8) = 0 AND label
            THEN {IF i # 0 THEN out.PutChar['\n]; out.PutF["%3b:", [cardinal[i]] ] };
            out.PutF["%l  %6b%l", [rope["f"]], [cardinal[p[i]]], [rope["F"]] ];
        ENDLOOP;
        ViewerTools.SetContents[v, IO.RopeFromROS[out] ];
        END;

    ParseArray: PROC[d: MyData, v: ViewerClasses.Viewer, p: LONG POINTER TO ARRAY OF CARDINAL, n: INT] RETURNS[ok: BOOL _ TRUE] =
        TRUSTED BEGIN
        in: IO.STREAM = IO.RIS[ViewerTools.GetContents[v]];
        pos: CARDINAL _ 0;
        DO
            tempR: Rope.ROPE = in.GetCedarTokenRope[ !
                IO.EndOfStream => { Msg[d, "Too few values in data/label text"]; GOTO bad};
                IO.Error => { Msg[d, "Number expected in data/label text"]; GOTO bad} ].token;
            temp: INT = Convert.IntFromRope[tempR, 8 !
                Convert.Error => { Msg[d, "Number expected"]; GOTO bad } ];
            c: CHAR = in.GetChar[ !
                IO.EndOfStream => {
                    p[pos] _ temp; IF pos+1 = n THEN EXIT ELSE { Msg[d, "Too few values in data/label text"]; GOTO bad};
                } ];
            SELECT c FROM
                ': => IF temp # pos
                    THEN { Msg[d, "Incorrectly numbered position in data/label text"]; GOTO bad};
                ',, ' , '\n, '\t => { p[pos] _ temp; pos _ pos+1; IF pos = n THEN EXIT };
            ENDCASE =>
                { Msg[d, "Unexpected character in data/label text"]; GOTO bad};
        ENDLOOP;
        EXITS bad => RETURN[FALSE];
        END;

    Msg: PROC[d: MyData, msg: Rope.ROPE] =
        BEGIN
        Labels.Set[d.msgLabel, msg];
        END;


    -- ******** Viewer management ******** --

    MyData: TYPE = REF MyDataObject;

    MyDataObject: TYPE = MONITORED RECORD[
        mbQueue: MBQueue.Queue _ NIL,
        pageT,
        msgLabel,
        labelT,
        labelDetailsT,
        dataT: ViewerClasses.Viewer _ NIL,
        maxW: INTEGER _ 0,
        buttH: INTEGER _ 0,
        drive: REF ATOM];

    Create: Commander.CommandProc =
        BEGIN
        d: MyData _ NEW[MyDataObject];
        d.mbQueue _ MBQueue.Create[];
        MBQueue.QueueClientAction[d.mbQueue, ReallyCreate, d];
        END;

    ReallyCreate: PROC[clientData: REF ANY] =
        -- This is a separate procedure so that it is synchronized with d.mbQueue --
        <<Thus, the buttons can't be invoked until we've finished creating them, and called SetWorld.>>
        {
        d: MyData = NARROW[clientData];
        v: ViewerClasses.Viewer = Containers.Create[
            info: [name: "Disk Tool", column: left, scrollable: FALSE, iconic: TRUE]];
        child: ViewerClasses.Viewer _ NIL;
        x: INTEGER _ 2;
        y: INTEGER _ 0;
        CommandButton: PROC[name: Rope.ROPE, proc: Buttons.ButtonProc, data: REF ANY,
            newline: BOOL, guarded: BOOL _ FALSE] =
            {
            child _ MBQueue.CreateButton[
                q: d.mbQueue,
                info: [name: name, parent: v, border: TRUE,
                    wy: y, wx: x, ww: d.maxW],
                proc: proc,
                clientData: data,
                fork: TRUE,
                paint: TRUE,
                guarded: guarded];
            x _ IF newline THEN 1 ELSE child.wx + d.maxW - 1;
            y _ IF newline THEN child.wy + child.wh + 2 ELSE child.wy;
            };
        LabelText: PROC[name, data: Rope.ROPE, prev: ViewerClasses.Viewer]
            RETURNS[ViewerClasses.Viewer] =
            {
            scrollWidth: INTEGER = 12;
            child _ ViewerTools.MakeNewTextViewer[
                info: [parent: v, wh: d.buttH, ww: 999, scrollable: TRUE,
                    data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
                    border: FALSE,
                    wx: x + d.maxW + 2 - scrollWidth, wy: y],
                paint: TRUE ];
            Containers.ChildXBound[v, child];
            [] _ Buttons.Create[
                info: [name: name, parent: v, wh: d.buttH,
                    border: FALSE, wx: x+1, wy: y],
                proc: TextLabelProc, clientData: child, fork: FALSE, paint: TRUE];
            x _ 1;
            y _ child.wy + child.wh + 2;
            RETURN[child]
            };
        Label: PROC[name: Rope.ROPE, newline: BOOL] =
            {
            child _ Labels.Create[
                info: [name: name, parent: v, border: FALSE,
                    wy: y, wx: x+1],
                paint: TRUE ];
            x _ IF newline THEN 1 ELSE child.wx + d.maxW - 1;
            y _ IF newline THEN child.wy + child.wh + 2 ELSE child.wy;
            };
        Rule: PROC =
            {
            child _ Rules.Create[
                info: [parent: v, border: FALSE,
                    wy: y, wx: 0, ww: v.ww, wh: 1],
                paint: TRUE ];
            Containers.ChildXBound[v, child];
            x _ 1;
            y _ child.wy + child.wh + 2;
            };
        {
            -- kludge to find max button size! --
            temp: Buttons.Button = Buttons.Create[
                info: [name: "Label (octal):", parent: v, border: FALSE,
                    wx: 0, wy: 0],
                proc: NIL, clientData: d, fork: FALSE, paint: FALSE];
            d.maxW _ temp.ww;
            d.buttH _ temp.wh;
            Buttons.Destroy[temp];
        };
        child _ d.msgLabel _ Labels.Create[
            info: [name: "Left => do it.  Middle => increment and do it.  Right => decrement and do it",
                parent: v, border: FALSE,
                ww: v.cw, wy: y, wx: x+1],
            paint: TRUE ];
        Containers.ChildXBound[v, child];
        x _ 1; y _ child.wy + child.wh + 2;
        Rule[];
        [child, d.drive] _ CreateSelector[q: d.mbQueue,
            name: "Drive:", values: GetDrives[],
            init: NEW[ATOM_$RD0],
            change: NIL,
            clientData: d, viewer: v, x: x, y: y, w: d.maxW];
        x _ 1; y _ child.wy + child.wh - 1;
        Label["Command:", FALSE];
        CommandButton["vrr", VRR, d, FALSE];
        CommandButton["vvr", VVR, d, FALSE];
        CommandButton["vvw", VVW, d, FALSE, TRUE];
        CommandButton["vww", VWW, d, TRUE, TRUE];
        d.pageT _ LabelText["Page:", NIL, NIL];
        d.labelT _ LabelText["Label (octal):", NIL, NIL];
        d.labelDetailsT _ LabelText["", NIL, NIL];
        ViewerTools.InhibitUserEdits[d.labelDetailsT];
        d.dataT _ LabelText["Data:", NIL, NIL];
        Containers.ChildXBound[v, d.dataT];
        Containers.ChildYBound[v, d.dataT];
        ViewerOps.OpenIcon[v];
        };

    TextLabelProc: Buttons.ButtonProc = {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        text: ViewerClasses.Viewer = NARROW[clientData];
        SELECT mouseButton FROM
            red => ViewerTools.SetSelection[text, NIL];
            blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
            yellow => NULL;
        ENDCASE => ERROR;
        };

    Selector: TYPE = REF SelectorRec;

    SelectorRec: TYPE = RECORD[
        value: REF ATOM,
        change: SelectorNotifier,
        clientData: REF ANY,
        buttons: LIST OF Buttons.Button,
        values: LIST OF ATOM ];

    SelectorNotifier: TYPE =
        PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM] RETURNS[BOOL];

    CreateSelector: PROC[q: MBQueue.Queue,
        name: Rope.ROPE,
        values: LIST OF ATOM,
        init: REF ATOM _ NIL,
        change: SelectorNotifier _ NIL,
        clientData: REF ANY _ NIL,
        viewer: ViewerClasses.Viewer,
        x, y: INTEGER,
        w: INTEGER _ 0]
        RETURNS[child: ViewerClasses.Viewer, value: REF ATOM] = {
        selector: Selector _ NEW[ SelectorRec _
            [value: IF init # NIL THEN init ELSE NEW[ATOM_values.first],
                change: change,
                clientData: clientData,
                buttons: NIL,
                values: values ] ];
        last: LIST OF Buttons.Button _ NIL;
        value _ selector.value;
        child _ Labels.Create[
            info: [name: name, parent: viewer, border: FALSE, wx: x+1, wy: y, ww: w] ];
        FOR a: LIST OF ATOM _ values, a.rest UNTIL a = NIL
        DO child _ MBQueue.CreateButton[
            q: q,
            info: [name: Atom.GetPName[a.first], parent: viewer, border: TRUE,
                wy: child.wy, wx: child.wx + child.ww - 1, ww: w],
            proc: SelectorProc,
            clientData: selector,
            fork: TRUE,
            paint: TRUE];
            IF last = NIL
            THEN last _ selector.buttons _ CONS[first: child, rest: NIL]
            ELSE { last.rest _ CONS[first: child, rest: NIL]; last _ last.rest };
            IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
        ENDLOOP;
        };

    SelectorProc: Buttons.ButtonProc = {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        self: Buttons.Button = NARROW[parent];
        selector: Selector = NARROW[clientData];
        buttons: LIST OF Buttons.Button _ selector.buttons;
        FOR a: LIST OF ATOM _ selector.values, a.rest UNTIL a = NIL
        DO IF self = buttons.first
            THEN BEGIN
                IF selector.change = NIL OR selector.change[self.parent, selector.clientData, a.first]
                THEN BEGIN
                    selector.value^ _ a.first;
                    Buttons.SetDisplayStyle[self, $WhiteOnBlack];
                    FOR others: LIST OF Buttons.Button _ selector.buttons, others.rest UNTIL others = NIL
                    DO IF others.first # self
                        THEN Buttons.SetDisplayStyle[others.first, $BlackOnWhite]
                    ENDLOOP;
                    END;
                EXIT
                END;
            buttons _ buttons.rest;
        ENDLOOP;
        };

    Commander.Register[key: "DiskTool", proc: Create,
        doc: "Reading and patching raw disk (wizards only!)"];

    END.