Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/prparcom.bli
There are 10 other files named prparcom.bli in the archive. Click here to see a list.
%TITLE 'PRPARCOM - parse a command'
MODULE PRPARCOM ( ! Parse a command
IDENT = '3-016' ! File: PRPARCOM.BLI Edit:GB3016
) =
BEGIN
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1988. ALL RIGHTS RESERVED.
!
!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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY: EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
! Parse a command.
!
! ENVIRONMENT: Runs on TOPS-20 only
!
! AUTHOR: Chris Gill, CREATION DATE: March 1, 1983
!
! MODIFIED BY:
!
! 3-001 - Created. CJG 1-Mar-1983
! 3-002 - Change the way that filespecs are handled. CJG 28-Jun-1983
! 3-003 - Add code for PUSH command and tidy up. CJG 25-Sep-1983
! 3-004 - Add PROMPT_LENGTH so that we can get error pointer in right place. CJG 7-Oct-1983
! 3-005 - Add TRACE and XDDT commands. CJG 10-Oct-1983
! 3-006 - Add SET SEARCH IGNORE parsing. CJG 2-Nov-1983
! 3-007 - Apply some modifications required by fixes in PRFILE. CJG 12-Dec-1983
! 3-008 - Fix problem when <ESC> and Control-R interact. CJG 20-Dec-1983
! 3-009 - Make Control-H work remove some old code. CJG 20-Dec-1983
! 3-010 - Check for control-C being typed. CJG 5-Jan-1984
! 3-011 - Allow SUBSTITUTE string to be terminated by <CR>. GB 2-May-1984
! 3-012 - Allow control chars as SUBSTITUTE string delimiters. GB 2-May-1984
! 3-013 - Fix TAB ADJUST to parse a range specification. GB 20-Jul-1984
! 3-014 - Allow <LF> as a null command. GB 24-Jul-1984
! 3-015 - Fix problems with numeric zero argument on some SET commands. GB 7-Sep-1984
! 3-016 - Fix bug in comment handling which causes command buffer size to be
! reduced by 2 for each comment parsed. GB 15-Oct-1984
!--
%SBTTL 'DECLARATIONS'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
REQUIRE 'EDTSRC:PARLITS';
FORWARD ROUTINE
EDT$$PA_CMD,
PA_PARSE;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
REQUIRE 'SYS:JSYS';
REQUIRE 'EDTSRC:PARDATA';
!
! EXTERNAL REFERENCES:
!
EXTERNAL
! CMD_BUF, ! Command line buffer.
CMD_PTR, ! Pointer into command buffer.
CMD_END, ! Pointer to end of current command.
CMD_LEN, ! Length of command.
VFY, ! verify switch
INP_SRC, ! Source of input
DEFKEY, ! Flag for DEFINE KEY
TAB_SIZ, ! Size of a tab
TI_WID, ! Terminal width
PA_CURCMD : REF NODE_BLOCK, ! Current command node
PA_CURTOK, ! start of the current token
PA_CURTOKLEN, ! Length of current token
PA_CURRNG, ! Current range node
PA_MORE, ! More on command line
PA_ERRNO, ! Error number of parsing error.
PA_SP, ! Parse stack pointer
PROMPT_LENGTH, ! Length of prompt
WRT_NAM : BLOCK, ! Descriptor for WRITE command
OUT_NAM : BLOCK, ! Descriptor for EXIT command
INC_NAM : BLOCK, ! Descriptor for INCLUDE command
TEMP_BUFFER, ! Temp string buffer
HELP_DFLT, ! Help defaults for PA_FILE
CMD_DFLT, ! Command defaults for PA_FILE
CC_WAIT, ! ^C may be typed and should be handled
CC; ! Control-C flag
EXTERNAL ROUTINE
EDT$$FMT_CRLF, ! Terminate an output line
EDT$$FMT_CH,
EDT$$FMT_LIT,
EDT$$MSG_TOSTR,
EDT$$PA_TSTMACCAL, ! Test atom for being a macro name
EDT$$PA_NEW_NOD, ! Create a new node
EDT$$PA_SCANTOK : NOVALUE, ! Find length of current atom
EDT$$PA_SWITCH, ! Parse a switch
EDT$$PA_GET_KEY, ! Parse a key name
EDT$$PA_GET_CHAR, ! Get a single character
EDT$$PA_FILE, ! Parse a filespec
EDT$$PA_BUFFER, ! Parse a buffer name
EDT$$PA_NUMBER, ! Parse a decimal number
EDT$$PA_COLON, ! Parse a colon
EDT$$PA_RANGE; ! Parse a range specifier
!
! MACROS:
!
! NONE
!
!
! OWN STORAGE
!
! NONE
!
%SBTTL 'EDT$$PA_CMD - parse a command'
GLOBAL ROUTINE EDT$$PA_CMD(
PROMPT,
PRLEN) = ! Parse a command
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to parse a single command on the current command
! line. The command will be read from the relevent file or the terminal
! which allows for full recognition. In this case, a copy of the command
! is returned in the command buffer. If the parse is successful, a 1 is
! is returned and the parsing stack contains a description of the command.
! CMD_PTR is left pointing at the '\' or <CR> which are are the only
! valid terminators of commands. If an error occurs, a 0 is returned,
! and PA_MORE is left as zero to indicate that no more data exists on the
! command line.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! CMD_BUF
! CMD_PTR
! CMD_END
! CMD_LEN
! VFY
! INP_SRC
!
! IMPLICIT OUTPUTS:
!
! PA_CURCMD
! PA_SP
! PA_CURTOK
! PA_ERRNO
!
! ROUTINE VALUE:
!
! 1 = parse was successful
! 0 = parse failed, PA_ERRNO set
!
! SIDE EFFECTS:
!
! MANY
!
!--
BEGIN
LOCAL
C_FLAG, ! COMND flags
C_DATA, ! COMND data pointer
C_FDB, ! COMND actual FDB used
STS : INITIAL (0);
MESSAGES ((UNXCHRAFT, UNRCOM));
!+
! Indicate that if a control-C is typed it should be handled by aborting
! the COMND JSYS.
!-
CC_WAIT = -1;
!+
! Initialise the COMND JSYS ready for a command. This is only done if
! there is no more data in the rescan buffer.
!-
IF (.PA_MORE EQL 0) THEN
BEGIN
IF (.PRLEN NEQ 0) THEN PROMPT_LENGTH = .PRLEN;
CH$WCHAR (0, CH$MOVE (.PRLEN, .PROMPT, CH$PTR (TEMP_BUFFER,, BYTE_SIZE)));
CSB [$CMRTY] = CH$PTR (TEMP_BUFFER,, BYTE_SIZE);
IF (NOT COMMAND (FD_INI))
THEN
BEGIN
CC_WAIT = 0;
RETURN (0);
END;
IF (.CC NEQ 0) THEN STS = -1;
END;
!+
! Loop around the parser as long as a reparse is required. When an error
! occurs or the command is accepted, then continue.
!-
PA_MORE = 0;
WHILE (.STS EQL 0) DO
BEGIN
!+
! Initialize the command node pointer and the parsing stack pointer.
!-
PA_CURCMD = 0;
PA_SP = -1;
PA_ERRNO = 0;
STS = PA_PARSE (); ! Parse a command
IF (.STS EQL 1) THEN
BEGIN
!+
! The command has been parsed - make sure that it ends correctly.
!-
IF (NOT COMMAND (FD_END))
THEN
BEGIN
CC_WAIT = 0;
RETURN (0);
END;
IF (.CC NEQ 0)
THEN
STS = -1
ELSE
BEGIN
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN STS = 0;
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN
BEGIN
PA_ERRNO = EDT$_UNXCHRAFT;
STS = -1;
END;
END;
END;
END;
!+
! If the command ended with '\', then indicate more to come
!-
IF (.STS EQL 1) THEN
BEGIN
IF (.C_FDB<0,18> EQL FD_END) THEN
BEGIN
PA_CURTOK = .CSB [$CMPTR];
PA_CURTOKLEN = .CSB [$CMINC];
PA_MORE = 1;
END;
CMD_LEN = 256 - .CSB [$CMCNT];
CC_WAIT = 0;
RETURN (1);
END;
!+
! There was an error - if it occured because of control-C then tidy up,
! go to a new line for the message, and exit now. (Assume no other errors)
!-
IF (.CC NEQ 0) THEN
BEGIN
PA_MORE = 0;
PA_ERRNO = 0;
CC_WAIT = 0;
EDT$$FMT_CRLF ();
RETURN (0);
END;
!+
! The command failed to parse correctly - indicate the error
!-
IF (.PA_ERRNO EQL 0) THEN PA_ERRNO = EDT$_UNRCOM;
!+
! Print the command with an indication of where the error is. If the
! user ended the bad field with an escape, then send <CR><LF> first.
! Also take account of the prompt length so we get the pointer in the
! right place.
!-
IF ((.INP_SRC NEQ INP_TERM) AND (.VFY EQL 0)) THEN
BEGIN
EDT$$FMT_CH (%C' ');
EDT$$FMT_LIT (CH$PTR (CMD_BUF,, BYTE_SIZE), .CMD_LEN);
EDT$$FMT_CRLF ();
END;
IF ((.CSB [$CMFLG] AND CM_ESC) NEQ 0) THEN EDT$$FMT_CRLF ();
DECR I FROM (CH$DIFF (.CSB [$CMPTR], CH$PTR (CMD_BUF,, BYTE_SIZE)) +
.PROMPT_LENGTH) TO 0 DO EDT$$FMT_CH (%C' ');
EDT$$FMT_CH (%C'^');
EDT$$FMT_CRLF ();
PROMPT_LENGTH = 0;
!+
! Print the corresponding error message and ensure that other commands
! on this line are not parsed.
!-
EDT$$MSG_TOSTR (.PA_ERRNO);
EDT$$FMT_CRLF ();
PA_MORE = 0;
CC_WAIT = 0;
RETURN (0);
END;
END;
%SBTTL 'PA_PARSE - Parse the individual commands'
ROUTINE PA_PARSE = ! Start parsing a command
BEGIN
!+
! This routine parses the command keyword and dispatches to the relevent
! subroutine to parse the rest of the command. If a reparse is required,
! the value of the routine is set to 0, if an error occurs, it is set to
! -1, else it is set to 1.
!-
OWN
PARSED_FILE : BLOCK [DSC$K_SIZE]; ! Space for parsed files
LOCAL
C_FLAG, ! COMND flags
C_DATA, ! COMND data pointer
C_FDB, ! COMND actual FDB used
CMDTYP, ! Command type or subtype
STS;
LITERAL ! Filespec parsing flags
F_REQD = 1, ! Filespec required
F_EXIT = 2, ! EXIT command
F_OUTPUT = 4, ! Parse an output filespec
F_RELEAS = 8; ! Release the JFN when done
MESSAGES ((ASREQ, QUOSTRREQ, MACKEYREQ, INVPARFOR, NUMVALREQ, NUMVALILL,
UNXCHRAFT, UNRCOM, INVVALSET, ENTMUSTBE, NONALPNUM,
SUBSTRNUL, INVSTR));
BEGIN
!+
! Parse the command keyword
!-
STS = 0;
IF (NOT COMMAND (FD_CMD)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
!+
! If the atom ended in an escape, then don't try to match it with a buffer
! name (we can't do recognition on these). If the atom parsed OK and it is
! not a buffer name, then treat it as a good command. Otherwise, try to
! make a range node out of it. If the command is just a carriage return,
! then default to NULL, ignore the command if it is a comment.
!-
SELECTONE .C_FDB<0,18> OF
SET
[ FD_CMD ] :
BEGIN
!+
! Found a valid command keyword. If recognition was not used, then see
! if it is a macro name. Otherwise, see to it.
!-
IF ((.C_FLAG AND CM_ESC) EQL 0)
THEN
BEGIN
EDT$$PA_SCANTOK (0,1);
IF (EDT$$PA_TSTMACCAL ()) THEN RETURN (1);
END;
CMDTYP = .(.C_DATA)<0,18>;
END;
[ FD_CMM ] :
BEGIN
!+
! Found an alphanumeric field. If it is not a macro name then fail, if
! it was empty, then try to parse a range.
!-
STS = 1;
EDT$$PA_SCANTOK (0,1);
IF (.PA_CURTOKLEN NEQ 0) THEN
BEGIN
IF (EDT$$PA_TSTMACCAL ()) THEN RETURN (1);
CMDTYP = CH$RCHAR (.PA_CURTOK);
IF (.CMDTYP GEQ %C'@') THEN RETURN (-1);
CSB [$CMINC] = .CSB [$CMINC] + .PA_CURTOKLEN; ! Backup
CSB [$CMPTR] = .PA_CURTOK;
CSB [$CMCNT] = .CSB [$CMCNT] + .PA_CURTOKLEN;
END;
CMDTYP = COM_NULL;
END;
[ FD_CMT ] :
BEGIN
!+
! Set the command type appropriately, and backup to the <CR><LF> so that
! the end of line parsing will work.
!-
LOCAL
PTR,
LEN;
LEN = CH$DIFF (.CSB [$CMPTR], CH$PTR (CMD_BUF,, BYTE_SIZE));
IF (.LEN LEQ 2) THEN
CMDTYP = COM_NULL
ELSE
CMDTYP = -1;
PTR = CH$PLUS (.CSB [$CMPTR], -1);
WHILE (CH$RCHAR (.PTR) EQL %O'15') OR (CH$RCHAR (.PTR) EQL %O'12') DO
BEGIN
CSB [$CMINC] = .CSB [$CMINC] + 1;
CSB [$CMPTR] = .PTR;
CSB [$CMCNT] = .CSB [$CMCNT] + 1;
PTR = CH$PLUS (.PTR, -1);
END;
END;
TES;
!+
! Get a new parse node for this command
!-
IF (.PA_CURCMD NEQ 0) THEN PA_CURCMD [ NEXT_COM ] = .PA_SP;
IF ((PA_CURCMD = EDT$$PA_NEW_NOD (COM_NODE, .CMDTYP)) EQL 0) THEN RETURN (0);
IF (.CMDTYP EQL -1) THEN RETURN (1);
CASE .CMDTYP FROM COM_NULL TO LAST_COM OF
SET
[ COM_NULL ] :
BEGIN
IF .STS
THEN
RETURN (EDT$$PA_RANGE (1)) ! Just parse a range
ELSE
CSB [$CMCNT] = .CSB [$CMCNT] + 2; ! Fix the counter
END;
[ COM_CHANGE, COM_FILL, COM_FIND, COM_INSERT, COM_REPLACE ] :
BEGIN
RETURN (EDT$$PA_RANGE (1)); ! Just parse a range
END;
[ COM_COPY, COM_MOVE ] :
BEGIN
STS = EDT$$PA_RANGE (2); ! Parse a range subcommand
IF (.STS LEQ 0) THEN RETURN (.STS);
IF (NOT COMMAND (FD_RTO)) THEN RETURN (-1); ! Parse 'TO'
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
IF (.C_FDB<0,18> EQL FD_RTO) THEN
BEGIN
!+
! If a '%' was found then try to parse 'TO'
!-
IF (NOT COMMAND (FD_RT1)) THEN RETURN (-1); ! Parse 'TO'
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
END;
STS = EDT$$PA_RANGE (1); ! Parse second range
IF (.STS LEQ 0) THEN RETURN (.STS);
RETURN (EDT$$PA_SWITCH (
IF (.CMDTYP EQL COM_COPY) THEN
FD_COP
ELSE
FD_DEL
));
END;
[ COM_DEFINE, COM_DEF_MAC ] :
BEGIN
PA_ERRNO = EDT$_MACKEYREQ;
IF (NOT COMMAND (FD_DEF)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
CMDTYP = .(.C_DATA)<0,18>;
PA_CURCMD [COM_NUM] = .CMDTYP;
SELECTONE .CMDTYP OF
SET
[ COM_DEFINE ] :
BEGIN
!+
! Get the key number from the command
!-
STS = EDT$$PA_GET_KEY ();
IF (.STS LEQ 0) THEN RETURN (.STS);
PA_ERRNO = EDT$_ASREQ;
DEFKEY = 0;
!+
! Parse 'AS "string" '
!-
IF (NOT COMMAND (FD_AS)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
PA_ERRNO = EDT$_QUOSTRREQ;
IF (NOT COMMAND (FD_QST)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
!+
! Store the length and pointer to the string
!-
EDT$$PA_SCANTOK (1,0);
PA_CURCMD [AS_STR] = .PA_CURTOK;
PA_CURCMD [AS_LEN] = .PA_CURTOKLEN;
END;
[ COM_DEF_MAC ] :
BEGIN
!+
! Parse a buffer name (same format as macro name)
!-
STS = EDT$$PA_BUFFER ();
IF (.STS LEQ 0) THEN RETURN (.STS);
PA_CURCMD [RANGE1] = .PA_CURRNG;
END;
TES;
END;
[ COM_CLEAR ] :
BEGIN
STS = EDT$$PA_BUFFER (); ! Parse a buffer name
IF (.STS LEQ 0) THEN RETURN (.STS);
PA_CURCMD [RANGE1] = .PA_CURRNG;
END;
[ COM_DELETE ] :
BEGIN
STS = EDT$$PA_RANGE (1); ! Parse a range
IF (.STS LEQ 0) THEN RETURN (.STS);
RETURN (EDT$$PA_SWITCH (FD_DEL)); ! Parse /QUERY
END;
[ COM_EXIT ] :
BEGIN
STS = EDT$$PA_FILE (OUT_NAM, F_EXIT + F_OUTPUT, 0);
IF (.STS LEQ 0) THEN RETURN (.STS);
RETURN (EDT$$PA_SWITCH (FD_EXI)); ! Parse /SAVE or /SEQUENCE
END;
[ COM_INCLUDE, COM_PRINT, COM_WRITE ] :
BEGIN
STS = (IF (.CMDTYP EQL COM_INCLUDE)
THEN EDT$$PA_FILE (INC_NAM, F_REQD, 0)
ELSE EDT$$PA_FILE (WRT_NAM, F_REQD + F_OUTPUT, 0));
IF (.STS LEQ 0) THEN RETURN (.STS);
STS = EDT$$PA_RANGE (1);
IF ((.STS LEQ 0) OR (.CMDTYP NEQ COM_WRITE)) THEN RETURN (.STS);
RETURN (EDT$$PA_SWITCH (FD_RES));
END;
[ COM_QUIT ] :
BEGIN
RETURN (EDT$$PA_SWITCH (FD_QIT)); ! Only look for /SAVE
END;
[ COM_RESEQ ] :
BEGIN
STS = EDT$$PA_RANGE (1);
IF (.STS LEQ 0) THEN RETURN (.STS);
RETURN (EDT$$PA_SWITCH (FD_RES)); ! Parse /SEQUENCE
END;
[ COM_SET ] :
BEGIN
PA_ERRNO = EDT$_INVPARFOR;
!+
! Clear out PARSED_FILE in case this is SET HELP or SET COMMAND.
!-
PARSED_FILE [DSC$A_DEVICE] = 0;
PARSED_FILE [DSC$A_DIRECT] = 0;
PARSED_FILE [DSC$A_FNAME] = 0;
PARSED_FILE [DSC$A_FEXTN] = 0;
!+
! Parse the SET option
!-
IF (NOT COMMAND (FD_SET)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
!+
! Save the option number
!-
CMDTYP = .(.C_DATA)<0,18>;
PA_CURCMD [SET_TYPE] = .CMDTYP;
!+
! Perform any extra argument parsing that may be required
!-
CASE .CMDTYP FROM 1 TO MAX_SET OF
SET
[ SET_WRAP, SET_SCRN, SET_LINES, SET_TAB ] :
BEGIN
PA_ERRNO = EDT$_NUMVALREQ;
!+
! A decimal number is required
!-
STS = EDT$$PA_NUMBER ();
IF (.STS LSS 0) THEN RETURN (.STS);
PA_ERRNO = EDT$_NUMVALILL;
IF (.STS GEQ 256) THEN RETURN (-1);
PA_CURCMD [SET_VAL] = .STS;
END;
[ SET_CASE, SET_SRCH, SET_TERM, SET_MODE, SET_NTITY,
SET_TEXT, SET_WORD, SET_PARA, SET_PROMPT ] :
BEGIN
PA_ERRNO = EDT$_INVVALSET;
IF (NOT COMMAND (
SELECTONE .CMDTYP OF
SET
[ SET_CASE ] : FD_CAS;
[ SET_SRCH ] : FD_SCH;
[ SET_TERM ] : FD_TRM;
[ SET_MODE ] : FD_MOD;
[ SET_NTITY] : FD_ENT;
[ SET_TEXT ] : FD_TEX;
[ SET_WORD ] : FD_WRD;
[ SET_PARA ] : FD_PAR;
[SET_PROMPT] : FD_PRO;
TES)
) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
PA_CURCMD [SET_VAL] = .(.C_DATA)<0,18>;
IF ((.CMDTYP EQL SET_NTITY) OR
(.CMDTYP EQL SET_TEXT) OR
(.CMDTYP EQL SET_PROMPT) OR
((.CMDTYP EQL SET_SRCH) AND (.(.C_DATA)<0,18> EQL SET_SIGN))) THEN
!+
! SET ENTITY, TEXT, or PROMPT also take a string
!-
BEGIN
PA_ERRNO = EDT$_QUOSTRREQ;
IF (NOT COMMAND (FD_QST)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
EDT$$PA_SCANTOK (1,0);
PA_CURCMD [AS_STR] = .PA_CURTOK;
PA_CURCMD [AS_LEN] = .PA_CURTOKLEN;
END;
END;
[ SET_HELP ] :
BEGIN
STS = EDT$$PA_FILE (PARSED_FILE, F_REQD + F_RELEAS, HELP_DFLT);
IF (.STS LEQ 0) THEN RETURN (.STS);
END;
[ SET_COMND ] :
BEGIN
STS = EDT$$PA_FILE (PARSED_FILE, F_REQD + F_RELEAS, CMD_DFLT);
IF (.STS LEQ 0) THEN RETURN (.STS);
END;
[ SET_CURSR ] :
BEGIN
PA_ERRNO = EDT$_NUMVALREQ;
STS = EDT$$PA_NUMBER ();
IF (.STS LSS 0) THEN RETURN (.STS);
PA_ERRNO = EDT$_NUMVALILL;
IF (.STS GEQ 32768) THEN RETURN (-1);
PA_CURCMD [SET_VAL1] = .STS;
STS = EDT$$PA_COLON (1);
IF (.STS LEQ 0) THEN RETURN (.STS);
PA_ERRNO = EDT$_NUMVALREQ;
STS = EDT$$PA_NUMBER ();
IF (.STS LSS 0) THEN RETURN (-1);
PA_ERRNO = EDT$_NUMVALILL;
IF (.STS GEQ 32768) THEN RETURN (-1);
PA_CURCMD [SET_VAL] = .STS;
END;
[ INRANGE ] :
;
TES;
RETURN (1);
END;
[ COM_SHOW ] :
BEGIN
PA_ERRNO = EDT$_INVPARFOR;
IF (NOT COMMAND (FD_SHO)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
CMDTYP = .(.C_DATA)<0,18>;
PA_CURCMD [SET_TYPE] = .CMDTYP;
SELECTONE .CMDTYP OF
SET
[ SHO_NTITY, SHO_PROMPT, SHO_TEXT ] :
BEGIN
PA_ERRNO = EDT$_ENTMUSTBE;
IF (NOT COMMAND (
SELECTONE .CMDTYP OF
SET
[ SHO_NTITY ] : FD_ENT;
[ SHO_PROMPT] : FD_PRO;
[ SHO_TEXT ] : FD_TEX;
TES)
) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
PA_CURCMD [SET_VAL] = .(.C_DATA)<0,18>;
END;
[ SHO_KEY ] :
BEGIN
RETURN (EDT$$PA_GET_KEY ());
END;
[ OTHERWISE ] :
;
TES;
RETURN (1);
END;
[ COM_SUBS, COM_SUBS_NEXT ] :
BEGIN
LOCAL
STRNODE : REF NODE_BLOCK, ! Node pointer
QCHAR; ! Quote character
!+
! If the command was SUBSTITUTE NEXT, then set CMDTYP and make sure the
! command node is correctly set.
!-
IF (.CMDTYP EQL COM_SUBS) THEN
BEGIN
IF (NOT COMMAND (FD_SNX)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) EQL 0) THEN CMDTYP = COM_SUBS_NEXT;
PA_CURCMD [COM_NUM] = .CMDTYP;
END;
!+
! If the command was [SUBSTITUTE] NEXT, then it can be terminated by <CR>
!-
IF (.CMDTYP EQL COM_SUBS_NEXT) THEN
IF ((.C_FLAG AND CM_EOC) NEQ 0) THEN RETURN (1);
!+
! Create a new node
!-
IF ((STRNODE = EDT$$PA_NEW_NOD (STR_NODE, 0)) EQL 0) THEN
RETURN (-1);
PA_CURCMD [STR_PNT] = .STRNODE;
!+
! Use the next character as the quote character - unless its alphanumeric
!-
QCHAR = EDT$$PA_GET_CHAR ();
IF (.QCHAR LEQ 0) THEN RETURN (.QCHAR);
PA_ERRNO = EDT$_NONALPNUM;
IF (((.QCHAR GEQ %C'0') AND (.QCHAR LEQ %C'9')) OR
((.QCHAR GEQ %C'A') AND (.QCHAR LEQ %C'Z')) OR
((.QCHAR GEQ %C'a') AND (.QCHAR LEQ %C'z'))) THEN RETURN (-1);
!+
! Now set the break mask for the new break character
!-
BREAK_MASK [0] = %O'20000000';
BREAK_MASK [1] = 0;
BREAK_MASK [2] = 0;
BREAK_MASK [3] = 0;
BREAK_MASK [.QCHAR/32] = 1 ^ (35 - (.QCHAR MOD 32)) OR
.BREAK_MASK [.QCHAR/32];
!+
! Parse an unquoted string - up to the break or <CR>
!-
STRNODE [SRCHADDR] = .CSB [$CMPTR];
IF (NOT COMMAND (FD_UQS)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
!+
! Save the length. Die if <CR> was the terminator
!-
STRNODE [SRCHLEN] = CH$DIFF (.CSB [$CMPTR], .STRNODE [SRCHADDR]);
CSB [$CMINC] = .CSB [$CMINC] - 1;
PA_ERRNO = EDT$_INVSTR;
IF (CH$RCHAR_A (CSB [$CMPTR]) EQL ASC_K_CR) THEN RETURN (-1);
!+
! Parse another unquoted string
!-
STRNODE [REPADDR] = .CSB [$CMPTR];
IF (NOT COMMAND (FD_UQS)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (-1);
!+
! Save the length of the replacement and make sure the aren't null
!-
STRNODE [REPLEN] = CH$DIFF (.CSB [$CMPTR], .STRNODE [REPADDR]);
PA_ERRNO = EDT$_SUBSTRNUL;
IF ((.STRNODE [REPLEN] EQL 0) AND (.STRNODE [SRCHLEN] EQL 0))
THEN RETURN (-1);
CSB [$CMINC] = .CSB [$CMINC] - 1;
CSB [$CMCNT] = .CSB [$CMCNT] - 1;
CSB [$CMPTR] = CH$PLUS (.CSB [$CMPTR], 1);
!+
! For a SUBSTITUTE command, then next atoms can be a range and switches.
!-
IF (.CMDTYP EQL COM_SUBS) THEN
BEGIN
QCHAR = EDT$$PA_RANGE (1);
IF (.QCHAR LEQ 0) THEN RETURN (.QCHAR);
RETURN (EDT$$PA_SWITCH (FD_SUB));
END;
END;
[ COM_TYPE ] :
BEGIN
STS = EDT$$PA_RANGE (1);
IF (.STS LEQ 0) THEN RETURN (.STS);
RETURN (EDT$$PA_SWITCH (FD_TYP));
END;
[ COM_HELP ] :
BEGIN
IF (NOT COMMAND (FD_TXT)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN
PA_CURCMD [FSPCLEN] = 0
ELSE
BEGIN
EDT$$PA_SCANTOK (0,0);
PA_CURCMD [FILSPEC] = .PA_CURTOK;
PA_CURCMD [FSPCLEN] = .PA_CURTOKLEN;
END;
END;
[ COM_TADJ ] :
BEGIN
PA_ERRNO = EDT$_NUMVALREQ;
IF (NOT COMMAND (FD_ADJ)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
IF (.C_FDB<0,18> EQL FD_ADJ) THEN
BEGIN
IF (NOT COMMAND (FD_VAL)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
END;
PA_ERRNO = EDT$_NUMVALILL;
STS = 1;
IF (.C_DATA LSS 0) THEN
BEGIN
STS = -1;
C_DATA = - .C_DATA;
END;
IF ((.C_DATA GEQ 32768) OR (.C_DATA * .TAB_SIZ GEQ 256)) THEN
RETURN (-1);
PA_CURCMD [TAB_COUNT] = .STS * .C_DATA;
STS = EDT$$PA_RANGE (1);
IF (.STS LEQ 0) THEN RETURN (.STS);
END;
[ COM_TRACE ] :
BEGIN
PA_ERRNO = EDT$_INVPARFOR;
IF ( NOT COMMAND (FD_TRC)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
CMDTYP = .(.C_DATA)<0,18>;
PA_CURCMD [SET_TYPE] = .CMDTYP;
PA_CURCMD [AS_STR] = 0; ! Preset
IF (((.CMDTYP EQL TRC_ON) OR (.CMDTYP EQL TRC_OFF)) AND
((.C_FLAG AND CM_EOC) EQL 0))
THEN
BEGIN
IF ( NOT COMMAND (FD_TRR)) THEN RETURN (-1);
IF (.CC NEQ 0) THEN RETURN (-1);
IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
EDT$$PA_SCANTOK (1, 0);
PA_CURCMD [AS_LEN] = .PA_CURTOKLEN;
PA_CURCMD [AS_STR] = .PA_CURTOK;
IF (.CMDTYP EQL TRC_ON) THEN EDT$$PA_SWITCH (FD_TRS);
END;
END;
[ COM_XDDT , COM_MAC_CALL , COM_PUSH ] :
;
TES;
RETURN (1);
END;
END;
END
ELUDOM