C C VSUTIL -- VS: UTILITY PROGRAM C C VERSION V02.02 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 ( " ... " ARE REQUIRED DELIMITERS FOR QUEUE NAMES; "" ... "" WITH CCL.) 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 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) GOTO10000 10999 CLOSE(UNIT=LUNI) CALL EXIT 10100 FUNC=IOCRQ GOTO10201 10150 FUNC=IOFLU 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 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 IF(LINE(J).EQ.'"')GOTO11203 WRITE(5,10202) GOTO10000 11203 I=0 11204 J=J+1 I=I+1 IF(LINE(J).EQ.'"')GOTO11210 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) 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) IF(SHORT.AND..NOT.ONEQ)WRITE(3,11106)TSKNAM,NMSGS 11106 FORMAT(' "',6A1,'" -- messages queued: ',I4) GOTO30 90 CLOSE(UNIT=3) GOTO10000 END