Trailing-Edge
-
PDP-10 Archives
-
BB-R775C-BM
-
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) 1983, 1985 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
! 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 WHICH 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