CDSequencerImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 22, 1983 6:02 pm
Last edited by: Christian Jacobi, November 3, 1986 7:06:36 pm PST
DIRECTORY
Atom,
BasicTime,
CedarProcess,
CD,
CDEnvironment USING [ExecFileEntry],
CDEvents USING [EventProc, RegisterEventProc, ProcessEvent, EventRegistration, RegisterEventType],
CDIO,
CDOps USING [DoTheDelayedRedraws],
CDPrivate,
CDProperties,
CDSequencer,
IO,
MBQueue USING [Queue, Create, QueueClientAction, Flush],
PopUpSelection,
Process,
RefTab,
Rope,
RuntimeError USING [UNCAUGHT],
TerminalIO,
TokenIO,
UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Number];
CDSequencerImpl: CEDAR MONITOR
IMPORTS Atom, BasicTime, CedarProcess, CDEvents, CDEnvironment, CDIO, CDOps, CDPrivate, CDProperties, IO, MBQueue, PopUpSelection, 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: INT𡤀, --modifyed by monitored procedures inside single call proc
whileOutput: BOOLFALSE, --modifyed exclusively by one single output process
stopWrite: REF BOOL,
parity: BOOLTRUE,
abort: BOOLFALSE,
abortFlags: LIST OF REF BOOLNIL,
notInit: BOOLTRUE,
lastCommand: BasicTime.GMT,
lastOutput: BasicTime.GMT,
num: INT𡤀
];
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𡤀
now: BasicTime.GMT ← BasicTime.Now[]; --lags behind
savePeriod: INT ← 0;
reCheck: CONDITION ← [timeout: Process.MsecToTicks[1000]];
EnterCommand: ENTRY PROC [x: REF PrivateSequencerDRep] = INLINE {
ENABLE UNWIND => NULL;
x.whileCommand ← x.whileCommand+1;
};
LeaveCommand: ENTRY PROC [x: REF PrivateSequencerDRep] = INLINE {
ENABLE UNWIND => NULL;
x.whileCommand ← x.whileCommand-1;
};
EnterOutput: ENTRY PROC [x: REF PrivateSequencerDRep] RETURNS [enter: BOOLFALSE] = {
ENABLE UNWIND => NULL;
IF enter←(x.whileCommand=0) THEN {
IF x.stopWrite=NIL THEN x.stopWrite←NEW[BOOL];
x.stopWrite^ ← FALSE;
x.whileOutput ← TRUE
}
};
DesignRegistrationEvent: CDEvents.EventProc = {
data: REF PrivateSequencerDRep ← NEW[PrivateSequencerDRep←[
queue: MBQueue.Create[],
stopWrite: NEW[BOOLFALSE],
lastCommand: now,
lastOutput: now,
num: designNumber
]];
designNumber ← designNumber+1;
design.cdSequencerPriv ← data;
};
TechRegistrationEvent: CDEvents.EventProc = {
tech: CD.Technology = NARROW[x];
tech.cdSequencerPriv ← NEW[PrivateSequencerTRep ← [commandTab: RefTab.Create[mod: 41]]]
};
UnKnownCommand: PROC [comm: CDSequencer.Command] = {
key: Rope.ROPESELECT TRUE FROM
comm=NIL => """NIL-command""",
comm.key=NIL => """NIL""",
ENDCASE => Atom.GetPName[comm.key];
TerminalIO.PutRopes["command ", key, " not loaded\n"];
};
WriteMsg: PROC [r: Rope.ROPE] = {
IF Rope.Length[r]>0 THEN {
IF Rope.Fetch[r, Rope.Length[r]-1]#'\n THEN r ← Rope.Concat[r, "\n"];
TerminalIO.PutRope[r];
};
};
InternalExec: PROC [ref: REF ANY] = { --type good for MBQueue.QueueClientAction
ENABLE {
ABORTED => {WriteMsg["** ABORTED"]; GOTO Oops};
quit => {WriteMsg[msg]; GOTO Oops};
TerminalIO.UserAbort => {WriteMsg["** aborted interactive input"]; GOTO Oops};
};
ic: REF InternalRec = NARROW[ref];
IF ic.qm=dontQueue THEN ic.proc[ic.comm]
ELSE {
de: REF PrivateSequencerDRep = ic.comm.design.cdSequencerPriv;
IF de=NIL THEN ERROR;
EnterCommand[de];
BEGIN
ENABLE UNWIND => LeaveCommand[de];
WHILE de.whileOutput DO
stop: REF BOOL ← de.stopWrite;
IF stop#NIL THEN stop^ ← TRUE;
IF de.whileOutput THEN Process.Pause[1]
ENDLOOP;
de.lastCommand ← now;
IF ic.qm=doQueueAndMark THEN {
IF ~ic.comm.design.changedSinceSaving OR ~ic.comm.design.actual.first.specific.changed THEN
MarkChanged[ic.comm.design];
};
IF Process.GetPriority[]>Process.priorityNormal THEN CedarProcess.SetPriority[CedarProcess.Priority[normal]];
de.abort ← FALSE;
ic.proc[ic.comm];
de.abortFlags ← NIL;
END;
LeaveCommand[de];
};
CDOps.DoTheDelayedRedraws[ic.comm.design];
EXITS Oops => NULL
};
Quit: PUBLIC PROC [message: Rope.ROPE] = {
ERROR quit[message]
};
ImplementCommand: PUBLIC ENTRY PROC [key: ATOM, proc: CommandProc, technology: CD.Technology, queue: QueueMethod] = {
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]]];
};
FetchCommand: PUBLIC PROC[key: ATOM, technology: CD.Technology] RETURNS [proc: CommandProc←NIL, qm: QueueMethod𡤍ontQueue] = {
FetchRegistration: PROC[key: ATOM, technology: CD.Technology] RETURNS [cd: Registration] = INLINE {
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]];
};
cd: Registration ← FetchRegistration[key, technology];
IF cd=NIL THEN {
CDEnvironment.ExecFileEntry[Atom.GetPName[key], technology, "cmds" !
ABORTED => {TerminalIO.PutRope["\n**abort\n"]; CONTINUE};
RuntimeError.UNCAUGHT =>
SELECT PopUpSelection.Request[
header: "ERROR",
choice: LIST["continue with ChipNDale", "debug"],
headerDoc: "error while executing command file",
choiceDoc: LIST["usually ok", "land in debugger (abort will continue ChipNDale)"]
] FROM
1 => CONTINUE;
2 => REJECT;
ENDCASE => CONTINUE;
];
cd ← FetchRegistration[key, technology];
};
IF cd#NIL THEN {proc�.p; qm�.qm};
};
Call: PROC [ic: REF InternalRec] = INLINE {
IF ic.qm=dontQueue THEN InternalExec[ic]
ELSE {
WHILE ic.comm.design.cdSequencerPriv.notInit DO
WaitInitialization[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] = {
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]
};
ExecuteCommand: PUBLIC PROC [key: ATOM, design: CD.Design, queue: QueueMethod, comm: CDSequencer.Command] = {
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]
};
RecheckEdited: PROC [design: CD.Design] = {
[] ← CDEvents.ProcessEvent[recheckEditedRequest, design];
};
SetEdited: PUBLIC PROC [design: CD.Design, edited: BOOL] = {
was: BOOL ← design.edited;
design.edited ← edited;
IF was#edited THEN RecheckEdited[design];
};
MarkChangedIOOnly: PUBLIC PROC [design: CD.Design] = {
IF ~design.actual.first.specific.changed OR ~design.changedSinceSaving THEN {
design.changedSinceSaving ← TRUE;
design.edited ← TRUE;
TRUSTED {Process.Detach[FORK RecheckEdited[design]]};
}
};
MarkChanged: PUBLIC PROC [design: CD.Design] = {
IF ~design.actual.first.specific.changed OR ~design.changedSinceSaving THEN {
design.actual.first.specific.changed ← TRUE;
design.changedSinceSaving ← TRUE;
design.edited ← TRUE;
TRUSTED {Process.Detach[FORK RecheckEdited[design]]};
}
};
AfterOutputEvent: CDEvents.EventProc = {
IF design#NIL THEN design.changedSinceSaving ← FALSE
};
WaitInitialization: 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, flush: BOOL] = {
IF design=NIL THEN [] ← CDEvents.ProcessEvent[abortRequest, NIL]
ELSE {
de: REF PrivateSequencerDRep = design.cdSequencerPriv;
de.abort ← TRUE;
FOR bl: LIST OF REF BOOL ← de.abortFlags, bl.rest WHILE bl#NIL DO
IF bl.first#NIL THEN bl.first^←TRUE
ENDLOOP;
[] ← CDEvents.ProcessEvent[abortRequest, design];
IF flush THEN MBQueue.Flush[de.queue];
};
};
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"];
CedarProcess.CheckAbort[NIL];
};
UseAbortFlag: PUBLIC PROC [design: CD.Design, flag: REF BOOL] = {
--not monitored: is called from inside a command
IF design=NIL OR flag=NIL THEN ERROR;
design.cdSequencerPriv.abortFlags ← CONS[flag, design.cdSequencerPriv.abortFlags];
};
BackgroundSaveProcess: PROC = {
SaveOneDesign: PROC [design: CD.Design] = {
de: REF PrivateSequencerDRep = design.cdSequencerPriv;
done, error: BOOLFALSE;
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,
stop: de.stopWrite
! TokenIO.Stopped, RuntimeError.UNCAUGHT => {error←TRUE; CONTINUE}
];
IF done THEN {
de.lastOutput ← BasicTime.Now[];
de.parity ← ~de.parity;
design.changedSinceSaving ← FALSE;
}
};
CheckDesignForSave: CDPrivate.DesignEnumerator = {
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 de.whileCommand=0
AND BasicTime.Period[from: de.lastCommand, to: now]>15
AND BasicTime.Period[from: de.lastOutput, to: de.lastCommand]>savePeriod
THEN IF CDProperties.GetDesignProp[design, $CDxDontBackgroundSave]#$TRUE THEN {
CedarProcess.SetPriority[CedarProcess.Priority[normal]];
--set priority high enough to stop quickly if necessary
IF EnterOutput[de] THEN
SaveOneDesign[design ! RuntimeError.UNCAUGHT => CONTINUE];
de.whileOutput ← FALSE;
CedarProcess.SetPriority[CedarProcess.Priority[background]]; --speed no more necessary
};
};
EXITS oops => NULL;
};
DO -- forever
now ← BasicTime.Now[];
Process.Pause[Process.SecondsToTicks[8]];
IF savePeriod>=0 THEN [] ← CDPrivate.EnumDesigns[CheckDesignForSave]
ENDLOOP;
};
NoteProfileChange: UserProfile.ProfileChangedProc = {
savePeriod ← UserProfile.Number[key: "ChipNDale.SavePeriod", default: 0];
};
abortRequest: CDEvents.EventRegistration = CDEvents.RegisterEventType[$Abort];
recheckEditedRequest: CDEvents.EventRegistration = CDEvents.RegisterEventType[$CheckEdited];
CDEvents.RegisterEventProc[$RegisterTechnology, TechRegistrationEvent];
CDEvents.RegisterEventProc[$CreateNewDesign, DesignRegistrationEvent];
CDEvents.RegisterEventProc[$AfterOutput, AfterOutputEvent];
UserProfile.CallWhenProfileChanges[NoteProfileChange];
TRUSTED {Process.Detach[FORK BackgroundSaveProcess[]]};
END.