CDSequencerImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 22, 1983 6:02 pm
Last edited by: Christian Jacobi, June 15, 1987 12:44:47 pm PDT
DIRECTORY
Atom,
BasicTime,
CedarProcess,
CD,
CDEnvironment,
CDEvents USING [EventProc, RegisterEventProc, ProcessEvent, EventRegistration, RegisterEventType],
CDIO,
CDOps USING [DoTheDelayedRedraws],
CDPrivate,
CDProperties,
CDSequencer,
CDSequencerExtras,
IO,
MBQueue USING [Queue, Create, QueueClientAction, Flush],
MessageWindow,
PopUpSelection,
Process,
ProcessProps,
RefTab,
Rope,
RuntimeError USING [UNCAUGHT],
TerminalIO,
TokenIO,
UserProfile;
CDSequencerImpl:
CEDAR
MONITOR
IMPORTS Atom, BasicTime, CedarProcess, CD, CDEvents, CDEnvironment, CDIO, CDOps, CDPrivate, CDProperties, IO, MBQueue, MessageWindow, PopUpSelection, Process, ProcessProps, RefTab, Rope, RuntimeError, TerminalIO, TokenIO, UserProfile
EXPORTS CDSequencer, CDSequencerExtras, CD =
BEGIN
Message:
PROC [r: Rope.
ROPE] = {
--Message r on Message window
MessageWindow.Append[r, TRUE];
MessageWindow.Blink[];
};
ErrorChangeReadOnlyDesign:
PROC [d:
CD.Design←
NIL] =
TRUSTED {
Process.Detach[
FORK
Message[Rope.Cat["design """, IF d=NIL THEN "" ELSE d.name, """ readonly"]]
];
ERROR CD.Error[designMutability];
};
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, --Set monitored, cleared by one single output process
stopWrite: REF BOOL,
abort: BOOL←FALSE,
abortFlags: LIST OF REF BOOL←NIL,
notInit: BOOL←TRUE,
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𡤍ontQueue, setWDir: BOOL←FALSE, registrationData: REF←NIL];
InternalRec: TYPE = RECORD [comm: Command, qm: QueueMethod, reg: Registration←NIL];
globalTab: 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 ← 0;
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:
BOOL←
FALSE] = {
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[BOOL←FALSE],
lastCommand: now,
lastOutput: now,
num: designNumber
]];
designNumber ← designNumber+1;
design.cdSequencerPriv ← data;
design.cdSequencerPriv.notInit ← FALSE;
};
TechRegistrationEvent: CDEvents.EventProc = {
tech: CD.Technology = NARROW[x];
tech.cdSequencerPriv ← NEW[PrivateSequencerTRep ← [commandTab: RefTab.Create[mod: 41]]]
};
unKnownRegistration: Registration ←
NEW[RegistrationRec←[
p: UnKnownCommand,
qm: dontQueue
]];
changeReadOnlyRegistration: Registration ←
NEW[RegistrationRec←[
p: ChangeReadonlyDesignCommand,
qm: dontQueue
]];
UnKnownCommand:
PROC [comm: CDSequencer.Command] = {
key: ATOM ← IF comm.key#NIL THEN comm.key ELSE $NIL;
r: Rope.ROPE ← IO.PutFR["command %g not known", [atom[key]]];
Message[r];
TerminalIO.PutRopes[r, "\n"];
};
ChangeReadonlyDesignCommand:
PROC [comm: CDSequencer.Command] = {
key: ATOM ← IF comm.key#NIL THEN comm.key ELSE $NIL;
TerminalIO.PutF["command %g tries to change design ""%g"", but design is readonly\n",
[atom[key]], [rope[CD.DesignName[comm.design]]]
];
};
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};
CD.Error =>
IF ec=designMutability
THEN {
WriteMsg["** aborted try to change readonly design"]; GOTO Oops
};
TerminalIO.UserAbort => {WriteMsg["** aborted interactive input"]; GOTO Oops};
};
ic: REF InternalRec = NARROW[ref];
ExecIcInline:
PROC [] =
INLINE {
ic.reg.p[ic.comm ! RuntimeError.
UNCAUGHT =>
IF ShouldDebug[
LOOPHOLE[signal]]
THEN REJECT
ELSE CONTINUE
];
};
ExecIc: PROC = {ExecIcInline[]};
ExecNWDir:
PROC [] =
INLINE {
IF ~ic.reg.setWDir
THEN ExecIcInline[]
ELSE {
wDir: Rope.ROPE ~ CDEnvironment.GetWorkingDirectory[ic.comm.design];
ProcessProps.AddPropList[
propList: LIST[NEW[Atom.DottedPairNode←[$WorkingDirectory, wDir]]],
inner: ExecIc
]
};
};
IF ic.qm=dontQueue THEN ExecNWDir[]
ELSE {
de: REF PrivateSequencerDRep = ic.comm.design.cdSequencerPriv;
Protected:
PROC [de:
REF PrivateSequencerDRep] ~ {
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
!
CD.Error =>
IF ec=designMutability
THEN {
ic.reg ← changeReadOnlyRegistration; CONTINUE;
};
];
};
IF Process.GetPriority[]>Process.priorityNormal THEN CedarProcess.SetPriority[CedarProcess.Priority[normal]];
de.abort ← FALSE;
ExecNWDir[];
de.abortFlags ← NIL;
LeaveCommand[de]
};-- Protected
IF de=NIL THEN ERROR CD.Error[programming];
EnterCommand[de];
Protected[de];
};
CDOps.DoTheDelayedRedraws[ic.comm.design];
EXITS Oops => NULL
};
ShouldDebug:
PROC [signal:
SIGNAL
ANY
RETURNS
ANY]
RETURNS [debug:
BOOL←
TRUE] = {
WITH CDProperties.GetAtomProp[$CDDebugPrivate, $CDDebugPrivate]
SELECT
FROM
rs: REF SIGNAL ANY RETURNS ANY => IF signal=rs^ THEN RETURN [TRUE];
ENDCASE => NULL;
IF UserProfile.Boolean["ChipNDale.OpenEventViewers", FALSE] THEN RETURN [TRUE];
DO
SELECT PopUpSelection.Request[
header: "ERROR",
choice: LIST["continue with ChipNDale", "debug"],
headerDoc: "error while executing ChipNDale command",
choiceDoc: LIST["usually ok", "land in debugger (abort will continue ChipNDale)"]
] FROM
1 => RETURN [FALSE];
2 => RETURN [TRUE];
ENDCASE => NULL;
TerminalIO.PutRope["don't skip this!\n"];
ENDLOOP
};
Quit:
PUBLIC
PROC [message: Rope.
ROPE] = {
ERROR quit[message]
};
RegisterCommand:
PUBLIC
ENTRY
PROC [key:
ATOM, proc: CommandProc, technology:
CD.Technology, queue: QueueMethod, setWDir:
BOOL←
TRUE, registrationData:
REF←
NIL] = {
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, registrationData: registrationData, setWDir: setWDir]]];
};
ImplementCommand:
PUBLIC
PROC [key:
ATOM, proc: CommandProc, technology:
CD.Technology, queue: QueueMethod, registrationData:
REF←
NIL] = {
RegisterCommand[key, proc, technology, queue, FALSE, registrationData];
};
FetchRegistration:
PROC [key:
ATOM, technology:
CD.Technology, load:
BOOL←
TRUE]
RETURNS [reg: Registration] = {
Fetch:
PROC[key:
ATOM, technology:
CD.Technology]
RETURNS [reg: 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]];
};
reg ← Fetch[key, technology];
IF reg=
NIL
AND load
THEN {
CDEnvironment.ExecFileEntry[Atom.GetPName[key], technology, "cmds",
FALSE,
FALSE !
ABORTED => 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;
];
reg ← Fetch[key, technology];
};
};
FetchCommand:
PUBLIC
PROC[key:
ATOM, technology:
CD.Technology, load:
BOOL←
TRUE]
RETURNS [proc: CommandProc←
NIL, qm: QueueMethod𡤍ontQueue, registrationData:
REF←
NIL] = {
reg: Registration ← FetchRegistration[key, technology, load];
IF reg#NIL THEN {proc←reg.p; qm←reg.qm; registrationData←reg.registrationData};
};
Call:
PROC [ic:
REF InternalRec] =
INLINE {
IF ic.qm=useDefault THEN ic.qm ← ic.reg.qm;
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],
reg: NEW[RegistrationRec←[p: 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],
qm: queue
]];
IF comm#NIL THEN ic.comm^ ← comm^;
IF key#NIL THEN ic.comm.key ← key;
IF design#NIL THEN ic.comm.design ← design;
ic.reg ← FetchRegistration[ic.comm.key, ic.comm.design.technology, TRUE];
IF ic.reg=NIL THEN ic.reg ← unKnownRegistration;
Call[ic]
};
RecheckEdited:
PROC [design:
CD.Design] = {
[] ← CDEvents.ProcessEvent[recheckEditedRequest, design];
};
SetEdited:
PUBLIC
PROC [design:
CD.Design, edited:
BOOL] = {
was: BOOL ← design.edited;
IF edited THEN IF design.mutability#editable THEN ErrorChangeReadOnlyDesign[design];
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 {
IF design.mutability#editable THEN ErrorChangeReadOnlyDesign[design];
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 {
IF design.mutability#editable THEN ErrorChangeReadOnlyDesign[design];
design.actual.first.specific.changed ← TRUE;
design.changedSinceSaving ← TRUE;
design.edited ← TRUE;
TRUSTED {Process.Detach[FORK RecheckEdited[design]]};
}
};
WaitInitialization:
ENTRY
PROC [sPriv:
REF PrivateSequencerDRep] = {
IF sPriv=NIL OR sPriv.notInit THEN WAIT reCheck
};
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 CD.Error[calling];
design.cdSequencerPriv.abortFlags ← CONS[flag, design.cdSequencerPriv.abortFlags];
};
BackgroundSaveProcess:
PROC = {
ProtectedSaveOneDesign:
PROC [design:
CD.Design] = {
de: REF PrivateSequencerDRep = design.cdSequencerPriv;
done: BOOL ← FALSE;
done ← CDIO.WriteDesign[design: design, to: NIL, quiet: TRUE, emergency: FALSE, stop: de.stopWrite ! TokenIO.Stopped, RuntimeError.UNCAUGHT => GOTO oops];
IF done
THEN {
de.lastOutput ← BasicTime.Now[];
design.changedSinceSaving ← FALSE;
}
EXITS oops => NULL;
};
CheckDesignForSave: CDPrivate.DesignEnumerator = {
ENABLE RuntimeError.UNCAUGHT => GOTO oops; --give the next design a chance
Process.Pause[1]; -- little bit slower for the benefit of the viewer redraw
IF design#
NIL
THEN {
de: REF PrivateSequencerDRep = design.cdSequencerPriv;
IF design.changedSinceSaving
AND de#
NIL
AND de.whileCommand=0
AND BasicTime.Period[from: de.lastCommand, to: now]>2
AND BasicTime.Period[from: de.lastOutput, to: de.lastCommand]>savePeriod
AND CDProperties.GetDesignProp[design, $CDxDontBackgroundSave]#$TRUE
THEN {
--CedarProcess.SetPriority[CedarProcess.Priority[normal]]; --so stops quickly if necessary
IF EnterOutput[de]
THEN
ProtectedSaveOneDesign[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];
UserProfile.CallWhenProfileChanges[NoteProfileChange];
TRUSTED {Process.Detach[FORK BackgroundSaveProcess[]]};
END.