
<<PFSClassImpl.mesa>>
    <<Copyright Ó 1989 by Xerox Corporation.  All rights reserved.>>
    <<Carl Hauser, June 7, 1989 10:26:27 am PDT>>
    <<Chauser, June 21, 1990 10:48 am PDT>>
<<>>
<<>>
    DIRECTORY
        Atom,
        BasicTime USING[GetClockPulses, Pulses, PulsesToMicroseconds],
        Booting,
        PFSClass,
        Process,
        Rope USING [Concat, EqualSubstrs, Length, ROPE, Substr],
        SymTab
        ;

    PFSClassImpl: CEDAR MONITOR
        IMPORTS SymTab, Booting, BasicTime, Rope, Atom, Process
        EXPORTS PFSClass
        ~ {
        OPEN PFSClass;
    <<Constants>>
        viewUnix: PUBLIC ATOM _ $viewUnix;
        viewCedar: PUBLIC ATOM _ $viewCedar;
    <<Copied Types>>
        ROPE: TYPE ~ Rope.ROPE;
        Pulses: TYPE ~ BasicTime.Pulses;

    <<Parameters>>
        secsBetweenSweeps: INT _ 6;
        downFSTTL: CARD _ 60; -- seconds
        waitForFSTimeout: INT _ 60; -- seconds
    <<Time Intervals Using Pulses>>
        NowPulses: PROC RETURNS [Pulses] ~ --INLINE-- { RETURN[BasicTime.GetClockPulses[]] };

        PeriodPulses: PROC [from, to: Pulses] RETURNS [delta: CARD] ~ INLINE {
            delta _ to - from;
            IF LOOPHOLE[delta, INT] < 0 THEN delta _ 0;
            };

        PulsesToSeconds: PROC [pulses: Pulses] RETURNS [seconds: INT] ~ {
            t1: CARD _ BasicTime.PulsesToMicroseconds[pulses];
            t2: CARD _ t1 + 500000;
        t2 _ MAX[t1, t2];
        RETURN [t2 / 1000000]; -- no bounds fault
        };
    <<Registration>>
        Registration: TYPE ~ REF RegistrationObject;
        RegistrationObject: TYPE ~ RECORD [
            next: Registration,
            flavor: ATOM,
            nameSuffix: ROPE,
            getHandle: GetHandleProc
            ];

        registrations: Registration _ NIL;

        Register: PUBLIC ENTRY PROC [flavor: ATOM, getHandle: GetHandleProc] ~ {
            <<no ENABLE UNWIND>>
            p, prev: Registration;
            nameSuffix: ROPE _ Rope.Concat["-", Atom.GetPName[flavor]];
            FOR p _ registrations, p.next WHILE p # NIL DO
                IF p.flavor = flavor THEN {
                    IF prev = NIL THEN registrations _ p.next ELSE prev.next _ p.next;
                    EXIT;
                    };
                prev _ p;
                ENDLOOP;
            IF getHandle # NIL
                THEN registrations _ NEW[RegistrationObject _ [registrations, flavor, nameSuffix, getHandle]];
            };

    <<Server Handle Cache>>
        fsTab: SymTab.Ref _ SymTab.Create[case~FALSE];

        lastSweepTimePulses: Pulses _ NowPulses[];
        readyToSweep: CONDITION;

        Daemon: PROC ~ {
            seconds: INT _ 0;
            CallSweep: SymTab.EachPairAction -- [key, val] RETURNS [quit] -- ~ {
                h: FSHandle ~ NARROW[val];
                h.maintenanceProcs.sweep[h, CARD[seconds]];
                RETURN [FALSE];
                };
            WaitReadyToSweep: ENTRY PROC ~ INLINE {
                ENABLE UNWIND => NULL;
                DO
                    thisSweepTimePulses: Pulses ~ NowPulses[];
                    delta: Pulses _ PeriodPulses[from~lastSweepTimePulses, to~thisSweepTimePulses];
                    seconds _ PulsesToSeconds[delta];
                    IF seconds >= secsBetweenSweeps THEN {
                        lastSweepTimePulses _ thisSweepTimePulses;
                        EXIT;
                        };
                    WAIT readyToSweep;
                    ENDLOOP;
                };

            TRUSTED {
                Process.EnableAborts[@readyToSweep];
                Process.SetTimeout[@readyToSweep, Process.MsecToTicks[INT[1000]*secsBetweenSweeps]];
                };
            DO
                WaitReadyToSweep[];
                [] _ SymTab.Pairs[fsTab, CallSweep];
                ENDLOOP;
            };

        Rollback: ENTRY Booting.RollbackProc ~ {
            ENABLE UNWIND => NULL;
            SymTab.Erase[fsTab];
            lastSweepTimePulses _ NowPulses[];
            };
    <<Finding a server (exported to RemoteFile)>>
        GetFSResponse: TYPE ~ REF GetFSResponseObject;
        GetFSResponseObject: TYPE ~ RECORD [
            nRunning: CARDINAL _ 0,
            wakeup: CONDITION,
            handle: FSHandle _ NIL,
            downMsg: ROPE _ NIL
            ];

        GetFS: PUBLIC PROC [fs: ROPE] RETURNS [h: FSHandle] ~ {
            <<Raises Error if server is down.>>
            obsolete: BOOL;
            downMsg: ROPE;
            fsWithoutSuffix: ROPE;
            kids: LIST OF PROCESS _ NIL;
            response: GetFSResponse;
            theRegistration: Registration;
            startedPulses: Pulses;

            MakeChild: ENTRY PROC [r: Registration] RETURNS [p: PROCESS] ~ --INLINE-- {
                ENABLE UNWIND => NULL;
                p _ FORK DoGetFS[r, fs, FALSE, response];
                response.nRunning _ response.nRunning + 1;
                };

            WaitForResponse: ENTRY PROC ~ --INLINE-- {
                ENABLE UNWIND => NULL;
                <<set [h, downMsg] ...>>
                WHILE (response.nRunning > 0) AND (response.handle = NIL) AND (response.downMsg = NIL) DO
                    sinceStarted: INT ~ PulsesToSeconds[PeriodPulses[from~startedPulses, to~NowPulses[]]];
                IF sinceStarted >= waitForFSTimeout THEN EXIT;
                    TRUSTED { Process.SetTimeout[@response.wakeup, Process.MsecToTicks[1000*(waitForFSTimeout-sinceStarted)+500]] };
                    WAIT response.wakeup;
                    ENDLOOP;
                h _ response.handle;
                downMsg _ response.downMsg;
                };

            h _ NARROW[SymTab.Fetch[fsTab, fs].val];
            IF h # NIL THEN {
                [obsolete, downMsg] _ h.maintenanceProcs.validate[h];
                IF NOT obsolete THEN {
                    IF downMsg # NIL THEN ErrorDownFS[h, downMsg];
                    RETURN;
                    };
                };

            response _ NEW [GetFSResponseObject];
            FOR theRegistration _ registrations, theRegistration.next WHILE theRegistration # NIL DO
                suffixLen, pos: INT;
                suffixLen _ Rope.Length[theRegistration.nameSuffix];
                pos _ Rope.Length[fs] - suffixLen;
                IF (pos >= 0) AND Rope.EqualSubstrs[fs, pos, suffixLen, theRegistration.nameSuffix, 0, suffixLen, FALSE]
                    THEN { fsWithoutSuffix _ Rope.Substr[fs, 0, pos]; EXIT };
                ENDLOOP;
            IF theRegistration # NIL
                THEN {
                    DoGetFS[theRegistration, fsWithoutSuffix, TRUE, response];
                    IF (h _ response.handle) # NIL THEN h.name _ fs;
                    downMsg _ response.downMsg;
                    }
                ELSE {
                    startedPulses _ NowPulses[];
                    TRUSTED { Process.EnableAborts[@response.wakeup] };
                    FOR each: Registration _ registrations, each.next WHILE each # NIL DO
                    kids _ CONS [MakeChild[each], kids];
                    ENDLOOP;
                    WaitForResponse[];
                    FOR kid: LIST OF PROCESS _ kids, kid.rest WHILE kid # NIL DO
                        TRUSTED { Process.Abort[kid.first] };
                        TRUSTED { Process.Detach[kid.first] };
                        ENDLOOP;
                    };
            IF h = NIL THEN {
                IF downMsg = NIL
                    THEN {
                        downMsg _ "unknown fs";
                        h _ MakeDownFS[fs, $serverNotKnown, downMsg];
                        }
                    ELSE {
                        h _ MakeDownFS[fs, $serverNotAvailable, downMsg];
                        };
                };
            [] _ SymTab.Store[fsTab, h.name, h];
            IF downMsg # NIL THEN ErrorDownFS[h, downMsg];
            };

        DoGetFS: PROC [r: Registration, fs: ROPE, flavorSpecified: BOOL, response: GetFSResponse] ~ {
            h: FSHandle _ NIL;
            downMsg: ROPE _ NIL;
            NotifyDone: ENTRY PROC ~ --INLINE-- {
                ENABLE UNWIND => NULL;
                response.nRunning _ response.nRunning - 1;
                IF (response.handle # NIL) OR (response.downMsg # NIL) THEN RETURN;
                SELECT TRUE FROM
                    (h # NIL) OR (downMsg # NIL) => -- found it -- {
                        response.handle _ h;
                        response.downMsg _ downMsg;
                        NOTIFY response.wakeup;
                        };
                    (response.nRunning = 0) => -- nobody will find it -- {
                        NOTIFY response.wakeup;
                        };
                    ENDCASE;
                };
            [h, downMsg] _ r.getHandle[fs, flavorSpecified
                ! Error -- can't happen--, ABORTED => CONTINUE];
            NotifyDone[];
            };

    <<Controlling the flavor of a cached file system.>>
        SetCachedFS: PUBLIC ENTRY PROC [fs: ROPE, flavor: ATOM] ~ {
            r: Registration;
            h: FSHandle;
            downMsg: ROPE;
            FOR r _ registrations, r.next WHILE (r # NIL) AND (r.flavor # flavor) DO NULL ENDLOOP;
            IF r = NIL THEN RETURN;
            [h, downMsg] _ r.getHandle[fs, TRUE];
            IF h = NIL THEN {
                code: ATOM;
                IF downMsg = NIL
                    THEN { downMsg _ "unknown fs"; code _ $fsNotKnown }
                    ELSE { code _ $fsNotAvailable };
                h _ MakeDownFS[fs, code, downMsg];
                };
            [] _ SymTab.Store[fsTab, fs, h];
            };

        ClearCachedServer: PUBLIC ENTRY PROC [fs: ROPE] ~ {
            [] _ SymTab.Delete[fsTab, fs];
            };
    <<Down server implementation>>
        DownFSData: TYPE ~ REF DownFSDataObject;
        DownFSDataObject: TYPE ~ RECORD [
            ttl: CARD,
            errorCode: ATOM,
            downMsg: ROPE
            ];

        downFSMaintenanceProcs: PFSClass.MaintenanceProcs _
            NEW[PFSClass.MaintenanceProcsObject _ [
                sweep~SweepDownFS,
                validate~ValidateDownFS
                ]
            ];

        MakeDownFS: PROC [name: ROPE, errorCode: ATOM, downMsg: ROPE] RETURNS [h: FSHandle] ~ {
            d: DownFSData _ NEW[DownFSDataObject _ [downFSTTL, errorCode,  downMsg]];
            h _ NEW[PFSClass.FSObject _ [$DOWN, name, downFSMaintenanceProcs, NIL, d]];
            };

        SweepDownFS: PFSClass.SweepProc -- [h: FSHandle, seconds: CARD] -- ~ {
            d: DownFSData _ NARROW[h.data];
            IF d.ttl > seconds THEN d.ttl _ d.ttl - seconds ELSE d.ttl _ 0;
            };

        ValidateDownFS: PFSClass.ValidateProc -- [h: FSHandle] RETURNS [obsolete: BOOL, downMsg: ROPE] -- ~ {
            d: DownFSData _ NARROW[h.data];
            RETURN[(d.ttl = 0), d.downMsg];
            };

    <<Error>>
        Error: PUBLIC ERROR [code: ATOM, msg: ROPE] ~ CODE;

        ErrorDownFS: PROC [h: FSHandle, downMsg: ROPE _ NIL] ~ {
            code: ATOM;
            WITH h.data SELECT FROM
                d: DownFSData => {
                    code _ d.errorCode;
                    IF downMsg = NIL THEN downMsg _ d.downMsg;
                    };
                ENDCASE => {
                    code _ $fsNotAvailable;
                    };
            ERROR Error[code, downMsg];
            };

    <<Initialization>>
        Booting.RegisterProcs[r~Rollback];
        TRUSTED { Process.Detach[ FORK Daemon[] ] 
        };

        }...


<<>>