Trailing-Edge
-
PDP-10 Archives
-
BB-M081U-SM_1989
-
exec/exec0.mac
There are 47 other files named exec0.mac in the archive. Click here to see a list.
; Edit= 4427 to EXEC0.MAC on 27-Apr-89 by GSCOTT
;Add support for ENABLE/DISABLE NOT-LOGGED-IN-SYSTAT command in SETSPD.
; Edit= 4424 to EXEC0.MAC on 9-Mar-89 by GSCOTT
;Support terminal type IDEAL.
; Edit= 4422 to EXEC0.MAC on 3-Mar-89 by RASPUZZI
;Fix insufficient size of STKVAR in GETPOB for large usernames.
; Edit= 4420 to EXEC0.MAC on 16-Feb-89 by GSCOTT
;Make ETYPE's %W say "never" for a zero date, then clean up login message code
;in EXEC0 and EXEC1.
; Edit= 4413 to EXEC0.MAC on 19-Dec-88 by RASPUZZI
;Fix broken SYSTAT in subcommand mode when username contains a wildcard
;character.
; Edit= 4412 to EXEC0.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4401 to EXEC0.MAC on 17-Mar-88 by RASPUZZI
;Take another whack at POBOX. Rewrite GETPOB so that it translates POBOX: and
;searches each structure for the user's POBOX directory. Also, fix ACSPOB to
;work correctly and look for STRX10 in MALCHK.
; UPD ID= 4106, RIP:<7.EXEC>EXEC0.MAC.21, 7-Mar-88 18:19:46 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 82, RIP:<7.EXEC>EXEC0.MAC.20, 10-Dec-87 15:14:16 by RASPUZZI
;TCO 7.1161 - Do something reasonable when user fills .CMFLD with crapola.
; Also, ***PERFORMANCE***. Remove extraneous INFO% (doing
; GETJI%) that is causing a slow down.
; UPD ID= 76, RIP:<7.EXEC>EXEC0.MAC.19, 24-Nov-87 15:10:09 by MCCOLLUM
;More of TCO 7.1140 - Fix SYSTAT to display class scheduling information
; in non-cluster mode again
; UPD ID= 75, RIP:<7.EXEC>EXEC0.MAC.18, 20-Nov-87 08:05:13 by RASPUZZI
;Fix typo in previous edit - change CLSFLG to CLSMSK like it should be.
; UPD ID= 74, RIP:<7.EXEC>EXEC0.MAC.17, 19-Nov-87 15:00:54 by RASPUZZI
;TCO 7.1140 - Do not display numbers in the class scheduling items if that
; system is not running class scheduling. Display blanks instead.
; UPD ID= 71, RIP:<7.EXEC>EXEC0.MAC.16, 17-Nov-87 15:08:12 by RASPUZZI
;TCO 7.1139 - Display all job 0's in the cluster when SYS NOD * OPERATOR
; is done.
;TCO 7.1137 - Make SYSTAT USER work for USER not being a local username.
; Note that THIS engineer does NOT support the use of SSTACK.
; It is a blatant crock but we are stuck with it for SYSTAT.
; If you can't beat'em, join'em (ptui!).
; UPD ID= 65, RIP:<7.EXEC>EXEC0.MAC.15, 12-Nov-87 16:39:13 by RASPUZZI
;More of TCO 7.1131 - Prevent Illegal memory read traps by using the right
; loop counter in NODPRT.
; UPD ID= 64, RIP:<7.EXEC>EXEC0.MAC.14, 12-Nov-87 15:09:31 by RASPUZZI
;TCO 7.1131 - Fix bug where %Class scheduling is off... is displayed
; when user does SYS NOD * ALL USER
; UPD ID= 59, RIP:<7.EXEC>EXEC0.MAC.13, 29-Oct-87 17:36:37 by RASPUZZI
;Fix small bug with previous edit.
; UPD ID= 57, RIP:<7.EXEC>EXEC0.MAC.10, 29-Oct-87 15:53:56 by RASPUZZI
;TCO 7.1100 - Don't display class if no system running class scheduling
; and show which nodes in the cluster are not returning
; information
; UPD ID= 53, RIP:<7.EXEC>EXEC0.MAC.9, 28-Oct-87 15:07:30 by RASPUZZI
;More of TCO 7.1089 - Fix stupidity in NODCHK
; UPD ID= 52, RIP:<7.EXEC>EXEC0.MAC.8, 28-Oct-87 14:05:27 by RASPUZZI
;TCO 7.1093 - Make N an invisible abbreviation for NO in SYSTAT
; UPD ID= 47, RIP:<7.EXEC>EXEC0.MAC.7, 27-Oct-87 16:06:05 by RASPUZZI
;TCO 7.1089 - Make SYS NOD * User work by caching job range outside of
; routine NODPRT. Make SPCIT space nodename and username
; correctly. Also, change NODCHK a little for efficiency.
; UPD ID= 38, RIP:<7.EXEC>EXEC0.MAC.6, 22-Oct-87 11:03:02 by RASPUZZI
;TCO 7.1076 - Add code to SYSYAT to use the INFO% JSYS for cluster wide
; SYSTATs. This includes a new command (NODE) to SYSTAT.
; UPD ID= 4, RIP:<7.EXEC>EXEC0.MAC.5, 4-Jun-87 14:54:15 by PRATT
;More of TCO 7.1008 - Rip out useless ";**; helper" lines
; UPD ID= 3, RIP:<7.EXEC>EXEC0.MAC.4, 3-Jun-87 09:51:35 by PRATT
;TCO 7.1008 - Fix systats origin typeout code to not type out 0 node
; numbers and also fix the incorrect column position of the
; origin field on "SYS username".
; UPD ID= 2, RIP:<7.EXEC>EXEC0.MAC.3, 3-Jun-87 09:44:52 by PRATT
;TCO 7.1007 - Make the EXEC typeout SYSTEM:JOB-STARTUP-MESSAGE.TXT
; *** Edit 3062 to EXEC0.MAC by EVANS on 3-Apr-87
; Change [] to <> to make GTJFN happy
; *** Edit 3059 to EXEC0.MAC by EVANS on 31-Mar-87, for SPR #21419
; Rewrite routine GETPOB; most importantly, add a test for "logged-in" and if
; not logged in exit immediately.
; *** Edit 3055 to EXEC0.MAC by EVANS on 11-Mar-87
; Add VT300 - dependent monitor edits 7423 and 7424.
; *** Edit 3053 to EXEC0.MAC by EVANS on 19-Nov-86
; Add an ERJMP after the ACCES% of POBOX:, as the JSYS always returns +1.
; *** Edit 3050 to EXEC0.MAC by EVANS on 29-Oct-86, for SPR #00092
; Reset STATSW to zero to prevent mulitply defined symbols when linking with
; distributed PCL and MIC modules; remove the STAT code so we don't do the
; statistics.
; *** Edit 3048 to EXEC0.MAC by EVANS on 14-Oct-86
; Make mail-checking code check to see if POBXNO (user's POBOX: directory
; number) is set up; if not, don't do the mail check. Also, check POBXNO before
; calling GETPOB:, so as not to execute the code if we don't have to.
; *** Edit 3047 to EXEC0.MAC by EVANS on 24-Sep-86
; Rework error handling in GETPOB: so as not to miss calls to RLJFN%.
; *** Edit 3046 to EXEC0.MAC by EVANS on 25-Aug-86
; Get the user's POBOX: directory number and save it separately from doing the
; access of it, as the access won't be done on a /FAST login or a PUSH; the
; directory number is needed for mail-watching and typing system mail. This
; incorporates edits 3034,3039,3040,3043,and 3044 in to 3046.
; *** Edit 3044 to EXEC0.MAC by EVANS on 15-Jul-86
; Implement LOGINF to tell when we are acessing POBOX: and mail-checking during
; login; have MALCHK test it and return to log-in code on a JSYS error.
; *** Edit 3043 to EXEC0.MAC by EVANS on 30-Jun-86
; Add POBJFN to the STKVAR at ACSPOB:
; *** Edit 3040 to EXEC0.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 3039 to EXEC0.MAC by EVANS on 6-Jun-86
; Fix edit 3034 to not end the access of POBOX: and to allow for POBOX:'s being
; a search string
; *** Edit 3034 to EXEC0.MAC by EVANS on 30-Apr-86 (TCO none)
; For MS QAR 907013 - Users who did not have mail watch set would not be
; notified of new mail at log-in. Make the login code ACCESS user's POBOX: and
; do a mail check.
; *** Edit 3030 to EXEC0.MAC by RASPUZZI on 8-Apr-86, for SPR #20778
; Display last login date & time when EXEC is started with CRJOB
; *** Edit 3027 to EXEC0.MAC by MAYO on 14-Feb-86
; Fix a comment.
; UPD ID= 216, SNARK:<6.1.EXEC>EXEC0.MAC.20, 10-Jun-85 08:41:13 by DMCDANIEL
; UPD ID= 200, SNARK:<6.1.EXEC>EXEC0.MAC.19, 24-May-85 14:12:56 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 186, SNARK:<6.1.EXEC>EXEC0.MAC.18, 3-May-85 14:43:04 by PRATT
;TCO 6.1.1357 - Don't clear name of fork when non-virgin on deposits
; UPD ID= 160, SNARK:<6.1.EXEC>EXEC0.MAC.17, 3-May-85 08:29:05 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 151, SNARK:<6.1.EXEC>EXEC0.MAC.16, 8-Apr-85 11:08:19 by PRATT
;TCO 6.1.1311 - Move the label FST3 up one line before the CALL ALRCHK
; UPD ID= 149, SNARK:<6.1.EXEC>EXEC0.MAC.15, 23-Mar-85 09:47:36 by MCCOLLUM
;OPERATOR and ORGIN are alphabetically inverted in the $SYSNO table
; UPD ID= 148, SNARK:<6.1.EXEC>EXEC0.MAC.14, 18-Mar-85 11:09:47 by PRATT
;TCO 6.1.1274 - Add ORIGIN/NO ORIGIN to SYSTAT
; UPD ID= 102, SNARK:<6.1.EXEC>EXEC0.MAC.13, 11-Dec-84 15:21:04 by MOSER
;TCO 6.1.1077 - ADD STAT STUFF
; UPD ID= 97, SNARK:<6.1.EXEC>EXEC0.MAC.12, 27-Nov-84 11:21:46 by EVANS
;TCO 6.1.1027 - Handle case of running program in LOGOUT.CMD
; UPD ID= 58, SNARK:<6.1.EXEC>EXEC0.MAC.7, 12-Nov-84 03:43:26 by MERRILL
;TCO 6.1.1042 - Update to work with the latest PCL we have
; Clear CIPF later (after CIN1) so DOCOMMAND "kept-fork-name" works.
; Fix ORIGINAL <esc> ^U to not leave the doing-an-original-command flag set.
; UPD ID= 51, SNARK:<6.1.EXEC>EXEC0.MAC.6, 5-Nov-84 12:55:23 by PRATT
;More TCO 6.1.1028 - Include network type after hostname
; UPD ID= 50, SNARK:<6.1.EXEC>EXEC0.MAC.5, 2-Nov-84 16:30:48 by PRATT
;More TCO 6.1.1028 - Handle detached lines correctly
; UPD ID= 43, SNARK:<6.1.EXEC>EXEC0.MAC.3, 28-Oct-84 10:53:18 by PRATT
;TCO 6.1.1028 - Always type out the "4n host" field
; UPD ID= 37, SNARK:<6.1.EXEC>EXEC0.MAC.2, 26-Oct-84 13:35:15 by EVANS
;TCO 6.1.1207 - Add SYSTEM: .CMD file code and label for LOGOUT.CMD
; UPD ID= 454, SNARK:<6.EXEC>EXEC0.MAC.45, 3-Oct-84 17:01:12 by PRATT
;TCO 6.2235 - Fix problem with ^T during ^C of ephemoral program
; UPD ID= 448, SNARK:<6.EXEC>EXEC0.MAC.44, 27-Sep-84 11:15:06 by MCCOLLUM
;TCO 6.2230 - Change text for shared page made private in DEPOSIT command.
; UPD ID= 445, SNARK:<6.EXEC>EXEC0.MAC.43, 26-Sep-84 16:46:07 by MCCOLLUM
;TCO 6.2229 - Clear private name in fork data block in DEPOSIT code
; UPD ID= 438, SNARK:<6.EXEC>EXEC0.MAC.42, 25-Sep-84 10:51:16 by EVANS
;TCO 6.2222 - Add support for VT200 terminals; also VT131.
; UPD ID= 425, SNARK:<6.EXEC>EXEC0.MAC.41, 19-Jul-84 16:03:26 by PRATT
;TCO 6.2136 - Allow both new and the old flavors of TERMINAL guide words
; UPD ID= 411, SNARK:<6.EXEC>EXEC0.MAC.40, 12-Jun-84 12:00:29 by MCCOLLUM
;TCO 6.2093 - Fix "TERM NO PAUSE CHAR" command to set defaults.
; UPD ID= 408, SNARK:<6.EXEC>EXEC0.MAC.39, 3-May-84 10:19:22 by SHTIL
; UPD ID= 379, SNARK:<6.EXEC>EXEC0.MAC.38, 20-Jan-84 16:00:27 by MCCOLLUM
;TCO 6.1945 - Range check ASCII code in "TERMINAL PAUSE (ON) CHARACTER"
; UPD ID= 373, SNARK:<6.EXEC>EXEC0.MAC.36, 9-Jan-84 20:30:16 by MCCOLLUM
;TCO 6.1928 - Confirm after "TERMINAL PAUSE CHARACTER n 0"
; UPD ID= 366, SNARK:<6.EXEC>EXEC0.MAC.35, 28-Dec-83 15:56:38 by PRATT
;TCO 6.1796 - Add [SET] TERMINAL [NO] INHIBIT (NON-JOB OUTPUT)
; UPD ID= 333, SNARK:<6.EXEC>EXEC0.MAC.34, 20-Nov-83 19:38:11 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 321, SNARK:<6.EXEC>EXEC0.MAC.33, 8-Nov-83 15:04:02 by PRATT
;TCO 6.1852 - Make TERMINAL HELP command typeout HLP:TERMINAL.HLP
; UPD ID= 317, SNARK:<6.EXEC>EXEC0.MAC.32, 8-Nov-83 13:47:17 by PRATT
;TCO 6.1847 - New /FAST switch to LOGIN
; UPD ID= 315, SNARK:<6.EXEC>EXEC0.MAC.31, 17-Oct-83 13:41:50 by PRATT
;TCO 6.1831 - Change the bizarre byte pointers in EXEC02
; UPD ID= 310, SNARK:<6.EXEC>EXEC0.MAC.30, 22-Sep-83 12:16:33 by MILLER
;TCO 6.1758. Make system mail work
; UPD ID= 288, SNARK:<6.EXEC>EXEC0.MAC.29, 14-Jun-83 11:57:01 by LOMARTIRE
;TCO 6.1676 - Allow range of terminal lines in ^ESET TERMINAL command
; UPD ID= 272, SNARK:<6.EXEC>EXEC0.MAC.28, 20-Apr-83 15:33:55 by PAETZOLD
;TCP 6.1619 - Add H10
; UPD ID= 234, SNARK:<6.EXEC>EXEC0.MAC.27, 4-Apr-83 10:10:30 by CHALL
;TCO 6.1456 - Set up AC C for $GET0 and $GET2
; UPD ID= 233, SNARK:<6.EXEC>EXEC0.MAC.26, 15-Jan-83 19:23:30 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 202, SNARK:<6.EXEC>EXEC0.MAC.25, 3-Dec-82 15:40:37 by CHALL
;TCO 6.1399 CIN9- USE A DIFFERENT KEYWORD TABLE WHEN NOT LOGGED IN
;TCO 6.1397 .TERMI- CHANGE NOISE TO "TERMINAL (FEATURE OR TYPE)"
;ALSO, SEPARATE KEYWORDS INTO TWO TABLES: TYPES AND FEATURES
; UPD ID= 160, SNARK:<6.EXEC>EXEC0.MAC.24, 21-Sep-82 15:50:43 by TSANG
;TCO 6.1248 MODIFY HELP TEXT STRING IN TERMINAL COMMAND
;TCO 6.1253 FIX THE USED CLASS (.SAUSE) PROBLEM
; UPD ID= 151, SNARK:<6.EXEC>EXEC0.MAC.23, 19-Aug-82 14:23:51 by MOSER
;MORE OF TCO 5.1306 LOAD FLAGS BEFORE TEST
; UPD ID= 132, SNARK:<6.EXEC>EXEC0.MAC.21, 4-Aug-82 17:09:50 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 122, SNARK:<6.EXEC>EXEC0.MAC.20, 24-Apr-82 12:24:51 by CHALL
;TCO 6.1101 MOVE STUFF WITH TERMINAL NAMES (.TERMI, .TTYPE) TO EXECCA
; UPD ID= 113, SNARK:<6.EXEC>EXEC0.MAC.19, 20-Apr-82 07:52:59 by CHALL
;TCO 6.1092 EXEC01- Remove MIC conditional
; UPD ID= 110, SNARK:<6.EXEC>EXEC0.MAC.18, 9-Apr-82 09:41:54 by CHALL
;TCO 6.1088 .TERMI- AND .TTYPE- ADD TERMINAL TYPE VT102
; UPD ID= 138, SNARK:<5.EXEC>EXEC0.MAC.42, 7-Feb-82 13:41:31 by CHALL
;TCO 5.1700 .TERMI- AND .TTYPE- ADD TERMINAL TYPES VT125 AND VK100
; UPD ID= 133, SNARK:<5.EXEC>EXEC0.MAC.41, 22-Jan-82 14:44:35 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 129, SNARK:<5.EXEC>EXEC0.MAC.40, 5-Jan-82 10:00:30 by MOSER
; UPD ID= 108, SNARK:<5.EXEC>EXEC0.MAC.27, 30-Nov-81 13:59:11 by MOSER
;TCO 5.1613 - ADD NEW BIT B4 TO CRJOB FLAGS. MEANS SIMULATE LOGIN.
; UPD ID= 97, SNARK:<5.EXEC>EXEC0.MAC.26, 21-Oct-81 13:43:45 by GROUT
;TCO 5.1578 MAKE CMDINI GLOBAL SO IT CAN BE CALLED FROM EOFJER
; UPD ID= 71, SNARK:<5.EXEC>EXEC0.MAC.23, 21-Sep-81 09:06:15 by CHALL
;TCO 5.1521 SUBSTA- OUTPUT SCOUNTS IN INFO SUBSYS (SEE TCO 5.1301)
; UPD ID= 60, SNARK:<5.EXEC>EXEC0.MAC.21, 1-Sep-81 18:01:29 by CHALL
;TCO 5.1483 SYSNX- IF USER TYPED "SYS:" GIVE FILESPEC-LIKE ERROR
; UPD ID= 43, SNARK:<5.EXEC>EXEC0.MAC.19, 17-Aug-81 22:48:14 by MURPHY
;MAKE MESS NOT FLUSH CURRENT FORK
; UPD ID= 31, SNARK:<5.EXEC>EXEC0.MAC.18, 14-Aug-81 19:11:43 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 22, SNARK:<5.EXEC>EXEC0.MAC.17, 5-Aug-81 16:00:09 by MURPHY
;BUG IN MESS - LEAVING GARBAGE FORK HANDLE IN FORK.
; UPD ID= 18, SNARK:<5.EXEC>EXEC0.MAC.16, 21-Jul-81 11:53:08 by GROUT
;TCO 5.1426 - Make SYSTAT work with wild directory and user args
;<HELLIWELL.EXEC.5>EXEC0.MAC.2, 13-May-81 19:58:17, EDIT BY HELLIWELL
;REMOVE DOCCL AND DOCC1 (NOW UNUSED)
;<HELLIWELL.EXEC.5>EXEC0.MAC.1, 13-May-81 14:51:16, EDIT BY HELLIWELL
;REMOVE GT40 TERMINAL TYPE
; UPD ID= 2099, SNARK:<5.EXEC>EXEC0.MAC.12, 28-May-81 10:58:35 by GROUT
; TCO 5.1351 - Make TERMINAL terminal-type not change duplex mode
; UPD ID= 2063, SNARK:<5.EXEC>EXEC0.MAC.11, 22-May-81 11:51:03 by GROUT
;TCO 5.1343 - Make IPCF code flush buffers only when necessary
; UPD ID= 2035, SNARK:<5.EXEC>EXEC0.MAC.10, 19-May-81 16:55:38 by MURPHY
;Raise input on TER PAUSE CHARACTER CONTROL x
; UPD ID= 1974, SNARK:<5.EXEC>EXEC0.MAC.9, 11-May-81 11:35:56 by TILLSON
;TCO 5.1306 - Make LOGIN messages print in Batch log file
; UPD ID= 1962, SNARK:<5.EXEC>EXEC0.MAC.8, 8-May-81 10:03:01 by SCHMITT
;TCO 5.1309 - Check for DWNTIM of -1 for system shutdown at SYSDWN
; UPD ID= 1949, SNARK:<5.EXEC>EXEC0.MAC.4, 6-May-81 14:53:33 by MURPHY
; TCO 5.1315 - PAUSE (ON) CHARACTER etc.
; UPD ID= 1871, SNARK:<5.EXEC>EXEC0.MAC.3, 22-Apr-81 11:29:57 by PAETZOLD
;fix typo in previous (TCO 5.1295)
; UPD ID= 1868, SNARK:<5.EXEC>EXEC0.MAC.2, 22-Apr-81 10:49:55 by PAETZOLD
;TCO 5.1295 Add cosmetic fix for systat for foreign arpanet host
;previous edit history line missing
;ADD PCLF SWITCHES WHERE VISIBLE TO USER
;REMOVE MFRK SWITCHES EXCEPT WHERE VISIBLE TO USER
;<4.EXEC>EXEC0.MAC.1, 23-Dec-80 19:03:03, Edit by DK32
;Programmable Command Language
; UPD ID= 1434, SNARK:<5.EXEC>EXEC0.MAC.41, 13-Jan-81 09:58:33 by OSMAN
;More 5.1129 - Make EXAMINE show octal contents "...too, if different"
; UPD ID= 1397, SNARK:<5.EXEC>EXEC0.MAC.40, 6-Jan-81 10:27:42 by OSMAN
;tco 5.1225 - Implement jsys trapping and file-opening trapping!
; UPD ID= 1394, SNARK:<5.EXEC>EXEC0.MAC.39, 31-Dec-80 16:08:32 by LYONS
; UPD ID= 1392, SNARK:<5.EXEC>EXEC0.MAC.38, 31-Dec-80 15:09:40 by LYONS
;for the time being, keep both sets of system mail code.
; UPD ID= 1355, SNARK:<5.EXEC>EXEC0.MAC.37, 16-Dec-80 09:51:38 by OSMAN
;Don't get second symbol buffer upon restarting customized exec
; UPD ID= 1280, SNARK:<5.EXEC>EXEC0.MAC.36, 17-Nov-80 16:40:55 by OSMAN
;Remove ^L hack
; UPD ID= 1252, SNARK:<5.EXEC>EXEC0.MAC.35, 10-Nov-80 13:24:26 by OSMAN
;More 5.1189 - Make DDT see /USE-SECTION switch
; UPD ID= 1237, SNARK:<5.EXEC>EXEC0.MAC.34, 6-Nov-80 15:20:32 by OSMAN
;tco 5.1189 - Use $GET0 instead of $GET2
; UPD ID= 1233, SNARK:<5.EXEC>EXEC0.MAC.33, 5-Nov-80 15:31:57 by LCAMPBELL
; UPD ID= 1188, SNARK:<5.EXEC>EXEC0.MAC.31, 23-Oct-80 10:09:49 by OSMAN
; UPD ID= 1187, SNARK:<5.EXEC>EXEC0.MAC.30, 22-Oct-80 17:01:15 by OSMAN
;Fix SET PROG EPHEMERAL
; UPD ID= 1146, SNARK:<5.EXEC>EXEC0.MAC.29, 10-Oct-80 09:31:07 by OSMAN
;More 5.1151 - Unbreak "DEC SYN CD CONNECT"
; UPD ID= 1145, SNARK:<5.EXEC>EXEC0.MAC.28, 10-Oct-80 09:25:26 by OSMAN
; UPD ID= 1127, SNARK:<5.EXEC>EXEC0.MAC.27, 6-Oct-80 10:16:23 by OSMAN
;tco 5.1167 - Remove FDB autokeep feature
; UPD ID= 1114, SNARK:<5.EXEC>EXEC0.MAC.26, 3-Oct-80 11:32:25 by OSMAN
;tco 5.1162 - Parse program names as keywords.
; UPD ID= 1040, SNARK:<5.EXEC>EXEC0.MAC.25, 25-Sep-80 14:12:54 by OSMAN
;tco 5.1156 - Add SET DEFAULT PROGRAM
; UPD ID= 1034, SNARK:<5.EXEC>EXEC0.MAC.24, 23-Sep-80 14:03:54 by OSMAN
;tco 5.1151 - prevent spurious error from "INFO MON"
; UPD ID= 1025, SNARK:<5.EXEC>EXEC0.MAC.23, 22-Sep-80 10:37:46 by OSMAN
;tco 5.1150 - Add SET PROGRAM
; UPD ID= 1016, SNARK:<5.EXEC>EXEC0.MAC.22, 16-Sep-80 10:14:20 by HESS
; New version of MIC
; UPD ID= 918, SNARK:<5.EXEC>EXEC0.MAC.21, 19-Aug-80 14:28:14 by HESS
; Fix Examine/Deposit commands for multi-forking
; UPD ID= 871, SNARK:<5.EXEC>EXEC0.MAC.20, 11-Aug-80 11:21:43 by OSMAN
;5.1129 - Allow "@FOO" as contents for DEPOSIT
; UPD ID= 865, SNARK:<5.EXEC>EXEC0.MAC.19, 11-Aug-80 10:59:05 by OSMAN
;More 5.1129 - Allow symbolic deposit into empty fork
; UPD ID= 863, SNARK:<5.EXEC>EXEC0.MAC.18, 10-Aug-80 16:41:16 by OSMAN
;More 5.1129 - Fix EXAMINE and DEPOSIT
; UPD ID= 852, SNARK:<5.EXEC>EXEC0.MAC.17, 10-Aug-80 15:20:04 by OSMAN
;tco 5.1129 - Add symbolic expression and address support
; UPD ID= 837, SNARK:<5.EXEC>EXEC0.MAC.16, 5-Aug-80 10:27:28 by OSMAN
;tco 5.1124 - Do LOGIN.CMD before COMAND.CMD
; UPD ID= 836, SNARK:<5.EXEC>EXEC0.MAC.15, 5-Aug-80 10:07:21 by OSMAN
;Remove SY abbreviation
; UPD ID= 829, SNARK:<5.EXEC>EXEC0.MAC.14, 4-Aug-80 12:36:58 by LYONS
; Change ^V echo to fix listings alignment
; Fix herald suppression code
; UPD ID= 825, SNARK:<5.EXEC>EXEC0.MAC.13, 4-Aug-80 09:48:52 by OSMAN
;Move version stuff into EXECIN
; UPD ID= 805, SNARK:<5.EXEC>EXEC0.MAC.12, 28-Jul-80 14:54:35 by MURPHY
;Remove effect of .FBKEP
; UPD ID= 787, SNARK:<5.EXEC>EXEC0.MAC.11, 23-Jul-80 15:25:57 by OSMAN
;tco 5.1111 - Don't croak SYSTAT if SKED% keels over due to job logging out
; UPD ID= 770, SNARK:<5.EXEC>EXEC0.MAC.10, 21-Jul-80 13:58:49 by MURPHY
;FORCE SY AS ABBREV FOR SYSTAT
; UPD ID= 586, SNARK:<5.EXEC>EXEC0.MAC.9, 2-Jun-80 14:35:06 by MURPHY
;<5.EXEC>EXEC0.MAC.8, 30-May-80 16:42:15, EDIT BY MURPHY
;PUT ALERT AND MAIL-WATCH UNDER NEWF
; UPD ID= 565, SNARK:<5.EXEC>EXEC0.MAC.7, 28-May-80 16:54:41 by MURPHY
; UPD ID= 551, SNARK:<5.EXEC>EXEC0.MAC.6, 23-May-80 13:36:11 by MURPHY
;MAKE EDIT/CREATE USE IMPLICIT RUN COMMAND LOGIC
; UPD ID= 543, SNARK:<5.EXEC>EXEC0.MAC.5, 21-May-80 12:06:57 by MURPHY
;ADD MFRK TO CONTROL MULTI-FORK FEATURES ONLY
;ADD NEWF TO CONTROL "NEW" FEATURES PENDING REVIEW
;Change handling of fork name as command
;<5.EXEC>EXEC0.MAC.4, 8-May-80 14:01:08, EDIT BY OSMAN
;Remove R.L.5 and R.GE.5 macro calls
;<4.1.EXEC>EXEC0.MAC.27, 29-Apr-80 13:30:31, EDIT BY OSMAN
;Make "Up again at" have space before it
; UPD ID= 457, SNARK:<4.1.EXEC>EXEC0.MAC.25, 22-Apr-80 16:42:13 by OSMAN
;tco 4.1.1146 - Make CTRL/Q during advice work.
;<4.1.EXEC>EXEC0.MAC.24, 28-Mar-80 09:52:19, Edit by HESS
; New version of MIC support
;<4.1.EXEC>EXEC0.MAC.23, 17-Mar-80 14:10:16, EDIT BY OSMAN
;Get rid of ONEWRD checks
;<4.1.EXEC>EXEC0.MAC.22, 17-Mar-80 10:53:23, EDIT BY OSMAN
;PUT R.L.5 CONDITIONAL AROUND SMOUNT, SDISMOUNT, TMOUNT
;<4.1.EXEC>EXEC0.MAC.21, 13-Mar-80 10:50:22, EDIT BY OSMAN
;tco 4.1.1108 - Print n.m instead of nx in version numbers
;Put SMOUNT and SDISMOUNT back in for release 4.1
;<4.1.EXEC>EXEC0.MAC.19, 7-Mar-80 17:00:41, EDIT BY OSMAN
;tco 4.1.1101 - lowercase error message "Illegal character in program name..."
;<4.1.EXEC>EXEC0.MAC.11, 29-Feb-80 09:31:36, EDIT BY OSMAN
;tco 4.1.1095 - allow "SYS NO ."
; UPD ID= 261, SNARK:<4.1.EXEC>EXEC0.MAC.8, 14-Feb-80 08:52:57 by OSMAN
;tco 4.1.1079 - Flush SMOUNT, SDISMOUNT, TMOUNT
; UPD ID= 258, SNARK:<4.1.EXEC>EXEC0.MAC.7, 12-Feb-80 10:10:48 by OSMAN
;Remove QCM (old QUENCH startup stuff)
; UPD ID= 236, SNARK:<4.1.EXEC>EXEC0.MAC.6, 1-Feb-80 08:51:12 by OSMAN
;tco 4.1.1076 - Wait for confirmation on FOREIGN-HOST subcommand
; UPD ID= 195, SNARK:<4.1.EXEC>EXEC0.MAC.5, 8-Jan-80 14:31:09 by OSMAN
; UPD ID= 192, SNARK:<4.1.EXEC>EXEC0.MAC.4, 8-Jan-80 14:25:26 by OSMAN
;tco 4.1.1061 - Use generation 1 on system mail
;<4.1.EXEC>EXEC0.MAC.2, 20-Nov-79 10:46:37, EDIT BY OSMAN
;TCO 4.1.1023 - FIX TAKE STUFF
; 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
UTITLE EXEC0
EXTERN INFLEN ;[7.1076]
;THIS FILE CONTAINS
; START AND REENTER INITIALIZATION
; MAIN LOOP TO READ FIRST WORD OF COMMAND AND DISPATCH
; COMMAND TABLES AND OTHER MISC TABLES
; STATUS AND TERMINAL CHARACTERISTICS COMMANDS
;TOPS10 JOB DATA AREA
JOBSA==:120
JOBSYM==:116
JOBDDT==:74
;TOPS20 ENTRY VECTOR
; NOTE: "EXEC" IS ASSUMED TO BE FIRST SYMBOL IN EXEC.REL, AND AT A
; PAGE BOUNDARY, BY PAGE BOUNDARY CHECK IN "ALOFRK" AT END OF THIS FILE.
EXEC:: JRST REENTE ;START ENTRY
JRST REENTE ;REENTER ENTRY
%%LVER,,%%RVER ;VERSION NUMBER
;PUT THE COPYRIGHT STATEMENT HERE IN THE REL FILE
CPYRYT
;POINTER TO SYMBOL TABLE
;SAVED HERE FROM JOBSYM WHEN THAT PAGE REMOVED FOR SHARABLE SUBSYSTEM
.JOBSYM::0
.NPAGS::0 ;SIZE OF EXEC IN PAGES
EVLEN==:3 ;ENTRY VECTOR LENGTH (STARTING AT "EXEC")
;PATCH AREA
;ALSO THERE'S A WRITEABLE PATCH AREA (PPAT) IN EXECPR.MAC.
PATS::
PAT:: BLOCK 200
;SUBROUTINE TO "AUTOLOGOUT" THIS JOB IF NOT LOGGED IN AND MORE
; THAN "AUTOL1" SECONDS HAVE ELAPSED SINCE STARTUP.
;ONE CALL IN CMDIN4 AREA.
ALOTST: PUSH P,A
GTAD
SUB A,STRTIM
SUB A,[AUTOL1]
JUMPG A,AUTOLO ;DO AUTOLOGOUT (EXECSU.MAC)
POP P,A
RET
CHNMSK: CHNS ;MASK FOR ACTIVE CHANNELS
;ROUTINE TO CLEAR CRJOB/PRARG START UP BLOCK
CLPRA: SETZM CRPRA
MOVE A,[XWD CRPRA,CRPRA+1]
BLT A,CRPRA+17
RET
;"EXEC" AND ITS VERSION
EXECV:: TYPE < TOPS-20 Command processor >
MOVE Q1,EXEC+2 ;GET VERSION #
CALLRET VERPNT ;PRINT IT
;ROUTINE TO INITIALIZE COMND JSYS. ITEMS INITIALIZED IN THIS ROUTINE
;ARE ONES NOT NECESSARY TO REINITIALIZE FOR EACH COMMAND.
CMDINI::MOVEI A,REPARS ;SET UP REPARSE HANDLER ADDRESS
MOVEM A,CMFLG
HRROI A,CBUF ;POINTER TO COMMAND BUFFER
MOVEM A,CMBFP
MOVEM A,CMPTR ;NO "NEXT FIELD" YET
MOVEI B,CBUFL*5 ;ANNOUNCE HOW MUCH ROOM FOR TYPEIN THERE IS
MOVEM B,CMCNT
SETZM CMINC ;NO UNPARSED CHARACTERS YET
HRROI A,ATMBUF ;POINTER TO ATOM BUFFER
MOVEM A,CMABP
MOVEI A,ATMLEN*5 ;LENGTH OF ATOM BUFFER
MOVEM A,CMABC
MOVEI A,CJFNBK ;ADDRESS OF GTJFN BLOCK
MOVEM A,CMGJB
RET
;REENTER ENTRY
REENTE::
REE:: SKIPN CINITF ;IS EXEC INITIALIZED?
JRST EXEC0 ;NO, "REENTER" GIVEN BEFORE "START",
;FULL INITIALIZATION REQUIRED.
SKIPE CUSTMF ;PCL Is this just a customized Exec?
JRST EXEC0 ;PCL It is, do full initialization
;THE FOLLOWING CODE IS EXECUTED ON "REENTER" ONLY.
;RE-INITIALIZE PSI SYSTEM
; (^C OUT OF EXEC DDT TO SUPERIOR EXEC LEAVES IT WRONG).
CALL ICLEAR ;CLEAR INTERRUPT WE MAY HAVE RESTARTED OUT OF, DONE HERE TO AVOID TWO FOR EVERY ^C!
MOVEI A,.FHSLF
MOVE B,CHNMSK ;GET ACTIVE CHANNEL MASK
AIC ;ACTIVATE CHANNELS SPECIFIED BY MASK
EIR ;ENABLE PROCESS PSEUDOINTERRUPT SYSTEM
CALL CPULIM ;GET AND SET CPU TIME LIMIT
TXO Z,NECHOF ;PRETEND ECHOING OFF
CALL DOECHO ;FORCE ECHOING (IN CASE WARM START AFTER INTERRUPT OUT OF A NOECHO PLACE!)
CALL DOATI ;TERMINAL INTERRUPTS (ON ^EQ, MINI-EXEC CLEARS THEM)
MOVEI Q1,ETTYMD
CALL LTTYMD ;INIT TTY STATE IN CASE INTERRUPTED OUT OF COMND
JRST CMDIN2 ;JOIN STARTUP CASE
;INSTRUCTION TO INITIALIZE STACK
INISTK::MOVE P,[IOWD PDL,PD]
;FIRST STARTUP INITIALIZATION
EXEC0:: XCT INISTK ;INITIALIZE THE STACK
MOVEI A,.FHSLF
RPCAP ;GET CURRENT CAPABILITIES
HLLZ C,C ;PREVENT "ATTACH" WITHOUT PASSWORD
EPCAP ;(MONITOR MAKES VIRGIN JOB BE WHEEL!)
SETZM CSZ1
MOVE A,[XWD CSZ1,CSZ1+1]
BLT A,CSZ4
GETNM ;GET PROGRAM NAME
MOVEM A,SAVNAM ;REMEMBER NAME
CALL GETMOD ;SEE WHETHER WE'RE COMING FROM EXEC OR USER MODE
MOVEM A,SAVT20 ;REMEMBER FOR WHEN WE POP
;SET UP 41 FOR UUO'S, P=17 FOR PUSHDOWN POINTER
MOVE A,[CALL CUUO]
MOVEM A,41
MOVE A,[IOWD JBUFL,JBUF] ;INIT PTR INTO JFN BUFFER
MOVEM A,JBUFP ;..
SETOM 1(A) ;INIT JFN BUFFER TO -1'S: 0 IS A JFN.
AOBJN A,.-1 ;..
SKIPN XDICT ;PCL Does permanent pool need initialized?
CALL XFRINI ;INITIALIZE PERMANENT FREE SPACE
SETOM CEPSIC ;NO DEFAULT INTERRUPT CHAR FOR COMMAND EDITOR
MOVEI A,NFRKS ;INITIALIZE FORK NAME TABLE
MOVEM A,FRKNMS ;SAY MAXIMUM NAMES ALLOWED IN TABLE
MOVEM A,KEPNMS ;INITIALIZE KEPT FORKS TABLE TOO
CALL GETFB1 ;GET FORK BLOCK FOR DEFAULTS
MOVEM A,FRKDEF ;REMEMBER ADDRESS OF DEFAULT BLOCK
SKIPE SYMBF ;DO WE ALREADY HAVE SYMBOL BUFFER (IS THIS A CUSTOMIZED EXEC)
JRST SYMDON ;YES
MOVEI A,777+NSMPGS_9 ;GET WINDOW FOR SYMBOL TABLE MAPPING
CALL GTBUFX
TRZE A,777 ;WE NEED PAGE-ALIGNED ADDRESS FOR PMAP
ADDI A,1000 ;IF BLOCK STARTED ON PARTIAL PAGE, GET TO FULL ONE
MOVEM A,SYMBF ;REMEMBER WHERE BUFFER STARTS
SYMDON: SETZ Z, ;CLEAR FLAGS
CALL CLPRA ;CLEAR CRJOB/PRARG AREA
MOVE A,[.PRARD,,.FHSLF] ;READ OUR BLK IF THERE
MOVEI B,CRPRA
MOVEI C,20 ;LENGTH OF OUR BLK
PRARG
JUMPE C,EXEC01 ;NOTHING WAITING FOR US
MOVE A,CRPRA+.CJPHD ;PICK UP ID THAT IDENTIFIES CRJOB-PRARG
CAME A,[1B0+3B6+2B12+CR%PRA] ;PRARG FROM CRJOB?
JRST [ CALL CLPRA ;NO, WHO KNOWS WHAT, DITCH IT
JRST EXEC01]
SETO A, ;THIS JOB
HRROI B,CJPTIM ;1 WORD INTO OUR FLAG WORD
MOVEI C,.JIRTL ;GET JOB RUNTIME LIMIT (IF SET)
GETJI
SETZM CJPTIM ;FAILED, FLAG AS NONE PRESENT
HRRZ A,CRPRA+.CJPLP ;GET PTR TO FLAGS
MOVE B,CRPRA(A) ;PICK UP FLAGS
TLNN B,(1B1+1B2) ;A FORK HANDLE GIVEN TO US?
JRST EXEC01 ;NO, CONTINUE
HRRZ A,CRPRA+.CJPKP ;GET PTR TO FORK,,SFRKV OFFSET
MOVE B,CRPRA(A)
HLRZM B,FORK ;SET IT AS CURRENT LOWER FORK
JRST EXEC02
EXEC01: SETOM FORK ;SAY NO INFERIOR FORK
SETOM RUNFK ;NO RUNNING FORK
SETOM EDFORK ;NO EDITOR FORK
SETOM IDFORK ;NO IDDT FORK
SETOM EFORK ;NO EPHERMERAL FORK
SETOM MICFRK ;NO MIC FORK
MOVEI A, CESAVE+2 ;INITIALIZE THE COMMAND EDITOR
MOVEM A, CESAVE ;
MOVEM A, CEFFL ;INITIALIZE FREE SPACE POINTER
MOVEI A, CESAVE ;INITIALIZE POINTER INTO TABLE
MOVEM A, CE1ST ;
MOVEM A, CELAST ;
MOVEI A, 1 ;INITIALIZE THE COMMAND COUNT
MOVEM A, CECNT ;
EXEC02: SETOM NPAGE ;SAY NO PAGE OF INFERIOR IS MAPPED
SETOM OLDIDX ;SAY NO IPCF MESSAGE WAITING YET
MOVEI A,NEXTS ;INITIALIZE EXTENSION TABLE
MOVEM A,DEXTBL
;INITIALIZE PROCESS PSI SYSTEM,
; DONE EARLY SO ERRORS IN REST OF INITIALIZATION WILL BE HANDLED.
;ENABLE ALL ERROR CHANNELS BUT OVERFLOW,
; ALSO CHANNEL 1 FOR ASSIGNMENT TO ^C BELOW,
; AND 2 FOR AUTOLOGOUT.
MOVEI A,.FHSLF ;SAY THIS FORK
MOVE B,[XWD LEVTAB,CHNTAB]
SIR ;SET UP TABLE ADDRESSES
MOVE B,CHNMSK ;GET ACTIVE CHANNEL MASK
AIC ;ACTIVATE SPECIFIED CHANNELS
EIR ;ENABLE PROCESS PSI SYSTEM
CALL CPULIM ;GET AND SET CPU TIME LIMIT
CALL CMDINI ;INITALIZE ALL COMND PARAMETERS
SETZM TAKLEN ;NO JFNS ON STACK YET
DMOVE A,[XWD .PRIIN,.PRIOU ;USE PRIMARY IO
TKALEF] ;ALLOW ERRORS AT THIS LEVEL, NO ECHOING OF COMMAND
CALL PUSHIO ;START INITIAL STREAM
CALL STSYST ;INIT GETAB NUMBERS
;INITIALIZE TELETYPE MODE, TABS, CONTROL CHARACTER OUTPUT (CCOC).
;INITIALIZE MODES FOR USE IN RUNNING PROGRAM FROM PRESENT MODES.
MOVEI Q1,ITTYMD ;INITIAL MODES FOR "START"
CALL RTTYMD ;THIS SUBR SAVES MODE WORD, TABS, CCOC.
MOVE A,[SIXBIT /(PRIV)/]
MOVEM A,ITTYMD+TTWSNM ;SUBSYSTEM NAME UNLESS OTHERWISE SPEC
;INITIALIZE MODES FOR USE WHEN EXEC IS RUNNING:
;ASSUME IT'S ALREADY CORRECT WITH REGARD TO HARDWARE FEATURES;
MOVEI Q1,ETTYMD ;KEEP EXEC MODES UP TO DATE IN STORAGE
CALL RTTYMD ;...FOR ^C.
MOVEI A,0 ;DON'T TYPE ^V IN ANY FORM
DPB A,[POINT 2,ETTYMD+TTWCOC+1,9]
;MAKE CONTROL-V ECHO LITERALLY AS IN FILENAMES
MOVEI A,3 ;FORMAT LINEFEED (MAKE IT ECHO AS CRLF)
DPB A,[POINT 2,ETTYMD+TTWCOC,21]
;DISABLE COMPAT FOR EXEC
MOVEI A,.FHSLF ;FOR SELF
MOVNI B,1 ;SET TO -1
MOVEI C,0 ;...
SCVEC ;BYE
;DETERMINE HERE IF BATCH MODE
SETZM BATCHF ;ASSUME NOT BATCH JOB
MOVNI A,1
MOVE B,[-1,,A]
MOVEI C,.JIBAT ;GET BATCH FLAG
GETJI
CALL JERR
JUMPE A,NOBTCH ;0 := NOT BATCH
SETOM BATCHF ;SET BATCH FLAG
SETOM CCFLAG ;NO CTRL-C CAPABILITY
NOBTCH:
;FIND OUT IF THIS JOB IS LOGGED IN. (MIGHT BE AT STARTUP IF SUBSIDIARY.
; OR A SUBSYSTEM COULD LOG JOB IN.)
GJINF ;USER # IN A, 0 IF NOT LOGGED
MOVEM A,CUSRNO ;SAVE USER # OR 0
MOVEM A,LIDNO ;SAVE AS LOGGED-IN DIR NUMBER IN CASE OLD MONITOR AND GETJI FAILS
MOVEM C,JOBNO ;REMEMBER JOB NUMBER
MOVE A,C ;GET THE JOB NUMBER
HRROI B,LIDNO ;READ LOGGED-IN DIRECTORY NUMBER INTO LIDNO
MOVEI C,.JILNO ;ASK FOR ONLY THIS ONE.
GETJI ;DO IT.
JFCL ;IGNORE FAILURE, SEE LIDNO REF. ABOVE.
MOVEI A,.FHJOB
RTIW ;UPDATED JOB TIW FOR EXEC
MOVEM B,ETTYMD+TTWJTI
MOVEM B,ITTYMD+TTWJTI ;INITIALLY, SAME FOR PGM
MOVEI Q1,ETTYMD ;INITIALIZE TTY, SO ^V DOESN'T APPEAR IN FILENAMES
CALL LTTYMD
;SAY INITIALIZATION HAS COMPLETED SUCCESSFULLY.
;UNTIL CINITF<>0, ERROR ROUTINES HALT RATHER THAN TYPE MESSAGES.
; AND "REENTER" DOES A "START".
SETOM CINITF
CALL DOATI ;ASSIGN TERMINAL INTERRUPTS (DON'T ALLOW ^C EARLIER !)
SKIPN CRPRA ;CRJOB SET UP?
JRST CMDIN0 ;NO
HRRZ A,CRPRA+.CJPLP ;FETCH FLAG POINTER
SKIPGE B,CRPRA(A) ;HERALD SUPPRESS?
JRST CMDIN2 ;YES
TLNN B,(1B4) ;SIMULATE LOGIN?
JRST CMDIN0 ;NO SO GO ON.
ETYPE <%_> ;PRINT A LINE.
CALL %VERSI ;VERSION AND STUFF
CALL DWNPNT ;DOWN TIME
JRST CMDIN2 ;AND CONTINUE
CMDIN0: SKIPE BATCHF ;BATCH JOB?
JRST CMDIN1 ;GO PRINT HERALD
SETO A, ;SUPPRESS HERALD FOR SYSJOB
HRROI B,C
MOVEI C,.JICPJ
GETJI ;FETCH CONTROLLING JOB NUMBER
CALL JERR
JUMPE C,CMDIN2 ;SYSJOB, SO SKIP IT
CMDIN1: ETYPE <%_> ;HERALD
CALL $VERSI ;VERSIONS
CALL DWNTYP ;IF THERE IS A DOWN TIME
;COMMANDS THAT RUN PROGRAM RETURN HERE WHEN IT STOPS.
;START, CONT, REENTER, RUN, <SUBSYSTEM NAME>, GOTO.
;RE-ENTRY JOINS MAIN FLOW HERE
CMDIN2::CALL SETT20 ;SAY TOPS20 COMMAND LEVEL (PLACED HERE TO MINIMIZE JSYS'S PER COMMAND)
JRST CMDIN3
$VERSI: GJINF
JUMPN A,EXECV ;EXEC VERSION ONLY IF LOGGED IN
HRROI B,[ASCIZ/SYSTEM:JOB-STARTUP-MESSAGE.TXT/] ;[7.1007]
MOVX A,GJ%OLD+GJ%SHT ;[7.1007] OLD FILE ONLY, SHORT FORM
CALL GTJFS ;[7.1007] (A,B/) GET HANDLE ON HELP FILE
JRST %VERSI ;[7.1007] IGNORE THE ERROR
MOVEI Q1,CP%HEL ;[7.1007] ACT LIKE THE HELP COMMAND
MOVE A,JBUFP ;[7.1007] GET POINTER TO JFN CELL
HRRZM A,INIFH1 ;[7.1007]
HRRZM A,INIFH2 ;[7.1007] COPY CODE NEEDS THIS
SETOM HELPSN ;[7.1007] FLAG TO "TYPE CODE" SAYING NO MORE TO DO
CALL TYPE1 ;[7.1007] (/) COPY THE FILE TO TTY
%VERSI::PRINT " "
HLLZ D,SYSVER ;XWD LENGTH, INDEX
%VERS1: GTB .SYSVE ;GET A DATA WORD FROM TABLE (USES D)
MOVE B,A
MOVEI C,5 ;PRINT 5 CHARS FROM EACH WORD
%VERS2: SETZ A,
LSHC A,7
JUMPE A,%VERS3 ;END ON NULL
PRINT (A)
SOJG C,%VERS2
AOBJN D,%VERS1 ;ALSO END ON END OF TABLE
%VERS3: ETYPE<%_>
RET
;FIXON IS CALLED AFTER ADVISE IS ENDED TO RESTORE TERMINAL PAGING.
FIXON:: MOVEI A,.CTTRM ;REFERENCE CONTROLLING TERMINAL
RFMOD ;GET CURRENT SETTINGS
TXZ B,TT%PGM ;START WITH CLEAN PAGE MODE BIT
IOR B,SAVPGM ;GET SAVED VALUE OF PAGE MODE BIT
STPAR ;RESTORE VALUE OF PAGING BIT
RET
;ROUTINE TO ENABLE TERMINAL INTERRUPTS
DOATI:: MOVEI A,.FHSLF
RPCAP ;SEE IF WE'RE ALLOWED TO ENABLE ^C
TXNN B,SC%CTC ;TEST SPEC CAP BIT 0
JRST DOAT0 ;NOT ALLOWED TO ENABLE ^C
TXO C,SC%CTC
EPCAP ;ENABLE FOR ^C CAPABILITY
MOVE A,[XWD CTRLC,1]
ATI
MOVEI A,.FHJOB ;SET TERMINAL MASK FOR JOB
MOVE B,ETTYMD+TTWJTI ;GET CORRECT MASK
STIW ;SET UP CORRECT MASK
MOVX A,ST%DIM!.FHSLF ;OURSELF, GET DEFERREDS IN AC3
RTIW ;GET DEFERRED MASK
TXO C,1B<CTRLC>
STIW ;MAKE SO PROGRAM BUFFERED INPUT GETS READ BEFORE ^C
;ASSIGN CHAR TO PRINT TIME USED (^T) TO PSI CHANNEL 3
DOAT0: MOVEI A,ADVESC ;MAKE SURE ADVICE CHARACTER NO LONGER SPECIAL
DTI
MOVE A,[XWD CTCODE,3]
ATI
;ASSIGN CHARACTER TO ACTIVATE COMMAND EDITOR
SKIPG CEPSIC ;INTERRUPT CHARACTER SET?
IFSKP. ;YES
HRLZ A, CEPSIC ;GET IT
HRRI A, CEDCHN ;AND USE CHANNEL FOR COMMAND EDITOR
ATI% ;ENABLE THE INTERRUPT
ENDIF.
;ASSIGN CHARACTER TO CLEAR OUTPUT BUFFER
MOVE A,[CTRLO,,5] ;CONTROL-O IS USED
ATI
RET
;THIS ROUTINE GET TIME LIMIT WHICH WAS POSSIBLY SET BY ANOTHER
;PROCESS AND SETS IT ON THE CORRECT CHANNEL
CPULIM: MOVNI A,1
MOVE B,[-1,,D] ;GET CURRENT LIMIT INTO D
MOVEI C,.JIRTL
GETJI
CALL JERR
MOVE A,[.FHJOB,,.TIMRT] ;SET TIME LIMIT CODE
SETZB B,C ;CLEAR LIMIT
TIMER
CALL [ CAIE A,TIMX4 ;NOT SET BY THIS FORK?
JRST JERR ;NOPE, PRINT IT
POP P,(P)
RET] ;RETURN HAVING DONE NOTHING
MOVE A,[.FHJOB,,.TIMRT] ;SET TIME LIMIT CODE
MOVE B,D ;GET TIME TO SET
MOVEI C,4 ;CHANNEL
TIMER
TIMERR: ERROR <Couldn't set time limit - %?>
RET
;SUBROUTINE TO INIT GTTAB NUMBERS - USED AT STARTUP ONLY
;NOTE: THE ONLY ONES THAT SHOULD BE INITED HERE ARE ONES TO BE
;USED FOR *OTHER* THAN GETAB JSYS. FOR GETAB JSYS, USE MONITOR
;SYMBOLS.
STSYST: MOVSI D,-NGTTBS ;NUMBER OF TABLES
STSYS1: MOVE A,GTTBS(D) ;GET THE SIXBIT NAME OF THE TABLE
SYSGT ;GET ITS NUMBER
JUMPN B,STSYS2 ;JUMP UNLESS NO SUCH TABLE
TYPE <%No system table named: >
MOVE A,GTTBS(D)
CALL SIXPRT
SETZ B,
STSYS2: MOVEM B,@GTTBS+1(D) ;PUT NUMBER IN VARIABLE
AOBJN D,.+1
AOBJN D,STSYS1 ;DO ALL TABLES
RET
DEFINE PRGSTG ;STORAGE NEEDED FOR PROGRAM COMMANDS
< TRVAR <PNAMP,NAMFLG,PJFN,PTBLP>
>
;LIST OF GTTAB TABLES KNOWN TO EXEC
DEFINE XX (NAMS)<
IRP NAMS,<
SIXBIT /NAMS/
Z NAMS>>
GTTBS: XX <QTIMES,SNAMES,SYSVER,JOBRT,TTYJOB>
NGTTBS==.-GTTBS
;^C AND COMMAND ERRORS COME BACK HERE.
;AFTER ^C IT IS NECESSARY TO EXECUTE CODE TO FIND OUT WHETHER LOGGED IN,
; HAVE INFERIOR FORK, UPDATE CAPABILITIES, KILL AUTOLOGOUT FORK,
; ETC IN CASE INTERRUPTED COMMAND WAS LOGIN, RUN, ETC.
ERRET:: SETZM ERRMF ;CLEAR ERROR WITHIN ERROR FLAG
SKIPN ADVFLG
JRST CMDIN3 ;NO CLEANUP NECESSARY
CALL DOATI ;MAKE SO ^E AND ^C WORK AS NORMAL AGAIN
CALL FIXON ;FIX PAGE MODE SETTING
MOVE B,ADVTNM ;GET TERMINAL FOR BREAKING LINKS WITH
CALL BREAK1 ;BREAK LINKS TO REALLY END THE ADVICE
XCT ADVMES ;GIVE STANDARD END MESSAGE (AFTER BREAK SO WE DON'T HANG UP AGAIN)
SETZM ADVFLG ;INDICATE NOT IN ADVISE CODE
CMDIN3: MOVEI A,1
MOVEM A,INTDF
MOVEM A,IINTDF ;MAKE SURE IPCF INTERRUPTS ALLOWED
CALL PION ;MAKE SURE ^C ALLOWED
CALL IPCON ;MAKE SURE IPCF INTERRUPTS ALLOWED
;MISCELLANEOUS INITIALIZATION
MOVEI A,RERET ;SAY WHERE TO GO ON ERROR WHILE TYPING
MOVEM A,CERET ; ...LOGIN MESSAGE
;[4420] Process CRJOB startup flags to simulate login, or look like an EXEC1
;LOGIN command.
SKIPN CRPRA ;[4420] Is crjob start up?
JRST CMDIN4 ;[4420] Nope, normal start
HRRZ A,CRPRA+.CJPLP ;[4420] Get flags ptr
MOVE B,CRPRA(A) ;[4420] Get the flags themselvex
TLNE B,(1B4) ;[4420] Simulate login?
SETOM LOGINI ;[4420] Yes.
TLNE B,(1B3!1B4) ;[4420] Creator want system messages etc?
IFSKP. ;[4420] Nope
SETZM MESMSF ;[4420] No login check
SETZM MWATCF ;[4420] No mail watch
JRST CMDIN4 ;[4420] Get quickly to normal commands
ENDIF. ;[4420] So, we aren't being quiet, eh?
;[4420] Look like a job logged into from a terminal. It's probably BATCON
;logging in a batch job for some user.
CALL FREINI ;[4420] (/) Initialize free space
CALL DOMESS ;[4420] (/) Display login messages
CALL DOFAIL ;[4412] (/) Display login failures
SETOM SYSMF ;[4420] We want system messages
CALL PNTMES ;[4420] (/) Print system message if needed
JRST CMDIN4 ;[4420] Restart command
;[4420] DOMESS - Routing to output the LOGIN command messages. Since
;GETJI will get this information from this job's JSB, and not from the
;directory on disk, it will contain the proper date time.
;Returns +1 always with current and last login date and time messages sent.
DOMESS: SETO A, ;[4420] This job
HRROI B,LOGDAT ;[4420] Point to the place to store last login
MOVEI C,.JILLN ;[4420] Get the last login date-time from JSB
GETJI% ;[4420] Get from JSB, directory was updated
ERJMP .+1 ;[4420] No error
MOVE A,LOGDAT ;[4420] Get the date time returned
ETYPE < Job %J on %L %D %E
Last interactive login %1W
> ;[4420] Output whole message at once
SETO A, ;[4420] Done this way to insure compatibility
HRROI B,LOGDAT ;[4420] Point back to place to store last login
MOVEI C,.JINLD ;[4420] Now try to get last non-int login
GETJI% ;[4420] Can we get it today?
ERJMP R ;[4420] Nope, return now
MOVE A,LOGDAT ;[4420] Use last non-int login as login time
ETYPE < Last non-interactive login %1W
> ;[4420] Output that information
RET ;[4420] Return
;[4412]
;DOFAIL - Routine called by EXEC when started goofy (PRARG%) to display various
;login failures. [4420] Note the directory's login failures are not updated on
;a non-interactive login, the counts will be correct in the directory.
;
; Called with:
; no arguments
; CALL DOFAIL
;
; Returns:
; +1 - Always, with login failures displayed
DOFAIL: STKVAR <<CDBLK,.CDFPA+1>> ;Temp storage
SETZM .CDFPA+CDBLK ;Clear this word in case monitor don't have it
MOVE A,LIDNO ;Get logged in directory number
MOVEI B,CDBLK ;Here's the place to write the information
MOVEI C,.CDFPA+1 ;Want this many words
MOVEM C,.CDLEN(B) ;Save it in argument block
SETZ C, ;Don't use password string
GTDIR% ;Get the password failure count
ERJMP .+1 ;If failure, continue
HLRZ B,.CDFPA+CDBLK ;[4420] Get interactive login failures
IFN. B ;Is it non-0?
ETYPE <%% %2Q interactive login failure>
CAIE B,1 ;Singular?
ETYPE <s> ;Nope
ETYPE < since last successful login
>
ENDIF.
HRRZ B,.CDFPA+CDBLK ;[4420] Non-interactive failures are unusual
IFN. B ;Non-0?
ETYPE <%% %2Q non-interactive login failure>
CAIE B,1 ;More than one?
ETYPE <s> ;Yes, say so
ETYPE < since last successful login
>
ENDIF. ;[4420] End of non-interactive login failures
RET ;[4420] Return with all information displayed
ENDSV. ;End GTDIR% block
;CMDOUT - FROM LOGOUT CODE TO PROCESS LOGOUT.CMD AND SAVE OUR RETURN
;CMDIN4 - WHEN READY TO INPUT A COMMAND.
;ALL COMMANDS RETURN TO CMDIN4 OR ABOVE WHEN DONE.
CMDOUT::SKIPN LGORET ;DOING LOGOUT.CMD? IF NOT, NO NEED TO SAVE OUR RETURN
JRST CMDIN4
POP P,LGORET ;YES, SAVE THE RETURN
HRRZS LGORET
CMDIN4::SETZM .JBUFP ;ALLOW ALL JFNS TO BE RELEASED
CALL FIXIO ;MAKE SURE REAL STREAM USED FOR COMMAND
;SET SUBSYSTEM NAME TO "EXEC".
;THIS UPDATES MONITOR TABLES USED BY "SYSTAT".
MOVX A,OURNAM
MOVEM A,ETTYMD+TTWSNM
MOVEM A,ETTYMD+TTWPNM ;PROGRAM NAME TOO
MOVX B,OURNAM ;SET UP PRIVATE NAME AS SAME
SKIPN PCCURC ;PCL If no stored command in progress
SETSN ;SET UP SYSTEM NAME AS EXEC
JFCL
SETO A,
CAME A,NPAGE
CALL MAPPF ;DON'T LEAVE FORK PAGES MAPPED
JFCL ;UNMAP SHOULDN'T FAIL
SETZM CSZ1 ;ZERO STORAGE
MOVE A,[XWD CSZ1,CSZ1+1]
BLT A,CSZ2
;INITIALIZE WHAT NEEDS INITIALIZING
MOVE A,[POINT 7,CBUF,-1] ;BYTE POINTER INTO COMMAND BUFFER,
;IN WHICH ENTIRE LINE IS ACCUMULATED.
MOVEM A,BEGINP ;REMEMBER WHERE INPUT LINE BEGINS (FOR REPARSES)
XCT INISTK ;INITIALIZE STACK
PRGSTG ;GET LOCAL STORAGE FOR PROGRAM NAME STUFF
CALL FREINI ;INITIALIZE FREE SPACE
;INITIALIZE AUTOLOGOUT STUFF IF NECESSARY
SKIPE CUSRNO
JRST CMDN5E ;LOGGED IN, NOT RELEVANT.
IFNBATCH (CMDN5E) ;NO ALO STUFF IF IN BATCH
SKIPE ALOST ;HAVE WE STARTED THE AUTOLOGOUT STUFF UP?
JRST CMDN5D ;YES, THE FOLLOWING ALREADY DONE
GTAD ;SAVE STARTUP TIME FOR USE IN
MOVEM A,STRTIM ;"ALOTST" SUBR
;SET UP A PENDING TIMER INTERRUPT FOR AUTO-LOGOUT IF JOB IS INACTIVE
MOVE A,[.FHSLF,,.TIMEL] ;SET AN ELAPSED TIMER FOR SELF
MOVE B,[AUTOL2*^D1000] ;FOR THAT FAR IN FUTURE
MOVEI C,2 ;ON CHANNEL 2
CALL PIOFF ;DISABLE CONTROL-C'S
SETOM ALOST ;SAY AUTOLOGOUT STUFF STARTED
TIMER
ERROR <Couldn't initialize auto-logout timer - %?>
CALL PION ;ENABLE CONTROL-C'S
;JOB ISN'T LOGGED IN, SEE IF IT'S TIME TO AUTO-LOGOUT IT.
CMDN5D: CALL ALOTST
;PRINT READY CHARACTER
CMDN5E:
;CHECK TO SEE IF CRJOB/PRARG START UP & IF SO, A PROGRAM TO RUN
SKIPE CRPRA ;CRJOB START UP?
JRST [ HRRZ A,CRPRA+.CJPLP ;YES, GET FLAGS PTR
MOVE B,CRPRA(A) ;THEN FLAGS
TLNN B,(1B2) ;WANT FORK STARTED?
JRST .+1 ;NO
HRRZ A,CRPRA+.CJPKP ;GET PTR TO FORK & SFRKV OFFSET
HRRZ B,CRPRA(A)
CALL CLPRA ;CLEAR CRJOB/PRARG AREA
PUSH P,[CMDIN4] ;WHERE TO RETURN WHEN DONE
JRST ..STCR] ;RUN IT
CALL CLPRA
; GET THE NUMBER OF THE USER'S POBOX: DIRECTORY, AND STORE IT IN POBXNO
SKIPE POBXNO ;[3048]POBXNO=0?
JRST CMDN5X ;[3048]NOT ZERO, SO DON'T GET IT AGAIN
CALL GETPOB ;[3046] ( /C) GET THE DIRECTORY NUMBER
SKIPA ;[3059] Not logged in - leave POBXNO alone
MOVEM C, POBXNO ;[3046] AND SAVE IT
;CHECK FOR DEFAULT "TAKE" COMMANDS
CMDN5X: MOVE A,CIJFN ;[3048]
CAIN A,.PRIIN ;IF INPUT NOT FROM PRIMARY,
SKIPE FSTLGN ; OR FAST LOGIN WANTED,
JRST NLGINI ;THEN NO CHANGE OF INPUT NOW
SKIPN LOGINI ;LOGIN JUST DONE?
JRST NL1 ;NO, SKIP THIS - IF LOGINI=0, WE ALREADY DID .CMD FILES
SKIPL LOGINI ;HAVE WE TAKEN ANY LOGIN.CMD FILES YET?
JRST TKULOG ;YES, TAKEN SYSTEM: .CMD FILE (LOGINI>0)-TRY USER's .CMD FILE
;
;
;[3046] NO COMMAND FILES HAVE YET BEEN TAKEN - WE CAN DO AN ACCES% OF POBOX: HERE AND
;[3046] A CHECK TO TELL THE USER IF NEW MAIL EXISTS
;[3046] DO THIS HERE SO WE DON'T MESS UP ANYBODY WHO HAS THEIR .CMD FILES ACCESS
;[3046] DIRECTORIES FOR THEM
;
SETOM LOGINF ;[3046] SET FLAG TO SAY WE ARE ACCESSING POBOX:
;[3046] DURING THE LOG-IN PROCESS
CALL ACSPOB ;[3046] ACCESS THIS USER'S POBOX: IF IT ISN'T PS:
JRST CMDFLS ;[3046] FAILED
MOVE B, POBXNO ;[3046] USER'S POBOX: DIRECTORY NUMBER
CALL MALCHK ;[3046] (B/ )DO THE MAIL CHECK
JFCL ;[3046] FAILED - PROBABLY NO MAIL
CMDFLS: SETZM LOGINF ;[3046] RESET FLAG
MOVEI B,1 ;LOGINI <0; WE HAVEN'T TAKEN ANY .CMD FILES YET
MOVEM B, LOGINI ;WE DO SYSTEM: .CMD FILES NOW - SET FLAG TO 1
HRROI B, [ASCIZ /SYSTEM:LOGIN.CMD/]
SKIPE BATCHF ;UNDER BATCH?
HRROI B,[ASCIZ /SYSTEM:BATCH.CMD/]
CALL TAKSYS ;SET UP FOR APPROPRIATE SYSTEM: FILE
CAIA ;PROBABLY NO SUCH FILE
JRST CMDIN4
TKULOG: SETZM LOGINI ;CLEAR FLAG
HRROI B,[ASCIZ "LOGIN.CMD"]
SKIPE BATCHF ;UNDER BATCH?
HRROI B,[ASCIZ "BATCH.CMD"] ;YES - USER OTHER FILE
CALL TAKEIN ;NO, SET UP EXEC INPUT
CAIA ;DON'T RESET ANYTHING IF NOTHING GOT TAKEN
JRST CMDIN4 ;RESET ALL COMMAND INFO AFTER TAKEIN ATTEMPT
NL1: SKIPE CUSRNO ;IF NOT LOGGED IN,
SKIPGE FILINI ;OR INITIALIZATION DONE,
JRST NLGINI ;THEN SKIP FOR NOW - FILINI <0 MEANS INIT DONE
SKIPE FILINI ;FILINI=0 MEANS WE HAVEN'T TAKEN ANY .CMD FILES
JRST TKUCMD ;WE'VE TAKEN SYSTEM: .CMD FILES - LOOK FOR USER'S
MOVEI B,1 ;HERE WE DO SYSTEM: .CMD FILES,
MOVEM B, FILINI ; SO SET FLAG TO 1
HRROI B, [ASCIZ/SYSTEM:COMAND.CMD/]
CALL TAKSYS ;SEE IF SYSTEM:COMAND.CMD EXISTS
CAIA ;PROBABLY NOT
JRST CMDIN4
TKUCMD: SETOM FILINI ;HERE WE TAKE USER'S CMD FILE, SO SET FLAG TO "INIT DONE"
HRROI B,[ASCIZ "COMAND.CMD"]
CALL TAKEIN ;NO, TAKE FILE
CAIA ;DON'T RESET ANYTHING UNLESS WE'RE REALLY DOING "TAKE" NOW
JRST CMDIN4 ;RESET ALL COMMAND INFO AFTER TAKEIN ATTEMPT
NLGINI: MOVE A,CIJFN ;SEE WHERE INPUT IS COMING FROM
SKIPE FSTLGN ;FAST LOGIN
JRST FST2 ;YES - NO SYSTEM MAIL CHECK
CAIN A,.PRIIN ;INPUTTING FROM TERMINAL?
CALL PNTMES ;YES, SO DONE WITH INITIALIZATION, TYPE SYSTEM MESSAGES
FST2: ;..
;PERFORM MAIL WATCH FUNCTION, IF REQUESTED BY SET MAIL-WATCH
CALL IPCOFF ;DON'T ALLOW IPCF INTERRUPTS
SKIPE IPCRCF ;WERE THERE SOME?
CALL IPCHEK ;YES, CHECK FOR MESSAGES RECEIVED
SETZM IPCRCF ;THIS FLAG WILL BE SET NEXT TIME AN INTERRUPT HAPPENS
CALL IPCON ;...WHICH COULD BE RIGHT NOW OR LATER
SKIPE FSTLGN ;FAST LOGIN
JRST FST3 ;YES - NO MAIL CHECK
SETZM TYPING ;NO TYPEOUT IN PROGRESS
SETZM AUTOF ;NO INTERRUPT IN PROGRESS
CALL MWATCH ;DO MAIL WATCH
FST3: ;..
CALL ALRCHK ; AND ALERT CHECK
CALL RLJFNS ;RELEASE ANY JFNS USED IN PREVIOUS COMMAND
;NOTE: RLJFNS CALLED HERE RATHER THAN EARLIER
;TO FLUSH JFN USED BY MWATCH. THIS IS NECESSARY
;SO THAT "COPY TTY:$" DOESN'T TYPE "MAIL"!
SETOM CLF ;SAY WE'RE AT COMMAND LEVEL
CALL READY ;INITIALIZE FOR COMND JSYS
CIN42:: MOVEI A,RERET ;REGULAR ERROR RETURN ADDRESS
MOVEM A,CERET ;SAY WHERE TO GO AFTER PRINTING ERR MSG
;CLEAR SOME FLAGS
MOVEI Z,0 ;CLEAR FLAGS
JRST CIN0 ;[3039] START INPUTTING AND DECODING A COMMAND
; [3059]
; ROUTINE TO OBTAIN THE POBOX: DIRECTORY NUMBER OF THIS USER. SINCE POBOX: MAY NOW BE
; ANY STRUCTURE ON A CLUSTER, AND INDEED MAY EVEN BE DEFINED AS A SEARCH LIST, E
; NEED TO GET THIS NUMBER AND SAVE IT . IT WILL BE USED TO PERFORM AN ACCES% OF
; THE USER'S POBOX: AND ALSO IN MAIL-WATCHING .
;
; CALL GETPOB
;
;
; RETURN +1 THE USER IS NOT LOGGED IN
;
; RETURN +2 A FAILURE IN THIS ROUTINE WILL RETURN A ZERO IN
; POBXNO
;
; SUCCESS MEANS THE USER'S POBOX: DIRECTORY NUMBER
; WILL BE IN POBXNO
GETPOB: SKIPN CUSRNO ; Logged in?
RET ; No, don't bother with this
STKVAR <<TMPSTR,15>,SAVPTR> ;[4422] Temp storage
MOVEI A,.LNSSY ;[4401] Do system wide translation
HRROI B,[ASCIZ /POBOX/] ;[4401] of this logical name
MOVE C,CSBUFP ;[4401] Get temp byte pointer
MOVEM C,SAVPTR ;[4401] Hold onto this
LNMST% ;[4401] Translate
IFJER. ;[4401] If no such logical,
TYPE <?Failed to translate POBOX: logical name.
>
JRST GETPBE ;[4401] Error - pass directory number of zero
ENDIF. ;[4401]
GETPB1: SKIPN C,SAVPTR ;[4401] Still a pointer there?
JRST GETPBE ;[4401] No, out of structures and couldn't find directory
MOVEI A,TMPSTR ;[4401] STR:<DIRECTORY> goes here
HRLI A,(POINT 7,) ;[4401] Make real byte pointer
DO. ;[4401] Now make STR:<DIRECTORY>
ILDB B,C ;[4401] Get a character from POBOX:
CAIE B,.CHNUL ;[4401] End of logical name list?
IFSKP. ;[4401] If so,
SETZ C, ;[4401] No more byte pointer
EXIT. ;[4401] And now check this final structure
ENDIF. ;[4401]
CAIN B,"," ;[4401] Have we obtained a full STR:?
EXIT. ;[4401] Yes, now put in directory
IDPB B,A ;[4401] Stick byte in here
JRST TOP. ;[4401] And continue with STR:
OD. ;[4401]
MOVEM C,SAVPTR ;[4401] Remember where we were in str list
MOVEI B,"<" ;[4401] Get directory delimiter
IDPB B,A ;[4401] Drop it in
MOVE B,CUSRNO ;[4401] Get user number
DIRST% ;[4401] Translate directory (should work)
ERJMP GETPBE ;[4401] If not, that's life
MOVEI B,">" ;[4401] Delimit STR:<DIRECTORY>
IDPB B,A ;[4401] Stick it in
MOVEI B,.CHNUL ;[4401] End string
IDPB B,A ;[4401] By adding NULL
MOVX A,<RC%EMO> ;[4401] Want exact match
HRROI B,TMPSTR ;[4401] Get string we just made
RCDIR% ;[4401] Find it
ERJMP GETPB1 ;[4401] If it is not there, try next STR:
TXNE A,RC%DIR ;[4401] Files only?
JRST GETPB1 ;[4401] Yes, try again
TXNE A,RC%NOM ;[4401] Not even there?
JRST GETPB1 ;[4401] Not there, try another STR:
RETSKP ;OK - got dir number in AC3
GETPBE: MOVEI C,0 ;Problem getting dir number - set POBXNO=0
RETSKP ;And return
;[3046] ROUTINE TO ACCESS POBOX: ON BEHALF OF THIS USER. SINCE POBOX: MAY NOT BE
;[3046] PS:, IT IS NECESSARY TO FIND OUT WHAT STRUCTURE IS POBOX: AND GET ACCESS TO IT
;[3046] SO WE CAN DO A MAIL CHECK AND THE USER WILL BE NOTIFIED OF NEW MAIL ON LOG-IN.
;[3046] IF POBOX: IS INDEED PS:, THE ACCES% DOES NOT NEED TO BE PERFORMED SINCE WE ARE
;[3046] ACCESSING THE USER'S LOG-IN DIRECTORY AT THIS POINT ANYWAY.
;[3046]
;[3046] CALL ACSPOB
;[3046]
;[3046] RETURN +1 ON FAILURE
;[3046] +2 ON SUCCESS - IF POBOX: IS PS:, NO ACCESS HAS BEEN DONE; IF IT
;[3046] IS NOT PS:, THE ACCESS HAS BEEN PERFORMED
;
ACSPOB: STKVAR <ACSJOB,ACSPSW,ACSDIR> ;[3046] KEEP THESE IN ORDER FOR ACCES%!!!
MOVE A,LIDNO ;[3046] GET LOGGED-IN DIRECTORY NUMBER
CAMN A,POBXNO ;[3046] SAME AS POBOX:?
RETSKP ;[3046] YES, NO NEED TO DO THE ACCES%
MOVE A,CSBUFP ;[3046] GET POBOX: NAME STRING FOR ACCES%
MOVE B,POBXNO ;[3046] USE THIS NUMBER TO GET THE STRING
DIRST% ;[4401] Get POBOX: directory string
ERJMP R ;[4401] Should never happen
SETZM ACSPSW ;[3046] NO PASSWORD
MOVE C,CSBUFP ;[3046] WHERE NAME STRING IS
MOVEM C,ACSDIR ;[3046] .ACDIR FOR ACCES%
SETOM ACSJOB ;[3046] -1 MEANS THIS JOB - .ACJOB FOR ACCES%
MOVX A,AC%OWN!.ACJOB+1 ;[3046] OWNER ACCESS,,BLK LEGTH=3
MOVEI B,ACSDIR ;[3046] ADDRESS OF BLOCK
ACCES% ;[3046]
ERJMP R ;[3053] IN CASE ACCESS FAILS
RETSKP ;[3046] POBOX: HAS BEEN SUCCESSFULLY ACCESSED
;BEGIN INPUTTING AND DECODING A COMMAND
CIN0:: CALL COMSET ;SET UP THINGS FOR COMMAND INPUT
MOVE B,PCLDCO ;[PCL] Get default value for Original flag
; (0 unless from DOCOMMAND ORIGINAL "...")
MOVEM B,ORIFLG ;[PCL] Set Original flag (here because after
; reparse address but before entry from
; the "Original" command.
CIN1: SETZM CIPF ;[PCL] No command in progress yet
SETZM CEBPTR ;SAY COMMAND CAN BE SAVED (COMMAND EDITOR)
SETOM CLF ;AND SAY AT COMMAND LEVEL (COMMAND EDITOR)
MOVX B,WHLU+OPRU+ERRU ;PCL
SKIPE PRVENF ;USER "ENABLE"D?
CALL PRVCK ;CHECK FOR PRIVILEGED USER
JRST CIN9 ;NOT PRIVILEGED, SO ^E NO POSSIBILITY
MOVEI B,CM1DBE ;GET THE PRIVILEGED DESCRIPTOR BLOCKS
JRST CIN7 ;AND GO CHECK FOR PCL COMMANDS
CIN9: MOVEI B,CM1DB ;GET THE UNPRIVILEGED DESCRIPTOR BLOCKS
SKIPE CUSRNO ;LOGGED IN?
JRST CIN7 ;YES - GO CHECK PCL
MOVX A,.SFXEC ;[4427] Function to get EXEC flags word
TMON ;[4427] Get EXEC flags word from monitor
ERJMP CIN9OM ;[4427] If failed, its an old monitor
TXNE B,XC%NLS ;[4427] Disallow not logged in SYSTAT?
SKIPA B,[CM1YL] ;[4427] Yes, omit SYSTAT command
CIN9OM: MOVEI B,CM1XL ;[4427] Use not-logged-in descriptor blocks
JRST CIN10 ;NO PCL UNTIL LOGGED IN (USES THE WRONG TABLE)
CIN7: SKIPN PCFLDB ;IS PCL A FACTOR?
SKIPE PCFLDP
TRNA ;YES
JRST CIN10 ;NO
MOVEI C,PCFLDB ;ASSUME USER TABLE
SKIPN ORIFLG ;[PCL] DOES HE WANT THE ORIGINAL SET?
SKIPN PCFLDB ;DOES HE HAVE HIS OWN?
TRNA ;YES, OR NO
JRST CIN8 ;NO AND YES, USE HIS
SKIPN PCFLDP ;IS THERE A PRESERVED TABLE?
JRST CIN10 ;NO, USE ORIGINAL ONE
SKIPLE ORIFLG ;[PCL] USE PRESERVED COMMANDS?
JRST CIN10 ;NO, USE ORIGINAL ONE
MOVEI C,PCFLDP ;USE PRESERVED COMMANDS
CIN8: HRRZ B,(B) ;STEP PAST THE ORIGINAL TABLE
HRRM B,(C) ;LINK AFTER PCL TABLE
MOVEI B,(C) ;USE IT
CIN10: CALL FLDSKP ;TRY TO READ COMMAND NAME
CMERRX <Unrecognized command>
MOVEM B,COMAND ;SAVE COMMAND INFO
LOAD D,FKFLAG,+@FRKDEF ;GET DEFAULT FLAGS
MOVEM D,NAMFLG
LDB D,[331100,,(C)] ;GOOD PARSE, SEE WHAT GOT TYPED
CAIN D,.CMFIL ;FILESPEC?
JRST CIN3P ;YES, GO RUN PROGRAM
CAIN D,.CMTOK ;^E?
JRST CINE ;YES
JRST CIN2 ;MUST BE COMMAND
;ROUTINE TO SET UP DEFAULTS FOR COMMAND INPUT
;PLEASE BE CAREFUL ABOUT CAUSING JSYS'S TO BE EXECUTED IN THIS ROUTINE,
;SINCE THIS ROUTINE GETS CALLED FOR EVERY COMMAND, AND WE WANT TO
;MINIMIZE NUMBER OF SYSTEM CALLS. THANKS.
COMSET: DEXTX <EXE> ;DEFAULT PROGRAM EXTENSION IS "EXE"
HRROI A,[ASCIZ /SYS/] ;DEFAULT DEVICE FOR PROGRAMS IS SYS:
MOVEM A,CJFNBK+.GJDEV
MOVX A,GJ%OLD ;PROGRAM MUST EXIST
MOVEM A,CJFNBK+.GJGEN
RET
;PRIVILEGED, AND ^E TYPED
CINE: MOVEI B,[FLDDB. .CMKEY,,CTBL2]
CALL FLDSKP
CMERRX ;NO SUCH ^E COMMAND
MOVEM B,COMAND
;HAVE VALID FIRST KEYWORD IN COMMAND
;MAKE PRE-DISPATCH CHECKS
CIN2:: MOVE B,COMAND ;PCL GET WHICH COMMAND WE'RE DOING
CALL GETKEY
HLRO A,@COMAND ;GET NAME OF COMMAND IN CASE IT'S A FORK
MOVEM A,PNAMP ;SAVE IT FOR ROUTINE THAT BUILD RESCAN STRING
MOVE A,COMAND ;GET WHICH COMMAND WE'RE DOING
HLRZ B,KEPNMS ;SEE HOW MANY FORKS IN FORK TABLE
ADDI B,KEPNMS ;GET HIGHEST TABLE ADDRESS POSSIBLE
CAIL A,KEPNMS+1 ;IS OUR COMMAND IN RANGE OF FORK TABLE?
CAMLE A,B ;LARGE ENOUGH. IS IT SMALL ENOUGH?
CAIA ;TOO SMALL OR TOO LARGE.
JRST [ CALL CIN3D ;GET RESCAN LINE AND CONFIRMATION
MOVEI A,FRKNMS ;SAVED FORK, FIND WHERE IT IS IN FORK TABLE
MOVE B,COMAND ;GET POINTER TO NAME ("FIELD" PUT PTR IN COMAND)
TBLUK ;GET TABLE ADDRESS
MOVEM A,PTBLP ;SAVE TABLE ADDRESS
JRST CINFRK] ;JOIN OTHER CODE
MOVE P4,P3 ;1ST KW'S VALUE WD STAYS IN P4.
SKIPE CUSRNO ;LOGGED IN?
JRST CIN2A ;YES - SKIP THIS
TXNN P4,NOLG ;NO - IS THIS COMMAND ALLOWED?
ERROR <LOGIN please> ;NO - IT'S AN ERROR
CIN2A: MOVE B,P3 ;FOUND PRIVILEGED COMMAND, MAKE SURE PRIVILEGES
CALL PRVCK
ERROR <Insufficient privileges>
CALL (P4) ;DISPATCH WITH PUSHJ,
;CAN RETURN WITH POPJ
;OR JRST CMDIN2,3,4.
JRST CMDIN4 ;WHERE MOST COMMANDS SHOULD RETURN.
;RUN PROGRAM ENTRY FOR PRARG.
DOCC2:: PRGSTG ;ALLOCATE STORAGE
CALL TRYGTJ ;GET JFN ON FILESPEC
CMERRX <Can't run program>
MOVEM A,PJFN ;REMEMBER JFN OF PROGRAM
JRST RSUBS4 ;GO RUN PROGRAM
;FIRST KEYWORD IS NOT A COMMAND NAME,
; SEE IF IT'S A SUBSYSTEM NAME
CIN3P: CALL SPNAME ;SET UP PROGRAM NAME
CALL CIN3D ;GET REST OF LINE
MOVEI A,FRKNMS ;POINT TO TABLE OF KNOWN FORK NAMES
MOVE B,PNAMP ;GET POINTER TO CURRENT PROGRAM NAME
TBLUK ;SEE IF NAME IS IN TABLE
TXNE B,TL%EXM ;EXACT MATCH?
JRST [ HRRZ A,(A) ;YES, GET ADDRESS OF FORK BLOCK
LOAD A,FKFLAG,(A) ;GET FLAGS FOR THIS FORK
MOVEM A,NAMFLG ;REMEMBER THEM
JRST .+1]
MOVE A,NAMFLG ;GET FLAGS FOR THIS PROGRAM
TXNE A,FN%EPH ;RUN THIS AS AN EPHEMERON?
JRST EPH ;YES
TXNE A,FN%NEF ;NEVER RUN THIS AS AN EPHEMERON?
JRST RSUBS4 ;YES
MOVE A,PJFN
DVCHR ;GET DEVICE CHARACTERISTICS
TLNE A,177777 ;IS IT A DISK?
JRST RSUBS4 ;NO - GO ON
MOVE A,PJFN
MOVE B,[1,,.FBCTL] ;GET FILE FLAGS
MOVEI C,C ;INTO C
CALL $GTFDB
JRST CERR
LDB C,[POINTR C,FB%FCF]
CAIE C,.FBEPH ;EPHEMERAL?
JRST RSUBS4 ;NO - GO ON
EPH: MOVEI Q1,ETTYMD ;SET TTY MODES
CALL LTTYMD
MOVE A,PJFN ;PASS ON JFN
JRST REPH ;GO RUN EPHEMERAL
;SPNAME is used to set up the program name cell.
;
;Accepts: B/ jfn
SPNAME: MOVEM B,PJFN ;REMEMBER JFN
MOVEI A,EXTSIZ ;GET ROOM FOR FILENAME
CALL GETBUF ;GET BUFFER FOR IT
HRRO A,A ;MAKE POINTER TO THE SPACE
MOVEM A,PNAMP ;REMEMBER POINTER TO PROGRAM NAME
HRLM A,PRGCEL ;SET UP POINTER TO PROG NAME FOR ^T
MOVE B,PJFN ;GET PROGRAM NAME
MOVX C,1B8 ;WE WANT JUST THE NAME FIELD
JFNS ;GET FILE NAME
MOVEI B,PRGCEL
MOVEM B,COMAND
RET
;ENTER HERE FROM EDIT/CREATE COMMAND
CIN3:: CALL SPNAME ;SET UP PROGRAM NAME
MOVEI A,FRKNMS ;POINT TO LIST OF KNOWN FORKS
MOVE B,PNAMP ;POINT TO NAME OF EDITOR
TBLUK ;LOOK UP EDITOR IN KNOWN NAMES
TXNN B,TL%EXM ;IS EDITOR IN LIST OF KNOWN FORKS?
JRST CINXED ;NO, SO IT WILL BE LOADED AND STARTED FOR SURE
HRRZ C,(A) ;YES, GET ADDRESS OF FORK BLOCK
LOAD D,FKHAN,(C) ;GET FORK HANDLE OF EDITOR
JUMPE D,CINXED ;IF NONE, GO START EDITOR
MOVX C,FK%RUN ;FORCE EDITOR TO ALWAYS BE "START"ED ON "EDIT"
ANDCAM C,SLFTAB(D) ;COMMAND, SO FRESH COPY OF EDITED FILE IS GUARANTEED.
CINXED: MOVEM A,PTBLP ;SAVE TABLE POINTER
TXNN B,TL%EXM ;EXACT MATCH OF NAME?
JRST RSUBS4 ;NO, GO RUN PROGRAM
CINFRK: HRRZ B,(A) ;GET ADDRESS OF FORK BLOCK
LOAD A,FKHAN,(B) ;GET FORK HANDLE
CAIN A,0 ;DOES THIS FORK EXIST?
JRST RSUBS4 ;NO
MOVE B,PTBLP ;GET TABLE ADDRESS IN CASE FORK IS KEPT
MOVE A,SLFTAB(A) ;GET FLAGS FOR THIS FORK
TXNE A,FK%KPT ;IS FORK KEPT ALREADY?
JRST RSTFK ;YES, SO GO RESTART IT
JRST RSUBS4
CIN3D: LINEX <Data line to be sent to program>
CMERRX
MOVE B,CMABP ;GET POINTER TO BEGINNING OF END OF LINE
ILDB D,B ;GET FIRST CHARACTER OF REST OF LINE
MOVE A,CSBUFP ;POINTER TO COMMAND LINE
MOVE B,PNAMP ;GET POINTER TO PROGRAM NAME
MOVEI C,0 ;END ON NULL
SOUT ;START COMMAND LINE WITH PROGRAM NAME
MOVEI B,40 ;SPACE TO SEPARATE FILENAME FROM REST OF LINE
CAIE D,0 ;IS THERE ANY MORE TO THE LINE?
TLOA Z,F3 ;YES - LIGHT FLAG
TLZA Z,F3 ;NO - CLEAR FLAG
BOUT ; AND PUT THE SPACE IN
MOVE B,CMABP ;GET POINTER TO ATOM BUFFER (REST OF LINE)
SOUT ;COPY REST OF LINE FOR RSCAN
HRROI B,[BYTE (7)12,0] ;LINEFEED TO END RSCAN BUFFER
SOUT ;FINISH LINE WITH LF
CONFIRM ;GET CONFIRMATION AFTER DATA LINE
MOVE A,CSBUFP ;GET RESCAN POINTER
CALL BUFFS ;SAVE THE STRING
MOVEM A,RSPTR ;SET UP FINAL ONE, NOW THAT COMMAND IS CONFIRMED
RET ;RETURN
RSUBS4: MOVEI Q1,ETTYMD ;MAKE SURE NORMAL TTY MODE RESTORED
CALL LTTYMD
CALL ERESET ;PREPARE TO LOAD AND RUN PGM
MOVE A,PJFN ;SAY WHICH PROGRAM TO GET
SETO C, ;FORCE OVERLAY
CALL $GET0 ;GET PROGRAM
JRST ..STRT ;START PROGRAM
;EXAMINE (MEMORY LOCATION) N
BLEN==20 ;ENOUGH FOR ASCIZ STRINGS
.EXAMI::STKVAR <<FANCBF,BLEN>,<OCTBF,BLEN>>
NOISE <MEMORY LOCATION>
SETZ A, ;SAY EXAMINE
CALL EXDPDF ;SET DEFAULT ADDRESS, IF ANY
ADDRX <Address to examine>
ERROR <Couldn't parse address>
CONFIRM
MOVE A,B
TLNE A,777740 ;THIS COMMAND ONLY ALLOWS 32 SECTIONS
ERROR <Memory address not between 0 and 37,,777777>
CALL MAPPF ;MAP THAT PAGE & GET ACCESS INFO
JRST CJERRE ;FAILED-- TYPE JSYS ERROR
TXNN B,PA%PEX
ERROR <No such page>
TXNN B,PA%RD
ERROR <Can't read that page>
MOVE B,FORK ;CURRENT FORK
SKIPE C,SLFTAB(B) ;EXISTS?
JRST [ MOVX D,FK%EDF
ANDCAM D,SLFTAB(B) ;INDICATE LAST WAS EXAMINE
MOVEM A,.FKEDL(C) ;SAVE THIS LOC
JRST .+1]
MOVE C,A ;FETCH CONTENTS
ANDI C,777
MOVE C,PAGEN(C) ;RH
HRROI D,FANCBF ;FIRST POINT AT FANCY BUFFER
MOVEM D,COJFN
ETYPE<%1Y/ %3/> ;CREATE FANCY VERSION
MOVEI D,.CHNUL ;MAKE SURE NULL AFTER STRING
IDPB D,COJFN
HRROI D,OCTBF ;NOW CREATE OCTAL VERSION
MOVEM D,COJFN
ETYPE <%1O/ %3#>
MOVEI D,.CHNUL
IDPB D,COJFN ;FINISH WITH NULL
CALL FIXIO ;REVERT TO STANDARD IO
UTYPE FANCBF ;FIRST, DISPLAY THE FANCY VERSION
HRROI B,OCTBF ;COMPARE IT WITH OCTAL VERSION
HRROI A,FANCBF
STCMP
JUMPN A,[HRROI A,OCTBF ;SHOW OCTAL VERSION IF DIFFERENT
ETYPE < (%1M)>
JRST .+1]
ETYPE <%_> ;FINISH LINE
RET
;DEPOSIT (MEMORY LOCATION) N (CONTENTS) M
.DEPOS::STKVAR <DEADD,DECON>
NOISE <MEMORY LOCATION>
SETO A, ;INDICATE DEPOSIT
CALL EXDPDF ;SET DEFAULT ADDRESS
ADDRX <Address in which to deposit>
ERROR <Couldn't parse address>
TLNE B,777740 ;THIS COMMAND ONLY ALLOWS 32 SECTIONS
ERROR <Memory address not between 0 and 37,,777777>
MOVEM B,DEADD ;SAVE ADDRESS
HRROI A,[ASCIZ /contents/] ;GUIDE WORD
CALL RINST ;GET INSTRUCTION TO BE DEPOSITED
MOVEM A,DECON ;SAVE UNEVALUATED DATA FOR DEPOSITING
CONFIRM
SKIPG FORK ;FORK EXISTS?
CALL ECFORK ;NO, CREATE ONE
MOVE A,FORK ;GET FORK INDEX
MOVE Q1,SLFTAB(A) ;GET ADDRESS OF FORK DATA
SKIPG FORK ;FORK EXISTS?
SETZM .FKPTM+TTWPNM(Q1) ;CLEAR FORK PROGRAM NAME
MOVE A,DECON ;GET UNEVALUATED CONTENTS
CALL PINST ;EVALUATE IT, NOW THAT WE HAVE A FORK
ERROR <Can't evaluate contents>
MOVEM A,DECON ;REMEMBER EVALUATED CONTENTS
MOVE A,DEADD ;GET LOCATION BEING WRITTEN INTO
CALL MAPPF ;MAP THAT PAGE AND GET ACCESS INFO
JRST CJERRE ;FAILED-- TYPE JSYS ERROR
TXNN B,PA%WT
JRST [ TXNN B,PA%CPY ;COPY-ON-WRITE BIT
ERROR <Can't write that page>
TYPE < [Shared page made private]>
JRST .+1]
TXNN B,PA%PEX
JRST [ TYPE < [New]> ;ADVISORY MESSAGE
JRST .+1]
MOVE B,DEADD ;GET LOCATION
MOVE A,FORK
SKIPE C,SLFTAB(A) ;FORK EXISTS?
JRST [ MOVX D,FK%EDF
IORM D,SLFTAB(A) ;INDICATE LAST WAS DEPOSIT
MOVEM B,.FKEDL(C) ;SAVE THIS LOC
JRST .+1]
MOVE A,DECON ;GET DATA
;STORE A AT B IN FORK. ASSUME WE STILL HAVE THE PAGE.
MOVE C,B ;REMEMBER ADDRESS
ANDI B,777 ;MASK OFF PAGE # PART OF ADDRESS
MOVEM A,PAGEN(B) ;STORE INTO PAGE BUFFER
;EXECUTION OF DEPOSIT COMMAND...
;IF ADDRESS < 20, SET FORK AC'S. NON-AC PAGES HANDLE THEMSELVES.
TDNE C,[777776,,777760] ;ACS ARE ALSO IN SECTION 1
JRST CMDIN4
MOVE A,FORK
MOVEI B,PAGEN
SFACS
ERJMP CJERRE ;FAILED-- TYPE JSYS ERROR
JRST CMDIN4
;EXDPDF - SET DEFAULT ADDRESS FOR EXAMINE OR DEPOSIT
; A/ 0 FOR EXAMINE, -1 FOR DEPOSIT
EXDPDF: STKVAR <EAM>
SKIPE C,FORK ;FORK HANDLE
SKIPN C,SLFTAB(C) ;KNOWN?
RET ;NO FORK - DO NOT SET DEFAULT
SKIPGE B,.FKEDL(C) ;ANY PREVIOUS E/D?
RET ;NO - DON'T SET DEFAULT
XOR C,A ;MASK FLAG
TXNN C,FK%EDF ;SAME AS LAST?
ADDI B,1 ;YES - INCR LOC
MOVEM B,EAM
MOVEI A,3 ;ENOUGH ROOM FOR NUMBER
CALL GETBUF ;GET BUFFER ON WORD BOUNDARY
MOVE D,A ;REMEMBER WHERE BUFFER STARTS
HRLI A,440700 ;MAKE BYTE POINTER
MOVX C,^D8 ;GET OLD VALUE
MOVE B,EAM
;WOULD LIKE TO SET DEFAULT STRING TO M,,N INSTEAD OF LARGE OCTAL NUMBER
;THIS REQUIRES M,,N TO BE AN ATOM FOR SOME TYPE OF COMND JSYS FIELD
REPEAT 0,<
TLNN B,-1 ;ANY SIGNIFICANCE IN LEFT HALF?
JRST EXDPRH ;NO--JUST DO RIGHT HALF
PUSH P,B ;SAVE NUMBER FOR RIGHT HALF LATER
HLRZS B ;SET TO PRINT LEFT HALF NOW
NOUT ;IN OCTAL
JRST [ POP P,(P) ;CAN'T--DON'T DEFAULT
RET]
MOVEI B,"," ;SEPARATE HALVES WITH ",,"
IDPB B,A
IDPB B,A
POP P,B ;GET BACK NUMBER
EXDPRH: HRRZS B ;PRINT JUST RIGHT HALF NOW
> ;END OF REPEAT 0
NOUT ;IN OCTAL
RET ;CAN'T-- DON'T DEFAULT
UDEF @D ;SET DEFAULT TO TEXT NUMBER
RET ;RETURN FROM EXDPDF
;PCL Original Exec command
.ORIGI::NOISE (EXEC COMMAND)
SETOM ORIFLG ;[PCL] NEXT COMMAND USES ORIGINAL TABLE
JRST CIN1 ;PARSE AS IF REGULAR COMMAND
;SYSTAT
;BITS IN Q1 USED FOR SYSTAT OUTPUT CONTROL
SYSIND==1
DEFINE SYSBIT(A)
< IRP A,<
IFE SYSIND,<PRINTX SYSTAT CONTROL BITS EXHAUSTED
>
SY%'A==SYSIND
SYSIND==SYSIND+SYSIND
>>
SYSBIT <IME,ALL,CLS,HED,NHD,TTY,USR,SUB,TIM,CON,LIM,CJB,JOB,NJB,STA,NOP,4NH,NOD,CT> ;[4412]
SYSDEF==SY%IME!SY%TTY!SY%USR!SY%SUB!SY%4NH ;DEFAULT LISTING
;[7.1076] Note that the SY%NOD bit is not included in this mask. It is only
;turned on when the user explicitly wants a node included in the SYSTAT
SYSALL==SY%ALL!SY%CLS!SY%TTY!SY%USR!SY%SUB!SY%TIM!SY%CON!SY%LIM!SY%CJB!SY%STA!SY%4NH!SY%CT ;[4412] All (everything)
;INDICES FOR STACK ARGS
SY$JOB==0 ;JOB NUMBER
SY$TTY==1 ;LINE NUMBER
SY$DIR==2 ;DIRNUM
SY$USR==3 ;USER NUMBER
SY$PRG==4 ;PROGRAM NAME
SY$FLD==5 ;[7.1137] Field was typed or WILD username + SY%NOD
JIBLN==.JICT+1 ;[4412] Size of job info block
SYCLN==10 ;SKED% BLOCK SIZE
.SISTA::SAVEAC <Q1,Q2,Q3,P1,P2,P3,P4,P5> ;[7.1076] Used and saved
TRVAR <SYSJFN,JNX,<SYCLB,SYCLN>,<.JIBAS,JIBLN>,<.NTBAS,.NWNU1+1>,SFRAME,<SYSTAK,SYSTAL>,SYSDIR,SYSTNM,SISTAS,SISLDS,SISCDS,SISTAN,<HSTNAM,10>,HSTDEL,HDRPOS,NODMSK,CURNOD,CURNDN,STKPTR,FLDPTR,SYJOBM,CLSMSK,SUBMSK> ;[4413]
SETZM SUBMSK ;[4413] Say not in subcommand mode yet
SETZM CLSMSK ;[7.1140] Clear class mask to start with
SETZM SYJOBM ;[7.1139] SYSJOB mask
SETZM WLDPAG ;[7.1137] Clear this to start
MOVE A,[WLDPAG,,WLDPAG+1] ;[7.1137] Prepare to clear page
BLT A,WLDPAG+777 ;[7.1137] No zero out page
SETZM FLDPTR ;[7.1137] Say we have bananas at the moment
;[7.1137] FLDPTR is used to index into WLDPAG.
;[7.1137] WLDPAG has the strings for non-local users
SETZM CURNOD ;[7.1076] Clear this (byte pointer to node name)
SETZM CURNDN ;[7.1076] Reset current node number
SETZM NODMSK ;[7.1076] Init CI node mask
SETZM SYSJFN ;NO SPECIAL OUTPUT JFN YET
SETOM TYPING ;SAY TYPEOUT IN PROGRESS
SETZM HDRPOS ;[7.1008] CLEAR ORIGIN HEADER COLUMN WORD
MOVE Q1,[SYSDEF]
HRLI A,-SYSTAL
HRRI A,SYSTAK ;MAKE STACK POINTER
MOVEM A,SFRAME ;SAVE ARG START
TLZ Z,F3
SYSTK1: MOVEI B,[
FLDBK. .CMKEY,,$SESTA,,,DOTBRK,[
FLDDB. .CMUSR,,CM%DWC,,,[
FLDDB. .CMDIR,,CM%DWC,,,[ ;KEEP AFTER USER NAME TO ALLOW RECOGNITION ON USER NAME
FLDDB. .CMNUM,CM%SDH,5+5,<Decimal job number>,,[
FLDDB. .CMCMA,,,,,[
FLDDB. .CMCFM,,,,,[
FLDBK. .CMFLD,CM%SDH,,,,[
BRMSK. (FLDB0.,FLDB1.,FLDB2.,FLDB3.,<*%-_$.>,)]]]]]]]] ;[7.1137]
CALL FLDSKP ;GET SOME INPUT
JRST SYSNX ;NO
LDB D,[331100,,(C)] ;GET FUNCTION CODE
CAIN D,.CMKEY ;KEYWORD?
JRST SYSKEY ;YES
CAIN D,.CMUSR ;USER NAME?
JRST SYSTU ;YES
CAIN D,.CMDIR ;DIRECTORY NAME?
JRST SYSTD ;YES
CAIN D,.CMNUM ;DECIMAL JOB NUMBER?
JRST SYSTJ ;YES
CAIN D,.CMCMA ;COMMA?
JRST SYSSUB ;YES, MAYBE SUBCOMMANDS COMING
CAIN D,.CMCFM ;END OF LINE?
JRST SYSTS0 ;YES GO EXECUTE COMMAND
CAIN D,.CMFLD ;[7.1137] Field (ala cluster SYSTAT username)?
JRST SYSFLD ;[7.1137] Yes, parse field
CALL SCREWUP ;SHOULD NEVER GET HERE
;HERE FOR "SYS ."
SYSTK.: MOVEI A,SY$JOB
CALL SSTACK ;PUT FLAVOR ON STACK
MOVE A,JOBNO
CALL SSTACK ;PUT ITEM ON STACK
TXO Q1,SY%IME ;"SYS NO . ." = "SYS ."
CALLRET .SYSEL ;EXIT THROUGH CODE THAT SAYS NOT TO PRINT HEADER
;KEYWORD TYPED AFTER SYSTAT
SYSKEY: CALL GETKEY ;CHANGE TABLE ADDRESS TO DISPATCH DATA
CALL (P3)
JRST SYSTK1
;COMMA TYPED..
SYSSUB: CRRX <Carriage return to enter subcommands, or another SYSTAT argument>
JRST SYSTK1 ;NO CR AFTER COMMA, NOT TIME FOR SUBCOMMANDS
JRST SYSUB1 ;COMMA CR, SO GO GET SUBCOMMANDS
;HERE ON AN ERROR. "SYS:" IS A SPECIAL CASE BECAUSE IT LOOKS LIKE THE START
;OF A FILESPEC. IF THE SPEC IS ILLEGAL CONTROL GETS TO SYSTAT. BUT THE
;"INVALID SYSTAT ARGUMENT" MESSAGE IS PRETTY HOSTILE, SO THE KLUGE BELOW
;TELLS THE USER IT'S A FILESPEC ERROR, WHICH IT PROBABLY IS.
SYSNX: MOVE A,CBUF ;GET WHAT WAS TYPED
TRZ A,377 ;KEEP ONLY THE FIRST FOUR CHARACTERS
CAMN A,[ASCIZ /SYS:/] ;SPECIAL MESSAGE IF IT'S A BOGUS DEVICE NAME
ERROR <Unrecognized command - Bad filespecs - "SYS:">
CMERRX <Invalid SYSTAT argument>
SYSUB1: SUBCOM $SYSTB
SYSTS0: TXNN Q1,SY%CLS ;[7.1076] User asking for class stuff?
IFSKP. ;[7.1076] If so,
TXNE Q1,SY%NOD ;[7.1076] Nodes specified?
IFSKP. ;[7.1076] If not,
CALL CLSON ;YES, MAKE SURE CLASS SCHEDULING IS ON
CAIA ;NO!
JRST SYSSS ;[7.1076] Yes
TXNN Q1,SY%ALL ;DON'T COMPLAIN IF HE SAID "ALL"
ETYPE <%%Class scheduling is off%_>
TXZ Q1,SY%CLS ;PRETEND HE NEVER ASKED FOR CLASS STUFF
ELSE. ;[7.1100] If considering remote jobs,
CALL CHCLAS ;[7.1100] (/) See if class scheduling is on anywhere
ANNSK. ;[7.1100] If no one is running class scheduling,
TXNN Q1,SY%ALL ;[7.1131] Don't complain if he said "ALL"
ETYPE <%%Class scheduling is off on specified systems%_>
TXZ Q1,SY%CLS ;[7.1100] We won't display class scheduling items
TXO Q1,SY%NOD ;[7.1100] Turn node back on
ENDIF.
ENDIF.
SYSSS: SKIPN A,SYSJFN ;SPECIAL OUTPUT JFN?
JRST SYSNFL ;NO!
LDF B,OF%WR ;WRITE
CALL $OPEN7 ;OPEN, 7 BIT BYTES, MODE 0.
MOVE A,SYSJFN ;NOW REDIRECT COJFN
MOVEM A,COJFN ;(MUST WAIT UNTIL AFTER $OPEN7 SINCE $IOCHK WOULD CIRCUMVENT THE OPENF!)
SYSNFL: TXNN Q1,SY%JOB!SY%NJB ;IF NEITHER JOB NOR NON-JOB NOR DEBUG
TXO Q1,SY%JOB!SY%NJB ;THEN DEFAULT TO JOB AND NON-JOB
TXNN Q1,SY%HED!SY%NHD ;IF HEADER NOT DECIDED,
TXO Q1,SY%HED ;DEFAULT TO HEADER
TXNE Q1,SY%NOD ;[7.1089] No reason for this unless node stuff
CALL CSHJOB ;[7.1089] (/) Now get job cache setup and
;[7.1089] Setup INFCIN table for NODPRT
TXNE Q1,SY%NJB
CALL SYPART ;TYPE SYSTEM PART
TXNE Q1,SY%JOB
CALL JBPART ;TYPE JOB LINES
RET
SYPART: SAVEAC <Q1> ;DON'T CLOBBER Q1 (READT DOES SO)
PRINT " "
GTAD
MOVE B,A
CAMN B,[-1]
MOVSI B,1 ;DO SAME AS %A IF NO DATE
MOVE A,COJFN
MOVX C,OT%DAY!OT%SCL
ODTIM ;CAN'T USE %D BECAUSE WE WANT DAY OF WEEK
TXNE Q1,SY%NOD ;[7.1076] Node stuff?
CALLRET NODPRT ;[7.1076] If so, all bets are off
ETYPE < Up %K%%_ %I Jobs Load av >
HRROI A,-1 ;WE WANT LOADS FOR CURRENT JOB'S CLASS
CALL GLOADS ;GET LOAD AVERAGES
CAIL A,0 ;CLASS SCHEDULING ON?
ETYPE <(class %1Q) >
ETYPE <%2Q %3Q %4Q%%_%%_>
MOVEI A,.SFOPR ;READ OPR STATUS
TMON
CAIN B,0
ETYPE < No operator in attendance%_%%_>
SETZ D,
GTB .DBUGS ;READ DBUGSW
JUMPE A,SYDBG1 ;0=NORMAL, DON'T PRINT
HRROI B,[ASCIZ/ System is stand-alone/] ;ASSUME THIS
CAIN A,1 ;1=REMEDIAL
HRROI B,[ASCIZ / System is remedial/]
ETYPE <%2M%%_%%_>
SYDBG1: CALL SYSDWN ;PRINT DOWN-TIME INFO
RET
SYSDWN::MOVEI D,0 ;GET ITEM 0 FROM DWNTIM TABLE
GTB .DWNTI
JUMPE A,R ;DO NOTHING IF NOT SET
CAMN A,[-1] ;IS SYSTEM SHUTDOWN
JRST [ ETYPE < System is shut down>
JRST SYSDW1] ;YES, TYPE MESSAGE
ETYPE < System shutdown scheduled for %1D %E>
SYSDW1: MOVEI D,1 ;GET ITEM 1
GTB .DWNTI
CAIE A,0
ETYPE <,%_ Up again at %1D %E>
ETYPE <%_%%_>
RET
;[7.1076]
;Routine to handle the header when SYS NODE was given. Loop over
;each node in NODMSK and do header for them.
;
; Called with:
; no specific arguments
; CALL NODPRT
;
; Returns:
; +1 - Always, with stuff output
NODPRT: SAVEAC <P1,P2> ;We are going to use these at our leisure
STKVAR <WRKNOD,TMPNOD> ;[7.1100] Temp storage
ETYPE <%_> ;Start a new line
SETZ P1, ;Our loop counter
HLRZ P2,CFGBLK ;[7.1131] Our loop fence
DO.
AOS P1 ;Do the first CI node
HLRZ A,CFGNOD(P1) ;Get me a CI node number
MOVE C,BITS(A) ;Get its bit setting
TDNN C,NODMSK ;Is this node in our mask?
JRST NODPR1 ;No, next node
MOVEM C,TMPNOD ;[7.1100] Save bit setting
MOVE B,INFCIN ;Get count
DO. ;See if this node is doing INFO%
SOSG B ;Done checking?
IFSKP. ;Nope,
CAMN A,INFCIN(B) ;Is this the node we want?
EXIT. ;If so, good, he is doing INFO%
JRST TOP. ;Not done checking yet
ENDIF.
CALL NOINF ;[7.1100] (A/) Say not available for this node
MOVE C,TMPNOD ;[7.1100] Get node bit back
ANDCAM C,NODMSK ;Node is not supplying information for us
JRST NODPR1 ;So ignore it and try others
ENDDO.
MOVEM A,WRKNOD ;Here's the node we are working on
MOVE A,CFGBLK(P1) ;Get the node name
PRINT " " ;Make first column a space
MOVEI B,6 ;Make sure we do 6 characters
DO. ;Do the characters
ILDB C,A ;Get a character
ETYPE <%3\> ;Do a character
JUMPE C,ENDLP. ;Null? Yes, fill in remaining spaces
SOJG B,TOP. ;Keep doing characters
ENDDO.
SKIPG B ;More characters to do?
IFSKP. ;If so,
DO. ;Print them out
PRINT " " ;Here's a space
SOJG B,TOP. ;Do more
ENDDO.
ENDIF.
ETYPE < Up > ;Prepare user for uptime
MOVEI A,INFBLK ;Return uptime here
MOVE B,[.INTIM,,.INMIN] ;Here's function and length
MOVEM B,.INFUN(A) ;Save it
MOVE B,WRKNOD ;This is the CI node we are working on
MOVEM B,.INCID(A) ;Save in block
INFO% ;Get uptime
ERJMP CJERR ;Meaningful error just happened
MOVE B,.INAC2(A) ;Get our divisor
MOVE A,.INAC1(A) ;Now get up time
IDIV A,B ;Get HH:MM:SS
CALL TOUT ;(A/) Display it
MOVEI A,INFBLK ;Now find out X+Y jobs
MOVE B,[.INGTB,,INFLEN] ;Here's the function
MOVEM B,.INFUN(A) ;Stash it
MOVE B,[57,,.SYSTA] ;Now get the GETAB% word
MOVEM B,.INAC1(A) ;Here ya go
INFO% ;Get me the jobs
ERJMP CJERR ;Ungowa
HRRZ B,.INAC1(A) ;Get count of user jobs
HLRZ C,.INAC1(A) ;Get count of operator jobs
ETYPE < %2Q+%3Q Jobs Load av > ;Do job count
MOVEI A,INFBLK ;Now get load averages
MOVE B,[.INGTB,,INFLEN] ;GETAB% is our JSYS
MOVEM B,.INFUN(A) ;Make sure the JSYS knows
MOVE B,[14,,.SYSTA] ;1 minute load average
MOVEM B,.INAC1(A) ;Save in argument block
INFO% ;Get that load av
ERJMP CJERR ;See you in your dreams
MOVE B,.INAC1(A) ;Get the load average
ETYPE <%2= > ;Show it
MOVE B,[15,,.SYSTA] ;5 minute load average
MOVEM B,.INAC1(A) ;Put in argument block
INFO% ;Get the load av
ERJMP CJERR ;Hrumph
MOVE B,.INAC1(A) ;Get the 5 min load av
ETYPE <%2= > ;Show it
MOVE B,[16,,.SYSTA] ;Get 15 minute load ave
MOVEM B,.INAC1(A) ;Tell JSYS
INFO% ;Do it
ERJMP CJERR ;Flunked
MOVE B,.INAC1(A) ;Get it for display
ETYPE <%2=%%_> ;Show it and do CRLF
MOVE B,[.INTMN,,INFLEN] ;Get operator attendance status
MOVEM B,.INFUN(A) ;Do remote TMON%
MOVEI B,.SFOPR ;Here's our TMON% function
MOVEM B,.INAC1(A) ;Give it to remote
INFO% ;Read opr status
ERJMP CJERR ;Take a trip to Garkland
SKIPN .INAC2(A) ;Operator there?
ETYPE < No operator in attendance%_> ;Nope
MOVE B,[.INGTB,,INFLEN] ;Now we want the debug sw setting
MOVEM B,.INFUN(A) ;Save our new function
MOVEI B,.DBUGS ;Get DBUGSW
MOVEM B,.INAC1(A) ;For remote system to do for us
INFO% ;Get the setting
ERJMP CJERR
MOVE C,.INAC1(A) ;Get remote DBUGSW setting
JUMPE C,SYNODB ;0=Normal, don't print
HRROI B,[ASCIZ / System is stand-alone/] ;Assume this
CAIN C,1 ;1=Remedial
HRROI B,[ASCIZ / System is remedial/]
ETYPE <%2M%%_> ;Display it
SYNODB: MOVEI B,.DWNTI ;Get downtime if there is downtime
MOVEM B,.INAC1(A) ;Make it remote
INFO% ;Get it
ERJMP CJERR ;Poof
SKIPN C,.INAC1(A) ;Get returned downtime
IFSKP. ;If downtime,
CAME C,[-1] ;See if really down
IFSKP. ;If so,
ETYPE < System is shut down%_>
JRST NODPR1 ;Go on
ENDIF.
ETYPE < System shutdown scheduled for %3D %E>
MOVE B,[1,,.DWNTI] ;Find out when it is up again
MOVEM B,.INAC1(A) ;Here for JSYS
INFO% ;Get next up
ERJMP CJERR ;Wham
SKIPE C,.INAC1(A) ;Get next uptime
ETYPE <,%_ Up again at %3D %E>
ETYPE <%_> ;Neaten things up
ENDIF.
NODPR1: CAME P1,P2 ;Have we done enough?
JRST TOP. ;No
ENDDO.
ETYPE <%_> ;Put in blank line
RET ;And back to caller
ENDSV.
;LOOP TO TYPE TSS JOB #, TTY #, USER FOR EACH JOB
JBPART: TLZ Z,F1+F2 ;CLEAR LOCAL FLAGS
MOVSI A,(RC%EMO) ;EXACT MATCH ONLY
HRROI B,[ASCIZ /OPERATOR/]
RCUSR ;GET OPERATOR'S USER NUMBER
TLNE A,(RC%NOM+RC%AMB) ;GOT IT?
MOVEI C,-1 ;IF NO SUCH, USE -1
MOVEM C,SYSDIR
TLZ Z,F3 ;NO JOBS PRINTED YET
SYST9A: SETO D,
GTB .JOBRT ;GET # POSSIBLE JOBS
HRLZ D,A ;XWD AOBJN COUNT, JOB #
MOVE A,NODMSK ;[7.1139] Get node mask
MOVEM A,SYJOBM ;[7.1139] And init the SYSJOB node mask
;TOP OF LOOP
SYST2: MOVEM D,JNX ;REMEMBER JOB NUMBER COUNTER
SETZM SISTAS ;CLEAR USER NAME STRING POINTER
SETZM SISLDS
SETZM SISCDS
HRRZ A,JNX
CALL NODCHK ;[7.1076] (A/) Check out job, see if remote
JRST SYST9 ;[7.1076] Job not logged in as far as we can tell
SETZM .JIBAS ;[4412] Prepare to clean house
HRLI B,.JIBAS ;[4412] Prepare this for BLT
HRRI B,1+.JIBAS ;[4412] Start with first word
BLT B,JIBLN+.JIBAS ;[4412] Get out the vacuum cleaner
HRRZI B,.JIBAS ;[4412] Store into correct block
HRLI B,-JIBLN ;LENGTH OF JOB INFO BLOCK
MOVEI C,0 ;START WITH FIRST ENTRY
TLNE Z,F4 ;[7.1076] Is job remote?
IFSKP. ;[7.1076] If not,
GETJI% ;[7.1076] Local stuff
IFJER. ;[7.1076] When it no worky
CAIE A,GTJIX4 ;[7.1076] No such job?
JRST JERR ;[7.1076] No, complain
JRST SYST9 ;[7.1076] Yes, skip it
ENDIF. ;[7.1076]
ELSE. ;[7.1076] We want remote GETJI%
MOVEI C,INFBLK ;[7.1076] INFO% block
MOVE D,[.INGJI,,INFLEN] ;[7.1076] Function and length
MOVEM D,.INFUN(C) ;[7.1076] Save it
MOVE D,CURNDN ;[7.1076] Get CI node to work on
MOVEM D,.INCID(C) ;[7.1076] Here's the node
MOVEM A,.INAC1(C) ;[7.1076] Save job number
MOVEM B,.INAC2(C) ;[7.1076] And argument block
SETZM .INAC3(C) ;[7.1076] From the top
MOVEI A,INFBLK ;[7.1076] Put arg block in correct AC
INFO% ;[7.1076] Go get my some information
ERJMP CJERR ;[7.1076] We tried
TXZN A,IN%RER ;[7.1076] Remote error?
IFSKP. ;[7.1076] If so,
CAIE A,GTJIX4 ;[7.1076] No such job?
JRST JERR ;[7.1076] No something real
JRST SYST9 ;[7.1076] Yes, ignore skip it
ENDIF. ;[7.1076]
ENDIF. ;[7.1076]
SKIPGE .JIRT+.JIBAS ;NEG RUN TIME MEANS NO JOB
JRST SYST9 ;SO SKIP IT
TXNN Q1,SY%IME ;DID USER SAY "NO ."?
JRST [ HRRZ B,JNX ;YES, SEE WHICH JOB WE'RE ON
CAME B,JOBNO ;IS IT OURSELF?
JRST .+1 ;NO, SO DISPLAY IT
JRST SYST9] ;YES, SO SKIP IT
MOVE A,.JIJNO+.JIBAS ;GET JOB NUMBER
MOVEM A,.SAJOB+SYCLB ;TELL MONITOR WHICH JOB TO INVESTIGATE
MOVEI A,SYCLN ;SET UP BLOCK SIZE FOR SKED%
MOVEM A,.SACNT+SYCLB
MOVEI A,.SKRJP ;SAY READ JOB PARAMETERS
MOVEI B,SYCLB ;POINT TO BLOCK
TXNN Q1,SY%CLS ;[7.1076] Don't bother doing SKED% if class not wanted
IFSKP. ;[7.1076] If class wanted,
TLNE Z,F4 ;[7.1076] And local job,
IFSKP. ;[7.1076] Then
SKED% ;[7.1076] Read the info
IFJER. ;[7.1076] If JSYS failed us,
CALL DGETER ;[7.1076] (/A) See why
CAIE A,ARGX15 ;[7.1076] "Job is not logged in"?
CALL JERR ;[7.1076] No, unexpected error
JRST SYST9 ;[7.1076] Yes, job logged out, skip it
ENDIF. ;[7.1076]
ENDIF. ;[7.1076]
ENDIF. ;[7.1076]
;CHECK FOR PASS 1 OR 2
SETO B, ;ASSUME NOT OPR
MOVE A,SYSDIR
CAMN A,.JIUNO+.JIBAS
SETZ B, ;FLAG OPR
TLNE Z,F2
SETCA B, ;REVERSE TEST FOR PASS 2
JUMPE B,SYST9 ;PASS 1, SKIP OPR. PASS 2, DO OPR
;CHECK IF REQUESTED JOB
HRLI A,-SYSTAL
HRRI A,SYSTAK
CAMN A,SFRAME ;ANY ARGS?
JRST SYST2Y
SYST2A: MOVE B,(A) ;GET INDEX INTO FUNCTION TABLE
MOVE C,1(A) ;GET ARG
XCT [ JRST SYST2D ;[7.1137] Job number was SSTACKed
CAMN C,.JITNO+.JIBAS ;[7.1137] Line number was SSTACKed
JRST SYST2C ;[7.1137] Directory name was SSTACKed
JRST SYS2U ;[7.1137] User name was SSTACKed
JRST SYSPRG ;[7.1137] Program name SSTACKed
JRST SYSWLD](B) ;[7.1137] Handle non-ex user
JRST SYST2Z ;MATCH
SYST2B: ADD A,[2,,2]
CAME A,SFRAME
JRST SYST2A
JRST SYST9 ;NO MATCH
SYSPRG: CAMN C,.JIPNM+.JIBAS ;CORRECT PROGRAM NAME?
JRST SYST2Z ;YES
JRST SYST2B
SYS2U: TLNN Z,F4 ;[7.1076] Is job of remote flavor?
IFSKP. ;[7.1076] If so,
MOVEM A,STKPTR ;[7.1076] Save this
HRROI A,ATMBUF ;[7.1076] Put username in ATMBUF
MOVE B,C ;[7.1076] Here's the user number
DIRST% ;[7.1076] Get username
IFJER. ;[7.1076] If error,
MOVE A,STKPTR ;[7.1076] Restore this
JRST SYST2B ;[7.1076] If failure, then assume no match
ENDIF.
HRROI A,ATMBUF ;[7.1076] Check to see if the one we are looking for
HRROI B,UNAME ;[7.1076] Matches the current job
STCMP% ;[7.1076] Is this the user we want?
ERJMP SYST2B ;[7.1076] Must not be
EXCH A,STKPTR ;[7.1076] Swap these
SKIPE STKPTR ;[7.1076] Is this the user we are looking for?
JRST SYST2B ;[7.1076] No, bypass then
JRST SYST2Z ;[7.1076] Yes, display this job then
ENDIF. ;[7.1076]
MOVEI B,SISTAS ;CHECK AGAINST CURRENT USER NUMBER/STRING
MOVE D,.JIUNO+.JIBAS
CALL SYSDUC
JRST SYST2Z ;SUCCESS, TYPE OUT JOB
JRST SYST2B ;FAILURE, NO MATCH
SYST2C: TLNN Z,F4 ;[7.1076] Is job of remote flavor?
IFSKP. ;[7.1076] If so,
MOVEM A,STKPTR ;[7.1076] Save this for now
HRROI A,ATMBUF ;[7.1076] Put username in ATMBUF
MOVE B,C ;[7.1076] Here's the user number
DIRST% ;[7.1076] Get username
IFJER. ;[7.1076] Assume no match
MOVE A,STKPTR ;[7.1076] Get this back
JRST SYST2B ;[7.1076] If failure, then assume no match
ENDIF. ;[7.1076]
HRROI A,ATMBUF ;[7.1076] Check to see if the one we are looking for
HRROI B,UNAME ;[7.1076] Matches the current job
STCMP% ;[7.1076] Is this the user we want?
ERJMP SYST2B ;[7.1076] Must not be
EXCH A,STKPTR ;[7.1076] Pointer restoration
SKIPE STKPTR ;[7.1076] Is this the user we are looking for?
JRST SYST2B ;[7.1076] No, bypass then
JRST SYST2Z ;[7.1076] Yes, display this job then
ENDIF. ;[7.1076]
MOVEI B,SISLDS ;CHECK AGAINST LOGGED-IN DIR
MOVE D,.JILNO+.JIBAS
CALL SYSDUC
JRST SYST2Z ;SUCCESS, GO TYPE JOB
TXNN Q1,SY%CON ;SHOWING CONNECTED DIR'S?
JRST SYST2B
TLNN Z,F4 ;[7.1076] Is job of remote flavor?
IFSKP. ;[7.1076] If so,
MOVEM A,STKPTR ;[7.1076] Save for later
HRROI A,ATMBUF ;[7.1076] Put dir name in ATMBUF
MOVE B,C ;[7.1076] Here's the user number
DIRST% ;[7.1076] Get username
IFJER. ;[7.1076] If goofed,
MOVE A,STKPTR ;[7.1076] Get this back
JRST SYST2B ;[7.1076] If failure, then assume no match
ENDIF.
HRROI A,ATMBUF ;[7.1076] Check to see if the one we are looking for
HRROI B,DIRN ;[7.1076] Matches the current job
STCMP% ;[7.1076] Is this the directory we want?
ERJMP SYST2B ;[7.1076] Must not be
EXCH A,STKPTR ;[7.1076] Restore this
SKIPE STKPTR ;[7.1076] Is this the user we are looking for?
JRST SYST2B ;[7.1076] No, bypass then
JRST SYST2Z ;[7.1076] Yes, display this job then
ENDIF. ;[7.1076]
MOVEI B,SISCDS ;CHECK AGAINST CONNECTED DIR
MOVE D,.JIDNO+.JIBAS
CALL SYSDUC
JRST SYST2Z ;SUCCESS
JRST SYST2B ;FAILURE
SYSWLD: SKIPN .JIUNO+.JIBAS ;[7.1137] Job logged in?
JRST SYST9 ;[7.1137] No, so skip this job
MOVEM A,STKPTR ;[7.1137] Boy does this get bashed
TLNE Z,F4 ;[7.1137] Is job remote or local?
IFSKP. ;[7.1137] If local,
HRROI A,ATMBUF ;[7.1137] Use this for work area
MOVE B,.JIUNO+.JIBAS ;[7.1137] Get user number
DIRST% ;[7.1137] Get user name string
ERJMP SYSWD1 ;[7.1137] We won't get a match this way
MOVE B,C ;[7.1137] Wild string was in C
HRROI C,ATMBUF ;[7.1137] This is what to compare it too
ELSE. ;[7.1137] If job remote,
MOVE B,C ;[7.1137] Wild string was in C, must be in B
HRROI C,UNAME ;[7.1137] Here's remote user name
ENDIF. ;[7.1137]
MOVEI A,.WLSTR ;[7.1137] Compare 2 strings (1 may be wild)
WILD% ;[7.1137] See if strings are near match
ERJMP CJERR ;[7.1137] We have problems...
SKIPN A ;[7.1137] Do we have a sucker to display?
JRST SYST2Z ;[7.1137] Yes we do. Show it
SYSWD1: MOVE A,STKPTR ;[7.1137] Must restore this for that wonderful routine SSTACK
JRST SYST2B ;[7.1137] On to next SSTACKed item (ARGH!)
;ROUTINE TO CHECK CURRENT DIRECTORY/USER AGAINST DIRECTORY/USER ARGUMENT
;ACCEPTS: B/ ADDRESS OF POINTER TO CURRENT DIRECTORY/USER STRING
; C/ DIRECTORY/USER ARGUMENT (NUMBER OR 'WILD' BYTE POINTER)
; D/ CURRENT DIRECTORY/USER NUMBER
;RETURNS: +1 SUCCESS, CURRENT NUMBER/STRING MATCHES ARG
; +2 FAILURE, CURRENT NUMBER/STRING DOES NOT MATCH ARG
SYSDUC: STKVAR <ASAV,DUSTRP,DUCARG>
CAMN C,D ;DOES IT MATCH ARG?
RET ;YES, GIVE SUCCESS RETURN
HRRZM B,DUSTRP ;SAVE AC B
LOAD B,NMFLG,C ;CHECK TO SEE IF ARG IS DIR/USER NUMBER
CAIN B,NUMVAL ;IS IT?
RETSKP ;YES, GIVE FAILURE RETURN
MOVEM A,ASAV ;SAVE AC'S A AND C
MOVEM C,DUCARG
SKIPE A,@DUSTRP ;HAVE WE GOTTEN DIR/USER STRING BEFORE?
JRST SYSDU1 ;YES, SKIP GETTING IT
HRROI A,ATMBUF ;PUT IT IN ATOM BUFFER TEMPORARILY
MOVE B,D
TLNE Z,F4 ;[7.1076] Job remote?
IFSKP. ;[7.1076] If so,
DIRST% ;[7.1076] Get locally
IFJER. ;[7.1076] If failure,
MOVE A,ASAV ;[7.1076] Restore these ACs
MOVE C,DUCARG ;[7.1076]
RETSKP ;[7.1076] If error, it's no match
ENDIF. ;[7.1076]
ELSE. ;[7.1076] Job is remote, get information
MOVEI A,INFBLK ;[7.1076] Here's where the stuff goes
MOVEM B,.INAC2(A) ;[7.1076] Save dir number
MOVE B,[.INDST,,INFLEN] ;[7.1076] This function
MOVEM B,.INFUN(A) ;[7.1076] Save for JSYS
HRROI B,ATMBUF ;[7.1076] String goes here
MOVEM B,.INAC1(A) ;[7.1076] Tell JSYS
INFO% ;[7.1076] Get it
ERJMP CJERR ;[7.1076] Node vamoosed
TXZN A,IN%RER ;[7.1076] Remote error?
IFSKP. ;[7.1076] If so,
MOVE A,ASAV ;[7.1076] Restore these ACs
MOVE C,DUCARG ;[7.1076]
RETSKP ;[7.1076] If error, it's no match
ENDIF. ;[7.1076]
ENDIF. ;[7.1076]
HRROI A,ATMBUF ;[7.1076] Copy string to free area
CALL BUFFS
MOVEM A,@DUSTRP ;SAVE THE DIR/USER STRING POINTER
SYSDU1: MOVE C,A ;PUT CUR DIR/USER STRING PTR IN N-W AC
SETZ A, ;NO FLAGS TO WILD%
MOVE B,DUCARG ;PUT DIR/USER ARG STRING PTR IN WILD AC
WILD% ;CHECK CURRENT DIR/USER STRING
ERJMP JERR ;THIS IS A WILD ERORR!?
TXNN A,WL%NOM ;WAS THERE A MATCH?
TDZA B,B ;YES
SETO B, ;NO
MOVE A,ASAV ;RESTORE REGISTERS A AND C
MOVE C,DUCARG
JUMPN B,RSKP ;IF NO MATCH, SKIP RETURN
RET ;IF MATCH, REGULAR RETURN
SYST2D: HRRZ D,JNX
CAMN C,D ;CURRENT JOB?
JRST SYST2Z
TXNN Q1,SY%CJB
JRST SYST2B
CAMN C,.JICPJ+.JIBAS
JRST SYST2Z
JRST SYST2B
SYST2Y: MOVE D,JNX
TRNE D,-1
JRST SYST2Z
SKIPGE .JITNO+.JIBAS
JRST SYST9 ;SKIP JOB 0 FOR NORMAL PRINT IF DETACHED
;HAVE A REAL JOB #. PRINT IT.
SYST2Z: TLOE Z,F1 ;TYPE HEADER FIRST TIME.
JRST SYSTS2
TXNN Q1,SY%HED
JRST SYSTS2
ETYPE < Job >
TXNE Q1,SY%CJB
ETYPE < CJB>
TXNE Q1,SY%TTY
ETYPE < Line>
TXNE Q1,SY%SUB
ETYPE < Program>
TXNE Q1,SY%NOD ;[7.1076] Want node name?
ETYPE < Node > ;[7.1076] Yes, put it in header
TXNE Q1,SY%STA
ETYPE < State>
TXNE Q1,SY%CT ;[4412] How about connect time?
ETYPE < Connected> ;[4412] Yes, prefix the header
TXNE Q1,SY%TIM
ETYPE < Time >
TXNE Q1,SY%CLS ;CLASS INFO REQUESTED?
ETYPE < Cls Shr Use>
TXNE Q1,SY%LIM
ETYPE < Limit >
TXNN Q1,SY%USR
JRST SYST2U
ETYPE < User>
TXNE Q1,SY%CON
UETYPE [ASCIZ /, <Directory>/]
TXNN Q1,SY%4NH ;DOING FOREIGN HOST?
JRST SYST2U ;NO, SKIP THIS THEN
TXNN Q1,SY%CON ;IF PREVIOUS HEADING NOT TYPED,
ETYPE < > ;COLUMNIZE THIS BETTER
MOVE A,COJFN ;GET CURRENT COLUMN POSITION
RFPOS ; ..
ERJMP [SETZ B, ;IF NOT TERMINAL, ASSUME 0
JRST .+2] ; *** NOTE .+2, NOT .+1 ***
ADDI B,2 ;ACCOUNT FOR LEADING SPACES IN NEXT ETYPE
HRRZM B,HDRPOS ;SAVE FOR LATER
ETYPE < Origin>
SYST2U: ETYPE <%_>
TLZ Z,F3 ;NO NEW LINE AFTER TITLE
SYSTS2: TLZE Z,F3 ;SEPARATE USER FROM OPR?
ETYPE <%_>
HRRZ A,JNX
CALL NUM4 ;PRINT 4-COLUMN NUMBER
GJINF
MOVEI B," " ;ASSUME NOT CURRENT JOB
HRRZ D,JNX
CAMN C,D ;OUR JOB?
MOVEI B,"*" ;YES, INDICATE
PRINT @B ;SPACE OR STAR
;CONTROLLING JOB OF PTY
TXNN Q1,SY%CJB
JRST SYST4A
SKIPGE A,.JICPJ+.JIBAS
JRST [ TYPE < >
JRST SYST4A]
MOVX B,NO%LFL!FLD(4,NO%COL)!<5+5> ;LEADING FILLER, 4 COLUMNS, DECIMAL
CALL SYNUM
SYST4A:
;"DET" OR "TTY N"
TXNN Q1,SY%TTY
JRST SYST4
SKIPGE A,.JITNO+.JIBAS
JRST [ TYPE < DET>
JRST SYST4]
MOVX B,NO%LFL!FLD(5,NO%COL)!8 ;LEADING FILLER, 5 COLUMNS, OCTAL
CALL SYNUM
SYST4:
;SYSTAT...
;SUBSYSTEM NAME
TXNN Q1,SY%SUB
JRST SYST8
SKIPN A,.JIPNM+.JIBAS
MOVE A,.JISNM+.JIBAS ;IF NO PROGRAM NAME, USE SUBSYSTEM NAME
ETYPE < %1'>
MOVEI B,0
JUMPE A,[TYPE < > ;SIX SPACES IF 0 NAME
JRST SYST8]
SYSSU: LSHC A,-6 ;PAD TO EXACTLY SIX CHARACTERS
JUMPN B,SYST8 ;LEAVE LOOP IF ENOUGH SPACES
PRINT " " ;PRINT A SPACE
JRST SYSSU
SYST8: TXNN Q1,SY%NOD ;[7.1076] Want node name column?
JRST SYST81 ;[7.1076] No
PRINT " " ;[7.1076] Leading space
SKIPN D,CURNOD ;[7.1076] Do we have a current node?
IFSKP. ;[7.1076] If so,
PRINT " " ;[7.1076] Must make columns line up
MOVEI B,6 ;[7.1076] Make sure we do 6 characters
DO. ;[7.1076] Do node name
ILDB A,D ;[7.1076] Get a node character
ETYPE <%1\> ;[7.1076] Show character
JUMPE A,SPCIT ;[7.1076] All node characters done?
SOJG B,TOP. ;[7.1076] Done all characters?
ENDDO. ;[7.1076]
SPCIT: SOJL B,SYST81 ;[7.1089] Need some spaces?
PRINT " " ;[7.1076] Do one
JRST SPCIT ;[7.1076] Keep spacing until all done
ELSE. ;[7.1076] Else,
TYPE < > ;[7.1076] Leave blank if no node
ENDIF. ;[7.1076]
SYST81: TXNN Q1,SY%STA ;[7.1076]
JRST SYST8A
TLNE Z,F4 ;[7.1076] Remote job?
IFSKP. ;[7.1076] If not,
SKIPGE D,.JITNO+.JIBAS ;[7.1076]
JRST SYST8B ;[7.1076] If no terminal, say running
GTB .TTYJO ;[7.1076] Get terminal word
HRRZ A,A ;[7.1076]
ELSE. ;[7.1076] Run state is in SYSTAT block
MOVEI A,INFSYS ;[7.1076] Argument block is here
HRRZ A,.SYSTT(A) ;[7.1076] Get state
ENDIF. ;[7.1076]
CAIE A,-1 ;OTHER THAN -1 MEANS FORK WAITING
SKIPA B,[-1,,[ASCIZ/ TI /]]
SYST8B: HRROI B,[ASCIZ/ RUN /]
ETYPE <%2M>
SYST8A: TXNN Q1,SY%CT ;[4412] Want to see connect time?
IFSKP. ;[4412] If so,
TLNE Z,F4 ;[4412] Remote job?
IFSKP. ;[4412] If not,
MOVE B,.JICT+.JIBAS ;[4412] Retrieve connect time from block
ELSE. ;[4412] Else, get connect time from INFO% block
MOVE B,.SYJCT+INFSYS ;[4412] Here's the connect time
ENDIF. ;[4412]
IDIVI B,^D1000 ;[4412] Make sure we have seconds
MOVE A,COJFN ;[4412] Output goes here
IDIVI B,^D3600 ;[4412] Get hours
PUSH P,C ;[4412] Save remainder for later (minutes and seconds)
MOVX C,NO%LFL!FLD(4,NO%COL)!FLD(^D10,NO%RDX) ;[4412] Want base 10 output
NOUT% ;[4412] Show us hours
ERCAL JERRC ;[4412] If error
MOVEI B,":" ;[4412] No slam seperator
BOUT% ;[4412]
ERCAL JERRC ;[4412] Report problems
POP P,B ;[4412] Get remainder back
IDIVI B,^D60 ;[4412] And find out minutes
PUSH P,C ;[4412] Save seconds
MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D10,NO%RDX) ;[4412] 2 columns
NOUT% ;[4412] And leading zeros for minutes
ERCAL JERRC ;[4412] Ooops
MOVEI B,":" ;[4412] Another seperator
BOUT% ;[4412]
ERCAL JERRC ;[4412]
POP P,B ;[4412] Retrieve seconds
NOUT% ;[4412] Display seconds
ERCAL JERRC ;[4412]
ENDIF. ;[4412]
TXNN Q1,SY%TIM
JRST SYSTS3
MOVE A,.JIRT+.JIBAS
ETYPE < %1B>
SYSTS3: TXNN Q1,SY%CLS ;PRINT CLASS STUFF?
JRST SYSECL ;NO
;CLASS SCHEDULER INFO
MOVE A,CURNDN ;[7.1140] Get current node we are working on
MOVE A,BITS(A) ;[7.1140] See if it is doing class scheduling
TXNE Q1,SY%NOD ;[7.1140] If NODE was typed
TDNE A,CLSMSK ;[7.1140] and class scheduling is off
IFSKP. ;[7.1140] at this node, then...
ETYPE < > ;[7.1140] leave fields blank
JRST SYSECL ;[7.1140] and go on
ENDIF. ;[7.1140]
TLNE Z,F4 ;[7.1076] Local job?
IFSKP. ;[7.1076] If so,
MOVE A,.SAJCL+SYCLB ;[7.1076] Get class
CALL NUM4 ;[7.1076] (A/) Print as four columns
DMOVE A,.SAJSH+SYCLB ;[7.1076] Get share and utilization
ELSE. ;[7.1076] Job was remote
MOVEI A,INFSYS ;[7.1076] Time to get class
MOVE A,.SYCLS(A) ;[7.1076] Here's the class
CALL NUM4 ;[7.1076] (A/) Print 4 cloumns
MOVEI A,INFSYS ;[7.1076] Now get share and utilization
DMOVE A,.SYSHR(A) ;[7.1076] Here ya go
ENDIF. ;[7.1076]
ETYPE <%1=%%2=> ;[7.1076] Display share and utilization
SYSECL: TXNN Q1,SY%LIM
JRST SYSTS4
;LIMIT
ETYPE < >
SKIPG A,.JIRTL+.JIBAS
JRST [ ETYPE < >
JRST SYSTS4]
ETYPE <%1B>
;USER NAME OR "?" IF CONVERSION FAILS.
SYSTS4: TXNN Q1,SY%USR
JRST SYSTS5
ETYPE < >
SKIPE B,SISTAS ;HAVE WE GOT USER STRING ALREADY?
JRST [MOVE A,COJFN
SETZ C,
SOUT
JRST SYSTS7] ;YES, TYPE IT OUT
SKIPN B,.JIUNO+.JIBAS
JRST [ ETYPE <Not logged in>
JRST SYSTS5]
TLNE Z,F4 ;[7.1076] Remote job?
IFSKP. ;[7.1076] If so,
ETYPE <%2R> ;[7.1076] Then here's the user name
ELSE. ;[7.1076] Otherwise,
HRROI B,UNAME ;[7.1076] Here's the user name
ETYPE <%2M> ;[7.1076] Show it
ENDIF. ;[7.1076]
SYSTS7: TXNN Q1,SY%CON
JRST SYSTS5
MOVE B,.JIDNO+.JIBAS
CAMN B,.JILNO+.JIBAS
JRST SYSTS5
ETYPE <, >
SKIPE B,SISCDS ;DO WE HAVE STRING ALREADY?
JRST [MOVE A,COJFN
SETZ C,
SOUT
JRST SYSTS5] ;YES, TYPE IT OUT
TLNE Z,F4 ;[7.1076] Job like remote?
IFSKP. ;[7.1076] If local,
MOVE B,.JIDNO+.JIBAS ;[7.1076] Here's the directory number
ETYPE <%2R> ;[7.1076] Show name
ELSE. ;[7.1076] Else, we get directory name from
HRROI B,DIRN ;[7.1076] Here!
ETYPE <%2M> ;[7.1076] Show us the name
ENDIF. ;[7.1076]
SYSTS5: TXNN Q1,SY%4NH ;DOING FOREIGN HOST NAME?
JRST SYSTS6 ;NO, SKIP THIS STUFF THEN
TLNN Z,F4 ;[7.1100] Remote job?
IFSKP. ;[7.1100] Job is remote,
SKIPE ORGN ;[7.1100] Does job have an origin
JRST SYST5A ;[7.1100] Yes, ignore useless code and display it
JRST SYSTS6 ;[7.1100] No origin, don't tab out to origin field
ENDIF. ;[7.1100]
MOVEI A,.NTBAS ;GET ADR OF NTINF ARG BLOCK
MOVEI B,.NWNU1+1 ;LENGTH OF ARG BLOCK
MOVEM B,.NWABC(A)
MOVEI B,.NWRRH ;RETURN REMOTE HOST NAME FUNCTION CODE
MOVEM B,.NWFNC(A)
MOVE B,.JITNO+.JIBAS ;CONTROLLING TTY NUMBER OF JOB
JUMPL B,SYSTS6 ;HANDLE DETACHED LINES
TRO B,.TTDES ;MAKE THE LINE NUMBER A LINE DESIGNATOR
MOVEM B,.NWLIN(A) ;SAVE IT
SETZM HSTNAM ;[4412] Zero this out to start with
HRROI B,HSTNAM ;POINTER TO SAVE HOST NAME
MOVEM B,.NWNNP(A)
NTINF% ;GET NETWORK INFO ON THIS TERMINAL
ERJMP SYSTS6 ;IGNORE THE ERROR
MOVEI A,.NTBAS ;GET POINTER TO ARG BLOCK AGAIN
MOVE B,.NWTTF(A) ;GET FLAGS WORD
LDB C,[POINT 9,B,17] ;GET NETWORK TYPE
CAIN C,NW%NNT ;NON-NETWORK TERMINAL ?
JRST SYSTS6 ;YES
CAIE C,NW%TCP ;TCP ?
IFSKP.
MOVE D,TCPDEL ;SET UP HOST PREFIX AND SUFFIX
MOVEM D,HSTDEL
MOVEI C,.NWNNU(A) ;YES - GET ADDRESS OF NODE NUMBER
CALL TCPHST ;GO TYPE IT
JRST SYSTS6 ;PROBLEM
JRST SYST5A ;FINISH UP
ENDIF.
CAIE C,NW%DNA ;DECNET ?
IFSKP.
HRRZ C,B ;GET LINE TYPE
MOVE D,NRTDEL ;SET UP HOST PREFIX AND SUFFIX
CAIN C,NW%CH ;CTERM ?
MOVE D,CTMDEL ;SET UP HOST PREFIX AND SUFFIX
MOVEM D,HSTDEL
MOVEI C,.NWNNU(A) ;YES - GET ADDRESS OF NODE NUMBER
CALL DNAHST ;GO TYPE IT
JRST SYSTS6 ;PROBLEM
JRST SYST5A ;FINISH UP
ENDIF.
CAIE C,NW%LAT ;LAT ?
IFSKP.
MOVE D,LATDEL ;SET UP HOST PREFIX AND SUFFIX
MOVEM D,HSTDEL
MOVEI C,.NWNNU(A) ;GET ADDRESS OF NODE NUMBER WORDS
CALL LATHST ;GO TYPE THEM
JRST SYSTS6 ;PROBLEM
JRST SYST5A
ENDIF.
JRST SYSTS6 ;UNKNOWN NETWORK TYPE
SYST5A: MOVE A,COJFN ;GET CURRENT HORIZONTAL POSITION
RFPOS ; ..
ERJMP [MOVEI B,7777 ;NOT TERMINAL, ASSUME COLUMN OVERFLOW
JRST .+1]
HRRZS B ;DROP LINE NUMBER
MOVE A,HDRPOS ;GET DESIRED COLUMN NUMBER OF HOST COLUMN
SUB A,B ;COMPUTE DISTANCE THERE
SKIPG A ;RANGE CHECK...IS IT POSITIVE?
MOVEI A,2 ;NO SO DEFAULT IT TO TWO SPACES
CAIGE A,2 ;FORCE AT LEAST TWO SPACES
MOVEI A,2 ; ..
CAIL A,^D100 ;UNREASONABLY LARGE NUMBER?
MOVEI A,2 ;YES, USE 2 INSTEAD
PRINT " " ;TYPE ENOUGH SPACES TO LINE UP
SOJG A,.-1 ; ..
TLNN Z,F4 ;[7.1076] Remote job?
IFSKP. ;[7.1076] If so,
SKIPN ORGN ;[7.1076] Anything to speak of?
JRST SYSTS6 ;[7.1076] No, don't bother
HRROI B,ORGN ;[7.1076] Origin is here
ETYPE <%2M> ;[7.1076] Show it to us
JRST SYSTS6 ;[7.1076] And that's it
ENDIF. ;[7.1076]
HLRO A,HSTDEL ;GET HOST NAME PREFIX
ETYPE <%1\>
UETYPE HSTNAM ;TYPE THE NAME
HRRO A,HSTDEL ;GET HOST NAME PREFIX
ETYPE <%1\>
JRST SYSTS6
TCPDEL: [ASCIZ//],,[ASCIZ/(TCP)/] ;SET UP HOST PREFIX AND SUFFIX
NRTDEL: [ASCIZ//],,[ASCIZ/(NRT)/] ;SET UP HOST PREFIX AND SUFFIX
CTMDEL: [ASCIZ//],,[ASCIZ/(CTM)/] ;SET UP HOST PREFIX AND SUFFIX
LATDEL: [ASCIZ//],,[ASCIZ/(LAT)/] ;SET UP HOST PREFIX AND SUFFIX
DNAHST: SKIPE D,(C) ;[7.1008] GET DECNET NODE NUMBER
TXNN B,NW%NNN ;HAVE A NODE NAME ?
RETSKP ;YES
SKIPE HSTNAM ;[4412] No node name, but did NTINF% fill in anything?
RETSKP ;[4412] NTINF% did it for us
HRROI A,HSTNAM ;OUTPUT TO HSTNAM STRING
MOVEI C,^D10 ;OUTPUT RADIX IS DECIMAL
LDB B,[POINT 6,D,25] ;GET AREA OF DECNET NODE NUMBER
JUMPE B,DNAHS1 ;ZERO ? DON'T TYPE AREA
NOUT ;NO - THEN OUTPUT IT
ERJMP R
MOVEI B,"." ;PRINT A DOT
BOUT
DNAHS1: LDB B,[POINT 10,D,35] ;GET HOST NUMBER PART
NOUT
ERJMP R
RETSKP
LATHST: SAVEAC <Z>
TXNN B,NW%NNN ;HAVE A NODE NAME ?
RETSKP ;YES
SKIPN (C) ;[7.1008] HAVE ANY ETHERNET ADDRESS ?
SKIPE 1(C) ;[7.1008] NOT SO FAR, CHECK NEXT WORD
SKIPA ;[7.1008] GOT NON-ZERO ADDRESS
RETSKP ;[7.1008] NO ETHERNET ADDRESS, DO NOTHING
MOVEI Z,6 ;ETHERNET ADDRESSES ARE 6 BYTES LONG
MOVE D,C ;GET ADDRESS OF ETHERNET ADDRESS
TXO D,<POINT 8,0> ;FORM BYTE POINTER TO IT
HRROI A,HSTNAM ;OUTPUT TO HSTNAM STRING
MOVX C,<NO%LFL!NO%ZRO!<2B17>!^D16> ;HEX OUTPUT, 2 DIGITS, ZERO FILL
JRST LATHS2 ;DON'T PRINT A SEPERATOR
LATHS1: MOVEI B,"-" ;PRINT A SEPERATOR
BOUT
LATHS2: ILDB B,D ;GET A BYTE
NOUT ;OUTPUT IT
ERJMP R
SOJG Z,LATHS1 ;LOOP TILL DONE
RETSKP
TCPHST: SKIPE D,(C) ;[7.1008] GET HOST NUMBER, RETURN IF NOT
TXNN B,NW%NNN ;HAVE A NODE NAME ?
RETSKP ;YES
HRROI A,HSTNAM ;TYPE HOST NUMBER LIKE #.#.#.#
MOVEI C,^D10
LDB B,[POINT 8,D,11] ;GET A BYTE
NOUT ;OUTPUT IT
ERJMP R
MOVEI B,"."
BOUT ;TYPE A DOT
LDB B,[POINT 8,D,19] ;GET A BYTE
NOUT ;OUTPUT IT IN DECIMAL
ERJMP R
MOVEI B,"."
BOUT ;TYPE A DOT
LDB B,[POINT 8,D,27] ;GET A BYTE
NOUT ;OUTPUT IT IN DECIMAL
ERJMP R
MOVEI B,"."
BOUT ;TYPE A DOT
LDB B,[POINT 8,D,35] ;GET A BYTE
NOUT ;OUTPUT IT IN DECIMAL
ERJMP R
RETSKP
SYSTS6: ETYPE <%_>
SYST9: SKIPE A,SISTAS ;RETURN USER STRING IF USED
CALL STREM
SKIPE A,SISLDS ;RETURN LOGGED-IN DIR STRING IF USED
CALL STREM
SKIPE A,SISCDS ;RETURN CONNECTED DIR STRING IF USED
CALL STREM
MOVE D,JNX
SKIPE SYJOBM ;[7.1139] Still doing SYSJOBs?
JRST SYST2 ;[7.1139] If so, don't bump job counter
AOBJN D,SYST2
TXNE Q1,SY%NOP
JRST RLJFNS ;QUIT NOW IF NO OPERATOR JOBS
TLO Z,F3 ;FLAG CRLF SECOND TIME THROUGH
TLON Z,F2 ;SECOND PASS DONE?
IFSKP. ;[7.1139] If so,
JRST RLJFNS ;[7.1139] Do cleanup and go back to command level
ELSE. ;[7.1139]
MOVE A,NODMSK ;[7.1139] Get node mask back
MOVEM A,SYJOBM ;[7.1139] And make SYSJOB mask setup again
JRST SYST9A ;[7.1139] Now print out OPR jobs only
ENDIF. ;[7.1139]
SYSTD: MOVEM B,SISTAN ;SAVE DIR NUMBER
CALL BUFFF ;GET THE DIR NAME STRING
MOVEM A,SISTAS ;SAVE STRING POINTER
MOVEI A,SY$DIR
CALL SSTACK ;ANNOUNCE DIR NUMBER OR STRING COMING UP
MOVE A,SISTAN ;STEP THE NUMBER
MOVE B,SISTAS
CALL STPDIR
JRST [MOVE A,SISTAN
JRST SYSTD1] ;NO MORE, SAVE DIR NUMBER
MOVEI A,[GJ%IFG+GJ%OFG
.NULIO,,.NULIO
0
0
POINT 7,[ASCIZ/*/]
POINT 7,[ASCIZ/*/]
0
0] ;GET JFN ON WILD DIRECTORY STRING
HRROI B,ATMBUF
GTJFN
ERJMP JERR ;WILD ERROR!?
MOVE B,A ;SET UP FOR JFNS
HRROI A,ATMBUF
MOVX C,1B2+1B5+JS%PAF
JFNS
MOVE A,B ;RELEASE THE JFN
RLJFN
ERJMP JERR ;DITTO
CALL BUFFF ;STORE STRING IN TEMPORARY FREE AREA
SYSTD1: CALL SSTACK
JRST SYST1J
SYSTU: CALL CHKWLD ;[7.1137] (/) Check for wildcard
SKIPA ;[7.1137] Wild card not given
JRST SYSFLD ;[7.1137] Wild name seen. Handle on its own
MOVEM B,SISTAN ;SAVE THE USER NUMBER
CALL BUFFF ;GET THE ATOM BUFFER
MOVEM A,SISTAS ;SAVE STRING POINTER TO USER NAME
MOVEI A,SY$USR ;ANNOUNCE THAT USER NAME OR STR COMING UP
CALL SSTACK
MOVE A,SISTAN ;NOW STEP THE USER
MOVE B,SISTAS ;IF NEEDED
CALL STPUSR
SKIPA A,SISTAN ;NO MORE, SAVE USER NUMBER
MOVE A,SISTAS ;IT'S WILD, SAVE STRING POINTER
CALL SSTACK
SYST1J: CALL .SYSEL
JRST SYSTK1
SYSTJ: PUSH P,B ;SAVE THE JOB NUMBER
MOVEI A,SY$JOB ;FLAVOR IS "JOB NUMBER"
CALL SSTACK
POP P,A ;GET THE JOB NUMBER
CALL SSTACK
JRST SYST1J
DEFINE TB(TEXT,FLAGS,BIT)<
T <TEXT>,FLAGS+,<[TXO Q1,SY%'BIT
RET]>
>
;THIS IS THE KEYWORD TABLE. SEE $SYSTB FOR THE SUBCOMMAND TABLE.
$SESTA: TABLE
T .,,SYSTK.
T ALL,,.SYSAL
TB CLASS,,CLS
TB CONNECT-TIME,,CT ;[4412] Connect time
TB CONTROLLING,,CJB
TB DIRECTORY,,CON
IT FOREIGN-HOST,,F4NH
TB HEADER,,HED
TB LIMIT,,LIM
T LINE,,SYSTT
T LPT,,.$LPT
TA N,.NOPE ;[7.1093]
.NOPE: T NO,,.SYSNO ;[7.1093]
T NODE,,SYSNOD ;[7.1076]
T ORIGIN,,F4NH
T PROGRAM
TB STATE,,STA
TB SYSTEM,,NJB
TB TIME,,TIM
TB WHAT,,SUB
TB WHERE,,TTY
TB WHO,,USR
TEND
DEFINE TB(TEXT,FLAGS,BIT)<
T <TEXT>,FLAGS+,<[CONFIRM
TXO Q1,SY%'BIT
RET]>
>
;This is the subcommand table. See $SESTA for the keyword table.
$SYSTB: TABLE
T ALL,,..SYSA
TB CLASS,,CLS
TB CONNECT-TIME,,CT ;[4412] Connect time
TB CONTROLLING,,CJB
TB DIRECTORY,,CON
IT FOREIGN-HOST,,CF4NH
TB HEADER,,HED
T JOB,,SYJOB
TB LIMIT,,LIM
T LINE,,..SYST
T LPT,,..LPT
TA N,SUBNO ;[7.1093]
SUBNO: T NO,,..SYSN ;[7.1093]
T NODE,,SYNODS ;[7.1076]
T ORIGIN,,CF4NH
T OUTPUT,,.SYOUT
T PROGRAM,,.PRCNF
TB STATE,,STA
TB SYSTEM,,NJB
TB TIME,,TIM
T USER,,SYUSR ;[7.1076]
TB WHAT,,SUB
TB WHERE,,TTY
TB WHO,,USR
TEND
.SYOUT: SKIPN CUSRNO
ERROR <LOGIN please>
NOISE <TO FILE>
MOVE A,[XWD [ASCIZ /SYSTAT/],[ASCIZ /LST/]] ;DEFAULT NAME & EXT
CALL COUTFN
JRST CERR
CONFIRM
MOVEM A,SYSJFN ;CAN'T SET UP COJFN UNTIL SUBCOMMANDS ARE OVER!
RET
.$LPT: SKIPN CUSRNO
ERROR <LOGIN please>
CALL GETLPT ;GET JFN ON LPT
MOVEM A,SYSJFN ;REMEMBER TO USE IT FOR OUTPUT
RET
..LPT: SKIPN CUSRNO
ERROR <LOGIN please>
CALL FINLPT ;FINISH LPT SUBCOMMAND
MOVEM A,SYSJFN ;REMEMBER LPT
RET
SYJOB: DECX <Decimal job number> ;[7.1076]
CMERRX
PUSH P,B ;SAVE THE NUMBER
CONFIRM ;WAIT FOR CONFIRMATION
MOVEI A,SY$JOB ;FLAVOR
CALL SSTACK
POP P,A ;RESTORE THE NUMBER
;DON'T TRY TO BUM CODE BY STACKING THE
;FLAVOR BEFORE READING VALUE. THE
;TYPIST MIGHT TYPE CONTROL-U, LEAVING
;THE ARG STACK AMUCK
CALL SSTACK
JRST .SYSEL
SYUSR: SETOM SUBMSK ;[4413] Say in subcommand
TLZ Z,F1 ;[7.1076] ALLOW DEFAULT
SKIPN CUSRNO ;LOGGED IN?
TLO Z,F1 ;NO, SO DON'T ALLOW DEFAULTING
CALL USRNMS
JRST SYSFLD ;[7.1137] Must have typed a non-local user
MOVEM B,SISTAS ;SAVE POINTER TO WILD STRING
MOVEM C,SISTAN ;SAVE USER NUMBER
CONFIRM
CALL CHKWLD ;[7.1137] (/) User want wildcarded username?
SKIPA ;[7.1137] No, go on
JRST SYSFLD ;[7.1137] Yes, handle differently
MOVEI A,SY$USR ;ANNOUNCE FLAVOR IS USER
CALL SSTACK
MOVE A,SISTAN ;GET DIRECTORY NUMBER
MOVE B,SISTAS ;AND POINTER TO STRING
CALL STPUSR ;STEP TO NEXT USER NUMBER
SKIPA A,SISTAN ;NO MORE, SAVE USER NUMBER
MOVE A,SISTAS ;IT'S WILD, SAVE USER STR POINTER
CALL SSTACK
CALLRE .SYSEL ;RETURN VIA .SYSEL
;[7.1137]
;"SYSTAT USER" when user is not local or "SYSTAT US*" comes through here
;Done for people who don't have homogeneous clusters. Grumble. Grumble.
SYSFLD: MOVE A,FLDPTR ;Get current pointer into WLDPAG
HRROI A,WLDPAG(A) ;Put wild (or non-local user) string here
HRROI B,ATMBUF ;Get it from here
MOVEI C,^D39 ;Only this many characters
SETZ D, ;Stop on null
SOUT% ;Transfer string
ERJMP .+1 ;Naaaa...
MOVE A,FLDPTR ;Get our current pointer
SKIPN WLDPAG(A) ;[7.1161] Did we get something for real from the user?
ERROR <Does not match keyword, directory or username> ;[7.1161] No, let them know
HRROI C,WLDPAG(A) ;And get another argument for SSTACK
ADDI A,10 ;Account for the maximum string
CAIL A,<WLDPAG+777> ;Did user give us too much?
ERROR <Too many arguments> ;Yes, let him know
MOVEM A,FLDPTR ;Update pointer
MOVEI A,SY$FLD ;Say this is special
CALL SSTACK ;(A/B) Boy, do I hate this hack
MOVE A,C ;Now stack up the wild byte pointer
CALL SSTACK ;(A/B) More hack
CALL .SYSEL ;(/) Set some bits
SKIPN SUBMSK ;[4413] In subcommand mode?
JRST SYSTK1 ;[4413] No, continue parsing the command
RET ;[4413] Yes, all done
;"SYSTAT PROGRAM FOO" ONLY LISTS JOBS RUNNING PROGRAM FOO
.PROGR: CALL PROG1 ;GET THE ARGS
CALLRET .SYSEL ;SAY NO HEADING
PROG1: STKVAR <PRGNAM>
WORDX <Program name whose users should be displayed>
CMERRX <Invalid program name>
HRROI A,ATMBUF ;POINT AT PROGRAM NAME
CALL GETSIX ;CHANGE TO SIXBIT
ERROR <Illegal character in program name, or name too long>
MOVEM A,PRGNAM ;REMEMBER WHICH PROGRAM WE'RE LOOKING FOR
MOVEI A,SY$PRG ;SAY PROGRAM NAME
CALL SSTACK
MOVE A,PRGNAM
CALL SSTACK ;REMEMBER THE PROGRAM NAME
RET
.PRCNF: CALL PROG1 ;GET PROGRAM NAME
CONFIRM ;WAIT FOR CONFIRMATION
CALLRET .SYSEL ;SET FLAGS SO HEADING DOESN'T APPEAR
..SYST: CALL SYSTT
CALLRET CONF
SYSTT: HELPX <octal line number or> ;[7.1076]
KEYWD $SYTTY
0
JRST .SYST1
HRROI B,-1 ;FLAG FOR DETACHED LINES
JRST .SYST2
$SYTTY: TABLE
T DETACHED,,0
TEND
.SYST1: OCTX ;IF NOT A KEYWORD, HAS TO BE OCTAL NUMBER
CMERRX ;NOT EITHER
.SYST2: PUSH P,B ;SAVE NUMBER
MOVEI A,SY$TTY
CALL SSTACK
POP P,A ;GET NUMBER
CALL SSTACK ;PUT IT ON STACK
.SYSEL: TXO Q1,SY%JOB!SY%NHD
RET
SSTACK::SKIPL SFRAME
ERROR <Too many arguments>
EXCH B,SFRAME
MOVEM A,(B)
ADD B,[1,,1]
EXCH B,SFRAME
RET
..SYSA: CONFIRM
.SYSAL: TXO Q1,SYSALL
RET
..SYSN: CALL .SYSNO
CALLRET CONF
.SYSNO: MOVEI B,[FLDBK. .CMKEY,,$SYSNO,,,DOTBRK] ;ALLOW DOT
CALL FLDSKP
CMERRX
CALL GETKEY
JRST (P3)
DOTBRK: BRMSK. KEYB0.,KEYB1.,KEYB2.,KEYB3.,<.> ;BREAK SET FOR KEYWORDS THAT MAY HAVE DOT IN THEM
DEFINE TB(TEXT,FLAGS,BIT)<
T <TEXT>,FLAGS+,<[TXZ Q1,SY%'BIT
RET]>
>
;$SYSNO IS USED FOR THE SYSTAT NO FEATURE, BOTH FOR SUBCOMMANDS AND FOR
;KEYWORDS.
$SYSNO: TABLE
TB .,,IME
TB CLASS,,CLS
TB CONNECT-TIME,,CT ;[4412]
TB CONTROLLING,,CJB
TB DIRECTORY,,CON
IT FOREIGN-HOST,,F4NHN
T HEADER,,.SYSNH
TB LIMIT,,LIM
T NODE,,NONODE ;[7.1076]
T OPERATOR,,.NOOPR
T ORIGIN,,F4NHN
TB STATE,,STA
T SYSTEM,,.SYSNS
TB TIME,,TIM
TB WHAT,,SUB
TB WHERE,,TTY
TB WHO,,USR
TEND
.SYSNH: TXZ Q1,SY%HED
TXO Q1,SY%NHD
RET
.NOOPR: TXO Q1,SY%NOP
RET
.SYSNS: TXO Q1,SY%JOB
RET
CF4NH: CONFIRM ;MAKE SURE HE MEANS IT
F4NH: TXO Q1,SY%4NH
RET
CN4NH: CONFIRM ;MAKE SURE HE MEANS IT
F4NHN: TXZ Q1,SY%4NH
RET
NONODE: CALL VALNDN ;[7.1076] (A/A,B,C) Get a valid node name
ANDCAM C,NODMSK ;[7.1076] Scratch this node from the node mask
SKIPN NODMSK ;[7.1076] Has this been nixed?
TXZ Q1,SY%NOD ;[7.1076] Yes, then don't do nodes
RET ;[7.1076] And done
SYSNOD: CALL VALNDN ;[7.1076] (A/A,B,C) Get a valid CI node
SYSND1: IORM C,NODMSK ;[7.1076] Say we can do these nodes
TXO Q1,SY%NOD ;[7.1076] Say we are doing nodes
RET ;[7.1076] And done
;When node is used as a subcommand
SYNODS: CALL VALNDN ;[7.1076] (A/A,B,C) Parse valid CI node
CONFIRM ;[7.1076] No for a <CRLF>
JRST SYSND1 ;[7.1076] And join common code
;STATISTICS
CLBLN==7 ;ROOM FOR COUNT, CLASS, SHAR, USE, 1 MIN LOAD, 5 MIN, 15 MIN
MONSTA::STKVAR <CURCLS,<CLBLK,CLBLN>>
MOVE A,[SIXBIT /SYSTAT/]
CALL READT ;READ SYSTEM STATISTICS TABLE INTO AC'S 4-13
ETYPE < Up %K
Idle %4T Waiting %5T Sched ovh %6T Pager traps %7T
Swap reads %10Q Writes %11Q File reads %12Q Writes %13Q
>
MOVE A,[SIXBIT /NCPGS/]
SYSGT
ETYPE < %1Q Pages of user memory
>
MOVE A,[SIXBIT /SYSTAT/]
MOVEI B,10
CALL MORET ;READ MORE OF TABLE
TIME ;TOTAL UPTIME OF SYSTEM
CALL FLOAT
EXCH 1,6
CALL FLOAT ;FLOAT NBAL TOTAL
EXCH 1,7
CALL FLOAT ;FLOAT NRUN TOTAL
EXCH 1,6
FDVR 6,1 ;NRUN AVERAGE
FDVR 7,1 ;NBAL AVERAGE
ETYPE < %4Q Term wakeups %5Q Term interrupts
NBAL av %7Q NRUN av %6Q
>
HLRE A,QTIMES ;GET NUMBER OF SHCED QUEUES
MOVM A,A ;MAKE POSITIVE
SUBI A,1 ;MAKE LIMIT INCLUSIVE
ETYPE < Runtime of jobs on sched queues 0-%1Q (sec)
>
HLLZ D,QTIMES ;SET UP TO LOOP OVER QTIMES
STAT5C: GTB .QTIME
IDIVI A,^D1000 ;CONVERT TO SECONDS
ETYPE < %1Q>
AOBJN D,STAT5C
MOVEI A,CLBLN ;BLOCK LENGTH
MOVEM A,.SACNT+CLBLK
CALL CLSON ;SEE IF CLASS SCHEDULER IS ON
JRST CLDON ;NO, SO DON'T TRY TO PRINT TABLE!
ETYPE <%_ Class Share Use Loads%_>
SETZB A,CURCLS ;START CURRENT CLASS AT 0
CLLUP: MOVEM A,.SACLS+CLBLK ;SAY WHICH CLASS TO LOOK AT
MOVEI A,SYCLN ;SET UP BLOCK SIZE FOR SKED%
MOVEM A,.SACNT+CLBLK
MOVEI A,.SKRCS ;READ CLASS PARAMETERS
MOVEI B,CLBLK ;SAY WHERE ARG BLOCK IS
SKED% ;GET THE INFO
ERJMP [CALL DGETER ;FAILED, SEE WHY
CAIE A,ARGX25 ;SCAN ALL LEGAL CLASSES?
CALL JERR ;NO, UNEXPECTED ERROR
JRST CLDON] ;YES, JUST LEAVE LOOP
SKIPN .SASHR+CLBLK ;DOES THIS CLASS HAVE A SHARE OF MACHINE?
SKIPE .SAUSE+CLBLK ;IS THIS CLASS BEEN USED?
CAIA
JRST CLNXT ;NO, SKIP IT
MOVE A,CURCLS ;GET CURRENT CLASS
ETYPE < >
CALL NUM4 ;PRINT 4-COLUMN CLASS NUMBER
DMOVE A,.SASHR+CLBLK ;GET SHARE AND UTILIZATION
ETYPE <%1=%%2=> ;SHARE, USE
MOVSI Q1,-3 ;SET UP TO PRINT 3 LOAD AVERAGES
HRRI Q1,.SA1ML+CLBLK ;POINT TO FIRST LOAD AVERAGE
CLOD: MOVE A,(Q1) ;GET NEXT LOAD
MOVEI B,7 ;PRINT IN 7 COLUMNS
PRINT " " ;SEPARATE WITH SPACE IN CASE OVERFLOW
CALL FLTTAB
AOBJN Q1,CLOD ;LOOP FOR REST OF LOADS
ETYPE <%_>
CLNXT: AOS A,CURCLS ;STEP TO NEXT CLASS
JRST CLLUP
CLDON: RET
;STATISTICS
;INFO SUBSYSTEM-STATUS - TABLE OF SUBSYSTEM USAGE
SUBSTA::ETYPE<%_>
TYPE < Subsys Time(sec) PGF/SEC Nblocks WS-size Scounts
>
HLLZ D,SNAMES ;SET UP TO LOOP OVER ALL NAMES
STAT5A: GTB .SNAME ;GET SIXBIT NAME
JUMPE A,STAT5Z ;0 MEANS NONE
PUSH P,A ;SAVE NAME FOR LATER
PRINT " "
CALL SIXPRT ;PRINT IT
PRINT TAB
GTB .STIME ;GET RUNTIME
PUSH P,A ;SAVE IT FOR LATER
IDIVI A,^D1000 ;CONVERT TO SECONDS
CALL STAT5N ;PRINT SECONDS
POP P,A ;GET TIME AGAIN
JUMPE A,[CALL STAT5N ;IF 0, PRINT 0 FOR PGF/SEC ALSO
JRST STAT5B]
CALL FLOAT
FDVRI A,(1000.0) ;CONVERT TO SECONDS
MOVEM A,C
GTB .SPFLT ;GET PAGE FAULTS
CALL FLOAT ;FLOAT IT
FDVR A,C ;COMPUTE PAGE FAULTS PER SECOND
JUMPE A,[CALL STAT5N ;IF 0, PRINT SPECIALLY SO IT'LL ALIGN PROPERLY
JRST STAT5B]
ETYPE < %1Q> ;PRINT IT IN 10-SPACE FIELD
STAT5B: GTB .SNBLK ;GET NUMBER OF BLOCKS
PUSH P,A
CALL STAT5N ;PRINT IT
POP P,A
JUMPE A,[CALL STAT5N ;IF 0, PRINT 0 FOR WSSIZE ALSO
JRST STAT5Y]
CALL FLOAT ;FLOAT IT
PUSH P,A
GTB .SSIZE ;GET SIZE INTEGRAL
CALL FLOAT ;FLOAT IT
POP P,B
FDVR A,B ;COMPUTE WSSIZE
JUMPE A,[CALL STAT5N ;IF 0, PRINT SPECIALLY SO IT'LL ALIGN PROPERLY
JRST STAT5Y]
ETYPE < %1Q> ;PRINT IT IN 10-SPACE FIELD
STAT5Y: GTB .SCOUNT ;GET COUNT OF SETSN'S DONE
POP P,B ;GET STORED PROGRAM NAME
CAME B,[OURNAM] ;IF IT'S THE EXEC, SCOUNT IS MEANINGLESS (& BIG)
CALL STAT5N ;ELSE OUTPUT IT IN 12 COLUMNS
ETYPE <%_> ;END THE LINE
STAT5Z: AOBJN D,STAT5A ;DO ALL NAMES
JRST EOLRET
;PRINT FLOATING POINT NUMBER. NUMBER IN A, COLUMNS IN B
DADP==2 ;NUMBER OF DIGITS AFTER DECIMAL POINT
FLTTAB: MOVX C,FL%ONE!FL%PNT!FL%OVL!FLD(DADP,FL%SND) ;AT LEAST ONE DIGIT, DECIMAL POINT, OUTPUT ON COLUMN OVERFLOW, 2 DIGITS AFTER POINT
SUBI B,DADP+1 ;SUBTRACT DIGITS AFTER POINT PLUS ONE FOR POINT
STOR B,FL%FST,C ;TELL SYSTEM HOW MANY PLACES BEFORE POINT
MOVE B,A ;NUMBER IN B
MOVE A,COJFN ;OUTPUT CHANNEL IN A
FLOUT ;TYPE THE FLOATING POINT NUMBER
JRST [ CAIN C,FLOTX1 ;OVERFLOW OF COLUMN 1?
JRST .+1 ;YES, O.K. JUST MEANS NUMBER REAL LARGE.
CALL CJERRE] ;NO, PROBABLY OVER QUOTA ON "TAKE" OUTPUT.
RET
;4-COLUMN NUMBER
NUM4: MOVX B,NO%LFL!FLD(4,NO%COL)!<5+5> ;LEADING FILLER, 4 COLUMNS, DECIMAL
CALLRET SYNUM
;PRINT FORMATTED NUMBER
;MAGNITUDE, LEADING FILLER, ERROR IF COLUMN OVERFLOW, 12 COLUMNS, DECIMAL
STAT5N: MOVX B,NO%MAG!NO%LFL!NO%OOV!FLD(12,NO%COL)!FLD(5+5,NO%RDX)
; CALLRET SYNUM ;PRINT NUMBER
;ROUTINE TO PRINT NUMBER FOR SYSTAT (COULD BE MADE MORE GENERAL!)
;ACCEPTS: A/ NUMBER
; B/ FORMAT, RADIX BITS PER NOUT SPECIFICATION
;RETURNS: +1 ALWAYS, NUMBER OUTPUTTED TO COJFN
SYNUM: MOVE C,B ;PUT FORMAT IN B
MOVE B,A ;NUMBER IN B
MOVE A,COJFN
NOUT
JRST [ CAIE A,NOUTX2 ;CHECK FOR COLUMN OVERFLOW ERROR CODE
CAIN C,NOUTX2 ;IN A OR C
RET ;ALLOW IT
JRST JERR] ;REPORT ANY OTHER ERROR
RET
;SUBROUTINE TO READ SYSTEM TABLE WHOSE NAME IS IN A INTO AC'S 4-14.
;USED IN SYSTAT, ERRSTAT.
READT: SETZ B, ;NORMAL ENTRY: START AT BEGINNING OF TABLE
MORET: MOVE D,B ;ENTRY FOR TABLE INDEX IN B
SYSGT
JUMPN B,.+2
CALL SCREWUP ;NO SUCH TABLE
HLLZ C,B ;FORM AOBJN INDEX
SOJGE D,[AOBJP C,[RET] ;PASS UNWANTED ENTRIES
JRST .]
PUSH P,[D] ;INIT PTR TO AC'S TO STORE VALUES IN
READT1: HRR A,B ;TABLE #
HRL A,C ;INDEX
GETAB ;READ A WORD OF TABLE INTO A
CALL JERR
MOVEM A,@(P)
AOS A,(P)
CAIGE A,15 ;STOP BEFORE OVERWRITING 15!
AOBJN C,READT1 ;END-OF-TABLE TEST AND LOOP
SUB P,[XWD 1,1]
RET
;TERMINAL CHARACTERISTICS COMMANDS GROUP
; LOWERCASE, FORMFEED, TABS, NO LOWERCASE, NO FORMFEED, NO TABS,
; RAISE, NO RAISE, HALFDUPLEX, FULLDUPLEX, INDICATE.
;THESE COMMANDS CHANGE THE FILE MODE WORD AND THE CONTROL CHARACTER
;OUTPUT CONTROL (CCOC) WORDS FOR THE PRIMARY OUTPUT FILE,
;AND ALSO THE THREE SETS OF THESE VALUES KEPT IN STORAGE.
;THE "NO" PREFIXED VERSIONS GO THRU THE SAME ROUTINES AS THE UNPREFIXED
;VERSIONS, BUT WITH F1 SET WHICH REVERSES THE EFFECT OF THE SUBROUTINES
;THEY CALL. F1 IS CLEAR ON DISPATCH FROM THE MAIN LOOP.
.TERNO::KEYWD $TERNO ;"NO". LOOK UP NEXT WORD.
0 ;NO DEFAULT
JRST CERR ;NULL ILLEGAL
TLO Z,F1 ;SAY NO
JRST (P3) ;GO TO .FORMF, .TABS, OR .LOWER.
;LOW ORDER BIT POSITION OF TT%DUM
LB.DUM==<TT%DUM&-TT%DUM>
.LINE:: LDF C,<.TTLDX>*<LB.DUM> ;SET LINE HALF DUPLEX
JRST SETDU ;DO SET DUPLEX
.FULLD::LDF C,<.TTFDX>*<LB.DUM> ;SET FULL DUPLEX
JRST SETDU
.HALFD::LDF C,<.TTHDX>*<LB.DUM>
SETDU: NOISE (MODE FOR TERMINAL)
CONFIRM
SETDU1: MOVEI A,.CTTRM
RFMOD
TXZ B,TT%DUM ;CLEAR ALL DUPLEX BITS
IOR B,C ;SET THE DESIRED ONES
STPAR ;SET NEW DUPLICITY
RET
.FORMF::NOISE (EXISTS ON TERMINAL)
LDF C,TT%MFF ;SET MECH FORMFEED BIT
CALLRET CMOD ;CHANGE MODE WORD AND RETURN
.TABS:: NOISE (EXIST ON TERMINAL)
LDF C,TT%TAB ;SET HARDWARE TABS BIT
MOVE D,[POINT 2,(Q1),19] ;PTR TO ^I CCOC BYTE
CALL CMOD ;CHANGE FILE MODE WORD
JRST CCCOC ;CHANGE CONT. CHAR. OUTPUT CONT. WORDS
;PAGE MODE
.PAGE:: NOISE <MODE>
DECX <Carriage return or page length>
JRST PAGE1 ;NO NUMBER TYPED
PUSH P,B ;A NUMBER SUPPLIED
CALL PAGE1
POP P,B
JRST PLENT1
PAGE1: CONFIRM
CALL ..END ;DO BOTH "PAUSE (ON) END-OF-PAGE"
CALLRET ..COMM ;AND "PAUSE (ON) COMMAND"
;TERMINAL PAUSE (ON)
.PAUSE::NOISE <ON>
KEYWD $PAUSE
0
JRST CERR
JRST (P3) ;DISPATCH
$PAUSE: TABLE
T CHARACTER,,..PPCH
T COMMAND,ONEWRD,..COMM
T END-OF-PAGE,ONEWRD,..END
TEND
;SPECIFY PAGE PAUSE AND UNPAUSE CHARACTER
..PPCH: TLNE Z,F1 ;DID USER SAY "NO"?
JRST [MOVEI Q1,23 ;GET DEFAULTS. ^S
MOVEI A,21 ;AND ^Q
JRST ..PPC1 ] ;AND FINISH UP
MOVEI B,[FLDDB. .CMNUM,CM%SDH,^D8,<octal ASCII code for character>,,[
FLDDB. .CMKEY,,$PCHAR,,,[
FLDDB. .CMQST,CM%SDH,,<any printing character in double quotes>,,]]]
CALL PPGETC ;GET THE CHARACTER TO PAUSE ON
MOVEM A,Q1 ;SAVE IT FOR LATER
NOISE <AND UNPAUSE ON>
MOVEI B,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMNUM,CM%SDH,^D8,<octal ASCII code for character>,,[
FLDDB. .CMKEY,,$PCHAR,,,[
FLDDB. .CMQST,CM%SDH,,<any printing character in double quotes>,,]]]]
CALL PPGETC ;GET SECOND CHAR
SKIPGE A ;DEFAULTED?
SKIPA A,Q1 ;YES - MAKE IT THE SAME AS THE PAUSE CHARACTER
..PPC1: CONFIRM ;ELSE CONFIRM
MOVE C,A
HRL C,Q1
MOVEI A,.CTTRM
MOVEI B,.MOPCS ;SET PAUSE AND UNPAUSE CHARACTERS
MTOPR
ERCAL CJERRE
RET
PPGETC: CALL FLDSKP
ERROR <Invalid, %?>
LOAD C,CM%FNC,.CMFNP(C) ;GET FUNCTION USED
CAIN C,.CMQST ;ARBITRARY CHAR?
JRST PPGTCC ;YES - RETURN IT
CAIN C,.CMCFM ;CR?
JRST PPGTCR ;YES - RETURN 0
CAIN C,.CMNUM ;NUMBER?
JRST PPGTCN ;YES - RETURN IT
HRRZ B,0(B) ;MUST BE KEYWORD, GET DISPATCH ADDRESS
HRRZ B,0(B)
CALLRET 0(B)
PPGTCC: LDB A,[POINT 7,ATMBUF,6] ;GOT AN ARBITRARY CHARACTER - RETURN IT
RET
PPGTCR: SETO A, ;GOT A CR - RETURN -1
RET
PPGTCN: SKIPLE A,B ;GOT A NUMBER, CHECK RANGE
CAILE A,177
ERROR <Invalid, not a legal ASCII code>
RET
PCHCON: MOVEI B,[FLDDB. .CMQST,CM%SDH,,<any printing character in doublequotes>,,]
CALL FLDSKP
ERROR <Invalid, not a quoted string>
LDB A,[POINT 7,ATMBUF,6] ;GET FIRST CHAR
CAIL A,"a" ;RAISE LOWERCASE
CAILE A,"z"
TRNA
SUBI A,40
CAILE A,100 ;CHECK RANGE
CAILE A,137
ERROR <Invalid, not a control character>
SUBI A,100
RET
PCHSPA: MOVEI A," " ;USE 'SPACE' CHARACTER
RET
$PCHAR: TABLE
T CONTROL,,PCHCON
T SPACE,,PCHSPA
TEND
..END: MOVEI A,.CTTRM
MOVEI B,.MOXOF
MOVEI C,.MOONX ;ASSUME ON
TLNE Z,F1 ;"NO" ?
MOVEI C,.MOOFF ;YUP, OFF
MTOPR
ERCAL CJERRE ;GO SAY WHY IT FAILED
RET
..COMM: LDF C,TT%PGM
JRST CMOD1 ;GO CHANGE MODE
;IMMEDIATE ECHO MODE
.IMMED::NOISE <ECHO MODE>
MOVEI C,TT%ECM
JRST CMOD
;LOWERCASE: CONTROLS LOWER CASE OUTPUT.
;IT MAY ALSO BE NECESSARY TO CLEAR "INDICATE WITH %" BIT,
;BUT PREFERABLE NOT TO IF IT HAS NO EFFECT WHEN B3 ON.
.LOWER::NOISE (EXISTS ON TERMINAL)
LDF C,TT%LCA ;SET LOWER CASE AVAILABLE BIT
JRST CMOD ;CHANGE FILE MODE WORD
;RAISE: CONTROLS CONVERSION OF LOWER CASE TO UPPER ON INPUT.
.RAISE::NOISE (TERMINAL INPUT)
LDF C,TT%LIC ;SET LOWERCASE INPUT CONTROL
JRST CMOD
;FLAG UPPERCASE OUTPUT
.FLAG:: NOISE <UPPER CASE OUTPUT>
LDF C,TT%UOC ;SET UPPERCASE OUTPUT CONTROL
JRST CMOD
;[SET] TERMINAL [NO] INHIBIT (NON-JOB OUTPUT)
.INHIB::NOISE (NON-JOB OUTPUT)
CONFIRM
CALL RTTFLG ;RETURN EXISTING TERMINAL FLAGS
ERROR <The [NO] INHIBIT function is not implemented>
TXO C,MO%NTM ;SET INHIBIT
TLNE Z,F1 ;GOT A "NO"
TXZ C,MO%NTM ;YES. TURN BIT OFF.
MOVEI A,.CTTRM ;CONTROLLING TERMINAL
MOVEI B,.MOSTF ;FUNCTION CODE FOR SETTING TERMINAL FLAGS
MTOPR ;DO IT
ERCAL CJERRE
RET
;TWO SUBROUTINES FOR TERMINAL CHARACTERISTICS COMMANDS
;CHANGE TELETYPE MODE WORD SUBR
;CHANGES MODE IN EFFECT
;TAKES: C: MASK INDICATING BITS TO CHANGE.
; AC Z LH BIT F1: ON TO CLEAR BIT(S), OFF TO SET THEM.
;PRESERVES D, DESTROYS A, B.
CMOD: CONFIRM ;NO TTY COMMANDS CONFIRMED BEFORE HERE
CMOD1: MOVEI A,.CTTRM
RFMOD
ANDCAM C,B ;IF NO, TURN OFF THE BITS
TLNN Z,F1
IORM C,B ;OTHERWISE, TURN THEM ON
STPAR ;THESE ARE ALL TERMINAL PARAMETERS
RET
;TERMINAL (TYPE OR FEATURE) IS
;NOTE: IF ADDING A NEW TERMINAL, SEE ALSO TTYPTB IN EXECIN
.TERMI::MOVEI B,[FLDDB. .CMNOI,,<-1,,[ASCIZ/FEATURE OR TYPE/]>,,,[
FLDDB. .CMNOI,,<-1,,[ASCIZ/MODE IS/]>]]
CALL FLDSKP ;READ THE GUIDE WORDS
CMERRX
MOVEI B,[FLDDB. .CMKEY,,$TERMI,,,[
FLDDB. .CMKEY,,$TTYP]]
CALL FLDSKP
JRST CERR ;ERROR - NEITHER TYPE OF KEYWORD WAS TYPED
CALL GETKEY ;CHANGE TABLE ADDRESS TO DISPATCH DATA
JRST (P3)
;HELP FOR TERMINAL COMMANDS.
TTYHLP::CONFIRM
MOVX A,GJ%OLD+GJ%SHT+GJ%IFG ;OLD FILE ONLY, SHORT FORM
HRROI B,[ASCIZ/HLP:TERMINAL.HLP/]
CALL GTJFS ;GET HANDLE ON HELP FILE
ERROR <No help available. The file HLP:TERMINAL.HLP was not found.>
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
JRST TYPE1 ;FINISH COMMAND BY COPYING HELP FILE TO TERMINAL
;TERMINAL TYPE N OR <TYPE>
;Note: If adding a new terminal, see also TTYPTB in EXECCA
.TTYPE::MOVEI B,[FLDDB. .CMNUM,CM%SDH,5+5,<Terminal type>,<SYSTEM-DEFAULT>,[
FLDDB. .CMKEY,,$TTYP]]
CALL FLDSKP
CMERRX ;NEITHER NUMBER OF KEYWORD TYPED
LOAD D,CM%FNC,.CMFNP(C) ;GET DATUM TYPE
CAIN D,.CMNUM ;NUMBER?
JRST .TTYP1 ;YES
CALL GETKEY ;NO, KEYWORD, GET INFO
JRST 0(P3) ;OK - DISPATCH
.TTYP1: PUSH P,B
JRST .TTY3
.T33:: PUSH P,[0]
JRST .TTY3
.T35:: PUSH P,[1]
JRST .TTY3
.T37:: PUSH P,[2]
JRST .TTY3
.TI:: PUSH P,[3]
JRST .TTY3
.DFLT:: ;SYSTEM-DEFAULT TERMINAL TYPE
.TRMNT::PUSH P,[^D8]
JRST .TTY3
.IDEAL::PUSH P,[.TTIDL] ;[4424] Here for TERMINAL IDEAL
JRST .TTY3 ;[4424]
.VT05:: PUSH P,[^D10]
JRST .TTY3
.VT50:: PUSH P,[^D11]
JRST .TTY3
.VT52:: PUSH P,[^D15]
JRST .TTY3
.LA36:: PUSH P,[^D14]
JRST .TTY3
.LA38:: PUSH P,[.TTL38]
JRST .TTY3
.LA120::PUSH P,[.TT120]
JRST .TTY3
.VT125::PUSH P,[.TT125]
JRST .TTY3
.VK100::PUSH P,[.TTK10]
JRST .TTY3
.VT100::PUSH P,[.TT100]
JRST .TTY3
.VT102::PUSH P,[.TT102]
JRST .TTY3
.VT200::PUSH P,[.TT200]
JRST .TTY3
.VT300::PUSH P,[.TT300] ;[3055]
JRST .TTY3 ;[3055]
.VT131::PUSH P,[.TT131]
JRST .TTY3
.VTH19::PUSH P,[.TTH19]
JRST .TTY3
.LA30:: PUSH P,[^D12]
.TTY3:: CONFIRM
POP P,B
MOVEI A,.CTTRM
STTYP
ERJMP [ERROR <Invalid terminal type>]
RET
;WIDTH OF TERMINAL LINE
.LWIDT::NOISE (OF LINE IS)
DECX <Terminal line width in decimal>
CMERRX
CONFIRM
MOVE C,B
MOVEI A,.CTTRM
MOVEI B,.MOSLW ;SPECIFY SETTING LINE WIDTH
MTOPR ;DO IT
ERCAL CJERRE ;GO SAY WHY IT FAILED
RET
;LENGTH OF TERMINAL PAGE
PLENTH::NOISE <OF PAGE IS>
DECX <Length of page in decimal>
CMERRX
CONFIRM
PLENT1: MOVE C,B
MOVEI A,.CTTRM
MOVEI B,.MOSLL ;SPECIFY SETTING LENGTH
MTOPR ;DO IT
ERCAL CJERRE ;FAILED, SAY WHY AND DIE
RET
;INDICATE (FORMFEED)
.INDIC::NOISE (FORMFEED)
CONFIRM
TLZN Z,F1 ;'NO'?
TLO Z,F2
MOVE D,[POINT 2,(Q1),25]
;JRST CCCOC
;SUBR TO CHANGE CCOC BYTE TO SIMULATE (IF F1 ON & F2 OFF)
; OR SEND (IF F1 AND F2 OFF) OR INDICATE (IF F2 ON).
;BYTE TO CHANGE IS INDICATED BY A BYTE PTR IN D, INDEXED BY E.
;DESTROYS A, B, C, E.
CCCOC: MOVE A,COJFN
RFCOC
MOVEI Q1,B
CALL CCCOCS ;OPERATE ON CCCOC WORDS IN B,C
MOVE A,COJFN
SFCOC ;PUT NEW VALUE INTO EFFECT
MOVEI Q1,ETTYMD+TTWCOC ;OPERATE ON STORED VALUES
CALL CCCOCS
MOVEI Q1,ITTYMD+TTWCOC
;SUBSUBROUTINE TO OPERATE ON BYTE IN WORDS Q1 POINTS TO
CCCOCS: TLNE Z,F1
SKIPA A,[3] ;3 = SIMULATE
MOVEI A,2 ;2 = SEND CODE
TLNE Z,F2
MOVEI A,1 ;1 = INDICATE BY ^X
DPB A,D
RET
;SET TERMINAL SPEED
.SPEED::MOVEI A,.CTTRM ;TO CURRENT TERMINAL
MOVEI B,.CTTRM ;HIGHEST TERMINAL IN RANGE
SPEEDA::STKVAR <STERM,RTERM,<SPNBUF,3>>
MOVEM A,STERM ;REMEMBER TERMINAL NUMBER
MOVEM B,RTERM ;REMEMBER HIGHEST TERMINAL IN RANGE
NOISE <OF INPUT>
KEYWD $BAUDR ;BAUD RATE TABLE
0 ;NO DEFAULT
JRST CERR ;ERROR IF NONE GIVEN
NOISE <AND OUTPUT>
HRLZ Q1,P3 ;SAVE VALUE
HRRZ B,P3 ;USE INPUT FOR OUTPUT DEFAULT
HRROI A,SPNBUF
MOVEM A,CMDEF
MOVEI C,5+5 ;SPEEDS ARE DECIMAL
NOUT ;SET UP DEFAULT STRING
CALL JERR ;SHOULD NEVER FAIL
KEYWD $BAUDR ;READ OUTPUT SPEED
0 ;DEFAULT ALREADY SET UP
CMERRX ;BAD OUTPUT SPEED SPECIFIED
HRR Q1,P3 ;FILL IN SELECTED OUTPUT SPEED
CONFIRM
MOVE A,STERM ;TERMINAL NUMBER TO START WITH
SPEEDB: MOVEI B,.MOSPD ;FCN CODE
MOVE C,Q1 ;PICK UP SELECTED SPEEDS
MTOPR ;C := INPUT,,OUTPUT
ERCAL CJERRE ;FAILED, TELL USER WHY
AOS A,STERM ;INCREMENT TERMINAL NUMBER
CAMG A,RTERM ;STILL IN RANGE?
JRST SPEEDB ;YES, SET NEXT TERMINAL
RET ;NO, RETURN
$BAUDR: TABLE
T 0,,0
T 110,,^D110
T 1200,,^D1200
T 134,,^D134
T 150,,^D150
T 1800,,^D1800
T 200,,^D200
T 2400,,^D2400
T 300,,^D300
T 4800,,^D4800
T 50,,^D50
T 600,,^D600
T 75,,^D75
T 9600,,^D9600
TEND
;ROUTINE TO PRINT SYSTEM-MESSAGES THAT HAVEN'T BEEN PRINTED
PNTMES::
SKIPE MESMSF ;MAIL CHECK YET?
CALL MESMES ;PUT OUT "YOU HAVE A MESSAGE" IS NECESSARY
AOSE SYSMF ;YES, SO MAYBE TIME TO PRINT SYSTEM MESSAGES
RET ;THEY'VE ALREADY BEEN PRINTED
MOVE A,LOGDAT ;THEY HAVEN'T, GET LOGIN DATE.
CALL MESS ;TYPE APPLICABLE LOGIN MESSAGES
RET
;CODE TO USE RDMAIL TO TYPE <SYSTEM>MAIL.TXT
MESS: STKVAR <MALJFN,SJFNP,MSFK> ;CELLS TO HOLD JFNS WE'LL USE
MOVE A,.JBUFP ;GET CURRENT JFN STACK POINTER
MOVEM A,SJFNP ;SAVE IT FOR RESTORATION LATER
MOVE A,FORK ;SAVE CURRENT FORK
MOVEM A,MSFK
SETOM FORK ;FORCE NEW FORK BELOW
MOVE A,JBUFP
MOVEM A,.JBUFP ;MARK STACK SO RLJFNS DOESN'T CLOSE THINGS OUR CALLER OPENED
HRROI B,[ASCIZ /POBOX:<SYSTEM>MAIL.TXT/]
CALL TRGTV1 ;TRY TO ASSIGN JFN TO FILE
JRST SYSLEV ;NO SUCH FILE
MOVE B,[XWD 1,.FBSIZ]
MOVEI C,C
CALL $GTFDB ;GET # BYTES IN FILE
JRST SYSMDO ;LET RDMAIL FIGURE IT OUT
JUMPLE C,SYSLEV ;THERE'S NO MESSAGE IF FILE IS NULL
MOVE B,[XWD 1,.FBWRT]
MOVEI C,C
CALL $GTFDB
JRST SYSMDO
CAMGE C,LOGDAT ;HAS FILE BEEN WRITTEN SINCE LAST LOGIN?
JRST SYSLEV ;NO
SYSMDO: HRROI B,[GETSAVE(SYS:RDMAIL.)]
CALL TRYGTJ
JRST SYSLEV ;LEAVE IF NO SUCH PROGRAM
MOVEM A,MALJFN
SETO C, ;FORCE OVERLAY
CALL $GET2 ;GET RDMAIL INTO IT
MOVE A,FORK ;GET FORK HANDLE
CALL JFNSTK ;STACK IT SO IT GOES AWAY LATER
GEVEC ;GET ENTRY VECTOR POINTER
HLRZ A,B
CAIGE A,3 ;MUST BE AT LEAST 3
JRST SYSLOS ;LOSE
ADDI A,-1(B) ;USE ENTRY -1 FROM LAST
CALL LOADF ;READ IT
JRST SYSLOS ;CAN'T READ IT
HRRZ C,A ;SAVE STARTING ADDR
HLRZ A,A ;GET POINTER TO WHERE TO STORE DATE AND TIME
MOVE B,LOGDAT ;GET DATE AND TIME
CALL STOREF ;STORE IT
JRST SYSLOS ;CAN'T SET IT
SETO A,
CALL MAPPF ;FREE MAPPED PAGE
JFCL ;UNMAP SHOULD NEVER FAIL
MOVEI Q1,ETTYMD ;SAVE EXEC TTY MODES
CALL RTTYMD
TLO Z,RUNF
MOVE B,C ;START ADDR IN B
MOVE A,FORK ;SET UP AS RUNNING FORK
SFORK ;START FORK HERE FOR SYSTEM MESSAGE
RFORK ;RESUME IT
WFORK ;WAIT FOR IT
SYSLEV: SKIPL A,FORK ;GET RID OF TEMP FORK
CALL KEFORK
CALL RLJFNS ;CLOSE FILES WE USED
MOVE A,SJFNP ;GET JFN STACK MARKER AS BEFORE WE TOUCHED IT
MOVEM A,.JBUFP ;RESTORE IT
MOVE A,MSFK ;RESTORE CURRENT FORK
MOVEM A,FORK
TLZ Z,RUNF ;SAY PROG'S TTY MODES NOT IN EFFECT
MOVEI Q1,ETTYMD ;RESTORE EXEC'S TTY MODES
CALL LTTYMD ; ..
RET
SYSLOS: ETYPE <%_%%%Error while reading system message - %?%%_>
JRST SYSLEV
;[7.1076]
;NODCHK - Called when SYSTAT is getting ready to do a job. First we
;must check to see if the job is local or if we must force SYSTAT
;to obtain the information from another system in the cluster.
;
; Called wtih:
; A/ Job number
; CALL NODCHK
;
; Returns:
; +1 - Job not logged into any node
; +2 - Job logged in with CURNOD, CURNDN, INFSYS and F4 setup
;
;Must clobber no ACs except Z!!!
NODCHK: SAVEAC <A,B,C,D,Q2,Q3,P1,P2> ;Preservation here
STKVAR <JOB> ;Temp storage
TLZ Z,F4 ;Say job is local until otherwise discovered
TXNN Q1,SY%NOD ;User say node?
RETSKP ;No, so everything is local
MOVEM A,JOB ;Save job number for later useage
MOVEI A,CFGBLK ;[7.1089] Node names are in here
MOVE A,1(A) ;[7.1089] Here's the local node name
MOVEM A,CURNOD ;[7.1089] This is the name by default
SKIPE JOB ;[7.1089] Do we have a non-zero job?
IFSKP. ;[7.1089] If job 0,
SKIPE P1,SYJOBM ;[7.1139] Get SYSJOB mask
IFSKP. ;[7.1139] If there isn't one, do what we always did
MOVEI A,CFGNOD ;[7.1089] This is where the node numbers are
HLRZ A,1(A) ;[7.1089] Get our node number
MOVE A,BITS(A) ;[7.1089] This is the bit setting for our node
TDNN A,NODMSK ;[7.1089] Is our node in this mask
RET ;[7.1089] No, then say job not found
RETSKP ;[7.1089] Job 0 is always local
ENDIF. ;[7.1139]
JFFO P1,.+1 ;[7.1139] Get bit setting
MOVE A,BITS(P2) ;[7.1139] Get bit for this node
ANDCAM A,SYJOBM ;[7.1139] Clear it. We only want this SYSJOB once
JRST NODC15 ;[7.1139] We know it exists, get information
ENDIF. ;[7.1089]
MOVE P1,NODMSK ;Here's the node mask
DO. ;Loop over CI nodes
JFFO P1,NODCH1 ;Get a bit
EXIT. ;If no more, then we are done
NODCH1: MOVE A,BITS(P2) ;Get the bit setting we jumped on
TDZ P1,A ;Clear this one
SKIPN A,JRCASH(P2) ;Get job range for this node
JRST TOP. ;[7.1089] We have no range, do next node
HLRZ Q2,A ;Get min job
HRRZ Q3,A ;Get max job
CAMLE Q2,JOB ;Too small?
JRST TOP. ;Yes, too small
CAMGE Q3,JOB ;Or in range?
JRST TOP. ;If not, then try another node
NODC15: SETZ Q2, ;[7.1139] Here's our counter through the CNFIG% tables
DO. ;Now set up CURNOD and CURNDN
AOS Q2 ;Bump this up
HLRZ A,CFGNOD(Q2) ;Get node number
CAME A,P2 ;Is this the one we are looking for?
JRST TOP. ;If not, try the next one
ENDDO.
MOVEM P2,CURNDN ;Save CI node number
MOVE A,CFGBLK(Q2) ;Get byte pointer to node name
MOVEM A,CURNOD ;And save for other routines
CAIN Q2,1 ;Is it the local node?
RETSKP ;Yes, let everyone else do the work
TLO Z,F4 ;No, tell everyone else to use INFO%
CALL ZERSYS ;(/) Zero out SYSTAT data area
MOVEI A,INFBLK ;And get the job information now
MOVEM P2,.INCID(A) ;[7.1089] This is the CI node
MOVEI B,INFSYS ;Here's the SYSTAT block
SETZM .SYJCT(B) ;[4412] Clear this in case we don't get something
HRROI C,UNAME ;User name goes here
MOVEM C,.SYUSR(B) ;Make sure JSYS knows
HRROI C,DIRN ;Connected directory name here
MOVEM C,.SYDIR(B) ;Tell JSYS
HRROI C,ORGN ;Job origin here
MOVEM C,.SYORG(B) ;Save
MOVEM B,.INAC1(A) ;Here's the SYSTAT block
MOVE B,[.INSYS,,INFLEN] ;Do this function
MOVEM B,.INFUN(A) ;Save function
MOVE B,JOB ;Here's the job number
MOVEM B,.INAC2(A) ;Save job number
INFO% ;Get job information
ERJMP CJERR ;Darn crashing nodes
TXZN A,IN%RER ;[7.1089] Did job go away?
RETSKP ;[7.1089] No, we are done
TLZ Z,F4 ;[7.1089] Yes, show no remote job found yet
JRST TOP. ;Continue
ENDDO.
RET ;Could not find a remote node to use
ENDSV.
;[7.1076]
;ZERSYS - This routine is called to zero out the words used by the
;INFO% JSYS' SYSTAT function. This will ensure no left over stuff
;
; Call with:
; No arguments
; CALL ZERSYS
;
; Returns:
; +1 - Always, with UNAME, DIRN, ORGN all zeroed out
;
;Clobbers nothing
ZERSYS: SAVEAC <A,B> ;Be neat
SETZM UNAME ;Smash user name area
MOVE A,[UNAME,,UNAME+1] ;Now do whole block
BLT A,UNAME+7 ;Zero it out
SETZM DIRN ;Now blow out connected directory name
MOVE A,[DIRN,,DIRN+1] ;Prepare for whole block
BLT A,DIRN+20 ;Do it
SETZM ORGN ;Last is origin name
MOVE A,[ORGN,,ORGN+1] ;Get ready
BLT A,ORGN+20 ;Get set, and go
RET
;[7.1089]
;CSHJOB - Routine to put job range of each system in the cache table
;
; Call with:
; NODMSK setup
; CALL CSHJOB
;
; Returns:
; +1 - Always with JRCASH setup
CSHJOB: SAVEAC <P1,P2> ;Save these
STKVAR <NODBIT> ;[7.1100] Save node bit we are working on
SETZM JRCASH ;Init this to all zeroes
MOVE A,[JRCASH,,JRCASH+1] ;Start with this
BLT A,JRCASH+17 ;Now zero out the table
MOVEI A,INFBLK ;INFO% block is here
MOVE B,[.INCIN,,INFLEN] ;This is the function
MOVEM B,.INFUN(A) ;Save function
MOVEI B,INFCIN ;Put CI nodes here
MOVEM B,.INAC1(A) ;Tell JSYS
INFO% ;Get CI nodes
ERJMP CJERR ;Failure
SETZ P1, ;Our loop counter
HLRZ P2,CFGNOD ;Our loop fence
DO.
AOS P1 ;Do the first CI node
HLRZ A,CFGNOD(P1) ;Get me a CI node number
MOVE C,BITS(A) ;Get its bit setting
TDNN C,NODMSK ;Is this node in our mask?
JRST CSHJB1 ;No, next node
MOVEM C,NODBIT ;[7.1100] Hold the bit for now
MOVE B,INFCIN ;Get count
DO. ;See if this node is doing INFO%
SOSG B ;Done checking?
IFSKP. ;Nope,
CAMN A,INFCIN(B) ;Is this the node we want?
EXIT. ;If so, good, he is doing INFO%
JRST TOP. ;Not done checking yet
ENDIF.
TXNE Q1,SY%NJB ;[7.1100] NODPRT going print name?
IFSKP. ;[7.1100] If not,
CALL NOINF ;[7.1100] (A/) Then do it now
MOVE C,NODBIT ;[7.1100] And clear node setting
ANDCAM C,NODMSK ;[7.1100] Don't try things on this node
ENDIF. ;[7.1100]
JRST CSHJB1 ;So ignore it and try others
ENDDO.
MOVEI B,INFBLK ;Get JSYS block
MOVEM A,.INCID(B) ;Save the node number
MOVEI A,INFBLK ;Block goes here for JSYS call
MOVE B,[.INGTB,,INFLEN] ;Get active job range
MOVEM B,.INFUN(A) ;Do this function
MOVE B,[56,,.SYSTA] ;Get active job range
MOVEM B,.INAC1(A) ;Put in JSYS block
INFO% ;Get active job range
ERJMP CJERR ;Report failure
MOVE B,.INAC1(A) ;Here's the active job range
MOVE A,.INCID(A) ;Get node number back
MOVEM B,JRCASH(A) ;Save in cache table
CSHJB1: CAME P1,P2 ;Have we done enough?
JRST TOP. ;No
ENDDO.
RET ;Done
;[7.1100]
;CHCLAS - Routine to see if any machine in the node mask is running
;class scheduling. If no machines are running class scheduling, then
;it is relatively useless to display the class scheduling stuff.
;
; Call with:
; NODMSK setup in the SYSTAT TRVAR
; CALL CHCLAS
;
; Returns:
; +1 - No machines in the node mask have class scheduling turned on
; +2 - At least one machine is running class scheduling
;
;Clobbers nada
CHCLAS: SAVEAC <A,B,C,D> ;Save bashed things
STKVAR <<SKDBLK,3>> ;SKED% JSYS block and return flag
MOVE C,NODMSK ;Get node mask
DO. ;Loop over each node
JFFO C,CHCLS1 ;Get a bit setting
EXIT. ;No more nodes, done
CHCLS1: MOVE A,BITS(D) ;Get bit setting for node we are checking
TDZ C,A ;Zero it in our loop indicator
MOVEI A,INFBLK ;Here's our INFO% block
MOVEM D,.INCID(A) ;Save node number we are checking
MOVE B,[.INSKD,,INFLEN] ;Want to do SKED% function
MOVEM B,.INFUN(A) ;Save in argument block
MOVEI B,.SKRCV ;Read class scheduling stuff
MOVEM B,.INAC1(A) ;Save in arg block
MOVEI B,3 ;SKED% block is 3 words long
MOVEM B,SKDBLK ;Stash length in SKED% block
MOVEI B,SKDBLK ;Here is the SKED% block
MOVEM B,.INAC2(A) ;Show JSYS where
INFO% ;Get remote class scheduling setting
ERJMP TOP. ;Ignore error
TXNE A,IN%RER ;Remote error?
JRST TOP. ;Yes, assume no class scheduling
MOVE A,.SACTL(B) ;Get setting as returned by remote
TXNE A,SK%STP ;Class scheduling on?
IFSKP. ;[7.1140] If so,
MOVE A,BITS(D) ;[7.1140] Get bit setting
IORM A,CLSMSK ;[7.1140] And note this system is doing class scheduling
ENDIF. ;[7.1140]
JRST TOP. ;No, check another node
ENDDO.
SKIPE CLSMSK ;[7.1140] Anyone doing class scheduling?
RETSKP ;[7.1140] Someone was...
RET ;No one is running class scheduling
;[7.1100]
;NOINF - This routine is called when we have determined that a node
;is not supplying information for SYSTAT. It may be called from NODPRT
;or from CSHJOB depending on whether or not the system header appears
;in the SYSTAT.
;
; Call with:
; A/ Node not doing information
; CALL NOINF
;
; Returns:
; +1 - Always, with " NODE %Information unavailable" displayed
;
;Clobbers lots
NOINF: HLRZ B,CFGNOD ;Get our loop counter
DO.
SOSG B ;Done checking for node name?
IFSKP. ;If not,
HLRZ C,CFGNOD(B) ;Get the node number of this system
CAME A,C ;Is this the one?
JRST TOP. ;No, do next node
MOVE A,CFGBLK(B) ;This is the node we want
PRINT " " ;Make first column a space
MOVEI B,6 ;Make sure we do 6 characters
DO. ;Do the characters
ILDB C,A ;Get a character
ETYPE <%3\> ;Do a character
JUMPE C,ENDLP. ;Null? Yes, fill in remaining spaces
SOJG B,TOP. ;Keep doing characters
ENDDO.
IFG. B ;More characters to do?
DO. ;Print them out
PRINT " " ;Here's a space
SOJG B,TOP. ;Do more
ENDDO.
ENDIF.
ETYPE < %%Information unavailable%_>
ENDIF.
ENDDO.
RET
;[7.1137]
;CHKWLD - This routine is called after SYSTAT has parsed some flavor
;of username. The username is left in ATMBUF by that marvelous JSYS
;called COMND%. This routine checks to see if the string returned in
;the atom buffer is wildcarded.
;
; Call with:
; ATMBUF setup via COMND%
; CALL CHKWLD
;
; Returns:
; +1 - Failure, string does not contain wild card character
; +2 - Success, string in ATMBUF is wild
;
; Bashes no ACs and let's keep it that way!
CHKWLD: SAVEAC <A,B,C> ;We are keeping it that way
MOVX A,RC%AWL ;Allow wild card characters
HRROI B,ATMBUF ;Check out that atom buffer
RCUSR% ;Valid user?
ERJMP CJERR ;Shouldna happen, captain
TXNN A,RC%WLD ;Verdict: was there a wild card character?
RET ;No ther wasn't
RETSKP ;Yes there was
END