CDSequencerImpl.mesa (part of Chipndale)
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved.
by Christian Jacobi June 22, 1983 6:02 pm
last edited by Christian Jacobi October 25, 1984 4:56:45 pm PDT
DIRECTORY
Atom,
BasicTime,
CD,
CDEvents USING [EventProc, RegisterEventProc, ProcessEvent, EventRegistration, RegisterEventType],
CDIO,
CDOps USING [DoTheDelayedRedraws],
CDSequencer,
CDValue,
CDViewer,
FileNames,
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, CDValue, CDViewer, FileNames, 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;
CommandPrivate: TYPE = CDSequencer.CommandPrivate;
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 ={
design.queue ← MBQueue.Create[];
designNumber ← designNumber+1;
design.seqPrivate ← NEW[DesignEntry←[lastCommand: now, lastOutput: now, num: designNumber]];
};
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.private#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.private.p#
NIL
THEN {
IF comm.private.qm#dontQueue
THEN {
de.whileCommand ← TRUE;
WHILE de.whileOutput
DO
TokenIO.StopWriting[];
IF de.whileOutput THEN Process.Pause[Process.MsecToTicks[1]]
ENDLOOP;
de.lastCommand ← now;
IF comm.private.qm=doQueueAndMark
THEN {
comm.design.actual.first.changed ← TRUE;
};
comm.private.p[comm];
de.whileCommand ← FALSE
}
ELSE comm.private.p[comm];
CDOps.DoTheDelayedRedraws[comm.design];
}
ELSE {
TerminalIO.WriteRope["command "];
TerminalIO.WriteRope[Atom.GetPName[comm.a]];
TerminalIO.WriteRope[" not loaded\n"];
};
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 CommandPrivate ~ NEW[CommandPrivate←[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;
ExecuteCommand:
PUBLIC
PROC [comm: Command, design:
CD.Design, as:
ATOM, queue: CDSequencer.QueueMethod] =
-- if as#NIL replaces comm.a
-- if design#NIL replaces comm.design
BEGIN
BuildCommandPrivate:
PROC[] =
INLINE
--uses globals newCom and queue
BEGIN
found: BOOLEAN ← FALSE;
val: RefTab.Val;
IF newComm.design.technology#
NIL
THEN {
-- search first for particular technology
cTab: REF TechnologyCommandsRep = newComm.design.technology.technologyCommands;
[found, val] ← RefTab.Fetch[cTab.commandTab, newComm.a];
};
IF NOT found THEN [found, val] ← RefTab.Fetch[globalRefTab, newComm.a]; -- search global
IF found THEN newComm.private ← NARROW[val, REF CommandPrivate]
ELSE newComm.private ←
NEW[CommandPrivate ← [p:
NIL, qm: queue]]
--usually
--we queue the message for unknown command; take it from queue
END;
newComm: CDSequencer.Command ~ NEW[CDSequencer.CommandRec𡤌omm^];
IF as#NIL THEN newComm.a ← as;
IF design#design THEN newComm.design ← design;
IF newComm.design=NIL THEN ERROR;
BuildCommandPrivate[];
IF queue#useDefault
AND newComm.private.qm#queue
THEN
newComm.private ← NEW[CommandPrivate ← [p: newComm.private.p, qm: queue]];
IF newComm.private.qm#dontQueue
THEN
MBQueue.QueueClientAction[newComm.design.queue, InternalExecuteCommand, newComm]
ELSE InternalExecuteCommand[newComm]
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;
MakeShortName:
PROC [design:
CD.Design]
RETURNS [name: Rope.
ROPE ←
NIL] =
BEGIN
TrailingDot:
PROC [base: Rope.
ROPE]
RETURNS [
INT] = {
--position of last dot
len: INT ← Rope.Length[base];
pos: INT ← len;
WHILE pos > 0
DO
SELECT Rope.Fetch[base, pos ← pos - 1]
FROM
'. => RETURN [pos];
'!, '], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [len];
};
SuggestedModule:
PROC [base: Rope.
ROPE]
RETURNS [Rope.
ROPE] = {
--given a filename, suggests a modulename
len, dot: INT;
base ← FileNames.GetShortName[base];
len ← Rope.Length[base];
dot ← TrailingDot[base];
IF len>dot
AND Rope.Equal[Rope.Substr[base, dot+1], "dale",
FALSE]
THEN
base ← Rope.Substr[base, 0, dot];
RETURN [base]
};
--MakeShortName
WITH CDValue.Fetch[boundTo: design, key: $CDxFromFile]
SELECT
FROM
r: Rope.ROPE => name ← SuggestedModule[r];
ENDCASE => NULL;
IF name=NIL THEN name ← design.name;
IF name=NIL THEN name ← "noname"
END;
SaveOneDesign:
PROC [design:
CD.Design] =
BEGIN
de: REF DesignEntry = design.seqPrivate;
done: BOOL ← FALSE;
error: BOOL ← FALSE;
shortName: Rope.ROPE ← 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.