Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/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