Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/t20src/diuc20.b36
There are 4 other files named diuc20.b36 in the archive. Click here to see a list.
%TITLE 'TOPS-20 DIU Command Parsing'
MODULE DIUC20 (IDENT = '262',
LANGUAGE(BLISS36),
ENTRY(DIUCMD, ! Initializes and calls COMAND
MAKEPROMPT, ! Sets new prompt string
C$CONTROL_C, ! Performs program exit (or not)
ST_HELP) ! Store value of HELP argument
) =
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
! 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: DIU (Data Interchange Utility)
!
! ABSTRACT: Parse commands for the Data Interchange Utility and build
! internal request blocks for queued or immediate execution.
!
! ENVIRONMENT: BLISS-36 V4 RMS-20 V3 COMAND
! TOPS-20 V6.1 XPORT V4
!
! AUTHOR: Rick Fricchione CREATED: 17-Dec-1984
!--
%SBTTL 'Revision History'
!++
! HISTORY:
!
! 275 SPR 20-21565. MKJOBNAME was using wrong pointer to tie off Asciz
! string.
! Brian Luau 3-Sep-87
!
! 265 The help for the /STREAM:[CARRIAGE_CONTROL:n|LINE_FEED:n] switch should
! specify "maximum record size" (like /VARIABLE) not "record size" (like
! /FIXED).
! Gregory A. Scott 10-Jul-86
!
! 262 Delete module DIUCMD.R36, moving defs as needed to DIUCOMMAND.
! Gregory A. Scott 7-Jul-86
!
! 260 Commands using a time of "/AFTER:13-jun-95 13:13" didn't parse.
! Gregory A. Scott 7-Jul-86
!
! 253 Library COMAND is now DIUCMD and PATPORTAL is now DIUPATPORTAL.
! Gregory A. Scott 1-Jul-86
!
! 252 Remove library of CONDIT.
! Sandy Clemens 1-Jul-86
!
! 246 Remove edit 245. Add /LIBOL:n switch to read the files that are
! written with RECORDING MODE IS BINARY with mixed-mode data. Default
! the /VFC switch to 2.
! Gregory A. Scott 27-Jul-86
!
! 245 Make /IMAGE legal for the input file for reading TOPS-20 COBOL files
! with RECORDING MODE IS BINARY with mixed-mode ASCII data (which is
! ASCII text mixed with numeric data; fixed and or floating point).
! Gregory A. Scott 26-Jul-86
!
! 234 Change library of RMSUSR to RMSINT.
! Gregory A. Scott 17-Jul-86
!
! 232 Initialize patpar_warn to zero in INIT_REQUEST.
! Sandy Clemens 16-Jun-86
!
! 230 Access control string that didn't specify an account copied the
! password over as the account in ST_UPA routine.
! Gregory A. Scott 12-Jun-86
!
! 220 RENAME should only allow one input filespec. APPEND takes different
! switches than COPY (e.g. no /IMAGE and nothing but /RMS:SEQUENTIAL).
! Again make wildcards illegal for destination side of APPEND.
! Gregory A. Scott 6-Jun-86
!
! 217 An illegal destination filespec (like specifying wildcards on the
! resulted in "File not found" faked error message from DSTFIL. Edit 215
! caused a bug in the SHOW QUEUE /switch parse tables to appear. Allow
! wildcards in destination to APPEND command again. Remove APPEND
! specific switches (/NEW/NONEW/OLD), since the COPY command does /NEW
! and the APPEND command does /OLD. Remove all extra parse tables and so
! on associated with the differences between APPEND and COPY.
! Gregory A. Scott 5-Jun-86
!
! 216 Default of /OLD in the APPEND command should set the CIF bit rather
! than clearing it. Turn off parse only bit on output side of APPEND.
! Make p_src and p_dst GLOBAL so that DEF$REQUEST can use them.
! Gregory A. Scott 4-Jun-86
!
! 215 Change IP_LIST call to SHOQUE.
! Gregory A. Scott 3-Jun-86
!
! 214 Add routine SH_QUEUE and have the SHOW QUEUE routine call it. Default
! the destination switch of /OLD on the APPEND command in the REQUEST
! routine.
! Gregory A. Scott 3-Jun-86
!
! 211 Put a CMCFM before the destination file parse in the SUBMIT and PRINT
! commands (so that we don't always hallucinate the default file name).
! Allow multiple sources on the SUBMIT command. Only write the $ETG for
! the destination filespec buffer if it is non-empty.
! Gregory A. Scott 29-May-86
!
! 207 The /[NO]CONTIGUOUS switch could be typed to the input file.
! Gregory A. Scott 27-May-86
!
! 206 Source remote filespec followed by a local filespec got SRCFIL confused
! because sflags[F_NODE] wasn't reset in PRE_INPUT.
! Gregory A. Scott 27-May-86
!
! 204 Allow HELP topics to include /switch, add default topic DIU. Only
! allow the /NOAFTER and /NODEADLINE switches from the MODIFY command.
! Gregory A. Scott 24-May-86
!
! 203 Add macro $TTY_FAO which prints a FAOed message on the terminal.
! Indicate the end of a TAKE file with a little message. Abort all takes
! when we a ^C is seen and we are yet the spooler doing a take.
! Gregory A. Scott 23-May-86
!
! 202 Fix /AFTER:TODAY again (groan), daylight savings time wasn't being
! handled properly.
! Gregory A. Scott 23-May-86
!
! 200 Don't allow non-disk output files for DIRECTORY if the command is
! queued. Also check that input and output files are on disk (if local).
! Add (yet) more hair to PARERR to eat the spaces at the end of a field
! before trying to eat the field itself.
! Gregory A. Scott 22-May-86
!
! 174 The help command tables were broken sometime in the past.
! Gregory A. Scott 20-May-86
!
! 172 Change prompt to DIUDEB if debugging. Really remove LIBRARY 'TOPS20'.
! Gregory A. Scott 20-May-86
!
! 171 Add routine C$CONTROL_C to handle the control-c interrupts. If a
! control-c is seen in a TAKE and we are yet the spooler, then we just
! set the current take JFN to eof. Remove call to S$TRACE, just do the
! $DEBUG call here instead. Use MONSYM and JSYSDEF rather than TOPS20.
! Gregory A. Scott 19-May-86
!
! 167 Add hair to SW_ARGUMENT to the area that prevents double colon typeout:
! this fixes a rather obscure case of a switch completed with escape that
! takes an argument and the user types a question mark and that switch
! happens to end at a place where there is a colon left in the command
! buffer from a previous command (check that the next unparsed character
! is a colon and the last parsed character is not a colon). Use
! S$NODE_CHECK for all nodes parsed and turn on the parse only bit in
! CMNOD, since we want to be smart about nodes that are offline.
! Gregory A. Scott 19-May-86
!
! 165 Turn off the interrupt system while running in DIU$DO in the request
! routine. This to to prevent getting bombed out to the exec because an
! active slave job or some user sent us an IPCF message while we are
! running in RMS with a section 3 stack. Yes, it is gross but so is
! doing non-queued requests from the spooler job. Edit 163 broke CCL
! takes, which is fixed now. Have macro PE append a CRLF to his strings.
! Gregory A. Scott 16-May-86
!
! 164 Rename D$SHDF to SHODEF and don't pass it an unused third argument.
! Avoid using crufty $MSG_FAO macro.
! Gregory A. Scott 16-May-86
!
! 163 Clean up DIUCMD to get the take file JFN installed in the command state
! block differently and remove routine D$$COMAND which apparently was a
! debugging aid.
! Gregory A. Scott 15-May-86
!
! 161 Make the /LSA switch erase properly on a parse error (like /IMAGE
! already specified in the command line) by always calling sw_argument at
! the start of the rfm_switch routine then retstoring the command state
! with rststa at the end of that same routine if it was the lsa switch.
! Gregory A. Scott 14-May-86
!
! 156 Remove /USAGE (the usage is set in the description file) and /NONRMS
! (the file's FDB is checked for the RMS file class) switches. Make the
! record format switches illegal with /IMAGE file format.
! Gregory A. Scott 13-May-86
!
! 154 The /IMAGE switch should add a tag of diu$k_fab_fac with a value of
! fab$m_bio for DIUDO's use. Use -1 generation on the output side of a
! remote filespec.
! Gregory A. Scott 12-May-86
!
! 152 Have spooler job write the "request queued" message to user log file.
! Gregory A. Scott 11-May-86
!
! 151 Fix PARERR to backup the command buffer over the last switch, so that a
! ^H after some PARERR generated error looks proper and correct (yuk).
! Don't allow /TRANSFORM or /DESCRIPTION with /IMAGE file format.
! Gregory A. Scott 9-May-86
!
! 150 Give a parse error on the following: /RMS:INDEXED without /KEY on
! destination side, /TRANSFORM without source /DESCRIPTION, and
! destination /DESCRIPTION without source /DESCRIPTION means that
! destination must be /RMS:INDEXED.
! Gregory A. Scott 9-May-86
!
! 147 Log the creation of a request in the user's log file.
! Gregory A. Scott 8-May-86
!
! 146 Print a message if we can't queue the request (checking status returned
! from IP_ENTER in the REQUEST routine).
! Gregory A. Scott 7-May-86
!
! 144 DIU$MESSAGE calls from here now never write to the system LOG file.
! Gregory A. Scott 7-May-86
!
! 143 REQUEST routine didn't ever use OWN variable txtbuf and LOCAL variable
! ptr. The defaulting of the request switches (/LOG and /NOTIFY) is now
! done by rewritten DEF$REQUEST which calls DEF$BUFFER and so forth.
! Don't default the notify and log file stuff in INIT_REQUEST dince it is
! done in DEF$REQUEST now. Remove notify_value (no longer used) and
! mvalue (write only variable). The /SPAN_BLOCKS switch should result in
! a tag value of NOT FAB$M_BLK, and /NOSPAM should result in FAB$M_BLK.
! Gregory A. Scott 6-May-86
!
! 142 Rename LOG routine to ST_LOG, remove routine ST_NOLOG, moving its
! rather limited function to ST_LOG. Fix /NOLOG_FILE switch. DEF$BUFFER
! now returns the length of the field it just set up.
! Gregory A. Scott 5-May-86
!
! 141 Work on /KEY so that it only allows one [NO]CHANGES and one
! [NO]DUPLICATES per key. Fix up help strings for the /KEY switch.
! Uppercase the job name in MKJOBNAME.
! Gregory A. Scott 5-May-86
!
! 140 ST_DEFAULTS was broken if setting def_root entries. The /LOG switch
! doesn't default the connected directory right since the JFNS to
! retrieve all of the parsed file specification isn't returning a
! directory since the JFN is done generically parse only for an old file.
! So, save the default directory in DEF$INIT for us to plug in as needed.
! Rename SET_MJOB_ACTION to ST_MJOB and teach it to see if we are the
! spooler or there is not (yet) a spooler before allowing MJOB to be set.
! Gregory A. Scott 3-May-86
!
! 137 Only check node validity once in DSTNOD and SRCNOD, by looking at
! context VALID_NODE. Rename ST_ACCESS to ST_UPA (user password
! account), and clever it up to take VMS-style embedded access strings.
! Remove SRCACC and DSTACC, calling ST_UPA instead. If input filename
! was a quoted string, the default the output filename and type to *.*.
! Rename SET_DEFAULTS_ACTION, to ST_DEFAULTS, clever it up a little bit
! to make it set both types of SET DEFAULT command, then we can get rid
! of SET_NODE. Work on LOG file routines included defaulting the log
! file spec inside of INIT_REQUEST and simplification of routines LOG and
! NOLOG. DEF$CREATE should be maintaining the linked list, rather than
! having each caller do it.
! Gregory A. Scott 3-May-86
!
! 136 Make keys work for indexed files.
! Sandy Clemens 1-May-86
!
! 135 Make the SET MAX command output the current setting of MJOB if we are
! (yet) the spooler.
! Gregory A. Scott 1-May-86
!
! 134 SET MAX error message needed a space in the error message that you get
! when you specify an out of range number. SHOW MAX now says "There are
! n requests executing" if there are slave jobs running. Remove cell
! stopped since cell shutdown is what should be used.
! Gregory A. Scott 30-Apr-86
!
! 133 Change messsage in EXIT_COMMAND if you are (yet) the spooler to have a
! CRLF after it (in case called by ^C trap). Remove MACY11 code in
! FILFMT_SWITCH. /IMAGE should only be global. Output better message in
! SRCNOD when we parse junk due to CMFLD (adding messages missing source
! file specification, bad switch, properly indicate file not found).
! Gregory A. Scott 29-Apr-86
!
! 132 Routine PARERR turned on the noparse bit but it also cleared the CM_XIF
! bit, causing "@" not to be handled locally after a noparse. Add entry
! point for exit_command routine to call upon a ^C.
! Gregory A. Scott 28-Apr-86
!
! 130 Routine MAKEPROMPT should be global so that it can be called by
! SP$START and SP$SHUT. (Yet) again default the filename properly in
! SRCFIL and DSTFIL if the file was remote and not quoted.
! Gregory A. Scott 28-Apr-86
!
! 127 Rework /PREREQ and /SEQ logic: Change /PREREQ switch to allow NONE for
! modify and don't allow a request id of less than 2. Remove NO and YES
! options to /SEQUENCE switch. Remove sequence_switch and
! last_sequence_switch and previous_id cells, add pre_id cell. Implement
! switch conflicts for /SEQUENCE with /QUEUE:NO.
! Gregory A. Scott 26-Apr-86
!
! 126 SHOW VERSION, MAX, and TAKE don't look right in TAKE files because they
! don't output a CRLF at the end of the string, since MSG_FAO doesn't do
! it anymore. INIT_REQUEST didn't specify its formal arguments. A
! command of the form "STOP/NOW/WAIT/NOW/WAIT" used to work; now it only
! lets you type one switch.
! Gregory A. Scott 26-Apr-86
!
! 125 Minor change due to deletion of the "free" crlf furnished by $MSG_FAO.
! /VFC:(n:m) was broken because it called RSTSTA after the first
! argument; now ST_BYTE and ST_HALFWORD check cstate and do not do the
! RSTSTA if we are in a state inside the /VFC:(n:m) switch. SRCFIL
! should always default the file name and type even if they were
! wildcarded.
! Gregory A. Scott 4-Apr-86
!
! 123 Parse of CMQST should be before CMFIL when parsing after the nodename.
! Remove the extra states for the DELETE command (we use the common
! remote input states instead now). Default generation should be "*" for
! the DELETE command.
! Gregory A. Scott 23-Apr-86
!
! 122 Routine request didn't get new lengths of the source and destination
! filespec after calling DEF$BUFFER, resulting in very short filespec
! lengths when access information was applied.
! Gregory A. Scott 22-Apr-86
!
! 121 Fix up help for filespecs after nodenames. Remove last call to
! S$JFN_STR, and remove external routine of Q$CONFIRM, which is never
! called.
! Gregory A. Scott 19-Apr-86
!
! 120 Additional work to make parsing of source and destination filespecs
! work better, or at least differently. Allow "::" after node specified
! in SHOW DEFAULTS. GETFILESPECS is now PRE_INPUT. SRCNOD and DSTNOD
! were carelessly changing the $GJGEN flags that are patiently set up
! elsewhere. Default the directory list level properly in PRE_INPUT.
! The ill-conceived routine SPECIAL_CASES doesn't do anything useful but
! default the filename and list level for the DIRECTORY command (which is
! now done where it should be), so delete it. Change flag_node_set cell
! to rflags[R_NODE]. Cells def_queuevalue, def_notify, and def_sequence
! were really constants, so replace them by the constant.
! Gregory A. Scott 18-Apr-86
!
! 117 Routine REQUEST doesn't need to be global; and it's not anymore.
! Default the output filename properly on the directory command by giving
! a default string on the first flddb in the chain after the filename is
! parsed. Implement checking for conflict between /AFTER /DEAD /QUEUE
! switches. Implement switch conflicts for /DESCRIPTION. Check that
! /DESCRIPTION and /TRANSFORM files are on disk. Allow SHOW DEFAULTS to
! take a nodename. Routine MANIPULATE_ACTION did too much work that was
! done in INIT_REQUEST, and its name conflicted with another routine that
! really did useful work. Now the routine is called PRE_MANIPULATE and
! does very little. TAKE_SET_DEFAULT is now PRE_TAKE. /AFTER:+5 broke
! somewhere in the last few edits.
! Gregory A. Scott 17-Apr-86.
!
! 116 Add proper switch conflict errors for /[NO]SPAN_BLOCKS. Fix parsing of
! multiple word switches (e.g. /FILE_FORMAT:FIXED:n) by having
! SW_ARGUMENT eat colons off of the CMKEYed second word. Make the
! default second word to /FILE_FORMAT: be RMS:. Rework command scanning
! of filespecs so that quoted filespecs work rationally. Remove $PARSEs
! in DSTFIL and SRCFIL since they didn't provide anything useful: quoted
! string filespecs didn't parse if you were typing a [P,PN] and if it
! wasn't a quoted string the GTJFN done by COMND checked the syntax and
! JFNS can be used to extract the name and type for defaulting. (In
! other words, if the user id doing a quoted filespec assume he knows
! what he is doing and let the remote FAL parse the filespec later.)
! Invent two cells (src_node and dst_node) that store the source and
! destination node names for MKJOBNAME's use, making its job a lot
! easier. Remove following storage which was never used or is now no
! longer used: sesa, desa, srsa, drsa, snam, dnam, sfab, dfab, filcnt,
! trace. Teach GETFILESPECS about the DIRECTORY command so that we can
! remove routine DIRECTORY. Remove brain damaged GETADD routine,
! replacing it with calls to newly clevered up GETFILESPECS. Remove
! routine ESAFNA which is no longer used.
! Gregory A. Scott 14-Apr-86
!
! 115 Implement checking of multiple /USERID, /PASSWORD, /ACCOUNT, /ACCESS,
! and fix bare /ACCESS switch. Give better help on all four of those
! switches. Remove cells set_all_aci, set_acct, set_pass, set_userid,
! since they have now been replaced by rflags bits. Remove MACY11 file
! format, /[NO]BLOCKING_FACTOR switch, and routines ST_BLK_FACTOR,
! FAC_SWITCH, and FAC_NSWITCH. Put break mask on /RECORD_FORMAT switch.
! Gregory A. Scott 9-Apr-86
!
! 114 Implement checking of multiple /[NO]AFTER, /[NO]DEADLINE, /NOTIFY,
! /PRIORITY, /[NO]LOG_FILE, /[NO]QUEUE, /PREREQUISITE, /SEQUENCE switches
! in same command. Remove cells set_notify, set_queue, and set_log.
! Make default ext for /LOG_FILE be LOG. Change routines ST_LOG and LOG
! to use rflags bit and context. Remove very strange code in SW_ARGUMENT
! and FILE_ARGUMENT that attempted to "hallucinate the default string
! into the atom buffer" if no terminating colon was seen on a switch; it
! made parsing of switches unlike any other TOPS-20 program. Move
! clearing of key_count and stopswitches to INIT_REQUEST. Remove routine
! STOP_SETUP as it only cleared stopswitches.
! Gregory A. Scott 8-Apr-86
!
! 113 Change usage of COMMAND_EXIT and EXIT to EXIT_STATE, and usage of SAME
! to SAME_STATE. Replace calls to INIT_COMAND with INIT_REQUEST and
! delete INIT_COMAND. Change references of seen_requestid to
! rflags[R_REQUESTID]. Remove /[NO]DEFERRED switch, since it doesn't
! make sense to have it as a synonym for /QUEUE. Remove ability to type
! /SEQUENCE:nn, since that functionality exists in the /PREREQUISITE:nn
! switch and having it both places is misleading. Add routine PARERR to
! print parsing errors; new macro PE calls PARERR and then RETURNs.
! Change all SIGNALed errors for parsing into PE calls. Remove
! FOP_NSWITCH and RAT_NSWITCH and install call FOP_SWITCH or RAT_NSWITCH
! with inverted context. Repair totally broken /VFC switch. Add a lot
! of switch conflict logic to many switches (/USAGE illegal with /LSA or
! /STREAM or /CARRIAGE_CONTROL; detect multiple /TRANSFORM and /WARNINGS;
! allow /KEY only on output file that is /RMS:INDEXED; only allow one
! /USAGE, record format, file format, /CARRIAGE_CONTROL, /CONTIGUOUS,
! /NEW|/OLD per filespec).
! Gregory A. Scott 7-Apr-86
!
! 112 Change the abbreivation for the EXIT command (EX) so that it uses the
! CM_ABR bit and RELATED= option, which is the right way to have an
! abbreviation in the command table. Implement /AFTER:[TODAY|dayofweek].
! Clean up /AFTER parsing in general.
! Gregory A. Scott 3-Apr-86
!
! 114 Change sflags and dflags to be a BITVECTOR of 36. Remove /QUEUE:MAYBE
! (superceded by /QUEUE:CONDITIONAL). Change switch tables around for
! COPY and APPEND so that there are five seperate switch tables,
! differing by the context in which they are parsed: request (anytime),
! input (after a input file only), output (after a COPY output file
! only), append (after APPEND output file only), and global (before any
! filespecs typed only). Add CM_SDH to CMIFI and CMQST in DELETE
! command. Make invisible command of EX so that you don't have to spell
! out "EXI" to exit. For SUBMIT, default file type to .CTL and allow
! wildcarded filenames in GETFILESPECS. GETFILESPECS shouldn't call
! INIT_REQUEST either. Default generation properly for DELETE and RENAME
! to *.
! Gregory A. Scott 2-Apr-86
!
! 106 Remove output of extra blank line when a job is queued. Remove the
! following switches: /BLOCK, /NOBLOCK, /NOCARRIAGE_CONTROL, /UNDEFINED
! on COPY and APPEND; /OUTPUT on DIRECTORY. Routine MKJOBNAME put spaces
! after the job name it made up, causing job names less than 6 characters
! not to match in Q$MATCH (e.g. SHOW QUEUE jobname wouldn't work on
! DIRECTORY and DELETE commands), so I rewrote it using CH$ functions
! rather than $STR functions to make it work simpler, smaller, and
! probably faster. Default directory filename to nodename.DIR rather
! than DIR.DIR; removes some CMCFMs to make that work right. A new fork
! was created by each PUSH command but old forks were never killed; make
! PUSH continue any old EXEC it has sitting around. TAKE, EXECUTE, and
! "@" now default extension to CMD. Prompt now changes to "DIU spooler>"
! if we are the spooler; routine MAKEPROMPT resets the prompt now.
! Gregory A. Scott 1-Apr-86
!
! 102 Conform SHOW VERSION to look like SHOW QUEUE and DEFAULTS. Change
! hyphens to underscores in MAXIMUM_SIMULTANEOUS_REQUESTS. In order to
! make SET DEFAULTS work somewhat more rationally, it has has been
! changed to SET DEFAULT {node::|SWITCHES} [/switch/switch]. This was
! done for clairity and because SW_ARGUMENT was doing bad things to us.
! Repair GET_REQUEST_ID, SHQ_GET_REQUEST_ID, and MODIFY_GET_REQUEST_ID
! parsing: change help string "Request identifier" to "Request queue
! entry, decimal number"; add better help when parsing <username> or
! [username] when specifying a request already in the queue; only accept
! the right flavor of delimiter for usernames (e.g. match "<" with
! closing ">"), which actually simplified parsing the field; remove extra
! CMCFMs which allowed illegal commands to be parsed and add flag
! seen_requestid do do the job the right way. Split FILFMT_TABLE into
! two tables: INP_FMT_TABLE (legal on input files and OUT_FMT_TABLE
! (legal on output files).
! Gregory A. Scott 28-Mar-86
!
! 100 Use "!V" to print version rather than splitting it up ourselves for
! printout in SHOW VERSION. Make nested TAKE commands work right in
! terms of echoing or not echoing. Add SET TAKE to set the default take
! echo mode and SHOW TAKE to display the default take mode. Make CCL
! TAKE (even nested!) work again. A CCL command that didn't parse left
! you in DIU, which is fixed by setting cmdnpt to COMMAND_EXIT to return
! control to DIUCMD.
! Gregory A. Scott 26-Mar-86
!
! 77 Move clearing of def_node to INIT_REQUEST where it belongs. Remove
! somewhat strange CCL command logic and replace with simple ccl_mode
! flag. Each command now has a NEXT state of COMMAND_EXIT, which causes
! each command to terminate in routine DIUCMD. DO_MORE and associated
! logic has been removed. TAKE tried to do a RLJFN of a open JFN which
! doesn't work (it now does a CLOSF). Make TAKE and "@" illegal from CCL
! commands (for now).
! Gregory A. Scott 25-Mar-86
!
! 76 Fix reparsing of command lines by setting CMDRPR (command reparse
! routine) to INIT_COMAND. This fixes ^W and ^H problems. Remove
! unimplementable switch FIMAGE. Pass 0 as third argument to EPCAP to
! prevent WARNing about AC3. Add DATA=10 to /BLK_FACTOR:n switch so that
! "n" can be parsed. Add help strings to CMKEY and CMSWI parsing for
! better help on "?". Revise some noise words to confirm to TOPS-20
! EXEC. Add CM_SDH to CMNOD to prevent seeing both "source filespec" and
! "node name" (since source filespec implies node name).
! Gregory A. Scott 24-Mar-86
!
! 75 Fix /KEY: switch to support key option flags CHANGES, NOCHANGES,
! DUPLICATES and NODUPLICATES and to support the correct syntax!
! Change /KEY: action routine so that the key command text is saved
! in a buffer in the REQBLK and parsed later.
! Sandy Clemens 19-Mar-86
!
! 73 Make all /WARNINGS and /USAGE information be stored in the REQBLK
! structure (not in global flags -- this won't work for queued
! requests).
! Sandy Clemens 4-Mar-86
!
! 72 Define WARNINGS_COUNT and if /WARNINGS:n was not specified by the
! user, then set WARNINGS_COUNT to the default which is 1. Remove
! WARNING_MAX.
! Sandy Clemens 3-Mar-86
!
! 70 Add setting F_RAT, F_RFM, F_NONRMS bits in SFLAGS and DFLAGS when RAT,
! RFM or NONRMS seen. Add CONTEXTs to /RMS:INDEXED, /RMS:SEQUENTIAL,
! /RMS:RELATIVE. Remove "need_usage" (not used anymore).
! Sandy Clemens 25-Feb-86
!
! 65 Change command switches: 1) remove /DATATYPE, add /USAGE 2) remove
! /ORGANIZATION, add /FILE_FORMAT. Change NAM$V_PWD bit to NAM$V_SYNCHK
! bit in SRCFIL and DSTFIL routines.
! Sandy Clemens 12-Feb-86
!
! 64 Add GLOBAL patpar_warn which is a flag that gets set if the
! DIU$_PATPAR informational condition is seen, and which is
! cleared when either DIU$_PARDES error condition or DIU$_PARTRA
! error condition is seen.
! Sandy Clemens 15-Jan-86
!
! 61 Remove $CMOFI (output file function) from APPEND_GET_INPUT,
! COPY_GET_INPUT, DELETE_GET_FILESPEC, PRINT_GET_INPUT,
! SUBMIT_GET_INPUT and RENAME_GET_INPUT command table states.
! These were work-arounds for a COMND bug which has now been fixed,
! and they now cause DIU problems. FILE: DIUC20.B36.
! Sandy Clemens 16-Dec-85
!
! 60 Implement /OUTPUT: switch for DIRECTORY.
! Sandy Clemens 16-Dec-85
!
! 56 Fix routine FILE_ARGUMENT so /TRANSFORM and /DESCRIPTION switches
! work. Reorder the action routines alphabetically. Implement TAKE
! switches (/ECHO, /VERIFY, /NOECHO, /NOVERIFY). Remove the "transfer"
! switches from PRINT and SUBMIT commands. Add /WAIT to STOP command.
! Sandy Clemens 3-Dec-85
!
! 52 Fix bug in $STR_SCANs in DECIDE_QUEUE routine. When setting up
! for prompting, make sure the PROMPT_CHARACTER is ASCIZ!
! Sandy Clemens 12-Nov-85
!
! 46 Make the queue decision smarter. Remove /NOTIFY:FAILURE code.
! Clean up SET DEFAULTS code. JOBNAME was being set to trash for
! a local to local request -- set it to "LOCAL" instead!
! Sandy Clemens 4-Nov-85
!
! 44 Add missing SET DEFAULTS switches /DEFERRED and /NODEFERRED.
! Sandy Clemens 17-Oct-85
!
! 43 Make routine REQUEST make a more intelligent decision about
! whether to queue a requeust. Make numerous switches which
! were the old FTS format be the new DIU format.
! Make /CARRIAGE_CONTROL work. Fix the /TRANSFORM switch which
! was being processed by /DESCRIPTION states... Add CRLF after
! "request queued" message.
! Sandy Clemens 11-Oct-85
!
! V01-042 Sandy Clemens 11-Oct-85
! Make 'mjob' and 'mst_flag' EXTERNAL rather than OWN variables.
!
! V01-041 Sandy Clemens 10-Oct-85
! Implement PUSH, SPAWN and EXECUTE commands in DIUC20.B36.
!
! V01-031 Sandy Clemens 17-Sep-85
! Change name of DIU-COMMAND.R36 to DIUCOMMAND.R36 to make
! porting to TOPS-10 easier. (TOPS-10 will truncate DIUCOMMAND
! to DIUCOM, but cannot bypass the "-").
!
! V01-027 Andy Nourse 22-Aug-85
! Fix absent rename output file, make take prompt after finishing.
!
! V01-024 Andy Nourse 18-July-85
! Put in /DESCRIPTION, /TRANSFORM, /KEY and /WARNING_COUNT
!
! V01-002 RDF0002 Rick Fricchione 17-Jan-1985
! Fix ridiculous first attempt at filespec storage logic and
! tag buffers. Make global tags get stored prior to filespecs
! and make sure $ETG and $NUL are in correct locations.
!
!
! V01-001 RDF0001 Rick Fricchione 17-Dec-1984
! Original version. Convert from FTSCMD, rewrite to create
! request blocks for back end which resemble VAX DIU blocks.
! Have parser dump tag values into request file buffers, and
! store filespecs in formatted manner.
!
!
!--
%SBTTL 'Forward Routine'
FORWARD ROUTINE
ADD_TAG : NOVALUE, ! Add a file attribute tag
C$CONTROL_C : NOVALUE, ! Handle Control C interrupt
DECIDE_QUEUE, ! decide to queue a request or not
DESCRIPTION : NOVALUE, ! /DESCRIPTION
DIUCMD, ! Initializes and calls COMAND
DSTFIL : NOVALUE, ! Eat the destination file
DSTNOD : NOVALUE, ! Eat the dest nodeid (sometimes)
EXIT_COMMAND : NOVALUE, ! EXIT command action
FILE_ARGUMENT : NOVALUE, ! Handle switch with filespec argument
FILFMT_SWITCH : NOVALUE, ! Store a file format switch
FOP_SWITCH : NOVALUE, ! Set FOP bit for switch
HELP : NOVALUE, ! Print help text
INIT_REQUEST : NOVALUE, ! Init request stuff
LIST_SWITCH : NOVALUE, ! Set verbosity level of directory
MAKEPROMPT : NOVALUE, ! Make the prompt proper
MANIPULATE_REQUESTS : NOVALUE, ! MODIFY, KILL, HOLD, RELEASE confirm
MKJOBNAME : NOVALUE, ! Make a job name
PARERR : NOVALUE, ! Punt a parse off
PRE_INPUT : NOVALUE, ! Set up for reading input filespecs
PRE_MANIPULATE : NOVALUE, ! MODIFY, KILL, HOLD, RELEASE seen
PRE_OUTPUT : NOVALUE, ! Prepare for terminal output
PRE_TAKE : NOVALUE, ! TAKE echo/noecho default setter
PUSH : NOVALUE, ! PUSH command
QUEUE : NOVALUE, ! /QUEUE
RAT_SWITCH : NOVALUE, ! Store a record-attribute switch
REQUEST : NOVALUE, ! Run again at end of line
REQ_ID : NOVALUE, ! Store request ID (for MODIFY, etc)
RFM_SWITCH : NOVALUE, ! Store a record-format switch
RSTSTA : NOVALUE, ! Restore state if necessary
SAVE_NUMBER : NOVALUE, ! Universal numeric arg saver
SET_TAKE_MODE : NOVALUE, ! SET TAKE confirm action routine
SET_TAKE_SWITCH : NOVALUE, ! SET TAKE keyword action routine
SH_DEFAULTS : NOVALUE, ! SHOW DEFAULTS
SH_MJOB : NOVALUE, ! SHOW MAXIMUM_SIMULTANEOUS_REQUESTS
SH_QUEUE : NOVALUE, ! SHOW QUEUE
SH_TAKE : NOVALUE, ! SHOW TAKE
SH_VERSION : NOVALUE, ! SHOW VERSION
SRCFIL : NOVALUE, ! Eat the source filespec
SRCNOD : NOVALUE, ! Eat the source nodeid
START : NOVALUE, ! Opr START command confirmed
STOP : NOVALUE, ! Opr STOP command confirmed
STOP_SWITCH : NOVALUE, ! Parse switch to STOP
ST_ACCOUNT : NOVALUE, ! Store Account for SET DEFAULTS
ST_BYTE : NOVALUE, ! /VFC:n,/VFC:(n:m)
ST_DAYS : NOVALUE, ! Store days in future
ST_DEFAULTS : NOVALUE, ! SET DEFAULTS action routine
ST_DNODE : NOVALUE, ! Store node name for SET DEFAULT n::
ST_FDAY : NOVALUE, ! Called on /AFTER:day_of_week
ST_FPDAY : NOVALUE, ! Called on /AFTER:day_of_week+HH:MM
ST_HALFWORD : NOVALUE, ! /FIXED:n, /VARIABLE:n
ST_HELP : NOVALUE, ! Store value of HELP argument
ST_JOBNAME : NOVALUE, ! Store job name (for MODIFY, etc)
ST_KEY : NOVALUE, ! /KEY:xxx
ST_LOG : NOVALUE, ! /LOG_FILE:filespec
ST_MJOB : NOVALUE, ! SET MAXIMUM_SIMULTANEOUS_REQUESTS
ST_NODE : NOVALUE, ! Store node name (for MODIFY, etc)
ST_NOTIFY : NOVALUE, ! Store /NOTIFY value
ST_NTAD : NOVALUE, ! Clear time-and-date switch arg
ST_PASSWORD : NOVALUE, ! Store Password for SET DEFAULTS
ST_PRIORITY : NOVALUE, ! /PRIORITY:n
ST_RIGHTBRACKET : NOVALUE, ! Store matching right bracket
ST_RTAD : NOVALUE, ! Store relative time switch arg
ST_R_USERNAME : NOVALUE, ! Store user name (for MODIFY, etc)
ST_SEQUENCE_ARGUMENT : NOVALUE, ! Store /SEQUENCE value
ST_TAD : NOVALUE, ! Store time-and-date switch arg
ST_UPA : NOVALUE, ! Store /ACCESS:"u p a" value
ST_USERNAME : NOVALUE, ! Store user name (for SET DEFAULTS)
ST_VERBOSITY : NOVALUE, ! Store SHOW QUEUE switch
ST_WARNING_COUNT : NOVALUE, ! /WARNINGS:n
SW_ARGUMENT : NOVALUE, ! Handle switch with argument
TAKE : NOVALUE, ! TAKE command
TAKE_SWITCH : NOVALUE, ! Parse switch to TAKE
TRACE_ACTION : NOVALUE, ! TRACE command action
TRANSFORM : NOVALUE; ! /TRANSFORM
%SBTTL 'Library and Require Files'
LIBRARY 'BLI:XPORT'; ! Not much else in BLISS-36
LIBRARY 'DIUMLB'; ! Usage type literals, etc.
LIBRARY 'DIUCOMMAND'; ! Command definitions
LIBRARY 'RMSINT'; ! RMS stuff
LIBRARY 'FAO'; ! FAO stuff
LIBRARY 'DIU'; ! DIU Definitions
LIBRARY 'MONSYM'; ! TOPS-20 monitor symbols
REQUIRE 'JSYSDEF'; ! JSYS definitions
REQUIRE 'DIUPATPORTAL'; ! Define long names for PAT parser rtns
%SBTTL 'External Declarations'
EXTERNAL cmderp, ! Error message for noparse
cmderr, ! "return on error" flag
cmdnpt, ! State to return to on a noparse
cmdrpr, ! Action routine to call on reparse
cmdrpt, ! Command state for beginning reparse
cmdsta, ! Next command state
defaults : REF $DEF_DECL, ! Pointer to defaults chain
def_dir, ! Default directory string
def_root : $DEF_DECL, ! Pointer to default defaults
hlptab, ! Topics list for help command
mjob, ! Maximum simultaneous transfers
mst_flag : VOLATILE, ! We are (yet) the spooler if nonzero
njob, ! Requests currently in progress
shutdown; ! 1 if we are shutting down
EXTERNAL ROUTINE
COMAND, ! Interpret table of commands
DEF$CREATE, ! Create a defaults node
DEF$FIND, ! Find a defaults node
DEF$REQUEST, ! Fill in default info for request
DIU$ABORT, ! DIU error messages and handler
DIU$DO, ! Process a request block
DIU$MESSAGE, ! DIU message from status
DIU$MODIFY, ! DIU modifiy job in queue
DIU$SYNTAX_DESCRIPTION, ! (macro) Check syntax of description
DIU$SYNTAX_TRANSFORM, ! (macro) Check syntax of transform
HLPINI : NOVALUE, ! Init the help table
IP_CHECK, ! See if there is (yet) a spooler
IP_ENTER, ! Send IPCF message to queue job
MOVEAZ, ! Move ASCIZ strings
Q$REQ_BLOCK_INIT : NOVALUE, ! Init a request block
RCLINE, ! Rescan command line
S$CRIF : NOVALUE, ! Print a CR if needed
S$HALT : NOVALUE, ! Halt this fork
S$NODE_CHECK, ! See if a node is legal
S$NOINT : NOVALUE, ! Turn off the interrupt system
S$OKINT : NOVALUE, ! Turn on the interrupt system
S$TIME, ! System time
SCHED : NOVALUE, ! Schedular
SHODEF : NOVALUE, ! Show defaults
SHOQUE : NOVALUE, ! Show Queue
SP$START : NOVALUE, ! Start the spooler
SP$STOP : NOVALUE; ! Stop the spooler
%SBTTL 'Macro Declarations'
! Macro to produce ASCII CR, LF; commonly used with %STRING operator.
MACRO crlf = %CHAR($CHCRT,$CHLFD)%;
! Macro to produce a parse error, returning an optional value.
MACRO PE(text,value) = BEGIN
PARERR(CH$PTR(UPLIT(%ASCIZ %STRING(text,crlf))));
RETURN value; ! Toto, we're not in Kansas any more
END %;
! $TTY_FAO prints the specified string to the terminal (only the terminal)
MACRO $TTY_FAO (control) =
BEGIN
! Dynamic descriptors don't seem to work here. $STR_DESC_INIT wouldn't
! seem to work. I think that the evidence points to this being (yet)
! another BLISS compiler bug. BOUNDED strings on the stack work, though.
LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=control), ! FAO control string
fao_buf : VECTOR[CH$ALLOCATION(200)], ! FAO buffer
fao_desc : $STR_DESCRIPTOR(CLASS=BOUNDED, ! FAO output descr
STRING=(200,CH$PTR(fao_buf)));
$FAO(fao_ctl,0,fao_desc,%REMAINING); ! Format the text
$XPO_PUT(IOB=tty, STRING=fao_desc); ! Print the string
END%;
%SBTTL 'Command State Tables'
! Macros for the command state table follow
MACRO state(S,T) = S,T%;
MACRO evens[S,T] = T%;
MACRO assign_states[S,T] = S = %COUNT%;
MACRO STATES = ! The state table definition follows
! (for the next 1700 lines or so...)
STATE (NEW_COMMAND,
$COMAND_FLDDB(FUNCTION=$CMINI,
NEXT=ACCEPT_COMMAND,
ACTION=INIT_REQUEST)),
STATE (ACCEPT_COMMAND,
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('DIU command,'),
DATA=COMMAND_TABLE,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
ACTION=PRE_TAKE,
FLAGS=CM_SDH,
HELP=PP('"@" followed by indirect command file'),
DATA=PP('@'),
NEXT=TAKE_FILE))),
! APPEND command
STATE (APPEND_NOISE_INPUT, ! Input noise word
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('from'),
NEXT=APPEND_GET_INPUT)),
STATE (APPEND_GET_INPUT, ! Get input filespec for APPEND
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=SOURCE_HELP,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=PP('global file switch,'),
DATA=APPEND_GLOB_SWITCH_TABLE,
NEXT=APPEND_GET_INPUT,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=APPEND_GET_INPUT,
BREAK=KEY_BREAK)))))),
STATE (APPEND_NOISE_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('to'),
ACTION=PRE_OUTPUT,
NEXT=APPEND_GET_OUTPUT)),
STATE (APPEND_GET_OUTPUT, ! Get possibly-existing output filespec
$COMAND_FLDDB(FUNCTION=$CMCMA,
ACTION=PRE_INPUT,
NEXT=APPEND_GET_INPUT,
FLAGS=CM_SDH,
HELP=ADDSOURCE_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=INPUT_SWITCH_HELP,
DATA=INP_SWITCH_TABLE,
NEXT=APPEND_GET_OUTPUT,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=APPEND_GET_OUTPUT))))))),
STATE (APPEND_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=OUTPUT_SWITCH_HELP,
DATA=APP_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=APPEND_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=APPEND_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE)))),
! COPY command
STATE (COPY_NOISE_INPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('from'),
NEXT=COPY_GET_INPUT)),
STATE (COPY_GET_INPUT,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=SOURCE_HELP,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=PP('global file switch,'),
DATA=COPY_GLOB_SWITCH_TABLE,
NEXT=COPY_GET_INPUT,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=COPY_GET_INPUT,
BREAK=KEY_BREAK)))))),
STATE (COPY_NOISE_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('to'),
ACTION=PRE_OUTPUT,
NEXT=COPY_GET_OUTPUT)),
STATE (COPY_GET_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMCMA,
ACTION=PRE_INPUT,
NEXT=COPY_GET_INPUT,
FLAGS=CM_SDH,
HELP=ADDSOURCE_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
BREAK=KEY_BREAK,
HELP=INPUT_SWITCH_HELP,
DATA=INP_SWITCH_TABLE,
NEXT=COPY_GET_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=COPY_GET_OUTPUT))))))),
STATE (COPY_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=OUTPUT_SWITCH_HELP,
DATA=OUT_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=COPY_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=COPY_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE)))),
! DELETE command
STATE (DELETE_NOISE_INPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('files'),
NEXT=DELETE_GET_FILESPEC)),
STATE (DELETE_GET_FILESPEC,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=PP('files to delete'),
FLAGS=CM_SDH,
ACTION=SRCFIL,
BREAK=USER_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=DELETE_GET_FILESPEC,
BREAK=KEY_BREAK))))),
STATE (DELETE_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCMA,
ACTION=PRE_INPUT,
NEXT=DELETE_GET_FILESPEC,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=DELETE_CONFIRM,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE)))),
! DIRECTORY command
STATE (DIRECTORY_NOISE_INPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('of files'),
NEXT=DIRECTORY_GET_INPUT)),
STATE (DIRECTORY_GET_INPUT,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=SOURCE_HELP,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=DIRECTORY_HELP,
DATA=DIRECTORY_TABLE,
NEXT=DIRECTORY_GET_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=DIRECTORY_GET_INPUT,
BREAK=USER_BREAK)))))),
STATE (DIRECTORY_NOISE_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('to file'),
ACTION=PRE_OUTPUT,
NEXT=DIRECTORY_GET_OUTPUT)),
STATE (DIRECTORY_GET_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMCMA,
DEFAULT=CH$PTR(def_fs),
ACTION=PRE_INPUT,
NEXT=DIRECTORY_GET_INPUT,
FLAGS=CM_SDH,
HELP=ADDSOURCE_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=DIRECTORY_HELP,
DATA=DIRECTORY_TABLE,
NEXT=DIRECTORY_GET_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=DIRECTORY_GET_OUTPUT,
BREAK=KEY_BREAK))))))),
STATE (DIRECTORY_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=DIRECTORY_HELP,
DATA=DIRECTORY_TABLE,
NEXT=DIRECTORY_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=DIRECTORY_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE)))),
! PRINT command
STATE (PRINT_NOISE_INPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('files'),
NEXT=PRINT_GET_INPUT)),
STATE (PRINT_GET_INPUT,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=SOURCE_HELP,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=PRINT_GET_INPUT,
BREAK=KEY_BREAK))))),
STATE (PRINT_GET_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCMA,
ACTION=PRE_INPUT,
NEXT=PRINT_GET_INPUT,
FLAGS=CM_SDH,
HELP=ADDSOURCE_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=PRINT_GET_OUTPUT,
BREAK=USER_BREAK))))))),
! SUBMIT command
STATE (SUBMIT_NOISE_INPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('file'),
NEXT=SUBMIT_GET_INPUT)),
STATE (SUBMIT_GET_INPUT,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=SOURCE_HELP,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=SUBMIT_GET_INPUT,
BREAK=KEY_BREAK))))),
STATE (SUBMIT_GET_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCMA,
ACTION=PRE_INPUT,
NEXT=SUBMIT_GET_INPUT,
FLAGS=CM_SDH,
HELP=ADDSOURCE_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=SUBMIT_GET_OUTPUT,
BREAK=USER_BREAK))))))),
! RENAME command
STATE (RENAME_NOISE_INPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('existing file'),
NEXT=RENAME_GET_INPUT)),
STATE (RENAME_GET_INPUT,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_INPUT_ACCESS,
HELP=SOURCE_HELP,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=SRCNOD,
NEXT=GET_REMOTE_INPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=SRCNOD,
NEXT=GET_INPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=RENAME_GET_INPUT,
BREAK=KEY_BREAK))))),
STATE (RENAME_NOISE_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('to be'),
ACTION=PRE_OUTPUT,
NEXT=RENAME_GET_OUTPUT)),
STATE (RENAME_GET_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=RENAME_GET_OUTPUT))))),
! Command states for parsing input filespecs
STATE (GET_INPUT_ACCESS, ! Read access string after nodename
$COMAND_FLDDB(FUNCTION=$CMQST,
NEXT=GET_INPUT_CC,
HELP=ACCESS_HELP,
FLAGS=CM_SDH,
CONTEXT=ACC_EMBEDDED,
ACTION=ST_UPA)),
STATE (GET_INPUT_CC, ! Get ::
$COMAND_FLDDB(FUNCTION=$CMTOK,
HELP=PP('"::" followed by remote filespec'),
FLAGS=CM_SDH,
NEXT=GET_REMOTE_INPUT,
DEFAULT=PP('::'),
DATA=PP('::'))),
STATE (GET_REMOTE_INPUT, ! Get remote input filespec after node
$COMAND_FLDDB(FUNCTION=$CMQST,
HELP=PP('quoted remote source filespec'),
CONTEXT=FILE_QUOTED,
FLAGS=CM_SDH,
ACTION=SRCFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
HELP=PP('remote source filespec'),
FLAGS=CM_SDH,
ACTION=SRCFIL))),
! Generic action routines for parsing output side of SUBMIT and PRINT
STATE (NOISE_AFTER_COPY,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('after copying to'),
ACTION=PRE_OUTPUT,
NEXT=GET_OUTPUT)),
STATE (GET_OUTPUT, ! Get output filespec
$COMAND_FLDDB(FUNCTION=$CMCMA,
ACTION=PRE_INPUT,
NEXT=PRINT_GET_INPUT, ! sure?
FLAGS=CM_SDH,
HELP=ADDSOURCE_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
NEXT=GET_OUTPUT_ACCESS,
HELP=DESTINATION_HELP,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
CONTEXT=VALID_NODE,
FLAGS=CM_SDH+CM_PO,
ACTION=DSTNOD,
NEXT=GET_REMOTE_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
FLAGS=CM_SDH,
ACTION=DSTNOD,
NEXT=GET_OUTPUT_ACCESS,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
BREAK=KEY_BREAK,
NEXT=GET_OUTPUT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE))))))),
! Generic action routines for parsing output files after VMS style nodespec
STATE (GET_OUTPUT_ACCESS,
$COMAND_FLDDB(FUNCTION=$CMQST,
NEXT=GET_OUTPUT_CC,
HELP=ACCESS_HELP,
FLAGS=CM_SDH,
CONTEXT=ACC_EMBEDDED,
ACTION=ST_UPA)),
STATE (GET_OUTPUT_CC,
$COMAND_FLDDB(FUNCTION=$CMTOK,
HELP=PP('"::" followed by remote filespec'),
FLAGS=CM_SDH,
DEFAULT=PP('::'),
NEXT=GET_REMOTE_OUTPUT,
DATA=PP('::'))),
STATE (GET_REMOTE_OUTPUT,
$COMAND_FLDDB(FUNCTION=$CMQST,
HELP=PP('quoted remote destination filespec'),
CONTEXT=FILE_QUOTED,
FLAGS=CM_SDH,
ACTION=DSTFIL,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFIL,
HELP=PP('remote destination filespec'),
FLAGS=CM_SDH,
ACTION=DSTFIL))),
! Generic confirm routine for any command that takes request switches
STATE (REQUEST_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=REQ_HELP,
DATA=REQ_SWITCH_TABLE,
NEXT=REQUEST_CONFIRM,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=REQUEST,
NEXT=EXIT_STATE))),
! MODIFY command
STATE (MODIFY,
$COMAND_FLDDB(FUNCTION=$CMNOI,
NEXT=MODIFY_GET_REQUEST_ID,
DATA=PP('request'))),
STATE (MODIFY_GET_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMNUM,
DATA=10,
NEXT=MODIFY_GOT_REQUEST_ID,
HELP=PP('request queue entry,'),
ACTION=REQ_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
ACTION=ST_NODE,
FLAGS=CM_PO,
NEXT=MODIFY_GET_REQUEST_ID_N,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('<'),
HELP=ANGLE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C'>',
NEXT=MODIFY_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('['),
HELP=SQUARE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C']',
NEXT=MODIFY_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=MODIFY_GOT_REQUEST_ID)))))),
STATE (MODIFY_GET_REQUEST_ID_N, ! Got node, get <u> or job
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('<'),
HELP=ANGLE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C'>',
NEXT=MODIFY_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('['),
HELP=SQUARE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C']',
NEXT=MODIFY_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=MODIFY_GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=MODIFY_GOT_REQUEST_ID,
HELP=MODIFY_HELP,
DATA=MODIFY_TABLE,
BREAK=KEY_BREAK))))),
STATE (MODIFY_GET_REQUEST_USER, ! Get Username for request
$COMAND_FLDDB(FUNCTION=$CMUSR,
NEXT=MODIFY_GET_REQUEST_USER_CLOSE,
ACTION=ST_R_USERNAME,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
ACTION=ST_R_USERNAME,
NEXT=MODIFY_GET_REQUEST_USER_CLOSE))),
STATE (MODIFY_GET_REQUEST_USER_CLOSE, ! Get Close bracket
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=CH$PTR(RIGHTBRACKET),
DEFAULT=CH$PTR(RIGHTBRACKET), ! Set up to match
NEXT=MODIFY_GET_REQUEST_ID_D)),
STATE (MODIFY_GET_REQUEST_ID_D, ! Have user, get optional jobname
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=MODIFY_GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=MODIFY_GOT_REQUEST_ID,
HELP=MODIFY_HELP,
DATA=MODIFY_TABLE,
BREAK=KEY_BREAK))),
STATE (MODIFY_GOT_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=GOT_REQUEST_ID,
HELP=MODIFY_HELP,
DATA=MODIFY_TABLE,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=MANIPULATE_REQUESTS))),
! CANCEL, KILL, HOLD, NEXT, RELEASE commands
STATE (NOISE_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMNOI,
NEXT=GET_REQUEST_ID,
DATA=PP('request'))),
STATE (GET_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMNUM,
NEXT=GOT_REQUEST_ID,
DATA=10,
HELP=PP('request queue entry,'),
ACTION=REQ_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
ACTION=ST_NODE,
FLAGS=CM_PO,
NEXT=GET_REQUEST_ID_N,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('<'),
HELP=ANGLE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C'>',
NEXT=GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('['),
HELP=SQUARE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C']',
NEXT=GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=GOT_REQUEST_ID)))))),
STATE (GET_REQUEST_ID_N, ! Got NODE::, see if any <u> or job
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('<'),
HELP=ANGLE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C'>',
NEXT=GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('['),
HELP=SQUARE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C']',
NEXT=GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=MANIPULATE_REQUESTS))))),
STATE (GET_REQUEST_USER, ! Got a < or [, parse user and > or ]
$COMAND_FLDDB(FUNCTION=$CMUSR,
NEXT=GET_REQUEST_USER_CLOSE,
ACTION=ST_R_USERNAME,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
ACTION=ST_R_USERNAME,
NEXT=GET_REQUEST_USER_CLOSE))),
STATE (GET_REQUEST_USER_CLOSE, ! Get Close bracket for username
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=CH$PTR(RIGHTBRACKET),
DEFAULT=CH$PTR(RIGHTBRACKET), ! Set up to match
NEXT=GET_REQUEST_ID_D)),
STATE (GET_REQUEST_ID_D, ! Got <user>, check for jobname
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=MANIPULATE_REQUESTS))),
STATE (GOT_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=MANIPULATE_REQUESTS)),
! INFORMATION command
STATE (NOISE_INFO,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('about'),
NEXT=SHOW_OPTION)),
! SHOW command
STATE (NOISE_SHOW,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('information about'),
NEXT=SHOW_OPTION)),
STATE (SHOW_OPTION,
$COMAND_FLDDB(FUNCTION=$CMKEY,
DATA=SHOW_TABLE)),
! SHOW QUEUE command
STATE (SHOW_QUEUE,
$COMAND_FLDDB(FUNCTION=$CMNOI,
NEXT=SHQ_GET_REQUEST_ID,
DATA=PP('request'))),
STATE (SHQ_GET_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMNUM,
DATA=10,
NEXT=SHQ_GOT_REQUEST_ID,
HELP=PP('request queue entry,'),
ACTION=REQ_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
ACTION=ST_NODE,
FLAGS=CM_PO,
NEXT=SHQ_GET_REQUEST_ID_N,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('<'),
HELP=ANGLE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C'>',
NEXT=SHQ_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('['),
HELP=SQUARE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C']',
NEXT=SHQ_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=SHQ_GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=SHQ_GOT_SWITCH,
HELP=SHOW_QUEUE_HELP,
DATA=SHQ_TABLE,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=SH_QUEUE)))))))),
STATE (SHQ_GET_REQUEST_ID_N, ! Got node, see if <u> or jobname
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('<'),
HELP=ANGLE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C'>',
NEXT=SHQ_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('['),
HELP=SQUARE_USER_HELP,
FLAGS=CM_SDH,
ACTION=ST_RIGHTBRACKET,
CONTEXT=%C']',
NEXT=SHQ_GET_REQUEST_USER,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=SHQ_GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=SHQ_GOT_SWITCH,
HELP=SHOW_QUEUE_HELP,
DATA=SHQ_TABLE,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=SH_QUEUE)))))),
STATE (SHQ_GET_REQUEST_USER, ! Got < or [, get user and ] or >
$COMAND_FLDDB(FUNCTION=$CMUSR,
NEXT=SHQ_GET_REQUEST_USER_CLOSE,
ACTION=ST_R_USERNAME,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
ACTION=ST_R_USERNAME,
NEXT=SHQ_GET_REQUEST_USER_CLOSE))),
STATE (SHQ_GET_REQUEST_USER_CLOSE, ! Get close bracket after user
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=CH$PTR(RIGHTBRACKET),
DEFAULT=CH$PTR(RIGHTBRACKET), ! Set up to match
NEXT=SHQ_GET_REQUEST_ID_D)),
STATE (SHQ_GET_REQUEST_ID_D, ! Got [user] or <user>, get jobname
$COMAND_FLDDB(FUNCTION=$CMFLD,
ACTION=ST_JOBNAME,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=JOB_NAME_HELP,
NEXT=SHQ_GOT_REQUEST_ID,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=SHQ_GOT_SWITCH,
HELP=SHOW_QUEUE_HELP,
DATA=SHQ_TABLE,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=SH_QUEUE)))),
STATE (SHQ_GOT_REQUEST_ID,
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=SHQ_GOT_SWITCH,
HELP=SHOW_QUEUE_HELP,
DATA=SHQ_TABLE,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=SH_QUEUE))),
STATE (SHQ_GOT_SWITCH,
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=SH_QUEUE)),
! SHOW DEFAULTS command
STATE (SHOW_DEFAULTS,
$COMAND_FLDDB(FUNCTION=$CMFLD,
DEFAULT=PP('*'),
FLAGS=CM_SDH+CM_PO,
HELP=PP('wild node specification to show defaults for'),
ACTION=SRCNOD,
BREAK=USER_BREAK,
NEXT=SHOW_DEFAULTS_CC)),
STATE (SHOW_DEFAULTS_CC,
$COMAND_FLDDB(FUNCTION=$CMTOK,
FLAGS=CM_SDH,
HELP=PP('optional "::" to terminate node spec'),
DEFAULT=PP('::'),
DATA=PP('::'),
NEXT=SHOW_DEFAULTS_CONFIRM)),
STATE (SHOW_DEFAULTS_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=SH_DEFAULTS,
NEXT=EXIT_STATE)),
! SHOW VERSION command
STATE (SHOW_VERSION,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=SH_VERSION,
NEXT=EXIT_STATE)),
! SHOW TAKE command
STATE (SHOW_TAKE,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=SH_TAKE,
NEXT=EXIT_STATE)),
! SHOW MAXIMUM_SIMULTANEOUS_REQUESTS command
STATE (SHOW_MJOB,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=SH_MJOB,
NEXT=EXIT_STATE)),
! SET command
STATE (SET_OPTION,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
DATA=SET_TABLE)),
STATE (SET_TAKE_DEFAULT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('default mode for TAKE commands,'),
DATA=SET_TAKE_TABLE)),
STATE (SET_TAKE_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=SET_TAKE_MODE,
NEXT=EXIT_STATE)),
STATE (SET_DEFAULTS,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('for'),
NEXT=SET_DEFAULTS_NODE)),
STATE (SET_DEFAULTS_NODE,
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('SWITCHES to set default for all requests'),
DEFAULT=PP('SWITCHES'),
FLAGS=CM_SDH,
DATA=SET_DEFAULTS_KEYWORD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNOD,
HELP=PP('specific node name to set default for'),
FLAGS=CM_SDH+CM_PO,
NEXT=SET_DEFAULTS_SWITCHES,
ACTION=ST_DNODE))),
STATE (SET_DEFAULTS_SWITCHES,
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=PP('switch to set default for,'),
DATA=DEF_SWITCHES,
NEXT=SET_DEFAULTS_SWITCHES,
BREAK=KEY_BREAK,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=ST_DEFAULTS,
NEXT=EXIT_STATE))),
STATE (SET_MJOB_N,
$COMAND_FLDDB(FUNCTION=$CMNUM,
DATA=10,
ACTION=SAVE_NUMBER,
HELP=PP(%STRING('Decimal number from 0 to ',
%NUMBER(MAX_MJOB))),
FLAGS=CM_SDH,
NEXT=SET_MJOB_CFM)),
STATE (SET_MJOB_CFM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=ST_MJOB,
NEXT=EXIT_STATE)),
! Get /ACCOUNT: argument
STATE (DEFAULT_ACCOUNT,
$COMAND_FLDDB(FUNCTION=$CMQST,
CONTEXT=ACC_QUOTED,
FLAGS=CM_SDH,
HELP=PP('"account" or next switch to be prompted for the account'),
ACTION=ST_ACCOUNT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
CONTEXT=ACC_UNQUOTED,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=PP('account'),
ACTION=ST_ACCOUNT))),
! Get /PASSWORD: argument
STATE (DEFAULT_PASSWORD,
$COMAND_FLDDB(FUNCTION=$CMQST,
CONTEXT=ACC_QUOTED,
FLAGS=CM_SDH,
HELP=PP('"password" or next switch to be prompted for the password'),
ACTION=ST_PASSWORD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
CONTEXT=ACC_UNQUOTED,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=PP('password'),
ACTION=ST_PASSWORD))),
! Get /USERID: argument
STATE (DEFAULT_USERID,
$COMAND_FLDDB(FUNCTION=$CMQST,
CONTEXT=ACC_QUOTED,
FLAGS=CM_SDH,
HELP=PP('"userid" or next switch to be prompted for the userid'),
ACTION=ST_USERNAME,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
CONTEXT=ACC_UNQUOTED,
BREAK=USER_BREAK,
FLAGS=CM_SDH,
HELP=PP('userid'),
ACTION=ST_USERNAME))),
! Get /ACCESS:"user pass acc"
STATE (GET_ACCESS_STRING,
$COMAND_FLDDB(FUNCTION=$CMQST,
CONTEXT=ACC_QUOTED,
FLAGS=CM_SDH,
HELP=ACCESS_HELP,
DEFAULT=PP('PROMPT'),
ACTION=ST_UPA,
MORE=
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('Access option,'),
DATA=ACCESS_TABLE))),
! Get /QUEUE: argument
STATE (GET_QUEUE_VALUE, ! Next is set by action routine
$COMAND_FLDDB(FUNCTION=$CMKEY,
DATA=QUEUE_TABLE,
DEFAULT=PP('YES'))),
! Get /LOG_FILE: output filespec
STATE (GET_LOG_FILESPEC,
$COMAND_FLDDB(FUNCTION=$CMFIL, ! Next is set by action routine
FLAGS=CM_SDH,
HELP=PP('LOG file specification'),
CONTEXT=TRUE,
DEFAULT=PP('DIU.LOG'),
ACTION=ST_LOG)),
! Get /DESCRIPTION: input file
STATE (GET_DESCRIPTION_FILESPEC,
$COMAND_FLDDB(FUNCTION=$CMFIL, ! Next is set by action routine
FLAGS=CM_SDH,
HELP=PP('description file specification'),
CONTEXT=1, ! Action routine should restore state
ACTION=DESCRIPTION)),
! Get /TRANSFORM: input file
STATE (GET_TRANSFORM_FILESPEC,
$COMAND_FLDDB(FUNCTION=$CMFIL, ! Next is set by action routine
FLAGS=CM_SDH,
HELP=PP('transform file specification'),
CONTEXT=1, ! Action routine should restore state
ACTION=TRANSFORM)),
! Get /PRIORITY: value
STATE (GET_PRIORITY_VALUE,
$COMAND_FLDDB(FUNCTION=$CMNUM,
DATA=10,
DEFAULT=PP('20'),
FLAGS=CM_SDH,
HELP=PP('priority, decimal number from 0 to 63'),
ACTION=ST_PRIORITY)),
! Get /WARNINGS: value
STATE (GET_WARNING_COUNT,
$COMAND_FLDDB(FUNCTION=$CMNUM, ! Next is remembered state
DATA=10,
DEFAULT=PP('1'),
HELP=PP('number of warnings to report per field,'),
ACTION=ST_WARNING_COUNT)),
! Get COPY's global /FILE_FORMAT:[RMS:type, IMAGE]
STATE (GET_COPY_GLOBAL_FILE_FORMAT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
DEFAULT=PP('RMS:'),
DATA=COPY_GLOB_FILE_FORMAT_TABLE,
HELP=FILE_FORMAT_HELP)),
! Get APPEND's global /FILE_FORMAT:RMS:SEQUENTIAL
STATE (GET_APPEND_GLOBAL_FILE_FORMAT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
DEFAULT=PP('RMS:'),
DATA=APPEND_GLOB_FILE_FORMAT_TABLE,
HELP=FILE_FORMAT_HELP)),
! Get input /FILE_FORMAT:[RMS:type, ISAM, FBINARY, IMAGE]
STATE (GET_INPUT_FILE_FORMAT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
HELP=FILE_FORMAT_HELP,
DEFAULT=PP('RMS:'),
DATA=INP_FILE_FORMAT_TABLE)),
! Get output /FILE_FORMAT: (RMS:type)
STATE (GET_OUTPUT_FILE_FORMAT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
DEFAULT=PP('RMS:'),
HELP=FILE_FORMAT_HELP,
DATA=OUT_FILE_FORMAT_TABLE)),
! Get /RMS: file organiztaion (RELATIVE, INDEXED, SEQUENTIAL)
STATE (GET_RMS_ORG,
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('RMS file organization,'),
DEFAULT=PP('SEQUENTIAL'),
DATA=RMS_ORG_TABLE)),
! Get /RMS:SEQUENTIAL file org
STATE (GET_RMS_SEQ_ORG,
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('RMS file organization,'),
DEFAULT=PP('SEQUENTIAL'),
DATA=RMS_SEQ_ORG_TABLE)),
! Get /RECORD_FORMAT: argument
! (FIXED:, VARIABLE:, STREAM:, VFC:, LINE_SEQUENCED_ASCII)
STATE (GET_RECORD_FORMAT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
HELP=PP('record format,'),
DATA=RECORD_FORMAT_TABLE)),
! Get /CARRIAGE_CONTROL: argument (CARRIAGE_RETURN, LINE_FEED)
STATE (GET_CARRIAGE_CONTROL,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
HELP=PP('record attribute,'),
DATA=RATTAB)),
! Get /FIXED:n, /LIBOL:n argument
STATE (GET_RECORD_SIZE,
$COMAND_FLDDB(FUNCTION=$CMNUM,
CONTEXT=DIU$K_FAB_MRS,
DATA=10,
DEFAULT=PP('512'),
HELP=PP('record size,'),
ACTION=ST_HALFWORD)), !Next is remembered state
! Get max record size for /VARIABLE:, /STREAM:[CARRIAGE_RETURN:n|LINE_FEED:n]
STATE (GET_MAXIMUM_RECORD_SIZE,
$COMAND_FLDDB(FUNCTION=$CMNUM,
CONTEXT=DIU$K_FAB_MRS,
DATA=10,
DEFAULT=PP('0'),
HELP=PP('maximum record size,'),
ACTION=ST_HALFWORD)), !Next is remembered state
! Get keyword or max record size for /STREAM:[n|CARRIAGE_RETURN:n|LINE_FEED:n]
STATE (GET_STREAM_OPTIONS,
$COMAND_FLDDB(FUNCTION=$CMNUM,
CONTEXT=DIU$K_FAB_MRS,
DATA=10,
DEFAULT=PP('0'),
HELP=PP('maximum record size,'),
ACTION=ST_HALFWORD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
DATA=STREAM_TABLE))),
! Get /VFC:n or /VFC:(n:m)
STATE (GET_VFC_ARGUMENT,
$COMAND_FLDDB(FUNCTION=$CMTOK,
DEFAULT=PP('2'),
HELP=PP('"(n:m)" for header and recordsize'),
FLAGS=CM_SDH,
DATA=PP('('),
NEXT=GET_VFC_HEADER_AND_RECORD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMNUM,
CONTEXT=DIU$K_FAB_FSZ,
DATA=10,
DEFAULT=PP('2'),
HELP=PP('fixed header size,'),
ACTION=ST_BYTE))),
STATE (GET_VFC_HEADER_AND_RECORD,
$COMAND_FLDDB(FUNCTION=$CMNUM,
CONTEXT=DIU$K_FAB_FSZ,
DATA=10,
DEFAULT=PP('2'),
HELP=PP('fixed header size,'),
ACTION=ST_BYTE,
NEXT=GET_VFC_COLON)),
STATE (GET_VFC_COLON,
$COMAND_FLDDB(FUNCTION=$CMTOK,
FLAGS=CM_SDH,
HELP=PP('":" followed by maximum record size'),
DATA=PP(':'),
NEXT=GET_VFC_RECORD_SIZE)),
STATE (GET_VFC_RECORD_SIZE,
$COMAND_FLDDB(FUNCTION=$CMNUM,
CONTEXT=DIU$K_FAB_MRS,
DATA=10,
DEFAULT=PP('0'),
HELP=PP('maximum record size,'),
ACTION=ST_HALFWORD,
NEXT=GET_VFC_THESIS)),
STATE (GET_VFC_THESIS,
$COMAND_FLDDB(FUNCTION=$CMTOK,
ACTION=RSTSTA,
DATA=PP(')'))),
! Get /KEY:foo and /KEY:(fee+fie,foe:CHANGES,foo:DUPLICATES)
STATE (GET_KEYS,
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('('),
CONTEXT=%C'(',
NEXT=GET_NEXT_KEY,
FLAGS=CM_SDH,
HELP=PP('"(" to specify multiple keys'),
ACTION=ST_KEY,
MORE=
$COMAND_FLDDB(FUNCTION=$CMFLD,
HELP=PP('field name for key'),
ACTION=ST_KEY,
CONTEXT=1))),
STATE (GET_NEXT_KEY,
$COMAND_FLDDB(FUNCTION=$CMFLD,
HELP=PP('field name for key'),
BREAK=KEY_BREAK,
CONTEXT=0,
ACTION=ST_KEY,
NEXT=GET_KEY_DELIMITER)),
STATE (GET_KEY_DELIMITER,
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP(':'),
ACTION=ST_KEY,
CONTEXT=%C':',
FLAGS=CM_SDH,
HELP=PP('":" to specify key options'),
NEXT=GET_KEY_OPTION,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP(','),
ACTION=ST_KEY,
CONTEXT=%C',',
FLAGS=CM_SDH,
HELP=PP('"," followed by another key'),
NEXT=GET_NEXT_KEY,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP('+'),
ACTION=ST_KEY,
CONTEXT=%C'+',
FLAGS=CM_SDH,
HELP=PP('"+" followed by another key segment'),
NEXT=GET_NEXT_KEY,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP(')'),
FLAGS=CM_SDH,
HELP=PP('")" to end list of keys'),
ACTION=ST_KEY,
CONTEXT=%C')'))))),
STATE (GET_KEY_OPTION,
$COMAND_FLDDB(FUNCTION=$CMKEY,
HELP=PP('key option,'),
DATA=KEY_TABLE)),
STATE (GET_KEY_OPTION_DELIM,
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP(':'),
ACTION=ST_KEY,
CONTEXT=%C':',
FLAGS=CM_SDH,
HELP=PP('":" to specify additional key options'),
NEXT=GET_KEY_OPTION,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP(','),
ACTION=ST_KEY,
CONTEXT=%C',',
FLAGS=CM_SDH,
HELP=PP('"," followed by another key'),
NEXT=GET_NEXT_KEY,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
DATA=PP(')'), ! Next is remembered state
FLAGS=CM_SDH,
HELP=PP('")" to end list of keys'),
ACTION=ST_KEY,
CONTEXT=%C')')))),
! Get /AFTER: and /DEADLINE: argument
STATE (GET_DATE_TIME, ! Get [dd-mmm-yy hh:mm:ss|+nd hh:mm]
$COMAND_FLDDB(FUNCTION=$CMTAD,
DATA=CM_IDA+CM_ITM,
ACTION=ST_TAD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTAD,
DATA=CM_ITM,
ACTION=ST_TAD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTAD,
DATA=CM_IDA,
ACTION=ST_TAD,
MORE=
$COMAND_FLDDB(FUNCTION=$CMKEY,
DATA=DAYS_TABLE,
HELP=PP('day of the week or TODAY'),
FLAGS=CM_SDH,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
HELP=PP('"+" to enter amount of time from now'),
FLAGS=CM_SDH,
DATA=PP('+'),
NEXT=GET_RELATIVE_DATE_TIME)))))),
STATE (GET_RELATIVE_DATE_TIME, ! Get + hh:mm etc
$COMAND_FLDDB(FUNCTION=$CMTAD,
FLAGS=CM_SDH,
HELP=PP('hours:minutes from now'),
DATA=CM_ITM+CM_NCI+IDTNC_BLOCK,
ACTION=ST_RTAD, !NEXT is set by action routine
MORE=
$COMAND_FLDDB(FUNCTION=$CMNUM,
DATA=10,
FLAGS=CM_SDH,
HELP=PP('number of days from now followed by "D"'),
ACTION=ST_DAYS,
NEXT=GET_D))),
STATE (GET_D, ! Get d from nnd
$COMAND_FLDDB(FUNCTION=$CMTOK,
FLAGS=CM_SDH,
HELP=PP('"D" to specify number of days from now'),
DATA=PP('D'),
NEXT=GET_RELATIVE_TIME,
MORE=
$COMAND_FLDDB(FUNCTION=$CMTOK,
FLAGS=CM_SDH,
DATA=PP('d'),
NEXT=GET_RELATIVE_TIME))),
STATE (GET_RELATIVE_TIME, ! Get hh:mm of + nnd hh:mm
$COMAND_FLDDB(FUNCTION=$CMTAD,
HELP=PP('hours:minutes from now'),
FLAGS=CM_SDH,
DATA=CM_ITM+CM_NCI+IDTNC_BLOCK,
DEFAULT=PP('00:00'),
ACTION=ST_RTAD)),
STATE (GOT_DAY_OF_WEEK,
$COMAND_FLDDB(FUNCTION=$CMTOK,
HELP=PP('optional "+" to add amount of time'),
DATA=PP('+'),
DEFAULT=PP('+00:00'),
FLAGS=CM_SDH,
NEXT=GOT_DAY_OF_WEEK_PLUS)),
STATE (GOT_DAY_OF_WEEK_PLUS,
$COMAND_FLDDB(FUNCTION=$CMTAD,
HELP=PP('hours:minutes'),
FLAGS=CM_SDH,
DATA=CM_ITM+CM_NCI+IDTNC_BLOCK,
DEFAULT=PP('00:00'),
ACTION=ST_FPDAY)),
! Get /NOTIFY: Argument
STATE (NOTIFY_ARGUMENT, ! /NOTIFY:TERMINAL, /NOTIFY:MAIL
$COMAND_FLDDB(FUNCTION=$CMKEY,
DEFAULT=PP('TERMINAL'),
DATA=NOTIFY_TABLE)),
! Get /SEQUENCE: argument
STATE (SEQUENCE_ARGUMENT,
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=KEY_BREAK,
DEFAULT=PP('ABORT_ON_ERROR'),
DATA=SEQUENCE_TABLE)),
! Get /PREREQUISITE: argument
STATE (PREREQUISITE_ARGUMENT,
$COMAND_FLDDB(FUNCTION=$CMNUM,
DATA=10,
FLAGS=CM_SDH,
HELP=PP('sequence number of job to finish first'),
CONTEXT=SEQ_NUM,
ACTION=ST_SEQUENCE_ARGUMENT,
MORE=
$COMAND_FLDDB(FUNCTION=$CMKEY,
DATA=PREREQUISITE_TABLE))),
! PUSH command
STATE (NOISE_PUSH,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('command level'),
NEXT=PUSH_CONFIRM)),
STATE (PUSH_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=PUSH,
NEXT=EXIT_STATE)),
! SPAWN command (synonym for PUSH)
STATE (NOISE_SPAWN,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('a subprocess'),
NEXT=SPAWN_CONFIRM)),
STATE (SPAWN_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=PUSH,
NEXT=EXIT_STATE)),
! TAKE command
STATE (NOISE_TAKE,
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('commands from'),
NEXT=TAKE_FILE)),
STATE (TAKE_FILE,
$COMAND_FLDDB(FUNCTION=$CMFIL,
ACTION=SAVE_NUMBER,
NEXT=TAKE_CONFIRM,
MORE=
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=PP('TAKE option,'),
NEXT=TAKE_FILE,
DATA=TAKE_TABLE))),
STATE (TAKE_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMSWI,
NEXT=TAKE_CONFIRM,
HELP=PP('TAKE option,'),
DATA=TAKE_TABLE,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=TAKE,
NEXT=EXIT_STATE))),
! STOP command
STATE (STOP_OPTIONS, ! STOP or STOP/xxx
$COMAND_FLDDB(FUNCTION=$CMSWI,
HELP=PP('STOP option,'),
NEXT=STOP_OPTIONS,
DATA=STOP_TABLE,
MORE=
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=STOP))),
STATE (STOP_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=STOP)),
! START command
STATE (START_OPTIONS, ! START
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=START)),
! HELP command
STATE (NOISE_HELP,
$COMAND_FLDDB(FUNCTION=$CMNOI,
NEXT=GET_HELP,
DATA=PP('on topic'))),
STATE (GET_HELP,
$COMAND_FLDDB(FUNCTION=$CMCFM,
DEFAULT=PP('DIU'),
NEXT=EXIT_STATE,
ACTION=HELP,
CONTEXT=DEF_HELP,
MORE=
$COMAND_FLDDB(FUNCTION=$CMKEY,
BREAK=HELP_BREAK,
NEXT=GOT_HELP,
DATA=HLPTAB))),
STATE (GOT_HELP,
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=HELP)),
! TRACE command
STATE (NOISE_TRACE, ! TRACE (Dap Messages)
$COMAND_FLDDB(FUNCTION=$CMNOI,
DATA=PP('DAP messages'),
NEXT=TRACE_CONFIRM)),
STATE (TRACE_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
NEXT=EXIT_STATE,
ACTION=TRACE_ACTION)),
! EXIT command
STATE (EXIT_CONFIRM,
$COMAND_FLDDB(FUNCTION=$CMCFM,
ACTION=EXIT_COMMAND,
NEXT=EXIT_STATE))
! End of command state defs
%;
%SBTTL 'Literal and Bind Declarations'
LITERAL ASSIGN_STATES(STATES); ! Give names to the states
LITERAL jfns_all = %O'111110000001', ! JFNS bits all fields plus punctuation
jfns_dev = %O'100000000000', ! JFNS bits device only
jfns_nam = %O'001000000000', ! JFNS bits file name only
jfns_typ = %O'000100000000'; ! JFNS bits file type only
LITERAL any_wildcards = GJ_DEV OR GJ_DIR OR GJ_NAM OR GJ_EXT OR GJ_VER;
! Define symbols that may not yet be defined
%IF NOT %DECLARED (G1_LOC)
%THEN LITERAL G1_LOC = %O'2000000000'; ! Local filespecs only
%FI
%IF NOT %DECLARED ($CHESC)
%THEN LITERAL $CHESC = %O'33'; ! Escape character
%FI
%IF NOT %DECLARED ($CHCRT)
%THEN LITERAL $CHCRT = %O'15'; ! Carriage return
%FI
%IF NOT %DECLARED ($CHFFD)
%THEN LITERAL $CHFFD = %O'14'; ! Form feed
%FI
%IF NOT %DECLARED ($CHLFD)
%THEN LITERAL $CHLFD = %O'12'; ! Line feed
%FI
! Strings bound for later use in command table macro def
BIND
ANGLE_USER_HELP = PP('<username> for requests created by that username'),
SQUARE_USER_HELP = PP('[username] for requests created by that username'),
JOB_NAME_HELP = PP('job name'),
ADDSOURCE_HELP = PP('comma followed by another source filespec'),
SOURCE_HELP = PP('source filespec'),
INPUT_SWITCH_HELP = PP('input file switch,'),
ACCESS_HELP = PP('"userid password account"'),
DESTINATION_HELP = PP('destination filespec'),
OUTPUT_SWITCH_HELP = PP('output file switch,'),
DIRECTORY_HELP = PP('directory option,'),
SHOW_QUEUE_HELP = PP('SHOW QUEUE option,'),
MODIFY_HELP = PP('modify option,'),
FILE_FORMAT_HELP = PP('file format,'),
REQ_HELP = PP('request switch,');
%SBTTL 'Module Static Storage'
OWN pre_id, ! Previous queued request id or 0
queue_value, ! To Queue or not to Queue
stopswitches, ! flag for stop switch stored
p_sfil, ! Pointer to source file collection buf
p_dfil, ! Pointer to dest file collection buff
idtnc_block : VECTOR[3], ! Time argument block (for /AFTER:+n)
days, ! number of days after now
number, ! Number saved by SAVE_NUMBER
savsta, ! saved CMDSTA
savnam, ! saved JFNBLK[$GJNAM]
savgen, ! saved JFNBLK[$GJGEN]
savext, ! saved JFNBLK[$GJEXT]
savf2, ! saved JFNBLK[$GJF2]
savctx, ! saved CONTEXT
rightbracket, ! Matching right bracket
frkhnd, ! Fork handle of inferior fork
shq_verbosity, ! Current SHOW QUEUE verbosity
mfunction, ! Function: Modify, Kill, Hold, Release
moptions : BITVECTOR[16], ! What are we MODIFYing
src_fil : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)],
dst_fil : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)],
def_name : VECTOR[CH$ALLOCATION(40)], ! Default file name
def_type : VECTOR[CH$ALLOCATION(40)], ! Default file type
def_fs : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)], ! Default filespec
buf_acct : VECTOR[CH$ALLOCATION(NAME_SIZE)], ! SET DEFAULT account
def_acct : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(NAME_SIZE,CH$PTR(buf_acct))),
buf_user : VECTOR[CH$ALLOCATION(NAME_SIZE)], ! SET DEFAULT user
def_user : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(NAME_SIZE,CH$PTR(buf_user))),
buf_pass : VECTOR[CH$ALLOCATION(NAME_SIZE)], ! SET DEFAULT passwd
def_pass : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(NAME_SIZE,CH$PTR(buf_pass))),
buf_node : VECTOR[CH$ALLOCATION(6)],
def_node : $STR_DESCRIPTOR(CLASS=BOUNDED, ! SET DEFAULT node
STRING=(6,CH$PTR(buf_node))),
helpdesc : REF $STR_DESCRIPTOR(),
%IF %SWITCHES(DEBUG) ! if debug mode
%THEN
prompt_buf : VECTOR[CH$ALLOCATION(16)], ! current debug prompt string
%ELSE
prompt_buf : VECTOR[CH$ALLOCATION(13)], ! current nondebug prompt
%FI
ccl_mode, ! TRUE if CCLing
stateb : VECTOR[$CMGJB+1], ! command state block
cbuf : VECTOR[CH$ALLOCATION(CBUF_LEN+1)], ! command line buffer
atom_buf : VECTOR[CH$ALLOCATION(ATOM_LEN+1)], ! atom buffer
jfnblk : VECTOR[$GJATR+1]; ! block for long GTJFNs
%SBTTL 'Module Global Storage'
GLOBAL
patpar_warn, ! indicates trans or descr parsing errs
sflags : BITVECTOR[36], ! What parts of source have we seen?
dflags : BITVECTOR[36], ! What parts of dest have we seen?
rflags : BITVECTOR[36], ! What once_per_request switches seen?
p_src, ! Pointer to source file buffer
p_dst, ! Pointer to dest file buffer
src_node : VECTOR[CH$ALLOCATION(7)], ! Last source nodename
dst_node : VECTOR[CH$ALLOCATION(7)], ! Destination nodename
takeflag, ! if ON, processing indirect cmd file
takeswitches, ! Current take mode
takejfn, ! JFN of current take file to abort
new_takeswitches, ! Take switch as typed in command
def_takeswitches : INITIAL(TAK_NOECHO), ! Default take mode (SET TAKE)
tty : $XPO_IOB(), ! IOB for the TTY
reqblk : $DIU_BLOCK; ! Block for the request we will do
%SBTTL 'Module Readonly Storage'
PSECT OWN=$HIGH$, GLOBAL=$HIGH$; ! Put these in the pure segment
! CAUTION! When changing this table be sure to change the RELATED=
! expression in the abbreviation for the EXIT command.
OWN COMMAND_TABLE: $COMAND_KEY ( ! Main Command Table
$COMAND_OPTION(OPT='APPEND', CONTEXT=DIU$K_APPEND,
ACTION=PRE_INPUT,
NEXT=APPEND_NOISE_INPUT),
$COMAND_OPTION(OPT='CANCEL', CONTEXT=M_KILL,
ACTION=PRE_MANIPULATE,
NEXT=NOISE_REQUEST_ID),
$COMAND_OPTION(OPT='COPY', CONTEXT=DIU$K_COPY,
ACTION=PRE_INPUT,
NEXT=COPY_NOISE_INPUT),
$COMAND_OPTION(OPT='DELETE', CONTEXT=DIU$K_DELETE,
ACTION=PRE_INPUT,
NEXT=DELETE_NOISE_INPUT),
$COMAND_OPTION(OPT='DIRECTORY', CONTEXT=DIU$K_DIRECTORY,
ACTION=PRE_INPUT,
NEXT=DIRECTORY_NOISE_INPUT),
$COMAND_OPTION(OPT='EX', FLAGS=CM_ABR+CM_INV,
RELATED=8+COMMAND_TABLE),
$COMAND_OPTION(OPT='EXECUTE', NEXT=NOISE_TAKE,
ACTION=PRE_TAKE),
$COMAND_OPTION(OPT='EXIT', NEXT=EXIT_CONFIRM),
$COMAND_OPTION(OPT='HELP', ACTION=HLPINI,
NEXT=NOISE_HELP),
$COMAND_OPTION(OPT='HOLD', CONTEXT=M_HOLD,
ACTION=PRE_MANIPULATE,
NEXT=NOISE_REQUEST_ID),
$COMAND_OPTION(OPT='INFORMATION', NEXT=NOISE_INFO),
$COMAND_OPTION(OPT='KILL', CONTEXT=M_KILL,
ACTION=PRE_MANIPULATE,
NEXT=NOISE_REQUEST_ID),
$COMAND_OPTION(OPT='MODIFY', CONTEXT=M_MODIFY,
ACTION=PRE_MANIPULATE,
NEXT=MODIFY),
$COMAND_OPTION(OPT='NEXT', CONTEXT=M_NEXT,
ACTION=PRE_MANIPULATE,
NEXT=NOISE_REQUEST_ID),
$COMAND_OPTION(OPT='PRINT', CONTEXT=DIU$K_PRINT,
ACTION=PRE_INPUT,
NEXT=PRINT_NOISE_INPUT),
$COMAND_OPTION(OPT='PUSH', NEXT=NOISE_PUSH),
$COMAND_OPTION(OPT='RELEASE', CONTEXT=M_RELEASE,
ACTION=PRE_MANIPULATE,
NEXT=NOISE_REQUEST_ID),
$COMAND_OPTION(OPT='RENAME', CONTEXT=DIU$K_RENAME,
ACTION=PRE_INPUT,
NEXT=RENAME_NOISE_INPUT),
$COMAND_OPTION(OPT='SET', NEXT=SET_OPTION),
$COMAND_OPTION(OPT='SHOW', NEXT=NOISE_SHOW),
$COMAND_OPTION(OPT='SPAWN', NEXT=NOISE_SPAWN),
$COMAND_OPTION(OPT='START', NEXT=START_OPTIONS),
$COMAND_OPTION(OPT='STOP', NEXT=STOP_OPTIONS),
$COMAND_OPTION(OPT='SUBMIT', CONTEXT=DIU$K_SUBMIT,
ACTION=PRE_INPUT,
NEXT=SUBMIT_NOISE_INPUT),
$COMAND_OPTION(OPT='TAKE', NEXT=NOISE_TAKE,
ACTION=PRE_TAKE),
$COMAND_OPTION(OPT='TRACE', FLAGS=CM_INV,
NEXT=NOISE_TRACE));
OWN SHOW_TABLE: $COMAND_KEY ( ! Options for SHOW command
$COMAND_OPTION(OPT='DEFAULTS', NEXT=SHOW_DEFAULTS),
$COMAND_OPTION(OPT='MAXIMUM_SIMULTANEOUS_REQUESTS',
NEXT=SHOW_MJOB),
$COMAND_OPTION(OPT='QUEUE', CONTEXT=M_LIST,
ACTION=PRE_MANIPULATE,
NEXT=SHOW_QUEUE),
$COMAND_OPTION(OPT='TAKE', NEXT=SHOW_TAKE),
$COMAND_OPTION(OPT='VERSION', NEXT=SHOW_VERSION)
);
OWN SET_TABLE: $COMAND_KEY ( ! SET command
$COMAND_OPTION(OPT='DEFAULTS', NEXT=SET_DEFAULTS),
$COMAND_OPTION(OPT='MAXIMUM_SIMULTANEOUS_REQUESTS',
NEXT=SET_MJOB_N),
$COMAND_OPTION(OPT='TAKE', NEXT=SET_TAKE_DEFAULT)
);
OWN SET_DEFAULTS_KEYWORD: $COMAND_KEY ( ! SET DEFAULTS keyword
$COMAND_OPTION(OPT='SWITCHES', NEXT=SET_DEFAULTS_SWITCHES));
OWN DEF_SWITCHES: $COMAND_KEY ( ! SET DEFAULTS switches
$COMAND_OPTION(OPT='ACCESS:', ACTION=SW_ARGUMENT,
NEXT=GET_ACCESS_STRING),
$COMAND_OPTION(OPT='ACCOUNT:', ACTION=SW_ARGUMENT,
NEXT=DEFAULT_ACCOUNT),
$COMAND_OPTION(OPT='LOG_FILE:', ACTION=FILE_ARGUMENT,
CONTEXT='LOG',
NEXT=GET_LOG_FILESPEC),
$COMAND_OPTION(OPT='NOACCESS', ACTION=ST_UPA,
CONTEXT=ACC_NOACCESS,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOLOG_FILE', ACTION=ST_LOG,
CONTEXT=FALSE,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOQUEUE', CONTEXT=DIU$K_NO_QUEUE,
ACTION=QUEUE,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOTIFY:', ACTION=SW_ARGUMENT,
NEXT=NOTIFY_ARGUMENT),
$COMAND_OPTION(OPT='PASSWORD:', ACTION=SW_ARGUMENT,
NEXT=DEFAULT_PASSWORD),
$COMAND_OPTION(OPT='QUEUE:', ACTION=SW_ARGUMENT,
NEXT=GET_QUEUE_VALUE),
$COMAND_OPTION(OPT='USERID:', ACTION=SW_ARGUMENT,
NEXT=DEFAULT_USERID)
);
OWN NOTIFY_TABLE: $COMAND_KEY ( ! /NOTIFY: switch
$COMAND_OPTION(OPT='MAIL', CONTEXT=NOTIFY_MAIL,
ACTION=ST_NOTIFY),
$COMAND_OPTION(OPT='NONE', CONTEXT=NOTIFY_NONE,
ACTION=ST_NOTIFY),
$COMAND_OPTION(OPT='TERMINAL', CONTEXT=NOTIFY_TERMINAL,
ACTION=ST_NOTIFY));
OWN KEY_TABLE: $COMAND_KEY ( ! /KEY:[NO]CHANGES, /KEY:[NO]DUPLICATES
$COMAND_OPTION(OPT='CHANGES', CONTEXT=2,
ACTION=ST_KEY,
NEXT=GET_KEY_OPTION_DELIM),
$COMAND_OPTION(OPT='DUPLICATES', CONTEXT=3,
ACTION=ST_KEY,
NEXT=GET_KEY_OPTION_DELIM),
$COMAND_OPTION(OPT='NOCHANGES', CONTEXT=4,
ACTION=ST_KEY,
NEXT=GET_KEY_OPTION_DELIM),
$COMAND_OPTION(OPT='NODUPLICATES', CONTEXT=5,
ACTION=ST_KEY,
NEXT=GET_KEY_OPTION_DELIM));
OWN PREREQUISITE_TABLE: $COMAND_KEY (
$COMAND_OPTION(OPT='NONE', CONTEXT=SEQ_NOSEQ,
ACTION=ST_SEQUENCE_ARGUMENT));
OWN SEQUENCE_TABLE: $COMAND_KEY ( ! /SEQUENCE:
$COMAND_OPTION(OPT='ABORT_ON_ERROR', CONTEXT=SEQ_ABORT,
ACTION=ST_SEQUENCE_ARGUMENT),
$COMAND_OPTION(OPT='CONTINUE_ON_ERROR', CONTEXT=SEQ_CONTINUE,
ACTION=ST_SEQUENCE_ARGUMENT));
OWN REQ_SWITCH_TABLE: $COMAND_KEY ( ! Request switch table (anytime)
$COMAND_OPTION(OPT='ACCESS:', ACTION=SW_ARGUMENT,
NEXT=GET_ACCESS_STRING),
$COMAND_OPTION(OPT='ACCOUNT:', ACTION=SW_ARGUMENT,
NEXT=DEFAULT_ACCOUNT),
$COMAND_OPTION(OPT='AFTER:', CONTEXT=TAD_AFTER,
ACTION=SW_ARGUMENT,
NEXT=GET_DATE_TIME),
$COMAND_OPTION(OPT='DEADLINE:', CONTEXT=TAD_DEADLINE,
ACTION=SW_ARGUMENT,
NEXT=GET_DATE_TIME),
$COMAND_OPTION(OPT='LOG_FILE:', ACTION=FILE_ARGUMENT,
CONTEXT='LOG',
NEXT=GET_LOG_FILESPEC),
$COMAND_OPTION(OPT='NOACCESS', CONTEXT=ACC_NOACCESS,
ACTION=ST_UPA,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOLOG_FILE', ACTION=ST_LOG,
CONTEXT=FALSE,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOQUEUE', CONTEXT=DIU$K_NO_QUEUE,
ACTION=QUEUE,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOTIFY:', ACTION=SW_ARGUMENT,
NEXT=NOTIFY_ARGUMENT),
$COMAND_OPTION(OPT='PASSWORD:', ACTION=SW_ARGUMENT,
NEXT=DEFAULT_PASSWORD),
$COMAND_OPTION(OPT='PREREQUISITE:', ACTION=SW_ARGUMENT,
NEXT=PREREQUISITE_ARGUMENT),
$COMAND_OPTION(OPT='PRIORITY:', ACTION=SW_ARGUMENT,
NEXT=GET_PRIORITY_VALUE),
$COMAND_OPTION(OPT='QUEUE:', ACTION=SW_ARGUMENT,
NEXT=GET_QUEUE_VALUE),
$COMAND_OPTION(OPT='SEQUENCE:', ACTION=SW_ARGUMENT,
NEXT=SEQUENCE_ARGUMENT),
$COMAND_OPTION(OPT='USERID:', ACTION=SW_ARGUMENT,
NEXT=DEFAULT_USERID));
OWN APPEND_GLOB_SWITCH_TABLE: $COMAND_KEY ( ! Global APPEND switches
$COMAND_OPTION(OPT='CARRIAGE_CONTROL:', ACTION=SW_ARGUMENT,
NEXT=GET_CARRIAGE_CONTROL),
$COMAND_OPTION(OPT='DESCRIPTION:', CONTEXT='DDL',
ACTION=FILE_ARGUMENT,
NEXT=GET_DESCRIPTION_FILESPEC),
$COMAND_OPTION(OPT='FILE_FORMAT:', ACTION=SW_ARGUMENT,
NEXT=GET_APPEND_GLOBAL_FILE_FORMAT),
$COMAND_OPTION(OPT='FIXED:', CONTEXT=FAB$K_FIX,
ACTION=RFM_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='LINE_SEQUENCED_ASCII', NEXT=SAME_STATE,
ACTION=RFM_SWITCH,
CONTEXT=FAB$K_LSA),
$COMAND_OPTION(OPT='RECORD_FORMAT:', NEXT=GET_RECORD_FORMAT,
ACTION=SW_ARGUMENT),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_SEQ_ORG),
$COMAND_OPTION(OPT='STREAM:', CONTEXT=FAB$K_STM,
ACTION=RFM_SWITCH,
NEXT=GET_STREAM_OPTIONS),
$COMAND_OPTION(OPT='TRANSFORM:', CONTEXT='TRA',
ACTION=FILE_ARGUMENT,
NEXT=GET_TRANSFORM_FILESPEC),
$COMAND_OPTION(OPT='VARIABLE:', CONTEXT=FAB$K_VAR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='VFC:', CONTEXT=FAB$K_VFC,
ACTION=RFM_SWITCH,
NEXT=GET_VFC_ARGUMENT),
$COMAND_OPTION(OPT='WARNINGS:', ACTION=SW_ARGUMENT,
NEXT=GET_WARNING_COUNT));
OWN COPY_GLOB_SWITCH_TABLE: $COMAND_KEY ( ! Global COPY switches
$COMAND_OPTION(OPT='CARRIAGE_CONTROL:', ACTION=SW_ARGUMENT,
NEXT=GET_CARRIAGE_CONTROL),
$COMAND_OPTION(OPT='DESCRIPTION:', CONTEXT='DDL',
ACTION=FILE_ARGUMENT,
NEXT=GET_DESCRIPTION_FILESPEC),
$COMAND_OPTION(OPT='FILE_FORMAT:', ACTION=SW_ARGUMENT,
NEXT=GET_COPY_GLOBAL_FILE_FORMAT),
$COMAND_OPTION(OPT='FIXED:', CONTEXT=FAB$K_FIX,
ACTION=RFM_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='IMAGE', CONTEXT=DIU$K_IMAGE,
ACTION=FILFMT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='LINE_SEQUENCED_ASCII', NEXT=SAME_STATE,
ACTION=RFM_SWITCH,
CONTEXT=FAB$K_LSA),
$COMAND_OPTION(OPT='RECORD_FORMAT:', NEXT=GET_RECORD_FORMAT,
ACTION=SW_ARGUMENT),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_ORG),
$COMAND_OPTION(OPT='STREAM:', CONTEXT=FAB$K_STM,
ACTION=RFM_SWITCH,
NEXT=GET_STREAM_OPTIONS),
$COMAND_OPTION(OPT='TRANSFORM:', CONTEXT='TRA',
ACTION=FILE_ARGUMENT,
NEXT=GET_TRANSFORM_FILESPEC),
$COMAND_OPTION(OPT='VARIABLE:', CONTEXT=FAB$K_VAR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='VFC:', CONTEXT=FAB$K_VFC,
ACTION=RFM_SWITCH,
NEXT=GET_VFC_ARGUMENT),
$COMAND_OPTION(OPT='WARNINGS:', ACTION=SW_ARGUMENT,
NEXT=GET_WARNING_COUNT));
OWN INP_SWITCH_TABLE: $COMAND_KEY ( ! Switches for input files
$COMAND_OPTION(OPT='CARRIAGE_CONTROL:', ACTION=SW_ARGUMENT,
NEXT=GET_CARRIAGE_CONTROL),
$COMAND_OPTION(OPT='DESCRIPTION:', CONTEXT='DDL',
ACTION=FILE_ARGUMENT,
NEXT=GET_DESCRIPTION_FILESPEC),
$COMAND_OPTION(OPT='FBINARY', CONTEXT=TYP$K_FORTRAN_BINARY,
ACTION=FILFMT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='FILE_FORMAT:', ACTION=SW_ARGUMENT,
NEXT=GET_INPUT_FILE_FORMAT),
$COMAND_OPTION(OPT='FIXED:', CONTEXT=FAB$K_FIX,
ACTION=RFM_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='ISAM', CONTEXT=TYP$K_ISAM,
ACTION=FILFMT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='LIBOL:', CONTEXT=DIU$K_LIBOL,
ACTION=FILFMT_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='LINE_SEQUENCED_ASCII', NEXT=SAME_STATE,
ACTION=RFM_SWITCH,
CONTEXT=FAB$K_LSA),
$COMAND_OPTION(OPT='RECORD_FORMAT:', NEXT=GET_RECORD_FORMAT,
ACTION=SW_ARGUMENT),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_ORG),
$COMAND_OPTION(OPT='STREAM:', CONTEXT=FAB$K_STM,
ACTION=RFM_SWITCH,
NEXT=GET_STREAM_OPTIONS),
$COMAND_OPTION(OPT='TRANSFORM:', CONTEXT='TRA',
ACTION=FILE_ARGUMENT,
NEXT=GET_TRANSFORM_FILESPEC),
$COMAND_OPTION(OPT='VARIABLE:', CONTEXT=FAB$K_VAR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='VFC:', CONTEXT=FAB$K_VFC,
ACTION=RFM_SWITCH,
NEXT=GET_VFC_ARGUMENT),
$COMAND_OPTION(OPT='WARNINGS:', ACTION=SW_ARGUMENT,
NEXT=GET_WARNING_COUNT));
OWN OUT_SWITCH_TABLE: $COMAND_KEY ( ! Copy output file switches
$COMAND_OPTION(OPT='CARRIAGE_CONTROL:', ACTION=SW_ARGUMENT,
NEXT=GET_CARRIAGE_CONTROL),
$COMAND_OPTION(OPT='CONTIGUOUS', CONTEXT=FAB$M_CTG,
ACTION=FOP_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='DESCRIPTION:', CONTEXT='DDL',
ACTION=FILE_ARGUMENT,
NEXT=GET_DESCRIPTION_FILESPEC),
$COMAND_OPTION(OPT='FILE_FORMAT:', ACTION=SW_ARGUMENT,
NEXT=GET_OUTPUT_FILE_FORMAT),
$COMAND_OPTION(OPT='FIXED:', CONTEXT=FAB$K_FIX,
ACTION=RFM_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='KEY:', ACTION=SW_ARGUMENT,
NEXT=GET_KEYS),
$COMAND_OPTION(OPT='LINE_SEQUENCED_ASCII', NEXT=SAME_STATE,
ACTION=RFM_SWITCH,
CONTEXT=FAB$K_LSA),
$COMAND_OPTION(OPT='NOCONTIGUOUS', CONTEXT=(NOT FAB$M_CTG),
ACTION=FOP_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOSPAN_BLOCKS', CONTEXT=FAB$M_BLK,
ACTION=RAT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='RECORD_FORMAT:', NEXT=GET_RECORD_FORMAT,
ACTION=SW_ARGUMENT),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_ORG),
$COMAND_OPTION(OPT='SPAN_BLOCKS', CONTEXT=(NOT FAB$M_BLK),
ACTION=RAT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='STREAM:', CONTEXT=FAB$K_STM,
ACTION=RFM_SWITCH,
NEXT=GET_STREAM_OPTIONS),
$COMAND_OPTION(OPT='TRANSFORM:', CONTEXT='TRA',
ACTION=FILE_ARGUMENT,
NEXT=GET_TRANSFORM_FILESPEC),
$COMAND_OPTION(OPT='VARIABLE:', CONTEXT=FAB$K_VAR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='VFC:', CONTEXT=FAB$K_VFC,
ACTION=RFM_SWITCH,
NEXT=GET_VFC_ARGUMENT),
$COMAND_OPTION(OPT='WARNINGS:', ACTION=SW_ARGUMENT,
NEXT=GET_WARNING_COUNT));
OWN APP_SWITCH_TABLE: $COMAND_KEY ( ! APPEND output file switches
$COMAND_OPTION(OPT='CARRIAGE_CONTROL:', ACTION=SW_ARGUMENT,
NEXT=GET_CARRIAGE_CONTROL),
$COMAND_OPTION(OPT='CONTIGUOUS', CONTEXT=FAB$M_CTG,
ACTION=FOP_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='DESCRIPTION:', CONTEXT='DDL',
ACTION=FILE_ARGUMENT,
NEXT=GET_DESCRIPTION_FILESPEC),
$COMAND_OPTION(OPT='FILE_FORMAT:', ACTION=SW_ARGUMENT,
NEXT=GET_OUTPUT_FILE_FORMAT),
$COMAND_OPTION(OPT='FIXED:', CONTEXT=FAB$K_FIX,
ACTION=RFM_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='LINE_SEQUENCED_ASCII', NEXT=SAME_STATE,
ACTION=RFM_SWITCH,
CONTEXT=FAB$K_LSA),
$COMAND_OPTION(OPT='NOCONTIGUOUS', CONTEXT=FAB$M_CTG,
ACTION=FOP_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOSPAN_BLOCKS', CONTEXT=FAB$M_BLK,
ACTION=RAT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='RECORD_FORMAT:', NEXT=GET_RECORD_FORMAT,
ACTION=SW_ARGUMENT),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_SEQ_ORG),
$COMAND_OPTION(OPT='SPAN_BLOCKS', CONTEXT=(NOT FAB$M_BLK),
ACTION=RAT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='STREAM:', CONTEXT=FAB$K_STM,
ACTION=RFM_SWITCH,
NEXT=GET_STREAM_OPTIONS),
$COMAND_OPTION(OPT='TRANSFORM:', CONTEXT='TRA',
ACTION=FILE_ARGUMENT,
NEXT=GET_TRANSFORM_FILESPEC),
$COMAND_OPTION(OPT='VARIABLE:', CONTEXT=FAB$K_VAR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='VFC:', CONTEXT=FAB$K_VFC,
ACTION=RFM_SWITCH,
NEXT=GET_VFC_ARGUMENT),
$COMAND_OPTION(OPT='WARNINGS:', ACTION=SW_ARGUMENT,
NEXT=GET_WARNING_COUNT));
OWN APPEND_GLOB_FILE_FORMAT_TABLE: $COMAND_KEY (
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_SEQ_ORG));
OWN COPY_GLOB_FILE_FORMAT_TABLE: $COMAND_KEY (
$COMAND_OPTION(OPT='IMAGE', CONTEXT=DIU$K_IMAGE,
ACTION=FILFMT_SWITCH),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_ORG));
OWN OUT_FILE_FORMAT_TABLE: $COMAND_KEY ( ! Output file format switch table
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_ORG));
OWN INP_FILE_FORMAT_TABLE: $COMAND_KEY ( ! Input file format switch table
$COMAND_OPTION(OPT='FBINARY', CONTEXT=TYP$K_FORTRAN_BINARY,
ACTION=FILFMT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='ISAM', CONTEXT=TYP$K_ISAM,
ACTION=FILFMT_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='LIBOL:', CONTEXT=DIU$K_LIBOL,
ACTION=FILFMT_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='RMS:', ACTION=SW_ARGUMENT,
NEXT=GET_RMS_ORG));
OWN RECORD_FORMAT_TABLE: $COMAND_KEY ( ! Switches for record formats
$COMAND_OPTION(OPT='FIXED:', CONTEXT=FAB$K_FIX,
ACTION=RFM_SWITCH,
NEXT=GET_RECORD_SIZE),
$COMAND_OPTION(OPT='LINE_SEQUENCED_ASCII', CONTEXT=FAB$K_LSA,
ACTION=RFM_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='STREAM:', CONTEXT=FAB$K_STM,
ACTION=RFM_SWITCH,
NEXT=GET_STREAM_OPTIONS),
$COMAND_OPTION(OPT='VARIABLE:', CONTEXT=FAB$K_VAR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='VFC:', CONTEXT=FAB$K_VFC,
ACTION=RFM_SWITCH,
NEXT=GET_VFC_ARGUMENT));
OWN RMS_ORG_TABLE: $COMAND_KEY ( ! Keywords for RMS file organizations
$COMAND_OPTION(OPT='INDEXED', NEXT=SAME_STATE,
ACTION=FILFMT_SWITCH,
CONTEXT=fab$k_idx),
$COMAND_OPTION(OPT='RELATIVE', NEXT=SAME_STATE,
ACTION=FILFMT_SWITCH,
CONTEXT=fab$k_rel),
$COMAND_OPTION(OPT='SEQUENTIAL', NEXT=SAME_STATE,
ACTION=FILFMT_SWITCH,
CONTEXT=fab$k_seq));
OWN RMS_SEQ_ORG_TABLE: $COMAND_KEY ( ! Keywords for RMS sequential filr org
$COMAND_OPTION(OPT='SEQUENTIAL', NEXT=SAME_STATE,
ACTION=FILFMT_SWITCH,
CONTEXT=FAB$K_SEQ));
OWN RATTAB: $COMAND_KEY ( ! Switches for record attributes
$COMAND_OPTION(OPT='CARRIAGE_RETURN', CONTEXT=FAB$M_CR,
ACTION=RAT_SWITCH),
$COMAND_OPTION(OPT='EMBEDDED', CONTEXT=FAB$M_EMB,
ACTION=RAT_SWITCH));
OWN STREAM_TABLE: $COMAND_KEY ( ! STREAM options
$COMAND_OPTION(OPT='CARRIAGE_RETURN:', CONTEXT=FAB$K_SCR,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE),
$COMAND_OPTION(OPT='LINE_FEED:', CONTEXT=FAB$K_SLF,
ACTION=RFM_SWITCH,
NEXT=GET_MAXIMUM_RECORD_SIZE));
OWN DIRECTORY_TABLE: $COMAND_KEY ( ! DIRECTORY switch table
$COMAND_OPTION(OPT='BRIEF', CONTEXT=DIU$K_LIST_BRIEF,
ACTION=LIST_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='FULL', CONTEXT=DIU$K_LIST_FULL,
ACTION=LIST_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='LIST', CONTEXT=DIU$K_LIST_NORMAL,
ACTION=LIST_SWITCH,
NEXT=SAME_STATE));
OWN MODIFY_TABLE: $COMAND_KEY ( ! MODIFY Switch Table
$COMAND_OPTION(OPT='AFTER:', CONTEXT=TAD_AFTER,
ACTION=SW_ARGUMENT,
NEXT=GET_DATE_TIME),
$COMAND_OPTION(OPT='DEADLINE:', CONTEXT=TAD_DEADLINE,
ACTION=SW_ARGUMENT,
NEXT=GET_DATE_TIME),
$COMAND_OPTION(OPT='LOG_FILE:', ACTION=FILE_ARGUMENT,
CONTEXT='LOG',
NEXT=GET_LOG_FILESPEC),
$COMAND_OPTION(OPT='NOAFTER', CONTEXT=TAD_AFTER,
ACTION=ST_NTAD,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NODEADLINE', CONTEXT=TAD_DEADLINE,
ACTION=ST_NTAD,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOLOG_FILE', ACTION=ST_LOG,
CONTEXT=FALSE,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOTIFY:', ACTION=SW_ARGUMENT,
NEXT=NOTIFY_ARGUMENT),
$COMAND_OPTION(OPT='PREREQUISITE:', ACTION=SW_ARGUMENT,
NEXT=PREREQUISITE_ARGUMENT),
$COMAND_OPTION(OPT='PRIORITY:', ACTION=SW_ARGUMENT,
NEXT=GET_PRIORITY_VALUE),
$COMAND_OPTION(OPT='SEQUENCE:', ACTION=SW_ARGUMENT,
NEXT=SEQUENCE_ARGUMENT));
OWN SHQ_TABLE: $COMAND_KEY ( ! SHOW QUEUE switch table
$COMAND_OPTION(OPT='ALL', CONTEXT=TRUE,
ACTION=ST_VERBOSITY,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='BRIEF', CONTEXT=FALSE,
ACTION=ST_VERBOSITY,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='FULL', CONTEXT=TRUE,
ACTION=ST_VERBOSITY,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NORMAL', CONTEXT=FALSE,
ACTION=ST_VERBOSITY,
NEXT=SAME_STATE));
OWN STOP_TABLE: $COMAND_KEY ( ! STOP Switch Table
$COMAND_OPTION(OPT='NOWAIT', CONTEXT=SP_NOWAIT,
ACTION=STOP_SWITCH,
NEXT=STOP_CONFIRM),
$COMAND_OPTION(OPT='WAIT', CONTEXT=SP_WAIT,
ACTION=STOP_SWITCH,
NEXT=STOP_CONFIRM));
OWN SET_TAKE_TABLE: $COMAND_KEY ( ! SET TAKE switch table
$COMAND_OPTION(OPT='ECHO', CONTEXT=TAK_ECHO,
ACTION=SET_TAKE_SWITCH,
NEXT=SET_TAKE_CONFIRM),
$COMAND_OPTION(OPT='NOECHO', CONTEXT=TAK_NOECHO,
ACTION=SET_TAKE_SWITCH,
NEXT=SET_TAKE_CONFIRM),
$COMAND_OPTION(OPT='NOVERIFY', CONTEXT=TAK_NOECHO,
ACTION=SET_TAKE_SWITCH,
NEXT=SET_TAKE_CONFIRM),
$COMAND_OPTION(OPT='VERIFY', CONTEXT=TAK_ECHO,
ACTION=SET_TAKE_SWITCH,
NEXT=SET_TAKE_CONFIRM));
OWN TAKE_TABLE: $COMAND_KEY ( ! TAKE switch table
$COMAND_OPTION(OPT='ECHO', CONTEXT=TAK_ECHO,
ACTION=TAKE_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOECHO', CONTEXT=TAK_NOECHO,
ACTION=TAKE_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='NOVERIFY', CONTEXT=TAK_NOECHO,
ACTION=TAKE_SWITCH,
NEXT=SAME_STATE),
$COMAND_OPTION(OPT='VERIFY', CONTEXT=TAK_ECHO,
ACTION=TAKE_SWITCH,
NEXT=SAME_STATE));
OWN ACCESS_TABLE: $COMAND_KEY ( ! ACCESS switch value table
$COMAND_OPTION(OPT='NONE', CONTEXT=ACC_NONE,
ACTION=ST_UPA),
$COMAND_OPTION(OPT='PROMPT', CONTEXT=ACC_PROMPT,
ACTION=ST_UPA));
OWN QUEUE_TABLE: $COMAND_KEY ( ! QUEUE switch value table
$COMAND_OPTION(OPT='CONDITIONAL', CONTEXT=DIU$K_MAYBE_QUEUE,
ACTION=QUEUE),
$COMAND_OPTION(OPT='NO', CONTEXT=DIU$K_NO_QUEUE,
ACTION=QUEUE),
$COMAND_OPTION(OPT='YES', CONTEXT=DIU$K_QUEUE,
ACTION=QUEUE));
OWN DAYS_TABLE: $COMAND_KEY ( ! Days of the week table
$COMAND_OPTION(OPT='FRIDAY',CONTEXT=2,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='MONDAY', CONTEXT=5,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='SATURDAY', CONTEXT=3,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='SUNDAY', CONTEXT=4,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='THURSDAY', CONTEXT=1,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='TODAY', CONTEXT=-1,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='TUESDAY', CONTEXT=6,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK),
$COMAND_OPTION(OPT='WEDNESDAY', CONTEXT=0,
ACTION=ST_FDAY,
NEXT=GOT_DAY_OF_WEEK));
! Break masks for usernames, node names, and our keyword tables.
! USRB is -, 0 thru 9, A thru Z, a thru z, .%*$_
! DEVB is -, 0 thru 9, A thru Z, a thru z, _$
OWN USER_BREAK: ! used for CMFLD parsing of usernames
VECTOR[4] INITIAL(USRB0$,USRB1$,USRB2$,USRB3$),
KEY_BREAK: ! used for CMSWI/CMKEY parsing of tables with "_" in them
VECTOR[4] INITIAL(KEYB0$,KEYB1$,KEYB2$-%O'20',KEYB3$),
HELP_BREAK: ! used for CMKEY parsing of help commands with "/" and "_"
VECTOR[4] INITIAL(KEYB0$,KEYB1$-%O'4000000',
KEYB2$-%O'20',KEYB3$);
OWN DEF_HELP: $STR_DESCRIPTOR(STRING=%STRING( ! Default help string
'Enter "HELP DIU" for a brief description of the program',CRLF,
'Enter "HELP topic" for help on a particular topic,',CRLF,
'Enter "HELP ?" for a list of topics',CRLF));
OWN DB: $COMAND_STATES (EVENS(STATES)); ! States of command parser
UNDECLARE %QUOTE STATES; ! This is not needed after here
! and is very large
GLOBAL D_NULL: $STR_DESCRIPTOR(STRING=%CHAR(0));
PSECT OWN=$LOW$, GLOBAL=$LOW$; ! Return to default psects
%SBTTL 'Routine ADD_TAG'
ROUTINE add_tag (tag, tag_type, p_value, val_len, p_buffer) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is responsible for appending file attribute information
! to the tag buffers in module static storage. These tag buffers are
! maintained seperate from the filespec, and when the completed filespec
! is detected, appended to it.
!
! The format of the filespec in the request block is as below.
!
! +-----+
! | len | request[DIU$H_SOURCE_FILESPEC]
! +-----+-----+-------+-----+-----+----------+-----+-----+-------+-----+
! | tag | tln | value | etg | fln | filespec | tag | tln | value | nul |
! +-----+-----+-------+-----+-----+----------+-----+-----+-------+-----+
! ^ ^ ^ ^ ^ ^
! +--------+----------+ +----+----+ +-----+-----+
! | | |
! global qualifiers file occurrence local qualifier
!
! Global qualifiers default to all filespecs in the list, although the
! actual tag information is recorded just once. The propogation of this
! information is done when the actual FABs are being built.
!
! len - the overall length of the request block filespec buffer
! fln - the length of just the upcoming filespec in the buffer
! tag - byte literal indicating field in FAB/RAB/XAB to be set
! tln - length of tag value
! value - the actual tag data
! etg - end of tag byte ($ETG)
! nul - a null byte which ends filespec to keep it ASCIZ
!
!
! The stream ALWAYS ends on a nul byte, and that nul byte is always
! found on the starting address + .len bytes.
!
! * WARNING * To be compatable with the way VAX DIU handles tag values,
! integer values are converted to ASCII and trimmed of any
! leading zeros. At run time these values are converted
! back to binary. This allows us to treate all tag values
! as character data similar to VAX DIU.
!
! FORMAL PARAMETERS:
!
! tag Literal found in DIU.R36 which indicates field in
! FAB/RAB/XAB to be set. (passed by value)
!
! tag_type Literal indicating value type (DATE, INTEGER, STRING)
! Needed to duplicate value in buffer. (passed by value)
!
! p_value Used depending on tag type above. If a string, interpret
! as a CH$PTR to the text. If an integer, then interpret it
! as the address of a BLISSword value.
!
! val_len Value length. This indicates the length in characters of
! the value we will deposit. (passed by value)
!
! p_buffer Tag buffer we will operate upon. This is a CH$PTR to
! the request block fields usually. (passed by REFERENCE)
!
!--
BIND value = .p_value,
buf_ptr = .p_buffer;
LOCAL number : $STR_DESCRIPTOR(CLASS=DYNAMIC);
CH$WCHAR_A(.tag,buf_ptr); ! Drop in the tag id
SELECTONE .tag_type OF
SET
[DIU$K_TAG_INTEGER] : BEGIN
! Convert the integer to ASCII
$STR_DESC_INIT(DESC=number,CLASS=DYNAMIC);
$STR_COPY(STRING=$STR_ASCII(value),TARGET=number);
! Drop in the newly ASCIIzed number length
CH$WCHAR_A(.number[STR$H_LENGTH],buf_ptr);
! Move the ASCIIzed string to the buffer
CH$MOVE(.number[STR$H_LENGTH],.number[STR$A_POINTER],
.buf_ptr);
! Update pointer
buf_ptr = CH$PLUS(.buf_ptr,.number[STR$H_LENGTH]);
END;
[DIU$K_TAG_TEXT] : BEGIN
CH$WCHAR_A(.val_len,buf_ptr); ! Insert length
CH$MOVE(.val_len,value,.buf_ptr); ! Move the string
buf_ptr=CH$PLUS(.buf_ptr,.val_len); ! Update pointer
END;
TES;
END; ! ADD_TAG
%SBTTL 'Routine C$CONTROL_C'
GLOBAL ROUTINE C$CONTROL_C : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine handles the control C interrupt. If the spooler is
! running a TAKE file, that TAKE file is aborted and we return. If the
! spooler is not running a TAKE file, we call the EXIT_COMMAND routine
! which will print a nasty message.
!--
IF .takeflag ! Are we in a take?
THEN BEGIN ! Yes, start being nasty
IF .takejfn NEQ -1 ! Unless we have been here already,
THEN JSYS_SFPTR(.takejfn,-1); ! Set the JFN to current eof
takejfn = -1; ! And abort the take please
END ! End of nasty code
ELSE EXIT_COMMAND(0,0,0); ! Not in a take, simulate EXIT command
END; ! C$CONTROL_C
%SBTTL 'Routine DECIDE_QUEUE'
ROUTINE DECIDE_QUEUE : =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine sets queue_value to determine weather or not to queue the
! request. A check for typing /AFTER or /DEADLINE OR /SEQUENCE is made
! so that use of these switches force the request to be queued. If a
! /[NO]QUEUE switch is typed, we take that value. Otherwise we look for
! a default for the source and destination nodes and use that value. If
! no default for either node is found, we use the default for all_nodes.
! The routine returs FALSE if the command should be aborted, TRUE
! otherwise.
!
! IMPLICIT INPUTS:
!
! rflags
! queue_value
!
! IMPLICIT OUTPUTS:
!
! queue_value: set to whatever we decide
!
!--
BEGIN
LOCAL nodename : $STR_DESCRIPTOR (),
def : REF $DEF_DECL;
def = 0; ! initialize to zero
! Check for switch conflicts. If /AFTER or /DEADLINE or /SEQUENCE were typed
! along with a /QUEUE switch then the queue_value must indicate that the
! request is to be queued. If /AFTER or /DEADLINE or /SEQUENCE are typed
! without a /QUEUE switch then we force the request to be queued. If /QUEUE is
! typed without /AFTER or /DEADLINE or /QUEUE then we just trust the
! queue_value.
IF .rflags[R_AFTER] OR .rflags[R_DEADLINE] OR .rflags[R_SEQUENCE]
THEN BEGIN ! If /DEADLINE|/AFTER|/SEQUENCE
IF .rflags[R_QUEUE] ! and /QUEUE
THEN BEGIN
IF .queue_value NEQ DIU$K_QUEUE ! If it wasn't /QUEUE:YES
THEN BEGIN ! then we have a problem
IF .rflags[R_AFTER]
THEN PE('/AFTER is only allowed if request is queued',FALSE);
IF .rflags[R_DEADLINE]
THEN PE('/DEADLINE is only allowed if request is queued',FALSE);
PE('/SEQUENCE is only allowed if request is queued',FALSE);
END;
END
ELSE BEGIN ! Here if /AFTER or /DEADLINE or /SEQ
rflags[R_QUEUE] = SEEN; ! but no /QUEUE
queue_value = DIU$K_QUEUE; ! so we fake up /QUEUE:YES
END;
END;
IF .rflags[R_QUEUE] THEN RETURN TRUE; ! If /QUEUE specifed, take queue_value
! Try to find a node with defaults set. Look for a default entry for the
! destination node first. If that's not set, look at the source node for a
! default. If there is not a default for the source or destination, then use
! the def_root defaults. After the default is found, grab the queue_value from
! it and return. NOTE: the sflags[F_NODE] bit is set by the last destination
! filespec that is parsed; therefore if there are numerous source filespecs
! then we only consider the def_root for the last one typed (which may or may
! not be a local filespec).
IF .dflags[F_NODE] ! did we have a dst node set?
THEN BEGIN
$STR_DESC_INIT(DESCRIPTOR=nodename,
STRING=(ASCIZ_LEN(CH$PTR(dst_node)),
CH$PTR(dst_node)));
def = DEF$FIND(nodename); ! Find the defaults to use (dest node)
END;
IF (.def EQL 0) OR (.def EQL def_root) ! Dst node not set or is local, then
THEN IF .sflags[F_NODE] ! if *last* source filespec was remote
THEN BEGIN ! then check it for a node entry
$STR_DESC_INIT(DESCRIPTOR=nodename,
STRING=(ASCIZ_LEN(CH$PTR(src_node)),
CH$PTR(src_node)));
def = DEF$FIND(nodename); ! Find def entry for source node
END;
IF (.def EQL 0) ! If node not found
THEN def = def_root; ! Use the default node defaults!
queue_value = .def[DEF$B_DEFER]; ! Set to default queue value
RETURN TRUE; ! Return OK
END; ! end of routine DECIDE_QUEUE
%SBTTL 'Routine DESCRIPTION'
ROUTINE DESCRIPTION (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Action routine for storing the DESCRIPTION filespec after the
! /DESCRIPTION switch has been parsed. Checks for more than one
! description file per input or output filespec. Insures that the
! description files are on disk.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (JFN of file).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$T_?_DESCRIPTION] is filled in with the filespec
! reqblk[DIU$H_?_DESCRIPTION] has the length
!
! SIDE EFFECTS:
!
! The JFN we got from COMND is released
!
!--
LOCAL device_chars; ! Device characteristics word
! Check for switch conflicts and insure JFN refers to disk before copying the
! transform filespec into the reqblk.
IF .rflags[R_IMAGE]
THEN PE('/DESCRIPTION illegal with /IMAGE file format');
IF NOT .dflags[F_FILESPEC] ! If we have not seen the dest spec yet
THEN BEGIN ! This should apply to the source
IF .sflags[F_DESCRIPTION] ! Seen one of these already?
THEN IF .sflags[F_FILESPEC] ! Yes, give proper error message
THEN PE('Multiple source DESCRIPTION files specified')
ELSE PE('Multiple global DESCRIPTION files specified');
JSYS_DVCHR(.r2; device_chars); ! Get the device characteristics
IF .device_chars<18,9,0> NEQ $DVDSK ! Is it a disk?
THEN IF .sflags[F_FILESPEC] ! No, give proper error message
THEN PE('Source DESCRIPTION file must be on disk')
ELSE PE('Global DESCRIPTION file must be on disk');
sflags[F_DESCRIPTION] = SEEN; ! We have seen this switch
JSYS_JFNS(CH$PTR(reqblk[DIU$T_SOURCE_DESCRIPTION]),.r2,jfns_all);
reqblk[DIU$H_SOURCE_DESCRIPTION] =
ASCIZ_LEN(CH$PTR(reqblk[DIU$T_SOURCE_DESCRIPTION]));
END;
! If both the destination and source filespec have been seen OR neither has
! been seen (i.e. its a global switch) then the filespec applies to the
! destination. Check for switch conflicts and insure JFN refers to disk before
! copying the description filespec into the reqblk.
IF .sflags[F_FILESPEC] EQL .dflags[F_FILESPEC] ! If neither or both seen
THEN BEGIN ! desc applies to destination
IF .dflags[F_DESCRIPTION] ! Been here before?
THEN PE('Multiple destination DESCRIPTION files specified');
JSYS_DVCHR(.r2; device_chars); ! Get the device characteristics
IF .device_chars<18,9,0> NEQ $DVDSK ! Is it a disk?
THEN PE('Destination DESCRIPTION file must be on disk'); ! No
dflags[F_DESCRIPTION] = SEEN; ! Remember we have done this
JSYS_JFNS(CH$PTR(reqblk[DIU$T_DESTINATION_DESCRIPTION]),.r2,jfns_all);
reqblk[DIU$H_DESTINATION_DESCRIPTION] =
ASCIZ_LEN(CH$PTR(reqblk[DIU$T_DESTINATION_DESCRIPTION]));
END;
! Release the JFN and restore the command state for further parsing.
JSYS_RLJFN(.r2); ! Free the JFN we got from COMND
RSTSTA(); ! Pop back to main parse state
END;
%SBTTL 'Routine DIUCMD'
GLOBAL ROUTINE DIUCMD (command_source) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine sets up the stateblock for the COMND JSYS, and calls
! COMAND. COMAND then calls the various action routines to process the
! command line(s). When COMAND returns (after a command has been
! completed) then we exit if we are processing a CCL command line.
! Otherwise we call call COMAND to work on more commands.
!
! FORMAL PARAMETERS:
!
! COMMAND_SOURCE: JFN to read command from, or 0 for terminal.
!
! SIDE EFFECTS:
!
! COMAND is called.
!
!--
LOCAL status; ! Status returned by COMAND
ENABLE DIU$ABORT; ! Catch stuff here
IF .tty[IOB$V_OPEN] EQL 0 ! Opened TTY yet?
THEN $XPO_OPEN (IOB=tty,
CHARACTERS=256, ! 256 char buffer
FILE_SPEC=$XPO_INPUT, ! No
ATTRIBUTES=STREAM ); ! so do so
! Reset the command state block. Input is from $PRIIN unless something else is
! specified (in the case of an indirect command file).
stateb[$CMIOJ] = ($PRIIN^18)+$PRIOU; ! Assume terminal IO for now
stateb[$CMFLG] = CM_XIF; ! Handle @ ourselves
stateb[$CMRTY] = CH$PTR(prompt_buf); ! Pointer to prompting string
stateb[$CMBFP] = STATEB[$CMPTR] = CH$PTR(cbuf); ! Pointer to cmd buf
stateb[$CMCNT] = CBUF_LEN; ! Number of characters free in buffer
stateb[$CMINC] = 0; ! Count of unparsed characters
stateb[$CMABP] = CH$PTR(atom_buf); ! Pointer to atom buffer
stateb[$CMABC] = ATOM_LEN; ! Size of atom buffer
stateb[$CMGJB] = jfnblk; ! block for GTJFN long form
! Reset comand package storage.
cmderr = 0; ! Reset return on error flag
cmderp = 0; ! Reset error message for noparse
cmdnpt = EXIT_STATE; ! Return control here on noparse
cmdrpt = ACCEPT_COMMAND; ! State for reparse to begin
cmdrpr = INIT_REQUEST; ! Routine to call on a reparse
! Reset the I/O JFNs for COMND if we are doing a TAKE file.
IF .command_source EQL 0 ! Only check this if
THEN BEGIN ! reading from terminal
IF RCLINE() ! If there is a rescanable command
THEN BEGIN ! then process it
ccl_mode = 1; ! Exit after this command
(stateb[$CMIOJ])<LH> = $CTTRM; ! Rescan input is put in
END ! job ctl tty, not fork ctl tty
ELSE ccl_mode = 0; ! Reading command from terminal
END
ELSE BEGIN
stateb[$CMIOJ] = (.command_source^18)+$NULIO; ! Set JFN
END;
! We are now ready to process commands.
DO BEGIN
MAKEPROMPT(); ! Create the proper prompt please
status = COMAND(NEW_COMMAND, stateb, db); ! Call COMAND package
! Figure out what to do next, if status returned is 0 then loop, if end of
! command file then exit the routine, and if any other status give an error.
SELECT .status OF
SET
[0]: ; ! End of command
[IOX4,COMNX9]: EXITLOOP status = SS$_NORMAL; ! End of command file
[OTHERWISE]: DIU$MESSAGE(.status,0,0,FALSE); ! Other errors
TES;
END
! Exit DIU after doing one command if CCL mode, unless doing a TAKE from CCL.
WHILE ((NOT .ccl_mode) OR .takeflag);
IF .ccl_mode AND NOT .takeflag ! Is this the end of a CCL command?
THEN S$HALT(); ! Yes, exit since we are done here
RETURN(.status) ! Return the status to caller
END; ! DIUCMD
%SBTTL 'Routine DSTFIL'
ROUTINE DSTFIL (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called when the destination filespec has been seen, as
! parsed by $CMFIL (JFN in R2) or $CMQST (string in atom_buf). If the
! filespec was terminated by a quote, then whatever was parsed must be a
! VMS style node name with access information, so we call DSTNOD to
! process it. Otherwise, the node name of the destination (if any) has
! been copied to the destination file area already. A jobname is created
! and stored in the request block.
!
! FORMAL PARAMETERS:
!
! R2: JFN if not FILE_QUOTED
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command Component Context: FILE_QUOTED if a quoted filespec
!
! IMPLICIT INPUTS:
!
! reqblk[DIU$H_FUNCTION]: which command function we are doing today
! p_dfil: byte pointer to destination filespec
! p_dst: byte pointer to destination area in request block
! atom_buf: atom buffer
! dflags: destination file flags
!
! IMPLICIT OUTPUTS:
!
! dflags[F_FILESPEC] is set
! cmdsta: set to proper next command state
! p_dst: updated
! reqblk: has destination filespec added to it
! reqblk[DIU$?_JOBNAME] is set up with the jobname
!--
LOCAL device_chars, ! Local file characteristics
jfns_bits, ! Make JFNS bits here
jfns_arg: VECTOR[CH$ALLOCATION(40)]; ! Place to look at the device
! See if this was actually a VMS style node spec and if so call the routine
! that wanted to process it in the first place.
IF .context NEQ FILE_QUOTED AND CH$RCHAR(.stateb[$CMPTR]) EQL %C'"'
THEN BEGIN ! yes, must have been a node spec
DSTNOD(0,0,0); ! Call the correct routine
JSYS_RLJFN(.r2); ! Release the JFN
RETURN; ! and return
END;
! Remember we've seen the filespec.
dflags[F_FILESPEC] = SEEN;
! Select next command state based on function. Wildcards illegal for APPEND,
! this is checked here because GJ_OFG allows wildcards.
SELECTONE .reqblk[DIU$H_FUNCTION] OF
SET
[DIU$K_APPEND] : BEGIN
IF (.r2 AND any_wildcards) NEQ 0
THEN PE('Wildcards illegal for destination file');
cmdsta = APPEND_CONFIRM;
END;
[DIU$K_COPY] : cmdsta = COPY_CONFIRM;
[DIU$K_DIRECTORY] : cmdsta = DIRECTORY_CONFIRM;
[OTHERWISE] : cmdsta = REQUEST_CONFIRM;
TES;
! If a remote quoted filespec, set up the file storage area with the string
! from the atom buffer, defaulting to def_fs if there is nothing in the atom
! buffer. If a remote non-quoted filespec, we want to expand the jfn
! furnished; but we don't want to get the device of DSK. If a local filespec
! do a full expansion of everything to the buffer.
IF .dflags[F_NODE] ! Has a node name been seen?
THEN BEGIN ! Start of a remote filespec checks
MOVEAZ(%REF(PP('::')),p_dfil); ! Add coloncolon after nodename
IF .context EQL FILE_QUOTED ! Quoted filespec?
THEN BEGIN ! Quoted remote file copies atom buffer
IF CH$RCHAR(.stateb[$CMABP]) EQL 0 ! Anything in the buf?
THEN MOVEAZ(%REF(CH$PTR(def_fs)),p_dfil) ! If nothing use def
ELSE MOVEAZ(%REF(.stateb[$CMABP]),p_dfil); ! else append atom buff
END ! End quoted remote filespec
ELSE BEGIN ! Non-quoted remote filespec does JFNS
jfns_arg = 0; ! Insure firstword is zeroed
JSYS_JFNS(CH$PTR(jfns_arg),.r2,jfns_dev); ! Get the device
jfns_bits = (IF .jfns_arg EQL 'DSK' ! If it was DSK
THEN jfns_all-jfns_dev ! Don't include device
ELSE jfns_all); ! It wasn't, include the dev
JSYS_JFNS(.p_dfil,.r2,.jfns_bits); ! Expand the filespec
END; ! End non-quoted remote dest filespec
END ! End remote destination file
ELSE BEGIN ! Local destination file
JSYS_DVCHR(.r2<RH>; device_chars); ! Get the device chars
IF .device_chars<18,9,0> NEQ $DVDSK ! Is it a disk?
THEN BEGIN ! No
IF .reqblk[DIU$H_FUNCTION] NEQ DIU$K_DIRECTORY ! DIR command?
THEN PE('Destination file must be on disk'); ! No, illegal
END
ELSE dflags[F_ON_DISK] = TRUE; ! The destination is on disk
JSYS_JFNS(.p_dfil,.r2,jfns_all); ! Use the complete filespec for storage
END; ! end local destination file
! Cap off any global tags that may have been parsed in preparation to copy the
! filepec to the dest area. Then make the expanded name ASCIZ and copy it to
! the request block.
CH$WCHAR_A($ETG,p_dst); ! Write a end tag to the dest area
CH$WCHAR_A(ASCIZ_LEN(CH$PTR(dst_fil)),p_dst); ! Write length of filespec
MOVEAZ(%REF(CH$PTR(dst_fil)),p_dst); ! Write filename to request block
! Use the output spec filename as the jobname if not wildcarded and not a
! quoted string, otherwise call someone and have them set up the jobname.
IF .context NEQ FILE_QUOTED AND (.R2 AND GJ_NAM) EQL 0
THEN BEGIN
JSYS_JFNS(CH$PTR(def_name),.r2,jfns_nam); ! Make default
reqblk[DIU$H_JOBNAME] = MIN(ASCIZ_LEN(CH$PTR(def_name)),6); ! Set length
CH$COPY(.reqblk[DIU$H_JOBNAME],CH$PTR(def_name), ! Source length, ptr,
0,6,CH$PTR(reqblk[DIU$T_JOBNAME])); ! Dest fill, len, ptr
END
ELSE MKJOBNAME(); ! Or make it up from something
! Release JFN recieved from COMND
IF .context NEQ FILE_QUOTED
THEN JSYS_RLJFN(.R2);
END; ! dstfil
%SBTTL 'Routine DSTNOD'
ROUTINE DSTNOD (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called when the destination node has been seen.
! The node name is copied to the destination filespec area.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context.
! VALID_NODE means the node has been parsed CMNOD call.
!
! IMPLICIT INPUTS:
!
! atom_buf: the atom buffer
! p_dfil: pointer to destination filespec area
!
! IMPLICIT OUTPUTS:
!
! dst_node: node name copied here for later use.
! dst_fil: node name copied there to start complete filespec
! jfnblk: changed to parse filespec for append/copy
!
!--
LOCAL peek_chr; ! Character we are peeking at
! First, remember we have been here for later checks.
dflags[F_NODE] = SEEN; ! Mark the node name as being seen
! Check length of node name, and make sure nothing illegal was typed. If it
! was illegal, spit out an error message similar to what the COMAND package
! would print. This grossness along with other related uglyness is needed for
! VMS style nodespecs. DIU is the only 36 bit program in existance to accept
! these gross nodespecs, and as we all know Spitbrook always does it right.
IF .context NEQ VALID_NODE ! If not from CMNOD
THEN BEGIN ! then give me error messages here
peek_chr = CH$RCHAR(.stateb[$CMPTR]); ! Peek at the "next" field
IF .peek_chr NEQ %C'"' AND .peek_chr NEQ %C':'
THEN BEGIN ! Error should be file not (yet) found
IF CH$RCHAR(.stateb[$CMABP]) EQL 0 ! Is anything in the buffer?
AND (.peek_chr EQL $CHCRT OR .peek_chr EQL $CHLFD) ! No file?
THEN PE('Missing destination filename'); ! Missing destination
IF .peek_chr EQL %C'/' ! Switch?
THEN PARERR(PP('Does not match switch: "')) ! Yes, it was a switch
ELSE PARERR(PP('Illegal destination filespec: "')); ! No, ill spec
JSYS_PSOUT(.stateb[$CMPTR]); ! print the unparsed chars
JSYS_PSOUT(PP(%STRING('"',crlf))); ! make it look nice and neat
RETURN; ! and return
END;
IF CH$RCHAR(.stateb[$CMABP]) EQL 0 ! Is anything in the buffer?
THEN PE('Blank destination node name'); ! Nope, CMFLD gave us nothing.
END;
! Check the node for validity, note that if it is offline or not accessible
! now, we will treat it as ok.
IF NOT S$NODE_CHECK(ASCIZ_LEN(.stateb[$CMABP]),.stateb[$CMABP]) ! Valid node?
THEN PE('Illegal destination node name'); ! Nope, give error message
! I may be wrong, but the node looks OK to me. Move it into the filespec area.
MOVEAZ(%REF(.stateb[$CMABP]),p_dfil); ! Move it to the dest file buffer.
MOVEAZ(%REF(.stateb[$CMABP]),%REF(CH$PTR(dst_node))); ! Save just the node
! Set up jfnblk: suppress logical name expansion; turn off the message bit,
! the wild bit, and the for output bit; insure that the parse only bit is lit.
jfnblk[$GJF2] = G1_SLN+G1_LOC; ! No log nam exp, local spec only
!!jfnblk[$GJGEN] = (.jfnblk[$GJGEN] AND NOT (GJ_MSG+GJ_FOU+GJ_IFG)) OR GJ_OFG;
jfnblk[$GJGEN] = (.jfnblk[$GJGEN] AND NOT (GJ_MSG+GJ_IFG)) OR GJ_OFG;
END; ! DSTNOD
%SBTTL 'Routine EXIT_COMMAND'
ROUTINE EXIT_COMMAND (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Action routine for the EXIT command: exit to the monitor.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! MST_FLAG: If set we are the spooler and must STOP before exiting
!
!--
IF .mst_flag ! Are we (yet) the spooler?
THEN BEGIN ! Yes
IF .shutdown ! In the middle of a shutdown?
THEN JSYS_ESOUT(PP(%STRING('DIU Spooler active, please wait for active requests to finish',CRLF)))
ELSE JSYS_ESOUT(PP(%STRING('DIU Spooler active, use STOP command to stop spooler',CRLF)));
END
ELSE S$HALT(); ! HALTF, allow continue.
END; ! EXIT_COMMAND
%SBTTL 'Routine FILE_ARGUMENT'
ROUTINE FILE_ARGUMENT (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called on a switch context when the thing to parse will
! be a file parsed with CMFIL. First it calls SW_ARGUMENT to remember
! the state and context that we were called from. It then defaults the
! extension to the word given in the CONTEXT (which is the actual ASCIZ
! text, not a pointer to ASCIZ text).
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (saved for later).
! CONTEXT: Command component context (ASCIZ default extension).
!
! IMPLICIT OUTPUTS:
!
! JFNBLK is set up to parse with the CMFIL functon of COMND.
!
! SIDE EFFECTS:
!
! Routine SW_ARGUMENT is called to save the command state.
!
!--
! Save the current command context for restoring later.
SW_ARGUMENT(.r2,.cstate,.context); ! Save the state of the world now
! Default the jfnblk for CMFIL parsing
jfnblk[$GJF2] = G1_LOC; ! Arguments are not remote filespecs
jfnblk[$GJEXT] = CH$PTR(context); ! Set default extension
IF .context EQL 'LOG' ! If we are parsing for a log file
THEN BEGIN
jfnblk[$GJGEN] = GJ_XTN+GJ_OLD+GJ_OFG; ! then set different flags
jfnblk[$GJNAM] = PP('DIU'); ! and default the filename too
jfnblk[$GJDIR] = CH$PTR(DEF_DIR); ! and the directory
END
ELSE jfnblk[$GJGEN] = GJ_XTN+GJ_OLD; ! else the file must be old
END; ! FILE_ARGUMENT
%SBTTL 'Routine FILFMT_SWITCH'
ROUTINE filfmt_switch (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process file format switches: (FBINARY, IMAGE, ISAM, RMS:). Checks for
! switch conflicts for the various file formats. The command state is
! checked to see if it is a global or local state. A global state will
! append tag information to both source and destination filespec buffers,
! while a local will cause only the source or dest buffer to be modified.
!
! FORMAL PARAMETERS:
!
! r2: Data from COMND monitor call (ignored).
! cstate: Parser's current state (ignored).
! context: Command component context (file format code).
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$T_???_FILESPEC] has tag information appended to it.
! sflags and/or dflags: F_FORMAT lit.
!
!--
LOCAL tag_field,
tag_value;
! First check for switch conflicts between the various file formats, and that
! the /KEY switch hasn't been typed without /RMS:INDEXED switch. Note that
! once /IMAGE has been typed no other file formats are legal.
IF .dflags[F_FILESPEC]
THEN BEGIN ! source only
IF .dflags[F_FORMAT]
THEN PE('Multiple file format switches for destination filespec');
dflags[F_FORMAT] = SEEN;
IF .dflags[F_KEY] AND .context NEQ FAB$K_IDX
THEN PE('/KEY only legal with /RMS:INDEXED file format');
IF .context EQL FAB$K_IDX
THEN dflags[F_RMS_INDEXED] = SEEN;
END
ELSE BEGIN ! destination only
IF .sflags[F_FORMAT]
THEN IF .sflags[F_FILESPEC]
THEN PE('Multiple file format switches for source filespec')
ELSE PE('Multiple global file format switches');
sflags[F_FORMAT] = SEEN;
IF NOT .sflags[F_FILESPEC]
THEN BEGIN ! global
dflags[F_FORMAT] = SEEN;
IF .context EQL FAB$K_IDX
THEN dflags[F_RMS_INDEXED] = SEEN;
END;
END;
! Since /IMAGE is only global, it is somewhat easier to check for
IF .context EQL DIU$K_IMAGE
THEN BEGIN
IF .sflags[F_DESCRIPTION] OR .dflags[F_DESCRIPTION]
THEN PE('/DESCRIPTION illegal with /IMAGE file format');
IF .rflags[R_TRANSFORM]
THEN PE('/TRANSFORM illegal with /IMAGE file format');
rflags[R_IMAGE] = SEEN;
END;
! Set up tag_field and tag_value with proper codes
SELECTONE .context OF
SET
[FAB$K_SEQ,
FAB$K_REL,
FAB$K_IDX] : BEGIN ! /RMS:[RELATIVE|SEQUENTIAL|INDEX]
tag_field = diu$k_fab_org; ! Organization is
tag_value = .context; ! whatever the context says
END;
[DIU$K_LIBOL]: BEGIN ! /LIBOL:n
SW_ARGUMENT(.r2,.cstate,.context); ! Save the world now
tag_field = diu$k_diu_file_datatype; ! Its a file type class
tag_value = TYP$K_IMAGE; ! that is image
END;
[DIU$K_IMAGE]: BEGIN ! /IMAGE
tag_field = diu$k_fab_fac; ! Fac field in fab
tag_value = fab$m_bio; ! Block io
END;
[OTHERWISE]: BEGIN ! /FBINARY /ISAM
tag_field = diu$k_diu_file_datatype; ! Its a file datatype
tag_value = .context; ! context is type
END;
TES;
! All is ok, add tag_field and tag_value to the tag list as required.
IF .dflags[F_FILESPEC]
THEN ADD_TAG(.tag_field, ! add tag to dest if dest spec seen
diu$k_tag_integer,
.tag_value,
%bpval/ch$size(),
p_dst)
ELSE BEGIN
ADD_TAG(.tag_field, ! No dest file, add tag to source
diu$k_tag_integer,
.tag_value,
%bpval/ch$size(),
p_src);
IF NOT .sflags[F_FILESPEC] ! No dest or source, add tag to dest
THEN ADD_TAG(.tag_field,
diu$k_tag_integer,
.tag_value,
%bpval/ch$size(),
p_dst);
END;
IF .context NEQ DIU$K_LIBOL ! If its not /LIBOL:n
THEN RSTSTA(); ! then restore state
END; ! FILFMT_SWITCH
%SBTTL 'Routine FOP_SWITCH'
ROUTINE fop_switch (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Set a bit in the FOP as requested by a switch, switches are output side
! only. Checks for multiple /CONTIGUOUS switches.
!
! FORMAL PARAMETERS:
!
! r2 : Data From COMND Monitor Call.
! cstate : Parser's Current State.
! context : Command Component Context: bit mask of bits to set for FOP
!
! IMPLICIT INPUTS:
!
! dflags[F_FILESPEC]: Flag for dest filespec seen
!
! IMPLICIT OUTPUTS:
!
! none
!
!--
SELECT .context OF
SET
[FAB$M_CTG, (NOT FAB$M_CTG)]:
BEGIN
IF .dflags[F_CONTIG]
THEN PE('Multiple /CONTIGUOUS switches');
dflags[F_CONTIG] = SEEN;
END;
TES;
! Add the context to the tag list for the output filespec.
ADD_TAG(diu$k_fab_fop,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_dst);
END; ! FOP_SWITCH
%SBTTL 'Routine HELP'
ROUTINE HELP (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Print HELP message. The context of external table HLPTAB points to
! massive text strings that we print out. HLPTAB is filled in by HLPINI
! which is in module DIUHLP.B36. If no help keywird is specified then
! def_help is printed out.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context: address of descriptor to type out.
!
!--
! Insure there is a valid context before setting the help descriptor address.
IF .context NEQ 0 THEN helpdesc = .context;
S$CRIF(); ! Get to left margin
$XPO_PUT(IOB=TTY, STRING=.helpdesc); ! Type the text, work done by DIUHLP
END; ! HELP
%SBTTL 'Routine INIT_REQUEST'
ROUTINE INIT_REQUEST (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Initialize everything associated with source & destination filespecs.
! Called only as $CMINI action routine.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (not used).
!
! IMPLICIT INPUTS:
!
! def_root: default for the defaults
!
! IMPLICIT OUTPUTS:
!
! reqblk: reset, log file spec defaulted from def_root
! (see below for other storage that is reset)
!
! SIDE EFFECTS:
!
! Q$REQ_BLOCK_INIT is called to reset the reqblk.
!--
! Perform calls to reset storage.
CLEARV(jfnblk); ! Zero jfnblk
Q$REQ_BLOCK_INIT(reqblk); ! clean the request block
! Init the source and destination filespec pointers to the request block
p_src = CH$PTR(reqblk[DIU$T_SOURCE_FILESPEC]);
p_dst = CH$PTR(reqblk[DIU$T_DESTINATION_FILESPEC]);
! Wipe the destination holding buffer clean and init the pointer to it.
p_dfil = CH$PTR(dst_fil);
CH$FILL(0,NAM$K_MAXRSS,CH$PTR(dst_fil));
! Reset switches to their defaults.
queue_value = DIU$K_MAYBE_QUEUE; ! Default to /QUEUE:YES
shq_verbosity = FALSE; ! Default SHOW QUEUE /NORMAL
! Restore the other parsing storage
sflags = 0; ! Clear source fields & switches seen
dflags = 0; ! Clear dest fields & switches seen
rflags = 0; ! Clear request flags
moptions = 0; ! Clear modify options
savsta = 0; ! Clear saved command state
idtnc_block[2] = 0; ! Clear seconds since midnight
days = 0; ! Clear number of days in future
stopswitches = 0; ! Clear STOP command switches
patpar_warn = 0; ! Set to show no patpar warnings yet!
END; ! INIT_REQUEST
%SBTTL 'Routine LIST_SWITCH'
ROUTINE LIST_SWITCH (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Store verbosity level of DIRECTORY list (/BRIEF, /FULL, /LIST)
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context: bit mask of bits to set for FOP
!
!--
reqblk[DIU$Z_LIST_LEVEL] = .context; ! Is that all there is?
END; ! LIST_SWITCH
%SBTTL 'Routine MAKEPROMPT'
GLOBAL ROUTINE MAKEPROMPT : NOVALUE =
BEGIN
!++
! Functional description
!
! This routine sets the prompt string to the proper value based on
! the ccl_mode flag and the takeswitches.
!
! Implicit inputs:
! mst_flag: 1 if we are the spooler
! ccl_flag: 1 if running ccl command
! takeswitches: TAK_ECHO if echoing take commmands
!
! Implicit outputs:
! prompt_buf: set with either "DIU>" or "DIU spooler>" in ASCIZ.
IF (.takeflag AND (.takeswitches EQL TAK_NOECHO)) ! Should we prompt?
OR (.ccl_mode AND NOT .takeflag)
THEN prompt_buf = 0 ! No prompting now
ELSE BEGIN ! We should prompt
%IF %SWITCHES(DEBUG) ! If debug mode
%THEN
IF .mst_flag ! are we the (yet) the spooler?
THEN CH$COPY(16,PP('DIUDEB spooler>'),0,16,CH$PTR(prompt_buf)) ! Yes
ELSE CH$COPY(8,PP('DIUDEB>'),0,8,CH$PTR(prompt_buf)); ! No
%ELSE
IF .mst_flag ! are we the (yet) the spooler?
THEN CH$COPY(13,PP('DIU spooler>'),0,13,CH$PTR(prompt_buf)) ! Yes
ELSE prompt_buf = %ASCIZ'DIU>' ! We are not (yet) the spooler
%FI
END;
END; ! MAKEPROMPT
%SBTTL 'Routine MANIPULATE_REQUESTS'
ROUTINE MANIPULATE_REQUESTS (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Perform CANCEL, MODIFY, HOLD, KILL, RELEASE command actions.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! reqblk: Request block to select requests to mung
! mfunction: the function code is stored here by pre_manipulate.
! moptions: indicates what will be modified.
!
!--
IF NOT .rflags[R_REQUESTID] ! Any request id seen?
THEN PE('Missing request id number'); ! Nope
DIU$MODIFY(reqblk,.mfunction,moptions); ! Perform mod/kill/hold/release
END; ! MANIPULATE_REQUESTS
%SBTTL 'Routine MKJOBNAME'
ROUTINE MKJOBNAME : NOVALUE =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Make a job name out of whatever we can find. Try destination node
! name, source node name, and failing all that, make the job name LOCAL.
! The jobname is insured to be uppercase and ASCIZ when created.
!
! IMPLICIT INPUTS:
!
! dflags[F_NODE], dst_node
! sflags[F_NODE], src_node
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$?_JOBNAME]
!--
LOCAL j_chr, ! Character we are looking at now
j_ptr, ! Source jobname pointer
o_ptr; ! Destination jobname pointer
IF .dflags[F_NODE] ! Is there destination nodename?
THEN j_ptr = CH$PTR(dst_node) ! Yes use that
ELSE BEGIN
IF .sflags[F_NODE] ! Is the *last* source filespec remote?
THEN j_ptr = CH$PTR(src_node) ! Yes, use that
ELSE j_ptr = PP('LOCAL'); ! Otherwise use LOCAL
END;
reqblk[DIU$H_JOBNAME] = MIN(ASCIZ_LEN(.j_ptr),6); ! Set length of string
o_ptr = CH$PTR(reqblk[DIU$T_JOBNAME]); ! Init pointer to it
INCR i FROM 1 to .reqblk[DIU$H_JOBNAME] ! Now copy the jobname over to reqblk
DO BEGIN ! For each character in the string do
j_chr = CH$RCHAR_A(j_ptr); ! Get a character
IF (.j_chr GEQ %C'a') ! Is the character
AND (.j_chr LEQ %C'z') ! lowercase?
THEN j_chr = .j_chr-(%C'a'-%C'A'); ! Yes, make it uppercase
CH$WCHAR_A(.j_chr, o_ptr); ! Put a character
END;
CH$WCHAR_A(0,o_ptr) ! Insure ASCIZ
END; ! MKJOBNAME
%SBTTL 'Routine PARERR'
ROUTINE PARERR (text) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! PARERR is called with a pointer to an ASCIZ string to publish on the
! terminal on a parse of some illegal field parsed.
!
! FORMAL PARAMETERS:
!
! text: Pointer to ASCIZ string to print on terminal
!--
LOCAL peek_chr, ! Character we are peeking at
peek_ptr; ! Pointer to characters to peek for
! First output the standard error message and the text that was furnished us.
JSYS_ESOUT(PP('DIU command error: '));
JSYS_PSOUT(.text);
! If I'm in the middle of a switch parse, run my finger backwards over the
! command buffer until I hit a slash, the beginning of the switch that caused
! me to stop here. If we are not in a switch, then we want to go back until we
! see a space or comma, leaving that in the buffer. Now I know all of this
! looks ugly, but it does seem to work properly.
IF .savsta NEQ 0 ! Are we in a switch?
THEN UNTIL .stateb[$CMCNT] EQL CBUF_LEN ! Until we have searched the buffer
DO BEGIN ! look backwards
stateb[$CMPTR] = CH$PLUS(.stateb[$CMPTR],-1); ! Backup a character
stateb[$CMCNT] = .stateb[$CMCNT] + 1; ! Incr free space
IF CH$RCHAR(.stateb[$CMPTR]) EQL %C'/' ! At a slash?
THEN EXITLOOP; ! Yes, exit
END ! End of UNTIL DO
ELSE BEGIN
UNTIL .stateb[$CMCNT] EQL CBUF_LEN ! Until we have searched the buffer
DO BEGIN ! Eat spaces backwards first
peek_chr = CH$RCHAR(.stateb[$CMPTR]); ! Peek at a character
IF .peek_chr NEQ %C' ' ! Is the peeked character a space?
THEN EXITLOOP; ! No, we can start looking for real
stateb[$CMPTR] = CH$PLUS(.stateb[$CMPTR],-1); ! Backup a character
stateb[$CMCNT] = .stateb[$CMCNT] + 1; ! Incr free space
END; ! Loop until trailing spaces eaten
UNTIL .stateb[$CMCNT] EQL CBUF_LEN ! Until we have searched the buffer
DO BEGIN ! look backwards
peek_chr = CH$RCHAR(.stateb[$CMPTR]); ! Peek at a character
IF .peek_chr EQL %C'/' ! Is the character a warped switch
OR .peek_chr EQL $CHCRT ! or the end of a command?
THEN EXITLOOP; ! Yes, exit
IF .peek_chr EQL %C' ' ! Is the peeked character a space?
OR .peek_chr EQL %C')' ! or the end of a noise word?
OR .peek_chr EQL %C',' ! or a comma between filespecs?
THEN BEGIN ! Yes, we have to re-include it
stateb[$CMPTR] = CH$PLUS(.stateb[$CMPTR],1); ! Forward over it
stateb[$CMCNT] = .stateb[$CMCNT]-1; ! Decr free space
EXITLOOP; ! And exit the loop
END;
stateb[$CMPTR] = CH$PLUS(.stateb[$CMPTR],-1); ! Backup a character
stateb[$CMCNT] = .stateb[$CMCNT] + 1; ! Incr free space
END; ! End of UNTIL DO
END;
! Normalize the command buffer by looking ahead for whatever doesn't print out
! well and zapping a null over it. This is done so we can print the command
! buffer out later.
peek_ptr = CH$PLUS(.stateb[$CMPTR],-1); ! Point to unparsed chars
DO BEGIN
peek_chr = CH$A_RCHAR(peek_ptr); ! Get character
IF .peek_chr EQL $CHESC OR ! Is it an escape
.peek_chr EQL $CHLFD OR ! or a linefeed
.peek_chr EQL $CHCRT OR ! or a carriage return
.peek_chr EQL $CHFFD ! or a form feed?
THEN BEGIN ! Yes, its time to stop looking
CH$WCHAR(0,.peek_ptr); ! Put a null there
EXITLOOP; ! and exit the loop
END;
END
WHILE .peek_chr NEQ 0; ! Until we see a null
! Reset the command state to be the exit state, causing COMAND to return, and
! also light the noparse bit. Then return.
stateb[$CMFLG] = .stateb[$CMFLG] OR CM_NOP; ! Turn on noparse bit
savsta = 0; ! There is no longer a saved cmd state
cmdsta = EXIT_STATE; ! The next state is the exit state
END; ! PARERR
%SBTTL 'Routine PRE_INPUT'
ROUTINE PRE_INPUT (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Set up the request block with the request type from the main command
! table. Sets up the GTJFN long block with the proper flags for CMFIL
! parsing of a possibly wildcarded input file. Called with the context
! containing the DIU function code (if at the start of a command).
! Called with a context of zero when a comma has been typed to input
! additonal filespecs.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: DIU request function code, or 0 if the function has been set.
!
! IMPLICIT OUTPUTS:
!
! REQBLK: Function code and prereq is filled in, rest cleared
! JFNBLK: Set up as specified below with flags for some commands.
!
!--
! First copy the request function into the reqblk if the context if nonzero
IF .context NEQ 0 ! Called after a comma?
THEN reqblk[DIU$H_FUNCTION] = .context ! Nope, first call this line, set fcn
ELSE sflags[F_NODE] = FALSE; ! Yep, reset only flag that matters
! Reset the file collection pointer for source files and default filespec
def_fs = 0; ! Zero the first word is good enough
p_sfil = CH$PTR(src_fil); ! Reset source pointer
CH$FILL(0,NAM$K_MAXRSS,CH$PTR(src_fil)); ! Zero fill the buffer
! Setup default jfnblk to allow for old local files.
jfnblk[$GJGEN] = GJ_IFG+GJ_OFG+GJ_FLG+GJ_XTN+GJ_OLD;
jfnblk[$GJF2] = G1_LOC; ! Set node name illegal in file spec
! Special cases of the jfnblk are modified here. SUBMIT command should default
! ext to CTL. DELETE command should default generation to *. DIRECTORY
! command should default the listing level and filename to *.*.*
IF .reqblk[DIU$H_FUNCTION] EQL DIU$K_SUBMIT ! Default extension to CTL
THEN jfnblk[$GJEXT] = PP('CTL');
IF .reqblk[DIU$H_FUNCTION] EQL DIU$K_DELETE ! Default to all gens
THEN jfnblk[$GJGEN] = GJ_IFG+GJ_OFG+GJ_FLG+GJ_XTN+GJ_OLD+$GJALL<RH>;
IF .reqblk[DIU$H_FUNCTION] EQL DIU$K_DIRECTORY
THEN BEGIN
jfnblk[$GJNAM] = PP('*'); ! Default name to "*"
jfnblk[$GJEXT] = PP('*'); ! Default ext to "*"
jfnblk[$GJGEN] = GJ_IFG+GJ_OFG+GJ_FLG+GJ_XTN+GJ_OLD+$GJALL<RH>;
MOVEAZ(%REF(PP('*.*.*')),%REF(CH$PTR(def_fs))); ! default the filename
reqblk[DIU$Z_LIST_LEVEL] = DIU$K_LIST_NORMAL;
END;
END; ! PRE_INPUT
%SBTTL 'Routine PRE_MANIPULATE'
ROUTINE PRE_MANIPULATE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the number from CONTEXT to call DIU$MODIFY with later.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (type of command executed).
!
! IMPLICIT OUTPUTS:
!
! mfunction: Set to the type of command we are executing.
!--
mfunction = .context; ! Save function code
END; ! manipulate action
%SBTTL 'Routine PRE_OUTPUT'
ROUTINE PRE_OUTPUT (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called when the destination filespec is about to be
! parsed. We set up jfnblk with the proper flags and default name and
! type fields, as well as a default local filename. The default local
! filespec (def_fs) is used because a command of the form "COPY
! GARK::A.B" would cause a blank CMFLD to be parsed resulting in a "blank
! destination node name illegal" error message.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! REQBLK[DIU$H_FUNCTION]
!
! IMPLICIT OUTPUTS:
!
! cmdsta: set to next state depending on the function specified
! jfnblk: set to new flags and default strings
! def_fs: set to a new default output filespec
!--
! Set up default jfnblk cells, which may be modified below.
jfnblk[$GJGEN] = GJ_IFG+GJ_OFG+GJ_XTN+GJ_FLG+GJ_FOU+GJ_MSG;
jfnblk[$GJF2] = G1_LOC;
! Function-specific actions
SELECTONE .reqblk[DIU$H_FUNCTION] OF
SET
! If a DIRECTORY command, default directory output file extension to DIR.
! Default directory filename to the node name specified, or LOCAL if local.
! Default the output filename for the default option on the first flddb after
! the input filespec. Don't allow wildcards on the output spec.
[DIU$K_DIRECTORY]: BEGIN
cmdsta = DIRECTORY_GET_OUTPUT;
jfnblk[$GJGEN] = GJ_XTN+GJ_FLG+GJ_FOU+GJ_MSG;
IF .sflags[F_NODE] ! *last* source was remote?
THEN jfnblk[$GJNAM] = CH$PTR(src_node)
ELSE jfnblk[$GJNAM] = PP('LOCAL');
jfnblk[$GJEXT] = PP('DIR');
END;
! If append then we don't allow wildcards on the output spec.
[DIU$K_APPEND]: BEGIN
cmdsta = COPY_GET_OUTPUT;
jfnblk[$GJGEN] = GJ_OFG+GJ_XTN+GJ_FLG;
END;
! The other functions just need the next command state set.
[DIU$K_COPY]: cmdsta = COPY_GET_OUTPUT;
[DIU$K_PRINT]: cmdsta = PRINT_GET_OUTPUT;
[DIU$K_SUBMIT]: cmdsta = SUBMIT_GET_OUTPUT;
[DIU$K_RENAME]: cmdsta = RENAME_GET_OUTPUT;
TES;
! Set up default filespec area for parsing in the cmcma block.
CH$COPY(ASCIZ_LEN(.jfnblk[$GJNAM]),.jfnblk[$GJNAM],
1,PP('.'),
ASCIZ_LEN(.jfnblk[$GJEXT]),.jfnblk[$GJEXT],
0,NAM$K_MAXRSS,CH$PTR(def_fs));
END; ! PRE_OUTPUT
%SBTTL 'Routine PRE_TAKE'
ROUTINE PRE_TAKE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Set default take mode after TAKE verb, EXECUTE verb, or "@" token
! parsed. Also sets the jfnblk flags appropriately and the default file
! type to CMD.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! new_takeswitches: set to def_takeswitches
! jfnblk[$GJGEN]: set for old file
! jfnblk[$GJF2]: set to disallow network filespecs
! jfnblk[$GJEXT]: set to default to .CMD
!--
jfnblk[$GJGEN] = GJ_OLD+GJ_XTN; ! Old file, long form blk
jfnblk[$GJF2] = G1_LOC; ! Local file
jfnblk[$GJEXT] = PP('CMD'); ! Default file extension
new_takeswitches = .def_takeswitches; ! Default take switches
END; ! PRE_TAKE
%SBTTL 'Routine PUSH'
ROUTINE PUSH (r2, cstate, context) : NOVALUE =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to service the PUSH (and SPAWN) commands. It
! attempts to continue any old EXEC left around from previous PUSHes
! first. If there is no old fork around it gets a new EXEC JFN from the
! proper system area (logical name DEFAULT-EXEC:), creates a fork, puts
! the EXEC there, and starts it. After starting the inferior it waits
! for it to terminate (POP command).
!
!
! FORMAL PARAMETERS:
!
! r2 : data from COMND monitor call (ignored).
! cstate : parser's current state (ignored).
! context : command component context (ignored).
!
! IMPLICIT INPUTS:
!
! frkhnd: fork handle of any old fork we created
!
! IMPLICIT OUTPUTS:
!
! frkhnd: if a for is created, new fork handle
!
! SIDE EFFECTS:
!
! A number of inferior forks may be created.
!
!--
BEGIN
LOCAL addtext : $STR_DESCRIPTOR (STRING = 'for DEFAULT-EXEC:'),
execjfn, ! Jfn for the exec
caps; ! Inferior fork's set capabilites
IF .frkhnd NEQ 0 ! Did a previous PUSH made a fork
THEN BEGIN ! Yes
IF JSYS_SFORK((SF_CON+.frkhnd)) ! Can it be continued?
THEN BEGIN ! Yes
JSYS_WFORK(.frkhnd); ! Wait for it to terminate
RETURN; ! Then return
END;
END;
! No old fork, so try to get a JFN for SYSTEM:EXEC.EXE
IF NOT JSYS_GTJFN(GJ_SHT+GJ_OLD,PP('DEFAULT-EXEC:'); execjfn)
THEN BEGIN ! Error, give it to me gently
DIU$MESSAGE(RMS$_CGJ, .execjfn, addtext, FALSE);
RETURN;
END;
! Try and create a fork with the EXEC in it.
IF NOT JSYS_CFORK (CR_CAP; frkhnd) ! Create a subfork with the same caps
THEN BEGIN ! Error, tall me about it
DIU$MESSAGE(DIU$_CANT_CREATE_FORK, .frkhnd, 0, FALSE);
RETURN;
END;
JSYS_RPCAP(.frkhnd; caps); ! get process capabilities
caps = .caps AND NOT SC_LOG; ! Don't let it log me out
JSYS_EPCAP(.frkhnd, .caps, 0); ! Enable the capabilities of the fork
JSYS_GET((.frkhnd^18)+.execjfn, 0); ! Copy EXEC.EXE into subfork
JSYS_SFRKV(.frkhnd, 0); ! Start the subfork at ev location 0
JSYS_WFORK(.frkhnd); ! Wait for it to complete (POP command)
END; ! PUSH
%SBTTL 'Routine QUEUE'
ROUTINE QUEUE (r2, cstate, context): NOVALUE = ! Process value of QUEUE switch
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process argument to /QUEUE switch. Disallows multiple /QUEUEs per
! command line.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (0: NO, 1:YES, 2:CONDITIONAL)
!
! IMPLICIT OUTPUTS:
!
! queue_value is set to the context.
!
!--
IF .rflags[R_QUEUE] ! have we seen a /QUEUE?
THEN PE('Multiple /QUEUE switches'); ! yes, punt him off
rflags[R_QUEUE] = SEEN; ! remember we have seen /QUEUE switch
queue_value = .context; ! Set the queue value
RSTSTA(); ! Restore command state
END; ! QUEUE
%SBTTL 'Routine RAT_SWITCH'
ROUTINE rat_switch (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process /CARRIAGE_CONTROL and /SPAN_BLOCKS switches.
!
! FORMAL PARAMETERS:
!
! r2: Data from COMND monitor call (ignored).
! cstate: Parser's current state (ignored).
! context: Command component context (value for RAT).
!
! IMPLICIT INPUTS:
!
! SFLAGS and DFLAGS
!
! IMPLICIT OUTPUTS:
!
! sflags and/or dflags[F_RAT]: Set for /CARRIAGE_CONTROL
! sflags and/or dflags[F_SPAM_BLOCKS]: Set for /SPAN_BLOCKS
!
! ROUTINE VALUE:
!
! NONE
!--
! Check for switch conflicts and set the switches seen bits. Note that
! /SPAN_BLOCKS can only be on the destination filespec and doesn't conflict
! with anything. /CARRIAGE_CONTROL can be global or source or destination.
IF .context EQL FAB$M_BLK ! If /NOSPAN_BLOCKS
OR .context EQL (NOT FAB$M_BLK) ! or /SPAN_BLOCKS
THEN BEGIN
IF .dflags[F_SPAM_BLOCKS] ! Spam, spam spam spam, Spam
THEN PE('Multiple /SPAN_BLOCKS switches on destination file');
dflags[F_SPAM_BLOCKS]=SEEN; ! Spam, eggs, spam, cheese, spam
END
ELSE BEGIN ! If /CARRIAGE_CONTROL
IF .dflags[F_FILESPEC]
THEN BEGIN
IF .dflags[F_RAT]
THEN PE('Multiple /CARRIAGE_CONTROL switches on destination file');
dflags[F_RAT]=SEEN;
END
ELSE BEGIN
IF .sflags[F_RAT]
THEN IF .sflags[F_FILESPEC]
THEN PE('Multiple /CARRIAGE_CONTROL switches on source file')
ELSE PE('Multiple global /CARRIAGE_CONTROL switches');
sflags[F_RAT]=SEEN;
IF NOT .sflags[F_FILESPEC]
THEN dflags[F_RAT]=SEEN;
END;
END;
! If we have a destination file parse state, we use add the tag to the dest
! file buffer only. If we have a source state, we add it to just the source
! file buffer. If we have a global state, it goes to both.
IF .dflags[F_FILESPEC]
THEN ADD_TAG(diu$k_fab_rat,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_dst)
ELSE BEGIN
ADD_TAG(diu$k_fab_rat,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_src);
IF NOT .sflags[F_FILESPEC]
THEN ADD_TAG(diu$k_fab_rat,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_dst);
END;
RSTSTA(); ! restore command state
END; ! rat_switch
%SBTTL 'Routine REQ_ID'
ROUTINE REQ_ID (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the request ID number for MODIFY, KILL, RELEASE, HOLD, CANCEL,
! NEXT commands.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (the number).
! CSTATE: Parser's current state.
! CONTEXT: Command component context.
!
! IMPLICIT OUTPUTS:
!
! request_id: the request id is stored here.
!
!--
IF .R2 LEQ 1 ! Request ids start at 2.
THEN PE('Illegal request number specified');
REQBLK[DIU$H_REQUEST_ID]=.R2; ! Save request id
rflags[R_REQUESTID] = SEEN; ! We saw some kind of request id string
END; ! REQ_ID
%SBTTL 'Routine REQUEST'
ROUTINE REQUEST (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is invoked when CRLF is seen to perform the DIU request.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (not used).
!
! IMPLICIT INPUTS:
!
! reqblk: DIU request block in progress
! SFLAGS, DFLAGS: Bits for some optional fields
!--
LOCAL n_ptr, ! Address of default block to use
n_desc : $STR_DESCRIPTOR(), ! Pointer to ASCIZ node spec
status; ! status returned by DIU$DO
! Check for any strange switch combination that would/could cause an error.
IF .dflags[F_KEY] NEQ .dflags[F_RMS_INDEXED]
THEN PE('/KEY must be specified with /RMS:INDEXED file format');
IF .reqblk[DIU$H_SOURCE_DESCRIPTION] EQL 0
THEN BEGIN
IF .reqblk[DIU$H_TRANSFORM] NEQ 0
THEN PE('/TRANSFORM cannot be used without a source /DESCRIPTION');
IF .reqblk[DIU$H_DESTINATION_DESCRIPTION] NEQ 0
AND NOT .dflags[F_RMS_INDEXED]
THEN PE('Destination /DESCRIPTION seen without /RMS:INDEXED');
END;
! Cap off the source filespec buffer - there is always a source filespec.
CH$WCHAR_A($ETG,p_src); ! Always a source filespec there
CH$WCHAR_A(0,p_src); ! Insure there is a null after that
! Check to see that there is a destination filespec. If there is one, then
! bind off the filespec buffer. If there isn't one, insure that there is a
! jobname in the buffer.
IF .dflags[F_FILESPEC] ! Was there a destination filespec?
THEN BEGIN ! Yes
CH$WCHAR_A($ETG,p_dst); ! Bind off the filespec buffer
CH$WCHAR_A(0,p_dst); ! Insure there is a null there
END
ELSE MKJOBNAME(); ! No, we need a job name from somewhere
! Apply defaults to request, straighten out the tag buffers.
DEF$REQUEST();
! Syntax check the source description file, if any
IF .reqblk[DIU$H_SOURCE_DESCRIPTION] NEQ 0
THEN BEGIN
LOCAL srcdesc: $STR_DESCRIPTOR(
STRING=(.reqblk[DIU$H_SOURCE_DESCRIPTION],
CH$PTR(reqblk[DIU$T_SOURCE_DESCRIPTION])));
DIU$SYNTAX_DESCRIPTION(srcdesc);
IF .patpar_warn THEN BEGIN
DIU$MESSAGE(DIU$_PARDES, 0, 0, FALSE);
RETURN;
END;
END;
! Syntax check the destination description file, if any
IF .reqblk[DIU$H_DESTINATION_DESCRIPTION] NEQ 0
THEN BEGIN
LOCAL dstdesc: $STR_DESCRIPTOR(
STRING=(.reqblk[DIU$H_DESTINATION_DESCRIPTION],
CH$PTR(reqblk[DIU$T_DESTINATION_DESCRIPTION])));
DIU$SYNTAX_DESCRIPTION(dstdesc);
IF .patpar_warn THEN BEGIN
DIU$MESSAGE(DIU$_PARDES, 0, 0, FALSE);
RETURN;
END;
END;
! Syntax check the transform file, if any
IF .reqblk[DIU$H_TRANSFORM] NEQ 0
THEN BEGIN
LOCAL trdesc: $STR_DESCRIPTOR(STRING=(.reqblk[DIU$H_TRANSFORM],
CH$PTR(reqblk[DIU$T_TRANSFORM])));
DIU$SYNTAX_TRANSFORM(trdesc);
IF .patpar_warn THEN BEGIN
DIU$MESSAGE(DIU$_PARDES, 0, 0, FALSE);
RETURN;
END;
END;
! If we saw a /SEQUENCE switch and no /PREREQ switch then set the previous
! request id as a prereq id for the current request.
IF NOT .rflags[R_PREREQUISITE] AND .rflags[R_SEQUENCE]
THEN reqblk[DIU$H_PREREQUISITE_ID] = .pre_id;
! Queue the request or handle it locally. First we get a default value for
! queue_value to tell us to try and queue the request or not. Unless its
! /QUEUE:YES we try and process the request now. If it was /QUEUE:NO we return
! after the request has been tried. If it is /QUEUE:MAYBE and the request
! failed then we check the status and queue it if the status returned is
! reasonable.
IF NOT DECIDE_QUEUE() THEN RETURN; ! setup queue_value, return if error
IF .queue_value NEQ DIU$K_QUEUE ! Unless he is sure he wants queued
THEN BEGIN ! then go ahead and do the request now
S$NOINT(); ! Prevent using section 3 stack on ints
status = DIU$DO(reqblk); ! Do the request (or not)
S$OKINT(); ! Turn on the interrupt system,
END ! allowing master job to function again
ELSE status = 0; ! else set status to indicate QUEUE:YES
IF .queue_value EQL DIU$K_NO_QUEUE THEN RETURN; ! Return if /NOQUEUE
IF (SELECTONE .status OF ! Check status to see if we queue
SET ! the request now
[0]: FALSE; ! Queue it if /QUEUE:YES
[RMS$_FLK, RMS$_DCB, RMS$_DCF, ! Queue it on
RMS$_COF, RMS$_JFN, RMS$_DPE, ! certain RMS
RMS$_EDQ, RMS$_EXT, RMS$_FNC, ! recoverable
RMS$_XCL]: FALSE; ! error codes
[OTHERWISE]: TRUE; ! If anything else, don't queue it
TES) ! since it must have worked!
THEN RETURN; ! Return if we don't want to queue it
! Here to queue the request. Don't allow non-disk destinations for the
! directory command.
IF .reqblk[DIU$H_FUNCTION] EQL DIU$K_DIRECTORY ! if a DIRECTORY command
AND NOT .dflags[F_NODE] ! has a local destination
AND NOT .dflags[F_ON_DISK] ! that is not on disk
THEN PE('Destination file must be on disk for queued request');
! An IPCF is sent to the master job, to queue the request. If it doesn't work
! we print a little message on the terminal.
IF NOT (status = IP_ENTER(reqblk)) ! try and queue the request
THEN BEGIN ! OOPS, it didn't work
DIU$MESSAGE(.status,0,0,FALSE); ! Print an error message
RETURN; ! and return
END;
! Request got queued, print a job queued message
$TTY_FAO('[DIU job !AD queued, request !SW]!/', ! Format the output please
.reqblk[DIU$H_JOBNAME],
CH$PTR(reqblk[DIU$T_JOBNAME]),
.reqblk[DIU$H_REQUEST_ID]);
! Remember previous request id if the current request had a /SEQ switch
IF .rflags[R_SEQUENCE] ! if in a /SEQUENCE
THEN pre_id = .reqblk[DIU$H_REQUEST_ID] ! remember last id
ELSE pre_id = 0; ! otherwise no prereq id
END; ! request
%SBTTL 'Routine RFM_SWITCH'
ROUTINE rfm_switch (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process any switch that sets record format (/RECORD_FORMAT:,
! /VARIABLE:, /FIXED:, /VFC:, /LINE_SEQUENCED_ASCII, /STREAM:). The
! command state is checked to see if it is a global or local state. A
! global state will append tag information to both source and destination
! filespec buffers, while a local will cause only the source or dest
! buffer to be modified.
!
! FORMAL PARAMETERS:
!
! r2 : Data From COMND Monitor Call.
! cstate : Parser's current state.
! context : Command Component Context: RFM value
!
! IMPLICIT INPUTS:
!
! SFLAGS, DFLAGS
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$T_???_FILESPEC] has tag information appended to it.
! {SFLAGS and/or DFLAGS}[F_RFM]: Set to remember that RFM was set.
!--
! Call sw_argument to save the command state (even if /LSA!)
SW_ARGUMENT(.r2,.cstate,.context);
! If /IMAGE specified, no other switches are legal
IF .rflags[R_IMAGE]
THEN PE('Record format switch illegal with /IMAGE file format');
! If we have a destination file parse state, we use add the tag to the dest
! file buffer only. If we have a source state, we add it to just the source
! file buffer. If we have a global state, it goes to both.
IF .dflags[F_FILESPEC] ! If destination filespec seen
THEN BEGIN ! then switch applies to destination
IF .context NEQ FAB$K_SCR AND .context NEQ FAB$K_SLF
THEN BEGIN
IF .dflags[F_RFM]
THEN PE('Multiple record format switches on destination file');
dflags[F_RFM] = SEEN;
END;
ADD_TAG(diu$k_fab_rfm,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_dst);
END
ELSE BEGIN ! If destination filespec not seen
IF .context NEQ FAB$K_SCR AND .context NEQ FAB$K_SLF
THEN BEGIN
IF .sflags[F_RFM]
THEN IF .sflags[F_FILESPEC]
THEN PE('Multiple record format switches on source file')
ELSE PE('Multiple global record format switches');
sflags[F_RFM] = SEEN;
END;
ADD_TAG(diu$k_fab_rfm,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_src);
IF NOT .sflags[F_FILESPEC] ! If neither dest or source filespec
THEN BEGIN ! seen then it applies to both
dflags[F_RFM] = SEEN;
ADD_TAG(diu$k_fab_rfm,
diu$k_tag_integer,
.context,
%bpval/ch$size(),
p_dst);
END
END;
! Restore the command state if there is no possibility of a field folowing.
IF .context EQL fab$k_lsa ! If /LSA
THEN RSTSTA(); ! restore the command state
END; ! RFM_SWITCH
%SBTTL 'Routine RSTSTA'
ROUTINE RSTSTA : NOVALUE =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
!
! Restore state to main line from switch parsing
!
! IMPLICIT INPUTS:
!
! savsta
! savgen
! savnam
! savext
! savf2
!--
IF (.savsta NEQ 0) AND (.cmdsta EQL 0) ! State is saved?
THEN BEGIN
cmdsta = .savsta; ! Restore command state
jfnblk[$GJGEN] = .savgen; ! Restore jfnblk
jfnblk[$GJNAM] = .savnam;
jfnblk[$GJEXT] = .savext;
jfnblk[$GJF2] = .savf2;
END;
savsta = 0; ! Always clear saved state
END; ! RSTSTA
%SBTTL 'Routine SAVE_NUMBER'
ROUTINE SAVE_NUMBER (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the number parsed by $CMNUM function of COMND JSYS.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (the number).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! number: the number is stored here.
!
!--
number = .r2 ! Copy given number
END; ! SAVE_NUMBER
%SBTTL 'Routine SH_DEFAULTS'
ROUTINE SH_DEFAULTS (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Perform the SHOW DEFAULTS command display.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! defaults: the linked list of defaults entries
! src_node: the (possibly wild) ASCIZ nodename parsed
!
!--
SHODEF(.defaults, ! Address of linked list of defaults
src_node); ! Address of string to match on
END; ! SH_DEFAULTS
%SBTTL 'Routine SH_MJOB'
ROUTINE SH_MJOB (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Perform the SHOW MAXIMUM_SIMULTANEOUS_REQUESTS command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!--
! Tell is all what mjob is set to today please
$TTY_FAO('Maximum simultaneous requests is set to !SL!/',
.mjob);
! Print a line if we are not (yet) the spooler, or if we are (yet) the spooler
! print the number of requests in progress.
IF NOT .mst_flag ! Are we the spooler yet?
THEN $XPO_PUT(IOB=tty, ! Nope
STRING=%STRING('(However, you are not (yet) the spooler)',CRLF))
ELSE IF .njob NEQ 0 ! We are the spooler,
THEN $TTY_FAO('Currently !SL request!%S in progress!/',
.njob); ! so print requests in progress if any
END; ! SH_MJOB
%SBTTL 'Routine SH_QUEUE'
ROUTINE SH_QUEUE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Perform the SHOW QUEUES command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!--
SHOQUE(reqblk,.shq_verbosity); ! Perform SHOW QUEUE
END; ! SH_QUEUE
%SBTTL 'Routine SH_TAKE'
ROUTINE SH_TAKE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Show default TAKE mode.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call. (ignored)
! CSTATE: Parser's current state. (ignored)
! CONTEXT: Command component context. (ignored)
!
! IMPLICIT INPUTS:
!
! def_takeswitches: default take mode switch
!
!--
IF .def_takeswitches EQL TAK_ECHO THEN
$XPO_PUT(IOB=tty,
STRING=%STRING('Default take mode is to echo take files',
CRLF))
ELSE
$XPO_PUT(IOB=tty,
STRING=%STRING('Default take mode is to not echo take files',
CRLF));
END; ! SH_TAKE
%SBTTL 'Routine SH_VERSION'
ROUTINE SH_VERSION (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Show version of DIU.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call.
! CSTATE: Parser's current state.
! CONTEXT: Command component context.
!
! IMPLICIT INPUTS:
!
! .JBVER: LCG-style version number
!
!--
BIND jobver = %O'137'; ! LCG version number here
$TTY_FAO('!AZ version !V!/',diu$$system_banner,.jobver);
END; ! SH_VERSION
%SBTTL 'Routine SRCFIL'
ROUTINE SRCFIL (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called when the source filespec has been seen, as
! parsed by $CMFIL (JFN in R2) or $CMQST (string in atom_buf). If the
! filespec was terminated by a quote, then whatever was parsed must be a
! VMS style node name with access information, so we call SRCNOD to
! process it. Otherwise, the node name of the source (if any) has been
! copied to the source file area already. So we copy the the source
! filespec to the source filespec holding area (after any possible node
! name and access string) and then copy all of that to the request block.
! Unless the filespec was quoted, the file type and name fields are
! defaulted for the output file. FTS didn't do it this way, so my hands
! are not (yet) tied.
!
! FORMAL PARAMETERS:
!
! R2: JFN we got from COMND, if not FILE_QUOTED
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context: FILE_QUOTED if quoted filespec
!
! IMPLICIT INPUTS:
!
! reqblk[DIU$H_FUNCTION]: which command function we are doing today
! p_sfil: byte pointer to destination filespec
! p_src: byte pointer to destination area in request block
! atom_buf: atom buffer
! sflags: destination file flags
!
! IMPLICIT OUTPUTS:
!
! sflags[F_FILESPEC] is set
! cmdsta: set to proper next command state
! p_src: updated
! reqblk: has destination filespec added to it
!--
LOCAL device_chars, ! Local source file chars
jfns_bits, ! Make JFNS bits here
jfns_arg: VECTOR[CH$ALLOCATION(40)]; ! Place to look at the device
! See if this was actually a VMS style node spec and if so call the routine
! that wanted to process it in the first place.
IF .context NEQ FILE_QUOTED AND CH$RCHAR(.stateb[$CMPTR]) EQL %C'"'
THEN BEGIN ! yes, must have been a node spec
SRCNOD(0,0,0); ! Call the correct routine
JSYS_RLJFN(.r2); ! Release the JFN
RETURN; ! and return
END;
! Remember that we have seen a source filespec
sflags[F_FILESPEC]=SEEN;
! Set the next parse state depending on the command we are parsing now.
cmdsta = (SELECT .reqblk[DIU$H_FUNCTION] OF
SET
[DIU$K_APPEND]: APPEND_NOISE_OUTPUT;
[DIU$K_COPY] : COPY_NOISE_OUTPUT;
[DIU$K_DELETE] : DELETE_CONFIRM;
[DIU$K_RENAME] : RENAME_NOISE_OUTPUT;
[DIU$K_DIRECTORY] : IF .dflags[F_FILESPEC]
THEN DIRECTORY_CONFIRM
ELSE DIRECTORY_NOISE_OUTPUT;
[DIU$K_SUBMIT,
DIU$K_PRINT] : NOISE_AFTER_COPY;
[OTHERWISE] : REQUEST_CONFIRM; ! Shouldn't get here
TES);
! If a remote quoted filespec, set up the file storage area with the string
! from the atom buffer, defaulting to def_fs if there is nothing in the atom
! buffer. If a remote non-quoted filespec, we want to expand the jfn
! furnished; but we don't want to get the device of DSK. If a local filespec
! do a full expansion of everything to the buffer.
IF .sflags[F_NODE] ! Remote source?
THEN BEGIN ! Yes a remote filespec
MOVEAZ(%REF(PP('::')),p_sfil); ! Add coloncolon after nodename
IF .context EQL FILE_QUOTED
THEN BEGIN ! Quoted remote file copies atom buffer
IF CH$RCHAR(.stateb[$CMABP]) EQL 0 ! Anything in the buf?
THEN MOVEAZ(%REF(CH$PTR(def_fs)),p_sfil) ! If nothing use def
ELSE MOVEAZ(%REF(.stateb[$CMABP]),p_sfil); ! else append atom buff
END ! End quoted remote filespec
ELSE BEGIN ! Non-quoted remote filespec does JFNS
jfns_arg = 0; ! Insure firstword is zeroed
JSYS_JFNS(CH$PTR(jfns_arg),.r2,jfns_dev); ! Get the device
jfns_bits = (IF .jfns_arg EQL 'DSK' ! if it was DSK
THEN jfns_all-jfns_dev ! dont include device
ELSE jfns_all); ! It wasn't, include the dev
JSYS_JFNS(.p_sfil,.r2,.jfns_bits); ! Expand the filespec
END; ! End non-quoted remote filespec
END ! End of remote source filespec
ELSE BEGIN ! Local source filespec
JSYS_DVCHR(.r2<RH>; device_chars); ! Get the device chars
IF .device_chars<18,9,0> NEQ $DVDSK ! Is it a disk?
THEN PE('Source file must be on disk'); ! No, it must be on disk fool
JSYS_JFNS(.p_sfil,.r2,jfns_all); ! Local file: use the complete filespec
END; ! End of local source filespec
! Now copy the completed filespec to the source area in the request block,
! along with its length.
CH$WCHAR_A($ETG,p_src); ! Insert tag
CH$WCHAR_A(ASCIZ_LEN(CH$PTR(src_fil)),p_src); ! Write length of filespec
MOVEAZ(%REF(CH$PTR(src_fil)),p_src); ! Write filename to request block
! If it wasn't a quoted filespec then set up default name and type.
IF .context EQL FILE_QUOTED
THEN BEGIN ! Quoted spec defaults
jfnblk[$GJNAM] = PP('*'); ! Default output file to *.*
jfnblk[$GJEXT] = PP('*'); ! so that we don't get "..0"
END
ELSE BEGIN ! Not a quoted spec, default usual
JSYS_JFNS(CH$PTR(def_name),.R2,jfns_nam); ! Get default name
jfnblk[$GJNAM] = CH$PTR(def_name); ! and point to it
JSYS_JFNS(CH$PTR(def_type),.R2,jfns_typ); ! Get default type
jfnblk[$GJEXT] = CH$PTR(def_type); ! and point to it
JSYS_RLJFN(.R2); ! Get rid of parse JFN
END;
END; ! SRCFIL
%SBTTL 'Routine SRCNOD'
ROUTINE SRCNOD (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called when a node name has been seen. The context
! tells us to expect a quoted access string or not.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (checked for SHOW_DEFAULTS).
! CONTEXT: Command component context:
! VALID_NODE means the node has been parsed CMNOD call.
!
! IMPLICIT INPUTS:
!
! atom_buf: string that is the node that was parsed
! p_sfil: used as pointer to filespec storage area
!
! IMPLICIT OUTPUTS:
!
! p_sfil: updated
! src_fil: gets a copy of the node name
! src_node: gets a copy of the node name
! jfnblk: bits are set up for following remote filespec
! sflags[F_NODE]: seen
!
! SIDE EFFECTS:
!
! Contents of Atom buffer copied to Source spec
!--
LOCAL peek_chr; ! Character we are peeking at
sflags[F_NODE] = SEEN; ! Current file has a node name
! Check node name. If some gark was typed, nack the user with a error message
! like COMAND would. This grossness along with other related uglyness is
! needed for VMS style nodespecs. Not that I'm bitter that DIU is the only 36
! bit program in existance to accept these gross nodespecs, because if VMS does
! it this way it HAS to be right.
IF .cstate NEQ SHOW_DEFAULTS ! If not from SHOW DEF then check node
AND .context NEQ VALID_NODE ! If not from $CMNOD parse
THEN BEGIN ! then give me error messages here
peek_chr = CH$RCHAR(.stateb[$CMPTR]); ! Peek at the "next" field
IF .peek_chr NEQ %C'"' AND .peek_chr NEQ %C':'
THEN BEGIN ! Error should be file not (yet) found
IF CH$RCHAR(.stateb[$CMABP]) EQL 0 ! Is anything in the buffer?
AND (.peek_chr EQL $CHCRT OR .peek_chr EQL $CHLFD) ! No file?
THEN PE('Missing source filename'); ! Nothing, missing source then
IF .peek_chr EQL %C'/' ! Switch?
THEN PARERR(PP('Does not match switch: "')) ! Yes, it was a switch
ELSE PARERR(PP('File not found: "')); ! No, must have been a file
JSYS_PSOUT(.stateb[$CMPTR]); ! print the unparsed chars
JSYS_PSOUT(PP(%STRING('"',crlf))); ! make it look nice and neat
RETURN; ! and return
END;
IF CH$RCHAR(.stateb[$CMABP]) EQL 0 ! Is anything in the buffer?
THEN PE('Blank source node name'); ! Nope, CMFLD gave us nothing.
END;
! Validate the node if it wasn't from SHOW DEFAULTS command.
IF .cstate NEQ SHOW_DEFAULTS ! If not from SHOW DEF then check node
AND NOT S$NODE_CHECK(ASCIZ_LEN(.stateb[$CMABP]),.stateb[$CMABP])
THEN PE('Illegal source node name'); ! Nope, give error message
! I'm glad all of that is over. Anyway, I could be wrong tonight, but the node
! name appears to be OK. Move it along.
MOVEAZ(%REF(.stateb[$CMABP]),p_sfil); ! Move it to the source file buffer.
MOVEAZ(%REF(.stateb[$CMABP]),%REF(CH$PTR(src_node))); ! Save just the node
! Set the jfnblk with flags to suppress logical name expansion and turn off the
! message bit.
jfnblk[$GJF2] = G1_SLN+G1_LOC;
jfnblk[$GJGEN] = .jfnblk[$GJGEN] AND NOT (GJ_MSG+GJ_OLD+GJ_IFG);
END; ! SRCNOD
%SBTTL 'Routine ST_ACCOUNT'
ROUTINE ST_ACCOUNT (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process the /ACCOUNT switch. It parses for a quoted string
! (context=ACC_QUOTED) or a field (context=ACC_UNQUOTED). If the atom
! that parses is a null field, then we want to prompt for a account
! later, in which case a "*" is set to be the account. The account
! string or "*" is copied to the default account (for SET DEFAULT) and
! added to the source and/or destination tags.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (ACC_QUOTED or ACC_UNQUOTED).
!
! IMPLICIT INPUTS:
!
! dflags[F_FILESPEC], rflags[F_FILESPEC]
! atom buffer
!
! IMPLICIT OUTPUTS:
!
! source and destination tag buffers
! default account is set for SET DEFAULTS
! sflags[F_ACCOUNT] and/or dflags[F_ACCOUNT]
!
! SIDE EFFECTS:
!
! saved command state is restored
!
!--
! If we get a null unquoted string, remember to prompt for the real input
IF (.context EQL ACC_UNQUOTED) AND (CH$RCHAR(.stateb[$CMABP]) EQL 0)
THEN CH$MOVE(2,PP(PROMPT_CHARACTER),.stateb[$CMABP]);
! Copy atom buffer to the default save area (case of SET DEFAULT)
$STR_COPY(STRING=ASCIZ_STR(.stateb[$CMABP]),TARGET=def_acct);
! Add it to the tag buffer for source and destination filespecs as needed,
! checking for multiple /ACCOUNT switches.
IF .dflags[F_FILESPEC] OR .dflags[F_NODE]
THEN BEGIN
IF .dflags[F_ACCOUNT]
THEN PE('Multiple ACCOUNTs given for destination');
dflags[F_ACCOUNT] = SEEN;
ADD_TAG(diu$k_diu_account,
diu$k_tag_text,
.def_acct[STR$A_POINTER],
.def_acct[STR$H_LENGTH],
p_dst);
END
ELSE BEGIN
IF .sflags[F_ACCOUNT]
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('Multiple ACCOUNTs given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN IF .sflags[F_ACCESS]
THEN PE('/ACCESS illegal with /ACCOUNT')
ELSE PE('Multiple /ACCOUNT switches')
ELSE PE('Multiple global ACCOUNTs given');
sflags[F_ACCOUNT] = SEEN;
ADD_TAG(diu$k_diu_account,
diu$k_tag_text,
.def_acct[STR$A_POINTER],
.def_acct[STR$H_LENGTH],
p_src);
IF NOT (.sflags[F_FILESPEC] OR .sflags[F_NODE])
THEN BEGIN
dflags[F_ACCOUNT] = SEEN;
ADD_TAG(diu$k_diu_account,
diu$k_tag_text,
.def_acct[STR$A_POINTER],
.def_acct[STR$H_LENGTH],
p_dst);
END;
END;
! Restore command state to before the switch was typed
RstSta();
END; ! ST_ACCOUNT
%SBTTL 'Routine ST_BYTE'
ROUTINE ST_BYTE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Store fixed header size from /VFC switch
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call, record size to store.
! CSTATE: Parser's current state, checked to see if we need to RSTSTA.
! CONTEXT: Command component context, tag to add
!
!--
IF (.R2 GTR %O'377') OR (.R2 LSS 0)
THEN PE('VFC fixed header size must be in range 0 to 255');
! If we have a destination file parse state, we use add the tag to the dest
! file buffer only. If we have a source state, we add it to just the source
! file buffer. If we have a global state, it goes to both.
IF .dflags[F_FILESPEC]
THEN ADD_TAG(.context,
diu$k_tag_integer,
.r2,
%bpval/ch$size(),
p_dst)
ELSE BEGIN
ADD_TAG(.context,
diu$k_tag_integer,
.r2,
%bpval/ch$size(),
p_src);
IF NOT .sflags[F_FILESPEC]
THEN ADD_TAG(.context,
diu$k_tag_integer,
.r2,
%bpval/ch$size(),
p_dst);
END;
! If we are here on /VFC:n {as opposed to /VFC:(n:m) then restore the state.
IF .cstate EQL GET_VFC_ARGUMENT THEN RstSta();
END; ! ST_BYTE
%SBTTL 'Routine ST_DAYS'
ROUTINE ST_DAYS (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the number of days in the future for /AFTER, /DEADLINE
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (the number).
! CSTATE: Parser's current state.
! CONTEXT: Command component context.
!
! IMPLICIT OUTPUTS:
!
! DAYS: number of days in the future
!--
IF .r2 LSS 0 ! Don't allow negative days
THEN PE('"days in the future" cannot be negative');
DAYS=.R2; ! Store it
END; ! ST_DAYS
%SBTTL 'Routine ST_DEFAULTS'
ROUTINE ST_DEFAULTS (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process SET DEFAULTS command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! def_node: node to default if rflags[R_NODE] (node seen)
! def_user: default username if rflags[R_USERNAME]
! def_acct: default account if rflags[R_ACCOUNT]
! def_pass: default password if rflags[R_PASSWORD]
! reqblk[DIU$?_LOG_FILESPEC]: default log file spec if rflags[R_LOG_FILE]
! queue_value: default queue value if rflags[R_QUEUE]
! reqblk[DIU$Z_NOTIFY]: default notify value if rflags[R_NOTIFY]
!
!
! IMPLICIT OUTPUTS:
!
! defaults (a linked list of defaults entries)
!--
LOCAL def : REF $DEF_DECL; ! Address of default block to work on
IF .rflags[R_NODE] ! Is access info being set for a node?
THEN BEGIN ! Yes, find or create a def block
IF (def = DEF$FIND(def_node)) EQL 0 ! Is there a node in the table?
THEN def = DEF$CREATE(def_node); ! No, create the node block
END
ELSE def = def_root; ! No node seen, setting default node
! Fill in defaults depending on what switches were just typed.
IF .sflags[F_PASSWORD] ! if /PASSWORD typed
THEN $STR_COPY(STRING = def_pass, TARGET = def[DEF$D_PASSWORD]);
IF .sflags[F_USERID] ! if /USERID typed
THEN $STR_COPY (STRING = def_user, TARGET = def[DEF$D_USER]);
IF .sflags[F_ACCOUNT] ! if /ACCOUNT typed
THEN $STR_COPY (STRING = def_acct, TARGET = def[DEF$D_ACCOUNT]);
IF .rflags[R_QUEUE] ! If /[NO]QUEUE typed
THEN def[DEF$B_DEFER] = .queue_value;
IF .rflags[R_NOTIFY] ! If /NOTIFY typed
THEN def[DEF$B_NOTIFY] = .reqblk[DIU$Z_NOTIFY];
IF .rflags[R_LOG_FILE] ! if /LOG_FILE or /NOLOG_FILE typed
THEN $STR_COPY (TARGET = def[DEF$D_LOG],
STRING = (.reqblk[DIU$H_LOG_FILESPEC],
CH$PTR(reqblk[DIU$T_LOG_FILESPEC])));
END; ! ST_DEFAULTS
%SBTTL 'Routine ST_DNODE'
ROUTINE ST_DNODE (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the Node name from the SET DEFAULT node::/switch command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! def_node: set up
!
!--
LOCAL node_length; ! Length of the node
rflags[R_NODE] = SEEN; ! Remember we saw a node name
node_length = ASCIZ_LEN(.stateb[$CMABP]); ! Get the length of the node
IF NOT S$NODE_CHECK(.node_length,.stateb[$CMABP]) ! Is the node OK?
THEN PE('Illegal node name specified'); ! Nope, barf on it
$STR_COPY(STRING=(.node_length,.stateb[$CMABP]),
TARGET=def_node); ! Copy the node to a safe place
END; ! ST_DNODE
%SBTTL 'Routine ST_FDAY'
ROUTINE ST_FDAY (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine called on /AFTER:dayofweek
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (code for day of week).
!
! IMPLICIT OUTPUTS:
!
! DAYS: code for day of the week
!--
DAYS=.context; ! Store it
END; ! ST_FDAY
%SBTTL 'Routine ST_FPDAY'
ROUTINE ST_FPDAY (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine called on /AFTER:dayofweek
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! days: code for day of the week
! idtnc_block[2]<0,18>: a number of seconds
!--
LOCAL udt, ! Universal date time day
nudt, ! Newly converted udt
secs, ! Seconds and timezone from IDCNV
year, ! Year from IDCNV
mday, ! day of month from IDCNV
dow; ! today's day of week
udt = S$TIME()^-18; ! Get day number since 16-Nov-1858
dow = .udt MOD 7; ! Get today's day of week
IF .days EQL -1 THEN days = .dow; ! if TODAY set to today's day of week
IF .dow LEQ .days THEN udt = (.udt+.days+1)-.dow ! Add number of days in
ELSE udt = (.udt+.days+8)-.dow; ! the future to today
! We have the day figured out, now get the time from local secs to UDT secs.
! We can't just divide it out because (1) timezones (2) daylight savings time.
! The day that we have figured out may have been for a time that is or isn't
! under daylight savings time. So, first we have to split apart that time,
! then put our own seconds in, then make it back.
JSYS_ODCNV(.udt^18,0; year,mday,secs); ! Go get the udt broken apart
secs = (.secs<lh>)^18+(.idtnc_block[2]<RH>); ! Put the correct time of day
JSYS_IDCNV(.year,.mday,.secs; nudt,mday); ! Compute the new real udt
! Add relative time to computed date and call absolute storer
ST_TAD((.udt)^18+.nudt<RH>,0,0); ! Call absolute time storer
END; ! ST_FPDAY
%SBTTL 'Routine ST_HALFWORD'
ROUTINE ST_HALFWORD (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Store recordsize (from /VAR:n, /FIX:n, etc.)
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call, the record size.
! CSTATE: Parser's current state, used to tell if we should RSTSTA
! CONTEXT: Command component context: tag identifier
!
!--
! Check for reasonable argument range
IF .R2 GTRU %O'777777'
THEN PE('Record size must be in range 0 to 262143');
! If we have a destination file parse state, we use add the tag to the dest
! file buffer only. If we have a source state, we add it to just the source
! file buffer. If we have a global state, it goes to both.
IF .dflags[F_FILESPEC]
THEN ADD_TAG(.context,
diu$k_tag_integer,
.r2,
%bpval/ch$size(),
p_dst)
ELSE BEGIN
ADD_TAG(.context,
diu$k_tag_integer,
.r2,
%bpval/ch$size(),
p_src);
IF NOT .sflags[F_FILESPEC]
THEN ADD_TAG(.context,
diu$k_tag_integer,
.r2,
%bpval/ch$size(),
p_dst);
END;
! Restore the command state unless we are in the /VFC:(n:m) switch
IF .cstate NEQ GET_VFC_RECORD_SIZE
THEN RSTSTA();
END; ! ST_HALFWORD
%SBTTL 'Routine ST_HELP'
GLOBAL ROUTINE ST_HELP (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Store address of HELP text from HLPTAB to print later.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context: Address of HELP text descriptor
!
! IMPLICIT OUTPUTS:
!
! helpdesc: gets the address of the help message.
!--
helpdesc = .context;
END; ! ST_HELP
%SBTTL 'Routine ST_JOBNAME'
ROUTINE ST_JOBNAME (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the JOBNAME for Modify or Kill
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! atom_buf: the atom buffer
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$T_JOBNAME], reqblk[DIU$H_JOBNAME], rflags[R_REQUESTID]
!--
MOVEAZ(%REF(.stateb[$CMABP]),%REF(CH$PTR(reqblk[DIU$T_JOBNAME])));
reqblk[DIU$H_JOBNAME]=ASCIZ_LEN(.stateb[$CMABP]);
IF .reqblk[DIU$H_JOBNAME] NEQ 0
THEN rflags[R_REQUESTID] = SEEN; ! We saw some kind of request id string
END; ! ST_JOBNAME
%SBTTL 'Routine ST_KEY'
ROUTINE ST_KEY (r2, cstate, context): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Add tags for /KEY switch. Gives a parse error message if any previous
! use of a file format switch wasn't /RMS:INDEXED. KEYs are only allowed
! for RMS indexed files and are only allowed for the destination file
! (since the source files XABKEYs will contain all of the KEY information
! once $OPEN is called for the source file). The /KEY switch is not
! allowed for ISAM files since DIU doesn't create ISAM files (except in a
! block mode transfer where the data format is irrelevant).
!
! NOTE: It would take lots of space to create and store data structures
! with all the key names and information (especially a problem for queued
! requests). Also, it is impossible at the time of command line parsing
! to validate that the field names specify actually exist in the record;
! however, this can be checked after the record description trees are
! built. Therefore, instead of expanding the command line information
! during command parsing, the information typed in by the user will be
! saved and expanded later.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context:
! "," "+" "(" and ")" are key delimiters
! 1 indicates a single field as argument (/KEY:FOO)
! 0 indicates one of several /KEY:(FOO+BAR,BLETCH,MUMBLE)
! 2 indicates CHANGES was specified
! 3 indicates DUPLICATES was specified
! 4 indicates NOCHANGES was specified
! 5 indicates NODUPLICATES was specified
!
! IMPLICIT OUTPUTS:
!
! keydsc: dynamic string descriptor
! key_segments: count of keys
! dflags[F_KEY]: set to SEEN
!
!--
BEGIN
OWN keydsc : $STR_DESCRIPTOR (CLASS = DYNAMIC), ! Copy of /KEY: switch args
key_count, ! number of keys processed
key_dup, ! DUPLICATES or NODUPLICATES specified
key_cha, ! CHANGES or NOCHANGES specified
key_segments; ! Number of key segs found (per key)
! First make sure that no bad file format switches has been typed so far
IF .dflags[F_FORMAT] AND NOT .dflags[F_RMS_INDEXED]
THEN PE('/KEY only legal with /RMS:INDEXED file format');
dflags[F_KEY] = SEEN;
! Store the keys as needed
SELECT .context OF
SET
[1, %C'(']: BEGIN ! Beginning of the key switch
$STR_DESC_INIT (DESCRIPTOR = keydsc, CLASS = DYNAMIC,
STRING = (0, 0));
key_segments = 0; ! No key segments yet
key_count = 1; ! Count this key switch
END;
[%C'+']: BEGIN ! Plus seen
LOCAL tdesc : $STR_DESCRIPTOR (STRING = ASCIZ_STR (.stateb[$CMABP]));
$STR_APPEND (STRING = tdesc, TARGET = keydsc);
key_segments = .key_segments + 1;
IF .key_segments GTR 8
THEN PE('Maximum of 8 segments allowed per KEY');
END;
[0, 1]: BEGIN ! A key was specified
LOCAL tdesc : $STR_DESCRIPTOR (STRING = ASCIZ_STR (.stateb[$CMABP]));
$STR_APPEND (STRING = tdesc, TARGET = keydsc);
key_cha = FALSE; ! [NO]CHANGES not seen yet
key_dup = FALSE; ! [NO]DUPLICATES not seen yet
END;
[%C':']: $STR_APPEND (STRING = ':', TARGET = keydsc); ! Colon seen
[2]: BEGIN ! CHANGES was specified
IF .key_count EQL 1 ! this is the primary key?
THEN PE('Option CHANGES is invalid for the primary KEY');
IF .key_cha ! Seen a [NO]CHANGES yet?
THEN PE('Multiple key option CHANGES seen');
key_cha = TRUE;
$STR_APPEND (STRING = '2', TARGET = keydsc);
END;
[3]: BEGIN ! DUPLICATES
IF .key_dup ! If we have seen one already
THEN PE('Multiple key option DUPLICATES seen');
key_dup = TRUE; ! Reemmber we have seen this
$STR_APPEND (STRING = '3', TARGET = keydsc);
END;
[4]: BEGIN ! NOCHANGES seen
IF .key_cha ! Seen a [NO]CHANGES yet?
THEN PE('Multiple key option NOCHANGES seen');
key_cha = TRUE; ! Remember this
$STR_APPEND (STRING = '4', TARGET = keydsc);
END;
[5]: BEGIN ! NODUPLICATES
IF .key_dup ! If we have seen one already
THEN PE('Multiple key option NODUPLICATES seen');
key_dup = TRUE; ! Reemmber we have seen this
$STR_APPEND (STRING = '5', TARGET = keydsc);
END;
[%C',']: BEGIN ! Comma was seen
$STR_APPEND (STRING = ',', TARGET = keydsc); ! Append the comma
key_segments = 0; ! Zero the segments counter
key_count = .key_count + 1; ! Count the next key coming
IF .key_count GTR 256 ! User specified GTR max num of keys
THEN PE('Maximum of 256 keys allowed per file');
END;
[%C')', 1]: BEGIN ! End of the keys
reqblk[DIU$H_KEY_SWITCH] = .keydsc[STR$H_LENGTH]; ! Save length
CH$MOVE (.keydsc[STR$H_LENGTH], ! Copy keys
.keydsc[STR$A_POINTER], ! to reqblk
CH$PTR(reqblk[DIU$T_KEY_SWITCH]));
RSTSTA(); ! Pop back to main state
END;
TES;
END; ! ST_KEY
%SBTTL 'Routine ST_LOG'
ROUTINE ST_LOG (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Fill in the LOG filespec. The context is FALSE if we are called from
! the /NONOG_FILE switch, and TRUE if called from the /LOG_FILE switch.
! In the case of the /LOG_FILE switch, R2 contains a JFN provided by
! COMND JSYS hat will be the LOG file spec to override the default.
! Rflags is checked to make sure that two /LOG_FILE switches have not
! been typed, and the saved command state is restored (if /LOG_FILE).
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND JSYS, JFN of file parsed.
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context:
! TRUE if /LOG_FILE, FALSE if /NOLOG_FILE.
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$T_LOG_FILESPEC] is filled in
! reqblk[DIU$H_LOG_FILESPEC] has the length (0 if /NOLOG_FILE)
! rflags[R_LOG_FILE] is set
!
! SIDE EFFECTS:
!
! If context is TRUE, the JFN we got from COMND is released, and the
! command state is restored to parse more switches.
!
!--
IF .rflags[R_LOG_FILE] ! Seen a /LOG_FILE switch already?
THEN PE('Multiple /LOG_FILE or /NOLOG_FILE switches');
rflags[R_LOG_FILE] = SEEN; ! We have seen a switch now
moptions[DIUQ$K_LOG_FILESPEC] = 1; ! Remember we saw this switch
IF .context
THEN BEGIN ! If /LOG_FILE
JSYS_JFNS(CH$PTR(reqblk[DIU$T_LOG_FILESPEC]),.r2,jfns_all); ! ASCIIze it
reqblk[DIU$H_LOG_FILESPEC] =
ASCIZ_LEN(CH$PTR(reqblk[DIU$T_LOG_FILESPEC]));
JSYS_RLJFN(.R2); ! Free the JFN we just got
RSTSTA(); ! Restore the command state
END
ELSE BEGIN ! If /NOLOG_FILE
reqblk[DIU$H_LOG_FILESPEC] = 0; ! Indicate there is no log file
END;
END; ! ST_LOG
%SBTTL 'Routine ST_MJOB'
ROUTINE ST_MJOB (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process SET MAXIMUM_SIMULTANEOUS_REQUESTS command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call.
! CSTATE: Parser's current state.
! CONTEXT: Command component context.
!
! IMPLICIT OUTPUTS:
!
! mjob: set to new number of streams.
!
!--
LOCAL sked_flag, ! 1 if we should call the scheduler
s_pid, ! my temporary pid to see if there
infov : VECTOR[2] PRESET([0] = 1);
! If we are not (yet) the spooler, see if he is around and if so don't let this
! command parse.
IF (NOT .mst_flag) AND IP_CHECK() ! If there is a spooler already
THEN PE('SET MAXIMUM must be done from the spooler job');
! We are not (yet) the spooler, and one doesn't exist. Range check the number.
IF .number GTRU MAX_MJOB
THEN PE(%STRING('Maximum simultaneous requests out of range 0 to ',
%NUMBER(MAX_MJOB)));
! We should call the scheduler if we are setting mjob to a higher value.
sked_flag = (.number GTR .mjob);
! Everything seems OK, go ahead and set the new mjob.
mjob = .number;
! Write this event to the log file if we are (yet) the spooler. If we are not
! (yet) the spooler, mjob will be written to the system log file when we are
! started.
infov[1] = .number;
IF .mst_flag THEN DIU$MESSAGE(DIU$_MAXIMUM_REQ_SET,0,infov,TRUE);
! If we increased MJOB, call the scheduler. Then return.
IF .sked_flag THEN SCHED();
END; ! ST_MJOB
%SBTTL 'Routine ST_NODE'
ROUTINE ST_NODE (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the node name from the GET_REQUEST_ID routines.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! atom_buf: the atom buffer.
!
! IMPLICIT OUTPUTS:
!
! rflags[R_REQUESTID]: set
! reqblk[DIU$x_SOURCE_FILESPEC]: set up with node name
!
!--
MOVEAZ(%REF(.stateb[$CMABP]),%REF(CH$PTR(REQBLK[DIU$T_SOURCE_FILESPEC])));
REQBLK[DIU$H_SOURCE_FILESPEC]=ASCIZ_LEN(.stateb[$CMABP]);
rflags[R_REQUESTID] = SEEN; ! We saw some kind of request id string
END; ! ST_NODE
%SBTTL 'Routine ST_NOTIFY'
ROUTINE ST_NOTIFY (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Set bit for /NOTIFY
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context, notify value.
!
! IMPLICIT OUTPUTS:
!
! REQBLK[DIU$V_NOTIFY_xxx]
!
!--
! First check for multiple /NOTIFY switches
IF .rflags[R_NOTIFY]
THEN PE('Multiple /NOTIFY switches');
rflags[R_NOTIFY] = SEEN;
moptions[DIUQ$K_NOTIFY] = 1; ! Remember this for MODIFY
! Set the bits depending on the notify type
CASE .context FROM NOTIFY_MIN TO NOTIFY_MAX OF
SET
[NOTIFY_NONE]: reqblk[DIU$Z_NOTIFY] = 0;
[NOTIFY_TERMINAL]: reqblk[DIU$V_NOTIFY_TERMINAL] = 1;
[NOTIFY_MAIL]: reqblk[DIU$V_NOTIFY_MAIL] = 1;
[INRANGE,OUTRANGE]: SIGNAL(DIU$_BUG);
TES;
RSTSTA(); ! Restore saved command state
END; ! ST_NOTIFY
%SBTTL 'Routine ST_NTAD'
ROUTINE ST_NTAD (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Clear the universal date-time for /AFTER and /DEADLINE. Disallows
! multiple /AFTER or /DEADLINE switches.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (TAD_AFTER or TAD_DEADLINE)
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$G_AFTER]: cleared if /AFTER
! rflags[R_AFTER]: SEEN if /AFTER
! reqblk[DIU$G_DEADLINE]: cleared if /DEADLINE
! rflags[R_DEADLINE]: SEEN if /DEADLINE
!--
CASE .context FROM TAD_MIN TO TAD_MAX OF
SET
[TAD_AFTER]: BEGIN
IF .rflags[R_AFTER]
THEN PE('Multiple /AFTER switches');
rflags[R_AFTER] = SEEN;
moptions[DIUQ$K_AFTER] = 1;
reqblk[DIU$G_AFTER] = 0;
END;
[TAD_DEADLINE]: BEGIN
IF .rflags[R_DEADLINE]
THEN PE('Multiple /DEADLINE switches');
rflags[R_DEADLINE] = SEEN;
moptions[DIUQ$K_DEADLINE] = 1;
reqblk[DIU$G_DEADLINE] = 0;
END;
[INRANGE,OUTRANGE]: SIGNAL(DIU$_BUG);
TES;
RstSta();
END; ! ST_NTAD
%SBTTL 'Routine ST_PASSWORD'
ROUTINE ST_PASSWORD (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process the /PASSWORD switch. It parses for a quoted string
! (context=ACC_QUOTED) or a field (context=ACC_UNQUOTED). If the atom
! that parses is a null field, then we want to prompt for a password
! later, in which case a "*" is set to be the password. The password
! string or "*" is copied to the default password (for SET DEFAULT) and
! added to the source and/or destination tags.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (ACC_QUOTED or ACC_UNQUOTED).
!
! IMPLICIT INPUTS:
!
! dflags[F_FILESPEC], rflags[F_FILESPEC]
! atom buffer
!
! IMPLICIT OUTPUTS:
!
! source and destination tag buffers
! default password is set for SET DEFAULTS
! sflags[F_PASSWORD] and/or dflags[F_PASSWORD]
!
! SIDE EFFECTS:
!
! saved command state is restored
!
!--
! If we get a null unquoted string, remember to prompt for the real input
IF (.context EQL ACC_UNQUOTED) AND (CH$RCHAR(.stateb[$CMABP]) EQL 0)
THEN CH$MOVE(2,PP(PROMPT_CHARACTER),.stateb[$CMABP]);
! Copy atom buffer to the default save area (case of SET DEFAULT)
$STR_COPY(STRING=ASCIZ_STR(.stateb[$CMABP]),TARGET=def_pass);
! Add it to the tag buffer for source and destination filespecs as needed,
! checking for multiple /PASSWORD switches.
IF .dflags[F_FILESPEC] OR .dflags[F_NODE]
THEN BEGIN
IF .dflags[F_PASSWORD]
THEN PE('Multiple PASSWORDs given for destination');
dflags[F_PASSWORD] = SEEN;
ADD_TAG(diu$k_diu_password,
diu$k_tag_text,
.def_pass[STR$A_POINTER],
.def_pass[STR$H_LENGTH],
p_dst);
END
ELSE BEGIN
IF .sflags[F_PASSWORD]
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('Multiple PASSWORDs given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN IF .sflags[F_ACCESS]
THEN PE('/ACCESS illegal with /PASSWORD')
ELSE PE('Multiple /PASSWORD switches')
ELSE PE('Multiple global PASSWORDs given');
sflags[F_PASSWORD] = SEEN;
ADD_TAG(diu$k_diu_password,
diu$k_tag_text,
.def_pass[STR$A_POINTER],
.def_pass[STR$H_LENGTH],
p_src);
IF NOT (.sflags[F_FILESPEC] OR .sflags[F_NODE])
THEN BEGIN
dflags[F_PASSWORD] = SEEN;
ADD_TAG(diu$k_diu_password,
diu$k_tag_text,
.def_pass[STR$A_POINTER],
.def_pass[STR$H_LENGTH],
p_dst);
END;
END;
! Restore command state to before the switch was typed
RstSta();
END; ! ST_PASSWORD
%SBTTL 'Routine ST_PRIORITY'
ROUTINE ST_PRIORITY (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Store the priority (parsed by $CMNUM function of COMND JSYS).
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call, the priority number.
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$B_PRIORITY]: the number is stored here
! rflags[R_PRIORITY]: set
! moptions[DIUQ$K_PRIORITY]: Set (in case of MODIFY /PRIORITY)
!
!--
IF .rflags[R_PRIORITY] ! Seen /PRIORITY before?
THEN PE('Multiple /PRIORITY switches'); ! Yes
rflags[R_PRIORITY] = SEEN; ! Remember we have seen a /PRIORITY
moptions[DIUQ$K_PRIORITY] = 1; ! Remember we set priority for modify
IF .R2 GTRU 63 ! 0 to 63
THEN PE('Priority must be in range 0 to 63');
reqblk[DIU$B_PRIORITY] = .R2;
RSTSTA(); ! Restore command state
END; ! ST_PRIORITY
%SBTTL 'Routine ST_R_USERNAME'
ROUTINE ST_R_USERNAME (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the user id for modify class commands.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! atom_buf: the atom buffer.
!
! IMPLICIT OUTPUTS:
!
! REQBLK[DIU$T_USERNAME], REQBLK[DIU$H_USERNAME]
!
!--
LOCAL UDESC: $STR_DESCRIPTOR(CLASS=BOUNDED);
$STR_DESC_INIT(DESC=UDESC, STRING=(NAME_LENGTH,CH$PTR(REQBLK[DIU$T_USERNAME])),
CLASS=BOUNDED);
REQBLK[DIU$H_USERNAME]=ASCIZ_LEN(.stateb[$CMABP]); ! Length of name
$STR_COPY(STRING=(.REQBLK[DIU$H_USERNAME]+1,.stateb[$CMABP]),
TARGET=UDESC, OPTION=TRUNCATE);
IF .REQBLK[DIU$H_USERNAME] EQL 0 ! Check to make sure non-null username
THEN PE('Blank username typed'); ! Illegal username
rflags[R_REQUESTID] = SEEN; ! We saw some kind of request id string
END; ! ST_R_USERNAME
%SBTTL 'Routine ST_RIGHTBRACKET'
ROUTINE ST_RIGHTBRACKET (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the matching right square or angle bracket for later checking.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context, correct right bracket character.
!
! IMPLICIT OUTPUTS:
!
! RIGHTBRACKET: The appropriate bracket is stored here ASCIZ.
!
!--
CH$WCHAR(.context,CH$PTR(rightbracket)); ! Put the character
END; ! ST_RIGHTBRACKET
%SBTTL 'Routine ST_RTAD'
ROUTINE ST_RTAD (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save relative date/time for /AFTER and /DEADLINE
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (not used).
!
! IMPLICIT INPUTS:
!
! days: Number of days in the future
! idtnc_block[2]<RH>: Number of seconds in the future
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$G_AFTER] if /AFTER
! reqblk[DIU$G_DEADLINE] if /DEADLINE
!
! Side effects:
!
! Calls ST_TAD to produce the implicit outputs.
!--
! Add relative time to now and call absolute storer
ST_TAD((((.idtnc_block[2]<RH>)^18)/(60*60*24))+(.days^18)+S$TIME(),0,0);
END; ! ST_RTAD
%SBTTL 'Routine ST_SEQUENCE_ARGUMENT'
ROUTINE ST_SEQUENCE_ARGUMENT (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save value of /[NO]SEQUENCE or /PREREQUISITE. Only one /PREREQUISITE
! and one /SEQUENCE per command, except /NOSEQUENCE can't be typed with
! /PREREQUISITE.
!
! switch used meaning of switch
! --------------- ----------------------------------------------------
! /SEQUENCE:ABORT previous sequence is prerequisite, abort on error
! /SEQUENCE:CONT previous sequence is prerequisite, continue on error
! /PREREQUISITE:NONE no prerequisite, abort on error
! /PREREQUISITE:n request n is prerequisite, abort on error
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call, a number if /PREREQ:nn
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context, context of keyword
! SEQ_ABORT = /SEQUENCE:ABORT
! SEQ_CONTINUE = /SEQUENCE:CONTINUE
! SEQ_NUM = /PREREQUISITE:nn
! SEQ_NOSEQ = /PREREQUISITE:NONE
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$H_PREREQUISITE_ID]: set to prereq id if /PREREQ:id
! reqblk[DIU$V_SEQ_CONTINUE]: set if /SEQ:CONT
! rflags[R_PREREQUISITE]: set if /PREREQ:anything
! rflags[R_SEQUENCE]: set if /SEQ:anything
!
!--
SELECT .context OF
SET
[SEQ_NOSEQ,
SEQ_NUM]: BEGIN ! if /PREREQUISITE:n
IF .rflags[R_PREREQUISITE] ! Check to see if we have been here
THEN PE('Multiple /PREREQUISITE switches');
rflags[R_PREREQUISITE] = SEEN; ! remember we have been here before
moptions[DIUQ$K_PREREQUISITE_ID] = 1; ! also remember for modify
END;
[SEQ_NUM]: BEGIN
IF .r2 LSS 2 ! Legal id number?
THEN PE('Illegal /PREREQUISITE request id number');
reqblk[DIU$H_PREREQUISITE_ID] = .r2; ! Save the id number
END;
[SEQ_CONTINUE,
SEQ_ABORT]: BEGIN ! If /SEQUENCE
IF .rflags[R_SEQUENCE] ! Check to see if we have been here
THEN PE('Multiple /SEQUENCE switches');
rflags[R_SEQUENCE] = SEEN; ! remember we have been here before
moptions[DIUQ$K_SEQUENCE] = 1; ! remember for modify
END;
[SEQ_CONTINUE]: reqblk[DIU$V_SEQ_CONTINUE] = 1; ! Set the bit for later
TES; ! end of SELECT
RSTSTA(); ! Restore command state
END; ! ST_SEQUENCE_ARGUMENT
%SBTTL 'Routine ST_TAD'
ROUTINE ST_TAD (r2, cstate, CONTEXT): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Save the 36 bit universal date time for /AFTER and /DEADLINE.
! Disallows multiple /AFTER and /DEADLINE on the same command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (the universal date time).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! SAVCTX: saved context so we can tell if it was /AFTER or /DEADLINE
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$G_AFTER]: universal date time if /AFTER
! rflags[R_AFTER]: SEEN if /AFTER
! reqblk[DIU$G_DEADLINE]: universal date time if /DEADLINE
! rflags[R_DEADLINE]: SEEN if /DEADLINE
!
!--
CASE .savctx FROM TAD_MIN TO TAD_MAX OF
SET
[TAD_AFTER]: BEGIN
IF .rflags[R_AFTER]
THEN PE('Multiple /AFTER switches');
rflags[R_AFTER] = SEEN;
reqblk[DIU$G_AFTER] = .r2;
moptions[DIUQ$K_AFTER] = 1;
END;
[TAD_DEADLINE]: BEGIN
IF .rflags[R_DEADLINE]
THEN PE('Multiple /DEADLINE switches');
rflags[R_DEADLINE] = SEEN;
reqblk[DIU$G_DEADLINE] = .r2;
moptions[DIUQ$K_DEADLINE] = 1;
END;
[INRANGE,OUTRANGE]: SIGNAL(DIU$_BUG);
TES;
RSTSTA(); ! Restore command state
END; ! ST_TAD
%SBTTL 'Routine ST_UPA'
ROUTINE ST_UPA (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to process the /[NO]ACCESS switch from a command
! that takes filespecs or from SET DEFAULT, and the VMS style access
! information in the file specification. The /ACCESS switch parses for a
! quoted string (context=ACC_QUOTED) or a keyword (context=ACC_PROMPT or
! ACC_NONE). The embedded access information parses for a quoted string
! from a a VMS-style file specification where the node is of the form
! node"user password account":: (context=ACC_EMBEDDED). If its an
! /ACCESS:"string" switch or embedded access information, the access
! control information is in the atom buffer. If its an /ACCESS:PROMPT
! switch, then we want to prompt for access information later, in which
! case a "* * *" is put into the atom buffer. It its a /NOACCCESS or
! /ACCESS:NONE switch we zero the atom buffer. Anyway, after the atom
! buffer is filled with the right information it is split into the
! def_user, def_pass, and def_acct areas for use in SET DEFAULT and for
! adding to the source asnd destination tag buffers. Only in the case of
! some flavor or the /ACCESS switch we want to restore the command state
! before returning.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used, savsta is used instead).
! CONTEXT: Command component context:
! ACC_QUOTED: /ACCESS:"control"
! ACC_PROMPT: /ACCESS:PROMPT
! ACC_NONE: /ACCESS:NONE
! ACC_NOACCESS: /NOACCESS
! ACC_EMBEDDED: node"control"::
!
! IMPLICIT INPUTS:
!
! dflags[F_FILESPEC] rflags[F_FILESPEC]
! sflags[F_ACCOUNT] sflags[F_USERID] sflags[F_PASSWORD]
! dflags[F_ACCOUNT] dflags[F_USERID] dflags[F_PASSWORD]
! atom_buf: the atom buffer
!
! IMPLICIT OUTPUTS:
!
! the access string is send to the tag buffers (as appropriate)
! sflags[F_ACCESS] sflags[F_ACCOUNT] sflags[F_USERID] sflags[F_PASSWORD]
! dflags[F_ACCESS] dflags[F_ACCOUNT] dflags[F_USERID] dflags[F_PASSWORD]
! if /ACCESS then atom_buf is filled with "* * *"
! if /NOACCESS or /ACCESS:NONE then atom_buf is zeroed
!
! SIDE EFFECTS:
!
! if any flavor of /ACCESS: then the command state is restored
!--
LOCAL status, ! $STR_SCAN returned status
d, ! $STR_SCAN delimiter
ad : $STR_DESCRIPTOR(CLASS=BOUNDED); ! String to use for $STR_SCAN
! Hairy check for illegal combinations of /ACCESS switches (yuk). Its real
! ugly, because it uses a lot of BFI (brute force and ignorance), but it
! compiles into pretty small and fast code, and makes real nice error messages.
IF .dflags[F_FILESPEC] OR .dflags[F_NODE]
THEN BEGIN ! We have seen a destination
IF .dflags[F_ACCESS]
THEN PE('Multiple access control given for destination');
IF .dflags[F_USERID]
THEN PE('/USERID illegal with access control given for destination');
IF .dflags[F_PASSWORD]
THEN PE('/PASSWORD illegal with access control given for destination');
IF .dflags[F_ACCOUNT]
THEN PE('/ACCOUNT illegal with access control given for destination');
dflags[F_ACCESS] = SEEN;
dflags[F_USERID] = SEEN;
dflags[F_PASSWORD] = SEEN;
dflags[F_ACCOUNT] = SEEN;
END
ELSE BEGIN ! Here if we haven't seen a dest file
IF .sflags[F_ACCESS] ! If access information already seen
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('Multiple access control given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN PE('Multiple /ACCESS switches')
ELSE PE('Multiple global /ACCESS switches given');
IF .sflags[F_USERID]
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('/USERID illegal with access control given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN PE('/USERID illegal with /ACCESS')
ELSE PE('Global /USERID illegal with global /ACCESS');
IF .sflags[F_PASSWORD]
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('/PASSWORD illegal with access control given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN PE('/PASSWORD illegal with /ACCESS')
ELSE PE('Global /PASSWORD illegal with global /ACCESS');
IF .sflags[F_ACCOUNT]
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('/ACCOUNT illegal with access control given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN PE('/ACCOUNT illegal with /ACCESS')
ELSE PE('Global /ACCOUNT illegal with global /ACCESS');
sflags[F_ACCESS] = SEEN;
sflags[F_USERID] = SEEN;
sflags[F_PASSWORD] = SEEN;
sflags[F_ACCOUNT] = SEEN;
IF NOT (.sflags[F_FILESPEC] OR .sflags[F_NODE])
THEN BEGIN ! switch applies to source and dest
dflags[F_ACCESS] = SEEN; ! BLISS combines all of these
dflags[F_USERID] = SEEN;
dflags[F_PASSWORD] = SEEN;
dflags[F_ACCOUNT] = SEEN;
END;
END;
! Fill in the atom buffer with prompt strings it he wants to be prompted,
! zap the atom buffer if /NOACCESS or /ACCESS:NONE, and restore the command
! state if some flavor of the /ACCESS switch.
SELECT .context OF
SET
[ACC_PROMPT]: CH$MOVE(6,PP('* * *'),.stateb[$CMABP]);
[ACC_NOACCESS, ACC_NONE]: atom_buf = 0;
[ACC_QUOTED, ACC_PROMPT, ACC_NONE]: RSTSTA();
TES;
! Make an XPORTable string out of the atom buffer
$STR_DESC_INIT(DESC=ad, CLASS=BOUNDED,
STRING=(ASCIZ_LEN(.stateb[$CMABP]),.stateb[$CMABP]));
! Find the username, copy it to def_user; find the password and copy it to
! def_pass; find the account and copy it to def_acct.
$STR_SCAN(REMAINDER=ad, ! Scan for the userid
SUBSTRING=ad, ! returning it in ad
STOP=' ', DELIMITER=d); ! looking for space, return delimiter
$STR_COPY(STRING=ad, ! Copy the userid
TARGET=def_user); ! to def_user
IF .d EQL %C' ' ! If there was a space after userid
THEN BEGIN ! then extract the password
STR_INCLUDE(ad, 1); ! Skip past space
$STR_SCAN(REMAINDER=ad, ! Scan for the password next
SUBSTRING=ad, ! return it in ad,
STOP=' ', DELIMITER=d); ! looking for space, return delimiter
$STR_COPY(STRING=ad, ! Grab the password
TARGET=def_pass); ! copy it to def_pass
IF .d EQL %C' ' ! If there was a space after the passwd
THEN BEGIN ! then extract the account
STR_INCLUDE(ad, 1); ! Skip past space
$STR_SCAN(REMAINDER=ad, ! Scan for account
SUBSTRING=ad, ! returning in in ad
STOP=' '); ! stopping on a space (?)
$STR_COPY(STRING=ad, ! Grab the account string
TARGET=def_acct); ! and put it in def_acct
END;
END;
! Now tag the userid, account, and password to the proper dest/source buffers
IF .dflags[F_FILESPEC] OR .dflags[F_NODE]
THEN BEGIN ! Dest filespec, add to dest buffer
ADD_TAG(diu$k_diu_user, ! Add user
diu$k_tag_text,
.def_user[STR$A_POINTER],
.def_user[STR$H_LENGTH],
p_dst);
ADD_TAG(diu$k_diu_password,
diu$k_tag_text,
.def_pass[STR$A_POINTER],
.def_pass[STR$H_LENGTH],
p_dst);
ADD_TAG(diu$k_diu_account,
diu$k_tag_text,
.def_acct[STR$A_POINTER],
.def_acct[STR$H_LENGTH],
p_dst);
END
ELSE BEGIN ! No dest filespec, add to src buffer
ADD_TAG(diu$k_diu_user,
diu$k_tag_text,
.def_user[STR$A_POINTER],
.def_user[STR$H_LENGTH],
p_src);
ADD_TAG(diu$k_diu_password,
diu$k_tag_text,
.def_pass[STR$A_POINTER],
.def_pass[STR$H_LENGTH],
p_src);
ADD_TAG(diu$k_diu_account,
diu$k_tag_text,
.def_acct[STR$A_POINTER],
.def_acct[STR$H_LENGTH],
p_src);
IF NOT (.sflags[F_FILESPEC] OR .sflags[F_NODE])
THEN BEGIN ! Global switch, add to dest buffer too
ADD_TAG(diu$k_diu_user,
diu$k_tag_text,
.def_user[STR$A_POINTER],
.def_user[STR$H_LENGTH],
p_dst);
ADD_TAG(diu$k_diu_password,
diu$k_tag_text,
.def_pass[STR$A_POINTER],
.def_pass[STR$H_LENGTH],
p_dst);
ADD_TAG(diu$k_diu_account,
diu$k_tag_text,
.def_acct[STR$A_POINTER],
.def_acct[STR$H_LENGTH],
p_dst);
END;
END;
END; ! ST_UPA
%SBTTL 'Routine ST_USERNAME'
ROUTINE ST_USERNAME (r2,cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Process the /USERID switch. It parses for a quoted string
! (context=ACC_QUOTED) or a field (context=ACC_UNQUOTED). If the atom
! that parses is a null field, then we want to prompt for a userid later,
! in which case a "*" is set to be the userid. The userid string or "*"
! is copied to the default userid (for SET DEFAULT) and added to the
! source and/or destination tags.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (not used).
! CSTATE: Parser's current state (not used).
! CONTEXT: Command component context (ACC_QUOTED or ACC_UNQUOTED).
!
! IMPLICIT INPUTS:
!
! dflags[F_FILESPEC], rflags[F_FILESPEC]
! atom buffer
!
! IMPLICIT OUTPUTS:
!
! source and destination tag buffers
! default userid is set for SET DEFAULTS
! sflags[F_USERID] and/or dflags[F_USERID]
!
! SIDE EFFECTS:
!
! saved command state is restored
!
!--
! If we get a null unquoted string, remember to prompt for the real input
IF (.context EQL ACC_UNQUOTED) AND (CH$RCHAR(.stateb[$CMABP]) EQL 0)
THEN CH$MOVE(2,PP(PROMPT_CHARACTER),.stateb[$CMABP]);
! Copy atom buffer to the default save area (case of SET DEFAULT)
$STR_COPY(STRING=ASCIZ_STR(.stateb[$CMABP]),TARGET=def_user);
! Add it to the tag buffer for source and destination filespecs as needed,
! checking for multiple /USERID switches.
IF .dflags[F_FILESPEC] OR .dflags[F_NODE]
THEN BEGIN
IF .dflags[F_USERID]
THEN PE('Multiple USERIDs given for destination');
dflags[F_USERID] = SEEN;
ADD_TAG(diu$k_diu_user,
diu$k_tag_text,
.def_user[STR$A_POINTER],
.def_user[STR$H_LENGTH],
p_dst);
END
ELSE BEGIN
IF .sflags[F_USERID]
THEN IF .sflags[F_FILESPEC] OR .sflags[F_NODE]
THEN PE('Multiple USERIDs given for source')
ELSE IF .savsta EQL SET_DEFAULTS_SWITCHES
THEN IF .sflags[F_ACCESS]
THEN PE('/ACCESS illegal with /USERID')
ELSE PE('Multiple /USERID switches')
ELSE PE('Multiple global USERIDs given');
sflags[F_USERID] = SEEN;
ADD_TAG(diu$k_diu_user,
diu$k_tag_text,
.def_user[STR$A_POINTER],
.def_user[STR$H_LENGTH],
p_src);
IF NOT (.sflags[F_FILESPEC] OR .sflags[F_NODE])
THEN BEGIN
dflags[F_USERID] = SEEN;
ADD_TAG(diu$k_diu_user,
diu$k_tag_text,
.def_user[STR$A_POINTER],
.def_user[STR$H_LENGTH],
p_dst);
END;
END;
! Restore command state to before the switch was typed
RstSta();
END; ! ST_USERNAME
%SBTTL 'Routine ST_VERBOSITY'
ROUTINE st_verbosity (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Remember the switch for the DIRECTORY command.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context, switch value for storage
!
! IMPLICIT OUTPUTS:
!
! shq_verbosity: set to the verbosity level specified
!--
shq_verbosity = .context;
END; ! ST_VERBOSITY
%SBTTL 'Routine ST_WARNING_COUNT'
ROUTINE ST_WARNING_COUNT (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Store the /WARNING value, parsed by $CMNUM.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (the number).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! REQBLK[DIU$H_WARNING_MAX] - the number is stored here.
!--
IF .rflags[R_WARNINGS]
THEN PE('Multiple /WARNINGS switches specified');
rflags[R_WARNINGS] = SEEN;
IF .R2 GTRU %O'777777' ! Maximum legal max that will fit
THEN PE('Illegal value for /WARNINGS switch');
reqblk[DIU$H_WARNING_MAX] = .R2; ! save warning count in request block
RSTSTA();
END; ! ST_WARNING_COUNT
%SBTTL 'Routine START'
ROUTINE START (r2, cstate, context): NOVALUE = ! START action routine
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Start up the spooler.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! ccl_mode: cleared
!
! SIDE EFFECTS:
!
! DIU will not exit after this command, even if invoked by "@DIU START"
!--
IF .mst_flag AND NOT .shutdown THEN ! Are we (yet) the spooler?
PE('Spooler already started'); ! yes
SP$START(); ! Start the spooler
ccl_mode = 0; ! Don't exit if I am (yet) the spooler
END; ! START
%SBTTL 'Routine STOP'
ROUTINE STOP (r2, cstate, context): NOVALUE = ! STOP action routine
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Spooling is terminated, if this job is the spooler
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! STOPSWITCHES: bits for switches to STOP command (only /NOWAIT now)
! MST_FLAG: Set if we are spooler. SP$STOP clears if no active jobs
!--
IF NOT .mst_flag ! See if we are the spooler
THEN PE('You are not (yet) the spooler');
SP$STOP(.stopswitches); ! Stop the spooler
END; ! STOP
%SBTTL 'Routine STOP_SWITCH'
ROUTINE STOP_SWITCH (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! STOP switch action routine
!
! FORMAL PARAMETERS:
!
! R2: Data From COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context: 1 if /NOWAIT, 0 otherwise
!
! IMPLICIT OUTPUTS:
!
! STOPSWITCHES: bit set for switch encountered
!--
stopswitches = .context;
END; ! STOP_SWITCH
%SBTTL 'Routine SW_ARGUMENT'
ROUTINE sw_argument (r2, cstate, context) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Remember the state we were called from, and the context. Then check
! for the typein ending in = and change it to a :. This routine is
! called to processing switch values where we have to go to another
! state, and want to get back where we came from.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (saved).
! CONTEXT: Command component context (saved).
!
! IMPLICIT OUTPUTS:
!
! SAVSTA is set to the current command state
! SAVCTX is set to CONTEXT argument
! SAVNAM gets the $GJNAM word from JFNBLK
! SAVEXT gets the $GJEXT word from JFNBLK
! SAVGEN gets the $GJGEN word from JFNBLK
! SAVF2 gets the $GJF2 word from JFNBLK
!--
LOCAL back_cnt;
! If the switch was terminated with a equalsign like VMS, hallucinate it into a
! colon and turn on the colon seen flag. Note: on a ^R the equalsign will turn
! into a colon- you aren't seeing things.
IF CH$RCHAR(.stateb[$CMPTR]) EQL %C'=' ! Terminated with '='?
THEN BEGIN
CH$WCHAR_A(%C':',stateb[$CMPTR]); ! Yes make it a colon instead
stateb[$CMFLG] = .stateb[$CMFLG] OR CM_SWT; ! and light the colon seen bit
END;
! Check to see that if the switch was terminated by a colon that the switch
! flags indicating that is set; otherwise parses by CMKEY of the second word of
! double switches (e.g. /RECORD_FORMAT:FIXED:n) won't work right.
IF CH$RCHAR(.stateb[$CMPTR]) EQL %C':' ! Next character a colon and
AND CH$RCHAR(CH$PLUS(.stateb[$CMPTR],-1)) NEQ %C':' ! previous not a colon?
THEN BEGIN ! Must be a CMKEY parse with an arg
stateb[$CMPTR] = CH$PLUS(.stateb[$CMPTR],1); ! Go around the colon
stateb[$CMCNT] = .stateb[$CMCNT] - 1; ! Count down avail bytes
stateb[$CMINC] = .stateb[$CMINC] - 1; ! Count down unparsed bytes
END;
! Save the command state for later restoration by RSTSTA
IF .savsta EQL 0 ! If we have not saved the main state
THEN BEGIN ! This is the time to do it
savctx = .context; ! Save context and command state
savsta = .cstate;
savgen = .jfnblk[$GJGEN]; ! Save jfnblk
savnam = .jfnblk[$GJNAM];
savext = .jfnblk[$GJEXT];
savf2 = .jfnblk[$GJF2];
END;
END; ! SW_ARGUMENT
%SBTTL 'Routine TAKE'
ROUTINE TAKE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! TAKE Command
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT INPUTS:
!
! number: JFN of take file
!--
LOCAL openf_error, ! Error returned by OPENF
abort_or_end, ! Address of ASCIZ reason for stoppage
current_takejfn, ! Current take jfn
saved_cmioj, ! Place to save io jfns
saved_takeswitches, ! Place to save current take switches
saved_takejfn, ! Current take JFN
saved_takeflag; ! Place to save current take flag
! Open the take file
IF NOT JSYS_OPENF(.number,%O'70000000000'+OF_RD; openf_error) ! OF_BSZ of 7
THEN BEGIN ! It didn't work, so
JSYS_RLJFN(.number); ! Release the JFN
DIU$MESSAGE(RMS$_COF, .openf_error, 0, FALSE); ! Print error message
RETURN; ! Punt the take command
END;
! Remember current context for later
saved_takejfn = .takejfn; ! Save the opened take jfn or 0
saved_cmioj = .stateb[$CMIOJ]; ! Save JFNs, they get clobbered
saved_takeswitches = .takeswitches; ! Save take flags
takeswitches = .new_takeswitches; ! copy over the switch in the command
saved_takeflag = .takeflag; ! Save current take flag (nested take)
current_takejfn = .number; ! Remember the current take JFN
takejfn = .number; ! Remember JFN to set EOF on
takeflag = 1; ! Indicate we are in a take
! Process commands from the file by calling DIUCMD recursively
DIUCMD(.current_takejfn); ! Process file
! File has finished, see if it was aborted or whatever and then close it
S$CRIF(); ! Output crlf if needed
IF .takejfn NEQ -1 ! Are we aborting the take?
THEN abort_or_end = PP('End of ') ! No
ELSE abort_or_end = PP('Aborting '); ! Yes
$TTY_FAO('[!AZ!J]!/',.abort_or_end,.current_takejfn);
JSYS_CLOSF(.current_takejfn); ! Close and release the JFN
! Restore context and get ready to exit the take
CMDSTA = EXIT_STATE; ! Set state to exit COMAND
takeswitches = .saved_takeswitches; ! Reset take switches
takeflag = .saved_takeflag; ! Restore old take flag
stateb[$CMIOJ] = .saved_cmioj; ! Restore JFNs from before
! If we are aborting takes and its nested be sure and set the next one to EOF!
IF .saved_takejfn EQL 0 ! Is this the end of the nested take?
THEN takejfn = 0 ! Yes it is
ELSE IF .takejfn NEQ -1 ! No, are we aborting the take?
THEN takejfn = .saved_takejfn ! No, restore the takejfn cell
ELSE BEGIN ! Unwinding nested takes then
stateb[$CMCNT] = CBUF_LEN; ! Number of characters free in buffer
stateb[$CMINC] = 0; ! Count of unparsed characters
JSYS_SFPTR(.saved_takejfn,-1); ! Set the JFN to current eof
END; ! End of unwinding nested takes
END; ! TAKE
%SBTTL 'Routine SET_TAKE_SWITCH'
ROUTINE SET_TAKE_SWITCH (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Called on SET TAKE {ECHO,NOECHO} to remember default take mode.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context: TAK_ECHO or TAK_NOECHO.
!
! IMPLICIT OUTPUTS:
!
! number: set to context
!--
number = .context; ! Remember the context for later
END; ! SET_TAKE_SWITCH
%SBTTL 'Routine SET_TAKE_MODE'
ROUTINE SET_TAKE_MODE (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Called on confirm of SET TAKE {ECHO|NOECHO} to actually set the
! TAKE default mode to whatever the user specified.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context (ignored).
!
! IMPLICIT OUTPUTS:
!
! def_takeswitches: set to new default
!--
def_takeswitches = .number;
END; ! SET_TAKE_MODE
%SBTTL 'Routine TAKE_SWITCH'
ROUTINE TAKE_SWITCH (r2, cstate, context) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Process TAKE command switches.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command component context: 1 if /ECHO, 0 otherwise.
!
! IMPLICIT OUTPUTS:
!
! new_takeswitches: set for switch encountered.
!--
BEGIN
new_takeswitches = .context;
END; ! TAKE_SWITCH
%SBTTL 'Routine TRANSFORM'
ROUTINE TRANSFORM (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called with a JFN in r2 that is to be used for the
! TRANSFORM filespec. The filespec is added to the request block.
! Multiple /TRANSFORM switches on the command line are disallowed. The
! filespec specified must be a disk file.
!
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call, JFN of the filespec.
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command Component Context (ignored).
!
! IMPLICIT OUTPUTS:
!
! reqblk[DIU$T_TRANSFORM] is filled in with the transform filespec
! reqblk[DIU$H_TRANSFORM] has the length of that string
!
! SIDE EFFECTS:
!
! The JFN we got from COMND is released
!--
LOCAL device_chars; ! Device characteristics
! Can't specify /IMAGE with /TRANSFORM, so check for this.
IF .rflags[R_IMAGE]
THEN PE('/TRANSFORM illegal with /IMAGE file format');
! Check for multiple /TRANSFORM files, remember we've been here before.
IF .rflags[R_TRANSFORM]
THEN PE('Multiple TRANSFORM files specified');
rflags[R_TRANSFORM] = SEEN;
! Insure the JFN refers to a disk file
JSYS_DVCHR(.r2; device_chars); ! Get the device characteristics
IF .device_chars<18,9,0> NEQ $DVDSK ! Is it a disk?
THEN PE('TRANSFORM file must be on disk');
! Copy the filespec and its length to the request block.
JSYS_JFNS(CH$PTR(reqblk[DIU$T_TRANSFORM]),.r2,jfns_all);
reqblk[DIU$H_TRANSFORM] = ASCIZ_LEN(CH$PTR(reqblk[DIU$T_TRANSFORM]));
JSYS_RLJFN(.r2); ! Free the JFN we got from COMND
RSTSTA(); ! Restore command state
END; ! TRANSFORM
%SBTTL 'Routine TRACE_ACTION'
ROUTINE TRACE_ACTION (r2, cstate, context): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to for the TRACE command. It makes the proper
! RMS call then returns.
!
! FORMAL PARAMETERS:
!
! R2: Data from COMND monitor call (ignored).
! CSTATE: Parser's current state (ignored).
! CONTEXT: Command Component Context (ignored).
!
! SIDE EFFECTS:
!
! RMS-20 is put into trace mode.
!--
$DEBUG(VALUE=%O'400000'); ! RMS please give us DAP verbage
END; ! TRACE_ACTION
END ! DIUCMD
ELUDOM