PROGRAM PARMQUAL ** * PROGRAM PARMQUAL * * This program is designed to be used inside command procedures. * It parses the arguments passed to the procedure (the DCL Symbols * P1 through P8), which are assumed to be in the format of DCL * command parameters and qualifiers. The local DCL symbols: * * PARM1, PARM2, ... * * QUAL1, QUAL2, ... * * QUALS * * are set to the values derived from the arguments. The last * symbol in each sequence is set to a null value, to signal that * it is the last. * * Example: * * Suppose that XXX.COM is: $ RUN PARMQUAL * $ SHOW SYM /ALL /LOCAL * * And we invoke XXX as: $ @XXX AAA/BBB /CCC/DDD EEE * * Then the symbols are: PARM1 = "AAA" * PARM2 = "EEE" * PARM3 = "" * QUAL1 = "/BBB" * QUAL2 = "/CCC" * QUAL3 = "/DDD" * QUAL4 = "" * QUALS = "/BBB/CCC/DDD" * * * 17 Apr 1984 Fix problems with following cases: * $ PROC AAA /BBB="/CCC" * $ PROC "" BBB * * * Alan L. Zirkle Naval Surface Weapons Center * Code N41 * 6 March 1984 Dahlgren, Virginia 22448 * IMPLICIT INTEGER (A-Z) CHARACTER*128 VALUE(8) CHARACTER*1 ORD INTEGER VLEN(8) EXTERNAL LIB$_NOSUCHSYM LOGICAL IN_QUOTE CHARACTER*128 SUMQUALS COMMON QLEN,SUMQUALS DATA QLEN,QUALS,PARMS,MAXPARM / 0,0,0,0 / DO I=1,8 ORD = CHAR(I+ICHAR('0')) STATUS = LIB$GET_SYMBOL('P'//ORD,VALUE(I),VLEN(I)) IF (STATUS.NE.%LOC(LIB$_NOSUCHSYM)) THEN IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) IF (VLEN(I).GT.0) MAXPARM = I ENDIF ENDDO DO I=1,MAXPARM IN_QUOTE = .FALSE. START = 1 COL = 1 IF (VLEN(I).EQ.0) GO TO 20 10 IF (VALUE(I)(COL:COL).EQ.'"') IN_QUOTE = .NOT. IN_QUOTE IF (IN_QUOTE) GO TO 20 IF (COL.GT.1.AND.VALUE(I)(COL:COL).EQ.'/') THEN IF (VALUE(I)(START:START).EQ.'/') THEN CALL DEFINE('QUAL',QUALS,VALUE(I)(START:COL-1)) ELSE CALL DEFINE('PARM',PARMS,VALUE(I)(START:COL-1)) ENDIF START = COL ENDIF 20 COL = COL + 1 IF (COL.LE.VLEN(I)) GO TO 10 IF (VALUE(I)(START:START).EQ.'/') THEN CALL DEFINE('QUAL',QUALS,VALUE(I)(START:VLEN(I))) ELSE CALL DEFINE('PARM',PARMS,VALUE(I)(START:VLEN(I))) ENDIF ENDDO LEN = 0 ! This allows definition of a null value CALL DEFINE('QUAL',QUALS,VALUE(1)(1:LEN)) CALL DEFINE('PARM',PARMS,VALUE(1)(1:LEN)) STATUS = LIB$SET_SYMBOL('QUALS',SUMQUALS(1:QLEN)) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) END SUBROUTINE DEFINE(TYPE,ORDINAL,VALUE) IMPLICIT INTEGER (A-Z) CHARACTER*(*) TYPE,VALUE CHARACTER*1 ORD CHARACTER*128 SUMQUALS COMMON QLEN,SUMQUALS ORDINAL = ORDINAL + 1 ORD = CHAR(ORDINAL+ICHAR('0')) STATUS = LIB$SET_SYMBOL(TYPE//ORD,VALUE) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) IF (TYPE.EQ.'QUAL') THEN SUMQUALS(QLEN+1:) = VALUE QLEN = QLEN + LEN(VALUE) ENDIF END