C C VSUTIL -- VS: UTILITY PROGRAM C C VERSION V01.08 C C WRITTEN: 20-MAY-81 BY J OSUDAR C C THIS PROGRAM PROVIDES SOME UTILITY FUNCTIONS RELATED TO THE VS: C MESSAGE DRIVER, AS FOLLOWS: C C QUEUES C Displays summary of queues on the terminal 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 ( " ... " ARE REQUIRED DELIMITERS FOR QUEUE NAMES) 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. C PARAMETER IOCRQ="2400,IODLQ="3000,IODMP="3400,POOLSZ=1030,POOLBY=2060 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 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.'D')GOTO10200 IF(LINE(1).EQ.'S')GOTO11000 IF(LINE(1).EQ.'Q')GOTO11100 IF(LINE(1).EQ.'X')GOTO10999 WRITE(5,10018)(LINE(I),I=1,L) 10018 FORMAT(' * ILLEGAL COMMAND: ',A1) GOTO10000 10999 CLOSE(UNIT=LUNI) CALL EXIT 10100 FUNC=IOCRQ GOTO10201 10200 FUNC=IODLQ 10201 IF(J.GT.L)GOTO10206 IF(LINE(J).EQ.'"')GOTO10203 WRITE(5,10202) 10202 FORMAT(' * QUEUE NAME MUST BE ENCLOSED IN " ... "') GOTO10000 10203 I=0 10204 J=J+1 I=I+1 IF(LINE(J).EQ.'"')GOTO10210 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 11100 SHORT=.TRUE. J=L+1 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.GT.L)CALL ASNLUN(3,'TI',0) IF(J.LE.L)CALL ASNLUN(3,'SY',0) IF(J.GT.L)GOTO11003 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(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) IQHFLG=WPOOL(IPTR+6) CALL R50ASC(6,RQHOTN,TSKNAM) FLGWOR=' ' IF((IQHFLG.AND."100000).NE.0)FLGWOR=' WOR' IF(.NOT.SHORT) 1 WRITE(3,106)LPTR,TSKNAM,IQHLNK,IQHFMS,IQHLMS,IQHRWP,FLGWOR 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,'; flags: ',A4/) 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)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) IF(SHORT)WRITE(3,11106)TSKNAM,FLGWOR,NMSGS 11106 FORMAT(' "',6A1,'" -- flags: ',A4,' -- messages queued: ',I4) GOTO30 90 CLOSE(UNIT=3) GOTO10000 END