Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/util/gpsss.sim
There is 1 other file named gpsss.sim in the archive. Click here to see a list.
OPTIONS(/E/L);
Simulation CLASS gpsss(max_queues,max_stations,max_storages);
INTEGER max_queues,max_stations,max_storages;
BEGIN
COMMENT **************************************************
MONTREAL GPSSS PACKAGE + VERSION 4.1 +
WRITTEN - FEBRUARY 1972
UPDATED - SEPTEMBER 1974
AUTHOR - JEAN G. VAUCHER
PROFESSEUR AGREGE
DEPARTEMENT D INFORMATIQUE
UNIVERSITE DE MONTREAL
C.P. 6128 , MONTREAL 101
CANADA
CONVERTED TO DECSYSTEM 10 - JUNE 1976
BY H-JOACHIM BOSE
**********************************************************;
REF (facility) ARRAY station (1:max_stations );
REF (storage ) ARRAY box (1:max_storages);
REF (q ) ARRAY file (1:max_queues) ;
INTEGER transid ;
INTEGER nstat, nstor, nque, passe ;
COMMENT **************************************************
FACILITY DEFINITION
**********************************************************;
CLASS facility;
BEGIN
REF (Head) inq;
REF (transaction) occupier;
INTEGER entries ;
REAL tlast, busy_time ;
BOOLEAN PROCEDURE busy;
busy := occupier =/= NONE ;
inq :- NEW Head ;
tlast := time_origin ;
END FACILITY DEFINITION;
COMMENT **************************************************
STORAGE DEFINITION
**********************************************************;
CLASS storage (capacity);
INTEGER capacity;
BEGIN
REF (Head) inq;
INTEGER max,entries,unit_entries; REAL contents;
REAL tlast, intgrl;
PROCEDURE check_inq;
BEGIN
REF (transaction) client, next_client;
client :- inq.First;
loop:
IF client == NONE OR contents= capacity
THEN GOTO fin;
next_client :- client.Suc ;
ACTIVATE client ;
client :- next_client;
GOTO loop;
fin:
END OF CHECK_INQ ;
inq :- NEW Head ;
tlast := time_origin ;
END STORAGE DEFINITION ;
COMMENT ************
STORAGE CREATION
********************;
PROCEDURE set_storage (n,capacity);
INTEGER n, capacity;
BEGIN
nstor := nstor + 1 ;
box (n) :- NEW storage (capacity);
END ;
COMMENT **************************************************
QUEUE DEFINITION
**********************************************************;
CLASS q ;
BEGIN
INTEGER entries, max ;
REAL intgrl, tlast, contents;
tlast := time_origin ;
END ;
COMMENT **************************************************
TRANSACTION DEFINITION
**********************************************************;
Process CLASS transaction ;
BEGIN
REAL time_mark, priority;
INTEGER id ;
COMMENT ************
ENTER_STATION
********************;
PROCEDURE enter_station (n);
INTEGER n ;
BEGIN
start:
INSPECT station(n) DO
BEGIN
IF occupier == THIS transaction THEN
BEGIN
erloc := n ;
erreur(6);
GOTO exit;
END ;
IF busy THEN BEGIN
priority_into(inq);
Passivate;
Out;
END ELSE tlast := Time;
entries := entries+1;
occupier :- THIS transaction;
exit:
END
OTHERWISE BEGIN
station (n) :- NEW facility;
nstat := nstat+1;
GOTO start;
END ;
END ENTER_STATION ;
COMMENT ************
LEAVE_STATION
********************;
PROCEDURE leave_station (n) ;
INTEGER n ;
BEGIN
INSPECT station (n) WHEN facility DO
BEGIN
IF occupier =/= THIS transaction THEN
BEGIN
erloc := n ;
erreur (3);
GOTO exit ;
END ;
IF inq.Empty THEN BEGIN
occupier :- NONE ;
busy_time:=busy_time + Time - tlast;
END
ELSE BEGIN
occupier :- inq.First;
ACTIVATE inq.First DELAY 0 ;
END ;
exit:
END OTHERWISE BEGIN
erloc := n ;
erreur(3) ;
END ;
END LEAVE_STATION ;
COMMENT ************
ENTER_STORAGE
********************;
PROCEDURE enter_storage (n, units_required) ;
INTEGER n, units_required ;
BEGIN
IF box (n) == NONE THEN set_storage(n,1000000) ;
INSPECT box (n) WHEN storage DO
BEGIN
IF units_required>capacity THEN
BEGIN
erloc := n ;
erreur (4);
GOTO error_exit ;
END ;
priority_into (inq);
test:
IF units_required <= capacity-contents THEN GOTO exit;
Passivate;
GOTO test;
exit:
Out;
entries:=entries+1;
unit_entries:=unit_entries+units_required;
Accum(intgrl,tlast,contents,units_required);
IF contents> max THEN max := contents;
Hold (0);
END INSPECT ;
error_exit:
END ENTER_STORAGE;
COMMENT ************
LEAVE_STORAGE
********************;
PROCEDURE leave_storage (n,units_released);
INTEGER n,units_released;
INSPECT box (n) WHEN storage DO
BEGIN
Accum(intgrl,tlast,contents,-(units_released)) ;
IF contents< 0 THEN BEGIN
erloc:=n;
erreur (5);
contents:= 0;
END ELSE check_inq;
END
OTHERWISE set_storage (n,1000000) ;
COMMENT ************
ENTER_QUEUE
********************;
PROCEDURE enter_queue (n);
INTEGER n ;
BEGIN
IF file (n) == NONE THEN BEGIN
file (n) :- NEW q;
nque := nque + 1;
END ;
INSPECT file (n) DO
BEGIN
entries := entries +1;
Accum (intgrl,tlast,contents,1);
IF contents>max THEN max := contents;
END ;
END ENTER_QUEUE;
COMMENT ************
LEAVE_QUEUE
********************;
PROCEDURE leave_queue (n) ;
INTEGER n;
INSPECT file (n) DO
IF contents= 0 THEN BEGIN
erloc:= n ;
erreur(7) ; END
ELSE Accum (intgrl,tlast,contents,-1)
OTHERWISE BEGIN
erloc := n ;
erreur(8);
file (n) :- NEW q ;
nque := nque +1 ;
END ;
COMMENT ************
PRIORITY_INTO
********************;
PROCEDURE priority_into (queue) ;
REF (Head) queue;
BEGIN
REF (transaction) pt ;
REF (Process) p ;
IF queue.Empty THEN Into(queue)
ELSE BEGIN
COMMENT SKIP NON TRANSACTION OBJECTS ;
p:-queue.Last ;
l: IF p IN transaction OR p== NONE THEN BEGIN
pt:-p;
GOTO loop;
END ;
p:-p.Pred ;
GOTO l;
predec: pt :- pt.Pred ;
loop: IF pt== NONE THEN Precede(queue.First)
ELSE IF priority<pt.priority THEN GOTO predec
ELSE IF priority=pt.priority AND priority<0
THEN GOTO predec
ELSE Follow (pt);
END ;
END PROCEDURE PRIORITY_INTO ;
time_mark := gpsss_time ;
transid := transid + 1 ;
id := transid ;
END CLASS TRANSACTION ;
COMMENT *******************************
WAIT_UNTIL PARAPHENALIA
***************************************;
REF (Head) waitq ;
REF (wait_monitor) wait_moniteur ;
BOOLEAN wait_action ;
PROCEDURE wait_until (b); NAME b; BOOLEAN b ;
INSPECT Current DO BEGIN
IF b THEN GOTO exit ;
IF Current IN transaction THEN
Current QUA transaction.priority_into(waitq)
ELSE Into(waitq);
IF wait_moniteur.Idle THEN
ACTIVATE wait_moniteur AFTER Nextev ;
loop:
Passivate;
IF NOT b THEN GOTO loop ;
Out ;
wait_action := TRUE ;
exit:
END WAIT_UNTIL ;
Process CLASS wait_monitor ;
BEGIN
REF (Process) pt ;
start:
IF waitq.Empty THEN Passivate ;
wait_action := FALSE ;
pt :- waitq.First ;
loop:
IF pt == NONE THEN GOTO Wait ;
ACTIVATE pt ;
IF wait_action THEN GOTO start ;
pt :- pt.Suc ;
GOTO loop ;
Wait:
REACTIVATE Current AFTER Nextev ;
GOTO start ;
END WAIT_MONITOR ;
COMMENT
******************************
PROCEDURES UTILITAIRES
******************************;
PROCEDURE skip (n) ;
INTEGER n;
BEGIN
Outimage;
IF n>0 THEN BEGIN
IF Line+n > 60 THEN Eject(2)
ELSE Eject (Line+n);
END ;
END PROC SKIP;
REAL PROCEDURE gpsss_time ;
gpsss_time := Time- simulation_start_time ;
PROCEDURE clear_sqs ;
l1: IF Current.Nextev =/= NONE THEN
BEGIN
Cancel (Current.Nextev) ;
GOTO l1 ;
END ;
PROCEDURE restart ;
BEGIN
INTEGER i ;
IF Current =/= Main THEN BEGIN
erreur(9) ; GOTO Out ; END ;
error_report ;
standard_report ;
passe := passe + 1 ;
COMMENT CANCEL ALL RESOURCES ;
FOR i := 1 STEP 1 UNTIL max_stations DO
station (i) :- NONE ;
FOR i := 1 STEP 1 UNTIL max_storages DO
box (i) :- NONE ;
FOR i := 1 STEP 1 UNTIL max_queues DO
file (i) :- NONE ;
COMMENT CANCEL ALL EVENTS ;
clear_sqs ;
simulation_start_time := Time ;
nstat := nstor := nque := 0 ;
transid := 0 ;
u := 987654321 ;
Out:
END ;
COMMENT *****************************************
ENQUIRY PROCEDURES
*************************************************;
INTEGER PROCEDURE contents_station(n) ;
INTEGER n ;
INSPECT station(n) DO
IF busy THEN contents_station := 1 ;
INTEGER PROCEDURE contents_storage (n) ;
INTEGER n ;
INSPECT box (n) DO
contents_storage := contents;
INTEGER PROCEDURE contents_queue (n) ;
INTEGER n ;
INSPECT file (n) DO
contents_queue := contents ;
INTEGER PROCEDURE waiting_station (n) ;
INTEGER n ;
INSPECT station (n) DO
waiting_station := inq.Cardinal ;
INTEGER PROCEDURE waiting_storage (n) ;
INTEGER n ;
INSPECT box (n) DO
waiting_storage := inq.Cardinal ;
INTEGER PROCEDURE waiting_queue (n) ;
INTEGER n ;
waiting_queue := 0 ;
COMMENT **************************************************
REPORT GENERATOR
**********************************************************;
PROCEDURE standard_report ;
BEGIN
INTEGER i;
BOOLEAN sbus;
REAL dtime;
dtime := Time-time_origin;
skip(100);
Outtext("***************************");
Outtext(" -VERSION 4.1-") ; Outimage ;
Outtext("*** MONTREAL GPSSS ***"); skip(0) ;
Outtext("*** SIMULATION REPORT ***");
skip(0); Outtext("***************************");
skip(2);
Outtext("PASSE =") ;
Outint(passe,3) ;
skip(1) ;
Outtext("START TIME=");
Outfix(time_origin-simulation_start_time,2,10);
skip(0);
Outtext("END TIME=");
Outfix(gpsss_time,2,10);
IF dtime=0 THEN BEGIN
skip(2);
Outtext("ELAPSED TIME = 0 - REPORT SKIPPED") ;
GOTO exit ;
END ;
skip(2);
IF nstat=0 THEN BEGIN
Outtext("* NO STATIONS *");
GOTO l1;
END ;
Outtext("* STATIONS *");
skip(0); Outtext("************");
skip(1);
Setpos(15);
Outtext("AVERAGE");
Setpos(38);
Outtext("AVERAGE");
skip(0);
Outtext
(" STATION UTILISATION ENTRIES TRANSIT TIME STATUS");
skip(1);
FOR i:=1 STEP 1 UNTIL max_stations DO
INSPECT station(i) DO
BEGIN
sbus := busy ;
IF sbus THEN busy_time:=busy_time+Time-tlast;
Outint(i,7);
Outfix(busy_time/dtime,2,13);
Outint(entries,10);
Setpos(36);
Outfix(busy_time/entries,2,10);
Setpos(52);
IF sbus THEN Outtext("BUSY")
ELSE Outtext("FREE");
COMMENT RE-INITIALISATION DES STATISTIQUES ;
IF sbus THEN entries :=1 ELSE entries :=0 ;
busy_time := 0;
tlast := Time;
skip(0);
END ;
l1:
skip(2);
IF nstor=0 THEN BEGIN
Outtext("* NO STORAGES *");
GOTO l2;
END ;
Outtext("* STORAGES *");
skip(0); Outtext("************");
skip(1);
Setpos(22); Outtext("AVG.");
Setpos(31); Outtext("AVG.");
Setpos(47); Outtext("THRU TIME");
Setpos(61); Outtext("CONTENTS");
skip(0);
Outtext
("STORAGE CAPACITY CONTENTS UTIL. ENTRIES ");
Outtext
(" / UNIT MAX NOW");
skip(1);
FOR i:=1 STEP 1 UNTIL max_storages DO
INSPECT box(i) DO
BEGIN
Accum(intgrl,tlast,contents,0);
Outint(i,5);
Outint(capacity,10) ;
Outfix(intgrl/dtime,2,12) ;
IF capacity=0 THEN Setpos(56) ELSE
Outfix(intgrl/(dtime*capacity),4,8);
Outint(entries,8);
IF unit_entries=0 THEN Setpos(56) ELSE
Outfix (intgrl/unit_entries,2,12);
Outint(max,7);
Outint(contents,7);
skip(0);
COMMENT RE-INITIALISATION DES STATISTIQUES ;
entries := 0;
unit_entries := contents;
intgrl := 0 ;
tlast := Time;
max := contents;
END ;
l2:
skip(2);
IF nque=0 THEN BEGIN
Outtext("* NO QUEUES *");
GOTO exit;
END ;
Outtext("* QUEUES *") ;
skip(0); Outtext("**********") ;
skip(1);
Setpos(19); Outtext(
"MAX. CURRENT AVG. AVG.") ;
skip(0); Outtext(
"QUEUE ENTRIES CONTENTS CONTENTS CONTENTS TIME/TRANS");
skip(1);
FOR i := 1 STEP 1 UNTIL max_queues DO
INSPECT file (i) DO
BEGIN
Accum(intgrl,tlast,contents,0);
Outint(i,4);
Outint(entries,8);
Outint(max,10);
Outint(contents,10);
Outfix(intgrl/dtime,2,11);
IF entries=0 THEN GOTO over;
Outfix(intgrl/entries,2,11);
over:
intgrl := 0;
max := entries := contents;
skip(0) ;
END ;
exit:
time_origin := Time;
END PROC STANDARD_REPORT ;
COMMENT ******************************
ERROR PACKAGE
***************************************;
INTEGER ernum,erloc ;
INTEGER ARRAY ertype(1:15),erres (1:15), ertran (1:15) ;
REAL ARRAY ertime (1:15) ;
PROCEDURE erreur (n) ;
INTEGER n ;
BEGIN
ernum := ernum + 1 ;
ertime (ernum) := gpsss_time ;
IF n<2 OR n>9 THEN
ertype(ernum) := 1
ELSE BEGIN
ertype(ernum) := n ;
erres (ernum) := erloc ;
INSPECT Current WHEN transaction DO
ertran (ernum) := id
OTHERWISE
ertran (ernum) := 0 ;
END ;
IF ernum = 14 THEN BEGIN
erreur(2) ;
clear_sqs ;
error_report ;
IF Current =/= Main THEN BEGIN
ACTIVATE Main DELAY 0 ;
Passivate;
END ;
END ;
erloc := 0 ;
END ;
PROCEDURE error_report ;
BEGIN
INTEGER i ;
PROCEDURE phrase1 (n) ; INTEGER n;
BEGIN
IF n=1 THEN Outtext("IN STATION") ELSE
IF n=2 THEN Outtext("IN STORAGE") ELSE
IF n=3 THEN Outtext("IN QUEUE" ) ELSE
Outtext("IN XXX" ) ;
Outint(erres(i),3) ;
Outimage ;
END ;
PROCEDURE phrase2 ;
BEGIN
Outtext(" TRANSACTION") ;
Outint(ertran(i),4) ;
END ;
IF ernum=0 THEN GOTO exit ;
skip(100) ;
Outtext("GPSSS ERROR REPORT - AT TIME=") ;
Outfix(gpsss_time,2,10) ;
Outimage ;
Outtext("******************") ; skip(1) ;
Outtext("PASSE =") ;
Outint(passe,3) ;
skip(1) ;
Outtext("** TIME **") ; Outimage ;
FOR i:=1 STEP 1 UNTIL ernum DO
BEGIN
Outimage ;
Outfix(ertime(i),2,10) ;
Outtext(" - ") ;
IF ertype(i)=1 THEN GOTO l1 ;
IF ertype(i)=2 THEN GOTO l2 ;
IF ertype(i)=3 THEN GOTO l3 ;
IF ertype(i)=4 THEN GOTO l4 ;
IF ertype(i)=5 THEN GOTO l5 ;
IF ertype(i)=6 THEN GOTO l6 ;
IF ertype(i)=7 THEN GOTO l7 ;
IF ertype(i)=8 THEN GOTO l8 ;
IF ertype(i)=9 THEN GOTO l9;
l1:Outtext("SYSTEM ERROR") ;
GOTO Out ;
l2:Outtext("TOO MANY ERRORS - SIMULATION TERMINATED");
GOTO Out ;
l3:phrase1 (1) ; phrase2 ;
Outtext(" TRIES TO LEAVE_BEFORE ENTERING") ;
GOTO Out ;
l4:phrase1 (2) ; phrase2 ;
Outtext(" REQUIRES MORE THAN MAX CAPACITY") ;
GOTO Out ;
l5:phrase1 (2) ; phrase2 ;
Outtext(" CAUSES OVERFLOW WHEN LEAVING") ;
GOTO Out ;
l6:phrase1 (1) ; phrase2 ;
Outtext(" TRIES TO RE-ENTER") ;
GOTO Out ;
l7:phrase1 (3) ; phrase2 ;
Outtext(" TRIES TO LEAVE_EMPTY QUEUE") ;
GOTO Out ;
l8:phrase1 (3) ; phrase2 ;
Outtext(" TRIES TO LEAVE_NON-EXISTENT QUEUE") ;
GOTO Out ;
l9:Outtext("RESTART USED OUTSIDE MAIN PROGRAM");
Outtext(" - NO ACTION") ;
GOTO Out ;
Out:
Outimage ;
END ;
ernum := 0 ;
exit:
END ;
COMMENT ************************************
INITIALISATION
********************************************;
INTEGER u ;
REAL time_origin, simulation_start_time ;
u :=987654321;
passe := 1 ;
waitq :- NEW Head ;
wait_moniteur :- NEW wait_monitor ;
INNER ;
error_report ;
standard_report ;
END GPSSS DEFINITION