Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/crc/ind/ind.mac
There are no other files named ind.mac in the archive.
;<IND>IND.MAC.471, 11-Oct-84 13:36:45, EDIT BY KEVIN
;	Convert to running inferiors via PTY's
;**********************Start V5******************************
;<IND>IND.MAC.457, 17-Feb-84 13:29:51, EDIT BY KEVIN
;	Add <FILPAG>,<FILSIZ>,<FILBYS>
;<IND>IND.MAC.456, 24-Jan-84 10:32:09, EDIT BY KEVIN
;	IND doesn't work in batch yet. Make sure people don't try.
;<IND>IND.MAC.451,  2-Nov-83 14:00:05, EDIT BY KEVIN
;	Add the TELL directive
;<IND>IND.MAC.448,  6-Sep-83 13:23:42, EDIT BY KEVIN
;	When saving and restoring JFN mode words in $CRCMD, we have problems
;	because the JFN mode word is not big enough to store fields like TT%WID.
;	We must use MTOPR to save and restore these explicitly.
;<IND>IND.MAC.447,  1-Sep-83 16:48:18, EDIT BY KEVIN
;	Make invalid filespecs in .TESTFILE return error -4
;<IND>IND.MAC.446,  1-Sep-83 16:44:12, EDIT BY KEVIN
;<IND>IND.MAC.445, 24-Aug-83 17:45:59, EDIT BY KEVIN
;	Add another system symbol (BYTEPOS) for current position of input file,
;	and another directive (POSITION) to get there.
;<IND>IND.MAC.444, 24-Aug-83 16:16:52, EDIT BY KEVIN
;	.PURGE directive doesn't decrement symbol usage stats.
;<IND>IND.MAC.443, 24-Aug-83 16:04:04, EDIT BY KEVIN
;	Squeeze stopped working when we altered the symbol tables
;<IND>IND.MAC.442, 20-Jul-83 12:04:56, EDIT BY KEVIN
;	Terminal occasionally hung with logging - suspect SOBE% problem.
;<IND>IND.MAC.441, 27-May-83 15:01:10, EDIT BY KEVIN
;	Add .RADIX operator
;<IND>IND.MAC.440, 29-Apr-83 15:21:51, EDIT BY KEVIN
;<IND>IND.MAC.438, 29-Apr-83 15:09:36, EDIT BY KEVIN
;	Add DAYTON and NTODAY to convert date strings to numbers, etc.
;<IND>IND.MAC.437, 11-Apr-83 14:00:22, EDIT BY KEVIN
;	.RUN gives no error message when file not found.
;<IND>IND.MAC.436, 28-Mar-83 11:31:22, EDIT BY KEVIN
;<IND>IND.MAC.435, 28-Mar-83 11:16:49, EDIT BY KEVIN
;	Purge had lost pointer to symbol to delete.
;<IND>IND.MAC.434,  1-Mar-83 15:57:46, EDIT BY KEVIN
;	Make IND FAIL-compatible (give up 'cos we don't have MACSYM.FUN, and
;	we can't use FAIL to compile MACSYM.MAC 'cos it uses IRP's which
;	aren't FAIL-compatible, and you can't compile MONSYM without MACSYM
;	and the MONSYM and MACSYM distributed with FAIL are from some 
;	prehistoric V of TOPS-20 like V3 or something..... I give up.)
;<IND>IND.MAC.433, 17-Feb-83 15:28:01, EDIT BY KEVIN
;	Must do proper compare for logical values
;<IND>IND.MAC.431, 14-Feb-83 17:13:49, EDIT BY KEVIN
;	Add CTRL/A panic abort, and .ENABLE/.DISABLE  abort
;<IND>IND.MAC.430, 14-Feb-83 14:03:06, EDIT BY KEVIN
;	.PARSE forgot to zero string count before using it.
;<IND>IND.MAC.429, 14-Feb-83 13:13:48, EDIT BY KEVIN
;	.REAL directive in wrong place in command table
;<IND>IND.MAC.427, 14-Feb-83 11:35:09, EDIT BY KEVIN
;	Make .TESTFILE return filename, device etc. fields on success.
;<IND>IND.MAC.424, 11-Feb-83 15:28:20, EDIT BY KEVIN
;	Left a NOUT in .ASKR
;<IND>IND.MAC.423, 11-Feb-83 14:58:58, EDIT BY KEVIN
;	If we can't find command file, look for it on SYS:
;<IND>IND.MAC.422,  9-Feb-83 14:47:23, EDIT BY KEVIN
;	RANGES was losing its track of the stack
;<IND>IND.MAC.421,  9-Feb-83 14:14:49, EDIT BY KEVIN
;	Forgot a couple of labels in range evaluation
;<IND>IND.MAC.420,  9-Feb-83 13:36:34, EDIT BY KEVIN
;	Make ISDGT accept decimal points in a number
;<IND>IND.MAC.419,  9-Feb-83 13:31:57, EDIT BY KEVIN
;	Woops - that means we have to add .SETR, .REAL, and add routines
;	to lookup and set numeric symbols, and modify the substitution routines,
;	and the range routines, and also add FLTEXP for floating expressions,
;	and modify NUMEXP to fix floating numbers in integer expressions, and...
;	why do I make work for myself like this ?
;<IND>IND.MAC.418,  9-Feb-83 12:13:10, EDIT BY KEVIN
;	Add .ASKR - ask for a real symbol
;<IND>IND.MAC.414,  8-Feb-83 18:55:55, EDIT BY KEVIN
;	Garbage collector destroyed string pool - typo.
;<IND>IND.MAC.413,  3-Feb-83 17:47:30, EDIT BY KEVIN
;	Symbol use tables did not map into each other correctly
;<IND>IND.MAC.412,  3-Feb-83 17:33:38, EDIT BY KEVIN
;	.IF directive couldn't handle strings
;<IND>IND.MAC.410,  3-Feb-83 17:02:15, EDIT BY KEVIN
;	Add .DDT directive to merge SYS:UDDT
;<IND>IND.MAC.408,  3-Feb-83 16:48:47, EDIT BY KEVIN
;	Problem was using LUKSYM instead of LUKSTR,LUKNUM,etc.
;<IND>IND.MAC.407,  3-Feb-83 16:42:57, EDIT BY KEVIN
;	Substitution of strings is messed up
;<IND>IND.MAC.405,  3-Feb-83 15:53:31, EDIT BY KEVIN
;	ASKCHK worked the wrong way round
;<IND>IND.MAC.404,  3-Feb-83 15:26:49, EDIT BY KEVIN
;	Bad labels were not causing parsing to halt
;<IND>IND.MAC.401,  3-Feb-83 15:14:13, EDIT BY KEVIN
;<IND>IND.MAC.400,  3-Feb-83 15:01:39, EDIT BY KEVIN
;	Change symbol tables so that there is one large one for all variable
;	symbols, with codes for symbol type. This allows full words to be used
;	for values, and makes checking for existence/type of a symbol much
;	quicker and easier.
;	Routines affected: ASKCHK,ENTVAL,ENT*,LUK*,ENTPLC,all tables, all
;	routines calling these routines.
;<IND>IND.MAC.399, 27-Jan-83 17:51:50, EDIT BY KEVIN
;	Make comments undestand this too.
;<IND>IND.MAC.397, 27-Jan-83 17:35:14, EDIT BY KEVIN
;	Default to allowing leading spaces/tabs before IND directives.
;	************** V4 STARTS HERE ***************
;<IND>IND.MAC.396, 11-Jan-83 17:09:40, EDIT BY KEVIN
;	Read directive appears to be failing to set <STRLEN>
;<IND>IND.MAC.395, 11-Nov-82 13:49:35, EDIT BY KEVIN
;	Logic for deleting symbols (PURGE) was hopeless. I must have had a
;	brainstorm that night. DO IT AGAIN !!!
;<IND>IND.MAC.394,  4-Nov-82 14:08:24, EDIT BY KEVIN
;	Set up for settable quiet EXEC name
;<IND>IND.MAC.393,  4-Nov-82 13:46:08, EDIT BY KEVIN
;	.RUN doesn't work with CSAVE'd files 'cos we're still tring to use
;	the jfn of the EXE file after we do the GET% on it.
;<IND>IND.MAC.391,  3-Nov-82 11:35:42, EDIT BY KEVIN
;	problrem with MAKHDW
;<IND>IND.MAC.389,  3-Nov-82 10:20:26, EDIT BY KEVIN
;	Add .RAISE directive
;<IND>IND.MAC.388,  3-Nov-82 09:57:13, EDIT BY KEVIN
;	If quiet mode is enabled, don't print messages when PAUSing
;<IND>IND.MAC.386,  1-Nov-82 11:57:21, EDIT BY KEVIN
;	Set up symbols <DEFNAM>, etc. for .ASKF defaults.
;	Change field type for .ASKS from .CMTXT to .CMFLD, so we can
;	parse leading blanks, etc.
;<IND>IND.MAC.384,  1-Nov-82 11:33:44, EDIT BY KEVIN
;	Bad return for null string in .TRIM
;<IND>IND.MAC.382,  1-Nov-82 10:45:44, EDIT BY KEVIN
;	Add .TRIM and .PAD directives.
;<IND>IND.MAC.381,  1-Nov-82 10:09:01, EDIT BY KEVIN
;<IND>IND.MAC.380, 29-Oct-82 18:10:24, EDIT BY KEVIN
;	Add some more system symbols
;	Accept that .ASKS just won't accept blank fields
;<IND>IND.MAC.379, 29-Oct-82 17:31:23, EDIT BY KEVIN
;<IND>IND.MAC.377, 29-Oct-82 17:11:17, EDIT BY KEVIN
;	.PARSE should not copy delimiters into field strings
;<IND>IND.MAC.375, 29-Oct-82 16:57:36, EDIT BY KEVIN
;	Let SEARCH and LENG accept implicit byte pointers
;<IND>IND.MAC.374, 29-Oct-82 15:28:24, EDIT BY KEVIN
;	.ASK was accepting null variable names
;	Cure is improve ENTVAL to call ASKCHK for types, and to call
;	LENG to check variable name lengths.
;<IND>IND.MAC.372, 29-Oct-82 15:08:32, EDIT BY KEVIN
;<IND>IND.MAC.371, 29-Oct-82 14:59:11, EDIT BY KEVIN
;	Forgot to skip blanks after parsing control string
;<IND>IND.MAC.369, 29-Oct-82 14:27:56, EDIT BY KEVIN
;	Control string for parse should be a string expression, not var
;<IND>IND.MAC.368, 29-Oct-82 14:16:29, EDIT BY KEVIN
;	Add default string answer. Add .PARSE directive.
;<IND>IND.MAC.367, 29-Oct-82 11:41:00, EDIT BY KEVIN
;	Setup new way of implementing writeable system symbols. Remove
;	old code.
;<IND>IND.MAC.364, 28-Oct-82 16:47:12, EDIT BY KEVIN
;	Add .PURGE directive to remove a symbol
;<IND>IND.MAC.361, 22-Oct-82 11:49:51, EDIT BY KEVIN
;	Add new capability for system symbols to be either read-only or
;	read-write. This is to allow implementation of such things as 
;	<STRINGDEF> etc.
;<IND>IND.MAC.360,  2-Sep-82 13:26:05, EDIT BY KEVIN
;	Improve setting of subsystem name across exec commands
;<IND>IND.MAC.359,  6-Aug-82 17:19:02, EDIT BY KEVIN
;	Allow directive keywords to have spaces between them and their dots,
;	such as .		SETS
;	This permits nice nested type stuff in command files like RSX.
;<IND>IND.MAC.358, 15-Jul-82 10:10:22, EDIT BY KEVIN
;	Typo in last edit
;<IND>IND.MAC.357, 15-Jul-82 10:07:13, EDIT BY KEVIN
;	The method that CRCMD uses to suppress COMAND.CMD is somehwhat
;	unsatisfactory. Set the file invisible instead of renaming it.
;<IND>IND.MAC.356, 13-Jul-82 11:39:19, EDIT BY KEVIN
;	Wrong compare in ENTSTR meant we very occasionally bombed out with
;	?string storage full when in fact it was only exactly written to end.
;<IND>IND.MAC.354,  9-Jul-82 14:36:09, EDIT BY KEVIN
;	Disabling command.cmd does not work if we are not connected to
;	the login directory - a bug in crcmd. Make it always use the login
;	directory. (By connect)
;<IND>IND.MAC.353,  5-Jul-82 17:15:48, EDIT BY KEVIN
;<IND>IND.MAC.352,  5-Jul-82 16:51:20, EDIT BY KEVIN
;	Add some more special system symbols - string characeristics.
;<IND>IND.MAC.351, 30-Jun-82 13:23:36, EDIT BY KEVIN
;	Add command file name to logfile
;<IND>IND.MAC.350, 22-Jun-82 14:24:40, EDIT BY KEVIN
;<IND>IND.MAC.349, 22-Jun-82 14:00:43, EDIT BY KEVIN
;	Version 3 start - add .CODE directive (mainly for building IND itself)
;	and setup for changeable quoting character.
;<IND>IND.MAC.348, 18-May-82 15:06:39, EDIT BY KEVIN
;	But include a new .EXIT directive which does.
;	The .EXIT directive will also return to our superior command file
;	if there is one - .STOP does not.
;<IND>IND.MAC.347, 13-May-82 10:29:59, EDIT BY KEVIN
;	Make .STOP directive not print @ <EOF> message.
;<IND>IND.MAC.346,  6-May-82 14:37:32, EDIT BY KEVIN
;<IND>IND.MAC.345,  6-May-82 14:30:59, EDIT BY KEVIN
;	.IF directive did not recognise "=" - modify GETWRD.
;	Check for PTY links being cleared
;<IND>IND.MAC.344,  6-May-82 14:00:09, EDIT BY KEVIN
;	Certain fork JSYSs were not trapped by ERCALs. Also, have found
;	new method of waiting for inferior, based on GETAB stuff.
;<IND>IND.MAC.343, 23-Apr-82 11:53:20, EDIT BY KEVIN
;<IND>IND.MAC.342, 23-Apr-82 11:49:40, EDIT BY KEVIN
;	Problem was due to commas in the wrong place
;<IND>IND.MAC.340, 23-Apr-82 11:34:21, EDIT BY KEVIN
;	Must change break mask for tokens with .CMTXT
;<IND>IND.MAC.338, 23-Apr-82 11:10:05, EDIT BY KEVIN
;	IF CM%SDH is set in the first FDB, following FDBs must supply their
;	own help messages.
;<IND>IND.MAC.337, 23-Apr-82 11:04:45, EDIT BY KEVIN
;	Token function does not work if .CMTXT is a previous alternative
;<IND>IND.MAC.335, 21-Apr-82 09:51:33, EDIT BY KEVIN
;<IND>IND.MAC.333, 20-Apr-82 15:11:41, EDIT BY KEVIN
;<IND>IND.MAC.332, 20-Apr-82 15:00:48, EDIT BY KEVIN
;	Add .DISABLE COMAND-CMD, put logfile under conditional
;<IND>IND.MAC.331, 20-Apr-82 14:47:52, EDIT BY KEVIN
;	remove unused buffers (for RDTTY) and update copyright
;<IND>IND.MAC.330, 20-Apr-82 14:28:41, EDIT BY KEVIN
;	Confirm handling incorrect in .ASKS
;<IND>IND.MAC.328, 20-Apr-82 14:16:38, EDIT BY KEVIN
;	Text string parsing is not all it could be. Must allow
;	CONFIRM as a separate option to allow for null strings.
;<IND>IND.MAC.327, 20-Apr-82 13:59:20, EDIT BY KEVIN
;	COMND and numbers appears ok, now for the last one - text strings
;<IND>IND.MAC.326, 20-Apr-82 13:47:05, EDIT BY KEVIN
;	Range checking failed due to trashed acs
;<IND>IND.MAC.325, 20-Apr-82 13:34:58, EDIT BY KEVIN
;	Did not inlude ctrl/z break mask in  .ASKN
;<IND>IND.MAC.322, 20-Apr-82 13:25:24, EDIT BY KEVIN
;	Flddb. does not reserve un-needed words
;<IND>IND.MAC.321, 20-Apr-82 13:15:51, EDIT BY KEVIN
;	Introduce COMND to .ASKN
;<IND>IND.MAC.320, 20-Apr-82 12:55:43, EDIT BY KEVIN
;	CMDINI was clearing the GTJFN block in .ASKF
;<IND>IND.MAC.319, 20-Apr-82 12:49:59, EDIT BY KEVIN
;<IND>IND.MAC.317, 20-Apr-82 11:46:35, EDIT BY KEVIN
;<IND>IND.MAC.316, 20-Apr-82 11:30:16, EDIT BY KEVIN
;<IND>IND.MAC.315, 20-Apr-82 11:28:37, EDIT BY KEVIN
;	Start including COMND-type parsing in .ASKF.
;<IND>IND.MAC.314, 20-Apr-82 09:49:22, EDIT BY KEVIN
;	Set COMND to wake up on each field.
;<KEVIN>IND.MAC.313, 19-Apr-82 19:37:21, EDIT BY KEVIN
;<KEVIN>IND.MAC.312, 19-Apr-82 19:24:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.311, 19-Apr-82 19:16:02, EDIT BY KEVIN
;<KEVIN>IND.MAC.310, 19-Apr-82 19:14:48, EDIT BY KEVIN
;	Must put ctrl-z into breakset
;<KEVIN>IND.MAC.309, 19-Apr-82 18:58:02, EDIT BY KEVIN
;	The COMND stuff appears to be safe so far - now try to include
;	"Ctrlz" as one of the options.
;<KEVIN>IND.MAC.308, 19-Apr-82 18:48:16, EDIT BY KEVIN
;<KEVIN>IND.MAC.307, 19-Apr-82 18:39:10, EDIT BY KEVIN
;<KEVIN>IND.MAC.306, 19-Apr-82 18:32:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.305, 19-Apr-82 18:28:47, EDIT BY KEVIN
;	Start work on using COMND for parsing command lines
;	Use .ASK first.
;<KEVIN>IND.MAC.304, 19-Apr-82 17:58:25, EDIT BY KEVIN
;	Rescanned lines are terminated by lf
;<KEVIN>IND.MAC.303, 19-Apr-82 17:50:17, EDIT BY KEVIN
;	Make impure size printout in decimal ; improve parameter parsing
;	when parameter is terminated by cr.
;<KEVIN>IND.MAC.302, 19-Apr-82 17:45:21, EDIT BY KEVIN
;	Parameter count trashed for null parameters
;<KEVIN>IND.MAC.301, 19-Apr-82 17:28:38, EDIT BY KEVIN
;	More work on parameters from command lines
;<KEVIN>IND.MAC.300, 19-Apr-82 16:57:52, EDIT BY KEVIN
;	Do same for warning messages
;<KEVIN>IND.MAC.299, 19-Apr-82 16:54:20, EDIT BY KEVIN
;	Some errors need cr/lf terminators
;<KEVIN>IND.MAC.298, 19-Apr-82 16:48:49, EDIT BY KEVIN
;	Add TSTCOL routine
;<KEVIN>IND.MAC.297, 19-Apr-82 16:45:55, EDIT BY KEVIN
;	Attempt to institute more standardised error message handling
;<KEVIN>IND.MAC.296, 19-Apr-82 15:11:46, EDIT BY KEVIN
;	Namelist parsing for declarations incorrect
;<KEVIN>IND.MAC.295, 19-Apr-82 15:06:30, EDIT BY KEVIN
;<KEVIN>IND.MAC.294, 19-Apr-82 14:32:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.293, 19-Apr-82 14:30:56, EDIT BY KEVIN
;	Implement declaration statements (.NUMERIC, .STRING, .FILE, .LOGICAL)
;<KEVIN>IND.MAC.292, 19-Apr-82 13:51:03, EDIT BY KEVIN
;<KEVIN>IND.MAC.291, 19-Apr-82 13:40:29, EDIT BY KEVIN
;	Let .IFT and .IFF operate on permanent system symbols too.
;<KEVIN>IND.MAC.290, 19-Apr-82 13:24:58, EDIT BY KEVIN
;	Implement end-of-file check on read. Symbol <EOF>
;<KEVIN>IND.MAC.289, 19-Apr-82 13:02:07, EDIT BY KEVIN
;	Confusion between byte and string storage sizes
;<KEVIN>IND.MAC.288, 19-Apr-82 12:00:03, EDIT BY KEVIN
;<KEVIN>IND.MAC.287, 19-Apr-82 11:58:20, EDIT BY KEVIN
;	Add .READ directive
;<KEVIN>IND.MAC.286, 19-Apr-82 11:28:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.285, 19-Apr-82 10:39:01, EDIT BY KEVIN
;	Add .OPENI directive
;<KEVIN>IND.MAC.284, 16-Apr-82 17:35:59, EDIT BY KEVIN
;<KEVIN>IND.MAC.283, 16-Apr-82 17:32:24, EDIT BY KEVIN
;	Announce size of impure store on assembly
;<KEVIN>IND.MAC.282, 16-Apr-82 17:26:41, EDIT BY KEVIN
;	Add .ENABLE LOGOUT
;<KEVIN>IND.MAC.281, 16-Apr-82 15:35:55, EDIT BY KEVIN
;	Increase buffer space for .ASK
;<KEVIN>IND.MAC.280, 16-Apr-82 14:28:58, EDIT BY KEVIN
;<KEVIN>IND.MAC.279, 16-Apr-82 14:21:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.278, 16-Apr-82 14:15:32, EDIT BY KEVIN
;<KEVIN>IND.MAC.277, 16-Apr-82 14:06:18, EDIT BY KEVIN
;	Add default version number to .ASKF
;<KEVIN>IND.MAC.276,  2-Apr-82 13:14:22, EDIT BY KEVIN
;<KEVIN>IND.MAC.275,  2-Apr-82 13:03:55, EDIT BY KEVIN
;	Spurious extra crs (not cr/lf combos) on commands were making sub-
;	commands impossible
;<KEVIN>IND.MAC.274,  3-Mar-82 13:04:04, EDIT BY KEVIN
;	Routine to print error from EXEC command was not using immediate fork
;	handle.
;<KEVIN>IND.MAC.273, 18-Feb-82 10:03:02, EDIT BY KEVIN
;	.OPENA was always getting a JFN on a new file
;<KEVIN>IND.MAC.272, 15-Feb-82 14:03:10, EDIT BY KEVIN
;<KEVIN>IND.MAC.271, 15-Feb-82 13:54:46, EDIT BY KEVIN
;<KEVIN>IND.MAC.270, 15-Feb-82 13:44:26, EDIT BY KEVIN
;	Acs trashed in TSBRK
;<KEVIN>IND.MAC.269, 15-Feb-82 11:02:39, EDIT BY KEVIN
;<KEVIN>IND.MAC.268, 15-Feb-82 10:38:21, EDIT BY KEVIN
;	Add parameter-picking from command line, using P1,P2, etc.
;<KEVIN>IND.MAC.267, 11-Feb-82 10:17:11, EDIT BY KEVIN
;	Clear typeahead on command errors.
;<KEVIN>IND.MAC.266,  8-Feb-82 10:22:08, EDIT BY KEVIN
;<KEVIN>IND.MAC.265,  8-Feb-82 10:17:29, EDIT BY KEVIN
;	Make end-of-command file close the logfile, and release the PTY.
;	Also add .CLOSELOG command to close the logfile.
;<KEVIN>IND.MAC.264,  8-Feb-82 09:57:23, EDIT BY KEVIN
;<KEVIN>IND.MAC.263,  8-Feb-82 09:54:05, EDIT BY KEVIN
;	Was not constructing PTY => TTY number correctly.
;<KEVIN>IND.MAC.262,  8-Feb-82 09:35:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.261,  8-Feb-82 09:31:23, EDIT BY KEVIN
;<KEVIN>IND.MAC.260,  8-Feb-82 09:18:20, EDIT BY KEVIN
;	GETPTY was skipping over TTYs assigned to SYSJOB, but was then grabbing
;	PTYs from PTYCON. Must use more extensive checks to decide whether 
;	device is free.
;<KEVIN>IND.MAC.259,  5-Feb-82 18:13:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.258,  5-Feb-82 17:56:49, EDIT BY KEVIN
;<KEVIN>IND.MAC.257,  5-Feb-82 17:41:48, EDIT BY KEVIN
;	However, TLINK still needs the TTY number !!!
;<KEVIN>IND.MAC.256,  5-Feb-82 17:24:49, EDIT BY KEVIN
;	PTYs must be referred to as PTYn: not TTY(105+n):
;<KEVIN>IND.MAC.255,  5-Feb-82 16:52:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.254,  5-Feb-82 16:14:41, EDIT BY KEVIN
;<KEVIN>IND.MAC.253,  5-Feb-82 15:35:18, EDIT BY KEVIN
;	MTOPR seems to refuse channel 0 as PTY interrupt channel
;<KEVIN>IND.MAC.252,  5-Feb-82 15:18:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.251,  5-Feb-82 14:27:42, EDIT BY KEVIN
;<KEVIN>IND.MAC.250,  5-Feb-82 14:01:24, EDIT BY KEVIN
;	Forgot to supply object designator for TLINK%
;<KEVIN>IND.MAC.249,  5-Feb-82 13:56:57, EDIT BY KEVIN
;	Apparently you can't give a device designator to OPENF%.
;	Thus, .LOGFILE must get a JFN on the PTY.
;<KEVIN>IND.MAC.248,  5-Feb-82 13:35:18, EDIT BY KEVIN
;<KEVIN>IND.MAC.247,  5-Feb-82 13:16:06, EDIT BY KEVIN
;<KEVIN>IND.MAC.246,  5-Feb-82 11:50:47, EDIT BY KEVIN
;	Put warning messages in with user record code
;<KEVIN>IND.MAC.245,  5-Feb-82 11:47:18, EDIT BY KEVIN
;	Start V2 with some code to do roughly the same thing as PHOTO -
;	.LOGFILE command, .ENABLE/.DISABLE LOGGING
;<KEVIN>IND.MAC.244,  3-Feb-82 14:10:29, EDIT BY KEVIN
;<KEVIN>IND.MAC.243,  3-Feb-82 14:02:42, EDIT BY KEVIN
;	Add conditional to record everyone who uses the file in a file in
;	<KEVIN>.
;<KEVIN>IND.MAC.242, 29-Jan-82 16:50:32, EDIT BY KEVIN
;	Add extra forms of relational operators such as <>
;<KEVIN>IND.MAC.241, 15-Jan-82 17:25:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.240, 15-Jan-82 17:15:38, EDIT BY KEVIN
;	Make CRCMD an internal routine so that we can use JSYS trapping on
;	the subsidiary EXEC.
;<KEVIN>IND.MAC.239, 30-Nov-81 15:30:10, EDIT BY KEVIN
;	Tell TESTFILE about invisible and offline files.
;<KEVIN>IND.MAC.238, 26-Nov-81 11:46:05, EDIT BY KEVIN
;<KEVIN>IND.MAC.236, 26-Nov-81 10:35:42, EDIT BY KEVIN
;	Add .OPENA, teach NUMEXP about system symbols
;<KEVIN>IND.MAC.235, 26-Nov-81 10:15:13, EDIT BY KEVIN
;	Teach .IF about system symbols as test variables (.IF <USER> eq "me")
;<KEVIN>IND.MAC.234, 26-Nov-81 10:02:57, EDIT BY KEVIN
;	Didn't document LUKSYS correctly
;<KEVIN>IND.MAC.232, 25-Nov-81 17:07:21, EDIT BY KEVIN
;	Allow system symbols in string expressions
;<KEVIN>IND.MAC.231, 22-Nov-81 14:04:46, EDIT BY KEVIN
;	End-of-file code was forgetting to test file nesting depth
;<KEVIN>IND.MAC.230, 22-Nov-81 13:57:47, EDIT BY KEVIN
;	.CALL was not saving new nesting level
;<KEVIN>IND.MAC.229, 22-Nov-81 13:43:29, EDIT BY KEVIN
;	Forgot to add .CALL to command table
;<KEVIN>IND.MAC.227, 22-Nov-81 13:20:09, EDIT BY KEVIN
;	Label testing was still being attempted in DATA mode - reverse order of
;	tests
;<KEVIN>IND.MAC.226, 22-Nov-81 12:50:02, EDIT BY KEVIN
;	XCREF AC symbols ; add .DISPLAY directive (probably not supported) ; add
;	.DELAY directive ; add .ENABLE/.DISABLE QUIET/EXTENDED-EXEC
;<KEVIN>IND.MAC.225, 19-Nov-81 17:40:10, EDIT BY KEVIN
;	Suppress RELOP symbols from DDT
;<KEVIN>IND.MAC.224, 19-Nov-81 17:27:44, EDIT BY KEVIN
;	Add .CALL directive
;<KEVIN>IND.MAC.223, 19-Nov-81 17:06:00, EDIT BY KEVIN
;	Make ISDGT recognise "-" as part of a number
;<KEVIN>IND.MAC.222, 19-Nov-81 16:45:57, EDIT BY KEVIN
;	Forgot to supply storage for FILERR
;<KEVIN>IND.MAC.221, 19-Nov-81 16:43:21, EDIT BY KEVIN
;	Add .TESTFILE directive, and special symbol <FILESTAT>
;<KEVIN>IND.MAC.220, 19-Nov-81 13:57:48, EDIT BY KEVIN
;	Add .TEST directive, and special symbol <STRLEN>
;<KEVIN>IND.MAC.218, 19-Nov-81 13:33:17, EDIT BY KEVIN
;	Don't use TX type macros when you haven't got an immediate value!
;<KEVIN>IND.MAC.216, 19-Nov-81 13:23:27, EDIT BY KEVIN
;	RFCOC was having acs trashed by TXO
;<KEVIN>IND.MAC.214, 19-Nov-81 13:14:56, EDIT BY KEVIN
;	Add .ENABLE ESCAPE for escape sequences
;<KEVIN>IND.MAC.212, 19-Nov-81 12:01:43, EDIT BY KEVIN
;	Add .INC/.DEC for numeric symbols
;	Make IND bomb out on command parse errors
;<KEVIN>IND.MAC.211, 18-Nov-81 19:34:23, EDIT BY KEVIN
;	Unusual terminator in ENTVAL
;<KEVIN>IND.MAC.209, 18-Nov-81 19:02:15, EDIT BY KEVIN
;	String expression parser failed on null strings
;<KEVIN>IND.MAC.208, 18-Nov-81 18:50:07, EDIT BY KEVIN
;	String expression parser failed on symbols without ranges
;<KEVIN>IND.MAC.207, 18-Nov-81 17:50:04, EDIT BY KEVIN
;	Rework way DATA mode works - set up flag for "pure" command, or
;	one that has been rewritten.
;<KEVIN>IND.MAC.206, 18-Nov-81 17:39:07, EDIT BY KEVIN
;	Source and destination designators wrong way round in WDATA
;<KEVIN>IND.MAC.205, 18-Nov-81 17:27:56, EDIT BY KEVIN
;	Use extend sign ops for GETAB stuff
;<KEVIN>IND.MAC.203, 18-Nov-81 17:23:23, EDIT BY KEVIN
;	Add ENABLE/DISABLE DATA directives
;<KEVIN>IND.MAC.201, 18-Nov-81 16:27:16, EDIT BY KEVIN
;	Processor for system name forgot ERCAL after GETAB
;<KEVIN>IND.MAC.200, 18-Nov-81 16:19:02, EDIT BY KEVIN
;	LUKSYS was not returning symbol type codes correctly
;<KEVIN>IND.MAC.198, 18-Nov-81 15:28:30, EDIT BY KEVIN
;	Must use indexing and inirection with subroutine dispatch in LUKSYS
;<KEVIN>IND.MAC.197, 18-Nov-81 15:23:35, EDIT BY KEVIN
;	Typeo in LUKSYS
;<KEVIN>IND.MAC.196, 18-Nov-81 15:14:18, EDIT BY KEVIN
;	Teach substitution about system symbols
;<KEVIN>IND.MAC.195, 18-Nov-81 14:53:03, EDIT BY KEVIN
;	CRCMD has now sorted out problems with PUSH, so we can now use
;	the PAUSE command
;<KEVIN>IND.MAC.194, 18-Nov-81 10:25:05, EDIT BY KEVIN
;	Correct typeos in system symbol table
;<KEVIN>IND.MAC.191, 18-Nov-81 10:17:42, EDIT BY KEVIN
;	Add support routines for system symbols
;<KEVIN>IND.MAC.190, 18-Nov-81 09:57:37, EDIT BY KEVIN
;	Add system symbol table
;<KEVIN>IND.MAC.188, 17-Nov-81 19:47:39, EDIT BY KEVIN
;	Open brackets improperly handled in numeric parser
;<KEVIN>IND.MAC.187, 17-Nov-81 19:32:14, EDIT BY KEVIN
;	Ranges was not remebering to save its acs
;<KEVIN>IND.MAC.185, 17-Nov-81 18:00:49, EDIT BY KEVIN
;	Move definition of storage, etc. to separate file (indsym.unv).
;	This allows IND to be generated by itself!
;<KEVIN>IND.MAC.183, 17-Nov-81 17:42:33, EDIT BY KEVIN
;	STREXP was not handling multiple quoted strings correctly
;<KEVIN>IND.MAC.181, 17-Nov-81 17:32:45, EDIT BY KEVIN
;	Testing wrong ac after STCMP
;<KEVIN>IND.MAC.179, 17-Nov-81 16:55:32, EDIT BY KEVIN
;	problems with macro used to generate RELOP table
;<KEVIN>IND.MAC.176, 17-Nov-81 16:22:48, EDIT BY KEVIN
;	Make garbage collector keep statistics on usage
;<KEVIN>IND.MAC.173, 17-Nov-81 15:26:45, EDIT BY KEVIN
;	Macro doesn't like ~ signs
;<KEVIN>IND.MAC.172, 17-Nov-81 15:06:09, EDIT BY KEVIN
;	Add .IF directive, for testing relational operations between strings or
;	numbers.
;<KEVIN>IND.MAC.171, 16-Nov-81 17:45:07, EDIT BY KEVIN
;	Stop .ASKS raising terminal input, add .STOP directive
;<KEVIN>IND.MAC.170, 16-Nov-81 17:35:10, EDIT BY KEVIN
;	.RETURN was not decrementing nesting level
;<KEVIN>IND.MAC.168, 16-Nov-81 17:11:05, EDIT BY KEVIN
;	Forward labels not being processed correctly
;<KEVIN>IND.MAC.166, 16-Nov-81 16:40:14, EDIT BY KEVIN
;	Bug in label processing
;<KEVIN>IND.MAC.164, 16-Nov-81 16:18:33, EDIT BY KEVIN
;	Implement .ASKS
;<KEVIN>IND.MAC.163, 16-Nov-81 15:21:17, EDIT BY KEVIN
;	Add IND comments (.; command). Add .GOSUB, .RETURN
;<KEVIN>IND.MAC.162, 16-Nov-81 14:37:49, EDIT BY KEVIN
;	Keyword table out of order
;<KEVIN>IND.MAC.159, 16-Nov-81 14:14:43, EDIT BY KEVIN
;	Implement .ASKF, improve .ASK
;<KEVIN>IND.MAC.158, 16-Nov-81 13:27:38, EDIT BY KEVIN
;	Wrong acs in .DATA command
;<KEVIN>IND.MAC.157, 16-Nov-81 13:18:48, EDIT BY KEVIN
;	STATUS was not displaying negative numbers correctly
;<KEVIN>IND.MAC.156, 16-Nov-81 11:48:23, EDIT BY KEVIN
;	Add .SETFI (set file symbol)
;<KEVIN>IND.MAC.154, 16-Nov-81 11:36:24, EDIT BY KEVIN
;	Add ENTFIL LUKFIL
;	Make substitution recognise file symbols. Fix bug in luknum - was
;	not returning negative values with full sign (use HRRE not HRRZ)
;<KEVIN>IND.MAC.153, 16-Nov-81 10:14:49, EDIT BY KEVIN
;	Add garbage collector for string storage, add .OPEN, .CLOSE, .DATA
;	improve entering routines for symbol tables to check for existence of
;	symbol (like ENTSTR does.)
;<KEVIN>IND.MAC.152, 13-Nov-81 18:25:39, EDIT BY KEVIN
;	LUKNUM was not returning table positions
;<KEVIN>IND.MAC.151, 13-Nov-81 18:18:47, EDIT BY KEVIN
;	Logic of below edit was inversed from desired action
;<KEVIN>IND.MAC.147, 13-Nov-81 18:05:06, EDIT BY KEVIN
;	Modify ENTLAB to ignore request if label is already in table
;<KEVIN>IND.MAC.146, 13-Nov-81 17:56:15, EDIT BY KEVIN
;<KEVIN>IND.MAC.143, 13-Nov-81 16:45:41, EDIT BY KEVIN
;<KEVIN>IND.MAC.142, 13-Nov-81 14:27:30, EDIT BY KEVIN
;<KEVIN>IND.MAC.140, 12-Nov-81 11:07:11, EDIT BY KEVIN
;<KEVIN>IND.MAC.137, 11-Nov-81 16:24:45, EDIT BY KEVIN
;	Start on .GOTO logica - command is not added yet, but we must put
;	checks into the parser for adding labels to the table, and checks to
;	ensure no commands are executed while a target is being searched for.
;<KEVIN>IND.MAC.132, 11-Nov-81 13:21:47, EDIT BY KEVIN
;	Add file symbol table, planned for inclusion from start. Stores JFNS
;	for later use. Improve ENTSTR so that it copes whether or not the symbol
;	is defined. This will be the only ENTER-type routine which does this,
;	and is useful 'cos strings are so difficult.
;<KEVIN>IND.MAC.129, 11-Nov-81 11:31:11, EDIT BY KEVIN
;<KEVIN>IND.MAC.128, 10-Nov-81 19:51:24, EDIT BY KEVIN
;	Beef up STATUS command to print out all symbols and values
;<KEVIN>IND.MAC.117, 10-Nov-81 19:05:49, EDIT BY KEVIN
;	Make ASKx directives use ranges.
;<KEVIN>IND.MAC.113, 10-Nov-81 18:35:49, EDIT BY KEVIN
;	Fix problem with range parsing
;<KEVIN>IND.MAC.108, 10-Nov-81 17:35:38, EDIT BY KEVIN
;	String parser
;<KEVIN>IND.MAC.107, 10-Nov-81 16:48:40, EDIT BY KEVIN
;	Remove .PAUSE command due to bug in $CRCMD
;<KEVIN>IND.MAC.105, 10-Nov-81 11:27:15, EDIT BY KEVIN
;<KEVIN>IND.MAC.102, 10-Nov-81 10:34:27, EDIT BY KEVIN
;	Add .PAUSE command, to PUSH to lower EXEC
;<KEVIN>IND.MAC.99, 10-Nov-81 10:00:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.95, 10-Nov-81 09:22:58, EDIT BY KEVIN
;<KEVIN>IND.MAC.92,  9-Nov-81 16:51:07, EDIT BY KEVIN
;<KEVIN>IND.MAC.91,  9-Nov-81 15:00:15, EDIT BY KEVIN
;	Bung in the work I did this weekend - notably the string and numeric
;	expression parsers, in all their glory (or lack of it.) Also resolve
;	problem whereby use of GETWRD was inconsistent, meaning that it could
;	not backspace its byte pointer. Make GETWRD allow $, < and > as valid
;	characters in a symbol.
;	Add range parsing routine, for use in string expressions and .ASKx
;	directives. Uses NUMEXP to parse general numeric expressions for the
;	ranges.
;<KEVIN>IND.MAC.85,  7-Nov-81 18:19:15, EDIT BY KEVIN
;	Add .IFDF/.IFNDF - if symbol defined or not defined
;<KEVIN>IND.MAC.82,  7-Nov-81 17:37:27, EDIT BY KEVIN
;	Add .ASKN - ask for numeric symbol
;<KEVIN>IND.MAC.79,  7-Nov-81 17:16:34, EDIT BY KEVIN
;	Add first few .ENABLE/.DISABLE commands
;<KEVIN>IND.MAC.78,  7-Nov-81 16:56:18, EDIT BY KEVIN
;	Make substitution use numeric symbols as well
;<KEVIN>IND.MAC.74,  7-Nov-81 16:13:15, EDIT BY KEVIN
;	Add .SETN
;<KEVIN>IND.MAC.72,  7-Nov-81 16:01:36, EDIT BY KEVIN
;	ENTSTR was not counting string lengths properly
;	Problem was implicit byte pointers where real ones were required
;<KEVIN>IND.MAC.71,  7-Nov-81 15:54:07, EDIT BY KEVIN
;	Substitution was losing cr/lf from end of line
;<KEVIN>IND.MAC.70,  7-Nov-81 15:44:58, EDIT BY KEVIN
;	LUKSTR was not returning correct byte pointers
;<KEVIN>IND.MAC.68,  7-Nov-81 15:23:01, EDIT BY KEVIN
;<KEVIN>IND.MAC.64,  7-Nov-81 14:58:55, EDIT BY KEVIN
;	Add seperate reenter - REENTER performs no rescan
;<KEVIN>IND.MAC.61,  6-Nov-81 17:32:37, EDIT BY KEVIN
;	Add substitution routines
;<KEVIN>IND.MAC.58,  6-Nov-81 16:32:10, EDIT BY KEVIN
;	Add .STATUS command to print symbol table usage, etc.
;<KEVIN>IND.MAC.56,  6-Nov-81 16:08:44, EDIT BY KEVIN
;<KEVIN>IND.MAC.55,  6-Nov-81 15:43:44, EDIT BY KEVIN
;	Add the .SETS command, in preparation for text substitution
;<KEVIN>IND.MAC.53,  6-Nov-81 15:14:44, EDIT BY KEVIN
;	Modify GETWRD to return on no-alphabetic, and reset byte pointer.
;	Also write ENTSTR - to enter a string symbol.
;<KEVIN>IND.MAC.51,  6-Nov-81 14:59:09, EDIT BY KEVIN
;	.ASKx routines don't really want all the line terminator guff.
;<KEVIN>IND.MAC.47,  6-Nov-81 14:27:36, EDIT BY KEVIN
;	Add LUKSTR to lookup string symbols so that the .ASKx routines can
;	verify their symbol types.
;<KEVIN>IND.MAC.44,  6-Nov-81 14:15:02, EDIT BY KEVIN
;<KEVIN>IND.MAC.42,  5-Nov-81 17:52:14, EDIT BY KEVIN
;	Add .ASK
;<KEVIN>IND.MAC.37,  5-Nov-81 17:21:31, EDIT BY KEVIN
;	Add beginnings of .IFT, .IFF to test the logical ops
;<KEVIN>IND.MAC.33,  5-Nov-81 16:58:04, EDIT BY KEVIN
;	Add .SETT/.SETF
;<KEVIN>IND.MAC.32,  5-Nov-81 16:11:33, EDIT BY KEVIN
;	But clear out the buffers when we do it
;<KEVIN>IND.MAC.26,  5-Nov-81 14:55:56, EDIT BY KEVIN
;	Add command line rescanning so we can @IND filename
;<KEVIN>IND.MAC.24,  5-Nov-81 14:22:32, EDIT BY KEVIN
;<KEVIN>IND.MAC.21,  5-Nov-81 14:07:37, EDIT BY KEVIN
;<KEVIN>IND.MAC.19,  4-Nov-81 18:03:05, EDIT BY KEVIN
;	Start adding symbol table lookup/insertion/maintenance routines
;<KEVIN>IND.MAC.16,  4-Nov-81 15:03:18, EDIT BY KEVIN
;	Also, REV and similar programs check the private program name and match
;	it against the recsan buffer - must set program name.
;<KEVIN>IND.MAC.14,  4-Nov-81 10:25:22, EDIT BY KEVIN
;	Alter way in which .RUN command works to load the rescan buffer properly
;	Apparently, if you say RUN SYS:REV.EXE *.rel, the rescan buffer must 
;	only contain REV *.rel .
;<KEVIN>IND.MAC.10,  3-Nov-81 16:40:08, EDIT BY KEVIN
;	Add .RUN command
;<KEVIN>IND.MAC.4,  3-Nov-81 13:56:20, EDIT BY KEVIN
;<KEVIN>IND.MAC.3,  3-Nov-81 13:52:09, EDIT BY KEVIN
;<KEVIN>IND.MAC.2,  3-Nov-81 13:48:47, EDIT BY KEVIN
;<KEVIN>IND.MAC.1,  3-Nov-81 12:02:26, EDIT BY KEVIN
	title	IND - performs similar function to RSX IND
	subttl	Edit history

	comment	@

			Kevin Ashley April 1982
			=======================

     The copyright in the computer program described in this  document  and
in the associated user instructions is the property of Kevin Ashley.

     The information in this document is subject to change  without  notice
and  should  not be construed as a commitment. Mr. Ashley  assumes no 
responsibility for any errors which may appear in this document.

     The software described in this document is supplied  under  a  licence
and  may  only  used  or copied in accordance with the conditions of such a
licence.  The licence conditions state that this software shall be supplied
free  of  charge and shall not be sold or otherwise disposed of by means of
trade or ortherwisw for any form of profit or advantage.  Possesion or  use
of  the  software  shall  be  deemed as acceptance of the conditions of the
licence.

     No guarantee is given or may be implied as  to  the  adequacy  of  the
program  or  its suitability for any particular purpose and no liability is
accepted for any loss or damage arising out of its use.

	@
	subttl	Definitions and impure storage
;
;	This program reads command files of a similar format to those
;	used under RSX, which allow question/answer stuff to go on, and also
;	symbol substitution and all that good stuff. Running programs via the
;	EXEC may present problems, so we may need to use a .RUN directive
;	rather than the EXEC RUN. We'll see....
;	This program provides almost all the capabilities of RSX/RT-11 IND
;	in as compatible a manner as possible, and also includes a few
;	extensions. See HLP:IND.DOC for details. Build this program using
;	INDGEN.CMD to customize it for a particular site.
;
	search	vtmac,indsym
	regdef
	.request	k:inderr,k:getddt	;request subroutine libraries
	external	errmes,error,getddt	;for these routines
	internal	tstcol			;used by error routines

	.XCREF T1,T2,T3,T4		;don't cross-reference ac symbols
	cexit.==:12345


IF2,<PRINTX *		Commencing pass 2>

	p$ush==8		;PUSH bit for CRCMD
	lf==12			;linefeed
	true==0			;logical truth
	false==^-0		;falsity (not 0)
	esc==33			;escape
	ctrlz==^d26		;control z
	cr==15			;carriage return
	quote==42		; " character
	addop==1		;for numeric parser
	subop==2		; :		:
	mulop==3		; :		:
	divop==4		; :		:
	$numer==1b0		;flag bits for TXTMSK
	$alpha==1b1		; ""	""
	$Nalpha==1b2		;""    ""
	ptychn==2		;channel for PTY interrupts
	frkchn==0		;inferior fork interrupts
	abochn==3		;channel for aborting IND
	ptysiz==^d100		;size of PTY output buffer
	mswrd==<mslen/5>+1	;maximum string length in words
	NCHPW==5		;NUMBER OF ASCII CHARACTERS PER WORD
	BUFSIZ==200		;SIZE OF INPUT TEXT BUFFER
 IFG	<MSWRD> <BUFSIZ>, <BUFSIZ==MSWRD>
	ATMSIZ==BUFSIZ		;SIZE OF ATOM BUFFER FOR COMND JSYS
	GJFSIZ==.GJRTY+2	;SIZE OF GTJFN BLOCK USED BY COMND JSYS
	FDBSIZ==.CMDEF+2	;SIZE OF FUNCTION DESCRIPTOR BLOCK
;
;	Flag bits in flag ac
;
	f==0			;Flag ac number
	quietf==1b0		;If 1, ENABLE QUIET
	loging==1b1		;If 1, ENABLE LOGGING
	logout==1b2		;If 1 , ENABLE LOGOUT
	m$exec==1b3		;If 1, MEXEC
;
;	Bit definitions for relational operators - if a bit is set, then that
;	condition means success for that operator. IE if the operator is le,
;	then equals or less than both mean success.
;
	$eq==1			;equals condition
	$lt==2			;less than
	$gt==4			;greater than
	eq==$eq			;only equals for equals
	ne==$lt+$gt		;ne means less than or greater than
	ge==$gt+$eq
	gt==$gt
	lt==$lt
	le==$lt+$eq

;	NOTE there must be no type code 0 - this is used to indicate an
;	empty slot in the symbol table
;	See SUBSTI if you want to add extra types

	$num==1			;symbol type codes
	$str==2			;string symbol
	$fil==3			;file symbol
	$lgc==4			;logical
	$lab==5			;label
	$flt==6			;floating point
	$sys==6			;system
	$wrt==1b18		;read/write flag for system symbol

$$impst:			;start of impure section
calstk:	block	mxcal		;IND .CALL stack

substk:	block	mxcnst		;subroutine stack

numstK:	block	numsl		;numeric parse stack

stack:	block	slen

	scrlen==^d30			;30 words for scratch strings
scratch:	block	scrlen

;
;	Storage for CRCMD
;
efork:	0			;fork handle if f$REEZ is set
waspsh:	0			;says we were pushed last time, so
					;we must use SFORK
sysnm:	0			;our SIXBIT name
infnam:	sixbit /EXEC/		;name of inferior fork
;
;	End of CRCMD storage
;
pc1:	0
pc2:	0
pc3:	0			;storage for PC on interrupts
relop:	0		;operator in .IF statement
ifval:	0		;value of symbol in .IF directive
iftyp:	0			;type of symbol :		:
comjfn:	0			;jfn of command file
logjfn:	0			;JFN of logging file or 0 if no log yet
ptydes:	0			;device designator of logging PTY
ttydes:	0		;device designator for PTY as TTY
ptyjfn:	0		;JFN of above PTY
ttyjfn:	0		;jfn of TTY at end of PTY
linlen:	0		;length of line read by GETLIN
purcmd:	0		;-1 if this command is a rewrite from .IF
gonst:	0		;subroutine nesting depth
calnst:	0		;command procedure nesting depth
comptr:	0		;pointer to remainder of command string for IND commands
datjfn:	0		;JFN of open data file
inpjfn:	0		;jfn of open input file
prgjfn:	0		;JFN of program mapped by .RUN
runnam:	0		;SIXBIT program name
prgnam:	0			;SIXBIT name of inferior
lgcflg:	0		;value of next logical symbol to be entered
escflg:	0		;-1 if escape was used to answer question
defflg:	0			;-1 if last question was defualted
extflg:	$ctrlz			;-1 if ctrl/z exits are prohibited
sbtflg:	$$subst		;-1 if substitution is not allowed
dspflg:	$disp		;if non-zero, display IND commands
ind11:	0		;-1 if leading blanks not permitted before directives
datflg:	0		;-1 if ENABLE DATA in process
datsav:	0		;copy of above, behind by one line
sqzd:	0		;non zero if garbage collector has been called 
nsqzd:	0		;number of tiems garbage collector has been called
exsrch:	0		;number of exhaustive searches made for a free name slot
ifdtyp:	0		;flags .IFDF/.IFNDF
fnd:	0		;flags if symbol found for above
edtyp:	0		;-1 when .DISABLing, 0 if .ENABLing
nval:	0		;second operand of numexp
numptr:	0		;stored pointer parsing expressions
numnst:	0		;nesting level of numeric expression
cnval:	0		;holds current value of expression when parsing
cnop:	0			; "	"	operator 	"	"
fltint:	0		;indicates floating or integer expression is parsing
radix:	^d10		;current radix
cbyt:	0		;starting byte number of current line
going:	0		;non-zero if searching for a label
strlen:	0		;length of string from .ASKS or .TEST directive
filerr:	0		;status of last .TESTFILE directive
lukoff:	0		;symbol table offset of last symbo looked up
nargs:	0			;number of parameters parsed
pname:	0			;name of current parameter
txtmsk:	0		;bit mask for string characteristics from .TEST
subdlm:	$subdl		;character to use as delimiter in substitution
			 ;( usually "'")
abortf:	0		;-1 if aborts disabled
ptybuf:	block	ptysiz/5	;storage for text from PTY
target:	block	3		;name of target label in search
vals:	block	3		;values returned when parsing ranges
asksym:	block	3		;space for ASKx symbol
subsym:	block	^d10	;space for substitution symbol
setsym:	block	5	;space for SET symbol
ifsym:	block	3		;space for .IF symbol

cgjargs:	gj%old		;old files for command input
	.nulio,,.nulio		;read from rescan buffer
	0
	0
	0
	deftyp
	0
	0
	0

gjargs:	gj%old		;old files
	.nulio,,.nulio		;inout, output jfns
	0			;default device
	0			;default directory
	0			;defualt name
	-1,,[asciz/exe/]	;default type
	0			;protections
	0			;account
	0			;JFN

comlin:	block	maxcom
comcop:	block	maxcom
asklin:	block	asklen
sublin:	block	maxcom		;space for substitution of text
wrkstr:	block	maxcom		;space for working out string expressions
sysval:	block	mswrd		;value of system symbols
rdbuf:	block	mswrd+1		;buffer for .READ command
telcmd:	block	maxcom		;space for TELL directive

;
;	Macro to adjust a byte pointer by a variable. Uses CX as scratch
;
	define	adjptr(ptr,bytes),<
	move	cx,bytes	;;number of bytes to bump by
	adjbp	cx,ptr
	movem	cx,ptr>

;
;	macro to backspace byte pointer 1 byte
;
	define	bkptr	(ptr),<
	setom	cx		;backspace 1
	adjbp	cx,ptr
	movem	cx,ptr>

;
;	macros to save and restore temp registers with open pushes
;
	define	savts,<push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4>

	define	rests,<pop	p,t4
	pop	p,t3
	pop	p,t2
	pop	p,t1>
;
;	Macros to print error and warning messages. Use is:
;	FATAL	<MESSAGE>,noret,mcall,nocmd
;
;	Only the first argument need be supplied. It is assumed that you wish
;	the error to be printed, and that the command line should then follow
;	that caused the error, followed by a non-skip return. To override any
;	of these, use noret to inhibit the return, mcall to cause a JSYS error
;	to be printed, nocmd to inhibit printing of the offending command line.
;	stop can be used in place of noret, and causes a jump to haltt to
;	take place.
;	WARN	is similar, except that a retskp will be used instead of ret.
;


	define	FATAL (message,return<>,js<>,pcmd<>),<
	call	tstcol		;;check for new line
	tmsg	<?IND - 'message> ;;print error
   IFDIF <PCMD> <nocmd>,<call	prtcmd>	;;print user's directive
   IFIDN <js> <mcall>,<call	errmes>
   IFB	<return>,<ret>			;;assume return
   IFIDN <return> <stop>,<jrst	haltt>	;;or jump to halt
			>		;end of macro


	define	WARN (message,return<>,js<>,pcmd<>),<
	call	tstcol		;;check for new line
	tmsg	<%IND - 'message> ;;print error
   IFDIF <PCMD> <nocmd>,<call	prtcmd>	;;print user's directive
   IFIDN <js> <mcall>,<call	errmes>
   IFB	<return>,<retskp>			;;assume return
			>		;end of macro
;
;	Macro to confirm a command
;
	define	confirm,<call	endcom>
;
;	macro to define an FDB for Control-z
;
	define	exfdb,<[fldbk. (.cmtok,cm%sdh,<point 7,[byte (7) ^d26]>,<Control-Z to exit>)]>

	define	bmask,<[brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,<>,)]>
;
;	macro to be called after COMND but before CONFIRM to check if ctrl-z
;	was typed.
;
	define	testz,<
	ldb	t4,[331100,,(t3)]	;get function code from FDB
	cain	t4,.cmtok	;was it a token ?
	 call	exit>		;yes, stop now if possible
;
;	Macro to make an implicit byte pointer into hardware format
;
	define makhdw(loc),<
IFN	loc-t1,<exch	t1,loc>	;;swap location with t1
	push	p,t1		;;save original pointer
	hlrz	t1,t1		;;get p,s,i,x fields
	cain	t1,-1		;;implicit ?
	movei	t1,(point 7,)	;;yes, make real
	hrl	t1,(p)		;;get back address portion of pointer
	movss	t1,t1		;;and swap halves back to rightful place
	adjsp	p,-1		;;throw away unneeded original pointer
IFN	loc-t1,<exch	t1,loc>	;;restore ac
	>
;
;	These are IND's symbol tables. The main table is used to hold
;	the names of all variables, together with a pointer to a subsidiary
;	table which holds their type codes and values. The symbol table is
;	a simple TBLUK table. The associated value of each variable is an
;	offset into table SYMVAL, which contains one two word entry for each
;	symbol, the fist word holding a type code for that symbol, and the
;	second a "value", which in the case of logical, numeric and file
;	variables really is a value, but in the case of strings is a pointer
;	into the string pool (which is a sort of value).
;
;	There also follows the command table and special system symbol table.
;

;
;	space for storage of strings
;
nxtbyt:	0			;next byte to be written into strings

strings: block	strspc/5
strcpy:	block	strspc/5	;copy of above for garbage collection

;
;space for text storage of symbol names
;

 symtot=strsiz+numsiz+lgcsiz+labsiz+filsiz+fltsiz ;total number of symbols

free:	symtot			;number of free entries left

nxtsym:	0			;offset to place next symbol name at


;
;	Names of variables are stored here.
;
symtab:block	<symtot>*<maxchr+1>/5	

;
;	This is the table of values and type codes for all symbols
;
SYMVAL:	block	symtot*2		;two words per symbol
nxtval:	0				;offset to place next value

;
;	This supporting table for SYMVAL contains the maximum and currently used
;	number of symbols of each type, offset by symbol type code
;	NOTE that these tables must be updated if:
;	(1) The symbol type codes are changed
;	(2) The number of allowable symbol types is altered.
;	There is one unused entry at the start of each list corresponding
;	to symbol code 0
;
symuse:	block	7
symmax:	0
	numsiz
	strsiz
	filsiz
	lgcsiz
	labsiz
	fltsiz

;
;	This is the TBLUK table for variable names
;
SYMBOLS:	0,,symtot		;current,,maximum number of entries
	block	symtot			;number of entries allowed

;
;	COMND - related storage
;
SAVRET:	BLOCK 1			;RETURN ADDRESS OF CMDINI CALLER
SAVREP:	BLOCK 1			;SAVED STACK POINTER TO RESTORE ON REPARSE
CMDBLK:	BLOCK .CMGJB+5		;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER:	BLOCK BUFSIZ		;INPUT TEXT STORED HERE
ATMBFR:	BLOCK ATMSIZ		;ATOM BUFFER FOR COMND JSYS
GJFBLK:	BLOCK GJFSIZ		;GTJFN BLOCK FOR COMND JSYS
NOIFDB:	BLOCK FDBSIZ		;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
;
;	Field descriptor block for .ASKN
;
numfdb:	fld(.cmnum,cm%fnc)!cm%dpp!exfdb	;decimal number,default
	0			;filled with radix
	0
	0
	bmask
;
;	Field descriptor block for .ASKR
;
fltfdb:	fld(.cmflt,cm%fnc)!cm%dpp!exfdb	;floating point number,default
	0
	0
	0
	bmask
;
;	Field descriptor block for .ASKS (has to have default pointer
;	modified).
;
strfdb:
sfdb1:	fld(.cmfld,cm%fnc)!cm%dpp!cm%hpp!cm%brk!cm%sdh!scfm	;text field
	0
	-1,,[asciz "Text string"]
	0
	[brmsk. (eolb0.,eolb1.,eolb2.,eolb3.,<>)]
scfm:	fldbk. (.cmcfm,cm%sdh)

$$pure:			;start of pure section
	subttl	Pure storage - command tables, etc.

;
;	Display size of impure section
;
	radix 5+5
	define	shows(size,pag),<printx	*	Impure data storage = size words (pag pages)>

if1,	<$$tmp==1
	ife <<$$pure-$$impst>&^o777>,<$$tmp==0>
	shows	\<$$pure-$$impst>,\<<<$$Pure-$$impst>/^d512>+$$tmp>>
	radix 8
;
;	These are the pure tables of commands and permanent symbols
;

	define	key$(comand,imp<noimp>,routine<>),<
	$comsz==$comsz+1
IFIDN	<IMP> <imp>,<
	IFNB	<routine>,<[asciz/comand/],,routine>
	IFB	<routine>,<[asciz/comand/],,.'comand>>
ifidn	<imp> <noimp>,<	[asciz/comand/],,[tmsg	<
%Can't .'comand yet...>
			retskp]>>
	define	syk$(keyword,ktype,routine,%type1),<
	%type1=-1
ifidn	<ktype> <string>,<%type1=$str>
ifidn	<ktype>	<numeric>,<%type1=$num>
ifidn	<ktype>	<logical>,<%type1=$lgc>
ifidn	<ktype> <file>,<%type1=$fil>

ifl	%type1	<printx ?Unrecognised system symbol type:'%type1>

	sysiz$=sysiz$+1
	[asciz/<'keyword'>/],,[%type1,,routine]
	.xcref	%type1
	purge	%type1>


	$comsz==0

comsym:	comsiz,,comsiz		;number of entries in table
	key$	ask,imp		;yes/no routine
	key$	askf,imp		;file question
	key$	askn,imp		;numeric question
	key$	askr,imp		;floating point question
	key$	asks,imp		;string question
	key$	call,imp		;call another file
	key$	close,imp		;close data file
	key$	closei,imp,.closi	;close input file
	key$	code,imp		;get ASCII code of first char of string
	key$	data,imp		;send line to data file
	key$	dayton,imp		;convert date string to number
	key$	ddt,imp			;merge DDT and breakpoint
	key$	dec,imp			;decrement symbol
	key$	delay,imp		;delay for n seconds
	key$	delim,imp		;set delimiter for substitution
$$disab:key$	disable,imp		;disable function
	key$	display,imp		;display string symbol as is (screens)
	key$	enable,imp		;enable function
	key$	endlog,imp		;close logfile release PTY
	key$	exit,imp		;exit (like .STOP but types @ <EOF>)
	key$	file,imp		;declare file symbol
	key$	gosub,imp		;.GOTO with .RETURN
	key$	goto,imp	;goto function
	key$	if,imp			;if sym relop 'expr' command
	key$	ifdf,imp		;if defined....
	key$	iff,imp		;if false....
	key$	ifndf,imp		;if not defined....
	key$	ift,imp		;if true....
	key$	inc,imp			;increment symbol
	key$	logfile,imp		;specify logfile
	key$	logical,imp		;declare logical symbol
	key$	lower,imp		;make lower case
	key$	ntoday,imp		;convert day number to string
	key$	numeric,imp		;numeric declaration
	key$	open,imp		;open data file
	key$	opena,imp		;open data file for append
	key$	openi,imp		;open file for input
	key$	pad,imp			;pad string with blanks
	key$	parse,imp		;parse string into substrings
	key$	pause,imp	;pause (push to subsid EXEC via $CRCMD)
	key$	position,imp,.posit	;Position input file
	key$	purge,imp		;undefine symbols
	key$	radix,imp		;set current radix
	key$	raise,imp		;make upper case
	key$	read,imp		;read from input file
	key$	real,imp		;declare real symbol
	key$	return,imp		;inverse of .GOSUB
	key$	rewind,imp		;rewind input file
	key$	run,imp		;run program (instead of EXEC command)
	key$	setf,imp		;set false
	key$	setfi,imp		;set file
	key$	setn,imp		;set numeric
	key$	setr,imp		;set real
	key$	sets,imp		;set string
	key$	sett,imp		;set true
	key$	status,imp		;type status of symbol tables, etc.
	key$	stop,imp		;STOP processing
	key$	string,imp		;declare string symbol
	Key$	Tell,imp		;Command for lower fork
	key$	test,imp		;test string length
	key$	testfile,imp		;test for file exists
	key$	trim,imp		;trim trailing blanks/tabs from string

	comsiz==$comsz
	purge	$comsz

;
;	table for yes/no
;
ysntab:	2,,2
	[ASCIZ/NO/],,false
	[asciz/YES/],,true

;
;	Keywords for .ENABLE/.DISABLE, and the routines to do it
;
	define	enk$(word,code),<
	[asciz/word/],,code
	ensiz$==ensiz$+1>

	ensiz$==0

edtab:	ensiz,,ensiz		;number of entries in table
	enk$	ABORT,edabo			;turn aborting on/off
	enk$	COMAND-CMD,[ret]
	enk$	CONTROL-Z-EXITS,[move	t1,edtyp
				movem	t1,extflg
				ret]
..data:	enk$	DATA,[move	t1,edtyp	;get type of command
		      setcam	t1,datflg	;setup flag
			ret]
	enk$	ESCAPE,[movei	t1,.priou
			rfcoc%
			movx	t1,1b19		;flag escape o
			movx	t4,2b19		;flag escape allowed
			skipe	edtyp		;enable ?
			exch	t1,t4		;no
			trz	t3,(t1)
			tro	t3,(t4)
			movei	t1,.priou
			sfcoc%
			ret]
	enk$	EXTENDED-EXEC,[skipe	edtyp			;enable ?
			 txza	f,m$exec		;no, zero and skip
			txo	f,m$exec		;yes, set up
			ret]
	enk$	LEADING,[setzm	ind11			;assume enable
			skipe	edtyp			;enable ?
			 setom	ind11			;no, disable leading
			ret]				;back to next command
..log:	enk$	LOGGING,[skipn	logjfn		;got a logfile ?
			 jrst	[warn	<no logfile selected:>]
			move	t1,[txo	f,loging]	;Assume enable loggin
			skipe	edtyp			;was it ?
			 move	t1,[txz	f,loging]	;No
			xct	t1			;Set/clear flag
			ret]
	enk$	LOGOUT,[skipe	edtyp			;enable ?
			 txza	f,logout		;no, zero and skip
			txo	f,logout		;yes, turn flag on
			ret]
	enk$	QUIET,[skipe	edtyp			;enable ?
			txza	t1,quietf		;No, quiet off
			 txo	t1,quietf		;yes, echo off
			ret]				;to caller
	enk$	SUBSTITUTION,[move	t1,edtyp	
			movem	t1,sbtflg	
				ret]		;return
	enk$	TRACE,[	move	t1,edtyp
			setcam	t1,dspflg
			ret]			;trace of IND commands
	ensiz==ensiz$
	purge	ensiz$


;
;	keyword table for .IF directive
;
	define	relk$(relop,val),<
	relsz$==relsz$+1
	[asciz'relop],,val>
	relsz$==0

reltab:	relsz,,relsz			;size of table
	relk$	"<",lt
	relk$	"<=",le
	relk$	"<>",ne
	relk$	"=",eq
	relk$	"=<",le
	relk$	"=>",ge
	relk$	">",gt
	relk$	"><",ne
	relk$	">=",ge
	relk$	"eq",eq			;equals
	relk$	"ge",ge
	relk$	"gt",gt
	relk$	"le",le
	relk$	"lt",lt
	relk$	"ne",ne
	relk$	"~=",ne

	relsz==relsz$
	purge	relsz$
;
;	System symbol table
;
	sysiz$==0

syssym:	sysiz,,sysiz			;size of table
	syk$	ACCOUNT,string,[seto	t1,		;this job
				hrroi	t2,sysval	;where to write string
				gacct%			;do it
				 ercal	error
				ret]
	syk$	ALPHA,logical,[move	t1,txtmsk	;get mask bits
				movx	t2,true		;assume alphabetic
				txnn	t1,$alpha	;test bit
				 movx	t2,false	;not set, so false
				movem	t2,sysval	;leave value behind
				ret]
	syk$	ALPHANUM,logical,[move	t1,txtmsk	;get mask bits
				movx	t2,true		;assume alphanumeric
				txnn	t1,$nalpha	;test bit
				 movx	t2,false	;not set, so false
				movem	t2,sysval	;leave value behind
				ret]
	syk$	BYTEPOS,numeric,[move	t1,inpjfn	;get jfn of input file
				jumpe	t1,[setom sysval ;if not open
					 ret]		;return -1
				rfptr%			;if open, read position
				 ercal error
				movem	t2,sysval	;store answer
				ret]			;and return
	syk$	DATE,string,[movx	t3,ot%ntm
				jrst	date.]
	syk$	DIRECTORY,string,[gjinf% ;get dir number
				hrroi	t1,sysval
				dirst%
				 ercal	error
				ret]
	syk$	DISKUSED,numeric,[seto	t1,		;this directory
				gtdal%			;read allocations
				 ercal	error
				movem	t2,sysval	;store used pages
				ret]
	SYK$	EOF,logical,ineof.	;end of file status on input
	syk$	FILESTAT,numeric,[move	t1,filerr	;result of .TESTFILE
				movem	t1,sysval
				ret]
	syk$	JOB,numeric,[gjinf%		;grab info
			    movem	t3,sysval ;store job number
			    ret]
	syk$	LIQUOTA,numeric,[seto	t1,		;this directory
				gtdal%			;read allocations
				 ercal	error
				movem	t1,sysval	;store logged in quota
				ret]
	syk$	LOQUOTA,numeric,[seto	t1,		;this directory
				gtdal%			;read allocations
				 ercal	error
				movem	t3,sysval	;store logged out quota
				ret]
	syk$	NUMERIC,logical,[move	t1,txtmsk	;get mask bits
				movx	t2,true		;assume numeric
				txnn	t1,$numer	;test bit
				 movx	t2,false	;not set, so false
				movem	t2,sysval	;leave value behind
				ret]
	syk$	STRLEN,numeric,[move	t1,strlen
				movem	t1,sysval
				ret]
	syk$	SYSTEM,string,sysnm.		;name of system
	syk$	TERLEN,numeric,[movei	t1,.priin	;our terminal
				movx	t2,.morll	;read length
				mtopr%			;do it
				 ercal	error
				movem	t3,sysval	;store length
				ret]			;back to caller
	syk$	TERMINAL,numeric,[gjinf%
				skipg	t4		;attached ?
				 setz	t4,		;no
				movem	t4,sysval	;store terminal number
				ret]
	syk$	TERWID,numeric,[movei	t1,.priin	;our terminal
				movx	t2,.morlw	;read width
				mtopr%			;do it
				 ercal	error
				movem	t3,sysval	;store width
				ret]			;back to caller
	syk$	TIME,string,[movx t3,ot%nda
				jrst	date.]
	syk$	USER,string,[gjinf%	;get user number
				movem t1,t2 ;save
				hrroi	t1,sysval ;where to write it
				dirst%		 ;write name
				 ercal	error
				ret]
	sysiz==sysiz$
	purge	sysiz$
;
;	dispatch table for numeric parser
;
optab:	illvec			;illegal operator vector
	nadd			;add
	nsub
	nmul
	ndiv

;
;	List of matching opening and closing brackets
;
brklst:	"}",,"{"
	"]",,"["
	">",,"<"
	")",,"("
	"""",,""""
;
;	GTJFN argument block for TESTFILE
;
tsargs:	gj%old+gj%xtn		;old files,extended arguments
	.nulio,,.nulio		;inout, output jfns
	0			;default device
	0			;default directory
	0			;defualt name
	0			;default type
	0			;protections
	0			;account
	0			;JFN
	g1%iin			;allow invisible files

;
;	Table of symbols to be filled in by testfile with name,type
;	etc. format is:
;	address of format control bits for jfns,,address of field symbol name
;

DEFINE	TSFENT(Bit,Field),<[FLD(.JSAOF,Bit)],,[ASCIZ/<'Field'>/]>

tsnams:	TSFENT	js%dev,FILDEV
	TSFENT	js%dir,FILDIR
	TSFENT	js%nam,FILNAM
	TSFENT	js%typ,FILTYP
	TSFENT	js%gen,FILGEN
	TSFENT	js%pro,FILPRO
	TSFENT	js%act,FILACT
	TSFENT	js%cdr,FILCRE
	TSFENT	js%lrd,FILRED
	0
;
;	Interrupt tables
;
levtab:	pc1
	pc2
	pc3				;address of PC words

chntab:	2,,frkint			;fork interrupts
	0				;PTY input (unused)
	3,,ptyint			;PTY output channel
	1,,aboint			;abort IND interrupt
	repeat	^d32,<0>		;unused channels

entvec:	jrst	start
	jrst	reen
	verno	5,,450,3		;Version number and author code - Kevin
	subttl	Main code
;
;	Program starts here
;
reen:	reset%			;on reenter, don't rescan
	move	p,[iowd slen,stack]	;set the stack
	jrst	start1			;read filename from terminal
	call	tstbat			;check for BATCH attempt
;
;	Normal entry: look at command line with rescan, for
;	IND FILNAM param1 param2 param3....
;	If FILNAM not found, look on SYS: for it

start:	reset%			;clear the world
	move	p,[iowd	slen,stack]	;set the stack
	call	gcom			;try and get command file name
start1:	 jrst	[tmsg	<
Command file name : >
		movx	t1,gj%cfm+gj%sht+gj%old+gj%fns ;olf file, name from terminal
		move	t2,[.priin,,.priou]
		gtjfn%
		 ercal	[call	errmes
			jrst	start1]
		jrst	.+1]		;ok, got it from terminal
	movem	t1,comjfn		;remember command file JFN
IFN <logg>,	<call	record>		;log user
	move	t1,comjfn		;get command file jfn
	movx	t2,fld(7,of%bsz)+of%rd	;open for read with 7-bit bytes
	openf%				;do so
	 ercal	error			;crash
	call	getpty			;Grab a pseudo-terminal for inferior
	 nop
	call	inton			;set up interrupt system
	call	cmdset			;initialize COMND block
fillop:	skipe	datsav			;last line in DATA mode ?
	 call	wdata			;yes, write to file if necessary
	move	t2,datflg		;get new copy of flag
	movem	t2,datsav		;and save it
	call	getlin			;read line, return +1 on eof
	 jrst	eof			;no more to do
	call	substi			;perform substitution
	 jrst	fillop			;failed for some reason
intfil:	setom	purcmd			;prevent copying from happening again
	skipn	ind11			;are we allowing 11-format commands ?
	 call	skpblk			;yes, so skip leading blanks
	ildb	t2,t1			;get first byte using pointer in t1
	cain	t2,"."			;is it a dot ?
	 jrst	[call	parse		;yes, it is an IND command - parse it
		jrst	fillop]		;get next line
	skipe	going			;are we searchig for a target ?
	 jrst	fillop			;yes, and we haven't found it yet
	skipe	datflg			;are we in DATA mode?
	 jrst	fillop			;yes, just loop for more
	cain	t2,";"			;is it a comment ?
	 jrst	[call	coment		;yes, just output and continue
		jrst	fillop]
	move	t1,[point 7,comlin]	;nope, just an ordinary command - do it
	move	t2,linlen		;get linelength
	subi	t2,2			;point before cr/lf
	adjptr	t1,t2			;fiddle the byte pointer
	setz	t2,			;get a null
	idpb	t2,t1			;and put ot over the cr/lf
	move	t1,[point 7,comlin]	;point to command
	setz	t2,
	call	$crcmd			;execute command....
	skipe	t3			;was there an error ?
	 jrst	excerr			;no, an error from the exec - halt
	jrst	fillop			;no error - get next line
	subttl	Parsing of IND commands
;
;	This routine parses the first part of IND commands, and does
;	dispatch processing. A byte pointer is in t1.
;	It also stores label values if they are present in the command line,
;	then rewrites the command and redispatches.
;
parse:	ildb	t2,t1			;get next byte
	cain	t2,";"			;comment start ?
	 ret				;do no more
	bkptr	t1			;backspace
	call	skpblk			;skip over blanks between "." and keywrd
	move	t2,[point 7,scratch]	;point to scratch string store
	call	getwrd			;get ASCIZ word next on line
	movem	t1,comptr		;save command pointer for routines
	skipe	dspflg			;display commands ?
	 jrst	[skipn	going		;jumping ?
		 call	prtcmd			;no
		jrst	.+1]
	movei	t1,comsym		;point to IND commands
	hrroi	t2,scratch		;point to this command
	tbluk%				;perform table lookup
	txnn	t2,tl%exm		;exact match ?
	 jrst	[skipn	datflg		;no, in data mode ?
		 jrst	tstlab		;no, test for a label
		move	t1,[0]		;yes, setup dummy command
		jrst	.+1]		;continue
	skipe	going			;execute commands ?
	 ret				;no, searching for label
	hrrz	t3,(t1)			;yes, get routine address
	skipe	datflg			;in DATA mode ?
	 jrst	[caie	t1,$$disab	;yes, is command DISABLE ?
		 ret			;no, ignore
		jrst	.+1]		;yes, let it work out what to do
	move	t1,comptr		;get command pointer for routine
	call	skpblk			;skip to Command start
	movem	t1,comptr		;resave pointer
	call	(t3)			;dispatch
	 jrst	comfl			;failure to parse rest of command
	ret				;ok, get next line
tstlab:	ildb	t2,comptr	;get next byte of command
	caie	t2,":"			;colon ?
	 jrst	badcom			;no, invalid command
	hrroi	t1,scratch		;point to label name
	move	t2,cbyt			;and byte that starts line
	call	entlab			;enter label in table
	 jrst	comfl			;failed
	move	t1,comptr		;get position again
	call	skpblk			;skip over blanks
	movem	t1,t2
	hrroi	t1,comlin		;now prepare to rewrite command line
	movei	t3,maxcom*5		;without a label on it
	setz	t4,
	sout%
	 ercal	error
	movei	t2,maxcom*5		;what we wanted to write
	sub	t2,t3			;minus what we didn't
	soj	t2,			;minus one for cr/lf problems
	movem	t2,linlen		;is what we did
	skipe	going			;are we trying for a target label ?
	 jrst	tstfnd			;yes, see if we just found it
	pop	p,t1			;throw away return address
	move	t1,[point 7,comlin]
	jrst	intfil			;go for a new parse
;
;	here to check if we just found our target label
;
tstfnd:	hrroi	t1,target		;point to desired target
	call	luklab			;lookup target in label table
	 ret				;not found - continue searching
	setzm	going			;found - turn off GOTO flag
	move	t1,comjfn		;our command file
	sfptr%				;set the pointer for the next read
	 ercal	error
	setzm	target			;clear out GOTO target
	ret				;continue executing commands
badcom:	fatal	<unidentifiable command: >,noret,,nocmd
	jrst	badc1
comfl:	fatal	<failure to parse command: >,noret,,nocmd
badc1:	hrroi	t1,scratch
	psout%
	tmsg	<
[IND - exiting]
>
	jrst	haltt
	
	subttl	The .RUN command
;
;	This rotine processes the .RUN command, replacing the EXEC run
;	cos that doesn't work with CRCMD.
;
.run:	stkvar	<prgfrk>
	call	skpblk			;skip over blanks
	movem	t1,comptr		;point to non-blank
	movem	t1,t2			;place in correct place for GTJFN
	movei	t1,gjargs		;address of file argument block
	gtjfn%				;grab filespec
	 erjmp	[fatal <Cannot find program to run because:>,,mcall] ;bad return
	movem	t1,prgjfn		;save jfn of exe file
	move	t1,t2			;get pointer to rescan string
	call	rsload			;load the rescan buffer
	move	t1,prgjfn		;get jfn of exe file again
	call	mapprg			;map the program
	 jrst	[fatal	<can't RUN program: >,,mcall]	;error from mapper
	movem	t1,prgfrk		;save the handle
	call	dotell			;If there is a TELL buffer, send it now
	move	t1,prgfrk		;Get the fork handle back
	setz	t2,			;start at primary position
	sfrkv%				;get the fork going
	 ercal	error
	move	t1,prgfrk
	wfork%				;wait for fork termination
	kfork%				;kill it off
	move	t1,runnam		;retrive old program name
	setnm%				;reset it
	retskp				;return to the outside world
;
;	routine to load rescan buffer from pointer in t1
;
rsload:	push	p,t1			;save command pointer
	setzm	scratch			;blank out word we're going to use
	setzm	scratch+1		;and the following
	hrroi	t1,scratch		;point to scratch buffer
	move	t2,prgjfn		;JFN of proggy we're about to run
	movx	t3,fld(.jsnof,js%dev)+fld(.jsnof,js%dir)+fld(.jsaof,js%nam)
		+fld(.jsnof,js%typ)+fld(.jsnof,js%gen) ;name only
	jfns%				;write filename to rescan buffer
	 ercal	error			;crash
	push	p,t1			;save pointer
	call	sysnam			;set new program name
	pop	p,t1			;restore pointer
	pop	p,t2			;retrive command pointer
	bkptr	t2			;backspace one byte
	setzb	t3,t4			;termina te on null
	sout%				;write command with exe name
	 ercal	error
	hrroi	t1,scratch		;repoint to rescan buffer
	rscan%				;load rescan buffer
	 ercal	error
	ret				;return
;
;	routine takes string from scratch buffer, and makes it our new
;	program name. Calls ascsix from the string routines. Our old
;	name is saved in runnam, for later restoration. New name is in
;	prgnam.
;
sysnam:	getnm%				;get current name
	movem	t1,runnam		;save it
	move	t1,[point 7,scratch]	;point to ASCII name
	call	ascsix			;SIXBIT returned in t2
	move	t1,t2			;place in correct AC
	setnm%				;set the name
	ret				;return OK
;
;	routine to map file whose JFN is in t1, return handle in t1
;	+1 fail, +2 success
;
mapprg:	stkvar	<prghnd>
	movem	t1,prgjfn		;save jfn
	movx	t1,cr%cap		;same capabilites as us
	cfork%				;grab a fork
	 erjmp	[ret]			;no thanks, you've had enough
	movem	t1,prghnd		;save a handle on a fork
	hrlzs	t1,t1			;put process handle in left half
	hrr	t1,prgjfn		;and a JFN in the right half
	get%				;map file to process
	 erjmp	[ret]
	move	t1,prghnd		;return handle for use by caller
	retskp				;return success
;
;	Routine to send the contents of the TELL buffer at our inferior
;	if necessary.
;
dotell:	skipn	telcmd			;Any command ?
	 ret				;no, so do nothing
	move	t3,[point 7,telcmd]	;yes, so point to it
	movei	t1,.priin		;Point to our terminal
dotela:	ildb	t2,t3			;Get a byte
	cain	t2,lf			;Line feed ?
	 jrst	dotele			;yes, we've already given cr
	jumpe	t2,dotele		;if null, done
	sti%				;Else input it
	jrst	dotela			;and loop
dotele:	setzm	telcmd			;blank the buffer
	ret				;done
	subttl	Set logical symbol true or false - .SETT
;
;	.SETT/.SETF routines
;
.sett:	setzm	lgcflg			;true value
	skipa
.setf:	setom	lgcflg			;false value
	move	t1,comptr		;point to command stuff
	move	t2,[point 7,asksym]	;and scratch store
	call	getwrd			;try out symbol
	movem	t1,comptr		;save command pointer
	movei	t1,$lgc			;check symbol is logical
	call	askchk
	 jrst	illtyp			;no, symbol is illegal type
	hrroi	t1,asksym		;ok, either its logical or undefined
	move	t2,lgcflg		;get its value
	call	entlgc			;enter into table
	 ret				;return fail
	retskp				;return success
illtyp:	fatal	<symbol is invalid type for assignment:
>
	subttl	Test logical flag - .IFF/.IFT
;
;	.IFF/.IFT - test logical flag and execute rest of command conditionally
;	We use a second entry point to the command parser just past the point
;	where we read from a file
;
.iff:	setom	lgcflg			;mark what we want
	skipa
.ift:	setzm	lgcflg
	move	t2,[point 7,scratch]
	call	getwrd			;get symbol name
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save for later
	hrroi	t1,scratch		;point to symbol name
	call	luklgc			;try to find symbol
	 jrst	[hrroi	t1,scratch	;failed, try permanent symbol table
		call	luksys		;is it there ?
		 jrst	[fatal	<logical symbol not defined: >];return failure - symbol not known
		caie	t3,$lgc		;its there - is it logical ?
		 jrst	[fatal	<system symbol not type logical: >]	;no
		jrst	.+1]		;all ok
	came	t2,lgcflg		;is symbol what we want ?
	 retskp				;no, don't bother to do owt
	move	t1,comptr		;yes, skip over leadind blanks
	call	skpblk
.ift1:	movem	t1,comptr
	hrroi	t1,comlin		;prepare to rewrite command
	move	t2,comptr
	movei	t3,^d80			;maximum length of line
	setz	t4,			;terminate on null
	sout%
	 ercal	error
	movei	t2,^d80			;what we wanted to write
	sub	t2,t3			;minus what we didn't
	movem	t2,linlen		;is what we did
	pop	p,t1			;throw away our return address
	pop	p,t1			;and PARSES return too
	move	t1,[point 7,comlin]	;point to command
	jrst	intfil			;internal command entry
	subttl	.ASK command - get yes/no answer
;
;	ASK for value of a logical symbol
;
.ask:	stkvar	askval			;value of answer,symbol name(3 words)
	call	iniflgs			;initialize <default>, etc.
	move	t2,[point 7,asksym]	;temporary storage for our symbol
	call	getwrd			;get the symbol
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save command line pointer
	movei	t1,$lgc			;the table we allow
	call	askchk			;check the symbol isn't already there
	 jrst	[fatal	<symbol is not logical: >]	;return
	move	t1,comptr		;point beyond symbol
	call	skpblk			;eat up blanks
	movem	t1,comptr		;comptr now points at start of question
	hrroi	t1,asklin		;point to question buffer
	hrroi	t2,[asciz/* /]		;question prefix
	setzb	t3,t4
	sout%				;write prefix
	 ercal	error
	move	t2,comptr		;now use question text
	movei	t3,^d70			;no  more than 70 chars
	movei	t4,15			;terminate on cr
	sout%				;write question also
	 ercal	error
	bkptr	t1			;back up over cr
	hrroi	t2,[asciz\ [Y/N] \]	;put the question type ID out
	setzb	t3,t4
	sout%
	 ercal	error
.ask2:	hrroi	t1,asklin		;point to prompt
	call	cmdini			;output prompt
	movei	t1,cmdblk		;point to state block
	movei	t2,[fldbk. (.cmkey,,ysntab,,<NO>,bmask,exfdb)]
	comnd%				;parse yes or no
	 ercal	error
	txne	t1,cm%nop		;parse ok ?
	 jrst	yesorno			;no, complain and try again
	testz				;check for control z
	hrre	t2,(t2)			;get yes or no indicator
	movem	t2,askval		;store value
	confirm				;try to confirm
	 jrst	.ask2			;failed
	hrroi	t1,asksym		;point to symbol name
	move	t2,askval		;get value of answer
	call	entlgc			;enter logical value
	 ret				;failed
	retskp				;succeeded
;
;	Complain about answer
;
yesorno:	fatal	<yes or no required
>,noret,,nocmd
	call	clrinp			;clear typeahead
	jrst	.ask2			;ask again
	purge	askval
;
;	Check symbol is not numeric or string or logical - t1 contains valid
;	symbol type, assumes symbol is in ASKSYM.
;	$ entry point assumes pointer to name is in t2.
;	Return +1: Symbol is defined in other table
;		+2: Symbol is in desired table or is not defined
;
askchk:	hrroi	t2,asksym		;where symbol is
$askchk: stkvar	oktab
	movem	t1,oktab		;remember valid table to use
	move	t1,t2			;get pointer in right ac
	call	luksym			;lookup the symbol
	 retskp				;not defined, so definitely kosher
	camn	t3,oktab		;defined - is it the correct type ?
	 retskp				;yes, so return +2
	ret				;no, return failure
	subttl	.SETS - set string symbol
;
;	.SETS - set a string symbol to specified value
;
.sets:	stkvar	<strstt,sexpvl>		;3 words for symbol name
	move	t2,[point 7,asksym]	;place to store symbol name
	call	getwrd			;get symbol name
	movem	t1,comptr		;save position after symbol name
	call	skpblk			;skip over blanks
	call	strexp			;parse string expression
	 ret				;parser failed
	movem	t2,sexpvl		;save pointer to value
	movei	t1,$str			;and valid table for it
	call	askchk			;check it isn't in another table
	 jrst	illtyp			;it is - complain
	hrroi	t1,asksym		;point to symbol name
	move	t2,sexpvl		;and symbol value
	call	entstr			;enter string into table
	 ret				;return -failure
	retskp				;return -success
	subttl	.STATUS command - print symbol table usage
;
;	.STATUS command - print out status of IND tables, and symbol
;	values
;
.status:	tmsg	<
	-----  IND symbol tables and internal flags  -----
>
	tmsg	<
	Exits on control-Z are >
	hrroi	t1,[asciz/not /]
	skipe	extflg			;allowed to exit ?
	 psout%				;no
	tmsg	<allowed.
>
	tmsg	<	Substitution is >
	hrroi	t1,[asciz /not /]
	skipe	sbtflg			;substitution allowed ?
	 psout%				;no
	tmsg	< being performed.
>
	skipn	nsqzd			;garbage collection performed ?
	 jrst	.stat1			;no, print nothing
	tmsg	<	Garbage collection of string pool has been performed >
	movei	t1,.priin		;terminal
	move	t2,nsqzd		;number of times performed
	movx	t3,^d10			;rad10
	nout%				;type number
	 ercal	error
	tmsg	< times.
>
.stat1:	skipn	exsrch			;name table filled once ?
	 jrst	.stat2			;no, print nothing
	tmsg	<	Exhaustive searches for name slots have occurred >
	movei	t1,.priin		;terminal
	move	t2,exsrch		;number of times performed
	movx	t3,^d10			;rad10
	nout%				;type number
	 ercal	error
	tmsg	< times.
>
.stat2:	tmsg	<
>					;nice blank line before tables

	define	prttab(tabnam,tabtyp,tabrtn),<
	xlist
	hrroi	t1,[asciz/
'tabnam':	/]
	psout%
	movei	t1,tabtyp		;;point to symbol table
	call	stuse			;;print usage
	movei	t1,tabtyp		;;now get tables printed out
	movei	t2,tabrtn		;;routine to print values
	call	stprnt			;;print a table out
	list
	>

	tmsg	< Symbol table usage : >

	prttab	Numeric,$num,.stn	;print numeric tables
	prttab	Floating-point,$flt,.str
	prttab	Strings,$str,.sts	;string tables
	prttab	Logicals,$lgc,.stl	;logical tables
	prttab	Files,$fil,.stf
	prttab	Labels,$lab,.stlb

	tmsg	<

	-----  End of status report  -----
>
	retskp				;return success always
;
;	subroutine which takes a table type in t1, and prints out
;	used and total entries.
;
stuse:	movem	t1,t4			;save table type
	move	t2,symuse(t4)		;get currently used number of symbols
	movei	t1,.priou		;type on terminal
	movx	t3,^d10			;in rad 10
	nout%				;type number
	 ercal	error
	tmsg	< entries used from a total of >
	movei	t1,.priou		;on terminal again
	movx	t3,^d10
	move	t2,symmax(t4)		;get total in table
	nout%				;type again
	 ercal	error
	tmsg	< entries available.
	Symbols defined, with values:

>
	ret
;
;	Subroutine takes a symbol type in t1, formatter routine address in t2.
;	It prints out the names of all symbols in the table, and calls the 
;	routine from t2 to print out the symbol value, via a table pointer in 
;	t3.
;
stprnt:	stkvar	<rtn,typcod>
	skipn	symuse(t1)	;any symbols of this type in use ?
	 jrst	stpr2		;no, so say so
	hlrz	q1,symbols	;head of table=number of entries,,max num
	movns	q1,q1		;make negative
	hrlz	q1,q1		;put in left half
	addi	q1,symbols+1	;point to first real entry
	movem	t2,rtn		;save the formatter routine's addres
	movem	t1,typcod	;save symbol type code
stpr1:	hrrz	t3,(q1)		;get offset into symval table
	addi	t3,symval	;construct address of type code for this routine
	move	t4,typcod	;get symbol type code
	came	t4,(t3)		;does this code match what we want ?
	 jrst	stprl		;no, go for next entry
	hlro	t1,(q1)		;yes, construct byte pointer to symbol name
	psout%			;type it
	tmsg	<:	>
	call	(t2)		;dispatch to routine to print out value
	move	t2,rtn		;reget dispatch address
stprl:	aobjn	q1,stpr1	;loop through table
	ret			;return success
stpr2:	tmsg	< No entries currently in use.
>
	ret
	purge	rtn,typcod	;dispose of local variables
;
;	The value printing routines
;
.stn:	move	t2,1(t3)		;get numeric value
	move	t3,radix		;get current radix
	movei	t1,.priou		;on terminal
	nout%
	 ercal	error
	tmsg	<
>
	ret
.str:	move	t2,1(t3)		;get floating value
	setz	t3,			;normal format
	movei	t1,.priou		;on terminal
	flout%
	 ercal	error
	tmsg	<
>
	ret
.stl:	move	t2,1(t3)		;get logical value
	hrroi	t1,[asciz/ False.
/]					;false ?
	skipn	t2
	 hrroi	t1,[asciz/ True.
/]					;nope, true
	psout%
	ret
.sts:	move	t2,1(t3)		;get byte address of string
	move	t1,[point 7,strings]	;point to start of strings
	adjptr	t1,t2			;adjust to point to selected string
	psout%
	tmsg	<
>
	ret
.stf:	move	t2,1(t3)		;get JFN
	movei	t1,.priou		;type on terminal
	setz	t3,			;no fancies
	jfns%				;type filename
	 erjmp	error
	tmsg	<
>
	ret
.stlb:	tmsg	< at byte >
	move	t2,1(t3)		;get byte number
	movx	t3,^d10
	movei	t1,.priou
	nout%
	 ercal	error
	tmsg	<
>
	ret
	subttl	Set numeric symbol
;
;	.SETN command - set a symbol to a numeric value.
;
;	Format:	.SETN	symbol	nnnn
;
.setn:	stkvar	setnvl			;value
	move	t2,[point 7,asksym]	;and scratch store
	call	getwrd			;try out symbol
	call	skpblk			;skip over blanks to value
	movem	t1,comptr		;save command pointer
	movei	t1,$num			;valid table
	call	askchk			;check symbol is numeric
	 jrst	illtyp			;no
	move	t1,comptr		;point to start of expression
	call	numexp			;now parse the numeric expression
	 jrst	setn1			;failed
	hrroi	t1,asksym		;point to this symbol
	call	entnum			;add or replace in numeric table
	 ret				;faile
	retskp				;succeed
setn1:	fatal	<can't understand number: >,,mcall
	purge	setnvl
	subttl	Set floating point symbol
;
;	.SETR command - set a symbol to a real value.
;
;	Format:	.SETR	symbol	floating expression
;
.setr:	stkvar	setnvl			;value
	move	t1,comptr		;point to command stuff
	call	skpblk
	move	t2,[point 7,asksym]	;and scratch store
	call	getwrd			;try out symbol
	call	skpblk			;skip over blanks to value
	movem	t1,comptr		;save command pointer
	movei	t1,$flt			;valid table
	call	askchk			;check symbol is real
	 jrst	illtyp			;no
	move	t1,comptr		;point to start of expression
	call	fltexp			;now parse the real expression
	 jrst	setr1			;failed
	hrroi	t1,asksym		;point to this symbol
	call	entflt			;add or replace in real table
	 ret				;faile
	retskp				;succeed
setr1:	fatal	<can't understand number: >,,mcall
	purge	setnvl
	subttl	.ENABLE and .DISABLE commands to toggle flags
;
;	.ENABLE/.DISABLE commands - same code, same tables, just a
;	flag marks the difference. These commands do things like
;	turning substitution on and off. Format:
;	.ENABLE SUBSTITUTION
;
.disable:	setom	edtyp		;mark enable
	skipa
.enable:	setzm	edtyp
	move	t2,[point 7,scratch]	;point to the scratch buffer
	call	getwrd			;grab the argument to command
	hrroi	t2,scratch		;now point to the word
	movei	t1,edtab		;table of keywords for command
	tbluk%				;try and lookup in the table
	 ercal	error			;crash - table is trashed
	txne	t2,tl%nom		;match found ?
	 jrst	.disa1			;no - bad argument - complain
	txne	t2,tl%amb		;ambiguous ?
	 jrst	.disa2			;yes - complain
	skipe	datflg			;are we in DATA mode ?
	 jrst	[caie	t1,..data	;yes, is it the DATA directive ?
		 retskp			;no, ignore
		skipn	edtyp		;OK, is it DISABLE ?
		 retskp			;no, ignore
		jrst	.+1]		;yes, allow it
	hrrz	t2,(t1)			;OK - get routine to do the work
	call	(t2)			;call it
	retskp				;and return success
;
;	Errors from keywords
;
.disa1:	fatal	<unrecognised .ENABLE/.DISABLE flag:
>
.disa2:	fatal	<ambiguous: >
	subttl	EDABO - enable/disable aborting via CTRL/A
;
;	These routines were a little too long to put in literals,
;	so they are here. They enable/disable the interrupts to abort
;	IND.
;
edabo:	skipge	edtyp			;is it .DISABLE ABORT ?
	 jrst	dabort			;yes, handle that
	skipn	abortf			;no, .ENABLE, is it already done ?
	 ret				;yes, so ignore directive
	move	t1,[aboch,,abochn]	;no, so get character code,,channel
	ati%				;assign code to channel
	 ercal	error
	movx	t1,.fhslf		;point to our fork
	movx	t2,1b<abochn>		;flag the channel number
	aic%				;reactivate the channel
	 ercal	error			;should not fail
	setzm	abortf			;flag aborts enabled
	ret				;return for next directive
dabort:	skipe	abortf			;aborts already disabled ?
	 ret				;yes, so ignore directive
	movx	t1,aboch		;no, so get the terminal code
	dti%				;deactive it
	 ercal	error
	movx	t1,.fhslf		;now point to our process
	movx	t2,1b<abochn>		;and get the channel bit
	dic%				;disable the channel
	 ercal	error			;should not fail
	setom	abortf			;mark aborts disabled
	ret				;and return
	subttl	.ASKN - get numeric answer
;
;	.ASKN - get a numeric answer
;
.askn:	stkvar	<askval,nrng>		;value of answer,number of ranges
	call	iniflgs			;initialize <escape>, etc.
	setzm	nrng			;zero number of ranges
	movem	t1,comptr		;save command position
	call	ranges			;get possible ranges, defualt
	 ret				;bad range format
	movem	t2,nrng			;save number of ranges
	call	skpblk			;skip blanks again
	move	t2,[point 7,asksym]	;temporary storage for our symbol
	call	getwrd			;get the symbol
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save command line pointer
	movei	t1,$num			;this is the one we allow
	call	askchk			;check the symbol isn't already there
	 jrst	[fatal	<symbol is not numeric: >]
	move	t1,comptr		;point beyond symbol
	call	skpblk			;eat up blanks
	movem	t1,comptr		;comptr now points at start of question
	hrroi	t1,asklin		;point to question buffer
	hrroi	t2,[asciz/* /]		;question prefix
	setzb	t3,t4
	sout%				;write prefix
	 ercal	error
	move	t2,comptr		;now use question text
	movei	t3,^d70			;no  more than 70 chars
	movei	t4,15			;terminate on cr
	sout%				;write question also
	 ercal	error
	bkptr	t1			;back up over cr
	hrroi	t2,[asciz\ [#\]	;put the question type ID out
	setzb	t3,t4
	sout%
	 ercal	error
	skipn	nrng			;ranges, defaults ?
	 jrst	.askn4			;no, skip next
	move	t2,nrng			;get number of ranges
	caige	t2,2			;at east 2 ?
	 jrst	.askn4			;no, strange syntax
	movei	t2," "
	idpb	t2,t1
	movei	t2,"R"			;bung out some chars
	idpb	t2,t1
	movei	t2,":"			;it's a waste of time using SOUT for 
	idpb	t2,t1			;this sort of thing - only a few chars
	move	t2,q1			;get lower range
	move	t3,radix		;get current radix
	nout%				;write it out
	 ercal	error
	movei	t2,":"			;separator
	idpb	t2,t1
	move	t3,radix		;get current radix
	move	t2,q2			;upper range
	nout%				;write it out
	 ercal	error
	move	t2,nrng			;get ranges again
	caie	t2,3			;default as well ?
	 jrst	.askn4			;no
	movei	t2," "			;space between
	idpb	t2,t1
	movei	t2,"D"			;default
	idpb	t2,t1
	movei	t2,":"
	idpb	t2,t1
	move	t2,q3			;get defualt val
	move	t3,radix		;get current radix
	nout%				;write out
	 ercal	error
.askn4:	movei	t2,"]"
	idpb	t2,t1
	setz	t2,
	idpb	t2,t1
.askn2:	hrroi	t1,asklin		;bung out CTRL/R buffer
	call	cmdini			;initialize COMND stuff
	hrroi	t1,scratch		;point to scratch buffer
	move	t2,q3			;get possible default value
	move	t3,radix		;get current radix
	move	t4,nrng			;get number of ranges
	cail	t4,3			;was a default supplied ?
	nout%				;yes, write it out
	 ercal	error			;should not fail
	hrroi	t1,scratch		;point at possible default
	setzm	numfdb+.cmdef		;assume no default
	cail	t4,3			;was a default supplied
	movem	t1,numfdb+.cmdef	;yes, store the pointer to default
	move	t1,radix		;get current radix
	movem	t1,numfdb+.cmdat	;store in FDB for COMND
	movei	t1,cmdblk		;point to state block
	movei	t2,numfdb		;and function block
	comnd%				;try to parse a number
	 ercal	error			;crash
	txne	t1,cm%nop		;parsed ok ?
	 jrst	numrqd			;no, complain and retry
	testz				;check for control-z
.askn5:	movem	t2,askval		;remember as value
	confirm				;confirm response
	 jrst	.askn2			;failed confirmation
	move	t2,nrng			;were ranges supplied
	cail	t2,2
	 jrst	.asknr			;yes, check we are in range
.askn6:	hrroi	t1,asksym		;point to symbol
	move	t2,askval		;get value of answer
	call	entnum			;enter into table
	 ret				;faile
	retskp				;succeed
;
;	check answer is in range
;
.asknr:	camge	q2,askval		;top limit greater ?
	 jrst	.askn7			;no
	camle	q1,askval		;bottom limit lower ?
	 jrst	.askn7			;no
	jrst	.askn6			;yes, OK
;
;	Complain about answer
;
numrqd:	fatal	<numeric answer required
>,noret,,nocmd
	call	clrinp			;clear typeahead
	jrst	.askn2			;ask again
	purge	askval,nrng
.askn7:	fatal	<answer not in range
>,noret,,nocmd
	call	clrinp			;clear typeahead
	jrst	.askn2
	subttl	.ASKR - get floating answer
;
;	.ASKR - get floating answer
;
.askr:	stkvar	<askval,nrng>		;value of answer,number of ranges
	call	iniflgs			;initialize <escape>, etc.
	setzm	nrng			;zero number of ranges
	movem	t1,comptr		;save command position
	call	franges			;get possible ranges, defualt
	 ret				;bad range format
	movem	t2,nrng			;save number of ranges
	call	skpblk			;skip blanks again
	move	t2,[point 7,asksym]	;temporary storage for our symbol
	call	getwrd			;get the symbol
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save command line pointer
	movei	t1,$flt			;this is the one we allow
	call	askchk			;check the symbol isn't already there
	 jrst	[fatal	<symbol is not floating: >]
	move	t1,comptr		;point beyond symbol
	call	skpblk			;eat up blanks
	movem	t1,comptr		;comptr now points at start of question
	hrroi	t1,asklin		;point to question buffer
	hrroi	t2,[asciz/* /]		;question prefix
	setzb	t3,t4
	sout%				;write prefix
	 ercal	error
	move	t2,comptr		;now use question text
	movei	t3,^d70			;no  more than 70 chars
	movei	t4,15			;terminate on cr
	sout%				;write question also
	 ercal	error
	bkptr	t1			;back up over cr
	hrroi	t2,[asciz\ [#\]	;put the question type ID out
	setzb	t3,t4
	sout%
	 ercal	error
	skipn	nrng			;ranges, defaults ?
	 jrst	.askr4			;no, skip next
	move	t2,nrng			;get number of ranges
	caige	t2,2			;at east 2 ?
	 jrst	.askr4			;no, strange syntax
	movei	t2," "
	idpb	t2,t1
	movei	t2,"R"			;bung out some chars
	idpb	t2,t1
	movei	t2,":"			;it's a waste of time using SOUT for 
	idpb	t2,t1			;this sort of thing - only a few chars
	move	t2,q1			;get lower range
	setz	t3,			;default format
	flout%				;write it out
	 ercal	error
	movei	t2,":"			;separator
	idpb	t2,t1
	setz	t3,			;usual format
	move	t2,q2			;upper range
	flout%				;write it out
	 ercal	error
	move	t2,nrng			;get ranges again
	caie	t2,3			;default as well ?
	 jrst	.askr4			;no
	movei	t2," "			;space between
	idpb	t2,t1
	movei	t2,"D"			;default
	idpb	t2,t1
	movei	t2,":"
	idpb	t2,t1
	move	t2,q3			;get defualt val
	setz	t3,			;usual format
	flout%				;write out
	 ercal	error
.askr4:	movei	t2,"]"
	idpb	t2,t1
	setz	t2,
	idpb	t2,t1
.askr2:	hrroi	t1,asklin		;bung out CTRL/R buffer
	call	cmdini			;initialize COMND stuff
	hrroi	t1,scratch		;point to scratch buffer
	move	t2,q3			;get possible default value
	setz	t3,			;write in usual format
	move	t4,nrng			;get number of ranges
	cail	t4,3			;was a default supplied ?
	flout%				;yes, write it out
	 ercal	error			;should not fail
	hrroi	t1,scratch		;point at possible default
	setzm	fltfdb+.cmdef		;assume no default
	cail	t4,3			;was a default supplied
	movem	t1,fltfdb+.cmdef	;yes, store the pointer to default
	movei	t1,cmdblk		;point to state block
	movei	t2,fltfdb		;and function block
	comnd%				;try to parse a number
	 ercal	error			;crash
	txne	t1,cm%nop		;parsed ok ?
	 jrst	fltrqd			;no, complain and retry
	testz				;check for control-z
.askr5:	movem	t2,askval		;remember as value
	confirm				;confirm response
	 jrst	.askr2			;failed confirmation
	move	t2,nrng			;were ranges supplied
	cail	t2,2
	 jrst	.askrr			;yes, check we are in range
.askr6:	hrroi	t1,asksym		;point to symbol
	move	t2,askval		;get value of answer
	call	entflt			;enter into table
	 ret				;faile
	retskp				;succeed
;
;	check answer is in range
;
.askrr:	camge	q2,askval		;top limit greater ?
	 jrst	.askr7			;no
	camle	q1,askval		;bottom limit lower ?
	 jrst	.askr7			;no
	jrst	.askr6			;yes, OK
;
;	Complain about answer
;
fltrqd:	fatal	<floating point answer required
>,noret,,nocmd
	call	clrinp			;clear typeahead
	jrst	.askr2			;ask again
	purge	askval,nrng
.askr7:	fatal	<answer not in range
>,noret,,nocmd
	call	clrinp			;clear typeahead
	jrst	.askr2
	subttl	.IFDF/.IFNDF commands
;
;	Conditional execution depending on whether a symbol is defined
;
.ifndf:	setzm	ifdtyp			;flag not defined wanted
	skipa
.ifdf:	setom	ifdtyp			;symbol must be defined
	move	t2,[point 7,asksym]
	call	getwrd			;get symbol name
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save for later
	setom	fnd			;mark found initially
	hrroi	t1,asksym		;point to symbol
	call	luksym			;and see if it exists
	 setzm	fnd			;it doesn't - indicate
	move	t1,fnd			;OK, did we find it ?
	came	t1,ifdtyp		;is the result a success
	 retskp		;no, either found and not wanted or vice versa
	move	t1,comptr		;OK - the IF worked,now do command
	call	skpblk			;skip over blanks
	movem	t1,t2			;point to startof new command
	hrroi	t1,comlin		;yes, prepare to rewrite command
	movei	t3,^d80			;maximum length of line
	setz	t4,			;terminate on null
	sout%
	 ercal	error
	movei	t2,^d80			;what we wanted to write
	sub	t2,t3			;minus what we didn't
	movem	t2,linlen		;is what we did
	pop	p,t1			;throw away our return address
	pop	p,t1			;and PARSES return too
	move	t1,[point 7,comlin]	;point to command
	jrst	intfil			;internal command entry
	subttl	The .PAUSE command
;
;	This command uses the p$USH bit in CRCMD, which just continues the
;	EXEC until we do a POP.
;
.pause:	txzn	f,quietf		;set echo on, and ask if it already was
	 jrst	.pau1			;it was not, so don't print messages
	tmsg	<
[IND - pausing. To continue type "POP"]
>
.pau1:	movx	t2,p$ush	;flag PUSH command
	call	$CRcmd
	skipe	t3			;OK ?
	 call	excerr			;no
	tmsg	<
[IND - continuing]
>
	retskp
	subttl	The GOTO command
;
;	This command is of the form .GOTO lab, where lab will be in
;	the file in the form .lab: . We check if it is already in the symbol
;	table, in which case we can use SFPTR and return, or we must set
;	GOING to true, and set up the label in TARGET, returning to allow
;	a search through the file for the label.
;
.goto:	move	t1,comptr		;point to label name
	move	t2,[point 7,target]	;where to put label
	call	getwrd			;pickup label from command
	movem	t1,comptr		;save pointer
	hrroi	t1,target		;point to label
	call	luklab			;does it exist ?
	 jrst	.goto2			;no, we must search
	move	t1,comjfn		;yes, just reset
	sfptr%				;the file pointer
	 ercal	error
	retskp				;and continue from the label
.goto2:	setom	going			;no, we must set up for a goto search
	retskp				;which inhibits command execution
	subttl	The .OPEN, .OPENA and .CLOSE commands
;
;	These commands are of the form .OPEN filename and .CLOSE . They open a
;	secondary fileto which the output of the .DATA directive, or .ENABLE 
;	DATA is directed. .CLOSE is a no-op if no file is open.
;	.OPENA opens the file for append, not write
;
.opena:	movx	t3,fld(7,of%bsz)+of%app	;open for append
	movx	t1,gj%sht!gj%old	;file must exist
	jrst	.+3
.open:	movx	t3,fld(7,of%bsz)+of%wr	;open for write
	movx	t1,gj%sht!gj%new!gj%fou	;new file
	skipe	datjfn			;file already open ?
	 jrst	[fatal	<File already open:>]		;yes, complain
	move	t2,comptr
	gtjfn%				;attempt to get a handle
	 erjmp	.open1			;failed for some reason
	movem	t1,datjfn		;save the handle
	move	t2,t3			;open for write or append
	openf%
	 erjmp	.open1			;failed for some reason
	retskp				;return success
.open1:	fatal	<can't OPEN file: >,noret,mcall
	setzm	datjfn			;clear in case error was on OPENF
	ret				;return failure

.close:	move	t1,datjfn		;get file handle
	jumpe	t1,rskp			;if no file, return success
	closf%				;close file
	 ercal	errmes			;huh ?
	setzm	datjfn			;indicate we have no file
	retskp				;return success
	subttl	The .DATA command - sends data to secondary file
;
;	This command is of the form .DATA kwjre ekekkjtr wjejjetre
;	Everything from the first non-blank character after the .DATA to the
;	end of line is output to the secondary file, if it exists. If it does 
;	not, an error is generated.
;
.data:	move	t1,datjfn		;get handle on secondary file
	jumpe	t1,[fatal	<no data file open:>] ;nofile open- complain
	move	t2,comptr		;pointer to data for file
	setzb	t3,t4			;write until null seen
	sout%
	 erjmp	[fatal <error writing to data file:>,,mcall]	;we have an error (disk full ?)
	retskp				;return success
	subttl	The .SETFI command - set file symbol
;
;	This command is of the form .SETFI FILS Filename.type
;	It sets up a file symbol
;
.setfi:	move	t2,[point 7,asksym]
	call	getwrd			;get file symbol name
	call	skpblk			;skip over blanks
	movem	t1,comptr
	movei	t1,$fil			;valid table
	call	askchk			;check valid type
	 jrst	illtyp			;no
	move	t2,comptr		;point to filename
	movx	t1,gj%sht		;short call
	gtjfn%				;get a handle
	 erjmp	.sef1			;error
	movem	t1,t2			;save handle
	hrroi	t1,asksym		;point to symbol name
	call	entfil			;enter into table
	 ret				;fail
	retskp				;succeed
.sef1:	fatal	<error in filename:>,,mcall
	subttl	The .ASKF command - ask for file spec (with recognition)
;
;	This command is like the other .ASKx - format is
;	.ASKF [n]  fildef Filename for output ?
; prompt is * Filename for output ? [F] .
;	We use an extended GTJFN for the CTRL/R buffer, and return a JFN for the
;	file symbol table. n is the default generation number, either a straight
;	number or a -1 for a new file, 0 for an old file, or -2 for oldest
;	existing generation.
;
.askf:	stkvar	askval			;value of answer
	call	iniflgs			;initialize <default>, etc.
	call	ranges			;check out range blocks
	 ret				;bad range format
	skipn	t2			;was there any supplied ?
	 setzm	q1			;no, so assume an old file
	movem	q1,q2			;remember generation number
	hrrzs	q1,q1			;make generation number a right half
	txo	q1,gj%msg		;set message flag up
	txz	q1,gj%old		;assume not an old file
	skipn	q2			;but if generation was zero
	txo	q1,gj%old		;we must nudge GTJFN a little bit
	call	skpblk			;skip over blanks after ranges
	move	t2,[point 7,asksym]	;temporary storage for our symbol
	call	getwrd			;get the symbol
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save command line pointer
	movei	t1,$fil			;the table we allow
	call	askchk			;check the symbol isn't already there
	 jrst	[fatal	<symbol is not a file symbol: >]
	move	t1,comptr		;point beyond symbol
	call	skpblk			;eat up blanks
	movem	t1,comptr		;comptr now points at start of question
	hrroi	t1,asklin		;point to question buffer
	hrroi	t2,[asciz/* /]		;question prefix
	setzb	t3,t4
	sout%				;write prefix
	 ercal	error
	move	t2,comptr		;now use question text
	movei	t3,^d70			;no  more than 70 chars
	movei	t4,15			;terminate on cr
	sout%				;write question also
	 ercal	error
	bkptr	t1			;back up over cr
	hrroi	t2,[asciz\ [F]:\]	;put the question type ID out
	setzb	t3,t4
	sout%
	 ercal	error
.askf2:	hrroi	t1,asklin		;bung out CTRL/R buffer
	call	cmdini			;initialize COMND
	call	askfd			;set up defaults for name,type etc.
	movem	q1,gjfblk		;restore arguments to filename block
	movei	t1,cmdblk		;address of state block
	movei	t2,[fldbk. (.cmfil,cm%sdh,,<File specification>,,bmask,exfdb)]
	comnd%				;parse the filespec
	 ercal	error			;crash
	txne	t1,cm%nop		;parsed ok ?
	 jrst	[call	errmes		;no, output error
		call	clrinp		;clear input buffer
		jrst	.askf2]		;try again
	testz				;check for ctrl-z
	movem	t2,askval		;store JFN
	confirm
	 jrst	.askf2
	hrroi	t1,asksym		;point to symbol
	move	t2,askval		;value of answer
	call	entfil			;enter into table
	 ret				;return failure
	retskp				;return success
	purge	askval
	subttl	askfd - set up defaults for .ASKF
;
;	This routine is called to look for the existence of the symbols
;	<defnam>, <deftyp>, <defdir>, <defdev>, and <defacc>.
;	If they exist, the corresponding default fields in the GTJFN block
;	are setup for COMND to use.
;
askfd:	hrroi	t1,[asciz/<defnam>/]	;point to a string
	call	lukstr			;look for it
	 skipa				;not found
	movem	t2,gjfblk+.gjnam	;default found for name, enter it
	hrroi	t1,[asciz/<deftyp>/]	;point to a string
	call	lukstr			;look for it
	 skipa				;not found
	movem	t2,gjfblk+.gjext	;default found for type, enter it
	hrroi	t1,[asciz/<defdir>/]	;point to a string
	call	lukstr			;look for it
	 skipa				;not found
	movem	t2,gjfblk+.gjdir	;default found for directory, enter it
	hrroi	t1,[asciz/<defdev>/]	;point to a string
	call	lukstr			;look for it
	 skipa				;not found
	movem	t2,gjfblk+.gjdev	;default found for device, enter it
	hrroi	t1,[asciz/<defacc>/]	;point to a string
	call	lukstr			;look for it
	 skipa				;not found
	movem	t2,gjfblk+.gjact	;default found for account, enter it
	ret				;back to caller
	
	subttl	.GOSUB, .RETURN commands
;
;	These two commands allow one to have subroutines in IND files.
;	.GOSUB pushes down a call stack, and uses the .GOTO code. .RETURN
;	pops the .GOSUB stack, and resets the byte pointer for input.
;
.gosub:		move	t3,gonst		;check GOSUB nesting depth
	cail	t3,mxcnst-1		;maximum call depth exceeded ?
	 jrst	[fatal	<subroutine nesting depth exceeded:
>,stop] ;yes, crash
	move	t1,comjfn		;command file JFN
	rfptr%				;find start of next line
	 ercal	error
	movem	t2,substk(t3)		;and stack on the subroutine list
	aoj	t3,			;bump the pointer
	movem	t3,gonst		;and store it again
	jrst	.goto			;get .GOTO to do the rest of the work
;
;	.RETURN
;
.return:	skipn	gonst		;are we in a subroutine ?
	 jrst	[fatal	<.RETURN when not in subroutine:>]
	move	t1,gonst		;yes, get the nesting depth
	soj	t1,			;decrement
	movem	t1,gonst		;place back
	move	t2,substk(t1)		;get old file pointer
	move	t1,comjfn		;JFN of command file
	sfptr%				;reset to continue from old place
	 ercal	error
	retskp				;return success
	subttl	.ASKS command - ask for a string
;
;	format : .ASKS [low:high] symnam what is your name?
;
;	low and high are optional range bounds for length
;	If symbol <STRINGDEF> is defined as string, then it's contents are
;	used as the default response.
;
.asks:	stkvar	<askval,nrng>		;value of answer,number of ranges
	call	iniflgs			;initialize <escape>, etc.
	setzm	nrng			;zero number of ranges
	movem	t1,comptr		;save command position
	call	ranges			;get possible ranges, defualt
	 ret				;bad range format
	movem	t2,nrng			;save number of ranges
	call	skpblk			;skip blanks again
	move	t2,[point 7,asksym]	;temporary storage for our symbol
	call	getwrd			;get the symbol
	call	skpblk			;skip over blanks
	movem	t1,comptr		;save command line pointer
	movei	t1,$str			;this is the one we allow
	call	askchk			;check the symbol isn't already there
	 jrst	[fatal	<symbol is not string: >]
	move	t1,comptr		;point beyond symbol
	call	skpblk			;eat up blanks
	movem	t1,comptr		;comptr now points at start of question
	hrroi	t1,asklin		;point to question buffer
	hrroi	t2,[asciz/* /]		;question prefix
	setzb	t3,t4
	sout%				;write prefix
	 ercal	error
	move	t2,comptr		;now use question text
	movei	t3,^d70			;no  more than 70 chars
	movei	t4,15			;terminate on cr
	sout%				;write question also
	 ercal	error
	bkptr	t1			;back up over cr
	hrroi	t2,[asciz\ [S\]	;put the question type ID out
	setzb	t3,t4
	sout%
	 ercal	error
	move	t2,nrng			;get number of ranges
	caie	t2,2			;at east 2 ?
	 jrst	.asks4			;no, strange syntax
	movei	t2," "
	idpb	t2,t1
	movei	t2,"R"			;bung out some chars
	idpb	t2,t1
	movei	t2,":"			;it's a waste of time using SOUT for 
	idpb	t2,t1			;this sort of thing - only a few chars
	move	t2,q1			;get lower range
	movx	t3,^d10
	nout%				;write it out
	 ercal	error
	movei	t2,":"			;separator
	idpb	t2,t1
	movx	t3,^d10
	move	t2,q2			;upper range
	nout%				;write it out
	 ercal	error
.asks4:	movei	t2,"]"
	idpb	t2,t1
	setz	t2,
	idpb	t2,t1
.asks2:	setzm	strfdb+.cmdef		;zero string default pointer
	hrroi	t1,[asciz "<STRDEF>"]	;name of default symbol
	call	lukstr			;do we have a default supplied ?
	 skipa				;no, use standard stuff
	movem	t2,strfdb+.cmdef	;yes, store pointer in FDB
	hrroi	t1,asklin		;bung out CTRL/R buffer
	call	cmdini			;initialize COMND blocks
	movei	t1,cmdblk		;point to state block
	movei	t2,strfdb		;point to function block for field
	comnd%				;do it
	 ercal	error
	txne	t1,cm%nop		;parsed OK ?
	 jrst	[fatal	<Invalid text string>,noret,mcall,nocmd ;no, complain
		jrst	.asks2]
	ldb	t1,[point 7,atmbfr,6]	;get a byte
	cain	t1,^d26			;control-z ?
	 call	exit			;yes, exit if possible
	testz
	cain	t4,.cmcfm		;was it confirm ?
	 jrst	[setzm	atmbfr		;yes, so set string null
		move	t1,[point 7,atmbfr] ;get pointer
		jrst	.asks5]		;and continue
	confirm
	 jrst	 .asks2			;failed confirmation
	move	t1,[point 7,atmbfr]	;point to start of answer
.asks5:	movem	t1,askval		;remember as value
	move	t2,nrng			;were ranges supplied
	cain	t2,2
	 jrst	.asksr			;yes, check we are in range
.asks6:	hrroi	t1,asksym		;point to symbol
	move	t2,askval		;get value of answer
	call	entstr			;enter into table
	 ret				;faile
	move	t1,[point 7,atmbfr]	;point to answer
	call	leng			;get length of it
	movem	t3,strlen		;remember for user
	move	t1,[point 7,atmbfr]	;point to string again
	call	strchs			;set up TXTMSK
	retskp				;succeed
;
;	check answer is in range
;
.asksr:	move	t1,[point 7,atmbfr]	;point to answer string
	call	leng			;get length
	camge	q2,t3			;top limit greater ?
	 jrst	.asks7			;no
	camle	q1,t3			;bottom limit lower ?
	 jrst	.asks7			;no
	jrst	.asks6			;yes, OK
;
;	Complain about answer
;
	purge	askval,nrng
.asks7:	fatal	<string length not in range
>,noret,,nocmd
	call	clrinp			;clear typeahead
	jrst	.asks2
	subttl	The .STOP and .EXIT directives
;
;	.STOP simulates EOF, but does not print the @ <EOF> message. .EXIT
;	is more complex - if the current file has been .CALLed, it does an
;	immediate return to our superior command file, otherwise it simulates
;	EOF with the @ <EOF> message.
;
.stop:	jrst	stopp
.exit:	jrst	eof
	subttl	The .IF command - permits comparison between strings or numbers
;
;	This directive is of the form
;	.IF	symbol	relop	expression   command
;
;	where symbol is either a numeric or a string symbol name, relop is one 
;	of eq(=) ne(~=) gt(>) ge(>=) lt(<) le(=<) and expression is either 
;	string or numeric in type according to symbol. The alternative forms of
;	relops are shown in brackets after their mnemonic names. The command
;	is executed if the comparison returns a true result.
;
.if:	move	t2,[point 7,asksym]	;where to put our symbol name
	call	getwrd			;retrieve the symbol
	call	skpblk			;skip over blanks
	move	t2,[point 7,scratch]	;now get operator
	call	getwrd			;retrieve in ASCIZ
	call	skpblk			;skip over next blanks
	movem	t1,comptr		;and save position of start of exp
	movei	t1,reltab		;table of relational operators
	hrroi	t2,scratch		;one we are considering at the moment
	tbluk%				;determine if in table
	 ercal	error			;crash - tables trashed
	txnn	t2,tl%exm		;exact match ?
	 jrst	.if1			;no, complain - bad relop
	hrrz	t2,(t1)			;OK, get relop ID
	movem	t2,relop		;and remember for when we parse exp
	hrroi	t1,asksym		;now find out if string or numeric
	call	luksym			;try numeric or string first
	 jrst	[hrroi	t1,asksym 	;failed , try system symbol
		call	luksys	  	;lookup
		 jrst	.if2	  	;still nowhere, complain
		movem	t3,iftyp  	;remember symbol type
		movem	t2,ifval  	;and value
		jrst	.if3]	  	;continue
	caie	t3,$num			;found - is it numeric ?
	 jrst	[caie	t3,$str		;or string ?
		 jrst	.if2		;neither, complain
		movem	t2,ifval	;string, so save byte count
		move	t2,[point 7,strings] ;point to string pool
		adjptr	t2,ifval	;construct byte pointer
		jrst	.+1]		;ok, continue
	movem	t3,iftyp		;remember symbol type
	movem	t2,ifval		;numeric succeeded, save value
.if3:	move	t1,iftyp		;get type of symbol
	cain	t1,$num			;numeric ?
	 jrst	.if4			;yes
	move	t1,comptr		;no,must be string - point to exp
	call	strexp			;parse string expression
	 ret				;failed - strexp has complained
	movem	t1,comptr		;save position in command
	move	t1,ifval		;get byte number of symbol value
	stcmp%				;compare two strings
	move	t3,relop		;now get desired operator
	jumpe	t1,.ifse		;strings are equal ?
	txne	t1,sc%lss		;no, is sym less than exp ?
	 jrst	.ifsl			;yes
	txne	t1,sc%gtr		;greater than ?
	 jrst	.ifsg			;yes
	txne	t1,sc%sub		;subset ?
	 jrst	.ifsl			;yes, consider as lt
	fatal	<can't understand string comparison: Internal error>,stop
;
;	Here for numeric comparison
;
.if4:	move	t1,comptr		;point to start of expression
	call	numexp			;evaluate
	 ret				;failed
	movem	t1,comptr		;save command position
	move	t1,ifval		;value of numeric symbol
	camn	t1,t2			;are they equal ?
	 jrst	.ifse			;yes
	caml	t1,t2			;is sym<exp ?
	 jrst	.ifsg			;no, must be greater
	jrst	.ifsl			;yes, dispatch as such
;
;	Test if the comparison is a success
;
.ifsl:	move	t3,relop		;get operator bits
	txnn	t3,$lt			;less than work for this relop ?
	 retskp				;no, do nothing
	jrst	.ifgo			;yes, do second command
.ifse:	move	t3,relop
	txnn	t3,$eq			;equals work ?
	 retskp				;no
	jrst	.ifgo			;yes
.ifsg:	move	t3,relop
	txnn	t3,$gt			;greater than OK ?
	 retskp				;no
	jrst	.ifgo			;yes
;
;	test succeeded - now rewrite command and dispatch for execution
;
.ifgo:	move	t1,comptr
	call	skpblk			;skip to start of command
	jrst	.ift1			;get .IFT code to do the work
;
;	.IF errors
;
.if1:	fatal	<unknown relational operator:>
.if2:	fatal	<symbol is not numeric or string for comparison:
>
	subttl	.IND/.DEC directives - increment/decrement numeric symbol
;
;	These directives are purely to make it easier to add or subtract one
;	from a symbol to do loops. It looks clearer than .SETN symnam symnam+1
;
.dec:	move	t2,[soj	t2,]		;decrement instruction
	skipa
.inc:	move	t2,[aoj	t2,]		;increment instruction
	push	p,t2			;save
	move	t1,comptr		;command pointer
	move	t2,[point 7,asksym]	;storage for symbol name
	call	getwrd			;get name
	hrroi	t1,asksym		;don't use ASKCHK - number MUST alread
	call	luknum			;exist.
	 jrst	.ince			;it doesn't - complain
	hrroi	t1,asksym		;we now have the current value in t2
	pop	p,t3			;so retrieve inc/dec instruction
	xct	t3			;and execute it
	call	entnum			;and re-enter in table
	 ret
	retskp				;return success
.ince:	pop	p,t1		;throw away saved instruction
	fatal	<symbol does not exist for increment/decrement:>
	subttl	The .TEST command - test the length of a string expression
;
;	This command is of the form .TEST strexp, and sets the special
;	symbol <STRLEN> to the length of the string in characters.
;	The string symbol bitmask is also set to reflect the characteristics
;	of the string - alphabetic, numeric, alphanumeric.
;
.test:	move	t1,comptr		;get command pointer
	call	strexp			;parse the string expression
	 ret				;parse failed
	move	t1,t2			;get pointer to string in right ac
	push	p,t1			;save copy of it
	call	leng			;discover length
	movem	t3,strlen		;remember in right place for SYSSYM
	pop	p,t1			;get pointer to string expression back
	call	strchs			;set characteristics mask
	retskp				;return success
;
;	This routine is called with a pointer to a string in t1.
;	It examines the string, setting the TXTMSK mask with bits to indicate
;	whether the string is alphabetic, alphanumeric, or numeric.
;
strchs:	movx	t3,$numer!$alpha!$nalpha ;assume all are true first
strchl:	ildb	t2,t1			;get a char
	jumpe	t2,strch4		;if null, all over
	caige	t2,"0"			;is it a digit ?
	 txz	t3,$numer!$alpha!$nalpha ;no, so clear all flags
	caile	t2,"9"			;still in digit range ?
	 txz	t3,$numer		;no, so cannot be numeric only
	caige	t2,"A"			;is it in character set range ?
	 txz	t3,$alpha		;no, so isn't alphabetic
	caile	t2,"z"			;not beyond end of alphabet range ?
	 txz	t3,$alpha!$numer!$nalpha ;yes, so all untrue
	caig	t2,"Z"			;is it upper case or less ?
	 jrst	strch1			;yes, so no more test
	caige	t2,"a"			;no, so is it lower case ?
	 txz	t3,$alpha!$numer!$nalpha ;no, so clear all flags
strch1:	jrst	strchl			;test next character
strch4:	movem	t3,txtmsk		;save mask bits
	ret				;return to caller
	subttl	The .TESTFILE directive - test for existence of a file
;
;	Format:	.TESTFILE filnam.typ
;
;	Sets symbol FILESTAT to 0: File does not exist
;				1: File exists
;				-1: File exists in deleted state only
;				-2: File exists but is invisible (may be del'd)
;				-3: File is offline
;				-4: Invalid filespec
;
;	Also sets up string symbols <FILNAM>,<FILTYP>,<FILDIR>,<FILDEV>
;	<FILGEN>,<FILACT>,<FILPRO>,<FILCRE>,<FILRED>
;	and numeric symbols <FILPAG>,<FILSIZ>,<FILBSZ>
;	with appropriate fields for the file if it exists in any way.
;
.testfil:	STKVAR	<TSJFN>			;jfn for file to be tested
	move	t2,comptr	;point to filename
	movx	t1,gj%sht+gj%old	;insist on old filename
	gtjfn%				;try for a handle
	 erjmp	.tsf1			;no success - see what happened
	movei	t2,1			;indicate existence
	movem	t2,filerr		;remember
	jrst	.tsf5			;now test for offline
.tsf1:	cain	t1,gjfx18		;no such filename ?
	 jrst	.tsf2			;yes, try deleted
	cain	t1,gjfx19		;no such filetype?
	 jrst	.tsf2			;yes
	cain	t1,gjfx20		;no such gen ?
	 jrst	.tsf2			;yes
	cain	t1,gjfx24		;file not found ?
	 jrst	.tsf2			;yes
	cain	t1,gjfx32		;no files match spec ?
	 jrst	.tsf2			;yes *wildcard only*
	movx	t2,-4			;no, so crappy filespec
	movem	t2,filerr		;store it
	retskp				;return
.tsf2:	move	t2,comptr		;get saved filename pointer
	movx	t1,gj%sht+gj%old+gj%del	;consider deleted files this time
	gtjfn%
	 erjmp	.tsf3			;OK, try invisible
	setom	filerr			;indicate status
	jrst	.tsf5			;now test for offline
.tsf3:	move	t2,comptr		;get saved filename pointer
	movei	t1,tsargs		;pointer to long form argument block
	gtjfn%				;try again
	 erjmp	.tsf4			;file definitely not found (syntax OK)
	movx	t2,-2			;set invisible status
	movem	t2,filerr		;mark
.tsf5:	move	t2,[1,,.fbctl]		;get .FBCTL out of the FDB
	movei	t3,t4			;return info in t4
	gtfdb%				;grab info
	 ercal	error			;die horribly
	move	t2,filerr		;get current status word
	txne	t4,fb%off		;file is offline ?
	movx	t2,-3			;yes, indicate
	movem	t2,filerr		;remeber status
	movem	t1,tsjfn		;remember jfn
	camge	t2,[-2]			;If file is here, find size stuff
	 jrst	.tsst			;If not, just do strings
	sizef%				;Get file size
	 ercal	error
	movem	t3,q1			;Save page count for a mo
	hrroi	t1,[Asciz/<FILSIZ>/]	;Symbol name
	call	entnum			;Set this up
	 ret				;Failed
	hrroi	t1,[Asciz/<FILPAG>/]	;Page size
	move	t2,q1			;Get it
	call	entnum			;Set it up
	 ret				;failed
	move	t1,tsjfn		;Point to the file
	move	t2,[1,,.fbbyv]		;get .fbbyv out of the FDB
	movei	t3,t4			;return info in t4
	gtfdb%				;grab info
	 ercal	error			;die horribly
	ldb	t2,[point <Wid(fb%bsz)>,t4,<Pos(Fb%bsz)>] ;Load the byte size
	hrroi	t1,[Asciz/<FILBYS>/]	;Symbol name
	call	entnum			;Place in symbol table
	 ret				;Failed
.tsst:	movei	q1,tsnams		;point to table of symbols/codes
.tslp:	hlrz	t3,(q1)			;get address of status code
	jumpe	t3,.tsend		;if zero, all over
	move	t3,(t3)			;get format control bits for this field
	hrroi	t1,scratch		;point to scratch string storage
	move	t2,tsjfn		;get jfn of file
	jfns%				;write out this field
	 ercal	error			;should not fail
	hrro	t1,(q1)			;point to name for this field
	hrroi	t2,scratch		;and the value we just got
	call	entstr			;enter into string table
	 ret				;failed
	aoja	q1,.tslp		;do next field
.tsend:	move	t1,tsjfn		;all done, get jfn
	rljfn%				;lose JFN
	 ercal	error
	retskp				;return OK
.tsf4:	setzm	filerr			;file does not exist (we know the name's
	retskp				;OK because it passed the first test)

	purge	tsjfn
	subttl	.CALL directive - invokes another IND file, passing symbols
;
;	This directive is of the form .CALL filnam
;	If the file type is not specified, the same default applies as with the
;	IND program itself. This directive allows you to pass symbols between
;	the command files (all symbols are still valid), thus having command
;	"procedures" you can call at will.
;
.call:	move	t2,calnst		;get current nesting level of IND
	cail	t2,mxcal		;above maximum call depth ?
	 jrst	[fatal	<maximum file nesting depth exceeded>,,,nocmd]
	move	t1,comjfn		;no, get current file handle
	movem	t1,calstk(t2)		;stack it
	aoj	t2,			;bump nesting depth
	movem	t2,calnst		;save it
	move	t2,comptr		;get command pointer
	movei	t1,cgjargs		;address of GTJFN argument block
	gtjfn%				;long form GTJFN
	 erjmp	[fatal	<can't .CALL file:>,,mcall]
	movem	t1,comjfn		;save JFN
	movx	t2,fld(7,of%bsz)+of%rd	;open for read
	openf%				;well, try anyway
	 erjmp	[fatal	<can't open command file:>,,mcall]	;failed
	retskp				;return OK
	subttl	.DELAY directive - pauses for n seconds
;
;	format:	.DELAY numexp (general numeric expression)
;
.delay:	call	numexp			;parse numeric expression
	 ret				;failed for some reason
	skipge	t2			;positive number ?
	 jrst	[warn	<can't DELAY for a negative amount of time>]
	move	t1,t2			;get in right ac
	imuli	t1,^d1000		;convert secomds to milliseconds
	disms%				;sleep....
	retskp				;and continue
	subttl	.DISPLAY directive - types string on terminal without cr/lf
;
;	Format:	.DISPLAY strexp .
;	This directive is primarily intended for files wanting to do cursor 
;	control via string variables.
;
.display:	call	strexp		;parse string expression
		 ret			;failed
	move	t1,t2			;retrive pointer
	psout%				;type string
	 ercal	error			;huh ?
	retskp				;can only really return success
	subttl	The .LOGFILE command - set up a logfile and .ENDLOG
;
;	Format: .LOGFILE filename
;	THis command specifies the terminal logfile to be used in .ENABLE
;	LOGGING. An error in the filename is not fatal.
;
.logfi:	skipe	logjfn			;do we already have a logfile ?
	 jrst	[warn	<logfile already open.
>]		;yes, warn politely and do nowt
	movem	t1,t2			;no, save pointer to name field
	movx	t1,gj%sht!gj%new!gj%fou	;and specify new file required
	gtjfn%				;get handle
	 erjmp	[fatal	<can't get handle on logfile:>,,mcall,nocmd]
	movx	t2,fld(7,of%bsz)!of%wr	;don't store JFN yet, try to open first
	openf%
	 erjmp	[fatal	<can't open logfile:>,,mcall,nocmd]
	movem	t1,logjfn		;now we have logfile, save JFN
	retskp				;succeeded
;
;	Format: .ENDLOG 
;	Closes logfile and releases PTY.
;
.endlog:	skipn	logjfn		;do we have a logfile ?
	 retskp				;no, return success
	hrrz	t1,..log		;yes, get entry for disable logging
	setom	edtyp			;flag disable is desired
	call	(t1)			;invoke routine to disable logging
	move	t1,logjfn		;get logfile
	closf%				;close it
	 ercal	error
	setzm	logjfn			;indicate no logfile
	retskp				;return success
	subttl	The .OPENI/.CLOSEI directive - open a file for input
;
;	Format:	.OPENI filename
;		.CLOSEI
;
;	This command opens a file for input with the specified name. The file is
;	read using the .READ directive. Only one input file may be open at a
;	given time. This does not interact with the .OPEN directive.
;	.CLOSEI closes the current input file. It is a noop if no file is open.
;
.openi:	movx	t3,fld(7,of%bsz)+of%rd	;open for read
	movx	t1,gj%sht!gj%old	;old file
	skipe	inpjfn			;file already open ?
	 jrst	[fatal	<Input file already open:>]	;yes, complain
	move	t2,comptr
	gtjfn%				;attempt to get a handle
	 erjmp	.opin1			;failed for some reason
	movem	t1,inpjfn		;save the handle
	move	t2,t3			;open for read
	openf%
	 erjmp	.opin1			;failed for some reason
	retskp				;return success
.opin1:	fatal	<can't OPEN input file: >,noret,mcall
	setzm	inpjfn			;clear in case error was on OPENF
	ret				;return failure

.closi:	move	t1,inpjfn		;get file handle
	jumpe	t1,rskp			;if no file, return success
	closf%				;close file
	 ercal	errmes			;huh ?
	setzm	inpjfn			;indicate we have no file
	retskp				;return success
	subttl	The .READ directive - get data from input file
;
;	Format:	.READ string-variable
;
;	This directive reads the next line from the current input file into
;	the string variable named. An error is given if the input line is
;	longer than the maximum string length allowed. Any cr/lf pair on
;	the end of the data is stripped.
;
.read:	skipn	inpjfn			;any input file open ?
	 jrst	[fatal	<no input file open:>]
	move	t2,[point 7,asksym]	;storage for symbol name
	call	getwrd			;read the symbol name
	movei	t1,$str			;check symbol is valid type
	call	askchk			;must be string or undefined
	 jrst	[fatal	<symbol is not string:>]
	move	t1,inpjfn		;ok, now read the data
	hrroi	t2,rdbuf		;into temporary input buffer
	movei	t3,mslen+2		;maximum length allowed (+2 for cr/lf)
	movei	t4,lf			;terminate on linefeed
	sin%				;read a line
	 ercal	rdchk			;check for end-of-file
	jumpe	t3,[fatal	<input record too long:>];complain if record was longer than max
	subi	t3,mslen		;subtract maximum string length from left
	movns	t3,t3			;and construct length of input string
	movem	t3,strlen		;store in special system symbol
	adjptr	t2,[-2]			;now backspace over cr/lf
	setz	t1,			;get a null
	idpb	t1,t2			;and dump it there
	hrroi	t1,asksym		;now point to symbol name
	move	t2,[point 7,rdbuf]	;and to the value of the string
	call	entstr			;enter value into table
	 ret				;failed
	retskp				;return success
rdchk:	movei	t1,.fhslf	;check what error was
	geter%				;read it
	 ercal	error			;error reading error ?
	hrrzs	t2,t2			;isolate error from handle
	caie	t2,iox4			;end of file reached ?
	 jrst	error			;no, crash
	pop	p,t1			;yes, so throw away ERCAL address
	hrroi	t1,asksym		;point to symbol name
	move	t2,[point 7,[0]]	;point to a null string
	call	entstr			;and set up for a null read
	 ret				;return failure
	setzm	strlen			;zero length of last string
	retskp				;return success
	subttl	The .REWIND command - reset input file to start
;
;	Format: .REWIND
;	This command rewinds the current input file. An error is given
;	if no input file is currently open.
;
.rewind: skipn	t1,inpjfn		;input file open ?
	 jrst	[fatal	<no input file open:>]
	setz	t2,			;yes, so set to byte 0
	sfptr%				;do it
	 ercal	error			;crash on error
	retskp				;return success
	Subttl	Declaration statements
;
;	The format of these commands is
;	.TYPE name,name,name
;	where TYPE is one of NUMERIC, STRING, LOGICAL,REAL or FILE,
;	and name is an as-yet undefined variable. They set up a variable
;	in the appropriate table with a null value: 0 or false or "" or NUL:
;	This aids in programming complex command files.
;
.real:	movei	t2,$flt			;set type real
	setz	t3,			;initialize default value
	jrst	declst			;parse declaration list
.numeric:	movei	t2,$num		;set up symbol type
	setzm	t3			;initialize default value
	jrst	declst			;parse declaration list
.logical: movei	t2,$lgc			;set up symbol type
	movx	t3,false		;and default value
	jrst	declst			;parse namelist
.string:	movei	t2,$str		;set up symbol type
	move	t3,[point 7,[0]]	;and default null string
	jrst	declst			;parse namelist
.file:	push	p,t1		;save command pointer
	movx	t1,gj%sht!gj%old	;old file
	hrroi	t2,[asciz/NUL:/]	;get a JFN on the null device
	gtjfn%				;do it
	 ercal	error			;total failure
	movem	t1,t3			;save as value
	pop	p,t1			;restore command pointer
	movei	t2,$fil			;set up symbol type
	jrst	declst			;and parse list
declst:	stkvar	<decval,dectab>		;remember default value and type here
	movem	t2,dectab		;remember type
	movem	t3,decval		;and value of new symbol
	movem	t1,comptr		;save command pointer
decls1:	move	t1,comptr		;point to next field of command
	move	t2,[point 7,asksym]	;place to store symbol name
	call	getwrd			;grab a word
	movem	t1,comptr		;store new command pointer
	move	t1,[point 7,asksym]	;now look at new name
	call	leng			;find length
	skipg	t3			;more than 0 ?
	 jrst	[fatal	<blank symbol name in declaration list: >]
	hrroi	t1,asksym		;ok, point at the symbol
	call	luksym			;and make sure it isn't defined
	 jrst	declok			;it isn't, so we're OK
	fatal	<symbol is already defined:> ;it is, issue an error
declok:	move	t1,[point 7,asksym]	;point to symbol name
	move	t2,decval		;include default value
	move	t3,dectab		;point to table to be used
	call	entval			;enter value and symbol in table
	 ret				;failed
	move	t1,comptr		;succeeded
	call	skpblk			;skip over blanks
	ildb	t2,t1			;get next byte after name
	caie	t2,","			;comma ?
	 retskp				;no, so namelist is parsed
	call	skpblk			;yes, so skip more blanks
	movem	t1,comptr		;store new command pointer
	jrst	decls1			;loop through namelist
	purge	decval,dectab
	subttl	.CODE directive - get ASCII code of character
;
;	The format of this directive is:
;	.CODE symbol string-expression
;	where symbol is of type numeric. The directive sets the symbol to the
;	value of the first character in the string.
;
.code:	move	t2,[point 7,asksym]	;point to storage for name of symbol
	call	getwrd			;grab a symbol name
	call	skpblk			;skip intervening blanks
	movem	t1,comptr		;save command line pointer
	call	strexp			;now parse a string expression
	 ret				;bad return from STREXP
	hrroi	t1,asksym		;point to name of numeric symbol
	ildb	t2,t2			;now get a byte from the start of result
	call	entnum			;enter numeric value
	 ret				;failed
	retskp				;succeeded
	subttl		.DELIM directive - set substitution delimiter
;
;	Format: .DELIM string-expression
;	The substitution delimiter character is set to the first character
;	of the designated string.
;
.delim:	call	strexp			;parse string expression
	 ret				;failed - return failure
	ildb	t1,t2			;get first character of it
	movem	t1,subdlm		;save new delimiter character
	retskp				;return success
	subttl	PURGE directive - undefine a symbol
;
;	The .PURGE directive takes the form
;	.PURGE symbol[,symbol,symbol...]
;	It removes the specified symbols completely - their types are
;	forgotten, their values lost, and space they used is reclaimed.
;	It is illegal to PURGE an undefined symbol.
;
.purge:	move	t1,comptr		;get command line pointer
	move	t2,[point 7,asksym]	;place to store symbol name
	call	getwrd			;retrieve a symbol from list
	movem	t1,comptr		;save current pointer
	move	t1,[point 7,asksym]	;point to current symbol name
	call	leng			;compute length
	jumple	t3,[fatal <Blank symbol name for PURGE:>] ;zero, funny command
	move	t1,[point 7,asksym]
	call	luksym			;find out what table it's in
	 jrst	[fatal	<Symbol to be PURGE'd is not defined:>] ;it isn't...
	move	t1,[point 7,asksym]	;point to name to clobber
	call	delval			;and remove it from the table
	move	t1,comptr		;now get the command pointer back
	call	skpblk			;skip blanks
	ildb	t2,t1			;get the next character
	caie	t2,","			;comma ?
	 retskp				;no, so list is parsed
	call	skpblk			;yes, so skip more blanks
	movem	t1,comptr		;save input pointer
	jrst	.purge			;do the next one
	subttl	.PARSE - parse a string into substrings
;
;	The .PARSE directive is of the form:
;	.PARSE comanstr controlstr fld1 fld2 ....
;
;	Its function is to split a string into substrings based on given
;	delimiters. The string to be split is in comanstr. The delimiters
;	are specified by the contents of controlstr, and the output for each
;	field is in the string variables fld1 fld2 fld3 etc.
;	Comanstr is scanned until the first character in controlstr is found.
;	At this point, it's contents until then are copied into fld1. It is then
;	scanned for the second character in controlstr, and the next field is
;	copied to fld2. If controlstr runs out, its last character is used 
;	repeatedly. If the field variables run out, the rest of controlstr is
;	copied into the final field variable.
;
.parse:	stkvar	<nflds,ctlptr,cmsptr,ndlms,lstdlm>
				;number of field variables, control
					;string pointer, command string ptr.
	move	t2,[point 7,asksym]	;area to store name of command variable
	call	getwrd			;retrieve name of string
	call	skpblk			;skip following blanks
	movem	t1,comptr		;save command string pointer
	hrroi	t1,asksym		;pointer to command string name
	call	lukstr			;look it up
	 jrst	[fatal	<String to be parsed does not exist: >] ;not there
	movem	t2,cmsptr		;found, save pointer to string
	move	t1,comptr		;back to command line
	call	strexp			;parse control string expression
	 ret				;failed
	movem	t2,ctlptr		;save pointer to contents
	call	skpblk			;skip intervening blanks
	movem	t1,comptr		;save command pointer
	call	cntfld			;count the number of field variables
	movem	t4,nflds		;save the count
	jumpe	t4,[fatal <No field variables for .PARSE >]
	move	t1,ctlptr		;point to control string
	call	leng			;and get its length
	jumpe	t3,[fatal <Control string is null >]	;nothing in it
	movem	t3,ndlms		;save number of delimiter characters
	setzm	strlen			;zero count of fields parsed
	jrst	.prsnx			;enter parsing loop
;
;	Routine to count number of field variables, and intialize them all
;	to null.
;
cntfld:	setz	q1,			;counter for fields
	move	q2,comptr		;get command line pointer
cntfl1:	move	t1,q2			;get pointer again
	move	t2,[point 7,asksym]	;place to store variable name
	call	getwrd			;look for a word
	call	skpblk			;skip intervening blanks/tabs
	movem	t1,q2			;save command line pointer
	move	t1,[point 7,asksym]	;point to name
	call	leng			;get length
	jumpe	t3,[move t4,q1		;if zero, all done, get count
			ret]		;and return to caller
	hrroi	t1,asksym		;else point to name
	hrroi	t2,[0]			;get null initial value
	call	entstr			;enter into string table
	 jrst	[fatal	<Cannot initialize fields for parse>]
	aoja	q1,cntfl1		;increment count of fields and loop
;...
;...	Start real parse
;
.prsnx:	move	t1,nflds		;get number of field variables left
	cain	t1,1			;only one to go ?
	 jrst	.prsall			;yes, so just parse the lot that's left
	move	t1,cmsptr		;point to current position in string
	move	t2,lstdlm		;get last delimiter character used
	skiple	ndlms			;used all delimiters ?
	 ildb	t2,ctlptr		;no, so grab another one
	movem	t2,lstdlm		;save current delimiter character
	sos	ndlms			;and drop number available
	movei	t3,mslen		;maximum string length
	call	search			;search for delimiter in string
	move	t2,cmsptr		;point to where we were looking at
	jumpl	t3,.prsall		;if not found, then just copy remainder
	jumpe	t3,[setzm	sublin  ;if position zero, delims are adjacent
		   jrst	.prsn1]		;so generate a null output string
	movns	t3,t3			;else get negative length
	hrroi	t1,sublin		;temporary area to store field
	sout%				;copy field out of command string
	setz	t3,			;get a null
	idpb	t3,t1			;and drop on end of string 
.prsn1:	ibp	t2			;skip over trailing delimiter
	movem	t2,cmsptr		;and save current command string pointer
	move	t1,comptr		;get real command line pointer
	move	t2,[point 7,asksym]	;pointer to place for next variable name
	call	getwrd			;get name of next field variable
	call	skpblk			;skip blanks after name
	movem	t1,comptr		;save position of next name
	hrroi	t1,asksym		;point to name of variable
	hrroi	t2,sublin		;and value
	call	entstr			;enter next field in table
	 ret				;failed, drop back through
	aos	strlen			;increment number of fields parsed
	sos	nflds			;and decrement number of field vars.
	jrst	.prsnx			;and go and look for next one
.prsal:	move	t1,comptr		;point to place for next field name
	move	t2,[point 7,asksym]	;place to put it
	call	getwrd			;get name of last field
	hrroi	t1,asksym		;point to name of last field variable
	move	t2,cmsptr		;get pointer to current string
	call	entstr			;set it up
	 ret				;failed
	aos	strlen			;increment fields parsed
	retskp				;return success

	purge	nflds,ctlptr,cmsptr,ndlms,lstdlm
	subttl	.TRIM and .PAD - blank handling
;
;	The .TRIM directive removes trailing blanks from a string variable.
;	Format:		.TRIM strsym
;	The .PAD directive pads a string to a specified length with blanks.
;	Format:	.PAD strsym numexp
;	where numexp is an expression for the desired length of the string.
;
.pad:	stkvar	<padlen,padptr>
	move	t1,comptr		;point to command line
	move	t2,[point 7,asksym]	;area for string symbol name
	call	getwrd			;grab name of symbol
	movem	t1,comptr		;save command line pointer
	hrroi	t1,asksym		;now point to name
	call	lukstr			;and check that it is of type string
	 jrst	[fatal	<Unknown string symbol in .PAD: >] ;nope
	movem	t2,padptr		;save pointer to string
	move	t1,comptr		;now get command line pointer back
	call	skpblk			;skip intervening blanks/tabs
	call	numexp			;and parse the numeric expression
	 ret				;bad return
	caile	t2,mslen		;is it greater than maximum allowed?
	 jrst	[fatal	<Length to pad string to is too great: >]
	movem	t2,padlen		;save result of expression
	hrroi	t1,sublin		;so point to a temporary area
	move	t2,padptr		;get pointer to string back
	setzb	t3,t4
	sout%				;and copy the current string
	 ercal	error
	hrroi	t1,sublin		;now point to copy
	call	leng			;and get the length
	caml	t3,padlen		;is it greater than length to be padded
	 jrst	[warn	<String is already longer than .PAD length: >] ;yes
	move	t1,[point 7,sublin]	;get pointer to start of string
	adjptr	t1,t3			;and make it point to the end
	exch	t3,padlen		;swap desired and current lengths
	sub	t3,padlen	;and discover how many extra blanks we need
	movei	t2," "			;get a space
.padlp:	idpb	t2,t1			;drop it in
	sojg	t3,.padlp		;and continue as long as required
	setz	t2,			;now, get a null
	idpb	t2,t1			;and drop on the end
	hrroi	t1,asksym		;now point to name of string
	hrroi	t2,sublin		;and new value
	call	entstr			;re-enter in tables
	 ret				;failed
	retskp				;succeeded
	subttl	.TRIM
.trim:	move	t2,[point 7,asksym]	;point to area for symbol name
	call	getwrd			;grab name
	hrroi	t1,asksym		;now point to name
	call	lukstr			;does it exist ?
	 jrst	[fatal	<Unknown string variable to .TRIM: >] ;nope
	hrroi	t1,sublin		;yes, so copy it somewhere
	setzb	t3,t4
	sout%				;in a leisurely manner
	 ercal	error			;allowing for errors
	hrroi	t1,sublin		;now point to the symbol
	call	leng			;and grab its length
	jumpe	t3,[retskp]		;if empty, go home
	move	t1,[point 7,sublin]	;else point to start
	movem	t3,t4			;save length as a counter
	adjptr	t1,t3			;and point to end
.triml:	ldb	t2,t1			;grab last character.
	caie	t2," "			;is it space ?
	cain	t2,"	"		;or tab ?
	 jrst	[bkptr	t1		;yes, so backspace the pointer
		sojg	t4,.triml	;and get the next if some left
		move	t1,[point 7,sublin] ;get empty pointer
		jrst	.triem]		;else it's empty
.triem:	setz	t2,			;we have found end
	idpb	t2,t1			;so bung a null over the last space/tab
	hrroi	t1,asksym		;point to string name
	hrroi	t2,sublin		;and new value
	call	entstr			;bung it in
	 ret				;failed somehow
	retskp				;succeeded
	subttl	.RAISE - make a string upper case(and .LOWER)
;
;	This directive is used to force all characters in a string to be
;	upper case.
;
.raise:	hrroi	t2,asksym		;point to storage for symbol name
	call	getwrd			;retrieve name of symbol
	hrroi	t1,asksym		;point to name of string variable
	call	lukstr			;check it's existence
	 jrst	[fatal	<String for .RAISE does not exist: >]
	move	t3,[point 7,sublin]	;point to output
rais1:	ildb	t1,t2			;get a character from string
	jumpe	t1,raisin		;if zero, then end
	cail	t1,"a"			;is it less than lower case
	 caile	t1,"z"			;or more than ?
	skipa				;yes, so don't interfere
	txz	t1,40			;no, is lower case, make upper
	idpb	t1,t3			;store this byte in output
	jrst	rais1			;and go for more
raisin:	setz	t2,			;get a null
	idpb	t2,t3			;and put on end of output string
	hrroi	t1,asksym		;name of variable
	hrroi	t2,sublin		;new, raised value
	call	entstr			;enter it
	 ret				;failed
	retskp				;succeeded
;
;	.LOWER - make everything lower case
;
.lower:	hrroi	t2,asksym		;point to storage for symbol name
	call	getwrd			;retrieve name of symbol
	hrroi	t1,asksym		;point to name of string variable
	call	lukstr			;check it's existence
	 jrst	[fatal	<String for .LOWER does not exist: >]
	move	t3,[point 7,sublin]	;point to output
lowe1:	ildb	t1,t2			;get a character from string
	jumpe	t1,lowend		;if zero, then end
	cail	t1,"A"			;is it less than upper case
	 caile	t1,"Z"			;or more than ?
	skipa				;yes, so don't interfere
	txo	t1,40			;no, is upper case, make lower
	idpb	t1,t3			;store this byte in output
	jrst	lowe1			;and go for more
lowend:	setz	t2,			;get a null
	idpb	t2,t3			;and put on end of output string
	hrroi	t1,asksym		;name of variable
	hrroi	t2,sublin		;new, raised value
	call	entstr			;enter it
	 ret				;failed
	retskp				;succeeded

	subttl	DDT - directive to merge DDT and breakpoint
.ddt:	call	getddt			;grab DDT
	retskp				;back for next directive
	subttl	DAYTON and NTODAY - date conversion
;
;	These directives convert from date strings to day numbers
;	and back again
;
.dayton:	stkvar	<strptr>
	call	strexp			;parse the string expression
	 ret				;failed somehow
	movem	t2,strptr		;save string pointer
	call	skpblk			;skip intervening blanks
	move	t2,[point 7,asksym]	;where to store output
	call	getwrd			;get name of numeric variable
	movei	t1,$num			;allowed to be numeric
	call	askchk			;make sure it is
	 jrst	[fatal	<Second variable in DAYTON must be numeric: >]
	move	t1,strptr		;OK, point to string
	ildb	t2,t1			;and start looking for the end
	jumpn	t2,.-1			;keep looping till it's found
	bkptr	t1			;space back over the null
	hrroi	t2,[asciz/ 3:00AM-GMT/]	;add on a decent time of day
	setzb	t3,t4
	sout%				;and append it to the date
	move	t1,strptr		;point at the date again
	movx	t2,it%snm!it%err	;second number MUST be month
	idtim%				;read it
	 erjmp	dayter			;some invalid date format
	hlrzs	t2,t2			;get just smithsonian day number
	hrroi	t1,asksym		;point to symbol name
	call	entnum			;enter number
	 ret				;failed
	retskp				;succeeded
dayter:	fatal	<Invalid date format: >,stop,js

.NTODAY:	call	numexp			;parse numeric expression
	 ret				;failed
	movem	t2,t4			;save value
	call	skpblk			;skip intervening blanks
	hrroi	t2,asksym		;point to area for name
	call	getwrd			;get name of string symbol
	movei	t1,$str			;must be string
	call	askchk			;check this
	 jrst	[fatal	<Destination must be string: >]
	hrroi	t1,wrkstr		;point to temp string area
	hrlz	t2,t4			;get internal date
	addi	t2,7777			;make it well into that day
	movx	t3,ot%ntm		;date only
	odtim%				;write out date
	 erjmp	[fatal	<Invalid day number: >,js,stop]
	hrroi	t1,asksym		;point to string name
	hrroi	t2,wrkstr		;point to string
	call	entstr			;enter in tables
	 ret				;failed
	retskp				;succeded
	subttl	.RADIX directive - set the current radix
;
;	Format: .RADIX numeric-expression.
;	The current radix for .ASKN, and all integer I/O is set.
;	The expression is ALWAYS interpreted as a RAD-10 expression, so that:
;	.SETN OLDRADIX 10
;	.RADIX 7
;	....
;	.RADIX 'OLDRADIX' or .RADIX OLDRADIX
;	will work.
;
.radix:	movei	t4,^d10			;read this in decimal
	movem	t4,radix		;store for NUMEXP
	call	numexp			;now read new radix in decimal
	 jrst	haltt			;halt on error
	jumple	t2,[fatal <Radix must be greater than 0>,stop] ;check +ve
	caile	t2,^d36			;within range ?
	 jrst	[fatal <Radix must be less than 36>,stop]
	movem	t2,radix		;store new radix
	retskp				;return
	subttl	POSITION directive  - position the input file
;
;	Format is .POSITION numeric expression  
;	The open input file is set to that byte number
;
.posit:	call 	numexp			;try parsing a numeric expression
	 ret				;failed
	skipn	t1,inpjfn			;any input file ?
	 jrst	[fatal	<No input file open to position>,stop] ;no
	jumpl	t1,[fatal <Must position to positive byte number>,stop]
	sfptr%				;set the position for next read
	 ercal	error
	retskp				;all done
	subttl	.TELL - store command for inferior fork
;
;	This directive just stores the rest of its text which will be
;	sent to the inferior fork next used in a .RUN directive.
;
.tell:	hrroi	t2,telcmd		;point to TELL buffer
	setzb	t3,t4			;string is ASCIZ
	sin%				;copy it
	retskp				;completed
;==**== Next command goes here
	subttl	Text substitution routines
;
;	text substitution routines - given a command line in COMLIN,
;	we scan the line for 'SYMBOL' and substitute the appropriate string
;	or numeric stuff. Return +1/+2
;
substi:	stkvar	<subst,subptr,newptr>
	skipe	purcmd			;are we being re-entered ?
	 retskp				;yes, ignore
	move	t1,[comlin,,comcop]	;make copy of command line
	blt	t1,comcop+maxcom-1	;for use by .DATA directives
	move	t1,[point 7,comlin]	;point to command line
	movem	t1,comptr		;save as command pointer
	skipe	sbtflg			;are we allowed to substitute ?
	 retskp				;no, user has disabled function
	skipe	going			;are we doing a GOTO search ?
	 retskp				;yes, symbols may not be defined
	move	t1,[point 7,sublin]	;point to substitution line
	movem	t1,subptr		;save it
	move	t1,[point 7,comlin]	;point to command line
	movem	t1,comptr		;save as command pointer
;
;	Enter here for each round of substitution
;
subst2:	move	t1,comptr		;point to where we are in command line
	move	t2,subdlm			;search for symbol starter
	movei	t3,^d80			;80 chars away at most
	call	search			;try to find the character
	skipge	t3			;was it found ?
	 jrst	subend			;no, we can exit gracefully
	move	t2,[point 7,subsym]	;yes, get the symbol name
	movem	t1,subst		;substitution start pointer
	call	getwrd			;will return on non-alpha
	ildb	t2,t1			;now get next char
	came	t2,subdlm		;should be matching delimiter
	 jrst	sbqerr			;no, so we can't parse the line
	movem	t1,newptr		;now this points beyond end of symbol
	move	t1,subptr		;reget substitution pointer
	move	t2,comptr		;reget command pointer
	movei	t3,^d80			;maximum of 80 chars
	move	t4,subdlm			;terminate on quote
	sout%				;write normal part of string
	 ercal	error
	bkptr	t1			;back up over "'"
	movem	t1,subptr		;and save again
	move	t1,[point 7,subsym]	;start of symbol
	call	luksym			;lookup in general symbol table
	 jrst	subsy			;string not found try system
	jrst	@[subnf			;table of routines to dispatch to
		subnt			;on numeric symbol type codes
		subsr			;go here for strings
		subft			;here for files
		subnf			;here for logicals (illegal)
		subnf			;here for labels (impossible)
		subrl](t3)		;here for reals
subsr:	move	t4,t2			;get byte number where string starts
	move	t2,[point 7,strings]	;point at string table
	adjptr	t2,t4			;and adjust to point to relevant byte
subst3:	move	t1,subptr		;OK, get pointer to output again
	setzb	t3,t4			;terminate on null
	sout%				;write substituted string
	 ercal	error
	movem	t1,subptr		;save substitution pointer
	move	t1,newptr		;this points beyond end of symbol
	movem	t1,comptr		;which is where we want to search from
	jrst	subst2			;and go and try for next bit of string
;
;	try for numeric symbol and get value
;
subnt:	hrroi	t1,scratch		;point to scratch buffer
	move	t3,radix		;get current radix
	nout%
	 ercal	error
	hrroi	t2,scratch		;set up for substi as if a string was
	jrst	subst3			 ;found and continue
;
;	Substitute for real symbol
;
subrl:	hrroi	t1,scratch		;point to scratch buffer
	setz	t3,			;default floating format
	flout%				;write out number
	 ercal	error
	hrroi	t2,scratch		;set up for substi as if string was done
	jrst	subst3			;join loop
;
;	Output string for file symbol
;
subft:	hrroi	t1,scratch		;write name to scratch buffer
	setz	t3,			;no fancy options: dev:<dir>file.typ.gen
	jfns%				;write out name
	 ercal	error
	hrroi	t2,scratch		;set up for substitution
	jrst	subst3			;place into command
;
;	Try for system symbol, decode
;
subsy:	move	t1,[point 7,subsym]
	call	luksys			;lookup symbol in system tables
	 jrst	subnf			;not found - complain
	caie	t3,$str			;string symbol ?
	 jrst	nsubsy			;no, hopefully numeric
	hrroi	t1,scratch		;yes, write to scratch buffer
	hrroi	t2,sysval		;from where left
	setzb	t3,t4
	sout%				;with a sout%
	 ercal	error
	hrroi	t2,scratch		;fool the rest of the code this normal
	jrst	subst3			;continue
nsubsy:	caie	t3,$num			;numeric, perhaps ?
	 jrst	illsy			;no, illegal system symbol type
	hrroi	t1,scratch		;yes, write to scratch buffer
	move	t2,sysval		;get value of symbol
	move	t3,radix		;get current radix
	nout%
	 ercal	error
	hrroi	t2,scratch		;fool the rest of the code
	jrst	subst3			;and continue
;
;	print out remainder of command in buffer, and copy buffer back
;	to comlin
;
subend:	move	t1,subptr			;where we are
	move	t2,comptr		;where we are coming from
	setzb	t3,t4			;terminate on null
	sout%				;write rest of string
	 ercal	error
	hrroi	t1,comlin		;point back to comlin
	hrroi	t2,sublin		;and to where we have the substituted 
	movei	t3,maxcom*5		;maximum command length
	setz	t4,			;string in ASCIZ
	sout%
	 ercal	error
	movei	t2,maxcom*5-1		;what we wanted to read
	sub	t2,t3			;minus what we didn't
	movem	t2,linlen		;is what we did
	move	t1,[comlin,,comcop]	;make copy of command line
	blt	t1,comcop+maxcom-1	;for use by .DATA directives
	move	t1,[point 7,comlin]	;restore command pointer
	retskp				;return success
	purge	newptr,subptr,subst	;throw away temporary names
;
;	string symbol not found
;
subnf:	fatal	<undefined symbol for substitution: >
;
;	mismatched quotes
;
sbqerr:	fatal	<mismatched quotes while substituting: >
;
;	Crazy system symbol type
;
illsy:	fatal	<invalid system symbol type>
	subttl	Rescan EXEC command line for input file
;
;	This routine rescans our command line to attempt to get a filename
;	for it. It also picks up any parameters from the command line and
;	sets them up as string symbols.
;
gcom:	call	tstbat			;check for BATCH attempt
	movei	t1,.rsini		;initialize for rescan
	rscan%
	 ercal	error
	movei	t1,.rscnt		;count of chars in buffer
	rscan%
	 ercal	error
	movnm	t1,t3			;make a count for SIN%
	movei	t1,.priin		;read rescan stuff
	hrroi	t2,scratch		;write to scratch
	setz	t4,			;terminate on null
	sin%				;read rescan stuff
	adjptr	t2,[3]			;bump pointer to safe area
	call	gfil			;set up command file name
	 jrst	errmes			;failed, print error and ask terminal
;
;	Now load up the passed parameters
;
	move	t1,t2			;get byte pointer back
	setzm	nargs			;indicate no arguments yet
	move	t2,[asciz/P0/]		;initial parameter name
	movem	t2,pname		;store
gcom1:	call	skpblk			;skip over blanks
	move	t4,[point 7,wrkstr]	;point to output for param
	ildb	t2,t1			;get next byte
	jumpe	t2,gcom2		;if null, parameter list has ended
	call	tsbrk			;if not, check if it is a bracket
	 skipa				;was not a bracket, keep char
gcom3:	ildb	t2,t1			;was a bracket, get first of string
	camn	t2,t3			;is it the terminator for this string ?
	 jrst	gcom4			;yes, close off
	jumpe	t2,gcom4		;no, but jump on null also
	cain	t2,cr			;and also carriage return
	 jrst	gcom4
	cain	t2,lf			;linefeed ?
	 jrst	gcom4			;yes, ignore
	idpb	t2,t4			;else deposit in output
	jrst	gcom3			;and loop for next character
gcom4:	aos	nargs		;bump number of arguments
	setz	t2,			;get a null
	idpb	t2,t4			;and append it to the parameter string
	push	p,t1			;save input pointer
	move	t2,[point 7,wrkstr]		;point to string value
	move	t1,[point 7,pname]	;point to parameter name
	ibp	t1			;bump pointer to digit
	ildb	t3,t1			;get digit
	aoj	t3,			;increment it
	dpb	t3,t1			;put it back again
	hrroi	t1,pname		;point to parameter name
	call	entstr			;enter in string table
	 jrst	[fatal	<table error on parameter startup>,stop,,nocmd]
	pop	p,t1			;get input pointer back
	jrst	gcom1			;and get next parameter
gcom2:	movei	t4,9		;max params
	camg	t4,nargs		;done that many ?
	 jrst	gcom6			;yes, all done
	sub	t4,nargs		;no, get count of number to do
gcom5:	move	t2,[point 7,pname]	;point to current parameter name
	ibp	t2			;now point to number
	ildb	t3,t2			;get it
	aoj	t3,			;increment it
	dpb	t3,t2			;put it back
	hrroi	t1,pname		;point to next name
	hrroi	t2,[0]			;and null string
	push	p,t4			;save count
	call	entstr			;enter
	 jrst	[fatal	<table error on parameter startup>,stop,,nocmd]
	pop	p,t4			;restore count
	sojn	t4,gcom5		;loop for remaining params
gcom6:	move	t1,comjfn		;get command file JFN back
	retskp				;return success
;
;	This routine is called with a character in t2, which is to be tested
;	to see if it is an opening bracket. If so, return the matching closing
;	bracket in t3 and return +2, else return space in t3 and standard 
;	return (+1). Leave t1 undisturbed (and t4).
;
tsbrk:	push	p,t4
	move	t4,[-5,,brklst]	;number of brackets, table address
tsbrk1:	hrrz	t3,(t4)			;get next bracket
	camn	t2,t3			;does it match ?
	 jrst	tsbrk2			;yes, return closing
	aobjn	t4,tsbrk1		;no, try next
	movei	t3," "			;no match at all, return space
	pop	p,t4
	ret
tsbrk2:	hlrz	t3,(t4)			;get closing bracket of pair
	pop	p,t4
	retskp				;return success
	subttl	GFIL - get command file
;
;	This routine is called with a string pointer in t2.
;	This should point to the filename in the IND command line
;	to be used.
;
gfil:	move	t1,[point 7,scratch]	;where to read from
	call	getwrd			;get a word out
	call	skpblk			;skip over intervening blanks
	movem	t1,t2			;put pointer in right place
	movei	t1,cgjargs		;address of argument block
	gtjfn%				;attempt to get handle on file
	 erjmp	gfil1			;try for SYS: instead
	movem	t1,comjfn		;save command file JFN
	retskp				;return success to caller
;
;	Here to try for command file from SYS:. Note that if this succeeds,
;	it makes SYS: the default device for future .CALL directives.
;
gfil1:	movei	t1,cgjargs		;GTJFN argument block, default SYS:
	hrroi	t2,[asciz/SYS/]		;default device for this
	movem	t2,cgjargs+.gjdev	;store pointer to default device
	move	t2,[point 7,scratch]	;point at command line
	adjptr	t2,[4]			;and then to filename
	gtjfn%				;try again
	 erjmp	[ret]			;failed again, give bad return
	movem	t1,comjfn		;succeeded, store jfn
	retskp				;give success return
	subttl	Sundry routines
;
;	This routine resets the question/answer flags to initial settings
;	(for system symbols <ESCAPE>, <DEFAULT> and .DISABLE/.ENABLE EXIT
;
iniflgs:	setzm	escflg		;indicate no escape
	setzm	defflg			;no defualt
	ret
;
;	exit if ctrl/z exit is allowed
;
exit:	skipe	extflg			;allowed to exit ?
	 ret				;no
	jrst	haltt			;yes - finish up
;
;	set <escape> to true
;
escon:	setom	escflg
	ret
prtcmd:	hrroi	t1,comlin
	psout%
	ret
;
;	Check substring limits - byte pointer in t1 to string, or 0 if not
;	yet exists. Q1,Q2 contain start, finish. Check that q1<=q2, and
;	if t1 is not 0, that q2 is less than the length of the string.
;	Also check q1>0
;
cksubs:	skipg	q1		;q1 > 0 ?
	 ret			;no, complain
	camle	q1,q2		;q1 <= q2 ?
	 ret			;no, complain
	skipn	t1		;pointer supplied ?
	 retskp			;no, return success
	push	p,t1		;save pointer
	call	leng		;get length of string
	skipge	t3		;length OK ?
	 jrst	cksub1		;no... strange
	camle	q2,t3		;top of range less than string length ?
	 jrst	cksub1		;no, complain
	pop	p,t1		;restore pointer
	retskp			;yes, OK
cksub1:	pop	p,t1
	ret
;
;	write to data file if necessary
;	Must preserve AC 1. On entry:	DATFLG/-1, datsav/0:
;	Last command was .ENABLE DATA, do nowt
;	-1,-1:	In DATA mode, write to file
;	0,-1:	Last command was .DISABLE DATA, do nowt
;
wdata:	skipn	datsav			;are we in DATA mode ?
	 ret				;no, just ENABLEd now
	skipn	datflg			;just done a .DISABLE DATA ?
	 ret				;yes, do nowt
	push	p,t1			;save useful acs
	skipn	datjfn			;open data file ?
	 jrst	wdata1			;no, crash
	hrroi	t2,comcop		;yes, write to file
	move	t1,datjfn		;from command buffer
	setzb	t3,t4			;terminate on null
	sout%				;write
	 ercal	error
	pop	p,t1
	ret				;return OK
wdata1:	fatal	<can't .ENABLE DATA without data file open.>,stop,,nocmd
;
;	Routine to clear typeahead buffer
;
clrinp:	movei	t1,.priin		;point to terminal
	cfibf%				;clear input buffer
	 ercal	error
	ret
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED

TSTCOL:	MOVEI T1,.PRIOU		;GET PRIMARY OUTPUT DESIGNATOR
	RFPOS			;READ FILE POSITION
	HRRZ T2,T2		;KEEP JUST THE COLUMN POSITION
	JUMPE T2,R		;IF AT COLUMN 1 DO NOT OUTPUT CRLF
	TMSG <
>				;NO, OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...

;
;	Routine to test if IND is being run in batch - if so, halt.
;
tstbat:	seto	t1,		;this job
	hrroi	t2,t4		;retrieve one word of job info ti t4
	movei	t3,.jibat	;word is batch control word
	getji%			;read it
	 ercal	error
	jumpe	t4,r		;if zero, AOK
	fatal	<IND cannot yet be run in batch - see the manual for techniques to be used
with IND and batch jobs.>,stop,,nocmd
	subttl	Routines used by system symbol tables
;
;	These routines find the values of various system permanent symbols,
;	and leave their answers (of whatever forms) in SYSVAL.
;
date.:	hrroi	t1,sysval		;where to put output string
	seto	t2,			;current date/time
	odtim%				;format bits already in t3
	ret
sysnm.:	move	t1,[sixbit/SYSVER/]	;routine to find system name
	sysgt%				;find out how many words in table
	hrrz	t1,t2			;put table number in t1
	hlre	t3,t2			;set up counter
	hrrzs	t2,t2			;leave t2 with just a table number
	setz	t4,
sysnm1:	getab%				;read next word from table
	 ercal	error
	movem	t1,sysval(t4)		;store
	aoj	t4,			;bump t4
	hrlz	t1,t4			;set up t1 again - getab trashes it
	hrr	t1,t2			;and get the table number
	aojn	t3,sysnm1		;go until finished
	ret				;all done
;
;	Here to check for end-of-file on input
;
ineof.:	skipn	t1,inpjfn		;any file open for input ?
	 jrst	[setom	sysval		;no, return false always
		ret]
	gtsts%				;yes, so read status of JFN
	 ercal	error
	setzm	sysval			;assume true first
	txnn	t2,gs%eof		;is end-of-file set ?
	 setom	sysval			;no, so indicate false
	ret				;return to caller
	subttl	comment processing
;
;	This routine is called to output comments in command files to the
;	screen
;	T1 contains a pointer to the command line
;
coment:	bkptr	t1			;backspace over ";"
	move	t2,t1			;put pointer in source ac
	movei	t1,.priou		;point to terminal
	setzb	t3,t4			;terminate on null
	sout%				;type it
	 ercal	error			;crash
	ret
;
;	IND comments
;
.coment:	retskp			;succeed always, do nowt
;
;	Called whenever an error occurs executing an EXEC command with
;	JSYS error in t3
;
excerr:	tmsg	<
?IND - error executing command: >
	movei	t1,.priou		;type on terminal
	move	t2,t3			;get error number in right place
	hrli	t2,.fhslf		;must point to own fork
	setz	t3,			;no limit on message length
	erstr%				;type out JSYS error
	 trn
	 trn				;ignore errors with errors
haltt:	call	.endlog			;close out logfile if necessary
	 nop
	call	nopty			;release PTY etc
	haltf%				;stop
	tmsg	<
?Cannot be continued>
	jrst	haltt
;
;	called ar end of file
;
eof:	skipe	going			;still searching for a label ?
	 jrst	laberr			;yes, error
	skipn	calnst			;end of .CALLED file ?
	 jrst	eof1			;no, proceed as normal
	sos	calnst			;drop nesting level
	move	t1,comjfn		;get old command file JFN
	closf%				;close it
	 erjmp	.+1			;ignore errors
	move	t1,calnst		;get current value
	move	t2,calstk(t1)		;and get old command file JFN
	movem	t2,comjfn		;store as new one
	jrst	fillop			;loop for next command
eof1:	tmsg	<
@ <EOF>>
stopp:	skipe	datjfn			;data file open ?
	 jrst	[move	t1,datjfn	;yes, close it
		closf%
		 erjmp	.+1		;ignore errors
		jrst	.+1]
	jrst	haltt
laberr:	fatal	<End of file while searching for label ">,noret,,nocmd
	hrroi	t1,target		;point to label name
	psout%				;type it
	tmsg	<">
	jrst	haltt			;stop
;
;	called from numeric parser
;
illvec:	fatal	<fatal internal error in numeric parser - impossible operator invoked.>,stop
	subttl	Read next command line
;
;	This routine zeros out the command space and reads in the next line
;	from the command file. It returns +1 on error, +2 on success
;
getlin:	setzm	comlin			;zero out first word of command
	setzm	purcmd			;indicate real command for SUBSTI
	move	t1,[comlin,,comlin+1]	;from,,to
	blt	t1,comlin+maxcom-1	;zero out command line
	move	t1,comjfn		;handle on command file
	rfptr%				;read where we are in file
	 ercal	error
	movem	t2,cbyt			;remember for .goto, etc.
	hrroi	t2,comlin		;where to put command line
	movei	t3,maxcom*5		;maximum chars in string
	movei	t4,lf			;terminate on linefeed
	sin%				;read record
	 erjmp	[ret]			;return +1 - failure
	movei	t2,maxcom*5		;what we wanted to read
	sub	t2,t3			;minus what we didn't
	movem	t2,linlen		;is what we did
	move	t1,[point 7,comlin]	;return start pointer
	retskp				;return success
	subttl	Enable interrupt system for fork errors, PTY
;
;	This sets up the interrupt system tables, and enables the channels
;	we use for inferior fork traps and for PTY output. Although the
;	channels are activated by this routine, we do not expect them to be
;	used until the appropriate routine causes action on that channel.
;	The channel for aborting IND is also set up.
;
inton:	movx	t1,.fhslf		;this humble fork
	move	t2,[levtab,,chntab]	;these humble tables
	sir%				;humbly request interrupts
	 ercal	error			;sod you jack
	movx	t1,.fhslf
	eir%				;enable interrupt system also
	 ercal	error
	move	t1,[aboch,,abochn]	;get code,,channel for aborting IND
	ati%				;allocate terminal interrupts
	 ercal	error			;should not fail
	movx	t1,.fhslf
	movx	t2,1b<abochn>!1b<ptychn>!1b<frkchn> 
				;set up PTY, abort and inferior interrupts
	aic%				;activate channels
	 ercal	error
	ret				;return to caller
	subttl	Grab and release PTYs for logging
;
;	This routine grabs a PTY and establishes interrupt channels for
;	its output. Return +1/+2. The device designator is stored in PTYDES.
;	The PTY jfn is stored in PTYJFN. The corresponding TTY designator
;	is stored in TTYDES.
;
getpty:	movx	t1,.ptypa		;system PTY table
	getab%			;read number, start of PTYs
	 ercal	error
	hlrzm	t1,t4		;get number of PTYs in system
	hrrzm	t1,q2		;TTY number of first PTY
	setzm	q1		;start with PTY 0
getpt1:	movsi	t1,.dvdes+.dvpty	;PTY designator
	add	t1,q1		;add PTY number
	dvchr%			;get device chars
	 ercal	error
	txne	t2,dv%av	;device available ?
	 jrst	[hlres	t3	;yes, get job number assigned to
		jumpg	t3,.+1	;if non-zero, job is already using it
		jrst	getpt2]	;else we can have it
	aoj	q1,		;no, bump PTY number
	sojn	t4,getpt1	;loop through all PTYs
	 fatal	<No PTYs available for inferior fork>,stop,,nocmd
getpt2:movem	t1,t2		;save device designator
	movem	t2,ptydes	;store for later use
	hrroi	t1,wrkstr	;now get the PTY name
	devst%			;with this JSYS
	 ercal	error
	movei	t2,":"		;no colons are provided
	idpb	t2,t1		;so we must supply one ourselves
	setz	t2,		;together with a trailing null
	idpb	t2,t1		;to make an ASCIZ string
	hrroi	t2,wrkstr	;which we can then give to GTJFN%
	movx	t1,gj%sht!gj%old ;in order to get a JFN for OPENF%
	gtjfn%			;grab JFN
	 ercal	error
	movx	t2,fld(7,of%bsz)!of%rd!of%wr ;now open for read
	openf%
	 ercal	error
	movem	t1,ptyjfn	;store JFN for interrupt routines
	hrrz	t2,ptydes	;get unit number of PTY
	add	t2,q2		;add unit number of first PTY as TTY
	addi	t2,.ttdes	;make TTY desig
	movem	t2,ttydes	;remember
	move	t1,ptyjfn		;point to PTY again
	movx	t2,mo%oir!fld(ptychn-1,mo%sic)!.moapi ; enable output-is-ready
						 ;interrupts
	mtopr%			;do it
	 ercal	error
	retskp			;return success

;
;	Routine to release PTY and deassign interrupts
;
nopty:	move	t1,ptyjfn		;get PTY jfn
	closf%				;close and release (dispose of links)
	 ercal	error
	move	t1,ttyjfn
	closf%
	 erjmp	._1
	ret				;and return to caller
	subttl	Interrupt routines for PTY and forks
;
;	The PTY routine is invoked whenever PTY output is ready. It reads it in
;	and then writes it to a logfile.
;
ptyint:	savts				;save temporary acs
ptytst:	move	t1,ttydes		;PTY as TTY
	sobe%				;output buffer empty ?
	 skipa				;no, do summat
	jrst	ptyin2			;yes, ignore interrupt
	move	t1,ptyjfn		;point to PTY
	caile	t2,^d15			;reasonable number of chars ?
	 movei	t2,^d15			;no, chop it
	jumpl	t2,[fatal	<Negative no of chars on interrupt>]
	movn	t3,t2			;negate number of chars to read
	push	p,t2
	hrroi	t2,ptybuf		;and pty buffer
	sin%				;read text from PTY
	 ercal	error
	movei	t1,.priou		;Point to terminal
	hrroi	t2,ptybuf		;point to text just read
	pop	p,t3			;get back number of chars read
	push	p,t3			;save it again
	movns	t3,t3			;negate that
	txnn	f,quietf		;Is QUIET mode enabled ?
	 sout%				;no, write that many bytes
	  ercal	error
	move	t1,logjfn		;Point to logfile now
	hrroi	t2,ptybuf		;and string also
	pop	p,t3			;Number of chars
	movns	t3			;negate
	txne	f,loging		;is LOGGING enabled ?
	 sout%				;yes, write to logfile
	jrst	ptytst			;may be more characters there
ptyin2:	rests				;restore temp acs
	debrk%				;leave interrupt context
frkint:	tmsg	<
????Fork interrupt !!!!>
	debrk%
;
;	Entry to abort IND
;
aboint:	tmsg	<
[IND - aborting]
>
	movei	t1,.priin		;point to terminal
	cfibf%				;clear the input buffer
	 ercal	error			;should not fail
	jrst	.exit			;and close up
	subttl	Range parsing routines
;
;	Ranges - called with a byte pointer in t1, looks for something of the 
;	form [a:b:c], c being optional, and all of a,b,c being arbitrary numeric
;	expressions. They can indicate a range for an answer (a is min, b max, c
;	default) or a substring slice (where c should be absent.) Here, we don't
;	care. a,b,c are returned in q1,q2,q3 and the number of vals found is 
;	returned in t2. The byte pointer is undisturbed if t2=0, else it points
;	beyond the closing bracket.
;	FRANGES is an entry point to parse floating point ranges, which
;	allows floating expressions instead of numeric ones.
;	Integer expressions are read in the current radix (usually 10)
;
frange:	seto	t2,			;flag floating entry point
	skipa				;continue
ranges:	setz	t2,			;flag integer ranges
	stkvar	<savptr,nvals,exptyp>
	movem	t1,savptr		;save the pointer
	movem	t2,exptyp		;and expression type
	call	skpblk			;jump over blanks
	ildb	t2,t1			;get first non-blank
	caie	t2,"["			;start of range ?
	 jrst	[setz	t2,		;no, return no args
		move	t1,savptr	;restore original pointer
		retskp]			;return success
	hrlzi	t4,-3			;initialize count
rangl:	skipe	exptyp			;integer expression ?
	 jrst	[push	p,t4			;save ac
		call	fltexp		;no, floating one
		 jrst	[pop	p,t4		;which failed
			jrst	range1]	
		jrst	rangc]		;or succeeded
	push	p,t4			;save ac
	call	numexp			;parse first expression
	 jrst	[pop	p,t4
		jrst	range1]		;bad expression
rangc:	pop	p,t4			;restore
	movem	t2,vals(t4)		;save value of expression
	ildb	t2,t1			;get next byte
	caie	t2,":"			;should be ":" to separate
	 jrst	[cain	t2,"]"		;or failing that, end of range specs
		 jrst	[aoj	t4,1	;it is, fake extra pass in loop
			jrst	rang2]	;return OK
		jrst	rang3]		;it ain't, complain
	aobjn	t4,rangl		;ok, loop 3 times
rang2:	move	q1,vals			;get first value
	move	q2,vals+1		;and second
	move	q3,vals+2		;and third
	hrrz	t2,t4			;get number of args parsed
	retskp				;return success
rang3:	fatal	<bad range format: >
range1:	fatal	<bad numeric range>	;NUMEXP has complained - return failure
	purge	savptr,nvals,exptyp	;delete local symbols
	subttl	Numeric expression parsing - floating and integer
;
;	FLTEXP/NUMEXP - parse a numeric expression of the form
;	ID op ID op.... where ID is either a constant, variable or bracketed
;	expression, and op is one of "+","-","*","/" . We do NOT parse this
;	truly algebraically as no rules of operator precedence are applied.
;	Evaluation is simply left to right, and brackets must be used to overide
;	this. We use a separate parsing stack for this, to simplify exits if we
;	bomb out halfway through. We use a simple expression stack of the form:
;	TOP				BOTTOM
;	op val op val ...             op val.
;
;	which is unstacked on every ")". Initially we put 0 and "+" as the
;	current op and val, in case we get (1+2) or that.
;	Opcodes:
;	+:1 -:2 *:3 /:4
;	Floating numbers are rounded before use in integer expressions,
;	integers are rounded.
;	Integers are read in the current radix if an integer expression is
;	being parsed.
;	Input:	t1/Byte pointer to expression
;	Output:	t2/Value of expression
;
fltexp:	setom	fltint			;mark floating parse
	skipa				;and continue
numexp:	setzm	fltint			;indicate integer parsing
	move	p5,[iowd numsl,numstk]	;set up parsing stack
	setzm	cnval			;initialize current value of exp.
	movei	t2,addop		;and set current operator to +
	movem	t2,cnop
	setzm	numnst			;initialize nest level of brackets to 0
;
;	Come here to get number, symbol or "("
;
gval:	ildb	t2,t1			;get first byte of next bit
	caig	t2," "			;space ?
	 jrst	numext			;not a printer - exit if OK
	cain	t2,"("			;open bracketed expression ?
	 jrst	opnbrk			;yes - push parse stack
	call	isdgt			;OK, is it a digit ?
	 jrst	symevl			;no, evaluate as a symbol
	bkptr	t1			;yes, backup over first digit
	move	t3,radix		;read in current radix if integer
	skipe	fltint			;floating expression ?
	 setz	t3,			;yes, use default format input
	movx	t4,nin%			;assume integer input
	skipe	fltint			;is it ?
	 movx	t4,flin%		;no, must use floating
	xct	t4			;read the number
	 erjmp	numex1			;bad numeric format
	movem	t2,nval			;OK, we have val1
	bkptr	t1			;backup over first non-digit
	jrst	eval			;now evaluate current expression
symevl:	bkptr	t1			;we have a symbol - hopefully (may be ])
	move	t2,[point 7,scratch]	;bung symbol name here
	call	getwrd			;grab symbol name
	movem	t1,numptr		;save pointer value
	move	t1,[point 7,scratch]	;point to symbol
	call	leng			;and evaluate length
	skipn	t3			;was it zero ?
	 jrst	numex2			;yes, unknown symbol for mo - better ?
	hrroi	t1,scratch		;point to symbol name
	call	luksym			;attempt to look it up
	 jrst	[hrroi	t1,scratch	;failed - point again
		call	luksys		;and try for system symbol
		 jrst	numex2		;unknown
		jrst	symev1]		;succeed
	cain	t3,$flt			;is it floating point ?
	 jrst	[skipn	fltint		;yes, are we parsing floating numbers ?
		 fixr	t2,t2		;no, so fix and round it
		jrst	symev2]		;continue
symev1:	caie	t3,$num			;is it integer type ?
	 jrst	numex2			;no, so complain
	skipe	fltint			;yes, are we parsing integer expressions
	 fltr	t2,t2			;no, so float the number
symev2:	movem	t2,nval			;and save value
	move	t1,numptr		;restore pointer
	jrst	eval			;evaluate so far
opnbrk:	push	p5,cnval		;remember current exp value
	push	p5,cnop			;and curent operator
	aos	numnst			;bump nesting level
	setzm	cnval			;initialize current value of exp.
	movei	t2,addop		;and set current operator to +
	movem	t2,cnop
	jrst	gval			;get next value
clsbrk:	sosge	numnst			;drop nesting level, test for OK
	 jrst	badbrk			;bad parentheses
	pop	p5,cnop			;get old operator
	pop	p5,t2			;and old value
	exch	t2,cnval		;make current value
	movem	t2,nval			;and make current val second op
	jrst	eval			;get evaluated
;
;	here after obtaining a value or popping brackets - evaluate current
;	expression and get next operator
;
eval:	move	t2,cnop			;get current operator
	call	@optab(t2)		;dispatch to arithmetic routine
	ildb	t2,t1			;get next byte
	caige	t2," "			;printing character ?
	 jrst	numext			;no, try exit
	cain	t2,")"			;close bracket ?
	 jrst	clsbrk			;yes, pop parse stack
	cain	t2,"+"			;add ?
	 jrst	[movei	t2,addop	;yes, remeber operator
		movem	t2,cnop
		jrst	gval]
	cain	t2,"-"			;subtract ?
	 jrst	[movei	t2,subop
		movem	t2,cnop
		jrst	gval]
	cain	t2,"*"			;multiply ?
	 jrst	[movei	t2,mulop
		movem	t2,cnop
		jrst	gval]
	cain	t2,"/"			;divide ?
	 jrst	[movei	t2,divop
		movem	t2,cnop
		jrst	gval]
	jrst	numext			;none of these - try exiting expression
;
;	here at possible end of expression - check state of parse stack for
;	valid parentheses
;
numext:	skipe	numnst			;still nested ?
	 jrst	badbrk			;yes, complain
	move	t2,cnval			;yes,get expression value
	bkptr	t1			;nackup over the byte we don't want
	retskp				;return success
numex1:	fatal	<bad numeric constant: >,,mcall
numex2:	fatal	<unknown numeric symbol in expression:>
badbrk:	fatal	<Unmatched parentheses: >
numex4:	fatal	<non-numeric system symbol in numeric expression:>

;
;	arithmetic routines
;
nadd:	move	t3,nval			;get second operand
	move	t4,[addm t3,cnval]	;assume integer add
	skipe	fltint			;are we doing integer stuff ?
	 move	t4,[fadrm t3,cnval]	;no, so get a floating add
	xct	t4			;do whatever sort of add it is
	ret				;continue parse
nsub:	move	t3,cnval		;get first operand
	move	t4,[sub t3,nval]	;assume integer subtract
	skipe	fltint			;are we doing integer stuff ?
	 move	t4,[fsbr t3,nval]	;no, so get a floating subtract
	xct	t4			;do whatever sort of subtract it is
	movem	t3,cnval		;store result
	ret
nmul:	move	t3,nval			;get second operand
	move	t4,[imulm t3,cnval]	;assume integer multiply
	skipe	fltint			;are we doing integer stuff ?
	 move	t4,[fmprm t3,cnval]	;no, so get a floating multiply
	xct	t4			;do whatever sort of multiply it is
	ret
ndiv:	move	t3,cnval		;get dividend
	move	t4,[idiv t3,nval]	;assume integer divide
	skipe	fltint			;are we doing integer stuff ?
	 move	t4,[fdvr t3,nval]	;no, so get a floating divide
	xct	t4			;do whatever sort of divide it is
	movem	t3,cnval		;store result
	ret
	subttl	String expression parsing
;
;	This subroutine accepts, like numexp, a pointer in t1 to the
;	start of a string expression to be parsed. It calls NUMEXP, via
;	RANGES, when doing substring evaluation. It accepts string constants
;	of the form "asbdek", string variable names, like STREXP, and optional
;	range values on the variables: STREXP[1:23] . The numbers indicate
;	start and stop chop positions for a substring. The only operator is
;	"+" for concatenation.
;	Input:	t1/byte pointer to expression (parse stops on bad char)
;	Output:	t2/ Pointer to result of expression
;
strexp:	stkvar	<stxptr,qstrt,ssymvl>
	setzm	wrkstr			;initialize parsed string to null
	move	t2,[point 7,wrkstr]	;point to it
	movem	t2,stxptr		;initialize expression pointer
strelp:	ildb	t3,t1			;get a byte
	caie	t3,quote		; "?
	 jrst	ssymev			;no, must be a symbol
	movei	t2,quote		;get closing quote
	movei	t3,mslen		;maximum string length
	movem	t1,qstrt		;save start of string
	call	search			;search for matching quote
	skipge	t3			;found ?
	 jrst	strex1			;no - complain
	movem	t1,comptr		;save position in string of end
	move	t2,qstrt		;get start position
	movns	t3,t3			;make absolute limit
	jumpe	t3,strel1		;special for null string ""
	movei	t4,quote		;terminate on "
	move	t1,stxptr		;write to expression buffer
	sout%				;write quoted string
	 ercal	error
strel1:	ibp	t2			;bump past " in input
	movem	t1,stxptr		;save pointer position
	movem	t2,comptr		;and position to read from command
	jrst	getop			;get possible operator
ssymev:	bkptr	t1
	move	t2,[point 7,scratch]	;where to put symbol name
	call	getwrd			;get symbol name
	movem	t1,comptr		;save end of symbol
	hrroi	t1,scratch		;point to symbol name
	call	lukstr			;and lookup value in tables
	 jrst	[hrroi	t1,scratch	;not there - try system symbol
		call	luksys		;is it there ?
		 jrst	strex2		;not there - complain
		caie	t3,$str		;string type symbol ?
		 jrst	strex3		;no - complain
		hrroi	t2,sysval	;construct pointer to value
		jrst	.+1]		;OK - is there
	movem	t2,ssymvl		;remember string value (ie pointer)
	move	t1,comptr		;point to next byteof expression
	call	ranges			;check for possible substring stuff
	 ret				;bad range format
	movem	t1,comptr		;may have moved
	jumpe	t2,ssymnr		;if no ranges, jump over
	caie	t2,2			;if ranges, must be 2 and 2 only
	 jrst	bdsubs			;bad substring format
	move	t1,ssymvl		;get symbol value pointer
	call	cksubs			;check substring stuff is in range
	 jrst	bdsubs			;no - complain
	move	t2,ssymvl		;OK, point to string start
	adjptr	t2,q1			;start of substring
	bkptr	t2			;but ranges start at 1, so....
	move	t3,q2			;get end of range
	sub	t3,q1			;compute difference
	aoj	t3,			;add 1 'cos of 1/0 stuff
	movns	t3,t3			;make negative for absolute limit
	setz	t4,			;terminate
	move	t1,stxptr		;next bit of expression
	sout%				;write out
	 ercal	error
	idpb	t4,t1			;dump out extra null
	bkptr	t1			;and backup over it
	movem	t1,stxptr		;save pointer to result
	jrst	getop			;get possible operand
;
;	String symbol, no range specified
;
ssymnr:	move	t2,ssymvl
;	move	t2,[point 7,strings]
;	adjptr	t2,t3			;adjust to point to correct POOL byte
	move	t1,stxptr		;where we will put expression
	setzb	t3,t4			;termiate on null
	sout%				;write variable value
	 ercal	error
	movem	t1,stxptr		;remember where we got to
	jrst	getop			;get possible operand
;
;	Check for operand
;
getop:	move	t1,comptr		;point to command
	ildb	t2,t1			;get next char
	caie	t2,"+"			;is it "+" ?
	 jrst	strext			;no, exit
	movem	t1,comptr		;yes, grab next bit
	jrst	strelp			;got to it !!!
;
;	Check and exit
;
strext:	bkptr	t1			;back up over non-+
	move	t2,[point 7,wrkstr]	;where the result is
	retskp				;return success
;
;	errors in string parsing
;
strex1:	fatal	<mismatched " in string constant:>
strex2:	fatal	<unknown string symbol in expression:>
strex3:	fatal	<system symbol in string expression is not of type string:
>
bdsubs:	fatal	<substring limits invalid: >
	purge	stxptr,qstrt,ssymvl
	subttl	Symbol table manipulation
;=======================================================
;
;	These are the symbol table manipulation routines.
;	They provide code for entering symbols into the tables,
;	and performing table lookup. All are +1/+2 return type stuff,
;	and the usual convention is to have a byte pointer in t1 to the
;	symbol in ASCIZ, and have data returned in t2 (i.e. symbol value,
;	or pointer to symbol value.)
;
;=========================================================
;
;	entnum: enter a numeric symbol. t1- pointer to symbol name
;					t2 - symbol value
;
entnum:	movei	t3,$num			;type code of numeric symbols
	call	entval			;get entval to do the work
	 ret
	retskp
;
;	entflt: enter a floating symbol. t1- pointer to symbol name
;					t2 - symbol value
;
entflt:	movei	t3,$flt			;type code of real symbols
	call	entval			;get entval to do the work
	 ret
	retskp
;
;	luknum - lookup a numeric symbol - return +1 if not there, +2 if is
;	input: t1/Pointer to symbol name
;	output:	t2/ Value of symbol if it exists
;		t3/Position in table if exists
;
luknum:	movem	t1,t2
	call	luksym			;lookup the symbol
	 ret				;not there, return failure
	caie	t3,$num			;it exists - is it numeric ?
	 ret				;no, return failure
	move	t3,lukoff		;yes, return table address
	retskp				;and success
;
;	lukflt - lookup a real symbol - return +1 if not there, +2 if is
;	input: t1/Pointer to symbol name
;	output:	t2/ Value of symbol if it exists
;		t3/Position in table if exists
;
lukflt:	movem	t1,t2
	call	luksym			;lookup the symbol
	 ret				;not there, return failure
	caie	t3,$flt			;it exists - is it floating ?
	 ret				;no, return failure
	move	t3,lukoff		;yes, return table address
	retskp				;and success
;
;	Entlgc:	Enter logical symbol into table.
;	Input:	t1/Pointer to symbol name in ASCIZ
;		t2/0 - true, -1 - false
;	Calls	entval - general entry routine
;
entlgc:	movei	t3,$lgc				;address of logical table
	call	entval				;entval does the work
	 ret					;return failure
	retskp					;return success
;
;	LUKLGC:	Lookup logical symbol, return value
;	Input:	t1/	Pointer to symbol name
;
;	Output:	t2/	Symbol value if +2 return, else
;			+1 return, not found
;
;		t3/	Address in TBLUK table of entry
;
luklgc:	movem	t1,t2
	call	luksym			;lookup the symbol
	 ret				;not there, return failure
	caie	t3,$lgc			;it exists - is it logical ?
	 ret				;no, return failure
	move	t3,lukoff		;yes, return table address
	retskp				;and success
;
;	entstr - enter s string symbol into appropriate table
;
;	Input:	t1/	Pointer to symbol name
;		t2/	Pointer to symbol value
;	We have to do a bit of work with this one before we call entval
;
entstr:	stkvar	<ptr,strptr,strpos>
	setzm	sqzd			;indicate not squeezed yet
	movem	t1,ptr		;save name pointer
	movem	t2,strptr		;save value pointer also
	movei	t3,strspc		;max number of string chars
	camge	t3,nxtbyt		;already written that many ?
	 jrst	strful			;yes, BOMB
entst1:	move	t1,strptr		;pointer to string
	call	leng			;get string length
	skipge	t3			;string OK ?
	 jrst	[fatal	<string too long: >]
	move	t1,nxtbyt		;size of string buffers in use
	add	t1,t3			;what we want to add to it
	cail	t1,strspc		;will it overflow ?
	 jrst	[call	squeeze		;call garbage collector
		jrst	entst1]
	move	t1,nxtbyt		;get next byte in use
	movem	t1,strpos		;where string will be written
	move	t1,[point 7,strings]	;point to strings
	adjptr	t1,nxtbyt		;and now point to free store
	addm	t3,nxtbyt		;OK, bump amount of storage in use
	aos	nxtbyt			;add on null byte
	move	t2,strptr		;get string itself
	setzb	t3,t4			;write until null byte
	sout%				;write string
	 ercal	error			;crash
	move	t1,ptr			;ask ENTVAL to put it in
	move	t2,strpos
	movei	t3,$str
	call	entval
	 ret			;return failure
	retskp			;return success
	purge	strpos,ptr,strptr
;
;	Lookup string symbol
;	Input:	t1/ Pointer to symbol name
;
;	Output:	t2/ Pointer to symbol value if +2 return
;		t3/ Position in symbol table if +2 return
;
;	+1 return: Symbol not found
;
lukstr:	movem	t1,t2			;put pointer in right place
	call	luksym			;lookup the symbol
	 ret				;not there, return failure
	caie	t3,$str			;it exists - is it string ?
	 ret				;no, return failure
	move	t3,lukoff		;yes, return table address
	move	t4,t2			;get byte number where string starts
	move	t2,[point 7,strings]	;point at string table
	adjptr	t2,t4			;and adjust to point to relevant byte
	retskp				;return success
;
;	entlab - enter a label into table
;	t1 - byte pointer to label name
;	t2 - byte number in file to associate with it
;
entlab:	stkvar	<labnam,labbyt>
	movem	t1,labnam
	movem	t2,labbyt
	call	luklab			;look it up
	 skipa				;not there - put it in
	retskp				;there - ignore it
	move	t1,labnam
	move	t2,labbyt
	movei	t3,$lab			;include type code
	call	entval			;enter value
	 ret				;fail
	retskp				;succeed
	purge	labnam,labbyt
;
;	luklab - lookup label i symbol table +1/+2 return
;	input:	t1/Byte pointer to label name
;	Output:	t2/ Value of label
;		t3/ Position in symbol table
;
luklab:	movem	t1,t2
	call	luksym			;lookup the symbol
	 ret				;not there, return failure
	caie	t3,$lab			;it exists - is it label ?
	 ret				;no, return failure
	move	t3,lukoff		;yes, return table address
	retskp				;and success
;
;	LUKFIL - lookup file symbol in table, return JFN
;	In:	t1/ Pointer to symbol name
;	Out:	t2/ JFN
;		t3/ Table address
;
lukfil:	movem	t1,t2
	call	luksym			;lookup the symbol
	 ret				;not there, return failure
	caie	t3,$fil			;it exists - is it file ?
	 ret				;no, return failure
	move	t3,lukoff		;yes, return table address
	retskp				;and success
;
;	ENTFIL - enter file symbol.
;	t1/ Pointer to symbol name
;	t2/ JFN
;
entfil:	movei	t3,$fil		;address of table
	call	entval			;enter it
	 ret				;fail
	retskp				;succeed
;
;	LUKSYS - lookup a system symbol
;	Input:	t1/	Pointer to symbol name in ASCIZ
;	Returns: +1: Symbol does not exist
;		 +2: Symbol exists, with
;	Output:	t2/ Value of symbol (Text string or immediate)
;		t3/Symbol type code
;
luksys:	movem	t1,t2			;put name in right place
	movei	t1,syssym		;address of table
	tbluk%				;try a lookup
	 ercal	error			;tables trashed
	txnn	t2,tl%exm		;exact match ?
	 ret				;no, return failure
	hrrz	t3,(t1)			;yes, get table entry
	push	p,t3			;save entry for use by caller
	hrrz	t3,(t3)			;make routine address
	call	(t3)			;call the routine
	pop	p,t3			;get back old copy of entry
	hlrz	t3,(t3)			;and leave the symbol type behind
	txz	t3,$wrt			;clear out read/write bit
	move	t2,sysval		;get value of symbol
	cain	t3,$str			;string type symbol returned ?
	 hrroi	t2,sysval		;yes, must return pointer to symbol
	retskp				;return success
;
;	Entval : Enter a general symbol into table, placing value in
;	there also.
;	Input:	t1/	Pointer to synbol name in ASCIZ
;		t2/	Value of symbol or stuff for left half of TBLUK entry.
;		t3/	Table type code
;	+1/+2 return
;
entval:	stkvar	<namptr,value,tabnam>
	movem	t1,namptr
	movem	t2,value		;save arguments
	movem	t3,tabnam		;save table name
	move	t1,t3			;tabel address
	move	t2,namptr		;name of symbol
	call	$askchk			;check if symbol is in other table
	 jrst	[fatal	<Symbol to be assigned is already of another type: >]
	move	t1,namptr		;get pointer to name
	call	leng			;get length of name
	jumple	t3,[fatal <No name for symbol: >] ;zero, something wrong
	movei	t1,symbols		;point to symbol tables
	move	t2,namptr		;and pointer to name
	tbluk%				;symbol already there ?
	 ercal	error			;tables crapped up
	txnn	t2,tl%exm		;well ?
	 jrst	entvl1			;no, put it in properly
	move	t2,value		;yes, just put new value in
	hrrz	t1,(t1)			;yes, so get address of value entry
	move	t3,tabnam		;get the type code
	came	t3,symvals(t1)		;and check that it matches current type
	 jrst	[fatal <Internal error - symbol to be updated is of wrong type>]
	movem	t2,symvals+1(t1)	;and store the new value in place
	retskp				;return success
entvl1:	move	t3,tabnam		;get symbol type code
	move	t2,symuse(t3)		;get number of entries of that type used
	caml	t2,symmax(t3)		;less than maximum allowed ?
	 jrst	[fatal <Attempt to define too many variables of one type: >] ;no
	aos	symuse(t3)		;yes, so increment symbols in use
	sosge	free			;decrement number of entries in strings
	 jrst	strful			;string space full - crash
	call	entplc			;find where to write next entry
	 ret				;failed - internal error
	call	valslt			;find where to put next value
	 ret				;failed, internal error
	move	t1,nxtval		;offset for value slot to use
	move	t2,tabnam		;get type code
	movem	t2,symvals(t1)		;store that
	move	t2,value		;get value of new symbol
	movem	t2,symvals+1(t1)	;store that too
	movei	t3,symtab		;address of string storage
	add	t3,nxtsym		;offset to next entry
	hrro	t1,t3			;make byte pointer
	move	t2,namptr		;point to name string
	movei	t3,9			;maximum of 9 bytes
	setz	t4,			;terminate on null
	sout%
	 ercal	error
	setz	t2,			;grab a null byte
	idpb	t2,t1			;and bung that at the end
	movei	t1,symbols		;now bung the TBLUK entry in
	movei	t2,symtab		;address of string table
	add	t2,nxtsym		;where we put the entry
	hrlzs	t2,t2			;put in left half
	hrr	t2,nxtval		;and put value pointer in left half
	tbadd%				;enter into table
	 erjmp	tberr			;table error - report
	movei	t1,2			;its now safe to update the table entry
	addm	t1,nxtsym		;to reflect the new string
	addm	t1,nxtval		;point to next value slot
	retskp				;return success
	purge	namptr,tabnam,value

;
;	tabel error routines
;
strful:	fatal	<No space for variable name>,,,nocmd
tberr:	fatal	<symbol table full>,,mcall,nocmd

;
;	LUKSYM - lookup a general symbol.
;	Input t1/ Pointer to ASCIZ symbol name
;	Returns: +1: Symbol not defined
;		 +2: Symbol defined, t2/ value of symbol
;				      t3/ Type code for symbol
;
luksym:	movem	t1,t2		;save pointer to name
	movei	t1,symbols		;point to symbol table
	tbluk%				;try for a lookup
	 erjmp	[fatal <Internal error: Corrupt symbol table>,stop,js]
	txnn	t2,tl%exm		;exact match ?
	 ret				;no, return failure
	hrrz	t2,(t1)			;yes, retrieve value pointer
	movem	t1,lukoff		;store table offset for those interested
	move	t3,SYMVAL(t2)		;get symbol type code
	move	t2,symvals+1(t2)	;get symbol value
	retskp				;return success
	subttl	ENTPLC - find next place to write a symbol name
;
;	This routine is called to return the address for writing the next symbol
;	Usually we just add the contents of NXTSYM to address SYMTAB and use it.
;	If much purging has been done, however, the table may be full at the end
;	but should contain empty slots earlier on. We try to find these, and
;	return +2 with NXTSYM updated.
;
entplc:	movei	t1,symtab		;address of symbol name space
	add	t1,nxtsym		;address to write next symbol
	cail	t1,symtab+2*symtot	;off end of space ?
	 jrst	entpls			;yes, so scan for empty slot
	skipn	(t1)			;no, is slot free ?
	 retskp				;yes, so return OK
entpls:	movei	t3,symtot	;ok, set up for maximum scans
	aos	exsrch			;increment exhaustive search count
entpll:	addi	t1,2			;increment pointer to next name slot
	cail	t1,symtab+2*symtot	;off end of table ?
	 movei	t1,symtab		;yes, wrap round to start
	skipn	(t1)			;is this slot free ?
	 jrst	entple			;yes, return address
	sojn	t3,entpll		;no,  so loop to next entry
	fatal	<Internal error - no zero name slot when all should be free>,stop,,nocmd
entple:	subi	t1,symtab		;ok, construct the right NXTSYM value
	movem	t1,nxtsym		;store it
	retskp				;and return success
	subttl	VALSLT - find next value slot
;
;	This routine is called when creating a new variable to discover
;	the next slot to use in the values and types table. Usually we just
;	use the next available, but in some circumstances there may be scattered
;	slots throughout the list. We then have to do an exhaustive search.
;
valslt:	movei	t1,symval		;address of value tables
	add	t1,nxtval		;point to apparent free slot
	cail	t1,symval+2*symtot	;off end of values space ?
	 jrst	valsrc			;yes, so must search for free slot
	skipn	(t1)			;is it free (IE zero type code)?
	 retskp				;yes, so all is well
valsrc:	movei	t2,<symtot-1>*2		;number of values stored
valsr1:	skipn	symval(t2)		;is this entry free ?
	 jrst	valsfn			;yes, so remember it
	soj	t2,			;no, so skip back...
	sojn	t2,valsr1		;and examine the previous entry
	fatal <Internal error: no slot for symbol value when one should be free>
valsfn:	movem	t2,nxtval		;store offset for new value code
	retskp				;return success
	subttl	DELVAL - delete a symbol from a table
;
;	This routine is called to delete a symbol completely from the specified
;	table. It also removes the name from the name space, leaving compression
;	out. Values (such as string values) are not removed from the pool, an
;	operation which is left to he garbage collector.
;	Accepts:	t1/ Pointer to symbol name
;
delval:	stkvar	<namptr,tabent>
	movem	t1,namptr	;save name of argument
	exch	t1,t2		;swap address and pointer
	movei	t1,symbols	;point to symbol table
	tbluk%			;is entry in table ?
	 ercal	error		;tables crapped up
	txnn	t2,tl%exm	;well, is it there ?
	 jrst	[fatal	<Internal error PURGE of non-existent symbol>,stop] ;no
	move	t2,(t1)		;get the current contents of the entry
	movem	t2,tabent	;and save them
	move	t2,t1		;get address of entry to delete
	movei	t1,symbols	;now prepare to delete the entry
	tbdel%			;from the lookup table
	 ercal	error		;should not fail
	hlrz	t1,tabent	;get address where symbol name was
	setzm	(t1)		;zero it for later use
	aos	free		;one more free entry in symbol table names
	hrrz	t1,tabent	;get address of value/type slot for symbol
	move	t2,symval(t1)	;get type code
	setzm	symval(t1)	;zero type code slot
	setzm	symval+1(t1)	;and value slot for later use
	sos	symuse(t2)	;decrement usage for this symbol type
	ret			;back to friendly caller
	purge	namptr,tabent

IFN	<logg>,<
	SUBTTL	Record username
;
;	This routine makes a record of all users of IND
;
record:	stkvar	recjfn
	movx	t1,gj%sht!gj%old
	hrroi	t2,lfnam		;point to name of logging file
	GTJFN%
	 erjmp	recerr
	movem	t1,recjfn
	movx	t2,fld(7,of%bsz)!of%app
	openf%
	 erjmp	recerr
	hrroi	t2,[asciz/ 
User /]
	setzb	t3,t4
	sout%
	 erjmp	recerr
	gjinf%
	movem	t1,t2
	move	t1,recjfn
	dirst%
	 erjmp	recerr
	hrroi	t2,[asciz / at /]
	setzb	t3,t4
	sout%
	 erjmp	recerr
	seto	t2,
	setz	t3,
	odtim%
	 erjmp	recerr
	hrroi	t2,[asciz / file /]
	setzb	t3,t4
	sout%
	 erjmp	recerr
	move	t2,comjfn		;get command file jfn
	movx	t3,1b2!1b5!1b8!1b11!1b14!js%paf ;write all fields
	setz	t4,
	jfns%
	 erjmp	recerr
	closf%
	 erjmp	recerr
	ret 
recerr:	tmsg	<
%User logfile write failed, please inform KEVIN:>
	call	errmes
	ret>
	subttl	COMND - related routines
;
;	These are routines to initialize the COMND state blocks and
;	to parse things sucj as noise phrases and confirms.
;
;
;	Once-only routine to initialize comnd state blocks
;

cmdset:	HRROI T1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM T1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEM T1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE PRIMARY JFN'S
	SETZM CMDBLK+.CMINC	;INITIALIZE # OF CHARACTERS AFTER POINTER
	movei	t1,gjfblk	;point to GTJFN block
	movem	t1,cmdblk+.cmgjb	;store pointer
	MOVEI T1,BUFSIZ*NCHPW	;GET # OF CHARACTERS IN BUFFER AREA
	MOVEM T1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	HRROI T1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI T1,ATMSIZ*NCHPW	;GET # OF CHARACTERS IN ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABC	;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
	ret


; INVALID END-OF-COMMAND

CFMERR:	CALL TSTCOL		;TEST COLUMN POSITION
	TMSG <?Not confirmed>				;OUTPUT ERROR MESSAGE
	RET			;RETURN TO WHENCE WE CAME ...
SUBTTL	COMND PARSING SUBROUTINES

; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL:		CALL ENDCOM
; RETURNS: +1	 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
;	   +2	SUCCESS, COMMAND CONFIRMED

ENDCOM:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
	COMND			;PARSE CONFIRMATION
	 ercal error		;error, go check for eof on take file
	TXNE T1,CM%NOP		;VALID END-OF-COMMAND SEEN ?
	JRST [ CALLRET CFMERR ]	;NO, ISSUE ERROR MESSAGE AND RETURN
	RETSKP			;SUCCESS, RETURN


; ROUTINE TO PARSE NOISE PHRASE
;
; CALL:	T2/ POINTER TO NOISE PHRASE
;		CALL SKPNOI
; RETURNS: +1	 ERROR, INVALID NOISE PHRASE
;	   +2 	SUCCESS, NOISE PHRASE PARSED OK

SKPNOI:	MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
	SETZM NOIFDB		;CLEAR FIRST WORD OF BLOCK
	BLT T1,NOIFDB+FDBSIZ-1	;CLEAR FUNCTION DESCRIPTOR BLOCK
	MOVX T1,.CMNOI		;GET FUNCTION TO PERFORM
	STOR T1,CM%FNC,NOIFDB	;STORE FUNCTION CODE IN FDB
	MOVEM T2,NOIFDB+.CMDAT	;STORE POINTER TO NOISE PHRASE IN FDB
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,NOIFDB		;GET ADDRESS OF FUNCTION BLOCK
	COMND			;PARSE NOISE WORD
	 ercal error		;error, go check for eof on take file
	TXNN T1,CM%NOP		;NOISE PHRASE PARSED OK ?
	RETSKP			;YES, RETURN SUCCESS
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	HRROI T1,[ASCIZ/Invalid guide phrase/]
	ret
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/	POINTER TO ASCIZ PROMPT STRING
;		CALL CMDINI
;RETURNS: +1 ALWAYS,	WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
;			CALL TO CMDINI.


CMDINI:	MOVEM T1,CMDBLK+.CMRTY	;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
	CALL CLRGJF		;GO CLEAR GTJFN BLOCK
	POP P,SAVRET		;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
	MOVEM P,SAVREP		;SAVE STACK POINTER TO BE RESET ON REPARSE
	MOVEI T1,REPARS		;GET ADDRESS OF REPARSE ROUTINE
	txo	t1,cm%wkf!cm%xif	;wake on every field, no indirect files
	MOVEM T1,CMDBLK+.CMFLG	;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
	COMND			;INITIALIZE COMMAND SCANNER JSYS
	 ercal error		;ERROR, GO SEE IF END OF "TAKE FILE"
	JRST @SAVRET		;RETURN


; HERE TO PROCESS A REPARSE

REPARS:	MOVE P,SAVREP		;RESET STACK POINTER
	JRST @SAVRET		;RETURN TO CALLER OF CMDINI

; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL:		CALL CLRGJF
; RETURNS: +1 ALWAYS

CLRGJF:	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
	SETZM GJFBLK		;CLEAR FIRST WORD OF BLOCK
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR GTJFN BLOCK
	RET			;RETURN TO WHENCE WE CAME ...
	subttl	EXEC handler - lifted from CRCMD en mass.
;
;	This subroutine has been taken direct from the CRC subroutine library.
;	We need it here because we need to access some of its internal variables
;	such as the fork handle of its inferior EXEC.
;
;
;	The program is called from fortan as below :
;
;	call	crcmd('print file.dat/forms:la1',flags,jserr)
;
;	from macro , pass a byte pointer in t1
;	a flag word in t2, jsys error returned in t3
;
;	The meaning of the flag word is as follows:
;	0	Do nothing unusual
;	b35 (1)	Use MEXEC instead of EXEC
;	b34 (2)	Allow echoing of commands
;	b33 (OBSOLETE) (4)
;		Do not release EXEC fork- freeze it, and check for existing
;		fork on reentry
;	b32 (8)	Do not pass command to EXEC - merely run it and WFORK.
;	b31 (16) Allow COMAND.CMD to be executed
;	The strategy is to get the EXEC in a lower fork (natch), clear
;	the input buffer, wait till output finishes, and lock the keyboard
;	(send ^s). We then rename COMAND.CMD to COMAND.crcmd (to stop it
;	being executed) and do STIs to get the stuff in, followed by a POP.
;	We do a DIBE to wait for the time to put the POP in, and then WFORK.
;	It may be necessary to do a KFORK after we give the command, to prevent
;	errors in the command from clearing our typeahead.
;
	define	db(code),<ifdef	$dbg,<code>>
;	$dbg==0
;	c$cmd==20			;COMAND.CMD no rename
	cr==15
	lf==12
;
;	PRARG argument block for EXEC
;
prargb:	4			;number of words in block
	1b0+3b6+2b12+cr%pra	;crjob prarg block
	1b0+4
	1b0+5
	1b0
	0
	prblen==6
$crcmd:	stkvar	<cmdjfn,cmdptr,flgs,excjfn,exchnd>
	movem	t1,cmdptr		;save pointer
	movem	t2,flgs			;save flgs
	setzm	exchnd
	setzm	cmdjfn
	setzm	excjfn			;zero before use !!
	skipn	efork		;got a frozen fork ?
	 jrst	cont		;no, thanks
	move	t1,ttydes		;Yes, so Point at TTY buffer
	dobe%				;wait for output to finish
	 erjmp	crerr
cont:	move	t2,flgs			;give flag word
	call	mapexc			;get hold of a fork and an EXEC
	 jrst	crerr			;error return
	movem	t1,excjfn		;save EXEC jfn
	movem	t2,exchnd		;and fork handle
	move	t1,flgs			;get flag word
	txne	t1,p$ush		;a PUSH-type command wanted ?
	 jrst	push			;yes, just do that then
db	<tmsg	<
%Simulating command input>>
	move	t1,ptyjfn		;Look at PTY
	dibe%				;wait until input buffer empties too
	move	t2,cmdptr		;retrieve command pointer
	move	t1,ptyjfn		;Point at pseudo-terminal
	setzb	t3,t4			;terminate on null
	sout%				;write to PTY
	movei	t2,cr			;get carriage return
	bout%				;input also
push:	skipe	efork			;continuing frozen fork ?
	 jrst	[db	<tmsg	<
%Resuming frozen fork>>
		move	t1,exchnd	;Get exec's handle
		rfork%			;resume it
		 ercal	error
		call	tsfork		;test if we need an SFORK%
		jrst	crwait]		;wait for denoument
db	<tmsg	<
%Starting EXEC at entry vector>>
	move	t1,exchnd		;get the EXEC handle
	setz	t2,			;start at START
	sfrkv%				;commence at normal entry vector
	 erjmp	crerr
crwait:	move	t1,flgs			;get flags
	txne	t1,p$ush		;PUSH wanted ?
	 jrst	[db	<tmsg	<
%Push and WFORK%>>
		move	t1,exchnd	;yes, get handle we just created
		skipe	efork
		 move	t1,efork	;or a frozen one, if we have it
		wfork%			;and wait for the EXEC
		jrst	crfin]		;it has POPped !
db	<tmsg	<
%DIBE/SIBE pair>>
	move	t1,ttydes		;Get terminal number of inferior's priin
	sibe%				;skip if already empty
	dibe%				;and dismiss until input buffer empty
crcm3:	move	t1,ttydes
	subi	t1,.ttdes		;Remove terminal designator code
	hrlzs	t1			;put in left half of ac
	hrri	t1,.ttyjob		;put TTYJOB table number in right half
	getab%				;now, examine table
	 ercal	error
	hrres	t1,t1			;extend right half
	came	t1,[-1]			;is some process waiting for input ?
	 jrst	crfin			;yes, probably inferior EXEC
	movei	t1,^d1000		;no, but input is empty.
	disms%				;so wait a second...
	jrst	crcm3			;and try again
;
;	at this point, the input buffer is empty. This means that the EXEC has
;	read our commmand, executed it, and read the following linefeed. Thus,
;	Alternatively, we have done a PUSH, and the EXEC has done a POP.
;
crfin:	getnm%				;read program name that was being used
	movem	t1,infnam		;and save for next command
	move	t1,sysnm		;get our old name
	setnm%				;set it
	setz	t3,			;indicate no errors
	move	t1,exchnd		;get handle again
	ffork%				;freeze it.
	 ercal	error
	move	t2,flgs			;get flags
	skipn	efork			;yes, got one ?
	 movem	t1,efork	;remember newly acquired fork
	setzm	waspsh
	txne	t2,p$ush		;did we do a push ?
	 setom	waspsh			;yes, indicate that next call must SFORK
fgo:	db	<txne	t2,p$ush
	 jrst	[tmsg	<
%Exec was pushed - setting flag>
		jrst	.+1]>
	ret				;and return success
;
;	This subroutine maps the EXEC into an appropriate fork
;	It also sends the PRARG block to the fork
;	called	with t2=flags
;	If frozen fork desired, and already have one, don't map
;	Returns +1 error, +2 success with t1=JFN of EXEC, t2=fork handle
;
mapexc:getnm%				;get our program name
	movem	t1,sysnm		;save it
	move	t1,infnam		;get name inferior was using
	setnm%				;and set that for its own use
db	<skipe	efork
	 jrst	[tmsg	<
%Already have a fork - not mapping a new one>
		jrst	.+1]>
	skipe	t2,efork		;yes, got one already ?
	 retskp			;yes, ta very much
db	<tmsg	<
%mapping new EXEC>>
	movx	t1,cr%cap	;leave out that frozen trash - give me a FRESH fork with my caps !
	cfork%				;create a fork
	 erjmp	[ret]
	movem	t1,t4			;save handle
	movx	t1,gj%sht+gj%old	;old file
	hrroi	t2,[asciz/SYSTEM:EXEC.EXE/]	;which is the EXEC
	txne	f,m$exec		;MEXEC required ?
	 hrroi	t2,[asciz/SYS:MEXEC.EXE/]	;yes
	gtjfn%				;get a handle
	 erjmp	[ret]			;return failure
	movem	t1,t3			;save JFN
	hrl	t1,t4			;place fork handle with JFN
	get%				;map the EXEC to the fork
	 erjmp	[ret]			;fail return
	move	t1,t4			;get fork handle
	hrli	t1,.prast		;set arguments
	movei	t2,prargb		;address of argument block
	push	p,t3
	movei	t3,prblen		;length of arg block
	prarg%				;specify argument block
	 erjmp	[ret]			;failure
	movei	t1,.fhslf		;now discover our capabilities
	rpcap%				;read them
	 erjmp	[ret]
	txz	t2,sc%log		;make LOGOUT impossible
	txz	t3,sc%log		;and don't enable it
	move	t1,t4			;get the fork handle
	txnn	f,logout		;do they want logout turned on ?
	epcap%				;no, set the EXEC's capabilities
	 erjmp	[ret]
	call	settt			;Set up TTY as controlling terminal
	pop	p,t3			;restore ac
	move	t2,t4			;place returned arguments in correct 
	move	t1,t3
	retskp				;return success
;
;	SETTT - set up TTY as controlling terminal of inferior fork.
;	Preserves all acs. Fork handle supplied in ac4
;
settt:	push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4
	hrroi	t1,wrkstr	;now get the device name
	move	t2,ttydes	;Of the tty of the PTY
	devst%			;with this JSYS
	 ercal	error
	movei	t2,":"		;no colons are provided
	idpb	t2,t1		;so we must supply one ourselves
	setz	t2,		;together with a trailing null
	idpb	t2,t1		;to make an ASCIZ string
	hrroi	t2,wrkstr	;which we can then give to GTJFN%
	movx	t1,gj%sht!gj%old ;in order to get a JFN for OPENF%
	gtjfn%			;grab JFN
	 ercal	error
	movem	t1,ttyjfn	;save for later releasing
	movx	t2,fld(7,of%bsz)!of%rd!of%wr ;now open for read
	openf%
	 ercal	error
	hrls	t1		;Copy right half to left half jfn
	move	t2,t1		;Place input,,output jfns
	move	t1,t4		;for inferior fork
	spjfn%			;set them
	 ercal	error
	pop	p,t4
	pop	p,t3
	pop	p,t2
	pop	p,t1
	ret
;
;	Test is subsidiary is halted, and if so, SFORK it
;
tsfork:
db	<skipn	waspsh
	 jrst	[push	p,t1
		tmsg	<
%Exec was not pushed last time>
		pop	p,t1
		jrst	$db1]
	push	p,t1
	tmsg	<
%Exec was pushed last time>
	pop	p,t1
$db1:>
	skipn	waspsh			;pushed last time ?
	 ret				;no, just return
	movem	t1,t3			;save fork handle
	movei	t1,^d500		;1/2 second
	disms%
	move	t1,t3			;get handle again
	rfsts%				;read fork status
db	<push	p,t1
	push	p,t2
	push	p,t3
	movem	t1,t2
	movei	t1,.priou
	movx	t3,^d10
	nout%
	 erjmp	[jshlt]
	tmsg	< was Fork status
>
	pop	p,t3
	pop	p,t2
	pop	p,t1>
db	<tmsg	<
%Continuing EXEC>>
	move	t1,t3			;yes, get handle
	txo	t1,sf%con		;mark for continue
	sfork%				;start
db	 <erjmp	[tmsg <
%Error from SFORK>
		jrst	.+1]>
	 erjmp	.+1			;ignore error - process ws never started
	ret
;
;	errors come here
;
crerr:
	movei	t1,.fhslf		;us
	geter%				;get the error code
	hrrz	t3,t2			;place in t3
	ret				;and return
	subttl	Garbage collector for string storage
;
;	This routine is called from ENTSTR whenever a new string would drop off 
;	the end of the string pool. Its operation is extremely primitive. As the
;	string pool contains no back pointers (ie symbol names point to symbol
;	values, but not vice versa) we just reconstruct the entire thing from
;	scratch, using symbol table pointers and a second copy of the pool.
;	When entered, we set a flag to say we have been. If this flag is set on
;	entry, we consider it an error. It is the rsponsibility of the calling
;	routine to clear the flag to prevent recursion.
;
squeeze:	skipe	sqzd		;already squezed ?
	 jrst	[fatal	<string space exhausted: recursive call to SQUEEZE.>,stop]
	stkvar	<onxbyt,scptr,sval,savq1>
	aos	nsqzd			;increment times called
	movem	q1,savq1		;save non-scratch AC
	setom	sqzd			;mark entry has occurred
	move	t1,nxtbyt		;get value of next free byte
	movem	t1,onxbyt		;remeber it
	setzm	nxtbyt			;zero out in preparation
	hlrz	q1,symbols		;number of symbols of all types defined
	movns	q1,q1			;negate
	hrlz	q1,q1			;put in left half
	hrri	q1,symbols+1		;make aobjn pointer with first table ent
	hrroi	t1,strcpy		;point to string copies
squez1:	move	t2,[point 7,strings]	;point to strings
	hrrz	t3,(q1)			;get value pointer for this symbol
	move	t4,symval(t3)		;get symbol type code
	caie	t4,$str			;is it string ?
	 jrst	sqnstr			;no, so leave it alone
	move	t3,symval+1(t3)		;yes, so get its start byte
	adjptr	t2,t3			;construct pointer
	movem	t2,sval			;save pointer to source
	setzb	t3,t4			;write until null
	sout%				;move to copy space
	 ercal	error
	ibp	t1			;bump output past null
	movem	t1,scptr		;save output pointer
	move	t2,nxtbyt		;this is where we wrote the string
	hrrz	t3,(q1)			;get address for value slot
	movem	t2,symval+1(t3)		;and store new value for string address
	move	t1,sval			;get pointer to string we just wrote
	call	leng			;discover length
	aoj	t3,			;add on null byte
	addm	t3,nxtbyt		;increment space used
	move	t1,scptr		;reget output pointer
sqnstr:	aobjn	q1,squez1		;loop through table
	move	t1,[strcpy,,strings]	;from,,to
	blt	t1,strings+<strspc/5>-1	;transfer strings back to where they 
	move	q1,savq1		;came from, restore acs
	ret
	subttl	String handling routines
;===========================================================
;
;	These are the general string-handling routines. They generally
;	accept a byte pointer to a source string in t1.
;
;	LENG - computes length of ASCIZ string
;		byte pointer in t1
;		length returned in t3 - -1 if more than 256 chars
;
leng:	setz	t2,		;tell SEARCH to look for null
	movei	t3,^d256	;max length acceptable
	call	search		;get search to do the work
	ret
;
;	SEARCH - byte pointer in t1
;		character to search for in t2
;		Maximum length in t3 (terminated on null also)
;
;	Returns:	Updated pointer in t1
;			Position in t3, or -1 if not found.
;
search:	movns	t3,t3		;negate count
	hrlz	t3,t3		;place in left half,use right half for count
	makhdw	t1		;ensure hardware format byte pointer
searc1:	ildb	t4,t1		;get byte
	camn	t4,t2		;character desired ?
	 jrst	searc4		;yes, exit
	jumpe	t4,searc3	;null, exit with not found
	aobjn	t3,searc1	;increment count, and loop if not all done
;
;	If here, then we have found a null or dropped offf end without target
;
searc3:	seto	t3,		;indicate not found
	ret			;return
searc4:	hrrzs	t3,t3		;throw away index, leave character position
	ret			;return
	
;
;	getwrd - removes next word from string.
;	accepts pointer in t1 to input string,
;		pointer in t2 to area to output ASCIZ word.
;
getwrd:	makhdw	t2		;force hardware byte pointers
	ildb	t3,t1		;get next byte
	cain	t3,"$"		;check for allowed special chars: $,<,>,=
	 jrst	getwr2		;yes, is $
	cain	t3,"<"
	 jrst	getwr2		;yes, is "<"
	cain	t3,">"		;yes, is "<"
	 jrst	getwr2
	cain	t3,"="
	 jrst	getwr2		;ok,is "="
	caig	t3,"/"		;at least numeric ?
	 jrst	getwr1		;no, end of word
	txo	t3,40		;ok, safe to force lower case
	caile	t3,"z"		;not a funny char ?
	 jrst	getwr1		;funny char
	caig	t3,"9"		;numeric ?
	 jrst	getwr2		;definitely - Ok
	caig	t3,"@"		;in between number and letter ?
	 jrst	getwr1		;yes - end of word
getwr2:	idpb	t3,t2		;no, dump character
	jrst	getwrd		;and get next
getwr1:	setz	t3,		;get a null byte
	idpb	t3,t2		;dump that too
	bkptr	t1		;backup pointer to valid byte
	ret			;return
;
;	isdgt - called with character in t2, returns +2 if digit, else
;	+1
;
isdgt:	cain	t2,"-"			;minus sign ?
	 retskp				;yes, OK
	cain	t2,"."			;decimal point ?
	 retskp				;yes, that's OK too
	caige	t2,"0"			;at least 0 ?
	 ret				;nope
	caile	t2,"9"			;at most 9 ?
	 ret				;nope
	retskp				;yes
;
;	skpblk - skips over blanks and tabs
;	byte pointer to string in t1
;
skpblk:	ildb	t2,t1			;get next byte
	jumpe	t2,skpbl1		;return on null
	cain	t2," "			;space ?
	 jrst	skpblk			;yes
	cain	t2,"	"		;tab ?
	 jrst	skpblk			;yes
skpbl1:	bkptr	t1			;backspace byte pointer
	ret				;and return
;
;	ASCSIZ - accepts byte pointer in t1 to ascii string, encodes
;	6 chars into SIXBIT word in t2
;
ascsix:	setz	t2,			;zero out SIXBIT word
	movei	t4,6			;initialize loop count
ascsi1:	ildb	t3,t1			;get byte
	subi	t3,40			;convert to sixbit
	skipge	t3			;still a character ?
	 setz	t3,			;no, convert to space
	lsh	t2,6			;shift current word six bits left
	or	t2,t3			;and in extra byte
	sojg	t4,ascsi1		;loop six times
	ret				;back to caller

	xlist				;store literals, but don't listem
literl:	LIT				;store literals here
	list
;
;	Display size of pure section
;
	radix 5+5
	define	showp(size,pag),<printx	*	Shareable data/code storage = size words (pag pages) + external routines>

if1,	<$$tmp==1
	ife <<.-$$pure>&^o777>,<$$tmp==0>
	showp	\<.-$$pure>,\<<<.-$$Pure>/^d512>+$$tmp>>
	radix 8
	end	<3,,entvec>