Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/crc/ind/v2ind.mac
There are no other files named v2ind.mac in the archive.
;<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
;<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 -
;<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
;<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
;	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
;<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

     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....
	search	vtmac,indsym
	.request	inderr		;request subroutine libraries
	external	errmes,error	;for these routines
	internal	tstcol		;used by error routines

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

	m$exec==1		;mexec bit for CRCMD
	f$reez==4		;freeze but for CRCMD
	e$cho==2		;echo bit for CRCMD
	p$ush==8		;PUSH bit for CRCMD
	c$cmd==20		;COMAND.CMD bit
	l$gout==40		;Lower fork LOG capability bit
	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		; :		:
	ptychn==2		;channel for PTY interrupts
	frkchn==0		;inferior fork interrupts
	ptysiz==^d100		;size of PTY output buffer
	mswrd==<mslen/5>+1	;maximum string length in words
;	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

	$num==0			;symbol type codes

$$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
cmdwrd:	0			;saved JFN mode word from COMND
cmdcc1:	0				;saved CCOC words from COMND
cmdcc2:	0				;""		""
sysnm:	0			;our SIXBIT name
;	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
ptytty:	0		;device designator for PTY as TTY
ptyjfn:	0		;JFN of above 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
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
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 	"	"
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
nargs:	0			;number of parameters parsed
pname:	0			;name of current parameter
excflg:	f$reez+c$cmd+e$cho ;flags for EXEC routine
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

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

;	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
;	This is the collection of symbol tables for the various questions.
;	There are four impure tables - for string symbols (STRSYM), numeric
;	symbols (NUMSYM), logical symbols (LGCSYM) and file symbols (FILSYM).
;	There should also be
;	two pure tables, the command table (COMSYM) and the permanent symbol
;	table (SYSSYM).

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

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

;space for text storage of symbol names

free:	strsiz+numsiz+lgcsiz+labsiz+filsiz	;number of free entries left

nxtsym:	0		;offset to place next symbol name at

symtab:block	<strsiz+numsiz+lgcsiz+labsiz+filsiz>*<maxchr+1>/5	

numsym:	0,,numsiz		;max entries in table of numeric symbols
	block	numsiz		;table storage

strsym:	0,,strsiz
	block	strsiz

filsym:	0,,filsiz
	block	filsiz

lgcsym:	0,,lgcsiz
	block	lgcsiz

labsym:	0,,labsiz
	block	labsiz

;	COMND - related storage
;	Field descriptor block for .ASKN
numfdb:	fld(.cmnum,cm%fnc)!cm%dpp!exfdb	;decimal number,default
	^d10					;radix 10
$$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<>),<
IFIDN	<IMP> <imp>,<
	IFNB	<routine>,<[asciz/comand/],,routine>
	IFB	<routine>,<[asciz/comand/],,.'comand>>
ifidn	<imp> <noimp>,<	[asciz/comand/],,[tmsg	<
%Can't .'comand yet...>
	define	syk$(keyword,ktype,routine,%type1),<
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>

	.xcref	%type1
	purge	%type1>


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$	asks,imp		;string question
	key$	call,imp		;call another file
	key$	close,imp		;close data file
	key$	closei,imp,.closi	;close input file
	key$	data,imp		;send line to data file
	key$	dec,imp			;decrement symbol
	key$	delay,imp		;delay for n seconds
$$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$	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$	pause,imp	;pause (push to subsid EXEC via $CRCMD)
	key$	read,imp		;read from input file
	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$	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$	test,imp		;test string length
	key$	testfile,imp		;test for file exists

	purge	$comsz

;	table for yes/no
ysntab:	2,,2

;	Keywords for .ENABLE/.DISABLE, and the routines to do it
	define	enk$(word,code),<


edtab:	ensiz,,ensiz		;number of entries in table
	enk$	COMAND-CMD,[move t1,excflgs	;get the flags
			 skipe	edtyp		;enable ?
			txza	t1,c$cmd	;no, zero flag and skip
			txo	t1,c$cmd	;yes, light COMAND.CMD flag
			movem	t1,excflgs	;store flags
			ret]			;back to caller
	enk$	CONTROL-Z-EXITS,[move	t1,edtyp
				movem	t1,extflg
				ret]	enk$	DATA,[move	t1,edtyp	;get type of command
		      setcam	t1,datflg	;setup flag
	enk$	ESCAPE,[movei	t1,.priou
			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
	enk$	EXTENDED-EXEC,[move	t1,excflgs	;get current flags
			skipe	edtyp			;enable ?
			 txza	t1,m$exec		;no, zero and skip
			txo	t1,m$exec		;yes, set up
			movem	t1,excflgs		;restore flags
..log:	enk$	LOGGING,[skipn	logjfn		;got a logfile ?
			 jrst	[warn	<no logfile selected:>]
			move	t2,ptytty		;yes, get PTY
			movx	t1,tl%eor!fld(-1,tl%obj);ass enable
			skipe	edtyp			;was it ?
			movx	t1,tl%cor!fld(-1,tl%obj);no, clear links
			tlink%				;clear or set link
			 ercal	error
	enk$	LOGOUT,[move	t1,excflgs		;get EXEC mode flags
			skipe	edtyp			;enable ?
			 txza	t1,l$gout		;no, zero and skip
			txo	t1,l$gout		;yes, turn flag on
			movem	t1,excflgs		;restore flags
	enk$	QUIET,[move	t1,excflg		;get flags
			skipe	edtyp			;enable ?
			txoa	t1,e$cho		;no, echo back on
			txz	t1,e$cho		;yes, echo off
			movem	t1,excflgs		;restore
			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
	purge	ensiz$

;	keyword table for .IF directive
	define	relk$(relop,val),<

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

	purge	relsz$
;	System symbol table

syssym:	sysiz,,sysiz			;size of table
	syk$	DATE,string,[movx	t3,ot%ntm
				jrst	date.]
	syk$	DIRECTORY,string,[gjinf% ;get dir number
				hrroi	t1,sysval
				 ercal	error
	SYK$	EOF,logical,ineof.	;end of file status on input
	syk$	FILESTAT,numeric,[move	t1,filerr	;result of .TESTFILE
				movem	t1,sysval
	syk$	STRLEN,numeric,[move	t1,strlen
				movem	t1,sysval
	syk$	SYSTEM,string,sysnm.		;name of system
	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
	purge	sysiz$
;	dispatch table for numeric parser
optab:	illvec			;illegal operator vector
	nadd			;add

;	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

;	Interrupt tables
levtab:	pc1
	pc3				;address of PC words

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

entvec:	jrst	start
	jrst	reen
	verno	2,,348,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
IFN	<LOGG>,	<call	record>
	jrst	start1			;read filename from terminal
start:	reset%			;clear the world
	move	p,[iowd	slen,stack]	;set the stack
IFN <logg>,	<call	record>		;log user
	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]
		 ercal	[call	errmes
			jrst	start1]
		jrst	.+1]		;ok, got it from terminal
	movem	t1,comjfn		;remember 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	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
	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
	move	t2,excflgs		;whatever flags are in use
	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
	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
	 ret				;bad return
	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,
	 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
	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	<rsptr,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	[ret]			;bad return
	movem	t2,rsptr		;save pointer to rest of string
	call	mapprg			;map the program
	jrst	[fatal	<can't RUN program: >,,mcall]	;error from mapper
	movem	t1,prgfrk		;save the handle
	move	t1,rsptr		;get the rescan pointer
	call	rsload			;load the rescan buffer
	move	t1,prgfrk		;get the progs fork
	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
	subttl	Set logical symbol true or false - .SETT
;	.SETT/.SETF routines
.sett:	setzm	lgcflg			;true value
.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,lgcsym		;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
.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
	 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,lgcsym		;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
	 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
	hrrz	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
	call	clrinp			;clear typeahead
	jrst	.ask2			;ask again
	purge	askval
;	Check symbol is not numeric or string or logical - t1 contains valid
;	table address, assumes symbol is in ASKSYM.
;	Return +1: Symbol is defined in other table
;		+2: Symbol is in desired table or is not defined
askchk:	stkvar	oktab			;table we allow
	movem	t1,oktab		;remeber valid table
	cain	t1,numsym		;numeric symbol OK
	 jrst	askch1			;yes, don't check
	hrroi	t1,asksym		;point to our symbol
	call	luknum			;is it numeric ?
	 skipa				;no, try next
	ret				;yes, return failure
askch1:	move	t2,oktab		;table we allow
	cain	t2,strsym		;string symbol OK ?
	 jrst	askch2			;yes, don't check
	hrroi	t1,asksym		;point again
	call	lukstr			;is it string ?
	 skipa				;no, check next
	ret				;yes, return failure
askch2:	move	t2,oktab	;table we allow
	cain	t2,lgcsym		;logical OK ?
	 jrst	askch3			;yes, don't check
	hrroi	t1,asksym		;point again
	call	luklgc			;is it logical ?
	 skipa				;no, do next
	ret				;yes, fail
askch3:	retskp				;return success
	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,strsym		;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:	tmsg	<
>					;nice blank line before tables

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

	tmsg	< Symbol table usage : >

	prttab	Numeric,numsym,.stn	;print numeric tables
	prttab	Strings,strsym,.sts	;string tables
	prttab	Logicals,lgcsym,.stl	;logical tables
	prttab	Files,filsym,.stf
	prttab	Labels,labsym,.stlb

	tmsg	<

	-----  End of status report  -----
	retskp				;return success always
;	subroutine which takes a table address in t1, and prints out
;	used and total entries.
stuse:	movem	t1,t4			;save table address
	hlrz	t2,(t4)			;get currently used
	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
	hrrz	t2,(t4)			;get total in table
	nout%				;type again
	 ercal	error
	tmsg	< entries available.
	Symbols defined, with values:

;	Subroutine takes a table address 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
	hlrz	q1,(t1)		;head of table=number of entried,,max num
	jumpe	q1,stpr2	;if table empty, say so
	movns	q1,q1		;make negative
	hrlz	q1,q1		;put in left half
	addi	q1,1		;point to first real entry
	add	q1,t1		;and add the start of the table in
	movem	t2,rtn		;save the formatter routine's addres
stpr1:	hlro	t1,(q1)		;construct byte pointer to symbol name
	psout%			;type it
	tmsg	<:	>
	hrrz	t3,q1		;point to where we are in table
	call	(t2)		;dispatch to routine to print out value
	move	t2,rtn		;reget dispatch address
	aobjn	q1,stpr1		;loop through table
	ret			;return success
stpr2:	tmsg	< No entries currently in use.
;	The value printing routines
.stn:	hrre	t2,(t3)			;get numeric value
	movx	t3,^d10			;print in decimal
	movei	t1,.priou		;on terminal
	 ercal	error
	tmsg	<
.stl:	hrrz	t2,(t3)			;get logical value
	hrroi	t1,[asciz/ False.
/]					;false ?
	skipn	t2
	 hrroi	t1,[asciz/ True.
/]					;nope, true
.sts:	hrrz	t2,(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
	tmsg	<
.stf:	hrrz	t2,(t3)			;get JFN
	movei	t1,.priou		;type on terminal
	setz	t3,			;no fancies
	jfns%				;type filename
	 erjmp	error
	tmsg	<
.stlb:	tmsg	< at byte >
	hrrz	t2,(t3)			;get byte number
	movx	t3,^d10
	movei	t1,.priou
	 ercal	error
	tmsg	<
	subttl	Set numeric symbol
;	.SETN command - set a symbol to a numeric value.
;	Format:	.SETN	symbol	nnnn
.setn:	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,numsym		;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
	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:
.disable:	setom	edtyp		;mark enable
.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,	;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	.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,numsym		;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
	 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
	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
	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
	movx	t3,^d10
	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
	movx	t3,^d10			;write in rad 10
	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
	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
	call	clrinp			;clear typeahead
	jrst	.askn2			;ask again
	purge	askval,nrng
.askn7:	fatal	<answer not in range
	call	clrinp			;clear typeahead
	jrst	.askn2
	subttl	.IFDF/.IFNDF commands
;	Conditional execution depending on whether a symbol is defined
.ifndf:	setzm	ifdtyp			;flag not defined wanted
.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
	setz	t1,			;indicate NO table is valid
	call	askchk			;and ask if it exists
	 skipa				;it does - skip next
	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
	 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:	tmsg	<
[IND - pausing. To continue type "POP"]
	movx	t2,c$cmd+m$exec+e$cho+p$ush ;push, freeze, echo, keep COMAND.CMD
	call	$CRcmd
	skipe	t3			;OK ?
	 call	excerr			;no
	tmsg	<
[IND - continuing]
	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
	 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
	 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,filsym		;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,filsym		;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
	 ercal	error
.askf2:	hrroi	t1,asklin		;bung out CTRL/R buffer
	call	cmdini			;initialize COMND
	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
	 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	.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:	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
.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,strsym		;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
	 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:	hrroi	t1,asklin		;bung out CTRL/R buffer
	call	cmdini			;initialize COMND blocks
	movei	t1,cmdblk		;point to state block
	movei	t2,[fldbk. (.cmtok,cm%sdh,<point 7,[byte (7) ^d26]>,<text string
  or Control-Z to exit>,,[brmsk. (0,0,0,0,<>)],
	[fldbk. (.cmtxt,cm%sdh,,,,[brmsk. (eolb0.,eolb1.,eolb2.,eolb3.,,<>)],
	[fldbk. (.cmcfm,cm%sdh)])])] ;parse text string
	comnd%				;do it
	 ercal	error
	txne	t1,cm%nop		;parsed OK ?
	 jrst	[fatal	<Invalid text string>,noret,mcall,nocmd ;no, complain
		jrst	.asks2]
	testz				;check for control-z
	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
	 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
	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
	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	luknum			;try numeric first
	 jrst	[hrroi	t1,asksym	;failed, try string
		call	lukstr
		 jrst	[hrroi	t1,asksym ;failed again, 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
		movem	t2,ifval	;save value
		movei	t1,$str		;and type
		movem	t1,iftyp
		jrst	.if3]		;continue
	movem	t2,ifval		;numeric succeeded, save value
	movei	t1,$num			;and remember type also
	movem	t1,iftyp
.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
.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
	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.
.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
	call	leng			;discover length
	movem	t3,strlen		;remember in right place for SYSSYM
	retskp				;return success
	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
.testfil:	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*
	fatal	<invalid filespec:>
.tsf2:	move	t2,comptr		;get saved filename pointer
	movx	t1,gj%sht+gj%old+gj%del	;consider deleted files this time
	 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
	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)
	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
	 erjmp	[fatal	<can't open logfile:>,,mcall,nocmd]
	movem	t1,logjfn		;now we have logfile, save JFN
	call	getpty			;and try to grab a PTY as well
	 jrst	.+2			;failed, release logfile
	retskp				;succeeded
	move	t1,logjfn		;get logfile JFN
	closf%				;close it
	 erjmp	.+1
	setzm	logjfn			;forget we have one
;	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
	call	nopty			;release the PTY
	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
;	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
	 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,strsym		;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
	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
	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 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.
.numeric:	movei	t2,numsym	;set up symbol type
	setzm	t3			;initialize default value
	jrst	declst			;parse declaration list
.logical: movei	t2,lgcsym		;set up symbol type
	movx	t3,false		;and default value
	jrst	declst			;parse namelist
.string:	movei	t2,strsym	;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,filsym		;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: >]
	setz	t1,			;OK, now the symbol must not be defined
	call	askchk			;so make sure it isn't
	 jrst	[fatal	<symbol is already defined:>]
	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
;==**== 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
	movei	t2,"'"			;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
	caie	t2,"'"			;should be closing quote
	 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
	movei	t4,"'"			;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	lukstr			;lookup in string symbol table
	 jrst	subnt			;string not found try numeric
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:	move	t1,[point 7,subsym]	;point at symbol name
	call	luknum			;lookup symbol as numeric
	 jrst	subft			;not found - try for file symbol
	hrroi	t1,scratch		;point to scratch buffer
	movx	t3,^d10			;write number as numeric
	 ercal	error
	hrroi	t2,scratch		;set up for substi as if a string was
	jrst	subst3			 ;found and continue
;	Try for file symbol and get filename
subft:	move	t1,[point 7,subsym]	;point to symbol name
	call	lukfil			;try in file table
	 jrst	subsy			;not found -try system symbol
	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
	movx	t3,^d10			;in RAD 10
	 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
	 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:	movei	t1,.rsini		;initialize for rescan
	 ercal	error
	movei	t1,.rscnt		;count of chars in buffer
	 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
	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	[call	errmes
		ret]			;return bad - get from terminal
	movem	t1,comjfn		;save command file JFN
;	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
tsbrk2:	hlrz	t3,(t4)			;get closing bracket of pair
	pop	p,t4
	retskp				;return success
	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
;	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
prtcmd:	hrroi	t1,comlin
;	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
;	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

	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
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
	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
coment:	hrroi	t2,comlin		;point to command line
	movei	t1,.priou		;point to terminal
	setzb	t3,t4			;terminate on null
	sout%				;type it
	 ercal	error			;crash
;	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				;ignore errors with errors
haltt:	call	.endlog			;close out logfile if necessary
	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
		 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.
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
	movx	t2,1b<ptychn>!1b<frkchn> ;set up PTY 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.
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	getpt2		;yes, device is available
	aoj	q1,		;no, bump PTY number
	sojn	t4,getpt1	;loop through all PTYs
	 warn	<no PTYs avaiable for logging - releasing logfile.
	ret			;return failure
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
	 ercal	error
	movem	t1,ptyjfn	;store JFN for interrupt routines
	movx	t1,tl%sab!tl%abs	;set PTY to receive links
	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,ptytty	;remember
	hrr	t1,t2		;PTY is object for this function
	 ercal	error
	move	t1,ptyjfn		;point to PTY again
	movx	t2,mo%oir!fld(ptychn-1,mo%sic)!.moapi ; enable output-is-ready
	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
	setzm	ptytty
	setzm	ptydes			;clear device designators
	setzm	ptyjfn			;and jfns
	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
	move	t1,ptytty		;PTY as TTY
	sobe%				;output buffer empty ?
	 skipa				;no, do summat
	jrst	ptyin2			;yes, ignore interrupt
	move	t1,ptyjfn		;point to PTY
	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
	move	t1,logjfn
	hrroi	t2,ptybuf		;point to text just read and logfile
	pop	p,t3			;get back number of chars read
	movns	t3,t3			;negate that
	sout%				;write that many bytes
	 ercal	error
ptyin2:	rests				;restore temp acs
	debrk%				;leave interrupt context
frkint:	tmsg	<
????Fork interrupt !!!!>
	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.
ranges:	stkvar	<savptr,nvals>
	movem	t1,savptr		;save the pointer
	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:	push	p,t4			;save ac
	call	numexp			;parse first expression
	 jrst	[pop	p,t4
		jrst	range1]		;bad expression
	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
	subttl	Numeric expression parsing
;	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:
;	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
;	Input:	t1/Byte pointer to expression
;	Output:	t2/Value of expression
numexp:	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
	movx	t3,^d10			;read as decimal
	nin%				;monitor does work
	 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	luknum			;attempt to look it up
	 jrst	[hrroi	t1,scratch	;failed - point again
		call	luksys		;and try for system symbol
		 jrst	numex2			;unknown
		caie	t3,$num		;numeric type ?
		 jrst	numex4		;no, complain
		jrst	.+1]		;succeed
	movem	t2,nval		;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: >
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
	addm	t3,cnval		;and add to first
nsub:	move	t3,cnval		;get first operand
	sub	t3,nval			;subtract second
	movem	t3,cnval		;store result
nmul:	move	t3,nval			;get second operand
	imulm	t3,cnval		;multiply by first and store
ndiv:	move	t3,cnval		;get dividend
	idiv	t3,nval			;divide by divisor
	movem	t3,cnval		;store result
	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,numsym		;address of numeric symbols
	call	entval			;get entval to do the work
;	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
	movei	t1,numsym		;address of table
	tbluk%				;look it up
	 ercal	error			;table is screwed up
	txnn	t2,tl%exm		;exact match ?
	 ret				;no - return failure
	hrre	t2,(t1)			;yes - get value of symbol
	move	t3,t1			;and position in table
	retskp				;return 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,lgcsym		;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
	movei	t1,lgcsym		;address of table
	tbluk%				;look it up
	 ercal	error			;table is screwed up
	txnn	t2,tl%exm		;exact match ?
	 ret				;no - return failure
	hrre	t2,(t1)			;yes - get value of symbol (extend sign)
	movem	t1,t3			;and return entry address
	retskp				;return 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
	camg	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,strsym
	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
	movei	t1,strsym		;point to string tables
	tbluk%				;try to look it up
	 ercal	error			;woops....
	txnn	t2,tl%exm		;exact match ?
	 ret				;no, return failure
	movem	t1,t3			;save table address for caller
	hrr	t4,(t3)			;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,labsym		;point to correct table
	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			;save pointer to label
	movei	t1,labsym		;point to label table
	tbluk%				;lookup
	 ercal	error			;tables are crapped up
	txnn	t2,tl%exm		;exact match ?
	 ret				;no - return failure
	hrrz	t2,(t1)			;yes - get value of symbol
	move	t3,t1
	retskp				;return 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			;save
	movei	t1,filsym		;address of symbol table
	tbluk%				;lookup
	 ercal	error			;tables trashed
	txnn	t2,tl%exm		;match ?
	 ret				;no
	hrrz	t2,(t1)			;yes, get JFN
	move	t3,t1			;address
	retskp				;return success
;	ENTFIL - enter file symbol.
;	t1/ Pointer to symbol name
;	t2/ JFN
entfil:	movei	t3,filsym		;address of table
	call	entval			;enter it
	 ret				;fail
	retskp				;succeed
;	LUKSYS - lookup a system symbol
;	Input:	t1/	Pointer to symbol name in ASCIZ
;	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
	cain	t3,$str			;string type symbol returned ?
	 jrst	[hrroi	t2,sysval	;yes, point to it
		jrst	.+2]
	move	t2,sysval		;no, just get value
	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 address
;	+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
	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
	hrrm	t2,(t1)			;at the address wher we found the oldun
	retskp				;return success
entvl1:	sosge	free			;decrement number of entries in strings
	 jrst	strful			;string space full - crash
	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
	 ercal	error
	setz	t2,			;grab a null byte
	idpb	t2,t1			;and bung that at the end
	move	t1,tabnam		;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,value		;and put value 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
	retskp				;return success
	purge	namptr,tabnam,value

;	tabel error routines
strful:	fatal	<string storage full>,,,nocmd
tberr:	fatal	<symbol table full>,,mcall,nocmd
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
	 erjmp	recerr
	movem	t1,recjfn
	movx	t2,fld(7,of%bsz)!of%app
	 erjmp	recerr
	hrroi	t2,[asciz/ 
User /]
	setzb	t3,t4
	 erjmp	recerr
	movem	t1,t2
	move	t1,recjfn
	 erjmp	recerr
	hrroi	t2,[asciz / at /]
	setzb	t3,t4
	 erjmp	recerr
	seto	t2,
	setz	t3,
	 erjmp	recerr
	 erjmp	recerr
recerr:	tmsg	<
%User logfile write failed, please inform KEVIN:>
	call	errmes
	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

	movei	t1,gjfblk	;point to GTJFN block
	movem	t1,cmdblk+.cmgjb	;store pointer


	TMSG <?Not confirmed>				;OUTPUT ERROR MESSAGE


	 ercal error		;error, go check for eof on take file


	 ercal error		;error, go check for eof on take file
	HRROI T1,[ASCIZ/Invalid guide phrase/]

	txo	t1,cm%wkf!cm%xif	;wake on every field, no indirect files
	 ercal error		;ERROR, GO SEE IF END OF "TAKE FILE"




	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
	ctrls==23			;xoff
	xonoff==0			;make 1 to use XON/XOFF processing
	eatch1==40			;char to be eaten (space)
	eatch2==177			;second eatable = delete
;	PRARG argument block for EXEC
prargb:	4			;number of words in block
	1b0+3b6+2b12+cr%pra	;crjob prarg block
$crcmd:	stkvar	<cmdjfn,cmdptr,flgs,excjfn,exchnd,jfnwrd,ccoc1,ccoc2>
	movem	t1,cmdptr		;save pointer
	movem	t2,flgs			;save flgs
	setzm	exchnd
	setzm	cmdjfn
	setzm	excjfn			;zero before use !!
;	Now save the JFN word and CCOC word
	movei	t1,.priin		;terminal
	rfmod%				;get mode word
	 erjmp	crerr
	movem	t2,jfnwrd		;save it
	rfcoc%				;get ccoc word
	 erjmp	crerr
	movem	t2,ccoc1		;save first word
	movem	t3,ccoc2		;and second
	skipe	efork		;got a frozen fork ?
	 jrst	cont		;yes, thanks
				;no, but I wouldn't mind one or two
	move	t2,flgs			;get flags back
	txne	t2,c$cmd		;COMAND.CMD desired ?
	 jrst	nocom			;yes, skip next
db	<tmsg	<
%Renaming COMAND.CMD>>
	movx	t1,gj%sht+gj%old	;old file
	hrroi	t2,[asciz/COMAND.CMD/]	
	GTJFN%				;is there a COMAND.CMD available ?
	 erjmp	nocom			;no, forget it
	movem	t1,cmdjfn		;yes, save the JFN
	movx	t1,gj%sht+gj%new+gj%fou	;new file
	hrroi	t2,[asciz/COMAND.crcmd/]	;saved filespec
	 erjmp	crerr			;failure
	movem	t1,t2			;put arg in right place
	move	t1,cmdjfn		;get old JFN
	rnamf%				;rename comand.cmd temporarily
	 erjmp	crerr
	movem	t2,cmdjfn		;save the new JFN for later use
	jrst	crcmd1			;comtinue
nocom:	setzm	cmdjfn			;indicate no COMAND.CMD
db	<tmsg	<
%No COMAND.CMD or not renaming>>
crcmd1:	movei	t1,.priou
	dobe%				;wait for output to finish
	 erjmp	crerr
	jrst	cont1			;don't restore nonexistant JFN words
cont:	movei	t1,.priin		;point to terminal
	move	t2,cmdwrd		;get COMND JFN word
	sfmod%				;set software mode
	 erjmp	crerr
	stpar%				;set hardware mode
	 erjmp	crerr
	move	t2,cmdcc1		;get old CCOC words
	move	t3,cmdcc2		;and the next
	sfcoc%				;set them also
	 erjmp	crerr
cont1:	movei	t1,.priin
	cfibf%				;clear any typeahead
IFN	xonoff,<movei	t1,ctrls		;get an xoff
	pbout%				;and lock the keyboard
	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
	txnn	t1,e$cho		;echo desired ?
	 call	noeco			;no
	move	t1,flgs			;get flags again
	txne	t1,p$ush		;a PUSH-type command wanted ?
	 jrst	push			;yes, just do that then
db	<tmsg	<
%Simulating command input>>
	move	t3,cmdptr		;retrieve command pointer
	movei	t1,.priin		;point to input
comlop:	ildb	t2,t3			;grab a byte
	jumpe	t2,crcmd2		;if 0, end of command
	sti%				;simulate input
	jrst	comlop			;go for next
crcmd2:	movei	t2,cr			;get carriage return
	sti%				;input
;	movei	t2,eatch1		;and char to be eaten for detection
;					;of new command parse
;	sti%				;input
;	movei	t2,eatch2		;second eatable char to remove first
;	sti%
push:	skipe	efork			;continuing frozen fork ?
	 jrst	[db	<tmsg	<
%Resuming frozen fork>>
		move	t1,efork	;yes, get handle
		rfork%			;and resume fork operations
		 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>>
	movei	t1,.priin		;specify input
	sibe%				;skip if already empty
	dibe%				;and dismiss until input buffer empty
	gjinf%				;ok, discover terminal number
	 ercal	error
crcm3:	hrlz	t1,t4			;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,
;	it can now be killed.
;	Alternatively, we have done a PUSH, and the EXEC has done a POP.
crfin:	movei	t1,.priin		;now find out what COMND has left the 
	rfmod%				;terminal like
	 erjmp	crerr
	movem	t2,cmdwrd		;save COMMD word
	rfcoc%				;get CCOC words
	 erjmp	crerr
	movem	t2,cmdcc1		;save first
	movem	t3,cmdcc2		;and second
	movei	t1,.priin		;now reset things for our terminal
	move	t2,jfnwrd		;first the JFN word
	sfmod%				;software bits
	 erjmp	crerr
	stpar%				;and hardware bits
	 erjmp	crerr
	movei	t1,.priin		;now things to do with control chars
	move	t2,ccoc1
	move	t3,ccoc2		;get both words back
	sfcoc%				;and reset to what we had before
	 erjmp	crerr

IFN	xonoff,<movei	t1,xon			;reallow terminal input
db	<tmsg	<
Termination occurred>>
	move	t1,sysnm		;get our old name
	setnm%				;set it
	move	t1,flgs			;get flags
	txnn	t1,e$cho		;was echo off ?
	 call	eco			;yes, turn it on
	setz	t3,			;indicate no errors
	move	t1,exchnd		;get handle again
	move	t2,flgs			;get flags
	skipn	efork			;yes, got one ?
	 movem	t1,efork	;remember newly acquired fork
	move	t1,efork	;get it back in case we didn't have it
	ffork%			;freeze it
	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]>
	skipn	cmdjfn			;anything to rename ?
	 ret				;no, just return
db	<tmsg	<
%Renaming COMAND files>>
	movx	t1,gj%sht+gj%fou	;new file
	hrroi	t2,[asciz/COMAND.CMD/]	;name to use
	 erjmp	crerr
	movem	t1,t2			;save JFN for COMAND.CMD
	move	t1,cmdjfn		;retrieve JFN of COMAND.crcmd
	rnamf%				;rename
	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
db	<skipe	efork
	 jrst	[tmsg	<
%Already have a fork - not mapping a new one>
		jrst	.+1]>
	skipe	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
	movem	t2,t3			;save flags
	hrroi	t2,[asciz/SYSTEM:EXEC.EXE/]	;which is the EXEC
	txne	t3,m$exec		;MEXEC required ?
	 hrroi	t2,[asciz/SYS:MEXEC.EXE/]	;yes
	txnn	t3,e$cho		;echo wanted ?
	 hrroi	t2,[asciz/PS:<PACKAGES>CRCMD-EXEC.EXE/] ;no, suppress prompt
	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
	push	p,t4			;save handle
	move	t4,excflgs			;get the flags
	txnn	t4,l$gout		;do they want logout turned on ?
	epcap%				;no, set the EXEC's capabilities
	 erjmp	[ret]
	pop	p,t4			;return fork handle
	pop	p,t3			;restore ac
	move	t2,t4			;place returned arguments in correct 
	move	t1,t3
	retskp				;return success
;	These two routines turn terminal echoing on and off
noeco:	setzm	t3			;indicate echo off
db	<tmsg	<
%echo off>>
eco:	seto	t3,			;indicate echo on
	movei	t1,.priin
	rfmod%				;get terminal mode word
	jumpe	t3,eco1			;echo off or on ?
	txo	t2,tt%eco		;on
eco1:	txz	t2,tt%eco		;off
	sfmod%				;do whatever it is
	ret				;back to caller
;	Test is subsidiary is halted, and if so, SFORK it
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
	skipn	waspsh			;pushed last time ?
	 ret				;no, just return
	movem	t1,t3			;save fork handle
	movei	t1,^d500		;1/2 second
	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
	 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
;	errors come here
IFN	xonoff,<movei	t1,xon			;reallow terminal input
	movei	t1,flgs			;get flags
	txnn	t1,e$cho		;was echo off
	 call	eco			;yes, turn it on
	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
	hllz	q1,strsym		;number of string symbols defined
	movns	q1,q1			;negate
	hrri	q1,strsym+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 start byte of this string
	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
	hrrm	t2,(q1)			;so store it back in the table
	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
	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
	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
;	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
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:	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
	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
	end	<3,,entvec>