Trailing-Edge
-
PDP-10 Archives
-
bb-m081w-sm_t20_v7_0_02_exec_src_mod
-
exec/execsu.mac
There are 47 other files named execsu.mac in the archive. Click here to see a list.
; Edit= 4425 to EXECSU.MAC on 14-Mar-89 by GSCOTT
;Rewrite ATTACH command to allow user to pick a job to attach to if more than
;one candidate job. Also allow ETYPE's %L to take an AC argument.
; Edit= 4421 to EXECSU.MAC on 28-Feb-89 by GSCOTT
;Suppress columnization in ETYPE %W's ODTIM.
; Edit= 4420 to EXECSU.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= 4419 to EXECSU.MAC on 9-Feb-89 by GSCOTT
;INFORMATION JOB command should show network origin. %L now will output this.
; Edit= 4412 to EXECSU.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4405 to EXECSU.MAC on 5-May-88 by RASPUZZI (TCO 7.1284)
;Don't trash AC 0. Fix SETO instruction introduced by edit 4402.
; Edit= 4402 to EXECSU.MAC on 5-Apr-88 by EVANS (TCO 7.1265)
;Make the EXEC accept non-alphanumeric characters $,_,-,and . in LAT-type
;names for remote printing.
; Edit= 4401 to EXECSU.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= 4129, RIP:<7.EXEC>EXECSU.MAC.9, 7-Mar-88 18:27:47 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 49, RIP:<7.EXEC>EXECSU.MAC.8, 27-Oct-87 17:24:01 by RASPUZZI
;TCO 7.1085 - Don't make AUTOLO do a DOBE% because the terminal origin may
; no longer be valid. This causes phantom jobs to hang around.
; Instead, DISMS% for a short time period, then kill the job
; UPD ID= 48, RIP:<7.EXEC>EXECSU.MAC.7, 27-Oct-87 17:20:18 by GSCOTT
;TCO 7.1083 - Change characteristic bit mask storage for 8 bit byte pointer.
; UPD ID= 44, RIP:<7.EXEC>EXECSU.MAC.5, 22-Oct-87 11:04:44 by RASPUZZI
;TCO 7.1076 - Make routine TOUT globally accessible
; UPD ID= 22, RIP:<7.EXEC>EXECSU.MAC.4, 22-Sep-87 11:29:04 by EVANS
; More TCO 7.1061 - Fill in TCO numbers around edits and add header line.
; UPD ID= 17, RIP:<7.EXEC>EXECSU.MAC.3, 22-Sep-87 10:48:18 by EVANS
; TCO 7.1061 - Implement SET REMOTE-PRINTING CHARACTERISTIC and INFORMATION
; (ABOUT) REMOTE-PRINTING.
; *** Edit 3068 to EXECSU.MAC by EVANS on 15-May-87, for SPR #21620
; Allow INFO MAIL when not logged in - don't check for POBXNO at MALCHK:.
; *** Edit 3066 to EXECSU.MAC by EVANS on 29-Apr-87
; Add the string 'POBOX:' to the error message after the DIRST so the user
; knows what it refers to.
; *** Edit 3065 to EXECSU.MAC by EVANS on 28-Apr-87
; Change error handling after DIRST in MALCHK to avoid looping.
; *** Edit 3063 to EXECSU.MAC by MCCOLLUM on 21-Apr-87, for SPR #20642
; Release unwanted fork handles after a GFRKS% JSYS
; *** Edit 3050 to EXECSU.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 EXECSU.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 3044 to EXECSU.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 3040 to EXECSU.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 3038 to EXECSU.MAC by RASPUZZI on 22-May-86
; Fix minor MACRO problem with edit 3037
; *** Edit 3037 to EXECSU.MAC by RASPUZZI on 21-May-86
; More of edit 3033 - extend GTJFN blocks so that the we have room for all
; GTJFN words when called.
; *** Edit 3031 to EXECSU.MAC by PRATT on 15-Apr-86, for SPR #20805
; Fix double prompts when not logged in and user gets an error.
; *** Edit 3029 to EXECSU.MAC by WAGNER on 4-Apr-86, for SPR #20747
; Modify Autologout code to do a DOBE before LGOUT%
; Edit 3019 to EXECSU.MAC by EVANS on 22-Oct-85 (TCO none )
; Make ASOUT work right when passed a specific number of bytes to be copied -
; was failing after one byte copied. (QAR 838282)
; Edit 3017 to EXECSU.MAC by EVANS on 15-Oct-85 (TCO none)
; Prevent a SET DEFAULT (GALAXY-related) command from echoing twice if issued
; from a TAKE file with subcommand ECHO. QAR 838277
; UPD ID= 256, SNARK:<6.1.EXEC>EXECSU.MAC.31, 20-Jun-85 14:21:50 by EVANS
;More TCO 6.1.1404 - Test NOSAVE flag before saving commands.
; UPD ID= 249, SNARK:<6.1.EXEC>EXECSU.MAC.30, 14-Jun-85 15:53:20 by EVANS
;More TCO 6.1.1404 - Fix for command editor bug (HISTORY saving PCL subcommands)
; UPD ID= 241, SNARK:<6.1.EXEC>EXECSU.MAC.29, 10-Jun-85 08:45:30 by DMCDANIEL
; UPD ID= 207, SNARK:<6.1.EXEC>EXECSU.MAC.28, 24-May-85 14:14:21 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 187, SNARK:<6.1.EXEC>EXECSU.MAC.27, 6-May-85 11:10:20 by PRATT
;More TCO 6.1.1353 - ERJMP should be JRST after call to GNJFS
; UPD ID= 182, SNARK:<6.1.EXEC>EXECSU.MAC.26, 3-May-85 08:32:46 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 158, SNARK:<6.1.EXEC>EXECSU.MAC.25, 2-May-85 11:17:32 by PRATT
;TCO 6.1.1353 - GNJFS for checking GNJFN failures and stacked jfns
; UPD ID= 135, SNARK:<6.1.EXEC>EXECSU.MAC.24, 14-Mar-85 10:53:46 by PRATT
;TCO 6.1.1257 - If DBGEXC is set, make ^T display exec pc's during commands
; UPD ID= 133, SNARK:<6.1.EXEC>EXECSU.MAC.23, 7-Mar-85 19:56:24 by PRATT
;TCO 6.1.1243 - Better help in OCTLST (octal number list) routine
; UPD ID= 121, SNARK:<6.1.EXEC>EXECSU.MAC.22, 8-Jan-85 15:00:42 by MCCOLLUM
;Add a <CRLF> after the "%Not superseding current file" message
; UPD ID= 115, SNARK:<6.1.EXEC>EXECSU.MAC.21, 18-Dec-84 12:48:22 by TBOYLE
;TCO 6.1.1092 - Fix jobs hung as EXEC not logged in. Remove DOBE at autol6
; UPD ID= 105, SNARK:<6.1.EXEC>EXECSU.MAC.20, 11-Dec-84 15:22:07 by MOSER
;TCO 6.1.1077 - ADD STAT STUFF
; UPD ID= 99, SNARK:<6.1.EXEC>EXECSU.MAC.18, 4-Dec-84 11:27:08 by MCCOLLUM
;Fix ERJMP to bad literal in GTSTAD.
; UPD ID= 98, SNARK:<6.1.EXEC>EXECSU.MAC.17, 27-Nov-84 13:04:12 by PRATT
;TCO 6.1.1063 - Fix typo in MAPPF when no current fork
; UPD ID= 89, SNARK:<6.1.EXEC>EXECSU.MAC.15, 14-Nov-84 11:11:02 by MCCOLLUM
;More of TCO 6.1.1025 - Replace an edit that disappeared
; UPD ID= 85, SNARK:<6.1.EXEC>EXECSU.MAC.14, 12-Nov-84 16:22:00 by MCCOLLUM
;TCO 6.1.1044 - Add NEWER option to SPRCHK
; UPD ID= 67, SNARK:<6.1.EXEC>EXECSU.MAC.13, 12-Nov-84 03:51:30 by MERRILL
;TCO 6.1.1042 - Update for the latest PCL we have
; Make ^T work in a reasonable manner (consistent with what it does
; with builtin commands) when a PCL command is in progress.
; Make assignments to $PromptReg and friends cause the prompt to
; change immediately (instead of after the next command or ^C).
; Don't close PCL PTY in CIOREL.
; Don't call CMDINI in EOFJER if a PCL is running, it breaks DOCOMMAND.
; Check FK%INV fork flag instead of PCPRGR to determine if a program
; has been INVOKE'd.
; Don't blow up if user ^C's during PRESERVE EXEC.
; Attack error handlers to make sure we don't end up in subcommand
; mode if a DOCOMMAND blows up while inputting subcommands.
; Make a change to DOGET whose raison d'etre has long been forgotten.
; Make NOTIO check if JFN in use by PCL system.
; UPD ID= 54, SNARK:<6.1.EXEC>EXECSU.MAC.12, 5-Nov-84 15:19:33 by MCCOLLUM
;More of TCO 6.1.1025 - Fix up calling sequence to MFSET
; UPD ID= 44, SNARK:<6.1.EXEC>EXECSU.MAC.11, 30-Oct-84 13:53:34 by MCCOLLUM
;TCO 6.1.1025 - Add routines SPRCHK and GTSJFN for COPY SUPERSEDE.
; UPD ID= 42, SNARK:<6.1.EXEC>EXECSU.MAC.10, 26-Oct-84 16:17:25 by EVANS
;TCO 6.1.1027 - reprised - Zero LGORET when do error message. GOOD return
; from successful TAKE of LOGOUT.CMD is in here too.
; UPD ID= 41, SNARK:<6.1.EXEC>EXECSU.MAC.9, 26-Oct-84 13:36:37 by EVANS
;TCO 6.1.1027 - Clear LGORET (taking LOGOUT.CMD file) on ^C or error.
; UPD ID= 32, SNARK:<6.1.EXEC>EXECSU.MAC.8, 3-Oct-84 17:09:23 by PRATT
;TCO 6.2235 - Fix problem with ^T during ^C of ephemoral programs
; UPD ID= 24, SNARK:<6.1.EXEC>EXECSU.MAC.7, 1-Oct-84 22:40:30 by PRATT
;TCO 6.1.1019 - Make DEVN routine set CM%NSF nosuffix flag
; UPD ID= 18, SNARK:<6.1.EXEC>EXECSU.MAC.6, 29-Sep-84 21:33:24 by PRATT
;TCO 6.1.1018 - Move ASOUT to here and make READNM use it
; UPD ID= 3, SNARK:<6.1.EXEC>EXECSU.MAC.2, 28-Sep-84 12:52:22 by PRATT
;TCO 6.1.1012 - Reset terminal characteristics after unformatted TYPE
; UPD ID= 446, SNARK:<6.EXEC>EXECSU.MAC.65, 26-Sep-84 16:46:38 by MCCOLLUM
;TCO 6.2229 - Check private name in USEX and print subsys name if null.
; UPD ID= 427, SNARK:<6.EXEC>EXECSU.MAC.64, 23-Jul-84 13:27:25 by PRATT
;TCO 6.2140 - Fix error return problem in MAPPF when pages can't be mapped
; UPD ID= 424, SNARK:<6.EXEC>EXECSU.MAC.63, 19-Jul-84 14:41:05 by PRATT
;TCO 6.2135 - Fix CMERR$ to rewrite the null byte
; UPD ID= 405, SNARK:<6.EXEC>EXECSU.MAC.62, 3-May-84 08:19:19 by SHTIL
; UPD ID= 383, SNARK:<6.EXEC>EXECSU.MAC.61, 26-Jan-84 17:00:05 by MCCOLLUM
;TCO 6.1957 - Fix label at %X2+5 from %X to %X4, like it should be
; UPD ID= 372, SNARK:<6.EXEC>EXECSU.MAC.60, 5-Jan-84 10:16:21 by PRATT
;TCO 6.1923 - If detached bypass the DVCHR in LTTYMD and RTTYMD
; UPD ID= 350, SNARK:<6.EXEC>EXECSU.MAC.59, 29-Nov-83 10:51:43 by PRATT
;TCO 6.1874 - Modify USRNAM for the INFO MAIL command.
; UPD ID= 342, SNARK:<6.EXEC>EXECSU.MAC.58, 20-Nov-83 19:45:24 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 332, SNARK:<6.EXEC>EXECSU.MAC.56, 18-Nov-83 14:34:21 by TSANG
;More TCO 6.1837
; UPD ID= 324, SNARK:<6.EXEC>EXECSU.MAC.55, 10-Nov-83 14:12:11 by TSANG
;TCO 6.1837 - Make error character consistent in RENAME, DIRECTORY, DELETE, ARCHIVE and DISCARD.
; UPD ID= 312, SNARK:<6.EXEC>EXECSU.MAC.53, 26-Sep-83 19:37:43 by MILLER
;TCO 6.1758. Change other MALCHK routine
; UPD ID= 309, SNARK:<6.EXEC>EXECSU.MAC.52, 1-Sep-83 10:09:46 by PRATT
;TCO 6.1790 - Remove CLZFF CZ%NCL bit used in RERET. Cleans up lost jfns
; UPD ID= 304, SNARK:<6.EXEC>EXECSU.MAC.51, 8-Aug-83 11:23:17 by TSANG
;TCO 6.1760 - Make the error character consist in RENAME command.
; UPD ID= 303, SNARK:<6.EXEC>EXECSU.MAC.50, 3-Aug-83 10:54:21 by MILLER
;TCO 6.1758. Look on POBOX: for MAIL.TXT files
; UPD ID= 290, SNARK:<6.EXEC>EXECSU.MAC.49, 21-Jun-83 15:18:35 by WEETON
;TCO 6.1698 - Fix WORD$ so that BUILD command works when disabled
; UPD ID= 267, SNARK:<6.EXEC>EXECSU.MAC.48, 8-Apr-83 15:55:35 by TSANG
;TCO 6.1519- CHANGE FIELD TO FIELDX SO AS NOT TO CONFLICT WITH MACSYM
;TCO 6.1516 - Make ^O... appear on TTY: only
; UPD ID= 263, SNARK:<6.EXEC>EXECSU.MAC.47, 7-Mar-83 14:28:55 by WEETON
;TCO 6.1535 - Allow wild carding on DIRECTORY TYPE commands
; UPD ID= 261, SNARK:<6.EXEC>EXECSU.MAC.46, 21-Feb-83 00:44:42 by MURPHY
;TCO 6.1514 - Error code not in AC if ERJMP taken at RJFNE and GTFAIL.
; UPD ID= 260, SNARK:<6.EXEC>EXECSU.MAC.45, 14-Feb-83 11:48:12 by LOMARTIRE
;TCO 6.1499 - Fix COPY FOO.*.* BAR.*.*;T so that destination files are ;T
; UPD ID= 254, SNARK:<6.EXEC>EXECSU.MAC.44, 26-Jan-83 18:48:48 by PAETZOLD
;TCO 6.1478 - Prevent killer mail files in MALLCL
; UPD ID= 253, SNARK:<6.EXEC>EXECSU.MAC.43, 18-Jan-83 16:20:50 by WEETON
;TCO 6.1450 - Fix Daylight Saving Time change over problems (this TCO
; supercedes TCO 6.1338)
; UPD ID= 248, SNARK:<6.EXEC>EXECSU.MAC.42, 15-Jan-83 19:26:55 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 232, SNARK:<6.EXEC>EXECSU.MAC.41, 14-Jan-83 14:55:50 by TSANG
;TCO 6.1461 - In CTRL/T, if program name = EXEC, try to get last run
; program name.
;TCO 6.1460 - Use GETNM to get running fork's name instead of table lookup.
;TCO 6.1459 - Save AC .FP during subcommand processing for use in error
; recovery.
; UPD ID= 227, SNARK:<6.EXEC>EXECSU.MAC.40, 12-Jan-83 15:30:47 by WEETON
;TCO 6.1141 When ETYPE <%X> is called from "INFO PROG", don't print "?" in
; first column.
; UPD ID= 221, SNARK:<6.EXEC>EXECSU.MAC.39, 11-Jan-83 15:05:50 by CHALL
;TCO 6.1451 JFNSIL- SEE IF JFN IS RESTRICTED BEFORE SEEING IF IT HAS A NAME
; UPD ID= 219, SNARK:<6.EXEC>EXECSU.MAC.38, 11-Jan-83 11:36:02 by TSANG
;TCO 6.1114 - Make subcommand ECHO of TAKE command works.
; UPD ID= 218, SNARK:<6.EXEC>EXECSU.MAC.37, 10-Jan-83 14:26:04 by TSANG
;TCO 6.1128 - Check correctly at GETLPC for waiting interrupt levels.
; UPD ID= 190, SNARK:<6.EXEC>EXECSU.MAC.36, 1-Nov-82 16:23:28 by WEETON
;TCO 6.1338 - Add correction for ending Daylight Saving Time
; UPD ID= 175, SNARK:<6.EXEC>EXECSU.MAC.35, 8-Oct-82 18:03:21 by CHALL
;MORE TCO 6.1270 MFINP0- ADD MISSING JS%DIR TO JFNS CALL
; UPD ID= 168, SNARK:<6.EXEC>EXECSU.MAC.34, 30-Sep-82 16:33:52 by MCINTEE
;TCO 6.1270 - larger CRDIR block - remote alias list
; UPD ID= 164, SNARK:<6.EXEC>EXECSU.MAC.33, 28-Sep-82 10:12:42 by TSANG
;TCO 6.1250 SET BREAK MASK TO PARSE A PASSWORD IN WORDX.
;TCO 6.1249 FIX SET LATE-CLEAR-TYPEAHEAD COMMAND
; UPD ID= 143, SNARK:<6.EXEC>EXECSU.MAC.32, 4-Aug-82 17:30:46 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 121, SNARK:<6.EXEC>EXECSU.MAC.31, 20-Apr-82 07:55:08 by CHALL
;TCO 6.1097 %GTB- Return 0 if GETAB table is unknown, for upward compatibility
;TCO 6.1092 USEPS2- Move MIC-calling code to EXECCA (USEPSM)
; UPD ID= 101, SNARK:<6.EXEC>EXECSU.MAC.28, 8-Jan-82 16:00:06 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 83, SNARK:<6.EXEC>EXECSU.MAC.27, 20-Dec-81 18:48:51 by CHALL
;TCO 6.1050 MAKE GTB A SUBROUTINE RATHER THAN A (WASTEFUL) UUO
; UPD ID= 81, SNARK:<6.EXEC>EXECSU.MAC.26, 20-Dec-81 18:10:26 by CHALL
;TCO 6.1049 FNODE$- RNODE$- DON'T REQUIRE "::" IN NODE NAME (SET CM%NSF)
; UPD ID= 56, SNARK:<6.EXEC>EXECSU.MAC.23, 21-Sep-81 09:25:15 by CHALL
;TCO 5.1518 CIOER1- DON'T OUTPUT MESSAGE ON ^C OF PCL COMMAND
; UPD ID= 53, SNARK:<6.EXEC>EXECSU.MAC.20, 11-Sep-81 09:20:47 by CHALL
;MORE TCO 5.1496 DT1- FIX A CAIE D,.CMTOK THAT SHOULD BE A CAIN
; UPD ID= 67, SNARK:<5.EXEC>EXECSU.MAC.17, 9-Sep-81 15:25:47 by GROUT
;TCO 5.1497 RESTORE .JB41 EARLIER IN ILL INST TRAP, AT ILIPSI
; UPD ID= 66, SNARK:<5.EXEC>EXECSU.MAC.16, 9-Sep-81 14:55:39 by GROUT
;TCO 5.1496 FIX UP TIMES INPUT TO /AFTER AND /SINCE TYPE SWITCHES
; UPD ID= 50, SNARK:<6.EXEC>EXECSU.MAC.19, 9-Sep-81 10:08:26 by CHALL
;TCO 5.1493 USEX- ON ^T MAKE SURE THERE'S A SPACE AFTER THE TIME
; UPD ID= 39, SNARK:<6.EXEC>EXECSU.MAC.17, 19-Aug-81 11:01:55 by CHALL
;TCO 5.1466 REPARS: CLEAR PCLDCO (ORIGINAL COMMAND FLAG) ON COMMAND REPARSE
; UPD ID= 23, SNARK:<6.EXEC>EXECSU.MAC.16, 17-Aug-81 10:24:00 by CHALL
;TCO 5.1455 PIOFF: - CLEAR CTLCF1 AND CTLCF2 FLAGS IN Z
;TCO 5.1454 CHANGE NAMES FROM SUBRS TO EXECSU AND XDEF TO EXECDE
; UPD ID= 7, SNARK:<6.EXEC>EXECSU.MAC.15, 14-Jul-81 17:07:40 by MURPHY
;DITTO
; UPD ID= 6, SNARK:<6.EXEC>EXECSU.MAC.14, 14-Jul-81 14:11:33 by MURPHY
;TCO 5.1410 - MACHINE SIZE EXCEEDED, OVER QUOTA, ETC.
; UPD ID= 2279, SNARK:<6.EXEC>EXECSU.MAC.13, 1-Jul-81 13:42:42 by CHALL
;TCO 5.1391 - CIOREL: PCMPOS SHOULD BE CALLED BEFORE FIXIO
; UPD ID= 2244, SNARK:<6.EXEC>EXECSU.MAC.12, 23-Jun-81 15:12:10 by OSMAN
;more 6.1023 - allow ddt/use-section:n even if no program
; UPD ID= 2213, SNARK:<6.EXEC>EXECSU.MAC.11, 18-Jun-81 15:58:45 by OSMAN
;tco 6.1023 - Make MAPPF give nonexistent return instead of error return
;when PMAP fails (presumably due to section not existing)
; UPD ID= 2173, SNARK:<6.EXEC>EXECSU.MAC.10, 11-Jun-81 10:03:21 by OSMAN
;tco 6.1022 - give error on a,,b if b is an illegal expression
; UPD ID= 2029, SNARK:<6.EXEC>EXECSU.MAC.9, 19-May-81 10:27:29 by PURRETTA
;<6.EXEC>EXECSU.MAC.7, 13-Apr-81 15:29:31, Edit by DK32
;PCL Fix DOGET to really clean up stack, Make some globals
; UPD ID= 1998, SNARK:<6.EXEC>EXECSU.MAC.8, 14-May-81 15:23:45 by MURPHY
; UPD ID= 1955, SNARK:<5.EXEC>EXECSU.MAC.3, 6-May-81 15:06:23 by MURPHY
; UPD ID= 1891, SNARK:<5.EXEC>EXECSU.MAC.2, 27-Apr-81 09:51:31 by ACARLSON
;<ACARLSON>EXECSU.MAC.2, 25-Apr-81 15:33:30, EDIT BY ACARLSON
;Modify PRIT1 so that it works with GALAXY 4.0 and GALAXY 4.1
;
; UPD ID= 1938, SNARK:<6.EXEC>EXECSU.MAC.7, 5-May-81 15:31:46 by ACARLSON
;<ACARLSON>EXECSU.MAC.2, 5-May-81 15:30:46, EDIT BY ACARLSON
; Make this EXEC run with both GALAXY 4.0 and GALAXY 5.0
; UPD ID= 1739, SNARK:<6.EXEC>EXECSU.MAC.6, 19-Mar-81 16:46:26 by OSMAN
;Make MAPPF give skip return even when section doesn't exist
; UPD ID= 1643, SNARK:<6.EXEC>EXECSU.MAC.5, 4-Mar-81 10:41:54 by OSMAN
;more 6.1004 - Do it in monitor instead of exec
; UPD ID= 1640, SNARK:<6.EXEC>EXECSU.MAC.4, 3-Mar-81 15:35:59 by OSMAN
;tco 6.1004 - Make DOCOMMANDs following DOCOMMAND of failed TAKE file
;work.
; UPD ID= 1585, SNARK:<6.EXEC>EXECSU.MAC.3, 25-Feb-81 14:11:19 by OSMAN
;tco 6.1001 - Fix PCL to not hang after DOCOMMAND "TAKE...".
;REMOVE MFRK CONDITIONALS
;<4.EXEC>EXECSU.MAC.1, 23-Dec-80 19:17:25, Edit by DK32
;Programmable Command Language
;SPR 14203,14601, CM236 Fixes
; UPD ID= 1433, SNARK:<5.EXEC>EXECSU.MAC.34, 13-Jan-81 09:57:54 by OSMAN
;More 5.1129 - Make EXAMINE show octal contents "...too, if different"
; UPD ID= 1403, SNARK:<5.EXEC>EXECSU.MAC.33, 6-Jan-81 10:28:12 by OSMAN
;tco 5.1225 - Implement jsys trapping and file-opening trapping!
; UPD ID= 1384, SNARK:<5.EXEC>EXECSU.MAC.32, 24-Dec-80 15:07:17 by OSMAN
;More 5.1214 - Unbreak ^H feature! (restore SBLOCK state)
; UPD ID= 1370, SNARK:<5.EXEC>EXECSU.MAC.31, 19-Dec-80 10:26:15 by OSMAN
;More 5.1214 - Make "COPY NONEXISTENTFILE<cr>" say which file wasn't found
; UPD ID= 1354, SNARK:<5.EXEC>EXECSU.MAC.30, 15-Dec-80 15:54:15 by OSMAN
;More 5.1214 - Use ADJBP instead of ADJSP (you turkey Eric!)
; UPD ID= 1351, SNARK:<5.EXEC>EXECSU.MAC.29, 12-Dec-80 16:57:47 by OSMAN
;TCO 5.1214 - Show erroneous part of command if available
; UPD ID= 1339, SNARK:<5.EXEC>EXECSU.MAC.28, 8-Dec-80 10:08:27 by ACARLSON
;<GALAXY.DEVELOPMENT>EXECSU.MAC.2, 8-Dec-80 09:58:58, EDIT BY ACARLSON
;TCO 5.1210 - Add routine GQSRPD to ask SYSINF for PID of private QUASAR
; UPD ID= 1326, SNARK:<5.EXEC>EXECSU.MAC.27, 1-Dec-80 16:03:07 by OSMAN
;Make NESC global, return from ADDR$ if escape typed
; UPD ID= 1294, SNARK:<5.EXEC>EXECSU.MAC.26, 19-Nov-80 10:31:25 by OSMAN
;GETARG only needs to be two words
; UPD ID= 1201, SNARK:<5.EXEC>EXECSU.MAC.25, 27-Oct-80 09:36:21 by SCHMITT
;TCO 5.1181 - Precede all EXEC BATCH prompts with a space
; UPD ID= 1176, SNARK:<5.EXEC>EXECSU.MAC.24, 20-Oct-80 16:59:32 by DONAHUE
;TCO 5.1176 - Let LFJFNS return a byte pointer to a null string rather
;than 0
; UPD ID= 1051, SNARK:<5.EXEC>EXECSU.MAC.23, 26-Sep-80 09:59:50 by OSMAN
;Fix FLOUT format to have symbolic representation
; UPD ID= 1047, SNARK:<5.EXEC>EXECSU.MAC.22, 25-Sep-80 15:10:11 by OSMAN
;tco 5.1158 - Make ^T show current time
; UPD ID= 1031, SNARK:<5.EXEC>EXECSU.MAC.21, 22-Sep-80 10:38:42 by OSMAN
;tco 5.1150 - Add SET PROGRAM
;Make %KEYW return entry address in B. (%KEYW no longer preserves temps!)
; UPD ID= 1017, SNARK:<5.EXEC>EXECSU.MAC.20, 16-Sep-80 10:18:10 by HESS
;New version of MIC
; UPD ID= 979, SNARK:<5.EXEC>EXECSU.MAC.19, 3-Sep-80 11:01:38 by DONAHUE
;TCO 5.1138 - Move label CCDB3 up 2 lines so CTRL/C resets CCOC word
; UPD ID= 884, SNARK:<5.EXEC>EXECSU.MAC.18, 13-Aug-80 13:31:24 by OSMAN
;More 5.1129 - Handle "?" correctly in memory addresses
; UPD ID= 868, SNARK:<5.EXEC>EXECSU.MAC.16, 11-Aug-80 10:59:57 by OSMAN
;More 5.1129 - Print exec's jsys error symbolically if appropriate
; UPD ID= 864, SNARK:<5.EXEC>EXECSU.MAC.15, 10-Aug-80 16:41:48 by OSMAN
;More 5.1129 - Fix
; UPD ID= 862, SNARK:<5.EXEC>EXECSU.MAC.14, 10-Aug-80 16:23:49 by OSMAN
;More 5.1129 - Allow halfword format for addresses
; UPD ID= 860, SNARK:<5.EXEC>EXECSU.MAC.13, 10-Aug-80 15:20:26 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
; UPD ID= 833, SNARK:<5.EXEC>EXECSU.MAC.12, 5-Aug-80 08:55:58 by OSMAN
;tco 5.1123 - Don't allow wildcarding in user names in USER$ routine
; UPD ID= 828, SNARK:<5.EXEC>EXECSU.MAC.11, 4-Aug-80 11:19:18 by OSMAN
;More 5.1113 - Fix broken JFNSTK
; UPD ID= 808, SNARK:<5.EXEC>EXECSU.MAC.10, 30-Jul-80 10:02:18 by OSMAN
;tco 5.1115 - Prevent looping "?File or Swapping space exceeded..."
; UPD ID= 802, SNARK:<5.EXEC>EXECSU.MAC.9, 28-Jul-80 09:53:28 by OSMAN
;TCO 5.1113 - Make RLJFNS/FLJFNS return 0 for success and 1 for error
;Note: As of this change, RLJFN / FLJFNS no longer preserve temps!
; UPD ID= 594, SNARK:<5.EXEC>EXECSU.MAC.8, 3-Jun-80 10:35:39 by OSMAN
;tco 5.1058 - Make ^T not clobber 16.
;<5.EXEC>EXECSU.MAC.7, 30-May-80 16:59:00, EDIT BY MURPHY
;NEW MAIL WATCH AND ALERT UNDER NEWF
; UPD ID= 540, SNARK:<5.EXEC>EXECSU.MAC.6, 20-May-80 15:54:32 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
;<5.EXEC>EXECSU.MAC.5, 15-May-80 14:53:30, EDIT BY OSMAN
;More DATBIT.
; UPD ID= 519, SNARK:<5.EXEC>EXECSU.MAC.4, 14-May-80 13:19:39 by OSMAN
;Implement DATBIT
; UPD ID= 496, SNARK:<5.EXEC>EXECSU.MAC.3, 30-Apr-80 14:36:20 by OSMAN
;<OSMAN.EXEC>EXECSU.MAC.2, 30-Apr-80 13:42:11, EDIT BY OSMAN
;tco 5.1028 - Echo erroneous commands from TAKE files
; UPD ID= 459, SNARK:<4.1.EXEC>EXECSU.MAC.15, 22-Apr-80 16:42:28 by OSMAN
;tco 4.1.1145 - Make ADVISE smarter about "line not active"
;<4.1.EXEC>EXECSU.MAC.14, 9-Apr-80 14:31:42, EDIT BY OSMAN
;Make GETDIR leave account pointer good in .CDDAC
;<4.1.EXEC>EXECSU.MAC.12, 17-Mar-80 14:05:48, EDIT BY OSMAN
;Handle ONEWRD in one place
; UPD ID= 309, SNARK:<4.1.EXEC>EXECSU.MAC.11, 10-Mar-80 13:37:48 by OSMAN
;tco 4.1.1103 - Prevent spurious mail activity by changing CAMLE C,D to CAML
;<4.1.EXEC>EXECSU.MAC.10, 29-Feb-80 13:59:11, EDIT BY OSMAN
;tco 4.1.1097 - Don't say "string space exhausted" after many DELETE commands
; UPD ID= 241, SNARK:<4.1.EXEC>EXECSU.MAC.9, 4-Feb-80 11:11:59 by OSMAN
;tco 4.1.1078 - Make echoing of .CMD lines always happen on error if requested
; UPD ID= 237, SNARK:<4.1.EXEC>EXECSU.MAC.8, 1-Feb-80 08:54:38 by OSMAN
;Change IPCIDX to IPCIX
; UPD ID= 228, SNARK:<4.1.EXEC>EXECSU.MAC.7, 28-Jan-80 10:39:33 by OSMAN
;tco 4.1.1075 - Add IPCIDX
;<4.1.EXEC>EXECSU.MAC.3, 20-Nov-79 10:30:51, EDIT BY OSMAN
;TCO 4.1023 - Fix TAKE stuff
;<4.1.EXEC>EXECSU.MAC.2, 1-Nov-79 13:39:12, EDIT BY OSMAN
;tco 4.1.1005 - Fix I MEM when restricted jfn is involved
; 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 - SUBROUTINES
SEARCH EXECDE
TTITLE EXECSU
;THIS FILE CONTAINS SUBROUTINES AND SERVICE ROUTINES IN THREE SECTIONS:
; 1. MONITOR-INDEPENDENT LANGUAGE DECODING OPERATIONS
; 2. MONITOR-DEPENDENT OPERATIONS, E.G. I/O
; 3. PSEUDO-INTERRUPT AND ERROR PROCESSORS
;INTERNS -- ROUTINES IN THIS ASSEMBLY
INTERN READY,READ1,READY2,REPARS ;PRINT ONE OR TWO READY CHARACTERS (@ OR !)
INTERN PRVCK ;ROUTINE FOR CHECKING PRIVILEGES
INTERN %KEYW ;SERVICE ROUTINE FOR KEYWORD LOOKUP UUO (KEYWD)
INTERN %NOI ;SERV ROUTINE FOR NOISE WORD UUO ("NOISE" MACRO)
INTERN %SBCOM ;UUO TO INPUT AND DISPATCH ON SUBCOMMANDS
INTERN CONF ;TERMINATE AND CONFIRM COMMAND
INTERN SPRTR ;ANALYZE SEPARATOR/TERMINATOR IN ARG LIST
DEFINE XX (FOO)
<
INTERN FOO'$
>
ULIST
INTERN COUTFN,CSAVFN,SPECFN,CPFN,CPFNA ;INPUT IN, OUT, SPECIAL, PROG FILE NAMES
INTERN .INFG,$INFGX,DIRARG ;INPUT FILE GROUP DESCRIPTORS
INTERN TYPIF,TYPOK,GNFIL ;ROUTINES FOR STEPPING THRU FILES IN GRP
INTERN DEVN ;COLLECT DEVICE NAME
INTERN TOCT,OCTCOM,TOUT,TOUTD ;NUMBER OUTPUT SUBRS
INTERN BUFFF ;BUFFER LAST FIELD SUITABLY FOR USE AS JSYS ARG
INTERN NOECHO,DOECHO,LTTYMD,RTTYMD ;TTY MODES ETC
INTERN %PRINT ;OUTPUT CHARACTER UUO
INTERN MAPPF ;MAP PAGE OF FORK SUBR
INTERN LOADF ;LOAD WORD FROM FORK SUBR
INTERN STOREF ;STORE WORD INTO FORK SUBR
INTERN %GTB ;CONVENIENT GETAB JSYS CALL ROUTINE
INTERN USEPSI ;TERMINAL PSI TO PRINT RUNTIME (^T)
INTERN NIYE,NIM,SCREWUP,JERR,JERRC ;VARIOUS ERROR CONDITIONS
INTERN %TRAP ;CHANNEL 1 ERROR PSI MESSAGE UUO
INTERN ILIPSI ;ILLEGAL INSTRUCTION PSI
INTERN EOFPSI ;END-OF-FILE PSEUDO-INTERRUPT ON CHANNEL 1
INTERN DATPSI ;FILE DATA ERROR INTERRUPT
INTERN CCPSI ;^C PSI ON CHANNEL 1
INTERN TLMPSI ;TIME EXCEEDED ON CHANNEL 4
INTERN COBPSI ;^O PSI ON CHANNEL 5
INTERN ALOPSI ;PSI ON CHAN 1 FROM AUTOLOGOUT FORK
INTERN AUTOLO ;ROUTINE TO DO AUTOLOGOUT
INTERN %ERR,%$ERR,%.$ERR ;GENERAL ERROR UUOS (MACROS "ERROR" ETC)
INTERN RERET ;NORMAL AFTER-ERROR ROUTINE FOR CERET TO PT TO
INTERN RLJFNS ;CLOSE & RELEASE JFNS USED BY CURRENT COMMAND
INTERN %ETYPE ;TYPE MESSAGE, INTERPRETING %-CODES
INTERN CERR
INTERN FLOAT ;FLOAT INTEGER IN A
;SAVE TEMP AC'S - COMMONLY USED VIA ATSAVE MACRO
.SAVT:: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSHJ P,0(CX) ;CONTINUE ROUTINE
TRNA
AOS -4(P) ;PROPAGATE SKIP
POP P,D
POP P,C
POP P,B
POP P,A
RET
;TO DO TABLE LOOKUP OF NEXT FIELD OF COMMAND, DO:
;
; HELPX <THIS IS WHAT "?" TYPES OUT>
; KEYWD TABLE ;"TABLE" IS ADDRESS OF TABLE
; T FOO... ;APPROPRIATE "T" MACRO FORM OF DEFAULT VALUE
; ERROR RETURN
; SUCCESS RETURN ;P3 HAS VALUE FROM TABLE
; ;B HAS TABLE ENTRY ADDRESS
%KEYW: HLRO A,@(P) ;PICK UP POINTER TO DEFAULT FIELD VALUE
AOS (P) ;SKIP THE DEFAULT ON RETURN
TRNE A,-1 ;LEAVE DEFAULT POINTER AS IS IF NO FIELD SUPPLIED
MOVEM A,CMDEF ;SAVE DEFAULT STRING POINTER
HRRZ A,40 ;PICK UP ADDRESS OF KEYWORD TABLE
MOVEM A,CMDAT ;SAVE ADDRESS OF TABLE
MOVX A,CMKEY ;PREPARE TO PARSE KEYWORD
SKIPE CMDEF ;IS THERE A DEFAULT?
TXO A,CM%DPP ;YES, TELL COMND TO READ IT
SKIPE CMHLP ;USER HELP MESSAGE?
TXO A,CM%HPP ;YES, USE IT
SKIPE CMBRK ;SPECIAL BREAK MASK?
TXO A,CM%BRK ;USE IT
MOVEM A,CMFNP ;STORE FLAGS
MOVEI B,FBLOCK ;GET ADDRESS OF FUNCTION BLOCK
CALL FIELDX ;INPUT THE KEYWORD FIELD
SETZM CMDEF ;DON'T LET SAME DEFAULT BE USED OVER.
SETZM CMHLP ;DON'T LET SAME HELP BE USED OVER
SETZM CMBRK ;DON'T LET SAME BREAK MASK BE USED OVER
TXNE A,CM%NOP ;MAKE SURE FIELD PARSED ALL RIGHT
RET ;DIDN'T, TAKE SINGLE RETURN
CALL GETKEY ;GET KEYWORD DATA
RETSKP ;GIVE SKIP RETURN
;ROUTINE TO TAKE TABLE ADDRESS IN B AND RETURN TABLE DATA IN P3.
;THE ENTRY ADDRESS IN B IS PRESERVED.
GETKEY::HRRZ P3,(B) ;GET ADDRESS OF CONTROL DATA
MOVE P3,(P3) ;GET THE CONTROL DATA ITSELF
TXNE P3,ONEWRD ;CONFIRMATION NECESSARY NOW?
CALLRET CONF ;YES, DO IT AND RETURN
RET ;GIVE GOOD RETURN
;FIELD INPUT ROUTINE. CALL IT WITH ADDRESS OF FUNCTION DESCRIPTOR
;BLOCK IN AC "B". ROUTINE RETURNS WITH A, B, C, CONTAINING
;WHATEVER COMND PUT THERE.
FIELDX::STKVAR <<CMDDAT,2>,CMDFDB>
FIELDR: MOVEI A,CCHEOF ;PCL Get EOF dispatch address
MOVEM A,EOFDSP ;WHERE TO GO ON END OF FILE
MOVX A,CM%WKF!CM%XIF ;WAKE ON EVERY FIELD SO ECHO CAN BE TURNED OFF IN TIME FOR LOGIN
SKIPN CUSRNO ;IS USER LOGGED IN?
IORM A,CMFLG ;NO, SO DON'T ALLOW "@" AND WAKE PER FIELD
MOVX A,CM%WKF
SKIPE CUSRNO ;LOGGED IN?
ANDCAM A,CMFLG ;YES, SO DON'T WAKE PER FIELD
AOS CLZFFF ;SAY CLZFF BETTER BE DONE IF ^C HERE.
MOVEI A,SBLOCK ;ADDRESS OF COMMAND STATE BLOCK
COMND ;DO THE COMND JSYS ITSELF (ONLY ONE IN EXEC! 6/16/77 EO)
ERCAL EOFJER ;FAILED, SAY WHY AND DIE
DMOVEM B,CMDDAT ;REMEMBER DATA
MOVEM C,CMDFDB
AOS TTYACF ;NOTE THAT SOME TTY ACTION OCCURED
SETZM CMDEF ;CLEAR DEFAULT STRING, SO ISN'T USED AGAIN INADVERTANTLY
SETZM CMHLP ;CLEAR HELP MESSAGE, SO IT ISN'T USED AGAIN
SETZM CMBRK ;CLEAR BREAK MASK SO IT ISN'T USED AGAIN
SETZM EOFDSP ;CLEAR EOF DISPATCH ADDRESS
;IF THIS IS A CONFIRMATION, ECHO THE COMMAND IF DESIRED.
TXNE A,CM%NOP ;SUCCESS?
JRST [ SOS CLZFFF ;NO, CLZFF NO LONGER NEEDED
JRST FIELD1] ;SKIP FUNCTION CODE ANALYSIS
LDB A,[POINTR((C),CM%FNC)] ;GET FUNCTION CODE
CAIE A,.CMIFI ;SOMETHING PARSED WHICH CREATED A JFN?
CAIN A,.CMOFI
JRST FIELDF ;YES, LEAVE CLZFFF ON TO FORCE CLZFF IF ^C.
CAIN A,.CMFIL
JRST FIELDF ; " "
SOS CLZFFF ;NOT FILESPEC FUNCTION, CLZFF NOT NEEDED
CAIE A,.CMCFM ;CONFIRMATION?
JRST FIELD1 ;NO, GO ON
SETZM CLF ;NOT AT COMMAND LEVEL IF JUST PARSED RETURN
SKIPLE PCCIPF ;[PCL] Just confirmed top-level PCL command?
SETOM PCCIPF ;[PCL] Yes, remember it's in progress for ^T
SKIPE CIPF ;COMMAND ALREADY IN PROGRESS?
JRST FIELD1 ;YES
MOVE A,COMAND ;GET ADDRESS OF TABLE ENTRY
TLNE A,-1 ;[PCL] Already been byte-pointer-ized?
JRST FIELD3 ;[PCL] Yes, don't trash COMAND
HLRZ A,(A) ;GET ADDRESS OF COMMAND NAME INFO
MOVSI B,774000 ;SEE IF THIS IS A FLAG WORD
TDNN B,(A) ;IS IT?
AOJ A, ;YES, SO COMMAND NAME STARTS IN NEXT WORD
FIELD2: HRLI A,440700 ;MAKE POINTER TO BEGINNING OF COMMAND NAME
MOVEM A,COMAND ;REMEMBER POINTER TO ASCII
FIELD3: SKIPE PCCURC ;[PCL] PCL command in progress?
MOVE A,PCLNAM ;[PCL] Yes, so use its name
CALL GETSIX ;GET SIXBIT NAME FOR COMMAND
JFCL ;TRUNCATE IF COMMAND TOO LONG
MOVEM A,COMSIX ;REMEMBER IT
SKIPN PCCURC ;PCL No change if within stored command
SETNM ;TELL SYSTEM, SO SYSTAT SHOWS IT
SETOM CIPF ;SAY COMMAND IN PROGRESS
SKIPN SDECHO ;[3017] CHECK "DON'T ECHO THIS TWICE" FLAG
CALL ECHCMD ;ECHO THE COMMAND IF NECESSARY
TXNN P3, NOSAVE ;SAVE THIS COMMAND? SKIP IF NO
CALL CMDHST ;SAVE COMMAND FOR COMMAND EDITOR
FIELD1: MOVX A,CM%XIF
ANDCAB A,CMFLG ;ALLOW "@" UNLESS CALLER SAYS DON'T, RETURN FLAGS IN A
DMOVE B,CMDDAT ;RETURN COMND DATA IN B
RET
FIELDF: MOVE A,B ;GET JFN
CALL JFNSTK ;STACK IT SO WE REMEMBER TO RELEASE IT LATER
SOS CLZFFF ;CLZFF NO LONGER NEEDED WHEN JFN IS STACKED
JRST FIELD1
;GET ONE CHARACTER FROM COMMAND STRING
CMDCHR::
CMDCH2: MOVEI B,SBLOCK
SKIPG .CMINC(B) ;SOMETHING THERE?
JRST CMDCH1 ;NO
ILDB A,.CMPTR(B) ;YES, GET IT
SOS .CMINC(B) ;UPDATE COUNT
CAIN A," " ;A SPACE?
JRST CMDCH2 ;PASS IT
RET
CMDCH1: HRROI A,[ASCIZ / /] ;PARSE A NULL STRING
CALL CHAR ;IN ORDER TO GET MORE INPUT
JRST CMDCH2
JRST CMDCH2 ;TRY AGAIN
;BACKUP MAIN PTR IN COMMAND STRING
CMDBAK: MOVEI B,SBLOCK
MOVNI A,1
ADJBP A,.CMPTR(B) ;DECREMENT BYTE PTR
MOVEM A,.CMPTR(B)
AOS .CMINC(B)
RET
;ROUTINE WHICH CALLS FIELD AND SKIPS IFF SUCCESSFUL PARSE
FLDSKP::CALL FIELDX ;PARSE THE INPUT
TXNE A,CM%NOP ;DID IT PARSE CORRECTLY?
RET ;NO, NON-SKIP
RETSKP ;YES, SKIP
;THESE ROUTINES ARE USED TO MANUALLY BACK UP THE COMND POINTERS
;TO THE PREVIOUS ATOM. THIS IS NECESSARY WHEN, FOR EXAMPLE,
;COMND HAS CORRECTLY PARSED A NUMBER, BUT THE NUMBER FAILS
;SOME RANGE CHECK THAT IS PERFORMED AFTER THE PARSE.
SAVCM:: ATSAVE
DMOVE A,SBLOCK+.CMPTR
MOVE C,SBLOCK+.CMINC
DMOVEM A,CBLOCK
MOVEM C,CBLOCK+2
RET
RESCM:: ATSAVE
DMOVE A,CBLOCK
MOVE C,CBLOCK+2
DMOVEM A,SBLOCK+.CMPTR
MOVEM C,SBLOCK+.CMINC
RET
;ROUTINE TO ECHO THE CURRENT COMMAND STRING IF NEED BE
ECHCMD::MOVE A,TAKCUR ;GET CURRENT SETTINGS
SKIPN ERRMF ;ARE WE PRINTING AN ERROR MESSAGE?
JRST ECHCM1 ;NO - SKIP THIS
TXNN A,TKTERF ;YES, ARE WE READING FROM A TERMINAL?
JRST ECHCM2 ;NO - ALWAYS ECHO ERRONEOUS COMMAND
ECHCM1: TXNN A,TKECOF ;ECHOING?
RET ;NO ECHOING
ECHCM2: MOVE A,SVPRMT ;GET POINTER TO PROMPT STRING
ETYPE <%1M> ;TYPE PROMPT STRING
UTYPE CBUF ; AND COMMAND BUFFER
CALLRET LM ;GET TO LEFT MARGIN IF COMMAND WASN'T COMPLETE
;ROUTINES TO HANDLE BIT MASKS...
;CLRALL/SETALL CLEARS/SETS ALL THE BITS IN A BITMLN-BIT MASK
;
;ACCEPTS: A/ ADDRESS OF MASK
CLRALL::SETZM (A) ;CLEAR FIRST WORD
CAIA ;FALL INTO COMMON CODE
SETALL::SETOM (A) ;SET ALL THE BITS IN THE FIRST WORD OF MASK
HRL A,A ;MAKE BLT POINTER
HRRZI B,BITMLN-1(A) ;GET LAST ADDRESS OF BIT MASK
AOJ A, ;MAKE POINTER TO SMEAR BITS
BLT A,(B) ;SET ALL BITS
RET
;SKPNAZ SKIPS IF NOT ALL ZERO (SOME BIT IS ON IN MASK)
;
;ACCEPTS: A/ ADDRESS OF MASK
;
;RETURNS+1: ALL ZERO
; +2: NOT ALL ZERO (SOME BIT IN BIT MASK IS ON)
SKPNAZ::MOVSI B,-BITMLN ;NUMBER OF WORDS TO CHECK
SKPN1: MOVE C,A ;GET BASE ADDRESS
ADDI C,(B) ;GET NEXT ADDRESS TO LOOK AT
SKIPE (C) ;IS THIS PART OF MASK ALL ZERO?
RETSKP ;NO, SO MASK IS NAZ
AOBJN B,SKPN1 ;YES, SO KEEP LOOKING
RET ;ALL ZERO SO DON'T SKIP
;SKPON SKIPS IF A BIT IS ON (SET) IN A MASK
;
;ACCEPTS: A/ BIT NUMBER
; B/ ADDRESS OF MASK
;
;RETURNS+1: BIT NOT ON
; +2: BIT ON
SKPON:: HRLI B,430100 ;GET POINTER TO FIRST (0TH) BIT
ADJBP A,B ;MAKE BYTE POINTER TO EXACT BIT
LDB C,A ;GET BIT VALUE
JUMPN C,RSKP ;SKIP RETURN IF 1
RET ;SINGLE RETURN IF 0
;COPBTS COPIES ONE BIT MASK TO ANOTHER
;
;ACCEPTS: A/ SOURCE ADDRESS
; B/ DESTINATION
COPBTS::MOVEI C,BITMLN-1(B) ;GET LARGEST DESTINATION ADDRESS
HRL B,A ;MAKE BLT POINTER
BLT B,(C) ;COPY THE MASK
RET
;SETBIT/CLRBIT SETS/CLEARS ONE BIT IN A MASK
;
;ACCEPTS: A/ BIT NUMBER TO SET (0 MEANS B0 OF FIRST WORD)
; B/ ADDRESS OF MASK
CLRBIT::TDZA C,C ;GET 0 TO STUFF INTO BIT
SETBIT::MOVEI C,1 ;GET 1 TO STUFF INTO BIT
HRLI B,430100 ;GET POINTER TO FIRST (0TH) BIT
ADJBP A,B ;MAKE BYTE POINTER TO EXACT BIT
DPB C,A ;SET OR CLEAR BIT
RET
;ROUTINES TO TELL MONITOR WE'RE AT TOPS20 LEVEL AND PROGRAM LEVEL.
;THE BATCH SYSTEM NEEDS THESE TO KNOW TO SEND ^C IF WE'RE AT PROGRAM
;LEVEL, AND NEXT LINE OF BATCH JOB INPUT IS SUPPOSED TO GO TO THE
;EXEC.
;
;NOTE: EXEC IS CAREFUL NOT TO CALL THESE ON EVERY COMMAND, IN ORDER
;TO MINIMIZE NUMBER OF JSYS'S DONE PER COMMAND.
SETMOD::MOVE C,A ;ARG IN C
JRST SETMD1
SETPRG::TDZA C,C ;SPECIFY PROGRAM LEVEL
SETT20::SETO C, ;SPECIFY TOPS20 LEVEL
SETMD1: SETO A, ;CURRENT JOB
MOVX B,.SJT20 ;SPECIFY TOPS20 FUNCTION
SETJB ;TELL MONITOR WHICH LEVEL
ERJMP .+1 ;FAILED, PROBABLY OLD MONITOR
RET
;ROUTINE TO GET TOPS20 MODE
;RETURNS RESULT IN A
GETMOD::SETO A, ;CURRENT JOB
HRROI B,A ;PUT RESULT IN A
MOVEI C,.JIT20 ;SPECIFY THIS FUNCTION
GETJI ;GET THE INFO FROM SYSTEM
ERJMP .+1 ;IGNORE ERROR, PROBABLY OLD MONITOR
RET
;GET CURRENT CLASS AND LOAD AVERAGES
;ACCEPTS: A/ JOB NUMBER OR -1 FOR CURRENT JOB
;RETURNS: +1
; A/ -1 FOR NO CLASS SCHEDULING, OR CLASS NUMBER
; B/ 1-MINUTE LOAD AVERAGE
; C/ 5-MINUTE LOAD AVERAGE
; D/ 15-MINUTE LOAD AVERAGE
GLBLN==10 ;ROOM TO GET LOAD AVERAGES
GLOADS::STKVAR <WJOBN,<GLBLK,GLBLN>>
MOVEM A,WJOBN ;REMEMBER WHICH JOB
CALL CLSON ;CLASS SCHEDULING ON?
JRST GLNO ;NO
MOVEI A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVE A,WJOBN ;GET JOB
MOVEM A,.SAJOB+GLBLK
MOVEI A,.SKRJP ;READ THIS JOB'S CLASS
MOVEI B,GLBLK
SKED% ;SEE WHAT CLASS WE'RE IN
MOVE A,.SAJCL+GLBLK
MOVEM A,.SACLS+GLBLK ;MOVE CLASS FOR ASKING FOR LOADS
MOVEI A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVEI A,.SKRCS ;NOW GET LOAD AVERAGES FOR THE CLASS
SKED%
GLN2: HRLI A,.SA1ML+GLBLK ;MOVE DATA STARTING WITH LOAD AVS
HRRI A,B ;MOVE INTO AC'S
BLT A,D ;GET CLASS, 1M LOAD, 5M LOAD, 15M LOAD
MOVE A,.SACLS+GLBLK ;RETURN CLASS IN A
RET
GLNO: MOVEI D,14 ;FIRST SYSTEM LOAD AVERAGE IS WORD 14
GTB .SYSTA
MOVEM A,.SA1ML+GLBLK ;STORE THE LOAD AVERAGES
MOVEI D,15
GTB .SYSTA
MOVEM A,.SA5ML+GLBLK
MOVEI D,16
GTB .SYSTA
MOVEM A,.SA15L+GLBLK
HRROI A,-1 ;-1 MEANS CLASS SCHEDULING IS OFF
MOVEM A,.SACLS+GLBLK
JRST GLN2 ;GO RETURN RESULTS
;SKIP IF CLASS SCHEDULER IS ON...
;A CONTAINS STATUS BITS OF SCHEDULER
CLSON:: MOVEI B,C ;ARG BLOCK IN C
MOVEI A,.SKRCV ;READ STATUS
MOVEI C,2 ;SPECIFY A 2-WORD BLOCK
SKED% ;GET THE INFO
MOVE A,D ;RETURN DATA IN A
TXNN A,SK%STP ;CLASS SCHEDULER ON?
RETSKP ;YES, SKIP
RET ;NO, DON'T.
;GET TERMINATOR OF LASS FIELD, RETURNED IN A. -1 IS RETURNED IF NO
;TERMINATOR HAS BEEN TYPED YET
GETTER::MOVE B,SBLOCK+.CMPTR ;GET POINTER TO REST OF LINE
SETO A, ;RETURN -1 IF NO TERMINATOR YET
SKIPLE SBLOCK+.CMINC ;MAKE SURE THERE ARE SOME UNPARSED CHARACTERS
ILDB A,B ;GET NEXT CHARACTER AFTER PARSED FIELD
RET
;NACL SKIPS IF NOT AT TOPS20 COMMAND LEVEL. THIS IS USEFUL IF SOME
;ASYNCHRONOUS CODE HAS SOMETHING TO SAY AND DOESN'T WANT INTERRUPT OTHER
;OUTPUT OR COMMAND INPUT
NACL:: SKIPN CLF ;AT COMMAND LEVEL?
RETSKP ;NO
MOVE A,CMRTY ;YES, SEE HOW MANY CHARACTERS IN PROMPT
CALL FIXPT
MOVEI C,0 ;C WILL ACCUMULATE COUNT
NACL1: ILDB B,A ;GET NEXT CHARACTER OF PROMPT STRING
CAIE B,0 ;DONE COUNTING WHEN NULL HIT
AOJA C,NACL1
MOVE A,CIJFN ;GET INPUT CHANNEL
RFPOS ;SEE IF USER HAS STARTED TYPING COMMAND YET
CAIL C,(B) ;HAS HE STARTED TYPING YET?
RET ;NO, SO DON'T SKIP. IT'S O.K. TO BLURT MESSAGE NOW
RETSKP ;HE STARTED TYPING, SO DON'T DISTURB HIM
;ROUTINE WHICH SKIPS IFF LAST FIELD WASN'T TERMINATED WITH ALTMODE.
;THIS ROUTINE ONLY NEEDS TO BE CALLED IN SITUATIONS WHERE IT'S AMBIGUOUS
;AS TO WHETHER USER SHOULD BE PROMPTED FOR NEXT FIELD, OR ALLOWED TO ENTER
;MORE FOR THIS FIELD. FOR INSTANCE, IN A "COPY" COMMAND, "COPY FOO$":
;SHOULD WE WAIT FOR MORE, DESPITE THE ALTMODE, IN CASE USER WANTS TO
;MAKE IT "COPY FOO,BAR (TO) ...", OR SHOULD WE ASSUME THAT THE ALTMODE
;MEANS DO "COPY FOO (TO)" ? THE CURRENT ANSWER IS THAT THE ALTMODE MEANS
;GO ON TO THE NEXT FIELD. OTHERWISE, USER WOULD NEVER SEE "(TO)" PRINTED
;OUT. ANOTHER EXAMPLE IS A COMMAND LIKE "SET PAGE-ACCESS 1:3$". ALTHOUGH
;THE USER COULD AT THIS POINT MAKE IT "...1:3,4...", WE ASSUME THAT
;THE ALTMODE MEANS GO ON TO NEXT FIELD, HENCE MAKING IT
;"SET PAGE-ACCESS 1:3 (TO)". THIS ROUTINE CLOBBERS NO AC'S.
NESC:: ATSAVE ;PRESERVE TEMPY'S
MOVE A,CMFLG ;GET FLAGS
TXNE A,CM%ESC ;LAST FIELD END WITH ALTMODE?
RET ;YES, NO SKIP
RETSKP ;NO, SO SKIP
;ROUTINE TO INITIALIZE COMMAND LINE JSYS AND PRINT PROMPT FOR NEW COMMAND.
READY: CALL SETPMT ;[PCL] Get pointer to prompt string
JRST READ1 ;[PCL] Join common code
READY2: MOVEM A,CMDACS ;DON'T CLOBBER AC1
MOVEI A,5 ;PCL Precede prompt with space if batch
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
MOVEI A,4 ;PCL Use a dollar sign
SKIPN PRVENF ;USE @ IF NOT ENABLED
MOVEI A,3 ;PCL One prompt for regular command
CALL SETPM2 ;[PCL] Get pointer to (subcommand) prompt
JRST READ1 ;[PCL] Join common code
SETPMT: MOVEM A,CMDACS ;[PCL] DON'T CLOBBER ANY AC'S
MOVEI A,2 ;[PCL] Assume enabled batch
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
MOVEI A,1 ;[PCL] Use a dollar sign
SKIPN PRVENF ;USE @ IF NOT ENABLED
SETZ A, ;[PCL] One prompt for regular command
SETPM2: MOVEM B,CMDACS+1 ;[PCL] Get another register
HRROI B,REDPMT(A) ;[PCL] Point to the standard prompt
SKIPE PCLPMT(A) ;[PCL] Is one provided by PCL?
HRRO B,PCLPMT(A) ;[PCL] Yes, point to that one
MOVE A,B ;[PCL]
MOVE B,CMDACS+1 ;[PCL]
RET ;[PCL]
;ENTER HERE FOR CUSTOM PROMPT CHARACTERS:
READ1:: MOVEM A,CMRTY ;SET UP PROMPT BUFFER
MOVEM A,SVPRMT ; AND REMEMBER THE POINTER FOR "TAKE, ECHO"
POP P,REPARA ;REMEMBER WHERE TO REPRASE TO
MOVE A,CMDACS ;GET SAVED AC1 (SEE %$TYPE:)
MOVEM 17,CMDACS+17 ;SAVE AC17 AWAY
MOVEI 17,CMDACS ;MAKE BLT POINTER 0,,CMDACS
BLT 17,CMDACS+16 ;SAVE REST TO AC'S
MOVE 17,CMDACS+17 ;LEAVE AC17 INTACT
MOVE A,JBUFP ;GET CURRENT LOCATION ON JFN STACK
MOVEM A,.J ;REMEMBER WHERE WE ARE FOR REPARSE
HRR A,COJFN ;GET OUTPUT JFN
HRL A,CIJFN ;AND INPUT
MOVEM A,CMIOJ
READ2: HRROI A,[0] ;PCL GET NULL STRING
MOVE B,TAKCUR ;GET CURRENT SETTINGS
TXNN B,TKTERF ;SKIP IF INPUTTING FROM TERMINAL
MOVEM A,CMRTY ;NO PROMPT UNLESS INPUTTING FROM TERMINAL
MOVX A,CMINI ;DO INITIALIZATION, PRINT PROMPT
MOVEM A,CMFNP
MOVEI B,FBLOCK ;SPECIFY FUNCTION BLOCK ADDRESS
CALL FIELDX ;TYPE THE PROMPT
MOVE A,CIJFN ;PCL See if executing stored command
CAIE A,.NULIO ;PCL Are we?
JRST READ3 ;PCL No
CALL PCMXCT ;PCL Yes, go get a line of command text
JRST [ HRR A,COJFN ;PCL End of execution, fix up I/O JFNs
HRL A,CIJFN ;PCL
MOVEM A,CMIOJ ;PCL
MOVX A,OURNAM ;PCL Fix the system name
MOVE B,A ;PCL
SETSN ;PCL Since we are going back to TI state
TRN ;[PCL]
CALL SETPMT ;[PCL] Get the correct prompt string
MOVEM A,CMRTY ;[PCL] Set it up
JRST READ2] ;PCL And start again
READ3: MOVE A,CMDACS+A ;PCL
MOVE B,CMDACS+B ;RESTORE AC'S WE USED
MOVE C,CMDACS+C ;LEAVE ALL AC'S AS WE FOUND THEM
JRSTF @REPARA ;RETURN TO CALLER
;PCL Standard prompt strings
REDPMT::ASCIZ /@/ ;Disabled
ASCIZ /$/ ;Enabled
ASCIZ / $/ ;Enabled batch needs space because of operator
ASCIZ /@@/ ;Disabled subcommand
ASCIZ /$$/ ;Enabled subcommand
ASCIZ / $$/ ;Enabled batch subcommand
;GUIDE WORD HANDLER, INVOKED WITH "NOISE" MACRO
%NOI: ATSAVE ;DON'T CLOBBER AC'S
HRRO A,40 ;GET POINTER TO GUIDE STRING
MOVEM A,CMDAT ;SET UP GUIDE STRING
MOVX A,CMNOI ;SPECIFY NOISE FUNCTION
MOVEM A,CMFNP
MOVEI B,FBLOCK
CALL FLDSKP ;READ THE GUIDE WORDS
CMERRX
RET
;ROUTINES TO TURN IPCF INTERRUPTS ON AND OFF. INTS MUST BE TURNED OFF IN
;VARIOUS PLACES TO AVOID RECEIVING AN IPCF MESSAGE WITHOUT KNOWING ABOUT IT.
IPCON:: SOSLE IINTDF ;DECREMENT AMOUNT OF NESTING
RET ;SOMEONE ELSE STILL WANTS IPCOFF!
SETOM IPCALF ;ALLOW IPCF INTERRUPTS AGAIN
MOVEI A,.FHSLF ;TALK TO OURSELF
MOVX B,1B<IPCCHN> ;PREPARE TO SIMULATE IPCF INTERRUPT
SKIPE IPCWTF ;IS THERE A WAITING INTERRUPT?
IIC ;YES, FORCE AN INTERRUPT
RET
IPCOFF::AOS IINTDF ;NEST DEEPER INTO OFFNESS
SETZM IPCALF ;THIS FLAG 0 MEANS DON'T ALLOW IPCF INTERRUPT
RET
;PION/PIOFF CONTROL PRIORITY INTERRUPT, TURNING IT ON AND OFF.
;USE PIOFF TO PREVENT ^C, AND PION TO ALLOW IT AGAIN.
;THESE ROUTINES EXPLICITLY DO NOT CLOBBER THE TEMPORARY AC'S, SO THAT CALLERS
;CAN HAVE ^C TURNED OFF FOR AS LITTLE TIME AS POSSIBLE
PION:: SOSLE INTDF ;DECREMENT AMOUNT OF NESTING
RET ;SOMEONE ELSE STILL WANTS NO ^C, DO NOTHING MORE
SETOM ACTRCF ;ALLOW ^C
TLNE Z,CTLCF1 ;DID THE USER ALREADY TYPE ^C?
JRST .CTRLC ;YES
RET
PIOFF:: AOS INTDF ;INCREMENT AMOUNT OF NESTING
SETZM ACTRCF ;DISALLOW ^C
TLZ Z,CTLCF1!CTLCF2 ;FORGET ABOUT CONTROL-C'S ALREADY TYPED
RET
;PRVCK
;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE
; REQUIRED AS INDICATED BY BITS IN B, GENERALLY FROM
; A KEYWORD TABLE.
;SKIPS UNLESS SPEC CAP(S) ARE REQUIRED BUT USER HAS NONE OF THEM.
;USES: FORK COMMAND (XCMD1.MAC), %KEYWD (JUST ABOVE).
PRVCK: TXNN B,WHLU+OPRU+ERRU ;ANY PRIVILEGES WANTED?
RETSKP ;NO - RETURN SUCCESS
SKIPN CUSRNO ;MUST BE LOGGED IN TO HAVE PRIVILEGES
RET
ATSAVE
MOVE D,B
MOVEI A,.FHSLF
RPCAP ;READ CAPABILITIES ENABLED FOR THIS PROCESS
TXNN D,WHLU ;CHECKING FOR WHEEL?
JRST PRVCK1 ;NO - SKIP THIS
TXNE C,SC%WHL ;YES - HAS USER GOT WHEEL?
RETSKP ;YES - SUCCESS
PRVCK1: TXNN D,OPRU ;CHECKING FOR OPERATOR?
JRST PRVCK2 ;NO - SKIP THIS
TXNE C,SC%OPR ;YES - HAS USER GOT OPERATOR?
RETSKP ;YES - SUCCESS
PRVCK2: TXNE D,ERRU ;CHECKING FOR "CONFIDENTIAL INFORMATION"?
TXNN C,SC%CNF ;YES - HAS USER GOT IT?
RET ;WANTS AND DOESN'T HAVE - FAILURE
RETSKP ;WANTS AND HAS - SUCCESS
;USUBCO UUO, INVOKED BY SUBCOM MACRO
;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO
;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS
;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST
%SBCOM: STKVAR <OCERET,OJBUFP,KADDR,INITR>
MOVE A,CERET
MOVEM A,OCERET ;SAVE OLD LOCATION FOR ERROR DISPATCH
MOVE A,.JBUFP
MOVEM A,OJBUFP ;SAVE OLD JFN STACK POINTER BOUNDARY
HRRZ A,40 ;GET KEYWORD TABLE ADDRESS ADDRESS
MOVE B,(A) ;GET TABLE ADDRESS
MOVEM B,KADDR
MOVE B,1(A) ;GET INIT ROUTINE ADDRESS
MOVEM B,INITR
MOVEI A,[CALL FLJFNS ;ON ERROR, FLUSH JFN FOR ERRONEOUS SUBCOMMAND
JRST SBCOM1] ;THEN GO AND PROMPT FOR NEXT SUBCOMMAND
MOVEM A,CERET ;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE
MOVEM .FP,.PP ;SAVED, IN CASE OF ERROR.
MOVEM P,.P ;REMEMBER STACK POINTER IN CASE ERROR DURING SUBCOMMAND
SBCOM1: MOVE A,JBUFP
MOVEM A,.JBUFP ;PREVENT ERRONEOUS SUBCOMMANDS FROM CAUSING COMMAND JFNS TO BE FLUSHED
CALL READY2 ;TYPE 2 READY CHARACTERS: @@ OR !!
MOVEI B,[FLDDB. .CMCFM,,,,,FBLOCK]
MOVE C,KADDR ;GET ADDRESS OF KEYWORD TABLE
MOVEM C,CMDAT ;STORE ADDRESS OF KEYWORD TABLE
MOVX A,CMKEY ;SPECIFY KEYWORD FUNCTION, NO SPECIAL FLAGS
MOVEM A,CMFNP ;STORE FUNCTION
CALL FLDSKP ;READ TYPED IN FIELD
CMERRX <Carriage return or subcommand required>
CALL GETKEY ;GET KEYWORD INFO
TRNN P3,-1
JRST SBCOM9 ;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS
SKIPE INITR ;IS THERE AN INITIALIZATION ROUTINE?
CALL @INITR ;YES, EXECUTE IT
CALL (P3) ;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
CALL ECHCMD ;NEED TO TURN ECHO ON FOR THE TAKE
JRST SBCOM1 ;GO GET ANOTHER
SBCOM9: MOVE A,OJBUFP ;GET OLD JFN BOUNDARY
MOVEM A,.JBUFP ;RESTORE AS BEFORE SUBCOMMANDS
MOVE A,OCERET ;GET OLD ERROR DISPATCH ADDRESS
MOVEM A,CERET
RET
;CONF
;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE
;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS.
;IF TYPIST TYPES "?", IT TELLS HIM THAT IT'S WAITING FOR
;CONFIRMATION. IF HE STARTS WITH ! OR ; (RECOGNIZED COMMENT CHARACTERS
;DUE TO PHASE OF MOON AT TIME OF THIS DOCUMENTATION), IT ALLOWS
;A COMMENT TO PRECEDE THE CONFIRMATION. (CONFIRMATION ITSELF IS
;CARRIAGE RETURN, LINEFEED, CONTROL-L ETC.) IF A NON-COMMENT PRECEDES
;THE CONFIRMATION, AN ERROR MESSAGE RESULTS.
;FCONF PRINTS [CONFIRM] THEN FORCES FURTHER CONFIRMATION
FCONF:: PROMPT <[Confirm]>
FCONFA::
;CONF
CONF: ATSAVE ;SAVE TEMPORARIES
CRRX <Confirm with carriage return>
CMERRX ;BAD CONFIRMATION TYPED
RET ;GOOD CONFIRMATION, RETURN.
;SPRTR
;READS END OF LINE, DETECTING COMMA FOR SUBCOMMANDS. TAKES non-skip RETURN IF COMMA THEN
;CARRIAGE RETURN. TAKES SKIP IF JUST CARRIAGE RETURN.
SPRTR: ATSAVE ;DON'T CLOBBER AC'S
COMMAX <Confirm with carriage return or comma to enter subcommands>
JRST SPR1 ;NOT COMMA, MAYBE END OF INE
CRRX <Carriage return to enter subcommands>
ERROR <Carriage return required after comma to enter subcommands>
RET ;REGULAR SKIP IF COMMA SEEN
SPR1: CRRX ;NO COMMA, CHECK FOR END OF LINE
ERROR <Comma or carriage return required>
RETSKP ;TYPIST ENDED LINE WITH NO COMMA
;GET HERE FOR LINE REPARSE, WHICH HAPPENS WHEN PREVIOUSLY
;PARSED FIELDS ARE REQUIRED TO BE REPARSED.
REPARS: MOVE A,.J ;FIX JFN STACK
MOVEM A,.JBUFP ;RESTORE JFN STACK FRAME
CALL FLJFNS ;GET RID OF ANY JFN'S THAT WERE USED FOR COMMAND
CALL DOECHO ;ECHOING MAY HAVE BEEN TURNED OFF FOR PASSWORD
MOVSI 17,CMDACS ;MAKE BLT POINTER CMDACS,,0
BLT 17,17 ;RESTORE AC'S TO HOW THEY WERE WHEN THIS PART OF COMMAND STARTED
JRSTF @REPARA ;RETURN TO BEGINNING OF COMMAND LINE
;EOF WHILE READING COMMAND FILE
CCHEOF: MOVE A,CIJFN
CAIE A,.NULIO ;PCL Command generation?
JRST CCHEFN ;PCL No
CALL PCMXCT ;PCL Continue command procedure
JRST CMDIN4 ;PCL It ran to completion, generating nothing
JRST FIELDR ;PCL It did a DoCommand, retry the COMND%
CCHEFN: CALL CIOREL
JFCL
ETYPE < End of %1S
>
CLOSF ;CLOSE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
SKIPN LGORET ;DOING LOGOUT.CMD FILE?
JRST CMDIN4 ;NO, GO BACK FOR NEXT COMMAND
JRST @LGORET ;YES, RETURN TO LOGOUT CODE IN THIS CASE
;ROUTINE TO POP BACK TO LAST EXEC INPUT STREAM. RETURNS WITH JFN
;OF OLD INPUT IN AC1.
;IT SKIP RETURNS IFF THERE WAS NOTHING TO DELETE (I.E. ONLY ONE
;SET OF JFNS ON THE COMAND STREAM STACK)
;IT CLOSES THE OUTPUT SIDE, AND LEAVES RIJFN HOLDING THE INPUT
;SIDE BUT INPUT ISN'T CLOSED YET, SO THAT ERROR MESSAGES ETC. MAY
;DO JFNS ON INPUT JFN BEFORE CLOSING IT.
CIOREL::STKVAR <OLDJFS>
MOVE A,TAKLEN ;SEE HOW MANY ITEMS ARE ON STACK
MOVE B,TAKJFN-1(A) ;GET SET OF JFNS BEING POSSIBLY FLUSHED
MOVEM B,OLDJFS
SOJE A,RSKP ;SKIP RETURN IF ONLY ONE
MOVEM A,TAKLEN ;STORE REDUCED LENGTH
MOVE A,CIJFN ;SEE WHERE READING FROM
CAIN A,.NULIO ;PCL?
CALL PCMPOS ;NO, POP COMMAND PROCEDURE CONTEXT
CALL FIXIO
HRRZ A,OLDJFS
CAME A,COJFN ;DON'T CLOSE OUTPUT IF SAME!
TXNE A,.TTDES ;[PCL] Don't close if a terminal designator
TRNA ;[PCL] Either same or PTY designator
CLOSF ;CLOSE OUTPUT BUT NOT INPUT YET
ERCAL JERR
HLRZ A,OLDJFS ;RETURN INPUT JFN IN A
RET
;ROUTINE TO GET RID OF ALL COMMAND JFNS. THIS HAPPENS, FOR INSTANCE,
;IF USER TYPES ^C DURING "TAKE" COMMAND PROCESSING
;SKIPS IFF THERE ARE NONE TO GET RID OF
CLRIO: CALL CIOREL ;CLOSE STREAM
CAIA ;THERE WAS AT LEAST ONE TO CLOSE
RETSKP ;NONE TO CLOSE, TAKE SKIP
PUSH P,A ;SAVE JFN IN CASE LAST ONE
CLR1: CALL CIOREL ;CLOSE NEXT ONE
JRST CLR2 ;NEXT ONE WASN'T LAST
POP P,A ;IT WAS THE LAST ONE, SO RETURN IT
RET
CLR2: EXCH A,(P) ;GET THE ONE THAT WASN'T LAST
CLOSF ;CLOSE THE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
JRST CLR1 ;LOOP BACK TO CLOSE THE REST
;UUO DISPATCH TABLE
CUUOT: EXP %ERR,%ETYPE,%KEYW
EXP %NOI,%$TYPE,%LERRO
EXP 0,%$ERR,%ETYPE,0
EXP %PRINT,%TRAP,%.$ERR
EXP %SBCOM
%%U==.-CUUOT
DEFINE XX(UUL)
<
%%X==.
RELOC CUUOT+<U'UUL>_-^D23-20 ;;BITS 0-8 CAN'T BE 0
UUL'$
IFG .-CUUOT-%%U,<%%U==.-CUUOT>
RELOC %%X
>
ULIST
RELOC CUUOT+%%U ;LEAVE ROOM FOR ALL UUO ENTRIES
;UUO DISPATCHER
CUUO:: MOVEM A,CTUUO ;SAVE AC A
HLRZ A,40 ;GET THE OP-CODE
LSH A,-5
HRRZ A,CUUOT-20(A) ;GET THE DISPATCH ADDRESS FOR THIS OP-CODE
EXCH A,CTUUO ;SAVE IT AND RESTORE AC A
JRST @CTUUO ;DISPATCH TO UUO-HANDLING ROUTINE
;ROUTINE INVOKED BY "$TYPE <FOO>" MACRO. IT STARTS A NEW LINE
;PART OF THE COMMAND, WITH THE PROMPT BEING "FOO".
%$TYPE: MOVEM A,CMDACS ;WE DON'T WANT TO CLOBBER ANYTHING
MOVEI A,@40 ;GET ADDRESS OF PROMPT STRING
HRLI A,440700 ;MAKE BYTE POINTER
CALLRET READ1 ;TYPE PROMPT AND RETURN TO PROGRAM
;SEE ALSO "%ETYPE" IN S3.MAC
;ROUTINES FOR INPUTTING FIELDS OF COMMAND. INVOKED BY MACROS.
;THESE ROUTINES ARE NAMED $FOO AND %FOO. ROUTINE $FOO ASSUMES
;THE EFFECTIVE ADDRESS OF THE UUO CONTAINS THE HELP STRING FOR
;THE FIELD. %FOO ASSUMES THAT THE PREVIOUS HELP STRING IS TO
;BE USED.
;DECIMAL NUMBER...
DEC$: CALL GETHLP ;SET UP HELP MESSAGE
MOVEI A,5+5 ;RADIX
NUM13: MOVEM A,CMDAT
MOVX A,CMNUM
CALLRET $WORK ;INPUT THE NUMBER AND SKIP OR NORMAL RETURN
;OCTAL NUMBER
OCT$: CALL GETHLP
MOVEI A,8 ;OCTAL RADIX
JRST NUM13 ;JOIN COMMON CODE
;TIME
TIME$: CALL GETHLP
MOVX A,CM%ITM ;TIME ONLY
MOVEM A,CMDAT
MOVX A,CMTAD ;TIME AND DATE FUNCTION
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;DATE AND TIME
;THE POSSIBILE THINGS ARE:
;
;1) SPECIFIC DATE AND TIME (OR JUST TIME, WHICH ASSUMES TODAY)
;
;2) "+" OR "-" FOLLOWED BY AMOUNT OF TIME, WHICH MEANS NOW + - AMOUNT
;
;3) KEYWORD, FOLLOWED BY KEYWORD-DEPENDENT DATA
DA%DAY==1B18 ;BIT TO MEAN DAY OF THE WEEK
;KEYWORD TABLE FOR DATE AND TIME
$DKEYS: TABLE
T FRIDAY,,DA%DAY+4
T MONDAY,,DA%DAY+0 ;TOO BAD THIS HAS TO BE ALPHABETICAL
T SATURDAY,,DA%DAY+5
T SUNDAY,,DA%DAY+6
T THURSDAY,,DA%DAY+3
T TODAY
T TUESDAY,,DA%DAY+1
T WEDNESDAY,,DA%DAY+2
TEND
DTR$: MOVEI A,1 ;SAY WE WANT TIME RELATIVE TO NOW
JRST DT1
DT$: TDZA A,A ;SAY WE WANT TIME IN THE FUTURE
DTP$: MOVNI A,1 ;SAY WE WANT TIME IN THE PAST
DT1: TRVAR <RETBTS,TODAY,SENSE,DAYWEK,NOW,TOMORO,BTIME,<STRNG0,10>,DAYFLG>
MOVEM A,SENSE ;REMEMBER WHETHER FUTURE OR PAST
SETZM RETBTS ;INITIALLY, NO RETURN BITS
CALL GETHLP
GTAD ;GET CURRENT TIME AND DATE
MOVEM A,NOW
MOVSI B,1
ADD B,A ;GET TOMORROW SAME TIME IN A
CALL TSTDST ;correct for DST
HRROI A,STRNG0 ;WRITE TO SCRATCH
MOVX C,OT%NTM ;WE WANT ONLY DATE
ODTIM ;GET STRING FOR TOMORROW'S DATE
HRROI B,[ASCIZ / 0:0:0/]
MOVEI C,0
SOUT ;MAKE DATE AND TIME FOR BEGINNING OF TOMORROW
HRROI A,STRNG0 ;POINT AT FULL STRING
MOVEI B,0 ;NO SPECIAL FORMAT
IDTIM ;GET INTERNAL FORMAT FOR TOMORROW
CALL JERR ;SHOULDN'T FAIL
MOVEM B,TOMORO ;REMEMBER VALUE FOR TOMORROW
SUB B,[1B17] ;CREATE BEGINNING OF TODAY
MOVEM B,TODAY
MOVX A,CM%IDA+CM%ITM
MOVEM A,CMDAT ;FIRST FUNCTION IN CHAIN IS DATE AND TIME
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter amount of time from now>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
SKIPGE SENSE ;DIFFERENT CHOICES FOR DATE AND TIME IN PAST
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /-/]>,<"-" to enter amount of time in past>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
CALL $WORK
RET ;BAD INPUT TYPED
LDB D,[331100,,(C)] ;GET FUNCTION FLAVOR
CAIN D,.CMKEY ;KEYWORD?
JRST DAKEY ;YES, GO HANDLE IT
CAIN D,.CMTOK ;"+" OR "-"?
JRST GETPLM ;YES, GO HANDLE IT
MOVE D,.CMDAT(C) ;GET CONTROL BITS
MOVX A,DATBIT ;GET BIT SAYING USER TYPED A DATE
TXNE D,CM%IDA ;IS IT A DATE?
JRST [IORM A,RETBTS ;YES, REMEMBER
JRST DTEXIT] ;GO DO STANDARD EXIT
SKIPLE A,SENSE ;IS TIME INDEPENDENT?
JRST DTEXIT ;YES, NO FIXUP NEEDED
MOVE C,B ;save time
CAMG B,NOW ;COMPUTE VALUE TO ADD
addi a,1 ;make it next day
HRLZS A ;PUT VALUE IN LEFT HALF
ADD B,A ;FIX UP DATE-TIME
move a,c ;get DAT for today back
call tstdst ;correct for DST
JRST DTEXIT ;TAKE STANDARD EXIT
GETPLM: CALL GETAMT ;GOT A DATE IN THE PAST OR FUTURE - GET AMOUNT
RET ;SYNTAX ERROR
SKIPGE SENSE
MOVN A,A ;HANDLE "DIRECTORY SINCE -4:0:0"
ADD A,NOW ;ADD TO NOW
MOVE B,A ;RETURN RESULT IN B AND FALL INTO EXIT
MOVE A,NOW ;get current DAT
CALL TSTDST ;correct for DST
;...
;DTEXIT is the common exit for time-and-date parsing. It returns bits in
;A declaring what the user typed.
DTEXIT: MOVE A,RETBTS ;GET RETURN BITS
RETSKP ;SKIP TO DENOTE SUCCESS
;ROUTINE TO INPUT AN AMOUNT OF TIME.
;RETURNS:
; +1 SYNTAX ERROR
; +2 A/ INTERNAL FORMAT
; B/ SECONDS
GETAMT::STKVAR <CTIM>
DECX <Amount of time in form hh:mm>
RET ;GIVE UP IF CAN'T READ HOURS
IMULI B,^D3600 ;CHANGE TO SECONDS
MOVEM B,CTIM ;SAVE NUMBER OF SECONDS
COLONX <Colon to separate hours and minutes>
JRST ONENUM ;ONLY ONE NUMBER BEING TYPED
DECX <Minutes>
RET ;ERROR IF NO NUMBER AFTER COLON
IMULI B,^D60 ;CHANGE MINUTES TO SECONDS
ADDM B,CTIM ;ACCUMULATE RESULT
COLONX <Colon, if seconds are being entered>
JRST NOSECS ;NO SECONDS FORTHCOMING (THAT'S O.K.)
DECX <Seconds>
RET ;ERROR IF SECOND COLON AND NO SECONDS
ADD B,CTIM ;GET TOTAL SECONDS
T22: MOVEM B,CTIM ;REMEMBER SECONDS
MUL B,[1B17] ;IN INTERNAL FORMAT, RIGHT HALF OVER 1B17 IS FRACTION OF A DAY
DIV B,[^D86400] ;DIVIDE BY SECONDS IN A DAY
CAILE C,^D86400/2 ;ROUND
AOJ B,
MOVE A,B ;RETURN RESULT IN A
MOVE B,CTIM ;RETURN SECONDS IN B
RETSKP
ONENUM: MOVE B,CTIM ;GET NUMBER OF SECONDS GIVEN HOURS
IDIVI B,^D60 ;TREAT NUMBER AS THOUGH IT WERE ORIGINALLY MINUTES
JRST T22
NOSECS: MOVE B,CTIM ;NO SECONDS FORTHCOMING
JRST T22
;KEYWORD TYPED AFTER /AFTER:
DAKEY: CALL GETKEY ;GET KEYWORD DATA
TXNN P3,DA%DAY ;DAY OF THE WEEK?
JRST (P3) ;NO, DO SPECIFIC THING
ANDI P3,7 ;DAY OF THE WEEK, KEEP ONLY IT
MOVEM P3,DAYWEK ;REMEMBER DAY
MOVE B,TOMORO ;PUT TOMORROW REAL EARLY MORNING IN B
MOVEI D,0 ;NO SPECIAL BITS
ODCNV ;SEE WHAT DAY OF WEEK TOMORROW IS
SKIPN SENSE
JRST [ MOVNI C,-1(C) ;NEGATE DAY OF WEEK AND FLUSH DAY OF MONTH
HRRE C,C ;FOR SUNDAY, GET RID OF 777777 IN LEFT HALF
ADD C,DAYWEK ;GET NUMBER OF DAYS FROM TOMORROW IS DESIRED
CAIGE C,0
ADDI C,7 ;FOR FUTURE, "SUBMIT /AFTER:MONDAY" MEANS NEXT TUESDAY OR LATER
JRST SL]
SUB C,DAYWEK
MOVNI C,(C) ;GET NEGATIVE NUMBER OF DAYS BEFORE TOMORROW WE WANT, AND FLUSH DAY OF MONTH
HRRE C,C ;IN CASE C WAS NEGATIVE BEFORE
SKIPLE SENSE ;RELATIVE TO NOW?
JRST SL ;YES - CHECK LATER
CAIL C,0
SUBI C,7 ;FOR PAST, "DIRECTORY SINCE MONDAY" MEANS FILES WRITTEN LAST MONDAY OR MORE RECENTLY"
SL: ASH C,22 ;SHIFT INTO POSITION FOR INTERNAL FORMAT
ADD C,TOMORO ;GET INTERNAL REPRESENTATION FOR DAY SPECIFIED
MOVEM C,BTIME
SETOM DAYFLG ;note that day-of-week was specified
JRST DAPLSQ ;MAYBE USER TYPING "+" AFTER THE DAY
; Daylight Saving Time correction subroutine
;
; calling sequence:
; A/ current date and time
; B/ target date and time
; CALL TSTDST
;
; Returns:
; +1 always with
; A/ current date and time
; B/ target date and time corrected for DST change over
TSTDST: STKVAR <TDAT> ;make a storage spot
MOVEM B,TDAT ;save target date
MOVE B,A ;copy today's date and time to B
SETZM D ;clear D for ODCNV
ODCNV ;do it
TXNN D,IC%ADS ;is DST applied (for current time)?
JRST [MOVE B,TDAT ;no, get target date and time
SETZM D ;clear ac D
ODCNV ;do it
MOVE B,TDAT ;get target date back
TXNE D,IC%ADS ;target date and time during DST?
SUBI B,25253 ;yes, convert time to DST.
RET] ;return proper date and time
MOVE B,TDAT ;no, lets see if target date in in DST
SETZM D ;clear ac D
ODCNV ;do it
MOVE B,TDAT ;get target date and time back
TXNN D,IC%ADS ;is target date in DST?
ADDI B,25253 ;yes, correct for DST change over
RET ;return proper date and time
;USER HAS TYPED /AFTER:TODAY OR SINCE TODAY
.TODAY: SETZM DAYFLG ;SAY WE DIDN'T DO A DAY OF THE WEEK
MOVE A,TOMORO ;GET VALUE FOR TOMORROW
SKIPE SENSE
MOVE A,TODAY ;FOR TIME IN PAST, BASE IS BEGINNING OF TODAY
MOVEM A,BTIME ;REMEMBER IT AS BASE VALUE
DAPLSQ: MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<Optional "+" to add amount of time>]
CALL FLDSKP ;IS USER TYPING "+"?
JRST NOPLUS ;NO
CALL GETAMT ;YES, GET AMOUNT OF TIME
RET ;IF ERROR, NON-SKIP
ADD A,BTIME
MOVE B,A ;RETURN INTERNAL DATE-AND-TIME IN B
DAA1: SKIPG SENSE ;RELATIVE TO NOW?
JRST DTEXIT ;NO - DONE
CAMG B,NOW ;TIME IN FUTURE?
ADD B,[7B17] ;NO - JUMP AHEAD 1 WK
JRST DTEXIT ;RETURN
NOPLUS: MOVE B,BTIME ;NO PLUS, SO NO MODIFICATION OF BASE TIME
MOVE A,DAYFLG ;GET FLAG THAT DAY-OF-WEEK WAS SPECIFIED
JUMPGE A,DAA1 ;WAS FLAG SET? NO, CONTINUE
MOVE A,NOW ;YES, GET CURRENT DATE AND TIME
CALL TSTDST ;ADJUST IT FOR DST CROSS OVER
JRST DAA1 ;CONTINUE...
;DATE AND TIME OR INTERVAL IN DAYS "+NNN"
DTIV$: CALL GETHLP
MOVX A,CM%IDA+CM%ITM ;FIRST FUNCTION IN CHAIN IS D&T
MOVEM A,CMDAT
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter interval in number of days>,,]]]]
CALL $WORK
RET ;BAD INPUT
LDB C,[331100,,(C)] ;GET FLAVOR OF FUNCTION
CAIE C,.CMTOK ;"+"?
RETSKP ;NO, A VALID DATE & TIME WAS GIVEN
DECX <Interval in number of days>
RET ;INVALID
RETSKP ;RETURN # OF DAYS
;QUOTED STRING
QUOTE$: CALL GETHLP
MOVX A,CMQST ;QUOTED STRING FUNCTION CODE
CALLRET $WORK ;OUTPUT IT AND SKIP OR NORMAL RETURN
;USER NAME
USERS$: SKIPA A,[CM%DWC] ;ALLOW WILDCARDING
USER$: MOVEI A,0 ;NO WILDCARDING
MOVEM A,CMDAT ;STORE IN DATA FIELD
CALL GETHLP
MOVX A,CMUSR ;USER NAME FUNCTION
CALLRET $WORK
;DIRECTORY NAME
DIRS$: MOVX A,CM%DWC ;ALLOW WILDCARDING
MOVEM A,CMDAT ;STORE IN DATA FIELD
DIR$: CALL GETHLP
MOVX A,CMDIR
CALLRET $WORK
;STRUCTURE NAME, LIKE DEVICE BUT NEEDN'T EXIST
STR$: CALL GETHLP
MOVX A,CMDEV!CM%PO
CALLRET $WORK
;DEVICE
DEV$: CALL GETHLP
MOVX A,CMDEV
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;FAKE NODE, SYNTAX CORRECT ONLY
FNODE$: CALL GETHLP
MOVX A,CMNOD!CM%PO!CM%NSF
CALLRET $WORK
;REAL NODE, MUST BE KNOWN BY SYSTEM
RNODE$: CALL GETHLP
MOVX A,CMNOD!CM%NSF
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;FILE SPECIFICATION
FILE$: CALL GETHLP
MOVX A,CMFIL ;SPECIFY FILE FUNCTION
CALLRET $WORK
;READ ENTIRE REST OF LINE
LINE$: CALL GETHLP
MOVX A,CMTXT ;TEXT FUNCTION
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;CONTROL-E
CTRLE$: HRROI A,[ASCIZ //] ;EXPECTED FIELD
JRST CHAR ;JOIN COMMON CODE
;PARSE A COMMA
COMMA$: CALL GETHLP
MOVX A,CMCMA ;COMMA FUNCTION
CALLRET $WORK
;PARSE A SLASH
SLASH$: HRROI A,[ASCIZ ./.]
JRST CHAR
;PARSE A BACKSLASH
BSLSH$: HRROI A,[ASCIZ .\.]
JRST CHAR
;PARSE A DOT
DOT$: HRROI A,[ASCIZ /./]
JRST CHAR
;PARSE A COLON
COLON$: HRROI A,[ASCIZ /:/]
JRST CHAR
;PARSE CHARACTER PASSED IN AC1
CHAR$: STKVAR <STRNG> ;STORAGE FOR CHARACTER STRING
ROT A,-7 ;MAKE ASCIZ STRING
MOVEM A,STRNG ;PUT IT ON STACK
HRROI A,STRNG ;POINT TO STRING
JRST CHAR ;FINISH UP
;PARSE A FIELD WHICH IS JUST "*"
STAR$: HRROI A,[ASCIZ /*/] ;EXPECTED FIELD
CHAR: MOVEM A,CMDAT
CALL GETHLP
MOVX A,CMTOK
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;PARSE A HYPHEN
DASH$: HRROI A,[ASCIZ /-/]
JRST CHAR ;USE COMMON CODE
;READ AND PARSE NEXT NON-BLANK CHARACTER
CMDCHT::STKVAR <STRNG>
CALL CMDCHR ;READ NEXT NON-BLANK CHAR FROM COMMAND
ROT A,-7 ;MAKE ASCIZ STRING
MOVEM A,STRNG
CALL CMDBAK ;BACKUP OVER CHAR JUST READ
HRROI A,STRNG
JRST CHAR ;PARSE THAT
ENDSV.
;SYMBOLIC ADDRESS
;This can be of the form "x" or "x,," or "x,,y", all of which can be
;symbolic.
ADDR$: STKVAR <LHVAL>
CALL ADDPRT ;GET A PART
RET ;FAILED
MOVEM A,LHVAL ;REMEMBER LEFT HALF
CALL NESC ;USER TYPE ESCAPE?
JRST NC ;YES, EXIT NOW SO GUIDE WORDS WILL BE SEEN
MOVEI B,[FLDDB. .CMTOK,,<-1,,[ASCIZ /,,/]>]
CALL FLDSKP ;SEE IF TWO COMMAS NEXT
JRST NC ;NO COMMAS, SO THERE'S ONLY ONE EXPRESSION
CALL NESC ;USER TYPE ESCAPE?
JRST NC1 ;YES - EXIT NOW SO GUIDE WORDS WILL BE SEEN
CALL ADDPRT ;GET THE PART AFTER THE COMMAS
JRST NC1 ;FAILED - ALLOW "FOO,,"
HRR B,A ;PUT RIGHT HALF INTO B
HRL B,LHVAL ;ACCUMULATE WITH LEFT HALF
RETSKP ;SKIP FOR SUCCESS
ADDPRT: CALL GETHLP ;SET UP HELP TEXT
MOVEI A,[BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<()+-*/&.$%>]
MOVEM A,CMBRK ;SPECIFY BREAK MASK
MOVX A,CMFLD ;SAY TO READ AS A FIELD
CALL $WORK ;READ THE ADDRESS
RET ;GIVE FAILURE RETURN IF CAN'T EVEN READ STRING
CALL BUFFF ;ISOLATE THE STRING
MOVE B,A ;GET COPY OF POINTER TO EXPRESSION
ILDB B,B ;PEEK TO SEE IF NULL
JUMPE B,ADDPR0 ;NULL, SO RETURN 0
CALLRET EVAL ;EVALUATE ADDRESS AND SKIP OR NORMAL RETURN
ADDPR0: TDZA A,A ;RETURN ZERO
NC: MOVE B,LHVAL ;NO COMMAS, SO THERE'S ONLY ONE EXPRESSION
RETSKP
NC1: HRLZ B,LHVAL ;ALLOW "FOO,,"
RETSKP
;ACCOUNT
ACCT$: CALL GETHLP ;SET UP HELP TEXT
MOVX A,CMACT ;SPECIFY ACCOUNT FUNCTION
CALLRET $WORK
;WORD
WORD$: USTAR @40 ;WORD MIGHT BE "*"
CAIA ;NON-* TYPED
RETSKP ;YUP, WAS.
CALL GETHLP
MOVX A,CMFLD ;ARBITRARY FIELD FUNCTION
CAME Q3,[ASCIZ /PSWD/] ;PARSING A PASSWORD ?
IFSKP. ;[4402] Yes.
MOVEI B,MSKLB ;[4402] Get appropriate mask
MOVEM B,FBLOCK+4 ;MOVE ADDR TO .CMBRK
TXO A,CM%BRK ;SET CMBRK FLAG IN CMFNP
ENDIF.
CAME Q3,[ASCIZ /LAT/] ;[4402] How about a LAT-type name?
IFSKP. ;[4402] Yes.
MOVEI B,LATMSK ;[4402] So allow appropriate characters
MOVEM B,FBLOCK+4 ;MOVE ADDR TO .CMBRK
TXO A,CM%BRK ;SET CMBRK FLAG IN CMFNP
ENDIF.
;[4402] Neither password nor LAT name - proceed as normal
SETZM Q3 ;[4402] RESTORE TEMP AC
CALLRET $WORK
;END OF LINE
CRR$: CALL GETHLP
MOVX A,CMCFM ;"CONFIRM" FUNCTION
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;COMMON CODE FOR ABOVE CASES
$WORK: MOVEI B,FBLOCK ;GET ADDRESS OF FUNCTION BLOCK
WORKB$: TXO A,CM%BRK+CM%HPP+CM%DPP+CM%SDH ;USE OUR OWN HELP, DEFAULTS, AND BREAK SET
SKIPN CMBRK ;BREAK SUPPLIED?
TXZ A,CM%BRK ;NO, SO TELL COMND THERE IS NONE
SKIPN CMDEF ;ANY DEFAULT STRING SUPPLIED?
TXZ A,CM%DPP ;NO, SO TELL COMND THERE'S NONE
MOVEM A,CMFNP
CALLRET FLDSKP ;INPUT THE FIELD AND SKIP OR NORMAL RETURN
GETHLP: SKIPN A,@40 ;GET HELP STRING
RET ;USE SAME AS LAST TIME
;FALL INTO HELP$ TO SET IT UP
;SERVICE "HELPX" MACRO. USE ARG AS DEFAULT HELP STRING FOR NEXT
;FIELD INPUT.
HELP$: HRRO A,40 ;GET POINTER TO STRING
MOVEM A,CMHLP ;STORE HELP STRING
RET
;SERVICE ROUTINE FOR DEXTX MACRO, WHICH SETS UP
;JFN BLOCK WITH DEFAULT EXTENSIONS FOR INPUT AND OUTPUT FILESPECS
DEXT$: SETZM CJFNBK ;CLEAR OUT JFN BLOCK
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+JBLEN-1
HRRO A,40 ;GET DEFAULT EXTENSION
SKIPE @40 ;DON'T SET UP POINTER IF NO DEFAULT EXTENSION
MOVEM A,CJFNBK+.GJEXT ;STORE IT
RET
;ROUTINE TO SERVICE "DEFX" MACRO, WHICH SETS THE DEFAULT STRING
;VALUE
DEF$: HRRO A,40 ;GET POINTER TO DEFAULT FIELD VALUE
MOVEM A,CMDEF ;SET UP DEFAULT STRING VALUE
RET
;MULTI FILE INPUT AND OUTPUT ROUTINES
;SCAN OUTPUT FILESPEC FOR MULTI FILE OP
;IF GROUPF NOT SET, DEFAULTS NAME AND EXT TO INPUT JFN
;RETURNS OUTPUT JFN IN OUTDSG
;IF GROUPF SET, DEFAULTS TO *.*;-1 AND RETURNS JFN IN MCOJFN
MFOUT:: MOVE A,[XWD [ASCIZ/*/],[ASCIZ/*/]] ;DEFAULT TO *'S
MOVE B,INIFH1
CAME B,INIFH2 ;IF EXACTLY 1 TERM, MAYBE USE NAMES
JRST MCOPY1
HRRZ B,@INIFH1 ;GET JFN ONLY
CAIN B,FI%ERR ;DID FILE EXIST?
JRST MCOPY1 ;NO--USE *.* AS DEFAULT
MOVE B,@INIFH1 ;GET JFN AND BITS
TXNN B,GJ%NAM ;* FOR NAME?
HRLI A,2 ;NO, USE PREVIOUS NAME
TXNN B,GJ%EXT ;* FOR EXT?
HRRI A,2 ;NO, USE PREVIOUS EXT
MCOPY1: MOVEI B,(GJ%FOU+GJ%IFG+GJ%OFG+GJ%MSG) ;DEFAULT TO -1 VERSION
CALL SPECFN ;COLLECT FILE NAME, GTJFN FLAGS IN RH B.
JRST CERR
MOVEM A,OUTDSG ;DESTINATION JFN
MOVEM A,MCOJFN ;HERE FOR MULTI FILE COPY
MOVE B,A ;PUT FILE HANDLE IN B (WITH WILDCARD BITS)
LDF C,1B2 ;BITS TO GET DEVICE FIELD
TXNE B,GJ%DEV+GJ%UNT ;WILDCARDS USED IN DEVICE FIELD?
CALL BADSTR ;ERROR IF BAD WILDCARD SYNTAX
LDF C,1B5 ;SPECIFY DIRECTORY
TXNE B,GJ%DIR ;STAR IN DIRECTORY FIELD?
CALL BADSTR ;YES, MAKE SURE IT'S LEGAL
LDF C,1B8 ;NAME FIELD
TXNE B,GJ%NAM
CALL BADSTR ;MAKE SURE LEGAL STARS IN NAME FIELD
LDF C,1B11 ;TYPE FIELD (EXTENSION)
TXNE B,GJ%EXT
CALL BADSTR
LDF C,1B14 ;GENERATION NUMBER
TXNE B,GJ%VER
CALL BADSTR ;MAKE SURE LEGAL WILCARDS IN GENERATION FIELD
HLRZ A,JBUFP ;WILL REQUIRE AT LEAST 1 MORE JFN FOR COMMAND
CAIN A,-1
ERROR <Too many JFNs in command>
RET
;FOLLOWING ROUTINE RETURNS IFF STRING RETURNED BY JFNS CONTAINS
;ONLY "*". CALL THIS ROUTINE WITH INDEXABLE FILE HANDLE (FLAGS,,JFN)
;IN B, AND JFNS BITS IN C. AC'S PRESERVED. THE PURPOSE OF THIS ROUTINE
;IS TO CATCH FANCY FILENAMES THAT WON'T CAUSE EXPECTED RESULT.
;FOR INSTANCE "RENAME *.* (TO BE) X*.*" DOESN'T REALLY PUT "X" IN FRONT
;OF EVERY NAME, SO THIS ROUTINE MAKES SURE YOU'RE NOT TRYING TO DO
;THAT TYPE OF THING.
BADSTR: SAVEAC <A,B,C>
STKVAR <<JFNSP,EXTSIZ>>
HRROI A,JFNSP
JFNS ;GET FIELD
HRROI A,JFNSP ;POINT AT FIELD WE JUST WROTE
HRROI B,[ASCIZ /*/]
STCMP ;MAKE SURE ONLY "*" AND NOT "F*" ETC.
JUMPN A,[ERROR <Invalid use of wildcard characters>]
RET ;RETURN SUCCESFULLY
;GET OUTPUT NAME FOR MULTI FILE OPERATION
;GETS JFN INTO OUTDSG, ASSUMES SCANNED
;OUTPUT NAME JFN IN MCOJFN. SKIPS ON SUCCESSFUL GTJFN AFTER
;PRINTING FILESPEC.
;DIRECT RETURN ON ERROR, NAME AND MESSAGE ALREADY PRINTED
;CALL:
; A/ -1 IF COPYING FILES, 0 IF RENAME OR APPEND
;RETURNS:
; +1: FAILURE. MESSAGE ALREADY PRINTED
; +2: SUCCESS. OUTPUT FILE JFN IN OUTDSG
;
MFSET:: TRVAR <MFPP,COPFLG,<MFBUF,FILWDS>>
SKIPN MCOJFN ;MULTI FILE OUTPUT?
RETSKP ;NO, JFN ALREADY IN OUTDSG
MOVEM A,COPFLG ;SAVE COPY FLAG
SETZM MFBUF ;SO WE CAN CHECK FOR NULL STRING
HRROI A,MFBUF
MOVEM A,MFPP ;INITIALIZE BYTE POINTER TO BUFFER
MOVX C,<FLD(.JSAOF,JS%NOD)+JS%PAF> ;GET NODE
CALL MCOSTO
MOVSI A,(GJ%DEV) ;FLAG BIT TO TEST
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF> ;GET DEVICE
CALL MCOSTR ;GET STRING
MOVSI A,(GJ%DIR)
MOVX C,<FLD(.JSAOF,JS%DIR)+JS%PAF> ;GET DIRECTORY
CALL MCOSTR
MOVSI A,(GJ%NAM)
MOVX C,<FLD(.JSAOF,JS%NAM)+JS%PAF> ;NAME
CALL MCOSTR
SKIPN MFBUF ;NULL FILESPEC?
JRST MFSET1 ;YES
MOVSI A,(GJ%EXT)
MOVX C,<FLD(.JSAOF,JS%TYP)+JS%PAF> ;EXT
MOVE D,MFPP ;SAVE THE CURRENT STRING POINTER
CALL MCOSTR
MOVEI A,"." ;FOR NULL EXTENSIONS
CAMN D,MFPP ;SEE IF WE GOT SOMETHING
IDPB A,MFPP ;NOTHING CHANGED, FORCE A NULL EXTENSION
MOVSI A,(GJ%VER)
MOVX C,<FLD(.JSAOF,JS%GEN)+JS%PAF> ;VERSION
CALL MCOSTR
MOVX C,<FLD(.JSSSD,JS%PRO)+JS%PAF> ;PROTECTION
CALL MCOSTO ;GET PROTECTION FROM OUTPUT
MOVE C,MCOJFN ;GET OUTPUT NAME JFN
TXNN C,GJ%TFS ;IS THIS A TEMPORARY FILESPEC?
JRST MFSET0 ;NO, SO DO NOT APPEND ;T TO FILENAME
MOVE A,MFPP ;YES, GET STRING SPACE POINTER
MOVEI C,";" ;APPEND A ;T TO THE FILENAME
IDPB C,A
MOVEI C,"T"
IDPB C,A
MOVEM A,MFPP ;REPLACE UPDATED STRING POINTER
MFSET0: MOVX C,<FLD(.JSSSD,JS%ACT)+JS%PAF> ;ACCOUNT
CALL MCOSTO
MOVX C,<JS%ATR+JS%PAF> ;GET ATTRIBUTES
CALL MCOSTO
MFSET1: SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
UTYPE [ASCIZ/ => /]
HRROI B,MFBUF
MOVSI A,(GJ%FOU!GJ%SHT!GJ%DEL!GJ%FLG!GJ%PHY) ;OUTPUT, SHORT CALL, DELETED OK, PHYSICAL ONLY
CALL GTJFS ;DO GTJFN, STACK IN CASE ^C
JRST [ HRROI B,MFBUF ;GET POINTER TO BEGINNING OF STRING
LERROR <Destination GTJFN failure on %2M%%_% %1?>
RET]
HRRZM A,OUTDSG
MOVE B,A ;GET FULL JFN INTO B
TXZ B,GJ%UHV!GJ%NHV!GJ%ULV ;MAKE VERSION NUMBER COME OUT RIGHT
MOVE A,COJFN ;OUTPUT NAME TO HERE
MOVE C,[JS%NOD+2B2+2B5+2B8+2B11+2B14+2B17+2B20+1B21+JS%ATR+1B35]
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
JFNS
SKIPGE COPFLG ;COPYING?
JRST [ CALL SPRCHK ;YES. SEE IF OK TO COPY FILE
JRST SPRERR ;DESTINATION FILE CAN'T BE SUPERSEDED
JRST .+1 ] ;OK TO COPY FILE
HRRZ A,OUTDSG
DVCHR ;GET DEVICE CHARACTERISTICS OF OUTPUT FILE
LDB A,[POINT 9,B,17] ;DEVICE TYPE
CAIE A,.DVDSK ;IF DISK, SPECIAL CHECK
RETSKP ;ELSE INDICATE SUCCESS
HRRZ A,OUTDSG
MOVE B,[1,,.FBCTL] ;GET FLAG WORD
MOVEI C,A ;INTO A
CALL $GTFDB
SETZ A, ;MAKE SURE FB%NXF OFF IF ACCESS PREVENTED
TXNN A,FB%NXF ;NEW FILE?
TYPE < [Superseding]> ;NO, INFORM USER
RETSKP
SPRERR: ETYPE <%_%%%Not superseding current file%_> ;SAY FILE WAS NOT SUPERSEDED
RET ;AND RETURN +1
MCOSTR: TDNN A,MCOJFN ;OUTPUT * HERE?
MCOSTO: SKIPA B,MCOJFN ;NO, USE OUTPUT FIELD
HRRZ B,@INIFH1 ;YES, USE INPUT FIELD
MOVE A,MFPP ;GET STRING SPACE POINTER
JFNS ;GET STRING
MOVEM A,MFPP ;STORE STRING SPACE POINTER
RET
;CALL TO COPY JFN POINTED TO BY INIFH1 TO SECOND JFN
;THEN ADVANCE INIFH1 PAST THAT FILE. USED BY DELETE AND
;RENAME BECAUSE GNJFN DOES NOT WORK AFTER RENAME AND SOME DELETES.
MFINP:: CALL MFINP0 ;GET JFN AND FLAGS
RET ;FAILED
HRRZ A,A ;GET RID OF FLAGS
RETSKP
;MFINP0 IS LIKE MFINP BUT RETURNS GNJFN FLAGS IN LEFT HALF OF A
MFINP0::STKVAR <MFJFN,<MFIBUF,FILWDS>>
HRROI A,MFIBUF
HRRZ B,@INIFH1 ;JFN
MOVX C,<JS%NOD+JS%DEV+JS%DIR+JS%NAM+JS%TYP+JS%GEN+JS%ATR+JS%PAF>
JFNS ;ASK FOR NODE::DEVICE:<DIR>NAME.EXT;GEN
CALL GNFIL ;ADVANCE FIRST JFN BEFORE DELETE OR WE GET LOST
SETZM INIFH1 ;CLEAR THIS TO INDICATE NO MORE JFNS
MOVEM A,MFJFN ;REMEMBER FLAGS
MOVEI A,[GJ%OLD+GJ%NS+GJ%PHY+GJ%DEL+GJ%XTN
.NULIO,,.NULIO ;NO I/O
0 ;DSK:
0 ;<DIR>
0 ;FILE.
0 ;EXT
0 ;;P
0 ;;A
0 ;JFN
G1%IIN ;ALLOW INVISIBLE FILES
0 ;[3037][3038] Fill in remaining words with 0
0 ;[3038]
0 ;[3038]
0 ;[3038]
0 ;[3038]
0] ;[3038]
HRROI B,MFIBUF ;GET FILE FROM OTHER JFN
CALL GTJFS ;DO GTJFN, STACK IT
JRST [ HRROI B,MFIBUF ;GET POINTER TO FILESPEC
LERROR <Source GTJFN failure on %2M%%_% %1?>
RET]
HLL A,MFJFN ;RETURN GNJFN'S FLAGS
RETSKP ;RETURN WITH JFN IN A
;SPRCHK - VERIFY VALIDITY OF COPYING WITH SUPERSEDE SUBCOMMANDS
;CHECK TO SEE IF THE SETTING OF THE SUPERSEDE FLAG AND THE WRITE TIME AND
;DATE OF THE FILES WILL ALLOW THE COPY.
; OUTDSG/ DESTINATION JFN
; INIFH1/ ADDRESS OF INPUT JFN
;RETURNS: +1: FILE SHOULD NOT BE COPIED
; +2: FILE CAN BE COPIED
;
SPRCHK: TRVAR <DSTTAD>
SKIPGE SPRSED ;SUPERSEDE ALWAYS?
RETSKP ;YES. RETURN +2
CALL GTSTAD ;GET TAD OF FILE BEING SUPERSEDED
RETSKP ;NO TAD, ALLOW COPY TO SUCCEED
MOVEM A,DSTTAD ;STORE TAD OF FILE
SKIPN SPRSED ;SUPERSEDE NEVER?
RET ;YES. DON'T COPY OVER THIS FILE
HRRZ A,@INIFH1 ;GET JFN OF SOURCE FILE
MOVEI B,D ;WHERE TO STORE TAD OF FILE
MOVEI C,1 ;LENGTH OF ARG BLOCK
RFTAD ;GET TIME AND DATE OF LAST WRITE
SKIPGE D ;SOURCE TAD -1?
RETSKP ;YES. ALLOW THIS TO WORK
MOVE A,SPRSED ;GET SUPERSEDE SWITCH
CAIN A,2 ;SUPERSEDE NEWER?
EXCH D,DSTTAD ;YES. EXCHANGE VALUES FOR COMPARE
CAMLE D,DSTTAD ;COPY ALLOWED?
RETSKP ;YES
RET ;NO
;GTSTAD - GET TAD OF THE FILE BEING SUPERSEDED. THIS FILE IS DEFINED AS
;BEING THE FILE WITH HIGHEST GENERATION NUMBER LESS THAN OR EQUAL TO THE
;GENERATION NUMBER OF THE DESTINATION FILE.
; OUTDSG/ JFN OF DESTINATION FILE
; CALL GTSTAD ;(OUTDSG/T1)
;RETURNS: +1: FAILED TO GET A TIME AND DATE (PROBABLY NO SUCH FILE OR
; DEVICE TYPE HAS NO TIME AND DATE ASSOCIATED WITH IT)
; +2: SUCCESS
; A/ TIME AND DATE AND DATE OF FILE BEING SUPERSEDED
;
GTSTAD: TRVAR <DSTGEN,SPRTAD,CURJFN,<FILBUF,FILWDS>>
SETOM SPRTAD ;INDICATE NO JFN FOUND
HRRZ A,OUTDSG ;GET JFN OF DEST. FILE
MOVE B,[XWD 1,.FBGEN] ;GET GENERATION WORD
MOVEI C,D ;STORE IN D
GTFDB% ;GET THE GENERATION NUMBER
ERJMP GTSERR ;NOT GOOD. ALLOW COPY
HLRZM D,DSTGEN ;SAVE ONLY GENERATION NUMBER
HRROI A,FILBUF ;POINT TO FILE NAME BUFFER
HRRZ B,OUTDSG ;GET DESTINATION JFN
MOVX C,<2B2!2B5!1B8!1B11!JS%PAF> ;FLAGS FOR JFNS
SETZ D, ;NO PREFIX STRING
JFNS ;EXPAND THE FILE NAME
ERJMP GTSERR ;FAILED TO EXPAND JFN?
HRROI B,[ASCIZ /.*/] ;STRING TO APPEND
SETZ C, ;TERMINATE ON NULL BYTE
SOUT ;APPEND TO FILE NAME
ERJMP GTSERR ;FAILED FOR SOME REASON
MOVX A,<GJ%SHT!GJ%IFG!GJ%OLD> ;OLD FILES, ALLOW WILD CARDS
HRROI B,FILBUF ;POINT TO CONSTRUCTED FILE NAME
CALL GTJFS ;GET AND STACK THE JFN
JRST GTSERR ;FAILED. ASSUME NO FILES
MOVEM A,CURJFN ;SAVE CURRENT JFN
GTS1: HRRZS A ;GET JFN ONLY FOR GTFDB
MOVE B,[XWD 1,.FBGEN] ;GET GENERATION WORD
MOVEI C,D ;STORE IN D
GTFDB% ;GET THE GENERATION NUMBER
ERJMP GTSFND ;NOT GOOD. USE SPRTAD
HLRZS D ;GET GENERATION ONLY
CAMLE D,DSTGEN ;IS THIS GENERATION GREATER THAN DEST.
JRST GTSFND ;YES. RETURN TAD IN SPRTAD
MOVEI B,D ;RETURN INFO IN D
MOVEI C,1 ;ONE WORD
RFTAD ;GET FILE TIME AND DATE
ERJMP GTSFND ;USE SPRTAD
MOVEM D,SPRTAD ;SAVE THIS TIME AND DATE
MOVE A,CURJFN ;GET FULL JFN WORD FOR GNJFN
CALL GNJFS ;GET NEXT JFN IN GROUP
JRST GTSFND ;NO MORE OR SOMETHING. USE SPRTAD
JRST GTS1 ;GOT ONE. TEST GENERATION
GTSFND: CALL JUNSTK ;JFN HAS BEEN DE-ASSIGNED. POP FROM STACK
RLJFN ;RELEASE IT
ERJMP .+1 ;IGNORE ERROR. GNJFN MAY RELEASE JFN
SKIPL A,SPRTAD ;GET FILE TIME AND DATE IN A
AOS (P) ;RETURN +2 IF WE GOT A TAD
GTSERR: RET ;DONE
;COLLECT FILE NAMES:
;COUTFN & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON.
;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS.
;CAN INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS *.MAC FORMS.
;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER
; 2 => USE EXT OF LAST FILE NAME INPUT AS DEFAULT EXT
; LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
; 0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE
; 1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT
; 2 => LIKE 0 BUT USE LAST NAME INPUT AS DEFAULT NAME
; -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR *
; -2 LIKE -1 BUT GIVE R1 IF NO SUCH FILE
; ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0)
; RH: FLAGS FOR GTJFN PLUS:
; B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",".
; DOES NOT HANDLE ALTMODE-COMMA (USE ^F FOR RECOGNITION),
; MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY)
; B16: ALLOW GROUP OF NAMES SEPARATED BY SPACE, ALTMODE, OR
; SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED
; BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND
; INPUT REQUIRED).
; B15 SHOULD ALSO BE ON.
; ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN
; PRE-READ FOLLOWING FIELD
; B17: NO SUBCOMMANDS FOLLOW THE LIST.
;
; B14: IF NO SUCH DEVICE, NO SUCH DIRECTORY,...,
; NO SUCH GENERATION... RETURN PTR,,FI%ERR IN PLACE OF JFN
; PTR POINTS TO <CHAR COUNT>,,<ERROR #> FOLLOWED BY
; BYTE POINTER TO TYPESCRIPT.
;
;
; ALSO, F3 IN Z SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN
; AFTER INITIAL TRY FAILS -- FOR DEFAULT RUN
; IGINV in Z says to allow invisible files (G1%IIN)
;COLLECT FILE NAMES COMMENTS...
;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT,
; OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A),
; OR P2=EOL AT ENTRY (IN WHICH CASE NO INPUT),
; OR -2 IN LH OF A AND NO SUCH FILE,
; OR B16 ON AND LIST ENDED WITH COMMA.
; THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T
; BE USED IF B15 OR B16 ON.
; +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF"
; (POINTER JBUFP). 1ST LOCATION IN THIS BUFFER
; (FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,...
; IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT
; (B11,15,16 ON), SETS INIFH1 &2 TO 1ST & LAST USED
; LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF"
; IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT).
; EITHER: TERMINATOR IN "P2"
;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF,
; AS %KEYW DOES. SEE %KEYW'S GLITCH NOTE (S1.MAC).
;FLAGS IN AC D
;RH: FROM CALLER
;LH:
; B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA
; B2: DITTO, DITTO, FOLLOWED BY COMMA
;COLLECT FILE NAMES... ENTRIES.
CSAVFN: MOVEI B,<GJ%FOU!GJ%MSG>B53 ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME).
;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION.
COUTFN: MOVEI B,(GJ%FOU!GJ%MSG) ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP.
;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA.
;NO SPECIAL RETURN FOR "*" OR NULL INPUT.
;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN".
;COLLECT FILE NAMES... GROUP ENTRIES
;.INFG
;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME -
; THUS ^F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW.
;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW,
; AS IN 1ST ARG TO "COPY".
;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP),
; VERSION TO HIGHEST.
;ONE RETURN ONLY.
;.INFG, BUT WITH NO SEARCH (FOR ACCOUNT, VERSION-RET..., PROTECTION)
INFGNS::MOVE B,[XWD -3,<GJ%OLD!GJ%IFG!GJ%NS!1B14!1B15>B53] ;* VERSION FOR RENAME
JRST .INFG1
.INFG: MOVEI B,(GJ%OLD!GJ%IFG!1B15)
.INFG1: MOVE A,[XWD 2,2]
CALL SPECFN
JRST CERR
RET
;$INFGX
;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT
;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT).
$INFGX: MOVEI B,(GJ%OLD!GJ%IFG!1B14!1B15!1B16)
MOVE A,[XWD 2,2]
JRST SPECFN
;FLAVOR THAT READS LIST OF FILESPECS, AS IN "TYPE" COMMAND, OR
;"SET FILE INVISIBLE". NOTE THAT THIS IS THE WRONG ROUTINE FOR
;THINGS LIKE "SET FILE PROTECTION" WHICH TAKE ANOTHER ARG (THE PROTECTION)
;AFTER THE LIST
TYPFLS::DMOVE A,[EXP 0,<(GJ%OLD!GJ%IFG!1B15!1B16!1B17)>] ;NO SPECIAL, OLD FILE, STARS ALLOWED, LIST O.K., LIST IS LAST ON LINE, NO SUBCOMMANDS
CALL SPECFN ;GATHER SPECS TO TYPE
RET ;NO SUBCOMMANDS
RET
;DIRARG
;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT:
; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!).
; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS
; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER.
; ACCEPTS * FOR NAME IN EMPTY DIRECTORY
; SETS NO SEARCH FOR GTJFN
DIRARG: MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]]
HRLI B,-3 ;DEFAULT VERSION: *
HRRI B,(GJ%OLD!GJ%DEL!GJ%IFG!1B14!1B15!1B16)
JRST SPECFN
;COLLECT FILE NAMES ENTRIES...
;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH.
; USED IN SPECIAL CASES, EG:
; DELETED FILE NAME FOR "UNDELETE"
; ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY".
;END OF ENTRIES. CASES MERGE HERE.
SPECFN: SETZM CJFNBK+2 ;NO DEFAULT DEVICE
SETZM CJFNBK+3 ;AND NO DEFAULT DIRECTORY
CFN1A: TRVAR <SAVFGS,CEX,SEXJFN,CFNMOD,CFLAGS>
MOVEM A,CFNMOD ;SAVE MODE BITS
HRRZ D,B ;SAVE GTJFN AND LOCAL FLAGS IN RH D
MOVEM D,CFLAGS ;SAVE FLAGS
TRZ B,(1B14!1B15!1B16) ;DON'T GIVE LOCAL FLAGS TO GTJFN
TRNN D,(GJ%OFG) ;IF OUTPUT GROUP THEN NOT INPUT
TRNN D,(GJ%IFG!1B15!1B16) ;IF AN INPUT GROUP IS BEING REQUESTED,
SKIPA
SETZM INIFH1 ;SAY NO NAMES HAVE BEEN INPUT YET.
;COLLECT FILE NAMES...
;SET UP GTJFN PARAMETER BLOCK
MOVSM B,SAVFGS ;FLAGS AND DEFAULT VERSION
SETZ B, ;SET UP .GJF2 WORD
TXNE Z,IGINV ;ALLOW INVISIBLE?
TXO B,G1%IIN ;YES
MOVEM B,CJFNBK+.GJF2 ;STORE IN GTJFN BLOCK
;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP
CFN2: MOVE A,SAVFGS ;GET SAVED FLAGS
MOVEM A,CJFNBK+.GJGEN ;SET UP FOR GTJFN (ERROR HANDLING MAY HAVE CLOBBERED THEM)
MOVE A,CFNMOD ;RESTORE MODES
MOVE B,JBUFP
MOVEM B,.JBUFP
;FORM "DEFAULT STRING POINTER" TO EXTENSION
HRRZ B,A
MOVX C,FLD(.JSAOF,JS%TYP) ;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT
CAIN B,2 ;2 SAYS USE EXT OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S EXT
SKIPE B
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+5
;FORM "DEFAULT STRING POINTER" TO DEFAULT NAME
HLRZ B,A
MOVX C,FLD(.JSAOF,JS%NAM) ;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT.
CAIN B,2 ;2 SAYS USE NAME OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S NAME
CAIE B,-2
CAIN B,-1
SETZ B,
SKIPE B
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+4
HLRZ B,JBUFP ;CHECK SPACE IN JFN BUFFER
CAIN B,-1
ERROR <Too many JFNs in command>
FILEX <FILE NAME> ;TRY TO READ FILE NAME
JRST CFNE ;COULDN'T
MOVE A,B ;PUT JFN INTO A
;COLLECT FILE NAMES...
;CODE FOR THE VARIOUS GROUP CASES
CFN4Z: MOVE D,CFLAGS ;GET FLAGS (SUBROUTINES MAY CLOBBER D!)
TRNN D,(GJ%OFG)
TRNN D,(GJ%IFG!1B15!1B16)
RETSKP ;NO SUCH OPTIONS ON
HRRZ B,JBUFP
SKIPN INIFH1 ;FIRST JFN IN GROUP?
MOVEM B,INIFH1 ;YES, SAVE JBUF POINTER
TLNE A,<77B5>B53 ;ANY *'S INPUT OR DEFAULTED TO?
TLO Z,GROUPF ;YES, SAY GROUP WAS SPECIFIED.
TRNN D,(1B15) ;INPUTTING GROUPS OF FILES?
JRST CFN7Z ;NO
TRNE D,(1B16) ;INPUTTING UNTIL END OF LINE?
JRST B16ON ;YES
MOVE A,CMFLG ;NOT INPUTTING TO END OF LINE, GET FLAGS
TXNE A,CM%ESC ;DID USER END FILE NAME WITH $ ?
JRST CFN7Z ;YES, SO WE'RE DONE
;Note here that ESCAPE is being used for
;two purposes, both to complete the filespec
;automatically, and to declare that you want
;the guide words for the next field of the
;command. This is sort of a loser. What if
;you want one and not the other???
COMMAX <Comma to specify another filespec, or next field of command>
;REGULAR GROUP, SO WE NEED COMMA TO READ ANOTHER NAME
JRST CFN7Z ;GROUP BUT NO COMMA AFTER FILE NAME, SO WE'RE DONE
CFN22: TLO Z,GROUPF ;NOTE THAT GROUP HAS BEEN INPUT
JRST CFN2 ;GET NEXT FILE AFTER THE COMMA
B16ON: HELPX <Carriage return to end command
or comma and another filespec
or comma and carriage return to enter subcommands>
TRNE D,(CF%NS) ;DON'T ADVERTISE SUBCOMMANDS IF CALLER HAS NONE
HELPX <Carriage return to end command
or comma and another filespec>
CRRX ;INPUTTING UNTIL END OF LINE, HAVE WE REACHED IT YET?
CAIA ;NOT YET
JRST CFN7Z ;YES
COMMAX ;COMMA AFTER FILE NAME?
ERROR <Comma missing between filespecs or illegal character in command>
TRNE D,(CF%NS) ;NO SUBCOMMANDS?
JRST CFN22 ;RIGHT, SO COMMA MEANS ANOTHER FILE COMING
CRRX <Carriage return to enter subcommands
or another filespec> ;SUBCOMMANDS, SO WE WANT R1
JRST CFN22 ;COMMA NOT FOLLOWED BY CR, MUST BE ANOTHER FILE SPEC
CALLRET CFNFIX ;GET RETURN DATA AND GIVE NON-SKIP RETURN
CFN7Z: CALL CFNFIX
RETSKP
CFNFIX: HRRZ B,JBUFP
MOVEM B,INIFH2 ;RETURN JBUFP VALUE FOR LAST NAME IN GROUP
MOVE A,@INIFH1 ;RETURN FIRST, NOT LAST, JFN IN A
RET
;GTJFN ERRORS
;FIRST TEST ERROR CODE FOR EXCEPTIONS.
CFNE: CALL GETERR ;GET REASON THE GTJFN FAILED
CAIN A,GJFX3
ERROR <No JFNs available: You must close some files first>
CAIN A,GJFX22
ERROR <JSB full: Try closing some files then repeating command>
CAIN A,GJFX23
ERROR <Directory full: Can't create new files until you
"DELETE" some files and "EXPUNGE (DIRECTORY)">
TRNN Z,F4!F3!F2 ;FOR DELETE, DIRECTORY OR DISCARD COMMAND?
JRST CFNE2 ;NO, NO CHECK
CAIL A,GJFX16
CAILE A,GJFX21
CAIN A,GJFX24
JRST CFNE1
CAIE A,GJFX36
CAIN A,GJFX32
JRST CFNE1
CAIN A,GJFX35 ;DIR ACCESS DENIED
JRST CFNE1 ;YES - DEFER
CFNE2: MOVEM A,ERCOD ;SAVE ERROR CODE
HLRZ A,CFNMOD ;MOST GTJFN ERRORS RETURN +1 IF CALLER GAVE
CAIE A,-2 ;... -2 IN LH OF A.
CMERRX ;IT'S -2 - GIVE UP AND TYPE ERROR MESSAGE
MOVE A,CFNMOD ;ELSE RETURN
RET ;RETURN
;IF FLAG B14 ON GIVE GOOD RETURN WITH PTR,,FI%ERR INSTEAD
;OF JFN WHEN GJFX32 ERROR OCCURS.
;USED FOR "DIRECTORY" (DIRARG).
CFNE1: MOVEM A,CEX ;SAVE ERROR CODE
MOVE A,CMFLG ;GET FLAGS
TXNE A,CM%ESC ;MAKE SURE NO RECOGNITION WAS ATTEMPTED
IFNSK.
ETYPE <%_>
CALL %MESS
MOVE A,[440700,,ATMBUF]
ETYPE <%? - %1M %_>
JRST ERRFIN
ENDIF.
DEXTX <> ;CLEAR GTJFN BLOCK
MOVX A,GJ%OFG ;WE WANT SPEC, DON'T CARE IF EXISTS ANYMORE
IORM A,CJFNBK+.GJGEN
FILEX <> ;TRY TO READ THE FILESPEC
CMERRX ;SPEC NOT EVEN SYNTACTICALLY CORRECT
MOVEM B,SEXJFN ;REMEMBER JFN AND FLAGS
CALL PIOFF ;DON'T ALLOW ^C WHILE PERMANENT FREE SPACE ASSIGNED AND NOT RECORDED
MOVEI A,.FILEN ;GET SIZE OF ERROR BLOCK
CALL GTBUFX ;GET BUFFER FOR BLOCK (NOT GETBUF, SINCE UNMAP
;MIGHT BE CALLED BEFORE RLJFNS!)
EXCH A,CEX ;STORE ADDRESS IN CEX, GET ERROR CODE IN A
MOVE B,CEX ;GET ADDRESS OF BLOCK
MOVEM A,.FIERR(B) ;STORE ERROR CODE IN FIRST WORD OF BLOCK
MOVE A,SEXJFN ;GET JFN AND FLAGS IN CASE CALLER WANTS IT
MOVEM A,.FIJFN(B) ;REMEMBER IT IN CASE CALLER NEEDS IT
HRROI A,ATMBUF ;POINT TO FILESPEC
CALL XBUFFS ;BUFFER IN PERMANENT SPACE (SO UNMAP DOESN'T CLOBBER IT)
MOVE B,CEX ;GET ADDRESS OF BLOCK
MOVEM A,.FISTR(B) ;STORE STRING POINTER IN BLOCK
HRL A,CEX ;ADDRESS IN LEFT HALF
HRRI A,FI%ERR ;SPECIAL CODE
MOVE B,JBUFP ;SEE WHERE ON STACK THIS ENTRY SHOULD BE PUT
MOVEM A,(B) ;REPLACE PARSE-ONLY JFN WITH ERROR ENTRY
CALL PION ;ALLOW ^C AGAIN NOW THAT FREE SPACE USAGE HAS BEEN RECORDED
JRST CFN4Z ;FINISH PROCESSING
;NXFILE
;CHECK FOR FLAG IN PLACE OF JFN (FI%ERR)
;IF ON, PRINT ERROR MESSAGE AND TYPESCRIPT
NXFILE::ATSAVE
HRRZ A,@INIFH1
CAIE A,FI%ERR ;SPECIAL CASE?
RETSKP ;NO
CALL %MESS
HLRZ D,@INIFH1 ;GET POINTER TO STRING
HRRZ A,.FIERR(D) ;GET GTJFN ERROR CODE
CALL $ERSTR ;PRINT ERROR
TYPE < - >
UTYPE @.FISTR(D) ;PRINT TYPESCRIPT
ETYPE<%_>
AOS A,INIFH1 ;SKIP OVER THIS TERM
CAMLE A,INIFH2 ;PAST END?
SETZM INIFH1 ;YES, FLAG SUCH
RET
$ERSTR::ETYPE <%1?> ;TYPE MESSAGE FOR CODE IN A
RET
;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN.
;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING
; JFNS FORMAT SPECIFICATION IN C.
;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING
;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS
; COMMAND, RETURNS 0 IN B.
LFJFNS: SAVEAC <A>
STKVAR <<LFBUF,FILWDS>>
SETZM LFBUF ;SO WE'LL KNOW IF SOMETHING'S WRITTEN
HRRZ B,JBUFP ;JFN STACK POINTER
CAIN B,JBUF-1 ;HAS A NAME BEEN INPUT YET?
JRST LFJF9 ;NO, GO RETURN 0 POINTER
HRRZ A,(B) ;PICK UP JFN OF LAST NAME INPUT
CAIE A,-2
CAIN A,-1
JRST LFJF9 ;-1, -2 ISN'T A JFN BUT MIGHT GET HERE
HRROI A,LFBUF
MOVE B,JBUFP
MOVE B,(B) ;PICK UP JFN AGAIN
JFNS ;DO THE JFN TO STRING CONVERSION
SKIPN LFBUF
HRLI A,440700 ;RETURN POINTER TO NULL STRING
SETZ B,
IDPB B,A ;APPEND NULL TO STRING
HRROI A,LFBUF ;POINT TO STRING
CALL BUFFS ;RETURN POINTER TO STRING
MOVE B,A ;RETURN POINTER IN B
RET
LFJF9: SETZ B, ;RETURN 0 IF CAN'T RETURN A STRING
RET
;CPFN: COLLECT PROGRAM FILE NAME
;TAKES: A: 0 OR WORD POINTER TO DEFAULT DEVICE NAME.
;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV".
;RETURNS +1 ON GTJFN FAILURE.
CPFN: MOVEI B,100000
CPFNA: JUMPE A,.+2
HRLI A,<POINT 7,0,-1>B53 ;IF NON-0, FILL OUT BYTE PTR
MOVEM A,CJFNBK+2 ;DEFAULT DEVICE
HRRI A,[GETSAVE()] ;DEFAULT EXT
HRLI A,-2 ;SAY RETURN +1 ON GTJFN FAILURE
JRST CFN1A ;JOIN CINFN & COUTFN
;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP
; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT)
;RETURNS JFN IN A
TYPIF: HRRZ A,@INIFH1 ;GET CURRENT JFN
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, SKIP IF NON-GROUP
ETYPE < %1S> ;%S: TYPE NAME FOR JFN
RET
;TYPOK: TYPES [OK] CORRESPONDING TO TYPIF ABOVE
;SHOULD BE CALLED ONCE FOR EACH CALL ON TYPIF, BUT
;ONLY AFTER SUCCESFULL COMPLETION OF FILE
TYPOK: SKIPN TYPGRP
TLNE Z,GROUPF
TYPE < [OK]
>
RET
;GNFIL
;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A WITH FLAGS FROM GNJFN.
;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).
GNFIL: PUSH P,A
PUSH P,B
HRRZ A,@INIFH1
GTSTS
JUMPGE B,GNFIL3 ;JUMP IF NOT OPEN
TXO A,CO%NRJ ;SAY DON'T RELEASE JFN
CLOSF
CALL JERR
GNFIL3: MOVE A,@INIFH1
TLNN A,<77B5>B53 ;NO *-FLAGS, SKIP GNJFN AND ITS BUGS
JRST GNFIL5
CAME A,[-2] ;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES
;(THAT SHOULDN'T GET HERE ANYWAY)
CALL GNJFS ;STEP TO NEXT FILE IN *-GROUP
JRST GNFIL5 ;NO MORE
JRST GNFIL8 ;LEAVE FLAGS IN LEFT HALF OF A
GNFIL5: AOS A,INIFH1 ;NEXT NAME IN GROUP
CAMLE A,INIFH2 ;ARE THERE MORE?
JRST [ POP P,B ;NO
POP P,A
RET]
HRRZ A,@INIFH1 ;RETURN NEXT JFN IN A
GNFIL8: AOS -2(P)
POP P,B
SUB P,[XWD 1,1]
RET
;THIS ROUTINE OBTAINS CONNECTED STRUCTURE. RETURNS POINTER THERETO IN A.
CONST:: GJINF ;GET CONNECTED DIRECTORY NUMBER
MOVE A,CSBUFP ;POINT TO STRING SPACE
DIRST ;GET STR:<DIR>
ERJMP CJERRE ;GO TELL USER WHY IT FAILED (PROBABLY STRUCTURE DISMOUNTED)
MOVE A,CSBUFP ;POINTER TO STRING
STDEV ;GET DEVICE DESIGNATOR FOR STRUCTURE
ERJMP CJERRE ;COULDN'T, SAY WHY AND DIE
MOVE A,CSBUFP ;POINT TO FREE SPACE
DEVST ;MAKE STRING NAME OF STRUCTURE
ERJMP CJERRE ;FAILED
MOVE A,CSBUFP ;POINT TO THE NAME
CALLRET BUFFS ;BUFFER IT AND RETURN POINTERTO USER
;DEVN
;INPUT AND VERIFY A DEVICE NAME.
;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI
; AS TERMINATOR.
;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS.
DEVN:: SKIPN B ;ANY HELP STRING ?
HRROI B,[ASCIZ/Device name/] ;NO - USE DEFAULT
MOVEM B,CMHLP ;STORE HELP STRING
MOVX A,CMDEV!CM%NSF
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;HERE TO PARSE A STRUCTURE, LIKE DEVN EXCEPT DEVICE DOESN'T HAVE TO EXIST
STRN:: SKIPN B ;ANY HELP STRING ?
HRROI B,[ASCIZ/Structure name/] ;NO - USE DEFAULT
MOVEM B,CMHLP ;STORE HELP STRING
MOVX A,CMDEV!CM%NSF!CM%PO
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;ROUTINE TO GET DIRECTORY INFORMATION
;ACCEPTS IN A/ DIRECTORY NUMBER
; B/ POINTER TO PASSWORD STRING (GETDRP ONLY)
; C/ ADDRESS OF BLOCK INTO WHICH TO READ INFO
;RETURNS +1: FAILED
; +2: OK
GETDIR::MOVEI B,0 ;NO PASSWORD GIVEN
GETDRP::STKVAR <GACTPR,DNOO,DRADR,SAVPP,DRPASP>
MOVEM A,DNOO ;REMEMBER DIRECTORY NUMBER
MOVEM C,DRADR ;SAVE ADDRESS OF DIRECTORY BLOCK
MOVEM B,DRPASP ;SAVE THE POINTER TO THE PASSWORD STRING
MOVEI A,EXTSIZ ;ALLOCATE BLOCK FOR PASSWORD
CALL GETBUF
HRLI A,440700 ;MAKE BYTE POINTER
MOVEM A,SAVPP ;REMEMBER POINTER TO PASSWORD BLOCK
MOVE A,DRADR ;GET ADDRESS OF BLOCK
CALL DIRINI ;INIT GROUP POINTERS AND GROUP BUFFERS
MOVE A,DRADR ;GET ADDRESS OF GTDIR BLOCK
MOVE A,.CDDAC(A) ;GET POINTER TO ACCOUNT BEFORE GTDIR BLOODY DESTROYS IT
MOVEM A,GACTPR ;REMEMBER POINTER TO ACCOUNT
MOVE A,SAVPP ;COPY PASSWORD INTO BLOCK FOR DIRECTORY
MOVE B,DRPASP ;COPY FROM GIVEN PASSWORD (OR 0!)
MOVEI C,0 ;STOP COPYING ON NULL CHARACTER
SOUT ;COPY THE PASSWORD
MOVE A,DNOO ;GET DIRECTORY NUMBER
MOVE B,DRADR ;GET ADDRESS OF BLOCK
MOVEI C,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM C,.CDLEN(B) ;IN FIRST WORD OF BUFFER
MOVE C,SAVPP ;WHERE TO PUT PASSWORD (POINTER RETURNED IN BUFFER)
AOS .CDDRN(B) ;FOR REMOTE ALIAS BLOCK, FIRST WORD NOT USED
; BY GTDIR
SETZM .CDNLD(B) ;[4412] Zero this in case of an old monitor
SETZM .CDFPA(B) ;[4412] And this too
GTDIR ;GET ALL THE INFO INTO THAT BLOCK
ERJMP R ;IF FAILED, RETURN NO-SKIP
HLRZ A,@.CDDRN(B) ;GET USED COUNT FOR GTDIR BLOCK
SOS .CDDRN(B) ;REMOTE ALIAS BLOCK - RECOVER ENTIRE BLOCK
CAIG A,1 ;ANY ALIASES RETURNED ?
JRST GETDR1 ;NO.
MOVE A,.CDDRN(B) ;YES. MAKE FIRST WORD OF REMOTE ALIAS BLOCK
ADDI A,2 ; TO POINT
MOVEM A,@.CDDRN(B) ; TO ALIAS LIST.
GETDR1: MOVE A,GACTPR ;GET ORIGINAL ACCOUNT POINTER
MOVEM A,.CDDAC(B) ;MAKE POINTER TO BEGINNING OF ACCOUNT
RETSKP
;INITIALIZE BUFFER FOR GTDIR (ALSO FOR NEW DIR DEFAULTS)
;TAKES ADDRESS OF BLOCK IN A
;ALLOCATES AND INITIALIZES ALL THE SUBBLOCKS THAT GTDIR NEEDS (USER GROUPS,
;ACCOUNT, SUBDIRECTORY USER GROUPS ALLOWED)
DIRINI::STKVAR <BFA>
MOVEM A,BFA
SETZM (A)
HRL B,A
HRRI B,1(A)
BLT B,GTDLN-1(A)
MOVEI A,UGBUFL ;LENGTH OF USER GROUP BUFFER
CALL GETBUF ;GET SPACE FOR USER GROUPS
MOVE B,BFA ;GET ADDRESS OF DIR BLOCK
MOVEM A,.CDUGP(B) ;REMEMBER ADDRESS OF USER GROUP BUFFER
MOVEI B,UGBUFL ;LENGTH OF BUFFER
MOVEM B,(A)
MOVEI A,DGBUFL ;ALLOCATE DIRECTORY GROUP BUFFER IN SAME WAY
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDDGP(B)
MOVEI B,DGBUFL
MOVEM B,(A)
MOVEI A,SGBUFL ;GET BLOCK FOR ALLOWABLE USER GROUPS
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDCUG(B) ;STORE ADDRESS OF BLOCK FOR USER GROUPS
MOVEI B,SGBUFL
MOVEM B,(A) ;SET FIRST WORD OF SUBBLOCK TO COUNT
MOVEI A,EXTSIZ ;GET ROOM FOR ACCOUNT STRING
CALL GETBUF
MOVE B,BFA
HRLI A,440700 ;MAKE REAL BYTE POINTER TO ACCOUNT
MOVEM A,.CDDAC(B) ;STORE POINTER TO ACCOUNT BLOCK
SETZM (A) ;INITIALIZE ACCOUNT BUFFER
MOVEI A,RNAUFL ;GET BLOCK FOR
CALL GETBUF ; REMOTE ALIAS LIST
MOVE B,BFA ;STORE
MOVEM A,.CDDRN(B) ; IT
MOVEI B,RNAUFL-1 ;PUT LENGTH IN
MOVEM B,1(A) ; IN SECOND WORD OF REMOTE ALIAS BLOCK
SETZM (A) ;CLEAR FIRST WORD OF REMOTE ALIAS BLOCK
MOVEI A,GTDLN ;SET UP LENGTH OF BUFFER
MOVE B,BFA ; IN FIRST
MOVEM A,.CDLEN(B) ; WORD OF BUFFER
RET
;ROUTINE TO RELEASE FREE SPACE TAKEN UP BY A DIRECTORY BLOCK. THE ITEMS
;RELEASED ARE:
;
; o PASSWORD
; o USER GROUPS
; o DIRECTORY GROUPS
; o SUBDIRECTORY ALLOWABLE USER GROUPS
; o DEFAULT ACCOUNT STRING FOR LOGIN
; o BLOCK FOR REMOTE ALIASES
;
;ACCEPTS:
; A/ ADDRESS OF DIRECTORY BLOCK
;RETURNS:
; +1 YES
RELDIR::SAVEAC <Q2,Q1> ;USE AN AC SO INDEXING CAN BE DONE
MOVE Q1,A ;PRESERVE ADDRESS OF DIRECTORY BLOCK
HRRZ Q2,(Q1) ;GET LENGTH OF BLOCK
MOVEI A,EXTSIZ ;SIZE OF PASSWORD BLOCK
CAILE Q2,.CDPSW ;PASSWORD POINTER GIVEN?
SKIPN B,.CDPSW(Q1) ;MAYBE, IS THERE ONE THERE?
CAIA ;NO
CALL RETBUF ;YES, RELEASE SPACE USED BY PASSWORD
MOVEI A,UGBUFL ;SIZE OF USER GROUP BLOCK
CAILE Q2,.CDUGP ;USER GROUP POINTER THERE?
SKIPN B,.CDUGP(Q1) ;YES, IS IT VALID?
CAIA ;NO
CALL RETBUF ;YES, RELEASE GROUPS STORAGE
MOVEI A,DGBUFL ;LENGTH OF DIRECTORY GROUP BUFFER
CAILE Q2,.CDDGP ;RELEASE DIRECTORY GROUP BLOCK
SKIPN B,.CDDGP(Q1)
CAIA
CALL RETBUF
MOVEI A,SGBUFL ;SIZE OF SUBDIRECTORY USER GROUP BUFFER
CAILE Q2,.CDCUG ;DO SUBDIRECTORY USER GROUPS
SKIPN B,.CDCUG(Q1)
CAIA
CALL RETBUF
MOVEI A,EXTSIZ ;PREPARE TO RELEASE ACCOUNT STRING STORAGE
CAILE Q2,.CDDAC ;ACCOUNT POINTER?
SKIPN B,.CDDAC(Q1)
CAIA
CALL RETBUF ;REMOVE ACCOUNT STRING STORAGE
MOVEI A,RNAUFL ;PREPARE TO RELEASE REMOTE ALIAS STORAGE
CAILE Q2,.CDDRN ;REMOTE ALIAS
SKIPN B,.CDDRN(Q1) ; STORAGE ?
CAIA ;NONE PRESENT.
CALL RETBUF ;RELEASE STORAGE
RET
;DIRNAM
;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION.
;SKIP RETURNS WITH ENTIRE WORDS FROM RCDIR OR RCUSR IN A AND C ON SUCCESS.
; AND THE POINTER TO THE DIR/USER NAME STRING IN B.
;USED IN CONNECT, WHERE, ^EPRINT COMMANDS.
;PRESERVES Q1 (FOR DIRECTORY).
;CALL WITH F1 OFF FOR DEFAULTING TO LOGGED-IN USER NAME OR CURRENT
;CONNECTED DIRECTORY. CALL WITH F1 ON FOR NO DEFAULTING.
USRNMS::TLOA Z,F5 ;ALLOW WILDCARDING
USRNAM::TLZ Z,F5 ;NO WILDCARDING
STKVAR <<USRDEF,EXTSIZ>>
TLZ Z,F6 ;DO NOT RETURN IF AMBIGUOUS
TLZ Z,F4 ;NO DEFAULT
SKIPE CUSRNO ;NO DEFAULTING ALLOWED IF NOT LOGGED IN
TLNE Z,F1 ;DEFAULTING ALLOWED?
JRST NODDF1 ;NO
MOVEI A,USRDEF ;POINT AT TEMP STRING AREA
CALL DFUSER ;GET DEFAULT USER STRING
NODDF1: TLNE Z,F5 ;ALLOW WILDCARDS?
JRST [ USERSX <User name>
RET ;FAILED
JRST NODDF2]
USERX <User name>
RET ;SINGLE RETURN ON FAILURE
NODDF2: MOVE C,B ;RETURN USER NUMBER IN C
PUSH P,A ;SAVE A
CALL BUFFF ;COPY STRING FROM ATOM BUFFER
MOVE B,A ;RETURNS STRING POINTER IN B
POP P,A ;RESTORE A
RETSKP ;TAKE SKIP RETURN ON SUCCESS
;HERE TO PICK UP THE USERS NAME AND BUILD THE STRING.
;CALL WITH: A/ ADR TO PUT THE STRING
DFUSER::MOVE D,A ;SAVE POINTER
HRROI A,(D) ;GET ROOM FOR STRING
MOVEM A,CMDEF ;REMEMBER POINTER TO DEFAULT STRING
MOVNI A,1 ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVEI C,.JIUNO ;DEFAULT TO CURRENT USER
GETJI ;GET INTERNAL FORM OF DEFAULT
CALL JERR ;SHOULD NEVER FAIL
MOVE B,A ;PUT DEFAULT INTO B
MOVE A,CMDEF ;GET POINTER TO DEFAULT STRING AREA
DIRST ;MAKE DEFAULT STRING
JFCL
RET
CURNMS::TLO Z,F5!F4 ;ALLOW WILDCARDING, DEFAULTING ALLOWED
TLZ Z,F6
JRST DIRNA0
CURNAM::TLZ Z,F5!F6 ;DO NOT ALLOW WILDCARDING
TLO Z,F4 ;FLAG DEFAULT TO CONNECTED DIR
JRST DIRNA0
DIRNAM::TLZ Z,F4!F5!F6 ;NO WILDCARDING, NO RETN IF AMBIGUOUS, NO DEF'T
DIRNA0: STKVAR <<DIRDF,EXTSIZ>>
SKIPE CUSRNO ;NO DEFAULTING ALLOWED IF NOT LOGGED IN
TLNE Z,F1 ;DEFAULTING ALLOWED?
JRST NODDF ;NO
HRROI A,DIRDF ;GET BUFFER FOR DEFAULT
MOVEM A,CMDEF ;DEFAULT WANTED, SET UP POINTER
MOVNI A,1 ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVEI C,.JIDNO ;FIRST ASSUME DEFAULT TO CONNECTED DIRECTORY
TLNN Z,F4 ;DEFAULT TO LOGGED-IN?
MOVEI C,.JILNO ;YES, GET LOGGED-IN DIRECTORY NUMBER
GETJI ;GET INTERNAL FORM OF DEFAULT
CALL JERR ;SHOULD NEVER FAIL
MOVE B,A ;PUT DEFAULT INTO B
MOVE A,CMDEF ;GET POINTER TO DEFAULT STRING AREA
DIRST ;MAKE DEFAULT STRING
JFCL
NODDF: TLNE Z,F5 ;ALLOW WILDCARDING?
JRST [ DIRSX <Directory name>
RET ;FAILED
JRST DIRNA1] ;GOT ONE
DIRX <Directory name>
RET ;SINGLE RETURN ON FAILURE
DIRNA1: CALL BUFFF ;MAKE A COPY OF THE STRING
PUSH P,A ;SAVE THE POINTER TO THE STRING
MOVE B,A ;GET POINTER TO DIR NAME AGAIN
MOVX A,RC%EMO!RC%AWL ;EXACT MATCH AND ALLOW WILDCARDS
RCDIR ;GET INFO ON THIS DIRECTORY
ERJMP [POP P,(P)
RET] ;IF FAILS, NO SUCH DIR
POP P,B ;RETURN THE STRING POINTER IN B
TXNE A,RC%NOM!RC%AMB!RC%NMD
RET ;NONE FOUND
RETSKP ;TAKE SKIP RETURN ON SUCCESS
;ROUTINES TO STEP USER AND DIRECTORY NUMBERS WITH RCDIR
;ACCEPTS IN A/ DIR NUMBER
; B/ STRING POINTER TO WILDCARD STRING
; CALL STPDIR OR CALL STPUSR
;RETURNS +1: NO MORE
; +2: A/ NEW DIR NUMBER
STPDIR::SKIPA D,[RCDIR] ;STEP THE DIR NUMBER
STPUSR::MOVE D,[RCUSR] ;STEP THE USER NUMBER
STKVAR <STPSTP>
MOVEM B,STPSTP ;SAVE THE STRING POINTER
MOVE C,A ;GET DIR NUMBER INTO C
MOVX A,RC%AWL!RC%STP ;STEP THE DIR
XCT D
ERJMP R ;FAILED, NO MORE DIRS
TXNN A,RC%NMD ;ANY MORE DIR'S?
TXNE A,RC%NOM!RC%AMB ;FOUND ONE?
RET ;NO
MOVE A,C ;RETURN THE NEW NUMBER
RETSKP
;$GTFDB
;SUBROUTINE TO DO GTFDB JSYS AND SKIP UNLESS
;AN INSTRUCTION TRAP WITH "LIST ACCESS NOT ALLOWED"
;ERROR OCCURRED.
;USED IN DIRECTORY, UNDELETE, DSKSTAT, COPY/APPEND, LIST/TYPE.
;SHOULD BE IN SAME PAGE AS DSKDIR CAUSE ITS IN A LOOP THERE.
$GTFDB::GTFDB
ERJMP FDBILI
RETSKP
;TRAP OCCURRED, CHECK ERROR CODE
FDBILI: CALL %GETER ;GET ERROR CODE
PUSH P,A
HRRZ A,ERCOD
CAIE A,GFDBX3 ;"LIST ACCESS NOT ALLOWED"?
JRST [ POP P,(P)
JRST JERRE]
POP P,A
RET
;$CHFDB - AS ABOVE FOR CHFDB
$CHFDB::CHFDB
ERJMP CHFD1
RETSKP ;SUCCESSFUL RETURN
CHFD1: CALL %GETER
HRRZ A,ERCOD ;RETURN ERROR CODE ON FAILURE
RET
;OCTCOM INPUTS A 36-BIT OCTAL NUMBER IN EITHER OF TWO FORMATS. THE
;NUMBER MAY SIMPLY BE TYPED AS A LARGE OCTAL NUMBER, OR AS TWO SMALL
;NUMBERS SEPARATED BY ",,". IF THE FIRST NUMBER HAS MORE THAN 6
;SIGNIFICANT DIGITS, WE GIVE AN ERROR. ON CALL,
;A SHOULD CONTAIN THE POINTER TO THE HELP TEXT FOR THE FIELD, AND
;B SHOULD CONTAIN A POINTER TO THE HELP TEXT FOR THE NEXT FIELD. THIS
;IS NECESSARY BECAUSE AFTER THE FIRST NUMBER HAS BEEN READ, THE OPTIONS TO
;THE USER ARE ",," OR THE NEXT FIELD.
OCTCOM: STKVAR <HLP1,HLP2,OCTVL,<HLPTXT,40>>
MOVEM A,HLP1 ;SAVE THE HELP POINTERS
MOVEM B,HLP2
UOCT @HLP1 ;ASK FOR FIRST NUMBER WITH CALLER'S HELP
CMERRX
MOVEM B,OCTVL ;SAVE VALUE
CALL NESC ;TERMINATED WITH ESC?
JRST OCTDON ;YES--ASSUME DONE
TLC B,-1 ;ANY SIGNIFICANCE IN LH?
TLCE B,-1 ;SIGNIFICANCE IS OTHER THAN ALL 1S OR 0S
TLNN B,-1 ; TO ALLOW -M,,N
JRST OCTCO1 ;NO--TRY FOR A RIGHT HALF
JRST OCTDON ;YES--ASSUME NUMBER IS DONE
OCTCO1: HRROI A,HLPTXT ;BUILD COMBINED HELP MESSAGE
HRROI B,[ASCIZ /",," to separate left and right halves,
or /]
SETZ C,
SOUT ;COMBINE THEM
HRRO B,HLP2 ;TACK ON CALLER'S HELP TEXT
SOUT
SETZ B, ;TERMINATE IN ASCIZ FORMAT
IDPB B,A
MOVE A,[<ASCIZ /,/>+","];FAKE OUT CHARX
UCHAR HLPTXT ;LOOK FOR ",,"
JRST OCTDON
HRLZS OCTVL ;FIRST NUMBER WAS LEFT HALF
DEFX <0> ;DEFAULT RIGHT HALF TO 0
OCTX <Right half> ;ACCEPT RIGHT HALF OF NUMBER
CMERRX
TLC B,-1 ;ANY SIGNIFICANCE IN LH NOW IS AN ERROR
TLCE B,-1 ; BUT ALLOW M,,-N
TLNN B,-1
JRST OCTCO2 ;NO--STORE RESULT
ERROR <Right half exceeds 777777>
OCTCO2: HRRM B,OCTVL ;STORE REST OF NUMBER
OCTDON: MOVE A,OCTVL ;RETURN NUMBER TO USER
RET
;ROUTINE TO INPUT LIST OF OCTAL NUMBER RANGES IN THE FORM:
;N1,N2:N3,N4:N5,N6...
;"RLIST" STARTS WITH COUNT OF NUMBER OF NUMBERS, FOLLOWED BY THE
;NUMBERS THEMSELVES. NUMBERS ARE ALL TWO-WORD PAIRS SHOWING BEGINNING
;AND END OF RANGE. FOR INSTANCE, "N1,N2:N3,N4,N5:N6" WOULD GET
;STORED LIKE THIS:
;
; RLIST/ 8 ;8 NUMBERS ALTOGETHER (4 PAIRS)
; RLIST+1/N1
; RLIST+2/N1 ;NOTE THAT FIRST PAIR GOES FROM N1 TO N1!
; RLIST+3/N2
; RLIST+4/N3
; RLIST+5/N4
; RLIST+6/N4
; RLIST+7/N5
; RLIST+8/N6
;THIS ROUTINE RETURNS IF THE USER ENDS A RANGE WITH $. THIS IS NECESSARY
;TO ALLOW THE USER TO BE PROMPTED FOR THE NEXT FIELD.
OCTLST::SETZM RLIST ;START WITH 0 NUMBERS
OCTL2: OCTX <Octal number
or a pair of octal numbers seperated by a colon to specify a range
or octal number followed by a comma to specify additional numbers>
CMERRX ;AT LEAST ONE NUMBER MUST BE ENTERED
CALL NUMSTR ;STORE THE NUMBER IN THE LIST
CALL NESC ;SKIP IF ESCAPE DIDN'T TERMINATE NUMBER
JRST NUMREP ;IT DID, SO DON'T INPUT MORE
COLONX <Colon to specify a range
or comma to specify additional numbers
or next field of command>
CAIA ;NO COLON TYPED
JRST OCTL4 ;COLON TYPED, GO GET END OF RANGE
COMMAX <Comma to specify another number
or next field of command>
JRST NUMREP ;NO COMMA OR COLON AFTER NUMBER, MUST BE END OF LIST
CALL NUMREP ;REPEAT LAST NUMBER
JRST OCTL2 ;GO GET NEXT SET (REQUIRED BECAUSE WE SAW COMMA)
OCTL4: OCTX <Octal number for end of range>
CMERRX
CALL NUMSTR ;STORE END OF RANGE
CALL NESC ;DID NUMBER END WITH ESCAPE?
RET ;YES, SO GO ON TO NEXT FIELD OF COMMAND
COMMAX <Comma to specify another number
or next field of command>
RET ;NO COMMA AFTER RANGE, MUST BE END OF LIST
JRST OCTL2 ;COMMA, SO GET ANOTHER PAIR
;SINGLE NUMBER FOLLOWED BY NON-COMMA AND NON-COLON
NUMREP: MOVE D,RLIST ;TO REPEAT LAST NUMBER, GET END OF LIST
MOVE B,RLIST(D) ;GET LAST NUMBER, AND FALL INTO REGULAR NUMBER STORE ROUTINE...
NUMSTR: AOS D,RLIST ;INCREASE NUMBER OF NUMBERS
MOVEM B,RLIST(D) ;SAVE NUMBER
RET
;OUTPUT OCTAL NUMBER FROM B, NO LEADING ZEROES OR SPACES.
TOCT: PUSH P,A
PUSH P,C
MOVE A,COJFN ;DESTINATION
MOVE C,[1B0+10] ;"MAGNITUDE" FLAG AND RADIX
NOUT
CALL JERRC ;GENERAL JSYS ERROR, CODE IN C
MOVEM A,COJFN ;SAVE IN CASE BYTE POINTER
POP P,C
POP P,A
RET
;TYPE SYSTEM DOWN TIME IF SET
DWNTYP::GJINF
JUMPN A,R ;NO TYPE IF ALREADY LOGGED IN
DWNPNT::MOVEI D,0 ;GET ITEM 0 FROM DWNTIM TABLE
GTB .DWNTI
JUMPE A,R ;DO NOTHING IF NOT SET
CAMN A,[-1] ;IS SYSTEM SHUT DOWN?
JRST [ETYPE < System is shut down>
JRST DWNTY2]
ETYPE < System shutdown scheduled for %1W>
DWNTY2: MOVEI D,1 ;GET ITEM 1
GTB .DWNTI
JUMPE A,DWNTY1 ;JUMP IF UPTIME NOT SET
ETYPE <,
Up again at %1W>
DWNTY1: ETYPE<%_>
RET
;ROUTINE THAT TAKES SIXBIT IN A AND RETURNS A POINTER TO ASCII STRING
GETASC::STKVAR <REMSIX,ASCPR>
MOVEM A,REMSIX ;REMEMBER THE SIXBIT
MOVEI A,2 ;NEED TWO WORDS FOR ASCII
CALL GETBUF
HRLI A,440700 ;MAKE BYTE POINTER TO ASCII
MOVEM A,ASCPR ;REMEMBER POINTER TO ASCII
HRRI B,REMSIX
HRLI B,440600 ;GET SIXBIT POINTER
MOVEI D,0 ;NULL FOR CLEARING PROCESSED CHARACTERS
ASC1: SKIPN REMSIX ;ANY MORE LEFT?
JRST ASC2 ;NO
ILDB C,B ;YES, PICK UP NEXT CHARACTER
ADDI C,40 ;CHANGE TO ASCII
IDPB C,A ;STORE ASCII CHARACTER
DPB D,B ;CLEAR CHARACTER SO WE'LL KNOW WHEN WE'VE HIT END
TLNE B,770000 ;DONE SIX CHARACTERS?
JRST ASC1 ;NO, MIGHT BE MORE
ASC2: MOVEI C,0 ;GUARANTEE NULL AT END
IDPB C,A
MOVE A,ASCPR ;GET POINTER TO ASCII
RET ;RETURN POINTER
;ROUTINE TO RETURN SIXBIT VERSION OF LATEST FIELD IN A.
;[4402] Add entry to allow non-alphanumeric characters
GETSXF::TDZA Q2,Q2 ;[4402] Say "allow funny characters"
GETSXB::SETO Q2, ;[4405] No funny chars allowed
HRROI A,ATMBUF ;POINT AT WHAT USER TYPED
CALL GETSIX ;GET SIXBIT VERSION
ERROR <Name too long or contains invalid character>
RET
;ROUTINE TO YIELD SIXBIT DATA FROM THE ASCII STRING POINTED TO BY
;POINTER IN A. SKIP RETURNS, UNLESS ILLEGAL SIXBIT CHARACTER ENCOUNTERED,
;OR STRING MORE THAN SIX CHARACTERS, IN WHICH CASE A WILL CONTAIN
;SIXBIT THROUGH THE LAST GOOD CHARACTER
GETSIX::STKVAR <ASPTR,SIXPTR>
CALL FIXPT ;FIX POINTER
MOVEM A,ASPTR ;REMEMBER ASCII POINTER
MOVE A,[440600,,A] ;POINTER TO SIXBIT RESULT
MOVEM A,SIXPTR
MOVEI A,0 ;START WITH NULL RESULT
MOVSI B,-6 ;DO SIX CHARS MAXIMUM
GETSX1: ILDB C,ASPTR ;GET NEXT ASCII CHARACTER
JUMPE C,RSKP ;DONE IF NULL
CAIN C,"" ;THE QUOTING CHARACTER?
JRST [ ILDB C,ASPTR ;YES, ALLOW NEXT CHARACTER REGARDLESS
JRST .+1]
CAIL C,141 ;CHANGE LOWERCASE LETTERS TO UPPERCASE
CAILE C,172
CAIA ;NOT LOWERCASE
TRZ C,40 ;LOWERCASE, CHANGE IT
SUBI C,40 ;CHANGE TO SIXBIT
SKIPE Q2 ;[4402] Skip if allowing funny characters
JUMPL C,R ;IF ILLEGAL CHARACTER, GIVE NON-SKIP
IDPB C,SIXPTR ;STORE IN SIXBIT RESULT IN A
AOBJN B,GETSX1 ;ONLY DO SIX CHARACTERS
ILDB C,ASPTR ;GET CHARACTER AFTER SIXTH
JUMPE C,RSKP ;IF NULL, STRING ENDED "JUST IN THE NICK OF TIME"
RET ;NON-SKIP IF STRING TOO LONG
;ROUTINE TO CHANGE -1,,FOO TO 440700,,FOO
FIXPT:: TLC A,-1 ;IF WAS -1, IS NOW 0 (IF OTHER, IS NOW OTHER')
TLCN A,-1 ;SKIP AND RESTORE IF WASN'T -1
HRLI A,440700 ;CHANGE TO 440700 IF WAS -1
RET
;BUFFF
;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND
; RETURN A BYTE PTR TO IT IN A.
;COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END.
BUFFF: PUSH P,B
PUSH P,C
PUSH P,D
MOVE A,[POINT 7,ATMBUF] ;POINT TO THE FIELD
CALL BUFFS ;BUFFER THE STRING
POP P,D
POP P,C
POP P,B
RET
;ROUTINES TO BUFFER A STRING. GIVE IT POINTER TO STRING IN A.
;ROUTINE RETURNS POINTER TO BUFFERED STRING IN A.
;THE STRING ALWAYS BEGINS ON A WORD BOUNDARY. (SOME CALLERS ASSUME SO!)
;XBUFFS USES PERMANENT STORAGE, BUFFS USES TEMPORARY STORAGE
XBUFFS::SKIPA B,[XDICT] ;SPECIFY PERMANENT FREE POOL
BUFFS:: MOVEI B,DICT ;TEMPORARY POOL
CALL READNM ;COPY STRING INTO FREE SPACE
ERROR <String space exhausted>
RET
;ROUTINE TAKING A STRING POINTER IN A. IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A. IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
;GIVE IT FREE POOL HEADER ADDRESS IN B
READNM: STKVAR <FPA,RPTR,NEWPTR>
MOVEM A,RPTR ;REMEMBER POINTER
MOVEM B,FPA ;REMEMBER FREE POOL ADDRESS
CALL BCOUNT ;HOW MANY WORDS IN THIS STRING?
MOVE B,FPA ;SAY WHICH FREE POOL TO USE
CALL GETMEM ;GET THAT MANY
RET ;COULDN'T, SO TAKE NON-SKIP RETURN
HRLI B,440700 ;MAKE BYTE POINTER TO SPACE OBTAINED
MOVEM B,NEWPTR ;REMEMBER NEW POINTER
MOVE A,RPTR ;GET POINTER TO STRING
CALL FIXPT ;FIX SOURCE POINTER IF NEEDED
EXCH A,B ;PUT DEST IN A, SOURCE IN B
MOVEI C,0 ;STORE NULL AT END OF STRING
CALL ASOUT ;COPY THE STRING
MOVE A,NEWPTR ;GET ADDRESS WHERE STRING GOT PUT
RETSKP ;SUCCESFUL RETURN
;ARTIFICIAL SOUT ROUTINE FOR OUTPUTTING STRINGS TO MEMORY
;(SAVES HUNDREDS OF INSTRUCTIONS OVER THE JSYS)
;CALL (LIKE SOUT) WITH:
; A/ POINTER TO TARGET STRING (NO HRROI'S ALLOWED)
; B/ POINTER TO SOURCE STRING
; C/ 0==STOP ON NULL; <0==DO -(C) CHARACTERS
;RETURNS UPDATED POINTERS AND C/ 0
ASOUT:: JUMPL C,ASOUTC ;JUMP TO DO A GIVEN NUMBER OF CHARACTERS
ASOUT1: ILDB C,B ;ELSE GET A CHARACTER
JUMPE C,ASOUTX ;DONE IF NULL
IDPB C,A ;ELSE SAVE IT
JRST ASOUT1 ;AND LOOP
ASOUTC: PUSH P,D ;SAVE A WORK AC
ASOUTD: ILDB D,B ;[3019]GET A CHARACTER
IDPB D,A ;SAVE IT
AOJL C,ASOUTD ;[3019]LOOP UNTIL COUNTED OUT
CAIA ;THEN SKIP THE AV SAVE
ASOUTX: PUSH P,D ;SAVE A WORK AC
MOVE D,A ;GET A FRAGGABLE TARGET POINTER
IDPB C,D ;END THE STRING WITH A NULL
POP P,D ;RESTORE THE SCRATCH AC
RET ;DONE
;ROUTINE TO GET MEMORY BLOCK. RETURNS +1 ALWAYS WITH ADDRESS OF BLOCK
;IN A. GIVE IT NUMBER OF WORDS DESIRED IN A.
GTBUFX::SKIPA B,[XDICT] ;PERMANENT STORAGE
GETBUF::MOVEI B,DICT ;USE TEMPORARY POOL
CALL GETMEM ;GET THE MEMORY
ERROR <Exec free space exhausted>
MOVE A,B ;RETURN ADDRESS IN A
RET
;GETMEM - ROUTINE TO ASSIGN MEMORY AS REQUESTED
;INPUTS: A - CONTAINS NUMBER OF WORDS WANTED
; B - FREE SPACE HEADER ADDRESS
;OUTPUTS: A - NUMBER OF WORDS OBTAINED
; B - CONTAINS ADDRESS OF WORDS GOTTEN
;RETURNS: SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM
GETMEM::STKVAR <<SAVSTF,2>,DADR>
MOVEM B,DADR ;REMEMBER HEADER ADDRESS
GETM2: MOVE C,B ;REMEMBER WHO POINTS TO CURRENT
HRRZ B,0(C) ;B IS NOW CURRENT BLOCK
JUMPE B,R ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ D,0(B) ;GET SIZE OF CURRENT BLOCK
CAMGE D,A ;IS IT SUFFICIENT FOR REQUEST?
JRST GETM2 ;NO, SO TRY NEXT BLOCK
GETM3: CALL PIOFF ;TURN OFF CONTROL-C INTERRUPTS
HRL B,0(B) ;GET LINK OF CURRENT BLOCK
HLRM B,0(C) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZS B ;ISOLATE CURRENT BLOCKS ADDRESS
CAMN D,A ;IS THIS AN EXACT MATCH ON SIZE?
JRST GETRSK ;SUCCESS, SKIP RETURN
DMOVEM A,SAVSTF ;SAVE NUMBER OF WORDS AND ADDRESS
ADD B,A ;GET FIRST WORD TO RETURN
SUBM D,A ;NUMBER OF WORDS TO RETURN
MOVE C,DADR ;GET ADDRESS OF CONTROL WORD
CALL RETMEM ;RETURN THE EXTRA WORDS
DMOVE A,SAVSTF ;RESTORE NUMBER OF WORDS AND ADDRESS
GETRSK: CALL PION ;TURN CONTROL-C INTERRUPTS BACK ON
RETSKP ;SUCCESS, SKIP RETURN
;STREM ROUTINE TAKES POINTER TO STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE. THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE
STREM:: ATSAVE ;NEED TO BE TRANSPARENT
STKVAR <SPT000>
MOVEM A,SPT000 ;REMEMBER POINTER
CALL BCOUNT ;COUNT NUMBER OF WORDS IN THE STRING
HRRZ B,SPT000 ;GET RID OF BYTE POINTER P AND S
CALLRET RETBUF ;RETURN THE BUFFER
;RETBUF RETURNS A BUFFER TO FREE STORAGE
; A/ SIZE BEING RETURNED
; B/ ADDRESS OF BLOCK BEING RETURNED
RETBUF::MOVEI C,DICT ;FIRST ASSUME TEMPORARY FREE SPACE
CAIL B,XFREE ;MAYBE ADDRESS IS IN PERMANENT FREE SPACE
CAIL B,XFREE+XFRESZ
JRST RETMEM
MOVEI C,XDICT ;YES
; CALLRET RETMEM ;RETURN THE SPACE TO THE FREE POOL
;RETMEM - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
;INPUT: A - CONTAINS SIZE OF BLOCK TO RETURN
; B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
; C - FREE SPACE HEADER ADDRESS
;OUTPUT: NONE
;RETURNS: ALWAYS CPOPJ
RETMEM::HRRZ D,0(C) ;GET PREV'S LINK
SKIPE D ;IF CURRENT IS 0 OR
CAIL D,0(B) ; ITS ADDRESS IS PAST ADDR OF RETURN BLK
JRST RETM4 ;THEN RETURN BLOCK HERE
MOVE C,D ;MAKE PREV=CURRENT
JRST RETMEM ;CONTINUE
RETM4: CALL PIOFF ;TURN OFF CONTROL-C INTERRUPTS
HRRM D,0(B) ;FORWARD PTR OF RETURNED BLOCK
HRRM B,0(C) ;FORWARD PTR OF PREV BLOCK
HRLM A,0(B) ;STORE SIZE OF THIS BLOCK
ADD A,B ;ADD ADDR+SIZE
CAIE A,0(D) ;ARE WE RIGHT UP AGAINST NEXT BLOCK?
JRST RETM5 ;NO, CANT COMBINE
HRRZ A,0(D) ;GET NEXT GUYS FORWARD LINK
HRRM A,0(B) ;MAKE IT OURS. IE POINT PAST HIM
HLRZ A,0(B) ;GET OUR SIZE
HLRZ D,0(D) ;GET HIS SIZE
ADD A,D ;GET OUR NEW COMBINED SIZE
HRLM A,0(B) ;STORE INTO RETURNED BLOCK
HRRZ D,0(B) ;GET LINK OF CURRENT BLOCK
RETM5: HLRZ A,0(C) ;GET PREV BLOCKS SIZE
ADDI A,0(C) ;ADD HIS ADDRESS AND SIZE
CAIE A,0(B) ;DOES HE BUTT RIGHT UP AGAINST US?
CALLRET PION ;NO, RETURN WITH NO COMBINATION
HRRM D,0(C) ;MAKE PREV POINT TO OUR NEXT
HLRZ A,0(C) ;GET HIS SIZE
HLRZ B,0(B) ;AND OUR SIZE
ADD A,B ;COMBINE THE SIZES
HRLM A,0(C) ;STORE COMBINED SIZE
CALLRET PION ;RETURN
;ROUTINE TO INITIALIZE FREE SPACE STORAGE. DONE BEFORE EACH COMMAND IS
;EXECUTED.
FREINI::SETZM DICT ;INITIALIZE FREE SPACE SYSTEM
MOVEI A,FRESIZ ;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
MOVEI B,FREE ;STARTS AT ADDRESS IN B
CALL RETBUF ;FREE IT UP IN STANDARD WAY
MOVEI A,STRSIZ ;ALLOCATE SOME SPACE FOR STRINGS
CALL GETBUF
HRLI A,440700 ;MAKE POINTER TO STRING STORAGE
MOVEM A,CSBUFP ;REMEMBER POINTER TO STRING STORAGE
RET
;ROUTINE TO INITIALIZE PERMANENT FREE SPACE. THIS IS DONE ONCE PER RUNNING
;OF THE EXEC
XFRINI::SETZM XDICT
HRROI A,-1 ;RELEASE PERMANENT FREE SPACE
MOVE B,[.FHSLF,,XFREPN] ;TO GUARANTEE THAT RETBUF CAN WRITE INTO IT
MOVX C,PM%CNT!XFREPZ ;(IF SYMBOL TABLE WAS MAPPED, RETBUF COULD FAIL)
PMAP
MOVEI A,XFRESZ
MOVEI B,XFREE
CALLRET RETBUF ;RETURN ALL PERMANENT FREE SPACE TO POOL
;BCOUNT MEASURES AN ASCIZ STRING.
;
;ACCEPTS: A/ POINTER (-1,,FOO O.K.!)
;
;RETURNS+1: A/ NUMBER OF WORDS NEEDED IN A
; B/ NUMBER OF CHARACTERS
BCOUNT::CALL FIXPT ;CHANGE -1 TO 440700
MOVEI B,0 ;B WILL ACCUMULATE COUNT OF BYTES
BC1: ILDB C,A ;READ NEXT BYTE
CAIE C,0 ;DONE COUNTING IF NULL SEEN
AOJA B,BC1 ;NOT DONE, KEEP COUNTING
MOVE D,B ;REMEMBER EXACT COUNT IN D
AOJ B, ;LEAVE ROOM FOR NULL
IDIVI B,5 ;GET NUMBER OF WORDS
CAIE C,0 ;EXTRA CHARACTERS?
AOJ B, ;YES, THEY TAKE A WHOLE WORD
MOVE A,B
MOVE B,D ;RETURN BYTE COUNT IN B
RET
;ROUTINE TO RETURN HOST'S NODE NAME. RETURNS A POINTER TO IT IN A.
;THIS RETURN SKIPS IFF SUCCESSFUL
GETNOD::MOVEI A,.NDGLN ;SAY WE WANT HOST'S NODE NAME
MOVEI B,CSBUFP ;USE POINTER TO STRING SPACE TO WRITE THE NAME
MOVE C,CSBUFP ;REMEMBER POINTER TO NAME
NODE ;GET THE NAME
ERJMP R ;FAILED, GIVE SINGLE RETURN
MOVE A,C ;GET POINTER TO NAME
CALL BUFFS ;BUFFER THE NAME AND RETURN
RETSKP
;SUBROUTINE TO TURN OFF ECHOING BEFORE PASSWORD INPUT
NOECHO: PUSH P,C
TXO Z,NECHOF ;SAY ECHOING OFF (TESTED IN %NOI)
MOVEI C,0 ;SAY NO ECHOING NOHOW
JRST ECHOST ;JOIN "DOECHO"
;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT
DOECHO::TXNN Z,NECHOF ;WAS ECHOING OFF?
RET ;NO, SO NOTHING TO DO
PUSH P,C
MOVEI C,2 ;SAY IMMEDIATE OR DEFERRED ECHOING
ECHOST: PUSH P,A ;ENTRY TO SET ECHO BITS FROM C
PUSH P,B
MOVE A,CIJFN
RFMOD ;READ TELETYPE MODE WORD
DPB C,[POINT 2,B,25]
SFMOD ;SET TTY MODE WORD
CAIN C,2 ;ECHOING NOW ON?
TXZ Z,NECHOF ;SAY ECHOING NOT SUPPRESSED
POP P,B
POP P,A
POP P,C
RET
;LTTYMD - LOAD TELETYPE MODES
;AC Q1 POINTS TO 11-WORD BLOCK OF VALUES TO PUT INTO EFFECT:
;SEE EXECDE FOR STRUCTURE OF BLOCK
UTTYMD::PUSH P,A ;SAVE REG
SKIPLE A,FORK ;USER CURRENT FORK
CALL FTTYMD ;IF VALID
POP P,A ;RESTORE REG
RET ;RETURN
FTTYMD::SKIPN Q1,SLFTAB(A) ;SET UP MODE BLOCK PNTR
RET
MOVEI Q1,.FKPTM(Q1) ;ADDRS OF FORK'S MODE BLOCK
LTTYMD: SKIPN (Q1) ;DO NOTHING IF BLOCK IS 0 DUE TO A BUG OR
RET ;A STRANGE INTERRUPT-RESTART SEQUENCE
ATSAVE
MOVEI A,.CTTRM
MOVE B,TTWMOD(Q1) ;FILE MODE WORD
TXZ B,TT%OSP ;ENSURE NO OUTPUT SUPPRESS
SFMOD
GJINF ;GET JOB INFO
JUMPL D,NOTTY1 ;SEE IF WE ARE DETACHED
MOVEI A,.CTTRM ;HAVE TERMINAL, USE CONTROLLING TTY
DVCHR ;MTOPR WORKS ON TTY ONLY
LDB B,[POINTR B,DV%TYP] ;GET DEVICE TYPE CODE
CAIE B,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY1 ;NO - NOT A TTY
MOVEI A,.CTTRM ;NOW RESTORE THE MASK
MOVEI B,.MOSBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY1 ;ERROR MEANS WRONG MONITOR
MOVEI B,.MOSFW ;NOW FOR THE FIELD WIDTH
MOVE C,TTWFWT(Q1)
MTOPR
MOVEI A,.CTTRM
NOTTY1: MOVE B,TTWCOC(Q1) ;2 CCOC WORDS
MOVE C,TTWCOC+1(Q1)
SFCOC
MOVEI A,.FHSLF
RPCAP
TXON C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
JRST [ TXNN B,SC%CTC ;^C NOT ENABLED. ENABLABLE?
JRST NOSTIW ;NO, DON'T TRY THE STIW
EPCAP ;ENABLABLE, SO DO IT
JRST .+1] ;NOTE: LOGIN JSYS CLEARS AC3 CAPABILITIES!
MOVEI A,.FHJOB
MOVE B,TTWJTI(Q1) ;SET JOB TIW
STIW
NOSTIW: MOVE A,TTWSNM(Q1) ;GET SUBSYS NAME
MOVE B,TTWPNM(Q1) ;GET PROGRAM NAME
SETSN ;SET THEM
CALL JERR
RET
;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC
; INTO 6-WORD BLOCK THAT AC Q1 POINTS TO.
RFTYMD::SKIPN Q1,SLFTAB(A) ;SET UP MODE BLOCK PNTR
RET
MOVEI Q1,.FKPTM(Q1) ;MODES FOR FORK
RTTYMD: ATSAVE
MOVEI A,.CTTRM
RFMOD
MOVEM B,TTWMOD(Q1)
GJINF ;GET JOB INFO
JUMPL D,NOTTY2 ;SEE IF WE ARE DETACHED
MOVEI A,.CTTRM ;HAVE TERMINAL, USE CONTROLLING TTY
DVCHR ;MTOPR WORKS ON TTY ONLY
LDB B,[POINTR B,DV%TYP] ;GET DEVICE TYPE CODE
CAIE B,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY2 ;NO - NOT A TTY
MOVEI A,4 ;PUT LENGTH INTO BLOCK
MOVEM A,TTWMSK(Q1)
MOVEI A,.CTTRM ;NOW SAVE THE MASK
MOVEI B,.MORBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY2 ;ERROR MEANS WRONG MONITOR
MOVEI B,.MORFW ;NOW FOR THE FIELD WIDTH
MTOPR
MOVEM C,TTWFWT(Q1)
MOVEI B,.MOSFW
SETZ C, ;TURN OFF FIELD WIDTH
MTOPR
NOTTY2: MOVEI A,.CTTRM
RFCOC
MOVEM B,TTWCOC(Q1)
MOVEM C,TTWCOC+1(Q1)
MOVEI A,.FHJOB
RTIW
MOVEM B,TTWJTI(Q1)
SETO A, ;SAY THIS JOB
MOVE B,[-2,,C] ;SAY 2 WORDS INTO C AND D
MOVEI C,.JISNM ;STARTING WITH SUBSYS NAME
GETJI ;GET SUBSYS AND PROGRAM NAME
CALL JERR
MOVEM C,TTWSNM(Q1) ;SAVE THEM
MOVEM D,TTWPNM(Q1)
RET
;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS
;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT.
;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE;
;TO CHANGE IT USER MUST: A) USE A PROGRAM, SUCH AS DDT, OR B) TEMP SET
; OUTFILE=INFILE (IF PSEUDO-ECHOING DOESN'T INTERFERE). 4/22/70.
;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS
%PRINT: PUSH P,A
PUSH P,B
AOS TTYACF ;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE
MOVE A,COJFN
HRRZ B,40
BOUT
MOVEM A,COJFN ;IN CASE IT'S A BYTE POINTER
AOS TTYACF ;AGAIN IN CASE BLOCKED DUE TO FULL BUFFER
POP P,B
POP P,A
RET
;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?)
COUTC:: PUSH P,A
MOVE A,COJFN ;GET OUTPUT STREAM
TLNE A,-1 ;BYTE POINTER?
JRST [ IDPB B,COJFN ;YES, SAVE TIME TO OPTIMIZE ETYPE
JRST COUTC1]
AOS TTYACF ;TELL AUTOLOGOUT THAT THERE'S BEEN TTY ACTIVITY
BOUT ;MONITOR CALL TO OUTPUT CHARACTER
AOS TTYACF
COUTC1: POP P,A
RET
;TBOUT, TSOUT0 -- USED INSTEAD OF BOUT AND SOUT WHERE TEXT
;MAY CONTAIN EOL'S.
TBOUT:: BOUT ;(ACH - SOMEBODY WANT TO TELL ME WHY THIS
RET ; IS BETTER THAN A BOUT IN THE CODE?)
;SOUT WHERE C=0, I.E. TERMINATE ON NULL
TSOUT0::PUSH P,C
SETZ C,
SOUT
POP P,C
RET
REPEAT 0,<
TSOUT0::PUSH P,C ;SAVE AN AC
MOVE C,B ;PUT THE POINTER IN THAT AC
TLC C,-1 ;CHANGE -1 LEFT HALF TO A POINTER
TLCN C,-1
HRLI C,440700
TSOUT1: ILDB B,C ;GET THE NEXT CHARACTER
JUMPE B,TSOUTE ;NULL TERMINATES, RESTORE UPDATED PTR
BOUT ;ELSE OUTPUT THE CHARACTER AND LOOP
JRST TSOUT1
TSOUTE: MOVE B,C
POP P,C
RET
>
;RANDOM reads a word from the current fork.
;
;Accepts: A/ address to read
;
;Returns+1: Nonexistent or unreadable
; +2: A/ contents
RANDOM::STKVAR <WAA>
MOVEM A,WAA ;REMEMBER ADDRESS
CALL MAPPF ;MAP IN THE PAGE
RET ;FAILED, SAY SO.
LDB A,[001100,,WAA] ;GET OFFSET INTO BUFFER
MOVE A,PAGEN(A) ;GET THE DATA
ERJMP R ;IF CAN'T, GIVE FAILURE RETURN
RETSKP ;GIVE SUCCESS RETURN WITH DATA IN A
;MAP A PAGE OF A FORK
;Accepts in A: A 30-bit address in the fork, or -1 to clear the buffer
; FORK: Fork handle
;Returns:
; +1: Cannot map process (last error says why)
; +2: Success,
; A: Untouched
; B: Access and existence bits (from RPACS), unless A had -1
; PAGEN: The page mapped
MAPPF: PUSH P,C
PUSH P,A
JUMPL A,MPPF1
SKIPL FORK ;IS THERE A CURRENT FORK?
IFSKP.
MOVEI A,.FHSLF ;NO - SET AN ERROR FOR OUR FORK
MOVEI B,ILLX04 ;REFERENCE TO NON-EXISTENT PAGE
SETER ;SET THE ERROR
ERJMP .+1 ;IGNORE THE ERROR
JRST MAPPFF ;GO RETURN THE ERROR
ENDIF.
TDNN A,[777776,,777760] ;SECTION 0 OR 1, ADDRS 0-17 ARE ACS
JRST MAPACS
LSH A,-^D9 ;SEPARATE PAGE #
HRL A,FORK ;FORK HANDLE OF PAGE WE WANT
TLO A,(1B0) ;SAY FORK HANDLE NOT JFN
MPPF1: MOVEI B,PAGEN ;GENERATE DESTINATION PAGE IDENTIFIER
LSH B,-^D9 ;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL
TLO B,(1B0) ;...SAY THIS FORK
MOVX C,PM%RD!PM%WR!PM%EX ;REQUEST ALL ACCESS, NORMAL DISPOSAL
CAME A,NPAGE ;SAVE TIME IF ALREADY MAPPED
PMAP ;MAP IT
ERJMP NOX ;CAN'T MAP-- JUST SAY DOESN'T EXIST
MOVEM A,NPAGE ;SAY IT'S MAPPED
CAMN A,[-1]
JRST MPPF8
RPACS ;GET ACCESS/EXISTENCE OF MAPPED PAGE
ERJMP NOX1 ;SECTION CONTAINING PAGE DOESN'T EXIST
JUMPN B,MPPF8 ;ANY BITS?
TXO B,PA%WT ;NO - SET WRITE ACCESS (NEW PAGE)
JRST MPPF8 ;RESTORE AND RETURN +2
;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS".
;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION.
MAPACS: SETO A,
CALL MAPPF ;UNMAP PAGE IN BUFFER, IF ANY.
JFCL ;UNMAP SHOULDN'T FAIL
MOVE A,FORK
MOVEI B,PAGEN
RFACS ;READ FORK ACS INTO "PAGEN"
ERJMP MAPPFF ;FAILED-- RESTORE ACS AND RETURN +1
MOVX B,PM%RD!PM%WR!PM%EX!PM%PLD ;REQUEST ALL ACCESS, NORMAL DISPOSAL
SKIPA ;SKIP NOX
NOX1: SETZ B, ;SECTION CONTAINING PAGE DOESN'T EXIST
MPPF8: POP P,A ;RH A TRANSPARENT
POP P,C
RETSKP ;RETURN +2 SUCCESS FROM MAPPF
NOX: SETZ B, ;SECTION CONTAINING PAGE DOESN'T EXIST
MAPPFF: POP P,A ;RESTORE ALL
POP P,C ;. . .
RET ;AND RETURN +1 FROM MAPPF
;LOAD SINGLE WORD FROM FORK, GIVEN ADDRESS IN A
LOADF: CALL MAPPF
RET ;FAILED-- RETURN +1
TXNN B,PA%PEX
ERROR <No such page>
TXNN B,PA%RD
ERROR <Can't read that page>
ANDI A,777
MOVE A,PAGEN(A)
RETSKP ;RETURN +2 FROM LOADF
;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A
STOREF: PUSH P,B ;SAVE WORD TO STORE OVER MAPPF
CALL MAPPF
JRST [ POP P,B
RET] ;FAILED-- RETURN +1
TXNE B,PA%PEX ;OK TO STORE IF PAGE NON-EXISTENT
TXNE B,PA%WT!PA%CPY ;OR IF WRITE ACCESS OR COPY ON WRITE PERMITTED
CAIA
ERROR <Can't write into page>
ANDI A,777
POP P,B ;GET BACK VALUE TO STORE
MOVEM B,PAGEN(A)
RETSKP
;%GTB
;SUBROUTINE TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN AC A, INDEX IN RH OF D, RETURN +1 WITH WORD IN A.
;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
; FOR USE IN OTHER JSYS CALLS INSIDE LOOP.
%GTB: HRL A,D ;PUT THE INDEX IN WITH THE TABLE NUMBER
GETAB ;AS FOR THE VALUE
SETZ A, ;ERROR - RETURN ZERO AS THE VALUE
RET
;ERROR, PSEUDO-INTERRUPT, %-MESSAGE-TYPING STUFF
;PSI ROUTINE FOR TERMINAL CHARACTER THAT PRINTS RUNTIME (^T)
USEPSI: CALL SAVACS ;DON'T CLOBBER ANY AC'S (LIKE 16!)
CALL USEX ;DO THE WORK
CALL RESACS ;RESTORE AC'S
DEBRK ;DISMISS THE INTERRUPT
USEX:
STKVAR <CIJFN0,COJFN0,SAV40,SVHNDL>
MOVE A,CIJFN
MOVE B,COJFN
MOVEM A,CIJFN0 ;SAVE POSSIBLE DIVERTED OUTPUT
MOVEM B,COJFN0
MOVE A,40
MOVEM A,SAV40 ;POSSIBLE UUO IN PROGRESS
MOVEI A,.PRIOU ;ALWAYS DISPLAY OUTPUT TO PRIMARY,
MOVEM A,COJFN ;SINCE THAT'S WHERE ^T WAS TYPED FROM.
ETYPE < %A> ;START WITH CURRENT TIME
SKIPL PCCIPF ;[PCL] PCL command in progress or
SKIPE CIPF ;COMMAND IN PROGRESS?
JRST USEPS9 ;YES, DIFFERENT MESSAGE
SKIPLE EFORK ;EPHERMERAL?
JRST [ GETNM ;YES - GET NAME
ETYPE < %1' (;E)>
MOVE A,EFORK ;TELL USER ^T IN EPHERMERAL
JRST USEPS0]
SKIPGE A,FORK
JRST USEPS2 ;NO INFERIOR
SKIPN B,SLFTAB(A) ;LOAD B WITH FORK TABLE INDEX
JRST USEPS0 ;IF 0, WE DON'T KNOW THIS PROGRAM
GETNM
CAMN A,['EXEC '] ;IS CURRENT PROG NAME EXEC?
JRST [ SKIPE B,.FKPTM+TTWPNM(B) ;YES, GET NAME FROM TABLE
MOVE A,B ;IF NON-NULL, USE IT
JRST .+1 ]
ETYPE < %1'> ;NO, JUST TYPE WHAT GETNM FOUND
MOVE A,FORK
USEPS0: TYPE < > ;SEPARATE NAME AND STATUS
CALL FSTAT ;PRINT STATUS & PC OF INFERIOR (HANDLE IN A)
PRINT " " ;FSTAT IS IN EXECIN.MAC
USEPS2: HRROI A,-1 ;GET LOAD AVERAGES FOR CURRENT JOB
CALL GLOADS ;GET LOAD AVERAGES
ETYPE < Used %V in %C, Load %2Q>
CALL USEPSM ;IF MIC EXISTS, SAY A DO IS PROGRESS (EXECCA)
USEOU1: TYPE <
>
MOVE A,SAV40
MOVEM A,40
MOVE A,CIJFN0
MOVEM A,CIJFN
MOVE B,COJFN0
MOVEM B,COJFN ;RESTORE POSSIBLE BUFFERED OUTPUT
RET
;IF ^T DURING COMMAND EXECUTION, TELL USER WHAT COMMAND IS BEING
;EXECUTED.
USEPS9: MOVE B,COMAND ;GET POINTER TO COMMAND
SKIPE PCCURC ;PCL During PCL execution?
JRST [ SKIPN B ;PCL Yes, is the command name gone?
HRROI B,[ASCIZ/Stored/] ;PCL Yes, use generic name
JRST .+1] ;PCL
ETYPE < %2M command >
SKIPN DBGEXC ;DEBUGGING THE EXEC ?
IFSKP.
MOVEI A,.FHSLF ;YES - GET OUR FORK HANDLE
EXCH A,FORK ;UPDATE FORK
MOVEM A,SVHNDL ;SAVE THE FORK HANDLE
MOVE A,LEV3PC ;GET OUR INTERRUPTED PC
TLZ A,770000 ;WIPE OUT THE FLAGS
ETYPE < at %1Y > ;TYPE IT OUT
MOVE A,SVHNDL
MOVEM A,FORK ;RESTORE FORK
ENDIF.
JRST USEPS2 ;JOIN COMMON CODE
CERR: CMERRX ;CATCH-ALL COMMAND ERROR
;ROUTINE TO HANDLE CMERRX MACRO CALL.
CMERR$: STKVAR <MP,SEP2,ATMP,SAVBLK>
MOVEI A,SBLKLN ;SAVE STATE BLOCK SO ERROR HANDLING DOESN'T RUIN ^H
CALL GETBUF ;GET ROOM TO SAVE IT
MOVEM A,SAVBLK ;REMEMBER WHERE BLOCK IS
HRLI A,SBLOCK ;MAKE BLT POINTER
MOVEI B,SBLKLN-1(A) ;GET LAST ADDRESS TO BE SAVED INTO
BLT A,(B) ;SAVE STATE BLOCK
SETZM SEP2 ;NO SECOND SEPARATOR YET
SETZM ATMP ;NO ATOM TO PRINT YET
HRROI A,@40 ;GET POINTER TO MESSAGE
MOVEM A,MP ;REMEMBER POINTER TO MESSAGE
MOVE D,[440700,,ATMBUF] ;FIRST TRY TO USE ATOM BUFFER
MOVE B,D ;SEE IF ANYTHING IN IT
ILDB B,B
JUMPN B,CMERR1 ;IF SO, NO NEED TO SLURP COMMAND BUFFER UP.
SKIPN CMCNT ;ROOM FOR ONE MORE CHARACTER?
JRST CMERR2 ;NO, FORGET IT
MOVE A,CMINC ;GET NUMBER OF UNPARSED CHARACTERS
ADJBP A,CMPTR ;GET POINTER TO END OF BUFFER
MOVEI B,.CHLFD ;USE LINEFEED TO PREVENT COMND FROM GOING INTO I/O WAIT
IDPB B,A ;PUT LINEFEED IN BUFFER
SETZ B, ;MAKE SURE THERE IS A NULL AT THE END
IDPB B,A
SOS CMCNT ;REMEMBER THERE'S ROOM FOR ONE LESS CHARACTER
AOS CMINC ;REMEMBER THERE'S ONE MORE UNPARSED CHARACTER
MOVEI B,[FLDDB. .CMTXT] ;READ REST OF LINE INTO ATOM BUFFER
CALL FLDSKP
JRST CMERR2 ;IF THAT FAILS, HANG IT UP.
MOVE D,[440700,,ATMBUF] ;POINT TO STRING WHICH IS REST OF LINE
MOVE B,D ;GET COPY OF POINTER
ILDB B,B ;SEE IF THERE'S ANYTHING ON LINE
JUMPE B,CMERR2 ;IF NOT, DON'T ATTEMPT TO PRINT MORE OF STRING
CMERR1: HRROI B,[ASCIZ / - "/] ;GET SECOND SEPARATOR
MOVEM B,SEP2
MOVE A,CSBUFP ;PREPARE TO BUILD STRING WITH ATOM AND CLOSE QUOTE
MOVE B,D ;POINT TO ATOM
MOVEI C,.CHNUL ;STOP ON NUL
SOUT ;PUT ATOM IN STRING
HRROI B,[ASCIZ /"/] ;CLOSE QUOTE AND PUT IN NULL
SOUT
MOVE A,CSBUFP ;POINT TO ENTIRE STRING
CALL BUFFS ;ISOLATE THE STRING
MOVEM A,ATMP ;SAVE POINTER TO ATOM BUFFER
CMERR2: HRL A,SAVBLK ;RESTORE STATE BLOCK SO ^H WORKS
HRRI A,SBLOCK
BLT A,SBLOCK+SBLKLN-1
HRROI B,[ASCIZ / - /] ;FIRST ASSUME MESSAGE HAS TWO PARTS
MOVE A,MP ;GET MESSAGE POINTER
SKIPN (A) ;IS CALLER SUPPLYING SPECIFIC STRING?
HRROI B,[0] ;NO, SO NO SEPARATOR NEEDED BETWEEN STRINGS
MOVE C,SEP2 ;GET POSSIBLE SECOND SEPARATOR
MOVE D,ATMP ;GET POSSIBLE ATOM POINTER
ERROR <%1M%%2M%%?%%3M%%4M> ;USER, SEPARATOR, MONITOR, SEPARATOR, ATOM
;NOT IMPLEMENTED YET ERROR
;DISPATCH TO HERE AUTOMATICALLY SUPPLIED BY COMMAND TABLE ENTRY MACRO
; IF NO ROUTINE IS DEFINED FOR THE COMMAND.
NIM:
NIYE: ERROR <Not implemented yet>
;INTERNAL ERROR
SCREWUP:HRRZ Q1,(P) ;PC (GET HERE WITH PUSHJ)
SUBI Q1,1
ERROR <Internal error at %5P>
;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1.
;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT.
;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS
; BEFORE COMING TO THIS GENERAL ROUTINE.
;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR"
; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE
; JSYS'S. 6/26/70.
JERR: MOVEM A,ERCOD ;SAVE ERROR NUMBER
JERR1: CALL ERFRST ;GET SET TO TYPE MSG
CALL CRIF ;EOL UNLESS AT LEFT
HRRZ Q2,(P) ;PC (GOT TO JERR WITH PUSHJ)
SUBI Q2,2 ;PROBABLE LOC OF JSYS
CALL PIOFF ;DON'T ALLOW ^C WHILE FORK IS AMOK
MOVEI A,.FHSLF ;USE OUR SYMBOL TABLE FOR MESSAGE
EXCH A,FORK
ETYPE <JSYS error at %6Y>
EXCH A,FORK ;RESTORE FORK CELL
CALL PION ;ALLOW INTERRUPTS AGAIN
CALL SYSERA ;GO TYPE SYSTEM ERROR MESSAGE
JRST ERRFIN ;FINISH
JERRC: MOVEM C,ERCOD ;"JERR" FOR ERROR CODE IN C
JRST JERR1 ; (AS AFTER "NOUT")
;ROUTINES FOR USE WITH ERJMP AND ERCAL JSYS RETURNS
;GET ERROR CODE FROM SYSTEM AND STORE IN ERCOD
;THEN CALL REGULAR ERROR PRINT
JERRE:: CALL %GETER
JRST JERR1
CJERRE::CALL %GETER
JRST CJERR1
;ERROR RETURN FROM JSYS WHERE ERROR MESSAGE FROM JSYS SHOULD BE
;MEANINGFUL TO USER
CJERR:: MOVEM A,ERCOD
CJERR1: CALL ERFRST ;INIT ERROR STUFF
CALL SYSERA ;PRINT JSYS MSG ONLY
JRST ERRFIN ;FINISH
;ROUTINE TO PRINT WARNING ABOUT FAILING JSYS.
;PUT "JWARN" AFTER ANY JSYS THAT ISN'T EXPECTED TO FAIL, BUT FOR WHICH
;YOU DON'T REALLY CARE IF IT DOES, EXCEPT THAT YOU WANT THE USER TO KNOW
;WHY.
RJWARN::ETYPE <%_%%%Unexpected error: %?%%_%%% proceeding...%_>
RET ;RETURN TO CALLER
;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE
;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING
;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT.
;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN EXEC",
; TYPE SYSTEM ERROR MESSAGE WITH
; REGULAR ROUTINE, AND RETURN TO COMMAND INPUT.
%TRAP: PUSH P,D
PUSH P,Q1
MOVE Q1,@40 ;GET LEVEL
CAILE Q1,0
CAILE Q1,3 ;LEGAL LEVEL?
SKIPA Q1,[0,,-1] ;NO, GIVE -1
HRRZ Q1,PCTAB(Q1) ;YES, GET PC
CALL ICLEAR ;CLEAR THIS INTERRUPT
MOVEI D,RERET ;CHANGE ERROR ROUTINE RETURN
MOVEM D,CERET ;...TO "REGULAR"
SETZM .JBUFP ;SAY FLUSH ALL JFNS
;HERE WE MUST CHECK FOR EOF IN COMMAND FILE AND HANDLE SPECIALLY.
;ALSO I'M SURE MANY OTHER EXECEPTIONAL CASES WILL TURN UP.
MOVE D,40 ;SAVE TEXT ADDRESS
CALL ERFRST ;DO THINGS NEEDED BEFORE TYPING MESSAGE
CALL CRIF ;EOL IF CARRIAGE NOT AT LEFT MARGIN
UTYPE 1(D) ;TYPE CHANNEL-SPECIFIC MESSAGE
ETYPE < internal trap at %5P>
POP P,Q1
POP P,D
PUSH P,[ERRFIN] ;WHERE TO GO AFTER ERROR MESSAGE PRINTING
PUSH P,[U$ERR] ;NO MESSAGE
JRST ERR1 ;GO FINISH ERROR PROCESSING
;NOTE: EXCEPT FOR ^O, THERE ARE NO INTERRUPTS WHICH DEBREAK TO THE POINT
;OF INTERRUPTION. HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET"
;BEING CHANGED. BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO
;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED.
;PDL OVERFLOW. THIS ROUTINE MUST FIRST CLEAR THE STACK BEFORE IT
;CAN CALL ANYTHING ELSE!
PDLOV:: XCT INISTK ;CLEAR THE STACK
TRAP LV.POV,<Pushdown overflow>
;ILLEGAL INSTRUCTION PSI
;GO TO SPECIAL CASE ROUTINE ILIDSP POINTS TO, IF NON-0,ELSE
;TREAT LIKE OTHER ERROR PSI'S.
;ILIDSP USED, FOR INSTANCE, TO DETECT "LIST ACCESS NOT ALLOWED" FROM
; GTFDB JSYS.
;SPECIAL ROUTINE GETS ERROR CODE IN ERCOD.
;IF SPECIAL ROUTINE ISN'T INTERESTED IN THIS PARTICULAR ERROR,
; IT CAN JRST TO ILIPSI AGAIN.
ILIPSI: MOVE A,[CALL CUUO] ;RESET UUO DISPATCH TO PROTECT
MOVEM A,41 ; IT FROM MALICIOUS USERS (AND IF TRASHED)
SKIPE ILIDSP ;IS THERE A SPECIAL DISPATCH?
JRST ILIDO ;YES, DO IT
STKVAR <ILCOD>
CALL DGETER ;SEE WHY FAILED
MOVEM A,ILCOD ;REMEMBER
CALL ICLEAR ;CLEAR INTERRUPT
HRRZ A,LV.ILI+PCTAB ;GET PC OF ERROR
MOVE B,ILCOD ;PRINT REASON
ERROR <Internal illegal instruction at %1O - %2?>
ILIDO: CALL ILI0 ;DO THE WORK
DEBRK ;DISMISS TO SPECIAL PLACE
ILI0: ATSAVE
MOVE A,ILIDSP ;GET WHERE TO GO
MOVEM A,LV.ILI+PCTAB ;TELL DEBRK
SETZM ILIDSP ;CLEAR SPECIAL DISPATCH
MOVEI A,.FHSLF
GETER ;GET ERROR CODE
HRRZM B,ERCOD ;ERROR CODE, FOR SPECIAL ROUTINE
RET ;DISPATCH TO SPECIAL ROUTINE
;END-OF-FILE INTERRUPT
;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR,
; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS.
;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS.
EOFPSI: CALL SAVACS ;DON'T CLOBBER AC'S
CALL ICLEAR ;CLEAR INTERRUPT
CALL RESACS ;RESTORE AC'S
JRST EOFCHK ;HANDLE CONDITION
;CALL THE FOLLOWING ROUTINE AFTER A FAILING TEXTI. IT CHECKS THE
;ERROR CODE FOR END-OF-FILE CONDITION, HANDLING SPECIALLY. OTHER ERRORS
;ARE HANDLED STANDARDLY.
EOFJER::CALL GETERR ;GET ERROR CODE
CAIE A,IOX4 ;END OF FILE?
CALL CJERRE ;NO, TREAT AS UNEXPECTED ERROR
SKIPN PCCURC ;[PCL] Unless in a PCL,
CALL CMDINI ;RE-INIT COMMAND, TO PROTECT OURSELF
POP P,(P) ;THROW AWAY THE CALL TO THIS ROUTINE
JRST EOFCHK
;ROUTINE TO HANDLE END OF FILE CONDITION.
EOFCHK: SKIPN EOFDSP
TRAP LV.EOF,<Unexpected end-of-file> ;NO SPEC DISPATCH, TREAT AS ERROR
PUSH P,EOFDSP ;PREPARE TO DISPATCH TO SPECIAL PLACE WITHOUT CLOBBERING AC'S
SETZM EOFDSP ;DON'T ALLOW FURTHER INTERRUPTS
RET ;SERVICE THE END OF FILE CONDITION
;QUOTA EXCEEDED INTERRUPT
;DISPATCH ON QTADSP IF NON-ZERO, ELSE TREAT LIKE OTHER
;"PSEUDO-INTERRUPTS". QTADSP IS USUALLY NON-ZERO DURING ROUTINES
;WHICH WOULD CREATE PAGES AND WISH TO HELP THE USER.
QTAPSI::CALL SAVACS ;SAVE A REG
SKIPN QTADSP
CALL ICLEAR ;CLEAR INTERRUPTS IF NO SPECIAL DISPATCH ADDRESS
SKIPN QTADSP ;CHECK ROUTINE ADDRS
ERROR <User resource failure in EXEC, %?> ;NOT SPECIAL, GIVE MONITOR MSG
MOVE A,QTADSP ;GET ADDRS OF SPECIAL ROUTINE
HRRM A,PCTAB+LV.QTA ;SET UP FOR DEBRK
SETZM QTADSP ;ONLY ONCE
CALL RESACS ;RESTORE
DEBRK ;BYE
;MACHINE SIZE EXCEEDED INTERRUPT
MSEPSI::CALL SAVACS
CALL ICLEAR
CALL RESACS
CALL GETERR ;SEE WHAT HAPPENED
ERROR <System resource failure in EXEC, %?> ;NO, REPORT FROM SYSTEM
;FILE DATA ERROR INTERRUPT
;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO.
;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND
; FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED.
DATPSI: CALL SAVACS ;DON'T CLOBBER AC'S
CALL ICLEAR ;CLEAR INTERRUPT
CALL RESACS
SKIPN DATDSP
JRST DATPS1 ;NO DISPATCH, TYPE ERROR MESSAGE
PUSH P,DATDSP ;SAVE SPECIAL DISPATCH ADDR FOR "RET" BELOW
SETZM DATDSP ;CLEAR SPECIAL DISPATCH
RET ;DISPATCH TO SPECIAL ROUTINE
DATPS1: MOVEI Q1,RERET
MOVEM Q1,CERET ;RESET ERROR RETURN TO "NORMAL"
SETZM .JBUFP
GTSTS ;TREAT CONTENTS OF AC1 AS A JFN, SEE IF ERROR
TXC B,GS%ERR!GS%NAM ;IF ERROR AND LEGAL JFN, BOTH BITS ARE OFF NOW
TXNE B,GS%ERR!GS%NAM ;SKIP IF JFN IS LEGAL AND IN ERROR
ERROR <File data error>
MOVE D,A ;REMEMBER JFN
DVCHR ;SEE WHAT KIND OF DEVICE WE HAVE
LOAD A,DV%TYP,B ;SEE WHAT FLAVOR DEVICE
CAIE A,.DVMTA ;DO SPECIAL MESSAGE FOR MAGTAPE
DTANOF: ERROR <File data error on file %4S>
MOVE A,D ;GET THE JFN BACK
GDSTS ;IT'S A MAGTAPE, SEE IF WE'RE AT END OF TAPE
TXNN B,MT%EOT ;ARE WE AT END OF TAPE?
JRST DTANOF ;NO
ERROR <End of tape reached on file %4S>
;CLEAR OUTPUT BUFFER PSI
;ISSUES CFOBF ON PRIMARY OUTPUT JFN
;NORMALLY INVOKED BY ^O
COBPSI: PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.PRIOU
RFMOD ;GET PRESENT TTY MODES
TLCE B,(1B0) ;COMPLEMENT SUPPRESS FLAG
JRST [ SFMOD ;WAS ON BEFORE, TURN IT OFF AND PROCEED
JRST COBPS1]
PUSH P,B
CFOBF ;CLEAR OUTBUF OF TTY (PRESUMABLY)
HRROI B,[ASCIZ / ^O...
/]
SETZ C,
SOUT ;NOTE WHAT HAPPENED FOR USER
POP P,B ;RECOVER TTY MODES
SFMOD ;SET OUTPUT SUPPRESS
COBPS1: POP P,C
POP P,B
POP P,A
DEBRK
;GETLPC GETS THE ADDRESS IN WHICH THE INTERRUPT PC FOR THE CURRENT INTERRUPT
;LEVEL IS STORED.
;
;RETURNS+1: NO INTERRUPT IN PROGRESS
; +2: A/ ADDRESS WHICH CONTAINS INTERRUPTED PC
GETLPC::MOVEI A,.FHSLF ;OURSELF
RWM ;SEE WHICH LEVELS ARE IN PROGRESS
TSO B,B ;IN EITHER USER OR MONITOR CONTEXT.
JFFO B,GETL1 ;FIGURE OUT HIGHEST LEVEL IN PROGRESS
RET ;NO INTERRUPT IN PROGRESS
GETL1: MOVEI A,PCTAB(C) ;GET ADDRESS IN A
RETSKP ;SKIP TO SAY INTERRUPT IN PROGRESS
;ROUTINE TO CLEAR INTERRUPT. WE TRY TO AVOID CIS JSYS, WHICH REQUIRES
;FAKING AN IPCF INTERRUPT, SINCE ^C OUT OF IPCF INTERRUPT COULD OTHERWISE
;PREVENT ANY MORE IPCF MESSAGES FROM BEING RECEIVED
;ONE OF THE GOALS OF THIS ROUTINE IS TO DO MINIMAL JSYS'S SINCE, ^C CALLS
;IT AND WANTS TO BE EFFICIENT.
ICLEAR::CALL GETLPC ;GET ADDRESS OF INTERRUPT ADDRESS
RET ;NO INTERRUPT IN PROGRESS
XMOVEI D,IC2 ;GET DUMMY PC FOR CLEARING INTERRUPT
EXCH D,@A ;STORE DUMMY PC, GET REAL ONE
DEBRK ;CLEAR THIS INTERRUPT LEVEL
IC2: MOVEM D,@A ;RESTORE REAL INTERRUPT ADDRESS IN CASE SOMEONE CARES
HLLZ B,B ;IGNORE MONITOR INTERRUPTS
LSH B,1(C) ;THROW AWAY BIT REPRESENTING LEVEL WE JUST CLEARED
JUMPE B,R ;IF NO OTHER LEVELS IN PROGRESS, RETURN
;...
;CODE TO FLUSH OUT THE INTERRUPT SYSTEM. THIS IS NEEDED WHEN CLEARING
;AN INTERRUPT LEVEL (SUCH AS ^C) IF OTHER LEVELS WERE IN PROGRESS, IN ORDER
;TO PREVENT ALL SUBSEQUENT CODE TO BE AT INTERRUPT LEVEL.
;WE MUST FAKE AN IPCF INTERRUPT, SINCE THE MONITOR ONLY GIVES US ONE WHEN
;THE COUNT OF MESSAGES GOES FROM 0 TO 1.
SETZM IPCCTL ;PREVENT IPCF DISPATCH
CIS ;CLEAR ALL OTHER LEVELS
MOVEI A,.FHSLF ;OURSELF
MOVX B,1B<IPCCHN>
IIC ;FAKE IPCF INTERRUPT IN CASE WE ARE RESTARTING OR BOMBING OUT OF IPCF INTERRUPT ROUTINE
RET
;SUPER-PANIC CHARACTER (CURRENTLY ^C) PSEUDO-INTERRUPT ROUTINE.
;CHANNEL 1, LEVEL 1
CCPSI: TLOE Z,CTLCF1 ;SAY WE'VE SEEN ^C
TLO Z,CTLCF2 ;IF IT'S THE SECOND ONE, SAY SO
;(CTLCF2 CAUSES OUTBUF TO BE CLEARED BELOW).
SKIPN ACTRCF ;^C ALLOWED?
DEBRK ;NO
.CTRLC: SETZM ILIDSP ;CLEAR SPECIAL IL INST DISPATCH ADDRESS
SETZM CLF ;SAY NOT AT COMMAND LEVEL
CALL ICLEAR ;CLEAR INTERRUPT SO MULTIPLE ^C'S WORK
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
SKIPG A,EFORK ;SPECIAL FORK?
IFSKP.
FFORK ;YES - FREEZE IT
ERJMP .+1 ;ALREADY GONE
ENDIF.
TLNN Z,RUNF ;PROGRAM RUNNING?
JRST [ TLO Z,CTLCF2 ;NO, ^C FROM EXEC. DO CLEAR OUTBUF
JRST CCDB3]
;*** NEED TO SET CTLCF2 HERE IFF FORK WAS IN TTY INPUT WAIT ***
TXO Z,NECHOF ;PRETEND ECHOING OFF IN CASE PROG TURNED IT OFF, IN ORDER THAT DOECHO TURN IT BACK ON
SKIPG A,RUNFK ;HAVE A RUNNING FORK
MOVE A,FORK
FFORK ;FREEZE THE WORLD
ERCAL [TYPE <% Process disappeared>
ETYPE<%_>
RET]
MOVX Q1,FK%INT ;MARK INTERRUPTED
SKIPE SLFTAB(A)
IORM Q1,SLFTAB(A)
TMNN FK%INV,SLFTAB(A) ;[PCL] If not controlled by PCL
CALL RFTYMD ;READ FORK'S MODES
TLZ Z,RUNF ;DON'T DO TTY MODES ON 2ND ^C!
CCDB3: MOVEI Q1,ETTYMD ;CM236 SPR 14601
TMNN FK%INV,SLFTAB(A) ;[PCL] If not controlled by PCL
CALL LTTYMD ;SET UP OUR MODES, PROGRAM MAY HAVE CAUSED STRANGE STATE.
SKIPE TPCCOC ;USED UNFORMATTED TYPE COMMAND ?
CALL TYPFIN ;YES
MOVE A,COJFN ;CM236 SPR 14601
TLNE Z,CTLCF2 ;2ND ^C?
CFOBF ;YES, CLEAR OUTPUT BUFFER.
;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.
SETZM ERRMF ;CLEAR "PROCESSING AN ERROR" FLAG, BECAUSE
;ANOTHER ^C WHILE PROCESSING EARLIER ONE IS OK.
MOVEI A,CCERET ;SET ERROR ROUTINE TO SPECIAL ^C VALUE
MOVEM A,CERET ;..
SETZM .JBUFP ;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
SETZM LGORET ;CLEAR LOGOUT-RETURN FLAG; WE WON'T GO BACK THERE
CALL CLRIO ;CHECK AND RELEASE EXEC IO
CALL CIOER1 ;GET RID OF "TAKE" JFN
SKIPE PCCURC ;PCL Command procedure in progress?
CALL PCMPOP ;PCL Yes, pop context right now
SKIPE QTADSP ;[PCL] Do we seem initialized?
SETOM CINITF ;[PCL] Yes, allow for ^C in Save/Exec
SKIPE MPENDF ;WARN IF ^C OUT OF MOUNT
ETYPE <%@[Mount request remaining in queue]
>
SETZM MPENDF ;DON'T KEEP REMINDING HIM
.$ERROR <^C> ;NO CLEAR INBUF, NO CR FIRST
;WAIT FOR OUTBUF TO EMPTY BEFORE CLEARING ^C FLAGS,
; FOR PROPER DETECTION OF 2ND ^C.
CCERET: MOVE A,COJFN
TLNN Z,CTLCF2 ;BUT DON'T WAIT IF 2ND ^C
DOBE
TLZ Z,CTLCF1+CTLCF2
JRST RERET ;GO TO STANDARD ERROR HANDLER
;TIME LIMIT EXCEEDED INTERRUPT COMES HERE
TLMPSI: SETZM .JBUFP ;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
;TO MAKE EXEC TRANSFER TO ANY CODE THEY WISH).
TLNN Z,RUNF ;PROGRAM RUNNING?
JRST [ TLO Z,CTLCF2 ;NO, ^C FROM EXEC. DO CLEAR OUTBUF
JRST TLMPS1]
;*** NEED TO SET CTLCF2 HERE IFF FORK WAS IN TTY INPUT WAIT ***
SKIPG A,RUNFK ;CURRENT FORK
MOVE A,FORK
FFORK ;FREEZE THE WORLD
MOVX Q1,FK%INT ;MARK INTERRUPTED
SKIPE SLFTAB(A)
IORM Q1,SLFTAB(A)
TMNN FK%INV,SLFTAB(A) ;[PCL] If not controlled by PCL
CALL RFTYMD ;READ FORK'S MODES
TLZ Z,RUNF ;DON'T DO TTY MODES ON 2ND ^C!
TLMPS1: MOVEI Q1,ETTYMD ;PUT EXEC'S TTY MODES INTO EFFECT.
TMNN FK%INV,SLFTAB(A) ;[PCL] If not controlled by PCL
CALL LTTYMD ;MUST ALWAYS BE DONE: EG GTJFN LEAVES THEM BAD.
MOVE A,COJFN
TLNE Z,CTLCF2 ;2ND ^C?
CFOBF ;YES, CLEAR OUTPUT BUFFER.
;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.
SETZM ERRMF ;CLEAR "PROCESSING AN ERROR" FLAG, BECAUSE
;ANOTHER ^C WHILE PROCESSING EARLIER ONE IS OK.
MOVEI A,TLMRET
MOVEM A,CERET ;COME BACK HERE AFTER ERROR PRINT
ERROR <Time limit exceeded>
TLMRET: SKIPN CJPTIM ;CRJOB STARTUP & TIME LIMIT SET?
JRST TLMRE1 ;AND REENTER EXEC
IFNBATCH(TLMRE1) ;IF BATCH, ALLOW BATCON TO HANDLE
SETO A,
LGOUT
JFCL
HALTF ;MINI-EXEC WILL CATCH US?
TLMRE1: CALL ICLEAR ;CLEAR INTERRUPT
JRST ERRET ;REENTER EXEC
;AUTOLOGOUT PSI AND ROUTINE
;PROGRAM-GENERATED PSI ON CHANNEL 2, LEVEL 1 DISPATCHES HERE
ALOPSI: PUSH P,[[DEBRK]] ;FAKE UP RETURN
ATSAVE
GJINF ;GETS LOGIN USER # IN A
JUMPN A,R ;LOGIN IS COMPLETE, DONE WITH ALL THIS
MOVE C,TTYACF ;GET # CHARS TYPED SO FAR
CAMN C,PTTYAC ;SAME AS LAST PASS?
JRST ALOPS1 ;YES, CLOBBER JOB, IT IS INACTIVE
MOVEM C,PTTYAC ;NO, SAVE CURRENT AS PREVIOUS
MOVE A,[.FHSLF,,.TIMEL] ;SET NEXT TIME TO CHECK
MOVE B,[AUTOL3*^D1000]
MOVEI C,2 ;CHANNEL 2
TIMER
ERROR <Couldn't set auto-logout timer - %?>
RET
ALOPS1: CIS ;ITS REAL. CLEAR PSI SYSTEM SO AUTOLOGOUT
;IS DONE NOT ON AN INTERRUPT LEVEL.
;EXEC'S MAIN FORK JSRT'S HERE,
;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT.
;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT.
AUTOLO: SKIPE CUSRNO ;SKIP IF NOT LOGGED IN
ERROR <Autologout screwup>
GJINF ;GETS CONTROLLING TTY # IN 4
CAMN D,[-1] ;-1 IF NONE (DETACHED)
JRST AUTOL6 ;DETACHED, TYPING MESSAGE WOULD HANG UP JOB.
;CAN BE DETACHED IF DATAPHONE HUNG UP AND CARRIER-OFF PSI
;ISN'T FULLY PROCESSED, OR IF ATACH HAS SOMEHOW FAILED TO
;COMPLETE.
MOVE A,COJFN
CFOBF ;CLEAR POSSIBLE ^S
TYPE <
Autologout
>
;Nota Bene - If you dare change the DISMS% back to a DOBE% like it used
;to be, you stand the chance of seeing "ghost" jobs on your system. The
;DOBE% will hang if the terminal associated with the job somehow has no
;origin associated with it any longer. This is how "(LAT)" and "(CTM)"
;jobs appear and can't be killed. The DISMS% should finish and then the
;job should get logged out. If this no worky, then the bug is in the
;monitor somewhere.
MOVEI A,^D1000 ;[7.1085] Give ample time for Autologout msg
DISMS% ;[7.1085] Now wait until finished
AUTOL6: SETO A, ;SAY SELF
LGOUT ;LOG JOB OUT
CALL JERR ;SHOULDN'T BE ABLE TO HAPPEN.
;ERROR UUO HANDLER. MESSAGE TEXT AT EFFECTIVE ADDRESS.
;SERVICES UUO'S UERR, U$ERR, U.$ERR (MACROS ERROR, $ERROR AND .$ERROR)
;USE "LERROR <TEXT>" TO PRINT ERROR MESSAGE AND RETURN. SAME AS
;"ERROR <TEXT>" EXCEPT LATTER DOESN'T RETURN TO CALLER.
%LERRO: TLZ Z,F1 ;LOCAL ERROR HANDLER, RETURNS TO CALLER
PUSH P,A ;[PCL] Save an AC to play with
MOVE A,TAKLEN ;[PCL] Get I/O stack pointer
HLRZ A,TAKJFN-1(A) ;[PCL] Get input designator (don't just look
; at CIJFN because we didn't call FIXIO yet)
CAIN A,.NULIO ;[PCL] From PCL?
JRST ERRPCL ;[PCL] Yes, return to Exec top level
POP P,A ;[PCL] Restore work AC
CALL ERRX ;PRINT ERROR MESSAGE
SETZM ERRMF ;CLEAR FLAG TO SAY ERROR IS OVER
RET ;RETURN
%ERR: %$ERR: TLZ Z,F1
CAIA
%.$ERR: TLO Z,F1 ;SAY DON'T CLEAR INBUF (ERFRS1)
PUSH P,A ;[PCL] Save an AC to play with
MOVE A,TAKLEN ;[PCL] Get I/O stack pointer
HLRZ A,TAKJFN-1(A) ;[PCL] Get input designator (don't just look
; at CIJFN because we didn't call FIXIO yet)
CAIE A,.NULIO ;[PCL] From PCL?
JRST NOPCL ;[PCL] No, do normal stuff
ERRPCL: MOVEI A,RERET ;[PCL] Get standard error return
MOVEM A,CERET ;[PCL] Say return to Exec top-level after error
; is processed
NOPCL: POP P,A ;[PCL] Restore work AC
CALL ERRX ;PRINT ERROR MESSAGE
JRST ERRFIN ;FINISH ERROR HANDLING
;MAIN WORK ROUTINE FOR ERROR MESSAGES. HANDLES CLEARING OF TYPEAHEAD,
;TYPING "?" IN FRONT OF MESSAGES, ETC.
ERRX: PUSH P,40 ;TEXT ADDRESS AND UUO VALUE
CALL ERFRS1 ;DO WHAT MUST BE DONE BEFORE TYPING ERROR MSG
JRST ERR1
;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD"
;MUST HAVE ALREADY CALLED "ERFRST"
SYSERA: PUSH P,[-2]
ERR1: PUSH P,A ;AC'S MUST BE SAVED FOR ETYPE OR ERSTR
;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN "?" (ALWAYS),
;THEN TEXT, THEN CR.
;BUT NO INITIAL CR-SPACE IF "U$ERR" UUO.
HLRZ A,-1(P) ;-1 FOR SYSTEM MSG, OR UUO FOR EXEC MSG
CAIE A,<U.$ERR>B53
CAIN A,<U$ERR>B53
JRST ERR5 ;NO CR-SPACE FOR U$ERR UUO ($ERROR MACRO)
CALL CRIF ;TYPE EOL IF NOT ALREADY AT LEFT
ERR5: MOVE A,-1(P) ;0, -1, -2, OR UUO-TEXT ADDRESS
TRNN A,-1
JRST ERR7 ;0 RH MEANS NO TEXT
JUMPGE A,ERR5A ;POSITIVE: USE TEXT A POINTS TO
CAME A,[-1] ;-1 MEANS LATEST ERROR FROM SYSTEM
JRST ERR5C
SKIPG A,EFORK ; USE EPHEMERAL IF PRESENT
MOVEI A,.FHSLF ;GET ERROR # FROM SYSTEM NOW FOR
GETER ; LATER USE IN MSG
ERJMP ERR5B ;FORK WENT AWAY PROBABLY, SHOULD TYPE SOMETHING
ERR5C: HRLI B,.FHSLF ;FORK: SELF
CAMN A,[-2]
HRR B,ERCOD ;-2 SAYS USE SYSTEM ERR # FROM "ERCOD"
HRRZ C,B ;GET ERROR CODE
CAIE C,GJFX3 ;NO JFNS?
CAIN C,GJFX22 ;OR JSB FULL?
JRST [ TYPE <Can't create another JFN for this job --
Try releasing some with "CLOSE" command>
JRST ERR6] ;SPECIAL CASE BECAUSE ERSTR WILL FAIL HERE
ERR5B: ETYPE <%3?> ;TYPE ERROR MESSAGE
JRST ERR6 ;DONE.
ERR5A: MOVE A,(P) ;VALUE THAT CAME IN A MIGHT BE USED BY ETYPE
UETYPE @-1(P) ;TYPE MESSAGE FROM CORE
ERR6: ETYPE<%_>
TLNE Z,LOGOFF
TYPE < Not logged off
> ;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE
;ERROR UUOS AND SYSERM...
;MESSAGE ALL TYPED.
ERR7: TLNN Z,F1 ;DON'T CLEAR INBUF FOR RUBOUT, ^X (.$ERROR)
SKIPN CIDLYF ;REQUESTING DELAYED CFIBF?
JRST ERR7A ;NO
MOVE A,CIJFN
DOBE
CFIBF ;CLEAR FILE INPUT BUFFER
ERR7A: CALL DOECHO ;MAKE SURE ECHOING IS ON
POP P,B
POP P,A
RET ;RETURN TO CALLER
;GET HERE IF ERROR IS FATAL, AND NO RETURN TO CALLER IS TO BE DONE.
;RESETTING OF VARIOUS THINGS DONE HERE...
ERRFIN::SETZM IPCCTL ;CLEAR SPECIAL IPCF INTERRUPT DISPATCH
SKIPG A,EFORK ;SPECIAL FORK?
IFSKP.
KFORK ;YES - KILL IT
ERJMP .+1 ;ALREADY GONE
SETOM EFORK ;NO MORE
ENDIF.
BTCHER ;SHOULD STOP NON-CONVERSATIONAL JOB
ADJSP P,-1 ;FORGET UUO
;RESTORE EARLIER (LESS FULL) PUSHDOWN LEVEL IF LEVEL
;WAS SAVED . THIS IS GENERALLY USED DURING SUBCOMMAND
;INPUT.
SKIPE .PP ;DON'T RESET IF .PP NEVER SAVED
MOVE .FP,.PP ;RESTORE .FP AS IT WAS BEFORE COMMAND.
SKIPE .P ;DON'T RESET P IF NEVER SAVED!
MOVE P,.P ;RESTORE P TO AS IT WAS BEFORE COMMAND
SETZM ERRMF ;NO LONGER PROCESSING AN ERROR
JRST @CERET ;VARIABLE ERROR RETURN, GOES SPECIAL PLACES
;DURING SUB-COMMAND INPUT AS FOR "DIRECTORY" CMD
;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE
RERET: CALL UNMAP ;UNMAP SPECIAL PAGES (BEFORE FLJFNS TO PREVENT CLOSF FAILURE)
CALL UNTAKE ;END TAKE FILE IF ERRORS NOT ALLOWED
SETZM .JBUFP ;FLUSH ALL JFNS
CALL FLJFNS ;RELEASE JFNS FLUSHING OUTPUT FILES
MOVE A,[CZ%NIF+.FHSLF]
SKIPE CLZFFF ;DO CLZFF IF POSSIBLE LOST JFN
CLZFF ;RELEASE ANY UNOPEN JFNS
JRST ERRET ;GO BACK TO COMMAND INPUT
;ROUTINE TO UNMAP SPECIAL PAGES, SAVES SWAPPING SPACE.
UNMAP:: SETO A, ;PAGE OF INFERIOR FORK
CALL MAPPF
JFCL ;UNMAP SHOULD NEVER FAIL
SETO A,
MOVE B,[XWD .FHSLF,1+<FREE>B44] ;CLEAR PAGES FREE+1 - BUFL WHICH INCLUDES
MOVE C,[PM%CNT+<BUFL-FREE>B44] ; BUF1, BUF2, DIRECTORY
PMAP ;RESERVE ONE PAGE IN CASE SWAPPING SPACE FILLS UP
CALLRET FREINI ;FIX FREE STORAGE DATABASE AND RETURN
;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT
; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR.
ERFRST: TLZ Z,F1 ;NORMAL ENTRY
ERFRS1: ;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
SAVEAC <A,B,C,D> ;AC'S MAY HAVE DATA FOR MESSAGE PRINTOUT
SKIPE TPCCOC ;USED UNFORMATTED TYPE COMMAND ?
CALL TYPFIN ;YES
CALL %GETER ;GET ERROR CODE IN CASE "%?"
CALL CSAVE ;SAVE FAILED COMMAND FOR COMMAND EDITOR
JFCL ;COULDN'T - PROCEED AS USUAL
CALL FIXIO ;MAKE SURE ERROR SEEN IN "REAL" OUTPUT STREAM
CALL SETT20 ;SAY TOPS20 LEVEL NOW
SKIPN CINITF ;IS EXEX INITIALIZED?
JRST [ MOVEI 1,.PRIOU ;NO, ASSUME COJFN, ETC. NOT SET UP
HRLOI 2,.FHSLF
SETZ 3,
ERSTR ;BUT TRY TO GET OUT ERROR MSG
JFCL
JFCL
HRROI 1,[ASCIZ /
?TOPS-20 command processor not properly initialized.
/]
PSOUT
HALTF]
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH, BECAUSE OTHERWISE
MOVEM A,41 ;MALICIOUS USERS CAN MAKE EXEC TRANSFER
;TO ANY CODE THEY WISH BY PATCHING PAGE 0 OF PMF
MOVE A,COJFN
DOBE ;WAIT IN CASE USER ^O'S SOME OTHER TYPEOUT
RFMOD ;GET TTY MODES
TLZE B,(1B0) ;CLEAR OUTPUT SUPPRESS IF IT WAS ON
SFMOD
SKIPE ERRMF ;DID THIS ERROR OCCUR WHILE PROCESSING ANOTHER?
JRST [ CALL UNTAK1 ;IF MULTIPLE ERROR, ALWAYS END TAKE FILE
UTYPE [ASCIZ /
?Error within an error
/] ;YES, GIVE UP
JRST ERRET]
SETOM ERRMF ;SAY THERE'S AN ERROR
CALL ECHCMD ;ECHO ERRONEOUS COMMAND IF NOT FROM TERMINAL
MOVE A,CIJFN ;SEE WHERE INPUT FROM
CAIN A,.NULIO ;PCL?
JRST [ CALL PCMPOP ;YES, ALWAYS FLUSH
JRST ERFRS2]
CALL UNTAKE ;UNWIND IF ERRORS NOT ALLOWED AT THIS LEVEL
ERFRS2: TLNN Z,F1 ;DON'T CLEAR INBUF FOR ^U
SKIPN CIDLYF ;REQUESTING DELAYED CFIBF?
IFNSK. ;[3031]
SKIPE CUSRNO ;[3031] YES - LOGGED IN ?
RET ;[3031] NO - DON'T DO IT NOW
ENDIF. ;[3031]
MOVE A,CIJFN
CFIBF ;[3031] CLEAR THE INPUT BUFFER
ERJMP .+1 ;[3031] IGNORE THE ERROR RETURN
RET
;ROUTINE TO RESTORE CIJFN/COJFN TO THEIR CORRECT VALUE. THIS IS DONE
;TO UNDO POSSIBLE MEDDLING WITH CI/COJFN BY CERTAIN COMMANDS THAT MAY DIVERT
;OUTPUT TEMPORARILY TO A STRING.
FIXIO:: MOVE A,TAKLEN ;GET POINTER TO CURRENT LEVEL
HLR B,TAKJFN-1(A) ;GET CIJFN VALUE
HRRZM B,CIJFN ;RESTORE INPUT STREAM
HRR B,TAKJFN-1(A) ;GET COJFN VALUE
HRRZM B,COJFN ;RESTORE OUTPUT STREAM
MOVE B,TAKBTS-1(A) ;GET CORRECT CONTROL BITS
MOVEM B,TAKCUR ;REMEMBER CURRENT SETTINGS
RET
;ROUTINE TO FINISH TAKE FILE BECAUSE THERE IS AN ERROR WHILE
;PROCESSING IT.
UNTAKE: MOVE A,TAKCUR ;GET CURRENT SETTINGS
MOVE B,CIJFN ;ALWAYS END TAKE FILE IF IT'S A PCL COMMAND
CAIE B,.NULIO
TXNN A,TKALEF ;ALLOWING ERRORS?
CAIA
RET ;YES, SO DON'T END THE TAKE FILE
UNTAK1: CALL CIOREL ;END TAKE FILE
CALLRET CIOER ;THERE WAS ONE, SO SAY WHICH ONE WAS ENDED
RET
;ROUTINE TO GET RID OF "TAKE" JFN WHEN ERROR FROM WITHIN IT.
CIOER1: CLOSF ;JUST CLOSE TAKE FILE
CALL JERR ;SHOULDN'T FAIL
RET ;DONE
CIOER: MOVEI D,[ASCIZ /%% Error while reading %1M, file aborted.
/]
SETZM LGORET ;RESET "TAKING LOGOUT.CMD" FLAG IF ERROR
STKVAR <<CSIBUF,EXTSIZ>>
CAIN A,.NULIO ;PCL Is there a real file name?
JRST CIOER2 ;PCL No, use generic name
MOVE B,A ;JFN
HRROI A,CSIBUF ;SPACE TO STORE STRING
MOVEI C,0 ;NO SPECIAL FLAGS
JFNS ;GET FILENAME
ERJMP .+1 ;PCL Allow for missing JFN
MOVE A,B ;PUT JFN BACK INTO A
CLOSF ;CLOSE TAKE FILE BEFORE PRINTING MESSAGE BECAUSE ERROR MIGHT BE IN TAKE FILE ITSELF!
CALL JERR ;SHOULDN'T FAIL
HRROI A,CSIBUF ;GET POINTER TO FILENAME
UETYPE @D ;PRINT ERROR MESSAGE
RET
CIOER2: MOVE A,[POINT 7,[ASCIZ /command program/]] ;PCL
UETYPE @D ;PCL
RET ;PCL
;BEGIN ERROR MESSAGE LINE. DO CRLF IF NOT ALREADY AT LEFT MARGIN,
;THEN PRINT "?"
CRIF:: ATSAVE
CALL LM ;GET TO LEFT MARGIN
PRINT "?"
RET
;ROUTINE TO GET TO LEFT MARGIN
LM:: MOVE A,COJFN
RFPOS ;READ FILE POSITION
TRNE B,-1 ;LINE POSITION 0?
ETYPE<%_> ;NO, DO CRLF
RET
%MESS:: ATSAVE
CALL LM
PRINT "%"
RET
;ROUTINE TO GET LAST MONITOR ERROR CODE, RETURNS IT IN A.
GETERR: CALL %GETER
MOVE A,ERCOD
RET
;SUBROUTINE TO OBTAIN LAST JSYS ERROR IN A.
DGETER::MOVEI A,.FHSLF ;OURSELF
GETER ;GET LAST ERROR
HRRZ A,B ;RETURN ERROR IN A
RET
;SUBROUTINE TO DO "GETER" JSYS FOR EXEC AND STORE
;CODE IN "ERCOD"
%GETER::PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.FHSLF
GETER
HRRZM B,ERCOD
POP P,C
POP P,B
POP P,A
RET
;DOGET DOES THE GET JSYS.
;
;ACCEPTS: AC'S/ WHATEVER GET JSYS WANTS
;
;RETURNS: AC'S/ WHATEVER GET RETURNS
; +1 ERROR
; +2 SUCCESS, FAME AND FORTUNE
;
;This routine makes sure the jfn being used by the GET jsys is NOT on the
;exec's jfn stack before the GET jsys. This is necessary to ensure that
;the exec won't attempt to close the jfn later, when it may already be
;associated with another filespec being used by some random fork in the job.
;Normally, the monitor GET code will close the jfn appropriately at the end
;of the GET jsys, so there's no need for the exec to try to close it anyway.
DOGET:: STKVAR <<GETARG,2>>
DMOVEM A,GETARG ;REMEMBER GET ARGUMENTS
LOAD A,GT%JFN,A ;ISOLATE THE JFN
MOVE B,JBUFP ;GET POINTER TO CURRENT SAVED JFNS
DG1: CAMN B,[IOWD JBUFL,JBUF];HAVE WE SCANNED ENTIRE LIST?
JRST DG2 ;YES, JFN WAS NEVER STACKED
HRRZ C,(B) ;NO, EXAMINE NEXT JFN ON STACK
ADJSP B,-1 ;STEP BACK TO NEXT SLOT
CAME C,A ;HAVE WE FOUND THE CORRECT ONE YET?
JRST DG1 ;NO, KEEP LOOKING.
SETZM 1(B) ;YES, CLEAR THIS ENTRY SO EXEC DOESN'T TRY TO CLOSE IT
MOVE A,B ;PCL
ADJSP A,1 ;PCL See where it came from
CAMN A,JBUFP ;PCL Was it the top of the stack?
MOVEM B,JBUFP ;PCL Yes, just forget it
DG2: DMOVE A,GETARG ;NOW DO THE GET JSYS
GET
ERJMP R ;NON-SKIP ON FAILURE
RETSKP ;SKIP IF GOOD.
;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED --
; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES.
;CLOSES AND RELEASES JFNS STACKED IN JBUF.
;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0
; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN
; TO A SUBCOMMAND INPUT LOOP.
;Returns+1: A/ 0 success
; -1 failure
FLJFNS::ATSAVE
LDF D,CZ%ABT ;ABORT OUTPUT FILES
JRST RJFNS0
RLJFNS: SETZ D, ;BITS TO INCLUDE IN CLOSF
RJFNS0: STKVAR <RLERRF>
SETZM RLERRF ;NO ERROR YET
RJFNSP: MOVE C,JBUFP ;SCAN JFN BUFFER
CAMLE C,[IOWD JBUFL,JBUF] ;STOP AT BOTTOM OF STACK,
CAMN C,.JBUFP ;OR AT SAVED POINTER LEVEL
JRST RJDON ;DONE
CALL RJFN ;DELETE ONE JFN
MOVEM A,RLERRF ;REMEMBER WHETHER ERROR
JRST RJFNSP
RJDON: MOVE A,RLERRF ;RETURN ERROR INFO
RET
;ROUTINE TO GET RID OF TOP JFN ON STACK. COMMANDS THAT WANT TO GET
;RID OF A STACKED JFN SHOULD CALL THIS ROUTINE (RJFN).
;RETURNS+1: A/ 0 SUCCESS
; -1 FAILURE
RJFN:: CALL RJFNS2
MOVE C,JBUFP
ADJSP C,-1 ;DECREMENT POINTER
MOVEM C,JBUFP
RET
;PROCESS ONE WORD OF JBUF
;RETURNS+1: A/ 0 SUCCESS
; -1 FAILURE
RJFNS2: STKVAR <R2ERRF>
SETZM R2ERRF ;NO ERROR YET
MOVE C,JBUFP
HRRZ A,(C) ;GET A JFN TO CONSIDER
JUMPE A,RS2DON ;RETURN IF 0
CAIN A,FI%ERR ;BUFFERED ERROR?
JRST [ HLRZ A,(C) ;YES, GET ADDRESS OF ERROR BLOCK
HRRZ A,.FIJFN(A);GET PARSE-ONLY JFN
JRST .+1]
CALL SKPJFN ;SKIP IF THIS IS A JFN
JRST RJFNS9 ;IT'S A FORK
CAIE A,.PRIIN
CAIN A,.PRIOU
JRST RJFNS8
CALL NOTIO ;MAKE SURE JFN ISN'T AN IO JFN
JRST RJFNS8 ;IT IS!
GTSTS ;GET ITS STATUS
TXNN B,GS%NAM ;JFN EVEN EXIST?
JRST RJFNS8 ;INVALID, FORGET IT
HRRZ A,A ;PREPARE FOR RLJFN/CLOSF
TXNN B,GS%OPN ;IS IT OPEN?
JRST [ RLJFN ;NO, RELEASE IT
JRST RJFNE ;FAILED, GO ANALYZE
JRST RJFNS8] ;SUCCEEDED
HLL A,D ;GET BITS FOR CLOSF
CLOSF ;YES, CLOSE AND RELEASE
RJFNE: ERJMP [CALL RJFNER ;ANALYZE ERROR
MOVEM A,R2ERRF ;STORE ERROR INFO
JRST .+1]
;...
;DONE WITH THIS WORD
RJFNS8: HRRZ A,(C) ;CHECK AGAIN FOR STACKED ERRONEOUS FILESPEC
CAIN A,FI%ERR ;IS IT ONE?
JRST [ HLRZ A,(C) ;YES, GET POINTER TO BLOCK
MOVE A,.FISTR(A);GET POINTER TO BUFFERED FILESPEC
CALL STREM ;RELEASE FREE SPACE USED BY FILESPEC
MOVE C,JBUFP ;GET POINTER TO JFN STACK AGAIN
HLRZ B,(C) ;GET ADDRESS OF BLOCK
MOVEI A,.FILEN ;SAY HOW LONG IT IS
CALL RETBUF ;RETURN BLOCK TO FREE SPACE
MOVE C,JBUFP ;GET POINTER TO STACK AGAIN
JRST .+1]
SETZM (C) ;ZERO JBUF WORD
RS2DON: MOVE A,R2ERRF ;SHOW 0 FOR SUCCESS, -1 FOR ERROR
RET
;LARGE JFNS ARE ASSUMED TO BE FORK HANDLES
RJFNS9: CAMN A,FORK ;ARE WE KILLING MAIN FORK?
SETOM FORK ;YES, SO SAY FORK IS GONE
KFORK ;KILL THE FORK
ERJMP RJFNS8
JRST RJFNS8 ;CONTINUE
;ROUTINE TO SKIP IF WE'VE GOT A JFN
;
;ACCEPTS: A/ ANIMAL
;
;RETURNS: +1: ANIMAL IS NOT A JFN
; +2: ANIMAL IS A JFN
SKPJFN: CAIL A,MAXJFN ;1000 IS MAX FOR NOW
RET ;TOO LARGE, NOT A JFN
RETSKP
;ROUTINE WHICH SKIPS IFF JFN IN A IS NOT AN EXEC COMMAND JFN. CLOBBERS
;NOTHING
NOTIO:: ATSAVE ;DON'T CLOBBER ANY AC'S
MOVE B,TAKLEN ;GET POINTER TO COMMAND JFN STACK
RJFNSA: SOJL B,NPCLIO ;[PCL] When all entries have been scanned, see
; if JFN in use by PCL
HRRZ D,TAKJFN(B) ;GET OUTPUT JFN
CAMN A,D ;DOES JFN IN QUESTION MATCH A COMMAND OUTPUT JFN?
RET ;YES
HLRZ D,TAKJFN(B) ;NO, CHECK INPUT
CAMN A,D ;DOES JFN MATCH AN INPUT JFN?
RET ;YES
JRST RJFNSA ;NO, KEEP LOOKING
;ROUTINE TO DETERMINE IF ERROR FROM CLOSF IS OK
;OR CAN BE HANDLED
;RETURNS+1: A/ 0 SUCCESS
; -1 FAILURE
RJFNER: STKVAR <AERRF>
CALL GETERR ;GET THE ERROR CODE
SETZM AERRF ;NO ERROR YET
CAIE A,DESX3 ;YOU CAN GET "JFN IS NOT ASSIGNED" AFTER
;A LOWER EXEC HAS POPED BACK TO US, WHICH
;WE STARTED WITH A PUSH
;THIS IS BECAUSE WE STACKED THE JFN OF THAT
;EXEC, BUT MONITOR CLOSED THAT JFN DURING THE
;GET, AND THEN THE JFN GOT REUSED FOR A PROGRAM
;UNDER THE NEW EXEC. SO THE GTSTS CAN SAY THERE IS
;STILL A NAME ASSOCIATED WITH IT, ALTHOUGH IT
;IS BEING DELETED DUE TO
;THE KFORK IN THE PUSH CODE.
;...NOT TO MENTION THE FACT THAT THE JFN GOT
;REUSED AS A RESTRICTED JFN, WHICH WILL ALSO
;CAUSE DESX3. (ACTUALLY, MONITOR SHOULD BE
;FIXED TO GIVE A SPECIAL ERROR IN THAT CASE)
CAIN A,CLSX3 ;IGNORE PAGE STILL MAPPED
JRST AEDON
CAIE A,CLSX4 ;DEVICE STILL ACTIVE REQUIRES WORK
JRST [ HRRZ A,(C) ;GET JFN AGAIN
GTSTS ;GET INFO FOR DIAGNOSTIC
JRST RFAIL] ;MUSTN'T BOMB COMPLETELY, lest we loop
TYPE <% Device active - wait...>
MOVEI B,^D20 ;# OF HALF SECONDS
RJFNR1: MOVEI A,^D500 ;MS TO SLEEP
DISMS ;ZZZZZ
HRRZ A,0(C) ;GET JFN BACK
HLL A,D ;BITS TO SET
CLOSF ;TRY AGAIN
JRST RJFNR2 ;MORE PROCESSING TO COME
TYPE < [OK]
>
AEDON: MOVE A,AERRF ;RETURN ERROR INFO
RET
RFAIL: ETYPE <%@%%%Couldn't close JFN %1O, status %2O - %?%%_>
SETOM AERRF ;SAY ERROR
JRST AEDON
RJFNR2: CAILE B,1 ;GIVE UP IF TRIED MANY TIMES
CAIE A,CLSX4 ;CHECK SAME LOSAGE
JRST [ HRRZ A,(C) ;GET JFN AGAIN
GTSTS ;GET INFO FOR DIAGNOSTIC
JRST RFAIL] ;MUSTN'T BOMB COMPLETELY, lest we loop
SOJA B,RJFNR1 ;TRY AGAIN
;GNJFS - This routine, GNJFS, should be used wherever GNJFN%
;would have been employed to step a JFN. This is done to ensure
;that the case of GNJFN% failing and releasing the indexed JFN
;is properly handled with respect to the JFN stack. Failure to
;do this can cause the Exec to manipulate JFNs which it has
;actually released and may belong to another fork leading to
;many strange and wonderful kinds of misbehaviors. GNJFS behaves
;exactly like GNJFN% with respect to returns and accumulator
;usage.
GNJFS:: STKVAR <GNJFA,GNJFER,<GNJFBC,2>,GNJSKP> ;ALLOCATE SOME STORAGE
MOVEM A,GNJFA ;SAVE THE AFFECTED ACS
DMOVEM B,GNJFBC
SETZM GNJSKP ;INDICATE NON SKIP RETURN
MOVE A,GNJFA ;GET OUR ARGUMENT
GNJFN% ;STEP IT
ERJMP GNJFSE
AOS GNJSKP ;BUMP THE SKIP RETURN FLAG
GNJFS1: DMOVE B,GNJFBC ;RECOVER (B) AND (C)
SKIPN GNJSKP ;SKIP RETURN?
RET ;NO, FAILURE RETURN
RETSKP ;OTHERWISE, SUCCESS
GNJFSE: CALL PIOFF ;GO CRITICAL
MOVEM A,GNJFER ;SAVE THE ERROR CODE
HRRZ A,GNJFA ;GET THE JFN AGAIN
MOVE B,JBUFP ;SET UP TO SEARCH JFN STACK
GNJFSL: CAMN B,[IOWD JBUFL,JBUF] ;OFF TOP OF STACK?
JRST GNJFS2 ;YES, DON'T LOOK ANY MORE FOR IT
HRRZ C,(B) ;GET THE JFN ONLY FROM THE STACK
CAME A,C ;IS IT THE ONE WE'RE DOING?
JRST [ADJSP B,-1 ;NO, POP UP ONE
JRST GNJFSL] ;CONTINUE LOOKING
MOVE A,GNJFER ;GET THE ERROR CODE AGAIN
CAIN A,GNJFX1 ;NO MORE FILES?
CAMN B,[IOWD JBUFL,JBUF] ;AND NOT AT TOP OF STACK?
SKIPA ;NO TO EITHER, NO JFN ENTRY TO CLEAR
SETZM (B) ;CLEAR THE JFN STACK ENTRY FOR RELEASED JFN
GNJFS2: CALL PION ;ALLOW INTERRUPTS
JRST GNJFS1 ;GO FINISH UP
;ROUTINE TO STACK JFNS OR FORK, CHECKS FOR SPACE FIRST
JFNSTK::MOVE B,A ;JFN IN B
HLRZ A,JBUFP
CAIN A,-1
ERROR <Too many JFNs in command>
MOVE A,JBUFP
PUSH A,B ;STACK JFN
MOVEM A,JBUFP
HRRZ A,B ;GET RID OF FLAGS
CALL SKPJFN ;IS THIS REALLY A JFN?
CAIA ;NO
MOVE A,B ;RETURN JFN OR FORK IN A
RET
;PCL ROUTINE TO UNSTACK THE TOP JFN IN THE JFN STACK.
;RETURNS THE JFN IN A. DESTROYS NO REGISTERS.
JUNSTK::PUSH P,B ;SAVE B
MOVE B,JBUFP ;GET THE STACK POINTER
POP B,A ;POP THE JFN INTO A
MOVEM B,JBUFP ;SAVE THE STACK POINTER
POP P,B ;RESTORE B
RET ;AND RETURN
;ROUTINE TO DO GTJFN AND STACK THE JFN. THIS SHOULD BE USED WHEREVER
;A JFN IS NEEDED DURING COMMAND EXECUTION, IN ORDER THAT THE JFN BE
;GUARANTEED TO BE FREED IF THE USER ^C'S OUT OF THE COMMAND.
;THIS ROUTINE SKIPS AND CLOBBERS 1 AND 2 EXACTLY AS GTJFN DOES, EXCEPT
;THAT ERJMP AFTER THE CALL TO THIS ROUTINE WILL NOT WORK (USE JRST).
;(IF YOU FIND PLACES WHERE THE EXEC DOES GTJFN FOLLOWED BY A CALL TO
;JFNSTK, YOU SHOULD CHANGE THEM TO CALL GTJFS INSTEAD)
GTJFS:: STKVAR <<GTDATA,2>>
DMOVEM A,GTDATA ;SAVE THE GTJFN DATA
AOS CLZFFF ;IF ^C BEFORE JFN STACKED, CAUSE CLZFF
GTJFN ;DO THE GTJFN
ERJMP GTFAIL ;FAILED
DMOVEM A,GTDATA ;SAVE RESULTANT DATA
CALL JFNSTK ;STACK THE JFN
SOS CLZFFF ;CLZFF NO LONGER NEEDED SINCE JFN IS STACKED
DMOVE A,GTDATA ;GET WHAT GTJFN RETURNED
RETSKP ;SAY SUCCESS
GTFAIL: CALL GETERR ;GET THE ERROR CODE
DMOVEM A,GTDATA ;SAVE WHAT FAILING GTJFN RETURNED
SOS CLZFFF ;GTJFN FAILED, CLZFF NOT NEEDED
DMOVE A,GTDATA ;GET WHAT GTJFN SAID (ABOUT FAILURE)
RET ;ERROR RETURN
;ROUTINE TO PRINT JOBS ACCOUNTING STRING (OR NUMBER)
PRACCT::STKVAR <<ACCBUF,EXTSIZ>>
HRROI B,ACCBUF ;POINT TO ACCOUNT BUFFER
MOVNI A,1 ;-1 FOR SELF
GACCT ;GET IT
LDB A,[410300,,B] ;GET SIG. OCTAL DIGIT
CAIE A,5 ;5 MEANS NUMBER INSTEAD OF STRING
JRST [HRROI A,ACCBUF ;POINT TO STRING
ETYPE <%1M> ;DUMP IT
RET]
TLZ B,500000 ;GET RID OF CONTROL BITS
ETYPE <%2Q> ;DECIMAL
RET ;RETURN
;%ETYPE (ETYPE MACRO, UETYPE UUO)
;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES.
;SPECIAL CODES ARE OF FORM %NL%
; WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC
; L IS A LETTER:
; D: TYPE CURRENT DATE
; J: TYPE TSS JOB #
; O: TYPE CONTENTS OF INDICATED AC IN OCTAL
; SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.
EBLN==50 ;BUFFER SIZE FOR CHARACTERS DURING ETYPE
; NOTE: STATF (BELOW) IS USED TO FORCE A REENTRY INTO THE PARSE
; CODE AFTER AN AC IS PARSED.
%ETYPE: TRVAR <<ETBFR,EBLN>,<RACS,5>,ETPTR,SRCPTR,ETYPF,EDAT,STATF,AC%B,AC%C,AC%D>
SETZM STATF ;ZERO STATE FLAG
MOVEM Z,RACS ;SAVE REAL AC'S AWAY
DMOVEM A,1+RACS
DMOVEM C,3+RACS
HLRZ A,40 ;SEE WHICH INSTRUCTION
SETOM ETYPF ;FIRST ASSUME ETYPE
CAIE A,<UETYPE>B53 ;MAYBE REGULAR TYPE
SETZM ETYPF ;YES
CALL %GETER ;GET ERROR CODE IN CASE "%?"
HRRZ A,40
CAIG A,17 ;PRINTING TEXT FROM TEMP AC?
ADDI A,RACS ;YES, POINT TO SAVED BLOCK
HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR FROM EFF ADDR
MOVEM A,SRCPTR ;REMEMBER SOURCE POINTER
MOVEI A,ETBFR ;CREATE POINTER TO BUFFER FOR CHARACTERS
HRLI A,440700
MOVEM A,ETPTR ;DIVERT OUTPUT TO TEMPORARY BUFFER
ETYP2: HRRZ A,ETPTR ;GET CURRENT OUTPUT ADDRESS
CAIL A,-10+EBLN+ETBFR ;GETTING NEAR END OF BUFFER?
CALL EDMP ;YES, DUMP BUFFER
ILDB B,SRCPTR ;NEXT CHARACTER
ETYP2A: JUMPE B,ETYPDN ;IF NULL, STRING IS DONE
SKIPE ETYPF ;% IS NOT SPECIAL UNLESS ETYPE
CAIE B,"%"
JRST [ IDPB B,ETPTR ;NOT A %, BUFFER IT
JRST ETYP2]
CALL EDMP ;OUTPUT BUFFERED STUFF PRECEDING THE %
;%ETYPE...
;"%" SEEN
ETYP3: ILDB B,SRCPTR ;GET THE CHARACTER AFTER PERCENT
ETYP4: SKIPN STATF ;SKIP IF WE JUST PARSED AC #
SETZM D ;D=NONZERO MEANS AC SPECIFIED
SETZM STATF ;RESET STATE FLAG
CAIGE B,040 ;ASCII SPACE OR GREATER?
CALL %ILOP ;NO, ILLEGAL OPERAND, CALL AND DON'T RETURN
MOVEI A,-40(B) ;(1) SUBTRACT 40 TO ALLOW FOR MISSING CTL CHARS
;(2) LEAVE THE CHAR INTACT IN AC-B
HRRZ A,%LETS(A) ;GET ADDRESS OF ROUTINE
CALL (A) ;DO THE WORK
;RETURN FROM DISPATCH
SKIPE STATF ;ARE WE IN NEXT STATE?
JRST ETYP4 ;YES
MOVE C,SRCPTR ;SAVE COPY
ILDB B,C ;NEXT CHARACTER
CAIN B,"%" ;PASS FOLLOWING %
MOVEM C,SRCPTR
JRST ETYP2 ;NO, CONTINUE TYPING
ETYPDN: CALL EDMP ;DUMP LAST BUFFERFUL
DMOVE Z,RACS ;RESTORE AC'S
DMOVE B,2+RACS
MOVE D,4+RACS
RET ;ALL DONE
;EDMP DUMPS BUFFER ONTO ACTUAL OUTPUT DEVICE
EDMP: MOVEI A,0 ;GUARANTEE NULL
IDPB A,ETPTR
MOVE A,COJFN ;OUTPUT TO REAL JFN
HRROI B,ETBFR ;FROM OUR BUFFER
MOVEI C,0 ;STOP ON NULL
SOUT ;SEND THE DATA
MOVEM A,COJFN ;UPDATE JFN IN CASE BYTE POINTER
MOVEI A,ETBFR ;RECONSTRUCT BYTE POINTER TO BUFFER
HRLI A,440700
MOVEM A,ETPTR
RET
;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER %
;THIS IS AN ASCII DISPATCH TABLE MINUS THE CONTROL CHARACTERS
%LETS: %ILOP ;( ) PERMANENTLY UNASSIGNED
%EXTND ;(!) EXTEND OPERATOR
%UNAS ;(") UNASSIGNED
%NUMS ;(#) OCTAL NUMBER AS N OR N,,N AS APPROPRIATE
%UNAS ;($) UNASSIGNED
%PER ;(%) %% JUST PRINTS A PERCENT
%UNAS ;(&) UNASSIGNED
%SIX ;(') PRINT CONTENTS OF AC IN SIXBIT
%UNAS ;"(" UNASSIGNED
%UNAS ;")" UNASSIGNED
%UNAS ;(*) UNASSIGNED
%UNAS ;(+) UNASSIGNED
%UNAS ;(,) UNASSIGNED
%UNAS ;(-) UNASSIGNED
%UNAS ;(.) UNASSIGNED
%EXPR ;(/) EXPRESSION IN AC
%AC ;(0) DIGIT
%AC ;(1) DIGIT
%AC ;(2) DIGIT
%AC ;(3) DIGIT
%AC ;(4) DIGIT
%AC ;(5) DIGIT
%AC ;(6) DIGIT
%AC ;(7) DIGIT
%AC ;(8) DIGIT
%AC ;(9) DIGIT
%UNAS ;(:) UNASSIGNED
%UNAS ;(;) UNASSIGNED
%ILOP ;(<) PERMANENTLY UNASSIGNED
%FLT ;(=) SIX-COLUMN FLOATING POINT NUMBER, NN.MM
%ILOP ;(>) PERMANENTLY UNASSIGNED
%SYSMS ;(?) ERROR MESSAGE (CONTENTS OF AC OR LATEST)
%LM ;(@) GET TO LEFT MARGIN
%A ;(A) CURRENT TIME
%B ;(B) CPU TIME AS HH:MM:SS, OR SPECIFIC TIME
; IN MILLISECONDS
%C ;(C) CONNECT TIME
%D ;(D) CURRENT DATE(OR SPECIFIC DATE)
%E ;(E) SAME TIME AS LAST %D(OR SPECIFIC TIME)
%F ;(F) "FORK N " IF >1 INFERIOR
%G ;(G) CONNECTED DIR NAME
%H ;(H) DEVICE NAME FOR DESIGNATOR IN INDICATED AC
%I ;(I) PRINT # OF USER JOBS + # OF OPR JOBS
%J ;(J) TSS JOB #
%K ;(K) UPTIME
%L ;(L) "LINE N" OR "DETACHED"
%M ;(M) NUMBER OR STRING (5B0+N OR BYTE POINTER)
%N ;(N) NAME UNDER WHICH USER IS LOGGED IN
; (OR SPECIFIC USER NAME)
%O ;(O) CONTENTS OF SPECIFIED AC IN OCTAL
%P ;(P) CONTENTS OF RIGHT HALF OF SPECIFIED AC IN OCTAL
%Q ;(Q) CONTENTS OF AC IN DECIMAL OR FLOATING!
%R ;(R) DIRECTORY NAME FOR DIR # OR STRING POINTER IN AC
%S ;(S) FILE NAME FOR JFN IN AC
%T ;(T) CONTENTS OF AC AS PERCENTAGE OF UP TIME
%U ;(U) DECIMAL BIT NUMBERS, SEPARATED BY COMMAS
%V ;(V) CPU TIME WITH TENTHS OF SECONDS
; (FORK HANDLE IN AC IF NOT 0)
%W ;(W) STD FORMAT DATE AND TIME IN AC
%X ;(X) TYPE ILLEG INST ERROR MSG
%Y ;(Y) MEMORY ADDRESS
%Z ;(Z) TYPE "," <SPACE><SPACE>...
%UNAS ;([) UNASSIGNED
%STRNG ;(\) TYPE STRING OR CHAR IN AC
%UNAS ;(]) UNASSIGNED
%UNAS ;(^) UNASSIGNED
%EOL ;(_) TYPE A CRLF
%SIX ;(') PRINT CONTENTS OF AC IN SIXBIT
%AA ;(a) TYPE OUT 3-DIGIT OCTAL NUMBER WITH LEADING ZEROES
%BB ;(b) TYPE OUT CURRENT CONTENTS OF ATOM BUFFER
%UNAS ;(c) UNASSIGNED
%UNAS ;(d) UNASSIGNED
%UNAS ;(e) UNASSIGNED
%UNAS ;(f) UNASSIGNED
%UNAS ;(g) UNASSIGNED
%UNAS ;(h) UNASSIGNED
%UNAS ;(i) UNASSIGNED
%UNAS ;(j) UNASSIGNED
%UNAS ;(k) UNASSIGNED
%UNAS ;(l) UNASSIGNED
%UNAS ;(m) UNASSIGNED
%UNAS ;(n) UNASSIGNED
%UNAS ;(o) UNASSIGNED
%UNAS ;(p) UNASSIGNED
%UNAS ;(q) UNASSIGNED
%UNAS ;(r) UNASSIGNED
%UNAS ;(s) UNASSIGNED
%UNAS ;(t) UNASSIGNED
%UNAS ;(u) UNASSIGNED
%UNAS ;(v) UNASSIGNED
%UNAS ;(w) UNASSIGNED
%UNAS ;(x) UNASSIGNED
%UNAS ;(y) UNASSIGNED
%UNAS ;(z) UNASSIGNED
%UNAS ;({) UNASSIGNED
%UNAS ;(|) UNASSIGNED
%UNAS ;(}) UNASSIGNED
%UNAS ;(~) UNASSIGNED
%ILOP ;(DEL) PERMANENTLY UNASSIGNED
LETLEN==.-%LETS
;UNRECOGNIZED %-CODE
%ILOP:
%UNAS: TYPE <%> ;DIGIT, IF ANY, IS LOST.
POP P,A ;POP THE STACK AND DISCARD
JRST ETYP2A ;CONTINUE TYPING, STARTING WITH CHAR AFTER %.
;THIS ROUTINE IS LEFT FOR A POSSIBLE EXPANSION OF THE DISPATCH TABLE
;IN WHICH THE LEFT HALF WOULD CONTAIN A NEW SERIES OF DISPATCH ADDRESSES
%EXTND: RET
;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE.
;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY.
;%AC EXTRACTS AC VALUE IF AN AC WAS SPECIFIED
;AND LEAVES CONTENTS OF AC IN C
%AC:
SETOM STATF ;INDICATE NEXT NON-NUMERIC IS A DISPATCH CHAR
SETZB C,D ;C: IF NO NUMBER, USE 0 IN PLACE OF AC CONTENTS
;D: INIT NUMBER TO 0.
%AC1: IMULI D,10
ADDI D,-"0"(B) ;ADD NEW DIGIT TO NUMBER
MOVE C,D ;COMPUTE LOCATION TO GET AC FROM...
CAIG C,D ;...AC'S 5-9 ARE PRESERVED,
ADDI C,RACS ;...CONTENTS OF 0-4 ARE IN PUSHDOWN.
MOVE C,(C) ;FETCH CONTENTS OF AC INDICATED BY NUMBER SO FAR
ILDB B,SRCPTR ;GET NEXT CHARACTER
CAIG B,"9"
CAIGE B,"0"
RET
JRST %AC1 ;GO CHECK FOR ADDITIONAL DIGIT(S)
;%% JUST PRINTS A %
%PER: PRINT "%"
RET
;CURRENT TIME
%A: GTAD ;GET CURRENT DATE & TIME
A1: MOVX C,OT%NDA ;TIME ONLY
A2: MOVE B,A
MOVE A,COJFN
CAMN B,[-1] ;DOES SYSTEM HAVE DATE & TIME?
HRLZI B,1 ;CHANGE TO CALL SCREWUP ________
ODTIM
MOVEM A,COJFN ;SAVE UPDATED POINTER
RET
;GET TO LEFT MARGIN
%LM: CALLRET LM
;CPU TIME USED. ALSO SEE %V.
%B: SKIPE A,C ;SPECIFIC TIME SUPPLIED?
JRST [ IDIVI A,^D1000 ;YES, CHANGE TO SECONDS
JRST TOUT] ;PRINT AS HH:MM:SS
HRROI A,-5 ;SAY WHOLE JOB
RUNTM
%B1: IDIV A,B ;CONVERT TO SECS
JRST TOUT ;TYPE AS H:MM:SS
;CONSOLE TIME USED
%C: HRROI A,-5
RUNTM
MOVE A,C
JRST %B1
;DATE
%D: SKIPN A,C ;USE GIVEN QUANTITY IF ANY
GTAD ;GET CURRENT DATE & TIME FROM SYSTEM
MOVEM A,%EDAYT ;SAVE FOR %E
MOVX C,OT%NTM!OT%SCL ;DATE ONLY, STANDARD CONCISE FORMAT
JRST A2 ;GO PRINT DATE
;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE.
%E: SKIPN A,C ;IF SPECIFIC TIME GIVEN, USE IT
MOVE A,%EDAYT
JRST A1 ;SEE %A
;ETYPE'S % ROUTINES ...
;TYPE "FORK N " ONLY IF THIS EXEC HAS >1 INFERIORS.
; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "RFORK".
;FIRST READ FORK STRUCTURE TO FIND OUT HOW MANY FORKS THERE ARE.
%F: MOVEI A,.FHSLF ;SAY START AT SELF
MOVX B,GF%GFH ;ASSIGN FORK HANDLES
MOVE C,[-300,,BUF0] ;WHERE TO PUT FORK STRUCTURE
GFRKS ;GET FORK STRUCTURE
CALL [ CAIE 1,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
POP P,(P)
JRST %F1] ;PRINT ANYWAY
HRRZ A,(B) ;PTR TO INFERIOR
MOVE A,(A) ;XWD ITS PARELLEL, ITS INFERIOR
JUMPE A,%F2 ;[3063]NEITHER EXISTS, ITS ONLY ONE, PRINT NOTHING.
%F1: TYPE <Fork >
SKIPG B,C ;USE GIVEN HANDLE IF AC W >0 CONTENTS GIVEN
MOVE B,FORK ;ELSE HANDLE OF LAST RUN FORK
TRZ B,(1B0) ;PRINT ## NOT 4000##.
CALL TOCT ;OCTAL OUTPUT FROM B
PRINT " "
%F2: MOVEI A,BUF0 ;[3063]Get address of GFRKS% block
CALL RELHAN ;[3063](A/)Release unwanted fork handles
RET
;DEVICE NAME FOR DESIGNATOR IN INDCATED AC.
%H: MOVE A,C
DVCHR ;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR
ERCAL JERR ;CM236
MOVE B,A
MOVE A,COJFN
DEVST ;DEVICE TO STRING
CALL JERR
MOVEM A,COJFN ;SAVE IN CASE POINTER
RET
;NUMBER OF USERS ON SYSTEM.
;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1.
%I: CALL USRCNT
PUSH P,A ;SAVE OPR JOB COUNT
MOVE A,COJFN
MOVEI C,^D10
NOUT ;PRINT NUMBER
CALL JERRC ;GENERAL JSYS ERROR ROUTINE FOR ERR COD IN C
MOVEI B,"+" ;SEPARATE USER/OPR JOBS
BOUT
POP P,B ;GET COUNT OF OPR JOBS
NOUT ;PRINT IT
CALL JERRC
MOVEM A,COJFN ;SAVE IN CASE POINTER
RET
USRCNT::MOVSI A,(RC%EMO) ;EXACT MATCH ONLY
HRROI B,[ASCIZ /OPERATOR/]
RCUSR ;GET DIRNUM OF OPERATOR
TLNE A,(RC%NOM+RC%AMB) ;COULDN'T?
MOVEI C,-1 ;NO, SO USE -1
PUSH P,C ;SAVE IT FOR COMPARES BELOW
SETZB B,C ;COUNTER
HLLZ D,JOBRT ;SET UP AOBJN PTR
GTB .JOBRT
JUMPL A,%I1 ;NO JOB 0
GTB .JOBTT
JUMPL A,%I3 ;IGNORE DETACHED JOB 0
%I1: GTB .JOBRT ;TABLE 1 IS POSITIVE IF JOB EXISTS
JUMPL A,%I3
CALL USERNO ;GET USER NUMBER
JUMPE A,%I3 ;SKIP JOB IF NOT LOGGED IN
CAMN A,0(P) ;LOGGED IN AS 'OPERATOR'?
AOJA C,%I3 ;YES, COUNT OPERATOR JOBS
AOS B ;COUNT REGULAR JOBS
%I3: AOBJN D,%I1
MOVE A,C
POP P,(P)
RET
;UPTIME
%K: TIME ;TIME SINCE SYSTEM RESTARTED
IDIV A,B ;CONVERT TO SECONDS
CALLRET TOUT ;PRINT AS HH:MM:SS AND RETURN
;ETYPE's % routines ...
;%L takes .TTDES+n or no arg (or 0) for controlling terminal.
;%L will output output "TTYn", "TTYn org(typ)" or "Detached".
%L: STKVAR <<NTBLK,.NWNU1+2>,<HSTNAM,20>> ;[4419] NTINF storage
IFE. C ;[4425] If no AC or 0 specified do this job
GJINF% ;[4419] Get information about the job
MOVEI C,.TTDES(D) ;[4425] Load terminal number to C
ENDIF. ;[4425] End of defaulting code
IFL. C ;[4419] Detached?
UTYPE [ASCIZ /Detached/] ;[4419] Yes say so
RET ;[4419] and return
ENDIF. ;[4419] Not detached
MOVEM C,.NWLIN+NTBLK ;[4419] Want this terminal's location
UTYPE [ASCIZ/TTY/] ;[4419] Spread TTY
MOVEI B,-.TTDES(C) ;[4425] Get just the number for TOCT
CALL TOCT ;[4419] (B/) Type octal from B
SETZM HSTNAM ;[4419] Clear this out
MOVEI B,.NWNU1+1 ;[4419] Size of argument block
MOVEM B,.NWABC+NTBLK ;[4419] Save it in the right place
SETZM .NWFNC+NTBLK ;[4419] Clear out function (func=0)
HRROI B,HSTNAM ;[4419] Remote goes here
MOVEM B,.NWNNP+NTBLK ;[4419] Save in argument block
MOVEI A,NTBLK ;[4419] Here's the argument block
NTINF% ;[4419] Get information
ERJMP R ;[4419] Return now if old monitor
SKIPN HSTNAM ;[4419] Do we have a host?
RET ;[4419] Nope, return
UTYPE [ASCIZ/ /] ;[4419] Output a space
UTYPE HSTNAM ;[4419] Output host name
HRRZ B,.NWTTF+NTBLK ;[4419] (no symbol for this field) Get type
MOVSI A,-%L%SIZ ;[4419] Load number of things in table,,0
DO. ;[4419] Loop for things in table
HRRZ C,%L%TAB(A) ;[4419] Load type of connection from table
CAMN C,B ;[4419] Match the type we want to hear about?
EXIT. ;[4419] Yes
AOBJN A,TOP. ;[4419] Loop for all of them
RET ;[4419] Unknown type, just return
OD. ;[4419] End of loop
HLRO B,%L%TAB(A) ;[4419] Match, load address of text
UTYPE (B) ;[4419] Output the type text
RET ;[4419] and return
;[4419] Table of network connection types for above code.
%L%TAB: XWD [ASCIZ/(NRT)/],NW%MC ;[4419] MCB (NRT) terminal
XWD [ASCIZ/(TCP)/],NW%TV ;[4419] TVT (TCP) terminal
XWD [ASCIZ/(CTM)/],NW%CH ;[4419] CTERM terminal
XWD [ASCIZ/(LAT)/],NW%LH ;[4419] LAT terminal
%L%SIZ==.-%L%TAB ;[4419] Make size of table
ENDSV. ;[4419] End of STKVAR at %L
;ETYPE'S % ROUTINES ...
;TAKES 5B2+NUMBER, OR STRING POINTER, IN INDICATED AC
%M: MOVE A,COJFN
LDB B,[POINT 3,C,2]
CAIE B,5
JRST [ MOVE B,C
SETZ C,
SOUT
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET]
MOVE B,C
TLZ B,700000
MOVEI C,^D10
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N.
%G: GJINF
JRST %N1
;USER (DIRECTORY) NAME LOGGED IN UNDER.
%N: SKIPN A,C ;USE SPECIFIC USER NAME IF GIVEN
GJINF
MOVE B,A ;LOGIN DIRECTORY NO
%N1: MOVE A,COJFN
DIRST
ERJMP DIRSTB ;THE DIRST FAILED
MOVEM A,COJFN ;UPDATE IN CASE BYTE POINTER
RET
DIRSTB: PRINT "?" ;R1: UNASSIGNED DIR #, NO SYST ERR # IN A.
RET
;ETYPE'S % ROUTINES...
;OCTAL NUMBER IN SPECIFIED AC.
%O: MOVE B,C
JRST TOCT ;TYPE OCTAL FROM B
%STRNG: HLRZ A,C ;GET PNTR LHS
JUMPE A,%CHAR ;IF NO POINTER THEN CHARACTER RJ
CAIE A,-1 ;CHECK FOR -1,,
CAIN A,(<POINT 7,,>) ; OR 440700
CAIA
RET ;RETURN IF CRAP
HRLI C,(<UETYPE>) ;FORM LUUO
PUSH P,C ;SAVE IT
MOVE Z,RACS ;RESTORE ACS
DMOVE A,1+RACS
DMOVE C,3+RACS
XCT 0(P) ;DO IT
POP P,C ;PRUNE PDL
RET ;RETURN
%CHAR: SKIPN B,C ;GET CHARACTER
RET ;RETURN IF NULL
CALLRET COUTC ;TYPE IT AND RETURN
;SIXBIT OF DATA IN AC
%SIX: MOVE A,[440600,,C] ;POINTER TO SIXBIT DATA
MOVEI D,0 ;NULL TO CLEAR CHARACTERS AS WE PRINT THEM
SIX1: TLNN A,770000 ;HAVE WE DONE ALL SIX CHARACTERS YET?
RET ;YES
ILDB B,A ;NO, GET ONE
DPB D,A ;CLEAR OUT CHARACTER WE JUST READ
JUMPN B,SIX2 ;IF CHARACTER IS NON-0, ALWAYS PRINT IT
JUMPE C,R ;IF CHARACTER IS 0, PRINT IT UNLESS IT'S A TRAILING SPACE
SIX2: ADDI B,40 ;CHANGE TO ASCII
PRINT @B ;PRINT CHARACTER
JRST SIX1 ;GO BACK FOR REST
;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC
%P: HRRZ B,C
JRST TOCT
;FLOATING POINT NUMBER
%FLT: MOVE B,C ;GET NUMBER
JRST %Q2
;TSS JOB NUMBER. MUST PRECEDE %Q.
%J: GJINF ;GETS JOB # IN C
;FLOATING PT OR DECIMAL NUMBER FROM AC.
;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100<Q1<377
%Q: MOVE B,C
MOVM C,B
TLNE C,700000 ;EXPONENT .GE. 100?
TLNN C,400 ;NORMALIZED?
JRST %Q1 ;NO, PRINT DECIMAL
LDB C,[POINT 9,C,8] ;GET EXPONENT
CAIN C,377 ;SPECIAL INFINITY?
JRST [ TYPE <+INF> ;YES - SAY SO
RET]
%Q2: MOVE A,COJFN
;THE FOLLOWING FORMAT WORD WILL USE 6 PLACES FOR NUMBERS LESS THAN
;1000. OTHERWISE, IT GOES TO 'FREE' FORMAT AND USES WHATEVER NECESSARY.
MOVE C,[FL%ONE+FL%PNT+FL%OVL+FLD(3,FL%FST)+FLD(2,FL%SND)]
FLOUT
CALL [ CAIE C,FLOTX1 ;COLUMN OVERFLOW?
JRST JERRC ;NO, SOMETHING UNEXPECTED
POP P,C ;YES, THAT'S OK
JRST .+1]
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
%Q1: MOVEI C,^D10 ;RADIX TO USE
MOVE A,COJFN
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;FLOAT THE INTEGER IN A
FLOAT: IDIVI A,400000 ;BREAK NUMBER INTO TWO PARTS
FSC A,254 ;CONVERT HIGH PART
FSC B,233 ;CONVERT LOW PART
FADR A,B ;COMBINE PARTS
RET
;RETURN USER NUMBER IN A OF JOB # IN D
;RETURNS 0 IF THE JOB IS NOT LOGGED IN!
USERNO::PUSH P,B
PUSH P,C ;CLOBBER NOTHING
HRROI B,A ;DIRECT OUTPUT TO LOCATION A
HRRZ A,D ;GET JOB #
MOVEI C,.JIUNO ;SPECIFY USER NUMBER REQUESTED
GETJI ;GET THE USER NUMBER
JRST USERN1 ;FAILED, GO SEE WHY
USERN2: POP P,C
POP P,B
RET
USERN1: CAIE A,GTJIX4 ;"JOB NOT LOGGED IN" ERROR?
CALL JERR ;NO, OTHER. UNEXPECTED
MOVEI A,0 ;YES, SO RETURN 0.
JRST USERN2
;DIRECTORY NAME FOR NUMBER IN AC
%R: CAMN C,[-1]
JRST %G ;-1 = CONNECTED
LDB B,[POINT 3,C,2] ;SEE IF THIS IS A NUMBER
CAIE B,5 ;OR IF IT IS A STRING POINTER
JRST %M ;STRING POINTER
MOVE B,C
JRST %N1
;FILE NAME FOR JFN IN AC
%S: MOVE A,COJFN
MOVE B,C
SETZ C,
JFNS
ERJMP %S1 ;ERROR - CHECK IT OUT
MOVEM A,COJFN ;UPDATE IN CASE BYTE POINTER
RET
%S1: CALL JFNSIL ;ANALYZE THE ERROR
JRST JERR ;STRANGE ERROR
RET ;"GOOD" ERROR
;JFNSIL ANALYZES JFNS ERROR. IF IT RECOGNIZES THE ERROR, IT PRINTS OUT
;THE EXPLANATION AND SKIP RETURNS.
;IF IT DOESN'T RECOGNIZE THE ERROR, IT GIVES A NON-SKIP RETURN.
JFNSIL::CALL %GETER
HRRZ A,B
GTSTS
MOVE A,ERCOD
CAIN A,DESX3 ;RESTRICTED JFN ERROR?
JRST [ TYPE < Restricted JFN>
RETSKP]
TXNN B,GS%NAM ;DOES JFN HAVE NAME?
RET ;NO - JUST RETURN ERROR CODE
CAIN A,GJFX24 ;YES - IS THE FILE GONE?
JRST [ TYPE < Nonexistent file>
RETSKP]
RET ;NON-SKIP TO DENOTE STRANGE ERROR
;CONTENTS OF AC AS PERCENTAGE OF UP TIME
%T: TIME ;GET UPTIME IN A
MULI C,^D200
DIV C,A ;HOPE DIVISORS TO CONVERT TO SECS ARE SAME
ADDI C,1 ;ROUND
LSH C,-1
CALL %Q ;PRINT IN DECIMAL
PRINT "%"
RET
;ETYPE'S % ROUTINES...
;CONTENTS OF AC AS LIST OF DECIMAL NUMBERS FOR SET BITS,
; OR "NONE" IF AC 0.
%U: JUMPE C,[UTYPE [ASCIZ /None/]
RET]
SETZ D, ;BIT NUMBER
;FIND FIRST SET BIT
TLNE C,(1B0)
JRST %U2
LSH C,1
AOS D
JRST .-4
;LOOP FOR SUCCESSIVE BITS
%U1: TLNN C,(1B0)
JRST %U3
PRINT "," ;COMMA (AND SPACE) BEFORE ALL BUT FIRST
MOVE A,COJFN
RFPOS
MOVEI B,(B)
CAIL B,^D55
ETYPE<%_> ;EOL IF TOO FAR RIGHT
PRINT " "
%U2: ETYPE <%4Q> ;BIT # IN DECIMAL
%U3: AOJ D,
LSH C,1
JUMPN C,%U1
RET
;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB.
%V: SKIPE D ;IF AC SPECIFIED
SKIPA A,C ;THEN IT IS FORK HANDLE
HRROI A,-5 ;SAY WHOLE JOB
RUNTM
MOVE C,B ;TICKS PER SECOND
IDIV A,B ;CONVERT TIME IN TICKS TO SECS
CALL TOUT ;TYPE H:MM:SS
IDIVI C,^D10 ;GET TICKS PER 1/10 SEC
JUMPN D,[RET] ;NOT EVEN, DON'T PRINT TENTHS OF SECS
IDIV B,C ;CONVERT REMAINDER OF TICKS TO TENTHS
ETYPE <.%2Q> ;TYPE TENTHS OF SECONDS
RET
;PRINT C(AC) AS DATE AND TIME
;[4420] If supplied date time is zero, print "Never"
%W: MOVE A,COJFN ;[4420] Load the usual output JFN
SKIPE B,C ;[4420] Arg supplied in C, was it zero?
IFSKP. ;[4420] Yes, it was zero
HRROI B,[ASCIZ/Never/] ;[4420] Never say never, just display it
SETZ C, ;[4420] Terminate on a null
SOUT ;[4420] Send that along slowly please
ERJMP .+1 ;[4420] Avoid problem if owie byte pointer
MOVEM A,COJFN ;[4420] Save it back incase a pointer
RET ;[4420] and return
ENDIF. ;[4420] Argument was nonzero, its a date time
MOVX C,OT%SCL ;[4421] Suppress columnization please
ODTIM ;Output the date and time
MOVEM A,COJFN ;UPDATE COJFN IF BYTE POINTER
RET
;ETYPE's % routines...
;ARGUMENT TO %NX IS HANDLE OF A PROCESS STOPPED BECAUSE OF AN
;ILLEGAL INSTRUCTION. TYPE THE INSTRUCTION, THE PC, AND IF THE
;INSTRUCTION WAS A JSYS, THE ASSOCIATED SYSTEM MESSAGE. THOUGH THE
;PC COULD BE FOUND BY DOING A LONG RFSTS HERE, CALLERS HAVE DONE IT,
;LEAVING IT IN LRFSTS+.RFPPC.
%X: PUSH P,FORK ;SAVE GLOBAL FORK HANDLE
CALL PIOFF ;NO ^C WHILE FORK CELL IS WRONG
CAIN C,0 ;ANY FORK GIVEN?
MOVE C,FORK ;NO, USE CURRENT
SKIPLE EFORK ;USE EPHEMERAL IF PRESENT
MOVE C,EFORK
MOVEM C,FORK ;TEMP STORE FOR MAPPF CALL
SETZM SYMOKF ;FORCE SYMBOL TABLE INITIALIZATION FOR FORK BEING DISPLAYED
MOVE C,LRFSTS+.RFPPC ;GET PC OF PROCESS
HRRI C,-1(C) ;GET PC OF OFFENDING INSTRUCTION, BUT
MOVE A,C ; BY SUBTRACTING WITHOUT CARRY FROM LH
CALL LOADF ;GET CONTENTS OF PC
JRST %X1 ;CAN'T READ INSTRUCTION-- DON'T PRINT IT
ETYPE <%1/ at %3Y>
HLRZS A ;GET OPCODE TO SEE IF IT'S A JSYS
CAIN A,<JSYS>B53
TYPE < - JSYS error:>
JRST %X2 ;CONTINUE . . .
%X1: ETYPE <at %3Y>
%X2: MOVE A,FORK ;GET ERROR CODE NOW FOR USE IN ERSTR
GETER ;DO JSYS
HRRZ B,B ;KEEP ONLY THE ERROR CODE
ETYPE <%_> ;TYPE EOL
SKIPE INDQUS ;IF SET, WE ARE PRINTING "INFO PROG"
JRST %X4 ;DONT WANT QUESTION MARK IN COLUMN 1
ETYPE <?%2?> ;NOT SET, PROCEED NORMALLY
%X3: SETO A, ;ADD LABEL
CALL MAPPF ;UNMAP PAGE
JFCL ;UNMAP SHOULDN'T FAIL
POP P,FORK ;RESETORE FORK INFO
SETZM SYMOKF ;FORCE RECALCULATION OF OLD FORK'S SYMBOL TABLE DATA
CALLRET PION ;SET ^C O.K. AND RETURN
%X4: ETYPE < > ;TYPE THREE SPACES FOR EACH FORK-LEVEL
SOJGE Q1,%X4 ;Q1, IS SETUP BY FSTAT TO CONTAIN FORK-LEVEL
ETYPE <?%2?> ;FINALLY PRINT FORK'S ERROR MESSAGE
JRST %X3
;ETYPE'S % ROUTINES...
;%/ PRINTS EXPRESSION IN AC
%EXPR: SKIPN SYMF ;PRINT SYMBOLICALLY?
JRST %Y ;NO, DO LIKE ADDRESS
MOVE A,C ;YES, GET VALUE
CALLRET TYPEXP ;PRINT EXPRESSION
;%Y TYPES AN EXPRESSION
%Y: SKIPE SYMF ;TYPE SYMBOLICALLY?
JRST [ MOVE A,C ;YES, GET VALUE TO BE TYPED
CALLRET TYPADD] ;TYPE IT SYMBOLICALLY
%NUMS: PUSH P,C ;SAVE THE NUMBER
HLRZ B,C ;SET UP LEFT HALF OF NUMBER
MOVE A,COJFN ;STANDARD OUTPUT STREAM
MOVEI C,8 ;OCTAL
JUMPE B,%Y1 ;DON'T PRINT ANYTHING IF ZERO
NOUT
CALL JERRC ;TYPE STANDARD MESSAGE
MOVEI B,"," ;SEPARATE HALVES
BOUT
BOUT
%Y1: POP P,B ;RESTORE NUMBER
MOVEI B,(B) ;PRINT JUST THE RIGHT HALF THIS TIME
NOUT
CALL JERRC ;PRINT STANDARD MESSAGE
MOVEM A,COJFN ;UPDATE IN CASE IT'S A BYTE POINTER
RET
;%Z TYPES "," SPACE SPACE ... SPACE
%Z: SKIPN D ;WAS AN AC SPECIFIED?
SETZM C ;NO, OUTPUT COMMA ONLY
CAILE C,%COMN ;.LEQ. MAX COMMAS ?
MOVEI C,%COMN ;NO, USE MAX
MOVE A,COJFN ;STANDARD OUTPUT JFN
HRRO B,COMTAB(C) ;GET POINTER TO STRING
SETZM C ;END ON NULL
SOUT ;OUTPUT STRING
RET ;RETURN
COMTAB: [ASCIZ/,/]
[ASCIZ/, /]
[ASCIZ/, /]
[ASCIZ/, /]
[ASCIZ/, /]
[ASCIZ/, /]
[ASCIZ/, /]
[ASCIZ/, /]
[ASCIZ/, /]
%COMN=.-COMTAB
;%a TYPES OUT AN OCTAL NUMBER IN A 3-DIGIT FIELD
%AA: MOVE A,COJFN ;GET CURRENT JFN
MOVE B,C ;GET THE NUMBER
MOVE C,[NO%LFL+NO%MAG+NO%ZRO+3B17+10]
NOUT
JFCL ;IGNORE ERRORS
RET
;%b TYPES OUT CONTENTS OF ATOM BUFFER
%BB: MOVE A,COJFN ;GET CURRENT JFN
MOVE B,[POINT 7,ATMBUF]
SETZM C
SOUT
RET
;%? TYPES LAST ERROR MESSAGE
%SYSMS: HRLI B,.FHSLF ;OURSELF
HRR B,ERCOD ;USE LAST ERROR IF NO ARG
CAIE C,0 ;SPECIFIC ERROR DESIRED?
HRR B,C ;YES, USE IT
MOVE A,COJFN ;STANDARD OUTPUT STREAM
MOVEI C,0 ;NO SIZE LIMIT
AOS CLZFFF ;IF ^C WHILE ERSTR HAS ERRMES.BIN OPEN, DO CLZFF
ERSTR ;TYPE MESSAGE
JRST [ CALL CRIF ;START ON A NEW LINE IF NEEDED
ETYPE <?Error message not found for error %2P>
JRST .+2] ;R1: BAD ERROR NUMBER
JRST .+1 ;R2: DESTINATION PROBLEM, FORGET IT.
SOS CLZFFF ;WE NO LONGER REQUIRE CLZFF
MOVEM A,COJFN ;UPDATE COJFN IN CASE BYTE POINTER
RET
;ETYPE'S % ROUTINES...
;PRINT CRLF
%EOL: MOVE A,COJFN ;GET OUTPUT STREAM
CALL SNDEOL ;WRITE THE CRLF
MOVEM A,COJFN ;UPDATE OUTPUT STREAM
RET
;ROUTINE TO PUT OUT END OF LINE. CALL WITH JFN IN A.
SNDEOL::PUSH P,B
HRROI B,[BYTE(7).CHCRT,.CHLFD]
MOVEI C,0 ;END ON NULL
SOUT ;WRITE THE CRLF
POP P,B
RET
;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS.
TOUTD: PUSH P,A
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,OUTDSG
JRST TOUT1
TOUT:: PUSH P,A ;[7.1076]
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,COJFN
TOUT1: IDIVI B,^D3600
PUSH P,C
MOVEI C,^D10
NOUT ;HOURS
CALL JERRC
MOVEI B,":"
BOUT
POP P,B
IDIVI B,^D60
PUSH P,C
MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!5+5 ;2 COLS, LEADING 0'S.
NOUT ;MINUTES
CALL JERRC
MOVEI B,":"
BOUT
POP P,B
NOUT ;SECONDS
CALL JERRC
POP P,C
POP P,B
POP P,A
RET
;ROUTINE TO STACK ALL THE AC'S. THIS IS USEFUL FOR INTERRUPT
;ROUTINES THAT HAVEN'T THE SLIGHTEST IDEA WHERE THE EXEC WAS WHEN
;THE INTERRUPT OCCURED, SO THE INTERRUPT ROUTINE CALLES SAVACS TO
;SAVE ALL THE AC'S ON THE STACK. THE INTERRUPT ROUTINE MUST CALL
;RESACS BEFORE DISMISSING THE INTERRUPT, IN ORDER TO RESTORE THE
;AC'S.
;THIS ROUTINE DOESN'T SAVE P.
SAVACS::EXCH 0,(P) ;SAVE AC0, GET RETURN ADDRESS
ADJSP P,17 ;ALLOCATE ROOM FOR THE REST OF THE AC'S
MOVEM 0,(P) ;STORE RETURN ADDRESS "AFTER" AC BLOCK
HRRI 0,-16(P) ;PLACE ON STACK TO STORE AC'S
HRLI 0,1 ;STARTING FROM AC1
BLT 0,-1(P) ;SAVE REST OF AC'S
RET ;RETURN TO CALLER
;ROUTINE TO RESTORE AC'S
RESACS::HRLI 0,-16(P) ;GET ADDRESS OF STORED AC'S
HRRI 0,1 ;RESTORE AC'S INTO AC1 ONWARD
BLT 0,16 ;RESTORE 1 THROUGH 16
MOVE 0,(P) ;GET RETURN ADDRESS
EXCH 0,-17(P) ;STORE RETURN ADDRESS, GET ORIGINAL AC0
ADJSP P,-17 ;FREE UP SPACE USED BY RETURN ADDRESS AND 1 THRNOUGH 16
RET ;RETURN TO CALLER (PHYEW!)
;[3034] POBCHK
;[3034] ROUTINE TO SEE IF DIRECTORY/USER NAME INPUT HAS A MAIL.TXT.1 FILE ON
;[3034] POBOX:. IF NOT, DO NOT ALLOW MAIL FUNCTIONS TO BE PERFORMED ON THAT DIR
;[3034]
;[3034] CALL WITH STRING POINTER TO DIR NAME IN AC2
;[3034]
;[3034] RETURNS +1 IF ERROR - "NO MAILBOX"
;[3034]
;[3034] RETURNS +2 ON SUCCESS, WITH DIRECTORY NUMBER IN AC3
;[3034]
;
POBCHK::STKVAR <DIRPTR,POBJFN> ;[3040]
MOVEM B,DIRPTR ;[3040] SAVE POINTER TO INPUT DIR NAME
MOVE A, CSBUFP ;[3040]
HRROI B,[ASCIZ/POBOX:</] ;[3040] SET UP STRING IN FREESPACE
MOVEI C, 0 ;[3040]
SOUT% ;[3040]
ERJMP CJERRE ;[3040]
MOVE B,DIRPTR ;[3040] GET BACK POINTER TO NAME
MOVEI C,0 ;[3040]
SOUT% ;[3040] ADD DIR NAME TO STRING
ERJMP CJERRE ;[3040]
MOVEI B,">" ;[3040]
BOUT% ;[3040]
ERJMP CJERRE ;[3040]
HRROI B,[ASCIZ/MAIL.TXT.1/] ;[3040]ADD FILENAME TO STRING
MOVEI C,0 ;[3040]
SOUT% ;[3040]
ERJMP CJERRE ;[3040]
;
; NOW TRY TO GET A JFN ON MAIL.TXT.1 IN THE INPUT DIRECTORY ON POBOX:
;
MOVX A,GJ%OLD!GJ%DEL!GJ%SHT!GJ%PHY ;[3040] FILE MUST EXIST, DISREGARD JOB-WIDE LOGICALS
;[3040]...FILE CAN BE DELETED, SHORT FORM GTJFN
MOVE B,CSBUFP ;[3040]POINTER TO STRING
GTJFN% ;[3040]
ERJMP [CAIN A,GJFX24 ;[3040] FILE NOT FOUND?
RET ;[3040] NOT THERE, CAN'T WATCH THIS DIR
JRST CJERRE] ;[3040] SOME OTHER ERROR
;
;[3040]NOW WE HAVE THE JFN ON POBOX:<DIRECTORY>MAIL.TXT.1 USE IT TO HAVE JFNS%
;[3040]RETURN THE "REAL" STRUCTURE NAME AND DIRECTORY SO WE CAN GIVE IT TO RCDIR%
;[3040]AND OBTAIN THE DIRECTORY NUMBER TO PUT IN THE MAIL-WATCHING TABLE.
;
MOVEM A,POBJFN ;[3040] SAVE THE STUFF FROM GTJFN
HRRZ B,A ;[3040] GET JFN INTO AC2
MOVE A,CSBUFP ;[3040]
MOVX C,FLD (.JSAOF,JS%DEV)!FLD (.JSAOF,JS%DIR)!JS%PAF ;[3040] GET PUNCTUATED STRUCTURE AND DIRECTORY
JFNS% ;[3040]
ERJMP CJERRE ;[3040]
HRRZ A,POBJFN ;[3040]GET THE JFN BACK
RLJFN% ;[3040]RELEASE IT
ERJMP CJERRE
MOVE B,CSBUFP ;[3040] MOVE BYTE POINTER INTO AC2
MOVEI A,0 ;[3040]
MOVEI C,0 ;[3040]
RCDIR% ;[3040]
ERJMP CJERRE ;[3040]
RETSKP ;[3040] WE HAVE THE DIRECTORY NUMBER IN AC3...
ENDSV. ;[3040] ...RETURN IT
;NEW MAIL WATCH SUBROUTINE - CAN BE CALLED FROM EITHER INTERRUPT LEVEL
;OR COMMAND RETURNS , DOES NOTHING IF NOT LOGGED IN OR MAIL WATCH TURNED
;OFF, MWATCF := 0
MWATCH::SKIPE BATCHF ;NO MAIL WATCH IF UNDER BATCH
RET
SKIPE CUSRNO ;LOGGED IN?
SKIPN MWATCF ;YES - WANT MAIL WATCH
RET ;NO - RETURN
GTAD ;OK - GET D/T
MOVEI D,MWATAT ;AUTO TIMER
SKIPN AUTOF ;THIS CALL FROM IIT
MOVEI D,MWATCT ;NO - USE COMMAND TIMER
CAMGE A,0(D) ;TIME TO CHECK MAIL?
RET ;NOPE - RETURN
ADDI A,^D910 ;TRY AGAIN 5 MINS FROM NOW
MOVEM A,0(D)
MOVEI Q2,NMWAT-1 ;# OF ENTRIES
MWATC0: SKIPE B,MWATDR(Q2) ;GET DIRECTORY #
CALL MALCHK ;CHECK ONE
JRST MWATC4 ;NO NEW MAIL
CAMN D,MWATWR(Q2) ;CHECK LAST WRITE DATE/TIME
JRST [ SKIPE AUTOF ;STILL THE SAME , CHECK IIT
JRST MWATC4 ;AUTO WATCH - GO TO NEXT
JRST MWATC1] ;NOT AUTO - DECREMENT COUNT
MOVE Q1,MWATN0(Q2) ;GET INITIAL COUNT
MOVEM Q1,MWATN(Q2) ;RESET FOR NEW D/T
MOVEM D,MWATWR(Q2) ;REMEMBER WRITE DATE
SKIPE AUTOF ;IIT?
JRST MWATC2 ;YES - TELL USER
MWATC1: SOSGE MWATN(Q2) ;REDUCE REPEAT COUNT
JRST MWATC4 ;COUNT EXPIRED, GO ON
JRST MWATC3 ;INFORM USER OF MAIL
MWATC2: PUSH P,A ;SAVE STRING PNTR FROM MALCHK
MOVE A,COJFN
DOBE ;WAIT FOR TYPEOUT TO STOP
POP P,A ;RESTORE PNTR
TYPE <> ;RING CHIMES
MWATC3: MOVE Q1,MWATDR(Q2) ;USER BEING WATCHED
CAME Q1,POBXNO ;[3040] IS IT ME?
JRST [ ETYPE <[%10R has > ;[3040] NO - TELL ME WHO THEN
JRST .+2]
TYPE <[You have > ;IT'S MINE
TLNN B,77 ;NETWORKS
TYPE <net>
ETYPE <mail %1\]%_>
MWATC4: SOJGE Q2,MWATC0 ;LOOP BACK FOR NEXT
RET ;DONE, RETURN
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;[3040] CALLED WITH C(B) := DIRECTORY #
;RETURNS:
; +1 ;NO MAIL, OR SOME OTHER FAILURE
; +2 ;NEW MAIL - C(A) := -1,,MESSAGE
; C(D) := WRITE DATE/TIME
; C(C) := AUX MESSAGE
;[3040] C(P1):= POINTER TO MAILBOX NAME
MALCHK::STKVAR <MALDIR,<MALFDB,16>,POBJFN> ;[3040]
SETO Q1, ;INIT FLAG
HRROI A,MALBUF ;POINT AT BUFFER
DIRST ;NAME STRING TO BUFFER
IFJER.
CAIE A,STRX10 ;[4401] Is structure offline?
IFSKP. ;[4401] If so,
TYPE <?Mail checking failed because mail structure is offline
>
RET ;[4401] And return
ENDIF.
TYPE <%POBOX: - > ;[3066] Handle error
CALL %GETER ;[3065] Get error code
MOVE A,ERCOD
CALL $ERSTR ;[3065] Print it
RET ;[3065] And return
ENDIF.
HRROI B,[ASCIZ "MAIL.TXT.1"]
MOVEI C,0
SOUT ;FINISH FILE SPEC
MOVX A,GJ%OLD!GJ%DEL!GJ%SHT
HRROI B,MALBUF
GTJFN ;GRASP AT FILE
JRST [SKIPN LOGINF ;[3044] LOGGING IN?
JRST MALCH2 ;[3044] NO, HANDLE ERROR
RET] ;[3044] YES, JUST CONTINUE
MOVEM A,POBJFN ;[3040] SAVE POBOX JFN
HRRZ B,A ;[3040] GET JFN INTO AC2
MOVE A,CSBUFP ;[3040]
MOVX C,FLD(.JSAOF,JS%DIR) ;[3040] GET DIR (MAILBOX) NAME
JFNS% ;[3040]
ERJMP [SKIPN LOGINF ;[3044] LOGGING IN?
JRST CJERRE ;[3044] NO, GIVE ERROR
RET] ;[3044] YES, JUST CONTINUE
MOVE P1,CSBUFP ;[3040] RETURN THIS POINTER
MOVE A,POBJFN ;[3040] RESTORE AC1
MOVEI Q1,(A) ;[3040] JFN TO Q1
MOVE B,[15,,.FBCTL] ;GET SOME FDB INFO
MOVEI C,.FBCTL+MALFDB ;POINT AT STG
CALL $GTFDB ;GET IT
JRST MALCHP ;PROTECTED
MOVX C,FB%DEL ;CHECK DELETED
TDNN C,.FBCTL+MALFDB
SKIPG .FBSIZ+MALFDB ;EXISTS - HAVE CONTENTS?
JRST MALCHN ;EMPTY OR DELETED
MOVE D,.FBWRT+MALFDB ;GET D/T LAST WRITE
CAMG D,.FBREF+MALFDB ;COMPARE AGAINS LAST READ
JRST MALCHN ;NO NEW MAIL
HRLI A,.GFLWR ;GET LAST WRITER STRING
HRROI B,MALBUF ;POINT TO BUFFER
SETZM MALBUF ;MAKE SURE WE HAVE A VALID ERROR STRING
GFUST
ERJMP .+1
HRROI B,MALBUF ;ASSUME LOCAL MAIL (-1,,MALBUF)
SKIPA A,[POINT 7,MALBUF]
MALCKL: JUMPE C,MALLCL ;LOCAL IF NO SPECIAL CHARS
ILDB C,A ;FETCH CHAR IN NAME
CAIE C," " ;IMBEDDED SPACE
CAIN C,"@" ;OR AT SIGN MEANS NET MAIL
SKIPA B,[POINT 7,MALBUF] ;RETURN 440700,,MALBUF
JRST MALCKL ;NO SPECIAL KEEP LOOKING
MALLCL: MOVEI A,(Q1) ;JFN TO RELEASE
RLJFN
JRST [SKIPN LOGINF ;[3044] LOGGING IN?
CALL JERR ;[3044] NO, GIVE ERROR
RET] ;[3044] YES, JUST CONTINUE
GTAD ;GET D/T NOW
SUB A,D ;CHECK FOR GREATED THAN 1 DAY
TLNN A,-1
TDZA C,C ;LESS - CLEAR XTR MSG
HRROI C,[ASCIZ "%4D "] ;GIVE DATE AS WELL AS
HRROI A,[ASCIZ "from %2M at %3\%%4E%"] ;TIME
RETSKP ;GOOD RETURN
;MALCHK CONTINUED....
;HERE ON GTJFN FAILURE FOR MAIL.TXT.1
MALCH2: CAIN A,GJFX24 ;FILE NOT FOUND
JRST MALCHN ;NO FILE RETURN
CAIL A,GJFX16 ;MORE NOT FOUND ERRORS
CAILE A,GJFX20
JRST MALCHP ;MUST BE PROTECTED
MALCHN: TDZA A,A ;RETURN 0 IF NOT FOUND
MALCHP: SETO A, ; -1 IF PROTECTED (OR SOMETHING)
JUMPL Q1,R ;HAVE JFN?
EXCH A,Q1 ;YES - RELEASE IT
RLJFN
JRST [SKIPN LOGINF ;[3044] LOGGING IN?
CALL JERR ;[3044] NO, GIVE ERROR
RET] ;[3044] YES, JUST CONTINUE
MOVE A,Q1 ;RESTORE VALUE
RET ; AND RETURN
;INTERRUPT ROUTINE FOR IIT (TIMER)
;INTERRUPTS OCCUR EVERY MINUTE IF SET AUTO (MAIL-WATCH AND ALERTS) IS ON
IITPSI::PUSH P,40 ;SAVE LUUO LOC
PUSH P,P1 ;TOP AC TO SAVE
ADJSP P,7 ;MAKE SOME STACK ROOM
MOVSI P1,A ;SAVE REGS
HRRI P1,-6(P)
BLT P1,0(P) ;...
SKIPE TYPING ;TYPEOUT IN PROGRESS?
JRST IITRET ;YES - EXIT NOW
SETOM AUTOF ;NO - SAY WE ARE IN AUTO CHECK
CALL MWATCH ;INVOKE WATCHERS
CALL ALRCHK
SKIPE IPCRCF ;ANY IPCF MESSAGES?
CALL IPCHEK ;YES - INFORM USER
IITRET: MOVE A,[.FHSLF,,.TIMEL] ;ELAPSED TIME FOR SELF
MOVEI B,^D60000 ;1MIN FROM NOW
MOVEI C,IITCHN ;PSI CHL
TIMER ;ARM IT
SETZM IITSET ;CLEAR FLAG
MOVEI Q3,A ;RESTORE ACS
HRLI Q3,-6(P)
BLT Q3,Q3
ADJSP P,-7
POP P,P1
POP P,40 ;RESTORE LUUO
DEBRK ;EXIT INT
;ROUTINE TO SUBTRACT TWO BYTE POINTERS
;CALL: A/ BYTE POINTER 1
; B/ BYTE POINTER 2
;RETURN: +1
; A/ 1-2
SUBBP:: TLC A,-1
TLCN A,-1
HRLI A,440700 ;IF LEFT HALF -1, IT'S NOW 440700
TLC B,-1
TLCN B,-1
HRLI B,440700 ;SAME FOR OTHER POINTER
MOVEI C,1
ADJBP C,B ;PUT SECOND POINTER INCREMENTED IN C
IBP A ;NOW NEITHER POINTER IS "44XX00,,"
MULI A,5 ;MULTIPLY POINTER BY BYTES PER WORD
SUBI B,-4(A) ;B HOLDS CHARACTER ADDRESS
MULI C,5 ;DO SAME TO OTHER POINTER
SUBI D,-4(C)
SUB B,D ;CALCULATE DIFFERENCE
HRRE A,B ;RETURN ANSWER IN A.
RET
;[7.1061][7.1083]
;Following are two routines to create a 128-bit bit-mask for remote printing
;characteristics. "NBTMSK" takes numerical input and translates it to a bit
;number in the mask, then lights that bit. "KBTMSK" takes keyword input, finds
;the already-existing bit-mask for that keyword, and lights the appropriate
;bit(s).
;The bit-mask which has the bits lit is actually 4 words in memory,
;BTMSK1-BTMSK4. This makes things easier, as there routines are called from
;two places - the SRPC processing (EXECSE.MAC) and the PRINT command
;(EXECQU.MAC). The bit mask is formatted into sixteen bytes to send
;to the Distributed Job Manager by the DQS LPTSPL. The bytes are formatted
;in such a manner that it is easy to transmit them to the DJM by using a
;8 bit PDP-10 byte pointer. Since we are talking to a little ender machine
;(PDP-11 format) the bits within each byte are assigned from the "little end"
;(least significant bit) of the 8 bit byte. Since the PDP-10 is a big ender
;machine (the intuitive way to do it after all) the bytes are packed in each
;word starting from the "big end" (most significant bit).
;
;The format of this bit mask is:
;
; 0 7|8 15|16 23|24 31|32 35|
; +---------+---------+---------+---------+------+
;Word 0 | byte 00 | byte 01 | byte 02 | byte 03 | 0000 |
; +---------+---------+---------+---------+------+
;Word 1 | byte 04 | byte 05 | byte 06 | byte 07 | 0000 |
; +---------+---------+---------+---------+------+
;Word 2 | byte 08 | byte 09 | byte 10 | byte 11 | 0000 |
; +---------+---------+---------+---------+------+
;Word 3 | byte 12 | byte 13 | byte 14 | byte 15 | 0000 |
; +---------+---------+---------+---------+------+
;
;Furthermore, within each byte, the bits are assigned from the right:
;
; +-----------------+
; | 7 6 5 4 3 2 1 0 |
; +-----------------+
;
;So, how does this all apply to characteristics? Each characteristic is
;numbered from 0 to 127, for a total of 128 bits. The bits of the
;characteristic word are set from a table of 32 words with 1B7, 1B6, 1B5, 1B4,
;1B3, 1B2, 1B1, 1B0, 1B15, 1B14, 1B13, 1B12, 1B11, 1B10, 1B9, 1B8, 1B23, 1B22,
;oh well you get the idea. The characterisic number is divided by 32 which
;results in the word offset and the remainder which is used to index into this
;table and load a bit mask to set.
;[7.1061]
;NBTMSK - translate a number to a bit; light that bit in a bit-mask
;
;A/ number (radix 10)
;
; CALL NBTMSK
;
;RETURN +1 always, with bit lit in BTMSK*
NBTMSK::IDIVI A,^D32 ;[7.1083] Bitmap word in A, BETTBL index in B
MOVE C,BETTBL(B) ;[7.1083] Get the -11 format bit
IORM C,BTMSK1(A) ;[7.1083] Light it
RET ;[7.1083] Return
;[7.1083] Table of funny PDP-11 style bits
BETTBL: ZZ==1B8 ;[7.1083] Start with bit zero of the word
REPEAT 4,< ;[7.1083] For each of the four bytes
REPEAT 8,< ;[7.1083] For each of the bits in a byte
EXP <ZZ==ZZ_1> ;[7.1083] Make a bit and shift it left by one
> ;[7.1083] End of per-byte REPEAT
ZZ==ZZ_-^D16 ;[7.1083] Done with a byte, get next one
> ;[7.1083] End of per-word REPEAT
;[7.1061]
;KBTMSK - translate a keyword to a bit-mask; light those bits in a bit-mask
;
;A/ address of already-existing keyword
;
; CALL KBTMSK
;
;RETURN +1 always, with bit(s) lit in BTMSK*
;
KBTMSK::HRRZ C,(A) ; Get address of bit-mask
MOVE B,0(C) ;[7.1083] Load first word of bit-mask
IORM B,BTMSK1 ;[7.1083] and set any bits in that word
MOVE B,1(C) ;[7.1083] Get second word
IORM B,BTMSK2 ;[7.1083] and set 'em there
MOVE B,2(C) ;[7.1083] Load third word
IORM B,BTMSK3 ;[7.1083] and copy the bits
MOVE B,3(C) ;[7.1083] Load fourth word
IORM B,BTMSK4 ; Last word
RET ; Done
;[7.1061]
;THIS ROUTINE WILL CONVERT LOWERCASE ASCIZ INPUT TO UPPERCASE
;NOTE: THIS ROUTINE ASSUMES THAT THE STRING HAS "CORRECT" LETTERS.
;THAT IS, IT WILL STEP OVER ANYTHING THAT IS NOT ALPHABETIC, LEAVING IT
;ALONE. ALL NON-ALPHABETIC CHARACTERS WILL REMAIN AS THEY WERE.
;
;THIS LOOPS THROUGH THE CHARACTERS, STOPPING ON NULL
;
;
; CALL UPRCAS
;
;CALL WITH:
;
; A/ BYTE POINTER TO STRING
;
;
;RETURNS +1 ALWAYS, WITH BYTE POINTER IN A
;
;
UPRCAS::STKVAR <WRDPTR>
MOVEM A,WRDPTR ;Store the pointer to the input
UPRCS1: ILDB C,A ;Get a character
JUMPE C,UPDONE ;Done if null
CAIN C,"" ;Quoting character?
IFNSK.
ILDB C,A ;Yes, skip over it
JRST UPRCS1 ;And the next
ENDIF.
CAIL C,"A" ;Is this alphabet country?
IFNSK.
CAIG C,"Z" ;Uppercase already?
JRST UPRCS1 ;Yes, so skip along
CAIGE C,"a" ;Lowercase ?
JRST UPRCS1 ;Funny character, skip it
CAILE C,"z" ;Lowercase?
JRST UPRCS1 ;No. must be funny
TRZ C,40 ;Lowercase, change it to UPPER
DPB C,A ;Store it back
ENDIF.
JRST UPRCS1
UPDONE: MOVE A,WRDPTR ;Point to beginning of input
RET
ENDSV.
;ROUTINE TO DO GFRKS JSYS TO GET FORK HANDLES ON ALL PROCESSES
;UNDER THIS EXEC.
; Note: After using the information returned by this routine, RELHAN
; should be called to release any unwanted fork handles.
;SKIPS IFF SUCCESSFUL
GFLEN==1000*<<BUFL-BUF0>B44+1> ;LENGTH OF BLOCK
DGFRKS::MOVEI A,.FHSLF ;SAY START AT SELF
LDF B,GF%GFH+GF%GFS ;ASSIGN FORK HANDLES, GET STATUS
MOVE C,[-GFLEN,,BUF0] ;WHERE TO PUT FORK STRUCTURE (BUF0-BUFL)
GFRKS ;GET FORK STRUCTURE
RET ;FAILED
RETSKP ;WIN
; [3063]
; RELHAN - Check all the handles and release non-inferiors
;
; This routine releases all the fork handles acquired by doing a
; GFRKS% JSYS. Routine DGFRKS does a GFRKS% JSYS to return the job's
; fork structure. GFRKS% acquires handles on all forks that the
; process doesn't already have a handle on. We need to release these
; newly acquired handles or the forks cannot be properly killed.
;
; A/ Address of GFRKS% block
; CALL RELHAN
; Returns:
; +1: Always
;
; Preserves all ACs
;
RELHAN::SAVEAC <A> ;Preserve this AC
MOVEI A,BUF0 ;Address of GFRKS% block
HRRZ A,(A) ;Get pointer to first inferior
SKIPE A ;Any there?
CALL STPHAN ;(A/)Yes. Step through all the handles
RET ;Done
; [3063]
; STPHAN - Step through all handles and release them
;
; This recursive routine steps through the fork handle block starting
; at the address supplied in A. It releases the handles of all the
; forks that are not direct inferiors to this EXEC by calling routine
; RELHAN.
;
; A/ Pointer into GFRKS% fork block
; CALL STPHAN
; Returns:
; +1: Always
;
; Uses AC A
;
STPHAN: SAVEAC <B> ;Save B
MOVEM A,B ;Remember the pointer supplied
HRRZ A,1(B) ;Get handle of this fork
CALL CHKHAN ;(A/)Release it if we should
HRRZ A,(B) ;Get pointer to inferior
SKIPE A ;Is there one?
CALL STPHAN ;(A/)Yes. Release it and inferiors/siblings
HLRZ A,(B) ;Get pointer to parallel fork
SKIPE A ;Is there one?
CALL STPHAN ;(A/)Yes. Release it and inferiors/siblings
RET ;Done at this level
; [3063]
; CHKHAN - Release a fork handle if needed
;
; This routine releases the given fork handle if we don't need it.
; This determination is made by looking into the fork blocks pointed
; to by the FRKNMS table and determining if there is an entry for this
; fork. If there is, the handle is kept. If there isn't, it is
; released.
;
; A/ Fork Handle
; CALL CHKHAN
; Returns:
; +1: Always
;
; Preserves all ACs
;
CHKHAN: SAVEAC <A,B,C> ;Save ACs
CAIN A,.FHSLF ;Ourself?
RET ;Yes. Don't try to release the handle
MOVE B,[XWD -NFRKS,FRKNMS+1] ;Set up AOBJN pointer
CHKHN1: HRRZ C,(B) ;Get pointer to fork block
JUMPE C,CHKHN2 ;Don't check handle if no block
CAMN A,C ;Is this is fork provided?
RET ;Yes. Don't release the handle
CHKHN2: AOBJN B,CHKHN1 ;Loop through all blocks
RFRKH% ;Don't have it, so release it
ERJMP .+1 ;Don't worry. The handle is gone
RET ;Done
;FOWNER FINDS THE OWNER OF A FORK. THE "OWNER" IS DEFINED TO BE THE DIRECT
;INFERIOR OF OURSELF THAT IS AN ANCESTOR OF THE FORK WHOSE OWNER IS
;SOUGHT. (OUR DIRECT INFERIORS ARE THEIR OWN OWNERS.)
; Note: After using the information returned by this routine, RELHAN
; should be called to release any unwanted fork handles.
;
;ACCEPTS: A/ FORK HANDLE OF FORK WHOSE OWNER IS SOUGHT
;
;RETURNS: A/ OWNER
FOWNER::STKVAR <FLOST,FBEST>
MOVEM A,FLOST ;REMEMBER "LOST" FORK WHOSE OWNER IS BEING SOUGHT
CALL DGFRKS ;GET THE FORK TREE
CALL JERRE ;SHOULDN'T FAIL
MOVSI A,-<GFLEN/3> ;FIND LOST FORK AS STARTING POINT FOR SCAN
MOVEI B,BUF0 ;ADDRESS OF NEXT TRIPLET TO CONSIDER
FOW1: HRRZ C,1(B) ;GET FORK REPRESENTED BY CURRENT TRIPLET
CAMN C,FLOST ;IS THIS THE STARTING POINT YET?
JRST FOW2 ;YES
ADDI B,3 ;NO, STEP TO NEXT TRIPLET
AOBJN A,FOW1 ;LOOP OVER ENTIRE TABLE
CALL SCREWUP ;NO OWNER OF THIS FORK (SHOULDN'T HAPPEN!)
FOW2: MOVEM C,FBEST ;SAVE LATEST SUSPECT OF OWNER
HLRZ B,1(B) ;GET ADDRESS OF TRIPLET CONTAINING SUPERIOR
HRRZ C,1(B) ;GET FORK HANDLE OF SUPERIOR
CAIE C,.FHSLF ;HAVE WE TRACED BACK TO OURSELF YET?
JRST FOW2 ;NO, LOOP
MOVE A,FBEST ;YES, SO WE KNOW WHO OWNER IS NOW
RET
;ROUTINE TO REWIND MAGTAPE. GIVE IT JFN IN A
;THIS ROUTINE LEAVES THE TAPE OPEN OR NOT DEPENDING ON WHETHER JFN WAS
;OPEN TO START WITH
REWIND::GTSTS ;SEE IF JFN IS OPEN
TXNN B,GS%OPN ;OPEN?
JRST [ MOVX B,OF%RD ;NO, OPEN FOR READING
CALL OPNMAG ;OPEN THE TAPE
CALL REWIND ;REWIND THE TAPE
TXO A,CO%NRJ
CLOSF ;CLOSE FILE BUT DON'T RELEASE JFN
NOP ;IGNORE FAILURE
RET]
MOVEI B,.MOREW ;SAY "REWIND"
MTOPR ;DO IT
ERCAL CJERRE ;IF FAILS, SAY WHY AND DIE
RET
;ROUTINE TO OPEN MAG TAPE
;ACCEPTS: A/ JFN
; B/ BITS FOR OPENF
OPNMAG::STKVAR <MJFN,OBITS>
MOVEM B,OBITS ;REMEMBER OPENF BITS
MOVEM A,MJFN ;REMEMBER JFN
OPN1: OPENF ;TRY TO OPEN
JRST [ CAIE A,OPNX9 ;INVALID SIMULTANEOUS ACCESS?
CALL CJERR ;NO, I CAN'T HANDLE THIS ONE
MOVE A,MJFN ;GET JFN
DVCHR ;TRANSLATE TO DEVICE DESIGNATOR
CALL CJDEV ;TRY TO FIND ANOTHER OPEN JFN
JRST [ MOVEI A,OPNX9 ;NONE
CALL CJERR] ;SO HANG IT UP
MOVE A,MJFN ;RESTORE JFN
MOVE B,OBITS ;RESTORE OPENF BITS
JRST OPN1] ;GO TRY AGAIN
RET
MSKLB: 1B9+1B10+1B13 ;TAB AND CR/LF ARE BREAK MASK
1B0 ;SPACE IS BREAK MASK
0
0
LATMSK: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_-.>) ;[4402]
;BITS+N CONTAINS A WORD WITH A 1 IN BIT N
XX==0
BITS:: REPEAT ^D36,<EXP 1B<XX>
XX=XX+1>
XEND==:. ;MUST BE LAST LOCATION OF EXEC!
END