Trailing-Edge
-
PDP-10 Archives
-
BB-M781B-SM
-
exec/execsu.mac
There are 47 other files named execsu.mac in the archive. Click here to see a list.
; UPD ID= 59, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.10, 2-Jun-82 13:47:29 by KROSENBLUH
;Edit 737 - in ctrl/t, if program name = EXEC, try to get
;last-run program name
; UPD ID= 57, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.4, 1-Jun-82 14:01:48 by KROSENBLUH
;EDIT 736 - More of edit 735
; UPD ID= 51, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.3, 17-May-82 17:57:23 by KROSENBLUH
;Edit 735 - When ETYPE <%X> is called from "INFO PROG", don't print "?" in
;first column.
; UPD ID= 49, FARK:<5-WORKING-SOURCES.EXEC>EXECSU.MAC.3, 12-May-82 15:38:12 by KROSENBLUH
;Edit 734 - Use GETNM to get running fork's name, instead of table lookup
; UPD ID= 32, FARK:<4-1-WORKING-SOURCES.EXEC>EXECSU.MAC.4, 29-Apr-82 13:24:25 by KROSENBLUH
;REINSERT EDIT 589 [726]
; UPD ID= 25, FARK:<4-1-WORKING-SOURCES.EXEC>EXECSU.MAC.3, 8-Apr-82 11:48:39 by GROUT
;Edit 723 - Check correctly at GETLPC for waiting interrupt levels
; UPD ID= 22, FARK:<4-1-WORKING-SOURCES.EXEC>EXECSU.MAC.2, 6-Apr-82 16:45:50 by KROSENBLUH
;SAVE AC .FP DURING SUBCOMMAND PROCESSING FOR USE IN ERROR RECOVERY [722]
; 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
;INTERNS -- ROUTINES IN THIS ASSEMBLY
INTERN READY,READ1,READY2,REPARS ;PRINT ONE OR TWO READY CHARACTERS (@ OR !)
INTERN PRVCK ;ROUTINE FOR CHECKING PRIVILEGES
INTERN %KEYW ;SERVICE ROUTINE FOR KEYWORD LOOKUP UUO (KEYWD)
INTERN %NOI ;SERV ROUTINE FOR NOISE WORD UUO ("NOISE" MACRO)
INTERN %SBCOM ;UUO TO INPUT AND DISPATCH ON SUBCOMMANDS
INTERN CONF ;TERMINATE AND CONFIRM COMMAND
INTERN SPRTR ;ANALYZE SEPARATOR/TERMINATOR IN ARG LIST
DEFINE XX (FOO)
<
INTERN FOO'$
>
ULIST
INTERN COUTFN,CSAVFN,SPECFN,CPFN,CPFNA ;INPUT IN, OUT, SPECIAL, PROG FILE NAMES
INTERN .INFG,$INFGX,DIRARG ;INPUT FILE GROUP DESCRIPTORS
INTERN TYPIF,TYPOK,GNFIL ;ROUTINES FOR STEPPING THRU FILES IN GRP
INTERN DEVN ;COLLECT DEVICE NAME
INTERN TOCT,OCTCOM,TOUT,TOUTD ;NUMBER OUTPUT SUBRS
INTERN BUFFF ;BUFFER LAST FIELD SUITABLY FOR USE AS JSYS ARG
INTERN NOECHO,DOECHO,LTTYMD,RTTYMD ;TTY MODES ETC
INTERN %PRINT ;OUTPUT CHARACTER UUO
INTERN MAPPF ;MAP PAGE OF FORK SUBR
INTERN LOADF ;LOAD WORD FROM FORK SUBR
INTERN STOREF ;STORE WORD INTO FORK SUBR
INTERN %GTB ;CONVENIENT GETAB JSYS CALL UUO
INTERN USEPSI ;TERMINAL PSI TO PRINT RUNTIME (^T)
INTERN NIYE,NIM,SCREWUP,JERR,JERRC ;VARIOUS ERROR CONDITIONS
INTERN %TRAP ;CHANNEL 1 ERROR PSI MESSAGE UUO
INTERN ILIPSI ;ILLEGAL INSTRUCTION PSI
INTERN EOFPSI ;END-OF-FILE PSEUDO-INTERRUPT ON CHANNEL 1
INTERN DATPSI ;FILE DATA ERROR INTERRUPT
INTERN CCPSI ;^C PSI ON CHANNEL 1
INTERN TLMPSI ;TIME EXCEEDED ON CHANNEL 4
INTERN COBPSI ;^O PSI ON CHANNEL 5
INTERN ALOPSI ;PSI ON CHAN 1 FROM AUTOLOGOUT FORK
INTERN AUTOLO ;ROUTINE TO DO AUTOLOGOUT
INTERN %ERR,%$ERR,%.$ERR ;GENERAL ERROR UUOS (MACROS "ERROR" ETC)
INTERN RERET ;NORMAL AFTER-ERROR ROUTINE FOR CERET TO PT TO
INTERN RLJFNS ;CLOSE & RELEASE JFNS USED BY CURRENT COMMAND
INTERN %ETYPE ;TYPE MESSAGE, INTERPRETING %-CODES
INTERN CERR
INTERN FLOAT ;FLOAT INTEGER IN A
;SAVE TEMP AC'S - COMMONLY USED VIA ATSAVE MACRO
.SAVT:: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSHJ P,0(CX) ;CONTINUE ROUTINE
TRNA
AOS -4(P) ;PROPAGATE SKIP
POP P,D
POP P,C
POP P,B
POP P,A
RET
;TO DO TABLE LOOKUP OF NEXT FIELD OF COMMAND, DO:
;
; HELPX <THIS IS WHAT "?" TYPES OUT>
; KEYWD TABLE ;"TABLE" IS ADDRESS OF TABLE
; T FOO... ;APPROPRIATE "T" MACRO FORM OF DEFAULT VALUE
; ERROR RETURN
; SUCCESS RETURN ;P3 HAS VALUE FROM TABLE
; ;B HAS TABLE ENTRY ADDRESS
%KEYW: HLRO A,@(P) ;PICK UP POINTER TO DEFAULT FIELD VALUE
AOS (P) ;SKIP THE DEFAULT ON RETURN
TRNE A,-1 ;LEAVE DEFAULT POINTER AS IS IF NO FIELD SUPPLIED
MOVEM A,CMDEF ;SAVE DEFAULT STRING POINTER
HRRZ A,40 ;PICK UP ADDRESS OF KEYWORD TABLE
MOVEM A,CMDAT ;SAVE ADDRESS OF TABLE
MOVX A,CMKEY ;PREPARE TO PARSE KEYWORD
SKIPE CMDEF ;IS THERE A DEFAULT?
TXO A,CM%DPP ;YES, TELL COMND TO READ IT
SKIPE CMHLP ;USER HELP MESSAGE?
TXO A,CM%HPP ;YES, USE IT
SKIPE CMBRK ;SPECIAL BREAK MASK?
TXO A,CM%BRK ;USE IT
MOVEM A,CMFNP ;STORE FLAGS
MOVEI B,FBLOCK ;GET ADDRESS OF FUNCTION BLOCK
CALL 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 IN B AND RETURN TABLE DATA IN P3.
;THE ENTRY ADDRESS IN B IS PRESERVED.
GETKEY::HRRZ P3,(B) ;GET ADDRESS OF CONTROL DATA
MOVE P3,(P3) ;GET THE CONTROL DATA ITSELF
TXNE P3,ONEWRD ;CONFIRMATION NECESSARY NOW?
CALLRET CONF ;YES, DO IT AND RETURN
RET ;GIVE GOOD RETURN
;FIELD INPUT ROUTINE. CALL IT WITH ADDRESS OF FUNCTION DESCRIPTOR
;BLOCK IN AC "B". ROUTINE RETURNS WITH A, B, C, CONTAINING
;WHATEVER COMND PUT THERE.
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!CM%XIF ;WAKE ON EVERY FIELD SO ECHO CAN BE TURNED OFF IN TIME FOR LOGIN
SKIPN CUSRNO ;IS USER LOGGED IN?
IORM A,CMFLG ;NO, SO DON'T ALLOW "@" AND WAKE PER FIELD
MOVX A,CM%WKF
SKIPE CUSRNO ;LOGGED IN?
ANDCAM A,CMFLG ;YES, SO DON'T WAKE PER FIELD
AOS CLZFFF ;SAY CLZFF BETTER BE DONE IF ^C HERE.
MOVEI A,SBLOCK ;ADDRESS OF COMMAND STATE BLOCK
COMND ;DO THE COMND JSYS ITSELF (ONLY ONE IN EXEC! 6/16/77 EO)
ERCAL EOFJER ;FAILED, SAY WHY AND DIE
DMOVEM B,CMDDAT ;REMEMBER DATA
MOVEM C,CMDFDB
AOS TTYACF ;NOTE THAT SOME TTY ACTION OCCURED
SETZM CMDEF ;CLEAR DEFAULT STRING, SO ISN'T USED AGAIN INADVERTANTLY
SETZM CMHLP ;CLEAR HELP MESSAGE, SO IT ISN'T USED AGAIN
SETZM CMBRK ;CLEAR BREAK MASK SO IT ISN'T USED AGAIN
SETZM EOFDSP ;CLEAR EOF DISPATCH ADDRESS
;IF THIS IS A CONFIRMATION, ECHO THE COMMAND IF DESIRED.
TXNE A,CM%NOP ;SUCCESS?
JRST [ SOS CLZFFF ;NO, CLZFF NO LONGER NEEDED
JRST FIELD1] ;SKIP FUNCTION CODE ANALYSIS
LDB A,[POINTR((C),CM%FNC)] ;GET FUNCTION CODE
CAIE A,.CMIFI ;SOMETHING PARSED WHICH CREATED A JFN?
CAIN A,.CMOFI
JRST FIELDF ;YES, LEAVE CLZFFF ON TO FORCE CLZFF IF ^C.
CAIN A,.CMFIL
JRST FIELDF ; " "
SOS CLZFFF ;NOT FILESPEC FUNCTION, CLZFF NOT NEEDED
CAIE A,.CMCFM ;CONFIRMATION?
JRST FIELD1 ;NO, GO ON
SETZM CLF ;NOT AT COMMAND LEVEL IF JUST PARSED RETURN
SKIPE CIPF ;COMMAND ALREADY IN PROGRESS?
JRST FIELD1 ;YES
MOVE A,COMAND ;GET ADDRESS OF TABLE ENTRY
HLRZ A,(A) ;GET ADDRESS OF COMMAND NAME INFO
MOVSI B,774000 ;SEE IF THIS IS A FLAG WORD
TDNN B,(A) ;IS IT?
AOJ A, ;YES, SO COMMAND NAME STARTS IN NEXT WORD
FIELD2: HRLI A,440700 ;MAKE POINTER TO BEGINNING OF COMMAND NAME
MOVEM A,COMAND ;REMEMBER POINTER TO ASCII
CALL GETSIX ;GET SIXBIT NAME FOR COMMAND
JFCL ;TRUNCATE IF COMMAND TOO LONG
MOVEM A,COMSIX ;REMEMBER IT
SKIPN PCCURC ;PCL No change if within stored command
SETNM ;TELL SYSTEM, SO SYSTAT SHOWS IT
SETOM CIPF ;SAY COMMAND IN PROGRESS
CALL ECHCMD ;ECHO THE COMMAND IF NECESSARY
FIELD1: MOVX A,CM%XIF
ANDCAB A,CMFLG ;ALLOW "@" UNLESS CALLER SAYS DON'T, RETURN FLAGS IN A
DMOVE B,CMDDAT ;RETURN COMND DATA IN B
RET
FIELDF: MOVE A,B ;GET JFN
CALL JFNSTK ;STACK IT SO WE REMEMBER TO RELEASE IT LATER
SOS CLZFFF ;CLZFF NO LONGER NEEDED WHEN JFN IS STACKED
JRST FIELD1
;GET ONE CHARACTER FROM COMMAND STRING
CMDCHR::
CMDCH2: MOVEI B,SBLOCK
SKIPG .CMINC(B) ;SOMETHING THERE?
JRST CMDCH1 ;NO
ILDB A,.CMPTR(B) ;YES, GET IT
SOS .CMINC(B) ;UPDATE COUNT
CAIN A," " ;A SPACE?
JRST CMDCH2 ;PASS IT
RET
CMDCH1: HRROI A,[ASCIZ / /] ;PARSE A NULL STRING
CALL CHAR ;IN ORDER TO GET MORE INPUT
JRST CMDCH2
JRST CMDCH2 ;TRY AGAIN
;BACKUP MAIN PTR IN COMMAND STRING
CMDBAK: MOVEI B,SBLOCK
MOVNI A,1
ADJBP A,.CMPTR(B) ;DECREMENT BYTE PTR
MOVEM A,.CMPTR(B)
AOS .CMINC(B)
RET
;ROUTINE WHICH CALLS FIELD AND SKIPS IFF SUCCESSFUL PARSE
FLDSKP::CALL 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
CAIA ;FALL INTO COMMON CODE
SETALL::SETOM (A) ;SET ALL THE BITS IN THE FIRST WORD OF MASK
HRL A,A ;MAKE BLT POINTER
HRRZI B,BITMLN-1(A) ;GET LAST ADDRESS OF BIT MASK
AOJ A, ;MAKE POINTER TO SMEAR BITS
BLT A,(B) ;SET ALL BITS
RET
;SKPNAZ SKIPS IF NOT ALL ZERO (SOME BIT IS ON IN MASK)
;
;ACCEPTS: A/ ADDRESS OF MASK
;
;RETURNS+1: ALL ZERO
; +2: NOT ALL ZERO (SOME BIT IN BIT MASK IS ON)
SKPNAZ::MOVSI B,-BITMLN ;NUMBER OF WORDS TO CHECK
SKPN1: MOVE C,A ;GET BASE ADDRESS
ADDI C,(B) ;GET NEXT ADDRESS TO LOOK AT
SKIPE (C) ;IS THIS PART OF MASK ALL ZERO?
RETSKP ;NO, SO MASK IS NAZ
AOBJN B,SKPN1 ;YES, SO KEEP LOOKING
RET ;ALL ZERO SO DON'T SKIP
;SKPON SKIPS IF A BIT IS ON (SET) IN A MASK
;
;ACCEPTS: A/ BIT NUMBER
; B/ ADDRESS OF MASK
;
;RETURNS+1: BIT NOT ON
; +2: BIT ON
SKPON:: HRLI B,430100 ;GET POINTER TO FIRST (0TH) BIT
ADJBP A,B ;MAKE BYTE POINTER TO EXACT BIT
LDB C,A ;GET BIT VALUE
JUMPN C,RSKP ;SKIP RETURN IF 1
RET ;SINGLE RETURN IF 0
;COPBTS COPIES ONE BIT MASK TO ANOTHER
;
;ACCEPTS: A/ SOURCE ADDRESS
; B/ DESTINATION
COPBTS::MOVEI C,BITMLN-1(B) ;GET LARGEST DESTINATION ADDRESS
HRL B,A ;MAKE BLT POINTER
BLT B,(C) ;COPY THE MASK
RET
;SETBIT/CLRBIT SETS/CLEARS ONE BIT IN A MASK
;
;ACCEPTS: A/ BIT NUMBER TO SET (0 MEANS B0 OF FIRST WORD)
; B/ ADDRESS OF MASK
CLRBIT::TDZA C,C ;GET 0 TO STUFF INTO BIT
SETBIT::MOVEI C,1 ;GET 1 TO STUFF INTO BIT
HRLI B,430100 ;GET POINTER TO FIRST (0TH) BIT
ADJBP A,B ;MAKE BYTE POINTER TO EXACT BIT
DPB C,A ;SET OR CLEAR BIT
RET
;ROUTINES TO TELL MONITOR WE'RE AT TOPS20 LEVEL AND PROGRAM LEVEL.
;THE BATCH SYSTEM NEEDS THESE TO KNOW TO SEND ^C IF WE'RE AT PROGRAM
;LEVEL, AND NEXT LINE OF BATCH JOB INPUT IS SUPPOSED TO GO TO THE
;EXEC.
;
;NOTE: EXEC IS CAREFUL NOT TO CALL THESE ON EVERY COMMAND, IN ORDER
;TO MINIMIZE NUMBER OF JSYS'S DONE PER COMMAND.
SETMOD::MOVE C,A ;ARG IN C
JRST SETMD1
SETPRG::TDZA C,C ;SPECIFY PROGRAM LEVEL
SETT20::SETO C, ;SPECIFY TOPS20 LEVEL
SETMD1: SETO A, ;CURRENT JOB
MOVX B,.SJT20 ;SPECIFY TOPS20 FUNCTION
SETJB ;TELL MONITOR WHICH LEVEL
ERJMP .+1 ;FAILED, PROBABLY OLD MONITOR
RET
;ROUTINE TO GET TOPS20 MODE
;RETURNS RESULT IN A
GETMOD::SETO A, ;CURRENT JOB
HRROI B,A ;PUT RESULT IN A
MOVEI C,.JIT20 ;SPECIFY THIS FUNCTION
GETJI ;GET THE INFO FROM SYSTEM
ERJMP .+1 ;IGNORE ERROR, PROBABLY OLD MONITOR
RET
;GET CURRENT CLASS AND LOAD AVERAGES
;ACCEPTS: A/ JOB NUMBER OR -1 FOR CURRENT JOB
;RETURNS: +1
; A/ -1 FOR NO CLASS SCHEDULING, OR CLASS NUMBER
; B/ 1-MINUTE LOAD AVERAGE
; C/ 5-MINUTE LOAD AVERAGE
; D/ 15-MINUTE LOAD AVERAGE
GLBLN==10 ;ROOM TO GET LOAD AVERAGES
GLOADS::STKVAR <WJOBN,<GLBLK,GLBLN>>
MOVEM A,WJOBN ;REMEMBER WHICH JOB
CALL CLSON ;CLASS SCHEDULING ON?
JRST GLNO ;NO
MOVEI A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVE A,WJOBN ;GET JOB
MOVEM A,.SAJOB+GLBLK
MOVEI A,.SKRJP ;READ THIS JOB'S CLASS
MOVEI B,GLBLK
SKED% ;SEE WHAT CLASS WE'RE IN
MOVE A,.SAJCL+GLBLK
MOVEM A,.SACLS+GLBLK ;MOVE CLASS FOR ASKING FOR LOADS
MOVEI A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVEI A,.SKRCS ;NOW GET LOAD AVERAGES FOR THE CLASS
SKED%
GLN2: HRLI A,.SA1ML+GLBLK ;MOVE DATA STARTING WITH LOAD AVS
HRRI A,B ;MOVE INTO AC'S
BLT A,D ;GET CLASS, 1M LOAD, 5M LOAD, 15M LOAD
MOVE A,.SACLS+GLBLK ;RETURN CLASS IN A
RET
GLNO: MOVEI D,14 ;FIRST SYSTEM LOAD AVERAGE IS WORD 14
GTB .SYSTA
MOVEM A,.SA1ML+GLBLK ;STORE THE LOAD AVERAGES
MOVEI D,15
GTB .SYSTA
MOVEM A,.SA5ML+GLBLK
MOVEI D,16
GTB .SYSTA
MOVEM A,.SA15L+GLBLK
HRROI A,-1 ;-1 MEANS CLASS SCHEDULING IS OFF
MOVEM A,.SACLS+GLBLK
JRST GLN2 ;GO RETURN RESULTS
;SKIP IF CLASS SCHEDULER IS ON...
;A CONTAINS STATUS BITS OF SCHEDULER
CLSON:: MOVEI B,C ;ARG BLOCK IN C
MOVEI A,.SKRCV ;READ STATUS
MOVEI C,2 ;SPECIFY A 2-WORD BLOCK
SKED% ;GET THE INFO
MOVE A,D ;RETURN DATA IN A
TXNN A,SK%STP ;CLASS SCHEDULER ON?
RETSKP ;YES, SKIP
RET ;NO, DON'T.
;GET TERMINATOR OF LASS FIELD, RETURNED IN A. -1 IS RETURNED IF NO
;TERMINATOR HAS BEEN TYPED YET
GETTER::MOVE B,SBLOCK+.CMPTR ;GET POINTER TO REST OF LINE
SETO A, ;RETURN -1 IF NO TERMINATOR YET
SKIPLE SBLOCK+.CMINC ;MAKE SURE THERE ARE SOME UNPARSED CHARACTERS
ILDB A,B ;GET NEXT CHARACTER AFTER PARSED FIELD
RET
;NACL SKIPS IF NOT AT TOPS20 COMMAND LEVEL. THIS IS USEFUL IF SOME
;ASYNCHRONOUS CODE HAS SOMETHING TO SAY AND DOESN'T WANT INTERRUPT OTHER
;OUTPUT OR COMMAND INPUT
NACL:: SKIPN CLF ;AT COMMAND LEVEL?
RETSKP ;NO
MOVE A,CMRTY ;YES, SEE HOW MANY CHARACTERS IN PROMPT
CALL FIXPT
MOVEI C,0 ;C WILL ACCUMULATE COUNT
NACL1: ILDB B,A ;GET NEXT CHARACTER OF PROMPT STRING
CAIE B,0 ;DONE COUNTING WHEN NULL HIT
AOJA C,NACL1
MOVE A,CIJFN ;GET INPUT CHANNEL
RFPOS ;SEE IF USER HAS STARTED TYPING COMMAND YET
CAIL C,(B) ;HAS HE STARTED TYPING YET?
RET ;NO, SO DON'T SKIP. IT'S O.K. TO BLURT MESSAGE NOW
RETSKP ;HE STARTED TYPING, SO DON'T DISTURB HIM
;ROUTINE WHICH SKIPS IFF LAST FIELD WASN'T TERMINATED WITH ALTMODE.
;THIS ROUTINE ONLY NEEDS TO BE CALLED IN SITUATIONS WHERE IT'S AMBIGUOUS
;AS TO WHETHER USER SHOULD BE PROMPTED FOR NEXT FIELD, OR ALLOWED TO ENTER
;MORE FOR THIS FIELD. FOR INSTANCE, IN A "COPY" COMMAND, "COPY FOO$":
;SHOULD WE WAIT FOR MORE, DESPITE THE ALTMODE, IN CASE USER WANTS TO
;MAKE IT "COPY FOO,BAR (TO) ...", OR SHOULD WE ASSUME THAT THE ALTMODE
;MEANS DO "COPY FOO (TO)" ? THE CURRENT ANSWER IS THAT THE ALTMODE MEANS
;GO ON TO THE NEXT FIELD. OTHERWISE, USER WOULD NEVER SEE "(TO)" PRINTED
;OUT. ANOTHER EXAMPLE IS A COMMAND LIKE "SET PAGE-ACCESS 1:3$". ALTHOUGH
;THE USER COULD AT THIS POINT MAKE IT "...1:3,4...", WE ASSUME THAT
;THE ALTMODE MEANS GO ON TO NEXT FIELD, HENCE MAKING IT
;"SET PAGE-ACCESS 1:3 (TO)". THIS ROUTINE CLOBBERS NO AC'S.
NESC:: ATSAVE ;PRESERVE TEMPY'S
MOVE A,CMFLG ;GET FLAGS
TXNE A,CM%ESC ;LAST FIELD END WITH ALTMODE?
RET ;YES, NO SKIP
RETSKP ;NO, SO SKIP
;ROUTINE TO INITIALIZE COMMAND LINE JSYS AND PRINT PROMPT FOR NEW COMMAND.
READY: MOVEM A,CMDACS ;DON'T CLOBBER ANY AC'S
MOVEI A,2 ;PCL Assume enabled batch
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
MOVEI A,1 ;PCL Use a dollar sign
SKIPN PRVENF ;USE @ IF NOT ENABLED
SETZ A, ;PCL One prompt for regular command
JRST READY3 ;PCL JOIN COMMON CODE
READY2: MOVEM A,CMDACS ;DON'T CLOBBER AC1
MOVEI A,5 ;PCL Precede prompt with space if batch
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
MOVEI A,4 ;PCL Use a dollar sign
SKIPN PRVENF ;USE @ IF NOT ENABLED
MOVEI A,3 ;PCL One prompt for regular command
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
MOVE A,B ;PCL
MOVE B,CMDACS+1 ;PCL
;ENTER HERE FOR CUSTOM PROMPT CHARACTERS:
READ1: MOVEM A,CMRTY ;SET UP PROMPT BUFFER
MOVEM A,SVPRMT ; AND REMEMBER THE POINTER FOR "TAKE, ECHO"
POP P,REPARA ;REMEMBER WHERE TO REPRASE TO
MOVE A,CMDACS ;GET SAVED AC1 (SEE %$TYPE:)
MOVEM 17,CMDACS+17 ;SAVE AC17 AWAY
MOVEI 17,CMDACS ;MAKE BLT POINTER 0,,CMDACS
BLT 17,CMDACS+16 ;SAVE REST TO AC'S
MOVE 17,CMDACS+17 ;LEAVE AC17 INTACT
MOVE A,JBUFP ;GET CURRENT LOCATION ON JFN STACK
MOVEM A,.J ;REMEMBER WHERE WE ARE FOR REPARSE
HRR A,COJFN ;GET OUTPUT JFN
HRL A,CIJFN ;AND INPUT
MOVEM A,CMIOJ
READ2: HRROI A,[0] ;PCL GET NULL STRING
MOVE B,TAKCUR ;GET CURRENT SETTINGS
TXNN B,TKTERF ;SKIP IF INPUTTING FROM TERMINAL
MOVEM A,CMRTY ;NO PROMPT UNLESS INPUTTING FROM TERMINAL
MOVX A,CMINI ;DO INITIALIZATION, PRINT PROMPT
MOVEM A,CMFNP
MOVEI B,FBLOCK ;SPECIFY FUNCTION BLOCK ADDRESS
CALL 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
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
JRSTF @REPARA ;RETURN TO CALLER
;PCL Standard prompt strings
REDPMT::ASCIZ /@/ ;Disabled
ASCIZ /$/ ;Enabled
ASCIZ / $/ ;Enabled batch needs space because of operator
ASCIZ /@@/ ;Disabled subcommand
ASCIZ /$$/ ;Enabled subcommand
ASCIZ / $$/ ;Enabled batch subcommand
;GUIDE WORD HANDLER, INVOKED WITH "NOISE" MACRO
%NOI: ATSAVE ;DON'T CLOBBER AC'S
HRRO A,40 ;GET POINTER TO GUIDE STRING
MOVEM A,CMDAT ;SET UP GUIDE STRING
MOVX A,CMNOI ;SPECIFY NOISE FUNCTION
MOVEM A,CMFNP
MOVEI B,FBLOCK
CALL FLDSKP ;READ THE GUIDE WORDS
CMERRX
RET
;ROUTINES TO TURN IPCF INTERRUPTS ON AND OFF. INTS MUST BE TURNED OFF IN
;VARIOUS PLACES TO AVOID RECEIVING AN IPCF MESSAGE WITHOUT KNOWING ABOUT IT.
IPCON:: SOSLE IINTDF ;DECREMENT AMOUNT OF NESTING
RET ;SOMEONE ELSE STILL WANTS IPCOFF!
SETOM IPCALF ;ALLOW IPCF INTERRUPTS AGAIN
MOVEI A,.FHSLF ;TALK TO OURSELF
MOVX B,1B<IPCCHN> ;PREPARE TO SIMULATE IPCF INTERRUPT
SKIPE IPCWTF ;IS THERE A WAITING INTERRUPT?
IIC ;YES, FORCE AN INTERRUPT
RET
IPCOFF::AOS IINTDF ;NEST DEEPER INTO OFFNESS
SETZM IPCALF ;THIS FLAG 0 MEANS DON'T ALLOW IPCF INTERRUPT
RET
;PION/PIOFF CONTROL PRIORITY INTERRUPT, TURNING IT ON AND OFF.
;USE PIOFF TO PREVENT ^C, AND PION TO ALLOW IT AGAIN.
;THESE ROUTINES EXPLICITLY DO NOT CLOBBER THE TEMPORARY AC'S, SO THAT CALLERS
;CAN HAVE ^C TURNED OFF FOR AS LITTLE TIME AS POSSIBLE
PION:: SOSLE INTDF ;DECREMENT AMOUNT OF NESTING
RET ;SOMEONE ELSE STILL WANTS NO ^C, DO NOTHING MORE
SETOM ACTRCF ;ALLOW ^C
TLNE Z,CTLCF1 ;DID THE USER ALREADY TYPE ^C?
JRST .CTRLC ;YES
RET
PIOFF:: AOS INTDF ;INCREMENT AMOUNT OF NESTING
SETZM ACTRCF ;DISALLOW ^C
TLZ Z,CTLCF1!CTLCF2 ;FORGET ABOUT CONTROL-C'S ALREADY TYPED
RET
;PRVCK
;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE
; REQUIRED AS INDICATED BY BITS IN B, GENERALLY FROM
; A KEYWORD TABLE.
;SKIPS UNLESS SPEC CAP(S) ARE REQUIRED BUT USER HAS NONE OF THEM.
;USES: FORK COMMAND (XCMD1.MAC), %KEYWD (JUST ABOVE).
PRVCK: TXNN B,WHLU+OPRU+ERRU ;ANY PRIVILEGES WANTED?
RETSKP ;NO - RETURN SUCCESS
SKIPN CUSRNO ;MUST BE LOGGED IN TO HAVE PRIVILEGES
RET
ATSAVE
MOVE D,B
MOVEI A,.FHSLF
RPCAP ;READ CAPABILITIES ENABLED FOR THIS PROCESS
TXNN D,WHLU ;CHECKING FOR WHEEL?
JRST PRVCK1 ;NO - SKIP THIS
TXNE C,SC%WHL ;YES - HAS USER GOT WHEEL?
RETSKP ;YES - SUCCESS
PRVCK1: TXNN D,OPRU ;CHECKING FOR OPERATOR?
JRST PRVCK2 ;NO - SKIP THIS
TXNE C,SC%OPR ;YES - HAS USER GOT OPERATOR?
RETSKP ;YES - SUCCESS
PRVCK2: TXNE D,ERRU ;CHECKING FOR "CONFIDENTIAL INFORMATION"?
TXNN C,SC%CNF ;YES - HAS USER GOT IT?
RET ;WANTS AND DOESN'T HAVE - FAILURE
RETSKP ;WANTS AND HAS - SUCCESS
;USUBCO UUO, INVOKED BY SUBCOM MACRO
;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO
;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS
;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST
%SBCOM: STKVAR <OCERET,OJBUFP,KADDR,INITR>
MOVE A,CERET
MOVEM A,OCERET ;SAVE OLD LOCATION FOR ERROR DISPATCH
MOVE A,.JBUFP
MOVEM A,OJBUFP ;SAVE OLD JFN STACK POINTER BOUNDARY
HRRZ A,40 ;GET KEYWORD TABLE ADDRESS ADDRESS
MOVE B,(A) ;GET TABLE ADDRESS
MOVEM B,KADDR
MOVE B,1(A) ;GET INIT ROUTINE ADDRESS
MOVEM B,INITR
MOVEI A,[CALL FLJFNS ;ON ERROR, FLUSH JFN FOR ERRONEOUS SUBCOMMAND
JRST SBCOM1] ;THEN GO AND PROMPT FOR NEXT SUBCOMMAND
MOVEM A,CERET ;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE
;**; [722] Insert 1 line at %SBCOM: + 13 6-APR-82 KR
MOVEM .FP,.PP ;[722]SAVE INN CASE OF ERROR
MOVEM P,.P ;REMEMBER STACK POINTER IN CASE ERROR DURING SUBCOMMAND
SBCOM1: MOVE A,JBUFP
MOVEM A,.JBUFP ;PREVENT ERRONEOUS SUBCOMMANDS FROM CAUSING COMMAND JFNS TO BE FLUSHED
CALL READY2 ;TYPE 2 READY CHARACTERS: @@ OR !!
MOVEI B,[FLDDB. .CMCFM,,,,,FBLOCK]
MOVE C,KADDR ;GET ADDRESS OF KEYWORD TABLE
MOVEM C,CMDAT ;STORE ADDRESS OF KEYWORD TABLE
MOVX A,CMKEY ;SPECIFY KEYWORD FUNCTION, NO SPECIAL FLAGS
MOVEM A,CMFNP ;STORE FUNCTION
CALL FLDSKP ;READ TYPED IN FIELD
CMERRX <Carriage return or subcommand required>
CALL GETKEY ;GET KEYWORD INFO
TRNN P3,-1
JRST SBCOM9 ;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS
SKIPE INITR ;IS THERE AN INITIALIZATION ROUTINE?
CALL @INITR ;YES, EXECUTE IT
CALL (P3) ;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
;**;[726] Insert 1 line at SBCOM1:+17 KR 29-APR-82
CALL ECHCMD ;[726]NEED TO TURN ON ECHO FOR TAKE?
JRST SBCOM1 ;GO GET ANOTHER
SBCOM9: MOVE A,OJBUFP ;GET OLD JFN BOUNDARY
MOVEM A,.JBUFP ;RESTORE AS BEFORE SUBCOMMANDS
MOVE A,OCERET ;GET OLD ERROR DISPATCH ADDRESS
MOVEM A,CERET
RET
;CONF
;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE
;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS.
;IF TYPIST TYPES "?", IT TELLS HIM THAT IT'S WAITING FOR
;CONFIRMATION. IF HE STARTS WITH ! OR ; (RECOGNIZED COMMENT CHARACTERS
;DUE TO PHASE OF MOON AT TIME OF THIS DOCUMENTATION), IT ALLOWS
;A COMMENT TO PRECEDE THE CONFIRMATION. (CONFIRMATION ITSELF IS
;CARRIAGE RETURN, LINEFEED, CONTROL-L ETC.) IF A NON-COMMENT PRECEDES
;THE CONFIRMATION, AN ERROR MESSAGE RESULTS.
;FCONF PRINTS [CONFIRM] THEN FORCES FURTHER CONFIRMATION
FCONF:: PROMPT <[Confirm]>
FCONFA::
;CONF
CONF: ATSAVE ;SAVE TEMPORARIES
CRRX <Confirm with carriage return>
CMERRX ;BAD CONFIRMATION TYPED
RET ;GOOD CONFIRMATION, RETURN.
;SPRTR
;READS END OF LINE, DETECTING COMMA FOR SUBCOMMANDS. TAKES non-skip RETURN IF COMMA THEN
;CARRIAGE RETURN. TAKES SKIP IF JUST CARRIAGE RETURN.
SPRTR: ATSAVE ;DON'T CLOBBER AC'S
COMMAX <Confirm with carriage return or comma to enter subcommands>
JRST SPR1 ;NOT COMMA, MAYBE END OF INE
CRRX <Carriage return to enter subcommands>
ERROR <Carriage return required after comma to enter subcommands>
RET ;REGULAR SKIP IF COMMA SEEN
SPR1: CRRX ;NO COMMA, CHECK FOR END OF LINE
ERROR <Comma or carriage return required>
RETSKP ;TYPIST ENDED LINE WITH NO COMMA
;GET HERE FOR LINE REPARSE, WHICH HAPPENS WHEN PREVIOUSLY
;PARSED FIELDS ARE REQUIRED TO BE REPARSED.
REPARS: MOVE A,.J ;FIX JFN STACK
MOVEM A,.JBUFP ;RESTORE JFN STACK FRAME
CALL FLJFNS ;GET RID OF ANY JFN'S THAT WERE USED FOR COMMAND
CALL DOECHO ;ECHOING MAY HAVE BEEN TURNED OFF FOR PASSWORD
MOVSI 17,CMDACS ;MAKE BLT POINTER CMDACS,,0
BLT 17,17 ;RESTORE AC'S TO HOW THEY WERE WHEN THIS PART OF COMMAND STARTED
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
JFCL
ETYPE < End of %1S
>
CLOSF ;CLOSE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
JRST CMDIN4 ;GO BACK FOR NEXT COMMAND
;ROUTINE TO POP BACK TO LAST EXEC INPUT STREAM. RETURNS WITH JFN
;OF OLD INPUT IN AC1.
;IT SKIP RETURNS IFF THERE WAS NOTHING TO DELETE (I.E. ONLY ONE
;SET OF JFNS ON THE COMAND STREAM STACK)
;IT CLOSES THE OUTPUT SIDE, AND LEAVES RIJFN HOLDING THE INPUT
;SIDE BUT INPUT ISN'T CLOSED YET, SO THAT ERROR MESSAGES ETC. MAY
;DO JFNS ON INPUT JFN BEFORE CLOSING IT.
CIOREL::STKVAR <OLDJFS>
MOVE A,TAKLEN ;SEE HOW MANY ITEMS ARE ON STACK
MOVE B,TAKJFN-1(A) ;GET SET OF JFNS BEING POSSIBLY FLUSHED
MOVEM B,OLDJFS
SOJE A,RSKP ;SKIP RETURN IF ONLY ONE
MOVEM A,TAKLEN ;STORE REDUCED LENGTH
MOVE A,CIJFN ;SEE WHERE READING FROM
CAIN A,.NULIO ;PCL?
CALL PCMPOS ;NO, POP COMMAND PROCEDURE CONTEXT
CALL FIXIO
HRRZ A,OLDJFS
CAME A,COJFN ;DON'T CLOSE OUTPUT IF SAME!
CLOSF ;CLOSE OUTPUT BUT NOT INPUT YET
ERCAL JERR
HLRZ A,OLDJFS ;RETURN INPUT JFN IN A
RET
;ROUTINE TO GET RID OF ALL COMMAND JFNS. THIS HAPPENS, FOR INSTANCE,
;IF USER TYPES ^C DURING "TAKE" COMMAND PROCESSING
;SKIPS IFF THERE ARE NONE TO GET RID OF
CLRIO: CALL CIOREL ;CLOSE STREAM
CAIA ;THERE WAS AT LEAST ONE TO CLOSE
RETSKP ;NONE TO CLOSE, TAKE SKIP
PUSH P,A ;SAVE JFN IN CASE LAST ONE
CLR1: CALL CIOREL ;CLOSE NEXT ONE
JRST CLR2 ;NEXT ONE WASN'T LAST
POP P,A ;IT WAS THE LAST ONE, SO RETURN IT
RET
CLR2: EXCH A,(P) ;GET THE ONE THAT WASN'T LAST
CLOSF ;CLOSE THE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
JRST CLR1 ;LOOP BACK TO CLOSE THE REST
;UUO DISPATCH TABLE
CUUOT: EXP %ERR,%ETYPE,%KEYW
EXP %NOI,%$TYPE,%LERRO
EXP 0,%$ERR,%ETYPE,%GTB
EXP %PRINT,%TRAP,%.$ERR
EXP %SBCOM
%%U==.-CUUOT
DEFINE XX(UUL)
<
%%X==.
RELOC CUUOT+<U'UUL>_-^D23-20 ;;BITS 0-8 CAN'T BE 0
UUL'$
IFG .-CUUOT-%%U,<%%U==.-CUUOT>
RELOC %%X
>
ULIST
RELOC CUUOT+%%U ;LEAVE ROOM FOR ALL UUO ENTRIES
;UUO DISPATCHER
CUUO:: MOVEM A,CTUUO ;SAVE AC A
HLRZ A,40 ;GET THE OP-CODE
LSH A,-5
HRRZ A,CUUOT-20(A) ;GET THE DISPATCH ADDRESS FOR THIS OP-CODE
EXCH A,CTUUO ;SAVE IT AND RESTORE AC A
JRST @CTUUO ;DISPATCH TO UUO-HANDLING ROUTINE
;ROUTINE INVOKED BY "$TYPE <FOO>" MACRO. IT STARTS A NEW LINE
;PART OF THE COMMAND, WITH THE PROMPT BEING "FOO".
%$TYPE: MOVEM A,CMDACS ;WE DON'T WANT TO CLOBBER ANYTHING
MOVEI A,@40 ;GET ADDRESS OF PROMPT STRING
HRLI A,440700 ;MAKE BYTE POINTER
CALLRET READ1 ;TYPE PROMPT AND RETURN TO PROGRAM
;SEE ALSO "%ETYPE" IN S3.MAC
;ROUTINES FOR INPUTTING FIELDS OF COMMAND. INVOKED BY MACROS.
;THESE ROUTINES ARE NAMED $FOO AND %FOO. ROUTINE $FOO ASSUMES
;THE EFFECTIVE ADDRESS OF THE UUO CONTAINS THE HELP STRING FOR
;THE FIELD. %FOO ASSUMES THAT THE PREVIOUS HELP STRING IS TO
;BE USED.
;DECIMAL NUMBER...
DEC$: CALL GETHLP ;SET UP HELP MESSAGE
MOVEI A,5+5 ;RADIX
NUM13: MOVEM A,CMDAT
MOVX A,CMNUM
CALLRET $WORK ;INPUT THE NUMBER AND SKIP OR NORMAL RETURN
;OCTAL NUMBER
OCT$: CALL GETHLP
MOVEI A,8 ;OCTAL RADIX
JRST NUM13 ;JOIN COMMON CODE
;TIME
TIME$: CALL GETHLP
MOVX A,CM%ITM ;TIME ONLY
MOVEM A,CMDAT
MOVX A,CMTAD ;TIME AND DATE FUNCTION
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;DATE AND TIME
;THE POSSIBILE THINGS ARE:
;
;1) SPECIFIC DATE AND TIME (OR JUST TIME, WHICH ASSUMES TODAY)
;
;2) "+" OR "-" FOLLOWED BY AMOUNT OF TIME, WHICH MEANS NOW + - AMOUNT
;
;3) KEYWORD, FOLLOWED BY KEYWORD-DEPENDENT DATA
DA%DAY==1B18 ;BIT TO MEAN DAY OF THE WEEK
;KEYWORD TABLE FOR DATE AND TIME
$DKEYS: TABLE
T FRIDAY,,DA%DAY+4
T MONDAY,,DA%DAY+0 ;TOO BAD THIS HAS TO BE ALPHABETICAL
T SATURDAY,,DA%DAY+5
T SUNDAY,,DA%DAY+6
T THURSDAY,,DA%DAY+3
T TODAY
T TUESDAY,,DA%DAY+1
T WEDNESDAY,,DA%DAY+2
TEND
DTR$: MOVEI A,1 ;SAY WE WANT TIME RELATIVE TO NOW
JRST DT1
DT$: TDZA A,A ;SAY WE WANT TIME IN THE FUTURE
DTP$: MOVNI A,1 ;SAY WE WANT TIME IN THE PAST
DT1: TRVAR <RETBTS,TODAY,SENSE,DAYWEK,NOW,TOMORO,BTIME,<STRNG0,10>>
MOVEM A,SENSE ;REMEMBER WHETHER FUTURE OR PAST
SETZM RETBTS ;INITIALLY, NO RETURN BITS
CALL GETHLP
GTAD ;GET CURRENT TIME AND DATE
MOVEM A,NOW
MOVSI B,1
ADD B,A ;GET TOMORROW SAME TIME IN A
HRROI A,STRNG0 ;WRITE TO SCRATCH
MOVX C,OT%NTM ;WE WANT ONLY DATE
ODTIM ;GET STRING FOR TOMORROW'S DATE
HRROI B,[ASCIZ / 0:0:0/]
MOVEI C,0
SOUT ;MAKE DATE AND TIME FOR BEGINNING OF TOMORROW
HRROI A,STRNG0 ;POINT AT FULL STRING
MOVEI B,0 ;NO SPECIAL FORMAT
IDTIM ;GET INTERNAL FORMAT FOR TOMORROW
CALL JERR ;SHOULDN'T FAIL
MOVEM B,TOMORO ;REMEMBER VALUE FOR TOMORROW
SUB B,[1B17] ;CREATE BEGINNING OF TODAY
MOVEM B,TODAY
MOVX A,CM%IDA+CM%ITM
MOVEM A,CMDAT ;FIRST FUNCTION IN CHAIN IS DATE AND TIME
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter amount of time from now>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
SKIPGE SENSE ;DIFFERENT CHOICES FOR DATE AND TIME IN PAST
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /-/]>,<"-" to enter amount of time in past>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
CALL $WORK
RET ;BAD INPUT TYPED
LDB D,[331100,,(C)] ;GET FUNCTION FLAVOR
CAIN D,.CMKEY ;KEYWORD?
JRST DAKEY ;YES, GO HANDLE IT
CAIN D,.CMTOK ;"+" OR "-"?
JRST GETPLM ;YES, GO HANDLE IT
MOVE D,.CMDAT(C) ;GET CONTROL BITS
MOVX A,DATBIT ;GET BIT SAYING USER TYPED A DATE
TXNE D,CM%IDA ;IS IT A DATE?
JRST [IORM A,RETBTS ;YES, REMEMBER
JRST DTEXIT] ;GO DO STANDARD EXIT
SKIPLE A,SENSE ;IS TIME INDEPENDENT?
JRST DTEXIT ;YES, NO FIXUP NEEDED
CAMG B,NOW ;COMPUTE VALUE TO ADD
ADDI A,1
JUMPE A,DTEXIT ;DON'T BOTHER IF ZERO
HRLZS 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. It returns bits in
;A declaring what the user typed.
DTEXIT: MOVE A,RETBTS ;GET RETURN BITS
RETSKP ;SKIP TO DENOTE SUCCESS
;ROUTINE TO INPUT AN AMOUNT OF TIME.
;RETURNS:
; +1 SYNTAX ERROR
; +2 A/ INTERNAL FORMAT
; B/ SECONDS
GETAMT::STKVAR <CTIM>
DECX <Amount of time in form hh:mm>
RET ;GIVE UP IF CAN'T READ HOURS
IMULI B,^D3600 ;CHANGE TO SECONDS
MOVEM B,CTIM ;SAVE NUMBER OF SECONDS
COLONX <Colon to separate hours and minutes>
JRST ONENUM ;ONLY ONE NUMBER BEING TYPED
DECX <Minutes>
RET ;ERROR IF NO NUMBER AFTER COLON
IMULI B,^D60 ;CHANGE MINUTES TO SECONDS
ADDM B,CTIM ;ACCUMULATE RESULT
COLONX <Colon, if seconds are being entered>
JRST NOSECS ;NO SECONDS FORTHCOMING (THAT'S O.K.)
DECX <Seconds>
RET ;ERROR IF SECOND COLON AND NO SECONDS
ADD B,CTIM ;GET TOTAL SECONDS
T22: MOVEM B,CTIM ;REMEMBER SECONDS
MUL B,[1B17] ;IN INTERNAL FORMAT, RIGHT HALF OVER 1B17 IS FRACTION OF A DAY
DIV B,[^D86400] ;DIVIDE BY SECONDS IN A DAY
CAILE C,^D86400/2 ;ROUND
AOJ B,
MOVE A,B ;RETURN RESULT IN A
MOVE B,CTIM ;RETURN SECONDS IN B
RETSKP
ONENUM: MOVE B,CTIM ;GET NUMBER OF SECONDS GIVEN HOURS
IDIVI B,^D60 ;TREAT NUMBER AS THOUGH IT WERE ORIGINALLY MINUTES
JRST T22
NOSECS: MOVE B,CTIM ;NO SECONDS FORTHCOMING
JRST T22
;KEYWORD TYPED AFTER /AFTER:
DAKEY: CALL GETKEY ;GET KEYWORD DATA
TXNN P3,DA%DAY ;DAY OF THE WEEK?
JRST (P3) ;NO, DO SPECIFIC THING
ANDI P3,7 ;DAY OF THE WEEK, KEEP ONLY IT
MOVEM P3,DAYWEK ;REMEMBER DAY
MOVE B,TOMORO ;PUT TOMORROW REAL EARLY MORNING IN B
MOVEI D,0 ;NO SPECIAL BITS
ODCNV ;SEE WHAT DAY OF WEEK TOMORROW IS
SKIPN SENSE
JRST [ MOVNI C,-1(C) ;NEGATE DAY OF WEEK AND FLUSH DAY OF MONTH
HRRE C,C ;FOR SUNDAY, GET RID OF 777777 IN LEFT HALF
ADD C,DAYWEK ;GET NUMBER OF DAYS FROM TOMORROW IS DESIRED
CAIGE C,0
ADDI C,7 ;FOR FUTURE, "SUBMIT /AFTER:MONDAY" MEANS NEXT TUESDAY OR LATER
JRST SL]
SUB C,DAYWEK
MOVNI C,(C) ;GET NEGATIVE NUMBER OF DAYS BEFORE TOMORROW WE WANT, AND FLUSH DAY OF MONTH
HRRE C,C ;IN CASE C WAS NEGATIVE BEFORE
SKIPLE SENSE ;RELATIVE TO NOW?
JRST SL ;YES - CHECK LATER
CAIL C,0
SUBI C,7 ;FOR PAST, "DIRECTORY SINCE MONDAY" MEANS FILES WRITTEN LAST MONDAY OR MORE RECENTLY"
SL: ASH C,22 ;SHIFT INTO POSITION FOR INTERNAL FORMAT
ADD C,TOMORO ;GET INTERNAL REPRESENTATION FOR DAY SPECIFIED
MOVEM C,BTIME
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,<-1,,[ASCIZ /+/]>,<Optional "+" to add amount of time>]
CALL FLDSKP ;IS USER TYPING "+"?
JRST NOPLUS ;NO
CALL GETAMT ;YES, GET AMOUNT OF TIME
RET ;IF ERROR, NON-SKIP
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: MOVEI A,0 ;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,<-1,,[ASCIZ /+/]>,<"+" to enter interval in number of days>,,]]]]
CALL $WORK
RET ;BAD INPUT
LDB C,[331100,,(C)] ;GET FLAVOR OF FUNCTION
CAIE C,.CMTOK ;"+"?
RETSKP ;NO, A VALID DATE & TIME WAS GIVEN
DECX <Interval in number of days>
RET ;INVALID
RETSKP ;RETURN # OF DAYS
;QUOTED STRING
QUOTE$: CALL GETHLP
MOVX A,CMQST ;QUOTED STRING FUNCTION CODE
CALLRET $WORK ;OUTPUT IT AND SKIP OR NORMAL RETURN
;USER NAME
USERS$: SKIPA A,[CM%DWC] ;ALLOW WILDCARDING
USER$: MOVEI A,0 ;NO WILDCARDING
MOVEM A,CMDAT ;STORE IN DATA FIELD
CALL GETHLP
MOVX A,CMUSR ;USER NAME FUNCTION
CALLRET $WORK
;DIRECTORY NAME
DIRS$: MOVX A,CM%DWC ;ALLOW WILDCARDING
MOVEM A,CMDAT ;STORE IN DATA FIELD
DIR$: CALL GETHLP
MOVX A,CMDIR
CALLRET $WORK
;STRUCTURE NAME, LIKE DEVICE BUT NEEDN'T EXIST
STR$: CALL GETHLP
MOVX A,CMDEV!CM%PO
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$: CALL GETHLP
MOVX A,CMFIL ;SPECIFY FILE FUNCTION
CALLRET $WORK
;READ ENTIRE REST OF LINE
LINE$: CALL GETHLP
MOVX A,CMTXT ;TEXT FUNCTION
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;CONTROL-E
CTRLE$: HRROI A,[ASCIZ //] ;EXPECTED FIELD
JRST CHAR ;JOIN COMMON CODE
;PARSE A COMMA
COMMA$: CALL GETHLP
MOVX A,CMCMA ;COMMA FUNCTION
CALLRET $WORK
;PARSE A SLASH
SLASH$: HRROI A,[ASCIZ ./.]
JRST CHAR
;PARSE A BACKSLASH
BSLSH$: HRROI A,[ASCIZ .\.]
JRST CHAR
;PARSE A DOT
DOT$: HRROI A,[ASCIZ /./]
JRST CHAR
;PARSE A COLON
COLON$: HRROI A,[ASCIZ /:/]
JRST CHAR
;PARSE CHARACTER PASSED IN AC1
CHAR$: STKVAR <STRNG> ;STORAGE FOR CHARACTER STRING
ROT A,-7 ;MAKE ASCIZ STRING
MOVEM A,STRNG ;PUT IT ON STACK
HRROI A,STRNG ;POINT TO STRING
JRST CHAR ;FINISH UP
;PARSE A FIELD WHICH IS JUST "*"
STAR$: HRROI A,[ASCIZ /*/] ;EXPECTED FIELD
CHAR: MOVEM A,CMDAT
CALL GETHLP
MOVX A,CMTOK
CALLRET $WORK ;DO THE WORK AND SKIP OR NORMAL RETURN
;PARSE A HYPHEN
DASH$: HRROI A,[ASCIZ /-/]
JRST CHAR ;USE COMMON CODE
;READ AND PARSE NEXT NON-BLANK CHARACTER
CMDCHT::STKVAR <STRNG>
CALL CMDCHR ;READ NEXT NON-BLANK CHAR FROM COMMAND
ROT A,-7 ;MAKE ASCIZ STRING
MOVEM A,STRNG
CALL CMDBAK ;BACKUP OVER CHAR JUST READ
HRROI A,STRNG
JRST CHAR ;PARSE THAT
ENDSV.
;SYMBOLIC ADDRESS
;This can be of the form "x" or "x,," or "x,,y", all of which can be
;symbolic.
ADDR$: STKVAR <LHVAL>
CALL ADDPRT ;GET A PART
RET ;FAILED
MOVEM A,LHVAL ;REMEMBER LEFT HALF
CALL NESC ;USER TYPE ESCAPE?
JRST NC ;YES, EXIT NOW SO GUIDE WORDS WILL BE SEEN
MOVEI B,[FLDDB. .CMTOK,,<-1,,[ASCIZ /,,/]>]
CALL FLDSKP ;SEE IF TWO COMMAS NEXT
JRST [NC: 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 "*"
CAIA ;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 OP
;IF GROUPF NOT SET, DEFAULTS NAME AND EXT TO INPUT JFN
;RETURNS OUTPUT JFN IN OUTDSG
;IF GROUPF SET, DEFAULTS TO *.*;-1 AND RETURNS JFN IN MCOJFN
MFOUT:: MOVE A,[XWD [ASCIZ/*/],[ASCIZ/*/]] ;DEFAULT TO *'S
MOVE B,INIFH1
CAME B,INIFH2 ;IF EXACTLY 1 TERM, MAYBE USE NAMES
JRST MCOPY1
HRRZ B,@INIFH1 ;GET JFN ONLY
CAIN B,FI%ERR ;DID FILE EXIST?
JRST MCOPY1 ;NO--USE *.* AS DEFAULT
MOVE B,@INIFH1 ;GET JFN AND BITS
TXNN B,GJ%NAM ;* FOR NAME?
HRLI A,2 ;NO, USE PREVIOUS NAME
TXNN B,GJ%EXT ;* FOR EXT?
HRRI A,2 ;NO, USE PREVIOUS EXT
MCOPY1: MOVEI B,(GJ%FOU+GJ%IFG+GJ%OFG+GJ%MSG) ;DEFAULT TO -1 VERSION
CALL SPECFN ;COLLECT FILE NAME, GTJFN FLAGS IN RH B.
JRST CERR
MOVEM A,OUTDSG ;DESTINATION JFN
MOVEM A,MCOJFN ;HERE FOR MULTI FILE COPY
MOVE B,A ;PUT FILE HANDLE IN B (WITH WILDCARD BITS)
LDF C,1B2 ;BITS TO GET DEVICE FIELD
TXNE B,GJ%DEV+GJ%UNT ;WILDCARDS USED IN DEVICE FIELD?
CALL BADSTR ;ERROR IF BAD WILDCARD SYNTAX
LDF C,1B5 ;SPECIFY DIRECTORY
TXNE B,GJ%DIR ;STAR IN DIRECTORY FIELD?
CALL BADSTR ;YES, MAKE SURE IT'S LEGAL
LDF C,1B8 ;NAME FIELD
TXNE B,GJ%NAM
CALL BADSTR ;MAKE SURE LEGAL STARS IN NAME FIELD
LDF C,1B11 ;TYPE FIELD (EXTENSION)
TXNE B,GJ%EXT
CALL BADSTR
LDF C,1B14 ;GENERATION NUMBER
TXNE B,GJ%VER
CALL BADSTR ;MAKE SURE LEGAL WILCARDS IN GENERATION FIELD
HLRZ A,JBUFP ;WILL REQUIRE AT LEAST 1 MORE JFN FOR COMMAND
CAIN A,-1
ERROR <Too many JFNs in command>
RET
;FOLLOWING ROUTINE RETURNS IFF STRING RETURNED BY JFNS CONTAINS
;ONLY "*". CALL THIS ROUTINE WITH INDEXABLE FILE HANDLE (FLAGS,,JFN)
;IN B, AND JFNS BITS IN C. AC'S PRESERVED. THE PURPOSE OF THIS ROUTINE
;IS TO CATCH FANCY FILENAMES THAT WON'T CAUSE EXPECTED RESULT.
;FOR INSTANCE "RENAME *.* (TO BE) X*.*" DOESN'T REALLY PUT "X" IN FRONT
;OF EVERY NAME, SO THIS ROUTINE MAKES SURE YOU'RE NOT TRYING TO DO
;THAT TYPE OF THING.
BADSTR: SAVEAC <A,B,C>
STKVAR <<JFNSP,EXTSIZ>>
HRROI A,JFNSP
JFNS ;GET FIELD
HRROI A,JFNSP ;POINT AT FIELD WE JUST WROTE
HRROI B,[ASCIZ /*/]
STCMP ;MAKE SURE ONLY "*" AND NOT "F*" ETC.
JUMPN A,[ERROR <Invalid use of wildcard characters>]
RET ;RETURN SUCCESFULLY
;GET OUTPUT NAME FOR MULTI FILE OPERATION
;GETS JFN INTO OUTDSG, ASSUMES SCANNED
;OUTPUT NAME JFN IN MCOJFN. SKIPS ON SUCCESSFUL GTJFN AFTER
;PRINTING FILESPEC.
;DIRECT RETURN ON GTJFN ERROR, NAME AND MESSAGE ALREADY PRINTED
MFSET:: TRVAR <MFPP,<MFBUF,FILWDS>>
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
MOVSI A,(GJ%DEV) ;FLAG BIT TO TEST
MOVE C,[1B2+1B35] ;GET DEVICE
CALL MCOSTR ;GET STRING
MOVSI A,(GJ%DIR)
MOVE C,[1B5+1B35] ;GET DIRECTORY
CALL MCOSTR
MOVSI A,(GJ%NAM)
MOVE C,[1B8+1B35] ;NAME
CALL MCOSTR
SKIPN MFBUF ;NULL FILESPEC?
JRST MFSET1 ;YES
MOVSI A,(GJ%EXT)
MOVE C,[1B11+1B35] ;EXT
MOVE D,MFPP ;SAVE THE CURRENT STRING POINTER
CALL MCOSTR
MOVEI A,"." ;FOR NULL EXTENSIONS
CAMN D,MFPP ;SEE IF WE GOT SOMETHING
IDPB A,MFPP ;NOTHING CHANGED, FORCE A NULL EXTENSION
MOVSI A,(GJ%VER)
MOVE C,[1B14+1B35] ;VERSION
CALL MCOSTR
MOVE C,[2B17+1B35] ;PROTECTION
CALL MCOSTO ;GET PROTECTION FROM OUTPUT
MOVE C,[2B20+1B35] ;ACCOUNT
CALL MCOSTO
MOVE C,[1B21+1B35] ;";T"
CALL MCOSTO
MOVE C,[JS%ATR!JS%PAF] ;GET ATTRIBUTES
CALL MCOSTO
MFSET1: SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
UTYPE [ASCIZ/ => /]
HRROI B,MFBUF
MOVSI A,(GJ%FOU!GJ%SHT!GJ%DEL!GJ%FLG!GJ%PHY) ;OUTPUT, SHORT CALL, DELETED OK, PHYSICAL ONLY
CALL GTJFS ;DO GTJFN, STACK IN CASE ^C
JRST [ HRROI B,MFBUF ;GET POINTER TO BEGINNING OF STRING
LERROR <Destination GTJFN failure on %2M%%_% %1?>
RET]
HRRZM A,OUTDSG
MOVE B,A ;GET FULL JFN INTO B
TXZ B,GJ%UHV!GJ%NHV!GJ%ULV ;MAKE VERSION NUMBER COME OUT RIGHT
MOVE A,COJFN ;OUTPUT NAME TO HERE
MOVE C,[2B2+2B5+2B8+2B11+2B14+2B17+2B20+1B21+JS%ATR+1B35]
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
JFNS
HRRZ A,OUTDSG
DVCHR ;GET DEVICE CHARACTERISTICS OF OUTPUT FILE
LDB A,[POINT 9,B,17] ;DEVICE TYPE
CAIE A,.DVDSK ;IF DISK, SPECIAL CHECK
RETSKP ;ELSE INDICATE SUCCESS
HRRZ A,OUTDSG
MOVE B,[1,,.FBCTL] ;GET FLAG WORD
MOVEI C,A ;INTO A
CALL $GTFDB
SETZ A, ;MAKE SURE FB%NXF OFF IF ACCESS PREVENTED
TXNN A,FB%NXF ;NEW FILE?
TYPE < [Superseding]> ;NO, INFORM USER
RETSKP
MCOSTR: TDNN A,MCOJFN ;OUTPUT * HERE?
MCOSTO: SKIPA B,MCOJFN ;NO, USE OUTPUT FIELD
HRRZ B,@INIFH1 ;YES, USE INPUT FIELD
MOVE A,MFPP ;GET STRING SPACE POINTER
JFNS ;GET STRING
MOVEM A,MFPP ;STORE STRING SPACE POINTER
RET
;CALL TO COPY JFN POINTED TO BY INIFH1 TO SECOND JFN
;THEN ADVANCE INIFH1 PAST THAT FILE. USED BY DELETE AND
;RENAME BECAUSE GNJFN DOES NOT WORK AFTER RENAME AND SOME DELETES.
MFINP:: CALL MFINP0 ;GET JFN AND FLAGS
RET ;FAILED
HRRZ A,A ;GET RID OF FLAGS
RETSKP
;MFINP0 IS LIKE MFINP BUT RETURNS GNJFN FLAGS IN LEFT HALF OF A
MFINP0::STKVAR <MFJFN,<MFIBUF,FILWDS>>
HRROI A,MFIBUF
HRRZ B,@INIFH1 ;JFN
MOVE C,[1B2+1B5+1B8+1B11+1B14+JS%ATR+1B35] ;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 & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON.
;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS.
;CAN INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS *.MAC FORMS.
;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER
; 2 => USE EXT OF LAST FILE NAME INPUT AS DEFAULT EXT
; LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
; 0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE
; 1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT
; 2 => LIKE 0 BUT USE LAST NAME INPUT AS DEFAULT NAME
; -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR *
; -2 LIKE -1 BUT GIVE R1 IF NO SUCH FILE
; ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0)
; RH: FLAGS FOR GTJFN PLUS:
; B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",".
; DOES NOT HANDLE ALTMODE-COMMA (USE ^F FOR RECOGNITION),
; MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY)
; B16: ALLOW GROUP OF NAMES SEPARATED BY SPACE, ALTMODE, OR
; SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED
; BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND
; INPUT REQUIRED).
; B15 SHOULD ALSO BE ON.
; ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN
; PRE-READ FOLLOWING FIELD
;CF%NS B17: NO SUBCOMMANDS FOLLOW THE LIST.
;
; B14: IF NO SUCH DEVICE, NO SUCH DIRECTORY,...,
; NO SUCH GENERATION... RETURN PTR,,FI%ERR IN PLACE OF JFN
; PTR POINTS TO <CHAR COUNT>,,<ERROR #> FOLLOWED BY
; BYTE POINTER TO TYPESCRIPT.
;
;
; ALSO, F3 IN Z SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN
; AFTER INITIAL TRY FAILS -- FOR DEFAULT RUN
; IGINV in Z says to allow invisible files (G1%IIN)
;COLLECT FILE NAMES COMMENTS...
;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT,
; OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A),
; OR P2=EOL AT ENTRY (IN WHICH CASE NO INPUT),
; OR -2 IN LH OF A AND NO SUCH FILE,
; OR B16 ON AND LIST ENDED WITH COMMA.
; THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T
; BE USED IF B15 OR B16 ON.
; +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF"
; (POINTER JBUFP). 1ST LOCATION IN THIS BUFFER
; (FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,...
; IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT
; (B11,15,16 ON), SETS INIFH1 &2 TO 1ST & LAST USED
; LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF"
; IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT).
; EITHER: TERMINATOR IN "P2"
;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF,
; AS %KEYW DOES. SEE %KEYW'S GLITCH NOTE (S1.MAC).
;FLAGS IN AC D
;RH: FROM CALLER
;LH:
; B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA
; B2: DITTO, DITTO, FOLLOWED BY COMMA
;COLLECT FILE NAMES... ENTRIES.
CSAVFN: MOVEI B,<GJ%FOU!GJ%MSG>B53 ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME).
;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION.
COUTFN: MOVEI B,(GJ%FOU!GJ%MSG) ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP.
;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA.
;NO SPECIAL RETURN FOR "*" OR NULL INPUT.
;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN".
;COLLECT FILE NAMES... GROUP ENTRIES
;.INFG
;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME -
; THUS ^F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW.
;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW,
; AS IN 1ST ARG TO "COPY".
;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP),
; VERSION TO HIGHEST.
;ONE RETURN ONLY.
;.INFG, BUT WITH NO SEARCH (FOR ACCOUNT, VERSION-RET..., PROTECTION)
INFGNS::MOVE B,[XWD -3,<GJ%OLD!GJ%IFG!GJ%NS!1B14!1B15>B53] ;* VERSION FOR RENAME
JRST .INFG1
.INFG: MOVEI B,(GJ%OLD!GJ%IFG!1B15)
.INFG1: MOVE A,[XWD 2,2]
CALL SPECFN
JRST CERR
RET
;$INFGX
;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT
;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT).
$INFGX: MOVEI B,(GJ%OLD!GJ%IFG!1B14!1B15!1B16)
MOVE A,[XWD 2,2]
JRST SPECFN
;FLAVOR THAT READS LIST OF FILESPECS, AS IN "TYPE" COMMAND, OR
;"SET FILE INVISIBLE". NOTE THAT THIS IS THE WRONG ROUTINE FOR
;THINGS LIKE "SET FILE PROTECTION" WHICH TAKE ANOTHER ARG (THE PROTECTION)
;AFTER THE LIST
TYPFLS::DMOVE A,[EXP 0,<(GJ%OLD!GJ%IFG!1B15!1B16!1B17)>] ;NO SPECIAL, OLD FILE, STARS ALLOWED, LIST O.K., LIST IS LAST ON LINE, NO SUBCOMMANDS
CALL SPECFN ;GATHER SPECS TO TYPE
RET ;NO SUBCOMMANDS
RET
;DIRARG
;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT:
; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!).
; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS
; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER.
; ACCEPTS * FOR NAME IN EMPTY DIRECTORY
; SETS NO SEARCH FOR GTJFN
DIRARG: MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]]
HRLI B,-3 ;DEFAULT VERSION: *
HRRI B,(GJ%OLD!GJ%DEL!GJ%IFG!1B14!1B15!1B16)
JRST SPECFN
;COLLECT FILE NAMES ENTRIES...
;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH.
; USED IN SPECIAL CASES, EG:
; DELETED FILE NAME FOR "UNDELETE"
; ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY".
;END OF ENTRIES. CASES MERGE HERE.
SPECFN: SETZM CJFNBK+2 ;NO DEFAULT DEVICE
SETZM CJFNBK+3 ;AND NO DEFAULT DIRECTORY
CFN1A: TRVAR <SAVFGS,CEX,SEXJFN,CFNMOD,CFLAGS>
MOVEM A,CFNMOD ;SAVE MODE BITS
HRRZ D,B ;SAVE GTJFN AND LOCAL FLAGS IN RH D
MOVEM D,CFLAGS ;SAVE FLAGS
TRZ B,(1B14!1B15!1B16) ;DON'T GIVE LOCAL FLAGS TO GTJFN
TRNN D,(GJ%OFG) ;IF OUTPUT GROUP THEN NOT INPUT
TRNN D,(GJ%IFG!1B15!1B16) ;IF AN INPUT GROUP IS BEING REQUESTED,
SKIPA
SETZM INIFH1 ;SAY NO NAMES HAVE BEEN INPUT YET.
;COLLECT FILE NAMES...
;SET UP GTJFN PARAMETER BLOCK
MOVSM B,SAVFGS ;FLAGS AND DEFAULT VERSION
SETZ B, ;SET UP .GJF2 WORD
TXNE Z,IGINV ;ALLOW INVISIBLE?
TXO B,G1%IIN ;YES
MOVEM B,CJFNBK+.GJF2 ;STORE IN GTJFN BLOCK
;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP
CFN2: MOVE A,SAVFGS ;GET SAVED FLAGS
MOVEM A,CJFNBK+.GJGEN ;SET UP FOR GTJFN (ERROR HANDLING MAY HAVE CLOBBERED THEM)
MOVE A,CFNMOD ;RESTORE MODES
MOVE B,JBUFP
MOVEM B,.JBUFP
;FORM "DEFAULT STRING POINTER" TO EXTENSION
HRRZ B,A
MOVX C,FLD(.JSAOF,JS%TYP) ;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT
CAIN B,2 ;2 SAYS USE EXT OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S EXT
SKIPE B
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+5
;FORM "DEFAULT STRING POINTER" TO DEFAULT NAME
HLRZ B,A
MOVX C,FLD(.JSAOF,JS%NAM) ;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT.
CAIN B,2 ;2 SAYS USE NAME OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S NAME
CAIE B,-2
CAIN B,-1
SETZ B,
SKIPE B
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+4
HLRZ B,JBUFP ;CHECK SPACE IN JFN BUFFER
CAIN B,-1
ERROR <Too many JFNs in command>
FILEX <FILE NAME> ;TRY TO READ FILE NAME
JRST CFNE ;COULDN'T
MOVE A,B ;PUT JFN INTO A
;COLLECT FILE NAMES...
;CODE FOR THE VARIOUS GROUP CASES
CFN4Z: MOVE D,CFLAGS ;GET FLAGS (SUBROUTINES MAY CLOBBER D!)
TRNN D,(GJ%OFG)
TRNN D,(GJ%IFG!1B15!1B16)
RETSKP ;NO SUCH OPTIONS ON
HRRZ B,JBUFP
SKIPN INIFH1 ;FIRST JFN IN GROUP?
MOVEM B,INIFH1 ;YES, SAVE JBUF POINTER
TLNE A,<77B5>B53 ;ANY *'S INPUT OR DEFAULTED TO?
TLO Z,GROUPF ;YES, SAY GROUP WAS SPECIFIED.
TRNN D,(1B15) ;INPUTTING GROUPS OF FILES?
JRST CFN7Z ;NO
TRNE D,(1B16) ;INPUTTING UNTIL END OF LINE?
JRST B16ON ;YES
MOVE A,CMFLG ;NOT INPUTTING TO END OF LINE, GET FLAGS
TXNE A,CM%ESC ;DID USER END FILE NAME WITH $ ?
JRST CFN7Z ;YES, SO WE'RE DONE
;Note here that ESCAPE is being used for
;two purposes, both to complete the filespec
;automatically, and to declare that you want
;the guide words for the next field of the
;command. This is sort of a loser. What if
;you want one and not the other???
COMMAX <Comma to specify another filespec, or next field of command>
;REGULAR GROUP, SO WE NEED COMMA TO READ ANOTHER NAME
JRST CFN7Z ;GROUP BUT NO COMMA AFTER FILE NAME, SO WE'RE DONE
CFN22: TLO Z,GROUPF ;NOTE THAT GROUP HAS BEEN INPUT
JRST CFN2 ;GET NEXT FILE AFTER THE COMMA
B16ON: HELPX <Carriage return to end command
or comma and another filespec
or comma and carriage return to enter subcommands>
TRNE D,(CF%NS) ;DON'T ADVERTISE SUBCOMMANDS IF CALLER HAS NONE
HELPX <Carriage return to end command
or comma and another filespec>
CRRX ;INPUTTING UNTIL END OF LINE, HAVE WE REACHED IT YET?
CAIA ;NOT YET
JRST CFN7Z ;YES
COMMAX ;COMMA AFTER FILE NAME?
ERROR <Comma missing between filespecs or illegal character in command>
TRNE D,(CF%NS) ;NO SUBCOMMANDS?
JRST CFN22 ;RIGHT, SO COMMA MEANS ANOTHER FILE COMING
CRRX <Carriage return to enter subcommands
or another filespec> ;SUBCOMMANDS, SO WE WANT R1
JRST CFN22 ;COMMA NOT FOLLOWED BY CR, MUST BE ANOTHER FILE SPEC
CALLRET CFNFIX ;GET RETURN DATA AND GIVE NON-SKIP RETURN
CFN7Z: CALL CFNFIX
RETSKP
CFNFIX: HRRZ B,JBUFP
MOVEM B,INIFH2 ;RETURN JBUFP VALUE FOR LAST NAME IN GROUP
MOVE A,@INIFH1 ;RETURN FIRST, NOT LAST, JFN IN A
RET
;GTJFN ERRORS
;FIRST TEST ERROR CODE FOR EXCEPTIONS.
CFNE: CALL GETERR ;GET REASON THE GTJFN FAILED
CAIN A,GJFX3
ERROR <No JFNs available: You must close some files first>
CAIN A,GJFX22
ERROR <JSB full: Try closing some files then repeating command>
CAIN A,GJFX23
ERROR <Directory full: Can't create new files until you
"DELETE" some files and "EXPUNGE (DIRECTORY)">
TRNN D,(1B14) ;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
MOVEI A,.FILEN ;GET SIZE OF ERROR BLOCK
CALL GTBUFX ;GET BUFFER FOR BLOCK (NOT GETBUF, SINCE UNMAP
;MIGHT BE CALLED BEFORE RLJFNS!)
EXCH A,CEX ;STORE ADDRESS IN CEX, GET ERROR CODE IN A
MOVE B,CEX ;GET ADDRESS OF BLOCK
MOVEM A,.FIERR(B) ;STORE ERROR CODE IN FIRST WORD OF BLOCK
MOVE A,SEXJFN ;GET JFN AND FLAGS IN CASE CALLER WANTS IT
MOVEM A,.FIJFN(B) ;REMEMBER IT IN CASE CALLER NEEDS IT
HRROI A,ATMBUF ;POINT TO FILESPEC
CALL XBUFFS ;BUFFER IN PERMANENT SPACE (SO UNMAP DOESN'T CLOBBER IT)
MOVE B,CEX ;GET ADDRESS OF BLOCK
MOVEM A,.FISTR(B) ;STORE STRING POINTER IN BLOCK
HRL A,CEX ;ADDRESS IN LEFT HALF
HRRI A,FI%ERR ;SPECIAL CODE
MOVE B,JBUFP ;SEE WHERE ON STACK THIS ENTRY SHOULD BE PUT
MOVEM A,(B) ;REPLACE PARSE-ONLY JFN WITH ERROR ENTRY
CALL PION ;ALLOW ^C AGAIN NOW THAT FREE SPACE USAGE HAS BEEN RECORDED
JRST CFN4Z ;FINISH PROCESSING
;NXFILE
;CHECK FOR FLAG IN PLACE OF JFN (FI%ERR)
;IF ON, PRINT ERROR MESSAGE AND TYPESCRIPT
NXFILE::ATSAVE
HRRZ A,@INIFH1
CAIE A,FI%ERR ;SPECIAL CASE?
RETSKP ;NO
CALL %MESS
HLRZ D,@INIFH1 ;GET POINTER TO STRING
HRRZ A,.FIERR(D) ;GET GTJFN ERROR CODE
CALL $ERSTR ;PRINT ERROR
TYPE < - >
UTYPE @.FISTR(D) ;PRINT TYPESCRIPT
ETYPE<%_>
AOS A,INIFH1 ;SKIP OVER THIS TERM
CAMLE A,INIFH2 ;PAST END?
SETZM INIFH1 ;YES, FLAG SUCH
RET
$ERSTR::ETYPE <%1?> ;TYPE MESSAGE FOR CODE IN A
RET
;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN.
;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING
; JFNS FORMAT SPECIFICATION IN C.
;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING
;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS
; COMMAND, RETURNS 0 IN B.
LFJFNS: SAVEAC <A>
STKVAR <<LFBUF,FILWDS>>
SETZM LFBUF ;SO WE'LL KNOW IF SOMETHING'S WRITTEN
HRRZ B,JBUFP ;JFN STACK POINTER
CAIN B,JBUF-1 ;HAS A NAME BEEN INPUT YET?
JRST LFJF9 ;NO, GO RETURN 0 POINTER
HRRZ A,(B) ;PICK UP JFN OF LAST NAME INPUT
CAIE A,-2
CAIN A,-1
JRST LFJF9 ;-1, -2 ISN'T A JFN BUT MIGHT GET HERE
HRROI A,LFBUF
MOVE B,JBUFP
MOVE B,(B) ;PICK UP JFN AGAIN
JFNS ;DO THE JFN TO STRING CONVERSION
SKIPN LFBUF
HRLI A,440700 ;RETURN POINTER TO NULL STRING
SETZ B,
IDPB B,A ;APPEND NULL TO STRING
HRROI A,LFBUF ;POINT TO STRING
CALL BUFFS ;RETURN POINTER TO STRING
MOVE B,A ;RETURN POINTER IN B
RET
LFJF9: SETZ B, ;RETURN 0 IF CAN'T RETURN A STRING
RET
;CPFN: COLLECT PROGRAM FILE NAME
;TAKES: A: 0 OR WORD POINTER TO DEFAULT DEVICE NAME.
;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV".
;RETURNS +1 ON GTJFN FAILURE.
CPFN: MOVEI B,100000
CPFNA: JUMPE A,.+2
HRLI A,<POINT 7,0,-1>B53 ;IF NON-0, FILL OUT BYTE PTR
MOVEM A,CJFNBK+2 ;DEFAULT DEVICE
HRRI A,[GETSAVE()] ;DEFAULT EXT
HRLI A,-2 ;SAY RETURN +1 ON GTJFN FAILURE
JRST CFN1A ;JOIN CINFN & COUTFN
;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP
; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT)
;RETURNS JFN IN A
TYPIF: HRRZ A,@INIFH1 ;GET CURRENT JFN
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, SKIP IF NON-GROUP
ETYPE < %1S> ;%S: TYPE NAME FOR JFN
RET
;TYPOK: TYPES [OK] CORRESPONDING TO TYPIF ABOVE
;SHOULD BE CALLED ONCE FOR EACH CALL ON TYPIF, BUT
;ONLY AFTER SUCCESFULL COMPLETION OF FILE
TYPOK: SKIPN TYPGRP
TLNE Z,GROUPF
TYPE < [OK]
>
RET
;GNFIL
;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A WITH FLAGS FROM GNJFN.
;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).
GNFIL: PUSH P,A
PUSH P,B
HRRZ A,@INIFH1
GTSTS
JUMPGE B,GNFIL3 ;JUMP IF NOT OPEN
TXO A,CO%NRJ ;SAY DON'T RELEASE JFN
CLOSF
CALL JERR
GNFIL3: MOVE A,@INIFH1
TLNN A,<77B5>B53 ;NO *-FLAGS, SKIP GNJFN AND ITS BUGS
JRST GNFIL5
CAME A,[-2] ;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES
;(THAT SHOULDN'T GET HERE ANYWAY)
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
SUB P,[XWD 1,1]
RET
;THIS ROUTINE OBTAINS CONNECTED STRUCTURE. RETURNS POINTER THERETO IN A.
CONST:: GJINF ;GET CONNECTED DIRECTORY NUMBER
MOVE A,CSBUFP ;POINT TO STRING SPACE
DIRST ;GET STR:<DIR>
ERJMP CJERRE ;GO TELL USER WHY IT FAILED (PROBABLY STRUCTURE DISMOUNTED)
MOVE A,CSBUFP ;POINTER TO STRING
STDEV ;GET DEVICE DESIGNATOR FOR STRUCTURE
ERJMP CJERRE ;COULDN'T, SAY WHY AND DIE
MOVE A,CSBUFP ;POINT TO FREE SPACE
DEVST ;MAKE STRING NAME OF STRUCTURE
ERJMP CJERRE ;FAILED
MOVE A,CSBUFP ;POINT TO THE NAME
CALLRET BUFFS ;BUFFER IT AND RETURN POINTERTO USER
;DEVN
;INPUT AND VERIFY A DEVICE NAME.
;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI
; AS TERMINATOR.
;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS.
;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
;ENTRY
DEVN:
;RETURN HERE TO TRY AGAIN AFTER TYPING " ? " AFTER ERROR.
DEVX <Device name>
CMERRX
MOVE A,B
DVCHR ;GET CHARACTERISTICS WORD
HLRE C,C
RET
;ROUTINE TO GET DIRECTORY INFORMATION
;ACCEPTS IN A/ DIRECTORY NUMBER
; B/ POINTER TO PASSWORD STRING (GETDRP ONLY)
; C/ ADDRESS OF BLOCK INTO WHICH TO READ INFO
;RETURNS +1: FAILED
; +2: OK
GETDIR::MOVEI B,0 ;NO PASSWORD GIVEN
GETDRP::STKVAR <GACTPR,DNOO,DRADR,SAVPP,DRPASP>
MOVEM A,DNOO ;REMEMBER DIRECTORY NUMBER
MOVEM C,DRADR ;SAVE ADDRESS OF DIRECTORY BLOCK
MOVEM B,DRPASP ;SAVE THE POINTER TO THE PASSWORD STRING
MOVEI A,EXTSIZ ;ALLOCATE BLOCK FOR PASSWORD
CALL GETBUF
HRLI A,440700 ;MAKE BYTE POINTER
MOVEM A,SAVPP ;REMEMBER POINTER TO PASSWORD BLOCK
MOVE A,DRADR ;GET ADDRESS OF BLOCK
CALL DIRINI ;INIT GROUP POINTERS AND GROUP BUFFERS
MOVE A,DRADR ;GET ADDRESS OF GTDIR BLOCK
MOVE A,.CDDAC(A) ;GET POINTER TO ACCOUNT BEFORE GTDIR BLOODY DESTROYS IT
MOVEM A,GACTPR ;REMEMBER POINTER TO ACCOUNT
MOVE A,SAVPP ;COPY PASSWORD INTO BLOCK FOR DIRECTORY
MOVE B,DRPASP ;COPY FROM GIVEN PASSWORD (OR 0!)
MOVEI C,0 ;STOP COPYING ON NULL CHARACTER
SOUT ;COPY THE PASSWORD
MOVE A,DNOO ;GET DIRECTORY NUMBER
MOVE B,DRADR ;GET ADDRESS OF BLOCK
MOVEI C,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM C,.CDLEN(B) ;IN FIRST WORD OF BUFFER
MOVE C,SAVPP ;WHERE TO PUT PASSWORD (POINTER RETURNED IN BUFFER)
GTDIR ;GET ALL THE INFO INTO THAT BLOCK
ERJMP R ;IF FAILED, RETURN NO-SKIP
MOVE A,GACTPR ;GET ORIGINAL ACCOUNT POINTER
MOVEM A,.CDDAC(B) ;MAKE POINTER TO BEGINNING OF ACCOUNT
RETSKP
;INITIALIZE BUFFER FOR GTDIR (ALSO FOR NEW DIR DEFAULTS)
;TAKES ADDRESS OF BLOCK IN A
;ALLOCATES AND INITIALIZES ALL THE SUBBLOCKS THAT GTDIR NEEDS (USER GROUPS,
;ACCOUNT, SUBDIRECTORY USER GROUPS ALLOWED)
DIRINI::STKVAR <BFA>
MOVEM A,BFA
SETZM (A)
HRL B,A
HRRI B,1(A)
BLT B,GTDLN-1(A)
MOVEI A,UGBUFL ;LENGTH OF USER GROUP BUFFER
CALL GETBUF ;GET SPACE FOR USER GROUPS
MOVE B,BFA ;GET ADDRESS OF DIR BLOCK
MOVEM A,.CDUGP(B) ;REMEMBER ADDRESS OF USER GROUP BUFFER
MOVEI B,UGBUFL ;LENGTH OF BUFFER
MOVEM B,(A)
MOVEI A,DGBUFL ;ALLOCATE DIRECTORY GROUP BUFFER IN SAME WAY
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDDGP(B)
MOVEI B,DGBUFL
MOVEM B,(A)
MOVEI A,SGBUFL ;GET BLOCK FOR ALLOWABLE USER GROUPS
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDCUG(B) ;STORE ADDRESS OF BLOCK FOR USER GROUPS
MOVEI B,SGBUFL
MOVEM B,(A) ;SET FIRST WORD OF SUBBLOCK TO COUNT
MOVEI A,EXTSIZ ;GET ROOM FOR ACCOUNT STRING
CALL GETBUF
MOVE B,BFA
HRLI A,440700 ;MAKE REAL BYTE POINTER TO ACCOUNT
MOVEM A,.CDDAC(B) ;STORE POINTER TO ACCOUNT BLOCK
SETZM (A) ;INITIALIZE ACCOUNT BUFFER
MOVEI A,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:
;
; o PASSWORD
; o USER GROUPS
; o DIRECTORY GROUPS
; o SUBDIRECTORY ALLOWABLE USER GROUPS
; o DEFAULT ACCOUNT STRING FOR LOGIN
;
;ACCEPTS:
; A/ ADDRESS OF DIRECTORY BLOCK
;RETURNS:
; +1 YES
RELDIR::SAVEAC <Q2,Q1> ;USE AN AC SO INDEXING CAN BE DONE
MOVE Q1,A ;PRESERVE ADDRESS OF DIRECTORY BLOCK
HRRZ Q2,(Q1) ;GET LENGTH OF BLOCK
MOVEI A,EXTSIZ ;SIZE OF PASSWORD BLOCK
CAILE Q2,.CDPSW ;PASSWORD POINTER GIVEN?
SKIPN B,.CDPSW(Q1) ;MAYBE, IS THERE ONE THERE?
CAIA ;NO
CALL RETBUF ;YES, RELEASE SPACE USED BY PASSWORD
MOVEI A,UGBUFL ;SIZE OF USER GROUP BLOCK
CAILE Q2,.CDUGP ;USER GROUP POINTER THERE?
SKIPN B,.CDUGP(Q1) ;YES, IS IT VALID?
CAIA ;NO
CALL RETBUF ;YES, RELEASE GROUPS STORAGE
MOVEI A,DGBUFL ;LENGTH OF DIRECTORY GROUP BUFFER
CAILE Q2,.CDDGP ;RELEASE DIRECTORY GROUP BLOCK
SKIPN B,.CDDGP(Q1)
CAIA
CALL RETBUF
MOVEI A,SGBUFL ;SIZE OF SUBDIRECTORY USER GROUP BUFFER
CAILE Q2,.CDCUG ;DO SUBDIRECTORY USER GROUPS
SKIPN B,.CDCUG(Q1)
CAIA
CALL RETBUF
MOVEI A,EXTSIZ ;PREPARE TO RELEASE ACCOUNT STRING STORAGE
CAILE Q2,.CDDAC ;ACCOUNT POINTER?
SKIPN B,.CDDAC(Q1)
CAIA
CALL RETBUF ;REMOVE ACCOUNT STRING STORAGE
RET
;DIRNAM
;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION.
;SKIP RETURNS WITH ENTIRE WORDS FROM RCDIR OR RCUSR IN A AND C ON SUCCESS.
; AND THE POINTER TO THE DIR/USER NAME STRING IN B.
;USED IN CONNECT, WHERE, ^EPRINT COMMANDS.
;PRESERVES Q1 (FOR DIRECTORY).
;CALL WITH F1 OFF FOR DEFAULTING TO LOGGED-IN USER NAME OR CURRENT
;CONNECTED DIRECTORY. CALL WITH F1 ON FOR NO DEFAULTING.
USRNMS::TLOA Z,F5 ;ALLOW WILDCARDING
USRNAM::TLZ Z,F5 ;NO WILDCARDING
STKVAR <<USRDEF,EXTSIZ>>
TLZ Z,F6 ;DO NOT RETURN IF AMBIGUOUS
TLZ Z,F4 ;NO DEFAULT
SKIPE CUSRNO ;NO DEFAULTING ALLOWED IF NOT LOGGED IN
TLNE Z,F1 ;DEFAULTING ALLOWED?
JRST NODDF1 ;NO
HRROI A,USRDEF ;GET ROOM FOR STRING
MOVEM A,CMDEF ;REMEMBER POINTER TO DEFAULT STRING
MOVNI A,1 ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVEI C,.JIUNO ;DEFAULT TO CURRENT USER
GETJI ;GET INTERNAL FORM OF DEFAULT
CALL JERR ;SHOULD NEVER FAIL
MOVE B,A ;PUT DEFAULT INTO B
MOVE A,CMDEF ;GET POINTER TO DEFAULT STRING AREA
DIRST ;MAKE DEFAULT STRING
JFCL
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>>
SKIPE CUSRNO ;NO DEFAULTING ALLOWED IF NOT LOGGED IN
TLNE Z,F1 ;DEFAULTING ALLOWED?
JRST NODDF ;NO
HRROI A,DIRDF ;GET BUFFER FOR DEFAULT
MOVEM A,CMDEF ;DEFAULT WANTED, SET UP POINTER
MOVNI A,1 ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVEI C,.JIDNO ;FIRST ASSUME DEFAULT TO CONNECTED DIRECTORY
TLNN Z,F4 ;DEFAULT TO LOGGED-IN?
MOVEI C,.JILNO ;YES, GET LOGGED-IN DIRECTORY NUMBER
GETJI ;GET INTERNAL FORM OF DEFAULT
CALL JERR ;SHOULD NEVER FAIL
MOVE B,A ;PUT DEFAULT INTO B
MOVE A,CMDEF ;GET POINTER TO DEFAULT STRING AREA
DIRST ;MAKE DEFAULT STRING
JFCL
NODDF: TLNE Z,F5 ;ALLOW WILDCARDING?
JRST [ DIRSX <Directory name>
RET ;FAILED
JRST DIRNA1] ;GOT ONE
DIRX <Directory name>
RET ;SINGLE RETURN ON FAILURE
DIRNA1: CALL BUFFF ;MAKE A COPY OF THE STRING
PUSH P,A ;SAVE THE POINTER TO THE STRING
MOVE B,A ;GET POINTER TO DIR NAME AGAIN
MOVX A,RC%EMO!RC%AWL ;EXACT MATCH AND ALLOW WILDCARDS
RCDIR ;GET INFO ON THIS DIRECTORY
ERJMP [POP P,(P)
RET] ;IF FAILS, NO SUCH DIR
POP P,B ;RETURN THE STRING POINTER IN B
TXNE A,RC%NOM!RC%AMB!RC%NMD
RET ;NONE FOUND
RETSKP ;TAKE SKIP RETURN ON SUCCESS
;ROUTINES TO STEP USER AND DIRECTORY NUMBERS WITH RCDIR
;ACCEPTS IN A/ DIR NUMBER
; B/ STRING POINTER TO WILDCARD STRING
; CALL STPDIR OR CALL STPUSR
;RETURNS +1: NO MORE
; +2: A/ NEW DIR NUMBER
STPDIR::SKIPA D,[RCDIR] ;STEP THE DIR NUMBER
STPUSR::MOVE D,[RCUSR] ;STEP THE USER NUMBER
STKVAR <STPSTP>
MOVEM B,STPSTP ;SAVE THE STRING POINTER
MOVE C,A ;GET DIR NUMBER INTO C
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
;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. ON CALL,
;A SHOULD CONTAIN THE POINTER TO THE HELP TEXT FOR THE FIELD, AND
;B SHOULD CONTAIN A POINTER TO THE HELP TEXT FOR THE NEXT FIELD. THIS
;IS NECESSARY BECAUSE AFTER THE FIRST NUMBER HAS BEEN READ, THE OPTIONS TO
;THE USER ARE ",," OR THE NEXT FIELD.
OCTCOM: STKVAR <HLP1,HLP2,OCTVL,<HLPTXT,40>>
MOVEM A,HLP1 ;SAVE THE HELP POINTERS
MOVEM B,HLP2
UOCT @HLP1 ;ASK FOR FIRST NUMBER WITH CALLER'S HELP
CMERRX
MOVEM B,OCTVL ;SAVE VALUE
CALL NESC ;TERMINATED WITH ESC?
JRST OCTDON ;YES--ASSUME DONE
TLC B,-1 ;ANY SIGNIFICANCE IN LH?
TLCE B,-1 ;SIGNIFICANCE IS OTHER THAN ALL 1S OR 0S
TLNN B,-1 ; TO ALLOW -M,,N
JRST OCTCO1 ;NO--TRY FOR A RIGHT HALF
JRST OCTDON ;YES--ASSUME NUMBER IS DONE
OCTCO1: HRROI A,HLPTXT ;BUILD COMBINED HELP MESSAGE
HRROI B,[ASCIZ /",," to separate left and right halves,
or /]
SETZ C,
SOUT ;COMBINE THEM
HRRO B,HLP2 ;TACK ON CALLER'S HELP TEXT
SOUT
SETZ B, ;TERMINATE IN ASCIZ FORMAT
IDPB B,A
MOVE A,[<ASCIZ /,/>+","];FAKE OUT CHARX
UCHAR HLPTXT ;LOOK FOR ",,"
JRST OCTDON
HRLZS OCTVL ;FIRST NUMBER WAS LEFT HALF
DEFX <0> ;DEFAULT RIGHT HALF TO 0
OCTX <Right half> ;ACCEPT RIGHT HALF OF NUMBER
CMERRX
TLC B,-1 ;ANY SIGNIFICANCE IN LH NOW IS AN ERROR
TLCE B,-1 ; BUT ALLOW M,,-N
TLNN B,-1
JRST OCTCO2 ;NO--STORE RESULT
ERROR <Right half exceeds 777777>
OCTCO2: HRRM B,OCTVL ;STORE REST OF NUMBER
OCTDON: MOVE A,OCTVL ;RETURN NUMBER TO USER
RET
;ROUTINE TO INPUT LIST OF OCTAL NUMBER RANGES IN THE FORM:
;N1,N2:N3,N4:N5,N6...
;"RLIST" STARTS WITH COUNT OF NUMBER OF NUMBERS, FOLLOWED BY THE
;NUMBERS THEMSELVES. NUMBERS ARE ALL TWO-WORD PAIRS SHOWING BEGINNING
;AND END OF RANGE. FOR INSTANCE, "N1,N2:N3,N4,N5:N6" WOULD GET
;STORED LIKE THIS:
;
; RLIST/ 8 ;8 NUMBERS ALTOGETHER (4 PAIRS)
; RLIST+1/N1
; RLIST+2/N1 ;NOTE THAT FIRST PAIR GOES FROM N1 TO N1!
; RLIST+3/N2
; RLIST+4/N3
; RLIST+5/N4
; RLIST+6/N4
; RLIST+7/N5
; RLIST+8/N6
;THIS ROUTINE RETURNS IF THE USER ENDS A RANGE WITH $. THIS IS NECESSARY
;TO ALLOW THE USER TO BE PROMPTED FOR THE NEXT FIELD.
OCTLST::SETZM RLIST ;START WITH 0 NUMBERS
OCTL2: OCTX <Octal number>
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>
CAIA ;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 FROM B, NO LEADING ZEROES OR SPACES.
TOCT: PUSH P,A
PUSH P,C
MOVE A,COJFN ;DESTINATION
MOVE C,[1B0+10] ;"MAGNITUDE" FLAG AND RADIX
NOUT
CALL JERRC ;GENERAL JSYS ERROR, CODE IN C
MOVEM A,COJFN ;SAVE IN CASE BYTE POINTER
POP P,C
POP P,A
RET
;TYPE SYSTEM DOWN TIME IF SET
DWNTYP::GJINF
JUMPN A,R ;NO TYPE IF ALREADY LOGGED IN
DWNPNT::MOVEI D,0 ;GET ITEM 0 FROM DWNTIM TABLE
GTB .DWNTI
JUMPE A,R ;DO NOTHING IF NOT SET
CAMN A,[-1] ;IS SYSTEM SHUTDOWN
JRST [ ETYPE < System is shutdown>
JRST DWNTY2] ;YES, SAY SO
ETYPE < System shutdown scheduled for %1W>
DWNTY2: MOVEI D,1 ;GET ITEM 1
GTB .DWNTI
JUMPE A,DWNTY1 ;JUMP IF UPTIME NOT SET
ETYPE <,
Up again at %1W>
DWNTY1: ETYPE<%_>
RET
;ROUTINE THAT TAKES SIXBIT IN A AND RETURNS A POINTER TO ASCII STRING
GETASC::STKVAR <REMSIX,ASCPR>
MOVEM A,REMSIX ;REMEMBER THE SIXBIT
MOVEI A,2 ;NEED TWO WORDS FOR ASCII
CALL GETBUF
HRLI A,440700 ;MAKE BYTE POINTER TO ASCII
MOVEM A,ASCPR ;REMEMBER POINTER TO ASCII
HRRI B,REMSIX
HRLI B,440600 ;GET SIXBIT POINTER
MOVEI D,0 ;NULL FOR CLEARING PROCESSED CHARACTERS
ASC1: SKIPN REMSIX ;ANY MORE LEFT?
JRST ASC2 ;NO
ILDB C,B ;YES, PICK UP NEXT CHARACTER
ADDI C,40 ;CHANGE TO ASCII
IDPB C,A ;STORE ASCII CHARACTER
DPB D,B ;CLEAR CHARACTER SO WE'LL KNOW WHEN WE'VE HIT END
TLNE B,770000 ;DONE SIX CHARACTERS?
JRST ASC1 ;NO, MIGHT BE MORE
ASC2: MOVEI C,0 ;GUARANTEE NULL AT END
IDPB C,A
MOVE A,ASCPR ;GET POINTER TO ASCII
RET ;RETURN POINTER
;ROUTINE TO RETURN SIXBIT VERSION OF LATEST FIELD IN A.
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 ASCII STRING POINTED TO BY
;POINTER IN A. SKIP RETURNS, UNLESS ILLEGAL SIXBIT CHARACTER ENCOUNTERED,
;OR STRING MORE THAN SIX CHARACTERS, IN WHICH CASE A WILL CONTAIN
;SIXBIT THROUGH THE LAST GOOD CHARACTER
GETSIX::STKVAR <ASPTR,SIXPTR>
CALL FIXPT ;FIX POINTER
MOVEM A,ASPTR ;REMEMBER ASCII POINTER
MOVE A,[440600,,A] ;POINTER TO SIXBIT RESULT
MOVEM A,SIXPTR
MOVEI A,0 ;START WITH NULL RESULT
MOVSI B,-6 ;DO SIX CHARS MAXIMUM
GETSX1: ILDB C,ASPTR ;GET NEXT ASCII CHARACTER
JUMPE C,RSKP ;DONE IF NULL
CAIN C,"" ;THE QUOTING CHARACTER?
JRST [ ILDB C,ASPTR ;YES, ALLOW NEXT CHARACTER REGARDLESS
JRST .+1]
CAIL C,141 ;CHANGE LOWERCASE LETTERS TO UPPERCASE
CAILE C,172
CAIA ;NOT LOWERCASE
TRZ C,40 ;LOWERCASE, CHANGE IT
SUBI C,40 ;CHANGE TO SIXBIT
JUMPL C,R ;IF ILLEGAL CHARACTER, GIVE NON-SKIP
IDPB C,SIXPTR ;STORE IN SIXBIT RESULT IN A
AOBJN B,GETSX1 ;ONLY DO SIX CHARACTERS
ILDB C,ASPTR ;GET CHARACTER AFTER SIXTH
JUMPE C,RSKP ;IF NULL, STRING ENDED "JUST IN THE NICK OF TIME"
RET ;NON-SKIP IF STRING TOO LONG
;ROUTINE TO CHANGE -1,,FOO TO 440700,,FOO
FIXPT:: TLC A,-1 ;IF WAS -1, IS NOW 0 (IF OTHER, IS NOW OTHER')
TLCN A,-1 ;SKIP AND RESTORE IF WASN'T -1
HRLI A,440700 ;CHANGE TO 440700 IF WAS -1
RET
;BUFFF
;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND
; RETURN A BYTE PTR TO IT IN A.
;COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END.
BUFFF: PUSH P,B
PUSH P,C
PUSH P,D
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. GIVE IT POINTER TO STRING IN A.
;ROUTINE RETURNS POINTER TO BUFFERED STRING IN A.
;THE STRING ALWAYS BEGINS ON A WORD BOUNDARY. (SOME CALLERS ASSUME SO!)
;XBUFFS USES PERMANENT STORAGE, BUFFS USES TEMPORARY STORAGE
XBUFFS::SKIPA B,[XDICT] ;SPECIFY PERMANENT FREE POOL
BUFFS:: MOVEI B,DICT ;TEMPORARY POOL
CALL READNM ;COPY STRING INTO FREE SPACE
ERROR <String space exhausted>
RET
;ROUTINE TAKING A STRING POINTER IN A. IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A. IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
;GIVE IT FREE POOL HEADER ADDRESS IN B
READNM: STKVAR <FPA,RPTR,NEWPTR>
MOVEM A,RPTR ;REMEMBER POINTER
MOVEM B,FPA ;REMEMBER FREE POOL ADDRESS
CALL BCOUNT ;HOW MANY WORDS IN THIS STRING?
MOVE B,FPA ;SAY WHICH FREE POOL TO USE
CALL GETMEM ;GET THAT MANY
RET ;COULDN'T, SO TAKE NON-SKIP RETURN
HRLI B,440700 ;MAKE BYTE POINTER TO SPACE OBTAINED
MOVEM B,NEWPTR ;REMEMBER NEW POINTER
MOVE A,B
MOVE B,RPTR ;GET POINTER TO STRING
MOVEI C,0 ;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. RETURNS +1 ALWAYS WITH ADDRESS OF BLOCK
;IN A. GIVE IT NUMBER OF WORDS DESIRED IN A.
GTBUFX::SKIPA B,[XDICT] ;PERMANENT STORAGE
GETBUF::MOVEI B,DICT ;USE TEMPORARY POOL
CALL GETMEM ;GET THE MEMORY
ERROR <Exec free space exhausted>
MOVE A,B ;RETURN ADDRESS IN A
RET
;GETMEM - ROUTINE TO ASSIGN MEMORY AS REQUESTED
;INPUTS: A - CONTAINS NUMBER OF WORDS WANTED
; B - FREE SPACE HEADER ADDRESS
;OUTPUTS: A - NUMBER OF WORDS OBTAINED
; B - CONTAINS ADDRESS OF WORDS GOTTEN
;RETURNS: SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM
GETMEM::STKVAR <<SAVSTF,2>,DADR>
MOVEM B,DADR ;REMEMBER HEADER ADDRESS
GETM2: MOVE C,B ;REMEMBER WHO POINTS TO CURRENT
HRRZ B,0(C) ;B IS NOW CURRENT BLOCK
JUMPE B,R ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ D,0(B) ;GET SIZE OF CURRENT BLOCK
CAMGE D,A ;IS IT SUFFICIENT FOR REQUEST?
JRST GETM2 ;NO, SO TRY NEXT BLOCK
GETM3: CALL PIOFF ;TURN OFF CTRL/C INTERRUPTS
HRL B,0(B) ;GET LINK OF CURRENT BLOCK
HLRM B,0(C) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZS B ;ISOLATE CURRENT BLOCKS ADDRESS
CAMN D,A ;IS THIS AN EXACT MATCH ON SIZE?
JRST GETRSK ;SUCCESS, SKIP RETURN
DMOVEM A,SAVSTF ;SAVE NUMBER OF WORDS AND ADDRESS
ADD B,A ;GET FIRST WORD TO RETURN
SUBM D,A ;NUMBER OF WORDS TO RETURN
MOVE C,DADR ;GET ADDRESS OF CONTROL WORD
CALL RETMEM ;RETURN THE EXTRA WORDS
DMOVE A,SAVSTF ;RESTORE NUMBER OF WORDS AND ADDRESS
GETRSK: CALL PION ;TURN CTRL/C INTERRUPTS BACK ON
RETSKP ;SUCCESS, SKIP RETURN
;STREM ROUTINE TAKES POINTER TO STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE. THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE
STREM:: ATSAVE ;NEED TO BE TRANSPARENT
STKVAR <SPT000>
MOVEM A,SPT000 ;REMEMBER POINTER
CALL BCOUNT ;COUNT NUMBER OF WORDS IN THE STRING
HRRZ B,SPT000 ;GET RID OF BYTE POINTER P AND S
CALLRET RETBUF ;RETURN THE BUFFER
;RETBUF RETURNS A BUFFER TO FREE STORAGE
; A/ SIZE BEING RETURNED
; B/ ADDRESS OF BLOCK BEING RETURNED
RETBUF::MOVEI C,DICT ;FIRST ASSUME TEMPORARY FREE SPACE
CAIL B,XFREE ;MAYBE ADDRESS IS IN PERMANENT FREE SPACE
CAIL B,XFREE+XFRESZ
JRST RETMEM
MOVEI C,XDICT ;YES
; CALLRET RETMEM ;RETURN THE SPACE TO THE FREE POOL
;RETMEM - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
;INPUT: A - CONTAINS SIZE OF BLOCK TO RETURN
; B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
; C - FREE SPACE HEADER ADDRESS
;OUTPUT: NONE
;RETURNS: ALWAYS CPOPJ
RETMEM::HRRZ D,0(C) ;GET PREV'S LINK
SKIPE D ;IF CURRENT IS 0 OR
CAIL D,0(B) ; ITS ADDRESS IS PAST ADDR OF RETURN BLK
JRST RETM4 ;THEN RETURN BLOCK HERE
MOVE C,D ;MAKE PREV=CURRENT
JRST RETMEM ;CONTINUE
RETM4: CALL PIOFF ;TURN OFF CTRL/C INTERRUPTS
HRRM D,0(B) ;FORWARD PTR OF RETURNED BLOCK
HRRM B,0(C) ;FORWARD PTR OF PREV BLOCK
HRLM A,0(B) ;STORE SIZE OF THIS BLOCK
ADD A,B ;ADD ADDR+SIZE
CAIE A,0(D) ;ARE WE RIGHT UP AGAINST NEXT BLOCK?
JRST RETM5 ;NO, CANT COMBINE
HRRZ A,0(D) ;GET NEXT GUYS FORWARD LINK
HRRM A,0(B) ;MAKE IT OURS. IE POINT PAST HIM
HLRZ A,0(B) ;GET OUR SIZE
HLRZ D,0(D) ;GET HIS SIZE
ADD A,D ;GET OUR NEW COMBINED SIZE
HRLM A,0(B) ;STORE INTO RETURNED BLOCK
HRRZ D,0(B) ;GET LINK OF CURRENT BLOCK
RETM5: HLRZ A,0(C) ;GET PREV BLOCKS SIZE
ADDI A,0(C) ;ADD HIS ADDRESS AND SIZE
CAIE A,0(B) ;DOES HE BUTT RIGHT UP AGAINST US?
CALLRE PION ;NO, RETURN WITH NO COMBINATION
HRRM D,0(C) ;MAKE PREV POINT TO OUR NEXT
HLRZ A,0(C) ;GET HIS SIZE
HLRZ B,0(B) ;AND OUR SIZE
ADD A,B ;COMBINE THE SIZES
HRLM A,0(C) ;STORE COMBINED SIZE
CALLRE PION ;RETURN
;ROUTINE TO INITIALIZE FREE SPACE STORAGE. DONE BEFORE EACH COMMAND IS
;EXECUTED.
FREINI::SETZM DICT ;INITIALIZE FREE SPACE SYSTEM
MOVEI A,FRESIZ ;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
MOVEI B,FREE ;STARTS AT ADDRESS IN B
CALL RETBUF ;FREE IT UP IN STANDARD WAY
MOVEI A,STRSIZ ;ALLOCATE SOME SPACE FOR STRINGS
CALL GETBUF
HRLI A,440700 ;MAKE POINTER TO STRING STORAGE
MOVEM A,CSBUFP ;REMEMBER POINTER TO STRING STORAGE
RET
;ROUTINE TO INITIALIZE PERMANENT FREE SPACE. THIS IS DONE ONCE PER RUNNING
;OF THE EXEC
XFRINI::SETZM XDICT
HRROI A,-1 ;RELEASE PERMANENT FREE SPACE
MOVE B,[.FHSLF,,XFREPN] ;TO GUARANTEE THAT RETBUF CAN WRITE INTO IT
MOVX C,PM%CNT!XFREPZ ;(IF SYMBOL TABLE WAS MAPPED, RETBUF COULD FAIL)
PMAP
MOVEI A,XFRESZ
MOVEI B,XFREE
CALLRET RETBUF ;RETURN ALL PERMANENT FREE SPACE TO POOL
;BCOUNT MEASURES AN ASCIZ STRING.
;
;ACCEPTS: A/ POINTER (-1,,FOO O.K.!)
;
;RETURNS+1: A/ NUMBER OF WORDS NEEDED IN A
; B/ NUMBER OF CHARACTERS
BCOUNT::CALL FIXPT ;CHANGE -1 TO 440700
MOVEI B,0 ;B WILL ACCUMULATE COUNT OF BYTES
BC1: ILDB C,A ;READ NEXT BYTE
CAIE C,0 ;DONE COUNTING IF NULL SEEN
AOJA B,BC1 ;NOT DONE, KEEP COUNTING
MOVE D,B ;REMEMBER EXACT COUNT IN D
AOJ B, ;LEAVE ROOM FOR NULL
IDIVI B,5 ;GET NUMBER OF WORDS
CAIE C,0 ;EXTRA CHARACTERS?
AOJ B, ;YES, THEY TAKE A WHOLE WORD
MOVE A,B
MOVE B,D ;RETURN BYTE COUNT IN B
RET
;ROUTINE TO RETURN HOST'S NODE NAME. RETURNS A POINTER TO IT IN A.
;THIS RETURN SKIPS IFF SUCCESSFUL
GETNOD::MOVEI A,.NDGLN ;SAY WE WANT HOST'S NODE NAME
MOVEI B,CSBUFP ;USE POINTER TO STRING SPACE TO WRITE THE NAME
MOVE C,CSBUFP ;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)
MOVEI C,0 ;SAY NO ECHOING NOHOW
JRST ECHOST ;JOIN "DOECHO"
;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT
DOECHO: TXNN Z,NECHOF ;WAS ECHOING OFF?
RET ;NO, SO NOTHING TO DO
PUSH P,C
MOVEI C,2 ;SAY IMMEDIATE OR DEFERRED ECHOING
ECHOST: PUSH P,A ;ENTRY TO SET ECHO BITS FROM C
PUSH P,B
MOVE A,CIJFN
RFMOD ;READ TELETYPE MODE WORD
DPB C,[POINT 2,B,25]
SFMOD ;SET TTY MODE WORD
CAIN C,2 ;ECHOING NOW ON?
TXZ Z,NECHOF ;SAY ECHOING NOT SUPPRESSED
POP P,B
POP P,A
POP P,C
RET
;LTTYMD - LOAD TELETYPE MODES
;AC Q1 POINTS TO 11-WORD BLOCK OF VALUES TO PUT INTO EFFECT:
;SEE EXECDE FOR STRUCTURE OF BLOCK
UTTYMD::PUSH P,A ;SAVE REG
SKIPLE A,FORK ;USER CURRENT FORK
CALL FTTYMD ;IF VALID
POP P,A ;RESTORE REG
RET ;RETURN
FTTYMD::SKIPN Q1,SLFTAB(A) ;SET UP MODE BLOCK PNTR
RET
MOVEI Q1,.FKPTM(Q1) ;ADDRS OF FORK'S MODE BLOCK
LTTYMD: SKIPN (Q1) ;DO NOTHING IF BLOCK IS 0 DUE TO A BUG OR
RET ;A STRANGE INTERRUPT-RESTART SEQUENCE
ATSAVE
MOVEI A,.CTTRM
MOVE B,TTWMOD(Q1) ;FILE MODE WORD
TXZ B,TT%OSP ;ENSURE NO OUTPUT SUPPRESS
SFMOD
DVCHR ;MTOPR WORKS ON TTY ONLY
LDB B,[POINTR B,DV%TYP] ;GET DEVICE TYPE CODE
CAIE B,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY1 ;NO - NOT A TTY
MOVEI A,.CTTRM ;NOW RESTORE THE MASK
MOVEI B,.MOSBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY1 ;ERROR MEANS WRONG MONITOR
MOVEI B,.MOSFW ;NOW FOR THE FIELD WIDTH
MOVE C,TTWFWT(Q1)
MTOPR
MOVEI A,.CTTRM
NOTTY1: MOVE B,TTWCOC(Q1) ;2 CCOC WORDS
MOVE C,TTWCOC+1(Q1)
SFCOC
MOVEI A,.FHSLF
RPCAP
TXON C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
JRST [ TXNN B,SC%CTC ;^C NOT ENABLED. ENABLABLE?
JRST NOSTIW ;NO, DON'T TRY THE STIW
EPCAP ;ENABLABLE, SO DO IT
JRST .+1] ;NOTE: LOGIN JSYS CLEARS AC3 CAPABILITIES!
MOVEI A,.FHJOB
MOVE B,TTWJTI(Q1) ;SET JOB TIW
STIW
NOSTIW: MOVE A,TTWSNM(Q1) ;GET SUBSYS NAME
MOVE B,TTWPNM(Q1) ;GET PROGRAM NAME
SETSN ;SET THEM
CALL JERR
RET
;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC
; INTO 6-WORD BLOCK THAT AC Q1 POINTS TO.
RFTYMD::SKIPN Q1,SLFTAB(A) ;SET UP MODE BLOCK PNTR
RET
MOVEI Q1,.FKPTM(Q1) ;MODES FOR FORK
RTTYMD: ATSAVE
MOVEI A,.CTTRM
RFMOD
MOVEM B,TTWMOD(Q1)
DVCHR ;MTOPR WORKS ON TTY ONLY
LDB B,[POINTR B,DV%TYP] ;GET DEVICE TYPE CODE
CAIE B,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY2 ;NO - NOT A TTY
MOVEI A,4 ;PUT LENGTH INTO BLOCK
MOVEM A,TTWMSK(Q1)
MOVEI A,.CTTRM ;NOW SAVE THE MASK
MOVEI B,.MORBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY2 ;ERROR MEANS WRONG MONITOR
MOVEI B,.MORFW ;NOW FOR THE FIELD WIDTH
MTOPR
MOVEM C,TTWFWT(Q1)
MOVEI B,.MOSFW
SETZ C, ;TURN OFF FIELD WIDTH
MTOPR
NOTTY2: MOVEI A,.CTTRM
RFCOC
MOVEM B,TTWCOC(Q1)
MOVEM C,TTWCOC+1(Q1)
MOVEI A,.FHJOB
RTIW
MOVEM B,TTWJTI(Q1)
SETO A, ;SAY THIS JOB
MOVE B,[-2,,C] ;SAY 2 WORDS INTO C AND D
MOVEI C,.JISNM ;STARTING WITH SUBSYS NAME
GETJI ;GET SUBSYS AND PROGRAM NAME
CALL JERR
MOVEM C,TTWSNM(Q1) ;SAVE THEM
MOVEM D,TTWPNM(Q1)
RET
;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS
;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT.
;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE;
;TO CHANGE IT USER MUST: A) USE A PROGRAM, SUCH AS DDT, OR B) TEMP SET
; OUTFILE=INFILE (IF PSEUDO-ECHOING DOESN'T INTERFERE). 4/22/70.
;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS
%PRINT: PUSH P,A
PUSH P,B
AOS TTYACF ;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE
MOVE A,COJFN
HRRZ B,40
BOUT
MOVEM A,COJFN ;IN CASE IT'S A BYTE POINTER
AOS TTYACF ;AGAIN IN CASE BLOCKED DUE TO FULL BUFFER
POP P,B
POP P,A
RET
;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?)
COUTC:: PUSH P,A
MOVE A,COJFN ;GET OUTPUT STREAM
TLNE A,-1 ;BYTE POINTER?
JRST [ IDPB B,COJFN ;YES, SAVE TIME TO OPTIMIZE ETYPE
JRST COUTC1]
AOS TTYACF ;TELL AUTOLOGOUT THAT THERE'S BEEN TTY ACTIVITY
BOUT ;MONITOR CALL TO OUTPUT CHARACTER
AOS TTYACF
COUTC1: POP P,A
RET
;TBOUT, TSOUT0 -- USED INSTEAD OF BOUT AND SOUT WHERE TEXT
;MAY CONTAIN EOL'S.
TBOUT:: BOUT ;(ACH - SOMEBODY WANT TO TELL ME WHY THIS
RET ; IS BETTER THAN A BOUT IN THE CODE?)
;SOUT WHERE C=0, I.E. TERMINATE ON NULL
TSOUT0::PUSH P,C
SETZ C,
SOUT
POP P,C
RET
REPEAT 0,<
TSOUT0::PUSH P,C ;SAVE AN AC
MOVE C,B ;PUT THE POINTER IN THAT AC
TLC C,-1 ;CHANGE -1 LEFT HALF TO A POINTER
TLCN C,-1
HRLI C,440700
TSOUT1: ILDB B,C ;GET THE NEXT CHARACTER
JUMPE B,TSOUTE ;NULL TERMINATES, RESTORE UPDATED PTR
BOUT ;ELSE OUTPUT THE CHARACTER AND LOOP
JRST TSOUT1
TSOUTE: MOVE B,C
POP P,C
RET
>
;RANDOM reads a word from the current fork.
;
;Accepts: A/ address to read
;
;Returns+1: Nonexistent or unreadable
; +2: A/ contents
RANDOM::STKVAR <WAA>
MOVEM A,WAA ;REMEMBER ADDRESS
CALL MAPPF ;MAP IN THE PAGE
RET ;FAILED, SAY SO.
LDB A,[001100,,WAA] ;GET OFFSET INTO BUFFER
MOVE A,PAGEN(A) ;GET THE DATA
ERJMP R ;IF CAN'T, GIVE FAILURE RETURN
RETSKP ;GIVE SUCCESS RETURN WITH DATA IN A
;MAP A PAGE OF A FORK
;Accepts in A: A 30-bit address in the fork, or -1 to clear the buffer
; FORK: Fork handle
;Returns:
; +1: Cannot map process (last error says why)
; +2: Success,
; A: Untouched
; B: Access and existence bits (from RPACS), unless A had -1
; PAGEN: The page mapped
MAPPF: PUSH P,C
PUSH P,A
JUMPL A,MPPF1
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
TLO A,(1B0) ;SAY FORK HANDLE NOT JFN
MPPF1: MOVEI B,PAGEN ;GENERATE DESTINATION PAGE IDENTIFIER
LSH B,-^D9 ;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL
TLO B,(1B0) ;...SAY THIS FORK
MOVX C,PM%RD!PM%WR!PM%EX ;REQUEST ALL ACCESS, NORMAL DISPOSAL
CAME A,NPAGE ;SAVE TIME IF ALREADY MAPPED
PMAP ;MAP IT
ERJMP 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
SKIPN B ;ANY BITS?
TXO B,PA%WT ;NO - SET WRITE ACCESS (NEW PAGE)
JRST MPPF8 ;RESTORE AND RETURN +2
;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS".
;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION.
MAPACS: SETO A,
CALL MAPPF ;UNMAP PAGE IN BUFFER, IF ANY.
JFCL ;UNMAP SHOULDN'T FAIL
MOVE A,FORK
MOVEI B,PAGEN
RFACS ;READ FORK ACS INTO "PAGEN"
ERJMP MAPPFF ;FAILED-- RESTORE ACS AND RETURN +1
MOVX B,PM%RD!PM%WR!PM%EX!PM%PLD ;REQUEST ALL ACCESS, NORMAL DISPOSAL
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, GIVEN ADDRESS IN A
LOADF: CALL MAPPF
RET ;FAILED-- RETURN +1
TXNN B,PA%PEX
ERROR <No such page>
TXNN B,PA%RD
ERROR <Can't read that page>
ANDI A,777
MOVE A,PAGEN(A)
RETSKP ;RETURN +2 FROM LOADF
;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A
STOREF: PUSH P,B ;SAVE WORD TO STORE OVER MAPPF
CALL MAPPF
JRST [ POP P,B
RET] ;FAILED-- RETURN +1
TXNE B,PA%PEX ;OK TO STORE IF PAGE NON-EXISTENT
TXNE B,PA%WT!PA%CPY ;OR IF WRITE ACCESS OR COPY ON WRITE PERMITTED
CAIA
ERROR <Can't write into page>
ANDI A,777
POP P,B ;GET BACK VALUE TO STORE
MOVEM B,PAGEN(A)
RETSKP
;%GTB
;UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN C(Q1), INDEX IN RH OF D, ONE RETURN WITH WORD IN A.
;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
; FOR USE IN OTHER JSYS CALLS INSIDE LOOP.
%GTB: HRL A,D
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
MOVEI A,.PRIOU ;ALWAYS DISPLAY OUTPUT TO PRIMARY,
MOVEM A,COJFN ;SINCE THAT'S WHERE ^T WAS TYPED FROM.
ETYPE < %A> ;START WITH CURRENT TIME
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
;**;[737] Insert 2 lines at USEX:+21L KR 2-JUN-82
SKIPN B,SLFTAB(A) ;[737]LOAD B WITH FORK TABLE INDEX
JRST USEPS0 ;[737]IF 0,WE DON'T KNOW THIS PROG
;**;[734] Replace 4 lines with 3 at USEX:+21L KR 12-MAY-1982
GETNM ;[734]
;**;[737] Insert 2 lines at USEX:+22L KR 2-JUN-82
CAMN A,['EXEC '] ;[737]IS CURRENT PROG NAME EXEC?
MOVE A,.FKPTM+TTWPNM(B) ;[737]YES, GET LAST RUN PROG'S NAME
ETYPE < %1'> ;[734]NO, JUST TYPE WHAT GETNM FOUND
MOVE A,FORK ;[734]
USEPS0: TYPE < > ;SEPARATE NAME AND STATUS
CALL FSTAT ;PRINT STATUS & PC OF INFERIOR (HANDLE IN A)
PRINT " " ;FSTAT IS IN EXECIN.MAC
USEPS2: HRROI A,-1 ;GET LOAD AVERAGES FOR CURRENT JOB
CALL GLOADS ;GET LOAD AVERAGES
ETYPE < Used %V in %C, Load %2Q>
MIC,< CALL GETPAG ;MIC EXISTS?
JRST USEOU1 ;NO
TYPE < (DO in progress)>
>
USEOU1: TYPE <
>
MOVE A,SAV40
MOVEM A,40
MOVE A,CIJFN0
MOVEM A,CIJFN
MOVE B,COJFN0
MOVEM B,COJFN ;RESTORE POSSIBLE BUFFERED OUTPUT
RET
;IF ^T DURING COMMAND EXECUTION, TELL USER WHAT COMMAND IS BEING
;EXECUTED.
USEPS9: MOVE B,COMAND ;GET POINTER TO COMMAND
SKIPE PCCURC ;PCL During PCL execution?
JRST [ SKIPN B ;PCL Yes, is the command name gone?
HRROI B,[ASCIZ/Stored/] ;PCL Yes, use generic name
JRST .+1] ;PCL
ETYPE < %2M command >
JRST USEPS2 ;JOIN COMMON CODE
CERR: CMERRX ;CATCH-ALL COMMAND ERROR
;ROUTINE TO HANDLE CMERRX MACRO CALL.
CMERR$: STKVAR <MP,SEP2,ATMP,SAVBLK>
MOVEI A,SBLKLN ;SAVE STATE BLOCK SO ERROR HANDLING DOESN'T RUIN ^H
CALL GETBUF ;GET ROOM TO SAVE IT
MOVEM A,SAVBLK ;REMEMBER WHERE BLOCK IS
HRLI A,SBLOCK ;MAKE BLT POINTER
MOVEI B,SBLKLN-1(A) ;GET LAST ADDRESS TO BE SAVED INTO
BLT A,(B) ;SAVE STATE BLOCK
SETZM SEP2 ;NO SECOND SEPARATOR YET
SETZM ATMP ;NO ATOM TO PRINT YET
HRROI A,@40 ;GET POINTER TO MESSAGE
MOVEM A,MP ;REMEMBER POINTER TO MESSAGE
MOVE D,[440700,,ATMBUF] ;FIRST TRY TO USE ATOM BUFFER
MOVE B,D ;SEE IF ANYTHING IN IT
ILDB B,B
JUMPN B,CMERR1 ;IF SO, NO NEED TO SLURP COMMAND BUFFER UP.
SKIPN CMCNT ;ROOM FOR ONE MORE CHARACTER?
JRST CMERR2 ;NO, FORGET IT
MOVE A,CMINC ;GET NUMBER OF UNPARSED CHARACTERS
ADJBP A,CMPTR ;GET POINTER TO END OF BUFFER
MOVEI B,.CHLFD ;USE LINEFEED TO PREVENT COMND FROM GOING INTO I/O WAIT
IDPB B,A ;PUT LINEFEED IN BUFFER
SOS CMCNT ;REMEMBER THERE'S ROOM FOR ONE LESS CHARACTER
AOS CMINC ;REMEMBER THERE'S ONE MORE UNPARSED CHARACTER
MOVEI B,[FLDDB. .CMTXT] ;READ REST OF LINE INTO ATOM BUFFER
CALL FLDSKP
JRST CMERR2 ;IF THAT FAILS, HANG IT UP.
MOVE D,[440700,,ATMBUF] ;POINT TO STRING WHICH IS REST OF LINE
MOVE B,D ;GET COPY OF POINTER
ILDB B,B ;SEE IF THERE'S ANYTHING ON LINE
JUMPE B,CMERR2 ;IF NOT, DON'T ATTEMPT TO PRINT MORE OF STRING
CMERR1: HRROI B,[ASCIZ / - "/] ;GET SECOND SEPARATOR
MOVEM B,SEP2
MOVE A,CSBUFP ;PREPARE TO BUILD STRING WITH ATOM AND CLOSE QUOTE
MOVE B,D ;POINT TO ATOM
MOVEI C,.CHNUL ;STOP ON NUL
SOUT ;PUT ATOM IN STRING
HRROI B,[ASCIZ /"/] ;CLOSE QUOTE AND PUT IN NULL
SOUT
MOVE A,CSBUFP ;POINT TO ENTIRE STRING
CALL BUFFS ;ISOLATE THE STRING
MOVEM A,ATMP ;SAVE POINTER TO ATOM BUFFER
CMERR2: HRL A,SAVBLK ;RESTORE STATE BLOCK SO ^H WORKS
HRRI A,SBLOCK
BLT A,SBLOCK+SBLKLN-1
HRROI B,[ASCIZ / - /] ;FIRST ASSUME MESSAGE HAS TWO PARTS
MOVE A,MP ;GET MESSAGE POINTER
SKIPN (A) ;IS CALLER SUPPLYING SPECIFIC STRING?
HRROI B,[0] ;NO, SO NO SEPARATOR NEEDED BETWEEN STRINGS
MOVE C,SEP2 ;GET POSSIBLE SECOND SEPARATOR
MOVE D,ATMP ;GET POSSIBLE ATOM POINTER
ERROR <%1M%%2M%%?%%3M%%4M> ;USER, SEPARATOR, MONITOR, SEPARATOR, ATOM
;NOT IMPLEMENTED YET ERROR
;DISPATCH TO HERE AUTOMATICALLY SUPPLIED BY COMMAND TABLE ENTRY MACRO
; IF NO ROUTINE IS DEFINED FOR THE COMMAND.
NIM:
NIYE: ERROR <Not implemented yet>
;INTERNAL ERROR
SCREWUP:HRRZ Q1,(P) ;PC (GET HERE WITH PUSHJ)
SUBI Q1,1
ERROR <Internal error at %5P>
;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1.
;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT.
;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS
; BEFORE COMING TO THIS GENERAL ROUTINE.
;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR"
; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE
; JSYS'S. 6/26/70.
JERR: MOVEM A,ERCOD ;SAVE ERROR NUMBER
JERR1: CALL ERFRST ;GET SET TO TYPE MSG
CALL CRIF ;EOL UNLESS AT LEFT
HRRZ Q2,(P) ;PC (GOT TO JERR WITH PUSHJ)
SUBI Q2,2 ;PROBABLE LOC OF JSYS
CALL PIOFF ;DON'T ALLOW ^C WHILE FORK IS AMOK
MOVEI A,.FHSLF ;USE OUR SYMBOL TABLE FOR MESSAGE
EXCH A,FORK
ETYPE <JSYS error at %6Y>
EXCH A,FORK ;RESTORE FORK CELL
CALL PION ;ALLOW INTERRUPTS AGAIN
CALL SYSERA ;GO TYPE SYSTEM ERROR MESSAGE
JRST ERRFIN ;FINISH
JERRC: MOVEM C,ERCOD ;"JERR" FOR ERROR CODE IN C
JRST JERR1 ; (AS AFTER "NOUT")
;ROUTINES FOR USE WITH ERJMP AND ERCAL JSYS RETURNS
;GET ERROR CODE FROM SYSTEM AND STORE IN ERCOD
;THEN CALL REGULAR ERROR PRINT
JERRE:: CALL %GETER
JRST JERR1
CJERRE::CALL %GETER
JRST CJERR1
;ERROR RETURN FROM JSYS WHERE ERROR MESSAGE FROM JSYS SHOULD BE
;MEANINGFUL TO USER
CJERR:: MOVEM A,ERCOD
CJERR1: CALL ERFRST ;INIT ERROR STUFF
CALL SYSERA ;PRINT JSYS MSG ONLY
JRST ERRFIN ;FINISH
;ROUTINE TO PRINT WARNING ABOUT FAILING JSYS.
;PUT "JWARN" AFTER ANY JSYS THAT ISN'T EXPECTED TO FAIL, BUT FOR WHICH
;YOU DON'T REALLY CARE IF IT DOES, EXCEPT THAT YOU WANT THE USER TO KNOW
;WHY.
RJWARN::ETYPE <%_%%%Unexpected error: %?%%_%%% proceeding...%_>
RET ;RETURN TO CALLER
;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE
;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING
;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT.
;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN EXEC",
; TYPE SYSTEM ERROR MESSAGE WITH
; REGULAR ROUTINE, AND RETURN TO COMMAND INPUT.
%TRAP: PUSH P,D
PUSH P,Q1
MOVE Q1,@40 ;GET LEVEL
CAILE Q1,0
CAILE Q1,3 ;LEGAL LEVEL?
SKIPA Q1,[0,,-1] ;NO, GIVE -1
HRRZ Q1,PCTAB(Q1) ;YES, GET PC
CALL ICLEAR ;CLEAR THIS INTERRUPT
MOVEI D,RERET ;CHANGE ERROR ROUTINE RETURN
MOVEM D,CERET ;...TO "REGULAR"
SETZM .JBUFP ;SAY FLUSH ALL JFNS
;HERE WE MUST CHECK FOR EOF IN COMMAND FILE AND HANDLE SPECIALLY.
;ALSO I'M SURE MANY OTHER EXECEPTIONAL CASES WILL TURN UP.
MOVE D,40 ;SAVE TEXT ADDRESS
CALL ERFRST ;DO THINGS NEEDED BEFORE TYPING MESSAGE
CALL CRIF ;EOL IF CARRIAGE NOT AT LEFT MARGIN
UTYPE 1(D) ;TYPE CHANNEL-SPECIFIC MESSAGE
ETYPE < internal trap at %5P>
POP P,Q1
POP P,D
PUSH P,[ERRFIN] ;WHERE TO GO AFTER ERROR MESSAGE PRINTING
PUSH P,[U$ERR] ;NO MESSAGE
JRST ERR1 ;GO FINISH ERROR PROCESSING
;NOTE: EXCEPT FOR ^O, THERE ARE NO INTERRUPTS WHICH DEBREAK TO THE POINT
;OF INTERRUPTION. HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET"
;BEING CHANGED. BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO
;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED.
;PDL OVERFLOW. THIS ROUTINE MUST FIRST CLEAR THE STACK BEFORE IT
;CAN CALL ANYTHING ELSE!
PDLOV:: XCT INISTK ;CLEAR THE STACK
TRAP LV.POV,<Pushdown overflow>
;ILLEGAL INSTRUCTION PSI
;GO TO SPECIAL CASE ROUTINE ILIDSP POINTS TO, IF NON-0,ELSE
;TREAT LIKE OTHER ERROR PSI'S.
;ILIDSP USED, FOR INSTANCE, TO DETECT "LIST ACCESS NOT ALLOWED" FROM
; GTFDB JSYS.
;SPECIAL ROUTINE GETS ERROR CODE IN ERCOD.
;IF SPECIAL ROUTINE ISN'T INTERESTED IN THIS PARTICULAR ERROR,
; IT CAN JRST TO ILIPSI AGAIN.
ILIPSI: MOVE A,[CALL CUUO] ;RESET UUO DISPATCH TO PROTECT
MOVEM A,41 ;IT FROM MALICIOUS USERS (AND IF TRASHED)
SKIPE ILIDSP ;IS THERE A SPECIAL DISPATCH?
JRST ILIDO ;YES, DO IT
STKVAR <ILCOD>
CALL DGETER ;SEE WHY FAILED
MOVEM A,ILCOD ;REMEMBER
CALL ICLEAR ;CLEAR INTERRUPT
HRRZ A,LV.ILI+PCTAB ;GET PC OF ERROR
MOVE B,ILCOD ;PRINT REASON
ERROR <Internal illegal instruction at %1O - %2?>
ILIDO: CALL ILI0 ;DO THE WORK
DEBRK ;DISMISS TO SPECIAL PLACE
ILI0: ATSAVE
MOVE A,ILIDSP ;GET WHERE TO GO
MOVEM A,LV.ILI+PCTAB ;TELL DEBRK
SETZM ILIDSP ;CLEAR SPECIAL DISPATCH
MOVEI A,.FHSLF
GETER ;GET ERROR CODE
HRRZM B,ERCOD ;ERROR CODE, FOR SPECIAL ROUTINE
RET ;DISPATCH TO SPECIAL ROUTINE
;END-OF-FILE INTERRUPT
;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR,
; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS.
;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS.
EOFPSI: CALL SAVACS ;DON'T CLOBBER AC'S
CALL ICLEAR ;CLEAR INTERRUPT
CALL RESACS ;RESTORE AC'S
JRST EOFCHK ;HANDLE CONDITION
;CALL THE FOLLOWING ROUTINE AFTER A FAILING TEXTI. IT CHECKS THE
;ERROR CODE FOR END-OF-FILE CONDITION, HANDLING SPECIALLY. OTHER ERRORS
;ARE HANDLED STANDARDLY.
EOFJER::CALL GETERR ;GET ERROR CODE
CAIE A,IOX4 ;END OF FILE?
CALL CJERRE ;NO, TREAT AS UNEXPECTED ERROR
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: SKIPN EOFDSP
TRAP LV.EOF,<Unexpected end-of-file> ;NO SPEC DISPATCH, TREAT AS ERROR
PUSH P,EOFDSP ;PREPARE TO DISPATCH TO SPECIAL PLACE WITHOUT CLOBBERING AC'S
SETZM EOFDSP ;DON'T ALLOW FURTHER INTERRUPTS
RET ;SERVICE THE END OF FILE CONDITION
;QUOTA EXCEEDED INTERRUPT
;DISPATCH ON QTADSP IF NON-ZERO, ELSE TREAT LIKE OTHER
;"PSEUDO-INTERRUPTS". QTADSP IS USUALLY NON-ZERO DURING ROUTINES
;WHICH WOULD CREATE PAGES AND WISH TO HELP THE USER.
QTAPSI::CALL SAVACS ;SAVE A REG
SKIPN QTADSP
CALL ICLEAR ;CLEAR INTERRUPTS IF NO SPECIAL DISPATCH ADDRESS
SKIPN QTADSP ;CHECK ROUTINE ADDRS
ERROR <User resource failure in EXEC, %?> ;NOT SPECIAL, GIVE MONITOR MSG
MOVE A,QTADSP ;GET ADDRS OF SPECIAL ROUTINE
HRRM A,PCTAB+LV.QTA ;SET UP FOR DEBRK
SETZM QTADSP ;ONLY ONCE
CALL RESACS ;RESTORE
DEBRK ;BYE
;MACHINE SIZE EXCEEDED INTERRUPT
MSEPSI::CALL SAVACS
CALL ICLEAR
CALL RESACS
CALL GETERR ;SEE WHAT HAPPENED
ERROR <System resource failure in EXEC, %?> ;NO, REPORT FROM SYSTEM
;FILE DATA ERROR INTERRUPT
;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO.
;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND
; FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED.
DATPSI: CALL SAVACS ;DON'T CLOBBER AC'S
CALL ICLEAR ;CLEAR INTERRUPT
CALL RESACS
SKIPN DATDSP
JRST DATPS1 ;NO DISPATCH, TYPE ERROR MESSAGE
PUSH P,DATDSP ;SAVE SPECIAL DISPATCH ADDR FOR "RET" BELOW
SETZM DATDSP ;CLEAR SPECIAL DISPATCH
RET ;DISPATCH TO SPECIAL ROUTINE
DATPS1: MOVEI Q1,RERET
MOVEM Q1,CERET ;RESET ERROR RETURN TO "NORMAL"
SETZM .JBUFP
GTSTS ;TREAT CONTENTS OF AC1 AS A JFN, SEE IF ERROR
TXC B,GS%ERR!GS%NAM ;IF ERROR AND LEGAL JFN, BOTH BITS ARE OFF NOW
TXNE B,GS%ERR!GS%NAM ;SKIP IF JFN IS LEGAL AND IN ERROR
ERROR <File data error>
MOVE D,A ;REMEMBER JFN
DVCHR ;SEE WHAT KIND OF DEVICE WE HAVE
LOAD A,DV%TYP,B ;SEE WHAT FLAVOR DEVICE
CAIE A,.DVMTA ;DO SPECIAL MESSAGE FOR MAGTAPE
DTANOF: ERROR <File data error on file %4S>
MOVE A,D ;GET THE JFN BACK
GDSTS ;IT'S A MAGTAPE, SEE IF WE'RE AT END OF TAPE
TXNN B,MT%EOT ;ARE WE AT END OF TAPE?
JRST DTANOF ;NO
ERROR <End of tape reached on file %4S>
;CLEAR OUTPUT BUFFER PSI
;ISSUES CFOBF ON PRIMARY OUTPUT JFN
;NORMALLY INVOKED BY ^O
COBPSI: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,COJFN
RFMOD ;GET PRESENT TTY MODES
TLCE B,(1B0) ;COMPLEMENT SUPPRESS FLAG
JRST [ SFMOD ;WAS ON BEFORE, TURN IT OFF AND PROCEED
JRST COBPS1]
PUSH P,B
CFOBF ;CLEAR OUTBUF OF TTY (PRESUMABLY)
HRROI B,[ASCIZ / ^O...
/]
SETZ C,
SOUT ;NOTE WHAT HAPPENED FOR USER
POP P,B ;RECOVER TTY MODES
SFMOD ;SET OUTPUT SUPPRESS
COBPS1: POP P,C
POP P,B
POP P,A
DEBRK
;GETLPC GETS THE ADDRESS IN WHICH THE INTERRUPT PC FOR THE CURRENT INTERRUPT
;LEVEL IS STORED.
;
;RETURNS+1: NO INTERRUPT IN PROGRESS
; +2: A/ ADDRESS WHICH CONTAINS INTERRUPTED PC
GETLPC::MOVEI A,.FHSLF ;OURSELF
RWM ;SEE WHICH LEVELS ARE IN PROGRESS
;**;[723] Add 1 line at GETLPC:+2L JRG 8-APR-82
TSO B,B ;[723] IN EITHER USER OR MONITOR CONTEXT
JFFO B,GETL1 ;FIGURE OUT HIGHEST LEVEL IN PROGRESS
RET ;NO INTERRUPT IN PROGRESS
GETL1: MOVEI A,PCTAB(C) ;GET ADDRESS IN A
RETSKP ;SKIP TO SAY INTERRUPT IN PROGRESS
;ROUTINE TO CLEAR INTERRUPT. WE TRY TO AVOID CIS JSYS, WHICH REQUIRES
;FAKING AN IPCF INTERRUPT, SINCE ^C OUT OF IPCF INTERRUPT COULD OTHERWISE
;PREVENT ANY MORE IPCF MESSAGES FROM BEING RECEIVED
;ONE OF THE GOALS OF THIS ROUTINE IS TO DO MINIMAL JSYS'S SINCE, ^C CALLS
;IT AND WANTS TO BE EFFICIENT.
ICLEAR::CALL GETLPC ;GET ADDRESS OF INTERRUPT ADDRESS
RET ;NO INTERRUPT IN PROGRESS
XMOVEI D,IC2 ;GET DUMMY PC FOR CLEARING INTERRUPT
EXCH D,@A ;STORE DUMMY PC, GET REAL ONE
DEBRK ;CLEAR THIS INTERRUPT LEVEL
IC2: MOVEM D,@A ;RESTORE REAL INTERRUPT ADDRESS IN CASE SOMEONE CARES
HLLZ B,B ;IGNORE MONITOR INTERRUPTS
LSH B,1(C) ;THROW AWAY BIT REPRESENTING LEVEL WE JUST CLEARED
JUMPE B,R ;IF NO OTHER LEVELS IN PROGRESS, RETURN
;...
;CODE TO FLUSH OUT THE INTERRUPT SYSTEM. THIS IS NEEDED WHEN CLEARING
;AN INTERRUPT LEVEL (SUCH AS ^C) IF OTHER LEVELS WERE IN PROGRESS, IN ORDER
;TO PREVENT ALL SUBSEQUENT CODE TO BE AT INTERRUPT LEVEL.
;WE MUST FAKE AN IPCF INTERRUPT, SINCE THE MONITOR ONLY GIVES US ONE WHEN
;THE COUNT OF MESSAGES GOES FROM 0 TO 1.
SETZM IPCCTL ;PREVENT IPCF DISPATCH
CIS ;CLEAR ALL OTHER LEVELS
MOVEI A,.FHSLF ;OURSELF
MOVX B,1B<IPCCHN>
IIC ;FAKE IPCF INTERRUPT IN CASE WE ARE RESTARTING OR BOMBING OUT OF IPCF INTERRUPT ROUTINE
RET
;SUPER-PANIC CHARACTER (CURRENTLY ^C) PSEUDO-INTERRUPT ROUTINE.
;CHANNEL 1, LEVEL 1
CCPSI: TLOE Z,CTLCF1 ;SAY WE'VE SEEN ^C
TLO Z,CTLCF2 ;IF IT'S THE SECOND ONE, SAY SO
;(CTLCF2 CAUSES OUTBUF TO BE CLEARED BELOW).
SKIPN ACTRCF ;^C ALLOWED?
DEBRK ;NO
.CTRLC: SETZM ILIDSP ;CLEAR SPECIAL IL INST DISPATCH ADDRESS
SETZM CLF ;SAY NOT AT COMMAND LEVEL
CALL ICLEAR ;CLEAR INTERRUPT SO MULTIPLE ^C'S WORK
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
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 [TYPE <% Process disappeared>
ETYPE<%_>
RET]
MOVX Q1,FK%INT ;MARK INTERRUPTED
SKIPE SLFTAB(A)
IORM Q1,SLFTAB(A)
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
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 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)
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.
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
JFCL
HALTF ;MINI-EXEC WILL CATCH US?
TLMRE1: CALL ICLEAR ;CLEAR INTERRUPT
JRST ERRET ;REENTER EXEC
;AUTOLOGOUT PSI AND ROUTINE
;PROGRAM-GENERATED PSI ON CHANNEL 2, LEVEL 1 DISPATCHES HERE
ALOPSI: PUSH P,[[DEBRK]] ;FAKE UP RETURN
ATSAVE
GJINF ;GETS LOGIN USER # IN A
JUMPN A,R ;LOGIN IS COMPLETE, DONE WITH ALL THIS
MOVE C,TTYACF ;GET # CHARS TYPED SO FAR
CAMN C,PTTYAC ;SAME AS LAST PASS?
JRST ALOPS1 ;YES, CLOBBER JOB, IT IS INACTIVE
MOVEM C,PTTYAC ;NO, SAVE CURRENT AS PREVIOUS
MOVE A,[.FHSLF,,.TIMEL] ;SET NEXT TIME TO CHECK
MOVE B,[AUTOL3*^D1000]
MOVEI C,2 ;CHANNEL 2
TIMER
ERROR <Couldn't set auto-logout timer - %?>
RET
ALOPS1: CIS ;ITS REAL. CLEAR PSI SYSTEM SO AUTOLOGOUT
;IS DONE NOT ON AN INTERRUPT LEVEL.
;EXEC'S MAIN FORK JSRT'S HERE,
;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT.
;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT.
AUTOLO: SKIPE CUSRNO ;SKIP IF NOT LOGGED IN
ERROR <Autologout screwup>
GJINF ;GETS CONTROLLING TTY # IN 4
CAMN D,[-1] ;-1 IF NONE (DETACHED)
JRST AUTOL6 ;DETACHED, TYPING MESSAGE WOULD HANG UP JOB.
;CAN BE DETACHED IF DATAPHONE HUNG UP AND CARRIER-OFF PSI
;ISN'T FULLY PROCESSED, OR IF ATACH HAS SOMEHOW FAILED TO
;COMPLETE.
MOVE A,COJFN
CFOBF ;CLEAR POSSIBLE ^S
TYPE <
Autologout
>
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
CALL ERRX ;PRINT ERROR MESSAGE
SETZM ERRMF ;CLEAR FLAG TO SAY ERROR IS OVER
RET ;RETURN
%ERR: %$ERR: TLZ Z,F1
CAIA
%.$ERR: TLO Z,F1 ;SAY DON'T CLEAR INBUF (ERFRS1)
CALL ERRX ;PRINT ERROR MESSAGE
JRST ERRFIN ;FINISH ERROR HANDLING
;MAIN WORK ROUTINE FOR ERROR MESSAGES. HANDLES CLEARING OF TYPEAHEAD,
;TYPING "?" IN FRONT OF MESSAGES, ETC.
ERRX: PUSH P,40 ;TEXT ADDRESS AND UUO VALUE
CALL ERFRS1 ;DO WHAT MUST BE DONE BEFORE TYPING ERROR MSG
JRST ERR1
;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD"
;MUST HAVE ALREADY CALLED "ERFRST"
SYSERA: PUSH P,[-2]
ERR1: PUSH P,A ;AC'S MUST BE SAVED FOR ETYPE OR ERSTR
;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN "?" (ALWAYS),
;THEN TEXT, THEN CR.
;BUT NO INITIAL CR-SPACE IF "U$ERR" UUO.
HLRZ A,-1(P) ;-1 FOR SYSTEM MSG, OR UUO FOR EXEC MSG
CAIE A,<U.$ERR>B53
CAIN A,<U$ERR>B53
JRST ERR5 ;NO CR-SPACE FOR U$ERR UUO ($ERROR MACRO)
CALL CRIF ;TYPE EOL IF NOT ALREADY AT LEFT
ERR5: MOVE A,-1(P) ;0, -1, -2, OR UUO-TEXT ADDRESS
TRNN A,-1
JRST ERR7 ;0 RH MEANS NO TEXT
JUMPGE A,ERR5A ;POSITIVE: USE TEXT A POINTS TO
CAME A,[-1] ;-1 MEANS LATEST ERROR FROM SYSTEM
JRST ERR5C
SKIPG A,EFORK ; USE EPHEMERAL IF PRESENT
MOVEI A,.FHSLF ;GET ERROR # FROM SYSTEM NOW FOR
GETER ; LATER USE IN MSG
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
TYPE < Not logged off
> ;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE
;ERROR UUOS AND SYSERM...
;MESSAGE ALL TYPED.
ERR7: TLNN Z,F1 ;DON'T CLEAR INBUF FOR RUBOUT, ^X (.$ERROR)
SKIPN CIDLYF ;REQUESTING DELAYED CFIBF?
JRST ERR7A ;NO
MOVE A,CIJFN
DOBE
CFIBF ;CLEAR FILE INPUT BUFFER
ERR7A: CALL DOECHO ;MAKE SURE ECHOING IS ON
POP P,B
POP P,A
RET ;RETURN TO CALLER
;GET HERE IF ERROR IS FATAL, AND NO RETURN TO CALLER IS TO BE DONE.
;RESETTING OF VARIOUS THINGS DONE HERE...
ERRFIN::SETZM IPCCTL ;CLEAR SPECIAL IPCF INTERRUPT DISPATCH
SKIPLE A,EFORK ;SPECIAL FORK?
KFORK ;YES - KILL IT
SETOM EFORK ;NO MORE
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.
;**; [722] Insert 2 lines at ERRFIN + 10 6-APR-82 KR
SKIPE .PP ;[722]DON'T RESET IF .PP NEVER SAVED
MOVE .FP,.PP ;[722]RESTORE .FP AS IT WAS BEFORE COMMAND
SKIPE .P ;DON'T RESET P IF NEVER SAVED!
MOVE P,.P ;RESTORE P TO AS IT WAS BEFORE COMMAND
SETZM ERRMF ;NO LONGER PROCESSING AN ERROR
JRST @CERET ;VARIABLE ERROR RETURN, GOES SPECIAL PLACES
;DURING SUB-COMMAND INPUT AS FOR "DIRECTORY" CMD
;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE
RERET: CALL UNMAP ;UNMAP SPECIAL PAGES (BEFORE FLJFNS TO PREVENT CLOSF FAILURE)
CALL UNTAKE ;END TAKE FILE IF ERRORS NOT ALLOWED
SETZM .JBUFP ;FLUSH ALL JFNS
CALL FLJFNS ;RELEASE JFNS FLUSHING OUTPUT FILES
MOVE A,[CZ%NIF+CZ%NCL+.FHSLF]
SKIPE CLZFFF ;DO CLZFF IF POSSIBLE LOST JFN
CLZFF ;RELEASE ANY UNOPEN JFNS
JRST ERRET ;GO BACK TO COMMAND INPUT
;ROUTINE TO UNMAP SPECIAL PAGES, SAVES SWAPPING SPACE.
UNMAP:: SETO A, ;PAGE OF INFERIOR FORK
CALL MAPPF
JFCL ;UNMAP SHOULD NEVER FAIL
SETO A,
MOVE B,[XWD .FHSLF,1+<FREE>B44] ;CLEAR PAGES FREE+1 - BUFL WHICH INCLUDES
MOVE C,[PM%CNT+<BUFL-FREE>B44] ; BUF1, BUF2, DIRECTORY
PMAP ;RESERVE ONE PAGE IN CASE SWAPPING SPACE FILLS UP
CALLRET FREINI ;FIX FREE STORAGE DATABASE AND RETURN
;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT
; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR.
ERFRST: TLZ Z,F1 ;NORMAL ENTRY
ERFRS1: ;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
SAVEAC <A,B,C,D> ;AC'S MAY HAVE DATA FOR MESSAGE PRINTOUT
CALL %GETER ;GET ERROR CODE IN CASE "%?"
CALL FIXIO ;MAKE SURE ERROR SEEN IN "REAL" OUTPUT STREAM
CALL SETT20 ;SAY TOPS20 LEVEL NOW
SKIPN CINITF ;IS EXEX INITIALIZED?
JRST [ MOVEI 1,.PRIOU ;NO, ASSUME COJFN, ETC. NOT SET UP
HRLOI 2,.FHSLF
SETZ 3,
ERSTR ;BUT TRY TO GET OUT ERROR MSG
JFCL
JFCL
HRROI 1,[ASCIZ /
?TOPS-20 command processor not properly initialized.
/]
PSOUT
HALTF]
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH, BECAUSE OTHERWISE
MOVEM A,41 ;MALICIOUS USERS CAN MAKE EXEC TRANSFER
;TO ANY CODE THEY WISH BY PATCHING PAGE 0 OF PMF
MOVE A,COJFN
DOBE ;WAIT IN CASE USER ^O'S SOME OTHER TYPEOUT
RFMOD ;GET TTY MODES
TLZE B,(1B0) ;CLEAR OUTPUT SUPPRESS IF IT WAS ON
SFMOD
SKIPE ERRMF ;DID THIS ERROR OCCUR WHILE PROCESSING ANOTHER?
JRST [ CALL UNTAK1 ;IF MULTIPLE ERROR, ALWAYS END TAKE FILE
UTYPE [ASCIZ /
?Error within an error
/] ;YES, GIVE UP
JRST ERRET]
SETOM ERRMF ;SAY THERE'S AN ERROR
CALL ECHCMD ;ECHO ERRONEOUS COMMAND IF NOT FROM TERMINAL
MOVE A,CIJFN ;SEE WHERE INPUT FROM
CAIN A,.NULIO ;PCL?
JRST [ CALL PCMPOP ;YES, ALWAYS FLUSH
JRST ER2]
CALL UNTAKE ;UNWIND IF ERRORS NOT ALLOWED AT THIS LEVEL
ER2:
TLNN Z,F1 ;DON'T CLEAR INBUF FOR ^U
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?
CAIA
RET ;YES, SO DON'T END THE TAKE FILE
UNTAK1: CALL CIOREL ;END TAKE FILE
CALLRET CIOER ;THERE WAS ONE, SO SAY WHICH ONE WAS ENDED
RET
;ROUTINE TO GET RID OF "TAKE" JFN WHEN ERROR FROM WITHIN IT.
CIOER1: CLOSF ;JUST CLOSE TAKE FILE
CALL JERR ;SHOULDN'T FAIL
RET ;DONE
CIOER: MOVEI D,[ASCIZ /%% Error while reading %1M, file aborted.
/]
STKVAR <<CSIBUF,EXTSIZ>>
CAIN A,.NULIO ;PCL Is there a real file name?
JRST CIOER2 ;PCL No, use generic name
MOVE B,A ;JFN
HRROI A,CSIBUF ;SPACE TO STORE STRING
MOVEI C,0 ;NO SPECIAL FLAGS
JFNS ;GET FILENAME
ERJMP .+1 ;PCL Allow for missing JFN
MOVE A,B ;PUT JFN BACK INTO A
CLOSF ;CLOSE TAKE FILE BEFORE PRINTING MESSAGE BECAUSE ERROR MIGHT BE IN TAKE FILE ITSELF!
CALL JERR ;SHOULDN'T FAIL
HRROI A,CSIBUF ;GET POINTER TO FILENAME
UETYPE @D ;PRINT ERROR MESSAGE
RET
CIOER2: MOVE A,[POINT 7,[ASCIZ /command program/]] ;PCL
UETYPE @D ;PCL
RET ;PCL
;BEGIN ERROR MESSAGE LINE. DO CRLF IF NOT ALREADY AT LEFT MARGIN,
;THEN PRINT "?"
CRIF:: ATSAVE
CALL LM ;GET TO LEFT MARGIN
PRINT "?"
RET
;ROUTINE TO GET TO LEFT MARGIN
LM:: MOVE A,COJFN
RFPOS ;READ FILE POSITION
TRNE B,-1 ;LINE POSITION 0?
ETYPE<%_> ;NO, DO CRLF
RET
%MESS:: ATSAVE
CALL LM
PRINT "%"
RET
;ROUTINE TO GET LAST MONITOR ERROR CODE, RETURNS IT IN A.
GETERR: CALL %GETER
MOVE A,ERCOD
RET
;SUBROUTINE TO OBTAIN LAST JSYS ERROR IN A.
DGETER::MOVEI A,.FHSLF ;OURSELF
GETER ;GET LAST ERROR
HRRZ A,B ;RETURN ERROR IN A
RET
;SUBROUTINE TO DO "GETER" JSYS FOR EXEC AND STORE
;CODE IN "ERCOD"
%GETER::PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.FHSLF
GETER
HRRZM B,ERCOD
POP P,C
POP P,B
POP P,A
RET
;DOGET DOES THE GET JSYS.
;
;ACCEPTS: AC'S/ WHATEVER GET JSYS WANTS
;
;RETURNS: AC'S/ WHATEVER GET RETURNS
; +1 ERROR
; +2 SUCCESS, FAME AND FORTUNE
;
;This routine makes sure the jfn being used by the GET jsys is NOT on the
;exec's jfn stack before the GET jsys. This is necessary to ensure that
;the exec won't attempt to close the jfn later, when it may already be
;associated with another filespec being used by some random fork in the job.
;Normally, the monitor GET code will close the jfn appropriately at the end
;of the GET jsys, so there's no need for the exec to try to close it anyway.
DOGET:: STKVAR <<GETARG,2>>
DMOVEM A,GETARG ;REMEMBER GET ARGUMENTS
LOAD A,GT%JFN,A ;ISOLATE THE JFN
MOVE B,JBUFP ;GET POINTER TO CURRENT SAVED JFNS
DG1: CAMN B,[IOWD JBUFL,JBUF];HAVE WE SCANNED ENTIRE LIST?
JRST DG2 ;YES, JFN WAS NEVER STACKED
HRRZ C,(B) ;NO, EXAMINE NEXT JFN ON STACK
ADJSP B,-1 ;STEP BACK TO NEXT SLOT
CAME C,A ;HAVE WE FOUND THE CORRECT ONE YET?
JRST DG1 ;NO, KEEP LOOKING.
SETZM 1(B) ;YES, CLEAR THIS ENTRY SO EXEC DOESN'T TRY TO CLOSE IT
DG2: DMOVE A,GETARG ;NOW DO THE GET JSYS
GET
ERJMP R ;NON-SKIP ON FAILURE
RETSKP ;SKIP IF GOOD.
;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED --
; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES.
;CLOSES AND RELEASES JFNS STACKED IN JBUF.
;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0
; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN
; TO A SUBCOMMAND INPUT LOOP.
;Returns+1: A/ 0 success
; -1 failure
FLJFNS: ATSAVE
LDF D,CZ%ABT ;ABORT OUTPUT FILES
JRST RJFNS0
RLJFNS: SETZ D, ;BITS TO INCLUDE IN CLOSF
RJFNS0: STKVAR <RLERRF>
SETZM RLERRF ;NO ERROR YET
RJFNSP: MOVE C,JBUFP ;SCAN JFN BUFFER
CAMLE C,[IOWD JBUFL,JBUF] ;STOP AT BOTTOM OF STACK,
CAMN C,.JBUFP ;OR AT SAVED POINTER LEVEL
JRST RJDON ;DONE
CALL RJFN ;DELETE ONE JFN
MOVEM A,RLERRF ;REMEMBER WHETHER ERROR
JRST RJFNSP
RJDON: MOVE A,RLERRF ;RETURN ERROR INFO
RET
;ROUTINE TO GET RID OF TOP JFN ON STACK. COMMANDS THAT WANT TO GET
;RID OF A STACKED JFN SHOULD CALL THIS ROUTINE (RJFN).
;RETURNS+1: A/ 0 SUCCESS
; -1 FAILURE
RJFN:: CALL RJFNS2
MOVE C,JBUFP
ADJSP C,-1 ;DECREMENT POINTER
MOVEM C,JBUFP
RET
;PROCESS ONE WORD OF JBUF
;RETURNS+1: A/ 0 SUCCESS
; -1 FAILURE
RJFNS2: STKVAR <R2ERRF>
SETZM R2ERRF ;NO ERROR YET
MOVE C,JBUFP
HRRZ A,(C) ;GET A JFN TO CONSIDER
JUMPE A,RS2DON ;RETURN IF 0
CAIN A,FI%ERR ;BUFFERED ERROR?
JRST [ HLRZ A,(C) ;YES, GET ADDRESS OF ERROR BLOCK
HRRZ A,.FIJFN(A);GET PARSE-ONLY JFN
JRST .+1]
CALL SKPJFN ;SKIP IF THIS IS A JFN
JRST RJFNS9 ;IT'S A FORK
CAIE A,.PRIIN
CAIN A,.PRIOU
JRST RJFNS8
CALL NOTIO ;MAKE SURE JFN ISN'T AN IO JFN
JRST RJFNS8 ;IT IS!
GTSTS ;GET ITS STATUS
TXNN B,GS%NAM ;JFN EVEN EXIST?
JRST RJFNS8 ;INVALID, FORGET IT
HRRZ A,A ;PREPARE FOR RLJFN/CLOSF
TXNN B,GS%OPN ;IS IT OPEN?
JRST [ RLJFN ;NO, RELEASE IT
JRST RJFNE ;FAILED, GO ANALYZE
JRST RJFNS8] ;SUCCEEDED
HLL A,D ;GET BITS FOR CLOSF
CLOSF ;YES, CLOSE AND RELEASE
RJFNE: ERJMP [CALL RJFNER ;ANALYZE ERROR
MOVEM A,R2ERRF ;STORE ERROR INFO
JRST .+1]
;...
;DONE WITH THIS WORD
RJFNS8: HRRZ A,(C) ;CHECK AGAIN FOR STACKED ERRONEOUS FILESPEC
CAIN A,FI%ERR ;IS IT ONE?
JRST [ HLRZ A,(C) ;YES, GET POINTER TO BLOCK
MOVE A,.FISTR(A);GET POINTER TO BUFFERED FILESPEC
CALL STREM ;RELEASE FREE SPACE USED BY FILESPEC
MOVE C,JBUFP ;GET POINTER TO JFN STACK AGAIN
HLRZ B,(C) ;GET ADDRESS OF BLOCK
MOVEI A,.FILEN ;SAY HOW LONG IT IS
CALL RETBUF ;RETURN BLOCK TO FREE SPACE
MOVE C,JBUFP ;GET POINTER TO STACK AGAIN
JRST .+1]
SETZM (C) ;ZERO JBUF WORD
RS2DON: MOVE A,R2ERRF ;SHOW 0 FOR SUCCESS, -1 FOR ERROR
RET
;LARGE JFNS ARE ASSUMED TO BE FORK HANDLES
RJFNS9: CAMN A,FORK ;ARE WE KILLING MAIN FORK?
SETOM FORK ;YES, SO SAY FORK IS GONE
KFORK ;KILL THE FORK
ERJMP RJFNS8
JRST RJFNS8 ;CONTINUE
;ROUTINE TO SKIP IF WE'VE GOT A JFN
;
;ACCEPTS: A/ ANIMAL
;
;RETURNS: +1: ANIMAL IS NOT A JFN
; +2: ANIMAL IS A JFN
SKPJFN: CAIL A,MAXJFN ;1000 IS MAX FOR NOW
RET ;TOO LARGE, NOT A JFN
RETSKP
;ROUTINE WHICH SKIPS IFF JFN IN A IS NOT AN EXEC COMMAND JFN. CLOBBERS
;NOTHING
NOTIO:: ATSAVE ;DON'T CLOBBER ANY AC'S
MOVE B,TAKLEN ;GET POINTER TO COMMAND JFN STACK
RJFNSA: SOJL B,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 SUCCESS
; -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...>
MOVEI B,^D20 ;# OF HALF SECONDS
RJFNR1: MOVEI A,^D500 ;MS TO SLEEP
DISMS ;ZZZZZ
HRRZ A,0(C) ;GET JFN BACK
HLL A,D ;BITS TO SET
CLOSF ;TRY AGAIN
JRST RJFNR2 ;MORE PROCESSING TO COME
TYPE < [OK]
>
AEDON: MOVE A,AERRF ;RETURN ERROR INFO
RET
RFAIL: ETYPE <%@%%%Couldn't close JFN %1O, status %2o - %?%%_>
SETOM AERRF ;SAY ERROR
JRST AEDON
RJFNR2: CAILE B,1 ;GIVE UP IF TRIED MANY TIMES
CAIE A,CLSX4 ;CHECK SAME LOSAGE
JRST [ HRRZ A,(C) ;GET JFN AGAIN
GTSTS ;GET INFO FOR DIAGNOSTIC
JRST RFAIL] ;MUSTN'T BOMB COMPLETELY, lest we loop
SOJA B,RJFNR1 ;TRY AGAIN
;ROUTINE TO STACK JFNS OR FORK, CHECKS FOR SPACE FIRST
JFNSTK::MOVE B,A ;JFN IN B
HLRZ A,JBUFP
CAIN A,-1
ERROR <Too many JFNs in command>
MOVE A,JBUFP
PUSH A,B ;STACK JFN
MOVEM A,JBUFP
HRRZ A,B ;GET RID OF FLAGS
CALL SKPJFN ;IS THIS REALLY A JFN?
CAIA ;NO
MOVE A,B ;RETURN JFN OR FORK IN A
RET
;PCL ROUTINE TO UNSTACK THE TOP JFN IN THE JFN STACK.
;RETURNS THE JFN IN A. DESTROYS NO REGISTERS.
JUNSTK::PUSH P,B ;SAVE B
MOVE B,JBUFP ;GET THE STACK POINTER
POP B,A ;POP THE JFN INTO A
MOVEM B,JBUFP ;SAVE THE STACK POINTER
POP P,B ;RESTORE B
RET ;AND RETURN
;ROUTINE TO DO GTJFN AND STACK THE JFN. THIS SHOULD BE USED WHEREVER
;A JFN IS NEEDED DURING COMMAND EXECUTION, IN ORDER THAT THE JFN BE
;GUARANTEED TO BE FREED IF THE USER ^C'S OUT OF THE COMMAND.
;THIS ROUTINE SKIPS AND CLOBBERS 1 AND 2 EXACTLY AS GTJFN DOES, EXCEPT
;THAT ERJMP AFTER THE CALL TO THIS ROUTINE WILL NOT WORK (USE JRST).
;(IF YOU FIND PLACES WHERE THE EXEC DOES GTJFN FOLLOWED BY A CALL TO
;JFNSTK, YOU SHOULD CHANGE THEM TO CALL GTJFS INSTEAD)
GTJFS:: STKVAR <<GTDATA,2>>
DMOVEM A,GTDATA ;SAVE THE GTJFN DATA
AOS CLZFFF ;IF ^C BEFORE JFN STACKED, CAUSE CLZFF
GTJFN ;DO THE GTJFN
ERJMP GTFAIL ;FAILED
DMOVEM A,GTDATA ;SAVE RESULTANT DATA
CALL JFNSTK ;STACK THE JFN
SOS CLZFFF ;CLZFF NO LONGER NEEDED SINCE JFN IS STACKED
DMOVE A,GTDATA ;GET WHAT GTJFN RETURNED
RETSKP ;SAY SUCCESS
GTFAIL: DMOVEM A,GTDATA ;SAVE WHAT FAILING GTJFN RETURNED
SOS CLZFFF ;GTJFN FAILED, CLZFF NOT NEEDED
DMOVE A,GTDATA ;GET WHAT GTJFN SAID (ABOUT FAILURE)
RET ;ERROR RETURN
;ROUTINE TO PRINT JOBS ACCOUNTING STRING (OR NUMBER)
PRACCT::STKVAR <<ACCBUF,EXTSIZ>>
HRROI B,ACCBUF ;POINT TO ACCOUNT BUFFER
MOVNI A,1 ;-1 FOR SELF
GACCT ;GET IT
LDB A,[410300,,B] ;GET SIG. OCTAL DIGIT
CAIE A,5 ;5 MEANS NUMBER INSTEAD OF STRING
JRST [HRROI A,ACCBUF ;POINT TO STRING
ETYPE <%1M> ;DUMP IT
RET]
TLZ B,500000 ;GET RID OF CONTROL BITS
ETYPE <%2Q> ;DECIMAL
RET ;RETURN
;%ETYPE (ETYPE MACRO, UETYPE UUO)
;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES.
;SPECIAL CODES ARE OF FORM %NL%
; WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC
; L IS A LETTER:
; D: TYPE CURRENT DATE
; J: TYPE TSS JOB #
; O: TYPE CONTENTS OF INDICATED AC IN OCTAL
; SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.
EBLN==50 ;BUFFER SIZE FOR CHARACTERS DURING ETYPE
%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>B53 ;MAYBE REGULAR TYPE
SETZM ETYPF ;YES
CALL %GETER ;GET ERROR CODE IN CASE "%?"
HRRZ A,40
CAIG A,17 ;PRINTING TEXT FROM TEMP AC?
ADDI A,RACS ;YES, POINT TO SAVED BLOCK
HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR FROM EFF ADDR
MOVEM A,SRCPTR ;REMEMBER SOURCE POINTER
MOVEI A,ETBFR ;CREATE POINTER TO BUFFER FOR CHARACTERS
HRLI A,440700
MOVEM A,ETPTR ;DIVERT OUTPUT TO TEMPORARY BUFFER
ETYP2: HRRZ A,ETPTR ;GET CURRENT OUTPUT ADDRESS
CAIL A,-10+EBLN+ETBFR ;GETTING NEAR END OF BUFFER?
CALL EDMP ;YES, DUMP BUFFER
ILDB B,SRCPTR ;NEXT CHARACTER
ETYP2A: JUMPE B,ETYPDN ;IF NULL, STRING IS DONE
SKIPE ETYPF ;% IS NOT SPECIAL UNLESS ETYPE
CAIE B,"%"
JRST [ IDPB B,ETPTR ;NOT A %, BUFFER IT
JRST ETYP2]
CALL EDMP ;OUTPUT BUFFERED STUFF PRECEDING THE %
;%ETYPE...
;"%" SEEN
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: MOVEI A,0 ;GUARANTEE NULL
IDPB A,ETPTR
MOVE A,COJFN ;OUTPUT TO REAL JFN
HRROI B,ETBFR ;FROM OUR BUFFER
MOVEI C,0 ;STOP ON NULL
SOUT ;SEND THE DATA
MOVEM A,COJFN ;UPDATE JFN IN CASE BYTE POINTER
MOVEI A,ETBFR ;RECONSTRUCT BYTE POINTER TO BUFFER
HRLI A,440700
MOVEM A,ETPTR
RET
ETYP5: CAIL B,141
CAILE B,172
CAIA
TRZ B,40 ;MAKE THE CHARACTER UPPER CASE
MOVEI 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,141
CAILE C,172
CAIA
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: "#",,%NUMS ;OCTAL NUMBER AS N OR N,,N AS APPROPRIATE
"%",,%PER ;%% JUST PRINTS A PERCENT
"=",,%FLT ;SIX-COLUMN FLOATING POINT NUMBER, NN.MM
"@",,%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
"\",,%STRNG ;TYPE STRING OR CHAR IN AC
"/",,%EXPR ;EXPRESSION IN AC
"'",,%SIX ;PRINT CONTENTS OF AC IN SIXBIT
"_",,%EOL ;TYPE A CRLF
"?",,%SYSMS ;ERROR MESSAGE (CONTENTS OF AC OR LATEST)
LETLEN==.-%LETS
;UNRECOGNIZED %-CODE
LETNF: TYPE <%> ;DIGIT, IF ANY, IS LOST.
JRST ETYP2A ;CONTINUE TYPING, STARTING WITH CHAR AFTER %.
;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE.
;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY.
;%% JUST PRINTS A %
%PER: PRINT "%"
RET
;CURRENT TIME
%A: GTAD ;GET CURRENT DATE & TIME
A1: MOVX C,OT%NDA ;TIME ONLY
A2: MOVE B,A
MOVE A,COJFN
CAMN B,[-1] ;DOES SYSTEM HAVE DATE & TIME?
HRLZI B,1 ;CHANGE TO CALL SCREWUP ________
ODTIM
MOVEM A,COJFN ;SAVE UPDATED POINTER
RET
;GET TO LEFT MARGIN
%LM: CALLRET LM
;CPU TIME USED. ALSO SEE %V.
%B: SKIPE A,C ;SPECIFIC TIME SUPPLIED?
JRST [ IDIVI A,^D1000 ;YES, CHANGE TO SECONDS
JRST TOUT] ;PRINT AS HH:MM:SS
HRROI A,-5 ;SAY WHOLE JOB
RUNTM
%B1: IDIV A,B ;CONVERT TO SECS
JRST TOUT ;TYPE AS H:MM:SS
;CONSOLE TIME USED
%C: HRROI A,-5
RUNTM
MOVE A,C
JRST %B1
;DATE
%D: SKIPN A,C ;USE GIVEN QUANTITY IF ANY
GTAD ;GET CURRENT DATE & TIME FROM SYSTEM
MOVEM A,%EDAYT ;SAVE FOR %E
MOVX C,OT%NTM!OT%SCL ;DATE ONLY, STANDARD CONCISE FORMAT
JRST A2 ;GO PRINT DATE
;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE.
%E: SKIPN A,C ;IF SPECIFIC TIME GIVEN, USE IT
MOVE A,%EDAYT
JRST A1 ;SEE %A
;ETYPE'S % ROUTINES ...
;TYPE "FORK N " ONLY IF THIS EXEC HAS >1 INFERIORS.
; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "RFORK".
;FIRST READ FORK STRUCTURE TO FIND OUT HOW MANY FORKS THERE ARE.
%F: MOVEI A,.FHSLF ;SAY START AT SELF
MOVX B,GF%GFH ;ASSIGN FORK HANDLES
MOVE C,[-300,,BUF0] ;WHERE TO PUT FORK STRUCTURE
GFRKS ;GET FORK STRUCTURE
CALL [ CAIE 1,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
POP P,(P)
JRST %F1] ;PRINT ANYWAY
HRRZ A,(B) ;PTR TO INFERIOR
MOVE A,(A) ;XWD ITS PARELLEL, ITS INFERIOR
JUMPE A,[RET] ;NEITHER EXISTS, ITS ONLY ONE, PRINT NOTHING.
%F1: TYPE <Fork >
SKIPG B,C ;USE GIVEN HANDLE IF AC W >0 CONTENTS GIVEN
MOVE B,FORK ;ELSE HANDLE OF LAST RUN FORK
TRZ B,(1B0) ;PRINT ## NOT 4000##.
CALL TOCT ;OCTAL OUTPUT FROM B
PRINT " "
RET
;DEVICE NAME FOR DESIGNATOR IN INDCATED AC.
%H: MOVE A,C
DVCHR ;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR
ERCAL JERR ;CM236
MOVE B,A
MOVE A,COJFN
DEVST ;DEVICE TO STRING
CALL JERR
MOVEM A,COJFN ;SAVE IN CASE POINTER
RET
;NUMBER OF USERS ON SYSTEM.
;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1.
%I: CALL USRCNT
PUSH P,A ;SAVE OPR JOB COUNT
MOVE A,COJFN
MOVEI C,^D10
NOUT ;PRINT NUMBER
CALL JERRC ;GENERAL JSYS ERROR ROUTINE FOR ERR COD IN C
MOVEI B,"+" ;SEPARATE USER/OPR JOBS
BOUT
POP P,B ;GET COUNT OF OPR JOBS
NOUT ;PRINT IT
CALL JERRC
MOVEM A,COJFN ;SAVE IN CASE POINTER
RET
USRCNT::MOVSI A,(RC%EMO) ;EXACT MATCH ONLY
HRROI B,[ASCIZ /OPERATOR/]
RCUSR ;GET DIRNUM OF OPERATOR
TLNE A,(RC%NOM+RC%AMB) ;COULDN'T?
MOVEI C,-1 ;NO, SO USE -1
PUSH P,C ;SAVE IT FOR COMPARES BELOW
SETZB B,C ;COUNTER
HLLZ D,JOBRT ;SET UP AOBJN PTR
GTB .JOBRT
JUMPL A,%I1 ;NO JOB 0
GTB .JOBTT
JUMPL A,%I3 ;IGNORE DETACHED JOB 0
%I1: GTB .JOBRT ;TABLE 1 IS POSITIVE IF JOB EXISTS
JUMPL A,%I3
CALL USERNO ;GET USER NUMBER
JUMPE A,%I3 ;SKIP JOB IF NOT LOGGED IN
CAMN A,0(P) ;LOGGED IN AS 'OPERATOR'?
AOJA C,%I3 ;YES, COUNT OPERATOR JOBS
AOS B ;COUNT REGULAR JOBS
%I3: AOBJN D,%I1
MOVE A,C
POP P,(P)
RET
;UPTIME
%K: TIME ;TIME SINCE SYSTEM RESTARTED
IDIV A,B ;CONVERT TO SECONDS
CALLRET TOUT ;PRINT AS HH:MM:SS AND RETURN
;ETYPE'S % ROUTINES ...
;"TTY N" OR "DETACHED"
%L: GJINF
JUMPL D,[UTYPE [ASCIZ /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
TLZ B,700000
MOVEI C,^D10
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N.
%G: GJINF
JRST %N1
;USER (DIRECTORY) NAME LOGGED IN UNDER.
%N: SKIPN A,C ;USE SPECIFIC USER NAME IF GIVEN
GJINF
MOVE B,A ;LOGIN DIRECTORY NO
%N1: MOVE A,COJFN
DIRST
ERJMP DIRSTB ;THE DIRST FAILED
MOVEM A,COJFN ;UPDATE IN CASE BYTE POINTER
RET
DIRSTB: PRINT "?" ;R1: UNASSIGNED DIR #, NO SYST ERR # IN A.
RET
;ETYPE'S % ROUTINES...
;OCTAL NUMBER IN SPECIFIED AC.
%O: MOVE B,C
JRST TOCT ;TYPE OCTAL FROM B
%STRNG: HLRZ A,C ;GET PNTR LHS
JUMPE A,%CHAR ;IF NO POINTER THEN CHARACTER RJ
CAIE A,-1 ;CHECK FOR -1,,
CAIN A,(<POINT 7,,>) ; OR 440700
CAIA
RET ;RETURN IF CRAP
HRLI C,(<UETYPE>) ;FORM LUUO
PUSH P,C ;SAVE IT
MOVE Z,RACS ;RESTORE ACS
DMOVE A,1+RACS
DMOVE C,3+RACS
XCT 0(P) ;DO IT
POP P,C ;PRUNE PDL
RET ;RETURN
%CHAR: SKIPN B,C ;GET CHARACTER
RET ;RETURN IF NULL
CALLRET COUTC ;TYPE IT AND RETURN
;SIXBIT OF DATA IN AC
%SIX: MOVE A,[440600,,C] ;POINTER TO SIXBIT DATA
MOVEI D,0 ;NULL TO CLEAR CHARACTERS AS WE PRINT THEM
SIX1: TLNN A,770000 ;HAVE WE DONE ALL SIX CHARACTERS YET?
RET ;YES
ILDB B,A ;NO, GET ONE
DPB D,A ;CLEAR OUT CHARACTER WE JUST READ
JUMPN B,SIX2 ;IF CHARACTER IS NON-0, ALWAYS PRINT IT
JUMPE C,R ;IF CHARACTER IS 0, PRINT IT UNLESS IT'S A TRAILING SPACE
SIX2: ADDI B,40 ;CHANGE TO ASCII
PRINT @B ;PRINT CHARACTER
JRST SIX1 ;GO BACK FOR REST
;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC
%P: HRRZ B,C
JRST TOCT
;FLOATING POINT NUMBER
%FLT: MOVE B,C ;GET NUMBER
JRST %Q2
;TSS JOB NUMBER. MUST PRECEDE %Q.
%J: GJINF ;GETS JOB # IN C
;FLOATING PT OR DECIMAL NUMBER FROM AC.
;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100<Q1<377
%Q: MOVE B,C
MOVM C,B
TLNE C,700000 ;EXPONENT .GE. 100?
TLNN C,400 ;NORMALIZED?
JRST %Q1 ;NO, PRINT DECIMAL
LDB C,[POINT 9,C,8] ;GET EXPONENT
CAIN C,377 ;SPECIAL INFINITY?
JRST [ TYPE <+INF> ;YES - SAY SO
RET]
%Q2: MOVE A,COJFN
;THE FOLLOWING FORMAT WORD WILL USE 6 PLACES FOR NUMBERS LESS THAN
;1000. OTHERWISE, IT GOES TO 'FREE' FORMAT AND USES WHATEVER NECESSARY.
MOVE C,[FL%ONE+FL%PNT+FL%OVL+FLD(3,FL%FST)+FLD(2,FL%SND)]
FLOUT
CALL [ CAIE C,FLOTX1 ;COLUMN OVERFLOW?
JRST JERRC ;NO, SOMETHING UNEXPECTED
POP P,C ;YES, THAT'S OK
JRST .+1]
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
%Q1: MOVEI C,^D10 ;RADIX TO USE
MOVE A,COJFN
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;FLOAT THE INTEGER IN A
FLOAT: IDIVI A,400000 ;BREAK NUMBER INTO TWO PARTS
FSC A,254 ;CONVERT HIGH PART
FSC B,233 ;CONVERT LOW PART
FADR A,B ;COMBINE PARTS
RET
;RETURN USER NUMBER IN A OF JOB # IN D
;RETURNS 0 IF THE JOB IS NOT LOGGED IN!
USERNO::PUSH P,B
PUSH P,C ;CLOBBER NOTHING
HRROI B,A ;DIRECT OUTPUT TO LOCATION A
HRRZ A,D ;GET JOB #
MOVEI C,.JIUNO ;SPECIFY USER NUMBER REQUESTED
GETJI ;GET THE USER NUMBER
JRST USERN1 ;FAILED, GO SEE WHY
USERN2: POP P,C
POP P,B
RET
USERN1: CAIE A,GTJIX4 ;"JOB NOT LOGGED IN" ERROR?
CALL JERR ;NO, OTHER. UNEXPECTED...
MOVEI A,0 ;YES, SO RETURN 0.
JRST USERN2
;DIRECTORY NAME FOR NUMBER IN AC
%R: CAMN C,[-1]
JRST %G ;-1 = CONNECTED
LDB B,[POINT 3,C,2] ;SEE IF THIS IS A NUMBER
CAIE B,5 ;OR IF IT IS A STRING POINTER
JRST %M ;STRING POINTER
MOVE B,C
JRST %N1
;FILE NAME FOR JFN IN AC
%S: MOVE A,COJFN
MOVE B,C
SETZ C,
JFNS
ERJMP [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. IF IT RECOGNIZES THE ERROR, IT PRINTS OUT
;THE EXPLANATION AND SKIP RETURNS.
;IF IT DOESN'T RECOGNIZE THE ERROR, IT GIVES A NON-SKIP RETURN.
JFNSIL::CALL %GETER
HRRZ A,B
GTSTS
MOVE A,ERCOD
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,[UTYPE [ASCIZ /None/]
RET]
SETZ D, ;BIT NUMBER
;FIND FIRST SET BIT
TLNE C,(1B0)
JRST %U2
LSH C,1
AOS D
JRST .-4
;LOOP FOR SUCCESSIVE BITS
%U1: TLNN C,(1B0)
JRST %U3
PRINT "," ;COMMA (AND SPACE) BEFORE ALL BUT FIRST
MOVE A,COJFN
RFPOS
MOVEI B,(B)
CAIL B,^D55
ETYPE<%_> ;EOL IF TOO FAR RIGHT
PRINT " "
%U2: ETYPE <%4Q> ;BIT # IN DECIMAL
%U3: AOJ D,
LSH C,1
JUMPN C,%U1
RET
;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB.
%V: SKIPE D ;IF AC SPECIFIED
SKIPA A,C ;THEN IT IS FORK HANDLE
HRROI A,-5 ;SAY WHOLE JOB
RUNTM
MOVE C,B ;TICKS PER SECOND
IDIV A,B ;CONVERT TIME IN TICKS TO SECS
CALL TOUT ;TYPE H:MM:SS
IDIVI C,^D10 ;GET TICKS PER 1/10 SEC
JUMPN D,[RET] ;NOT EVEN, DON'T PRINT TENTHS OF SECS
IDIV B,C ;CONVERT REMAINDER OF TICKS TO TENTHS
ETYPE <.%2Q> ;TYPE TENTHS OF SECONDS
RET
;PRINT C(AC) AS DATE AND TIME
%W: MOVE A,COJFN
MOVE B,C ;ARG SUPPLIED IN C
MOVEI C,0 ;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>
HLRZS A ;GET OPCODE TO SEE IF IT'S A JSYS
CAIN A,<JSYS>B53
TYPE < - JSYS error:>
JRST %X2 ;CONTINUE . . .
%X1: ETYPE <at %3Y>
%X2: MOVE A,FORK ;GET ERROR CODE NOW FOR USE IN ERSTR
GETER ;DO JSYS
HRRZ B,B ;KEEP ONLY THE ERROR CODE
;**;[735] Replace 2 lines with 5 at %X2:+3L KR 17-MAY-82
ETYPE <%_> ;[735]TYPE EOL
SKIPE INDQUS ;[735]IF SET, WE ARE PRINTING "INFO PROG",
JRST %X4 ;[735] DON'T WANT QUESTION MARK IN FIRST COLUMN
ETYPE <?%2?> ;[735]NOT SET; PROCEED NORMALLY
%X3: SETO A, ;[735]ADD LABEL
CALL MAPPF ;UNMAP PAGE
JFCL ;UNMAP SHOULDN'T FAIL
POP P,FORK ;RESETORE FORK INFO
SETZM SYMOKF ;FORCE RECALCULATION OF OLD FORK'S SYMBOL TABLE DATA
CALLRET PION ;SET ^C O.K. AND RETURN
;**;[735] Insert 4 lines at %EXPR:-4L KR 17-MAY-82
%X4: ETYPE < > ;[735]TYPE 3 SPACES FOR EACH FORK-LEVEL
;**;[736] Change 1 line at %X4:+1L KR 1-JUN-82
SOJGE Q1,%X4 ;[735][736] Q1 IS SETUP BY FSTAT TO CONTAIN FORK-LEVEL
ETYPE <?%2?> ;[735]FINALLY PRINT FORK'S ERROR MESSAGE
JRST %X3 ;[735]RETURN TO NORMAL FLOW
;ETYPE'S %-ROUTINES...
;%/ PRINTS EXPRESSION IN AC
%EXPR: SKIPN SYMF ;PRINT SYMBOLICALLY?
JRST %Y ;NO, DO LIKE ADDRESS
MOVE A,C ;YES, GET VALUE
CALLRET TYPEXP ;PRINT EXPRESSION
;%Y TYPES AN EXPRESSION
%Y: SKIPE SYMF ;TYPE SYMBOLICALLY?
JRST [ MOVE A,C ;YES, GET VALUE TO BE TYPED
CALLRET TYPADD] ;TYPE IT SYMBOLICALLY
%NUMS: PUSH P,C ;SAVE THE NUMBER
HLRZ B,C ;SET UP LEFT HALF OF NUMBER
MOVE A,COJFN ;STANDARD OUTPUT STREAM
MOVEI C,8 ;OCTAL
JUMPE B,%Y1 ;DON'T PRINT ANYTHING IF ZERO
NOUT
CALL JERRC ;TYPE STANDARD MESSAGE
MOVEI B,"," ;SEPARATE HALVES
BOUT
BOUT
%Y1: POP P,B ;RESTORE NUMBER
MOVEI B,(B) ;PRINT JUST THE RIGHT HALF THIS TIME
NOUT
CALL JERRC ;PRINT STANDARD MESSAGE
MOVEM A,COJFN ;UPDATE IN CASE IT'S A BYTE POINTER
RET
;%? TYPES LAST ERROR MESSAGE
%SYSMS: HRLI B,.FHSLF ;OURSELF
HRR B,ERCOD ;USE LAST ERROR IF NO ARG
CAIE C,0 ;SPECIFIC ERROR DESIRED?
HRR B,C ;YES, USE IT
MOVE A,COJFN ;STANDARD OUTPUT STREAM
MOVEI C,0 ;NO SIZE LIMIT
AOS CLZFFF ;IF ^C WHILE ERSTR HAS ERRMES.BIN OPEN, DO CLZFF
ERSTR ;TYPE MESSAGE
JRST [ CALL CRIF ;START ON A NEW LINE IF NEEDED
ETYPE <?Error message not found for error %2P>
JRST .+2] ;R1: BAD ERROR NUMBER
JRST .+1 ;R2: DESTINATION PROBLEM, FORGET IT.
SOS CLZFFF ;WE NO LONGER REQUIRE CLZFF
MOVEM A,COJFN ;UPDATE COJFN IN CASE BYTE POINTER
RET
;ETYPE'S % ROUTINES...
;PRINT CRLF
%EOL: MOVE A,COJFN ;GET OUTPUT STREAM
CALL SNDEOL ;WRITE THE CRLF
MOVEM A,COJFN ;UPDATE OUTPUT STREAM
RET
;ROUTINE TO PUT OUT END OF LINE. CALL WITH JFN IN A.
SNDEOL::PUSH P,B
HRROI B,[BYTE(7).CHCRT,.CHLFD]
MOVEI C,0 ;END ON NULL
SOUT ;WRITE THE CRLF
POP P,B
RET
;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS.
TOUTD: PUSH P,A
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,OUTDSG
JRST TOUT1
TOUT: PUSH P,A
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,COJFN
TOUT1: IDIVI B,^D3600
PUSH P,C
MOVEI C,^D10
NOUT ;HOURS
CALL JERRC
MOVEI B,":"
BOUT
POP P,B
IDIVI B,^D60
PUSH P,C
MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!5+5 ;2 COLS, LEADING 0'S.
NOUT ;MINUTES
CALL JERRC
MOVEI B,":"
BOUT
POP P,B
NOUT ;SECONDS
CALL JERRC
POP P,C
POP P,B
POP P,A
RET
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
TYPE <[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
MOVEI C,MALCHN ;USE MAIL CHANNEL
TIMER ;ENABLE FOR INTERRUPT
ETYPE <
%%Unexpected MAIL-WATCH failure, mail no longer being watched - %?
>
RET
> ; 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 0,(P) ;SAVE AC0, GET RETURN ADDRESS
ADJSP P,17 ;ALLOCATE ROOM FOR THE REST OF THE AC'S
MOVEM 0,(P) ;STORE RETURN ADDRESS "AFTER" AC BLOCK
HRRI 0,-16(P) ;PLACE ON STACK TO STORE AC'S
HRLI 0,1 ;STARTING FROM AC1
BLT 0,-1(P) ;SAVE REST OF AC'S
RET ;RETURN TO CALLER
;ROUTINE TO RESTORE AC'S
RESACS::HRLI 0,-16(P) ;GET ADDRESS OF STORED AC'S
HRRI 0,1 ;RESTORE AC'S INTO AC1 ONWARD
BLT 0,16 ;RESTORE 1 THROUGH 16
MOVE 0,(P) ;GET RETURN ADDRESS
EXCH 0,-17(P) ;STORE RETURN ADDRESS, GET ORIGINAL AC0
ADJSP P,-17 ;FREE UP SPACE USED BY RETURN ADDRESS AND 1 THRNOUGH 16
RET ;RETURN TO CALLER (PHYEW!)
NONEWF,<
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;CALLED WITH B CONTAINING THE USER NUMBER
;SKIP RETURNS IF THAT DIRECTORY'S MAIL.TXT EXISTS AND HAS NEW STUFF.
;NON-SKIP IF NO NEW MAIL (A=0) OR CANNOT TELL (A=-1).
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:
MOVEI C,0
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/]
MOVEI C,0
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
> ; 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,0(D) ;TIME TO CHECK MAIL?
RET ;NOPE - RETURN
ADDI A,^D910 ;TRY AGAIN 5 MINS FROM NOW
MOVEM A,0(D)
MOVEI Q2,NMWAT-1 ;# OF ENTRIES
MWATC0: SKIPE B,MWATDR(Q2) ;GET DIRECTORY #
CALL MALCHK ;CHECK ONE
JRST MWATC4 ;NO NEW MAIL
CAMN D,MWATWR(Q2) ;CHECK LAST WRITE DATE/TIME
JRST [ SKIPE AUTOF ;STILL THE SAME , CHECK IIT
JRST MWATC4 ;AUTO WATCH - GO TO NEXT
JRST MWATC1] ;NOT AUTO - DECREMENT COUNT
MOVE Q1,MWATN0(Q2) ;GET INITIAL COUNT
MOVEM Q1,MWATN(Q2) ;RESET FOR NEW D/T
MOVEM D,MWATWR(Q2) ;REMEMBER WRITE DATE
SKIPE AUTOF ;IIT?
JRST MWATC2 ;YES - TELL USER
MWATC1: SOSGE MWATN(Q2) ;REDUCE REPEAT COUNT
JRST MWATC4 ;COUNT EXPIRED, GO ON
JRST MWATC3 ;INFORM USER OF MAIL
MWATC2: PUSH P,A ;SAVE STRING PNTR FROM MALCHK
MOVE A,COJFN
DOBE ;WAIT FOR TYPEOUT TO STOP
POP P,A ;RESTORE PNTR
TYPE <> ;RING CHIMES
MWATC3: MOVE Q1,MWATDR(Q2) ;USER BEING WATCHED
CAME Q1,CUSRNO ;IS IT ME?
JRST [ ETYPE <[%5N has > ;NO - TELL ME WHO THEN
JRST .+2]
TYPE <[You have > ;IT'S MINE
TLNN B,77 ;NETWORKS
TYPE <net>
ETYPE <mail %1\]%_>
MWATC4: SOJGE Q2,MWATC0 ;LOOP BACK FOR NEXT
RET ;DONE, RETURN
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;CALLED WITH C(B) := USER #
;RETURNS:
; +1 ;NO MAIL, OR SOME OTHER FAILURE
; +2 ;NEW MAIL - C(A) := -1,,MESSAGE
; C(D) := WRITE DATE/TIME
; C(C) := AUX MESSAGE
MALCHK::STKVAR <MALUSR,<MALFDB,16>>
SETO Q1, ;INIT FLAG
HRROI A,MALBUF ;POINT AT BUFFER
MOVEM B,MALUSR ;SAVE USER #
HRROI B,[ASCIZ "PS:<"]
MOVEI C,0
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
ERJMP .+1
HRROI B,MALBUF ;ASSUME LOCAL MAIL (-1,,MALBUF)
SKIPA A,[POINT 7,MALBUF]
MALCKL: JUMPE C,MALLCL ;LOCAL IF NO SPECIAL CHARS
ILDB C,A ;FETCH CHAR IN NAME
CAIE C," " ;IMBEDDED SPACE
CAIN C,"@" ;OR AT SIGN MEANS NET MAIL
SKIPA B,[POINT 7,MALBUF] ;RETURN 440700,,MALBUF
JRST MALCKL ;NO SPECIAL KEEP LOOKING
MALLCL: MOVEI A,(Q1) ;JFN TO RELEASE
RLJFN
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%"] ;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
MOVSI P1,A ;SAVE REGS
HRRI P1,-6(P)
BLT P1,0(P) ;...
SKIPE TYPING ;TYPEOUT IN PROGRESS?
JRST IITRET ;YES - EXIT NOW
SETOM AUTOF ;NO - SAY WE ARE IN AUTO CHECK
CALL MWATCH ;INVOKE WATCHERS
CALL ALRCHK
SKIPE IPCRCF ;ANY IPCF MESSAGES?
CALL IPCHEK ;YES - INFORM USER
IITRET: MOVE A,[.FHSLF,,.TIMEL] ;ELAPSED TIME FOR SELF
MOVEI B,^D60000 ;1MIN FROM NOW
MOVEI C,IITCHN ;PSI CHL
TIMER ;ARM IT
SETZM IITSET ;CLEAR FLAG
MOVEI Q3,A ;RESTORE ACS
HRLI Q3,-6(P)
BLT Q3,Q3
ADJSP P,-7
POP P,P1
POP P,40 ;RESTORE LUUO
DEBRK ;EXIT INT
> ; NEWF
;ROUTINE TO SUBTRACT TWO BYTE POINTERS
;CALL: A/ BYTE POINTER 1
; B/ BYTE POINTER 2
;RETURN: +1
; A/ 1-2
SUBBP:: TLC A,-1
TLCN A,-1
HRLI A,440700 ;IF LEFT HALF -1, IT'S NOW 440700
TLC B,-1
TLCN B,-1
HRLI B,440700 ;SAME FOR OTHER POINTER
MOVEI C,1
ADJBP C,B ;PUT SECOND POINTER INCREMENTED IN C
IBP A ;NOW NEITHER POINTER IS "44XX00,,"
MULI A,5 ;MULTIPLY POINTER BY BYTES PER WORD
SUBI B,-4(A) ;B HOLDS CHARACTER ADDRESS
MULI C,5 ;DO SAME TO OTHER POINTER
SUBI D,-4(C)
SUB B,D ;CALCULATE DIFFERENCE
HRRE A,B ;RETURN ANSWER IN A.
RET
;ROUTINE TO DO GFRKS JSYS TO GET FORK HANDLES ON ALL PROCESSES
;UNDER THIS EXEC.
;SKIPS IFF SUCCESSFUL
GFLEN==1000*<<BUFL-BUF0>B44+1> ;LENGTH OF BLOCK
DGFRKS::MOVEI A,.FHSLF ;SAY START AT SELF
LDF B,GF%GFH+GF%GFS ;ASSIGN FORK HANDLES, GET STATUS
MOVE C,[-GFLEN,,BUF0] ;WHERE TO PUT FORK STRUCTURE (BUF0-BUFL)
GFRKS ;GET FORK STRUCTURE
RET ;FAILED
RETSKP ;WIN
;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. GIVE IT JFN IN A
;THIS ROUTINE LEAVES THE TAPE OPEN OR NOT DEPENDING ON WHETHER JFN WAS
;OPEN TO START WITH
REWIND::GTSTS ;SEE IF JFN IS OPEN
TXNN B,GS%OPN ;OPEN?
JRST [ MOVX B,OF%RD ;NO, OPEN FOR READING
CALL OPNMAG ;OPEN THE TAPE
CALL REWIND ;REWIND THE TAPE
TXO A,CO%NRJ
CLOSF ;CLOSE FILE BUT DON'T RELEASE JFN
NOP ;IGNORE FAILURE
RET]
MOVEI B,.MOREW ;SAY "REWIND"
MTOPR ;DO IT
ERCAL CJERRE ;IF FAILS, SAY WHY AND DIE
RET
;ROUTINE TO OPEN MAG TAPE
;ACCEPTS: A/ JFN
; B/ BITS FOR OPENF
OPNMAG::STKVAR <MJFN,OBITS>
MOVEM B,OBITS ;REMEMBER OPENF BITS
MOVEM A,MJFN ;REMEMBER JFN
OPN1: OPENF ;TRY TO OPEN
JRST [ CAIE A,OPNX9 ;INVALID SIMULTANEOUS ACCESS?
CALL CJERR ;NO, I CAN'T HANDLE THIS ONE
MOVE A,MJFN ;GET JFN
DVCHR ;TRANSLATE TO DEVICE DESIGNATOR
CALL CJDEV ;TRY TO FIND ANOTHER OPEN JFN
JRST [ MOVEI A,OPNX9 ;NONE
CALL CJERR] ;SO HANG IT UP
MOVE A,MJFN ;RESTORE JFN
MOVE B,OBITS ;RESTORE OPENF BITS
JRST OPN1] ;GO TRY AGAIN
RET
;BITS+N CONTAINS A WORD WITH A 1 IN BIT N
XX==0
BITS:: REPEAT ^D36,<EXP 1B<XX>
XX=XX+1>
XEND==:. ;MUST BE LAST LOCATION OF EXEC !!!!!
END