Google
 

Trailing-Edge - PDP-10 Archives - bb-m081w-sm_t20_v7_0_02_exec_src_mod - exec/execsu.mac
There are 47 other files named execsu.mac in the archive. Click here to see a list.
; Edit= 4425 to EXECSU.MAC on 14-Mar-89 by GSCOTT
;Rewrite ATTACH command to allow user to pick a job to attach to if more than
;one candidate job. Also allow ETYPE's %L to take an AC argument. 
; Edit= 4421 to EXECSU.MAC on 28-Feb-89 by GSCOTT
;Suppress columnization in ETYPE %W's ODTIM.
; Edit= 4420 to EXECSU.MAC on 16-Feb-89 by GSCOTT
;Make ETYPE's %W say "never" for a zero date, then clean up login message code
;in EXEC0 and EXEC1.
; Edit= 4419 to EXECSU.MAC on 9-Feb-89 by GSCOTT
;INFORMATION JOB command should show network origin. %L now will output this. 
; Edit= 4412 to EXECSU.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4405 to EXECSU.MAC on 5-May-88 by RASPUZZI (TCO 7.1284)
;Don't trash AC 0. Fix SETO instruction introduced by edit 4402.
; Edit= 4402 to EXECSU.MAC on 5-Apr-88 by EVANS (TCO 7.1265)
;Make the EXEC accept non-alphanumeric characters $,_,-,and . in LAT-type
;names for remote printing. 
; Edit= 4401 to EXECSU.MAC on 17-Mar-88 by RASPUZZI
;Take another whack at POBOX. Rewrite GETPOB so that it translates POBOX: and
;searches each structure for the user's POBOX directory. Also, fix ACSPOB to
;work correctly and look for STRX10 in MALCHK.
; UPD ID= 4129, RIP:<7.EXEC>EXECSU.MAC.9,   7-Mar-88 18:27:47 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 49, RIP:<7.EXEC>EXECSU.MAC.8,  27-Oct-87 17:24:01 by RASPUZZI
;TCO 7.1085 - Don't make AUTOLO do a DOBE% because the terminal origin may
;             no longer be valid. This causes phantom jobs to hang around.
;             Instead, DISMS% for a short time period, then kill the job
; UPD ID= 48, RIP:<7.EXEC>EXECSU.MAC.7,  27-Oct-87 17:20:18 by GSCOTT
;TCO 7.1083 - Change characteristic bit mask storage for 8 bit byte pointer.
; UPD ID= 44, RIP:<7.EXEC>EXECSU.MAC.5,  22-Oct-87 11:04:44 by RASPUZZI
;TCO 7.1076 - Make routine TOUT globally accessible
; UPD ID= 22, RIP:<7.EXEC>EXECSU.MAC.4,  22-Sep-87 11:29:04 by EVANS
; More TCO 7.1061 - Fill in TCO numbers around edits and add header line.
; UPD ID= 17, RIP:<7.EXEC>EXECSU.MAC.3,  22-Sep-87 10:48:18 by EVANS
; TCO 7.1061 - Implement SET REMOTE-PRINTING CHARACTERISTIC and INFORMATION
;		(ABOUT) REMOTE-PRINTING.
; *** Edit 3068 to EXECSU.MAC by EVANS on 15-May-87, for SPR #21620
; Allow INFO MAIL when not logged in - don't check for POBXNO at MALCHK:.
; *** Edit 3066 to EXECSU.MAC by EVANS on 29-Apr-87
; Add the string 'POBOX:' to the error message after the DIRST so the user
; knows what it refers to. 
; *** Edit 3065 to EXECSU.MAC by EVANS on 28-Apr-87
; Change error handling after DIRST in MALCHK to avoid looping. 
; *** Edit 3063 to EXECSU.MAC by MCCOLLUM on 21-Apr-87, for SPR #20642
; Release unwanted fork handles after a GFRKS% JSYS 
; *** Edit 3050 to EXECSU.MAC by EVANS on 29-Oct-86, for SPR #00092
; Reset STATSW to zero to prevent mulitply defined symbols when linking with
; distributed PCL and MIC modules; remove the STAT code so we don't do the
; statistics.
; *** Edit 3048 to EXECSU.MAC by EVANS on 14-Oct-86
; Make mail-checking code check to see if POBXNO (user's POBOX: directory
; number) is set up; if not, don't do the mail check. Also, check POBXNO before
; calling GETPOB:, so as not to execute the code if we don't have to.
; *** Edit 3044 to EXECSU.MAC by EVANS on 15-Jul-86
; Implement LOGINF to tell when we are acessing POBOX: and mail-checking during
; login; have MALCHK test it and return to log-in code on a JSYS error.
; *** Edit 3040 to EXECSU.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; *** Edit 3038 to EXECSU.MAC by RASPUZZI on 22-May-86
; Fix minor MACRO problem with edit 3037 
; *** Edit 3037 to EXECSU.MAC by RASPUZZI on 21-May-86
; More of edit 3033 - extend GTJFN blocks so that the we have room for all
; GTJFN words when called. 
; *** Edit 3031 to EXECSU.MAC by PRATT on 15-Apr-86, for SPR #20805
; Fix double prompts when not logged in and user gets an error. 
; *** Edit 3029 to EXECSU.MAC by WAGNER on 4-Apr-86, for SPR #20747
; Modify Autologout code to do a DOBE before LGOUT% 
; Edit 3019 to EXECSU.MAC by EVANS on 22-Oct-85 (TCO none )
; Make ASOUT work right when passed a specific number of bytes to be copied -
; was failing after one byte copied. (QAR 838282) 
; Edit 3017 to EXECSU.MAC by EVANS on 15-Oct-85 (TCO none)
; Prevent a SET DEFAULT (GALAXY-related) command from echoing twice if issued
; from a TAKE file with subcommand ECHO. QAR 838277
; UPD ID= 256, SNARK:<6.1.EXEC>EXECSU.MAC.31,  20-Jun-85 14:21:50 by EVANS
;More TCO 6.1.1404 - Test NOSAVE flag before saving commands.
; UPD ID= 249, SNARK:<6.1.EXEC>EXECSU.MAC.30,  14-Jun-85 15:53:20 by EVANS
;More TCO 6.1.1404 - Fix for command editor bug (HISTORY saving PCL subcommands)
; UPD ID= 241, SNARK:<6.1.EXEC>EXECSU.MAC.29,  10-Jun-85 08:45:30 by DMCDANIEL
; UPD ID= 207, SNARK:<6.1.EXEC>EXECSU.MAC.28,  24-May-85 14:14:21 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 187, SNARK:<6.1.EXEC>EXECSU.MAC.27,   6-May-85 11:10:20 by PRATT
;More TCO 6.1.1353 - ERJMP should be JRST after call to GNJFS
; UPD ID= 182, SNARK:<6.1.EXEC>EXECSU.MAC.26,   3-May-85 08:32:46 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 158, SNARK:<6.1.EXEC>EXECSU.MAC.25,   2-May-85 11:17:32 by PRATT
;TCO 6.1.1353 - GNJFS for checking GNJFN failures and stacked jfns
; UPD ID= 135, SNARK:<6.1.EXEC>EXECSU.MAC.24,  14-Mar-85 10:53:46 by PRATT
;TCO 6.1.1257 - If DBGEXC is set, make ^T display exec pc's during commands
; UPD ID= 133, SNARK:<6.1.EXEC>EXECSU.MAC.23,   7-Mar-85 19:56:24 by PRATT
;TCO 6.1.1243 - Better help in OCTLST (octal number list) routine
; UPD ID= 121, SNARK:<6.1.EXEC>EXECSU.MAC.22,   8-Jan-85 15:00:42 by MCCOLLUM
;Add a <CRLF> after the "%Not superseding current file" message
; UPD ID= 115, SNARK:<6.1.EXEC>EXECSU.MAC.21,  18-Dec-84 12:48:22 by TBOYLE
;TCO 6.1.1092 - Fix jobs hung as EXEC not logged in. Remove DOBE at autol6
; UPD ID= 105, SNARK:<6.1.EXEC>EXECSU.MAC.20,  11-Dec-84 15:22:07 by MOSER
;TCO 6.1.1077 - ADD STAT STUFF
; UPD ID= 99, SNARK:<6.1.EXEC>EXECSU.MAC.18,   4-Dec-84 11:27:08 by MCCOLLUM
;Fix ERJMP to bad literal in GTSTAD.
; UPD ID= 98, SNARK:<6.1.EXEC>EXECSU.MAC.17,  27-Nov-84 13:04:12 by PRATT
;TCO 6.1.1063 - Fix typo in MAPPF when no current fork
; UPD ID= 89, SNARK:<6.1.EXEC>EXECSU.MAC.15,  14-Nov-84 11:11:02 by MCCOLLUM
;More of TCO 6.1.1025 - Replace an edit that disappeared
; UPD ID= 85, SNARK:<6.1.EXEC>EXECSU.MAC.14,  12-Nov-84 16:22:00 by MCCOLLUM
;TCO 6.1.1044 - Add NEWER option to SPRCHK
; UPD ID= 67, SNARK:<6.1.EXEC>EXECSU.MAC.13,  12-Nov-84 03:51:30 by MERRILL
;TCO 6.1.1042 - Update for the latest PCL we have
;  Make ^T work in a reasonable manner (consistent with what it does
;  with builtin commands) when a PCL command is in progress.
;  Make assignments to $PromptReg and friends cause the prompt to
;  change immediately (instead of after the next command or ^C).
;  Don't close PCL PTY in CIOREL.
;  Don't call CMDINI in EOFJER if a PCL is running, it breaks DOCOMMAND.
;  Check FK%INV fork flag instead of PCPRGR to determine if a program
;  has been INVOKE'd.
;  Don't blow up if user ^C's during PRESERVE EXEC.
;  Attack error handlers to make sure we don't end up in subcommand
;  mode if a DOCOMMAND blows up while inputting subcommands.
;  Make a change to DOGET whose raison d'etre has long been forgotten.
;  Make NOTIO check if JFN in use by PCL system.
; UPD ID= 54, SNARK:<6.1.EXEC>EXECSU.MAC.12,   5-Nov-84 15:19:33 by MCCOLLUM
;More of TCO 6.1.1025 - Fix up calling sequence to MFSET
; UPD ID= 44, SNARK:<6.1.EXEC>EXECSU.MAC.11,  30-Oct-84 13:53:34 by MCCOLLUM
;TCO 6.1.1025 - Add routines SPRCHK and GTSJFN for COPY SUPERSEDE.
; UPD ID= 42, SNARK:<6.1.EXEC>EXECSU.MAC.10,  26-Oct-84 16:17:25 by EVANS
;TCO 6.1.1027 - reprised - Zero LGORET when do error message. GOOD return
;	      from successful TAKE of LOGOUT.CMD is in here too.
; UPD ID= 41, SNARK:<6.1.EXEC>EXECSU.MAC.9,  26-Oct-84 13:36:37 by EVANS
;TCO 6.1.1027 - Clear LGORET (taking LOGOUT.CMD file) on ^C or error.
; UPD ID= 32, SNARK:<6.1.EXEC>EXECSU.MAC.8,   3-Oct-84 17:09:23 by PRATT
;TCO 6.2235 - Fix problem with ^T during ^C of ephemoral programs
; UPD ID= 24, SNARK:<6.1.EXEC>EXECSU.MAC.7,   1-Oct-84 22:40:30 by PRATT
;TCO 6.1.1019 - Make DEVN routine set CM%NSF nosuffix flag
; UPD ID= 18, SNARK:<6.1.EXEC>EXECSU.MAC.6,  29-Sep-84 21:33:24 by PRATT
;TCO 6.1.1018 - Move ASOUT to here and make READNM use it
; UPD ID= 3, SNARK:<6.1.EXEC>EXECSU.MAC.2,  28-Sep-84 12:52:22 by PRATT
;TCO 6.1.1012 - Reset terminal characteristics after unformatted TYPE
; UPD ID= 446, SNARK:<6.EXEC>EXECSU.MAC.65,  26-Sep-84 16:46:38 by MCCOLLUM
;TCO 6.2229 - Check private name in USEX and print subsys name if null.
; UPD ID= 427, SNARK:<6.EXEC>EXECSU.MAC.64,  23-Jul-84 13:27:25 by PRATT
;TCO 6.2140 - Fix error return problem in MAPPF when pages can't be mapped
; UPD ID= 424, SNARK:<6.EXEC>EXECSU.MAC.63,  19-Jul-84 14:41:05 by PRATT
;TCO 6.2135 - Fix CMERR$ to rewrite the null byte
; UPD ID= 405, SNARK:<6.EXEC>EXECSU.MAC.62,   3-May-84 08:19:19 by SHTIL
; UPD ID= 383, SNARK:<6.EXEC>EXECSU.MAC.61,  26-Jan-84 17:00:05 by MCCOLLUM
;TCO 6.1957 - Fix label at %X2+5 from %X to %X4, like it should be
; UPD ID= 372, SNARK:<6.EXEC>EXECSU.MAC.60,   5-Jan-84 10:16:21 by PRATT
;TCO 6.1923 - If detached bypass the DVCHR in LTTYMD and RTTYMD
; UPD ID= 350, SNARK:<6.EXEC>EXECSU.MAC.59,  29-Nov-83 10:51:43 by PRATT
;TCO 6.1874 - Modify USRNAM for the INFO MAIL command.
; UPD ID= 342, SNARK:<6.EXEC>EXECSU.MAC.58,  20-Nov-83 19:45:24 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 332, SNARK:<6.EXEC>EXECSU.MAC.56,  18-Nov-83 14:34:21 by TSANG
;More TCO 6.1837
; UPD ID= 324, SNARK:<6.EXEC>EXECSU.MAC.55,  10-Nov-83 14:12:11 by TSANG
;TCO 6.1837 - Make error character consistent in RENAME, DIRECTORY, DELETE, ARCHIVE and DISCARD.
; UPD ID= 312, SNARK:<6.EXEC>EXECSU.MAC.53,  26-Sep-83 19:37:43 by MILLER
;TCO 6.1758. Change other MALCHK routine
; UPD ID= 309, SNARK:<6.EXEC>EXECSU.MAC.52,   1-Sep-83 10:09:46 by PRATT
;TCO 6.1790 - Remove CLZFF CZ%NCL bit used in RERET. Cleans up lost jfns
; UPD ID= 304, SNARK:<6.EXEC>EXECSU.MAC.51,   8-Aug-83 11:23:17 by TSANG
;TCO 6.1760 - Make the error character consist in RENAME  command.
; UPD ID= 303, SNARK:<6.EXEC>EXECSU.MAC.50,   3-Aug-83 10:54:21 by MILLER
;TCO 6.1758. Look on POBOX: for MAIL.TXT files
; UPD ID= 290, SNARK:<6.EXEC>EXECSU.MAC.49,  21-Jun-83 15:18:35 by WEETON
;TCO 6.1698 - Fix WORD$ so that BUILD command works when disabled
; UPD ID= 267, SNARK:<6.EXEC>EXECSU.MAC.48,   8-Apr-83 15:55:35 by TSANG
;TCO 6.1519- CHANGE FIELD TO FIELDX SO AS NOT TO CONFLICT WITH MACSYM
;TCO 6.1516 - Make ^O... appear on TTY: only
; UPD ID= 263, SNARK:<6.EXEC>EXECSU.MAC.47,   7-Mar-83 14:28:55 by WEETON
;TCO 6.1535 - Allow wild carding on DIRECTORY TYPE commands
; UPD ID= 261, SNARK:<6.EXEC>EXECSU.MAC.46,  21-Feb-83 00:44:42 by MURPHY
;TCO 6.1514 - Error code not in AC if ERJMP taken at RJFNE and GTFAIL.
; UPD ID= 260, SNARK:<6.EXEC>EXECSU.MAC.45,  14-Feb-83 11:48:12 by LOMARTIRE
;TCO 6.1499 - Fix COPY FOO.*.* BAR.*.*;T so that destination files are ;T
; UPD ID= 254, SNARK:<6.EXEC>EXECSU.MAC.44,  26-Jan-83 18:48:48 by PAETZOLD
;TCO 6.1478 - Prevent killer mail files in MALLCL
; UPD ID= 253, SNARK:<6.EXEC>EXECSU.MAC.43,  18-Jan-83 16:20:50 by WEETON
;TCO 6.1450 - Fix Daylight Saving Time change over problems (this TCO
; supercedes TCO 6.1338)
; UPD ID= 248, SNARK:<6.EXEC>EXECSU.MAC.42,  15-Jan-83 19:26:55 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 232, SNARK:<6.EXEC>EXECSU.MAC.41,  14-Jan-83 14:55:50 by TSANG
;TCO 6.1461 - In CTRL/T, if program name = EXEC, try to get last run
; program name.
;TCO 6.1460 - Use GETNM to get running fork's name instead of table lookup.
;TCO 6.1459 - Save AC .FP during subcommand processing for use in error
; recovery.
; UPD ID= 227, SNARK:<6.EXEC>EXECSU.MAC.40,  12-Jan-83 15:30:47 by WEETON
;TCO 6.1141 When ETYPE <%X> is called from "INFO PROG", don't print "?" in
; first column.
; UPD ID= 221, SNARK:<6.EXEC>EXECSU.MAC.39,  11-Jan-83 15:05:50 by CHALL
;TCO 6.1451 JFNSIL- SEE IF JFN IS RESTRICTED BEFORE SEEING IF IT HAS A NAME
; UPD ID= 219, SNARK:<6.EXEC>EXECSU.MAC.38,  11-Jan-83 11:36:02 by TSANG
;TCO 6.1114 - Make subcommand ECHO of TAKE command works.
; UPD ID= 218, SNARK:<6.EXEC>EXECSU.MAC.37,  10-Jan-83 14:26:04 by TSANG
;TCO 6.1128 - Check correctly at GETLPC for waiting interrupt levels.
; UPD ID= 190, SNARK:<6.EXEC>EXECSU.MAC.36,   1-Nov-82 16:23:28 by WEETON
;TCO 6.1338 - Add correction for ending Daylight Saving Time
; UPD ID= 175, SNARK:<6.EXEC>EXECSU.MAC.35,   8-Oct-82 18:03:21 by CHALL
;MORE TCO 6.1270 MFINP0- ADD MISSING JS%DIR TO JFNS CALL
; UPD ID= 168, SNARK:<6.EXEC>EXECSU.MAC.34,  30-Sep-82 16:33:52 by MCINTEE
;TCO 6.1270 - larger CRDIR block - remote alias list
; UPD ID= 164, SNARK:<6.EXEC>EXECSU.MAC.33,  28-Sep-82 10:12:42 by TSANG
;TCO 6.1250 SET BREAK MASK TO PARSE A PASSWORD IN WORDX.
;TCO 6.1249 FIX SET LATE-CLEAR-TYPEAHEAD COMMAND
; UPD ID= 143, SNARK:<6.EXEC>EXECSU.MAC.32,   4-Aug-82 17:30:46 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 121, SNARK:<6.EXEC>EXECSU.MAC.31,  20-Apr-82 07:55:08 by CHALL
;TCO 6.1097 %GTB- Return 0 if GETAB table is unknown, for upward compatibility
;TCO 6.1092 USEPS2- Move MIC-calling code to EXECCA (USEPSM)
; UPD ID= 101, SNARK:<6.EXEC>EXECSU.MAC.28,   8-Jan-82 16:00:06 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 83, SNARK:<6.EXEC>EXECSU.MAC.27,  20-Dec-81 18:48:51 by CHALL
;TCO 6.1050 MAKE GTB A SUBROUTINE RATHER THAN A (WASTEFUL) UUO
; UPD ID= 81, SNARK:<6.EXEC>EXECSU.MAC.26,  20-Dec-81 18:10:26 by CHALL
;TCO 6.1049 FNODE$- RNODE$- DON'T REQUIRE "::" IN NODE NAME (SET CM%NSF)
; UPD ID= 56, SNARK:<6.EXEC>EXECSU.MAC.23,  21-Sep-81 09:25:15 by CHALL
;TCO 5.1518 CIOER1- DON'T OUTPUT MESSAGE ON ^C OF PCL COMMAND
; UPD ID= 53, SNARK:<6.EXEC>EXECSU.MAC.20,  11-Sep-81 09:20:47 by CHALL
;MORE TCO 5.1496 DT1- FIX A CAIE D,.CMTOK THAT SHOULD BE A CAIN
; UPD ID= 67, SNARK:<5.EXEC>EXECSU.MAC.17,   9-Sep-81 15:25:47 by GROUT
;TCO 5.1497 RESTORE .JB41 EARLIER IN ILL INST TRAP, AT ILIPSI
; UPD ID= 66, SNARK:<5.EXEC>EXECSU.MAC.16,   9-Sep-81 14:55:39 by GROUT
;TCO 5.1496 FIX UP TIMES INPUT TO /AFTER AND /SINCE TYPE SWITCHES
; UPD ID= 50, SNARK:<6.EXEC>EXECSU.MAC.19,   9-Sep-81 10:08:26 by CHALL
;TCO 5.1493 USEX- ON ^T MAKE SURE THERE'S A SPACE AFTER THE TIME
; UPD ID= 39, SNARK:<6.EXEC>EXECSU.MAC.17,  19-Aug-81 11:01:55 by CHALL
;TCO 5.1466 REPARS: CLEAR PCLDCO (ORIGINAL COMMAND FLAG) ON COMMAND REPARSE
; UPD ID= 23, SNARK:<6.EXEC>EXECSU.MAC.16,  17-Aug-81 10:24:00 by CHALL
;TCO 5.1455 PIOFF: - CLEAR CTLCF1 AND CTLCF2 FLAGS IN Z
;TCO 5.1454 CHANGE NAMES FROM SUBRS TO EXECSU AND XDEF TO EXECDE
; UPD ID= 7, SNARK:<6.EXEC>EXECSU.MAC.15,  14-Jul-81 17:07:40 by MURPHY
;DITTO
; UPD ID= 6, SNARK:<6.EXEC>EXECSU.MAC.14,  14-Jul-81 14:11:33 by MURPHY
;TCO 5.1410 - MACHINE SIZE EXCEEDED, OVER QUOTA, ETC.
; UPD ID= 2279, SNARK:<6.EXEC>EXECSU.MAC.13,   1-Jul-81 13:42:42 by CHALL
;TCO 5.1391 - CIOREL: PCMPOS SHOULD BE CALLED BEFORE FIXIO
; UPD ID= 2244, SNARK:<6.EXEC>EXECSU.MAC.12,  23-Jun-81 15:12:10 by OSMAN
;more 6.1023 - allow ddt/use-section:n even if no program
; UPD ID= 2213, SNARK:<6.EXEC>EXECSU.MAC.11,  18-Jun-81 15:58:45 by OSMAN
;tco 6.1023 - Make MAPPF give nonexistent return instead of error return
;when PMAP fails (presumably due to section not existing)
; UPD ID= 2173, SNARK:<6.EXEC>EXECSU.MAC.10,  11-Jun-81 10:03:21 by OSMAN
;tco 6.1022 - give error on a,,b if b is an illegal expression
; UPD ID= 2029, SNARK:<6.EXEC>EXECSU.MAC.9,  19-May-81 10:27:29 by PURRETTA
;<6.EXEC>EXECSU.MAC.7, 13-Apr-81 15:29:31, Edit by DK32
;PCL Fix DOGET to really clean up stack, Make some globals
; UPD ID= 1998, SNARK:<6.EXEC>EXECSU.MAC.8,  14-May-81 15:23:45 by MURPHY
; UPD ID= 1955, SNARK:<5.EXEC>EXECSU.MAC.3,   6-May-81 15:06:23 by MURPHY
; UPD ID= 1891, SNARK:<5.EXEC>EXECSU.MAC.2,  27-Apr-81 09:51:31 by ACARLSON
;<ACARLSON>EXECSU.MAC.2, 25-Apr-81 15:33:30, EDIT BY ACARLSON
;Modify PRIT1 so that it works with GALAXY 4.0 and GALAXY 4.1
;
; UPD ID= 1938, SNARK:<6.EXEC>EXECSU.MAC.7,   5-May-81 15:31:46 by ACARLSON
;<ACARLSON>EXECSU.MAC.2,  5-May-81 15:30:46, EDIT BY ACARLSON
;   Make this EXEC run with both GALAXY 4.0 and GALAXY 5.0
; UPD ID= 1739, SNARK:<6.EXEC>EXECSU.MAC.6,  19-Mar-81 16:46:26 by OSMAN
;Make MAPPF give skip return even when section doesn't exist
; UPD ID= 1643, SNARK:<6.EXEC>EXECSU.MAC.5,   4-Mar-81 10:41:54 by OSMAN
;more 6.1004 - Do it in monitor instead of exec
; UPD ID= 1640, SNARK:<6.EXEC>EXECSU.MAC.4,   3-Mar-81 15:35:59 by OSMAN
;tco 6.1004 - Make DOCOMMANDs following DOCOMMAND of failed TAKE file
;work.
; UPD ID= 1585, SNARK:<6.EXEC>EXECSU.MAC.3,  25-Feb-81 14:11:19 by OSMAN
;tco 6.1001 - Fix PCL to not hang after DOCOMMAND "TAKE...".
;REMOVE MFRK CONDITIONALS
;<4.EXEC>EXECSU.MAC.1, 23-Dec-80 19:17:25, Edit by DK32
;Programmable Command Language
;SPR 14203,14601, CM236 Fixes
; UPD ID= 1433, SNARK:<5.EXEC>EXECSU.MAC.34,  13-Jan-81 09:57:54 by OSMAN
;More 5.1129 - Make EXAMINE show octal contents "...too, if different"
; UPD ID= 1403, SNARK:<5.EXEC>EXECSU.MAC.33,   6-Jan-81 10:28:12 by OSMAN
;tco 5.1225 - Implement jsys trapping and file-opening trapping!
; UPD ID= 1384, SNARK:<5.EXEC>EXECSU.MAC.32,  24-Dec-80 15:07:17 by OSMAN
;More 5.1214 - Unbreak ^H feature! (restore SBLOCK state)
; UPD ID= 1370, SNARK:<5.EXEC>EXECSU.MAC.31,  19-Dec-80 10:26:15 by OSMAN
;More 5.1214 - Make "COPY NONEXISTENTFILE<cr>" say which file wasn't found
; UPD ID= 1354, SNARK:<5.EXEC>EXECSU.MAC.30,  15-Dec-80 15:54:15 by OSMAN
;More 5.1214 - Use ADJBP instead of ADJSP (you turkey Eric!)
; UPD ID= 1351, SNARK:<5.EXEC>EXECSU.MAC.29,  12-Dec-80 16:57:47 by OSMAN
;TCO 5.1214 - Show erroneous part of command if available
; UPD ID= 1339, SNARK:<5.EXEC>EXECSU.MAC.28,   8-Dec-80 10:08:27 by ACARLSON
;<GALAXY.DEVELOPMENT>EXECSU.MAC.2,  8-Dec-80 09:58:58, EDIT BY ACARLSON
;TCO 5.1210 - Add routine GQSRPD to ask SYSINF for PID of private QUASAR
; UPD ID= 1326, SNARK:<5.EXEC>EXECSU.MAC.27,   1-Dec-80 16:03:07 by OSMAN
;Make NESC global, return from ADDR$ if escape typed
; UPD ID= 1294, SNARK:<5.EXEC>EXECSU.MAC.26,  19-Nov-80 10:31:25 by OSMAN
;GETARG only needs to be two words
; UPD ID= 1201, SNARK:<5.EXEC>EXECSU.MAC.25,  27-Oct-80 09:36:21 by SCHMITT
;TCO 5.1181 - Precede all EXEC BATCH prompts with a space
; UPD ID= 1176, SNARK:<5.EXEC>EXECSU.MAC.24,  20-Oct-80 16:59:32 by DONAHUE
;TCO 5.1176 - Let LFJFNS return a byte pointer to a null string rather
;than 0
; UPD ID= 1051, SNARK:<5.EXEC>EXECSU.MAC.23,  26-Sep-80 09:59:50 by OSMAN
;Fix FLOUT format to have symbolic representation
; UPD ID= 1047, SNARK:<5.EXEC>EXECSU.MAC.22,  25-Sep-80 15:10:11 by OSMAN
;tco 5.1158 - Make ^T show current time
; UPD ID= 1031, SNARK:<5.EXEC>EXECSU.MAC.21,  22-Sep-80 10:38:42 by OSMAN
;tco 5.1150 - Add SET PROGRAM
;Make %KEYW return entry address in B.  (%KEYW no longer preserves temps!)
; UPD ID= 1017, SNARK:<5.EXEC>EXECSU.MAC.20,  16-Sep-80 10:18:10 by HESS
;New version of MIC
; UPD ID= 979, SNARK:<5.EXEC>EXECSU.MAC.19,   3-Sep-80 11:01:38 by DONAHUE
;TCO 5.1138 - Move label CCDB3 up 2 lines so CTRL/C resets CCOC word
; UPD ID= 884, SNARK:<5.EXEC>EXECSU.MAC.18,  13-Aug-80 13:31:24 by OSMAN
;More 5.1129 - Handle "?" correctly in memory addresses
; UPD ID= 868, SNARK:<5.EXEC>EXECSU.MAC.16,  11-Aug-80 10:59:57 by OSMAN
;More 5.1129 - Print exec's jsys error symbolically if appropriate
; UPD ID= 864, SNARK:<5.EXEC>EXECSU.MAC.15,  10-Aug-80 16:41:48 by OSMAN
;More 5.1129 - Fix
; UPD ID= 862, SNARK:<5.EXEC>EXECSU.MAC.14,  10-Aug-80 16:23:49 by OSMAN
;More 5.1129 - Allow halfword format for addresses
; UPD ID= 860, SNARK:<5.EXEC>EXECSU.MAC.13,  10-Aug-80 15:20:26 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
; UPD ID= 833, SNARK:<5.EXEC>EXECSU.MAC.12,   5-Aug-80 08:55:58 by OSMAN
;tco 5.1123 - Don't allow wildcarding in user names in USER$ routine
; UPD ID= 828, SNARK:<5.EXEC>EXECSU.MAC.11,   4-Aug-80 11:19:18 by OSMAN
;More 5.1113 - Fix broken JFNSTK
; UPD ID= 808, SNARK:<5.EXEC>EXECSU.MAC.10,  30-Jul-80 10:02:18 by OSMAN
;tco 5.1115 - Prevent looping "?File or Swapping space exceeded..."
; UPD ID= 802, SNARK:<5.EXEC>EXECSU.MAC.9,  28-Jul-80 09:53:28 by OSMAN
;TCO 5.1113 - Make RLJFNS/FLJFNS return 0 for success and 1 for error
;Note:  As of this change, RLJFN / FLJFNS no longer preserve temps!
; UPD ID= 594, SNARK:<5.EXEC>EXECSU.MAC.8,   3-Jun-80 10:35:39 by OSMAN
;tco 5.1058 - Make ^T not clobber 16.
;<5.EXEC>EXECSU.MAC.7, 30-May-80 16:59:00, EDIT BY MURPHY
;NEW MAIL WATCH AND ALERT UNDER NEWF
; UPD ID= 540, SNARK:<5.EXEC>EXECSU.MAC.6,  20-May-80 15:54:32 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
;<5.EXEC>EXECSU.MAC.5, 15-May-80 14:53:30, EDIT BY OSMAN
;More DATBIT.
; UPD ID= 519, SNARK:<5.EXEC>EXECSU.MAC.4,  14-May-80 13:19:39 by OSMAN
;Implement DATBIT
; UPD ID= 496, SNARK:<5.EXEC>EXECSU.MAC.3,  30-Apr-80 14:36:20 by OSMAN
;<OSMAN.EXEC>EXECSU.MAC.2, 30-Apr-80 13:42:11, EDIT BY OSMAN
;tco 5.1028 - Echo erroneous commands from TAKE files
; UPD ID= 459, SNARK:<4.1.EXEC>EXECSU.MAC.15,  22-Apr-80 16:42:28 by OSMAN
;tco 4.1.1145 - Make ADVISE smarter about "line not active"
;<4.1.EXEC>EXECSU.MAC.14,  9-Apr-80 14:31:42, EDIT BY OSMAN
;Make GETDIR leave account pointer good in .CDDAC
;<4.1.EXEC>EXECSU.MAC.12, 17-Mar-80 14:05:48, EDIT BY OSMAN
;Handle ONEWRD in one place
; UPD ID= 309, SNARK:<4.1.EXEC>EXECSU.MAC.11,  10-Mar-80 13:37:48 by OSMAN
;tco 4.1.1103 - Prevent spurious mail activity by changing CAMLE C,D to CAML
;<4.1.EXEC>EXECSU.MAC.10, 29-Feb-80 13:59:11, EDIT BY OSMAN
;tco 4.1.1097 - Don't say "string space exhausted" after many DELETE commands
; UPD ID= 241, SNARK:<4.1.EXEC>EXECSU.MAC.9,   4-Feb-80 11:11:59 by OSMAN
;tco 4.1.1078 - Make echoing of .CMD lines always happen on error if requested
; UPD ID= 237, SNARK:<4.1.EXEC>EXECSU.MAC.8,   1-Feb-80 08:54:38 by OSMAN
;Change IPCIDX to IPCIX
; UPD ID= 228, SNARK:<4.1.EXEC>EXECSU.MAC.7,  28-Jan-80 10:39:33 by OSMAN
;tco 4.1.1075 - Add IPCIDX
;<4.1.EXEC>EXECSU.MAC.3, 20-Nov-79 10:30:51, EDIT BY OSMAN
;TCO 4.1023 - Fix TAKE stuff
;<4.1.EXEC>EXECSU.MAC.2,  1-Nov-79 13:39:12, EDIT BY OSMAN
;tco 4.1.1005 - Fix I MEM when restricted jfn is involved

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE - SUBROUTINES

	SEARCH EXECDE
	TTITLE EXECSU

;THIS FILE CONTAINS SUBROUTINES AND SERVICE ROUTINES IN THREE SECTIONS:
; 1. MONITOR-INDEPENDENT LANGUAGE DECODING OPERATIONS
; 2. MONITOR-DEPENDENT OPERATIONS, E.G. I/O
; 3. PSEUDO-INTERRUPT AND ERROR PROCESSORS
;INTERNS -- ROUTINES IN THIS ASSEMBLY

INTERN READY,READ1,READY2,REPARS ;PRINT ONE OR TWO READY CHARACTERS (@ OR !)
INTERN PRVCK			;ROUTINE FOR CHECKING PRIVILEGES
INTERN %KEYW			;SERVICE ROUTINE FOR KEYWORD LOOKUP UUO (KEYWD)
INTERN %NOI			;SERV ROUTINE FOR NOISE WORD UUO ("NOISE" MACRO)
INTERN %SBCOM			;UUO TO INPUT AND DISPATCH ON SUBCOMMANDS
INTERN CONF			;TERMINATE AND CONFIRM COMMAND
INTERN SPRTR			;ANALYZE SEPARATOR/TERMINATOR IN ARG LIST
DEFINE XX (FOO)
<
INTERN FOO'$
>
ULIST

INTERN COUTFN,CSAVFN,SPECFN,CPFN,CPFNA	;INPUT IN, OUT, SPECIAL, PROG FILE NAMES
INTERN .INFG,$INFGX,DIRARG	;INPUT FILE GROUP DESCRIPTORS
INTERN TYPIF,TYPOK,GNFIL	;ROUTINES FOR STEPPING THRU FILES IN GRP
INTERN DEVN			;COLLECT DEVICE NAME
INTERN TOCT,OCTCOM,TOUT,TOUTD	;NUMBER OUTPUT SUBRS
INTERN BUFFF			;BUFFER LAST FIELD SUITABLY FOR USE AS JSYS ARG
INTERN NOECHO,DOECHO,LTTYMD,RTTYMD ;TTY MODES ETC
INTERN %PRINT			;OUTPUT CHARACTER UUO
INTERN MAPPF			;MAP PAGE OF FORK SUBR
INTERN LOADF			;LOAD WORD FROM FORK SUBR
INTERN STOREF			;STORE WORD INTO FORK SUBR
INTERN %GTB			;CONVENIENT GETAB JSYS CALL ROUTINE

INTERN USEPSI			;TERMINAL PSI TO PRINT RUNTIME (^T)
INTERN NIYE,NIM,SCREWUP,JERR,JERRC ;VARIOUS ERROR CONDITIONS
INTERN %TRAP			;CHANNEL 1 ERROR PSI MESSAGE UUO
INTERN ILIPSI			;ILLEGAL INSTRUCTION PSI
INTERN EOFPSI			;END-OF-FILE PSEUDO-INTERRUPT ON CHANNEL 1
INTERN DATPSI			;FILE DATA ERROR INTERRUPT
INTERN CCPSI			;^C PSI ON CHANNEL 1
INTERN TLMPSI			;TIME EXCEEDED ON CHANNEL 4
INTERN COBPSI			;^O PSI ON CHANNEL 5
INTERN ALOPSI			;PSI ON CHAN 1 FROM AUTOLOGOUT FORK
INTERN AUTOLO			;ROUTINE TO DO AUTOLOGOUT
INTERN %ERR,%$ERR,%.$ERR	;GENERAL ERROR UUOS (MACROS "ERROR" ETC)
INTERN RERET			;NORMAL AFTER-ERROR ROUTINE FOR CERET TO PT TO
INTERN RLJFNS			;CLOSE & RELEASE JFNS USED BY CURRENT COMMAND
INTERN %ETYPE			;TYPE MESSAGE, INTERPRETING %-CODES
INTERN CERR
INTERN FLOAT			;FLOAT INTEGER IN A
;SAVE TEMP AC'S - COMMONLY USED VIA ATSAVE MACRO

.SAVT::	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSHJ P,0(CX)		;CONTINUE ROUTINE
	 TRNA
	AOS -4(P)		;PROPAGATE SKIP
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET
;TO DO TABLE LOOKUP OF NEXT FIELD OF COMMAND, DO:
;
;	HELPX <THIS IS WHAT "?" TYPES OUT>
;	KEYWD TABLE		;"TABLE" IS ADDRESS OF TABLE
;	T FOO...		;APPROPRIATE "T" MACRO FORM OF DEFAULT VALUE
;	 ERROR RETURN
;	SUCCESS RETURN		;P3 HAS VALUE FROM TABLE
;				;B HAS TABLE ENTRY ADDRESS

%KEYW:	HLRO A,@(P)		;PICK UP POINTER TO DEFAULT FIELD VALUE
	AOS (P)			;SKIP THE DEFAULT ON RETURN
	TRNE A,-1		;LEAVE DEFAULT POINTER AS IS IF NO FIELD SUPPLIED
	MOVEM A,CMDEF		;SAVE DEFAULT STRING POINTER
	HRRZ A,40		;PICK UP ADDRESS OF KEYWORD TABLE
	MOVEM A,CMDAT		;SAVE ADDRESS OF TABLE
	MOVX A,CMKEY		;PREPARE TO PARSE KEYWORD
	SKIPE CMDEF		;IS THERE A DEFAULT?
	TXO A,CM%DPP		;YES, TELL COMND TO READ IT
	SKIPE CMHLP		;USER HELP MESSAGE?
	TXO A,CM%HPP		;YES, USE IT
	SKIPE CMBRK		;SPECIAL BREAK MASK?
	TXO A,CM%BRK		;USE IT
	MOVEM A,CMFNP		;STORE FLAGS
	MOVEI B,FBLOCK		;GET ADDRESS OF FUNCTION BLOCK
	CALL FIELDX		;INPUT THE KEYWORD FIELD
	SETZM CMDEF		;DON'T LET SAME DEFAULT BE USED OVER.
	SETZM CMHLP		;DON'T LET SAME HELP BE USED OVER
	SETZM CMBRK		;DON'T LET SAME BREAK MASK BE USED OVER
	TXNE A,CM%NOP		;MAKE SURE FIELD PARSED ALL RIGHT
	RET			;DIDN'T, TAKE SINGLE RETURN
	CALL GETKEY		;GET KEYWORD DATA
	RETSKP			;GIVE SKIP RETURN

;ROUTINE TO TAKE TABLE ADDRESS IN B AND RETURN TABLE DATA IN P3.
;THE ENTRY ADDRESS IN B IS PRESERVED.

GETKEY::HRRZ P3,(B)		;GET ADDRESS OF CONTROL DATA
	MOVE P3,(P3)		;GET THE CONTROL DATA ITSELF
	TXNE P3,ONEWRD		;CONFIRMATION NECESSARY NOW?
	CALLRET CONF		;YES, DO IT AND RETURN
	RET			;GIVE GOOD RETURN
;FIELD INPUT ROUTINE.  CALL IT WITH ADDRESS OF FUNCTION DESCRIPTOR
;BLOCK IN AC "B".  ROUTINE RETURNS WITH A, B, C, CONTAINING
;WHATEVER COMND PUT THERE.

FIELDX::STKVAR <<CMDDAT,2>,CMDFDB>
FIELDR:	MOVEI A,CCHEOF		;PCL Get EOF dispatch address
	MOVEM A,EOFDSP		;WHERE TO GO ON END OF FILE
	MOVX A,CM%WKF!CM%XIF	;WAKE ON EVERY FIELD SO ECHO CAN BE TURNED OFF IN TIME FOR LOGIN
	SKIPN CUSRNO		;IS USER LOGGED IN?
	IORM A,CMFLG		;NO, SO DON'T ALLOW "@" AND WAKE PER FIELD
	MOVX A,CM%WKF
	SKIPE CUSRNO		;LOGGED IN?
	ANDCAM A,CMFLG		;YES, SO DON'T WAKE PER FIELD
	AOS CLZFFF		;SAY CLZFF BETTER BE DONE IF ^C HERE.
	MOVEI A,SBLOCK		;ADDRESS OF COMMAND STATE BLOCK
	COMND			;DO THE COMND JSYS ITSELF (ONLY ONE IN EXEC! 6/16/77 EO)
	 ERCAL EOFJER		;FAILED, SAY WHY AND DIE
	DMOVEM B,CMDDAT		;REMEMBER DATA
	MOVEM C,CMDFDB
	AOS TTYACF		;NOTE THAT SOME TTY ACTION OCCURED
	SETZM CMDEF		;CLEAR DEFAULT STRING, SO ISN'T USED AGAIN INADVERTANTLY
	SETZM CMHLP		;CLEAR HELP MESSAGE, SO IT ISN'T USED AGAIN
	SETZM CMBRK		;CLEAR BREAK MASK SO IT ISN'T USED AGAIN
	SETZM EOFDSP		;CLEAR EOF DISPATCH ADDRESS
;IF THIS IS A CONFIRMATION, ECHO THE COMMAND IF DESIRED.

	TXNE A,CM%NOP		;SUCCESS?
	 JRST [	SOS CLZFFF	;NO, CLZFF NO LONGER NEEDED
		JRST FIELD1]	;SKIP FUNCTION CODE ANALYSIS
	LDB A,[POINTR((C),CM%FNC)] ;GET FUNCTION CODE
	CAIE A,.CMIFI		;SOMETHING PARSED WHICH CREATED A JFN?
	CAIN A,.CMOFI
	JRST FIELDF		;YES, LEAVE CLZFFF ON TO FORCE CLZFF IF ^C.
	CAIN A,.CMFIL
	JRST FIELDF		; "    "
	SOS CLZFFF		;NOT FILESPEC FUNCTION, CLZFF NOT NEEDED
	CAIE A,.CMCFM		;CONFIRMATION?
	 JRST FIELD1		;NO, GO ON
	SETZM CLF		;NOT AT COMMAND LEVEL IF JUST PARSED RETURN
	SKIPLE PCCIPF		;[PCL] Just confirmed top-level PCL command?
	SETOM PCCIPF		;[PCL] Yes, remember it's in progress for ^T
	SKIPE CIPF		;COMMAND ALREADY IN PROGRESS?
	JRST FIELD1		;YES
	MOVE A,COMAND		;GET ADDRESS OF TABLE ENTRY
	TLNE A,-1		;[PCL] Already been byte-pointer-ized?
	 JRST FIELD3		;[PCL] Yes, don't trash COMAND
	HLRZ A,(A)		;GET ADDRESS OF COMMAND NAME INFO
	MOVSI B,774000		;SEE IF THIS IS A FLAG WORD
	TDNN B,(A)		;IS IT?
	AOJ A,			;YES, SO COMMAND NAME STARTS IN NEXT WORD
FIELD2:	HRLI A,440700		;MAKE POINTER TO BEGINNING OF COMMAND NAME
	MOVEM A,COMAND		;REMEMBER POINTER TO ASCII
FIELD3:	SKIPE PCCURC		;[PCL] PCL command in progress?
	 MOVE A,PCLNAM		;[PCL] Yes, so use its name
	CALL GETSIX		;GET SIXBIT NAME FOR COMMAND
	 JFCL			;TRUNCATE IF COMMAND TOO LONG
	MOVEM A,COMSIX		;REMEMBER IT
	SKIPN PCCURC		;PCL No change if within stored command
	SETNM			;TELL SYSTEM, SO SYSTAT SHOWS IT
	SETOM CIPF		;SAY COMMAND IN PROGRESS
	SKIPN SDECHO		;[3017] CHECK "DON'T ECHO THIS TWICE" FLAG
	CALL ECHCMD		;ECHO THE COMMAND IF NECESSARY
	TXNN P3, NOSAVE		;SAVE THIS COMMAND? SKIP IF NO
	CALL CMDHST		;SAVE COMMAND FOR COMMAND EDITOR
FIELD1:	MOVX A,CM%XIF
	ANDCAB A,CMFLG		;ALLOW "@" UNLESS CALLER SAYS DON'T, RETURN FLAGS IN A
	DMOVE B,CMDDAT		;RETURN COMND DATA IN B
	RET

FIELDF:	MOVE A,B		;GET JFN
	CALL JFNSTK		;STACK IT SO WE REMEMBER TO RELEASE IT LATER
	SOS CLZFFF		;CLZFF NO LONGER NEEDED WHEN JFN IS STACKED
	JRST FIELD1
;GET ONE CHARACTER FROM COMMAND STRING

CMDCHR::
CMDCH2:	MOVEI B,SBLOCK
	SKIPG .CMINC(B)		;SOMETHING THERE?
	JRST CMDCH1		;NO
	ILDB A,.CMPTR(B)	;YES, GET IT
	SOS .CMINC(B)		;UPDATE COUNT
	CAIN A," "		;A SPACE?
	JRST CMDCH2		;PASS IT
	RET

CMDCH1:	HRROI A,[ASCIZ / /]	;PARSE A NULL STRING
	CALL CHAR		;IN ORDER TO GET MORE INPUT
	 JRST CMDCH2
	JRST CMDCH2		;TRY AGAIN

;BACKUP MAIN PTR IN COMMAND STRING

CMDBAK:	MOVEI B,SBLOCK
	MOVNI A,1
	ADJBP A,.CMPTR(B)	;DECREMENT BYTE PTR
	MOVEM A,.CMPTR(B)
	AOS .CMINC(B)
	RET
;ROUTINE WHICH CALLS FIELD AND SKIPS IFF SUCCESSFUL PARSE

FLDSKP::CALL FIELDX		;PARSE THE INPUT
	TXNE A,CM%NOP		;DID IT PARSE CORRECTLY?
	 RET			;NO, NON-SKIP
	RETSKP			;YES, SKIP

;THESE ROUTINES ARE USED TO MANUALLY BACK UP THE COMND POINTERS
;TO THE PREVIOUS ATOM.  THIS IS NECESSARY WHEN, FOR EXAMPLE,
;COMND HAS CORRECTLY PARSED A NUMBER, BUT THE NUMBER FAILS
;SOME RANGE CHECK THAT IS PERFORMED AFTER THE PARSE.

SAVCM::	ATSAVE
	DMOVE A,SBLOCK+.CMPTR
	MOVE C,SBLOCK+.CMINC
	DMOVEM A,CBLOCK
	MOVEM C,CBLOCK+2
	RET

RESCM::	ATSAVE
	DMOVE A,CBLOCK
	MOVE C,CBLOCK+2
	DMOVEM A,SBLOCK+.CMPTR
	MOVEM C,SBLOCK+.CMINC
	RET

;ROUTINE TO ECHO THE CURRENT COMMAND STRING IF NEED BE

ECHCMD::MOVE A,TAKCUR		;GET CURRENT SETTINGS
	SKIPN ERRMF		;ARE WE PRINTING AN ERROR MESSAGE?
	JRST ECHCM1		;NO - SKIP THIS
	TXNN A,TKTERF		;YES, ARE WE READING FROM A TERMINAL?
	JRST ECHCM2		;NO - ALWAYS ECHO ERRONEOUS COMMAND
ECHCM1:	TXNN A,TKECOF		;ECHOING?
	RET			;NO ECHOING
ECHCM2:	MOVE A,SVPRMT		;GET POINTER TO PROMPT STRING
	ETYPE <%1M>		;TYPE PROMPT STRING
	UTYPE CBUF		; AND COMMAND BUFFER
	CALLRET LM		;GET TO LEFT MARGIN IF COMMAND WASN'T COMPLETE
;ROUTINES TO HANDLE BIT MASKS...

;CLRALL/SETALL  CLEARS/SETS ALL THE BITS IN A BITMLN-BIT MASK
;
;ACCEPTS:	A/	ADDRESS OF MASK

CLRALL::SETZM (A)		;CLEAR FIRST WORD
	CAIA			;FALL INTO COMMON CODE
SETALL::SETOM (A)		;SET ALL THE BITS IN THE FIRST WORD OF MASK
	HRL A,A			;MAKE BLT POINTER
	HRRZI B,BITMLN-1(A)	;GET LAST ADDRESS OF BIT MASK
	AOJ A,			;MAKE POINTER TO SMEAR BITS
	BLT A,(B)		;SET ALL BITS
	RET

;SKPNAZ SKIPS IF NOT ALL ZERO (SOME BIT IS ON IN MASK)
;
;ACCEPTS:	A/	ADDRESS OF MASK
;
;RETURNS+1:	ALL ZERO
;	+2:	NOT ALL ZERO (SOME BIT IN BIT MASK IS ON)

SKPNAZ::MOVSI B,-BITMLN		;NUMBER OF WORDS TO CHECK
SKPN1:	MOVE C,A		;GET BASE ADDRESS
	ADDI C,(B)		;GET NEXT ADDRESS TO LOOK AT
	SKIPE (C)		;IS THIS PART OF MASK ALL ZERO?
	RETSKP			;NO, SO MASK IS NAZ
	AOBJN B,SKPN1		;YES, SO KEEP LOOKING
	RET			;ALL ZERO SO DON'T SKIP
;SKPON SKIPS IF A BIT IS ON (SET) IN A MASK
;
;ACCEPTS:	A/	BIT NUMBER
;		B/	ADDRESS OF MASK
;
;RETURNS+1:	BIT NOT ON
;	+2:	BIT ON

SKPON::	HRLI B,430100		;GET POINTER TO FIRST (0TH) BIT
	ADJBP A,B		;MAKE BYTE POINTER TO EXACT BIT
	LDB C,A			;GET BIT VALUE
	JUMPN C,RSKP		;SKIP RETURN IF 1
	RET			;SINGLE RETURN IF 0

;COPBTS COPIES ONE BIT MASK TO ANOTHER
;
;ACCEPTS:	A/	SOURCE ADDRESS
;		B/	DESTINATION

COPBTS::MOVEI C,BITMLN-1(B)	;GET LARGEST DESTINATION ADDRESS
	HRL B,A			;MAKE BLT POINTER
	BLT B,(C)		;COPY THE MASK
	RET

;SETBIT/CLRBIT SETS/CLEARS ONE BIT IN A MASK
;
;ACCEPTS:	A/	BIT NUMBER TO SET (0 MEANS B0 OF FIRST WORD)
;		B/	ADDRESS OF MASK

CLRBIT::TDZA C,C		;GET 0 TO STUFF INTO BIT
SETBIT::MOVEI C,1		;GET 1 TO STUFF INTO BIT
	HRLI B,430100		;GET POINTER TO FIRST (0TH) BIT
	ADJBP A,B		;MAKE BYTE POINTER TO EXACT BIT
	DPB C,A			;SET OR CLEAR BIT
	RET
;ROUTINES TO TELL MONITOR WE'RE AT TOPS20 LEVEL AND PROGRAM LEVEL.
;THE BATCH SYSTEM NEEDS THESE TO KNOW TO SEND ^C IF WE'RE AT PROGRAM
;LEVEL, AND NEXT LINE OF BATCH JOB INPUT IS SUPPOSED TO GO TO THE
;EXEC.
;
;NOTE:	EXEC IS CAREFUL NOT TO CALL THESE ON EVERY COMMAND, IN ORDER
;TO MINIMIZE NUMBER OF JSYS'S DONE PER COMMAND.

SETMOD::MOVE C,A		;ARG IN C
	JRST SETMD1

SETPRG::TDZA C,C		;SPECIFY PROGRAM LEVEL
SETT20::SETO C,			;SPECIFY TOPS20 LEVEL
SETMD1:	SETO A,			;CURRENT JOB
	MOVX B,.SJT20		;SPECIFY TOPS20 FUNCTION
	SETJB			;TELL MONITOR WHICH LEVEL
	 ERJMP .+1		;FAILED, PROBABLY OLD MONITOR
	RET

;ROUTINE TO GET TOPS20 MODE
;RETURNS RESULT IN A

GETMOD::SETO A,			;CURRENT JOB
	HRROI B,A		;PUT RESULT IN A
	MOVEI C,.JIT20		;SPECIFY THIS FUNCTION
	GETJI			;GET THE INFO FROM SYSTEM
	 ERJMP .+1		;IGNORE ERROR, PROBABLY OLD MONITOR
	RET
;GET CURRENT CLASS AND LOAD AVERAGES
;ACCEPTS:	A/	JOB NUMBER OR -1 FOR CURRENT JOB
;RETURNS:	+1
;		A/	-1 FOR NO CLASS SCHEDULING, OR CLASS NUMBER
;		B/	1-MINUTE LOAD AVERAGE
;		C/	5-MINUTE LOAD AVERAGE
;		D/	15-MINUTE LOAD AVERAGE

GLBLN==10			;ROOM TO GET LOAD AVERAGES

GLOADS::STKVAR <WJOBN,<GLBLK,GLBLN>>
	MOVEM A,WJOBN		;REMEMBER WHICH JOB
	CALL CLSON		;CLASS SCHEDULING ON?
	 JRST GLNO		;NO
	MOVEI A,GLBLN		;ALLOCATE ROOM IN BLOCK
	MOVEM A,.SACNT+GLBLK
	MOVE A,WJOBN		;GET JOB
	MOVEM A,.SAJOB+GLBLK
	MOVEI A,.SKRJP		;READ THIS JOB'S CLASS
	MOVEI B,GLBLK
	SKED%			;SEE WHAT CLASS WE'RE IN
	MOVE A,.SAJCL+GLBLK
	MOVEM A,.SACLS+GLBLK	;MOVE CLASS FOR ASKING FOR LOADS
	MOVEI A,GLBLN		;ALLOCATE ROOM IN BLOCK
	MOVEM A,.SACNT+GLBLK
	MOVEI A,.SKRCS		;NOW GET LOAD AVERAGES FOR THE CLASS
	SKED%
GLN2:	HRLI A,.SA1ML+GLBLK	;MOVE DATA STARTING WITH LOAD AVS
	HRRI A,B		;MOVE INTO AC'S
	BLT A,D			;GET CLASS, 1M LOAD, 5M LOAD, 15M LOAD
	MOVE A,.SACLS+GLBLK	;RETURN CLASS IN A
	RET

GLNO:	MOVEI D,14		;FIRST SYSTEM LOAD AVERAGE IS WORD 14
	GTB .SYSTA
	MOVEM A,.SA1ML+GLBLK	;STORE THE LOAD AVERAGES
	MOVEI D,15
	GTB .SYSTA
	MOVEM A,.SA5ML+GLBLK
	MOVEI D,16
	GTB .SYSTA
	MOVEM A,.SA15L+GLBLK
	HRROI A,-1		;-1 MEANS CLASS SCHEDULING IS OFF
	MOVEM A,.SACLS+GLBLK
	JRST GLN2		;GO RETURN RESULTS
;SKIP IF CLASS SCHEDULER IS ON...
;A CONTAINS STATUS BITS OF SCHEDULER

CLSON::	MOVEI B,C		;ARG BLOCK IN C
	MOVEI A,.SKRCV		;READ STATUS
	MOVEI C,2		;SPECIFY A 2-WORD BLOCK
	SKED%			;GET THE INFO
	MOVE A,D		;RETURN DATA IN A
	TXNN A,SK%STP		;CLASS SCHEDULER ON?
	RETSKP			;YES, SKIP
	RET			;NO, DON'T.
;GET TERMINATOR OF LASS FIELD, RETURNED IN A.  -1 IS RETURNED IF NO
;TERMINATOR HAS BEEN TYPED YET

GETTER::MOVE B,SBLOCK+.CMPTR	;GET POINTER TO REST OF LINE
	SETO A,			;RETURN -1 IF NO TERMINATOR YET
	SKIPLE SBLOCK+.CMINC	;MAKE SURE THERE ARE SOME UNPARSED CHARACTERS
	ILDB A,B		;GET NEXT CHARACTER AFTER PARSED FIELD
	RET

;NACL SKIPS IF NOT AT TOPS20 COMMAND LEVEL.  THIS IS USEFUL IF SOME
;ASYNCHRONOUS CODE HAS SOMETHING TO SAY AND DOESN'T WANT INTERRUPT OTHER
;OUTPUT OR COMMAND INPUT

NACL::	SKIPN CLF		;AT COMMAND LEVEL?
	RETSKP			;NO
	MOVE A,CMRTY		;YES, SEE HOW MANY CHARACTERS IN PROMPT
	CALL FIXPT
	MOVEI C,0		;C WILL ACCUMULATE COUNT
NACL1:	ILDB B,A		;GET NEXT CHARACTER OF PROMPT STRING
	CAIE B,0		;DONE COUNTING WHEN NULL HIT
	AOJA C,NACL1
	MOVE A,CIJFN		;GET INPUT CHANNEL
	RFPOS			;SEE IF USER HAS STARTED TYPING COMMAND YET
	CAIL C,(B)		;HAS HE STARTED TYPING YET?
	RET			;NO, SO DON'T SKIP.  IT'S O.K. TO BLURT MESSAGE NOW
	RETSKP			;HE STARTED TYPING, SO DON'T DISTURB HIM

;ROUTINE WHICH SKIPS IFF LAST FIELD WASN'T TERMINATED WITH ALTMODE.
;THIS ROUTINE ONLY NEEDS TO BE CALLED IN SITUATIONS WHERE IT'S AMBIGUOUS
;AS TO WHETHER USER SHOULD BE PROMPTED FOR NEXT FIELD, OR ALLOWED TO ENTER
;MORE FOR THIS FIELD.  FOR INSTANCE, IN A "COPY" COMMAND, "COPY FOO$":
;SHOULD WE WAIT FOR MORE, DESPITE THE ALTMODE, IN CASE USER WANTS TO
;MAKE IT "COPY FOO,BAR (TO) ...", OR SHOULD WE ASSUME THAT THE ALTMODE
;MEANS DO "COPY FOO (TO)" ?  THE CURRENT ANSWER IS THAT THE ALTMODE MEANS
;GO ON TO THE NEXT FIELD.  OTHERWISE, USER WOULD NEVER SEE "(TO)" PRINTED
;OUT.  ANOTHER EXAMPLE IS A COMMAND LIKE "SET PAGE-ACCESS 1:3$".  ALTHOUGH
;THE USER COULD AT THIS POINT MAKE IT "...1:3,4...", WE ASSUME THAT
;THE ALTMODE MEANS GO ON TO NEXT FIELD, HENCE MAKING IT
;"SET PAGE-ACCESS 1:3 (TO)".  THIS ROUTINE CLOBBERS NO AC'S.

NESC::	ATSAVE			;PRESERVE TEMPY'S
	MOVE A,CMFLG		;GET FLAGS
	TXNE A,CM%ESC		;LAST FIELD END WITH ALTMODE?
	RET			;YES, NO SKIP
	RETSKP			;NO,  SO SKIP
;ROUTINE TO INITIALIZE COMMAND LINE JSYS AND PRINT PROMPT FOR NEW COMMAND.

READY:	CALL SETPMT		;[PCL] Get pointer to prompt string
	JRST READ1		;[PCL] Join common code
READY2:	MOVEM A,CMDACS		;DON'T CLOBBER AC1
	MOVEI A,5		;PCL Precede prompt with space if batch
	SKIPN BATCHF		;THIS PREVENTS CONFUSION WITH OPERATOR MODE
	MOVEI A,4		;PCL Use a dollar sign
	SKIPN PRVENF		;USE @ IF NOT ENABLED
	MOVEI A,3		;PCL One prompt for regular command
	CALL SETPM2		;[PCL] Get pointer to (subcommand) prompt
	JRST READ1		;[PCL] Join common code
SETPMT:	MOVEM A,CMDACS		;[PCL] DON'T CLOBBER ANY AC'S
	MOVEI A,2		;[PCL] Assume enabled batch
	SKIPN BATCHF		;THIS PREVENTS CONFUSION WITH OPERATOR MODE
	MOVEI A,1		;[PCL] Use a dollar sign
	SKIPN PRVENF		;USE @ IF NOT ENABLED
	SETZ A,			;[PCL] One prompt for regular command
SETPM2:	MOVEM B,CMDACS+1	;[PCL] Get another register
	HRROI B,REDPMT(A)	;[PCL] Point to the standard prompt
	SKIPE PCLPMT(A)		;[PCL] Is one provided by PCL?
	HRRO B,PCLPMT(A)	;[PCL] Yes, point to that one
	MOVE A,B		;[PCL]
	MOVE B,CMDACS+1		;[PCL]
	RET			;[PCL]
;ENTER HERE FOR CUSTOM PROMPT CHARACTERS:

READ1::	MOVEM A,CMRTY		;SET UP PROMPT BUFFER
	MOVEM A,SVPRMT		; AND REMEMBER THE POINTER FOR "TAKE, ECHO"
	POP P,REPARA		;REMEMBER WHERE TO REPRASE TO
	MOVE A,CMDACS		;GET SAVED AC1 (SEE %$TYPE:)
	MOVEM 17,CMDACS+17	;SAVE AC17 AWAY
	MOVEI 17,CMDACS		;MAKE BLT POINTER 0,,CMDACS
	BLT 17,CMDACS+16	;SAVE REST TO AC'S
	MOVE 17,CMDACS+17	;LEAVE AC17 INTACT
	MOVE A,JBUFP		;GET CURRENT LOCATION ON JFN STACK
	MOVEM A,.J		;REMEMBER WHERE WE ARE FOR REPARSE
	HRR A,COJFN		;GET OUTPUT JFN
	HRL A,CIJFN		;AND INPUT
	MOVEM A,CMIOJ
READ2:	HRROI A,[0]		;PCL GET NULL STRING
	MOVE B,TAKCUR		;GET CURRENT SETTINGS
	TXNN B,TKTERF		;SKIP IF INPUTTING FROM TERMINAL
	MOVEM A,CMRTY		;NO PROMPT UNLESS INPUTTING FROM TERMINAL
	MOVX A,CMINI		;DO INITIALIZATION, PRINT PROMPT
	MOVEM A,CMFNP
	MOVEI B,FBLOCK		;SPECIFY FUNCTION BLOCK ADDRESS
	CALL FIELDX		;TYPE THE PROMPT
	MOVE A,CIJFN		;PCL See if executing stored command
	CAIE A,.NULIO		;PCL Are we?
	JRST READ3		;PCL No
	CALL PCMXCT		;PCL Yes, go get a line of command text
	 JRST [	HRR A,COJFN	;PCL End of execution, fix up I/O JFNs
		HRL A,CIJFN	;PCL
		MOVEM A,CMIOJ	;PCL
		MOVX A,OURNAM	;PCL Fix the system name
		MOVE B,A	;PCL
		SETSN		;PCL Since we are going back to TI state
		 TRN		;[PCL]
		CALL SETPMT	;[PCL] Get the correct prompt string
		MOVEM A,CMRTY	;[PCL] Set it up
		JRST READ2]	;PCL And start again
READ3:	MOVE A,CMDACS+A		;PCL
	MOVE B,CMDACS+B		;RESTORE AC'S WE USED
	MOVE C,CMDACS+C		;LEAVE ALL AC'S AS WE FOUND THEM
	JRSTF @REPARA		;RETURN TO CALLER
;PCL Standard prompt strings

REDPMT::ASCIZ /@/		;Disabled
	ASCIZ /$/		;Enabled
	ASCIZ / $/		;Enabled batch needs space because of operator
	ASCIZ /@@/		;Disabled subcommand
	ASCIZ /$$/		;Enabled subcommand
	ASCIZ / $$/		;Enabled batch subcommand

;GUIDE WORD HANDLER, INVOKED WITH "NOISE" MACRO

%NOI:	ATSAVE			;DON'T CLOBBER AC'S
	HRRO A,40		;GET POINTER TO GUIDE STRING
	MOVEM A,CMDAT		;SET UP GUIDE STRING
	MOVX A,CMNOI		;SPECIFY NOISE FUNCTION
	MOVEM A,CMFNP
	MOVEI B,FBLOCK
	CALL FLDSKP		;READ THE GUIDE WORDS
	 CMERRX
	RET
;ROUTINES TO TURN IPCF INTERRUPTS ON AND OFF.  INTS MUST BE TURNED OFF IN
;VARIOUS PLACES TO AVOID RECEIVING AN IPCF MESSAGE WITHOUT KNOWING ABOUT IT.

IPCON::	SOSLE IINTDF		;DECREMENT AMOUNT OF NESTING
	RET			;SOMEONE ELSE STILL WANTS IPCOFF!
	SETOM IPCALF		;ALLOW IPCF INTERRUPTS AGAIN
	MOVEI A,.FHSLF		;TALK TO OURSELF
	MOVX B,1B<IPCCHN>	;PREPARE TO SIMULATE IPCF INTERRUPT
	SKIPE IPCWTF		;IS THERE A WAITING INTERRUPT?
	IIC			;YES, FORCE AN INTERRUPT
	RET

IPCOFF::AOS IINTDF		;NEST DEEPER INTO OFFNESS
	SETZM IPCALF		;THIS FLAG 0 MEANS DON'T ALLOW IPCF INTERRUPT
	RET

;PION/PIOFF CONTROL PRIORITY INTERRUPT, TURNING IT ON AND OFF.
;USE PIOFF TO PREVENT ^C, AND PION TO ALLOW IT AGAIN.
;THESE ROUTINES EXPLICITLY DO NOT CLOBBER THE TEMPORARY AC'S, SO THAT CALLERS
;CAN HAVE ^C TURNED OFF FOR AS LITTLE TIME AS POSSIBLE

PION::	SOSLE INTDF		;DECREMENT AMOUNT OF NESTING
	RET			;SOMEONE ELSE STILL WANTS NO ^C, DO NOTHING MORE
	SETOM ACTRCF		;ALLOW ^C
	TLNE Z,CTLCF1		;DID THE USER ALREADY TYPE ^C?
	JRST .CTRLC		;YES
	RET

PIOFF::	AOS INTDF		;INCREMENT AMOUNT OF NESTING
	SETZM ACTRCF		;DISALLOW ^C
	TLZ Z,CTLCF1!CTLCF2	;FORGET ABOUT CONTROL-C'S ALREADY TYPED
	RET
;PRVCK
;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE
; REQUIRED AS INDICATED BY BITS IN B, GENERALLY FROM
; A KEYWORD TABLE.
;SKIPS UNLESS SPEC CAP(S) ARE REQUIRED BUT USER HAS NONE OF THEM.
;USES: FORK COMMAND (XCMD1.MAC), %KEYWD (JUST ABOVE).

PRVCK:	TXNN B,WHLU+OPRU+ERRU	;ANY PRIVILEGES WANTED?
	RETSKP			;NO - RETURN SUCCESS
	SKIPN CUSRNO		;MUST BE LOGGED IN TO HAVE PRIVILEGES
	RET
	ATSAVE
	MOVE D,B
	MOVEI A,.FHSLF
	RPCAP			;READ CAPABILITIES ENABLED FOR THIS PROCESS
	TXNN D,WHLU		;CHECKING FOR WHEEL?
	JRST PRVCK1		;NO - SKIP THIS
	TXNE	C,SC%WHL	;YES - HAS USER GOT WHEEL?
	RETSKP			;YES - SUCCESS
PRVCK1:	TXNN D,OPRU		;CHECKING FOR OPERATOR?
	JRST PRVCK2		;NO - SKIP THIS
	TXNE	C,SC%OPR	;YES - HAS USER GOT OPERATOR?
	RETSKP			;YES - SUCCESS
PRVCK2:	TXNE D,ERRU		;CHECKING FOR "CONFIDENTIAL INFORMATION"?
	TXNN	C,SC%CNF	;YES - HAS USER GOT IT?
	RET			;WANTS AND DOESN'T HAVE - FAILURE
	RETSKP			;WANTS AND HAS - SUCCESS
;USUBCO UUO, INVOKED BY SUBCOM MACRO
;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO
;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS
;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST

%SBCOM:	STKVAR <OCERET,OJBUFP,KADDR,INITR>
	MOVE A,CERET
	MOVEM A,OCERET		;SAVE OLD LOCATION FOR ERROR DISPATCH
	MOVE A,.JBUFP
	MOVEM A,OJBUFP		;SAVE OLD JFN STACK POINTER BOUNDARY
	HRRZ A,40		;GET KEYWORD TABLE ADDRESS ADDRESS
	MOVE B,(A)		;GET TABLE ADDRESS
	MOVEM B,KADDR
	MOVE B,1(A)		;GET INIT ROUTINE ADDRESS
	MOVEM B,INITR
	MOVEI A,[CALL FLJFNS	;ON ERROR, FLUSH JFN FOR ERRONEOUS SUBCOMMAND
		 JRST SBCOM1]	;THEN GO AND PROMPT FOR NEXT SUBCOMMAND
	MOVEM A,CERET		;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE
	MOVEM .FP,.PP		;SAVED, IN CASE OF ERROR.
	MOVEM P,.P		;REMEMBER STACK POINTER IN CASE ERROR DURING SUBCOMMAND
SBCOM1:	MOVE A,JBUFP
	MOVEM A,.JBUFP		;PREVENT ERRONEOUS SUBCOMMANDS FROM CAUSING COMMAND JFNS TO BE FLUSHED
	CALL READY2		;TYPE 2 READY CHARACTERS: @@ OR !!
	MOVEI B,[FLDDB. .CMCFM,,,,,FBLOCK]
	MOVE C,KADDR		;GET ADDRESS OF KEYWORD TABLE
	MOVEM C,CMDAT		;STORE ADDRESS OF KEYWORD TABLE
	MOVX A,CMKEY		;SPECIFY KEYWORD FUNCTION, NO SPECIAL FLAGS
	MOVEM A,CMFNP		;STORE FUNCTION
	CALL FLDSKP		;READ TYPED IN FIELD
	 CMERRX <Carriage return or subcommand required>
	CALL GETKEY		;GET KEYWORD INFO
	TRNN P3,-1
	JRST SBCOM9		;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS
	SKIPE INITR		;IS THERE AN INITIALIZATION ROUTINE?
	CALL @INITR		;YES, EXECUTE IT
	CALL (P3)		;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
	CALL ECHCMD		;NEED TO TURN ECHO ON FOR THE TAKE
	JRST SBCOM1		;GO GET ANOTHER

SBCOM9:	MOVE A,OJBUFP		;GET OLD JFN BOUNDARY
	MOVEM A,.JBUFP		;RESTORE AS BEFORE SUBCOMMANDS
	MOVE A,OCERET		;GET OLD ERROR DISPATCH ADDRESS
	MOVEM A,CERET
	RET
;CONF
;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE
;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS.

;IF TYPIST TYPES "?", IT TELLS HIM THAT IT'S WAITING FOR
;CONFIRMATION.  IF HE STARTS WITH ! OR ; (RECOGNIZED COMMENT CHARACTERS
;DUE TO PHASE OF MOON AT TIME OF THIS DOCUMENTATION), IT ALLOWS
;A COMMENT TO PRECEDE THE CONFIRMATION.  (CONFIRMATION ITSELF IS
;CARRIAGE RETURN, LINEFEED, CONTROL-L ETC.)  IF A NON-COMMENT PRECEDES
;THE CONFIRMATION, AN ERROR MESSAGE RESULTS.

;FCONF PRINTS [CONFIRM] THEN FORCES FURTHER CONFIRMATION

FCONF::	PROMPT <[Confirm]>
FCONFA::

;CONF

CONF:	ATSAVE			;SAVE TEMPORARIES
	CRRX <Confirm with carriage return>
	 CMERRX			;BAD CONFIRMATION TYPED
	RET			;GOOD CONFIRMATION, RETURN.
;SPRTR
;READS END OF LINE, DETECTING COMMA FOR SUBCOMMANDS.  TAKES non-skip RETURN IF COMMA THEN
;CARRIAGE RETURN.  TAKES SKIP IF JUST CARRIAGE RETURN.

SPRTR:	ATSAVE			;DON'T CLOBBER AC'S
	COMMAX <Confirm with carriage return or comma to enter subcommands>
	 JRST SPR1		;NOT COMMA, MAYBE END OF INE
	CRRX <Carriage return to enter subcommands>
	 ERROR <Carriage return required after comma to enter subcommands>
	RET			;REGULAR SKIP IF COMMA SEEN

SPR1:	CRRX			;NO COMMA, CHECK FOR END OF LINE
	 ERROR <Comma or carriage return required>
	RETSKP			;TYPIST ENDED LINE WITH NO COMMA

;GET HERE FOR LINE REPARSE, WHICH HAPPENS WHEN PREVIOUSLY
;PARSED FIELDS ARE REQUIRED TO BE REPARSED.

REPARS:	MOVE A,.J		;FIX JFN STACK
	MOVEM A,.JBUFP		;RESTORE JFN STACK FRAME
	CALL FLJFNS		;GET RID OF ANY JFN'S THAT WERE USED FOR COMMAND
	CALL DOECHO		;ECHOING MAY HAVE BEEN TURNED OFF FOR PASSWORD
	MOVSI 17,CMDACS		;MAKE BLT POINTER CMDACS,,0
	BLT 17,17		;RESTORE AC'S TO HOW THEY WERE WHEN THIS PART OF COMMAND STARTED
	JRSTF @REPARA		;RETURN TO BEGINNING OF COMMAND LINE
;EOF WHILE READING COMMAND FILE

CCHEOF:	MOVE A,CIJFN
	CAIE A,.NULIO		;PCL Command generation?
	JRST CCHEFN		;PCL No
	CALL PCMXCT		;PCL Continue command procedure
	 JRST CMDIN4		;PCL It ran to completion, generating nothing
	JRST FIELDR		;PCL It did a DoCommand, retry the COMND%

CCHEFN:	CALL CIOREL
	JFCL
	ETYPE < End of %1S
>
	CLOSF			;CLOSE INPUT SIDE
	 CALL JERR		;SHOULDN'T FAIL
	SKIPN LGORET		;DOING LOGOUT.CMD FILE?
	JRST CMDIN4		;NO, GO BACK FOR NEXT COMMAND
	JRST @LGORET		;YES, RETURN TO LOGOUT CODE IN THIS CASE
;ROUTINE TO POP BACK TO LAST EXEC INPUT STREAM.  RETURNS WITH JFN
;OF OLD INPUT IN AC1.
;IT SKIP RETURNS IFF THERE WAS NOTHING TO DELETE (I.E. ONLY ONE
;SET OF JFNS ON THE COMAND STREAM STACK)
;IT CLOSES THE OUTPUT SIDE, AND LEAVES RIJFN HOLDING THE INPUT
;SIDE BUT INPUT ISN'T CLOSED YET, SO THAT ERROR MESSAGES ETC. MAY
;DO JFNS ON INPUT JFN BEFORE CLOSING IT.

CIOREL::STKVAR <OLDJFS>
	MOVE A,TAKLEN		;SEE HOW MANY ITEMS ARE ON STACK
	MOVE B,TAKJFN-1(A)	;GET SET OF JFNS BEING POSSIBLY FLUSHED
	MOVEM B,OLDJFS
	SOJE A,RSKP		;SKIP RETURN IF ONLY ONE
	MOVEM A,TAKLEN		;STORE REDUCED LENGTH
	MOVE A,CIJFN		;SEE WHERE READING FROM
	CAIN A,.NULIO		;PCL?
	CALL PCMPOS		;NO, POP COMMAND PROCEDURE CONTEXT
	CALL FIXIO
	HRRZ A,OLDJFS
	CAME A,COJFN		;DON'T CLOSE OUTPUT IF SAME!
	TXNE A,.TTDES		;[PCL] Don't close if a terminal designator
	TRNA			;[PCL] Either same or PTY designator
	CLOSF			;CLOSE OUTPUT BUT NOT INPUT YET
	 ERCAL JERR
	HLRZ A,OLDJFS		;RETURN INPUT JFN IN A
	RET

;ROUTINE TO GET RID OF ALL COMMAND JFNS.  THIS HAPPENS, FOR INSTANCE,
;IF USER TYPES ^C DURING "TAKE" COMMAND PROCESSING
;SKIPS IFF THERE ARE NONE TO GET RID OF

CLRIO:	CALL CIOREL		;CLOSE STREAM
	 CAIA			;THERE WAS AT LEAST ONE TO CLOSE
	RETSKP			;NONE TO CLOSE, TAKE SKIP
	PUSH P,A		;SAVE JFN IN CASE LAST ONE
CLR1:	CALL CIOREL		;CLOSE NEXT ONE
	 JRST CLR2		;NEXT ONE WASN'T LAST
	POP P,A			;IT WAS THE LAST ONE, SO RETURN IT
	RET

CLR2:	EXCH A,(P)		;GET THE ONE THAT WASN'T LAST
	CLOSF			;CLOSE THE INPUT SIDE
	 CALL JERR		;SHOULDN'T FAIL
	JRST CLR1		;LOOP BACK TO CLOSE THE REST
;UUO DISPATCH TABLE

CUUOT:	EXP %ERR,%ETYPE,%KEYW
        EXP %NOI,%$TYPE,%LERRO
	EXP 0,%$ERR,%ETYPE,0
	EXP %PRINT,%TRAP,%.$ERR
	EXP %SBCOM
%%U==.-CUUOT
DEFINE XX(UUL)
<
%%X==.
RELOC CUUOT+<U'UUL>_-^D23-20	;;BITS 0-8 CAN'T BE 0
	UUL'$
IFG .-CUUOT-%%U,<%%U==.-CUUOT>
RELOC %%X
>
ULIST
RELOC CUUOT+%%U			;LEAVE ROOM FOR ALL UUO ENTRIES

;UUO DISPATCHER

CUUO::	MOVEM A,CTUUO		;SAVE AC A
        HLRZ A,40		;GET THE OP-CODE
        LSH A,-5
        HRRZ A,CUUOT-20(A)	;GET THE DISPATCH ADDRESS FOR THIS OP-CODE
        EXCH A,CTUUO		;SAVE IT AND RESTORE AC A
        JRST @CTUUO		;DISPATCH TO UUO-HANDLING ROUTINE

;ROUTINE INVOKED BY "$TYPE <FOO>" MACRO.  IT STARTS A NEW LINE
;PART OF THE COMMAND, WITH THE PROMPT BEING "FOO".

%$TYPE:	MOVEM A,CMDACS		;WE DON'T WANT TO CLOBBER ANYTHING
	MOVEI A,@40		;GET ADDRESS OF PROMPT STRING
	HRLI A,440700		;MAKE BYTE POINTER
	CALLRET READ1		;TYPE PROMPT AND RETURN TO PROGRAM

;SEE ALSO "%ETYPE" IN S3.MAC
;ROUTINES FOR INPUTTING FIELDS OF COMMAND.  INVOKED BY MACROS.
;THESE ROUTINES ARE NAMED $FOO AND %FOO.  ROUTINE $FOO ASSUMES
;THE EFFECTIVE ADDRESS OF THE UUO CONTAINS THE HELP STRING FOR
;THE FIELD.  %FOO ASSUMES THAT THE PREVIOUS HELP STRING IS TO
;BE USED.

;DECIMAL NUMBER...

DEC$:	CALL GETHLP		;SET UP HELP MESSAGE
	MOVEI A,5+5		;RADIX
NUM13:	MOVEM A,CMDAT
	MOVX A,CMNUM
	CALLRET $WORK		;INPUT THE NUMBER AND SKIP OR NORMAL RETURN

;OCTAL NUMBER

OCT$:	CALL GETHLP
	MOVEI A,8		;OCTAL RADIX
	JRST NUM13		;JOIN COMMON CODE
;TIME

TIME$:	CALL GETHLP
	MOVX A,CM%ITM		;TIME ONLY
	MOVEM A,CMDAT
	MOVX A,CMTAD		;TIME AND DATE FUNCTION
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN

;DATE AND TIME
;THE POSSIBILE THINGS ARE:
;
;1)	SPECIFIC DATE AND TIME (OR JUST TIME, WHICH ASSUMES TODAY)
;
;2)	"+" OR "-" FOLLOWED BY AMOUNT OF TIME, WHICH MEANS NOW + - AMOUNT
;
;3)	KEYWORD, FOLLOWED BY KEYWORD-DEPENDENT DATA

DA%DAY==1B18			;BIT TO MEAN DAY OF THE WEEK

;KEYWORD TABLE FOR DATE AND TIME

$DKEYS:	TABLE
	T FRIDAY,,DA%DAY+4
	T MONDAY,,DA%DAY+0	;TOO BAD THIS HAS TO BE ALPHABETICAL
	T SATURDAY,,DA%DAY+5
	T SUNDAY,,DA%DAY+6
	T THURSDAY,,DA%DAY+3
	T TODAY
	T TUESDAY,,DA%DAY+1
	T WEDNESDAY,,DA%DAY+2
	TEND
DTR$:	MOVEI A,1		;SAY WE WANT TIME RELATIVE TO NOW
	JRST DT1

DT$:	TDZA A,A		;SAY WE WANT TIME IN THE FUTURE
DTP$:	MOVNI A,1		;SAY WE WANT TIME IN THE PAST
DT1:	TRVAR <RETBTS,TODAY,SENSE,DAYWEK,NOW,TOMORO,BTIME,<STRNG0,10>,DAYFLG>
	MOVEM A,SENSE		;REMEMBER WHETHER FUTURE OR PAST
	SETZM RETBTS		;INITIALLY, NO RETURN BITS
	CALL GETHLP
	GTAD			;GET CURRENT TIME AND DATE
	MOVEM A,NOW
	MOVSI B,1
	ADD B,A			;GET TOMORROW SAME TIME IN A
	CALL	TSTDST		;correct for DST
	HRROI A,STRNG0		;WRITE TO SCRATCH
	MOVX C,OT%NTM		;WE WANT ONLY DATE
	ODTIM			;GET STRING FOR TOMORROW'S DATE
	HRROI B,[ASCIZ / 0:0:0/]
	MOVEI C,0
	SOUT			;MAKE DATE AND TIME FOR BEGINNING OF TOMORROW
	HRROI A,STRNG0		;POINT AT FULL STRING
	MOVEI B,0		;NO SPECIAL FORMAT
	IDTIM			;GET INTERNAL FORMAT FOR TOMORROW
	 CALL JERR		;SHOULDN'T FAIL
	MOVEM B,TOMORO		;REMEMBER VALUE FOR TOMORROW
	SUB B,[1B17]		;CREATE BEGINNING OF TODAY
	MOVEM B,TODAY
	MOVX A,CM%IDA+CM%ITM
	MOVEM A,CMDAT		;FIRST FUNCTION IN CHAIN IS DATE AND TIME
	MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
		FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
		FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter amount of time from now>,,[
		FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
	SKIPGE SENSE		;DIFFERENT CHOICES FOR DATE AND TIME IN PAST
	MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
		FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
		FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /-/]>,<"-" to enter amount of time in past>,,[
		FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
	CALL $WORK
	 RET			;BAD INPUT TYPED
	LDB D,[331100,,(C)]	;GET FUNCTION FLAVOR
	CAIN D,.CMKEY		;KEYWORD?
	JRST DAKEY		;YES, GO HANDLE IT
	CAIN D,.CMTOK		;"+" OR "-"?
	JRST GETPLM		;YES, GO HANDLE IT
	MOVE D,.CMDAT(C)	;GET CONTROL BITS
	MOVX A,DATBIT		;GET BIT SAYING USER TYPED A DATE
	TXNE D,CM%IDA		;IS IT A DATE?
	JRST	[IORM A,RETBTS	;YES, REMEMBER
		 JRST DTEXIT]	;GO DO STANDARD EXIT
	SKIPLE A,SENSE		;IS TIME INDEPENDENT?
	 JRST DTEXIT		;YES, NO FIXUP NEEDED
	MOVE	C,B		;save time
	CAMG B,NOW		;COMPUTE VALUE TO ADD
	addi	a,1		;make it next day
	HRLZS A			;PUT VALUE IN LEFT HALF
	ADD B,A			;FIX UP DATE-TIME
	move	a,c		;get DAT for today back
	call	tstdst		;correct for DST
	JRST DTEXIT		;TAKE STANDARD EXIT

GETPLM:	CALL GETAMT		;GOT A DATE IN THE PAST OR FUTURE -  GET AMOUNT
	 RET			;SYNTAX ERROR
	SKIPGE SENSE
	MOVN A,A		;HANDLE "DIRECTORY SINCE -4:0:0"
	ADD A,NOW		;ADD TO NOW
	MOVE B,A		;RETURN RESULT IN B AND FALL INTO EXIT
	MOVE	A,NOW		;get current DAT
	CALL	TSTDST		;correct for DST
	;...

;DTEXIT is the common exit for time-and-date parsing.  It returns bits in
;A declaring what the user typed.

DTEXIT:	MOVE A,RETBTS		;GET RETURN BITS
	RETSKP			;SKIP TO DENOTE SUCCESS
;ROUTINE TO INPUT AN AMOUNT OF TIME.
;RETURNS:
;	+1	SYNTAX ERROR
;	+2	A/	INTERNAL FORMAT
;		B/	SECONDS

GETAMT::STKVAR <CTIM>
	DECX <Amount of time in form hh:mm>
	 RET			;GIVE UP IF CAN'T READ HOURS
	IMULI B,^D3600		;CHANGE TO SECONDS
	MOVEM B,CTIM		;SAVE NUMBER OF SECONDS
	COLONX <Colon to separate hours and minutes>
	 JRST ONENUM		;ONLY ONE NUMBER BEING TYPED
	DECX <Minutes>
	 RET			;ERROR IF NO NUMBER AFTER COLON
	IMULI B,^D60		;CHANGE MINUTES TO SECONDS
	ADDM B,CTIM		;ACCUMULATE RESULT
	COLONX <Colon, if seconds are being entered>
	 JRST NOSECS		;NO SECONDS FORTHCOMING (THAT'S O.K.)
	DECX <Seconds>
	 RET			;ERROR IF SECOND COLON AND NO SECONDS
	ADD B,CTIM		;GET TOTAL SECONDS
T22:	MOVEM B,CTIM		;REMEMBER SECONDS
	MUL B,[1B17]		;IN INTERNAL FORMAT, RIGHT HALF OVER 1B17 IS FRACTION OF A DAY
	DIV B,[^D86400]		;DIVIDE BY SECONDS IN A DAY
	CAILE C,^D86400/2	;ROUND
	AOJ B,
	MOVE A,B		;RETURN RESULT IN A
	MOVE B,CTIM		;RETURN SECONDS IN B
	RETSKP

ONENUM:	MOVE B,CTIM		;GET NUMBER OF SECONDS GIVEN HOURS
	IDIVI B,^D60		;TREAT NUMBER AS THOUGH IT WERE ORIGINALLY MINUTES
	JRST T22

NOSECS:	MOVE B,CTIM		;NO SECONDS FORTHCOMING
	JRST T22
;KEYWORD TYPED AFTER /AFTER:

DAKEY:	CALL GETKEY		;GET KEYWORD DATA
	TXNN P3,DA%DAY		;DAY OF THE WEEK?
	JRST (P3)		;NO, DO SPECIFIC THING
	ANDI P3,7		;DAY OF THE WEEK, KEEP ONLY IT
	MOVEM P3,DAYWEK		;REMEMBER DAY
	MOVE B,TOMORO		;PUT TOMORROW REAL EARLY MORNING IN B
	MOVEI D,0		;NO SPECIAL BITS
	ODCNV			;SEE WHAT DAY OF WEEK TOMORROW IS
	SKIPN SENSE
	JRST [	MOVNI C,-1(C)	;NEGATE DAY OF WEEK AND FLUSH DAY OF MONTH
		HRRE C,C	;FOR SUNDAY, GET RID OF 777777 IN LEFT HALF
		ADD C,DAYWEK	;GET NUMBER OF DAYS FROM TOMORROW IS DESIRED
		CAIGE C,0
		ADDI C,7	;FOR FUTURE, "SUBMIT /AFTER:MONDAY" MEANS NEXT TUESDAY OR LATER
		JRST SL]
	SUB C,DAYWEK
	MOVNI C,(C)		;GET NEGATIVE NUMBER OF DAYS BEFORE TOMORROW WE WANT, AND FLUSH DAY OF MONTH
	HRRE C,C		;IN CASE C WAS NEGATIVE BEFORE
	SKIPLE SENSE		;RELATIVE TO NOW?
	 JRST SL		;YES - CHECK LATER
	CAIL C,0
	SUBI C,7		;FOR PAST, "DIRECTORY SINCE MONDAY" MEANS FILES WRITTEN LAST MONDAY OR MORE RECENTLY"
SL:	ASH C,22		;SHIFT INTO POSITION FOR INTERNAL FORMAT
	ADD C,TOMORO		;GET INTERNAL REPRESENTATION FOR DAY SPECIFIED
	MOVEM C,BTIME
	SETOM	DAYFLG		;note that day-of-week was specified
	JRST DAPLSQ		;MAYBE USER TYPING "+" AFTER THE DAY
;	Daylight Saving Time correction subroutine
;
;	calling sequence:
;	A/ current date and time
;	B/ target date and time
;	CALL	TSTDST
;
;	Returns:
;	 +1 always with
;	A/ current date and time
;	B/ target date and time corrected for DST change over
TSTDST:	STKVAR	<TDAT>		;make a storage spot
	MOVEM	B,TDAT		;save target date
	MOVE	B,A		;copy today's date and time to B
	SETZM	D		;clear D for ODCNV
	ODCNV			;do it
	TXNN	D,IC%ADS	;is DST applied (for current time)?
	JRST	[MOVE	B,TDAT	;no, get target date and time
		 SETZM	D	;clear ac D
		 ODCNV		;do it
		 MOVE	B,TDAT	;get target date back
		 TXNE	D,IC%ADS ;target date and time during DST?
		 SUBI	B,25253 ;yes, convert time to DST.
		 RET]		;return proper date and time
	MOVE	B,TDAT		;no, lets see if target date in in DST
	SETZM	D		;clear ac D
	ODCNV			;do it
	MOVE	B,TDAT		;get target date and time back
	TXNN	D,IC%ADS	;is target date in DST?
	ADDI	B,25253		;yes, correct for DST change over
	RET			;return proper date and time

;USER HAS TYPED /AFTER:TODAY OR SINCE TODAY

.TODAY:	SETZM	DAYFLG		;SAY WE DIDN'T DO A DAY OF THE WEEK
	MOVE A,TOMORO		;GET VALUE FOR TOMORROW
	SKIPE SENSE
	MOVE A,TODAY		;FOR TIME IN PAST, BASE IS BEGINNING OF TODAY
	MOVEM A,BTIME		;REMEMBER IT AS BASE VALUE
DAPLSQ:	MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<Optional "+" to add amount of time>]
	CALL FLDSKP		;IS USER TYPING "+"?
	JRST NOPLUS		;NO
	CALL GETAMT		;YES, GET AMOUNT OF TIME
	 RET			;IF ERROR, NON-SKIP
	ADD A,BTIME
	MOVE B,A		;RETURN INTERNAL DATE-AND-TIME IN B
DAA1:	SKIPG SENSE		;RELATIVE TO NOW?
	 JRST DTEXIT		;NO - DONE
	CAMG B,NOW		;TIME IN FUTURE?
	 ADD B,[7B17]		;NO - JUMP AHEAD 1 WK
	JRST DTEXIT		;RETURN

NOPLUS:	MOVE	B,BTIME		;NO PLUS, SO NO MODIFICATION OF BASE TIME
	MOVE	A,DAYFLG	;GET FLAG THAT DAY-OF-WEEK WAS SPECIFIED
	JUMPGE	A,DAA1		;WAS FLAG SET? NO, CONTINUE
	MOVE	A,NOW		;YES, GET CURRENT DATE AND TIME
	CALL	TSTDST		;ADJUST IT FOR DST CROSS OVER
	JRST DAA1		;CONTINUE...
;DATE AND TIME OR INTERVAL IN DAYS "+NNN"

DTIV$:	CALL GETHLP
	MOVX A,CM%IDA+CM%ITM	;FIRST FUNCTION IN CHAIN IS D&T
	MOVEM A,CMDAT
	MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
		FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
		FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter interval in number of days>,,]]]]
	CALL $WORK
	 RET			;BAD INPUT
	LDB C,[331100,,(C)]	;GET FLAVOR OF FUNCTION
	CAIE C,.CMTOK		;"+"?
	RETSKP			;NO, A VALID DATE & TIME WAS GIVEN
	DECX <Interval in number of days>
	 RET			;INVALID
	RETSKP			;RETURN # OF DAYS
;QUOTED STRING

QUOTE$:	CALL GETHLP
	MOVX A,CMQST		;QUOTED STRING FUNCTION CODE
	CALLRET $WORK		;OUTPUT IT AND SKIP OR NORMAL RETURN

;USER NAME

USERS$:	SKIPA A,[CM%DWC]	;ALLOW WILDCARDING
USER$:	MOVEI A,0		;NO WILDCARDING
	MOVEM A,CMDAT		;STORE IN DATA FIELD
	CALL GETHLP
	MOVX A,CMUSR		;USER NAME FUNCTION
	CALLRET $WORK

;DIRECTORY NAME

DIRS$:	MOVX A,CM%DWC		;ALLOW WILDCARDING
	MOVEM A,CMDAT		;STORE IN DATA FIELD
DIR$:	CALL GETHLP
	MOVX A,CMDIR
	CALLRET $WORK

;STRUCTURE NAME, LIKE DEVICE BUT NEEDN'T EXIST

STR$:	CALL GETHLP
	MOVX A,CMDEV!CM%PO
	CALLRET $WORK

;DEVICE

DEV$:	CALL GETHLP
	MOVX A,CMDEV
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN
;FAKE NODE, SYNTAX CORRECT ONLY

FNODE$:	CALL GETHLP
	MOVX A,CMNOD!CM%PO!CM%NSF
	CALLRET $WORK

;REAL NODE, MUST BE KNOWN BY SYSTEM

RNODE$:	CALL GETHLP
	MOVX A,CMNOD!CM%NSF
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN

;FILE SPECIFICATION

FILE$:	CALL GETHLP
	MOVX A,CMFIL		;SPECIFY FILE FUNCTION
	CALLRET $WORK

;READ ENTIRE REST OF LINE

LINE$:	CALL GETHLP
	MOVX A,CMTXT		;TEXT FUNCTION
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN

;CONTROL-E

CTRLE$:	HRROI A,[ASCIZ //]	;EXPECTED FIELD
	JRST CHAR		;JOIN COMMON CODE

;PARSE A COMMA

COMMA$:	CALL GETHLP
	MOVX A,CMCMA		;COMMA FUNCTION
	CALLRET $WORK

;PARSE A SLASH

SLASH$:	HRROI A,[ASCIZ ./.]
	JRST CHAR

;PARSE A BACKSLASH

BSLSH$:	HRROI A,[ASCIZ .\.]
	JRST CHAR
;PARSE A DOT

DOT$:	HRROI A,[ASCIZ /./]
	JRST CHAR

;PARSE A COLON

COLON$:	HRROI A,[ASCIZ /:/]
	JRST CHAR

;PARSE CHARACTER PASSED IN AC1

CHAR$:	STKVAR <STRNG>		;STORAGE FOR CHARACTER STRING
	ROT A,-7		;MAKE ASCIZ STRING
	MOVEM A,STRNG		;PUT IT ON STACK
	HRROI A,STRNG		;POINT TO STRING
	JRST CHAR		;FINISH UP

;PARSE A FIELD WHICH IS JUST "*"

STAR$:	HRROI A,[ASCIZ /*/]	;EXPECTED FIELD
CHAR:	MOVEM A,CMDAT
	CALL GETHLP
	MOVX A,CMTOK
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN

;PARSE A HYPHEN

DASH$:	HRROI A,[ASCIZ /-/]
	JRST CHAR		;USE COMMON CODE

;READ AND PARSE NEXT NON-BLANK CHARACTER

CMDCHT::STKVAR <STRNG>
	CALL CMDCHR		;READ NEXT NON-BLANK CHAR FROM COMMAND
	ROT A,-7		;MAKE ASCIZ STRING
	MOVEM A,STRNG
	CALL CMDBAK		;BACKUP OVER CHAR JUST READ
	HRROI A,STRNG
	JRST CHAR		;PARSE THAT

	ENDSV.
;SYMBOLIC ADDRESS
;This can be of the form "x" or "x,," or "x,,y", all of which can be
;symbolic.

ADDR$:	STKVAR <LHVAL>
	CALL ADDPRT		;GET A PART
	 RET			;FAILED
	MOVEM A,LHVAL		;REMEMBER LEFT HALF
	CALL NESC		;USER TYPE ESCAPE?
	 JRST NC		;YES, EXIT NOW SO GUIDE WORDS WILL BE SEEN
	MOVEI B,[FLDDB. .CMTOK,,<-1,,[ASCIZ /,,/]>]
	CALL FLDSKP		;SEE IF TWO COMMAS NEXT
	 JRST NC		;NO COMMAS, SO THERE'S ONLY ONE EXPRESSION
	CALL NESC		;USER TYPE ESCAPE?
	 JRST NC1		;YES - EXIT NOW SO GUIDE WORDS WILL BE SEEN
	CALL ADDPRT		;GET THE PART AFTER THE COMMAS
	 JRST NC1		;FAILED - ALLOW "FOO,,"
	HRR B,A			;PUT RIGHT HALF INTO B
	HRL B,LHVAL		;ACCUMULATE WITH LEFT HALF
	RETSKP			;SKIP FOR SUCCESS

ADDPRT:	CALL GETHLP		;SET UP HELP TEXT
	MOVEI A,[BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<()+-*/&.$%>]
	MOVEM A,CMBRK		;SPECIFY BREAK MASK
	MOVX A,CMFLD		;SAY TO READ AS A FIELD
	CALL $WORK		;READ THE ADDRESS
	 RET			;GIVE FAILURE RETURN IF CAN'T EVEN READ STRING
	CALL BUFFF		;ISOLATE THE STRING
	MOVE B,A		;GET COPY OF POINTER TO EXPRESSION
	ILDB B,B		;PEEK TO SEE IF NULL
	JUMPE B,ADDPR0		;NULL, SO RETURN 0
	CALLRET EVAL		;EVALUATE ADDRESS AND SKIP OR NORMAL RETURN

ADDPR0:	TDZA A,A		;RETURN ZERO
NC:	MOVE B,LHVAL		;NO COMMAS, SO THERE'S ONLY ONE EXPRESSION
	RETSKP

NC1:	HRLZ B,LHVAL		;ALLOW "FOO,,"
	RETSKP
;ACCOUNT

ACCT$:	CALL GETHLP		;SET UP HELP TEXT
	MOVX A,CMACT		;SPECIFY ACCOUNT FUNCTION
	CALLRET $WORK

;WORD

WORD$:	USTAR @40		;WORD MIGHT BE "*"
	 CAIA			;NON-* TYPED
	RETSKP			;YUP, WAS.
	CALL GETHLP
	MOVX A,CMFLD		;ARBITRARY FIELD FUNCTION
	CAME Q3,[ASCIZ /PSWD/]	;PARSING A PASSWORD ?
	IFSKP.			;[4402] Yes.
	  MOVEI B,MSKLB		;[4402] Get appropriate mask
          MOVEM B,FBLOCK+4	;MOVE ADDR TO .CMBRK
          TXO A,CM%BRK		;SET CMBRK FLAG IN CMFNP
	ENDIF.
	CAME Q3,[ASCIZ /LAT/]	;[4402] How about a LAT-type name?
	IFSKP.			;[4402] Yes.
	  MOVEI B,LATMSK        ;[4402] So allow appropriate characters
          MOVEM B,FBLOCK+4	;MOVE ADDR TO .CMBRK
          TXO A,CM%BRK		;SET CMBRK FLAG IN CMFNP
	ENDIF.

;[4402] Neither password nor LAT name - proceed as normal

       	SETZM Q3		;[4402] RESTORE TEMP AC
	CALLRET $WORK

;END OF LINE

CRR$:	CALL GETHLP
	MOVX A,CMCFM		;"CONFIRM" FUNCTION
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN
;COMMON CODE FOR ABOVE CASES

$WORK:	MOVEI B,FBLOCK		;GET ADDRESS OF FUNCTION BLOCK
WORKB$:	TXO A,CM%BRK+CM%HPP+CM%DPP+CM%SDH ;USE OUR OWN HELP, DEFAULTS, AND BREAK SET
	SKIPN CMBRK		;BREAK SUPPLIED?
	TXZ A,CM%BRK		;NO, SO TELL COMND THERE IS NONE
	SKIPN CMDEF		;ANY DEFAULT STRING SUPPLIED?
	TXZ A,CM%DPP		;NO, SO TELL COMND THERE'S NONE
	MOVEM A,CMFNP
	CALLRET FLDSKP		;INPUT THE FIELD AND SKIP OR NORMAL RETURN

GETHLP:	SKIPN A,@40		;GET HELP STRING
	RET			;USE SAME AS LAST TIME
				;FALL INTO HELP$ TO SET IT UP

;SERVICE "HELPX" MACRO.  USE ARG AS DEFAULT HELP STRING FOR NEXT
;FIELD INPUT.

HELP$:	HRRO A,40		;GET POINTER TO STRING
	MOVEM A,CMHLP		;STORE HELP STRING
	RET

;SERVICE ROUTINE FOR DEXTX MACRO, WHICH SETS UP
;JFN BLOCK WITH DEFAULT EXTENSIONS FOR INPUT AND OUTPUT FILESPECS

DEXT$:	SETZM CJFNBK		;CLEAR OUT JFN BLOCK
	MOVE A,[CJFNBK,,CJFNBK+1]
	BLT A,CJFNBK+JBLEN-1
	HRRO A,40		;GET DEFAULT EXTENSION
	SKIPE @40		;DON'T SET UP POINTER IF NO DEFAULT EXTENSION
	MOVEM A,CJFNBK+.GJEXT	;STORE IT
	RET

;ROUTINE TO SERVICE "DEFX" MACRO, WHICH SETS THE DEFAULT STRING
;VALUE

DEF$:	HRRO A,40		;GET POINTER TO DEFAULT FIELD VALUE
	MOVEM A,CMDEF		;SET UP DEFAULT STRING VALUE
	RET
;MULTI FILE INPUT AND OUTPUT ROUTINES

;SCAN OUTPUT FILESPEC FOR MULTI FILE OP
;IF GROUPF NOT SET, DEFAULTS NAME AND EXT TO INPUT JFN
;RETURNS OUTPUT JFN IN OUTDSG
;IF GROUPF SET, DEFAULTS TO *.*;-1 AND RETURNS JFN IN MCOJFN

MFOUT::	MOVE A,[XWD [ASCIZ/*/],[ASCIZ/*/]] ;DEFAULT TO *'S
	MOVE B,INIFH1
	CAME B,INIFH2		;IF EXACTLY 1 TERM, MAYBE USE NAMES
	JRST MCOPY1
	HRRZ B,@INIFH1		;GET JFN ONLY
	CAIN B,FI%ERR		;DID FILE EXIST?
	JRST MCOPY1		;NO--USE *.* AS DEFAULT
	MOVE B,@INIFH1		;GET JFN AND BITS
	TXNN	B,GJ%NAM	;* FOR NAME?
	HRLI A,2		;NO, USE PREVIOUS NAME
	TXNN	B,GJ%EXT	;* FOR EXT?
	HRRI A,2		;NO, USE PREVIOUS EXT
MCOPY1:	MOVEI B,(GJ%FOU+GJ%IFG+GJ%OFG+GJ%MSG)	;DEFAULT TO -1 VERSION
	CALL SPECFN		;COLLECT FILE NAME, GTJFN FLAGS IN RH B.
	 JRST CERR
	MOVEM A,OUTDSG		;DESTINATION JFN
	MOVEM A,MCOJFN		;HERE FOR MULTI FILE COPY
	MOVE B,A		;PUT FILE HANDLE IN B (WITH WILDCARD BITS)
	LDF C,1B2		;BITS TO GET DEVICE FIELD
	TXNE B,GJ%DEV+GJ%UNT	;WILDCARDS USED IN DEVICE FIELD?
	CALL BADSTR		;ERROR IF BAD WILDCARD SYNTAX
	LDF C,1B5		;SPECIFY DIRECTORY
	TXNE B,GJ%DIR		;STAR IN DIRECTORY FIELD?
	CALL BADSTR		;YES, MAKE SURE IT'S LEGAL
	LDF C,1B8		;NAME FIELD
	TXNE B,GJ%NAM
	CALL BADSTR		;MAKE SURE LEGAL STARS IN NAME FIELD
	LDF C,1B11		;TYPE FIELD (EXTENSION)
	TXNE B,GJ%EXT
	CALL BADSTR
	LDF C,1B14		;GENERATION NUMBER
	TXNE B,GJ%VER
	CALL BADSTR		;MAKE SURE LEGAL WILCARDS IN GENERATION FIELD
	HLRZ A,JBUFP		;WILL REQUIRE AT LEAST 1 MORE JFN FOR COMMAND
	CAIN A,-1
	ERROR <Too many JFNs in command>
	RET
;FOLLOWING ROUTINE RETURNS IFF STRING RETURNED BY JFNS CONTAINS
;ONLY "*".  CALL THIS ROUTINE WITH INDEXABLE FILE HANDLE (FLAGS,,JFN)
;IN B, AND JFNS BITS IN C.  AC'S PRESERVED.  THE PURPOSE OF THIS ROUTINE
;IS TO CATCH FANCY FILENAMES THAT WON'T CAUSE EXPECTED RESULT.
;FOR INSTANCE "RENAME *.* (TO BE) X*.*" DOESN'T REALLY PUT "X" IN FRONT
;OF EVERY NAME, SO THIS ROUTINE MAKES SURE YOU'RE NOT TRYING TO DO
;THAT TYPE OF THING.

BADSTR:	SAVEAC <A,B,C>
	STKVAR <<JFNSP,EXTSIZ>>
	HRROI A,JFNSP
	JFNS			;GET FIELD
	HRROI A,JFNSP		;POINT AT FIELD WE JUST WROTE
	HRROI B,[ASCIZ /*/]
	STCMP			;MAKE SURE ONLY "*" AND NOT "F*" ETC.
	JUMPN A,[ERROR <Invalid use of wildcard characters>]
	RET			;RETURN SUCCESFULLY
;GET OUTPUT NAME FOR MULTI FILE OPERATION
;GETS JFN INTO OUTDSG, ASSUMES SCANNED
;OUTPUT NAME JFN IN MCOJFN. SKIPS ON SUCCESSFUL GTJFN AFTER
;PRINTING FILESPEC.
;DIRECT RETURN ON ERROR, NAME AND MESSAGE ALREADY PRINTED
;CALL:
; A/	-1 IF COPYING FILES, 0 IF RENAME OR APPEND
;RETURNS:
; +1:	FAILURE. MESSAGE ALREADY PRINTED
; +2:	SUCCESS. OUTPUT FILE JFN IN OUTDSG
;
MFSET::	TRVAR <MFPP,COPFLG,<MFBUF,FILWDS>>
	SKIPN MCOJFN		;MULTI FILE OUTPUT?
	RETSKP			;NO, JFN ALREADY IN OUTDSG
	MOVEM A,COPFLG		;SAVE COPY FLAG
	SETZM MFBUF		;SO WE CAN CHECK FOR NULL STRING
	HRROI A,MFBUF
	MOVEM A,MFPP		;INITIALIZE BYTE POINTER TO BUFFER
	MOVX C,<FLD(.JSAOF,JS%NOD)+JS%PAF> ;GET NODE
	CALL MCOSTO
	MOVSI A,(GJ%DEV)	;FLAG BIT TO TEST
	MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF> ;GET DEVICE
	CALL MCOSTR		;GET STRING
	MOVSI A,(GJ%DIR)
	MOVX C,<FLD(.JSAOF,JS%DIR)+JS%PAF> ;GET DIRECTORY
	CALL MCOSTR
	MOVSI A,(GJ%NAM)
	MOVX C,<FLD(.JSAOF,JS%NAM)+JS%PAF> ;NAME
	CALL MCOSTR
	SKIPN MFBUF		;NULL FILESPEC?
	JRST MFSET1		;YES
	MOVSI A,(GJ%EXT)
	MOVX C,<FLD(.JSAOF,JS%TYP)+JS%PAF> ;EXT
	MOVE D,MFPP		;SAVE THE CURRENT STRING POINTER
	CALL MCOSTR
	MOVEI A,"."		;FOR NULL EXTENSIONS
	CAMN D,MFPP		;SEE IF WE GOT SOMETHING
	IDPB A,MFPP		;NOTHING CHANGED, FORCE A NULL EXTENSION
	MOVSI A,(GJ%VER)
	MOVX C,<FLD(.JSAOF,JS%GEN)+JS%PAF> ;VERSION
	CALL MCOSTR
	MOVX C,<FLD(.JSSSD,JS%PRO)+JS%PAF> ;PROTECTION
	CALL MCOSTO		;GET PROTECTION FROM OUTPUT
	MOVE C,MCOJFN		;GET OUTPUT NAME JFN
	TXNN C,GJ%TFS		;IS THIS A TEMPORARY FILESPEC?
	JRST MFSET0		;NO, SO DO NOT APPEND ;T TO FILENAME
	MOVE A,MFPP		;YES, GET STRING SPACE POINTER
	MOVEI C,";"		;APPEND A ;T TO THE FILENAME
	IDPB C,A
	MOVEI C,"T"
	IDPB C,A
	MOVEM A,MFPP		;REPLACE UPDATED STRING POINTER
MFSET0:	MOVX C,<FLD(.JSSSD,JS%ACT)+JS%PAF> ;ACCOUNT
	CALL MCOSTO
	MOVX C,<JS%ATR+JS%PAF>	;GET ATTRIBUTES
	CALL MCOSTO
MFSET1:	SKIPN TYPGRP		;FORCED PRINT?
	TLNE Z,GROUPF		;NO, ONLY IF GROUP
	UTYPE [ASCIZ/ => /]
	HRROI B,MFBUF
	MOVSI A,(GJ%FOU!GJ%SHT!GJ%DEL!GJ%FLG!GJ%PHY) ;OUTPUT, SHORT CALL, DELETED OK, PHYSICAL ONLY
	CALL GTJFS		;DO GTJFN, STACK IN CASE ^C
	 JRST [	HRROI B,MFBUF	;GET POINTER TO BEGINNING OF STRING
		LERROR <Destination GTJFN failure on %2M%%_% %1?>
		RET]
	HRRZM A,OUTDSG
	MOVE B,A		;GET FULL JFN INTO B
	TXZ B,GJ%UHV!GJ%NHV!GJ%ULV ;MAKE VERSION NUMBER COME OUT RIGHT
	MOVE A,COJFN		;OUTPUT NAME TO HERE
	MOVE C,[JS%NOD+2B2+2B5+2B8+2B11+2B14+2B17+2B20+1B21+JS%ATR+1B35]
	SKIPN TYPGRP		;FORCED PRINT?
	TLNE Z,GROUPF		;NO, ONLY IF GROUP
	JFNS
	SKIPGE COPFLG		;COPYING?
	 JRST [ CALL SPRCHK	;YES. SEE IF OK TO COPY FILE
		 JRST SPRERR	;DESTINATION FILE CAN'T BE SUPERSEDED
		JRST .+1 ]	;OK TO COPY FILE
	HRRZ A,OUTDSG
	DVCHR			;GET DEVICE CHARACTERISTICS OF OUTPUT FILE
	LDB A,[POINT 9,B,17]	;DEVICE TYPE
	CAIE A,.DVDSK		;IF DISK, SPECIAL CHECK
	RETSKP			;ELSE INDICATE SUCCESS
	HRRZ A,OUTDSG
	MOVE B,[1,,.FBCTL]	;GET FLAG WORD
	MOVEI C,A		;INTO A
	CALL $GTFDB
	 SETZ A,		;MAKE SURE FB%NXF OFF IF ACCESS PREVENTED
	TXNN	A,FB%NXF	;NEW FILE?
	TYPE < [Superseding]>	;NO, INFORM USER
	RETSKP

SPRERR:	ETYPE <%_%%%Not superseding current file%_> ;SAY FILE WAS NOT SUPERSEDED
	RET			;AND RETURN +1

MCOSTR:	TDNN A,MCOJFN		;OUTPUT * HERE?
MCOSTO:	SKIPA B,MCOJFN		;NO, USE OUTPUT FIELD
	HRRZ B,@INIFH1		;YES, USE INPUT FIELD
	MOVE A,MFPP		;GET STRING SPACE POINTER
	JFNS			;GET STRING
	MOVEM A,MFPP		;STORE STRING SPACE POINTER
	RET
;CALL TO COPY JFN POINTED TO BY INIFH1 TO SECOND JFN
;THEN ADVANCE INIFH1 PAST THAT FILE. USED BY DELETE AND
;RENAME BECAUSE GNJFN DOES NOT WORK AFTER RENAME AND SOME DELETES.

MFINP::	CALL MFINP0		;GET JFN AND FLAGS
	 RET			;FAILED
	HRRZ A,A		;GET RID OF FLAGS
	RETSKP

;MFINP0 IS LIKE MFINP BUT RETURNS GNJFN FLAGS IN LEFT HALF OF A

MFINP0::STKVAR <MFJFN,<MFIBUF,FILWDS>>
	HRROI A,MFIBUF
	HRRZ B,@INIFH1		;JFN
	MOVX C,<JS%NOD+JS%DEV+JS%DIR+JS%NAM+JS%TYP+JS%GEN+JS%ATR+JS%PAF>
	JFNS			;ASK FOR NODE::DEVICE:<DIR>NAME.EXT;GEN
	CALL GNFIL		;ADVANCE FIRST JFN BEFORE DELETE OR WE GET LOST
	 SETZM INIFH1		;CLEAR THIS TO INDICATE NO MORE JFNS
	MOVEM A,MFJFN		;REMEMBER FLAGS
	MOVEI A,[GJ%OLD+GJ%NS+GJ%PHY+GJ%DEL+GJ%XTN
		 .NULIO,,.NULIO	;NO I/O
		 0		;DSK:
		 0		;<DIR>
		 0		;FILE.
		 0		;EXT
		 0		;;P
		 0		;;A
		 0		;JFN
		 G1%IIN		;ALLOW INVISIBLE FILES
		 0		;[3037][3038] Fill in remaining words with 0
		 0		;[3038]
		 0		;[3038]
		 0		;[3038]
		 0		;[3038]
		 0]		;[3038]
	HRROI B,MFIBUF		;GET FILE FROM OTHER JFN
		CALL GTJFS		;DO GTJFN, STACK IT
	 JRST [	HRROI B,MFIBUF	;GET POINTER TO FILESPEC
		LERROR <Source GTJFN failure on %2M%%_% %1?>
		RET]
	HLL A,MFJFN		;RETURN GNJFN'S FLAGS
	RETSKP			;RETURN WITH JFN IN A
;SPRCHK - VERIFY VALIDITY OF COPYING WITH SUPERSEDE SUBCOMMANDS
;CHECK TO SEE IF THE SETTING OF THE SUPERSEDE FLAG AND THE WRITE TIME AND
;DATE OF THE FILES WILL ALLOW THE COPY.
; OUTDSG/ DESTINATION JFN
; INIFH1/ ADDRESS OF INPUT JFN
;RETURNS: +1:	FILE SHOULD NOT BE COPIED
;	  +2:	FILE CAN BE COPIED
;
SPRCHK:	TRVAR <DSTTAD>
	SKIPGE SPRSED		;SUPERSEDE ALWAYS?
	 RETSKP			;YES. RETURN +2
	CALL GTSTAD		;GET TAD OF FILE BEING SUPERSEDED
	 RETSKP			;NO TAD, ALLOW COPY TO SUCCEED
	MOVEM A,DSTTAD		;STORE TAD OF FILE
	SKIPN SPRSED		;SUPERSEDE NEVER?
	 RET			;YES. DON'T COPY OVER THIS FILE
	HRRZ A,@INIFH1		;GET JFN OF SOURCE FILE
	MOVEI B,D		;WHERE TO STORE TAD OF FILE
	MOVEI C,1		;LENGTH OF ARG BLOCK
	RFTAD			;GET TIME AND DATE OF LAST WRITE
	SKIPGE D		;SOURCE TAD -1?
	 RETSKP			;YES. ALLOW THIS TO WORK
	MOVE A,SPRSED		;GET SUPERSEDE SWITCH
	CAIN A,2		;SUPERSEDE NEWER?
	 EXCH D,DSTTAD		;YES. EXCHANGE VALUES FOR COMPARE
	CAMLE D,DSTTAD		;COPY ALLOWED?
	 RETSKP			;YES
	RET			;NO
;GTSTAD - GET TAD OF THE FILE BEING SUPERSEDED. THIS FILE IS DEFINED AS
;BEING THE FILE WITH HIGHEST GENERATION NUMBER LESS THAN OR EQUAL TO THE
;GENERATION NUMBER OF THE DESTINATION FILE.
; OUTDSG/ JFN OF DESTINATION FILE
;	CALL GTSTAD		;(OUTDSG/T1)
;RETURNS: +1: FAILED TO GET A TIME AND DATE (PROBABLY NO SUCH FILE OR
;	       DEVICE TYPE HAS NO TIME AND DATE ASSOCIATED WITH IT)
;	  +2: SUCCESS
;		A/ TIME AND DATE AND DATE OF FILE BEING SUPERSEDED
;
GTSTAD:	TRVAR <DSTGEN,SPRTAD,CURJFN,<FILBUF,FILWDS>>
	SETOM SPRTAD		;INDICATE NO JFN FOUND
	HRRZ A,OUTDSG		;GET JFN OF DEST. FILE
	MOVE B,[XWD 1,.FBGEN]	;GET GENERATION WORD
	MOVEI C,D		;STORE IN D
	GTFDB%			;GET THE GENERATION NUMBER
	 ERJMP GTSERR		;NOT GOOD. ALLOW COPY
	HLRZM D,DSTGEN		;SAVE ONLY GENERATION NUMBER
	HRROI A,FILBUF		;POINT TO FILE NAME BUFFER
	HRRZ B,OUTDSG		;GET DESTINATION JFN
	MOVX C,<2B2!2B5!1B8!1B11!JS%PAF> ;FLAGS FOR JFNS
	SETZ D,			;NO PREFIX STRING
	JFNS			;EXPAND THE FILE NAME
	 ERJMP GTSERR		;FAILED TO EXPAND JFN?
	HRROI B,[ASCIZ /.*/]	;STRING TO APPEND
	SETZ C,			;TERMINATE ON NULL BYTE
	SOUT			;APPEND TO FILE NAME
	 ERJMP GTSERR		;FAILED FOR SOME REASON
	MOVX A,<GJ%SHT!GJ%IFG!GJ%OLD> ;OLD FILES, ALLOW WILD CARDS
	HRROI B,FILBUF		;POINT TO CONSTRUCTED FILE NAME
	CALL GTJFS		;GET AND STACK THE JFN
	 JRST GTSERR		;FAILED. ASSUME NO FILES
	MOVEM A,CURJFN		;SAVE CURRENT JFN
GTS1:	HRRZS A			;GET JFN ONLY FOR GTFDB
	MOVE B,[XWD 1,.FBGEN]	;GET GENERATION WORD
	MOVEI C,D		;STORE IN D
	GTFDB%			;GET THE GENERATION NUMBER
	 ERJMP GTSFND		;NOT GOOD. USE SPRTAD
	HLRZS D			;GET GENERATION ONLY
	CAMLE D,DSTGEN		;IS THIS GENERATION GREATER THAN DEST.
	 JRST GTSFND		;YES. RETURN TAD IN SPRTAD
	MOVEI B,D		;RETURN INFO IN D
	MOVEI C,1		;ONE WORD
	RFTAD			;GET FILE TIME AND DATE
	 ERJMP GTSFND		;USE SPRTAD
	MOVEM D,SPRTAD		;SAVE THIS TIME AND DATE
	MOVE A,CURJFN		;GET FULL JFN WORD FOR GNJFN
	CALL GNJFS		;GET NEXT JFN IN GROUP
	 JRST GTSFND		;NO MORE OR SOMETHING. USE SPRTAD
	JRST GTS1		;GOT ONE. TEST GENERATION
GTSFND:	CALL JUNSTK		;JFN HAS BEEN DE-ASSIGNED. POP FROM STACK
	RLJFN			;RELEASE IT
	 ERJMP .+1		;IGNORE ERROR. GNJFN MAY RELEASE JFN
	SKIPL A,SPRTAD		;GET FILE TIME AND DATE IN A
	 AOS (P)		;RETURN +2 IF WE GOT A TAD
GTSERR:	RET			;DONE
;COLLECT FILE NAMES:
;COUTFN & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON.
;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS.
;CAN INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS *.MAC FORMS.

;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER
;	      2 => USE EXT OF LAST FILE NAME INPUT AS DEFAULT EXT
;	 LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
;	      0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE
;	      1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT
;	      2 => LIKE 0 BUT USE LAST NAME INPUT AS DEFAULT NAME
;	      -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR *
;	      -2   LIKE -1 BUT GIVE R1 IF NO SUCH FILE
;    ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0)
;	RH: FLAGS FOR GTJFN PLUS:
;	    B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",".
;		 DOES NOT HANDLE ALTMODE-COMMA (USE ^F FOR RECOGNITION),
;		 MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY)
;	    B16: ALLOW GROUP OF NAMES SEPARATED BY SPACE, ALTMODE, OR
;		 SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED
;		 BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND
;		 INPUT REQUIRED).
;		 B15 SHOULD ALSO BE ON.
;		 ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN
;		 PRE-READ FOLLOWING FIELD
;	    B17: NO SUBCOMMANDS FOLLOW THE LIST.
;
;	    B14: IF NO SUCH DEVICE, NO SUCH DIRECTORY,...,
;		NO SUCH GENERATION... RETURN PTR,,FI%ERR IN PLACE OF JFN
;		PTR POINTS TO <CHAR COUNT>,,<ERROR #> FOLLOWED BY
;		BYTE POINTER TO TYPESCRIPT.
;
;
;    ALSO, F3 IN Z  SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN
;	AFTER INITIAL TRY FAILS --  FOR DEFAULT RUN
;	IGINV in Z says to allow invisible files (G1%IIN)
;COLLECT FILE NAMES COMMENTS...

;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT,
;		OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A),
;		OR P2=EOL AT ENTRY (IN WHICH CASE NO INPUT),
;		OR -2 IN LH OF A AND NO SUCH FILE,
;		OR B16 ON AND LIST ENDED WITH COMMA.
;		THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T
;		BE USED IF B15 OR B16 ON.
;	 +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF"
;		(POINTER JBUFP). 1ST LOCATION IN THIS BUFFER
;		(FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,...
;		IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT
;		(B11,15,16 ON), SETS INIFH1 &2 TO 1ST & LAST USED
;		LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF"
;		IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT).

;	 EITHER: TERMINATOR IN "P2"
;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF,
; AS %KEYW DOES.  SEE %KEYW'S GLITCH NOTE (S1.MAC).

;FLAGS IN AC D
;RH: FROM CALLER
;LH:
;    B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA
;    B2: DITTO, DITTO, FOLLOWED BY COMMA
;COLLECT FILE NAMES...  ENTRIES.

CSAVFN:	MOVEI B,<GJ%FOU!GJ%MSG>B53	;GTJFN FLAGS FOR OUTPUT FILE NAME
	JRST SPECFN

;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME).
;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION.

COUTFN:	MOVEI B,(GJ%FOU!GJ%MSG)	;GTJFN FLAGS FOR OUTPUT FILE NAME
	JRST SPECFN

;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP.
;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA.
;NO SPECIAL RETURN FOR "*" OR NULL INPUT.
;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN".
;COLLECT FILE NAMES...   GROUP ENTRIES

;.INFG
;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME -
; THUS ^F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW.
;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW,
; AS IN 1ST ARG TO "COPY".
;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP),
; VERSION TO HIGHEST.
;ONE RETURN ONLY.

;.INFG, BUT WITH NO SEARCH (FOR ACCOUNT, VERSION-RET..., PROTECTION)

INFGNS::MOVE B,[XWD -3,<GJ%OLD!GJ%IFG!GJ%NS!1B14!1B15>B53] ;* VERSION FOR RENAME
	JRST .INFG1

.INFG:	MOVEI B,(GJ%OLD!GJ%IFG!1B15)
.INFG1:	MOVE A,[XWD 2,2]
	CALL SPECFN
	 JRST CERR
	RET

;$INFGX
;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT
;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT).

$INFGX:	MOVEI B,(GJ%OLD!GJ%IFG!1B14!1B15!1B16)
	MOVE A,[XWD 2,2]
	JRST SPECFN
;FLAVOR THAT READS LIST OF FILESPECS, AS IN "TYPE" COMMAND, OR
;"SET FILE INVISIBLE".  NOTE THAT THIS IS THE WRONG ROUTINE FOR
;THINGS LIKE "SET FILE PROTECTION" WHICH TAKE ANOTHER ARG (THE PROTECTION)
;AFTER THE LIST

TYPFLS::DMOVE A,[EXP 0,<(GJ%OLD!GJ%IFG!1B15!1B16!1B17)>] ;NO SPECIAL, OLD FILE, STARS ALLOWED, LIST O.K., LIST IS LAST ON LINE, NO SUBCOMMANDS
	CALL SPECFN	;GATHER SPECS TO TYPE
	 RET		;NO SUBCOMMANDS
	RET

;DIRARG
;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT:
; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!).
; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS
; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER.
; ACCEPTS * FOR NAME IN EMPTY DIRECTORY
; SETS NO SEARCH FOR GTJFN

DIRARG:	MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]]
	HRLI B,-3		;DEFAULT VERSION: *
	HRRI B,(GJ%OLD!GJ%DEL!GJ%IFG!1B14!1B15!1B16)
	JRST SPECFN
;COLLECT FILE NAMES ENTRIES...

;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH.
; USED IN SPECIAL CASES, EG:
;	DELETED FILE NAME FOR "UNDELETE"
;	ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY".

;END OF ENTRIES.  CASES MERGE HERE.

SPECFN:	SETZM CJFNBK+2		;NO DEFAULT DEVICE
	SETZM CJFNBK+3		;AND NO DEFAULT DIRECTORY
CFN1A:	TRVAR <SAVFGS,CEX,SEXJFN,CFNMOD,CFLAGS>
	MOVEM A,CFNMOD		;SAVE MODE BITS
	HRRZ D,B		;SAVE GTJFN AND LOCAL FLAGS IN RH D
	MOVEM D,CFLAGS		;SAVE FLAGS
	TRZ B,(1B14!1B15!1B16)	;DON'T GIVE LOCAL FLAGS TO GTJFN
	TRNN D,(GJ%OFG)		;IF OUTPUT GROUP THEN NOT INPUT
	TRNN D,(GJ%IFG!1B15!1B16) ;IF AN INPUT GROUP IS BEING REQUESTED,
	SKIPA
	SETZM INIFH1		;SAY NO NAMES HAVE BEEN INPUT YET.
;COLLECT FILE NAMES...
;SET UP GTJFN PARAMETER BLOCK

	MOVSM B,SAVFGS		;FLAGS AND DEFAULT VERSION
	SETZ B,			;SET UP .GJF2 WORD
	TXNE Z,IGINV		;ALLOW INVISIBLE?
	 TXO B,G1%IIN		;YES
	MOVEM B,CJFNBK+.GJF2	;STORE IN GTJFN BLOCK

;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP

CFN2:	MOVE A,SAVFGS		;GET SAVED FLAGS
	MOVEM A,CJFNBK+.GJGEN	;SET UP FOR GTJFN (ERROR HANDLING MAY HAVE CLOBBERED THEM)

	MOVE A,CFNMOD		;RESTORE MODES
	MOVE B,JBUFP
	MOVEM B,.JBUFP

;FORM "DEFAULT STRING POINTER" TO EXTENSION

	HRRZ B,A
	MOVX C,FLD(.JSAOF,JS%TYP) ;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT
	CAIN B,2		;2 SAYS USE EXT OF LAST FILE NAME INPUT
	CALL LFJFNS		;GET A STRING FOR LAST FILE'S EXT
	SKIPE B
	HRLI B,<POINT 7,0,-1>B53
	MOVEM B,CJFNBK+5

;FORM "DEFAULT STRING POINTER" TO DEFAULT NAME

	HLRZ B,A
	MOVX C,FLD(.JSAOF,JS%NAM) ;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT.
	CAIN B,2		;2 SAYS USE NAME OF LAST FILE NAME INPUT
	CALL LFJFNS		;GET A STRING FOR LAST FILE'S NAME
	CAIE B,-2
	CAIN B,-1
	SETZ B,
	SKIPE B
	HRLI B,<POINT 7,0,-1>B53
	MOVEM B,CJFNBK+4
	HLRZ B,JBUFP		;CHECK SPACE IN JFN BUFFER
	CAIN B,-1
	ERROR <Too many JFNs in command>
	FILEX <FILE NAME>	;TRY TO READ FILE NAME
	 JRST CFNE		;COULDN'T
	MOVE A,B		;PUT JFN INTO A
;COLLECT FILE NAMES...
;CODE FOR THE VARIOUS GROUP CASES

CFN4Z:	MOVE D,CFLAGS		;GET FLAGS (SUBROUTINES MAY CLOBBER D!)
	TRNN D,(GJ%OFG)
	TRNN D,(GJ%IFG!1B15!1B16)
	RETSKP			;NO SUCH OPTIONS ON
	HRRZ B,JBUFP
	SKIPN INIFH1		;FIRST JFN IN GROUP?
	MOVEM B,INIFH1		;YES, SAVE JBUF POINTER
	TLNE A,<77B5>B53	;ANY *'S INPUT OR DEFAULTED TO?
	TLO Z,GROUPF		;YES, SAY GROUP WAS SPECIFIED.
	TRNN D,(1B15)		;INPUTTING GROUPS OF FILES?
	JRST CFN7Z		;NO
	TRNE D,(1B16)		;INPUTTING UNTIL END OF LINE?
	JRST B16ON		;YES
	MOVE A,CMFLG		;NOT INPUTTING TO END OF LINE, GET FLAGS
	TXNE A,CM%ESC		;DID USER END FILE NAME WITH $ ?
	JRST CFN7Z		;YES, SO WE'RE DONE
				;Note here that ESCAPE is being used for
				;two purposes, both to complete the filespec
				;automatically, and to declare that you want
				;the guide words for the next field of the
				;command.  This is sort of a loser.  What if
				;you want one and not the other???
	COMMAX <Comma to specify another filespec, or next field of command>
				;REGULAR GROUP, SO WE NEED COMMA TO READ ANOTHER NAME
	 JRST CFN7Z		;GROUP BUT NO COMMA AFTER FILE NAME, SO WE'RE DONE
CFN22:	TLO Z,GROUPF		;NOTE THAT GROUP HAS BEEN INPUT
	JRST CFN2		;GET NEXT FILE AFTER THE COMMA
B16ON:	HELPX <Carriage return to end command
or comma and another filespec
or comma and carriage return to enter subcommands>
	TRNE D,(CF%NS)		;DON'T ADVERTISE SUBCOMMANDS IF CALLER HAS NONE
	HELPX <Carriage return to end command
or comma and another filespec>
	CRRX			;INPUTTING UNTIL END OF LINE, HAVE WE REACHED IT YET?
	 CAIA			;NOT YET
	JRST CFN7Z		;YES
	COMMAX			;COMMA AFTER FILE NAME?
	 ERROR <Comma missing between filespecs or illegal character in command>
	TRNE D,(CF%NS)		;NO SUBCOMMANDS?
	JRST CFN22		;RIGHT, SO COMMA MEANS ANOTHER FILE COMING
	CRRX <Carriage return to enter subcommands
or another filespec>		;SUBCOMMANDS, SO WE WANT R1
	 JRST CFN22		;COMMA NOT FOLLOWED BY CR, MUST BE ANOTHER FILE SPEC
	CALLRET CFNFIX		;GET RETURN DATA AND GIVE NON-SKIP RETURN

CFN7Z:	CALL CFNFIX
	RETSKP

CFNFIX:	HRRZ B,JBUFP
	MOVEM B,INIFH2		;RETURN JBUFP VALUE FOR LAST NAME IN GROUP
	MOVE A,@INIFH1		;RETURN FIRST, NOT LAST, JFN IN A
	RET
;GTJFN ERRORS
;FIRST TEST ERROR CODE FOR EXCEPTIONS.

CFNE:	CALL GETERR		;GET REASON THE GTJFN FAILED

	CAIN A,GJFX3
	ERROR <No JFNs available: You must close some files first>
	CAIN A,GJFX22
	ERROR <JSB full: Try closing some files then repeating command>
	CAIN A,GJFX23
	ERROR <Directory full: Can't create new files until you
 "DELETE" some files and "EXPUNGE (DIRECTORY)">
	TRNN Z,F4!F3!F2		;FOR DELETE, DIRECTORY OR DISCARD COMMAND?
	JRST CFNE2		;NO, NO CHECK
	CAIL	A,GJFX16
	CAILE	A,GJFX21
	CAIN	A,GJFX24
	JRST	CFNE1
	CAIE	A,GJFX36
	CAIN	A,GJFX32
	JRST	CFNE1
	CAIN	A,GJFX35	;DIR ACCESS DENIED
	JRST	CFNE1		;YES - DEFER

CFNE2:	MOVEM A,ERCOD		;SAVE ERROR CODE
	HLRZ A,CFNMOD		;MOST GTJFN ERRORS RETURN +1 IF CALLER GAVE
	CAIE A,-2		;... -2 IN LH OF A.
	 CMERRX			;IT'S -2 - GIVE UP AND TYPE ERROR MESSAGE
	MOVE A,CFNMOD		;ELSE RETURN
	RET			;RETURN
;IF FLAG B14 ON GIVE GOOD RETURN WITH PTR,,FI%ERR INSTEAD
;OF JFN WHEN GJFX32 ERROR OCCURS.
;USED FOR "DIRECTORY" (DIRARG).

CFNE1:	MOVEM A,CEX		;SAVE ERROR CODE
	MOVE A,CMFLG		;GET FLAGS
	TXNE A,CM%ESC		;MAKE SURE NO RECOGNITION WAS ATTEMPTED
	IFNSK.
	  ETYPE <%_>
	  CALL %MESS
	  MOVE A,[440700,,ATMBUF]
	  ETYPE <%? - %1M %_>
	  JRST ERRFIN
	ENDIF.
	DEXTX <>		;CLEAR GTJFN BLOCK
	MOVX A,GJ%OFG		;WE WANT SPEC, DON'T CARE IF EXISTS ANYMORE
	IORM A,CJFNBK+.GJGEN
	FILEX <>		;TRY TO READ THE FILESPEC
	 CMERRX			;SPEC NOT EVEN SYNTACTICALLY CORRECT
	MOVEM B,SEXJFN		;REMEMBER JFN AND FLAGS
	CALL PIOFF		;DON'T ALLOW ^C WHILE PERMANENT FREE SPACE ASSIGNED AND NOT RECORDED
	MOVEI A,.FILEN		;GET SIZE OF ERROR BLOCK
	CALL GTBUFX		;GET BUFFER FOR BLOCK (NOT GETBUF, SINCE UNMAP
				;MIGHT BE CALLED BEFORE RLJFNS!)
	EXCH A,CEX		;STORE ADDRESS IN CEX, GET ERROR CODE IN A
	MOVE B,CEX		;GET ADDRESS OF BLOCK
	MOVEM A,.FIERR(B)	;STORE ERROR CODE IN FIRST WORD OF BLOCK
	MOVE A,SEXJFN		;GET JFN AND FLAGS IN CASE CALLER WANTS IT
	MOVEM A,.FIJFN(B)	;REMEMBER IT IN CASE CALLER NEEDS IT
	HRROI A,ATMBUF		;POINT TO FILESPEC
	CALL XBUFFS		;BUFFER IN PERMANENT SPACE (SO UNMAP DOESN'T CLOBBER IT)
	MOVE B,CEX		;GET ADDRESS OF BLOCK
	MOVEM A,.FISTR(B)	;STORE STRING POINTER IN BLOCK
	HRL A,CEX		;ADDRESS IN LEFT HALF
	HRRI A,FI%ERR		;SPECIAL CODE
	MOVE B,JBUFP		;SEE WHERE ON STACK THIS ENTRY SHOULD BE PUT
	MOVEM A,(B)		;REPLACE PARSE-ONLY JFN WITH ERROR ENTRY
	CALL PION		;ALLOW ^C AGAIN NOW THAT FREE SPACE USAGE HAS BEEN RECORDED
	JRST CFN4Z		;FINISH PROCESSING
;NXFILE
;CHECK FOR FLAG IN PLACE OF JFN (FI%ERR)
;IF ON, PRINT ERROR MESSAGE AND TYPESCRIPT

NXFILE::ATSAVE
	HRRZ A,@INIFH1
	CAIE A,FI%ERR		;SPECIAL CASE?
	RETSKP			;NO
	CALL %MESS
	HLRZ D,@INIFH1		;GET POINTER TO STRING
	HRRZ A,.FIERR(D)	;GET GTJFN ERROR CODE
	CALL $ERSTR		;PRINT ERROR
	TYPE < - >
	UTYPE @.FISTR(D)	;PRINT TYPESCRIPT
	ETYPE<%_>
	AOS A,INIFH1		;SKIP OVER THIS TERM
	CAMLE A,INIFH2		;PAST END?
	SETZM INIFH1		;YES, FLAG SUCH
	RET

$ERSTR::ETYPE <%1?>		;TYPE MESSAGE FOR CODE IN A
	RET
;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN.
;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING
; JFNS FORMAT SPECIFICATION IN C.
;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING
;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS
; COMMAND, RETURNS 0 IN B.

LFJFNS:	SAVEAC <A>
	STKVAR <<LFBUF,FILWDS>>
	SETZM LFBUF		;SO WE'LL KNOW IF SOMETHING'S WRITTEN
	HRRZ B,JBUFP		;JFN STACK POINTER
	CAIN B,JBUF-1		;HAS A NAME BEEN INPUT YET?
	JRST LFJF9		;NO, GO RETURN 0 POINTER
	HRRZ A,(B)		;PICK UP JFN OF LAST NAME INPUT
	CAIE A,-2
	CAIN A,-1
	JRST LFJF9		;-1, -2 ISN'T A JFN BUT MIGHT GET HERE
	HRROI A,LFBUF
	MOVE B,JBUFP
	MOVE B,(B)		;PICK UP JFN AGAIN
	JFNS			;DO THE JFN TO STRING CONVERSION
	SKIPN LFBUF
	HRLI A,440700		;RETURN POINTER TO NULL STRING
	SETZ B,
	IDPB B,A		;APPEND NULL TO STRING
	HRROI A,LFBUF		;POINT TO STRING
	CALL BUFFS		;RETURN POINTER TO STRING
	MOVE B,A		;RETURN POINTER IN B
	RET

LFJF9:	SETZ B,			;RETURN 0 IF CAN'T RETURN A STRING
	RET
;CPFN: COLLECT PROGRAM FILE NAME
;TAKES: A: 0 OR WORD POINTER TO DEFAULT DEVICE NAME.
;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV".
;RETURNS +1 ON GTJFN FAILURE.

CPFN:	MOVEI B,100000
CPFNA:	JUMPE A,.+2
	HRLI A,<POINT 7,0,-1>B53 ;IF NON-0, FILL OUT BYTE PTR
	MOVEM A,CJFNBK+2	;DEFAULT DEVICE
	HRRI A,[GETSAVE()]	;DEFAULT EXT
	HRLI A,-2		;SAY RETURN +1 ON GTJFN FAILURE
	JRST CFN1A		;JOIN CINFN & COUTFN
;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP
; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT)
;RETURNS JFN IN A

TYPIF:	HRRZ A,@INIFH1		;GET CURRENT JFN
	SKIPN TYPGRP		;FORCED PRINT?
	TLNE Z,GROUPF		;NO, SKIP IF NON-GROUP
	ETYPE < %1S>		;%S: TYPE NAME FOR JFN
	RET

;TYPOK: TYPES [OK] CORRESPONDING TO TYPIF ABOVE
;SHOULD BE CALLED ONCE FOR EACH CALL ON TYPIF, BUT
;ONLY AFTER SUCCESFULL COMPLETION OF FILE
TYPOK:	SKIPN TYPGRP
	TLNE Z,GROUPF
	TYPE < [OK]
>
	RET
;GNFIL
;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A WITH FLAGS FROM GNJFN.
;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).

GNFIL:	PUSH P,A
	PUSH P,B
	HRRZ A,@INIFH1
	GTSTS
	JUMPGE B,GNFIL3		;JUMP IF NOT OPEN
	TXO A,CO%NRJ		;SAY DON'T RELEASE JFN
	CLOSF
	 CALL JERR
GNFIL3:	MOVE A,@INIFH1
	TLNN A,<77B5>B53	;NO *-FLAGS, SKIP GNJFN AND ITS BUGS
	JRST GNFIL5
	CAME A,[-2]		;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES
				;(THAT SHOULDN'T GET HERE ANYWAY)
	CALL GNJFS		;STEP TO NEXT FILE IN *-GROUP
	 JRST GNFIL5		;NO MORE
	JRST GNFIL8		;LEAVE FLAGS IN LEFT HALF OF A

GNFIL5:	AOS A,INIFH1		;NEXT NAME IN GROUP
	CAMLE A,INIFH2		;ARE THERE MORE?
	JRST [	POP P,B		;NO
		POP P,A
		RET]
	HRRZ A,@INIFH1		;RETURN NEXT JFN IN A
GNFIL8:	AOS -2(P)
	POP P,B
	SUB P,[XWD 1,1]
	RET
;THIS ROUTINE OBTAINS CONNECTED STRUCTURE.  RETURNS POINTER THERETO IN A.

CONST::	GJINF			;GET CONNECTED DIRECTORY NUMBER
	MOVE A,CSBUFP		;POINT TO STRING SPACE
	DIRST			;GET STR:<DIR>
	 ERJMP CJERRE		;GO TELL USER WHY IT FAILED (PROBABLY STRUCTURE DISMOUNTED)
	MOVE A,CSBUFP		;POINTER TO STRING
	STDEV			;GET DEVICE DESIGNATOR FOR STRUCTURE
	 ERJMP CJERRE		;COULDN'T, SAY WHY AND DIE
	MOVE A,CSBUFP		;POINT TO FREE SPACE
	DEVST			;MAKE STRING NAME OF STRUCTURE
	 ERJMP CJERRE		;FAILED
	MOVE A,CSBUFP		;POINT TO THE NAME
	CALLRET BUFFS		;BUFFER IT AND RETURN POINTERTO USER

;DEVN
;INPUT AND VERIFY A DEVICE NAME.
;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI
; AS TERMINATOR.
;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS.

DEVN::	SKIPN B			;ANY HELP STRING ?
	HRROI B,[ASCIZ/Device name/] ;NO - USE DEFAULT
	MOVEM B,CMHLP		;STORE HELP STRING
	MOVX A,CMDEV!CM%NSF
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN

;HERE TO PARSE A STRUCTURE, LIKE DEVN EXCEPT DEVICE DOESN'T HAVE TO EXIST

STRN::	SKIPN B			;ANY HELP STRING ?
	HRROI B,[ASCIZ/Structure name/] ;NO - USE DEFAULT
	MOVEM B,CMHLP		;STORE HELP STRING
	MOVX A,CMDEV!CM%NSF!CM%PO
	CALLRET $WORK		;DO THE WORK AND SKIP OR NORMAL RETURN
;ROUTINE TO GET DIRECTORY INFORMATION
;ACCEPTS IN	A/	DIRECTORY NUMBER
;		B/	POINTER TO PASSWORD STRING (GETDRP ONLY)
;		C/	ADDRESS OF BLOCK INTO WHICH TO READ INFO
;RETURNS +1:	FAILED
;	 +2:	OK

GETDIR::MOVEI B,0		;NO PASSWORD GIVEN
GETDRP::STKVAR <GACTPR,DNOO,DRADR,SAVPP,DRPASP>
	MOVEM A,DNOO		;REMEMBER DIRECTORY NUMBER
	MOVEM C,DRADR		;SAVE ADDRESS OF DIRECTORY BLOCK
	MOVEM B,DRPASP		;SAVE THE POINTER TO THE PASSWORD STRING
	MOVEI A,EXTSIZ		;ALLOCATE BLOCK FOR PASSWORD
	CALL GETBUF
	HRLI A,440700		;MAKE BYTE POINTER
	MOVEM A,SAVPP		;REMEMBER POINTER TO PASSWORD BLOCK
	MOVE A,DRADR		;GET ADDRESS OF BLOCK
	CALL DIRINI		;INIT GROUP POINTERS AND GROUP BUFFERS
	MOVE A,DRADR		;GET ADDRESS OF GTDIR BLOCK
	MOVE A,.CDDAC(A)	;GET POINTER TO ACCOUNT BEFORE GTDIR BLOODY DESTROYS IT
	MOVEM A,GACTPR		;REMEMBER POINTER TO ACCOUNT
	MOVE A,SAVPP		;COPY PASSWORD INTO BLOCK FOR DIRECTORY
	MOVE B,DRPASP		;COPY FROM GIVEN PASSWORD (OR 0!)
	MOVEI C,0		;STOP COPYING ON NULL CHARACTER
	SOUT			;COPY THE PASSWORD
	MOVE A,DNOO		;GET DIRECTORY NUMBER
	MOVE B,DRADR		;GET ADDRESS OF BLOCK
	MOVEI C,GTDLN		;SET UP LENGTH OF BUFFER
	MOVEM C,.CDLEN(B)	;IN FIRST WORD OF BUFFER
	MOVE C,SAVPP		;WHERE TO PUT PASSWORD (POINTER RETURNED IN BUFFER)
	AOS .CDDRN(B)		;FOR REMOTE ALIAS BLOCK, FIRST WORD NOT USED
				; BY GTDIR
	SETZM .CDNLD(B)		;[4412] Zero this in case of an old monitor
	SETZM .CDFPA(B)		;[4412] And this too
	GTDIR			;GET ALL THE INFO INTO THAT BLOCK
	 ERJMP R		;IF FAILED, RETURN NO-SKIP
	HLRZ A,@.CDDRN(B)	;GET USED COUNT FOR GTDIR BLOCK
	SOS .CDDRN(B)		;REMOTE ALIAS BLOCK - RECOVER ENTIRE BLOCK
	CAIG A,1		;ANY ALIASES RETURNED ?
	JRST GETDR1		;NO.
	MOVE A,.CDDRN(B)	;YES. MAKE FIRST WORD OF REMOTE ALIAS BLOCK
	ADDI A,2		; TO POINT
	MOVEM A,@.CDDRN(B)	;  TO ALIAS LIST.
GETDR1:	MOVE A,GACTPR		;GET ORIGINAL ACCOUNT POINTER
	MOVEM A,.CDDAC(B)	;MAKE POINTER TO BEGINNING OF ACCOUNT
	RETSKP
;INITIALIZE BUFFER FOR GTDIR (ALSO FOR NEW DIR DEFAULTS)
;TAKES ADDRESS OF BLOCK IN A
;ALLOCATES AND INITIALIZES ALL THE SUBBLOCKS THAT GTDIR NEEDS (USER GROUPS,
;ACCOUNT, SUBDIRECTORY USER GROUPS ALLOWED)

DIRINI::STKVAR <BFA>
	MOVEM A,BFA
	SETZM (A)
	HRL B,A
	HRRI B,1(A)
	BLT B,GTDLN-1(A)
	MOVEI A,UGBUFL		;LENGTH OF USER GROUP BUFFER
	CALL GETBUF		;GET SPACE FOR USER GROUPS
	MOVE B,BFA		;GET ADDRESS OF DIR BLOCK
	MOVEM A,.CDUGP(B)	;REMEMBER ADDRESS OF USER GROUP BUFFER
	MOVEI B,UGBUFL		;LENGTH OF BUFFER
	MOVEM B,(A)
	MOVEI A,DGBUFL		;ALLOCATE DIRECTORY GROUP BUFFER IN SAME WAY
	CALL GETBUF
	MOVE B,BFA
	MOVEM A,.CDDGP(B)
	MOVEI B,DGBUFL
	MOVEM B,(A)
	MOVEI A,SGBUFL		;GET BLOCK FOR ALLOWABLE USER GROUPS
	CALL GETBUF
	MOVE B,BFA
	MOVEM A,.CDCUG(B)	;STORE ADDRESS OF BLOCK FOR USER GROUPS
	MOVEI B,SGBUFL
	MOVEM B,(A)		;SET FIRST WORD OF SUBBLOCK TO COUNT
	MOVEI A,EXTSIZ		;GET ROOM FOR ACCOUNT STRING
	CALL GETBUF
	MOVE B,BFA
	HRLI A,440700		;MAKE REAL BYTE POINTER TO ACCOUNT
	MOVEM A,.CDDAC(B)	;STORE POINTER TO ACCOUNT BLOCK
	SETZM (A)		;INITIALIZE ACCOUNT BUFFER
	MOVEI A,RNAUFL		;GET BLOCK FOR
	CALL GETBUF		; REMOTE ALIAS LIST
	MOVE B,BFA		;STORE
	MOVEM A,.CDDRN(B)	; IT
	MOVEI B,RNAUFL-1	;PUT LENGTH IN
	MOVEM B,1(A)		; IN SECOND WORD OF REMOTE ALIAS BLOCK
	SETZM (A)		;CLEAR FIRST WORD OF REMOTE ALIAS BLOCK
	MOVEI A,GTDLN		;SET UP LENGTH OF BUFFER
	MOVE B,BFA		; IN FIRST
	MOVEM A,.CDLEN(B)	;  WORD OF BUFFER
	RET
;ROUTINE TO RELEASE FREE SPACE TAKEN UP BY A DIRECTORY BLOCK.  THE ITEMS
;RELEASED ARE:
;
;	o	PASSWORD
;	o	USER GROUPS
;	o	DIRECTORY GROUPS
;	o	SUBDIRECTORY ALLOWABLE USER GROUPS
;	o	DEFAULT ACCOUNT STRING FOR LOGIN
;	o	BLOCK FOR REMOTE ALIASES
;
;ACCEPTS:
;	A/	ADDRESS OF DIRECTORY BLOCK
;RETURNS:
;	+1	YES

RELDIR::SAVEAC <Q2,Q1>		;USE AN AC SO INDEXING CAN BE DONE
	MOVE Q1,A		;PRESERVE ADDRESS OF DIRECTORY BLOCK
	HRRZ Q2,(Q1)		;GET LENGTH OF BLOCK
	MOVEI A,EXTSIZ		;SIZE OF PASSWORD BLOCK
	CAILE Q2,.CDPSW		;PASSWORD POINTER GIVEN?
	SKIPN B,.CDPSW(Q1)	;MAYBE, IS THERE ONE THERE?
	CAIA			;NO
	CALL RETBUF		;YES, RELEASE SPACE USED BY PASSWORD
	MOVEI A,UGBUFL		;SIZE OF USER GROUP BLOCK
	CAILE Q2,.CDUGP		;USER GROUP POINTER THERE?
	SKIPN B,.CDUGP(Q1)	;YES, IS IT VALID?
	CAIA			;NO
	CALL RETBUF		;YES, RELEASE GROUPS STORAGE
	MOVEI A,DGBUFL		;LENGTH OF DIRECTORY GROUP BUFFER
	CAILE Q2,.CDDGP		;RELEASE DIRECTORY GROUP BLOCK
	SKIPN B,.CDDGP(Q1)
	CAIA
	CALL RETBUF
	MOVEI A,SGBUFL		;SIZE OF SUBDIRECTORY USER GROUP BUFFER
	CAILE Q2,.CDCUG		;DO SUBDIRECTORY USER GROUPS
	SKIPN B,.CDCUG(Q1)
	CAIA
	CALL RETBUF
	MOVEI A,EXTSIZ		;PREPARE TO RELEASE ACCOUNT STRING STORAGE
	CAILE Q2,.CDDAC		;ACCOUNT POINTER?
	SKIPN B,.CDDAC(Q1)
	CAIA
	CALL RETBUF		;REMOVE ACCOUNT STRING STORAGE
	MOVEI A,RNAUFL		;PREPARE TO RELEASE REMOTE ALIAS STORAGE
	CAILE Q2,.CDDRN		;REMOTE ALIAS
	SKIPN B,.CDDRN(Q1)	; STORAGE ?
	CAIA			;NONE PRESENT.
	CALL RETBUF		;RELEASE STORAGE
	RET

;DIRNAM
;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION.
;SKIP RETURNS WITH ENTIRE WORDS FROM RCDIR OR RCUSR IN A AND C ON SUCCESS.
;	AND THE POINTER TO THE DIR/USER NAME STRING IN B.
;USED IN CONNECT, WHERE, ^EPRINT COMMANDS.
;PRESERVES Q1 (FOR DIRECTORY).
;CALL WITH F1 OFF FOR DEFAULTING TO LOGGED-IN USER NAME OR CURRENT
;CONNECTED DIRECTORY.  CALL WITH F1 ON FOR NO DEFAULTING.

USRNMS::TLOA Z,F5		;ALLOW WILDCARDING
USRNAM::TLZ Z,F5		;NO WILDCARDING
	STKVAR <<USRDEF,EXTSIZ>>
	TLZ Z,F6		;DO NOT RETURN IF AMBIGUOUS
	TLZ Z,F4		;NO DEFAULT
	SKIPE CUSRNO		;NO DEFAULTING ALLOWED IF NOT LOGGED IN
	TLNE Z,F1		;DEFAULTING ALLOWED?
	JRST NODDF1		;NO
	MOVEI A,USRDEF		;POINT AT TEMP STRING AREA
	CALL DFUSER		;GET DEFAULT USER STRING
NODDF1:	TLNE Z,F5		;ALLOW WILDCARDS?
	JRST [	USERSX <User name>
		 RET		;FAILED
		JRST NODDF2]
	USERX <User name>
	 RET			;SINGLE RETURN ON FAILURE
NODDF2:	MOVE C,B		;RETURN USER NUMBER IN C
	PUSH P,A		;SAVE A
	CALL BUFFF		;COPY STRING FROM ATOM BUFFER
	MOVE B,A		;RETURNS STRING POINTER IN B
	POP P,A			;RESTORE A
	RETSKP			;TAKE SKIP RETURN ON SUCCESS

;HERE TO PICK UP THE USERS NAME AND BUILD THE STRING.
;CALL WITH: A/ ADR TO PUT THE STRING

DFUSER::MOVE D,A		;SAVE POINTER
	HRROI A,(D)   		;GET ROOM FOR STRING
	MOVEM A,CMDEF		;REMEMBER POINTER TO DEFAULT STRING
	MOVNI A,1		;PREPARE TO READ ONE JOB DATUM
	HRROI B,A		;WE'LL READ DATUM INTO A
	MOVEI C,.JIUNO		;DEFAULT TO CURRENT USER
	GETJI			;GET INTERNAL FORM OF DEFAULT
	 CALL JERR		;SHOULD NEVER FAIL
	MOVE B,A		;PUT DEFAULT INTO B
	MOVE A,CMDEF		;GET POINTER TO DEFAULT STRING AREA
	DIRST			;MAKE DEFAULT STRING
	 JFCL
	RET

CURNMS::TLO Z,F5!F4		;ALLOW WILDCARDING, DEFAULTING ALLOWED
	TLZ Z,F6
	JRST DIRNA0

CURNAM::TLZ Z,F5!F6		;DO NOT ALLOW WILDCARDING
	TLO Z,F4		;FLAG DEFAULT TO CONNECTED DIR
	JRST DIRNA0
DIRNAM::TLZ Z,F4!F5!F6		;NO WILDCARDING, NO RETN IF AMBIGUOUS, NO DEF'T
DIRNA0:	STKVAR <<DIRDF,EXTSIZ>>
	SKIPE CUSRNO		;NO DEFAULTING ALLOWED IF NOT LOGGED IN
	TLNE Z,F1		;DEFAULTING ALLOWED?
	JRST NODDF		;NO
	HRROI A,DIRDF		;GET BUFFER FOR DEFAULT
	MOVEM A,CMDEF		;DEFAULT WANTED, SET UP POINTER
	MOVNI A,1		;PREPARE TO READ ONE JOB DATUM
	HRROI B,A		;WE'LL READ DATUM INTO A
	MOVEI C,.JIDNO		;FIRST ASSUME DEFAULT TO CONNECTED DIRECTORY
	TLNN Z,F4		;DEFAULT TO LOGGED-IN?
	MOVEI C,.JILNO		;YES, GET LOGGED-IN DIRECTORY NUMBER
	GETJI			;GET INTERNAL FORM OF DEFAULT
	 CALL JERR		;SHOULD NEVER FAIL
	MOVE B,A		;PUT DEFAULT INTO B
	MOVE A,CMDEF		;GET POINTER TO DEFAULT STRING AREA
	DIRST			;MAKE DEFAULT STRING
	 JFCL
NODDF:	TLNE Z,F5		;ALLOW WILDCARDING?
	JRST [	DIRSX <Directory name>
		 RET		;FAILED
		JRST DIRNA1]	;GOT ONE
	DIRX <Directory name>
	 RET			;SINGLE RETURN ON FAILURE
DIRNA1:	CALL BUFFF		;MAKE A COPY OF THE STRING
	PUSH P,A		;SAVE THE POINTER TO THE STRING
	MOVE B,A		;GET POINTER TO DIR NAME AGAIN
	MOVX A,RC%EMO!RC%AWL	;EXACT MATCH AND ALLOW WILDCARDS
	RCDIR			;GET INFO ON THIS DIRECTORY
	 ERJMP [POP P,(P)
		RET]		;IF FAILS, NO SUCH DIR
	POP P,B			;RETURN THE STRING POINTER IN B
	TXNE A,RC%NOM!RC%AMB!RC%NMD
	RET			;NONE FOUND
	RETSKP			;TAKE SKIP RETURN ON SUCCESS
;ROUTINES TO STEP USER AND DIRECTORY NUMBERS WITH RCDIR
;ACCEPTS IN A/	DIR NUMBER
;	    B/	STRING POINTER TO WILDCARD STRING
;	CALL STPDIR	OR	CALL STPUSR
;RETURNS +1:	NO MORE
;	 +2:	A/	NEW DIR NUMBER

STPDIR::SKIPA D,[RCDIR]		;STEP THE DIR NUMBER
STPUSR::MOVE D,[RCUSR]		;STEP THE USER NUMBER
	STKVAR <STPSTP>
	MOVEM B,STPSTP		;SAVE THE STRING POINTER
	MOVE C,A		;GET DIR NUMBER INTO C
	MOVX A,RC%AWL!RC%STP	;STEP THE DIR
	XCT D
	 ERJMP R		;FAILED, NO MORE DIRS
	TXNN A,RC%NMD		;ANY MORE DIR'S?
	TXNE A,RC%NOM!RC%AMB	;FOUND ONE?
	RET			;NO
	MOVE A,C		;RETURN THE NEW NUMBER
	RETSKP
;$GTFDB
;SUBROUTINE TO DO GTFDB JSYS AND SKIP UNLESS
;AN INSTRUCTION TRAP WITH "LIST ACCESS NOT ALLOWED"
;ERROR OCCURRED.
;USED IN DIRECTORY, UNDELETE, DSKSTAT, COPY/APPEND, LIST/TYPE.
;SHOULD BE IN SAME PAGE AS DSKDIR CAUSE ITS IN A LOOP THERE.

$GTFDB::GTFDB
	 ERJMP FDBILI
	RETSKP

;TRAP OCCURRED, CHECK ERROR CODE

FDBILI:	CALL %GETER		;GET ERROR CODE
	PUSH P,A
	HRRZ A,ERCOD
	CAIE A,GFDBX3		;"LIST ACCESS NOT ALLOWED"?
	JRST [	POP P,(P)
		JRST JERRE]
	POP P,A
	RET

;$CHFDB - AS ABOVE FOR CHFDB

$CHFDB::CHFDB
	 ERJMP CHFD1
	RETSKP			;SUCCESSFUL RETURN

CHFD1:	CALL %GETER
	HRRZ A,ERCOD		;RETURN ERROR CODE ON FAILURE
	RET
;OCTCOM INPUTS A 36-BIT OCTAL NUMBER IN EITHER OF TWO FORMATS.  THE
;NUMBER MAY SIMPLY BE TYPED AS A LARGE OCTAL NUMBER, OR AS TWO SMALL
;NUMBERS SEPARATED BY ",,".  IF THE FIRST NUMBER HAS MORE THAN 6
;SIGNIFICANT DIGITS, WE GIVE AN ERROR.  ON CALL,
;A SHOULD CONTAIN THE POINTER TO THE HELP TEXT FOR THE FIELD, AND
;B SHOULD CONTAIN A POINTER TO THE HELP TEXT FOR THE NEXT FIELD.  THIS
;IS NECESSARY BECAUSE AFTER THE FIRST NUMBER HAS BEEN READ, THE OPTIONS TO
;THE USER ARE ",," OR THE NEXT FIELD.

OCTCOM:	STKVAR <HLP1,HLP2,OCTVL,<HLPTXT,40>>
	MOVEM A,HLP1		;SAVE THE HELP POINTERS
	MOVEM B,HLP2
	UOCT @HLP1		;ASK FOR FIRST NUMBER WITH CALLER'S HELP
	 CMERRX
	MOVEM B,OCTVL		;SAVE VALUE
	CALL NESC		;TERMINATED WITH ESC?
	 JRST OCTDON		;YES--ASSUME DONE
	TLC B,-1		;ANY SIGNIFICANCE IN LH?
	TLCE B,-1		;SIGNIFICANCE IS OTHER THAN ALL 1S OR 0S
	TLNN B,-1		;  TO ALLOW -M,,N
	 JRST OCTCO1		;NO--TRY FOR A RIGHT HALF
	JRST OCTDON		;YES--ASSUME NUMBER IS DONE

OCTCO1:	HRROI A,HLPTXT		;BUILD COMBINED HELP MESSAGE
	HRROI B,[ASCIZ /",," to separate left and right halves,
or /]
	SETZ C,
	SOUT			;COMBINE THEM
	HRRO B,HLP2		;TACK ON CALLER'S HELP TEXT
	SOUT
	SETZ B,			;TERMINATE IN ASCIZ FORMAT
	IDPB B,A
	MOVE A,[<ASCIZ /,/>+","];FAKE OUT CHARX
	UCHAR HLPTXT		;LOOK FOR ",,"
	 JRST OCTDON
	HRLZS OCTVL		;FIRST NUMBER WAS LEFT HALF
	DEFX <0>		;DEFAULT RIGHT HALF TO 0
	OCTX <Right half>	;ACCEPT RIGHT HALF OF NUMBER
	 CMERRX
	TLC B,-1		;ANY SIGNIFICANCE IN LH NOW IS AN ERROR
	TLCE B,-1		; BUT ALLOW M,,-N
	TLNN B,-1
	 JRST OCTCO2		;NO--STORE RESULT
	ERROR <Right half exceeds 777777>

OCTCO2:	HRRM B,OCTVL		;STORE REST OF NUMBER
OCTDON:	MOVE A,OCTVL		;RETURN NUMBER TO USER
	RET
;ROUTINE TO INPUT LIST OF OCTAL NUMBER RANGES IN THE FORM:
;N1,N2:N3,N4:N5,N6...
;"RLIST" STARTS WITH COUNT OF NUMBER OF NUMBERS, FOLLOWED BY THE
;NUMBERS THEMSELVES.  NUMBERS ARE ALL TWO-WORD PAIRS SHOWING BEGINNING
;AND END OF RANGE.  FOR INSTANCE, "N1,N2:N3,N4,N5:N6" WOULD GET
;STORED LIKE THIS:
;
;	RLIST/	8	;8 NUMBERS ALTOGETHER (4 PAIRS)
;	RLIST+1/N1
;	RLIST+2/N1	;NOTE THAT FIRST PAIR GOES FROM N1 TO N1!
;	RLIST+3/N2
;	RLIST+4/N3
;	RLIST+5/N4
;	RLIST+6/N4
;	RLIST+7/N5
;	RLIST+8/N6

;THIS ROUTINE RETURNS IF THE USER ENDS A RANGE WITH $.  THIS IS NECESSARY
;TO ALLOW THE USER TO BE PROMPTED FOR THE NEXT FIELD.

OCTLST::SETZM RLIST		;START WITH 0 NUMBERS
OCTL2:	OCTX <Octal number 
 or a pair of octal numbers seperated by a colon to specify a range
 or octal number followed by a comma to specify additional numbers>
	 CMERRX			;AT LEAST ONE NUMBER MUST BE ENTERED
	CALL NUMSTR		;STORE THE NUMBER IN THE LIST
	CALL NESC		;SKIP IF ESCAPE DIDN'T TERMINATE NUMBER
	 JRST NUMREP		;IT DID, SO DON'T INPUT MORE
	COLONX <Colon to specify a range
 or comma to specify additional numbers
 or next field of command>
	 CAIA			;NO COLON TYPED
	JRST OCTL4		;COLON TYPED, GO GET END OF RANGE
	COMMAX <Comma to specify another number
 or next field of command>
	 JRST NUMREP		;NO COMMA OR COLON AFTER NUMBER, MUST BE END OF LIST
	CALL NUMREP		;REPEAT LAST NUMBER
	JRST OCTL2		;GO GET NEXT SET (REQUIRED BECAUSE WE SAW COMMA)
OCTL4:	OCTX <Octal number for end of range>
	 CMERRX
	CALL NUMSTR		;STORE END OF RANGE
	CALL NESC		;DID NUMBER END WITH ESCAPE?
	 RET			;YES, SO GO ON TO NEXT FIELD OF COMMAND
	COMMAX <Comma to specify another number
 or next field of command>
	 RET			;NO COMMA AFTER RANGE, MUST BE END OF LIST
	JRST OCTL2		;COMMA, SO GET ANOTHER PAIR
;SINGLE NUMBER FOLLOWED BY NON-COMMA AND NON-COLON

NUMREP:	MOVE D,RLIST		;TO REPEAT LAST NUMBER, GET END OF LIST
	MOVE B,RLIST(D)		;GET LAST NUMBER, AND FALL INTO REGULAR NUMBER STORE ROUTINE...

NUMSTR:	AOS D,RLIST		;INCREASE NUMBER OF NUMBERS
	MOVEM B,RLIST(D)	;SAVE NUMBER
	RET
;OUTPUT OCTAL NUMBER FROM B, NO LEADING ZEROES OR SPACES.

TOCT:	PUSH P,A
	PUSH P,C
	MOVE A,COJFN		;DESTINATION
	MOVE C,[1B0+10]		;"MAGNITUDE" FLAG AND RADIX
	NOUT
	 CALL JERRC		;GENERAL JSYS ERROR, CODE IN C
	MOVEM A,COJFN		;SAVE IN CASE BYTE POINTER
	POP P,C
	POP P,A
	RET
;TYPE SYSTEM DOWN TIME IF SET

DWNTYP::GJINF
	JUMPN A,R		;NO TYPE IF ALREADY LOGGED IN
DWNPNT::MOVEI D,0		;GET ITEM 0 FROM DWNTIM TABLE
	GTB .DWNTI
	JUMPE A,R		;DO NOTHING IF NOT SET
	CAMN A,[-1]		;IS SYSTEM SHUT DOWN?
	JRST [ETYPE < System is shut down>
	      JRST DWNTY2]
	ETYPE < System shutdown scheduled for %1W>
DWNTY2:	MOVEI D,1		;GET ITEM 1
	GTB .DWNTI
	JUMPE A,DWNTY1		;JUMP IF UPTIME NOT SET
	ETYPE <,
 Up again at %1W>
DWNTY1:	ETYPE<%_>
	RET
;ROUTINE THAT TAKES SIXBIT IN A AND RETURNS A POINTER TO ASCII STRING

GETASC::STKVAR <REMSIX,ASCPR>
	MOVEM A,REMSIX		;REMEMBER THE SIXBIT
	MOVEI A,2		;NEED TWO WORDS FOR ASCII
	CALL GETBUF
	HRLI A,440700		;MAKE BYTE POINTER TO ASCII
	MOVEM A,ASCPR		;REMEMBER POINTER TO ASCII
	HRRI B,REMSIX
	HRLI B,440600		;GET SIXBIT POINTER
	MOVEI D,0		;NULL FOR CLEARING PROCESSED CHARACTERS
ASC1:	SKIPN REMSIX		;ANY MORE LEFT?
	JRST ASC2		;NO
	ILDB C,B		;YES, PICK UP NEXT CHARACTER
	ADDI C,40		;CHANGE TO ASCII
	IDPB C,A		;STORE ASCII CHARACTER
	DPB D,B			;CLEAR CHARACTER SO WE'LL KNOW WHEN WE'VE HIT END
	TLNE B,770000		;DONE SIX CHARACTERS?
	JRST ASC1		;NO, MIGHT BE MORE
ASC2:	MOVEI C,0		;GUARANTEE NULL AT END
	IDPB C,A
	MOVE A,ASCPR		;GET POINTER TO ASCII
	RET			;RETURN POINTER
;ROUTINE TO RETURN SIXBIT VERSION OF LATEST FIELD IN A.
;[4402] Add entry to allow non-alphanumeric characters

GETSXF::TDZA Q2,Q2  		;[4402] Say "allow funny characters"
GETSXB::SETO Q2, 		;[4405] No funny chars allowed
        HRROI A,ATMBUF		;POINT AT WHAT USER TYPED
	CALL GETSIX		;GET SIXBIT VERSION
	 ERROR <Name too long or contains invalid character>
	RET

;ROUTINE TO YIELD SIXBIT DATA FROM THE ASCII STRING POINTED TO BY
;POINTER IN A.  SKIP RETURNS, UNLESS ILLEGAL SIXBIT CHARACTER ENCOUNTERED,
;OR STRING MORE THAN SIX CHARACTERS, IN WHICH CASE A WILL CONTAIN
;SIXBIT THROUGH THE LAST GOOD CHARACTER

GETSIX::STKVAR <ASPTR,SIXPTR>
	CALL FIXPT		;FIX POINTER
	MOVEM A,ASPTR		;REMEMBER ASCII POINTER
	MOVE A,[440600,,A]	;POINTER TO SIXBIT RESULT
 	MOVEM A,SIXPTR
	MOVEI A,0		;START WITH NULL RESULT
	MOVSI B,-6		;DO SIX CHARS MAXIMUM
GETSX1:	ILDB C,ASPTR		;GET NEXT ASCII CHARACTER
	JUMPE C,RSKP		;DONE IF NULL
	CAIN C,""		;THE QUOTING CHARACTER?
	JRST [	ILDB C,ASPTR	;YES, ALLOW NEXT CHARACTER REGARDLESS
		JRST .+1]
	CAIL C,141		;CHANGE LOWERCASE LETTERS TO UPPERCASE
	CAILE C,172
	CAIA			;NOT LOWERCASE
	TRZ C,40		;LOWERCASE, CHANGE IT
	SUBI C,40		;CHANGE TO SIXBIT
	SKIPE Q2 		;[4402] Skip if allowing funny characters
	JUMPL C,R		;IF ILLEGAL CHARACTER, GIVE NON-SKIP
	IDPB C,SIXPTR		;STORE IN SIXBIT RESULT IN A
	AOBJN B,GETSX1		;ONLY DO SIX CHARACTERS
	ILDB C,ASPTR		;GET CHARACTER AFTER SIXTH
	JUMPE C,RSKP		;IF NULL, STRING ENDED "JUST IN THE NICK OF TIME"
	RET			;NON-SKIP IF STRING TOO LONG
;ROUTINE TO CHANGE -1,,FOO TO 440700,,FOO

FIXPT::	TLC A,-1		;IF WAS -1, IS NOW 0 (IF OTHER, IS NOW OTHER')
	TLCN A,-1		;SKIP AND RESTORE IF WASN'T -1
	HRLI A,440700		;CHANGE TO 440700 IF WAS -1
	RET

;BUFFF
;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND
;  RETURN A BYTE PTR TO IT IN A.
;COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END.

BUFFF:	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE A,[POINT 7,ATMBUF]	 ;POINT TO THE FIELD
	CALL BUFFS		;BUFFER THE STRING
	POP P,D
	POP P,C
	POP P,B
	RET

;ROUTINES TO BUFFER A STRING.  GIVE IT POINTER TO STRING IN A.
;ROUTINE RETURNS POINTER TO BUFFERED STRING IN A.
;THE STRING ALWAYS BEGINS ON A WORD BOUNDARY.  (SOME CALLERS ASSUME SO!)
;XBUFFS USES PERMANENT STORAGE, BUFFS USES TEMPORARY STORAGE

XBUFFS::SKIPA B,[XDICT]		;SPECIFY PERMANENT FREE POOL
BUFFS::	MOVEI B,DICT		;TEMPORARY POOL
	CALL READNM		;COPY STRING INTO FREE SPACE
	 ERROR <String space exhausted>
	RET
;ROUTINE TAKING A STRING POINTER IN A.  IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A.  IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
;GIVE IT FREE POOL HEADER ADDRESS IN B

READNM:	STKVAR <FPA,RPTR,NEWPTR>
	MOVEM A,RPTR		;REMEMBER POINTER
	MOVEM B,FPA		;REMEMBER FREE POOL ADDRESS
	CALL BCOUNT		;HOW MANY WORDS IN THIS STRING?
	MOVE B,FPA		;SAY WHICH FREE POOL TO USE
	CALL GETMEM		;GET THAT MANY
	 RET			;COULDN'T, SO TAKE NON-SKIP RETURN
	HRLI B,440700		;MAKE BYTE POINTER TO SPACE OBTAINED
	MOVEM B,NEWPTR		;REMEMBER NEW POINTER
	MOVE A,RPTR		;GET POINTER TO STRING
	CALL FIXPT		;FIX SOURCE POINTER IF NEEDED
	EXCH A,B		;PUT DEST IN A, SOURCE IN B
	MOVEI C,0		;STORE NULL AT END OF STRING
	CALL ASOUT		;COPY THE STRING
	MOVE A,NEWPTR		;GET ADDRESS WHERE STRING GOT PUT
	RETSKP			;SUCCESFUL RETURN

;ARTIFICIAL SOUT ROUTINE FOR OUTPUTTING STRINGS TO MEMORY
;(SAVES HUNDREDS OF INSTRUCTIONS OVER THE JSYS)
;CALL (LIKE SOUT) WITH:
;	A/ POINTER TO TARGET STRING (NO HRROI'S ALLOWED)
;	B/ POINTER TO SOURCE STRING
;	C/ 0==STOP ON NULL; <0==DO -(C) CHARACTERS
;RETURNS UPDATED POINTERS AND C/ 0

ASOUT::	JUMPL C,ASOUTC		;JUMP TO DO A GIVEN NUMBER OF CHARACTERS
ASOUT1:	ILDB C,B		;ELSE GET A CHARACTER
	JUMPE C,ASOUTX		;DONE IF NULL
	IDPB C,A		;ELSE SAVE IT
	JRST ASOUT1		;AND LOOP

ASOUTC:	PUSH P,D		;SAVE A WORK AC
ASOUTD:	ILDB D,B		;[3019]GET A CHARACTER
	IDPB D,A		;SAVE IT
	AOJL C,ASOUTD		;[3019]LOOP UNTIL COUNTED OUT
	CAIA			;THEN SKIP THE AV SAVE
ASOUTX:	PUSH P,D		;SAVE A WORK AC
	MOVE D,A		;GET A FRAGGABLE TARGET POINTER
	IDPB C,D		;END THE STRING WITH A NULL
	POP P,D			;RESTORE THE SCRATCH AC
	RET			;DONE
;ROUTINE TO GET MEMORY BLOCK.  RETURNS +1 ALWAYS WITH ADDRESS OF BLOCK
;IN A.  GIVE IT NUMBER OF WORDS DESIRED IN A.

GTBUFX::SKIPA B,[XDICT]		;PERMANENT STORAGE
GETBUF::MOVEI B,DICT		;USE TEMPORARY POOL
	CALL GETMEM		;GET THE MEMORY
	ERROR <Exec free space exhausted>
	MOVE A,B		;RETURN ADDRESS IN A
	RET

;GETMEM - ROUTINE TO ASSIGN MEMORY AS REQUESTED
;INPUTS:	A - CONTAINS NUMBER OF WORDS WANTED
;      	B - FREE SPACE HEADER ADDRESS
;OUTPUTS:	A - NUMBER OF WORDS OBTAINED
;      	B - CONTAINS ADDRESS OF WORDS GOTTEN
;RETURNS:	SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM

GETMEM::STKVAR <<SAVSTF,2>,DADR>
	MOVEM B,DADR		;REMEMBER HEADER ADDRESS
GETM2:	MOVE C,B		;REMEMBER WHO POINTS TO CURRENT
	HRRZ B,0(C)		;B IS NOW CURRENT BLOCK
	JUMPE B,R		;IF 0, WE HAVE REACHED END OF THE ROAD
	HLRZ D,0(B)		;GET SIZE OF CURRENT BLOCK
	CAMGE D,A		;IS IT SUFFICIENT FOR REQUEST?
	JRST GETM2		;NO, SO TRY NEXT BLOCK
GETM3:	CALL PIOFF		;TURN OFF CONTROL-C INTERRUPTS
	HRL B,0(B)		;GET LINK OF CURRENT BLOCK
	HLRM B,0(C)		;MAKE PREV LINK BE WHAT WAS OUR LINK
	HRRZS B			;ISOLATE CURRENT BLOCKS ADDRESS
	CAMN D,A		;IS THIS AN EXACT MATCH ON SIZE?
	JRST GETRSK		;SUCCESS, SKIP RETURN
	DMOVEM A,SAVSTF		;SAVE NUMBER OF WORDS AND ADDRESS
	ADD B,A			;GET FIRST WORD TO RETURN
	SUBM D,A		;NUMBER OF WORDS TO RETURN
	MOVE C,DADR		;GET ADDRESS OF CONTROL WORD
	CALL RETMEM		;RETURN THE EXTRA WORDS
	DMOVE A,SAVSTF		;RESTORE NUMBER OF WORDS AND ADDRESS
GETRSK:	CALL PION		;TURN CONTROL-C INTERRUPTS BACK ON
	RETSKP			;SUCCESS, SKIP RETURN
;STREM ROUTINE TAKES POINTER TO STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE.  THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE

STREM::	ATSAVE			;NEED TO BE TRANSPARENT
	STKVAR <SPT000>
	MOVEM A,SPT000		;REMEMBER POINTER
	CALL BCOUNT		;COUNT NUMBER OF WORDS IN THE STRING
	HRRZ B,SPT000		;GET RID OF BYTE POINTER P AND S
	CALLRET RETBUF		;RETURN THE BUFFER

;RETBUF RETURNS A BUFFER TO FREE STORAGE
;	A/	SIZE BEING RETURNED
;	B/	ADDRESS OF BLOCK BEING RETURNED

RETBUF::MOVEI C,DICT		;FIRST ASSUME TEMPORARY FREE SPACE
	CAIL B,XFREE		;MAYBE ADDRESS IS IN PERMANENT FREE SPACE
	CAIL B,XFREE+XFRESZ
	JRST RETMEM
	MOVEI C,XDICT		;YES
;	CALLRET RETMEM		;RETURN THE SPACE TO THE FREE POOL
;RETMEM - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
;INPUT:	A - CONTAINS SIZE OF BLOCK TO RETURN
;      	B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
;      	C - FREE SPACE HEADER ADDRESS
;OUTPUT:	NONE
;RETURNS: ALWAYS CPOPJ

RETMEM::HRRZ D,0(C)		;GET PREV'S LINK
	SKIPE	D		;IF CURRENT IS 0 OR
	CAIL D,0(B)		; ITS ADDRESS IS PAST ADDR OF RETURN BLK
	JRST RETM4		;THEN RETURN BLOCK HERE
	MOVE C,D		;MAKE PREV=CURRENT
	JRST RETMEM		;CONTINUE

RETM4:	CALL PIOFF		;TURN OFF CONTROL-C INTERRUPTS
	HRRM D,0(B)		;FORWARD PTR OF RETURNED BLOCK
	HRRM B,0(C)		;FORWARD PTR OF PREV BLOCK
	HRLM A,0(B)		;STORE SIZE OF THIS BLOCK
	ADD A,B			;ADD ADDR+SIZE
	CAIE A,0(D)		;ARE WE RIGHT UP AGAINST NEXT BLOCK?
	JRST RETM5		;NO, CANT COMBINE
	HRRZ A,0(D)		;GET NEXT GUYS FORWARD LINK
	HRRM A,0(B)		;MAKE IT OURS. IE POINT PAST HIM
	HLRZ A,0(B)		;GET OUR SIZE
	HLRZ D,0(D)		;GET HIS SIZE
	ADD A,D			;GET OUR NEW COMBINED SIZE
	HRLM A,0(B)		;STORE INTO RETURNED BLOCK
	HRRZ D,0(B)		;GET LINK OF CURRENT BLOCK
RETM5:	HLRZ A,0(C)		;GET PREV BLOCKS SIZE
	ADDI A,0(C)		;ADD HIS ADDRESS AND SIZE
	CAIE A,0(B)		;DOES HE BUTT RIGHT UP AGAINST US?
	CALLRET PION		;NO, RETURN WITH NO COMBINATION
	HRRM D,0(C)		;MAKE PREV POINT TO OUR NEXT
	HLRZ A,0(C)		;GET HIS SIZE
	HLRZ B,0(B)		;AND OUR SIZE
	ADD A,B			;COMBINE THE SIZES
	HRLM A,0(C)		;STORE COMBINED SIZE
	CALLRET PION		;RETURN
;ROUTINE TO INITIALIZE FREE SPACE STORAGE.  DONE BEFORE EACH COMMAND IS
;EXECUTED.

FREINI::SETZM DICT		;INITIALIZE FREE SPACE SYSTEM
	MOVEI A,FRESIZ		;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
	MOVEI B,FREE		;STARTS AT ADDRESS IN B
	CALL RETBUF		;FREE IT UP IN STANDARD WAY
	MOVEI A,STRSIZ		;ALLOCATE SOME SPACE FOR STRINGS
	CALL GETBUF
	HRLI A,440700		;MAKE POINTER TO STRING STORAGE
	MOVEM A,CSBUFP		;REMEMBER POINTER TO STRING STORAGE
	RET

;ROUTINE TO INITIALIZE PERMANENT FREE SPACE.  THIS IS DONE ONCE PER RUNNING
;OF THE EXEC

XFRINI::SETZM XDICT
	HRROI A,-1		;RELEASE PERMANENT FREE SPACE
	MOVE B,[.FHSLF,,XFREPN]	;TO GUARANTEE THAT RETBUF CAN WRITE INTO IT
	MOVX C,PM%CNT!XFREPZ	;(IF SYMBOL TABLE WAS MAPPED, RETBUF COULD FAIL)
	PMAP
	MOVEI A,XFRESZ
	MOVEI B,XFREE
	CALLRET RETBUF		;RETURN ALL PERMANENT FREE SPACE TO POOL
;BCOUNT MEASURES AN ASCIZ STRING.
;
;ACCEPTS:	A/	POINTER (-1,,FOO O.K.!)
;
;RETURNS+1:	A/	NUMBER OF WORDS NEEDED IN A
;		B/	NUMBER OF CHARACTERS

BCOUNT::CALL FIXPT		;CHANGE -1 TO 440700
	MOVEI B,0		;B WILL ACCUMULATE COUNT OF BYTES
BC1:	ILDB C,A		;READ NEXT BYTE
	CAIE C,0		;DONE COUNTING IF NULL SEEN
	AOJA B,BC1		;NOT DONE, KEEP COUNTING
	MOVE D,B		;REMEMBER EXACT COUNT IN D
	AOJ B,			;LEAVE ROOM FOR NULL
	IDIVI B,5		;GET NUMBER OF WORDS
	CAIE C,0		;EXTRA CHARACTERS?
	AOJ B,			;YES, THEY TAKE A WHOLE WORD
	MOVE A,B
	MOVE B,D		;RETURN BYTE COUNT IN B
	RET

;ROUTINE TO RETURN HOST'S NODE NAME.  RETURNS A POINTER TO IT IN A.
;THIS RETURN SKIPS IFF SUCCESSFUL

GETNOD::MOVEI A,.NDGLN		;SAY WE WANT HOST'S NODE NAME
	MOVEI B,CSBUFP		;USE POINTER TO STRING SPACE TO WRITE THE NAME
	MOVE C,CSBUFP		;REMEMBER POINTER TO NAME
	NODE			;GET THE NAME
	 ERJMP R		;FAILED, GIVE SINGLE RETURN
	MOVE A,C		;GET POINTER TO NAME
	CALL BUFFS		;BUFFER THE NAME AND RETURN
	RETSKP
;SUBROUTINE TO TURN OFF ECHOING BEFORE PASSWORD INPUT

NOECHO:	PUSH P,C
	TXO Z,NECHOF		;SAY ECHOING OFF (TESTED IN %NOI)
	MOVEI C,0		;SAY NO ECHOING NOHOW
	JRST ECHOST		;JOIN "DOECHO"

;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT

DOECHO::TXNN Z,NECHOF		;WAS ECHOING OFF?
	RET			;NO, SO NOTHING TO DO
	PUSH P,C
	MOVEI C,2		;SAY IMMEDIATE OR DEFERRED ECHOING
ECHOST:	PUSH P,A		;ENTRY TO SET ECHO BITS FROM C
	PUSH P,B
	MOVE A,CIJFN
	RFMOD			;READ TELETYPE MODE WORD
	DPB C,[POINT 2,B,25]
	SFMOD			;SET TTY MODE WORD
	CAIN C,2		;ECHOING NOW ON?
	TXZ Z,NECHOF		;SAY ECHOING NOT SUPPRESSED
	POP P,B
	POP P,A
	POP P,C
	RET
;LTTYMD - LOAD TELETYPE MODES
;AC Q1 POINTS TO 11-WORD BLOCK OF VALUES TO PUT INTO EFFECT:
;SEE EXECDE FOR STRUCTURE OF BLOCK

UTTYMD::PUSH P,A		;SAVE REG
	SKIPLE A,FORK		;USER CURRENT FORK
	 CALL FTTYMD		;IF VALID
	POP P,A			;RESTORE REG
	RET			;RETURN

FTTYMD::SKIPN Q1,SLFTAB(A)	;SET UP MODE BLOCK PNTR
	 RET
	MOVEI Q1,.FKPTM(Q1)	;ADDRS OF FORK'S MODE BLOCK
LTTYMD:	SKIPN (Q1)		;DO NOTHING IF BLOCK IS 0 DUE TO A BUG OR
	RET			;A STRANGE INTERRUPT-RESTART SEQUENCE
	ATSAVE
	MOVEI A,.CTTRM
	MOVE B,TTWMOD(Q1)	;FILE MODE WORD
	TXZ B,TT%OSP		;ENSURE NO OUTPUT SUPPRESS
	SFMOD
	GJINF			;GET JOB INFO
	JUMPL D,NOTTY1		;SEE IF WE ARE DETACHED
	MOVEI A,.CTTRM		;HAVE TERMINAL, USE CONTROLLING TTY
	DVCHR			;MTOPR WORKS ON TTY ONLY
	LDB B,[POINTR B,DV%TYP]	;GET DEVICE TYPE CODE
	CAIE B,.DVTTY		;SKIP IF IT'S A TERMINAL
	JRST NOTTY1		;NO - NOT A TTY
	MOVEI A,.CTTRM		;NOW RESTORE THE MASK
	MOVEI B,.MOSBM
	MOVEI C,TTWMSK(Q1)
	MTOPR
	 ERJMP NOTTY1		;ERROR MEANS WRONG MONITOR
	MOVEI B,.MOSFW		;NOW FOR THE FIELD WIDTH
	MOVE C,TTWFWT(Q1)
	MTOPR
	MOVEI A,.CTTRM
NOTTY1:	MOVE B,TTWCOC(Q1)	;2 CCOC WORDS
	MOVE C,TTWCOC+1(Q1)
	SFCOC
	MOVEI A,.FHSLF
	RPCAP
	TXON	C,SC%CTC	;CAN'T SET JOB TIW IF NO ^C PRIV
	JRST [	TXNN B,SC%CTC	;^C NOT ENABLED.  ENABLABLE?
		JRST NOSTIW	;NO, DON'T TRY THE STIW
		EPCAP		;ENABLABLE, SO DO IT
		JRST .+1]	;NOTE: LOGIN JSYS CLEARS AC3 CAPABILITIES!
	MOVEI A,.FHJOB
	MOVE B,TTWJTI(Q1)	;SET JOB TIW
	STIW
NOSTIW:	MOVE A,TTWSNM(Q1)	;GET SUBSYS NAME
	MOVE B,TTWPNM(Q1)	;GET PROGRAM NAME
	SETSN			;SET THEM
	 CALL JERR
	RET
;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC
; INTO 6-WORD BLOCK THAT AC Q1 POINTS TO.

RFTYMD::SKIPN Q1,SLFTAB(A)	;SET UP MODE BLOCK PNTR
	 RET
	MOVEI Q1,.FKPTM(Q1)	;MODES FOR FORK
RTTYMD:	ATSAVE
	MOVEI A,.CTTRM
	RFMOD
	MOVEM B,TTWMOD(Q1)
	GJINF			;GET JOB INFO
	JUMPL D,NOTTY2		;SEE IF WE ARE DETACHED
	MOVEI A,.CTTRM		;HAVE TERMINAL, USE CONTROLLING TTY
	DVCHR			;MTOPR WORKS ON TTY ONLY
	LDB B,[POINTR B,DV%TYP]	;GET DEVICE TYPE CODE
	CAIE B,.DVTTY		;SKIP IF IT'S A TERMINAL
	JRST NOTTY2		;NO - NOT A TTY
	MOVEI A,4		;PUT LENGTH INTO BLOCK
	MOVEM A,TTWMSK(Q1)
	MOVEI A,.CTTRM		;NOW SAVE THE MASK
	MOVEI B,.MORBM
	MOVEI C,TTWMSK(Q1)
	MTOPR
	 ERJMP NOTTY2		;ERROR MEANS WRONG MONITOR
	MOVEI B,.MORFW		;NOW FOR THE FIELD WIDTH
	MTOPR
	MOVEM C,TTWFWT(Q1)
	MOVEI B,.MOSFW
	SETZ C,			;TURN OFF FIELD WIDTH
	MTOPR
NOTTY2:	MOVEI A,.CTTRM
	RFCOC
	MOVEM B,TTWCOC(Q1)
	MOVEM C,TTWCOC+1(Q1)
	MOVEI A,.FHJOB
	RTIW
	MOVEM B,TTWJTI(Q1)
	SETO A,			;SAY THIS JOB
	MOVE B,[-2,,C]		;SAY 2 WORDS INTO C AND D
	MOVEI C,.JISNM		;STARTING WITH SUBSYS NAME
	GETJI			;GET SUBSYS AND PROGRAM NAME
	 CALL JERR
	MOVEM C,TTWSNM(Q1)	;SAVE THEM
	MOVEM D,TTWPNM(Q1)
	RET

;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS
;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT.
;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE;
;TO CHANGE IT USER MUST: A) USE A PROGRAM, SUCH AS DDT, OR B) TEMP SET
; OUTFILE=INFILE (IF PSEUDO-ECHOING DOESN'T INTERFERE). 4/22/70.
;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS

%PRINT:	PUSH P,A
	PUSH P,B
	AOS TTYACF		;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE
	MOVE A,COJFN
	HRRZ B,40
	BOUT
	MOVEM A,COJFN		;IN CASE IT'S A BYTE POINTER
	AOS TTYACF		;AGAIN IN CASE BLOCKED DUE TO FULL BUFFER
	POP P,B
	POP P,A
	RET

;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?)

COUTC::	PUSH P,A
	MOVE A,COJFN		;GET OUTPUT STREAM
	TLNE A,-1		;BYTE POINTER?
	JRST [	IDPB B,COJFN	;YES, SAVE TIME TO OPTIMIZE ETYPE
		JRST COUTC1]
	AOS TTYACF		;TELL AUTOLOGOUT THAT THERE'S BEEN TTY ACTIVITY
	BOUT			;MONITOR CALL TO OUTPUT CHARACTER
	AOS TTYACF
COUTC1:	POP P,A
	RET
;TBOUT, TSOUT0 -- USED INSTEAD OF BOUT AND SOUT WHERE TEXT
;MAY CONTAIN EOL'S.

TBOUT::	BOUT			;(ACH - SOMEBODY WANT TO TELL ME WHY THIS
	RET			;       IS BETTER THAN A BOUT IN THE CODE?)

;SOUT WHERE C=0, I.E. TERMINATE ON NULL

TSOUT0::PUSH P,C
	SETZ C,
	SOUT
	POP P,C
	RET

REPEAT 0,<
TSOUT0::PUSH P,C		;SAVE AN AC
	MOVE C,B		;PUT THE POINTER IN THAT AC
	TLC C,-1		;CHANGE -1 LEFT HALF TO A POINTER
	TLCN C,-1
	HRLI C,440700

TSOUT1:	ILDB B,C		;GET THE NEXT CHARACTER
	JUMPE B,TSOUTE		;NULL TERMINATES, RESTORE UPDATED PTR
	BOUT			;ELSE OUTPUT THE CHARACTER AND LOOP
	JRST TSOUT1

TSOUTE:	MOVE B,C
	POP P,C
	RET
>
;RANDOM reads a word from the current fork.
;
;Accepts:	A/	address to read
;
;Returns+1:	Nonexistent or unreadable
;	+2:	A/	contents

RANDOM::STKVAR <WAA>
	MOVEM A,WAA		;REMEMBER ADDRESS
	CALL MAPPF		;MAP IN THE PAGE
	 RET			;FAILED, SAY SO.
	LDB A,[001100,,WAA]	;GET OFFSET INTO BUFFER
	MOVE A,PAGEN(A)		;GET THE DATA
	 ERJMP R		;IF CAN'T, GIVE FAILURE RETURN
	RETSKP			;GIVE SUCCESS RETURN WITH DATA IN A
;MAP A PAGE OF A FORK
;Accepts in A:	A 30-bit address in the fork, or -1 to clear the buffer
;	FORK:	Fork handle
;Returns:
;	+1: 	Cannot map process (last error says why)
;	+2:	Success,
;	A:	Untouched
;	B:	Access and existence bits (from RPACS), unless A had -1
;	PAGEN:	The page mapped

MAPPF:	PUSH P,C
	PUSH P,A
	JUMPL A,MPPF1
	SKIPL FORK		;IS THERE A CURRENT FORK?
	IFSKP.
	 MOVEI A,.FHSLF		;NO - SET AN ERROR FOR OUR FORK
	 MOVEI B,ILLX04		;REFERENCE TO NON-EXISTENT PAGE
	 SETER			;SET THE ERROR
	  ERJMP .+1		;IGNORE THE ERROR
	 JRST MAPPFF		;GO RETURN THE ERROR
	ENDIF.
	TDNN A,[777776,,777760]	;SECTION 0 OR 1, ADDRS 0-17 ARE ACS
	JRST MAPACS
	LSH A,-^D9		;SEPARATE PAGE #
	HRL A,FORK		;FORK HANDLE OF PAGE WE WANT
	TLO A,(1B0)		;SAY FORK HANDLE NOT JFN
MPPF1:	MOVEI B,PAGEN		;GENERATE DESTINATION PAGE IDENTIFIER
	LSH B,-^D9		;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL
	TLO B,(1B0)		;...SAY THIS FORK
	MOVX C,PM%RD!PM%WR!PM%EX ;REQUEST ALL ACCESS, NORMAL DISPOSAL
	CAME A,NPAGE		;SAVE TIME IF ALREADY MAPPED
	PMAP			;MAP IT
	 ERJMP NOX		;CAN'T MAP-- JUST SAY DOESN'T EXIST
	MOVEM A,NPAGE		;SAY IT'S MAPPED
	CAMN A,[-1]
	JRST MPPF8
	RPACS			;GET ACCESS/EXISTENCE OF MAPPED PAGE
	 ERJMP NOX1		;SECTION CONTAINING PAGE DOESN'T EXIST
	JUMPN B,MPPF8		;ANY BITS?
	TXO B,PA%WT		;NO - SET WRITE ACCESS (NEW PAGE)
	JRST MPPF8		;RESTORE AND RETURN +2

;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS".
;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION.

MAPACS:	SETO A,
	CALL MAPPF		;UNMAP PAGE IN BUFFER, IF ANY.
	 JFCL			;UNMAP SHOULDN'T FAIL
	MOVE A,FORK
	MOVEI B,PAGEN
	RFACS			;READ FORK ACS INTO "PAGEN"
	 ERJMP MAPPFF		;FAILED-- RESTORE ACS AND RETURN +1
	MOVX B,PM%RD!PM%WR!PM%EX!PM%PLD	;REQUEST ALL ACCESS, NORMAL DISPOSAL
	SKIPA			;SKIP NOX
NOX1:	SETZ B,			;SECTION CONTAINING PAGE DOESN'T EXIST
MPPF8:	POP P,A			;RH A TRANSPARENT
	POP P,C
	RETSKP			;RETURN +2 SUCCESS FROM MAPPF

NOX:	SETZ B,			;SECTION CONTAINING PAGE DOESN'T EXIST
MAPPFF:	POP P,A			;RESTORE ALL
	POP P,C			;. . .
	RET			;AND RETURN +1 FROM MAPPF
;LOAD SINGLE WORD FROM FORK, GIVEN ADDRESS IN A

LOADF:	CALL MAPPF
	 RET			;FAILED-- RETURN +1
	TXNN B,PA%PEX
	ERROR <No such page>
	TXNN B,PA%RD
	ERROR <Can't read that page>
	ANDI A,777
	MOVE A,PAGEN(A)
	RETSKP			;RETURN +2 FROM LOADF

;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A

STOREF:	PUSH P,B		;SAVE WORD TO STORE OVER MAPPF
	CALL MAPPF
	 JRST [	POP P,B
		RET]		;FAILED-- RETURN +1
	TXNE B,PA%PEX		;OK TO STORE IF PAGE NON-EXISTENT
	TXNE B,PA%WT!PA%CPY	;OR IF WRITE ACCESS OR COPY ON WRITE PERMITTED
	CAIA
	ERROR <Can't write into page>
	ANDI A,777
	POP P,B			;GET BACK VALUE TO STORE
	MOVEM B,PAGEN(A)
	RETSKP
;%GTB
;SUBROUTINE TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN AC A, INDEX IN RH OF D, RETURN +1 WITH WORD IN A.
;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
;	FOR USE IN OTHER JSYS CALLS INSIDE LOOP.

%GTB:	HRL A,D			;PUT THE INDEX IN WITH THE TABLE NUMBER
	GETAB			;AS FOR THE VALUE
	 SETZ A,		;ERROR - RETURN ZERO AS THE VALUE
	RET

;ERROR, PSEUDO-INTERRUPT, %-MESSAGE-TYPING STUFF

;PSI ROUTINE FOR TERMINAL CHARACTER THAT PRINTS RUNTIME (^T)

USEPSI:	CALL SAVACS		;DON'T CLOBBER ANY AC'S (LIKE 16!)
	CALL USEX		;DO THE WORK
	CALL RESACS		;RESTORE AC'S
	DEBRK			;DISMISS THE INTERRUPT
USEX:
	STKVAR <CIJFN0,COJFN0,SAV40,SVHNDL>
	MOVE A,CIJFN
	MOVE B,COJFN
	MOVEM A,CIJFN0		;SAVE POSSIBLE DIVERTED OUTPUT
	MOVEM B,COJFN0
	MOVE A,40
	MOVEM A,SAV40		;POSSIBLE UUO IN PROGRESS
	MOVEI A,.PRIOU		;ALWAYS DISPLAY OUTPUT TO PRIMARY,
	MOVEM A,COJFN		;SINCE THAT'S WHERE ^T WAS TYPED FROM.
	ETYPE < %A>		;START WITH CURRENT TIME
	SKIPL PCCIPF		;[PCL] PCL command in progress or
	SKIPE CIPF		;COMMAND IN PROGRESS?
	JRST USEPS9		;YES, DIFFERENT MESSAGE
	SKIPLE EFORK		;EPHERMERAL?
	 JRST [	GETNM		;YES - GET NAME
		ETYPE < %1' (;E)>
		MOVE A,EFORK	;TELL USER ^T IN EPHERMERAL
		JRST USEPS0]
	SKIPGE A,FORK
	JRST USEPS2		;NO INFERIOR
	SKIPN B,SLFTAB(A)	;LOAD B WITH FORK TABLE INDEX
	 JRST USEPS0		;IF 0, WE DON'T KNOW THIS PROGRAM
	GETNM
	CAMN A,['EXEC  ']	;IS CURRENT PROG NAME EXEC?
	 JRST [ SKIPE B,.FKPTM+TTWPNM(B) ;YES, GET NAME FROM TABLE
		 MOVE A,B	;IF NON-NULL, USE IT
		JRST .+1 ]
	ETYPE < %1'>		;NO, JUST TYPE WHAT GETNM FOUND
	MOVE A,FORK
USEPS0:	TYPE < >		;SEPARATE NAME AND STATUS
	CALL FSTAT		;PRINT STATUS & PC OF INFERIOR (HANDLE IN A)
	PRINT " "		;FSTAT IS IN EXECIN.MAC
USEPS2:	HRROI A,-1		;GET LOAD AVERAGES FOR CURRENT JOB
	CALL GLOADS		;GET LOAD AVERAGES
	ETYPE < Used %V in %C, Load %2Q>
	CALL USEPSM		;IF MIC EXISTS, SAY A DO IS PROGRESS (EXECCA)

USEOU1: TYPE <
>
	MOVE A,SAV40
	MOVEM A,40
	MOVE A,CIJFN0
	MOVEM A,CIJFN
	MOVE B,COJFN0
	MOVEM B,COJFN		;RESTORE POSSIBLE BUFFERED OUTPUT
	RET
;IF ^T DURING COMMAND EXECUTION, TELL USER WHAT COMMAND IS BEING
;EXECUTED.

USEPS9:	MOVE B,COMAND		;GET POINTER TO COMMAND
	SKIPE PCCURC		;PCL During PCL execution?
	JRST [	SKIPN B		;PCL Yes, is the command name gone?
		HRROI B,[ASCIZ/Stored/]	;PCL Yes, use generic name
		JRST .+1]	;PCL
	ETYPE < %2M command >
	SKIPN DBGEXC		;DEBUGGING THE EXEC ?
	IFSKP.
	 MOVEI A,.FHSLF		;YES - GET OUR FORK HANDLE
	 EXCH A,FORK		;UPDATE FORK 
	 MOVEM A,SVHNDL		;SAVE THE FORK HANDLE
	 MOVE A,LEV3PC		;GET OUR INTERRUPTED PC
	 TLZ A,770000		;WIPE OUT THE FLAGS
	 ETYPE < at %1Y >	;TYPE IT OUT
	 MOVE A,SVHNDL
	 MOVEM A,FORK		;RESTORE FORK
	ENDIF.
	JRST USEPS2		;JOIN COMMON CODE
CERR:	CMERRX			;CATCH-ALL COMMAND ERROR

;ROUTINE TO HANDLE CMERRX MACRO CALL.

CMERR$:	STKVAR <MP,SEP2,ATMP,SAVBLK>
	MOVEI A,SBLKLN		;SAVE STATE BLOCK SO ERROR HANDLING DOESN'T RUIN ^H
	CALL GETBUF		;GET ROOM TO SAVE IT
	MOVEM A,SAVBLK		;REMEMBER WHERE BLOCK IS
	HRLI A,SBLOCK		;MAKE BLT POINTER
	MOVEI B,SBLKLN-1(A)	;GET LAST ADDRESS TO BE SAVED INTO
	BLT A,(B)		;SAVE STATE BLOCK
	SETZM SEP2		;NO SECOND SEPARATOR YET
	SETZM ATMP		;NO ATOM TO PRINT YET
	HRROI A,@40		;GET POINTER TO MESSAGE
	MOVEM A,MP		;REMEMBER POINTER TO MESSAGE
	MOVE D,[440700,,ATMBUF]	;FIRST TRY TO USE ATOM BUFFER
	MOVE B,D		;SEE IF ANYTHING IN IT
	ILDB B,B
	JUMPN B,CMERR1		;IF SO, NO NEED TO SLURP COMMAND BUFFER UP.
	SKIPN CMCNT		;ROOM FOR ONE MORE CHARACTER?
	JRST CMERR2		;NO, FORGET IT
	MOVE A,CMINC		;GET NUMBER OF UNPARSED CHARACTERS
	ADJBP A,CMPTR		;GET POINTER TO END OF BUFFER
	MOVEI B,.CHLFD		;USE LINEFEED TO PREVENT COMND FROM GOING INTO I/O WAIT
	IDPB B,A		;PUT LINEFEED IN BUFFER
	SETZ B,			;MAKE SURE THERE IS A NULL AT THE END
	IDPB B,A
	SOS CMCNT		;REMEMBER THERE'S ROOM FOR ONE LESS CHARACTER
	AOS CMINC		;REMEMBER THERE'S ONE MORE UNPARSED CHARACTER
	MOVEI B,[FLDDB. .CMTXT]	;READ REST OF LINE INTO ATOM BUFFER
	CALL FLDSKP
	 JRST CMERR2		;IF THAT FAILS, HANG IT UP.
	MOVE D,[440700,,ATMBUF]	;POINT TO STRING WHICH IS REST OF LINE
	MOVE B,D		;GET COPY OF POINTER
	ILDB B,B		;SEE IF THERE'S ANYTHING ON LINE
	JUMPE B,CMERR2		;IF NOT, DON'T ATTEMPT TO PRINT MORE OF STRING
CMERR1:	HRROI B,[ASCIZ / - "/]	;GET SECOND SEPARATOR
	MOVEM B,SEP2
	MOVE A,CSBUFP		;PREPARE TO BUILD STRING WITH ATOM AND CLOSE QUOTE
	MOVE B,D		;POINT TO ATOM
	MOVEI C,.CHNUL		;STOP ON NUL
	SOUT			;PUT ATOM IN STRING
	HRROI B,[ASCIZ /"/]	;CLOSE QUOTE AND PUT IN NULL
	SOUT
	MOVE A,CSBUFP		;POINT TO ENTIRE STRING
	CALL BUFFS		;ISOLATE THE STRING
	MOVEM A,ATMP		;SAVE POINTER TO ATOM BUFFER
CMERR2:	HRL A,SAVBLK		;RESTORE STATE BLOCK SO ^H WORKS
	HRRI A,SBLOCK
	BLT A,SBLOCK+SBLKLN-1
	HRROI B,[ASCIZ / - /]	;FIRST ASSUME MESSAGE HAS TWO PARTS
	MOVE A,MP		;GET MESSAGE POINTER
	SKIPN (A)		;IS CALLER SUPPLYING SPECIFIC STRING?
	HRROI B,[0]		;NO, SO NO SEPARATOR NEEDED BETWEEN STRINGS
	MOVE C,SEP2		;GET POSSIBLE SECOND SEPARATOR
	MOVE D,ATMP		;GET POSSIBLE ATOM POINTER
	ERROR <%1M%%2M%%?%%3M%%4M> ;USER, SEPARATOR, MONITOR, SEPARATOR, ATOM
;NOT IMPLEMENTED YET ERROR
;DISPATCH TO HERE AUTOMATICALLY SUPPLIED BY COMMAND TABLE ENTRY MACRO
; IF NO ROUTINE IS DEFINED FOR THE COMMAND.

NIM:
NIYE:	ERROR <Not implemented yet>

;INTERNAL ERROR

SCREWUP:HRRZ Q1,(P)		;PC (GET HERE WITH PUSHJ)
	SUBI Q1,1
	ERROR <Internal error at %5P>

;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1.
;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT.
;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS
; BEFORE COMING TO THIS GENERAL ROUTINE.
;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR"
; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE
; JSYS'S. 6/26/70.

JERR:	MOVEM A,ERCOD		;SAVE ERROR NUMBER
JERR1:	CALL ERFRST		;GET SET TO TYPE MSG
	CALL CRIF		;EOL UNLESS AT LEFT
	HRRZ Q2,(P)		;PC (GOT TO JERR WITH PUSHJ)
	SUBI Q2,2		;PROBABLE LOC OF JSYS
	CALL PIOFF		;DON'T ALLOW ^C WHILE FORK IS AMOK
	MOVEI A,.FHSLF		;USE OUR SYMBOL TABLE FOR MESSAGE
	EXCH A,FORK
	ETYPE <JSYS error at %6Y>
	EXCH A,FORK		;RESTORE FORK CELL
	CALL PION		;ALLOW INTERRUPTS AGAIN
	CALL SYSERA		;GO TYPE SYSTEM ERROR MESSAGE
	JRST ERRFIN		;FINISH

JERRC:	MOVEM C,ERCOD		;"JERR" FOR ERROR CODE IN C
	JRST JERR1		;  (AS AFTER "NOUT")
;ROUTINES FOR USE WITH ERJMP AND ERCAL JSYS RETURNS
;GET ERROR CODE FROM SYSTEM AND STORE IN ERCOD
;THEN CALL REGULAR ERROR PRINT

JERRE::	CALL %GETER
	JRST JERR1

CJERRE::CALL %GETER
	JRST CJERR1

;ERROR RETURN FROM JSYS WHERE ERROR MESSAGE FROM JSYS SHOULD BE
;MEANINGFUL TO USER

CJERR::	MOVEM A,ERCOD
CJERR1:	CALL ERFRST		;INIT ERROR STUFF
	CALL SYSERA		;PRINT JSYS MSG ONLY
	JRST ERRFIN		;FINISH

;ROUTINE TO PRINT WARNING ABOUT FAILING JSYS.
;PUT "JWARN" AFTER ANY JSYS THAT ISN'T EXPECTED TO FAIL, BUT FOR WHICH
;YOU DON'T REALLY CARE IF IT DOES, EXCEPT THAT YOU WANT THE USER TO KNOW
;WHY.

RJWARN::ETYPE <%_%%%Unexpected error:	%?%%_%%% proceeding...%_>
	RET			;RETURN TO CALLER
;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE
;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING
;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT.
;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN EXEC",
;  TYPE SYSTEM ERROR MESSAGE WITH
;  REGULAR ROUTINE, AND RETURN TO COMMAND INPUT.

%TRAP:	PUSH P,D
	PUSH P,Q1
	MOVE Q1,@40		;GET LEVEL
	CAILE Q1,0
	CAILE Q1,3		;LEGAL LEVEL?
	SKIPA Q1,[0,,-1]	;NO, GIVE -1
	HRRZ Q1,PCTAB(Q1)	;YES, GET PC
	CALL ICLEAR		;CLEAR THIS INTERRUPT
	MOVEI D,RERET		;CHANGE ERROR ROUTINE RETURN
	MOVEM D,CERET		;...TO "REGULAR"
	SETZM .JBUFP		;SAY FLUSH ALL JFNS

;HERE WE MUST CHECK FOR EOF IN COMMAND FILE AND HANDLE SPECIALLY.
;ALSO I'M SURE MANY OTHER EXECEPTIONAL CASES WILL TURN UP.

	MOVE D,40		;SAVE TEXT ADDRESS
	CALL ERFRST		;DO THINGS NEEDED BEFORE TYPING MESSAGE
	CALL CRIF		;EOL IF CARRIAGE NOT AT LEFT MARGIN
	UTYPE 1(D)		;TYPE CHANNEL-SPECIFIC MESSAGE
	ETYPE	< internal trap at %5P>
	POP P,Q1
	POP P,D
	PUSH P,[ERRFIN]		;WHERE TO GO AFTER ERROR MESSAGE PRINTING
	PUSH P,[U$ERR]		;NO MESSAGE
	JRST ERR1		;GO FINISH ERROR PROCESSING

;NOTE: EXCEPT FOR ^O, THERE ARE NO INTERRUPTS WHICH DEBREAK TO THE POINT
;OF INTERRUPTION.  HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET"
;BEING CHANGED.  BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO
;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED.
;PDL OVERFLOW.  THIS ROUTINE MUST FIRST CLEAR THE STACK BEFORE IT
;CAN CALL ANYTHING ELSE!

PDLOV::	XCT INISTK		;CLEAR THE STACK
	TRAP LV.POV,<Pushdown overflow>

;ILLEGAL INSTRUCTION PSI
;GO TO SPECIAL CASE ROUTINE ILIDSP POINTS TO, IF NON-0,ELSE
;TREAT LIKE OTHER ERROR PSI'S.
;ILIDSP USED, FOR INSTANCE, TO DETECT "LIST ACCESS NOT ALLOWED" FROM
; GTFDB JSYS.
;SPECIAL ROUTINE GETS ERROR CODE IN ERCOD.
;IF SPECIAL ROUTINE ISN'T INTERESTED IN THIS PARTICULAR ERROR,
; IT CAN JRST TO ILIPSI AGAIN.

ILIPSI:	MOVE A,[CALL CUUO]	;RESET UUO DISPATCH TO PROTECT
	MOVEM A,41		; IT FROM MALICIOUS USERS (AND IF TRASHED)
	SKIPE ILIDSP		;IS THERE A SPECIAL DISPATCH?
	JRST ILIDO		;YES, DO IT
	STKVAR <ILCOD>
	CALL DGETER		;SEE WHY FAILED
	MOVEM A,ILCOD		;REMEMBER
	CALL ICLEAR		;CLEAR INTERRUPT
	HRRZ A,LV.ILI+PCTAB	;GET PC OF ERROR
	MOVE B,ILCOD		;PRINT REASON
	ERROR <Internal illegal instruction at %1O - %2?>

ILIDO:	CALL ILI0		;DO THE WORK
	DEBRK			;DISMISS TO SPECIAL PLACE

ILI0:	ATSAVE
	MOVE A,ILIDSP		;GET WHERE TO GO
	MOVEM A,LV.ILI+PCTAB	;TELL DEBRK
	SETZM ILIDSP		;CLEAR SPECIAL DISPATCH
	MOVEI A,.FHSLF
	GETER			;GET ERROR CODE
	HRRZM B,ERCOD		;ERROR CODE, FOR SPECIAL ROUTINE
	RET			;DISPATCH TO SPECIAL ROUTINE
;END-OF-FILE INTERRUPT
;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR,
; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS.
;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS.

EOFPSI:	CALL SAVACS		;DON'T CLOBBER AC'S
	CALL ICLEAR		;CLEAR INTERRUPT
	CALL RESACS		;RESTORE AC'S
	JRST EOFCHK		;HANDLE CONDITION

;CALL THE FOLLOWING ROUTINE AFTER A FAILING TEXTI.  IT CHECKS THE
;ERROR CODE FOR END-OF-FILE CONDITION, HANDLING SPECIALLY.  OTHER ERRORS
;ARE HANDLED STANDARDLY.

EOFJER::CALL GETERR		;GET ERROR CODE
	CAIE A,IOX4		;END OF FILE?
	CALL CJERRE		;NO, TREAT AS UNEXPECTED ERROR
	SKIPN PCCURC		;[PCL] Unless in a PCL,
	CALL CMDINI		;RE-INIT COMMAND, TO PROTECT OURSELF
	POP P,(P)		;THROW AWAY THE CALL TO THIS ROUTINE
	JRST EOFCHK

;ROUTINE TO HANDLE END OF FILE CONDITION.

EOFCHK:	SKIPN EOFDSP
	TRAP LV.EOF,<Unexpected end-of-file> ;NO SPEC DISPATCH, TREAT AS ERROR
	PUSH P,EOFDSP		;PREPARE TO DISPATCH TO SPECIAL PLACE WITHOUT CLOBBERING AC'S
	SETZM EOFDSP		;DON'T ALLOW FURTHER INTERRUPTS
	RET			;SERVICE THE END OF FILE CONDITION
;QUOTA EXCEEDED INTERRUPT
;DISPATCH ON QTADSP IF NON-ZERO, ELSE TREAT LIKE OTHER
;"PSEUDO-INTERRUPTS". QTADSP IS USUALLY NON-ZERO DURING ROUTINES
;WHICH WOULD CREATE PAGES AND WISH TO HELP THE USER.

QTAPSI::CALL SAVACS		;SAVE A REG
	SKIPN QTADSP
	CALL ICLEAR		;CLEAR INTERRUPTS IF NO SPECIAL DISPATCH ADDRESS
	SKIPN QTADSP		;CHECK ROUTINE ADDRS
	ERROR <User resource failure in EXEC, %?> ;NOT SPECIAL, GIVE MONITOR MSG
	MOVE A,QTADSP		;GET ADDRS OF SPECIAL ROUTINE
	HRRM A,PCTAB+LV.QTA	;SET UP FOR DEBRK
	SETZM QTADSP		;ONLY ONCE
	CALL RESACS		;RESTORE
	DEBRK			;BYE

;MACHINE SIZE EXCEEDED INTERRUPT

MSEPSI::CALL SAVACS
	CALL ICLEAR
	CALL RESACS
	CALL GETERR		;SEE WHAT HAPPENED
	ERROR <System resource failure in EXEC, %?> ;NO, REPORT FROM SYSTEM
;FILE DATA ERROR INTERRUPT
;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO.
;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND
;  FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED.

DATPSI:	CALL SAVACS		;DON'T CLOBBER AC'S
	CALL ICLEAR		;CLEAR INTERRUPT
	CALL RESACS
	SKIPN DATDSP
	JRST DATPS1		;NO DISPATCH, TYPE ERROR MESSAGE
	PUSH P,DATDSP		;SAVE SPECIAL DISPATCH ADDR FOR "RET" BELOW
	SETZM DATDSP		;CLEAR SPECIAL DISPATCH
	RET			;DISPATCH TO SPECIAL ROUTINE

DATPS1:	MOVEI Q1,RERET
	MOVEM Q1,CERET		;RESET ERROR RETURN TO "NORMAL"
	SETZM .JBUFP
	GTSTS			;TREAT CONTENTS OF AC1 AS A JFN, SEE IF ERROR
	TXC B,GS%ERR!GS%NAM	;IF ERROR AND LEGAL JFN, BOTH BITS ARE OFF NOW
	TXNE B,GS%ERR!GS%NAM	;SKIP IF JFN IS LEGAL AND IN ERROR
	ERROR <File data error>
	MOVE D,A		;REMEMBER JFN
	DVCHR			;SEE WHAT KIND OF DEVICE WE HAVE
	LOAD A,DV%TYP,B		;SEE WHAT FLAVOR DEVICE
	CAIE A,.DVMTA		;DO SPECIAL MESSAGE FOR MAGTAPE
DTANOF:	ERROR <File data error on file %4S>
	MOVE A,D		;GET THE JFN BACK
	GDSTS			;IT'S A MAGTAPE, SEE IF WE'RE AT END OF TAPE
	TXNN B,MT%EOT		;ARE WE AT END OF TAPE?
	JRST DTANOF		;NO
	ERROR <End of tape reached on file %4S>
;CLEAR OUTPUT BUFFER PSI
;ISSUES CFOBF ON PRIMARY OUTPUT JFN
;NORMALLY INVOKED BY ^O

COBPSI:	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI A,.PRIOU
	RFMOD			;GET PRESENT TTY MODES
	TLCE B,(1B0)		;COMPLEMENT SUPPRESS FLAG
	JRST [	SFMOD		;WAS ON BEFORE, TURN IT OFF AND PROCEED
		JRST COBPS1]
	PUSH P,B
	CFOBF			;CLEAR OUTBUF OF TTY (PRESUMABLY)
	HRROI B,[ASCIZ / ^O...
/]
	SETZ C,
	SOUT			;NOTE WHAT HAPPENED FOR USER
	POP P,B			;RECOVER TTY MODES
	SFMOD			;SET OUTPUT SUPPRESS
COBPS1:	POP P,C
	POP P,B
	POP P,A
	DEBRK
;GETLPC GETS THE ADDRESS IN WHICH THE INTERRUPT PC FOR THE CURRENT INTERRUPT
;LEVEL IS STORED.
;
;RETURNS+1:	NO INTERRUPT IN PROGRESS
;	+2:	A/	ADDRESS WHICH CONTAINS INTERRUPTED PC

GETLPC::MOVEI A,.FHSLF		;OURSELF
	RWM			;SEE WHICH LEVELS ARE IN PROGRESS
	TSO B,B			;IN EITHER USER OR MONITOR CONTEXT.
	JFFO B,GETL1		;FIGURE OUT HIGHEST LEVEL IN PROGRESS
	RET			;NO INTERRUPT IN PROGRESS
GETL1:	MOVEI A,PCTAB(C)	;GET ADDRESS IN A
	RETSKP			;SKIP TO SAY INTERRUPT IN PROGRESS
;ROUTINE TO CLEAR INTERRUPT.  WE TRY TO AVOID CIS JSYS, WHICH REQUIRES
;FAKING AN IPCF INTERRUPT, SINCE ^C OUT OF IPCF INTERRUPT COULD OTHERWISE
;PREVENT ANY MORE IPCF MESSAGES FROM BEING RECEIVED
;ONE OF THE GOALS OF THIS ROUTINE IS TO DO MINIMAL JSYS'S SINCE, ^C CALLS
;IT AND WANTS TO BE EFFICIENT.

ICLEAR::CALL GETLPC		;GET ADDRESS OF INTERRUPT ADDRESS
	 RET			;NO INTERRUPT IN PROGRESS
	XMOVEI D,IC2		;GET DUMMY PC FOR CLEARING INTERRUPT
	EXCH D,@A		;STORE DUMMY PC, GET REAL ONE
	DEBRK			;CLEAR THIS INTERRUPT LEVEL
IC2:	MOVEM D,@A		;RESTORE REAL INTERRUPT ADDRESS IN CASE SOMEONE CARES
	HLLZ B,B		;IGNORE MONITOR INTERRUPTS
	LSH B,1(C)		;THROW AWAY BIT REPRESENTING LEVEL WE JUST CLEARED
	JUMPE B,R		;IF NO OTHER LEVELS IN PROGRESS, RETURN
	;...

;CODE TO FLUSH OUT THE INTERRUPT SYSTEM.  THIS IS NEEDED WHEN CLEARING
;AN INTERRUPT LEVEL (SUCH AS ^C) IF OTHER LEVELS WERE IN PROGRESS, IN ORDER
;TO PREVENT ALL SUBSEQUENT CODE TO BE AT INTERRUPT LEVEL.
;WE MUST FAKE AN IPCF INTERRUPT, SINCE THE MONITOR ONLY GIVES US ONE WHEN
;THE COUNT OF MESSAGES GOES FROM 0 TO 1.

	SETZM IPCCTL		;PREVENT IPCF DISPATCH
	CIS			;CLEAR ALL OTHER LEVELS
	MOVEI A,.FHSLF		;OURSELF
	MOVX B,1B<IPCCHN>
	IIC			;FAKE IPCF INTERRUPT IN CASE WE ARE RESTARTING OR BOMBING OUT OF IPCF INTERRUPT ROUTINE
	RET
;SUPER-PANIC CHARACTER (CURRENTLY ^C) PSEUDO-INTERRUPT ROUTINE.
;CHANNEL 1, LEVEL 1

CCPSI:	TLOE Z,CTLCF1		;SAY WE'VE SEEN ^C
	TLO Z,CTLCF2		;IF IT'S THE SECOND ONE, SAY SO
				;(CTLCF2 CAUSES OUTBUF TO BE CLEARED BELOW).
	SKIPN ACTRCF		;^C ALLOWED?
	DEBRK			;NO
.CTRLC:	SETZM ILIDSP		;CLEAR SPECIAL IL INST DISPATCH ADDRESS
	SETZM CLF		;SAY NOT AT COMMAND LEVEL
	CALL ICLEAR		;CLEAR INTERRUPT SO MULTIPLE ^C'S WORK
	MOVE A,[CALL CUUO]	;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
	MOVEM A,41		;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
	SKIPG A,EFORK		;SPECIAL FORK?
	IFSKP.
	 FFORK			;YES - FREEZE IT
	  ERJMP .+1		;ALREADY GONE
	ENDIF.
	TLNN Z,RUNF		;PROGRAM RUNNING?
	JRST [	TLO Z,CTLCF2	;NO, ^C FROM EXEC.  DO CLEAR OUTBUF
		JRST CCDB3]

;*** NEED TO SET CTLCF2 HERE IFF FORK WAS IN TTY INPUT WAIT ***

	TXO Z,NECHOF		;PRETEND ECHOING OFF IN CASE PROG TURNED IT OFF, IN ORDER THAT DOECHO TURN IT BACK ON
	SKIPG	A,RUNFK		;HAVE A RUNNING FORK
	MOVE	A,FORK
	FFORK			;FREEZE THE WORLD
	ERCAL	[TYPE <% Process disappeared>
		 ETYPE<%_>
		 RET]
	MOVX Q1,FK%INT		;MARK INTERRUPTED
	SKIPE SLFTAB(A)
	IORM Q1,SLFTAB(A)
	TMNN FK%INV,SLFTAB(A)	;[PCL] If not controlled by PCL
	CALL RFTYMD		;READ FORK'S MODES
	TLZ Z,RUNF		;DON'T DO TTY MODES ON 2ND ^C!
CCDB3:	MOVEI Q1,ETTYMD		;CM236 SPR 14601
	TMNN FK%INV,SLFTAB(A)	;[PCL] If not controlled by PCL
	CALL LTTYMD		;SET UP OUR MODES, PROGRAM MAY HAVE CAUSED STRANGE STATE.
	SKIPE TPCCOC		;USED UNFORMATTED TYPE COMMAND ?
	CALL TYPFIN		;YES 
	MOVE A,COJFN		;CM236 SPR 14601
	TLNE Z,CTLCF2		;2ND ^C?
	CFOBF			;YES, CLEAR OUTPUT BUFFER.
;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.

	SETZM ERRMF		;CLEAR "PROCESSING AN ERROR" FLAG, BECAUSE
				;ANOTHER ^C WHILE PROCESSING EARLIER ONE IS OK.
	MOVEI A,CCERET		;SET ERROR ROUTINE TO SPECIAL ^C VALUE
	MOVEM A,CERET		;..
	SETZM .JBUFP		;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
	SETZM LGORET		;CLEAR LOGOUT-RETURN FLAG; WE WON'T GO BACK THERE
	CALL CLRIO		;CHECK AND RELEASE EXEC IO
	 CALL CIOER1		;GET RID OF "TAKE" JFN
	SKIPE PCCURC		;PCL Command procedure in progress?
	CALL PCMPOP		;PCL Yes, pop context right now
	SKIPE QTADSP		;[PCL] Do we seem initialized?
	SETOM CINITF		;[PCL] Yes, allow for ^C in Save/Exec
	SKIPE MPENDF		;WARN IF ^C OUT OF MOUNT
	ETYPE <%@[Mount request remaining in queue]
>
	SETZM MPENDF		;DON'T KEEP REMINDING HIM
	.$ERROR <^C>		;NO CLEAR INBUF, NO CR FIRST

;WAIT FOR OUTBUF TO EMPTY BEFORE CLEARING ^C FLAGS,
; FOR PROPER DETECTION OF 2ND ^C.

CCERET:	MOVE A,COJFN
	TLNN Z,CTLCF2		;BUT DON'T WAIT IF 2ND ^C
	DOBE
	TLZ Z,CTLCF1+CTLCF2
	JRST RERET		;GO TO STANDARD ERROR HANDLER
;TIME LIMIT EXCEEDED INTERRUPT COMES HERE

TLMPSI:	SETZM .JBUFP		;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
	MOVE A,[CALL CUUO]	;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
	MOVEM A,41		;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
				;TO MAKE EXEC TRANSFER TO ANY CODE THEY WISH).
	TLNN Z,RUNF		;PROGRAM RUNNING?
	JRST [	TLO Z,CTLCF2	;NO, ^C FROM EXEC.  DO CLEAR OUTBUF
		JRST TLMPS1]

;*** NEED TO SET CTLCF2 HERE IFF FORK WAS IN TTY INPUT WAIT ***

	SKIPG A,RUNFK		;CURRENT FORK
	MOVE A,FORK
	FFORK			;FREEZE THE WORLD
	MOVX Q1,FK%INT		;MARK INTERRUPTED
	SKIPE SLFTAB(A)
	IORM Q1,SLFTAB(A)
	TMNN FK%INV,SLFTAB(A)	;[PCL] If not controlled by PCL
	CALL RFTYMD		;READ FORK'S MODES
	TLZ Z,RUNF		;DON'T DO TTY MODES ON 2ND ^C!
TLMPS1:	MOVEI Q1,ETTYMD		;PUT EXEC'S TTY MODES INTO EFFECT.
	TMNN FK%INV,SLFTAB(A)	;[PCL] If not controlled by PCL
	CALL LTTYMD		;MUST ALWAYS BE DONE: EG GTJFN LEAVES THEM BAD.
	MOVE A,COJFN
	TLNE Z,CTLCF2		;2ND ^C?
	CFOBF			;YES, CLEAR OUTPUT BUFFER.

;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.

	SETZM ERRMF		;CLEAR "PROCESSING AN ERROR" FLAG, BECAUSE
				;ANOTHER ^C WHILE PROCESSING EARLIER ONE IS OK.
	MOVEI A,TLMRET
	MOVEM A,CERET		;COME BACK HERE AFTER ERROR PRINT
	ERROR <Time limit exceeded>

TLMRET:	SKIPN CJPTIM		;CRJOB STARTUP & TIME LIMIT SET?
	 JRST TLMRE1		;AND REENTER EXEC
	IFNBATCH(TLMRE1)	;IF BATCH, ALLOW BATCON TO HANDLE

	SETO A,
	LGOUT
	 JFCL
	HALTF			;MINI-EXEC WILL CATCH US?

TLMRE1:	CALL ICLEAR		;CLEAR INTERRUPT
	JRST ERRET		;REENTER EXEC
;AUTOLOGOUT PSI AND ROUTINE

;PROGRAM-GENERATED PSI ON CHANNEL 2, LEVEL 1 DISPATCHES HERE

ALOPSI:	PUSH P,[[DEBRK]]	;FAKE UP RETURN
	ATSAVE
	GJINF			;GETS LOGIN USER # IN A
	JUMPN A,R		;LOGIN IS COMPLETE, DONE WITH ALL THIS
	MOVE C,TTYACF		;GET # CHARS TYPED SO FAR
	CAMN C,PTTYAC		;SAME AS LAST PASS?
	 JRST ALOPS1		;YES, CLOBBER JOB, IT IS INACTIVE
	MOVEM C,PTTYAC		;NO, SAVE CURRENT AS PREVIOUS
	MOVE A,[.FHSLF,,.TIMEL]	;SET NEXT TIME TO CHECK
	MOVE B,[AUTOL3*^D1000]
	MOVEI C,2		;CHANNEL 2
	TIMER
	 ERROR <Couldn't set auto-logout timer - %?>
	RET

ALOPS1:	CIS			;ITS REAL. CLEAR PSI SYSTEM SO AUTOLOGOUT
				;IS DONE NOT ON AN INTERRUPT LEVEL.
;EXEC'S MAIN FORK JSRT'S HERE,
;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT.
;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT.

AUTOLO:	SKIPE CUSRNO		;SKIP IF NOT LOGGED IN
	ERROR <Autologout screwup>
	GJINF			;GETS CONTROLLING TTY # IN 4
	CAMN D,[-1]		;-1 IF NONE (DETACHED)
	JRST AUTOL6		;DETACHED, TYPING MESSAGE WOULD HANG UP JOB.

;CAN BE DETACHED IF DATAPHONE HUNG UP AND CARRIER-OFF PSI
;ISN'T FULLY PROCESSED, OR IF ATACH HAS SOMEHOW FAILED TO
;COMPLETE.

	MOVE A,COJFN
	CFOBF			;CLEAR POSSIBLE ^S
	TYPE <
 Autologout
>
;Nota Bene - If you dare change the DISMS% back to a DOBE% like it used
;to be, you stand the chance of seeing "ghost" jobs on your system. The
;DOBE% will hang if the terminal associated with the job somehow has no
;origin associated with it any longer. This is how "(LAT)" and "(CTM)"
;jobs appear and can't be killed. The DISMS% should finish and then the
;job should get logged out. If this no worky, then the bug is in the
;monitor somewhere.
	MOVEI A,^D1000		;[7.1085] Give ample time for Autologout msg
	DISMS%			;[7.1085] Now wait until finished
AUTOL6:	SETO A,			;SAY SELF
	LGOUT			;LOG JOB OUT
	 CALL JERR		;SHOULDN'T BE ABLE TO HAPPEN.
;ERROR UUO HANDLER. MESSAGE TEXT AT EFFECTIVE ADDRESS.
;SERVICES UUO'S UERR, U$ERR, U.$ERR (MACROS ERROR, $ERROR AND .$ERROR)

;USE "LERROR <TEXT>" TO PRINT ERROR MESSAGE AND RETURN.  SAME AS
;"ERROR <TEXT>" EXCEPT LATTER DOESN'T RETURN TO CALLER.

%LERRO:	TLZ Z,F1		;LOCAL ERROR HANDLER, RETURNS TO CALLER
	PUSH P,A		;[PCL] Save an AC to play with
	MOVE A,TAKLEN		;[PCL] Get I/O stack pointer
	HLRZ A,TAKJFN-1(A)	;[PCL] Get input designator (don't just look
				; at CIJFN because we didn't call FIXIO yet)
	CAIN A,.NULIO		;[PCL] From PCL?
	 JRST ERRPCL		;[PCL] Yes, return to Exec top level
	POP P,A			;[PCL] Restore work AC
	CALL ERRX		;PRINT ERROR MESSAGE
	SETZM ERRMF		;CLEAR FLAG TO SAY ERROR IS OVER
	RET			;RETURN

%ERR: %$ERR: TLZ Z,F1
	CAIA
%.$ERR:	TLO Z,F1		;SAY DON'T CLEAR INBUF (ERFRS1)
	PUSH P,A		;[PCL] Save an AC to play with
	MOVE A,TAKLEN		;[PCL] Get I/O stack pointer
	HLRZ A,TAKJFN-1(A)	;[PCL] Get input designator (don't just look
				; at CIJFN because we didn't call FIXIO yet)
	CAIE A,.NULIO		;[PCL] From PCL?
	 JRST NOPCL		;[PCL] No, do normal stuff
ERRPCL:	MOVEI A,RERET		;[PCL] Get standard error return
	MOVEM A,CERET		;[PCL] Say return to Exec top-level after error
				; is processed
NOPCL:	POP P,A			;[PCL] Restore work AC
	CALL ERRX		;PRINT ERROR MESSAGE
	JRST ERRFIN		;FINISH ERROR HANDLING

;MAIN WORK ROUTINE FOR ERROR MESSAGES.  HANDLES CLEARING OF TYPEAHEAD,
;TYPING "?" IN FRONT OF MESSAGES, ETC.

ERRX:	PUSH P,40		;TEXT ADDRESS AND UUO VALUE
	CALL ERFRS1		;DO WHAT MUST BE DONE BEFORE TYPING ERROR MSG
	JRST ERR1
;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD"
;MUST HAVE ALREADY CALLED "ERFRST"

SYSERA:	PUSH P,[-2]
ERR1:	PUSH P,A		;AC'S MUST BE SAVED FOR ETYPE OR ERSTR

;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN "?" (ALWAYS),
;THEN TEXT, THEN CR.
;BUT NO INITIAL CR-SPACE IF "U$ERR" UUO.

	HLRZ A,-1(P)		;-1 FOR SYSTEM MSG, OR UUO FOR EXEC MSG
	CAIE A,<U.$ERR>B53
	CAIN A,<U$ERR>B53
	JRST ERR5		;NO CR-SPACE FOR U$ERR UUO ($ERROR MACRO)
	CALL CRIF		;TYPE EOL IF NOT ALREADY AT LEFT
ERR5:	MOVE A,-1(P)		;0, -1, -2, OR UUO-TEXT ADDRESS
	TRNN A,-1
	JRST ERR7		;0 RH MEANS NO TEXT
	JUMPGE A,ERR5A		;POSITIVE: USE TEXT A POINTS TO
	CAME A,[-1]		;-1 MEANS LATEST ERROR FROM SYSTEM
	JRST ERR5C
	SKIPG A,EFORK		; USE EPHEMERAL IF PRESENT
	MOVEI A,.FHSLF		;GET ERROR # FROM SYSTEM NOW FOR
	GETER			;  LATER USE IN MSG
	 ERJMP ERR5B		;FORK WENT AWAY PROBABLY, SHOULD TYPE SOMETHING
ERR5C:	HRLI B,.FHSLF		;FORK: SELF
	CAMN A,[-2]
	HRR B,ERCOD		;-2 SAYS USE SYSTEM ERR # FROM "ERCOD"
	HRRZ C,B		;GET ERROR CODE
	CAIE C,GJFX3		;NO JFNS?
	CAIN C,GJFX22		;OR JSB FULL?
	JRST [	TYPE <Can't create another JFN for this job --
 Try releasing some with "CLOSE" command>
		JRST ERR6]	;SPECIAL CASE BECAUSE ERSTR WILL FAIL HERE
ERR5B:	ETYPE <%3?>		;TYPE ERROR MESSAGE
	JRST ERR6		;DONE.

ERR5A:	MOVE A,(P)		;VALUE THAT CAME IN A MIGHT BE USED BY ETYPE
	UETYPE @-1(P)		;TYPE MESSAGE FROM CORE
ERR6:	ETYPE<%_>
	TLNE Z,LOGOFF
	TYPE < Not logged off
>				;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE
;ERROR UUOS AND SYSERM...
;MESSAGE ALL TYPED.

ERR7:	TLNN Z,F1		;DON'T CLEAR INBUF FOR RUBOUT, ^X (.$ERROR)
	SKIPN CIDLYF		;REQUESTING DELAYED CFIBF?
	JRST ERR7A		;NO
	MOVE A,CIJFN
	DOBE
	CFIBF			;CLEAR FILE INPUT BUFFER
ERR7A:	CALL DOECHO		;MAKE SURE ECHOING IS ON
	POP P,B
	POP P,A
	RET			;RETURN TO CALLER

;GET HERE IF ERROR IS FATAL, AND NO RETURN TO CALLER IS TO BE DONE.
;RESETTING OF VARIOUS THINGS DONE HERE...

ERRFIN::SETZM IPCCTL		;CLEAR SPECIAL IPCF INTERRUPT DISPATCH
	SKIPG A,EFORK		;SPECIAL FORK?
	IFSKP.
	 KFORK			;YES - KILL IT
	  ERJMP .+1		;ALREADY GONE
	 SETOM EFORK		;NO MORE
	ENDIF.
	BTCHER			;SHOULD STOP NON-CONVERSATIONAL JOB
	ADJSP P,-1		;FORGET UUO

;RESTORE EARLIER (LESS FULL) PUSHDOWN LEVEL IF LEVEL
;WAS SAVED . THIS IS GENERALLY USED DURING SUBCOMMAND
;INPUT.

	SKIPE .PP		;DON'T RESET IF .PP NEVER SAVED
	MOVE .FP,.PP		;RESTORE .FP AS IT WAS BEFORE COMMAND.
	SKIPE .P		;DON'T RESET P IF NEVER SAVED!
	MOVE P,.P		;RESTORE P TO AS IT WAS BEFORE COMMAND
	SETZM ERRMF		;NO LONGER PROCESSING AN ERROR
	JRST @CERET		;VARIABLE ERROR RETURN, GOES SPECIAL PLACES
				;DURING SUB-COMMAND INPUT AS FOR "DIRECTORY" CMD
;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE

RERET:	CALL UNMAP		;UNMAP SPECIAL PAGES (BEFORE FLJFNS TO PREVENT CLOSF FAILURE)
	CALL UNTAKE		;END TAKE FILE IF ERRORS NOT ALLOWED
	SETZM .JBUFP		;FLUSH ALL JFNS
	CALL FLJFNS		;RELEASE JFNS FLUSHING OUTPUT FILES
	MOVE A,[CZ%NIF+.FHSLF]
	SKIPE CLZFFF		;DO CLZFF IF POSSIBLE LOST JFN
	CLZFF			;RELEASE ANY UNOPEN JFNS
	JRST ERRET		;GO BACK TO COMMAND INPUT

;ROUTINE TO UNMAP SPECIAL PAGES, SAVES SWAPPING SPACE.

UNMAP::	SETO A,			;PAGE OF INFERIOR FORK
	CALL MAPPF
	 JFCL			;UNMAP SHOULD NEVER FAIL
	SETO A,
	MOVE B,[XWD .FHSLF,1+<FREE>B44] ;CLEAR PAGES FREE+1 - BUFL WHICH INCLUDES
	MOVE C,[PM%CNT+<BUFL-FREE>B44] ; BUF1, BUF2, DIRECTORY
	PMAP			;RESERVE ONE PAGE IN CASE SWAPPING SPACE FILLS UP
	CALLRET FREINI		;FIX FREE STORAGE DATABASE AND RETURN
;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT
; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR.

ERFRST:	TLZ Z,F1		;NORMAL ENTRY
ERFRS1:				;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
	SAVEAC <A,B,C,D>	;AC'S MAY HAVE DATA FOR MESSAGE PRINTOUT
	SKIPE TPCCOC		;USED UNFORMATTED TYPE COMMAND ?
	CALL TYPFIN		;YES 
	CALL %GETER		;GET ERROR CODE IN CASE "%?"
	CALL CSAVE		;SAVE FAILED COMMAND FOR COMMAND EDITOR
	JFCL			;COULDN'T - PROCEED AS USUAL
	CALL FIXIO		;MAKE SURE ERROR SEEN IN "REAL" OUTPUT STREAM
	CALL SETT20		;SAY TOPS20 LEVEL NOW
	SKIPN CINITF		;IS EXEX INITIALIZED?
	JRST [	MOVEI 1,.PRIOU	;NO, ASSUME COJFN, ETC. NOT SET UP
		HRLOI 2,.FHSLF
		SETZ 3,
		ERSTR		;BUT TRY TO GET OUT ERROR MSG
		 JFCL
		 JFCL
		HRROI 1,[ASCIZ /
?TOPS-20 command processor not properly initialized.
/]
		PSOUT
		HALTF]
	MOVE A,[CALL CUUO]	;RESET UUO DISPATCH, BECAUSE OTHERWISE
	MOVEM A,41		;MALICIOUS USERS CAN MAKE EXEC TRANSFER
				;TO ANY CODE THEY WISH BY PATCHING PAGE 0 OF PMF
	MOVE A,COJFN
	DOBE			;WAIT IN CASE USER ^O'S SOME OTHER TYPEOUT
	RFMOD			;GET TTY MODES
	TLZE B,(1B0)		;CLEAR OUTPUT SUPPRESS IF IT WAS ON
	SFMOD
	SKIPE ERRMF		;DID THIS ERROR OCCUR WHILE PROCESSING ANOTHER?
	JRST [	CALL UNTAK1	;IF MULTIPLE ERROR, ALWAYS END TAKE FILE
		UTYPE [ASCIZ /
?Error within an error
/]				;YES, GIVE UP
		JRST ERRET]
	SETOM ERRMF		;SAY THERE'S AN ERROR
	CALL ECHCMD		;ECHO ERRONEOUS COMMAND IF NOT FROM TERMINAL
	MOVE A,CIJFN		;SEE WHERE INPUT FROM
	CAIN A,.NULIO		;PCL?
	JRST [	CALL PCMPOP	;YES, ALWAYS FLUSH
		JRST ERFRS2]
	CALL UNTAKE		;UNWIND IF ERRORS NOT ALLOWED AT THIS LEVEL
ERFRS2:	TLNN Z,F1		;DON'T CLEAR INBUF FOR ^U
	SKIPN CIDLYF		;REQUESTING DELAYED CFIBF?
	IFNSK.			;[3031]
	 SKIPE CUSRNO		;[3031] YES - LOGGED IN ?
	 RET			;[3031] NO - DON'T DO IT NOW
	ENDIF.			;[3031]
	MOVE A,CIJFN
	CFIBF			;[3031] CLEAR THE INPUT BUFFER
	 ERJMP .+1		;[3031] IGNORE THE ERROR RETURN
	RET
;ROUTINE TO RESTORE CIJFN/COJFN TO THEIR CORRECT VALUE.  THIS IS DONE
;TO UNDO POSSIBLE MEDDLING WITH CI/COJFN BY CERTAIN COMMANDS THAT MAY DIVERT
;OUTPUT TEMPORARILY TO A STRING.

FIXIO::	MOVE A,TAKLEN		;GET POINTER TO CURRENT LEVEL
	HLR B,TAKJFN-1(A)	;GET CIJFN VALUE
	HRRZM B,CIJFN		;RESTORE INPUT STREAM
	HRR B,TAKJFN-1(A)	;GET COJFN VALUE
	HRRZM B,COJFN		;RESTORE OUTPUT STREAM
	MOVE B,TAKBTS-1(A)	;GET CORRECT CONTROL BITS
	MOVEM B,TAKCUR		;REMEMBER CURRENT SETTINGS
	RET

;ROUTINE TO FINISH TAKE FILE BECAUSE THERE IS AN ERROR WHILE
;PROCESSING IT.

UNTAKE:	MOVE A,TAKCUR		;GET CURRENT SETTINGS
	MOVE B,CIJFN		;ALWAYS END TAKE FILE IF IT'S A PCL COMMAND
	CAIE B,.NULIO
	TXNN A,TKALEF		;ALLOWING ERRORS?
	CAIA
	RET			;YES, SO DON'T END THE TAKE FILE
UNTAK1:	CALL CIOREL		;END TAKE FILE
	 CALLRET CIOER		;THERE WAS ONE, SO SAY WHICH ONE WAS ENDED
	RET
;ROUTINE TO GET RID OF "TAKE" JFN WHEN ERROR FROM WITHIN IT.

CIOER1:	CLOSF			;JUST CLOSE TAKE FILE
	 CALL JERR		;SHOULDN'T FAIL
	RET			;DONE

CIOER:	MOVEI D,[ASCIZ /%% Error while reading %1M, file aborted.
/]
	SETZM LGORET		;RESET "TAKING LOGOUT.CMD" FLAG IF ERROR
	STKVAR <<CSIBUF,EXTSIZ>>
	CAIN A,.NULIO		;PCL Is there a real file name?
	JRST CIOER2		;PCL No, use generic name
	MOVE B,A		;JFN
	HRROI A,CSIBUF		;SPACE TO STORE STRING
	MOVEI C,0		;NO SPECIAL FLAGS
	JFNS			;GET FILENAME
	 ERJMP .+1		;PCL Allow for missing JFN
	MOVE A,B		;PUT JFN BACK INTO A
	CLOSF			;CLOSE TAKE FILE BEFORE PRINTING MESSAGE BECAUSE ERROR MIGHT BE IN TAKE FILE ITSELF!
	 CALL JERR		;SHOULDN'T FAIL
	HRROI A,CSIBUF		;GET POINTER TO FILENAME
	UETYPE @D		;PRINT ERROR MESSAGE
	RET

CIOER2:	MOVE A,[POINT 7,[ASCIZ /command program/]] ;PCL
	UETYPE @D		;PCL
	RET			;PCL
;BEGIN ERROR MESSAGE LINE.  DO CRLF IF NOT ALREADY AT LEFT MARGIN,
;THEN PRINT "?"

CRIF::	ATSAVE
	CALL LM			;GET TO LEFT MARGIN
	PRINT "?"
	RET

;ROUTINE TO GET TO LEFT MARGIN

LM::	MOVE A,COJFN
	RFPOS			;READ FILE POSITION
	TRNE B,-1		;LINE POSITION 0?
	ETYPE<%_>		;NO, DO CRLF
	RET

%MESS::	ATSAVE
	CALL LM
	PRINT "%"
	RET
;ROUTINE TO GET LAST MONITOR ERROR CODE, RETURNS IT IN A.

GETERR:	CALL %GETER
	MOVE A,ERCOD
	RET

;SUBROUTINE TO OBTAIN LAST JSYS ERROR IN A.

DGETER::MOVEI A,.FHSLF		;OURSELF
	GETER			;GET LAST ERROR
	HRRZ A,B		;RETURN ERROR IN A
	RET

;SUBROUTINE TO DO "GETER" JSYS FOR EXEC AND STORE
;CODE IN "ERCOD"

%GETER::PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI A,.FHSLF
	GETER
	HRRZM B,ERCOD
	POP P,C
	POP P,B
	POP P,A
	RET
;DOGET DOES THE GET JSYS.
;
;ACCEPTS:	AC'S/	WHATEVER GET JSYS WANTS
;
;RETURNS:	AC'S/	WHATEVER GET RETURNS
;		+1	ERROR
;		+2	SUCCESS, FAME AND FORTUNE
;
;This routine makes sure the jfn being used by the GET jsys is NOT on the
;exec's jfn stack before the GET jsys.  This is necessary to ensure that
;the exec won't attempt to close the jfn later, when it may already be
;associated with another filespec being used by some random fork in the job.
;Normally, the monitor GET code will close the jfn appropriately at the end
;of the GET jsys, so there's no need for the exec to try to close it anyway.

DOGET::	STKVAR <<GETARG,2>>
	DMOVEM A,GETARG		;REMEMBER GET ARGUMENTS
	LOAD A,GT%JFN,A		;ISOLATE THE JFN
	MOVE B,JBUFP		;GET POINTER TO CURRENT SAVED JFNS
DG1:	CAMN B,[IOWD JBUFL,JBUF];HAVE WE SCANNED ENTIRE LIST?
	JRST DG2		;YES, JFN WAS NEVER STACKED
	HRRZ C,(B)		;NO, EXAMINE NEXT JFN ON STACK
	ADJSP B,-1		;STEP BACK TO NEXT SLOT
	CAME C,A		;HAVE WE FOUND THE CORRECT ONE YET?
	JRST DG1		;NO, KEEP LOOKING.
	SETZM 1(B)		;YES, CLEAR THIS ENTRY SO EXEC DOESN'T TRY TO CLOSE IT
	MOVE A,B		;PCL
	ADJSP A,1		;PCL See where it came from
	CAMN A,JBUFP		;PCL Was it the top of the stack?
	MOVEM B,JBUFP		;PCL Yes, just forget it
DG2:	DMOVE A,GETARG		;NOW DO THE GET JSYS
	GET
	 ERJMP R		;NON-SKIP ON FAILURE
	RETSKP			;SKIP IF GOOD.
;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED --
; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES.
;CLOSES AND RELEASES JFNS STACKED IN JBUF.
;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0
; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN
; TO A SUBCOMMAND INPUT LOOP.
;Returns+1:		A/	0	success
;				-1	failure

FLJFNS::ATSAVE
	LDF D,CZ%ABT		;ABORT OUTPUT FILES
	JRST RJFNS0

RLJFNS:	SETZ D,			;BITS TO INCLUDE IN CLOSF
RJFNS0:	STKVAR <RLERRF>
	SETZM RLERRF		;NO ERROR YET
RJFNSP:	MOVE C,JBUFP		;SCAN JFN BUFFER
	CAMLE C,[IOWD JBUFL,JBUF] ;STOP AT BOTTOM OF STACK,
	CAMN C,.JBUFP		;OR AT SAVED POINTER LEVEL
	JRST RJDON		;DONE
	CALL RJFN		;DELETE ONE JFN
	MOVEM A,RLERRF		;REMEMBER WHETHER ERROR
	JRST RJFNSP

RJDON:	MOVE A,RLERRF		;RETURN ERROR INFO
	RET
;ROUTINE TO GET RID OF TOP JFN ON STACK.  COMMANDS THAT WANT TO GET
;RID OF A STACKED JFN SHOULD CALL THIS ROUTINE (RJFN).
;RETURNS+1:		A/	0	SUCCESS
;				-1	FAILURE

RJFN::	CALL RJFNS2
	MOVE C,JBUFP
	ADJSP C,-1		;DECREMENT POINTER
	MOVEM C,JBUFP
	RET

;PROCESS ONE WORD OF JBUF
;RETURNS+1:		A/	0	SUCCESS
;				-1	FAILURE

RJFNS2:	STKVAR <R2ERRF>
	SETZM R2ERRF		;NO ERROR YET
	MOVE C,JBUFP
	HRRZ A,(C)		;GET A JFN TO CONSIDER
	JUMPE A,RS2DON		;RETURN IF 0
	CAIN A,FI%ERR		;BUFFERED ERROR?
	JRST [	HLRZ A,(C)	;YES, GET ADDRESS OF ERROR BLOCK
		HRRZ A,.FIJFN(A);GET PARSE-ONLY JFN
		JRST .+1]
	CALL SKPJFN		;SKIP IF THIS IS A JFN
	 JRST RJFNS9		;IT'S A FORK
	CAIE A,.PRIIN
	CAIN A,.PRIOU
	JRST RJFNS8
	CALL NOTIO		;MAKE SURE JFN ISN'T AN IO JFN
	JRST RJFNS8		;IT IS!
	GTSTS			;GET ITS STATUS
	TXNN B,GS%NAM		;JFN EVEN EXIST?
	JRST RJFNS8		;INVALID, FORGET IT
	HRRZ A,A		;PREPARE FOR RLJFN/CLOSF
	TXNN B,GS%OPN		;IS IT OPEN?
	JRST [	RLJFN		;NO, RELEASE IT
		 JRST RJFNE	;FAILED, GO ANALYZE
		JRST RJFNS8]	;SUCCEEDED

	HLL A,D			;GET BITS FOR CLOSF
	CLOSF			;YES, CLOSE AND RELEASE
RJFNE:	 ERJMP [CALL RJFNER	;ANALYZE ERROR
		MOVEM A,R2ERRF	;STORE ERROR INFO
		JRST .+1]
	;...
;DONE WITH THIS WORD

RJFNS8:	HRRZ A,(C)		;CHECK AGAIN FOR STACKED ERRONEOUS FILESPEC
	CAIN A,FI%ERR		;IS IT ONE?
	JRST [	HLRZ A,(C)	;YES, GET POINTER TO BLOCK
		MOVE A,.FISTR(A);GET POINTER TO BUFFERED FILESPEC
		CALL STREM	;RELEASE FREE SPACE USED BY FILESPEC
		MOVE C,JBUFP	;GET POINTER TO JFN STACK AGAIN
		HLRZ B,(C)	;GET ADDRESS OF BLOCK
		MOVEI A,.FILEN	;SAY HOW LONG IT IS
		CALL RETBUF	;RETURN BLOCK TO FREE SPACE
		MOVE C,JBUFP	;GET POINTER TO STACK AGAIN
		JRST .+1]
	SETZM (C)		;ZERO JBUF WORD
RS2DON:	MOVE A,R2ERRF		;SHOW 0 FOR SUCCESS, -1 FOR ERROR
	RET

;LARGE JFNS ARE ASSUMED TO BE FORK HANDLES

RJFNS9:	CAMN A,FORK		;ARE WE KILLING MAIN FORK?
	SETOM FORK		;YES, SO SAY FORK IS GONE
	KFORK			;KILL THE FORK
	ERJMP RJFNS8
	JRST RJFNS8		;CONTINUE
;ROUTINE TO SKIP IF WE'VE GOT A JFN
;
;ACCEPTS:	A/	ANIMAL
;
;RETURNS:	+1:	ANIMAL IS NOT A JFN
;		+2:	ANIMAL IS A JFN

SKPJFN:	CAIL A,MAXJFN		;1000 IS MAX FOR NOW
	RET			;TOO LARGE, NOT A JFN
	RETSKP

;ROUTINE WHICH SKIPS IFF JFN IN A IS NOT AN EXEC COMMAND JFN.  CLOBBERS
;NOTHING

NOTIO::	ATSAVE			;DON'T CLOBBER ANY AC'S
	MOVE B,TAKLEN		;GET POINTER TO COMMAND JFN STACK
RJFNSA:	SOJL B,NPCLIO		;[PCL] When all entries have been scanned, see
				; if JFN in use by PCL
	HRRZ D,TAKJFN(B)	;GET OUTPUT JFN
	CAMN A,D		;DOES JFN IN QUESTION MATCH A COMMAND OUTPUT JFN?
	RET			;YES
	HLRZ D,TAKJFN(B)	;NO, CHECK INPUT
	CAMN A,D		;DOES JFN MATCH AN INPUT JFN?
	RET			;YES
	JRST RJFNSA		;NO, KEEP LOOKING
;ROUTINE TO DETERMINE IF ERROR FROM CLOSF IS OK
;OR CAN BE HANDLED
;RETURNS+1:		A/	0	SUCCESS
;				-1	FAILURE

RJFNER:	STKVAR <AERRF>
	CALL GETERR		;GET THE ERROR CODE
	SETZM AERRF		;NO ERROR YET
	CAIE A,DESX3		;YOU CAN GET "JFN IS NOT ASSIGNED" AFTER
				;A LOWER EXEC HAS POPED BACK TO US, WHICH
				;WE STARTED WITH A PUSH
				;THIS IS BECAUSE WE STACKED THE JFN OF THAT
				;EXEC, BUT MONITOR CLOSED THAT JFN DURING THE
				;GET, AND THEN THE JFN GOT REUSED FOR A PROGRAM
				;UNDER THE NEW EXEC.  SO THE GTSTS CAN SAY THERE IS
				;STILL A NAME ASSOCIATED WITH IT, ALTHOUGH IT
				;IS BEING DELETED DUE TO
				;THE KFORK IN THE PUSH CODE.
				;...NOT TO MENTION THE FACT THAT THE JFN GOT
				;REUSED AS A RESTRICTED JFN, WHICH WILL ALSO
				;CAUSE DESX3.  (ACTUALLY, MONITOR SHOULD BE
				;FIXED TO GIVE A SPECIAL ERROR IN THAT CASE)
	CAIN	A,CLSX3		;IGNORE PAGE STILL MAPPED
	JRST AEDON
	CAIE	A,CLSX4		;DEVICE STILL ACTIVE REQUIRES WORK
	JRST [	HRRZ A,(C)	;GET JFN AGAIN
		GTSTS		;GET INFO FOR DIAGNOSTIC
		JRST RFAIL]	;MUSTN'T BOMB COMPLETELY, lest we loop
	TYPE	<% Device active - wait...>
	MOVEI	B,^D20		;# OF HALF SECONDS
RJFNR1:	MOVEI	A,^D500		;MS TO SLEEP
	DISMS			;ZZZZZ
	HRRZ	A,0(C)		;GET JFN BACK
	HLL	A,D		;BITS TO SET
	CLOSF			;TRY AGAIN
	  JRST	RJFNR2		;MORE PROCESSING TO COME
	TYPE	< [OK]
>
AEDON:	MOVE A,AERRF		;RETURN ERROR INFO
	RET

RFAIL:		ETYPE <%@%%%Couldn't close JFN %1O, status %2O - %?%%_>
	SETOM AERRF		;SAY ERROR
	JRST AEDON

RJFNR2:	CAILE B,1		;GIVE UP IF TRIED MANY TIMES
	CAIE	A,CLSX4		;CHECK SAME LOSAGE
	JRST [	HRRZ A,(C)	;GET JFN AGAIN
		GTSTS		;GET INFO FOR DIAGNOSTIC
		JRST RFAIL]	;MUSTN'T BOMB COMPLETELY, lest we loop
	SOJA	B,RJFNR1	;TRY AGAIN

;GNJFS  -  This  routine,  GNJFS, should be used wherever GNJFN%
;would have been employed to step a JFN. This is done to  ensure
;that  the  case of GNJFN% failing and releasing the indexed JFN
;is properly handled with respect to the JFN stack.  Failure  to
;do  this  can  cause  the  Exec to manipulate JFNs which it has
;actually released and may belong to  another  fork  leading  to
;many strange and wonderful kinds of misbehaviors. GNJFS behaves
;exactly  like  GNJFN%  with  respect to returns and accumulator
;usage.

GNJFS::	STKVAR <GNJFA,GNJFER,<GNJFBC,2>,GNJSKP> ;ALLOCATE SOME STORAGE
        MOVEM A,GNJFA           ;SAVE THE AFFECTED ACS
        DMOVEM B,GNJFBC
        SETZM GNJSKP            ;INDICATE NON SKIP RETURN
	MOVE A,GNJFA            ;GET OUR ARGUMENT
        GNJFN%                  ;STEP IT
         ERJMP GNJFSE
        AOS GNJSKP              ;BUMP THE SKIP RETURN FLAG
GNJFS1: DMOVE B,GNJFBC          ;RECOVER (B) AND (C)
        SKIPN GNJSKP            ;SKIP RETURN?
         RET                    ;NO, FAILURE RETURN
        RETSKP                  ;OTHERWISE, SUCCESS

GNJFSE: CALL PIOFF              ;GO CRITICAL
	MOVEM A,GNJFER          ;SAVE THE ERROR CODE
	HRRZ A,GNJFA		;GET THE JFN AGAIN
        MOVE B,JBUFP            ;SET UP TO SEARCH JFN STACK
GNJFSL: CAMN B,[IOWD JBUFL,JBUF] ;OFF TOP OF STACK?
         JRST GNJFS2            ;YES, DON'T LOOK ANY MORE FOR IT
        HRRZ C,(B)              ;GET THE JFN ONLY FROM THE STACK
        CAME A,C                ;IS IT THE ONE WE'RE DOING?
         JRST  [ADJSP B,-1      ;NO, POP UP ONE
                JRST GNJFSL]    ;CONTINUE LOOKING
	MOVE A,GNJFER		;GET THE ERROR CODE AGAIN
	CAIN A,GNJFX1   	;NO MORE FILES?
        CAMN B,[IOWD JBUFL,JBUF] ;AND NOT AT TOP OF STACK?
         SKIPA          	;NO TO EITHER, NO JFN ENTRY TO CLEAR
        SETZM (B)       	;CLEAR THE JFN STACK ENTRY FOR RELEASED JFN
GNJFS2: CALL PION       	;ALLOW INTERRUPTS
	JRST GNJFS1		;GO FINISH UP
 
;ROUTINE TO STACK JFNS OR FORK, CHECKS FOR SPACE FIRST

JFNSTK::MOVE B,A		;JFN IN B
	HLRZ A,JBUFP
	CAIN A,-1
	ERROR <Too many JFNs in command>
	MOVE A,JBUFP
	PUSH A,B		;STACK JFN
	MOVEM A,JBUFP
	HRRZ A,B		;GET RID OF FLAGS
	CALL SKPJFN		;IS THIS REALLY A JFN?
	 CAIA			;NO
	MOVE A,B		;RETURN JFN OR FORK IN A
	RET

;PCL ROUTINE TO UNSTACK THE TOP JFN IN THE JFN STACK.
;RETURNS THE JFN IN A.  DESTROYS NO REGISTERS.

JUNSTK::PUSH P,B		;SAVE B
	MOVE B,JBUFP		;GET THE STACK POINTER
	POP B,A			;POP THE JFN INTO A
	MOVEM B,JBUFP		;SAVE THE STACK POINTER
	POP P,B			;RESTORE B
	RET			;AND RETURN

;ROUTINE TO DO GTJFN AND STACK THE JFN.  THIS SHOULD BE USED WHEREVER
;A JFN IS NEEDED DURING COMMAND EXECUTION, IN ORDER THAT THE JFN BE
;GUARANTEED TO BE FREED IF THE USER ^C'S OUT OF THE COMMAND.
;THIS ROUTINE SKIPS AND CLOBBERS 1 AND 2 EXACTLY AS GTJFN DOES, EXCEPT
;THAT ERJMP AFTER THE CALL TO THIS ROUTINE WILL NOT WORK (USE JRST).
;(IF YOU FIND PLACES WHERE THE EXEC DOES GTJFN FOLLOWED BY A CALL TO
;JFNSTK, YOU SHOULD CHANGE THEM TO CALL GTJFS INSTEAD)

GTJFS::	STKVAR <<GTDATA,2>>
	DMOVEM A,GTDATA		;SAVE THE GTJFN DATA
	AOS CLZFFF		;IF ^C BEFORE JFN STACKED, CAUSE CLZFF
	GTJFN			;DO THE GTJFN
	 ERJMP GTFAIL		;FAILED
	DMOVEM A,GTDATA		;SAVE RESULTANT DATA
	CALL JFNSTK		;STACK THE JFN
	SOS CLZFFF		;CLZFF NO LONGER NEEDED SINCE JFN IS STACKED
	DMOVE A,GTDATA		;GET WHAT GTJFN RETURNED
	RETSKP			;SAY SUCCESS

GTFAIL:	CALL GETERR		;GET THE ERROR CODE
	DMOVEM A,GTDATA		;SAVE WHAT FAILING GTJFN RETURNED
	SOS CLZFFF		;GTJFN FAILED, CLZFF NOT NEEDED
	DMOVE A,GTDATA		;GET WHAT GTJFN SAID (ABOUT FAILURE)
	RET			;ERROR RETURN
;ROUTINE TO PRINT JOBS ACCOUNTING STRING (OR NUMBER)

PRACCT::STKVAR <<ACCBUF,EXTSIZ>>
	HRROI B,ACCBUF		;POINT TO ACCOUNT BUFFER
	MOVNI	A,1		;-1 FOR SELF
	GACCT			;GET IT
	LDB A,[410300,,B]	;GET SIG. OCTAL DIGIT
	CAIE A,5		;5 MEANS NUMBER INSTEAD OF STRING
	JRST	[HRROI A,ACCBUF	;POINT TO STRING
		 ETYPE <%1M>	;DUMP IT
		 RET]
	TLZ B,500000		;GET RID OF CONTROL BITS
	ETYPE	<%2Q>		;DECIMAL
	RET			;RETURN
;%ETYPE (ETYPE MACRO, UETYPE UUO)
;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES.
;SPECIAL CODES ARE OF FORM %NL%
;	WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC
;	      L IS A LETTER:
;		D: TYPE CURRENT DATE
;		J: TYPE TSS JOB #
;		O: TYPE CONTENTS OF INDICATED AC IN OCTAL
;		SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.

EBLN==50			;BUFFER SIZE FOR CHARACTERS DURING ETYPE

;	NOTE:  STATF (BELOW) IS USED TO FORCE A REENTRY INTO THE PARSE
;	CODE AFTER AN AC IS PARSED.

%ETYPE:	TRVAR <<ETBFR,EBLN>,<RACS,5>,ETPTR,SRCPTR,ETYPF,EDAT,STATF,AC%B,AC%C,AC%D>
	SETZM STATF		;ZERO STATE FLAG
	MOVEM Z,RACS		;SAVE REAL AC'S AWAY
	DMOVEM A,1+RACS
	DMOVEM C,3+RACS
	HLRZ A,40		;SEE WHICH INSTRUCTION
	SETOM ETYPF		;FIRST ASSUME ETYPE
	CAIE A,<UETYPE>B53	;MAYBE REGULAR TYPE
	SETZM ETYPF		;YES
	CALL %GETER		;GET ERROR CODE IN CASE "%?"
	HRRZ A,40
	CAIG A,17		;PRINTING TEXT FROM TEMP AC?
	ADDI A,RACS		;YES, POINT TO SAVED BLOCK
	HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR FROM EFF ADDR
	MOVEM A,SRCPTR		;REMEMBER SOURCE POINTER
	MOVEI A,ETBFR		;CREATE POINTER TO BUFFER FOR CHARACTERS
	HRLI A,440700
	MOVEM A,ETPTR		;DIVERT OUTPUT TO TEMPORARY BUFFER
ETYP2:	HRRZ A,ETPTR		;GET CURRENT OUTPUT ADDRESS
	CAIL A,-10+EBLN+ETBFR	;GETTING NEAR END OF BUFFER?
	CALL EDMP		;YES, DUMP BUFFER
	ILDB B,SRCPTR		;NEXT CHARACTER
ETYP2A:	JUMPE B,ETYPDN		;IF NULL, STRING IS DONE
	SKIPE ETYPF		;% IS NOT SPECIAL UNLESS ETYPE
	CAIE B,"%"
	JRST [	IDPB B,ETPTR	;NOT A %, BUFFER IT
		JRST ETYP2]
	CALL EDMP		;OUTPUT BUFFERED STUFF PRECEDING THE %
;%ETYPE...
;"%" SEEN

ETYP3:	ILDB B,SRCPTR		;GET THE CHARACTER AFTER PERCENT

ETYP4:	SKIPN STATF		;SKIP IF WE JUST PARSED AC #
	SETZM D			;D=NONZERO MEANS AC SPECIFIED
	SETZM STATF		;RESET STATE FLAG
	CAIGE B,040		;ASCII SPACE OR GREATER?
	CALL %ILOP		;NO, ILLEGAL OPERAND, CALL AND DON'T RETURN
	MOVEI A,-40(B)		;(1) SUBTRACT 40 TO ALLOW FOR MISSING CTL CHARS
				;(2) LEAVE THE CHAR INTACT IN AC-B
	HRRZ A,%LETS(A)		;GET ADDRESS OF ROUTINE
	CALL (A)		;DO THE WORK

;RETURN FROM DISPATCH
	SKIPE STATF		;ARE WE IN NEXT STATE?
	JRST ETYP4		;YES
	MOVE C,SRCPTR		;SAVE COPY
	ILDB B,C		;NEXT CHARACTER
	CAIN B,"%"		;PASS FOLLOWING %
	MOVEM C,SRCPTR
	JRST ETYP2		;NO, CONTINUE TYPING


ETYPDN:	CALL EDMP		;DUMP LAST BUFFERFUL
	DMOVE Z,RACS		;RESTORE AC'S
	DMOVE B,2+RACS
	MOVE D,4+RACS
	RET			;ALL DONE

;EDMP DUMPS BUFFER ONTO ACTUAL OUTPUT DEVICE

EDMP:	MOVEI A,0		;GUARANTEE NULL
	IDPB A,ETPTR
	MOVE A,COJFN		;OUTPUT TO REAL JFN
	HRROI B,ETBFR		;FROM OUR BUFFER
	MOVEI C,0		;STOP ON NULL
	SOUT			;SEND THE DATA
	MOVEM A,COJFN		;UPDATE JFN IN CASE BYTE POINTER
	MOVEI A,ETBFR		;RECONSTRUCT BYTE POINTER TO BUFFER
	HRLI A,440700
	MOVEM A,ETPTR
	RET
;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER %
;THIS IS AN ASCII DISPATCH TABLE MINUS THE CONTROL CHARACTERS

%LETS:	%ILOP		;( ) PERMANENTLY UNASSIGNED
	%EXTND		;(!) EXTEND OPERATOR
	%UNAS		;(") UNASSIGNED
	%NUMS		;(#) OCTAL NUMBER AS N OR N,,N AS APPROPRIATE
	%UNAS		;($) UNASSIGNED
	%PER		;(%) %% JUST PRINTS A PERCENT
	%UNAS		;(&) UNASSIGNED
	%SIX		;(') PRINT CONTENTS OF AC IN SIXBIT
	%UNAS		;"(" UNASSIGNED
	%UNAS		;")" UNASSIGNED
	%UNAS		;(*) UNASSIGNED
	%UNAS		;(+) UNASSIGNED
	%UNAS		;(,) UNASSIGNED
	%UNAS		;(-) UNASSIGNED
	%UNAS		;(.) UNASSIGNED
	%EXPR		;(/) EXPRESSION IN AC
	%AC		;(0) DIGIT
	%AC		;(1) DIGIT
	%AC		;(2) DIGIT
	%AC		;(3) DIGIT
	%AC		;(4) DIGIT
	%AC		;(5) DIGIT
	%AC		;(6) DIGIT
	%AC		;(7) DIGIT
	%AC		;(8) DIGIT
	%AC		;(9) DIGIT
	%UNAS		;(:) UNASSIGNED
	%UNAS		;(;) UNASSIGNED
	%ILOP		;(<) PERMANENTLY UNASSIGNED
	%FLT		;(=) SIX-COLUMN FLOATING POINT NUMBER, NN.MM
	%ILOP		;(>) PERMANENTLY UNASSIGNED
	%SYSMS		;(?) ERROR MESSAGE (CONTENTS OF AC OR LATEST)
	%LM		;(@) GET TO LEFT MARGIN
	%A		;(A) CURRENT TIME
	%B		;(B) CPU TIME AS HH:MM:SS, OR SPECIFIC TIME
			;    IN MILLISECONDS
	%C		;(C) CONNECT TIME
	%D		;(D) CURRENT DATE(OR SPECIFIC DATE)
	%E		;(E) SAME TIME AS LAST %D(OR SPECIFIC TIME)
	%F		;(F) "FORK N " IF >1 INFERIOR
	%G		;(G) CONNECTED DIR NAME
	%H		;(H) DEVICE NAME FOR DESIGNATOR IN INDICATED AC
	%I		;(I) PRINT # OF USER JOBS + # OF OPR JOBS
	%J		;(J) TSS JOB #
	%K		;(K) UPTIME
	%L		;(L) "LINE N" OR "DETACHED"
	%M		;(M) NUMBER OR STRING (5B0+N OR BYTE POINTER)
	%N		;(N) NAME UNDER WHICH USER IS LOGGED IN
			;    (OR SPECIFIC USER NAME)
	%O		;(O) CONTENTS OF SPECIFIED AC IN OCTAL
	%P		;(P) CONTENTS OF RIGHT HALF OF SPECIFIED AC IN OCTAL
	%Q		;(Q) CONTENTS OF AC IN DECIMAL OR FLOATING!
	%R		;(R) DIRECTORY NAME FOR DIR # OR STRING POINTER IN AC
	%S		;(S) FILE NAME FOR JFN IN AC
	%T		;(T) CONTENTS OF AC AS PERCENTAGE OF UP TIME
	%U		;(U) DECIMAL BIT NUMBERS, SEPARATED BY COMMAS
	%V		;(V) CPU TIME WITH TENTHS OF SECONDS
			;    (FORK HANDLE IN AC IF NOT 0)
	%W		;(W) STD FORMAT DATE AND TIME IN AC
	%X		;(X) TYPE ILLEG INST ERROR MSG
	%Y		;(Y) MEMORY ADDRESS
	%Z		;(Z) TYPE "," <SPACE><SPACE>...
	%UNAS		;([) UNASSIGNED
	%STRNG		;(\) TYPE STRING OR CHAR IN AC
	%UNAS		;(]) UNASSIGNED
	%UNAS		;(^) UNASSIGNED
	%EOL		;(_) TYPE A CRLF
	%SIX		;(') PRINT CONTENTS OF AC IN SIXBIT
	%AA		;(a) TYPE OUT 3-DIGIT OCTAL NUMBER WITH LEADING ZEROES
	%BB		;(b) TYPE OUT CURRENT CONTENTS OF ATOM BUFFER
	%UNAS		;(c) UNASSIGNED
	%UNAS		;(d) UNASSIGNED
	%UNAS		;(e) UNASSIGNED
	%UNAS		;(f) UNASSIGNED
	%UNAS		;(g) UNASSIGNED
	%UNAS		;(h) UNASSIGNED
	%UNAS		;(i) UNASSIGNED
	%UNAS		;(j) UNASSIGNED
	%UNAS		;(k) UNASSIGNED
	%UNAS		;(l) UNASSIGNED
	%UNAS		;(m) UNASSIGNED
	%UNAS		;(n) UNASSIGNED
	%UNAS		;(o) UNASSIGNED
	%UNAS		;(p) UNASSIGNED
	%UNAS		;(q) UNASSIGNED
	%UNAS		;(r) UNASSIGNED
	%UNAS		;(s) UNASSIGNED
	%UNAS		;(t) UNASSIGNED
	%UNAS		;(u) UNASSIGNED
	%UNAS		;(v) UNASSIGNED
	%UNAS		;(w) UNASSIGNED
	%UNAS		;(x) UNASSIGNED
	%UNAS		;(y) UNASSIGNED
	%UNAS		;(z) UNASSIGNED
	%UNAS		;({) UNASSIGNED
	%UNAS		;(|) UNASSIGNED
	%UNAS		;(}) UNASSIGNED
	%UNAS		;(~) UNASSIGNED
	%ILOP		;(DEL) PERMANENTLY UNASSIGNED


LETLEN==.-%LETS

;UNRECOGNIZED %-CODE

%ILOP:
%UNAS:	TYPE <%>		;DIGIT, IF ANY, IS LOST.
	POP P,A			;POP THE STACK AND DISCARD
	JRST ETYP2A		;CONTINUE TYPING, STARTING WITH CHAR AFTER %.


;THIS ROUTINE IS LEFT FOR A POSSIBLE EXPANSION OF THE DISPATCH TABLE
;IN WHICH THE LEFT HALF WOULD CONTAIN A NEW SERIES OF DISPATCH ADDRESSES
%EXTND:	RET
;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE.
;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY.

;%AC EXTRACTS AC VALUE IF AN AC WAS SPECIFIED
;AND LEAVES CONTENTS OF AC IN C
%AC:
	SETOM STATF		;INDICATE NEXT NON-NUMERIC IS A DISPATCH CHAR
	SETZB C,D		;C: IF NO NUMBER, USE 0 IN PLACE OF AC CONTENTS
				;D: INIT NUMBER TO 0.
%AC1:	IMULI D,10
	ADDI D,-"0"(B)		;ADD NEW DIGIT TO NUMBER
	MOVE C,D		;COMPUTE LOCATION TO GET AC FROM...
	CAIG C,D		;...AC'S 5-9 ARE PRESERVED,
	ADDI C,RACS		;...CONTENTS OF 0-4 ARE IN PUSHDOWN.
	MOVE C,(C)		;FETCH CONTENTS OF AC INDICATED BY NUMBER SO FAR
	ILDB B,SRCPTR		;GET NEXT CHARACTER
	CAIG B,"9"
	CAIGE B,"0"
	RET
	JRST %AC1		;GO CHECK FOR ADDITIONAL DIGIT(S)

;%% JUST PRINTS A %

%PER:	PRINT "%"
	RET

;CURRENT TIME

%A:	GTAD			;GET CURRENT DATE & TIME
A1:	MOVX C,OT%NDA		;TIME ONLY
A2:	MOVE B,A
	MOVE A,COJFN
	CAMN B,[-1]		;DOES SYSTEM HAVE DATE & TIME?
	HRLZI B,1		;CHANGE TO CALL SCREWUP ________
	ODTIM
	MOVEM A,COJFN		;SAVE UPDATED POINTER
	RET
;GET TO LEFT MARGIN

%LM:	CALLRET LM

;CPU TIME USED. ALSO SEE %V.

%B:	SKIPE A,C		;SPECIFIC TIME SUPPLIED?
	JRST [	IDIVI A,^D1000	;YES, CHANGE TO SECONDS
		JRST TOUT]	;PRINT AS HH:MM:SS
	HRROI A,-5		;SAY WHOLE JOB
	RUNTM
%B1:	IDIV A,B		;CONVERT TO SECS
	JRST TOUT		;TYPE AS H:MM:SS

;CONSOLE TIME USED

%C:	HRROI A,-5
	RUNTM
	MOVE A,C
	JRST %B1

;DATE

%D:	SKIPN A,C		;USE GIVEN QUANTITY IF ANY
	GTAD			;GET CURRENT DATE & TIME FROM SYSTEM
	MOVEM A,%EDAYT		;SAVE FOR %E
	MOVX C,OT%NTM!OT%SCL	;DATE ONLY, STANDARD CONCISE FORMAT
	JRST A2			;GO PRINT DATE

;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE.

%E:	SKIPN A,C		;IF SPECIFIC TIME GIVEN, USE IT
	MOVE A,%EDAYT
	JRST A1			;SEE %A
;ETYPE'S % ROUTINES ...

;TYPE "FORK N " ONLY IF THIS EXEC HAS >1 INFERIORS.
; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "RFORK".
;FIRST READ FORK STRUCTURE TO FIND OUT HOW MANY FORKS THERE ARE.

%F:	MOVEI A,.FHSLF		;SAY START AT SELF
	MOVX B,GF%GFH		;ASSIGN FORK HANDLES
	MOVE C,[-300,,BUF0]	;WHERE TO PUT FORK STRUCTURE
	GFRKS			;GET FORK STRUCTURE
	 CALL [	CAIE 1,GFKSX1	;RAN OUT OF SPACE?
		JRST JERR	;NO, STRANGE
		POP P,(P)
		JRST %F1]	;PRINT ANYWAY
	HRRZ A,(B)		;PTR TO INFERIOR
	MOVE A,(A)		;XWD ITS PARELLEL, ITS INFERIOR
	JUMPE A,%F2		;[3063]NEITHER EXISTS, ITS ONLY ONE, PRINT NOTHING.
%F1:	TYPE <Fork >
	SKIPG B,C		;USE GIVEN HANDLE IF AC W >0 CONTENTS GIVEN
	MOVE B,FORK		;ELSE HANDLE OF LAST RUN FORK
	TRZ B,(1B0)		;PRINT ## NOT 4000##.
	CALL TOCT		;OCTAL OUTPUT FROM B
	PRINT " "
%F2:	MOVEI A,BUF0		;[3063]Get address of GFRKS% block
	CALL RELHAN		;[3063](A/)Release unwanted fork handles
	RET

;DEVICE NAME FOR DESIGNATOR IN INDCATED AC.

%H:	MOVE A,C
	DVCHR			;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR
	 ERCAL JERR		;CM236
	MOVE B,A
	MOVE A,COJFN
	DEVST			;DEVICE TO STRING
	 CALL JERR
	MOVEM A,COJFN		;SAVE IN CASE POINTER
	RET
;NUMBER OF USERS ON SYSTEM.
;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1.

%I:	CALL USRCNT
	PUSH P,A		;SAVE OPR JOB COUNT
	MOVE A,COJFN
	MOVEI C,^D10
	NOUT			;PRINT NUMBER
	 CALL JERRC		;GENERAL JSYS ERROR ROUTINE FOR ERR COD IN C
	MOVEI B,"+"		;SEPARATE USER/OPR JOBS
	BOUT
	POP P,B			;GET COUNT OF OPR JOBS
	NOUT			;PRINT IT
	 CALL JERRC
	MOVEM A,COJFN		;SAVE IN CASE POINTER
	RET

USRCNT::MOVSI A,(RC%EMO)	;EXACT MATCH ONLY
	HRROI B,[ASCIZ /OPERATOR/]
	RCUSR			;GET DIRNUM OF OPERATOR
	TLNE A,(RC%NOM+RC%AMB)	;COULDN'T?
	MOVEI C,-1		;NO, SO USE -1
	PUSH P,C		;SAVE IT FOR COMPARES BELOW
	SETZB B,C		;COUNTER
	HLLZ D,JOBRT		;SET UP AOBJN PTR
	GTB .JOBRT
	JUMPL A,%I1		;NO JOB 0
	GTB .JOBTT
	JUMPL A,%I3		;IGNORE DETACHED JOB 0
%I1:	GTB .JOBRT		;TABLE 1 IS POSITIVE IF JOB EXISTS
	JUMPL A,%I3
	CALL USERNO		;GET USER NUMBER
	JUMPE A,%I3		;SKIP JOB IF NOT LOGGED IN
	CAMN A,0(P)		;LOGGED IN AS 'OPERATOR'?
	AOJA C,%I3		;YES, COUNT OPERATOR JOBS
	AOS B			;COUNT REGULAR JOBS
%I3:	AOBJN D,%I1
	MOVE A,C
	POP P,(P)
	RET

;UPTIME

%K:	TIME			;TIME SINCE SYSTEM RESTARTED
	IDIV A,B		;CONVERT TO SECONDS
	CALLRET TOUT		;PRINT AS HH:MM:SS AND RETURN
;ETYPE's % routines ...

;%L takes .TTDES+n or no arg (or 0) for controlling terminal.
;%L will output output "TTYn", "TTYn org(typ)" or "Detached".

%L:	STKVAR <<NTBLK,.NWNU1+2>,<HSTNAM,20>> ;[4419] NTINF storage
	IFE. C			;[4425] If no AC or 0 specified do this job
	  GJINF%		;[4419] Get information about the job
	  MOVEI C,.TTDES(D)	;[4425] Load terminal number to C
	ENDIF.			;[4425] End of defaulting code
	IFL. C			;[4419] Detached?
	  UTYPE [ASCIZ /Detached/] ;[4419] Yes say so
	  RET			;[4419] and return
	ENDIF.			;[4419] Not detached
	MOVEM C,.NWLIN+NTBLK	;[4419] Want this terminal's location
	UTYPE [ASCIZ/TTY/]	;[4419] Spread TTY 
	MOVEI B,-.TTDES(C)	;[4425] Get just the number for TOCT
	CALL TOCT		;[4419] (B/) Type octal from B
	SETZM HSTNAM		;[4419] Clear this out
	MOVEI B,.NWNU1+1	;[4419] Size of argument block
	MOVEM B,.NWABC+NTBLK	;[4419] Save it in the right place
	SETZM .NWFNC+NTBLK	;[4419] Clear out function (func=0)
	HRROI B,HSTNAM		;[4419] Remote goes here
	MOVEM B,.NWNNP+NTBLK	;[4419] Save in argument block
	MOVEI A,NTBLK		;[4419] Here's the argument block
	NTINF%			;[4419] Get information
	 ERJMP R		;[4419] Return now if old monitor
	SKIPN HSTNAM		;[4419] Do we have a host?
	RET			;[4419] Nope, return
	UTYPE [ASCIZ/ /]	;[4419] Output a space
	UTYPE HSTNAM		;[4419] Output host name
	HRRZ B,.NWTTF+NTBLK	;[4419] (no symbol for this field) Get type 
	MOVSI A,-%L%SIZ		;[4419] Load number of things in table,,0
	DO.			;[4419] Loop for things in table
	  HRRZ C,%L%TAB(A)	;[4419] Load type of connection from table
	  CAMN C,B		;[4419] Match the type we want to hear about?
	  EXIT.			;[4419] Yes
	  AOBJN A,TOP.		;[4419] Loop for all of them
	  RET			;[4419] Unknown type, just return
	OD.			;[4419] End of loop
	HLRO B,%L%TAB(A)	;[4419] Match, load address of text
	UTYPE (B)		;[4419] Output the type text
	RET			;[4419]  and return

;[4419] Table of network connection types for above code.

%L%TAB:	XWD [ASCIZ/(NRT)/],NW%MC ;[4419] MCB (NRT) terminal
	XWD [ASCIZ/(TCP)/],NW%TV ;[4419] TVT (TCP) terminal
	XWD [ASCIZ/(CTM)/],NW%CH ;[4419] CTERM terminal
	XWD [ASCIZ/(LAT)/],NW%LH ;[4419] LAT terminal
	%L%SIZ==.-%L%TAB	;[4419] Make size of table
	ENDSV.			;[4419] End of STKVAR at %L
;ETYPE'S % ROUTINES ...

;TAKES 5B2+NUMBER, OR STRING POINTER, IN INDICATED AC

%M:	MOVE A,COJFN
	LDB B,[POINT 3,C,2]
	CAIE B,5
	JRST [	MOVE B,C
		SETZ C,
		SOUT
		MOVEM A,COJFN	;UPDATE, IN CASE BYTE POINTER
		RET]
	MOVE B,C
	TLZ B,700000
	MOVEI C,^D10
	NOUT
	 CALL JERRC
	MOVEM A,COJFN		;UPDATE, IN CASE BYTE POINTER
	RET

;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N.

%G:	GJINF
	JRST %N1

;USER (DIRECTORY) NAME LOGGED IN UNDER.

%N:	SKIPN A,C		;USE SPECIFIC USER NAME IF GIVEN
	GJINF
	MOVE B,A		;LOGIN DIRECTORY NO
%N1:	MOVE A,COJFN
	DIRST
	 ERJMP DIRSTB		;THE DIRST FAILED
	MOVEM A,COJFN		;UPDATE IN CASE BYTE POINTER
	RET
DIRSTB:	 PRINT "?"		;R1: UNASSIGNED DIR #, NO SYST ERR # IN A.
	RET
;ETYPE'S % ROUTINES...

;OCTAL NUMBER IN SPECIFIED AC.

%O:	MOVE B,C
	JRST TOCT		;TYPE OCTAL FROM B

%STRNG:	HLRZ A,C		;GET PNTR LHS
	JUMPE A,%CHAR		;IF NO POINTER THEN CHARACTER RJ
	CAIE A,-1		;CHECK FOR -1,,
	 CAIN A,(<POINT 7,,>)	; OR 440700
	  CAIA
	   RET			;RETURN IF CRAP
	HRLI C,(<UETYPE>)	;FORM LUUO
	PUSH P,C		;SAVE IT
	MOVE Z,RACS		;RESTORE ACS
	DMOVE A,1+RACS
	DMOVE C,3+RACS
	XCT 0(P)		;DO IT
	POP P,C			;PRUNE PDL
	RET			;RETURN

%CHAR:	SKIPN B,C		;GET CHARACTER
	 RET			;RETURN IF NULL
	CALLRET COUTC		;TYPE IT AND RETURN

;SIXBIT OF DATA IN AC

%SIX:	MOVE A,[440600,,C]	;POINTER TO SIXBIT DATA
	MOVEI D,0		;NULL TO CLEAR CHARACTERS AS WE PRINT THEM
SIX1:	TLNN A,770000		;HAVE WE DONE ALL SIX CHARACTERS YET?
	RET			;YES
	ILDB B,A		;NO, GET ONE
	DPB D,A			;CLEAR OUT CHARACTER WE JUST READ
	JUMPN B,SIX2		;IF CHARACTER IS NON-0, ALWAYS PRINT IT
	JUMPE C,R		;IF CHARACTER IS 0, PRINT IT UNLESS IT'S A TRAILING SPACE
SIX2:	ADDI B,40		;CHANGE TO ASCII
	PRINT @B		;PRINT CHARACTER
	JRST SIX1		;GO BACK FOR REST

;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC

%P:	HRRZ B,C
	JRST TOCT

;FLOATING POINT NUMBER

%FLT:	MOVE B,C		;GET NUMBER
	JRST %Q2
;TSS JOB NUMBER. MUST PRECEDE %Q.

%J:	GJINF			;GETS JOB # IN C

;FLOATING PT OR DECIMAL NUMBER FROM AC.
;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100<Q1<377

%Q:	MOVE B,C
	MOVM C,B
	TLNE C,700000		;EXPONENT .GE. 100?
	TLNN C,400		;NORMALIZED?
	JRST %Q1		;NO, PRINT DECIMAL
	LDB C,[POINT 9,C,8]	;GET EXPONENT
	CAIN C,377		;SPECIAL INFINITY?
	JRST [	TYPE <+INF>	;YES - SAY SO
		RET]
%Q2:	MOVE A,COJFN

;THE FOLLOWING FORMAT WORD WILL USE 6 PLACES FOR NUMBERS LESS THAN
;1000.  OTHERWISE, IT GOES TO 'FREE' FORMAT AND USES WHATEVER NECESSARY.

	MOVE C,[FL%ONE+FL%PNT+FL%OVL+FLD(3,FL%FST)+FLD(2,FL%SND)]
	FLOUT
	 CALL [	CAIE C,FLOTX1	;COLUMN OVERFLOW?
		JRST JERRC	;NO, SOMETHING UNEXPECTED
		POP P,C		;YES, THAT'S OK
		JRST .+1]
	MOVEM A,COJFN		;UPDATE, IN CASE BYTE POINTER
	RET

%Q1:	MOVEI	C,^D10		;RADIX TO USE
	MOVE A,COJFN
	NOUT
	 CALL JERRC
	MOVEM A,COJFN		;UPDATE, IN CASE BYTE POINTER
	RET

;FLOAT THE INTEGER IN A

FLOAT:	IDIVI A,400000		;BREAK NUMBER INTO TWO PARTS
	FSC A,254		;CONVERT HIGH PART
	FSC B,233		;CONVERT LOW PART
	FADR A,B		;COMBINE PARTS
	RET
;RETURN USER NUMBER IN A OF JOB # IN D
;RETURNS 0 IF THE JOB IS NOT LOGGED IN!

USERNO::PUSH P,B
	PUSH P,C		;CLOBBER NOTHING
	HRROI B,A		;DIRECT OUTPUT TO LOCATION A
	HRRZ A,D		;GET JOB #
	MOVEI C,.JIUNO		;SPECIFY USER NUMBER REQUESTED
	GETJI			;GET THE USER NUMBER
	 JRST USERN1		;FAILED, GO SEE WHY
USERN2:	POP P,C
	POP P,B
	RET
USERN1:	CAIE A,GTJIX4		;"JOB NOT LOGGED IN" ERROR?
	CALL JERR		;NO, OTHER. UNEXPECTED
	MOVEI A,0		;YES, SO RETURN 0.
	JRST USERN2

;DIRECTORY NAME FOR NUMBER IN AC

%R:	CAMN C,[-1]
	JRST %G			;-1 = CONNECTED
	LDB B,[POINT 3,C,2]	;SEE IF THIS IS A NUMBER
	CAIE B,5		;OR IF IT IS A STRING POINTER
	JRST %M			;STRING POINTER
	MOVE B,C
	JRST %N1
;FILE NAME FOR JFN IN AC

%S:	MOVE A,COJFN
	MOVE B,C
	SETZ C,
	JFNS
	 ERJMP %S1		;ERROR - CHECK IT OUT
	MOVEM A,COJFN		;UPDATE IN CASE BYTE POINTER
	RET

%S1:	CALL JFNSIL 		;ANALYZE THE ERROR
	 JRST JERR		;STRANGE ERROR
	RET			;"GOOD" ERROR

;JFNSIL ANALYZES JFNS ERROR.  IF IT RECOGNIZES THE ERROR, IT PRINTS OUT
;THE EXPLANATION AND SKIP RETURNS.
;IF IT DOESN'T RECOGNIZE THE ERROR, IT GIVES A NON-SKIP RETURN.

JFNSIL::CALL %GETER
	HRRZ A,B
	GTSTS
	MOVE A,ERCOD
	CAIN A,DESX3		;RESTRICTED JFN ERROR?
	 JRST [	TYPE < Restricted JFN>
		RETSKP]
	TXNN B,GS%NAM		;DOES JFN HAVE NAME?
	RET			;NO - JUST RETURN ERROR CODE
	CAIN A,GJFX24		;YES - IS THE FILE GONE?
	 JRST [	TYPE < Nonexistent file>
		RETSKP]
	RET			;NON-SKIP TO DENOTE STRANGE ERROR
;CONTENTS OF AC AS PERCENTAGE OF UP TIME

%T:	TIME			;GET UPTIME IN A
	MULI C,^D200
	DIV C,A			;HOPE DIVISORS TO CONVERT TO SECS ARE SAME
	ADDI C,1		;ROUND
	LSH C,-1
	CALL %Q			;PRINT IN DECIMAL
	PRINT "%"
	RET
;ETYPE'S % ROUTINES...

;CONTENTS OF AC AS LIST OF DECIMAL NUMBERS FOR SET BITS,
; OR "NONE" IF AC 0.

%U:	JUMPE C,[UTYPE [ASCIZ /None/]
		RET]
	SETZ D,			;BIT NUMBER
				;FIND FIRST SET BIT
	TLNE C,(1B0)
	JRST %U2
	LSH C,1
	AOS D
	JRST .-4
				;LOOP FOR SUCCESSIVE BITS
%U1:	TLNN C,(1B0)
	JRST %U3
	PRINT ","		;COMMA (AND SPACE) BEFORE ALL BUT FIRST
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIL B,^D55
	ETYPE<%_>		;EOL IF TOO FAR RIGHT
	PRINT " "
%U2:	ETYPE <%4Q>		;BIT # IN DECIMAL
%U3:	AOJ D,
	LSH C,1
	JUMPN C,%U1
	RET
;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB.

%V:	SKIPE D			;IF AC SPECIFIED
	SKIPA A,C		;THEN IT IS FORK HANDLE
	HRROI A,-5		;SAY WHOLE JOB
	RUNTM
	MOVE C,B		;TICKS PER SECOND
	IDIV A,B		;CONVERT TIME IN TICKS TO SECS
	CALL TOUT		;TYPE H:MM:SS
	IDIVI C,^D10		;GET TICKS PER 1/10 SEC
	JUMPN D,[RET]		;NOT EVEN, DON'T PRINT TENTHS OF SECS
	IDIV B,C		;CONVERT REMAINDER OF TICKS TO TENTHS
	ETYPE <.%2Q>		;TYPE TENTHS OF SECONDS
	RET

;PRINT C(AC) AS DATE AND TIME
;[4420] If supplied date time is zero, print "Never"

%W:	MOVE A,COJFN		;[4420] Load the usual output JFN
	SKIPE B,C		;[4420] Arg supplied in C, was it zero?
	IFSKP.			;[4420] Yes, it was zero
	  HRROI B,[ASCIZ/Never/] ;[4420] Never say never, just display it
	  SETZ C,		;[4420] Terminate on a null
	  SOUT			;[4420] Send that along slowly please
	   ERJMP .+1		;[4420] Avoid problem if owie byte pointer
	  MOVEM A,COJFN		;[4420] Save it back incase a pointer
	  RET			;[4420]  and return
	ENDIF.			;[4420] Argument was nonzero, its a date time
	MOVX C,OT%SCL		;[4421] Suppress columnization please
	ODTIM			;Output the date and time
	MOVEM A,COJFN		;UPDATE COJFN IF BYTE POINTER
	RET
;ETYPE's % routines...

;ARGUMENT TO %NX IS HANDLE OF A PROCESS STOPPED BECAUSE OF AN
;ILLEGAL INSTRUCTION.  TYPE THE INSTRUCTION, THE PC, AND IF THE
;INSTRUCTION WAS A JSYS, THE ASSOCIATED SYSTEM MESSAGE.  THOUGH THE
;PC COULD BE FOUND BY DOING A LONG RFSTS HERE, CALLERS HAVE DONE IT,
;LEAVING IT IN LRFSTS+.RFPPC.

%X:	PUSH P,FORK		;SAVE GLOBAL FORK HANDLE
	CALL PIOFF		;NO ^C WHILE FORK CELL IS WRONG
	CAIN C,0		;ANY FORK GIVEN?
	MOVE C,FORK		;NO, USE CURRENT
	SKIPLE EFORK		;USE EPHEMERAL IF PRESENT
	 MOVE C,EFORK
	MOVEM C,FORK		;TEMP STORE FOR MAPPF CALL
	SETZM SYMOKF		;FORCE SYMBOL TABLE INITIALIZATION FOR FORK BEING DISPLAYED
	MOVE C,LRFSTS+.RFPPC	;GET PC OF PROCESS
	HRRI C,-1(C)		;GET PC OF OFFENDING INSTRUCTION, BUT
	MOVE A,C		;  BY SUBTRACTING WITHOUT CARRY FROM LH
	CALL LOADF		;GET CONTENTS OF PC
	 JRST %X1		;CAN'T READ INSTRUCTION-- DON'T PRINT IT
	ETYPE <%1/ at %3Y>
	HLRZS A			;GET OPCODE TO SEE IF IT'S A JSYS
	CAIN A,<JSYS>B53
	TYPE < - JSYS error:>
	JRST %X2		;CONTINUE . . .

%X1:	ETYPE <at %3Y>

%X2:	MOVE A,FORK		;GET ERROR CODE NOW FOR USE IN ERSTR
	GETER			;DO JSYS
	HRRZ B,B		;KEEP ONLY THE ERROR CODE
	ETYPE <%_>		;TYPE EOL
	SKIPE INDQUS		;IF SET, WE ARE PRINTING "INFO PROG"
	JRST %X4		;DONT WANT QUESTION MARK IN COLUMN 1
	ETYPE <?%2?>		;NOT SET, PROCEED NORMALLY
%X3:	SETO A,			;ADD LABEL
	CALL MAPPF		;UNMAP PAGE
	 JFCL			;UNMAP SHOULDN'T FAIL
	POP P,FORK		;RESETORE FORK INFO
	SETZM SYMOKF		;FORCE RECALCULATION OF OLD FORK'S SYMBOL TABLE DATA
	CALLRET PION		;SET ^C O.K. AND RETURN

%X4:	ETYPE <   >		;TYPE THREE SPACES FOR EACH FORK-LEVEL
	SOJGE Q1,%X4		;Q1, IS SETUP BY FSTAT TO CONTAIN FORK-LEVEL
	ETYPE <?%2?>		;FINALLY PRINT FORK'S ERROR MESSAGE
	JRST %X3
;ETYPE'S % ROUTINES...

;%/ PRINTS EXPRESSION IN AC

%EXPR:	SKIPN SYMF		;PRINT SYMBOLICALLY?
	JRST %Y			;NO, DO LIKE ADDRESS
	MOVE A,C		;YES, GET VALUE
	CALLRET TYPEXP		;PRINT EXPRESSION

;%Y TYPES AN EXPRESSION

%Y:	SKIPE SYMF		;TYPE SYMBOLICALLY?
	JRST [	MOVE A,C	;YES, GET VALUE TO BE TYPED
		CALLRET TYPADD]	;TYPE IT SYMBOLICALLY
%NUMS:	PUSH P,C		;SAVE THE NUMBER
	HLRZ B,C		;SET UP LEFT HALF OF NUMBER
	MOVE A,COJFN		;STANDARD OUTPUT STREAM
	MOVEI C,8		;OCTAL
	JUMPE B,%Y1		;DON'T PRINT ANYTHING IF ZERO
	NOUT
	 CALL JERRC		;TYPE STANDARD MESSAGE
	MOVEI B,","		;SEPARATE HALVES
	BOUT
	BOUT
%Y1:	POP P,B			;RESTORE NUMBER
	MOVEI B,(B)		;PRINT JUST THE RIGHT HALF THIS TIME
	NOUT
	 CALL JERRC		;PRINT STANDARD MESSAGE
	MOVEM A,COJFN		;UPDATE IN CASE IT'S A BYTE POINTER
	RET
;%Z TYPES "," SPACE SPACE ... SPACE

%Z:	SKIPN D			;WAS AN AC SPECIFIED?
	SETZM C			;NO, OUTPUT COMMA ONLY
	CAILE C,%COMN		;.LEQ. MAX COMMAS ?
	MOVEI C,%COMN		;NO, USE MAX
	MOVE A,COJFN		;STANDARD OUTPUT JFN
	HRRO B,COMTAB(C)	;GET POINTER TO STRING
	SETZM C			;END ON NULL
	SOUT			;OUTPUT STRING
	RET			;RETURN


COMTAB: [ASCIZ/,/]
	[ASCIZ/, /]
	[ASCIZ/,  /]
	[ASCIZ/,   /]
	[ASCIZ/,    /]
	[ASCIZ/,     /]
	[ASCIZ/,      /]
	[ASCIZ/,       /]
	[ASCIZ/,        /]
	%COMN=.-COMTAB

	;%a TYPES OUT AN OCTAL NUMBER IN A 3-DIGIT FIELD
%AA:	MOVE A,COJFN		;GET CURRENT JFN
	MOVE B,C		;GET THE NUMBER
	MOVE C,[NO%LFL+NO%MAG+NO%ZRO+3B17+10]
	NOUT
	JFCL			;IGNORE ERRORS
	RET
;%b TYPES OUT CONTENTS OF ATOM BUFFER

%BB:	MOVE A,COJFN		;GET CURRENT JFN
	MOVE B,[POINT 7,ATMBUF]
	SETZM C
	SOUT
	RET

;%? TYPES LAST ERROR MESSAGE

%SYSMS:	HRLI B,.FHSLF		;OURSELF
	HRR B,ERCOD		;USE LAST ERROR IF NO ARG
	CAIE C,0		;SPECIFIC ERROR DESIRED?
	HRR B,C			;YES, USE IT
	MOVE A,COJFN		;STANDARD OUTPUT STREAM
	MOVEI C,0		;NO SIZE LIMIT
	AOS CLZFFF		;IF ^C WHILE ERSTR HAS ERRMES.BIN OPEN, DO CLZFF
	ERSTR			;TYPE MESSAGE
	 JRST [	CALL CRIF	;START ON A NEW LINE IF NEEDED
		ETYPE <?Error message not found for error %2P>
		JRST .+2]	;R1: BAD ERROR NUMBER
	 JRST .+1		;R2: DESTINATION PROBLEM, FORGET IT.
	SOS CLZFFF		;WE NO LONGER REQUIRE CLZFF
	MOVEM A,COJFN		;UPDATE COJFN IN CASE BYTE POINTER
	RET
;ETYPE'S % ROUTINES...

;PRINT CRLF

%EOL:	MOVE A,COJFN		;GET OUTPUT STREAM
	CALL SNDEOL		;WRITE THE CRLF
	MOVEM A,COJFN		;UPDATE OUTPUT STREAM
	RET

;ROUTINE TO PUT OUT END OF LINE.  CALL WITH JFN IN A.

SNDEOL::PUSH P,B
	HRROI B,[BYTE(7).CHCRT,.CHLFD]
	MOVEI C,0		;END ON NULL
	SOUT			;WRITE THE CRLF
	POP P,B
	RET
;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS.

TOUTD:	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVE B,A
	MOVE A,OUTDSG
	JRST TOUT1

TOUT::	PUSH P,A		;[7.1076]
	PUSH P,B
	PUSH P,C
	MOVE B,A
	MOVE A,COJFN
TOUT1:	IDIVI B,^D3600
	PUSH P,C
	MOVEI C,^D10
	NOUT			;HOURS
	 CALL JERRC
	MOVEI B,":"
	BOUT
	POP P,B
 	IDIVI B,^D60
	PUSH P,C
	MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!5+5	;2 COLS, LEADING 0'S.
	NOUT			;MINUTES
	 CALL JERRC
	MOVEI B,":"
	BOUT
	POP P,B
	NOUT			;SECONDS
	 CALL JERRC
	POP P,C
	POP P,B
	POP P,A
	RET
;ROUTINE TO STACK ALL THE AC'S.  THIS IS USEFUL FOR INTERRUPT
;ROUTINES THAT HAVEN'T THE SLIGHTEST IDEA WHERE THE EXEC WAS WHEN
;THE INTERRUPT OCCURED, SO THE INTERRUPT ROUTINE CALLES SAVACS TO
;SAVE ALL THE AC'S ON THE STACK.  THE INTERRUPT ROUTINE MUST CALL
;RESACS BEFORE DISMISSING THE INTERRUPT, IN ORDER TO RESTORE THE
;AC'S.
;THIS ROUTINE DOESN'T SAVE P.

SAVACS::EXCH 0,(P)		;SAVE AC0, GET RETURN ADDRESS
	ADJSP P,17		;ALLOCATE ROOM FOR THE REST OF THE AC'S
	MOVEM 0,(P)		;STORE RETURN ADDRESS "AFTER" AC BLOCK
	HRRI 0,-16(P)		;PLACE ON STACK TO STORE AC'S
	HRLI 0,1		;STARTING FROM AC1
	BLT 0,-1(P)		;SAVE REST OF AC'S
	RET			;RETURN TO CALLER

;ROUTINE TO RESTORE AC'S

RESACS::HRLI 0,-16(P)		;GET ADDRESS OF STORED AC'S
	HRRI 0,1		;RESTORE AC'S INTO AC1 ONWARD
	BLT 0,16		;RESTORE 1 THROUGH 16
	MOVE 0,(P)		;GET RETURN ADDRESS
	EXCH 0,-17(P)		;STORE RETURN ADDRESS, GET ORIGINAL AC0
	ADJSP P,-17		;FREE UP SPACE USED BY RETURN ADDRESS AND 1 THRNOUGH 16
	RET			;RETURN TO CALLER (PHYEW!)
;[3034] POBCHK
;[3034] ROUTINE TO SEE IF DIRECTORY/USER NAME INPUT HAS A MAIL.TXT.1 FILE ON 
;[3034] POBOX:. IF NOT, DO NOT ALLOW MAIL FUNCTIONS TO BE PERFORMED ON THAT DIR
;[3034]
;[3034]	CALL WITH STRING POINTER TO DIR NAME IN AC2
;[3034]
;[3034]	RETURNS +1 IF ERROR - "NO MAILBOX"
;[3034]
;[3034]	RETURNS +2 ON SUCCESS, WITH DIRECTORY NUMBER IN AC3
;[3034]
;

POBCHK::STKVAR <DIRPTR,POBJFN>	;[3040]
	MOVEM B,DIRPTR		;[3040] SAVE POINTER TO INPUT DIR NAME
	MOVE A, CSBUFP		;[3040]
        HRROI B,[ASCIZ/POBOX:</] ;[3040] SET UP STRING IN FREESPACE
	MOVEI C, 0		;[3040]
	SOUT%			;[3040]
         ERJMP CJERRE		;[3040]
	MOVE B,DIRPTR		;[3040] GET BACK POINTER TO NAME
	MOVEI C,0		;[3040]
	SOUT%			;[3040] ADD DIR NAME TO STRING
	 ERJMP CJERRE		;[3040]
	MOVEI B,">"		;[3040]
	BOUT%			;[3040]
         ERJMP CJERRE		;[3040]
	HRROI B,[ASCIZ/MAIL.TXT.1/] ;[3040]ADD FILENAME TO STRING
	MOVEI C,0		;[3040]
	SOUT%			;[3040]
	 ERJMP CJERRE		;[3040]
;				
; NOW TRY TO GET A JFN ON MAIL.TXT.1 IN THE INPUT DIRECTORY ON POBOX:
;
	MOVX A,GJ%OLD!GJ%DEL!GJ%SHT!GJ%PHY ;[3040] FILE MUST EXIST, DISREGARD JOB-WIDE LOGICALS
				;[3040]...FILE CAN BE DELETED, SHORT FORM GTJFN
	MOVE B,CSBUFP		;[3040]POINTER TO STRING
	GTJFN%			;[3040]
         ERJMP [CAIN A,GJFX24	;[3040] FILE NOT FOUND?
               RET 		;[3040] NOT THERE, CAN'T WATCH THIS DIR
	       JRST CJERRE]	;[3040] SOME OTHER ERROR
;
;[3040]NOW WE HAVE THE JFN ON POBOX:<DIRECTORY>MAIL.TXT.1 USE IT TO HAVE JFNS% 
;[3040]RETURN THE "REAL" STRUCTURE NAME AND DIRECTORY SO WE CAN GIVE IT TO RCDIR%
;[3040]AND OBTAIN THE DIRECTORY NUMBER TO PUT IN THE MAIL-WATCHING TABLE.
;

	MOVEM A,POBJFN		;[3040] SAVE THE STUFF FROM GTJFN
	HRRZ B,A		;[3040] GET JFN INTO AC2
	MOVE A,CSBUFP		;[3040]
	MOVX C,FLD (.JSAOF,JS%DEV)!FLD (.JSAOF,JS%DIR)!JS%PAF ;[3040] GET PUNCTUATED STRUCTURE AND DIRECTORY
	JFNS%			;[3040]
         ERJMP CJERRE		;[3040]
	HRRZ A,POBJFN		;[3040]GET THE JFN BACK
	RLJFN%			;[3040]RELEASE IT
	 ERJMP CJERRE
	MOVE B,CSBUFP		;[3040] MOVE BYTE POINTER INTO AC2
	MOVEI A,0		;[3040]
	MOVEI C,0		;[3040]
	RCDIR%			;[3040]
	 ERJMP CJERRE		;[3040]
	RETSKP			;[3040] WE HAVE THE DIRECTORY NUMBER IN AC3...
	ENDSV.			;[3040] ...RETURN IT
;NEW MAIL WATCH SUBROUTINE - CAN BE CALLED FROM EITHER INTERRUPT LEVEL
;OR COMMAND RETURNS , DOES NOTHING IF NOT LOGGED IN OR MAIL WATCH TURNED
;OFF, MWATCF := 0

MWATCH::SKIPE BATCHF		;NO MAIL WATCH IF UNDER BATCH
	 RET
	SKIPE CUSRNO		;LOGGED IN?
	 SKIPN MWATCF		;YES - WANT MAIL WATCH
	  RET			;NO - RETURN
	GTAD			;OK - GET D/T
	MOVEI D,MWATAT		;AUTO TIMER
	SKIPN AUTOF		;THIS CALL FROM IIT
	 MOVEI D,MWATCT		;NO - USE COMMAND TIMER
	CAMGE A,0(D)		;TIME TO CHECK MAIL?
	 RET			;NOPE - RETURN
	ADDI A,^D910		;TRY AGAIN 5 MINS FROM NOW
	MOVEM A,0(D)
	MOVEI Q2,NMWAT-1	;# OF ENTRIES
MWATC0:	SKIPE B,MWATDR(Q2)	;GET DIRECTORY #
	 CALL MALCHK		;CHECK ONE
	  JRST MWATC4		;NO NEW MAIL
	CAMN D,MWATWR(Q2)	;CHECK LAST WRITE DATE/TIME
	 JRST [	SKIPE AUTOF	;STILL THE SAME , CHECK IIT
		JRST MWATC4	;AUTO WATCH - GO TO NEXT
		JRST MWATC1]	;NOT AUTO - DECREMENT COUNT
	MOVE Q1,MWATN0(Q2)	;GET INITIAL COUNT
	MOVEM Q1,MWATN(Q2)	;RESET FOR NEW D/T
	MOVEM D,MWATWR(Q2)	;REMEMBER WRITE DATE
	SKIPE AUTOF		;IIT?
	 JRST MWATC2		;YES - TELL USER
MWATC1:	SOSGE MWATN(Q2)		;REDUCE REPEAT COUNT
	 JRST MWATC4		;COUNT EXPIRED, GO ON
	JRST MWATC3		;INFORM USER OF MAIL

MWATC2:	PUSH P,A		;SAVE STRING PNTR FROM MALCHK
	MOVE A,COJFN
	DOBE			;WAIT FOR TYPEOUT TO STOP
	POP P,A			;RESTORE PNTR
	TYPE <>		;RING CHIMES
MWATC3:	MOVE Q1,MWATDR(Q2)	;USER BEING WATCHED
	CAME Q1,POBXNO		;[3040] IS IT ME?
	 JRST [	ETYPE <[%10R has > ;[3040] NO - TELL ME WHO THEN
		JRST .+2]
	TYPE <[You have >	;IT'S MINE
	TLNN B,77		;NETWORKS
	TYPE <net>
	ETYPE <mail %1\]%_>
MWATC4:	SOJGE Q2,MWATC0		;LOOP BACK FOR NEXT
	RET			;DONE, RETURN
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;[3040] CALLED WITH C(B) := DIRECTORY #
;RETURNS:
;	+1	;NO MAIL, OR SOME OTHER FAILURE
;	+2	;NEW MAIL - C(A) := -1,,MESSAGE
;			    C(D) := WRITE DATE/TIME
;			    C(C) := AUX MESSAGE
;[3040]			    C(P1):= POINTER TO MAILBOX NAME

MALCHK::STKVAR <MALDIR,<MALFDB,16>,POBJFN> ;[3040]
	SETO Q1,		;INIT FLAG
	HRROI A,MALBUF		;POINT AT BUFFER 
	DIRST			;NAME STRING TO BUFFER
	IFJER.
	  CAIE A,STRX10		;[4401] Is structure offline?
	  IFSKP.		;[4401] If so,
	    TYPE <?Mail checking failed because mail structure is offline
>
	    RET			;[4401] And return
	  ENDIF.
          TYPE <%POBOX: - >	;[3066] Handle error
	  CALL %GETER		;[3065] Get error code
	  MOVE A,ERCOD
	  CALL $ERSTR		;[3065] Print it
	  RET			;[3065] And return
	ENDIF.
	HRROI B,[ASCIZ "MAIL.TXT.1"]
	MOVEI C,0
	SOUT			;FINISH FILE SPEC
	MOVX A,GJ%OLD!GJ%DEL!GJ%SHT
	HRROI B,MALBUF
	GTJFN			;GRASP AT FILE
	 JRST [SKIPN LOGINF	;[3044] LOGGING IN?
               JRST MALCH2	;[3044] NO, HANDLE ERROR
	       RET]		;[3044] YES, JUST CONTINUE
	MOVEM A,POBJFN		;[3040] SAVE POBOX JFN
	HRRZ B,A		;[3040] GET JFN INTO AC2
	MOVE A,CSBUFP		;[3040]
	MOVX C,FLD(.JSAOF,JS%DIR) ;[3040] GET DIR (MAILBOX) NAME
	JFNS%			;[3040]
	 ERJMP [SKIPN LOGINF	;[3044] LOGGING IN?
               JRST CJERRE	;[3044] NO, GIVE ERROR
	       RET]		;[3044] YES, JUST CONTINUE
	MOVE P1,CSBUFP		;[3040] RETURN THIS POINTER
	MOVE A,POBJFN		;[3040] RESTORE AC1
	MOVEI Q1,(A)		;[3040] JFN TO Q1
	MOVE B,[15,,.FBCTL]	;GET SOME FDB INFO
	MOVEI C,.FBCTL+MALFDB	;POINT AT STG
	CALL $GTFDB		;GET IT
	 JRST MALCHP		;PROTECTED
	MOVX C,FB%DEL		;CHECK DELETED
	TDNN C,.FBCTL+MALFDB
	 SKIPG .FBSIZ+MALFDB	;EXISTS - HAVE CONTENTS?
	  JRST MALCHN		;EMPTY OR DELETED
	MOVE D,.FBWRT+MALFDB	;GET D/T LAST WRITE
	CAMG D,.FBREF+MALFDB	;COMPARE AGAINS LAST READ
	 JRST MALCHN		;NO NEW MAIL
	HRLI A,.GFLWR		;GET LAST WRITER STRING
	HRROI B,MALBUF		;POINT TO BUFFER
	SETZM MALBUF		;MAKE SURE WE HAVE A VALID ERROR STRING
	GFUST
	 ERJMP .+1
	HRROI B,MALBUF		;ASSUME LOCAL MAIL (-1,,MALBUF)
	SKIPA A,[POINT 7,MALBUF]
MALCKL:	JUMPE C,MALLCL		;LOCAL IF NO SPECIAL CHARS
	ILDB C,A		;FETCH CHAR IN NAME
	CAIE C," "		;IMBEDDED SPACE
	 CAIN C,"@"		;OR AT SIGN MEANS NET MAIL
	  SKIPA B,[POINT 7,MALBUF] ;RETURN 440700,,MALBUF
	   JRST MALCKL		;NO SPECIAL KEEP LOOKING
MALLCL:	MOVEI A,(Q1)		;JFN TO RELEASE
	RLJFN
	 JRST [SKIPN LOGINF	;[3044] LOGGING IN?
               CALL JERR	;[3044] NO, GIVE ERROR
	       RET]		;[3044] YES, JUST CONTINUE
	GTAD			;GET D/T NOW
	SUB A,D			;CHECK FOR GREATED THAN 1 DAY
	TLNN A,-1
	 TDZA C,C		;LESS - CLEAR XTR MSG
	  HRROI C,[ASCIZ "%4D "] ;GIVE DATE AS WELL AS
	HRROI A,[ASCIZ "from %2M at %3\%%4E%"] ;TIME
	RETSKP			;GOOD RETURN
;MALCHK CONTINUED....
;HERE ON GTJFN FAILURE FOR MAIL.TXT.1

MALCH2:	CAIN A,GJFX24		;FILE NOT FOUND
	 JRST MALCHN		;NO FILE RETURN
	CAIL A,GJFX16		;MORE NOT FOUND ERRORS
	 CAILE A,GJFX20
	  JRST MALCHP		;MUST BE PROTECTED
MALCHN:	TDZA A,A		;RETURN 0 IF NOT FOUND
MALCHP:	 SETO A,		; -1 IF PROTECTED (OR SOMETHING)
	JUMPL Q1,R		;HAVE JFN?
	EXCH A,Q1		;YES - RELEASE IT
	RLJFN
	 JRST [SKIPN LOGINF	;[3044] LOGGING IN?
               CALL JERR	;[3044] NO, GIVE ERROR
	       RET]		;[3044] YES, JUST CONTINUE
	MOVE A,Q1		;RESTORE VALUE
	RET			; AND RETURN

;INTERRUPT ROUTINE FOR IIT (TIMER)
;INTERRUPTS OCCUR EVERY MINUTE IF SET AUTO (MAIL-WATCH AND ALERTS) IS ON

IITPSI::PUSH P,40		;SAVE LUUO LOC
	PUSH P,P1		;TOP AC TO SAVE
	ADJSP P,7		;MAKE SOME STACK ROOM
	MOVSI P1,A		;SAVE REGS
	HRRI P1,-6(P)
	BLT P1,0(P)		;...
	SKIPE TYPING		;TYPEOUT IN PROGRESS?
	 JRST IITRET		;YES - EXIT NOW
	SETOM AUTOF		;NO - SAY WE ARE IN AUTO CHECK
	CALL MWATCH		;INVOKE WATCHERS
	CALL ALRCHK
	SKIPE IPCRCF		;ANY IPCF MESSAGES?
	 CALL IPCHEK		;YES - INFORM USER
IITRET:	MOVE A,[.FHSLF,,.TIMEL]	;ELAPSED TIME FOR SELF
	MOVEI B,^D60000		;1MIN FROM NOW
	MOVEI C,IITCHN		;PSI CHL
	TIMER			;ARM IT
	SETZM IITSET		;CLEAR FLAG
	MOVEI Q3,A		;RESTORE ACS
	HRLI Q3,-6(P)
	BLT Q3,Q3
	ADJSP P,-7
	POP P,P1
	POP P,40		;RESTORE LUUO
	DEBRK			;EXIT INT
;ROUTINE TO SUBTRACT TWO BYTE POINTERS
;CALL:	A/	BYTE POINTER 1
;	B/	BYTE POINTER 2
;RETURN:	+1
;		A/	1-2

SUBBP::	TLC A,-1
	TLCN A,-1
	HRLI A,440700		;IF LEFT HALF -1, IT'S NOW 440700
	TLC B,-1
	TLCN B,-1
	HRLI B,440700		;SAME FOR OTHER POINTER
	MOVEI C,1
	ADJBP C,B		;PUT SECOND POINTER INCREMENTED IN C
	IBP A			;NOW NEITHER POINTER IS "44XX00,,"
	MULI A,5		;MULTIPLY POINTER BY BYTES PER WORD
	SUBI B,-4(A)		;B HOLDS CHARACTER ADDRESS
	MULI C,5		;DO SAME TO OTHER POINTER
	SUBI D,-4(C)
	SUB B,D			;CALCULATE DIFFERENCE
	HRRE A,B		;RETURN ANSWER IN A.
	RET
;[7.1061][7.1083]
;Following are two routines to create a 128-bit bit-mask for remote printing
;characteristics.  "NBTMSK" takes numerical input and translates it to a bit
;number in the mask, then lights that bit.  "KBTMSK" takes keyword input, finds
;the already-existing bit-mask for that keyword, and lights the appropriate
;bit(s).

;The bit-mask which has the bits lit is actually 4 words in memory,
;BTMSK1-BTMSK4.  This makes things easier, as there routines are called from
;two places - the SRPC processing (EXECSE.MAC) and the PRINT command
;(EXECQU.MAC).  The bit mask is formatted into sixteen bytes to send
;to the Distributed Job Manager by the DQS LPTSPL.  The bytes are formatted
;in such a manner that it is easy to transmit them to the DJM by using a 
;8 bit PDP-10 byte pointer.  Since we are talking to a little ender machine
;(PDP-11 format) the bits within each byte are assigned from the "little end"
;(least significant bit) of the 8 bit byte.  Since the PDP-10 is a big ender
;machine (the intuitive way to do it after all) the bytes are packed in each
;word starting from the "big end" (most significant bit).
;
;The format of this bit mask is:
;
;	 0       7|8      15|16     23|24     31|32  35|
;       +---------+---------+---------+---------+------+
;Word 0	| byte 00 | byte 01 | byte 02 | byte 03 | 0000 |
;       +---------+---------+---------+---------+------+
;Word 1	| byte 04 | byte 05 | byte 06 | byte 07 | 0000 |
;       +---------+---------+---------+---------+------+
;Word 2	| byte 08 | byte 09 | byte 10 | byte 11 | 0000 |
;       +---------+---------+---------+---------+------+
;Word 3	| byte 12 | byte 13 | byte 14 | byte 15 | 0000 |
;       +---------+---------+---------+---------+------+
;
;Furthermore, within each byte, the bits are assigned from the right:
;
;       +-----------------+
;	| 7 6 5 4 3 2 1 0 |
;       +-----------------+
;
;So, how does this all apply to characteristics?  Each characteristic is
;numbered from 0 to 127, for a total of 128 bits.  The bits of the
;characteristic word are set from a table of 32 words with 1B7, 1B6, 1B5, 1B4,
;1B3, 1B2, 1B1, 1B0, 1B15, 1B14, 1B13, 1B12, 1B11, 1B10, 1B9, 1B8, 1B23, 1B22,
;oh well you get the idea.  The characterisic number is divided by 32 which
;results in the word offset and the remainder which is used to index into this
;table and load a bit mask to set.
;[7.1061]
;NBTMSK - translate a number to a bit; light that bit in a bit-mask
;
;A/ number (radix 10)
;
;	CALL NBTMSK
;
;RETURN +1 always, with bit lit in BTMSK*

NBTMSK::IDIVI A,^D32		;[7.1083] Bitmap word in A, BETTBL index in B
	MOVE C,BETTBL(B)	;[7.1083] Get the -11 format bit
	IORM C,BTMSK1(A)	;[7.1083] Light it
	RET			;[7.1083] Return

;[7.1083] Table of funny PDP-11 style bits

BETTBL:	ZZ==1B8			;[7.1083] Start with bit zero of the word
REPEAT 4,<			;[7.1083] For each of the four bytes
	REPEAT 8,<		;[7.1083] For each of the bits in a byte
		EXP <ZZ==ZZ_1>	;[7.1083] Make a bit and shift it left by one
	>			;[7.1083] End of per-byte REPEAT
	ZZ==ZZ_-^D16		;[7.1083] Done with a byte, get next one
>				;[7.1083] End of per-word REPEAT
;[7.1061]
;KBTMSK - translate a keyword to a bit-mask; light those bits in a bit-mask
;
;A/ address of already-existing keyword
;
;	CALL KBTMSK
;
;RETURN +1 always, with bit(s) lit in BTMSK* 
;

KBTMSK::HRRZ C,(A)		; Get address of bit-mask
	MOVE B,0(C)		;[7.1083] Load first word of bit-mask
	IORM B,BTMSK1		;[7.1083]  and set any bits in that word
	MOVE B,1(C)		;[7.1083] Get second word
	IORM B,BTMSK2		;[7.1083]  and set 'em there
	MOVE B,2(C)		;[7.1083] Load third word
        IORM B,BTMSK3		;[7.1083]  and copy the bits
	MOVE B,3(C)		;[7.1083] Load fourth word
        IORM B,BTMSK4		; Last word
        RET              	; Done
;[7.1061]
;THIS ROUTINE WILL CONVERT LOWERCASE ASCIZ INPUT TO UPPERCASE
;NOTE: THIS ROUTINE ASSUMES THAT THE STRING HAS "CORRECT" LETTERS.
;THAT IS, IT WILL STEP OVER ANYTHING THAT IS NOT ALPHABETIC, LEAVING IT
;ALONE. ALL NON-ALPHABETIC CHARACTERS WILL REMAIN AS THEY WERE.
;   
;THIS LOOPS THROUGH THE CHARACTERS, STOPPING ON NULL
;
;
;    CALL UPRCAS
;
;CALL WITH:
;
;	A/ BYTE POINTER TO STRING
;	
;
;RETURNS +1 ALWAYS, WITH  BYTE POINTER IN A
;
;
UPRCAS::STKVAR <WRDPTR>
	MOVEM A,WRDPTR		;Store the pointer to the input
UPRCS1: ILDB C,A         	;Get a character
	JUMPE C,UPDONE		;Done if null
	CAIN C,""		;Quoting character?
	IFNSK.
	  ILDB C,A 		;Yes, skip over it
          JRST UPRCS1		;And the next
	ENDIF.
	CAIL C,"A"		;Is this alphabet country?
	IFNSK.			
	  CAIG C,"Z"		;Uppercase already?
	  JRST UPRCS1		;Yes, so skip along
	  CAIGE C,"a"		;Lowercase ?
          JRST UPRCS1		;Funny character, skip it
	  CAILE C,"z"		;Lowercase?
	  JRST UPRCS1		;No. must be funny
          TRZ C,40		;Lowercase, change it to UPPER
          DPB C,A 		;Store it back
 	ENDIF.
	JRST UPRCS1
UPDONE: MOVE A,WRDPTR		;Point to beginning of input
	RET
	ENDSV.
;ROUTINE TO DO GFRKS JSYS TO GET FORK HANDLES ON ALL PROCESSES
;UNDER THIS EXEC.
; Note: After using the information returned by this routine, RELHAN
; should be called to release any unwanted fork handles.
;SKIPS IFF SUCCESSFUL

GFLEN==1000*<<BUFL-BUF0>B44+1>	;LENGTH OF BLOCK

DGFRKS::MOVEI A,.FHSLF		;SAY START AT SELF
	LDF B,GF%GFH+GF%GFS	;ASSIGN FORK HANDLES, GET STATUS
	MOVE C,[-GFLEN,,BUF0]	;WHERE TO PUT FORK STRUCTURE (BUF0-BUFL)
	GFRKS			;GET FORK STRUCTURE
	 RET			;FAILED
	RETSKP			;WIN
; [3063]
; RELHAN - Check all the handles and release non-inferiors
;
; This routine releases all the fork handles acquired by doing a
; GFRKS% JSYS. Routine DGFRKS does a GFRKS% JSYS to return the job's
; fork structure. GFRKS% acquires handles on all forks that the
; process doesn't already have a handle on. We need to release these
; newly acquired handles or the forks cannot be properly killed.
;
;   A/ Address of GFRKS% block
;	CALL RELHAN
; Returns:
;	+1: Always
;
; Preserves all ACs
;
RELHAN::SAVEAC <A>		;Preserve this AC
	MOVEI A,BUF0		;Address of GFRKS% block
	HRRZ A,(A)		;Get pointer to first inferior
	SKIPE A			;Any there?
	CALL STPHAN		;(A/)Yes. Step through all the handles
	RET			;Done
; [3063]
; STPHAN - Step through all handles and release them
;
; This recursive routine steps through the fork handle block starting
; at the address supplied in A. It releases the handles of all the
; forks that are not direct inferiors to this EXEC by calling routine
; RELHAN.
;
;  A/ Pointer into GFRKS% fork block
;	CALL STPHAN
; Returns:
;	+1: Always
;
; Uses AC A
;
STPHAN:	SAVEAC <B>		;Save B
	MOVEM A,B		;Remember the pointer supplied
	HRRZ A,1(B)		;Get handle of this fork
	CALL CHKHAN		;(A/)Release it if we should
	HRRZ A,(B)		;Get pointer to inferior
	SKIPE A			;Is there one?
	CALL STPHAN		;(A/)Yes. Release it and inferiors/siblings
	HLRZ A,(B)		;Get pointer to parallel fork
	SKIPE A			;Is there one?
	CALL STPHAN		;(A/)Yes. Release it and inferiors/siblings
	RET			;Done at this level
; [3063]
; CHKHAN - Release a fork handle if needed
;
; This routine releases the given fork handle if we don't need it.
; This determination is made by looking into the fork blocks pointed
; to by the FRKNMS table and determining if there is an entry for this
; fork. If there is, the handle is kept. If there isn't, it is
; released.
;
;  A/ Fork Handle
;	CALL CHKHAN
; Returns:
;	+1: Always
;
; Preserves all ACs
;
CHKHAN:	SAVEAC <A,B,C>		;Save ACs
	CAIN A,.FHSLF		;Ourself?
	RET			;Yes. Don't try to release the handle
	MOVE B,[XWD -NFRKS,FRKNMS+1] ;Set up AOBJN pointer
CHKHN1:	HRRZ C,(B)		;Get pointer to fork block
	JUMPE C,CHKHN2		;Don't check handle if no block
	CAMN A,C		;Is this is fork provided?
	RET			;Yes. Don't release the handle
CHKHN2:	AOBJN B,CHKHN1		;Loop through all blocks
	RFRKH%			;Don't have it, so release it
	 ERJMP .+1		;Don't worry. The handle is gone
	RET			;Done
;FOWNER FINDS THE OWNER OF A FORK.  THE "OWNER" IS DEFINED TO BE THE  DIRECT
;INFERIOR OF OURSELF THAT IS AN ANCESTOR OF THE FORK WHOSE OWNER IS
;SOUGHT.  (OUR DIRECT INFERIORS ARE THEIR OWN OWNERS.)
; Note: After using the information returned by this routine, RELHAN
; should be called to release any unwanted fork handles.
;
;ACCEPTS:	A/	FORK HANDLE OF FORK WHOSE OWNER IS SOUGHT
;
;RETURNS:	A/	OWNER

FOWNER::STKVAR <FLOST,FBEST>
	MOVEM A,FLOST		;REMEMBER "LOST" FORK WHOSE OWNER IS BEING SOUGHT
	CALL DGFRKS		;GET THE FORK TREE
	 CALL JERRE		;SHOULDN'T FAIL
	MOVSI A,-<GFLEN/3>	;FIND LOST FORK AS STARTING POINT FOR SCAN
	MOVEI B,BUF0		;ADDRESS OF NEXT TRIPLET TO CONSIDER
FOW1:	HRRZ C,1(B)		;GET FORK REPRESENTED BY CURRENT TRIPLET
	CAMN C,FLOST		;IS THIS THE STARTING POINT YET?
	JRST FOW2		;YES
	ADDI B,3		;NO, STEP TO NEXT TRIPLET
	AOBJN A,FOW1		;LOOP OVER ENTIRE TABLE
	CALL SCREWUP		;NO OWNER OF THIS FORK (SHOULDN'T HAPPEN!)
FOW2:	MOVEM C,FBEST		;SAVE LATEST SUSPECT OF OWNER
	HLRZ B,1(B)		;GET ADDRESS OF TRIPLET CONTAINING SUPERIOR
	HRRZ C,1(B)		;GET FORK HANDLE OF SUPERIOR
	CAIE C,.FHSLF		;HAVE WE TRACED BACK TO OURSELF YET?
	JRST FOW2		;NO, LOOP
	MOVE A,FBEST		;YES, SO WE KNOW WHO OWNER IS NOW
	RET
;ROUTINE TO REWIND MAGTAPE.  GIVE IT JFN IN A
;THIS ROUTINE LEAVES THE TAPE OPEN OR NOT DEPENDING ON WHETHER JFN WAS
;OPEN TO START WITH

REWIND::GTSTS			;SEE IF JFN IS OPEN
	TXNN B,GS%OPN		;OPEN?
	JRST [	MOVX B,OF%RD	;NO, OPEN FOR READING
		CALL OPNMAG	;OPEN THE TAPE
		CALL REWIND	;REWIND THE TAPE
		TXO A,CO%NRJ
		CLOSF		;CLOSE FILE BUT DON'T RELEASE JFN
		 NOP		;IGNORE FAILURE
		RET]
	MOVEI B,.MOREW		;SAY "REWIND"
	MTOPR			;DO IT
	 ERCAL CJERRE		;IF FAILS, SAY WHY AND DIE
	RET

;ROUTINE TO OPEN MAG TAPE
;ACCEPTS:	A/	JFN
;		B/	BITS FOR OPENF

OPNMAG::STKVAR <MJFN,OBITS>
	MOVEM B,OBITS		;REMEMBER OPENF BITS
	MOVEM A,MJFN		;REMEMBER JFN
OPN1:	OPENF			;TRY TO OPEN
	 JRST [	CAIE A,OPNX9	;INVALID SIMULTANEOUS ACCESS?
		CALL CJERR	;NO, I CAN'T HANDLE THIS ONE
		MOVE A,MJFN	;GET JFN
		DVCHR		;TRANSLATE TO DEVICE DESIGNATOR
		CALL CJDEV	;TRY TO FIND ANOTHER OPEN JFN
		 JRST [	MOVEI A,OPNX9 ;NONE
			CALL CJERR] ;SO HANG IT UP
		MOVE A,MJFN	;RESTORE JFN
		MOVE B,OBITS	;RESTORE OPENF BITS
		JRST OPN1]	;GO TRY AGAIN
	RET


MSKLB:	1B9+1B10+1B13		;TAB AND CR/LF ARE BREAK MASK
	1B0			;SPACE IS BREAK MASK
	0
	0

LATMSK: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_-.>) ;[4402]


;BITS+N CONTAINS A WORD WITH A 1 IN BIT N

XX==0
BITS::	REPEAT ^D36,<EXP 1B<XX>
		XX=XX+1>

XEND==:.	;MUST BE LAST LOCATION OF EXEC!

	END