
    <<MBDriver.mesa   >>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sandman on 6-Aug-81 15:40:03>>
        <<Lewis on 28-Sep-81 16:46:51>>
        <<Levin on January 16, 1984 11:39 am>>
        <<Russ Atkinson (RRA) March 8, 1985 5:02:23 pm PST>>

    DIRECTORY
        Ascii USING [CR, SP, TAB],
        BasicTime USING [GMT, Now, Period],
        Commander USING [CommandProc, Register],
        Convert USING [CardFromRope, Error],
        DebuggerSwap USING [CallDebugger],
        FS USING [Error, FileInfo],
        IO USING [bool, BreakProc, card, EndOfStream, GetTokenRope, PutChar, PutF, PutFR, PutRope, RIS, rope, STREAM, time],
        IOUtils USING [CopyPFProcs, PFCodeProc, PFProcs, SetPFCodeProc, SetPFProcs],
        List USING [Map, Reverse],
        Loader USING [BCDBuildTime],
        MB USING [Abort, BCount, BHandle, BObject, DumpBootHeader, DumpFrames, DumpInputBcds, DumpStartList, EchoInput, Error, FinishCache, 
        FinishDebug, FinishLoader, FinishLoadmap, FinishMain, FinishOutput, FinishParse, FinishScript, FinishUtilities, FinishVM, 
        Handle, InitCache, InitDebug, InitLoader, InitLoadmap, InitMain, InitMemory, InitOutput, InitParse, InitScript, 
        InitUtilities, InitVM, InputBCDs, Load, MakeScript, Object, OpenLoadmap, ProcessInput, ReportFrameAllocation, 
        TurnOffStartTrap, WriteBootFile, WriteGermFile],
        PrincOps USING [GFTIndex, PsbIndex],
        Process USING [CheckForAbort],
        Rope USING [Cat, Equal, Fetch, Find, Index, Length, ROPE, Substr];

    MBDriver: CEDAR MONITOR
        IMPORTS BasicTime, Commander, Convert, DebuggerSwap, FS, IO, IOUtils, List, Loader, MB, Process, Rope
        EXPORTS MB = BEGIN

    ROPE: TYPE = Rope.ROPE;

    data: MB.Handle _ NIL;
    typescript: IO.STREAM;
    commandStream: IO.STREAM;

    Outcome: TYPE = {normal, error, abort, noMoreCommands};

    RunFromCommander: Commander.CommandProc = {
        commandStream _ IO.RIS[cmd.commandLine];
        typescript _ cmd.out;
        [] _ DoWork[];
        commandStream _ typescript _ NIL;
        };


    DoWork: ENTRY PROC RETURNS [outcome: Outcome] = {
        ENABLE UNWIND => NULL;
        WriteHerald: PROC = {typescript.PutF["%g\N%t\N", IO.rope[MakeBootVersion[]], IO.time[]]};
        ReportStats: PROC [
            nFilePages, nModules, nGFIs, nResidentPages, nBootLoadedPages: CARDINAL,
            elapsedTime: LONG CARDINAL] = {
            typescript.PutF["Boot file pages: %d (%d bootloaded, of which %d are resident)\N",
                IO.card[nFilePages], IO.card[nBootLoadedPages], IO.card[nResidentPages]];
            typescript.PutF["Modules: %d (requiring %d GFIs)\N", IO.card[nModules], IO.card[nGFIs]];
            typescript.PutF["Time: %r\N", IO.card[elapsedTime]];
            };
        Initialize: PROC = {
            <<the following must be first>>
            InitDriver[];
            <<The order of the following is arbitrary.>>
            MB.InitCache[data];
            MB.InitDebug[data];
            MB.InitLoader[data];
            MB.InitLoadmap[data];
            MB.InitMain[data];
            MB.InitOutput[data];
            MB.InitParse[data];
            MB.InitScript[data];
            MB.InitUtilities[data];
            MB.InitVM[data];
            };
        Finalize: PROC = {
            <<The ordering of the following is significant.>>
            MB.FinishOutput[];
            MB.FinishLoader[];
            <<The ordering of the following is arbitrary.>>
            MB.FinishVM[];
            MB.FinishUtilities[];
            MB.FinishScript[];
            MB.FinishParse[];
            MB.FinishMain[];
            MB.FinishLoadmap[];
            MB.FinishDebug[];
            MB.FinishCache[];
            <<the following must be last>>
            FinishDriver[];
            };
        DoRealWork: PROC RETURNS [outcome: Outcome] = {
            CheckAbort: PROC = {Process.CheckForAbort[]};
            CheckAbort[];
            IF (outcome _ ProcessCmds[]) ~= $normal THEN RETURN;
            MB.OpenLoadmap[];
            MB.InitMemory[];
            CheckAbort[];
            EchoBCDs[];
            MB.EchoInput[];
            CheckAbort[];
            MB.Load[];
            CheckAbort[];
            MB.TurnOffStartTrap[];
            MB.ReportFrameAllocation[];
            IF data.debug THEN {MB.DumpInputBcds[]; MB.DumpFrames[]};
            CheckAbort[];
            IF data.germ THEN MB.WriteGermFile[]
            ELSE {
                MB.MakeScript[];
                CheckAbort[];
                MB.WriteBootFile[];
                };
            CheckAbort[];
            IF data.debug AND ~data.germ THEN {MB.DumpBootHeader[]; MB.DumpStartList[]};
            RETURN[normal]
            };
        WriteHerald[];
        DO  -- until no commands remain
            start: BasicTime.GMT _ BasicTime.Now[];
            nFilePages, nModules, nGFIs, nResidentPages, nBootLoadedPages: CARDINAL;
            outcome _ $abort;
            Initialize[];
            outcome _ DoRealWork[  
                ! UNWIND => Finalize[];
                    MB.Abort, ABORTED => CONTINUE;
                    FS.Error => {
                        IF error.group ~= $user THEN typescript.PutRope["\NUnexpected error from FS: "];
                        typescript.PutF["%g\N", IO.rope[error.explanation]];
                        CONTINUE
                        };
                ];
            SELECT outcome FROM
                $normal => {
                    nFilePages _ data.nFilePages;
                    nModules _ data.nModules;
                    nGFIs _ data.nGFIs;
                    nResidentPages _ data.nResidentPages;
                    nBootLoadedPages _ data.nBootLoadedPages;
                    };
                $abort => {typescript.PutRope["...MakeBoot aborted\N"];  EXIT};
                $noMoreCommands => {outcome _ $normal; EXIT};
                ENDCASE --$warning or $error-- => EXIT;
            Finalize[];
            ReportStats[
                nFilePages: nFilePages, nModules: nModules, nGFIs: nGFIs,
                nResidentPages: nResidentPages, nBootLoadedPages: nBootLoadedPages,
                elapsedTime: BasicTime.Period[from: start, to: BasicTime.Now[]]
                ];
            ENDLOOP;
        Finalize[];
        };

    oldTSPFProcs: IOUtils.PFProcs;

    InitDriver: PROC = {
        tsPFProcs: IOUtils.PFProcs _ IOUtils.CopyPFProcs[typescript];
        [] _ IOUtils.SetPFCodeProc[tsPFProcs, 'y, GermOrBoot];
        oldTSPFProcs _ IOUtils.SetPFProcs[typescript, tsPFProcs];
        data _ NEW[MB.Object _ [
            buildTime: BasicTime.Now[],
            typescript: typescript,
            inputBCDs: NEW[MB.InputBCDs[10] _ [nBcds: 1]]
            ]];
        <<create BObject describing main input Bcd, used by ProcessCmds>>
        data.inputBCDs.bcds[0] _ NEW[MB.BObject _ [
            name: NIL,
            bcd: NIL, pages: 0, bcdSeg: NIL,
            mt: NIL, gfiOffset: 0,
            files: NIL]];
        };

    FinishDriver: PROC = {
        [] _ IOUtils.SetPFProcs[typescript, oldTSPFProcs];
        data _ NIL;  -- drop the whole structure on the floor
        };

    GermOrBoot: IOUtils.PFCodeProc = {
        <<%y: Argument is Boolean >>
        typescript.PutRope[IF data.germ THEN "germ" ELSE "boot"]};

    <<>>
    <<Command Line Parsing and Analysis>>
    <<>>
    ProcessCmds: PROC RETURNS [outcome: Outcome] = {
        args, results: PairList;
        switches, sourceName: ROPE _ NIL;
        BEGIN
        [sourceName, args, results, switches] _ Parse[commandStream ! ParseFailed => GOTO bogus];
        IF sourceName = NIL THEN RETURN[outcome: $noMoreCommands];
        EXITS 
            bogus => {
                typescript.PutRope["! Bad MakeBoot command line\N"];
                RETURN[outcome: $error]
                };
        END;
        IF switches ~= NIL THEN {
            sense: BOOL _ TRUE;
            FOR i: INT IN [0..switches.Length[]) DO
                SELECT switches.Fetch[i] FROM
                    '-, '~ => sense _ ~sense;
                    'd, 'D => {data.debug _ sense; sense _ TRUE};
                    'e, 'E => {data.etherFormat _ sense; sense _ TRUE};
                    'g, 'G => {data.germ _ sense; sense _ TRUE};
                    'h, 'H => {data.hexLoadmap _ sense; sense _ TRUE};
                    '! => DebuggerSwap.CallDebugger["Called from MakeBoot"L];
                    ENDCASE;
                ENDLOOP;
            };
        data.inputBCDs.bcds[0].name _ data.input _ SetExtension[sourceName, "bcd"];
        ProcessResults[results];
        EchoCommand[];
        ProcessArgs[args];
        RETURN[outcome: $normal]
        };

    EchoCommand: PROC = {
        typescript.PutF["Building %y file %g", IO.bool[data.germ], IO.rope[data.output]];
        IF data.etherFormat THEN
            typescript.PutF[" and ether %y file %g\N", IO.bool[data.germ], IO.rope[data.etherOutput]]
        ELSE typescript.PutChar['\N];
        typescript.PutF["Writing load map to %g\N", IO.rope[data.loadmapName]];
        };

    EchoBCDs: PROC = {
        data.loadmap.PutRope["Input BCD"];
        IF data.inputBCDs.nBcds ~= 0 THEN data.loadmap.PutChar['s];
        data.loadmap.PutRope[":\N\N"];
        FOR i: CARDINAL IN [0..data.inputBCDs.nBcds) DO
            ENABLE FS.Error => IF error.group = $user THEN {data.loadmap.PutChar['\N]; CONTINUE};
            data.loadmap.PutF["  %39j  %t\N",
                IO.rope[data.inputBCDs.bcds[i].name],
                IO.time[FS.FileInfo[data.inputBCDs.bcds[i].name].created]
                ];
            ENDLOOP;
        data.loadmap.PutChar['\N];
        };

    ProcessResults: PROC [results: PairList] = {
        DoOnePair: PROC [p: REF ANY, rest: LIST OF REF ANY] = {
            key, value: ROPE;
            [key, value] _ NARROW[p, REF Pair]^;
            SELECT TRUE FROM
                key = NIL => data.output _ value;
                key.Equal["bootFile", FALSE] =>
                    IF data.output = NIL THEN data.output _ value
                    ELSE MB.Error["Duplicate result keyword 'bootFile'"];
                key.Equal["loadMap", FALSE] =>
                    IF data.loadmapName = NIL THEN data.loadmapName _ value
                    ELSE MB.Error["Duplicate result keyword 'loadMap'"];
                ENDCASE => MB.Error["Unrecognized result keyword"];
            };
        data.output _ data.etherOutput _ data.loadmapName _ NIL;
        List.Map[results, DoOnePair];
        IF data.output = NIL THEN data.output _ StripExtension[data.input];
        data.output _ SetExtension[data.output, IF data.germ THEN "germ" ELSE "boot"];
        IF data.etherFormat THEN
            data.etherOutput _
                SetExtension[StripExtension[data.output], IF data.germ THEN "eg" ELSE "pb"];
        IF data.loadmapName = NIL THEN data.loadmapName _ StripExtension[data.output];
        data.loadmapName _ SetExtension[data.loadmapName, "loadmap"];
        };

    SetExtension: PROC [r, ext: ROPE] RETURNS [ROPE] = {
        RETURN[IF r.Find["."] = -1 THEN r.Cat[".", ext] ELSE r]};

    StripExtension: PROC [r: ROPE] RETURNS [ROPE] = {RETURN[r.Substr[len: r.Index[s2: "."]]]};

    ProcessArgs: PROC [args: PairList] = {
        nProcesses, gftLength: CARDINAL _ LAST[CARDINAL];
        RopeToNumber: PROC [r: ROPE] RETURNS [ok: BOOL _ TRUE, v: LONG CARDINAL] = {
            v _ Convert.CardFromRope[r ! Convert.Error => {ok _ FALSE; CONTINUE}];
            };
        DoOnePair: PROC [p: REF ANY, rest: LIST OF REF ANY] = {
            key, value: ROPE;
            [key, value] _ NARROW[p, REF Pair]^;
            SELECT TRUE FROM
                key.Equal["parm", FALSE] => {
                    parmFile: ROPE = SetExtension[value, "bootmesa"];
                    typescript.PutF["Processing parameter file %g", IO.rope[parmFile]];
                    MB.ProcessInput[parmFile];
                    typescript.PutChar[Ascii.CR];
                    };
                key.Equal["bcd", FALSE] => {
                    IF data.inputBCDs.nBcds = LAST[MB.BCount] - 1 --save slot for NullConfig-- THEN
                        MB.Error["Too many input BCDs"];
                    IF data.inputBCDs.nBcds = data.inputBCDs.length THEN {
                        newLength: MB.BCount = MIN[2*data.inputBCDs.length, LAST[MB.BCount]];
                        newInputBCDs: REF MB.InputBCDs _
                            NEW[MB.InputBCDs[newLength] _ [nBcds: data.inputBCDs.nBcds]];
                        FOR i: CARDINAL IN [0..data.inputBCDs.nBcds) DO
                            newInputBCDs.bcds[i] _ data.inputBCDs.bcds[i];
                            ENDLOOP;
                        data.inputBCDs _ newInputBCDs;
                        };
                    data.inputBCDs.bcds[data.inputBCDs.nBcds] _ NEW[MB.BObject _ [
                        name: SetExtension[value, "bcd"],
                        bcd: NIL, pages: 0, bcdSeg: NIL,
                        mt: NIL, gfiOffset: 0,
                        files: NIL]];
                    data.inputBCDs.nBcds _ data.inputBCDs.nBcds+1;
                    };
                key.Equal["nProcesses", FALSE] => {
                    ok: BOOL;
                    [ok, nProcesses] _ RopeToNumber[value];
                    IF ~ok OR ~(nProcesses-1 IN PrincOps.PsbIndex) THEN MB.Error["Invalid nProcesses"];
                    };
                key.Equal["gftLength", FALSE] => {
                    ok: BOOL;
                    [ok, gftLength] _ RopeToNumber[value];
                    IF ~ok OR ~(gftLength-1 IN PrincOps.GFTIndex) THEN MB.Error["Invalid gftLength"];
                    };
                ENDCASE => MB.Error["Unrecognized parameter keyword"];
            };
        List.Map[args, DoOnePair];
        IF nProcesses ~= LAST[CARDINAL] THEN {
            data.nProcesses _ nProcesses;
            typescript.PutF["Number of processes set to %d\N", IO.card[nProcesses]];
            };
        IF gftLength ~= LAST[CARDINAL] THEN { 
            data.gftLength _ gftLength;
            typescript.PutF["GFT length set to %d\N", IO.card[gftLength]];
            };
        };

    <<Command Line Parser>>

    PairList: TYPE = LIST OF REF --Pair-- ANY;
    Pair: TYPE = RECORD [key, value: ROPE];

    ParserState: TYPE = [0..17];
        <<0:>>
        <<1:    id>>
        <<2:    id _>>
        <<3:    [ ?{ARG},>>
        <<4:    [ ?{ARG}, id>>
        <<5:    [ ?{ARG}, id :>>
        <<6:    [ ?{ARG}, id : id>>
        <<7:    [ ?{ARG}, ]>>
        <<8:    [ ?{ARG}, ] _>>
        <<9:    LHS _ id>>
        <<10:    ?(LHS _) id [ ?{ARG},>>
        <<11:    ?(LHS _) id [ ?{ARG}, id>>
        <<12:    ?(LHS _) id [ ?{ARG}, id :>>
        <<13:    ?(LHS _) id [ ?{ARG}, id : id>>
        <<14:    ?(LHS _) id RHS>>
        <<15:    ?(LHS _) id ?RHS />>
        <<16:    ?(?(LHS _) id ?RHS) / id>>
        <<17:    ?(?(LHS _) id ?RHS) ?(/ ?id) (;|eom)  |  eom>>
        <<where LHS = id | [ ?{ARG}, ]>>
        <<RHS = [ ?{ARG}, ]  >>
        <<ARG = id : id  |  id (if allowNoTagParm)>>

    ParseFailed: ERROR = CODE;

    dontAdvance: BOOL _ FALSE;
    token: ROPE _ NIL;

    Parse: PROC [cmd: IO.STREAM, allowNoTagParm: BOOL _ FALSE]
        RETURNS [operator: ROPE _ NIL, argList, resultList: PairList _ NIL, switches: ROPE _ NIL] = {
        state: ParserState _ 0;
        pair0, pair1: ROPE _ NIL;

        DontAdvance: PROC = INLINE {dontAdvance _ TRUE};

        NextToken: IO.BreakProc = {
            SELECT char FROM
                Ascii.SP, Ascii.CR, Ascii.TAB => RETURN[sepr];
                IN ['a..'z], IN ['A..'Z], IN ['0..'9], '<, '>, '., '+, '-, '~, '!, '$ => RETURN[other];
                ';, '_, '[, ',, '], ':, '/ => RETURN[break];
                ENDCASE;
            ERROR ParseFailed;
            };

        PushArg: PROC = INLINE {
            argList _ CONS[NEW[Pair _ [key: pair0, value: pair1]], argList]};

        PushResult: PROC = INLINE {
            resultList _ CONS[NEW[Pair _ [key: pair0, value: pair1]], resultList]};

        UNTIL state = LAST[ParserState] DO
            IF dontAdvance THEN dontAdvance _ FALSE
            ELSE
                token _ cmd.GetTokenRope[NextToken
                    ! IO.EndOfStream => {token _ NIL; CONTINUE}].token;
            IF token = NIL THEN  -- end of command stream
                SELECT state FROM
                    0, 1, 9, 14, 15, 16 => state _ 17;
                    ENDCASE => ERROR ParseFailed
            ELSE
                SELECT Rope.Fetch[token] FROM
                    '_ =>
                        SELECT state FROM
                            1 => {
                                pair0 _ NIL; pair1 _ operator; operator _ NIL;
                                PushResult[]; state _ 2};
                            7 => state _ 8;
                            ENDCASE => ERROR ParseFailed;
                    '[ =>
                        SELECT state FROM
                            0 => state _ 3;
                            1, 9 => state _ 10;
                            14 => {DontAdvance[]; state _ 17};
                            ENDCASE => ERROR ParseFailed;
                    '] =>
                        SELECT state FROM
                            3, 6 => state _ 7;
                            4 => IF allowNoTagParm THEN {
                                pair1 _ pair0; pair0 _ NIL;
                                PushArg[]; state _ 7}
                                ELSE ERROR ParseFailed;
                            10, 13 => state _ 14;
                            11 => IF allowNoTagParm THEN {
                                pair1 _ pair0; pair0 _ NIL;
                                PushArg[];  state _ 14}
                                ELSE ERROR ParseFailed;
                            ENDCASE => ERROR ParseFailed;
                    ': =>
                        SELECT state FROM
                            4 => state _ 5;
                            11 => state _ 12;
                            ENDCASE => ERROR ParseFailed;
                    ', =>
                        SELECT state FROM
                            4 => IF allowNoTagParm THEN {
                                pair1 _ pair0; pair0 _ NIL;
                                PushArg[]; state _ 3}
                                ELSE ERROR ParseFailed;
                            6 => state _ 3;
                            11 => IF allowNoTagParm THEN {
                                pair1 _ pair0; pair0 _ NIL;
                                PushArg[]; state _ 10}
                                ELSE ERROR ParseFailed;
                            13 => state _ 10;
                            ENDCASE => ERROR ParseFailed;
                    '/ =>
                        SELECT state FROM
                            0, 1, 9, 14 => state _ 15;
                            ENDCASE => ERROR ParseFailed;
                    '; =>
                        SELECT state FROM
                            1, 9, 14, 15, 16 => state _ 17;
                            ENDCASE => ERROR ParseFailed;
                    ENDCASE => -- id--
                        SELECT state FROM
                            0 =>    {operator _ token; state _ 1};
                            2, 8 => {operator _ token; state _ 9};
                            3 =>    {pair0 _ token; state _ 4};
                            5 =>    {pair1 _ token; PushResult[]; state _ 6};
                            10 =>   {pair0 _ token; state _ 11};
                            12 =>   {pair1 _ token; PushArg[]; state _ 13};
                            15 =>   {switches _ token; state _ 16};
                            1, 9, 14, 16 => {DontAdvance[]; state _ 17};
                            ENDCASE => ERROR ParseFailed;
            ENDLOOP;
        resultList _ List.Reverse[resultList];
        argList _ List.Reverse[argList];
        };

    <<>>
    <<Miscellaneous Exported Utilities>>

    Abort: PUBLIC SIGNAL = CODE;

    Error:  PUBLIC PROC [msg: Rope.ROPE] = {
        typescript.PutF["\NError: %g\N", IO.rope[msg]];
        SIGNAL MB.Abort;
        };

    MakeBootVersion: PUBLIC PROC RETURNS [r: ROPE] = {
        r _ IO.PutFR["Cedar MakeBoot of %t", IO.time[Loader.BCDBuildTime[MakeBootVersion]]];
        };    

    <<Initialization>>
    <<>>
    Commander.Register[key: "MakeBoot", proc: RunFromCommander, doc: NIL]

    END.