examples/bank2.log

   1 BLOCK
   2 (* BANK DEPARTMENT SERVICE SIMULATION *)
   3
   4
   5
   6 UNIT PRIORITYQUEUE: CLASS;
   7   (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)
   8
   9
  10
  11      UNIT QUEUEHEAD: CLASS;
  12         (* HEAP ACCESING MODULE *)
  13              VAR LAST,ROOT:NODE;
  14
  15              UNIT MIN: FUNCTION: ELEM;
  16                   BEGIN
  17                 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
  18                  END MIN;
  19
  20              UNIT INSERT: PROCEDURE(R:ELEM);
  21                (* INSERTION INTO HEAP *)
  22                    VAR X,Z:NODE;
  23                  BEGIN
  24                        X:= R.LAB;
  25                        IF LAST=NONE THEN
  26                          ROOT:=X;
  27                          ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
  28                        ELSE
  29                          IF LAST.NS=0 THEN
  30                            LAST.NS:=1;
  31                            Z:=LAST.LEFT;
  32                            LAST.LEFT:=X;
  33                            X.UP:=LAST;
  34                            X.LEFT:=Z;
  35                            Z.RIGHT:=X;
  36                          ELSE
  37                            LAST.NS:=2;
  38                            Z:=LAST.RIGHT;
  39                            LAST.RIGHT:=X;
  40                            X.RIGHT:=Z;
  41                            X.UP:=LAST;
  42                            Z.LEFT:=X;
  43                            LAST.LEFT.RIGHT:=X;
  44                            X.LEFT:=LAST.LEFT;
  45                            LAST:=Z;
  46                          FI
  47                        FI;
  48                        CALL CORRECT(R,FALSE)
  49                        END INSERT;
  50
  51 UNIT DELETE: PROCEDURE(R: ELEM);
  52      VAR X,Y,Z:NODE;
  53      BEGIN
  54      X:=R.LAB;
  55      Z:=LAST.LEFT;
  56      IF LAST.NS =0 THEN
  57            Y:= Z.UP;
  58            Y.RIGHT:= LAST;
  59            LAST.LEFT:=Y;
  60            LAST:=Y;
  61                    ELSE
  62            Y:= Z.LEFT;
  63            Y.RIGHT:= LAST;
  64             LAST.LEFT:= Y;
  65                     FI;
  66        Z.EL.LAB:=X;
  67        X.EL:= Z.EL;
  68        LAST.NS:= LAST.NS-1;
  69        R.LAB:=Z;
  70        Z.EL:=R;
  71        IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
  72                        ELSE CALL CORRECT(X.EL,TRUE) FI;
  73      END DELETE;
  74
  75 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);
  76    (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)
  77      VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;
  78      BEGIN
  79      Z:=R.LAB;
  80      IF DOWN THEN
  81           WHILE NOT FIN DO
  82                  IF Z.NS =0 THEN FIN:=TRUE ELSE
  83                       IF Z.NS=1 THEN X:=Z.LEFT ELSE
  84                       IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT
  85                        FI; FI;
  86                       IF Z.LESS(X) THEN FIN:=TRUE ELSE
  87                             T:=X.EL;
  88                             X.EL:=Z.EL;
  89                             Z.EL:=T;
  90                             Z.EL.LAB:=Z;
  91                            X.EL.LAB:=X
  92                       FI; FI;
  93                  Z:=X;
  94                        OD
  95               ELSE
  96     X:=Z.UP;
  97     IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
  98     WHILE NOT LOG DO
  99           T:=Z.EL;
 100           Z.EL:=X.EL;
 101            X.EL:=T;
 102           X.EL.LAB:=X;
 103           Z.EL.LAB:=Z;
 104           Z:=X;
 105           X:=Z.UP;
 106            IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
 107             FI;
 108                 OD
 109      FI;
 110  END CORRECT;
 111
 112 END QUEUEHEAD;
 113
 114
 115 UNIT NODE: CLASS (EL:ELEM);
 116   (* ELEMENT OF THE HEAP *)
 117       VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;
 118       UNIT LESS: FUNCTION(X:NODE): BOOLEAN;
 119           BEGIN
 120           IF X= NONE THEN RESULT:=FALSE
 121                     ELSE RESULT:=EL.LESS(X.EL) FI;
 122           END LESS;
 123      END NODE;
 124
 125
 126 UNIT ELEM: CLASS(PRIOR:REAL);
 127   (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
 128    VAR LAB: NODE;
 129    UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
 130             BEGIN
 131             IF X=NONE THEN RESULT:= FALSE ELSE
 132                            RESULT:= PRIOR< X.PRIOR FI;
 133             END LESS;
 134     BEGIN
 135     LAB:= NEW NODE(THIS ELEM);
 136     END ELEM;
 137
 138
 139 END PRIORITYQUEUE;
 140
 141
 142
 143 UNIT SIMULATION: PRIORITYQUEUE CLASS;
 144 (* THE LANGUAGE FOR SIMULATION PURPOSES *)
 145
 146   VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)
 147       PQ:QUEUEHEAD,  (* THE TIME AXIS *)
 148        MAINPR: MAINPROGRAM;
 149
 150
 151       UNIT SIMPROCESS: COROUTINE;
 152         (* USER PROCESS PREFIX *)
 153              VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)
 154                  EVENTAUX: EVENTNOTICE,
 155                  (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
 156                  (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)
 157                  FINISH: BOOLEAN;
 158
 159              UNIT IDLE: FUNCTION: BOOLEAN;
 160                    BEGIN
 161                    RESULT:= EVENT= NONE;
 162                    END IDLE;
 163
 164              UNIT TERMINATED: FUNCTION :BOOLEAN;
 165                    BEGIN
 166                   RESULT:= FINISH;
 167                    END TERMINATED;
 168
 169              UNIT EVTIME: FUNCTION: REAL;
 170              (* TIME OF ACTIVATION *)
 171                   BEGIN
 172                   IF IDLE THEN CALL ERROR1;
 173                                            FI;
 174                   RESULT:= EVENT.EVENTTIME;
 175                   END EVTIME;
 176
 177     UNIT ERROR1:PROCEDURE;
 178                 BEGIN
 179                 ATTACH(MAIN);
 180                 WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
 181                 END ERROR1;
 182
 183      UNIT ERROR2:PROCEDURE;
 184                  BEGIN
 185                  ATTACH(MAIN);
 186                  WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
 187                  END ERROR2;
 188              BEGIN
 189
 190              RETURN;
 191              INNER;
 192              FINISH:=TRUE;
 193               CALL PASSIVATE;
 194              CALL ERROR2;
 195           END SIMPROCESS;
 196
 197
 198 UNIT EVENTNOTICE: ELEM CLASS;
 199   (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)
 200       VAR EVENTTIME: REAL, PROC: SIMPROCESS;
 201
 202       UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
 203        (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
 204                   BEGIN
 205                   IF X=NONE THEN RESULT:= FALSE ELSE
 206                   RESULT:= EVENTTIME< X.EVENTTIME OR
 207                   (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;
 208
 209                END LESS;
 210     END EVENTNOTICE;
 211
 212
 213 UNIT MAINPROGRAM: SIMPROCESS CLASS;
 214  (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
 215       BEGIN
 216       DO ATTACH(MAIN) OD;
 217       END MAINPROGRAM;
 218
 219 UNIT TIME:FUNCTION:REAL;
 220  (* CURRENT VALUE OF SIMULATION TIME *)
 221      BEGIN
 222      RESULT:=CURRENT.EVTIME
 223      END TIME;
 224
 225 UNIT CURRENT: FUNCTION: SIMPROCESS;
 226    (* THE FIRST PROCESS ON THE TIME AXIS *)
 227      BEGIN
 228      RESULT:=CURR;
 229      END CURRENT;
 230
 231 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
 232  (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)
 233  (* WITHIN TIME MOMENT T                                                  *)
 234       BEGIN
 235       IF T<TIME THEN T:= TIME FI;
 236       IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
 237       IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
 238                 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
 239                 P.EVENT.PROC:= P;
 240                                       ELSE
 241        IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
 242                P.EVENT:= P.EVENTAUX;
 243                P.EVENT.PRIOR:=RANDOM;
 244                                           ELSE
 245    (* NEW SCHEDULING *)
 246                P.EVENT.PRIOR:=RANDOM;
 247                CALL PQ.DELETE(P.EVENT)
 248                                 FI; FI;
 249       P.EVENT.EVENTTIME:= T;
 250       CALL PQ.INSERT(P.EVENT) FI;
 251 END SCHEDULE;
 252
 253 UNIT HOLD:PROCEDURE(T:REAL);
 254  (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
 255  (* REDEFINE PRIOR                                  *)
 256      BEGIN
 257      CALL PQ.DELETE(CURRENT.EVENT);
 258      CURRENT.EVENT.PRIOR:=RANDOM;
 259      IF T<0 THEN T:=0; FI;
 260       CURRENT.EVENT.EVENTTIME:=TIME+T;
 261      CALL PQ.INSERT(CURRENT.EVENT);
 262      CALL CHOICEPROCESS;
 263      END HOLD;
 264
 265 UNIT PASSIVATE: PROCEDURE;
 266   (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
 267      BEGIN
 268       CALL PQ.DELETE(CURRENT.EVENT);
 269       CURRENT.EVENT:=NONE;
 270       CALL CHOICEPROCESS
 271      END PASSIVATE;
 272
 273 UNIT RUN: PROCEDURE(P:SIMPROCESS);
 274  (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
 275  (* PRIOR                                                              *)
 276      BEGIN
 277      CURRENT.EVENT.PRIOR:=RANDOM;
 278      IF NOT P.IDLE THEN
 279             P.EVENT.PRIOR:=0;
 280             P.EVENT.EVENTTIME:=TIME;
 281             CALL PQ.CORRECT(P.EVENT,FALSE)
 282                     ELSE
 283       IF P.EVENTAUX=NONE THEN
 284             P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
 285             P.EVENT.EVENTTIME:=TIME;
 286             P.EVENT.PROC:=P;
 287             CALL PQ.INSERT(P.EVENT)
 288                         ELSE
 289              P.EVENT:=P.EVENTAUX;
 290              P.EVENT.PRIOR:=0;
 291              P.EVENT.EVENTTIME:=TIME;
 292              P.EVENT.PROC:=P;
 293              CALL PQ.INSERT(P.EVENT);
 294                           FI;FI;
 295       CALL CHOICEPROCESS;
 296 END RUN;
 297
 298 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
 299  (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
 300    BEGIN
 301    IF P= CURRENT THEN CALL PASSIVATE ELSE
 302     CALL PQ.DELETE(P.EVENT);
 303     P.EVENT:=NONE;  FI;
 304  END CANCEL;
 305
 306 UNIT CHOICEPROCESS:PROCEDURE;
 307  (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
 308    VAR P:SIMPROCESS;
 309    BEGIN
 310    P:=CURR;
 311    CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
 312     IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;
 313                       ATTACH(MAIN);
 314                  ELSE ATTACH(CURR); FI;
 315 END CHOICEPROCESS;
 316
 317 BEGIN
 318   PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)
 319   CURR,MAINPR:=NEW MAINPROGRAM;
 320   MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);
 321   MAINPR.EVENT.EVENTTIME:=0;
 322   MAINPR.EVENT.PROC:=MAINPR;
 323   CALL PQ.INSERT(MAINPR.EVENT);
 324   (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)
 325   INNER;
 326   PQ:=NONE;
 327 END SIMULATION;
 328
 329
 330
 331 UNIT LISTS:SIMULATION CLASS;
 332  (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)
 333
 334            UNIT LINKAGE:CLASS;
 335             (*WE WILL USE TWO WAY LISTS *)
 336                 VAR SUC1,PRED1:LINKAGE;
 337                           END LINKAGE;
 338             UNIT HEAD:LINKAGE CLASS;
 339             (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
 340                       UNIT FIRST:FUNCTION:LINK;
 341                                  BEGIN
 342                              IF SUC1 IN LINK THEN RESULT:=SUC1
 343                                              ELSE RESULT:=NONE FI;
 344                                  END;
 345                       UNIT EMPTY:FUNCTION:BOOLEAN;
 346                                  BEGIN
 347                                  RESULT:=SUC1=THIS LINKAGE;
 348                                  END EMPTY;
 349                    BEGIN
 350                    SUC1,PRED1:=THIS LINKAGE;
 351                      END HEAD;
 352
 353           UNIT LINK:LINKAGE CLASS;
 354            (* ORDINARY LIST ELEMENT PREFIX *)
 355                      UNIT OUT:PROCEDURE;
 356                               BEGIN
 357                               IF SUC1=/=NONE THEN
 358                                     SUC1.PRED1:=PRED1;
 359                                     PRED1.SUC1:=SUC1;
 360                                     SUC1,PRED1:=NONE FI;
 361                                END OUT;
 362                      UNIT INTO:PROCEDURE(S:HEAD);
 363                                BEGIN
 364
 365                                CALL OUT;
 366                                IF S=/= NONE THEN
 367                                     IF S.SUC1=/=NONE THEN
 368                                             SUC1:=S;
 369                                             PRED1:=S.PRED1;
 370                                             PRED1.SUC1:=THIS LINKAGE;
 371                                             S.PRED1:=THIS LINKAGE;
 372                                                  FI FI;
 373                                   END INTO;
 374                   END LINK;
 375
 376      UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
 377      (* USER DEFINED  PROCESS WILL BE JOINED INTO LISTS  *)
 378                     END ELEM;
 379
 380     END LISTS;
 381
 382
 383
 384
 385
 386   (*BEGIN OF BANK DEPARTMENT SIMULATION*)
 387
 388
 389   UNIT OFFICE:LISTS CLASS; (*AN OFFICE*)
 390
 391      UNIT TILL:SIMPROCESS CLASS(QUEUE:HEAD);
 392      (* TELLER WITH CUSTOMERS QUEUEING UP *)
 393             UNIT VIRTUAL SERVICE:PROCEDURE;
 394              (* SERVICE OF THIS TELLER WILL BE PRECISED LATER *)
 395                                  END SERVICE;
 396               VAR CSTM:CUSTOMER,  (*THE CUSTOMER BEING SERVED*)
 397                   REST,PAUSE:REAL;
 398
 399               BEGIN
 400               PAUSE:=TIME;
 401               DO
 402               REST:=REST+TIME-PAUSE;
 403               WHILE NOT QUEUE.EMPTY DO
 404                (* SERVE ALL QUEUE *)
 405                        CSTM:=QUEUE.FIRST QUA ELEM.SPROCESS;
 406                        CALL SERVICE;
 407                        CALL SCHEDULE(CSTM,TIME);
 408                                        OD;
 409               PAUSE:=TIME;
 410               CALL PASSIVATE
 411               OD;
 412      END TILL;
 413
 414    UNIT CUSTOMER:SIMPROCESS CLASS;
 415
 416               VAR ELLIST:ELEM, K:INTEGER;
 417               UNIT ARRIVAL:PROCEDURE(S:TILL);
 418               (* ATTACHING TELLER S *)
 419                         BEGIN
 420                         IF S=/=NONE THEN
 421                           ELLIST:=NEW ELEM(THIS CUSTOMER);
 422                           CALL ELLIST.INTO(S.QUEUE);
 423                           IF S.IDLE THEN CALL SCHEDULE(S,TIME) FI;
 424                           CALL PASSIVATE; FI;
 425                         END ARRIVAL;
 426        END CUSTOMER;
 427
 428  END OFFICE;
 429
 430
 431
 432 UNIT BANKDEPARTMENT:OFFICE CLASS;
 433
 434
 435     UNIT COUNTER:TILL CLASS;
 436               VAR PAYTIME:REAL; (*RANDOM SERVICE TIME*)
 437               UNIT VIRTUAL SERVICE:PROCEDURE;
 438                  BEGIN
 439                  WRITELN(" THE PAY DESK  SERVES CUSTOMER NO",CSTM.K,
 440                          " AT",TIME:10:4);
 441                  CALL CSTM.ELLIST.OUT;
 442                  PAYTIME:=RANDOM*2+2;
 443                  CALL HOLD(PAYTIME);
 444                  END SERVICE;
 445     END COUNTER;
 446
 447
 448     UNIT TELLER:TILL CLASS(NUMBER:INTEGER);
 449               VAR SERVICETIME:REAL;
 450               UNIT VIRTUAL SERVICE:PROCEDURE;
 451                  VAR N:INTEGER;
 452                  BEGIN
 453                  WRITELN(" THE TELLER NO",NUMBER," WAS IDLE FOR",REST:10:4,
 454                          " SEC");
 455                   CALL CSTM.ELLIST.OUT;
 456                   N:=CSTM QUA BANKCUSTOMER.NO;
 457                   WRITELN(" THE CUSTOMER NO",CSTM.K,
 458                           " BEGINS TO BE SERVED BY THE TELLER NO",NUMBER,
 459                           " AT",TIME:10:4);
 460                   ACCOUNT(N):=ACCOUNT(N)+CSTM QUA BANKCUSTOMER.AMOUNT;
 461                   IF ACCOUNT(N)<0 THEN CALL CSTM.ARRIVAL(CONTROL);FI;
 462                   SERVICETIME:=RANDOM*7+3;
 463                   CALL HOLD(SERVICETIME);
 464
 465                  END SERVICE;
 466           END TELLER;
 467
 468
 469     UNIT BANKCUSTOMER:CUSTOMER CLASS(NO:INTEGER,AMOUNT:REAL);
 470     (* BANK CUSTOMER. AMOUNT- THE MONEY TO BE PAID AT THE BANK *)
 471             VAR ARRIVALTIME,STAYTIME:REAL,CHOOSETELLER:INTEGER;
 472                BEGIN
 473                I:=I+1;
 474                K:=I;
 475                ARRIVALTIME:=TIME;
 476                WRITELN(" THE CUSTOMER NO",K," ARRIVED AT",TIME:10:4);
 477                CHOOSETELLER:=RANDOM*5+1;
 478                CALL ARRIVAL(TELLERS(CHOOSETELLER));
 479                IF AMOUNT<0 THEN CALL ARRIVAL(CTR); FI;
 480                STAYTIME:=TIME-ARRIVALTIME;
 481                WRITELN(" THE CUSTOMER NO",K," STAYED AT THE BANK FOR",
 482                        STAYTIME:10:4," SEC; STATE OF ACCOUNT",ACCOUNT(NO):10:4);
 483             END BANKCUSTOMER;
 484
 485   VAR TELLERS:ARRAYOF TELLER,ACCOUNT:ARRAYOF REAL;
 486   VAR CTR:COUNTER, CONTROL:TILL,I:INTEGER;
 487
 488      BEGIN   (* NEW BANK DEPARTMENT GENERATION *)
 489     CTR:=NEW COUNTER(NEW HEAD);
 490     ARRAY TELLERS DIM(1:5);  (* WE DEAL WITH 5 TELLES *)
 491     FOR I:=1 TO 5 DO  TELLERS(I):=NEW TELLER(NEW HEAD,I); OD;
 492     ARRAY ACCOUNT DIM(1:100);
 493     (* WE DEAL WITH 100 ACOUNTS IN THIS BANK DEPARTMENT *)
 494     FOR I:=1 TO 100 DO  ACCOUNT(I):=RANDOM*901+100; OD;
 495                   (* AN ACCOUNT VALUE CAN FLUCTUATE FROM 100 TO 1000$ *)
 496     I:=0;
 497  END BANKDEPARTMENT;
 498
 499
 500
 501  BEGIN (* OF PROGRAM *)
 502    PREF BANKDEPARTMENT BLOCK
 503         UNIT GENERATOR:SIMPROCESS CLASS;
 504          (* CUSTOMERS GENERATION *)
 505               BEGIN
 506               DO
 507               CALL SCHEDULE(NEW BANKCUSTOMER(RANDOM*100+1,
 508                               RANDOM*9996+5),TIME);
 509               CALL HOLD(RANDOM*10);
 510               CALL SCHEDULE(NEW BANKCUSTOMER(RANDOM*100+1,
 511                           -(RANDOM*900+5)),TIME);
 512               CALL HOLD(RANDOM*10);
 513               OD
 514               END GENERATOR;
 515       BEGIN
 516       WRITELN(" BANK DEPARTMENT SERVICE SIMULATION");
 517       WRITELN;
 518       CALL SCHEDULE(NEW GENERATOR,TIME);
 519       CALL HOLD (40);
 520        END
 521 END