Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/util/gpsss1.sim
There is 1 other file named gpsss1.sim in the archive. Click here to see a list.
00010	OPTIONS(/E);
00020	Simulation  CLASS GPSSS1(max_queues,max_stations,max_storages,
00030	unit,secdec);
00040	INTEGER max_queues,max_stations,max_storages,secdec;
00050	CHARACTER unit;
00060	BEGIN
00070	    COMMENT **************************************************
00080	    MONTREAL  GPSSS PACKAGE + VERSION 4.1 +
00090	    WRITTEN - FEBRUARY 1972
00100	    UPDATED - SEPTEMBER 1974
00110	    AUTHOR  - JEAN G. VAUCHER
00120	    PROFESSEUR AGREGE
00130	    DEPARTEMENT D INFORMATIQUE
00140	    UNIVERSITE DE MONTREAL
00150	    C.P. 6128 , MONTREAL 101
00160	    CANADA
00170	    CONVERTED TO DECSYSTEM 10 - JUNE 1976
00180	    BY H-JOACHIM BOSE
00190	    **********************************************************;
00200	    REF (facility)  ARRAY  station (1:max_stations  );
00210	    REF (storage )  ARRAY  box     (1:max_storages);
00220	    REF (q       )  ARRAY  file    (1:max_queues)  ;
00230	    TEXT field;
00240	    REAL bbegin_time;
00250	    INTEGER  transid  ;
00260	    INTEGER  nstat, nstor, nque, passe ;
00270	    COMMENT **************************************************
00280	    FACILITY DEFINITION
00290	    **********************************************************;
00300	    CLASS  facility;
00310	    BEGIN
00320		REF (Head) inq;
00330		REF (transaction) occupier;
00340		INTEGER  entries ;
00350		REAL  tlast, busy_time ;
00360		BOOLEAN   PROCEDURE  busy;
00370		busy := occupier =/=  NONE ;
00380		inq :-  NEW  Head ;
00390		tlast := time_origin ;
00400	    END  FACILITY DEFINITION;
00410	    COMMENT **************************************************
00420	    STORAGE DEFINITION
00430	    **********************************************************;
00440	    CLASS  storage (capacity);
00450	    INTEGER  capacity;
00460	    BEGIN
00470		REF (Head) inq;
00480		INTEGER max,entries,unit_entries; REAL contents;
00490		REAL  tlast, intgrl;
00500		PROCEDURE  check_inq;
00510		BEGIN
00520		    REF (transaction) client, next_client;
00530		    client :- inq.First;
00540		    loop:
00550		    IF  client ==  NONE   OR  contents=  capacity
00560		    THEN  GOTO  fin;
00570		    next_client :- client.Suc ;
00580		    ACTIVATE  client ;
00590		    client :- next_client;
00600		    GOTO  loop;
00610		    fin:
00620		END  OF CHECK_INQ ;
00630		inq :-  NEW  Head ;
00640		tlast := time_origin ;
00650	    END  STORAGE DEFINITION ;
00660	    COMMENT ************
00670	    STORAGE CREATION
00680	    ********************;
00690	    PROCEDURE  set_storage (n,capacity);
00700	    INTEGER  n, capacity;
00710	    BEGIN
00720		nstor := nstor + 1 ;
00730		box (n) :-  NEW  storage (capacity);
00740	    END ;
00750	    COMMENT **************************************************
00760	    QUEUE DEFINITION
00770	    **********************************************************;
00780	    CLASS   q ;
00790	    BEGIN
00800		INTEGER  entries, max ;
00810		REAL  intgrl, tlast, contents;
00820		tlast := time_origin ;
00830	    END ;
00840	    COMMENT ***********************************************
00850	    PUTTIME DEFINITION
00860	    *******************************************************;
00870	    TEXT PROCEDURE puttime(Time);
00880	    REAL Time;
00890	    IF field.Length >=
00900	    (IF secdec < 0 THEN 12 ELSE IF secdec = 0 THEN 15 ELSE secdec+16)
00910	    THEN
00920	    BEGIN   INTEGER days,hours,m,powersec;   REAL seconds;
00930	
00940		PROCEDURE fixedit(x,w);   REAL x;   INTEGER w;
00950		BEGIN
00960		    field.Sub(field.Pos,w).Putfix(
00970		    x,IF secdec>=0 THEN secdec ELSE 0);
00980		    field.Setpos(field.Pos+w);
00990		END of fixedit;
01000	
01010		PROCEDURE intedit(i,w);   INTEGER i,w;
01020		BEGIN
01030		    field.Sub(field.Pos,w).Putint(i);
01040		    IF field.Getchar = ' ' THEN
01050		    BEGIN   field.Setpos(field.Pos-1);
01060			field.Putchar('0');
01070		    END;
01080		    field.Setpos(field.Pos-1+w);
01090		END of intedit;
01100	
01110		BOOLEAN PROCEDURE adjusted;
01120		BEGIN
01130		    IF m = 60 THEN
01140		    BEGIN   adjusted:= TRUE;
01150			hours:= hours + 1;   m:= 0;
01160			IF hours = 24 THEN
01170			BEGIN   days:= days + 1;   hours:= 0   END
01180		    END;
01190		    field.Sub(2,6):= "   D  ";
01200		    field.Setpos(5);
01210		    IF days < 1 THEN
01220		    field.Putchar(' ') ELSE
01230		    IF days < 10 THEN
01240		    BEGIN
01250			field.Setpos(4);
01260			field.Putchar(Char(days+Rank('0')));
01270		    END ELSE
01280		    IF days < 100 THEN
01290		    BEGIN   field.Setpos(3);   intedit(days,2)   END ELSE
01300		    IF days < 1000 THEN
01310		    BEGIN   field.Setpos(2);   intedit(days,3) END ELSE
01320		    field.Sub(2,3):= "***";
01330		    field.Setpos(8);
01340		    intedit(hours,2);   field.Putchar(':');
01350		END of adjust;
01360	
01370		powersec:= 1;
01380		FOR m:= 1 STEP 1 UNTIL secdec DO powersec:= powersec*10;
01390		IF unit = 'D' OR unit = 'd'  THEN Time:= 1440*Time ELSE
01400		IF unit = 'H' OR unit = 'h' THEN Time:= 60*Time ELSE
01410		IF unit = 'S' OR unit = 's' THEN Time:= Time/60;
01420	
01430		field.Setpos(1);
01440		field.Putchar(IF Time < 0 THEN '-' ELSE ' ');
01450		Time:= Abs(Time);
01460		IF Time > 34 359 738 367 THEN GO TO error;
01470		m:= Entier(Time);
01480		seconds:= 60*(Time - m);
01490		hours:= m//60;
01500		m:= Mod(m,60);
01510		days:= hours//24;
01520		hours:= Mod(hours,24);
01530		IF secdec >= 0 THEN
01540		BEGIN
01550		    IF Entier(seconds*powersec+0.5) = 60*powersec THEN
01560		    BEGIN   m:= m + 1;   seconds:= 0   END;
01570		    adjusted;
01580		    intedit(m,2);   field.Putchar('.');
01590		    IF seconds < 9.5 THEN
01600		    BEGIN   field.Putchar('0');
01610			fixedit(seconds,IF secdec = 0 THEN 1 ELSE secdec+2)
01620		    END ELSE
01630		    fixedit(seconds,IF secdec = 0 THEN 2 ELSE secdec+3);
01640		END ELSE
01650		BEGIN   Time:= m + seconds/60;
01660		    m:= Time;
01670		    IF adjusted THEN Time:= 0;
01680		    IF Time < 9.5 THEN   field.Putchar('0');
01690		    fixedit(Time,IF Time < 9.5 THEN 1 ELSE 2)
01700		END;
01710		field.Setpos(1);   puttime:- field
01720	    END of puttime OK ELSE
01730	    error:
01740	    BEGIN   field.Setpos(1);
01750		WHILE field.More DO field.Putchar('*');
01760		field.Setpos(1);
01770		puttime:- field ;
01780	    END of puttime error;
01790	    COMMENT **************************************************
01800	    TRANSACTION DEFINITION
01810	    **********************************************************;
01820	    Process  CLASS  transaction ;
01830	    BEGIN
01840		REAL  time_mark, priority;
01850		INTEGER  id ;
01860		COMMENT ************
01870		ENTER_STATION
01880		********************;
01890		PROCEDURE  enter_station (n);
01900		INTEGER  n ;
01910		BEGIN
01920		    start:
01930		    INSPECT  station(n)  DO
01940		    BEGIN
01950			IF  occupier ==  THIS  transaction  THEN
01960			BEGIN
01970			    erloc := n ;
01980			    erreur(6);
01990			    GOTO  exit;
02000			END ;
02010			IF  busy  THEN   BEGIN
02020			    priority_into(inq);
02030			    Passivate;
02040			    Out;
02050			END   ELSE  tlast := Time;
02060			entries := entries+1;
02070			occupier :-  THIS  transaction;
02080			exit:
02090		    END
02100		    OTHERWISE   BEGIN
02110			station (n) :-  NEW  facility;
02120			nstat := nstat+1;
02130			GOTO  start;
02140		    END ;
02150		END  ENTER_STATION ;
02160		COMMENT ************
02170		LEAVE_STATION
02180		********************;
02190		PROCEDURE  leave_station (n) ;
02200		INTEGER  n ;
02210		BEGIN
02220		    INSPECT  station (n)  WHEN  facility  DO
02230		    BEGIN
02240			IF  occupier =/=  THIS  transaction  THEN
02250			BEGIN
02260			    erloc := n ;
02270			    erreur (3);
02280			    GOTO  exit ;
02290			END ;
02300			IF  inq.Empty  THEN   BEGIN
02310			    occupier :-  NONE ;
02320			    busy_time:=busy_time + Time - tlast;
02330			END
02340			ELSE   BEGIN
02350			    occupier :- inq.First;
02360			    ACTIVATE  inq.First  DELAY  0 ;
02370			END ;
02380			exit:
02390		    END   OTHERWISE   BEGIN
02400			erloc := n ;
02410			erreur(3) ;
02420		    END  ;
02430		END  LEAVE_STATION ;
02440		COMMENT ************
02450		ENTER_STORAGE
02460		********************;
02470		PROCEDURE  enter_storage (n, units_required) ;
02480		INTEGER  n, units_required ;
02490		BEGIN
02500		    IF  box (n) ==  NONE   THEN  set_storage(n,1000000) ;
02510		    INSPECT  box (n)  WHEN  storage  DO
02520		    BEGIN
02530			IF  units_required>capacity  THEN
02540			BEGIN
02550			    erloc := n ;
02560			    erreur (4);
02570			    GOTO  error_exit ;
02580			END ;
02590			priority_into (inq);
02600			test:
02610			IF  units_required <= capacity-contents THEN  GOTO exit;
02620			Passivate;
02630			GOTO  test;
02640			exit:
02650			Out;
02660			entries:=entries+1;
02670			unit_entries:=unit_entries+units_required;
02680			Accum(intgrl,tlast,contents,units_required);
02690			IF  contents>  max  THEN  max := contents;
02700			Hold (0);
02710		    END  INSPECT ;
02720		    error_exit:
02730		END  ENTER_STORAGE;
02740		COMMENT ************
02750		LEAVE_STORAGE
02760		********************;
02770		PROCEDURE  leave_storage (n,units_released);
02780		INTEGER  n,units_released;
02790		INSPECT  box (n)  WHEN  storage  DO
02800		BEGIN
02810		    Accum(intgrl,tlast,contents,-(units_released))	;
02820		    IF  contents<  0  THEN   BEGIN
02830			erloc:=n;
02840			erreur (5);
02850			contents:=  0;
02860		    END   ELSE  check_inq;
02870		END
02880		OTHERWISE  set_storage (n,1000000) ;
02890		COMMENT ************
02900		ENTER_QUEUE
02910		********************;
02920		PROCEDURE  enter_queue (n);
02930		INTEGER  n ;
02940		BEGIN
02950		    IF  file (n) ==  NONE   THEN   BEGIN
02960			file (n) :-  NEW  q;
02970			nque := nque + 1;
02980		    END ;
02990		    INSPECT  file (n)  DO
03000		    BEGIN
03010			entries := entries +1;
03020			Accum (intgrl,tlast,contents,1);
03030			IF  contents>max  THEN  max := contents;
03040		    END  ;
03050		END  ENTER_QUEUE;
03060		COMMENT ************
03070		LEAVE_QUEUE
03080		********************;
03090		PROCEDURE  leave_queue (n) ;
03100		INTEGER  n;
03110		INSPECT  file (n)  DO
03120		IF  contents=  0  THEN   BEGIN
03130		    erloc:= n ;
03140		erreur(7) ;  END
03150		ELSE   Accum (intgrl,tlast,contents,-1)
03160		OTHERWISE   BEGIN
03170		    erloc := n ;
03180		    erreur(8);
03190		    file (n) :-  NEW  q ;
03200		    nque := nque +1 ;
03210		END ;
03220	    COMMENT **************************************************
03230	    BEGIN_TIME DEFINITION
03240	    **********************************************************;
03250	    REAL PROCEDURE begin_time(Time);
03260	    REAL Time;
03270	    BEGIN
03280	    bbegin_time:=60*Entier(Time)+100*(
03290	    Time-Entier(Time));
03300	    begin_time:=bbegin_time ;
03310	    END ;
03320	   INTEGER secdec;
03330	   CHARACTER unit;
03340	    PROCEDURE outtime(u_time); REAL u_time ;
03350	    BEGIN
03360	    TEXT savefield;
03370	    savefield:- field ;
03380	    IF pos + llength > length + 1 THEN outimage ;
03390	    field:- Image.sub(pos,llength);
03400	    puttime(u_time);
03410	    Setpos(pos + llength);
03420	    field :- savefield ;
03430	    END of outtime ;
03440		COMMENT ************
03450		PRIORITY_INTO
03460		********************;
03470		PROCEDURE  priority_into (queue) ;
03480		REF (Head) queue;
03490		BEGIN
03500		    REF (transaction) pt ;
03510		    REF (Process) p ;
03520		    IF  queue.Empty  THEN  Into(queue)
03530		    ELSE   BEGIN
03540			COMMENT  SKIP NON TRANSACTION OBJECTS ;
03550			p:-queue.Last ;
03560			l:  IF  p  IN  transaction  OR  p== NONE   THEN   BEGIN
03570			    pt:-p;
03580			    GOTO  loop;
03590			END ;
03600			p:-p.Pred ;
03610			GOTO  l;
03620			predec:   pt :- pt.Pred ;
03630			loop:      IF  pt== NONE   THEN  Precede(queue.First)
03640			ELSE   IF  priority<pt.priority  THEN  GOTO  predec
03650			ELSE   IF  priority=pt.priority  AND priority<0
03660			THEN   GOTO  predec
03670			ELSE  Follow (pt);
03680		    END ;
03690		END  PROCEDURE PRIORITY_INTO ;
03700		time_mark := gpsss_time ;
03710		transid  := transid  + 1 ;
03720		id := transid  ;
03730	    END  CLASS TRANSACTION ;
03740	    COMMENT *******************************
03750	    WAIT_UNTIL PARAPHENALIA
03760	    ***************************************;
03770	    REF (Head) waitq ;
03780	    REF (wait_monitor) wait_moniteur ;
03790	    BOOLEAN  wait_action ;
03800	    PROCEDURE  wait_until (b);  NAME  b;  BOOLEAN  b ;
03810	    INSPECT  Current  DO   BEGIN
03820		IF  b  THEN   GOTO  exit ;
03830		IF  Current  IN  transaction  THEN
03840		Current  QUA  transaction.priority_into(waitq)
03850		ELSE  Into(waitq);
03860		IF  wait_moniteur.Idle  THEN
03870		ACTIVATE  wait_moniteur  AFTER  Nextev ;
03880		loop:
03890		Passivate;
03900		IF  NOT b THEN  GOTO  loop ;
03910		Out ;
03920		wait_action :=  TRUE  ;
03930		exit:
03940	    END  WAIT_UNTIL ;
03950	    Process  CLASS  wait_monitor ;
03960	    BEGIN
03970		REF (Process) pt ;
03980		start:
03990		IF  waitq.Empty  THEN  Passivate ;
04000		wait_action :=  FALSE  ;
04010		pt :- waitq.First ;
04020		loop:
04030		IF  pt ==  NONE   THEN   GOTO  Wait ;
04040		ACTIVATE  pt ;
04050		IF  wait_action  THEN   GOTO  start ;
04060		pt :- pt.Suc ;
04070		GOTO  loop ;
04080		Wait:
04090		REACTIVATE  Current  AFTER  Nextev ;
04100		GOTO  start ;
04110	    END  WAIT_MONITOR ;
04120	    COMMENT
04130	    ******************************
04140	    PROCEDURES UTILITAIRES
04150	    ******************************;
04160	    PROCEDURE  skip (n) ;
04170	    INTEGER  n;
04180	    BEGIN
04190		Outimage;
04200		IF  n>0  THEN   BEGIN
04210		    IF  Line+n > 60  THEN  Eject(2)
04220		    ELSE  Eject (Line+n);
04230		END ;
04240	    END  PROC SKIP;
04250	    REAL   PROCEDURE  gpsss_time ;
04260	    gpsss_time := Time- simulation_start_time ;
04270	    PROCEDURE  clear_sqs ;
04280	    l1:  IF  Current.Nextev =/=  NONE   THEN
04290	    BEGIN
04300		Cancel (Current.Nextev) ;
04310		GOTO  l1 ;
04320	    END  ;
04330	    PROCEDURE  restart ;
04340	    BEGIN
04350		INTEGER  i ;
04360		IF  Current =/= Main  THEN   BEGIN
04370		erreur(9) ;  GOTO  Out ;  END  ;
04380		error_report ;
04390		standard_report ;
04400		passe := passe + 1 ;
04410		COMMENT  CANCEL ALL RESOURCES ;
04420		FOR  i := 1  STEP  1  UNTIL  max_stations  DO
04430		station (i) :-  NONE  ;
04440		FOR i := 1  STEP  1  UNTIL  max_storages  DO
04450		box     (i) :-  NONE  ;
04460		FOR  i := 1  STEP  1  UNTIL  max_queues  DO
04470		file    (i) :-  NONE  ;
04480		COMMENT  CANCEL ALL EVENTS ;
04490		clear_sqs ;
04500		simulation_start_time := Time ;
04510		nstat := nstor := nque := 0 ;
04520		transid  := 0 ;
04530		u := 987654321 ;
04540		Out:
04550	    END  ;
04560	    COMMENT *****************************************
04570	    ENQUIRY PROCEDURES
04580	    *************************************************;
04590	    INTEGER   PROCEDURE  contents_station(n) ;
04600	    INTEGER  n ;
04610	    INSPECT  station(n)  DO
04620	    IF  busy  THEN  contents_station := 1 ;
04630	    INTEGER   PROCEDURE  contents_storage (n) ;
04640	    INTEGER  n ;
04650	    INSPECT  box (n)  DO
04660	    contents_storage := contents;
04670	    INTEGER   PROCEDURE  contents_queue (n) ;
04680	    INTEGER  n ;
04690	    INSPECT  file (n)  DO
04700	    contents_queue := contents  ;
04710	    INTEGER   PROCEDURE  waiting_station (n) ;
04720	    INTEGER  n ;
04730	    INSPECT  station (n)  DO
04740	    waiting_station := inq.Cardinal ;
04750	    INTEGER   PROCEDURE  waiting_storage (n) ;
04760	    INTEGER  n ;
04770	    INSPECT  box (n)  DO
04780	    waiting_storage := inq.Cardinal ;
04790	    INTEGER   PROCEDURE  waiting_queue (n) ;
04800	    INTEGER  n ;
04810	    waiting_queue := 0 ;
04820	    PROCEDURE  standard_report ;
04830	    BEGIN
04840		INTEGER  i;
04850		BOOLEAN  sbus;
04860		REAL  dtime;
04870		dtime := Time-time_origin;
04880		skip(100);
04890		Outtext("***************************");
04900		Outtext("    -VERSION 4.1-")  ; Outimage ;
04910		Outtext("***   MONTREAL  GPSSS   ***");  skip(0) ;
04920		Outtext("***  SIMULATION REPORT  ***");
04930		skip(0); Outtext("***************************");
04940		skip(2);
04950		Outtext("PASSE  =")  ;
04960		Outint(passe,3) ;
04970		skip(1) ;
04980		Outtext("START  TIME=");
04990		field:-Image.Sub(13,llength);
05000		puttime(time_origin-simulation_start_time
05010		+bbegin_time ) ;
05020		skip(0);
05030		Outtext("END    TIME=");
05040		puttime(gpsss_time + bbegin_time);
05050		IF  dtime=0  THEN   BEGIN
05060		    skip(2);
05070		    Outtext("ELAPSED  TIME = 0 - REPORT SKIPPED")  ;
05080		    GOTO  exit ;
05090		END ;
05100		skip(2);
05110		IF  nstat=0  THEN   BEGIN
05120		    Outtext("* NO STATIONS *");
05130		    GOTO  l1;
05140		END ;
05150		Outtext("* STATIONS *");
05160		skip(0); Outtext("************");
05170		skip(1);
05180		Setpos(15);
05190		Outtext("AVERAGE");
05200		Setpos(38);
05210		Outtext("AVERAGE");
05220		skip(0);
05230		Outtext
05240		("   STATION   UTILISATION  ENTRIES   TRANSIT TIME   STATUS");
05250		skip(1);
05260		field:-Image.Sub(32,llength);
05270		FOR  i:=1  STEP  1  UNTIL  max_stations  DO
05280		INSPECT  station(i)  DO
05290		BEGIN
05300		    sbus := busy ;
05310		    IF  sbus  THEN  busy_time:=busy_time+Time-tlast;
05320		    Outint(i,7);
05330		    Outfix(busy_time/dtime,2,13);
05340		    Outint(entries,10);
05350		    puttime(busy_time/entries);
05360		    Setpos(52);
05370		    IF  sbus  THEN  Outtext("BUSY")
05380		    ELSE  Outtext("FREE");
05390		    COMMENT  RE-INITIALISATION DES STATISTIQUES ;
05400		    IF  sbus  THEN  entries :=1  ELSE  entries :=0 ;
05410		    busy_time := 0;
05420		    tlast := Time;
05430		    skip(0);
05440		END ;
05450		l1:
05460		skip(2);
05470		IF  nstor=0  THEN   BEGIN
05480		    Outtext("* NO STORAGES *");
05490		    GOTO  l2;
05500		END ;
05510		Outtext("* STORAGES *");
05520		skip(0); Outtext("************");
05530		skip(1);
05540		Setpos(23);  Outtext("AVG.");
05550		Setpos(32);  Outtext("AVG.");
05560		Setpos(51);  Outtext("THRU  TIME");
05570		Setpos(67);  Outtext("CONTENTS");
05580		skip(0);
05590		Outtext
05600		("STORAGE   CAPACITY  CONTENTS   UTIL.  ENTRIES  ");
05610		Outtext
05620		("     / UNIT        MAX    NOW");
05630		skip(1);
05640		field:-Image.Sub(46,llength);
05650		FOR i:=1 STEP 1 UNTIL max_storages DO
05660		INSPECT  box(i)  DO
05670		BEGIN
05680		    Accum(intgrl,tlast,contents,0);
05690		    Outint(i,5)  ;
05700		    Outint(capacity,10) ;
05710		    Outfix(intgrl/dtime,2,12) ;
05720		    IF  capacity=0  THEN  Setpos(38)  ELSE
05730		    Outfix(intgrl/(dtime*capacity),4,8);
05740		    Outint(entries,8);
05750		    IF  unit_entries=0  THEN  Setpos(61)  ELSE
05760		    puttime (intgrl/unit_entries);
05770		    Setpos(63);
05780		    Outint(max,7);
05790		    Outint(contents,7);
05800		    skip(0);
05810		    COMMENT  RE-INITIALISATION DES STATISTIQUES ;
05820		    entries := 0;
05830		    unit_entries := contents;
05840		    intgrl := 0 ;
05850		    tlast := Time;
05860		    max := contents;
05870		END ;
05880		l2:
05890		skip(2);
05900		IF  nque=0  THEN   BEGIN
05910		    Outtext("* NO QUEUES *");
05920		    GOTO  exit;
05930		END ;
05940		Outtext("* QUEUES *")  ;
05950		skip(0); Outtext("**********")   ;
05960		skip(1);
05970		Setpos(19); Outtext(
05980		"MAX.     CURRENT     AVG.         AVG.")  ;
05990		skip(0); Outtext(
06000		"QUEUE   ENTRIES  CONTENTS  CONTENTS  CONTENTS     TIME/TRANS");
06010		skip(1);
06020		field:-Image.Sub(46,llength);
06030		FOR  i := 1  STEP  1  UNTIL  max_queues  DO
06040		INSPECT  file (i)  DO
06050		BEGIN
06060		    Accum(intgrl,tlast,contents,0);
06070		    Outint(i,4)  ;
06080		    Outint(entries,8);
06090		    Outint(max,10);
06100		    Outint(contents,10);
06110		    Outfix(intgrl/dtime,2,11);
06120		    IF  entries=0  THEN   GOTO  over;
06130		    puttime(intgrl/entries);
06140		    over:
06150		    intgrl := 0;
06160		    max := entries := contents;
06170		    skip(0) ;
06180		END ;
06190		exit:
06200		time_origin := Time;
06210	    END  PROC STANDARD_REPORT ;
06220	    COMMENT  ******************************
06230	    ERROR   PACKAGE
06240	    ***************************************;
06250	    INTEGER  ernum,erloc ;
06260	    INTEGER   ARRAY  ertype(1:15),erres  (1:15),    ertran (1:15)  ;
06270	    REAL   ARRAY  ertime (1:15)  ;
06280	    PROCEDURE  erreur (n) ;
06290	    INTEGER  n ;
06300	    BEGIN
06310		ernum := ernum + 1 ;
06320		ertime (ernum) := gpsss_time ;
06330		IF  n<2  OR  n>9  THEN
06340		ertype(ernum) := 1
06350		ELSE   BEGIN
06360		    ertype(ernum) := n ;
06370		    erres (ernum) := erloc ;
06380		    INSPECT  Current  WHEN  transaction  DO
06390		    ertran (ernum) := id
06400		    OTHERWISE
06410		    ertran (ernum) := 0 ;
06420		END  ;
06430		IF  ernum = 14  THEN   BEGIN
06440		    erreur(2) ;
06450		    clear_sqs ;
06460		    error_report ;
06470		    IF  Current =/= Main  THEN   BEGIN
06480			ACTIVATE  Main  DELAY  0 ;
06490			Passivate;
06500		    END  ;
06510		END  ;
06520		erloc := 0 ;
06530	    END  ;
06540	    PROCEDURE  error_report ;
06550	    BEGIN
06560		INTEGER  i ;
06570		PROCEDURE  phrase1 (n) ;  INTEGER  n;
06580		BEGIN
06590		    IF  n=1  THEN  Outtext("IN  STATION")   ELSE
06600		    IF  n=2  THEN  Outtext("IN  STORAGE")   ELSE
06610		    IF  n=3  THEN  Outtext("IN  QUEUE"   )  ELSE
06620		    Outtext("IN  XXX"     ) ;
06630		    Outint(erres(i),3) ;
06640		    Outimage ;
06650		END  ;
06660		PROCEDURE  phrase2 ;
06670		BEGIN
06680		    Outtext("               TRANSACTION")  ;
06690		    Outint(ertran(i),4) ;
06700		END  ;
06710		IF  ernum=0  THEN   GOTO  exit ;
06720		skip(100) ;
06730		Outtext("GPSSS  ERROR REPORT   - AT TIME=")  ;
06740		Outfix(gpsss_time,2,10) ;
06750		Outimage ;
06760		Outtext("******************")   ; skip(1) ;
06770		Outtext("PASSE  =")  ;
06780		Outint(passe,3) ;
06790		skip(1) ;
06800		Outtext("**  TIME **")  ; Outimage ;
06810		FOR  i:=1  STEP  1  UNTIL  ernum  DO
06820		BEGIN
06830		    Outimage ;
06840		    Outfix(ertime(i),2,10) ;
06850		    Outtext("   - ")  ;
06860		    IF ertype(i)=1 THEN GOTO l1 ;
06870		    IF ertype(i)=2 THEN GOTO l2 ;
06880		    IF ertype(i)=3 THEN GOTO l3 ;
06890		    IF ertype(i)=4 THEN GOTO l4 ;
06900		    IF ertype(i)=5 THEN GOTO l5 ;
06910		    IF ertype(i)=6 THEN GOTO l6 ;
06920		    IF ertype(i)=7 THEN GOTO l7 ;
06930		    IF ertype(i)=8 THEN GOTO l8 ;
06940		    IF ertype(i)=9 THEN GOTO l9;
06950		    l1:Outtext("SYSTEM   ERROR")  ;
06960		    GOTO  Out ;
06970		    l2:Outtext("TOO   MANY ERRORS - SIMULATION TERMINATED");
06980		    GOTO  Out ;
06990		    l3:phrase1  (1) ; phrase2 ;
07000		    Outtext("  TRIES TO LEAVE_BEFORE ENTERING")  ;
07010		    GOTO  Out ;
07020		    l4:phrase1  (2) ; phrase2 ;
07030		    Outtext("  REQUIRES MORE THAN MAX CAPACITY")  ;
07040		    GOTO  Out ;
07050		    l5:phrase1  (2) ; phrase2 ;
07060		    Outtext("  CAUSES OVERFLOW WHEN LEAVING")  ;
07070		    GOTO  Out ;
07080		    l6:phrase1  (1) ; phrase2 ;
07090		    Outtext("  TRIES TO RE-ENTER")  ;
07100		    GOTO  Out ;
07110		    l7:phrase1  (3) ; phrase2 ;
07120		    Outtext("  TRIES TO LEAVE_EMPTY QUEUE")  ;
07130		    GOTO  Out ;
07140		    l8:phrase1  (3) ; phrase2 ;
07150		    Outtext("  TRIES TO LEAVE_NON-EXISTENT QUEUE")  ;
07160		    GOTO  Out ;
07170		    l9:Outtext("RESTART   USED OUTSIDE MAIN PROGRAM");
07180		    Outtext("  - NO ACTION")  ;
07190		    GOTO  Out ;
07200		    Out:
07210		    Outimage ;
07220		END  ;
07230		ernum := 0 ;
07240		exit:
07250	    END  ;
07260	    COMMENT ************************************
07270	    INITIALISATION
07280	    ********************************************;
07290	    INTEGER  u,llength ;
07300	    REAL  time_origin, simulation_start_time ;
07310	    u :=987654321;
07320	    passe := 1 ;
07330	    waitq :-  NEW  Head ;
07340	    wait_moniteur :-  NEW  wait_monitor ;
07350	    llength:=(IF secdec<0 THEN 13 ELSE
07360	    IF secdec=0 THEN 16 ELSE 17+secdec);
07370	    INNER ;
07380	    error_report ;
07390	    standard_report ;
07400	END  GPSSS DEFINITION