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