Google
 

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;