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_0, --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,
changedSinceOutput: BOOL_FALSE,
lastCommand: BasicTime.GMT, 
lastOutput: BasicTime.GMT,
num: INT_0
];

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
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;

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;
};

KillCommand: ENTRY PROC [x: REF PrivateSequencerDRep] RETURNS [killSelf: BOOL_FALSE] = TRUSTED {
ENABLE UNWIND => NULL;
};

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_dontQueue] = {

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_cd.p; qm_cd.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]]; 
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. 


ΠCDSequencerImpl.mesa   (part of ChipNDale)
Copyright c 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
process: PROCESS, --valid during whileCommand>0  the compiler didn't want that
--using a RefTab is ok: we approximately know the number of entries
--we wont use it-- x.process _ LOOPHOLE[Process.GetCurrent[]];
--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];
}; 

--set priority high enough to stop quickly if necessary
Κ“˜
codeš
œ*™*Kšœ
Οm
œ7™BKš
œ4™4K™AK˜—š
Οk	˜	K˜Kš
œ
˜
Kš
œ
˜
Kšžœ
˜Kšœžœ˜$Kšœ	žœT˜bKš
œ˜Kšœžœ˜"Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ+˜8Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
žœžœ˜Kš
œ˜Kš
œ˜Kšœžœ6˜G—K˜šΟbœžœ
žœ
˜Kšžœ7žœžœa˜»
Kšžœ!žœ˜-—Kš
ž˜K˜Kšœ	žœ˜$Kšœ
žœ˜,Kšœ
žœ˜,K˜šœžœ
žœžœ˜,Kš
œ˜KšœžœΟc:˜OKšœ
žœ
žœ 3˜LKšœžœ
žœ
˜Kšœžœ
žœ
˜Kšœ	žœ
žœ
˜Kšœ	žœ <™NKšœžœ
žœ
˜Kšœžœ˜Kšœžœ
˜Kšœžœ˜
Kš
œ˜—K˜šœžœ
žœžœ˜,K˜K˜—K˜Kšœžœžœ˜)Kšœžœžœ#˜AKšœ
žœžœ5˜OK˜šœ1 *˜[Kš
œC™C—Kšœžœžœžœ ,˜QKšœžœ˜Kšœžœ ˜4Kšœžœ˜K˜š
Οnœžœ
žœžœžœ˜AKšžœ
žœžœ
˜Kš œ
žœ™>Kš
œ"˜"K˜—K˜š
‘œžœ
žœžœžœ˜AKšžœ
žœžœ
˜Kš
œ"˜"K˜—K˜š‘œžœ
žœžœžœžœ
žœžœ˜`Kšžœ
žœžœ
˜K™=šžœžœ™Kš
œ*™*šžœžœ
™Kšœ'žœžœ™=—Kš
œ™—K˜—K˜š‘œžœ
žœžœžœ	žœ
žœ˜UKšžœ
žœžœ
˜Kšžœžœž˜5K˜—K˜šΠbnœ˜/šœžœžœ˜;Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kš
œ˜Kš
œ˜Kš
œ˜—K˜šŸœ˜-Kšœžœžœ˜ Kšœžœ=˜WKš
œ˜—K˜š‘œžœ ˜4šœ
žœžœ
ž	˜!Kšœžœ˜Kšœ	žœ˜Kšžœ˜#—Kš
œ8˜8Kš
œ˜—K˜š‘œžœ
žœ˜!šžœžœ˜Kšžœ%žœ˜EKš
œ˜Kš
œ˜—K˜—K˜š	‘œžœžœ
žœ )˜Ošžœ˜Kšžœžœ˜/Kšœžœ˜#KšœCžœ˜NKš
œ˜—Kšœžœžœ˜"Kšžœžœ˜(šžœ˜Kšœžœ7˜>Kšžœžœ
žœ
žœ
˜Kš
œ˜š
ž˜Kšžœ
žœ˜"šžœž˜Kš
œ˜Kšžœžœ˜'Kšžœ
˜—Kš
œ˜šžœžœ˜šžœžœ&žœ
˜GKš
œ˜—Kš
œ˜—Kšžœ.žœ9˜mKšœžœ
˜Kš
œ˜Kšžœ
˜—Kš
œ˜Kš
œ˜—Kš
œ*˜*Kšžœ	ž˜Kš
œ˜—K˜š‘œžœ
žœžœ˜*Kšžœ˜Kš
œ˜—K˜š‘œžœ
žœ
žœžœ!žœ$˜uKšžœ
žœžœ˜Kš
œ˜Kšžœžœ
žœ/˜EKšœžœ*˜KKš
œ˜—K˜š‘œžœ
žœžœžœ
žœžœ ˜~K˜š‘œžœžœžœ
žœžœ˜cšžœžœ
žœ
 )˜BKšœžœ3˜<Kš
œ9˜9Kš
žœžœ
žœ
žœžœ˜%Kš
œ˜—Kšžœžœ$˜2Kš
œ˜—K˜Kš
œ6˜6šžœžœ
žœ˜š
œC˜Cšœžœ˜šžœ˜Kš
œ˜Kšœžœ&˜2Kš
œ1˜1KšœžœB˜QKšœž˜Kšœžœ
˜Kšœžœ
˜Kšžœžœ
˜——Kš
œ˜—Kš
œ(˜(K˜—Kšžœžœ
žœ˜%Kš
œ˜—K˜š‘œžœžœžœ˜+Kšžœžœ˜+šžœ˜šžœ(ž˜/Kš
œ2˜2Kšžœ
˜—Kš
œQ˜QK˜
—K˜—K˜š‘œžœ
žœžœ;˜ršœžœžœ˜'Kšœžœ˜"Kš	œžœžœ
žœžœ˜0Kš
œ	˜	Kš
œ˜—Kšžœžœ
žœ˜"Kšžœžœ
žœ˜+Kš
œ˜Kš
œ˜—K˜š
‘œžœ
žœžœ
žœ;˜mšœžœžœ˜'Kšœžœ˜"Kšœžœ
˜
Kš
œ˜Kš
œ˜—Kšžœžœ
žœ˜"Kšžœžœ
žœ˜"Kšžœžœ
žœ˜+Kš
œH˜Hšžœ	žœ
žœ˜Kš
œ,˜,K˜—Kšžœ%˜'Kš
œ˜Kš
œ˜—K˜š‘œžœ
žœ˜$Kš
œ5˜5K˜—K˜š‘œžœ
žœ
žœ˜6šžœžœž
œžœ˜TKšœž
œž˜1Kšžœžœ˜.K˜
—Kš
œ˜—K˜š‘œžœ
žœ
žœ˜0šžœžœž
œžœ˜TKšœž˜#Kšœž
œž˜1Kšžœžœ˜.K˜
—Kš
œ˜—K˜šŸœ˜(šžœžœ
žœ
˜Kšœ,ž˜1—Kš
œ˜—K˜Kšœ	ž	œ(˜:K˜š‘œžœ
žœ	žœ˜DKš
žœžœ
žœžœ
žœ˜/Kš
œ˜—K˜š
‘œžœ
žœ
žœ
žœ˜7š‘œž
œ˜Kšœ!žœ
˜'Kšž	œ˜Kš
œ˜—Kšœžœžœ
˜*Kš
œ˜—K˜š’œžœ
žœ
žœ˜8Kšžœžœ
žœ*žœ
˜@šžœ˜Kšœžœ/˜6Kšœžœ
˜Kš
œ1˜1Kš
œ˜Kšžœžœ
žœ
ž˜.K˜—Kš
œ˜—K˜š‘œžœ
žœ
žœ	žœžœ˜;Kšžœ˜%Kš
œ˜—K˜š‘œžœ
žœ
žœ˜1Kšžœžœ˜=Kšœžœ˜Kš
œ˜K™—š‘œžœ˜K˜š‘
œžœ
žœ˜+Kšœžœ/˜6Kšœ
žœžœ
˜šœžœ˜(Kšœžœ5žœžœžœžœžœžœžœ˜š
Kšœžœ˜
Kšœž˜Kšœ'žœžœžœ
˜IKš
œ˜—Kšžœžœ˜%šžœ
žœžœ˜Kš
œ ˜ Kš
œ˜K˜
—Kš
œ˜K˜—š‘œ ˜2Kšžœžœžœ ˜JKšœ B˜Tšžœžœ
žœ˜Kšœžœ0˜7šžœžœ
žœ˜ Kšžœ4˜7KšžœF˜I—šžœ˜š
œ9˜9Kš
œ7™7—šžœžœ
˜Kšœ$žœžœ˜:—Kšœž˜K˜—Kšœ= ˜VKš
œ˜—Kšžœ	žœ
˜Kš
œ˜—K˜šžœ
 
˜
Kš
œ˜Kš
œ)˜)Kšžœžœ/˜DKšžœ
˜—Kš
œ˜K˜—K˜šŸœ$˜5Kš
œI˜IKš
œ˜—K˜Kš
œN˜NKš
œV˜VKš
œG˜GKš
œF˜FKš
œ;˜;Kš
œ6˜6Kšžœžœ˜7Kšžœ˜K˜K˜—…—)::