Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/execsu.mac
There are 47 other files named execsu.mac in the archive. Click here to see a list.
;1021 Clear cmdat for non-wildcarded DIR$
;713 rename XX macro and XX variable to prevent conflict with site
;712 DEC release version
; UPD ID= 127, SNARK:<5.EXEC>EXECSU.MAC.27, 28-Dec-81 11:19:00 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 96, SNARK:<5.EXEC>EXECSU.MAC.24, 21-Oct-81 13:41:08 by GROUT
;TCO 5.1578 ADD CMDINI AFTER EOFJER DETECTS TEXTI EOF
; UPD ID= 72, SNARK:<5.EXEC>EXECSU.MAC.22, 21-Sep-81 09:07:57 by CHALL
;TCO 5.1518 CIOER1- DON'T OUTPUT MESSAGE ON ^C OF PCL COMMAND
; UPD ID= 69, SNARK:<5.EXEC>EXECSU.MAC.19, 11-Sep-81 09:02:58 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= 64, SNARK:<5.EXEC>EXECSU.MAC.15, 9-Sep-81 09:44:56 by CHALL
;TCO 5.1493 USEX- ON ^T MAKE SURE THERE'S A SPACE AFTER THE TIME
; UPD ID= 47, SNARK:<5.EXEC>EXECSU.MAC.12, 19-Aug-81 10:40:25 by CHALL
;TCO 5.1466 REPARS- CLEAR PCLDCO (ORIGINAL COMMAND FLAG) ON COMMAND REPARSE
; UPD ID= 30, SNARK:<5.EXEC>EXECSU.MAC.11, 14-Aug-81 18:35:19 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= 12, SNARK:<5.EXEC>EXECSU.MAC.9, 14-Jul-81 15:49:24 by MURPHY
;DITTO
; UPD ID= 9, SNARK:<5.EXEC>EXECSU.MAC.8, 13-Jul-81 17:41:20 by MURPHY
;TCO 5.1410 - MACHINE SIZE EXCEEDED, OVER QUOTA, ETC.
; UPD ID= 2, SNARK:<5.EXEC>EXECSU.MAC.7, 9-Jul-81 13:49:08 by GROUT
;TCO 5.1404 - PUT PIOFF/PION PAIR AROUND GETMEM/RETMEM FREE LIST MANIPULATION
; UPD ID= 2282, SNARK:<5.EXEC>EXECSU.MAC.5, 1-Jul-81 16:30:56 by CHALL
;TCO 5.1391 CIOREL- PCMPOS SHOULD BE CALLED BEFORE FIXIO
; UPD ID= 1963, SNARK:<5.EXEC>EXECSU.MAC.4, 8-May-81 10:03:14 by SCHMITT
;TCO 5.1309 - Make DWNPNT understand DWNTIM of -1 for system shutdown
; 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
;
;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
;<4.EXEC>EXECSU.MAC.365, 24-Oct-79 15:41:45, EDIT BY TOMCZAK
;TCO# 4.2545 - Change PECHOF/ECHOF flag test at ECHCMD
;<4.EXEC>EXECSU.MAC.364, 22-Oct-79 11:26:00, EDIT BY OSMAN
;CHANGE JFNSIL
;<4.EXEC>EXECSU.MAC.363, 20-Oct-79 15:13:44, EDIT BY R.ACE
;In message "[MOUNT request remaining in queue]" change MOUNT to Mount
;<4.EXEC>EXECSU.MAC.361, 9-Oct-79 09:49:05, EDIT BY OSMAN
;CHANGE $XXX SYMBOLS TO XXX$ TO AVOID CONFLICT WITH MACRO NAMES
;<4.EXEC>EXECSU.MAC.360, 8-Oct-79 15:50:57, EDIT BY OSMAN
;tco 4.2519 - Make ^T output go to .PRIOU
;<4.EXEC>EXECSU.MAC.359, 4-Oct-79 10:41:47, EDIT BY OSMAN
;tco 4.2510 - Fix EOF interrupt
;<4.EXEC>EXECSU.MAC.358, 28-Sep-79 13:59:31, EDIT BY OSMAN
;EXPAND BCOUNT TO GIVE CHARACTER COUNT
;<4.EXEC>EXECSU.MAC.356, 26-Sep-79 14:50:12, Edit by HESS
; Fix mail watch typeout for user other than self (XTND only)
;<4.EXEC>EXECSU.MAC.355, 20-Sep-79 13:53:30, EDIT BY OSMAN
;INSTEAD OF RJFN, JUST REPLACE THE ENTRY
;<OSMAN>EXECSU.MAC.1, 19-Sep-79 11:58:54, EDIT BY OSMAN
;MORE CLZFFF STUFF, CALL RJFN IN CFNE1 TO GET RID OF SCRATCH JFN
;<4.EXEC>EXECSU.MAC.352, 18-Sep-79 12:33:23, EDIT BY TOMCZAK
;Get rid of CFN1 since it isn't unique from SPECFN anymore
;<4.EXEC>EXECSU.MAC.351, 17-Sep-79 16:32:54, EDIT BY OSMAN
;tco 4.2472 - prevent "?JFN is not assigned" on "TAKE FOO NUL:"
;<4.EXEC>EXECSU.MAC.350, 17-Sep-79 10:37:56, EDIT BY OSMAN
;ADD BITS
;<4.EXEC>EXECSU.MAC.349, 14-Sep-79 08:52:27, EDIT BY OSMAN
;Call JFNSTK in FIELD instead of after CFN2
;<4.EXEC>EXECSU.MAC.346, 12-Sep-79 14:01:43, EDIT BY OSMAN
;HAVE ONLY ONE ERSTR, SO CLZFFF CAN BE HANDLED
;<4.EXEC>EXECSU.MAC.345, 12-Sep-79 11:14:30, EDIT BY OSMAN
;DON'T SOS CLZFFF IN JFNSTK IF JFN IS REALLY A FORK
;<4.EXEC>EXECSU.MAC.344, 12-Sep-79 11:04:11, EDIT BY OSMAN
;tco 4.2459 - Allow ^C out of magtape commands
;CHANGE CLZF TO CLZFFF, USE CLZFFF INSTEAD OF PIOFF IN GTJFS
;Use %3? instead of ERSTR at ERR5C
;Use %? in RJWARN
;<4.EXEC>EXECSU.MAC.341, 6-Sep-79 15:10:23, EDIT BY OSMAN
;tco 4.2448 - Print filespec and EOT info on data error
;<4.EXEC>EXECSU.MAC.339, 5-Sep-79 10:56:12, EDIT BY OSMAN
;TCO 4.2440 - Add DOGET
;<4.EXEC>EXECSU.MAC.338, 4-Sep-79 14:36:07, Edit by HESS
; Add call to IPCHEK to IITPSI (XTND)
;<4.EXEC>EXECSU.MAC.337, 4-Sep-79 14:17:35, Edit by HESS
; Don't do Auto Mail Watch if under batch (XTND only)
;<4.EXEC>EXECSU.MAC.336, 4-Sep-79 11:56:00, EDIT BY OSMAN
;MAKE GETMEM BE GLOBAL
;<4.EXEC>EXECSU.MAC.334, 31-Aug-79 13:07:25, EDIT BY OSMAN
;tco 4.2433 - Make SETM be SETZM
;<4.EXEC>EXECSU.MAC.332, 28-Aug-79 15:27:12, EDIT BY OSMAN
;TCO 4.2427 - ADD MFINP0
;<4.EXEC>EXECSU.MAC.331, 28-Aug-79 14:36:26, EDIT BY OSMAN
;MAKE GNFIL RETURN GNJFN FLAGS IN LEFT HALF OF A, SO DELETE KNOWS WHEN DIR
; CHANGES
;<HESS.E>EXECSU.MAC.17, 21-Aug-79 13:30:36, Edit by HESS
; Add extended features
;<4.EXEC>EXECSU.MAC.329, 15-Aug-79 11:08:30, EDIT BY OSMAN
;tco 4.2399 - If ECHO is on for TAKE, be sure to echo the erroneous commands!
;<4.EXEC>EXECSU.MAC.325, 10-Aug-79 15:15:14, EDIT BY OSMAN
;ADD TYPFLS
;<4.EXEC>EXECSU.MAC.323, 2-Aug-79 16:53:00, EDIT BY DNEFF
;TCO 4.2370 - Fix illegal instruction traps from 777777.
;<4.EXEC>EXECSU.MAC.322, 17-Jul-79 11:11:20, EDIT BY OSMAN
;tco 4.2332 - Fix /AFTER:SATURDAY on SUNDAY, AND @@SINCE ... on DIR command
;<4.EXEC>EXECSU.MAC.321, 16-Jul-79 09:06:34, EDIT BY OSMAN
;REMOVE %ERSTR, USE %? FOR $ERSTR
;<4.EXEC>EXECSU.MAC.319, 13-Jul-79 15:44:06, EDIT BY OSMAN
;tco 4.2327 - Make RELDIR
;<4.EXEC>EXECSU.MAC.318, 13-Jul-79 14:49:13, EDIT BY OSMAN
;tco 4.2326 - Prevent ILL MEM WR on INFO DIR PS:[*] when enabled.
;<4.EXEC>EXECSU.MAC.315, 29-Jun-79 14:08:42, EDIT BY OSMAN
;FIX ICLEAR TO NOT EVER LOSE IPCF OF ^T INTERRUPTS
;<4.EXEC>EXECSU.MAC.314, 7-Jun-79 09:01:37, EDIT BY EKLUND
;tco 4.2276 - CHANGE ERROR MESSAGE TO INCLUDE "ILLEGAL CHARACTER IN COMMAND"
;<4.EXEC>EXECSU.MAC.313, 6-Jun-79 12:58:35, EDIT BY HELLIWELL
;CHANGE ATMBFR TO ATMBUF
;<4.EXEC>EXECSU.MAC.312, 6-Jun-79 09:59:36, EDIT BY OSMAN
;tco 4.2274 - Don't leave jfn's around on ^C
;<4.EXEC>EXECSU.MAC.311, 4-Jun-79 10:36:59, EDIT BY OSMAN
;tco 4.2270 - use CLZF to decide whether to do CLZFF on ^C
;<4.EXEC>EXECSU.MAC.309, 16-May-79 16:09:00, EDIT BY OSMAN
;TRY TO ENABLE ^C IN LTTYMD BEFORE DOING STIW
;<4.EXEC>EXECSU.MAC.308, 15-May-79 09:05:29, EDIT BY OSMAN
;BETTER CALL LTTYMD ON ^C FROM PROG, PROG MAY HAVE DIDDLED TTY STATE.
;<4.EXEC>EXECSU.MAC.307, 4-May-79 15:30:20, EDIT BY OSMAN
;REMOVE EXTRA SFMOD AT ERR1 (ALREADY DONE AT ERFRS1 TO TURN OFF ^O)
;<4.EXEC>EXECSU.MAC.306, 2-May-79 17:00:39, EDIT BY OSMAN
;FIX RLJFNS TO HANDLE RESTRICTED JFNS BETTER
;<4.EXEC>EXECSU.MAC.304, 2-May-79 15:08:50, EDIT BY OSMAN
;FIX ICLEAR TO DO LESS WORK
;<4.EXEC>EXECSU.MAC.302, 1-May-79 11:27:11, EDIT BY OSMAN
;GTJFN => CALL GTJFS, SO ^C DOESN'T LEAVE JFN AROUND
;<4.EXEC>EXECSU.MAC.301, 1-May-79 11:12:01, EDIT BY OSMAN
;REMOVE CLZFF AT RERET (FOR EFFICIENCY. IF WANTED, FLAG SHOULD BE DESIGNED
;TO SHOW WHETHER IT'S NEEDED)
;<4.EXEC>EXECSU.MAC.300, 30-Apr-79 15:02:07, EDIT BY OSMAN
;MAKE DOECHO CHECK NECHOF, TO AVOID UNNECESSARY JSYS'S
;<4.EXEC>EXECSU.MAC.299, 30-Apr-79 14:55:02, EDIT BY OSMAN
;DON'T CALL LTTYMD ON ^C, COMND WILL FIX THINGS UP
;<4.EXEC>EXECSU.MAC.298, 26-Apr-79 11:42:44, EDIT BY OSMAN
;ADD .FIJFN
;<4.EXEC>EXECSU.MAC.295, 18-Apr-79 13:57:10, EDIT BY OSMAN
;ADD GTBUFX
;<4.EXEC>EXECSU.MAC.293, 18-Apr-79 09:55:10, EDIT BY OSMAN
;ADD RETBUF
;<4.EXEC>EXECSU.MAC.291, 12-Apr-79 10:44:33, EDIT BY OSMAN
;FIX OPNMAG
;<4.EXEC>EXECSU.MAC.290, 6-Apr-79 10:05:01, EDIT BY OSMAN
;ADD %@ (%LM) TO GET TO LEFT MARGIN
;<4.EXEC>EXECSU.MAC.288, 2-Apr-79 12:58:19, EDIT BY OSMAN
;REMOVE OPLEAS STUFF
;<4.EXEC>EXECSU.MAC.284, 28-Mar-79 15:10:52, EDIT BY OSMAN
;CHECK MPENDF IN ^C AND WARN THAT MOUNT STILL PENDING
;<4.EXEC>EXECSU.MAC.283, 27-Mar-79 17:12:49, EDIT BY OSMAN
;tco 4.2223 - don't say "device is not a terminal" when better error exists
;<4.EXEC>EXECSU.MAC.282, 22-Mar-79 10:12:29, EDIT BY OSMAN
;BE MORE EXPLICIT ON INTERNAL ILLEGAL INSTRUCTIN TRAPS
;<4.EXEC>EXECSU.MAC.280, 15-Mar-79 16:21:58, EDIT BY OSMAN
;USE FI%ERR INSTEAD OF -2 FOR FILESPEC ERRORS. ALSO, .FIERR, .FISTR
;<4.EXEC>EXECSU.MAC.279, 15-Mar-79 14:30:59, EDIT BY OSMAN
;ADD OPNMAG
;<4.EXEC>EXECSU.MAC.275, 14-Mar-79 13:56:27, EDIT BY OSMAN
;ADD $DTP TO READ DATE AND TIME IN PAST (LIKE FOR SINCE SUBCOMMAND OF DIR)
;<4.EXEC>EXECSU.MAC.274, 13-Mar-79 15:54:33, EDIT BY OSMAN
;ADD REWIND ROUTINE
;<4.EXEC>EXECSU.MAC.273, 12-Mar-79 18:06:40, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;UNBREAK RLJFNS (CHECK FOR GS%NAM)
;<4.EXEC>EXECSU.MAC.271, 12-Mar-79 09:58:58, EDIT BY OSMAN
;ADD LM
;<4.EXEC>EXECSU.MAC.270, 9-Mar-79 16:45:02, EDIT BY OSMAN
;don't ever "fail" in RJFN, since it is in error recovery loop!
;<4.EXEC>EXECSU.MAC.269, 9-Mar-79 10:37:36, EDIT BY OSMAN
;MAKE %B ALLOW SPECIFIC TIME
;<4.EXEC>EXECSU.MAC.267, 7-Mar-79 13:32:19, EDIT BY OSMAN
;FIX GLOADS
;REMOVE A BILLION EDIT HEADERS
;<4.EXEC>EXECSU.MAC.260, 2-Mar-79 15:48:18, EDIT BY OSMAN
;handle TIMER errors better
;<4.EXEC>EXECSU.MAC.258, 2-Mar-79 14:41:22, EDIT BY OSMAN
;ADD GLOADS; PRINT LOAD AVERAGE ON ^T
;<4.EXEC>EXECSU.MAC.257, 1-Mar-79 17:02:27, EDIT BY OSMAN
;CALL RJFNER INSTEAD OF JERR IN RJFNS2 TO PREVENT "?JFN IS NOT ASSIGNED"
;<4.EXEC>EXECSU.MAC.256, 1-Mar-79 09:31:15, EDIT BY OSMAN
;CHANGE %EOL AND SNDEOL TO BE MORE EFFICIENT (SOUT INSTEAD OF BOUT BOUT)
;<4.EXEC>EXECSU.MAC.254, 28-Feb-79 15:14:05, EDIT BY OSMAN
;put floating nums back to the old way (*sigh*)
;REMOVE CTYPE, %TYPE
;<4.EXEC>EXECSU.MAC.250, 27-Feb-79 16:52:13, EDIT BY OSMAN
;SPEED UP EXEC BY NOT DOING BOUTS IN ETYPE AND TYPE. DO SOUT INSTEAD
;REMOVE ATSVAR
;<4.EXEC>EXECSU.MAC.249, 27-Feb-79 15:54:49, EDIT BY OSMAN
;GET RID OF CCHRO
;<4.EXEC>EXECSU.MAC.248, 27-Feb-79 11:38:09, EDIT BY OSMAN
;change %Q to not put out any leading spaces on floating pt nums
;<4.EXEC>EXECSU.MAC.246, 27-Feb-79 10:12:36, EDIT BY OSMAN
;ADD CLSON
;<4.EXEC>EXECSU.MAC.245, 27-Feb-79 09:38:55, EDIT BY OSMAN
;<4.EXEC>EXECSU.MAC.244, 27-Feb-79 09:37:25, EDIT BY OSMAN
;<4.EXEC>EXECSU.MAC.243, 20-Feb-79 16:18:50, EDIT BY OSMAN
;MAKE ^T OUTPUT ALWAYS GO TO COJFN EVEN IF OUTPUT DIVERTED TO A BUFFER
;<4.EXEC>EXECSU.MAC.240, 19-Feb-79 14:31:25, EDIT BY OSMAN
;IF AT COMMAND LEVEL, ALLOW MOUNT RECEIPTS TO BE ANNOUNCED
;<4.EXEC>EXECSU.MAC.239, 15-Feb-79 16:42:56, EDIT BY HEMPHILL
;TCO 4.2190 -- FIX MFOUT TO USE *.* AS DEFAULT IF ONLY ONE INPUT FILESPEC
;HAD BEEN SPECIFIED, AND THAT FILE DIDN'T EXIST
;<4.EXEC>EXECSU.MAC.236, 13-Feb-79 17:54:30, EDIT BY OSMAN
;HANDLE QUASAR DISAPPEARING MORE GRACEFULLY (SEE SPTBL)
;<4.EXEC>EXECSU.MAC.235, 13-Feb-79 15:15:55, EDIT BY OSMAN
;CHANGE MFBUF SIZE FROM EXTSIZ TO FILWDS AT MFSET
;<4.EXEC>EXECSU.MAC.234, 7-Feb-79 10:35:38, EDIT BY OSMAN
;change GETNOD to give an error return if fails
;<4.EXEC>EXECSU.MAC.232, 1-Feb-79 18:58:09, EDIT BY ACARLSON
;DELETE GQSRPD TO APPEASE BIG WIGS (CODE FREEZE)
;<4.EXEC>EXECSU.MAC.230, 1-Feb-79 17:19:50, EDIT BY OSMAN
;ADD IPCHEK
;<4.EXEC>EXECSU.MAC.229, 1-Feb-79 17:07:50, EDIT BY OSMAN
;MAKE IPCOFF/IPCON NESTABLE. HANDLE MESSAGE OVERFLOW BETTER
;<4.EXEC>EXECSU.MAC.228, 31-Jan-79 20:29:54, EDIT BY ACARLSON
;ADD GQSRPD TO REQUEST A PRIVATE QUASAR'S PID FROM SYSTEM INFO
;<4.EXEC>EXECSU.MAC.226, 31-Jan-79 14:29:54, EDIT BY OSMAN
;DON'T FLJFNS AT ERRF1. DO IT AT SUBCOMMAND ERROR INSTEAD (SBCOM1)
;<4.EXEC>EXECSU.MAC.225, 30-Jan-79 14:08:59, EDIT BY OSMAN
;CHECK FOR DESX3 IN RJFNER
;<4.EXEC>EXECSU.MAC.224, 29-Jan-79 09:17:02, EDIT BY OSMAN
;ADD REFERENCE TO CF%NS
;<4.EXEC>EXECSU.MAC.223, 26-Jan-79 14:30:54, EDIT BY OSMAN
;ADD $RNODE AND $FNODE
;<4.EXEC>EXECSU.MAC.221, 25-Jan-79 13:24:47, EDIT BY OSMAN
;ADD FIXIO, UPDATE COJFN IN TOCT, CALL FIXIO IN ERFRS1
;<4.EXEC>EXECSU.MAC.219, 24-Jan-79 13:59:47, EDIT BY OSMAN
;DON'T CALL UNMAP UNTIL RERET. DON'T CALL UNMAP IN REPARS.
;THIS IS NECESSARY SO THAT TYPING ERRORS DURING SUBCOMMAND MODE
;DOESN'T CAUSE SAVED STRINGS FOR CURRENT COMMAND TO BE LOST!
;<4.EXEC>EXECSU.MAC.218, 23-Jan-79 10:41:29, EDIT BY OSMAN
;CHANGE SUBCOMMANDS, SEE "SUBCOM" IN EXECDE
;<4.UTILITIES>EXECSU.MAC.1, 22-Jan-79 14:12:02, EDIT BY OSMAN
;MAKE SURE PIOFF AND PION PRESERVE AC'S
;<4.EXEC>EXECSU.MAC.214, 18-Jan-79 14:11:32, EDIT BY OSMAN
;add STREM
;<4.EXEC>EXECSU.MAC.213, 18-Jan-79 11:35:13, EDIT BY OSMAN
;MAKE PION/PIOFF NESTABLE
;<4.EXEC>EXECSU.MAC.212, 15-Jan-79 02:43:34, EDIT BY HEMPHILL
;MODIFY SUBROUTINES TO HANDLE USER EXTENDED ADDRESSING PROPERLY
;<4.EXEC>EXECSU.MAC.209, 13-Jan-79 16:09:04, EDIT BY OSMAN
;ADD XBUFFS, XFRINI
;<4.EXEC>EXECSU.MAC.208, 12-Jan-79 17:37:25, EDIT BY OSMAN
;REMOVE REFS TO RUNFK
;<4.EXEC>EXECSU.MAC.207, 12-Jan-79 17:08:35, EDIT BY OSMAN
;tco 4.2159 - single line error messages, no more lone "?"
;<4.EXEC>EXECSU.MAC.206, 10-Jan-79 18:32:29, EDIT BY HURLEY.CALVIN
; PRITXT - change QUASAR ack text offset from .MSDAT to .OHDRS+ARG.DA
;<4.EXEC>EXECSU.MAC.205, 5-Jan-79 10:36:30, EDIT BY OSMAN
;put FREINI here, and call it from UNMAP
;<4.EXEC>EXECSU.MAC.204, 4-Jan-79 10:21:41, EDIT BY OSMAN
;FIX UNMAP TO DELETE FREE SPACE
;<4.EXEC>EXECSU.MAC.203, 20-Dec-78 10:33:22, EDIT BY OSMAN
;make /after:thursday really mean "after Thursday"!!
;<4.EXEC>EXECSU.MAC.201, 18-Dec-78 16:49:25, EDIT BY OSMAN
;ADD GETNOD
;<4.EXEC>EXECSU.MAC.200, 7-Dec-78 11:25:19, EDIT BY OSMAN
;MAKE GETAMT GLOBAL, AND MAKE IT RETURN SECONDS IN B (INTERNAL IN A)
;<4.EXEC>EXECSU.MAC.198, 6-Dec-89 10:43:50, EDIT BY OSMAN
;tco 4.2110 - Fix recovery from bad confirmation of KILL subcommand
;<4.EXEC>EXECSU.MAC.196, 5-Dec-78 11:49:11, EDIT BY R.ACE
;ADD ATSAVR - DRIVER FOR ATSAVE MACRO
;<4.EXEC>EXECSU.MAC.195, 1-Dec-78 10:48:44, EDIT BY KIRSCHEN
;ADD SET [NO] DEFAULT TAKE
;<4.EXEC>EXECSU.MAC.194, 29-Nov-78 14:52:12, EDIT BY KIRSCHEN
;TURN OFF TAKE ECHOING AT CCHEOF NOT EOFPSI
;<4.EXEC>EXECSU.MAC.192, 22-Nov-78 15:33:46, EDIT BY KIRSCHEN
;TURN OFF PER-TAKE-COMMAND ECHOING AT EOFPSI
;<4.EXEC>EXECSU.MAC.191, 10-Nov-78 14:10:58, EDIT BY OSMAN
;CHANGE /AFTER:TOMORROW TO /AFTER:TODAY (LIKE THE SPEC SAYS! AND LIKE TOPS10
; DOES!)
;<4.EXEC>EXECSU.MAC.188, 7-Nov-78 14:34:31, EDIT BY OSMAN
;tco 4.2082 - REMOVE PUSH'S AT ERRFIN BEFORE CALL UNMAP, AND POP'S AFTER CALL
; UNMAP.
;1) WHY ARE THEY NEEDED, 2) THERE WAS ONE MORE POP THAN PUSH ANYWAY!
;3) they cause an infinite loop if TIMER fails at CMDIN4+40
;<4.EXEC>EXECSU.MAC.187, 1-Nov-78 15:13:44, EDIT BY OSMAN
;DETECT CHANGE OF SYSTEM PIDS, AND UPDATE EXEC'S COPY AS NEED BE
;<4.EXEC>EXECSU.MAC.186, 31-Oct-78 16:45:09, EDIT BY OSMAN
;ADD GETSXB
;<4.EXEC>EXECSU.MAC.185, 30-Oct-78 14:39:10, EDIT BY OSMAN
;MAKE GETSIX RECOGNIZE QUOTED CHARACTERS
;<4.EXEC>EXECSU.MAC.184, 27-Oct-78 18:22:22, EDIT BY OSMAN
;MAKE GETDIR, GETDRP RETURN POINTER TO ACCOUNT
;<4.EXEC>EXECSU.MAC.183, 27-Oct-78 12:12:15, EDIT BY OSMAN
;MAKE DIRINI ALLOCATE AND INITIALIZE SUBBLOCKS
;<4.EXEC>EXECSU.MAC.181, 26-Oct-78 14:37:19, EDIT BY OSMAN
;tco 4.2068 - Call DOECHO in REPARS
;<CALVIN>EXECSU.MAC.1, 9-Aug-78 12:56:14, EDIT BY CALVIN
; Install function routine for d&t or interval in days (DTIV)
;<3-ARC-EXEC>EXECSU.MAC.4, 4-Aug-78 10:22:05, EDIT BY CALVIN
; bugfixes from BBN's release 3 exec
;<3-ARC-EXEC>EXECSU.MAC.3, 14-May-78 18:34:50, Edit by MTRAVERS
;<3-ARC-EXEC>EXECSU.MAC.2, 14-May-78 17:20:51, Edit by MTRAVERS
;<3-ARC-EXEC>EXECSU.MAC.1, 14-May-78 17:04:27, Edit by MTRAVERS
; Added IGINV flag in SPECFN.
;<4.EXEC>EXECSU.MAC.173, 20-Oct-78 19:31:20, EDIT BY OSMAN
;MAKE IPCRCV/IPCFND RETURN MESSAGES IN THE ORDER THEY WERE SENT
;<4.EXEC>EXECSU.MAC.167, 16-Oct-78 13:32:57, EDIT BY OSMAN
;CLEAR IPCCTL IN ICLEAR, SO THAT ^C OUT OF IPCF WAIT WORKS
;<4.EXEC>EXECSU.MAC.166, 10-Oct-78 15:45:54, EDIT BY OSMAN
;tco 4.2039 - Make "TYPE A,B" name each file before typing it (worked in r2!)
;<4.EXEC>EXECSU.MAC.164, 8-Oct-78 20:14:20, EDIT BY OSMAN
;REMOVE PTY CHECK IN MWATCH ROUTINE
;CHANGE CIS'S TO CALL ICLEAR'S
;<4.EXEC>EXECSU.MAC.157, 8-Oct-78 17:28:00, EDIT BY OSMAN
;ADD %\ (SEE %CHAR)
;<4.EXEC>EXECSU.MAC.156, 8-Oct-78 14:54:55, EDIT BY OSMAN
;FLUSH NERET, CHANGE REFS TO RERET, SINCE THAT'S ALL NERET EVER HAD IN IT!
;<4.EXEC>EXECSU.MAC.155, 7-Oct-78 00:45:11, EDIT BY OSMAN
;add DGETER
;<4.EXEC>EXECSU.MAC.124, 28-Sep-78 16:43:08, EDIT BY OSMAN
;PUT IN STUFF FOR GETTING INTERRUPT ON IPCF MESSAGE
;<4.EXEC>EXECSU.MAC.123, 28-Sep-78 14:27:33, EDIT BY OSMAN
;REMOVE ALL Bn SYMBOLS
;<4.EXEC>EXECSU.MAC.115, 26-Sep-78 13:28:16, EDIT BY OSMAN
;TURN ON CM%WKF IF NOT LOGGED IN
;<4.EXEC>EXECSU.MAC.114, 22-Sep-78 16:56:24, EDIT BY OSMAN
;ADD GETASC
;<4.EXEC>EXECSU.MAC.110, 18-Sep-78 17:01:29, EDIT BY OSMAN
;MAKE BCOUNT BE GLOBAL
;TCO 4.2010 - FIX ERROR MESSAGE ON "DIR A,B,C,D" IF C DOESN'T EXIST
;<4.EXEC>EXECSU.MAC.92, 15-Sep-78 15:30:13, EDIT BY OSMAN
;USE STANDARD FREE-SPACE MANAGEMENT FOR MANIPULATING STRINGS
;<4.EXEC>EXECSU.MAC.90, 14-Sep-78 14:10:59, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECSU.MAC.89, 14-Sep-78 11:17:28, EDIT BY OSMAN
;ADD QUASAR ROUTINES QUASND, QCLEAN
;<4.EXEC>EXECSU.MAC.88, 12-Sep-78 15:15:18, EDIT BY OSMAN
;REMOVE WAKE AND NOWAKE
;<4.EXEC>EXECSU.MAC.87, 14-Aug-78 16:51:55, EDIT BY OSMAN
;FIX GETTER TO RETURN -1 INSTEAD OF GARBAGE IF THERE IS NO TERMINATOR
;<4.EXEC>EXECSU.MAC.86, 13-Aug-78 14:37:03, Edit by HELLIWELL
;ADD CPFNA ENTRY FOR "SET EDITOR"
;<4.EXEC>EXECSU.MAC.85, 12-Aug-78 16:17:35, EDIT BY OSMAN
;MAKE ERRFIN GLOBAL
;<4.EXEC>EXECSU.MAC.83, 10-Aug-78 10:05:55, EDIT BY OSMAN
;IN CFN, CHANGE DEFINITION OF B17 TO MEAN "NO SUBCOMMANDS"
;<4.EXEC>EXECSU.MAC.81, 5-Aug-78 14:23:48, Edit by DBELL
;<4.EXEC>EXECSU.MAC.80, 5-Aug-78 14:04:26, Edit by DBELL
;TCO 1971. MAKE ^T ALWAYS SHOW THE CURRENT PROGRAM NAME
;<4.EXEC>EXECSU.MAC.79, 3-Aug-78 16:13:35, EDIT BY OSMAN
;FIX SPELLING OF SEPARATE, AND MAKE HELP MESSAGE FOR /AFTER: LOWERCASE
;<4.EXEC>EXECSU.MAC.78, 3-Aug-78 15:13:17, EDIT BY OSMAN
;PUT SPACE IN FRONT OF $ PROMPT TO PREVENT CONFUSION FOR OPERATOR MODE BATCH
; JOBS
;<4.EXEC>EXECSU.MAC.77, 3-Aug-78 14:50:59, EDIT BY OSMAN
;PREVENT FATAL ERROR/LOGOUT IF "TAKE" JFN CLOSED "ACCIDENTALLY"
;USE STANDARD TRAP LOGIC FOR ILL INST TRAP
;<4.EXEC>EXECSU.MAC.76, 2-Aug-78 11:07:04, EDIT BY OSMAN
;MAKE THINGS LIKE "ILLEGAL MEMORY READ" HAVE "?" IN FRONT OF THEM
;<4.EXEC>EXECSU.MAC.73, 2-Aug-78 10:13:06, EDIT BY OSMAN
;ADD PDL OVERFLOW ROUTINE
;<4.EXEC>EXECSU.MAC.71, 27-Jul-78 15:56:38, EDIT BY OSMAN
;CHANGE $STR TO USE CM%PO
;<4.EXEC>EXECSU.MAC.69, 25-Jul-78 10:12:15, EDIT BY OSMAN
;ADD RJFN TO UNSTACK A SINGLE JFN
;<4.EXEC>EXECSU.MAC.66, 21-Jul-78 10:11:52, Edit by PORCHER
;MAKE "TAKE, ECHO" PRINT RIGHT PROMPT
;ADD GETMOD
;<4.EXEC>EXECSU.MAC.59, 20-Jul-78 15:42:01, EDIT BY OSMAN
;ADD SETMOD
;ALLOW FANCIER /AFTER:
;<4.EXEC>EXECSU.MAC.53, 18-Jul-78 15:54:52, EDIT BY OSMAN
;ALLOW "/AFTER:+72:0:0" ETC. (SEE BIGTIM:)
;<4.EXEC>EXECSU.MAC.49, 17-Jul-78 11:13:10, EDIT BY OSMAN
;GET RID OF REFS TO GTBUF
;<4.EXEC>EXECSU.MAC.48, 13-Jul-78 13:16:58, EDIT BY OSMAN
;REMOVE REFS TO ERPC
;REMOVE %Y:
;<4.EXEC>EXECSU.MAC.46, 10-Jul-78 20:40:12, EDIT BY OSMAN
;MAKE SVCSBP BE LOCAL
;<4.EXEC>EXECSU..1, 10-Jul-78 20:35:19, EDIT BY OSMAN
;REMOVE SVPRMT
;<4.EXEC>EXECSU.MAC.38, 10-Jul-78 14:09:25, EDIT BY OSMAN
;CLEAN UP CFN1 CODE TO NOT DO PUSH'S
;<4.EXEC>EXECSU.MAC.36, 29-Jun-78 15:39:33, EDIT BY OSMAN
;make cfnmod be local variable
;<4.EXEC>EXECSU.MAC.35, 29-Jun-78 13:49:19, EDIT BY OSMAN
;ADD SETT20, SETPRG
;<4.EXEC>EXECSU.MAC.30, 27-Jun-78 16:10:53, EDIT BY OSMAN
;CHANGE ALL GTB'S TO USE MONSYM SYMBOLS
;<4.EXEC>EXECSU.MAC.29, 27-Jun-78 16:02:40, EDIT BY OSMAN
;CHANGE GTB UUO TO BE IMMEDIATE
;<4.EXEC>EXECSU.MAC.28, 27-Jun-78 14:22:21, EDIT BY OSMAN
;ADD PION AND PIOFF ROUTINES THAT DON'T DO ANY JSYS'S
;<4.EXEC>EXECSU.MAC.25, 27-Jun-78 11:10:46, EDIT BY OSMAN
;ADD GTJFS AND REMOVE REF TO LNGJFN (IN JFNSTK)
;<4.EXEC>EXECSU.MAC.24, 26-Jun-78 13:54:16, EDIT BY OSMAN
;SET PROGRAM NAME TO COMMAND NAME WHEN COMMAND CONFIRMED
;<4.EXEC>EXECSU.MAC.22, 23-Jun-78 18:43:57, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: CFN2A, CFN4, CFNLEV, DEVN1, DIRNMS,
;DIRNMX, DWNPNT, ERRDO, MCOPY0, USRNMX, %Q1A
;<4.EXEC>EXECSU.MAC.14, 21-Jun-78 17:01:08, EDIT BY OSMAN
;USE INTERRUPT FOR MAIL-WATCH (AVOIDS DOING GTAD ON EVERY COMMAND)
;<4.EXEC>EXECSU.MAC.11, 19-Jun-78 14:43:34, EDIT BY OSMAN
;DON'T DO DVCHR EVERY TIME READY IS CALLED. (TEST TINPF INSTEAD)
;<4.EXEC>EXECSU.MAC.9, 19-Jun-78 10:43:27, EDIT BY OSMAN
;ADD GETSIX, FIXPT
;<4.EXEC>EXECSU.MAC.8, 12-Jun-78 13:48:10, EDIT BY OSMAN
;ADD BUFFS
;<4.EXEC>EXECSU.MAC.6, 9-Jun-78 18:01:27, EDIT BY OSMAN
;ADD FLDSKP
;<4.EXEC>EXECSU.MAC.5, 9-Mar-78 09:22:08, Edit by ENGEL
;ADD MTOPR FUNCTIONS FOR SAVEING AND RESTORING THE FULL MASK
;<4.EXEC>EXECSU.MAC.4, 31-Jan-78 13:37:00, Edit by PORCHER
;<4.EXEC>EXECSU.MAC.3, 31-Jan-78 11:51:09, Edit by PORCHER
;<4.EXEC>EXECSU.MAC.2, 31-Jan-78 09:33:07, Edit by PORCHER
;Add stuff for "TAKE,ECHO"
;<4.EXEC>EXECSU.MAC.1, 30-Jan-78 17:18:19, Edit by PORCHER
;Add stuff for execute-only
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE - SUBROUTINES
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
TTITLE 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
;7 all INTERNs now indicated via "::" labels, except for ULIST entries in order
;7 to keep it easy to add new routines there
;713 rename XX macro to PARFLD to coresspond with DE
DEFINE PARFLD (FOO)
< INTERN FOO'$>
ULIST
;SAVE TEMP AC'S - COMMONLY USED VIA ATSAVE MACRO
.SAVT:: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSHJ P,(CX) ;CONTINUE ROUTINE
ABSKP
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
;
; CALLING SEUQENCE:
; HELPX <THIS IS WHAT "?" TYPES OUT>
; KEYWD TABLE ;"TABLE" IS ADDRESS OF TBLUK KEYWORD TABLE
; T FOO... ;APPROPRIATE "T" MACRO FORM OF DEFAULT VALUE
; ERROR RETURN
; SUCCESS RETURN
;
; RETURNS: +1 ERROR, PROBABLY NO MATCH
; +2 B/ TABLE ENTRY ADDRESS
; P3/ VALUE FROM TABLE
%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 FIELD ;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 AND RETURN TABLE DATA, AND DO ONEWRD
; CONFIRMATION
;
; ACCEPTS: B/ TABLE ADDRESS
; RETURNS: P3/ TABLE DATA
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.
;
; ACCEPTS: B/ ADDRESS OF FUNCTION DESCRIPTOR BLOCK
; RETURNS: A,B,C/ WHATEVER COMND% PUT THERE
FIELD:: 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 ;7 wake-every-field
ANDCAM A,CMFLG ;7 turn it off
SKIPN WAKFLD ;7 turn back on if set
SKIPE PASCMD ;7 or if password command (this doesn't work)
IORM A,CMFLG ;7
MOVX A,CM%XIF ;7 indirect file specification
SKIPN CUSRNO ;7 logged in?
IORM A,CMFLG ;7 no, disallow
DELETE,<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
GTFLDT A ;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 ;715 just confirmed top-level PCL command?
SETOM PCCIPF ;715 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 ;715 already have byte pointer setup
JRST FIELD3 ;715 yes, don't change COMAND
HLRZ A,(A) ;GET ADDRESS OF COMMAND NAME INFO
MOVX B,177B6 ;SEE IF THIS IS A FLAG WORD
TDNN B,(A) ;IS IT?
ADDI A,1 ;YES, SO COMMAND NAME STARTS IN NEXT WORD
FIELD2: HRLI A,(ASCPTR) ;MAKE POINTER TO BEGINNING OF COMMAND NAME
MOVEM A,COMAND ;REMEMBER POINTER TO ASCII
FIELD3: SKIPE PCCURC ;715 PCL command in progress?
MOVE A,PCLNAM ;715 yes, so use its name
CALL GETSIX ;GET SIXBIT NAME FOR COMMAND
NOP ;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
CALL ECHCMD ;ECHO THE COMMAND IF NECESSARY
CEF,< CALL CSAVE> ;716 save the command for command-edit
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
SETO A,
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 FIELD ;PARSE THE INPUT
TXNE A,CM%NOP ;DID IT PARSE CORRECTLY?
RET ;NO, NON-SKIP
RETSKP ;YES, SKIP
;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
ABSKP ;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
ADDI A,1 ;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,(POINT 1,0,0) ;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:: MOVX C,1 ;GET 1 TO STUFF INTO BIT
HRLI B,(POINT 1,0,0) ;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
ERNOP ;FAILED, PROBABLY OLD MONITOR
RET
;ROUTINE TO GET TOPS20 MODE
;
; RETURNS: A/ MODE
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
MOVX A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVE A,WJOBN ;GET JOB
MOVEM A,.SAJOB+GLBLK
MOVX 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
MOVX A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVX 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
GLOVER::STKVAR <WJOBN,<GLBLK,GLBLN>> ;7 get overall load averages
GLNO: MOVX D,14 ;FIRST SYSTEM LOAD AVERAGE IS WORD 14
GTB .SYSTA
MOVEM A,.SA1ML+GLBLK ;STORE THE LOAD AVERAGES
MOVX D,15
GTB .SYSTA
MOVEM A,.SA5ML+GLBLK
MOVX D,16
GTB .SYSTA
MOVEM A,.SA15L+GLBLK
SETO A, ;-1 MEANS CLASS SCHEDULING IS OFF
MOVEM A,.SACLS+GLBLK
JRST GLN2 ;GO RETURN RESULTS
;SKIP IF CLASS SCHEDULER IS ON...
;
; RETURNS: A/ CONTAINS STATUS BITS OF SCHEDULER
CLSON:: MOVEI B,C ;ARG BLOCK IN C
MOVX A,.SKRCV ;READ STATUS
MOVX 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 LAST FIELD
;
; RETURNS: A/ TERMINATOR CHRACTER CODE, OR -1 IF NONE TYPED
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
SETZ C, ;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:: ;715 code that used to be here is moved below
CALL SETPMT ;715 get pointer to prompt string
JRST READ1 ;715 join common code
READY2::MOVEM A,CMDACS ;DON'T CLOBBER AC1
MOVX A,5 ;PCL PRECEDE PROMPT WITH SPACE IF BATCH
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
MOVX A,4 ;PCL USE DOLLAR SIGN
SKIPN PRVENF ;USE @ IF NOT ENABLED
MOVX A,3 ;PCL ONE PROMPT FOR REGULAR COMMAND
CALL SETPM2 ;715 get pointer to subcommand prompt
JRST READ1 ;715 join common code
SETPMT: ;715 add local label
;715 this code (upto SETPM2) moved from above
MOVEM A,CMDACS ;DON'T CLOBBER ANY AC'S
MOVX A,2 ;PCL ASSUME ENABLED BATCH
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
MOVX A,1 ;PCL USE A DOLLAR SIGN
SKIPN PRVENF ;USE @ IF NOT ENABLED
SETZ A, ;PCL ONE PROMPT FOR REGULAR COMMAND
;715 JRST READY3
SETPM2: ;715 add local label
;715 READY3:
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 INSTEAD
MOVE A,B ;PCL
MOVE B,CMDACS+1 ;PCL
RET ;715
;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 P,CMDACS+17 ;SAVE AC17 AWAY
MOVEI P,CMDACS ;MAKE BLT POINTER 0,,CMDACS
BLT P,CMDACS+16 ;SAVE REST TO AC'S
MOVE P,CMDACS+17 ;LEAVE AC17 INTACT
MOVE A,JBUFP ;GET CURRENT LOCATION ON JFN STACK
MOVEM A,.J ;REMEMBER WHERE WE ARE FOR REPARSE
SKIPE STICKY ;7 using sticky file defaulting?
CALL SFDFTO ;7 yes, remember current defaults 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 FIELD ;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
NOP ;715
CALL SETPMT ;715 get the correct prompt string
MOVEM A,CMRTY ;715 set it up
;715 JRST READ2 ;PCL
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
MOVE D,CMDACS+D ;7 sticky file defaulting uses an extra AC
JRSTF @REPARA ;RETURN TO CALLER
;PCL STANDARD PROMPT STRINGS
REDPMT::ASCIZ/@/ ;(0) DISABLED
MIT,< ASCIZ/!/ ;7 MIT tradition to run strange enabled prompt
ASCIZ/ !/ ;7
> ;7
NOMIT,< ASCIZ/$/ ;(1) ENABLED
ASCIZ/ $/ ;(2) ENABLED BATCH NEEDS SPACE BECAUSE OF
> ; OPERATOR
ASCIZ/@@/ ;(3) DISABLED SUBCOMMAND
MIT,< ASCIZ/!!/ ;7 likewise here
ASCIZ/ !!/ ;7
> ;7
NOMIT,< ASCIZ/$$/ ;(4) ENABLED SUBCOMMAND
ASCIZ/ $$/ ;(5) 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.
; INTERRUPTS 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
MOVX 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, GENERALLY FROM A KEYWORD TABLE. USED IN FORK COMMAND
; (XCMD1.MAC), %KEYWD (JUST ABOVE).
;
; ACCEPTS: B/ PRIVILEGE BITS TO CHECK
; RETURNS: +1 USER DOESN'T HAVE SPECIFIED CAPS
; +2 OTHERWISE
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
MOVX 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!SC%MNT ;7 YES - HAS USER GOT IT? (add maintainance)
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. USED IN 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 P,.P ;REMEMBER STACK POINTER IN CASE ERROR DURING
; SUBCOMMAND
MOVEM 15,.AC15 ;7 SPR #:20-17409 save TRVAR pointer
SBCOM1: SETOM CEBPTR ;716 subcommands are not recorded
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
CALL ECHCMD ;7 SPR #:20-15373 echo subcomands on TAKE, ECHO
SKIPE INITR ;IS THERE AN INITIALIZATION ROUTINE?
CALL @INITR ;YES, EXECUTE IT
CALL (P3) ;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
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, ETC.) IF
; A NON-COMMENT PRECEDES THE CONFIRMATION, AN ERROR MESSAGE RESULTS.
;
;FCONF - PRINTS [CONFIRM] THEN FORCES FURTHER CONFIRMATION
GOAHED::PROMPT < go ahead anyway? [confirm]> ;7 make sure user really wants it
ABSKP ;7
FCONF:: PROMPT <[Confirm]>
FCONFA::
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.
;
; RETURNS: +1 COMMA AND RETURN
; +2 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
SKIPE STICKY ;7 maybe reset sticky file defaults
CALL SFDCTO ;7
SETZM CSZ1 ;7 zero flags in special area
MOVE A,[CSZ1,,CSZ1+1] ;7
BLT A,CSZ1A ;7
MOVSI P,CMDACS ;MAKE BLT POINTER CMDACS,,0
BLT P,P ;RESTORE AC'S TO HOW THEY WERE WHEN THIS PART
; OF COMMAND STARTED
SETZM CEBPTR ;716 reset CEDIT recording status
SKIPN CERECD ;716
SETOM CEBPTR ;716
;715 SETZM PCLDCO ;PCL Clear original command flag
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
JRST CCEOF1 ;7 not primary
CCHEOP: ETYPE < Fatal end of primary input%_> ;7 hang it up
HALTF ;7
JRST .-1 ;7 don't continue
CCEOF1: ;7 add local label
ETYPE < End of %1S%%_>
CLOSF ;CLOSE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
SKIPE LGOCMD ;7 inside LOGOUT.CMD
JRST LOGOU2 ;7 yes, logout
JRST CMDIN4 ;GO BACK FOR NEXT COMMAND
;ROUTINE TO POP BACK TO LAST EXEC INPUT STREAM.
; 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.
;
; RETURNS: +1 A/ JFN OF OLD INPUT
; +2 NOTHING TO DELETE (I.E. ONLY ONE SET OF JFNS ON THE
; COMAND STREAM STACK)
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 ;715 close only if not a terminal designator
ABSKP ;715
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
;
; RETURNS: +1 SUCCESS
; +2 NONE TO GET RID OF
CLRIO: CALL CIOREL ;CLOSE STREAM
ABSKP ;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: %ERR
%ETYPE
%KEYW
%NOI
%$TYPE
%LERRO
0
%$ERR
%ETYPE
%GTB
%PRINT
%TRAP
%.$ERR
%SBCOM
%%U==.-CUUOT
;713 XX becomes PARFLD to correspond with DE
DEFINE PARFLD (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,(ASCPTR) ;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.
; ROUTINE "%FOO" ASSUMES THAT THE PREVIOUS HELP STRING IS TO BE USED.
;DECIMAL NUMBER...
DEC$: CALL GETHLP ;SET UP HELP MESSAGE
MOVX A,^D10 ;RADIX
NUM13: MOVEM A,CMDAT
MOVX A,CMNUM
CALLRET $WORK ;INPUT THE NUMBER AND SKIP OR NORMAL RETURN
;7 Decimal Number
;7 also accepts string "+INF" which is equal to 377777,,777777
;7
;7 RETURNS: +1 error
;7 +2 A/ value
DECIML::SAVEAC <B,C,D> ;7 these get clobbered
MOVE D,A ;7 save AC A in D
MOVEI B,[FLDDB. .CMKEY,CM%SDH,$INFIN,<a decimal number or "infinity">,,[
FLDDB. .CMNUM,CM%SDH,^D10]] ;7
CALL FLDSKP ;7
JRST [MOVE A,D ;7 error
RET] ;7
GTFLDT D ;7 get parse type
CAIN D,.CMNUM ;7 number?
JRST [MOVE A,B ;7 yes, move to A
RETSKP] ;7
HRLOI A,377777 ;7 +INF
RETSKP ;7
$INFIN: TABLE ;7 infinity key word table
T infinity,,0 ;7
TEND ;7
;OCTAL NUMBER
OCT$: CALL GETHLP
MOVX A,10 ;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$: MOVX A,1 ;SAY WE WANT TIME RELATIVE TO NOW
JRST DT1
DT$: TDZA A,A ;SAY WE WANT TIME IN THE FUTURE
DTP$: SETO A, ;SAY WE WANT TIME IN THE PAST
DT1: TRVAR <RETBTS,TODAY,SENSE,DAYWEK,NOW,TOMORO,BTIME,<STRNG0,10>>
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
MOVX B,1B17
ADD B,A ;GET TOMORROW SAME TIME IN A
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/]
SETZ C,
SOUT ;MAKE DATE AND TIME FOR BEGINNING OF TOMORROW
HRROI A,STRNG0 ;POINT AT FULL STRING
SETZ B, ;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,TXTPTR <+>,<"+" to enter amount of time
from now>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<a 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,TXTPTR <->,<"-" to enter amount of time
in past>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<a day of the week or TODAY>]]]]]
CALL $WORK
RET ;BAD INPUT TYPED
GTFLDT D ;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
CAMG B,NOW ;COMPUTE VALUE TO ADD
ADDI A,1
JUMPE A,DTEXIT ;DON'T BOTHER IF ZERO
HRLZ A,A ;PUT VALUE IN LEFT HALF
ADD B,A ;FIX UP DATE-TIME
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
;...
;DTEXIT IS THE COMMON EXIT FOR TIME-AND-DATE PARSING.
;
; RETURNS: A/ BITS 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
ADDI B,1
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
SETZ D, ;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
JRST DAPLSQ ;MAYBE USER TYPING "+" AFTER THE DAY
;USER HAS TYPED /AFTER:TODAY OR SINCE TODAY
.TODAY: 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,TXTPTR <+>,<an 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
DAA1: ADD A,BTIME
MOVE B,A ;RETURN INTERNAL DATE-AND-TIME IN B
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: SETZ A, ;NO PLUS, SO NO MODIFICATION OF BASE TIME
JRST DAA1
;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,TXTPTR <+>,<"+" to enter interval in
number of days>]]]]
CALL $WORK
RET ;BAD INPUT
GTFLDT 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$: SETZ A, ;NO WILDCARDING
MOVEM A,CMDAT ;STORE IN DATA FIELD
CALL GETHLP
MOVX A,CMUSR ;USER NAME FUNCTION
CALLRET $WORK
;DIRECTORY NAME
;1021 DIRS$: MOVX A,CM%DWC ;ALLOW WILDCARDING
;1021 MOVEM A,CMDAT ;STORE IN DATA FIELD
;1021 DIR$: CALL GETHLP
DIRS$: SKIPA A,[CM%DWC] ;1021 Allow wildcarding
DIR$: SETZ A, ;1021 No wildcarding
MOVEM A,CMDAT ;1021
CALL GETHLP ;1021
MOVX A,CMDIR
CALLRET $WORK
;STRUCTURE NAME, LIKE DEVICE BUT NEEDN'T EXIST
STR$: CALL GETHLP
MOVX A,CMDEV!CM%PO
JRST $DEV1 ;REST SAME AS DEVICE
;DEVICE
DEV$: CALL GETHLP
MOVX A,CMDEV
$DEV1: CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;FAKE NODE, SYNTAX CORRECT ONLY
FNODE$: CALL GETHLP
MOVX A,CMNOD!CM%PO
JRST $RNOD1 ;REST SAME AS REAL NODE
;REAL NODE, MUST BE KNOWN BY SYSTEM
RNODE$: CALL GETHLP
MOVX A,CMNOD
$RNOD1: CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;FILE SPECIFICATION
FILE$: SKIPN STICKY ;7 sticky file defaulting
JRST FILE$1 ;7
CALL FILE$1 ;7 try to get file spec
ABSKP ;7
JRST RSKP ;7 sucess
SETZM CJFNBK+.GJEXT ;7 try again with no default extension
CALL FILE$1 ;7
ABSKP ;7
JRST RSKP ;7 sucess
SETZM CJFNBK+.GJNAM ;7 try again with no name
MOVEI A,SFDFIL+.GJEXT ;7 but with default extension
MOVEM A,CJFNBK+.GJEXT ;7
CALL FILE$1 ;7
ABSKP ;7
JRST RSKP ;7 sucess
SETZM CJFNBK+.GJEXT ;7 try again with no defaults
FILE$1: ;7 add local label
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 ARBITRARY CHARACTER
;
; ACCEPTS: A/ CHARACTER TO PARSE
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. ;7 what's this doing here?
;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,,TXTPTR <,,>]
CALL FLDSKP ;SEE IF TWO COMMAS NEXT
JRST [NC: MOVE B,LHVAL ;NO COMMAS, SO THERE'S ONLY ONE NUMBER
RETSKP]
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: HRLZ B,LHVAL ;ALLOW "FOO,,"
RETSKP]
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
CALLRET EVAL ;EVALUATE ADDRESS AND SKIP OR NORMAL RETURN
;ACCOUNT
ACCT$: CALL GETHLP ;SET UP HELP TEXT
MOVX A,CMACT ;SPECIFY ACCOUNT FUNCTION
CALLRET $WORK
;WORD
WORD$: USTAR @40 ;WORD MIGHT BE "*"
ABSKP ;NON-* TYPED
RETSKP ;YUP, WAS.
CALL GETHLP
MOVX A,CMFLD ;ARBITRARY FIELD FUNCTION
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
HRRO A,40 ;GET POINTER TO HELP STRING
MOVEM A,CMHLP ;SET UP HELP TEXT POINTER
RET
;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 OUTPUT
;
; ACCEPTS: GROUPF/ WHETHER TO ACCEPT WILDCARDS
; RETURNS: OUTDSG/ JFN IF GROUPF NOT SET, DEFAULTS NAME AND EXT TO INPUT
; JFN
; MCOJFN/ JFN IF GROUPF SET, DEFAULTS TO *.*.-1
MFOUT:: MOVE A,[[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: MOVX 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,FLD(.JSAOF,JS%DEV) ;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,FLD(.JSAOF,JS%DIR) ;SPECIFY DIRECTORY
TXNE B,GJ%DIR ;STAR IN DIRECTORY FIELD?
CALL BADSTR ;YES, MAKE SURE IT'S LEGAL
LDF C,FLD(.JSAOF,JS%NAM) ;NAME FIELD
TXNE B,GJ%NAM
CALL BADSTR ;MAKE SURE LEGAL STARS IN NAME FIELD
LDF C,FLD(.JSAOF,JS%TYP) ;TYPE FIELD (EXTENSION)
TXNE B,GJ%EXT
CALL BADSTR
LDF C,FLD(.JSAOF,JS%GEN) ;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 "*".
; 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.
;
; ACCEPTS: B/ INDEXABLE FILE HANDLE (FLAGS,,JFN)
; C/ JFNS BITS
; AC'S PRESERVED.
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
;
; ACCEPTS: MCOJFN/ SCANNED OUTPUT NAME JFN
; RETURNS: +1 GTJFN ERROR, ERROR MESSAGE ALREADY PRINTED
; +2 OUTDSG/ JFN, SUCESSFUL GTJFN AFTER PRINTING FILESPEC
MFSET:: TRVAR <MFPP,<MFBUF,FILWDS>,MFDTY> ;7 add MFDTY
SKIPN MCOJFN ;MULTI FILE OUTPUT?
RETSKP ;NO, JFN ALREADY IN OUTDSG
SETZM MFBUF ;SO WE CAN CHECK FOR NULL STRING
HRROI A,MFBUF
MOVEM A,MFPP ;INITIALIZE BYTE POINTER TO BUFFER
MOVX A,GJ%DEV ;FLAG BIT TO TEST
MOVX C,FLD(.JSAOF,JS%DEV)!JS%PAF ;GET DEVICE
CALL MCOSTR ;GET STRING
MOVE A,MFPP ;7 get device designator
STDEV ;7
ERNOP ;7
HLRZ B,B ;7 save left half (chop off unit number)
MOVEM B,MFDTY ;7
MOVX A,GJ%DIR
MOVX C,FLD(.JSAOF,JS%DIR)!JS%PAF ;GET DIRECTORY
CALL MCOSTR
MOVX A,GJ%NAM
MOVX C,FLD(.JSAOF,JS%NAM)!JS%PAF ;NAME
CALL MCOSTR
MOVE A,MFDTY ;7 get device type
CAIE A,.DVDES+.DVNET ;7 network, use full name
SKIPE MFBUF ;7 null filespec?
ABSKP ;7
;7 SKIPN MFBUF ;NULL FILESPEC?
JRST MFSET1 ;YES
MOVX A,GJ%EXT
MOVX C,FLD(.JSAOF,JS%TYP)!JS%PAF ;EXT
MOVE D,MFPP ;SAVE THE CURRENT STRING POINTER
CALL MCOSTR
MOVX A,"." ;FOR NULL EXTENSIONS
CAMN D,MFPP ;SEE IF WE GOT SOMETHING
IDPB A,MFPP ;NOTHING CHANGED, FORCE A NULL EXTENSION
MOVX 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
MOVX C,FLD(.JSSSD,JS%ACT)!JS%PAF ;ACCOUNT
CALL MCOSTO
MOVX C,JS%TMP!JS%PAF ;";T"
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
MOVX 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
MOVX C,FLD(.JSSSD,JS%DEV)!FLD(.JSSSD,JS%DIR)!FLD(.JSSSD,JS%NAM)!
FLD(.JSSSD,JS%TYP)!FLD(.JSSSD,JS%GEN)!FLD(.JSSSD,JS%PRO)!FLD(.JSSSD,JS%ACT)!
JS%TMP!JS%ATR!JS%PAF
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
JFNS
HRRZ A,OUTDSG
DVCHR ;GET DEVICE CHARACTERISTICS OF OUTPUT FILE
LDB A,[POINTR B,DV%TYP] ;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
TXNE A,FB%NXF ;7 new file?
;7 TXNN A,FB%NXF ;NEW FILE?
RETSKP ;7
TXNE A,FB%NDL ;7 perpetual?
JRST [TYPE < ?Cannot supercede perpetual file> ;7 yes, say something
RET] ;7
TYPE < [Superseding]> ;NO, INFORM USER
RETSKP
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
;
; RETURNS: A/ FLAGS,,JFN
MFINP0::STKVAR <MFJFN,<MFIBUF,FILWDS>>
HRROI A,MFIBUF
HRRZ B,@INIFH1 ;JFN
MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!
FLD(.JSAOF,JS%TYP)!FLD(.JSAOF,JS%GEN)!JS%ATR!JS%PAF ;DEVICE:<DIR>NAME.EXT;GEN
JFNS
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
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
;COLLECT FILE NAMES: COUTFN, CPFN, DIRARG, INFG, .INFG, SPECFN AND SO ON
; VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, AND GROUP DESCRIPTORS. CAN
; INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS * FORMS.
;
; ACCEPTS: Z/ FLAGS
; F3: DEFAULT DIRECTORIES TO CONNECT AND LOGIN AFTER
; INITIAL TRY FAILS, FOR DEFAULT RUN
; IGINV: ALLOW INVISIBLE FILES (G1%IIN)
; A/ LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
; -2: LIKE -1 BUT RETURN +1 IF NO SUCH FILE
; -1: GIVE INPUT TO GTJFN EVEN IF NULL OR *
; 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
; RH: 0, 2, OR DEFAULT EXTENSION POINTER
; 2: USE EXT OF LAST FILE NAME INPUT AS DEFAULT EXT
; B/ ("SPECFN" ENTRY ONLY)
; LH: DEFAULT VERSION (USUALLY 0)
; RH: FLAGS FOR GTJFN PLUS:
; B14: (CF%ERR) IF NO SUCH DEVICE, NO SUCH DIRECTORY,
; ETC. RETURN PTR,,FI%ERR IN PLACE OF JFN; PTR
; POINTS TO <CHAR COUNT>,,<ERROR #> FOLLOWED BY
; BYTE POINTER TO TYPESCRIPT.
; B15: (CF%GRP) 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: (CF%EOL) ALLOW GROUP OF NAMES SEPARATED BY
; SPACE, ALTMODE, OR SPACE-COMMA OR
; ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED BY
; ALTMODE OR EOL, RETURN +1 (TO INDICATE
; SUBCOMMAND INPUT REQUIRED). B15 SHOULD ALSO BE
; ON. THIS IS ONLY USEABLE IF LIST IS LAST THING
; IN COMMAND; CAN PRE-READ FOLLOWING FIELD
; B17: (CF%NS) NO SUBCOMMANDS FOLLOW THE LIST.
; RETURNS: +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.
; P2/ TERMINATOR, SEE NOTE BELOW
; +2 SUCCESS
; Z/ GROUPF FLAG MAY BE SET (SEE DESCRIPTION FOR A)
; A/ JFN 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 & B 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).
; B/ MAY BE SET TO LASTLOC IN JBUF (SEE DESCRIPTION FOR A)
; D/ LH: FLAGS
; B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED
; BY COMMA
; B2: SAME AS B1, EXCEPT FOLLOWED BY A COMMA
; P2/ TERMINATOR ASSUME NULL INPUT IF LAST TERMINATOR= EOL
; AND BAKFF OFF, AS %KEYW DOES. SEE %KEYW'S GLITCH
; NOTE (S1.MAC).
; JBUFP/ SEE DESCRIPTION FOR A
; JBUF/ DITTO
; INIFH1/ DITTO
;COLLECT FILE NAMES... ENTRIES.
CSAVFN::MOVX B,(GJ%FOU!GJ%MSG) ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME). PRINTS WHETHER OLD OR NEW, NO
; CONFIRMATION.
COUTFN::MOVX 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".
;.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.
INFGNS::HRLI B,-3
HRRI B,(GJ%OLD!GJ%IFG!GJ%NS!CF%ERR!CF%GRP) ;* VERSION FOR RENAME
JRST .INFG1
INFGN2::MOVX B,(GJ%OLD!GJ%IFG!GJ%NS!CF%ERR!CF%GRP) ;7 only highest generation
ABSKP
;.INFG
; BUT WITH NO SEARCH (FOR ACCOUNT, VERSION-RET..., PROTECTION)
.INFG:: MOVX B,(GJ%OLD!GJ%IFG!CF%GRP)
.INFG1: MOVE A,[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::MOVX B,(GJ%OLD!GJ%IFG!CF%ERR!CF%GRP!CF%EOL)
MOVE A,[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::SETZ A,
MOVX B,(GJ%OLD!GJ%IFG!CF%GRP!CF%EOL!CF%NS) ;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,[[ASCIZ/*/],,[ASCIZ/*/]]
HRLI B,-3 ;DEFAULT VERSION: *
HRRI B,(GJ%OLD!GJ%DEL!GJ%IFG!CF%ERR!CF%GRP!CF%EOL)
JRST SPECFN
;COLLECT FILE NAMES ENTRIES...
;ENTRY FOR GTJFN FLAGS
; USED IN SPECIAL CASES, EG: DELETED FILE NAME FOR "UNDELETE", ANYWHERE *'S
; ARE ALLOWED, AS IN "DIRECTORY".
;
; ACCEPTS: (AMONG OTHER THINGS)
; B/ LH: DEFAULT VERSION (NORMALLY 0)
; RH: GTJFN AND SPECIAL FLAGS
;END OF ENTRIES. CASES MERGE HERE.
SPECFN::SETZM CJFNBK+2 ;NO DEFAULT DEVICE
SETZM CJFNBK+3 ;AND NO DEFAULT DIRECTORY
SKIPN STICKY ;7 sticky file defaulting?
JRST CFN1A ;7 no, skip this
SKIPG STICKY ;7 per-command?
SKIPA D,[SFDCMD+.GJDEV,,CJFNBK+.GJDEV] ;7 yes, use this set
MOVE D,[SFDFIL+.GJDEV,,CJFNBK+.GJDEV] ;7 no, use per-filespec stuff
BLT D,CJFNBK+.GJEXT ;7 copy defaults into COMND GTJFN block
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,(CF%ERR!CF%GRP!CF%EOL) ;DON'T GIVE LOCAL FLAGS TO GTJFN
TRNN D,(GJ%OFG) ;IF OUTPUT GROUP THEN NOT INPUT
TRNN D,(GJ%IFG!CF%GRP!CF%EOL) ;IF AN INPUT GROUP IS BEING REQUESTED,
ABSKP
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
CAIE B,0
HRLI B,(ASCPTR)
SKIPE STICKY ;7 sticky file defaulting?
CAIE B,0 ;7 yes, never zero default
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,
CAIE B,0
HRLI B,(ASCPTR)
SKIPE STICKY ;7 sticky file defaulting?
CAIE B,0 ;7 yes, never zero default
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
SKIPE STICKY ;7 maybe remember filename?
CALL SFDSAV ;7 try to
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!CF%GRP!CF%EOL)
RETSKP ;NO SUCH OPTIONS ON
HRRZ B,JBUFP
SKIPN INIFH1 ;FIRST JFN IN GROUP?
MOVEM B,INIFH1 ;YES, SAVE JBUF POINTER
TXNE A,77B5 ;ANY *'S INPUT OR DEFAULTED TO?
TLO Z,GROUPF ;YES, SAY GROUP WAS SPECIFIED.
TXNN D,(CF%GRP) ;INPUTTING GROUPS OF FILES?
JRST CFN7Z ;NO
TXNE D,(CF%EOL) ;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
;7 better format
B16ON: HELPX <Comma and another file specification
or comma and carriage return to enter subcommands
or carriage return to end command>
TXNE D,(CF%NS) ;DON'T ADVERTISE SUBCOMMANDS IF CALLER HAS NONE
;7 better format
HELPX <Comma and another file specification
or carriage return to end command>
CRRX ;INPUTTING UNTIL END OF LINE, HAVE WE REACHED
; IT YET?
ABSKP ;NOT YET
JRST CFN7Z ;YES
COMMAX ;COMMA AFTER FILE NAME?
ERROR <Comma missing between filespecs or illegal character in
command>
TXNE D,(CF%NS) ;NO SUBCOMMANDS?
JRST CFN22 ;RIGHT, SO COMMA MEANS ANOTHER FILE COMING
;7 better format
CRRX <Another file specification
or carriage return to enter subcommands> ;SUBCOMMANDS, SO WE WANT RETURN +1
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: Cannot create new files until you
"DELETE" some files and "EXPUNGE (DIRECTORY)">
TXNN D,(CF%ERR) ;NO SUCH FILE OK?
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
CMERRX ;LET MONITOR SAY WHAT'S WRONG WITH FILESPEC
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
MOVX 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 JSYS FOR MOST RECENTLY PREVIOUSLY INPUT FILE
;
; ACCEPTS: C/ JFNS FORMAT WORD
; RETURNS: B/ POINTER TO LEFT-JUSTIFIED STRING
; OR 0 FOR LAST JFN NOT ON DEVICE WITH DIRECTORY
; OR 0 FOR NO PREVIOUS JFN FOR THIS COMMAND
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,(ASCPTR) ;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
; WITH NO DEFAULT NAME, AND DEFAULT EXTENSION .EXE
;
; ACCEPTS: A/ 0 OR WORD POINTER TO DEFUALT DEVICE NAME
; RETURNS: +1 ON GTJFN FAILURE
CPFN:: MOVX B,(GJ%OLD)
;7 CPFNA:: ;7 not referenced anywhere!
CAIE A,0
HRLI A,(ASCPTR) ;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: A/ JFN
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
ETYPE < [OK]%_>
RET
;GNFIL
; GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
; CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).
;
; RETURNS: +1 NO MORE FILES
; +2 A/ NEXT JFN AND FLAGS FORM GNJFN
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
JRST RJERR ;7 reset error return first, to prevent looping
;7 CALL JERR
GNFIL3: MOVE A,@INIFH1
TXNN A,77B5 ;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).
GNJFN ;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
ADJSP P,-1
RET
;7 sticky filename defaulting
;7 initialize routine
SFDINI::SAVEAC <Q1> ;7 AOBJN pointer is put in Q1
MOVE Q1,[-4,,SFDFIL+.GJDEV] ;7 setup empty per-filespec block
CALL SFDIN1 ;7
MOVE Q1,[-4,,SFDCMD+.GJDEV] ;7 setup empty per-command block
CALL SFDIN1 ;7
MOVX A,GJ%SHT!GJ%OFG ;7 set up initial default string
HRROI B,[ASCIZ/FOO.NIL/] ;7
CALL GTJFS ;7
ERROR ;7
MOVE B,A ;7
CALL SFDSAV ;7
CALL SFDCON ;7 compensate for GTJFN bug
CALL SFDFTO ;7 make the per-command block have it too
CALLRET RJFN ;7 release the dummy JFN
;7 setup block pointers and allocate space to point to
;7
;7 ACCEPTS: Q1/ AOBJN pointer to block area
SFDIN1: MOVX A,EXTSIZ ;7 allocate maximum filespec field length
MOVEI B,XDICT ;7 from permanent storage pool
CALL GETMEM ;7
ERROR <String space exhausted> ;7
HRLI B,(ASCPTR) ;7 setup string pointer to point to the space
MOVEM B,(Q1) ;7
AOBJN Q1,SFDIN1 ;7 loop
RET ;7
;7 save a new set of defaults
;7 never sets wildcard defaults, not sure this is right but stops some screws
;7
;7 ACCEPTS: B/ JFN and flags
SFDSAV: MOVE A,SFDFIL+.GJDEV ;7 store device default
MOVX C,FLD(.JSAOF,JS%DEV) ;7
TXNN B,GJ%DEV ;7 except when wildcard
JFNS ;7
MOVE A,SFDFIL+.GJDIR ;7 likewise for directory
MOVX C,FLD(.JSAOF,JS%DIR) ;7
TXNN B,GJ%DIR ;7
JFNS ;7
MOVE A,SFDFIL+.GJNAM ;7 and name
MOVX C,FLD(.JSAOF,JS%NAM) ;7
TXNN B,GJ%NAM ;7
JFNS ;7
MOVE A,SFDFIL+.GJEXT ;7 and extension
MOVX C,FLD(.JSAOF,JS%TYP) ;7
TXNN B,GJ%EXT ;7
JFNS ;7
RET ;7
;7 set device and directory defaults to be connected directory
SFDCON::GJINF ;7 get connected directory number
MOVE A,CSBUFP ;7 point to string space
DIRST ;7 get str:<dir>
ERJMP CJERRE ;7
MOVE A,SFDFIL+.GJDEV ;7 copy device field to device default
MOVE B,CSBUFP ;7
MOVX C,EXTSIZ ;7
MOVX D,":" ;7
SOUT ;7
SETZ D, ;7 terminate with null
DPB D,A ;7
IBP B ;7 skip over left angle bracket
MOVE A,SFDFIL+.GJDIR ;7 likewise for directory field
MOVX C,FILWDS ;7
MOVX D,76 ;7 until the right angle bracket
SOUT ;7
SETZ D, ;7
DPB D,A ;7
RET ;7
;7 copy defaults from SFDFIL to SFDCMD
SFDFTO: MOVE A,[-4,,.GJDEV] ;7 AOBJN pointer
SFDFT1: MOVE B,SFDFIL(A) ;7 get "from" pointer
MOVE C,SFDCMD(A) ;7 get "to" pointer
SFDFT2: ILDB D,B ;7 copy characters from "from" string to "to"
IDPB D,C ;7 string
JUMPN D,SFDFT2 ;7 loop until all hit a null
AOBJN A,SFDFT1 ;7 loop until all strings are copied
RET ;7
;7 copy defaults from SFDCMD to SFDFIL
SFDCTO: MOVE A,[-4,,.GJDEV] ;7 just like above but direction is reversed
SFDCT1: MOVE B,SFDCMD(A) ;7
MOVE C,SFDFIL(A) ;7
SFDCT2: ILDB D,B ;7
IDPB D,C ;7
JUMPN D,SFDCT2 ;7
AOBJN A,SFDCT1 ;7
RET ;7
;THIS ROUTINE OBTAINS CONNECTED STRUCTURE.
;
; RETURNS: A/ POINTER TO CONNECTED STRUCTURE STRING
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.
;
; RETURNS: A/ DEVICE DESIGNATOR
; B/ CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS
; THEREOF:
; B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB
; B6: ON IF ASSIGNED
; BOTH B5 & B6 ON IF ASSIGNED TO SELF
; C/ JOB # ASSIGNED TO IF B6 OF B ON
;RETURN HERE TO TRY AGAIN AFTER TYPING " ? " AFTER ERROR.
DEVN:: DEVX <Device name>
CMERRX
MOVE A,B
DVCHR ;GET CHARACTERISTICS WORD
HLRE C,C
RET
;ROUTINE TO GET DIRECTORY INFORMATION
;
; ACCEPTS: 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::SETZ B, ;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
MOVX A,EXTSIZ ;ALLOCATE BLOCK FOR PASSWORD
CALL GETBUF
HRLI A,(ASCPTR) ;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!)
SETZ C, ;STOP COPYING ON NULL CHARACTER
SOUT ;COPY THE PASSWORD
MOVE A,DNOO ;GET DIRECTORY NUMBER
MOVE B,DRADR ;GET ADDRESS OF BLOCK
MOVX 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)
GTDIR ;GET ALL THE INFO INTO THAT BLOCK
ERJMP R ;IF FAILED, RETURN NO-SKIP
MOVX C,GTDLN ;7 no comment?
MOVEM C,.CDLEN(B) ;7
MOVE C,SAVPP ;7
MOVEM C,.CDPSW(B) ;7
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)
; ALLOCATES AND INITIALIZES ALL THE SUBBLOCKS THAT GTDIR NEEDS (USER GROUPS,
; ACCOUNT, SUBDIRECTORY USER GROUPS ALLOWED)
;
; ACCEPTS: A/ ADDRESS OF BLOCK
DIRINI::STKVAR <BFA>
MOVEM A,BFA
SETZM (A)
HRL B,A
HRRI B,1(A)
BLT B,GTDLN-1(A)
MOVX 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
MOVX B,UGBUFL ;LENGTH OF BUFFER
MOVEM B,(A)
MOVX A,DGBUFL ;ALLOCATE DIRECTORY GROUP BUFFER IN SAME WAY
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDDGP(B)
MOVX B,DGBUFL
MOVEM B,(A)
MOVX A,SGBUFL ;GET BLOCK FOR ALLOWABLE USER GROUPS
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDCUG(B) ;STORE ADDRESS OF BLOCK FOR USER GROUPS
MOVX B,SGBUFL
MOVEM B,(A) ;SET FIRST WORD OF SUBBLOCK TO COUNT
MOVX A,EXTSIZ ;GET ROOM FOR ACCOUNT STRING
CALL GETBUF
MOVE B,BFA
HRLI A,(ASCPTR) ;MAKE REAL BYTE POINTER TO ACCOUNT
MOVEM A,.CDDAC(B) ;STORE POINTER TO ACCOUNT BLOCK
SETZM (A) ;INITIALIZE ACCOUNT BUFFER
MOVX A,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM A,.CDLEN(B) ;IN FIRST WORD OF BUFFER
RET
;ROUTINE TO RELEASE FREE SPACE TAKEN UP BY A DIRECTORY BLOCK. THE ITEMS
; RELEASED ARE:
; 1) PASSWORD
; 2) USER GROUPS
; 3) DIRECTORY GROUPS
; 4) SUBDIRECTORY ALLOWABLE USER GROUPS
; 5) DEFAULT ACCOUNT STRING FOR LOGIN
;
; ACCEPTS: A/ ADDRESS OF DIRECTORY BLOCK
; RETURNS: +1 SUCESS
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
MOVX A,EXTSIZ ;SIZE OF PASSWORD BLOCK
CAILE Q2,.CDPSW ;PASSWORD POINTER GIVEN?
SKIPN B,.CDPSW(Q1) ;MAYBE, IS THERE ONE THERE?
ABSKP ;NO
CALL RETBUF ;YES, RELEASE SPACE USED BY PASSWORD
MOVX A,UGBUFL ;SIZE OF USER GROUP BLOCK
CAILE Q2,.CDUGP ;USER GROUP POINTER THERE?
SKIPN B,.CDUGP(Q1) ;YES, IS IT VALID?
ABSKP ;NO
CALL RETBUF ;YES, RELEASE GROUPS STORAGE
MOVX A,DGBUFL ;LENGTH OF DIRECTORY GROUP BUFFER
CAILE Q2,.CDDGP ;RELEASE DIRECTORY GROUP BLOCK
SKIPN B,.CDDGP(Q1)
ABSKP
CALL RETBUF
MOVX A,SGBUFL ;SIZE OF SUBDIRECTORY USER GROUP BUFFER
CAILE Q2,.CDCUG ;DO SUBDIRECTORY USER GROUPS
SKIPN B,.CDCUG(Q1)
ABSKP
CALL RETBUF
MOVX A,EXTSIZ ;PREPARE TO RELEASE ACCOUNT STRING STORAGE
CAILE Q2,.CDDAC ;ACCOUNT POINTER?
SKIPN B,.CDDAC(Q1)
ABSKP
CALL RETBUF ;REMOVE ACCOUNT STRING STORAGE
RET
;DIRNAM
; INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION. USED IN CONNECT,
; AND ^EPRINT COMMANDS.
;
; ACCEPTS: Z/ FLAGS
; F1: OFF FOR DEFAULTING
; ON SOME ENTRIES THESE CAN ALSO BE SET:
; F4: DEFAULT TO CONNECTED DIRECTORY NOT LOGGED-IN
; F5: ON TO ALLOW WILDCARDING
; F6: SAYS NOT TO RETURN IF AMBIGUOUS
; RETURNS: +1 FAILED
; +2 A,C/ RCUSR OR RCUSR DATA
; B/ POINTER TO NAME STRING
; PRESERVES: Q1 (FOR DIRECTORY)
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
HRROI A,USRDEF ;GET ROOM FOR STRING
MOVEM A,CMDEF ;REMEMBER POINTER TO DEFAULT STRING
SETO A, ;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
NOP
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
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>> ;7 make it global
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
SETO A, ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVX C,.JIDNO ;FIRST ASSUME DEFAULT TO CONNECTED DIRECTORY
TLNN Z,F4 ;DEFAULT TO LOGGED-IN?
MOVX 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
NOP
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: A/ DIR NUMBER
; B/ STRING POINTER TO WILDCARD STRING
; 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
STPUS1: ILDB A,STPSTP ;GET NEXT CHAR OF STRING
CAIE A,"*" ;IS IT A WILDCARD?
CAIN A,"%" ;...
JRST STPUS2 ;YES, GO TRY TO STEP THIS STRING
JUMPN A,STPUS1 ;NO, KEEP LOOKING
RET ;NONE FOUND, THEN DO NOT DO THE JSYS
STPUS2: 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 - DOES GTFDB AND SOME OTHER THINGS
; SUBROUTINE TO DO GTFDB JSYS AND SKIP UNLESS AN INSTRUCTION TRAP WITH "LIST
; ACCESS NOT ALLOWED" ERROR OCCURED.
;
; 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. CALL WITH TWO POINTERS FOR THE HELP TEXT FOR THIS FIELD, AND THE
; 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.
;
; ACCEPTS: A/ POINTER TO HELP TEXT FOR FIELD
; B/ POINTER FOR HELP TEXT FOR NEXT FIELD
; RETURNS: A/ VALUE
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 /] ;7 better format
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>
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
CALLRET NUMREP ;IT DID, SO DON'T INPUT MORE
COLONX <":" to enter range, or "," for another number, or next field of command>
ABSKP ;NO COLON TYPED
JRST OCTL4 ;COLON TYPED, GO GET END OF RANGE
COMMAX <"," to enter 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 enter 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 WITH NO LEADING ZEROES OR SPACES.
;
; ACCEPTS: B/ NUMBER
TOCT:: PUSH P,A
PUSH P,C
MOVE A,COJFN ;DESTINATION
MOVX C,NO%MAG!FLD(10,NO%RDX) ;"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::SETZ D, ;GET ITEM 0 FROM DWNTIM TABLE
GTB .DWNTI
JUMPE A,R ;DO NOTHING IF NOT SET
CAMN A,[-1] ;IS SYSTEM SHUTDOWN
JRST [ETYPE < System is shutdown>
JRST DWNTY2] ;YES, SAY SO
MOVE D,A ;7 save A in D
GTAD ;7 get our current TAD
MOVE B,D ;7 make a copy in B
SUB B,A ;7 get difference
CAMLE B,[6,,0] ;7 more than 6 days away?
RET ;7 don't say anything
MOVE B,D ;7 restore downtime to B
ETYPE < System shutdown scheduled for > ;7 don't use %W
MOVE A,COJFN ;7 use different format
MOVX C,OT%DAY ;7
ODTIM ;7
DWNTY2: MOVEI D,1 ;GET ITEM 1
GTB .DWNTI
JUMPE A,DWNTY1 ;JUMP IF UPTIME NOT SET
ETYPE <%_ Reload scheduled for > ;7 different format again
MOVE B,A ;7
MOVE A,COJFN ;7
ODTIM ;7
DWNTY1: ETYPE<%_>
RET
;ROUTINE THAT TAKES SIXBIT AND RETURNS A POINTER TO AN ASCIZ STRING
;
; ACCEPTS: A/ SIXBIT
; RETURNS: A/ POINTER TO ASCIZ STRING
GETASC::STKVAR <REMSIX,ASCPR>
MOVEM A,REMSIX ;REMEMBER THE SIXBIT
MOVX A,2 ;NEED TWO WORDS FOR ASCII
CALL GETBUF
HRLI A,(ASCPTR) ;MAKE BYTE POINTER TO ASCII
MOVEM A,ASCPR ;REMEMBER POINTER TO ASCII
HRRI B,REMSIX
HRLI B,(POINT 6) ;GET SIXBIT POINTER
SETZ D, ;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
TXNE B,77B5 ;DONE SIX CHARACTERS?
JRST ASC1 ;NO, MIGHT BE MORE
ASC2: SETZ C, ;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
;
; RETURNS: A/ SIXBIT
GETSXB::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 ASCIZ STRING
;
; ACCEPTS: A/ POINTER TO ASCII STRING
; RETURNS: +1 ILLEGAL SIXBIT CHARACTER ENCOUNTERED, OR STRING MORE
; THAN SIX CHARACTERS
; A/ SIXBIT UPTO LAST GOOD CHARACTER
; +2 A/ SIXBIT
GETSIX::STKVAR <ASPTR,SIXPTR>
CALL FIXPT ;FIX POINTER
MOVEM A,ASPTR ;REMEMBER ASCII POINTER
MOVE A,[POINT 6,A] ;POINTER TO SIXBIT RESULT
MOVEM A,SIXPTR
SETZ A, ;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,"a" ;CHANGE LOWERCASE LETTERS TO UPPERCASE
CAILE C,"z"
ABSKP ;NOT LOWERCASE
TRZ C,40 ;LOWERCASE, CHANGE IT
SUBI C,40 ;CHANGE TO SIXBIT
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,(ASCPTR) ;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. COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END.
;
; RETURNS: A/ POINTER TO BUFFERED STRING
BUFFF:: PUSH P,B
PUSH P,C
PUSH P,D
HRROI A,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.
; THE STRING ALWAYS BEGINS ON A WORD BOUNDARY. (SOME CALLERS ASSUME SO!)
; XBUFFS USES PERMANENT STORAGE, BUFFS USES TEMPORARY STORAGE
;
; ACCEPTS: A/ POINTER TO STRING
; RETURNS: A/ POINTER TO BUFFERED STRING
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 TAKES A STRING POINTER AND IT COPIES THE STRING TO FREE SPACE
;
; ACCEPTS: A/ STRING POINTER
; B/ FREE POOL HEADER ADDRESS
; RETURNS: +1 NO ROOM FOR STRING
; +2 A/ POINTER TO BUFFERED STRING
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,(ASCPTR) ;MAKE BYTE POINTER TO SPACE OBTAINED
MOVEM B,NEWPTR ;REMEMBER NEW POINTER
MOVE A,B
MOVE B,RPTR ;GET POINTER TO STRING
SETZ C, ;STORE NULL AT END OF STRING
SOUT ;COPY THE STRING
MOVE A,NEWPTR ;GET ADDRESS WHERE STRING GOT PUT
RETSKP ;SUCCESFUL RETURN
;ROUTINE TO GET MEMORY BLOCK.
;
; ACCEPTS: A/ NUMBER OF WORDS DESIRED
; RETURNS: +1 A/ ADDRESS OF BLOCK
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
;
; ACCEPTS: A/ CONTAINS NUMBER OF WORDS WANTED
; B/ FREE SPACE HEADER ADDRESS
; RETURNS: +1 NO ROOM
; A/ NUMBER OF WORDS OBTAINED
; B/ CONTAINS ADDRESS OF WORDS GOTTEN
; +2 SUCESSFUL
; A,B/ SAME AS RETURN +1
GETME0::SAVEAC <C,D> ;7 save ACs entry
GETMEM::STKVAR <<SAVSTF,2>,DADR>
MOVEM B,DADR ;REMEMBER HEADER ADDRESS
GETM2: MOVE C,B ;REMEMBER WHO POINTS TO CURRENT
HRRZ B,(C) ;B IS NOW CURRENT BLOCK
JUMPE B,R ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ D,(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 CTRL/C INTERRUPTS
HRL B,(B) ;GET LINK OF CURRENT BLOCK
HLRM B,(C) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZ B,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 CTRL/C INTERRUPTS BACK ON
RETSKP ;SUCCESS, SKIP RETURN
;STREM ROUTINE TAKES POINTER TO STRING, AND "REMOVES" THE STRING FROM THE
; STRING STORAGE SPACE. THE SPACE WHERE THE STRING WAS IS RETURNED TO FREE
; SPACE
;
; ACCEPTS: A/ POINTER TO STRING
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
;
; ACCEPTS: 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
;
; ACCEPTS: A/ CONTAINS SIZE OF BLOCK TO RETURN
; B/ CONTAINS ADDRESS OF BLOCK BEING RETURNED
; C/ FREE SPACE HEADER ADDRESS
RETMEM::HRRZ D,(C) ;GET PREV'S LINK
CAIE D,0 ;IF CURRENT IS 0 OR
CAIL D,(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 CTRL/C INTERRUPTS
HRRM D,(B) ;FORWARD PTR OF RETURNED BLOCK
HRRM B,(C) ;FORWARD PTR OF PREV BLOCK
HRLM A,(B) ;STORE SIZE OF THIS BLOCK
ADD A,B ;ADD ADDR+SIZE
CAIE A,(D) ;ARE WE RIGHT UP AGAINST NEXT BLOCK?
JRST RETM5 ;NO, CANT COMBINE
HRRZ A,(D) ;GET NEXT GUYS FORWARD LINK
HRRM A,(B) ;MAKE IT OURS. IE POINT PAST HIM
HLRZ A,(B) ;GET OUR SIZE
HLRZ D,(D) ;GET HIS SIZE
ADD A,D ;GET OUR NEW COMBINED SIZE
HRLM A,(B) ;STORE INTO RETURNED BLOCK
HRRZ D,(B) ;GET LINK OF CURRENT BLOCK
RETM5: HLRZ A,(C) ;GET PREV BLOCKS SIZE
ADDI A,(C) ;ADD HIS ADDRESS AND SIZE
CAIE A,(B) ;DOES HE BUTT RIGHT UP AGAINST US?
CALLRE PION ;NO, RETURN WITH NO COMBINATION
HRRM D,(C) ;MAKE PREV POINT TO OUR NEXT
HLRZ A,(C) ;GET HIS SIZE
HLRZ B,(B) ;AND OUR SIZE
ADD A,B ;COMBINE THE SIZES
HRLM A,(C) ;STORE COMBINED SIZE
CALLRE PION ;RETURN
;ROUTINE TO INITIALIZE FREE SPACE STORAGE. DONE BEFORE EACH COMMAND IS
; EXECUTED.
FREINI::SETZM DICT ;INITIALIZE FREE SPACE SYSTEM
MOVX 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
MOVX A,STRSIZ ;ALLOCATE SOME SPACE FOR STRINGS
CALL GETBUF
HRLI A,(ASCPTR) ;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
SETO A, ;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
MOVX 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
SETZ B, ;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
ADDI B,1 ;LEAVE ROOM FOR NULL
IDIVI B,5 ;GET NUMBER OF WORDS
CAIE C,0 ;EXTRA CHARACTERS?
ADDI B,1 ;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: +1 UNSUCESSFUL
; +2 A/ POINTER TO NONDE NAME STRING
GETNOD::MOVX A,.NDGLN ;SAY WE WANT HOST'S NODE NAME
MOVEI B,CSBUFP ;USE POINTER TO STRING SPACE TO WRITE THE NAME
MOVE C,CSBUFP ;REMEMER 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)
SETZ C, ;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
MOVX 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,[POINTR B,<TT%ECO!TT%ECM>]
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
;7 UTTYMD
;7 sets TTY modes of current fork
UTTYMD::PUSH P,A ;SAVE REG
SKIPLE A,FORK ;USER CURRENT FORK
CALL FTTYMD ;IF VALID
POP P,A ;RESTORE REG
RET ;RETURN
;7 FTTYMD
;7 sets TTY modes of specified fork
;7
;7 ACCEPTS: A/ fork handle
FTTYMD::ATSAVE
SKIPN Q1,SLFTAB(A) ;SET UP MODE BLOCK PNTR
RET
MOVE B,Q1 ;7 save a copy
MOVEI Q1,.FKPTM(Q1) ;ADDRS OF FORK'S MODE BLOCK
SKIPN (Q1) ;7 do nothing if block is 0
RET ;7
TXNN B,FK%PRI ;7 primary input redirected?
JRST LTTYM1 ;7 no, reset modes
TXNE B,FK%BKG ;7 background fork?
TDZA B,B ;7 yes, zero TIW
MOVE B,TTWPTI(Q1) ;7 no reset process TIW
STIW ;7
JRST LTTYM1 ;7
;LTTYMD - LOAD TELETYPE MODES
; SEE EXECDE FOR STRUCTURE OF BLOCK
;
; ACCEPTS: Q1/ POINTER TO 11-WORD BLOCK OF VALUES TO PUT INTO EFFECT
LTTYMD::SKIPN (Q1) ;DO NOTHING IF BLOCK IS 0 DUE TO A BUG OR
RET ;A STRANGE INTERRUPT-RESTART SEQUENCE
ATSAVE
LTTYM1: MOVX A,.CTTRM ;7 add local label
MOVE B,TTWMOD(Q1) ;FILE MODE WORD
TXZ B,TT%OSP ;ENSURE NO OUTPUT SUPPRESS
SFMOD
VTS,< MOVE B,TTDMOD(Q1) ;7 do likewise for VTS mode word
STMOD ;7
ERNOP ;7
> ;7
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
MOVX A,.CTTRM ;NOW RESTORE THE MASK
MOVX B,.MOSBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY1 ;ERROR MEANS WRONG MONITOR
MOVX B,.MOSFW ;NOW FOR THE FIELD WIDTH
MOVE C,TTWFWT(Q1)
MTOPR
MOVX A,.CTTRM
NOTTY1: MOVE B,TTWCOC(Q1) ;2 CCOC WORDS
MOVE C,TTWCOC+1(Q1)
SFCOC
MOVX 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!
MOVX 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
;7 RFTYMD
;7 reads fork TTY modes
;7
;7 ACCEPTS: A/ fork handle
RFTYMD::ATSAVE ;7 save ACs
SKIPN Q1,SLFTAB(A) ;SET UP MODE BLOCK PNTR
RET
MOVE B,Q1 ;7 save a copy
MOVEI Q1,.FKPTM(Q1) ;MODES FOR FORK
TXNE B,FK%BKG ;7 background fork?
JRST RTTYM1 ;7 yes, go on
RTIW ;7 no, read and store TIW
MOVEM B,TTWPTI(Q1) ;7
JRST RTTYM1 ;7
;RTTYMD STORE CURRENT TTY MODE, TAB STOPS, CCOC INTO 6-WORD BLOCK
;
; ACCEPTS: Q1/ POINTER TO STORAGE BLOCK
RTTYMD::ATSAVE
RTTYM1: MOVX A,.CTTRM ;7 add local label
RFMOD
MOVEM B,TTWMOD(Q1)
VTS,< RTMOD ;7 do likewise with VTS mode word
ERSKP ;7
MOVEM B,TTDMOD(Q1) ;7
> ;7
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
MOVX A,4 ;PUT LENGTH INTO BLOCK
MOVEM A,TTWMSK(Q1)
MOVX A,.CTTRM ;NOW SAVE THE MASK
MOVX B,.MORBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY2 ;ERROR MEANS WRONG MONITOR
MOVX B,.MORFW ;NOW FOR THE FIELD WIDTH
MTOPR
MOVEM C,TTWFWT(Q1)
MOVX B,.MOSFW
SETZ C, ;TURN OFF FIELD WIDTH
MTOPR
NOTTY2: MOVX A,.CTTRM
RFCOC
MOVEM B,TTWCOC(Q1)
MOVEM C,TTWCOC+1(Q1)
MOVX A,.FHJOB
RTIW
MOVEM B,TTWJTI(Q1)
SETO A, ;SAY THIS JOB
MOVE B,[-2,,C] ;SAY 2 WORDS INTO C AND D
MOVX 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 IS
RET ; 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
DELETE,<
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,(ASCPTR)
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
> ;end DELETE
;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,[POINT 9,WAA,35] ;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: 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
SKIPGE FORK ;IS THERE A CURRENT FORK?
ERROR <No program> ;NO.
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
TXO 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
TXO 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 MAPPFF ;CAN'T MAP-- RETURN +1
MOVEM A,NPAGE ;SAY ITS MAPPED
CAMN A,[-1]
JRST MPPF8
RPACS ;GET ACCESS/EXISTENCE OF MAPPED PAGE
ERJMP [SETZ B, ;SECTION CONTAINING PAGE DOESN'T EXIST
JRST MPPF8] ;JUST SAY PAGE CAN'T BE USED
CAIN B,0 ;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.
NOP ;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
MPPF8: POP P,A ;RH A TRANSPARENT
POP P,C
RETSKP ;RETURN +2 SUCCESS FROM MAPPF
MAPPFF: POP P,A ;RESTORE ALL
POP P,C ;. . .
RET ;AND RETURN +1 FROM MAPPF
;LOAD SINGLE WORD FROM FORK
;
; ACCEPTS: A/ ADDRESS
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 INTO FORK
;
; ACCEPTS: A/ ADDRESS
; B/ WORD TO STORE
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
ABSKP
ERROR <Can't write into page>
ANDI A,777
POP P,B ;GET BACK VALUE TO STORE
MOVEM B,PAGEN(A)
RETSKP
;%GTB
; UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
; TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
; FOR USE IN OTHER JSYS CALLS INSIDE LOOP.
;
; ACCEPTS: D/ RH: TABLE INDEX
; Q1/ TABLE NUMBER
; RETURNS: A/ DATA WORD
%GTB:: HRL A,D
HRR A,40
GETAB
CALL JERR
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:
STAT,< AOS STBUF> ;THIS INDEX FOR ^T
STKVAR <CIJFN0,COJFN0,SAV40>
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
MOVX 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 ;715 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) ;KNOWN TO US?
JRST USEPS0 ;NO - NO NAME THEN
MOVE B,.FKPTM+TTWPNM(B) ;GET NAME FROM TABLE
ETYPE < %2'>
USEPS0: PRINT " " ;7 a little cleaner
;7 TYPE < > ;SEPARATE NAME AND STATUS
CALL FSTAT ;PRINT STATUS & PC OF INFERIOR (HANDLE IN A)
PRINT " " ;FSTAT IS IN EXECIN.MAC
USEPS2: SETO A, ;GET LOAD AVERAGES FOR CURRENT JOB
CALL GLOADS ;GET LOAD AVERAGES
ETYPE < Used %V in %C, Load %2Q>
MIC,< CALL GETPAG ;MIC EXISTS?
JRST USEOU1 ;NO
TYPE < (DO in progress)>
>
USEOU1: ETYPE <%_>
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 [CAIN B,0 ;PCL YES, IS THE COMMAND NAME GONE?
HRROI B,[ASCIZ/Stored/] ;PCL YES, USE GENERIC NAME
JRST .+1] ;PCL
ETYPE < %2M command >
JRST USEPS2 ;JOIN COMMON CODE
CERR:: CMERRX ;CATCH-ALL COMMAND ERROR
;ROUTINE TO HANDLE CMERRX MACRO CALL.
CMERR$: STKVAR <MP,SEP2,ATMP,SAVBLK>
MOVX 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,[ASCPTR 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
MOVX B,.CHLFD ;USE LINEFEED TO PREVENT COMND FROM GOING INTO
; I/O WAIT
IDPB B,A ;PUT LINEFEED IN BUFFER
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,[ASCPTR 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
SETZ C, ;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
SCREWU::HRRZ Q1,(P) ;PC (GET HERE WITH PUSHJ)
SUBI Q1,1
ERROR <Internal error at %5P>
;ERROR RETURN FROM A JSYS
; 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.
;
; ACCEPTS: A/ SYSTEM ERROR NUMBER
RJERR: PUSH P,A ;7 restore regular error return first
MOVEI A,RERET ;7
MOVEM A,CERET ;7
POP P,A ;7
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
MOVX 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
; DEBRK 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, 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.
;
; ACCEPTS: ILIDSP/ SPECIAL ROUTINE ADDRESS OR 0
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
MOVX A,.FHSLF
GETER ;GET ERROR CODE
HRRZM B,ERCOD ;ERROR CODE, FOR SPECIAL ROUTINE
RET ;DISPATCH TO SPECIAL ROUTINE
;END-OF-FILE INTERRUPT
; DEBRK TO SPECIAL ROUTINE, OR TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS. THE
; LATTER IS NORMALLY TRUE EXCEPT FOR FILE-COPYING COMMANDS.
;
; ACCEPTS: EOFDSP/ SPECIAL ROUTINE ADDRESS OR 0
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?
CAIN A,COMNX9 ;7 or EOF in COMND?
ABSKP ;7 yes
CALL CJERRE ;NO, TREAT AS UNEXPECTED ERROR
SKIPN PCCURC ;715 unless in a PCL
CALL CMDINI ;RE-INIT COMND, TO PROTECT OURSELF
POP P,(P) ;THROW AWAY THE CALL TO THIS ROUTINE
JRST EOFCHK
;ROUTINE TO HANDLE END OF FILE CONDITION.
EOFCHK: MOVX A,.PRIIN ;7 check for EOF on primary input
GTSTS ;7
TXNE B,GS%EOF ;7 EOF bit set?
JRST CCHEOP ;7 yes, EOF on primary input
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 ONSPECIAL ROUTINE POINTER IF NON-ZERO, ELSE TREAT LIKE OTHER
; "PSEUDO-INTERRUPTS". SPECIAL ROUTINE IS USUALLY PROVIDED DURING ROUTINES
; WHICH WOULD CREATE PAGES AND WISH TO HELP THE USER.
;
; ACCEPTS: QTADSP/ SPECIAL ROUTINE ADDRESS OR 0
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
MOVE A,COJFN
RFMOD ;GET PRESENT TTY MODES
TXCE 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::MOVX A,.FHSLF ;OURSELF
RWM ;SEE WHICH LEVELS ARE IN PROGRESS
TSO B,B ;756 SPR #:20-15465 prevent loop on ^C of ^T
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
MOVX 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
SKIPLE A,EFORK ;EPHERMERAL?
FFORK ;YES - FREEZE IT
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 [ETYPE < %% Process disappeared%_>
RET]
MOVX Q1,FK%INT ;MARK INTERRUPTED
SKIPE SLFTAB(A)
IORM Q1,SLFTAB(A)
TMNN FK%INV,SLFTAB(A) ;715 If not controlled by PCL
;715 SKIPN PCPRGR ;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) ;715 If not controlled by PCL
;715 SKIPN PCPRGR ;PCL IF NOT CONTROLLED BY PCL
CALL LTTYMD ;SET UP OUR MODES, PROGRAM MAY HAVE CAUSED
; STRANGE STATE.
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
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 ;715 do we seem initialized?
SETOM CINITF ;715 yes, allow for ^C in PRESERVE 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) ;715 if not controlled by PCL
;715 SKIPN PCPRGR ;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) ;715 if not controlled by PCL
;715 SKIPN PCPRGR ;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
NOP
HALTF ;MINI-EXEC WILL CATCH US?
JRST .-1 ;7 don't continue
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
SKIPGE FORK ;7 running anything?
SKIPL EFORK ;7 ephemeral?
JRST ALOP0A ;7 don't do anything this pass
MOVE C,TTYACF ;GET # CHARS TYPED SO FAR
CAMN C,PTTYAC ;SAME AS LAST PASS?
JRST ALOPS1 ;YES, CLOBBER JOB, IT IS INACTIVE
ALOP0A: ;7 add local label
MOVEM C,PTTYAC ;NO, SAVE CURRENT AS PREVIOUS
MOVE A,[.FHSLF,,.TIMEL] ;SET NEXT TIME TO CHECK
MOVX B,AUTOL3*^D1000
MOVX 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
ETYPE <%_ Autologout%_>
MOVE A,COJFN
DOBE ;MAKE SURE IT ALL TYPES (NEEDED?)
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 ;715 save an AC to play with
MOVE A,TAKLEN ;715 get I/O stack pointer
HLRZ A,TAKJFN-1(A) ;715 get input designator (don't just look at
;715 CIJFN because we didn't call FIXIO yet)
CAIN A,.NULIO ;715 from PCL?
JRST ERRPCL ;715 yes, return to EXEC top level
POP P,A ;715 restore work AC
CALL ERRX ;PRINT ERROR MESSAGE
SETZM ERRMF ;CLEAR FLAG TO SAY ERROR IS OVER
RET ;RETURN
%ERR::
%$ERR:: TLZ Z,F1
ABSKP
%.$ERR:: TLO Z,F1 ;SAY DON'T CLEAR INBUF (ERFRS1)
PUSH P,A ;715 save an AC to play with
MOVE A,TAKLEN ;715 get I/O stack pointer
HLRZ A,TAKJFN-1(A) ;715 get input designator (don't just look at
;715 CIJFN because we didn't call FIXIO yet)
CAIE A,.NULIO ;715 from PCL?
JRST NOPCL ;715 no, do normal stuff
ERRPCL: MOVEI A,RERET ;715 get standard error return
MOVEM A,CERET ;715 say return to EXEC top-level after error
;715 is processed
NOPCL: POP P,A ;715 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)
CAIN A,(U$ERR)
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
MOVX A,.FHSLF ;GET ERROR # FROM SYSTEM NOW FOR
GETER ; LATER USE IN MSG
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
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
ETYPE < Not logged off%_> ;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED
; OFF" MESSAGE
;ERROR UUOS AND SYSTEM...
;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
SKIPLE A,EFORK ;SPECIAL FORK?
KFORK ;YES - KILL IT
SETOM EFORK ;NO MORE
;7 BuTCHER doesn't do anthing!
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 .P ;DON'T RESET P IF NEVER SAVED!
MOVE P,.P ;RESTORE P TO AS IT WAS BEFORE COMMAND
MOVE 15,.AC15 ;756 SPR #:20-17409 restore TRVAR pointer
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
MOVX A,CZ%NIF!FLD(.FHSLF,CZ%PRH) ;7 SPR #:20-19067
;7 MOVX A,CZ%NIF!CZ%NCL!FLD(.FHSLF,CZ%PRH)
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
NOP ;UNMAP SHOULD NEVER FAIL
SETO A,
MOVE B,[.FHSLF,,1+FREEPN] ;CLEAR PAGES FREE+1 - BUFL WHICH INCLUDES
MOVX C,PM%CNT!FLD(<BUFLPN-FREEPN>,PM%RPT) ;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
;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
ERFRS1: SAVEAC <A,B,C,D> ;AC'S MAY HAVE DATA FOR MESSAGE PRINTOUT
CALL %GETER ;GET ERROR CODE IN CASE "%?"
CALL CSAVE ;716 save the failed command
CALL FIXIO ;MAKE SURE ERROR SEEN IN "REAL" OUTPUT STREAM
CALL SETT20 ;SAY TOPS20 LEVEL NOW
SKIPN CINITF ;IS EXEX INITIALIZED?
JRST [MOVX A,.PRIOU ;NO, ASSUME COJFN, ETC. NOT SET UP
HRLOI B,.FHSLF
SETZ C,
ERSTR ;BUT TRY TO GET OUT ERROR MSG
NOP
NOP
HRROI A,[ASCIZ/
?TOPS-20 command processor not properly initialized.
/]
PSOUT
HALTF
JRST .-1] ;7 don't continue
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
TXZE 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
ETYPE <%_ ?Error within an error%_> ;YES, GIVE UP
JRST REENTE] ;7 try something more drastic
;7 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 ER2]
CALL UNTAKE ;UNWIND IF ERRORS NOT ALLOWED AT THIS LEVEL
ER2: TLNN Z,F1 ;DON'T CLEAR INBUF FOR ^U
SKIPN CIDLYF ;7 SPR #:20-17975 do late-clear-typeahead
;7 SKIPE CIDLYF ;REQUESTING DELAYED CFIBF?
RET ;YES, DON'T DO IT NOW
MOVE A,CIJFN
CFIBF
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?
ABSKP
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
SKIPE LGOCMD ;7 from LOGOUT.CMD?
RET
JRST LOGOU2 ;7 yes, then logout
;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.
/]
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
SETZ C, ;NO SPECIAL FLAGS
JFNS ;GET FILENAME
ERNOP ;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: MOVEI A,[TXTPTR <command procedure>] ;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::MOVX 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
MOVX A,.FHSLF
GETER
HRRZM B,ERCOD
POP P,C
POP P,B
POP P,A
RET
;DOGET DOES THE GET JSYS.
; 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.
;
; ACCEPTS: AC'S/ GET JSYS ARGUMENTS
; RETURNS: AC'S/ WHATEVER GET RETURNS
; +1 ERROR
; +2 SUCCESS, FAME AND FORTUNE
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
;715 CMU note: *** I haven't the foggiest idea why this change is here, but it
;715 has been since time immemoriable - PA0B, 21-Nov-82 ***
MOVE A,B ;715
ADJSP A,1 ;715 see where it came from
CAMN A,JBUFP ;715 was it the top of the stack?
MOVEM B,JBUFP ;715 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
ABSKP
RLJFNS:: ;7 make it global
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
MOVX 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 ;715 When all entries have been scanned, see if
;715 JFN in use by PCL
;715 SOJL B,RSKP ;LEAVE LOOP WHEN ALL ENTRIES HAVE BEEN SCANNED
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: SUCESS, -1: FAILURE
RJFNER: STKVAR <AERRF>
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...>
MOVX B,^D20 ;# OF HALF SECONDS
RJFNR1: MOVX A,^D500 ;MS TO SLEEP
DISMS ;ZZZZZ
HRRZ A,(C) ;GET JFN BACK
HLL A,D ;BITS TO SET
CLOSF ;TRY AGAIN
JRST RJFNR2 ;MORE PROCESSING TO COME
ETYPE < [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
;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?
ABSKP ;NO
MOVE A,B ;RETURN JFN OR FORK IN A
RET
;PCL ROUTINE TO UNSTACK THE TOP JFN IN THE JFN STACK.
;
; RETURNS: A/ JFN
; CLOBBERS: NOTHING
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: 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
SETO A, ;-1 FOR SELF
GACCT ;GET IT
LDB A,[POINT 3,B,2] ;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. SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.
EBLN==50 ;BUFFER SIZE FOR CHARACTERS DURING ETYPE
%ETYPE::TRVAR <<ETBFR,EBLN>,<RACS,5>,ETPTR,SRCPTR,ETYPF,EDAT>
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) ;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,(ASCPTR) ;FORM BYTE PTR FROM EFF ADDR
MOVEM A,SRCPTR ;REMEMBER SOURCE POINTER
MOVEI A,ETBFR ;CREATE POINTER TO BUFFER FOR CHARACTERS
HRLI A,(ASCPTR)
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
SETZB C,D ;C: IF NO NUMBER, USE 0 IN PLACE OF AC CONTENTS
; D: INIT NUMBER TO 0.
ETYP4: ILDB B,SRCPTR ;CHARACTER AFTER %
CAIG B,"9"
CAIGE B,"0"
JRST ETYP5
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
JRST ETYP4 ;GO CHECK FOR ADDITIONAL DIGIT(S)
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: SETZ A, ;GUARANTEE NULL
IDPB A,ETPTR
MOVE A,COJFN ;OUTPUT TO REAL JFN
HRROI B,ETBFR ;FROM OUR BUFFER
SETZ C, ;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,(ASCPTR)
MOVEM A,ETPTR
RET
ETYP5: CAIL B,"a"
CAILE B,"z"
ABSKP
TRZ B,40 ;MAKE THE CHARACTER UPPER CASE
MOVX A,LETLEN ;INDEX INTO TABLE OF CODES
MOVEM C,EDAT ;DON'T CLOBBER DATA
ETYP7: SOJL A,LETNF ;COULDN'T FIND CHARACTER IN TABLE IF THIS JUMPS
HLRZ C,%LETS(A) ;GET NAME OF ELEMENT FROM TABLE
CAIL C,"a"
CAILE C,"b"
ABSKP
TRZ C,40 ;MAKE THE CHARACTER UPPER CASE
CAME B,C ;IS THIS THE CORRECT ENTRY?
JRST ETYP7 ;NOT YET...
MOVE C,EDAT ;RESTORE DATA
HRRZ A,%LETS(A) ;GET ADDRESS OF ROUTINE
CALL (A) ;DO THE WORK
;DONE INTERPRETING A % CODE.
MOVE C,SRCPTR ;SAVE COPY
ILDB B,C ;NEXT CHARACTER
CAIN B,"%" ;PASS FOLLOWING %
MOVEM C,SRCPTR
JRST ETYP2 ;CONTINUE TYPING
;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER
; KEEP THIS TABLE IN ASCII ASCENDING ORDER SO IT REMAINS EASY TO SEE IF A
; CHARACTER IS IMPLEMENTED OR NOT
; (NOTE THAT EXEC DOESN'T ASSUME TABLE IS ORDERED THOUGH)
%LETS: "_",,%EOL ;7 TYPE A CRLF, out of order for speed
"#",,%NUMS ;OCTAL NUMBER AS N OR N,,N AS APPROPRIATE
"$",,%VSTR ;7 verbatim string
"%",,%PER ;%% JUST PRINTS A PERCENT
"'",,%SIX ;PRINT CONTENTS OF AC IN SIXBIT
"/",,%EXPR ;EXPRESSION IN AC
"=",,%FLT ;SIX-COLUMN FLOATING POINT NUMBER, NN.MM
"?",,%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
"[",,%GTHST ;7 host name (or number if unknown)
"\",,%STRNG ;TYPE STRING OR CHAR IN AC
"]",,%CHANM ;7 CHAOSnet host name (or number if unknown)
LETLEN==.-%LETS
;UNRECOGNIZED %-CODE
LETNF: TYPE <%> ;DIGIT, IF ANY, IS LOST.
JRST ETYP2A ;CONTINUE TYPING, STARTING WITH CHAR AFTER %.
;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;
; ACCEPTS: C/ CONTENTS OF SPECIFIED AC, OR 0 IF NONE
; CLOBBER: A,B,C,D ONLY
;%% JUST PRINTS A %
%PER: PRINT "%"
RET
;CURRENT TIME
%A: GTAD ;GET CURRENT DATE & TIME
A1: MOVX C,OT%NDA!OT%NSC ;7 add NSC bit
;7 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: MOVX 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 A,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,[RET] ;NEITHER EXISTS, ITS ONLY ONE, PRINT NOTHING.
%F1:
;7 TYPE <Fork >
SKIPG B,C ;USE GIVEN HANDLE IF AC W >0 CONTENTS GIVEN
MOVE B,RUNFK ;7 running not current?
;7 MOVE B,FORK ;ELSE HANDLE OF LAST RUN FORK
TXZ B,(1B0) ;PRINT ## NOT 4000##.
SKIPE A,FRKTAB(B) ;7 check if fork has name
TLNN A,(FK%NAM) ;7
JRST %F2 ;7 no name just print number
HRROI A,.FKNAM(A) ;7 has name type name and number
ETYPE <%1\ (%2O) > ;7
RET ;7
%F2: TYPE <Fork > ;7
CALL TOCT ;OCTAL OUTPUT FROM B
PRINT " "
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
MOVX C,FLD(^D10,NO%RDX)
NOUT ;PRINT NUMBER
CALL JERRC ;GENERAL JSYS ERROR ROUTINE FOR ERR COD IN C
MOVX 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::MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,[ASCIZ/OPERATOR/]
RCUSR ;GET DIRNUM OF OPERATOR
TXNE A,RC%NOM!RC%AMB ;COULDN'T?
SETO C, ;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,(P) ;LOGGED IN AS 'OPERATOR'?
AOJA C,%I3 ;YES, COUNT OPERATOR JOBS
ADDI B,1 ;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 ...
;"TTY N" OR "DETACHED"
%L: GJINF
JUMPL D,[TYPE <Detached>
RET]
TYPE <TTY>
MOVE A,COJFN
MOVE B,D
JRST TOCT ;TYPE OCTAL FROM B
;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
TXZ B,7B2
MOVX C,FLD(^D10,NO%RDX)
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
JRST DIRSTB ;7 DIRST is a +1/+2 return JSYS
;7 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
;7 same as %STRNG except use UTYPE (instead of UETYPE) to make sure % doesn't
;7 get interpreted
%VSTR: HLRZ A,C ;7 just like below
JUMPE A,%CHAR ;7
CAIE A,-1 ;7
CAIN A,(ASCPTR) ;7
ABSKP ;7
RET ;7
HRLI C,(UTYPE) ;7 use UTYPE not UETYPE
JRST %STR0 ;7 join main code
%STRNG: HLRZ A,C ;GET PNTR LHS
JUMPE A,%CHAR ;IF NO POINTER THEN CHARACTER RJ
CAIE A,-1 ;CHECK FOR -1,,
CAIN A,(ASCPTR) ; OR 440700
ABSKP
RET ;RETURN IF CRAP
HRLI C,(UETYPE) ;FORM LUUO
%STR0: PUSH P,C ;SAVE IT
MOVE Z,RACS ;RESTORE ACS
DMOVE A,1+RACS
DMOVE C,3+RACS
XCT (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,[POINT 6,C] ;POINTER TO SIXBIT DATA
SETZ D, ;NULL TO CLEAR CHARACTERS AS WE PRINT THEM
SIX1: TXNN A,77B5 ;HAVE WE DONE ALL SIX CHARACTERS YET?
RET ;YES
ILDB B,A ;NO, GET ONE
DPB D,A ;CLEAR OUT CHARACTER WE JUST READ
CAIN B,0 ;IF CHARACTER IS NON-0, ALWAYS PRINT IT
JUMPE C,R ;IF CHARACTER IS 0, PRINT IT UNLESS IT'S A
; TRAILING SPACE
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
TXNE C,7B2 ;EXPONENT .GE. 100?
TXNN C,1B9 ;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.
MOVX 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: MOVX C,FLD(^D10,NO%RDX) ;RADIX TO USE
MOVE A,COJFN
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;FLOAT AN INTEGER
;
; ACEEPTS: A/ INTEGER
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
;
; ACCEPTS: D/ JOB NUMBER
; RETURNS: A/ USER NUMBER OR 0 FOR 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 #
MOVX 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...
SETZ A, ;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 [CALL JFNSIL ;SPR 14203 ANALYZE ERROR
JRST JERR ;STRANGE ERROR
JRST %S1] ;"GOOD" ERROR
MOVEM A,COJFN ;UPDATE IN CASE BYTE POINTER
%S1: RET
;JFNSIL ANALYZES JFNS ERROR.
;
; RETURNS: +1 DOESN'T RECOGNIZE ERROR
; +2 RECOGNISED ERROR AND PRINTED OUT EXPLANANTION
JFNSIL::CALL %GETER
HRRZ A,B
GTSTS
MOVE A,ERCOD
TXNN B,GS%NAM ;DOES JFN HAVE NAME?
RET ;NO, JUST RETURN ERROR CODE
CAIN A,DESX3 ;UNASSIGNED JFN ERROR?
JRST [TYPE < Restricted JFN>
RETSKP]
CAIN A,GJFX24 ;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,[TYPE <None>
RET]
SETZ D, ;BIT NUMBER
;FIND FIRST SET BIT
TXNE C,1B0
JRST %U2
LSH C,1
ADDI D,1
JRST .-4
;LOOP FOR SUCCESSIVE BITS
%U1: TXNN 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: ADDI D,1
LSH C,1
JUMPN C,%U1
RET
;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB.
%V: CAIE D,0 ;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
%W: MOVE A,COJFN
MOVE B,C ;ARG SUPPLIED IN C
SETZ C, ;USE STANDARD BRIEF FORMAT
ODTIM
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>
HLRZ A,A ;GET OPCODE TO SEE IF IT'S A JSYS
CAIN A,(JSYS)
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 <%_?%2?>
SETO A,
CALL MAPPF ;UNMAP PAGE
NOP ;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
;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
MOVX C,FLD(10,NO%RDX) ;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
;%? 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
SETZ C, ;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...
;7 %[ type host name or octal number if unknown number
%GTHST: MOVX A,.GTHNS ;7 output host primary name
MOVE B,COJFN ;7
GTHST% ;7 host number in C already
ERJMP GTHST1 ;7 if not on ARPA
CAIN A,.GTHNS ;7 check to see if we have error code?
RET ;7 none
HRRZ C,C ;7 isolate host number
GTHST1: MOVE A,COJFN ;7 error, probably unknown number
MOVE B,C ;7 output number
MOVX C,NO%MAG!FLD(10,NO%RDX) ;7 octal, to correspond to DEC TCP std
NOUT ;7
ERNOP ;7 ignore error
RET ;7
;7 %] type CHAOSnet host name using CHANM or octal number if unknown number
%CHANM: TRVAR <<CHSTNM,EXTSIZ>> ;7 buffer for host name
MOVX A,.CHNNS ;7 CHAOSnet host primary name to buffer
HRROI B,CHSTNM ;7
CHANM% ;7 host number in C already
ERJMP GTHST1 ;7 error, print number instead
MOVE A,COJFN ;7 print it
HRROI B,CHSTNM ;7
SETZ C, ;7
SOUT ;7
ERNOP ;7 ignore error
RET ;7
;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.
;
; ACCEPTS: A/ JFN
SNDEOL::PUSH P,B
HRROI B,[BYTE(7).CHCRT,.CHLFD]
SETZ C, ;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
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,COJFN
TOUT1: IDIVI B,^D3600
PUSH P,C
MOVX C,FLD(^D10,NO%RDX)
NOUT ;HOURS
CALL JERRC
MOVX B,":"
BOUT
POP P,B
IDIVI B,^D60
PUSH P,C
MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D10,NO%RDX) ;2 COLS, LEADING
; 0'S.
NOUT ;MINUTES
CALL JERRC
MOVX B,":"
BOUT
POP P,B
NOUT ;SECONDS
CALL JERRC
POP P,C
POP P,B
POP P,A
RET
NONEWF,<
;SUBROUTINE CALLED AT RETURN TO COMMAND LOOP, TO DO MAIL WATCH.
; CALLED IFF MWATCF (MAIL WATCH FLAG) IS NON-ZERO. "CALL CHKPTY" REMOVED FROM
; THIS ROUTINE BECAUSE 1) IT WAS CAUSING TWO EXTRA JSYS'S TO BE EXECUTED PER
; EXEC COMMAND AND 2) USER RUNNING UNDER NEWRUN OR PTYCON MAY VERY WELL HAVE
; MAIL BE WATCHED.
MWATCH::SKIPE CUSRNO ;MUST BE LOGGED IN
SKIPN MAILF ;TIME TO CHECK?
RET ;NO
CALL MINT0 ;ENABLE FOR ANOTHER MAIL INTERRUPT
MOVE B,CUSRNO ;GET LOGGED-IN USER NUMBER
CALL MALCHK ;CHECK MY MAIL BOX
RET ;NO NEW MAIL
ETYPE <[You have new mail]%_>
RET ;RETURN TO COMMAND LOOP
;ROUTINE TO ENABLE FOR A TIMER INTERRUPT AT SOME ELAPSED TIME FROM NOW. WHEN
; THE INTERRUPT OCCURS, IT MEANS THAT MAIL SHOULD BE CHECKED.
MINT0:: SETZM MAILF ;SAY NO INTERRUPT YET
GTAD ;GET CURRENT TIME AND DATE
MOVX B,MWATCI ;GET INCREMENT
ADD B,A ;CALCULATE WHEN TO INTERRUPT
MOVEM B,MALWEN ;REMEMBER WHEN
MOVE A,[.FHSLF,,.TIMDT] ;SAY TO INTERRUPT AT EXACT TIME
MOVX C,MALCHN ;USE MAIL CHANNEL
TIMER ;ENABLE FOR INTERRUPT
ETYPE <
%%Unexpected MAIL-WATCH failure, mail no longer being watched - %?%%_>
RET
> ;END NONEWF
;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 Z,(P) ;SAVE AC Z, GET RETURN ADDRESS
ADJSP P,17 ;ALLOCATE ROOM FOR THE REST OF THE AC'S
MOVEM Z,(P) ;STORE RETURN ADDRESS "AFTER" AC BLOCK
HRRI Z,-16(P) ;PLACE ON STACK TO STORE AC'S
HRLI Z,A ;STARTING FROM AC A
BLT Z,-1(P) ;SAVE REST OF AC'S
RET ;RETURN TO CALLER
;ROUTINE TO RESTORE AC'S
RESACS::HRLI Z,-16(P) ;GET ADDRESS OF STORED AC'S
HRRI Z,A ;RESTORE AC'S INTO AC A ONWARD
BLT Z,16 ;RESTORE 1 THROUGH 16
MOVE Z,(P) ;GET RETURN ADDRESS
EXCH Z,-17(P) ;STORE RETURN ADDRESS, GET ORIGINAL AC Z
ADJSP P,-17 ;FREE UP SPACE USED BY RETURN ADDRESS AND 1
; THRNOUGH 16
RET ;RETURN TO CALLER (PHYEW!)
NONEWF,<
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;
; ACCEPTS: B/ USER NUMBER
; RETURNS: +1 A/ 0: NO NEW MAIL, -1: CANNOT TELL
; +2 NEW MAIL IN USER'S MAIL.TXT
MALCHK::STKVAR <MALUSR,<MALBFR,FILWDS>>
MOVEM B,MALUSR ;SAVE USER NUMBER
HRROI A,MALBFR ;SPACE TO CREATE FILENAME
HRROI B,[ASCIZ/PS:</] ;MUST BE ON PS:
SETZ C,
SOUT
MOVE B,MALUSR ;RESTORE USER NUMBER
DIRST ;ADD USER NAME
CALL JERR ;NO SUCH DIRECORY. SHOULDN'T HAPPEN
HRROI B,[ASCIZ/>MAIL.TXT.1/]
SETZ C,
SETO Q1, ;NO JFN YET
SOUT ;FINISH FILE NAME
MOVX A,GJ%OLD!GJ%DEL!GJ%SHT ;OLD,DELETED AND SHORT FORM
HRROI B,MALBFR ;POINT TO FILE NAME
CALL GTJFS ;GET AND STACK JFN
JRST MALCH2 ;FAILED
HRRZ Q1,A ;SAVE THE JFN IN MORE PERMANENT AC
MOVE B,[1,,.FBCTL] ;ANALYZE THE FILE
MOVEI C,C
CALL $GTFDB ;SEE IF IT IS DELETED
JRST MALCHP ;PROTECTED
TXNE C,FB%DEL ;DELETED?
JRST MALCHM ;YES. NO NEW MAIL
MOVE B,[1,,.FBSIZ] ;NOT DELETE. GET SIZE
MOVEI C,C
CALL $GTFDB ;GET SIZE
JRST MALCHP ;PROTECTED
JUMPLE C,MALCHM ;IF EMPTY. NO MAIL
MOVE B,[1,,.FBWRT] ;NOT EMPTY GET WRITE DATE
MOVEI C,D ;PUT WRITE DATE IN D
CALL $GTFDB
JRST MALCHP ;PROTECTED
MOVE B,[1,,.FBREF] ;GET LAST REFERENCE DATE
MOVEI C,C
CALL $GTFDB
JRST MALCHP ;PROTECTED
CAML C,D ;WRITTEN LATELY?
JRST MALCHM ;NO. NO MAIL
RETSKP
;... MALCHK CONTINUED
MALCH2: CAIN A,GJFX24 ;SPECIFIC FILE NOT FOUND
JRST MALCHM ;RIGHT. NO NEW MAIL
CAIL A,GJFX16 ;RANGE FOR NOT FOUND
CAILE A,GJFX20 ;..
JRST MALCHP ;SAY DON'T KNOW ABOUT MAIL
MALCHM: TDZA A,A ;MAIL REALLY NOT THERE
MALCHP: SETO A, ;CAN'T TELL IF MAIL IS THERE
RET
> ;END NONEWF
NEWF,<
;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,(D) ;TIME TO CHECK MAIL?
RET ;NOPE - RETURN
ADDI A,^D910 ;TRY AGAIN 5 MINS FROM NOW
MOVEM A,(D)
MOVX 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,CUSRNO ;IS IT ME?
JRST [ETYPE <[%5N has > ;NO - TELL ME WHO THEN
JRST .+2]
TYPE <[You have > ;IT'S MINE
TXNN B,77B17 ;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
;
; ACCEPTS: B/ USER NUMBER
; RETURNS: +1 NO MAIL OR SOME TYPE OF FAILURE
; +2 NEW MAIL
; A/ POINTER TO MESSAGE
; C/ AUX MESSAGE
; D/ WRITE DATE AND TIME
MALCHK::STKVAR <MALUSR,<MALFDB,16>>
SETO Q1, ;INIT FLAG
HRROI A,MALBUF ;POINT AT BUFFER
MOVEM B,MALUSR ;SAVE USER #
HRROI B,[ASCIZ/PS:</]
SETZ C,
SOUT ;COPY STRING
MOVE B,MALUSR ;RESTORE USER
DIRST ;NAME STRING TO BUFFER
CALL JERR
HRROI B,[ASCIZ/>MAIL.TXT.1/]
SOUT ;FINISH FILE SPEC
MOVX A,GJ%OLD!GJ%DEL!GJ%SHT
HRROI B,MALBUF
GTJFN ;GRASP AT FILE
JRST MALCH2 ;HANDLE ERROR
MOVEI Q1,(A) ;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
ERNOP
HRROI B,MALBUF ;ASSUME LOCAL MAIL (-1,,MALBUF)
SKIPA A,[ASCPTR 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,[ASCPTR MALBUF] ;RETURN 440700,,MALBUF
JRST MALCKL ;NO SPECIAL KEEP LOOKING
MALLCL: MOVEI A,(Q1) ;JFN TO RELEASE
RLJFN
CALL JERR ;BITCH ABOUT IT
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 %2$ at %3\%%4E%"] ;7 internet forwarding uses %
;7 HRROI A,[ASCIZ"from %2\ 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
CALL JERR ;BITCH IF LOSAGE
MOVE A,Q1 ;RESTORE VALUE
RET ; AND RETURN
; STILL IN NEWF
;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
MOVX P1,(A) ;SAVE REGS
HRRI P1,-6(P)
BLT P1,(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
MOVX B,^D60000 ;1MIN FROM NOW
MOVX C,IITCHN ;PSI CHL
TIMER ;ARM IT
SETZM IITSET ;CLEAR FLAG
MOVX 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
> ;END NEWF
;ROUTINE TO SUBTRACT TWO BYTE POINTERS
;
; ACCEPTS: A/ BYTE POINTER 1
; B/ BYTE POINTER 2
; RETURNS: +1 A/ 1-2
SUBBP:: TLC A,-1
TLCN A,-1
HRLI A,(ASCPTR) ;IF LEFT HALF -1, IT'S NOW 440700
TLC B,-1
TLCN B,-1
HRLI B,(ASCPTR) ;SAME FOR OTHER POINTER
MOVX 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
;ROUTINE TO DO GFRKS JSYS TO GET FORK HANDLES ON ALL PROCESSES UNDER THIS EXEC.
;
; RETURNS: +1 FAILURE
; +2 SUCESS
GFLEN==1000*<BUFLPN-BUF0PN+1> ;LENGTH OF BLOCK
DGFRKS::MOVX 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
;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.)
;
; 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
; THIS ROUTINE LEAVES THE TAPE OPEN OR NOT DEPENDING ON WHETHER JFN WAS OPEN
; TO START WITH
;
; ACCEPTS: A/ JFN
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]
MOVX 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 [MOVX 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
;BITS+N CONTAINS A WORD WITH A 1 IN BIT N
;713 change this local XX to ..POS
..POS==0
BITS:: REPEAT ^D36,<EXP 1B<..POS>
..POS=..POS+1>
XEND==:. ;MUST BE LAST LOCATION OF EXEC !!!!!
LITSSU: ;713 debugging aid: literals label
END