Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
;<4.EXEC>EXEC1.MAC.152, 3-Jan-80 16:06:38, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<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) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH XDEF
TTITLE EXEC1
;THIS FILE CONTAINS
;LOTS OF COMMANDS...
; ARCHIVE <Files>
; F2 - Don't flush file contents
.ARCHI::NOISE <FILES>
TLZ Z,F2 ; Default is to not retain contents
MOVE A,[XWD -1,0] ; No default names
HRLI B,-3 ; Default version is *
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
CALL SPECFN
JRST ARCHI1
JRST ARCHI2 ; Do it
ARCHI1: SUBCOM $ARCHIV
ARCHI2: SETOM TYPGRP ; Always type name
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
MOVX C,.ARSET ; with no flags
TLNE Z,F2 ; Want to retain file contents?
TXO C,AR%NDL ; Right, flag that on the call
PUSH P,C ; Save disposition bits etc
ARCHI3: CALL RLJFNS
CALL NXFILE
JRST ARCHI9
CALL TYPIF
CALL MFINP ; Get 2nd JFN
JRST ARCHI9 ; Failed
MOVX B,.ARRAR ; Function code to use (pls archive)
MOVE C,0(P) ; And bits
ARCF
ERJMP [ETYPE < %?%%_>
JRST ARCHI9]
HRLI A,.FBCTL
MOVX B,FB%INV ; Make the file invisible too
MOVX C,FB%INV
TLNN Z,F2 ; RETAIN CONTENTS?
CHFDB
ERJMP [ETYPE < %?%%_>
JRST .+1]
TYPE < [Requested]
>
ARCHI9: SKIPE INIFH1 ; Done them all?
JRST ARCHI3 ; No, loop
SETZM .JBUFP
ADJSP P,-1 ; Flags no longer useful
RET
; Tables etc. to ARCHIVE
$ARCHI: TABLE
T RETAIN,,.ARFL
TEND
.ARFL: NOISE <DISK CONTENTS>
CONFIRM
TLO Z,F2
RET
;LET (LOGICAL NAME) -- (AS) --
EDEFIN::
TLO Z,F2
NOISE <SYSTEM LOGICAL NAME>
JRST .ASSO
.DEFIN::TLZ Z,F2
NOISE <LOGICAL NAME>
.ASSO: STARX <
Logical name to define or delete,
or "*" to delete all>
JRST .ASSO1 ;NOT "DEFINE *"
PUSH P,[0] ;PUSH 0 TO INDICATE ALL
JRST .ASSO2 ;AND EAT TERMINATOR
.ASSO1: STRX <Logical name to define or delete> ;READ LOGICAL NAME
CMERRX
CALL BUFFF ;GET POINTER TO NAME
PUSH P,A ;SAVE PNTR
.ASSO2: SKIPN (P) ;ALL?
JRST .ASS3B ;YES, SEPERATE ROUTINE
NOISE <AS>
CRRX <Definition list or null to delete>
CAIA ;NOT JUST "DEFINE FOO<CR>"
JRST .ASSO9 ;YES, JUST "DEFINE FOO<CR>"
LINEX <Definition list> ;READ DEFINITION LINE
CMERRX ;NOT ANYTHING LEGAL AFTER "DEFINE" !
CALL BUFFF ;GET POINTER TO DEFINITION STRING
CONFIRM
MOVE C,A ;NEW NAME IN C
MOVEI A,.CLNJB
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSY ;YES
.ASSO4: TLNE Z,F2 ;SYSTEM?
CALL FCONF ;YES, FORCE FURTHER CONFIRMATION
MOVE B,(P) ;GET LOGICAL NAME
PUSH P,A ;REMEMBER ATTEMPTED FUNCTION IN CASE ERROR
CRLNM
JRST ASSONO ;COULDN'T DO IT
POP P,(P)
POP P,(P) ;FIX STACK
RET
;HERE WHEN LOGICAL NAME MANIPULATION FAILED
ASSONO: CAIE A,CRLNX1
CALL CJERRE ;UNKNOWN ERROR
POP P,A ;NOW WE KNOW "NAME UNDEFINED"
CAIE A,.clnj1 ;TRYING TO DELETE ONE JOB NAME?
CAIN A,.clns1 ;OR TRYING TO DELETE ONE SYSTEM NAME?
CAIA ;YES
CALL CJERRE ;NO, TYPE MONITOR MESSAGE
POP P,A ;GET POINTER TO NAME WE COULDN'T DELETE
ETYPE <%%Logical name %1M: was not defined
>
RET ;NON-FATAL ERROR IF DELETING NON-EXISTENT LOGICAL NAME
.ASSO9: MOVEI A,.CLNJ1 ;DELETE
TLNE Z,F2
MOVEI A,.CLNS1
JRST .ASSO4
.ASS3B: CRRX <Confirm to delete all logical names>
CMERRX
MOVEI A,.CLNJA ;DELETE ALL
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSA
TLNE Z,F2 ;SYSTEM?
PROMPT <[Confirm to delete all SYSTEM logical names]>
TLNN Z,F2
PROMPT <[Confirm to delete ALL logical names]>
CALL FCONFA
CRLNM
CALL CJERR
POP P,B
RET
;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>
;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM:
;ATTACH
;(USER) <NAME>
;(PASSWORD) ----
;(TSS JOB #) <#>
;PASSWORD IS NOT ECHOED IN FULL DUPLEX, TYPED OVER MASK ON
;FOLLOWING LINE IN HALF DUPLEX.
;TSS JOB # CAN BE OMITTED IF THERE IS ONLY ONE JOB FOR GIVEN USER.
;IF NOT LOGGED IN, CURRENT JOB GOES AWAY (HANDLED BY MONITOR),
;IF LOGGED IN IT IS DETACHED.
;IN ORDER TO NOT HAVE TO HAVE THE EXEC WAKING UP AFTER EVERY FIELD
;OF INPUT TO SEE IF WE'RE DOING SOME SORT OF PASSWORD COMMAND, THE
;FORMAT OF THE "ATTACH" AND "UNATTACH" COMMANDS HAVE BEEN CHANGED TO
;PROMPT FOR THEIR PASSWORD ON THE SECOND LINE. SINCE THE CR AT END
;OF FIRST LINE CAUSES WAKEUP, THIS GUARANTEES THAT ECHOING WILL HAVE
;A CHANCE TO BE TURNED OFF BEFORE USER TYPES PASSWORD.E.O. JUL-8-77
.ATTAC:: ;ENTRY FOR COMMAND, NEXT TAG IS FROM UNATTACH
IFNBATCH <[ERROR <ATTACH illegal from BATCH job>]>
ATTAU1:
;DECODE ARGUMENTS
TRVAR <ATTNM,<APBUF,20>,AT1,AT2> ;HOLDS ATACH ARGS
NOISE <USER>
CALL USERN ;INPUT USER (DIRECTORY) NAME
CMERRX ;FAILED, PRINT REASON
TXNE A,RC%DIR
ERROR <That's a FILES-ONLY directory name>
PUSH P,C ;SAVE DIR #
SETOM ATTNM ;CLEAR ATTACHED TERMINAL # HERE
NOISE <JOB #>
DECX < Number if more than one job under that name>
CAIA ;NON-DECIMAL NUMBER TYPED
JRST ATTNUM ;NUMBER TYPED, GO PROCESS IT
CONFIRM ;REQUIRE CONFIRMATION OF COMMAND
JRST ATTAC5 ;GO DEFAULT A VALUE
ATTNUM: CONFIRM
PUSH P,B ;SAVE JOB # INPUT BY USER
;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE
SETO D,
GTB .JOBRT ;GET MAX JOB # AS LENGTH OF SYSTEM TABLE
MOVN A,A ;LENGTH COMES BACK NEGATIVE
SUBI A,1 ;SO VALUE COMES OUT RIGHT IN ERR MSG
CAML A,(P) ;LENGTH MUST BE > GIVEN #
SKIPGE D,(P) ;GIVEN JOB # TO D
ERROR <Job # must be between 0 and %1Q>
;MAKE SURE GIVEN JOB # IS LOGGED IN W MATCHING USER # AND IS ATTACHED
GTB .JOBRT ;ENTRY NEG IF NO SUCH JOB
JUMPL A,[UERR[ASCIZ/No job %4Q/]]
GTB .JOBTT ;LINE # OR NEGATIVE FOR DETACHED IN LH
HLREM A,ATTNM ;STORE ATTACHED LINE NUMBER FOR LATER
CALL USERNO ;GET USER OWNING JOB BEING ATTACHED
JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]]
MOVE Q1,-1(P) ;DESIRED USER #, FOR USE IN ERR MSG
CAME A,Q1
ERROR <Job %4Q not logged in under %5R>
JRST ATTAC7 ;GO CONFIRM AND EXECUTE
;ATTACH...
;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME.
ATTAC5: ;SEARCH JOBDIR TABLE FOR A MATCH
GJINF ;GET JOB # INTO C FOR TEST LATER
MOVE Q1,(P) ;DIR # TO SEARCH FOR (USED IN ERR MSGS!)
SETO D,
GTB .JOBRT ;JOBRT TABLE BY JOB #, LOGIN DIR # IN RH.
HRLZ D,A ;SET UP XWD LENGTH, INDEX FOR AOBJN & GTB.
TLZ Z,F2 ;FLAG NO DETACHED JOBS SEEN YET
PUSH P,[-1] ;INIT JOB TO UNKNOWN
ATA5A: CAIN C,(D) ;ALWAYS SKIP US
JRST ATA5L
CALL USERNO
CAME A,Q1 ;IS THIS CORRECT USER?
JRST ATA5L ;NO
GTB .JOBTT ;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...
ATTAC7:
;CHECK FOR SELF
GJINF ;GET JOB NUMBER IN C
CAMN C,(P) ;IS IT US?
JRST [ TLNN Z,F1 ;ATTACH OR UNATTACH?
ERROR <Cannot ATTACH to self>
ERROR <Cannot UNATTACH self>]
;CHECK FOR ALREADY ATTACHED
SKIPGE A,ATTNM ;TTY #
JRST ATAC4B
HRROI B,APBUF ;REDIRECT OUTPUT TO OUR BUFFER
MOVEM B,COJFN
ETYPE < [Attached to TTY%1O, confirm]>
CALL FIXIO ;RESUME NORMAL OUTPUT
UPROMP APBUF ;PROMPT USER FOR CONFIRMATION
CALL FCONFA
ATAC4B:
;EXECUTE THE COMMAND
POP P,A ;TSS JOB # TO ATTACH TO
MOVEI C,0 ;NO PASSWORD POINTER
POP P,B ;USER TO ATTACH TO
TLNN Z,F1 ;IF NOT LOSING THIS JOB
SKIPN CUSRNO ;OR NOT LOGGED IN,
CAIA ;THEN SAY NOTHING
ETYPE < Detaching job # %J
>
TLNE Z,F1 ;UNATTACH?
TLO A,(1B1) ;YES, TELL ATACH
DMOVEM A,AT1 ;SAVE ARGS IN CASE REDO NECESSARY
ATACH ;TRY TO DO IT
ERJMP .+2 ;FAILED
JRST ATGOOD ;SUCCEEDED
CAIE A,ATACX4 ;PASSWORD PROBLEM?
JRST ATNG ;NO, SOME OTHER ERROR
CALL PASLIN ;PASSWORD NOT GIVEN BUT REQUIRED, GET IT
MOVE C,A ;STORE NEW PASSWORD POINTER
DMOVE A,AT1 ;GET OTHER ARGS
ATACH
ATNG: CALL [ TLNN Z,F1 ;DIDN'T SAY DETACHING JOB IF UNATTACH
ETYPE <?ATTACH failure, still attached to job # %J
>
CALL CJERRE]
ATGOOD: JRST CMDIN4 ;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
; STILL ATTACHED IF 'UNATTACH' JUST DONE.
;BREAK (LINKS)
NOXTND,<
.BREAK::NOISE <LINKS>
>
BREAK0: CONFIRM
BREAK1: MOVE A,[1B0+1B1+.CTTRM] ;BREAK TO AND FROM CONTROLLING
MOVEI B,-1 ;ALL REMOTES
TLINK
CALL JERR
JRST CMDIN4
XTND,<
;BREAK (LINKS TO) - FANCIER FORM OF BREAK COMMAND
.BREAK::NOISE <LINKS WITH>
STKVAR <BYUNO>
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "*"]>,<User name, line number, or CR for all>,<*>,[
FLDDB. .CMUSR,CM%SDH,,,,[
FLDDB. .CMNUM,CM%SDH,10,,,[
FLDDB. .CMCFM,CM%SDH,,,,]]]]
CALL FLDSKP ; PARSE THIS MESS
CMERRX
LDB C,[POINT 9,0(C),8] ; FIGURE OUT WHAT WAS TYPED
CAIN C,.CMCFM ; JUST CR?
JRST BREAK1 ; YES - DO ALL
CAIN C,.CMTOK ; WAS IT "*"
JRST BREAK0 ; YES - DO ALL (CONFIRM FIRST)
CONFIRM ; MUST BE USER NAME OR LINE #
CAIN C,.CMNUM ; LINE NUMBER?
JRST .BYEBY ; YES - CONFIRM FIRST
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
.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.
MOVX A,TL%CRO!TL%COR+.CTTRM
TLINK ; BREAK A LINK
CALL JERR
RET
>
; CANCEL (Request type) ARCHIVE - arrive here from EXECQU
CANARC::NOISE <FOR FILES>
MOVE A,[XWD -1,0]
HRLI B,-3 ; All generations
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
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
CALL TYPIF ; Type name of file
CALL MFINP ; Get a second JFN
JRST [ETYPE < %?
>
JRST CANAR2] ; Failed for some reason
MOVEI B,.ARRAR ; Request archive
MOVEI C,.ARCLR ; Clear the request
ARCF
ERJMP [ETYPE < %?
>
JRST CANAR2]
HRLI A,.FBCTL
MOVX B,FB%INV
SETZ C, ; Make file visible again
CHFDB
ERJMP [ETYPE < %?
>
JRST .+1] ; Say OK if just making visible failed
CALL TYPOK
CANAR2: SKIPE INIFH1
JRST CANAR1
RET
CANAR3: CALL GNFIL ; Advance to next guy
SETZM INIFH1 ; None left
JRST CANAR2 ; And go on
;CLEAR (DIRECTORY OF DEVICE) <DEVICE NAME>
;FORCED CONFIRMATION
NOSHIP,<
.CLEAR::NOISE <DIRECTORY OF DEVICE>
CALL DEVN
LDB D,[POINT 9,A,17] ;DEVICE TYPE
CAIE D,.DVDTA
ERROR <Dectapes only>
TXNN B,DV%AV ;AVAILABLE?
JRST [ TXNN B,DV%ASN ;ASSIGNED?
UERR [ASCIZ /%1H: Not available/]
UERR [ASCIZ /%1H: Assigned to job %3Q/]]
CONFIRM
INIDR ;INITILIZE DIRECTORY (DESIGNATOR IN A)
CALL CJERR
RET
>;NOSHIP
;END-ACCESS (DIRECTORY) <NAME> --
.ENDAC::TLO Z,F2+F3 ;F2 MEANS ACCESS OR END-ACCESS, F3 MEANS END-ACCESS
JRST CONNX ;JOIN COMMON CODE
;ACCESS (DIRECTORY) <NAME> --
.ACCES::TLO Z,F2 ;F2 ON MEANS "ACCESS", OFF MEANS "CONNECT"
TLZ Z,F3 ;F2 MEANS ACCESS
JRST CONNX ;JOIN COMMON CODE
;CONNECT (TO DIRECTORY) <NAME> --
.CONNE::TLZ Z,F2+F3 ;OFF MEANS "CONNECT", ON MEANS "ACCESS"
CONNX: TRVAR <ACDNUM,ACPASS,ACJNUM,OLDCON> ;KEEP ACDNUM,ACPASS,ACJNUM CONSECUTIVE AND IN ORDER!!
SETZM ACPASS ;NO PASSWORD ASSUMED THIS TIME
SETOM ACJNUM ;USE OUR OWN JOB NUMBER
NOISE <TO DIRECTORY>
TLZ Z,F1 ;ALLOW DEFAULT SELF
TLNE Z,F2
TLO Z,F1 ;NO DEFAULTING ON ACCESS COMMAND
CALL DIRNAM ;INPUT & CHECK DIRECTORY NAME
ERROR <No such directory>
MOVEM C,ACDNUM ;REMEMBER DIRECTORY NUMBER
CONFIRM
TLNE Z,F2 ;CONNECT?
JRST NOCONN ;NO, SO NO OVER QUOTA REPORTING
GJINF ;GET CONNECTED DIRECTORY
MOVEM B,OLDCON ;REMEMBER OLD ONE
CALL CHKDAL ;CHECK CURRENT DIRECTORY BEFORE LEAVING
NOCONN: SETZM ACPASS ;FIRST TRY WITHOUT PASSWORD
CALL DOACC ;DO THE JSYS
TLNE Z,F2 ;CONNECT?
JRST CMDIN4 ;NO, ACCESS, SO NO OVER QUOTA REPORT
GJINF ;GET CONNECTED DIRECTORY NOW
CAME B,OLDCON ;DON'T GIVE SAME REPORT TWICE!
CALL CHKDAL ;CHECK NEW DIRECTORY
JRST CMDIN4
;ROUTINE TO DO JSYS FOR ACCESS, END-ACCESS, CONNECT
DOACC: MOVE A,[AC%CON+3] ;SAY "CONNECT"+"3 WORDS IN INFO BLOCK"
TLNE Z,F2 ;"ACCESS"?
TXC A,AC%CON+AC%OWN ;YES, TURN OFF CONNECT AND ON ACCESS
TLNE Z,F3 ;END-ACCESS?
TXC A,AC%OWN+AC%REM ;YES, TURN OFF "ACCESS", TURN ON "END-ACCESS"
MOVEI B,ACDNUM ;WHERE THE BLOCK IS.
ACCES
ERCAL ACCHK ;FAILED
RET ;SUCCEEDED
;CHECK FOR FAILING END-ACCESS AND USER WASN'T ACCESSING THE DIRECTORY
ACCHK: CALL %GETER ;GET ERROR CODE FOR FAILING ACCES JSYS
MOVE A,ERCOD
CAIE A,ACESX6 ;"DIRECTORY ISN'T BEING ACCESSED" ERROR?
JRST ACNOP ;NO, MAYBE PASSWORD NOT GIVEN BUT REQUIRED
MOVE A,ACDNUM ;GET DIRECTORY NUMBER REFERRED TO
ETYPE <%%Directory %1R wasn't being ACCESSed
>
JRST CMDIN4 ;GIVE SUCCESS RETURN FOR COMMAND
;CONNECT OR ACCESS FAILED. SEE IF PASSWORD NOT GIVEN, BUT REQUIRED.
;IF SO, PROMPT FOR IT AND TRY AGAIN. IF NOT, PRINT SYSTEM ERROR.
ACNOP: CAIE A,ACESX3 ;"?PASSWORD IS REQUIRED"?
JRST CJERRE ;NO, OTHER ERROR. PRINT ERROR MESSAGE.
CALL PASLIN ;YES, GET PASSWORD ON NEW LINE.
MOVEM A,ACPASS ;STORE NEW PASSWORD POINTER
JRST DOACC ;TRY THE JSYS AGAIN
;"COPY" IS IN X2CMD.MAC.
;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.
.DAYTI::PRINT " "
MOVE A,COJFN ;DESTINATION
SETOB B,C ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT
ODTIM
ETYPE<%_>
RET
;DELETE <FILE GROUP>
.DELET:: TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN>
SETZM KEPNUM ;ASSUME NOT KEEP
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD!GJ%NS!GJ%IFG!1B14!1B15!1B16) ;OLD FILE, NO SEARCH, *'S AND COMMA OK
CALL SPECFN ;INPUT FILE GROUP DESCRIPTOR
JRST DELET1
TDZ Z,[F5!F2!F3!F4!1B18] ;CAN'T BE EXPUNGE IF NO SUBCOMMAND
JRST DELET2
DELET1: TDZ Z,[F5!F2!F3!F4!1B18] ;CLEAR FLAGS
SUBCOM $DELET
DELET2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;FOR NXFILE TYPEOUT
MOVE A,JBUFP ;SAVE THESE JFNS
MOVEM A,.JBUFP
SETZM DELDIR ;NO DIRECTORY INITIALIZED YET
SETOM EXMFLG ;FORCE DIRECTORY TO BE EXAMINED
SKIPE KEPNUM ;DELETING ALL VERSIONS?
JRST KEEPDL ;NO, SPECIAL CODE
DELET3: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR SPECIAL TERM
JRST [ SETOM EXMFLG ;BAD JFN STEPPED TO NEXT, REMEMBER TO EXAMINE IT
JRST DTDEL2]
SKIPE EXMFLG ;ARE WE SUPPOSED TO EXAMINE THIS DIRECTORY?
JRST [ CALL GETDNM ;YES, SEE WHAT NUMBER IT IS
CALL DELINI ;ESTABLISH THIS DIRECTORY AS CURRENT
SETZM EXMFLG ;SAY NO MORE EXAMINATION NEEDED YET
JRST .+1]
CALL TYPIF ;TYPE FILENAME (RETURNS JFN IN A)
MOVE A,INIFH1 ;BEFORE STEPPING TO NEXT FILE
MOVEM A,INIFHO ;REMEMBER WHICH JFN WE'RE ON
CALL MFINP0 ;GET SECOND JFN ON CURRENT FILE, RETURN IN A
JRST DTDEL2 ;ERROR, MESSAGE ALREADY PRINTED
MOVEM A,DELJFN ;SAVE JFN
HRRZ A,A ;GET JFN
TLNE Z,F5
TXO A,DF%ARC ; Allow archived files
TLNE Z,F2
TXO A,DF%EXP ;EXPUNGE FILE
TLNE Z,F3
TXO A,DF%FGT ;FORGET FILE
TLNE Z,F4
TXO A,DF%DIR ;ZAP DIRECTORY
TRNE Z,1B18 ; Contents only?
TXO A,DF%CNO
DELF
JRST [ TYPE < >
CALL $ERSTR ;PRINT ERROR MESSAGE
ETYPE<%_>
JRST DTDEL2]
CALL TYPOK
MOVE A,DELJFN ;GET FLAGS
MOVE B,INIFHO ;GET OLD JFN POINTER
CAMN B,INIFH1 ;IF DIFFERENT JFN NOW, REPORT MIGHT BE DUE
TXNE A,GN%STR!GN%DIR ;DID DIRECTORY JUST CHANGE?
SETOM EXMFLG ;NEW JFN OR DIRECTORY CHANGED, REMEMBER TO EXAMINE DIRECTORY
DTDEL2: SKIPE INIFH1 ;DID WE USE UP ALL THE JFNS?
JRST DELET3 ;NO, GO CHECK NEXT JFN
CALLRET PDLFRE ;REPORT ABOUT FINAL DIRECTORY AND RETURN
;ROUTINE USED BY DELETE TO PRINT NUMBER OF PAGES FREED IF EXPUNGE SUBCOMMAND
;WAS USED, OR IF SOME PAGES HAVE BEEN FREED
PDLFRE: SKIPN A,DELDIR ;GET CURRENT DIRECTORY NUMBER
RET ;WHOOPS, NONE! USER TYPED "DELETE BLECCH"
MOVE B,DELPGS ;CAUSE "PAGES FREED" TO BE 0 FOR NON-DIR DEVICE
CAIE Q2,0 ;DON'T TO "GTDAL" UNLESS MULTIPLE DIRECTORY DEVICE
GTDAL ;CHECK ALLOCATION
MOVE A,DELPGS ;GET ORIGINAL ALLOC
SUB A,B ;TAKE DIFFERENCE NOW
TLNN Z,F2 ;ALWAYS PRINT AFTER EXPUNGE
JUMPE A,R ;DON'T PRINT IF 0
MOVE C,DELDIR ;TELL TYPFRE WHICH DIRECTORY TO PRINT
CALLRET TYPFRE ;PRINT RESULTS
;DELINI TAKES DIRECTORY NUMBER IN A AND INITIALIZES DATA TO WORK ON THAT
;DIRECTORY
DELINI: MOVEM A,NEWDIR ;SET NEW DIRECTORY WE'RE WORKING ON
CAMN A,DELDIR ;IS NEW ONE THE SAME AS THE OLD ONE?
RET ;YES, SO DON'T RESET COUNTS OR TRY TO PRINT
SKIPE DELDIR ;WAS THERE A PREVIOUS DIRECTORY?
CALL PDLFRE ;YES, PRINT ITS RESULTS
MOVE A,NEWDIR ;SET UP NEW ONE AS CURRENT
MOVEM A,DELDIR ;REMEMBER DIRECTORY NUMBER
CAIE Q2,0 ;DON'T GET ALLOCATION FOR NON-DIRECTORY DEVICE
GTDAL ;GET ALLOCATION
MOVEM B,DELPGS ;SAVE PAGES IN USE
RET
;GETDNM DECIDES WHAT DIRECTORY NUMBER WE'RE WORKING ON
GETDNM: HRRZ A,@INIFH1 ;GET JFN
SETOM Q2 ;ASSUME MULTIPLE DIRECTORY DEVICE
CALL DIRQ ;SKIP IF DIRECTORY DEVICE
MOVEI Q2,0 ;NOT A MULTIPLE DIRECTORY DEVICE
JUMPE Q2,R ;SKIP DIRECTORY NAME STUFF IF NOT MULTIPLE DIRECTORY DEVICE
HRRZ B,@INIFH1 ;JFN TO B
LDF C,1B2+1B5+JS%PAF ;GET PUNCUATED STRUCTURE AND DIRECTORY
HRROI A,DELBUF ;WHERE TO PUT IT
JFNS
MOVSI A,(RC%EMO) ;LITERAL MATCH
HRROI B,DELBUF ;STRING
RCDIR ;GET DIR #
HRROI B,DELBUF ;FOR ERROR MESSAGE
TLNE A,(RC%AMB+RC%NOM)
ERROR <No such directory - %2m>
MOVE A,C ;RETURN DIRECTORY NUMBER IN A
RET
;DIRQ SKIPS IFF THE CURRENT JFN IS A MULTIPLE DIRECTORY DEVICE
DIRQ: HRRZ A,@INIFH1 ;GET RID OF FLAGS
DVCHR ;GET DEVICE CHARACTERISTICS
ERCAL JERR ;UNEXPECTED FAILURE
TXNE B,DV%MDD ;SKIP IF NON-DIRECTORY DEVICE
RETSKP ;WE'LL SKIP, BECAUSE IT'S A DIRECTORY DEVICE
RET
$DELETE: TABLE
T ARCHIVE,,..ARCH
T CONTENTS-ONLY,,.CNOLY
T DIRECTORY,,..DIR
T EXPUNGE,,..EXP
T FORGET,,..FORG
T KEEP,,..KEEP
TEND
..ARCH: NOISE <FILES INCLUDED>
CONFIRM
TLO Z,F5
RET
.CNOLY: CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
TRO Z,1B18
RET
..EXP: NOISE <AFTER DELETING>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TLO Z,F2 ;FLAG EXPUNGE
RET
..FORG: NOISE <WITHOUT DEASSIGNING DISK ADDRESSES>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "FORGET" at the same time>
MOVX B,WHLU+OPRU
CALL PRVCK
ERROR <WHEEL or OPERATOR capability required>
TLO Z,F3
RET
..KEEP: DEFX <1> ;DEFAULT IS "1"
DECX <Number of generations>
CMERRX ;NO DECIMAL NUMBER SUPPLIED
CAIN B,1
NOISE <GENERATION>
CAIE B,1
NOISE <GENERATIONS>
CONFIRM
SKIPN B
ERROR <Number of generations may not be 0>
TLNE Z,F3
ERROR <Can't "KEEP" and "FORGET" at the same time>
TLNE Z,F2
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TRNE Z,1B18
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
MOVEM B,KEPNUM
RET
..DIR: NOISE <AND "FORGET" FILE SPACE>
CONFIRM
MOVX B,WHLU+OPRU
CALL PRVCK ;MUST HAVE PRIVS FOR THIS FCN
ERROR <WHEEL or OPERATOR capability required>
SKIPN KEPNUM
TLZE Z,F2!F3
TYPE <% KEEP or EXPUNGE or FORGET subcommand ignored>
SETZM KEPNUM ;ZERO THIS
TLO Z,F4 ;SET FLAG FOR ZAP DIRECTORY
RET
;PRUNE NUMBER OF GENERATIONS
;SOME BUFFER DEFINITIONS
VERBUF==BUF0 ;PUT TABLE AT BUF0
VRTBLN==<BUFL-BUF0>/2 ;USE 1/2 THE SPACE FOR STRING POINTERS,
;THE OTHER 1/2 FOR STRINGS
VERSTR==VERBUF+VRTBLN ;START OF STRING SPACE
VEREND==BUFL+1000-5 ;5 WORDS FOR OVERFLOW
KEEPDL: CALL RLJFNS ;RELEASE ANY TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX TERMS
JRST KEEPDE ;END CHECK
HRROI A,DELBUF ;GET POINTER TO STRING BUFFER
HRRZ B,@INIFH1 ;GET JFN
LDF C,2B2+2B5+1B8+1B11+1B35 ;DEV, DIR, NAME, EXT
JFNS ;SAVE NAME OF FILE
ERCAL JERRE
MOVE A,[POINT 7,VERSTR] ;INIT POINTER TO VERSION STRING SPACE
MOVEM A,KEPJNM ;SAVE HERE
MOVSI Q1,-VRTBLN ;AOBJN PTR TO VER STRING PTR TABLE
LDF D,1B14+1B35 ;GENERATION + PUNCTUATION
KEEPD1: MOVE A,KEPJNM ;GET VERSION POINTER
TLNE Z,F5 ; Allowed to delete archive stuff?
JRST KEEPD8 ; Yes, bypass checks
HRRZ A,@INIFH1 ; Get current JFN
MOVE B,[1,,.FBCTL] ; Get control bits
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,FB%ARC ; Not deletable?
JRST KEEPD9 ; No, pass over it
HRRZ A,@INIFH1
MOVE B,[1,,.FBBK0]
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,AR%RAR ; Requested archive?
JRST KEEPD9 ; Yes, pass over it
KEEPD8: MOVE A,KEPJNM ;GET VERSION POINTER
HRRZ B,A
CAIL B,VEREND ;BUFFER SPACE FULL?
JRST KEEPOV ;YES
MOVEM A,VERBUF(Q1) ;SAVE IN TABLE
HRRZ B,@INIFH1
MOVE C,D ; Get disposition
JFNS ;INTO VERSION STRING SPACE
ERCAL JERRE
SETZ C,
IDPB C,A ;TERMINATE STRING
MOVEM A,KEPJNM ;STORE UPDATED STRING POINTER
KEEPD9: MOVE A,@INIFH1
TLNE A,770000 ;SKIP GNJFN IF NO STARS
GNJFN
JRST KEEPD3
TLNE A,(1B14+1B15+1B16) ;DIR, NAME, EXT CHANGED?
JRST KEEPD2 ;YES, FINISH THIS FILE
JUMPN C,KEEPD1 ; If none found
LDF D,1B14 ;GENERATION WITHOUT PUNCT.
AOBJN Q1,KEEPD1 ;INCREMENT VERSION PTR AND LOOP BACK
KEEPOV: TYPE <%Too many generations for internal stroage, will not print generations
>
CALL KEEPPN ;PRINT NAME
CALL KEEPDO ;DO DELETE (RETURNS # DELETED IN A)
SKIPL A
ETYPE < [%1Q generations deleted]
>
MOVE A,@INIFH1
TLNE A,770000
KEEPD4: GNJFN
JRST [ AOS A,INIFH1
CAMLE A,INIFH2 ;OFF END?
SETZM INIFH1 ;YES, INDICATE SUCH
JRST KEEPDE]
TLNN A,(1B14+1B15+1B16)
JRST KEEPD4
JRST KEEPDE
KEEPD3: AOS A,INIFH1
CAMLE A,INIFH2
SETZM INIFH1
KEEPD2: MOVEI A,1(Q1) ;GET NUMBER OF VERSIONS
SUB A,KEPNUM ;GET NUMBER TO DELETE
JUMPLE A,KEEPDE ;JUMP IF NONE
CALL KEEPPN ;PRINT NAME
MOVNI A,1(Q1) ;GET -NUMBER OF VERSIONS
ADD A,KEPNUM ;GET NUMBER TO DELETE
HRLZ Q1,A ;MAKE AOBJN PTR
KEEPD5: MOVE A,VERBUF(Q1)
ETYPE <%1M>
AOBJN Q1,[PRINT "," ;PRINT THEM ALL
JRST KEEPD5]
CALL KEEPDO ;DO DELNF
JUMPL A,KEEPDE ;ERROR?
CALL TYPOK ;TYPE [OK]
KEEPDE: SKIPE INIFH1
JRST KEEPDL
JRST DTDEL2
KEEPPN: PRINT " "
HRROI A,DELBUF ;GET NAME POINTER
ETYPE <%1M> ;TYPE IT
RET
KEEPDO: MOVSI A,(GJ%OLD+GJ%PHY+GJ%SHT)
HRROI B,DELBUF ;GET FILE VERSION 0 (HIGHEST)
CALL GTJFS ;GET AND STACK JFN
JRST KEEPE1 ;GTJFN FAILED
MOVE B,KEPNUM ;NUMBER TO KEEP
TLNE Z,F5 ; Archive allowed?
TXO A,DF%ARC ; Yes, say so.
DELNF
JRST KEEPE2
MOVE A,B ;RETURN NUMBER IN A
RET
KEEPE2: TYPE < >
CAIA
KEEPE1: TYPE < GTJFN failure for highest generation
?>
CALL $ERSTR
TYPE <
>
SETO A,
RET
; DISCARD (TAPE INFORMATION FOR FILES) <files>
.DISCA::NOISE <TAPE INFORMATION FOR FILES>
MOVE A,[XWD -1,0] ; No default names
HRRZI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;no subcommands
CALL SPECFN
JRST CERR ; Don't allow "stuff,"
SETOM TYPGRP ; Always type the name
MOVE A,COJFN
MOVEM A,OUTDSG ; Where output goes
MOVE A,JBUFP
MOVEM A,.JBUFP
DISCA1: CALL RLJFNS ; Release stray JFN's
CALL NXFILE ; Step to next file in group
JRST DISCA2 ; No more in this group
CALL TYPIF ; Do name
CALL MFINP ; Get a second JFN
JRST DISCA2 ; FAILED?
MOVX B,.ARDIS ; Function code for the discard
MOVX C,AR%CR1+AR%CR2 ; Do both tapes
ARCF
ERJMP DISCA9 ; Failed...
CALL TYPOK ; Tell the user it's done
DISCA2: SKIPE INIFH1 ; Done them all?
JRST DISCA1 ; No, continue the process
RET
DISCA9: ETYPE < %?
>
JRST DISCA2
;SET PROGRAM ENTRY (VECTOR LOCATION) <OCTAL> (LENGTH) <OCTAL>
.ENTRY::SKIPGE FORK
ERROR <No program>
NOISE <LOCATION TO>
OCTX <Memory location of entry vector>
CMERRX ;NUMBER MUST BE INPUT
PUSH P,B ;SAVE LOCATION
NOISE <LENGTH>
DEFX <1> ;DEFAULT
OCTX <Octal number between 1 and 777
or 254000 for compatible entry vector.>
CMERRX
CAILE b,777 ;TOO LONG?
JRST [ CAIN b,254000 ;ALLOW JRST FOR COMPATIBLE
JRST .+1
JRST CERR] ;"?"
CONFIRM
MOVE A,B
POP P,B ;LOCATION
HRL B,A ;LENGTH
MOVE A,FORK
SEVEC
ERJMP CJERR ;OOPS-- MUST BE EX-ONLY
RET
;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 IN EXPDIR/ DIR NUMBER
;WARNING: THIS IS NOT A GENERAL ROUTINE. TO MAKE IT ONE, HAVE IT
;ACCEPT THE DIR IN A INSTEAD OF EXPDIR, SINCE EXPDIR IS LOCAL TO THE
;EXPUNGE COMMAND
EXPDO: MOVE A,EXPDIR
GTDAL
MOVEM B,OLDALC
MOVE B,EXPDIR
HLLZ A,Q1 ;GET BITS FROM ARGS
DELDF
ERJMP [TYPE <% > ;HANDLE ERROR
CALL %GETER ;GET ERROR CODE
MOVE A,ERCOD
CALL $ERSTR ;PRINT IT
MOVE A,EXPDIR ;GET DIR NUMBER
ETYPE< - %1R%%_> ;TERMINATE ERROR MESSAGE
RET] ;AND RETURN
MOVE A,EXPDIR
GTDAL
MOVE A,OLDALC
SUB A,B
MOVE C,EXPDIR ;GET THE DIR NUMBER TO BE OUTPUT
;... FALL INTO TYPFRE
;TYPFRE TAKES NUMBER OF PAGES FREED IN A, DIR NUMBER IN C, AND PRINTS
;MESSAGE SAYING HOW MANY PAGES FREED
TYPFRE::MOVEI B,[ASCIZ " %3R [%1Q"]
SKIPN A ;ANYTHING?
MOVEI B,[ASCIZ " %3R [No"]
UETYPE (B) ;PRINT FIRST PART
TYPE < page> ;BUILD CORRECT GRAMMAR
CAIE A,1 ;ONLY ONE?
PRINT "s" ;NO - THEN PLURAL
TYPE < freed]
>
RET
;ROUTINE TO GET EXPUNGE SUBCOMMANDS
%EXPUN: SETZ Q1, ;CLEAR BITS
CALL SPRTR
SUBCOM $EXPUN ;SUBCOMMANDS, READ 'EM
RET
$EXPUN: TABLE
T DELETE,,.TEXP
T PURGE,,.NXEXP
T REBUILD,,.REBLD
TEND
.TEXP: NOISE <TEMPORARY FILES>
CONFIRM
TXO Q1,DD%DTF
RET
.NXEXP: NOISE <NOT COMPLETELY CREATED FILES>
CONFIRM
TXO Q1,DD%DNF
RET
.REBLD: NOISE <SYMBOL TABLE>
CONFIRM
TXO Q1,DD%RST
RET
;COMMENT (END WITH ^Z)
.REMAR:: NOISE (MODE)
CONFIRM ;GET COMMAND CONFIRMATION
TYPE <Type remark. End with CTRL/Z.
>
STKVAR <<CMTXTB,10>>
SETZM .RDBFP+CMTXTB ;SAY NO BACKUP POINTER
SETZM .RDRTY+CMTXTB ;SAY NO ^R POINTER
COM1: MOVEI A,.RDBRK ;THIS MANY WORDS IN TEXTI BLOCK
MOVEM A,.RDCWB+CMTXTB
MOVX A,RD%JFN ;SAY WE'RE GIVING JFNS
MOVEM A,.RDFLG+CMTXTB
HRL A,CIJFN ;INPUT STREAM
HRR A,COJFN ;EDITING STREAM
MOVEM A,.RDIOJ+CMTXTB
HRROI A,BUF0 ;USE BUFFER SPACE FOR INPUT
MOVEM A,.RDDBP+CMTXTB
MOVX A,<BUFEND-BUF0+1>*5;THIS MANY CHARACTERS AVAILABLE IN BUFFER
MOVEM A,.RDDBC+CMTXTB
MOVEI A,[EXP 1B<3*8+2>,0,0,0] ;ONLY BREAK ON ^Z
MOVEM A,.RDBRK+CMTXTB ;SET UP BREAK MASK
MOVEI A,CMTXTB ;POINT TO BLOCK
TEXTI ;INPUT SOME OF THE COMMENT
ERCAL CJERRE ;FAILED, GO SEE WHY
MOVE A,.RDFLG+CMTXTB ;GET RESULTS
TXNE A,RD%BTM ;^Z TYPED YET?
JRST UNMAP ;YES, CLEAN UP AND RETURN
JRST COM1 ;NOT YET, READ MORE
.CLOSE:: NOISE <JFN>
CRRX <Octal JFN number or blank for all>
CAIA ;NOT JUST "CLOSE<CR>"
JRST SHUT
OCTX ;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 ;BOUNDS CHECK JFN
SKIPG A
ERROR <Illegal JFN number>
CALL JFNREL
ERROR <JFN not in use>
RET
;ENTER HERE WITH JFN TO RELEASE IN A
JFNREL: TDZA D,D ;NO SPECIAL BITS
JFNRLA:: LDF D,CZ%ABT ;CLOSE WITH ABORT
HRRZ A,A ;CLEAR LHS
GTSTS
TXNN B,GS%NAM ;ANYTHING IN THIS JFN?
RET ;NO, RETURN
ETYPE < %1P %1S > ;TYPE JFN AND NAME
CAIN A,.PRIIN ;PRIMARY INPUT?
JRST NRLPRI ;YES
CAIN A,.PRIOU ;PRIMARY OUTPUT?
JRST NRLPRO
CALL NOTIO ;MAKE SURE JFN ISN'T BEING USED FOR EXEC COMMAND INPUT OR OUTPUT
JRST NRLEX ;NAUGHTY, NAUGHTY, TRYING TO CLOSE COMMAND JFN!
TXNN B,GS%OPN ;OPEN?
JRST [ RLJFN
JRST JFNER1
JRST JFNOK1]
HLL A,D ;USE BITS IN D
CLOSF
JRST JFNER2
JFNOK1: GTSTS
TXNE B,GS%NAM ;NAME STILL THERE?
JRST JFNOK2
TYPE < [OK]
>
RETSKP
NRLPRI: TYPE < Primary input not closed
>
RETSKP
NRLPRO: TYPE < Primary output not closed
>
RETSKP
;USER TRIED TO CLOSE COMMAND JFN. SEE WHETHER INPUT OR OUTPUT TO
;GIVE FANCY MESSAGE.
NRLEX: TXNE B,GS%WRF ;OPEN FOR WRITE?
JRST NRLEXO ;YES, ASSUME OUTPUT JFN
JRST NRLEXI ;NO, ASSUME INPUT
NRLEXI: TYPE < EXEC command input not closed
>
RETSKP
NRLEXO: TYPE < EXEC command output not closed
>
RETSKP
JFNOK2: TXNE B,GS%OPN
TYPE < Can't close file
>
TXNN B,GS%OPN
TYPE < Can't release JFN
>
RETSKP
JFNER1: TYPE < Can't release JFN - >
CAIA
JFNER2: TYPE < Can't close file - >
CALL $ERSTR ;PRINT ERROR IN A
ETYPE<%_>
RETSKP
SHUT: CALL CLOPAT ;GO UNMAP THE PA1050 OPEN FILES
MOVEI A,MAXJFN ;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1: PUSH P,A
CALL JFNREL ;RELEASE JFN
JFCL ;IGNORE NOTHING THERE
POP P,A
SOJG A,SHUT1
RET
;ADVISE (TERMINAL/USER)
.ADVIS::TLO Z,F2 ;FLAG ADVISE
NOISE <USER>
JRST LINK0
.JILEN==.JILNO+1 ;ROOM FOR ALL JOB INFO WE MAY NEED
;TALK (TERMINAL/USER)
.TALK:: TLZ Z,F2
NOISE <TO>
LINK0: trvar <<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVTNM,ADVJNM,dirno>
MOVEM P,TFRAME ;SAVE BEGINNING OF POSSIBITITES
USERX <User name or terminal number>
JRST LTTY ;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
CONFIRM
MOVEM B,DIRNO ;SAVE USER NUMBER
TLZ Z,F1 ;NO DETACHED JOBS SEEN YET
MOVEM P,TFRAME ;SAVE BEG OF ARGS
HLLZ D,JOBRT ;MAKE AOBJN PTR
LINK3: MOVEI B,(D) ;GET JOB NUMBER BY ITSELF
CAME B,JOBNO ;LOOKING AT MY OWN JOB?
SKIPN B ;OR JOB 0?
JRST LINK6 ;YES, SKIP IT
CALL USERNO ;GET USER NUMBER
CAME A,DIRNO
JRST LINK6 ;WRONG GUY
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LINK6 ;AND SKIP IT IF DETACHED
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
GTB .JOBPN ;GET PROGRAM NAME
PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6: AOBJN D,LINK3 ;MAY HAVE MORE JOBS
CAMN P,TFRAME ;FOUND ANY?
JRST [ TLNE Z,F1
ERROR <User has detached jobs only
Use "MAIL" to send mail to user>
MOVE A,CUSRNO ;GET MY USER NUMBER
CAMN A,DIRNO ;LOOKED FOR MY OWN JOBS?
JRST LINKNS ;YES, SAY CAN'T DO MYSELF
ERROR <User is not logged in
Use "MAIL" to send mail to user>]
POP P,A ;SUBSYSTEM NAME
POP P,B ;TTY#
CAMN P,TFRAME ;ONLY ONE POSSIBILITY?
JRST [ MOVE A,B ;YES, USE IT
TLO Z,F3 ;NO CONFIRM NEEDED
JRST LINK11]
LINK7: MOVE C,B ;SAVE FOR POSSIBLE DEFAULT
ETYPE < TTY%2O%, >
JUMPE A,[PRINT "?" ;NO SUBSYS NAME
JRST LINK8]
CALL SIXPRT ;PRINT SUBSYSTEM
LINK8: ETYPE<%_>
CAMN P,TFRAME ;DONE ALL?
JRST LINK9 ;YES
POP P,A
POP P,B
JRST LINK7
LINK9:
PROMPT <TTY: >
HRROI A,LDBUF ;GET POINTER FOR DEFAULT STRING
MOVEM A,CMDEF ;SAVE POINTER TO DEFAULT
MOVE B,C ;GET DEFAULT TTY # (FIRST ONE ON LIST)
MOVEI C,8 ;IN OCTAL
NOUT ;CREATE DEFAULT STRING
CALL JERR ;SHOULDN'T FAIL
OCTX <Terminal number>
CMERRX ;NON-OCTAL NUMBER TYPED
JRST LINK10
LTTY: OCTX ;USER NAME NOT TYPED, SEE IF TERMINAL NUMBER
CMERRX <User name or terminal number required>
LINK10: CONFIRM
LINK11: PUSH P,B ;SAVE TTY#
GJINF ;GET JOB INFORMATION
TLNN Z,F2 ;SKIP CHECK IF ADVISING
CAME D,0(P) ;IS TTY# IDENTICAL TO MY TTY NUMBER ?
SKIPA
LINKNS: ERROR <Cannot talk to self>
HLRE B,TTYJOB ;GET NEG SIZE OF TABLE
MOVMS B
POP P,A ;TTY#
CAIGE A,0(B)
CAIGE A,0
ERROR <Nonexistent terminal number>
TLNN Z,F3
MOVE P,TFRAME
PUSH P,A
SETZ D,
GTB .PTYPA
MOVE D,A
POP P,A
CAIGE A,(D) ;PTY?
JRST NOPTYL ;NO
PUSH P,D ;MAYBE. CHECK FOR ABOVE LAST PTY
HLRZ D,D ;NUMBER OF PTYS
ADD D,0(P) ;LAST PLUS ONE
POP P,0(P) ;CLEAR STACK
CAIL A,(D) ;ABOVE PTY'S?
JRST NOPTYL ;YES. NVT OR SOMETHING ELSE
PROMPT < [Pseudo-terminal, confirm]>
CALL FCONFA
NOPTYL: TLNE Z,F2
JRST ADVISE ;GO GIVE ADVISE
MOVEI B,.TTDES(A) ;FORM TTY DESIGNATOR
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERROR <Refused, use "MAIL" to send mail to user>
RET
;CODE TO GIVE ADVISE - CHECK TERMINAL PRINT JOB INFO
ADVISE: MOVEM A,ADVTNM
MOVX B,WHLU!OPRU
CALL PRVCK
CAIA
JRST ADVIS1 ;SKIP CHECK IF PRIVILEGED
TRO A,.TTDES
RFMOD
TRNN B,TT%AAD
ERROR <Destination not receiving advice>
ADVIS1: SETO D,
GTB .TTYJO
MOVNS A,A
CAMGE A,ADVTNM
ERROR <Illegal terminal number>
MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JITNO
GETJI
CALL JERR
CAMN C,ADVTNM
ERROR <Cannot advise self>
TYPE < Escape character is <CTRL>E, type <CTRL>^? for help
>
MOVE D,ADVTNM
GTB .TTYJO
HLRZ B,A
CAIN B,-1
JRST [ TYPE < No job on terminal.
>
JRST CONNECT]
CAIN B,-2
JRST [ TYPE < Terminal being assigned.
>
JRST CONNECT]
TRZE B,400000
TYPE < Not controlling terminal.
>
MOVEM B,ADVJNM
PRINT " "
MOVE A,ADVJNM
MOVEI B,JIBUF ;GET ADDRESS OF BUFFER
HRLI B,-.JILEN ;SPECIFY LENGTH
MOVEI C,0
GETJI
CALL JERR
SKIPN B,.JIUNO+JIBUF
JRST [ TYPE <Not logged in>
JRST NOLOGD]
ETYPE <%2R>
NOLOGD: MOVE B,.JIDNO+JIBUF
CAMN B,.JILNO+JIBUF
JRST NOCOND
UETYPE [ASCIZ/, %2R/]
NOCOND: MOVE B,ADVJNM
ETYPE < Job %2Q>
PRINT " "
SKIPN A,.JIPNM+JIBUF
MOVE A,.JISNM+JIBUF
CALL SIXPRT
ETYPE<%_>
;CODE TO GIVE ADVISE - MAKE CONNECTION, LOOP SENDING CHARACTERS
CONNEC: MOVE B,ADVTNM
TRO B,.TTDES ;SETUP TERMINAL NUMBER FOR STI
MOVEM B,ADVTNM
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERROR <Refused>
TYPE < [Advising]
>
MOVEI A,.FHSLF
RPCAP
MOVEI A,.FHJOB
MOVX B,1B<ADVESC> ;ONLY THE ADVICE ESCAPE CHARACTER DOESN'T GET SENT TO THE REMOTE JOB
TXNE C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
STIW
MOVE A,[ADVESC,,^D24] ;CONTROL-E IS USED TO GET OUT
ATI
SETOM ADVFLG ;FLAG IN ADVISE CODE
TLZ Z,F3 ;NOT IN COMMENT NOW
LDF A,GJ%SHT ;SHORT FORM GTJFN
HRROI B,[ASCIZ /TTY:/] ;WE NEED BINARY CHANNEL. THIS IS SO
;IF THINGS LIKE "TER RA" OR "TER NO RA"
;ARE "SENT" TO REMOTE JOB, THEY HAVE
;EFFECT
CALL GTJFS ;GET HANDLE ON TTY FOR BINARY COMMUNICATION
CALL CJERRE ;FAILURE, PRINT ERROR AND RETURN
MOVE B,[100000,,OF%RD] ;OPEN THE JFN FOR READ
OPENF
ERCAL CJERRE ;FAILED
MOVEM A,ADVJFN ;REMEMBER THE ADVISE JFN
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
ADVLP1: TLNE Z,F3 ;COMMENT?
JRST ADVLOP ;YES, DON'T SEND CHAR
MOVE A,ADVTNM
STI
ERJMP ILISTI
JRST ADVLOP ;GO GET NEXT CHARACTER
ILISTI: CALL %GETER
MOVE A,ERCOD
CAIE A,DEVX2
CAIN A,DESX2
CAIA
JRST CJERR
TYPE <
[Destination refused advice]
>
JRST ADVDON
SNCTRL: BIN
MOVE C,B ;GET 7-BIT VERSION OF CHARACTER
ANDI C,177
CAIN C,"("
JRST STCOMM
CAIN C,")"
JRST ENCOMM
CAIN C,"+"
JRST RELINK
CAIN C,"?"
JRST TYPADV
CAIL C,141
CAILE C,172
CAIA ;NOT LOWERCASE LETTER
TRZ B,40 ;LOWERCASE, MAKE UPPERCASE
TRZ B,300 ;MAKE INTO A CONTROL (A BECOMES CTRL/A ETC.)
JRST ADVLP1
;START COMMENT
STCOMM: TYPE <^^(> ;ECHO CHARACTER HE TYPED
TLO Z,F3 ;FLAG NOT TO SEND CHARS
JRST ADVLOP
;END COMMENT
ENCOMM: TLZ Z,F3 ;FLAG TO SEND CHARS AGAIN
JRST ADVLOP
TYPADV: UTYPE [ASCIZ/
CMND EFFECT
---- ------
<CTRL>E Quit
<CTRL>^+ Relink to remote terminal
<CTRL>^( Start comment
<CTRL>^) End comment
<CTRL>^? Type this list
<CTRL>^<CHAR> Send <CTRL><CHAR>
/]
JRST ADVLOP
RELINK: MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
MOVE B,ADVTNM
TLINK ;PUT HIS OUTPUT ON OUR TERMINAL
JRST [ TYPE <
TLINK failure
>
JRST ADVLOP]
TYPE < [Advising]
>
JRST ADVLOP
ADVCTO::PUSH P,A
PUSH P,B
MOVE A,ADVTNM
MOVEI B,CTRLO
STI
ERJMP ILISTI
POP P,B
POP P,A
DEBRK
ESCPSI::SKIPN ADVFLG
DEBRK ;JUST IN CASE
ADVDON: CALL ICLEAR ;DISMISS INTERRUPT TO .+1
TYPE <
[Advice terminated]
>
MOVEI Q1,ETTYMD
CALL LTTYMD ;RESTORE TTY MODES
MOVE A,[1B0+1B1+.CTTRM] ;BREAK TO AND FROM CONTROLLING
MOVE B,ADVTNM
TLINK ;BREAK LINK
CALL JERR
CALL DOATI ;FIX ^C AND ^E
SETZM ADVFLG
MOVE A,ADVJFN ;GET SPECIAL JFN AGAIN
CLOSF ;RELEASE IT
ERCAL CJERRE ;SHOULDN'T FAIL
JRST ERRET ;ERROR RETURN TO TTY MODES RESET
;"LIST" IS WITH "TYPE" BELOW.
;LOGIN COMMAND
;LOGIN (USER) NAME (ACCOUNT) ACCOUNT (SESSION-REMARK) REMARK
;PASSWORD: PASSWORD
.LOGIN:: TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT>
SKIPE CUSRNO
ERROR <You are already logged in>
;DECODE ARGUMENTS
;FIRST ARGUMENT: USER NAME
NOISE <USER> ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
SETZM LERRF ;NO ERROR YET
CALL USERN ;INPUT USER NAME, TRANSLATE TO USER # IN A
JRST [ MOVEM A,LERRF ;FAILED, REMEMBER
MOVEI B,[FLDDB. .CMUSR,CM%PO] ;TRY TO READ PARSE-ONLY NAME
CALL FLDSKP
CMERRX ;IF THAT FAILS, GIVE UP
JRST .+1]
MOVEM A,RCBITS ;SAVE INFO RETURNED BY "RCDIR"
MOVEM C,LOGNO ;SAVE DIRECTORY NUMBER
CALL NOECHO ;NOISE STUFF WAITS FOR A CHARACTER!
NOISE (PASSWORD)
CALL PASWD ;READ THE PASSWORD
MOVEM A,LPASP ;REMEMBER POINTER TO PASSWORD
NOISE <ACCOUNT>
MOVEI A,0 ;NO SPECIAL BITS FOR RCDIR
MOVE B,LOGNO ;USER NUMBER
SKIPE LERRF ;USER NAME CORRECT?
JRST LOGIN1 ;NO, SO DON'T TRY TO SET UP ACCOUNT DEFAULT
RCDIR ;GET LOGGED-IN DIRECTORY NUMBER
MOVE A,C ;PUT DIR NUMBER INTO A
MOVE B,LPASP ;GET POINTER TO PASSWORD
MOVEI C,LDBLK ;GET ADDRESS TO USE FOR CRDIR BLOCK
CALL GETDRP ;GET ACCOUNT FOR DEFAULT
JRST LOGIN1 ;FAILED, ASSUME NO DEFAULT
MOVEM A,CMDEF ;USE DEFAULT ACCOUNT AS DEFAULT FOR FIELD
ILDB A,A ;GET FIRST CHARACTER
CAIN A,0
LOGIN1: SETZM CMDEF ;NO DEFAULT
CALL ACCT ;INPUT AND DECODE ACCT # (USES A)
MOVEM A,LACCT ;SAVE FOR LOGIN JSYS
NOISE (SESSION-REMARK)
CALL GSR ;GET SESSION-REMARK
MOVE Q1,A ;SAVE POINTER TO SESSION-REMARK
CONFIRM ;CONFIRM THE WHOLE COMMAND
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN
XTND,<
GTAD ; SETUP 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
MOVE C,LACCT ;ACCT # OR PTR THERETO
MOVE B,LPASP ;PASSWORD PTR
MOVE A,LOGNO ;USER #
MOVE D,C ;GET ACCT STRING
ILDB D,D ;LOOK AT FINAL ACCOUNT
SKIPN D ;HAVE ONE?
SETZM C ;NO. USE NOTHING
MOVEI D,0 ;RESERVE D FOR FUTURE FLAGS
LOGIN
JRST [ CAIN A,LGINX1
ERROR <Illegal account>
CAIN A,LGINX4
ERROR <Incorrect password>
CALL CJERRE] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
SETOM SYSMF ;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
MOVE B,LOGNO ;WHAT "RCUSR" RETURNED
MOVEM B,CUSRNO ;STORE USER NUMBER
MOVEM A,LOGDAT ;SAVE DATE OF LOGIN
GJINF ;GET LOGGED-IN DIRECTORY NUMBER
MOVEM B,LIDNO ;SAVE IT.
MOVE A,Q1 ;POINTER TO SESSION REMARK
CALL SSR ;SET SESSION-REMARK
;LOGIN...
; The AUTOLOGOUT for use to get killed here, now we must kill off the
; pending TIMER clock
MOVE A,[.FHSLF,,.TIMBF] ; Delete all entries before given time
MOVE B,[377777,,-1] ; Time way out in the boonies (won't
; clobber any runtime limit setting
SETZ C,
TIMER
JFCL ; Don't care if none pending
;TYPE "JOB <N> ON LINE N <DATE> <TIME>"
ETYPE < Job %J on %L %D %E
> ;EOL NEEDED BEFORE LOGIN MESSAGE
MOVE B,RCBITS ;WHAT RCUSR RETURNED
TXNE B,RC%RLM ;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
SETZM LOGDAT ;SET DATE TO 0 TO FORCE PRINTING
NOXTND,<
;TYPE "YOU HAVE A MESSAGE" IF A FILE "MAIL.TXT.1" OF NON-0 LENGTH
; EXISTS IN THIS DIRECTORY.
CALL MESMES
>
;GET DEFAULT EXEC INPUT FILE
SETOM LOGINI ;SET FLAG TO DO "TAKE INITIAL-LOGIN-TYPIN.TXT"
;AT NEXT OPPORTUNITY.
RET
;SIMULATE "TAKE" COMMAND OF FILSPEC (STRING POINTER IN B)
;SKIPS IFF SUCCEEDS IN SETTING UP STREAM
TAKEIN:: STKVAR <<TAKBUF,FILWDS>,SPB>
MOVEM B,SPB ;SAVE STRING POINTER
MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
HRROI A,TAKBUF ;GET STRING SPACE POINTER
CAMN B,[-1] ;DEFAULT?
JRST TAKEI1 ;YES, SKIP DIR
DIRST ;STORE DIR STRING
CALL JERR ;WE JUST SCANNED IT?!
TAKEI1: MOVE B,A
MOVE A,SPB
SETZ C, ;READ TO NULL
SIN ;APPEND TO STRING
HRROI B,TAKBUF ;GET POINTER TO BEGINNING
CALL TRYGTJ ;TRY TO FIND IT.
JRST TAKIN2 ;NO SUCH FILE, GO AWAY QUIETLY
MOVE B,[70000,,OF%RD]
OPENF
JRST [ HRROI B,TAKBUF ;GET POINTER FOR ERROR MESSAGE
LERROR <Can't read %2m%%_%%1?>
HRRZ A,JBUFP
HRRZ A,(A) ;GET SAVED JFN
RLJFN ;RELEASE IT
CALL JERR
HRRZ A,JBUFP
SETOM (A)
RET]
HRL A,A ;PUT INPUT JFN IN LEFT HALF
HRR A,COJFN ;USE SAME OUTPUT AS WERE USING
CALL PUSHIO ;SAVE OLD IO STREAM, START NEW ONE
RETSKP ;DOUBLE RETURN WHEN SUCCESSFUL
TAKIN2: RET ;FAILED, TAKE SINGLE RETURN
;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF P2=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
; MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
; (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
; AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.
;THIS UNWRITTEN ROUTINE SHOULD SOMEHOW ALLOW CARRIAGE RETURN
;IN THE MIDDLE OF COMMANDS, SUCH THAT THE GUIDE WORDS FOR THE NEXT
;FIELD COME OUT ON THE NEW LINE, AS THOUGH THE CR WAS $. BEWARE
;OF THE FOLLOWING PITFALLS OF THIS:
;1) ON REPARSE, GUIDEWORDS ARE ALREADY IN BUFFER, SO SOMEHOW
; REPARSED CR SHOULD DO NOTHING. NOTE THAT REPARSED $ IS
; NONEXISTANT, AS $ CAUSES ACTION BUT DOESN'T STAY IN
; BUFFER. YOU CAN'T AFFORD NOT TO LEAVE CR IN BUFFER,
; BECAUSE ^R AND RUBOUT WON'T WORK CORRECTLY, ESPECIALLY
; ON SCREEN TERMINALS.
;2) IF THE CR PROVOKED GUIDEWORDS ARE IMPLEMENTED AS PROMPTS,
; RUBBING OUT WON'T WORK. USER WILL JUST GET A DING.
;3) MOST DESIRABLY, CR IN THE MIDDLE OF COMMANDS SHOULD WORK
; FOR ALL COMMANDS, NOT JUST SPECIAL ONES LIKE LOGIN,ATTACH.
; THIS CREATES A PROBLEM WITH CASES WHERE A FIELD HAS A
; DEFAULT VALUE. CONSIDER THE AMBIGUITY UPON SEEING
; CR: DOES THE CR MEAN DEFAULT THE FIELD VALUE, OR
; TYPE THE GUIDEWORDS. FOR INSTANCE, SHOULD "DIRECTORY<CR>"
; TYPE "(OF FILES)", OR DEFAULT THE FILE SPEC TO *.* AND
; TAKE OFF?
ret
;USERN
;INPUT USER NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS RCUSR'S RETURNED INFO IN A,B,C.
;SKIPS, BUT NOT IF BAD NAME TYPED, IN WHICH CASE A CONTAINS ERROR CODE
USERN: USERX <User name>
JRST [ CALL %GETER ;FAILED, FIND OUT WHY
MOVE A,ERCOD ;RETURN ERROR IN A
RET]
CALL BUFFF ;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
MOVE B,A
MOVSI A,(RC%EMO) ;SAYS NO RECOGNITION
RCUSR ;STRING TO DIRECTORY # TRANSLATION
RETSKP
;ACCT
;RUTINE TO INPUT ACCOUNT STRING, RETURNS SUITABLE ARG
;FOR LOGIN OR CACCT JSYS.
;USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.
ACCT:: ACCTX <Account name>
CMERRX
JRST BUFFF ;STRING CASE. SAVE IN BUFFER.
;PASWD
;SUBROUTINE TO INPUT PASSWORD FOR "LOGIN", "ATTACH", AND "CONNECT".
;HANDLES HALF AND FULL DUPLEX CASES.
;BUFFERS IT FOR USE AS A JSYS ARGUMENT AND RETURNS BYTE PTR IN A.
PASLIN:: MOVEI A,[ASCIZ /Password: /]
CALL PASSX
CONFIRM ;CONFIRM
RET ;DONE
PASSX:: CALL NOECHO ;PROMPT TYPER LOOKS AT ONE INPUT CHARACTER SO TURN OFF ECHOING FIRST
UPROMPT @A ;TYPE PROMPT
CALLRET PASWD
PASWD:: CALL NOECHO ;MAKE SURE ECHOING OFF
CALL CHKPTY ;SKIP IF NOT A PTY
JRST PASWDF ;PTY - HANDLE FULL DUPLEX CASE ONLY
MOVE A,CIJFN
RFMOD ;READ TTY MODE
TRNE B,1B32 ;SKIP IF FULL DUPLEX
JRST PASWD1
;FULL DUPLEX CASE
;DON'T ECHO PASSWORD FIELD, DO ECHO TERMINATOR
PASWDF: CALL INPPAS ;INPUT THE PASSWORD
CALL DOECHO ;NOW WE WANT ECHOING ON
CALL GETTER ;GET THE TERMINATING CHARACTER
CAIE A,.CHCRT ;END OF LINE?
CAIN A,.CHLFD
CAIA ;YES
JRST PSWDF1 ;NO
MOVE A,CIJFN ;YES, SEE IF IT GOT ECHOED
RFPOS
TRNE B,-1 ;ARE WE AT COLUMN 1?
ETYPE <%_> ;NO, TYPE A CRLF
PSWDF1: CALLRET BUFFF ;BUFFER PASSWORD AND CHECK IT IF POSSIBLE
;PASWD...
;HALF DUPLEX CASE
;USE SEPERATE LINE, TYPE MASK FIRST
PASWD1: TYPE <
>
UPROMPT [BYTE (7)130,130,130,130,130,130,130,130,130,15
BYTE (7)127,127,127,127,127,127,127,127,127,15
BYTE (7)115,115,115,115,115,115,115,115,115,15
BYTE (7)15,15,0]
;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
CALL INPPAS ;INPUT THE PASSWORD
PRINT CR ;SET TO OVERPRINT SAME LINE
TYPE <Thank you ... >
ETYPE<%_>
ETYPE<%_>
CALLRET BUFFF ;BUFFER AND MAYBE CHECK PASSWORD
;ROUTINE TO INPUT THE PASSWORD
INPPAS: 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
NOXTND,<
MOVE B,CUSRNO ;THE USER NUMBER TO CHECK FOR MAIL
CALL MALCHK ;CHECK FOR NEW MAIL
JRST MESMS9 ;NO NEW MAIL, NO PRINTOUT
TYPE < You have a message
> ;USER TYPES FILE TO RECEIVE MESSAGE
>
XTND,<
HRLOI B,377777 ; SET INF COUNT FOR US
MOVEM B,MWATN0
MOVE B,CUSRNO ; SETUP FOR MAIL CHECK FOR THIS USER
MOVEM B,MWATDR
CALL MALCHK ; DO MAIL CHECK
JRST MESMS9 ; NO MAIL
TYPE < You have >
TLNN B,77 ; Check network mail flag
TYPE <net >
ETYPE <mail %1\%%_%>
>
MOVE A,COJFN
DOBE ;WAIT FOR IT TO REALLY PRINT
XTND,<
GTAD ; SETUP NEXT LOOK TIME
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT
>
MESMS9: SETZM MESMSF ;CLEAR FLAG SO IT WONT BE REPEATED
RET
;CHKPTY - SKIPS IF NOT RUNNING ON PSEUDO-TELETYPE
CHKPTY::PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SETZ D,
GTB .PTYPA ;GET PSEUDO TTY PARMS
HRRZ D,A ;SAVE FIRST PTY NUMBER
PUSH P,D ;FIRST PTY ON STACK
HLRZ A,A ;NUMBER OF PTY'S
ADDI D,(A) ;LAST PTY NUMBER PLUS ONE
MOVNI A,1
MOVE B,[XWD -1,C] ;1 WORD INTO C
MOVEI C,.JITNO ;READ TERMINAL NUMBER
GETJI
CALL JERR
POP P,A ;RESTORE FIRST PTY NUMBER
CAML C,A ;ARE WE A PTY? (DET IS -1)
CAML C,D
AOS -4(P) ;NO, SKIP
POP P,D
POP P,C
POP P,B
POP P,A
RET
;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS: +1: NO SUCH FILE
; +2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.
TRYGTO::PUSH P,B
PUSH P,A
MOVSI A,(GJ%FOU!GJ%SHT)
JRST TRYGT1
TRGTV1:: PUSH P,B
PUSH P,A
MOVE A,[GJ%OLD!GJ%SHT+1] ;OLD FILE, SHORT CALL, VERSION 1
JRST TRYGT1
TRYGTJ::PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY AND SHORT FORM
TRYGT1: CALL GTJFS ;ASSIGN JFN USING STRING POINTER IN B
JRST [ POP P,A ;LOSE, ERROR RETURN
JRST TRYG9]
SUB P,[XWD 1,1] ;FORGET SAVED A
AOS -1(P) ;SKIP
TRYG9: POP P,B
RET
;LOGOUT
.LOGOU::
SKIPN CUSRNO ;LOGGED IN?
JRST LOGOU1 ;NO, ONLY ONE CASE
DECX <Carriage return or job number>
JRST LOGOU1 ;NO NUMBER TYPED, LOG OUT THIS JOB
MOVE A,B ;PUT JOB NUMBER IN A
JRST ..LOGO ;GO LOG OUT REMOTE JOB
LOGOU1: CONFIRM
XTND,<
CALL BLANK1 ; CLEAR SCREEN
CALL DWNPNT ; INFORM DOWNTIME
>
SKIPN CUSRNO
JRST LOGOU2
GJINF ;GET CONNECTED DIRECTORY NUMBER
CAMN B,LIDNO ;DIFFERENT FROM LOGGED-IN ONE?
JRST LOGOU3 ;NO SO DON'T BOTHER EXPUNGING CONNECTED DIR
LDF A,DD%DTF ;FLUSH TEMPORARY FILES
DELDF ;EXPUNG CONNECTED DIR
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE<%_>
JRST .+1]
CALL CHKDAL ;NOW CHECK IT
LOGOU3: MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
LDF A,DD%DTF ;FLUSH TEMPORARY FILES ALSO
DELDF
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE<%_>
JRST .+1]
MOVE A,LIDNO
GTDAL ;GET USAGE/ALLOCATION
JUMPE B,LOGOU2 ;CAN'T BE OVER IF USAGE=0
SUB B,C ;SUBTRACT PERMANENT ALLOCATION FROM USAGE
SKIPLE B ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
LOGOU2: TLO Z,LOGOFF ;SAY LOGGING OUT (TELLS ERROR AND ^C
;ROUTINES TO SAY "NOT LOGGED OUT AFTER ALL").
MOVE A,COJFN
DOBE ;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.
;SET MAP TO "USER"
SETO A, ;SAY ITS SUICIDE
LGOUT
CALL CJERR
;DOESN'T RETURN ON SUCCESS
;"MERGE" IS WITH "GET" ABOVE.
; 'PUSH' = 'PUSH EXEC' (FORMERLY 'EXEC')
; - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'
.PUSH:: NOISE (COMMAND LEVEL)
CONFIRM
CALL PNTMES ;MAKE SURE SYSTEM MESSAGES HAVE BEEN SEEN BEFORE DOING "PUSH"
MOVSI 1,(1B2+1B17)
HRROI 2,[GETSAVE(<SYSTEM:EXEC.>)]
CALL TRYGTJ ;GTJFN AND SAVE IT
ERROR <EXEC not found>
PUSH P,1
MOVSI 1,(1B1) ;XMIT CAPS
CFORK
CALL CJERR
MOVEM 1,EFORK
POP P,1
HRL 1,EFORK
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED
MOVE 1,EFORK
SETZ 2,
SFRKV
ERJMP CJERRE
WFORK
RFSTS
MOVE C,A
MOVE A,EFORK
SETZM EFORK
KFORK
CAME C,[1B0+2B17]
CAMN C,[2B17] ;VOLUNTARY TERMINATION IS NORMAL
RET
ERROR <PUSH terminated abnormally - Fork status = %3O, PC = %2P>
;'POP' = 'POP EXEC' - POP TO HIGHER LEVEL EXEC
.POP:: NOISE (COMMAND LEVEL)
CONFIRM
CALL INFER ;TEST FOR EXISTENCE OF SUPERIOR FORK
ERROR <No higher command level>
JRST QUIT2 ;GO DO HALTF, ETC.
;QUIT: EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.
;IF TOP-LEVEL FORK, LEGAL ONLY FOR ENABLED WHEELS OR OPERS.
.QUIT:: CALL INFER ;SKIP IF INFERIOR
JRST [ MOVX B,WHLU+OPRU
SKIPE PRVENF
CALL PRVCK
ERROR <Not legal in top-level EXEC>
JRST .+1]
QUIT2: MOVE A,SAVT20 ;GET STATE BEFORE WE RAN
CALL SETMOD ;RESTORE IT
MOVE A,SAVNAM ;GET SAVED PROGRAM NAME
SETNM ;RESTORE IT
HALTF
JRST REE ;IN CASE OF RETURN FROM MINI-EXEC
;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ^E EDDT.
INFER:: ATSAVE
MOVEI 1,.FHTOP ;SAY TOP FORK
SETZ 2, ;SAY NO HANDLES OR STATUS
MOVEI 3,1(P) ;SAY BUILD STRUCTURE ON STACK
HRLI 3,-4 ;BUT 4 WORDS MAX
ADD P,[4,,4] ;MAKE ROOM ON STACK
GFRKS ;GET 'STRUCTURE' OF TOP FORK
CALL [ CAIE 1,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
RET] ;YES, WE EXPECT THAT
HRRZ 1,1(3) ;GET HANDLE OF TOP FORK
SUB P,[4,,4] ;CLEAR STACK
CAIN 1,.FHSLF ;IS IT SELF?
RET ;YES, WE ARE TOP AND HAVE NO SUPERIOR
RETSKP ;NO, WE ARE AN INFERIOR
;RECEIVE (LINKS)
.RECEI::TLZ Z,F4 ;SAY RECIEVE CMD
CALL RECREF ;CALL RECEIVE/REFUSE SUBR
MOVE A,[1B5+1B7+.CTTRM]
JUMPE Q1,REC2 ;IF Q1 STILL 0, ASSUME SYSTEM-MESSAGES
TDO A,Q1 ;GET ENABLE BITS
TLINK
CALL JERR
JRST CMDIN4
RECREF: SETZ Q1, ;ACCUMULATE LINKS/ADVICE BITS HERE
KEYWD $LNADV
T LINKS,,.RELNK
JRST CERR
SETZ Q2,
CALL (P3)
CONFIRM ;GET CONFIRMATION
RET
$LNADV: TABLE
T ADVICE,,.READV
T LINKS,,.RELNK
T SYSTEM-MESSAGES,,[RET]
TEND
.READV: TLO Q1,(1B6)
TLNE Z,F4 ;RECIEVE?
RET ;NO - RETURN
TLO Q1,(1B4) ;LINKS TOO
NOISE <AND LINKS>
RET
.RELNK: TLNE Z,F4 ;WHICH KIND?
NOISE <AND ADVICE>
TLO Q1,(1B4)
RET
;REFUSE (LINKS)
.REFUS::TLO Z,F4 ;SAY REFUSE CMD
CALL RECREF ;CALL RECEIVE/REFUSE SUBR
MOVEI A,.CTTRM
JUMPE Q1,REF2 ;IF NO BITS ON IN Q1, ASSUME SYSTEM-MESSAGES
HLL A,Q1 ;COPY ENABLES FROM SUBR
TLINK
CALL JERR
JRST CMDIN4
;REFUSE SYSTEM-MESSAGES
REF2: MOVEI C,.MOSMN ;SAY REFUSE
REF1: MOVEI A,.CTTRM
MOVEI B,.MOSNT ;FUNCTION CODE FOR CONTROLLING MESSAGES
MTOPR ;DO IT
ERCAL CJERRE ;COULDN'T
RET
;RECEIVE SYSTEM-MESSAGES
REC2: MOVEI C,.MOSMY
JRST REF1
;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>
.RENAM::SETOM TYPGRP ;TYPE ALL FILES
NOISE <EXISTING FILE>
CALL INFGNS ;GET INPUT FILE GROUP WITH NO SEARCH
NOISE <TO BE>
CALL MFOUT ;GET MULTI FILE OUTPUT TERM
CONFIRM
HLRZ A,JBUFP
CAIL A,-2 ;WILL NEED 2 MORE FOR PROCESSING
ERROR <Too many JFNs in command>
MOVE A,JBUFP
MOVEM A,.JBUFP ;SAVE THESE JFNS
RENAM1: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX FILE TERM
JRST RENAM2
CALL TYPIF ;TYPE INPUT NAME IF GROUP
CALL MFSET ;SETUP OUTPUT TERM
JRST [ CALL GNFIL ;ERROR, MESSAGE ALREADY PRINTED
SETZM INIFH1 ;CLEAR WHEN NO MORE
JRST RENAM2]
CALL MFINP ;GET SECOND JFN ON INPUT JFN
JRST RENAM2
HRRZ B,OUTDSG ;GET OUTPUT DESCRIPTOR
RNAMF ;RENAME FILE
ERJMP [ LERROR <%1?> ;TELL USER WHY IT FAILED
JRST RENAM2] ;GO ON TO NEXT FILE
CALL TYPOK
RENAM2: SKIPE INIFH1 ;DID LAST GNFIL HIT END?
JRST RENAM1 ;NO
RET
; Request a file be retrieved from offline storage
.RETRI:: STKVAR <NRETR>
NOISE <FILES>
MOVE A,[XWD -1,0] ; No default names
HRLI B,0 ; Default version is 0
HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
TXO Z,IGINV ; Find invisible files
CALL SPECFN
JRST CERR ; No "stuff,"
TXZ Z,IGINV
RETRI2: SETOM TYPGRP ; Always type name
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
SETZM NRETR ;KEEP TRACK OF HOW MANY RETRIEVED
RETRI3: CALL RLJFNS
CALL NXFILE
JRST RETRI4
CALL MFINP ; Get 2nd JFN
JRST RETRI4 ; Failed
MOVE B,[1,,.FBCTL]
MOVEI C,C ; Find out if file is offline
GTFDB
ERJMP RETRI4 ; Skip file if can't find out
TXNN C,FB%OFF ; Is it offline?
JRST RETRI4 ; No, can't possibley retrieve it
ETYPE < %1S> ; TYPE FILE NAME - SHOULD USE TYPIF
; BUT NXFILE MAY HAVE STEPPED US OFF
; THE END CAUSING TYPIF TO LOSE BIG
MOVEI B,.ARRFR ; Request to retrieve it
SETZ C, ; No flags
ARCF
ERJMP [ETYPE < %?
>
JRST RETRI4]
CALL TYPOK
AOS NRETR ;REMEMBER HOW MANY
RETRI4: SKIPE INIFH1 ; Done them all?
JRST RETRI3 ; No, loop
SKIPN NRETR ;DON'T BE TOO QUIET IF NOTHING DONE
ETYPE <%%No files found for retrieving%_>
RET
;^ESEND (MESSAGE) TO ALL ON SYSTEM
.SEND:: TRVAR <SNDPT,SNDLNO>
NOISE (TO)
OCTX <Octal line # or * for all>
CAIA ;NO NUMBER TYPED
JRST SENDA ;NUMBER TYPED.
STARX ;SEE IF "*" TYPD
CMERRx <Octal line number or * required>
HRROI B,-1 ;NOTE "*" WITH -1
SENDA: MOVEM B,SNDLNO ;SAVE LINE NUMBER
NOISE (MESSAGE)
MOVE A,CSBUFP ;GET POINTER TO STRING BUFFER
MOVEM A,SNDPT
CALL SCRLF ;INSERT INITIAL CRLF
MOVEI Q1,"[" ;BEGIN MESSAGE
IDPB Q1,SNDPT
MOVE A,SNDPT ;GET POINTER
HRROI B,[ASCIZ /From /]
MOVEI C,0
SOUT ;"[FROM ...."
MOVE B,CUSRNO ;GET USER NAME
DIRST ;PUT NAME SO PEOPLE WILL KNOW WHO'S SENDING OBSENITIES
CALL JERR ;SHOULDN'T FAIL
PUSH P,A ;SAVE OUTPUT DESIGNATOR
GJINF ;FIND OUT ABOUT MY JOB
POP P,A ;RESTORE AC
JUMPL D,DETSND ;SKIP ON IF WE'RE DETACHED
HRROI B,[ASCIZ/ on line /] ;GET SOME MORE TEXT
SETZ C,
SOUT ;STORE IT
MOVE B,D ;GET NUMBER IN RIGHT AC
MOVEI C,^D8 ;OCTAL OUTPUT
NOUT ;STORE TERMINAL NUMBER
CALL JERR
DETSND: HRROI B,[ASCIZ /: /]
SETZ C,
SOUT ;"[From OPERATOR on line 1: ..."
MOVEM A,SNDPT ;UPDATE POINTER TO MESSAGE
LINEX <Message to be sent>
CMERRX
MOVE A,SNDPT ;GET POINTER TO MESSAGE SO FAR
HRROI B,ATMBUF ;COPY MESSAGE FROM ATOM BUFFER
MOVEI C,0 ;STOP ON NULL
SOUT
MOVEM A,SNDPT ;UPDATE POINTER
MOVEI Q1,"]"
IDPB Q1,SNDPT ;WITH CLOSE BRACKET
CALL SCRLF ;AND TERMINATE WITH CRLF
MOVEI Q1,0 ;GRNTEE NULL
IDPB Q1,SNDPT ; AT END
MOVE A,CSBUFP
CALL SNDFIX ;FORMAT TEXT SO NONE LOST AT END OF LINES
MOVE B,A ;COPY POINTER TO MESSAGE
MOVE A,SNDLNO ;RESTORE LINE(S) FOR MESSAGE
SKIPL A ;SENDING TO PARTICULAR TERMINAL?
ADDI A,.TTDES ;YES, ADD IN TERMINAL DESIGNATOR
TTMSG ;DO IT
ERJMP CJERRE ;IN CASE OF LOSAGE
CALL UNMAP ;UNMAP BUFFER PAGE
RET ;RETURN
;SNDFIX - ROUTINE TO BREAK UP LONG ^ESEND TEXT INTO MULTIPLE LINES
;
;ACCEPTS IN A/ POINTER TO ORIGINAL TEXT
; CALL SNDFIX
;RETURNS: +1 ALWAYS, WITH A/ POINTER TO NEW TEXT
SNDSIZ==^D71 ;MAX SIZE OF ^ESEND LINES
SNDFIX: MOVE C,[POINT 7,BUF0] ;GET POINTER TO NEW STRING
SNDFX1: MOVSI D,-SNDSIZ ;GET MAX SIZE FOR ^ESEND LINES
SNDFX2: ILDB B,A ;GET A CHARACTER FROM INPUT STRING
IDPB B,C ;DEPOSIT CHARACTER IN NEW STRING
JUMPE B,SNDFX3 ;IF END OF STRING, ALL DONE
AOBJN D,SNDFX2 ;LOOP OVER A LINE-FUL OF CHARACTERS
MOVX B,.CHCRT ;GET A CARRIAGE RETURN
IDPB B,C ;ADD RETURN TO STRING
MOVX B,.CHLFD ;GET A LINE FEED
IDPB B,C ;FORM NEW LINE
MOVX B," " ;GET A BLANK
IDPB B,C ;INDENT SUCCESSIVE LINES
JRST SNDFX1 ;GO ADD REMAINDER OF STRING
SNDFX3: MOVE A,[POINT 7,BUF0] ;GET POINTER TO START OF STRING
RET ;DONE, RETURN
;SCRLF - ROUTINE TO ADD CRLF TO INITIAL STRING ASSEMBLED BY ^ESEND
SCRLF: MOVEI Q1,CR ;INSERT CRLF SEQUENCE
IDPB Q1,SNDPT ; INTO MESSAGE
MOVEI Q1,LF
IDPB Q1,SNDPT ;...
RET
;TAKE (EXEC INPUT FROM) FILESPEC
.TAKE:: STKVAR <JFN1,JFN2> ;CELLS TO HOLD NEW JFNS
NOISE <COMMANDS FROM>
SETZM JFN1 ;Indicate no input JFN yet
MOVE Q2,PECHOF ;Assume echoing will be the default
MOVE A,COJFN
MOVEM A,JFN2 ;DEFAULT NEW JFNS TO OLD
DEXTX <CMD> ;DEFAULT INPUT EXTENSION IS CMD
MOVX A,GJ%OLD+GJ%ACC ;OLD FILE ONLY AND DON'T LET INFERIORS KILL IT
MOVEM A,CJFNBK+.GJGEN ;STORE FLAGS
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to end current command level>,,[
FLDDB. .CMCMA,CM%SDH,,<Comma to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Command file name>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED!
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST PRIRES ;YES
CAIN C,.CMCMA ;Comma?
JRST TAKEC ;Yes, get subcommands
MOVEM B,JFN1 ;REMEMBER FIRST JFN
NOISE <LOGGING OUTPUT ON>
DEXTX <LOG> ;DEFAULT OUTPUT EXTENSION IS LOG
MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
;And don't let inferiors touch this JFN
MOVEM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return if no change of output desired>,,[
FLDDB.. .CMCMA,CM%SDH,,<Comma for no change, but to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Output file name>]]]
CALL FLDSKP ;READ EITHER CR OF FILESPEC
CMERRX ;NEITHER TYPED!
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST TAKE1 ;YES, DON'T CHANGE OUTPUT SIDE
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GO GET SUBCOMMANDS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
MOVEI Q1,0 ;FIRST ASSUME NO SUBCOMMANDS
COMMAX <Comma to enter subcommands, or confirm with carriage return>
CAIA ;NO SUBCOMMANDS COMING
MOVEI Q1,1 ;SUBCOMMANDS COMING
CONFIRM ;REQUIRE CONFIRMATION AFTER FILE NAME
JUMPE Q1,TAKE1 ;SKIP SUBCOMMAND STUFF IF NO COMMA
CAIA ;WE'VE ALREADY GOT CONFIRMATION
TAKEC: CONFIRM
SETO Q1, ;Initialize NO flag
SUBCOM $TAKE ;DO THE SUBCOMMANDS
TAKE1: SKIPN A,JFN1 ;Input file typed?
JRST TAKE3 ;No-- this is a NO-OP
MOVE B,[XWD 70000,OF%RD]
OPENF
ERCAL CJERRE ;COULDN'T OPEN TAKE FILE
MOVE A,JFN2
MOVE B,IOPT ;Get old I/O pointer
hrrz b,(b) ;Get old output JFN
CAIN A,(B) ;Output being changed?
JRST TAKE33 ;NO
MOVE B,[XWD 70000,OF%APP]
OPENF
ERCAL CJERRE ;GO PRINT ERROR MESSAGE
TAKE33: HRL A,JFN1 ;Get XWD input,output
CALL PUSHIO ;START NEW STREAM, REMEMBER OLD
TAKE3: MOVEM Q2,ECHOF ;Set echoing mode
RET
PRIRES: CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
RET ;NOTHING TO CLOSE (WE'RE AT TOP LEVEL)
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL
RET
;SUBCOMMANDS TO "TAKE" COMMAND
$TAKE:
TABLE
T ALLOW ;IGNORE ERRORS DURING TAKE
T DISALLOW ;STOP ON ERRORS DURING TAKE
T ECHO ;Echo commands in TAKE file
T NO,,.NOTAK ;NO
TEND
.ALLOW: NOISE (ERRORS DURING "TAKE" FILE)
CONFIRM
SETOM OKERR
RET
.DISAL: NOISE (ERRORS DURING "TAKE" FILE)
CONFIRM
SETZM OKERR
RET
.ECHO: NOISE (COMMANDS FROM "TAKE" FILE)
CONFIRM
MOVEM Q1,Q2 ;Set/clear ECHO flag
RET
.NOTAK: SETCA Q1, ;Complement NO flag
KEYWD $NOTAK ;Get next keyword
EXP 0 ;No default
JRST CERR
JRST (P3) ;Call proper routine
$NOTAK:
TABLE
T ECHO
TEND
;ROUTINE TO PUSH THE EXEC PRIMARY IO STREAM
;CALL WITH INJFN,,OUTJFN IN AC1.
PUSHIO::HLRE B,IOPT ;SEE IF THE IO STACK IS FULL
AOJGE B,NOPE ;YES, GO COMPLAIN
MOVE B,IOPT ;GET IO STACK POINTER
PUSH B,A ;PUT NEW ITEMS ON STACK
HLRZM A,CIJFN ;REMEMBER CURRENT INPUT JFN
HRRZM A,COJFN ;AND OUTPUT
MOVEM B,IOPT ;SAVE NEW POINTER
CALLRET SETIOF ;UPDATE FLAGS AND RETURN
NOPE: MOVE C,A ;SAVE JFNS IN C
HRRZ A,C
MOVE B,-1(B) ;Get last JFNs on list
CAIE A,(B) ;Don't close if last JFN is same
CLOSF ;CLOSE THIS LAST SET OF JFNS, SINCE THEY'RE NOT ON THE STACK YET
ERJMP .+1 ;FAILED, PROBABLY BECAUSE 100 OR 101
HLRZ A,C ;GET OTHER JFN
CLOSF
ERJMP .+1
ERROR <TAKE commands nested too deeply>
;"TYPE" AND "LIST" ARE IN A SEPERATE FILE BELOW.
;UNATTACH - DETACH REMOTE JOB WITHOUT REATTACHING HERE
.UNATT::TLO Z,F1 ;SAY UNATTACH INSTEAD OF ATTACH
JRST ATTAU1 ;GO JOIN ATTACH
;UNDELETE <DELETED FILE NAMES>
.UNDEL::NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
MOVX B,(GJ%OLD!GJ%NS!GJ%DEL!GJ%IFG!1B15!1B16!1B17) ;"MUST BE NEW" AND "IGNORE DELETED BIT"
; ALSO, NO SEARCHING TO BE DONE
HRLI B,-3 ;DEFAULT VERSION IS *
CALL SPECFN ;INPUT FILE NAME USING GTJFN FLAGS IN B
JFCL ;IGNORE SUBCOMMAND ENDING
SETOM TYPGRP ;ALWAYS PRINT FILENAME AT TYPIF
UNDEL1: HRRZ A,@INIFH1 ;JFN
DVCHR
TXNN B,DV%MDD ;MULT DIR DEVICE?
JRST [ ETYPE <?%1H: Can't undelete files on this device
>
MOVSI A,(77B5)
ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
JRST UNDEL8]
HRRZ A,@INIFH1
MOVE B,[XWD 1,.FBCTL] ;CONTROL BITS WORD OF FILE DESC BLOCK
MOVEI C,C ;READ INTO C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
SETO C, ;NO ACCESS, ASSUME DELETED
TXNN C,FB%DEL ;"FILE IS DELETED" BIT
JRST [ MOVE A,@INIFH1 ;GET JFN WITH FLAGS
TLNE A,<77B5>B53 ;ANY *'S?
JRST UNDEL8 ;YES, NO MESSAGE
CALL TYPIF ;PRINT NAME
TYPE < Wasn't deleted
>
JRST UNDEL8]
CALL TYPIF ;TYPE NAME IF GROUP
HRLI A,.FBCTL ;1: XWD DISPLACEMENT, JFN
LDF B,FB%DEL ;MASK OF BITS TO CHANGE
SETZ C, ;VALUE TO CHANGE TO: OFF.
CALL $CHFDB ;DO CHFDB AND FIELD ITRAP IF ANY
JRST [ TYPE < Access not allowed
>
JRST UNDEL8]
CALL TYPOK ;INDICATE DONE OK
UNDEL8: CALL GNFIL ;GET JFN OF NEXT FILE OF GROUP
RET ;NO MORE, GO GET NEXT COMMAND.
JRST UNDEL1 ;HAVE ANOTHER
;PRIVILEGED COMMANDS
;^E EDDT
;TRANSFER CONTROL TO TOPS20 DDT, GETTING IT IF IT ISN'T ALREADY THERE.
.EDDT:: SKIPE DDTORG
JRST EDDT4 ;DDT ALREADY THERE
SKIPN Q1,.JOBSY ;DO WE HAVE SOME SYMBOLS?
SKIPE Q1,JOBSYM ;???
SKIPA B,[-1,,[GETSAVE <SYS:UDDT.>]]
HRROI B,[GETSAVE <SYS:SDDT.>] ;USE SDDT IF NO SYMBOLS
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY, AND SHORT FORM
CALL GTJFS ;GET AND STACK THE JFN
CALL CJERRE ;IF CAN'T, JUST GIVE ERROR TO USER
HRLI A,.FHSLF ;SAY THIS FORK (JFN IS IN RH A)
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED, SAY WHY
CALL RLJFNS
;"GET" CHANGES ENTRY VECTOR TO POINT AT DDT.
;CHANGE IT BACK.
MOVEI A,.FHSLF
MOVE B,[EVLEN,,EXEC] ;ENTRY VECTOR AT BEGINNING OF M.MAC
SEVEC
;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.
SKIPN Q1 ;HAVE ONE?
JRST [TYPE <% No symbols
>
JRST EDDT4] ;NO - PROCEDE
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 Q1, ;FLAG DISABLE
DISAB1: NOISE <CAPABILITIES>
CONFIRM
MOVEM Q1,PRVENF
MOVEI A,.FHSLF ;"ENABLE" JOINS HERE
RPCAP
TRZ C,-1
SKIPE PRVENF
HRR C,B
EPCAP ;EXEC'S CAPABILITIES
SKIPG A,FORK
RET ;NO INFERIOR, DONE
RPCAP
TDZ C,[777B8+777777] ;MAKE CAPS BE OFF
SKIPE PRVENF ;NOW ENABLED?
MOVE C,B ;YES, MAKE CAPS BE ON
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 Q1, ;FLAG TO DO ENABLE
JRST DISAB1
;^ELOGOUT (JOB #)
..LOGO::PUSH P,A
GJINF
CAMN 3,0(P) ;THIS JOB?
ERROR <If you want to logout this job, use LOGOUT>
MOVE D,0(P) ;RECOVER JOB NUMBER
HLRE A,JOBRT ;GET NUMBER OF JOBS ON SYSTEM
MOVM A,A ;MAKE IT POSITIVE
CAML D,A ;VALID ARG?
JRST ELOGO1 ;NO
JUMPL D,ELOGO1 ;NEGATIVE ALSO INVALID
GTB .JOBRT ;CHECK RUNTIME TABLE
JUMPGE 1,.+2 ;REQUESTED JOB EXISTS?
ELOGO1: ERROR <That job does not exist>
CONFIRM
POP P,A
LGOUT
CALL CJERR
JRST CMDIN4
XTND,<
.BLANK::NOISE (SCREEN)
CONFIRM
BLANK1::STKVAR <TMOD>
MOVE 1,COJFN ; CURRENT OUTPUT JFN
RFMOD ; GET MODE WORD
MOVEM B,TMOD ; SAVE IT
TXZ B,TT%DAM ; NO XLATION
SFMOD
GTTYP ; GET TERMINAL TYPE
CAIG B,^D18 ; 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) TTY 33
0 ; (1) TTY 35
0 ; (2) TTY 37
0 ; (3) TI / EXECUPORT
REPEAT 4,<0> ; (4-7) RESERVED FOR CUSTOMER
0 ; (8) SYSTEM DEFAULT
0 ; (9) IDEAL (NO FILL)
[BYTE (7)35,177,177,177,177,177,177,37,0] ; (10) VT05
BYTE (7)33,"H",33,"J",0 ; (11) VT50
0 ; (12) LA30
BYTE (7)35,37 ; (13) GT40 - NO FILL REQUIRED
0 ; (14) LA36
BYTE (7)33,"H",33,"J",0 ; (15) VT52
[BYTE (7)33,"[","H",33,"[","J",0] ; (16) VT100
0 ; (17) LA38
0 ; (18) LA120
>
END