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, August 29, 1986 12:17:47 pm PDT
DIRECTORY
Atom,
BasicTime,
CedarProcess,
CD,
CDEnvironment USING [ExecFileEntry],
CDEvents USING [EventProc, RegisterEventProc, ProcessEvent, EventRegistration, RegisterEventType],
CDIO,
CDOps USING [DoTheDelayedRedraws],
CDPrivate,
CDSequencer,
CDSequencerExtras,
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, IO, MBQueue, PopUpSelection, Process, RefTab, Rope, RuntimeError, TerminalIO, TokenIO, UserProfile
EXPORTS CDSequencer, CDSequencerExtras, 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: BOOL←FALSE, --modifyed exclusively by one single output process
parity: BOOL←TRUE,
abort: BOOL←FALSE,
notInit: BOOL←TRUE,
process: PROCESS, --valid during whileCommand>0 the compiler didn't want that
changedSinceOutput: BOOL←FALSE,
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;
EnterCommand:
ENTRY
PROC [x:
REF PrivateSequencerDRep] =
INLINE {
ENABLE UNWIND => NULL;
--we wont use it-- x.process ← LOOPHOLE[Process.GetCurrent[]];
x.whileCommand ← x.whileCommand+1;
};
LeaveCommand:
ENTRY
PROC [x:
REF PrivateSequencerDRep] =
INLINE {
ENABLE UNWIND => NULL;
x.whileCommand ← x.whileCommand-1;
};
KillCommand:
ENTRY
PROC [x:
REF PrivateSequencerDRep]
RETURNS [killSelf:
BOOL←
FALSE] =
TRUSTED {
ENABLE UNWIND => NULL;
--don't! there are too many ENTRY procs around without UNWIND
IF x.whileCommand>0 THEN {
killSelf ← x.process=Process.GetCurrent[];
IF ~killSelf THEN
Process.Abort[x.process ! RuntimeError.UNCAUGHT => CONTINUE];
};
};
EnterOutput:
ENTRY
PROC [x:
REF PrivateSequencerDRep]
RETURNS [enter:
BOOL←
FALSE] = {
ENABLE UNWIND => NULL;
IF enter←(x.whileCommand=0) THEN x.whileOutput ← TRUE
};
DesignRegistrationEvent: CDEvents.EventProc = {
data:
REF PrivateSequencerDRep ←
NEW[PrivateSequencerDRep←[
queue: MBQueue.Create[],
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.
ROPE ←
SELECT
TRUE FROM
comm=NIL => """NIL-command""",
comm.key=NIL => """NIL""",
ENDCASE => Atom.GetPName[comm.key];
TerminalIO.WriteRopes["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.WriteRope[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
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];
};
IF Process.GetPriority[]>Process.priorityNormal THEN CedarProcess.SetPriority[CedarProcess.Priority[normal]];
de.abort ← FALSE;
ic.proc[ic.comm];
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"
! 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]
};
SetNew:
PROC [design:
CD.Design] = {
[] ← CDEvents.ProcessEvent[setEditedRequest, design];
};
MarkChangedIOOnly:
PUBLIC
PROC [design:
CD.Design] = {
IF ~design.actual.first.changed
OR ~design.cdSequencerPriv
.changedSinceOutput
THEN {
design.cdSequencerPriv.changedSinceOutput ← TRUE;
TRUSTED {Process.Detach[FORK SetNew[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 = {
IF design#
NIL
THEN
design.cdSequencerPriv.changedSinceOutput ← FALSE
};
reCheck: CONDITION ← [timeout: Process.MsecToTicks[1000]];
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] = {
IF design=NIL THEN [] ← CDEvents.ProcessEvent[abortRequest, NIL]
ELSE {
de: REF PrivateSequencerDRep = design.cdSequencerPriv;
de.abort ← TRUE;
[] ← CDEvents.ProcessEvent[abortRequest, design];
MBQueue.Flush[de.queue];
IF KillCommand[de].killSelf THEN ERROR ABORTED
};
};
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];
};
BackgroundSaveProcess:
PROC = {
SaveOneDesign:
PROC [design:
CD.Design] = {
de: REF PrivateSequencerDRep = design.cdSequencerPriv;
done, 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;
}
};
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 {
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];
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 BackgroundSaveProcess[]]};
END.