home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_300 / 349_01 / sss.arc / EX_0506.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-10  |  4KB  |  176 lines
  1. Program EX_0506;
  2. {Listing 11P - see documentation in TUTOR.SSS }
  3.  
  4. uses crt, SSS;
  5. { For Pascal other than Turbo/Quick erase above line }
  6.  
  7. const
  8.   ARRIVL = 1;
  9.   STARTA = 2;
  10.   ENDACT = 3;
  11.   NEXTAC = 4;
  12.  
  13.   FINAL  = 3;
  14.  
  15. type
  16.   bool_arr = array[1..3] of Boolean;
  17.   real_arr = array[1..3] of real;
  18.  
  19. { For MS Pascal $include:'SSSP1.H' }
  20.  
  21. var
  22.   busy, block : bool_arr;
  23.   defect      : real_arr;
  24.   i, ecode    : integer;
  25.   statn, rewkn: integer;
  26.   serial      : real;
  27.   debugf      : Boolean;
  28.   ch          : char;
  29.  
  30. { For MS Pascal $include:'SSSP2.H' }
  31.  
  32. procedure prime;
  33. begin
  34.   debugf := false;
  35.   serial := 1.0;
  36.   INIQUE(3,2,3);
  37.   INISTA(1,'Prod t #1',0,0,0,0);
  38.   INISTA(2,'Prod t #2',0,0,0,0);
  39.   INISTA(3,'Prod t #3',0,0,0,0);
  40.   CREATE(0.0, 0);
  41.   SIMEND(6.0);
  42.  
  43.   for i:=1 to 3 do
  44.   begin
  45.     busy[i]  := false;
  46.     block[i] := false;
  47.   end;
  48.   defect[1]  := 0.3;
  49.   defect[2]  := 0.2;
  50.   defect[3]  := 0.1;
  51. end;
  52.  
  53. procedure deciph(i: integer);
  54. begin
  55.   statn := i mod 4; (* station number   *)
  56.   rewkn := i shr 2; (* how many reworks *)
  57. end;
  58.  
  59. procedure triggr(i: integer);
  60. begin
  61.   REMVFQ(i, 1);
  62.   SCHED(0, NEXTAC, IDE);
  63.   if i > 1 then CREATE(0, i - 1);
  64. end;
  65.  
  66. procedure unblk(statn: integer);
  67. begin
  68.   DISPOS;
  69.   if block[statn] = true then
  70.   begin
  71.     if ((NQ(statn) > 0) and (busy[statn] = false)) then
  72.       triggr(statn);
  73.     block[statn] := false;
  74.   end;
  75. end;
  76.  
  77. begin
  78.  
  79.   prime;
  80.  
  81.   repeat
  82.     ecode := NEXTEV;
  83.     if ecode > 0 then
  84.     begin
  85.       case ecode of
  86.  
  87.       ARRIVL: begin
  88.                 if IDE > 0 then unblk(IDE) else
  89.                 begin
  90.                   CREATE(EX(0.5), 0);
  91.                   SETA(1,RN(0.25, 0.05));
  92.                   SETA(2,serial);
  93.                   serial := serial + 1.0;
  94.                   SCHED(0, NEXTAC, 1);
  95.                 end;
  96.               end;
  97.  
  98.       NEXTAC: begin
  99.                 deciph(IDE);
  100.                 if debugf then write('At ',T:6:2,' # ',
  101.                   A(2):2:0,' for ',A(1):4:2,
  102.                   ' h. to station # ',statn,
  103.                   ' for ',rewkn,' rework');
  104.                 if busy[statn] or block[statn] then
  105.  
  106.                 begin
  107.                   QUEUE(statn, 0);
  108.                   if debugf then writeln(' and waits');
  109.                   if ((NQ(statn) > 4) and (statn > 1))
  110.                     then block[statn - 1] := true;
  111.                 end else
  112.  
  113.                 begin
  114.                   SCHED(0, STARTA, IDE);
  115.                   if debugf then
  116.                   begin
  117.                     writeln(' and processed');
  118.                     ch := ReadKey;
  119.                     if ch = 'q' then halt;
  120.                   end;
  121.                 end;
  122.               end;
  123.  
  124.       STARTA: begin
  125.                 deciph(IDE);
  126.                 if debugf then writeln('At ',T:6:2,
  127.                 ' # ',A(2):2:0,' starts work');
  128.                 if rewkn = 0 then TALLY(statn, 1);
  129.                 busy[statn] := true;
  130.                 SCHED(A(1), ENDACT, IDE);
  131.               end;
  132.  
  133.       ENDACT: begin
  134.                 deciph(IDE);
  135.                 TALLY(statn, 0);
  136.                 if debugf then write('At ',T:6:2,
  137.                 ' # ',A(2):2:0,' ends work');
  138.                 busy[statn] := false;
  139.                 if RA > defect[statn] then
  140.  
  141.                 begin
  142.                   if statn = FINAL then
  143.                   begin
  144.                     DISPOS;
  145.                     if debugf then
  146.                       writeln(' and discharged');
  147.                   end else
  148.  
  149.                   begin
  150.                     SETA(1, RN(0.25, 0.05));
  151.                     SCHED(0, NEXTAC, statn + 1);
  152.                     if debugf then
  153.                       writeln(' and goes on');
  154.                   end;
  155.                 end else
  156.  
  157.                 begin
  158.                   SETA(1, A(1)/2);
  159.                   SCHED(0, NEXTAC,
  160.                         statn + 4*(rewkn + 1));
  161.                     if debugf then
  162.                       writeln(' and recycled');
  163.                 end;
  164.  
  165.                 if debugf then writeln('At ',T:6:2,
  166.                 ' ',NQ(statn),' are waiting at ',statn);
  167.                 if NQ(statn) > 0 then triggr(statn);
  168.               end;
  169.       end;
  170.     end;
  171.   until ecode = 0;
  172.  
  173.   SUMRY('');
  174.  
  175. end.
  176.