Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/util/gpsss.ibm
There is 1 other file named gpsss.ibm in the archive. Click here to see a list.
ZQ
//JBGPSSS JOB (XAO875,JB142M332,1,3),'J BOSE',
// MSGLEVEL=(2,1) ,CLASS=S,TIME=(0,15)
/*SD L#GGS I PROJEKT 13-FACKET
//SIMULA EXEC SIMCLG,REGION=208K
//SIM.SYSIN DD *
%NORESWD
COMMENT (/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
//