Trailing-Edge
-
PDP-10 Archives
-
BB-L054E-RK
-
blspar.b36
There are no other files named blspar.b36 in the archive.
MODULE BLSPAR (
ENTRY ($PRINIT,$PRCMND,$PRNFLD,$PRCFM,$PRKEY,$PRSWI,
$PRUSR,$PRNUM,$PRFIL,$PRFLD,$PRTOK,$PRNOD,
$PRSXF,$PRTXT,$PRDEV,$PRQST,$PRUNQ,$PRACT,
$PRCMA,$PRSETUP,$PARSE,$P$TAKE,$P$HELP),
LANGUAGE(BLISS36)
) =
BEGIN !Begin body of MODULE BLSPAR
!
! COPYRIGHT (c) 1979,1980 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: BLISS Interface to TOPS-10/20 GALAXY OPERATOR command parser
!
! ABSTRACT: This module provides an interface to the OPR command
! parsing routines. These routines are implemented as
! part of the GALAXY system in the module OPRPAR. The
! OPR parser routines provide a structured interface
! to the COMND JSYS on TOPS-20 and the emulation of
! the COMND functionality on TOPS-10. The use of this
! interface allows a BLISS program to make use of the
! services of the OPRPAR functionality. The interface
! handles the problem of the difference in linkage
! conventions between statndard BLISS and the GALAXY
! conventions. In addition it provides a set of macros
! to build the description of the syntax which the
! OPRPAR routine uses and defines some of the GALAXY
! data structures in BLISS. The use of OPRPAR
! currently requires the use of the GALAXY run time
! system GLXLIB. This results in a number of
! restrictions in the use of this interface.
! The restrictions are:
!
! 1. The GALAXY run time library, GLXLIB, must either
! be linked with the resultant object code produced
! from the BLISS compilation or be available on SYS:
! when the program is run.
!
! 2. The program must follow the address space
! conventions used by GLXLIB. Specifically, GLXLIB
! must reside at 400000, it is not relocatable. This
! may be accomplished by linking GLXLIB ensuring it is
! the first HISEG object module encountered by LINK.
! If it is not desired to link GLXLIB at object time
! then the BLISS code which will be loaded in the
! HISEG must be relocated when loading with LINK by
! using the /SEG:.HIGH.:nnnnnn switch, where, nnnnnn
! is the address at which the BLISS code will be
! loaded. The area at 600000 is used by GLXLIB for its
! variables.
!
!
! ENVIRONMENT: TOPS-20 with GALAXY R4 GLXLIB
!
! AUTHOR: Dale C. Gunn, CREATION DATE: 29 January 1979
!
! MODIFIED BY:
!
! Donald R. Brandt, 26-MAR-80: VERSION 02
!
! 01 - Updated to support released version of GALAXY
!
! Dale C. Gunn, 28-MAR-80: VERSION 02
!
! 02 - Remove SYSCOM and add BLSPAR.R36 as REQUIRE files
! Delete definitions duplicated in REQUIRE file
! Add needed definitions from SYSCOM
! Fix command error output code using K_SOUT
!
!--
GLOBAL BIND EDTPAR = %O'02' ; ! Edit level of this module
!+
! HOW TO USE THE BLISS INTERFACE TO GALAXY OPRPAR
!
! This documents the overall way to make use of the
! GALAXY OPRPAR functionality from a program written
! in BLISS. There are two basics components to the
! BLISS interface. They are a set of BLISS macros
! which are used to build the static data structure
! which defines the syntax to be parsed by OPRPAR and
! a set of routines which provide the run-time
! interface to the OPRPAR routines. The procedure to
! be followed is as follows:
!
! 1. In your BLISS program define the syntax of
! your command language using the macros provided in
! BLSPAR.R36. Each macro builds one instance of a
! Parser Data Block (PDB). The PDB's are linked
! through two fields, a next and alternate link.
! Before defining any PDB's their name should be
! declared FORWARD with the $PDB macro. This produces
! the FORWARD declaration with the correct structure
! type and size attributes.
!
! 2. In the BLISS routine at which you wish to
! parse a command, make a routine call to the routine
! $PRINIT to initialize the interface. This routine
! takes one argument, a six character sixbit string of
! the name of the calling program.
!
! 3. Call $PRCMND with three arguments to parse
! the command. The three arguments are the address of
! the initial PDB at which to start the parse, a
! character pointer to the prompt string, and
! optionally the address of a string in storage to be
! parsed or null to obtain commands from the terminal.
! This routine will return with a value of 1 only
! after a complete command has been parsed. It should
! never return with a value of zero.
!
! 4. When $PRCMND has returned it has within its
! variable space a block which contains the results of
! the parse. The resultant data may be obtained
! sequentially using the routines provided for that
! purpose. There is a routine for each type of data
! that is expected to be present in the return block.
! These routines take from one to three arguments
! which are the addresses of locations at which the
! returned data is stored. Up to three pieces of
! information is returned, the type of item
! encountered, the data itself, and a word count where
! necessary. The data is type dependent, in some cases
! it is the data itself, e.g. in the case of a number.
! In other cases it may be an address or pointer, e.g.
! in the case of a character field a pointer is
! returned.
!
! 4. Alternatively, one could have used one of
! the three exit entry points provided in the PDB to
! process the data being parsed "on the fly". The
! three exit points are specified by coding the
! keyword parameters PREFILL, ACTION, and ERROR when
! coding the macros which define the PDB. These three
! parameters specify the address of a routine to call
! at critical points during the parse. The points are
! for PREFILL, just prior to parsing the item
! specified by that PDB; for ACTION, just after the
! item specified for that PDB has been successfully
! parsed; and for ERROR, after an unsuccessful parse
! for that PDB. When the specified exit routine gets
! called it should be prepared to accept two
! arguments, a count of argument block length, and the
! address of the command return argument block (CR).
! The exit routine must return a value of -1 to allow
! the parse to continue or 0 to abort the parse at
! that point.
!
!-
!
! TABLE OF CONTENTS:
!
FORWARD
ROUTINE
$PRINIT,
$PRCMND,
$PRSETUP,
$PARSE,
$P$TAKE,
$P$HELP,
$PRNFLD,
$PRKEY,
$PRNUM,
$PRSWI,
!$PRIFI!
!$PROFI!
$PRFIL,
$PRFLD,
$PRCFM,
$PRDIR,
$PRUSR,
$PRFLT,
$PRDEV,
$PRTXT,
$PRTAD,
$PRQST,
!$PRUQS!
$PRUNQ,
$PRTOK,
$PRNUX,
$PRACT,
$PRNOD,
$PRSXF;
!
! INCLUDE FILES:
!
LIBRARY 'BLI:MONSYM'; !TOPS-20 symbols
LIBRARY 'BLI:TENDEF'; !PDP-10 definitions
!REQUIRE 'SYSCOM' !D02 SYSTEM LIBRARY DEFINITIONS
REQUIRE 'BLSPAR'; !A02 BLSPAR symbol definitions
!
! MACROS:
!
!GALAXY routine status return values
MACRO TRUE = 1 % ,
FALSE = 0 % ;
!GALAXY TTY string output macro
MACRO TTY_SOUT [] = K_SOUT(UPLIT(%ASCIZ %STRING(%REMAINING))) % ;
MACRO TTY_ADDR (STR_ADDR) = K_SOUT(STR_ADDR) % ;
!
! This macro ensures that there are no register allocation
! conflicts when interfacing with routines in the GALAXY
! library that want to return values in S1 and S2. This
! interface macro immediately moves the returned register
! values into local variables.
!
! Parameters are passed to the GALAXY routines by means of a
! BLISS LINKAGE attribute.
!
! GALAXY library routines always set the true/false condition
! in AC0.
!
! Calling sequence:
!
! GLX( function_call, ret_variable_1, ret_variable_2 )
!
MACRO
GLX(F,ret1,ret2) =
BEGIN
REGISTER
AC0 = 0,
AC1 = 1,
AC2 = 2 ;
F ;
%IF NOT %NULL(ret1) %THEN ret1 = .AC1 ; %FI
%IF NOT %NULL(ret2) %THEN ret2 = .AC2 ; %FI
.AC0
END % ;
!
! EQUATED SYMBOLS:
!
!
! FORWARD REFERENCES:
!
!
! OWN STORAGE:
!
! GALAXY INITIALIZATION BLOCK (IB)
! (from GLXMAC.MAC, 7-Mar-80)
!
! All programs which make use of the GALAXY library or
! runtime system must go through an initialization call to
! insure that the modules are in a determinant state, and
! also to set up the profile that this program wants. This
! initialization is carried out using a communications area,
! the Initialization Block, from which parameters are read
! and information filled in.
!
! The initialization call to I%INIT is made with S1
! containing the size of the IB and S2 containing its
! address.
!
! Initialization Block (IB):
!
! !=======================================================!
! ! Address of output routine for defaulted $TEXTs !
! !-------------------------------------------------------!
! !OCT!STP! program-wide flags !
! !-------------------------------------------------------!
! ! Base of program's interrupt vector(s) !
! !-------------------------------------------------------!
! ! PID block address !
! !-------------------------------------------------------!
! ! $TEXT error exit routine !
! !-------------------------------------------------------!
! ! Name of Program in SIXBIT !
! !=======================================================!
!
FIELD IB_FIELDS =
SET
IB$OUT = [0,0,36,0], !Address of routine to call from
! output routine if $TEXT
! specifies none
IB$FLG = [1,0,36,0], !Program wide flag word
IP$STP = [1,34,1,0], !Send stopcodes to ORION as WTO
IT$OCT = [1,35,1,0], !OPEN command terminal
IB$INT = [2,0,36,0], !Base of interrupt vector(s)
IB$PIB = [3,0,36,0], !Address of PID block
IB$ERR = [4,0,36,0], !User $TEXT error exit routine
! address
IB$PRG = [5,0,36,0] !Name of program, in SIXBIT
TES;
LITERAL IB$SZ = 6; !Size of GALAXY Initialization Block (IB)
! ! IN WITH A SP$xxx SYMBOL
! IB$IPC = [2,0,36,0], !IPCF CONTROL WORD
! IP$PSI = [2,0,1,0], !SET IF PROGRAM WILL USE PSI TO
! ! NOTIFY THAT IPCF PACKET IS READY
! IP$JWP = [2,1,1,0], !SET IF PROGRAM WISHES ITS PID TO BE
! ! PRESERVED UNTIL LOGOUT
! IP$STP = [2,2,1,0], !SEND STOPCODES TO ORION AS WTO IF SET
! IP$SPB = [2,3,1,0], !SET IF CALLER IS PRIVELEGED AND WISHES
! ! TO SEE IF SENDER SET IP$CFP
! IP$RSE = [2,4,1,0], !SET IF CALLER WANTS FAILURE RETURN ON
! ! SEND ERRORS THAT DEAL WITH
! ! TRANSIENT CONDITIONS
! IP$CHN = [2,12,6,0], !CHANNEL OR OFFSET TO CONNECT IPCF
! ! TO PSI ON IF IP$PSI IS LIT
! IP$SPI = [2,27,9,0], !SET IF CALLER WISHES TO BECOME
! ! A SYSTEM-WIDE COMPONENT. FILLED
! IB$IPP = [3,0,36,0], !IPCF PARAMETERS TO SET
! IP$MNP = [3,0,18,0], !MAXIMUM NUMBER OF PIDS JOB WILL HAVE
! IP$SQT = [3,18,9,0], !IPCF SEND QUOTA
! IP$RQT = [3,27,9,0], !IPCF RECEIVE QUOTA
! IB$PID = [4,0,36,0], !FILLED IN WITH PID ASSIGNED TO THE JOB
! IB$VER = [5,0,36,0], !VERSION NUMBER OF PROGRAM
! IB$TTY = [7,0,36,0], !TERMINAL SCANNING CHARACTERISTICS
! IT$OCT = [7,0,1,0], ! OPEN COMMAND TERMINAL
MACRO IB_BLOCK = BLOCK[IB$SZ] FIELD(IB_FIELDS) %;
OWN IB: IB_BLOCK INITIAL (0,0,0,0,0,%SIXBIT'BLSPAR') ;
! GALAXY PARSER ARGUMENT BLOCK (PAR)
FIELD PAR_FIELDS =
SET
PAR$TB = [0,0,36,0], !ADDRESS OF THE SYNTAX TABLES (PDB)
PAR$PM = [1,0,36,0], !ADDRESS OF THE PROMPT STRING
PAR$CM = [2,0,36,0], !ADDRESS OF STORED PARSE DATA,
! DEFAULT TO GET PAGE IF ZERO
PAR$SR = [3,0,36,0] !ADDRESS OF THE STRING TO PARSE,
TES; ! DEFAULTS TO TTY: IF ZERO
LITERAL PAR$SZ = 4 ; !Size of GALAXY Parser Argument Block (PAR)
MACRO PAR_BLOCK = BLOCK[PAR$SZ] FIELD(PAR_FIELDS) %;
OWN PAR: PAR_BLOCK INITIAL (0,0,0,0) ;
! GALAXY MESSAGE BLOCK
!Among GALAXY programs, there is a common message header format
! so that communication and error checking is easier. There are
! also some common function codes (currently only TEXT) which are
! defined across program lines. The specific data (if any) associated
! with each message type follows the standard header. Note also
! that MESSAGE LENGTH includes the header itself.
! !=======================================================!
! ! Message Length ! Message Type !
! !-------------------------------------------------------!
! !ACK!NOM!FAT!WRN!MOR! ! Sixbit Suffix !
! !-------------------------------------------------------!
! ! Acknowledgement code !
! !=======================================================!
FIELD MS_FIELDS =
SET
$MSTYP = [0,0,36,0], !MESSAGE TYPE WORD
MS$CNT = [0,0,18,0], !MESSAGE LENGTH
MS$TYP = [0,18,18,0], !MESSAGE TYPE
! MT.OFF==700000 !OFFSET TO THE COMMON CODES
! MT.TXT==700000 !TEXT MESSAGE
$MSFLG = [1,0,36,0], !FLAGS WORD
MF$ACK = [1,0,1,0], !1B0 ACKNOWLEDGEMENT REQUESTED
MF$NOM = [1,1,1,0], !1B1 NO MESSAGE, JUST AN ACK
MF$FAT = [1,2,1,0], !1B2 FATAL MESSAGE
MF$WRN = [1,3,1,0], !1B3 WARNING MESSAGE
MF$MOR = [1,4,1,0], !1B4 MORE MESSAGE FOLLOWS
MF$SUF = [1,18,18,0], !SUFFIX FOR TEXT MESSAGE
$MSCOD = [2,0,36,0] !USER SUPPLIED CODE USED FOR ACK'ING
TES;
LITERAL MS$SIZ = 3 ; !LENGTH OF MESSAGE HEADER
MACRO MS_BLOCK = BLOCK[MS$SIZ] FIELD(MS_FIELDS) %;
! GALAXY COMMAND Message
!This message consists of the standard message header followed by a Parser
!Block (PB) as defined below. This block is built by the routine PARSER
!in the module OPRPAR.
! !=======================================================!
! \ \
! \ THE MESSAGE HEADER \
! \ \
! !=======================================================!
! ! FLAG WORD !
! !-------------------------------------------------------!
! ! ARGUMENT COUNT !
! !=======================================================!
! !-------------------------------------------------------!
! ! COMMAND OBJECT TYPE !
! !-------------------------------------------------------!
! ! SOURCE NODE !
! !-------------------------------------------------------!
! ! OFFSET TO PARSER BLOCK !
! !-------------------------------------------------------!
! ! OFFSET TO TEXT OF COMMAND !
! !=======================================================!
FIELD COM_FIELDS =
SET
COM$TY = [5,0,36,0], !OBJECT TYPE CODE
!VALID FOR APPLICATIONS ONLY
COM$SN = [6,0,36,0], !SOURCE NODE OF COMMAND
COM$PB = [7,0,36,0], !POINTER TO THE PARSER BLOCK
COM$CM = [8,0,36,0] !POINTER TO MESSAGE TEXT
TES;
LITERAL COM$SZ = 4; !SIZE OF HEADER
MACRO COM_BLOCK = BLOCK[COM$SZ] FIELD(COM_FIELDS) %;
! PARSER RETURN BLOCK
FIELD PRT_FIELDS =
SET
PRT$FL = [0,0,36,0], !FLAG WORD FOR RETURN
PRT$CM = [1,0,36,0], !COMMAND MESSAGE ADDRESS
PRT$CF = [2,0,36,0], !COMMAND FLAG WORD
PRT$MS = [3,0,36,0], !POINTER TO TEXT OF MESSAGE ON
!FALSE RETURN
PRT$EM = [4,0,36,0], !POINTER TO ERROR MESSAGE ON
!FALSE RETURN
PRT$EC = [5,0,36,0] !ERROR CODE RETURNED
!FROM ACTION ROUTINE
TES;
LITERAL PRT$SZ = 6 ;
MACRO PRT_BLOCK = BLOCK[PRT$SZ] FIELD(PRT_FIELDS) %;
!
!D02 GALAXY exit routine parameter block - removed
!
!Miscellaneous storage
OWN MSGADR: INITIAL (0) ; !ADDRESS OF OPRPAR MESSAGE BLOCK
!
! EXTERNAL REFERENCES:
!
!D02 Linkage to GALAXY routine - removed
! Special linkage for OPRPAR semantic scanners
! These are used because no arguments are passed to them, but
! register 0 returns T/F flag and register 1 returns value.
LINKAGE GALXYS = PUSHJ: LINKAGE_REGS (15,14,0)
NOPRESERVE (0,2,3,4)
PRESERVE (5,6,7,8,9,10,11,12,13);
EXTERNAL
ROUTINE
!GALAXY routines
I_INIT: GALAXY, !GLXLIB initialization
P$INIT: GALAXY, !PARSER initialization
K_SOUT: GALAXY, !GALAXY String Output Routine
M_RPAG: GALAXY, !GALAXY Memory de-allocation
PARSER: GALAXY, !OPRPAR parser
P$TAKE: GALAXY, !Set up for TAKE
P$HELP: GALAXY, !Set up for HELP
P$SETUP: GALAXY, !OPRPAR semantic setup
P$NFLD: GALXYS, !OPRPAR semantic routines
P$CFM: GALXYS,
P$KEYW: GALXYS,
P$SWIT: GALXYS,
P$USER: GALXYS,
P$NUM: GALXYS,
P$FILE: GALXYS,
P$IFIL: GALXYS,
P$OFIL: GALXYS,
P$FLD: GALXYS,
P$TOK: GALXYS,
P$NODE: GALXYS,
P$SIXF: GALXYS,
P$RNGE: GALXYS,
P$TEXT: GALXYS,
P$DIR: GALXYS,
P$FLOT: GALXYS,
P$TIME: GALXYS,
P$DEV: GALXYS,
P$QSTR: GALXYS,
P$COMMA:GALXYS,
P$UQSTR:GALXYS,
P$ACCT: GALXYS,
%NAME('.ZPAGA'): GALAXY ; !Zero a page of memory
GLOBAL ROUTINE $PRINIT (NAME) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine calls the GALAXY routine I%INIT to
! initialize the GLXLIB environment and if not
! already present to obtain the runtime system
! into the programs address space.
!
! FORMAL PARAMETERS:
!
! NAME: A string of up to six SIXBIT characters which
! specify the name of the program.
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! If not already loaded, the GALAXY run-time system is loaded
! into the programs address space at location 400000.
!
! ROUTINE VALUE:
!
! Returns TRUE if function completed successfully.
! Returns FALSE if function not completed successfully.
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! The GLXLIB runtime module is loaded.
!
!--
BEGIN !Beginning ROUTINE $PRINIT
IB[IB$PRG] = .NAME ; !COPY NAME SUPPLIED
IB[IT$OCT] = 1 ; !Open command terminal
IF I_INIT(IB$SZ,IB) !INITIALIZE GLXLIB RUN TIME SYSTEM
THEN
( P$INIT(0,0) ; true )
ELSE
false
END; !End ROUTINE $PRINIT
GLOBAL ROUTINE $PRCMND (PDB,PROMPT,INCORE,PB_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will parse a complete command as described
! by the syntax of the PDB tree.
!
! FORMAL PARAMETERS:
!
! PDB: The address of the PDB data structure which describes
! the syntax of the command grammar to be parsed.
!
! PROMPT: A BLISS character pointer to the prompt string.
!
! INCORE: (Optional) If specified, a BLISS character pointer
! to a command string in memory.
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! Command error messages are output to the users terminal
! when invalid command input fields are entered.
!
! ROUTINE VALUE:
!
! Returns TRUE when a complete command has been
! successfully parsed.
!
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! The global address of a list of input items and
! their values is stored for use later by associated
! routines.
!
!--
BEGIN !Begin ROUTINE $PRCMND
LOCAL
PTR,
RETCOD ;
OWN
PRT$BLK: REF PRT_BLOCK,
COM$BLK: REF COM_BLOCK ;
PAR[PAR$TB] = .PDB ; !Pass along PDB address
PAR[PAR$PM] = .PROMPT ; !Pass along prompt pointer
PAR[PAR$CM] = .MSGADR ; !And message block address
PAR[PAR$SR] = .INCORE ; !If an incore string
DO BEGIN
RETCOD = (PARSER (PAR$SZ,PAR)) ;
BEGIN
REGISTER S2 = 2 ;
PRT$BLK = .S2 ;
END ;
IF .RETCOD EQL 0
THEN BEGIN
TTY_SOUT(%CHAR(13,10),'?Command Error: "') ;
!D02 PTR = CH$PTR(.PRT$BLK[PRT$MS]) ;
TTY_ADDR(.PRT$BLK[PRT$MS]) ; !M02
TTY_SOUT('" ') ;
!D02 PTR = CH$PTR(.PRT$BLK[PRT$EM]) ;
TTY_ADDR(.PRT$BLK[PRT$EM]) ; !M02
END ;
END
UNTIL .RETCOD NEQ 0 ; !Loop until successful parse
MSGADR = .PRT$BLK[PRT$CM] ; !Ret addr of message block
COM$BLK = .PRT$BLK[PRT$CM] ; !Point to command block
.PB_ADR = .COM$BLK + .COM$BLK[COM$PB]; !Point to PB block
TRUE !Return success
END; !End of ROUTINE $PRCMND
GLOBAL ROUTINE $PARSE(pdb_tree,prompt,command,error_msg,error_flag) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will parse a complete command as described by
! the syntax of the PDB tree. Following a successful parse,
! the parameters can be retrieved with successive calls to
! the appropriate routine (e.g., $PRKEY for a KEYWORD).
!
! FORMAL PARAMETERS:
!
! pdb_tree:
! The address of the PDB data structure describing
! the syntax of the command grammar to be parsed.
!
! prompt: A BLISS character pointer to the prompt string.
!
! command:
! A BLISS character pointer to a command string
! in memory. (0 if command is from TTY:)
!
! error_msg:
! The address to store the address of the error
! message returned by the parser if the parse fails.
!
! error_flag:
! The address to store the error flag returned by
! the parser if the parse fails.
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! On failure, values are stored in error_msg and error_flag.
!
! ROUTINE VALUE:
!
! Returns TRUE if the parse is successful
! Returns FALSE if the parse fails
!
! SIDE EFFECTS:
!
! The global address of a list of input items and their
! values is stored for use later by associated routines. If
! the parse is successful, P$SETUP processing is done.
!
!--
BEGIN !Beginning ROUTINE $PARSE
OWN
PRT$BLK: REF PRT_BLOCK,
COM$BLK: REF COM_BLOCK ;
! IF .msgadr NEQ 0 THEN %NAME('.ZPAGA')(.msgadr) ;
IF .msgadr NEQ 0 THEN ( M_RPAG(.msgadr) ; msgadr = 0 ) ;
PAR[PAR$TB] = .pdb_tree ; !Pass along PDB address
PAR[PAR$PM] = .prompt ; !Pass along prompt pointer
PAR[PAR$CM] = .msgadr ; !And message block address
PAR[PAR$SR] = .command ; !If an incore string
IF GLX(PARSER(PAR$SZ,PAR),,PRT$BLK)
THEN
BEGIN
MSGADR = .PRT$BLK[PRT$CM] ; !Ret addr of message block
COM$BLK = .PRT$BLK[PRT$CM] ; !Point to command block
P$SETUP(.COM$BLK + .COM$BLK[COM$PB]) ; !Point to PB block
true
END
ELSE
BEGIN
.error_msg = .PRT$BLK[PRT$EM] ; !Return error message
.error_flag = .PRT$BLK[PRT$FL]; !Return error flag, too
! .adr_text = .PRT$BLK[PRT$MS] ; !Return address of text
! TTY_ASOUT(.PRT$BLK[PRT$MS]) ; !Return address of text
false
END
END ; !End ROUTINE $PARSE
GLOBAL ROUTINE $P$TAKE(fd1,fd2,ifn1,ifn2) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine performs the initialization required to do a
! TAKE command.
!
! FORMAL PARAMETERS:
!
! fd1: the FD of the command file
!
! fd2: the FD of the log file
!
! ifn1: the address to store the IFN of the command file in
!
! ifn2: the address to store the IFN of the log file in
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if setup fails.
!
! SIDE EFFECTS:
!
! The files are opened
!
!--
BEGIN !Beginning ROUTINE $P$TAKE
LOCAL
S1,
S2 ;
IF GLX(P$TAKE(.fd1,.fd2),S1,S2)
THEN
( .ifn1 = .S1 ; .ifn2 = .S2 ; true )
ELSE
false
END ; !End ROUTINE $P$TAKE
GLOBAL ROUTINE $P$HELP(fd,s_key) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine interfaces to the OPRPAR routine P$HELP for
! providing help messages from a specified text file.
!
! FORMAL PARAMETERS:
!
! fd: the FD of the .HLP file
!
! s_key: the address of the string to be used as a
! search key in the .HLP file
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! Outputs any associated error messages.
!
! ROUTINE VALUE:
!
! Returns TRUE if no errors.
! Returns FALSE if errors.
!
! SIDE EFFECTS:
!
! The files are opened
!
!--
BEGIN !Beginning ROUTINE $P$HELP
GLX(P$HELP(.fd,.s_key))
END ; !End ROUTINE $P$HELP
GLOBAL ROUTINE $PRSETUP (PB_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Calls the OPRPAR routine P$SETUP to set address of first
! parser block.
!
! FORMAL PARAMETERS
!
! PB_ADR => Address of first parser block
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE always.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
S1 = .PB_ADR ; !Point to first parser block
P$SETUP(); !Call the OPRPAR routine
TRUE !Always must return true
END; !End of $PRSETUP
GLOBAL ROUTINE $PRNFLD (TYPE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Obtains the type of the next item parsed.
!
! FORMAL PARAMETERS
!
! TYPE => The address of a BLISS variable to contain the result.
!
! IMPLICIT INPUTS
!
! The pointer to the current item.
!
! ROUTINE VALUE:
!
! Returns TRUE always.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$NFLD(); !Get next field type
!Leave PB at current
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF .TF EQL 0
THEN BEGIN
.TYPE = .RET1 ; !TYPE FOUND
RETURN FALSE
END
ELSE BEGIN
.TYPE = .RET1 ;
RETURN TRUE
END
END; !End of $PRNFLD
GLOBAL ROUTINE $PRKEY (TYPE,CODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Obtains the command keyword code if the current
! item parsed was a keyword.
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a keyword ($CMKEY),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ; !USED WITH CAUTION
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$KEYW();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMKEY ;
.CODE = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRKEY
GLOBAL ROUTINE $PRNUM (TYPE,VALUE,RADIX) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a number ($CMNUM),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$NUM();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMNUM ;
.VALUE = .RET1 ;
.RADIX = .RET2 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRNUM
GLOBAL ROUTINE $PRSWI (TYPE,CODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a switch ($CMSWI),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
!
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$SWIT();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMSWI ;
.CODE = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRSWI
GLOBAL ROUTINE $PRFIL (TYPE,FD,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a file spec ($CMFIL),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$FILE();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMFIL ;
.FD = .RET1 + 1 ; !Point to FD
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRFIL
GLOBAL ROUTINE $PRFLD (TYPE,TEXT,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is an arbitrary field ($CMFLD),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$FLD();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMFLD ;
.TEXT = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRFLD
GLOBAL ROUTINE $PRCFM (TYPE) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a carriage return ($CMCFM),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$CFM();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF .TF EQL 0
THEN BEGIN
.TYPE = .RET1 ; !TYPE FOUND
RETURN FALSE
END
ELSE BEGIN
.TYPE = $CMCFM ;
RETURN TRUE
END
END; !End of $PRCFM
GLOBAL ROUTINE $PRDIR (TYPE,DATA1) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a directory name ($CMDIR),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$DIR();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMDIR ;
.DATA1 = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRDIR
GLOBAL ROUTINE $PRUSR (TYPE,USER) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a user name ($CMUSR),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$USER();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMUSR ;
.USER = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRUSR
GLOBAL ROUTINE $PRFLT (TYPE,DATA1) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a floating point number ($CMFLT),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$FLOT();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMFLT ;
.DATA1 = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRFLT
GLOBAL ROUTINE $PRDEV (TYPE,ADDR,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a device name ($CMDEV),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$DEV();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMDEV ;
.ADDR = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRDEV
GLOBAL ROUTINE $PRTXT (TYPE,TEXT,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a text line ($CMTXT),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$TEXT();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMTXT ;
.TEXT = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRTXT
GLOBAL ROUTINE $PRTAD (TYPE,DATA1) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a time and date ($CMTAD),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$TIME();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMTAD ;
.DATA1 = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRTAD
GLOBAL ROUTINE $PRQST (TYPE,TEXT,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a quoted string ($CMQST),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$QSTR();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMQST ;
.TEXT = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRQST
GLOBAL ROUTINE $PRUNQ (TYPE,TEXT,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is an unquoted string ($CMUQS),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$UQSTR();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMUQS ;
.TEXT = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRUNQ
GLOBAL ROUTINE $PRTOK (TYPE,TEXT,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a token ($CMTOK),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$TOK();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TEXT = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
.TYPE = $CMTOK ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRTOK
GLOBAL ROUTINE $PRNUX (TYPE,DATA1,DATA2) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a numeric field ($CMNUX),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$NUM();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMNUX ;
.DATA1 = .RET1 ;
.DATA2 = .RET2 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRNUX
GLOBAL ROUTINE $PRACT (TYPE,TEXT,COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is an account ($CMACT),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
REGISTER S2 = 2 ;
STACKLOCAL RET1,RET2; !TO SAVE AWAY S1,S2
P$ACCT();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
RET2 = .S2 ; ! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMACT ;
.TEXT = .RET1 + 1 ;
.COUNT = .RET2 - 1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRACT
GLOBAL ROUTINE $PRCMA (TYPE) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a comma ($CMCMA),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$COMMA();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND, IF NOT COMMA
ELSE BEGIN
.TYPE = $CMACT ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRACT
GLOBAL ROUTINE $PRNOD (TYPE,NODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a node name ($CMNOD),
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$NODE();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMNOD ;
.NODE = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRNOD
GLOBAL ROUTINE $PRSXF (TYPE,FLDSIX) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Returns TRUE if the current item is a sixbit field,
! otherwise, returns FALSE.
!
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
REGISTER S1 = 1 ;
REGISTER TF = 0 ;
STACKLOCAL RET1; !TO SAVE AWAY S1
P$SIXF();
RET1 = .S1 ; !GET RETURN VALUES SAFELY
! OUT OF AC'S
IF (.TF EQL 0)
THEN .TYPE = .RET1 !TYPE FOUND
ELSE BEGIN
.TYPE = $CMFLD ;
.FLDSIX = .RET1 ;
RETURN TRUE ;
END;
FALSE
END; !End of $PRSXF
END !End body of MODULE BLSPAR
ELUDOM
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:41
! End: