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, January 2, 1986 3:41:52 pm PST
DIRECTORY
Atom,
BasicTime,
CedarProcess,
CD,
CDEvents USING [EventProc, RegisterEventProc, ProcessEvent, EventRegistration, RegisterEventType],
CDIO,
CDOps USING [DoTheDelayedRedraws],
CDSequencer,
CDViewer,
IO,
MBQueue USING [Queue, Create, QueueClientAction, Flush],
Process,
RefTab,
Rope,
RuntimeError,
TerminalIO USING [WriteRope, UserAbort, WriteLn],
TokenIO,
UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Number],
ViewerOps;
CDSequencerImpl: CEDAR MONITOR
IMPORTS Atom, BasicTime, CedarProcess, CD, CDEvents, CDIO, CDOps, CDViewer, IO, MBQueue, Process, RefTab, Rope, RuntimeError, TerminalIO, TokenIO, UserProfile, ViewerOps
EXPORTS CDSequencer, CD =
BEGIN
Command: TYPE = CDSequencer.Command;
CommandProc: TYPE = CDSequencer.CommandProc;
QueueMethod: TYPE = CDSequencer.QueueMethod;
CommDescriptor: TYPE = CDSequencer.CommDescriptor;
priviledgedRefTab: RefTab.Ref = RefTab.Create[mod: 7]; -- holds commands not to be used
globalRefTab: RefTab.Ref = RefTab.Create[mod: 193]; -- holds commands used in all technologies
quit: ERROR [msg: Rope.ROPE] = CODE; --actually is signal, but we never return...
designNumber: INT𡤀
DesignEntry: TYPE = RECORD [
whileCommand: BOOLFALSE, --modifyed exclusively by the monitored command procedures
whileOutput: BOOLFALSE, --modifyed exclusively by one single output process
parity: BOOLTRUE,
abort: BOOLFALSE,
lastCommand: BasicTime.GMT,
lastOutput: BasicTime.GMT,
num: INT𡤀
];
SequencerDesignPrivate: PUBLIC TYPE = DesignEntry;
start: BasicTime.GMT = BasicTime.Now[];
now: BasicTime.GMT ← BasicTime.Now[];
TechnologyCommandsRep: PUBLIC TYPE = RECORD [
commandTab: RefTab.Ref
];
DesignHasBeenCreated: CDEvents.EventProc =
BEGIN
design.queue ← MBQueue.Create[];
designNumber ← designNumber+1;
design.seqPrivate ← NEW[DesignEntry←[
lastCommand: now,
lastOutput: now,
num: designNumber
]];
END;
UnKnownCommand: PROC [comm: CDSequencer.Command] =
BEGIN
TerminalIO.WriteRope["command "];
IF comm#NIL AND comm.a#NIL THEN TerminalIO.WriteRope[Atom.GetPName[comm.a]];
TerminalIO.WriteRope[" not loaded\n"];
END;
TechnologyHasBeenRegistered: CDEvents.EventProc =
BEGIN
NARROW[x, CD.Technology].technologyCommands ← NEW[TechnologyCommandsRep ← [commandTab: RefTab.Create[mod: 41]]]
END;
InternalExecuteCommand: PROC [ref: REF ANY] =
--caller must guarantee: comm.fetched#NIL
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 finish
};
};
comm: Command = NARROW[ref];
de: REF DesignEntry = comm.design.seqPrivate;
CedarProcess.SetPriority[CedarProcess.Priority[normal]];
de.abort ← FALSE;
IF comm.fetched.qm=dontQueue THEN comm.fetched.p[comm]
ELSE {
de.whileCommand ← TRUE;
WHILE de.whileOutput DO
TokenIO.StopWriting[];
IF de.whileOutput THEN Process.Pause[1]
ENDLOOP;
de.lastCommand ← now;
IF comm.fetched.qm=doQueueAndMark THEN {
comm.design.actual.first.changed ← TRUE;
};
comm.fetched.p[comm];
de.whileCommand ← FALSE
};
CDOps.DoTheDelayedRedraws[comm.design];
EXITS
Aborted => {TerminalIO.WriteRope["** ABORTED\n"]};
TerminalAborted => {TerminalIO.WriteRope["** user aborted\n"]};
finish => NULL;
END;
QuitCommand: PUBLIC PROC [message: Rope.ROPE] =
--write message and terminates execution of the command of this process
--never returns
BEGIN
quit[message]
END;
ImplementCommand: PUBLIC ENTRY PROC [a: ATOM, p: CommandProc, technology: CD.Technology←NIL, queue: QueueMethod] =
-- If technology is NIL implement for all technologies.
-- There is a (finite, short) list of atoms you MUST NOT use.
-- Reimplementing the same atom in a technology it already exists overwrites the command;
-- If the same atom is specified for a particular technology and all technologies,
-- the more specific implementation wins independent of order.
-- Don't fool with NIL CommandProc's if you don't know EXACTLY what it does.
-- (NIL CommandProc's serves too install the list of commands you MUST NOT use.)
BEGIN
ENABLE UNWIND => NULL;
ptr: REF CommDescriptor = NEW[CommDescriptor ← [p: p, qm: queue]];
myRefTab: RefTab.Ref ← globalRefTab;
-- check if is reserved atom not to be used
IF p=NIL THEN {[] ← RefTab.Insert[priviledgedRefTab, a, technology]; RETURN}
ELSE IF RefTab.Fetch[priviledgedRefTab, a].found THEN
RETURN WITH ERROR CD.Error[doubleRegistration, "This atom is reserved"];
-- do implementation
IF technology#NIL THEN {
techCommands: REF TechnologyCommandsRep = technology.technologyCommands;
myRefTab ← techCommands.commandTab;
};
[] ← RefTab.Store[myRefTab, a, ptr]
END;
FetchCommand: PUBLIC PROC[a: ATOM, technology: CD.Technology] RETURNS [cd: REF READONLY CommDescriptor] =
BEGIN
IF technology#NIL THEN { -- search first for particular technology
cTab: REF TechnologyCommandsRep = technology.technologyCommands;
val: RefTab.Val ← RefTab.Fetch[cTab.commandTab, a].val;
IF val#NIL THEN RETURN [NARROW[val]];
};
-- search global
RETURN [NARROW[RefTab.Fetch[globalRefTab, a].val]];
END;
ExecuteProc: PUBLIC PROC [comm: CDSequencer.Command ← NIL, design: CD.Design ← NIL, proc: CommandProc, queue: QueueMethod ← doQueue] =
--if design#NIL replaces comm.design
BEGIN
newComm: CDSequencer.Command = NEW[CDSequencer.CommandRec];
IF comm#NIL THEN newComm^ ← comm^;
IF design#NIL THEN newComm.design ← design;
IF proc=NIL THEN proc ← UnKnownCommand;
newComm.fetched ← NEW[CommDescriptor ← [p: proc, qm: queue]];
IF queue#useDefault AND newComm.fetched.qm#queue THEN
newComm.fetched ← NEW[CommDescriptor ← [p: newComm.fetched.p, qm: queue]];
IF newComm.fetched.qm#dontQueue THEN
MBQueue.QueueClientAction[newComm.design.queue, InternalExecuteCommand, newComm]
ELSE InternalExecuteCommand[newComm]
END;
ExecuteCommand: PUBLIC PROC [comm: Command, design: CD.Design, command: ATOM, queue: CDSequencer.QueueMethod] =
--if command#NIL replaces comm.a
--if design#NIL replaces comm.design
BEGIN
newComm: CDSequencer.Command = NEW[CDSequencer.CommandRec];
IF comm#NIL THEN newComm^ ← comm^;
IF command#NIL THEN newComm.a ← command;
IF design#NIL THEN newComm.design ← design;
newComm.fetched ← FetchCommand[newComm.a, newComm.design.technology];
IF newComm.fetched=NIL THEN
newComm.fetched ← NEW[CommDescriptor ← [p: UnKnownCommand, qm: dontQueue]];
IF queue#useDefault AND newComm.fetched.qm#queue THEN
newComm.fetched ← NEW[CommDescriptor ← [p: newComm.fetched.p, qm: queue]];
IF newComm.fetched.qm#dontQueue THEN
MBQueue.QueueClientAction[newComm.design.queue, InternalExecuteCommand, newComm]
ELSE InternalExecuteCommand[newComm]
END;
MarkChanged: PUBLIC PROC [design: CD.Design] =
BEGIN
design.actual.first.changed ← TRUE
END;
AbortTheCommand: PUBLIC PROC [design: CD.Design] =
BEGIN
IF design#NIL THEN {
de: REF DesignEntry = design.seqPrivate;
IF de.whileCommand THEN de.abort ← TRUE
};
[] ← CDEvents.ProcessEvent[abortRequest, design];
IF design#NIL THEN MBQueue.Flush[design.queue];
END;
Aborted: PUBLIC PROC [design: CD.Design] RETURNS [BOOL] =
BEGIN
de: REF DesignEntry = design.seqPrivate;
RETURN [de.abort]
END;
CheckAborted: PUBLIC PROC [design: CD.Design] =
--IF Aborted[design] THEN SIGNAL TerminalIO.UserAbort
BEGIN
de: REF DesignEntry = design.seqPrivate;
IF de.abort THEN SIGNAL TerminalIO.UserAbort
END;
SaveOneDesign: PROC [design: CD.Design] =
BEGIN
de: REF DesignEntry = design.seqPrivate;
done: BOOLFALSE;
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
! 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
SaveAViewer: ViewerOps.EnumProc -- PROC [v: Viewer] RETURNS [BOOL ← TRUE] -- =
BEGIN
ENABLE RuntimeError.UNCAUGHT => GOTO oops; --give the next viewer a chance
design: CD.Design;
Process.Pause[1]; --make it a little bit slower for the benefit of the viewer redraw
design ← CDViewer.DesignOf[v].design; -- is not monitored
IF design#NIL THEN {
de: REF DesignEntry = design.seqPrivate;
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 ViewerOps.EnumerateViewers[SaveAViewer]
ENDLOOP;
END;
savePeriod: INT ← 0;
NoteProfileChange: UserProfile.ProfileChangedProc -- PROC [reason: ProfileChangeReason]-- =
BEGIN
savePeriod ← UserProfile.Number[key: "ChipNDale.SavePeriod", default: 0];
END;
abortRequest: CDEvents.EventRegistration = CDEvents.RegisterEventType[$Abort];
CDEvents.RegisterEventProc[$RegisterTechnology, TechnologyHasBeenRegistered];
CDEvents.RegisterEventProc[$CreateNewDesign, DesignHasBeenCreated];
UserProfile.CallWhenProfileChanges[NoteProfileChange];
TRUSTED {Process.Detach[FORK EmergencySaveProcess[]]};
END.