C C VSUTIL -- VS: UTILITY PROGRAM C C VERSION V02.05 C C WRITTEN: 31-JUL-81 BY J OSUDAR C C THIS PROGRAM PROVIDES SOME UTILITY FUNCTIONS RELATED TO THE VS: C VARIABLE SEND-DATA DRIVER, VERSION 2, AS FOLLOWS: C C QUEUES [queue] C Displays summary of queues on the terminal, or display all C messages in a single queue. C SHOW [filename] C Produces a snapshot of VS: private pool, queues, messages. C CREATE queue C Creates a queue with the specified name. C DELETE queue C Deletes the specified queue, and all messages in it. C FLUSH queue C Flushes the specified queue of all messages C REMOVE msg-id,queue C Removes the specified message from the specified queue C C *** WITH THIS VERSION OF VSUTIL, " ... " ARE NO LONGER REQUIRED. C REPLACE SPACES IN QUEUE NAMES WITH THE UNDERSCORE CHARACTER, E.G. C INSTEAD OF TYPING: VSU F "Q WSUD" C TYPE: VSU F Q_WSUD C C [ ... ] INDICATES OPTIONAL PARAMETERS C "MESSAGE ID" IS THE VIRTUAL ADDRESS OF THE MESSAGE C C IF THIS PROGRAM IS PASSED AN MCR COMMAND LINE, THE LINE MUST BE C ONE OF THE VALID COMMANDS LISTED ABOVE, OR THE FORM "@FILENAME". C C CHANGE POOLSZ AND POOLBY BELOW WHEN REBUILDING THE DRIVER FOR A C LARGER POOL SIZE. (POOLBY= BYTES IN POOL + 12; POOLSZ=POOLBY/2) C PARAMETER IOCRQ="2400,IODLQ="3000,IODMP="4000,IOFLU="2500,IODLM="5400 PARAMETER POOLSZ=3500,POOLBY=7000 INTEGER IPARM(6),IOSB(2),WPOOL(0:POOLSZ) INTEGER HERE,QHDHDF,QHDHDL,THREE,FREEPT,ZERO INTEGER IQHOTN(2),IMSSTN(2),FUNC LOGICAL*1 BPOOL(0:POOLBY),TSKNAM(6),LINE(80),FNAME(30) LOGICAL*1 SHORT,SINGLE,GOTDOT,ONEQ,REPLCH EQUIVALENCE (WPOOL(0),BPOOL(0),HERE) EQUIVALENCE (WPOOL(1),QHDHDF),(WPOOL(2),QHDHDL),(WPOOL(3),THREE) EQUIVALENCE (WPOOL(4),FREEPT),(WPOOL(5),ZERO) EQUIVALENCE (IQHOTN,RQHOTN),(IMSSTN,RMSSTN) EQUIVALENCE (IPARM(3),Q) DATA IPARM/6*0/,SINGLE/.FALSE./,GOTDOT/.FALSE./ ID(N)=(N-HERE)/2 CALL WTQIO("1400,5,5) CALL ASNLUN(1,'VS',0) CALL GETMCR(LINE,L) LUNI=4 IF(L.LT.5)LUNI=5 IF(LUNI.NE.4)GOTO10000 DO 10001 I=1,L 10001 IF(LINE(I).LE.' ')GOTO10002 LUNI=5 GOTO10000 10002 DO 10003 J=I,L 10003 IF(LINE(J).GT.' ')GOTO10004 LUNI=5 GOTO10000 10004 IF(LINE(J).EQ.'@')GOTO14001 DO 13001 I=J,L 13001 LINE(I-J+1)=LINE(I) IL=L-J+1 LINE(IL+1)=0 SINGLE=.TRUE. GOTO19003 14001 I=1 J=J+1 IF(J.GT.L)GOTO10006 10005 FNAME(I)=LINE(J) IF(FNAME(I).EQ.'.')GOTDOT=.TRUE. I=I+1 J=J+1 IF(J.GT.L)GOTO10006 IF(LINE(J).GT.' ')GOTO10005 10006 IF(GOTDOT)GOTO14007 FNAME(I)='.' FNAME(I+1)='C' FNAME(I+2)='M' FNAME(I+3)='D' I=I+4 14007 FNAME(I)=0 OPEN(UNIT=4,NAME=FNAME,TYPE='OLD',READONLY,ERR=10009) GOTO10000 10009 STOP '-- UNABLE TO OPEN COMMAND FILE' 10000 IF(SINGLE)GOTO10999 IF(LUNI.EQ.5)WRITE(5,12345) 12345 FORMAT('$VSU> ') READ(LUNI,10010,END=10999)LINE 10010 FORMAT(80A1) DO 19001 IL=80,1,-1 19001 IF(LINE(IL).GT.' ')GOTO19002 IL=1 19002 IF(LUNI.NE.5)WRITE(5,10013)(LINE(L),L=1,IL) 10013 FORMAT(' VSU> ',A1) 19003 IF(LINE(1).GE.'a'.AND.LINE(1).LE.'z')LINE(1)=LINE(1)+('A'-'a') L=IL IF(LINE(1).EQ.' ')GOTO10000 10012 IF(LINE(1).EQ.';')GOTO10000 DO 10014 I=1,L 10014 IF(LINE(I).LE.' ')GOTO10015 GOTO10019 10015 DO 10016 J=I,L 10016 IF(LINE(J).GT.' ')GOTO10017 10019 J=L+1 10017 IF(LINE(1).EQ.'C')GOTO10100 IF(LINE(1).EQ.'F')GOTO10150 IF(LINE(1).EQ.'D')GOTO10200 IF(LINE(1).EQ.'S')GOTO11000 IF(LINE(1).EQ.'Q')GOTO11100 IF(LINE(1).EQ.'X')GOTO10999 IF(LINE(1).EQ.'R')GOTO10300 WRITE(5,10018)(LINE(I),I=1,L) 10018 FORMAT(' * ILLEGAL COMMAND: ',A1) IF(LUNI.NE.5)GOTO10000 WRITE(5,19101) 19101 FORMAT(' *** COMMANDS RECOGNIZED BY VSUTIL ***') WRITE(5,19102) 19102 FORMAT(' QUEUES [queue]') WRITE(5,19103) 19103 FORMAT(' Displays summary of queues on the terminal, or') WRITE(5,19104) 19104 FORMAT(' display all messages in a single queue.') WRITE(5,19105) 19105 FORMAT(' SHOW [filename]') WRITE(5,19106) 19106 FORMAT(' Produces a snapshot of VS: pool, queues, messages.') WRITE(5,19107) 19107 FORMAT(' CREATE queue') WRITE(5,19108) 19108 FORMAT(' Creates a queue with the specified name.') WRITE(5,19109) 19109 FORMAT(' DELETE queue') WRITE(5,19110) 19110 FORMAT(' Deletes the specified queue, and all messages in it.') WRITE(5,19111) 19111 FORMAT(' FLUSH queue') WRITE(5,19112) 19112 FORMAT(' Flushes the specified queue of all messages') WRITE(5,19113) 19113 FORMAT(' REMOVE msg-id,queue') WRITE(5,19114) 19114 FORMAT(' Removes the specified message from the specified queue') GOTO10000 10999 CLOSE(UNIT=LUNI) CALL EXIT 10100 FUNC=IOCRQ GOTO10201 10150 FUNC=IOFLU GOTO10201 10200 FUNC=IODLQ 10201 IF(J.GT.L)GOTO10206 10203 I=0 J=J-1 10204 J=J+1 I=I+1 IF(LINE(J).LE.' ')GOTO10210 IF(LINE(J).EQ.'_')LINE(J)=' ' IF(I.GT.6.OR.J.GT.L)GOTO10206 IF((LINE(J).EQ.' ').AND.I.EQ.1)GOTO10208 IF(LINE(J).GE.'a'.AND.LINE(J).LE.'z')LINE(J)=LINE(J)+('A'-'a') IF(LINE(J).NE.' '.AND.LINE(J).NE.'$'.AND.LINE(J).NE.'.' 1 .AND..NOT.((LINE(J).GE.'0'.AND.LINE(J).LE.'9').OR. 2 (LINE(J).GE.'A'.AND.LINE(J).LE.'Z')))GOTO10206 TSKNAM(I)=LINE(J) GOTO10204 10206 WRITE(5,10207) 10207 FORMAT(' * BAD QUEUE NAME') GOTO10000 10208 WRITE(5,10209) 10209 FORMAT(' * QUEUE NAME CANNOT BEGIN WITH A SPACE') GOTO10000 10210 IF(I.EQ.7)GOTO10211 TSKNAM(I)=' ' I=I+1 GOTO10210 10211 Q=RAD50(TSKNAM) CALL WTQIO(FUNC,1,15,,IOSB,IPARM,IDSW) IF(IDSW.NE.1.OR.IOSB(1).NE.1)GOTO10213 WRITE(5,10212) 10212 FORMAT(' * DONE') GOTO10000 10213 WRITE(5,10214)IDSW,IOSB 10214 FORMAT(' * I/O ERROR: DSW=',O6,' IOSB=',O6,',',O6) GOTO10000 10300 DECODE(L-J+1,10301,LINE(J))IPARM(5) 10301 FORMAT(O10) FUNC=IODLM DO 10302 I=J,L 10302 IF(LINE(I).EQ.',')GOTO10304 I=L 10304 J=I+1 GOTO10201 11100 SHORT=.TRUE. ONEQ=(J.LE.L) IF(.NOT.ONEQ)GOTO11101 11203 I=0 J=J-1 11204 J=J+1 I=I+1 IF(LINE(J).LE.' ')GOTO11210 IF(LINE(J).EQ.'_')LINE(J)=' ' IF(I.GT.6.OR.J.GT.L)GOTO10206 IF((LINE(J).EQ.' ').AND.I.EQ.1)GOTO10208 IF(LINE(J).GE.'a'.AND.LINE(J).LE.'z')LINE(J)=LINE(J)+('A'-'a') IF(LINE(J).NE.' '.AND.LINE(J).NE.'$'.AND.LINE(J).NE.'.' 1 .AND..NOT.((LINE(J).GE.'0'.AND.LINE(J).LE.'9').OR. 2 (LINE(J).GE.'A'.AND.LINE(J).LE.'Z')))GOTO10206 TSKNAM(I)=LINE(J) GOTO11204 11210 IF(I.EQ.7)GOTO11211 TSKNAM(I)=' ' I=I+1 GOTO11210 11211 QQ=RAD50(TSKNAM) GOTO11101 11000 SHORT=.FALSE. 11101 CALL GETADR(IPARM(1),WPOOL(0)) IPARM(2)=POOLBY CALL WTQIO(IODMP,1,15,,IOSB,IPARM,IDSW) IF(IDSW.NE.1.OR.IOSB(1).NE.1)GOTO10213 FNAME(1)='.' FNAME(2)=0 IF(J.LE.L.AND..NOT.SHORT)GOTO11110 CALL ASNLUN(3,'TI',0) GOTO11003 11110 CALL ASNLUN(3,'SY',0) I=1 11001 FNAME(I)=LINE(J) I=I+1 J=J+1 IF(I.LE.29.AND.J.LE.L.AND.LINE(J).GT.' ')GOTO11001 FNAME(I)=0 WRITE(5,11002)(FNAME(K),K=1,I-1) 11002 FORMAT(' * WRITING SNAPSHOT TO FILE: ',A1) 11003 OPEN(UNIT=3,NAME=FNAME,TYPE='NEW',CARRIAGECONTROL='FORTRAN', 1ERR=11009) GOTO11111 11009 WRITE(5,11010) 11010 FORMAT(' * UNABLE TO OPEN SNAPSHOT LISTING FILE') GOTO10000 11111 NTOTAL=IOSB(2)-12 MAXFRE=0 NBKFRE=0 NFREE=0 WRITE(3,103)NTOTAL 103 FORMAT(' Total size of VS: driver pool = ',I4,' bytes.') IF(.NOT.SHORT)WRITE(3,11103) 11103 FORMAT(' Free blocks:') IPTR=ID(FREEPT) LPTR=FREEPT 10 IF(LPTR.EQ.0)GOTO20 IF(.NOT.SHORT)WRITE(3,104)LPTR,WPOOL(IPTR+1) 104 FORMAT(' At virtual address ',O6,': ',I4,' bytes') NFREE=NFREE+WPOOL(IPTR+1) IF(WPOOL(IPTR+1).GT.MAXFRE)MAXFRE=WPOOL(IPTR+1) NBKFRE=NBKFRE+1 LPTR=WPOOL(IPTR) IPTR=ID(WPOOL(IPTR)) GOTO10 20 WRITE(3,105)NFREE,NBKFRE,MAXFRE 105 FORMAT(' Total free pool = ',I4,' bytes in ',I3, 1' blocks; largest free block = ',I4,' bytes.'/) IF(.NOT.ONEQ.AND.(NTOTAL.GT.NFREE))WRITE(3,10505) 10505 FORMAT(' Message queues:'/) IPTR=ID(QHDHDF) LPTR=QHDHDF 30 IF(LPTR.EQ.0)GOTO90 IQHLNK=WPOOL(IPTR) IQHFMS=WPOOL(IPTR+1) IQHLMS=WPOOL(IPTR+2) IQHOTN(1)=WPOOL(IPTR+3) IQHOTN(2)=WPOOL(IPTR+4) IQHRWP=WPOOL(IPTR+5) IQHTCB=WPOOL(IPTR+6) IQHAST=WPOOL(IPTR+7) CALL R50ASC(6,RQHOTN,TSKNAM) REPLCH='?' DO 31 I=6,1,-1 IF(TSKNAM(I).NE.' ')REPLCH=' ' 31 IF(TSKNAM(I).EQ.REPLCH)TSKNAM(I)='_' IF((.NOT.SHORT).OR.(SHORT.AND.ONEQ.AND.(RQHOTN.EQ.QQ))) 1 WRITE(3,106)LPTR,TSKNAM,IQHLNK,IQHFMS,IQHLMS,IQHRWP,IQHTCB,IQHAST 106 FORMAT(/' Queue header at virtual address ',O6,' named "',6A1,'"'/ 1 ' Forward link to ',O6,'; first message at ',O6,'; last ', 2 'message at ',O6/' Read-wait packet at ',O6, 3 '; AST task TCB at ',O6,', AST address ',O6/) NMSGS=0 JPTR=ID(IQHFMS) KPTR=IQHFMS 40 IF(KPTR.EQ.0)GOTO50 NMSGS=NMSGS+1 IMSLNK=WPOOL(JPTR) IMSLEN=WPOOL(JPTR+1) IMSSTN(1)=WPOOL(JPTR+2) IMSSTN(2)=WPOOL(JPTR+3) IF(SHORT.AND.(.NOT.ONEQ.OR.(RQHOTN.NE.QQ)))GOTO11109 CALL R50ASC(6,RMSSTN,TSKNAM) IF(IMSLEN.LE.0)GOTO11177 WRITE(3,107)KPTR,TSKNAM,IMSLNK,IMSLEN, 1 (WPOOL(I),I=JPTR+4,JPTR+(IMSLEN+7)/2) 107 FORMAT(' Message at virtual address ',O6,' from task ',6A1/ 1 ' Forward link to ',O6,'; message length ',I4,' bytes'/ 2 ' Octal dump of message text:'/(5X,8(O6,2X))) JPTR=JPTR+JPTR+8 DO 11166 I=JPTR,JPTR+IMSLEN-1 11166 IF(BPOOL(I).LE.' '.OR.BPOOL(I).GT."176)BPOOL(I)='.' WRITE(3,11167)(BPOOL(I),I=JPTR,JPTR+IMSLEN-1) 11167 FORMAT(' ASCII dump of message text:'/(5X,64A1)) GOTO11109 11177 WRITE(3,108)KPTR,TSKNAM,IMSLNK,IMSLEN 108 FORMAT(' Message at virtual address ',O6,' from task ',6A1/ 1 ' Forward link to ',O6,'; message length ',I4,' bytes') 11109 KPTR=IMSLNK JPTR=ID(IMSLNK) GOTO40 50 LPTR=IQHLNK IPTR=ID(IQHLNK) ASTFLG='+AST' IF(IQHAST.EQ.0.OR.IQHTCB.EQ.0)ASTFLG=' ' IF(SHORT.AND..NOT.ONEQ)WRITE(3,11106)TSKNAM,NMSGS,ASTFLG 11106 FORMAT(' "',6A1,'" -- messages queued: ',I4,1X,A4) GOTO30 90 CLOSE(UNIT=3) GOTO10000 END