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