Trailing-Edge
-
PDP-10 Archives
-
tops20v41_execsrcmod
-
exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
;Edit 2012 to EXEC1.MAC by SANTIAGO on Fri 15-Mar-85
; Fix edit 2008 - always go to LOGOU2 if GTDAL% fails
;Edit 2008 to EXEC1.MAC by SANTIAGO on Wed 13-Mar-85, for SPR #19885
; Make LOGOUT work on EXEC with no GETAB% cap.
;Edit 1015 to EXEC1.MAC by EVANS on Thu 6-Dec-84, for SPR #20023
; Change error from "No such directory" to "No such directory or
;; Structure not mounted" to account for case of failure in RCDIR
;; which will now check for mounted structure (monitor edit 3185)
;Edit 1005 to EXEC1.MAC by EVANS on Tue 15-May-84, for SPR #19719
; Add terminals 29-36 to blank-screen table -
; change compare instruction to skip if greater or equal.
;Edit 998 to EXEC1.MAC by PRATT on Thu 19-Apr-84 - Remove edits 991 and 992
;Edit 993 to EXEC1.MAC by PRATT on Thu 5-Jan-84, for SPR #19564
; Allow EXEC to run as an inferior even though detached
;Edit 992 to EXEC1.MAC by TSANG on Tue 27-Dec-83 - More to EDIT #991
;Edit 991 to EXEC1.MAC by TSANG on Mon 19-Dec-83
; LOGOUT of another job give the victim's name and ask for confirm
;Edit 986 to EXEC1.MAC by TSANG on Fri 18-Nov-83, for SPR #19628
; Addition to EDIT# 985
;Edit 985 to EXEC1.MAC by TSANG on Thu 10-Nov-83, for SPR #19628
; Make the error characters consistent in reporting an error
;Edit 972 to EXEC1.MAC by TSANG on Mon 1-Aug-83, for SPR #19352
; Make the error character consist in RENAME command
;Edit 953 - Set ERJMP at DISAB1
; UPD ID= 103, FARK:<5-WORKING-SOURCES.EXEC>EXEC1.MAC.6, 29-Sep-82 16:39:32 by DONAHUE
;Edit 914 - Set bit CF%NS at CANARC
; UPD ID= 102, FARK:<5-WORKING-SOURCES.EXEC>EXEC1.MAC.5, 29-Sep-82 16:28:13 by DONAHUE
;Edit 913 - CONFIRM LOG-FILE subcommand to TAKE
; UPD ID= 89, FARK:<5-WORKING-SOURCES.EXEC>EXEC1.MAC.4, 8-Sep-82 15:21:14 by TSANG
;Edit 903 - Set a flag when parsing a password.
; UPD ID= 61, FARK:<5-WORKING-SOURCES.EXEC>EXEC1.MAC.3, 2-Jun-82 14:07:19 by KROSENBLUH
;Edit 738 - new entry routine TRYGTS for getting a jfn for SYSJOB.COMMANDS
; UPD ID= 27, FARK:<4-1-WORKING-SOURCES.EXEC>EXEC1.MAC.2, 12-Apr-82 18:19:18 by KROSENBLUH
;IF ADVISOR TYPES CTRL/O, SEND IT'S EFFECT TO HIS TERMINAL TOO [721]
;<5.EXEC>EXEC1.MAC.17, 18-Mar-82 10:09:20, Edit by CHALL
; UPD ID= 134, SNARK:<5.EXEC>EXEC1.MAC.15, 22-Jan-82 14:49:11 by CHALL
;TCO 5.1698 .TKLOG- ADD NEW SUBCOMMAND TO TAKE: LOG-FILE
; UPD ID= 132, SNARK:<5.EXEC>EXEC1.MAC.14, 15-Jan-82 16:26:55 by CHALL
;TCO 5.1668 .CLOSE- ADD HELP MESSAGE TO OCTX LUUO
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21, 28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 82, SNARK:<5.EXEC>EXEC1.MAC.12, 10-Oct-81 19:40:43 by CHALL
;TCO 5.1563 .CONNE- ADD "STRUCTURE NOT MOUNTED" TO CONNECT ERROR MESSAGE
; UPD ID= 32, SNARK:<5.EXEC>EXEC1.MAC.9, 14-Aug-81 19:11:58 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 19, SNARK:<5.EXEC>EXEC1.MAC.8, 21-Jul-81 12:29:01 by MURPHY
;TCO 5.1427 - GET RID OF SYSTEM MAIL BEFORE PUSH
; UPD ID= 15, SNARK:<5.EXEC>EXEC1.MAC.6, 17-Jul-81 15:42:41 by CHALL
;TCO 5.1420 DETSND- HAVE SEND * SAY IT'S GOING TO ALL
; UPD ID= 4, SNARK:<5.EXEC>EXEC1.MAC.5, 10-Jul-81 17:07:35 by TILLSON
;Remove TCO 5.1400 - this code was already added!
; UPD ID= 2310, SNARK:<5.EXEC>EXEC1.MAC.4, 8-Jul-81 14:22:45 by TILLSON
;TCO 5.1400 - Fix CTRL/C out of LOGIN
; UPD ID= 2247, SNARK:<5.EXEC>EXEC1.MAC.3, 23-Jun-81 15:36:48 by LEACHE
;TCO 5.1379
;Make CANCEL ARCHIVE fail if FB%ARC set (collection run-1 started)
;<HELLIWELL.EXEC.5>EXEC1.MAC.1, 13-May-81 19:58:46, EDIT BY HELLIWELL
;REMOVE .CLEAR ROUTINE (NOW UNUSED)
;<4.EXEC>EXEC1.MAC.1, 10-May-80 16:42:52, Edit by DK32
;Programmable Command Language, SPR 13716
; UPD ID= 1511, SNARK:<5.EXEC>EXEC1.MAC.16, 2-Feb-81 18:10:30 by ELFSTROM
;change stroage to storage in error message for KEEPOV:
; UPD ID= 1321, SNARK:<5.EXEC>EXEC1.MAC.15, 1-Dec-80 16:00:47 by OSMAN
;Use SETENT instead of SEVEC
; UPD ID= 1307, SNARK:<5.EXEC>EXEC1.MAC.14, 24-Nov-80 12:13:52 by DONAHUE
;TCO 5.1191 - Allow UNDELETE to see invisible files (in case one got deleted)
; UPD ID= 1305, SNARK:<5.EXEC>EXEC1.MAC.13, 21-Nov-80 14:22:52 by DONAHUE
;TCO 5.1201 - Set GJ%ACC when getting JFN on LOGIN.CMD
; UPD ID= 1106, SNARK:<5.EXEC>EXEC1.MAC.12, 2-Oct-80 09:55:40 by OSMAN
;tco 5.1163 - Put CONFIRM in ^ESEND command
; UPD ID= 1024, SNARK:<5.EXEC>EXEC1.MAC.11, 17-Sep-80 10:35:57 by OSMAN
;tco 5.1148 - Make DISABLE/RUN equivalent capwise to RUN/DISABLE/START
; UPD ID= 853, SNARK:<5.EXEC>EXEC1.MAC.10, 10-Aug-80 15:20:07 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
;tco 5.1128 - More correct error on "SET ENTRY 2000 2000"
; UPD ID= 832, SNARK:<5.EXEC>EXEC1.MAC.9, 4-Aug-80 12:57:35 by LYONS
; Fix typo in last fix
; UPD ID= 830, SNARK:<5.EXEC>EXEC1.MAC.8, 4-Aug-80 12:37:05 by LYONS
; Allow BLANK command to work for tty types over 18
; UPD ID= 592, SNARK:<5.EXEC>EXEC1.MAC.7, 3-Jun-80 09:33:31 by OSMAN
;tco 5.1057 - Allow ENABLE, DISABLE, and PUSH under BUILD
;<5.EXEC>EXEC1.MAC.6, 30-May-80 16:44:41, EDIT BY MURPHY
;PUT NEW ALERT AND MAIL WATCH UNDER NEWF
; UPD ID= 531, SNARK:<5.EXEC>EXEC1.MAC.5, 20-May-80 14:55:12 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 493, SNARK:<5.EXEC>EXEC1.MAC.4, 30-Apr-80 14:34:40 by OSMAN
; UPD ID= 492, SNARK:<4.1.EXEC>EXEC1.MAC.19, 30-Apr-80 09:55:25 by OSMAN
;Fix confirmation on TAKE subcommands
; UPD ID= 458, SNARK:<4.1.EXEC>EXEC1.MAC.13, 22-Apr-80 16:42:22 by OSMAN
;tco 4.1.1146 - Make CTRL/Q during advice work.
;tco 4.1.1145 - Make ADVISE smarter about "line not active"
;<4.1.EXEC>EXEC1.MAC.12, 8-Apr-80 14:18:46, EDIT BY OSMAN
;tco 4.1.1140 - Remove "(MESSAGE)" guidewords on ^ESEND
; UPD ID= 342, SNARK:<4.1.EXEC>EXEC1.MAC.11, 19-Mar-80 14:59:24 by TOMCZAK
;TCO# 4.1.1117 Clean up some password parsing problems (add PASFLD and a flag)
;<4.1.EXEC>EXEC1.MAC.3, 20-Nov-79 10:02:38, EDIT BY OSMAN
;TCO 4.1.1023 - Fix TAKE stuff
;<4.1.EXEC>EXEC1.MAC.2, 9-Nov-79 09:22:17, EDIT BY OSMAN
;tco 4.1.1011 - Don't allow ^C between LOGIN jsys and setting up CUSRNO
;<4.EXEC>EXEC1.MAC.151, 24-Oct-79 15:40:39, EDIT BY TOMCZAK
;TCO# 4.2544 - Make TAKE file command echoing work right
;<OSMAN.EXEC>EXEC1.MAC.1, 12-Oct-79 16:16:01, EDIT BY OSMAN
;TCO 4.2500 - USE THE CBACK AND CCHKPT LOGIC IN PASSWORD STUFF ONLY
;<4.EXEC>EXEC1.MAC.149, 8-Oct-79 16:13:03, EDIT BY OSMAN
;tco 4.2520 - Get confirmation after password
;<4.EXEC>EXEC1.MAC.147, 15-Sep-79 16:07:25, EDIT BY TOMCZAK
;TCO#4.2471 - Add GJ%ACC bit for getting JFNs on command and log files in TAKE
;<4.EXEC>EXEC1.MAC.146, 12-Sep-79 15:43:01, Edit by HESS
; Re-arrange invocation of MESMES for "set no login-mail" (XTND only)
;<4.EXEC>EXEC1.MAC.144, 5-Sep-79 10:22:16, EDIT BY OSMAN
;tco 4.2440 - Avoid "?JFN is not assigned" in TV (Don't close jfns after GET
;jsys
;<4.EXEC>EXEC1.MAC.141, 28-Aug-79 15:21:50, EDIT BY OSMAN
;tco 4.2427 - Print [n pages freed] message for all appropriate directories.
;<4.EXEC>EXEC1.MAC.141, 28-Aug-79 15:55:01, Edit by HESS
;<4.EXEC>EXEC1.MAC.140, 22-Aug-79 16:14:01, EDIT BY DBELL
;TCO 4.2415 - SKIP OUR OWN JOB WHEN SEARCHING JOBS IN ADVISE OR TALK
;<HESS.E>EXEC1.MAC.15, 19-Aug-79 23:03:39, Edit by HESS
; Add extended features
;<4.EXEC>EXEC1.MAC.138, 14-Aug-79 13:45:57, EDIT BY DBELL
;TCO 4.2396 - STOP PDL OVERFLOWS IN PUSHIO (REPLACE ERJMP WITH MANUAL CHECK)
;<4.EXEC>EXEC1.MAC.137, 10-Aug-79 14:50:41, EDIT BY OSMAN
;tco 4.2384 - Give warning, if nothing retrieved
;<4.EXEC>EXEC1.MAC.135, 10-Aug-79 08:18:18, EDIT BY OSMAN
;tco 4.2380 - Use standard error message if RNAMF jsys fails
;<4.EXEC>EXEC1.MAC.134, 2-Aug-79 09:07:28, EDIT BY OSMAN
;tco 4.2368 - Don't allow NO NO NO NO NO in TAKE subcommands
;<4.UTILITIES>FOO.BAR.8, 26-Jul-79 13:08:06, EDIT BY OSMAN
;tco 4.2347 - Check BATCHF instead of CHKPTY for whether to calculate
;"You have a message"
;<4.EXEC>EXEC1.MAC.125, 26-Jun-79 08:54:45, EDIT BY OSMAN
;tco 4.2310 - Fix prompt "[Attached to TTY67, confirm]"
;<4.EXEC>EXEC1.MAC.124, 21-Jun-79 14:35:56, EDIT BY OSMAN
;<4.EXEC>EXEC1.MAC.123, 21-Jun-79 13:34:10, EDIT BY OSMAN
;REMOVE EXTRANEOUS REFS TO RLJFNS
;<4.EXEC>EXEC1.MAC.122, 20-Jun-79 16:33:29, EDIT BY OSMAN
;tco 4.2301 - Don't type "garbage [No pages freed]" on "DELETE nonxfile"
;and EXP subcommand
;<4.EXEC>EXEC1.MAC.121, 6-Jun-79 09:23:14, EDIT BY HELLIWELL
;DELETE CODE FOR UNMOUNT COMMAND (WAS NOSHIP)
;<4.EXEC>EXEC1.MAC.120, 4-May-79 10:51:28, EDIT BY OSMAN
;DOATI INSTEAD OF BLECCH
;<4.EXEC>EXEC1.MAC.119, 4-May-79 09:16:26, EDIT BY OSMAN
;REMOVE EPCAP AFTER LOGIN (IT'S USELESS, SINCE USER CAN ^C BEFORE IT ANYWAY)
;<4.EXEC>EXEC1.MAC.117, 1-May-79 11:16:39, EDIT BY OSMAN
;CHANGE GTJFN TO GTJFS IN KEEP
;<4.EXEC>EXEC1.MAC.116, 1-May-79 10:17:56, EDIT BY OSMAN
;FOR ADVICE, ATI ^E. SEND ALL OTHER CHARACTERS (INCLUDING ^O!) TO REMOTE JOB
;<4.EXEC>EXEC1.MAC.115, 1-May-79 09:48:21, EDIT BY OSMAN
;try not doing process STIW for ADVISE, just job-wide STIW
;<4.EXEC>EXEC1.MAC.114, 30-Apr-79 16:55:02, EDIT BY OSMAN
;CALL BLECCH AT END OF ADVISE SO STIW ISN'T NEEDED AFTER EVERY ERROR
;<4.EXEC>EXEC1.MAC.113, 30-Apr-79 14:34:46, EDIT BY OSMAN
;DON'T DTI ^C IN ^EEDDT, SINCE WARM START NO LONGER DOES ATI
;<4.EXEC>EXEC1.MAC.112, 30-Apr-79 13:54:03, EDIT BY OSMAN
;DON'T DTI ^C AND ^T ON ^EQUIT OR POP, SINCE WARM START NO LONGER ATI'S THEM!
;<4.EXEC>EXEC1.MAC.111, 12-Mar-79 17:48:08, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<HURLEY.CALVIN>EXEC1.MAC.1, 12-Mar-79 16:04:43, EDIT BY HURLEY.CALVIN
; FIX RETRIEVE - USE ETYPE < %1S> INSTEAD OF TYPIF SINCE USING IT
; WITH NXFILE DOESN'T QUITE WIN FOR THINGS LIKE RETRIEVE AND UNDELETE
; THAT IS, BY THE TIME YOU CALL TYPIF, NXFILE MAY HAVE STEPPED OFF
; THE END CAUSING TYPIF TO LOSE BIG
;<4.EXEC>EXEC1.MAC.109, 12-Mar-79 14:51:15, EDIT BY HURLEY.CALVIN
; CAUSE ARCHIVE, RETAIN NOT TO MAKE FILE INVISIBLE
;<4.EXEC>EXEC1.MAC.106, 9-Mar-79 15:45:51, EDIT BY OSMAN
;CALL MFINP BEFORE DOING GTFDB IN RETRIEVE
;<4.EXEC>EXEC1.MAC.105, 6-Mar-79 09:58:07, EDIT BY OSMAN
;USE GTJFS INSTEAD OF $GTJFN IN ^EEDDT
;<4.EXEC>EXEC1.MAC.104, 5-Mar-79 16:27:02, EDIT BY HURLEY.CALVIN
; don't try to retrieve files that aren't offline
;<4.EXEC>EXEC1.MAC.103, 1-Mar-79 16:27:37, EDIT BY OSMAN
;NOECHO BEFORE (PASSWORD) IN LOGIN
;<4.EXEC>EXEC1.MAC.102, 28-Feb-79 09:53:49, EDIT BY OSMAN
;REMOVE REFS TO CTYPE (USE ETYPE INSTEAD)
;<4.EXEC>EXEC1.MAC.100, 21-Feb-79 16:32:34, EDIT BY OSMAN
;tco 4.2195 - Don't write-enable exec when doing ^EEDDT
;<4.EXEC>EXEC1.MAC.99, 21-Feb-79 09:35:18, EDIT BY OSMAN
;TCO 4.2189 - CONTINUED
;<4.EXEC>EXEC1.MAC.97, 14-Feb-79 14:23:57, EDIT BY OSMAN
;<4.EXEC>EXEC1.MAC.96, 14-Feb-79 13:59:08, EDIT BY OSMAN
;TCO 4.2189 - ASSUME NULL PASSWORD IF USER TYPES CR AT "PASSWORD:"
;<4.EXEC>EXEC1.MAC.94, 9-Feb-79 10:27:56, EDIT BY OSMAN
;MOVE ASSIGN AND DEASSIGN INTO EXECMT
;<4.EXEC>EXEC1.MAC.93, 9-Feb-79 10:17:44, EDIT BY OSMAN
;Make JFNRLA global
;<4.EXEC>EXEC1.MAC.91, 9-Feb-79 09:47:45, EDIT BY OSMAN
;Move tape stuff from here into EXECMT
;<4.EXEC>EXEC1.MAC.89, 6-Feb-79 16:55:23, EDIT BY HURLEY.CALVIN
;<4.EXEC>EXEC1.MAC.86, 6-Feb-79 16:19:16, EDIT BY HURLEY.CALVIN
; Remove XARC around making visible again on CANCEL ARCHIVE, also, ok
; cancel the request for files pending archive
;<4.EXEC>EXEC1.MAC.85, 6-Feb-79 15:44:32, EDIT BY HURLEY.CALVIN
; Cause CANCEL ARCHIVE to find invisible files
;<4.EXEC>EXEC1.MAC.84, 29-Jan-79 09:13:09, EDIT BY OSMAN
;fix call to SPECFN in DISCARD so user doesn't think there's subcommands
;<4.EXEC>EXEC1.MAC.83, 26-Jan-79 15:24:18, EDIT BY OSMAN
;take INVISIBLE feature out of XARC (i.e. make feature always available)
;<4.EXEC>EXEC1.MAC.82, 24-Jan-79 12:44:47, EDIT BY HURLEY.CALVIN
; Also make CANCEL ARCHIVE make 'em visible again (under XARC)
;<4.EXEC>EXEC1.MAC.81, 24-Jan-79 12:37:04, EDIT BY HURLEY.CALVIN
; Cause ARCHIVE request to make files invisible right away (under XARC)
;<4.EXEC>EXEC1.MAC.80, 10-Jan-79 10:56:14, EDIT BY R.ACE
;TAKE OUT "UNAVAILABLE, USE TMOUNT COMMAND" MSG IN ASSIGN COMMAND CODE
;<4.EXEC>EXEC1.MAC.79, 7-Jan-79 16:18:39, EDIT BY DBELL
;CHANGE ^ESEND MESSAGE FORMATS FROM "TTY1" TO "LINE 1"
;<4.EXEC>EXEC1.MAC.76, 20-Dec-78 15:50:42, EDIT BY HURLEY.CALVIN
; Add 1B17 to SPECFN bits in .RETRI
;<4.EXEC>EXEC1.MAC.75, 6-Dec-78 09:29:36, EDIT BY R.ACE
;CREATE CJDEV SUBROUTINE TO CLOSE JFN FOR A GIVEN DEVICE
;<4.EXEC>EXEC1.MAC.74, 19-Nov-78 17:55:11, EDIT BY DBELL
;TCO 4.2092 - GIVE TERMINAL NAME IN ^ESEND TEXTS SO REPLIES ARE EASIER
;<HURLEY.CALVIN>EXEC1.MAC.1, 8-Nov-78 22:09:25, EDIT BY HURLEY.CALVIN
; Change some GUIDE words to upper case only
;<4.EXEC>EXEC1.MAC.72, 27-Oct-78 18:28:19, EDIT BY OSMAN
;DON'T REFERENCE ACTBUF IN LOGIN
;<CALVIN>EXEC1.MAC.2, 8-Aug-78 13:59:05, EDIT BY CALVIN
; Install DISCARD
;[BBN-TENEXD]<CALVIN>EXEC1.MAC.1, 8-Aug-78 11:01:45, Ed: CALVIN
; Install ARCHIVE and RETRIEVE commands in this module (from EXECAR)
;<3-ARC-EXEC>EXEC1.MAC.4, 4-Aug-78 10:00:21, EDIT BY CALVIN
; Bugfixes from BBN sources into DEC archive sources
;<3-ARC-EXEC>EXEC1.MAC.3, 14-May-78 18:56:41, Edit by MTRAVERS
; TYPFRE made external for FLUSH to use.
;<3-ARC-EXEC>EXEC1.MAC.2, 14-May-78 18:02:05, Edit by MTRAVERS
;<3-ARC-EXEC>EXEC1.MAC.1, 14-May-78; Added stuff for DELETE, ARCHIVE.
;<4.EXEC>EXEC1.MAC.68, 22-Oct-78 07:51:42, EDIT BY HEMPHILL
;TCO 4.2059 ADD WARNING MESSAGE IF USER TRIES TO TALK TO SELF
;<4.EXEC>EXEC1.MAC.66, 8-Oct-78 18:49:14, EDIT BY OSMAN
;CALL ICLEAR INSTEAD OF CIS IN ADVISE CODE
;<4.EXEC>EXEC1.MAC.65, 7-Oct-78 00:48:07, EDIT BY OSMAN
;FIX ADVISE HEADER MESSAGE
;<4.EXEC>EXEC1.MAC.64, 28-Sep-78 15:44:33, EDIT BY HELLIWELL
;CHANGE B7 TO DV%MDV AT UNMOUNT
;<4.EXEC>EXEC1.MAC.63, 28-Sep-78 11:38:18, EDIT BY R.ACE
;IF RELD FAILS IN DEASSIGN COMMAND, CALL CJERRE INSTEAD OF JERR
;<4.EXEC>EXEC1.MAC.61, 27-Sep-78 16:15:23, EDIT BY OSMAN
;GET RID OF ALL REFS TO "B3" ETC. (EXCEPT FOR B7 UNDER NOSHIP???)
;TCO 4.2024 - WAIT FOR END OF LOGIN BEFORE PRINTING ERROR (SO PASSWORD DOESN'T ECHO)
;<4.EXEC>EXEC1.MAC.55, 26-Sep-78 13:24:57, EDIT BY OSMAN
;PUT BACK SINGLE-LINE LOGIN
;<4.EXEC>EXEC1.MAC.54, 21-Sep-78 15:21:19, EDIT BY OSMAN
;CHANGE WHLUO ETC. TO WHLU (SEE EXECDE)
;TCO 4.2012 - PRINT SENSIBLE ERROR ON DELETE COMMAND FAILING
;<4.EXEC>EXEC1.MAC.50, 15-Sep-78 22:24:34, EDIT BY OSMAN
;REMOVE ALL REFS TO CSBUF, CSBUFP
;<4.EXEC>EXEC1.MAC.49, 15-Sep-78 11:55:03, EDIT BY OSMAN
;Tco 4.2009 - Remove extra "PASSWORD)" in password routine
;<4.EXEC>EXEC1.MAC.48, 14-Sep-78 14:06:13, EDIT BY OSMAN
;DO SETNM IF ^EEDDT
;<4.EXEC>EXEC1.MAC.46, 14-Sep-78 11:37:41, EDIT BY OSMAN
;REMOVE SEARCH
;Remove mounting stuff. Move to new module, EXECMT
;<4.EXEC>NEW1.MAC.1, 12-Sep-78 15:14:07, EDIT BY OSMAN
;MAKE LOGIN BE ON TWO LINES
;<4.EXEC>EXEC1.MAC.42, 6-Sep-78 13:43:52, EDIT BY R.ACE
;TCO 4.2002 - CHANGE HELP MESSAGE OF "TAKE" COMMAND
;<4.EXEC>EXEC1.MAC.41, 1-Sep-78 17:43:16, EDIT BY OSMAN
;REMOVE PASSWORD-ON-SAME-LINE OPTION OF CONNECT
;<4.EXEC>EXEC1.MAC.40, 30-Aug-78 23:52:07, EDIT BY DBELL
;TCO 4.2001 - MAKE SENDS TO PARTICULAR TTY NUMBER WORK AGAIN
;<4.EXEC>EXEC1.MAC.39, 21-Aug-78 20:06:23, EDIT BY OSMAN
;TCO 4.1988 - FIX "DEFINE" COMMAND HELP MESSAGE
;<4.EXEC>EXEC1.MAC.38, 10-Aug-78 10:11:38, EDIT BY OSMAN
;TCO 1977 DON'T ADVERTISE SUBCOMMANDS FOR UNDELETE
;<4.EXEC>EXEC1.MAC.37, 1-Aug-78 14:31:58, Edit by HEMPHILL
;TCO 1963 -- CORRECT FIX
;<4.EXEC>EXEC1.MAC.35, 1-Aug-78 10:02:06, EDIT BY OSMAN
;FIX SDISMOUNT, PUT ERROR RETURN ON STRX CALL, AND USE LOCAL CELL TO HOLD ALIAS NAME
;<4.EXEC>EXEC1.MAC.34, 31-Jul-78 11:08:42, Edit by HEMPHILL
;TCO 1963 -- MAKE TMOUNT WARN USER ABOUT OPERATOR NOT IN ATTENDANCE
;<4.EXEC>EXEC1.MAC.33, 27-Jul-78 15:43:39, EDIT BY OSMAN
;FIX "DEFINE" HELP MESSAGE
;<4.EXEC>EXEC1.MAC.32, 25-Jul-78 14:01:12, EDIT BY OSMAN
;TCO 1954
;DON'T PRINT OVER QUOTA MESSAGE ON ACCESS, OR IF NOT CHANGING CONNECTED DIRECTORY DURING CONNECT
;<4.EXEC>EXEC1.MAC.30, 21-Jul-78 15:31:19, EDIT BY OSMAN
;RESTORE NAME WHEN POP
;<4.EXEC>EXEC1.MAC.29, 21-Jul-78 10:34:41, Edit by PORCHER
;FIX SET ENTRY VECTOR FOR EX-ONLY
;<4.EXEC>EXEC1.MAC.28, 20-Jul-78 15:40:07, EDIT BY OSMAN
;RESTORE .SJT20 UPON EXITING (.POP)
;<4.EXEC>EXEC1.MAC.26, 17-Jul-78 11:30:43, EDIT BY OSMAN
;GET RID OF GTBUF, USE LOCAL STORAGE, ALSO REMOVE PUS/POP'S IN LOGIN
;<4.EXEC>EXEC1.MAC.23, 13-Jul-78 14:56:47, EDIT BY OSMAN
;CHANGE KEEPNM TO KEPNUM AND MAKE IT LOCAL
;<4.EXEC>EXEC1.MAC.22, 13-Jul-78 13:32:22, EDIT BY OSMAN
;MAKE TALK'S USE OF FRAME BE LOCAL (TFRAME)
;<4.EXEC>EXEC1.MAC.20, 11-Jul-78 15:44:28, EDIT BY OSMAN
;MAKE ADVISE, ATTACH, TALK USE LOCAL VARIABLES
;<4.EXEC>EXEC1.MAC.18, 10-Jul-78 20:50:23, EDIT BY OSMAN
;CHANGE REMARK'S USE OF TEXTIB TO BE LOCAL, AND RENAME IT TO CMTXTB
;<4.EXEC>EXEC1.MAC.17, 29-Jun-78 15:49:43, EDIT BY OSMAN
;make talk's dirno be local
;<4.EXEC>EXEC1.MAC.14, 29-Jun-78 14:56:48, EDIT BY OSMAN
;USE GTJFS, AND MAKE ADVJFN BE TRVAR. ALSO TRVAR FOR CONNECT/ACCESS, STRNAM TOO
;<4.EXEC>EXEC1.MAC.13, 27-Jun-78 16:09:12, EDIT BY OSMAN
;CHANGE ALL THE GTB'S TO BE IMMEDIATE
;<4.EXEC>EXEC1.MAC.12, 26-Jun-78 09:55:49, EDIT BY OSMAN
;MAKE SURE LOGIN BANNER NOT ON SAME LINE AS LOGIN COMMAND
;(BROKE WHEN COMND CHANGED TO PUT CRLF'S IN BUFFER INSTEAD OF LF)
;<4.EXEC>EXEC1.MAC.11, 23-Jun-78 18:20:08, EDIT BY OSMAN
;REMOVE SYMBOLS: CONN2-3-4, ENTRY5, KEEP1A, LOGIN6, RECRF2, SMOUN1
;STRSIX, TAKIN1, TMOUN1, TRYGTP, .ASSO3, .CONN1, .SKIP0-1 (NOT REFERENCED!)
;<4.EXEC>EXEC1.MAC.10, 23-Jun-78 18:00:05, EDIT BY OSMAN
;REMOVE ADVLP0 (UNREFERENCED)
;<4.EXEC>EXECGL.MAC.25, 22-Jun-78 15:14:15, EDIT BY OSMAN
;IN MESMES, REMOVE HACK WITH MWATCT
;<4.EXEC>EXEC1.MAC.8, 19-Jun-78 14:48:55, EDIT BY OSMAN
;CALL SETIOF IN PUSHIO, INSTEAD OF DOING DVCHR AT READ1 (AVOIDS DOING DVCHR BEFORE EVERY COMMAND!)
;<4.EXEC>EXEC1.MAC.7, 9-Jun-78 18:03:56, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<4.EXEC>EXEC1.MAC.6, 31-Jan-78 14:00:04, Edit by PORCHER
;<4.EXEC>EXEC1.MAC.5, 31-Jan-78 11:52:40, Edit by PORCHER
;Add "TAKE,ECHO"
;<4.EXEC>EXEC1.MAC.2, 19-Jan-78 14:53:42, EDIT BY HELLIWELL
;FIX STACK FOR NON-MTA (NOSHIP) AT DOMTOP
;<4.EXEC>EXEC1.MAC.1, 6-Jan-78 11:46:01, EDIT BY HELLIWELL
;TEST FOR DEVICE MTA BEFORE GDSTS AT DOMTOP
;FIX ERCAL .+2 AT DOACC
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;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 EXEC1
;THIS FILE CONTAINS
;LOTS OF COMMANDS...
;ARCHIVE <Files>
;F2 - DON'T FLUSH FILE CONTENTS
.ARCHI::NOISE <FILES>
TLZ Z,F2 ;DEFAULT IS NOT TO RETAIN CONTENTS
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
CALL SPECFN
JRST ARCHI1
JRST ARCHI2 ;DO IT
ARCHI1: SUBCOM $ARCHI
ARCHI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
MOVX C,.ARSET ;WITH NO FLAGS
TLNE Z,F2 ;WANT TO RETAIN FILE CONTENTS?
TXO C,AR%NDL ;RIGHT, FLAG THAT ON THE CALL
PUSH P,C ;SAVE DISPOSITION BITS ETC
ARCHI3: CALL RLJFNS
CALL NXFILE
JRST ARCHI9
CALL TYPIF
CALL MFINP ;GET 2ND JFN
JRST ARCHI9 ;FAILED
MOVX B,.ARRAR ;FUNCTION CODE TO USE (PLS ARCHIVE)
MOVE C,0(P) ;AND BITS
ARCF
ERJMP [ETYPE < %?%%_>
JRST ARCHI9]
HRLI A,.FBCTL
MOVX B,FB%INV ;MAKE THE FILE INVISIBLE TOO
MOVX C,FB%INV
TLNN Z,F2 ;RETAIN CONTENTS?
CHFDB
ERJMP [ETYPE < %?%%_>
JRST .+1]
TYPE < [Requested]
>
ARCHI9: SKIPE INIFH1 ;DONE THEM ALL?
JRST ARCHI3 ;NO, LOOP
SETZM .JBUFP
ADJSP P,-1 ;FLAGS NO LONGER USEFUL
RET
;TABLES ETC. TO ARCHIVE
$ARCHI: TABLE
T RETAIN,,.ARFL
TEND
.ARFL: NOISE <DISK CONTENTS>
CONFIRM
TLO Z,F2
RET
;LET (LOGICAL NAME) -- (AS) --
EDEFIN::TLO Z,F2
NOISE <SYSTEM LOGICAL NAME>
JRST .ASSO
.DEFIN::TLZ Z,F2
NOISE <LOGICAL NAME>
.ASSO: STARX <
Logical name to define or delete,
or "*" to delete all>
JRST .ASSO1 ;NOT "DEFINE *"
PUSH P,[0] ;PUSH 0 TO INDICATE ALL
JRST .ASSO2 ;AND EAT TERMINATOR
.ASSO1: STRX <Logical name to define or delete> ;READ LOGICAL NAME
CMERRX
CALL BUFFF ;GET POINTER TO NAME
PUSH P,A ;SAVE PNTR
.ASSO2: SKIPN (P) ;ALL?
JRST .ASS3B ;YES, SEPARATE ROUTINE
NOISE <AS>
CRRX <Definition list or null to delete>
CAIA ;NOT JUST "DEFINE FOO<CR>"
JRST .ASSO9 ;YES, JUST "DEFINE FOO<CR>"
LINEX <Definition list> ;READ DEFINITION LINE
CMERRX ;NOT ANYTHING LEGAL AFTER "DEFINE" !
CALL BUFFF ;GET POINTER TO DEFINITION STRING
CONFIRM
MOVE C,A ;NEW NAME IN C
MOVEI A,.CLNJB
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSY ;YES
.ASSO4: TLNE Z,F2 ;SYSTEM?
CALL FCONF ;YES, FORCE FURTHER CONFIRMATION
MOVE B,(P) ;GET LOGICAL NAME
PUSH P,A ;REMEMBER ATTEMPTED FUNCTION IN CASE ERROR
CRLNM
JRST ASSONO ;COULDN'T DO IT
POP P,(P)
POP P,(P) ;FIX STACK
RET
;HERE WHEN LOGICAL NAME MANIPULATION FAILED
ASSONO: CAIE A,CRLNX1
CALL CJERRE ;UNKNOWN ERROR
POP P,A ;NOW WE KNOW "NAME UNDEFINED"
CAIE A,.clnj1 ;TRYING TO DELETE ONE JOB NAME?
CAIN A,.clns1 ;OR TRYING TO DELETE ONE SYSTEM NAME?
CAIA ;YES
CALL CJERRE ;NO, TYPE MONITOR MESSAGE
POP P,A ;GET POINTER TO NAME WE COULDN'T DELETE
ETYPE <%%Logical name %1M: was not defined
>
RET ;NON-FATAL ERROR IF DELETING NON-EXISTENT LOGICAL NAME
.ASSO9: MOVEI A,.CLNJ1 ;DELETE
TLNE Z,F2
MOVEI A,.CLNS1
JRST .ASSO4
.ASS3B: CRRX <Confirm to delete all logical names>
CMERRX
MOVEI A,.CLNJA ;DELETE ALL
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSA
TLNE Z,F2 ;SYSTEM?
PROMPT <[Confirm to delete all SYSTEM logical names]>
TLNN Z,F2
PROMPT <[Confirm to delete ALL logical names]>
CALL FCONFA
CRLNM
CALL CJERR
POP P,B
RET
;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>
;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM:
;ATTACH
;(USER) <NAME>
;(PASSWORD) ----
;(TSS JOB #) <#>
;PASSWORD IS NOT ECHOED IN FULL DUPLEX, TYPED OVER MASK ON
;FOLLOWING LINE IN HALF DUPLEX.
;TSS JOB # CAN BE OMITTED IF THERE IS ONLY ONE JOB FOR GIVEN USER.
;IF NOT LOGGED IN, CURRENT JOB GOES AWAY (HANDLED BY MONITOR),
;IF LOGGED IN IT IS DETACHED.
;IN ORDER TO NOT HAVE TO HAVE THE EXEC WAKING UP AFTER EVERY FIELD
;OF INPUT TO SEE IF WE'RE DOING SOME SORT OF PASSWORD COMMAND, THE
;FORMAT OF THE "ATTACH" AND "UNATTACH" COMMANDS HAVE BEEN CHANGED TO
;PROMPT FOR THEIR PASSWORD ON THE SECOND LINE. SINCE THE CR AT END
;OF FIRST LINE CAUSES WAKEUP, THIS GUARANTEES THAT ECHOING WILL HAVE
;A CHANCE TO BE TURNED OFF BEFORE USER TYPES PASSWORD.E.O. JUL-8-77
.ATTAC:: ;ENTRY FOR COMMAND, NEXT TAG IS FROM UNATTACH
IFNBATCH <[ERROR <ATTACH illegal from BATCH job>]>
ATTAU1:
;DECODE ARGUMENTS
TRVAR <ATTNM,<APBUF,20>,AT1,AT2> ;HOLDS ATACH ARGS
NOISE <USER>
CALL USERN ;INPUT USER (DIRECTORY) NAME
CMERRX ;FAILED, PRINT REASON
TXNE A,RC%DIR
ERROR <That's a FILES-ONLY directory name>
PUSH P,C ;SAVE DIR #
SETOM ATTNM ;CLEAR ATTACHED TERMINAL # HERE
NOISE <JOB #>
DECX < Number if more than one job under that name>
CAIA ;NON-DECIMAL NUMBER TYPED
JRST ATTNUM ;NUMBER TYPED, GO PROCESS IT
CONFIRM ;REQUIRE CONFIRMATION OF COMMAND
JRST ATTAC5 ;GO DEFAULT A VALUE
ATTNUM: CONFIRM
PUSH P,B ;SAVE JOB # INPUT BY USER
;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE
SETO D,
GTB .JOBRT ;GET MAX JOB # AS LENGTH OF SYSTEM TABLE
MOVN A,A ;LENGTH COMES BACK NEGATIVE
SUBI A,1 ;SO VALUE COMES OUT RIGHT IN ERR MSG
CAML A,(P) ;LENGTH MUST BE > GIVEN #
SKIPGE D,(P) ;GIVEN JOB # TO D
ERROR <Job # must be between 0 and %1Q>
;MAKE SURE GIVEN JOB # IS LOGGED IN W MATCHING USER # AND IS ATTACHED
GTB .JOBRT ;ENTRY NEG IF NO SUCH JOB
JUMPL A,[UERR[ASCIZ /No job %4Q/]]
GTB .JOBTT ;LINE # OR NEGATIVE FOR DETACHED IN LH
HLREM A,ATTNM ;STORE ATTACHED LINE NUMBER FOR LATER
CALL USERNO ;GET USER OWNING JOB BEING ATTACHED
JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]]
MOVE Q1,-1(P) ;DESIRED USER #, FOR USE IN ERR MSG
CAME A,Q1
ERROR <Job %4Q not logged in under %5R>
JRST ATTAC7 ;GO CONFIRM AND EXECUTE
;ATTACH...
;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME.
ATTAC5: ;SEARCH JOBDIR TABLE FOR A MATCH
GJINF ;GET JOB # INTO C FOR TEST LATER
MOVE Q1,(P) ;DIR # TO SEARCH FOR (USED IN ERR MSGS!)
SETO D,
GTB .JOBRT ;JOBRT TABLE BY JOB #, LOGIN DIR # IN RH.
HRLZ D,A ;SET UP XWD LENGTH, INDEX FOR AOBJN & GTB.
TLZ Z,F2 ;FLAG NO DETACHED JOBS SEEN YET
PUSH P,[-1] ;INIT JOB TO UNKNOWN
ATA5A: CAIN C,(D) ;ALWAYS SKIP US
JRST ATA5L
CALL USERNO
CAME A,Q1 ;IS THIS THE CORRECT USER?
JRST ATA5L ;NO
GTB .JOBTT ;YES - GET TTY WORD
TLNN Z,F1 ;ATTACH OR UNATTACH?
JRST ATA5B ;ATTACH
JUMPL A,ATA5L ;JUMP IF DETACHED
SKIPL (P) ;ATTACHED JOB, SEEN ONE ALREADY?
JRST ATA5E1 ;YES, ERROR
HRRZM D,(P) ;SAVE JOB #
SETOM ATTNM ; AND SET TERM AS DETACHED
JRST ATA5L
ATA5B: JUMPL A,ATA5C ;JUMP IF DETACHED
TLNE Z,F2 ;ALREADY SEEN DETACHED JOB?
JRST ATA5L ;YES, DON'T LOOK AT ATTACHED ONES
SKIPL (P) ;FIRST ATTACHED ONE?
JRST ATA5D ;NO, STOP LOOKING AT ATTACHED ONES
HRRZM D,(P) ;SAVE JOB #
HLREM A,ATTNM ; AND TERMINAL #
JRST ATA5L
ATA5D: SETOM (P) ;RESET JOB # TO UNKNOWN
SETOM ATTNM ; AND TERMINAL # ALSO
TLO Z,F2 ;SET FLAG TO LOOK ONLY AT DETACHED JOBS
JRST ATA5L
ATA5C: TLON Z,F2 ;FLAG DETACHED JOB FOUND
SETOM (P) ;FORGET ANY ATTACHED JOB
SKIPL (P) ;MORE THAN ONE?
ERROR <Job # required - %5R has more than one detached job>
HRRZM D,(P) ;NO, SAVE JOB #
SETOM ATTNM ; AND MARK TERMINAL DETACHED
ATA5L: AOBJN D,ATA5A ;LOOP THROUGH ALL JOBS
SKIPL (P) ;DID WE FIND A JOB?
JRST ATTAC7 ;YES, GO DO IT
TLNE Z,F2 ;.GT. 1 ATTACHED, BUT 0 DETACHED?
JRST ATA5E1 ;YES, SAME ERROR MESSAGE AS UNATTACH
TLNE Z,F1 ;ATTACH OF UNATTACH?
JRST ATA5E2 ;UNATTACH
CAMN Q1,CUSRNO
ERROR <No other jobs logged in under %5R>
ERROR <No jobs logged in under %5R>
ATA5E2: CAMN Q1,CUSRNO
ERROR <No other attached jobs logged in under %5R>
ERROR <No attached jobs logged in under %5R>
ATA5E1: CAMN Q1,CUSRNO
ERROR <Job # required - %5R has more than one other attached job>
ERROR <Job # required - %5R has more than one attached job>
;ATTACH...
;CHECK FOR SELF
ATTAC7: GJINF ;GET JOB NUMBER IN C
CAMN C,(P) ;IS IT US?
JRST [ TLNN Z,F1 ;ATTACH OR UNATTACH?
ERROR <Cannot ATTACH to self>
ERROR <Cannot UNATTACH self>]
;CHECK FOR ALREADY ATTACHED
SKIPGE A,ATTNM ;TTY #
JRST ATAC4B
HRROI B,APBUF ;REDIRECT OUTPUT TO OUR BUFFER
MOVEM B,COJFN
ETYPE < [Attached to TTY%1O, confirm]>
CALL FIXIO ;RESUME NORMAL OUTPUT
UPROMP APBUF ;PROMPT USER FOR CONFIRMATION
CALL FCONFA
;EXECUTE THE COMMAND
ATAC4B: POP P,A ;TSS JOB # TO ATTACH TO
MOVEI C,0 ;NO PASSWORD POINTER
POP P,B ;USER TO ATTACH TO
TLNN Z,F1 ;IF NOT LOSING THIS JOB
SKIPN CUSRNO ;OR NOT LOGGED IN,
CAIA ;THEN SAY NOTHING
ETYPE < Detaching job # %J
>
TLNE Z,F1 ;UNATTACH?
TLO A,(1B1) ;YES, TELL ATACH
DMOVEM A,AT1 ;SAVE ARGS IN CASE REDO NECESSARY
ATACH ;TRY TO DO IT
ERJMP .+2 ;FAILED
JRST ATGOOD ;SUCCEEDED
CAIE A,ATACX4 ;PASSWORD PROBLEM?
JRST ATNG ;NO, SOME OTHER ERROR
CALL PASLIN ;PASSWORD NOT GIVEN BUT REQUIRED, GET IT
MOVE C,A ;STORE NEW PASSWORD POINTER
DMOVE A,AT1 ;GET OTHER ARGS
ATACH
ATNG: CALL [ TLNN Z,F1 ;DIDN'T SAY DETACHING JOB IF UNATTACH
ETYPE <?ATTACH failure, still attached to job # %J
>
CALL CJERRE]
ATGOOD: JRST CMDIN4 ;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
; STILL ATTACHED IF 'UNATTACH' JUST DONE.
;BREAK (LINKS)
NONEWF,<
.BREAK::NOISE <LINKS>
>
BREAK0: CONFIRM
BREK0A: MOVEI B,-1 ;SET TO BREAK ALL LINKS
;(FALL INTO BREAK1)
;BREAK1 breaks links from specific terminal.
;
;Accepts: B/ terminal number or 777777 for all
BREAK1::MOVE A,[TL%CRO!TL%COR+.CTTRM] ;BREAK TO AND FROM LINKS
TLINK
CALL JERR
RET
NEWF,<
;BREAK (LINKS WITH) - FANCIER FORM OF BREAK COMMAND
.BREAK::NOISE <LINKS WITH>
STKVAR <BYUNO>
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "*"]>,<User name, line number, or CR for all>,<*>,[
FLDDB. .CMUSR,CM%SDH,,,,[
FLDDB. .CMNUM,CM%SDH,10,,,[
FLDDB. .CMCFM,CM%SDH,,,,]]]]
CALL FLDSKP ;PARSE THIS MESS
CMERRX
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIN C,.CMCFM ;JUST CR?
JRST BREK0A ;YES - DO ALL
CAIN C,.CMTOK ;WAS IT "*"
JRST BREAK0 ;YES - CONFIRM AND DO ALL
CONFIRM ;MUST BE USER NAME OR LINE #
CAIN C,.CMNUM ;LINE NUMBER?
JRST .BYEBY ;YES - CONFIRM, BREAK, AND RETURN
MOVEM B,BYUNO ;SAVE USER #
TLZ Z,F1!F2 ;INIT FLAGS
HLLZ D,JOBRT ;-# OF JOBS AS AOBJN CNTR
.BYE2: CALL USERNO ;GET USER # OF JOB IN D
CAME A,BYUNO ;IS IT THE ONE WE WANT?
JRST .BYE3 ;NO
TLO Z,F2 ;FOUND ONE
GTB .JOBTT ;GET TTY # FOR JOB
JUMPL A,.BYE3 ;JUMP IF DETACHED
TLO Z,F1 ;ACTUALLY OK TO BREAK LINK
HLRZ B,A ;LINE # TO RHS
CALL .BYEBY ;BREAK A LINK
.BYE3: AOBJN D,.BYE2 ;LOOP THRU ALL JOBS
TLNE Z,F1 ;DID ANY?
RET ;YUP - DONE
TLNE Z,F2 ;WHAT KIND OF LOSAGE?
ERROR <User has detached jobs only>
ERROR <User not logged in>
.BYEBY: TXO B,.TTDES ;MAKE INTO TERMINAL DESC.
CALLRET BREAK1 ;BREAK THE LINK AND RETURN
>
;CANCEL (Request type) ARCHIVE - arrive here from EXECQU
CANARC::NOISE <FOR FILES>
MOVE A,[XWD -1,0]
HRLI B,-3 ;ALL GENERATIONS
;**;[914] Change one line at CANARC:+3L PED 29-SEP-82
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;[914] PASS FLAG BITS
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
SETOM TYPGRP
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP ;SET JFN STACK FENCE
CANAR1: CALL RLJFNS ;RELEASE UNNEEDED JFNS
CALL NXFILE ;STEP TO NEXT FILE
JRST CANAR2
HRRZ A,@INIFH1 ;GET THE JFN WITH NO BITS
MOVE B,[1,,.FBBBT] ;GET WORD WITH REQUEST BIT
MOVEI C,C
GTFDB ;GET IT NOW
ERJMP CANAR3 ;SKIP THIS ONE
TXNN C,AR%RAR ;REQUESTED?
JRST CANAR3 ;NO, SKIP THIS FILE
HRRZ A,@INIFH1 ;GET THE JFN WITH NO BITS
MOVE B,[1,,.FBCTL] ;GET FDB FLAG WORD
MOVEI C,C
GTFDB ;GET IT NOW
ERJMP CANAR3 ;SKIP THIS ONE
TXNE C,FB%ARC ;DOES THE FILE CURRENTLY HAVE ARCHIVE STATUS?
;EG, HAS COLLECTION RUN-1 ALREADY STARTED?
JRST [TYPE <?File has archive status: >
CALL TYPIF ;DISPLAY OFFENDING FILE
TYPE <
>
JRST CANAR3] ;TRY FOR NEXT FILE
CALL TYPIF ;TYPE NAME OF FILE
CALL MFINP ;GET A SECOND JFN
JRST [ETYPE < %?
>
JRST CANAR2] ;FAILED FOR SOME REASON
MOVEI B,.ARRAR ;REQUEST ARCHIVE
MOVEI C,.ARCLR ;CLEAR THE REQUEST
ARCF
ERJMP [ETYPE < %?
>
JRST CANAR2]
HRLI A,.FBCTL
MOVX B,FB%INV
SETZ C, ;MAKE FILE VISIBLE AGAIN
CHFDB
ERJMP [ETYPE < %?
>
JRST .+1] ;SAY OK IF JUST MAKING VISIBLE FAILED
CALL TYPOK
CANAR2: SKIPE INIFH1
JRST CANAR1
RET
CANAR3: CALL GNFIL ;ADVANCE TO NEXT GUY
SETZM INIFH1 ;NONE LEFT
JRST CANAR2 ;AND GO ON
;END-ACCESS (DIRECTORY) <NAME> --
.ENDAC::TLO Z,F2+F3 ;F2 MEANS ACCESS OR END-ACCESS, F3 MEANS END-ACCESS
JRST CONNX ;JOIN COMMON CODE
;ACCESS (DIRECTORY) <NAME> --
.ACCES::TLO Z,F2 ;F2 ON MEANS "ACCESS", OFF MEANS "CONNECT"
TLZ Z,F3 ;F2 MEANS ACCESS
JRST CONNX ;JOIN COMMON CODE
;CONNECT (TO DIRECTORY) <NAME> --
.CONNE::TLZ Z,F2+F3 ;OFF MEANS "CONNECT", ON MEANS "ACCESS"
CONNX: TRVAR <ACDNUM,ACPASS,ACJNUM,OLDCON> ;KEEP ACDNUM,ACPASS,ACJNUM CONSECUTIVE AND IN ORDER!!
SETZM ACPASS ;NO PASSWORD ASSUMED THIS TIME
SETOM ACJNUM ;USE OUR OWN JOB NUMBER
NOISE <TO DIRECTORY>
TLNE Z,F2 ;WANT DEFAULTING?
TLOA Z,F1 ;NO (ACCESS, END ACCESS)
TLZ Z,F1 ;YES (CONNECT)
CALL DIRNAM ;INPUT & CHECK DIRECTORY NAME
ERROR <No such directory or structure not mounted>
MOVEM C,ACDNUM ;REMEMBER DIRECTORY NUMBER
CONFIRM
TLNE Z,F2 ;CONNECT?
JRST NOCONN ;NO, SO NO OVER QUOTA REPORTING
GJINF ;GET CONNECTED DIRECTORY
MOVEM B,OLDCON ;REMEMBER OLD ONE
CALL CHKDAL ;CHECK CURRENT DIRECTORY BEFORE LEAVING
NOCONN: SETZM ACPASS ;FIRST TRY WITHOUT PASSWORD
CALL DOACC ;DO THE JSYS
TLNE Z,F2 ;CONNECT?
JRST CMDIN4 ;NO, ACCESS, SO NO OVER QUOTA REPORT
GJINF ;GET CONNECTED DIRECTORY NOW
CAME B,OLDCON ;DON'T GIVE SAME REPORT TWICE!
CALL CHKDAL ;CHECK NEW DIRECTORY
JRST CMDIN4
;ROUTINE TO DO JSYS FOR ACCESS, END-ACCESS, CONNECT
DOACC: MOVE A,[AC%CON+3] ;SAY "CONNECT"+"3 WORDS IN INFO BLOCK"
TLNE Z,F2 ;"ACCESS"?
TXC A,AC%CON+AC%OWN ;YES, TURN OFF CONNECT AND ON ACCESS
TLNE Z,F3 ;END-ACCESS?
TXC A,AC%OWN+AC%REM ;YES, TURN OFF "ACCESS", TURN ON "END-ACCESS"
MOVEI B,ACDNUM ;WHERE THE BLOCK IS.
ACCES
ERCAL ACCHK ;FAILED
RET ;SUCCEEDED
;CHECK FOR FAILING END-ACCESS AND USER WASN'T ACCESSING THE DIRECTORY
ACCHK: CALL %GETER ;GET ERROR CODE FOR FAILING ACCES JSYS
MOVE A,ERCOD
CAIE A,ACESX6 ;"DIRECTORY ISN'T BEING ACCESSED" ERROR?
JRST ACNOP ;NO, MAYBE PASSWORD NOT GIVEN BUT REQUIRED
MOVE A,ACDNUM ;GET DIRECTORY NUMBER REFERRED TO
ETYPE <%%Directory %1R wasn't being ACCESSed
>
JRST CMDIN4 ;GIVE SUCCESS RETURN FOR COMMAND
;CONNECT OR ACCESS FAILED. SEE IF PASSWORD NOT GIVEN, BUT REQUIRED.
;IF SO, PROMPT FOR IT AND TRY AGAIN. IF NOT, PRINT SYSTEM ERROR.
ACNOP: CAIE A,ACESX3 ;"?PASSWORD IS REQUIRED"?
JRST CJERRE ;NO, OTHER ERROR. PRINT ERROR MESSAGE.
CALL PASLIN ;YES, GET PASSWORD ON NEW LINE.
MOVEM A,ACPASS ;STORE NEW PASSWORD POINTER
JRST DOACC ;TRY THE JSYS AGAIN
;"COPY" IS IN X2CMD.MAC.
;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.
.DAYTI::PRINT " "
MOVE A,COJFN ;DESTINATION
SETOB B,C ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT
ODTIM
ETYPE<%_>
RET
;DELETE <FILE GROUP>
.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN>
SETZM KEPNUM ;ASSUME NOT KEEP
;**;[985] Add one line at .DELET+2L YKT NOV-09-83
TRO Z,F4 ;[985]
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD!GJ%NS!GJ%IFG!1B14!1B15!1B16) ;OLD FILE, NO SEARCH, *'S AND COMMA OK
CALL SPECFN ;INPUT FILE GROUP DESCRIPTOR
JRST DELET1
TDZ Z,[F5!F2!F3!F4!1B18] ;CAN'T BE EXPUNGE IF NO SUBCOMMAND
JRST DELET2
DELET1: TDZ Z,[F5!F2!F3!F4!1B18] ;CLEAR FLAGS
SUBCOM $DELET
DELET2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;FOR NXFILE TYPEOUT
MOVE A,JBUFP ;SAVE THESE JFNS
MOVEM A,.JBUFP
SETZM DELDIR ;NO DIRECTORY INITIALIZED YET
SETOM EXMFLG ;FORCE DIRECTORY TO BE EXAMINED
SKIPE KEPNUM ;DELETING ALL VERSIONS?
JRST KEEPDL ;NO, SPECIAL CODE
DELET3: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR SPECIAL TERM
JRST [ SETOM EXMFLG ;BAD JFN STEPPED TO NEXT, REMEMBER TO EXAMINE IT
JRST DTDEL2]
SKIPE EXMFLG ;ARE WE SUPPOSED TO EXAMINE THIS DIRECTORY?
JRST [ CALL GETDNM ;YES, SEE WHAT NUMBER IT IS
CALL DELINI ;ESTABLISH THIS DIRECTORY AS CURRENT
SETZM EXMFLG ;SAY NO MORE EXAMINATION NEEDED YET
JRST .+1]
CALL TYPIF ;TYPE FILENAME (RETURNS JFN IN A)
MOVE A,INIFH1 ;BEFORE STEPPING TO NEXT FILE
MOVEM A,INIFHO ;REMEMBER WHICH JFN WE'RE ON
CALL MFINP0 ;GET SECOND JFN ON CURRENT FILE, RETURN IN A
JRST DTDEL2 ;ERROR, MESSAGE ALREADY PRINTED
MOVEM A,DELJFN ;SAVE JFN
HRRZ A,A ;GET JFN
TLNE Z,F5
TXO A,DF%ARC ;ALLOW ARCHIVED FILES
TLNE Z,F2
TXO A,DF%EXP ;EXPUNGE FILE
TLNE Z,F3
TXO A,DF%FGT ;FORGET FILE
TLNE Z,F4
TXO A,DF%DIR ;ZAP DIRECTORY
TRNE Z,1B18 ;CONTENTS ONLY?
TXO A,DF%CNO
DELF
JRST [ TYPE < >
CALL $ERSTR ;PRINT ERROR MESSAGE
ETYPE<%_>
JRST DTDEL2]
CALL TYPOK
MOVE A,DELJFN ;GET FLAGS
MOVE B,INIFHO ;GET OLD JFN POINTER
CAMN B,INIFH1 ;IF DIFFERENT JFN NOW, REPORT MIGHT BE DUE
TXNE A,GN%STR!GN%DIR ;DID DIRECTORY JUST CHANGE?
SETOM EXMFLG ;NEW JFN OR DIRECTORY CHANGED, REMEMBER TO EXAMINE DIRECTORY
DTDEL2: SKIPE INIFH1 ;DID WE USE UP ALL THE JFNS?
JRST DELET3 ;NO, GO CHECK NEXT JFN
CALLRET PDLFRE ;REPORT ABOUT FINAL DIRECTORY AND RETURN
;ROUTINE USED BY DELETE TO PRINT NUMBER OF PAGES FREED IF EXPUNGE SUBCOMMAND
;WAS USED, OR IF SOME PAGES HAVE BEEN FREED
PDLFRE: SKIPN A,DELDIR ;GET CURRENT DIRECTORY NUMBER
RET ;WHOOPS, NONE! USER TYPED "DELETE BLECCH"
MOVE B,DELPGS ;CAUSE "PAGES FREED" TO BE 0 FOR NON-DIR DEVICE
CAIE Q2,0 ;DON'T TO "GTDAL" UNLESS MULTIPLE DIRECTORY DEVICE
GTDAL ;CHECK ALLOCATION
MOVE A,DELPGS ;GET ORIGINAL ALLOC
SUB A,B ;TAKE DIFFERENCE NOW
TLNN Z,F2 ;ALWAYS PRINT AFTER EXPUNGE
JUMPE A,R ;DON'T PRINT IF 0
MOVE C,DELDIR ;TELL TYPFRE WHICH DIRECTORY TO PRINT
CALLRET TYPFRE ;PRINT RESULTS
;DELINI TAKES DIRECTORY NUMBER IN A AND INITIALIZES DATA TO WORK ON THAT
;DIRECTORY
DELINI: MOVEM A,NEWDIR ;SET NEW DIRECTORY WE'RE WORKING ON
CAMN A,DELDIR ;IS NEW ONE THE SAME AS THE OLD ONE?
RET ;YES, SO DON'T RESET COUNTS OR TRY TO PRINT
SKIPE DELDIR ;WAS THERE A PREVIOUS DIRECTORY?
CALL PDLFRE ;YES, PRINT ITS RESULTS
MOVE A,NEWDIR ;SET UP NEW ONE AS CURRENT
MOVEM A,DELDIR ;REMEMBER DIRECTORY NUMBER
CAIE Q2,0 ;DON'T GET ALLOCATION FOR NON-DIRECTORY DEVICE
GTDAL ;GET ALLOCATION
MOVEM B,DELPGS ;SAVE PAGES IN USE
RET
;GETDNM DECIDES WHAT DIRECTORY NUMBER WE'RE WORKING ON
GETDNM: HRRZ A,@INIFH1 ;GET JFN
SETOM Q2 ;ASSUME MULTIPLE DIRECTORY DEVICE
CALL DIRQ ;SKIP IF DIRECTORY DEVICE
MOVEI Q2,0 ;NOT A MULTIPLE DIRECTORY DEVICE
JUMPE Q2,R ;SKIP DIRECTORY NAME STUFF IF NOT MULTIPLE DIRECTORY DEVICE
HRRZ B,@INIFH1 ;JFN TO B
LDF C,1B2+1B5+JS%PAF ;GET PUNCTUATED STRUCTURE AND DIRECTORY
HRROI A,DELBUF ;WHERE TO PUT IT
JFNS
MOVSI A,(RC%EMO) ;LITERAL MATCH
HRROI B,DELBUF ;STRING
RCDIR ;GET DIR #
HRROI B,DELBUF ;FOR ERROR MESSAGE
TLNE A,(RC%AMB+RC%NOM)
ERROR <No such directory - %2m>
MOVE A,C ;RETURN DIRECTORY NUMBER IN A
RET
;DIRQ SKIPS IFF THE CURRENT JFN IS A MULTIPLE DIRECTORY DEVICE
DIRQ: HRRZ A,@INIFH1 ;GET RID OF FLAGS
DVCHR ;GET DEVICE CHARACTERISTICS
ERCAL JERR ;UNEXPECTED FAILURE
TXNE B,DV%MDD ;SKIP IF NON-DIRECTORY DEVICE
RETSKP ;WE'LL SKIP, BECAUSE IT'S A DIRECTORY DEVICE
RET
$DELET: TABLE
T ARCHIVE,,..ARCH
T CONTENTS-ONLY,,.CNOLY
T DIRECTORY,,..DIR
T EXPUNGE,,..EXP
T FORGET,,..FORG
T KEEP,,..KEEP
TEND
..ARCH: NOISE <FILES INCLUDED>
CONFIRM
TLO Z,F5
RET
.CNOLY: CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
TRO Z,1B18
RET
..EXP: NOISE <AFTER DELETING>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TLO Z,F2 ;FLAG EXPUNGE
RET
..FORG: NOISE <WITHOUT DEASSIGNING DISK ADDRESSES>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "FORGET" at the same time>
MOVX B,WHLU+OPRU
CALL PRVCK
ERROR <WHEEL or OPERATOR capability required>
TLO Z,F3
RET
..KEEP: DEFX <1> ;DEFAULT IS "1"
DECX <Number of generations>
CMERRX ;NO DECIMAL NUMBER SUPPLIED
CAIN B,1
NOISE <GENERATION>
CAIE B,1
NOISE <GENERATIONS>
CONFIRM
SKIPN B
ERROR <Number of generations may not be 0>
TLNE Z,F3
ERROR <Can't "KEEP" and "FORGET" at the same time>
TLNE Z,F2
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TRNE Z,1B18
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
MOVEM B,KEPNUM
RET
..DIR: NOISE <AND "FORGET" FILE SPACE>
CONFIRM
MOVX B,WHLU+OPRU
CALL PRVCK ;MUST HAVE PRIVS FOR THIS FCN
ERROR <WHEEL or OPERATOR capability required>
SKIPN KEPNUM
TLZE Z,F2!F3
TYPE <% KEEP or EXPUNGE or FORGET subcommand ignored>
SETZM KEPNUM ;ZERO THIS
TLO Z,F4 ;SET FLAG FOR ZAP DIRECTORY
RET
;PRUNE NUMBER OF GENERATIONS
;SOME BUFFER DEFINITIONS
VERBUF==BUF0 ;PUT TABLE AT BUF0
VRTBLN==<BUFL-BUF0>/2 ;USE 1/2 THE SPACE FOR STRING POINTERS,
;THE OTHER 1/2 FOR STRINGS
VERSTR==VERBUF+VRTBLN ;START OF STRING SPACE
VEREND==BUFL+1000-5 ;5 WORDS FOR OVERFLOW
KEEPDL: CALL RLJFNS ;RELEASE ANY TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX TERMS
JRST KEEPDE ;END CHECK
HRROI A,DELBUF ;GET POINTER TO STRING BUFFER
HRRZ B,@INIFH1 ;GET JFN
LDF C,2B2+2B5+1B8+1B11+1B35 ;DEV, DIR, NAME, EXT
JFNS ;SAVE NAME OF FILE
ERCAL JERRE
MOVE A,[POINT 7,VERSTR] ;INIT POINTER TO VERSION STRING SPACE
MOVEM A,KEPJNM ;SAVE HERE
MOVSI Q1,-VRTBLN ;AOBJN PTR TO VER STRING PTR TABLE
LDF D,1B14+1B35 ;GENERATION + PUNCTUATION
KEEPD1: MOVE A,KEPJNM ;GET VERSION POINTER
TLNE Z,F5 ;ALLOWED TO DELETE ARCHIVE STUFF?
JRST KEEPD8 ;YES, BYPASS CHECKS
HRRZ A,@INIFH1 ;GET CURRENT JFN
MOVE B,[1,,.FBCTL] ;GET CONTROL BITS
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,FB%ARC ;NOT DELETABLE?
JRST KEEPD9 ;NO, PASS OVER IT
HRRZ A,@INIFH1
MOVE B,[1,,.FBBK0]
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,AR%RAR ;REQUESTED ARCHIVE?
JRST KEEPD9 ;YES, PASS OVER IT
KEEPD8: MOVE A,KEPJNM ;GET VERSION POINTER
HRRZ B,A
CAIL B,VEREND ;BUFFER SPACE FULL?
JRST KEEPOV ;YES
MOVEM A,VERBUF(Q1) ;SAVE IN TABLE
HRRZ B,@INIFH1
MOVE C,D ;GET DISPOSITION
JFNS ;INTO VERSION STRING SPACE
ERCAL JERRE
SETZ C,
IDPB C,A ;TERMINATE STRING
MOVEM A,KEPJNM ;STORE UPDATED STRING POINTER
KEEPD9: MOVE A,@INIFH1
TLNE A,770000 ;SKIP GNJFN IF NO STARS
GNJFN
JRST KEEPD3
TLNE A,(1B14+1B15+1B16) ;DIR, NAME, EXT CHANGED?
JRST KEEPD2 ;YES, FINISH THIS FILE
JUMPN C,KEEPD1 ;IF NONE FOUND
LDF D,1B14 ;GENERATION WITHOUT PUNCT.
AOBJN Q1,KEEPD1 ;INCREMENT VERSION PTR AND LOOP BACK
KEEPOV: TYPE <%Too many generations for internal storage, will not print generations
>
CALL KEEPPN ;PRINT NAME
CALL KEEPDO ;DO DELETE (RETURNS # DELETED IN A)
SKIPL A
ETYPE < [%1Q generations deleted]
>
MOVE A,@INIFH1
TLNE A,770000
KEEPD4: GNJFN
JRST [ AOS A,INIFH1
CAMLE A,INIFH2 ;OFF END?
SETZM INIFH1 ;YES, INDICATE SUCH
JRST KEEPDE]
TLNN A,(1B14+1B15+1B16)
JRST KEEPD4
JRST KEEPDE
KEEPD3: AOS A,INIFH1
CAMLE A,INIFH2
SETZM INIFH1
KEEPD2: MOVEI A,1(Q1) ;GET NUMBER OF VERSIONS
SUB A,KEPNUM ;GET NUMBER TO DELETE
JUMPLE A,KEEPDE ;JUMP IF NONE
CALL KEEPPN ;PRINT NAME
MOVNI A,1(Q1) ;GET -NUMBER OF VERSIONS
ADD A,KEPNUM ;GET NUMBER TO DELETE
HRLZ Q1,A ;MAKE AOBJN PTR
KEEPD5: MOVE A,VERBUF(Q1)
ETYPE <%1M>
AOBJN Q1,[PRINT "," ;PRINT THEM ALL
JRST KEEPD5]
CALL KEEPDO ;DO DELNF
JUMPL A,KEEPDE ;ERROR?
CALL TYPOK ;TYPE [OK]
KEEPDE: SKIPE INIFH1
JRST KEEPDL
JRST DTDEL2
KEEPPN: PRINT " "
HRROI A,DELBUF ;GET NAME POINTER
ETYPE <%1M> ;TYPE IT
RET
KEEPDO: MOVSI A,(GJ%OLD+GJ%PHY+GJ%SHT)
HRROI B,DELBUF ;GET FILE VERSION 0 (HIGHEST)
CALL GTJFS ;GET AND STACK JFN
JRST KEEPE1 ;GTJFN FAILED
MOVE B,KEPNUM ;NUMBER TO KEEP
TLNE Z,F5 ;ARCHIVE ALLOWED?
TXO A,DF%ARC ;YES, SAY SO.
DELNF
JRST KEEPE2
MOVE A,B ;RETURN NUMBER IN A
RET
KEEPE2: TYPE < >
CAIA
KEEPE1: TYPE < GTJFN failure for highest generation
?>
CALL $ERSTR
TYPE <
>
SETO A,
RET
;DISCARD (TAPE INFORMATION FOR FILES) <FILES>
.DISCA::NOISE <TAPE INFORMATION FOR FILES>
;**;[986] Add one line at .DISCA+1L YKT NOV-18-83
TRO Z,F2 ;[986] SET THE FLAG
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRRZI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;NO SUBCOMMANDS
CALL SPECFN
JRST CERR ;DON'T ALLOW "STUFF,"
SETOM TYPGRP ;ALWAYS TYPE THE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;WHERE OUTPUT GOES
MOVE A,JBUFP
MOVEM A,.JBUFP
DISCA1: CALL RLJFNS ;RELEASE STRAY JFN'S
CALL NXFILE ;STEP TO NEXT FILE IN GROUP
JRST DISCA2 ;NO MORE IN THIS GROUP
CALL TYPIF ;DO NAME
CALL MFINP ;GET A SECOND JFN
JRST DISCA2 ;FAILED?
MOVX B,.ARDIS ;FUNCTION CODE FOR THE DISCARD
MOVX C,AR%CR1+AR%CR2 ;DO BOTH TAPES
ARCF
ERJMP DISCA9 ;FAILED...
CALL TYPOK ;TELL THE USER IT'S DONE
DISCA2: SKIPE INIFH1 ;DONE THEM ALL?
JRST DISCA1 ;NO, CONTINUE THE PROCESS
RET
DISCA9: ETYPE < %?
>
JRST DISCA2
;EXPUNGE (ALL DELETED FILES)
.EXPUN::TRVAR <EXPNST,EXPNFL,EXPDIR,OLDALC>
GJINF
MOVEM B,EXPDIR ;DEFAULT IS CONNECTED DIR
NOISE <DIRECTORY>
CALL CURNMS ;READ DIRECTORY NAME ALLOWING STARS
;**;[1015]Change 1 line at .EXPUN+5 DEE 6-DEC-84
ERROR <No such directory or Structure not mounted>;[1015]RE: MONITOR EDIT 3185
MOVEM A,EXPNFL ;SAVE THE FLAGS RETURNED
MOVEM B,EXPNST ;SAVE THE POINTER TO THE DIR NAME STRING
MOVEM C,EXPDIR ;SAVE DIRECTORY NUMBER
CALL %EXPUN ;CHECK SUBCOMMANDS
EXPUN1: CALL EXPDO ;GO EXPUNGE THIS DIRECTORY
MOVE A,EXPDIR ;NOW STEP THE DIRECTORY NAME
MOVE B,EXPNST ;GET POINTER TO THE USER NAME STRING
MOVE C,EXPNFL ;GET THE FLAGS
TXNE C,RC%WLD ;WILD CARDS TYPED?
CALL STPDIR ;YES, GO STEP THE DIR NUMBER
RET ;NO MORE TO BE DONE
MOVEM A,EXPDIR ;SAVE THE NEW DIRECTORY NUMBER
JRST EXPUN1 ;LOOP BACK FOR REST OF DIRS
;ROUTINE TO DO THE EXPUNGING
;ACCEPTS IN EXPDIR/ DIR NUMBER
;WARNING: THIS IS NOT A GENERAL ROUTINE. TO MAKE IT ONE, HAVE IT
;ACCEPT THE DIR IN A INSTEAD OF EXPDIR, SINCE EXPDIR IS LOCAL TO THE
;EXPUNGE COMMAND
EXPDO: MOVE A,EXPDIR
GTDAL
MOVEM B,OLDALC
MOVE B,EXPDIR
HLLZ A,Q1 ;GET BITS FROM ARGS
DELDF
ERJMP [TYPE <% > ;HANDLE ERROR
CALL %GETER ;GET ERROR CODE
MOVE A,ERCOD
CALL $ERSTR ;PRINT IT
MOVE A,EXPDIR ;GET DIR NUMBER
ETYPE< - %1R%%_> ;TERMINATE ERROR MESSAGE
RET] ;AND RETURN
MOVE A,EXPDIR
GTDAL
MOVE A,OLDALC
SUB A,B
MOVE C,EXPDIR ;GET THE DIR NUMBER TO BE OUTPUT
;... FALL INTO TYPFRE
;TYPFRE TAKES NUMBER OF PAGES FREED IN A, DIR NUMBER IN C, AND PRINTS
;MESSAGE SAYING HOW MANY PAGES FREED
TYPFRE::MOVEI B,[ASCIZ " %3R [%1Q"]
SKIPN A ;ANYTHING?
MOVEI B,[ASCIZ " %3R [No"]
UETYPE (B) ;PRINT FIRST PART
TYPE < page> ;BUILD CORRECT GRAMMAR
CAIE A,1 ;ONLY ONE?
PRINT "s" ;NO - THEN PLURAL
TYPE < freed]
>
RET
;ROUTINE TO GET EXPUNGE SUBCOMMANDS
%EXPUN: SETZ Q1, ;CLEAR BITS
CALL SPRTR
SUBCOM $EXPUN ;SUBCOMMANDS, READ 'EM
RET
$EXPUN: TABLE
T DELETE,,.TEXP
T PURGE,,.NXEXP
T REBUILD,,.REBLD
TEND
.TEXP: NOISE <TEMPORARY FILES>
CONFIRM
TXO Q1,DD%DTF
RET
.NXEXP: NOISE <NOT COMPLETELY CREATED FILES>
CONFIRM
TXO Q1,DD%DNF
RET
.REBLD: NOISE <SYMBOL TABLE>
CONFIRM
TXO Q1,DD%RST
RET
;COMMENT (END WITH ^Z)
.REMAR::NOISE (MODE)
CONFIRM ;GET COMMAND CONFIRMATION
TYPE <Type remark. End with CTRL/Z.
>
STKVAR <<CMTXTB,10>>
SETZM .RDBFP+CMTXTB ;SAY NO BACKUP POINTER
SETZM .RDRTY+CMTXTB ;SAY NO ^R POINTER
COM1: MOVEI A,.RDBRK ;THIS MANY WORDS IN TEXTI BLOCK
MOVEM A,.RDCWB+CMTXTB
MOVX A,RD%JFN ;SAY WE'RE GIVING JFNS
MOVEM A,.RDFLG+CMTXTB
HRL A,CIJFN ;INPUT STREAM
HRR A,COJFN ;EDITING STREAM
MOVEM A,.RDIOJ+CMTXTB
HRROI A,BUF0 ;USE BUFFER SPACE FOR INPUT
MOVEM A,.RDDBP+CMTXTB
MOVX A,<BUFEND-BUF0+1>*5;THIS MANY CHARACTERS AVAILABLE IN BUFFER
MOVEM A,.RDDBC+CMTXTB
MOVEI A,[EXP 1B<3*8+2>,0,0,0] ;ONLY BREAK ON ^Z
MOVEM A,.RDBRK+CMTXTB ;SET UP BREAK MASK
MOVEI A,CMTXTB ;POINT TO BLOCK
TEXTI ;INPUT SOME OF THE COMMENT
ERCAL CJERRE ;FAILED, GO SEE WHY
MOVE A,.RDFLG+CMTXTB ;GET RESULTS
TXNE A,RD%BTM ;^Z TYPED YET?
JRST UNMAP ;YES, CLEAN UP AND RETURN
JRST COM1 ;NOT YET, READ MORE
.CLOSE::NOISE <JFN>
CRRX <Octal JFN number or blank for all>
CAIA ;NOT JUST "CLOSE<CR>"
JRST SHUT
OCTX <Octal JFN number> ;SEE IF OCTAL NUMBER
CMERRX ;NOT OCTAL NUMBER EITHER!
CONFIRM
PUSH P,B ;SAVE THE JFN
CALL CLOPAT ;GO UNMAP THE FILES IF PA1050 THERE
POP P,A ;PUT JFN IN A
CAIG A,MAXJFN ;ERROR IF THE JFN IS NOT WITHIN BOUNDS
SKIPG A
ERROR <Illegal JFN number>
CALL JFNREL
ERROR <JFN not in use>
RET
;ENTER HERE WITH JFN TO RELEASE IN A
JFNREL: TDZA D,D ;NO SPECIAL BITS
JFNRLA::LDF D,CZ%ABT ;CLOSE WITH ABORT
HRRZ A,A ;CLEAR LHS
GTSTS
TXNN B,GS%NAM ;ANYTHING IN THIS JFN?
RET ;NO, RETURN
ETYPE < %1P %1S > ;TYPE JFN AND NAME
CAIN A,.PRIIN ;PRIMARY INPUT?
JRST NRLPRI ;YES
CAIN A,.PRIOU ;PRIMARY OUTPUT?
JRST NRLPRO
CALL NOTIO ;MAKE SURE JFN ISN'T BEING USED FOR EXEC COMMAND INPUT OR OUTPUT
JRST NRLEX ;NAUGHTY, NAUGHTY, TRYING TO CLOSE COMMAND JFN!
TXNN B,GS%OPN ;OPEN?
JRST [ RLJFN
JRST JFNER1
JRST JFNOK1]
HLL A,D ;USE BITS IN D
CLOSF
JRST JFNER2
JFNOK1: GTSTS
TXNE B,GS%NAM ;NAME STILL THERE?
JRST JFNOK2
TYPE < [OK]
>
RETSKP
NRLPRI: TYPE < Primary input not closed
>
RETSKP
NRLPRO: TYPE < Primary output not closed
>
RETSKP
;USER TRIED TO CLOSE COMMAND JFN. SEE WHETHER INPUT OR OUTPUT TO
;GIVE FANCY MESSAGE.
NRLEX: TXNE B,GS%WRF ;OPEN FOR WRITE?
JRST NRLEXO ;YES, ASSUME OUTPUT JFN
JRST NRLEXI ;NO, ASSUME INPUT
NRLEXI: TYPE < EXEC command input not closed
>
RETSKP
NRLEXO: TYPE < EXEC command output not closed
>
RETSKP
JFNOK2: TXNE B,GS%OPN
TYPE < Can't close file
>
TXNN B,GS%OPN
TYPE < Can't release JFN
>
RETSKP
JFNER1: TYPE < Can't release JFN - >
CAIA
JFNER2: TYPE < Can't close file - >
CALL $ERSTR ;PRINT ERROR IN A
ETYPE<%_>
RETSKP
SHUT: CALL CLOPAT ;GO UNMAP THE PA1050 OPEN FILES
MOVEI A,MAXJFN ;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1: PUSH P,A
CALL JFNREL ;RELEASE JFN
JFCL ;IGNORE NOTHING THERE
POP P,A
SOJG A,SHUT1
RET
;ADVISE (TERMINAL/USER)
.ADVIS::TLO Z,F2 ;FLAG ADVISE
NOISE <USER>
JRST LINK0
.JILEN==.JILNO+1 ;ROOM FOR ALL JOB INFO WE MAY NEED
;TALK (TERMINAL/USER)
.TALK:: TLZ Z,F2
NOISE <TO>
LINK0: TRVAR <DOLNKF,<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVJNM,DIRNO>
MOVEM P,TFRAME ;SAVE BEGINNING OF POSSIBITITES
USERX <User name or terminal number>
JRST LTTY ;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
CONFIRM
MOVEM B,DIRNO ;SAVE USER NUMBER
TLZ Z,F1 ;NO DETACHED JOBS SEEN YET
MOVEM P,TFRAME ;SAVE BEG OF ARGS
HLLZ D,JOBRT ;MAKE AOBJN PTR
LINK3: MOVEI B,(D) ;GET JOB NUMBER BY ITSELF
CAME B,JOBNO ;LOOKING AT MY OWN JOB?
SKIPN B ;OR JOB 0?
JRST LINK6 ;YES, SKIP IT
CALL USERNO ;GET USER NUMBER
CAME A,DIRNO
JRST LINK6 ;WRONG GUY
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LINK6 ;AND SKIP IT IF DETACHED
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
GTB .JOBPN ;GET PROGRAM NAME
PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6: AOBJN D,LINK3 ;MAY HAVE MORE JOBS
CAMN P,TFRAME ;FOUND ANY?
JRST [ TLNE Z,F1
ERROR <User has detached jobs only
Use "MAIL" to send mail to user>
MOVE A,CUSRNO ;GET MY USER NUMBER
CAMN A,DIRNO ;LOOKED FOR MY OWN JOBS?
JRST LINKNS ;YES, SAY CAN'T DO MYSELF
ERROR <User is not logged in
Use "MAIL" to send mail to user>]
POP P,A ;SUBSYSTEM NAME
POP P,B ;TTY#
CAMN P,TFRAME ;ONLY ONE POSSIBILITY?
JRST [ MOVE A,B ;YES, USE IT
TLO Z,F3 ;NO CONFIRM NEEDED
JRST LINK11]
LINK7: MOVE C,B ;SAVE FOR POSSIBLE DEFAULT
ETYPE < TTY%2O%, >
JUMPE A,[PRINT "?" ;NO SUBSYS NAME
JRST LINK8]
CALL SIXPRT ;PRINT SUBSYSTEM
LINK8: ETYPE <%_>
CAMN P,TFRAME ;DONE ALL?
JRST LINK9 ;YES
POP P,A
POP P,B
JRST LINK7
LINK9: PROMPT <TTY: >
HRROI A,LDBUF ;GET POINTER FOR DEFAULT STRING
MOVEM A,CMDEF ;SAVE POINTER TO DEFAULT
MOVE B,C ;GET DEFAULT TTY # (FIRST ONE ON LIST)
MOVEI C,8 ;IN OCTAL
NOUT ;CREATE DEFAULT STRING
CALL JERR ;SHOULDN'T FAIL
OCTX <Terminal number>
CMERRX ;NON-OCTAL NUMBER TYPED
JRST LINK10
LTTY: OCTX ;USER NAME NOT TYPED, SEE IF TERMINAL NUMBER
CMERRX <User name or terminal number required>
LINK10: CONFIRM
LINK11: PUSH P,B ;SAVE TTY#
GJINF ;GET JOB INFORMATION
TLNN Z,F2 ;SKIP CHECK IF ADVISING
CAME D,0(P) ;IS TTY# IDENTICAL TO MY TTY NUMBER ?
SKIPA
LINKNS: ERROR <Cannot talk to self>
HLRE B,TTYJOB ;GET NEG SIZE OF TABLE
MOVMS B
POP P,A ;TTY#
CAIGE A,0(B)
CAIGE A,0
ERROR <Nonexistent terminal number>
TLNN Z,F3
MOVE P,TFRAME
PUSH P,A
SETZ D,
GTB .PTYPA
MOVE D,A
POP P,A
CAIGE A,(D) ;PTY?
JRST NOPTYL ;NO
PUSH P,D ;MAYBE. CHECK FOR ABOVE LAST PTY
HLRZ D,D ;NUMBER OF PTYS
ADD D,0(P) ;LAST PLUS ONE
POP P,0(P) ;CLEAR STACK
CAIL A,(D) ;ABOVE PTY'S?
JRST NOPTYL ;YES. NVT OR SOMETHING ELSE
PROMPT < [Pseudo-terminal, confirm]>
CALL FCONFA
NOPTYL: TLNE Z,F2
JRST ADVISE ;GO GIVE ADVISE
MOVEI B,.TTDES(A) ;FORM TTY DESIGNATOR
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERROR <Refused, use "MAIL" to send mail to user>
RET
;CODE TO GIVE ADVISE - CHECK TERMINAL PRINT JOB INFO
ADVISE: MOVEM A,ADVTNM
MOVX B,WHLU!OPRU
CALL PRVCK
CAIA
JRST ADVIS1 ;SKIP CHECK IF PRIVILEGED
TRO A,.TTDES
RFMOD
ERJMP [CALL TX1SKP ;FAILED, SEE IF FOR LINE NOT ACTIVE
CALL JERRE ;STRANGE ERROR, REPORT IT
JRST ADVIS1] ;NOTHING ON LINE, THAT'S O.K.
TRNN B,TT%AAD
ERROR <Destination not receiving advice>
ADVIS1: SETO D,
GTB .TTYJO
MOVNS A,A
CAMGE A,ADVTNM
ERROR <Illegal terminal number>
MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JITNO
GETJI
CALL JERR
CAMN C,ADVTNM
ERROR <Cannot advise self>
TYPE < Escape character is <CTRL>E, type <CTRL>^? for help
>
MOVE D,ADVTNM
GTB .TTYJO
HLRZ B,A
CAIN B,-1
JRST [ TYPE < No job on terminal.
>
JRST CONNECT]
CAIN B,-2
JRST [ TYPE < Terminal being assigned.
>
JRST CONNECT]
TRZE B,400000
TYPE < Not controlling terminal.
>
MOVEM B,ADVJNM
PRINT " "
MOVE A,ADVJNM
MOVEI B,JIBUF ;GET ADDRESS OF BUFFER
HRLI B,-.JILEN ;SPECIFY LENGTH
MOVEI C,0
GETJI
CALL JERR
SKIPN B,.JIUNO+JIBUF
JRST [ TYPE <Not logged in>
JRST NOLOGD]
ETYPE <%2R>
NOLOGD: MOVE B,.JIDNO+JIBUF
CAMN B,.JILNO+JIBUF
JRST NOCOND
UETYPE [ASCIZ /, %2R/]
NOCOND: MOVE B,ADVJNM
ETYPE < Job %2Q>
PRINT " "
SKIPN A,.JIPNM+JIBUF
MOVE A,.JISNM+JIBUF
CALL SIXPRT
ETYPE<%_>
;CODE TO GIVE ADVISE - MAKE CONNECTION, LOOP SENDING CHARACTERS
CONNEC: SETOM DOLNKF ;SAY TLINK NEEDED
MOVE B,ADVTNM ;GET TERMINAL NUMBER
TRO B,.TTDES ;SET UP TERMINAL NUMBER FOR STI
MOVEM B,ADVTNM
CALL CHKLNK ;TRY TO ESTABLISH LINK FIRST
MOVEI A,.FHSLF
RPCAP
MOVEI A,.FHJOB
MOVX B,1B<ADVESC> ;ONLY THE ADVICE ESCAPE CHARACTER DOESN'T GET SENT TO THE REMOTE JOB
TXNE C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
STIW
MOVE A,[ADVESC,,^D24] ;CONTROL-E IS USED TO GET OUT
ATI
SETOM ADVFLG ;FLAG IN ADVISE CODE
TLZ Z,F3 ;NOT IN COMMENT NOW
LDF A,GJ%SHT ;SHORT FORM GTJFN
HRROI B,[ASCIZ /TTY:/] ;WE NEED BINARY CHANNEL. THIS IS SO
;IF THINGS LIKE "TER RA" OR "TER NO RA"
;ARE "SENT" TO REMOTE JOB, THEY HAVE
;EFFECT
CALL GTJFS ;GET HANDLE ON TTY FOR BINARY COMMUNICATION
CALL CJERRE ;FAILURE, PRINT ERROR AND RETURN
MOVE B,[100000,,OF%RD] ;OPEN THE JFN FOR READ
OPENF
ERCAL CJERRE ;FAILED
MOVEM A,ADVJFN ;REMEMBER THE ADVISE JFN
MOVEI A,.CTTRM ;CONTROLLING TERMINAL
RFMOD ;GET CURRENT SETTING OF PAGE MODE
MOVE C,B ;GET A COPY OF IT
ANDX C,TT%PGM ;KEEP ONLY PAGE MODE
MOVEM C,SAVPGM ;REMEMBER CORRECT SETTING
TXZ B,TT%PGM ;TURN OFF PAGING SO WE CAN SEND CTRL/Q TO REMOTE TERMINAL
STPAR
ADVLOP: MOVE A,ADVJFN
TLNE Z,F3 ;COMMENT?
MOVE A,CIJFN ;YES, USE REGULAR ECHOING TTY CHANNEL
BIN
MOVE C,B ;PUT CHARACTER IN C
ANDI C,177 ;STRIP TO 7 BITS FOR IDENTIFICATION
CAIN C,"^"-100 ;^^ ?
JRST SNCTRL ;YES, SEND CONTROL CODE
;**; [721] Insert 7 lines at ADVLP1: - 1 6-APR-82 KR
CAIE C,CTRLO ;[721]DID HE TYPE CTRL/O?
JRST ADVLP1 ;[721]NO, GO ON
PUSH P,B ;[721]SAVE FOR LATER
MOVEI A,.FHSLF ;[721]SET UP TO SEND INTERRUPT
HRLZI B,10000 ;[721] ON USUAL CTRL/O CHANNEL
IIC ;[721] TO OURSELVES.
POP P,B ;[721]SET UP FOR STI
ADVLP1: TLNE Z,F3 ;COMMENT?
JRST ADVLOP ;YES, DON'T SEND CHAR
MOVE A,ADVTNM
STI
ERJMP [SKIPL DOLNKF ;HAVE WE SUCCESSFULLY LINKED YET?
JRST ILISTI ;YES, SO ANALYZE ERROR
PRINT .CHBEL ;NO, SO ECHO A BELL TO TYPIST
JRST .+1] ;GO WAIT FOR TLINK TO SUCCEED (WAIT FOR USER TO TYPE ^C)
ADVLP2: CALL CHKLNK ;SEE IF TLINK NEEDED (MAYBE OTHER JOB WENT AWAY, WHICH BREAKS LINK)
JRST ADVLOP ;GO GET NEXT CHARACTER
;TX1SKP sees if the last error was due to line being not active.
;
;Returns+1: other error
; +2: TTYX01 was last error
TX1SKP: CALL DGETER ;GET REASON
CAIE A,TTYX01 ;IS LINE NOT ACTIVE?
RET ;OTHER ERROR
RETSKP ;LINE IS NOT ACTIVE
;CHKLNK ATTEMPTS TO ESTABLISH LINKS IF THEY'RE NOT ALREADY ESTABLISHED.
CHKLNK: MOVE B,ADVTNM
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERJMP [CALL TX1SKP ;TLINK FAILED, SEE IF BECAUSE LINE NOT ACTIVE
JRST CJERRE ;OTHER FAILURE, TELL USER WHAT IT IS
JRST CONN1] ;LINE NOT ACTIVE, DON'T CLEAR FLAG YET
AOSN DOLNKF ;GIVE ANNOUNCEMENT FIRST TIME
TYPE < [Advising]
>
CONN1: RET
ILISTI: SETOM DOLNKF ;REMEMBER TO RETRY LINK IF WE RECOVER
CALL %GETER
MOVE A,ERCOD
CAIN A,IOX33 ;INPUT BUFFER IS FULL?
JRST ADVLP2 ;RIGHT, ASSUME USER HEARD BELL
CAIN A,TTYX01 ;LINE BECAME INACTIVE AND USER ISN'T A WHEEL?
JRST IS1 ;WHAT A CROCK, STI SHOULD BE FIXED IN MONITOR
;TO MERELY WORK ON INACTIVE LINE. ^C SHOULD
;START JOB, AND OTHER CHARACTERS SHOULD BEEP
;JUST AS THOUGH REAL TYPIST WERE THERE.
CAIE A,DEVX2
CAIN A,DESX2
CAIA
JRST CJERR
IS1: TYPE <
[Destination refused advice]
>
JRST ADVDON
SNCTRL: BIN
MOVE C,B ;GET 7-BIT VERSION OF CHARACTER
ANDI C,177
CAIN C,"("
JRST STCOMM
CAIN C,")"
JRST ENCOMM
CAIN C,"+"
JRST RELINK
CAIN C,"?"
JRST TYPADV
CAIL C,141
CAILE C,172
CAIA ;NOT LOWER CASE LETTER
TRZ B,40 ;LOWER CASE, MAKE UPPER CASE
TRZ B,300 ;MAKE INTO A CONTROL (A BECOMES CTRL/A ETC.)
JRST ADVLP1
;START COMMENT
STCOMM: TYPE <^^(> ;ECHO CHARACTER HE TYPED
TLO Z,F3 ;FLAG NOT TO SEND CHARS
JRST ADVLOP
;END COMMENT
ENCOMM: TLZ Z,F3 ;FLAG TO SEND CHARS AGAIN
JRST ADVLOP
TYPADV: UTYPE [ASCIZ /
CMND EFFECT
---- ------
<CTRL>E Quit
<CTRL>^+ Relink to remote terminal
<CTRL>^( Start comment
<CTRL>^) End comment
<CTRL>^? Type this list
<CTRL>^<CHAR> Send <CTRL><CHAR>
/]
JRST ADVLOP
RELINK: MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
MOVE B,ADVTNM
TLINK ;PUT HIS OUTPUT ON OUR TERMINAL
JRST [ TYPE <
TLINK failure
>
JRST ADVLOP]
TYPE < [Advising]
>
JRST ADVLOP
ESCPSI::SKIPN ADVFLG
DEBRK ;JUST IN CASE
ADVDON: CALL ICLEAR ;DISMISS INTERRUPT TO .+1
CALL DOATI ;FIX ^C AND ^E (DO HERE SO ^C WORKS IF REMOTE IS XOFFED)
CALL FIXON ;FIX PAGE MODE
ADVMES::TYPE <
[Advice terminated]
>
MOVEI Q1,ETTYMD
CALL LTTYMD ;RESTORE TTY MODES
MOVE B,ADVTNM ;GET TERMINAL WE WERE ADVISING
CALL BREAK1 ;BREAK LINKS
SETZM ADVFLG
MOVE A,ADVJFN ;GET SPECIAL JFN AGAIN
CLOSF ;RELEASE IT
ERCAL CJERRE ;SHOULDN'T FAIL
JRST ERRET ;ERROR RETURN TO TTY MODES RESET
;"LIST" IS WITH "TYPE" BELOW.
;LOGIN COMMAND
;LOGIN (USER) NAME (ACCOUNT) ACCOUNT (SESSION-REMARK) REMARK
;PASSWORD: PASSWORD
.LOGIN::TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT>
SKIPE CUSRNO
ERROR <You are already logged in>
;DECODE ARGUMENTS
;FIRST ARGUMENT: USER NAME
NOISE <USER> ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
SETZM LERRF ;NO ERROR YET
CALL USERN ;INPUT USER NAME, TRANSLATE TO USER # IN A
JRST [ MOVEM A,LERRF ;FAILED, REMEMBER
MOVEI B,[FLDDB. .CMUSR,CM%PO] ;TRY TO READ PARSE-ONLY NAME
CALL FLDSKP
CMERRX ;IF THAT FAILS, GIVE UP
JRST .+1]
MOVEM A,RCBITS ;SAVE INFO RETURNED BY "RCDIR"
MOVEM C,LOGNO ;SAVE DIRECTORY NUMBER
CALL NOECHO ;NOISE STUFF WAITS FOR A CHARACTER!
NOISE (PASSWORD)
CALL PASFLD ;READ THE PASSWORD
MOVEM A,LPASP ;REMEMBER POINTER TO PASSWORD
NOISE <ACCOUNT>
MOVEI A,0 ;NO SPECIAL BITS FOR RCDIR
MOVE B,LOGNO ;USER NUMBER
SKIPE LERRF ;USER NAME CORRECT?
JRST LOGIN1 ;NO, SO DON'T TRY TO SET UP ACCOUNT DEFAULT
RCDIR ;GET LOGGED-IN DIRECTORY NUMBER
MOVE A,C ;PUT DIR NUMBER INTO A
MOVE B,LPASP ;GET POINTER TO PASSWORD
MOVEI C,LDBLK ;GET ADDRESS TO USE FOR CRDIR BLOCK
CALL GETDRP ;GET ACCOUNT FOR DEFAULT
JRST LOGIN1 ;FAILED, ASSUME NO DEFAULT
MOVEM A,CMDEF ;USE DEFAULT ACCOUNT AS DEFAULT FOR FIELD
ILDB A,A ;GET FIRST CHARACTER
CAIN A,0
LOGIN1: SETZM CMDEF ;NO DEFAULT
CALL ACCT ;INPUT AND DECODE ACCT # (USES A)
MOVEM A,LACCT ;SAVE FOR LOGIN JSYS
NOISE (SESSION-REMARK)
CALL GSR ;GET SESSION-REMARK
MOVE Q1,A ;SAVE POINTER TO SESSION-REMARK
CONFIRM ;CONFIRM THE WHOLE COMMAND
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN
NEWF,<
GTAD ;SET UP MAIL WATCH INTERVAL HERE
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT ; IN CASE "MESMES" NEVER CALLED
>
SETOM MESMSF ;SAY TYPE "YOU HAVE A MESSAGE" IF APPROPRIATE,
;EVEN AFTER ^C'S
SKIPE A,LERRF ;ERROR ALREADY?
ERROR <%1?> ;YES, PRINT MESSAGE INSTEAD OF TRYING TO LOG IN
CALL PIOFF ;^C BETWEEN LOGIN AND CUSRNO SETUP WOULD BE EMBARRASING
MOVE C,LACCT ;ACCT # OR PTR THERETO
MOVE B,LPASP ;PASSWORD PTR
MOVE A,LOGNO ;USER #
MOVE D,C ;GET ACCT STRING
ILDB D,D ;LOOK AT FINAL ACCOUNT
SKIPN D ;HAVE ONE?
SETZM C ;NO. USE NOTHING
MOVEI D,0 ;RESERVE D FOR FUTURE FLAGS
LOGIN
JRST [ CAIN A,LGINX1
ERROR <Illegal account>
CAIN A,LGINX4
ERROR <Incorrect password>
CALL CJERRE] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
SETOM SYSMF ;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
MOVE B,LOGNO ;WHAT "RCUSR" RETURNED
MOVEM B,CUSRNO ;STORE USER NUMBER
MOVEM A,LOGDAT ;SAVE DATE OF LOGIN
GJINF ;GET LOGGED-IN DIRECTORY NUMBER
MOVEM B,LIDNO ;SAVE IT.
CALL PION ;ALLOW ^C NOW THAT CUSRNO IS SET UP
MOVE A,Q1 ;POINTER TO SESSION REMARK
CALL SSR ;SET SESSION-REMARK
;LOGIN...
;THE AUTOLOGOUT FOR USE TO GET KILLED HERE, NOW WE MUST KILL OFF THE
;PENDING TIMER CLOCK
MOVE A,[.FHSLF,,.TIMBF] ;DELETE ALL ENTRIES BEFORE GIVEN TIME
MOVE B,[377777,,-1] ;TIME WAY OUT IN THE BOONIES (WON'T
;CLOBBER ANY RUNTIME LIMIT SETTING
SETZ C,
TIMER
JFCL ;DON'T CARE IF NONE PENDING
;TYPE "JOB <N> ON LINE N <DATE> <TIME>"
ETYPE < Job %J on %L %D %E
> ;EOL NEEDED BEFORE LOGIN MESSAGE
MOVE B,RCBITS ;WHAT RCUSR RETURNED
TXNE B,RC%RLM ;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
SETZM LOGDAT ;SET DATE TO 0 TO FORCE PRINTING
NONEWF,<
;TYPE "YOU HAVE A MESSAGE" IF A FILE "MAIL.TXT.1" OF NON-0 LENGTH
; EXISTS IN THIS DIRECTORY.
CALL MESMES
>
;GET DEFAULT EXEC INPUT FILE
SETOM LOGINI ;SET FLAG TO DO "TAKE INITIAL-LOGIN-TYPIN.TXT"
;AT NEXT OPPORTUNITY.
RET
;SIMULATE "TAKE" COMMAND OF FILSPEC (STRING POINTER IN B)
;SKIPS IFF SUCCEEDS IN SETTING UP STREAM
TAKEIN::STKVAR <<TAKBUF,FILWDS>,SPB>
MOVEM B,SPB ;SAVE STRING POINTER
MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
HRROI A,TAKBUF ;GET STRING SPACE POINTER
CAMN B,[-1] ;DEFAULT?
JRST TAKEI1 ;YES, SKIP DIR
DIRST ;STORE DIR STRING
CALL JERR ;WE JUST SCANNED IT?!
TAKEI1: MOVE B,A
MOVE A,SPB
SETZ C, ;READ TO NULL
SIN ;APPEND TO STRING
HRROI B,TAKBUF ;GET POINTER TO BEGINNING
CALL TRYGTL ;TRY TO FIND IT.
JRST TAKIN2 ;NO SUCH FILE, GO AWAY QUIETLY
MOVE B,[70000,,OF%RD]
OPENF
JRST [ HRROI B,TAKBUF ;GET POINTER FOR ERROR MESSAGE
LERROR <Can't read %2m%%_%%1?>
HRRZ A,JBUFP
HRRZ A,(A) ;GET SAVED JFN
RLJFN ;RELEASE IT
CALL JERR
HRRZ A,JBUFP
SETOM (A)
RET]
HRL A,A ;PUT INPUT JFN IN LEFT HALF
HRR A,COJFN ;USE SAME OUTPUT AS WERE USING
MOVE B,TAKDEF ;USE DEFAULT SETTINGS
CALL PUSHIO ;SAVE OLD IO STREAM, START NEW ONE
RETSKP ;DOUBLE RETURN WHEN SUCCESSFUL
TAKIN2: RET ;FAILED, TAKE SINGLE RETURN
;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF P2=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
; MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
; (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
; AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.
;THIS UNWRITTEN ROUTINE SHOULD SOMEHOW ALLOW CARRIAGE RETURN
;IN THE MIDDLE OF COMMANDS, SUCH THAT THE GUIDE WORDS FOR THE NEXT
;FIELD COME OUT ON THE NEW LINE, AS THOUGH THE CR WAS $. BEWARE
;OF THE FOLLOWING PITFALLS OF THIS:
;1) ON REPARSE, GUIDEWORDS ARE ALREADY IN BUFFER, SO SOMEHOW
; REPARSED CR SHOULD DO NOTHING. NOTE THAT REPARSED $ IS
; NONEXISTANT, AS $ CAUSES ACTION BUT DOESN'T STAY IN
; BUFFER. YOU CAN'T AFFORD NOT TO LEAVE CR IN BUFFER,
; BECAUSE ^R AND RUBOUT WON'T WORK CORRECTLY, ESPECIALLY
; ON SCREEN TERMINALS.
;2) IF THE CR PROVOKED GUIDEWORDS ARE IMPLEMENTED AS PROMPTS,
; RUBBING OUT WON'T WORK. USER WILL JUST GET A DING.
;3) MOST DESIRABLY, CR IN THE MIDDLE OF COMMANDS SHOULD WORK
; FOR ALL COMMANDS, NOT JUST SPECIAL ONES LIKE LOGIN,ATTACH.
; THIS CREATES A PROBLEM WITH CASES WHERE A FIELD HAS A
; DEFAULT VALUE. CONSIDER THE AMBIGUITY UPON SEEING
; CR: DOES THE CR MEAN DEFAULT THE FIELD VALUE, OR
; TYPE THE GUIDEWORDS. FOR INSTANCE, SHOULD "DIRECTORY<CR>"
; TYPE "(OF FILES)", OR DEFAULT THE FILE SPEC TO *.* AND
; TAKE OFF?
RET
;USERN
;INPUT USER NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS RCUSR'S RETURNED INFO IN A,B,C.
;SKIPS, BUT NOT IF BAD NAME TYPED, IN WHICH CASE A CONTAINS ERROR CODE
USERN: USERX <User name>
JRST [ CALL %GETER ;FAILED, FIND OUT WHY
MOVE A,ERCOD ;RETURN ERROR IN A
RET]
CALL BUFFF ;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
MOVE B,A
MOVSI A,(RC%EMO) ;SAYS NO RECOGNITION
RCUSR ;STRING TO DIRECTORY # TRANSLATION
RETSKP
;ACCT
;RUTINE TO INPUT ACCOUNT STRING, RETURNS SUITABLE ARG
;FOR LOGIN OR CACCT JSYS.
;USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.
ACCT:: ACCTX <Account name>
CMERRX
JRST BUFFF ;STRING CASE. SAVE IN BUFFER.
;PASWD
;SUBROUTINE TO INPUT PASSWORD FOR "LOGIN", "ATTACH", AND "CONNECT".
;HANDLES HALF AND FULL DUPLEX CASES.
;BUFFERS IT FOR USE AS A JSYS ARGUMENT AND RETURNS BYTE PTR IN A.
PASLIN::MOVEI A,[ASCIZ /Password: /]
PASSX:: MOVEI C,1
CALL NOECHO ;PROMPT TYPER LOOKS AT ONE INPUT CHARACTER SO TURN OFF ECHOING FIRST
UPROMPT @A ;TYPE PROMPT
CALL PASWD ;SPR 13716
CONFIRM ;SPR 13716
RET ;SPR 13716
PASFLD::TDZ C,C ;FOR A PASSWORD FIELD, NO CRLF WANTED (IE LOGIN)
PASWD:: CALL NOECHO ;MAKE SURE ECHOING OFF
CALL CHKPTY ;SKIP IF NOT A PTY
JRST PASWDF ;PTY - HANDLE FULL DUPLEX CASE ONLY
MOVE A,CIJFN
RFMOD ;READ TTY MODE
TRNE B,1B32 ;SKIP IF FULL DUPLEX
JRST PASWD1
;FULL DUPLEX CASE
;DON'T ECHO PASSWORD FIELD, DO ECHO TERMINATOR
PASWDF: CALL INPPAS ;INPUT THE PASSWORD
CALL DOECHO ;NOW WE WANT ECHOING ON
CALL GETTER ;GET THE TERMINATING CHARACTER
CAIE A,.CHCRT ;END OF LINE?
CAIN A,.CHLFD
CAIA ;YES
JRST PSWDF1 ;NO
MOVE A,CIJFN ;YES, SEE IF IT GOT ECHOED
RFPOS
TRNE B,-1 ;ARE WE AT COLUMN 1?
ETYPE <%_> ;NO, TYPE A CRLF
PSWDF1: CALLRET BUFFF ;BUFFER PASSWORD AND CHECK IT IF POSSIBLE
;PASWD...
;HALF DUPLEX CASE
;USE SEPARATE LINE, TYPE MASK FIRST
PASWD1: TYPE <
>
UPROMPT [BYTE (7)130,130,130,130,130,130,130,130,130,15
BYTE (7)127,127,127,127,127,127,127,127,127,15
BYTE (7)115,115,115,115,115,115,115,115,115,15
BYTE (7)15,15,0]
;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
CALL INPPAS ;INPUT THE PASSWORD
PRINT CR ;SET TO OVERPRINT SAME LINE
TYPE <Thank you ... >
ETYPE<%_>
ETYPE<%_>
CALLRET BUFFF ;BUFFER AND MAYBE CHECK PASSWORD
;ROUTINE TO INPUT THE PASSWORD
INPPAS: JUMPE C,INPP1 ;DO THIS ONLY IF CRLF IS NEEDED
STKVAR <SAVFLG,SAVPTR>
MOVE A,CMFLG
MOVEM A,SAVFLG ;SAVE FLAGS IN CASE REPARSE IS NEEDED
MOVE A,CMPTR
MOVEM A,SAVPTR
CRRX <Password> ;HAVE TO TRY CR SO COMND DOESN'T RETYPE "PASSWORD:" IF HE TYPES NULL PASSWORD
JRST INPP1 ;NOT NULL PASSWORD
MOVE A,SAVFLG ;UNPARSE THE CARRIAGE RETURN
MOVEM A,CMFLG ;CALLERS WILL PARSE CONFIRM AFTER PASSWORD
MOVE A,CMPTR ;SEE WHERE WE ARE ON LINE NOW
MOVE B,SAVPTR ;SEE WHERE WE WERE AT BEGINNING OF LINE
MOVEM B,CMPTR ;RESET FIELD POINTER TO BEGINNING OF LINE
CALL SUBBP ;GET NUMBER OF CHARACTERS WE WANT TO BACK UP
ADDM A,CMINC ;INCREASE NUMBER OF UNPARSED CHARACTERS
ADDM A,CMCNT ;SHOW INCREASE IN SPACE LEFT
SETZM ATMBUF ;DENOTE NULL PASSWORD
RET
;**;[903] Add 1 line at INPP1 YKT 1-SEP-82
INPP1: MOVE Q3,[ASCIZ /PSWD/] ;[903] SET THE FLAG
WORDX <Password> ;READ NON-NULL PASSWORD
CMERRX
RET
;MESMES
;SUBROUTINE TO TYPE "YOU HAVE A MESSAGE" IF FLAG "MESMSF" IS ON AND
;THERE IS A MESSAGE FILE IN CONNECTED DIRECTORY.
;USED IN LOGIN, MAIN LOOP. CLOBBERS A,B,C.
MESMES::SKIPN CUSRNO
JRST MESMS9 ;IGNORE IF NOT LOGGED IN
SKIPE BATCHF ;DON'T CHECK FOR MESSAGES IN BATCH (TO SAVE TIME)
JRST MESMS9 ;YES, SKIP MESSAGES
CALL CHKDAL ;NOTE OVER ALLOCATION IN PRESENT FIRST
NONEWF,<
MOVE B,CUSRNO ;THE USER NUMBER TO CHECK FOR MAIL
CALL MALCHK ;CHECK FOR NEW MAIL
JRST MESMS9 ;NO NEW MAIL, NO PRINTOUT
TYPE < You have a message
> ;USER TYPES FILE TO RECEIVE MESSAGE
>
NEWF,<
HRLOI B,377777 ;SET INF COUNT FOR US
MOVEM B,MWATN0
MOVE B,CUSRNO ;SET UP FOR MAIL CHECK FOR THIS USER
MOVEM B,MWATDR
CALL MALCHK ;DO MAIL CHECK
JRST MESMS9 ;NO MAIL
TYPE < You have >
TLNN B,77 ;CHECK NETWORK MAIL FLAG
TYPE <net >
ETYPE <mail %1\%%_%>
>
MOVE A,COJFN
DOBE ;WAIT FOR IT TO REALLY PRINT
NEWF,<
GTAD ;SET UP NEXT LOOK TIME
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT
>
MESMS9: SETZM MESMSF ;CLEAR FLAG SO IT WONT BE REPEATED
RET
;CHKPTY - SKIPS IF NOT RUNNING ON PSEUDO-TELETYPE
CHKPTY::PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SETZ D,
GTB .PTYPA ;GET PSEUDO TTY PARMS
HRRZ D,A ;SAVE FIRST PTY NUMBER
PUSH P,D ;FIRST PTY ON STACK
HLRZ A,A ;NUMBER OF PTY'S
ADDI D,(A) ;LAST PTY NUMBER PLUS ONE
MOVNI A,1
MOVE B,[XWD -1,C] ;1 WORD INTO C
MOVEI C,.JITNO ;READ TERMINAL NUMBER
GETJI
CALL JERR
POP P,A ;RESTORE FIRST PTY NUMBER
CAML C,A ;ARE WE A PTY? (DET IS -1)
CAML C,D
AOS -4(P) ;NO, SKIP
POP P,D
POP P,C
POP P,B
POP P,A
RET
;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS: +1: NO SUCH FILE
; +2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.
;**;[738] Insert 4 lines at TRYGTO:+0L KR 2-JUN-82
TRYGTS::PUSH P,B ;[738]THIS IS CALLED FROM CTRL/E-SPEAK
PUSH P,A ;[738]
MOVSI A,(GJ%FOU!GJ%SHT!GJ%PHY) ;[738]
JRST TRYGT1 ;[738]
TRYGTO::PUSH P,B
PUSH P,A
MOVSI A,(GJ%FOU!GJ%SHT)
JRST TRYGT1
TRGTV1::PUSH P,B
PUSH P,A
MOVE A,[GJ%OLD!GJ%SHT+1] ;OLD FILE, SHORT CALL, VERSION 1
JRST TRYGT1
TRYGTL: PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC) ;OLD FILE, SHORT, NO ACCESS
JRST TRYGT1
TRYGTJ::PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY AND SHORT FORM
TRYGT1: CALL GTJFS ;ASSIGN JFN USING STRING POINTER IN B
JRST [ POP P,A ;LOSE, ERROR RETURN
JRST TRYG9]
SUB P,[XWD 1,1] ;FORGET SAVED A
AOS -1(P) ;SKIP
TRYG9: POP P,B
RET
;LOGOUT
.LOGOU::
SKIPN CUSRNO ;LOGGED IN?
JRST LOGOU1 ;NO, ONLY ONE CASE
DECX <Carriage return or job number>
JRST LOGOU1 ;NO NUMBER TYPED, LOG OUT THIS JOB
MOVE A,B ;PUT JOB NUMBER IN A
JRST ..LOGO ;GO LOG OUT REMOTE JOB
LOGOU1: CONFIRM
XTND,<
CALL BLANK1 ;CLEAR SCREEN
CALL DWNPNT ;INFORM DOWNTIME
>
SKIPN CUSRNO
JRST LOGOU2
GJINF ;GET CONNECTED DIRECTORY NUMBER
CAMN B,LIDNO ;DIFFERENT FROM LOGGED-IN ONE?
JRST LOGOU3 ;NO SO DON'T BOTHER EXPUNGING CONNECTED DIR
LDF A,DD%DTF ;FLUSH TEMPORARY FILES
DELDF ;EXPUNG CONNECTED DIR
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE<%_>
JRST .+1]
CALL CHKDAL ;NOW CHECK IT
LOGOU3: MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
LDF A,DD%DTF ;FLUSH TEMPORARY FILES ALSO
DELDF
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE<%_>
JRST .+1]
MOVE A,LIDNO
GTDAL ;GET USAGE/ALLOCATION
ERJMP [TYPE <%Warning -- Couldn't get allocation info, continuing...>
ETYPE <%_>
JRST LOGOU2]
JUMPE B,LOGOU2 ;CAN'T BE OVER IF USAGE=0
SUB B,C ;SUBTRACT PERMANENT ALLOCATION FROM USAGE
SKIPLE B ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
LOGOU2: TLO Z,LOGOFF ;SAY LOGGING OUT (TELLS ERROR AND ^C
;ROUTINES TO SAY "NOT LOGGED OUT AFTER ALL").
MOVE A,COJFN
DOBE ;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.
;SET MAP TO "USER"
SETO A, ;SAY ITS SUICIDE
LGOUT
CALL CJERR
;DOESN'T RETURN ON SUCCESS
;"MERGE" IS WITH "GET" ABOVE.
; 'PUSH' = 'PUSH EXEC' (FORMERLY 'EXEC')
; - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'
.PUSH:: NOISE (COMMAND LEVEL)
CONFIRM
REPEAT 0,<
CALL PNTMES ;MAKE SURE SYSTEM MESSAGES HAVE BEEN SEEN BEFORE DOING "PUSH"
>
MOVSI 1,(1B2+1B17)
HRROI 2,[GETSAVE(<SYSTEM:EXEC.>)]
CALL TRYGTJ ;GTJFN AND SAVE IT
ERROR <EXEC not found>
PUSH P,1
MOVSI 1,(1B1) ;XMIT CAPS
CFORK
CALL CJERR
MOVEM 1,EFORK
POP P,1
HRL 1,EFORK
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED
MOVE 1,EFORK
SETZ 2,
SFRKV
ERJMP CJERRE
WFORK
RFSTS
MOVE C,A
MOVE A,EFORK
SETZM EFORK
KFORK
CAME C,[1B0+2B17]
CAMN C,[2B17] ;VOLUNTARY TERMINATION IS NORMAL
RET
ERROR <PUSH terminated abnormally - Fork status = %3O, PC = %2P>
;'POP' = 'POP EXEC' - POP TO HIGHER LEVEL EXEC
.POP:: NOISE (COMMAND LEVEL)
CONFIRM
CALL INFER ;TEST FOR EXISTENCE OF SUPERIOR FORK
ERROR <No higher command level>
JRST QUIT2 ;GO DO HALTF, ETC.
;QUIT: EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.
;IF TOP-LEVEL FORK, LEGAL ONLY FOR ENABLED WHEELS OR OPERS.
.QUIT:: CALL INFER ;SKIP IF INFERIOR
JRST [ MOVX B,WHLU+OPRU
SKIPE PRVENF
CALL PRVCK
ERROR <Not legal in top-level EXEC>
JRST .+1]
QUIT2: MOVE A,SAVT20 ;GET STATE BEFORE WE RAN
CALL SETMOD ;RESTORE IT
MOVE A,SAVNAM ;GET SAVED PROGRAM NAME
SETNM ;RESTORE IT
HALTF
JRST REE ;IN CASE OF RETURN FROM MINI-EXEC
;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ^E EDDT.
INFER:: ATSAVE
MOVEI 1,.FHTOP ;SAY TOP FORK
SETZ 2, ;SAY NO HANDLES OR STATUS
MOVEI 3,1(P) ;SAY BUILD STRUCTURE ON STACK
HRLI 3,-4 ;BUT 4 WORDS MAX
ADD P,[4,,4] ;MAKE ROOM ON STACK
GFRKS ;GET 'STRUCTURE' OF TOP FORK
CALL [ CAIE 1,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
RET] ;YES, WE EXPECT THAT
HRRZ 1,1(3) ;GET HANDLE OF TOP FORK
SUB P,[4,,4] ;CLEAR STACK
CAIN 1,.FHSLF ;IS IT SELF?
RET ;YES, WE ARE TOP AND HAVE NO SUPERIOR
RETSKP ;NO, WE ARE AN INFERIOR
;RECEIVE (LINKS)
.RECEI::TLZ Z,F4 ;SAY RECEIVE CMD
CALL RECREF ;CALL RECEIVE/REFUSE SUBR
MOVE A,[1B5+1B7+.CTTRM]
JUMPE Q1,REC2 ;IF Q1 STILL 0, ASSUME SYSTEM-MESSAGES
TDO A,Q1 ;GET ENABLE BITS
TLINK
CALL JERR
JRST CMDIN4
RECREF: SETZ Q1, ;ACCUMULATE LINKS/ADVICE BITS HERE
KEYWD $LNADV
T LINKS,,.RELNK
JRST CERR
SETZ Q2,
CALL (P3)
CONFIRM ;GET CONFIRMATION
RET
$LNADV: TABLE
T ADVICE,,.READV
T LINKS,,.RELNK
T SYSTEM-MESSAGES,,[RET]
TEND
.READV: TLO Q1,(1B6)
TLNE Z,F4 ;RECEIVE?
RET ;NO - RETURN
TLO Q1,(1B4) ;LINKS TOO
NOISE <AND LINKS>
RET
.RELNK: TLNE Z,F4 ;WHICH KIND?
NOISE <AND ADVICE>
TLO Q1,(1B4)
RET
;REFUSE (LINKS)
.REFUS::TLO Z,F4 ;SAY REFUSE CMD
CALL RECREF ;CALL RECEIVE/REFUSE SUBR
MOVEI A,.CTTRM
JUMPE Q1,REF2 ;IF NO BITS ON IN Q1, ASSUME SYSTEM-MESSAGES
HLL A,Q1 ;COPY ENABLES FROM SUBR
TLINK
CALL JERR
JRST CMDIN4
;REFUSE SYSTEM-MESSAGES
REF2: MOVEI C,.MOSMN ;SAY REFUSE
REF1: MOVEI A,.CTTRM
MOVEI B,.MOSNT ;FUNCTION CODE FOR CONTROLLING MESSAGES
MTOPR ;DO IT
ERCAL CJERRE ;COULDN'T
RET
;RECEIVE SYSTEM-MESSAGES
REC2: MOVEI C,.MOSMY
JRST REF1
;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>
;**;[985] Remove next line YKT NOV-10-83
;**;[972] Add one line at .RENAM+0L YKT 01-AUG-83
.RENAM::
; TRO Z,F4 ;[985][972]
SETOM TYPGRP ;TYPE ALL FILES
NOISE <EXISTING FILE>
CALL INFGNS ;GET INPUT FILE GROUP WITH NO SEARCH
NOISE <TO BE>
CALL MFOUT ;GET MULTI FILE OUTPUT TERM
CONFIRM
HLRZ A,JBUFP
CAIL A,-2 ;WILL NEED 2 MORE FOR PROCESSING
ERROR <Too many JFNs in command>
MOVE A,JBUFP
MOVEM A,.JBUFP ;SAVE THESE JFNS
RENAM1: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX FILE TERM
JRST RENAM2
CALL TYPIF ;TYPE INPUT NAME IF GROUP
CALL MFSET ;SET UP OUTPUT TERM
JRST [ CALL GNFIL ;ERROR, MESSAGE ALREADY PRINTED
SETZM INIFH1 ;CLEAR WHEN NO MORE
JRST RENAM2]
CALL MFINP ;GET SECOND JFN ON INPUT JFN
JRST RENAM2
HRRZ B,OUTDSG ;GET OUTPUT DESCRIPTOR
RNAMF ;RENAME FILE
ERJMP [LERROR <%1?> ;TELL USER WHY IT FAILED
JRST RENAM2] ;GO ON TO NEXT FILE
CALL TYPOK
RENAM2: SKIPE INIFH1 ;DID LAST GNFIL HIT END?
JRST RENAM1 ;NO
RET
;REQUEST A FILE BE RETRIEVED FROM OFFLINE STORAGE
.RETRI::STKVAR <NRETR>
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,0 ;DEFAULT VERSION IS 0
HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
TXZ Z,IGINV
RETRI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
SETZM NRETR ;KEEP TRACK OF HOW MANY RETRIEVED
RETRI3: CALL RLJFNS
CALL NXFILE
JRST RETRI4
CALL MFINP ;GET 2ND JFN
JRST RETRI4 ;FAILED
MOVE B,[1,,.FBCTL]
MOVEI C,C ;FIND OUT IF FILE IS OFFLINE
GTFDB
ERJMP RETRI4 ;SKIP FILE IF CAN'T FIND OUT
TXNN C,FB%OFF ;IS IT OFFLINE?
JRST RETRI4 ;NO, CAN'T POSSIBLEY RETRIEVE IT
ETYPE < %1S> ;TYPE FILE NAME - SHOULD USE TYPIF
;BUT NXFILE MAY HAVE STEPPED US OFF
;THE END CAUSING TYPIF TO LOSE BIG
MOVEI B,.ARRFR ;REQUEST TO RETRIEVE IT
SETZ C, ;NO FLAGS
ARCF
ERJMP [ETYPE < %?
>
JRST RETRI4]
CALL TYPOK
AOS NRETR ;REMEMBER HOW MANY
RETRI4: SKIPE INIFH1 ;DONE THEM ALL?
JRST RETRI3 ;NO, LOOP
SKIPN NRETR ;DON'T BE TOO QUIET IF NOTHING DONE
ETYPE <%%No files found for retrieving%_>
RET
;^ESEND (MESSAGE) TO ALL ON SYSTEM
.SEND:: TRVAR <SNDPT,SNDLNO>
NOISE (TO)
OCTX <Octal line # or * for all>
CAIA ;NO NUMBER TYPED
JRST SENDA ;NUMBER TYPED.
STARX ;SEE IF "*" TYPD
CMERRX <Octal line number or * required>
SETO B, ;NOTE "*" WITH -1
SENDA: MOVEM B,SNDLNO ;SAVE LINE NUMBER
MOVE A,CSBUFP ;GET POINTER TO STRING BUFFER
MOVEM A,SNDPT
CALL SCRLF ;INSERT INITIAL CRLF
MOVEI Q1,"[" ;BEGIN MESSAGE
IDPB Q1,SNDPT
MOVE A,SNDPT ;GET POINTER
HRROI B,[ASCIZ /From /]
SETZ C,
SOUT ;"[FROM ...."
MOVE B,CUSRNO ;GET USER NAME
DIRST ;PUT NAME SO PEOPLE WILL KNOW WHO'S SENDING OBSENITIES
CALL JERR ;SHOULDN'T FAIL
PUSH P,A ;SAVE OUTPUT DESIGNATOR
GJINF ;FIND OUT ABOUT MY JOB
POP P,A ;RESTORE AC
JUMPL D,DETSND ;SKIP ON IF WE'RE DETACHED
HRROI B,[ASCIZ / on line /] ;GET SOME MORE TEXT
SETZ C,
SOUT ;STORE IT
MOVE B,D ;GET NUMBER IN RIGHT AC
MOVEI C,^D8 ;OCTAL OUTPUT
NOUT ;STORE TERMINAL NUMBER
CALL JERR
DETSND: HRROI B,[ASCIZ /: /]
SKIPGE SNDLNO ;IF SENDING TO ALL, SAY SO
HRRI B,[ASCIZ / to all: /]
SETZ C,
SOUT ;"[From OPERATOR on line 1: ..."
MOVEM A,SNDPT ;UPDATE POINTER TO MESSAGE
LINEX <Message to be sent>
CMERRX
CONFIRM ;GET CONFIRMATION
MOVE A,SNDPT ;GET POINTER TO MESSAGE SO FAR
HRROI B,ATMBUF ;COPY MESSAGE FROM ATOM BUFFER
MOVEI C,0 ;STOP ON NULL
SOUT
MOVEM A,SNDPT ;UPDATE POINTER
MOVEI Q1,"]"
IDPB Q1,SNDPT ;WITH CLOSE BRACKET
CALL SCRLF ;AND TERMINATE WITH CRLF
MOVEI Q1,0 ;GUARANTEE NULL
IDPB Q1,SNDPT ; AT END
MOVE A,CSBUFP
CALL SNDFIX ;FORMAT TEXT SO NONE LOST AT END OF LINES
MOVE B,A ;COPY POINTER TO MESSAGE
MOVE A,SNDLNO ;RESTORE LINE(S) FOR MESSAGE
SKIPL A ;SENDING TO PARTICULAR TERMINAL?
ADDI A,.TTDES ;YES, ADD IN TERMINAL DESIGNATOR
TTMSG ;DO IT
ERJMP CJERRE ;IN CASE OF LOSAGE
CALL UNMAP ;UNMAP BUFFER PAGE
RET ;RETURN
;SNDFIX - ROUTINE TO BREAK UP LONG ^ESEND TEXT INTO MULTIPLE LINES
;
;ACCEPTS IN A/ POINTER TO ORIGINAL TEXT
; CALL SNDFIX
;RETURNS: +1 ALWAYS, WITH A/ POINTER TO NEW TEXT
SNDSIZ==^D71 ;MAX SIZE OF ^ESEND LINES
SNDFIX: MOVE C,[POINT 7,BUF0] ;GET POINTER TO NEW STRING
SNDFX1: MOVSI D,-SNDSIZ ;GET MAX SIZE FOR ^ESEND LINES
SNDFX2: ILDB B,A ;GET A CHARACTER FROM INPUT STRING
IDPB B,C ;DEPOSIT CHARACTER IN NEW STRING
JUMPE B,SNDFX3 ;IF END OF STRING, ALL DONE
AOBJN D,SNDFX2 ;LOOP OVER A LINE-FUL OF CHARACTERS
MOVX B,.CHCRT ;GET A CARRIAGE RETURN
IDPB B,C ;ADD RETURN TO STRING
MOVX B,.CHLFD ;GET A LINE FEED
IDPB B,C ;FORM NEW LINE
MOVX B," " ;GET A BLANK
IDPB B,C ;INDENT SUCCESSIVE LINES
JRST SNDFX1 ;GO ADD REMAINDER OF STRING
SNDFX3: MOVE A,[POINT 7,BUF0] ;GET POINTER TO START OF STRING
RET ;DONE, RETURN
;SCRLF - ROUTINE TO ADD CRLF TO INITIAL STRING ASSEMBLED BY ^ESEND
SCRLF: MOVEI Q1,CR ;INSERT CRLF SEQUENCE
IDPB Q1,SNDPT ; INTO MESSAGE
MOVEI Q1,LF
IDPB Q1,SNDPT ;...
RET
;TAKE (EXEC INPUT FROM) FILESPEC
.TAKE:: TRVAR <TAKCON,JFN1,JFN2> ;CELLS TO HOLD NEW JFNS
NOISE <COMMANDS FROM>
SETZM JFN1 ;INDICATE NO INPUT JFN YET
MOVE A,TAKDEF ;GET THE DEFAULTS
MOVEM A,TAKCON ;REMEMBER SETTINGS BEFORE SUBCOMMANDS CHANGE THEM
MOVE A,COJFN
MOVEM A,JFN2 ;DEFAULT NEW JFNS TO OLD
DEXTX <CMD> ;DEFAULT INPUT EXTENSION IS CMD
MOVX A,GJ%OLD+GJ%ACC ;OLD FILE ONLY AND DON'T LET INFERIORS KILL IT
MOVEM A,CJFNBK+.GJGEN ;STORE FLAGS
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to end current command level>,,[
FLDDB. .CMCMA,CM%SDH,,<Comma to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Command file name>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED!
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST PRIRES ;YES
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GET SUBCOMMANDS
MOVEM B,JFN1 ;REMEMBER FIRST JFN
NOISE <LOGGING OUTPUT ON>
DEXTX <LOG> ;DEFAULT OUTPUT EXTENSION IS LOG
MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
MOVEM A,CJFNBK+.GJGEN ;AND DON'T LET INFERIORS TOUCH THIS JFN
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return if no change of output desired>,,[
FLDDB. .CMCMA,CM%SDH,,<Comma for no change, but to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Output file name>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST TAKE1 ;YES, DON'T CHANGE OUTPUT SIDE
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GO GET SUBCOMMANDS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
MOVEI Q1,0 ;FIRST ASSUME NO SUBCOMMANDS
COMMAX <Comma to enter subcommands, or confirm with carriage return>
CAIA ;NO SUBCOMMANDS COMING
MOVEI Q1,1 ;SUBCOMMANDS COMING
CONFIRM ;REQUIRE CONFIRMATION AFTER FILE NAME
JUMPE Q1,TAKE1 ;SKIP SUBCOMMAND STUFF IF NO COMMA
CAIA ;WE'VE ALREADY GOT CONFIRMATION
TAKEC: CONFIRM
SUBCOM $TAKE ;DO THE SUBCOMMANDS
TAKE1: SKIPN A,JFN1 ;INPUT FILE TYPED?
RET ;NO, THIS IS A NO-OP
MOVE B,[XWD 70000,OF%RD]
OPENF
ERCAL CJERRE ;COULDN'T OPEN TAKE FILE
MOVE A,JFN2
MOVE B,COJFN ;GET OLD OUTPUT
CAIN A,(B) ;OUTPUT BEING CHANGED?
JRST TAKE33 ;NO
MOVE B,[XWD 70000,OF%APP]
OPENF
ERCAL CJERRE ;GO PRINT ERROR MESSAGE
TAKE33: HRL A,JFN1 ;GET XWD INPUT,OUTPUT
MOVE B,TAKCON ;GET DESIRED SETTING FOR NESTED TAKE
CALLRET PUSHIO ;START NEW STREAM, REMEMBER OLD
PRIRES: CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
RET ;NOTHING TO CLOSE (WE'RE AT TOP LEVEL)
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL
RET
;SUBCOMMANDS TO "TAKE" COMMAND
$TAKE: TABLE
T ALLOW ;IGNORE ERRORS DURING TAKE
T DISALLOW ;STOP ON ERRORS DURING TAKE
T ECHO ;ECHO COMMANDS IN TAKE FILE
T LOG-FILE,,.TKLOG ;FILE TO LOG OUTPUT ON
T NO,,.NOTAK ;NO
TEND
.ALLOW: CALL ALONOI
MOVX A,TKALEF ;BIT TO ALLOW ERRORS
IORM A,TAKCON ;TURN IT ON
RET
.DISAL: CALL ALONOI
MOVX A,TKALEF ;BIT FOR ALLOWING ERRORS
ANDCAM A,TAKCON ;TURN IT OFF
RET
.ECHO: CALL ECHNOI
MOVX A,TKECOF ;FLAG TO ALLOW ECHOING
IORM A,TAKCON ;TURN IT ON
RET
.TKLOG: DEXTX <LOG> ;DEFAULT OUTPUT EXTENSION IS LOG
MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
MOVEM A,CJFNBK+.GJGEN ;AND DON'T LET INFERIORS TOUCH THIS JFN
MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Output file name>]
CALL FLDSKP ;READ FILESPEC
CMERRX ;THAT'S NOT WHAT IT WAS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
;**;[913] Add one line at .TKLOG:+7L PED 29-SEP-82
CONFIRM ;[913]
RET
.NECHO: CALL ECHNOI
MOVX A,TKECOF ;FLAG TO ALLOW ECHOING
ANDCAM A,TAKCON ;TURN IT OFF
RET
.NOTAK: KEYWD $NOTAK ;GET NEXT KEYWORD
T ECHO,,.NECHO
JRST CERR
JRST (P3) ;CALL PROPER ROUTINE
$NOTAK: TABLE
T ECHO,,.NECHO
TEND
;ROUTINE TO PUSH THE EXEC PRIMARY IO STREAM
;
;ACCEPTS: A/ INPUT JFN,,OUTPUT JFN
; B/ FLAG BITS (SUCH AS TKALEF, TKECOF)
;
;RETURNS +1
PUSHIO::MOVE C,TAKLEN ;GET CURRENT LENGTH
CAIL C,TAKLNX ;MAKE SURE WE'RE NOT AT MAXIMUM
JRST NOPE ;WE ARE
AOJ C, ;INCREASE LENGTH OF LIST
CALL PIOFF ;NO ^C WHILE WE STRAIGHTEN THINGS OUT
MOVEM A,TAKJFN-1(C) ;STORE JFNS
MOVEM B,TAKBTS-1(C) ;STORE CONTROL BITS
MOVEM C,TAKLEN ;REMEMBER NEW LENGTH
CALL FIXIO ;SET UP DYNAMIC VARIABLES
GJINF ;GET JOB INFO
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
SKIPGE D ; IF DETACHED
CAIE A,.PRIIN ; AND READING FROM PRIMARY INPUT
SKIPA
JRST [MOVE A,TAKCUR ;GET CURRENT SETTINGS
JRST PSH1] ;FALL IN TO TURN OFF TKTERF
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
DVCHR
LDB B,[221100,,B] ;GET DEVICE TYPE OF INPUT DEVICE
MOVE A,TAKCUR ;GET CURRENT SETTINGS
TXO A,TKTERF ;FIRST ASSUME INPUTTING FROM TERMINAL
CAIE B,.DVTTY ;GOOD GUESS?
PSH1: TXZ A,TKTERF ;NO, LOUSY GUESS.
MOVEM A,TAKCUR ;UPDATE SETTINGS
MOVE B,TAKLEN ;GET POINTER TO END OF LIST AGAIN
MOVEM A,TAKBTS-1(B) ;REMEMBER WHETHER INPUTTING FROM TERMINAL
CALLRET PION ;ALLOW ^C AGAIN
NOPE: MOVE C,A ;SAVE JFNS IN C
HRRZ A,C
MOVE B,TAKJFN-1(B) ;GET LAST JFNS ON LIST
CAIE A,(B) ;DON'T CLOSE IF LAST JFN IS SAME
CLOSF ;CLOSE THIS LAST SET OF JFNS, SINCE THEY'RE NOT ON THE STACK YET
ERJMP .+1 ;FAILED, PROBABLY BECAUSE 100 OR 101
HLRZ A,C ;GET OTHER JFN
CLOSF
ERJMP .+1
HLRZ A,C ;PCL Look at input
CAIN A,.NULIO ;PCL Command procedure?
ERROR <Command procedures nested too deeply> ;PCL
ERROR <TAKE commands nested too deeply>
;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.
;UNATTACH - DETACH REMOTE JOB WITHOUT REATTACHING HERE
.UNATT::TLO Z,F1 ;SAY UNATTACH INSTEAD OF ATTACH
JRST ATTAU1 ;GO JOIN ATTACH
;UNDELETE <DELETED FILE NAMES>
.UNDEL::NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
MOVX B,(GJ%OLD!GJ%NS!GJ%DEL!GJ%IFG!1B15!1B16!1B17) ;"MUST BE NEW" AND "IGNORE DELETED BIT"
; ALSO, NO SEARCHING TO BE DONE
HRLI B,-3 ;DEFAULT VERSION IS *
TRO Z,IGINV ;SEE INVISIBLE FILES
CALL SPECFN ;INPUT FILE NAME USING GTJFN FLAGS IN B
JFCL ;IGNORE SUBCOMMAND ENDING
SETOM TYPGRP ;ALWAYS PRINT FILENAME AT TYPIF
UNDEL1: HRRZ A,@INIFH1 ;JFN
DVCHR
TXNN B,DV%MDD ;MULT DIR DEVICE?
JRST [ ETYPE <?%1H: Can't undelete files on this device
>
MOVSI A,(77B5)
ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
JRST UNDEL8]
HRRZ A,@INIFH1
MOVE B,[XWD 1,.FBCTL] ;CONTROL BITS WORD OF FILE DESC BLOCK
MOVEI C,C ;READ INTO C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
SETO C, ;NO ACCESS, ASSUME DELETED
TXNN C,FB%DEL ;"FILE IS DELETED" BIT
JRST [ MOVE A,@INIFH1 ;GET JFN WITH FLAGS
TLNE A,<77B5>B53 ;ANY *'S?
JRST UNDEL8 ;YES, NO MESSAGE
CALL TYPIF ;PRINT NAME
TYPE < Wasn't deleted
>
JRST UNDEL8]
CALL TYPIF ;TYPE NAME IF GROUP
HRLI A,.FBCTL ;1: XWD DISPLACEMENT, JFN
LDF B,FB%DEL ;MASK OF BITS TO CHANGE
SETZ C, ;VALUE TO CHANGE TO: OFF.
CALL $CHFDB ;DO CHFDB AND FIELD ITRAP IF ANY
JRST [ TYPE < Access not allowed
>
JRST UNDEL8]
CALL TYPOK ;INDICATE DONE OK
UNDEL8: CALL GNFIL ;GET JFN OF NEXT FILE OF GROUP
RET ;NO MORE, GO GET NEXT COMMAND.
JRST UNDEL1 ;HAVE ANOTHER
;PRIVILEGED COMMANDS
;^E EDDT
;TRANSFER CONTROL TO TOPS20 DDT, GETTING IT IF IT ISN'T ALREADY THERE.
.EDDT:: SKIPE DDTORG
JRST EDDT4 ;DDT ALREADY THERE
SKIPN Q1,.JOBSY ;DO WE HAVE SOME SYMBOLS?
SKIPE Q1,JOBSYM ;???
SKIPA B,[-1,,[GETSAVE <SYS:UDDT.>]]
HRROI B,[GETSAVE <SYS:SDDT.>] ;USE SDDT IF NO SYMBOLS
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY, AND SHORT FORM
CALL GTJFS ;GET AND STACK THE JFN
CALL CJERRE ;IF CAN'T, JUST GIVE ERROR TO USER
HRLI A,.FHSLF ;SAY THIS FORK (JFN IS IN RH A)
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED, SAY WHY
CALL RLJFNS
;"GET" CHANGES ENTRY VECTOR TO POINT AT DDT.
;CHANGE IT BACK.
MOVEI A,.FHSLF
DMOVE B,[EXP EVLEN,EXEC] ;ENTRY VECTOR
CALL SETENT
;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.
SKIPN Q1 ;HAVE ONE?
JRST [TYPE <% No symbols
>
JRST EDDT4] ;NO - PROCEED
MOVEM Q1,@DDTORG+1 ;YES - STORE INTO DDT
EDDT4: MOVX A,OURNAM ;GET OUR NAME
SETNM ;SET IT IN CASE USER EXITS DDT AND TYPES "SAVE"
JRST DDTORG ;ENTER DDT
;DISABLE
;DISABLES PRIVILEGED COMMANDS,
;DISABLES USER (RH) SPEC CAPS IN EXEC AND INFERIOR FORK
; (CAPS POSSIBLE ARE STILL TRANSMITTED, SO INFERIOR CAN USE THEM
; IF IT ENABLES THEM ITSELF)
;**;[953] Add one at DISAB1+7, +14, +17 and +21 MAR-23-83 YKT
.DISAB::SETZ A, ;FLAG DISABLE
DISAB1: STKVAR <REMA>
MOVEM A,REMA ;REMEMBER DESIRED SETTING
NOISE <CAPABILITIES>
CONFIRM
MOVE A,REMA
MOVEM A,PRVENF ;GET DESIRED SETTING
MOVEI A,.FHSLF ;"ENABLE" JOINS HERE
RPCAP
ERJMP CJERR ;[953]
TRZ C,-1
SKIPE PRVENF
HRR C,B
MOVE D,C ;REMEMBER EXEC'S CAPS
EPCAP ;EXEC'S CAPABILITIES
ERJMP CJERR ;[953]
SKIPG A,FORK
RET ;NO INFERIOR, DONE
RPCAP
ERJMP CJERR ;[953]
MOVE C,D ;SET FORK TO WHATEVER WE ARE
EPCAP ;INFERIOR'S CAPS
ERJMP CJERR ;[953]
RET
;ENABLE
;ENABLES OTHER PRIVILEGED COMMANDS IN EXEC, AND ENABLES
;RH (USER) SPECIAL CAPS IN EXEC AND IN INFERIOR FORK, IF THERE IS ONE.
.ENABL::SETO A, ;FLAG TO DO ENABLE
JRST DISAB1
;^ELOGOUT (JOB #)
;**;[998] Restore the ..LOGO routine, kill edits 991,992 JMP 19-Apr-84
..LOGO::PUSH P,A
GJINF
CAMN 3,0(P) ;THIS JOB?
ERROR <If you want to logout this job, use LOGOUT>
MOVE D,0(P) ;RECOVER JOB NUMBER
HLRE A,JOBRT ;GET NUMBER OF JOBS ON SYSTEM
MOVM A,A ;MAKE IT POSITIVE
CAML D,A ;VALID ARG?
JRST ELOGO1 ;NO
JUMPL D,ELOGO1 ;NEGATIVE ALSO INVALID
GTB .JOBRT ;CHECK RUNTIME TABLE
JUMPGE 1,.+2 ;REQUESTED JOB EXISTS?
ELOGO1: ERROR <That job does not exist>
CONFIRM
POP P,A
LGOUT
CALL CJERR
JRST CMDIN4
NEWF,<
.BLANK::NOISE (SCREEN)
CONFIRM
BLANK1::STKVAR <TMOD>
MOVE A,COJFN ;CURRENT OUTPUT JFN
RFMOD ;GET MODE WORD
MOVEM B,TMOD ;SAVE IT
TXZ B,TT%DAM ;NO XLATION
SFMOD
GTTYP ;GET TERMINAL TYPE
;**;[1005] Change 1 line at BLANK1::+7L DEE 15-MAY-84
CAIGE B,BLNKMX ;[1005] (caig to caige) ALL WE KNOW ABOUT NOW
SKIPN A,BLNKTB(B) ;GET STRING TO DUMP
JRST BLANK2 ;NONE - DO NOTHING
TLNN A,-1 ;STRING OR PNTR?
TLOA A,-1 ;PNTR TO TEXT
HRROI A,BLNKTB(B) ;STRING - POINT TO IT INSTEAD
PSOUT ;DUMP IT
BLANK2: MOVE A,COJFN
MOVE B,TMOD ;RESTORE MODES WORD
SFMOD
RET
;**;[1005] Add entries 19-36 to table DEE 15-MAY-84
BLNKTB: 0 ;(0) TTY 33
0 ;(1) TTY 35
0 ;(2) TTY 37
0 ;(3) TI / EXECUPORT
REPEAT 4,<0> ;(4-7) RESERVED FOR CUSTOMER
0 ;(8) SYSTEM DEFAULT
0 ;(9) IDEAL (NO FILL)
[BYTE (7)35,177,177,177,177,177,177,37,0] ;(10) VT05
BYTE (7)33,"H",33,"J",0 ;(11) VT50
0 ;(12) LA30
BYTE (7)35,37 ;(13) GT40 - NO FILL REQUIRED
0 ;(14) LA36
BYTE (7)33,"H",33,"J",0 ;(15) VT52
[BYTE (7)33,"[","H",33,"[","J",0] ;(16) VT100
0 ;(17) LA38
0 ;(18) LA120
REPEAT 20,<0> ;(19-34) RESERVED FOR CUSTOMER
[BYTE (7)33,"[","H",33,"[","J",0] ;(35) VT125
[BYTE (7)33,"P","p","s","(","e",")",33,"\"] ;(36) VK100
BLNKMX=.-BLNKTB
>
END