Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/gpssst.sim
There is 1 other file named gpssst.sim in the archive. Click here to see a list.
00010 OPTIONS(/E/L);
00020 Simulation CLASS gpssst(max_queues,max_stations,max_storages,
00030 unit,secdec);
00040 CHARACTER unit;
00050 INTEGER max_queues,max_stations,max_storages,secdec;
00060 NOT HIDDEN PROTECTED object_trace_on,noreport,
00070 transid,set_storage,restart,gpsss_time,contents_station,
00080 station,box,file,secdec,unit,standard_report,u,transaction,wait_until,
00090 time_spent_only,skip,trace_on,begin_time,hold_until_ready,trace_object,
00100 contents_storage,contents_queue,waiting_station,waiting_storage,
00110 outtime,trans_name,queue_name,station_name,storage_name,waiting_queue,
00120 bbegin_time;
00130 NOT HIDDEN Process,Current,Time,Hold,Passivate,Wait,
00140 Cancel,Accum,Main,linkage,Link,Head;
00150 BEGIN
00160 COMMENT **************************************************
00170 MONTREAL GPSSS PACKAGE + VERSION 4.1 +
00180 WRITTEN - FEBRUARY 1972
00190 UPDATED - SEPTEMBER 1974
00200 AUTHOR - JEAN G. VAUCHER
00210 PROFESSEUR AGREGE
00220 DEPARTEMENT D INFORMATIQUE
00230 UNIVERSITE DE MONTREAL
00240 C.P. 6128 , MONTREAL 101
00250 CANADA
00260 CONVERTED TO DECSYSTEM 10 - JUNE 1976
00270 BY H-JOACHIM BOSE
00280 **********************************************************;
00290 REF (facility) ARRAY station (1:max_stations );
00300 REF (storage ) ARRAY box (1:max_storages);
00310 REF (q ) ARRAY file (1:max_queues) ;
00320 TEXT ARRAY queue_nname[1:max_queues];
00330 TEXT ARRAY station_nname[1:max_stations];
00340 TEXT ARRAY storage_nname[1:max_storages];
00350 TEXT trans_nname,field;
00360 REAL bbegin_time ;
00370 INTEGER maxlength,llength;
00380 BOOLEAN trace_on,object_trace_on,noreport,time_spent_only;
00390 REF(Head)finished_objects;
00400 COMMENT **********************************************************
00410 OCCURRENCE_STAT. DEFINITION. LINK TO OCCURENCES,ATTRIBUT TO TRANS.
00420 ******************************************************************;
00430 Link CLASS
00440 occurrence_statistics(occurrence_number,resource_number,
00450 occurrence_time);
00460 INTEGER occurrence_number,resource_number;
00470 REAL occurrence_time; ;
00480 INTEGER transid ;
00490 INTEGER nstat, nstor, nque, passe ;
00500 BOOLEAN outoforder ;
00510 COMMENT *******************************************************
00520 QUEUE_NAME DEFINITION
00530 ***************************************************************;
00540 PROCEDURE queue_name(i,new_name);
00550 VALUE new_name;
00560 INTEGER i;
00570 TEXT new_name;
00580 BEGIN
00590 check_limits(i,1); IF outoforder THEN GOTO Out;
00600 IF new_name.Length>maxlength THEN maxlength:=new_name.Length;
00610 queue_nname(i):-new_name;
00620 Out: outoforder := FALSE
00630 END;
00640 COMMENT *******************************************************
00650 STATION_NAME DEFINITION
00660 ***************************************************************;
00670 PROCEDURE station_name(i,new_name);
00680 VALUE new_name;
00690 INTEGER i;
00700 TEXT new_name;
00710 BEGIN
00720 check_limits(i,2); IF outoforder THEN GOTO Out;
00730 IF new_name.Length>maxlength THEN maxlength:=new_name.Length;
00740 station_nname(i):-new_name;
00750 Out: outoforder := FALSE
00760 END;
00770 COMMENT *******************************************************
00780 STORAGE_NAME DEFINITION
00790 ***************************************************************;
00800 PROCEDURE storage_name(i,new_name);
00810 VALUE new_name;
00820 INTEGER i;
00830 TEXT new_name;
00840 BEGIN
00850 check_limits(i,3); IF outoforder THEN GOTO Out ;
00860 IF new_name.Length>maxlength THEN maxlength:=new_name.Length;
00870 storage_nname(i):-new_name;
00880 Out: outoforder := FALSE
00890 END;
00900 COMMENT ***************************************
00910 OUTOFORDER DEFINITION
00920 ***********************************************;
00930 BOOLEAN PROCEDURE check_limits(nr,fac);
00940 INTEGER nr,fac;
00950 BEGIN
00960 SWITCH msg:=q,sta,sto;
00970 GOTO msg(fac);
00980 q: IF nr<1 OR nr>max_queues THEN BEGIN
00990 erreur(10);
00995 erloc:= nr;
01000 outoforder :=TRUE;END; GOTO Out;
01010 sta:IF nr<1 OR nr>max_stations THEN BEGIN
01020 erreur(11);
01025 erloc:= nr;
01030 outoforder :=TRUE;END; GOTO Out;
01040 sto:IF nr<1 OR nr>max_storages THEN BEGIN
01050 erreur(12);
01055 erloc:= nr;
01060 outoforder :=TRUE; END;
01070 Out:
01080 END of OUTOFORDER ;
01090 INTEGER tlength;
01100 COMMENT ***************************************************
01110 TRANS_NAME DEFINITION
01120 ***********************************************************;
01130 PROCEDURE trans_name(trname);
01140 VALUE trname;
01150 TEXT trname;
01160 BEGIN
01170 trans_nname:- trname;
01180 tlength:=trname.Length;
01190 END of trans_name ;
01200 COMMENT **************************************************
01210 BEGIN_TIME DEFINITION
01220 **********************************************************;
01230 REAL PROCEDURE begin_time(Time);
01240 REAL Time;
01250 BEGIN
01260 bbegin_time:=60*Entier(Time)+100*(
01270 Time-Entier(Time));
01280 begin_time:=bbegin_time ;
01290 END ;
01300 COMMENT **************************************************
01310 TRACE_OBJECT DEFINITION
01320 **********************************************************;
01330 PROCEDURE trace_objects;
01340 IF object_trace_on THEN BEGIN
01350 INTEGER tt;
01360 BOOLEAN notfirst;
01370 field:-Image.Sub(maxlength+18,llength);
01380 IF \finished_object.Empty THEN BEGIN
01390 IF Line>4 THEN skip(100);
01400 Outtext(" THE TRANSACTIONS LEAVING THE SYSTEM ARE");
01410 skip(0);
01420 Outtext(" =======================================");
01430 trace_queue(finished_objects);
01440 END;
01450 FOR tt:=1 STEP 1 UNTIL max_storages DO
01460 IF box(tt)=/=NONE THEN BEGIN
01470 IF \box(tt).inq.Empty THEN BEGIN
01480 IF \notfirst THEN BEGIN
01490 header(1);
01500 notfirst:=TRUE;
01510 END;
01520 Outtext(" /");
01530 facility_name_out(3,tt);
01540 Outtext("/");
01550 trace_queue(box(tt).inq);
01560 END;
01570 END;
01580 notfirst:=FALSE;
01590 FOR tt:=1 STEP 1 UNTIL max_stations DO
01600 IF station(tt)=/= NONE THEN BEGIN
01610 IF \station(tt).inq.Empty THEN BEGIN
01620 IF \notfirst THEN BEGIN
01630 header(2);
01640 notfirst:=TRUE;
01650 END;
01660 Outtext(" /");
01670 facility_name_out(2,tt);
01680 Outtext("/");
01690 trace_queue(station(tt).inq);
01700 END;
01710 END;
01720 IF \waitq.Empty THEN BEGIN
01730 IF Line > 4 THEN skip(100) ELSE skip(4);
01740 Outtext("THE TRANSACTIONS STUCKED IN WAITQUEUE ARE");
01750 skip(0);
01760 Outtext("=========================================");
01770 skip(0);
01780 Outtext("( passivated in the procedure wait_until )");
01790 skip(1);
01800 trace_queue(waitq);
01810 END;
01820 END ELSE BEGIN
01830 skip(0);Outtext(
01840 "You have to set object_trace_on := TRUE ");
01850 skip(0);Outtext(" if you want to use trace_objects ");
01860 skip(10);
01870 END of trace_object ;
01880 COMMENT *******************************************
01890 TRACE_QUEUE DEFINITION
01900 ***************************************************;
01910 PROCEDURE trace_queue (q_ref);
01920 REF(Head) q_ref;
01930 BEGIN
01940 REF(transaction) current_transaction;
01950 REF(occurrence_statistics) current_occurrence;
01960 INTEGER tt;
01970 current_transaction:-q_ref.First;
01980 WHILE current_transaction=/=NONE DO
01990 INSPECT current_transaction DO BEGIN
02000 IF \ time_spent_only THEN BEGIN
02010 IF Line+1.5*occurrences.Cardinal+10>54 THEN
02020 skip(100) ELSE skip(2);
02030 END ELSE IF Line + occurrences.Cardinal/2
02040 + 4 > 54 THEN skip(100) ELSE skip(2);
02050 Setpos(8);
02060 trans_name_out(id);
02070 skip(0);
02080 Setpos(8);
02090 IF trans_nname==NOTEXT THEN
02100 Outtext("----------") ELSE
02110 BEGIN
02120 FOR tt:=1 STEP 1 UNTIL tlength DO
02130 Outtext("-");
02140 Outtext("----");
02150 END;
02160 skip(2);
02170 IF \ time_spent_only THEN print_out(occurrences);
02180 skip(1);
02190 compare(current_transaction);
02200 current_transaction:-Suc;
02210 END inspect transaction ;
02220 END of proc. trace_queue ;
02230 COMMENT ****************************************************
02240 HEADER DEFINITION
02250 ************************************************************;
02260 PROCEDURE header(nr);
02270 INTEGER nr;
02280 BEGIN skip(100);
02290 Outtext("THE TRANSACTIONS WAITING TO ENTER ");
02300 IF nr=1 THEN Outtext("STORAGE ") ELSE
02310 Outtext("STATION "); Outtext("ARE :");
02320 skip(0);
02330 Outtext("===============================================");
02340 skip(1);
02350 END;
02360 COMMENT **************************************************
02370 PRINT_OUT DEFINITION
02380 **********************************************************;
02390 PROCEDURE print_out (transoccurrence);
02400 REF(Head) transoccurrence ;
02410 BEGIN
02420 REF(occurrence_statistics) z ;
02430 z:- transoccurrence.First;
02440 WHILE z =/= NONE DO
02450 INSPECT z DO BEGIN
02460 IF occurrence_number>0 THEN
02470 Outtext("Entered ") ELSE
02480 Outtext("Left ");
02490 facility_name_out(Abs(occurrence_number),resource_number);
02500 Setpos(11+maxlength);
02510 Outtext("at time ");
02520 puttime(occurrence_time+bbegin_time);
02530 skip(0);
02540 z:-z.Suc;
02550 END;
02560 END proc. print_out;
02570 COMMENT *****************************************************
02580 COMPARE DEFINITION
02590 *************************************************************;
02600 PROCEDURE compare(transoccurrence);
02610 REF(transaction) transoccurrence;
02620 INSPECT transoccurrence DO BEGIN
02630 REF(occurrence_statistics)x,y;
02640 x:-occurrences.First;
02650 WHILE x=/= NONE DO BEGIN
02660 y:-x.Suc;
02670 WHILE y=/= NONE DO BEGIN
02680 IF x.resource_number=
02690 y.resource_number AND
02700 x.occurrence_number=
02710 -(y.occurrence_number) THEN BEGIN
02720 wtime_spent_out(x,y);
02730 y.Out;
02740 GOTO next_x;
02750 END;
02760 y:-y.Suc;
02770 END;
02780 next_x:
02790 x:-x.Suc;
02800 END;
02810 END compare ;
02820 COMMENT *********************************************
02830 wtime_spent_out DEFINITION
02840 *****************************************************;
02850 PROCEDURE wtime_spent_out(occur1,occur2);
02860 REF(occurrence_statistics) occur1,occur2;
02870 BEGIN
02880 Outtext("Time spent in ");
02890 INSPECT occur1 DO
02900 facility_name_out(occurrence_number,resource_number);
02910 Setpos(17+maxlength);
02920 Outtext(":");
02930 puttime(occur2.occurrence_time-
02940 occur1.occurrence_time);
02950 skip(0);
02960 END wtime_spent_out;
02970 COMMENT ***********************************************
02980 TRANS_NAME_OUT DEFINITION
02990 *******************************************************;
03000 PROCEDURE trans_name_out(nr);
03010 INTEGER nr;
03020 BEGIN
03030 IF trans_nname==NOTEXT THEN Outtext("object") ELSE
03040 Outtext(trans_nname);
03050 Outint(nr,4);
03060 Setpos(Pos+2);
03070 END of trans_nname ;
03080 COMMENT *********************************************
03090 FACILITY_NAME_OUT DEFINITION
03100 *****************************************************;
03110 PROCEDURE facility_name_out(number,resource);
03120 INTEGER number,resource;
03130 BEGIN
03140 SWITCH msg:=q,sta,sto;
03150 GOTO msg(Abs(number));
03160 q:
03170 IF queue_nname(resource)==NOTEXT THEN BEGIN
03180 Outtext(" queue ");
03190 Outint(resource,4);
03200 END ELSE
03210 Outtext(queue_nname(resource));
03220 GOTO Out;
03230 sta:
03240 IF station_nname(resource)==NOTEXT THEN BEGIN
03250 Outtext(" station");
03260 Outint(resource,4);
03270 END ELSE
03280 Outtext( station_nname(resource));
03290 GOTO Out;
03300 sto:
03310 IF storage_nname(resource)==NOTEXT THEN BEGIN
03320 Outtext(" storage");
03330 Outint(resource,4);
03340 END ELSE
03350 Outtext(storage_nname(resource));
03360 Out:
03370 END of fac_name_out;
03380 COMMENT ***********************************************
03390 PUTTIME DEFINITION
03400 *******************************************************;
03410 TEXT PROCEDURE puttime(Time);
03420 REAL Time;
03430 IF field.Length >=
03440 (IF secdec < 0 THEN 12 ELSE IF secdec = 0 THEN 15 ELSE secdec+16)
03450 THEN
03460 BEGIN INTEGER days,hours,m,powersec; REAL seconds;
03470
03480 PROCEDURE fixedit(x,w); REAL x; INTEGER w;
03490 BEGIN
03500 field.Sub(field.Pos,w).Putfix(
03510 x,IF secdec>=0 THEN secdec ELSE 0);
03520 field.Setpos(field.Pos+w);
03530 END of fixedit;
03540
03550 PROCEDURE intedit(i,w); INTEGER i,w;
03560 BEGIN
03570 field.Sub(field.Pos,w).Putint(i);
03580 IF field.Getchar = ' ' THEN
03590 BEGIN field.Setpos(field.Pos-1);
03600 field.Putchar('0');
03610 END;
03620 field.Setpos(field.Pos-1+w);
03630 END of intedit;
03640
03650 BOOLEAN PROCEDURE adjusted;
03660 BEGIN
03670 IF m = 60 THEN
03680 BEGIN adjusted:= TRUE;
03690 hours:= hours + 1; m:= 0;
03700 IF hours = 24 THEN
03710 BEGIN days:= days + 1; hours:= 0 END
03720 END;
03730 field.Sub(2,6):= " D ";
03740 field.Setpos(5);
03750 IF days < 1 THEN
03760 field.Putchar(' ') ELSE
03770 IF days < 10 THEN
03780 BEGIN
03790 field.Setpos(4);
03800 field.Putchar(Char(days+Rank('0')));
03810 END ELSE
03820 IF days < 100 THEN
03830 BEGIN field.Setpos(3); intedit(days,2) END ELSE
03840 IF days < 1000 THEN
03850 BEGIN field.Setpos(2); intedit(days,3) END ELSE
03860 field.Sub(2,3):= "***";
03870 field.Setpos(8);
03880 intedit(hours,2); field.Putchar(':');
03890 END of adjust;
03900
03910 powersec:= 1;
03920 FOR m:= 1 STEP 1 UNTIL secdec DO powersec:= powersec*10;
03930 IF unit = 'D' OR unit = 'd' THEN Time:= 1440*Time ELSE
03940 IF unit = 'H' OR unit = 'h' THEN Time:= 60*Time ELSE
03950 IF unit = 'S' OR unit = 's' THEN Time:= Time/60;
03960
03970 field.Setpos(1);
03980 field.Putchar(IF Time < 0 THEN '-' ELSE ' ');
03990 Time:= Abs(Time);
04000 IF Time > 34 359 738 367 THEN GO TO error;
04010 m:= Entier(Time);
04020 seconds:= 60*(Time - m);
04030 hours:= m//60;
04040 m:= Mod(m,60);
04050 days:= hours//24;
04060 hours:= Mod(hours,24);
04070 IF secdec >= 0 THEN
04080 BEGIN
04090 IF Entier(seconds*powersec+0.5) = 60*powersec THEN
04100 BEGIN m:= m + 1; seconds:= 0 END;
04110 adjusted;
04120 intedit(m,2); field.Putchar('.');
04130 IF seconds < 9.5 THEN
04140 BEGIN field.Putchar('0');
04150 fixedit(seconds,IF secdec = 0 THEN 1 ELSE secdec+2)
04160 END ELSE
04170 fixedit(seconds,IF secdec = 0 THEN 2 ELSE secdec+3);
04180 END ELSE
04190 BEGIN Time:= m + seconds/60;
04200 m:= Time;
04210 IF adjusted THEN Time:= 0;
04220 IF Time < 9.5 THEN field.Putchar('0');
04230 fixedit(Time,IF Time < 9.5 THEN 1 ELSE 2)
04240 END;
04250 field.Setpos(1); puttime:- field
04260 END of puttime OK ELSE
04270 error:
04280 BEGIN field.Setpos(1);
04290 WHILE field.More DO field.Putchar('*');
04300 field.Setpos(1);
04310 puttime:- field ;
04320 END of puttime error;
04330 PROCEDURE outtime(u_time); REAL u_time ;
04340 BEGIN
04350 TEXT savefield;
04360 savefield:- field ;
04370 IF pos + llength > length + 1 THEN outimage ;
04380 field:- Image.sub(pos,llength);
04390 puttime(u_time);
04400 Setpos(pos + llength);
04410 field :- savefield ;
04420 END of outtime ;
04430 COMMENT **************************************************
04440 HOLD_UNTIL_READY DEFINITION
04450 **********************************************************;
04460 PROCEDURE hold_until_ready;
04470 BEGIN
04480 IF Current.Nextev==NONE THEN
04490 BEGIN
04500 Outtext("The simulation was already finished.");
04510 skip(0);
04520 Outtext("Do not make ""hold"" in the main program,");
04530 skip(0);
04540 Outtext("before hold_until_ready");
04550 skip(0);
04560 END ELSE Passivate;
04570 END;
04580 COMMENT **************************************************
04590 FACILITY DEFINITION
04600 **********************************************************;
04610 CLASS facility;
04620 BEGIN
04630 REF (Head) inq;
04640 REF (transaction) occupier;
04650 INTEGER entries ;
04660 REAL tlast, busy_time ;
04670 BOOLEAN PROCEDURE busy;
04680 busy := occupier =/= NONE ;
04690 inq :- NEW Head ;
04700 tlast := time_origin ;
04710 END FACILITY DEFINITION;
04720 COMMENT **************************************************
04730 STORAGE DEFINITION
04740 **********************************************************;
04750 CLASS storage (capacity);
04760 INTEGER capacity;
04770 BEGIN
04780 REF (Head) inq;
04790 INTEGER max,entries,unit_entries; REAL contents;
04800 REAL tlast, intgrl;
04810 COMMENT ********************************************
04820 CHECK_INQ DEFINITION
04830 ****************************************************;
04840 PROCEDURE check_inq;
04850 BEGIN
04860 REF (transaction) client, next_client;
04870 client :- inq.First;
04880 loop:
04890 IF client == NONE OR contents= capacity
04900 THEN GOTO fin;
04910 next_client :- client.Suc ;
04920 ACTIVATE client ;
04930 client :- next_client;
04940 GOTO loop;
04950 fin:
04960 END OF CHECK_INQ ;
04970 inq :- NEW Head ;
04980 tlast := time_origin ;
04990 END STORAGE DEFINITION ;
05000 COMMENT ************
05010 STORAGE CREATION
05020 ********************;
05030 PROCEDURE set_storage (n,capacity);
05040 INTEGER n, capacity;
05050 BEGIN
05060 nstor := nstor + 1 ;
05070 box (n) :- NEW storage (capacity);
05080 END ;
05090 COMMENT **************************************************
05100 QUEUE DEFINITION
05110 **********************************************************;
05120 CLASS q ;
05130 BEGIN
05140 INTEGER entries, max ;
05150 REAL intgrl, tlast, contents;
05160 tlast := time_origin ;
05170 END ;
05180 BOOLEAN init;
05190 COMMENT **************************************************
05200 TRANSACTION DEFINITION
05210 **********************************************************;
05220 Process CLASS transaction ;
05230 NOT HIDDEN PROTECTED enter_queue,leave_queue,enter_station,
05240 leave_station,enter_storage,leave_storage,id,time_mark,
05250 occurrences,priority,priority_into;
05260 NOT HIDDEN Idle,Nextev,Out,Follow,Precede,Into,Suc,Pred;
05270 BEGIN
05280 REAL time_mark, priority;
05290 INTEGER id ;
05300 REF(Head) occurrences;
05310 COMMENT ***************************************************
05320 TRACE DEFINITION
05330 ***********************************************************;
05340 PROCEDURE trace(n);
05350 INTEGER n;
05360 BEGIN
05370 IF \init THEN BEGIN
05380 IF Line>1 THEN skip(100) ELSE skip(1);
05390 init:=TRUE;
05400 END;
05410 field:-Image.Sub(position,llength);
05420 trans_name_out(id);
05430 IF mr<0 THEN Outtext(" leaving ") ELSE
05440 Outtext(" entering ");
05450 facility_name_out(mr,n);
05460 Setpos(maxlength+15+
05470 (IF trans_nname==NOTEXT THEN 11 ELSE tlength+5));
05480 Outtext("at time ");
05490 puttime(gpsss_time+bbegin_time);
05500 IF Mod(Line,5)=0 THEN skip(1) ELSE skip(0);
05510 IF Line>58 THEN skip(100);
05520 END trace ;
05530 COMMENT ***************
05540 FINAL_WAIT DEFINITION
05550 ***********************;
05560 PROCEDURE final_wait(q_ref);
05570 REF(Head)q_ref;
05580 BEGIN
05590 REF(transaction)current_transaction;
05600 current_transaction:-q_ref.Last;
05610 WHILE current_transaction =/=NONE DO
05620 BEGIN
05630 IF id>current_transaction.id THEN
05640 BEGIN
05650 Follow(current_transaction);
05660 GOTO Out;
05670 END;
05680 current_transaction:-current_transaction.Pred;
05690 END;
05700 Follow(q_ref);
05710 Out:
05720 END final_wait ;
05730 COMMENT ************
05740 ENTER_STATION
05750 ********************;
05760 PROCEDURE enter_station (n);
05770 INTEGER n ;
05780 BEGIN
05790 check_limits(n,2);
05800 IF outoforder THEN GOTO ut;
05810 start:
05820 INSPECT station(n) DO
05830 BEGIN
05840 IF occupier == THIS transaction THEN
05850 BEGIN
05860 erloc := n ;
05870 erreur(6);
05880 GOTO exit;
05890 END ;
05900 IF busy THEN BEGIN
05910 priority_into(inq);
05920 IF Nextev==NONE THEN ACTIVATE Main DELAY 0 ;
05930 Passivate;
05940 Out;
05950 END ELSE tlast := Time;
05960 entries := entries+1;
05970 occupier :- THIS transaction;
05980 mr:=2;
05990 IF trace_on THEN trace(n);
06000 IF object_trace_on THEN
06010 NEW occurrence_statistics(2,n,gpsss_time
06020 ).Into(occurrences);
06030 exit:
06040
06050 END
06060 OTHERWISE BEGIN
06070 station (n) :- NEW facility;
06080 nstat := nstat+1;
06090 GOTO start;
06100 END ;
06110 ut:outoforder :=FALSE;
06120 END ENTER_STATION ;
06130 COMMENT ************
06140 LEAVE_STATION
06150 ********************;
06160 PROCEDURE leave_station (n) ;
06170 INTEGER n ;
06180 BEGIN
06190 check_limits(n,2);
06200 IF outoforder THEN GOTO ut;
06210 INSPECT station (n) WHEN facility DO
06220 BEGIN
06230 IF occupier =/= THIS transaction THEN
06240 BEGIN
06250 erloc := n ;
06260 erreur (3);
06270 GOTO exit ;
06280 END ;
06290 IF inq.Empty THEN BEGIN
06300 occupier :- NONE ;
06310 busy_time:=busy_time + Time - tlast;
06320 END
06330 ELSE BEGIN
06340 occupier :- inq.First;
06350 ACTIVATE inq.First DELAY 0 ;
06360 END ;
06370 mr:=-2;
06380 IF trace_on THEN trace(n);
06390 IF object_trace_on THEN
06400 NEW occurrence_statistics(
06410 -2,n,gpsss_time).
06420 Into(occurrences);
06430 exit:
06440 END OTHERWISE BEGIN
06450 erloc := n ;
06460 erreur(3) ;
06470 END ;
06480 ut:outoforder :=FALSE;
06490 END LEAVE_STATION ;
06500 COMMENT ************
06510 ENTER_STORAGE
06520 ********************;
06530 PROCEDURE enter_storage (n, units_required) ;
06540 INTEGER n, units_required ;
06550 BEGIN
06560 check_limits(n,3);
06570 IF outoforder THEN GOTO ut;
06580 IF box (n) == NONE THEN set_storage(n,1000000) ;
06590 INSPECT box (n) WHEN storage DO
06600 BEGIN
06610 IF units_required>capacity THEN
06620 BEGIN
06630 erloc := n ;
06640 erreur (4);
06650 GOTO error_exit ;
06660 END ;
06670 priority_into (inq);
06680 test:
06690 IF units_required <= capacity-contents THEN GOTO exit;
06700 IF Nextev==NONE THEN ACTIVATE Main DELAY 0 ;
06710 Passivate;
06720 GOTO test;
06730 exit:
06740 mr:=3;
06750 IF trace_on THEN trace(n);
06760 IF object_trace_on THEN
06770 NEW occurrence_statistics(
06780 3,n,gpsss_time).
06790 Into(occurrences);
06800 Out;
06810 entries:=entries+1;
06820 unit_entries:=unit_entries+units_required;
06830 Accum(intgrl,tlast,contents,units_required);
06840 IF contents> max THEN max := contents;
06850 Hold (0);
06860 END INSPECT ;
06870 error_exit:
06880 ut: outoforder :=FALSE;
06890 END ENTER_STORAGE;
06900 COMMENT ************
06910 LEAVE_STORAGE
06920 ********************;
06930 PROCEDURE leave_storage (n,units_released);
06940 INTEGER n,units_released;
06950 BEGIN
06960 check_limits(n,3);
06970 IF outoforder THEN GOTO ut;
06980 INSPECT box (n) WHEN storage DO
06990 BEGIN
07000 Accum(intgrl,tlast,contents,-(units_released)) ;
07010 IF contents< 0 THEN BEGIN
07020 erloc:=n;
07030 erreur (5);
07040 contents:= 0;
07050 END ELSE BEGIN
07060 check_inq;
07070 mr:=-3;
07080 IF trace_on THEN trace(n);
07090 IF object_trace_on THEN
07100 NEW occurrence_statistics(
07110 -3,n,gpsss_time).
07120 Into(occurrences);
07130 END;
07140 END
07150 OTHERWISE set_storage (n,1000000) ;
07160 ut:outoforder :=FALSE;
07170 END;
07180 COMMENT ************
07190 ENTER_QUEUE
07200 ********************;
07210 PROCEDURE enter_queue (n);
07220 INTEGER n ;
07230 BEGIN
07240 check_limits(n,1);
07250 IF outoforder THEN GOTO ut;
07260 IF file (n) == NONE THEN BEGIN
07270 file (n) :- NEW q;
07280 nque := nque + 1;
07290 END ;
07300 INSPECT file (n) DO
07310 BEGIN
07320 entries := entries +1;
07330 Accum (intgrl,tlast,contents,1);
07340 IF contents>max THEN max := contents;
07350 mr:=1;
07360 IF trace_on THEN trace(n);
07370 IF object_trace_on THEN
07380 NEW occurrence_statistics(
07390 1,n,gpsss_time).
07400 Into(occurrences);
07410 END ;
07420 ut:outoforder :=FALSE;
07430 END ENTER_QUEUE;
07440 COMMENT ************
07450 LEAVE_QUEUE
07460 ********************;
07470 PROCEDURE leave_queue (n) ;
07480 INTEGER n;
07490 BEGIN
07500 check_limits(n,1);
07510 IF outoforder THEN GOTO ut;
07520 INSPECT file (n) DO
07530 IF contents= 0 THEN BEGIN
07540 erloc:= n ;
07550 erreur(7) ; END
07560 ELSE BEGIN
07570 Accum (intgrl,tlast,contents,-1);
07580 mr:=-1;
07590 IF trace_on THEN trace(n);
07600 IF object_trace_on THEN
07610 NEW occurrence_statistics(
07620 -1,n,gpsss_time).
07630 Into(occurrences);
07640 END
07650 OTHERWISE BEGIN
07660 erloc := n ;
07670 erreur(8);
07680 file (n) :- NEW q ;
07690 nque := nque +1 ;
07700 END ;
07710 ut:outoforder :=FALSE;
07720 END;
07730 COMMENT ************
07740 PRIORITY_INTO
07750 ********************;
07760 PROCEDURE priority_into (queue) ;
07770 REF (Head) queue;
07780 BEGIN
07790 REF (transaction) pt ;
07800 REF (Process) p ;
07810 IF queue.Empty THEN Into(queue)
07820 ELSE BEGIN
07830 COMMENT SKIP NON TRANSACTION OBJECTS ;
07840 p:-queue.Last ;
07850 l: IF p IN transaction OR p== NONE THEN BEGIN
07860 pt:-p;
07870 GOTO loop;
07880 END ;
07890 p:-p.Pred ;
07900 GOTO l;
07910 predec: pt :- pt.Pred ;
07920 loop: IF pt== NONE THEN Precede(queue.First)
07930 ELSE IF priority<pt.priority THEN GOTO predec
07940 ELSE IF priority=pt.priority AND priority<0
07950 THEN GOTO predec
07960 ELSE Follow (pt);
07970 END ;
07980 END PROCEDURE PRIORITY_INTO ;
07990 INTEGER mr;
08000 time_mark := gpsss_time ;
08010 transid := transid + 1 ;
08020 id := transid ;
08030 IF object_trace_on THEN occurrences:-NEW Head;
08040 INNER;
08050 IF object_trace_on THEN final_wait (finished_objects);
08060 IF Nextev==NONE THEN ACTIVATE Main DELAY 0;
08070 END CLASS TRANSACTION ;
08080 COMMENT *******************************
08090 WAIT_UNTIL PARAPHENALIA
08100 ***************************************;
08110 REF (Head) waitq ;
08120 REF (wait_monitor) wait_moniteur ;
08130 BOOLEAN wait_action ;
08140 PROCEDURE wait_until (b); NAME b; BOOLEAN b ;
08150 INSPECT Current DO BEGIN
08160 IF b THEN GOTO exit ;
08170 IF Current IN transaction THEN
08180 Current QUA transaction.priority_into(waitq)
08190 ELSE Into(waitq);
08200 IF wait_moniteur.Idle THEN
08210 ACTIVATE wait_moniteur AFTER Nextev ;
08220 loop:
08230 Passivate;
08240 IF NOT b THEN GOTO loop ;
08250 Out ;
08260 wait_action := TRUE ;
08270 exit:
08280 END WAIT_UNTIL ;
08290 Process CLASS wait_monitor ;
08300 BEGIN
08310 REF (Process) pt ;
08320 start:
08330 IF waitq.Empty THEN Passivate ;
08340 wait_action := FALSE ;
08350 pt :- waitq.First ;
08360 loop:
08370 IF pt == NONE THEN GOTO Wait ;
08380 ACTIVATE pt ;
08390 IF wait_action THEN GOTO start ;
08400 pt :- pt.Suc ;
08410 GOTO loop ;
08420 Wait:
08430 REACTIVATE Current AFTER Nextev ;
08440 GOTO start ;
08450 END WAIT_MONITOR ;
08460 COMMENT
08470 ******************************
08480 PROCEDURES UTILITAIRES
08490 ******************************;
08500 PROCEDURE skip (n) ;
08510 INTEGER n;
08520 BEGIN
08530 Outimage;
08540 IF n>0 THEN BEGIN
08550 IF Line+n > 60 THEN Eject(2)
08560 ELSE Eject (Line+n);
08570 END ;
08580 END PROC SKIP;
08590 REAL PROCEDURE gpsss_time ;
08600 gpsss_time := Time- simulation_start_time ;
08610 PROCEDURE clear_sqs ;
08620 l1: IF Current.Nextev =/= NONE THEN
08630 BEGIN
08640 Cancel (Current.Nextev) ;
08650 GOTO l1 ;
08660 END ;
08670 PROCEDURE restart ;
08680 BEGIN
08690 INTEGER i ;
08700 IF Current =/= Main THEN BEGIN
08710 erreur(9) ; GOTO Out ; END ;
08720 error_report ;
08730 IF \noreport THEN standard_report ;
08740 passe := passe + 1 ;
08750 COMMENT CANCEL ALL RESOURCES ;
08760
08770 FOR i := 1 STEP 1 UNTIL max_stations DO
08780 station (i) :- NONE ;
08790 FOR i := 1 STEP 1 UNTIL max_storages DO
08800 box (i) :- NONE ;
08810 FOR i := 1 STEP 1 UNTIL max_queues DO
08820 file (i) :- NONE ;
08830 COMMENT CANCEL ALL EVENTS ;
08840 clear_sqs ;
08850 init:=FALSE;
08860 simulation_start_time := Time ;
08870 nstat := nstor := nque := 0 ;
08880 transid := 0 ;
08890 u := 987654321 ;
08900 finished_objects :- NEW Head ;
08910 Out:
08920 END ;
08930 COMMENT *****************************************
08940 ENQUIRY PROCEDURES
08950 *************************************************;
08960 INTEGER PROCEDURE contents_station(n) ;
08970 INTEGER n ;
08980 BEGIN check_limits(n,2);
08990 IF outoforder THEN GOTO ut;
09000 INSPECT station(n) DO
09010 IF busy THEN contents_station := 1 ;
09020 ut:
09030 END;
09040 INTEGER PROCEDURE contents_storage (n) ;
09050 INTEGER n ;
09060 BEGIN check_limits(n,2);
09070 IF outoforder THEN GOTO ut;
09080 INSPECT box (n) DO
09090 contents_storage := contents;
09100 ut:
09110 END;
09120 INTEGER PROCEDURE contents_queue (n) ;
09130 INTEGER n ;
09140 BEGIN check_limits(n,2);
09150 IF outoforder THEN GOTO ut;
09160 INSPECT file (n) DO
09170 contents_queue := contents ;
09180 ut:
09190 END;
09200 INTEGER PROCEDURE waiting_station (n) ;
09210 INTEGER n ;
09220 BEGIN check_limits(n,2);
09230 IF outoforder THEN GOTO ut;
09240 INSPECT station (n) DO
09250 waiting_station := inq.Cardinal ;
09260 ut:
09270 END;
09280 INTEGER PROCEDURE waiting_storage (n) ;
09290 INTEGER n ;
09300 BEGIN check_limits(n,2);
09310 IF outoforder THEN GOTO ut;
09320 INSPECT box (n) DO
09330 waiting_storage := inq.Cardinal ;
09340 ut:
09350 END;
09360 INTEGER PROCEDURE waiting_queue (n) ;
09370 INTEGER n ;
09380 BEGIN check_limits(n,2);
09390 IF outoforder THEN GOTO ut;
09400 waiting_queue := 0 ;
09410 ut:
09420 END;
09430 COMMENT **************************************************
09440 REPORT GENERATOR
09450 **********************************************************;
09460 PROCEDURE standard_report ;
09470 BEGIN
09480 INTEGER i;
09490 BOOLEAN sbus;
09500 REAL dtime;
09510 dtime := Time-time_origin;
09520 skip(100);
09530 Outtext("***************************");
09540 Outtext(" -VERSION 4.1-") ; Outimage ;
09550 Outtext("*** MONTREAL GPSSS ***"); skip(0) ;
09560 Outtext("*** SIMULATION REPORT ***");
09570 skip(0); Outtext("***************************");
09580 skip(2);
09590 Outtext("PASSE =") ;
09600 Outint(passe,3) ;
09610 skip(1) ;
09620 Outtext("START TIME=");
09630 field:-Image.Sub(13,llength);
09640 puttime(time_origin-simulation_start_time
09650 +bbegin_time ) ;
09660 skip(0);
09670 Outtext("END TIME=");
09680 puttime(gpsss_time + bbegin_time);
09690 IF dtime=0 THEN BEGIN
09700 skip(2);
09710 Outtext("ELAPSED TIME = 0 - REPORT SKIPPED") ;
09720 GOTO exit ;
09730 END ;
09740 skip(2);
09750 IF nstat=0 THEN BEGIN
09760 Outtext("* NO STATIONS *");
09770 GOTO l1;
09780 END ;
09790 Outtext("* STATIONS *");
09800 skip(0); Outtext("************");
09810 skip(1);
09820 Setpos(15);
09830 Outtext("AVERAGE");
09840 Setpos(38);
09850 Outtext("AVERAGE");
09860 skip(0);
09870 Outtext
09880 (" STATION UTILISATION ENTRIES TRANSIT TIME STATUS");
09890 skip(1);
09900 field:-Image.Sub(32,llength);
09910 FOR i:=1 STEP 1 UNTIL max_stations DO
09920 INSPECT station(i) DO
09930 BEGIN
09940 sbus := busy ;
09950 IF sbus THEN busy_time:=busy_time+Time-tlast;
09960 Outint(i,7);
09970 Outfix(busy_time/dtime,2,13);
09980 Outint(entries,10);
09990 puttime(busy_time/entries);
10000 Setpos(52);
10010 IF sbus THEN Outtext("BUSY")
10020 ELSE Outtext("FREE");
10030 COMMENT RE-INITIALISATION DES STATISTIQUES ;
10040 IF sbus THEN entries :=1 ELSE entries :=0 ;
10050 busy_time := 0;
10060 tlast := Time;
10070 skip(0);
10080 END ;
10090 l1:
10100 skip(2);
10110 IF nstor=0 THEN BEGIN
10120 Outtext("* NO STORAGES *");
10130 GOTO l2;
10140 END ;
10150 Outtext("* STORAGES *");
10160 skip(0); Outtext("************");
10170 skip(1);
10180 Setpos(23); Outtext("AVG.");
10190 Setpos(32); Outtext("AVG.");
10200 Setpos(51); Outtext("THRU TIME");
10210 Setpos(67); Outtext("CONTENTS");
10220 skip(0);
10230 Outtext
10240 ("STORAGE CAPACITY CONTENTS UTIL. ENTRIES ");
10250 Outtext
10260 (" / UNIT MAX NOW");
10270 skip(1);
10280 field:-Image.Sub(46,llength);
10290 FOR i:=1 STEP 1 UNTIL max_storages DO
10300 INSPECT box(i) DO
10310 BEGIN
10320 Accum(intgrl,tlast,contents,0);
10330 Outint(i,5) ;
10340 Outint(capacity,10) ;
10350 Outfix(intgrl/dtime,2,12) ;
10360 IF capacity=0 THEN Setpos(38) ELSE
10370 Outfix(intgrl/(dtime*capacity),4,8);
10380 Outint(entries,8);
10390 IF unit_entries=0 THEN Setpos(61) ELSE
10400 puttime (intgrl/unit_entries);
10410 Setpos(63);
10420 Outint(max,7);
10430 Outint(contents,7);
10440 skip(0);
10450 COMMENT RE-INITIALISATION DES STATISTIQUES ;
10460 entries := 0;
10470 unit_entries := contents;
10480 intgrl := 0 ;
10490 tlast := Time;
10500 max := contents;
10510 END ;
10520 l2:
10530 skip(2);
10540 IF nque=0 THEN BEGIN
10550 Outtext("* NO QUEUES *");
10560 GOTO exit;
10570 END ;
10580 Outtext("* QUEUES *") ;
10590 skip(0); Outtext("**********") ;
10600 skip(1);
10610 Setpos(19); Outtext(
10620 "MAX. CURRENT AVG. AVG.") ;
10630 skip(0); Outtext(
10640 "QUEUE ENTRIES CONTENTS CONTENTS CONTENTS TIME/TRANS");
10650 skip(1);
10660 field:-Image.Sub(46,llength);
10670 FOR i := 1 STEP 1 UNTIL max_queues DO
10680 INSPECT file (i) DO
10690 BEGIN
10700 Accum(intgrl,tlast,contents,0);
10710 Outint(i,4) ;
10720 Outint(entries,8);
10730 Outint(max,10);
10740 Outint(contents,10);
10750 Outfix(intgrl/dtime,2,11);
10760 IF entries=0 THEN GOTO over;
10770 puttime(intgrl/entries);
10780 over:
10790 intgrl := 0;
10800 max := entries := contents;
10810 skip(0) ;
10820 END ;
10830 exit:
10840 time_origin := Time;
10850 END PROC STANDARD_REPORT ;
10860 COMMENT ******************************
10870 ERROR PACKAGE
10880 ***************************************;
10890 INTEGER ernum,erloc ;
10900 INTEGER ARRAY ertype(1:15),erres (1:15), ertran (1:15) ;
10910 REAL ARRAY ertime (1:15) ;
10920 PROCEDURE erreur (n) ;
10930 INTEGER n ;
10940 BEGIN
10950 ernum := ernum + 1 ;
10960 ertime (ernum) := gpsss_time ;
10970 IF n<2 OR n>12 THEN
10980 ertype(ernum) := 1
10990 ELSE BEGIN
11000 ertype(ernum) := n ;
11010 erres (ernum) := erloc ;
11020 INSPECT Current WHEN transaction DO
11030 ertran (ernum) := id
11040 OTHERWISE
11050 ertran (ernum) := 0 ;
11060 END ;
11070 IF ernum = 14 THEN BEGIN
11080 erreur(2) ;
11090 clear_sqs ;
11100 error_report ;
11110 IF Current =/= Main THEN BEGIN
11120
11130 ACTIVATE Main DELAY 0 ;
11140 Passivate;
11150 END ;
11160 END ;
11170 erloc := 0 ;
11180 END ;
11190 PROCEDURE error_report ;
11200 BEGIN
11210 INTEGER i ;
11220 PROCEDURE phrase1 (n) ; INTEGER n;
11230 BEGIN
11240 IF n=1 THEN Outtext("IN STATION") ELSE
11250 IF n=2 THEN Outtext("IN STORAGE") ELSE
11260 IF n=3 THEN Outtext("IN QUEUE" ) ELSE
11270 Outtext("IN XXX" ) ;
11280 Outint(erres(i),3) ;
11290 Outimage ;
11300 END ;
11310 PROCEDURE phrase2 ;
11320 BEGIN
11330 Outtext(" TRANSACTION") ;
11340 Outint(ertran(i),4) ;
11350 END ;
11360 IF ernum=0 THEN GOTO exit ;
11370 skip(100) ;
11380 Outtext("GPSSS ERROR REPORT - AT TIME=") ;
11390 field:-Image.Sub(34,llength);
11400 puttime(gpsss_time);
11410 Outimage ;
11420 Outtext("******************") ; skip(1) ;
11430 Outtext("PASSE =") ;
11440 Outint(passe,3) ;
11450 skip(1) ;
11460 Outtext("** TIME **") ; Outimage ;
11470 field:-Image.Sub(1,llength);
11480 FOR i:=1 STEP 1 UNTIL ernum DO
11490 BEGIN
11500 SWITCH msg:= l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12;
11510 Outimage ;
11520 puttime(ertime(i));
11530 Setpos(llength);
11540 Outtext(" - ") ;
11550 GOTO msg(ertype(i));
11560 l1:Outtext("SYSTEM ERROR") ;
11570 GOTO Out ;
11580 l2:Outtext("TOO MANY ERRORS - SIMULATION TERMINATED");
11590 GOTO Out ;
11600 l3:phrase1 (1) ; phrase2 ;
11610 Outtext(" TRIES TO LEAVE BEFORE ENTERING") ;
11620 GOTO Out ;
11630 l4:phrase1 (2) ; phrase2 ;
11640 Outtext(" REQUIRES MORE THAN MAX CAPACITY") ;
11650 GOTO Out ;
11660 l5:phrase1 (2) ; phrase2 ;
11670 Outtext(" CAUSES OVERFLOW WHEN LEAVING") ;
11680
11690 GOTO Out ;
11700 l6:phrase1 (1) ; phrase2 ;
11710 Outtext(" TRIES TO RE-ENTER") ;
11720 GOTO Out ;
11730 l7:phrase1 (3) ; phrase2 ;
11740 Outtext(" TRIES TO LEAVE EMPTY QUEUE") ;
11750 GOTO Out ;
11760 l8:phrase1 (3) ; phrase2 ;
11770 Outtext(" TRIES TO LEAVE NON-EXISTENT QUEUE") ;
11780 GOTO Out ;
11790 l9:Outtext("RESTART USED OUTSIDE MAIN PROGRAM");
11800 Outtext(" - NO ACTION") ;
11810 GOTO Out ;
11820 l10:phrase1 (1);GOTO l13;
11830 l11:phrase1 (2);GOTO l13;
11840 l12:phrase1 (3);GOTO l13;
11850 l13:Outtext(" = NON-EXISTENT RESOURCE ");
11860 Out:
11870 Outimage ;
11880 END ;
11890 ernum := 0 ;
11900 exit:
11910 END ;
11920 COMMENT *********************
11930 POSITION DEFINITION
11940 *****************************;
11950 INTEGER PROCEDURE position ;
11960 IF
11970 (IF tlength = 0 THEN 10 ELSE tlength + 4 )
11980 + 24 + maxlength > 79 - tlength
11990 THEN BEGIN
12000 position:= 45 ;
12010 maxlength:= 11 ;
12020 tlength:=0;
12030 clear_names;
12040 skip(0);
12050 Outtext(" You have to many characters in your name(s) ");
12060 skip(1);
12070 END ELSE position:=
12080 (IF tlength = 0 THEN 10 ELSE tlength + 4 )
12090 + 24 + maxlength ;
12100 COMMENT ******************
12110 CLEAR_NAMES DEFINITION
12120 **************************;
12130 PROCEDURE clear_names;
12140 BEGIN INTEGER j;
12150 FOR j:=1 STEP 1 UNTIL max_queues DO
12160 queue_nname(j):-NOTEXT;
12170 FOR j:=1 STEP 1 UNTIL max_stations DO
12180 station_nname(j):-NOTEXT;
12190 FOR j:=1 STEP 1 UNTIL max_storages DO
12200 storage_nname(j):-NOTEXT;
12210 trans_nname:-NOTEXT;
12220 END;
12230 COMMENT ************************************
12240 INITIALISATION
12250 ********************************************;
12260 INTEGER u ;
12270 REAL time_origin, simulation_start_time ;
12280 u :=987654321;
12290 passe := 1 ;
12300 maxlength:=11;
12310 llength:=(IF secdec<0 THEN 13 ELSE
12320 IF secdec=0 THEN 16 ELSE 17+secdec);
12330 waitq :- NEW Head ;
12340 wait_moniteur :- NEW wait_monitor ;
12350 finished_objects:-NEW Head;
12360 INNER ;
12370 error_report ;
12380 IF \noreport THEN standard_report ;
12390 END GPSSS DEFINITION