Google
 

Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/recog3/hlpinit.b32
There are 2 other files named hlpinit.b32 in the archive. Click here to see a list.
MODULE LIB$RECOG_INIT (
		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 main routines in the
!	HELP/RECOGNITION facility that are user callable.
!
! ENVIRONMENT:
!
! AUTHOR: Stanley Rabinowitz,	CREATION DATE:	26-Dec-1981
!
! MODIFIED BY: Stanley Rabinowitz
!
! Edit History:
!
! V00A03	 9-Oct-1982	Stan	Allow reprompting on a null line.
!					Put error part of field in atom buffer
!					and reset the pointer.
! V00A02	 3-Oct-1982	Stan	Error status in CAB$L_STS
!					Allocate command line buffer if
!					none specified by user.
! V00A01	24-Sep-1982	Stan	Allow input from non-terminal.
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE

	LIB$PARSE_LINE,		! Parse a line
	LIB$PARSE_FIELD,	! Parse a field
	GET_LINE,		! Get a line of input
	GET_CHARACTERISTICS,	! Get characteristics of SYS$INPUT
	LIB$$HLP$CATCHER,	! Condition handler to catch HLP$_HELP
	PARSE_PAB,		! Parses from just one PAB
	HLP$REPARSE_HANDLER,	! Condition handler to catch HLP$_REPARSE
	LIB$$HLP$CHAR,
	LIB$$HLP$UCHAR,
	LIB$$HLP$BACKUP		: NOVALUE;

!
! INCLUDE FILES:
!

REQUIRE 'HLP.R32';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE

	LIB$OUT_RECOG,
	LIB$$NUMBER_RECOG,
	LIB$$TOKEN_RECOG,
	LIB$$END_HELP,
	LIB$$NO_RECOG,
	LIB$$GENERAL_HELP,
	LIB$$FILENAME_RECOG,
	LIB$$KEYWORD_HELP,
	LIB$$KEYWORD_RECOG,
	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;
GLOBAL ROUTINE LIB$PARSE_LINE(P_CAB,P_RTN,RTN_PARAM) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Initializes the system so that it is ready to
!	begin parsing a command line.
!	Perform an initial read.
!
! FORMAL PARAMETERS:
!
!	P_CAB		Address of associated CAB.
!
!	P_RTN		Address of user's parsing routine.
!
!	RTN_PARAM	Longword parameter to be passed to user's
!			parsing routine.
!
! IMPLICIT INPUTS:
!
!	The following fields in the CAB must be previously set up
!	by the user.  (This can be done with the $CAB macro.)
!
!	CAB$W_BLN	set by $CAB
!	CAB$B_BID	set by $CAB
!	CAB$V_RAI	set by user
!	CAB$V_WAK	set by user
!	CAB$V_REP	set by user
!	CAB$V_COM	set by user
!	CAB$V_CON	set by user
!	CAB$W_CHN	set by user
!	CAB$A_GET	set by user
!	CAB$A_PMT	set by user
!	CAB$A_CMD	set by user
!	CAB$A_ATM	set by user
!
! IMPLICIT OUTPUTS:
!
!	CAB$A_PAB	cleared
!	CAB$W_RES	cleared
!	CAB$W_CLN	cleared
!	CAB$W_PTR
!	CAB$W_FLD_PTR	cleared
!	CAB$W_PMT_PTR	cleared
!	CAB$W_STS	cleared
!	CAB$W_STV	cleared
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	everything is okay
!
!	HLP$_CAB	CAB is invalid (BID field incorrect)
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	TERMIN,		! Fix
	STATUS;

BIND

	CAB	= .P_CAB		: $CAB_DECL;

BIND ROUTINE

	RTN	= .P_RTN;

EXTERNAL LITERAL

	HLP$_REPARSE,
	HLP$_CAB_BID,
	HLP$_CAB_BLN;

ENABLE	HLP$REPARSE_HANDLER;
!+
!	Check that this is really a CAB.
!	If not, or if it is too small, return
!	the error status HLP$_CAB and do not try to write in the CAB.
!-

IF .CAB[CAB$B_BID] NEQ  CAB$K_BID
  THEN	RETURN	HLP$_CAB_BID;

IF .CAB[CAB$W_BLN] LSSU	CAB$K_BLN
  THEN	RETURN	HLP$_CAB_BLN;

!+
!	Initialize various CAB fields to 0.
!-

CAB[CAB$A_PAB]=0;	! No initial PAB yet
CAB[CAB$W_CLN]=0;	! No command line seen yet
CAB[CAB$L_STS]=0;	! No error status yet
!CAB[CAB$L_STV]=0;	! No error status value

!+
!	If no command line buffer was specified by the user,
!	then allocate a dynamic buffer for him.
!-

IF .CAB[CAB$A_CMD] EQL 0
  THEN	BEGIN
	EXTERNAL ROUTINE

		LIB$GET_VM,
		LIB$SGET1_DD;

	!+
	! Get 8 bytes of memory for a dynamic string descriptor.
	!-

	STATUS=LIB$GET_VM(%REF(8),CAB[CAB$A_CMD]);
	IF NOT .STATUS THEN SIGNAL(.STATUS);

	!+
	! Zero this descriptor.
	!-

	CH$FILL(0,8,.CAB[CAB$A_CMD]);

	!+
	! Allocate a dynamic string descriptor for 256 bytes.
	!-

	STATUS=LIB$SGET1_DD(%REF(256),.CAB[CAB$A_CMD]);
	IF NOT .STATUS THEN SIGNAL(.STATUS);

	!+
	! Note that the virtual memory does not get deallocated
	! because it can be used again if the user makes a subsequent
	! call to these routines with the same CAB.
	!-

	END;

	BEGIN
	BIND	CMD = .CAB[CAB$A_CMD]	: BLOCK[,BYTE];
	CAB[CAB$W_CSZ]=.CMD[DSC$W_LENGTH];
	CAB[CAB$A_CBF]=.CMD[DSC$A_POINTER]
	END;

!+
!	If no channel has been supplied, then we will
!	assign a channel to SYS$INPUT.
!	This code relies on the fact that 0 is an illegal
!	channel number.
!-

IF .CAB[CAB$W_CHN] EQL 0
  THEN	BEGIN

	STATUS=$ASSIGN(	DEVNAM	= %ASCID 'SYS$INPUT',
			CHAN	= CAB[CAB$W_CHN]);
	IF NOT .STATUS
	  THEN	BEGIN
		CAB[CAB$L_STS] = .STATUS;
		RETURN .STATUS
		END;

	! How does this channel get deassigned?

	!+
	! Now clear out the DEVCLASS byte.
	! We rely on the fact that there is no
	! device class of 0 and thereby use the CAB$B_DEVCLASS
	! field to indicate that we have not yet ascertained
	! the input device's class, type, and characteristics.
	! Should the user want to reuse this CAB and shove in a
	! new channel number, he will also have to 0 out this field.
	! (We need to provide a macro to do that.)
	!-

	CAB[CAB$B_DEVCLASS]=0

	END;

!+
!	If we have not previously ascertained the characteristics
!	of the input device, do so now.
!	The field CAB$B_DEVCLASS is non-0 if we had previously
!	ascertained the device class, type, and characteristics.
!-

IF .CAB[CAB$B_DEVCLASS] EQL 0
  THEN	BEGIN
	STATUS=GET_CHARACTERISTICS(CAB);
	IF NOT .STATUS THEN RETURN .STATUS
	END;

!+
!	Now start by doing an initial read from the input device.
!-

!+
!	Invoke the user's parsing routine
!	with 3 arguments:
!
!	1.	The address of the CAB.
!		This is useful to him in case he is
!		using the same parse routine to handle
!		multiple CABs.
!
!	2.	His specified parameter.  This could
!		point to his full argument list, if desired.
!
!	3.	A flag specifying whether this is a parse or a reparse.
!		0 (FALSE)	means parse
!		1 (TRUE)	means reparse
!-

STATUS	= SS$_NORMAL;
CAB[CAB$V_HLP] = TRUE;	! KLUDGE so that we prompt first time through

!CAB[CAB$W_ERR_PTR]=0;
CAB[CAB$W_PTR]=0;	! Start at beginning of line
			! This changes to implement CTRL/H.

DO	BEGIN
	LOCAL	TEMP;
	TEMP=.CAB[CAB$V_HLP];
	CAB[CAB$W_RES]=0;	! Reset result flags (except for CAB$V_HLP)
	CAB[CAB$V_HLP]=.TEMP;
	CAB[CAB$W_FLD_PTR]=0;	! First field starts at begin of command line
	CAB[CAB$W_PMT_PTR]=0;	! First prompt field starts at begin of command line
	IF .CAB[CAB$V_GOT]
	  THEN	BEGIN
		BIND BUF = .CAB[CAB$A_CMD] : BLOCK[,BYTE];
		CH$FILL(0,8,CAB[CAB$Q_IOSB]);
		CAB[CAB$W_QIO_STS]=1;
		CAB[CAB$B_QIO_TRM]=13;
		CAB[CAB$W_CLN]=.BUF[DSC$W_LENGTH];
		IF NOT .STATUS
		  THEN	BEGIN
			CAB[CAB$L_STS] = .STATUS;
			RETURN .STATUS
			END;
		END
	  ELSE	BEGIN
		STATUS=GET_LINE(CAB);
		IF NOT .STATUS THEN RETURN .STATUS
		END;

	CAB[CAB$W_PTR] = 0;	! No characters parsed yet
	CAB[CAB$V_HLP] = .CAB[CAB$B_QIO_TRM] EQL HLP$K_HELP;
	CAB[CAB$V_TAB] = .CAB[CAB$B_QIO_TRM] EQL HLP$K_RECOGNIZE;

	!+
	!	Allow optional spaces at the beginning of the command
	!	unless prohibited by the programmer.
	!-

	IF NOT .CAB[CAB$V_NOS]
	  THEN	$OPT_SPACES;

	!+
	! If CAB$V_NUL is set and the input line is null,
	! then we go do a reparse, i.e. we get another line of input.
	! We studiously avoid doing this if CAB$V_GOT is set,
	! because that would put us in an infinite loop.
	! If the above situation is not true, then we call
	! the user's parsing routine to parse the line that
	! has been obtained.
	! Note that the third argument to the user's parsing routine
	! is now WRONG; but this is okay since we want to get
	! rid of this argument.
	!-

	IF NOT .CAB[CAB$V_GOT] AND
	  .CAB[CAB$W_PTR] EQL .CAB[CAB$W_CLN] AND
	  NOT .CAB[CAB$V_HLP] AND
	  NOT .CAB[CAB$V_TAB]
	  THEN	BEGIN
		STATUS=HLP$_REPARSE;
		CAB[CAB$V_HLP] = TRUE;	! KLUDGE so that we prompt again
		CAB[CAB$W_PTR]=0	! Start at beginning of line
		END
	  ELSE	STATUS=RTN(CAB,.RTN_PARAM,.STATUS EQL HLP$_REPARSE)
	END
UNTIL	.STATUS NEQ HLP$_REPARSE;

IF NOT .STATUS
  THEN	BEGIN
	CAB[CAB$L_STS] = .STATUS;
	RETURN .STATUS
	END;

!+
!	Everything went all right, so return SS$_NORMAL as success status.
!-

CAB[CAB$L_STS] = SS$_NORMAL;
RETURN SS$_NORMAL

END;
ROUTINE GET_CHARACTERISTICS(P_CAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Gets characteristcis of SYS$INPUT and puts them in the CAB.
!
! FORMAL PARAMETERS:
!
!	P_CAB		Address of CAB
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	CAB fields get filled in:
!
!	CAB$B_DEVCLASS		device class
!	CAB$L_DEVCHAR		device characteristics
!	CAB$B_DEVTYPE		device type
!	CAB$W_DEVBUFSIZ		device buffer size (terminal width)
!	CAB$L_DEVDEPEND		device dependent information
!	CAB$L_DEVDEPND2		extended device characteristics.
!
! ROUTINE VALUE:
!
!	status value
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	STATUS;

BIND

	CAB	= .P_CAB		: $CAB_DECL;

OWN

	DEVDEPEND2	: BITVECTOR[32],
	DVI_LIST	: VECTOR[1*3+1]
		INITIAL(WORD(4),WORD(DVI$_DEVDEPEND2),
			LONG(DEVDEPEND2),
			LONG(0),
			LONG(0));

LOCAL

	CBUF	: BLOCK[DIB$K_LENGTH,BYTE],	! Device characteristics buffer
	CDESC	: VECTOR[2];			! Descriptor for that buffer
!+
! Set up the descriptor for the device characteristics buffer
! on the stack.
!-

CDESC[0]=DIB$K_LENGTH;
CDESC[1]=CBUF;

!+
! Issue the $GETCHN system service to ascertain the desired
! information.
!-

STATUS=$GETCHN(	CHAN	= .CAB[CAB$W_CHN],
		PRIBUF	=  CDESC);
IF NOT .STATUS
  THEN	BEGIN
	CAB[CAB$L_STS] = .STATUS;
	RETURN .STATUS
	END;

STATUS=$GETDVI(	CHAN	= .CAB[CAB$W_CHN],
		ITMLST	=  DVI_LIST);
IF NOT .STATUS THEN SIGNAL(.STATUS);

!+
! Move that information into the CAB.
! The fields set up are:
!
!	CAB$B_DEVCLASS		device class
!	CAB$L_DEVCHAR		device characteristics
!	CAB$B_DEVTYPE		device type
!	CAB$W_DEVBUFSIZ		device buffer size (terminal width)
!	CAB$L_DEVDEPEND		device dependent information
!	CAB$L_DEVDEPND2		extended device characteristics.
!-

CAB[CAB$B_DEVCLASS]	= .CBUF[DIB$B_DEVCLASS];
CAB[CAB$L_DEVCHAR]	= .CBUF[DIB$L_DEVCHAR];
CAB[CAB$B_DEVTYPE]	= .CBUF[DIB$B_DEVTYPE];
CAB[CAB$W_DEVBUFSIZ]	= .CBUF[DIB$W_DEVBUFSIZ];
CAB[CAB$L_DEVDEPEND]	= .CBUF[DIB$L_DEVDEPEND];
CAB[CAB$L_DEVDEPND2]	= .DEVDEPEND2;

!+
! If the user has not specified a WIDTH, then
! we default in the WIDTH field from the terminal's width
! (device buffer size).
!-

IF .CAB[CAB$W_WIDTH] EQL 0
  THEN	CAB[CAB$W_WIDTH]=.CAB[CAB$W_DEVBUFSIZ];

RETURN SS$_NORMAL

END;
ROUTINE GET_LINE(P_CAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Gets a line (or part of a line) of input from the terminal,
!	or other input device (physical or logical).
!
! FORMAL PARAMETERS:
!
!	P_CAB		Address of CAB.
!
! IMPLICIT INPUTS:
!
!	items in CAB
!
! IMPLICIT OUTPUTS:
!
!	items in CAB
!
! ROUTINE VALUE:
!
!	status value
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	TIO_STATUS,
	STATUS;

BIND

	CAB	= .P_CAB		: $CAB_DECL;

BIND ROUTINE

	GET = .CAB[CAB$A_GET];

EXTERNAL ROUTINE

	LIB$GET_INPUT	: ADDRESSING_MODE(GENERAL);

EXTERNAL LITERAL

	RMS$_EOF;
!+
! If the user has supplied a routine to get input,
! then we merely get input from that routine and then return.
!-

IF GET NEQ 0
  THEN	BEGIN
	CH$FILL(0,8,CAB[CAB$Q_IOSB]);
	STATUS=GET(.CAB[CAB$A_CMD],0,CAB[CAB$W_CLN]);
	CAB[CAB$W_QIO_STS]=1;
	CAB[CAB$B_QIO_TRM]=13;
	IF NOT .STATUS
	  THEN	CAB[CAB$L_STS] = .STATUS;
	RETURN .STATUS
	END;

!+
! If no user-supplied input routine is given, then we must get
! input from SYS$INPUT.
!-

!+
! If the input device is not a terminal,
! then we just read in a line using LIB$GET_INPUT and return.
!-

IF .CAB[CAB$B_DEVCLASS] NEQ DC$_TERM
  THEN	BEGIN
	STATUS=LIB$GET_INPUT(.CAB[CAB$A_CMD],
			     .CAB[CAB$A_PMT],
			      CAB[CAB$W_CLN]);
	IF NOT .STATUS
	  THEN	CAB[CAB$L_STS] = .STATUS;
	RETURN .STATUS
	END;

!+
! Otherwise we do our normal stuff.
!-

DO TIO_STATUS = $TIO(CAB=CAB)
UNTIL .TIO_STATUS NEQ SS$_ABORT;
IF .TIO_STATUS EQL SS$_TIMEOUT
OR .TIO_STATUS EQL RMS$_EOF
  THEN	BEGIN
	CAB[CAB$L_STS] = .TIO_STATUS;
	RETURN .TIO_STATUS
	END;

IF NOT .TIO_STATUS THEN SIGNAL(.TIO_STATUS);

RETURN SS$_NORMAL
END;
GLOBAL ROUTINE LIB$PARSE_FIELD(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Parse a field.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB (Parameter Access Block)
!
! IMPLICIT INPUTS:
!
!	The following fields in the PAB must have been set up:
!
!	PAB$W_BLN	set by $PAB
!	PAB$B_BID	set by $PAB
!	PAB$B_TYP	set by user	type of field
!	PAB$A_NXT	set by user
!	PAB$L_ARG	set by user
!	PAB$V_SPO	set by user
!	PAB$V_SDH	set by user
!	PAB$V_NOS	set by user
!	PAB$A_CAB	set by user
!	PAB$A_HLP	set by user
!	PAB$A_DEF	set by user
!	PAB$A_PRM	set by user
!	PAB$A_GDW	set by user
!
!	The following fields in the associated CAB must be set up:
!
!	tbs
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL	field was parsed successfully
!
!	SS$_REPARSE	The command line must be reparsed
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	SAVE_EOL,
	DEPTH,
	ERR_STATUS,	! First error status found
	STATUS;

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL;

EXTERNAL LITERAL

	HLP$_HELP,
	HLP$_REPARSE,
	HLP$_MISCAB,	! Backpointer to CAB missing from PAB
	HLP$_MISPAB,	! Pointer to PAB missing in CAB.
	HLP$_PAB_BID,	! Invalid PAB (block ID bad)
	HLP$_PAB_BLN,	! Invalid PAB (length too small)
	HLP$_CAB2_BID,	! Invalid CAB in RAB
	HLP$_CAB2_BLN;	! Invalid CAB in RAB

EXTERNAL ROUTINE

	STR$COPY_R,
	STR$UPCASE;
!+
!	Check that the PAB block is valid.
!	If the address of the PAB is 0 or
!	the Block ID is not PAB$K_BID
!	or the length is too short, then return
!	an error, HLP$_PAB.
!-

IF PAB EQL 0
  THEN	RETURN HLP$_MISPAB;
IF .PAB[PAB$B_BID] NEQ  PAB$K_BID
  THEN	RETURN HLP$_PAB_BID;
IF .PAB[PAB$W_BLN] LSSU PAB$K_BLN
  THEN	RETURN HLP$_PAB_BLN;

!+
!	If the backpointer to the CAB is 0
!	or points to an invalid CAB, then
!	return the error HLP$_CAB2.
!-

IF CAB EQL 0
  THEN	RETURN HLP$_MISCAB;
IF .CAB[CAB$B_BID] NEQ  CAB$K_BID
  THEN	RETURN HLP$_CAB2_BID;
IF .CAB[CAB$W_BLN] LSSU CAB$K_BLN
  THEN	RETURN HLP$_CAB2_BLN;

!+
!	Put this PAB address in the CAB.
!-

CAB[CAB$A_PAB]=PAB;
CAB[CAB$L_STS]=SS$_NORMAL;

!+
!	Note that we are at the beginning of a field.
!	Note that no help has occurred yet for this field.
!-

CAB[CAB$W_FLD_PTR]=.CAB[CAB$W_PTR];
CAB[CAB$V_PHL]=FALSE;
CAB[CAB$W_ALN]=0;

!+
!	If a guideword is permitted, we handle it now
!	by building a special PAB.
!-

IF .PAB[PAB$A_GDW] NEQ 0
  THEN	BEGIN
	BIND GDW = .PAB[PAB$A_GDW] : BLOCK[,BYTE];
	IF .GDW[DSC$W_LENGTH] NEQ 0
	  THEN	BEGIN
		STATUS=LIB$$HANDLE_GUIDEWORD(PAB);
		IF .STATUS EQL HLP$_HELP
		  THEN	BEGIN
			$OUT(%ASCID '',HLP$K_END_LINE);
			SIGNAL(HLP$_REPARSE)
			END;
		IF NOT .STATUS
		  THEN	BEGIN
			CAB[CAB$L_STS]=.STATUS;
			RETURN .STATUS
			END
		END
	END;

!+
!	Do not allow recognition to automatically pass through
!	this point.
!-

IF .CAB[CAB$V_PFR]
  THEN	SIGNAL(HLP$_REPARSE);

!+
!	Go see what the field type is,
!	and then perform the appropriate action.
!	If there are multiple PABs linked together,
!	then we invoke them in succession, as necessary.
!	Move the first PAB of the chain into CAB$A_CURPAB
!	and make sure CAB$W_FLD_PTR is set up properly.
!-

CAB[CAB$A_CURPAB]=.CAB[CAB$A_PAB];
CAB[CAB$V_PHL]=FALSE;
ERR_STATUS=0;
DEPTH=0;

SAVE_EOL=.CAB[CAB$V_EOL];

WHILE 1 DO
	BEGIN

	BIND	CURPAB	= .CAB[CAB$A_CURPAB]	: $PAB_DECL;

	CAB[CAB$V_EOL]=.SAVE_EOL;

	STATUS=PARSE_PAB(CURPAB);
	CURPAB[PAB$L_ERR]=.STATUS;

	! THERE is a bug below, if in a set of choices the
	! first one produces help but the second one succeeds
	! perfectly.

	IF .STATUS
	  THEN	BEGIN
		ERR_STATUS=0;
		DEPTH=0;
		EXITLOOP
		END;

	!+
	!	If the status is HELP$_HELP, this means that
	!	help was generated.
	!-

	IF .STATUS EQL HLP$_HELP
	  THEN	BEGIN
		CAB[CAB$V_PHL]=TRUE
		END
	  ELSE	BEGIN

		!+
		!	If an error occurred, store it away in
		!	ERR_STATUS so that it can be returned to the
		!	user as the final error status.
		!	In case there are multiple PABs linked
		!	together, each PAB gets the error status
		!	for that PAB's parse, and the final error
		!	status consists of the error status from the PAB
		!	whose parse proceeded furthest along the command
		!	line.
		!-

		IF NOT .STATUS
		  THEN	BEGIN
			LOCAL	NEW_DEPTH;

			!+
			! If this error got further into the command line
			! than the previous error, then save this one
			! as the most likely candidate for the final
			! error status.
			!-

			NEW_DEPTH=.CAB[CAB$W_PTR]-.CAB[CAB$W_FLD_PTR];
			IF .NEW_DEPTH GTRU .DEPTH
			OR .ERR_STATUS EQL 0
			  THEN	BEGIN
				DEPTH=.NEW_DEPTH;
				ERR_STATUS=.STATUS
				END
			END;

!		IF .ERR_STATUS EQL 0 AND NOT .STATUS
!		  THEN	ERR_STATUS=.STATUS;
		END;

	!+
	! If there is another PAB in the chain, then invoke it.
	! Otherwise, we are done scanning the PABs, so we can exit this loop.
	!-

	IF .CURPAB[PAB$A_NXT] EQL 0
	  THEN	EXITLOOP
	  ELSE	BEGIN
		CAB[CAB$A_CURPAB]=.CURPAB[PAB$A_NXT];

		!+
		! Reset the pointer back to the beginning of this field.
		!-

		CAB[CAB$W_PTR]=.CAB[CAB$W_FLD_PTR];

		END;

	END;

!+
!	If any incremental help had occurred, then we must
!	reparse the line.
!-

IF .CAB[CAB$V_PHL]
  THEN	BEGIN
	!+
	! In case user is trapping this help, tell
	! him that it is through now.
	!-

	$OUT(%ASCID '',HLP$K_END_LINE);

	CAB[CAB$V_PHL]=FALSE;
	SIGNAL(HLP$_REPARSE)
	END;

!+
!	Copy the string matched into the atom buffer
!	(if one has been specified).
!	Copy verbatim with STR$COPY unless the UCA (Upcase
!	Atom Buffer) bit has been set in the CAB, in which
!	case copy using STR$UPCASE.
!	We copy into the atom buffer even if an error
!	occurred.  In that case, the atom buffer contains
!	the partial field matched in case the user
!	wishes to print it in his error message.
!-

IF .CAB[CAB$A_ATM] NEQ 0
  THEN	BEGIN
	BIND	BUF = .CAB[CAB$A_CBF]		: VECTOR[,BYTE],
		INI =  CAB[CAB$W_FLD_PTR]	: WORD,
		PTR =  CAB[CAB$W_PTR]		: WORD;

	CAB[CAB$W_ALN]=.PTR-.INI;
	IF .CAB[CAB$V_UCA]
	  THEN	BEGIN
		LOCAL	D : VECTOR[2];
		D[0]=.PTR-.INI;
		D[1]=BUF[.INI];
		STATUS=STR$UPCASE(.CAB[CAB$A_ATM],D)
		END
	  ELSE	STATUS=STR$COPY_R(	.CAB[CAB$A_ATM],
					%REF(.PTR-.INI),
					BUF[.INI]);
	IF NOT .STATUS AND .ERR_STATUS NEQ 0
	  THEN	ERR_STATUS=.STATUS;

	END;

!+
!	If an error had occurred, then we return the first one
!	to the user.
!	Field CAB$W_ERR_PTR is set to the current pointer
!	position so that a subsequent CTRL/H will work.
!	The pointer is then reset to the beginning of the
!	field in case the user wishes to manually reparse the field.
!-

IF .ERR_STATUS NEQ 0
  THEN	BEGIN
	CAB[CAB$L_STS]=.ERR_STATUS;
	CAB[CAB$W_ERR_PTR]=.CAB[CAB$W_PTR];
	CAB[CAB$W_PTR]=.CAB[CAB$W_FLD_PTR];
	RETURN .ERR_STATUS
	END;

$CONTINUE_RECOG;

IF NOT .PAB[PAB$V_NOS]
  THEN	$SPACES;

CAB[CAB$L_STS]=SS$_NORMAL;
RETURN SS$_NORMAL

END;
ROUTINE PARSE_PAB(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	TBS
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	ERROR STATUS
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BIND

	PAB	= .P_PAB	: $PAB_DECL;

LOCAL

	CHAR,
	STATUS;

EXTERNAL LITERAL

	HLP$_EXTRA,	! Extra characters at end of line
	HLP$_BADTYP;	! Bad type field in PAB

ENABLE

	LIB$$HLP$CATCHER;

PAB[PAB$A_SOS]=0;
PAB[PAB$L_ERR]=SS$_NORMAL;
PAB[PAB$L_STS]=0;
PAB[PAB$L_STV]=0;

SELECTONE .PAB[PAB$B_TYP] OF

	SET

	[HLP$K_KEYWORD,
	 HLP$K_QUALIFIER]:

		STATUS=LIB$$HANDLE_KEYWORD(PAB);

	[HLP$K_NUMBER]:

		STATUS=LIB$$HANDLE_NUMBER(PAB);

	[HLP$K_TOKEN]:

		STATUS=LIB$$HANDLE_TOKEN(PAB);

	[HLP$K_PARAM,HLP$K_DEVICE,HLP$K_FLOAT,HLP$K_TIME,HLP$K_UIC]:

		STATUS=LIB$$HANDLE_PARAM(PAB);

	[HLP$K_NAME,HLP$K_PROCESS,HLP$K_USERNAME,HLP$K_ACCOUNT,
	 HLP$K_NODENAME,HLP$K_LOGICAL_NAME]:

		STATUS=LIB$$HANDLE_NAME(PAB);

	[HLP$K_CHARACTER]:

		STATUS=LIB$$HANDLE_CHARACTER(PAB);

	[HLP$K_TEXT]:

		STATUS=LIB$$HANDLE_TEXT(PAB);

	[HLP$K_STRING]:

		STATUS=LIB$$HANDLE_STRING(PAB);

	[HLP$K_QUOTED_STRING]:

		STATUS=LIB$$HANDLE_QUOTED_STRING(PAB);

	[HLP$K_INPUT_FILE]:

		STATUS=LIB$$HANDLE_FILENAME(PAB);

	[HLP$K_OUTPUT_FILE]:

		STATUS=LIB$$HANDLE_FILENAME(PAB);

	[HLP$K_GENERAL_FILE]:

		STATUS=LIB$$HANDLE_FILENAME(PAB);

	[HLP$K_END]:

		BEGIN

		!+
		! Confirm that we are at the end of the line.
		!-

		CHAR=$CHAR(LIB$$END_HELP,LIB$$NO_RECOG);
		IF .CHAR EQL 0
		  THEN	STATUS=SS$_NORMAL
		  ELSE	STATUS=HLP$_EXTRA

		END;

	[OTHERWISE]:

		$PAB_ERR(HLP$_BADTYP,2,PAB,.PAB[PAB$B_TYP])
	TES;

RETURN .STATUS

END;
ROUTINE HLP$REPARSE_HANDLER(P_SIG,P_MECH,P_ENBL) =
BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Standard VMS Condition handler.
!	Its only purpose is to catch the special signal known as
!	HLP$_REPARSE which means that we should back up to our
!	last prompt.  We restore the state of the world (as best
!	as we can) to what it was just before the last prompt,
!	and then issue the prompt again.  This is accomplished
!	by doing an unwind.
!
! FORMAL PARAMETERS:
!
!	P_SIG		Address of signal vector.
!
!	P_MECH		Address of mechanism vector.
!
!	P_ENBL		Address of enable vector.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!	NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BIND

	SIG	=	.P_SIG		: BLOCK[,BYTE],	! Signal vector
	MECH	=	.P_MECH		: BLOCK[,BYTE];	! Mechanism vector

LOCAL

	STATUS;

EXTERNAL LITERAL

	HLP$_REPARSE;

!+
!	If the condition that is signalled is not the one we are interested
!	in (HLP$_REPARSE), then we do nothing but resignal the condition
!	so that some condition handler above us will take care of the
!	condition.
!-

IF .SIG[CHF$L_SIG_NAME] NEQ HLP$_REPARSE THEN RETURN SS$_RESIGNAL;

!+
!	Unwind, not to our caller, but to us.
!	This forces the call to the user's parsing routine
!	to return HLP$_REPARSE as a value.
!-

MECH[CHF$L_MCH_SAVR0]=.SIG[CHF$L_SIG_NAME];

STATUS=SETUNWIND(MECH[CHF$L_MCH_DEPTH]);
IF NOT .STATUS THEN SIGNAL(.STATUS);

RETURN SS$_RESIGNAL

END;
GLOBAL ROUTINE LIB$$HLP$CATCHER(P_SIG,P_MECH,P_ENBL) =
BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Standard VMS Condition handler.
!	Its only purpose is to catch the special signal known as
!	HLP$_HELP and return it as a status value.
!
! FORMAL PARAMETERS:
!
!	P_SIG		Address of signal vector.
!
!	P_MECH		Address of mechanism vector.
!
!	P_ENBL		Address of enable vector.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
!
!	NONE
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BIND

	SIG	=	.P_SIG		: BLOCK[,BYTE],	! Signal vector
	MECH	=	.P_MECH		: BLOCK[,BYTE];	! Mechanism vector

LOCAL

	STATUS;

EXTERNAL LITERAL

	HLP$_HELP;

!+
!	If the condition that is signalled is not the one we are interested
!	in (HLP$_HELP), then we do nothing but resignal the condition
!	so that some condition handler above us will take care of the
!	condition.
!-

IF .SIG[CHF$L_SIG_NAME] NEQ HLP$_HELP THEN RETURN SS$_RESIGNAL;

!+
!	Unwind, to our caller.
!	This forces the call to us
!	to return HLP$_HELP as a value.
!-

MECH[CHF$L_MCH_SAVR0]=.SIG[CHF$L_SIG_NAME];

STATUS=SETUNWIND();
IF NOT .STATUS THEN SIGNAL(.STATUS);

RETURN SS$_RESIGNAL

END;
GLOBAL ROUTINE LIB$$HLP$UCHAR(P_PAB,P_HELP_RTN,P_RECOG_RTN) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Gets the next character to be parsed, first
!	converting it to upper case
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB
!
! IMPLICIT INPUTS:
!
!	CAB
!
! IMPLICIT OUTPUTS:
!
!	CAB$W_PTR is advanced if we are not at the end of the line
!
! ROUTINE VALUE:
!
!	the next character or 0 if there are no more characters
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BIND

	PAB	= .P_PAB	: $PAB_DECL;

LOCAL

	CHAR;

CHAR=$CHAR(.P_HELP_RTN,.P_RECOG_RTN);
IF .CHAR GEQU %C'a' AND .CHAR LEQU %C'z'
  THEN	CHAR=.CHAR-%C'a'+%C'A';

RETURN .CHAR

END;
GLOBAL ROUTINE LIB$$HLP$CHAR(P_PAB,P_HELP_RTN,P_RECOG_RTN) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Gets the next character out of the command line.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	CAB
!
! IMPLICIT OUTPUTS:
!
!	CAB$W_PTR	is advanced if we are not at the end of the line
!
! ROUTINE VALUE:
!
!	the next character or 0 if we were at the end of the line
!
! SIDE EFFECTS:
!
!	NONE
!
!--
LOCAL

	STATUS;

BIND

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

BIND ROUTINE

	HELP_RTN	= .P_HELP_RTN,
	RECOG_RTN	= .P_RECOG_RTN;

EXTERNAL LITERAL

	HLP$_HELP,
	HLP$_REPARSE;

!+
!	Is there a character left to be parsed in the buffer?
!	If there is, then we can immediately return it.
!	If not, then what are we to do?
!	There are one of 3 possible cases:
!
!	(a)	user hit RECOGNIZE and we need to perform recognition
!
!	(b)	user hit HELP and we need to perform incremental help
!
!	(c)	we are at the end of the user's command line.
!-

SELECTONE 1 OF

    SET

    [.PTR LSSU .CLN]:

	;

    [.CAB[CAB$B_QIO_TRM] EQL HLP$K_RECOGNIZE]:

	BEGIN

	!+
	! The user typed RECOGNIZE at this point.
	!-

	CAB[CAB$V_EOL] = 1;	! ***

	!+
	! If the current field has already been recognized,
	! then we merely return a 0.
	! This will force us on to the next field.
	!-

	IF .CAB[CAB$V_REC]
	  THEN	BEGIN
		CAB[CAB$V_REC]=FALSE;
		CAB[CAB$V_PFR]=TRUE;
		RETURN 0
		END;

	!+
	! If we are at the beginning of a field,
	! and if there is a default string,
	! then we recognize this default string.
	!-

	IF .PTR EQL .INI AND
	    DEF NEQ 0	 AND
	    .DEF[DSC$W_LENGTH] NEQ 0
	  THEN	BEGIN
		LIB$OUT_RECOG(DEF,CAB);
		STATUS=TRUE
		END
	  ELSE	BEGIN

		!+
		! If there is no recognition routine, then
		! we just return a 0.
		!-

		IF RECOG_RTN EQL 0
		  THEN	RETURN 0;

		!+
		! Go call the appropriate recognition routine.
		!-

		STATUS=RECOG_RTN(PAB);

		END;

	!+
	! Set the "current field has been recognized" bit if we
	! completed this field via recognition.
	!-

	CAB[CAB$V_REC]=.STATUS;

	!+
	! If no new characters have been recognized,
	! then go get some new characters from the terminal.
	! As a temporary inefficiency, we do this by
	! signalling HLP$_REPARSE.
	!-

	IF .PTR EQL .CLN
	  THEN	BEGIN
		IF .STATUS
		  THEN	RETURN 0
		  ELSE	BEGIN
			$OUT(UPLIT(1,UPLIT(7)),HLP$K_BELL_LINE);
			SIGNAL(HLP$_REPARSE)
			END
		END;

	!+
	! If recognition failed to complete, then
	! ring the terminal bell.
	!-

!	IF NOT .CAB[CAB$V_REC]
!	  THEN	$OUT(UPLIT(1,UPLIT(7)));

	END;

    [.CAB[CAB$B_QIO_TRM] EQL HLP$K_HELP]:

	BEGIN

	CAB[CAB$V_EOL] = 1;	! ***

	IF HELP_RTN EQL 0
	  THEN	RETURN 0;

	!+
	! The user typed HELP ("?") at this point.
	! Display the "?" and some spaces the first time through,
	! or the word OR on subsequent times.
	!-

	IF .CAB[CAB$V_PHL]
	  THEN	$OUT(%ASCID 'or ',    HLP$K_OR_LINE)
	  ELSE	$OUT(%ASCID '?     ',HLP$K_QMARK_LINE);

	!+
	! Do we have any user-supplied help text for this field?
	! If so, output it now.
	!-

!	IF .PAB[PAB$V_HLP]
!	  THEN	BEGIN
!		1
!		END;

	!+
	! Now go perform normal incremental help,
	! unless the user has explicitly suppressed it.
	!-

	IF NOT .PAB[PAB$V_SDH]
	  THEN	HELP_RTN(PAB);

	!+
	! Temporarily, this will always cause a reparse.
	!-

	SIGNAL(HLP$_HELP)

	END;

    [.PTR EQL .CLN]:

	BEGIN

	!+
	! If we are at the end of the line, return a 0.
	! Set the EOL flag to stop us from backing up.
	!-

	CAB[CAB$V_EOL]=1;
	RETURN 0
	END

    TES;

!+
! Get the character and return it.
! Advance the pointer.
!-

PTR=.PTR+1;
RETURN .BUF[.PTR-1]

END;
GLOBAL ROUTINE LIB$$HLP$BACKUP(P_CAB) : NOVALUE =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Backs up the command line scan by one character position.
!
! FORMAL PARAMETERS:
!
!	P_CAB		Address of CAB
!
! IMPLICIT INPUTS:
!
!	CAB
!
! IMPLICIT OUTPUTS:
!
!	CAB$W_PTR	gets decremented unless we are at the end of the line.
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BIND

	CAB	= .P_CAB	: $CAB_DECL;

IF NOT .CAB[CAB$V_EOL]
  THEN	CAB[CAB$W_PTR]=.CAB[CAB$W_PTR]-1

END;
END
ELUDOM