MODULE VALIDATE (MAIN = VALIDATE, LIST(SOURCE,COMMENTARY))=
BEGIN

!	Program Validate is designed to aid command procedure files by setting
!	exit status according to whether or not the file named on the command
!	line exists or not.  $SEVERITY is:
!		WARNING if there was an error on the command line
!		INFORMATIONAL if the file (or its directory) did not exist
!		SUCCESS if the file did exist
!
!	Parameter:
!		file-spec
!
!	Qualiflers:
!		/[NO]LOG - write the name of the file to SYS$OUTPUT
!		/[NO]BRIEF - for /LOG, delete the prefix " File found: "
!			   from the message.
!		/DEFAULT - provides any element that should be used as default
!			   in the file spec, in file-spec format.

!	Written by R.J. FitzPatrick 23-Jul-1980 at SAO

LIBRARY 'SYS$LIBRARY:STARLET.L32';
LIBRARY 'SYS$LIBRARY:CLIMAC.L32';
LIBRARY 'SYS$LIBRARY:TPAMAC.L32';

!	STRINGS is a macro package that allows easy definition of string
!	literals, with optional descriptor.

REQUIRE 'STRINGS.REQ';

LITERAL

    MAX_PARAMS	= 1,

    DESCR_SIZE	= 2,
    XDESCR_SIZE = 3,

    TRUE	= 1,
    FALSE	= 0,

    ON		= 1,
    OFF		= 0;

LITERAL
    VAL_NOWILD	= RMS$_SYN,
    DCL_IVDELIM	= %X'38110',
    DCL_DIRECT	= %X'38030',
    DCL_NOLIST	= %X'380C0',
    DCL_NOVALU	= %X'380D0',
    DCL_NOKEYW	= %X'380B8',
    DCL_IVKEYW	= %X'38060',
    DCL_BADVAL	= %X'38060',	! Same as IVKEYW.
    DCL_NOTNEG	= %X'380D8',
    DCL_INSFPRM	= %X'38048',
    DCL_NULFIL	= %X'380E0',
    DCL_MAXPARM	= %X'38098';

STRUCTURE
	BBLOCK [O, P, S, E; N] =
		[N]
		(BBLOCK+O)<P,S,E>;
!
! Macro to declare parameter list for TPARSE action routines.
!
MACRO
	TPARSE_ARGS (NAME) =
		BUILTIN AP;
		BIND NAME = AP : REF BBLOCK;
		%;

FIELD
    QUAL_FIELDS =
	SET
	SUCC	= [0,0,1,0],
	FAIL	= [0,1,1,0],
	ALL	= [0,0,2,0],
	BRIEF	= [0,2,1,0]
	TES,

    XDESCR_FIELDS =
	SET
	COUNT	= [0,0,16,0],
	DTYPE	= [0,16,8,0],
	CLASS	= [0,24,8,0],
	ADDRESS	= [1,0,32,0],
	POINTER	= [2,0,32,0]
	TES;

MACRO
    DESCR = BLOCK[DESCR_SIZE] FIELD(XDESCR_FIELDS) %;
MACRO
    XDESCR = BLOCK[XDESCR_SIZE] FIELD(XDESCR_FIELDS) %;
MACRO
    DYNAMIC = 2^24 OR DSC$K_DTYPE_T^16 %;

FORWARD ROUTINE
    TELL,
    PROMPT;

OWN
    PARSE_ERROR,
    QUAL_FLAGS	: BLOCK[1] FIELD(QUAL_FIELDS),
    PARAM_COUNT,
    RAWBUF	: VECTOR[NAM$C_MAXRSS, BYTE],
    PARSED	: VECTOR[NAM$C_MAXRSS, BYTE],
    NAMEBUF	: VECTOR[NAM$C_MAXRSS, BYTE],
    ANAM	: $NAM(
			ESA=PARSED,
			ESS=NAM$C_MAXRSS,
			RSA=NAMEBUF,
			RSS=NAM$C_MAXRSS
			),
    AFAB	: $FAB(    ! B_FNS is set in CNT_PARM
			FNA=NAMEBUF,
			NAM=ANAM
			), ! Fields B_DNS & L_DNA may be set in SET_DEF

    TPARSE_BLOCK	: BBLOCK [TPA$K_LENGTH0]
			  INITIAL (TPA$K_COUNT0, 2^24);

GLOBAL ROUTINE VALIDATE (START_ADD, CLI_CALLBACK) =
BEGIN

    OWN
	PUTMSGVEC	: VECTOR[3]
			  INITIAL(15^16 OR 2),
	GET_CMD		: $CLIREQDESC (RQTYPE = GETCMD);

    PDSLIT (FACILITY, 'VALIDATE');
    PSLIT (FOUND, ' File found: ');
    PSLIT (NOT_FOUND, ' File not found: ');
    PSLIT (SPEC_ERR, ' File specification error in: ');

    EXTERNAL
	CLI_STB		: VECTOR [0],
	CLI_KTB		: VECTOR [0];

    EXTERNAL ROUTINE
	LIB$TPARSE;

    REGISTER
	STATUS;

    LOCAL
	TELL_FN,
	TELL_FNL;

    (.CLI_CALLBACK) (GET_CMD);
    TPARSE_BLOCK[TPA$L_STRINGCNT] = .GET_CMD[CLI$W_RQSIZE];
    TPARSE_BLOCK[TPA$L_STRINGPTR] = .GET_CMD[CLI$A_RQADDR];
    TPARSE_BLOCK[TPA$V_ABBREV] = ON;
    STATUS = LIB$TPARSE (TPARSE_BLOCK, CLI_STB, CLI_KTB);
    IF .PARSE_ERROR NEQ 0 THEN STATUS = .PARSE_ERROR;
    IF .STATUS THEN IF .PARAM_COUNT EQL 0 THEN STATUS = PROMPT();
    IF .STATUS	!  Else there was an error in parsing, or perhaps no file name
!		!  (especially likely in batch mode).
    THEN
	BEGIN
	STATUS = $PARSE(FAB=AFAB);

!	Show the user the best version of the file name possible.
!	The file name is put into Namebuf by Tparse, then into Parsed by
!	$Parse (if it is successfull, and for some error conditions), then
!	into Namebuf by $Search if it is successfull.  Note that that if the
!	name is in Namebuf, the length may be in either the FAB or the NAM
!	block.

	IF .ANAM[NAM$B_ESL] EQL 0
	THEN
	    BEGIN
	    TELL_FN = NAMEBUF;
	    TELL_FNL = .AFAB[FAB$B_FNS]
	    END
	ELSE
	    BEGIN
	    TELL_FN = PARSED;
	    TELL_FNL = .ANAM[NAM$B_ESL]
	    END;
	IF (   .STATUS EQL RMS$_NORMAL
	    OR .STATUS EQL RMS$_DNF	! These two errors result in severity
	    OR .STATUS EQL RMS$_DNR)	! of Informational, because they are
!					! very close to file-not-found.
	THEN
	    BEGIN
	    IF .STATUS EQL RMS$_NORMAL THEN STATUS = $SEARCH(FAB=AFAB);
	    IF .STATUS	! Now we see if the caller wants the result logged.
	    THEN
		BEGIN
		STATUS = SS$_NORMAL;	! Instead of RMS$_SUCCESS
		IF .QUAL_FLAGS[SUCC]
		THEN TELL(NAMEBUF, .ANAM[NAM$B_RSL],
			  FOUND, STRING_LENGTH(FOUND),
			  .QUAL_FLAGS[BRIEF])
		END
	    ELSE   ! STATUS from $Search was bad, or we had DNF or DNR.
		BEGIN
		STATUS<0,3,0> = 3;	! Severity = Information
		IF .QUAL_FLAGS[FAIL]
		THEN
		    BEGIN
		    TELL(.TELL_FN, .TELL_FNL,
			 NOT_FOUND, STRING_LENGTH(NOT_FOUND),
			 .QUAL_FLAGS[BRIEF]);
		    PUTMSGVEC[1] = .STATUS;
		    PUTMSGVEC[2] = .AFAB[FAB$L_STV];
		    $PUTMSG(MSGVEC=PUTMSGVEC, FACNAM=DESCRIPTOR(FACILITY))
		    END
		END
	    END
	ELSE
	    BEGIN
	    STATUS<0,3,0> = 0;	! Severity = Warn
	    TELL(.TELL_FN, .TELL_FNL,
		  SPEC_ERR, STRING_LENGTH(SPEC_ERR), OFF) ! i.e. BRIEF = OFF
	    END
	END;
    RETURN .STATUS
END;

ROUTINE PROMPT =
BEGIN

    OWN
	RESULT : DESCR INITIAL(DYNAMIC);

    REGISTER
	STATUS;

    EXTERNAL
	CLI_STB		: VECTOR [0],
	CLI_KTB		: VECTOR [0];

    EXTERNAL ROUTINE
	OTS$SFREE1_DD,
	LIB$TPARSE,
	LIB$GET_COMMAND;

    PDSLIT (PROMPT_STR, ' File: ');

    DO
	STATUS = LIB$GET_COMMAND(RESULT, DESCRIPTOR(PROMPT_STR))
    UNTIL (IF .STATUS THEN  .RESULT[COUNT] GTR 0  ELSE TRUE);
    IF .STATUS EQL RMS$_EOF THEN (STATUS = DCL_INSFPRM)
    ELSE IF .STATUS
    THEN
	BEGIN
	TPARSE_BLOCK[TPA$L_STRINGCNT] = .RESULT[COUNT];
	TPARSE_BLOCK[TPA$L_STRINGPTR] = .RESULT[ADDRESS];
	STATUS = LIB$TPARSE (TPARSE_BLOCK, CLI_STB, CLI_KTB);
	OTS$SFREE1_DD(RESULT);
	IF .PARSE_ERROR NEQ 0 THEN STATUS = .PARSE_ERROR;
	IF .STATUS THEN IF .PARAM_COUNT EQL 0 THEN STATUS = DCL_NULFIL
	END;
    RETURN .STATUS
END;


ROUTINE TELL (FNAM, FNAM_LEN, PREFIX, PREFIX_LEN, BRIEF_FLAG) =
BEGIN

    LOCAL
	MESSAGE : DESCR;

    REGISTER
	RSZ;

    EXTERNAL ROUTINE
	LIB$PUT_OUTPUT;

    IF .BRIEF_FLAG
    THEN	! Setup to send only file name as message.
	BEGIN
	MESSAGE[COUNT] = .FNAM_LEN;
	MESSAGE[ADDRESS] = .FNAM
	END
    ELSE	! Put label and file name into message.
	BEGIN
	RSZ = .PREFIX_LEN + .FNAM_LEN;
	CH$COPY( .PREFIX_LEN, CH$PTR(.PREFIX),
		 .FNAM_LEN, CH$PTR(.FNAM),
		 %C' ', .RSZ, CH$PTR(RAWBUF));
	MESSAGE[COUNT] = .RSZ;
	MESSAGE[ADDRESS] = RAWBUF
	END;

!	Now send the message.

    LIB$PUT_OUTPUT(MESSAGE)
END;

!		LIB$TPARSE SECTION
!		********** *******

!	There are two sets of LIB$TPARSE states, i.e. two $INIT_STATE macro
!	calls.  The first is for the scan of the command line and/or the
!	response to prompting.  The second is called from the action routines
!	of the first, and is for parsing a file name, which may be the (only)
!	parameter or a /DEFAULT= spec.

!	Action routines used by both parsers --

ROUTINE SAVEPUNC =
BEGIN

    TPARSE_ARGS(TPA);

    BIND
	TARGET = TPA[TPA$L_PARAM] : REF XDESCR;

    TARGET[POINTER] = CH$MOVE(1, CH$PTR(TPA[TPA$L_CHAR]), .TARGET[POINTER]);
    TARGET[COUNT] = .TARGET[COUNT] + 1;
    RETURN SS$_NORMAL
END;

ROUTINE SAVESYM =
BEGIN

    TPARSE_ARGS(TPA);

    BIND
	TARGET = TPA[TPA$L_PARAM] : REF XDESCR;

    TARGET[COUNT] = .TARGET[COUNT] + .TPA[TPA$L_TOKENCNT];
    TARGET[POINTER] = CH$MOVE(.TPA[TPA$L_TOKENCNT],
		      CH$PTR(.TPA[TPA$L_TOKENPTR]),
		    .TARGET[POINTER]);
    RETURN SS$_NORMAL
END;

!	Action routines for initial scan only --

ROUTINE BLANKS_ON: NOVALUE =
BEGIN

    TPARSE_ARGS(TPA);

    TPA[TPA$V_BLANKS] = ON
END;

ROUTINE BLANKS_OFF: NOVALUE =
BEGIN

    TPARSE_ARGS(TPA);

    TPA[TPA$V_BLANKS] = OFF
END;

!		Routines called to clear bits set by TPARSE maskaddr/mask

ROUTINE NO_LOG: NOVALUE =
    QUAL_FLAGS[ALL] = 0;

ROUTINE NO_BR: NOVALUE =
    QUAL_FLAGS[BRIEF] = 0;

ROUTINE IVDELIM: NOVALUE =	! Last gasp error message.
    IF .PARSE_ERROR EQL 0 THEN PARSE_ERROR = DCL_IVDELIM;
    

!	Variables declared in the outer-most block, but not needed until
!	this point (i. e. used only while parsing).
OWN
    COLON_FLAG,
    DEFAULTBUF	: VECTOR[NAM$C_MAXRSS, BYTE],
    RAWDESCR	: XDESCR
		  INITIAL(0, RAWBUF, CH$PTR(RAWBUF)),
    NAME	: XDESCR,	! Descriptor of name string found by LIB$TPARSE
    NAME_TMP	: XDESCR;



!	TPARSE action routine to parse a string to check for legitimate file
!	name.  LIB$TPARSE is called again to do the parsing.  Any logical name
!	translations necessary will be done by TRNLOG, called as an action
!	routine by LIB$TPARSE.
!
!	The string to be parsed may be a parameter or follow /DEF=
!
!	Arguments:
!	    Standard calling sequence from LIB$TPARSE, with the "parameter"
!	    of the transition macro set to the address of a vector specific
!	    to the source of the string.  This value is passed into CHECK as
!	    .TPA[TPA$L_PARAM].  The vector pointed to contains:
!		- The address of the buffer in which to place the successfully
!		  parsed/expanded string.
!		- The address of a routine for CHECK to call to record that the
!		  string has been successfully parsed, and in the case of a
!		  parameter, to check that the maximum parameter count is not
!		  exceeded.
!	    Implicitly, the string to be parsed is described by RAWDESCR.
!
ROUTINE CHECK =
BEGIN

    TPARSE_ARGS(TPA);

    BIND
	ARGS	= TPA[TPA$L_PARAM] : REF VECTOR[2];

    OWN
	TPARSE_BLOCK	: BBLOCK [TPA$K_LENGTH0]
			  INITIAL (TPA$K_COUNT0, 2^24);

    EXTERNAL
	FSPEC_STB	: VECTOR [0],
	FSPEC_KTB	: VECTOR [0];

    EXTERNAL ROUTINE
	LIB$TPARSE;

    REGISTER
	STATUS;

!	NAME is an extended descriptor of the resultant string of LIB$TPARSE
!	Its address is passed to various action routines by the TPARSE 
!	transitions.  It is also known to Routine TRNLOG.
    NAME[COUNT] = 0;
    NAME[ADDRESS] = .ARGS[0];
    NAME[POINTER] = CH$PTR(.NAME[ADDRESS]);
!	NAME_TMP is an auxiliary extended descriptor of the resultant string,
!	used as in sub-states which may need to be unwound.
    NAME_TMP[COUNT] = 0;
    NAME_TMP[ADDRESS] = .ARGS[0];
    NAME_TMP[POINTER] = .NAME[POINTER];
    TPARSE_BLOCK[TPA$L_STRINGCNT] = .RAWDESCR[COUNT];
    TPARSE_BLOCK[TPA$L_STRINGPTR] = .RAWDESCR[ADDRESS];
    STATUS = LIB$TPARSE (TPARSE_BLOCK, FSPEC_STB, FSPEC_KTB);
    IF .PARSE_ERROR NEQ 0 THEN STATUS = .PARSE_ERROR;
!	If successfull to this point, call the auxiliary (completion)
!	routine whose address was passed in the argument vector of the
!	transition which called CHECK.
    IF .STATUS THEN STATUS = (.ARGS[1]) ();
!	Empty RAWDESCR
    RAWDESCR[COUNT] = 0;
    RAWDESCR[POINTER] = CH$PTR(.RAWDESCR[ADDRESS]);
    RETURN .STATUS
END;

!	Completion routines for CHECK --

ROUTINE CNT_PARM =	! For parameter
BEGIN
    AFAB[FAB$B_FNS] = .NAME[COUNT];
    PARAM_COUNT = .PARAM_COUNT+1;
    IF (.PARAM_COUNT GTR MAX_PARAMS)
    THEN PARSE_ERROR = DCL_MAXPARM
    ELSE SS$_NORMAL
END;

ROUTINE SET_DEF =	! For default string
BEGIN
    AFAB[FAB$B_DNS] = .NAME[COUNT];
    AFAB[FAB$L_DNA] = DEFAULTBUF;
    RETURN SS$_NORMAL
END;

!	Argument lists for CHECK

OWN
    PARAMVEC	: VECTOR[2]
		  INITIAL(NAMEBUF, CNT_PARM),
    DEFVEC	: VECTOR[2]
		  INITIAL(DEFAULTBUF, SET_DEF);

!	Routines for file-spec scan only --

ROUTINE MOVPART: NOVALUE =
BEGIN

    NAME[COUNT] = .NAME[COUNT] + .NAME_TMP[COUNT];
    NAME_TMP[COUNT] = 0;
    NAME[POINTER] = .NAME_TMP[POINTER]

END;

ROUTINE CLEAN: NOVALUE =
BEGIN

    NAME_TMP[COUNT] = 0;
    NAME_TMP[POINTER] = .NAME[POINTER]

END;


ROUTINE TRNLOG =
BEGIN

    REQUIRE 'HANDY.REQ';

!	Does a logical name translation on the current string.
!	The translation is recursive on two levels:
!	    a) Subroutine SYS_TRNLOG does a recursive translation on the
!		entire string.
!	    b) If the returned string contains a :, then the portion before
!		the : is translated by another call to SYS_TRNLOG.
!	Finally, if the original string was terminated by a : and the result
!	string contains no punctuation, then terminate the result with a : .

    REGISTER
	STATUS;

    LOCAL
	RLEN;

    OWN
	PIECE	: XDESCR,
	SDESCR	: DESCR,
	RDESCR	: DESCR,
	TRN_BUF	: VECTOR[NAM$C_MAXRSS, BYTE];

    PIECE[COUNT]	= 0;
    SDESCR[COUNT]	= .NAME[COUNT];
    RDESCR[COUNT]	= NAM$C_MAXRSS;
    SDESCR[ADDRESS]	= .NAME[ADDRESS];
    RDESCR[ADDRESS]	= TRN_BUF;
    DO  BEGIN
!	Call SYS_TRNLOG ---
	STATUS = $TRNLOGR(LOGNAM=SDESCR, RSLLEN=RLEN, RSLBUF=RDESCR);
	IF .STATUS EQL SS$_NORMAL
	THEN
	    IF (INCR I FROM 1 TO .RLEN-1
		DO
		    IF CH$RCHAR(CH$PTR(.RDESCR[ADDRESS], .I)) EQL %C':'
		    THEN
			BEGIN

			REGISTER
			    TEMP;
			COLON_FLAG = FALSE;
			SDESCR[COUNT] = .I;
			TEMP = .SDESCR[ADDRESS];
			SDESCR[ADDRESS] = .RDESCR[ADDRESS];
			RDESCR[ADDRESS] = .TEMP;
			IF .PIECE[COUNT] NEQ 0 THEN	    ! Add old piece.
			    CH$MOVE(.PIECE[COUNT], .PIECE[POINTER],
				    CH$PTR(.SDESCR[ADDRESS], .RLEN));
			PIECE[POINTER] = CH$PTR(.SDESCR[ADDRESS], .SDESCR[COUNT]);
			PIECE[COUNT] = .PIECE[COUNT] + .RLEN - .SDESCR[COUNT];
			EXITLOOP 0
			END)
		EQL -1
	    THEN EXITLOOP
	END
    WHILE (.STATUS EQL SS$_NORMAL);

    IF .STATUS
    THEN
	BEGIN
	IF .STATUS EQL SS$_NOTRAN THEN STATUS = SS$_NORMAL;
	IF .COLON_FLAG
	THEN
	    BEGIN

	    REGISTER
	        NEXT_PUNC;

	    PSLIT(PUNC_LIST, '.;[]<>');

	    COLON_FLAG = FALSE;
	    IF (INCR NEXT_PUNC FROM 0 TO STRING_LENGTH(PUNC_LIST) - 1
		DO IF NOT CH$FAIL(CH$FIND_CH(.RDESCR[COUNT], CH$PTR(.RDESCR[ADDRESS]),
				     CH$RCHAR(CH$PTR(PUNC_LIST, .NEXT_PUNC))))
		   THEN EXITLOOP 0)
	    THEN
	        BEGIN
	        CH$WCHAR(%C':', CH$PTR(.RDESCR[ADDRESS], .RLEN));
	        RLEN = .RLEN + 1
	        END
	    END;

	NAME[COUNT] = .RLEN + .PIECE[COUNT];
	NAME[POINTER] = CH$COPY(.RLEN, CH$PTR(.RDESCR[ADDRESS]),
			.PIECE[COUNT], .PIECE[POINTER],
			%C' ',		! Effectively ignored.
			.NAME[COUNT], CH$PTR(.NAME[ADDRESS]));
	NAME_TMP[POINTER] = .NAME[POINTER]
	END;

    RETURN .STATUS
END;	! TRNLOG

!	TPARSE state tables for initial scan.

BEGIN
SWITCHES LIST(NOOBJECT);

$INIT_STATE	(CLI_STB, CLI_KTB);


!	MASTER state -- finds qualifiers and parameters.
!			exits on EOS or parsing error.

$STATE	(MASTER,
	( (QUAL),MASTER),
	( (PARAM),MASTER,CHECK,,,PARAMVEC),
	(TPA$_EOS,TPA$_EXIT),
	(TPA$_LAMBDA,TPA$_FAIL,IVDELIM)
	);

!	States needed to identify qualifiers, and their values.

$STATE	(QUAL,
	('/')
	);
$STATE	(QUAL0,
	('NOLOG',NEG_QUAL,NO_LOG),
	('LOG'),
	('NOBRIEF',NEG_QUAL,NO_BR),
	('BRIEF',NEG_QUAL,,4,QUAL_FLAGS),
	('DEFAULT',DEF),
	('NODEFAULT',TPA$_FAIL,,DCL_NOTNEG,PARSE_ERROR),
	(TPA$_SYMBOL,TPA$_FAIL,,DCL_IVKEYW,PARSE_ERROR),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_NOKEYW,PARSE_ERROR)
	);
$STATE	(,
	('='),
	(TPA$_LAMBDA,TPA$_EXIT,,3,QUAL_FLAGS)
	);
$STATE	(,
	('ALL',TPA$_EXIT,,3,QUAL_FLAGS),
	('FAILURE',TPA$_EXIT,,2,QUAL_FLAGS),
	('SUCCESS',TPA$_EXIT,,1,QUAL_FLAGS),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_BADVAL,PARSE_ERROR)
	);
$STATE	(DEF,
	('='),
	(TPA$_LAMBDA,TPA$_EXIT)
	);
$STATE	(,
	( (PARAM),TPA$_EXIT,CHECK,,,DEFVEC),
	(TPA$_EOS,TPA$_FAIL,,DCL_NULFIL,PARSE_ERROR),
	(TPA$_LAMBDA,TPA$_FAIL,IVDELIM)
	);
$STATE	(NEG_QUAL,
	('=',TPA$_FAIL,,DCL_NOVALU,PARSE_ERROR),
	(TPA$_LAMBDA,TPA$_EXIT)
	);


!	States needed to get parameters, without checking their content.

$STATE	(PARAM,
	('/',TPA$_FAIL),	! In case QUAL foun an error.
	(TPA$_SYMBOL,,SAVESYM,,,RAWDESCR),
	('*',,SAVEPUNC,,,RAWDESCR),
	('[',,SAVEPUNC,,,RAWDESCR),
	('<',,SAVEPUNC,,,RAWDESCR),
	('.',,SAVEPUNC,,,RAWDESCR)
	);
$STATE	(,
	(TPA$_LAMBDA,,BLANKS_ON)
	);
$STATE	(PLOOP,
	('/',,BLANKS_OFF),
	(TPA$_SYMBOL,PLOOP,SAVESYM,,,RAWDESCR),
	('.',PLOOP,SAVEPUNC,,,RAWDESCR),
	(';',PLOOP,SAVEPUNC,,,RAWDESCR),
	(':',PLOOP,SAVEPUNC,,,RAWDESCR),
	('[',PLOOP,SAVEPUNC,,,RAWDESCR),
	(']',PLOOP,SAVEPUNC,,,RAWDESCR),
	('<',PLOOP,SAVEPUNC,,,RAWDESCR),
	('>',PLOOP,SAVEPUNC,,,RAWDESCR),
	(',',PLOOP,SAVEPUNC,,,RAWDESCR),
	('*',PLOOP,SAVEPUNC,,,RAWDESCR),
	(TPA$_BLANK,TPA$_EXIT,BLANKS_OFF),
	(TPA$_EOS,TPA$_EXIT),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_IVDELIM,PARSE_ERROR)
	);
$STATE	(,
	( (QUAL0),TPA$_EXIT),
	(TPA$_LAMBDA,TPA$_FAIL)
	);


!	States needed to parse a parameter, which must be a single file-spec.

$INIT_STATE	(FSPEC_STB, FSPEC_KTB);

$STATE	(,
	( (UIC),FNAME,MOVPART),
	( (DIRNAM),FNAME,MOVPART),
	( (LOGNAM),NAME_OR_DIR,TRNLOG),
	(TPA$_SYMBOL,PART2,SAVESYM,,,NAME),	! File name.
	('.',PART3,SAVEPUNC,,,NAME),
	(';',PART3,SAVEPUNC,,,NAME),
	('*',TPA$_FAIL,,VAL_NOWILD,PARSE_ERROR),
	(TPA$_LAMBDA,TPA$_FAIL,IVDELIM)
	);
$STATE	(NAME_OR_DIR,
	( (UIC),,MOVPART),
	( (DIRNAM),,MOVPART),
	(TPA$_LAMBDA)
	);
$STATE	(FNAME,
	('*',TPA$_FAIL,,VAL_NOWILD,PARSE_ERROR),
	(TPA$_SYMBOL,,SAVESYM,,,NAME),
	(TPA$_EOS,TPA$_EXIT),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_IVDELIM,PARSE_ERROR)
	);
$STATE	(PART2,
	('.',,SAVEPUNC,,,NAME),
	(';',FNAME,SAVEPUNC,,,NAME),
	(TPA$_EOS,TPA$_EXIT),
	(',',TPA$_FAIL,,DCL_NOLIST,PARSE_ERROR),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_IVDELIM,PARSE_ERROR)
	);
$STATE	(PART3,	! This state is needed for the syntax NAME.;
	('.',FNAME,SAVEPUNC,,,NAME),	! [with the variant NAME.. or NAME..1]
	(';',FNAME,SAVEPUNC,,,NAME),
	(',',TPA$_FAIL,,DCL_NOLIST,PARSE_ERROR),
	(TPA$_SYMBOL,PART2,SAVESYM,,,NAME),
	('*',TPA$_FAIL,,VAL_NOWILD,PARSE_ERROR),
	(TPA$_EOS,TPA$_EXIT),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_IVDELIM,PARSE_ERROR)
	);

!	Sub-states for file name parts.

$STATE	(LOGNAM,
	(TPA$_SYMBOL,,SAVESYM,,,NAME_TMP)
	);
$STATE	(,
	(':',TPA$_EXIT,MOVPART,TRUE,COLON_FLAG),
	(TPA$_EOS,TPA$_EXIT,MOVPART),
	(TPA$_LAMBDA,TPA$_FAIL)
	);

$STATE	(UIC,
	(TPA$_LAMBDA,,CLEAN)
	);
$STATE	(,
	('[',,SAVEPUNC,,,NAME_TMP),
	('<',,SAVEPUNC,,,NAME_TMP)
	);
$STATE	(,
	(TPA$_OCTAL,,SAVESYM,,,NAME_TMP)
	);
$STATE	(,
	(',',,SAVEPUNC,,,NAME_TMP),
	);
$STATE	(,
	(TPA$_OCTAL,,SAVESYM,,,NAME_TMP)
	);
$STATE	(,
	(']',TPA$_EXIT,SAVEPUNC,,,NAME_TMP),
	('>',TPA$_EXIT,SAVEPUNC,,,NAME_TMP)
	);

$STATE	(DIRNAM,
	(TPA$_LAMBDA,,CLEAN)
	);
$STATE	(,
	('[',,SAVEPUNC,,,NAME_TMP),
	('<',,SAVEPUNC,,,NAME_TMP)
	);
$STATE	(SUBDIR,
	(TPA$_STRING,SUBDIR,SAVESYM,,,NAME_TMP),
	('.',SUBDIR,SAVEPUNC,,,NAME_TMP),
	(']',TPA$_EXIT,SAVEPUNC,,,NAME_TMP),
	('>',TPA$_EXIT,SAVEPUNC,,,NAME_TMP),
	(TPA$_LAMBDA,TPA$_FAIL,,DCL_DIRECT,PARSE_ERROR)
	);
END

END
ELUDOM