Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE LIB$RECOG_HANDLE (
		IDENT = 'V00A03'
		 ) =
BEGIN

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	HELP
!
! ABSTRACT:
!
!	This module contains the routines used by the recognition
!	package to handle various types of fields.
!
! ENVIRONMENT:
!
! AUTHOR: Stanley Rabinowitz,	CREATION DATE:	26-Dec-1981
!
! MODIFIED BY: Stanley Rabinowitz
!
! Edit History:
!
! V00A03	 6-Jul-1983	Stan	Allow any radix (2-10,16) for numbers
! V00A02	10-Oct-1982	Stan	Allow delimiters with text
! V00A01	 9-Oct-1982	Stan	Pulled out of HLPINIT.
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE

	LIB$$HANDLE_KEYWORD,
	LIB$$HANDLE_NUMBER,
	LIB$$HANDLE_GUIDEWORD,
	LIB$$HANDLE_TOKEN,
	LIB$$HANDLE_TEXT,
	LIB$$HANDLE_STRING,
	LIB$$HANDLE_QUOTED_STRING,
	LIB$$HANDLE_PARAM,
	LIB$$HANDLE_FILENAME,
	LIB$$HANDLE_NAME,
	LIB$$HANDLE_CHARACTER;

!
! INCLUDE FILES:
!

REQUIRE 'HLP.R32';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE

	LIB$OUT_RECOG,
	LIB$$HLP$CATCHER,
	LIB$$HLP$CHAR,
	LIB$$HLP$BACKUP,
	LIB$$HLP$UCHAR,
	LIB$$NUMBER_RECOG,
	LIB$$TOKEN_RECOG,
	LIB$$END_HELP,
	LIB$$NO_RECOG,
	LIB$$GENERAL_HELP,
	LIB$$FILENAME_RECOG,
	LIB$$KEYWORD_HELP,
	LIB$$KEYWORD_RECOG;

GLOBAL ROUTINE LIB$$HANDLE_GUIDEWORD(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handle parsing of a guideword.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	PAREN_COUNT,
	STATUS;

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	GDW	= .PAB[PAB$A_GDW]	: BLOCK[,BYTE],
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_GDWMISPAR;

LOCAL

	GDW_VECTOR	: VECTOR[64,BYTE],	! this will change when DESC types can occur in a kw table
	GDW_KEYTAB	: VECTOR[3];

BIND

	GDW_CS	= GDW_VECTOR	: $COUNTED_STRING;

OWN

	OPAREN_PAB	: $PAB(CAB=0,TYP=TOKEN,ARG=%ASCID '('),
	CPAREN_PAB	: $PAB(CAB=0,TYP=TOKEN,ARG=%ASCID ')'),
	GDW_PAB		: $PAB(CAB=0,TYP=KEYWORD);

ENABLE

	LIB$$HLP$CATCHER;

!+
!	Create a standard keyword table containing
!	exactly one keyword - the guideword.
!	*** This code will change once we implement the
!	extened keyword table structure that permits
!	us to put the descriptor for the keyword
!	directly in the structure instead of
!	having to create a counted string.
!-

GDW_KEYTAB[0]=2*1;
GDW_KEYTAB[1]=GDW_CS;

GDW_CS[CS$B_LENGTH]=.GDW[DSC$W_LENGTH];
CH$MOVE(.GDW_CS[CS$B_LENGTH],.GDW[DSC$A_POINTER],GDW_CS[CS$T_STRING]);

OPAREN_PAB[PAB$A_CAB]=CAB;
CPAREN_PAB[PAB$A_CAB]=CAB;

GDW_PAB[PAB$A_CAB]=CAB;
GDW_PAB[PAB$L_ARG]=GDW_KEYTAB;
GDW_PAB[PAB$A_HLP]=%ASCID 'guideword';

!+
!	See if there is an "(" here.
!-

! **** BUG: we don't want a new recognize to recognize the "("
! only a continuation of a previous recognize.

CHAR = $CHAR(0,LIB$$TOKEN_RECOG,OPAREN_PAB);
IF .CHAR NEQ %C'('
  THEN	BEGIN
	$BACKUP;
	RETURN SS$_NORMAL
	END;

!+
! 	Advance the pointer to the beginning of the field.
!-

INI=.INI+1;

$CONTINUE_RECOG;

!+
!	Scan off the guideword.
!	*** eventually we must do something to normalize spaces.
!	We have to match parentheses in the rare case
!	that the guideword contains parentheses itself.
!-

PAREN_COUNT=0;
WHILE 1 DO
	BEGIN
	CHAR = $CHAR(LIB$$KEYWORD_HELP,LIB$$KEYWORD_RECOG,GDW_PAB);
	SELECTONE .CHAR OF
		SET
		[0]:	EXITLOOP;
		['(']:	PAREN_COUNT=.PAREN_COUNT+1;
		[')']:	IF .PAREN_COUNT EQL 0
			  THEN	EXITLOOP
			  ELSE	PAREN_COUNT=.PAREN_COUNT-1
		TES;
	END;

$BACKUP;

$CONTINUE_RECOG;

!+
!	Now check for the ")" that must be at the end
!	of the guideword.
!-

INI = .PTR;
CHAR = $CHAR(0,LIB$$TOKEN_RECOG,CPAREN_PAB);
IF .CHAR NEQ %C')'
  THEN	RETURN HLP$_GDWMISPAR;

INI=.PTR;

$CONTINUE_RECOG;

$SPACES;

INI = .PTR;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_KEYWORD(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!		Type field in PAB says whether this is really
!		a keyword field or a qualifier field.
!
!
! IMPLICIT OUTPUTS:
!
!	PAB[PAB$L_VAL]	gets set to the value associated with the
!			keyword that matched (0 if no macth).
!
!	PAB[PAB$A_VBF]	gets set to the full keyword name.
!
!	PAB[PAB$W_VLN]	gets set to length of full keyword name.
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	STATUS;

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	KEY_TAB	= .PAB[PAB$L_ARG]	: VECTOR,
	TYP	=  PAB[PAB$B_TYP]	: BYTE,
	ATM	= .CAB[CAB$A_ATM]	: BLOCK[,BYTE],
	ALN	=  CAB[CAB$W_ALN]	: WORD,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	VBF	= .PAB[PAB$A_VBF]	: BLOCK[,BYTE],
	VLN	=  PAB[PAB$W_VLN]	: WORD,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

LOCAL

	QUALIFIER_FLAG,		! 1 if field is a qualifier field, 0 otherwise
				! Must be 1 or 0
	D			: VECTOR[2];

OWN

	UC_DESC	: BLOCK[8,BYTE]	PRESET(
			[DSC$W_LENGTH]	= 0,
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$B_CLASS]	= DSC$K_CLASS_D,
			[DSC$A_POINTER]	= 0);

EXTERNAL ROUTINE

	STR$UPCASE,
	LIB$LOOKUP_KEYWORD,
	LIB$SCOPY_R_DX;

EXTERNAL LITERAL

	LIB$_AMBKEY,
	LIB$_UNRKEY,
	HLP$_NOKEYW,	! No keyword in qualifier
	HLP$_NOSLASH,	! Missing qualifier
	HLP$_MISKEY,	! Missing keyword
	HLP$_AMBQUAL,	! Ambiguous qualifier
	HLP$_UNRQUAL,	! Unrecognized qualifier
	HLP$_AMBKEY,	! Ambiguous keyword
	HLP$_UNRKEY;	! Unrecognized keyword

VLN=0;
VAL=0;

!+
! If this is a qualifier field, then it must begin with a "/".
!-

QUALIFIER_FLAG=.TYP EQL HLP$K_QUALIFIER;

IF .QUALIFIER_FLAG
  THEN	BEGIN
	CHAR=$UCHAR(LIB$$KEYWORD_HELP,LIB$$KEYWORD_RECOG);
	IF .CHAR NEQ '/'
	  THEN	RETURN HLP$_NOSLASH;
	END;

!+
! Parse a keyword consisting of letters and "_" only.
! We also allow digits unless PAB$V_NOD is set.
!-

WHILE 1 DO
	BEGIN
	CHAR=$UCHAR(LIB$$KEYWORD_HELP,LIB$$KEYWORD_RECOG);
	IF .CHAR EQL '_' OR (.CHAR GEQU 'A' AND .CHAR LEQU 'Z')
	OR (NOT .PAB[PAB$V_NOD] AND .CHAR GEQU '0' AND .CHAR LEQU '9')
	  THEN	1
	  ELSE	EXITLOOP
	END;
$BACKUP;

!+
!	Special case: if there is no keyword on the line at all,
!	then we return the missing keyword error rather than
!	an ambiguous keyword error.
!-

IF .INI+.QUALIFIER_FLAG EQL .PTR
  THEN	RETURN (IF .QUALIFIER_FLAG
		  THEN	HLP$_NOKEYW
		  ELSE	HLP$_MISKEY);

!+
!	The UPcase of the keyword is matched against the keyword table.
!	This will change when we fix LIB$LOOKUP_KEYWORD.
!-

D[0]=.PTR-.INI-.QUALIFIER_FLAG;
D[1]=BUF[.INI+.QUALIFIER_FLAG];
STATUS=STR$UPCASE(UC_DESC,D);
IF NOT .STATUS THEN RETURN .STATUS;
STATUS=LIB$LOOKUP_KEYWORD(UC_DESC,KEY_TAB,VAL,VBF,VLN);
SELECTONE .STATUS OF
	SET

	[LIB$_AMBKEY]:	RETURN (IF .QUALIFIER_FLAG
				  THEN	HLP$_AMBQUAL
				  ELSE	HLP$_AMBKEY);

	[LIB$_UNRKEY]:	RETURN (IF .QUALIFIER_FLAG
				  THEN	HLP$_UNRQUAL
				  ELSE	HLP$_UNRKEY);

	[OTHERWISE]:	IF NOT .STATUS THEN RETURN .STATUS;

	TES;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_NUMBER(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of a number.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!	ARG		Radix to be used
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	MAX_DIG,
	RAD,
	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	RADIX	=  PAB[PAB$L_ARG]	: LONG,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_MISNUM;

!+
! Parse a decimal number. (or a number to base 2-10, or 16).
!-

VAL=0;

IF .RADIX NEQ 16
  THEN	RAD=MIN(.RADIX,10);

!+
! Treat 0 or 1 as base 10.
!-

IF .RADIX LSS 2
  THEN	RAD=10;

MAX_DIG=%C'0'+.RAD-1;

IF .RADIX EQL 16
  THEN	WHILE 1 DO
		BEGIN
		CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NUMBER_RECOG);
		IF (.CHAR GEQU %C'0' AND .CHAR LEQU %C'9')
		OR (.CHAR GEQU %C'A' AND .CHAR LEQU %C'F')
		OR (.CHAR GEQU %C'a' AND .CHAR LEQU %C'f')
		  THEN	BEGIN
			IF .CHAR LEQU %C'9'
			  THEN	VAL=.CHAR-%C'0'+16*.VAL
			  ELSE	VAL=(.CHAR OR %X'60')-%C'a'+10+16*.VAL
			END
		  ELSE	EXITLOOP;
		END
  ELSE	WHILE 1 DO
		BEGIN
		CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NUMBER_RECOG);
		IF .CHAR LSSU %C'0' OR .CHAR GTRU .MAX_DIG
		  THEN	EXITLOOP;
		VAL=.CHAR-%C'0'+.RAD*.VAL
		END;
$BACKUP;

!+
!	Give an error if the number was missing.
!-

IF .CAB[CAB$W_FLD_PTR] EQL .CAB[CAB$W_PTR]
  THEN	RETURN HLP$_MISNUM;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_TOKEN(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of a token (fixed string).
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!		CAB[CAB$L_ARG]	contains a descriptor for the token
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	TOKDSC	= .PAB[PAB$L_ARG]	: BLOCK[8,BYTE],
	TOKLEN	=  TOKDSC[DSC$W_LENGTH]	: WORD,
	TOKEN	= .TOKDSC[DSC$A_POINTER]: VECTOR[,BYTE],
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_PARTOKEN,
	HLP$_MISTOKEN;

PAB[PAB$A_SOS]=%ASCID 'token';

!+
! The following characters must match those in the token
! one for one.
!-

INCR I FROM 0 TO .TOKLEN-1
	DO
	BEGIN
	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$TOKEN_RECOG);
	IF .CHAR NEQ .TOKEN[.I]
	  THEN	BEGIN
		IF .I EQL 0
		  THEN	RETURN HLP$_MISTOKEN
		  ELSE	RETURN HLP$_PARTOKEN
		END
	END;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_TEXT(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of arbitrary text.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!	PAB[PAB$L_ARG]	Address of descriptor for delimiters.
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	ARG	= .PAB[PAB$L_ARG]	: BLOCK[,BYTE],
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

PAB[PAB$A_SOS]=%ASCID 'text';

!+
! Just parse characters until the end of the line or until a user-
! specified delimiter is encountered.
!-

IF ARG EQL 0
  THEN	DO	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG)
	UNTIL	.CHAR EQL 0
  ELSE	BEGIN
	BIND	N =  ARG[DSC$W_LENGTH]	: WORD,
		P = .ARG[DSC$A_POINTER];
	DO	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG)
	UNTIL	.CHAR EQL 0 OR NOT CH$FAIL(CH$FIND_CH(.N,P,.CHAR));
	IF .CHAR NEQ 0
	  THEN	$BACKUP
	END;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_PARAM(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of arbitrary text up to the next
!	space, tab, comma, slash, plus, close paren, or !.
!	At least one character must match.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_NOPARM;

PAB[PAB$A_SOS]=%ASCID 'parameter';

!+
! Just parse characters until one of the delimiters is found.
!-

DO	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG)
UNTIL	.CHAR EQL 0
   OR	.CHAR EQL ' '
   OR	.CHAR EQL ','
   OR	.CHAR EQL '+'
   OR	.CHAR EQL '/'
   OR	.CHAR EQL 9
   OR	.CHAR EQL ')'
   OR	.CHAR EQL '!';

$BACKUP;

IF .PTR EQL .INI
  THEN	RETURN	HLP$_NOPARM;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_QUOTED_STRING(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of a quoted string.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!	PAB[PAB$L_ARG]	The quote character. " if 0.
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	QUOTE_CHAR			: BYTE,
	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	ARG	=  PAB[PAB$L_ARG]	: LONG,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_NOBQUOTE,		! Quoted string does not start with quote character
	HLP$_NOEQUOTE;		! No matching close quote

PAB[PAB$A_SOS]=%ASCID 'quoted string';

!+
! The quote character to be used is specified at offset L_ARG.
! If that is 0, then double-quote is to be the quote character.
!-

IF .ARG EQL 0
  THEN	QUOTE_CHAR=%C'"'
  ELSE	QUOTE_CHAR=.ARG;

!+
! The quote character must be the first character typed.
!-

CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG);
IF .CHAR NEQ .QUOTE_CHAR
  THEN	RETURN HLP$_NOBQUOTE;

!+
! Now parse characters up to the matching quote.
!-

DO	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG)
UNTIL	.CHAR EQL 0 OR .CHAR EQL .QUOTE_CHAR;

!+
! It is an error if no terminating quote was found.
!-

IF .CHAR NEQ .QUOTE_CHAR
  THEN	RETURN HLP$_NOEQUOTE;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_STRING(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of a string or quoted string.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!	PAB[PAB$L_ARG]	quote character
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	QUOTE_CHAR			: BYTE,
	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	ARG	=  PAB[PAB$L_ARG]	: LONG,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_NOEQUOTE;		! No matching close quote

PAB[PAB$A_SOS]=%ASCID 'string or quoted string';

!+
! The quote character to be used in specified at offset L_ARG.
! If that is 0, then double-quote is to be the quote character.
!-

IF .ARG EQL 0
  THEN	QUOTE_CHAR=%C'"'
  ELSE	QUOTE_CHAR=.ARG;

!+
! The quote character must be the first character typed.
!-

PAB[PAB$A_SOS]=%ASCID 'string or quoted string';
CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG);
!*** NEEDS WORK
!IF .CHAR NEQ .QUOTE_CHAR
!  THEN	RETURN HLP$_NOBQUOTE;

!+
! Now parse characters up to the matching quote.
!-

DO	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG)
UNTIL	.CHAR EQL 0 OR .CHAR EQL .QUOTE_CHAR;

!+
! It is an error if no matching end quote is found.
!-

IF .CHAR NEQ .QUOTE_CHAR
  THEN	RETURN	HLP$_NOEQUOTE;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_NAME(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of an arbitrary name
!	consisting only of letters (upper or lower case),
!	digits, and "_".
!	At least one character must match.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_NOPARM;

PAB[PAB$A_SOS]=%ASCID 'name';

!+
! Just parse characters until we don't find a legal alphanumeric.
!-

DO	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG)
WHILE	(.CHAR GEQU 'A' AND .CHAR LEQU 'Z')
   OR	(.CHAR GEQU 'a' AND .CHAR LEQU 'z')
   OR	.CHAR EQL '_';

$BACKUP;

IF .PTR EQL .INI
  THEN	RETURN	HLP$_NOPARM;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_CHARACTER(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing of a single character.
!	May not match end-of-statement.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

EXTERNAL LITERAL

	HLP$_NOPARM;

PAB[PAB$A_SOS]=%ASCID 'text';

!+
! Just parse characters until one of the delimiters is found.
!-

CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$NO_RECOG);

IF .CHAR EQL 0
  THEN	RETURN HLP$_NOPARM;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$HANDLE_FILENAME(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles parsing a filename.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!	PAB
!
! IMPLICIT OUTPUTS:
!
!	PAB[PAB$A_VBF]	gets set to the expanded name.
!
!	PAB[PAB$W_VLN]	gets set to length of the expanded name.
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	DIR_FLAG,	! 1 if we are inside a directory spec
	QUOTE_COUNT,
	STATUS;

BIND	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	CLN	=  CAB[CAB$W_CLN]	: WORD,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	CHAR	=  CAB[CAB$B_TRM]	: BYTE,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	VAL	=  PAB[PAB$L_VAL]	: LONG,
	ARG	= .PAB[PAB$L_ARG]	: VECTOR,
	VBF	= .PAB[PAB$A_VBF]	: BLOCK[,BYTE],
	VLN	=  PAB[PAB$W_VLN]	: WORD,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE];

OWN

	ENAME	: VECTOR[NAM$C_MAXRSS,BYTE],	! Buffer to hold expanded filename
	RNAME	: VECTOR[NAM$C_MAXRSS,BYTE],	! Buffer to hold resultant filename
	PNAM	: $NAM(	ESA=ENAME,		! Name block used to get expanded filename
			ESS=NAM$C_MAXRSS,
			RSA=RNAME,
			RSS=NAM$C_MAXRSS),
	PFAB	: $FAB(	NAM=PNAM);		! File access block for PARSE

EXTERNAL ROUTINE

	STR$COPY_R;

EXTERNAL LITERAL

	HLP$_NOFILE,		! No filespec found
	HLP$_WILD,		! Illegal wildcard
	HLP$_ACS,		! Error in access control string
	HLP$_DEV,		! Error in device name
	HLP$_DIR,		! Error in directory
	HLP$_FNM,		! Error in filename
	HLP$_NOD,		! Error in node name
	HLP$_QUO,		! Error in quoted string
	HLP$_TYP,		! Error in filetype
	HLP$_VER,		! Error in version number
	HLP$_BADFILSPEC;	! Bad file specification

PAB[PAB$A_SOS]=%ASCID 'filespec';

VLN=0;

DIR_FLAG=FALSE;

!+
! Set default file specification string.
!-

IF ARG EQL 0 OR .ARG[0] EQL 0
  THEN	PFAB[FAB$B_DNS]=0
  ELSE	BEGIN
	BIND	FDEF=.ARG[0]	: BLOCK[,BYTE];
	PFAB[FAB$B_DNS]=.FDEF[DSC$W_LENGTH];
	PFAB[FAB$L_DNA]=.FDEF[DSC$A_POINTER]
	END;

QUOTE_COUNT=0;

WHILE 1 DO
	BEGIN
	CHAR=$CHAR(LIB$$GENERAL_HELP,LIB$$FILENAME_RECOG);
	SELECTONE .CHAR OF

	    SET

	    [0]:

		EXITLOOP;

	    [%C'"']:

		BEGIN
		QUOTE_COUNT=.QUOTE_COUNT+1;
		IF .QUOTE_COUNT
		  THEN	PAB[PAB$A_SOS]=%ASCID 'quoted string'
		  ELSE	PAB[PAB$A_SOS]=%ASCID 'filespec'
		END;

	    [32,9,%C'/',%C'+',%C'!',%C')']:

		IF NOT .QUOTE_COUNT THEN EXITLOOP;

	    [%C',']:

		!+
		! Comma is allowed within a directory spec
		! as in DBA0:[1,4]FOO.BAR.
		!-

		IF NOT .QUOTE_COUNT AND NOT .DIR_FLAG
		  THEN	EXITLOOP;

	    [%C'[',%C'<']:

		!+
		! Watch out for [ and < in quoted strings
		!-

		IF NOT .QUOTE_COUNT
		  THEN	BEGIN
			DIR_FLAG=TRUE;
			PAB[PAB$A_SOS]=%ASCID 'directory part of filespec';
			END;

	    [%C']',%C'>']:

		IF NOT .QUOTE_COUNT
		  THEN	BEGIN
			DIR_FLAG=FALSE;
			PAB[PAB$A_SOS]=%ASCID 'filespec';
			END;

	    TES;

	END;

$BACKUP;

!+
!	If there is nothing there, then we return with a FALSE value
!	to say that we couldn't find a filespec.
!-

IF .PTR EQL .INI
  THEN	RETURN HLP$_NOFILE;

PFAB[FAB$L_FNA] = BUF[.INI];

PFAB[FAB$B_FNS] = .PTR - .INI;

STATUS=$PARSE(FAB=PFAB);
IF NOT .STATUS
  THEN	BEGIN
	PAB[PAB$L_STS]=.PFAB[FAB$L_STS];
	PAB[PAB$L_STV]=.PFAB[FAB$L_STV];
	RETURN SELECTONE .STATUS OF
		SET
		[RMS$_ACS]:	HLP$_ACS;
		[RMS$_DEV]:	HLP$_DEV;
		[RMS$_DIR]:	HLP$_DIR;
		[RMS$_FNM]:	HLP$_FNM;
		[RMS$_NOD]:	HLP$_NOD;
		[RMS$_QUO]:	HLP$_QUO;
		[RMS$_TYP]:	HLP$_TYP;
		[RMS$_VER]:	HLP$_VER;
		[OTHERWISE]:	HLP$_BADFILSPEC
		TES
	END;

!+
! Generate an error message if an invalid wildcard is specified.
!-

IF .PAB[PAB$V_NOWLD] AND (.PNAM[NAM$V_WILDCARD] OR .PNAM[NAM$V_WILD_DIR])
  THEN	RETURN	HLP$_WILD;

!+
! Set VBF with expanded name.
!-

IF VBF NEQ 0
  THEN	BEGIN
	VLN=.PNAM[NAM$B_ESL];
	STATUS=STR$COPY_R(VBF,VLN,ENAME);
	IF NOT .STATUS THEN RETURN .STATUS
	END;

RETURN .STATUS

END;

END
ELUDOM