home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Interactive Reference Guide / C-C++ Interactive Reference Guide.iso / c_ref / csource5 / 349_01 / sss.arc / EX_0506.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-04-16  |  3.8 KB  |  158 lines
  1. ' Program EX_0506.BAS
  2. ' Listing 11B - see documentation in TUTOR.SSS
  3.  
  4. const ARRIVL = 1, STARTA = 2, ENDACT = 3, NEXTAC = 4
  5. const FINAL = 3
  6. const FALSE = 0, TRUE = not FALSE
  7.  
  8. dim shared busy(1 to 3), block(1 to 3), defect(1 to 3)
  9.  
  10. common shared ecode, statn, rewkn, debugf, serial
  11.  
  12. declare sub waital ()
  13. declare sub prime ()
  14. declare sub deciph (i%)
  15. declare sub triggr (i)
  16. declare sub unblk (i%)
  17.  
  18. rem $include: 'SSSB.H'
  19.  
  20.   prime
  21.  
  22.   f1$ = "&#####.##&##"
  23.   f2$ = "&#####.##"
  24.   f3$ = "##&##"
  25.  
  26.   do
  27.     ecode = NEXTEV
  28.     if ecode > 0 then
  29.       select case ecode
  30.  
  31.       case ARRIVL
  32.              if IDE > 0 then
  33.                unblk IDE
  34.              else
  35.                CREATE EX(.5), 0
  36.                SETA 1, RN(.25, .05)
  37.                SETA 2, serial
  38.                serial = serial + 1
  39.                SCHED 0, NEXTAC, 0
  40.              end if
  41.  
  42.       case NEXTAC
  43.              deciph IDE
  44.              if debugf then
  45.                print using f1$; "At "; T; " #"; A(2);
  46.                print using f2$; " for "; A(1);
  47.                print "h. to station #";
  48.                print using f3$; statn; " for "; rewkn;
  49.                print " rework";
  50.              end if
  51.  
  52.              if busy(statn) or block(statn) then
  53.                QUEUE statn, 0
  54.                if debugf then print " and waits"
  55.                if NQ(statn) > 4 and statn > 1 then
  56.                  block(statn - 1) = TRUE
  57.                end if
  58.  
  59.              else
  60.                SCHED 0, STARTA, IDE
  61.                if debugf then
  62.                  print " and processed"
  63.                  waital
  64.                end if
  65.              end if
  66.  
  67.       case STARTA
  68.                deciph IDE
  69.                if debugf then
  70.                  print using f1$; "At "; T; " #"; A(2);
  71.                  print " starts working at station #";
  72.                  print statn
  73.                end if
  74.                if rewkn = 0 then TALLY statn, 1
  75.                busy(statn) = TRUE
  76.                SCHED A(1), ENDACT, IDE
  77.  
  78.       case ENDACT
  79.                deciph IDE
  80.                TALLY statn, 0
  81.                if debugf then
  82.                  print using f1$; "At "; T; " #"; A(2);
  83.                  print " ends work at "; statn; " and ";
  84.                end if
  85.                busy(statn) = FALSE
  86.  
  87.                if RA > defect(statn) then
  88.                  if statn = FINAL then
  89.                    DISPOS
  90.                    if debugf then print "discharged"
  91.                  else
  92.                    SETA 1, RN(.25, .05)
  93.                    SCHED 0, NEXTAC, statn
  94.                    if debugf then print "goes on"
  95.                  end if
  96.  
  97.                else
  98.                  SETA 1, A(1) / 2
  99.                  SCHED 0, NEXTAC, statn + 4 * (rewkn + 1) - 1
  100.                  if debugf then print "recycled"
  101.                end if
  102.                if debugf then
  103.                  print using f1$; "At"; T; " "; NQ(statn);
  104.                  print " are waiting at "; statn
  105.                end if
  106.                if NQ(statn) > 0 then triggr statn
  107.  
  108.       end select
  109.     end if
  110.   loop while ecode > 0
  111.  
  112.   title$ = "  "
  113.   SUMRY sadd(title$)
  114.  
  115.  
  116. sub deciph (i%)
  117.   statn = 1 + (i% and 3)
  118.   rewkn = i% \ 4
  119. end sub
  120.  
  121. sub prime
  122.   defect(1) = .3
  123.   defect(2) = .2
  124.   defect(3) = .1
  125.   debugf = FALSE
  126.   serial = 1
  127.  
  128.   INIQUE 3, 2, 3
  129.   for i = 1 to 3
  130.     busy(i) = FALSE
  131.     block(i) = FALSE
  132.     title$ = "Prod t #" + str$(i) + "                   "
  133.     INISTA i, sadd(title$), 0, 0, 0, 0
  134.   next i
  135.   CREATE 0, 0
  136.   SIMEND 6
  137. end sub
  138.  
  139. sub triggr (i)
  140.   REMVFQ i, 1
  141.   SCHED 0, NEXTAC, IDE
  142.   if i > 1 then CREATE 0, i - 1
  143. end sub
  144.  
  145. sub unblk (i%)
  146.   DISPOS
  147.   if block(i%) then
  148.     if NQ(i%) > 0 and (not busy(i%)) then triggr i
  149.     block(i%) = FALSE
  150.   end if
  151. end sub
  152.  
  153. sub waital
  154.   input "Press q to quit"; q$
  155.   if left$(ucase$(q$), 1) = "Q" then stop
  156. end sub
  157.  
  158.