EXTERNALROUTINE BENCH(STRING (255)S)
!
!
INCLUDE "CONLIB.VVP_VVPSPECS"
INCLUDE "CONLIB.VVP_VVPFORMATS"
!
!
RECORDFORMAT C
DATAF(INTEGER START, BITSIZE, BADSTART, NNTSTART,
NNTSIZE, NNTTOP, NNTHASH, INDEXSTART,
FILESTART, END, TYPE)
RECORDFORMAT C
IOF(INTEGER INPOS, STRING (15)INTMESS)
RECORDFORMAT C
ITF(INTEGER INBASE, INLENGTH, INPOINTER)
!
!
!
SYSTEMROUTINESPEC C
CONSOLE(INTEGER EP, INTEGERNAME A, B)
EXTERNALINTEGERFNSPEC C
DDELAY(INTEGER SECS)
EXTERNALINTEGERFNSPEC C
DSFI(STRING (31)INDEX, INTEGER FSYS, TYPE, SET, ADR)
EXTERNALINTEGERFNSPEC C
DSYSAD(INTEGER TYPE, ADR, FSYS)
EXTERNALINTEGERFNSPEC C
FBASE(INTEGERNAME LO, HI, INTEGER FSYS)
SYSTEMROUTINESPEC C
FILL(INTEGER LEN, ADR, FILLER)
EXTERNALINTEGERFNSPEC C
GETUSNAMES(INTEGERNAME N, INTEGER ADR, FSYS)
SYSTEMSTRINGFNSPEC C
ITOS(INTEGER N)
SYSTEMROUTINESPEC C
UCTRANSLATE(INTEGER ADR, LEN)
!
!
!
CONSTSTRINGNAME TIME = X'80C0004B'
!
!
!
INTEGERFN STOI2(STRING (255) S, INTEGERNAME I2)
STRING (63) P
INTEGER TOTAL, SIGN, AD, I, J, HEX
!MON MON(1) = MON(1) + 1
HEX = 0; TOTAL = 0; SIGN = 1
AD = ADDR(P)
A: IF S -> (" ").S THEN -> A; !CHOP LEADING SPACES
IF S -> ("-").S THEN SIGN = -1
IF S -> ("X").S THEN HEX = 1 AND -> A
P = S
UNLESS S -> P.(" ").S THEN S = ""
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9' OR (HEX # 0 C
AND 'A' <= J <= 'F')
IF HEX = 0 THEN TOTAL = 10*TOTAL C
ELSE TOTAL = TOTAL<<4+9*J>>6
TOTAL = TOTAL+J&15; I = I+1
REPEAT
IF HEX # 0 AND I > 9 THEN -> FAULT
IF I > 1 THEN I2 = SIGN*TOTAL AND RESULT = 0
FAULT:
I2 = 0
RESULT = 1
END ; ! STOI2
!
!-----------------------------------------------------------------------
!
CONSTLONGREAL DZ=0
CONSTLONGREALARRAY TENPOWERS (0:20) = 1,10,100,1000,1@4,1@5,1@6,
1@7,1@8,1@9,1@10,1@11,1@12,
1@13,1@14,1@15,1@16,1@17,
1@18,1@19,1@20
!
STRINGFN SWRITE(INTEGER VALUE,PLACES)
STRING (16)S
INTEGER D0,D1,D2,D3,L
STRING (255)W
W = ""
WHILE PLACES > 14 CYCLE
PLACES = PLACES - 1
W = W . " "
REPEAT
!
*LSS_VALUE
*CDEC_0
! Acc is now 64 bits, holding the value as a packed decimal
! number, i.e. 15 decimal digits coded in binary in 4 bits
! each, followed by a 'sign' quartet at the least significant
! end. The largest possible absolute value would be 2**31
! which is 2,147,483,648. Hence at least the first five
! quartets must be zero.
*LD_S; *INCA_1; *STD_TOS
! *LD_S gets a byte vector descriptor to the whole of S -
! the bound will be 17 and the address will point to the
! 'length byte'. So DR (and TOS) now point to the text
! field of the IMP string.
*CPB_B ; ! SET CC=0
*SUPK_L =15,0,32; ! UNPACK & SPACE FILL
! Acc is now zero except for the sign quartet which is
! unchanged at the least significant end. The first
! 15 text bytes of S now have the value in unpacked
! decimal format (unsigned). CC will be zero if the
! value is zero, and non-zero otherwise. The unpacked
! decimal string in S will have no leading zeros: leading
! bytes will be X'20' (ISO space) - but the digits will
! be in EBCDIC form, i.e. X'Fn'. If the number is zero,
! then all fifteen bytes will be spaces. If it is not, then
! a descriptor will have been planted on TOS which points
! to the byte immediately preceding the first digit (i.e.,
! to the last of the leading spaces).
!
! D2 will get a (zero length) descriptor to the byte immediately
! after the fifteenth digit - i.e., to the last byte of S.
*STD_D2; *JCC_8,<WASZERO>
!
! If the value was not zero -
! copy the descriptor-to-last-leading-space into D0:
*LD_TOS ; *STD_D0; ! FOR SIGN INSERTION
! restore the descriptor to the first byte of text:
*LD_TOS
! convert digits to ISO:
! (this uses the MASK to clear the top two bits of each byte,
! thus leaving the spaces - X'20' - unchanged, but coverting
! EBCDIC digits X'Fn' to their ISO equivalents X'3n'.)
*MVL_L =15,63,0; ! FORCE ISO ZONE CODES
IF VALUE<0 THEN BYTEINTEGER(D1)='-'; ! D0 is a descriptor
! to the appropriate place for a sign, and D1 is the
! address word of that descriptor.
L=D3-D1; ! L is the number of bytes occupied by significant
! digits with a leading space or sign.
OUT: IF PLACES>=L THEN L=PLACES+1
D3=D3-L-1
BYTEINTEGER(D3)=L
RESULT = W . STRING(D3)
WASZERO:
BYTEINTEGER(D3-1)='0'
L=2; -> OUT
END ; ! SWRITE
!
!-----------------------------------------------------------------------
!
STRINGFN SPRINTFL(LONGREAL XX,INTEGER N)
!***********************************************************************
!* PRINTS IN FLOATING POINT FORMAT WITH N PLACES AFTER THE *
!* DECIMAL POINT. ALWAYS TAKES N+7 PRINTING POSITIONS. *
!* CARE REQUIRED TO AVOID OVERFLOW WITH LARGE X *
!***********************************************************************
STRING (47)S
LONGLONGREAL ROUND,FACTOR,LB,UB,X,Y
INTEGER COUNT,INC,SIGN,L,J
N=N&31
IF N<=20 THEN Y=TENPOWERS(N) ELSE C
Y=TENPOWERS(20)*TENPOWERS(N-20)
ROUND=R'41100000000000000000000000000000'/(2*Y)
LB=1-ROUND; UB=10-ROUND
SIGN=' '
X=XX+DZ; ! NORMALISE
IF X=0 THEN COUNT=-99 ELSE START
IF X<0 THEN X=-X AND SIGN='-'
INC=1; COUNT=0
FACTOR=R'4019999999999999999999999999999A'
IF X<=1 THEN FACTOR=10 AND INC=-1
! FORCE INTO RANGE 1->10
WHILE X<LB OR X>=UB CYCLE
X=X*FACTOR; COUNT=COUNT+INC
REPEAT
FINISH
X=X+ROUND
IF N>16 THEN START ; ! TOO BIG FOR CDEC WITHOUT SCALING
LENGTH(S)=N+4
CHARNO(S,1)=SIGN
L=INTPT(X)
CHARNO(S,2)=L+'0'
CHARNO(S,3)='.'
J=1
WHILE J<=N CYCLE
X=(X-L)*10
L=INTPT(X)
CHARNO(S,J+3)=L+'0'
J=J+1
REPEAT
FINISH ELSE START
X=X*Y
J=30-N
*LSQ_X
*FIX_B
*MYB_4
*ISH_B ; ! NOCHECKING NEEDED AS N LIMITED
*CDEC_0; ! GIVES 128 BIT DECIMAL N0
*LB_N
*ADB_4
*LD_S
*MVL_L =1; ! LENGTH INTO STRING
*DSH_J
*LB_SIGN
*MVL_L =1; ! SIGN INTO STRING
*SUPK_L =1,0,48; ! FIRST DIGIT INTO STRING
*MVL_L =1,0,46; ! DOT INTO STRING
*LDB_N
*SUPK_L =DR ,0,48; ! UNPACK FR PT &ZEROFILL
*LDB_(S)
*INCA_1
*ANDS_L =DR ,0,63; ! FORCE ISO ZONE CODES
FINISH
CHARNO(S,N+4)='@'
!
RESULT = S . SWRITE(COUNT, 2)
END ; ! SPRINTFL
!
!-----------------------------------------------------------------------
!
STRINGFN SPRINT(LONGREAL X,INTEGER N,M)
!***********************************************************************
!* 'PRINTS' A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL *
!* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES *
!* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. *
!* *
!* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY *
!* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS *
!***********************************************************************
LONGREAL ROUND
LONGLONGREAL Y,Z
STRING (127)S
INTEGER I,J,L,SIGN,SPTR
STRING (255)W
W = ""; ! initialise result string
M=M&63; ! DEAL WITH STUPID PARAMS
IF N<0 THEN N=1 ELSE START
WHILE N > 31 CYCLE
N = N - 1
W = W . " "
REPEAT
FINISH
!
X=X+DZ; ! NORMALISE
!
SIGN=' '; ! '+' IMPLIED
IF X<0 THEN SIGN='-'
Y=MOD(X); ! ALL WORK DONE WITH Y
IF Y>1@15 OR N=0 THEN START ; ! MEANINGLESS FIGURES GENERATED
IF N>M THEN M=N; ! FOR FIXED POINT PRINTING
RESULT = SPRINTFL(X,M); ! OF ENORMOUS NUMBERS
! SO PRINT IN FLOATING FORM
FINISH
IF M<=20 THEN ROUND=1/(2*TENPOWERS(M)) ELSE C
ROUND= 0.5/R'41A00000000000000000000000000000'**M;! ROUNDING FACTOR
Y=Y+ROUND
->FASTPATH IF N+M<=16 AND Y<TENPOWERS(N)
I=0;Z=1
CYCLE ; ! COUNT LEADING PLACES
I=I+1;Z=10*Z; ! NO DANGER OF OVERFLOW HERE
REPEAT UNTIL Z>Y
SPTR=1
WHILE SPTR<=N-I CYCLE
CHARNO(S,SPTR)=' '
SPTR=SPTR+1
REPEAT
CHARNO(S,SPTR)=SIGN
SPTR=SPTR+1
J=I-1; Z=R'41A00000000000000000000000000000'**J
CYCLE
CYCLE
L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT
Y=Y-L*Z;Z=Z/10; ! AND REDUCE TOTAL
CHARNO(S,SPTR)=L+'0'
SPTR=SPTR+1
J=J-1
REPEAT UNTIL J<0
IF M=0 THEN EXIT ; ! NO DECIMAL PART TO BE O/P
CHARNO(S,SPTR)='.'
SPTR=SPTR+1
J=M-1; Z=R'41A00000000000000000000000000000'**(J-1)
M=0
Y=10*Y*Z
REPEAT
LENGTH(S)=SPTR-1
-> OPUT
FASTPATH: ! USE SUPK WITHOUT SCALING
L=M+N+2; ! NO OF BYTES TO BE OPUT
IF M=0 THEN L=L-1
Y=Y*TENPOWERS(M); ! CONVERT TO INTEGER
J=N-1
I=30-M-N; ! FOR DECIMAL SHIFT
*LSQ_Y
*FIX_B
*MYB_4
*ISH_B
*CDEC_0
*LD_S
*LB_L
*MVL_L =1; ! LENGTH INTO STRING
*DSH_I
*CPB_B ; ! SET CC=0 FOR SUPK
*LDB_J
*JAT_11,6; ! TILL SUPK FIXED!
*SUPK_L =DR ,0,32; ! UNPACK WITH LEADING SPACES
*JCC_7,<DESSTACKED>
*STD_TOS ; ! FOR SIGN INSERTION
DESSTACKED:
*LDB_2
*SUPK_L =1,0,32
*SUPK_L =1,0,48; ! FORCE ZERO BEFORE DP
*SLD_TOS
*LB_SIGN
*STB_(DR ); ! INSERT SIGN
*LB_46; ! ISO DECIMAL POINT
*LD_TOS
*LDB_M
*JAT_11,<NOFRPART>; ! INTEGER PRINTING
*STB_(DR )
*INCA_1
*SUPK_L =DR ,0,48; ! ZEROFILL
NOFRPART:
*LDB_(S)
*INCA_1
*ANDS_L =DR ,0,63; ! FORCE ISO ZONE CODES
OPUT:
RESULT = W . S
END ; ! SPRINT
!
!-----------------------------------------------------------------------
!
ROUTINE VVWRITE(INTEGER N, PLACES)
VVPRINTSTRING(SWRITE(N, PLACES))
END
!
!
!
ROUTINE VVPRINT(LONGREAL X, INTEGER N, M)
VVPRINTSTRING(SPRINT(X, N, M))
END
!
!
!
ROUTINE VVPRINTFL(LONGREAL X, INTEGER N)
VVPRINTSTRING(SPRINTFL(X, N))
END
!
!
!
!
!
!
INTEGERFN ACTIVE PROCESSES(INTEGER FSYS)
!
EXTERNALINTEGERFNSPEC DCONNECT(STRING (31)INDEX, FILE,
INTEGER FSYS, MODE, APF, INTEGERNAME SEG, GAP)
EXTERNALINTEGERFNSPEC C
DDISCONNECT(STRING (31)INDEX, FILE, INTEGER FSYS, DESTROY)
!
!<Logfile formats
constinteger TOPLOG = 5
constinteger TOP FE NO = 7
constinteger NSI = 0
constinteger X25 = 1
constinteger FEP IO BUFF SIZE = 2048; ! bytes in each control buffer
constinteger MAXTCPNAME = 15 {TCP-name length}
{Kent TCP names have max 15 chars).
recordformat c
FEP DETAILF(integer INPUT STREAM, OUTPUT STREAM,
IN BUFF DISC ADDR, OUT BUFF DISC ADDR,
IN BUFF DISC BLK LIM, OUT BUFF DISC BLK LIM,
IN BUFF CON ADDR, OUT BUFF CON ADDR,
IN BUFF OFFSET, OUT BUFF OFFSET, IN BUFF LENGTH, OUT BUFF LENGTH,
INPUT CURSOR, OUTPUT CURSOR)
!
recordformat c
FEPF(record (FEP DETAILF)array FEP DETAILS(NSI:X25), integer AVAILABLE)
!
recordformat c
LF(string (11)NAME, integer FSYS, DISC ADDR, STATE)
!
recordformat C
PROCDATF(string (6)USER, string (MAXTCPNAME)TCPNAME, byteinteger LOGKEY,
byteinteger INVOC, PROTOCOL, NODENO, FSYS,
integer LOGSNO,
byteinteger SITE, SP1, SP2, REASON,
integer ID, PROCESS, PREV WARN, SESSEND,
byteinteger GETMODE, PREEMPT, BLNK, LINK)
!
recordformat c
LOGF HDF(integer LOGMAPST,SPARE0,
byteinteger FREEHD,LIVEHD,BACKHD,SPARE,
integer FES FOUND,
byteintegerarray FE USECOUNT(0:TOP FE NO),
record (LF)array LOGS(0:TOPLOG),
record (FEPF)array FEPS(0:TOP FE NO),
record (PROCDATF)array PROCLIST(0:255),
integer LEND)
!
recordformat c
TMODEF(halfinteger FLAGS1, FLAGS2,
{.04} byteinteger PROMPTCHAR, ENDCHAR,
{.06} bytearray BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))} ,
{.0A} byteinteger PADS, RPTBUF, LINELIMIT, PAGELENG,
{.0E} byteintegerARRAY TABVEC(0:7),
{.16} byteinteger CR,ESC,DEL,CAN, SP1,SP2,SP3,SP4,SP5,SP6)
{length of this format is X20 bytes}
!>
!
!
INTEGER J, SEG, GAP, CFLAG, COUNT
RECORD (LOGFHDF)NAME LOGH
RECORD (PROCDATF)ARRAYNAME PROCLIST
RECORD (PROCDATF)NAME P
!
!
COUNT = 0
SEG = 0
GAP = 0
CFLAG = DCONNECT("VOLUMS", "#LOGMAP", -1, 11, 0, SEG, GAP)
-> OUT UNLESS CFLAG = 0 OR CFLAG = 34
!
LOGH == RECORD(SEG << 18 + X'10000')
PROCLIST == LOGH_PROCLIST
!
J = LOGH_BACKHD
WHILE J # 255 CYCLE
P == PROCLIST(J)
COUNT = COUNT + 1 IF P_FSYS = FSYS
J = P_BLNK
REPEAT
!
J = DDISCONNECT("VOLUMS", "#LOGMAP", -1, 0) IF CFLAG = 0
!
OUT:
RESULT = COUNT
END ; ! ACTIVE PROCESSES
!
!-----------------------------------------------------------------------
!
INTEGERFN FBASE2(INTEGER FSYS, ADR)
!
! This returns the characteristics of an on-line disc in a record
! of format DATAF at address ADR
INTEGER J, LOB, HIB, TYPE, K
RECORD (DATAF) NAME DATA
CONSTINTEGER TOPTYPE= 5
CONSTINTEGERARRAY BITSIZE(1:TOP TYPE)= X'1000'(2), X'2000'(2), X'5000'
CONSTINTEGERARRAY NNTSTART(1:TOP TYPE)= X'7000'(4), X'A000'
CONSTINTEGERARRAY NNTSIZE(1:TOP TYPE)= X'4000'(4), X'1FF8'
CONSTINTEGERARRAY NNTTOP(1:TOP TYPE)= 1364(4), 681
CONSTINTEGERARRAY NNTHASH(1:TOP TYPE)= 1361(4), 667
CONSTBYTEARRAY INDEXSTART(1:TOP TYPE)= 12(5)
CONSTINTEGERARRAY FILESTART(1:TOP TYPE)= 1024(5)
CONSTINTEGERARRAY HI(1:TOP TYPE)= X'3F1F', X'59F3', X'8F6F',
X'B3E7', X'24797'
J = FBASE(LOB, HIB, FSYS)
RESULT = J UNLESS J = 0
!
TYPE = - 1
CYCLE K = 1, 1, TOP TYPE
TYPE = K ANDEXITIF HIB = HI(K)
REPEAT
RESULT = 8 IF TYPE < 0
!
DATA == RECORD(ADR)
!
DATA_START = LOB
DATA_BITSIZE = BITSIZE(TYPE)
DATA_BADSTART = X'5000'
DATA_NNTSTART = NNTSTART(TYPE)
DATA_NNTSIZE = NNTSIZE(TYPE)
DATA_NNTTOP = NNTTOP(TYPE)
DATA_NNTHASH = NNTHASH(TYPE)
DATA_INDEXSTART = INDEX START(TYPE)
DATA_FILESTART = FILE START(TYPE)
DATA_END = HIB
DATA_TYPE = TYPE
RESULT = 0
END ; ! FBASE2
!
!-----------------------------------------------------------------------
!
INTEGERFN IHOLESHIST(INTEGER FSYS)
INTEGERARRAY BITMAP(0:5119)
INTEGERARRAY A(1:32)
INTEGERARRAY P(1:32)
INTEGER I, J, LO, HI, W, N, S, L, D
RECORD (DATAF) DATA
INTEGER IPROCS, BPROCS, B
STRING (6)ARRAY USER(0 : 1364)
CONSTSTRING (3)ARRAY TYPE(1:5) = "80", "100", "160", "200", "640"
CYCLE J = 1, 1, 32
A(J) = 0
P(J) = 0
REPEAT
!
J = DSYSAD(0, ADDR(BITMAP(0)), FSYS)
RESULT = J UNLESS J = 0
!
J = FBASE2(FSYS, ADDR(DATA))
!
VVGOTO(0, 0)
VVPRINTSTRING("Fsys")
VVWRITE(FSYS, 2)
VVGOTO(9, 0)
VVPRINTSTRING("EDS" . TYPE(DATA_TYPE))
!
VVWRITE(ACTIVE PROCESSES(FSYS), 4)
VVPRINTSTRING(" processes")
!
VVGOTO(72, 0)
VVPRINTSTRING(TIME)
LO = (DATA_START + DATA_FILESTART) >> 5
HI = DATA_END >> 5
CYCLE I = LO, 1, HI
W = BITMAP(I)
!
N = 0; ! number of consecutive zero bits
S = 32; ! number of bits remaining to be examined
WHILE S > 0 CYCLE
IF W = 0 START
A(S) = A(S) + 1
EXIT
FINISH
IF W < 0 START
IF N > 0 START
A(N) = A(N) + 1
N = 0
FINISH
FINISHELSE N = N + 1
W = W << 1
S = S - 1
REPEAT
!
REPEAT
!
S = 0
CYCLE I = 1, 1, 31
S = S + I*A(I)
REPEAT
!
VVGOTO(0, 2)
VVPRINT(S*100/(HI-LO+1)<<5, 1, 1)
VVPRINTSTRING("% frag")
VVPRINT(100 - ((S+32*A(32))*100) / ((HI-LO+1)<<5), 4, 1)
VVPRINTSTRING("% full free sections:")
!
CYCLE L = 0, 1, 9
VVGOTO(0, 4+L)
CYCLE J = 0, 1, 3
S = L+10*J; ! section size
VVPRINTSTRING(" ") IF S = 0
VVWRITE(S, 6) AND VVWRITE(A(S), 6) IF 1 <= S <= 32
REPEAT
REPEAT
!
D = 1000
CYCLE L = 0, 1, 3
VVGOTO(5, 15+L)
CYCLE J = 1, 1, 32
I = A(J) // D
IF I > 0 OR P(J) = 1 OR L = 4 C
THEN VVPRINTCH(I + '0') AND P(J) = 1 C
ELSE VVPRINTCH(' ')
A(J) = A(J) - D*I
REPEAT
D = D // 10
REPEAT
!
VVGOTO(5, 19)
VVPRINTSTRING("--------------------------------")
VVGOTO(5, 20)
VVPRINTSTRING("12345678901234567890123456789012")
RESULT = 0
END ; ! IHOLESHIST
!
!
!
INTEGER I, J, FSYS
RECORD (IOF)NAME IO
RECORD (ITF)NAME IT
FSYS = -1
CONSOLE(13, I, J)
IT == RECORD(I)
IO == RECORD(J)
!
VVINIT(J)
RETURN UNLESS J = 0
!
VV DEFINE TRIGGERS(3, 0, 0)
LOOP:
!
J = IHOLESHIST(FSYS) UNLESS FSYS < 0
!
VVGOTO(0, 23)
VVPRINTSTRING("Bench: ")
VV UPDATE SCREEN
!
IF IO_INPOS # IT_INPOINTER START
S = ""
VVRSTRG(S)
UCTRANSLATE(ADDR(S)+1, LENGTH(S))
IF S = "Q" START
VVDEFINETRIGGERS(0, 0, 0)
RETURN
FINISH
J = STOI2(S, I)
FSYS = I IF J = 0
-> LOOP
FINISH
!
J = DDELAY(4)
-> LOOP
END
ENDOFFILE