Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
;[MIT-XX]SRC:<EXEC.TEST>EXEC1.MAC.52, 10-Nov-84 15:26:08, Edit by GZ
;121 (OZ) add .OFF files
;[MIT-XX]SRC:<EXEC.TEST>EXEC1.MAC.51, 2-Sep-84 03:13:51, Edit by GZ
;116 (OZ only) You can have a user get a login refused/failed message by
; putting it in PS:<ACCOUNTS.LIMBO>username.TYPE. For now the only type
; implemented is BADPWD, for when he types a bad password.
;[MIT-XX]EXEC:<GREN>EXEC1.MAC.44, 16-Aug-84 17:42:49, Edit by GREN
;113 Have REMARK work a line at a time so ^L doesn't retype EVERYTHING
;[MIT-XX]SRC:<EXEC.TEST>EXEC1.MAC.43, 24-Jul-84 23:24:12, Edit by JTW
;nonumber - put part of 1017 that causes errors on unmodified monitors
; under OZ conditional.
;1017 oz's refuse-sends-bit support
;1016 ask to attach det jobs when login, ask to interrupt n-links
;717 change BLANK to use new terminal types and VTS
;713 add literal label
;712 DEC release version
; 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 CONNExqCT 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
;7 internal flag: CVAL0 - keep file visible
.ARCHI::NOISE <files>
TLZ Z,F2 ;DEFAULT IS NOT TO RETAIN CONTENTS
HRROI A,0 ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD!GJ%IFG!CF%ERR!CF%GRP!CF%EOL)
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,(P) ; AND BITS
ARCF
ERJMP [ETYPE < %?%%_>
JRST ARCHI9]
SKIPE CVAL0 ;7 keep it visible?
JRST ARCHI4 ;7 yes
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]
ARCHI4: ETYPE < [Requested]%_> ;7 add local label
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
T visible,,.ARVIS ;7 keep file visible
TEND
.ARFL: NOISE <disk contents>
CONFIRM
TLO Z,F2
RET
.ARVIS: CONFIRM ;7
SETOM CVAL0 ;7 set flag
RET ;7
;LET (LOGICAL NAME) -- (AS) --
EDEFIN::MOVEI A,[ASCIZ/^EDEFI/] ;7 set up program name properly
HRROM A,COMAND ;7
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>
ABSKP ;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
MOVX A,.CLNJB
TLNE Z,F2 ;SYSTEM?
MOVX 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?
ABSKP ;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: MOVX A,.CLNJ1 ;DELETE
TLNE Z,F2
MOVX A,.CLNS1
JRST .ASSO4
.ASS3B: CRRX <Confirm to delete all logical names>
CMERRX
MOVX A,.CLNJA ;DELETE ALL
TLNE Z,F2 ;SYSTEM?
MOVX A,.CLNSA
TLNE Z,F2 ;SYSTEM?
PROMPT <[Confirm to delete all SYSTEM logical names]>
TLNN Z,F2
PROMPT <[Confirm to delete ALL logical names]>
CONFIRM
CRLNM
CALL CJERR
POP P,B
RET
;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>
;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM:
; @ATTACH (USER) <NAME> (TSS JOB #) <#>
; PASSWORD: (PASSWORD) ----
;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
;ENTRY FOR COMMAND, NEXT TAG IS FROM UNATTACH
.ATTAC::IFNBATCH <[ERROR <ATTACH illegal from BATCH job>]>
;DECODE ARGUMENTS
ATTAU1: SETOM PASCMD ;7 command needs password
TRVAR <ATTNM,<APBUF,20>,AT1,AT2,PASPTR> ;7 add pasptr, 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 #
CALL CKANON ;7 ATTACH to ANONYMOUS?
JRST [MOVX B,WHLU!OPRU ;7 yes, check for enabled wheel or operator
SKIPE PRVENF ;7
CALL PRVCK ;7
ERROR <Wheel or operator capability required> ;7 no
JRST .+1] ;7 yes
SETOM ATTNM ;7 code moved from below
CALL PASWD ;7 get password
MOVEM A,PASPTR ;7 save pointer to password
ILDB A,A ;7 is it null?
CAIN A,0 ;7
JRST ATTAU2 ;7 yes, indicate no password, don't ask for job
;7 this code moved above
;7 SETOM ATTNM ;CLEAR ATTACHED TERMINAL # HERE
NOISE <job #>
DECX < Number if more than one job under that name>
ABSKP ;NON-DECIMAL NUMBER TYPED
JRST ATTNUM ;NUMBER TYPED, GO PROCESS IT
ABSKP ;7 go on
ATTAU2: SETZM PASPTR ;7 indicate no password
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,[ERROR <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,[ERROR <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.
;SEARCH JOBDIR TABLE FOR A MATCH
ATTAC5: 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
CONFIRM
;EXECUTE THE COMMAND
ATAC4B: POP P,A ;TSS JOB # TO ATTACH TO
MOVE C,PASPTR ;7 get password if given
;7 SETZ C, ;NO PASSWORD POINTER
POP P,B ;USER TO ATTACH TO
TLNN Z,F1 ;IF NOT LOSING THIS JOB
SKIPN CUSRNO ; OR NOT LOGGED IN,
ABSKP ; 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
ERSKP ;FAILED
JRST ATGOOD ;SUCCEEDED
SKIPN PASPTR ;7 did he give a password?
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: SKIPE CUSRNO ;7 logged in?
TLNE Z,F1 ;7 UNATTACH?
JRST CMDIN4 ;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
; STILL ATTACHED IF 'UNATTACH' JUST DONE.
JRST DTCH1 ;7 logged in ATTACH, go reset TTY mods,
;7 setup ATTACH.CMD stuff
;BREAK (LINKS)
NONEWF,<
OLDF,< ;7
.BYE:: NOISE <to> ;7
ABSKP ;7
.BREAK:: NOISE <links>
>> ;7
BREAK0: CONFIRM
BREK0A: HRLOI B,0 ;SET TO BREAK ALL LINKS
;(FALL INTO BREAK1)
;BREAK1 - BREAKS LINKS FROM SPECIFIC TERMINAL.
;
; ACCEPTS: B/ TERMINAL NUMBER OR 777777 FOR ALL
BREAK1::MOVX A,TL%CRO!TL%COR!FLD(.CTTRM,TL%OBJ) ;BREAK TO AND FROM LINKS
TLINK
CALL JERR
RET
NEWF,<
;BREAK (LINKS WITH) - FANCIER FORM OF BREAK COMMAND
OLDF,< ;7
.BYE:: NOISE <to> ;7 another way to say the same thing
ABSKP ;7
> ;7
.BREAK:: NOISE <links with>
STKVAR <BYUNO>
MOVEI B,[FLDDB. .CMNUM,CM%SDH,10,<an octal line number>,,[
FLDDB. .CMUSR,,,,,[
FLDDB. .CMTOK,CM%SDH,TXTPTR <*>,,,[
FLDDB. .CMCFM,CM%SDH,,<or a carriage return for all links>]]]]
CALL FLDSKP ;PARSE THIS MESS
CMERRX
GTFLDT C ;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
> ;end NEWF
;CANCEL (Request type) ARCHIVE - arrive here from EXECQU
CANARC::NOISE <for files>
HRROI A,0
HRLI B,-3 ;ALL GENERATIONS
HRRI B,(GJ%OLD!GJ%IFG!CF%ERR!CF%GRP!CF%EOL)
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
ETYPE <%_>
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
MOVX B,.ARRAR ;REQUEST ARCHIVE
MOVX 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> --
LAZCON::MOVE C,B ;7 move directory number to right place
SETOM LAZCMD ;7 turn on lazy command flag
PUSH P,[CMDIN4] ;7 setup return addr
MOVEI A,[ASCIZ/CONNEC/] ;7 setup pointer for program name setup
HRROM A,COMAND ;7
.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!!
SETOM PASCMD ;7 command requires password
SETZM ACPASS ;NO PASSWORD ASSUMED THIS TIME
SETOM ACJNUM ;USE OUR OWN JOB NUMBER
SKIPE LAZCMD ;7 lazy connect?
JRST CONNX1 ;7 yes, we already have the directory
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>
CONNX1: ;7 add local label
MOVEM C,ACDNUM ;REMEMBER DIRECTORY NUMBER
CALL PASWD ;7 get password
CONFIRM
MOVEM A,ACPASS ;7
ILDB A,A ;7 get the first char of password
CAIN A,0 ;7 null?
SETZM ACPASS ;7 yes
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:
;7 SETZM ACPASS ;FIRST TRY WITHOUT PASSWORD
CALL DOACC ;DO THE JSYS
TLNE Z,F2 ;CONNECT?
RET ;7 style
;7 JRST CMDIN4 ;NO, ACCESS, SO NO OVER QUOTA REPORT
SKIPE STICKY ;7 sticky file defaulting?
CALL SFDCON ;7 yes, change defaults
GJINF ;GET CONNECTED DIRECTORY NOW
CAME B,OLDCON ;DON'T GIVE SAME REPORT TWICE!
CALL CHKDAL ;CHECK NEW DIRECTORY
RET ;7 style
;7 JRST CMDIN4
;ROUTINE TO DO JSYS FOR ACCESS, END-ACCESS, CONNECT
DOACC: MOVX 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
ERJMP ACCHK ;7 style
;7 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
;7 can't RET from here
;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
EE,< SETOB B,C> ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE
; FORMAT
NOEE,< SETO B, ;7 lets get real fancy
MOVX C,OT%DAY!OT%FDY!OT%FMN!OT%4YR!OT%DAM!OT%SPA!OT%12H!OT%TMZ
>
ODTIM
EE,< TYPE < (> ;7 also 12 hour format for EE
MOVX C,OT%NDA!OT%NSC!OT%SCL!OT%12H ;7
ODTIM ;7
ETYPE <)%_> ;7
> ;7
NOEE,< ETYPE<%_>>
RET
;DELETE <FILE GROUP>
.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,
DELPGS,DELJFN>
SETZM KEPNUM ;ASSUME NOT KEEP
NOISE <files>
HRROI A,0 ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD!GJ%NS!GJ%IFG!CF%ERR!CF%GRP!CF%EOL) ;OLD FILE, NO SEARCH,
; *'S AND COMMA OK
CALL SPECFN ;INPUT FILE GROUP DESCRIPTOR
JRST DELET1
TDZ Z,[<(F2!F3!F4!F5)>!1B18] ;7 correct bit placement
;7 TDZ Z,[F2!F3!F4!F5!1B18] ;CAN'T BE EXPUNGE IF NO SUBCOMMAND
JRST DELET2
DELET1: TDZ Z,[<(F2!F3!F4!F5)>!1B18] ;7 correct bit placement
;7 TDZ Z,[F2!F3!F4!F5!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
SETZ Q2, ;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,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF ;GET PUNCTUATED
; STRUCTURE AND DIRECTORY
HRROI A,DELBUF ;WHERE TO PUT IT
JFNS
MOVX A,RC%EMO ;LITERAL MATCH
HRROI B,DELBUF ;STRING
RCDIR ;GET DIR #
HRROI B,DELBUF ;FOR ERROR MESSAGE
TXNE 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 e,,0,CM%NOR ;7 "EXP" is the minimum abbrev for "EXPUNGE"
T ex,,0,CM%NOR ;7
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
CAIN B,0
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>
TXNE 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,FLD(.JSSSD,JS%DEV)!FLD(.JSSSD,JS%DIR)!FLD(.JSAOF,JS%NAM)!
FLD(.JSAOF,JS%TYP)!JS%PAF ;DEV, DIR, NAME, EXT
JFNS ;SAVE NAME OF FILE
ERCAL JERRE
MOVE A,[ASCPTR VERSTR] ;INIT POINTER TO VERSION STRING SPACE
MOVEM A,KEPJNM ;SAVE HERE
MOVSI Q1,-VRTBLN ;AOBJN PTR TO VER STRING PTR TABLE
LDF D,FLD(.JSAOF,JS%GEN)!JS%PAF ;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
ERNOP
TXNE C,FB%ARC ;NOT DELETABLE?
JRST KEEPD9 ;NO, PASS OVER IT
HRRZ A,@INIFH1
MOVE B,[1,,.FBBK0]
MOVEI C,C
GTFDB
ERNOP
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
TXNE A,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER ;SKIP GNJFN IF NO
; STARS
GNJFN
JRST KEEPD3
TXNE A,GN%DIR!GN%NAM!GN%EXT ;DIR, NAME, EXT CHANGED?
JRST KEEPD2 ;YES, FINISH THIS FILE
JUMPN C,KEEPD1 ;IF NONE FOUND
LDF D,FLD(.JSAOF,JS%GEN) ;GENERATION WITHOUT PUNCT.
AOBJN Q1,KEEPD1 ;INCREMENT VERSION PTR AND LOOP BACK
KEEPOV: ETYPE <%Too many generations for internal storage, will not print
generations%_>
CALL KEEPPN ;PRINT NAME
CALL KEEPDO ;DO DELETE (RETURNS # DELETED IN A)
CAIL A,0
ETYPE < [%1Q generations deleted]%_>
MOVE A,@INIFH1
TXNE A,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER
KEEPD4: GNJFN
JRST [AOS A,INIFH1
CAMLE A,INIFH2 ;OFF END?
SETZM INIFH1 ;YES, INDICATE SUCH
JRST KEEPDE]
TXNN A,GN%DIR!GN%NAM!GN%EXT
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: MOVX 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 < >
ABSKP
KEEPE1: ETYPE < GTJFN failure for highest generation%_%?>
CALL $ERSTR
ETYPE <%_>
SETO A,
RET
;DISCARD (TAPE INFORMATION FOR FILES) <FILES>
.DISCA::NOISE <tape information for files>
HRROI A,0 ;NO DEFAULT NAMES
HRRZI B,(GJ%OLD!GJ%IFG!CF%ERR!CF%GRP!CF%EOL!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
ERROR <No such directory>
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: 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 - PRINTS MESSAGE SAYING HOW MANY PAGES FREED
;
; ACCEPTS: A/ NUMBER OF PAGES FREED
; C/ DIR NUMBER
TYPFRE::MOVEI B,[ASCIZ/ %3R [%1Q/]
CAIN A,0 ;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
ETYPE < 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
ETYPE <Type remark. End with CTRL/Z.%_>
STKVAR <<CMTXTB,10>>
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
SETZM .RDBFP+CMTXTB ;SAY NO BACKUP POINTER
SETZM .RDRTY+CMTXTB ;SAY NO ^R POINTER
MOVEI A,[EXP <1B<.TICCM>!1B<.TICCZ>>,0,0,0] ;113 Break on ^Z, ^M
MOVEM A,.RDBRK+CMTXTB ;SET UP BREAK MASK
COM1: 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,CMTXTB ;POINT TO BLOCK
TEXTI ;INPUT SOME OF THE COMMENT
ERCAL CJERRE ;FAILED, GO SEE WHY
LDB A,.RDDBP+CMTXTB ;113 Get character that broke us
CAIN A,"Z"-100 ;113 ^Z?
JRST UNMAP ;YES, CLEAN UP AND RETURN
JRST COM1 ;NOT YET, READ MORE
.CLOSE::NOISE <JFN>
CRRX <Octal JFN number or blank for all>
ABSKP ;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
CAIG A,0
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
ETYPE < [OK]%_>
RETSKP
NRLPRI: ETYPE < Primary input not closed%_>
RETSKP
NRLPRO: ETYPE < 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: ETYPE < EXEC command input not closed%_>
RETSKP
NRLEXO: ETYPE < EXEC command output not closed%_>
RETSKP
JFNOK2: TXNE B,GS%OPN
ETYPE < Can't close file%_>
TXNN B,GS%OPN
ETYPE < Can't release JFN%_>
RETSKP
JFNER1: TYPE < Can't release JFN - >
ABSKP
JFNER2: TYPE < Can't close file - >
CALL $ERSTR ;PRINT ERROR IN A
ETYPE<%_>
RETSKP
SHUT: CALL CLOPAT ;GO UNMAP THE PA1050 OPEN FILES
MOVX A,MAXJFN ;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1: PUSH P,A
CALL JFNREL ;RELEASE JFN
NOP ;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,
NLINKD,LINKTO,LNKDTO> ;1016
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?
CAIN B,0 ;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%_% 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%_% 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)
MOVX C,FLD(10,NO%RDX) ;IN OCTAL
NOUT ;CREATE DEFAULT STRING
CALL JERR ;SHOULDN'T FAIL
OCTX <Terminal number>
CMERRX ;NON-OCTAL NUMBER TYPED
JRST LINK10
;So who's bright idea was it to use this in the EXEC?
OPDEF MONRD% [JSYS 717]
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,(P) ;IS TTY# IDENTICAL TO MY TTY NUMBER ?
ABSKP
LINKNS: ERROR <Cannot talk to self>
HLRE B,TTYJOB ;GET NEG SIZE OF TABLE
MOVMS B
POP P,A ;TTY#
CAIGE A,(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,(P) ;LAST PLUS ONE
POP P,(P) ;CLEAR STACK
CAIL A,(D) ;ABOVE PTY'S?
JRST NOPTYL ;YES. NVT OR SOMETHING ELSE
PROMPT < [Pseudo-terminal, confirm]>
CONFIRM
NOPTYL: TLNE Z,F2
JRST ADVISE ;GO GIVE ADVISE
SETZM NLINKD ;1016 # other people that TTY's linked to
MOVEM A,LINKTO ;1016 Save TTY# of who we want to link to.
MOVE D,A ;1016 TTY#
MOVEI A,11 ;1016 .RDTTY - Read TTACTL stuff
MOVE B,[SIXBIT "TTLINK"] ;1016
SETZ C, ;1016 offset from TTLINK word
MONRD% ;1016
ERJMP LNKED2 ;1016
MOVEM B,LNKDTO ;1016
LNKED0: SKIPN B,LNKDTO ;1016 Linked to any more TTYs?
JRST LNKED2 ;1016 Nope.
SETZ A, ;1016
LSHC A,^D9 ;1016 Rotate out the next TTY he's linked to
MOVEM B,LNKDTO ;1016 and save rest-of-ttys word.
CAIN A,777 ;1016
JRST LNKED0 ;1016
PUSH P,A ;1016
MOVE D,A ;1016
MOVEI A,11 ;1016 .RDTTY
MOVE B,[SIXBIT "TTLINK"] ;1016
SETZ C, ;1016
MONRD% ;1016
ERJMP LNKED0 ;1016
LNKED1: JUMPE B,[POP P,A ;1016 Flush that saved word
JRST LNKED0] ;1016
SETZ A, ;1016
LSHC A,^D9 ;1016
CAME A,LINKTO ;1016
JRST LNKED1 ;1016
AOS NLINKD ;1016 Found someone we have a full link to!
JRST LNKED0 ;1016
LNKED2: SKIPG NLINKD ;1016 Already full-linked to anyone?
JRST LNKED5 ;1016 Naw, so just go ahead.
MOVS C,NLINKD ;1016
MOVNS C ;1016 -#on stack,,0
HRRI C,1(P) ;1016
SUB C,NLINKD ;1016
HRROI A,[ASCIZ/Talking to /] ;1016
LNKED3: MOVE B,(C) ;1016
CALL SHLINK ;1016
HRROI A,[ASCIZ/, /] ;1016
AOBJN C,LNKED3 ;1016
ETYPE <%_> ;1016
PROMPT <Join them? [Confirm] > ;1016
CONFIRM ;1016
LNKED4: MOVX A,TL%EOR!TL%ERO!FLD(.CTTRM,TL%OBJ) ;1016
POP P,B ;1016
ADDI B,.TTDES ;1016
TLINK ;1016
JRST [SUBI B,.TTDES ;1016
ETYPE <%%Couldn't link to TTY%2O%_> ;1016
JRST .+1] ;1016
SOSLE NLINKD ;1016
JRST LNKED4 ;1016
LNKED5: MOVX A,TL%EOR!TL%ERO!FLD(.CTTRM,TL%OBJ) ;1016 to and from .CTTRM
MOVE B,LINKTO ;1016
ADDI B,.TTDES ;1016
;1016 old code
DELETE,<MOVEI B,.TTDES(A) ;FORM TTY DESIGNATOR
MOVX A,TL%EOR!TL%ERO!FLD(.CTTRM,TL%OBJ) ;TO AND FROM CONTROLLING TTY
>
TLINK
ERROR <Refused, use SEND or send mail to user> ;7 different message
RET
SHLINK: SAVEAC <A,B,C,D> ;1016
PSOUT ;1016
ETYPE <TTY%2O > ;1016
MOVEI A,.TTDES(B) ;1016
HRROI B,D ;1016
MOVEI C,.JIUNO ;1016
GETJI ;1016
JRST [ETYPE <???> ;1016
RET] ;1016
JUMPE D,[ETYPE <Not logged in> ;1016
RET] ;1016
ETYPE <%4R> ;1016
RET ;1016
;CODE TO GIVE ADVISE - CHECK TERMINAL PRINT JOB INFO
ADVISE: MOVEM A,ADVTNM
MOVX B,WHLU!OPRU
CALL PRVCK
ABSKP
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.
TXNN B,TT%AAD
ERROR <Destination not receiving advice>
ADVIS1: SETO D,
GTB .TTYJO
MOVNS A,A
CAMGE A,ADVTNM
ERROR <Illegal terminal number>
SETO A,
HRROI B,C
MOVX C,.JITNO
GETJI
CALL JERR
CAMN C,ADVTNM
ERROR <Cannot advise self>
ETYPE < Escape character is <CTRL>E, type <CTRL>^? for help%_>
MOVE D,ADVTNM
GTB .TTYJO
HLRZ B,A
CAIN B,-1
JRST [PROMPT < No job on terminal. Creating new job [Confirm]> ;7
CONFIRM ;7
MOVE A,ADVTNM ;7 throw CTRL/C into buffer to start job
TXO A,.TTDES ;7
MOVX B,.CHCNC ;7
STI ;7
ERCAL CERR ;7 oops
WAITY: MOVE D,ADVTNM ;7 started up yet?
GTB .TTYJO ;7
HLRZ B,A ;7
CAIN B,-1 ;7 no, wait and try again
JRST [MOVX A,^D1000 ;7
DISMS ;7
JRST WAITY] ;7
ETYPE < Job created%_> ;7 tell we have it now
CAIN B,-2 ;7 being assigned, continue
JRST CONNEC ;7
JRST ADVI1A] ;7 other cases
CAIN B,-2
JRST [ETYPE < Terminal being assigned.%_>
JRST CONNEC]
ADVI1A: TRZE B,400000 ;7 add local label
ETYPE < Not controlling terminal.%_>
MOVEM B,ADVJNM
PRINT " "
MOVE A,ADVJNM
MOVEI B,JIBUF ;GET ADDRESS OF BUFFER
HRLI B,-.JILEN ;SPECIFY LENGTH
SETZ C,
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
ETYPE <, %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
MOVX A,.FHSLF
RPCAP
MOVX 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
MOVX B,FLD(8,OF%BSZ)!OF%RD ;OPEN THE JFN FOR READ
OPENF
ERCAL CJERRE ;FAILED
MOVEM A,ADVJFN ;REMEMBER THE ADVISE JFN
MOVX 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
CAIE C,CTRLO ;7 SPR #:20-17441
JRST ADVLP1 ;7 make CTRL/O do an interrupt
PUSH P,B ;7
MOVX A,.FHSLF ;7
MOVX B,1B5 ;7
IIC ;7
POP P,B ;7
ADVLP1: TLNE Z,F3 ;COMMENT?
JRST ADVLOP ;YES, DON'T SEND CHAR
MOVE A,ADVTNM
MOVE D,B ;7 save character
SOBF ;7 output buffer full?
ABSKP ;7 no, send char (possible race)
JRST ADVUNP ;7 yes, is it unpause char?
MOVE B,D ;7 get the char back
ADVL1A: STI ;7
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
ADVUNP: MOVX A,.CTTRM ;7 get unpause char for advisor
MOVX B,.MOPCR ;7
MTOPR ;7
ERJMP ADVUN1 ;7 assume it's not unpause char
MOVE A,ADVTNM ;7 restore JFN
HRRZ C,C ;7 isolate unpause char
ANDI D,177 ;7 strip parity on char in question
CAMN C,D ;7 are they the same?
JRST ADVL1A ;7 yes, send it on
ADVUN1: ETYPE <%_ [Destination buffer full]%_> ;7 no, tell him
JRST ADVLOP ;7 wait till buffer is ready
;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
MOVX A,TL%EOR!TL%ERO!FLD(.CTTRM,TL%OBJ) ;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
ETYPE < [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
ABSKP
JRST CJERR
IS1: ETYPE <%_% [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
ABSKP ;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: MOVX A,TL%EOR!TL%ERO!FLD(.CTTRM,TL%OBJ) ;TO AND FROM CONTROLLING TTY
MOVE B,ADVTNM
TLINK ;PUT HIS OUTPUT ON OUR TERMINAL
JRST [ETYPE <%_% TLINK failure%_>
JRST ADVLOP]
ETYPE < [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::ETYPE <%_% [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
LAZLOG::SETOM LAZCMD ;7 lazy command
PUSH P,[CMDIN4] ;7 push return addr
MOVEI A,[ASCIZ/LOGIN/] ;7 setup pointer for program name setup
HRROM A,COMAND ;7
ABSKP ;7
.QLOGI:: SETOM CVAL0 ;7 quick login
.LOGIN::TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT,LTTYNO> ;7 LTTYNO
;7 is last login TTY
;7 SKIPE CUSRNO ;7 login only in CTBL0
;7 ERROR <You are already logged in>
;DECODE ARGUMENTS
;FIRST ARGUMENT: USER NAME
SETZM LERRF ;NO ERROR YET
SKIPN LAZCMD ;7 lazy login?
JRST LOGI0A ;7 no
CALL LAZUSR ;7 get user no
JRST LOGIPO ;7 try again
JRST LOGI0B ;7
LOGI0A: NOISE <user> ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
CALL USERN ;INPUT USER NAME, TRANSLATE TO USER # IN A
JRST LOGIPO ;7 try again with "parse only"
LOGI0B: SETOM PASCMD ;7 password command
MOVEM A,RCBITS ;SAVE INFO RETURNED BY "RCDIR"
MOVEM C,LOGNO ;SAVE DIRECTORY NUMBER
CALL CKANON ;7 check for anonymous login
ERROR <Anonymous logins via non-file jobs are not allowed> ;7
CALL NOECHO ;NOISE STUFF WAITS FOR A CHARACTER!
NOISE <password>
CALL PASWD ;7 null passwd indicates passwd on next line
;7 CALL PASFLD ;READ THE PASSWORD
MOVEM A,LPASP ;REMEMBER POINTER TO PASSWORD
ILDB A,A ;7 was it null?
CAIN A,0 ;7
SETZM LPASP ;7 yes, then zero ptr
NOISE <account>
SETZ A, ;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
SKIPE LPASP ;7 did we get a password?
JRST LOGIN2 ;7 yes, skip this
CALL CHKPTY ;7 are we on a PTY?
JRST LOGIN2 ;7 yes, skip this
CALL PASLIN ;7 get password
MOVEM A,LPASP ;7
LOGIN2: ;7 add local label
;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 A,LOGNO ;USER #
MIT,< SKIPN CVAL0 ;7 quick login?
CALL GLTTY ;7 no, check last login TTY
>
MOVE C,LACCT ;ACCT # OR PTR THERETO
MOVE B,LPASP ;PASSWORD PTR
MOVE D,C ;GET ACCT STRING
ILDB D,D ;LOOK AT FINAL ACCOUNT
CAIN D,0 ;HAVE ONE?
SETZM C ;NO. USE NOTHING
SETZ D, ;RESERVE D FOR FUTURE FLAGS
LOGIN
JRST [CAIN A,LGINX1
ERROR <Illegal account>
NOOZ,< ;116
CAIN A,LGINX4
ERROR <Incorrect password>
CALL CJERRE ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
> ;116
OZ,< CALL PION ;121 Let him ^C out of typeout
CAIE A,LGINX2 ;121 Directory is "files-only"?
CAIN A,600016 ;121 (LGINX8) or account is turned off?
JRST [HRROI A,[ASCIZ/OFF/] ;121 Yes, type OFF message
CALL CKACOF ;121
ERROR <Directory cannot be logged in to> ;121 no msg
JRST RERET] ;121 else bail out quietly
CAIE A,LGINX4 ;116 Bad password?
CALL CJERRE ;116 No, do the general thing
HRROI A,[ASCIZ /BADPWD/] ;116 Type failed-password message
CALL CKACOF ;116
ERROR <Incorrect password> ;116 None, err out normally
JRST RERET ;116
> ;116
]
SKIPE CVAL0 ;7 quick login?
JRST LOGIN3 ;7 yes, skip all this junk
NOEE,< CAIN A,0 ;7 has he logged in before?
SETOM FIRLOG ;7 no, remember this
>
SETOM SYSMF ;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
LOGIN3: ;7 add local label
MOVE B,LOGNO ;WHAT "RCUSR" RETURNED
MOVEM B,CUSRNO ;STORE USER NUMBER
MOVEM A,LOGDAT ;SAVE DATE OF LOGIN
SETZM OPERF ;1016
MOVX A,RC%EMO ;1016
HRROI B,[ASCIZ "OPERATOR"] ;1016
RCUSR ;1016
TXNE A,RC%NOM!RC%AMB ;1016
SETZ C, ;1016
CAMN C,CUSRNO ;1016
SETOM OPERF ;1016 Dual operator-p and operator's user#
GJINF ;GET LOGGED-IN DIRECTORY NUMBER
MOVEM B,LIDNO ;SAVE IT.
CALL PION ;ALLOW ^C NOW THAT CUSRNO IS SET UP
SETZM WAKFLD ;7 set no wake-every-field
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
HRLOI B,377777 ;TIME WAY OUT IN THE BOONIES (WON'T
;CLOBBER ANY RUNTIME LIMIT SETTING
SETZ C,
TIMER
NOP ;DON'T CARE IF NONE PENDING
;TYPE "JOB <N> ON LINE N <DATE> <TIME>"
SKIPE CVAL0 ;7 quick login?
RET ;7 yes
ETYPE < Job %J on %L %D %E%%_> ;EOL NEEDED BEFORE LOGIN MESSAGE
SKIPG A,LOGDAT ;7 ever login before?
JRST LOGIN4 ;7 no
ETYPE < Last login: %1D %1E> ;7 yes
MIT,< CALL PLTTY> ;7 print TTY for last login
ETYPE <%_> ;7
LOGIN4: ;7 add local label
CALL JOBCNT ;7 multiple jobs logged in under user?
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
;TYPE "YOU HAVE A MESSAGE" IF A FILE "MAIL.TXT.1" OF NON-0 LENGTH
; EXISTS IN THIS DIRECTORY.
NONEWF,<CALL MESMES>
SETOM MWATCF ;7 turn mail watching on
MOVE A,CUSRNO ;7
MOVEM A,MWATDR ;7
HRLOI A,377777 ;7 large msg count
MOVEM A,MWATN ;7
MOVEM A,MWATN0 ;7
;GET DEFAULT EXEC INPUT FILE
SETOM LOGINI ;SET FLAG TO DO "TAKE INITIAL-LOGIN-TYPIN.TXT"
;AT NEXT OPPORTUNITY.
SETOM GLGINI ;7 "TAKE GROUP-LOGIN.CMD" too
RET
;7 code moved
LOGIPO: ;7 add local label
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 LOGI0B
;7 check for ANONYMOUS user
;7
;7 ACCEPTS: C/ user number from RCUSR
CKANON: TRVAR <<CKADNM,^D16>> ;7 holds directory name
HRROI A,CKADNM ;7 translate number to directory name
MOVE B,C ;7
DIRST ;7
RETSKP ;7 error, well lets assume not
HRROI A,CKADNM ;7 is it ANONYMOUS?
HRROI B,[ASCIZ/ANONYMOUS/] ;7
STCMP ;7
CAIN A,0 ;7
RET ;7 yes
RETSKP ;7 no
MIT,< ;7
;7 GET LAST LOGIN INFO FROM CERBER
;7
;7 ACCEPTS: A/ user number
;7 RETURNS: +1 A/ user number
;7 B,C,D get clobbered
NOOZ,< ;7 STKVAR won't interfere with login's TRVAR
GLTTY: STKVAR <CERJFN> ;7 CERBERUS.PMAP JFN
MOVE D,A ;7 move user number to D
HRROI B,[ASCIZ/SYS:CERBERUS.PMAP/] ;7 get CERBERUS.PMAP JFN
CALL TRYGTJ ;7
JRST GLTTY1 ;7 error, get out quietly
MOVX B,OF%RD!OF%THW ;7 open in thawed, read
OPENF ;7
JRST GLTTY1 ;7 error, get out quietly
MOVEM A,CERJFN ;7 save the JFN
HRLZ A,A ;7 map the last login data pages from file
HRRI A,20 ;7
MOVE B,[.FHSLF,,SCRPAG] ;7
MOVX C,PM%CNT!PM%RD!PM%CPY!FLD(2,PM%RPT) ;7
PMAP ;7
MOVE C,SCRATC(D) ;7 get TTY of last login
CAMN C,[-1] ;7 is it -1?
SETZ C, ;7 yes, then it was detached
MOVEM C,LTTYNO ;7 save away last TTY
SETO A, ;7 unmap the pages
MOVE B,[.FHSLF,,SCRPAG] ;7
MOVX C,PM%CNT!FLD(2,PM%RPT) ;7
PMAP ;7
MOVE A,CERJFN ;7 close the file
CLOSF ;7
JWARN ;7 error, tell him but continue
ABSKP ;7
GLTTY1: SETZM LTTYNO ;7 error, no terminal number
MOVE A,D ;7 restore A
RET ;7
> ;7
OZ,< ;7 STKVAR doesn't interfere with login's TRVAR
GLTTY: STKVAR <LOGJFN> ;7 LOGOUT.BIN JFN
MOVE D,A ;7 move user number in D
HRROI B,[ASCIZ/SYSTEM:LOGOUT.BIN/] ;7 get LOGOUT.BIN JFN
CALL TRYGTJ ;7
JRST GLTTY2 ;7
MOVX B,OF%RD ;7 open file, read
OPENF ;7
JRST GLTTY2 ;7
MOVEM A,LOGJFN ;7 save JFN
HRLZ A,A ;7
HRRZ C,D ;7 compute page number based on user number
LSH C,-7 ;7
HRR A,C ;7 map the appropriate pages
MOVE B,[.FHSLF,,SCRPAG] ;7
MOVX C,PM%RD!PM%CPY ;7
PMAP ;7
MOVE C,D ;7 compute base of user data entry on page
LSH C,2 ;7
ANDI C,777 ;7
MOVE B,SCRATC+1(C) ;7 get last login tty (offset 1)
CAMN B,[-1] ;7 is it -1?
JRST [SETZM LTTYNO ;7 yes, then it was detached
JRST GLTTY1] ;7
HLL B,SCRATC+3(C) ;7 get flags (offset 3)
MOVEM B,LTTYNO ;7 save last tty
GLTTY1: SETO A, ;7 unmap pages
MOVE B,[.FHSLF,,SCRPAG] ;7
SETZ C, ;7
PMAP ;7
MOVE A,LOGJFN ;7 close file
CLOSF ;7
JWARN ;7 error, tell him but continue
ABSKP ;7
GLTTY2: SETZM LTTYNO ;7 error, no terminal number
MOVE A,D ;7 restore A
RET ;7
> ;7 end OZ
;7 print out last login tty number
PLTTY: SKIPN Q1,LTTYNO ;7 if no last login TTY, forget it
RET ;7
TYPE < from > ;7
NOOZ,< TLZE Q1,.TTDES> ;7 network host?
OZ,< TLZN Q1,.TTDES> ;7 network host?
JRST PLTTY1 ;7 yes
ETYPE <TTY%5O> ;7 no
SETZ D, ;7 pseudo-terminal?
GTB .PTYPA ;7
HRRZ B,A ;7 isolate terminal number
HLRZ A,A ;7
ADD A,B ;7
CAML Q1,B ;7 lower than bounds
CAMLE Q1,A ;7 greater than bounds
ABSKP ;7
TYPE < (Pseudo-terminal)> ;7 yes
RET ;7 no
NOOZ,< ;7
PLTTY1: ETYPE <Host %5[> ;7 print host number
RET ;7
> ;7
OZ,< ;7
PLTTY1: HLRZ D,Q1 ;7 isolate net number
CAIN D,7 ;7 is it 7?
JRST PLTTY2 ;7 yes, go do CHAOSnet
CAIE D,12 ;7 is it 12?
RET ;7 no, bogus net number - say nothing
HRLI Q1,1200 ;7 yes, do ARPAnet, install proper net number
ETYPE <ARPAnet host %5[> ;7 print it
RET ;7
PLTTY2: HRRZ Q1,Q1 ;7 isolate host number
ETYPE <CHAOSnet host %5]> ;7 print it
RET ;7
>> ;7 end MIT, OZ
;;116 begin of addition
OZ,<
;Should use a logical name, but don't want this to be too visible to users.
ACOFDR: ASCIZ /PS:<ACCOUNTS.LIMBO>/
ACOFBF==:FREE
ACOFB1==:FREE+1000
;;CKACOF - called with A/ bp to type name
;;Tries to find and type out the file USERNAME.type in the ACOFDR directory
;;Skips if successful
CKACOF: STKVAR <ACOFTP>
TXCE A,.LHALF
TXCN A,.LHALF
HRLI A,(ASCPTR)
MOVEM A,ACOFTP
HRROI A,ACOFB1
MOVE B,LOGNO
DIRST
ERJMP R
MOVE A,[ASCPTR ACOFBF] ;Build filename here
MOVE B,[ASCPTR ACOFDR] ;First the directory
ILDB C,B
JUMPN C,[IDPB C,A
JRST .-1]
MOVE B,[ASCPTR ACOFB1] ;Now user name as filename
DO.
ILDB C,B
CAIE C,"."
IFSKP.
MOVEI D,.CHCNV
IDPB D,A
ENDIF.
CAIE C,.CHCNV
IFSKP.
IDPB C,A
ILDB C,B
ENDIF.
IDPB C,A
JUMPN C,TOP.
ENDDO.
MOVEI C,"." ;And now the filetype
DPB C,A
MOVE B,ACOFTP ;Given as arg
DO.
ILDB C,B
IDPB C,A
JUMPN C,TOP.
ENDDO.
HRROI B,ACOFBF
CALL TRYGTJ
RET
MOVEM A,ACOFTP
MOVX B,FLD(7,OF%BSZ)!OF%RD
OPENF
RET
HRROI B,ACOFBF
SETZ C,
SIN
ERNOP
IDPB C,B
MOVE A,ACOFTP
CLOSF
NOP
; UTYPE ACOFBF
MOVE A,COJFN
HRROI B,ACOFBF
SETZ C,
SOUT
MOVEM A,COJFN
RETSKP
> ;OZ
;;116 end of addition
;7 print out info about other jobs logged in under same user
JOBCNT: TRVAR <NDETCH,SAVEDP> ;1016
SETZM NDETCH ;1016 # detached non-FILE jobs
MOVEM P,SAVEDP ;1016
GJINF ;7 get job info
MOVE Q1,A ;7 get user no
HLLZ D,JOBRT ;7 make an AOBJN pointer for jobs
CALL JOBCNF ;7 find first other job
RET ;7 no others
MOVEI Q2,(D) ;7 got one, remember job no
MOVE Q3,A ;7 remember whether detached
CALL JOBCNN ;7 get the next other job
JRST [ETYPE < [Job %6Q> ;7 no others, just print this one
CAIGE Q3,0
JSP B,DETP ;1016
JRST JOBCN2] ;7 finish up
ETYPE < [Jobs %6Q> ;7 more than one
CAIGE Q3,0
JSP B,DETP ;1016
JOBCN1: MOVEI Q2,(D) ;7 copy job no
ETYPE <, %6Q> ;7 print it
CAIGE A,0
JSP B,DETP ;1016
CALL JOBCNN ;7 find next "other" job
ABSKP ;7 no more, finish up
JRST JOBCN1 ;7 some more loop
JOBCN2: ETYPE < also logged in under %5R]%_> ;7 parting message
SKIPE OPERF ;1016 Don't ask, if this is
JRST LEAVE0 ;1016 an OPERATOR job.
SKIPN BATCHF ;1016 Don't ask, if this is a batch job.
SKIPG A,NDETCH ;1016 Any detached jobs (not including FILE
JRST LEAVE0 ;1016 jobs)? Naw, so done.
CAIE A,1 ;1016 Only one?
JRST ATACHP ;1016 More than one, so ask for TTY#
PROMPT < Attach your detached job? [Confirm] > ;1016
CRRX <Confirm with carriage return> ;1016
JRST LEAVE ;1016
POP P,A ;1016
JRST DOATA1 ;1016
ATACHP: PROMPT < Attach to which job? (carriage return for none) > ;1016
CRRX <Decimal job# or carriage return for none> ;1016
ABSKP ;1016 Not <CR>
JRST LEAVE ;1016 Yes <CR>, so leave them alone
DECX ;1016 See if a decimal number
JRST LEAVE ;1016 Nope, luz
MOVE D,B ;1016 Save the number you gave in D
CRRX <Confirm with carriage return> ;1016
JRST LEAVE ;1016 Toad!
MOVS A,NDETCH ;1016 Now check to see if it's one of yours.
MOVNS A ;1016 -#on stack,,0
HRRI A,1(P) ;1016
SUB A,NDETCH ;1016
CAMN D,(A) ;1016
JRST DOATA ;1016
AOBJN A,.-2 ;1016
ETYPE <%%Pick one of the jobs shown above%_> ;1016
JRST ATACHP ;1016
DOATA: MOVE P,SAVEDP ;1016
MOVE A,D ;1016
DOATA1: MOVE B,Q1 ;1016 your user#
ETYPE < Attaching...%_> ;1016
ATACH ;1016
ERSKP ;1016
JRST KKJOB3 ;1016
ETYPE <?ATTACH failure, still attached to job # %J%_> ;1016
;1016 print out the jsys error message here
RET ;1016
LEAVE: ETYPE < Left detached%_>;1016
LEAVE0: MOVE P,SAVEDP ;1016
RET ;1016
DETP: PUSH P,A ;1016 Called via JSP B,DETP
PUSH P,B ;1016
PUSH P,C ;1016
MOVE A,Q2 ;1016 Job#
HRROI B,C ;1016 put results in C
MOVEI C,.JIPNM ;1016 Want program-name
GETJI ;1016
JRST ENDDET ;1016
JUMPE C,[HRROI B,C ;1016 Not there, so try for subsystem name.
MOVEI C,.JISNM ;1016
GETJI ;1016
JRST ENDDET ;1016
CAIN C,0 ;1016
MOVE C,[SIXBIT "NONAME"] ;1016
JRST .+1] ;1016
CAME C,[SIXBIT "DETACH"];1016 And if neither use "NONAME"
JRST [TYPE < (Det, > ;1016
MOVE A,C ;1016
CALL SIXPRT ;1016
TYPE <)> ;1016
JRST .+2] ;1016
TYPE < (Det)> ;1016
SKIPN BATCHF ;1016 If batch then don't save anything.
CAMN C,[SIXBIT "FILE"] ;1016 File jobs don't count
ABSKP ;1016
JRST SAVDET ;1016
ENDDET: POP P,C ;1016
POP P,B ;1016
POP P,A ;1016
JRST (B) ;1016 Return.
SAVDET: POP P,C ;1016
POP P,B ;1016
AOS NDETCH ;1016
EXCH Q2,(P) ;1016
MOVE A,Q2 ;1016
JRST (B) ;1016
JOBCNF: CALL USERNO ;7 get user no of particular job
CAMN Q1,A ;7 same user?
CAIN C,(D) ;7 yes, same job?
JOBCNN: AOBJN D,JOBCNF ;7 no, try next
JUMPGE D,JOBCN3 ;7 done?
GTB .JOBTT ;7 no, get job number
RETSKP ;7 sucess
JOBCN3: RET ;7 no more
;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
HLRZ C,SPB ;7 isolate LH of string pointer
CAIN C,-1 ;7 if real string pointer, skip dir tacking
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
SKIPN ATTINI ;7 taking ATTACH.CMD?
JRST TAKEI2 ;7 no
SETZM ATTINI ;7 yes
PROMPT < TAKE ATTACH.CMD file [Confirm]> ;7 make sure
CONFIRM ;7
TAKEI2: MOVX B,FLD(7,OF%BSZ)!OF%RD ;7 add local label
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: SETZM ATTINI ;7 make sure flag is reset
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?
;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]
LAZUSR: ;7 add local label
CALL BUFFF ;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
MOVE B,A
MOVX A,RC%EMO ;SAYS NO RECOGNITION
RCUSR ;STRING TO DIRECTORY # TRANSLATION
RETSKP
;ACCT
;ROUTINE TO INPUT ACCOUNT STRING, RETURNS SUITABLE ARG FOR LOGIN OR CACCT JSYS.
; USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.
ACCT:: ACCTX <Account name>
CMERRX
CALLRET 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: /]
JRST PASSX ;7
PASFLN: MOVEI A,[ASCIZ / Password: /] ;7 seperate line, don't accept null pasw
SETZ C, ;7
ABSKP ;7
PASSX:: MOVX C,1
SETOM PASCMD ;7
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
TXNE B,TT%DUM ;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
ABSKP ;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: ETYPE <%_>
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
CALL DOECHO ;7 solve half-duplex problem (frank@utah-20)
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
INPP1: 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
ETYPE < You have a message%_> ;USER TYPES FILE TO RECEIVE MESSAGE
>
NEWF,<
;7 already done in login
;7 HRLOI B,377777 ;SET INF COUNT FOR US
;7 MOVEM B,MWATN0
MOVE B,CUSRNO ;SETUP FOR MAIL CHECK FOR THIS USER
;7 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
SETO A,
HRROI B,C ;1 WORD INTO C
MOVX 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
;
; ACCEPTS: B/ POINTER TO STRING FOR GTJFN
; RETURNS: +1 NO SUCH FILE
; +2 A/ JFN
; USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.
TRYGTS::PUSH P,B ;7 output file, ignore job logicals
PUSH P,A ;7
MOVX A,GJ%FOU!GJ%PHY!GJ%SHT ;7
JRST TRYGT1 ;7
TRYGTO::PUSH P,B
PUSH P,A
MOVX A,GJ%FOU!GJ%SHT
JRST TRYGT1
TRGTV1::PUSH P,B
PUSH P,A
MOVX A,GJ%OLD!GJ%SHT!1 ;OLD FILE, SHORT CALL, VERSION 1
JRST TRYGT1
TRYGTL: PUSH P,B
PUSH P,A
MOVX A,GJ%OLD!GJ%SHT!GJ%ACC ;OLD FILE, SHORT, NO ACCESS
JRST TRYGT1
TRYGTJ::PUSH P,B
PUSH P,A
MOVX 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]
ADJSP P,-1 ;FORGET SAVED A
AOS -1(P) ;SKIP
TRYG9: POP P,B
RET
.KKJOB::SKIPN CUSRNO ;7 logged in?
JRST KKJOB1 ;7 no
DECX <a job number or a carriage return for this job> ;7 input
JRST KKJOB1 ;7 no number kkjob own
CAMN B,JOBNO ;7 is this self?
ERROR <If you want to kill this job, use KKJOB with no job number> ;7
PUSH P,B ;7 store job no
CONFIRM ;7
CALL CONKIL ;7 confirm
MOVE B,A ;7 unattach
MOVE A,(P) ;7
TXO A,AT%CCJ!AT%NAT ;7
ATACH ;7
NOP ;7 might not work if not logged in
POP P,A ;7 logout
LGOUT ;7
CALL JERR ;7
RET ;7
KKJOB1: CONFIRM ;7
CALL CHKLGO ;7 can we logout?
CALL BLANK1 ;7 blank screen
MOVE A,JOBNO ;7 type out msg
ETYPE <Kkjob Job %J, > ;7
SKIPN CUSRNO ;7
JRST KKJOB2 ;7
ETYPE <User %N, Account > ;7
CALL PRACCT ;7
TYPE <, > ;7
KKJOB2: ETYPE <%L, %_ at %D %A, Used %B in %C %_> ;7
DTACH ;7 detach
KKJOB3: SETO A, ;7 logout
LGOUT ;7
HALTF ;7
JRST HUNG ;7
;LOGOUT
.LOGOU::SKIPN CUSRNO ;LOGGED IN?
JRST LOGOU1 ;NO, ONLY ONE CASE
DECX <a job number or a carriage return for this job>
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
CALL CHKLGO ;7 check to see if we have logout capability
SKIPE LGOCMD ;7 inside logout.cmd?
JRST LOGOU2 ;7 yes, don't hang up
XTND,< SKIPE BATCHF ;7 don't bother for batch
JRST LOGO1A
CALL BLANK1 ;CLEAR SCREEN
CALL DWNPNT ;INFORM DOWNTIME
>
LOGO1A: 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 [ETYPE <%%Warning -- EXPUNGE failed, continuing...%_>
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 [ETYPE <%%Warning -- EXPUNGE failed, continuing...%_>
JRST .+1]
MOVE A,LIDNO
GTDAL ;GET USAGE/ALLOCATION
JUMPE B,LOGOU2 ;CAN'T BE OVER IF USAGE=0
SUB B,C ;SUBTRACT PERMANENT ALLOCATION FROM USAGE
CAILE B,0 ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).%_>
MOVE Q1,CIJFN ;7 do "TAKE LOGOUT.CMD"
HRROI B,[ASCIZ/LOGOUT.CMD/] ;7
CALL TAKEIN ;7
JRST LOGOU2 ;7
SETOM LGOCMD ;7 flag it
RET ;7
LOGOU2:: ;7 make label global
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 ;7 LGOUT doesn't always work!
HALTF ;7 try to halt
HUNG: MOVX A,SIXBIT/HUNG!/ ;7 tell the world it's hung
SETNM ;7
WAIT ;7 just hang quietly
;7 CALL CJERR ;DOESN'T RETURN ON SUCCESS
CHKLGO: MOVX A,.FHSLF ;7 check if we can logout from here
RPCAP ;7
TXNN B,SC%LOG ;7
ERROR <Cannot LOGOUT from here (try POP)> ;7
RET ;7
;"MERGE" IS WITH "GET" ABOVE.
;'PUSH' = 'PUSH EXEC' (FORMERLY 'EXEC') STARTS AN EXEC IN INFERIOR FORK
; SEPARATE FROM 'FORK'
.PUSH:: NOISE (command level)
CONFIRM
DELETE,<CALL PNTMES> ;MAKE SURE SYSTEM MESSAGES HAVE BEEN SEEN
;BEFORE DOING "PUSH"
;7 MOVX A,1B2!1B17 ;7 not looked at
HRROI B,[GETSAVE <SYSTEM:EXEC.>]
CALL TRYGTJ ;GTJFN AND SAVE IT
ERROR <EXEC not found>
PUSH P,A
MOVX A,CR%CAP ;XMIT CAPS
CFORK
CALL CJERR
MOVEM A,EFORK
POP P,A
HRL A,EFORK
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED
MOVE A,EFORK
SETZ B,
SFRKV
ERJMP CJERRE
WFORK
RFSTS
MOVE C,A
MOVE A,EFORK
SETZM EFORK
KFORK
CAME C,[RF%FRZ!FLD(.RFHLT,RF%STS)]
CAMN C,[FLD(.RFHLT,RF%STS)] ;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:: MOVX A,SIXBIT/^EQUIT/ ;7 setup proper name
SETNM ;7
CALL INFER ;SKIP IF INFERIOR
JRST [MOVX B,WHLU ;7 only WHEELs can quit from top
SKIPE PRVENF
CALL PRVCK
ERROR <Wheel capability required to quit from top-level>
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 REENTE ;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
MOVX A,.FHTOP ;SAY TOP FORK
SETZ B, ;SAY NO HANDLES OR STATUS
MOVEI C,1(P) ;SAY BUILD STRUCTURE ON STACK
HRLI C,-4 ;BUT 4 WORDS MAX
ADJSP P,4 ;MAKE ROOM ON STACK
GFRKS ;GET 'STRUCTURE' OF TOP FORK
CALL [CAIE A,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
RET] ;YES, WE EXPECT THAT
HRRZ A,1(C) ;GET HANDLE OF TOP FORK
ADJSP P,-4 ;CLEAR STACK
CAIN A,.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
MOVX A,TL%ABS!TL%AAD!FLD(.CTTRM,TL%OBJ)
JUMPE Q1,REC2 ;IF Q1 STILL 0, ASSUME SYSTEM-MESSAGES
TDO A,Q1 ;GET ENABLE BITS
TLINK
CALL JERR
RET ;7 style
;7 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
OZ,< T sends,,.RESND> ;1017
T system-messages,,.RESYS ;1017
TEND
.READV: TXO Q1,TL%STA
TLNE Z,F4 ;RECEIVE?
RET ;NO - RETURN
TXO Q1,TL%SAB ;LINKS TOO
NOISE <and links>
RET
.RELNK: TLNE Z,F4 ;WHICH KIND?
NOISE <and advice>
TXO Q1,TL%SAB
RET
OZ,<
.RESND: MOVEI Q2,.MOSRM ;1017
RET ;1017
>
.RESYS: MOVEI Q2,.MOSNT ;1017
RET ;1017
;REFUSE (LINKS)
.REFUS::TLO Z,F4 ;SAY REFUSE CMD
CALL RECREF ;CALL RECEIVE/REFUSE SUBR
MOVX 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 or sends
REF2: MOVX C,.MOSMN ;SAY REFUSE
REF1: MOVX A,.CTTRM
MOVE B,Q2 ;FUNCTION CODE FOR CONTROLLING MESSAGES
MTOPR ;DO IT
ERCAL CJERRE ;COULDN'T
RET
;RECEIVE SYSTEM-MESSAGES or sends
REC2: MOVX C,.MOSMY
JRST REF1
;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>
.RENAM::SETOM TYPGRP ;TYPE ALL FILES
NOISE <existing file>
CALL INFGN2 ;7 default to highest version only
;7 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>
HRROI A,0 ;NO DEFAULT NAMES
HRLI B,0 ;DEFAULT VERSION IS 0
HRRI B,(GJ%OLD!GJ%IFG!GJ%NS!CF%GRP!CF%EOL!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
MOVX 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:: MOVEI A,[ASCIZ/^ESEND/] ;7 setup for program name setup
HRROM A,COMAND ;7
TRVAR <SNDPT,SNDLNO>
NOISE <to>
OCTX <an octal line # or * for all>
ABSKP ;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
NOISE <message> ;7 style change
MOVE A,CSBUFP ;GET POINTER TO STRING BUFFER
MOVEM A,SNDPT
CALL SCRLF ;INSERT INITIAL CRLF
MOVX 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/, TTY/] ;7 style change
;7 HRROI B,[ASCIZ / on line /] ;GET SOME MORE TEXT
SETZ C,
SOUT ;STORE IT
MOVE B,D ;GET NUMBER IN RIGHT AC
MOVX C,FLD(10,NO%RDX) ;OCTAL OUTPUT
NOUT ;STORE TERMINAL NUMBER
CALL JERR
DETSND: SETO B, ;7 test for send all
CAMN B,SNDLNO ;7
SKIPA B,[TXTPTR < (to *): >] ;7
HRROI B,[ASCIZ/: /] ;7
DELETE,<HRROI B,[ASCIZ/: /] ;7 old code here
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
SETZ C, ;STOP ON NULL
SOUT
MOVEM A,SNDPT ;UPDATE POINTER
MOVX Q1,"]"
IDPB Q1,SNDPT ;WITH CLOSE BRACKET
CALL SCRLF ;AND TERMINATE WITH CRLF
SETZ Q1, ;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
CAIL A,0 ;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: A/ POINTER TO ORIGINAL TEXT
; RETURNS: +1 A/ POINTER TO NEW TEXT
SNDSIZ==^D71 ;MAX SIZE OF ^ESEND LINES
SNDFIX: MOVE C,[ASCPTR 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,[ASCPTR BUF0] ;GET POINTER TO START OF STRING
RET ;DONE, RETURN
;SCRLF - ROUTINE TO ADD CRLF TO INITIAL STRING ASSEMBLED BY ^ESEND
SCRLF: MOVX Q1,CR ;INSERT CRLF SEQUENCE
IDPB Q1,SNDPT ; INTO MESSAGE
MOVX Q1,LF
IDPB Q1,SNDPT ;...
RET
;TAKE (EXEC INPUT FROM) FILESPEC
LAZTAK::MOVEI A,[ASCIZ/TAKE/] ;7 setup for program name setup
HRROM A,COMAND ;7
ABSKP ;7
.TAKE:: NOISE <commands from>
TRVAR <TAKCON,JFN1,JFN2>
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
SKIPN LAZCMD ;7 lazy take?
JRST TAKE0A ;7 no
HRROI A,[ASCIZ/SYS/] ;7 yes
MOVEM A,.GJDEV+CJFNBK ;7 make SYS: the default
MOVEI B,[FLDDB. .CMFIL] ;7
CALL FLDSKP ;7
RETSKP ;7 try the next lazy feature
JRST TAKE0B ;7
TAKE0A: MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<a command file name>,,[
FLDDB. .CMCMA,CM%SDH,,<a comma to enter subcommands>,,[
FLDDB. .CMCFM,CM%SDH,,<a carriage return to end current
command level>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED!
GTFLDT C ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST PRIRES ;YES
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GET SUBCOMMANDS
TAKE0B: ;7 add local label
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. .CMFIL,CM%SDH,,<an output file name>,,[
FLDDB. .CMCMA,CM%SDH,,<a comma for no change, but to enter
subcommands>,,[
FLDDB. .CMCFM,CM%SDH,,<a carriage return if no change of
output desired>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED
GTFLDT 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
SETZ Q1, ;FIRST ASSUME NO SUBCOMMANDS
COMMAX <Comma to enter subcommands, or confirm with carriage return>
ABSKP ;NO SUBCOMMANDS COMING
MOVX Q1,1 ;SUBCOMMANDS COMING
CONFIRM ;REQUIRE CONFIRMATION AFTER FILE NAME
JUMPE Q1,TAKE1 ;SKIP SUBCOMMAND STUFF IF NO COMMA
ABSKP ;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
MOVX B,FLD(7,OF%BSZ)!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
MOVX B,FLD(7,OF%BSZ)!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: SKIPE LGOCMD ;7 in logout.cmd?
JRST LOGOU2 ;7 yes
CALL CIOREL ;POP BACK ONE LEVEL
ABSKP ;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,,<an output file name>]
CALL FLDSKP ;READ FILESPEC
CMERRX ;THAT'S NOT WHAT IT WAS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
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
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
DVCHR
LDB B,[POINTR B,DV%TYP] ;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?
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
ERNOP ;FAILED, PROBABLY BECAUSE 100 OR 101
HLRZ A,C ;GET OTHER JFN
CLOSF
ERNOP
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>
HRROI A,0 ;NO DEFAULT NAMES
MOVX B,(GJ%OLD!GJ%NS!GJ%DEL!GJ%IFG!CF%GRP!CF%EOL!CF%NS) ;"MUST BE NEW",
; "IGNORE DELETED BIT" AND NO SEARCHING TO BE
; DONE
HRLI B,-3 ;DEFAULT VERSION IS *
TXO Z,IGINV ;7 don't make it depend on right half
;7 TRO Z,IGINV ;SEE INVISIBLE FILES
CALL SPECFN ;INPUT FILE NAME USING GTJFN FLAGS IN B
NOP ;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%_>
MOVX A,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER
ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT
; JFN
JRST UNDEL8]
HRRZ A,@INIFH1
MOVE B,[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
TXNE A,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER ;ANY *'S?
JRST UNDEL8 ;YES, NO MESSAGE
CALL TYPIF ;PRINT NAME
ETYPE < 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 [ETYPE < 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:: MOVX A,SIXBIT/^EEDDT/ ;7 setup correct name
SETNM ;7
SKIPE DDTORG
JRST EDDT4 ;DDT ALREADY THERE
SKIPN Q1,.JOBSY ;DO WE HAVE SOME SYMBOLS?
SKIPE Q1,JOBSYM ;???
SKIPA B,[ASCPTR [GETSAVE <SYS:UDDT.>]]
HRROI B,[GETSAVE <SYS:SDDT.>] ;USE SDDT IF NO SYMBOLS
MOVX 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.
MOVX A,.FHSLF
DMOVE B,[EVLEN
EXEC] ;ENTRY VECTOR
CALL SETENT
;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.
CAIN Q1,0 ;HAVE ONE?
JRST [ETYPE <%% 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)
.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
MOVX A,.FHSLF ;"ENABLE" JOINS HERE
RPCAP
TRZ C,-1
SKIPE PRVENF
HRR C,B
MOVE D,C ;REMEMBER EXEC'S CAPS
EPCAP ;EXEC'S CAPABILITIES
SKIPG A,FORK
RET ;NO INFERIOR, DONE
RPCAP
MOVE C,D ;SET FORK TO WHATEVER WE ARE
EPCAP ;INFERIOR'S CAPS
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 #)
..LOGO: PUSH P,A ;7 make label local
GJINF
CAMN C,(P) ;THIS JOB?
ERROR <If you want to logout this job, use LOGOUT with no job number>
MOVE D,(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
CAIGE A,0 ;REQUESTED JOB EXISTS?
ELOGO1: ERROR <That job does not exist>
CONFIRM
CALL CONKIL ;7 confirm kill
POP P,A
LGOUT
CALL CJERR
RET ;7 style
;7 JRST CMDIN4
CONKIL: MOVE A,-1(P) ;7 we need the job no
TRVAR <CKJNUM,CKJTTY,CKJUNO,CKJCDN,CKJSSN,CKJPNM> ;7 room for table
MOVEI B,CKJNUM ;7
HRLI B,-6 ;7
MOVX C,.JIJNO ;7 first entry
GETJI ;7 get info
ERROR <Bad job number> ;7
MOVE A,COJFN ;7 output job number
MOVE B,CKJNUM ;7
MOVX C,NO%LFL!FLD(4,NO%COL)!FLD(^D10,NO%RDX) ;7
NOUT ;7
JRST CJERR ;7
SKIPGE B,CKJTTY ;7 output tty number
JRST [TYPE < DET> ;7 detached
JRST CONKI1] ;7
MOVX C,NO%LFL!FLD(6,NO%COL)!FLD(10,NO%RDX)
NOUT ;7
JRST CJERR ;7
CONKI1: MOVE B,CKJPNM ;7 output program name
MOVE A,CKJUNO ;7 and user name
SKIPN A ;7
JRST [ETYPE < %2' Not logged in> ;7
JRST CONKI2] ;7
ETYPE < %2' %1R> ;7
CONKI2: PROMPT < LOGOUT this job? [confirm]> ;7 confirm
CONFIRM ;7
MOVE A,CKJUNO ;7 return user number in a
RET ;7
NEWF,<
.BLANK::NOISE <screen>
CONFIRM
BLANK1::
NOVTS,< STKVAR <TMOD>> ;717
MOVE A,COJFN ;CURRENT OUTPUT JFN
VTS,< MOVX B,.VTCLR ;717 set function code
VTSOP ;717
ERNOP ;717 terminal can't do it - so ignore
RET ;717
> ;717
NOVTS,< RFMOD ;717 GET MODE WORD
MOVEM B,TMOD ;SAVE IT
TXZ B,TT%DAM ;NO XLATION
SFMOD
GTTYP ;GET TERMINAL TYPE
CAIG B,BLNKMX ;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
BLNKTB: 0 ;(0) 33 TTY
0 ;(1) 35 TTY
0 ;(2) 37 TTY
0 ;(3) EXECUPORT/TI
MIT,< BYTE (7)177,21,177,4,0 ;717 (4) Imlac
BYTE (7)2,35,36,0 ;717 (5) Datamedia Elite 2500
BYTE (7)33,"H",33,"J",0 ;717 (6) Hewlett Packard 2645
0 ;717 (7) nvt
>
NOMIT,<REPEAT 4,<0>> ;(4-7) free
0 ;(8) system default/TI733
0 ;(9) IDEAL (no fill)
[BYTE (7)35,177,177,177,177,177,177,37,0] ;(10) DEC VT05
BYTE (7)33,"H",33,"J",0 ;(11) DEC VT50
0 ;(12) DEC LA30
MIT,< 0> ;(13) (not supported)
NOMIT,< BYTE (7)35,37> ;(13) DEC GT40 - no fill required
0 ;(14) DEC LA36
BYTE (7)33,"H",33,"J",0 ;(15) DEC VT52
MIT,< 0 ;717 (16) glass
BYTE (7)33,"H",33,"J",0 ;717 (17) Perkin-Elmer Fox
BYTE (7)33,"H",33,"J",0 ;717 (18) DEC VT100 in VT52 mode
>
NOMIT,< [BYTE (7)33,"[","H",33,"[","J",0] ;(16) DEC VT100
0 ;(17) DEC LA38
0 ;(18) DEC LA120
>
MIT,< BYTE (7)33,"H",33,"J",0 ;717 (19) Teleray 1061
BYTE (7)33,"H",33,"J",0 ;717 (20) Heath/Zenith 19
BYTE (7)33,"?",33,5,0 ;717 (21) HDS Concept 100
[BYTE (7)33,"[","H",33,"[","J",0] ;717 (22) DEC VT100 in ANSI mode
0 ;717 (23) DEC LA38
0 ;717 (24) DEC LA120
BYTE (7)33,"H",33,"J",0 ;717 (25) plasma tv
0 ;717 (26) supdup nvt
BYTE (7)33,"H",33,"J",0 ;717 (27) Hewlett Packard 2640
[BYTE (7)33,"[","H",33,"[","J",0] ;717 (28) Ann Arbor Ambassador
[BYTE (7)33,"[","H",33,"[","J",0] ;717 (29) BBN Bitgraph
>
NOMIT,< REPEAT ^D11,<0>> ;(19-29) free
REPEAT 5,<0> ;(30-34) free
[BYTE (7)33,"[","H",33,"[","J",0] ;(35) DEC VT125
[BYTE (7)33,"[","H",33,"[","J",0] ;(36) DEC VK100 (GIGI)
BLNKMX=.-BLNKTB
> ;717 end NOVTS
> ;end NEWF
;7 DISPLAY interpret and display line user input
;7 like ECHO command below, but interprets ETYPE codes
.DISPL::LINEX <Format text line to be displayed> ;7
CMERRX ;7
CONFIRM ;7
SAVEAC <P1,P2,P3,P4,P5> ;7 save these registers
MOVE P4,[DSPREG,,A] ;7 copy in the display registers
BLT P4,P4 ;7
HRROI P5,ATMBUF ;7
ETYPE <%14\> ;7 doesn't automatically print return
RET ;7
;7 ECHO what the user types
.ECHOL::LINEX <Text line to be echoed> ;7 type back what the user types
CMERRX ;7 useful for printing in TAKE files
CONFIRM ;7
HRROI A,ATMBUF ;7
ETYPE <%1$%%_> ;7
RET ;7
;7 REPLACE EXEC (WITH)
;7 code should maybe rewritten to use built in subrs
.TREPL::TLOA Z,F4 ;7 flag top-level replace
.REPLA:: TLZ Z,F4 ;7 flag REPLACE command
NOISE <EXEC with> ;7
MOVEI A,[ASCIZ/SYS:/] ;7
CALL CPFN ;7 collect program name
CALL [MOVE A,ERCOD ;7 set up error code
JRST CJERR] ;7 print message
PUSH P,A ;7 save JFN
CALL JFNSTK ;7 stack JFN to get rid of it
MOVE A,CSBUFP ;7 get pointer to build cmd line
MOVE B,JBUFP ;7 get pointer to jfn of program
MOVE B,(B) ;7 JFN to B
MOVX C,FLD(.JSAOF,JS%NAM) ;7 the name field only
JFNS ;7 get file name
EXCH A,CSBUFP ;7 update pointer to string buffer
MOVEM A,RSPTR ;7 remember RSCAN pointer
LINEX <Data line to be sent to program> ;7
CMERRX ;7
MOVE B,CMABP ;7 get pointer to beginning of end of line
ILDB C,B ;7 get first character of rest of line
MOVX B,.CHSPC ;7 space to seperate filename from line
MOVE A,CSBUFP ;7 point to end of filename
CAIE C,.CHNUL ;7 is there any more to the line?
BOUT ;7 yes, so put the space in
MOVE B,CMABP ;7 get pointer to atom buffer (rest of line)
SETZ C, ;7 end on NULL
SOUT ;7 copy rest of line for RSCAN
HRROI B,[BYTE (7).CHLFD,0] ;7 LINEFEED to end RSCAN buffer
SETZ C, ;7
SOUT ;7 finish line with LINEFEED
IBP A ;7 leave NULL after line
MOVEM A,CSBUFP ;7 save new pointer to string storage
CONFIRM ;7
TLNE Z,F4 ;7 if replace command,
CALL INFER ;7 or top-level and treplace,
ABSKP ;7 do the replace
JRST [ADJSP P,-1 ;7 else fix up stack
CALLRET RLJFNS] ;7 and forget about it
MOVE A,(P) ;7 open file
MOVX B,OF%RD!OF%EX ;7
OPENF ;7
CALL CJERR ;7
HRLZ A,(P) ;7 find first used page of file
FFUFP ;7
CALL JERR ;7
MOVE B,[.FHSLF,,BUF0PN] ;7 map a page from the file
MOVX C,PM%RD!PM%EX ;7
PMAP ;7
ERCAL CJERRE ;7
SETO A, ;7 success, now get rid of page
SETZ C, ;7
PMAP ;7
MOVE A,(P) ;7 close file
TXO A,CO%NRJ ;7 (without losing JFN)
CLOSF ;7
CALL CJERR ;7
CALL CRSCAN ;7 put right thing in RSCAN buffer
MOVX A,.FHSLF ;7
DIR ;7 turn off the interrupts
SETO B, ;7 now de-activate all channels
DIC ;7
POP P,A ;7 get back the JFN
MOVE P,A ;7 save the JFN (all pages will disappear)
SETO A, ;7 remove pages
MOVSI B,.FHSLF ;7 free from this fork (start at page 0)
MOVX C,PM%CNT!FLD(1000,PM%RPT) ;7 all 1000 pages (everything)
MOVE D,[RUNCOD,,Q3] ;7 move rest of code to
BLT D,CX ;7 ACS 10-16
JRST Q3 ;7 do it there
;7 (A) -1
;7 (B) .FHSLF
;7 (C) PM%CNT!1000
;7 (D) left over from BLT
;7 (Q1,Q2) ?
RUNCOD: PMAP ;7 (Q3) do the actual deletion
MOVSI A,.FHSLF ;7 (P1) get into this fork handle
HRR A,P ;7 (P2) from this file's jfn
GET ;7 (P3) go get it
MOVEI A,.FHSLF ;7 (P4) get this forks entry vector
GEVEC ;7 (P5)
CLZFF ;7 (AC15) close all we can
JRST (B) ;7 (CX) start the fork
;7 (P) JFN
;7 ^ERESET - supposedly unwedge a device
.ERESE::MOVEI A,[ASCIZ/^ERESE/] ;7 setup correct program name
HRROM A,COMAND ;7
NOISE <device> ;7 get a device
DEVX <name of device to reset> ;7
CMERRX ;7
MOVE A,B ;7 get device type
DVCHR ;7
LDB D,[POINTR B,DV%TYP] ;7
CONFIRM ;7
CAIE D,.DVPTY ;7 PTY or TTY?
CAIN D,.DVTTY ;7
JRST RESTTY ;7
LPTD,< CAIN D,.DVLPT ;7 LPT:?
ERROR <Please examine the state of LPTSPL> ;7
>
CAIN D,.DVNUL ;7 NUL:?
ERROR <Reseting the NUL: device has no effect> ;7
ERROR <No reset capability for device %1H:> ;7 something else
RESTTY: CFIBF ;7 clear input buffer
ERNOP ;7
CFOBF ;7 clear output buffer
ERJMP CJERR ;7
RET ;7
LITS1: ;713 debugging aid: literals label
END