Google
 

Trailing-Edge - PDP-10 Archives - BB-M081T-SM - exec/execin.mac
There are 47 other files named execin.mac in the archive. Click here to see a list.
; Edit= 4419 to EXECIN.MAC on 9-Feb-89 by GSCOTT
;INFORMATION JOB command should show network origin. %L now will output this. 
; Edit= 4416 to EXECIN.MAC on 10-Jan-89 by RASPUZZI
;Add commands and modify INFO SYS for password dictionary.
; Edit= 4412 to EXECIN.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4410 to EXECIN.MAC on 15-Aug-88 by GSCOTT
;Correct minor error in INFORMATION REMOTE-PRINTING. 
; UPD ID= 4122, RIP:<7.EXEC>EXECIN.MAC.11,   7-Mar-88 18:23:26 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4099, RIP:<7.EXEC>EXECIN.MAC.10,  18-Feb-88 15:47:16 by RASPUZZI
;TCO 7.1231 - Add new display for IN SYS to show min password length.
; UPD ID= 4096, RIP:<7.EXEC>EXECIN.MAC.9,  26-Jan-88 11:14:24 by EVANS
;TCO 7.1199 - Grump 149. Prevent pushdown overflow by JRST'ing to
;		TRYARP: instead of CALLing it.
; UPD ID= 4092, RIP:<7.EXEC>EXECIN.MAC.8,  19-Jan-88 15:44:48 by EVANS
;TCO 7.1189 - EXEC Cleanup. Tell user if structure Exclusive to this
;		processor, in response to INFO STRUCTURE command.
; UPD ID= 41, RIP:<7.EXEC>EXECIN.MAC.7,  22-Oct-87 11:03:56 by RASPUZZI
;TCO 7.1076 - Add INFO CLUSTER-SEND and INFO CLUSTER-INFO commands
; UPD ID= 30, RIP:<7.EXEC>EXECIN.MAC.6,  30-Sep-87 16:10:44 by EVANS
; TCO 7.1068 - Implement the display of printers ("aliases") for
;		INFORMATION (ABOUT) REMOTE-PRINTING
; UPD ID= 27, RIP:<7.EXEC>EXECIN.MAC.5,  23-Sep-87 15:50:57 by MCCOLLUM
;TCO 7.1063 - Add Offline Structures display to INFO SYSTEM and INFO STR.
;             Fix up INFO DISK to display STRX10 message
; UPD ID= 21, RIP:<7.EXEC>EXECIN.MAC.4,  22-Sep-87 11:24:52 by EVANS
; More TCO 7.1061 - Fill in TCO numbers around edits and add header line.
; UPD ID= 13, RIP:<7.EXEC>EXECIN.MAC.3,  22-Sep-87 10:46:42 by EVANS
; TCO 7.1061 - Implement INFORMATION (ABOUT) REMOTE-PRINTING.
; *** Edit 3063 to EXECIN.MAC by MCCOLLUM on 21-Apr-87, for SPR #20642
; Release unwanted fork handles after a GFRKS% JSYS 
; *** Edit 3052 to EXECIN.MAC by EVANS on 17-Nov-86
; Fix edit 3051 - make "SKIPE B," "SKIPE B" 
; *** Edit 3051 to EXECIN.MAC by EVANS on 29-Oct-86, for SPR #21265
; If a program has no entry vector, or an old-style entry vector, make the EXEC
; get the version from .JBVER 
; *** Edit 3041 to EXECIN.MAC by MCCOLLUM on 24-Jun-86, for SPR #21297
; Add ^ESET [NO] LOGINS LAT-TERMINALS and fix up @INFO SYS to display status 
; *** Edit 3040 to EXECIN.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; *** Edit 3037 to EXECIN.MAC by RASPUZZI on 21-May-86
; More of edit 3033 - extend GTJFN blocks so that the we have room for all
; GTJFN words when called. 
; *** Edit 3020 to EXECIN.MAC by EVANS on 13-Nov-85 (TCO none)
; Do not output a line if no data returned, for INFO CLUSTER.
; UPD ID= 275, SNARK:<6.1.EXEC>EXECIN.MAC.33,  30-Jul-85 09:49:38 by EVANS
;More TCO 6.1.1023 - Fix problem of I J printing blank line if no Account or Remark.
; UPD ID= 232, SNARK:<6.1.EXEC>EXECIN.MAC.32,  10-Jun-85 08:44:06 by DMCDANIEL
; UPD ID= 211, SNARK:<6.1.EXEC>EXECIN.MAC.31,  31-May-85 10:29:32 by EVANS
;More TCO 6.1.1404 - Take TERMNL out of TRVAR, it's now global.
; UPD ID= 205, SNARK:<6.1.EXEC>EXECIN.MAC.30,  24-May-85 14:13:56 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 199, SNARK:<6.1.EXEC>EXECIN.MAC.29,  21-May-85 10:29:44 by WAGNER
;More 6.1.1400 - Macro complained with a Q error, fix it.
; UPD ID= 198, SNARK:<6.1.EXEC>EXECIN.MAC.28,  20-May-85 14:09:23 by WAGNER
;TCO 6.1.1400 - TCO 6.1.1186 Missing .GJALL in arg block. Put in.
; UPD ID= 191, SNARK:<6.1.EXEC>EXECIN.MAC.27,  10-May-85 13:24:04 by EVANS
;More TCO 6.1.1023 - Output a carriage return even if no session remark.
; UPD ID= 188, SNARK:<6.1.EXEC>EXECIN.MAC.26,   6-May-85 11:10:45 by PRATT
;More TCO 6.1.1353 - ERJMP R should be a RET after call to GNJFS
; UPD ID= 174, SNARK:<6.1.EXEC>EXECIN.MAC.25,   3-May-85 08:31:16 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 156, SNARK:<6.1.EXEC>EXECIN.MAC.24,   2-May-85 11:16:50 by PRATT
;TCO 6.1.1353 - Have GNJFN's handle errors better
; UPD ID= 138, SNARK:<6.1.EXEC>EXECIN.MAC.23,  14-Mar-85 11:30:41 by SANTIAGO
;TCO 6.1.1262 - Make I DECNET sort nodes beginning with numbers before alphas.
; UPD ID= 130, SNARK:<6.1.EXEC>EXECIN.MAC.22,  11-Feb-85 14:19:59 by WAGNER
;TCO 6.1.1186 - Make DSKCNT routine use long for GTJFN% with G1%IIN.
; UPD ID= 126, SNARK:<6.1.EXEC>EXECIN.MAC.21,   6-Feb-85 14:42:01 by EVANS
;More TCO 6.1.1107 - Check for zero HSCs returned by CNFIG% .
; UPD ID= 124, SNARK:<6.1.EXEC>EXECIN.MAC.20,  11-Jan-85 09:52:55 by EVANS
;TCO 6.1.1130 - Remove part of INFO VOLUMES help message, which asks for colons
;		after tapeset name -colons are now optional.
; UPD ID= 117, SNARK:<6.1.EXEC>EXECIN.MAC.19,   4-Jan-85 15:46:55 by EVANS
;TCO 6.1.1107 - Add .CLUST - INFO CLUSTER
; UPD ID= 100, SNARK:<6.1.EXEC>EXECIN.MAC.18,   5-Dec-84 12:56:37 by EVANS
;More TCO 6.1.1023 - Don't display "Host FOO" if not on network or customer
;			left default node name (TOPS20).
; UPD ID= 96, SNARK:<6.1.EXEC>EXECIN.MAC.17,  21-Nov-84 15:43:02 by PALMIERI
;Handle all possible return flags from NODE jsys .NDVFY at .IDECN
; UPD ID= 87, SNARK:<6.1.EXEC>EXECIN.MAC.14,  12-Nov-84 16:28:50 by MERRILL
;TCO 6.1.1042 - Update for latest PCL we have
;  Make INFORMATION DEFAULT ALL tell of DECLARE defaults.
;  Make fork status printing stuff know about INVOKE'd forks.
; UPD ID= 57, SNARK:<6.1.EXEC>EXECIN.MAC.13,   9-Nov-84 11:06:40 by PRATT
;More TCO 6.1.1015 - Change processes to forks in INFO SUP for doc.
; UPD ID= 56, SNARK:<6.1.EXEC>EXECIN.MAC.12,   9-Nov-84 08:44:46 by PRATT
;More TCO 6.1.1023 - Only have account string typeout if present
; UPD ID= 55, SNARK:<6.1.EXEC>EXECIN.MAC.11,   5-Nov-84 17:03:07 by PAETZOLD
;Fix I ARPA for multiple local networks.
; UPD ID= 48, SNARK:<6.1.EXEC>EXECIN.MAC.10,  31-Oct-84 18:04:58 by PRATT
;More TCO 6.1.1023 - Force account string to next line
; UPD ID= 35, SNARK:<6.1.EXEC>EXECIN.MAC.8,  16-Oct-84 10:04:05 by EVANS
; UPD ID= 34, SNARK:<6.1.EXEC>EXECIN.MAC.7,  16-Oct-84 09:51:03 by EVANS
;TCO 6.1.1023 - Make INFO JOB tell the host name.
; UPD ID= 33, SNARK:<6.1.EXEC>EXECIN.MAC.6,   3-Oct-84 17:18:05 by PRATT
;TCO 6.2236 - Fix lowercase o problem in etype during I VER
; UPD ID= 31, SNARK:<6.1.EXEC>EXECIN.MAC.5,   3-Oct-84 17:09:03 by PRATT
;TCO 6.2235 - Fix problem with ^T during ^C of ephemoral programs
; UPD ID= 27, SNARK:<6.1.EXEC>EXECIN.MAC.3,   1-Oct-84 22:41:08 by PRATT
;TCO 6.1.1019 - Allow some commands to not require a colon for devices
; UPD ID= 6, SNARK:<6.1.EXEC>EXECIN.MAC.2,  29-Sep-84 14:58:23 by PRATT
;TCO 6.1.1015 - Add INFO SUPERIORS command
; UPD ID= 449, SNARK:<6.EXEC>EXECIN.MAC.61,  28-Sep-84 15:56:25 by MCCOLLUM
;TCO 6.2231 - Remove superfluous code in .LNLIS
; UPD ID= 443, SNARK:<6.EXEC>EXECIN.MAC.60,  26-Sep-84 15:11:01 by MCCOLLUM
;TCO 6.2228 - Call routine RTFLG1 instead of RTTFLG to return TTY flags.
; UPD ID= 428, SNARK:<6.EXEC>EXECIN.MAC.59,  23-Jul-84 14:20:32 by SANTIAGO
;MORE OF TCO 6.2129 - Use STKVAR instead of permanent storage.
; UPD ID= 420, SNARK:<6.EXEC>EXECIN.MAC.58,  17-Jul-84 14:26:17 by SANTIAGO
;TCO 6.2129 - Performance improvement on INFO DISK-USAGE
; UPD ID= 414, SNARK:<6.EXEC>EXECIN.MAC.57,  15-Jun-84 11:50:17 by MCCOLLUM
;TCO 6.2101 - Add warning to INFO LOGICAL command if name is not defined.
; UPD ID= 375, SNARK:<6.EXEC>EXECIN.MAC.56,  18-Jan-84 13:58:57 by PAETZOLD
;More TCO 6.1939 - Support .SFMS0, .SFMS1, and .SFBGS in SYSINF.
; UPD ID= 374, SNARK:<6.EXEC>EXECIN.MAC.55,  18-Jan-84 13:45:46 by PAETZOLD
;TCO 6.1939 - Support .SFMS0, .SFMS1, and .SFBGS in SYSINF.
; UPD ID= 370, SNARK:<6.EXEC>EXECIN.MAC.54,  28-Dec-83 16:39:12 by PRATT
;TCO 6.1796 - Add USER-MESSAGES, INHIBIT (NON-JOB OUTPUT) 
; UPD ID= 360, SNARK:<6.EXEC>EXECIN.MAC.53,  16-Dec-83 11:49:57 by TSANG
;MORE FOR TCO 6.1731
; UPD ID= 351, SNARK:<6.EXEC>EXECIN.MAC.52,  29-Nov-83 11:29:05 by PRATT
;TCO 6.1885 - Remove INFO DOWNTIME code.
; UPD ID= 348, SNARK:<6.EXEC>EXECIN.MAC.51,  29-Nov-83 10:49:54 by PRATT
;TCO 6.1874 - Run RDMAIL, not MS. Parse SYSTEM, add better help.
; UPD ID= 338, SNARK:<6.EXEC>EXECIN.MAC.50,  20-Nov-83 19:43:08 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 326, SNARK:<6.EXEC>EXECIN.MAC.49,  15-Nov-83 12:03:12 by PAETZOLD
;More TCO 6.1865 - Add the internet address to the INFO ARPA STAT command
; UPD ID= 325, SNARK:<6.EXEC>EXECIN.MAC.48,  15-Nov-83 08:58:10 by PAETZOLD
;TCO 6.1865 - Rewrite INFO ARPA STAT command.
; UPD ID= 314, SNARK:<6.EXEC>EXECIN.MAC.47,  10-Oct-83 15:04:19 by PRATT
;More TCO 6.1823 - Don't break on "-", "_", "$" characters in log name
; UPD ID= 313, SNARK:<6.EXEC>EXECIN.MAC.46,  10-Oct-83 13:07:34 by PRATT
;TCO 6.1823 - Allow INFO LOG Wildcarded-Device: 
; UPD ID= 306, SNARK:<6.EXEC>EXECIN.MAC.45,  10-Aug-83 15:57:35 by CHALL
;TCO 6.1766 DNTOP2- Output number of reachable nodes on I DECNET
; UPD ID= 302, SNARK:<6.EXEC>EXECIN.MAC.44,   1-Aug-83 09:14:05 by CHALL
;MORE TCO 6.1287 XRMAP- ADD ERJMP AFTER XRMAP%
; UPD ID= 301, SNARK:<6.EXEC>EXECIN.MAC.43,  22-Jul-83 11:24:02 by TSANG
;TCO 6.1731 - Add an error handling after TBADD JSYS call
; UPD ID= 297, SNARK:<6.EXEC>EXECIN.MAC.42,  11-Jul-83 14:52:52 by WEETON
;TCO 6.1715 - Put TCO 6.1715 in standard format
; UPD ID= 296, SNARK:<6.EXEC>EXECIN.MAC.41,   8-Jul-83 15:17:50 by WEETON
;TCO 6.1715 - Make version number come out in decimal (if VI%DEC is on)
; UPD ID= 228, SNARK:<6.EXEC>EXECIN.MAC.40,  12-Jan-83 15:34:01 by WEETON
;TCO 6.1141 - Set flag for ETYPE'ing last error message for INFO PROG
; UPD ID= 224, SNARK:<6.EXEC>EXECIN.MAC.38,  12-Jan-83 14:20:47 by WEETON
;TCO 6.1118 CORRECT RESPONSE TO "I SPOOL"
; UPD ID= 223, SNARK:<6.EXEC>EXECIN.MAC.37,  12-Jan-83 10:28:50 by WEETON
;TCO 6.1117 - Fix HELP<ESC> command
; UPD ID= 212, SNARK:<6.EXEC>EXECIN.MAC.36,   3-Jan-83 17:08:07 by LOMARTIRE
;TCO 6.1433 - Add code for ^ESET [NO] LOGINS-ALLOWED DECNET-LINES command
; UPD ID= 205, SNARK:<6.EXEC>EXECIN.MAC.35,   8-Dec-82 16:07:14 by CHALL
;TCO 6.1406 AVNOD- MAKE "NODE IS UNREACHABLE" A "%" ERROR
; UPD ID= 194, SNARK:<6.EXEC>EXECIN.MAC.34,  11-Nov-82 21:50:06 by CHALL
;TCO 6.1368 .IDECN- CHANGE "I DEC NODES" TO "I DEC";
; CHANGE "I AVAIL NODE FOO" TO "I DEC FOO" (.AVNOD MOVES UNDER .IDECN)
; ALLOW FOO, FOO: OR FOO:: AS THE NODE NAME
; UPD ID= 173, SNARK:<6.EXEC>EXECIN.MAC.33,  30-Sep-82 20:28:03 by CHALL
;TCO 6.1287 .MEMST-  speed up INFO MEMORY by using XRMAP%
; UPD ID= 150, SNARK:<6.EXEC>EXECIN.MAC.32,  11-Aug-82 15:06:08 by LEACHE
;TCO 6.1225 - Fix incorrect invocation of ETYPE in I PSI
; UPD ID= 145, SNARK:<6.EXEC>EXECIN.MAC.31,   5-Aug-82 09:24:22 by CHALL
;TCO 6.1210 FSTR1- AFTER CALL TO FSTAT, RESTORE AC D FROM SAVHD
; UPD ID= 138, SNARK:<6.EXEC>EXECIN.MAC.30,   4-Aug-82 17:24:29 by LEACHE
;TCO 6.1209 Fix JSYS trapping
; UPD ID= 125, SNARK:<6.EXEC>EXECIN.MAC.29,  24-Apr-82 12:25:30 by CHALL
;TCO 6.1101 CONSOLIDATE STUFF ABOUT TERMINALS (TTYPTB) IN EXECCA
; UPD ID= 111, SNARK:<6.EXEC>EXECIN.MAC.28,   9-Apr-82 09:42:06 by CHALL
;TCO 6.1088 TTYPTB- ADD VT102 TO NAME TABLE
; UPD ID= 109, SNARK:<6.EXEC>EXECIN.MAC.27,   8-Apr-82 17:16:06 by CHALL
;TCO 6.1086 TTYPTB- ADD VT125 AND VK100 TO NAME TABLE
; UPD ID= 94, SNARK:<6.EXEC>EXECIN.MAC.25,   8-Jan-82 15:54:03 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 74, SNARK:<6.EXEC>EXECIN.MAC.23,  22-Oct-81 14:50:38 by CHALL
;TCO 5.1583 MOVE $DEF- KEYWORDS FOR "INFO DEFAULTS" TO EXECCA
; UPD ID= 65, SNARK:<6.EXEC>EXECIN.MAC.22,  10-Oct-81 19:51:35 by CHALL
;TCO 6.1027 (.AVNOD) ADD "INFO AVAIL NODE FOO" COMMAND (UNDEF NEWF)
; UPD ID= 63, SNARK:<6.EXEC>EXECIN.MAC.21,   2-Oct-81 10:48:20 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)
; UPD ID= 59, SNARK:<6.EXEC>EXECIN.MAC.20,  21-Sep-81 14:58:52 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 10 AWAY FROM THE END (", XXX-XXX," HAS TO FIT)
;TCO 5.1524 .FILST- CHANGE blank TO carriage return IN HELP TEXT
; UPD ID= 19, SNARK:<6.EXEC>EXECIN.MAC.17,  17-Aug-81 10:12:01 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 11, SNARK:<6.EXEC>EXECIN.MAC.15,  20-Jul-81 11:17:43 by CHALL
;TCO 5.1421 - .INDEF: ADD "INFO DEFAULTS ALL"; MAKE IT THE DEFAULT
; UPD ID= 9, SNARK:<6.EXEC>EXECIN.MAC.14,  16-Jul-81 11:20:31 by C;TCO 5.1417 - .PISTA: IF RIR FAILS TRY AN XRIR%
; UPD ID= 2256, SNARK:<6.EXEC>EXECIN.MAC.9,  26-Jun-81 09:12:29 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
;<6.EXEC>EXECIN.MAC.8, 12-Jun-81 14:17:59, 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= 2025, SNARK:<6.EXEC>EXECIN.MAC.6,  19-May-81 10:25:26 by PURRETTA
;<6.EXEC>EXECIN.MAC.3, 13-Apr-81 14:58:38, Edit by DK32
;Add Information Default Declare
; UPD ID= 2010, SNARK:<6.EXEC>EXECIN.MAC.5,  15-May-81 15:26:25 by OSMAN
;tco 6.1012 - Remember to look at pdvs for version number when entry vector
; length is less than 3 and name is null.
; UPD ID= 2000, SNARK:<6.EXEC>EXECIN.MAC.4,  14-May-81 15:24:02 by MURPHY
;GLXSCH
; UPD ID= 1958, SNARK:<6.EXEC>EXECIN.MAC.3,   7-May-81 09:23:47 by GRANT
;TCO 5.1316 - Make @INF VER be able to handle an entry vector in a non-0 section
;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

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


	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,[XWD [ASCIZ /*/],[ASCIZ /*/]] ;DEFAULT NAME & EXT IS *
	HRLI B,-3		;DEFAULT VERSION IS *
	HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+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?
	TYPE <
>				;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 0(B)		;TYPE THE STRING
	RET
.AVAIL::KEYWD $AVAIL
	 T DEVICES,		;[TAH] CHANGE DEFAULT TO DEVICES
	 JRST CERR
				;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE
	JRST (P3)

$AVAIL:	TABLE
	T DEVICES,
	T LINES,,..TERM
	TA T			;"T" = "TERMINALS"
	T TELETYPES,,..TERM,CM%INV
.T:
.TE:
	T TERMINALS,,..TERM,CM%INV
	T TTYS,,..TERM,CM%INV
	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
	MOVEI Q1,0		;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,[POINT 9,B,17]	;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?
	TYPE <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,[360600,,A]	;GET FIRST CHARACTER
	CAIL B,'0'		;DOES NAME START WITH A DIGIT?
	CAILE B,'7'
	CAIA			;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'
	CAIA			;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,  FILSTAT,
;AND INFO CLUSTER.
;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT.

;CALL WITH F2 ON IN AC Z TO GET A TAB BETWEEN ITEMS, OFF TO GET A SPACE

BEFORE::ATSAVE
	MOVE A,COJFN
	MOVEI B,.MORLW
	MOVEI C,^D72		;USE 72 COLUMNS IF NOT A TERMINAL
	MTOPR			;GET LINE WIDTH
	 ERJMP .+1		;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 11		;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 AFTER CALL WITH SIXBIT NAME IN A
;    DEVICE CHARACTERISTICS WORD IN LH B
;    UNIT NUMBER IN RH OF B
;    -1 OR JOB # ASSIGNED TO IN C.
;	DEVICE DESIGNATOR IN D
;RETURNS +2.
;DESTROYS A, B, C, D.

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

;THIS ROUTINE TAKES DEVICE INDEX IN D AND DOES DVCHR, RETURNING
;DVCHR'S INFO IN A,B,C.  NOTHING ELSE IS CHANGED.
;RETURNS:
;	+1:	NO SUCH DEVICE
;	+2:	SUCCESS

.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,[440600,,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

.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
HLPERR:	 CMERRX <Invalid HELP request, try "HELP<RET>">	;INSERT LABEL
	LDB C,[331100,,.CMFNP(C)]	;SEE WHAT GOT TYPED
	CAIN C,.CMCFM		;CR?
	JRST BLURB		;YES, GO TYPE GENERAL HELP BLURB
REPEAT 0,<	CONFIRM>	;DELAY CONFIRMATION UNTIL AFTER FIX

REPEAT 0,<			;TCO#4.2475
	CAIN C,.CMTOK		;*?
	JRST TYPLST		;YES, TYPE OUT THE LIST
>

	MOVEM B,HITEM		;SAVE POINTER TO ITEM HELP DESIRED ABOUT
	TXNE A,CM%ESC		;WAS KEYWORD EXPLICITLY TYPED?
	JRST HLPCNF		;YES, SKIP CHECK
	HLRZ B,(B)		;CONSTRUCT BYTE POINTER TO KEYWORD NAME
	HRLI B,440700		;
	MOVE A,SBLOCK+.CMABP	;LOAD BYTE POINTER TO KEYWORD INPUT
	STCMP			;COMPARE STRINGS
	TXNE A,SC%SUB		;WAS A SUBSTRING INPUT?
	JRST HLPERR		;MOVE TO CONFIRM HERE
HLPCNF:	CONFIRM			;GET CONFIRMATION
	HRROI A,HLPBUF		;PREPARE TO CREATE FILENAME STRING
	HRROI B,[ASCIZ /HLP:/]
	MOVEI C,0		;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>
	MOVEI 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
	SETOM HELPSN		
	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

REPEAT 0,<			;TCO#4.2475
TYPLST:	HLRZ Q1,$HELP.		;GET NUMBER OF ENTRIES FOR WHICH THERE'S HELP
	JUMPE Q1,NOHELP		;SPECIAL CASE IF NONE
	TYPE <Help is available on these subjects:
>
	MOVEI Q2,0		;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:	TYPE <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:	MOVEI 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,1B8		;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
	 ERJMP .+2
	ADDI Q1,8+8		;POINT TO NEXT FILENAME ENTRY
	MOVE A,HLPJFN		;GET JFN AGAIN
	CALL GNJFS		;STEP TO NEXT HELP FILE
	 RET			;NO MORE IN THIS SET
	JRST HLP2		;GOT ANOTHER, GO PROCESS IT
;INFO (ON)

.INFOR::NOISE <ABOUT>
	TRVAR <RFERR,RFINFO>
	KEYWD $INFO
	 0
	 JRST CERR
	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, ARE WE?
	JRST (P3)		;OK
	ERROR <LOGIN please>
	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::CALL .IDC		;OUTPUT DEFAULTS FOR CARDS
	CALL .IDCS		;OUTPUT DEFAULTS FOR COMPILE-SWITCHES
	CALL .IDDCL		;[PCL] Output "Declare" default
	CALL .IDP		;OUTPUT DEFAULTS FOR PAPER-TAPE
	CALL .IDPL		;OUTPUT DEFAULTS FOR PLOT
	CALL .IDPRT		;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
;PCL Info Default Declare

.IDDCL:	HRROI A,[0]		;ASSUME NO NO
	MOVX B,PCFQDC		;GET QUIET-DECLARATION BIT
	TDNE B,PCFLAG		;IS IT SET?
	HRROI A,[ASCIZ /NO/]	;YES, NO CONFIRMATION
	ETYPE < SET DEFAULT DECLARE /%1MCONFIRM%_>
	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
	SKIPE C			;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

.INDIR::JRST EPRINT		;USE SAME CODE

;GET HERE ON "INFORMATION (ABOUT) COMMAND-LEVEL"
.EXECM::
	TYPE < SET >
	SKIPN CIDLYF
	TYPE <NO >
	TYPE <LATE-CLEAR-TYPEAHEAD
>
	TYPE < SET >
	SKIPN IITSET		;TIMER ENABLED?
	TYPE <NO >
	TYPE <AUTOMATIC (MAIL AND ALERT CHECKS)
>
	CALL INFOCE		;INFO ABOUT COMMAND EDITOR
	CALL IMETKY		;INFO ABOUT META KEY (COMMAND EDITOR)

	RET
;"INFORMATION (ABOUT) SYSTEM-STATUS"
SYSINF::MOVEI A,.SFOPR
	TMON
	TYPE < Operator is >
	SKIPN B
	TYPE <not >
	TYPE <in attendance
>
	MOVEI A,.SFRMT
	HRROI B,[ASCIZ / Remote logins /]
	CALL TYPALO
	MOVEI A,.SFLCL
	HRROI B,[ASCIZ / Local logins /]
	CALL TYPALO
	MOVEI A,.SFPTY
	HRROI B,[ASCIZ / Pseudo-terminal logins /]
	CALL TYPALO
	MOVEI A,.SFNVT
	HRROI B,[ASCIZ / ARPANET terminal logins /]
	CALL TYPALO
	MOVEI A,.SFMCB		;GET DECNET LOGINS ALLOWED BIT
	HRROI B,[ASCIZ / DECnet terminal logins /]  ;FIRST PART OF MSG
	CALL TYPALO		;PRINT MESSAGE ABOUT LOGIN PERMISSION
	MOVEI A,.SFLAT		;[3041]GET LAT LOGINS ALLOWED BIT
	HRROI B,[ASCIZ / LAT terminal logins /]	;[3041]FIRST PART OF MSG
	CALL TYPALO		;[3041]PRINT MESSAGE ABOUT LOGIN PERMISSION
	MOVEI A,.SFCTY
	TMON
	TYPE < Console terminal login >
	SKIPN B
	TYPE <is not >
	TYPE <allowed
>
	MOVEI A,.SFFAC
	TMON
	TYPE < Accounting is >
	SKIPN B
	TYPE <not >
	TYPE <being done
>
	MOVEI A,.SFCDE
	TMON
	SKIPE B
	TYPE < CHECKD found errors
>
	MOVEI A,.SFCDR
	SKIPE B
	TYPE < CHECKD is running
>
	MOVEI A,.SFAVR		;SEE IF ACCOUNT VALIDATION IN EFFECT
	TMON
	TYPE < Account validation is >
	CALL INSYED		;TYPE "ENABLED" OR "DISABLED"
	MOVEI A,.SFWSP		;SEE IF WORKING SET PRELOADING BEING DONE
	TMON
	TYPE < Working set preloading is >
	CALL INSYED
	MOVEI A,.SFMS0		;SYSTEM MESSAGE LEVEL ZERO
	TMON			;TELL ME ABOUT IT
	TYPE < Sending of system level zero messages is >
	CALL INSYED		;TELL US ABOUT THEM
	MOVEI A,.SFMS1		;SYSTEM MESSAGE LEVEL ONE
	TMON			;TELL ME ABOUT IT
	TYPE < Sending of system level one messages is >
	CALL INSYED		;TELL US ABOUT THEM
	MOVEI A,.SFBGS		;JOB 0 CTY OUTPUT
	TMON			;TELL ME ABOUT IT
	TYPE < Job zero CTY output is >
	CALL INSYED		;TELL US ABOUT THEM
	MOVEI A,.SFMTA		;DISPLAY STATE OF TAPE-DRIVE ALLOCATION
	TMON
	TYPE < Tape-drive allocation is >
	CALL INSYED
	MOVEI A,.SFRTW		;SEE IF RETRIEVAL-WAITS ALLOWED
	HRROI B,[ASCIZ / Automatic file-retrieval-waits /]
	CALL TYPALO		;TYPE WHETHER ALLOWED OR NOT
	MOVEI A,.SFMCY		;GET TAPE RECYCLE PERIOD
	TMON
	ETYPE < Maximum offline-expiration is %2Q day>
	CAIE B,1
	PRINT "s"
	ETYPE <%_>
	MOVEI A,.SKRBC		;SAY WE WANT CONTROL SETTING
	MOVEI B,C		;ARG BLOCK ADDRESS
	MOVEI 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>
	MOVEI A,.SKBCR		;READ BATCH CLASS
	MOVEI B,C		;BLOCK IS IN C
	MOVEI C,2		;ALLOCATE ROOM
	SKED%			;GET BATCH CLASS
	JUMPL D,NOCLS		;IF NEGATIVE, NO BATCH CLASS
	ETYPE <, batch class %4Q>
NOCLS:	ETYPE <%_>
	MOVEI A,.SFOFS		;[7.1063]Get TMON% function code
	TMON%			;[7.1063]Read timeout interval
	 ERJMP CJERRE		;[7.1063]Go complain about it
	SKIPN B			;[7.1063]Feature enabled?
	IFSKP.			;[7.1063]If enabled, then...
	  ETYPE < Offline structures timeout interval is >
	  IDIVI B,^D60		;[7.1063]Get minutes and seconds
	  ETYPE <%2Q >		;[7.1063]Display number of minutes
	  CAIE B,1		;[7.1063]Just one minute?
	  IFSKP.		;[7.1063]Yes...
	    ETYPE <minute and %3Q > ;[7.1063]Display number of seconds
	  ELSE.			;[7.1063]No...
	    ETYPE <minutes and %3Q > ;[7.1063]Display number of seconds
	  ENDIF.		;[7.1063]
	  CAIE C,1		;[7.1063]Just one second?
	  IFSKP.		;[7.1063]Yes...
	    ETYPE <second>	;[7.1063]
	  ELSE.			;[7.1063]No...
	    ETYPE <seconds>	;[7.1063]
	  ENDIF.		;[7.1063]
	ELSE.			;[7.1063]If disabled then...
	  ETYPE < Offline structures are disabled> ;[7.1063]Tell user so
	ENDIF.			;[7.1063]
	ETYPE <%_>		;[7.1063]Finish it up
	MOVEI A,.SFCLU		;[7.1076] Get TMON% function code
	TMON%			;[7.1076] Read info status
	 ERJMP CJERRE		;[7.1076] Must not be a feature here
	SKIPN B			;[7.1076] Feature enabled?
	IFSKP.			;[7.1076] If enabled,
	  ETYPE < Cluster information is enabled> ;[7.1076]
	ELSE.			;[7.1076] If disabled,
	  ETYPE < Cluster information is disabled> ;[7.1076] Tell user so
	ENDIF.			;[7.1076]
	ETYPE <%_>		;[7.1076]
	MOVEI A,.SFTMG		;[7.1076] Get TMON% function code
	TMON%			;[7.1076] Read remote sendall status
	 ERJMP CJERRE		;[7.1076] Must not be a feature here
	SKIPN B			;[7.1076] Feature enabled?
	IFSKP.			;[7.1076] If so,
	  ETYPE < Cluster sendalls are enabled> ;[7.1076]
	ELSE.			;[7.1076] If not,
	  ETYPE < Cluster sendalls are disabled> ;[7.1076]
	ENDIF.			;[7.1076] 
	ETYPE <%_>		;[7.1231] Be neat
	MOVEI A,.SFMPL		;[7.1231] Get TMON% function
	TMON%			;[7.1231] Find out minimum password length
	 ERJMP CJERRE		;[7.1231] Must not be in this monitor
	ETYPE < Minimum password length is > ;[7.1231]
	IFN. B			;[7.1231] Is it enabled?
	  ETYPE <%2Q character>	;[7.1231] Say how many characters
	  CAIL B,2		;[7.1231] Make it plural?
	   ETYPE <s>		;[7.1231] Stick in the "S"
	ELSE.
	  ETYPE <disabled>	;[7.1231] Say it is disabled
	ENDIF.			;[7.1231]
	ETYPE <%_>		;[7.1076] Finish it up
	MOVEI A,.SFPEX		;[4412] Check password expiration
	TMON%			;[4412] Get it
	 ERJMP NOPEX		;[4412] If not in monitor, then blow it off
	ETYPE < Password expiration is > ;[4412]
	IFE. B			;[4416] Is it set?
	  ETYPE <disabled>	;[4412] Say so
	ELSE.			;[4412] It is set, so...
	  ETYPE <%2Q day>	;[4412] Say how many days
	  CAIE B,1		;[4412] If not singular
	  ETYPE <s>		;[4412] Make it plural
	ENDIF.			;[4412]
	ETYPE <%_>		;[4412] Make neat
NOPEX:	MOVEI A,.SFPWD		;[4416] Check password dictionary
	TMON%			;[4416] Get it
	 ERJMP NOPWDC		;[4416] If not in monitor, then blow it off
	ETYPE < Password dictionary is > ;[4416]
	IFE. B			;[4416] Is it set?
	  ETYPE <disabled>	;[4416] Say so
	ELSE.			;[4416] It is set, so...
	  ETYPE <enabled>	;[4416] Say it is enabled
	ENDIF.			;[4416]
	ETYPE <%_>		;[4416] Make neat
NOPWDC:	CALLRET SYSDWN		;[4416] Print downtime info and exit

;ROUTINE TO DO COMMON WORK FOR INFO SYSTEM-STATUS
;A/	CODE FOR ASKING MONITOR FOR INFO
;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!
	SKIPN B
	TYPE <are not >
	ETYPE <allowed%_>
	RET
;ROUTINE TO REPORT DISABLED IF B/ 0 AND ENABLED IF B/ 1

INSYED:	SKIPE B
	TYPE <enabled
>
	SKIPN B
	TYPE <disabled
>
	RET
;INFORMATION (ABOUT) VOLUMES (NAME) tapesetname:

IVOL::	STKVAR <QID>
	NOISE <OF TAPE>
	HRROI B,[ASCIZ/tape set name/]
	CALL DEVN		;READ DEVICE
	 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
	MOVEI A,.TMSET
	CALL FNDATR		;FIND SETNAME
	MOVE A,1(A)		;GET SETNAME
	ETYPE <Volumes of tape set %1': >
	MOVEI 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
	SKIPA
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
; 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::MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI 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)
	TYPE <
>
ILLDEN:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI 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)
	TYPE <
>
ILLPAR:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI 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)
	TYPE <
>
ILLFMT:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JIRS
	GETJI
	 CALL JERR
	ETYPE < SET TAPE RECORD-LENGTH %3Q
>
	RET
SPLINF::MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI 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-action, value = %3O
>
		RET]
	TYPE < SET SPOOLED-OUTPUT > ;CORRECT RESPONSE TO "I SPOOL"
	UTYPE (B)
	TYPE <
>
	RET
;TYPE CURRENT TERMINAL MODES

TRMPNT::NOISE (FOR TERMINAL)
	MOVEI A,.CTTRM		;DEFAULT TO CONTROLLING TERMINAL
	MOVEM A,TERMNL
	MOVEI B,[FLDDB. .CMCFM,,,,,[
		 FLDDB. .CMNUM,CM%SDH,8,<Terminal number>]]
	CALL FLDSKP		;SEE WHAT'S BEING TYPED
	 CMERRX <Carriage return or terminal number required>
	LOAD D,CM%FNC,.CMFNP(C)
	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/]
		MOVEI C,0
		SOUT		;BUILD STRING TTYnnn
		MOVE B,TERMNL
		SUBI B,.TTDES	;MAKE REAL NUMBER AGAIN
		MOVEI C,8	;SAY OCTAL
		NOUT		;PUT NUMBER ON STRING
		 ERCAL JERR	;THIS SHOULDN'T FAIL
		HRROI B,[ASCIZ /:/]
		MOVEI C,0
		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		;IS IT WITHIN THE RANGE OF KNOWN TYPES?
	CAMGE B,NTTYPS
	SKIPA A,B		;YES - SET UP THE TERMINAL NAME STRING
ILTTYP:	MOVE A,NTTYPS		;NO - JUST OUTPUT THE INDEX
	XCT TTYPTB(A)		;TYPE OUT TERMINAL NAME OR INDEX
	ETYPE <%_>

;PRINT SPEED INFO

ILTTY1:	MOVE A,TERMNL
	MOVEI 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
	HRRZS C
	ETYPE < TERMINAL SPEED %1Q>
	CAME A,C		;INPUT = OUTPUT
	ETYPE < %3Q>
TISP2:	ETYPE <%_>		;TERMINATE LINE
NOSPD:
	TLZ Z,F1		;CLEAR "DISABLED" FLAG
	MOVE A,TERMNL		;GET TERMINAL LINE NUMBER
	CALL RTFLG1		;GET TERMINAL FLAGS
	 JRST NOTFLG		;NO FLAGS AVAILABLE
	TYPE < TERMINAL>
	TXNN C,MO%NTM		;INHIBIT ?
	 TYPE < NO>		;NO
	TYPE < INHIBIT (NON-JOB OUTPUT)
>
	TXNE C,MO%NTM		;INHIBIT ?
	 TLO Z,F1		;YES. SET "DISABLED" FLAG
NOTFLG:
	SETZM RFERR		;NO RFMOD ERROR YET
	MOVE A,TERMNL
	RFMOD			;GET TERMINAL MODES

;CHECK LINKS BIT

	 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
	TYPE < RECEIVE LINKS>
	TXNN B,TT%ALK
	TYPE < REFUSE LINKS>
	TLNE Z,F1		;DISABLED BY INHIBIT ?
	 TYPE < IS DISABLED>	;YES
	TYPE <
>

;CHECK ADVICE BIT

	TXNE B,TT%AAD
	TYPE < RECEIVE ADVICE>
	TXNN B,TT%AAD
	TYPE < REFUSE ADVICE>
	TLNE Z,F1		;DISABLED BY INHIBIT ?
	 TYPE < IS DISABLED>	;YES
	TYPE <
>
NOLNK:	MOVE A,TERMNL
	MOVEI B,.MORNT
	MTOPR
	 ERJMP [ETYPE <%% Can't get system-message status - %?%%_>
		JRST N0STAT]
	CAIN C,0
	ETYPE < RECEIVE SYSTEM-MESSAGES>
	CAIE C,0
	ETYPE < REFUSE SYSTEM-MESSAGES>
 	TLNE Z,F1
	 TYPE < IS DISABLED>
	TYPE <
>
N0STAT:
	MOVE A,TERMNL		;GET TERMINAL LINE NUMBER
	CALL RTFLG1		;GET TERMINAL FLAGS AGAIN
	 JRST NOUMSG		;FAILED
	TXNE C,MO%NUM		;ALLOW USER-MESSAGES ?
	 TYPE < REFUSE USER-MESSAGES> ;NO
	TXNN C,MO%NUM		;ALLOW USER-MESSAGES ?
	 TYPE < RECEIVE USER-MESSAGES> ;YES
 	TLNE Z,F1
	 TYPE < IS DISABLED>
	TYPE <
>
NOUMSG:

;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 >
	TYPE <PAUSE (ON) COMMAND
>
;CHECK PAUSE (ON) END-OF-PAGE

NPINFO:	MOVE A,TERMNL
	MOVEI 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:	TYPE <
>
;IF PAUSE EOP IS ON SAY WHAT THE PAUSE CHARACTERS ARE

	CAIE C,.MOOFF		;IS NO-PAUSE-EOP SET,
	TXNN B,TT%PGM		;  OR IS IT DISABLED?
	JRST NOEOPS		;EITHER - DON'T TYPE THE CHARACTERS
	MOVE A,TERMNL		;READ PAUSE,,UNPAUSE CHARS INTO T3
	MOVEI B,.MOPCR
	MTOPR
	 ERJMP [ETYPE <%% Can't get pause characters - %?%%_>
		JRST NOEOPS]
	CAMN C,[23,,21]		;GOT THE USUAL CHARACTERS?
	JRST NOEOPS		;YES - SKIP THE LINE
	TYPE < TERMINAL PAUSE (ON) CHARACTER>
	HLRZ B,C		;GET THE TURN-OFF CHARACTER
	PUSHJ P,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 < (AND UNPAUSE ON)>
	HRRZ B,C		;GET THE TURN-ON CHARACTER
	PUSHJ P,POUTCH		;OUTPUT IT
PAUSC0:	TYPE <
>
;PAGE LENGTH

NOEOPS:	MOVE A,TERMNL
	MOVEI 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

	MOVEI 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 >
	TYPE <LOWERCASE
>
;CHECK RAISE

	TYPE < TERMINAL >
	TXNN B,TT%LIC
	TYPE <NO >
	TYPE <RAISE
>
;CHECK OUTPUT FLAGGING

	TYPE < TERMINAL >
	TXNN B,TT%UOC
	TYPE <NO >
	TYPE <FLAG
>
;CHECK INDICATE FORMFEED FLAG

	TYPE < TERMINAL >
	MOVE A,TERMNL
	RFCOC
	LDB A,[POINT 2,B,25]
	CAIE A,1
	TYPE <NO >
	TYPE <INDICATE
>
;CHECK MECHANICAL FORMFEED

	TYPE < TERMINAL >
	MOVE B,RFINFO
	TXNN B,TT%MFF
	TYPE <NO >
	TYPE <FORMFEED
>
;CHECK MECHANICAL TAB

	TYPE < TERMINAL >
	TXNN B,TT%TAB
	TYPE <NO >
	TYPE <TABS
>
;ECHO MODE

	TYPE < TERMINAL >
	TXNN B,TT%ECM
	TYPE <NO >
	TYPE <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 [	TYPE < Duplexing in reserved state
>
		JRST DPLXDN]
	TYPE < TERMINAL >
	CAIN A,.TTFDX
	TYPE <FULLDUPLEX
>
	CAIN A,.TTHDX
	TYPE <HALFDUPLEX
>
	CAIN A,.TTLDX
	TYPE <LINE
>
DPLXDN:	RET			;ALL DONE
;SUBROUTINE TO OUTPUT THE CHARACTER IN T2 AS "CHAR"
;SAYS "ESCAPE", "SPACE" OR "CONTROL " IN THE APPROPRIATE CASES

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,33		;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,TRAPU		;STEAL TRAPU AS TEMPORARY TEMPORARY LOCATION
	UTYPE TRAPU		;OUTPUT THE PRINTING CHARACTER IN QUOTES
	EXCH B,TRAPU
	RET			;DONE

POUTCS:	TYPE < SPACE>
	RET
POUTCE:	TYPE < ESCAPE>
	RET
;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>,[
		 FLDBK. .CMDEV,CM%NSF!CM%BRK!CM%SDH!CM%PO,,<logical name>,,[
			   BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<*%-_$>]]]
	CALL FLDSKP
 	 CMERRX <"JOB", "SYSTEM", "ALL", or logical name required>
	LDB C,[331100,,(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
	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
	TYPE <Job-wide logical names:

>
	MOVE A,[.INLJB,,.LNSJB]
	CALL .LNTYL
	TLNE Z,F2
	TYPE <
System-wide logical names:

>
.LNSY1:	TLNN Z,F2
	RET
	MOVE A,[.INLSY,,.LNSSY]

;FALL INTO .LNTYL

.LNTYL:	HRRZM A,LNJNM
	HLLZS 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
	CALL LNSBLD		;BUILD LOGICAL NAMES DEF STRING 
	MOVE A,LNDIR
	AOJA A,.LNTY1

;GET HERE WHEN SPECIFIC LOGICAL NAME REQUESTED

LNSPEC:	CONFIRM			;CONFIRM THE SPECIFIC LOGICAL NAME
	MOVE A,SPNAM		;POINTER TO NAME IN B
	CALL CLNWLD		;SEE IF DEVICE NAME HAS WILDCARDS
	  JRST LNWILD		;IT DOES, SO HANDLE DIFFERENTLY
	SETZ D,			;NO MATCHES YET.
	MOVE B,SPNAM		;POINTER TO NAME IN B
	MOVE C,CSBUFP		;WRITE DEFINITION INTO STRING AREA
	MOVEI A,.LNSJB		;SPECIFY JOB
	LNMST			;GET JOB DEFINITION
	 ERJMP LNS1		;NO JOB DEFINITION
	SETO D,			;LOGICAL NAME EXISTS
	TYPE <Job-wide:

>
	MOVE A,SPNAM
	MOVE B,CSBUFP
	CALL LNTYPE		;TYPE THE DEFINITION
	TYPE <
>
LNS1:	MOVEI A,.LNSSY		;GET SYSTEM DEFINITION
	MOVE B,SPNAM		;POINTER TO NAME AGAIN
	MOVE C,CSBUFP		;STRING SPACE
	LNMST			;GET SYSTEM VERSION
	 JRST [ MOVE A,SPNAM	;GET POINTER TO NAME
		SKIPN D		;NO SYSTEM NAME. WAS THERE A JOB NAME?
		 ETYPE <%%Logical name %1M: is not defined> ;NO. WARNING
		RET ]		;FINISHED
		
	TYPE <System-wide:

>
	MOVE A,SPNAM
	MOVE B,CSBUFP
	CALLRET LNTYPE		;TYPE SYSTEM VERSION AND RETURN
;Here to handle a wildcarded logical name.
LNWILD:	TYPE <Job-wide:

>
	MOVE A,[.INLJB,,.LNSJB]
	CALL LNTWLD		;DO JOB WIDE LOGICAL NAMES
	TYPE <
System-wide:

>
	MOVE A,[.INLSY,,.LNSSY]
	CALL LNTWLD		;DO SYSTEM WIDE LOGICAL NAMES NOW
	RET

;Here to handle the wildcarded string typing out certain logical names.
LNTWLD:	HRRZM A,LNJNM
	HLLZS A
LNWLD1:	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
	MOVEI A,.WLSTR		
	MOVE B,SPNAM		;COMPARE WILDCARDED NAME
	MOVE C,CSBUFP		;AGAINST THIS NAME
	WILD%
	 ERCAL JERR
	SKIPN A       		;ZERO IF WE MATCH
	 CALL LNSBLD		;BUILD THE STRING TO TYPE OUT
	MOVE A,LNDIR
	AOJA A,LNWLD1

;Build the logical name string.

LNSBLD:	MOVE B,CSBUFP		;PICK UP POINTER TO THE NAME
	MOVE C,LNTNM		; AND POINTER TO PLACE TO PUT STRING
	MOVE A,LNJNM		;GET FUNCTION
	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:	RET

;Here to check for wildcards in logical name. 
;Call with device string pointer in A. 
;
;Returns: +1 if string is wildcarded
;	  +2 if not wildcarded.

CLNWLD:	ILDB B,A		;GET THE NEXT CHAR
	JUMPE B,RSKP		;IF END OF STRING THEN NO WILD CARDS
	CAIN B,"*"
	 RET			;GOT A WILDCARD. 
	CAIN B,"%"
	 RET			;GOT A WILDCARD
	JRST CLNWLD
;ROUTINE TO TYPE A LOGICAL NAME DEFINITION.  GIVE IT POINTERS TO
;NAME AND DEFINITION IN A, B RESPECTIVELY

LNTYPE:	UETYPE [ASCIZ /%1M: => %2M%%_/]
	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>
	 CAIA			;"*" NOT TYPED
	JRST STRSTR		;"*" TYPED
	MOVE A,DEFNAM
	MOVEM A,CMDEF		;SET UP DEFAULT AGAIN
	HRROI B,[ASCIZ/Name of structure or * for all/]
	CALL DEVN
	 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:%_> ;[7.1063]
	MOVE D,.MSGST+ISBLK	;[7.1063]GET STRUCTURE FLAGS
	TXNE D,MS%OFS		;[7.1063]IS THE STRUCTURE OFFLINE?
	ETYPE <Structure is offline%_> ;[7.1063]YES. SAY SO
	ETYPE <Mount count: %1Q, open file count: %2Q, units in structure: %3Q
> ;[7.1063]
	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%EXL		;[7.1189] See if exclusive to this processor
	TYPE <Exclusive >	;[7,1189] Yes.
	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,[EXP <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
	TYPE <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?
	TYPE <%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
	MOVEI P2,0		;LENGTH OF USER LIST
	MOVEI 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,[221100,,B]	;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:	MOVEI P1,0		;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
	MOVEI B,.MORLW
	MOVEI C,^D72		;FOR NON-TERMINAL ASSUME 72 COLUMNS
	MTOPR			;GET LINE WIDTH
	 ERJMP .+1		;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
	MOVEI B,0		;PUT NULL IN TO MARK END OF STRING
	IDPB B,A
	MOVEI A,DRRBUF		;LOOK AT STRING
	HRLI A,440700		;MAKE CORRECT BYTE POINTER
	MOVEI D,0		;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:	TYPE <
	>
	MOVEI P1,0		;NOTE THAT WE'RE ON NEW LINE
	JRST DIRUMX
;JOBSTAT (INFORMATION JOB command).

.JOBST::SAVEAC <P1>		;[4419] Preserve P1
	CALL IJHOST		;[4419] (/A) Output host name (if any set)
	 SETZ A,		;[4419] No host name found
	MOVEM A,P1		;[4419] Save pointer to node name
	ETYPE < Job %J, %L%%_ User %N> ;[4419] Output job, terminal, user
	GJINF			;Get current job information
	CAME B,LIDNO		;Skip if connected to logged-in directory
	ETYPE <, %G% >		;No, output connected directory
	ETYPE <%_>		;Output a return

	CALL ACTSTG		;(/) Print account info
	CALL IJSESS		;[4419] (/) Print session remark if any
;	CALLRET IJLOCA		;[4419] (P1/) Output location info and return

;[4419] Output job's location only if it is different from node name.
;Call with P1/ pointer to host node name
;Returns +1 always

IJLOCA:	JUMPE P1,R		;[4419] Return now if no host name known
	SETO A,			;[4419] Get information about self
	HRROI B,D		;[4419] Point to byte pointer
	MOVEI C,.JILLO		;Say we want logical location
	MOVE D,CSBUFP		;[4419] Point to free space
	GETJI			;Get job's location
	 ERCAL CJERRE		;Shouldn't fail

	MOVE A,CSBUFP		;[4419] Point to location string
	MOVE B,P1		;[4419] Point to the host name
	STCMP			;[4419] Are they the same?
	JUMPE A,R		;[4419] Return if they are the same
	MOVE B,CSBUFP		;[4419] Point to the returned location string
	ETYPE < Located at %2M%%_> ;[4419] Output job's location
	RET			;[4419] and return from command
;INFORMATION JOB command continues

;[4419] Routine called from INFORMATION JOB command to output host name.  This
;routine will output the Arpanet host name if the DECnet host name is not set
;(i.e. set to "TOPS20") or if there is no DECnet host name (this is an Arpanet
;only system).
;Returns +1 if no DECnet, or DECnet host name not set 
;Returns +2 if DECnet host name output, A/ pointer to host name

IJHOST:	CALL GETNOD		;[4419] (/A) Get pointer to the node name
	IFSKP.			;[4419] If there was a DECnet node name
	  MOVE D,A		;[4419] Save pointer to that node name
	  HRROI B,[ASCIZ/TOPS20/] ;[4419] Point to node name that is default
	  STCMP			;[4419] Is the node name set to TOPS20?
	  EXCH A,D		;[4419] Swap flag with node name pointer
	  JUMPE D,R		;[4419] Return +1 if no node name
	  ETYPE < Host %1M,>	;[4419] Output host name
	  RETSKP		;[4419]  and return +2
	ENDIF.			;[4419] No DECnet node name, try Arpanet

	MOVEI A,.GTHSZ		;[4419] See if any Arpanet hosts on system 
	GTHST			;[4419] Ask monitor for local host number
	 ERJMP R		;[4419] If this fails, non-arpanet monitor
	MOVE C,D		;[4419] Copy local host number to C
	MOVE B,CSBUFP		;[4419] Point to free space
	MOVEI A,.GTHNS		;[4419] We want name for our host number
	GTHST	         	;[4419] Get our host name  
	 ERJMP R		;[4419] We forgot our own name
	MOVE A,CSBUFP		;[4419] Point to the host name again
	ETYPE < Host %1M,>	;[4419] Output host name
	RET			;[4419] Return +1 indicating no DECnet name
;INFORMATION JOB command continues

;ROUTINE TO PRINT ACCOUNTING STRING IF PRESENT

ACTSTG:	MOVE B,CSBUFP		;[4419] Point to free space
	MOVNI A,1		;-1 for self
	GACCT			;Get the job's account string
	LDB A,[POINT 3,B,2]	;[4419] Get first octal digit 
	CAIE A,5		;5 means number instead of string
	IFSKP.			;[4419] If numeric account
	  TLZ B,500000		;Get rid of control bits
	  ETYPE < Account %2Q%%_> ;[4419] Output account number in decimal
	  RET			;[4419] Return
	ENDIF.			;[4419] Otherwise must be alphanumeric account
	MOVE A,CSBUFP		;[4419] Point back to buffer
	ILDB A,A		;[4419] Get first byte of buffer
	IFN. A			;[4419] If there is an account string
	  MOVE A,CSBUFP		;[4419] Point to free space again
	  ETYPE < Account %1M%%_> ;[4419] Output account string
	ENDIF.			;[4419] No account string, see if number
	RET			;[4419] Return

;[4419] Here from INFORMATION JOB command to output session remark.
;Returns +1 always

IJSESS:	HRROI A,-1		;[4419] Current job
	MOVE D,CSBUFP		;[4419] Use free space pointer
	HRROI B,D		;[4419] Say one entry, pointer in D
	MOVEI C,.JISRM		;[4419] Specify we want session remark
	GETJI			;[4419] Get session remark from monitor
	 ERJMP R		;[4419] If fails, there's no remark
	MOVE A,CSBUFP		;[4419] Get pointer to remark
	ILDB A,A		;[4419] Get first character
	JUMPE A,R		;[4419] Return if no session remark
	MOVE D,CSBUFP		;[4419] Point back at free space area
	ETYPE < Session remark %4M%%_> ;[4419] Output session remark
	RET			;[4419] Return
;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: %1V
>
	TYPE < SET >
	SKIPE PAXLFL
	TYPE <NO >
	TYPE <UUO-SIMULATION (FOR PROGRAM)
>
	TYPE < SET >
	SKIPE CCFLAG
	TYPE <NO >
	TYPE <CONTROL-C-CAPABILITY (OF PROGRAM)
>
XTND,<
	TYPE < SET >
	SKIPN CCKEEP
	TYPE <NO >
	TYPE <KEEP-FORK (ON <CTRL-C>)
>
>
	SKIPE TFILEF		;SEE IF TRAPPING FILE-OPENINGS
	ETYPE < SET TRAP FILE-OPENINGS%_>
	MOVE A, TRAPU		;GET UNDEFINED TRAP COUNT
	ADD A,TRAPD		;GET DEFINED TRAP COUNT
	SKIPN A			;ANY JSYS BEING TRAPPED?
	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,JLEN-1		;PERHAPS EVERYTHING IS BEING TRAPPED
	JRST	[ETYPE < SET TRAP JSYS /ALL%_>
		JRST JMORE]
JPRNT:	CALL SCNJBK		;PRINT APPROPRIATE JSYS 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,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,FRKNMS+1(B)	;GET ADDRESS OF FORK BLOCK
	LOAD C,FKFLAG,(A)	;GET FLAGS
	HLRO B,FRKNMS+1(B)	;GET POINTER TO NAME
	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?
		SKIPA		;YES - CONTINUE
		JRST CJERR	;NO, STRANGE
		TYPE <% >
		CALL $ERSTR	;PRINT SYSTEM MESSAGE
		ETYPE <%_>	;ADD CRLF
		TYPE <% Partial structure will be printed.
>
		RET]
	SETZ Q1,
	HRRZ D,(C)
	SETOM INDQUS		;FLAG %ETYPE TO INDENT WHEN REPORTING ERR MESS FOR FORK
	CALL FSTRUC		;PRINT FORK TREE
	MOVEI A,BUF0		;[3063]Get address of GFRKS% block
	CALL RELHAN		;[3063](A/)RELEASE UNWANTED FORK HANDLES
	SETZM INDQUS		;DON'T NEED FLAG ANYMORE
	CALLRET UNMDIR		;UNMAP SPECIAL PAGES
;INFO (ABOUT) SUPERIORS 

.SUPER::MOVX A,.FHTOP		;START AT THE TOP
	MOVX B,GF%GFH+GF%GFS	;ASSIGN FORK HANDLES, GET STATUS
	MOVE C,[-300,,BUF0]	;RETURN STRUCTURE HERE
	GFRKS			;GET FORK STRUCTURE
	CALL [CAIE A,GFKSX1	;AREA TOO SMALL?
	      JRST JERR		;NOPE, WE GOT PROBLEMS
	      RET]		;YES
	SETZ B,			;CLEAR THE COUNTER
	MOVE C,[-277,,BUF0+1]	;POINT TO TOP PROCESS HANDLE
GSUPS1:	HRRZ A,(C)		;GET POSSIBLE HANDLE
	CAIN A,.FHSLF		;US YET?
	JRST GSUPS2		;YES, GO COUNT SUPERIORS
	AOBJP C,GSUPSE		;SKIP STATUS WORD
	AOBJP C,GSUPSE		;AND POINTERS
	AOBJN C,GSUPS1		;GO BACK FOR ANOTHER LOOK
GSUPSE:	MOVEI A,BUF0		;[3063]Get address of GFRKS% block
	CALL RELHAN		;[3063](A/)Release unwanted handles
	ERROR <Can't find self in fork structure> ;COMPLAIN IF LOST
GSUPS2:	HLRZ C,(C) 		;GET POINTER TO SUPERIOR
	JUMPE C,GSUP3 		;IF NO SUPERIOR, WE'RE DONE
	AOS C			;INCREMENT POINTER TO SUPERIOR'S
	AOJA B,GSUPS2		;COUNT THIS AND GO FOR MORE

GSUP3:	SKIPE B
	 ETYPE < Superior forks: %2Q>
	SKIPN B
	 ETYPE <%%No superior forks>
	MOVEI A,BUF0		;[3063]Get address of GFRKS% block
	CALL RELHAN		;[3063](A/)Release unwanted handles
	CALLRET UNMDIR		;UNMAP SPECIAL PAGES

;SCNJBK is used to scan through the jsyses for trap-handling
;
;THE LEFT HALF OF Q2 IS A FLAG:
	;0	MEANS PRINT NON-TRAPPED SET
	;1	MEANS PRINT TRAPPED SET

SCNJBK:	SKIPN TRAPD		;TRAPPING DEFINED JSYS'S?
	JRST UNDJ		;NO

;HERE IF WE HAVE DEFINED JSYS'S

DEFJ:	MOVE A,TRAPD		;GET DEFINED COUNT
	CAIL A,SJLEN		;ALL DEFINED'S BEING TRAPPED?
	JRST	[ETYPE < SET TRAP JSYS /DEFINED>
		JRST UNDTST]
	HRLZI Q2,1		;NO, ASSUME TRAPPED SET
	MOVE A,TRAPD		;GET COUNT
	CAILE A,<SJLEN/2>	;MORE THAN HALF TRAPPED?
	SETZM Q2		;YES, USE UNTRAPPED SET

	SKIPE Q2
	TYPE < SET TRAP on these defined JSYS's:  >
	SKIPN Q2
	TYPE < All defined JSYS's being trapped except:  >
	SETZM Q1		;ZERO BYTE COUNT
	HRRI Q2,JSOUT		;USE THIS OUTPUT ROUTINE
	MOVE Q3,[-SJLEN,,1]	;GET INCREMENTED AOBJN POINTER
	CALL SCNJ		;PRINT THEM
UNDTST:	SKIPN TRAPU		;TRAPPING UNDEFINED JSYS'S?
	RET			;NO
	ETYPE <%_>		;END THE PREVIOUS LIST
;HERE IF WE HAVE UNDEFINED JSYS'S

UNDJ:	MOVEI A,JLEN-1		;GET TOTAL JSYS NUMBER
	SUBI A,SJLEN		;CALCULATE TOTAL UNDEFINEDS POSSIBLE
	CAMN A,TRAPU		;ALL OF THEM?
	JRST	[ETYPE < SET TRAP JSYS /UNDEFINED%_>
		RET]
	HRLZI Q2,1		;NO, ASSUME TRAPPED SET
	MOVE A,TRAPU		;GET COUNT
	CAILE A,<JLEN-1-SJLEN>/2 ;MORE THAN HALF TRAPPED?
	SETZM Q2		;YES, USE UNTRAPPED SET
	SKIPE Q2
	TYPE < SET TRAP on these undefined JSYS's:  >
	SKIPN Q2
	TYPE < All undefined JSYS's being trapped except:  >
	SETZM Q1		;ZERO BYTE COUNT
	HRRI Q2,OUTJN		;USE THIS ROUTINE FOR OUTPUT
	MOVE Q3,[-JLEN+1,,1]	;GET INCREMENTED AOBJN POINTER FOR
;	CALLRET SCNJ		;PRINT THEM
;ROUTINE TO SCAN THROUGH JSYS TABLE
;MUST SET UP Q3 WITH AOBJN POINTER AND Q2 WITH: FLAG,,OUTPUT ROUTINE

SCNJ:	STKVAR <JSET>
	HLRZM Q2,JSET		;STORE THE FLAG
	HRRZS Q2		;GET ONLY ROUTINE ADDR
SCNJ1:	CAIE Q2,OUTJN		;DOING UNDEFINED?
	JRST SCNJ4		;NO
	LDB C,[POINT 9,JTAB(Q3),35]; GET STRING OFFSET FOR THIS JSYS NUMBER
	JUMPN C,SCNJNX		;SKIP IT IF IT IS DEFINED
	HRRZ C,Q3		;GET JSYS NUMBER
	SKIPA
SCNJ4:	LDB C,[POINT 9,JTAB(Q3),26];GET JSYS NUMBER
	MOVE D,[POINT 1,JSBDEF] ;GET BYTE POINTER TO BIT MASK
	ADJBP C,D		;INCREMENT TO THAT JSYS
	ILDB A,C		;GET THE BIT
	CAMN A,[<0,,-1>&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
	CAIA			;NOT OPENF OR NOT BEING TRAPPED
	AND A,TOPENF		;DON'T CONFUSE FILE-OPENINGS WITH JSYS OPENF
	CAMN A,JSET		;IS THIS JSYS IN CORRECT SET
	CALL (Q2)		;YES, CALL THE ROUTINE
SCNJNX:	AOBJN Q3,SCNJ1		;CONTINUE
	RET
;ROUTINE TO OUTPUT JSYS NAMES

;ACCEPTS:
;Q3/	INDEX INTO JTAB

JSOUT:	ATSAVE
	SKIPLE Q1		;FIRST TIME THROUGH?
	CALL BEFORJ		;NO, SEE HOW MANY SPACES TO OUTPUT
	MOVE A,COJFN		;GET STANDARD OUTPUT JFN
	HLRZ B,JTAB(Q3)		;GET POINTER
	AOS B			;INCREMENT TO STRING
	HLL B,[POINT 7,0]
	MOVEI C,12
	SETZM D			;END ON NULL
	SOUT
	MOVEI Q1,12-1		;CALCULATE BYTES WRITTEN
	SUB Q1,C		;...
	RET
;HERE TO OUTPUT JSYS NUMBERS FOR UNDEFINED JSYS'S
;ACCEPTS:  Q3/  JTAB INDEX

OUTJN:	ATSAVE
	SKIPLE Q1		;FIRST TIME THROUGH?
	CALL BEFORJ		;NO, SEE HOW MANY SPACES TO OUTPUT
	HRRZ A,Q3		;GET THE JSYS NUMBER
	ETYPE <%1a>		;TYPE THE JSYS NUMBER
	MOVEI Q1,3		;FROM NOW ON, BYTE COUNT IS 3
	RET

BEFORJ:	ATSAVE
	 MOVE A,COJFN
	MOVEI B,.MORLW
	MOVEI C,^D72		;USE 72 COLUMNS IF NOT A TERMINAL
	MTOPR			;GET LINE WIDTH
	 ERJMP .+1		;IF NOT, USE 72 (PRESUMABLY NOT A TERMINAL)
	RFPOS
	MOVEI B,(B)		;MASK COLUMN POSITION
	CAIL B,-7(C)		;WITHIN 7
	JRST BEFR1		;GO DO IT
	MOVEI A,7		;GET FIELD WIDTH
	SUBI A,-1(Q1)		;SUBTRACT JSYS CHARS OUTPUT
	ETYPE <%1Z>		;OUTPUT THE COMMA-SPACE STRING
	RET

BEFR1:	PRINT ","		;END LINE WITH A COMMA
	ETYPE <%_ >		;EITHER WAY, START A NEW LINE
	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%_>
	TXNE C,FN%NEF
	ETYPE < SET %4M%%2M NO-EPHEMERAL%_>
	LOAD A,FKRESP,(A)	;GET POINTER TO METHOD OF RESTARTING
	TXNE C,FN%KEP
	ETYPE < SET %4M%%2M KEEP (AND) %1M (WHEN INVOKED AS A COMMAND)%_>
	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 PARELLEL FORKS ARE THOSE WHICH APPEAR AT SAME INDENTATION WITH
;  NO LESS-INDENTED ENTRIES BETWEEN THEM.
;TAKES: 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 " "
	HRRZ B,1(D)
	CAMN B,FORK		;< TO MATCH FOLLOWING
	UTYPE [ASCIZ /=> /]
	CAME B,FORK
	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,[UTYPE [ASCIZ /**: /]
		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
		MOVE D,SAVHD		;GET THE POINTER BACK AGAIN
		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:	MOVEI 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)
				;FORK HAS NO NAME , BUT WE KNOW ABOUT IT NOW
FSTR2B:	TYPE <Fork >
	MOVE A,COJFN
	MOVEI C,10
	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		;[PCL] INVOKE'd?
	 TYPE <Invoked, >	;[PCL]
	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.
;TAKES A FORK HANDLE OR 0 IN A.  IF 0, A LONG RFSTS HAS BEEN SIMULATED
;CONTAINING ALL AVAILABLE 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
	MOVEI 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
	 ERJMP [MOVEI D,[ASCIZ /Fork disappeared/] ;GONE
		JRST FSTAT8]
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)	;[PCL] Controlled program
	 CAIE C,.RFIO		;[PCL]  and waiting for I/O?
	  TRNA			;[PCL] No, go on
	  TXZ B,RF%FRZ		;[PCL] Yes, probably waiting for typein
	SKIPGE B
	lall
	UTYPE [ASCIZ /^C from /] ;"FROZEN" BIT ON
	UTYPE @[[ASCIZ /Running/]
		[ASCIZ /IO wait/]
		[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
	sall
	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 1,FORK
	JRST [	UTYPE [ASCIZ /No program/]
		JRST EOLRET]
	UTYPE [ASCIZ /PSI is /]
	MOVEI 5,[ASCIZ /ON/]
	SKPIR
	MOVEI 5,[ASCIZ /OFF/]
	UTYPE 0(5)
	RIR
	 ERJMP [MOVEI 3,3	;FAILED - TRY IT EXTENDED - GET ARG LENGTH
		MOVEI B,3	;READ LEVTAB INTO AC 4, CHNTAB INTO AC 5
		XRIR%
		JRST PISTA1]
	HLRZ 4,2		;GET ADDRESS OF LEVTAB
	HRRZ 5,2		;GET ADDRESS OF CHNTAB
PISTA1:	RCM
	MOVE 6,1		;GET CHANNEL MASK
	MOVE 1,FORK
	RWM
	HLLZ 2,2
	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
	 JRST CJERRE		;[7.1063]Failed. Print error and quit
	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>
	SKIPE Q2		;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
	SKIPLE D
	ETYPE < Over permanent storage allocation by %4Q page(s).
>
	SKIPLE B
	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
	MOVEI C,0		;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,1B2		;SPECIFY DEVICE FIELD, NO PUNCUATION
	JFNS			;ISOLATE THE STRUCTURE NAME
	MOVEI B,0		;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
	ETYPE < %2Q Pages free on %3M:, %1Q pages used.%_>
	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
	HRROI B,DSCBUF
	HRRZI A,GTJBLK
	CALL GTJFS		;GET JFN
	CALL [	CAIE A,GJFX20
		CAIN A,GJFX32
		JRST [	SUB P,[XWD 1,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:	STKVAR <<TMPFDB,<.FBBYV-.FBCTL+1>>> ;TEMP. BUFFER TO STORE FDB INFO IN
DSKST5:	TLZ Z,F1		;RESET DELETED BIT
	HRRZ A,Q1		;JFN ONLY
	MOVE B,[ <.FBBYV-.FBCTL+1>,,.FBCTL ] ;GET ALL FDB INFO AT ONCE
				;SO WE DON'T NEED TWO CALLS TO $GTFDB
	MOVEI C,TMPFDB		;STORE IT HERE
	CALL $GTFDB		;GET FILE SIZE AND STATUS AT ONCE
	 JRST DSKST2		;COULDN'T, SO LET'S SKIP THE ADDITION
	MOVE C,TMPFDB		;GET .FBCTL FOR CHECKING FILE STATUS
	HRRZ A,.FBBYV-.FBCTL+TMPFDB ;GET NUMBER OF PAGES IN FILE
	TXNE C,FB%DEL		;IS FILE DELETED?
	 JRST DSKST4		;YES, ADD TO DELETED TOTAL INSTEAD
	ADDI D,(A)		;ELSE INCREMENT UNDELETED TOTAL
	JRST DSKST3
DSKST4:	ADDI Q2,(A)		;FILE IS DELETED, INCREMENT DELETED TOTAL
	TRNA			;GO GET NEXT JFN
DSKST2:	TLO Z,F3
DSKST3:	MOVE A,Q1		;JFN AND FLAGS
	CALL GNJFS		;STEP TO NEXT FILE
	 TRNA			;NO MORE FILES
	JRST DSKST5
	MOVE Q3,D		;FORM SUM
	ADDI Q3,(Q2)		;OF DELETED AND UNDELETED
	RET			;PRINT RELEVANT NUMS, RELEASE JFN
GTJBLK:	GJ%OLD!GJ%DEL!GJ%IFG!GJ%PHY!GJ%XTN!.GJALL
	.NULIO,,.NULIO
	BLOCK 7
	G1%IIN
	BLOCK 6			;[3037] Fill in remaining words with 0

;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
	SKIPLE B		;SKIP IF NOT OVER
	ETYPE < %4R Over working storage allocation by %2Q page(s).
>
	RET

CHKDA1:	SUB B,C			;GET AMOUNT OVER PERMANENT QUOTA
	SKIPLE B		;SKIP IF NOT OVER
	ETYPE < %4R Over permanent storage allocation by %2Q page(s).
>
	RET

;INFORMATION ABOUT MAIL
;[3040] TELLS IF THERE IS NEW MAIL FOR A USER OR MAILBOX
;DEFAULTS TO SELF

.MALST::NOISE <FOR USER>
	STKVAR <<USRDEF,EXTSIZ>,DEFPTR>	;[3040]
	SKIPN CUSRNO		;ALREADY LOGGED IN ?
	 JRST MALST1		;NO - NO DEFAULT
	MOVEI A,USRDEF		;POINT AT TEMP STRING AREA
	CALL DFUSER		;[3040] (A/A)GET DEFAULT USER STRING
  	MOVEM A,DEFPTR		;[3040] SAVE THE POINTER


MALST1:	USERX <User name, Mailbox name or SYSTEM for system mail> ;[3040]
  	 CALL SYSMAL     	;[3040]	FAILED - CHECK FOR "SYSTEM" OR A MAILBOX NAME
	CONFIRM
	CALL BUFFF		;[3040] BUFFER THE INPUT
	MOVE B,A		;[3040] POINT TO IT FOR POBCHK
       	CALL POBCHK		;[3040] (B/C )THIS DIR ON POBOX: AND HAVE MAIL.TXT.1?
	 ERROR <No mailbox>	;[3040]	GUESS NOT
	MOVE B,C		;[3040] DIRECTORY NUMBER 
      				;STRING PNTR IN A
	CALL MALCHK		;SEE IF THAT USER HAS ANY NEW MAIL
	 JRST MALSTF		;MAIL.TXT NOT READABLE OR NO MAIL
     				;STRING PNTR IN A
	TLNN B,77		;CHECK NET-MAIL
	 JRST [	ETYPE < Netmail %1\>
		JRST EOLRET]
	ETYPE < Mail %1\>
	JRST EOLRET

MALSTF:	JUMPE A,MALSTN		;IF ZERO NO MAIL
	UTYPE [ASCIZ / Mailbox protected/]
	JRST EOLRET

MALSTN:	UTYPE [ASCIZ / No new mail exists/]
	JRST EOLRET
;HERE TO SEE IF "SYSTEM" WAS TYPED. IF SO, TYPE SYSTEM MAIL.
;IF NOT, ASSUME WE HAVE A MAILBOX NAME

SYSMAL:	MOVEI B,[FLDDB. .CMKEY,,[EXP <1,,1>,<[ASCIZ "SYSTEM"],,0>]]
	CALL FLDSKP
	 CALLRET MBOX 	;[3040] NOT USERNAME OR "SYSTEM" - GET MAILBOX NAME
       	CONFIRM
	POP P,		;[3040] CLEAN UP
	SETO A,		;THIS JOB
	HRROI B,LOGDAT
	MOVEI C,.JILLN	;GET LAST LOGIN D&T
	SKIPN LOGDAT	;IF LOGDAT ALREADY SETUP, DON'T NEED IT AGAIN
	GETJI
	 JFCL   
	SETOM SYSMF	;TIME TO PRINT SYSTEM MAIL.
 	CALLRET PNTMES 	;PRINT OUT THE NEW SYSTEM MESSAGES AND RETURN

MBOX:	WORDX		;[3040] ASSUME A MAILBOX
	 CMERRX <Username, Mailbox name, or SYSTEM required> ;[3040]
	RET		;[3040] GOT IT, RETURN TO COMMON CODE
;INFORMATION ABOUT ALERTS

.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
	 TYPE < 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:	TYPE <
 Alerts are >
	SKIPN IITSET		;IF THE ALERT TIMER IS SET THER'RE AUTOMATIC
	TYPE <not >
	TYPE <automatic
>
	RET			;DONE

ALRST4:	TYPE < No alerts set
>
	JRST	ALRST5		;TELL IF THEY'RE AUTOMATIC AND RETURN


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

.MEMST::SKIPGE FORK
	JRST [	UTYPE [ASCIZ / No program/]
		JRST EOLRET]

XRMBUF==BUFEND-1777		;START OF BUFFER

	TRVAR <LPC,NPGS,<XRMARG,4>>
	SETOM 2+XRMARG		;LAST SECTION
	SETOM LPC		;LAST PAGE COUNTED
	SETZM NPGS		;NO PAGES YET
	MOVEI A,BUF0		;MAKE BYTE POINTER FOR BUILDING MESSAGE
	HRLI A,440700
	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> ;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		;GET THE SECTION NUMBER OF THIS PAGE
	TRZ B,777
	CAME B,2+XRMARG		;MOVED TO A NEW SECTION?
	 CALL XRMAP		;YES - MAP IT
	MOVE A,D		;GET THE PAGE NUMBER
	ANDI A,777		;RETAIN THE PAGE WITHIN THE SECTION
	LSH A,1			;ALLOW FOR TWO WORDS PER ENTRY
	DMOVE A,XRMBUF(A)	;GET THE ENTRY FOR THIS PAGE
	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 loc %3Y len %2O>
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
	UTYPE [ASCIZ /@ /]	;INDICATE INDIRECT POINTER
	TXNN P4,PA%PEX		;DOES PAGE EXIST?
	JRST [	UTYPE [ASCIZ /No page/] ;CAN HAPPEN WITH INDIRECT.
		JRST MMAP13]
	TXNE P4,PA%PRV
	JRST [	UTYPE [ASCIZ /Private/]
		JRST MMAP13]
	CAMN P3,[-1]		;RMAP RETURNS -1 IF NO JFN FOR FILE
	JRST [	UTYPE [ASCIZ /Forgotten file/]
		JRST MMAP13]
	LDB B,[POINT 9,P3,17]	;JFN OR FORK #
	TXNE P3,1B0		;ON IF FORK
	JRST [	UETYPE [ASCIZ /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
;TAKES IN D: PAGE #, IN P3, P4: IDENTITY OF FIRST PAGE IN GROUP,
; IN 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			;BUMP AND GET ADDRESS OF NEXT PAGE
	TRNN A,777		;MOVE TO A NEW SECTION?
	 RET			;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		;GET THE SECTION NUMBER OF THIS PAGE
	TRZ B,777
	CAME B,2+XRMARG		;SAME AS CURRENT MAP?
	 CALL XRMAP		;NO - START A NEW MAP
	MOVE A,D		;GET THE PAGE NUMBER
	ANDI A,777		; WITHIN THE SECTION
	LSH A,1			;ALLOW TWO WORDS PER ENTRY
	DMOVE A,XRMBUF(A)	;GET THE ENTRY FOR THIS PAGE
	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
	TLNE B,<37B6+3B10>B53
	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
;SUBROUTINE TO LOAD RMAP INFO FOR A WHOLE SECTION INTO A TABLE AT XRMBUF
;CALL WITH: B/ FIRST PAGE OF CURRENT SECTION
;USES A AND B

XRMAP:	MOVEM B,2+XRMARG	;SAVE THE STARTING PAGE NUMBER
	MOVE A,D		;ISOLATE THE SECTION NUMBER
	LSH A,-9
	HRL A,FORK
	RSMAP%
	CAMN A,[-1]		;IS THERE SUCH A SECTION?
	 JRST XRMAPX		;NO - SKIP TO THE END OF THE SECTION
	PUSH P,B
	MOVE B,D
	LSH B,-9
	UETYPE	[ASCIZ/  Section %2O	/]
	POP P,B
	TXNE B,SM%RD		;DOES THE SECTION HAS READ ACCESS?
	UTYPE [ASCIZ/R, /]	;YES
	TXNE B,SM%WR		;DOES THE SECTION HAS WRITE ACCESS?
	UTYPE [ASCIZ/W, /]	;YES
	TXNE B,SM%EX		;DOES THE SECTION HAS EXECUTE ACCESS?
	UTYPE [ASCIZ/E, /]	;YES
	CAIN A,0
	UETYPE [ASCIZ/ Private%_/]
	CAIE A,0		;this should be expanded
	UETYPE [ASCIZ/ special mapping%_/]
	MOVEI B,4		;GET LENGTH OF ARGUMENT LIST
	MOVEM B,XRMARG
	MOVEI B,1000		;GET DATA FOR THE WHOLE SECTION
	MOVEM B,1+XRMARG
	XMOVEI B,XRMBUF		;POINT TO THE MAP
	MOVEM B,3+XRMARG
	HRLZ A,FORK
	XMOVEI B,XRMARG
	XRMAP%			;GET THE SECTION'S MAPPING
	 ERJMP XRMAPX		;FAILED
	RET

XRMAPX:	TRO D,777		;NO - SKIP TO THE END OF THE SECTION
	SETOM XRMBUF		;CLEAR THE WHOLE MAP
	SETZM XRMBUF+1
	MOVE A,[XRMBUF,,XRMBUF+2]
	BLT A,XRMBUF+1777
	RET			;DONE WITH THIS SECTION
;INFORMATION (ABOUT) ARPANET

.IARPA::KEYWD $IARPA
	 T STATUS,ONEWRD,.ANSTS
	 JRST CERR
	JRST (P3)

$IARPA:	TABLE
	T STATUS,ONEWRD,.ANSTS
	TEND

;INFORMATION (ABOUT) APRANET STATUS

.ANSTS:				;INFORMATION ARPANET STATUS
	STKVAR <<DCAHST,10>,<DCASTS,7>,<DCANAM,10>>
	SETZM DCAHST		;MAKE SURE THE FIRST HOST IS AT LEAST NOTHING
	MOVEI A,.GTHLA		;FUNCTION FOR GTHST
	MOVEI C,DCAHST		;TARGET ADDRESS
	MOVEI D,10		;MAX NUMBER OF ADDRESSES
	GTHST%			;GET OUR LOCAL HOST NUMBER
	 ERJMP ANSTS2		;IF ERROR ASSUME NO ARPANET
	MOVN Q1,D		;GET THE INTERFACE COUNT
	HRLZS Q1		;MAKE IT AN AOBJN POINTER
	HRRI Q1,DCAHST		;GET THE ADDRESS OF THE ADR TABLE
	JRST ANSTS1		
ANSTS0:	ETYPE <
>
ANSTS1:				;INTERFACE LOOP
	MOVEI A,.GTHNT		;GET NETWORK STATUS FUNCTION
	MOVE B,(Q1)		;GET THE HOST NUMBER
	MOVEI C,DCASTS		;GET ADDRESS OF THE FIRST WORD
	MOVSI D,-7		;GET SEVEN WORDS OF STATUS
	GTHST%			;GET NETWORK STATUS
	 ERJMP ANSTS2		;IF ERROR ASSUME NO ARPANET
	MOVE B,(Q1)		;GET THE NETWORK NUMBER
	MOVE C,(Q1)		;GET THE NETWORK NUMBER
	TXNN B,<BYTE (4)0(8)200,0,0,0> ;CLASS A?
	 TXZ C,<BYTE (4)0(8)0,377,377,377> ;YES
	TXNE B,<BYTE (4)0(8)200,0,0,0> ;CLASS B?
	 TXNE C,<BYTE (4)0(8)100,0,0,0> ;CLASS B?
	  SKIPA			;NOT CLASS B
	   TXZ C,<BYTE (4)0(8)0,0,377,377> ;YES
	TXNE B,<BYTE (4)0(8)200,0,0,0> ;CLASS C?
	 TXNN B,<BYTE (4)0(8)100,0,0,0> ;CLASS C?
	  SKIPA			;NOT CLASS C
	   TXZ C,<BYTE (4)0(8)0,0,0,377> ;YES
	MOVEI A,.GTHNS		;GET HOST NAME FUNCTION
	HRROI B,DCANAM		;TARGET ADDRESS
	GTHST%			;GET THE NETWORK NAME
	 ERJMP ANSTS2		;ON ERROR ASSUME NO NAME
	HRROI A,DCANAM		;GET A POINTER TO THE NAME STRING
	ETYPE <Local %1M >
	MOVEI A,.GTHNS		;GET HOST NAME FUNCTION
	HRROI B,DCANAM		;GET POINTER TO STRING TARGET
	MOVE C,(Q1)		;GET THE HOST NUMBER
	GTHST%			;GET THE HOST NAME STRING
	 ERJMP ANSTS2		;ON ERROR ASSUME NO ARPANET
	HRROI A,DCANAM		;GET A POINTER TO THE NAME STRING
	ETYPE <host name is %1M>
	MOVX D,<POINT 8,(Q1),3> ;GET POINTER TO ADDRESS OCTETS
	ILDB A,D		;GET THE FIRST OCTET
	ILDB B,D		;GET THE SECOND
	ILDB C,D		;GET THE THIRD
	ILDB D,D		;GET THE FOURTH
	ETYPE <, Internet address is %1Q.%2Q.%3Q.%4Q
>
	HRROI A,[ASCIZ/up/]	;ASSUME INTERFACE IS UP
	SKIPN 0+DCASTS		;INTERFACE DOWN?
	HRROI A,[ASCIZ/down/]	;YES
	SKIPLE 0+DCASTS		;CYCLING?
	HRROI A,[ASCIZ/cycling/] ;YES
	ETYPE <Network interface is %1M
>
	HRROI A,[ASCIZ/enabled/] ;ASSUME OUTPUT ENABLED
	SKIPN 3+DCASTS		;OUTPUT DISABLED?
	HRROI A,[ASCIZ/disabled/] ;YES
	ETYPE <Network interface output is %1M
>
	HRROI A,[ASCIZ/enabled/] ;ASSUME ENABLED INTERFACE
	SKIPN 1+DCASTS		;INTERFACE DISABLED?
	HRROI A,[ASCIZ/disabled/] ;YES
	SKIPLE 1+DCASTS		;CYCLING
	HRROI A,[ASCIZ/cycling/] ;YES
	ETYPE <Network service is %1M
>
	SKIPLE A,4+DCASTS	;GET NETWORK CYCLE TIME
	ETYPE <Last network interface cycle transition: %1W
>
	SKIPLE A,5+DCASTS	;GET NETWORK OFF TIME
	ETYPE <Last network interface off transition: %1W
>
	SKIPLE A,6+DCASTS	;GET NETWORK ON TIME
	ETYPE <Last network interface up transition: %1W
>
	AOBJN Q1,ANSTS0		;LOOP FOR ALL THE INTERFACES
	RET			

ANSTS2:				;HERE WHEN GTHST GAVE AN ERROR
	ETYPE <%%No ARPANET>
	RET
; INFORMATION ABOUT CLUSTER - ALWAYS DISPLAYS LOCAL NODE, THEN ANY OTHER NODES
; (HOSTS) IN THE CLUSTER, FINALLY ANY HSC NODES FOUND.

.CLUST::MOVEI A,.CFCND		;WE WANT NODES
	MOVEI B,CFGBLK		;ARG BLOCK
	MOVEI C,CFGSIZ		;BLOCK LENGTH
	MOVEM C,.CFNND(B)
	CNFIG%
	  ERCAL CJERRE
	HLRZ Q1,.CFNND(B)	;MAKE AOBJN POINTER FOR LOOPING THRU NAMES
	MOVNS Q1
	HRLZS Q1
	TLO Z, F2               ;SIGNAL "BEFORE" ROUTINE WE WANT TAB
	MOVE B,CFGBLK+.CFBP1(Q1) ;POINT TO 1ST NODE RETURNED - LOCAL NODE
	ETYPE < Local Cluster Node:     >
        CALL BEFORE
	ETYPE <%2M>
	AOBJN Q1,GTHST1		;[3020]
	JRST HSCS		;NO MORE HOSTS - GET HSCS
GTHST1:	ETYPE <%_>		;[3020] START ON A NEW LINE
	ETYPE < Accessible TOPS-20 Hosts: > ;[3020]
	CALL BEFORE		;[3020]		
GTHSTS:	MOVE A,CFGBLK+.CFBP1(Q1) ;POINT TO HOST NAME
	PSOUT			;TELL THE FOLKS
	  ERJMP CJERRE
	CALL BEFORE
	AOBJN Q1,GTHSTS	                            
HSCS:   ETYPE <%_>	        ;DONE WITH HOSTS - START ON A NEW LINE
	MOVEI A,.CFHSC		;WE WANT HSCS
	MOVEI B,CFGBLK		;ARG BLOCK
	MOVEI C,CFGSIZ		;SIZE OF ARG BLOCK
	MOVEM C,.CFNHN(B)                                    
	CNFIG%
	  ERCAL CJERRE
	HLRZ Q1,.CFNHN(B)       ;MAKE AOBJN POINTER TO LOOP THRU HSC NAMES
	JUMPE Q1,ENCLUS		;IF NO HSCS, WE ARE DONE.
	MOVNS Q1
	HRLZS Q1
	TLO Z, F2
	ETYPE < Accessible HSC Servers: >
GETHSC:	CALL BEFORE
       	MOVE A,CFGBLK+.CFHP1(Q1)
	SETZ B,			;ZERO COUNT OF TRAILING SPACES IN NAME
	DO.			;DO THIS CUZ HSC FIELD IS TEN CHAR'S NOT 8
	  ILDB C,A		;GET NEXT CHAR FROM HSCs NAME STRING
	  JUMPE C,ENDLP.	;LEAVE IF THIS THE NULL AT END OF STRING
	  CAIN C,40		;IS THIS A SPACE?
	   SOSA B		;YES, COUNT IT
	    SETZ B,		;NO -  ZERO THE COUNT OF TRAILING SPACES
	  LOOP.
	ENDDO.
	ADJBP B,A		;POINT TO FIRST TRAILING SPACE OR NULL
	DPB C,B			;PUT THE NULL WE FOUND ON TOP OF IT
       	MOVE A,CFGBLK+.CFHP1(Q1)
	PSOUT			;TELL THE PEOPLE
	  ERCAL CJERRE
        AOBJN Q1,GETHSC		; 
ENCLUS:	TLZ Z,F2		; CLEAR TAB FLAG
	RET
;INFORMATION (ABOUT) DECNET  OR  INFORMATION (ABOUT) DECNET FOO::

.IDECN::MOVEI B,[FLDDB. .CMCFM,,,,,[
		 FLDDB. .CMNOD,CM%PO!CM%SDH!CM%NSF,,<specific node name>]]
	CALL FLDSKP
	 CMERRX <carriage return or node name required>
	LDB C,[331100,,(C)]	;GET FIELD FLAVOR
	CAIN C,.CMCFM		;WAS "I DECNET" TYPED?
	JRST .DNTOP		;YES - SHOW ALL THE NODES THAT ARE UP
	CONFIRM			;NO - CONFIRM THE COMMAND
	HRROI C,ATMBUF		;GET POINTER TO THE NODE NAME
	MOVEI A,.NDVFY		;VERIFY THE STATUS OF THIS NODE
	MOVEI B,C		;(READ FLAGS INTO AC D)
	NODE
	 ERJMP CJERRE		;FAILED - SAY WHY

	TXNN D,ND%LGL		;Is node name format parseable?
	 JRST AVUPN		;No
	TXNN D,ND%EXM		;Is the node known to the system?
	 JRST AVNUA		;No - SAY SO
	TXNE D,ND%RCH		;Is the node reachable?
	 JRST AVNOU		;YES - SAY SO
	TXNE D,ND%RUK		;Is reachability unknown?
	 JRST AVRUK	
AVNOD:	ETYPE <%%Node %3M is unreachable
>
	RET
AVUPN:	ETYPE <%%Illegal node name format
>
	RET
AVNUA:	ETYPE < Node %3M is not known to this system
>
	RET
AVNOU:	ETYPE < Node %3M is reachable
>
	RET
AVRUK:	ETYPE < Node %3M accessibility can only be determined by attempting a connection
>
	RET
;INFORMATION (ABOUT) DECNET

.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
	MOVEI A,.NDGLN		;GET THE LOCAL NODE NAME
	NODE
	 ERCAL DNTOPE
	MOVEI A,BUFL-BUF0-10-.NDNND-1
	MOVEM A,BUF0+10+.NDNND	;SAVE NUMBER OF WORDS AVAILABLE FOR THE TABLE
	MOVEI 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

	SETZ D,			;CLEAR COUNT OF NODES
	MOVEI C,.NDSON		;GET NODE ON-LINE FLAG
DNTOP0:	MOVE B,(A)		;GET POINTER TO NODE BLOCK
	CAMN C,.NDSTA(B)	;IS THE NODE ON-LINE?
	AOJA D,DNTOP1		;YES - COUNT IT AND MOVE IT
	SETZM (A)		;NO - SKIP IT - CLEAR POINTER
	AOBJN A,DNTOP0		;LOOP THROUGH TABLE; FALL THROUGH WHEN DONE
	JRST DNTOP2		;THEN JOIN THE AFTER-LOOP FLOW

DNTOP1:	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:	ETYPE <.  Nodes reachable: %4Q.%_>
	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?
	PUSH P,D		;KEEP IT
	MOVE D,(D)		;GET STRING
	TLC B,400000		;MASK OFF FIRST (SIGN) BIT
	TLC D,400000		; TO GET NUMBERS BEFORE LETTERS
	CAMG B,D		;COMPARE... IS IT LESS?
	 JRST [	POP P,D		; YES - KEEP AS IS
		TLC B,400000	;RESTORE ORIGINAL STRING
		JRST DNTOP6]
	POP P,D			;RESTORE STRING POINTER
DNTOP5:	MOVE B,(D)		;AND SET UP STRING ITSELF
	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

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
;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?
	SKIPG B
	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

	TYPE < 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 IN RH OF D.
;NOP IF UNASSIGNED.
;IF ASSIGNED, TYPE <JFN> <NAME>
;AND WHAT OPEN FOR AND "NOT OPEN" OR "DATA ERROR" OR "EOF" IF PERTINENT.
;DESTROYS A, B, C, E.  USED IN "FILSTAT".

JSTAT:	HRRZ A,D
	GTSTS
	TLNN B,200
	RET			;UNASSIGNED, RETURN.
	MOVE Q1,B		;STATUS FOR USE BELOW
	PRINT " "
	MOVE A,COJFN
	HRRZ B,D
	MOVE C,[XWD 4,10]
	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
	MOVEI C,12
	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
	MOVEI B,")"
	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
;[7.1061]
;ROUTINE TO OUTPUT INFORMATION ABOUT REMOTE-PRINTING.
;WILL LIST CHARACTERISTIC NAMES, THEN REMOTE-PRINTER NAMES, RESOLVED
;TO "PRINTER/NODENAME" COMBINATION

.REMOT::STKVAR <STRLEN,TBLPTR,STRPTR,SAVQ1,SAVQ2,SAVQ3> ; Length of string being printed, and Qn AC's
	MOVEM Q1,SAVQ1
	MOVEM Q2,SAVQ2
	MOVEM Q3,SAVQ3
	SETZM STRLEN            ; Zero it
	SKIPE CHRTAB		; No table at all?
	IFSKP.
	  ETYPE <%%No CHARACTERISTICs Table%_> ; Nope.
	  JRST REMOT3
	ENDIF.
	MOVE D,CHRTAB		; Get table address
	MOVE B,(D)       	; Get first table word
	HLRZ C,B		;     and number of entries
	IFE. C			;[4410] No entries?
          ETYPE <%%No CHARACTERISTICs found%_> ;Guess not
	  JRST REMOT3
	ENDIF.

;OK, WE HAVE A TABLE WITH SOME STUFF IN IT - STEP THROUGH AND PRINT
;THE NAMES.

	ETYPE <%_>		; Start on a new line
	ETYPE <CHARACTERISTICS currently defined for this job:%_>
	ETYPE <%_>
 	TLO Z, F2               ;Signal "RMOTB4" routine we want tabs
	AOJ D,			; Increment to first table entry
	MOVN Q3,C		; Negative table length
	HRLZS Q3
	HRR Q3,D		; First table entry


REMOT2: HLRO C,(D)		; Make a byte pointer to address of string
	MOVEM D,TBLPTR          ; (BCOUNT gorches D)
	MOVEM C,STRPTR          ; (BCOUNT again!)
	MOVE A,C		; Get byte pointer into AC1 for BCOUNT
	CALL BCOUNT		; (A/A,B) How many characters?
	MOVEM B,STRLEN          ; Put number someplace safe
	MOVEI D,CHRCHR		; Tell formatter max characters
	ADDI D,2		; Add a couple for tab stops
        CALL RMOTB4		; (Z,D/D) Call formatting routine
	MOVE D,TBLPTR		; Get back our table pointer
	MOVE C,STRPTR		; And our string pointer
 	MOVE Q2,STRLEN		; Get length of string to type
	CAIGE Q2,^D8		;[4410] Less than 8 characters?
	IFSKP.			;[4410] 
          ETYPE <%3M>		; No - more. Just print the name
	ELSE.	
          ETYPE <%3M       >	; Print the name with an extra tab
	ENDIF.
	AOJ D,			; Next table entry
	AOBJN Q3,REMOT2		; and loop
	ETYPE <%_>		;[4410] Give ourselves some room
;	JRST REMOT3
;[7.1068]
;HERE TO DISPLAY LIST OF REMOTE PRINTERS.
;TYPE THE ALIAS FIRST, THEN A "-->", FOLLOWED BY ANY OTHER ALIASES, THEN
;FINALLY THE PHYSICAL PRINTER IN THE FORM "NAME (ON NODE) NODE"
;

REMOT3:	SKIPE PTRTAB		;[4410] No table at all?
	IFSKP.			;[4410] Nope
          ETYPE <%%No REMOTE PRINTER Table%_> ; Nope.
	  RET
	ENDIF.
	MOVE D,PTRTAB		; Get table address
	MOVE B,(D)       	; Get first table word
        HLRZ C,B		;     and number of entries
	IFE. C			;[4410] No entries?
          ETYPE <%%No REMOTE PRINTERs found%_> ;Guess not
	  RET
	ENDIF.

;OK, WE HAVE A TABLE WITH SOME STUFF IN IT - STEP THROUGH AND PRINT
;THE NAMES.

	ETYPE <%_>		; Start on a new line
	ETYPE <REMOTE PRINTERS currently defined for this job:%_>
	ETYPE <%_>
	AOJ D,			; Increment to first table entry
;MAKE AOBJN POINTER

       	MOVN Q3,C		; Negative table length
	HRLZS Q3
	HRR Q3,D		; First table entry

REMOT4: HLRO C,(D)		; Make a byte pointer to address of string
        ETYPE < %3M >           ; Print the name
	HRROI A, [ASCIZ/--> /]	; Now pointer thingy
	ETYPE <%1M >
        HRRZ B,(D)		; Get address of data
	IFE. B			;[4410] If zero, an deleted entry!
	  ETYPE <[Deleted entry found]%_> ;Yes.
	  JRST REMOT5
	ENDIF.
	HLRZ C,(B)		; LH of data pointer
	IFE. C			;[4410] If zero, then its an alias
	  HRRO C,(B)		; Then we need the RH
          ETYPE < %3M
>                               ; Print the name
	ELSE.			; Not zero - this is a "physical printer"
          HRLI C,-1  		; Make a byte pointer
          ETYPE < %3M on node>	;[4410] Print the name
          HRR A,(D)		; Get RH of data word
          HRRO C,(A)		; Point to nodename

          ETYPE < %3M
>                               ; Print the nodename
	ENDIF.

REMOT5:	AOJ D,			; Next table entry
	AOBJN Q3,REMOT4		; and loop
	MOVE Q1,SAVQ1		; Now restore the Q's
	MOVE Q2,SAVQ2
	MOVE Q3,SAVQ3
	RET
;[7.1061]
;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE, WITH
;ITEM NAMES LONGER THAN EIGHT CHARACTERS.
;
;THIS IS ESSENTIALLY THE SAME AS ROUTINE "BEFORE".
;HOWEVER, "BEFORE" ASSUMES EIGHT CHARACTERS, AND WE NEED TO ALLOW
;14 FOR CHARACTERISTICS. SO, MAKE THIS ROUTINE TAKE THE NUMBER OF
;CHARACTERS AS INPUT, AND BASE ITS DECISIONS ON THAT. TWO TABS WILL
;BE OUTPUT BETWEEN ENTRIES.
;
;FORMAT WILL BE: COMMA FOLLOWING ENTRY, EXCEPT CRLF IF TOO FAR TO RIGHT.
;					OR
;		 TABS BETWEEN ENTRIES, AND CRLF IF TOO FAR TO RIGHT

;CALL WITH: F2 ON IN AC Z TO GET TABS BETWEEN ITEMS, OFF TO GET A COMMA,SPACE
;	    D/MAX NUMBER OF CHARACTERS ALLOWED PER ENTRY


RMOTB4::ATSAVE
 	MOVE A,COJFN
 	MOVEI B,.MORLW
 	MOVEI C,^D72		;Use 72 columns if not a terminal
 	MTOPR			;Get line width
	 ERJMP .+1		;If not, use 72 (presumably not a terminal)
	RFPOS			;Where are we?
	 ERJMP .+1
	MOVEI B,(B)		;Mask column position
	SKIPE B         	;Just starting out? Then no tabs yet.
        IFSKP.
	  PRINT " "		;But we need an initial space
	  RET
	ENDIF.
	AOJ D,			;Pad length
	MOVNS D         	;Make negative
 	CAIL B,^D72(D)		;Not enough room for entry?
 	JRST RMTB41		;Yes, start new line and return
 	TLNE Z,F2		;Want a tab between entries?
 	JRST RMTB40		;Yes - go do it
 	TLOE Z,F1		;No - for first entry just output a space
 	PRINT ","		;Else output a comma and space
 	PRINT " "
 	RET
 
;HERE TO PRINT TABS 

RMTB40:	PRINT 11		;Print a tab
 	RET			;
 
RMTB41:	TLNN Z,F2		;Putting a tab between entries?
 	PRINT ","		;No - end line with a comma
 	ETYPE <%_ >		;Either way, start a new line
 	RET
	ENDTV.
;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
	SKIPE B         	;[3051]	[3052] No entry vector?
	CAIN B,(<JRST>)		;[3051]	Old style entry vector?
	TRNA			;[3051]	Yes to either - use .JBVER
	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,VERSIX	;NO OLD STYLE VERSION OR NAME, CHECK PDVS
		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
	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
	MOVEI 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:	MOVEI 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
	MOVEI A,1+.POADR	;SAY LENGTH OF ARGUMENT BLOCK
	MOVEM A,.POCT1+PDVARG
	MOVEI 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
		AOJ A,		;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
	MOVEI A,1		;VERSION IS ONLY ONE WORD
	MOVEM A,.POCT2+PDVARG
	MOVEI 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
	MOVEI 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]
	MOVEI A,MAXNAM		;GET MAXIMUM NAME LENGTH
	MOVEM A,.POCT2+PDVARG
	MOVE A,NAMADR		;GET ADDRESS OF NAME BUFFER
	MOVEM A,.PODAT+PDVARG
	MOVEI 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
	TXNE B,PA%PEX		;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

VERPNT::LDB A,[POINT 9,Q1,11]	;GET MAJOR VERSION
	JUMPE A,VERSI1		;MAJOR VERSION NUMBER?  NO, SKIP IT
	TXNE Q1,VI%DEC		;DECIMAL FORM?
	JRST [ETYPE <%1Q>	;YES, WRITE IT IN NEW STYLE
	      JRST VERSI1]	;SKIP OVER OLD STYLE
	ETYPE <%1O>		;PRINT IF NON-ZERO
VERSI1:	LDB A,[POINT 6,Q1,17]	;GET MINOR VERSION
	JUMPE A,VERSI2		;SKIP IF 0
	TXNE Q1,VI%DEC		;DECIMAL FORM?
	JRST [ETYPE <.%1Q>	;YES, WRITE IT IN NEW STYLE
	      JRST VERSI2]	;SKIP OVER OLD STYLE
	ETYPE <.%1O>		;PUT DOT AND OCTAL MINOR NON-ZERO VALUE
VERSI2:	HRRZ A,Q1		;GET EDIT NUMBER
	JUMPE A,VERSI3
	TXZE A,VI%DEC		;DECIMAL FORM?
	JRST [ETYPE <(%1Q)>	;YES, WRITE IT IN NEW STYLE
	      JRST VERSI3]	;SKIP OVER OLD STYLE
	ETYPE <(%1O)>		;PRINT IF NON-ZERO
VERSI3:	LDB A,[POINT 3,Q1,2]	;GET GROUP CODE
	SKIPE A
	ETYPE <-%1O>		;PRINT IF NON-ZERO
	ETYPE <%_>
	RET
END