Google
 

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