
    <<CDSequencerImpl.mesa   (part of ChipNDale)>>
        <<Copyright © 1983, 1986 by Xerox Corporation.  All rights reserved.>>
        <<by Christian Jacobi,  June 22, 1983 6:02 pm >>
        <<last edited by Christian Jacobi,  March 28, 1986 12:02:18 pm PST>>

    DIRECTORY
        Atom,
        BasicTime,
        CedarProcess,
        CD,
        CDEvents USING [EventProc, RegisterEventProc, ProcessEvent, EventRegistration, RegisterEventType],
        CDIO,
        CDOps USING [DoTheDelayedRedraws],
        CDPrivate,
        CDSequencer,
        IO,
        MBQueue USING [Queue, Create, QueueClientAction, Flush],
        Process,
        RefTab,
        Rope,
        RuntimeError,
        TerminalIO USING [WriteRope, UserAbort, WriteLn],
        TokenIO,
        UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Number];

    CDSequencerImpl: CEDAR MONITOR 
        IMPORTS Atom, BasicTime, CedarProcess, CDEvents, CDIO, CDOps, CDPrivate, IO, MBQueue, Process, RefTab, Rope, RuntimeError, 
        TerminalIO, TokenIO, UserProfile 
        EXPORTS CDSequencer, CD = 
    BEGIN

    Command: TYPE = CDSequencer.Command;
    CommandProc: TYPE = CDSequencer.CommandProc;
    QueueMethod: TYPE = CDSequencer.QueueMethod;

    PrivateSequencerDRep: PUBLIC TYPE = RECORD [
        queue: MBQueue.Queue,
        whileCommand: BOOL_FALSE, --modifyed exclusively by the monitored command procedures
        whileOutput: BOOL_FALSE, --modifyed exclusively by one single output process
        parity: BOOL_TRUE,
        abort: BOOL_FALSE,
        notInit: BOOL_TRUE,
        changedSinceOutput: BOOL_TRUE,
        lastCommand: BasicTime.GMT, 
        lastOutput: BasicTime.GMT,
        num: INT_0
        ];

    PrivateSequencerTRep: PUBLIC TYPE = RECORD [
        commandTab: RefTab.Ref
        ];

    Registration: TYPE = REF RegistrationRec;
    RegistrationRec: TYPE = RECORD [p: CommandProc, qm: QueueMethod];
    InternalRec: TYPE = RECORD [comm: Command, qm: QueueMethod, proc: CommandProc];

    globalTab: RefTab.Ref = RefTab.Create[mod: 193]; -- holds commands used in all technologies
        <<--using a RefTab is ok: we approximately know the number of entries>>
    quit: ERROR [msg: Rope.ROPE] = CODE; --actually is signal, but we never return...
    designNumber: INT_0;
    now: BasicTime.GMT _ BasicTime.Now[]; --lags behind 
    savePeriod: INT _ 0;

    DesignRegistrationEvent: CDEvents.EventProc =
        BEGIN
        data: REF PrivateSequencerDRep _ NEW[PrivateSequencerDRep_[
            queue: MBQueue.Create[],
            lastCommand: now, 
            lastOutput: now, 
            num: designNumber
            ]];
        designNumber _ designNumber+1;
        design.cdSequencerPriv _ data;
        END;


    TechRegistrationEvent: CDEvents.EventProc = {
        tech: CD.Technology = NARROW[x];
        tech.cdSequencerPriv _ NEW[PrivateSequencerTRep _ [commandTab: RefTab.Create[mod: 41]]]
        };

    UnKnownCommand: PROC [comm: CDSequencer.Command] = {
        TerminalIO.WriteRope["command "];
        IF comm#NIL AND comm.key#NIL THEN TerminalIO.WriteRope[Atom.GetPName[comm.key]];
        TerminalIO.WriteRope[" not loaded\n"];
        };

    InternalExec: PROC [ref: REF ANY] =
        BEGIN
        ENABLE {
            ABORTED => GOTO Aborted;
            TerminalIO.UserAbort => GOTO TerminalAborted;
            quit => {
                IF Rope.Length[msg]>0 THEN {
                    TerminalIO.WriteRope[msg];
                    IF Rope.Fetch[msg, Rope.Length[msg]-1]#'\n THEN TerminalIO.WriteLn[]
                    };
                GOTO QuitAborted
                };
            };
        ic: REF InternalRec = NARROW[ref];
        de: REF PrivateSequencerDRep = ic.comm.design.cdSequencerPriv;
        IF Process.GetPriority[]>Process.priorityNormal THEN
            CedarProcess.SetPriority[CedarProcess.Priority[normal]];
        de.abort _ FALSE;
        IF ic.qm=dontQueue THEN ic.proc[ic.comm]
        ELSE {
            de.whileCommand _ TRUE;
            WHILE de.whileOutput DO
                TokenIO.StopWriting[];
                IF de.whileOutput THEN Process.Pause[1]
                ENDLOOP;
            de.lastCommand _ now;
            IF ic.qm=doQueueAndMark THEN {
                IF ~de.changedSinceOutput OR ~ic.comm.design.actual.first.changed THEN 
                    MarkChanged[ic.comm.design];
                };
            ic.proc[ic.comm];
            de.whileCommand _ FALSE
            };
        CDOps.DoTheDelayedRedraws[ic.comm.design];
        EXITS
            Aborted => {TerminalIO.WriteRope["** ABORTED\n"]};
            TerminalAborted => {TerminalIO.WriteRope["** aborted interactive input\n"]};
            QuitAborted => {};
        END;

    Quit: PUBLIC PROC [message: Rope.ROPE] = {
        quit[message]
        };

    ImplementCommand: PUBLIC ENTRY PROC [key: ATOM, proc: CommandProc, technology: CD.Technology, queue: QueueMethod] =  
        BEGIN ENABLE UNWIND => NULL; 
        table: RefTab.Ref _ globalTab;
        IF technology#NIL THEN  
            table _ technology.cdSequencerPriv.commandTab;
        [] _ RefTab.Store[table, key, NEW[RegistrationRec _ [p: proc, qm: queue]]];
        END;

    FetchCommand: PUBLIC PROC[key: ATOM, technology: CD.Technology] RETURNS [proc: CommandProc_NIL, qm: QueueMethod_dontQueue] =
        BEGIN

        FetchRegistration: PROC[key: ATOM, technology: CD.Technology] RETURNS [cd: Registration] =
            INLINE BEGIN
            IF technology#NIL THEN { -- search first for particular technology
                cTab: REF PrivateSequencerTRep = technology.cdSequencerPriv;
                val: RefTab.Val _ RefTab.Fetch[cTab.commandTab, key].val;
                IF val#NIL THEN RETURN [NARROW[val]];
                };
            RETURN [NARROW[RefTab.Fetch[globalTab, key].val]];
            END;

        cd: Registration ~ FetchRegistration[key, technology];
        IF cd#NIL THEN {proc_cd.p; qm_cd.qm};
        END;


    Call: PROC [ic: REF InternalRec] = INLINE {
        IF ic.qm=dontQueue THEN InternalExec[ic]   
        ELSE { 
            WHILE ic.comm.design.cdSequencerPriv.notInit DO
                Wait[ic.comm.design.cdSequencerPriv]
                ENDLOOP;
            MBQueue.QueueClientAction[ic.comm.design.cdSequencerPriv.queue, InternalExec, ic]
            }
        };

    ExecuteProc: PUBLIC PROC [proc: CommandProc, design: CD.Design, queue: QueueMethod, comm: CDSequencer.Command] =
        BEGIN
        ic: REF InternalRec _ NEW[InternalRec_[
            comm: NEW[CDSequencer.CommandRec],
            proc: IF proc=NIL THEN UnKnownCommand ELSE proc,
            qm: queue
            ]];
        IF comm#NIL THEN ic.comm^ _ comm^;
        IF design#NIL THEN ic.comm.design _ design;
        Call[ic]
        END;

    ExecuteCommand: PUBLIC PROC [key: ATOM, design: CD.Design, queue: QueueMethod, comm: CDSequencer.Command] =
        BEGIN
        ic: REF InternalRec _ NEW[InternalRec_[
            comm: NEW[CDSequencer.CommandRec],
            proc: NIL,
            qm: useDefault
            ]];
        IF comm#NIL THEN ic.comm^ _ comm^;
        IF key#NIL THEN ic.comm.key _ key;
        IF design#NIL THEN ic.comm.design _ design;
        [ic.proc, ic.qm] _ FetchCommand[ic.comm.key, ic.comm.design.technology];
        IF ic.proc=NIL THEN { 
            ic.proc _ UnKnownCommand; ic.qm _ dontQueue;
            };
        IF queue#useDefault THEN ic.qm _ queue;
        Call[ic]
        END;

    SetNew: PROC [design: CD.Design] = {
        [] _ CDEvents.ProcessEvent[setEditedRequest, design];
        };

    MarkChanged: PUBLIC PROC [design: CD.Design] = {
        IF ~design.actual.first.changed OR ~design.cdSequencerPriv.changedSinceOutput THEN {
            design.actual.first.changed _ TRUE;
            design.cdSequencerPriv.changedSinceOutput _ TRUE;
            TRUSTED {Process.Detach[FORK SetNew[design]]};
            }
        };

    AfterOutputEvent: CDEvents.EventProc =
        BEGIN
        IF design#NIL THEN {
            design.cdSequencerPriv.changedSinceOutput _ FALSE
            };
        END;

    reCheck: CONDITION;

    Wait: ENTRY PROC [sPriv: REF PrivateSequencerDRep] = {
        IF sPriv=NIL OR sPriv.notInit THEN WAIT reCheck
        };

    OpenDialogue: PUBLIC ENTRY PROC [design: CD.Design] = {
        DoIt: INTERNAL PROC [] = {
            design.cdSequencerPriv.notInit _ FALSE;
            BROADCAST reCheck
            };
        DoIt[ ! RuntimeError.UNCAUGHT => CONTINUE]
        };

    AbortDesignsCommand: PUBLIC PROC [design: CD.Design] =
        BEGIN
        IF design=NIL THEN [] _ CDEvents.ProcessEvent[abortRequest, NIL]
        ELSE {
            de: REF PrivateSequencerDRep = design.cdSequencerPriv;
            IF de.whileCommand THEN de.abort _ TRUE;
            [] _ CDEvents.ProcessEvent[abortRequest, design];
            MBQueue.Flush[de.queue];
            };
        END;

    Aborted: PUBLIC PROC [design: CD.Design] RETURNS [BOOL] = {
        RETURN [design.cdSequencerPriv.abort]
        };

    CheckAborted: PUBLIC PROC [design: CD.Design] = {
        IF design.cdSequencerPriv.abort THEN Quit["command aborted"];
        };
        <<>>
    SaveOneDesign: PROC [design: CD.Design] =
        BEGIN
        de: REF PrivateSequencerDRep = design.cdSequencerPriv;
        done: BOOL _ FALSE;
        error: BOOL _ FALSE;
        done _ CDIO.WriteDesign[design: design, 
            to: IO.PutFR["///temp/ChipNDale/saved/%01g%01g%01g.dale", IO.rope[CDIO.MakeShortName[design]], 
            IO.int[de.num], 
            IO.char[IF de.parity THEN 'A ELSE 'B]], 
            quiet: TRUE, 
            emergency: FALSE
            ! TokenIO.WritingStopped, RuntimeError.UNCAUGHT => {error_TRUE; CONTINUE}
            ];
        IF error THEN TokenIO.ReleaseWriter[]
        ELSE IF done THEN {
            de.lastOutput _ BasicTime.Now[];
            de.parity _ ~de.parity;
            }
        END;

    EmergencySaveProcess: PROC =  
        BEGIN

        SaveADesign: CDPrivate.DesignEnumerator =
            BEGIN
                ENABLE RuntimeError.UNCAUGHT => GOTO oops; --give the next viewer a chance
            Process.Pause[1]; --make it a little bit slower for the benefit of the viewer redraw
            IF design#NIL THEN {
                de: REF PrivateSequencerDRep = design.cdSequencerPriv; 
                IF de#NIL AND NOT de.whileCommand 
                    AND BasicTime.Period[from: de.lastCommand, to: now]>15 
                    AND BasicTime.Period[from: de.lastOutput, to: de.lastCommand]>savePeriod 
                THEN {
                    CedarProcess.SetPriority[CedarProcess.Priority[normal]]; 
                        <<--set priority high enough to stop quickly if necessary>>
                    de.whileOutput _ TRUE; 
                    <<--Hint for correctness proof:>>
                        <<--this (above) assignment statement to de.whileOutput happens either before >>
                        <<--or after an assgnment to de.whileCommand or there is no conflict at all>>
                        <<--If this before: in command process we wait until outout is finished>>
                        <<--If this after: we skip the output (next if statement) >>
                    IF NOT de.whileCommand THEN {
                        SaveOneDesign[design];
                        }
                    };
                IF de#NIL THEN de.whileOutput _ FALSE;
                CedarProcess.SetPriority[CedarProcess.Priority[background]]; --speed no more necessary
                };
            EXITS oops => NULL;
            END;

        <<--EmergencySaveProcess>>
        DO -- forever
            now _ BasicTime.Now[];
            Process.Pause[Process.SecondsToTicks[8]];
            IF savePeriod>=0 THEN [] _ CDPrivate.EnumDesigns[SaveADesign]
            ENDLOOP;
        END;


    NoteProfileChange: UserProfile.ProfileChangedProc = {
        savePeriod _ UserProfile.Number[key: "ChipNDale.SavePeriod", default: 0];
        }; 

    abortRequest: CDEvents.EventRegistration = CDEvents.RegisterEventType[$Abort];
    setEditedRequest: CDEvents.EventRegistration = CDEvents.RegisterEventType[$SetEdited];
    CDEvents.RegisterEventProc[$RegisterTechnology, TechRegistrationEvent];
    CDEvents.RegisterEventProc[$CreateNewDesign, DesignRegistrationEvent];
    CDEvents.RegisterEventProc[$AfterOutput, AfterOutputEvent];
    UserProfile.CallWhenProfileChanges[NoteProfileChange];
    TRUSTED {Process.Detach[FORK EmergencySaveProcess[]]};
    END.