! FILE 'FEP_BUFF3'
!*******************************
!* EMAS-2900   BUFFER MANAGER *
!*     FILE: BUFF3 (FEP)      *
!*     DATE: 04.NOV.80        *
!******************************

!! STK = SIZE+200
%CONSTINTEGER SIZE = K'33000';   ! WAS 35000, BUT NEEDS LINK6S
%CONTROL K'100001'
%SYSTEMROUTINESPEC LINKIN(%INTEGER SER)
%SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
%RECORDFORMAT D(%INTEGER I)
%CONSTRECORD (D) %NAME NULL = 0


%BEGIN

     %RECORDFORMAT BF(%RECORD (BF) %NAME L, %BYTEINTEGER LEN, MODE, %C
       %BYTEINTEGERARRAY A(0:99))

     %RECORDFORMAT QF(%RECORD (BF) %NAME L)
     %RECORDFORMAT R1F(%INTEGER X)
     %RECORDFORMAT R3F(%BYTEINTEGERNAME X)
     %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, FN, PORT, %C
       %RECORD (BF) %NAME MES, %BYTEINTEGER LEN, S1)

     %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %INTEGER A, B, C)

     %CONSTBYTEINTEGERNAME OWN ID = K'160030'
     %CONSTINTEGER REQUEST BUFFER = 0
     %CONSTINTEGER RELEASE BUFFER = 1

     %CONSTBYTEINTEGERNAME INT = K'160060'

     %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310'
     %CONSTINTEGER T3 SER = 21

     %CONSTINTEGER SER NO = 17


     %OWNRECORD (QF) %NAME FREE BIG
     %OWNRECORD (QF) %NAME FREE SMALL

     %CONSTINTEGER NO OF BIG = 34, BIG L = 256
     %CONSTINTEGER NO OF SMALL = 78, SMALL L = 64


     !* NOTE: FOR ONE SEGMENT (ELSE CHANGE ABOVE)
     !!        4*SMALL = BIG     TOTAL = (N SMALL+1)*4+N BIG = 32
     %CONSTINTEGER QL = 127;            ! SIZE OF 'REQUEST' QUEUE
     %OWNINTEGER QUEUED = 0
     %OWNINTEGER NB = 0, NS = 0, QQ = 0, LB = 999, LS = 999
           ! NB -> K'100112' (IN OTHER VMS)
     %OWNINTEGER BR = 0,  SR = 0
     %OWNINTEGER DELAY = 60;       ! 60 MINS
      %OWNINTEGER DCOU

     %OWNINTEGERARRAY MONIT(0:20)
     %OWNRECORD (PE) %ARRAY PA(0:QL)



     %INTEGER I, ADD, PT, LEN, TOP, BOT, X, LAST, LASTAD, SMALL LIM

     %OWNRECORD (PE)P
     %OWNRECORD (P2F) %NAME P2
     %OWNRECORD (BF) %NAME B
     %OWNRECORD (R1F)R1
     %OWNRECORD (QF) %NAME R2
     %OWNRECORD (R3F) %NAME R3


     %BYTEINTEGERARRAY BUFF(0:SIZE)

     %ROUTINESPEC QUEUE(%RECORD (PE) %NAME P)
     %INTEGERFNSPEC UNQUEUE(%INTEGER LEN)


     LINKIN(SER NO)
     CHANGE OUT ZERO = T3 SER;       ! POINT OUTPUT(0) TO COMMON OUT
     ALARM(60*50);                    ! ONE MINUTE
     P2 == P
     R2 == R1;  R3 == R1

     R3_X == BUFF(0)
     TOP = R1_X
     R3_X == BUFF(SIZE)
     BOT = R1_X
     ! OCTAL(TOP); ! OCTAL(BOT); ! NEWLINE
      PT = (TOP&K'17700')+K'100'
      PT = PT!(TOP&K'160000')
      ! OCTAL(PT)

     %CYCLE I = 1, 1, NO OF SMALL
        R1_X = PT;  PT = PT+SMALL L
        B == R2_L
        B_L == FREE SMALL
        FREE SMALL == B
        B_MODE = 64
         NS = NS+1
     %REPEAT

      SMALL LIM = (PT-K'20000')>>1

     %CYCLE I = 1, 1, NO OF BIG
        R1_X = PT;  PT = PT+BIG L
         B == R2_L
        B_L == FREE BIG
        FREE BIG == B
        B_MODE = 0
         NB = NB+1
     %REPEAT
     ! OCTAL(PT); !  NEWLINE

     %CYCLE
        P_SER = 0;  POFF(P2)

         %IF P_REPLY = 0 %START;      ! CLOCK TICK
            %IF '0'<=INT<='9' %THEN DELAY =INT-'0' %AND %C
               INT = 'P' %AND DCOU = 0
            ALARM(50*60)

            %IF NB = 0 %START
              PRINTSTRING("BUFF: NO BIG BUFFERS ******
")
           %FINISH
           %IF NS = 0 %THEN PRINTSTRING("BUFF: NO SMALL BUFFERS ******
")
           DCOU = DCOU+1
            %IF DCOU = DELAY %OR INT = '?' %START
               INT = 0
               DCOU = 0
               PRINTSTRING('        BUFF:')
               WRITE(NB, 1); WRITE(NS, 1)
               WRITE(LB, 1); WRITE(LS, 1)
               WRITE(BR, 3); WRITE(SR, 1)
               WRITE(QUEUED, 3); WRITE(QQ, 1); NEWLINE
                QQ = 0;  LB = 999; LS = 999; BR = 0;  SR = 0
            %FINISH
            %CONTINUE
          %FINISH

        %IF P_FN = REQUEST BUFFER %START
AGAIN:                                 ! COMES HERE IF IT WAS A
                                       ! QUEUED REQUEST
           %IF P_LEN = 0 %START;       ! BIG BUFFER
              %UNLESS FREE BIG == NULL %START
                 P_MES == FREE BIG;  FREE BIG == P_MES_L
                 NB = NB-1;  %IF NB < LB %THEN LB = NB
                 BR = BR+1
                 -> REPLY
              %FINISH
              QUEUE(P2)
           %ELSE
              !! SMALL BLOCK REQUEST
              %UNLESS FREE SMALL == NULL %START
                 P_MES == FREE SMALL;  FREE SMALL == P_MES_L
                 NS = NS-1; %IF NS < LS %THEN LS = NS
              SR = SR+1
REPLY:           
                 P_SER = P_REPLY;  P_REPLY = SER NO
                 P_MES_L == NULL
                 P_MES_A(1) = P_SER;      ! PUT WHO TO IN IT
                 P2_B = P2_B-K'20000'
                    !! PUT BLOCK ADDRESS IN SEG 4/5

                 PON(P2)
              %ELSE
                 QUEUE(P2)
              %FINISH
           %FINISH
           %CONTINUE
        %FINISH

        !! SHOULD BE RELEASE BUFFER
        %IF P_FN = RELEASE BUFFER %START

            X = P2_B>>1;           ! AVOIDS SIGN PROBLEMS
            %UNLESS K'30000' <= X <= K'60000' %START
BAD:            PRINTSTRING("BUFF: Bad Buffer ")
                  OCTAL(P2_B); PRINTSTRING(" From")
                  WRITE(P_REPLY, 1); SPACES(3)
                  OCTAL(X); OCTAL(SMALL LIM); NEWLINE
                  %CONTINUE
            %FINISH
            -> BAD %IF P2_B&K'17' # 0
           LASTAD = P2_B; LAST = P_REPLY
           P2_B = P2_B+K'20000';     ! BLOCK ADDRESS IN SEG 5/6

           %IF P_MES_MODE = 0 %START
              -> BAD %IF X < SMALL LIM
              P_MES_L == FREE BIG
              FREE BIG == P_MES
              NB = NB+1
              LEN = 0;         ! BIG BLOCK
           %ELSE
               ->BAD %IF X >= SMALL LIM
              P_MES_L == FREE SMALL
              FREE SMALL == P_MES
              LEN = 1;                 ! SMALL BLOCK
              NS = NS+1
           %FINISH

           !! CHECK FOR A QUEUED REQUEST
           %IF QUEUED > 0 %START
              %IF UN QUEUE(LEN) # 0 %THEN -> AGAIN
              !! # 0 -> FOUND A REQUEST, WHICH IS COPIED TO "P"

           %FINISH
        %FINISH
     %REPEAT


     %ROUTINE QUEUE(%RECORD (PE) %NAME P)
        %INTEGER I
        %RECORD (PE) %NAME P2

        %CYCLE I = 0, 1, QL
           P2 == PA(I)
           %IF P2_SER = 0 %START;      ! QUEUE SLOT NOT ALLOCATED
              P2 = P;                  ! COPY P INTO PA
              QUEUED = QUEUED+1;  QQ = QQ+1
              %RETURN
           %FINISH
        %REPEAT
        PRINTSTRING("FULL!
        ")
     %END


     %INTEGERFN UN QUEUE(%INTEGER LEN)
        %INTEGER I, OLD
        %RECORD (PE) %NAME P2
        %OWNINTEGER IN TURN

        OLD = IN TURN
        %CYCLE
           P2 == PA(IN TURN);  IN TURN = (IN TURN+1)&QL
           %IF P2_SER # 0 %AND P2_LEN = LEN %START
              P = P2;                  ! COPY PA INTO P
              P2_SER = 0;              ! SLOT NOW FREE
              QUEUED = QUEUED-1
              %RESULT = 1
           %FINISH
           %IF IN TURN = OLD %THENEXIT
        %REPEAT
        %RESULT = 0
     %END

%ENDOFPROGRAM