Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-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