CDSequencerImpl.mesa (part of ChipNDale)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, June 22, 1983 6:02 pm
last edited by Christian Jacobi, April 11, 1985 2:42:07 pm PST
DIRECTORY
Atom,
BasicTime,
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],
TokenIO,
UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Number],
ViewerOps;
CDSequencerImpl:
CEDAR
MONITOR
IMPORTS Atom, BasicTime, CD, CDEvents, CDIO, CDOps, CDViewer, IO, MBQueue, Process, RefTab, 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: 17]; -- holds commands not to be used
globalRefTab: RefTab.Ref = RefTab.Create[mod: 53]; -- holds commands used in all technologies
designNumber: INT𡤀
DesignEntry:
TYPE =
RECORD [
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,
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
tech: CD.Technology = NARROW[x];
tech.technologyCommands ←
NEW[TechnologyCommandsRep
← [commandTab: RefTab.Create[mod: 31]]]
END;
InternalExecuteCommand:
PROC [ref:
REF
ANY] =
--caller must guarantee: comm.fetched#NIL
BEGIN
ENABLE {
ABORTED => GOTO Aborted;
TerminalIO.UserAbort => GOTO TerminalAborted;
};
comm: Command = NARROW[ref];
de: REF DesignEntry = comm.design.seqPrivate;
TRUSTED {Process.SetPriority[Process.priorityNormal]};
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[Process.MsecToTicks[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"]};
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←
NIL] =
BEGIN
found: BOOLEAN ← FALSE;
val: RefTab.Val;
IF technology#
NIL
THEN {
-- search first for particular technology
cTab: REF TechnologyCommandsRep = technology.technologyCommands;
[found, val] ← RefTab.Fetch[cTab.commandTab, a];
IF found THEN RETURN [NARROW[val]];
};
[found, val] ← RefTab.Fetch[globalRefTab, a]; -- search global
IF found THEN RETURN [NARROW[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: BOOL ← FALSE;
error: BOOL ← FALSE;
shortName: Rope.ROPE ← CDIO.MakeShortName[design];
code: CHAR = IF de.parity THEN 'A ELSE 'B;
fileName: Rope.ROPE = IO.PutFR["///temp/chipndale/saved/%01g%01g%01g.dale", IO.rope[shortName], IO.int[de.num], IO.char[code]];
done ←
CDIO.WriteDesign[design: design, to: fileName, 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 exit; --give the next viewer a chance
design: CD.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 {
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
}
EXITS exit => NULL;
END;
TRUSTED {Process.SetPriority[Process.priorityBackground]};
DO
-- forever
now ← BasicTime.Now[];
Process.Pause[Process.SecondsToTicks[10]];
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.