<<>>
    <<Dependencies.mesa>>
        <<Copyright Ó 1985, 1987, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) March 12, 1987 10:54:55 am PST>>
        <<Bill Jackson (bj) October 29, 1988 4:19:42 pm PDT>>
        <<Willie-Sue, October 6, 1989 10:13:54 pm PDT>>
        <<Willie-s, January 23, 1992 2:15 pm PST>>

        DIRECTORY
            BasicTime USING [ GMT, Now, nullGMT, Unpack ],
            MobDefs USING [ Base, MobBase, FTHandle, FTIndex, FTNull, FTRecord, NameRecord, NameString, VersionStamp ],
            Commander USING [ CommandProc, Register ],
            CommanderOps USING [ ArgumentVector, Failed, Parse ],
            Convert USING [RopeFromInt],
            DFUtilities USING [ Date ],
            FileNames USING [ GetShortName, StripVersionNumber ],
            GenerateDFClosure USING [ ActionProc, GenerateClosureToProc ],
            IO,
            List USING [ Compare, CompareProc, Sort ],
            MobMapper USING [AlterMob, AlterMobResults, BadMobContents],
            MessagesOut USING [ PutRopes ],
            PFS USING [ Close, Error, GetInfo, Open, OpenFile, PathFromRope, Read ],
            Process USING [ CheckForAbort, Pause, SecondsToTicks ],
            Prop USING [ PropList, Put ],
            RedBlackTree USING [ Compare, Create, EachNode, EnumerateIncreasing, GetKey, Insert, Lookup, Table ],
            Rope USING [ ActionType, Compare, Concat, Fetch, Flatten, FromProc, Length, Map, Match, ROPE, Substr ],
            TiogaAccess USING [ Create, Put, TiogaChar, WriteFile, Writer ],
            UserProfile USING [ Token ],
            VM USING [ AddressForPageNumber, Free, Interval, PagesForBytes, SimpleAllocate ];

    Dependencies: CEDAR MONITOR
        IMPORTS BasicTime, Commander, CommanderOps, Convert, FileNames, GenerateDFClosure, IO, List, MobMapper, MessagesOut, PFS, Process, 
        Prop, RedBlackTree, Rope, TiogaAccess, UserProfile, VM = BEGIN
            GMT: TYPE = BasicTime.GMT;
            ROPE: TYPE = Rope.ROPE;
            Switches: TYPE ~ PACKED ARRAY CHAR['a..'z] OF BOOL;

            tempfile: ROPE Ź "///Temp/Dependencies.temp$";

            triesForServerGlitch: NAT Ź 8;
                <<# of times to retry a server glitch>>
            pauseForServerGlitch: NAT Ź 15;
                <<# of seconds to pause for a server glitch>>
            forkers: NAT Ź 1;
                <<# of processes to fork for help>>

            suspectFrom: ROPE Ź NIL;
            suspectTo: ROPE Ź NIL;
            SuspectSeen: SIGNAL = CODE;

            BaseEntry: TYPE = REF BaseEntryRep;
            BaseEntryList: TYPE = LIST OF BaseEntry;
            BaseEntryRep: TYPE = RECORD [
                name: ROPE,
                from: ROPE Ź NIL,
                version: VersionStamp,
                dependents: BaseEntryList Ź NIL,
                next: BaseEntry Ź NIL
                ];

            ObjectStyle: TYPE ~ { bcd, mob };
            VersionStamp: TYPE ~ RECORD [ 
                SELECT style: ObjectStyle FROM
                    mob => [ mob: MobDefs.VersionStamp ]
                    ENDCASE
                ];

        DumpOutput: PROC [ outName: ROPE, table: RedBlackTree.Table, switches: Switches ] ~ {
            <<First Char:>>
                <<[charSet: 0, char: '\n, looks: LOOKS[], format: NIL, comment: FALSE, endOfNode: TRUE, deltaLevel: 1, propList: LIST[^[key: 
                $FromTiogaFile, val: $Yes]]]>>
            <<Comment Char:>>
                <<[charSet: 0, char: 'F, looks: LOOKS[], format: $code, comment: TRUE, endOfNode: FALSE, deltaLevel: 0, propList: NIL]>>
            <<Normal Char:>>
                <<[charSet: 0, char: 'F, looks: LOOKS[], format: $code, comment: FALSE, endOfNode: FALSE, deltaLevel: 0, propList: NIL]>>
            <<Comment end of node (next node nested):>>
                <<[charSet: 0, char: '\n, looks: LOOKS[], format: $code, comment: TRUE, endOfNode: TRUE, deltaLevel: 1, propList: NIL]>>
            tc: TiogaAccess.TiogaChar Ź [charSet: 0, char: '\n, looks: ALL[FALSE], format: NIL, comment: FALSE, endOfNode: TRUE, deltaLevel: 1,
            propList: Prop.Put[propList: NIL, key: $NewlineDelimiter, val: Rope.Flatten["\n"]] ];
            PutCharB: Rope.ActionType = { tc.char Ź c; TiogaAccess.Put[writer, tc] };
            PutRope: PROC [ rope: ROPE ] = { [] Ź rope.Map[action: PutCharB] };
            PutRopeBold: PROC [ rope: ROPE ] = {
                tc.looks['b] Ź TRUE;
                [] Ź rope.Map[action: PutCharB];
                tc.looks['b] Ź FALSE;
                };
            PutRopeItalic: PROC [ rope: ROPE ] = {
                tc.looks['i] Ź TRUE;
                [] Ź rope.Map[action: PutCharB];
                tc.looks['i] Ź FALSE;
                };
            EndNode: PROC [ delta: INTEGER Ź 0, format: ATOM Ź NIL ] = {
                tc.char Ź '\n;
                tc.format Ź format;
                tc.deltaLevel Ź delta;
                tc.endOfNode Ź TRUE;
                TiogaAccess.Put[writer, tc];
                tc.endOfNode Ź FALSE;
                };
            EachNode: RedBlackTree.EachNode = {
                WITH data SELECT FROM
                    base: BaseEntry => {
                        WHILE ( base # NIL ) DO
                            dependents: BaseEntryList Ź base.dependents Ź SortDependents[base.dependents];
                            SELECT TRUE FROM
                                ( ( dependents = NIL ) AND ( NOT switches['u] ) ) => { NULL };
                                ( ( base.from = NIL ) AND ( NOT switches['v] ) ) => { NULL };
                                ENDCASE => {
                                    tc.format Ź $block;
                                    PutRopeBold[base.name];
                                    SELECT base.version.style FROM
                                        mob => { IF ( switches['m] ) THEN PutRope["[mob]"] };
                                        ENDCASE => { NULL }; -- ???
                                    PutRope[": "];
                                    PutRopeItalic["("];
                                    PutRopeItalic[IF ( base.from = NIL ) THEN "??" ELSE base.from];
                                    PutRopeItalic[")"];
                                    IF ( dependents = NIL )
                                        THEN { EndNode[0, $block] }
                                        ELSE {
                                            EndNode[1, $block];
                                            tc.format Ź $ragged;
                                            WHILE ( dependents # NIL ) DO
                                                PutRope[dependents.first.name];
                                                PutRope[" "];
                                                dependents Ź dependents.rest;
                                                ENDLOOP;
                                            EndNode[-1, $ragged];
                                            };
                                    };
                            IF ( suspectTo.Match[base.name, FALSE] ) THEN SIGNAL SuspectSeen;
                            base Ź base.next;
                            ENDLOOP;
                        };
                    ENDCASE => { NULL };
                };
            writer: TiogaAccess.Writer Ź TiogaAccess.Create[];
            tyme: BasicTime.GMT = BasicTime.Now[];
            TiogaAccess.Put[writer, tc];
            tc.propList Ź NIL;
            tc.comment Ź TRUE;
            tc.endOfNode Ź FALSE;
            PutRope[outName];
            EndNode[1];
            PutRope[ IO.PutFR1["Copyright Ó %g by Xerox Corporation.  All rights reserved.",
            [rope[Convert.RopeFromInt[BasicTime.Unpack[tyme].year]]] ] ];
            EndNode[];
            PutRope[IO.PutFR1["Written %g", [time[tyme]] ]];
            EndNode[-1];
            EndNode[];

            tc.comment Ź FALSE;
            RedBlackTree.EnumerateIncreasing[table, EachNode];
            TiogaAccess.WriteFile[writer, outName];
            };

        MyData: TYPE = REF MyDataRep;
        MyDataRep: TYPE = RECORD [
            table: RedBlackTree.Table Ź NIL,
            abortRequested: BOOL Ź FALSE,
            fsCareful: BOOL Ź TRUE,
            errs: IO.STREAM Ź NIL
            ];

        EnsureProc: TYPE ~ PROC [objectName: ROPE, version: VersionStamp];
        DependencyProc: TYPE ~ PROC [fromObject: ROPE, version: VersionStamp,
        toName: ROPE, toVersion: VersionStamp];

        EachFile: GenerateDFClosure.ActionProc = {
            myData: MyData Ź CheckAbort[data];
            table: RedBlackTree.Table Ź myData.table;
            EnterDependency: ENTRY DependencyProc = {
                <<From file depends on the to file; version stamps are present to remove name ambiguity.>>
                ENABLE UNWIND => { NULL };
                baseFrom: BaseEntry Ź GetBaseRecord[table, fromObject, version];
                baseTo: BaseEntry Ź GetBaseRecord[table, toName, toVersion];
                baseTo.dependents Ź CONS[baseFrom, baseTo.dependents];
                baseFrom.from Ź FileNames.StripVersionNumber[from];
                IF ( suspectFrom.Match[fromObject, FALSE] ) THEN SIGNAL SuspectSeen;
                IF ( suspectTo.Match[toName, FALSE] ) THEN SIGNAL SuspectSeen;
                };
            EnsureFrom: ENTRY EnsureProc = {
                ENABLE UNWIND => { NULL };
                base: BaseEntry Ź GetBaseRecord[table, objectName, version];
                IF ( base.from = NIL ) THEN base.from Ź FileNames.StripVersionNumber[from];
                };
            ProcessObjectFile: PROC [ kind: ObjectStyle, shortName: ROPE, triesLeft: NAT ] ~ {
                <<context/continuation includes [name, from: ROPE, date: DFUtilities.Date]
                and [myData: MyData]>>
                shortName Ź shortName.Flatten[len: ( shortName.Length[] - 4 )];
                DO
                    ENABLE
                        PFS.Error => {
                            SELECT error.code FROM
                                $serverInaccessible => {
                                    MessagesOut.PutRopes[myData.errs, "Server glitch: ", name];
                                    Process.Pause[Process.SecondsToTicks[pauseForServerGlitch]];
                                    IF ( (triesLeft Ź triesLeft.PRED) # 0 ) THEN LOOP;
                                    };
                                ENDCASE;
                            MessagesOut.PutRopes[myData.errs, "File not found: ", name,
                                IO.PutFR["\n  from: %g\n  reason: %g\n",
                                IO.rope[from], IO.rope[error.explanation] ]
                                ];
                            IF ( error.group # bug ) THEN EXIT ELSE REJECT;
                            };
                    <<Process this file for dependencies>>
                    file: PFS.OpenFile;
                    file Ź PFS.Open[name: PFS.PathFromRope[name],
                    wantedUniqueID: [egmt: [gmt: date.gmt, usecs: 0]] ];
                <<Ok, now we've got the bits in "file"; lets process the contents>>

                    {
                        bytes: INT ~ file.GetInfo[].bytes;
                        interval: VM.Interval ~ VM.SimpleAllocate[VM.PagesForBytes[bytes]];
                        p: LONG POINTER ~ VM.AddressForPageNumber[interval.page];
                        TRUSTED { [] Ź file.Read[filePosition: 0, nBytes: bytes, to: p] };
                        SELECT kind FROM
                            mob => TRUSTED {
                                mob: MobDefs.MobBase ~ LOOPHOLE[p];
                                limit: CARD ~ bytes / BYTES[UNIT];
                                mobRes: MobMapper.AlterMobResults Ź noop;
                                mobRes Ź MobMapper.AlterMob[mob, LOOPHOLE[mob], limit ! MobMapper.BadMobContents => { mobRes Ź badVersion; CONTINUE} ];
                                IF mobRes = badVersion THEN 
                                    MessagesOut.PutRopes[myData.errs, "MobMapper.AlterMob failed for ", name]
                                    ELSE MobCase[shortName, mob, EnsureFrom, EnterDependency];
                                };
                            ENDCASE => { NULL };
                        TRUSTED { VM.Free[interval] };
                        file.Close[];
                        };

                    EXIT;
                    ENDLOOP;
                };

            SELECT kind FROM
                file => {
                    triesLeft: NAT Ź triesForServerGlitch;
                    shortName: ROPE Ź FileNames.GetShortName[name];
                    SELECT TRUE FROM
                        Rope.Match["*.mob", shortName, FALSE] => {
                            ProcessObjectFile[mob, shortName, triesLeft];
                            };
                        ENDCASE => { NULL };
                    };
                ENDCASE;
            };
    <<Mob Specific code>>
        CharSeq: TYPE = RECORD [ PACKED SEQUENCE COMPUTED CARD16 OF CHAR ];

        RopeForNameRecord: PROC [ mob: MobDefs.MobBase, n: MobDefs.NameRecord ]
        RETURNS [ rope: ROPE ] = TRUSTED {
            ssb: MobDefs.NameString ~ LOOPHOLE[mob + mob.ssOffset.units];
            index: CARD16 ~ n+4;
            ss: LONG POINTER TO CharSeq ~ LOOPHOLE[ssb];
            len: CARD16 ~ ss[index]-0C;
            i: INT Ź index.SUCC;
            GetFromNameString: SAFE PROC RETURNS [ char: CHAR ] =
            TRUSTED { char Ź ss[i]; i Ź i + 1 };
            rope Ź Rope.FromProc[len, GetFromNameString];
            IF ( ( len > 0 ) AND ( rope.Fetch[len.PRED] = '. ) )
            THEN rope Ź rope.Substr[len: len.PRED]; -- ???
            };

        MobCase: PROC [ shortName: ROPE, mob: MobDefs.MobBase, ensureFrom: EnsureProc, enterDependency: DependencyProc ] ~ TRUSTED {
            DoOneFile: PROC [ fth: MobDefs.FTHandle, fti: MobDefs.FTIndex ]
            RETURNS [ BOOL Ź FALSE ] = TRUSTED {
                <<context/continuation includes [shortName: ROPE, file: FS.OpenFile, mob: MobDefs.MobBase]>>
                file: ROPE Ź RopeForNameRecord[mob, fth.name];
                enterDependency[shortName, [mob[mob.version]], file, [mob[fth.version]]];
                };
            IF ( mob.nConfigs = 0 ) THEN [] Ź ProcessFiles[mob, DoOneFile];
            ensureFrom[shortName, [mob[mob.version]]];
            };

        ProcessFiles: PROC [ mob: MobDefs.MobBase, proc: PROC [MobDefs.FTHandle, MobDefs.FTIndex] RETURNS [BOOL] ] RETURNS [ fth: 
        MobDefs.FTHandle, fti: MobDefs.FTIndex ] = TRUSTED {
            ftb: MobDefs.Base = LOOPHOLE[mob + mob.ftOffset.units];
            FOR fti Ź FIRST[MobDefs.FTIndex], fti + SIZE[MobDefs.FTRecord]
            UNTIL ( fti = mob.ftLimit ) DO
                fth Ź @ftb[fti];
                IF ( proc[fth, fti] ) THEN RETURN;
                ENDLOOP;
            RETURN[NIL, MobDefs.FTNull];
            };
    <<RedBlackTree for BaseEntry (plus List-buckets)>>
        GetBaseRecord: INTERNAL PROC [ table: RedBlackTree.Table, file: ROPE, version: VersionStamp ] RETURNS [ base: BaseEntry ] = {
            old: BaseEntry Ź NIL;
            WITH table.Lookup[file] SELECT FROM
                be: BaseEntry => WHILE ( be # NIL ) DO
                    IF ( SameVersion[be.version, version] ) THEN { base Ź be; RETURN };
                    old Ź be; be Ź be.next;
                    ENDLOOP;
                ENDCASE;
            base Ź NEW[BaseEntryRep Ź [name: file, version: version]];
            IF ( old # NIL ) THEN old.next Ź base ELSE table.Insert[base, file];
            };

        SameVersion: PROC [ first: VersionStamp, second: VersionStamp ]
        RETURNS [ yup: BOOL Ź FALSE ] ~ {
            IF ( first.style # second.style ) THEN RETURN;
            WITH first SELECT FROM
                left: mob VersionStamp => {
                    WITH second SELECT FROM
                        right: mob VersionStamp => { IF ( left # right ) THEN RETURN };
                        ENDCASE => { ERROR };
                    };
                ENDCASE => { ERROR };
            yup Ź TRUE;
            };

        GetKey: RedBlackTree.GetKey = { RETURN [data] };
        Compare: RedBlackTree.Compare = {
            key: ROPE Ź WITH k SELECT FROM
                base: BaseEntry => base.name,
                rope: ROPE => rope,
                ENDCASE => ERROR;
            WITH data SELECT FROM
                base: BaseEntry => { RETURN [key.Compare[base.name, FALSE]] };
                ENDCASE => { ERROR };
            };

        CompareEntries: List.CompareProc = {
            WITH ref1 SELECT FROM
                base1: BaseEntry => {
                    WITH ref2 SELECT FROM
                        base2: BaseEntry => { RETURN [base1.name.Compare[base2.name, FALSE]] };
                        ENDCASE => { ERROR };
                    };
                ENDCASE => { ERROR };
            };

        SortDependents: PROC [list: BaseEntryList] RETURNS [BaseEntryList] = TRUSTED {
            <<We can use List.Sort because BaseEntryList is a list of REFs, and List.Sort only plays with the rest fields, not the first fields.>>
            RETURN [LOOPHOLE[List.Sort[LOOPHOLE[list], CompareEntries]]];
            };
    <<Utilities>>
        CheckAbort: PROC [ref: REF] RETURNS [MyData] = {
            WITH ref SELECT FROM
                mine: MyData => {
                    SELECT TRUE FROM
                        mine.abortRequested => { NULL };
                        ENDCASE => RETURN [mine];
                    };
                ENDCASE => { NULL };
            ERROR ABORTED;
            };

        DependenciesCommandProc: Commander.CommandProc = {
            out: IO.STREAM = cmd.out;
            switches: Switches Ź ALL[FALSE];
            ProcessSwitches: PROC [arg: ROPE] = {
                sense: BOOL Ź TRUE;
                FOR index: INT IN [0..arg.Length[]) DO
                    char: CHAR Ź arg.Fetch[index];
                    SELECT char FROM
                        '- => { LOOP };
                        '~ => { sense Ź NOT sense; LOOP };
                        IN ['a..'z] => switches[char] Ź sense;
                        IN ['A..'Z] => switches[char + ('a-'A)] Ź sense;
                        ENDCASE;
                    sense Ź TRUE;
                    ENDLOOP;
                };
            ProcessArgument: PROC [arg: ROPE] = {
                table: RedBlackTree.Table Ź RedBlackTree.Create[getKey: GetKey, compare: Compare];
                myData: MyData Ź NEW[MyDataRep Ź [table: table, fsCareful: NOT switches['f], errs: out]];
                dfName: ROPE Ź arg.Concat[".df"];
                outName: ROPE Ź arg.Concat[".depends"];
                Process.CheckForAbort[];

                IO.PutF1[out, "Generating dependencies for %g\n", IO.rope[dfName] ];
                IO.PutF1[out, "  %g\n", IO.time[] ];

                [] Ź GenerateDFClosure.GenerateClosureToProc[dfName, out, EachFile, myData,
                [toFork: forkers, followImports: NOT switches['s] ]
                ! ABORTED, UNWIND => { myData.abortRequested Ź TRUE } ];
                <<Now that we have our data structure, print it.>>
                IO.PutF1[out, "\nWriting dependencies to %g", IO.rope[outName] ];
                DumpOutput[outName, table, switches];
                IO.PutF1[out, ".\n\n%g\n", IO.time[] ];
                };

            argsProcessed: NAT Ź 0;
            argv: CommanderOps.ArgumentVector Ź CommanderOps.Parse[cmd: cmd
            ! CommanderOps.Failed => { msg Ź errorMsg; GO TO failed } ];
            ProcessSwitches[UserProfile.Token["Dependencies.DefaultSwitches"]];
            FOR i: NAT IN [1..argv.argc) DO
                arg: ROPE ~ argv[i];
                Process.CheckForAbort[];
                IF ( arg.Length[] = 0 ) THEN LOOP;
                IF ( arg.Fetch[0] = '- ) THEN { ProcessSwitches[arg]; LOOP };
                ProcessArgument[arg];
                ENDLOOP;
            EXITS
                failed => { result Ź $Failure };
            };

        doc: ROPE = "{switch | item}*\nGenerates object file dependency list
            -m: mobs (qualify entries with [MOB])
            -s: shallow (don't follow imports)
            -u: show NIL dependents
            -v: show files not from DF files
            -f: use fs caching when reading files";

        Commander.Register["Dependencies", DependenciesCommandProc, doc];
        END.