Trailing-Edge
-
PDP-10 Archives
-
tops10and20_integ_tools_v9_3-aug-86
-
tools/crc/ind/v4ind.mac
There are no other files named v4ind.mac in the archive.
;<IND>IND.MAC.457, 17-Feb-84 13:29:51, EDIT BY KEVIN
; Add <FILPAG>,<FILSIZ>,<FILBYS>
;<IND>IND.MAC.456, 24-Jan-84 10:32:09, EDIT BY KEVIN
; IND doesn't work in batch yet. Make sure people don't try.
;<IND>IND.MAC.451, 2-Nov-83 14:00:05, EDIT BY KEVIN
; Add the TELL directive
;<IND>IND.MAC.448, 6-Sep-83 13:23:42, EDIT BY KEVIN
; When saving and restoring JFN mode words in $CRCMD, we have problems
; because the JFN mode word is not big enough to store fields like TT%WID.
; We must use MTOPR to save and restore these explicitly.
;<IND>IND.MAC.447, 1-Sep-83 16:48:18, EDIT BY KEVIN
; Make invalid filespecs in .TESTFILE return error -4
;<IND>IND.MAC.446, 1-Sep-83 16:44:12, EDIT BY KEVIN
;<IND>IND.MAC.445, 24-Aug-83 17:45:59, EDIT BY KEVIN
; Add another system symbol (BYTEPOS) for current position of input file,
; and another directive (POSITION) to get there.
;<IND>IND.MAC.444, 24-Aug-83 16:16:52, EDIT BY KEVIN
; .PURGE directive doesn't decrement symbol usage stats.
;<IND>IND.MAC.443, 24-Aug-83 16:04:04, EDIT BY KEVIN
; Squeeze stopped working when we altered the symbol tables
;<IND>IND.MAC.442, 20-Jul-83 12:04:56, EDIT BY KEVIN
; Terminal occasionally hung with logging - suspect SOBE% problem.
;<IND>IND.MAC.441, 27-May-83 15:01:10, EDIT BY KEVIN
; Add .RADIX operator
;<IND>IND.MAC.440, 29-Apr-83 15:21:51, EDIT BY KEVIN
;<IND>IND.MAC.438, 29-Apr-83 15:09:36, EDIT BY KEVIN
; Add DAYTON and NTODAY to convert date strings to numbers, etc.
;<IND>IND.MAC.437, 11-Apr-83 14:00:22, EDIT BY KEVIN
; .RUN gives no error message when file not found.
;<IND>IND.MAC.436, 28-Mar-83 11:31:22, EDIT BY KEVIN
;<IND>IND.MAC.435, 28-Mar-83 11:16:49, EDIT BY KEVIN
; Purge had lost pointer to symbol to delete.
;<IND>IND.MAC.434, 1-Mar-83 15:57:46, EDIT BY KEVIN
; Make IND FAIL-compatible (give up 'cos we don't have MACSYM.FUN, and
; we can't use FAIL to compile MACSYM.MAC 'cos it uses IRP's which
; aren't FAIL-compatible, and you can't compile MONSYM without MACSYM
; and the MONSYM and MACSYM distributed with FAIL are from some
; prehistoric V of TOPS-20 like V3 or something..... I give up.)
;<IND>IND.MAC.433, 17-Feb-83 15:28:01, EDIT BY KEVIN
; Must do proper compare for logical values
;<IND>IND.MAC.431, 14-Feb-83 17:13:49, EDIT BY KEVIN
; Add CTRL/A panic abort, and .ENABLE/.DISABLE abort
;<IND>IND.MAC.430, 14-Feb-83 14:03:06, EDIT BY KEVIN
; .PARSE forgot to zero string count before using it.
;<IND>IND.MAC.429, 14-Feb-83 13:13:48, EDIT BY KEVIN
; .REAL directive in wrong place in command table
;<IND>IND.MAC.427, 14-Feb-83 11:35:09, EDIT BY KEVIN
; Make .TESTFILE return filename, device etc. fields on success.
;<IND>IND.MAC.424, 11-Feb-83 15:28:20, EDIT BY KEVIN
; Left a NOUT in .ASKR
;<IND>IND.MAC.423, 11-Feb-83 14:58:58, EDIT BY KEVIN
; If we can't find command file, look for it on SYS:
;<IND>IND.MAC.422, 9-Feb-83 14:47:23, EDIT BY KEVIN
; RANGES was losing its track of the stack
;<IND>IND.MAC.421, 9-Feb-83 14:14:49, EDIT BY KEVIN
; Forgot a couple of labels in range evaluation
;<IND>IND.MAC.420, 9-Feb-83 13:36:34, EDIT BY KEVIN
; Make ISDGT accept decimal points in a number
;<IND>IND.MAC.419, 9-Feb-83 13:31:57, EDIT BY KEVIN
; Woops - that means we have to add .SETR, .REAL, and add routines
; to lookup and set numeric symbols, and modify the substitution routines,
; and the range routines, and also add FLTEXP for floating expressions,
; and modify NUMEXP to fix floating numbers in integer expressions, and...
; why do I make work for myself like this ?
;<IND>IND.MAC.418, 9-Feb-83 12:13:10, EDIT BY KEVIN
; Add .ASKR - ask for a real symbol
;<IND>IND.MAC.414, 8-Feb-83 18:55:55, EDIT BY KEVIN
; Garbage collector destroyed string pool - typo.
;<IND>IND.MAC.413, 3-Feb-83 17:47:30, EDIT BY KEVIN
; Symbol use tables did not map into each other correctly
;<IND>IND.MAC.412, 3-Feb-83 17:33:38, EDIT BY KEVIN
; .IF directive couldn't handle strings
;<IND>IND.MAC.410, 3-Feb-83 17:02:15, EDIT BY KEVIN
; Add .DDT directive to merge SYS:UDDT
;<IND>IND.MAC.408, 3-Feb-83 16:48:47, EDIT BY KEVIN
; Problem was using LUKSYM instead of LUKSTR,LUKNUM,etc.
;<IND>IND.MAC.407, 3-Feb-83 16:42:57, EDIT BY KEVIN
; Substitution of strings is messed up
;<IND>IND.MAC.405, 3-Feb-83 15:53:31, EDIT BY KEVIN
; ASKCHK worked the wrong way round
;<IND>IND.MAC.404, 3-Feb-83 15:26:49, EDIT BY KEVIN
; Bad labels were not causing parsing to halt
;<IND>IND.MAC.401, 3-Feb-83 15:14:13, EDIT BY KEVIN
;<IND>IND.MAC.400, 3-Feb-83 15:01:39, EDIT BY KEVIN
; Change symbol tables so that there is one large one for all variable
; symbols, with codes for symbol type. This allows full words to be used
; for values, and makes checking for existence/type of a symbol much
; quicker and easier.
; Routines affected: ASKCHK,ENTVAL,ENT*,LUK*,ENTPLC,all tables, all
; routines calling these routines.
;<IND>IND.MAC.399, 27-Jan-83 17:51:50, EDIT BY KEVIN
; Make comments undestand this too.
;<IND>IND.MAC.397, 27-Jan-83 17:35:14, EDIT BY KEVIN
; Default to allowing leading spaces/tabs before IND directives.
; ************** V4 STARTS HERE ***************
;<IND>IND.MAC.396, 11-Jan-83 17:09:40, EDIT BY KEVIN
; Read directive appears to be failing to set <STRLEN>
;<IND>IND.MAC.395, 11-Nov-82 13:49:35, EDIT BY KEVIN
; Logic for deleting symbols (PURGE) was hopeless. I must have had a
; brainstorm that night. DO IT AGAIN !!!
;<IND>IND.MAC.394, 4-Nov-82 14:08:24, EDIT BY KEVIN
; Set up for settable quiet EXEC name
;<IND>IND.MAC.393, 4-Nov-82 13:46:08, EDIT BY KEVIN
; .RUN doesn't work with CSAVE'd files 'cos we're still tring to use
; the jfn of the EXE file after we do the GET% on it.
;<IND>IND.MAC.391, 3-Nov-82 11:35:42, EDIT BY KEVIN
; problrem with MAKHDW
;<IND>IND.MAC.389, 3-Nov-82 10:20:26, EDIT BY KEVIN
; Add .RAISE directive
;<IND>IND.MAC.388, 3-Nov-82 09:57:13, EDIT BY KEVIN
; If quiet mode is enabled, don't print messages when PAUSing
;<IND>IND.MAC.386, 1-Nov-82 11:57:21, EDIT BY KEVIN
; Set up symbols <DEFNAM>, etc. for .ASKF defaults.
; Change field type for .ASKS from .CMTXT to .CMFLD, so we can
; parse leading blanks, etc.
;<IND>IND.MAC.384, 1-Nov-82 11:33:44, EDIT BY KEVIN
; Bad return for null string in .TRIM
;<IND>IND.MAC.382, 1-Nov-82 10:45:44, EDIT BY KEVIN
; Add .TRIM and .PAD directives.
;<IND>IND.MAC.381, 1-Nov-82 10:09:01, EDIT BY KEVIN
;<IND>IND.MAC.380, 29-Oct-82 18:10:24, EDIT BY KEVIN
; Add some more system symbols
; Accept that .ASKS just won't accept blank fields
;<IND>IND.MAC.379, 29-Oct-82 17:31:23, EDIT BY KEVIN
;<IND>IND.MAC.377, 29-Oct-82 17:11:17, EDIT BY KEVIN
; .PARSE should not copy delimiters into field strings
;<IND>IND.MAC.375, 29-Oct-82 16:57:36, EDIT BY KEVIN
; Let SEARCH and LENG accept implicit byte pointers
;<IND>IND.MAC.374, 29-Oct-82 15:28:24, EDIT BY KEVIN
; .ASK was accepting null variable names
; Cure is improve ENTVAL to call ASKCHK for types, and to call
; LENG to check variable name lengths.
;<IND>IND.MAC.372, 29-Oct-82 15:08:32, EDIT BY KEVIN
;<IND>IND.MAC.371, 29-Oct-82 14:59:11, EDIT BY KEVIN
; Forgot to skip blanks after parsing control string
;<IND>IND.MAC.369, 29-Oct-82 14:27:56, EDIT BY KEVIN
; Control string for parse should be a string expression, not var
;<IND>IND.MAC.368, 29-Oct-82 14:16:29, EDIT BY KEVIN
; Add default string answer. Add .PARSE directive.
;<IND>IND.MAC.367, 29-Oct-82 11:41:00, EDIT BY KEVIN
; Setup new way of implementing writeable system symbols. Remove
; old code.
;<IND>IND.MAC.364, 28-Oct-82 16:47:12, EDIT BY KEVIN
; Add .PURGE directive to remove a symbol
;<IND>IND.MAC.361, 22-Oct-82 11:49:51, EDIT BY KEVIN
; Add new capability for system symbols to be either read-only or
; read-write. This is to allow implementation of such things as
; <STRINGDEF> etc.
;<IND>IND.MAC.360, 2-Sep-82 13:26:05, EDIT BY KEVIN
; Improve setting of subsystem name across exec commands
;<IND>IND.MAC.359, 6-Aug-82 17:19:02, EDIT BY KEVIN
; Allow directive keywords to have spaces between them and their dots,
; such as . SETS
; This permits nice nested type stuff in command files like RSX.
;<IND>IND.MAC.358, 15-Jul-82 10:10:22, EDIT BY KEVIN
; Typo in last edit
;<IND>IND.MAC.357, 15-Jul-82 10:07:13, EDIT BY KEVIN
; The method that CRCMD uses to suppress COMAND.CMD is somehwhat
; unsatisfactory. Set the file invisible instead of renaming it.
;<IND>IND.MAC.356, 13-Jul-82 11:39:19, EDIT BY KEVIN
; Wrong compare in ENTSTR meant we very occasionally bombed out with
; ?string storage full when in fact it was only exactly written to end.
;<IND>IND.MAC.354, 9-Jul-82 14:36:09, EDIT BY KEVIN
; Disabling command.cmd does not work if we are not connected to
; the login directory - a bug in crcmd. Make it always use the login
; directory. (By connect)
;<IND>IND.MAC.353, 5-Jul-82 17:15:48, EDIT BY KEVIN
;<IND>IND.MAC.352, 5-Jul-82 16:51:20, EDIT BY KEVIN
; Add some more special system symbols - string characeristics.
;<IND>IND.MAC.351, 30-Jun-82 13:23:36, EDIT BY KEVIN
; Add command file name to logfile
;<IND>IND.MAC.350, 22-Jun-82 14:24:40, EDIT BY KEVIN
;<IND>IND.MAC.349, 22-Jun-82 14:00:43, EDIT BY KEVIN
; Version 3 start - add .CODE directive (mainly for building IND itself)
; and setup for changeable quoting character.
;<IND>IND.MAC.348, 18-May-82 15:06:39, EDIT BY KEVIN
; But include a new .EXIT directive which does.
; The .EXIT directive will also return to our superior command file
; if there is one - .STOP does not.
;<IND>IND.MAC.347, 13-May-82 10:29:59, EDIT BY KEVIN
; Make .STOP directive not print @ <EOF> message.
;<IND>IND.MAC.346, 6-May-82 14:37:32, EDIT BY KEVIN
;<IND>IND.MAC.345, 6-May-82 14:30:59, EDIT BY KEVIN
; .IF directive did not recognise "=" - modify GETWRD.
; Check for PTY links being cleared
;<IND>IND.MAC.344, 6-May-82 14:00:09, EDIT BY KEVIN
; Certain fork JSYSs were not trapped by ERCALs. Also, have found
; new method of waiting for inferior, based on GETAB stuff.
;<IND>IND.MAC.343, 23-Apr-82 11:53:20, EDIT BY KEVIN
;<IND>IND.MAC.342, 23-Apr-82 11:49:40, EDIT BY KEVIN
; Problem was due to commas in the wrong place
;<IND>IND.MAC.340, 23-Apr-82 11:34:21, EDIT BY KEVIN
; Must change break mask for tokens with .CMTXT
;<IND>IND.MAC.338, 23-Apr-82 11:10:05, EDIT BY KEVIN
; IF CM%SDH is set in the first FDB, following FDBs must supply their
; own help messages.
;<IND>IND.MAC.337, 23-Apr-82 11:04:45, EDIT BY KEVIN
; Token function does not work if .CMTXT is a previous alternative
;<IND>IND.MAC.335, 21-Apr-82 09:51:33, EDIT BY KEVIN
;<IND>IND.MAC.333, 20-Apr-82 15:11:41, EDIT BY KEVIN
;<IND>IND.MAC.332, 20-Apr-82 15:00:48, EDIT BY KEVIN
; Add .DISABLE COMAND-CMD, put logfile under conditional
;<IND>IND.MAC.331, 20-Apr-82 14:47:52, EDIT BY KEVIN
; remove unused buffers (for RDTTY) and update copyright
;<IND>IND.MAC.330, 20-Apr-82 14:28:41, EDIT BY KEVIN
; Confirm handling incorrect in .ASKS
;<IND>IND.MAC.328, 20-Apr-82 14:16:38, EDIT BY KEVIN
; Text string parsing is not all it could be. Must allow
; CONFIRM as a separate option to allow for null strings.
;<IND>IND.MAC.327, 20-Apr-82 13:59:20, EDIT BY KEVIN
; COMND and numbers appears ok, now for the last one - text strings
;<IND>IND.MAC.326, 20-Apr-82 13:47:05, EDIT BY KEVIN
; Range checking failed due to trashed acs
;<IND>IND.MAC.325, 20-Apr-82 13:34:58, EDIT BY KEVIN
; Did not inlude ctrl/z break mask in .ASKN
;<IND>IND.MAC.322, 20-Apr-82 13:25:24, EDIT BY KEVIN
; Flddb. does not reserve un-needed words
;<IND>IND.MAC.321, 20-Apr-82 13:15:51, EDIT BY KEVIN
; Introduce COMND to .ASKN
;<IND>IND.MAC.320, 20-Apr-82 12:55:43, EDIT BY KEVIN
; CMDINI was clearing the GTJFN block in .ASKF
;<IND>IND.MAC.319, 20-Apr-82 12:49:59, EDIT BY KEVIN
;<IND>IND.MAC.317, 20-Apr-82 11:46:35, EDIT BY KEVIN
;<IND>IND.MAC.316, 20-Apr-82 11:30:16, EDIT BY KEVIN
;<IND>IND.MAC.315, 20-Apr-82 11:28:37, EDIT BY KEVIN
; Start including COMND-type parsing in .ASKF.
;<IND>IND.MAC.314, 20-Apr-82 09:49:22, EDIT BY KEVIN
; Set COMND to wake up on each field.
;<KEVIN>IND.MAC.313, 19-Apr-82 19:37:21, EDIT BY KEVIN
;<KEVIN>IND.MAC.312, 19-Apr-82 19:24:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.311, 19-Apr-82 19:16:02, EDIT BY KEVIN
;<KEVIN>IND.MAC.310, 19-Apr-82 19:14:48, EDIT BY KEVIN
; Must put ctrl-z into breakset
;<KEVIN>IND.MAC.309, 19-Apr-82 18:58:02, EDIT BY KEVIN
; The COMND stuff appears to be safe so far - now try to include
; "Ctrlz" as one of the options.
;<KEVIN>IND.MAC.308, 19-Apr-82 18:48:16, EDIT BY KEVIN
;<KEVIN>IND.MAC.307, 19-Apr-82 18:39:10, EDIT BY KEVIN
;<KEVIN>IND.MAC.306, 19-Apr-82 18:32:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.305, 19-Apr-82 18:28:47, EDIT BY KEVIN
; Start work on using COMND for parsing command lines
; Use .ASK first.
;<KEVIN>IND.MAC.304, 19-Apr-82 17:58:25, EDIT BY KEVIN
; Rescanned lines are terminated by lf
;<KEVIN>IND.MAC.303, 19-Apr-82 17:50:17, EDIT BY KEVIN
; Make impure size printout in decimal ; improve parameter parsing
; when parameter is terminated by cr.
;<KEVIN>IND.MAC.302, 19-Apr-82 17:45:21, EDIT BY KEVIN
; Parameter count trashed for null parameters
;<KEVIN>IND.MAC.301, 19-Apr-82 17:28:38, EDIT BY KEVIN
; More work on parameters from command lines
;<KEVIN>IND.MAC.300, 19-Apr-82 16:57:52, EDIT BY KEVIN
; Do same for warning messages
;<KEVIN>IND.MAC.299, 19-Apr-82 16:54:20, EDIT BY KEVIN
; Some errors need cr/lf terminators
;<KEVIN>IND.MAC.298, 19-Apr-82 16:48:49, EDIT BY KEVIN
; Add TSTCOL routine
;<KEVIN>IND.MAC.297, 19-Apr-82 16:45:55, EDIT BY KEVIN
; Attempt to institute more standardised error message handling
;<KEVIN>IND.MAC.296, 19-Apr-82 15:11:46, EDIT BY KEVIN
; Namelist parsing for declarations incorrect
;<KEVIN>IND.MAC.295, 19-Apr-82 15:06:30, EDIT BY KEVIN
;<KEVIN>IND.MAC.294, 19-Apr-82 14:32:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.293, 19-Apr-82 14:30:56, EDIT BY KEVIN
; Implement declaration statements (.NUMERIC, .STRING, .FILE, .LOGICAL)
;<KEVIN>IND.MAC.292, 19-Apr-82 13:51:03, EDIT BY KEVIN
;<KEVIN>IND.MAC.291, 19-Apr-82 13:40:29, EDIT BY KEVIN
; Let .IFT and .IFF operate on permanent system symbols too.
;<KEVIN>IND.MAC.290, 19-Apr-82 13:24:58, EDIT BY KEVIN
; Implement end-of-file check on read. Symbol <EOF>
;<KEVIN>IND.MAC.289, 19-Apr-82 13:02:07, EDIT BY KEVIN
; Confusion between byte and string storage sizes
;<KEVIN>IND.MAC.288, 19-Apr-82 12:00:03, EDIT BY KEVIN
;<KEVIN>IND.MAC.287, 19-Apr-82 11:58:20, EDIT BY KEVIN
; Add .READ directive
;<KEVIN>IND.MAC.286, 19-Apr-82 11:28:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.285, 19-Apr-82 10:39:01, EDIT BY KEVIN
; Add .OPENI directive
;<KEVIN>IND.MAC.284, 16-Apr-82 17:35:59, EDIT BY KEVIN
;<KEVIN>IND.MAC.283, 16-Apr-82 17:32:24, EDIT BY KEVIN
; Announce size of impure store on assembly
;<KEVIN>IND.MAC.282, 16-Apr-82 17:26:41, EDIT BY KEVIN
; Add .ENABLE LOGOUT
;<KEVIN>IND.MAC.281, 16-Apr-82 15:35:55, EDIT BY KEVIN
; Increase buffer space for .ASK
;<KEVIN>IND.MAC.280, 16-Apr-82 14:28:58, EDIT BY KEVIN
;<KEVIN>IND.MAC.279, 16-Apr-82 14:21:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.278, 16-Apr-82 14:15:32, EDIT BY KEVIN
;<KEVIN>IND.MAC.277, 16-Apr-82 14:06:18, EDIT BY KEVIN
; Add default version number to .ASKF
;<KEVIN>IND.MAC.276, 2-Apr-82 13:14:22, EDIT BY KEVIN
;<KEVIN>IND.MAC.275, 2-Apr-82 13:03:55, EDIT BY KEVIN
; Spurious extra crs (not cr/lf combos) on commands were making sub-
; commands impossible
;<KEVIN>IND.MAC.274, 3-Mar-82 13:04:04, EDIT BY KEVIN
; Routine to print error from EXEC command was not using immediate fork
; handle.
;<KEVIN>IND.MAC.273, 18-Feb-82 10:03:02, EDIT BY KEVIN
; .OPENA was always getting a JFN on a new file
;<KEVIN>IND.MAC.272, 15-Feb-82 14:03:10, EDIT BY KEVIN
;<KEVIN>IND.MAC.271, 15-Feb-82 13:54:46, EDIT BY KEVIN
;<KEVIN>IND.MAC.270, 15-Feb-82 13:44:26, EDIT BY KEVIN
; Acs trashed in TSBRK
;<KEVIN>IND.MAC.269, 15-Feb-82 11:02:39, EDIT BY KEVIN
;<KEVIN>IND.MAC.268, 15-Feb-82 10:38:21, EDIT BY KEVIN
; Add parameter-picking from command line, using P1,P2, etc.
;<KEVIN>IND.MAC.267, 11-Feb-82 10:17:11, EDIT BY KEVIN
; Clear typeahead on command errors.
;<KEVIN>IND.MAC.266, 8-Feb-82 10:22:08, EDIT BY KEVIN
;<KEVIN>IND.MAC.265, 8-Feb-82 10:17:29, EDIT BY KEVIN
; Make end-of-command file close the logfile, and release the PTY.
; Also add .CLOSELOG command to close the logfile.
;<KEVIN>IND.MAC.264, 8-Feb-82 09:57:23, EDIT BY KEVIN
;<KEVIN>IND.MAC.263, 8-Feb-82 09:54:05, EDIT BY KEVIN
; Was not constructing PTY => TTY number correctly.
;<KEVIN>IND.MAC.262, 8-Feb-82 09:35:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.261, 8-Feb-82 09:31:23, EDIT BY KEVIN
;<KEVIN>IND.MAC.260, 8-Feb-82 09:18:20, EDIT BY KEVIN
; GETPTY was skipping over TTYs assigned to SYSJOB, but was then grabbing
; PTYs from PTYCON. Must use more extensive checks to decide whether
; device is free.
;<KEVIN>IND.MAC.259, 5-Feb-82 18:13:19, EDIT BY KEVIN
;<KEVIN>IND.MAC.258, 5-Feb-82 17:56:49, EDIT BY KEVIN
;<KEVIN>IND.MAC.257, 5-Feb-82 17:41:48, EDIT BY KEVIN
; However, TLINK still needs the TTY number !!!
;<KEVIN>IND.MAC.256, 5-Feb-82 17:24:49, EDIT BY KEVIN
; PTYs must be referred to as PTYn: not TTY(105+n):
;<KEVIN>IND.MAC.255, 5-Feb-82 16:52:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.254, 5-Feb-82 16:14:41, EDIT BY KEVIN
;<KEVIN>IND.MAC.253, 5-Feb-82 15:35:18, EDIT BY KEVIN
; MTOPR seems to refuse channel 0 as PTY interrupt channel
;<KEVIN>IND.MAC.252, 5-Feb-82 15:18:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.251, 5-Feb-82 14:27:42, EDIT BY KEVIN
;<KEVIN>IND.MAC.250, 5-Feb-82 14:01:24, EDIT BY KEVIN
; Forgot to supply object designator for TLINK%
;<KEVIN>IND.MAC.249, 5-Feb-82 13:56:57, EDIT BY KEVIN
; Apparently you can't give a device designator to OPENF%.
; Thus, .LOGFILE must get a JFN on the PTY.
;<KEVIN>IND.MAC.248, 5-Feb-82 13:35:18, EDIT BY KEVIN
;<KEVIN>IND.MAC.247, 5-Feb-82 13:16:06, EDIT BY KEVIN
;<KEVIN>IND.MAC.246, 5-Feb-82 11:50:47, EDIT BY KEVIN
; Put warning messages in with user record code
;<KEVIN>IND.MAC.245, 5-Feb-82 11:47:18, EDIT BY KEVIN
; Start V2 with some code to do roughly the same thing as PHOTO -
; .LOGFILE command, .ENABLE/.DISABLE LOGGING
;<KEVIN>IND.MAC.244, 3-Feb-82 14:10:29, EDIT BY KEVIN
;<KEVIN>IND.MAC.243, 3-Feb-82 14:02:42, EDIT BY KEVIN
; Add conditional to record everyone who uses the file in a file in
; <KEVIN>.
;<KEVIN>IND.MAC.242, 29-Jan-82 16:50:32, EDIT BY KEVIN
; Add extra forms of relational operators such as <>
;<KEVIN>IND.MAC.241, 15-Jan-82 17:25:53, EDIT BY KEVIN
;<KEVIN>IND.MAC.240, 15-Jan-82 17:15:38, EDIT BY KEVIN
; Make CRCMD an internal routine so that we can use JSYS trapping on
; the subsidiary EXEC.
;<KEVIN>IND.MAC.239, 30-Nov-81 15:30:10, EDIT BY KEVIN
; Tell TESTFILE about invisible and offline files.
;<KEVIN>IND.MAC.238, 26-Nov-81 11:46:05, EDIT BY KEVIN
;<KEVIN>IND.MAC.236, 26-Nov-81 10:35:42, EDIT BY KEVIN
; Add .OPENA, teach NUMEXP about system symbols
;<KEVIN>IND.MAC.235, 26-Nov-81 10:15:13, EDIT BY KEVIN
; Teach .IF about system symbols as test variables (.IF <USER> eq "me")
;<KEVIN>IND.MAC.234, 26-Nov-81 10:02:57, EDIT BY KEVIN
; Didn't document LUKSYS correctly
;<KEVIN>IND.MAC.232, 25-Nov-81 17:07:21, EDIT BY KEVIN
; Allow system symbols in string expressions
;<KEVIN>IND.MAC.231, 22-Nov-81 14:04:46, EDIT BY KEVIN
; End-of-file code was forgetting to test file nesting depth
;<KEVIN>IND.MAC.230, 22-Nov-81 13:57:47, EDIT BY KEVIN
; .CALL was not saving new nesting level
;<KEVIN>IND.MAC.229, 22-Nov-81 13:43:29, EDIT BY KEVIN
; Forgot to add .CALL to command table
;<KEVIN>IND.MAC.227, 22-Nov-81 13:20:09, EDIT BY KEVIN
; Label testing was still being attempted in DATA mode - reverse order of
; tests
;<KEVIN>IND.MAC.226, 22-Nov-81 12:50:02, EDIT BY KEVIN
; XCREF AC symbols ; add .DISPLAY directive (probably not supported) ; add
; .DELAY directive ; add .ENABLE/.DISABLE QUIET/EXTENDED-EXEC
;<KEVIN>IND.MAC.225, 19-Nov-81 17:40:10, EDIT BY KEVIN
; Suppress RELOP symbols from DDT
;<KEVIN>IND.MAC.224, 19-Nov-81 17:27:44, EDIT BY KEVIN
; Add .CALL directive
;<KEVIN>IND.MAC.223, 19-Nov-81 17:06:00, EDIT BY KEVIN
; Make ISDGT recognise "-" as part of a number
;<KEVIN>IND.MAC.222, 19-Nov-81 16:45:57, EDIT BY KEVIN
; Forgot to supply storage for FILERR
;<KEVIN>IND.MAC.221, 19-Nov-81 16:43:21, EDIT BY KEVIN
; Add .TESTFILE directive, and special symbol <FILESTAT>
;<KEVIN>IND.MAC.220, 19-Nov-81 13:57:48, EDIT BY KEVIN
; Add .TEST directive, and special symbol <STRLEN>
;<KEVIN>IND.MAC.218, 19-Nov-81 13:33:17, EDIT BY KEVIN
; Don't use TX type macros when you haven't got an immediate value!
;<KEVIN>IND.MAC.216, 19-Nov-81 13:23:27, EDIT BY KEVIN
; RFCOC was having acs trashed by TXO
;<KEVIN>IND.MAC.214, 19-Nov-81 13:14:56, EDIT BY KEVIN
; Add .ENABLE ESCAPE for escape sequences
;<KEVIN>IND.MAC.212, 19-Nov-81 12:01:43, EDIT BY KEVIN
; Add .INC/.DEC for numeric symbols
; Make IND bomb out on command parse errors
;<KEVIN>IND.MAC.211, 18-Nov-81 19:34:23, EDIT BY KEVIN
; Unusual terminator in ENTVAL
;<KEVIN>IND.MAC.209, 18-Nov-81 19:02:15, EDIT BY KEVIN
; String expression parser failed on null strings
;<KEVIN>IND.MAC.208, 18-Nov-81 18:50:07, EDIT BY KEVIN
; String expression parser failed on symbols without ranges
;<KEVIN>IND.MAC.207, 18-Nov-81 17:50:04, EDIT BY KEVIN
; Rework way DATA mode works - set up flag for "pure" command, or
; one that has been rewritten.
;<KEVIN>IND.MAC.206, 18-Nov-81 17:39:07, EDIT BY KEVIN
; Source and destination designators wrong way round in WDATA
;<KEVIN>IND.MAC.205, 18-Nov-81 17:27:56, EDIT BY KEVIN
; Use extend sign ops for GETAB stuff
;<KEVIN>IND.MAC.203, 18-Nov-81 17:23:23, EDIT BY KEVIN
; Add ENABLE/DISABLE DATA directives
;<KEVIN>IND.MAC.201, 18-Nov-81 16:27:16, EDIT BY KEVIN
; Processor for system name forgot ERCAL after GETAB
;<KEVIN>IND.MAC.200, 18-Nov-81 16:19:02, EDIT BY KEVIN
; LUKSYS was not returning symbol type codes correctly
;<KEVIN>IND.MAC.198, 18-Nov-81 15:28:30, EDIT BY KEVIN
; Must use indexing and inirection with subroutine dispatch in LUKSYS
;<KEVIN>IND.MAC.197, 18-Nov-81 15:23:35, EDIT BY KEVIN
; Typeo in LUKSYS
;<KEVIN>IND.MAC.196, 18-Nov-81 15:14:18, EDIT BY KEVIN
; Teach substitution about system symbols
;<KEVIN>IND.MAC.195, 18-Nov-81 14:53:03, EDIT BY KEVIN
; CRCMD has now sorted out problems with PUSH, so we can now use
; the PAUSE command
;<KEVIN>IND.MAC.194, 18-Nov-81 10:25:05, EDIT BY KEVIN
; Correct typeos in system symbol table
;<KEVIN>IND.MAC.191, 18-Nov-81 10:17:42, EDIT BY KEVIN
; Add support routines for system symbols
;<KEVIN>IND.MAC.190, 18-Nov-81 09:57:37, EDIT BY KEVIN
; Add system symbol table
;<KEVIN>IND.MAC.188, 17-Nov-81 19:47:39, EDIT BY KEVIN
; Open brackets improperly handled in numeric parser
;<KEVIN>IND.MAC.187, 17-Nov-81 19:32:14, EDIT BY KEVIN
; Ranges was not remebering to save its acs
;<KEVIN>IND.MAC.185, 17-Nov-81 18:00:49, EDIT BY KEVIN
; Move definition of storage, etc. to separate file (indsym.unv).
; This allows IND to be generated by itself!
;<KEVIN>IND.MAC.183, 17-Nov-81 17:42:33, EDIT BY KEVIN
; STREXP was not handling multiple quoted strings correctly
;<KEVIN>IND.MAC.181, 17-Nov-81 17:32:45, EDIT BY KEVIN
; Testing wrong ac after STCMP
;<KEVIN>IND.MAC.179, 17-Nov-81 16:55:32, EDIT BY KEVIN
; problems with macro used to generate RELOP table
;<KEVIN>IND.MAC.176, 17-Nov-81 16:22:48, EDIT BY KEVIN
; Make garbage collector keep statistics on usage
;<KEVIN>IND.MAC.173, 17-Nov-81 15:26:45, EDIT BY KEVIN
; Macro doesn't like ~ signs
;<KEVIN>IND.MAC.172, 17-Nov-81 15:06:09, EDIT BY KEVIN
; Add .IF directive, for testing relational operations between strings or
; numbers.
;<KEVIN>IND.MAC.171, 16-Nov-81 17:45:07, EDIT BY KEVIN
; Stop .ASKS raising terminal input, add .STOP directive
;<KEVIN>IND.MAC.170, 16-Nov-81 17:35:10, EDIT BY KEVIN
; .RETURN was not decrementing nesting level
;<KEVIN>IND.MAC.168, 16-Nov-81 17:11:05, EDIT BY KEVIN
; Forward labels not being processed correctly
;<KEVIN>IND.MAC.166, 16-Nov-81 16:40:14, EDIT BY KEVIN
; Bug in label processing
;<KEVIN>IND.MAC.164, 16-Nov-81 16:18:33, EDIT BY KEVIN
; Implement .ASKS
;<KEVIN>IND.MAC.163, 16-Nov-81 15:21:17, EDIT BY KEVIN
; Add IND comments (.; command). Add .GOSUB, .RETURN
;<KEVIN>IND.MAC.162, 16-Nov-81 14:37:49, EDIT BY KEVIN
; Keyword table out of order
;<KEVIN>IND.MAC.159, 16-Nov-81 14:14:43, EDIT BY KEVIN
; Implement .ASKF, improve .ASK
;<KEVIN>IND.MAC.158, 16-Nov-81 13:27:38, EDIT BY KEVIN
; Wrong acs in .DATA command
;<KEVIN>IND.MAC.157, 16-Nov-81 13:18:48, EDIT BY KEVIN
; STATUS was not displaying negative numbers correctly
;<KEVIN>IND.MAC.156, 16-Nov-81 11:48:23, EDIT BY KEVIN
; Add .SETFI (set file symbol)
;<KEVIN>IND.MAC.154, 16-Nov-81 11:36:24, EDIT BY KEVIN
; Add ENTFIL LUKFIL
; Make substitution recognise file symbols. Fix bug in luknum - was
; not returning negative values with full sign (use HRRE not HRRZ)
;<KEVIN>IND.MAC.153, 16-Nov-81 10:14:49, EDIT BY KEVIN
; Add garbage collector for string storage, add .OPEN, .CLOSE, .DATA
; improve entering routines for symbol tables to check for existence of
; symbol (like ENTSTR does.)
;<KEVIN>IND.MAC.152, 13-Nov-81 18:25:39, EDIT BY KEVIN
; LUKNUM was not returning table positions
;<KEVIN>IND.MAC.151, 13-Nov-81 18:18:47, EDIT BY KEVIN
; Logic of below edit was inversed from desired action
;<KEVIN>IND.MAC.147, 13-Nov-81 18:05:06, EDIT BY KEVIN
; Modify ENTLAB to ignore request if label is already in table
;<KEVIN>IND.MAC.146, 13-Nov-81 17:56:15, EDIT BY KEVIN
;<KEVIN>IND.MAC.143, 13-Nov-81 16:45:41, EDIT BY KEVIN
;<KEVIN>IND.MAC.142, 13-Nov-81 14:27:30, EDIT BY KEVIN
;<KEVIN>IND.MAC.140, 12-Nov-81 11:07:11, EDIT BY KEVIN
;<KEVIN>IND.MAC.137, 11-Nov-81 16:24:45, EDIT BY KEVIN
; Start on .GOTO logica - command is not added yet, but we must put
; checks into the parser for adding labels to the table, and checks to
; ensure no commands are executed while a target is being searched for.
;<KEVIN>IND.MAC.132, 11-Nov-81 13:21:47, EDIT BY KEVIN
; Add file symbol table, planned for inclusion from start. Stores JFNS
; for later use. Improve ENTSTR so that it copes whether or not the symbol
; is defined. This will be the only ENTER-type routine which does this,
; and is useful 'cos strings are so difficult.
;<KEVIN>IND.MAC.129, 11-Nov-81 11:31:11, EDIT BY KEVIN
;<KEVIN>IND.MAC.128, 10-Nov-81 19:51:24, EDIT BY KEVIN
; Beef up STATUS command to print out all symbols and values
;<KEVIN>IND.MAC.117, 10-Nov-81 19:05:49, EDIT BY KEVIN
; Make ASKx directives use ranges.
;<KEVIN>IND.MAC.113, 10-Nov-81 18:35:49, EDIT BY KEVIN
; Fix problem with range parsing
;<KEVIN>IND.MAC.108, 10-Nov-81 17:35:38, EDIT BY KEVIN
; String parser
;<KEVIN>IND.MAC.107, 10-Nov-81 16:48:40, EDIT BY KEVIN
; Remove .PAUSE command due to bug in $CRCMD
;<KEVIN>IND.MAC.105, 10-Nov-81 11:27:15, EDIT BY KEVIN
;<KEVIN>IND.MAC.102, 10-Nov-81 10:34:27, EDIT BY KEVIN
; Add .PAUSE command, to PUSH to lower EXEC
;<KEVIN>IND.MAC.99, 10-Nov-81 10:00:54, EDIT BY KEVIN
;<KEVIN>IND.MAC.95, 10-Nov-81 09:22:58, EDIT BY KEVIN
;<KEVIN>IND.MAC.92, 9-Nov-81 16:51:07, EDIT BY KEVIN
;<KEVIN>IND.MAC.91, 9-Nov-81 15:00:15, EDIT BY KEVIN
; Bung in the work I did this weekend - notably the string and numeric
; expression parsers, in all their glory (or lack of it.) Also resolve
; problem whereby use of GETWRD was inconsistent, meaning that it could
; not backspace its byte pointer. Make GETWRD allow $, < and > as valid
; characters in a symbol.
; Add range parsing routine, for use in string expressions and .ASKx
; directives. Uses NUMEXP to parse general numeric expressions for the
; ranges.
;<KEVIN>IND.MAC.85, 7-Nov-81 18:19:15, EDIT BY KEVIN
; Add .IFDF/.IFNDF - if symbol defined or not defined
;<KEVIN>IND.MAC.82, 7-Nov-81 17:37:27, EDIT BY KEVIN
; Add .ASKN - ask for numeric symbol
;<KEVIN>IND.MAC.79, 7-Nov-81 17:16:34, EDIT BY KEVIN
; Add first few .ENABLE/.DISABLE commands
;<KEVIN>IND.MAC.78, 7-Nov-81 16:56:18, EDIT BY KEVIN
; Make substitution use numeric symbols as well
;<KEVIN>IND.MAC.74, 7-Nov-81 16:13:15, EDIT BY KEVIN
; Add .SETN
;<KEVIN>IND.MAC.72, 7-Nov-81 16:01:36, EDIT BY KEVIN
; ENTSTR was not counting string lengths properly
; Problem was implicit byte pointers where real ones were required
;<KEVIN>IND.MAC.71, 7-Nov-81 15:54:07, EDIT BY KEVIN
; Substitution was losing cr/lf from end of line
;<KEVIN>IND.MAC.70, 7-Nov-81 15:44:58, EDIT BY KEVIN
; LUKSTR was not returning correct byte pointers
;<KEVIN>IND.MAC.68, 7-Nov-81 15:23:01, EDIT BY KEVIN
;<KEVIN>IND.MAC.64, 7-Nov-81 14:58:55, EDIT BY KEVIN
; Add seperate reenter - REENTER performs no rescan
;<KEVIN>IND.MAC.61, 6-Nov-81 17:32:37, EDIT BY KEVIN
; Add substitution routines
;<KEVIN>IND.MAC.58, 6-Nov-81 16:32:10, EDIT BY KEVIN
; Add .STATUS command to print symbol table usage, etc.
;<KEVIN>IND.MAC.56, 6-Nov-81 16:08:44, EDIT BY KEVIN
;<KEVIN>IND.MAC.55, 6-Nov-81 15:43:44, EDIT BY KEVIN
; Add the .SETS command, in preparation for text substitution
;<KEVIN>IND.MAC.53, 6-Nov-81 15:14:44, EDIT BY KEVIN
; Modify GETWRD to return on no-alphabetic, and reset byte pointer.
; Also write ENTSTR - to enter a string symbol.
;<KEVIN>IND.MAC.51, 6-Nov-81 14:59:09, EDIT BY KEVIN
; .ASKx routines don't really want all the line terminator guff.
;<KEVIN>IND.MAC.47, 6-Nov-81 14:27:36, EDIT BY KEVIN
; Add LUKSTR to lookup string symbols so that the .ASKx routines can
; verify their symbol types.
;<KEVIN>IND.MAC.44, 6-Nov-81 14:15:02, EDIT BY KEVIN
;<KEVIN>IND.MAC.42, 5-Nov-81 17:52:14, EDIT BY KEVIN
; Add .ASK
;<KEVIN>IND.MAC.37, 5-Nov-81 17:21:31, EDIT BY KEVIN
; Add beginnings of .IFT, .IFF to test the logical ops
;<KEVIN>IND.MAC.33, 5-Nov-81 16:58:04, EDIT BY KEVIN
; Add .SETT/.SETF
;<KEVIN>IND.MAC.32, 5-Nov-81 16:11:33, EDIT BY KEVIN
; But clear out the buffers when we do it
;<KEVIN>IND.MAC.26, 5-Nov-81 14:55:56, EDIT BY KEVIN
; Add command line rescanning so we can @IND filename
;<KEVIN>IND.MAC.24, 5-Nov-81 14:22:32, EDIT BY KEVIN
;<KEVIN>IND.MAC.21, 5-Nov-81 14:07:37, EDIT BY KEVIN
;<KEVIN>IND.MAC.19, 4-Nov-81 18:03:05, EDIT BY KEVIN
; Start adding symbol table lookup/insertion/maintenance routines
;<KEVIN>IND.MAC.16, 4-Nov-81 15:03:18, EDIT BY KEVIN
; Also, REV and similar programs check the private program name and match
; it against the recsan buffer - must set program name.
;<KEVIN>IND.MAC.14, 4-Nov-81 10:25:22, EDIT BY KEVIN
; Alter way in which .RUN command works to load the rescan buffer properly
; Apparently, if you say RUN SYS:REV.EXE *.rel, the rescan buffer must
; only contain REV *.rel .
;<KEVIN>IND.MAC.10, 3-Nov-81 16:40:08, EDIT BY KEVIN
; Add .RUN command
;<KEVIN>IND.MAC.4, 3-Nov-81 13:56:20, EDIT BY KEVIN
;<KEVIN>IND.MAC.3, 3-Nov-81 13:52:09, EDIT BY KEVIN
;<KEVIN>IND.MAC.2, 3-Nov-81 13:48:47, EDIT BY KEVIN
;<KEVIN>IND.MAC.1, 3-Nov-81 12:02:26, EDIT BY KEVIN
title IND - performs similar function to RSX IND
subttl Edit history
comment @
Kevin Ashley April 1982
=======================
The copyright in the computer program described in this document and
in the associated user instructions is the property of Kevin Ashley.
The information in this document is subject to change without notice
and should not be construed as a commitment. Mr. Ashley assumes no
responsibility for any errors which may appear in this document.
The software described in this document is supplied under a licence
and may only used or copied in accordance with the conditions of such a
licence. The licence conditions state that this software shall be supplied
free of charge and shall not be sold or otherwise disposed of by means of
trade or ortherwisw for any form of profit or advantage. Possesion or use
of the software shall be deemed as acceptance of the conditions of the
licence.
No guarantee is given or may be implied as to the adequacy of the
program or its suitability for any particular purpose and no liability is
accepted for any loss or damage arising out of its use.
@
subttl Definitions and impure storage
;
; This program reads command files of a similar format to those
; used under RSX, which allow question/answer stuff to go on, and also
; symbol substitution and all that good stuff. Running programs via the
; EXEC may present problems, so we may need to use a .RUN directive
; rather than the EXEC RUN. We'll see....
; This program provides almost all the capabilities of RSX/RT-11 IND
; in as compatible a manner as possible, and also includes a few
; extensions. See HLP:IND.DOC for details. Build this program using
; INDGEN.CMD to customize it for a particular site.
;
search vtmac,indsym
regdef
.request k:inderr,k:getddt ;request subroutine libraries
external errmes,error,getddt ;for these routines
internal tstcol ;used by error routines
.XCREF T1,T2,T3,T4 ;don't cross-reference ac symbols
cexit.==:12345
IF2,<PRINTX * Commencing pass 2>
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 ; : :
$numer==1b0 ;flag bits for TXTMSK
$alpha==1b1 ; "" ""
$Nalpha==1b2 ;"" ""
ptychn==2 ;channel for PTY interrupts
frkchn==0 ;inferior fork interrupts
abochn==3 ;channel for aborting IND
ptysiz==^d100 ;size of PTY output buffer
mswrd==<mslen/5>+1 ;maximum string length in words
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
IFG <MSWRD> <BUFSIZ>, <BUFSIZ==MSWRD>
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
;
; Bit definitions for relational operators - if a bit is set, then that
; condition means success for that operator. IE if the operator is le,
; then equals or less than both mean success.
;
$eq==1 ;equals condition
$lt==2 ;less than
$gt==4 ;greater than
eq==$eq ;only equals for equals
ne==$lt+$gt ;ne means less than or greater than
ge==$gt+$eq
gt==$gt
lt==$lt
le==$lt+$eq
; NOTE there must be no type code 0 - this is used to indicate an
; empty slot in the symbol table
; See SUBSTI if you want to add extra types
$num==1 ;symbol type codes
$str==2 ;string symbol
$fil==3 ;file symbol
$lgc==4 ;logical
$lab==5 ;label
$flt==6 ;floating point
$sys==6 ;system
$wrt==1b18 ;read/write flag for system symbol
$$impst: ;start of impure section
calstk: block mxcal ;IND .CALL stack
substk: block mxcnst ;subroutine stack
numstK: block numsl ;numeric parse stack
stack: block slen
scrlen==^d30 ;30 words for scratch strings
scratch: block scrlen
;
; Storage for CRCMD
;
efork: 0 ;fork handle if f$REEZ is set
waspsh: 0 ;says we were pushed last time, so
;we must use SFORK
cmdwrd: 0 ;saved JFN mode word from COMND
cmdcc1: 0 ;saved CCOC words from COMND
cmdcc2: 0 ;"" ""
cmdwid: 0 ;saved terminal width
sysnm: 0 ;our SIXBIT name
infnam: sixbit /EXEC/ ;name of inferior fork
;
; End of CRCMD storage
;
pc1: 0
pc2: 0
pc3: 0 ;storage for PC on interrupts
relop: 0 ;operator in .IF statement
ifval: 0 ;value of symbol in .IF directive
iftyp: 0 ;type of symbol : :
comjfn: 0 ;jfn of command file
logjfn: 0 ;JFN of logging file or 0 if no log yet
ptydes: 0 ;device designator of logging PTY
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
ind11: 0 ;-1 if leading blanks not permitted before directives
datflg: 0 ;-1 if ENABLE DATA in process
datsav: 0 ;copy of above, behind by one line
sqzd: 0 ;non zero if garbage collector has been called
nsqzd: 0 ;number of tiems garbage collector has been called
exsrch: 0 ;number of exhaustive searches made for a free name slot
ifdtyp: 0 ;flags .IFDF/.IFNDF
fnd: 0 ;flags if symbol found for above
edtyp: 0 ;-1 when .DISABLing, 0 if .ENABLing
nval: 0 ;second operand of numexp
numptr: 0 ;stored pointer parsing expressions
numnst: 0 ;nesting level of numeric expression
cnval: 0 ;holds current value of expression when parsing
cnop: 0 ; " " operator " "
fltint: 0 ;indicates floating or integer expression is parsing
radix: ^d10 ;current radix
cbyt: 0 ;starting byte number of current line
going: 0 ;non-zero if searching for a label
strlen: 0 ;length of string from .ASKS or .TEST directive
filerr: 0 ;status of last .TESTFILE directive
lukoff: 0 ;symbol table offset of last symbo looked up
nargs: 0 ;number of parameters parsed
pname: 0 ;name of current parameter
txtmsk: 0 ;bit mask for string characteristics from .TEST
subdlm: $subdl ;character to use as delimiter in substitution
;( usually "'")
abortf: 0 ;-1 if aborts disabled
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
telcmd: block maxcom ;space for TELL directive
;
; Macro to adjust a byte pointer by a variable. Uses CX as scratch
;
define adjptr(ptr,bytes),<
move cx,bytes ;;number of bytes to bump by
adjbp cx,ptr
movem cx,ptr>
;
; macro to backspace byte pointer 1 byte
;
define bkptr (ptr),<
setom cx ;backspace 1
adjbp cx,ptr
movem cx,ptr>
;
; macros to save and restore temp registers with open pushes
;
define savts,<push p,t1
push p,t2
push p,t3
push p,t4>
define rests,<pop p,t4
pop p,t3
pop p,t2
pop p,t1>
;
; Macros to print error and warning messages. Use is:
; FATAL <MESSAGE>,noret,mcall,nocmd
;
; Only the first argument need be supplied. It is assumed that you wish
; the error to be printed, and that the command line should then follow
; that caused the error, followed by a non-skip return. To override any
; of these, use noret to inhibit the return, mcall to cause a JSYS error
; to be printed, nocmd to inhibit printing of the offending command line.
; stop can be used in place of noret, and causes a jump to haltt to
; take place.
; WARN is similar, except that a retskp will be used instead of ret.
;
define FATAL (message,return<>,js<>,pcmd<>),<
call tstcol ;;check for new line
tmsg <?IND - 'message> ;;print error
IFDIF <PCMD> <nocmd>,<call prtcmd> ;;print user's directive
IFIDN <js> <mcall>,<call errmes>
IFB <return>,<ret> ;;assume return
IFIDN <return> <stop>,<jrst haltt> ;;or jump to halt
> ;end of macro
define WARN (message,return<>,js<>,pcmd<>),<
call tstcol ;;check for new line
tmsg <%IND - 'message> ;;print error
IFDIF <PCMD> <nocmd>,<call prtcmd> ;;print user's directive
IFIDN <js> <mcall>,<call errmes>
IFB <return>,<retskp> ;;assume return
> ;end of macro
;
; Macro to confirm a command
;
define confirm,<call endcom>
;
; macro to define an FDB for Control-z
;
define exfdb,<[fldbk. (.cmtok,cm%sdh,<point 7,[byte (7) ^d26]>,<Control-Z to exit>)]>
define bmask,<[brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,<>,)]>
;
; macro to be called after COMND but before CONFIRM to check if ctrl-z
; was typed.
;
define testz,<
ldb t4,[331100,,(t3)] ;get function code from FDB
cain t4,.cmtok ;was it a token ?
call exit> ;yes, stop now if possible
;
; Macro to make an implicit byte pointer into hardware format
;
define makhdw(loc),<
IFN loc-t1,<exch t1,loc> ;;swap location with t1
push p,t1 ;;save original pointer
hlrz t1,t1 ;;get p,s,i,x fields
cain t1,-1 ;;implicit ?
movei t1,(point 7,) ;;yes, make real
hrl t1,(p) ;;get back address portion of pointer
movss t1,t1 ;;and swap halves back to rightful place
adjsp p,-1 ;;throw away unneeded original pointer
IFN loc-t1,<exch t1,loc> ;;restore ac
>
;
; These are IND's symbol tables. The main table is used to hold
; the names of all variables, together with a pointer to a subsidiary
; table which holds their type codes and values. The symbol table is
; a simple TBLUK table. The associated value of each variable is an
; offset into table SYMVAL, which contains one two word entry for each
; symbol, the fist word holding a type code for that symbol, and the
; second a "value", which in the case of logical, numeric and file
; variables really is a value, but in the case of strings is a pointer
; into the string pool (which is a sort of value).
;
; There also follows the command table and special system symbol table.
;
;
; space for storage of strings
;
nxtbyt: 0 ;next byte to be written into strings
strings: block strspc/5
strcpy: block strspc/5 ;copy of above for garbage collection
;
;space for text storage of symbol names
;
symtot=strsiz+numsiz+lgcsiz+labsiz+filsiz+fltsiz ;total number of symbols
free: symtot ;number of free entries left
nxtsym: 0 ;offset to place next symbol name at
;
; Names of variables are stored here.
;
symtab:block <symtot>*<maxchr+1>/5
;
; This is the table of values and type codes for all symbols
;
SYMVAL: block symtot*2 ;two words per symbol
nxtval: 0 ;offset to place next value
;
; This supporting table for SYMVAL contains the maximum and currently used
; number of symbols of each type, offset by symbol type code
; NOTE that these tables must be updated if:
; (1) The symbol type codes are changed
; (2) The number of allowable symbol types is altered.
; There is one unused entry at the start of each list corresponding
; to symbol code 0
;
symuse: block 7
symmax: 0
numsiz
strsiz
filsiz
lgcsiz
labsiz
fltsiz
;
; This is the TBLUK table for variable names
;
SYMBOLS: 0,,symtot ;current,,maximum number of entries
block symtot ;number of entries allowed
;
; COMND - related storage
;
SAVRET: BLOCK 1 ;RETURN ADDRESS OF CMDINI CALLER
SAVREP: BLOCK 1 ;SAVED STACK POINTER TO RESTORE ON REPARSE
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
;
; Field descriptor block for .ASKN
;
numfdb: fld(.cmnum,cm%fnc)!cm%dpp!exfdb ;decimal number,default
0 ;filled with radix
0
0
bmask
;
; Field descriptor block for .ASKR
;
fltfdb: fld(.cmflt,cm%fnc)!cm%dpp!exfdb ;floating point number,default
0
0
0
bmask
;
; Field descriptor block for .ASKS (has to have default pointer
; modified).
;
strfdb:
sfdb1: fld(.cmfld,cm%fnc)!cm%dpp!cm%hpp!cm%brk!cm%sdh!scfm ;text field
0
-1,,[asciz "Text string"]
0
[brmsk. (eolb0.,eolb1.,eolb2.,eolb3.,<>)]
scfm: fldbk. (.cmcfm,cm%sdh)
$$pure: ;start of pure section
subttl Pure storage - command tables, etc.
;
; Display size of impure section
;
radix 5+5
define shows(size,pag),<printx * Impure data storage = size words (pag pages)>
if1, <$$tmp==1
ife <<$$pure-$$impst>&^o777>,<$$tmp==0>
shows \<$$pure-$$impst>,\<<<$$Pure-$$impst>/^d512>+$$tmp>>
radix 8
;
; These are the pure tables of commands and permanent symbols
;
define key$(comand,imp<noimp>,routine<>),<
$comsz==$comsz+1
IFIDN <IMP> <imp>,<
IFNB <routine>,<[asciz/comand/],,routine>
IFB <routine>,<[asciz/comand/],,.'comand>>
ifidn <imp> <noimp>,< [asciz/comand/],,[tmsg <
%Can't .'comand yet...>
retskp]>>
define syk$(keyword,ktype,routine,%type1),<
%type1=-1
ifidn <ktype> <string>,<%type1=$str>
ifidn <ktype> <numeric>,<%type1=$num>
ifidn <ktype> <logical>,<%type1=$lgc>
ifidn <ktype> <file>,<%type1=$fil>
ifl %type1 <printx ?Unrecognised system symbol type:'%type1>
sysiz$=sysiz$+1
[asciz/<'keyword'>/],,[%type1,,routine]
.xcref %type1
purge %type1>
$comsz==0
comsym: comsiz,,comsiz ;number of entries in table
key$ ask,imp ;yes/no routine
key$ askf,imp ;file question
key$ askn,imp ;numeric question
key$ askr,imp ;floating point question
key$ asks,imp ;string question
key$ call,imp ;call another file
key$ close,imp ;close data file
key$ closei,imp,.closi ;close input file
key$ code,imp ;get ASCII code of first char of string
key$ data,imp ;send line to data file
key$ dayton,imp ;convert date string to number
key$ ddt,imp ;merge DDT and breakpoint
key$ dec,imp ;decrement symbol
key$ delay,imp ;delay for n seconds
key$ delim,imp ;set delimiter for substitution
$$disab:key$ disable,imp ;disable function
key$ display,imp ;display string symbol as is (screens)
key$ enable,imp ;enable function
key$ endlog,imp ;close logfile release PTY
key$ exit,imp ;exit (like .STOP but types @ <EOF>)
key$ file,imp ;declare file symbol
key$ gosub,imp ;.GOTO with .RETURN
key$ goto,imp ;goto function
key$ if,imp ;if sym relop 'expr' command
key$ ifdf,imp ;if defined....
key$ iff,imp ;if false....
key$ ifndf,imp ;if not defined....
key$ ift,imp ;if true....
key$ inc,imp ;increment symbol
key$ logfile,imp ;specify logfile
key$ logical,imp ;declare logical symbol
key$ lower,imp ;make lower case
key$ ntoday,imp ;convert day number to string
key$ numeric,imp ;numeric declaration
key$ open,imp ;open data file
key$ opena,imp ;open data file for append
key$ openi,imp ;open file for input
key$ pad,imp ;pad string with blanks
key$ parse,imp ;parse string into substrings
key$ pause,imp ;pause (push to subsid EXEC via $CRCMD)
key$ position,imp,.posit ;Position input file
key$ purge,imp ;undefine symbols
key$ radix,imp ;set current radix
key$ raise,imp ;make upper case
key$ read,imp ;read from input file
key$ real,imp ;declare real symbol
key$ return,imp ;inverse of .GOSUB
key$ rewind,imp ;rewind input file
key$ run,imp ;run program (instead of EXEC command)
key$ setf,imp ;set false
key$ setfi,imp ;set file
key$ setn,imp ;set numeric
key$ setr,imp ;set real
key$ sets,imp ;set string
key$ sett,imp ;set true
key$ status,imp ;type status of symbol tables, etc.
key$ stop,imp ;STOP processing
key$ string,imp ;declare string symbol
Key$ Tell,imp ;Command for lower fork
key$ test,imp ;test string length
key$ testfile,imp ;test for file exists
key$ trim,imp ;trim trailing blanks/tabs from string
comsiz==$comsz
purge $comsz
;
; table for yes/no
;
ysntab: 2,,2
[ASCIZ/NO/],,false
[asciz/YES/],,true
;
; Keywords for .ENABLE/.DISABLE, and the routines to do it
;
define enk$(word,code),<
[asciz/word/],,code
ensiz$==ensiz$+1>
ensiz$==0
edtab: ensiz,,ensiz ;number of entries in table
enk$ ABORT,edabo ;turn aborting on/off
enk$ COMAND-CMD,[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]
enk$ LEADING,[setzm ind11 ;assume enable
skipe edtyp ;enable ?
setom ind11 ;no, disable leading
ret] ;back to next command
..log: enk$ LOGGING,[skipn logjfn ;got a logfile ?
jrst [warn <no logfile selected:>]
move 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$ ACCOUNT,string,[seto t1, ;this job
hrroi t2,sysval ;where to write string
gacct% ;do it
ercal error
ret]
syk$ ALPHA,logical,[move t1,txtmsk ;get mask bits
movx t2,true ;assume alphabetic
txnn t1,$alpha ;test bit
movx t2,false ;not set, so false
movem t2,sysval ;leave value behind
ret]
syk$ ALPHANUM,logical,[move t1,txtmsk ;get mask bits
movx t2,true ;assume alphanumeric
txnn t1,$nalpha ;test bit
movx t2,false ;not set, so false
movem t2,sysval ;leave value behind
ret]
syk$ BYTEPOS,numeric,[move t1,inpjfn ;get jfn of input file
jumpe t1,[setom sysval ;if not open
ret] ;return -1
rfptr% ;if open, read position
ercal error
movem t2,sysval ;store answer
ret] ;and return
syk$ DATE,string,[movx t3,ot%ntm
jrst date.]
syk$ DIRECTORY,string,[gjinf% ;get dir number
hrroi t1,sysval
dirst%
ercal error
ret]
syk$ DISKUSED,numeric,[seto t1, ;this directory
gtdal% ;read allocations
ercal error
movem t2,sysval ;store used pages
ret]
SYK$ EOF,logical,ineof. ;end of file status on input
syk$ FILESTAT,numeric,[move t1,filerr ;result of .TESTFILE
movem t1,sysval
ret]
syk$ JOB,numeric,[gjinf% ;grab info
movem t3,sysval ;store job number
ret]
syk$ LIQUOTA,numeric,[seto t1, ;this directory
gtdal% ;read allocations
ercal error
movem t1,sysval ;store logged in quota
ret]
syk$ LOQUOTA,numeric,[seto t1, ;this directory
gtdal% ;read allocations
ercal error
movem t3,sysval ;store logged out quota
ret]
syk$ NUMERIC,logical,[move t1,txtmsk ;get mask bits
movx t2,true ;assume numeric
txnn t1,$numer ;test bit
movx t2,false ;not set, so false
movem t2,sysval ;leave value behind
ret]
syk$ STRLEN,numeric,[move t1,strlen
movem t1,sysval
ret]
syk$ SYSTEM,string,sysnm. ;name of system
syk$ TERLEN,numeric,[movei t1,.priin ;our terminal
movx t2,.morll ;read length
mtopr% ;do it
ercal error
movem t3,sysval ;store length
ret] ;back to caller
syk$ TERMINAL,numeric,[gjinf%
skipg t4 ;attached ?
setz t4, ;no
movem t4,sysval ;store terminal number
ret]
syk$ TERWID,numeric,[movei t1,.priin ;our terminal
movx t2,.morlw ;read width
mtopr% ;do it
ercal error
movem t3,sysval ;store width
ret] ;back to caller
syk$ TIME,string,[movx t3,ot%nda
jrst date.]
syk$ USER,string,[gjinf% ;get user number
movem t1,t2 ;save
hrroi t1,sysval ;where to write it
dirst% ;write name
ercal error
ret]
sysiz==sysiz$
purge sysiz$
;
; dispatch table for numeric parser
;
optab: illvec ;illegal operator vector
nadd ;add
nsub
nmul
ndiv
;
; List of matching opening and closing brackets
;
brklst: "}",,"{"
"]",,"["
">",,"<"
")",,"("
"""",,""""
;
; Name of quiet exec without a prompt
;
qtexc: qtnam ;define in INDSYM
;
; GTJFN argument block for TESTFILE
;
tsargs: gj%old+gj%xtn ;old files,extended arguments
.nulio,,.nulio ;inout, output jfns
0 ;default device
0 ;default directory
0 ;defualt name
0 ;default type
0 ;protections
0 ;account
0 ;JFN
g1%iin ;allow invisible files
;
; Table of symbols to be filled in by testfile with name,type
; etc. format is:
; address of format control bits for jfns,,address of field symbol name
;
DEFINE TSFENT(Bit,Field),<[FLD(.JSAOF,Bit)],,[ASCIZ/<'Field'>/]>
tsnams: TSFENT js%dev,FILDEV
TSFENT js%dir,FILDIR
TSFENT js%nam,FILNAM
TSFENT js%typ,FILTYP
TSFENT js%gen,FILGEN
TSFENT js%pro,FILPRO
TSFENT js%act,FILACT
TSFENT js%cdr,FILCRE
TSFENT js%lrd,FILRED
0
;
; Interrupt tables
;
levtab: pc1
pc2
pc3 ;address of PC words
chntab: 2,,frkint ;fork interrupts
0 ;PTY input (unused)
3,,ptyint ;PTY output channel
1,,aboint ;abort IND interrupt
repeat ^d32,<0> ;unused channels
entvec: jrst start
jrst reen
verno 4,B,449,3 ;Version number and author code - Kevin
subttl Main code
;
; Program starts here
;
reen: reset% ;on reenter, don't rescan
move p,[iowd slen,stack] ;set the stack
jrst start1 ;read filename from terminal
call tstbat ;check for BATCH attempt
;
; Normal entry: look at command line with rescan, for
; IND FILNAM param1 param2 param3....
; If FILNAM not found, look on SYS: for it
start: reset% ;clear the world
move p,[iowd slen,stack] ;set the stack
call gcom ;try and get command file name
start1: jrst [tmsg <
Command file name : >
movx t1,gj%cfm+gj%sht+gj%old+gj%fns ;olf file, name from terminal
move t2,[.priin,,.priou]
gtjfn%
ercal [call errmes
jrst start1]
jrst .+1] ;ok, got it from terminal
movem t1,comjfn ;remember command file JFN
IFN <logg>, <call record> ;log user
move t1,comjfn ;get command file jfn
movx t2,fld(7,of%bsz)+of%rd ;open for read with 7-bit bytes
openf% ;do so
ercal error ;crash
call inton ;set up interrupt system
call cmdset ;initialize COMND block
fillop: skipe datsav ;last line in DATA mode ?
call wdata ;yes, write to file if necessary
move t2,datflg ;get new copy of flag
movem t2,datsav ;and save it
call getlin ;read line, return +1 on eof
jrst eof ;no more to do
call substi ;perform substitution
jrst fillop ;failed for some reason
intfil: setom purcmd ;prevent copying from happening again
skipn ind11 ;are we allowing 11-format commands ?
call skpblk ;yes, so skip leading blanks
ildb t2,t1 ;get first byte using pointer in t1
cain t2,"." ;is it a dot ?
jrst [call parse ;yes, it is an IND command - parse it
jrst fillop] ;get next line
skipe going ;are we searchig for a target ?
jrst fillop ;yes, and we haven't found it yet
skipe datflg ;are we in DATA mode?
jrst fillop ;yes, just loop for more
cain t2,";" ;is it a comment ?
jrst [call coment ;yes, just output and continue
jrst fillop]
move t1,[point 7,comlin] ;nope, just an ordinary command - do it
move t2,linlen ;get linelength
subi t2,2 ;point before cr/lf
adjptr t1,t2 ;fiddle the byte pointer
setz t2, ;get a null
idpb t2,t1 ;and put ot over the cr/lf
move t1,[point 7,comlin] ;point to command
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
call skpblk ;skip over blanks between "." and keywrd
move t2,[point 7,scratch] ;point to scratch string store
call getwrd ;get ASCIZ word next on line
movem t1,comptr ;save command pointer for routines
skipe dspflg ;display commands ?
jrst [skipn going ;jumping ?
call prtcmd ;no
jrst .+1]
movei t1,comsym ;point to IND commands
hrroi t2,scratch ;point to this command
tbluk% ;perform table lookup
txnn t2,tl%exm ;exact match ?
jrst [skipn datflg ;no, in data mode ?
jrst tstlab ;no, test for a label
move t1,[0] ;yes, setup dummy command
jrst .+1] ;continue
skipe going ;execute commands ?
ret ;no, searching for label
hrrz t3,(t1) ;yes, get routine address
skipe datflg ;in DATA mode ?
jrst [caie t1,$$disab ;yes, is command DISABLE ?
ret ;no, ignore
jrst .+1] ;yes, let it work out what to do
move t1,comptr ;get command pointer for routine
call skpblk ;skip to Command start
movem t1,comptr ;resave pointer
call (t3) ;dispatch
jrst comfl ;failure to parse rest of command
ret ;ok, get next line
tstlab: ildb t2,comptr ;get next byte of command
caie t2,":" ;colon ?
jrst badcom ;no, invalid command
hrroi t1,scratch ;point to label name
move t2,cbyt ;and byte that starts line
call entlab ;enter label in table
jrst comfl ;failed
move t1,comptr ;get position again
call skpblk ;skip over blanks
movem t1,t2
hrroi t1,comlin ;now prepare to rewrite command line
movei t3,maxcom*5 ;without a label on it
setz t4,
sout%
ercal error
movei t2,maxcom*5 ;what we wanted to write
sub t2,t3 ;minus what we didn't
soj t2, ;minus one for cr/lf problems
movem t2,linlen ;is what we did
skipe going ;are we trying for a target label ?
jrst tstfnd ;yes, see if we just found it
pop p,t1 ;throw away return address
move t1,[point 7,comlin]
jrst intfil ;go for a new parse
;
; here to check if we just found our target label
;
tstfnd: hrroi t1,target ;point to desired target
call luklab ;lookup target in label table
ret ;not found - continue searching
setzm going ;found - turn off GOTO flag
move t1,comjfn ;our command file
sfptr% ;set the pointer for the next read
ercal error
setzm target ;clear out GOTO target
ret ;continue executing commands
badcom: fatal <unidentifiable command: >,noret,,nocmd
jrst badc1
comfl: fatal <failure to parse command: >,noret,,nocmd
badc1: hrroi t1,scratch
psout%
tmsg <
[IND - exiting]
>
jrst haltt
subttl The .RUN command
;
; This rotine processes the .RUN command, replacing the EXEC run
; cos that doesn't work with CRCMD.
;
.run: stkvar <prgfrk>
call skpblk ;skip over blanks
movem t1,comptr ;point to non-blank
movem t1,t2 ;place in correct place for GTJFN
movei t1,gjargs ;address of file argument block
gtjfn% ;grab filespec
erjmp [fatal <Cannot find program to run because:>,,mcall] ;bad return
movem t1,prgjfn ;save jfn of exe file
move t1,t2 ;get pointer to rescan string
call rsload ;load the rescan buffer
move t1,prgjfn ;get jfn of exe file again
call mapprg ;map the program
jrst [fatal <can't RUN program: >,,mcall] ;error from mapper
movem t1,prgfrk ;save the handle
call dotell ;If there is a TELL buffer, send it now
move t1,prgfrk ;Get the fork handle back
setz t2, ;start at primary position
sfrkv% ;get the fork going
ercal error
move t1,prgfrk
wfork% ;wait for fork termination
kfork% ;kill it off
move t1,runnam ;retrive old program name
setnm% ;reset it
retskp ;return to the outside world
;
; routine to load rescan buffer from pointer in t1
;
rsload: push p,t1 ;save command pointer
setzm scratch ;blank out word we're going to use
setzm scratch+1 ;and the following
hrroi t1,scratch ;point to scratch buffer
move t2,prgjfn ;JFN of proggy we're about to run
movx t3,fld(.jsnof,js%dev)+fld(.jsnof,js%dir)+fld(.jsaof,js%nam)
+fld(.jsnof,js%typ)+fld(.jsnof,js%gen) ;name only
jfns% ;write filename to rescan buffer
ercal error ;crash
push p,t1 ;save pointer
call sysnam ;set new program name
pop p,t1 ;restore pointer
pop p,t2 ;retrive command pointer
bkptr t2 ;backspace one byte
setzb t3,t4 ;termina te on null
sout% ;write command with exe name
ercal error
hrroi t1,scratch ;repoint to rescan buffer
rscan% ;load rescan buffer
ercal error
ret ;return
;
; routine takes string from scratch buffer, and makes it our new
; program name. Calls ascsix from the string routines. Our old
; name is saved in runnam, for later restoration. New name is in
; prgnam.
;
sysnam: getnm% ;get current name
movem t1,runnam ;save it
move t1,[point 7,scratch] ;point to ASCII name
call ascsix ;SIXBIT returned in t2
move t1,t2 ;place in correct AC
setnm% ;set the name
ret ;return OK
;
; routine to map file whose JFN is in t1, return handle in t1
; +1 fail, +2 success
;
mapprg: stkvar <prghnd>
movem t1,prgjfn ;save jfn
movx t1,cr%cap ;same capabilites as us
cfork% ;grab a fork
erjmp [ret] ;no thanks, you've had enough
movem t1,prghnd ;save a handle on a fork
hrlzs t1,t1 ;put process handle in left half
hrr t1,prgjfn ;and a JFN in the right half
get% ;map file to process
erjmp [ret]
move t1,prghnd ;return handle for use by caller
retskp ;return success
;
; Routine to send the contents of the TELL buffer at our inferior
; if necessary.
;
dotell: skipn telcmd ;Any command ?
ret ;no, so do nothing
move t3,[point 7,telcmd] ;yes, so point to it
movei t1,.priin ;Point to our terminal
dotela: ildb t2,t3 ;Get a byte
cain t2,lf ;Line feed ?
jrst dotele ;yes, we've already given cr
jumpe t2,dotele ;if null, done
sti% ;Else input it
jrst dotela ;and loop
dotele: setzm telcmd ;blank the buffer
ret ;done
subttl Set logical symbol true or false - .SETT
;
; .SETT/.SETF routines
;
.sett: setzm lgcflg ;true value
skipa
.setf: setom lgcflg ;false value
move t1,comptr ;point to command stuff
move t2,[point 7,asksym] ;and scratch store
call getwrd ;try out symbol
movem t1,comptr ;save command pointer
movei t1,$lgc ;check symbol is logical
call askchk
jrst illtyp ;no, symbol is illegal type
hrroi t1,asksym ;ok, either its logical or undefined
move t2,lgcflg ;get its value
call entlgc ;enter into table
ret ;return fail
retskp ;return success
illtyp: fatal <symbol is invalid type for assignment:
>
subttl Test logical flag - .IFF/.IFT
;
; .IFF/.IFT - test logical flag and execute rest of command conditionally
; We use a second entry point to the command parser just past the point
; where we read from a file
;
.iff: setom lgcflg ;mark what we want
skipa
.ift: setzm lgcflg
move t2,[point 7,scratch]
call getwrd ;get symbol name
call skpblk ;skip over blanks
movem t1,comptr ;save for later
hrroi t1,scratch ;point to symbol name
call luklgc ;try to find symbol
jrst [hrroi t1,scratch ;failed, try permanent symbol table
call luksys ;is it there ?
jrst [fatal <logical symbol not defined: >];return failure - symbol not known
caie t3,$lgc ;its there - is it logical ?
jrst [fatal <system symbol not type logical: >] ;no
jrst .+1] ;all ok
came t2,lgcflg ;is symbol what we want ?
retskp ;no, don't bother to do owt
move t1,comptr ;yes, skip over leadind blanks
call skpblk
.ift1: movem t1,comptr
hrroi t1,comlin ;prepare to rewrite command
move t2,comptr
movei t3,^d80 ;maximum length of line
setz t4, ;terminate on null
sout%
ercal error
movei t2,^d80 ;what we wanted to write
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
pop p,t1 ;throw away our return address
pop p,t1 ;and PARSES return too
move t1,[point 7,comlin] ;point to command
jrst intfil ;internal command entry
subttl .ASK command - get yes/no answer
;
; ASK for value of a logical symbol
;
.ask: stkvar askval ;value of answer,symbol name(3 words)
call iniflgs ;initialize <default>, etc.
move t2,[point 7,asksym] ;temporary storage for our symbol
call getwrd ;get the symbol
call skpblk ;skip over blanks
movem t1,comptr ;save command line pointer
movei t1,$lgc ;the table we allow
call askchk ;check the symbol isn't already there
jrst [fatal <symbol is not logical: >] ;return
move t1,comptr ;point beyond symbol
call skpblk ;eat up blanks
movem t1,comptr ;comptr now points at start of question
hrroi t1,asklin ;point to question buffer
hrroi t2,[asciz/* /] ;question prefix
setzb t3,t4
sout% ;write prefix
ercal error
move t2,comptr ;now use question text
movei t3,^d70 ;no more than 70 chars
movei t4,15 ;terminate on cr
sout% ;write question also
ercal error
bkptr t1 ;back up over cr
hrroi t2,[asciz\ [Y/N] \] ;put the question type ID out
setzb t3,t4
sout%
ercal error
.ask2: hrroi t1,asklin ;point to prompt
call cmdini ;output prompt
movei t1,cmdblk ;point to state block
movei t2,[fldbk. (.cmkey,,ysntab,,<NO>,bmask,exfdb)]
comnd% ;parse yes or no
ercal error
txne t1,cm%nop ;parse ok ?
jrst yesorno ;no, complain and try again
testz ;check for control z
hrre t2,(t2) ;get yes or no indicator
movem t2,askval ;store value
confirm ;try to confirm
jrst .ask2 ;failed
hrroi t1,asksym ;point to symbol name
move t2,askval ;get value of answer
call entlgc ;enter logical value
ret ;failed
retskp ;succeeded
;
; Complain about answer
;
yesorno: fatal <yes or no required
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .ask2 ;ask again
purge askval
;
; Check symbol is not numeric or string or logical - t1 contains valid
; symbol type, assumes symbol is in ASKSYM.
; $ entry point assumes pointer to name is in t2.
; Return +1: Symbol is defined in other table
; +2: Symbol is in desired table or is not defined
;
askchk: hrroi t2,asksym ;where symbol is
$askchk: stkvar oktab
movem t1,oktab ;remember valid table to use
move t1,t2 ;get pointer in right ac
call luksym ;lookup the symbol
retskp ;not defined, so definitely kosher
camn t3,oktab ;defined - is it the correct type ?
retskp ;yes, so return +2
ret ;no, return failure
subttl .SETS - set string symbol
;
; .SETS - set a string symbol to specified value
;
.sets: stkvar <strstt,sexpvl> ;3 words for symbol name
move t2,[point 7,asksym] ;place to store symbol name
call getwrd ;get symbol name
movem t1,comptr ;save position after symbol name
call skpblk ;skip over blanks
call strexp ;parse string expression
ret ;parser failed
movem t2,sexpvl ;save pointer to value
movei t1,$str ;and valid table for it
call askchk ;check it isn't in another table
jrst illtyp ;it is - complain
hrroi t1,asksym ;point to symbol name
move t2,sexpvl ;and symbol value
call entstr ;enter string into table
ret ;return -failure
retskp ;return -success
subttl .STATUS command - print symbol table usage
;
; .STATUS command - print out status of IND tables, and symbol
; values
;
.status: tmsg <
----- IND symbol tables and internal flags -----
>
tmsg <
Exits on control-Z are >
hrroi t1,[asciz/not /]
skipe extflg ;allowed to exit ?
psout% ;no
tmsg <allowed.
>
tmsg < Substitution is >
hrroi t1,[asciz /not /]
skipe sbtflg ;substitution allowed ?
psout% ;no
tmsg < being performed.
>
skipn nsqzd ;garbage collection performed ?
jrst .stat1 ;no, print nothing
tmsg < Garbage collection of string pool has been performed >
movei t1,.priin ;terminal
move t2,nsqzd ;number of times performed
movx t3,^d10 ;rad10
nout% ;type number
ercal error
tmsg < times.
>
.stat1: skipn exsrch ;name table filled once ?
jrst .stat2 ;no, print nothing
tmsg < Exhaustive searches for name slots have occurred >
movei t1,.priin ;terminal
move t2,exsrch ;number of times performed
movx t3,^d10 ;rad10
nout% ;type number
ercal error
tmsg < times.
>
.stat2: tmsg <
> ;nice blank line before tables
define prttab(tabnam,tabtyp,tabrtn),<
xlist
hrroi t1,[asciz/
'tabnam': /]
psout%
movei t1,tabtyp ;;point to symbol table
call stuse ;;print usage
movei t1,tabtyp ;;now get tables printed out
movei t2,tabrtn ;;routine to print values
call stprnt ;;print a table out
list
>
tmsg < Symbol table usage : >
prttab Numeric,$num,.stn ;print numeric tables
prttab Floating-point,$flt,.str
prttab Strings,$str,.sts ;string tables
prttab Logicals,$lgc,.stl ;logical tables
prttab Files,$fil,.stf
prttab Labels,$lab,.stlb
tmsg <
----- End of status report -----
>
retskp ;return success always
;
; subroutine which takes a table type in t1, and prints out
; used and total entries.
;
stuse: movem t1,t4 ;save table type
move t2,symuse(t4) ;get currently used number of symbols
movei t1,.priou ;type on terminal
movx t3,^d10 ;in rad 10
nout% ;type number
ercal error
tmsg < entries used from a total of >
movei t1,.priou ;on terminal again
movx t3,^d10
move t2,symmax(t4) ;get total in table
nout% ;type again
ercal error
tmsg < entries available.
Symbols defined, with values:
>
ret
;
; Subroutine takes a symbol type in t1, formatter routine address in t2.
; It prints out the names of all symbols in the table, and calls the
; routine from t2 to print out the symbol value, via a table pointer in
; t3.
;
stprnt: stkvar <rtn,typcod>
skipn symuse(t1) ;any symbols of this type in use ?
jrst stpr2 ;no, so say so
hlrz q1,symbols ;head of table=number of entries,,max num
movns q1,q1 ;make negative
hrlz q1,q1 ;put in left half
addi q1,symbols+1 ;point to first real entry
movem t2,rtn ;save the formatter routine's addres
movem t1,typcod ;save symbol type code
stpr1: hrrz t3,(q1) ;get offset into symval table
addi t3,symval ;construct address of type code for this routine
move t4,typcod ;get symbol type code
came t4,(t3) ;does this code match what we want ?
jrst stprl ;no, go for next entry
hlro t1,(q1) ;yes, construct byte pointer to symbol name
psout% ;type it
tmsg <: >
call (t2) ;dispatch to routine to print out value
move t2,rtn ;reget dispatch address
stprl: aobjn q1,stpr1 ;loop through table
ret ;return success
stpr2: tmsg < No entries currently in use.
>
ret
purge rtn,typcod ;dispose of local variables
;
; The value printing routines
;
.stn: move t2,1(t3) ;get numeric value
move t3,radix ;get current radix
movei t1,.priou ;on terminal
nout%
ercal error
tmsg <
>
ret
.str: move t2,1(t3) ;get floating value
setz t3, ;normal format
movei t1,.priou ;on terminal
flout%
ercal error
tmsg <
>
ret
.stl: move t2,1(t3) ;get logical value
hrroi t1,[asciz/ False.
/] ;false ?
skipn t2
hrroi t1,[asciz/ True.
/] ;nope, true
psout%
ret
.sts: move t2,1(t3) ;get byte address of string
move t1,[point 7,strings] ;point to start of strings
adjptr t1,t2 ;adjust to point to selected string
psout%
tmsg <
>
ret
.stf: move t2,1(t3) ;get JFN
movei t1,.priou ;type on terminal
setz t3, ;no fancies
jfns% ;type filename
erjmp error
tmsg <
>
ret
.stlb: tmsg < at byte >
move t2,1(t3) ;get byte number
movx t3,^d10
movei t1,.priou
nout%
ercal error
tmsg <
>
ret
subttl Set numeric symbol
;
; .SETN command - set a symbol to a numeric value.
;
; Format: .SETN symbol nnnn
;
.setn: stkvar setnvl ;value
move t2,[point 7,asksym] ;and scratch store
call getwrd ;try out symbol
call skpblk ;skip over blanks to value
movem t1,comptr ;save command pointer
movei t1,$num ;valid table
call askchk ;check symbol is numeric
jrst illtyp ;no
move t1,comptr ;point to start of expression
call numexp ;now parse the numeric expression
jrst setn1 ;failed
hrroi t1,asksym ;point to this symbol
call entnum ;add or replace in numeric table
ret ;faile
retskp ;succeed
setn1: fatal <can't understand number: >,,mcall
purge setnvl
subttl Set floating point symbol
;
; .SETR command - set a symbol to a real value.
;
; Format: .SETR symbol floating expression
;
.setr: stkvar setnvl ;value
move t1,comptr ;point to command stuff
call skpblk
move t2,[point 7,asksym] ;and scratch store
call getwrd ;try out symbol
call skpblk ;skip over blanks to value
movem t1,comptr ;save command pointer
movei t1,$flt ;valid table
call askchk ;check symbol is real
jrst illtyp ;no
move t1,comptr ;point to start of expression
call fltexp ;now parse the real expression
jrst setr1 ;failed
hrroi t1,asksym ;point to this symbol
call entflt ;add or replace in real table
ret ;faile
retskp ;succeed
setr1: fatal <can't understand number: >,,mcall
purge setnvl
subttl .ENABLE and .DISABLE commands to toggle flags
;
; .ENABLE/.DISABLE commands - same code, same tables, just a
; flag marks the difference. These commands do things like
; turning substitution on and off. Format:
; .ENABLE SUBSTITUTION
;
.disable: setom edtyp ;mark enable
skipa
.enable: setzm edtyp
move t2,[point 7,scratch] ;point to the scratch buffer
call getwrd ;grab the argument to command
hrroi t2,scratch ;now point to the word
movei t1,edtab ;table of keywords for command
tbluk% ;try and lookup in the table
ercal error ;crash - table is trashed
txne t2,tl%nom ;match found ?
jrst .disa1 ;no - bad argument - complain
txne t2,tl%amb ;ambiguous ?
jrst .disa2 ;yes - complain
skipe datflg ;are we in DATA mode ?
jrst [caie t1,..data ;yes, is it the DATA directive ?
retskp ;no, ignore
skipn edtyp ;OK, is it DISABLE ?
retskp ;no, ignore
jrst .+1] ;yes, allow it
hrrz t2,(t1) ;OK - get routine to do the work
call (t2) ;call it
retskp ;and return success
;
; Errors from keywords
;
.disa1: fatal <unrecognised .ENABLE/.DISABLE flag:
>
.disa2: fatal <ambiguous: >
subttl EDABO - enable/disable aborting via CTRL/A
;
; These routines were a little too long to put in literals,
; so they are here. They enable/disable the interrupts to abort
; IND.
;
edabo: skipge edtyp ;is it .DISABLE ABORT ?
jrst dabort ;yes, handle that
skipn abortf ;no, .ENABLE, is it already done ?
ret ;yes, so ignore directive
move t1,[aboch,,abochn] ;no, so get character code,,channel
ati% ;assign code to channel
ercal error
movx t1,.fhslf ;point to our fork
movx t2,1b<abochn> ;flag the channel number
aic% ;reactivate the channel
ercal error ;should not fail
setzm abortf ;flag aborts enabled
ret ;return for next directive
dabort: skipe abortf ;aborts already disabled ?
ret ;yes, so ignore directive
movx t1,aboch ;no, so get the terminal code
dti% ;deactive it
ercal error
movx t1,.fhslf ;now point to our process
movx t2,1b<abochn> ;and get the channel bit
dic% ;disable the channel
ercal error ;should not fail
setom abortf ;mark aborts disabled
ret ;and return
subttl .ASKN - get numeric answer
;
; .ASKN - get a numeric answer
;
.askn: stkvar <askval,nrng> ;value of answer,number of ranges
call iniflgs ;initialize <escape>, etc.
setzm nrng ;zero number of ranges
movem t1,comptr ;save command position
call ranges ;get possible ranges, defualt
ret ;bad range format
movem t2,nrng ;save number of ranges
call skpblk ;skip blanks again
move t2,[point 7,asksym] ;temporary storage for our symbol
call getwrd ;get the symbol
call skpblk ;skip over blanks
movem t1,comptr ;save command line pointer
movei t1,$num ;this is the one we allow
call askchk ;check the symbol isn't already there
jrst [fatal <symbol is not numeric: >]
move t1,comptr ;point beyond symbol
call skpblk ;eat up blanks
movem t1,comptr ;comptr now points at start of question
hrroi t1,asklin ;point to question buffer
hrroi t2,[asciz/* /] ;question prefix
setzb t3,t4
sout% ;write prefix
ercal error
move t2,comptr ;now use question text
movei t3,^d70 ;no more than 70 chars
movei t4,15 ;terminate on cr
sout% ;write question also
ercal error
bkptr t1 ;back up over cr
hrroi t2,[asciz\ [#\] ;put the question type ID out
setzb t3,t4
sout%
ercal error
skipn nrng ;ranges, defaults ?
jrst .askn4 ;no, skip next
move t2,nrng ;get number of ranges
caige t2,2 ;at east 2 ?
jrst .askn4 ;no, strange syntax
movei t2," "
idpb t2,t1
movei t2,"R" ;bung out some chars
idpb t2,t1
movei t2,":" ;it's a waste of time using SOUT for
idpb t2,t1 ;this sort of thing - only a few chars
move t2,q1 ;get lower range
move t3,radix ;get current radix
nout% ;write it out
ercal error
movei t2,":" ;separator
idpb t2,t1
move t3,radix ;get current radix
move t2,q2 ;upper range
nout% ;write it out
ercal error
move t2,nrng ;get ranges again
caie t2,3 ;default as well ?
jrst .askn4 ;no
movei t2," " ;space between
idpb t2,t1
movei t2,"D" ;default
idpb t2,t1
movei t2,":"
idpb t2,t1
move t2,q3 ;get defualt val
move t3,radix ;get current radix
nout% ;write out
ercal error
.askn4: movei t2,"]"
idpb t2,t1
setz t2,
idpb t2,t1
.askn2: hrroi t1,asklin ;bung out CTRL/R buffer
call cmdini ;initialize COMND stuff
hrroi t1,scratch ;point to scratch buffer
move t2,q3 ;get possible default value
move t3,radix ;get current radix
move t4,nrng ;get number of ranges
cail t4,3 ;was a default supplied ?
nout% ;yes, write it out
ercal error ;should not fail
hrroi t1,scratch ;point at possible default
setzm numfdb+.cmdef ;assume no default
cail t4,3 ;was a default supplied
movem t1,numfdb+.cmdef ;yes, store the pointer to default
move t1,radix ;get current radix
movem t1,numfdb+.cmdat ;store in FDB for COMND
movei t1,cmdblk ;point to state block
movei t2,numfdb ;and function block
comnd% ;try to parse a number
ercal error ;crash
txne t1,cm%nop ;parsed ok ?
jrst numrqd ;no, complain and retry
testz ;check for control-z
.askn5: movem t2,askval ;remember as value
confirm ;confirm response
jrst .askn2 ;failed confirmation
move t2,nrng ;were ranges supplied
cail t2,2
jrst .asknr ;yes, check we are in range
.askn6: hrroi t1,asksym ;point to symbol
move t2,askval ;get value of answer
call entnum ;enter into table
ret ;faile
retskp ;succeed
;
; check answer is in range
;
.asknr: camge q2,askval ;top limit greater ?
jrst .askn7 ;no
camle q1,askval ;bottom limit lower ?
jrst .askn7 ;no
jrst .askn6 ;yes, OK
;
; Complain about answer
;
numrqd: fatal <numeric answer required
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .askn2 ;ask again
purge askval,nrng
.askn7: fatal <answer not in range
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .askn2
subttl .ASKR - get floating answer
;
; .ASKR - get floating answer
;
.askr: stkvar <askval,nrng> ;value of answer,number of ranges
call iniflgs ;initialize <escape>, etc.
setzm nrng ;zero number of ranges
movem t1,comptr ;save command position
call franges ;get possible ranges, defualt
ret ;bad range format
movem t2,nrng ;save number of ranges
call skpblk ;skip blanks again
move t2,[point 7,asksym] ;temporary storage for our symbol
call getwrd ;get the symbol
call skpblk ;skip over blanks
movem t1,comptr ;save command line pointer
movei t1,$flt ;this is the one we allow
call askchk ;check the symbol isn't already there
jrst [fatal <symbol is not floating: >]
move t1,comptr ;point beyond symbol
call skpblk ;eat up blanks
movem t1,comptr ;comptr now points at start of question
hrroi t1,asklin ;point to question buffer
hrroi t2,[asciz/* /] ;question prefix
setzb t3,t4
sout% ;write prefix
ercal error
move t2,comptr ;now use question text
movei t3,^d70 ;no more than 70 chars
movei t4,15 ;terminate on cr
sout% ;write question also
ercal error
bkptr t1 ;back up over cr
hrroi t2,[asciz\ [#\] ;put the question type ID out
setzb t3,t4
sout%
ercal error
skipn nrng ;ranges, defaults ?
jrst .askr4 ;no, skip next
move t2,nrng ;get number of ranges
caige t2,2 ;at east 2 ?
jrst .askr4 ;no, strange syntax
movei t2," "
idpb t2,t1
movei t2,"R" ;bung out some chars
idpb t2,t1
movei t2,":" ;it's a waste of time using SOUT for
idpb t2,t1 ;this sort of thing - only a few chars
move t2,q1 ;get lower range
setz t3, ;default format
flout% ;write it out
ercal error
movei t2,":" ;separator
idpb t2,t1
setz t3, ;usual format
move t2,q2 ;upper range
flout% ;write it out
ercal error
move t2,nrng ;get ranges again
caie t2,3 ;default as well ?
jrst .askr4 ;no
movei t2," " ;space between
idpb t2,t1
movei t2,"D" ;default
idpb t2,t1
movei t2,":"
idpb t2,t1
move t2,q3 ;get defualt val
setz t3, ;usual format
flout% ;write out
ercal error
.askr4: movei t2,"]"
idpb t2,t1
setz t2,
idpb t2,t1
.askr2: hrroi t1,asklin ;bung out CTRL/R buffer
call cmdini ;initialize COMND stuff
hrroi t1,scratch ;point to scratch buffer
move t2,q3 ;get possible default value
setz t3, ;write in usual format
move t4,nrng ;get number of ranges
cail t4,3 ;was a default supplied ?
flout% ;yes, write it out
ercal error ;should not fail
hrroi t1,scratch ;point at possible default
setzm fltfdb+.cmdef ;assume no default
cail t4,3 ;was a default supplied
movem t1,fltfdb+.cmdef ;yes, store the pointer to default
movei t1,cmdblk ;point to state block
movei t2,fltfdb ;and function block
comnd% ;try to parse a number
ercal error ;crash
txne t1,cm%nop ;parsed ok ?
jrst fltrqd ;no, complain and retry
testz ;check for control-z
.askr5: movem t2,askval ;remember as value
confirm ;confirm response
jrst .askr2 ;failed confirmation
move t2,nrng ;were ranges supplied
cail t2,2
jrst .askrr ;yes, check we are in range
.askr6: hrroi t1,asksym ;point to symbol
move t2,askval ;get value of answer
call entflt ;enter into table
ret ;faile
retskp ;succeed
;
; check answer is in range
;
.askrr: camge q2,askval ;top limit greater ?
jrst .askr7 ;no
camle q1,askval ;bottom limit lower ?
jrst .askr7 ;no
jrst .askr6 ;yes, OK
;
; Complain about answer
;
fltrqd: fatal <floating point answer required
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .askr2 ;ask again
purge askval,nrng
.askr7: fatal <answer not in range
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .askr2
subttl .IFDF/.IFNDF commands
;
; Conditional execution depending on whether a symbol is defined
;
.ifndf: setzm ifdtyp ;flag not defined wanted
skipa
.ifdf: setom ifdtyp ;symbol must be defined
move t2,[point 7,asksym]
call getwrd ;get symbol name
call skpblk ;skip over blanks
movem t1,comptr ;save for later
setom fnd ;mark found initially
hrroi t1,asksym ;point to symbol
call luksym ;and see if it exists
setzm fnd ;it doesn't - indicate
move t1,fnd ;OK, did we find it ?
came t1,ifdtyp ;is the result a success
retskp ;no, either found and not wanted or vice versa
move t1,comptr ;OK - the IF worked,now do command
call skpblk ;skip over blanks
movem t1,t2 ;point to startof new command
hrroi t1,comlin ;yes, prepare to rewrite command
movei t3,^d80 ;maximum length of line
setz t4, ;terminate on null
sout%
ercal error
movei t2,^d80 ;what we wanted to write
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
pop p,t1 ;throw away our return address
pop p,t1 ;and PARSES return too
move t1,[point 7,comlin] ;point to command
jrst intfil ;internal command entry
subttl The .PAUSE command
;
; This command uses the p$USH bit in CRCMD, which just continues the
; EXEC until we do a POP.
;
.pause: move t1,excflgs ;get lower fork flags
txon t1,e$cho ;set echo on, and ask if it already was
jrst .pau1 ;it was not, so don't print messages
tmsg <
[IND - pausing. To continue type "POP"]
>
.pau1: movx t2,c$cmd+e$cho+p$ush ;push, freeze, echo, keep COMAND.CMD
call $CRcmd
skipe t3 ;OK ?
call excerr ;no
move t1,excflgs ;get exec level flags
txnn t1,e$cho ;echo on ?
retskp ;no, no messages ta
tmsg <
[IND - continuing]
>
retskp
subttl The GOTO command
;
; This command is of the form .GOTO lab, where lab will be in
; the file in the form .lab: . We check if it is already in the symbol
; table, in which case we can use SFPTR and return, or we must set
; GOING to true, and set up the label in TARGET, returning to allow
; a search through the file for the label.
;
.goto: move t1,comptr ;point to label name
move t2,[point 7,target] ;where to put label
call getwrd ;pickup label from command
movem t1,comptr ;save pointer
hrroi t1,target ;point to label
call luklab ;does it exist ?
jrst .goto2 ;no, we must search
move t1,comjfn ;yes, just reset
sfptr% ;the file pointer
ercal error
retskp ;and continue from the label
.goto2: setom going ;no, we must set up for a goto search
retskp ;which inhibits command execution
subttl The .OPEN, .OPENA and .CLOSE commands
;
; These commands are of the form .OPEN filename and .CLOSE . They open a
; secondary fileto which the output of the .DATA directive, or .ENABLE
; DATA is directed. .CLOSE is a no-op if no file is open.
; .OPENA opens the file for append, not write
;
.opena: movx t3,fld(7,of%bsz)+of%app ;open for append
movx t1,gj%sht!gj%old ;file must exist
jrst .+3
.open: movx t3,fld(7,of%bsz)+of%wr ;open for write
movx t1,gj%sht!gj%new!gj%fou ;new file
skipe datjfn ;file already open ?
jrst [fatal <File already open:>] ;yes, complain
move t2,comptr
gtjfn% ;attempt to get a handle
erjmp .open1 ;failed for some reason
movem t1,datjfn ;save the handle
move t2,t3 ;open for write or append
openf%
erjmp .open1 ;failed for some reason
retskp ;return success
.open1: fatal <can't OPEN file: >,noret,mcall
setzm datjfn ;clear in case error was on OPENF
ret ;return failure
.close: move t1,datjfn ;get file handle
jumpe t1,rskp ;if no file, return success
closf% ;close file
ercal errmes ;huh ?
setzm datjfn ;indicate we have no file
retskp ;return success
subttl The .DATA command - sends data to secondary file
;
; This command is of the form .DATA kwjre ekekkjtr wjejjetre
; Everything from the first non-blank character after the .DATA to the
; end of line is output to the secondary file, if it exists. If it does
; not, an error is generated.
;
.data: move t1,datjfn ;get handle on secondary file
jumpe t1,[fatal <no data file open:>] ;nofile open- complain
move t2,comptr ;pointer to data for file
setzb t3,t4 ;write until null seen
sout%
erjmp [fatal <error writing to data file:>,,mcall] ;we have an error (disk full ?)
retskp ;return success
subttl The .SETFI command - set file symbol
;
; This command is of the form .SETFI FILS Filename.type
; It sets up a file symbol
;
.setfi: move t2,[point 7,asksym]
call getwrd ;get file symbol name
call skpblk ;skip over blanks
movem t1,comptr
movei t1,$fil ;valid table
call askchk ;check valid type
jrst illtyp ;no
move t2,comptr ;point to filename
movx t1,gj%sht ;short call
gtjfn% ;get a handle
erjmp .sef1 ;error
movem t1,t2 ;save handle
hrroi t1,asksym ;point to symbol name
call entfil ;enter into table
ret ;fail
retskp ;succeed
.sef1: fatal <error in filename:>,,mcall
subttl The .ASKF command - ask for file spec (with recognition)
;
; This command is like the other .ASKx - format is
; .ASKF [n] fildef Filename for output ?
; prompt is * Filename for output ? [F] .
; We use an extended GTJFN for the CTRL/R buffer, and return a JFN for the
; file symbol table. n is the default generation number, either a straight
; number or a -1 for a new file, 0 for an old file, or -2 for oldest
; existing generation.
;
.askf: stkvar askval ;value of answer
call iniflgs ;initialize <default>, etc.
call ranges ;check out range blocks
ret ;bad range format
skipn t2 ;was there any supplied ?
setzm q1 ;no, so assume an old file
movem q1,q2 ;remember generation number
hrrzs q1,q1 ;make generation number a right half
txo q1,gj%msg ;set message flag up
txz q1,gj%old ;assume not an old file
skipn q2 ;but if generation was zero
txo q1,gj%old ;we must nudge GTJFN a little bit
call skpblk ;skip over blanks after ranges
move t2,[point 7,asksym] ;temporary storage for our symbol
call getwrd ;get the symbol
call skpblk ;skip over blanks
movem t1,comptr ;save command line pointer
movei t1,$fil ;the table we allow
call askchk ;check the symbol isn't already there
jrst [fatal <symbol is not a file symbol: >]
move t1,comptr ;point beyond symbol
call skpblk ;eat up blanks
movem t1,comptr ;comptr now points at start of question
hrroi t1,asklin ;point to question buffer
hrroi t2,[asciz/* /] ;question prefix
setzb t3,t4
sout% ;write prefix
ercal error
move t2,comptr ;now use question text
movei t3,^d70 ;no more than 70 chars
movei t4,15 ;terminate on cr
sout% ;write question also
ercal error
bkptr t1 ;back up over cr
hrroi t2,[asciz\ [F]:\] ;put the question type ID out
setzb t3,t4
sout%
ercal error
.askf2: hrroi t1,asklin ;bung out CTRL/R buffer
call cmdini ;initialize COMND
call askfd ;set up defaults for name,type etc.
movem q1,gjfblk ;restore arguments to filename block
movei t1,cmdblk ;address of state block
movei t2,[fldbk. (.cmfil,cm%sdh,,<File specification>,,bmask,exfdb)]
comnd% ;parse the filespec
ercal error ;crash
txne t1,cm%nop ;parsed ok ?
jrst [call errmes ;no, output error
call clrinp ;clear input buffer
jrst .askf2] ;try again
testz ;check for ctrl-z
movem t2,askval ;store JFN
confirm
jrst .askf2
hrroi t1,asksym ;point to symbol
move t2,askval ;value of answer
call entfil ;enter into table
ret ;return failure
retskp ;return success
purge askval
subttl askfd - set up defaults for .ASKF
;
; This routine is called to look for the existence of the symbols
; <defnam>, <deftyp>, <defdir>, <defdev>, and <defacc>.
; If they exist, the corresponding default fields in the GTJFN block
; are setup for COMND to use.
;
askfd: hrroi t1,[asciz/<defnam>/] ;point to a string
call lukstr ;look for it
skipa ;not found
movem t2,gjfblk+.gjnam ;default found for name, enter it
hrroi t1,[asciz/<deftyp>/] ;point to a string
call lukstr ;look for it
skipa ;not found
movem t2,gjfblk+.gjext ;default found for type, enter it
hrroi t1,[asciz/<defdir>/] ;point to a string
call lukstr ;look for it
skipa ;not found
movem t2,gjfblk+.gjdir ;default found for directory, enter it
hrroi t1,[asciz/<defdev>/] ;point to a string
call lukstr ;look for it
skipa ;not found
movem t2,gjfblk+.gjdev ;default found for device, enter it
hrroi t1,[asciz/<defacc>/] ;point to a string
call lukstr ;look for it
skipa ;not found
movem t2,gjfblk+.gjact ;default found for account, enter it
ret ;back to caller
subttl .GOSUB, .RETURN commands
;
; These two commands allow one to have subroutines in IND files.
; .GOSUB pushes down a call stack, and uses the .GOTO code. .RETURN
; pops the .GOSUB stack, and resets the byte pointer for input.
;
.gosub: move t3,gonst ;check GOSUB nesting depth
cail t3,mxcnst-1 ;maximum call depth exceeded ?
jrst [fatal <subroutine nesting depth exceeded:
>,stop] ;yes, crash
move t1,comjfn ;command file JFN
rfptr% ;find start of next line
ercal error
movem t2,substk(t3) ;and stack on the subroutine list
aoj t3, ;bump the pointer
movem t3,gonst ;and store it again
jrst .goto ;get .GOTO to do the rest of the work
;
; .RETURN
;
.return: skipn gonst ;are we in a subroutine ?
jrst [fatal <.RETURN when not in subroutine:>]
move t1,gonst ;yes, get the nesting depth
soj t1, ;decrement
movem t1,gonst ;place back
move t2,substk(t1) ;get old file pointer
move t1,comjfn ;JFN of command file
sfptr% ;reset to continue from old place
ercal error
retskp ;return success
subttl .ASKS command - ask for a string
;
; format : .ASKS [low:high] symnam what is your name?
;
; low and high are optional range bounds for length
; If symbol <STRINGDEF> is defined as string, then it's contents are
; used as the default response.
;
.asks: stkvar <askval,nrng> ;value of answer,number of ranges
call iniflgs ;initialize <escape>, etc.
setzm nrng ;zero number of ranges
movem t1,comptr ;save command position
call ranges ;get possible ranges, defualt
ret ;bad range format
movem t2,nrng ;save number of ranges
call skpblk ;skip blanks again
move t2,[point 7,asksym] ;temporary storage for our symbol
call getwrd ;get the symbol
call skpblk ;skip over blanks
movem t1,comptr ;save command line pointer
movei t1,$str ;this is the one we allow
call askchk ;check the symbol isn't already there
jrst [fatal <symbol is not string: >]
move t1,comptr ;point beyond symbol
call skpblk ;eat up blanks
movem t1,comptr ;comptr now points at start of question
hrroi t1,asklin ;point to question buffer
hrroi t2,[asciz/* /] ;question prefix
setzb t3,t4
sout% ;write prefix
ercal error
move t2,comptr ;now use question text
movei t3,^d70 ;no more than 70 chars
movei t4,15 ;terminate on cr
sout% ;write question also
ercal error
bkptr t1 ;back up over cr
hrroi t2,[asciz\ [S\] ;put the question type ID out
setzb t3,t4
sout%
ercal error
move t2,nrng ;get number of ranges
caie t2,2 ;at east 2 ?
jrst .asks4 ;no, strange syntax
movei t2," "
idpb t2,t1
movei t2,"R" ;bung out some chars
idpb t2,t1
movei t2,":" ;it's a waste of time using SOUT for
idpb t2,t1 ;this sort of thing - only a few chars
move t2,q1 ;get lower range
movx t3,^d10
nout% ;write it out
ercal error
movei t2,":" ;separator
idpb t2,t1
movx t3,^d10
move t2,q2 ;upper range
nout% ;write it out
ercal error
.asks4: movei t2,"]"
idpb t2,t1
setz t2,
idpb t2,t1
.asks2: setzm strfdb+.cmdef ;zero string default pointer
hrroi t1,[asciz "<STRDEF>"] ;name of default symbol
call lukstr ;do we have a default supplied ?
skipa ;no, use standard stuff
movem t2,strfdb+.cmdef ;yes, store pointer in FDB
hrroi t1,asklin ;bung out CTRL/R buffer
call cmdini ;initialize COMND blocks
movei t1,cmdblk ;point to state block
movei t2,strfdb ;point to function block for field
comnd% ;do it
ercal error
txne t1,cm%nop ;parsed OK ?
jrst [fatal <Invalid text string>,noret,mcall,nocmd ;no, complain
jrst .asks2]
ldb t1,[point 7,atmbfr,6] ;get a byte
cain t1,^d26 ;control-z ?
call exit ;yes, exit if possible
testz
cain t4,.cmcfm ;was it confirm ?
jrst [setzm atmbfr ;yes, so set string null
move t1,[point 7,atmbfr] ;get pointer
jrst .asks5] ;and continue
confirm
jrst .asks2 ;failed confirmation
move t1,[point 7,atmbfr] ;point to start of answer
.asks5: movem t1,askval ;remember as value
move t2,nrng ;were ranges supplied
cain t2,2
jrst .asksr ;yes, check we are in range
.asks6: hrroi t1,asksym ;point to symbol
move t2,askval ;get value of answer
call entstr ;enter into table
ret ;faile
move t1,[point 7,atmbfr] ;point to answer
call leng ;get length of it
movem t3,strlen ;remember for user
move t1,[point 7,atmbfr] ;point to string again
call strchs ;set up TXTMSK
retskp ;succeed
;
; check answer is in range
;
.asksr: move t1,[point 7,atmbfr] ;point to answer string
call leng ;get length
camge q2,t3 ;top limit greater ?
jrst .asks7 ;no
camle q1,t3 ;bottom limit lower ?
jrst .asks7 ;no
jrst .asks6 ;yes, OK
;
; Complain about answer
;
purge askval,nrng
.asks7: fatal <string length not in range
>,noret,,nocmd
call clrinp ;clear typeahead
jrst .asks2
subttl The .STOP and .EXIT directives
;
; .STOP simulates EOF, but does not print the @ <EOF> message. .EXIT
; is more complex - if the current file has been .CALLed, it does an
; immediate return to our superior command file, otherwise it simulates
; EOF with the @ <EOF> message.
;
.stop: jrst stopp
.exit: jrst eof
subttl The .IF command - permits comparison between strings or numbers
;
; This directive is of the form
; .IF symbol relop expression command
;
; where symbol is either a numeric or a string symbol name, relop is one
; of eq(=) ne(~=) gt(>) ge(>=) lt(<) le(=<) and expression is either
; string or numeric in type according to symbol. The alternative forms of
; relops are shown in brackets after their mnemonic names. The command
; is executed if the comparison returns a true result.
;
.if: move t2,[point 7,asksym] ;where to put our symbol name
call getwrd ;retrieve the symbol
call skpblk ;skip over blanks
move t2,[point 7,scratch] ;now get operator
call getwrd ;retrieve in ASCIZ
call skpblk ;skip over next blanks
movem t1,comptr ;and save position of start of exp
movei t1,reltab ;table of relational operators
hrroi t2,scratch ;one we are considering at the moment
tbluk% ;determine if in table
ercal error ;crash - tables trashed
txnn t2,tl%exm ;exact match ?
jrst .if1 ;no, complain - bad relop
hrrz t2,(t1) ;OK, get relop ID
movem t2,relop ;and remember for when we parse exp
hrroi t1,asksym ;now find out if string or numeric
call luksym ;try numeric or string first
jrst [hrroi t1,asksym ;failed , try system symbol
call luksys ;lookup
jrst .if2 ;still nowhere, complain
movem t3,iftyp ;remember symbol type
movem t2,ifval ;and value
jrst .if3] ;continue
caie t3,$num ;found - is it numeric ?
jrst [caie t3,$str ;or string ?
jrst .if2 ;neither, complain
movem t2,ifval ;string, so save byte count
move t2,[point 7,strings] ;point to string pool
adjptr t2,ifval ;construct byte pointer
jrst .+1] ;ok, continue
movem t3,iftyp ;remember symbol type
movem t2,ifval ;numeric succeeded, save value
.if3: move t1,iftyp ;get type of symbol
cain t1,$num ;numeric ?
jrst .if4 ;yes
move t1,comptr ;no,must be string - point to exp
call strexp ;parse string expression
ret ;failed - strexp has complained
movem t1,comptr ;save position in command
move t1,ifval ;get byte number of symbol value
stcmp% ;compare two strings
move t3,relop ;now get desired operator
jumpe t1,.ifse ;strings are equal ?
txne t1,sc%lss ;no, is sym less than exp ?
jrst .ifsl ;yes
txne t1,sc%gtr ;greater than ?
jrst .ifsg ;yes
txne t1,sc%sub ;subset ?
jrst .ifsl ;yes, consider as lt
fatal <can't understand string comparison: Internal error>,stop
;
; Here for numeric comparison
;
.if4: move t1,comptr ;point to start of expression
call numexp ;evaluate
ret ;failed
movem t1,comptr ;save command position
move t1,ifval ;value of numeric symbol
camn t1,t2 ;are they equal ?
jrst .ifse ;yes
caml t1,t2 ;is sym<exp ?
jrst .ifsg ;no, must be greater
jrst .ifsl ;yes, dispatch as such
;
; Test if the comparison is a success
;
.ifsl: move t3,relop ;get operator bits
txnn t3,$lt ;less than work for this relop ?
retskp ;no, do nothing
jrst .ifgo ;yes, do second command
.ifse: move t3,relop
txnn t3,$eq ;equals work ?
retskp ;no
jrst .ifgo ;yes
.ifsg: move t3,relop
txnn t3,$gt ;greater than OK ?
retskp ;no
jrst .ifgo ;yes
;
; test succeeded - now rewrite command and dispatch for execution
;
.ifgo: move t1,comptr
call skpblk ;skip to start of command
jrst .ift1 ;get .IFT code to do the work
;
; .IF errors
;
.if1: fatal <unknown relational operator:>
.if2: fatal <symbol is not numeric or string for comparison:
>
subttl .IND/.DEC directives - increment/decrement numeric symbol
;
; These directives are purely to make it easier to add or subtract one
; from a symbol to do loops. It looks clearer than .SETN symnam symnam+1
;
.dec: move t2,[soj t2,] ;decrement instruction
skipa
.inc: move t2,[aoj t2,] ;increment instruction
push p,t2 ;save
move t1,comptr ;command pointer
move t2,[point 7,asksym] ;storage for symbol name
call getwrd ;get name
hrroi t1,asksym ;don't use ASKCHK - number MUST alread
call luknum ;exist.
jrst .ince ;it doesn't - complain
hrroi t1,asksym ;we now have the current value in t2
pop p,t3 ;so retrieve inc/dec instruction
xct t3 ;and execute it
call entnum ;and re-enter in table
ret
retskp ;return success
.ince: pop p,t1 ;throw away saved instruction
fatal <symbol does not exist for increment/decrement:>
subttl The .TEST command - test the length of a string expression
;
; This command is of the form .TEST strexp, and sets the special
; symbol <STRLEN> to the length of the string in characters.
; The string symbol bitmask is also set to reflect the characteristics
; of the string - alphabetic, numeric, alphanumeric.
;
.test: move t1,comptr ;get command pointer
call strexp ;parse the string expression
ret ;parse failed
move t1,t2 ;get pointer to string in right ac
push p,t1 ;save copy of it
call leng ;discover length
movem t3,strlen ;remember in right place for SYSSYM
pop p,t1 ;get pointer to string expression back
call strchs ;set characteristics mask
retskp ;return success
;
; This routine is called with a pointer to a string in t1.
; It examines the string, setting the TXTMSK mask with bits to indicate
; whether the string is alphabetic, alphanumeric, or numeric.
;
strchs: movx t3,$numer!$alpha!$nalpha ;assume all are true first
strchl: ildb t2,t1 ;get a char
jumpe t2,strch4 ;if null, all over
caige t2,"0" ;is it a digit ?
txz t3,$numer!$alpha!$nalpha ;no, so clear all flags
caile t2,"9" ;still in digit range ?
txz t3,$numer ;no, so cannot be numeric only
caige t2,"A" ;is it in character set range ?
txz t3,$alpha ;no, so isn't alphabetic
caile t2,"z" ;not beyond end of alphabet range ?
txz t3,$alpha!$numer!$nalpha ;yes, so all untrue
caig t2,"Z" ;is it upper case or less ?
jrst strch1 ;yes, so no more test
caige t2,"a" ;no, so is it lower case ?
txz t3,$alpha!$numer!$nalpha ;no, so clear all flags
strch1: jrst strchl ;test next character
strch4: movem t3,txtmsk ;save mask bits
ret ;return to caller
subttl The .TESTFILE directive - test for existence of a file
;
; Format: .TESTFILE filnam.typ
;
; Sets symbol FILESTAT to 0: File does not exist
; 1: File exists
; -1: File exists in deleted state only
; -2: File exists but is invisible (may be del'd)
; -3: File is offline
; -4: Invalid filespec
;
; Also sets up string symbols <FILNAM>,<FILTYP>,<FILDIR>,<FILDEV>
; <FILGEN>,<FILACT>,<FILPRO>,<FILCRE>,<FILRED>
; and numeric symbols <FILPAG>,<FILSIZ>,<FILBSZ>
; with appropriate fields for the file if it exists in any way.
;
.testfil: STKVAR <TSJFN> ;jfn for file to be tested
move t2,comptr ;point to filename
movx t1,gj%sht+gj%old ;insist on old filename
gtjfn% ;try for a handle
erjmp .tsf1 ;no success - see what happened
movei t2,1 ;indicate existence
movem t2,filerr ;remember
jrst .tsf5 ;now test for offline
.tsf1: cain t1,gjfx18 ;no such filename ?
jrst .tsf2 ;yes, try deleted
cain t1,gjfx19 ;no such filetype?
jrst .tsf2 ;yes
cain t1,gjfx20 ;no such gen ?
jrst .tsf2 ;yes
cain t1,gjfx24 ;file not found ?
jrst .tsf2 ;yes
cain t1,gjfx32 ;no files match spec ?
jrst .tsf2 ;yes *wildcard only*
movx t2,-4 ;no, so crappy filespec
movem t2,filerr ;store it
retskp ;return
.tsf2: move t2,comptr ;get saved filename pointer
movx t1,gj%sht+gj%old+gj%del ;consider deleted files this time
gtjfn%
erjmp .tsf3 ;OK, try invisible
setom filerr ;indicate status
jrst .tsf5 ;now test for offline
.tsf3: move t2,comptr ;get saved filename pointer
movei t1,tsargs ;pointer to long form argument block
gtjfn% ;try again
erjmp .tsf4 ;file definitely not found (syntax OK)
movx t2,-2 ;set invisible status
movem t2,filerr ;mark
.tsf5: move t2,[1,,.fbctl] ;get .FBCTL out of the FDB
movei t3,t4 ;return info in t4
gtfdb% ;grab info
ercal error ;die horribly
move t2,filerr ;get current status word
txne t4,fb%off ;file is offline ?
movx t2,-3 ;yes, indicate
movem t2,filerr ;remeber status
movem t1,tsjfn ;remember jfn
camge t2,[-2] ;If file is here, find size stuff
jrst .tsst ;If not, just do strings
sizef% ;Get file size
ercal error
movem t3,q1 ;Save page count for a mo
hrroi t1,[Asciz/<FILSIZ>/] ;Symbol name
call entnum ;Set this up
ret ;Failed
hrroi t1,[Asciz/<FILPAG>/] ;Page size
move t2,q1 ;Get it
call entnum ;Set it up
ret ;failed
move t1,tsjfn ;Point to the file
move t2,[1,,.fbbyv] ;get .fbbyv out of the FDB
movei t3,t4 ;return info in t4
gtfdb% ;grab info
ercal error ;die horribly
ldb t2,[point <Wid(fb%bsz)>,t4,<Pos(Fb%bsz)>] ;Load the byte size
hrroi t1,[Asciz/<FILBYS>/] ;Symbol name
call entnum ;Place in symbol table
ret ;Failed
.tsst: movei q1,tsnams ;point to table of symbols/codes
.tslp: hlrz t3,(q1) ;get address of status code
jumpe t3,.tsend ;if zero, all over
move t3,(t3) ;get format control bits for this field
hrroi t1,scratch ;point to scratch string storage
move t2,tsjfn ;get jfn of file
jfns% ;write out this field
ercal error ;should not fail
hrro t1,(q1) ;point to name for this field
hrroi t2,scratch ;and the value we just got
call entstr ;enter into string table
ret ;failed
aoja q1,.tslp ;do next field
.tsend: move t1,tsjfn ;all done, get jfn
rljfn% ;lose JFN
ercal error
retskp ;return OK
.tsf4: setzm filerr ;file does not exist (we know the name's
retskp ;OK because it passed the first test)
purge tsjfn
subttl .CALL directive - invokes another IND file, passing symbols
;
; This directive is of the form .CALL filnam
; If the file type is not specified, the same default applies as with the
; IND program itself. This directive allows you to pass symbols between
; the command files (all symbols are still valid), thus having command
; "procedures" you can call at will.
;
.call: move t2,calnst ;get current nesting level of IND
cail t2,mxcal ;above maximum call depth ?
jrst [fatal <maximum file nesting depth exceeded>,,,nocmd]
move t1,comjfn ;no, get current file handle
movem t1,calstk(t2) ;stack it
aoj t2, ;bump nesting depth
movem t2,calnst ;save it
move t2,comptr ;get command pointer
movei t1,cgjargs ;address of GTJFN argument block
gtjfn% ;long form GTJFN
erjmp [fatal <can't .CALL file:>,,mcall]
movem t1,comjfn ;save JFN
movx t2,fld(7,of%bsz)+of%rd ;open for read
openf% ;well, try anyway
erjmp [fatal <can't open command file:>,,mcall] ;failed
retskp ;return OK
subttl .DELAY directive - pauses for n seconds
;
; format: .DELAY numexp (general numeric expression)
;
.delay: call numexp ;parse numeric expression
ret ;failed for some reason
skipge t2 ;positive number ?
jrst [warn <can't DELAY for a negative amount of time>]
move t1,t2 ;get in right ac
imuli t1,^d1000 ;convert secomds to milliseconds
disms% ;sleep....
retskp ;and continue
subttl .DISPLAY directive - types string on terminal without cr/lf
;
; Format: .DISPLAY strexp .
; This directive is primarily intended for files wanting to do cursor
; control via string variables.
;
.display: call strexp ;parse string expression
ret ;failed
move t1,t2 ;retrive pointer
psout% ;type string
ercal error ;huh ?
retskp ;can only really return success
subttl The .LOGFILE command - set up a logfile and .ENDLOG
;
; Format: .LOGFILE filename
; THis command specifies the terminal logfile to be used in .ENABLE
; LOGGING. An error in the filename is not fatal.
;
.logfi: skipe logjfn ;do we already have a logfile ?
jrst [warn <logfile already open.
>] ;yes, warn politely and do nowt
movem t1,t2 ;no, save pointer to name field
movx t1,gj%sht!gj%new!gj%fou ;and specify new file required
gtjfn% ;get handle
erjmp [fatal <can't get handle on logfile:>,,mcall,nocmd]
movx t2,fld(7,of%bsz)!of%wr ;don't store JFN yet, try to open first
openf%
erjmp [fatal <can't open logfile:>,,mcall,nocmd]
movem t1,logjfn ;now we have logfile, save JFN
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,$str ;check symbol is valid type
call askchk ;must be string or undefined
jrst [fatal <symbol is not string:>]
move t1,inpjfn ;ok, now read the data
hrroi t2,rdbuf ;into temporary input buffer
movei t3,mslen+2 ;maximum length allowed (+2 for cr/lf)
movei t4,lf ;terminate on linefeed
sin% ;read a line
ercal rdchk ;check for end-of-file
jumpe t3,[fatal <input record too long:>];complain if record was longer than max
subi t3,mslen ;subtract maximum string length from left
movns t3,t3 ;and construct length of input string
movem t3,strlen ;store in special system symbol
adjptr t2,[-2] ;now backspace over cr/lf
setz t1, ;get a null
idpb t1,t2 ;and dump it there
hrroi t1,asksym ;now point to symbol name
move t2,[point 7,rdbuf] ;and to the value of the string
call entstr ;enter value into table
ret ;failed
retskp ;return success
rdchk: movei t1,.fhslf ;check what error was
geter% ;read it
ercal error ;error reading error ?
hrrzs t2,t2 ;isolate error from handle
caie t2,iox4 ;end of file reached ?
jrst error ;no, crash
pop p,t1 ;yes, so throw away ERCAL address
hrroi t1,asksym ;point to symbol name
move t2,[point 7,[0]] ;point to a null string
call entstr ;and set up for a null read
ret ;return failure
setzm strlen ;zero length of last string
retskp ;return success
subttl The .REWIND command - reset input file to start
;
; Format: .REWIND
; This command rewinds the current input file. An error is given
; if no input file is currently open.
;
.rewind: skipn t1,inpjfn ;input file open ?
jrst [fatal <no input file open:>]
setz t2, ;yes, so set to byte 0
sfptr% ;do it
ercal error ;crash on error
retskp ;return success
Subttl Declaration statements
;
; The format of these commands is
; .TYPE name,name,name
; where TYPE is one of NUMERIC, STRING, LOGICAL,REAL or FILE,
; and name is an as-yet undefined variable. They set up a variable
; in the appropriate table with a null value: 0 or false or "" or NUL:
; This aids in programming complex command files.
;
.real: movei t2,$flt ;set type real
setz t3, ;initialize default value
jrst declst ;parse declaration list
.numeric: movei t2,$num ;set up symbol type
setzm t3 ;initialize default value
jrst declst ;parse declaration list
.logical: movei t2,$lgc ;set up symbol type
movx t3,false ;and default value
jrst declst ;parse namelist
.string: movei t2,$str ;set up symbol type
move t3,[point 7,[0]] ;and default null string
jrst declst ;parse namelist
.file: push p,t1 ;save command pointer
movx t1,gj%sht!gj%old ;old file
hrroi t2,[asciz/NUL:/] ;get a JFN on the null device
gtjfn% ;do it
ercal error ;total failure
movem t1,t3 ;save as value
pop p,t1 ;restore command pointer
movei t2,$fil ;set up symbol type
jrst declst ;and parse list
declst: stkvar <decval,dectab> ;remember default value and type here
movem t2,dectab ;remember type
movem t3,decval ;and value of new symbol
movem t1,comptr ;save command pointer
decls1: move t1,comptr ;point to next field of command
move t2,[point 7,asksym] ;place to store symbol name
call getwrd ;grab a word
movem t1,comptr ;store new command pointer
move t1,[point 7,asksym] ;now look at new name
call leng ;find length
skipg t3 ;more than 0 ?
jrst [fatal <blank symbol name in declaration list: >]
hrroi t1,asksym ;ok, point at the symbol
call luksym ;and make sure it isn't defined
jrst declok ;it isn't, so we're OK
fatal <symbol is already defined:> ;it is, issue an error
declok: move t1,[point 7,asksym] ;point to symbol name
move t2,decval ;include default value
move t3,dectab ;point to table to be used
call entval ;enter value and symbol in table
ret ;failed
move t1,comptr ;succeeded
call skpblk ;skip over blanks
ildb t2,t1 ;get next byte after name
caie t2,"," ;comma ?
retskp ;no, so namelist is parsed
call skpblk ;yes, so skip more blanks
movem t1,comptr ;store new command pointer
jrst decls1 ;loop through namelist
purge decval,dectab
subttl .CODE directive - get ASCII code of character
;
; The format of this directive is:
; .CODE symbol string-expression
; where symbol is of type numeric. The directive sets the symbol to the
; value of the first character in the string.
;
.code: move t2,[point 7,asksym] ;point to storage for name of symbol
call getwrd ;grab a symbol name
call skpblk ;skip intervening blanks
movem t1,comptr ;save command line pointer
call strexp ;now parse a string expression
ret ;bad return from STREXP
hrroi t1,asksym ;point to name of numeric symbol
ildb t2,t2 ;now get a byte from the start of result
call entnum ;enter numeric value
ret ;failed
retskp ;succeeded
subttl .DELIM directive - set substitution delimiter
;
; Format: .DELIM string-expression
; The substitution delimiter character is set to the first character
; of the designated string.
;
.delim: call strexp ;parse string expression
ret ;failed - return failure
ildb t1,t2 ;get first character of it
movem t1,subdlm ;save new delimiter character
retskp ;return success
subttl PURGE directive - undefine a symbol
;
; The .PURGE directive takes the form
; .PURGE symbol[,symbol,symbol...]
; It removes the specified symbols completely - their types are
; forgotten, their values lost, and space they used is reclaimed.
; It is illegal to PURGE an undefined symbol.
;
.purge: move t1,comptr ;get command line pointer
move t2,[point 7,asksym] ;place to store symbol name
call getwrd ;retrieve a symbol from list
movem t1,comptr ;save current pointer
move t1,[point 7,asksym] ;point to current symbol name
call leng ;compute length
jumple t3,[fatal <Blank symbol name for PURGE:>] ;zero, funny command
move t1,[point 7,asksym]
call luksym ;find out what table it's in
jrst [fatal <Symbol to be PURGE'd is not defined:>] ;it isn't...
move t1,[point 7,asksym] ;point to name to clobber
call delval ;and remove it from the table
move t1,comptr ;now get the command pointer back
call skpblk ;skip blanks
ildb t2,t1 ;get the next character
caie t2,"," ;comma ?
retskp ;no, so list is parsed
call skpblk ;yes, so skip more blanks
movem t1,comptr ;save input pointer
jrst .purge ;do the next one
subttl .PARSE - parse a string into substrings
;
; The .PARSE directive is of the form:
; .PARSE comanstr controlstr fld1 fld2 ....
;
; Its function is to split a string into substrings based on given
; delimiters. The string to be split is in comanstr. The delimiters
; are specified by the contents of controlstr, and the output for each
; field is in the string variables fld1 fld2 fld3 etc.
; Comanstr is scanned until the first character in controlstr is found.
; At this point, it's contents until then are copied into fld1. It is then
; scanned for the second character in controlstr, and the next field is
; copied to fld2. If controlstr runs out, its last character is used
; repeatedly. If the field variables run out, the rest of controlstr is
; copied into the final field variable.
;
.parse: stkvar <nflds,ctlptr,cmsptr,ndlms,lstdlm>
;number of field variables, control
;string pointer, command string ptr.
move t2,[point 7,asksym] ;area to store name of command variable
call getwrd ;retrieve name of string
call skpblk ;skip following blanks
movem t1,comptr ;save command string pointer
hrroi t1,asksym ;pointer to command string name
call lukstr ;look it up
jrst [fatal <String to be parsed does not exist: >] ;not there
movem t2,cmsptr ;found, save pointer to string
move t1,comptr ;back to command line
call strexp ;parse control string expression
ret ;failed
movem t2,ctlptr ;save pointer to contents
call skpblk ;skip intervening blanks
movem t1,comptr ;save command pointer
call cntfld ;count the number of field variables
movem t4,nflds ;save the count
jumpe t4,[fatal <No field variables for .PARSE >]
move t1,ctlptr ;point to control string
call leng ;and get its length
jumpe t3,[fatal <Control string is null >] ;nothing in it
movem t3,ndlms ;save number of delimiter characters
setzm strlen ;zero count of fields parsed
jrst .prsnx ;enter parsing loop
;
; Routine to count number of field variables, and intialize them all
; to null.
;
cntfld: setz q1, ;counter for fields
move q2,comptr ;get command line pointer
cntfl1: move t1,q2 ;get pointer again
move t2,[point 7,asksym] ;place to store variable name
call getwrd ;look for a word
call skpblk ;skip intervening blanks/tabs
movem t1,q2 ;save command line pointer
move t1,[point 7,asksym] ;point to name
call leng ;get length
jumpe t3,[move t4,q1 ;if zero, all done, get count
ret] ;and return to caller
hrroi t1,asksym ;else point to name
hrroi t2,[0] ;get null initial value
call entstr ;enter into string table
jrst [fatal <Cannot initialize fields for parse>]
aoja q1,cntfl1 ;increment count of fields and loop
;...
;... Start real parse
;
.prsnx: move t1,nflds ;get number of field variables left
cain t1,1 ;only one to go ?
jrst .prsall ;yes, so just parse the lot that's left
move t1,cmsptr ;point to current position in string
move t2,lstdlm ;get last delimiter character used
skiple ndlms ;used all delimiters ?
ildb t2,ctlptr ;no, so grab another one
movem t2,lstdlm ;save current delimiter character
sos ndlms ;and drop number available
movei t3,mslen ;maximum string length
call search ;search for delimiter in string
move t2,cmsptr ;point to where we were looking at
jumpl t3,.prsall ;if not found, then just copy remainder
jumpe t3,[setzm sublin ;if position zero, delims are adjacent
jrst .prsn1] ;so generate a null output string
movns t3,t3 ;else get negative length
hrroi t1,sublin ;temporary area to store field
sout% ;copy field out of command string
setz t3, ;get a null
idpb t3,t1 ;and drop on end of string
.prsn1: ibp t2 ;skip over trailing delimiter
movem t2,cmsptr ;and save current command string pointer
move t1,comptr ;get real command line pointer
move t2,[point 7,asksym] ;pointer to place for next variable name
call getwrd ;get name of next field variable
call skpblk ;skip blanks after name
movem t1,comptr ;save position of next name
hrroi t1,asksym ;point to name of variable
hrroi t2,sublin ;and value
call entstr ;enter next field in table
ret ;failed, drop back through
aos strlen ;increment number of fields parsed
sos nflds ;and decrement number of field vars.
jrst .prsnx ;and go and look for next one
.prsal: move t1,comptr ;point to place for next field name
move t2,[point 7,asksym] ;place to put it
call getwrd ;get name of last field
hrroi t1,asksym ;point to name of last field variable
move t2,cmsptr ;get pointer to current string
call entstr ;set it up
ret ;failed
aos strlen ;increment fields parsed
retskp ;return success
purge nflds,ctlptr,cmsptr,ndlms,lstdlm
subttl .TRIM and .PAD - blank handling
;
; The .TRIM directive removes trailing blanks from a string variable.
; Format: .TRIM strsym
; The .PAD directive pads a string to a specified length with blanks.
; Format: .PAD strsym numexp
; where numexp is an expression for the desired length of the string.
;
.pad: stkvar <padlen,padptr>
move t1,comptr ;point to command line
move t2,[point 7,asksym] ;area for string symbol name
call getwrd ;grab name of symbol
movem t1,comptr ;save command line pointer
hrroi t1,asksym ;now point to name
call lukstr ;and check that it is of type string
jrst [fatal <Unknown string symbol in .PAD: >] ;nope
movem t2,padptr ;save pointer to string
move t1,comptr ;now get command line pointer back
call skpblk ;skip intervening blanks/tabs
call numexp ;and parse the numeric expression
ret ;bad return
caile t2,mslen ;is it greater than maximum allowed?
jrst [fatal <Length to pad string to is too great: >]
movem t2,padlen ;save result of expression
hrroi t1,sublin ;so point to a temporary area
move t2,padptr ;get pointer to string back
setzb t3,t4
sout% ;and copy the current string
ercal error
hrroi t1,sublin ;now point to copy
call leng ;and get the length
caml t3,padlen ;is it greater than length to be padded
jrst [warn <String is already longer than .PAD length: >] ;yes
move t1,[point 7,sublin] ;get pointer to start of string
adjptr t1,t3 ;and make it point to the end
exch t3,padlen ;swap desired and current lengths
sub t3,padlen ;and discover how many extra blanks we need
movei t2," " ;get a space
.padlp: idpb t2,t1 ;drop it in
sojg t3,.padlp ;and continue as long as required
setz t2, ;now, get a null
idpb t2,t1 ;and drop on the end
hrroi t1,asksym ;now point to name of string
hrroi t2,sublin ;and new value
call entstr ;re-enter in tables
ret ;failed
retskp ;succeeded
subttl .TRIM
.trim: move t2,[point 7,asksym] ;point to area for symbol name
call getwrd ;grab name
hrroi t1,asksym ;now point to name
call lukstr ;does it exist ?
jrst [fatal <Unknown string variable to .TRIM: >] ;nope
hrroi t1,sublin ;yes, so copy it somewhere
setzb t3,t4
sout% ;in a leisurely manner
ercal error ;allowing for errors
hrroi t1,sublin ;now point to the symbol
call leng ;and grab its length
jumpe t3,[retskp] ;if empty, go home
move t1,[point 7,sublin] ;else point to start
movem t3,t4 ;save length as a counter
adjptr t1,t3 ;and point to end
.triml: ldb t2,t1 ;grab last character.
caie t2," " ;is it space ?
cain t2," " ;or tab ?
jrst [bkptr t1 ;yes, so backspace the pointer
sojg t4,.triml ;and get the next if some left
move t1,[point 7,sublin] ;get empty pointer
jrst .triem] ;else it's empty
.triem: setz t2, ;we have found end
idpb t2,t1 ;so bung a null over the last space/tab
hrroi t1,asksym ;point to string name
hrroi t2,sublin ;and new value
call entstr ;bung it in
ret ;failed somehow
retskp ;succeeded
subttl .RAISE - make a string upper case(and .LOWER)
;
; This directive is used to force all characters in a string to be
; upper case.
;
.raise: hrroi t2,asksym ;point to storage for symbol name
call getwrd ;retrieve name of symbol
hrroi t1,asksym ;point to name of string variable
call lukstr ;check it's existence
jrst [fatal <String for .RAISE does not exist: >]
move t3,[point 7,sublin] ;point to output
rais1: ildb t1,t2 ;get a character from string
jumpe t1,raisin ;if zero, then end
cail t1,"a" ;is it less than lower case
caile t1,"z" ;or more than ?
skipa ;yes, so don't interfere
txz t1,40 ;no, is lower case, make upper
idpb t1,t3 ;store this byte in output
jrst rais1 ;and go for more
raisin: setz t2, ;get a null
idpb t2,t3 ;and put on end of output string
hrroi t1,asksym ;name of variable
hrroi t2,sublin ;new, raised value
call entstr ;enter it
ret ;failed
retskp ;succeeded
;
; .LOWER - make everything lower case
;
.lower: hrroi t2,asksym ;point to storage for symbol name
call getwrd ;retrieve name of symbol
hrroi t1,asksym ;point to name of string variable
call lukstr ;check it's existence
jrst [fatal <String for .LOWER does not exist: >]
move t3,[point 7,sublin] ;point to output
lowe1: ildb t1,t2 ;get a character from string
jumpe t1,lowend ;if zero, then end
cail t1,"A" ;is it less than upper case
caile t1,"Z" ;or more than ?
skipa ;yes, so don't interfere
txo t1,40 ;no, is upper case, make lower
idpb t1,t3 ;store this byte in output
jrst lowe1 ;and go for more
lowend: setz t2, ;get a null
idpb t2,t3 ;and put on end of output string
hrroi t1,asksym ;name of variable
hrroi t2,sublin ;new, raised value
call entstr ;enter it
ret ;failed
retskp ;succeeded
subttl DDT - directive to merge DDT and breakpoint
.ddt: call getddt ;grab DDT
retskp ;back for next directive
subttl DAYTON and NTODAY - date conversion
;
; These directives convert from date strings to day numbers
; and back again
;
.dayton: stkvar <strptr>
call strexp ;parse the string expression
ret ;failed somehow
movem t2,strptr ;save string pointer
call skpblk ;skip intervening blanks
move t2,[point 7,asksym] ;where to store output
call getwrd ;get name of numeric variable
movei t1,$num ;allowed to be numeric
call askchk ;make sure it is
jrst [fatal <Second variable in DAYTON must be numeric: >]
move t1,strptr ;OK, point to string
ildb t2,t1 ;and start looking for the end
jumpn t2,.-1 ;keep looping till it's found
bkptr t1 ;space back over the null
hrroi t2,[asciz/ 3:00AM-GMT/] ;add on a decent time of day
setzb t3,t4
sout% ;and append it to the date
move t1,strptr ;point at the date again
movx t2,it%snm!it%err ;second number MUST be month
idtim% ;read it
erjmp dayter ;some invalid date format
hlrzs t2,t2 ;get just smithsonian day number
hrroi t1,asksym ;point to symbol name
call entnum ;enter number
ret ;failed
retskp ;succeeded
dayter: fatal <Invalid date format: >,stop,js
.NTODAY: call numexp ;parse numeric expression
ret ;failed
movem t2,t4 ;save value
call skpblk ;skip intervening blanks
hrroi t2,asksym ;point to area for name
call getwrd ;get name of string symbol
movei t1,$str ;must be string
call askchk ;check this
jrst [fatal <Destination must be string: >]
hrroi t1,wrkstr ;point to temp string area
hrlz t2,t4 ;get internal date
addi t2,7777 ;make it well into that day
movx t3,ot%ntm ;date only
odtim% ;write out date
erjmp [fatal <Invalid day number: >,js,stop]
hrroi t1,asksym ;point to string name
hrroi t2,wrkstr ;point to string
call entstr ;enter in tables
ret ;failed
retskp ;succeded
subttl .RADIX directive - set the current radix
;
; Format: .RADIX numeric-expression.
; The current radix for .ASKN, and all integer I/O is set.
; The expression is ALWAYS interpreted as a RAD-10 expression, so that:
; .SETN OLDRADIX 10
; .RADIX 7
; ....
; .RADIX 'OLDRADIX' or .RADIX OLDRADIX
; will work.
;
.radix: movei t4,^d10 ;read this in decimal
movem t4,radix ;store for NUMEXP
call numexp ;now read new radix in decimal
jrst haltt ;halt on error
jumple t2,[fatal <Radix must be greater than 0>,stop] ;check +ve
caile t2,^d36 ;within range ?
jrst [fatal <Radix must be less than 36>,stop]
movem t2,radix ;store new radix
retskp ;return
subttl POSITION directive - position the input file
;
; Format is .POSITION numeric expression
; The open input file is set to that byte number
;
.posit: call numexp ;try parsing a numeric expression
ret ;failed
skipn t1,inpjfn ;any input file ?
jrst [fatal <No input file open to position>,stop] ;no
jumpl t1,[fatal <Must position to positive byte number>,stop]
sfptr% ;set the position for next read
ercal error
retskp ;all done
subttl .TELL - store command for inferior fork
;
; This directive just stores the rest of its text which will be
; sent to the inferior fork next used in a .RUN directive.
;
.tell: hrroi t2,telcmd ;point to TELL buffer
setzb t3,t4 ;string is ASCIZ
sin% ;copy it
retskp ;completed
;==**== Next command goes here
subttl Text substitution routines
;
; text substitution routines - given a command line in COMLIN,
; we scan the line for 'SYMBOL' and substitute the appropriate string
; or numeric stuff. Return +1/+2
;
substi: stkvar <subst,subptr,newptr>
skipe purcmd ;are we being re-entered ?
retskp ;yes, ignore
move t1,[comlin,,comcop] ;make copy of command line
blt t1,comcop+maxcom-1 ;for use by .DATA directives
move t1,[point 7,comlin] ;point to command line
movem t1,comptr ;save as command pointer
skipe sbtflg ;are we allowed to substitute ?
retskp ;no, user has disabled function
skipe going ;are we doing a GOTO search ?
retskp ;yes, symbols may not be defined
move t1,[point 7,sublin] ;point to substitution line
movem t1,subptr ;save it
move t1,[point 7,comlin] ;point to command line
movem t1,comptr ;save as command pointer
;
; Enter here for each round of substitution
;
subst2: move t1,comptr ;point to where we are in command line
move t2,subdlm ;search for symbol starter
movei t3,^d80 ;80 chars away at most
call search ;try to find the character
skipge t3 ;was it found ?
jrst subend ;no, we can exit gracefully
move t2,[point 7,subsym] ;yes, get the symbol name
movem t1,subst ;substitution start pointer
call getwrd ;will return on non-alpha
ildb t2,t1 ;now get next char
came t2,subdlm ;should be matching delimiter
jrst sbqerr ;no, so we can't parse the line
movem t1,newptr ;now this points beyond end of symbol
move t1,subptr ;reget substitution pointer
move t2,comptr ;reget command pointer
movei t3,^d80 ;maximum of 80 chars
move t4,subdlm ;terminate on quote
sout% ;write normal part of string
ercal error
bkptr t1 ;back up over "'"
movem t1,subptr ;and save again
move t1,[point 7,subsym] ;start of symbol
call luksym ;lookup in general symbol table
jrst subsy ;string not found try system
jrst @[subnf ;table of routines to dispatch to
subnt ;on numeric symbol type codes
subsr ;go here for strings
subft ;here for files
subnf ;here for logicals (illegal)
subnf ;here for labels (impossible)
subrl](t3) ;here for reals
subsr: move t4,t2 ;get byte number where string starts
move t2,[point 7,strings] ;point at string table
adjptr t2,t4 ;and adjust to point to relevant byte
subst3: move t1,subptr ;OK, get pointer to output again
setzb t3,t4 ;terminate on null
sout% ;write substituted string
ercal error
movem t1,subptr ;save substitution pointer
move t1,newptr ;this points beyond end of symbol
movem t1,comptr ;which is where we want to search from
jrst subst2 ;and go and try for next bit of string
;
; try for numeric symbol and get value
;
subnt: hrroi t1,scratch ;point to scratch buffer
move t3,radix ;get current radix
nout%
ercal error
hrroi t2,scratch ;set up for substi as if a string was
jrst subst3 ;found and continue
;
; Substitute for real symbol
;
subrl: hrroi t1,scratch ;point to scratch buffer
setz t3, ;default floating format
flout% ;write out number
ercal error
hrroi t2,scratch ;set up for substi as if string was done
jrst subst3 ;join loop
;
; Output string for file symbol
;
subft: hrroi t1,scratch ;write name to scratch buffer
setz t3, ;no fancy options: dev:<dir>file.typ.gen
jfns% ;write out name
ercal error
hrroi t2,scratch ;set up for substitution
jrst subst3 ;place into command
;
; Try for system symbol, decode
;
subsy: move t1,[point 7,subsym]
call luksys ;lookup symbol in system tables
jrst subnf ;not found - complain
caie t3,$str ;string symbol ?
jrst nsubsy ;no, hopefully numeric
hrroi t1,scratch ;yes, write to scratch buffer
hrroi t2,sysval ;from where left
setzb t3,t4
sout% ;with a sout%
ercal error
hrroi t2,scratch ;fool the rest of the code this normal
jrst subst3 ;continue
nsubsy: caie t3,$num ;numeric, perhaps ?
jrst illsy ;no, illegal system symbol type
hrroi t1,scratch ;yes, write to scratch buffer
move t2,sysval ;get value of symbol
move t3,radix ;get current radix
nout%
ercal error
hrroi t2,scratch ;fool the rest of the code
jrst subst3 ;and continue
;
; print out remainder of command in buffer, and copy buffer back
; to comlin
;
subend: move t1,subptr ;where we are
move t2,comptr ;where we are coming from
setzb t3,t4 ;terminate on null
sout% ;write rest of string
ercal error
hrroi t1,comlin ;point back to comlin
hrroi t2,sublin ;and to where we have the substituted
movei t3,maxcom*5 ;maximum command length
setz t4, ;string in ASCIZ
sout%
ercal error
movei t2,maxcom*5-1 ;what we wanted to read
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
move t1,[comlin,,comcop] ;make copy of command line
blt t1,comcop+maxcom-1 ;for use by .DATA directives
move t1,[point 7,comlin] ;restore command pointer
retskp ;return success
purge newptr,subptr,subst ;throw away temporary names
;
; string symbol not found
;
subnf: fatal <undefined symbol for substitution: >
;
; mismatched quotes
;
sbqerr: fatal <mismatched quotes while substituting: >
;
; Crazy system symbol type
;
illsy: fatal <invalid system symbol type>
subttl Rescan EXEC command line for input file
;
; This routine rescans our command line to attempt to get a filename
; for it. It also picks up any parameters from the command line and
; sets them up as string symbols.
;
gcom: call tstbat ;check for BATCH attempt
movei t1,.rsini ;initialize for rescan
rscan%
ercal error
movei t1,.rscnt ;count of chars in buffer
rscan%
ercal error
movnm t1,t3 ;make a count for SIN%
movei t1,.priin ;read rescan stuff
hrroi t2,scratch ;write to scratch
setz t4, ;terminate on null
sin% ;read rescan stuff
adjptr t2,[3] ;bump pointer to safe area
call gfil ;set up command file name
jrst errmes ;failed, print error and ask terminal
;
; Now load up the passed parameters
;
move t1,t2 ;get byte pointer back
setzm nargs ;indicate no arguments yet
move t2,[asciz/P0/] ;initial parameter name
movem t2,pname ;store
gcom1: call skpblk ;skip over blanks
move t4,[point 7,wrkstr] ;point to output for param
ildb t2,t1 ;get next byte
jumpe t2,gcom2 ;if null, parameter list has ended
call tsbrk ;if not, check if it is a bracket
skipa ;was not a bracket, keep char
gcom3: ildb t2,t1 ;was a bracket, get first of string
camn t2,t3 ;is it the terminator for this string ?
jrst gcom4 ;yes, close off
jumpe t2,gcom4 ;no, but jump on null also
cain t2,cr ;and also carriage return
jrst gcom4
cain t2,lf ;linefeed ?
jrst gcom4 ;yes, ignore
idpb t2,t4 ;else deposit in output
jrst gcom3 ;and loop for next character
gcom4: aos nargs ;bump number of arguments
setz t2, ;get a null
idpb t2,t4 ;and append it to the parameter string
push p,t1 ;save input pointer
move t2,[point 7,wrkstr] ;point to string value
move t1,[point 7,pname] ;point to parameter name
ibp t1 ;bump pointer to digit
ildb t3,t1 ;get digit
aoj t3, ;increment it
dpb t3,t1 ;put it back again
hrroi t1,pname ;point to parameter name
call entstr ;enter in string table
jrst [fatal <table error on parameter startup>,stop,,nocmd]
pop p,t1 ;get input pointer back
jrst gcom1 ;and get next parameter
gcom2: movei t4,9 ;max params
camg t4,nargs ;done that many ?
jrst gcom6 ;yes, all done
sub t4,nargs ;no, get count of number to do
gcom5: move t2,[point 7,pname] ;point to current parameter name
ibp t2 ;now point to number
ildb t3,t2 ;get it
aoj t3, ;increment it
dpb t3,t2 ;put it back
hrroi t1,pname ;point to next name
hrroi t2,[0] ;and null string
push p,t4 ;save count
call entstr ;enter
jrst [fatal <table error on parameter startup>,stop,,nocmd]
pop p,t4 ;restore count
sojn t4,gcom5 ;loop for remaining params
gcom6: move t1,comjfn ;get command file JFN back
retskp ;return success
;
; This routine is called with a character in t2, which is to be tested
; to see if it is an opening bracket. If so, return the matching closing
; bracket in t3 and return +2, else return space in t3 and standard
; return (+1). Leave t1 undisturbed (and t4).
;
tsbrk: push p,t4
move t4,[-5,,brklst] ;number of brackets, table address
tsbrk1: hrrz t3,(t4) ;get next bracket
camn t2,t3 ;does it match ?
jrst tsbrk2 ;yes, return closing
aobjn t4,tsbrk1 ;no, try next
movei t3," " ;no match at all, return space
pop p,t4
ret
tsbrk2: hlrz t3,(t4) ;get closing bracket of pair
pop p,t4
retskp ;return success
subttl GFIL - get command file
;
; This routine is called with a string pointer in t2.
; This should point to the filename in the IND command line
; to be used.
;
gfil: move t1,[point 7,scratch] ;where to read from
call getwrd ;get a word out
call skpblk ;skip over intervening blanks
movem t1,t2 ;put pointer in right place
movei t1,cgjargs ;address of argument block
gtjfn% ;attempt to get handle on file
erjmp gfil1 ;try for SYS: instead
movem t1,comjfn ;save command file JFN
retskp ;return success to caller
;
; Here to try for command file from SYS:. Note that if this succeeds,
; it makes SYS: the default device for future .CALL directives.
;
gfil1: movei t1,cgjargs ;GTJFN argument block, default SYS:
hrroi t2,[asciz/SYS/] ;default device for this
movem t2,cgjargs+.gjdev ;store pointer to default device
move t2,[point 7,scratch] ;point at command line
adjptr t2,[4] ;and then to filename
gtjfn% ;try again
erjmp [ret] ;failed again, give bad return
movem t1,comjfn ;succeeded, store jfn
retskp ;give success return
subttl Sundry routines
;
; This routine resets the question/answer flags to initial settings
; (for system symbols <ESCAPE>, <DEFAULT> and .DISABLE/.ENABLE EXIT
;
iniflgs: setzm escflg ;indicate no escape
setzm defflg ;no defualt
ret
;
; exit if ctrl/z exit is allowed
;
exit: skipe extflg ;allowed to exit ?
ret ;no
jrst haltt ;yes - finish up
;
; set <escape> to true
;
escon: setom escflg
ret
prtcmd: hrroi t1,comlin
psout%
ret
;
; Check substring limits - byte pointer in t1 to string, or 0 if not
; yet exists. Q1,Q2 contain start, finish. Check that q1<=q2, and
; if t1 is not 0, that q2 is less than the length of the string.
; Also check q1>0
;
cksubs: skipg q1 ;q1 > 0 ?
ret ;no, complain
camle q1,q2 ;q1 <= q2 ?
ret ;no, complain
skipn t1 ;pointer supplied ?
retskp ;no, return success
push p,t1 ;save pointer
call leng ;get length of string
skipge t3 ;length OK ?
jrst cksub1 ;no... strange
camle q2,t3 ;top of range less than string length ?
jrst cksub1 ;no, complain
pop p,t1 ;restore pointer
retskp ;yes, OK
cksub1: pop p,t1
ret
;
; write to data file if necessary
; Must preserve AC 1. On entry: DATFLG/-1, datsav/0:
; Last command was .ENABLE DATA, do nowt
; -1,-1: In DATA mode, write to file
; 0,-1: Last command was .DISABLE DATA, do nowt
;
wdata: skipn datsav ;are we in DATA mode ?
ret ;no, just ENABLEd now
skipn datflg ;just done a .DISABLE DATA ?
ret ;yes, do nowt
push p,t1 ;save useful acs
skipn datjfn ;open data file ?
jrst wdata1 ;no, crash
hrroi t2,comcop ;yes, write to file
move t1,datjfn ;from command buffer
setzb t3,t4 ;terminate on null
sout% ;write
ercal error
pop p,t1
ret ;return OK
wdata1: fatal <can't .ENABLE DATA without data file open.>,stop,,nocmd
;
; Routine to clear typeahead buffer
;
clrinp: movei t1,.priin ;point to terminal
cfibf% ;clear input buffer
ercal error
ret
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT DESIGNATOR
RFPOS ;READ FILE POSITION
HRRZ T2,T2 ;KEEP JUST THE COLUMN POSITION
JUMPE T2,R ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
TMSG <
> ;NO, OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
;
; Routine to test if IND is being run in batch - if so, halt.
;
tstbat: seto t1, ;this job
hrroi t2,t4 ;retrieve one word of job info ti t4
movei t3,.jibat ;word is batch control word
getji% ;read it
ercal error
jumpe t4,r ;if zero, AOK
fatal <IND cannot yet be run in batch - see the manual for techniques to be used
with IND and batch jobs.>,stop,,nocmd
subttl Routines used by system symbol tables
;
; These routines find the values of various system permanent symbols,
; and leave their answers (of whatever forms) in SYSVAL.
;
date.: hrroi t1,sysval ;where to put output string
seto t2, ;current date/time
odtim% ;format bits already in t3
ret
sysnm.: move t1,[sixbit/SYSVER/] ;routine to find system name
sysgt% ;find out how many words in table
hrrz t1,t2 ;put table number in t1
hlre t3,t2 ;set up counter
hrrzs t2,t2 ;leave t2 with just a table number
setz t4,
sysnm1: getab% ;read next word from table
ercal error
movem t1,sysval(t4) ;store
aoj t4, ;bump t4
hrlz t1,t4 ;set up t1 again - getab trashes it
hrr t1,t2 ;and get the table number
aojn t3,sysnm1 ;go until finished
ret ;all done
;
; Here to check for end-of-file on input
;
ineof.: skipn t1,inpjfn ;any file open for input ?
jrst [setom sysval ;no, return false always
ret]
gtsts% ;yes, so read status of JFN
ercal error
setzm sysval ;assume true first
txnn t2,gs%eof ;is end-of-file set ?
setom sysval ;no, so indicate false
ret ;return to caller
subttl comment processing
;
; This routine is called to output comments in command files to the
; screen
; T1 contains a pointer to the command line
;
coment: bkptr t1 ;backspace over ";"
move t2,t1 ;put pointer in source ac
movei t1,.priou ;point to terminal
setzb t3,t4 ;terminate on null
sout% ;type it
ercal error ;crash
ret
;
; IND comments
;
.coment: retskp ;succeed always, do nowt
;
; Called whenever an error occurs executing an EXEC command with
; JSYS error in t3
;
excerr: tmsg <
?IND - error executing command: >
movei t1,.priou ;type on terminal
move t2,t3 ;get error number in right place
hrli t2,.fhslf ;must point to own fork
setz t3, ;no limit on message length
erstr% ;type out JSYS error
trn
trn ;ignore errors with errors
haltt: call .endlog ;close out logfile if necessary
nop
haltf% ;stop
tmsg <
?Cannot be continued>
jrst haltt
;
; called ar end of file
;
eof: skipe going ;still searching for a label ?
jrst laberr ;yes, error
skipn calnst ;end of .CALLED file ?
jrst eof1 ;no, proceed as normal
sos calnst ;drop nesting level
move t1,comjfn ;get old command file JFN
closf% ;close it
erjmp .+1 ;ignore errors
move t1,calnst ;get current value
move t2,calstk(t1) ;and get old command file JFN
movem t2,comjfn ;store as new one
jrst fillop ;loop for next command
eof1: tmsg <
@ <EOF>>
stopp: skipe datjfn ;data file open ?
jrst [move t1,datjfn ;yes, close it
closf%
erjmp .+1 ;ignore errors
jrst .+1]
jrst haltt
laberr: fatal <End of file while searching for label ">,noret,,nocmd
hrroi t1,target ;point to label name
psout% ;type it
tmsg <">
jrst haltt ;stop
;
; called from numeric parser
;
illvec: fatal <fatal internal error in numeric parser - impossible operator invoked.>,stop
subttl Read next command line
;
; This routine zeros out the command space and reads in the next line
; from the command file. It returns +1 on error, +2 on success
;
getlin: setzm comlin ;zero out first word of command
setzm purcmd ;indicate real command for SUBSTI
move t1,[comlin,,comlin+1] ;from,,to
blt t1,comlin+maxcom-1 ;zero out command line
move t1,comjfn ;handle on command file
rfptr% ;read where we are in file
ercal error
movem t2,cbyt ;remember for .goto, etc.
hrroi t2,comlin ;where to put command line
movei t3,maxcom*5 ;maximum chars in string
movei t4,lf ;terminate on linefeed
sin% ;read record
erjmp [ret] ;return +1 - failure
movei t2,maxcom*5 ;what we wanted to read
sub t2,t3 ;minus what we didn't
movem t2,linlen ;is what we did
move t1,[point 7,comlin] ;return start pointer
retskp ;return success
subttl Enable interrupt system for fork errors, PTY
;
; This sets up the interrupt system tables, and enables the channels
; we use for inferior fork traps and for PTY output. Although the
; channels are activated by this routine, we do not expect them to be
; used until the appropriate routine causes action on that channel.
; The channel for aborting IND is also set up.
;
inton: movx t1,.fhslf ;this humble fork
move t2,[levtab,,chntab] ;these humble tables
sir% ;humbly request interrupts
ercal error ;sod you jack
movx t1,.fhslf
eir% ;enable interrupt system also
ercal error
move t1,[aboch,,abochn] ;get code,,channel for aborting IND
ati% ;allocate terminal interrupts
ercal error ;should not fail
movx t1,.fhslf
movx t2,1b<abochn>!1b<ptychn>!1b<frkchn>
;set up PTY, abort and inferior interrupts
aic% ;activate channels
ercal error
ret ;return to caller
subttl Grab and release PTYs for logging
;
; This routine grabs a PTY and establishes interrupt channels for
; its output. Return +1/+2. The device designator is stored in PTYDES.
; The PTY jfn is stored in PTYJFN.
;
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
ptytst: 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
caile t2,^d15 ;reasonable number of chars ?
movei t2,^d15 ;no, chop it
jumpl t2,[fatal <Negative no of chars on interrupt>]
movn t3,t2 ;negate number of chars to read
push p,t2
hrroi t2,ptybuf ;and pty buffer
sin% ;read text from PTY
ercal error
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
jrst ptytst ;may be more characters there
ptyin2: rests ;restore temp acs
debrk% ;leave interrupt context
frkint: tmsg <
????Fork interrupt !!!!>
debrk%
;
; Entry to abort IND
;
aboint: tmsg <
[IND - aborting]
>
movei t1,.priin ;point to terminal
cfibf% ;clear the input buffer
ercal error ;should not fail
jrst .exit ;and close up
subttl Range parsing routines
;
; Ranges - called with a byte pointer in t1, looks for something of the
; form [a:b:c], c being optional, and all of a,b,c being arbitrary numeric
; expressions. They can indicate a range for an answer (a is min, b max, c
; default) or a substring slice (where c should be absent.) Here, we don't
; care. a,b,c are returned in q1,q2,q3 and the number of vals found is
; returned in t2. The byte pointer is undisturbed if t2=0, else it points
; beyond the closing bracket.
; FRANGES is an entry point to parse floating point ranges, which
; allows floating expressions instead of numeric ones.
; Integer expressions are read in the current radix (usually 10)
;
frange: seto t2, ;flag floating entry point
skipa ;continue
ranges: setz t2, ;flag integer ranges
stkvar <savptr,nvals,exptyp>
movem t1,savptr ;save the pointer
movem t2,exptyp ;and expression type
call skpblk ;jump over blanks
ildb t2,t1 ;get first non-blank
caie t2,"[" ;start of range ?
jrst [setz t2, ;no, return no args
move t1,savptr ;restore original pointer
retskp] ;return success
hrlzi t4,-3 ;initialize count
rangl: skipe exptyp ;integer expression ?
jrst [push p,t4 ;save ac
call fltexp ;no, floating one
jrst [pop p,t4 ;which failed
jrst range1]
jrst rangc] ;or succeeded
push p,t4 ;save ac
call numexp ;parse first expression
jrst [pop p,t4
jrst range1] ;bad expression
rangc: pop p,t4 ;restore
movem t2,vals(t4) ;save value of expression
ildb t2,t1 ;get next byte
caie t2,":" ;should be ":" to separate
jrst [cain t2,"]" ;or failing that, end of range specs
jrst [aoj t4,1 ;it is, fake extra pass in loop
jrst rang2] ;return OK
jrst rang3] ;it ain't, complain
aobjn t4,rangl ;ok, loop 3 times
rang2: move q1,vals ;get first value
move q2,vals+1 ;and second
move q3,vals+2 ;and third
hrrz t2,t4 ;get number of args parsed
retskp ;return success
rang3: fatal <bad range format: >
range1: fatal <bad numeric range> ;NUMEXP has complained - return failure
purge savptr,nvals,exptyp ;delete local symbols
subttl Numeric expression parsing - floating and integer
;
; FLTEXP/NUMEXP - parse a numeric expression of the form
; ID op ID op.... where ID is either a constant, variable or bracketed
; expression, and op is one of "+","-","*","/" . We do NOT parse this
; truly algebraically as no rules of operator precedence are applied.
; Evaluation is simply left to right, and brackets must be used to overide
; this. We use a separate parsing stack for this, to simplify exits if we
; bomb out halfway through. We use a simple expression stack of the form:
; TOP BOTTOM
; op val op val ... op val.
;
; which is unstacked on every ")". Initially we put 0 and "+" as the
; current op and val, in case we get (1+2) or that.
; Opcodes:
; +:1 -:2 *:3 /:4
; Floating numbers are rounded before use in integer expressions,
; integers are rounded.
; Integers are read in the current radix if an integer expression is
; being parsed.
; Input: t1/Byte pointer to expression
; Output: t2/Value of expression
;
fltexp: setom fltint ;mark floating parse
skipa ;and continue
numexp: setzm fltint ;indicate integer parsing
move p5,[iowd numsl,numstk] ;set up parsing stack
setzm cnval ;initialize current value of exp.
movei t2,addop ;and set current operator to +
movem t2,cnop
setzm numnst ;initialize nest level of brackets to 0
;
; Come here to get number, symbol or "("
;
gval: ildb t2,t1 ;get first byte of next bit
caig t2," " ;space ?
jrst numext ;not a printer - exit if OK
cain t2,"(" ;open bracketed expression ?
jrst opnbrk ;yes - push parse stack
call isdgt ;OK, is it a digit ?
jrst symevl ;no, evaluate as a symbol
bkptr t1 ;yes, backup over first digit
move t3,radix ;read in current radix if integer
skipe fltint ;floating expression ?
setz t3, ;yes, use default format input
movx t4,nin% ;assume integer input
skipe fltint ;is it ?
movx t4,flin% ;no, must use floating
xct t4 ;read the number
erjmp numex1 ;bad numeric format
movem t2,nval ;OK, we have val1
bkptr t1 ;backup over first non-digit
jrst eval ;now evaluate current expression
symevl: bkptr t1 ;we have a symbol - hopefully (may be ])
move t2,[point 7,scratch] ;bung symbol name here
call getwrd ;grab symbol name
movem t1,numptr ;save pointer value
move t1,[point 7,scratch] ;point to symbol
call leng ;and evaluate length
skipn t3 ;was it zero ?
jrst numex2 ;yes, unknown symbol for mo - better ?
hrroi t1,scratch ;point to symbol name
call luksym ;attempt to look it up
jrst [hrroi t1,scratch ;failed - point again
call luksys ;and try for system symbol
jrst numex2 ;unknown
jrst symev1] ;succeed
cain t3,$flt ;is it floating point ?
jrst [skipn fltint ;yes, are we parsing floating numbers ?
fixr t2,t2 ;no, so fix and round it
jrst symev2] ;continue
symev1: caie t3,$num ;is it integer type ?
jrst numex2 ;no, so complain
skipe fltint ;yes, are we parsing integer expressions
fltr t2,t2 ;no, so float the number
symev2: movem t2,nval ;and save value
move t1,numptr ;restore pointer
jrst eval ;evaluate so far
opnbrk: push p5,cnval ;remember current exp value
push p5,cnop ;and curent operator
aos numnst ;bump nesting level
setzm cnval ;initialize current value of exp.
movei t2,addop ;and set current operator to +
movem t2,cnop
jrst gval ;get next value
clsbrk: sosge numnst ;drop nesting level, test for OK
jrst badbrk ;bad parentheses
pop p5,cnop ;get old operator
pop p5,t2 ;and old value
exch t2,cnval ;make current value
movem t2,nval ;and make current val second op
jrst eval ;get evaluated
;
; here after obtaining a value or popping brackets - evaluate current
; expression and get next operator
;
eval: move t2,cnop ;get current operator
call @optab(t2) ;dispatch to arithmetic routine
ildb t2,t1 ;get next byte
caige t2," " ;printing character ?
jrst numext ;no, try exit
cain t2,")" ;close bracket ?
jrst clsbrk ;yes, pop parse stack
cain t2,"+" ;add ?
jrst [movei t2,addop ;yes, remeber operator
movem t2,cnop
jrst gval]
cain t2,"-" ;subtract ?
jrst [movei t2,subop
movem t2,cnop
jrst gval]
cain t2,"*" ;multiply ?
jrst [movei t2,mulop
movem t2,cnop
jrst gval]
cain t2,"/" ;divide ?
jrst [movei t2,divop
movem t2,cnop
jrst gval]
jrst numext ;none of these - try exiting expression
;
; here at possible end of expression - check state of parse stack for
; valid parentheses
;
numext: skipe numnst ;still nested ?
jrst badbrk ;yes, complain
move t2,cnval ;yes,get expression value
bkptr t1 ;nackup over the byte we don't want
retskp ;return success
numex1: fatal <bad numeric constant: >,,mcall
numex2: fatal <unknown numeric symbol in expression:>
badbrk: fatal <Unmatched parentheses: >
numex4: fatal <non-numeric system symbol in numeric expression:>
;
; arithmetic routines
;
nadd: move t3,nval ;get second operand
move t4,[addm t3,cnval] ;assume integer add
skipe fltint ;are we doing integer stuff ?
move t4,[fadrm t3,cnval] ;no, so get a floating add
xct t4 ;do whatever sort of add it is
ret ;continue parse
nsub: move t3,cnval ;get first operand
move t4,[sub t3,nval] ;assume integer subtract
skipe fltint ;are we doing integer stuff ?
move t4,[fsbr t3,nval] ;no, so get a floating subtract
xct t4 ;do whatever sort of subtract it is
movem t3,cnval ;store result
ret
nmul: move t3,nval ;get second operand
move t4,[imulm t3,cnval] ;assume integer multiply
skipe fltint ;are we doing integer stuff ?
move t4,[fmprm t3,cnval] ;no, so get a floating multiply
xct t4 ;do whatever sort of multiply it is
ret
ndiv: move t3,cnval ;get dividend
move t4,[idiv t3,nval] ;assume integer divide
skipe fltint ;are we doing integer stuff ?
move t4,[fdvr t3,nval] ;no, so get a floating divide
xct t4 ;do whatever sort of divide it is
movem t3,cnval ;store result
ret
subttl String expression parsing
;
; This subroutine accepts, like numexp, a pointer in t1 to the
; start of a string expression to be parsed. It calls NUMEXP, via
; RANGES, when doing substring evaluation. It accepts string constants
; of the form "asbdek", string variable names, like STREXP, and optional
; range values on the variables: STREXP[1:23] . The numbers indicate
; start and stop chop positions for a substring. The only operator is
; "+" for concatenation.
; Input: t1/byte pointer to expression (parse stops on bad char)
; Output: t2/ Pointer to result of expression
;
strexp: stkvar <stxptr,qstrt,ssymvl>
setzm wrkstr ;initialize parsed string to null
move t2,[point 7,wrkstr] ;point to it
movem t2,stxptr ;initialize expression pointer
strelp: ildb t3,t1 ;get a byte
caie t3,quote ; "?
jrst ssymev ;no, must be a symbol
movei t2,quote ;get closing quote
movei t3,mslen ;maximum string length
movem t1,qstrt ;save start of string
call search ;search for matching quote
skipge t3 ;found ?
jrst strex1 ;no - complain
movem t1,comptr ;save position in string of end
move t2,qstrt ;get start position
movns t3,t3 ;make absolute limit
jumpe t3,strel1 ;special for null string ""
movei t4,quote ;terminate on "
move t1,stxptr ;write to expression buffer
sout% ;write quoted string
ercal error
strel1: ibp t2 ;bump past " in input
movem t1,stxptr ;save pointer position
movem t2,comptr ;and position to read from command
jrst getop ;get possible operator
ssymev: bkptr t1
move t2,[point 7,scratch] ;where to put symbol name
call getwrd ;get symbol name
movem t1,comptr ;save end of symbol
hrroi t1,scratch ;point to symbol name
call lukstr ;and lookup value in tables
jrst [hrroi t1,scratch ;not there - try system symbol
call luksys ;is it there ?
jrst strex2 ;not there - complain
caie t3,$str ;string type symbol ?
jrst strex3 ;no - complain
hrroi t2,sysval ;construct pointer to value
jrst .+1] ;OK - is there
movem t2,ssymvl ;remember string value (ie pointer)
move t1,comptr ;point to next byteof expression
call ranges ;check for possible substring stuff
ret ;bad range format
movem t1,comptr ;may have moved
jumpe t2,ssymnr ;if no ranges, jump over
caie t2,2 ;if ranges, must be 2 and 2 only
jrst bdsubs ;bad substring format
move t1,ssymvl ;get symbol value pointer
call cksubs ;check substring stuff is in range
jrst bdsubs ;no - complain
move t2,ssymvl ;OK, point to string start
adjptr t2,q1 ;start of substring
bkptr t2 ;but ranges start at 1, so....
move t3,q2 ;get end of range
sub t3,q1 ;compute difference
aoj t3, ;add 1 'cos of 1/0 stuff
movns t3,t3 ;make negative for absolute limit
setz t4, ;terminate
move t1,stxptr ;next bit of expression
sout% ;write out
ercal error
idpb t4,t1 ;dump out extra null
bkptr t1 ;and backup over it
movem t1,stxptr ;save pointer to result
jrst getop ;get possible operand
;
; String symbol, no range specified
;
ssymnr: move t2,ssymvl
; move t2,[point 7,strings]
; adjptr t2,t3 ;adjust to point to correct POOL byte
move t1,stxptr ;where we will put expression
setzb t3,t4 ;termiate on null
sout% ;write variable value
ercal error
movem t1,stxptr ;remember where we got to
jrst getop ;get possible operand
;
; Check for operand
;
getop: move t1,comptr ;point to command
ildb t2,t1 ;get next char
caie t2,"+" ;is it "+" ?
jrst strext ;no, exit
movem t1,comptr ;yes, grab next bit
jrst strelp ;got to it !!!
;
; Check and exit
;
strext: bkptr t1 ;back up over non-+
move t2,[point 7,wrkstr] ;where the result is
retskp ;return success
;
; errors in string parsing
;
strex1: fatal <mismatched " in string constant:>
strex2: fatal <unknown string symbol in expression:>
strex3: fatal <system symbol in string expression is not of type string:
>
bdsubs: fatal <substring limits invalid: >
purge stxptr,qstrt,ssymvl
subttl Symbol table manipulation
;=======================================================
;
; These are the symbol table manipulation routines.
; They provide code for entering symbols into the tables,
; and performing table lookup. All are +1/+2 return type stuff,
; and the usual convention is to have a byte pointer in t1 to the
; symbol in ASCIZ, and have data returned in t2 (i.e. symbol value,
; or pointer to symbol value.)
;
;=========================================================
;
; entnum: enter a numeric symbol. t1- pointer to symbol name
; t2 - symbol value
;
entnum: movei t3,$num ;type code of numeric symbols
call entval ;get entval to do the work
ret
retskp
;
; entflt: enter a floating symbol. t1- pointer to symbol name
; t2 - symbol value
;
entflt: movei t3,$flt ;type code of real symbols
call entval ;get entval to do the work
ret
retskp
;
; luknum - lookup a numeric symbol - return +1 if not there, +2 if is
; input: t1/Pointer to symbol name
; output: t2/ Value of symbol if it exists
; t3/Position in table if exists
;
luknum: movem t1,t2
call luksym ;lookup the symbol
ret ;not there, return failure
caie t3,$num ;it exists - is it numeric ?
ret ;no, return failure
move t3,lukoff ;yes, return table address
retskp ;and success
;
; lukflt - lookup a real symbol - return +1 if not there, +2 if is
; input: t1/Pointer to symbol name
; output: t2/ Value of symbol if it exists
; t3/Position in table if exists
;
lukflt: movem t1,t2
call luksym ;lookup the symbol
ret ;not there, return failure
caie t3,$flt ;it exists - is it floating ?
ret ;no, return failure
move t3,lukoff ;yes, return table address
retskp ;and success
;
; Entlgc: Enter logical symbol into table.
; Input: t1/Pointer to symbol name in ASCIZ
; t2/0 - true, -1 - false
; Calls entval - general entry routine
;
entlgc: movei t3,$lgc ;address of logical table
call entval ;entval does the work
ret ;return failure
retskp ;return success
;
; LUKLGC: Lookup logical symbol, return value
; Input: t1/ Pointer to symbol name
;
; Output: t2/ Symbol value if +2 return, else
; +1 return, not found
;
; t3/ Address in TBLUK table of entry
;
luklgc: movem t1,t2
call luksym ;lookup the symbol
ret ;not there, return failure
caie t3,$lgc ;it exists - is it logical ?
ret ;no, return failure
move t3,lukoff ;yes, return table address
retskp ;and success
;
; entstr - enter s string symbol into appropriate table
;
; Input: t1/ Pointer to symbol name
; t2/ Pointer to symbol value
; We have to do a bit of work with this one before we call entval
;
entstr: stkvar <ptr,strptr,strpos>
setzm sqzd ;indicate not squeezed yet
movem t1,ptr ;save name pointer
movem t2,strptr ;save value pointer also
movei t3,strspc ;max number of string chars
camge t3,nxtbyt ;already written that many ?
jrst strful ;yes, BOMB
entst1: move t1,strptr ;pointer to string
call leng ;get string length
skipge t3 ;string OK ?
jrst [fatal <string too long: >]
move t1,nxtbyt ;size of string buffers in use
add t1,t3 ;what we want to add to it
cail t1,strspc ;will it overflow ?
jrst [call squeeze ;call garbage collector
jrst entst1]
move t1,nxtbyt ;get next byte in use
movem t1,strpos ;where string will be written
move t1,[point 7,strings] ;point to strings
adjptr t1,nxtbyt ;and now point to free store
addm t3,nxtbyt ;OK, bump amount of storage in use
aos nxtbyt ;add on null byte
move t2,strptr ;get string itself
setzb t3,t4 ;write until null byte
sout% ;write string
ercal error ;crash
move t1,ptr ;ask ENTVAL to put it in
move t2,strpos
movei t3,$str
call entval
ret ;return failure
retskp ;return success
purge strpos,ptr,strptr
;
; Lookup string symbol
; Input: t1/ Pointer to symbol name
;
; Output: t2/ Pointer to symbol value if +2 return
; t3/ Position in symbol table if +2 return
;
; +1 return: Symbol not found
;
lukstr: movem t1,t2 ;put pointer in right place
call luksym ;lookup the symbol
ret ;not there, return failure
caie t3,$str ;it exists - is it string ?
ret ;no, return failure
move t3,lukoff ;yes, return table address
move t4,t2 ;get byte number where string starts
move t2,[point 7,strings] ;point at string table
adjptr t2,t4 ;and adjust to point to relevant byte
retskp ;return success
;
; entlab - enter a label into table
; t1 - byte pointer to label name
; t2 - byte number in file to associate with it
;
entlab: stkvar <labnam,labbyt>
movem t1,labnam
movem t2,labbyt
call luklab ;look it up
skipa ;not there - put it in
retskp ;there - ignore it
move t1,labnam
move t2,labbyt
movei t3,$lab ;include type code
call entval ;enter value
ret ;fail
retskp ;succeed
purge labnam,labbyt
;
; luklab - lookup label i symbol table +1/+2 return
; input: t1/Byte pointer to label name
; Output: t2/ Value of label
; t3/ Position in symbol table
;
luklab: movem t1,t2
call luksym ;lookup the symbol
ret ;not there, return failure
caie t3,$lab ;it exists - is it label ?
ret ;no, return failure
move t3,lukoff ;yes, return table address
retskp ;and success
;
; LUKFIL - lookup file symbol in table, return JFN
; In: t1/ Pointer to symbol name
; Out: t2/ JFN
; t3/ Table address
;
lukfil: movem t1,t2
call luksym ;lookup the symbol
ret ;not there, return failure
caie t3,$fil ;it exists - is it file ?
ret ;no, return failure
move t3,lukoff ;yes, return table address
retskp ;and success
;
; ENTFIL - enter file symbol.
; t1/ Pointer to symbol name
; t2/ JFN
;
entfil: movei t3,$fil ;address of table
call entval ;enter it
ret ;fail
retskp ;succeed
;
; LUKSYS - lookup a system symbol
; Input: t1/ Pointer to symbol name in ASCIZ
; Returns: +1: Symbol does not exist
; +2: Symbol exists, with
; Output: t2/ Value of symbol (Text string or immediate)
; t3/Symbol type code
;
luksys: movem t1,t2 ;put name in right place
movei t1,syssym ;address of table
tbluk% ;try a lookup
ercal error ;tables trashed
txnn t2,tl%exm ;exact match ?
ret ;no, return failure
hrrz t3,(t1) ;yes, get table entry
push p,t3 ;save entry for use by caller
hrrz t3,(t3) ;make routine address
call (t3) ;call the routine
pop p,t3 ;get back old copy of entry
hlrz t3,(t3) ;and leave the symbol type behind
txz t3,$wrt ;clear out read/write bit
move t2,sysval ;get value of symbol
cain t3,$str ;string type symbol returned ?
hrroi t2,sysval ;yes, must return pointer to symbol
retskp ;return success
;
; Entval : Enter a general symbol into table, placing value in
; there also.
; Input: t1/ Pointer to synbol name in ASCIZ
; t2/ Value of symbol or stuff for left half of TBLUK entry.
; t3/ Table type code
; +1/+2 return
;
entval: stkvar <namptr,value,tabnam>
movem t1,namptr
movem t2,value ;save arguments
movem t3,tabnam ;save table name
move t1,t3 ;tabel address
move t2,namptr ;name of symbol
call $askchk ;check if symbol is in other table
jrst [fatal <Symbol to be assigned is already of another type: >]
move t1,namptr ;get pointer to name
call leng ;get length of name
jumple t3,[fatal <No name for symbol: >] ;zero, something wrong
movei t1,symbols ;point to symbol tables
move t2,namptr ;and pointer to name
tbluk% ;symbol already there ?
ercal error ;tables crapped up
txnn t2,tl%exm ;well ?
jrst entvl1 ;no, put it in properly
move t2,value ;yes, just put new value in
hrrz t1,(t1) ;yes, so get address of value entry
move t3,tabnam ;get the type code
came t3,symvals(t1) ;and check that it matches current type
jrst [fatal <Internal error - symbol to be updated is of wrong type>]
movem t2,symvals+1(t1) ;and store the new value in place
retskp ;return success
entvl1: move t3,tabnam ;get symbol type code
move t2,symuse(t3) ;get number of entries of that type used
caml t2,symmax(t3) ;less than maximum allowed ?
jrst [fatal <Attempt to define too many variables of one type: >] ;no
aos symuse(t3) ;yes, so increment symbols in use
sosge free ;decrement number of entries in strings
jrst strful ;string space full - crash
call entplc ;find where to write next entry
ret ;failed - internal error
call valslt ;find where to put next value
ret ;failed, internal error
move t1,nxtval ;offset for value slot to use
move t2,tabnam ;get type code
movem t2,symvals(t1) ;store that
move t2,value ;get value of new symbol
movem t2,symvals+1(t1) ;store that too
movei t3,symtab ;address of string storage
add t3,nxtsym ;offset to next entry
hrro t1,t3 ;make byte pointer
move t2,namptr ;point to name string
movei t3,9 ;maximum of 9 bytes
setz t4, ;terminate on null
sout%
ercal error
setz t2, ;grab a null byte
idpb t2,t1 ;and bung that at the end
movei t1,symbols ;now bung the TBLUK entry in
movei t2,symtab ;address of string table
add t2,nxtsym ;where we put the entry
hrlzs t2,t2 ;put in left half
hrr t2,nxtval ;and put value pointer in left half
tbadd% ;enter into table
erjmp tberr ;table error - report
movei t1,2 ;its now safe to update the table entry
addm t1,nxtsym ;to reflect the new string
addm t1,nxtval ;point to next value slot
retskp ;return success
purge namptr,tabnam,value
;
; tabel error routines
;
strful: fatal <No space for variable name>,,,nocmd
tberr: fatal <symbol table full>,,mcall,nocmd
;
; LUKSYM - lookup a general symbol.
; Input t1/ Pointer to ASCIZ symbol name
; Returns: +1: Symbol not defined
; +2: Symbol defined, t2/ value of symbol
; t3/ Type code for symbol
;
luksym: movem t1,t2 ;save pointer to name
movei t1,symbols ;point to symbol table
tbluk% ;try for a lookup
erjmp [fatal <Internal error: Corrupt symbol table>,stop,js]
txnn t2,tl%exm ;exact match ?
ret ;no, return failure
hrrz t2,(t1) ;yes, retrieve value pointer
movem t1,lukoff ;store table offset for those interested
move t3,SYMVAL(t2) ;get symbol type code
move t2,symvals+1(t2) ;get symbol value
retskp ;return success
subttl ENTPLC - find next place to write a symbol name
;
; This routine is called to return the address for writing the next symbol
; Usually we just add the contents of NXTSYM to address SYMTAB and use it.
; If much purging has been done, however, the table may be full at the end
; but should contain empty slots earlier on. We try to find these, and
; return +2 with NXTSYM updated.
;
entplc: movei t1,symtab ;address of symbol name space
add t1,nxtsym ;address to write next symbol
cail t1,symtab+2*symtot ;off end of space ?
jrst entpls ;yes, so scan for empty slot
skipn (t1) ;no, is slot free ?
retskp ;yes, so return OK
entpls: movei t3,symtot ;ok, set up for maximum scans
aos exsrch ;increment exhaustive search count
entpll: addi t1,2 ;increment pointer to next name slot
cail t1,symtab+2*symtot ;off end of table ?
movei t1,symtab ;yes, wrap round to start
skipn (t1) ;is this slot free ?
jrst entple ;yes, return address
sojn t3,entpll ;no, so loop to next entry
fatal <Internal error - no zero name slot when all should be free>,stop,,nocmd
entple: subi t1,symtab ;ok, construct the right NXTSYM value
movem t1,nxtsym ;store it
retskp ;and return success
subttl VALSLT - find next value slot
;
; This routine is called when creating a new variable to discover
; the next slot to use in the values and types table. Usually we just
; use the next available, but in some circumstances there may be scattered
; slots throughout the list. We then have to do an exhaustive search.
;
valslt: movei t1,symval ;address of value tables
add t1,nxtval ;point to apparent free slot
cail t1,symval+2*symtot ;off end of values space ?
jrst valsrc ;yes, so must search for free slot
skipn (t1) ;is it free (IE zero type code)?
retskp ;yes, so all is well
valsrc: movei t2,<symtot-1>*2 ;number of values stored
valsr1: skipn symval(t2) ;is this entry free ?
jrst valsfn ;yes, so remember it
soj t2, ;no, so skip back...
sojn t2,valsr1 ;and examine the previous entry
fatal <Internal error: no slot for symbol value when one should be free>
valsfn: movem t2,nxtval ;store offset for new value code
retskp ;return success
subttl DELVAL - delete a symbol from a table
;
; This routine is called to delete a symbol completely from the specified
; table. It also removes the name from the name space, leaving compression
; out. Values (such as string values) are not removed from the pool, an
; operation which is left to he garbage collector.
; Accepts: t1/ Pointer to symbol name
;
delval: stkvar <namptr,tabent>
movem t1,namptr ;save name of argument
exch t1,t2 ;swap address and pointer
movei t1,symbols ;point to symbol table
tbluk% ;is entry in table ?
ercal error ;tables crapped up
txnn t2,tl%exm ;well, is it there ?
jrst [fatal <Internal error PURGE of non-existent symbol>,stop] ;no
move t2,(t1) ;get the current contents of the entry
movem t2,tabent ;and save them
move t2,t1 ;get address of entry to delete
movei t1,symbols ;now prepare to delete the entry
tbdel% ;from the lookup table
ercal error ;should not fail
hlrz t1,tabent ;get address where symbol name was
setzm (t1) ;zero it for later use
aos free ;one more free entry in symbol table names
hrrz t1,tabent ;get address of value/type slot for symbol
move t2,symval(t1) ;get type code
setzm symval(t1) ;zero type code slot
setzm symval+1(t1) ;and value slot for later use
sos symuse(t2) ;decrement usage for this symbol type
ret ;back to friendly caller
purge namptr,tabent
IFN <logg>,<
SUBTTL Record username
;
; This routine makes a record of all users of IND
;
record: stkvar recjfn
movx t1,gj%sht!gj%old
hrroi t2,lfnam ;point to name of logging file
GTJFN%
erjmp recerr
movem t1,recjfn
movx t2,fld(7,of%bsz)!of%app
openf%
erjmp recerr
hrroi t2,[asciz/
User /]
setzb t3,t4
sout%
erjmp recerr
gjinf%
movem t1,t2
move t1,recjfn
dirst%
erjmp recerr
hrroi t2,[asciz / at /]
setzb t3,t4
sout%
erjmp recerr
seto t2,
setz t3,
odtim%
erjmp recerr
hrroi t2,[asciz / file /]
setzb t3,t4
sout%
erjmp recerr
move t2,comjfn ;get command file jfn
movx t3,1b2!1b5!1b8!1b11!1b14!js%paf ;write all fields
setz t4,
jfns%
erjmp recerr
closf%
erjmp recerr
ret
recerr: tmsg <
%User logfile write failed, please inform KEVIN:>
call errmes
ret>
subttl COMND - related routines
;
; These are routines to initialize the COMND state blocks and
; to parse things sucj as noise phrases and confirms.
;
;
; Once-only routine to initialize comnd state blocks
;
cmdset: HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
movei t1,gjfblk ;point to GTJFN block
movem t1,cmdblk+.cmgjb ;store pointer
MOVEI T1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM T1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI T1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM T1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI T1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM T1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
ret
; INVALID END-OF-COMMAND
CFMERR: CALL TSTCOL ;TEST COLUMN POSITION
TMSG <?Not confirmed> ;OUTPUT ERROR MESSAGE
RET ;RETURN TO WHENCE WE CAME ...
SUBTTL COMND PARSING SUBROUTINES
; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL: CALL ENDCOM
; RETURNS: +1 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
; +2 SUCCESS, COMMAND CONFIRMED
ENDCOM: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND ;PARSE CONFIRMATION
ercal error ;error, go check for eof on take file
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
JRST [ CALLRET CFMERR ] ;NO, ISSUE ERROR MESSAGE AND RETURN
RETSKP ;SUCCESS, RETURN
; ROUTINE TO PARSE NOISE PHRASE
;
; CALL: T2/ POINTER TO NOISE PHRASE
; CALL SKPNOI
; RETURNS: +1 ERROR, INVALID NOISE PHRASE
; +2 SUCCESS, NOISE PHRASE PARSED OK
SKPNOI: MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
SETZM NOIFDB ;CLEAR FIRST WORD OF BLOCK
BLT T1,NOIFDB+FDBSIZ-1 ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVX T1,.CMNOI ;GET FUNCTION TO PERFORM
STOR T1,CM%FNC,NOIFDB ;STORE FUNCTION CODE IN FDB
MOVEM T2,NOIFDB+.CMDAT ;STORE POINTER TO NOISE PHRASE IN FDB
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,NOIFDB ;GET ADDRESS OF FUNCTION BLOCK
COMND ;PARSE NOISE WORD
ercal error ;error, go check for eof on take file
TXNN T1,CM%NOP ;NOISE PHRASE PARSED OK ?
RETSKP ;YES, RETURN SUCCESS
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
HRROI T1,[ASCIZ/Invalid guide phrase/]
ret
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PROMPT STRING
; CALL CMDINI
;RETURNS: +1 ALWAYS, WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
; CALL TO CMDINI.
CMDINI: MOVEM T1,CMDBLK+.CMRTY ;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
POP P,SAVRET ;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
MOVEM P,SAVREP ;SAVE STACK POINTER TO BE RESET ON REPARSE
MOVEI T1,REPARS ;GET ADDRESS OF REPARSE ROUTINE
txo t1,cm%wkf!cm%xif ;wake on every field, no indirect files
MOVEM T1,CMDBLK+.CMFLG ;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
COMND ;INITIALIZE COMMAND SCANNER JSYS
ercal error ;ERROR, GO SEE IF END OF "TAKE FILE"
JRST @SAVRET ;RETURN
; HERE TO PROCESS A REPARSE
REPARS: MOVE P,SAVREP ;RESET STACK POINTER
JRST @SAVRET ;RETURN TO CALLER OF CMDINI
; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL: CALL CLRGJF
; RETURNS: +1 ALWAYS
CLRGJF: MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD OF BLOCK
BLT T1,GJFBLK+GJFSIZ-1 ;CLEAR GTJFN BLOCK
RET ;RETURN TO WHENCE WE CAME ...
subttl EXEC handler - lifted from CRCMD en mass.
;
; This subroutine has been taken direct from the CRC subroutine library.
; We need it here because we need to access some of its internal variables
; such as the fork handle of its inferior EXEC.
;
;
; The program is called from fortan as below :
;
; call crcmd('print file.dat/forms:la1',flags,jserr)
;
; from macro , pass a byte pointer in t1
; a flag word in t2, jsys error returned in t3
;
; The meaning of the flag word is as follows:
; 0 Do nothing unusual
; b35 (1) Use MEXEC instead of EXEC
; b34 (2) Allow echoing of commands
; b33 (OBSOLETE) (4)
; Do not release EXEC fork- freeze it, and check for existing
; fork on reentry
; b32 (8) Do not pass command to EXEC - merely run it and WFORK.
; b31 (16) Allow COMAND.CMD to be executed
; The strategy is to get the EXEC in a lower fork (natch), clear
; the input buffer, wait till output finishes, and lock the keyboard
; (send ^s). We then rename COMAND.CMD to COMAND.crcmd (to stop it
; being executed) and do STIs to get the stuff in, followed by a POP.
; We do a DIBE to wait for the time to put the POP in, and then WFORK.
; It may be necessary to do a KFORK after we give the command, to prevent
; errors in the command from clearing our typeahead.
;
define db(code),<ifdef $dbg,<code>>
; $dbg==0
c$cmd==20 ;COMAND.CMD no rename
cr==15
lf==12
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,jfnwid>
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
movei t2,.morlw ;now read page width
mtopr% ;with MTOPR% because JFN word is small
erjmp crerr
movem t3,jfnwid ;and store the width
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>>
seto t1, ;current job
hrroi t2,t4 ;one word in t4
movei t3,.jilno ;which is logged in directory num
getji% ;get it
erjmp crerr ;failed
hrroi t1,sysval ;point to temp string
move t2,t4 ;get directory number
dirst% ;write out directory number
ercal error
hrroi t2,[asciz/comand.cmd/] ;file name
setz t3,
sout% ;append file name
ercal error
movx t1,gj%sht+gj%old ;old file
hrroi t2,sysval
GTJFN% ;is there a COMAND.CMD available ?
erjmp nocom ;no, forget it
movem t1,cmdjfn ;yes, save the JFN
movx t1,fld(.fbctl,cf%dsp) ;word in fdb to change
hrr t1,cmdjfn ;and jfn of file to alter
movx t2,fb%inv ;make file invisible
movx t3,fb%inv ;set this bit
chfdb% ;do it
erjmp crerr ;failed
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
movei t2,.moslw ;now set line width explicitly
move t3,cmdwid ;as JFN word is too small
mtopr% ;so we use MTOPR%
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 t2,.morlw ;now read line width explicitly
mtopr% ;so we use MTOPR%
erjmp crerr
movem t3,cmdwid ;as JFN word is too small
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
movei t2,.moslw ;now set line width explicitly
move t3,jfnwid ;as JFN word is too small
mtopr% ;so we use MTOPR%
erjmp crerr
IFN xonoff,<movei t1,xon ;reallow terminal input
pbout%
>
db <tmsg <
Termination occurred>>
getnm% ;read program name that was being used
movem t1,infnam ;and save for next command
move t1,sysnm ;get our old name
setnm% ;set it
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,fld(.fbctl,cf%dsp) ;word in fdb to change
hrr t1,cmdjfn ;and jfn of file to alter
movx t2,fb%inv ;make file invisible
setz t3, ;clear the invisible bit
chfdb% ;do it
erjmp crerr ;failed
move t1,cmdjfn ;point to COMAND.CMD
rljfn% ;release the now useless jfn
trn ;ignore errors
ret ;and return success
;
; This subroutine maps the EXEC into an appropriate fork
; It also sends the PRARG block to the fork
; called with t2=flags
; If frozen fork desired, and already have one, don't map
; Returns +1 error, +2 success with t1=JFN of EXEC, t2=fork handle
;
mapexc:getnm% ;get our program name
movem t1,sysnm ;save it
move t1,infnam ;get name inferior was using
setnm% ;and set that for its own use
db <skipe efork
jrst [tmsg <
%Already have a fork - not mapping a new one>
jrst .+1]>
skipe 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,qtexc ;no get a quiet exec
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
hlrz q1,symbols ;number of symbols of all types defined
movns q1,q1 ;negate
hrlz q1,q1 ;put in left half
hrri q1,symbols+1 ;make aobjn pointer with first table ent
hrroi t1,strcpy ;point to string copies
squez1: move t2,[point 7,strings] ;point to strings
hrrz t3,(q1) ;get value pointer for this symbol
move t4,symval(t3) ;get symbol type code
caie t4,$str ;is it string ?
jrst sqnstr ;no, so leave it alone
move t3,symval+1(t3) ;yes, so get its start byte
adjptr t2,t3 ;construct pointer
movem t2,sval ;save pointer to source
setzb t3,t4 ;write until null
sout% ;move to copy space
ercal error
ibp t1 ;bump output past null
movem t1,scptr ;save output pointer
move t2,nxtbyt ;this is where we wrote the string
hrrz t3,(q1) ;get address for value slot
movem t2,symval+1(t3) ;and store new value for string address
move t1,sval ;get pointer to string we just wrote
call leng ;discover length
aoj t3, ;add on null byte
addm t3,nxtbyt ;increment space used
move t1,scptr ;reget output pointer
sqnstr: aobjn q1,squez1 ;loop through table
move t1,[strcpy,,strings] ;from,,to
blt t1,strings+<strspc/5>-1 ;transfer strings back to where they
move q1,savq1 ;came from, restore acs
ret
subttl String handling routines
;===========================================================
;
; These are the general string-handling routines. They generally
; accept a byte pointer to a source string in t1.
;
; LENG - computes length of ASCIZ string
; byte pointer in t1
; length returned in t3 - -1 if more than 256 chars
;
leng: setz t2, ;tell SEARCH to look for null
movei t3,^d256 ;max length acceptable
call search ;get search to do the work
ret
;
; SEARCH - byte pointer in t1
; character to search for in t2
; Maximum length in t3 (terminated on null also)
;
; Returns: Updated pointer in t1
; Position in t3, or -1 if not found.
;
search: movns t3,t3 ;negate count
hrlz t3,t3 ;place in left half,use right half for count
makhdw t1 ;ensure hardware format byte pointer
searc1: ildb t4,t1 ;get byte
camn t4,t2 ;character desired ?
jrst searc4 ;yes, exit
jumpe t4,searc3 ;null, exit with not found
aobjn t3,searc1 ;increment count, and loop if not all done
;
; If here, then we have found a null or dropped offf end without target
;
searc3: seto t3, ;indicate not found
ret ;return
searc4: hrrzs t3,t3 ;throw away index, leave character position
ret ;return
;
; getwrd - removes next word from string.
; accepts pointer in t1 to input string,
; pointer in t2 to area to output ASCIZ word.
;
getwrd: makhdw t2 ;force hardware byte pointers
ildb t3,t1 ;get next byte
cain t3,"$" ;check for allowed special chars: $,<,>,=
jrst getwr2 ;yes, is $
cain t3,"<"
jrst getwr2 ;yes, is "<"
cain t3,">" ;yes, is "<"
jrst getwr2
cain t3,"="
jrst getwr2 ;ok,is "="
caig t3,"/" ;at least numeric ?
jrst getwr1 ;no, end of word
txo t3,40 ;ok, safe to force lower case
caile t3,"z" ;not a funny char ?
jrst getwr1 ;funny char
caig t3,"9" ;numeric ?
jrst getwr2 ;definitely - Ok
caig t3,"@" ;in between number and letter ?
jrst getwr1 ;yes - end of word
getwr2: idpb t3,t2 ;no, dump character
jrst getwrd ;and get next
getwr1: setz t3, ;get a null byte
idpb t3,t2 ;dump that too
bkptr t1 ;backup pointer to valid byte
ret ;return
;
; isdgt - called with character in t2, returns +2 if digit, else
; +1
;
isdgt: cain t2,"-" ;minus sign ?
retskp ;yes, OK
cain t2,"." ;decimal point ?
retskp ;yes, that's OK too
caige t2,"0" ;at least 0 ?
ret ;nope
caile t2,"9" ;at most 9 ?
ret ;nope
retskp ;yes
;
; skpblk - skips over blanks and tabs
; byte pointer to string in t1
;
skpblk: ildb t2,t1 ;get next byte
jumpe t2,skpbl1 ;return on null
cain t2," " ;space ?
jrst skpblk ;yes
cain t2," " ;tab ?
jrst skpblk ;yes
skpbl1: bkptr t1 ;backspace byte pointer
ret ;and return
;
; ASCSIZ - accepts byte pointer in t1 to ascii string, encodes
; 6 chars into SIXBIT word in t2
;
ascsix: setz t2, ;zero out SIXBIT word
movei t4,6 ;initialize loop count
ascsi1: ildb t3,t1 ;get byte
subi t3,40 ;convert to sixbit
skipge t3 ;still a character ?
setz t3, ;no, convert to space
lsh t2,6 ;shift current word six bits left
or t2,t3 ;and in extra byte
sojg t4,ascsi1 ;loop six times
ret ;back to caller
xlist ;store literals, but don't listem
literl: LIT ;store literals here
list
;
; Display size of pure section
;
radix 5+5
define showp(size,pag),<printx * Shareable data/code storage = size words (pag pages) + external routines>
if1, <$$tmp==1
ife <<.-$$pure>&^o777>,<$$tmp==0>
showp \<.-$$pure>,\<<<.-$$Pure>/^d512>+$$tmp>>
radix 8
end <3,,entvec>