SUBROUTINE DALCMD(IOPCOD) C C C COMPONENT: DALCMD -- DALLOC COMMAND LINE PARSER C C DATE: 27-NOV-79 C C AUTHOR: GR JOHNSON C BATTELLE NORTHWEST C P O BOX 999 C RICHLAND WA 99352 C C SOURCE: FORTRAN IV-PLUS C C DESCRIPTION: C C THE ROUTINE "DALCMD" FETCHES AND PARSES THE MCR COMMAND LINE, RETURNING C THE INTEGER OPERATION CODES DEFINED BELOW: C C OPCODE OPERATION C ------ --------- C 1 DALNEW ! NEW C 2 DALUPD ! UPDATE C 3 DALDUP ! UPDATE/DEFAULT C 4 DALREM ! REMOVE C 5 DALVFY ! VERIFY C 6 DALADT ! AUDIT C 7 DALADB ! AUDIT/BRIEF C C THE ROUTINE ALSO PROMPTS FOR AND PARSES ANY ADDITIONAL PARAMETERS SUPPLIED C BY THE USER, EG: OUTPUT FILESPEC, DEVICE CODE, UFD, AND ALLOCATION LIMIT. C C C OUTPUT FILESPEC -- LOGICAL UNIT 6 IS ASSIGNED. C C DEVICE CODE -- COMMON VARIABLES "VAFDEF" AND "VAFUNT" ARE C INITIALIZED. C C UFD -- COMMON VARIABLE "VAFUIC" IS SET/RESET. C C ALLOCATION LIMIT -- COMMON VARIABLE "VAFLIM" IS SET/RESET. C C C G L O B A L P A R A M E T E R S A N D V A R I A B L E S C C C INCLUDE 'VAFILE.COM/NOLIST' C C C L O C A L P A R A M E T E R S A N D V A R I A B L E S C C C PARAMETER VAFLUN = 1 ! VAFILE LUN PARAMETER TTYLUN = 5 ! TERMINAL I/O LUN PARAMETER RPTLUN = 6 ! REPORT OUTPUT LUN C PARAMETER EOS = 0 ! END-OF-STRING C INTEGER IOPCOD ! INTEGER OPCODE C BYTE ICMD(128) ! INPUT COMMAND LINE BUFFER INTEGER ILEN ! INPUT COMMAND LINE LENGTH INTEGER IPNT ! INPUT COMMAND LINE POINTER C LOGICAL PRTQ ! "/PRINT" QUALIFIER LOGICAL OUTQ ! "/OUTPUT" QUALIFIER C BYTE OUTFIL(32) ! OUTPUT FILE SPECIFICATION BUFFER C INTEGER LUNBUF(6) ! GETLUN DIRECTIVE BUFFER C C C P R E L I M I N A R Y C C C C RESET COMMAND OPCODE C IOPCOD=0 C C C C RESET COMMAND PARAMETERS C VAFDEV(1)=0 VAFDEV(2)=0 C VAFUNT=0 C VAFUIC=0 C VAFLIM=0 C C C C RESET LOCAL FLAGS C PRTQ=.FALSE. OUTQ=.FALSE. C C C C ASSIGN DEFAULT REPORT OUTPUT DEVICE C CALL ASNLUN(RPTLUN,'TI',0) C C C P A R S E D A L L O C C O M M A N D L I N E C C C C FETCH COMMAND LINE -- PARSE COMMAND NAME C 20 CALL GCMD(TTYLUN,ICMD,ILEN) C CALL COMPAR(ICMD,'DALLOC',IPNT) IF(IPNT.LE.3) STOP 'DALLOC installed with unknown task name' C IF(ICMD(IPNT).EQ.EOS) GO TO 2002 IF(ICMD(IPNT).EQ.' ') GO TO 2004 GO TO 90000 C C C C PROMPT AND INPUT "OPERATION" (IF NECCESSARY) C 2002 CALL GCMDP(TTYLUN,'Operation? ',ICMD,ILEN) IF(ILEN.LT.0) CALL EXIT IF(ILEN.EQ.0) GO TO 90100 IPNT=0 C C C C PARSE "OPERATION" C 2004 IPNT=IPNT+1 C IOPCOD=1 ! "NEW" CALL COMPAR(ICMD(IPNT),'NEW',NCHR) IF(NCHR.GT.1) GO TO 2006 C IOPCOD=2 ! "UPDATE" CALL COMPAR(ICMD(IPNT),'UPDATE',NCHR) IF(NCHR.GT.1) GO TO 2006 C IOPCOD=4 ! "REMOVE" CALL COMPAR(ICMD(IPNT),'REMOVE',NCHR) IF(NCHR.GT.1) GO TO 2006 C IOPCOD=5 ! "VERIFY" CALL COMPAR(ICMD(IPNT),'VERIFY',NCHR) IF(NCHR.GT.1) GO TO 2006 C IOPCOD=6 ! "AUDIT" CALL COMPAR(ICMD(IPNT),'AUDIT',NCHR) IF(NCHR.LE.1) GO TO 90200 C C 2006 IPNT=IPNT+NCHR-1 IF(ICMD(IPNT).EQ.'/') GO TO 2008 IF(ICMD(IPNT).EQ.EOS) GO TO 2022 IF(ICMD(IPNT).EQ.' ') GO TO 2024 GO TO 90300 C C C C PARSE "OPERATION/QUALIFIER" C 2008 IPNT=IPNT+1 C CALL COMPAR(ICMD(IPNT),'DEFAULT',NCHR) ! "/DEFAULT" IF(NCHR.GT.1) GO TO 2010 C CALL COMPAR(ICMD(IPNT),'BRIEF',NCHR) ! "/BRIEF" IF(NCHR.GT.1) GO TO 2012 C CALL COMPAR(ICMD(IPNT),'PRINT',NCHR) ! "/PRINT" IF(NCHR.GT.1) GO TO 2014 C CALL COMPAR(ICMD(IPNT),'OUTPUT',NCHR) ! "/OUTPUT" IF(NCHR.GT.1) GO TO 2016 GO TO 90200 C C C C >>> "/DEFAULT" QUALIFIER C 2010 IF(IOPCOD.NE.2) GO TO 90400 C IOPCOD=3 GO TO 2006 C C C C >>> "/BRIEF" QUALIFIER C 2012 IF(IOPCOD.NE.6) GO TO 90400 C IOPCOD=7 GO TO 2006 C C C C >>> "/PRINT" QUALIFIER C 2014 IF(IOPCOD.NE.5.AND. 2 IOPCOD.NE.6.AND. 3 IOPCOD.NE.7 ) GO TO 90400 C IF(OUTQ) GO TO 90400 ! "/OUTPUT" ALREADY SPECIFIED C PRTQ=.TRUE. C CALL ASSIGN(RPTLUN,'CL:[1,4]DALLOC.LST') GO TO 2006 C C C C >>> "/OUTPUT:FILESPEC" QUALIFIER C 2016 IF(IOPCOD.NE.5.AND. 2 IOPCOD.NE.6.AND. 3 IOPCOD.NE.7 ) GO TO 90400 C IF(PRTQ) GO TO 90400 ! "/PRINT" ALREADY SPECIFIED C OUTQ=.TRUE. C IPNT=IPNT+NCHR-1 C IF(ICMD(IPNT).EQ.EOS) GO TO 90100 IF(ICMD(IPNT).EQ.' ') GO TO 90100 IF(ICMD(IPNT).NE.':') GO TO 90300 C DO 2018 NCHR=1,31 OUTFIL(NCHR)=ICMD(IPNT+NCHR) IF(OUTFIL(NCHR).EQ.EOS) GO TO 2020 IF(OUTFIL(NCHR).EQ.' ') GO TO 2020 2018 CONTINUE GO TO 90300 C 2020 OUTFIL(NCHR)=EOS C CALL FILNAM(OUTFIL,,,'DALLOC','LST') C CALL ERRSNS CALL ASSIGN(RPTLUN,OUTFIL) CALL ERRSNS(ISW) IF(ISW.NE.0) GO TO 90500 C IPNT=IPNT+1 C GO TO 2006 C C C C PROMPT AND INPUT "DEVICE" AND/OR "UFD" C 2022 IF(IOPCOD.EQ.1) CALL GCMDP(TTYLUN,'Device and UFD? ' ,ICMD,ILEN) IF(IOPCOD.EQ.2) CALL GCMDP(TTYLUN,'Device and UFD? ' ,ICMD,ILEN) IF(IOPCOD.EQ.3) CALL GCMDP(TTYLUN,'Device? ' ,ICMD,ILEN) IF(IOPCOD.EQ.4) CALL GCMDP(TTYLUN,'Device and UFD? ' ,ICMD,ILEN) IF(IOPCOD.EQ.5) CALL GCMDP(TTYLUN,'Device? ' ,ICMD,ILEN) IF(IOPCOD.EQ.6) CALL GCMDP(TTYLUN,'Device [and UFD]? ',ICMD,ILEN) IF(IOPCOD.EQ.7) CALL GCMDP(TTYLUN,'Device? ' ,ICMD,ILEN) C IF(ILEN.LT.0) CALL EXIT IF(ILEN.EQ.0) GO TO 90100 IPNT=0 C C C C PARSE "DEVICE" C 2024 IPNT=IPNT+1 C VAFDEV(1)=ICMD(IPNT) IPNT=IPNT+1 VAFDEV(2)=ICMD(IPNT) IPNT=IPNT+1 C VAFUNT=0 C 2026 IF(ICMD(IPNT).LT.'0') GO TO 2028 IF(ICMD(IPNT).GT.'7') GO TO 2028 VAFUNT=8*VAFUNT+(ICMD(IPNT)-'0') IPNT=IPNT+1 GO TO 2026 C 2028 IF(ICMD(IPNT).NE.':') GO TO 90600 C CALL ASNLUN(VAFLUN,VAFDEV,VAFUNT,ISW) IF(ISW.NE.1) GO TO 90600 C CALL GETLUN(VAFLUN,LUNBUF) ITMP="140010 IF(LUNBUF(3).NE.ITMP) GO TO 90700 C C C C PARSE "UFD" (IF NECCESSARY) C 2030 IPNT=IPNT+1 C IF(ICMD(IPNT).EQ.'[') GO TO 2032 IF(IOPCOD.EQ.1) GO TO 90100 ! UFD REQUIRED FOR "NEW" IF(IOPCOD.EQ.2) GO TO 90100 ! UFD REQUIRED FOR "UPDATE" IF(IOPCOD.EQ.4) GO TO 90100 ! UFD REQUIRED FOR "REMOVE" C IF(ICMD(IPNT).EQ.EOS) GO TO 2042 IF(ICMD(IPNT).EQ.'/') GO TO 2044 GO TO 90300 C C 2032 IF(IOPCOD.EQ.3) GO TO 90400 ! ERROR FOR "UPDATE/DEFAULT" C IF(IOPCOD.EQ.5) GO TO 2056 ! IGNORE FOR "VERIFY" IF(IOPCOD.EQ.7) GO TO 2056 ! IGNORE FOR "AUDIT/BRIEF" C C DO 2034 ITMP=1,9 VAFUFD(ITMP)=ICMD(IPNT) IPNT=IPNT+1 IF(VAFUFD(ITMP).EQ.']') GO TO 2036 2034 CONTINUE GO TO 90800 C 2036 VAFUFD(ITMP+1)=EOS C C IF(VAFUFD(1).NE.'['.OR. 2 VAFUFD(2).NE.'*'.OR. 3 VAFUFD(3).NE.','.OR. 4 VAFUFD(4).NE.'*'.OR. 5 VAFUFD(5).NE.']' ) GO TO 2038 C IF(IOPCOD.EQ.2.OR. 2 IOPCOD.EQ.6 ) GO TO 2040 GO TO 90800 C C 2038 CALL CVTUIC(VAFUFD,VAFUIC,-1,ISW) IF(ISW.NE.0) GO TO 90800 C IF(VAFUIC.EQ.0) GO TO 90800 C C 2040 IF(ICMD(IPNT).EQ.EOS) GO TO 2042 IF(ICMD(IPNT).EQ.'/') GO TO 2044 GO TO 90200 C C C C PROMPT AND INPUT "DALLOC" LIMIT PARAMETER (IF NECCESSARY) C 2042 IF(IOPCOD.NE.1.AND. 2 IOPCOD.NE.2.AND. 3 IOPCOD.NE.3 ) GO TO 2060 C CALL GCMDP(TTYLUN,'Parameters? ',ICMD,ISW) IF(ISW.LT.0) CALL EXIT IF(ISW.EQ.0) GO TO 90100 IPNT=0 C GO TO 2046 C C C C PARSE DIRECTORY ALLOCATION LIMIT PARAMETER C 2044 IF(IOPCOD.NE.1.AND. 2 IOPCOD.NE.2.AND. 3 IOPCOD.NE.3 ) GO TO 2056 C 2046 IPNT=IPNT+1 C CALL COMPAR(ICMD(IPNT),'DALLOC',NCHR) IF(NCHR.GT.1) GO TO 2048 C CALL COMPAR(ICMD(IPNT),'NODALLOC',NCHR) IF(NCHR.GT.1) GO TO 2054 GO TO 90300 C C C C >>> "/DALLOC" QUALIFIER C 2048 IPNT=IPNT+NCHR-1 C VAFLIM=0 C IF(ICMD(IPNT).EQ.EOS) GO TO 2060 IF(ICMD(IPNT).NE.':') GO TO 90300 C IPNT=IPNT+1 IF(ICMD(IPNT).LT.'0') GO TO 90900 IF(ICMD(IPNT).GT.'9') GO TO 90900 C 2050 IF(ICMD(IPNT).LT.'0') GO TO 2052 IF(ICMD(IPNT).GT.'9') GO TO 2052 VAFLIM=10*VAFLIM+(ICMD(IPNT)-'0') IPNT=IPNT+1 GO TO 2050 C 2052 IF(VAFLIM.EQ.0) GO TO 90900 C IF(ICMD(IPNT).EQ.'.') IPNT=IPNT+1 IF(ICMD(IPNT).EQ.EOS) GO TO 2060 GO TO 90300 C C C C >>> "/NODALLOC" QUALIFIER C 2054 IPNT=IPNT+NCHR-1 C VAFLIM=-1 C IF(ICMD(IPNT).EQ.EOS) GO TO 2060 GO TO 90300 C C C C IGNORE UNNECCESSARY OR REDUNDANT PARAMETERS C 2056 WRITE(TTYLUN,2058) (ICMD(IPNT),IPNT=IPNT,ILEN) 2058 FORMAT(1X,A1,' - ignored') C C C C RETURN TO CALLER C 2060 RETURN C C C P R O C E S S F A T A L E R R O R S C C C 90000 WRITE(TTYLUN,90001) 90001 FORMAT(' Illegal command'/) CALL EXIT C 90100 WRITE(TTYLUN,90101) 90101 FORMAT(' Required parameter not specified'/) CALL EXIT C 90200 WRITE(TTYLUN,90201) 90201 FORMAT(' Unknown qualifier'/) CALL EXIT C 90300 WRITE(TTYLUN,90301) 90301 FORMAT(' Invalid qualifier'/) CALL EXIT C 90400 WRITE(TTYLUN,90401) 90401 FORMAT(' Inconsistant qualifier'/) CALL EXIT C 90500 WRITE(TTYLUN,90501) 90501 FORMAT(' Illegal file specification'/) CALL EXIT C 90600 WRITE(TTYLUN,90601) 90601 FORMAT(' Invalid device code'/) CALL EXIT C 90700 WRITE(TTYLUN,90701) 90701 FORMAT(' Not a directory device'/) CALL EXIT C 90800 WRITE(TTYLUN,90801) 90801 FORMAT(' Invalid UFD'/) CALL EXIT C 90900 WRITE(TTYLUN,90901) 90901 FORMAT(' Invalid allocation limit'/) CALL EXIT C C END