Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - mit/exec/execin.mac
There are 47 other files named execin.mac in the archive. Click here to see a list.
;[MIT-XX]SRC:<EXEC.TEST>EXECIN.MAC.12, 14-Mar-85 00:45:31, Edit by JTW
;131 Add Chaosnet and Decnet terminal display to INFO SYSTEM
;[MIT-XX]SRC:<EXEC.TEST>EXECIN.MAC.11,  4-Nov-84 00:01:50, Edit by JTW
;120 Print version numbers in decimal sometimes
;1020 stanford help facility
;1017 oz's refuse-sends-bit support
;720 support for seperate command tables for not logged in
;717 add new terminal types
;   use VTS where possible
;716 add command-edit features
;715 add CMU PCL 5(100) features
;713 use new configuration switches
;   add literals label
;712 DEC release version
; UPD ID= 137, SNARK:<5.EXEC>EXECIN.MAC.22,   6-Feb-82 16:37:43 by LEACHE
;TCO 5.1722 CHANGE JSYS-TRAPPING PARAMETER
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21,  28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 101, SNARK:<5.EXEC>EXECIN.MAC.19,  22-Oct-81 14:34:32 by CHALL
;TCO 5.1583 MOVE $DEF- KEYWORDS FOR "INFO DEFAULTS" TO EXECCA
; UPD ID= 79, SNARK:<5.EXEC>EXECIN.MAC.18,   2-Oct-81 10:35:18 by CHALL
;TCO 5.1550 BEFORE- LOOK AT F2 FLAG IN Z; ON==OUTPUT TAB; OFF==SPACE
;  .DNTOP- LIGHT F2 FLAG IN AC Z FOR BEFORE ROUTINE
;TCO 5.1532 .DNTOP: RE-DO CODE; OUTPUT DECNET NODE LIST SORTED
; UPD ID= 75, SNARK:<5.EXEC>EXECIN.MAC.17,  21-Sep-81 14:55:46 by CHALL
;TCO 5.1525 BEFORE- MAKE LAST ITEM ON A LINE END WITH COMMA<CR> (NOT JUST <CR>)
;  ALSO, KICK OUT A NEW LINE WHEN 9 AWAY FROM THE END (", XXX-XXX," HAS TO FIT)
;TCO 5.1524 .FILST- CHANGE blank TO carriage return IN HELP TEXT
; UPD ID= 26, SNARK:<5.EXEC>EXECIN.MAC.14,  14-Aug-81 18:34:16 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 16, SNARK:<5.EXEC>EXECIN.MAC.10,  17-Jul-81 15:43:09 by CHALL
;TCO 5.1421 .INDEF- ADD "INFO DEFAULTS ALL"; MAKE IT THE DEFAULT
; UPD ID= 14, SNARK:<5.EXEC>EXECIN.MAC.8,  16-Jul-81 09:03:22 by CHALL
;TCO 5.1417 .PISTA- IF RIR FAILS TRY AN XRIR%
; UPD ID= 2258, SNARK:<5.EXEC>EXECIN.MAC.7,  26-Jun-81 16:56:45 by CHALL
;TCO 5.1389 .ALRST- INFO ALERT SAYS IF ALERTS ARE AUTOMATIC OR NOT
;TCO 5.1387 - NPINFO: ADD LINE TO INFO TERM SAYING WHAT THE PAUSE-EOP CHARS ARE
;<HELLIWELL.EXEC.5>EXECIN.MAC.2, 12-Jun-81 14:17:04, EDIT BY HELLIWELL
;MAKE .DOWNT INTERNAL (::)
;<HELLIWELL.EXEC.5>EXECIN.MAC.1, 14-May-81 08:19:15, EDIT BY HELLIWELL
;REMOVE "GT40" TERMINAL TYPE
; UPD ID= 1957, SNARK:<5.EXEC>EXECIN.MAC.4,   7-May-81 09:19:36 by GRANT
;TCO 5.1316 - Make @INF VER be able to handle an entry vector in a non-0
;   section 
; UPD ID= 1953, SNARK:<5.EXEC>EXECIN.MAC.3,   6-May-81 15:04:48 by MURPHY
;SEARCH GALAXY UNV'S
;REMOVE MFRK CONDITIONALS
;PCL ASSEMBLY SWITCH
;<4.EXEC>EXECIN.MAC.1, 11-Apr-80 06:19:07, Edit by DK32
;Programmable Command Language
; UPD ID= 1542, SNARK:<5.EXEC>EXECIN.MAC.35,   9-Feb-81 13:26:11 by OSMAN
;More 5.1223 - try to print as much as possible for inactive line
; UPD ID= 1541, SNARK:<5.EXEC>EXECIN.MAC.34,   9-Feb-81 13:19:10 by OSMAN
;More 5.1223 - try to print as much as possible for inactive line
; UPD ID= 1440, SNARK:<5.EXEC>EXECIN.MAC.33,  15-Jan-81 10:52:33 by OSMAN
;Tco 5.1233 - Make FILE-OPENINGS and JSYS OPENF independent
; UPD ID= 1429, SNARK:<5.EXEC>EXECIN.MAC.32,   9-Jan-81 15:02:31 by OSMAN
;5.1129 - Clear SYMOKF in INFO PROG and INFO FORK to make symbols come out
;   right 
; UPD ID= 1424, SNARK:<5.EXEC>EXECIN.MAC.31,   8-Jan-81 15:37:22 by OSMAN
;Fix "INFO PROG" to type correct error message of inferior fork
; UPD ID= 1406, SNARK:<5.EXEC>EXECIN.MAC.30,   6-Jan-81 14:40:49 by OSMAN
;More 5.1225 - Fix handling of "FORK" at FSTAT8
; UPD ID= 1399, SNARK:<5.EXEC>EXECIN.MAC.29,   6-Jan-81 10:27:50 by OSMAN
;tco 5.1225 - Implement jsys trapping and file-opening trapping!
; UPD ID= 1395, SNARK:<5.EXEC>EXECIN.MAC.28,  31-Dec-80 17:03:37 by LYONS
;TCO 5.1224 - Type a * in front of our node in I DECNET
; UPD ID= 1393, SNARK:<5.EXEC>EXECIN.MAC.27,  31-Dec-80 16:04:59 by OSMAN
;tco 5.1223 - Allow "INFO TERMINAL n"
; UPD ID= 1323, SNARK:<5.EXEC>EXECIN.MAC.26,   1-Dec-80 16:00:57 by OSMAN
;Use GETENT and SETENT instead of GEVEC and SEVEC
; UPD ID= 1241, SNARK:<5.EXEC>EXECIN.MAC.25,   6-Nov-80 15:21:04 by OSMAN
;Use HIGHPN as highest possible page number
; UPD ID= 1129, SNARK:<5.EXEC>EXECIN.MAC.24,   6-Oct-80 10:16:43 by OSMAN
;tco 5.1167 - Remove FDB autokeep feature
; UPD ID= 1042, SNARK:<5.EXEC>EXECIN.MAC.23,  25-Sep-80 14:14:10 by OSMAN
;TCO 5.1156 - Add INFO DEF PROGRAM
; UPD ID= 1032, SNARK:<5.EXEC>EXECIN.MAC.22,  23-Sep-80 09:48:30 by OSMAN
;More 5.1150 - Call DGFRKS after printing non-tree info, since (C) is needed
; UPD ID= 1028, SNARK:<5.EXEC>EXECIN.MAC.21,  22-Sep-80 10:38:10 by OSMAN
;tco 5.1150 - Add SET PROGRAM
; UPD ID= 1010, SNARK:<5.EXEC>EXECIN.MAC.20,  12-Sep-80 09:30:10 by OSMAN
;More 5.1113 - Print directory name before doing GTDAL
; UPD ID= 999, SNARK:<5.EXEC>EXECIN.MAC.19,  11-Sep-80 16:13:44 by OSMAN
;More 5.1113 - Print directory names
; UPD ID= 996, SNARK:<5.EXEC>EXECIN.MAC.18,  10-Sep-80 11:09:23 by OSMAN
;More 5.1113 - Do GTDAL in right place
; UPD ID= 919, SNARK:<5.EXEC>EXECIN.MAC.17,  19-Aug-80 15:06:33 by HESS
; UPD ID= 873, SNARK:<5.EXEC>EXECIN.MAC.16,  11-Aug-80 13:07:30 by OSMAN
;More 5.1113
; UPD ID= 856, SNARK:<5.EXEC>EXECIN.MAC.15,  10-Aug-80 15:20:12 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
; UPD ID= 851, SNARK:<5.EXEC>EXECIN.MAC.14,   7-Aug-80 16:52:52 by OSMAN
;More 5.1113 - Fix INFO DIS; DSKSTL was assuming RLJFNS preserved temps
; UPD ID= 842, SNARK:<5.EXEC>EXECIN.MAC.13,   5-Aug-80 16:26:20 by OSMAN
;More 5.1120
; UPD ID= 834, SNARK:<5.EXEC>EXECIN.MAC.12,   5-Aug-80 08:58:50 by OSMAN
;More 5.1120
; UPD ID= 823, SNARK:<5.EXEC>EXECIN.MAC.11,   4-Aug-80 09:48:24 by OSMAN
;tco 5.1120 - Make INFO VERSION show names and versions of pdvs
; UPD ID= 733, SNARK:<5.EXEC>EXECIN.MAC.10,   6-Jul-80 20:32:24 by LYONS
;FIX SOME BUGS IN READ AFTER WRITE OPTIONS
; UPD ID= 717, SNARK:<5.EXEC>EXECIN.MAC.8,   1-Jul-80 10:43:46 by OSMAN
;tco 5.1086 - Show offline-expiration-default under INFO SYSTEM-STATUS
; UPD ID= 620, SNARK:<5.EXEC>EXECIN.MAC.7,   9-Jun-80 18:12:36 by LYONS
;tco 5.1062 add information about read after write options
;<5.EXEC>EXECIN.MAC.6, 30-May-80 16:53:53, EDIT BY MURPHY
;NEW MAIL WATCH AND ALERTS UNDER NEWF
; UPD ID= 534, SNARK:<5.EXEC>EXECIN.MAC.5,  20-May-80 15:36:03 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 497, SNARK:<5.EXEC>EXECIN.MAC.4,  30-Apr-80 14:55:15 by OSMAN
;tco 5.1029 - Make INFO DECNET work right with small terminal widths
; UPD ID= 494, SNARK:<5.EXEC>EXECIN.MAC.3,  30-Apr-80 14:34:50 by OSMAN
;More confirmation fixups
; UPD ID= 475, SNARK:<4.1.EXEC>EXECIN.MAC.17,  24-Apr-80 16:05:26 by TOMCZAK
;Replace references to T1 with A to avoid confusion with GALAXY
;<4.1.EXEC>EXECIN.MAC.15, 24-Apr-80 15:22:52, EDIT BY OSMAN
;Don't require double confirmation on certain INFO DEFAULT commands
; UPD ID= 441, SNARK:<4.1.EXEC>EXECIN.MAC.14,  14-Apr-80 10:23:46 by OSMAN
;More 4.1.1111 - Don't loop if structure 2136: mounted!
;<4.1.EXEC>EXECIN.MAC.13, 17-Mar-80 14:09:35, EDIT BY OSMAN
;Get rid of ONEWRD checks
;<4.1.EXEC>EXECIN.MAC.8, 14-Mar-80 11:43:21, EDIT BY OSMAN
;tco 4.1.1111 - Handle plotters correctly under INFO AVAIL DEV
; UPD ID= 163, SNARK:<4.1.EXEC>EXECIN.MAC.7,  19-Dec-79 16:49:30 by OSMAN
;tco 4.1.1055 - Add working set preloading info under INFO SYSTEM
;<4.1.EXEC>EXECIN.MAC.6, 17-Dec-79 16:48:15, Edit by HESS
;TCO #4.2594 - Fix symbol conflict in HELP command
;<4.1.EXEC>EXECIN.MAC.3, 20-Nov-79 14:10:03, EDIT BY OSMAN
;TCO 4.1.1023 - TAKE stuff
;<4.1.EXEC>EXECIN.MAC.2,  2-Nov-79 15:32:25, EDIT BY OSMAN
;tco 4.1.1006 - Use CMERRX for HELP command error instead of ERROR
;<4.EXEC>EXECIN.MAC.145, 26-Oct-79 11:23:03, EDIT BY TOMCZAK
;TCO#4.2554 - ILLEGAL TERMINAL TYPES NOT HANDLED RIGHT AT ILTTYP+1
;<4.EXEC>EXECIN.MAC.143, 22-Oct-79 13:44:36, EDIT BY OSMAN
;tco 4.2541 - Handle errors in INFO FILS better, where the jfn disappears
;<4.EXEC>EXECIN.MAC.142,  9-Oct-79 12:00:03, EDIT BY OSMAN
;tco 4.2521 - Fix up listing of I STR to not break up user names
;<4.EXEC>EXECIN.MAC.141, 24-Sep-79 12:01:50, Edit by HESS
;<4.EXEC>EXECIN.MAC.140, 20-Sep-79 14:20:35, Edit by HESS
; Use perm free space for FRKTBL
;<4.EXEC>EXECIN.MAC.139, 19-Sep-79 14:14:48, EDIT BY TOMCZAK
;TCO# 4.2475 - Remove parsing for * in HELP command (? does same thing>
;<4.EXEC>EXECIN.MAC.138, 17-Sep-79 14:55:07, Edit by HESS
; Cosmetic change to INFO PROGRAM-STATUS, add more data to INFO COMMAND
;<4.EXEC>EXECIN.MAC.137, 22-Aug-79 00:30:41, Edit by HESS
;<HESS.E>EXECIN.MAC.17, 20-Aug-79 16:33:39, Edit by HESS
; Add extended features
;<4.EXEC>EXECIN.MAC.133,  8-Aug-79 09:53:24, EDIT BY OSMAN
;tco 4.2378 - Expand INFO SYSTEM to include retrieval-wait info
;<4.EXEC>EXECIN.MAC.131,  1-Aug-79 14:59:28, EDIT BY OSMAN
;tco 4.2363 - add INFO DEFAULT TAKE
;<4.EXEC>EXECIN.MAC.128,  1-Aug-79 13:58:12, EDIT BY OSMAN
;tco 4.2362 - Don't list connected structure twice if LPT defined as DSK.
;<4.EXEC>EXECIN.MAC.127, 27-Jul-79 12:32:44, EDIT BY TOMCZAK
;STRST1 - Don't stop executing I STR command so can see subsequent structures
;<4.EXEC>EXECIN.MAC.126, 21-Jun-79 13:38:03, EDIT BY OSMAN
;REMOVE EXTRANEOUS REFS TO RLJFNS
;<4.EXEC>EXECIN.MAC.125, 19-Jun-79 13:03:14, EDIT BY OSMAN
;tco 4.2294 - Don't say "batch class -1"
;<4.EXEC>EXECIN.MAC.124,  5-Jun-79 11:24:26, EDIT BY OSMAN
;tco 4.2272 - Fix ADDRESS-BREAK error on 2020
;<4.EXEC>EXECIN.MAC.123,  1-May-79 11:19:12, EDIT BY OSMAN
;CHANGE GTJFN'S TO CALL GTJFS SO THAT ^C IN MIDDLE WON'T LEAVE JFN AROUND
;<4.EXEC>EXECIN.MAC.122, 27-Apr-79 14:44:24, EDIT BY OSMAN
;Catch error on ADBRK for 2020
;<4.EXEC>EXECIN.MAC.121,  5-Apr-79 06:59:58, EDIT BY R.ACE
;FIX INFO VOLUMES TO DISPLAY SCRATCH TAPES CORRECTLY
;<4.EXEC>EXECIN.MAC.120, 29-Mar-79 15:19:25, EDIT BY OSMAN
;DON'T BOMB ON LARGE MEMORY MAPS.  PRINT WARNING AND PARTIAL MAP
;<4.EXEC>EXECIN.MAC.119, 21-Mar-79 10:22:59, EDIT BY OSMAN
;TCO 4.2220 - DON'T KEEL OVER ON INFO MEM IF PAGE IS MAPPED TO RESTRICTED JFN
;<4.EXEC>EXECIN.MAC.118, 14-Mar-79 07:39:58, EDIT BY R.ACE
;CHANGE NOISE ON INFO VOLUMES
;<4.EXEC>EXECIN.MAC.117, 12-Mar-79 17:59:38, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECIN.MAC.116,  7-Mar-79 13:27:35, EDIT BY OSMAN
;ADD DREGS REPORT IF CLASS SCHEDULING IS OFF
;<4.EXEC>EXECIN.MAC.115,  7-Mar-79 12:47:26, EDIT BY R.ACE
;ADD TAPE-DRIVE ALLOCATION TO INFO SYSTEM-STATUS COMMAND
;<4.EXEC>EXECIN.MAC.114,  5-Mar-79 15:25:49, EDIT BY HURLEY.CALVIN
; Fix INFO ARC NUL: bug
;<4.EXEC>EXECIN.MAC.110,  2-Mar-79 15:30:44, EDIT BY OSMAN
;TYPE CLASS SCHEDULER STUFF UNDER "INFO SYSTEM-STATUS"
;<4.EXEC>EXECIN.MAC.109, 28-Feb-79 10:32:28, EDIT BY OSMAN
;REMOVE REFS TO CTYPE (USE ETYPE INSTEAD)
;<4.EXEC>EXECIN.MAC.108, 27-Feb-79 15:56:13, EDIT BY OSMAN
;CHANGE CCHRO TO COUTC
;<4.EXEC>EXECIN.MAC.107, 12-Feb-79 14:08:46, EDIT BY HURLEY.CALVIN
; CHANGE BITS FOR SPECFN IN .ARSTS SO TRAILING "," DOESN'T SCREWUP
;<4.EXEC>EXECIN.MAC.106,  8-Feb-79 16:36:51, EDIT BY OSMAN
;ADD INFO DEF PLOT
;<4.EXEC>EXECIN.MAC.105,  7-Feb-79 10:42:06, EDIT BY OSMAN
;HANDLE FAILURE FROM GETNOD
;<HURLEY.CALVIN>EXECIN.MAC.1,  1-Feb-79 13:22:16, EDIT BY HURLEY.CALVIN
; Cause INFO ARCHIVE-STATUS to not print "None" files, find invisible
; ones, and default to * for extension
;<4.EXEC>EXECIN.MAC.101, 30-Jan-79 16:35:19, EDIT BY OSMAN
;ADD LA38, LA120
;<4.EXEC>EXECIN.MAC.100, 26-Jan-79 15:32:00, EDIT BY OSMAN
;keep all guide words UPPERCASE
;<4.EXEC>EXECIN.MAC.98, 26-Jan-79 13:46:30, EDIT BY OSMAN
;CHANGE INFO STR TO REFER TO MOUNT INSTEAD OF SMOUNT
;<4.EXEC>EXECIN.MAC.96, 26-Jan-79 13:41:43, EDIT BY OSMAN
;don't let INFO MEM buffer overflow
;<4.EXEC>EXECIN.MAC.95, 25-Jan-79 17:03:42, EDIT BY R.ACE
;MAKE INFO VOLUMES CONFORM TO NEW GALAXY TEXT MESSAGE FORMAT
;<4.EXEC>EXECIN.MAC.90, 25-Jan-79 14:12:53, EDIT BY OSMAN
;tco 4.2172 - speed up INFO MEM
;<4.EXEC>EXECIN.MAC.89, 23-Jan-79 09:42:18, EDIT BY OSMAN
;CHANGE NODE OUTPUT FORMAT "INFO JOB"
;<4.EXEC>EXECIN.MAC.88, 15-Jan-79 02:42:30, EDIT BY HEMPHILL
;MAKE EXEC UNDERSTAND USER EXTENDED ADDRESSING FOR "SET ADDRESS-BREAK",
; "INFORMATION PROGRAM", ^T, "INFORMATION MEMORY-USAGE"
;<4.EXEC>EXECIN.MAC.87, 14-Jan-79 13:40:41, EDIT BY KIRSCHEN
;USE SYMBOL .NDBK1 IN INFO DECNET
;<4.EXEC>EXECIN.MAC.86,  3-Jan-79 10:40:38, EDIT BY OSMAN
;try another flavor of "info job"
;<4.EXEC>EXECIN.MAC.85, 20-Dec-78 15:47:27, EDIT BY HURLEY.CALVIN
; Add 1B17 to SPECFN bits in .ARSTS
;<4.EXEC>EXECIN.MAC.84, 20-Dec-78 07:16:02, EDIT BY R.ACE
;ADD INFORMATION (ABOUT) VOLUMES
;<4.EXEC>EXECIN.MAC.83, 18-Dec-78 16:43:25, EDIT BY OSMAN
;ONLY DISPLAY NODE ON INFO JOB IF DIFFERENT FROM HOST NODE NAME
;<4.EXEC>EXECIN.MAC.80,  5-Dec-78 13:05:33, EDIT BY OSMAN
;Make INFO SYSTEM-STATUS display scheduler bias-control
;<4.EXEC>EXECIN.MAC.79, 22-Nov-78 12:54:39, EDIT BY KIRSCHEN
;REMOVE INFO DECNET STATUS, MAKE INFO DECNET NODES DEFAULT
;<4.EXEC>EXECIN.MAC.78,  8-Nov-78 16:06:08, EDIT BY HEMPHILL
;ALLOW WILDCARDS IN HLP: DEFINITION TO WORK BY ADDING GJ%IFG AT
; HLP3
;<4.EXEC>EXECIN.MAC.77, 26-Oct-78 16:03:38, EDIT BY OSMAN
;REMOVE REFS TO GSSBLK (USE LOCAL ISBLK INSTEAD)
;<4.EXEC>EXECIN.MAC.76, 25-Oct-78 16:29:32, EDIT BY OSMAN
;PRINT OUT LOGICAL LOCATION IN JOBSTAT (.JOBST)
;<ARC-DEC>EXECIN.MAC.6, 11-Oct-78 12:31:07, EDIT BY CALVIN
; Add INFO RETRIEVE-REQUESTS
;[BBN-TENEXD]<CALVIN>EXECIN.MAC.1,  8-Aug-78 11:20:29, Ed: CALVIN
; Install code for INFO ARCHIVE-STATUS command
;<3-ARC-EXEC>EXECIN.MAC.2, 14-May-78 20:38:35, Edit by MTRAVERS
;<3-ARC-EXEC>EXECIN.MAC.1, 14-May-78 15:40:28, Edit by MTRAVERS
; Added INFO ARCHIVE-STATUS to command table
;<4.EXEC>EXECIN.MAC.74, 13-Oct-78 10:55:15, EDIT BY OSMAN
;ADD INFO MOUNT-REQUESTS
;<4.EXEC>EXECIN.MAC.73, 10-Oct-78 09:56:15, EDIT BY R.ACE
;FIX BUG IN MT DEVICE DISPLAY FIX
;<4.EXEC>EXECIN.MAC.72, 29-Sep-78 15:39:33, EDIT BY R.ACE
;Make INF AVAIL DEV ;<4.EXEC>EXECIN.MAC.71, 28-Sep-78 15:21:48, EDIT BY
;   KIRSCHEN 
;ADD TEST FOR ILLEGAL FUNCTION AT DNTOPE, ALSO MERELY RETURN
;<4.EXEC>EXECIN.MAC.70, 28-Sep-78 15:05:29, EDIT BY KIRSCHEN
;AVOID !DISABLED! IN INFO TERM AT WRONG TIME
;<4.EXEC>EXECIN.MAC.69, 28-Sep-78 14:54:11, EDIT BY KIRSCHEN
;REMOVE IFN CONDITIONAL FROM .DNSTS
;<4.EXEC>EXECIN.MAC.68, 27-Sep-78 20:19:51, EDIT BY OSMAN
;GET RID OF Bn SYMBOLS
;<4.EXEC>EXECIN.MAC.64, 16-Sep-78 00:01:02, EDIT BY OSMAN
;GET RID OF REFS TO CSBUFP
;<4.EXEC>EXECIN.MAC.60, 14-Sep-78 14:14:00, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECIN.MAC.59,  7-Sep-78 15:21:37, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.58,  7-Sep-78 15:19:15, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.57,  7-Sep-78 15:18:00, EDIT BY HELLIWELL
;ADD " !DISABLED!" AFTER "TERMINAL PAUSE (ON) END-OF-PAGE" IF "TERMINAL NO
;   PAUSE (ON) COMMAND" 
;<4.EXEC>EXECIN.MAC.56,  1-Sep-78 22:17:05, EDIT BY OSMAN
;PUT IN VT100 STUFF
;<4.EXEC>EXECIN.MAC.55, 28-Aug-78 19:12:24, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.54, 28-Aug-78 19:04:19, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.53, 28-Aug-78 18:55:49, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.52, 28-Aug-78 18:53:07, EDIT BY HELLIWELL
;CHANGE "INFO TERMINAL" TO REFLECT "TERMINAL PAUSE"
;<4.EXEC>EXECIN.MAC.51, 25-Aug-78 17:05:05, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.50, 24-Aug-78 16:22:38, EDIT BY HELLIWELL
;REFORMAT "INFO  DECNET NODES" TYPEOUT
;<4.EXEC>EXECIN.MAC.49, 23-Aug-78 11:48:32, EDIT BY HELLIWELL
;PLACE MANY NODE NAMES ON SAME LINE IN "INFO DECNET NODES"
;<4.EXEC>EXECIN.MAC.48, 23-Aug-78 08:12:26, EDIT BY KIRSCHEN
;FIX INFO DECNET NODES
;<4.EXEC>EXECIN.MAC.47, 21-Aug-78 16:47:56, EDIT BY HELLIWELL
;REMOVE "INFO EDITOR"
;<4.EXEC>EXECIN.MAC.46, 16-Aug-78 17:16:46, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.45, 16-Aug-78 17:12:10, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.44, 16-Aug-78 17:02:26, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.43, 16-Aug-78 17:01:18, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.42, 16-Aug-78 14:16:38, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.41, 16-Aug-78 14:10:19, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.40, 16-Aug-78 13:43:26, Edit by HELLIWELL
;CHANGE "INFO NETWORK-STATUS" TO "INFO ARPANET" AND "INFO DECNET"
;<4.EXEC>EXECIN.MAC.39, 16-Aug-78 11:34:43, EDIT BY OSMAN
;FIX "INFO LOG" (GETTER CLOBBERS B)
;<4.EXEC>EXECIN.MAC.38, 16-Aug-78 11:24:09, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.37, 16-Aug-78 11:13:47, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.36, 13-Aug-78 15:42:42, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.35, 13-Aug-78 15:36:26, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.34, 13-Aug-78 14:55:02, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.33, 13-Aug-78 14:50:48, Edit by HELLIWELL
;ADD "INFO EDITOR"
;<4.EXEC>EXECIN.MAC.32, 10-Aug-78 11:28:39, EDIT BY OSMAN
;ALLOW WILDCARDING ON INFO DISK
;<4.EXEC>EXECIN.MAC.25, 28-Jul-78 13:50:21, EDIT BY OSMAN
;CHANGE "COMPILER-SWITCHES" TO "COMPILE-SWITCHES"
;<4.EXEC>EXECIN.MAC.22, 27-Jul-78 15:39:08, EDIT BY OSMAN
;<4.EXEC>EXECIN.MAC.21, 27-Jul-78 14:41:37, EDIT BY OSMAN
;allow "info logical-name foo:"
;<4.EXEC>EXECIN.MAC.20, 18-Jul-78 17:18:36, EDIT BY OSMAN
;MAKE HELP COMMAND SET UP Q1, AND CALL GTJFS
;<4.EXEC>EXECIN.MAC.19, 13-Jul-78 14:44:44, EDIT BY OSMAN
;CHANGE TAG DSKCN1 TO 0
;<4.EXEC>EXECIN.MAC.18, 13-Jul-78 14:33:48, EDIT BY OSMAN
;MAKE SIZCN1, SIZCN2, PAGFL1, PAGFL2 BE LOCAL (DSKCN1, ...)
;<4.EXEC>EXECIN.MAC.17, 11-Jul-78 16:21:40, EDIT BY OSMAN
;MAKE INFO LOGICAL NAMES AND INFO MAIL USE LOCAL VARIABLES
;<4.EXEC>EXECIN.MAC.16, 29-Jun-78 15:29:39, EDIT BY OSMAN
;make "alias" part of trvar
;<4.EXEC>EXECIN.MAC.15, 27-Jun-78 16:09:57, EDIT BY OSMAN
;CHANGE ALL THE GTB'S TO BE IMMEDIATE
;<4.EXEC>EXECIN.MAC.14, 23-Jun-78 21:26:42, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: CHKDLX, MMAP, .TE
;<4.EXEC>EXECIN.MAC.13, 14-Jun-78 14:53:19, EDIT BY OSMAN
;ADD INFO DEFAULTS
;<4.EXEC>EXECIN.MAC.11,  9-Jun-78 18:08:15, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<3-EXEC-SNARK>EXECIN.MAC.50, 20-Apr-78 11:22:28, Edit by FORTMILLER
;<4.EXEC>EXECIN.MAC.9, 17-Jan-78 10:13:30, EDIT BY HELLIWELL
;RELEASE JFNS AFTER DSKCNT IN INFO DISK COMMAND
;<4.EXEC>EXECIN.MAC.8,  6-Jan-78 17:06:56, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.7,  6-Jan-78 17:04:15, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.6,  6-Jan-78 17:02:00, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.5,  6-Jan-78 16:53:38, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.4,  6-Jan-78 16:48:02, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.3,  6-Jan-78 16:47:19, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.2,  6-Jan-78 16:30:23, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.1,  6-Jan-78 16:15:43, EDIT BY HELLIWELL
;MAKE INFO DISK DO * & %
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE

;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 EXECIN
	GLXSCH			;SEARCH GALAXY UNV'S

;THIS FILE CONTAINS INFORMATION COMMANDS
;   EXCEPT INFORMATION (ABOUT) BATCH-REQUESTS AND
;   INFORMATION (ABOUT) OUTPUT-REQUESTS, WHICH ARE IN EXECQU.MAC

;PRINT STATUS (IN TERMS OF THE ARCHIVE) OF FILES

.ARSTS::NOISE <of files>
	TXO Z,IGINV		;FIND INVISIBLE ONES TO BOOT
	MOVE A,[[ASCIZ/*/],,[ASCIZ/*/]] ;DEFAULT NAME & EXT IS *
	HRLI B,-3		;DEFAULT VERSION IS *
	HRRI B,(GJ%OLD!GJ%IFG!GJ%NS!CF%GRP!CF%EOL!CF%NS)
	CALL SPECFN
	 JRST CERR		;NO "STUFF,"
	SETOM TYPGRP		;ALWAYS TYPE NAME
	MOVE A,COJFN
	MOVEM A,OUTDSG
	MOVE A,JBUFP
	MOVEM A,.JBUFP
ARSTS3:	CALL RLJFNS
	CALL NXFILE
	 JRST ARSTS4
	CALL MFINP		;GET 2ND JFN
	 JRST ARSTS4		;FAILED
	CALL ARSTS		;PRINT STATUS
ARSTS4:	SKIPE INIFH1		;DONE THEM ALL?
	JRST ARSTS3		;NO, LOOP
	RET

ARSTS::	TLZ Z,F2		;COMMA FLAG
	MOVE B,[1,,.FBCTL]
	MOVEI C,D
	GTFDB
	 ERJMP [HRROI B,[ASCIZ / Tape information not available/]
		CALL ARPNT
		RET]
	MOVE B,[1,,.FBBBT]
	MOVEI C,C
	GTFDB
	EXCH C,D		;SWAP 'EM
	TXNN C,FB%ARC		;FILE HAVE ARCHIVE STATUS?
	 JRST ARSTS1		;NO
	HRROI B,[ASCIZ/ Archive status is not valid/]
	TXNE D,AR%1ST
	 CALL ARPNT
	HRROI B,[ASCIZ/ Archived/]
	TXNE D,AR%RAR		;REQUEST TOO? (ARCHIVE IN PROGRESS?)
	 HRROI B,[ASCIZ/ Archive in progress/]
	TXNN D,AR%1ST
	 CALL ARPNT
	HRROI B,[ASCIZ/ Migration requested/]
	TXNE D,AR%RIV
	 CALL ARPNT
NONE:	TLOE Z,F2		;PRINT ANYTHING?
	 ETYPE <%_>		;YES, END WITH CRLF
	RET

ARSTS1:	TXNN D,AR%RAR!AR%EXM!AR%RIV ;ANYTHING WE'VE AN INTEREST IN?
	 JRST NONE		;NO
	HRROI B,[ASCIZ/ Archive requested/]
	TXNE D,AR%RAR
	 CALL ARPNT
	HRROI B,[ASCIZ/ Retain contents/]
	TXNE D,AR%NDL
	 CALL ARPNT
	HRROI B,[ASCIZ/ Migration prohibited/]
	TXNE D,AR%EXM
	 CALL ARPNT
	HRROI B,[ASCIZ/ Migration requested/]
	TXNE D,AR%RIV
	 CALL ARPNT
	JRST NONE

ARPNT:	TLON Z,F2		;NEED <COMMA><SPACE>?
	 JRST  [ETYPE < %1S>	;PRINT THE FILE NAME
		JRST .+2]	;AND DON'T DO THE COMMA
	TYPE <, >
	UTYPE (B)		;TYPE THE STRING
	RET
.AVAIL::KEYWD $AVAIL
	 T devices		;[TAH] CHANGE DEFAULT TO DEVICES
	 JRST CERR
	JRST (P3)		;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN
				;   TABLE 

$AVAIL:	TABLE
	T devices
	T lines,,..TERM
	TA t			;"T" = "TERMINALS"
	IT teletypes,,..TERM
.T:	IT terminals,,..TERM
	IT ttys,,..TERM
	TEND

;AVAILABLE TERMINALS

..TERM::CONFIRM
	HLLZ D,TTYJOB		;SET UP NUMBER OF TERMINAL LINES
TERMI1:	HRRZI A,.TTDES(D)	;TERMINAL DESIGNATOR
	DVCHR			;GET ITS STATUS
	TXNN B,DV%AV		;IS IT AVAILABLE
	 JRST TERMI9		;NO - TRY NEXT
	CALL BEFORE		;TYPE COMMA OR MAYBE EOL
	HRRZ B,D
	CALL TOCT		;TYPE LINE NUMBER

;SEE IF SEVERAL CONSECUTIVE LINES TO BE GROUPED, E.G. 21-26
	PUSH P,D		;SAVE ONE JUST TYPED
	AOBJN D,TERMI7		;PEEK AT NEXT ONE
	POP P,D			;NO MORE, WRAP UP
	JRST TERMI9

TERMI7:	HRRZI A,.TTDES(D)	;FORM TERM DESIGNATOR
	DVCHR			;GET CHARACTERISTICS
	TXNE B,DV%AV		;AVAILABLE?
	 AOBJN D,TERMI7		;YES, KEEP LOOKING
	POP P,C			;FOUND NOT AVAIL OR AND OF LIST
	SUB D,[1,,1]		;GET BACK TO LAST AVAIL ONE FOUND
	CAMN D,C		;SAME AS LAST ONE PRINTED?
	 JRST TERMI9		;YES, NO GROUPING TO BE DONE
	PRINT "-"		;FIRST OF GROUP HAS BEEN PRINTED, NOW
	HRRZ B,D		;   PRINT DASH AND LAST OF GROUP
	CALL TOCT
TERMI9:	AOBJN D,TERMI1
	TLNN Z,F1
	 TYPE < All lines in use>
EOLRET::ETYPE <%_>		;COME HERE TO TYPE CRLF AND POPJ.
	RET
;AVAILABLE DEVICES - DOES NOT LIST TTYS
;   ALSO LISTS SEPERATELY DEVICES ALREADY ASSIGNED TO THIS JOB.

.DEVIC::CONFIRM
	TLZ Z,F1!F2		;SAY NOTHING TYPED YET
	MOVEI P3,-3		;SAY NO PREVIOUS GROUP ITEM
	SETZ Q1,		;LAST DEVICE NAME PRINTED

;"DEVLUP" EXECUTES CALLER+1 FOR EACH DEVICE, WITH NAME IN A, DVCHR WORD IN B.
	CALL DEVLUP
	 CALL DEVIC1		;DO THIS FOR EACH DEVICE
	TLZE Z,F2		;GROUP STARTED?
	 CALL AVD1		;YES, FINISH IT
	TLNN Z,F1
	 TYPE <No devices currently available to this job>
	ETYPE <%_>
	JRST ASTTJ		;LIST DEVS ASSIGNED TO THIS JOB. WITH FILSTAT.

DEVIC1:	STKVAR <DEISO,DENAME,DECHR>
	MOVEM A,DENAME		;SAVE NAME
	MOVEM B,DECHR		;SAVE CHARACTERISTICS
	TXNN B,DV%AV		;SKIP IF DEVICE AVAILABLE TO THIS JOB
	 RET
	LDB C,[POINTR B,DV%TYP]	;GET DEVICE TYPE
	CAIN C,.DVTTY		;SKIP TTYS
	 RET
	AND B,[DV%TYP!777777]	;MASK TO JUST DEVICE TYPE AND UNIT #
	CAIN C,.DVDSK		;A MOUNTABLE STRUCTURE (DISK)?
	 JRST DEVIC9		;YES, ALWAYS SEPERATE
	CALL ISONAM		;ISOLATE THE NAME OF THIS DEVICE
	MOVEM A,DEISO		;REMEMBER ISOLATED NAME
	MOVE A,Q1		;GET PREVIOUS DEVICE NAME
	CALL ISONAM		;ISOLATE ITS NAME TOO
	CAME A,DEISO		;ARE WE ON SUBSEQUENT UNIT OF SAME DEVICE?
	 JRST DEVIC9		;NO, CAN'T POSSIBLY BE IN SEQUENCE. WHY ALL THE
				;   BRUHAHA, YOU MUST ASK! WELL AT THIS TIME
				;   (10/26/76), PPLT0: AND PLT0: ETC. YIELD
				;   EXACT SAME DEVICE DESIGNATOR
	MOVE C,P3		;SEE IF DEVICE IS NEXT IN SEQUENCE
	HRRI C,1(C)		;18BIT ADD
	CAMN C,DECHR		;NEXT UNIT OF SAME DEVICE?
	 JRST  [TLO Z,F2	;YES, NOTE GROUP BEING PROCESSED
		MOVE P3,DECHR	;UPDATE UNIT NUMBER
		MOVE Q1,DENAME	;REMEMBER NEW LAST NAME
		RET]
DEVIC9:	TLZE Z,F2		;NOT IN SEQUENCE, PREVIOUS SEQUENCE?
	 CALL AVD1		;YES, FINISH IT
	MOVE P3,DECHR		;REMEMBER LAST DEVICE PRINTED
	MOVE Q1,DENAME		;REMEMBER NAME PRINTED
	TLNN Z,F1		;FIRST ONE?
	 ETYPE <Devices available to this job:%_>
	CALL BEFORE		;DO SEPARATING CHARACTER
	MOVE A,DENAME
	CALLRET SIXPRT		;PRINT NAME AND RETURN

;ISONAM - TAKES A SIXBIT DEVICE NAME, AND RIGHT-JUSTIFIES IT WITHOUT ITS UNIT
;   NUMBER. 
;
;   ACCEPTS:	A/	SIXBIT NAME, LIKE LPT34
;   RETURNS+1:	A/	NAME ONLY, LIKE LPT
ISONAM:	LDB B,[POINT 6,A,5]	;GET FIRST CHARACTER
	CAIL B,'0'		;DOES NAME START WITH A DIGIT?
	 CAILE B,'7'
	  ABSKP			;NO
	   RET			;YES, SO ASSUME NO UNIT NUMBER
ISO1:	LSHC A,-6		;GET RIGHTMOST CHARACTER INTO B
	LSH B,-<44-6>		;ISOLATE THE CHARACTER
	JUMPE B,ISO1		;IF SPACE, WE'RE ON TRAILING SPACES OF SHORT
				;   NAME 
	CAIL B,'0'		;ON UNIT NUMBER?
	 CAILE B,'7'
	  ABSKP			;NO
	   JRST ISO1		;YES, KEEP SHIFTING
	LSH A,6			;WE WENT ONE CHARACTER TOO FAR, FIX IT
	IOR A,B
	RET

AVD1:	PUSH P,B
	MOVEI B,"-"		;FINISH UP GROUP
	CALL COUTC
	MOVE B,P3		;GET LAST DEVICE DESIGNATOR
	TLC B,.DVMTA
	TLZN B,777777		;MAGTAPE DEVICE?
	 TRZ B,400000		;YES, CLEAR B18 IN CASE IT'S AN MT
	CALL TOCT		;PRINT IT
	POP P,B
	RET

;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE. USED FOR
;   AVAILABLE TERMINALS, AVAILABLE DEVICES, AND FILSTAT. BEFORE EACH ITEM:
;   COMMA EXCEPT CRLF IF TOO FAR TO RIGHT. 
;
;   ACCEPTS:	Z/	F2 ON TO GET TAB BETW ITEMS, OFF TO GET A SPACE
BEFORE::ATSAVE
	MOVE A,COJFN
	MOVX B,.MORLW
	MOVX C,^D72		;USE 72 COLUMNS IF NOT A TERMINAL
	MTOPR			;GET LINE WIDTH
	 ERNOP			;IF NOT, USE 72 (PRESUMABLY NOT A TERMINAL)
	RFPOS
	MOVEI B,(B)		;MASK COLUMN POSITION
	CAIL B,-11(C)		;WITHIN 9 CHARS OF END OF LINE?
	 JRST BEFOR1		;YES, START NEW LINE AND RETURN
	TLNE Z,F2		;WANT A TAB BETWEEN ENTRIES?
	 JRST BEFOR0		;YES - GO DO IT
	TLOE Z,F1		;NO - FOR FIRST ENTRY JUST OUTPUT A SPACE
	 PRINT ","		;ELSE OUTPUT A COMMA AND SPACE
	PRINT " "
	RET

BEFOR0:	PRINT TAB		;PRINT A TAB BETWEEN ENTRIES
	RET

BEFOR1:	TLNN Z,F2		;PUTTING A TAB BETWEEN ENTRIES?
	 PRINT ","		;NO - END LINE WITH A COMMA
	ETYPE <%_ >		;EITHER WAY, START A NEW LINE
	RET
;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT".
;   FOR EACH DEVICE, EXECUTES LOCATION 
;
;   RETURNS: +2	A/	SIXBIT NAME
;		B/	LH CONTAINS DEVICE CHARACTERISTICS WORD
;			RH UNIT NUMBER 
;		C/	-1 OR JOB # ASSIGNED TO 
;		D/	DEVICE DESIGNATOR
DEVLUP::SETO D,
	GTB .DEVNA		;GET # DEVICES FROM TABLE 6
	HRLZ D,A		;XWD AOBJN COUNT, TABLE INDEX
DEVL1:	PUSH P,D
	CALL .DVCHR		;GET DEVICE CHARACTERISTICS
	 JRST DEVL2		;SKIP THIS ONE IF UNKNOWN DEVICE
	MOVE D,A		;GIVE GUY DEVICE DESIGNATOR IN D
	HRR B,C			;GET UNIT NUMBER
	HLRE C,C
	EXCH D,(P)		;SAVE DESIGNATOR, GET INDEX INTO DEVICE TABLE
	GTB .DEVNA		;GET DEVICE NAME IN SIXBIT FROM TABLE 6
	EXCH D,(P)		;SAVE INDEX, GET DESIGNATOR
	JUMPE A,DEVL2		;SKIP NULL ENTRIES
	XCT @-1(P)
DEVL2:	POP P,D
	AOBJN D,DEVL1
	RETSKP

;TYPE SIXBIT SYMBOL FROM A.
;   USED IN "AVAILABLE DEVICES", "SYSTAT", "STATISTICS", AND "FILSTAT".
SIXPRT::ATSAVE
	MOVE C,A
SIXPR1:	SETZ B,
	LSHC B,6
	ADDI B,40
	CALL COUTC
	JUMPN C,SIXPR1
	RET

;ROUTINE DOES DVCHR
;
;   ACCEPTS:	D/	DEVICE INDEX
;   RETURNS: +1 	NO SUCH DEVICE
;	     +2 A,B,C/	DVCHR'S INFO
.DVCHR:	PUSH P,P1		;WE'LL NEED THESE, BUT DON'T HURT THEM
	PUSH P,P2
	GTB .DEVNA		;GET SIXBIT NAME INTO A
	MOVE B,[POINT 6,A]	;PREPARE TO READ THE SIXBIT NAME FROM A
DV1:	TLNN B,770000		;ARE WE DONE?
	 JRST DV2		;YES, GO LEFT-JUSTIFY
	ILDB C,B		;GET SIXBIT CHARACTER FROM NAME
	CAIE C,0		;LEAVE 0'S AS 0'S!
	 ADDI C,"A"-'A'		;CHANGE TO ASCII
	LSHC P1,7		;MAKE ROOM FOR THE CHARACTER
	IOR P2,C		;PUT IN THE CHARACTER
	JRST DV1		;GO DO NEXT CHARACTER

DV2:	LSHC P1,2*^D36-6*7-1	;LEFT JUSTIFY
	LSH P1,1		;^D36=1(MOD 5*7)
	HRROI A,P1		;POINT TO THE ASCII NAME OF THE DEVICE
	STDEV			;GET A DEVICE DESIGNATOR FOR THIS DEVICE
	 ERJMP DEVOUT		;JUST RETURN IF CAN'T
	MOVE A,B		;PUT DESIGNATOR IN A
	DVCHR			;GET CHARACTERISTICS
	AOS -2(P)		;WE WANT TO SKIP RETURN
DEVOUT:	POP P,P2
	POP P,P1
	RET
;HELP *, HELP <CR>, HELP FOO

NOOZ,<
.HELP::	STKVAR <<HLPBUF,FILWDS>,HITEM>
	NOISE <on subject>
	CALL MAKLST		;MAKE LIST OF THINGS THERE'S HELP ON
	MOVEI B,[FLDDB. .CMKEY,,$HELP.,,,[
		FLDDB. .CMCFM,,,,,]]
	CALL FLDSKP		;GET SOME INPUT
	 CMERRX <Invalid HELP request, try "HELP<RET>">
	GTFLDT C		;SEE WHAT GOT TYPED
	CAIN C,.CMCFM		;CR?
	 JRST BLURB		;YES, GO TYPE GENERAL HELP BLURB
	CONFIRM			;GET COMMAND CONFIRMATION
				;TCO#4.2475
DELETE,<CAIN C,.CMTOK		;*?
	 JRST TYPLST		;YES, TYPE OUT THE LIST
       >
	MOVEM B,HITEM		;SAVE POINTER TO ITEM HELP DESIRED ABOUT
	HRROI A,HLPBUF		;PREPARE TO CREATE FILENAME STRING
	HRROI B,[ASCIZ/HLP:/]
	SETZ C,			;WE WANT NULL AFTER FILENAME
	SOUT			;PUT IN DEVICE NAME
	MOVE B,HITEM		;GET POINTER TO FILENAME STRING
	HLRO B,(B)		;MAKE BYTE POINTER
	SOUT			;PUT IN FILENAME
	HRROI B,[ASCIZ/.HLP/]	;NOW WE'LL HAVE HLP:MUMBLE.HLP
	SOUT
	HRROI B,HLPBUF		;POINTER TO FILENAME
HLP3:	MOVX A,GJ%OLD!GJ%SHT!GJ%IFG ;OLD FILE ONLY, SHORT FORM
	CALL GTJFS		;GET HANDLE ON HELP FILE
	 ERROR <No help available on that subject>
	MOVX Q1,CP%HEL		;SO "TYPE" LOGIC WILL KNOW IT'S US
	MOVE A,JBUFP		;GET POINTER TO JFN CELL
	HRRZM A,INIFH1
	HRRZM A,INIFH2		;COPY CODE NEEDS THIS
	JRST TYPE1		;FINISH COMMAND BY COPYING HELP FILE TO
				;   TERMINAL 

;HELP<CR> JUST TYPES OUT "HLP:HELP.HLP"

BLURB:	HRROI B,[ASCIZ /HLP:HELP.HLP/]
	JRST HLP3		;GO TYPE OUT CONTENTS OF FILE

;HELP * LISTS ALL SUBJECTS FOR WHICH HELP IS AVAILABLE

DELETE,<			;TCO#4.2475
TYPLST:	HLRZ Q1,$HELP.		;GET NUMBER OF ENTRIES FOR WHICH THERE'S HELP
	JUMPE Q1,NOHELP		;SPECIAL CASE IF NONE
	ETYPE <Help is available on these subjects:%_>
	SETZ Q2,		;KEEPS TRACK OF HOW MANY ITEMS WE'VE PRINTED ON
				;   THIS LINE 
	MOVN Q1,Q1
	HRLZ Q1,Q1		;MAKE AOBJN POINTER
LST1:	TRNN Q2,7		;ENOUGH ITEMS BEEN PRINTED YET?
	 ETYPE <%_>		;YES, START NEW LINE
	HLRO A, $HELP.+1(Q1)	;GET ASCII POINTER TO ENTRY
	ETYPE <%1M	>	;TYPE ENTRY WITH TAB AFTER IT
	AOJ Q2,			;COUNT ITEMS ON LINE
	AOBJN Q1,LST1		;LOOP FOR REST OF ITEMS
	ETYPE <%_>		;FINISH WITH CARRIAGE RETURN
	JRST ENDHLP		;DONE
       >

NOHELP:	ETYPE <No help available%_>
	JRST ENDHLP

;DONE DOING HELP COMMAND, CLEAN UP AND RETURN
ENDHLP:	RET			;RETURN

;SPECIAL BUFFER ASSIGNMENTS FOR HELP COMMAND
	$HELP.==BUF0		;TABLE OF HELP CATEGORIES
	HLPLEN==BUF1-BUF0-1	;MAXIMUM NUMBER OF SUBJECTS AVAILABLE

;ROUTINE TO MAKE LIST OF SUBJECTS THERE'S HELP ON. THE LIST IS GENERATED BY THE
;   FILENAMES OF ALL THE .HLP FILES ON THE HLP: DEVICE.
MAKLST:	MOVX A,HLPLEN		;MAXIMUM LENGTH OF TABLE
	MOVEM A,$HELP.		;INITIALIZE TABLE OF ITEMS THERE'S HELP ON
	HRROI Q1,BUF1		;INITIALIZE POINTER TO NAME STORAGE AREA
	HRROI B,[ASCIZ/HLP:*.HLP/] ;HANDLE ON HELP FILES
	CALL HLPLST		;ACCUMULATE HELP FILE NAMES IN TABLE
	RET

;ROUTINE TO ACCUMULATE HELP FILE NAMES IN TABLE
HLPLST:	STKVAR <HLPJFN>		;HOLDS JFN OF HELP FILES
	MOVX A,GJ%OLD!GJ%IFG!GJ%SHT ;OLD FILE ONLY, ALLOW STARS, SHORT FORM
	CALL GTJFS		;GET AND STACK JFN
	 RET			;NO HELP FILES
	MOVEM A,HLPJFN		;REMEMBER THE JFN
HLP2:	MOVE A,Q1		;POINTER TO AREA IN WHICH TO STORE NAME
	HRRZ B,HLPJFN		;GET JFN OF HELP FILE
	MOVX C,FLD(.JSAOF,JS%NAM) ;WE WANT JUST THE FILENAME
	JFNS			;GET FILENAME (ENTRY FOR TABLE)
	MOVEI A,BUF0		;TELL SYSTEM WHERE TABLE BEGINS
	HRLZ B,Q1		;GET ENTRY FOR TABLE (POINTS TO FILENAME)
	TBADD			;PUT NEW ENTRY IN TABLE
	ADDI Q1,^D16		;POINT TO NEXT FILENAME ENTRY
	MOVE A,HLPJFN		;GET JFN AGAIN
	GNJFN			;STEP TO NEXT HELP FILE
	 ERJMP R		;NO MORE IN THIS SET
	JRST HLP2		;GOT ANOTHER, GO PROCESS IT
>;NOOZ
OZ,<				;1020 STANFORD/LOTS HELP FACILITY
$HELP.==FREE			;1020 ADDRESS OF HELP KEYWORD TABLE

.HELP::	NOISE (on subject)	;MAKE SOME NOISE
	CALL HLPKEY		;LOAD UP HELP KEYWORD TABLE, IF ANY
	MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<RETURN for general help>,,[
	         FLDDB. .CMTOK,CM%SDH,<-1,,[asciz/*/]>,<* to see a complete list of topics
  or the name of an EXEC command>,,[
		 FLDDB. .CMKEY,,$HELP.,,,[
		 FLDDB. .CMFLD,CM%SDH]]]] ;MANY OPTIONS NORMALLY
	SKIPN $HELP.		;SKIP IF WE FOUND THE KEYWORD TABLE
	 MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<RETURN for general help>,,[
		  FLDDB. .CMFLD,CM%SDH,,<HELP topic>]] ;MINIMAL HELP AVAILABLE
	CALL FLDSKP		;GET SOME INPUT
	 CMERRX <Invalid HELP request, try "HELP<RETURN>">
	LDB C,[POINT 9,(C),8]	;SEE WHAT GOT TYPED
	CAIN C,.CMCFM		;CONFIRMATION?
	 JRST HELP0		;YES, FIRE UP HELP PROGRAM
	CONFIRM			;NO, WAIT FOR CONFIRMATION
HELP0:	HRROI B,[GETSAVE (SYS:HELP.)] ;RUN STANFORD HELP PROGRAM
	CALL TRYGTJ
	 ERROR <No HELP facility at this site>
	CALLRET STEPH

;HLPKEY - MAP IN THE HELP KEYWORD TABLE USED BY THE HELP PROGRAM
;RETURNS +1 ALWAYS

HLPBIN:	ASCIZ "HLP:HELP.BIN"
NLIBIN:	ASCIZ "HLP:NOT-LOGGED-IN-HELP.BIN"

HLPKEY:	SETZM $HELP.		;CLEAR THE TABLE HEADER
	MOVX A,GJ%SHT+GJ%OLD	;A/ LOOKING FOR AN EXISTING FILE
	HRROI B,HLPBIN		;B/ FILE SPEC
	SKIPN CUSRNO		;logged in?
	  HRROI B,NLIBIN	;  nope, so use this file.
	GTJFN%			;GET A HANDLE ON THE FILE
	 ERJMP [SKIPE CUSRNO	;Didn't find it, but were we looking for the
		  RET		;NLI one?  Nope, so really didn't find it.
		MOVX A,GJ%SHT+GJ%OLD
		HRROI B,HLPBIN	;Yes, so look for the usual one.
		GTJFN%
		  RET		;Oops, not there either.
		JRST .+1]	;Found it, so carry on.
	MOVE D,A		;SAVE JFN
	MOVE B,[44B5+OF%RD]	;FULL WORD, READ ACCESS
	OPENF%			;OPEN THE FILE
	 ERJMP [MOVE A,D
		RLJFN%
		  JFCL
		RET]		;ON ERROR, RELEASE JFN AND RETURN
	SIZEF%			;GET FILE SIZE
	 ERJMP HLPKE0		;SOME ERROR
	MOVEI A,$HELP.(B)	;POINTER TO NEW START ADDRESS OF FREE SPACE
	MOVEM A,DICT		;STORE IT 
	MOVEI A,FRESIZ		;NUMBER OF WORDS IN TOTAL FREE SPACE
	SUBI A,1(B)		;LESS THE NUMBER WE'RE USING
	MOVSM A,@DICT		;STORE NEW FREE SPACE HEADER
	MOVE A,D		;A/ INPUT FILE
	MOVN C,B		;C/ SET UP BYTE COUNT
	MOVE B,[POINT 36,$HELP.] ;B/ DESTINATION
	SIN%			;READ IN THE FILE
	 ERJMP .+1		;IGNORE ANY ERRORS
	MOVE A,[XWD $HELP.,$HELP.] ;A/ OFFSETS
	HLRZ B,$HELP.		;FETCH NUMBER OF ENTRIES
	MOVNS B			;NEGATE
	MOVSS B			;SWAP SIDES
	HRRI B,$HELP.+1		;B/ FINISH BUILDING AOBJN POINTER
	ADDM A,(B)		;FIXUP
	AOBJN B,.-1		;LOOP OVER ENTIRE TABLE
HLPKE0:	MOVE A,D		;RETRIEVE JFN
	CLOSF%			;CLOSE THE FILE
	 JFCL			;IGNORE AN ERROR
	RET			;RETURN TO CALLER
>;OZ
;INFO (ON)

.INFOR::NOISE <about>
	TRVAR <TERMNL,TRAPC,RFERR,RFINFO>
	SKIPE CUSRNO		;720 logged in?
	 JRST INFOR1		;720 yes
	KEYWD $INFO0		;720 no
	 0			;720
	 JRST CERR		;720
	JRST (P3)		;720

INFOR1: SKIPN SIMPLE		;7 simple command level?
	 JRST INFOR2		;7 no
	KEYWD $INFOS		;7 yes
	 0			;7
	 JRST CERR		;7
	JRST (P3)		;7

INFOR2:	KEYWD $INFO		;7 normal command level
	 0			;7
	 JRST CERR		;7
;720	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
;720	 SKIPE CUSRNO		;YES, ARE WE?
	  JRST (P3)		;OK - DISPATCH
;720	ERROR <LOGIN please>
;720	JRST (P3)

;INFO DEFAULTS

.INDEF::NOISE (for)
	KEYWD $DEF		;SEE WHAT TO PRINT DEFAULTS ABOUT
	 T all,ONEWRD,.IDALL	;DEFAULT TO "ALL"
	 CMERRX
	JRST (P3)		;GO DO IT
;INFO DEFAULTS (FOR) ALL

.IDALL::
ONEON <CDPD,CDRDSW>,<		;713
	CALL .IDC>		;713 OUTPUT DEFAULTS FOR CARDS
	CALL .IDCS		;OUTPUT DEFAULTS FOR COMPILE-SWITCHES
PCLF,<	CALL .IDDCL>		;715 DECLARE defaults
ONEON <PTPD,PTRD>,<		;713
	CALL .IDP>		;713 OUTPUT DEFAULTS FOR PAPER-TAPE
PLTD,<	CALL .IDPL>		;713 OUTPUT DEFAULTS FOR PLOT
LPTD,<	CALL .IDPRT>		;713 OUTPUT DEFAULTS FOR PRINT
	CALL IDPRG1		;OUTPUT DEFAULTS FOR PROGRAM
	CALL .IDS		;OUTPUT DEFAULTS FOR SUBMIT
	CALLRET .IDTAK		;OUTPUT DEFAULTS FOR TAKE, AND RETURN

;INFO DEFAULTS (FOR) PROGRAM (ATTRIBUTES)

.IDPRG::NOISE <attributes>
	CONFIRM
IDPRG1:	MOVE A,FRKDEF		;GET ADDRESS OF DEFAULT FORK BLOCK
	CALLRET IPROG		;PRINT CONTENTS AND RETURN

;INFO DEFAULT TAKE

.IDTAK::HRROI A,[0]		;FIRST ASSUME NO NO
	MOVE B,TAKDEF
	TXNN B,TKECOF		;NO?
	 HRROI A,[ASCIZ/no /]	;YES, NO
	HRRO C,ECHNOI		;POINTER TO NOISE STRING
	ETYPE < set default take %1Mecho (%3M)%_>
	HRROI A,[0]
	TXNN B,TKALEF		;SAME SCHTUCK FOR ALLOW / DISALLOW
	 HRROI A,[ASCIZ/dis/]
	HRRO B,ALONOI
	ETYPE < set default take %1Mallow (%2M)%_>
	RET

;INFORMATION (ABOUT) ADDRESS-BREAK

	ALLFLG==AB%RED!AB%WRT!AB%XCT ;ALL ADDR BREAK BITS

.ADBRK::SKIPG A,FORK		;GET FORK HANDLE
	 JRST  [TYPE < No program>
		RET]
	HRLI A,.ABRED		;FUNCTION TO READ ADDRESS BREAK INFO
	ADBRK			;GET IT
	 ERJMP [CALL DGETER	;GET REASON FOR FAILURE
		CAIE A,ABRKX1	;NOT AVAILABLE ON THIS SYSTEM?
		 CALL CJERR	;OTHER ERROR, DO ERROR MESSAGE
		ETYPE <%%%%1?%%_>;YES, THAT'S THE "INFORMATION"!
		RET]		;DONE
	CAIE C,0		;ANYTHING THERE?
	 TXNN C,ALLFLG		;ANY BITS SET?
	  JRST [TYPE <Address break not set.>
		RET]		;NO
	ETYPE <Address break at %2Y on>
	TXC C,ALLFLG		;FIRST CHECK FOR COMMON CASE OF
	TXCN C,ALLFLG		;ALL BITS BEING SET
	 JRST  [TYPE < all types of references.>
		RET]		;THAT WAS EASY!
	TXNE C,AB%RED		;READ
	 TYPE < read>
	TXNE C,AB%WRT		;WRITE
	 TYPE < write>
	TXNE C,AB%XCT		;EXECUTE
	 TYPE < execute>
	TYPE <.>
	RET			;AND RETURN
;INFORMATION (ABOUT) DIRECTORY (NAME)
;   SAME AS ^EPRINT
;7 move this label to EPRINT code in 4
;7 .INDIR::JRST EPRINT		;USE SAME CODE

;GET HERE ON "INFORMATION (ABOUT) COMMAND-LEVEL"

.EXECM::SKIPN CUSRNO		;7 logged in?
	 JRST INCL6A		;7 no, show aonly things that can be changed
	SKIPE SIMPLE		;7 simple-command-level?
	 JRST INCL7		;7 yes, show only things we can set
NEWF,<	TYPE < set >		;SET AUTOMATIC
	SKIPN IITSET		;TIMER ENABLED?
	 TYPE <no >
	ETYPE <automatic (mail and alert checks)%_>
       >
CEF,<	TYPE < set edit-mode (for command editor to) >	;716 set edit-mode
	SKIPE CEFLAG		;716
	 JRST INCL1		;716
	ETYPE <emacs%_>		;716
	ABSKP			;716
INCL1:	 ETYPE <alter%_>	;716
       >			;716
	TYPE < set fdb-fork-control (for) > ;7 set fdb-fork-control
	SKIPN FDBAK		;7
	 JRST INCL2		;7
	SKIPE FDBEPH		;7
	 JRST INCL3		;7
	ETYPE <autokeep%_>	;7 autokeep
	JRST INCL5		;7

INCL2:	SKIPN FDBEPH		;7
	 JRST INCL4		;7
	ETYPE <ephemeral%_>	;7 ephemeral
	 JRST INCL5		;7

INCL3:	ETYPE <all%_>		;7 all
	ABSKP			;7
INCL4:	 ETYPE <none%_>		;7 none
INCL5:				;7
CEF,<	TYPE < set >		;716 set interrupt-character
	SKIPGE B,CEPSIC		;716
	 TYPE <no >		;716
	TYPE <interrupt-character > ;716
	JUMPL B,INCL6		;716
	TYPE <(for command editor to)> ;716
	CALL POUTCH		;716
	ETYPE <%_>		;716
	ABSKP			;716
INCL6:	 ETYPE <(for command editor)%_> ;716
       >			;716
INCL6A:	TYPE < set >		;SET LATE-CLEAR-TYPEAHEAD
	SKIPN CIDLYF
	 TYPE <no >
	ETYPE <late-clear-typeahead%_>
	SKIPN CUSRNO		;7 logged in?
	 JRST INCL11		;7 no
INCL7:	TYPE < set >		;7 set keep-fork
	SKIPN CCKEEP		;7
	 TYPE <no >		;7
	ETYPE <keep-fork (on CTRL/C)%_> ;7
	TYPE < set >		;7 set lazy-features
	SKIPN LAZFEA		;7
	 TYPE <no >		;7
	ETYPE <lazy-features%_>	;7
	SKIPN LAZFEA		;7 lazy-features?
	 JRST INCL9		;7 no, skip around lazy-restart
	TYPE < set lazy-restart (for) > ;7 set lazy-restart
	SKIPN LAZRES		;7
	 JRST INCL8		;7
	ETYPE <all-forks%_>	;7
	ABSKP			;7
INCL8:	 ETYPE <kept-forks%_>	;7
INCL9:	TYPE < set >		;7 set noisy-forks
	SKIPN NOISY		;7
	 TYPE <no >		;7
	ETYPE <noisy-forks%_>	;7
	SKIPE SIMPLE		;7 simple-command-level?
	 JRST INCL10		;7 yes, skip around things we can't set
	TYPE < set pass-capabilities (mask) >	;7 set pass-capabilities
	MOVE A,CAPMSK		;7
	ETYPE <%1#%%_>		;7
CEF,<	TYPE < set >		;716 set recording
	SKIPN CERECD		;716
	 TYPE <no >		;716
	ETYPE <recording (of commands for command editor)%_> ;716
       >			;716
INCL10:	TYPE < set >		;7 set simple-command-level
	SKIPN SIMPLE		;7
	 TYPE <no >		;7
	ETYPE <simple-command-level%_> ;7
	SKIPE SIMPLE		;7 simple-command-level?
	 RET			;7 yes, we are done
	TYPE < set >		;7 set sticky-file-defaulting
	SKIPN STICKY		;7
	 TYPE <no >		;7
	TYPE <sticky-file-defaulting > ;7
	SKIPLE STICKY		;7
	 ETYPE <per-filespec>	;7 per-filespec
	SKIPGE STICKY		;7
	 ETYPE <per-command>	;7 per-command
	ETYPE <%_>		;7
INCL11:	TYPE < set >		;7 set wake-every-field
	SKIPN WAKFLD		;7
	 TYPE <no >		;7
	ETYPE <wake-every-field%_> ;7
	RET			;7
;"INFORMATION (ABOUT) SYSTEM-STATUS"

SYSINF::MOVX A,.SFOPR
	TMON
	TYPE < Operator is >
	CAIN B,0
	 TYPE <not >
	ETYPE <in attendance%_>
	MOVX A,.SFLCL
	HRROI B,[ASCIZ/ Local logins /]
	CALL TYPALO
	MOVX A,.SFRMT
	HRROI B,[ASCIZ/ Remote (dialup or Rolm data feature) logins /]
	CALL TYPALO
ARPA,<	MOVX A,.SFNVT		;713
	HRROI B,[ASCIZ/ Internet terminal logins /]
	CALL TYPALO
       >			;713
;131 addition
CHA,<	MOVX A,.SFCVT
	HRROI B,[ASCIZ/ Chaosnet terminal logins /]
	CALL TYPALO
	>
DECN,<	MOVX A,.SFMCB
	HRROI B,[ASCIZ/ DECnet terminal logins /]
	CALL TYPALO
	>
;131 end addition
	MOVX A,.SFPTY
	HRROI B,[ASCIZ/ Pseudo-terminal logins /]
	CALL TYPALO
	MOVX A,.SFCTY
	TMON
	TYPE < Console terminal login is >
	CAIN B,0
	 TYPE <not >
	ETYPE <allowed%_>
CHA,<	MOVX A,.SFCHA		;7 show CHAOSnet protection status
	TMON			;7
	TYPE < CHAOSnet access control is > ;7
	CALL INSYED		;7
      >				;7
	MOVX A,.SFFAC
	TMON
	TYPE < Accounting is >
	CAIN B,0
	 TYPE <not >
	ETYPE <being done%_>
	MOVX A,.SFCDE
	TMON
	CAIE B,0
	 ETYPE < CHECKD found errors%_>
	MOVX A,.SFCDR
	CAIE B,0
	 ETYPE < CHECKD is running%_>
	MOVX A,.SFAVR		;SEE IF ACCOUNT VALIDATION IN EFFECT
	TMON
	TYPE < Account validation is >
	CALL INSYED		;TYPE "ENABLED" OR "DISABLED"
	MOVX A,.SFWSP		;SEE IF WORKING SET PRELOADING BEING DONE
	TMON
	TYPE < Working set preloading is >
	CALL INSYED
	MOVX A,.SFMTA		;DISPLAY STATE OF TAPE-DRIVE ALLOCATION
	TMON
	TYPE < Tape-drive allocation is >
	CALL INSYED
	MOVX A,.SFRTW		;SEE IF RETRIEVAL-WAITS ALLOWED
	HRROI B,[ASCIZ/ Automatic file-retrieval-waits /]
	CALL TYPALO		;TYPE WHETHER ALLOWED OR NOT
	MOVX A,.SFMCY		;GET TAPE RECYCLE PERIOD
	TMON
	ETYPE < Maximum offline-expiration is %2q day>
	CAIE B,1
	 PRINT "s"
	ETYPE <%_>
	MOVX A,.SKRBC		;SAY WE WANT CONTROL SETTING
	MOVEI B,C		;ARG BLOCK ADDRESS
	MOVX C,2		;LENGTH OF ARG BLOCK
	SKED%			;GET VALUE OF BIAS SETTING
	ETYPE < Scheduler bias-control setting is %4Q%%_>
	CALL CLSON		;SEE WHAT'S WITH CLASS SCHEDULING
	 JRST  [ETYPE < Class scheduling is disabled>
		TXNE A,SK%DRG	;BATCH ON DREGS
		 ETYPE <, batch jobs being run on dregs queue>
		JRST NOCLS]
	ETYPE < Class scheduling>
	TXNE A,SK%ACT		;SEE IF BY ACCOUNTS
	 ETYPE < by accounts>
	ETYPE < enabled, windfall >
	TXNE A,SK%WDF
	 ETYPE <withheld>
	TXNN A,SK%WDF
	 ETYPE <allocated>
	MOVX A,.SKBCR		;READ BATCH CLASS
	MOVEI B,C		;BLOCK IS IN C
	MOVX C,2		;ALLOCATE ROOM
	SKED%			;GET BATCH CLASS
	CAIL D,0		;IF NEGATIVE, NO BATCH CLASS
	 ETYPE <, batch class %4Q>
NOCLS:	ETYPE <%_>
	CALLRET SYSDWN		;PRINT INFO AND EXIT

;ROUTINE TO DO COMMON WORK FOR INFO SYSTEM-STATUS
;
;   ACCEPTS:	A/	PARAMETER CODE TO LOOK UP
;		B/	POINTER TO STRING TO PRINT OUT
TYPALO:	ETYPE <%2M>		;TYPE TITLE STRING
	TMON			;ASK MONITOR FOR STATUS
	CAIN A,.SFRTW		;FILE RETRIEVAL?
	 TRC B,1		;YES, SENSE IS DIFFERENT THAN ALL OTHERS!
	CAIN B,0
	 TYPE <are not >
	ETYPE <allowed%_>
	RET

;ROUTINE TO REPORT ENABLED/DISABLED 
;
;   ACCEPTS:	B/	#0: ENABLED, 0: DISABLED
INSYED:	CAIE B,0
	 ETYPE <enabled%_>
	CAIN B,0
	 ETYPE <disabled%_>
	RET
;INFORMATION (ABOUT) VOLUMES (NAME) tapesetname:

IVOL::	STKVAR <QID>
	NOISE <of tape>
	DEVX <tape set name, terminated with a colon>
	 CMERRX
	MOVEM B,IPCFP+.MATDV	;PUT DEVICE DESIGNATOR IN MESSAGE
	CONFIRM
	MOVE A,[.MATUS,,.QOMAT]
	MOVEM A,IPCFP+.MSTYP	;SET UP MESSAGE LENGTH AND CODE
	CALL QUASND		;SEND TO QUASAR
	MOVEM A,QID		;SAVE IDENTIFIER
	CALL GQPID		;GET QUASAR'S PID
	MOVE B,QID		;GET IDENTIFIER
	CALL IPCRCV		;RECEIVE RESPONSE
	MOVX A,MF.FAT
	TDNE A,IPCFP+.MSFLG	;FATAL ERROR?
	 UERR IPCFP+.OHDRS+1	;YES, GIVE ERROR MESSAGE
	MOVX A,.TMSET
	CALL FNDATR		;FIND SETNAME
	MOVE A,1(A)		;GET SETNAME
	ETYPE <Volumes of tape set %1': >
	MOVX A,.TMVOL
	CALL FNDATR		;FIND VOLID LIST
	LOAD P1,AR.LEN,(A)	;GET LENGTH OF ENTRY
	MOVNI P1,-1(P1)		;GET NEGATIVE NUMBER OF VOLIDS
	MOVSS P1		;OVER TO LEFT HALF FOR AOBJN PTR
	HRRI P1,1(A)		;POINT RIGHT HALF AT FIRST VOLID
	ABSKP
IVOL1:	 TYPE <,>
	SKIPN A,(P1)		;GET SIXBIT VOLID
	 JRST  [ETYPE <scratch>	;IF VOLID = 0, IT'S A SCRATCH TAPE
		JRST .+2]
	ETYPE <%1'>		;TYPE VOLID
	AOBJN P1,IVOL1
	ETYPE <%_>
	RET

;FNDATR - FIND ENTRY FOR SPECIFIED ATTRIBUTE TYPE
;
;   ACCEPTS:	A/	ATTRIBUTE TYPE
;   RETURNS: +1 A/	ADDRESS OF ENTRY HEADER
FNDATR:	MOVE C,A
	MOVE B,IPCFP+.OARGC	;GET # OF ENTRIES IN LIST
	MOVEI A,IPCFP+.OHDRS	;GET ADDRESS OF HEADER OF 1ST ENTRY
FNDAT1:	LOAD D,AR.TYP,(A)	;GET TYPE OF ENTRY
	CAMN C,D		;MATCH WHAT I WANT?
	 RET			;YES
	LOAD D,AR.LEN,(A)	;NO, GET LENGTH
	ADD A,D			;COMPUTE ADDRESS OF NEXT ENTRY
	SOJG B,FNDAT1		;LOOP THRU ENTRY LIST
	 ERROR <Error in response from QUASAR>
TAPINF::SETO A,
	HRROI B,C
	MOVX C,.JIDEN
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJDN2]
	 MOVEI B,[ASCIZ/200/]
	CAMN C,[.SJDN5]
	 MOVEI B,[ASCIZ/556/]
	CAMN C,[.SJDN8]
	 MOVEI B,[ASCIZ/800/]
	CAMN C,[.SJD16]
	 MOVEI B,[ASCIZ/1600/]
	CAMN C,[.SJD62]		;IS IT 6250 BPI?
	 MOVEI B,[ASCIZ/6250/]	;YES, 6250
	JUMPE B,[ETYPE < Unknown default tape density, value = %3O%%_>
		JRST ILLDEN]
	TYPE < set tape density >
	UTYPE (B)
	ETYPE <%_>
ILLDEN:	SETO A,
	HRROI B,C
	MOVX C,.JIPAR
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJPRE]
	 MOVEI B,[ASCIZ/even/]
	CAMN C,[.SJPRO]
	 MOVEI B,[ASCIZ/odd/]
	JUMPE B,[ETYPE < Unknown default tape parity, value = %3O%%_>
		JRST ILLPAR]
	TYPE < set tape parity >
	UTYPE (B)
	ETYPE <%_>
ILLPAR:	SETO A,
	HRROI B,C
	MOVX C,.JIDM
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJDMC]
	 MOVEI B,[ASCIZ/core-dump/]
	CAMN C,[.SJDMA]
	 MOVEI B,[ASCIZ/ansi-ascii/]
	CAMN C,[.SJDM8]
	 MOVEI B,[ASCIZ/industry-compatible/]
	CAMN C,[.SJDM6]
	 MOVEI B,[ASCIZ/sixbit/]
	CAMN C,[.SJDMH]		;IT IT HIGH DENSITY MODE?
	 MOVEI B,[ASCIZ/high-density/]
	JUMPE B,[ETYPE < Unknown default tape format, value = %3O%%_>
		JRST ILLFMT]
	TYPE < set tape format >
	UTYPE (B)
	ETYPE <%_>
ILLFMT:	SETO A,
	HRROI B,C
	MOVX C,.JIRS
	GETJI
	 CALL JERR
	ETYPE < set tape record-length %3Q%%_>
	RET

SPLINF::SETO A,
	HRROI B,C
	MOVX C,.JIDFS
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJSPD]
	 MOVEI B,[ASCIZ/deferred/]
	CAMN C,[.SJSPI]
	 MOVEI B,[ASCIZ/immediate/]
	JUMPE B,[ETYPE < Unknown spooled-output, value = %3O%%_> 
				;7 SPR #:20-16093
		RET]
	TYPE < set spooled-output > ;7 SPR #:20-16093
	UTYPE (B)
	ETYPE <%_>
	RET

;TYPE CURRENT TERMINAL MODES

TRMPNT::NOISE <for terminal>
	MOVX A,.CTTRM		;DEFAULT TO CONTROLLING TERMINAL
	MOVEM A,TERMNL
	MOVEI B,[FLDDB. .CMNUM,CM%SDH,8,<an octal terminal line number>,,[
		FLDDB. .CMCFM]]
	CALL FLDSKP		;SEE WHAT'S BEING TYPED
	 CMERRX <an octal terminal line number or carraige return>
	GTFLDT D
	CAIE D,.CMCFM		;SPECIAL NUMBER?
	 JRST  [ADDI B,.TTDES	;MAKE TERMINAL DESIGNATOR
		MOVEM B,TERMNL	;YES, REMEMBER IT
		MOVE A,CSBUFP	;POINT TO SOME FREE SPACE
		HRROI B,[ASCIZ/TTY/]
		SETZ C,
		SOUT		;BUILD STRING TTYnnn
		MOVE B,TERMNL
		SUBI B,.TTDES	;MAKE REAL NUMBER AGAIN
		MOVEI C,FLD(10,NO%RDX) ;SAY OCTAL
		NOUT		;PUT NUMBER ON STRING
		 ERCAL JERR	;THIS SHOULDN'T FAIL
		HRROI B,[ASCIZ/:/]
		SETZ C,
		SOUT
		MOVX A,GJ%SHT
		MOVE B,CSBUFP
		CALL GTJFS	;GET A JFN TO CHECK LEGALITY
		 ERROR <%?>	;GIVE ERROR IF BAD TERMINAL
		CONFIRM		;GET FINAL CONFIRMATION
		JRST .+1]

;CHECK TERMINAL TYPE AND INTERPRET SOME CODES
	MOVE A,TERMNL
	GTTYP
	 ERJMP [ETYPE <%% Can't read terminal type - %?%%_>
		JRST ILTTY1]
	JUMPL B,ILTTYP
	CAIGE B,TTYPLN
	 SKIPA A,B
ILTTYP:	  MOVEI A,TTYPLN	;THIS INDEX DOES "ETYPE < TERMINAL TYPE %2Q>"
	XCT TTYPTB(A)
	ETYPE<%_>

;PRINT SPEED INFO
ILTTY1:	MOVE A,TERMNL
	MOVX B,.MORSP		;SPEED INFO
	MTOPR
	 ERJMP [ETYPE <%% Can't get speeds - %?%%_>
		JRST NOSPD]
	CAME C,[-1]		;SPEEDS RECEIVED?
	 JRST TISP1		;YES
	TYPE < !Terminal speed indeterminate!>
	JRST TISP2

TISP1:	HLRZ A,C		;INPUT SPEED
	HRRZ C,C
	ETYPE < terminal speed %1Q>
	CAME A,C		;INPUT = OUTPUT
	 ETYPE < %3Q>
TISP2:	ETYPE<%_>		;TERMINATE LINE
NOSPD:

;CHECK LINKS BIT
	SETZM RFERR		;NO RFMOD ERROR YET
	MOVE A,TERMNL
	RFMOD			;GET TERMINAL MODES
	 ERJMP [CALL DGETER	;GET REASON FOR FAILURE
		MOVEM A,RFERR	;REMEMBER
		ETYPE <%% Can't get link or advice status - %?%%_>
		JRST NOLNK]
	MOVEM B,RFINFO		;REMEMBER RFMOD INFORMATION
	TXNE B,TT%ALK
	 ETYPE < receive links%_>
	TXNN B,TT%ALK
	 ETYPE < refuse links%_>

;CHECK ADVICE BIT
	TXNE B,TT%AAD
	 ETYPE < receive advice%_>
	TXNN B,TT%AAD
	 ETYPE < refuse advice%_>
NOLNK:	MOVE A,TERMNL
	MOVX B,.MORNT
	MTOPR
	 ERJMP [ETYPE <%% Can't get system-message status - %?%%_>
		JRST N0STAT]
	CAIN C,.MOSMY
	 ETYPE < receive system-messages%_>
	CAIN C,.MOSMN
	 ETYPE < refuse system-messages%_>
N0STAT:
OZ,<
	MOVE A,TERMNL
	MOVX B,.MORRM
	MTOPR
	 ERJMP [ETYPE <%% Can't get sends status - %?%%_>
		JRST N1STAT]
	CAIN C,.MOSMY
	 ETYPE < receive sends%_>
	CAIN C,.MOSMN
	 ETYPE < refuse sends%_>
N1STAT:
>;OZ

;CHECK PAUSE (ON) COMMAND
	SKIPE A,RFERR		;DON'T GIVE PAUSE INFO IF GOT ERROR
	 JRST  [ETYPE <%% Can't get pause-on-command setting - %1?%%_>
		JRST NPINFO]	
	MOVE B,RFINFO		;GET INFO FROM RFMOD JSYS
	TYPE < terminal >
	TXNN B,TT%PGM
	 TYPE <no >
	ETYPE <pause (on) command%_>

;CHECK PAUSE (ON) END-OF-PAGE
NPINFO:	MOVE A,TERMNL
	MOVX B,.MORXO
	MTOPR
	 ERJMP [ETYPE <%% Can't get end-of-page status - %?%%_>
		JRST NOEOPS]
	TYPE < terminal >
	CAIN C,.MOOFF
	 TYPE <no >
	TYPE <pause (on) end-of-page>
	SKIPN RFERR		;CAN'T TELL IF DISABLED UNLESS RFMOD SUCCEEDED
	 CAIN C,.MOOFF
	  JRST NPEOPD
	MOVE B,RFINFO		;GET RFMOD BITS
	TXNN B,TT%PGM
	 TYPE < !disabled!>
NPEOPD:	ETYPE <%_>

;IF PAUSE EOP IS ON SAY WHAT THE PAUSE CHARACTERS ARE
;7 show pause characters, unless is ITS-mode
;7	CAIE C,.MOOFF		;IS NO-PAUSE-EOP SET,
;7	 TXNN B,TT%PGM		;  OR IS IT DISABLED?
;7	  JRST NOEOPS		;EITHER - DON'T TYPE THE CHARACTERS
VTS,<	MOVX A,.PRIOU		;7 get VTS modes
	RTMOD			;7
	 ERJMP NPEOP1		;7 error, skip this check
	TXNE B,TM%MOR		;7 check bit
	 JRST NOEOPS		;7 don't print chars if ITS-mode 
       >			;7
NPEOP1:				;7 add local label
	MOVE A,TERMNL		;READ PAUSE,,UNPAUSE CHARS INTO T3
	MOVX B,.MOPCR
	MTOPR
	 ERJMP [ETYPE <%% Can't get pause characters - %?%%_>
		JRST NOEOPS]
;7 show even if normal characters
;7	CAMN C,[23,,21]		;GOT THE USUAL CHARACTERS?
;7	 JRST NOEOPS		;YES - SKIP THE LINE
	TYPE < terminal pause (on) character>
	HLRZ B,C		;GET THE TURN-OFF CHARACTER
	CALL POUTCH		;TYPE IT OUT
	HLRZ B,C		;GET THE TURN-OFF CHARACTER
	CAIN B,(C)		;ARE THE PAUSE AND UNPAUSE CHARACTERS THE SAME?
	 JRST PAUSC0		;YES - DON'T SAY IT TWICE
	TYPE < (continue on)>
	HRRZ B,C		;GET THE TURN-ON CHARACTER
	PUSHJ P,POUTCH		;OUTPUT IT
PAUSC0:	ETYPE <%_>
NOEOPS:

;PAGE LENGTH
	MOVE A,TERMNL
	MOVX B,.MORLL		;PREPARE TO READ LENGTH
	MTOPR			;DO IT
	 ERJMP [ETYPE <%% Can't get length and width - %?%%_>
		JRST NODIM]
	ETYPE < terminal length %3Q%%_>

;PAGE WIDTH
	MOVX B,.MORLW		;READ WIDTH
	MTOPR
	ETYPE < terminal width %3Q%%_>
NODIM:	SKIPE A,RFERR		;DON'T PRINT INFO FROM FAILED RFMOD
	 JRST  [ETYPE <%% Can't get lowercase, raise, flagging,
   formfeed, tab, echo, or duplex status - %1?%%_>
		JRST DPLXDN]

;CHECK LOWER CASE
	MOVE B,RFINFO		;GET INFO FROM RFMOD
	TYPE < terminal >
	TXNN B,TT%LCA
	 TYPE <no >
	ETYPE <lowercase%_>

;CHECK RAISE
	TYPE < terminal >
	TXNN B,TT%LIC
	 TYPE <no >
	ETYPE <raise%_>

;CHECK OUTPUT FLAGGING
	TYPE < terminal >
	TXNN B,TT%UOC
	 TYPE <no >
	ETYPE <flag%_>

;CHECK INDICATE FORMFEED FLAG
	TYPE < terminal >
	MOVE A,TERMNL
	RFCOC
	LDB A,[POINT 2,B,25]
	CAIE A,1
	 TYPE <no >
	ETYPE <indicate%_>

;CHECK MECHANICAL FORMFEED
	TYPE < terminal >
	MOVE B,RFINFO
	TXNN B,TT%MFF
	 TYPE <no >
	ETYPE <formfeed%_>

;CHECK MECHANICAL TAB
	TYPE < terminal >
	TXNN B,TT%TAB
	 TYPE <no >
	ETYPE <tabs%_>

;ECHO MODE
	TYPE < terminal >
	TXNN B,TT%ECM
	 TYPE <no >
	ETYPE <immediate%_>

;CHECK DUPLEX CONTROL
BT.DUM==^L<TT%DUM&-TT%DUM>
SZ.DUM==BT.DUM-^L<TT%DUM>+1
	LDB A,[POINT SZ.DUM,B,BT.DUM]
	CAIN A,.TT0DX
	 JRST  [ETYPE < Duplexing in reserved state%_>
		JRST DPLXDN]
	TYPE < terminal >
	CAIN A,.TTFDX
	 ETYPE <fullduplex%_>
	CAIN A,.TTHDX
	 ETYPE <halfduplex%_>
	CAIN A,.TTLDX
	 ETYPE <line%_>
DPLXDN:				
VTS,<	MOVE A,TERMNL		;717 read VTS terminal characteristics
	RTCHR			;717
	 ERJMP ALLDON		;717
	TYPE < terminal >	;717 meta-key
	TXNN B,TC%MET		;717
	 TYPE <no >		;717
	ETYPE <meta-key (present on terminal)%_> ;717
	MOVE A,TERMNL		;717 read VTS terminal modes
	RTMOD			;717
	 ERJMP ALLDON		;717
	TYPE < terminal >	;717 reverse
	TXNN B,TM%RSU		;717
	 TYPE <no >		;717
	ETYPE <reverse (delete and underscore characters)%_> ;717
	TYPE < terminal >	;717 visible-bell
	TXNN B, TM%VBL		;717
	 TYPE <no >		;717
	ETYPE <visible-bell%_>	;717
	TYPE < terminal >	;717 ITS-style
	TXNN B,TM%MOR		;717
	 TYPE <no >		;717
	ETYPE <ITS-style (end-of-page processing)%_> ;717
	TYPE < terminal >	;717 wrap/scroll
	TXNN B,TM%SCR		;717
	 JRST [ ETYPE <wrap (mode)%_> ;717
		JRST .+2 ]	;717
	ETYPE <scroll (mode)%_>	;717
	TYPE < terminal >	;717 verbose
	TXNN B,TM%MVR		;717
	 TYPE <no >		;717
	ETYPE <verbose (end-of-page indication)%_> ;717
       >			;717 end VTS
ALLDON:	RET			;ALL DONE


;SUBROUTINE TO OUTPUT THE CHARACTER, SAYS "ESCAPE", "SPACE" OR "CONTROL" IN
;   THE APPROPRIATE CASES 
;
;   ACCEPTS:	B/	CHARACTER
POUTCH:	CAILE B," "		;GOT A PRINTING CHARACTER?
	 JRST POUTCC		;YES - JUST OUTPUT IT
	CAIN B," "		;NO - GOT A SPACE
	 JRST POUTCS		;YES - OUTPUT "SPACE"
	CAIN B,.CHESC		;GOT AN ESCAPE?
	 JRST POUTCE		;YES - OUTPUT "ESCAPE"
	TYPE < control>
	ADDI B,"@"		;MAKE THE CHARACTER PRINT
				;AND FALL INTO:
POUTCC:	ROT B,-^D21
	OR B,[BYTE (7) " ","""",0,""""]
	EXCH B,TRAPC
	UTYPE TRAPC		;OUTPUT THE PRINTING CHARACTER IN QUOTES
	EXCH B,TRAPC
	RET			;DONE

POUTCS:	TYPE < space>
	RET

POUTCE:	TYPE < escape>
	RET

;717 begin - MIT types added
TTYPTB:	TYPE < terminal 33 tty>				;0
	TYPE < terminal 35 tty>				;1
	TYPE < terminal 37 tty>				;2
	TYPE < terminal Execuport/TI>			;3
MIT,<	TYPE < terminal Imlac>  	     	    ;717 4
	TYPE < terminal Datamedia Elite 2500>	    ;717 5
	TYPE < terminal Hewlett Packard 2645>	    ;717 6
	TYPE < terminal nvt>			    ;717 7
       >
NOMIT,<	REPEAT 4,<XCT TTYNTY>>		;4-7 free
	TYPE < terminal system-default/TI733> 		;8
MIT,<	XCT TTYNTY>				    ;717 9
NOMIT,< TYPE < terminal IDEAL>>		;9
	TYPE < terminal DEC VT05>			;10
	TYPE < terminal DEC VT50>			;11
	TYPE < terminal DEC LA30>			;12
MIT,<	XCT TTYNTY>				    ;717 13 (not supported)
NOMIT,< TYPE < terminal DEC GT40>>	;13
	TYPE < terminal DEC LA36>		    ;717 14
	TYPE < terminal DEC VT52>		    ;717 15
MIT,<	TYPE < terminal glass tty>		    ;717 16
	TYPE < terminal Perkin-Elmer Fox 1100>	    ;717 17
	TYPE < terminal DEC VT100 in VT52 mode>	    ;717 18
       >
NOMIT,<	TYPE < terminal DEC VT100>	;16 DEC numbers
	TYPE < terminal DEC LA38>	;17
	TYPE < terminal DEC LA120>	;18
       >
MIT,<	TYPE < terminal Teleray 1061>		    ;717 19
	TYPE < terminal Heath/Zenith 19>	    ;717 20
	TYPE < terminal HDS Concept 100>	    ;717 21
	TYPE < terminal DEC VT100 in ANSI mode>	    ;717 22
	TYPE < terminal DEC LA38>		    ;717 23
	TYPE < terminal DEC LA120>		    ;717 24
	TYPE < terminal plasma tv>		    ;717 25
	TYPE < terminal supdup nvt>		    ;717 26
	TYPE < terminal Hewlett Packard 2640>	    ;717 27
	TYPE < terminal Ann Arbor Ambassador>	    ;717 28
	TYPE < terminal BBN Bitgraph>		    ;717 29
       >
NOMIT,<	REPEAT ^D11,<XCT TTYNTY>>	;19-29 free
REPEAT 5,<XCT TTYNTY>					;30-34 free
	TYPE < terminal DEC VT125>			;35
	TYPE < terminal DEC VK100 (GIGI)>		;36
;717 end
TTYPLN==.-TTYPTB
TTYNTY:	ETYPE < terminal type %2Q>
;LIST LOGICAL NAMES

.LNLIS::TLZ Z,F2!F3		;EVERYTHING OFF SO WE CAN DEFAULT LATER
	NOISE <of>
	TRVAR <SPNAM,LNDIR,LNTNM,LNJNM,LNDAT>
	MOVEI B,[FLDDB. .CMKEY,,$LNLIS,,<JOB>,[
		FLDDB. .CMDEV,CM%PO!CM%SDH,,<a specific logical name>]]
	CALL FLDSKP
	 CMERRX <"JOB", "SYSTEM", "ALL", or specific logical name required>
	GTFLDT C		;GET FIELD FLAVOR
	MOVEM C,LNDAT		;REMEMBER FIELD FLAVOR
	HRLM B,LNDAT		;AND KEYWORD POINTER
	CALL BUFFF		;GET LOGICAL NAME OR KEYWORD
	MOVEM A,SPNAM		;REMEMBER POINTER TO NAME
	HRRZ C,LNDAT		;GET COMND DATA AGAIN
	CAIN C,.CMDEV		;SPECIFIC LOGICAL NAME?
	 JRST LNSPEC		;YES
	HLRZ B,LNDAT		;GET KEYWORD POINTER
	CALL GETKEY		;GET THE KEYWORD DATA
	CALL GETTER		;KEYWORD, BUT IS THERE A COLON AFTER IT?
	CAIN A,":"
	 JRST  [COLONX <Colon to terminate logical name>
		 CMERRX
		JRST LNSPEC]
	CONFIRM			;CONFIRM THE KEYWORD
	JRST (P3)		;DISPATCH

.LNALL:	TLOA Z,F2!F3
.LNJB:	 TLOA Z,F3
.LNSYS:	  TLO Z,F2
	TLNN Z,F3		;JOB-WIDE?
	 JRST .LNSY1
	TLNE Z,F2
	 ETYPE <Job-wide logical names:%_%%_>
	MOVE A,[.INLJB,,.LNSJB]
	CALL .LNTYL
	TLNE Z,F2
	 ETYPE <%_%System-wide logical names:%_%%_>
.LNSY1:	TLNN Z,F2
	 RET
	MOVE A,[.INLSY,,.LNSSY]

;FALL INTO .LNTYL
.LNTYL:	HRRZM A,LNJNM
	HLLZ A,A
.LNTY1:	MOVEM A,LNDIR
	MOVE B,CSBUFP		;PUT IN UNUSED PORTION OF STRING BUFFER
	INLNM
	 JRST  [CAIE A,INLNX1
		 CALL JERR
		RET]		;ALL DONE
	IBP B
	MOVEM B,LNTNM
	MOVE B,CSBUFP
	MOVE C,LNTNM
	MOVE A,LNJNM
	LNMST
	 JRST  [CAIE A,LNSTX1
		 CALL JERR
		JRST .LNTY2]
	MOVE A,CSBUFP		;GET POINTER TO NAME
	MOVE B,LNTNM		;GET POINTER TO DEFINITION
	CALL LNTYPE		;TYPE THE GOODIES
.LNTY2:	MOVE A,LNDIR
	AOJA A,.LNTY1

;GET HERE WHEN SPECIFIC LOGICAL NAME REQUESTED
LNSPEC:	 CONFIRM		;CONFIRM THE SPECIFIC LOGICAL NAME
	MOVE B,SPNAM		;POINTER TO NAME IN B
	MOVE C,CSBUFP		;WRITE DEFINITION INTO STRING AREA
	MOVX A,.LNSJB		;SPECIFY JOB
	LNMST			;GET JOB DEFINITION
	 ERJMP LNS1		;NO JOB DEFINITION
	ETYPE <Job-wide:%_%%_>
	MOVE A,SPNAM
	MOVE B,CSBUFP
	CALL LNTYPE		;TYPE THE DEFINITION
	ETYPE <%_>
LNS1:	MOVX A,.LNSSY		;GET SYSTEM DEFINITION
	MOVE B,SPNAM		;POINTER TO NAME AGAIN
	MOVE C,CSBUFP		;STRING SPACE
	LNMST			;GET SYSTEM VERSION
	 RET			;NONE
	ETYPE <System-wide:%_%%_>
	MOVE A,SPNAM
	MOVE B,CSBUFP
	CALLRET LNTYPE		;TYPE SYSTEM VERSION AND RETURN

;ROUTINE TO TYPE A LOGICAL NAME DEFINITION.  
;
;   ACCEPTS:	A/	POINTER TO NAME
;		B/	POINTER TO DEFINITION
LNTYPE:	UETYPE [ASCIZ/ %1M: => %2M%%_/]	;7 add a space for readability
	RET

$LNLIS:	TABLE
	T all,,.LNALL
	T job,,.LNJB
	T system,,.LNSYS
	TEND

;INFORMATION (ABOUT) STRUCTURE <NAME>

	GSUBLK==BUF0+<BUFL-BUF0+1>/2 ;USE DEEP HALF OF AVAILABLE AREA FOR JOB
				;   LIST. THIS ALLOWS STARTING USER LIST AT
				;   BEGINNING OF AREA WITHOUT FEAR OF
				;   COLLISION, DESPITE FACT THAT EACH USER
				;   ENTRY REQUIRES TWO WORDS 
	GSUALS==GSUBLK+.MSUAL	;ALIAS FOR GETTING USERS OF STRUCTURE
	GSUFLG==GSUBLK+.MSUFL	;FLAGS,,LENGTH OF RESULTANT LIST
	GSULST==GSUBLK+.MSUJ1	;BEGINNING OF JOB LIST
	GSULEN==BUFL-GSUBLK+1	;TOTAL DATA BLOCK SIZE
	GSUJLN==GSULEN-.MSUJ1+1	;MAXIMUM NUMBER OF USERS WE CAN LIST

.STRST::TRVAR <SIXALS,<ASCALS,2>,<ISBLK,GSSLEN>,ALIAS,DEFNAM>	;CELL TO HOLD
				;   POINTER TO DEFAULT NAME 
	NOISE <name>
	CALL CONST		;GET DESIGNATOR OF CONNECTED STRUCTURE
	MOVEM A,CMDEF		;SET UP POINTER TO DEFAULT VALUE FOR FIELD
	MOVEM A,DEFNAM		;REMEMBER POINTER TO DEFAULT
	STARX <Name of structure or * for all>
	 ABSKP			;"*" NOT TYPED
	  JRST STRSTR		;"*" TYPED
	MOVE A,DEFNAM
	MOVEM A,CMDEF		;SET UP DEFAULT AGAIN
	DEVX <Name of structure or * for all>
	 CMERRX <"*" or mounted structure name required>
	CONFIRM			;WAIT FOR CONFIRMATION
	MOVEM B,ALIAS		;STORE DEVICE DESIGNATOR
	CALLRET STRST1		;DO THE WORK AND RETURN

;ROUTINE THAT DOES THE REAL WORK OF PRINTING STRUCTURE STATUS
STRST1:	MOVE A,ALIAS		;GET DEVICE DESIGNATOR
	MOVEM A,.MSGSN+ISBLK	;STORE FOR GETTING STRUCTURE STATUS
	SETZM .MSGSI+ISBLK	;DON'T GET PHYSICAL NAME
	MOVE A,[GSSLEN,,.MSGSS]	;LENGTH,,FUNCTION
	MOVEI B,ISBLK		;GET ANSWERS INTO ISBLK
	MSTR			;ASK MONITOR FOR INFO ABOUT STRUCTURE
	 ERJMP [MOVE A,.MSGSN+ISBLK ;DESIGNATOR THAT CAUSED PROBLEMS
		CALLRET STRST2]	;PRINT A WARNING AND RETURN
	MOVE A,.MSGMC+ISBLK	;GET MOUNT COUNT
	MOVE B,.MSGFC+ISBLK	;AND OPEN FILE COUNT
	MOVE C,.MSGNU+ISBLK	;NUMBER OF UNITS IN STRUCTURE
	MOVE D,ALIAS		;GET POINTER TO NAME
	ETYPE <Status of structure %4H:
Mount count: %1Q, open file count: %2Q, units in structure: %3Q%%_>
	MOVE A,.MSGST+ISBLK	;GET STATUS BITS
	TXNE A,MS%PPS		;SKIP IF NOT THE PRIMARY PUBLIC STRUCTURE
	 TYPE <Public >
	TXNE A,MS%DOM		;SKIP IF NOT DOMESTIC
	 TYPE <Domestic >
	TXNN A,MS%DOM		;SKIP IF DOMESTIC
	 TYPE <Foreign >
	TXNN A,MS%INI		;SKIP IF NOT "BEING INITIALIZED"
	 TXNE A,MS%DIS		;SKIP IF "BEING DISMOUNTED"
	  TYPE <Unavailable for mounting >
	TXNE A,MS%RWD!MS%RWS	;SKIP IF WE DONT NEED ANOTHER LINE
	 ETYPE <%_>
	TXNE A,MS%RWD		;READ AFTER WRITE FOR DATA
	 TYPE <Write verification for data >
	TXNE A,MS%RWS		;READ AFTER WRITE FOR SWAP SPACE
	 TYPE <Write verification for swapping >
	ETYPE<%_>
	LDF A,MS%GTM!MS%GTA!MS%GTC ;REQUEST CONNECTORS, ACCESSORS, AND MOUNTERS
	MOVEM A,GSUFLG
	MOVE A,.MSGSN+ISBLK	;GET ALIAS
	MOVEM A,GSUALS		;STORE FOR GETTING STRUCTURE USERS
	DMOVE A,[<GSULEN>B17!.MSGSU
		GSUBLK]
	MSTR			;GET LIST OF USERS FOR THIS STRUCTURE
	 ERJMP [MOVE A,GSUALS	;GET THE TROUBLE MAKER
		CALLRET STRST2]	;PRINT A WARNING ON THIS DEVICE AND RETURN
	HRRZ A,GSUFLG		;GET LENGTH OF USER LIST
	JUMPN A,STRSTU		;NON-ZERO MEANS THERE'S A LIST TO PRINT
	ETYPE <There are no jobs currently using this structure%_>
	RET

STRST2:	PUSH P,A		;SAVE THE DEVICE DESIGNATOR
	TYPE <%>		;GET READY TO PRINT WARNING
	CALL %GETER		;GET LAST ERROR WE RECIEVED
	MOVE A,ERCOD		;SET IT UP FOR PRINTING
	CALL $ERSTR		;TELL THEM WHAT HAPPENED
	POP P,A			;NOW GET THE DESIGNATOR BACK
	ETYPE < - %1H:%_>	;AND PRINT IT
	RET			;RETURN TO WHEREVER WE CAME FROM

STRSTU:	CAIL A,GSUJLN		;ARE WE SURE WE GOT THE WHOLE LIST?
	 ETYPE < %%Couldn't get entire user list for structure%_>
	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4		;GET SOME AC'S
	PUSH P,P5
	PUSH P,Q1
	MOVN P1,A		;GET NEG OF NUMBER OF JOBS IN LIST
	HRLZ P1,P1		;MAKE AOBJN POINTER
	SETZ P2,		;LENGTH OF USER LIST
	MOVX C,.JIUNO		;SPECIFY WE WANT USER NUMBER
STR1:	HRRZ A,GSULST(P1)	;PICK UP A JOB NUMBER
	HRROI B,P3		;WE'LL READ USER NUMBER INTO P3
	GETJI			;GET IT'S USER NUMBER INTO P3
	 JRST STRX1		;COULDN'T, CHECK WHY
	MOVE P4,P2		;GET LENGTH OF USER LIST
STR3:	SOJL P4,STR2		;JUMP IF WE'VE SCANNED THE WHOLE LIST
	 SOJ P4,		;SECOND WORD IS INFO BITS
	CAME P3,BUF0(P4)	;FOUND IT IN LIST YET?
	 JRST STR3		;NO, KEEP LOOKING
	HLLZ A,GSULST(P1)	;FOUND IT, GET INFO BITS
	IORM A,BUF0+1(P4)	;PERHAPS MORE BITS ON FOR THIS JOB
STR4:	AOBJN P1,STR1		;LOOP FOR REST OF JOBS
	MOVE D,P2		;SAVE FINAL LENGTH OF USER LIST
	LDF P3,MS%GTM		;FIRST WE'LL LIST MOUNTERS
	MOVEI P4,[ASCIZ/Users who have MOUNTed %2H: /]
	MOVEI P5,[ASCIZ/No users have %2H: MOUNTed/]
	CALL REPORT		;PRINT THE MOUNTERS OF THE STRUCTURE
	LDF P3,MS%GTA		;LIST ACCESSERS
	MOVEI P4,[ASCIZ/Users ACCESSing %2H: /]
	MOVEI P5,[ASCIZ/No users are ACCESSing %2H:/]
	CALL REPORT
	LDF P3,MS%GTC		;NOW LIST CONNECTERS
	MOVEI P4,[ASCIZ/Users CONNECTed to %2H: /]
	MOVEI P5,[ASCIZ/No users CONNECTed to %2H:/]
	CALL REPORT
	POP P,Q1
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1		;RESTORE THESE LITTLE DEVILS
	RET

;GET TO HERE ON "INFO STR *" OR "INFO STR *:"
STRSTR:	CONFIRM
	CALL DEVLUP		;LOOP THROUGH ALL DEVICES
	 CALL STRWRK		;DO THE WORK FOR EACH ONE
	RET			;DONE

STRWRK:	CAMN A,[SIXBIT/DSK/]	;IS IT STRUCTURE "DSK"?
	 RET			;YES, FORGET IT, SINCE IT'LL COME UP AGAIN AS SPECIFIC STRUCTURE
	MOVEM D,ALIAS		;STORE DESIGNATOR FOR STRUCTURE ALIAS
	MOVEM A,SIXALS		;REMEMBER SIXBIT ALIAS
	LDB C,[POINTR B,DV%TYP]	;GET DEVICE TYPE
	CAIE C,.DVDSK		;MAKE SURE IT'S A DISK
	 RET
	HRROI A,ASCALS		;POINT TO AREA FOR ASCII ALIAS
	MOVE B,D		;GET DESIGNATOR
	DEVST			;GET ASCII
	 ERCAL JERRE		;SHOULDN'T FAIL, SINCE MONITOR SUPPLIED INPUT!
	HRROI A,ASCALS		;POINT TO THE ASCII
	CALL GETSIX		;GET SIXBIT
	 NOP			;WON'T EVER FAIL
	CAME A,SIXALS		;DID WE GET BACK WHAT WE STARTED WITH?
	 RET			;NO, SKIP "DSK" OR "LPT" DEFINED AS A STRUCTURE
	CALL STRST1		;PRINT THE GOODS ON THIS STRUCTURE
	ETYPE<%_>
	RET

;ROUTINE TO LIST ELEMENTS FROM LIST STARTING IN BUF0.
REPORT:	SETZ P1,		;TELLS HOW MANY NAMES HAVE BEEN PRINTED ON THIS
				;   LINE 
	SETOM Q1		;FLAG SAYING NO NAMES IN THIS LIST YET
	MOVE A,COJFN		;GET OUTPUT JFN
	MOVX B,.MORLW
	MOVX C,^D72		;FOR NON-TERMINAL ASSUME 72 COLUMNS
	MTOPR			;GET LINE WIDTH
	 ERNOP			;PROBABLY NOT A TERMINAL
	MOVE P2,C		;REMEMBER IN P2
	MOVN D,D		;GET NEGATIVE OF NUMBER OF ELEMENTS
	HRLZ D,D		;MAKE AOBJN POINTER
	MOVE B,ALIAS		;GET POINTER TO STRUCTURE NAME
STR5:	TDNN P3,BUF0+1(D)	;THIS USER HAVE CORRECT ATTRIBUTES?
	 JRST STR7		;NO
	AOSN Q1			;FIRST NAME BEING PRINTED?
	 UETYPE @P4		;YES, PUT IN HEADING
	CAIE Q1,0		;FIRST NAME BEING PRINTED?
	 TYPE <, >		;SEPARATE NAMES(NOT BEFORE FIRST ONE THOUGH!)
	MOVE B,BUF0(D)		;GET USER NAME
	CALL DIRRUM		;MAKE SURE THERE'S ENOUGH ROOM ON THIS LINE FOR
				;   ANOTHER NAME 
	DIRST			;PRINT USER NAME
	 ERJMP STR6		;GO CHECK ERROR CODE
	AOJ P1,			;COUNT NAMES ON THIS LINE
STR7:	AOBJN D,.+1
	AOBJN D,STR5		;LOOP FOR REST OF NAMES
	CAIGE Q1,0		;ANY NAMES PRINTED?
	 UETYPE @P5		;NO, SO GIVE REMARK ABOUT LIST BEING EMPTY
	ETYPE<%_>		;PUT CR AFTER LIST
	RET

STR6:	CALL %GETER		;GET REASON FOR FAILING DIRST
	MOVE B,ERCOD
	CAIE B,DIRX1		;USER GO AWAY?
	 CALL CJERRE		;NO, SO BOMB OUT
	JRST STR7		;YES, IGNORE AND GO ON

STR2:	MOVEM P3,BUF0(P2)	;USER NOT FOUND, ADD TO LIST
	HLL A,GSULST(P1)	;GET CONTROL BITS
	HLLM A,BUF0+1(P2)	;SAVE BITS
	AOJ P2,			;2 WORDS PER ENTRY IN USER LIST
	AOJA P2,STR4		;EXPAND LIST AND CHECK REST OF JOBS
STRX1:	 CAIE A,GTJIX4		;MAKE SURE ERROR IS "NO SUCH JOB"
	  CALL CJERRE		;NO, SO BOMB OUT
	JRST STR4		;YES, JOB LOGGED OFF, SO SKIP IT

;ROUTINE USED WHEN PRINTING A LIST OF USER NAMES TO DECIDE WHETHER THE NEXT
;   NAME WILL FIT ON THIS LINE. IF NOT, A CRLF AND TAB IS PRINTED. THE ROUTINE
;   ALWAYS ASSUMES THE NAME FITS, IF IT'S THE FIRST ONE ON THE LINE, NO MATTER
;   HOW LONG IT IS. 
;
;   ACCEPTS:	B/	USER OR DIRECTORY NUMBER
;		P1/	NUMBER OF NAMES SO FAR ON THIS LINE
;		P2/	TERMINAL WIDTH
;   RETURNS: +1		ALWAYS, WITH P1 RESET TO 0 IF THERE WAS NO ROOM
DIRRUM:	SAVEAC <A,B,C,D>	;CLOBBER NOTHING
	STKVAR <<DRRBUF,FILWDS>>
	JUMPE P1,DIRUMX		;THERE'S ALWAYS ROOM FOR AT LEAST ONE NAME!
	JUMPE P2,DIRUMX		;IF 0 WIDTH, ASSUME INFINITE AND HENCE THERE'S
				;   ROOM! 
	HRROI A,DRRBUF		;GET SOME FREE SPACE
	DIRST			;GENERATE THE STRING
	 ERJMP DIRUMX		;FAILED, SO JUST EXIT
	SETZ B,			;PUT NULL IN TO MARK END OF STRING
	IDPB B,A
	MOVEI A,DRRBUF		;LOOK AT STRING
	HRLI A,(ASCPTR)		;MAKE CORRECT BYTE POINTER
	SETZ D,			;D HOLDS LENGTH OF STRING
DUM1:	ILDB C,A		;MORE CHARACTERS?
	CAIE C,0		;NO
	 AOJA D,DUM1		;YES, COUNT 'EM
	  ADDI D,2		;LEAVE ROOM FOR COMMA AND SPACE
	MOVE A,COJFN		;GET POINTER TO OUTPUT DEVICE
	RFPOS			;WHERE ARE WE ON LINE?
	ADD B,D			;WHERE WILL WE BE AFTER PRINTING THIS NAME?
	CAIGE P2,(B)		;OVER RIGHT MARGIN?
	 JRST DUMNO		;YES, NO ROOM ON THIS LINE
DIRUMX:	RET

DUMNO:	ETYPE <%_	>
	SETZ P1,		;NOTE THAT WE'RE ON NEW LINE
	JRST DIRUMX

;JOBSTAT

.JOBST::SKIPN CUSRNO		;7 logged in?
	 JRST  [ETYPE < Job %J, Not logged in>	;7 no
		JRST JOBST1]	;7
	STKVAR <LLPTR>
	ETYPE < Job %J, User %N>
	GJINF
	CAME B,LIDNO		;SKIP IF CONNECTED TO LOGGED-IN DIR
	 ETYPE <, %G>
	TYPE <, Account >
	CALL PRACCT		;PRINT ACCOUNT INFO
JOBST1:	ETYPE <, %L%%_>		;7 add local label
	SETO A,			;OURSELF
	HRROI B,CSBUFP		;POINT TO BYTE POINTER
	MOVX C,.JILLO		;SAY WE WANT LOGICAL LOCATION
	MOVE D,CSBUFP		;GET POINTER TO BEGINNING OF STRING
	GETJI			;GET IT
	 ERCAL CJERRE		;SHOULDN'T FAIL
	MOVE A,D		;GET POINTER TO LOGICAL LOCATION
	CALL BUFFS		;SAVE THE LOCATION
	MOVEM A,LLPTR		;REMEMBER POINTER TO IT
	CALL GETNOD		;GET HOST NODE NAME
	 MOVE A,LLPTR		;ON NONDECNET, GUARANTEE THAT THEY MATCH
	MOVE B,LLPTR		;COMPARE WITH OUR JOB'S NODE
	STCMP
	JUMPE A,NOLOC		;DON'T PRINT NAME IF THEY'RE THE SAME
	MOVE A,LLPTR
	ETYPE < Located at %1M%%_>
NOLOC:	SETO A,			;CURRENT JOB
	MOVE D,CSBUFP		;USE FREE SPACE POINTER
	HRROI B,D		;SAY ONE ENTRY, POINTER IN D
	MOVX C,.JISRM		;SPECIFY WE WANT SESSION REMARK
	GETJI			;GET SESSION REMARK
	 ERJMP NOS		;IF FAILS, THERE'S NO REMARK
	MOVE A,CSBUFP		;GET POINTER TO REMARK
	ILDB A,A		;GET FIRST CHARACTER
	MOVE D,CSBUFP
	CAIE A,0		;PRINT NOTHING IF NO SESSION REMARK
	 ETYPE < Session remark: %4M%%_>
NOS:	RET
;RUNSTAT - INFO PROGRAM-STATUS

.RUNST::STKVAR <FRKSNW>
	ETYPE < Used %B% in %C%%_>
	TLOA Z,F1		;SET FLAG FOR JOB STATUS
.FRKST:: TLZ Z,F1		;CLEAR FLAG FOR FORK STATUS ONLY
	TLNN Z,F1		;WANT ALL INFO?
	 JRST .FKST2		;NO - PRINT FORKS ONLY
	MOVEI A,.FHSLF		;REPORT ON CURRENT FORK FIRST
	ETYPE < TOPS-20 Command Processor runtime: %1V%%_> ;7 more precise
	TYPE < set >
	SKIPE PAXLFL
	 TYPE <no >
	ETYPE <UUO-simulation (for program)%_>
	TYPE < set >
	SKIPE CCFLAG
	 TYPE <no >
	ETYPE <control-c-capability (of program)%_>
XTND,<	TYPE < set >
	SKIPN CCKEEP
	 TYPE <no >
	ETYPE <keep-fork (on CTRL/C)%_>
       >
	SETZM TRAPC		;CLEAR NUMBER BEING TRAPPED
	MOVEI A,[CAIE A,0	;COUNT ONES BEING TRAPPED
		 AOS TRAPC
		RET]
	CALL SCNJBK
	SKIPE TFILEF		;SEE IF TRAPPING FILE-OPENINGS
	ETYPE < set trap file-openings%_>
	SKIPN A,TRAPC
	 JRST  [SKIPN TFILEF	;NO JSYS TRAPPED.  TRAPPING FILE-OPENINGS?
		 JRST NJTRAP	;NOTHING BEING TRAPPED SO SAY NOTHING.
		JRST JMORE]	;TRAPPING ONLY FILE-OPENINGS SO GIVE OTHER
				;   STATUS 
	CAIN A,777		;PERHAPS EVERYTHING IS BEING TRAPPED
	 JRST  [ETYPE < set trap JSYS /all%_>
		JRST JMORE]
	SETZ Q2,		;Q2 IS 0 OR 1 DEPENDING ON WHICH SET IS LARGER
	CAIG A,223		;MORE THAN HALF OF ALL JSYS'S BEING TRAPPED?
	 MOVEI Q2,1
	CAIN Q2,0
	 TYPE < All JSYS's being trapped except: >
	CAIE Q2,0
	 TYPE < set trap on these JSYS's: >
	SETZ Q1,		;COUNTER FOR KNOWING WHEN TO BREAK LINE
	MOVEI A,[CAME A,Q2
		 RET		;DON'T LIST JSYS NOT IN CORRECT CLASS
		CAIL Q1,5
		 TYPE <	>
		CAIL Q1,5
		 SETZ Q1,	;START NEW LINE IF NECESSARY
		CAIE Q1,0
		 TYPE <, >
		ETYPE <%2M>
		CAIL Q1,5
		 TYPE <%_>
		ADDI Q1,1	;KEEP TRACK OF NUMBER ON LINE
		RET]
	CALL SCNJBK		;PRINT APPROPRIATE LIST
JMORE:	CALL LM			;FINISH LIST
	SKIPE TSTOPF		;SAY WHETHER PROCEEDING AFTER TRAPS OR NOT
	 ETYPE < set trap no proceed%_>
	SKIPN TSTOPF
	 ETYPE < set trap proceed%_>
NJTRAP:	TYPE < set typeout mode >
	SKIPN SYMF
	 ETYPE <numeric%_>
	SKIPE SYMF
	 ETYPE <symbolic%_>
	CALL IDPRG1		;SHOW DEFAULT PROGRAM SETTINGS
	HLRZ A,PRGNMS		;7 use PRGNMS instead of FRKNMS 
;7	HLRZ A,FRKNMS		;SEE HOW MANY FORK NAME BLOCKS EXIST
	MOVEM A,FRKSNW		;STORE IN FORK SCAN WORD
FKS1:	SOSGE B,FRKSNW		;DON'T ASSUME IPROG PRESERVES TEMPS
	 JRST .FKST2		;DONE IF NO MORE
	HRRZ A,PRGNMS+1(B)	;7 use the correct location
;7	HRRZ A,FRKNMS+1(B)	;GET ADDRESS OF FORK BLOCK
	LOAD C,FKFLAG,(A)	;GET FLAGS
	HLRO B,PRGNMS+1(B)	;7 use the correct location
;7	HLRO B,FRKNMS+1(B)	;GET POINTER TO NAME
;7 not necessary anymore
;7	TXNE C,FN%NAT		;DON'T PRINT UNLESS NAME HAS SPECIFIC
				;   ATTRIBUTES 
	 CALL IPROG		;PRINT INFO ABOUT THIS PROGRAM
	JRST FKS1		;LOOP FOR REST OF ENTRIES

.FKST2:	CALL DGFRKS		;DO THE GFRKS TO GET FORK HANDLES
	 CALL  [CAIE A,GFKSX1	;RAN OUT OF SPACE?
		 CAIN A,FRKHX6	;RAN OUT OF HANDLES?
		  ABSKP		;YES - CONTINUE
		   JRST CJERR	;NO, STRANGE
		TYPE <% >
		CALL $ERSTR	;PRINT SYSTEM MESSAGE
		ETYPE <%_% %%Partial structure will be printed.%_>
		RET]
	SETZ Q1,
	HRRZ D,(C)
	CALL FSTRUC		;PRINT FORK TREE
	CALLRET UNMDIR		;UNMAP SPECIAL PAGES

;SCNJBK - IS USED TO SCAN THROUGH THE JSYSES FOR TRAP-HANDLING
;
;   ACCEPTS:	A/	ROUTINE TO CALL FOR EACH JSYS
;
;   THE ROUTINE IN A IS CALLED WITH THE FOLLOWING SET UP:
;		A/	0 OR 1 SHOWING NOTRAP/TRAP FOR THIS JSYS
;		B/	POINTER TO ASCIZ JSYS NAME
;		C/	THE JSYS
SCNJBK:	STKVAR <RNAME,JIDX>
	MOVEM A,RNAME		;REMEMBER ROUTINE TO CALL
	SETZM JIDX		;START WITH JSYS 1
	AOS D,JIDX
SCNJ1:	HRRO B,JTAB(D)		;GET POINTER TO NAME
	MOVX C,JSYS		;GIVE THE JSYS IN C
	HRR C,D			;GET THE JSYS'S Y FIELD
	ADJBP D,[POINT 1,JSBDEF,0];GET BYTE POINTER INTO BIT MASK
	LDB A,D			;TELL CALLER VALUE OF BIT
	CAMN C,[OPENF]		;NO NEED TO BE CAREFUL IF JSYS ISN'T OPENF
	 CAIN A,0		;NO NEED TO BE CAREFUL IF JSYS ISN'T BEING
				;   TRAPPED 
	  ABSKP			;NOT OPENF OR NOT BEING TRAPPED
	   AND A,TOPENF		;DON'T CONFUSE FILE-OPENINGS WITH JSYS OPENF
	CALL @RNAME		;CALL THE ROUTINE
	AOS D,JIDX		;STEP TO NEXT JSYS
	CAIGE D,1000		;DONE THROUGH JSYS 777?
	 JRST SCNJ1		;NO, DO THE REST
	RET
;IPROG - PRINTS THE SET PROGRAM OR SET DEFAULT PROGRAM VALUES.
;
;   ACCEPTS:	A/	ADDRESS OF FORK BLOCK
;		B/	POINTER TO NAME (IGNORED IF C(A) = C(FRKDEF))
IPROG:	LOAD C,FKFLAG,(A)	;GET FLAGS
	HRROI D,[ASCIZ/program /]
	CAMN A,FRKDEF		;DOING DEFAULT DISPLAY?
	 JRST  [HRROI D,[ASCIZ/default program/] ;YES, SAY SO
		HRROI B,[0]	;NO SPECIFIC PROGRAM NAME
		JRST .+1]
	TXNE C,FN%EPH		;CHECK FOR "SET PROG" ATTRIBUTES
	 ETYPE < set %4M%%2M ephemeral%_>
	LOAD A,FKRESP,(A)	;7 moved, GET POINTER TO METHOD OF RESTARTING
	TXNE C,FN%NEF
      	 ETYPE < set %4M%%2M unkept (and) %1M (when lazy-restarted)%_> ;7 
;7	ETYPE < set %4M%%2M no-ephemeral%_> ;7 didn't show restart status
	TXNE C,FN%KEP
	 ETYPE < set %4M%%2M keep (and) %1M (when lazy-restarted)%_> ;7 jargon
	RET

;FSTRUC
;RECURSIVE SUBR TO TYPE FORK STRUCTURE OF JOB. FOR EACH FORK, TYPES HANDLE AND
;   STATUS. FILE NAME OR "PROGRAM" WOULD ALSO BE DESIRABLE IF IT WERE
;   AVAILABLE. STRUCTURE INDICATED BY PUTTING A FORK'S INFERIORS RIGHT AFTER
;   IT, INDENTING 3 COLUMNS PER LEVEL. THUS PARALLEL FORKS ARE THOSE WHICH
;   APPEAR AT SAME INDENTATION WITH NO LESS-INDENTED ENTRIES BETWEEN THEM.
;
;   ACCEPTS:	D/	POINTER TO GFRKS TABLE, SET UP BY CALLER.
;		Q1/	LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER.

;ENTRY POINT IS AT END BUT COMES RIGHT HERE. TYPE STUFF FOR THIS FORK.
FSTR1:	PRINT " "
	SKIPG FORK		;7 sometimes FORK gets zeroed
	 JRST FSTR1A		;7
	HRRZ B,1(D)
	CAMN B,FORK		;< TO MATCH FOLLOWING
	 UTYPE [ASCIZ/=> /]
	CAME B,FORK
FSTR1A:	 TYPE <   >
	SKIPA A,Q1
	 TYPE <   >		;INDENT 3 SPACES PER LEVEL BELOW FIRST.
	SOJGE A,.-1
	 HRRZ B,1(D)		;GET THIS FORK'S HANDLE FROM TABLE
	JUMPE B,[TYPE <**: >
		MOVE A,2(D)	;GET STATUS FROM TABLE
		MOVEM A,LRFSTS+.RFPSW ;SINCE WE DON'T HAVE A HANDLE
		SETZB A,LRFSTS+.RFPFL ;SIMULATE A LONG RFSTS WITH
		SETZM LRFSTS+.RFPPC ;AS MUCH INFORMATION AS WE KNOW
		CALL FSTAT	;PRINT STATUS WITH 0 PC
		JRST FSTR2]
	TXZ B,1B18		;PRINT IN FORM ## NOT 4000##
	SKIPN A,FRKTAB(B)	;KNOW ABOUT THIS FORK?
	 JRST FSTR2N		;NO - MAKE A DUMMY ENTRY
	TXNN A,FK%NAM		;FORK HAVE NAME?
	 JRST FSTR2B
	HRRO A,.FKNAM(A)	;GET POINTER TO NAME STRING
	ETYPE <%1\ (%2O)>
	JRST FSTR2C		;COMMON CODE

FSTR2N:	MOVX A,.FKSZE		;SIZE OF ENTRY
	MOVE Q2,B		;SAVE FORK #
	MOVEI B,XDICT
	CALL GETMEM		;GET BLOCK OF STORAGE
	 JRST  [MOVE B,Q2
		MOVE D,SAVHD	;RESTORE POINTER
		JRST FSTR2B]	;NO SLOTS - JUST GIVE STATUS
	EXCH Q2,B		;PNTR TO Q2, FORK # TO B
	MOVE D,SAVHD		;RESTORE POINTER
	HLRZ A,1(D)		;GET SUPERIOR PNTR
	JUMPE A,FSTR2B		;NONE - MUST BE US
	HRLZ A,1(A)		;GET HANDLE
	MOVEM A,.FKOWN(Q2)	;STORE SUPERIOR HANDLE
	SETOM .FKEDL(Q2)	;NO E/D DONE
	HRRZM Q2,FRKTAB(B)	;STORE PNTR TO ENTRY
	HRRZI A,.FKPTM+1(Q2)	;CLEAR FORK MODES
	HRLI A,-1(A)
	SETZM .FKPTM(Q2)
	BLT A,.FKPTM+NTTYMD+1(Q2)
FSTR2B:	TYPE <Fork >		;FORK HAS NO NAME, BUT WE KNOW ABOUT IT NOW
	MOVE A,COJFN
	MOVX C,FLD(10,NO%RDX)
	NOUT			;FORK HANDLE, OCTAL
	 CALL JERRC		;JSYS ERROR ROUTINE FOR ERROR NUM IN C
FSTR2C:	TYPE <: >
	HRRZ A,1(D)		;HANDLE AGAIN
	CAIN A,.FHSLF		;SELF?
	 JRST  [TYPE <EXEC>
		JRST FSTR2A]
	CAMN A,EDFORK		;EDITOR?
	 TYPE <Editor, >
	MOVE C,SLFTAB(A)
	TXNE C,FK%KPT		;THIS ONE KEPT?
	 TYPE <Kept, >
	TXNE C,FK%BKG		;BACKGROUND?
	 TYPE <Background, >
	TXNE C,FK%INV		;715 INVOKE'd?
	 TYPE <Invoked, >	;715
	TXNE C,FK%DBG		;DEBUGGER?
	 TYPE <Debugger, >
	CALL FSTAT		;TYPE ITS STATUS
FSTR2A:	MOVE D,SAVHD		;DON'T ASSUME FSTAT PRESERVES TEMPS
	HRRZ A,1(D)		;AND AGAIN
	ETYPE <, %1V>		;RUNTIME OF FORK
FSTR2:	ETYPE<%_>

;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION.
	HRRZ D,(D)		;INFERIOR PTR FROM GFRKS TABLE.
	AOS Q1			;DOWN LEVEL
	CALL FSTRUC		;RECURSIVE CALL TO DO ENTIRE SUBTREE
	SOS Q1			;UP LEVEL
	MOVE D,SAVHD		;RESTORE HANDLE
	HLRZ D,(D)		;PARALLEL PTR FROM GFRKS TABLE
	JRST FSTR3		;DON'T REALLOCATE LOCAL STORAGE

;ENTRY POINT. NOP IF 0 PTR GIVEN.
FSTRUC:	STKVAR <SAVHD>
FSTR3:	MOVEM D,SAVHD		;SAVE POINTER
	JUMPN D,FSTR1
	RET
;FORK STATUS TYPEOUT SUBROUTINE FOR INFORMATION PROGRAM, ^T, ETC.
;
;   ACCEPTS:	A/	FORK HANDLE OR 0, WHICH MEANS A LONG RFSTS HAS BEEN
;			SIMULATED CONTAINING ALL AVAILIBLE INFORMATION (AS WHEN
;			THERE ARE TOO MANY FORKS) 
FSTAT::	STKVAR <FHAN,OFORK>
	MOVEM A,FHAN		;REMEMBER HANDLE
	JUMPE A,FSTAT0		;ZERO HANDLE MEANS USE WHAT'S IN LRFSTS
	MOVX B,.RFSFL+1		;SET UP LRFSTS FOR A LONG RFSTS
	MOVEM B,LRFSTS+.RFCNT
	HRLI A,(RF%LNG)		;DON'T DESTROY FORK HANDLE IN A
	MOVEI B,LRFSTS
	RFSTS			;GET STATUS IN A, PC IN B
	 ERCAL CJERR		;7 don't trip out on an error
FSTAT0:	MOVE B,LRFSTS+.RFPSW	;LOAD STATUS TO DETERMINE MESSAGE
	HLRZ C,B		;B1-17 = STATUS
	CAIN C,-1		;-1 = UNASSIGNED HANDLE. MAYBE A SUPERIOR
	 JRST  [MOVEI D,[ASCIZ/Program disappeared/] ;..KILLED PROGRAM
		JRST FSTAT8]
	TXZ C,<(RF%FRZ)>	;FLUSH FROZEN BIT
	CAIE C,.RFHLT		;HALT OR FORCED TERM?
	 CAIN C,.RFFPT
	  TXZ B,RF%FRZ		;YES, WASN'T RESULT OF ^C
	CAIE C,.RFTTY		;TTY I/O WAIT?
	 CAIN C,.RFTRP		;JSYS TRAPPED?
	 TXZ B,RF%FRZ		;YES, NOT RESULT OF ^C
	TMNE FK%INV,SLFTAB(A)	;715 controlled program
	 CAIE C,.RFIO		;715    and waiting for I/O?
	  ABSKP			;715 no, go on
	   TXZ B,RF%FRZ		;735 yes, probably waiting for typein
	SKIPGE B
	 TYPE <^C from >	;"FROZEN" BIT ON
	UTYPE @[[ASCIZ/Running/]
		[ASCIZ"I/O wait"] ;7 put in the slash
		[ASCIZ/HALT/]	;INCLUDES NEVER STARTED
		[ASCIZ/HALT: /]
		[ASCIZ/Fork wait/]
		[ASCIZ/SLEEP/]
		[ASCIZ"JSYS/UUO trap"]
		[ASCIZ/Address break/]
		[ASCIZ"TTY I/O wait"]](C) ;NOTE INDEX!
	MOVEI D,[ASCIZ/ at %2Y/] ;%2Y TYPES PC FROM B
	CAIE C,.RFFPT
	 JRST FSTAT8		;GO OUTPUT "AT <PC>" 
				;AFTER ERROR STOP, TYPE REASON AS GIVEN BY PSI
				;   CHAN # IN RH OF A. USE TEXT FROM "START"
				;   COMMAND'S ERROR MSG TAB. 
	HRRZ C,LRFSTS+.RFPSW	;INSTR AT WHY INDEXES BY CHAN THRU C
	MOVE D,@WHY		;WHY TABLE HAS %1X, %2Y AND/OR %3Q
FSTAT8:	MOVE B,LRFSTS+.RFPPC	;LOAD ADDRESS PART OF PC FOR POSSIBLE %Y
	CALL PIOFF		;NO ^C WHILE FORK CELL IS AMUK
	MOVE A,FORK		;GET OFFICIAL CONTENTS OF FORK CELL
	MOVEM A,OFORK		;REMEMBER IT
	MOVE A,FHAN		;GET BACK HANDLE FOR POSSIBLE %X
	MOVEM A,FORK		;PUT IN FORK FOR POSSIBLE %Y
	SETZM SYMOKF		;FORCE REEVALUATION OF SYMBOL TABLE
	UETYPE (D)		;TYPE MSG. INCLUDES PC FROM B.
	MOVE A,OFORK		;GET BACK CORRECT CONTENTS OF FORK CELL
	MOVEM A,FORK		;RESTORE REAL FORK CELL
	CALLRET PION		;ALLOW ^C AGAIN AND RETURN
;PISTAT
;   PSI IS OFF, LEVTAB=NNNNNN, CHNTAB=NNNNNN, CHN MASK=NNNNNNNNNNNN, BIP=N

.PISTA::PRINT " "
	SKIPGE A,FORK
	 JRST  [TYPE <No program>
		JRST EOLRET]
	TYPE <PSI is >
	MOVEI Q1,[ASCIZ/ON/]
	SKPIR
	 MOVEI Q1,[ASCIZ/OFF/]
	UTYPE (Q1)
	RIR
	 ERJMP [MOVEI B,C	;FAILED - TRY IT EXTENDED - GET ARG LENGTH
		MOVEI C,3	;READ LEVTAB INTO AC 4, CHNTAB INTO AC 5
		XRIR%
		JRST PISTA1]
	HLRZ D,B		;GET ADDRESS OF LEVTAB
	HRRZ Q1,B		;GET ADDRESS OF CHNTAB
PISTA1:	RCM
	MOVE Q2,A		;GET CHANNEL MASK
	MOVE A,FORK
	RWM
	HLLZ B,B
	ETYPE <, LEVTAB=%4Y, CHNTAB=%5Y
 Levels in progress = %2U
 Channels enabled = %6U
 Channels Waiting = %1U>
	JRST EOLRET
;DSKSTAT

.DSKST::TRVAR <<DSCBUF,FILWDS>,DSKCN1,DSKCN2,DSKFL1,DSKFL2,EPFLG,EPDIR,EPWLS>
	NOISE <of directory>
	CALL CURNMS		;INPUT DIRECTORY NAME, GET # AND BITS IN A
	 ERROR <No such directory>
	MOVEM A,EPFLG		;SAVE THE FLAGS FROM RCDIR
	MOVEM B,EPWLS		;SAVE THE POINTER TO THE STRING
	MOVEM C,EPDIR		;SAVE THE DIR #
	CONFIRM
	SETZM DSKFL1		;CLEAR IN USE
	SETZM DSKFL2		;CLEAR DELETED
	SETZM DSKCN1		;CLEAR ASSIGNED
	SETOM DSKCN2		;FLAG FOR .GT. 1 DIR
DSKSTL:	MOVE A,EPDIR		;DIR TO COUNT PAGES FROM
	CALL DSKCNT		;COUNT PAGES
	SKIPL DSKCN2		;OTHER THAN FIRST DIR?
	 ETYPE <%_>		;YES, BLANK LINE
	MOVE A,EPDIR		;GET DIR NUMBER
	ETYPE < %1R%%_>		;PRINT IT
	GTDAL			;GET WHAT SYSTEM THINKS
	ADDM B,DSKCN1		;TOTAL ASSIGNED
	ADDM D,DSKFL1		;TOTAL IN USE
	AOS DSKCN2		;COUNT 1 DIR
	ADDM Q2,DSKFL2		;TOTAL DELETED
	ETYPE < %2Q Pages assigned>
	CAIE Q2,0		;DON'T PRINT IF 0 DELETED
	 ETYPE <, %4Q in use, %6Q deleted>
	TLNE Z,F3
	 ETYPE <%_ Excluding file(s) that are list protected from you>
	ETYPE <%_ %1Q Working pages, %3Q Permanent pages allowed%_>
	JUMPE B,DSKSOK		;CAN'T BE OVER IF 0 USAGE
	MOVE D,B
	SUB B,A
	SUB D,C
	MOVE A,EPDIR		;DIRECTORY FOR PRINTOUT
	CAILE D,0
	 ETYPE < Over permanent storage allocation by %4Q page(s).%_>
	CAILE B,0
	 ETYPE < Over working storage allocation by %2Q page(s).%_>
DSKSOK:	CALL RLJFNS		;RELEASE JFNS FROM DSKCNT
	MOVE A,EPDIR		;NOW STEP TO THE NEXT DIR (IF ANY)
	MOVE B,EPWLS		;GET POINTER TO ORIGINAL STRING
	MOVE C,EPFLG		;GET FLAGS
	TXNE C,RC%WLD		;ANY WILD CARD CHARACTERS IN STRING?
	 CALL STPDIR		;YES, GO STEP THE DIR NUMBER
	  JRST SYSFRE		;NO MORE DIRS, PRINT SYSTEM
	MOVEM A,EPDIR		;SAVE THE NEW DIR NUMBER
	JRST DSKSTL		;LOOP BACK FOR THE OTHER DIRS

SYSFRE:	SKIPG DSKCN2		;.GT. 1 DIR PRINTED?
	 JRST SYSFR1		;NO, NO SUMMARY
	MOVE A,DSKCN1		;GET ASSIGNED
	ETYPE <%_ Total of %1Q Pages assigned>
	MOVE A,DSKFL1		;GET IN USE
	SKIPE B,DSKFL2		;GET DELETED
	 ETYPE <, %1Q in use, %2Q deleted>
	AOS A,DSKCN2		;MAKE # OF DIRS AND LOAD
	ETYPE <, in %1Q directories.%_>
SYSFR1:	HRROI A,DSCBUF		;POINTER TO FREE SPACE
	MOVE B,EPDIR		;DIRECTORY NUMBER ASKED ABOUT
	DIRST			;GET DIRECTORY NAME WRITTEN INTO FREE SPACE
	 ERCAL JERRE		;THIS SHOULD NOT FAIL
	HRROI B,[ASCIZ/GET.NAM/] ;PUT IN A RANDOM FILE SPEC
	SETZ C,			;END ON NULL
	SOUT			;NOW WE'VE GOT COMPLETE FILESPEC
	LDF A,GJ%OFG!GJ%SHT	;SHORT FORM GTJFN, NAME ONLY( NO REAL FILE)
	HRROI B,DSCBUF		;POINTER TO FILESPEC
	CALL GTJFS		;PARSE THE FILESPEC( FOR STRUCTURE NAME)
	 CALL JERR		;SHOULDN'T FAIL FOR JUST A PARSE!
	MOVE B,A		;PUT JFN IN B
	HRROI A,DSCBUF		;POINTER TO FREE SPACE
	LDF C,FLD(.JSAOF,JS%DEV) ;SPECIFY DEVICE FIELD, NO PUNCUATION
	JFNS			;ISOLATE THE STRUCTURE NAME
	SETZ B,			;END WITH NULL
	IDPB B,A
	HRROI A,DSCBUF		;POINT AT STRUCTURE NAME
	STDEV			;GET THE DEVICE DESIGNATOR FOR STRUCTURE
	 CALL JERRE		;ERROR CODE IN B, UNEXPECTED ERROR
	MOVE A,B		;PUT DESIGNATOR IN A
	GDSKC
	HRROI C,DSCBUF		;GET POINTER TO STR NAME
NEWF,<	ETYPE < %2Q Pages free on %3M:, %1Q pages used.%_>>
NONEWF,<ETYPE < %2Q Pages free on %3M:%_>>
	RET

DSKCNT:	SETZB D,Q2		;FOR SUMS OF TOTAL AND DELETED PAGES
	MOVE B,A		;DIR NUMBER TO B
	HRROI A,DSCBUF		;GET STRING SPACE POINTER
	CAMN B,[-1]		;DEFAULT DIRECTORY?
	 JRST DSKCN0		;YES
	DIRST			;STORE DIR STRING
	 CALL CJERR		;WE JUST SCANNED IT?!
DSKCN0:	MOVE B,A
	HRROI A,[ASCIZ/*.*/]
	SETZ C,			;READ TO NULL
	SIN			;APPEND TO STRING
	MOVX A,GJ%OLD!GJ%DEL!GJ%IFG!GJ%PHY!GJ%SHT;OLD, *'S, SHORT CALL, INCL.
				;   DELETED, PHYSICAL DEVICE ONLY 
	HRRI A,.GJALL		;* VERSION
	HRROI B,DSCBUF		;GET STRING POINTER
	CALL GTJFS		;GET JFN
	 CALL  [CAIE A,GJFX20
		 CAIN A,GJFX32
		  JRST [ADJSP P,-1 ;FOR NO FILES IN DIRECTORY,
			SETZ Q3, ;CLEAR TOTAL
			RET]	;TYPE "0 PAGES"
		JRST CJERR]
	MOVE Q1,A

;LOOP OVER FILES WITH GNJFN
DSKST1:	TLZ Z,F1		;RESET DELETED BIT
	HRRZ A,Q1		;JFN ONLY
	MOVE B,[1,,.FBCTL]	;CONTROL BITS WORD OF FDB
	MOVEI C,C		;TO BE PUT IN C
	CALL $GTFDB		;GET IT
	 JRST DSKST2		;COULDN'T
	TXNE C,FB%DEL		;DELETED?
	 TLO Z,F1		;YES, SAY SO
	SIZEF			;7 save some time
;7	MOVE B,[1,,.FBBYV]	;# PAGES IN RH
;7	MOVEI C,C
;7	CALL $GTFDB		;DO GTFDB JSYS, NO SKIP IF NO ACCESS
DSKST2:	 TLOA Z,F3		;SAY ACCESS ERROR AND SKIP ADD
	  JRST DSKST4		;GO ADD UP PAGES
DSKST3:	MOVE A,Q1		;JFN AND FLAGS
	GNJFN			;STEP TO NEXT FILE
	 JRST .+2		;NO MORE FILES
	JRST DSKST1
	MOVE Q3,D		;FORM SUM
	ADDI Q3,(Q2)		;OF DELETED AND UNDELETED
	RET			;PRINT RELEVANT NUMS, RELEASE JFN

DSKST4:	TLNE Z,F1		;SUM DELETED OR UNDELETED
	 JRST .+3
	ADDI D,(C)		;UNDELETED TOTAL
	JRST DSKST3
	ADDI Q2,(C)		;DELETED TOTAL
	JRST DSKST3

;CHECK CONNECTED DIRECTORY FOR EXCEEDING DISK ALLOCATION 
;   USED BY LOGIN, LOGOUT, CONNECT
CHKDAL::GJINF
CHKDL3:	MOVE D,B		;SAVE CONNECTED DIR
	MOVE A,B		;PUT DIR NUM IN A
	GTDAL			;GET QUOTA AND CURRENT ALLOC
	 ERJMP R		;DON'T TRY TO PRINT OVER QUOTA IF THIS FAILS
	JUMPE B,R		;NO MESSAGE IF 0 USAGE
	CAME D,LIDNO		;IS THIS LOGGED IN DIR?
	 JRST CHKDA1		;NO, CHECK PERM STORAGE
	SUB B,A			;GET AMOUNT OVER WORKING QUOTA
	CAILE B,0		;SKIP IF NOT OVER
	 ETYPE < %4R Over working storage allocation by %2Q page(s).%_>
	RET

CHKDA1:	SUB B,C			;GET AMOUNT OVER PERMANENT QUOTA
	CAILE B,0		;SKIP IF NOT OVER
	 ETYPE < %4R Over permanent storage allocation by %2Q page(s).%_>
	RET
;INFORMATION ABOUT MAIL
;   TELLS IF THERE IS NEW MAIL FOR A USER DEFAULTS TO SELF
.MALST::NOISE <for user>
NONEWF,<CALL USRNAM		;GET USER NAME. DEFAULT TO SELF
	 ERROR <No such USER>
       >
NEWF,<	CALL USRNAM		;GET USER NAME. DEFAULT TO SELF
MIT,<	 ERROR <No such user>>	;7 this makes more sense
				;7 doesn't do anything worthwhile
NOMIT,<	JRST   [MOVEI B,[FLDDB. .CMKEY,,[1,,1
					[ASCIZ "SYSTEM"],,0]]
		SKIPE CUSRNO	;7 don't do anything silly while not logged in
		 CALL FLDSKP
		  ERROR <No such user>
		CONFIRM
		HRROI B,[GETSAVE <SYS:MS.>]
		CALL TRYGTJ
		 RET
		PUSH P,[CMDIN2]	;RETURN HERE
		MOVX B,1	;OFFSET 1
		CALLRET REPH1]	;RUN MS AS EPHEMERON
       >>
	MOVE B,C		;USER NUMBER IN B
	CONFIRM
	CALL MALCHK		;SEE IF THAT USER HAS ANY NEW MAIL
	 JRST MALSTF		;MAIL.TXT NOT READABLE OR NO MAIL
				;STRING PNTR IN A
NEWF,<	TLNN B,77		;CHECK NET-MAIL
	 JRST  [ETYPE < Netmail %1\>
		JRST EOLRET]
	ETYPE < Mail %1\>
	JRST EOLRET
       >
NONEWF,<TYPE < New mail exists>
	JRST EOLRET
       >
MALSTF:	JUMPE A,MALSTN		;IF ZERO NO MAIL
	TYPE < Mailbox protected>
	JRST EOLRET

MALSTN:	TYPE < No new mail exists>
	JRST EOLRET

;INFORMATION ABOUT ALERTS

NEWF,<
.ALRST::NOISE <pending>
	CONFIRM
	SKIPG A,ALRTIM		;ANY PENDING?
	 JRST ALRST4		;NO
	ETYPE < Next alert at %1D %1E>
	SKIPE B,REASON		;USER MESSAGE
	 TYPE < - >
	ETYPE <%2\%%_>
	MOVSI D,-NALTS		;CHECK FOR MORE
ALRST2:	SKIPG A,ALRTMS(D)	;ANY?
	 JRST ALRST3		;EMPTY SLOT - GO ON
	TLON Z,F1		;FIRST TIME FLAG
	 ETYPE < Other alerts set for:%_>
	ETYPE <   %1D %1E>
	SKIPE B,REASON+1(D)	;MESSAGE TABLE
	 TYPE < - >
	ETYPE <%2\%%_>
ALRST3:	AOBJN D,ALRST2		;LOOP OVER ALL
ALRST5:	ETYPE <%_ Alerts are >
	SKIPN IITSET		;IF THE ALERT TIMER IS SET THER'RE AUTOMATIC
	 TYPE <not >
	ETYPE <automatic%_>
	RET			;DONE

ALRST4:	ETYPE < No alerts set%_>
	JRST ALRST5		;TELL IF THEY'RE AUTOMATIC AND RETURN
;INFORMATION (ABOUT) DOWNTIME

.DOWNT::SETOM TYPING		;SAY OUTPUT IN PROGRESS
MIT,<	HRROI B,[GETSAVE <SYS:DOWN.>]>	;7 as usual, we run something else
NOMIT,<	HRROI B,[GETSAVE <SYS:MHALT.>]>
	CALL TRYGTJ
MIT,<	 ERROR <DOWN utility not installed at this site> ;7 be helpful
	MOVX B,3		;7 offset 3 for listing shutdowns
       >			;7
NOMIT,<  RET			;DON'T SAY ANYTHING (SNICKER, SNICKER)
	MOVX B,2		;START AT OFFSET 2 (ON THE VERSION NUMBER!)
       >
	CALLRET REPH1
       >			;end NEWF

;MEMSTAT
;  TYPES, FOR CURRENT FORK, # PAGES, ENTRY VECTOR, AND A TABLE GIVING IDENTITY
;  OF EACH PAGE IN FORK. 

	XRMBUF==BUFEND-1777	;7 start of buffer

.MEMST::SKIPGE FORK
	 JRST  [TYPE < No program>
		JRST EOLRET]
	TRVAR <LPC,NPGS,<XRMARG,4>> ;7 add XRMARG
	SETOM 2+XRMARG		;7 last section
	SETOM LPC		;LAST PAGE COUNTED
	SETZM NPGS		;NO PAGES YET
	MOVEI A,BUF0		;MAKE BYTE POINTER FOR BUILDING MESSAGE
	HRLI A,(ASCPTR)
	MOVEM A,COJFN
;SUBROUTINE TO TYPE MEMORY MAP FOR CURRENT FORK, FOR MEMSTAT.
;
;   ACS:	D/	PAGE #
;		Q1,Q2/	IDENTITY OF CURRENT PAGE, A LA RMAP A & B.
;		P3,P4/	SAVED IDENTITY OF 1ST PAGE OF GROUP.
;		Q3/ 	INCREMENT FOR PAGE # IN GROUP OF CONSECUTIVE PAGE
;			IDENTITIES. 
	MEMMXL==FILCRS+^D80	;MAXIMUM NUMBER OF CHARACTERS IN AN OUTPUT LINE
				;   OF INFO MEM 
	SETZ D,

;FIND EXISTING PAGE (TREAT INDIRECT POINTERS AS EXISTING)
MMAP1:	HRL A,FORK
MMAP2:	HRRZ B,COJFN		;SEE WHAT WORD WE'RE WRITING INTO
	CAIL B,<XRMBUF-1>-<MEMMXL/5> ;7 at end of buffer?
	 JRST  [CALL FIXIO	;REVERT IO TO REAL OUTPUT, SO WARNING GETS SEEN
		ETYPE <%%Memory map too fragmented for internal buffer - 
partial map being displayed...%_>
		JRST MMD1]
	CAIL D,HIGHPN+1
	 JRST MMAPDN		;NO MORE PAGES, DONE
	MOVE B,D		;7
	TRZ B,777		;7
	CAME B,2+XRMARG		;7
	 CALL XRMAP		;7
	MOVE A,D		;7 page number
	ANDI A,777		;7 page within section
	LSH A,1			;7
	DMOVE A,XRMBUF(A)	;7
	TXNN B,PA%PEX!PA%IND
	 AOJA D,MMAP2		;DOESN'T EXIST, TRY NEXT

;FOUND ONE, PRINT NUMBER
	CALL PAGID		;GET FULL IDENTITY
	 JRST .+1		;3-RETURN SUBR, BUT IRRELEVANT HERE.
	 SKIPA P3,Q1
	  MOVE P3,Q1		;SAVE IDENTITY FOR LATER COMPARISONS
	MOVE P4,Q2		;...AND PRINTING
	SETZ Q3,		;INIT # CONSECUTIVE IDENTITIES
	HRRZ B,D
	CALL TOCT		;PRINT PAGE NUMBER IN OCTAL

;LOOK AT IDENTITY OF NEXT PAGE
	CALL NPAGID		;STEPS D AND GETS IDENTITY
	 SOJA Q3,MMAP10		;DIFFERENT, GO TYPE IDENTITY
	  JRST MMAP6		;NEXT HIGHER IN SAME FILE OR FORK

;IDENTICAL, SEE HOW MANY MORE ARE
	CALL NPAGID
	 JRST .+1		;DIFFERENT
	 TDZA Q3,Q3		;NEXT HIGHER - SAY IDENTICAL NOT CONSEC GROUP
	  JRST .-3		;IDENTICAL, KEEP LOOKING
	JRST MMAP7		;GO PRINT "-# <FILE OR FORK> #

;GET HERE WHEN DONE MAKING TEXT
MMAPDN:	CALL FIXIO		;REVERT TO REAL OUTPUT STREAM
MMD1:	MOVE A,NPGS		;GET NUMBER OF PAGES
	ETYPE <%_%%1Q. pages>

;PRINT ENTRY VECTOR
	MOVE A,FORK
	CALL GETENT		;GET ENTRY VECTOR
	JUMPE B,MEMS3		;NONE
	ETYPE <, Entry vector location: %3y length: %2O> ;7 format change
MEMS3:	ETYPE<%_>
	SKIPN NPGS		;ANY PAGES?
	 RET			;NO, DONE!
	ETYPE<%_>
	UETYPE BUF0		;TYPE REST OF MESSAGE
	CALLRET UNMAP		;UNMAP BUFFER PAGES USED FOR TEXT

;NEXT HIGHER OF SAME FILE OR FORK, SEE HOW MANY MORE ARE CONSECUTIVE
MMAP6:	CALL NPAGID
	 JRST .+2		;DIFFERENT
	 JRST .-2		;CONSECUTIVE, KEEP LOOKING

;PRINT "-#" FOR GROUP OF IDENTICAL OR CONSECUTIVE PAGES
MMAP7:	PRINT "-"
	MOVEI B,-1(D)		;LAST IN GROUP WAS THE PREVIOUS PAGE
	CALL TOCT		;TYPE IN OCTAL
;MMAP...
;PRINT IDENTITY OF PAGES WHOSE #'S WE HAVE JUST PRINTED:
;   TYPICALLY FORK OR FILE NAME, # FOR A SINGLE PAGE OR IDENTICAL GROUP, 
;   #-# FOR CONSECUTIVE GROUP. ALL PRECEDED BY @ IF INDIRECT. 

MMAP10:	PRINT TAB
	PRINT " "
	TXNE P4,PA%IND
	 TYPE <@ >		;INDICATE INDIRECT POINTER
	TXNN P4,PA%PEX		;DOES PAGE EXIST?
	 JRST  [TYPE <No page>	;CAN HAPPEN WITH INDIRECT.
		JRST MMAP13]
	TXNE P4,PA%PRV
	 JRST  [TYPE <Private>
		JRST MMAP13]
	CAMN P3,[-1]		;RMAP RETURNS -1 IF NO JFN FOR FILE
	 JRST  [TYPE <Forgotten file>
		JRST MMAP13]
	LDB B,[POINT 9,P3,17]	;JFN OR FORK #
	TXNE P3,1B0		;ON IF FORK
	 JRST  [ETYPE <Fork %2O>
		JRST MMAP11]
	ETYPE <%2S>		;PRINT FILNAME
MMAP11:	TYPE <  >
	HRRZ B,P3
	CALL TOCT		;PAGE # IN FILE OR FORK
	JUMPLE Q3,MMAP13	;0 INDICATES ONE PAGE ONLY
	PRINT "-"
	ADDI B,-1(Q3)		;DON'T COUNT LAST PAGE TESTED!
	CALL TOCT		;PAGE # OF LAST PAGE OF CONSECUTIVE GROUP
MMAP13:	TYPE <  >
	TLZ Z,F1		;USED BY "BEFORE"
	TXNN P4,PA%RD
	 JRST .+3
	CALL BEFORE		;TYPE COMMA OR EOL BETWEEN ITEMS
	PRINT "R"
	TLNN P4,F3
	 JRST .+3
	CALL BEFORE		;SUBR WITH "AVAIL DEVICES"
	PRINT "W"
	TXNN P4,PA%CPY
	 JRST .+3
	CALL BEFORE
	TYPE <CW>		;COPY-ON-WRITE
	TXNN P4,PA%EX
	 JRST .+3
	CALL BEFORE
	PRINT "E"
	ETYPE<%_>
	JRST MMAP1		;GO BACK FOR ANOTHER PAGE OR GROUP
;SUBROUTINE FOR MMAP TO GET AND COMPARE IDENTITY OF PAGE
;
;   ACCEPTS:	D/	PAGE #
;		P3,P4/	IDENTITY OF FIRST PAGE IN GROUP,
; 		Q3/	PAGE # INCREMENT FOR CONSECUTIVE GROUP.
;   RETURNS: 	Q1,Q2/	IDENTITY OF PAGE, A LA RMAP.
;	     +1		DIFFERENT IDENTITY FROM FIRST PAGE OF GROUP
;	     +2		NEXT HIGHER PAGE # (THAN P4+Q3, Q3), Q3 INDEXED
;	     +3		IDENTICAL
;   IF D > 37777, BEHAVES AS THOUGH CURRENT PAGE IS NON-EXISTENT.
;   CLOBBERS A,B.
NPAGID:	AOJ Q3,			;ENTRY FOR NEXT PAGE
	AOS A,D			;7
	TRNN A,777		;7 new section?
	 RET			;7 yes, say it is not like previous pages
PAGID:	MOVE A,D		;ENTRY TO NOT INDEX PAGE #
	SETZ Q1,		;FOR NON-EXISTENT OR PRIVATE PAGE
	CAIL A,HIGHPN+1
	 JRST  [MOVX Q2,PA%PEX	;PAGES OVER HIGHPN DON'T EXIST
		JRST PAGID8]
	HRL A,FORK
	MOVE C,A		;GET COPY OF HANDLE TO CHECK FOR PRIVATENESS
	MOVE B,D		;7 page #
	TRZ B,777		;7 first page in section
	CAME B,2+XRMARG		;7 same as current map?
	 CALL XRMAP		;7
	MOVE A,D		;7 page number
	ANDI A,777		;7 within section
	LSH A,1			;7 two words per entry
	DMOVE A,XRMBUF(A)	;7
	CAMN A,C		;DID RMAP RETURN SAME HANDLE AS GIVEN?
	 TXO B,PA%PRV		;YES, SO PAGE IS PRIVATE
	HLLZ Q2,B		;RETURN RPACS INFO IN Q2
	MOVE Q1,A		;REMEMBER IDENTIFIER
	TXNN Q2,RM%PEX		;DOES PAGE EXIST?
	 JRST PAGID8		;NO - SKIP THIS
	HRRZ C,C		;YES - SEE WHAT PAGE THIS IS
	CAMG C,LPC		;LARGER THAN ONE ALREADY COUNTED?
	 JRST PAGID8		;NO - DON'T COUNT IT AGAIN
	MOVEM C,LPC		;YES - REMEMBER LARGEST COUNTED
	AOS NPGS		;COUNT NUMBER OF EXISTENT PAGES

;COMPARISON TO DETERMINE WHETHER SAME AS PREVIOUS PAGE
;   COMPARE THAT INFO WHICH IS PRINTED: ALL Q1, Q2 BITS 2-6, 9, 10.
PAGID8:	MOVE A,Q1
	XOR A,P3
	TLNE A,-1
	 RET			;DIFFERENT FILES OR FORKS - NORMAL RETURN
	MOVE B,Q2		;RMAP'S ACCESS IS WRONG
	XOR B,P4
	TXNE B,37B6!3B10
	 RET			;DIFFERENT ACCESS - NORMAL RETURN
	TRNE A,-1
	 JRST PAGI81
	AOS (P)			;SAME IDENTITY INCLUDING PAGE # - 2-SKIP RETURN
	AOS (P)
	RET

PAGI81:	MOVE A,Q3
	ADD A,P3
	SUB A,Q1
	TRNN A,-1
	 AOS (P)		;NEXT HIGHER PAGE # - SKIP RETURN
	RET			;REALLY DIFFERENT PAGE - NORMAL RETURN

;7 XRMAP - load RMAP info for a whole section into a table at XRMBUF
;7
;7  ACCEPTS:	B/	first page of current section
;7  CLOBBERS: A,B
XRMAP:	MOVEM B,2+XRMARG	;7
	MOVE A,D		;7
	LSH A,-9		;7 section #
	HRL A,FORK		;7
	RSMAP%			;7
	CAMN A,[-1]		;7 no such section?
	 JRST  [TRO D,777	;7 yes, skip to the end of the section
		SETOM XRMBUF	;7 clear the whole map
		SETZM XRMBUF+1	;7
		MOVE A,[XRMBUF,,XRMBUF+2] ;7
		BLT A,XRMBUF+1777 ;7
		RET]		;7
	PUSH P,B		;7
	MOVE B,D		;7
	LSH B,-9		;7
	ETYPE <%_  Section %2O	> ;7
	POP P,B			;7
	TXNE B,SM%RD		;7
	 TYPE <R, >		;7
	TXNE B,SM%WR		;7
	 TYPE <W, >		;7
	TXNE B,SM%EX		;7
	 TYPE <E, >		;7
	CAIN A,0		;7
	 ETYPE < Private%_>	;7
	CAIE A,0		;7 this should be expanded
	 ETYPE < special mapping%_> ;7
	MOVX B,4		;7 length of arg list
	MOVEM B,XRMARG		;7
	MOVX B,1000		;7 get the whole section
	MOVEM B,1+XRMARG	;7
	XMOVEI B,XRMBUF		;7 point to the map
	MOVEM B,3+XRMARG	;7
	HRLZ A,FORK		;7
	XMOVEI B,XRMARG		;7
	XRMAP%			;7
	RET			;7
;7 INFORMATION (about) NETWORK-STATUS

ONEON <ARPA,CHA,DECN>,<		;7
.INETW::			;7
ARPA,<	CALL .ANSTS>		;7 ARPAnet status
CHA,<	ETYPE <%_>		;7 skip a line
	CALL CHASTS		;7 CHAOSnet status
       >			;7
DECN,<	ETYPE <%_>		;7 skip a line
	CALL .DNTOP		;7 DECnet nodes, until .DNSTS works
       >			;7
	RET			;7
       >			;7

ARPA,<
.IARPA::KEYWD $IARPA
	 T status,ONEWRD,.ANSTS
	 JRST CERR
	JRST (P3)

$IARPA:	TABLE
;7	T host			;7 someday
	T status,ONEWRD,.ANSTS
	TEND

;INFORMATION (ABOUT) APRANET STATUS

.ANSTS:	MOVX A,SIXBIT/NETRDY/
	SYSGT			;GET NETWORK STATUS TABLE
	MOVEM B,NETRDY		;SET UP FOR GTB
	HRR A,B			;GET TABLE NUMBER
	HRLI A,1		;MUST DO THIS GETAB HERE TO SEE IF THE
	GETAB			; TABLE EXISTS
	 JRST  [ETYPE <%%No ARPANET%_>
		RET]
	TYPE < ARPANET service is >
	JUMPN A,[ETYPE <enabled%_>
		JRST NTST01]
	ETYPE <disabled%_>
NTST01:	TYPE < The IMP interface is >
	SETZ D,			;SEE IF IMP IS UP
	GTB .NETRD
	JUMPE A,[ETYPE <down%_>	;IF ZERO, IMP IS DOWN
		JRST NTST02]
	JUMPG A,[ETYPE <initializing%_> ;IF POSITVE, IMP IS INITIALIZING
		JRST NTST02]
	ETYPE <up%_>		;IF NEGATIVE, IMP IS UP
NTST02:	MOVX D,6		;GET TIME OF LAST IMP UP TIME
	GTB .NETRD
	CAILE A,0
	 ETYPE < Most recent IMP ready line on-transition: %1W%%_>
	MOVX D,5		;AND LAST DOWN TIME
	GTB .NETRD
	CAILE A,0
	 ETYPE < Most recent IMP ready line off-transition: %1W%%_>
	RET			;END OF STATUS PRINTING
       >
;7 INFORMATION (about) CHAOSnet

CHA,<
.ICHA::	KEYWD $ICHA		;7 get keyword
	 T status,ONEWRD,CHASTS	;7
	 JRST CERR		;7
	JRST (P3)		;7

$ICHA:	TABLE			;7
;	T host,,CHAHST		;7
	T status,ONEWRD,CHASTS	;7
	TEND			;7

CHASTS:	MOVX A,SIXBIT/CHSTAT/	;7 get on/off status 
	SYSGT			;7
	HRROI A,[ASCIZ/on/]	;7
	CAIN A,0		;7
	 HRROI A,[ASCIZ/off/]	;7
	ETYPE < CHAOSnet is %1$%%_> ;7
	RET			;7 more when I figure out what to get
       >
;INFORMATION (ABOUT) DECNET

DECN,<
.IDECN::KEYWD $IDECN
	 T nodes,ONEWRD,.DNTOP
	 JRST CERR
	JRST (P3)

$IDECN:	TABLE
	T nodes,ONEWRD,.DNTOP
	TEND

;INFORMATION (ABOUT) DECNET STATUS

DELETE,<
.DNSTS:	MOVX A,BUFL-BUF0-.NDNLN-1 ;WORDS AVAILABLE FOR LINE TABLE
	MOVEM A,BUF0+.NDNLN	;TO COUNT WORD
	MOVX A,.NDGLI		;FUNCTION
	MOVEI B,BUF0
	NODE
	 ERCAL DNTOPE
	HLRZ A,BUF0+.NDNLN	;GET COUNT OF RETURNED NODES
	JUMPE A,DNSTSX
	SETO A,
	HRLZ A,A
	HRRI A,BUF0+.NDNLN+1	;WE NOW HAVE AOBJN POINTER
DNSTS3:	MOVE B,(A)		;GET POINTER TO NODE BLOCK
	MOVE C,.NDLST(B)	;GET LINE STATE
	HRROI D,[ASCIZ/unknown/]
	CAIN C,.NDLON
	 HRROI D,[ASCIZ/on line/]
	CAIN C,.NDLOF
	 HRROI D,[ASCIZ/off line/]
	CAIN C,.NDLCN
	 HRROI D,[ASCIZ/controller loopback/]
	CAIN C,.NDLCB
	 HRROI D,[ASCIZ/cable loopback/]
	MOVE C,.NDLNM(B)	;GET PORT NUMBER
	MOVE B,.NDLND(B)	;POINTER TO NODE NAME
	ETYPE < Line %3O, Node %2M, State is %4M%%_>
	AOBJN A,DNSTS3
	RET

DNSTSX:	ETYPE <%%No DECNET status%_>
	RET
       >			;END OF DELETE

;INFORMATION (ABOUT) DECNET NODES

.DNTOP:	TRVAR <NDTYP>
	MOVEI B,BUF0		;READ THE LOCAL NODE NAME INTO
	HRROI A,BUF0+1		;   THE FIRST 10 WORDS OF BUF0
	MOVEM A,BUF0+.NDNOD
	MOVX A,.NDGLN		;GET THE LOCAL NODE NAME
	NODE
	 ERCAL DNTOPE
	MOVX A,BUFL-BUF0-10-.NDNND-1
	MOVEM A,BUF0+10+.NDNND	;SAVE NUMBER OF WORDS AVAILABLE FOR THE TABLE
	MOVX A,.NDGNT		;READ THE NODE TABLE
	MOVEI B,BUF0+10
	NODE
	 ERCAL DNTOPE
	HLRZ A,BUF0+10+.NDNND	;GET COUNT OF RETURNED NODES
	JUMPE A,DNTOPX		;IF NONE, SAY SO
	HRROI B,BUF0+1		;SAY WHAT THE LOCAL NODE IS
	ETYPE < Local DECNET node: %2M%%_>
	MOVN A,BUF0+10+.NDNND	;MAKE AN AOBJN POINTER TO THE LIST
	HRRI A,BUF0+10+.NDBK1
	ADD A,[1,,0]
	PUSH P,A
	TLO Z,F2		;INDICATE A TAB IS WANTED BETWEEN ITEMS

;MOVE ALL THE STRING POINTERS INTO THE TABLE; SKIP THOSE WHICH ARE OFF-LINE
	MOVX C,.NDSON		;GET NODE ON-LINE FLAG
DNTOP0:	MOVE B,(A)		;GET POINTER TO NODE BLOCK
	CAME C,.NDSTA(B)	;IS THE NODE ON-LINE?
	 JRST DNTOP1		;NO - SKIP IT
	MOVE B,.NDNAM(B)	;YES - GET NODE NAME POINTER
	MOVEM B,(A)		;SAVE IT IN NODE TABLE
	AOBJN A,DNTOP0		;LOOP THROUGH TABLE

;NOW LOOP THROUGH THE STRINGS - OUTPUT THE LOWEST ALPHABETICALLY, ELIMINATE IT,
;   AND LOOP 
DNTOP2:	POP P,A			;GET THE AOBJN POINTER AGAIN
	SETOM NDTYP		;SAY NO NODES HAVE BEEN PRINTED YET
DNTOP3:	SKIPN D,(A)		;GET FIRST STRING POINTER - ANY?
	 JRST DNTOP7		;NO - SKIP THIS ITERATION
	PUSH P,A		;YES - SAVE AOBJN POINTER
	JRST DNTOP5		;SET UP THE FIRST STRING

DNTOP4:	SKIPE D,(A)		;GET A STRING POINTER - ANY?
	 CAMG B,(D)		;YES - IS THIS STRING SMALLER?
	  JRST DNTOP6		;NO - SKIP IT
DNTOP5:	MOVE B,(D)		;YES - SET IT UP INSTEAD
	MOVE C,A		;GET ITS INDEX, TOO
DNTOP6:	AOBJN A,DNTOP4		;LOOP THROUGH ALL STRINGS
	AOSN NDTYP		;DO HEADER ONLY AT BEGINNING OF LIST
	 TYPE < Accessible DECNET nodes are:>
	CALL BEFORE
	MOVE A,(C)		;OUTPUT THE WINNING STRING
	ETYPE <%1M>
	POP P,A			;GET THE AOBJN POINTER BACK
	MOVE B,(A)		;STORE THE FIRST ITEM WHERE THIS ONE WAS
	MOVEM B,(C)
DNTOP7:	AOBJN A,DNTOP3		;DO THE OUTER LOOP
	SKIPGE NDTYP		;GIVE MESSAGE ONLY IF NONE PRINTED
DNTOPX:	 TYPE <%No DECNET nodes accessible>
	ETYPE <%_>		;END IT ALL WITH A CARRIAGE RETURN; DONE
	TLZ Z,F2		;CLEAR TAB FLAG
	RET

DNTOP1: SETZM (A)		;OFF-LINE - CLEAR POINTER
	AOBJN A,DNTOP0		;LOOP THROUGH TABLE
	JRST DNTOP2		;THEN JOIN THE AFTER-LOOP FLOW

DNTOPE:	CALL %GETER
	MOVE A,ERCOD		;GET FAILURE REASON
	CAIN A,ARGX04		;NOT ENOUGH SPACE?
	 JRST DNTPE1		;YES, PRINT WARNING
	CAIE A,ILINS2		;NO NODE JSYS?
	 CAIN A,ARGX02		;OR ILLEGAL FUNCTION?
	  RET			;YES, RETURN AS IF EMPTY TABLE
	JRST CJERR		;OTHERWISE THE ERROR IS REAL FLAKY

DNTPE1:	ETYPE <%%Not enough storage, incomplete data will be printed%_>
	RET
       >			;713 end DECN

;FILSTAT

.FILST::NOISE <of JFN>
	OCTX <Octal JFN number or carriage return for all>
	 JRST FILST1		;NON-OCTAL NUMBER TYPED, CHECK FOR BLANK
	CONFIRM			;CONFIRM THE NUMBER
	CAIG B,MAXJFN		;LEGAL JFN NUMBER?
	 CAIG B,0
	  ERROR <Illegal JFN number>
	MOVE D,B		;SAVE JFN FOR JSTAT
	MOVE A,B		;PUT JFN IN A
	GTSTS
	TXNN B,GS%NAM		;JFN ACTIVE?
	 ERROR <JFN not in use>
	CALLRET JSTAT		;PRINT INFO FOR JFN

FILST1:	CONFIRM
	GJINF
	ETYPE < Connected to %G%.  JFNS:%_> ;JFNS
	MOVEI D,MAXJFN		;JFN AND COUNTER
	CALL JSTAT		;TYPE INFO IF JFN ASSIGNED
	SOJGE D,.-1
	 ETYPE<%_>

;DEVICES ASSIGNED TO THIS JOB
	PUSH P,[[TLNE Z,F1	;SET RETURN FOR ASTTJ
		 ETYPE<%_>
		RET]]

;"AVAILABLE DEVICES" ALSO COMES HERE TO TYPE DEVS ASS TO THIS JOB.
ASTTJ::	GJINF			;GET JOB # IN C
	MOVE Q1,C
	TLZ Z,F1
	CALL DEVLUP		;GET NAME & CHARACTERISTICS FOR EACH DEVICE AND
				;   EXECUTES THE NEXT LOCATION. 
	 CALL  [CAME C,Q1	;ASSIGNED TO THIS JOB?
		 RET		;NO.
		TLNN Z,F1	;FIRST ONE? ("BEFORE" SETS F1)
		 TYPE <Devices assigned to/opened by this job:>
		CALL BEFORE	;COMMA OR CR OR NIL. AFTER "AVAIL DEV".
		JRST SIXPRT]	;PRINT SIXBIT NAME FROM A.
	TLNE Z,F1
	 ETYPE<%_>
	RET
;TYPE STATUS OF JFN - USED IN "FILSTAT".
;   NOP IF UNASSIGNED. 
;   IF ASSIGNED, TYPE <JFN> <NAME> AND WHAT OPEN FOR AND "NOT OPEN" OR 
;	"DATA ERROR" OR "EOF" IF PERTINENT. 
;
;   ACCEPTS:	D/	RH IS JFN
;   DESTROYS A, B, C, E.  
JSTAT:	HRRZ A,D
	GTSTS
	TXNN B,GS%NAM
	 RET			;UNASSIGNED, RETURN.
	MOVE Q1,B		;STATUS FOR USE BELOW
	PRINT " "
	MOVE A,COJFN
	HRRZ B,D
	MOVX C,FLD(4,NO%COL)!FLD(10,NO%RDX)
	NOUT			;JFN, LEFT ADJ IN 4 COLS
	 CALL JERRC
	HRRZ B,D
	SETZ C,			;DEFAULT FORMAT
	JFNS			;PRINT NAME
	 ERJMP [CALL JFNSIL	;ANALYZE ERROR
		 JRST JFNGON	;JFN PROBABLY WENT AWAY
		JRST .+1]	;MESSAGE PRINTED, LIKE "RESTRICTED JFN"
;JSTAT...
;TYPE "NOT OPEN" OR LIST OF "READ", "EXECUTE", ETC.
;IF B0 ON AND B1-3 & 5-6 OFF, TYPES NOTHING. CAN THIS HAPPEN? ______
	PRINT TAB
	TLZ Z,F1		;TELL "BEFORE" NOTHING HAS BEEN PRINTED
	TXNN Q1,GS%OPN
	 TYPE < Not opened>
	TXNN Q1,GS%RDF
	 JRST JSTAT3
	CALL BEFORE		;TYPE SPACE OR COMMA-SPACE OR EOL-SPACE
	TYPE <Read>
JSTAT3:	TXNN Q1,GS%WRF		;OK TO WRITE
	 JRST JSTAT4
	CALL BEFORE
	TXNN Q1,GS%RND		;ALSO OK TO CHANGE POINTER?
	 TYPE <Append>		;NO
	TXNE Q1,GS%RND
	 TYPE <Write>		;YES
JSTAT4:	TXNN Q1,GS%XCF		;EXECUTE
	 JRST JSTAT5
	CALL BEFORE
	TYPE <Execute>
JSTAT5:	TXNN Q1,GS%APT		;AS SPECIFIED BY PAGE TABLE
	 JRST JSTAT6
	CALL BEFORE
	TYPE <New file>
JSTAT6:	TXNN Q1,GS%CAL		;CALL AS PROCEDURE
	 JRST JSTAT7
	CALL BEFORE
	TYPE <Overlapped dump I/O>
JSTAT7:	TXNN Q1,GS%ERR
	 JRST JSTAT8
	CALL BEFORE
	TYPE <Data error>
JSTAT8:	TXNN Q1,GS%EOF
	 JRST JSTAT9
	CALL BEFORE
	TYPE <EOF>
JSTAT9:	TXNE Q1,GS%RDF!GS%WRF
	 TXNN Q1,GS%OPN
	  JRST JSTA10
	TXNE Q1,GS%XCF
	 JRST JSTA10
	HRRZ A,D
	RFPTR
	 ERJMP [TXNN Q1,GS%FRK	;RESTRICTED?
		 JRST JFNGON	;NO, PRINT LOSE MESSAGE
		JRST JSTA10]	;SKIP POSITION
	CALL BEFORE
	MOVE A,COJFN
	MOVX C,FLD(^D10,NO%RDX)
	NOUT
	 CALL JERRC
	TYPE <.(>
	HRRZ A,D
	RFBSZ
	 ERJMP JFNGON		;JFN DISAPPEARED
	MOVE A,COJFN
	NOUT			;PRINT BYTE SIZE (C STILL SET FROM LAST NOUT)
	 CALL JERRC
	MOVX B,")"
	BOUT			;7 that's all TBOUT does!
;7	CALL TBOUT
JSTA10:	JRST EOLRET

;COME HERE IF A JSYS FAILS WHICH IS TRYING TO INTERROGATE THE JFN BEING
;   PRINTED.  THE USUAL FAILURE IS IF THE JFN GETS CLOSED WHILE THE
;   INTERROGATION IS GOING ON. 
JFNGON:	CALL DGETER		;GET THE REASON FOR THE FAILURE
	CAIE A,DESX3		;MAKE SURE IT'S "JFN IS NOT ASSIGNED"
	 CALL JERR		;STRANGE ERROR, SO FAIL
	ETYPE < ...[JFN has just been released]%_>
	RET			;CONTINUE WITH REST OF JFNS
;SUBROUTINE TO TYPE SYSTEM AND EXEC VERSIONS.
;   USED AT STARTUP TO PRINT SIGN-ON MESSAGE; THIS IS ALSO THE EXECUTION
;   ROUTINE FOR "VERSION" COMMAND. 

	MAXNAM==50		;ROOM FOR LONG NAME
	MAXPVS==2		;ROOM FOR THIS MANY PDVAS IN ONE GULP

.VERSI::STKVAR <PMF,PDVLFT,<PDATA,MAXPVS>,NAMADR,<PDVARG,1+.POADE>,NUMPDV,
NEXPDV> 
	CALL %VERSI		;PRINT MONITOR VERSION
	CALL EXECV		;PRINT EXEC VERSION
	SKIPG A,FORK		;ANY INFERIOR FORK?
	 RET			;NO
	CALL GETENT		;GET ENTRY VECTOR
	CAIE B,(<JRST>)		;COMPATIBLE?
	 JRST  [CAIGE B,3	;NO, DOES +2 EXIST?
		 JRST NOVERS	;NO, NO VERSION
		MOVE A,C	;GET ADDRESS OF ENTRY VECTOR
		ADDI A,2	;OFFSET TO VERSION NUMBER
		JRST ISVER1]
	MOVEI A,.JBVER##	;READ VERSION WORD
ISVER1:	CALL VERGET
NOVERS:	 SETZ Q1,		;NO VERSION
	MOVE A,FORK
	SKIPE A,SLFTAB(A)	;GET FRKTBL PNTR
	 SKIPN A,.FKPTM+TTWPNM(A) ;NAME ENTRY
	  JRST [JUMPE Q1,VERSI2
		TYPE < Version is >
		JRST VERSI0]
	TYPE < Program is >
	PUSHJ P,SIXPRT
	JUMPE Q1,[ETYPE <%_>
		  JRST VERSIX]
	TYPE <, version is >
VERSI0:	CALL VERPNT		;PRINT VERSION
VERSIX:	MOVE A,FORK
	GCVEC			;GET COMPATIBILITY ENTRY VECTOR
	 ERJMP [SETO B,		;7 error, assume disabled
		JRST .+1]	;7
	JUMPLE B,VN		;MAYBE COMPATIBILITY DISABLED OR NOT THERE
	HLRZ A,B
	CAIGE A,2		;DOES VERSION ENTRY EXIST?
	 JRST VN		;NO
	MOVEI A,2(B)		;GET ADDR
	CALL VERGET		;GET VERSION
	 JRST VN		;LEAVE IF NONE
	TYPE < UUO simulation in use, version is >
	CALL VERPNT		;PRINT VERSION AND LEAVE
VN:	MOVE A,FORK		;GET CURRENT FORK HANDLE
	MOVEM A,.POPHD+PDVARG	;TELL MONITOR WHAT FORK TO LOOK AT
	MOVX A,MAXNAM		;GET ROOM FOR LONG NAME
	CALL GETBUF
	MOVEM A,NAMADR		;REMEMBER ADDRESS OF NAME BUFFER
	SETZM .POADR+PDVARG	;FIRST TIME THROUGH, RANGE IS EVERYTHING
	SETOM PMF		;CAUSE TITLE FIRST TIME THROUGH
VN3:	MOVX A,MAXPVS		;TELL MONITOR MAXIMUM PDVS WE CAN LIST
	MOVEM A,.POCT2+PDVARG
	MOVEI A,PDATA		;GET ADDRESS OF DATA
	MOVEM A,.PODAT+PDVARG	;TELL MONITOR WHERE TO PUT LIST OF PDVS
	MOVX A,1+.POADR		;SAY LENGTH OF ARGUMENT BLOCK
	MOVEM A,.POCT1+PDVARG
	MOVX A,.POGET		;TELL MONITOR WE WANT TO GET THE PDVAS
	MOVEI B,PDVARG		;SAY WHERE ARG BLOCK IS
	PDVOP%			;GET LIST OF PDVAS
	 ERJMP [CALL DGETER	;FAILED, GET REASON
		CAIN A,ILINS2	;NO SUCH JSYS?
		 RET		;RIGHT, SO O.K.
		CALL JERR]	;NO, SO UNEXPECTED ERROR
	SETZM NEXPDV		;START WITH INDEX 0
	HRRZ A,.POCT2+PDVARG	;GET NUMBER OF PDVS TO DEAL WITH
	MOVEM A,NUMPDV		;REMEMBER HOW MANY
	HLRZ B,.POCT2+PDVARG	;GET NUMBER THAT WERE AVAILABLE
	SUB B,A			;GET NUMBER LEFT TO READ
	MOVEM B,PDVLFT		;REMEMBER HOW MANY LEFT TO READ
VN1:	MOVE A,NEXPDV		;SEE WHICH ONE IS NEXT TO BE EXAMINED
	CAML A,NUMPDV		;HAVE WE EXAMINED THEM ALL YET?
	 JRST  [SKIPG A,PDVLFT	;YES, SEE IF MORE IN MONITOR
		 RET		;NO
		MOVE A,MAXPVS-1+PDATA ;GET LARGEST PDVA WE'VE SEEN
		ADDI A,1	;SAY TO START WITH NEXT
		MOVEM A,.POADR+PDVARG ;TELL MONITOR TO START WITH NEXT
		JRST VN3]	;GO READ NEXT GROUP
	ADDI A,PDATA		;NO, GET ADDRESS HOLDING NEXT PDVA
	MOVE A,(A)		;GET THE PDVA
	MOVEM A,.POADR+PDVARG	;TELL MONITOR WHICH ONE TO READ
	MOVX A,1		;VERSION IS ONLY ONE WORD
	MOVEM A,.POCT2+PDVARG
	MOVX A,1+.POADR		;SET UP NUMBER OF WORDS IN ARGUMENT BLOCK
	MOVEM A,.POCT1+PDVARG
	MOVEI A,Q1		;WRITE VERSION INTO Q1
	MOVEM A,.PODAT+PDVARG
	MOVX A,.POVER		;NOW READ VERSION OF THIS PROGRAM
	MOVEI B,PDVARG
	PDVOP%
	 ERJMP [CALL DGETER
		MOVE B,.POADR+PDVARG
		LERROR <Can't read version for PDV at %2O - %1?>
		JRST VN2]
	MOVX A,MAXNAM		;GET MAXIMUM NAME LENGTH
	MOVEM A,.POCT2+PDVARG
	MOVE A,NAMADR		;GET ADDRESS OF NAME BUFFER
	MOVEM A,.PODAT+PDVARG
	MOVX A,.PONAM		;SAY WE WANT TO READ NAME
	MOVEI B,PDVARG		;SAY WHERE ARG BLOCK IS
	PDVOP%			;READ NAME OF THIS PDV
	 ERJMP [CALL DGETER	;CAN'T GET IT.  GET WHY NOT
		MOVE B,.POADR+PDVARG	;GET ADDRESS
		LERROR <Can't read program name for PDV at %2O - %1?>
		JRST VN2]	;PROGRAM IS PROBABLY RUNNING AND CHANGING ITS
				;   PDV STATUS OUT FROM UNDER US 
	HRRO A,NAMADR		;POINT TO THE NAME
	AOSN PMF		;IS THIS THE FIRST?
	 TYPE <PDVs:>
	ETYPE <	Program name %1M, version >
	CALL VERPNT		;PRINT VERSION OF THIS ONE
VN2:	AOS NEXPDV		;STEP TO NEXT ONE
	JRST VN1		;LOOP FOR REST

VERGET:	PUSH P,A
	CALL MAPPF
	 JRST  [POP P,A		;FAILED TO MAP-- NO
		RET]		; VERSION-- RETURN +1 FROM VERGET
	POP P,Q1
	TXNN B,PA%PEX
	 RET			;NO PAGE
	TXNN B,PA%RD
	 RET			;CAN'T READ IT
	ANDI Q1,777
	MOVE Q1,PAGEN(Q1)	;LOAD VERSION INTO Q1
	JUMPE Q1,[RET]
	RETSKP

IFNDEF VI%DEC,<VI%DEC==400000>	;120 NOT IN REL-5 MACSYM
IFN VI%DEC-400000,<PRINTX VI%DEC CODE AT VERPNT (EXECIN) IS BROKEN!>

VERPNT::LDB A,[POINTR Q1,VI%MAJ] ;GET MAJOR VERSION
	CAIE A,0
	 ETYPE <%1O>		;PRINT IF NON-ZERO
	LDB A,[POINTR Q1,VI%MIN] ;GET MINOR VERSION
	JUMPE A,VERSI1		;SKIP IF 0
	ETYPE <.%1O>		;PUT DOT AND OCTAL MINOR NON-ZERO VALUE
VERSI1:	HRRZ A,Q1		;GET EDIT NUMBER
	JUMPE A,VERSI3		;120 NOTHING, FORGET IT
	TXZN A,VI%DEC		;120 DECIMAL?
	IFSKP.			;120 YES,
	 ETYPE <(%1Q)>		;120 TYPE IT THAT WAY
	ELSE.			;120 ELSE IT IS OCTAL
	 ETYPE <(%1O)>		;120 SO PRINT THAT WAY
	ENDIF.			;120 DONE
VERSI3:
	LDB A,[POINTR Q1,VI%WHO] ;GET GROUP CODE
	CAIE A,0
	 ETYPE <-%1O>		;PRINT IF NON-ZERO
VERSI2:	ETYPE<%_>
	RET

;7 INFORMATION (about) ERROR-MESSAGES
;7  print out error string for corresponding error number

.IERRO::NOISE <for error number> ;7
	OCTX <octal error number> ;7
	 CMERRX			;7
	CONFIRM			;7
	MOVE A,B		;7
	TRO A,.ERBAS		;7 make it a valid error number
	PRINT " "		;7
	JRST $ERSTR		;7

;7 INFORMATION (about) MAIL-WATCH
;7  print out mail watch stuff
.IMWAT::STKVAR <IMWAPO>		;7 any print out so far
	SETZM IMWAPO		;7 no print out so far
	ETYPE < Mail watching is > ;7 is it on?
	SKIPE MWATCF		;7
	 JRST .IMWA1		;7
	TYPE <dis>		;7
	ABSKP			;7
.IMWA1:	 TYPE <en>		;7
	ETYPE <abled%_>		;7
	MOVEI D,NMWAT-1		;7 setup loop variable
	ABSKP			;7
.IMWA2:  SOJL D,.IMWA4		;7
	SKIPN C,MWATDR(D)	;7
	 JRST .IMWA2		;7
	SKIPN IMWAPO		;7 first one?
	 JRST  [SETOM IMWAPO	;7 yes, print header
		ETYPE <%_ Message Count   User%_> ;7
		JRST .+1]	;7
	MOVE A,MWATN0(D)	;7 print out message count and user
	TYPE <  >		;7
	CALL WRDNUM		;7
	ETYPE <   %3N%%_>	;7
	JRST .IMWA2		;7
.IMWA4:	RET			;7

;7 INFORMATION (about) REGISTERS
;7  print out the values of DISPLAY command's reisters
.INREG::ETYPE < Register Value%_> ;7 header
	MOVE A,[-DSPRSZ,,DSPREG] ;7 counter
	MOVX B,1		;7
INREG1:	MOVE C,(A)		;7
	ETYPE <   %2#	    %3#%%_> ;7 print a register
	ADDI B,1		;7
	AOBJN A,INREG1		;7 loop
	RET			;7

LITSIN:				;713 debugging aid: literals label
	END