Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/zimula.sim
There is 1 other file named zimula.sim in the archive. Click here to see a list.
OPTIONS(/E/C/-W);
EXTERNAL PROCEDURE abort;
EXTERNAL TEXT PROCEDURE upcase,conc,puttime,putfloat,today,daytime;
EXTERNAL CLASS zimset;
zimset CLASS zimulation;
!;HIDDEN traceon_zimset,traceoff_zimset;
HIDDEN PROTECTED event_notice,sqs,first_ev,main_,
main_program,process_temp
!; ,mp_title,timefield1,timefield2,timefield3
!; ,oldtime,activate_,trace,process_count
;
BEGIN
link CLASS event_notice(ev_time,proc_);
REAL ev_time; REF (process) proc_;
BEGIN
REF (event_notice) PROCEDURE ev_suc;
IF suc IS event_notice THEN ev_suc:- suc;
PROCEDURE rank(before_); BOOLEAN before_;
BEGIN REF (event_notice) p;
p:- sqs.last;
WHILE p.ev_time > ev_time DO p:- p.prev;
IF before_ THEN
BEGIN
WHILE p.ev_time = ev_time DO p:- p.prev;
END;
follow(p);
END of rank;
END of event notice;
link CLASS process_temp;
PROTECTED i_terminated;
BEGIN
REF (event_notice) event_; BOOLEAN i_terminated;
!; TEXT process_title;
!; TEXT PROCEDURE title; title:- process_title;
!;
BOOLEAN PROCEDURE terminated;
terminated:= i_terminated;
BOOLEAN PROCEDURE idle;
idle:= event_ == NONE;
REAL PROCEDURE evtime;
IF idle THEN abort("Evtime of Idle Process") ELSE
evtime:= event_.ev_time;
REF (process) PROCEDURE nextev;
nextev:-
IF idle THEN NONE ELSE
IF event_.ev_suc == NONE THEN NONE ELSE
event_.ev_suc.proc_;
!; process_title:- Copy("(***)").Sub(2,3);
!; process_count:= process_count + 1;
!; process_title.Putint(process_count);
!; process_title:- process_title.Main;
Detach;
INNER;
i_terminated:= TRUE;
passivate;
abort("Activation of Terminated Process");
END of process temporarily defined;
process_temp CLASS process;
HIDDEN i_terminated;
BEGIN
event_: ;
END of process;
REF (event_notice) PROCEDURE first_ev;
first_ev:- sqs.first;
REF (process) PROCEDURE current;
current:- first_ev.proc_;
REAL PROCEDURE time;
time:= first_ev.ev_time;
PROCEDURE hold(t); REAL t;
INSPECT first_ev DO
BEGIN
IF t > 0 THEN
!; BEGIN REAL oldt; oldt:= ev_time;
!; IF trace[1] THEN
!; report(' ',proc_.title,conc(" Held",
!; puttime(timefield1,t,timeunit,secdec)," to",
!; puttime(timefield3,ev_time+t,timeunit,secdec)));
ev_time:= ev_time + t;
!; IF oldt = ev_time THEN
!; report('!',proc_.title," Hold arg. UNDERFLOW");
!; END;
IF ev_suc =/= NONE THEN
BEGIN
IF ev_suc.ev_time <= ev_time THEN
BEGIN out; rank(FALSE);
Resume(current);
END
END
END of hold;
PROCEDURE passivate;
BEGIN
INSPECT current WHEN process_temp DO
BEGIN
!; IF trace[2] THEN
!; report(' ',title," Passivated");
event_.out; event_:- NONE
END;
IF sqs.empty THEN abort("Passivating last Process in SQS")ELSE
Resume(current);
END of passivate;
PROCEDURE wait(s); REF (head) s;
BEGIN
current.into(s); passivate
END of wait;
PROCEDURE cancel(x); REF (process) x;
IF x == current THEN passivate ELSE
INSPECT x WHEN process_temp DO
IF event_ =/= NONE THEN
BEGIN
!; IF trace[3] THEN
!; report(' ',title,conc(" Cancelled - Evtime ",
!; puttime(timefield1,event_.ev_time,timeunit,secdec)));
event_.out; event_:- NONE
END of cancel
ELSE !;
!; report('?',title," Cancelled (was not scheduled)")
!; OTHERWISE
!; report('?',Copy("NONE")," couldn't be Cancelled")
;
PROCEDURE activate_(reac,x,code,t,y,prior_);
VALUE code; TEXT code;
REF (process_temp) x,y; BOOLEAN reac,prior_; REAL t;
INSPECT x DO
IF NOT terminated THEN
BEGIN REF (process_temp) z; REF (event_notice) ev;
IF reac THEN ev:- event_ ELSE
IF event_ =/= NONE THEN
!; BEGIN
!; report('?',title,conc(" unsucc. ACT. - already sched. at",
!; puttime(timefield1,event_.ev_time,timeunit,secdec)));
GO TO exit;
!; END;
z:- current;
IF upcase(code) = "DIRECT" THEN
direct: BEGIN
!; IF trace[4] THEN
!; report(' ',title," ACTIVATED");
event_:- NEW event_notice(time,x);
event_.precede(first_ev)
END direct ELSE
IF code = "DELAY" THEN
BEGIN
!; REAL oldt; oldt:= t;
t:= t + time;
!; IF time = t AND oldt > 0 THEN
!; report('!',title," DELAY arg. UNDERFLOW");
GO TO at_
END delay ELSE
IF code = "AT" THEN
at_: BEGIN
IF t < time THEN
!; BEGIN
!; report('?',title,conc(" Time > AT-arg: ",
!; puttime(timefield1,t,timeunit,secdec)));
t:= time;
!; END;
IF t = time AND prior_ THEN GO TO direct;
!; IF trace[5] THEN
!; BEGIN
!; IF t = time THEN
!; report(' ',title,conc(
!; IF code = "AT" THEN Copy(" will be ACT. AT Time (Now) ") ELSE
!; Copy(" will be ACT. Delay 0 "),
!; IF prior_ THEN Copy(" PRIOR") ELSE NOTEXT)) ELSE
!; report(' ',title,conc(
!; IF code = "AT" THEN Copy(" will be ACT. AT ") ELSE
!; Copy(" will be Delayed to"),
!; puttime(timefield1,t,timeunit,secdec),
!; IF prior_ THEN Copy(" PRIOR") ELSE NOTEXT));
!; END trace[5] on;
event_:- NEW event_notice(t,x);
event_.rank(prior_);
END at ELSE
IF (IF y == NONE THEN TRUE ELSE y.event_ == NONE) THEN
!; BEGIN
!; report('?',title,conc(" Passivated due to ACT. ",code,
!; IF y == NONE THEN Copy(" NONE") ELSE
!; conc(" Idle obj. ",y.title)));
event_:- NONE
!; END
ELSE
IF (IF code = "AFTER" THEN TRUE ELSE code = "BEFORE") THEN
BEGIN
IF x == y THEN
!; BEGIN
!; report('?',title,conc(" unsucc. ACT. ",code," itself"));
GO TO exit;
!; END;
! Reactivate x before/after y;
!; IF trace[6] THEN
!; report(' ',title,conc(" ACT. ",code," ",y.title," sched. at",
!; puttime(timefield1,y.event_.ev_time,timeunit,secdec)));
event_:- NEW event_notice(y.event_.ev_time,x);
IF code = "BEFORE" THEN event_.precede(y.event_) ELSE
event_.follow(y.event_);
END before or after ELSE
abort(conc("Illegal parm. to ACTIVATE - Code: ",code));
IF ev =/= NONE THEN
BEGIN
!; IF trace[7] THEN
!; report(' ',title,conc(" was REACT. from ",
!; puttime(timefield1,ev.ev_time,timeunit,secdec)));
ev.out;
IF sqs.empty THEN abort("SQS Empty")
END;
IF z =/= current THEN Resume(current);
exit:
END of activate
ELSE !;
!; report('?',Copy(" (TERM.OBJ) ")," Attempt to ACT. terminated object")
!; OTHERWISE
!; report('?',Copy("NONE"),conc(" couldn't be ",
!; IF reac THEN Copy("RE") ELSE NOTEXT,"ACTIVATED"))
;
PROCEDURE reactivat(x,code,t,y);
NAME code; REF (process_temp) x,y; TEXT code; REAL t;
BEGIN
activate_(TRUE,x,code,t,y,prior_); prior_:= FALSE;
END of reactivat;
PROCEDURE activat(x,code,t,y);
NAME code; REF (process_temp) x,y; TEXT code; REAL t;
BEGIN
activate_(FALSE,x,code,t,y,prior_); prior_:= FALSE;
END of activat;
BOOLEAN prior_;
PROCEDURE accum(a,b,c,d); NAME a,b,c; REAL a,b,c,d;
BEGIN a:= a + c*(time-b);
b:= time; c:= c + d
END of accum;
process CLASS main_program;
BEGIN
!; TEXT PROCEDURE title; title:- mp_title;
l: Detach; GO TO l
END of main program;
REF (process) PROCEDURE main; main:- main_;
REF (main_program) main_;
REF (head) sqs;
!; PROCEDURE sqslist;
!; INSPECT tracefile DO
!; BEGIN REF (event_notice) en;
!; Outimage;
!; Outtext(":---- Scheduled Processes ----"); Outimage;
!; Outchar(':'); Setpos(timefield1.Length-4);
!; Outtext("Evtime Title"); Outimage;
!; FOR en:- sqs.first QUA event_notice,
!; en.suc WHILE en =/= NONE DO
!; BEGIN Outchar(':');
!; Outtext(puttime(timefield1,en.ev_time,timeunit,secdec));
!; Setpos(Pos+4); Outtext(en.proc_.title); Outimage;
!; END loop;
!; Outtext(":---- End of SQS List --------"); Outimage;
!; Outimage;
!; END of sqslist;
!;
!; TEXT PROCEDURE now;
!; ! NOW returns leading part of messages.
!; ! Should end with blank;
!; BEGIN
!; IF Time > oldtime THEN
!; BEGIN oldtime:= Time;
!; puttime(timefield2,oldtime,timeunit,secdec);
!; END ELSE timefield2:= NOTEXT;
!; now:- timefield2.Main
!; END of now;
!; PROCEDURE traceon(filespec,dotrace);
!; VALUE filespec,dotrace; TEXT filespec,dotrace;
!; BEGIN CHARACTER c;
!; IF dotrace = "*" THEN
!; BEGIN INTEGER i;
!; FOR i:= 1 STEP 1 UNTIL 7 DO trace[i]:= TRUE;
!; dotrace.Setpos(0); ! Inhibit WHILE loop on dotrace;
!; END ELSE upcase(dotrace);
!; WHILE dotrace.More DO
!; BEGIN c:= dotrace.Getchar;
!; IF c = 'H' THEN trace[1]:= TRUE ELSE
!; IF c = 'P' THEN trace[2]:= TRUE ELSE
!; IF c = 'C' THEN trace[3]:= TRUE ELSE
!; IF c = 'D' THEN trace[4]:= TRUE ELSE
!; IF c = 'A' THEN trace[5]:= TRUE ELSE
!; IF c = 'B' THEN trace[6]:= TRUE ELSE
!; IF c = 'R' THEN trace[7]:= TRUE;
!; END loop;
!; traceon_zimset(filespec,dotrace);
!; END of traceon;
!;
!; PROCEDURE traceoff;
!; BEGIN INTEGER i;
!; FOR I:= 1 STEP 1 UNTIL 7 DO
!; trace[i]:= FALSE;
!; traceoff_zimset;
!; END of traceoff;
!;
!; PROCEDURE setparms(unit,dec); CHARACTER unit; INTEGER dec;
!; BEGIN
!; IF unit = 'd' THEN unit:= 'D' ELSE
!; IF unit = 'h' THEN unit:= 'H' ELSE
!; IF unit = 'm' THEN unit:= 'M' ELSE
!; IF unit = 's' THEN unit:= 'S';
!; timeunit:= unit;
!; secdec:= dec;
!; timefield2:-
!; Blanks(IF secdec < 0 THEN 13 ELSE
!; IF secdec = 0 THEN 16 ELSE secdec + 17);
!; timefield1:- Blanks(timefield2.Length-1);
!; timefield3:- Blanks(timefield1.Length);
!; ! Note - one extra blank at end of timefields.;
!; timefield2:- timefield2.Sub(1,timefield2.Length-1);
!; END of setparms;
!;
!; TEXT timefield1,timefield2,timefield3,mp_title;
!; CHARACTER timeunit; INTEGER secdec,process_count;
!; BOOLEAN ARRAY trace[1:7];
!; REAL oldtime;
!; setparms('M',-1); oldtime:= -1;
!;
!; mp_title:- Copy("Main Program");
sqs:- NEW head;
main_:- NEW main_program;
INSPECT main_ WHEN process_temp DO
BEGIN
event_:- NEW event_notice(0,main_);
event_.into(sqs);
END;
INNER;
!; IF sqs.first =/= sqs.last THEN
!; BEGIN TEXT t;
!; t:- Blanks(5);
!; t.Putint(sqs.cardinal);
!; report('!',t," Remaining Processes in SQS");
!; END sqs not empty;
!; traceoff;
!!!; now; ! Dummy call as temp fix;
END of zimulation;