Google
 

Trailing-Edge - PDP-10 Archives - BB-M781B-SM - exec/execsu.mac
There are 47 other files named execsu.mac in the archive. Click here to see a list.
; UPD ID= 59, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.10,   2-Jun-82 13:47:29 by KROSENBLUH
;Edit 737 - in ctrl/t, if program name = EXEC, try to get
;last-run program name
; UPD ID= 57, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.4,   1-Jun-82 14:01:48 by KROSENBLUH
;EDIT 736 - More of edit 735
; UPD ID= 51, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.3,  17-May-82 17:57:23 by KROSENBLUH
;Edit 735 - When ETYPE <%X> is called from "INFO PROG", don't print "?" in
;first column.
; UPD ID= 49, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.3,  12-May-82 15:38:12 by KROSENBLUH
;Edit 734 - Use GETNM to get running fork's name, instead of table lookup
; UPD ID= 32, FARK:<4-1-WORKING-SOURCES.EXEC>EXECSU.MAC.4,  29-Apr-82 13:24:25 by KROSENBLUH
;REINSERT EDIT 589		[726]
; UPD ID= 25, FARK:<4-1-WORKING-SOURCES.EXEC>EXECSU.MAC.3,   8-Apr-82 11:48:39 by GROUT
;Edit 723 - Check correctly at GETLPC for waiting interrupt levels
; UPD ID= 22, FARK:<4-1-WORKING-SOURCES.EXEC>EXECSU.MAC.2,   6-Apr-82 16:45:50 by KROSENBLUH
;SAVE AC .FP DURING SUBCOMMAND PROCESSING FOR USE IN ERROR RECOVERY [722]
; UPD ID= 127, SNARK:<5.EXEC>EXECSU.MAC.27,  28-Dec-81 11:19:00 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 96, SNARK:<5.EXEC>EXECSU.MAC.24,  21-Oct-81 13:41:08 by GROUT
;TCO 5.1578 ADD CMDINI AFTER EOFJER DETECTS TEXTI EOF
; UPD ID= 72, SNARK:<5.EXEC>EXECSU.MAC.22,  21-Sep-81 09:07:57 by CHALL
;TCO 5.1518 CIOER1- DON'T OUTPUT MESSAGE ON ^C OF PCL COMMAND
; UPD ID= 69, SNARK:<5.EXEC>EXECSU.MAC.19,  11-Sep-81 09:02:58 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= 64, SNARK:<5.EXEC>EXECSU.MAC.15,   9-Sep-81 09:44:56 by CHALL
;TCO 5.1493 USEX- ON ^T MAKE SURE THERE'S A SPACE AFTER THE TIME
; UPD ID= 47, SNARK:<5.EXEC>EXECSU.MAC.12,  19-Aug-81 10:40:25 by CHALL
;TCO 5.1466 REPARS- CLEAR PCLDCO (ORIGINAL COMMAND FLAG) ON COMMAND REPARSE
; UPD ID= 30, SNARK:<5.EXEC>EXECSU.MAC.11,  14-Aug-81 18:35:19 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= 12, SNARK:<5.EXEC>EXECSU.MAC.9,  14-Jul-81 15:49:24 by MURPHY
;DITTO
; UPD ID= 9, SNARK:<5.EXEC>EXECSU.MAC.8,  13-Jul-81 17:41:20 by MURPHY
;TCO 5.1410 - MACHINE SIZE EXCEEDED, OVER QUOTA, ETC.
; UPD ID= 2, SNARK:<5.EXEC>EXECSU.MAC.7,   9-Jul-81 13:49:08 by GROUT
;TCO 5.1404 - PUT PIOFF/PION PAIR AROUND GETMEM/RETMEM FREE LIST MANIPULATION
; UPD ID= 2282, SNARK:<5.EXEC>EXECSU.MAC.5,   1-Jul-81 16:30:56 by CHALL
;TCO 5.1391 CIOREL- PCMPOS SHOULD BE CALLED BEFORE FIXIO
; UPD ID= 1963, SNARK:<5.EXEC>EXECSU.MAC.4,   8-May-81 10:03:14 by SCHMITT
;TCO 5.1309 - Make DWNPNT understand DWNTIM of -1 for system shutdown
; 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
;
;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
;<4.EXEC>EXECSU.MAC.365, 24-Oct-79 15:41:45, EDIT BY TOMCZAK
;TCO# 4.2545 - Change PECHOF/ECHOF flag test at ECHCMD
;<4.EXEC>EXECSU.MAC.364, 22-Oct-79 11:26:00, EDIT BY OSMAN
;CHANGE JFNSIL
;<4.EXEC>EXECSU.MAC.363, 20-Oct-79 15:13:44, EDIT BY R.ACE
;In message "[MOUNT request remaining in queue]" change MOUNT to Mount
;<4.EXEC>EXECSU.MAC.361,  9-Oct-79 09:49:05, EDIT BY OSMAN
;CHANGE $XXX SYMBOLS TO XXX$ TO AVOID CONFLICT WITH MACRO NAMES
;<4.EXEC>EXECSU.MAC.360,  8-Oct-79 15:50:57, EDIT BY OSMAN
;tco 4.2519 - Make ^T output go to .PRIOU
;<4.EXEC>EXECSU.MAC.359,  4-Oct-79 10:41:47, EDIT BY OSMAN
;tco 4.2510 - Fix EOF interrupt
;<4.EXEC>EXECSU.MAC.358, 28-Sep-79 13:59:31, EDIT BY OSMAN
;EXPAND BCOUNT TO GIVE CHARACTER COUNT
;<4.EXEC>EXECSU.MAC.356, 26-Sep-79 14:50:12, Edit by HESS
; Fix mail watch typeout for user other than self (XTND only)
;<4.EXEC>EXECSU.MAC.355, 20-Sep-79 13:53:30, EDIT BY OSMAN
;INSTEAD OF RJFN, JUST REPLACE THE ENTRY
;<OSMAN>EXECSU.MAC.1, 19-Sep-79 11:58:54, EDIT BY OSMAN
;MORE CLZFFF STUFF, CALL RJFN IN CFNE1 TO GET RID OF SCRATCH JFN
;<4.EXEC>EXECSU.MAC.352, 18-Sep-79 12:33:23, EDIT BY TOMCZAK
;Get rid of CFN1 since it isn't unique from SPECFN anymore
;<4.EXEC>EXECSU.MAC.351, 17-Sep-79 16:32:54, EDIT BY OSMAN
;tco 4.2472 - prevent "?JFN is not assigned" on "TAKE FOO NUL:"
;<4.EXEC>EXECSU.MAC.350, 17-Sep-79 10:37:56, EDIT BY OSMAN
;ADD BITS
;<4.EXEC>EXECSU.MAC.349, 14-Sep-79 08:52:27, EDIT BY OSMAN
;Call JFNSTK in FIELD instead of after CFN2
;<4.EXEC>EXECSU.MAC.346, 12-Sep-79 14:01:43, EDIT BY OSMAN
;HAVE ONLY ONE ERSTR, SO CLZFFF CAN BE HANDLED
;<4.EXEC>EXECSU.MAC.345, 12-Sep-79 11:14:30, EDIT BY OSMAN
;DON'T SOS CLZFFF IN JFNSTK IF JFN IS REALLY A FORK
;<4.EXEC>EXECSU.MAC.344, 12-Sep-79 11:04:11, EDIT BY OSMAN
;tco 4.2459 - Allow ^C out of magtape commands
;CHANGE CLZF TO CLZFFF, USE CLZFFF INSTEAD OF PIOFF IN GTJFS
;Use %3? instead of ERSTR at ERR5C
;Use %? in RJWARN
;<4.EXEC>EXECSU.MAC.341,  6-Sep-79 15:10:23, EDIT BY OSMAN
;tco 4.2448 - Print filespec and EOT info on data error
;<4.EXEC>EXECSU.MAC.339,  5-Sep-79 10:56:12, EDIT BY OSMAN
;TCO 4.2440 - Add DOGET
;<4.EXEC>EXECSU.MAC.338,  4-Sep-79 14:36:07, Edit by HESS
; Add call to IPCHEK to IITPSI (XTND)
;<4.EXEC>EXECSU.MAC.337,  4-Sep-79 14:17:35, Edit by HESS
; Don't do Auto Mail Watch if under batch (XTND only)
;<4.EXEC>EXECSU.MAC.336,  4-Sep-79 11:56:00, EDIT BY OSMAN
;MAKE GETMEM BE GLOBAL
;<4.EXEC>EXECSU.MAC.334, 31-Aug-79 13:07:25, EDIT BY OSMAN
;tco 4.2433 - Make SETM be SETZM
;<4.EXEC>EXECSU.MAC.332, 28-Aug-79 15:27:12, EDIT BY OSMAN
;TCO 4.2427 - ADD MFINP0
;<4.EXEC>EXECSU.MAC.331, 28-Aug-79 14:36:26, EDIT BY OSMAN
;MAKE GNFIL RETURN GNJFN FLAGS IN LEFT HALF OF A, SO DELETE KNOWS WHEN DIR CHANGES
;<HESS.E>EXECSU.MAC.17, 21-Aug-79 13:30:36, Edit by HESS
; Add extended features
;<4.EXEC>EXECSU.MAC.329, 15-Aug-79 11:08:30, EDIT BY OSMAN
;tco 4.2399 - If ECHO is on for TAKE, be sure to echo the erroneous commands!
;<4.EXEC>EXECSU.MAC.325, 10-Aug-79 15:15:14, EDIT BY OSMAN
;ADD TYPFLS
;<4.EXEC>EXECSU.MAC.323,  2-Aug-79 16:53:00, EDIT BY DNEFF
;TCO 4.2370 - Fix illegal instruction traps from 777777.
;<4.EXEC>EXECSU.MAC.322, 17-Jul-79 11:11:20, EDIT BY OSMAN
;tco 4.2332 - Fix /AFTER:SATURDAY on SUNDAY, AND @@SINCE ... on DIR command
;<4.EXEC>EXECSU.MAC.321, 16-Jul-79 09:06:34, EDIT BY OSMAN
;REMOVE %ERSTR, USE %? FOR $ERSTR
;<4.EXEC>EXECSU.MAC.319, 13-Jul-79 15:44:06, EDIT BY OSMAN
;tco 4.2327 - Make RELDIR
;<4.EXEC>EXECSU.MAC.318, 13-Jul-79 14:49:13, EDIT BY OSMAN
;tco 4.2326 - Prevent ILL MEM WR on INFO DIR PS:[*] when enabled.
;<4.EXEC>EXECSU.MAC.315, 29-Jun-79 14:08:42, EDIT BY OSMAN
;FIX ICLEAR TO NOT EVER LOSE IPCF OF ^T INTERRUPTS
;<4.EXEC>EXECSU.MAC.314,  7-Jun-79 09:01:37, EDIT BY EKLUND
;tco 4.2276 - CHANGE ERROR MESSAGE TO INCLUDE "ILLEGAL CHARACTER IN COMMAND"
;<4.EXEC>EXECSU.MAC.313,  6-Jun-79 12:58:35, EDIT BY HELLIWELL
;CHANGE ATMBFR TO ATMBUF
;<4.EXEC>EXECSU.MAC.312,  6-Jun-79 09:59:36, EDIT BY OSMAN
;tco 4.2274 - Don't leave jfn's around on ^C
;<4.EXEC>EXECSU.MAC.311,  4-Jun-79 10:36:59, EDIT BY OSMAN
;tco 4.2270 - use CLZF to decide whether to do CLZFF on ^C
;<4.EXEC>EXECSU.MAC.309, 16-May-79 16:09:00, EDIT BY OSMAN
;TRY TO ENABLE ^C IN LTTYMD BEFORE DOING STIW
;<4.EXEC>EXECSU.MAC.308, 15-May-79 09:05:29, EDIT BY OSMAN
;BETTER CALL LTTYMD ON ^C FROM PROG, PROG MAY HAVE DIDDLED TTY STATE.
;<4.EXEC>EXECSU.MAC.307,  4-May-79 15:30:20, EDIT BY OSMAN
;REMOVE EXTRA SFMOD AT ERR1 (ALREADY DONE AT ERFRS1 TO TURN OFF ^O)
;<4.EXEC>EXECSU.MAC.306,  2-May-79 17:00:39, EDIT BY OSMAN
;FIX RLJFNS TO HANDLE RESTRICTED JFNS BETTER
;<4.EXEC>EXECSU.MAC.304,  2-May-79 15:08:50, EDIT BY OSMAN
;FIX ICLEAR TO DO LESS WORK
;<4.EXEC>EXECSU.MAC.302,  1-May-79 11:27:11, EDIT BY OSMAN
;GTJFN => CALL GTJFS, SO ^C DOESN'T LEAVE JFN AROUND
;<4.EXEC>EXECSU.MAC.301,  1-May-79 11:12:01, EDIT BY OSMAN
;REMOVE CLZFF AT RERET (FOR EFFICIENCY.  IF WANTED, FLAG SHOULD BE DESIGNED
;TO SHOW WHETHER IT'S NEEDED)
;<4.EXEC>EXECSU.MAC.300, 30-Apr-79 15:02:07, EDIT BY OSMAN
;MAKE DOECHO CHECK NECHOF, TO AVOID UNNECESSARY JSYS'S
;<4.EXEC>EXECSU.MAC.299, 30-Apr-79 14:55:02, EDIT BY OSMAN
;DON'T CALL LTTYMD ON ^C, COMND WILL FIX THINGS UP
;<4.EXEC>EXECSU.MAC.298, 26-Apr-79 11:42:44, EDIT BY OSMAN
;ADD .FIJFN
;<4.EXEC>EXECSU.MAC.295, 18-Apr-79 13:57:10, EDIT BY OSMAN
;ADD GTBUFX
;<4.EXEC>EXECSU.MAC.293, 18-Apr-79 09:55:10, EDIT BY OSMAN
;ADD RETBUF
;<4.EXEC>EXECSU.MAC.291, 12-Apr-79 10:44:33, EDIT BY OSMAN
;FIX OPNMAG
;<4.EXEC>EXECSU.MAC.290,  6-Apr-79 10:05:01, EDIT BY OSMAN
;ADD %@ (%LM) TO GET TO LEFT MARGIN
;<4.EXEC>EXECSU.MAC.288,  2-Apr-79 12:58:19, EDIT BY OSMAN
;REMOVE OPLEAS STUFF
;<4.EXEC>EXECSU.MAC.284, 28-Mar-79 15:10:52, EDIT BY OSMAN
;CHECK MPENDF IN ^C AND WARN THAT MOUNT STILL PENDING
;<4.EXEC>EXECSU.MAC.283, 27-Mar-79 17:12:49, EDIT BY OSMAN
;tco 4.2223 - don't say "device is not a terminal" when better error exists
;<4.EXEC>EXECSU.MAC.282, 22-Mar-79 10:12:29, EDIT BY OSMAN
;BE MORE EXPLICIT ON INTERNAL ILLEGAL INSTRUCTIN TRAPS
;<4.EXEC>EXECSU.MAC.280, 15-Mar-79 16:21:58, EDIT BY OSMAN
;USE FI%ERR INSTEAD OF -2 FOR FILESPEC ERRORS.  ALSO, .FIERR, .FISTR
;<4.EXEC>EXECSU.MAC.279, 15-Mar-79 14:30:59, EDIT BY OSMAN
;ADD OPNMAG
;<4.EXEC>EXECSU.MAC.275, 14-Mar-79 13:56:27, EDIT BY OSMAN
;ADD $DTP TO READ DATE AND TIME IN PAST (LIKE FOR SINCE SUBCOMMAND OF DIR)
;<4.EXEC>EXECSU.MAC.274, 13-Mar-79 15:54:33, EDIT BY OSMAN
;ADD REWIND ROUTINE
;<4.EXEC>EXECSU.MAC.273, 12-Mar-79 18:06:40, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;UNBREAK RLJFNS (CHECK FOR GS%NAM)
;<4.EXEC>EXECSU.MAC.271, 12-Mar-79 09:58:58, EDIT BY OSMAN
;ADD LM
;<4.EXEC>EXECSU.MAC.270,  9-Mar-79 16:45:02, EDIT BY OSMAN
;don't ever "fail" in RJFN, since it is in error recovery loop!
;<4.EXEC>EXECSU.MAC.269,  9-Mar-79 10:37:36, EDIT BY OSMAN
;MAKE %B ALLOW SPECIFIC TIME
;<4.EXEC>EXECSU.MAC.267,  7-Mar-79 13:32:19, EDIT BY OSMAN
;FIX GLOADS
;REMOVE A BILLION EDIT HEADERS
;<4.EXEC>EXECSU.MAC.260,  2-Mar-79 15:48:18, EDIT BY OSMAN
;handle TIMER errors better
;<4.EXEC>EXECSU.MAC.258,  2-Mar-79 14:41:22, EDIT BY OSMAN
;ADD GLOADS; PRINT LOAD AVERAGE ON ^T
;<4.EXEC>EXECSU.MAC.257,  1-Mar-79 17:02:27, EDIT BY OSMAN
;CALL RJFNER INSTEAD OF JERR IN RJFNS2 TO PREVENT "?JFN IS NOT ASSIGNED"
;<4.EXEC>EXECSU.MAC.256,  1-Mar-79 09:31:15, EDIT BY OSMAN
;CHANGE %EOL AND SNDEOL TO BE MORE EFFICIENT (SOUT INSTEAD OF BOUT BOUT)
;<4.EXEC>EXECSU.MAC.254, 28-Feb-79 15:14:05, EDIT BY OSMAN
;put floating nums back to the old way (*sigh*)
;REMOVE CTYPE, %TYPE
;<4.EXEC>EXECSU.MAC.250, 27-Feb-79 16:52:13, EDIT BY OSMAN
;SPEED UP EXEC BY NOT DOING BOUTS IN ETYPE AND TYPE.  DO SOUT INSTEAD
;REMOVE ATSVAR
;<4.EXEC>EXECSU.MAC.249, 27-Feb-79 15:54:49, EDIT BY OSMAN
;GET RID OF CCHRO
;<4.EXEC>EXECSU.MAC.248, 27-Feb-79 11:38:09, EDIT BY OSMAN
;change %Q to not put out any leading spaces on floating pt nums
;<4.EXEC>EXECSU.MAC.246, 27-Feb-79 10:12:36, EDIT BY OSMAN
;ADD CLSON
;<4.EXEC>EXECSU.MAC.245, 27-Feb-79 09:38:55, EDIT BY OSMAN
;<4.EXEC>EXECSU.MAC.244, 27-Feb-79 09:37:25, EDIT BY OSMAN
;<4.EXEC>EXECSU.MAC.243, 20-Feb-79 16:18:50, EDIT BY OSMAN
;MAKE ^T OUTPUT ALWAYS GO TO COJFN EVEN IF OUTPUT DIVERTED TO A BUFFER
;<4.EXEC>EXECSU.MAC.240, 19-Feb-79 14:31:25, EDIT BY OSMAN
;IF AT COMMAND LEVEL, ALLOW MOUNT RECEIPTS TO BE ANNOUNCED
;<4.EXEC>EXECSU.MAC.239, 15-Feb-79 16:42:56, EDIT BY HEMPHILL
;TCO 4.2190 -- FIX MFOUT TO USE *.* AS DEFAULT IF ONLY ONE INPUT FILESPEC
;HAD BEEN SPECIFIED, AND THAT FILE DIDN'T EXIST
;<4.EXEC>EXECSU.MAC.236, 13-Feb-79 17:54:30, EDIT BY OSMAN
;HANDLE QUASAR DISAPPEARING MORE GRACEFULLY (SEE SPTBL)
;<4.EXEC>EXECSU.MAC.235, 13-Feb-79 15:15:55, EDIT BY OSMAN
;CHANGE MFBUF SIZE FROM EXTSIZ TO FILWDS AT MFSET
;<4.EXEC>EXECSU.MAC.234,  7-Feb-79 10:35:38, EDIT BY OSMAN
;change GETNOD to give an error return if fails
;<4.EXEC>EXECSU.MAC.232,  1-Feb-79 18:58:09, EDIT BY ACARLSON
;DELETE GQSRPD TO APPEASE BIG WIGS (CODE FREEZE)
;<4.EXEC>EXECSU.MAC.230,  1-Feb-79 17:19:50, EDIT BY OSMAN
;ADD IPCHEK
;<4.EXEC>EXECSU.MAC.229,  1-Feb-79 17:07:50, EDIT BY OSMAN
;MAKE IPCOFF/IPCON NESTABLE.  HANDLE MESSAGE OVERFLOW BETTER
;<4.EXEC>EXECSU.MAC.228, 31-Jan-79 20:29:54, EDIT BY ACARLSON
;ADD GQSRPD TO REQUEST A PRIVATE QUASAR'S PID FROM SYSTEM INFO
;<4.EXEC>EXECSU.MAC.226, 31-Jan-79 14:29:54, EDIT BY OSMAN
;DON'T FLJFNS AT ERRF1.  DO IT AT SUBCOMMAND ERROR INSTEAD (SBCOM1)
;<4.EXEC>EXECSU.MAC.225, 30-Jan-79 14:08:59, EDIT BY OSMAN
;CHECK FOR DESX3 IN RJFNER
;<4.EXEC>EXECSU.MAC.224, 29-Jan-79 09:17:02, EDIT BY OSMAN
;ADD REFERENCE TO CF%NS
;<4.EXEC>EXECSU.MAC.223, 26-Jan-79 14:30:54, EDIT BY OSMAN
;ADD $RNODE AND $FNODE
;<4.EXEC>EXECSU.MAC.221, 25-Jan-79 13:24:47, EDIT BY OSMAN
;ADD FIXIO, UPDATE COJFN IN TOCT, CALL FIXIO IN ERFRS1
;<4.EXEC>EXECSU.MAC.219, 24-Jan-79 13:59:47, EDIT BY OSMAN
;DON'T CALL UNMAP UNTIL RERET.  DON'T CALL UNMAP IN REPARS.
;THIS IS NECESSARY SO THAT TYPING ERRORS DURING SUBCOMMAND MODE
;DOESN'T CAUSE SAVED STRINGS FOR CURRENT COMMAND TO BE LOST!
;<4.EXEC>EXECSU.MAC.218, 23-Jan-79 10:41:29, EDIT BY OSMAN
;CHANGE SUBCOMMANDS, SEE "SUBCOM" IN EXECDE
;<4.UTILITIES>EXECSU.MAC.1, 22-Jan-79 14:12:02, EDIT BY OSMAN
;MAKE SURE PIOFF AND PION PRESERVE AC'S
;<4.EXEC>EXECSU.MAC.214, 18-Jan-79 14:11:32, EDIT BY OSMAN
;add STREM
;<4.EXEC>EXECSU.MAC.213, 18-Jan-79 11:35:13, EDIT BY OSMAN
;MAKE PION/PIOFF NESTABLE
;<4.EXEC>EXECSU.MAC.212, 15-Jan-79 02:43:34, EDIT BY HEMPHILL
;MODIFY SUBROUTINES TO HANDLE USER EXTENDED ADDRESSING PROPERLY
;<4.EXEC>EXECSU.MAC.209, 13-Jan-79 16:09:04, EDIT BY OSMAN
;ADD XBUFFS, XFRINI
;<4.EXEC>EXECSU.MAC.208, 12-Jan-79 17:37:25, EDIT BY OSMAN
;REMOVE REFS TO RUNFK
;<4.EXEC>EXECSU.MAC.207, 12-Jan-79 17:08:35, EDIT BY OSMAN
;tco 4.2159 - single line error messages, no more lone "?"
;<4.EXEC>EXECSU.MAC.206, 10-Jan-79 18:32:29, EDIT BY HURLEY.CALVIN
; PRITXT - change QUASAR ack text offset from .MSDAT to .OHDRS+ARG.DA
;<4.EXEC>EXECSU.MAC.205,  5-Jan-79 10:36:30, EDIT BY OSMAN
;put FREINI here, and call it from UNMAP
;<4.EXEC>EXECSU.MAC.204,  4-Jan-79 10:21:41, EDIT BY OSMAN
;FIX UNMAP TO DELETE FREE SPACE
;<4.EXEC>EXECSU.MAC.203, 20-Dec-78 10:33:22, EDIT BY OSMAN
;make /after:thursday really mean "after Thursday"!!
;<4.EXEC>EXECSU.MAC.201, 18-Dec-78 16:49:25, EDIT BY OSMAN
;ADD GETNOD
;<4.EXEC>EXECSU.MAC.200,  7-Dec-78 11:25:19, EDIT BY OSMAN
;MAKE GETAMT GLOBAL, AND MAKE IT RETURN SECONDS IN B (INTERNAL IN A)
;<4.EXEC>EXECSU.MAC.198,  6-Dec-89 10:43:50, EDIT BY OSMAN
;tco 4.2110 - Fix recovery from bad confirmation of KILL subcommand
;<4.EXEC>EXECSU.MAC.196,  5-Dec-78 11:49:11, EDIT BY R.ACE
;ADD ATSAVR - DRIVER FOR ATSAVE MACRO
;<4.EXEC>EXECSU.MAC.195,  1-Dec-78 10:48:44, EDIT BY KIRSCHEN
;ADD SET [NO] DEFAULT TAKE
;<4.EXEC>EXECSU.MAC.194, 29-Nov-78 14:52:12, EDIT BY KIRSCHEN
;TURN OFF TAKE ECHOING AT CCHEOF NOT EOFPSI
;<4.EXEC>EXECSU.MAC.192, 22-Nov-78 15:33:46, EDIT BY KIRSCHEN
;TURN OFF PER-TAKE-COMMAND ECHOING AT EOFPSI
;<4.EXEC>EXECSU.MAC.191, 10-Nov-78 14:10:58, EDIT BY OSMAN
;CHANGE /AFTER:TOMORROW TO /AFTER:TODAY (LIKE THE SPEC SAYS! AND LIKE TOPS10 DOES!)
;<4.EXEC>EXECSU.MAC.188,  7-Nov-78 14:34:31, EDIT BY OSMAN
;tco 4.2082 - REMOVE PUSH'S AT ERRFIN BEFORE CALL UNMAP, AND POP'S AFTER CALL UNMAP.
;1) WHY ARE THEY NEEDED, 2) THERE WAS ONE MORE POP THAN PUSH ANYWAY!
;3) they cause an infinite loop if TIMER fails at CMDIN4+40
;<4.EXEC>EXECSU.MAC.187,  1-Nov-78 15:13:44, EDIT BY OSMAN
;DETECT CHANGE OF SYSTEM PIDS, AND UPDATE EXEC'S COPY AS NEED BE
;<4.EXEC>EXECSU.MAC.186, 31-Oct-78 16:45:09, EDIT BY OSMAN
;ADD GETSXB
;<4.EXEC>EXECSU.MAC.185, 30-Oct-78 14:39:10, EDIT BY OSMAN
;MAKE GETSIX RECOGNIZE QUOTED CHARACTERS
;<4.EXEC>EXECSU.MAC.184, 27-Oct-78 18:22:22, EDIT BY OSMAN
;MAKE GETDIR, GETDRP RETURN POINTER TO ACCOUNT
;<4.EXEC>EXECSU.MAC.183, 27-Oct-78 12:12:15, EDIT BY OSMAN
;MAKE DIRINI ALLOCATE AND INITIALIZE SUBBLOCKS
;<4.EXEC>EXECSU.MAC.181, 26-Oct-78 14:37:19, EDIT BY OSMAN
;tco 4.2068 - Call DOECHO in REPARS
;<CALVIN>EXECSU.MAC.1,  9-Aug-78 12:56:14, EDIT BY CALVIN
; Install function routine for d&t or interval in days (DTIV)
;<3-ARC-EXEC>EXECSU.MAC.4,  4-Aug-78 10:22:05, EDIT BY CALVIN
; bugfixes from BBN's release 3 exec
;<3-ARC-EXEC>EXECSU.MAC.3, 14-May-78 18:34:50, Edit by MTRAVERS
;<3-ARC-EXEC>EXECSU.MAC.2, 14-May-78 17:20:51, Edit by MTRAVERS
;<3-ARC-EXEC>EXECSU.MAC.1, 14-May-78 17:04:27, Edit by MTRAVERS
; Added IGINV flag in SPECFN.
;<4.EXEC>EXECSU.MAC.173, 20-Oct-78 19:31:20, EDIT BY OSMAN
;MAKE IPCRCV/IPCFND RETURN MESSAGES IN THE ORDER THEY WERE SENT
;<4.EXEC>EXECSU.MAC.167, 16-Oct-78 13:32:57, EDIT BY OSMAN
;CLEAR IPCCTL IN ICLEAR, SO THAT ^C OUT OF IPCF WAIT WORKS
;<4.EXEC>EXECSU.MAC.166, 10-Oct-78 15:45:54, EDIT BY OSMAN
;tco 4.2039 - Make "TYPE A,B" name each file before typing it (worked in r2!)
;<4.EXEC>EXECSU.MAC.164,  8-Oct-78 20:14:20, EDIT BY OSMAN
;REMOVE PTY CHECK IN MWATCH ROUTINE
;CHANGE CIS'S TO CALL ICLEAR'S
;<4.EXEC>EXECSU.MAC.157,  8-Oct-78 17:28:00, EDIT BY OSMAN
;ADD %\  (SEE %CHAR)
;<4.EXEC>EXECSU.MAC.156,  8-Oct-78 14:54:55, EDIT BY OSMAN
;FLUSH NERET, CHANGE REFS TO RERET, SINCE THAT'S ALL NERET EVER HAD IN IT!
;<4.EXEC>EXECSU.MAC.155,  7-Oct-78 00:45:11, EDIT BY OSMAN
;add DGETER
;<4.EXEC>EXECSU.MAC.124, 28-Sep-78 16:43:08, EDIT BY OSMAN
;PUT IN STUFF FOR GETTING INTERRUPT ON IPCF MESSAGE
;<4.EXEC>EXECSU.MAC.123, 28-Sep-78 14:27:33, EDIT BY OSMAN
;REMOVE ALL Bn SYMBOLS
;<4.EXEC>EXECSU.MAC.115, 26-Sep-78 13:28:16, EDIT BY OSMAN
;TURN ON CM%WKF IF NOT LOGGED IN
;<4.EXEC>EXECSU.MAC.114, 22-Sep-78 16:56:24, EDIT BY OSMAN
;ADD GETASC
;<4.EXEC>EXECSU.MAC.110, 18-Sep-78 17:01:29, EDIT BY OSMAN
;MAKE BCOUNT BE GLOBAL
;TCO 4.2010 - FIX ERROR MESSAGE ON "DIR A,B,C,D" IF C DOESN'T EXIST
;<4.EXEC>EXECSU.MAC.92, 15-Sep-78 15:30:13, EDIT BY OSMAN
;USE STANDARD FREE-SPACE MANAGEMENT FOR MANIPULATING STRINGS
;<4.EXEC>EXECSU.MAC.90, 14-Sep-78 14:10:59, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECSU.MAC.89, 14-Sep-78 11:17:28, EDIT BY OSMAN
;ADD QUASAR ROUTINES QUASND, QCLEAN
;<4.EXEC>EXECSU.MAC.88, 12-Sep-78 15:15:18, EDIT BY OSMAN
;REMOVE WAKE AND NOWAKE
;<4.EXEC>EXECSU.MAC.87, 14-Aug-78 16:51:55, EDIT BY OSMAN
;FIX GETTER TO RETURN -1 INSTEAD OF GARBAGE IF THERE IS NO TERMINATOR
;<4.EXEC>EXECSU.MAC.86, 13-Aug-78 14:37:03, Edit by HELLIWELL
;ADD CPFNA ENTRY FOR "SET EDITOR"
;<4.EXEC>EXECSU.MAC.85, 12-Aug-78 16:17:35, EDIT BY OSMAN
;MAKE ERRFIN GLOBAL
;<4.EXEC>EXECSU.MAC.83, 10-Aug-78 10:05:55, EDIT BY OSMAN
;IN CFN, CHANGE DEFINITION OF B17 TO MEAN "NO SUBCOMMANDS"
;<4.EXEC>EXECSU.MAC.81,  5-Aug-78 14:23:48, Edit by DBELL
;<4.EXEC>EXECSU.MAC.80,  5-Aug-78 14:04:26, Edit by DBELL
;TCO 1971.  MAKE ^T ALWAYS SHOW THE CURRENT PROGRAM NAME
;<4.EXEC>EXECSU.MAC.79,  3-Aug-78 16:13:35, EDIT BY OSMAN
;FIX SPELLING OF SEPARATE, AND MAKE HELP MESSAGE FOR /AFTER: LOWERCASE
;<4.EXEC>EXECSU.MAC.78,  3-Aug-78 15:13:17, EDIT BY OSMAN
;PUT SPACE IN FRONT OF $ PROMPT TO PREVENT CONFUSION FOR OPERATOR MODE BATCH JOBS
;<4.EXEC>EXECSU.MAC.77,  3-Aug-78 14:50:59, EDIT BY OSMAN
;PREVENT FATAL ERROR/LOGOUT IF "TAKE" JFN CLOSED "ACCIDENTALLY"
;USE STANDARD TRAP LOGIC FOR ILL INST TRAP
;<4.EXEC>EXECSU.MAC.76,  2-Aug-78 11:07:04, EDIT BY OSMAN
;MAKE THINGS LIKE "ILLEGAL MEMORY READ" HAVE "?" IN FRONT OF THEM
;<4.EXEC>EXECSU.MAC.73,  2-Aug-78 10:13:06, EDIT BY OSMAN
;ADD PDL OVERFLOW ROUTINE
;<4.EXEC>EXECSU.MAC.71, 27-Jul-78 15:56:38, EDIT BY OSMAN
;CHANGE $STR TO USE CM%PO
;<4.EXEC>EXECSU.MAC.69, 25-Jul-78 10:12:15, EDIT BY OSMAN
;ADD RJFN TO UNSTACK A SINGLE JFN
;<4.EXEC>EXECSU.MAC.66, 21-Jul-78 10:11:52, Edit by PORCHER
;MAKE "TAKE, ECHO" PRINT RIGHT PROMPT
;ADD GETMOD
;<4.EXEC>EXECSU.MAC.59, 20-Jul-78 15:42:01, EDIT BY OSMAN
;ADD SETMOD
;ALLOW FANCIER /AFTER:
;<4.EXEC>EXECSU.MAC.53, 18-Jul-78 15:54:52, EDIT BY OSMAN
;ALLOW "/AFTER:+72:0:0" ETC. (SEE BIGTIM:)
;<4.EXEC>EXECSU.MAC.49, 17-Jul-78 11:13:10, EDIT BY OSMAN
;GET RID OF REFS TO GTBUF
;<4.EXEC>EXECSU.MAC.48, 13-Jul-78 13:16:58, EDIT BY OSMAN
;REMOVE REFS TO ERPC
;REMOVE %Y:
;<4.EXEC>EXECSU.MAC.46, 10-Jul-78 20:40:12, EDIT BY OSMAN
;MAKE SVCSBP BE LOCAL
;<4.EXEC>EXECSU..1, 10-Jul-78 20:35:19, EDIT BY OSMAN
;REMOVE SVPRMT
;<4.EXEC>EXECSU.MAC.38, 10-Jul-78 14:09:25, EDIT BY OSMAN
;CLEAN UP CFN1 CODE TO NOT DO PUSH'S
;<4.EXEC>EXECSU.MAC.36, 29-Jun-78 15:39:33, EDIT BY OSMAN
;make cfnmod be local variable
;<4.EXEC>EXECSU.MAC.35, 29-Jun-78 13:49:19, EDIT BY OSMAN
;ADD SETT20, SETPRG
;<4.EXEC>EXECSU.MAC.30, 27-Jun-78 16:10:53, EDIT BY OSMAN
;CHANGE ALL GTB'S TO USE MONSYM SYMBOLS
;<4.EXEC>EXECSU.MAC.29, 27-Jun-78 16:02:40, EDIT BY OSMAN
;CHANGE GTB UUO TO BE IMMEDIATE
;<4.EXEC>EXECSU.MAC.28, 27-Jun-78 14:22:21, EDIT BY OSMAN
;ADD PION AND PIOFF ROUTINES THAT DON'T DO ANY JSYS'S
;<4.EXEC>EXECSU.MAC.25, 27-Jun-78 11:10:46, EDIT BY OSMAN
;ADD GTJFS AND REMOVE REF TO LNGJFN (IN JFNSTK)
;<4.EXEC>EXECSU.MAC.24, 26-Jun-78 13:54:16, EDIT BY OSMAN
;SET PROGRAM NAME TO COMMAND NAME WHEN COMMAND CONFIRMED
;<4.EXEC>EXECSU.MAC.22, 23-Jun-78 18:43:57, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: CFN2A, CFN4, CFNLEV, DEVN1, DIRNMS,
;DIRNMX, DWNPNT, ERRDO, MCOPY0, USRNMX, %Q1A
;<4.EXEC>EXECSU.MAC.14, 21-Jun-78 17:01:08, EDIT BY OSMAN
;USE INTERRUPT FOR MAIL-WATCH (AVOIDS DOING GTAD ON EVERY COMMAND)
;<4.EXEC>EXECSU.MAC.11, 19-Jun-78 14:43:34, EDIT BY OSMAN
;DON'T DO DVCHR EVERY TIME READY IS CALLED.  (TEST TINPF INSTEAD)
;<4.EXEC>EXECSU.MAC.9, 19-Jun-78 10:43:27, EDIT BY OSMAN
;ADD GETSIX, FIXPT
;<4.EXEC>EXECSU.MAC.8, 12-Jun-78 13:48:10, EDIT BY OSMAN
;ADD BUFFS
;<4.EXEC>EXECSU.MAC.6,  9-Jun-78 18:01:27, EDIT BY OSMAN
;ADD FLDSKP
;<4.EXEC>EXECSU.MAC.5,  9-Mar-78 09:22:08, Edit by ENGEL
;ADD MTOPR FUNCTIONS FOR SAVEING AND RESTORING THE FULL MASK
;<4.EXEC>EXECSU.MAC.4, 31-Jan-78 13:37:00, Edit by PORCHER
;<4.EXEC>EXECSU.MAC.3, 31-Jan-78 11:51:09, Edit by PORCHER
;<4.EXEC>EXECSU.MAC.2, 31-Jan-78 09:33:07, Edit by PORCHER
;Add stuff for "TAKE,ECHO"
;<4.EXEC>EXECSU.MAC.1, 30-Jan-78 17:18:19, Edit by PORCHER
;Add stuff for execute-only
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE - SUBROUTINES

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	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 UUO

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 FIELD		;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.

FIELD::	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
	SKIPE CIPF		;COMMAND ALREADY IN PROGRESS?
	JRST FIELD1		;YES
	MOVE A,COMAND		;GET ADDRESS OF TABLE ENTRY
	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
	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
	CALL ECHCMD		;ECHO THE COMMAND IF NECESSARY
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 FIELD		;PARSE THE INPUT
	TXNE A,CM%NOP		;DID IT PARSE CORRECTLY?
	 RET			;NO, NON-SKIP
	RETSKP			;YES, SKIP

;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:	MOVEM A,CMDACS		;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
	JRST READY3		;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

READY3:	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

;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 FIELD		;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
		 JRST READ2	;PCL
		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
;**;	[722]	Insert 1 line at %SBCOM: + 13	6-APR-82	KR
	MOVEM .FP,.PP		;[722]SAVE INN 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
;**;[726]	Insert 1 line at SBCOM1:+17	KR	29-APR-82
	CALL ECHCMD		;[726]NEED TO TURN ON ECHO FOR 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
	SETZM PCLDCO		;PCL Clear original command flag
	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
	JRST CMDIN4		;GO BACK FOR NEXT COMMAND

;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!
	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,%GTB
	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>>
	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
	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
	CAMG B,NOW		;COMPUTE VALUE TO ADD
	ADDI A,1
	JUMPE A,DTEXIT		;DON'T BOTHER IF ZERO
	HRLZS A			;PUT VALUE IN LEFT HALF
	ADD B,A			;FIX UP DATE-TIME
	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
	;...
;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
	JRST DAPLSQ		;MAYBE USER TYPING "+" AFTER THE DAY

;USER HAS TYPED /AFTER:TODAY OR SINCE TODAY

.TODAY:	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
DAA1:	ADD A,BTIME
	MOVE B,A		;RETURN INTERNAL DATE-AND-TIME IN B
	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:	MOVEI A,0		;NO PLUS, SO NO MODIFICATION OF BASE TIME
	JRST DAA1
;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
	JRST $DEV1		;REST SAME AS DEVICE

;DEVICE

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

FNODE$:	CALL GETHLP
	MOVX A,CMNOD!CM%PO
	JRST $RNOD1		;REST SAME AS REAL NODE

;REAL NODE, MUST BE KNOWN BY SYSTEM

RNODE$:	CALL GETHLP
	MOVX A,CMNOD
$RNOD1:	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: MOVE B,LHVAL	;NO COMMAS, SO THERE'S ONLY ONE NUMBER
		   RETSKP]
	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: HRLZ B,LHVAL ;ALLOW "FOO,,"
		    RETSKP]
	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
	CALLRET EVAL		;EVALUATE ADDRESS AND SKIP OR NORMAL RETURN

;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
	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
	HRRO A,40		;GET POINTER TO HELP STRING
	MOVEM A,CMHLP		;SET UP HELP TEXT POINTER
	RET

;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 GTJFN ERROR, NAME AND MESSAGE ALREADY PRINTED

MFSET::	TRVAR <MFPP,<MFBUF,FILWDS>>
	SKIPN MCOJFN		;MULTI FILE OUTPUT?
	RETSKP			;NO, JFN ALREADY IN OUTDSG
	SETZM MFBUF		;SO WE CAN CHECK FOR NULL STRING
	HRROI A,MFBUF
	MOVEM A,MFPP		;INITIALIZE BYTE POINTER TO BUFFER
	MOVSI A,(GJ%DEV)	;FLAG BIT TO TEST
	MOVE C,[1B2+1B35]	;GET DEVICE
	CALL MCOSTR		;GET STRING
	MOVSI A,(GJ%DIR)
	MOVE C,[1B5+1B35]	;GET DIRECTORY
	CALL MCOSTR
	MOVSI	A,(GJ%NAM)
	MOVE	C,[1B8+1B35]	;NAME
	CALL	MCOSTR
	SKIPN MFBUF		;NULL FILESPEC?
	JRST MFSET1		;YES
	MOVSI A,(GJ%EXT)
	MOVE C,[1B11+1B35]	;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)
	MOVE C,[1B14+1B35]	;VERSION
	CALL MCOSTR
	MOVE C,[2B17+1B35]	;PROTECTION
	CALL MCOSTO		;GET PROTECTION FROM OUTPUT
	MOVE C,[2B20+1B35]	;ACCOUNT
	CALL MCOSTO
	MOVE C,[1B21+1B35]	;";T"
	CALL MCOSTO
	MOVE 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,[2B2+2B5+2B8+2B11+2B14+2B17+2B20+1B21+JS%ATR+1B35]
	SKIPN TYPGRP		;FORCED PRINT?
	TLNE Z,GROUPF		;NO, ONLY IF GROUP
	JFNS
	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

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
	MOVE C,[1B2+1B5+1B8+1B11+1B14+JS%ATR+1B35] ;DEVICE:<DIR>NAME.EXT;GEN
	JFNS
	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
	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
;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
;CF%NS	    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 D,(1B14)		;NO SUCH FILE OK?
	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
	 CMERRX			;LET MONITOR SAY WHAT'S WRONG WITH FILESPEC
	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)
	GNJFN			;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.
;RETURNS:
;  A:  DEVICE DESIGNATOR
;  B:  CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS THEREOF:
;	B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB
;	B6: ON IF ASSIGNED
;	    BOTH B5 & B6 ON IF ASSIGNED TO SELF
;  C:  JOB # ASSIGNED TO IF B6 OF B ON

;ENTRY

DEVN:

;RETURN HERE TO TRY AGAIN AFTER TYPING " ? " AFTER ERROR.

	DEVX <Device name>
	 CMERRX
	MOVE A,B
	DVCHR			;GET CHARACTERISTICS WORD
	HLRE C,C
	RET
;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)
	GTDIR			;GET ALL THE INFO INTO THAT BLOCK
	 ERJMP R		;IF FAILED, RETURN NO-SKIP
	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,GTDLN		;SET UP LENGTH OF BUFFER
	MOVEM A,.CDLEN(B)	;IN FIRST 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
;
;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
	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
	HRROI A,USRDEF		;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
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

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
STPUS1:	ILDB A,STPSTP		;GET NEXT CHAR OF STRING
	CAIE A,"*"		;IS IT A WILDCARD?
	CAIN A,"%"		;...
	JRST STPUS2		;YES, GO TRY TO STEP THIS STRING
	JUMPN A,STPUS1		;NO, KEEP LOOKING
	RET			;NONE FOUND, THEN DO NOT DO THE JSYS

STPUS2:	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 OCCURED.
;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>
	 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
	 CALLRET NUMREP		;IT DID, SO DON'T INPUT MORE
	COLONX <":" to enter range, or "," for another number, or next field of command>
	 CAIA			;NO COLON TYPED
	JRST OCTL4		;COLON TYPED, GO GET END OF RANGE
	COMMAX <"," to enter 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 enter 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 SHUTDOWN
	JRST [	ETYPE < System is shutdown>
		JRST DWNTY2]	;YES, SAY SO
	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.

GETSXB::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
	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
	HRROI A,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,B
	MOVE B,RPTR		;GET POINTER TO STRING
	MOVEI C,0		;STORE NULL AT END OF STRING
	SOUT			;COPY THE STRING
	MOVE A,NEWPTR		;GET ADDRESS WHERE STRING GOT PUT
	RETSKP			;SUCCESFUL RETURN

;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 CTRL/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 CTRL/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 CTRL/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?
	CALLRE 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
	CALLRE 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		;REMEMER 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
	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)
	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
	SKIPGE FORK		;IS THERE A CURRENT FORK?
	ERROR <No program>	;NO.
	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 MAPPFF		;CAN'T MAP-- RETURN +1
	MOVEM A,NPAGE		;SAY ITS MAPPED
	CAMN A,[-1]
	JRST	MPPF8
	RPACS			;GET ACCESS/EXISTENCE OF MAPPED PAGE
	ERJMP [	SETZ B,		;SECTION CONTAINING PAGE DOESN'T EXIST
		JRST MPPF8]	;JUST SAY PAGE CAN'T BE USED
	SKIPN	B		;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

MPPF8:	POP P,A			;RH A TRANSPARENT
	POP P,C
	RETSKP			;RETURN +2 SUCCESS FROM MAPPF

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
;UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN C(Q1), INDEX IN RH OF D, ONE RETURN 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
	HRR A,40
	GETAB
	 CALL JERR
	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:
STAT,<	AOS STBUF	>	;THIS INDEX FOR ^T
	STKVAR <CIJFN0,COJFN0,SAV40>
	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
	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
;**;[737] Insert 2 lines at USEX:+21L	KR	2-JUN-82
	SKIPN B,SLFTAB(A)	;[737]LOAD B WITH FORK TABLE INDEX
	JRST USEPS0		;[737]IF 0,WE DON'T KNOW THIS PROG
;**;[734]	Replace 4 lines with 3 at USEX:+21L	KR	12-MAY-1982
	GETNM			;[734]
;**;[737] Insert 2 lines at USEX:+22L	KR	2-JUN-82
	CAMN A,['EXEC  ']	;[737]IS CURRENT PROG NAME EXEC?
	MOVE A,.FKPTM+TTWPNM(B)	;[737]YES, GET LAST RUN PROG'S NAME 
	ETYPE < %1'>		;[734]NO, JUST TYPE WHAT GETNM FOUND
	MOVE A,FORK		;[734]
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>
MIC,<	CALL GETPAG		;MIC EXISTS?
	  JRST USEOU1		;NO
	TYPE < (DO in progress)>
>
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 >
	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
	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
	CALL CMDINI		;RE-INIT COMND, 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
	MOVE A,COJFN
	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
;**;[723] Add 1 line at GETLPC:+2L	JRG	8-APR-82
	TSO B,B			;[723] 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
	SKIPLE A,EFORK		;EPHERMERAL?
	 FFORK			;YES - FREEZE IT
	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)
	SKIPN PCPRGR		;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
	SKIPN PCPRGR		;PCL If not controlled by PCL
	CALL LTTYMD		;SET UP OUR MODES, PROGRAM MAY HAVE CAUSED STRANGE STATE.
	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
	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 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)
	SKIPN PCPRGR		;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.
	SKIPN PCPRGR		;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
>
	MOVE A,COJFN
	DOBE			;MAKE SURE IT ALL TYPES (NEEDED?)
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
	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)
	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
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
	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
	SKIPLE A,EFORK		;SPECIAL FORK?
	 KFORK			;YES - KILL IT
	SETOM EFORK		;NO MORE
	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.
;**;	[722]	Insert 2 lines at ERRFIN + 10	6-APR-82	KR
	SKIPE .PP		;[722]DON'T RESET IF .PP NEVER SAVED
	MOVE .FP,.PP		;[722]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+CZ%NCL+.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
	CALL %GETER		;GET ERROR CODE IN CASE "%?"
	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 ER2]
	CALL UNTAKE		;UNWIND IF ERRORS NOT ALLOWED AT THIS LEVEL
ER2:
	TLNN Z,F1		;DON'T CLEAR INBUF FOR ^U
	SKIPE CIDLYF		;REQUESTING DELAYED CFIBF?
	RET			;YES, DON'T DO IT NOW
	MOVE A,CIJFN
	CFIBF
	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.
/]
	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
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,RSKP		;LEAVE LOOP WHEN ALL ENTRIES HAVE BEEN SCANNED
	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>
	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

;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:	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

%ETYPE:	TRVAR <<ETBFR,EBLN>,<RACS,5>,ETPTR,SRCPTR,ETYPF,EDAT>
	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

	SETZB C,D		;C: IF NO NUMBER, USE 0 IN PLACE OF AC CONTENTS
				;D: INIT NUMBER TO 0.
ETYP4:	ILDB B,SRCPTR		;CHARACTER AFTER %
	CAIG B,"9"
	CAIGE B,"0"
	JRST ETYP5
	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
	JRST ETYP4		;GO CHECK FOR ADDITIONAL DIGIT(S)

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

ETYP5:	CAIL B,141
	CAILE B,172
	CAIA
	TRZ B,40		;MAKE THE CHARACTER UPPER CASE
	MOVEI A,LETLEN		;INDEX INTO TABLE OF CODES
	MOVEM C,EDAT		;DON'T CLOBBER DATA
ETYP7:	SOJL A,LETNF		;COULDN'T FIND CHARACTER IN TABLE IF THIS JUMPS
	HLRZ C,%LETS(A)		;GET NAME OF ELEMENT FROM TABLE
	CAIL C,141
	CAILE C,172
	CAIA
	TRZ C,40		;MAKE THE CHARACTER UPPER CASE
	CAME B,C		;IS THIS THE CORRECT ENTRY?
	JRST ETYP7		;NOT YET...
	MOVE C,EDAT		;RESTORE DATA
	HRRZ A,%LETS(A)		;GET ADDRESS OF ROUTINE
	CALL (A)		;DO THE WORK

;DONE INTERPRETING A % CODE.

	MOVE C,SRCPTR		;SAVE COPY
	ILDB B,C		;NEXT CHARACTER
	CAIN B,"%"		;PASS FOLLOWING %
	MOVEM C,SRCPTR
	JRST ETYP2		;CONTINUE TYPING
;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER %
;KEEP THIS TABLE IN ASCII ASCENDING ORDER SO IT REMAINS EASY TO SEE IF A
;CHARACTER IS IMPLEMENTED OR NOT
;(NOTE THAT EXEC DOESN'T ASSUME TABLE IS ORDERED THOUGH)

%LETS:	"#",,%NUMS		;OCTAL NUMBER AS N OR N,,N AS APPROPRIATE
	"%",,%PER		;%% JUST PRINTS A PERCENT
	"=",,%FLT		;SIX-COLUMN FLOATING POINT NUMBER, NN.MM
	"@",,%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
	"\",,%STRNG		;TYPE STRING OR CHAR IN AC
	"/",,%EXPR		;EXPRESSION IN AC
	"'",,%SIX		;PRINT CONTENTS OF AC IN SIXBIT
	"_",,%EOL		;TYPE A CRLF
	"?",,%SYSMS		;ERROR MESSAGE (CONTENTS OF AC OR LATEST)
LETLEN==.-%LETS

;UNRECOGNIZED %-CODE

LETNF:	TYPE <%>		;DIGIT, IF ANY, IS LOST.
	JRST ETYP2A		;CONTINUE TYPING, STARTING WITH CHAR AFTER %.
;%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.

;%% 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,[RET]		;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 " "
	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 ...

;"TTY N" OR "DETACHED"

%L:	GJINF
	JUMPL D,[UTYPE [ASCIZ /Detached/]
		RET]
	TYPE <TTY>
	MOVE A,COJFN
	MOVE B,D
	JRST TOCT		;TYPE OCTAL FROM B

;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 [CALL JFNSIL 	;SPR 14203 ANALYZE ERROR
		 JRST JERR	;STRANGE ERROR
		JRST %S1]	;"GOOD" ERROR
	MOVEM A,COJFN		;UPDATE IN CASE BYTE POINTER
%S1:	RET

;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
	TXNN B,GS%NAM		;DOES JFN HAVE NAME?
	RET			;NO, JUST RETURN ERROR CODE
	CAIN A,DESX3		;UNASSIGNED JFN ERROR?
	 JRST [	TYPE < Restricted JFN>
		RETSKP]
	CAIN A,GJFX24		;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

%W:	MOVE A,COJFN
	MOVE B,C		;ARG SUPPLIED IN C
	MOVEI C,0		;USE STANDARD BRIEF FORMAT
	ODTIM
	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
;**;[735] Replace 2 lines with 5 at %X2:+3L	KR	17-MAY-82
	ETYPE <%_>		;[735]TYPE EOL
	SKIPE INDQUS		;[735]IF SET, WE ARE PRINTING "INFO PROG",
	JRST %X4		;[735] DON'T WANT QUESTION MARK IN FIRST COLUMN
	ETYPE <?%2?>		;[735]NOT SET; PROCEED NORMALLY
%X3:	SETO A,			;[735]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

;**;[735] Insert 4 lines at %EXPR:-4L	KR	17-MAY-82
%X4:	ETYPE <   >		;[735]TYPE 3 SPACES FOR EACH FORK-LEVEL
;**;[736] Change 1 line at %X4:+1L	KR	1-JUN-82
	SOJGE Q1,%X4		;[735][736] Q1 IS SETUP BY FSTAT TO CONTAIN FORK-LEVEL
	ETYPE <?%2?>		;[735]FINALLY PRINT FORK'S ERROR MESSAGE
	JRST %X3		;[735]RETURN TO NORMAL FLOW
;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

;%? 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
	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
NONEWF,<
;SUBROUTINE CALLED AT RETURN TO COMMAND LOOP, TO DO MAIL WATCH.
; CALLED IFF MWATCF (MAIL WATCH FLAG) IS NON-ZERO.
;"CALL CHKPTY" REMOVED FROM THIS ROUTINE BECAUSE 1) IT WAS CAUSING TWO
;EXTRA JSYS'S TO BE EXECUTED PER EXEC COMMAND AND 2) USER RUNNING UNDER NEWRUN
;OR PTYCON MAY VERY WELL HAVE MAIL BE WATCHED.

MWATCH::SKIPE CUSRNO		;MUST BE LOGGED IN
	SKIPN MAILF		;TIME TO CHECK?
	RET			;NO
	CALL MINT0		;ENABLE FOR ANOTHER MAIL INTERRUPT
	MOVE B,CUSRNO		;GET LOGGED-IN USER NUMBER
	CALL MALCHK		;CHECK MY MAIL BOX
	 RET			;NO NEW MAIL
	TYPE <[You have new mail]
>
	RET			;RETURN TO COMMAND LOOP

;ROUTINE TO ENABLE FOR A TIMER INTERRUPT AT SOME ELAPSED TIME FROM NOW.
;WHEN THE INTERRUPT OCCURS, IT MEANS THAT MAIL SHOULD BE CHECKED.

MINT0::	SETZM MAILF		;SAY NO INTERRUPT YET
	GTAD			;GET CURRENT TIME AND DATE
	MOVX B,MWATCI		;GET INCREMENT
	ADD B,A			;CALCULATE WHEN TO INTERRUPT
	MOVEM B,MALWEN		;REMEMBER WHEN
	MOVE A,[.FHSLF,,.TIMDT]	;SAY TO INTERRUPT AT EXACT TIME
	MOVEI C,MALCHN		;USE MAIL CHANNEL
	TIMER			;ENABLE FOR INTERRUPT
	 ETYPE <
%%Unexpected MAIL-WATCH failure, mail no longer being watched - %?
>
	RET
> ; NONEWF
;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!)
NONEWF,<
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;CALLED WITH B CONTAINING THE USER NUMBER
;SKIP RETURNS IF THAT DIRECTORY'S MAIL.TXT EXISTS AND HAS NEW STUFF.
;NON-SKIP IF NO NEW MAIL (A=0) OR CANNOT TELL (A=-1).

MALCHK::STKVAR <MALUSR,<MALBFR,FILWDS>>
	MOVEM B,MALUSR		;SAVE USER NUMBER
	HRROI A,MALBFR		;SPACE TO CREATE FILENAME
	HRROI B,[ASCIZ /PS:</]	;MUST BE ON PS:
	MOVEI C,0
	SOUT
	MOVE B,MALUSR		;RESTORE USER NUMBER
	DIRST			;ADD USER NAME
	 CALL JERR		;NO SUCH DIRECORY. SHOULDN'T HAPPEN
	HRROI B,[ASCIZ />MAIL.TXT.1/]
	MOVEI C,0
	SETO Q1,		;NO JFN YET
	SOUT			;FINISH FILE NAME
	MOVX A,GJ%OLD+GJ%DEL+GJ%SHT ;OLD,DELETED AND SHORT FORM
	HRROI B,MALBFR		;POINT TO FILE NAME
	CALL GTJFS		;GET AND STACK JFN
	 JRST MALCH2		;FAILED
	HRRZ Q1,A		;SAVE THE JFN IN MORE PERMANENT AC
	MOVE B,[1,,.FBCTL]	;ANALYZE THE FILE
	MOVEI C,C
	CALL $GTFDB		;SEE IF IT IS DELETED
	 JRST MALCHP		;PROTECTED
	TXNE C,FB%DEL		;DELETED?
	JRST MALCHM		;YES. NO NEW MAIL
	MOVE B,[1,,.FBSIZ]	;NOT DELETE.  GET SIZE
	MOVEI C,C
	CALL $GTFDB		;GET SIZE
	 JRST MALCHP		;PROTECTED
	JUMPLE C,MALCHM		;IF EMPTY.  NO MAIL
	MOVE B,[1,,.FBWRT]	;NOT EMPTY GET WRITE DATE
	MOVEI C,D		;PUT WRITE DATE IN D
	CALL $GTFDB
	 JRST MALCHP		;PROTECTED
	MOVE B,[1,,.FBREF]	;GET LAST REFERENCE DATE
	MOVEI C,C
	CALL $GTFDB
	 JRST MALCHP		;PROTECTED
	CAML C,D		;WRITTEN LATELY?
	JRST MALCHM		;NO.  NO MAIL
	RETSKP
;... MALCHK CONTINUED

MALCH2:	CAIN A,GJFX24		;SPECIFIC FILE NOT FOUND
	JRST MALCHM		;RIGHT. NO NEW MAIL
	CAIL A,GJFX16		;RANGE FOR NOT FOUND
	CAILE A,GJFX20		;..
	JRST MALCHP		;SAY DON'T KNOW ABOUT MAIL
MALCHM:	TDZA A,A		;MAIL REALLY NOT THERE
MALCHP:	SETO A,			;CAN'T TELL IF MAIL IS THERE
	RET
> ; NONEWF
NEWF,<
;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,CUSRNO		;IS IT ME?
	 JRST [	ETYPE <[%5N has > ;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
;CALLED WITH C(B) := USER #
;RETURNS:
;	+1	;NO MAIL, OR SOME OTHER FAILURE
;	+2	;NEW MAIL - C(A) := -1,,MESSAGE
;			    C(D) := WRITE DATE/TIME
;			    C(C) := AUX MESSAGE

MALCHK::STKVAR <MALUSR,<MALFDB,16>>
	SETO Q1,		;INIT FLAG
	HRROI A,MALBUF		;POINT AT BUFFER
	MOVEM B,MALUSR		;SAVE USER #
	HRROI B,[ASCIZ "PS:<"]
	MOVEI C,0
	SOUT			;COPY STRING
	MOVE B,MALUSR		;RESTORE USER
	DIRST			;NAME STRING TO BUFFER
	 CALL JERR
	HRROI B,[ASCIZ ">MAIL.TXT.1"]
	SOUT			;FINISH FILE SPEC
	MOVX A,GJ%OLD!GJ%DEL!GJ%SHT
	HRROI B,MALBUF
	GTJFN			;GRASP AT FILE
	 JRST MALCH2		;HANDLE ERROR
	MOVEI Q1,(A)		;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
	 CALL JERR		;BITCH ABOUT IT
	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 %2\ 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
	 CALL JERR		;BITCH IF LOSAGE
	MOVE A,Q1		;RESTORE VALUE
	RET			; AND RETURN
; STILL IN NEWF

;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
> ; NEWF
;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

;ROUTINE TO DO GFRKS JSYS TO GET FORK HANDLES ON ALL PROCESSES
;UNDER THIS EXEC.
;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

;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.)
;
;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

;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