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_0701.FOR < prev    next >
Text File  |  1991-04-10  |  4KB  |  169 lines
  1. C     Program EX_0701.FOR
  2. C     Listing 14F - see documentation in TUTOR.SSS
  3.  
  4. $include:'SSSF1.H'
  5.  
  6.       subroutine prime
  7. $include:'SSSF2.H'
  8.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  9.      +  server, ORD1, ORD2, DELUX1, DELUX2
  10.       real*8 ORDNRY, DELUX
  11.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  12.      +  server(2), ORD1, ORD2, DELUX1, DELUX2
  13.  
  14.       do 1 i = 1, 2
  15.   1     server(i) = 1
  16.       ARRIVL = 1
  17.       STARTA = 2
  18.       ENDACT = 3
  19.       NEXTAC = 4
  20.       ORD1   = 1
  21.       ORD2   = 2
  22.       DELUX1 = 3
  23.       DELUX2 = 4
  24.  
  25.       call INIQUE(5, 3, 1)
  26.       call inista(1,'Interrupts           ', 0, 0, 0, 0)
  27.       call SIMEND(60.0)
  28.       call CREATE(0.0, 0)
  29.       return
  30.       end
  31.  
  32.       integer function sindex
  33. $include:'SSSF2.H'
  34.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  35.      +  server, ORD1, ORD2, DELUX1, DELUX2
  36.       real*8 ORDNRY, DELUX
  37.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  38.      +  server(2), ORD1, ORD2, DELUX1, DELUX2
  39.  
  40.       if (IDE().lt.DELUX1) then
  41.         sindex = IDE()
  42.       else
  43.         sindex = IDE() - ORD2
  44.       endif
  45.       return
  46.       end
  47.  
  48.       integer function shortr
  49. $include:'SSSF2.H'
  50.  
  51.       if (NQ(4) + NQ(2).lt.NQ(3) + NQ(1))
  52.      +  call SETIDE(IDE() + 1)
  53.       shortr = IDE()
  54.       return
  55.       end
  56.  
  57.       subroutine preemp
  58. $include:'SSSF2.H'
  59.  
  60.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  61.      +  server, ORD1, ORD2, DELUX1, DELUX2
  62.       real*8 ORDNRY, DELUX
  63.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  64.      +  server(2), ORD1, ORD2, DELUX1, DELUX2
  65.       integer preide, shortr
  66.       real*8 remt
  67.  
  68.       call QUEUE(5, 0.0)
  69.   99  continue
  70.       if ((i.le.NC()).and.
  71.      +  ((AIC(i, 3).eq.DELUX).or.(NEIC(i).ne.ENDACT)))
  72.      +  then
  73.         i = i + 1
  74.         goto 99
  75.       endif
  76.  
  77.       if (i.le.NC()) then
  78.         remt = TIC(i) - T()
  79.         call REMVFC(i)
  80.         preide = IDE()
  81.         call SETA(1, A(1) + 1)
  82.         call SETA(2, remt)
  83.         call SETQDC(1, 'LIFO    ')
  84.         call QUEUE(IDE(), 0.0)
  85.         call SETQDC(1, 'FIFO    ')
  86.         call REMVFQ(5, 1)
  87.         call SCHED(0.0, STARTA, preide + 2)
  88.  
  89.       else
  90.         call REMVFQ(5, 1)
  91.         call QUEUE(shortr(), 0)
  92.       endif
  93.       return
  94.       end
  95.  
  96.       Program EX_0701
  97. $include:'SSSF2.H'
  98.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  99.      +  server, ORD1, ORD2, DELUX1, DELUX2
  100.       real*8 ORDNRY, DELUX
  101.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  102.      +  server(2), ORD1, ORD2, DELUX1, DELUX2
  103.       integer s, ecode, sindex, shortr
  104.  
  105.       call prime
  106.  
  107.  
  108.    99 ecode = NEXTEV()
  109.       if (ecode.gt.0) then
  110.         goto (101, 102, 103, 104) ecode
  111.  
  112. C ARRIVL
  113.   101   continue
  114.         call CREATE(EX(2.0), 0)
  115.         call SETA(1, 0.0)
  116.         call SETA(2, TR(1.0, 2.0, 3.0))
  117.  
  118.         if (RA().lt.0.25) then
  119.           call SETIDE(DELUX1)
  120.         else
  121.           call SETIDE(ORD1)
  122.         endif
  123.         call SCHED(0.0, NEXTAC, IDE())
  124.         goto 99
  125.  
  126. C NEXTAC
  127.   104   continue
  128.         if (server(1).gt.0) then
  129.           call SCHED(0.0, STARTA, IDE())
  130.         elseif (server(2).gt.0) then
  131.           call  SCHED(0.0, STARTA, IDE()+1)
  132.         elseif (IDE().eq.DELUX1) then
  133.           call preemp()
  134.         else
  135.           call QUEUE(shortr(), 0.0)
  136.         endif
  137.         goto 99
  138.  
  139. C STARTA
  140.   102   continue
  141.         s = sindex()
  142.         server(s) = server(s) - 1
  143.         call SCHED(A(2), ENDACT, IDE())
  144.         goto 99
  145.  
  146. C ENDACT
  147.   103   continue
  148.         s = sindex()
  149.         server(s) = server(s) + 1
  150.         if (IDE().lt.DELUX1) call TALLY(1, A(1))
  151.         call DISPOS
  152.  
  153.         if (NQ(s + 2).gt.0) then
  154.           call REMVFQ(s + 2, 1)
  155.           call SCHED(0, STARTA, IDE())
  156.         elseif (NQ(s).gt.0) then
  157.           call REMVFQ(s, 1)
  158.           call SCHED(0, STARTA, IDE())
  159.         endif
  160.         goto 99
  161.  
  162.       else
  163.  
  164.         call SUMRY(' ')
  165.         stop 'End of simulation'
  166.  
  167.       endif
  168.       end
  169.