Trailing-Edge
-
PDP-10 Archives
-
bb-gs97b-sm
-
exec-sources/execin.mac
There are 47 other files named execin.mac in the archive. Click here to see a list.
; 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
CALLRET SYSDWN ;PRINT 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
.JOBST::STKVAR <LLPTR>
CALL GETNOD ;GET NODE NAME
JRST TRYARP ;[7.1199] NO DECnet, TRY ARPANET
CALL DEKCHK ;DECnet EXISTS - IS IT USED?
ETYPE < Host %1M%%_> ;YES, TELL DECnet NODE NAME
NOTNOD: ETYPE < Job %J, %L, User %N> ;NO DECnet OR ARPANET, JUST SAY JOB STUFF
GJINF
CAME B,LIDNO ;SKIP IF CONNECTED TO LOGGED-IN DIR
ETYPE <, %G% >
ETYPE <%_>
CALL ACTSTG ;PRINT ACCOUNT INFO
HRROI A,-1 ;CURRENT JOB
MOVE D,CSBUFP ;USE FREE SPACE POINTER
HRROI B,D ;SAY ONE ENTRY, POINTER IN D
MOVEI C,.JISRM ;SPECIFY WE WANT SESSION REMARK
GETJI ;GET SESSION REMARK
ERJMP LOC ;IF FAILS, THERE'S NO REMARK
MOVE A,CSBUFP ;GET POINTER TO REMARK
ILDB A,A ;GET FIRST CHARACTER
MOVE D,CSBUFP
CAIE A,0 ;PRINT NOTHING IF NO SESSION REMARK
ETYPE < Session remark: %4M%%_>
CALL LM ;CARRIAGE RETURN IF NEEDED
LOC: HRROI A,-1 ;OURSELF
HRROI B,CSBUFP ;POINT TO BYTE POINTER
MOVEI C,.JILLO ;SAY WE WANT LOGICAL LOCATION
MOVE D,CSBUFP ;GET POINTER TO BEGINNING OF STRING
GETJI ;GET IT
ERCAL CJERRE ;SHOULDN'T FAIL
MOVE A,D ;GET POINTER TO LOGICAL LOCATION
CALL BUFFS ;SAVE THE LOCATION
MOVEM A,LLPTR ;REMEMBER POINTER TO IT
CALL GETNOD ;GET HOST NODE NAME
MOVE A,LLPTR ;ON NONDECNET, GUARANTEE THAT THEY MATCH
MOVE B,LLPTR ;COMPARE WITH OUR JOB'S NODE
STCMP
JUMPE A,IJDONE ;DON'T PRINT NAME IF THEY'RE THE SAME
MOVE A,LLPTR
ETYPE < Located at %1M%%_>
IJDONE: RET
; SEE IF INSTALLATION HAS LEFT DEFAULT NODE NAME - "TOPS20" . IF SO, ASSUME
; EITHER DECNET TURNED OFF, OR THEY DON'T WANT HOST NAME DISPLAYED FROM "INFO JOB"
DEKCHK: STKVAR <SAVEA,SAVEB>
MOVEM B, SAVEB ;SAVE AC2 - THIS CLOBBERS IT
MOVEM A,SAVEA ;SAME WITH AC1
HRROI B,[ASCIZ/TOPS20/] ;DEFAULT NODE NAME BEING USED?
STCMP
CAIN A,0 ;IF 0, STRINGS ARE EQUAL - USING THE DEFAULT
RETSKP ;THEY'RE THE SAME - DON'T SAY HOST NAME
MOVE A,SAVEA ;RESTORE NODE NAME TO AC1
MOVE B,SAVEB ;RESTORE AC2
RET ;NOT DEFAULT NODE NAME, TELL WHAT IT IS
ENDSV.
; SEE IF WE'RE ARPANET - IF SO, TELL THE HOST NAME
TRYARP: MOVEI A,.GTHSZ ;SEE IF ANY ARPANET HOSTS
GTHST
JRST NOTNOD ;IF FAILS, NO ARPA HOSTS
ETYPE < Host >
MOVE C,D
MOVE B,COJFN ;OUTPUT DESIGNATOR
MOVEI A,.GTHNS ;WE WANT HOST NAME
GTHST ;TELL HOST NAME
JRST NOTNOD ;NO ARPA HOST
ETYPE < %_>
JRST NOTNOD ;SKIP RETURN IN ANY CASE
;ROUTINE TO PRINT ACCOUNTING STRING IF PRESENT
ACTSTG: STKVAR <<ACCBUF,EXTSIZ>>
HRROI B,ACCBUF ;POINT TO ACCOUNT BUFFER
MOVNI A,1 ;-1 FOR SELF
GACCT ;GET IT
LDB A,[410300,,B] ;GET SIG. OCTAL DIGIT
CAIE A,5 ;5 MEANS NUMBER INSTEAD OF STRING
JRST [MOVE B,[POINT 7,ACCBUF]
ILDB B,B ;GET FIRST BYTE OF STRING
JUMPE B,R ;IF NULL, NO STRING THEN
HRROI A,ACCBUF ;POINT TO STRING
ETYPE < Account %1M > ;DUMP IT
RET]
TLZ B,500000 ;GET RID OF CONTROL BITS
ETYPE < Account %2Q > ;DECIMAL
RET ;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
SKIPE C ; No entries?
IFSKP.
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
CAIL Q2,^D8 ; Less than 8 characters?
IFNSK.
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
; 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: ETYPE <%_>
ETYPE <%_> ; Give ourselves some room
SKIPN PTRTAB ; No table at all?
IFNSK.
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
SKIPN C ; No entries?
IFNSK.
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
SKIPN B ;Zero?
IFNSK.
ETYPE <[Deleted entry found]%_> ;Yes.
JRST REMOT5
ENDIF.
HLRZ C,(B) ; LH of data pointer
SKIPN C ; Is it zero?
IFNSK. ;Yes. This is 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 > ; 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