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
; Add .ENABLE LOGOUT
;<KEVIN>IND.MAC.281, 16-Apr-82 15:35:55, EDIT BY KEVIN
; Increase buffer space for .ASK
;<KEVIN>IND.MAC.280, 16-Apr-82 14:28:58, EDIT BY KEVIN
;<KEVIN>IND.MAC.279, 16-Apr-82 14:21:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.278, 16-Apr-82 14:15:32, EDIT BY KEVIN
;<KEVIN>IND.MAC.277, 16-Apr-82 14:06:18, EDIT BY KEVIN
; Add default version number to .ASKF
;<KEVIN>IND.MAC.276, 2-Apr-82 13:14:22, EDIT BY KEVIN
;<KEVIN>IND.MAC.275, 2-Apr-82 13:03:55, EDIT BY KEVIN
; Spurious extra crs (not cr/lf combos) on commands were making sub-
; commands impossible
;<KEVIN>IND.MAC.274, 3-Mar-82 13:04:04, EDIT BY KEVIN
; Routine to print error from EXEC command was not using immediate fork
; handle.
;<KEVIN>IND.MAC.273, 18-Feb-82 10:03:02, EDIT BY KEVIN
; .OPENA was always getting a JFN on a new file
;<KEVIN>IND.MAC.272, 15-Feb-82 14:03:10, EDIT BY KEVIN
;<KEVIN>IND.MAC.271, 15-Feb-82 13:54:46, EDIT BY KEVIN
;<KEVIN>IND.MAC.270, 15-Feb-82 13:44:26, EDIT BY KEVIN
; Acs trashed in TSBRK
;<KEVIN>IND.MAC.269, 15-Feb-82 11:02:39, EDIT BY KEVIN
;<KEVIN>IND.MAC.268, 15-Feb-82 10:38:21, EDIT BY KEVIN
; Add parameter-picking from command line, using P1,P2, etc.
;<KEVIN>IND.MAC.267, 11-Feb-82 10:17:11, EDIT BY KEVIN
; Clear typeahead on command errors.
;<KEVIN>IND.MAC.266, 8-Feb-82 10:22:08, EDIT BY KEVIN
;<KEVIN>IND.MAC.265, 8-Feb-82 10:17:29, EDIT BY KEVIN
; Make end-of-command file close the logfile, and release the PTY.
; Also add .CLOSELOG command to close the logfile.
;<KEVIN>IND.MAC.264, 8-Feb-82 09:57:23, EDIT BY KEVIN
;<KEVIN>IND.MAC.263, 8-Feb-82 09:54:05, EDIT BY KEVIN
; Was not constructing PTY => TTY number correctly.
;<KEVIN>IND.MAC.262, 8-Feb-82 09:35:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.261, 8-Feb-82 09:31:23, EDIT BY KEVIN
;<KEVIN>IND.MAC.260, 8-Feb-82 09:18:20, EDIT BY KEVIN
; GETPTY was skipping over TTYs assigned to SYSJOB, but was then grabbing
; PTYs from PTYCON. Must use more extensive checks to decide whether
; device is free.
;<KEVIN>IND.MAC.259, 5-Feb-82 18:13:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.258, 5-Feb-82 17:56:49, EDIT BY KEVIN
;<KEVIN>IND.MAC.257, 5-Feb-82 17:41:48, EDIT BY KEVIN
; However, TLINK still needs the TTY number !!!
;<KEVIN>IND.MAC.256, 5-Feb-82 17:24:49, EDIT BY KEVIN
; PTYs must be referred to as PTYn: not TTY(105+n):
;<KEVIN>IND.MAC.255, 5-Feb-82 16:52:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.254, 5-Feb-82 16:14:41, EDIT BY KEVIN
;<KEVIN>IND.MAC.253, 5-Feb-82 15:35:18, EDIT BY KEVIN
; MTOPR seems to refuse channel 0 as PTY interrupt channel
;<KEVIN>IND.MAC.252, 5-Feb-82 15:18:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.251, 5-Feb-82 14:27:42, EDIT BY KEVIN
;<KEVIN>IND.MAC.250, 5-Feb-82 14:01:24, EDIT BY KEVIN
; Forgot to supply object designator for TLINK%
;<KEVIN>IND.MAC.249, 5-Feb-82 13:56:57, EDIT BY KEVIN
; Apparently you can't give a device designator to OPENF%.
; Thus, .LOGFILE must get a JFN on the PTY.
;<KEVIN>IND.MAC.248, 5-Feb-82 13:35:18, EDIT BY KEVIN
;<KEVIN>IND.MAC.247, 5-Feb-82 13:16:06, EDIT BY KEVIN
;<KEVIN>IND.MAC.246, 5-Feb-82 11:50:47, EDIT BY KEVIN
; Put warning messages in with user record code
;<KEVIN>IND.MAC.245, 5-Feb-82 11:47:18, EDIT BY KEVIN
; Start V2 with some code to do roughly the same thing as PHOTO -
; .LOGFILE command, .ENABLE/.DISABLE LOGGING
;<KEVIN>IND.MAC.244, 3-Feb-82 14:10:29, EDIT BY KEVIN
;<KEVIN>IND.MAC.243, 3-Feb-82 14:02:42, EDIT BY KEVIN
; Add conditional to record everyone who uses the file in a file in
; <KEVIN>.
;<KEVIN>IND.MAC.242, 29-Jan-82 16:50:32, EDIT BY KEVIN
; Add extra forms of relational operators such as <>
;<KEVIN>IND.MAC.241, 15-Jan-82 17:25:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.240, 15-Jan-82 17:15:38, EDIT BY KEVIN
; Make CRCMD an internal routine so that we can use JSYS trapping on
; the subsidiary EXEC.
;<KEVIN>IND.MAC.239, 30-Nov-81 15:30:10, EDIT BY KEVIN
; Tell TESTFILE about invisible and offline files.
;<KEVIN>IND.MAC.238, 26-Nov-81 11:46:05, EDIT BY KEVIN
;<KEVIN>IND.MAC.236, 26-Nov-81 10:35:42, EDIT BY KEVIN
; Add .OPENA, teach NUMEXP about system symbols
;<KEVIN>IND.MAC.235, 26-Nov-81 10:15:13, EDIT BY KEVIN
; Teach .IF about system symbols as test variables (.IF <USER> eq "me")
;<KEVIN>IND.MAC.234, 26-Nov-81 10:02:57, EDIT BY KEVIN
; Didn't document LUKSYS correctly
;<KEVIN>IND.MAC.232, 25-Nov-81 17:07:21, EDIT BY KEVIN
; Allow system symbols in string expressions
;<KEVIN>IND.MAC.231, 22-Nov-81 14:04:46, EDIT BY KEVIN
; End-of-file code was forgetting to test file nesting depth
;<KEVIN>IND.MAC.230, 22-Nov-81 13:57:47, EDIT BY KEVIN
; .CALL was not saving new nesting level
;<KEVIN>IND.MAC.229, 22-Nov-81 13:43:29, EDIT BY KEVIN
; Forgot to add .CALL to command table
;<KEVIN>IND.MAC.227, 22-Nov-81 13:20:09, EDIT BY KEVIN
; Label testing was still being attempted in DATA mode - reverse order of
; tests
;<KEVIN>IND.MAC.226, 22-Nov-81 12:50:02, EDIT BY KEVIN
; XCREF AC symbols ; add .DISPLAY directive (probably not supported) ; add
; .DELAY directive ; add .ENABLE/.DISABLE QUIET/EXTENDED-EXEC
;<KEVIN>IND.MAC.225, 19-Nov-81 17:40:10, EDIT BY KEVIN
; Suppress RELOP symbols from DDT
;<KEVIN>IND.MAC.224, 19-Nov-81 17:27:44, EDIT BY KEVIN
; Add .CALL directive
;<KEVIN>IND.MAC.223, 19-Nov-81 17:06:00, EDIT BY KEVIN
; Make ISDGT recognise "-" as part of a number
;<KEVIN>IND.MAC.222, 19-Nov-81 16:45:57, EDIT BY KEVIN
; Forgot to supply storage for FILERR
;<KEVIN>IND.MAC.221, 19-Nov-81 16:43:21, EDIT BY KEVIN
; Add .TESTFILE directive, and special symbol <FILESTAT>
;<KEVIN>IND.MAC.220, 19-Nov-81 13:57:48, EDIT BY KEVIN
; Add .TEST directive, and special symbol <STRLEN>
;<KEVIN>IND.MAC.218, 19-Nov-81 13:33:17, EDIT BY KEVIN
; Don't use TX type macros when you haven't got an immediate value!
;<KEVIN>IND.MAC.216, 19-Nov-81 13:23:27, EDIT BY KEVIN
; RFCOC was having acs trashed by TXO
;<KEVIN>IND.MAC.214, 19-Nov-81 13:14:56, EDIT BY KEVIN
; Add .ENABLE ESCAPE for escape sequences
;<KEVIN>IND.MAC.212, 19-Nov-81 12:01:43, EDIT BY KEVIN
; Add .INC/.DEC for numeric symbols
; Make IND bomb out on command parse errors
;<KEVIN>IND.MAC.211, 18-Nov-81 19:34:23, EDIT BY KEVIN
; Unusual terminator in ENTVAL
;<KEVIN>IND.MAC.209, 18-Nov-81 19:02:15, EDIT BY KEVIN
; String expression parser failed on null strings
;<KEVIN>IND.MAC.208, 18-Nov-81 18:50:07, EDIT BY KEVIN
; String expression parser failed on symbols without ranges
;<KEVIN>IND.MAC.207, 18-Nov-81 17:50:04, EDIT BY KEVIN
; Rework way DATA mode works - set up flag for "pure" command, or
; one that has been rewritten.
;<KEVIN>IND.MAC.206, 18-Nov-81 17:39:07, EDIT BY KEVIN
; Source and destination designators wrong way round in WDATA
;<KEVIN>IND.MAC.205, 18-Nov-81 17:27:56, EDIT BY KEVIN
; Use extend sign ops for GETAB stuff
;<KEVIN>IND.MAC.203, 18-Nov-81 17:23:23, EDIT BY KEVIN
; Add ENABLE/DISABLE DATA directives
;<KEVIN>IND.MAC.201, 18-Nov-81 16:27:16, EDIT BY KEVIN
; Processor for system name forgot ERCAL after GETAB
;<KEVIN>IND.MAC.200, 18-Nov-81 16:19:02, EDIT BY KEVIN
; LUKSYS was not returning symbol type codes correctly
;<KEVIN>IND.MAC.198, 18-Nov-81 15:28:30, EDIT BY KEVIN
; Must use indexing and inirection with subroutine dispatch in LUKSYS
;<KEVIN>IND.MAC.197, 18-Nov-81 15:23:35, EDIT BY KEVIN
; Typeo in LUKSYS
;<KEVIN>IND.MAC.196, 18-Nov-81 15:14:18, EDIT BY KEVIN
; Teach substitution about system symbols
;<KEVIN>IND.MAC.195, 18-Nov-81 14:53:03, EDIT BY KEVIN
; CRCMD has now sorted out problems with PUSH, so we can now use
; the PAUSE command
;<KEVIN>IND.MAC.194, 18-Nov-81 10:25:05, EDIT BY KEVIN
; Correct typeos in system symbol table
;<KEVIN>IND.MAC.191, 18-Nov-81 10:17:42, EDIT BY KEVIN
; Add support routines for system symbols
;<KEVIN>IND.MAC.190, 18-Nov-81 09:57:37, EDIT BY KEVIN
; Add system symbol table
;<KEVIN>IND.MAC.188, 17-Nov-81 19:47:39, EDIT BY KEVIN
; Open brackets improperly handled in numeric parser
;<KEVIN>IND.MAC.187, 17-Nov-81 19:32:14, EDIT BY KEVIN
; Ranges was not remebering to save its acs
;<KEVIN>IND.MAC.185, 17-Nov-81 18:00:49, EDIT BY KEVIN
; Move definition of storage, etc. to separate file (indsym.unv).
; This allows IND to be generated by itself!
;<KEVIN>IND.MAC.183, 17-Nov-81 17:42:33, EDIT BY KEVIN
; STREXP was not handling multiple quoted strings correctly
;<KEVIN>IND.MAC.181, 17-Nov-81 17:32:45, EDIT BY KEVIN
; Testing wrong ac after STCMP
;<KEVIN>IND.MAC.179, 17-Nov-81 16:55:32, EDIT BY KEVIN
; problems with macro used to generate RELOP table
;<KEVIN>IND.MAC.176, 17-Nov-81 16:22:48, EDIT BY KEVIN
; Make garbage collector keep statistics on usage
;<KEVIN>IND.MAC.173, 17-Nov-81 15:26:45, EDIT BY KEVIN
; Macro doesn't like ~ signs
;<KEVIN>IND.MAC.172, 17-Nov-81 15:06:09, EDIT BY KEVIN
; Add .IF directive, for testing relational operations between strings or
; numbers.
;<KEVIN>IND.MAC.171, 16-Nov-81 17:45:07, EDIT BY KEVIN
; Stop .ASKS raising terminal input, add .STOP directive
;<KEVIN>IND.MAC.170, 16-Nov-81 17:35:10, EDIT BY KEVIN
; .RETURN was not decrementing nesting level
;<KEVIN>IND.MAC.168, 16-Nov-81 17:11:05, EDIT BY KEVIN
; Forward labels not being processed correctly
;<KEVIN>IND.MAC.166, 16-Nov-81 16:40:14, EDIT BY KEVIN
; Bug in label processing
;<KEVIN>IND.MAC.164, 16-Nov-81 16:18:33, EDIT BY KEVIN
; Implement .ASKS
;<KEVIN>IND.MAC.163, 16-Nov-81 15:21:17, EDIT BY KEVIN
; Add IND comments (.; command). Add .GOSUB, .RETURN
;<KEVIN>IND.MAC.162, 16-Nov-81 14:37:49, EDIT BY KEVIN
; Keyword table out of order
;<KEVIN>IND.MAC.159, 16-Nov-81 14:14:43, EDIT BY KEVIN
; Implement .ASKF, improve .ASK
;<KEVIN>IND.MAC.158, 16-Nov-81 13:27:38, EDIT BY KEVIN
; Wrong acs in .DATA command
;<KEVIN>IND.MAC.157, 16-Nov-81 13:18:48, EDIT BY KEVIN
; STATUS was not displaying negative numbers correctly
;<KEVIN>IND.MAC.156, 16-Nov-81 11:48:23, EDIT BY KEVIN
; Add .SETFI (set file symbol)
;<KEVIN>IND.MAC.154, 16-Nov-81 11:36:24, EDIT BY KEVIN
; Add ENTFIL LUKFIL
; Make substitution recognise file symbols. Fix bug in luknum - was
; not returning negative values with full sign (use HRRE not HRRZ)
;<KEVIN>IND.MAC.153, 16-Nov-81 10:14:49, EDIT BY KEVIN
; Add garbage collector for string storage, add .OPEN, .CLOSE, .DATA
; improve entering routines for symbol tables to check for existence of
; symbol (like ENTSTR does.)
;<KEVIN>IND.MAC.152, 13-Nov-81 18:25:39, EDIT BY KEVIN
; LUKNUM was not returning table positions
;<KEVIN>IND.MAC.151, 13-Nov-81 18:18:47, EDIT BY KEVIN
; Logic of below edit was inversed from desired action
;<KEVIN>IND.MAC.147, 13-Nov-81 18:05:06, EDIT BY KEVIN
; Modify ENTLAB to ignore request if label is already in table
;<KEVIN>IND.MAC.146, 13-Nov-81 17:56:15, EDIT BY KEVIN
;<KEVIN>IND.MAC.143, 13-Nov-81 16:45:41, EDIT BY KEVIN
;<KEVIN>IND.MAC.142, 13-Nov-81 14:27:30, EDIT BY KEVIN
;<KEVIN>IND.MAC.140, 12-Nov-81 11:07:11, EDIT BY KEVIN
;<KEVIN>IND.MAC.137, 11-Nov-81 16:24:45, EDIT BY KEVIN
; Start on .GOTO logica - command is not added yet, but we must put
; checks into the parser for adding labels to the table, and checks to
; ensure no commands are executed while a target is being searched for.
;<KEVIN>IND.MAC.132, 11-Nov-81 13:21:47, EDIT BY KEVIN
; Add file symbol table, planned for inclusion from start. Stores JFNS
; for later use. Improve ENTSTR so that it copes whether or not the symbol
; is defined. This will be the only ENTER-type routine which does this,
; and is useful 'cos strings are so difficult.
;<KEVIN>IND.MAC.129, 11-Nov-81 11:31:11, EDIT BY KEVIN
;<KEVIN>IND.MAC.128, 10-Nov-81 19:51:24, EDIT BY KEVIN
; Beef up STATUS command to print out all symbols and values
;<KEVIN>IND.MAC.117, 10-Nov-81 19:05:49, EDIT BY KEVIN
; Make ASKx directives use ranges.
;<KEVIN>IND.MAC.113, 10-Nov-81 18:35:49, EDIT BY KEVIN
; Fix problem with range parsing
;<KEVIN>IND.MAC.108, 10-Nov-81 17:35:38, EDIT BY KEVIN
; String parser
;<KEVIN>IND.MAC.107, 10-Nov-81 16:48:40, EDIT BY KEVIN
; Remove .PAUSE command due to bug in $CRCMD
;<KEVIN>IND.MAC.105, 10-Nov-81 11:27:15, EDIT BY KEVIN
;<KEVIN>IND.MAC.102, 10-Nov-81 10:34:27, EDIT BY KEVIN
; Add .PAUSE command, to PUSH to lower EXEC
;<KEVIN>IND.MAC.99, 10-Nov-81 10:00:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.95, 10-Nov-81 09:22:58, EDIT BY KEVIN
;<KEVIN>IND.MAC.92, 9-Nov-81 16:51:07, EDIT BY KEVIN
;<KEVIN>IND.MAC.91, 9-Nov-81 15:00:15, EDIT BY KEVIN
; Bung in the work I did this weekend - notably the string and numeric
; expression parsers, in all their glory (or lack of it.) Also resolve
; problem whereby use of GETWRD was inconsistent, meaning that it could
; not backspace its byte pointer. Make GETWRD allow $, < and > as valid
; characters in a symbol.
; Add range parsing routine, for use in string expressions and .ASKx
; directives. Uses NUMEXP to parse general numeric expressions for the
; ranges.
;<KEVIN>IND.MAC.85, 7-Nov-81 18:19:15, EDIT BY KEVIN
; Add .IFDF/.IFNDF - if symbol defined or not defined
;<KEVIN>IND.MAC.82, 7-Nov-81 17:37:27, EDIT BY KEVIN
; Add .ASKN - ask for numeric symbol
;<KEVIN>IND.MAC.79, 7-Nov-81 17:16:34, EDIT BY KEVIN
; Add first few .ENABLE/.DISABLE commands
;<KEVIN>IND.MAC.78, 7-Nov-81 16:56:18, EDIT BY KEVIN
; Make substitution use numeric symbols as well
;<KEVIN>IND.MAC.74, 7-Nov-81 16:13:15, EDIT BY KEVIN
; Add .SETN
;<KEVIN>IND.MAC.72, 7-Nov-81 16:01:36, EDIT BY KEVIN
; ENTSTR was not counting string lengths properly
; Problem was implicit byte pointers where real ones were required
;<KEVIN>IND.MAC.71, 7-Nov-81 15:54:07, EDIT BY KEVIN
; Substitution was losing cr/lf from end of line
;<KEVIN>IND.MAC.70, 7-Nov-81 15:44:58, EDIT BY KEVIN
; LUKSTR was not returning correct byte pointers
;<KEVIN>IND.MAC.68, 7-Nov-81 15:23:01, EDIT BY KEVIN
;<KEVIN>IND.MAC.64, 7-Nov-81 14:58:55, EDIT BY KEVIN
; Add seperate reenter - REENTER performs no rescan
;<KEVIN>IND.MAC.61, 6-Nov-81 17:32:37, EDIT BY KEVIN
; Add substitution routines
;<KEVIN>IND.MAC.58, 6-Nov-81 16:32:10, EDIT BY KEVIN
; Add .STATUS command to print symbol table usage, etc.
;<KEVIN>IND.MAC.56, 6-Nov-81 16:08:44, EDIT BY KEVIN
;<KEVIN>IND.MAC.55, 6-Nov-81 15:43:44, EDIT BY KEVIN
; Add the .SETS command, in preparation for text substitution
;<KEVIN>IND.MAC.53, 6-Nov-81 15:14:44, EDIT BY KEVIN
; Modify GETWRD to return on no-alphabetic, and reset byte pointer.
; Also write ENTSTR - to enter a string symbol.
;<KEVIN>IND.MAC.51, 6-Nov-81 14:59:09, EDIT BY KEVIN
; .ASKx routines don't really want all the line terminator guff.
;<KEVIN>IND.MAC.47, 6-Nov-81 14:27:36, EDIT BY KEVIN
; Add LUKSTR to lookup string symbols so that the .ASKx routines can
; verify their symbol types.
;<KEVIN>IND.MAC.44, 6-Nov-81 14:15:02, EDIT BY KEVIN
;<KEVIN>IND.MAC.42, 5-Nov-81 17:52:14, EDIT BY KEVIN
; Add .ASK
;<KEVIN>IND.MAC.37, 5-Nov-81 17:21:31, EDIT BY KEVIN
; Add beginnings of .IFT, .IFF to test the logical ops
;<KEVIN>IND.MAC.33, 5-Nov-81 16:58:04, EDIT BY KEVIN
; Add .SETT/.SETF
;<KEVIN>IND.MAC.32, 5-Nov-81 16:11:33, EDIT BY KEVIN
; But clear out the buffers when we do it
;<KEVIN>IND.MAC.26, 5-Nov-81 14:55:56, EDIT BY KEVIN
; Add command line rescanning so we can @IND filename
;<KEVIN>IND.MAC.24, 5-Nov-81 14:22:32, EDIT BY KEVIN
;<KEVIN>IND.MAC.21, 5-Nov-81 14:07:37, EDIT BY KEVIN
;<KEVIN>IND.MAC.19, 4-Nov-81 18:03:05, EDIT BY KEVIN
; Start adding symbol table lookup/insertion/maintenance routines
;<KEVIN>IND.MAC.16, 4-Nov-81 15:03:18, EDIT BY KEVIN
; Also, REV and similar programs check the private program name and match
; it against the recsan buffer - must set program name.
;<KEVIN>IND.MAC.14, 4-Nov-81 10:25:22, EDIT BY KEVIN
; Alter way in which .RUN command works to load the rescan buffer properly
; Apparently, if you say RUN SYS:REV.EXE *.rel, the rescan buffer must
; only contain REV *.rel .
;<KEVIN>IND.MAC.10, 3-Nov-81 16:40:08, EDIT BY KEVIN
; Add .RUN command
;<KEVIN>IND.MAC.4, 3-Nov-81 13:56:20, EDIT BY KEVIN
;<KEVIN>IND.MAC.3, 3-Nov-81 13:52:09, EDIT BY KEVIN
;<KEVIN>IND.MAC.2, 3-Nov-81 13:48:47, EDIT BY KEVIN
;<KEVIN>IND.MAC.1, 3-Nov-81 12:02:26, EDIT BY KEVIN
title IND - performs similar function to RSX IND
subttl Edit history
comment #
Kevin Ashley April 1982
=======================
The copyright in the computer program described in this document and
in the associated user instructions is the property of Kevin Ashley.
The information in this document is subject to change without notice
and should not be construed as a commitment. Mr. Ashley assumes no
responsibility for any errors which may appear in this document.
The software described in this document is supplied under a licence
and may only used or copied in accordance with the conditions of such a
licence. The licence conditions state that this software shall be supplied
free of charge and shall not be sold or otherwise disposed of by means of
trade or ortherwisw for any form of profit or advantage. Possesion or use
of the software shall be deemed as acceptance of the conditions of the
licence.
No guarantee is given or may be implied as to the adequacy of the
program or its suitability for any particular purpose and no liability is
accepted for any loss or damage arising out of its use.
#
subttl Definitions and impure storage
;
; This program reads command files of a similar format to those
; used under RSX, which allow question/answer stuff to go on, and also
; symbol substitution and all that good stuff. Running programs via the
; EXEC may present problems, so we may need to use a .RUN directive
; rather than the EXEC RUN. We'll see....
;
search vtmac,indsym
regdef
.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
cexit.==:12345
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
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
IFG <MSWRD> <BUFSIZ>, <BUFSIZ==MSWRD>
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
;
; Bit definitions for relational operators - if a bit is set, then that
; condition means success for that operator. IE if the operator is le,
; then equals or less than both mean success.
;
$eq==1 ;equals condition
$lt==2 ;less than
$gt==4 ;greater than
eq==$eq ;only equals for equals
ne==$lt+$gt ;ne means less than or greater than
ge==$gt+$eq
gt==$gt
lt==$lt
le==$lt+$eq
$num==0 ;symbol type codes
$str==1
$fil==3
$lgc==4
$$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
0
0
0
deftyp
0
0
0
gjargs: gj%old ;old files
.nulio,,.nulio ;inout, output jfns
0 ;default device
0 ;default directory
0 ;defualt name
-1,,[asciz/exe/] ;default type
0 ;protections
0 ;account
0 ;JFN
comlin: block maxcom
comcop: block maxcom
asklin: block asklen
sublin: block maxcom ;space for substitution of text
wrkstr: block maxcom ;space for working out string expressions
sysval: block mswrd ;value of system symbols
rdbuf: block mswrd+1 ;buffer for .READ command
;
; 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
;
SAVRET: BLOCK 1 ;RETURN ADDRESS OF CMDINI CALLER
SAVREP: BLOCK 1 ;SAVED STACK POINTER TO RESTORE ON REPARSE
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
;
; Field descriptor block for .ASKN
;
numfdb: fld(.cmnum,cm%fnc)!cm%dpp!exfdb ;decimal number,default
^d10 ;radix 10
0
0
bmask
$$pure: ;start of pure section
subttl Pure storage - command tables, etc.
;
; Display size of impure section
;
radix 5+5
define shows(size,pag),<printx * Impure data storage = size words (pag pages)>
if1, <$$tmp==1
ife <<$$pure-$$impst>&^o777>,<$$tmp==0>
shows \<$$pure-$$impst>,\<<<$$Pure-$$impst>/^d512>+$$tmp>>
radix 8
;
; These are the pure tables of commands and permanent symbols
;
define key$(comand,imp<noimp>,routine<>),<
$comsz==$comsz+1
IFIDN <IMP> <imp>,<
IFNB <routine>,<[asciz/comand/],,routine>
IFB <routine>,<[asciz/comand/],,.'comand>>
ifidn <imp> <noimp>,< [asciz/comand/],,[tmsg <
%Can't .'comand yet...>
retskp]>>
define syk$(keyword,ktype,routine,%type1),<
%type1=-1
ifidn <ktype> <string>,<%type1=$str>
ifidn <ktype> <numeric>,<%type1=$num>
ifidn <ktype> <logical>,<%type1=$lgc>
ifidn <ktype> <file>,<%type1=$fil>
ifl %type1 <printx ?Unrecognised system symbol type:'%type1>
sysiz$=sysiz$+1
[asciz/<'keyword'>/],,[%type1,,routine]
.xcref %type1
purge %type1>
$comsz==0
comsym: comsiz,,comsiz ;number of entries in table
key$ ask,imp ;yes/no routine
key$ askf,imp ;file question
key$ askn,imp ;numeric question
key$ 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
comsiz==$comsz
purge $comsz
;
; table for yes/no
;
ysntab: 2,,2
[ASCIZ/NO/],,false
[asciz/YES/],,true
;
; Keywords for .ENABLE/.DISABLE, and the routines to do it
;
define enk$(word,code),<
[asciz/word/],,code
ensiz$==ensiz$+1>
ensiz$==0
edtab: ensiz,,ensiz ;number of entries in table
enk$ 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]
..data: enk$ DATA,[move t1,edtyp ;get type of command
setcam t1,datflg ;setup flag
ret]
enk$ ESCAPE,[movei t1,.priou
rfcoc%
movx t1,1b19 ;flag escape o
movx t4,2b19 ;flag escape allowed
skipe edtyp ;enable ?
exch t1,t4 ;no
trz t3,(t1)
tro t3,(t4)
movei t1,.priou
sfcoc%
ret]
enk$ EXTENDED-EXEC,[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
ret]
..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
ret]
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
ret]
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
ensiz==ensiz$
purge ensiz$
;
; keyword table for .IF directive
;
define relk$(relop,val),<
relsz$==relsz$+1
[asciz'relop],,val>
relsz$==0
reltab: relsz,,relsz ;size of table
relk$ "<",lt
relk$ "<=",le
relk$ "<>",ne
relk$ "=",eq
relk$ "=<",le
relk$ "=>",ge
relk$ ">",gt
relk$ "><",ne
relk$ ">=",ge
relk$ "eq",eq ;equals
relk$ "ge",ge
relk$ "gt",gt
relk$ "le",le
relk$ "lt",lt
relk$ "ne",ne
relk$ "~=",ne
relsz==relsz$
purge relsz$
;
; System symbol table
;
sysiz$==0
syssym: sysiz,,sysiz ;size of table
syk$ DATE,string,[movx t3,ot%ntm
jrst date.]
syk$ DIRECTORY,string,[gjinf% ;get dir number
hrroi t1,sysval
dirst%
ercal error
ret]
SYK$ EOF,logical,ineof. ;end of file status on input
syk$ FILESTAT,numeric,[move t1,filerr ;result of .TESTFILE
movem t1,sysval
ret]
syk$ STRLEN,numeric,[move t1,strlen
movem t1,sysval
ret]
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
ret]
sysiz==sysiz$
purge sysiz$
;
; dispatch table for numeric parser
;
optab: illvec ;illegal operator vector
nadd ;add
nsub
nmul
ndiv
;
; List of matching opening and closing brackets
;
brklst: "}",,"{"
"]",,"["
">",,"<"
")",,"("
"""",,""""
;
; GTJFN argument block for TESTFILE
;
tsargs: gj%old+gj%xtn ;old files,extended arguments
.nulio,,.nulio ;inout, output jfns
0 ;default device
0 ;default directory
0 ;defualt name
0 ;default type
0 ;protections
0 ;account
0 ;JFN
g1%iin ;allow invisible files
;
; Interrupt tables
;
levtab: pc1
pc2
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]
gtjfn%
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,
sout%
ercal error
movei t2,maxcom*5 ;what we wanted to write
sub t2,t3 ;minus what we didn't
soj t2, ;minus one for cr/lf problems
movem t2,linlen ;is what we did
skipe going ;are we trying for a target label ?
jrst tstfnd ;yes, see if we just found it
pop p,t1 ;throw away return address
move t1,[point 7,comlin]
jrst intfil ;go for a new parse
;
; here to check if we just found our target label
;
tstfnd: hrroi t1,target ;point to desired target
call luklab ;lookup target in label table
ret ;not found - continue searching
setzm going ;found - turn off GOTO flag
move t1,comjfn ;our command file
sfptr% ;set the pointer for the next read
ercal error
setzm target ;clear out GOTO target
ret ;continue executing commands
badcom: fatal <unidentifiable command: >,noret,,nocmd
jrst badc1
comfl: fatal <failure to parse command: >,noret,,nocmd
badc1: hrroi t1,scratch
psout%
tmsg <
[IND - exiting]
>
jrst haltt
subttl The .RUN command
;
; This rotine processes the .RUN command, replacing the EXEC run
; cos that doesn't work with CRCMD.
;
.run: stkvar <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
skipa
.setf: setom lgcflg ;false value
move t1,comptr ;point to command stuff
move t2,[point 7,asksym] ;and scratch store
call getwrd ;try out symbol
movem t1,comptr ;save command pointer
movei t1,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
skipa
.ift: setzm lgcflg
move t2,[point 7,scratch]
call getwrd ;get symbol name
call skpblk ;skip over blanks
movem t1,comptr ;save for later
hrroi t1,scratch ;point to symbol name
call luklgc ;try to find symbol
jrst [hrroi t1,scratch ;failed, try permanent symbol table
call luksys ;is it there ?
jrst [fatal <logical symbol not defined: >];return failure - symbol not known
caie t3,$lgc ;its there - is it logical ?
jrst [fatal <system symbol not type logical: >] ;no
jrst .+1] ;all ok
came t2,lgcflg ;is symbol what we want ?
retskp ;no, don't bother to do owt
move t1,comptr ;yes, skip over leadind blanks
call skpblk
.ift1: movem t1,comptr
hrroi t1,comlin ;prepare to rewrite command
move t2,comptr
movei t3,^d80 ;maximum length of line
setz t4, ;terminate on null
sout%
ercal error
movei t2,^d80 ;what we wanted to write
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
pop p,t1 ;throw away our return address
pop p,t1 ;and PARSES return too
move t1,[point 7,comlin] ;point to command
jrst intfil ;internal command entry
subttl .ASK command - get yes/no answer
;
; ASK for value of a logical symbol
;
.ask: stkvar askval ;value of answer,symbol name(3 words)
call iniflgs ;initialize <default>, etc.
move t2,[point 7,asksym] ;temporary storage for our symbol
call getwrd ;get the symbol
call skpblk ;skip over blanks
movem t1,comptr ;save command line pointer
movei t1,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
sout%
ercal error
.ask2: hrroi t1,asklin ;point to prompt
call cmdini ;output prompt
movei t1,cmdblk ;point to state block
movei t2,[fldbk. (.cmkey,,ysntab,,<NO>,bmask,exfdb)]
comnd% ;parse yes or no
ercal error
txne t1,cm%nop ;parse ok ?
jrst yesorno ;no, complain and try again
testz ;check for control z
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
>,noret,,nocmd
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),<
xlist
hrroi t1,[asciz/
'tabnam': /]
psout%
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
list
>
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:
>
ret
;
; 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.
>
ret
;
; The value printing routines
;
.stn: hrre t2,(t3) ;get numeric value
movx t3,^d10 ;print in decimal
movei t1,.priou ;on terminal
nout%
ercal error
tmsg <
>
ret
.stl: hrrz t2,(t3) ;get logical value
hrroi t1,[asciz/ False.
/] ;false ?
skipn t2
hrroi t1,[asciz/ True.
/] ;nope, true
psout%
ret
.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
psout%
tmsg <
>
ret
.stf: hrrz t2,(t3) ;get JFN
movei t1,.priou ;type on terminal
setz t3, ;no fancies
jfns% ;type filename
erjmp error
tmsg <
>
ret
.stlb: tmsg < at byte >
hrrz t2,(t3) ;get byte number
movx t3,^d10
movei t1,.priou
nout%
ercal error
tmsg <
>
ret
subttl Set numeric symbol
;
; .SETN command - set a symbol to a numeric value.
;
; Format: .SETN symbol nnnn
;
.setn: stkvar setnvl ;value
move 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:
; .ENABLE SUBSTITUTION
;
.disable: setom edtyp ;mark enable
skipa
.enable: setzm edtyp
move t2,[point 7,scratch] ;point to the scratch buffer
call getwrd ;grab the argument to command
hrroi t2,scratch ;now point to the word
movei t1,edtab ;table of keywords for command
tbluk% ;try and lookup in the table
ercal error ;crash - table is trashed
txne t2,tl%nom ;match found ?
jrst .disa1 ;no - bad argument - complain
txne t2,tl%amb ;ambiguous ?
jrst .disa2 ;yes - complain
skipe datflg ;are we in DATA mode ?
jrst [caie t1,..data ;yes, is it the DATA directive ?
retskp ;no, ignore
skipn edtyp ;OK, is it DISABLE ?
retskp ;no, ignore
jrst .+1] ;yes, allow it
hrrz t2,(t1) ;OK - get routine to do the work
call (t2) ;call it
retskp ;and return success
;
; Errors from keywords
;
.disa1: fatal <unrecognised .ENABLE/.DISABLE flag:
>
.disa2: fatal <ambiguous: >
subttl .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
sout%
ercal error
skipn nrng ;ranges, defaults ?
jrst .askn4 ;no, skip next
move t2,nrng ;get number of ranges
caige t2,2 ;at east 2 ?
jrst .askn4 ;no, strange syntax
movei t2," "
idpb t2,t1
movei t2,"R" ;bung out some chars
idpb t2,t1
movei t2,":" ;it's a waste of time using SOUT for
idpb t2,t1 ;this sort of thing - only a few chars
move t2,q1 ;get lower range
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
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .askn2 ;ask again
purge askval,nrng
.askn7: fatal <answer not in range
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .askn2
subttl .IFDF/.IFNDF commands
;
; Conditional execution depending on whether a symbol is defined
;
.ifndf: setzm ifdtyp ;flag not defined wanted
skipa
.ifdf: setom ifdtyp ;symbol must be defined
move t2,[point 7,asksym]
call getwrd ;get symbol name
call skpblk ;skip over blanks
movem t1,comptr ;save for later
setom fnd ;mark found initially
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
sout%
ercal error
movei t2,^d80 ;what we wanted to write
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
pop p,t1 ;throw away our return address
pop p,t1 ;and PARSES return too
move t1,[point 7,comlin] ;point to command
jrst intfil ;internal command entry
subttl The .PAUSE command
;
; This command uses the p$USH bit in CRCMD, which just continues the
; EXEC until we do a POP.
;
.pause: 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]
>
retskp
subttl The GOTO command
;
; This command is of the form .GOTO lab, where lab will be in
; the file in the form .lab: . We check if it is already in the symbol
; table, in which case we can use SFPTR and return, or we must set
; GOING to true, and set up the label in TARGET, returning to allow
; a search through the file for the label.
;
.goto: move t1,comptr ;point to label name
move t2,[point 7,target] ;where to put label
call getwrd ;pickup label from command
movem t1,comptr ;save pointer
hrroi t1,target ;point to label
call luklab ;does it exist ?
jrst .goto2 ;no, we must search
move t1,comjfn ;yes, just reset
sfptr% ;the file pointer
ercal error
retskp ;and continue from the label
.goto2: setom going ;no, we must set up for a goto search
retskp ;which inhibits command execution
subttl The .OPEN, .OPENA and .CLOSE commands
;
; These commands are of the form .OPEN filename and .CLOSE . They open a
; secondary fileto which the output of the .DATA directive, or .ENABLE
; DATA is directed. .CLOSE is a no-op if no file is open.
; .OPENA opens the file for append, not write
;
.opena: movx t3,fld(7,of%bsz)+of%app ;open for append
movx t1,gj%sht!gj%old ;file must exist
jrst .+3
.open: movx t3,fld(7,of%bsz)+of%wr ;open for write
movx t1,gj%sht!gj%new!gj%fou ;new file
skipe datjfn ;file already open ?
jrst [fatal <File already open:>] ;yes, complain
move t2,comptr
gtjfn% ;attempt to get a handle
erjmp .open1 ;failed for some reason
movem t1,datjfn ;save the handle
move t2,t3 ;open for write or append
openf%
erjmp .open1 ;failed for some reason
retskp ;return success
.open1: fatal <can't OPEN file: >,noret,mcall
setzm datjfn ;clear in case error was on OPENF
ret ;return failure
.close: move t1,datjfn ;get file handle
jumpe t1,rskp ;if no file, return success
closf% ;close file
ercal errmes ;huh ?
setzm datjfn ;indicate we have no file
retskp ;return success
subttl The .DATA command - sends data to secondary file
;
; This command is of the form .DATA kwjre ekekkjtr wjejjetre
; Everything from the first non-blank character after the .DATA to the
; end of line is output to the secondary file, if it exists. If it does
; not, an error is generated.
;
.data: move t1,datjfn ;get handle on secondary file
jumpe t1,[fatal <no data file open:>] ;nofile open- complain
move t2,comptr ;pointer to data for file
setzb t3,t4 ;write until null seen
sout%
erjmp [fatal <error writing to data file:>,,mcall] ;we have an error (disk full ?)
retskp ;return success
subttl The .SETFI command - set file symbol
;
; This command is of the form .SETFI FILS Filename.type
; It sets up a file symbol
;
.setfi: move t2,[point 7,asksym]
call getwrd ;get file symbol name
call skpblk ;skip over blanks
movem t1,comptr
movei t1,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
sout%
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
confirm
jrst .askf2
hrroi t1,asksym ;point to symbol
move t2,askval ;value of answer
call entfil ;enter into table
ret ;return failure
retskp ;return success
purge askval
subttl .GOSUB, .RETURN commands
;
; These two commands allow one to have subroutines in IND files.
; .GOSUB pushes down a call stack, and uses the .GOTO code. .RETURN
; pops the .GOSUB stack, and resets the byte pointer for input.
;
.gosub: move t3,gonst ;check GOSUB nesting depth
cail t3,mxcnst-1 ;maximum call depth exceeded ?
jrst [fatal <subroutine nesting depth exceeded:
>,stop] ;yes, crash
move t1,comjfn ;command file JFN
rfptr% ;find start of next line
ercal error
movem t2,substk(t3) ;and stack on the subroutine list
aoj t3, ;bump the pointer
movem t3,gonst ;and store it again
jrst .goto ;get .GOTO to do the rest of the work
;
; .RETURN
;
.return: skipn gonst ;are we in a subroutine ?
jrst [fatal <.RETURN when not in subroutine:>]
move t1,gonst ;yes, get the nesting depth
soj t1, ;decrement
movem t1,gonst ;place back
move t2,substk(t1) ;get old file pointer
move t1,comjfn ;JFN of command file
sfptr% ;reset to continue from old place
ercal error
retskp ;return success
subttl .ASKS command - ask for a string
;
; format : .ASKS [low:high] symnam what is your name?
;
; low and high are optional range bounds for length
;
.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
sout%
ercal error
move t2,nrng ;get number of ranges
caie t2,2 ;at east 2 ?
jrst .asks4 ;no, strange syntax
movei t2," "
idpb t2,t1
movei t2,"R" ;bung out some chars
idpb t2,t1
movei t2,":" ;it's a waste of time using SOUT for
idpb t2,t1 ;this sort of thing - only a few chars
move t2,q1 ;get lower range
movx t3,^d10
nout% ;write it out
ercal error
movei t2,":" ;separator
idpb t2,t1
movx t3,^d10
move t2,q2 ;upper range
nout% ;write it out
ercal error
.asks4: movei t2,"]"
idpb t2,t1
setz t2,
idpb t2,t1
.asks2: hrroi t1,asklin ;bung out CTRL/R buffer
call cmdini ;initialize COMND blocks
movei t1,cmdblk ;point to state block
list
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
confirm
jrst .asks2 ;failed confirmation
move t1,[point 7,atmbfr] ;point to start of answer
.asks5: movem t1,askval ;remember as value
move t2,nrng ;were ranges supplied
cain t2,2
jrst .asksr ;yes, check we are in range
.asks6: hrroi t1,asksym ;point to symbol
move t2,askval ;get value of answer
call entstr ;enter into table
ret ;faile
move t1,[point 7,atmbfr] ;point to answer
call leng ;get length of it
movem t3,strlen ;remember for user
retskp ;succeed
;
; check answer is in range
;
.asksr: move t1,[point 7,atmbfr] ;point to answer string
call leng ;get length
camge q2,t3 ;top limit greater ?
jrst .asks7 ;no
camle q1,t3 ;bottom limit lower ?
jrst .asks7 ;no
jrst .asks6 ;yes, OK
;
; Complain about answer
;
purge askval,nrng
.asks7: fatal <string length not in range
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .asks2
subttl The .STOP and .EXIT directives
;
; .STOP simulates EOF, but does not print the @ <EOF> message. .EXIT
; is more complex - if the current file has been .CALLed, it does an
; immediate return to our superior command file, otherwise it simulates
; EOF with the @ <EOF> message.
;
.stop: jrst stopp
.exit: jrst eof
subttl The .IF command - permits comparison between strings or numbers
;
; This directive is of the form
; .IF symbol relop expression command
;
; where symbol is either a numeric or a string symbol name, relop is one
; of eq(=) ne(~=) gt(>) ge(>=) lt(<) le(=<) and expression is either
; string or numeric in type according to symbol. The alternative forms of
; relops are shown in brackets after their mnemonic names. The command
; is executed if the comparison returns a true result.
;
.if: move t2,[point 7,asksym] ;where to put our symbol name
call getwrd ;retrieve the symbol
call skpblk ;skip over blanks
move t2,[point 7,scratch] ;now get operator
call getwrd ;retrieve in ASCIZ
call skpblk ;skip over next blanks
movem t1,comptr ;and save position of start of exp
movei t1,reltab ;table of relational operators
hrroi t2,scratch ;one we are considering at the moment
tbluk% ;determine if in table
ercal error ;crash - tables trashed
txnn t2,tl%exm ;exact match ?
jrst .if1 ;no, complain - bad relop
hrrz t2,(t1) ;OK, get relop ID
movem t2,relop ;and remember for when we parse exp
hrroi t1,asksym ;now find out if string or numeric
call 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
skipa
.inc: move t2,[aoj t2,] ;increment instruction
push p,t2 ;save
move t1,comptr ;command pointer
move t2,[point 7,asksym] ;storage for symbol name
call getwrd ;get name
hrroi t1,asksym ;don't use ASKCHK - number MUST alread
call luknum ;exist.
jrst .ince ;it doesn't - complain
hrroi t1,asksym ;we now have the current value in t2
pop p,t3 ;so retrieve inc/dec instruction
xct t3 ;and execute it
call entnum ;and re-enter in table
ret
retskp ;return success
.ince: pop p,t1 ;throw away saved instruction
fatal <symbol does not exist for increment/decrement:>
subttl The .TEST command - test the length of a string expression
;
; This command is of the form .TEST strexp, and sets the special
; symbol <STRLEN> to the length of the string in characters.
;
.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
gtjfn%
erjmp .tsf3 ;OK, try invisible
setom filerr ;indicate status
jrst .tsf5 ;now test for offline
.tsf3: move t2,comptr ;get saved filename pointer
movei t1,tsargs ;pointer to long form argument block
gtjfn% ;try again
erjmp .tsf4 ;file definitely not found (syntax OK)
movx t2,-2 ;set invisible status
movem t2,filerr ;mark
.tsf5: move t2,[1,,.fbctl] ;get .FBCTL out of the FDB
movei t3,t4 ;return info in t4
gtfdb% ;grab info
ercal error ;die horribly
move t2,filerr ;get current status word
txne t4,fb%off ;file is offline ?
movx t2,-3 ;yes, indicate
movem t2,filerr ;remeber status
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
openf%
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
retskp
;
; 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
; .CLOSEI
;
; This command opens a file for input with the specified name. The file is
; read using the .READ directive. Only one input file may be open at a
; given time. This does not interact with the .OPEN directive.
; .CLOSEI closes the current input file. It is a noop if no file is open.
;
.openi: movx t3,fld(7,of%bsz)+of%rd ;open for read
movx t1,gj%sht!gj%old ;old file
skipe inpjfn ;file already open ?
jrst [fatal <Input file already open:>] ;yes, complain
move t2,comptr
gtjfn% ;attempt to get a handle
erjmp .opin1 ;failed for some reason
movem t1,inpjfn ;save the handle
move t2,t3 ;open for read
openf%
erjmp .opin1 ;failed for some reason
retskp ;return success
.opin1: fatal <can't OPEN input file: >,noret,mcall
setzm inpjfn ;clear in case error was on OPENF
ret ;return failure
.closi: move t1,inpjfn ;get file handle
jumpe t1,rskp ;if no file, return success
closf% ;close file
ercal errmes ;huh ?
setzm inpjfn ;indicate we have no file
retskp ;return success
subttl The .READ directive - get data from input file
;
; Format: .READ string-variable
;
; This directive reads the next line from the current input file into
; the string variable named. An error is given if the input line is
; longer than the maximum string length allowed. Any cr/lf pair on
; the end of the data is stripped.
;
.read: skipn inpjfn ;any input file open ?
jrst [fatal <no input file open:>]
move t2,[point 7,asksym] ;storage for symbol name
call getwrd ;read the symbol name
movei t1,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
nout%
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
nout%
ercal error
hrroi t2,scratch ;fool the rest of the code
jrst subst3 ;and continue
;
; print out remainder of command in buffer, and copy buffer back
; to comlin
;
subend: move t1,subptr ;where we are
move t2,comptr ;where we are coming from
setzb t3,t4 ;terminate on null
sout% ;write rest of string
ercal error
hrroi t1,comlin ;point back to comlin
hrroi t2,sublin ;and to where we have the substituted
movei t3,maxcom*5 ;maximum command length
setz t4, ;string in ASCIZ
sout%
ercal error
movei t2,maxcom*5-1 ;what we wanted to read
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
move t1,[comlin,,comcop] ;make copy of command line
blt t1,comcop+maxcom-1 ;for use by .DATA directives
move t1,[point 7,comlin] ;restore command pointer
retskp ;return success
purge newptr,subptr,subst ;throw away temporary names
;
; string symbol not found
;
subnf: fatal <undefined symbol for substitution: >
;
; mismatched quotes
;
sbqerr: fatal <mismatched quotes while substituting: >
;
; Crazy system symbol type
;
illsy: fatal <invalid system symbol type>
subttl Rescan EXEC command line for input file
;
; This routine rescans our command line to attempt to get a filename
; for it. It also picks up any parameters from the command line and
; sets them up as string symbols.
;
gcom: movei t1,.rsini ;initialize for rescan
rscan%
ercal error
movei t1,.rscnt ;count of chars in buffer
rscan%
ercal error
movnm t1,t3 ;make a count for SIN%
movei t1,.priin ;read rescan stuff
hrroi t2,scratch ;write to scratch
setz t4, ;terminate on null
sin% ;read rescan stuff
adjptr t2,[3] ;bump pointer to safe area
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
ret
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
ret
;
; exit if ctrl/z exit is allowed
;
exit: skipe extflg ;allowed to exit ?
ret ;no
jrst haltt ;yes - finish up
;
; set <escape> to true
;
escon: setom escflg
ret
prtcmd: hrroi t1,comlin
psout%
ret
;
; Check substring limits - byte pointer in t1 to string, or 0 if not
; yet exists. Q1,Q2 contain start, finish. Check that q1<=q2, and
; if t1 is not 0, that q2 is less than the length of the string.
; Also check q1>0
;
cksubs: skipg q1 ;q1 > 0 ?
ret ;no, complain
camle q1,q2 ;q1 <= q2 ?
ret ;no, complain
skipn t1 ;pointer supplied ?
retskp ;no, return success
push p,t1 ;save pointer
call leng ;get length of string
skipge t3 ;length OK ?
jrst cksub1 ;no... strange
camle q2,t3 ;top of range less than string length ?
jrst cksub1 ;no, complain
pop p,t1 ;restore pointer
retskp ;yes, OK
cksub1: pop p,t1
ret
;
; write to data file if necessary
; Must preserve AC 1. On entry: DATFLG/-1, datsav/0:
; Last command was .ENABLE DATA, do nowt
; -1,-1: In DATA mode, write to file
; 0,-1: Last command was .DISABLE DATA, do nowt
;
wdata: skipn datsav ;are we in DATA mode ?
ret ;no, just ENABLEd now
skipn datflg ;just done a .DISABLE DATA ?
ret ;yes, do nowt
push p,t1 ;save useful acs
skipn datjfn ;open data file ?
jrst wdata1 ;no, crash
hrroi t2,comcop ;yes, write to file
move t1,datjfn ;from command buffer
setzb t3,t4 ;terminate on null
sout% ;write
ercal error
pop p,t1
ret ;return OK
wdata1: fatal <can't .ENABLE DATA without data file open.>,stop,,nocmd
;
; Routine to clear typeahead buffer
;
clrinp: movei t1,.priin ;point to terminal
cfibf% ;clear input buffer
ercal error
ret
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT DESIGNATOR
RFPOS ;READ FILE POSITION
HRRZ T2,T2 ;KEEP JUST THE COLUMN POSITION
JUMPE T2,R ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
TMSG <
> ;NO, OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
subttl Routines used by system symbol tables
;
; These routines find the values of various system permanent symbols,
; and leave their answers (of whatever forms) in SYSVAL.
;
date.: hrroi t1,sysval ;where to put output string
seto t2, ;current date/time
odtim% ;format bits already in t3
ret
sysnm.: move t1,[sixbit/SYSVER/] ;routine to find system name
sysgt% ;find out how many words in table
hrrz t1,t2 ;put table number in t1
hlre t3,t2 ;set up counter
hrrzs t2,t2 ;leave t2 with just a table number
setz t4,
sysnm1: getab% ;read next word from table
ercal error
movem t1,sysval(t4) ;store
aoj t4, ;bump t4
hrlz t1,t4 ;set up t1 again - getab trashes it
hrr t1,t2 ;and get the table number
aojn t3,sysnm1 ;go until finished
ret ;all done
;
; Here to check for end-of-file on input
;
ineof.: skipn t1,inpjfn ;any file open for input ?
jrst [setom sysval ;no, return false always
ret]
gtsts% ;yes, so read status of JFN
ercal error
setzm sysval ;assume true first
txnn t2,gs%eof ;is end-of-file set ?
setom sysval ;no, so indicate false
ret ;return to caller
subttl comment processing
;
; This routine is called to output comments in command files to the
; screen
;
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
ret
;
; IND comments
;
.coment: retskp ;succeed always, do nowt
;
; Called whenever an error occurs executing an EXEC command with
; JSYS error in t3
;
excerr: tmsg <
?IND - error executing command: >
movei t1,.priou ;type on terminal
move t2,t3 ;get error number in right place
hrli t2,.fhslf ;must point to own fork
setz t3, ;no limit on message length
erstr% ;type out JSYS error
trn
trn ;ignore errors with errors
haltt: call .endlog ;close out logfile if necessary
nop
haltf% ;stop
tmsg <
?Cannot be continued>
jrst haltt
;
; called ar end of file
;
eof: skipe going ;still searching for a label ?
jrst laberr ;yes, error
skipn calnst ;end of .CALLED file ?
jrst eof1 ;no, proceed as normal
sos calnst ;drop nesting level
move t1,comjfn ;get old command file JFN
closf% ;close it
erjmp .+1 ;ignore errors
move t1,calnst ;get current value
move t2,calstk(t1) ;and get old command file JFN
movem t2,comjfn ;store as new one
jrst fillop ;loop for next command
eof1: tmsg <
@ <EOF>>
stopp: skipe datjfn ;data file open ?
jrst [move t1,datjfn ;yes, close it
closf%
erjmp .+1 ;ignore errors
jrst .+1]
jrst haltt
laberr: fatal <End of file while searching for label ">,noret,,nocmd
hrroi t1,target ;point to label name
psout% ;type it
tmsg <">
jrst haltt ;stop
;
; called from numeric parser
;
illvec: fatal <fatal internal error in numeric parser - impossible operator invoked.>,stop
subttl Read next command line
;
; This routine zeros out the command space and reads in the next line
; from the command file. It returns +1 on error, +2 on success
;
getlin: setzm comlin ;zero out first word of command
setzm purcmd ;indicate real command for SUBSTI
move t1,[comlin,,comlin+1] ;from,,to
blt t1,comlin+maxcom-1 ;zero out command line
move t1,comjfn ;handle on command file
rfptr% ;read where we are in file
ercal error
movem t2,cbyt ;remember for .goto, etc.
hrroi t2,comlin ;where to put command line
movei t3,maxcom*5 ;maximum chars in string
movei t4,lf ;terminate on linefeed
sin% ;read record
erjmp [ret] ;return +1 - failure
movei t2,maxcom*5 ;what we wanted to read
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
move t1,[point 7,comlin] ;return start pointer
retskp ;return success
subttl Enable interrupt system for fork errors, PTY
;
; This sets up the interrupt system tables, and enables the channels
; we use for inferior fork traps and for PTY output. Although the
; channels are activated by this routine, we do not expect them to be
; used until the appropriate routine causes action on that channel.
;
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.
>,noret,,nocmd
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
openf%
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
tlink%
ercal error
move t1,ptyjfn ;point to PTY again
movx t2,mo%oir!fld(ptychn-1,mo%sic)!.moapi ; enable output-is-ready
;interrupts
mtopr% ;do it
ercal error
retskp ;return success
;
; Routine to release PTY and deassign interrupts
;
nopty: move t1,ptyjfn ;get PTY jfn
closf% ;close and release (dispose of links)
ercal error
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 !!!!>
debrk%
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:
; TOP BOTTOM
; op val op val ... op val.
;
; which is unstacked on every ")". Initially we put 0 and "+" as the
; current op and val, in case we get (1+2) or that.
; Opcodes:
; +:1 -:2 *:3 /:4
; 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
ret
nsub: move t3,cnval ;get first operand
sub t3,nval ;subtract second
movem t3,cnval ;store result
ret
nmul: move t3,nval ;get second operand
imulm t3,cnval ;multiply by first and store
ret
ndiv: move t3,cnval ;get dividend
idiv t3,nval ;divide by divisor
movem t3,cnval ;store result
ret
subttl String expression parsing
;
; This subroutine accepts, like numexp, a pointer in t1 to the
; start of a string expression to be parsed. It calls NUMEXP, via
; RANGES, when doing substring evaluation. It accepts string constants
; of the form "asbdek", string variable names, like STREXP, and optional
; range values on the variables: STREXP[1:23] . The numbers indicate
; start and stop chop positions for a substring. The only operator is
; "+" for concatenation.
; Input: t1/byte pointer to expression (parse stops on bad char)
; Output: t2/ Pointer to result of expression
;
strexp: stkvar <stxptr,qstrt,ssymvl>
setzm wrkstr ;initialize parsed string to null
move t2,[point 7,wrkstr] ;point to it
movem t2,stxptr ;initialize expression pointer
strelp: ildb t3,t1 ;get a byte
caie t3,quote ; "?
jrst ssymev ;no, must be a symbol
movei t2,quote ;get closing quote
movei t3,mslen ;maximum string length
movem t1,qstrt ;save start of string
call search ;search for matching quote
skipge t3 ;found ?
jrst strex1 ;no - complain
movem t1,comptr ;save position in string of end
move t2,qstrt ;get start position
movns t3,t3 ;make absolute limit
jumpe t3,strel1 ;special for null string ""
movei t4,quote ;terminate on "
move t1,stxptr ;write to expression buffer
sout% ;write quoted string
ercal error
strel1: ibp t2 ;bump past " in input
movem t1,stxptr ;save pointer position
movem t2,comptr ;and position to read from command
jrst getop ;get possible operator
ssymev: bkptr t1
move t2,[point 7,scratch] ;where to put symbol name
call getwrd ;get symbol name
movem t1,comptr ;save end of symbol
hrroi t1,scratch ;point to symbol name
call lukstr ;and lookup value in tables
jrst [hrroi t1,scratch ;not there - try system symbol
call luksys ;is it there ?
jrst strex2 ;not there - complain
caie t3,$str ;string type symbol ?
jrst strex3 ;no - complain
hrroi t2,sysval ;construct pointer to value
jrst .+1] ;OK - is there
movem t2,ssymvl ;remember string value (ie pointer)
move t1,comptr ;point to next byteof expression
call ranges ;check for possible substring stuff
ret ;bad range format
movem t1,comptr ;may have moved
jumpe t2,ssymnr ;if no ranges, jump over
caie t2,2 ;if ranges, must be 2 and 2 only
jrst bdsubs ;bad substring format
move t1,ssymvl ;get symbol value pointer
call cksubs ;check substring stuff is in range
jrst bdsubs ;no - complain
move t2,ssymvl ;OK, point to string start
adjptr t2,q1 ;start of substring
bkptr t2 ;but ranges start at 1, so....
move t3,q2 ;get end of range
sub t3,q1 ;compute difference
aoj t3, ;add 1 'cos of 1/0 stuff
movns t3,t3 ;make negative for absolute limit
setz t4, ;terminate
move t1,stxptr ;next bit of expression
sout% ;write out
ercal error
idpb t4,t1 ;dump out extra null
bkptr t1 ;and backup over it
movem t1,stxptr ;save pointer to result
jrst getop ;get possible operand
;
; String symbol, no range specified
;
ssymnr: move t2,ssymvl
; move t2,[point 7,strings]
; adjptr t2,t3 ;adjust to point to correct POOL byte
move t1,stxptr ;where we will put expression
setzb t3,t4 ;termiate on null
sout% ;write variable value
ercal error
movem t1,stxptr ;remember where we got to
jrst getop ;get possible operand
;
; Check for operand
;
getop: move t1,comptr ;point to command
ildb t2,t1 ;get next char
caie t2,"+" ;is it "+" ?
jrst strext ;no, exit
movem t1,comptr ;yes, grab next bit
jrst strelp ;got to it !!!
;
; Check and exit
;
strext: bkptr t1 ;back up over non-+
move t2,[point 7,wrkstr] ;where the result is
retskp ;return success
;
; errors in string parsing
;
strex1: fatal <mismatched " in string constant:>
strex2: fatal <unknown string symbol in expression:>
strex3: fatal <system symbol in string expression is not of type string:
>
bdsubs: fatal <substring limits invalid: >
purge stxptr,qstrt,ssymvl
subttl Symbol table manipulation
;=======================================================
;
; These are the symbol table manipulation routines.
; They provide code for entering symbols into the tables,
; and performing table lookup. All are +1/+2 return type stuff,
; and the usual convention is to have a byte pointer in t1 to the
; symbol in ASCIZ, and have data returned in t2 (i.e. symbol value,
; or pointer to symbol value.)
;
;=========================================================
;
; entnum: enter a numeric symbol. t1- pointer to symbol name
; t2 - symbol value
;
entnum: movei t3,numsym ;address of numeric symbols
call entval ;get entval to do the work
ret
retskp
;
; luknum - lookup a numeric symbol - return +1 if not there, +2 if is
; input: t1/Pointer to symbol name
; output: t2/ Value of symbol if it exists
; t3/Position in table if exists
;
luknum: movem t1,t2
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
sout%
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
GTJFN%
erjmp recerr
movem t1,recjfn
movx t2,fld(7,of%bsz)!of%app
openf%
erjmp recerr
hrroi t2,[asciz/
User /]
setzb t3,t4
sout%
erjmp recerr
gjinf%
movem t1,t2
move t1,recjfn
dirst%
erjmp recerr
hrroi t2,[asciz / at /]
setzb t3,t4
sout%
erjmp recerr
seto t2,
setz t3,
odtim%
erjmp recerr
closf%
erjmp recerr
ret
recerr: tmsg <
%User logfile write failed, please inform KEVIN:>
call errmes
ret>
subttl COMND - related routines
;
; These are routines to initialize the COMND state blocks and
; to parse things sucj as noise phrases and confirms.
;
;
; Once-only routine to initialize comnd state blocks
;
cmdset: HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
movei t1,gjfblk ;point to GTJFN block
movem t1,cmdblk+.cmgjb ;store pointer
MOVEI T1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM T1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI T1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM T1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI T1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM T1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
ret
; INVALID END-OF-COMMAND
CFMERR: CALL TSTCOL ;TEST COLUMN POSITION
TMSG <?Not confirmed> ;OUTPUT ERROR MESSAGE
RET ;RETURN TO WHENCE WE CAME ...
SUBTTL COMND PARSING SUBROUTINES
; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL: CALL ENDCOM
; RETURNS: +1 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
; +2 SUCCESS, COMMAND CONFIRMED
ENDCOM: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND ;PARSE CONFIRMATION
ercal error ;error, go check for eof on take file
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
JRST [ CALLRET CFMERR ] ;NO, ISSUE ERROR MESSAGE AND RETURN
RETSKP ;SUCCESS, RETURN
; ROUTINE TO PARSE NOISE PHRASE
;
; CALL: T2/ POINTER TO NOISE PHRASE
; CALL SKPNOI
; RETURNS: +1 ERROR, INVALID NOISE PHRASE
; +2 SUCCESS, NOISE PHRASE PARSED OK
SKPNOI: MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
SETZM NOIFDB ;CLEAR FIRST WORD OF BLOCK
BLT T1,NOIFDB+FDBSIZ-1 ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVX T1,.CMNOI ;GET FUNCTION TO PERFORM
STOR T1,CM%FNC,NOIFDB ;STORE FUNCTION CODE IN FDB
MOVEM T2,NOIFDB+.CMDAT ;STORE POINTER TO NOISE PHRASE IN FDB
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,NOIFDB ;GET ADDRESS OF FUNCTION BLOCK
COMND ;PARSE NOISE WORD
ercal error ;error, go check for eof on take file
TXNN T1,CM%NOP ;NOISE PHRASE PARSED OK ?
RETSKP ;YES, RETURN SUCCESS
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
HRROI T1,[ASCIZ/Invalid guide phrase/]
ret
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PROMPT STRING
; CALL CMDINI
;RETURNS: +1 ALWAYS, WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
; CALL TO CMDINI.
CMDINI: MOVEM T1,CMDBLK+.CMRTY ;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
POP P,SAVRET ;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
MOVEM P,SAVREP ;SAVE STACK POINTER TO BE RESET ON REPARSE
MOVEI T1,REPARS ;GET ADDRESS OF REPARSE ROUTINE
txo t1,cm%wkf!cm%xif ;wake on every field, no indirect files
MOVEM T1,CMDBLK+.CMFLG ;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
COMND ;INITIALIZE COMMAND SCANNER JSYS
ercal error ;ERROR, GO SEE IF END OF "TAKE FILE"
JRST @SAVRET ;RETURN
; HERE TO PROCESS A REPARSE
REPARS: MOVE P,SAVREP ;RESET STACK POINTER
JRST @SAVRET ;RETURN TO CALLER OF CMDINI
; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL: CALL CLRGJF
; RETURNS: +1 ALWAYS
CLRGJF: MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD OF BLOCK
BLT T1,GJFBLK+GJFSIZ-1 ;CLEAR GTJFN BLOCK
RET ;RETURN TO WHENCE WE CAME ...
subttl EXEC handler - lifted from CRCMD en mass.
;
; This subroutine has been taken direct from the CRC subroutine library.
; We need it here because we need to access some of its internal variables
; such as the fork handle of its inferior EXEC.
;
;
; The program is called from fortan as below :
;
; call crcmd('print file.dat/forms:la1',flags,jserr)
;
; from macro , pass a byte pointer in t1
; a flag word in t2, jsys error returned in t3
;
; The meaning of the flag word is as follows:
; 0 Do nothing unusual
; b35 (1) Use MEXEC instead of EXEC
; b34 (2) Allow echoing of commands
; b33 (OBSOLETE) (4)
; Do not release EXEC fork- freeze it, and check for existing
; fork on reentry
; b32 (8) Do not pass command to EXEC - merely run it and WFORK.
; b31 (16) Allow COMAND.CMD to be executed
; The strategy is to get the EXEC in a lower fork (natch), clear
; the input buffer, wait till output finishes, and lock the keyboard
; (send ^s). We then rename COMAND.CMD to COMAND.crcmd (to stop it
; being executed) and do STIs to get the stuff in, followed by a POP.
; We do a DIBE to wait for the time to put the POP in, and then WFORK.
; It may be necessary to do a KFORK after we give the command, to prevent
; errors in the command from clearing our typeahead.
;
define db(code),<ifdef $dbg,<code>>
; $dbg==0
c$cmd==20 ;COMAND.CMD no rename
cr==15
lf==12
ctrls==23 ;xoff
xon==21
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
1b0+4
1b0+5
1b0
0
prblen==6
$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
gtjfn%
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
pbout%
>
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
gtjfn%
erjmp crerr
movem t1,t2 ;save JFN for COMAND.CMD
move t1,cmdjfn ;retrieve JFN of COMAND.crcmd
rnamf% ;rename
trn
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>>
skipa
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
skipa
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
;
tsfork:
db <skipn waspsh
jrst [push p,t1
tmsg <
%Exec was not pushed last time>
pop p,t1
jrst $db1]
push p,t1
tmsg <
%Exec was pushed last time>
pop p,t1
$db1:>
skipn waspsh ;pushed last time ?
ret ;no, just return
movem t1,t3 ;save fork handle
movei t1,^d500 ;1/2 second
disms%
move t1,t3 ;get handle again
rfsts% ;read fork status
db <push p,t1
push p,t2
push p,t3
movem t1,t2
movei t1,.priou
movx t3,^d10
nout%
erjmp [jshlt]
tmsg < was Fork status
>
pop p,t3
pop p,t2
pop p,t1>
db <tmsg <
%Continuing EXEC>>
move t1,t3 ;yes, get handle
txo t1,sf%con ;mark for continue
sfork% ;start
db <erjmp [tmsg <
%Error from SFORK>
jrst .+1]>
erjmp .+1 ;ignore error - process ws never started
ret
;
; errors come here
;
crerr:
IFN xonoff,<movei t1,xon ;reallow terminal input
pbout%
>
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
ret
subttl String handling routines
;===========================================================
;
; These are the general string-handling routines. They generally
; accept a byte pointer to a source string in t1.
;
; LENG - computes length of ASCIZ string
; byte pointer in t1
; length returned in t3 - -1 if more than 256 chars
;
leng: setz t2, ;tell SEARCH to look for null
movei t3,^d256 ;max length acceptable
call search ;get search to do the work
ret
;
; SEARCH - byte pointer in t1
; character to search for in t2
; Maximum length in t3 (terminated on null also)
;
; Returns: Updated pointer in t1
; Position in t3, or -1 if not found.
;
search: movns t3,t3 ;negate count
hrlz t3,t3 ;place in left half,use right half for count
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>