! prep options
! k - kent (uses bigger small buffers)
! t - put task id in mode field and use 128 as flag for small buffs
!
! FILE 'FEP_BUFF3'
!*******************************
!* EMAS-2900 BUFFER MANAGER *
!* FILE: BUFF3 (FEP) *
!* DATE: 29.JAN.81 *
!******************************
!! 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'
CONSTINTEGERNAME PS = K'017776'; ! PDP11 PROCESSOR STATUS WORD (SEG 0)
CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310'
CONSTINTEGER T3 SER = 21
CONSTINTEGER SER NO = 17
OWNRECORD (QF) NAME FREE BIG
OWNRECORD (QF) NAME FREE SMALL
#if k
CONSTINTEGER NO OF BIG = 31, BIG L = 256
CONSTINTEGER NO OF SMALL = 45, SMALL L = 128
#else
CONSTINTEGER NO OF BIG = 34, BIG L = 256
CONSTINTEGER NO OF SMALL = 78, SMALL L = 64
#fi
!* 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)
SYSTEMROUTINESPEC MAP HWR(INTEGER SEG); ! WARNING: ADDS A WORD TO GLA
INTEGER I, ADD, PT, LEN, TOP, BOT, MID PT
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)
ROUTINESPEC CRASH(INTEGER I)
LINKIN(SER NO)
MAP HWR(0); ! MAP H/W REGS TO MY SEG 0
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
#if t
B_MODE=128+SER NO; !my buffer
#else
B_MODE = 64 + 1; !NOT IN USE BIT
#fi
NS = NS+1
REPEAT
MID PT = PT; !address of start of big blocks
CYCLE I = 1, 1, NO OF BIG
R1_X = PT; PT = PT+BIG L
B == R2_L
B_L == FREE BIG
FREE BIG == B
#if t
B_MODE=SER NO; !my buffer
#else
B_MODE = 1; !'FREE' BUFFER BIT
#fi
NB = NB+1
REPEAT
! OCTAL(PT); ! NEWLINE
#if k
#if t
PRINTSTRING("Buff5(kt)")
#else
PRINTSTRING("Buff5(k)")
#fi
#else
#if t
PRINTSTRING("Buff5(t)")
#else
PRINTSTRING("Buff5")
#fi
#fi
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
PS = PS!K'340'; ! ENSURE NO INTERRUPTS HERE
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
PS = PS&(¬K'340'); ! INTS ON AGAIN
IF P2_B < MID PT THEN CRASH(1); !in small buffer area
-> REPLY
FINISH
PS = PS&(¬K'340')
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
IF P2_B >= MID PT THEN CRASH(2)
REPLY:
P_SER = P_REPLY; P_REPLY = SER NO
P_MES_L == NULL
#if t
P_MES_MODE=P_MES_MODE & 128 + P_SER; !new owner
#else
P_MES_A(1) = P_SER; ! PUT WHO TO IN IT
IF P_MES_MODE & 1 = 0 THEN CRASH(5); !NOT FREE
P_MES_MODE = P_MES_MODE - 1; !REMOVE 'FREE' BIT
#fi
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
P2_B = P2_B+K'20000'; ! BLOCK ADDRESS IN SEG 5/6
IF P_MES_MODE & 1 # 0 THEN CRASH(6); !ALREADY FREE
P_MES_MODE = P_MES_MODE ! 1
#if t
IF P_MES_MODE & 128 = 0 START
#else
IF P_MES_MODE & K'376'= 0 START
#fi
IF P2_B < MID PT THEN CRASH(3)
PS = PS!K'340'; ! NO INTERRUPS IN THIS SECTION
P_MES_L == FREE BIG
FREE BIG == P_MES
NB = NB+1
PS = PS&(¬K'340'); ! INTS ON AGAIN HERE
LEN = 0; ! BIG BLOCK
ELSE
IF P2_B >= MID PT THEN CRASH(4)
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
ROUTINE CRASH(INTEGER I)
PRINTSTRING("Buff: small/large buffer error, task:")
WRITE(P_REPLY, -1); PRINTSTRING(" code:")
WRITE(I,-1); NEWLINE
CYCLE ; REPEAT
END
ENDOFPROGRAM