Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-EXEC>EXECVR.MAC.1055, 17-Jul-85 10:10:24, Edit by IAN
; [NIC1055] Make LAZCON fake up the COMAND word to point to the "connect"
; command, so avoid nasty IMRs in MAKSIX when it interprets the directory#
; as a pointer
;[SRI-NIC]SRC:<6-EXEC>EXEC1.MAC.25, 21-Jun-85 15:58:24, Edit by ROODE
; [NIC1047] extend prohibition of login as ANONYMOUS to all directories
; starting with that string
;[SRI-NIC]SRC:<6-EXEC>EXEC1.MAC.25, 10-May-85 12:29:44, Edit by HSS
; [NIC1035] Add lazy connect code.
;[SRI-NIC]SRC:<6-EXEC>EXEC1.MAC.24, 7-May-85 17:10:19, Edit by HSS
; [NIC1030] Allow exec to pass capabilities to inferiors.
;[SRI-NIC]SRC:<6-EXEC>EXEC1.MAC.23, 4-May-85 15:58:17, Edit by HSS
; [NIC1025] Remove most of Edit NIC1016 in favor of the existing
; Stanford attach detached job code.
;[SRI-NIC]SRC:<6-EXEC>EXEC1.MAC.22, 4-May-85 15:10:01, Edit by HSS
; [NIC1024] Fixed mistake in setting of OPERF
;[SRI-NIC]SRC:<6-EXEC>EXEC1.MAC.21, 18-Apr-85 15:58:11, Edit by HSS
; [NIC1021] Make RENAME copy files if two different structures are involved.
;[SRI-NIC]PS:<HSS.EXEC>EXEC1.MAC.20, 17-Apr-85 14:45:53, Edit by HSS
; [NIC1020] Make the DAYTIME command use a different format.
;[SRI-NIC]PS:<HSS.EXEC>EXEC1.MAC.19, 16-Apr-85 16:04:27, Edit by HSS
; [NIC1016] Add ask-to-attach-on-login code. Disable Stanford charge limit
; checking code.
;[SRI-NIC]PS:<HSS.EXEC>EXEC1.MAC.18, 16-Apr-85 15:06:03, Edit by HSS
; [NIC1015] Check for non-FTP anonymous login attempts
;[SRI-NIC]PS:<HSS.EXEC>EXEC1.MAC.17, 10-Apr-85 17:17:46, Edit by HSS
; [NIC1005] Change RETRIEVE message when file is already online.
;[SRI-NIC]PS:<HSS.EXEC>EXEC1.MAC.16, 5-Apr-85 16:41:14, Edit by HSS
; [NIC1003] Add BACK command
;[SRI-NIC]PS:<HSS.EXEC>EXEC1.MAC.15, 3-Apr-85 16:27:09, Edit by HSS
; [NIC1000] Add .KK0 label to die on.
;<6-EXEC>EXEC1.MAC.14, 7-Jan-85 13:54:57, Edit by HEGARTY
; Change edit 13 back to DBEDIT.EXE (we fixed DBEDIT)
;<6-EXEC>EXEC1.MAC.13, 19-Oct-84 19:14:08, Edit by LOUGHEED
; LOTS only: run DBCHANGE.EXE not DBEDIT.EXE
;<6-EXEC>EXEC1.MAC.12, 14-Sep-84 19:19:08, Edit by LOUGHEED
; ATTNLI has a better message for naive users
;<6-EXEC>EXEC1.MAC.11, 12-Sep-84 21:09:05, Edit by LOUGHEED
; Reinstall LOTS OPEN command that was lost in merge
;<6-EXEC>EXEC1.MAC.10, 12-Aug-84 13:50:49, Edit by LOUGHEED
; Remove unnecessary edit to BLANK command
;<6-EXEC>EXEC1.MAC.9, 9-Aug-84 14:57:33, Edit by LOUGHEED
;<6-EXEC>EXEC1.MAC.8, 9-Aug-84 14:32:17, Edit by LOUGHEED
; Fix execution of LOGOUT.CMD file
;<6-EXEC>EXEC1.MAC.7, 9-Aug-84 01:18:57, Edit by LOUGHEED
; Depend on ACJ to catch CD%RTD and CD%NVD directories
;<6-EXEC>EXEC1.MAC.6, 9-Aug-84 00:50:32, Edit by LOUGHEED
; Flush fancy ^ESEND code (use SEND program instead)
; Flush CHKLCL since it has outlived its usefulness
; Acct routine, LGXINI setup everywhere, misc. cleanups
;SCORE:<MERGED-6-EXEC>EXEC1.MAC.2, 11-Jul-84 06:26:59, Edit by JPBION
;Score changes:
; Support for charge limits
;SUMEX changes:
; Don't delete .TMP files on LOGOUT
; Reinstall ACCT routine
; When setting LOGINI, set LGXINI too (take SYSTEM:LOGIN.CMD)
;GSB changes:
; Set account (1 or 2) after login according to TTYRES information
;LOTS changes:
; OPEN command.
;Stanford changes:
; Reverse sense of BATCHF skip in LOGOU1
; ATTNLI routine for asking to attach detached jobs while logging in
; Remove unnecessary check for files only in ATTACH
; Check for frozen, root-dir-subdir, and guest in ATTACH and LOGIN
; CHKLCL routine to check for terminal locality for guest logins
; Lazy login support
; No accounts or session remarks in login
; Allow password to be typed on separate line from LOGIN command
; Support MRP -- user may only run LOGIN.CMD or programs, not EXEC commands
; Show other jobs logged in as that user
; Type previous date/time of login, otherwise friendly greeting message
; Remove ACCT routine
; Do LINEX instead of WORDX at INPP1 to avoid ^R retyping a password
; Suppress screen blanking and downtime print if batch or LOGOUT.CMD
; Delete all files with extension .TMP before EXPUNGE in LOGOUT
; LOGOUT.CMD support
; KK command to just log out
; Informative error if .LGOUT fails
; Tell who's about to get it with remote LOGOUT
; Stanford terminal types for BLANK
; OPERATOR gets to log in quietly
; CTRL-L in REMARK blanks the screen
; ENABLE/DISABLE doesn't mess with inferior's capabilities
;
; UPD ID= 392, SNARK:<6.EXEC>EXEC1.MAC.47, 28-Feb-84 08:23:59 by PRATT
;TCO 6.1956 - Check the SMON Exec flags before allowing /FAST
; UPD ID= 378, SNARK:<6.EXEC>EXEC1.MAC.46, 18-Jan-84 16:34:30 by PRATT
;More TCO 6.1796 - Use Q1 and Q2 in .RESYS, not just Q1
; UPD ID= 377, SNARK:<6.EXEC>EXEC1.MAC.45, 18-Jan-84 15:58:50 by PRATT
;TCO 6.1940 - Rewrite TCO 6.1857
; UPD ID= 371, SNARK:<6.EXEC>EXEC1.MAC.44, 5-Jan-84 10:16:00 by PRATT
;TCO 6.1923 - If detached and using .PRIIN, bypass the the DVCHR in PUSHIO
; UPD ID= 368, SNARK:<6.EXEC>EXEC1.MAC.43, 28-Dec-83 16:35:16 by PRATT
;More TCO 6.1796 - Add REFUSE USER-MESSAGES
; UPD ID= 364, SNARK:<6.EXEC>EXEC1.MAC.42, 27-Dec-83 10:14:00 by TSANG
;More for TCO 6.1857 - Need for CONFIRMATION.
; UPD ID= 363, SNARK:<6.EXEC>EXEC1.MAC.41, 19-Dec-83 12:14:02 by TSANG
;TCO 6.1857 - LOGOUT of another job give the victim's name and ask for confirm.
; UPD ID= 334, SNARK:<6.EXEC>EXEC1.MAC.40, 20-Nov-83 19:38:27 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 330, SNARK:<6.EXEC>EXEC1.MAC.38, 18-Nov-83 14:33:13 by TSANG
;More TCO 6.1837
; UPD ID= 329, SNARK:<6.EXEC>EXEC1.MAC.37, 17-Nov-83 17:25:46 by PRATT
;More TCO 6.1796 - New RECV/REFUSE code to prepare for USER-MESSAGE option
; UPD ID= 327, SNARK:<6.EXEC>EXEC1.MAC.36, 17-Nov-83 13:59:48 by PRATT
;TCO 6.1796 - [Set] Terminal [no] Receive Advice/Links/System-messages
; UPD ID= 322, SNARK:<6.EXEC>EXEC1.MAC.35, 10-Nov-83 14:10:47 by TSANG
;TCO 6.1837 - Set flag bit for .DELET .DISCA and remove from .RENAM
; UPD ID= 318, SNARK:<6.EXEC>EXEC1.MAC.34, 8-Nov-83 13:48:35 by PRATT
;TCO 6.1847 - Fast LOGIN code
; UPD ID= 305, SNARK:<6.EXEC>EXEC1.MAC.33, 8-Aug-83 11:24:04 by TSANG
;TCO 6.1760 - Set flag bit for .RENAM
; UPD ID= 285, SNARK:<6.EXEC>EXEC1.MAC.32, 13-May-83 00:03:01 by PAETZOLD
;TCP 6.1656 - Zero SNDPTC in .USEND after the TRVAR
; UPD ID= 264, SNARK:<6.EXEC>EXEC1.MAC.31, 8-Apr-83 13:53:41 by TSANG
;TCO 6.1580 - Provide ERJMP CJERR after RPCAP and EPCAP JSYS call
; UPD ID= 255, SNARK:<6.EXEC>EXEC1.MAC.30, 28-Jan-83 14:19:27 by DONAHUE
;TCO 6.1437 - Add CONFIRM to routine TKLOG
; UPD ID= 234, SNARK:<6.EXEC>EXEC1.MAC.29, 15-Jan-83 19:23:40 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 215, SNARK:<6.EXEC>EXEC1.MAC.28, 10-Jan-83 14:10:07 by LOMARTIRE
;TCO 6.1449 - New entry routine TRYGTS for getting a jfn for SYSJOB.COMMANDS
; UPD ID= 192, SNARK:<6.EXEC>EXEC1.MAC.27, 11-Nov-82 21:49:38 by CHALL
;TCO 6.1366 .TALK- REPLACE REFERENCES TO "MAIL" WITH A SUGGESTION TO RUN MAIL
; UPD ID= 170, SNARK:<6.EXEC>EXEC1.MAC.25, 30-Sep-82 20:15:35 by CHALL
;TCO 6.1288 PASWD1- TURN ON ECHOING AFTER READING PASSWORD ON A HDX T'L
;TCO 6.1286 .USEND- ADD SEND COMMAND (LIKE ^ESEND, NOT ENABLED)
; UPD ID= 154, SNARK:<6.EXEC>EXEC1.MAC.22, 28-Aug-82 18:27:19 by PAETZOLD
;More TCO 6.1240 - Get last login time from login jsys and not gtdir
; UPD ID= 165, SNARK:<6.EXEC>EXEC1.MAC.23, 28-Sep-82 10:21:17 by TSANG
;TCO 6.1250 - SET BREAK MASK FOR PARSING A PASSWORD IN WORDX.
; UPD ID= 154, SNARK:<6.EXEC>EXEC1.MAC.22, 28-Aug-82 18:27:19 by PAETZOLD
;More TCO 6.1240 - Get last login time from login jsys and not gtdir
; UPD ID= 152, SNARK:<6.EXEC>EXEC1.MAC.20, 28-Aug-82 11:53:36 by PAETZOLD
;TCO 6.1240 - Output date and time of last login when logging in
; UPD ID= 133, SNARK:<6.EXEC>EXEC1.MAC.19, 4-Aug-82 17:11:37 by LEACHE
;TCO 6.1209 - Fix invocations of ETYPE
; UPD ID= 130, SNARK:<6.EXEC>EXEC1.MAC.17, 22-Jul-82 00:01:39 by WALLACE
;TCO 6.1190 - Modify PDLFRE, the routine which gives pages freed for
; the DELETE command, to output pages freed only if EXPUNGE is
; explicitly requested and to say nothing if directory allocation grows
; during execution of the command. As before, always output zero pages
; freed for non multiple directory devices.
; UPD ID= 128, SNARK:<6.EXEC>EXEC1.MAC.16, 25-Jun-82 20:36:14 by CHALL
;TCO 6.1178 .PUSH- LOOK FOR "DEFAULT-EXEC:", THEN "SYSTEM:EXEC.EXE"
; UPD ID= 127, SNARK:<6.EXEC>EXEC1.MAC.15, 12-Jun-82 12:09:21 by CHALL
;TCO 6.1165 CANARC- SET CF%NS (NO SUBCOMMANDS) FOR CALL TO SPECFN
; UPD ID= 123, SNARK:<6.EXEC>EXEC1.MAC.14, 24-Apr-82 12:25:04 by CHALL
;TCO 6.1101 CONSOLIDATE STUFF ABOUT TERMINALS (BLNKTB) IN EXECCA
;TCO 6.1100 .SEND- RE-CAST THE ^ESEND CODE
; UPD ID= 104, SNARK:<6.EXEC>EXEC1.MAC.13, 22-Jan-82 16:42:48 by CHALL
;TCO 5.1698 .TKLOG- ADD NEW SUBCOMMAND TO TAKE: LOG-FILE
; UPD ID= 103, SNARK:<6.EXEC>EXEC1.MAC.12, 15-Jan-82 16:32:12 by CHALL
;TCO 5.1668 .CLOSE- ADD HELP MESSAGE TO OCTX LUUO
; UPD ID= 85, SNARK:<6.EXEC>EXEC1.MAC.11, 8-Jan-82 15:45:33 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 66, SNARK:<6.EXEC>EXEC1.MAC.9, 10-Oct-81 20:06:43 by CHALL
;TCO 5.1563 .CONNE- ADD "STRUCTURE NOT MOUNTED" TO CONNECT ERROR MESSAGE
; UPD ID= 25, SNARK:<6.EXEC>EXEC1.MAC.7, 17-Aug-81 10:33:14 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 14, SNARK:<6.EXEC>EXEC1.MAC.6, 21-Jul-81 12:30:56 by MURPHY
;TCO 5.1427 - GET RID OF SYSTEM MAIL BEFORE PUSH
; UPD ID= 12, SNARK:<6.EXEC>EXEC1.MAC.5, 20-Jul-81 11:18:33 by CHALL
;TCO 5.1420 - DETSND: HAVE SEND * SAY IT'S GOING TO ALL
; 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
;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,1983 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
TTITLE EXEC1
;THIS FILE CONTAINS
;LOTS OF COMMANDS...
;ARCHIVE <Files>
;F2 - DON'T FLUSH FILE CONTENTS
.ARCHI::NOISE <FILES>
TLZ Z,F2 ;DEFAULT IS NOT TO RETAIN CONTENTS
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
CALL SPECFN
JRST ARCHI1
JRST ARCHI2 ;DO IT
ARCHI1: SUBCOM $ARCHI
ARCHI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
MOVX C,.ARSET ;WITH NO FLAGS
TLNE Z,F2 ;WANT TO RETAIN FILE CONTENTS?
TXO C,AR%NDL ;RIGHT, FLAG THAT ON THE CALL
PUSH P,C ;SAVE DISPOSITION BITS ETC
ARCHI3: CALL RLJFNS
CALL NXFILE
JRST ARCHI9
CALL TYPIF
CALL MFINP ;GET 2ND JFN
JRST ARCHI9 ;FAILED
MOVX B,.ARRAR ;FUNCTION CODE TO USE (PLS ARCHIVE)
MOVE C,0(P) ;AND BITS
ARCF
ERJMP [ETYPE < %?%%_>
JRST ARCHI9]
IFE STANSW,<
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]
>;IFE STANSW
IFN STANSW,<
IFE GSBSW,<
HRLI A,.FBCTL
MOVX B,FB%INV ;MAKE THE FILE INVISIBLE TOO
MOVX C,FB%INV
TLNN Z,F2 ;RETAIN CONTENTS?
CHFDB
IFJER.
ETYPE < %?%%_>
ENDIF.
>;IFE GSBSW
>;IFN STANSW
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 POINTER
.ASSO2: SKIPN (P) ;ALL?
JRST .ASS3B ;YES, SEPARATE ROUTINE
NOISE <AS>
CRRX <Definition list or null to delete>
CAIA ;NOT JUST "DEFINE FOO<CR>"
JRST .ASSO9 ;YES, JUST "DEFINE FOO<CR>"
LINEX <Definition list> ;READ DEFINITION LINE
CMERRX ;NOT ANYTHING LEGAL AFTER "DEFINE" !
CALL BUFFF ;GET POINTER TO DEFINITION STRING
CONFIRM
MOVE C,A ;NEW NAME IN C
MOVEI A,.CLNJB
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSY ;YES
.ASSO4: TLNE Z,F2 ;SYSTEM?
CALL FCONF ;YES, FORCE FURTHER CONFIRMATION
MOVE B,(P) ;GET LOGICAL NAME
PUSH P,A ;REMEMBER ATTEMPTED FUNCTION IN CASE ERROR
CRLNM
JRST ASSONO ;COULDN'T DO IT
POP P,(P)
POP P,(P) ;FIX STACK
RET
;HERE WHEN LOGICAL NAME MANIPULATION FAILED
ASSONO: CAIE A,CRLNX1
CALL CJERRE ;UNKNOWN ERROR
POP P,A ;NOW WE KNOW "NAME UNDEFINED"
CAIE A,.clnj1 ;TRYING TO DELETE ONE JOB NAME?
CAIN A,.clns1 ;OR TRYING TO DELETE ONE SYSTEM NAME?
CAIA ;YES
CALL CJERRE ;NO, TYPE MONITOR MESSAGE
POP P,A ;GET POINTER TO NAME WE COULDN'T DELETE
ETYPE <%%Logical name %1M: was not defined
>
RET ;NON-FATAL ERROR IF DELETING NON-EXISTENT LOGICAL NAME
.ASSO9: MOVEI A,.CLNJ1 ;DELETE
TLNE Z,F2
MOVEI A,.CLNS1
JRST .ASSO4
.ASS3B: CRRX <Confirm to delete all logical names>
CMERRX
MOVEI A,.CLNJA ;DELETE ALL
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSA
TLNE Z,F2 ;SYSTEM?
PROMPT <[Confirm to delete all SYSTEM logical names]>
TLNN Z,F2
PROMPT <[Confirm to delete ALL logical names]>
CALL FCONFA
CRLNM
CALL CJERR
POP P,B
RET
;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>
;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM:
;ATTACH
;(USER) <NAME>
;(PASSWORD) ----
;(TSS JOB #) <#>
;PASSWORD IS NOT ECHOED IN FULL DUPLEX, TYPED OVER MASK ON
;FOLLOWING LINE IN HALF DUPLEX.
;TSS JOB # CAN BE OMITTED IF THERE IS ONLY ONE JOB FOR GIVEN USER.
;IF NOT LOGGED IN, CURRENT JOB GOES AWAY (HANDLED BY MONITOR),
;IF LOGGED IN IT IS DETACHED.
;IN ORDER TO NOT HAVE TO HAVE THE EXEC WAKING UP AFTER EVERY FIELD
;OF INPUT TO SEE IF WE'RE DOING SOME SORT OF PASSWORD COMMAND, THE
;FORMAT OF THE "ATTACH" AND "UNATTACH" COMMANDS HAVE BEEN CHANGED TO
;PROMPT FOR THEIR PASSWORD ON THE SECOND LINE. SINCE THE CR AT END
;OF FIRST LINE CAUSES WAKEUP, THIS GUARANTEES THAT ECHOING WILL HAVE
;A CHANCE TO BE TURNED OFF BEFORE USER TYPES PASSWORD.E.O. JUL-8-77
.ATTAC:: ;ENTRY FOR COMMAND, NEXT TAG IS FROM UNATTACH
IFNBATCH <[ERROR <ATTACH illegal from BATCH job>]>
ATTAU1:
;DECODE ARGUMENTS
TRVAR <ATTNM,<APBUF,20>,AT1,AT2> ;HOLDS ATACH ARGS
NOISE <USER>
CALL USERN ;INPUT USER (DIRECTORY) NAME
CMERRX ;FAILED, PRINT REASON
TXNE A,RC%DIR
ERROR <That's a FILES-ONLY directory name>
PUSH P,C ;SAVE DIR #
SETOM ATTNM ;CLEAR ATTACHED TERMINAL # HERE
NOISE <JOB #>
DECX < Number if more than one job under that name>
CAIA ;NON-DECIMAL NUMBER TYPED
JRST ATTNUM ;NUMBER TYPED, GO PROCESS IT
CONFIRM ;REQUIRE CONFIRMATION OF COMMAND
JRST ATTAC5 ;GO DEFAULT A VALUE
ATTNUM: CONFIRM
PUSH P,B ;SAVE JOB # INPUT BY USER
;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE
SETO D,
GTB .JOBRT ;GET MAX JOB # AS LENGTH OF SYSTEM TABLE
MOVN A,A ;LENGTH COMES BACK NEGATIVE
SUBI A,1 ;SO VALUE COMES OUT RIGHT IN ERR MSG
CAML A,(P) ;LENGTH MUST BE > GIVEN #
SKIPGE D,(P) ;GIVEN JOB # TO D
ERROR <Job # must be between 0 and %1Q>
;MAKE SURE GIVEN JOB # IS LOGGED IN W MATCHING USER # AND IS ATTACHED
GTB .JOBRT ;ENTRY NEG IF NO SUCH JOB
JUMPL A,[UERR[ASCIZ /No job %4Q/]]
GTB .JOBTT ;LINE # OR NEGATIVE FOR DETACHED IN LH
HLREM A,ATTNM ;STORE ATTACHED LINE NUMBER FOR LATER
CALL USERNO ;GET USER OWNING JOB BEING ATTACHED
JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]]
MOVE Q1,-1(P) ;DESIRED USER #, FOR USE IN ERR MSG
CAME A,Q1
ERROR <Job %4Q not logged in under %5R>
JRST ATTAC7 ;GO CONFIRM AND EXECUTE
;ATTACH...
;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME.
ATTAC5: ;SEARCH JOBDIR TABLE FOR A MATCH
GJINF ;GET JOB # INTO C FOR TEST LATER
MOVE Q1,(P) ;DIR # TO SEARCH FOR (USED IN ERR MSGS!)
SETO D,
GTB .JOBRT ;JOBRT TABLE BY JOB #, LOGIN DIR # IN RH.
HRLZ D,A ;SET UP XWD LENGTH, INDEX FOR AOBJN & GTB.
TLZ Z,F2 ;FLAG NO DETACHED JOBS SEEN YET
PUSH P,[-1] ;INIT JOB TO UNKNOWN
ATA5A: CAIN C,(D) ;ALWAYS SKIP US
JRST ATA5L
CALL USERNO
CAME A,Q1 ;IS THIS THE CORRECT USER?
JRST ATA5L ;NO
GTB .JOBTT ;YES - GET TTY WORD
TLNN Z,F1 ;ATTACH OR UNATTACH?
JRST ATA5B ;ATTACH
JUMPL A,ATA5L ;JUMP IF DETACHED
SKIPL (P) ;ATTACHED JOB, SEEN ONE ALREADY?
JRST ATA5E1 ;YES, ERROR
HRRZM D,(P) ;SAVE JOB #
SETOM ATTNM ; AND SET TERM AS DETACHED
JRST ATA5L
ATA5B: JUMPL A,ATA5C ;JUMP IF DETACHED
TLNE Z,F2 ;ALREADY SEEN DETACHED JOB?
JRST ATA5L ;YES, DON'T LOOK AT ATTACHED ONES
SKIPL (P) ;FIRST ATTACHED ONE?
JRST ATA5D ;NO, STOP LOOKING AT ATTACHED ONES
HRRZM D,(P) ;SAVE JOB #
HLREM A,ATTNM ; AND TERMINAL #
JRST ATA5L
ATA5D: SETOM (P) ;RESET JOB # TO UNKNOWN
SETOM ATTNM ; AND TERMINAL # ALSO
TLO Z,F2 ;SET FLAG TO LOOK ONLY AT DETACHED JOBS
JRST ATA5L
ATA5C: TLON Z,F2 ;FLAG DETACHED JOB FOUND
SETOM (P) ;FORGET ANY ATTACHED JOB
SKIPL (P) ;MORE THAN ONE?
ERROR <Job # required - %5R has more than one detached job>
HRRZM D,(P) ;NO, SAVE JOB #
SETOM ATTNM ; AND MARK TERMINAL DETACHED
ATA5L: AOBJN D,ATA5A ;LOOP THROUGH ALL JOBS
SKIPL (P) ;DID WE FIND A JOB?
JRST ATTAC7 ;YES, GO DO IT
TLNE Z,F2 ;.GT. 1 ATTACHED, BUT 0 DETACHED?
JRST ATA5E1 ;YES, SAME ERROR MESSAGE AS UNATTACH
TLNE Z,F1 ;ATTACH OF UNATTACH?
JRST ATA5E2 ;UNATTACH
CAMN Q1,CUSRNO
ERROR <No other jobs logged in under %5R>
ERROR <No jobs logged in under %5R>
ATA5E2: CAMN Q1,CUSRNO
ERROR <No other attached jobs logged in under %5R>
ERROR <No attached jobs logged in under %5R>
ATA5E1: CAMN Q1,CUSRNO
ERROR <Job # required - %5R has more than one other attached job>
ERROR <Job # required - %5R has more than one attached job>
;ATTACH...
;CHECK FOR SELF
ATTAC7: GJINF ;GET JOB NUMBER IN C
CAMN C,(P) ;IS IT US?
JRST [ TLNN Z,F1 ;ATTACH OR UNATTACH?
ERROR <Cannot ATTACH to self>
ERROR <Cannot UNATTACH self>]
;CHECK FOR ALREADY ATTACHED
SKIPGE A,ATTNM ;TTY #
JRST ATAC4B
HRROI B,APBUF ;REDIRECT OUTPUT TO OUR BUFFER
MOVEM B,COJFN
ETYPE < [Attached to TTY%1O, confirm]>
CALL FIXIO ;RESUME NORMAL OUTPUT
UPROMP APBUF ;PROMPT USER FOR CONFIRMATION
CALL FCONFA
;EXECUTE THE COMMAND
ATAC4B: POP P,A ;TSS JOB # TO ATTACH TO
MOVEI C,0 ;NO PASSWORD POINTER
POP P,B ;USER TO ATTACH TO
TLNN Z,F1 ;IF NOT LOSING THIS JOB
SKIPN CUSRNO ;OR NOT LOGGED IN,
CAIA ;THEN SAY NOTHING
ETYPE < Detaching job # %J
>
TLNE Z,F1 ;UNATTACH?
TLO A,(1B1) ;YES, TELL ATACH
DMOVEM A,AT1 ;SAVE ARGS IN CASE REDO NECESSARY
ATACH ;TRY TO DO IT
ERJMP .+2 ;FAILED
JRST ATGOOD ;SUCCEEDED
CAIE A,ATACX4 ;PASSWORD PROBLEM?
JRST ATNG ;NO, SOME OTHER ERROR
CALL PASLIN ;PASSWORD NOT GIVEN BUT REQUIRED, GET IT
MOVE C,A ;STORE NEW PASSWORD POINTER
DMOVE A,AT1 ;GET OTHER ARGS
ATACH
ATNG: CALL [ TLNN Z,F1 ;DIDN'T SAY DETACHING JOB IF UNATTACH
ETYPE <?ATTACH failure, still attached to job # %J
>
CALL CJERRE]
ATGOOD: JRST CMDIN4 ;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
; STILL ATTACHED IF 'UNATTACH' JUST DONE.
;BREAK (LINKS)
BREAK0: CONFIRM
BREK0A: MOVEI B,-1 ;SET TO BREAK ALL LINKS
;(FALL INTO BREAK1)
;BREAK1 breaks links from specific terminal.
;
;Accepts: B/ terminal number or 777777 for all
BREAK1::MOVE A,[TL%CRO!TL%COR+.CTTRM] ;BREAK TO AND FROM LINKS
TLINK
CALL JERR
RET
;BREAK (LINKS WITH) - FANCIER FORM OF BREAK COMMAND
.BREAK::NOISE <LINKS WITH>
STKVAR <BYUNO>
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "*"]>,<User name, line number, or CR for all>,<*>,[
FLDDB. .CMUSR,CM%SDH,,,,[
FLDDB. .CMNUM,CM%SDH,10,,,[
FLDDB. .CMCFM,CM%SDH,,,,]]]]
CALL FLDSKP ;PARSE THIS MESS
CMERRX
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIN C,.CMCFM ;JUST CR?
JRST BREK0A ;YES - DO ALL
CAIN C,.CMTOK ;WAS IT "*"
JRST BREAK0 ;YES - CONFIRM AND DO ALL
CONFIRM ;MUST BE USER NAME OR LINE #
CAIN C,.CMNUM ;LINE NUMBER?
JRST .BYEBY ;YES - CONFIRM, BREAK, AND RETURN
MOVEM B,BYUNO ;SAVE USER #
TLZ Z,F1!F2 ;INIT FLAGS
HLLZ D,JOBRT ;-# OF JOBS AS AOBJN CNTR
.BYE2: CALL USERNO ;GET USER # OF JOB IN D
CAME A,BYUNO ;IS IT THE ONE WE WANT?
JRST .BYE3 ;NO
TLO Z,F2 ;FOUND ONE
GTB .JOBTT ;GET TTY # FOR JOB
JUMPL A,.BYE3 ;JUMP IF DETACHED
TLO Z,F1 ;ACTUALLY OK TO BREAK LINK
HLRZ B,A ;LINE # TO RHS
CALL .BYEBY ;BREAK A LINK
.BYE3: AOBJN D,.BYE2 ;LOOP THRU ALL JOBS
TLNE Z,F1 ;DID ANY?
RET ;YUP - DONE
TLNE Z,F2 ;WHAT KIND OF LOSAGE?
ERROR <User has detached jobs only>
ERROR <User not logged in>
.BYEBY: TXO B,.TTDES ;MAKE INTO TERMINAL DESC.
CALLRET BREAK1 ;BREAK THE LINK AND RETURN
;CANCEL (Request type) ARCHIVE - arrive here from EXECQU
CANARC::NOISE <FOR FILES>
MOVE A,[XWD -1,0]
HRLI B,-3 ;ALL GENERATIONS
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS)
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
SETOM TYPGRP
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP ;SET JFN STACK FENCE
CANAR1: CALL RLJFNS ;RELEASE UNNEEDED JFNS
CALL NXFILE ;STEP TO NEXT FILE
JRST CANAR2
HRRZ A,@INIFH1 ;GET THE JFN WITH NO BITS
MOVE B,[1,,.FBBBT] ;GET WORD WITH REQUEST BIT
MOVEI C,C
GTFDB ;GET IT NOW
ERJMP CANAR3 ;SKIP THIS ONE
TXNN C,AR%RAR ;REQUESTED?
JRST CANAR3 ;NO, SKIP THIS FILE
HRRZ A,@INIFH1 ;GET THE JFN WITH NO BITS
MOVE B,[1,,.FBCTL] ;GET FDB FLAG WORD
MOVEI C,C
GTFDB ;GET IT NOW
ERJMP CANAR3 ;SKIP THIS ONE
TXNE C,FB%ARC ;DOES THE FILE CURRENTLY HAVE ARCHIVE STATUS?
;EG, HAS COLLECTION RUN-1 ALREADY STARTED?
JRST [TYPE <?File has archive status: >
CALL TYPIF ;DISPLAY OFFENDING FILE
TYPE <
>
JRST CANAR3] ;TRY FOR NEXT FILE
CALL TYPIF ;TYPE NAME OF FILE
CALL MFINP ;GET A SECOND JFN
JRST [ETYPE < %?
>
JRST CANAR2] ;FAILED FOR SOME REASON
MOVEI B,.ARRAR ;REQUEST ARCHIVE
MOVEI C,.ARCLR ;CLEAR THE REQUEST
ARCF
ERJMP [ETYPE < %?
>
JRST CANAR2]
HRLI A,.FBCTL
MOVX B,FB%INV
SETZ C, ;MAKE FILE VISIBLE AGAIN
CHFDB
ERJMP [ETYPE < %?
>
JRST .+1] ;SAY OK IF JUST MAKING VISIBLE FAILED
CALL TYPOK
CANAR2: SKIPE INIFH1
JRST CANAR1
RET
CANAR3: CALL GNFIL ;ADVANCE TO NEXT GUY
SETZM INIFH1 ;NONE LEFT
JRST CANAR2 ;AND GO ON
;END-ACCESS (DIRECTORY) <NAME> --
.ENDAC::TLO Z,F2+F3 ;F2 MEANS ACCESS OR END-ACCESS, F3 MEANS END-ACCESS
JRST CONNX ;JOIN COMMON CODE
;ACCESS (DIRECTORY) <NAME> --
.ACCES::TLO Z,F2 ;F2 ON MEANS "ACCESS", OFF MEANS "CONNECT"
TLZ Z,F3 ;F2 MEANS ACCESS
JRST CONNX ;JOIN COMMON CODE
;CONNECT (TO DIRECTORY) <NAME> --
IFN NICSW,< ;[NIC1003]
.BACK:: TXO Z,F4 ;[NIC1003] On means back-connect
JRST CONNX ;[NIC1003]
LAZCON::MOVEI C,..CD ;[NIC1055] Fake up the COMAND word to
MOVEM C,COMAND ;[NIC1055] point to "connect" ...
MOVE C,B ;[NIC1035] MOVE DIRECTORY NUMBER TO RIGHT PLACE
TXO Z,F1 ;[NIC1035] TURN ON LAZY COMMAND
>;IFN NICSW
.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
IFN NICSW,<
TXZE Z,F1 ;[NIC1035] WAS THIS LAZY?
JRST CONN0 ;[NIC1035] YES, ALREADY HAVE DIRECTORY
TXNE Z,F4 ;[NIC1003]
JRST [NOISE <TO PREVIOUS DIRECTORY> ;[NIC1003]
SKIPE C,LSTCON ;[NIC1003] RESTORE DIRECTORY # IF WE HAVE ONE
JRST CONN0 ;[NIC1003] DO THE WORK
GJINF ;[NIC1003] IF WE HAVE NO LSTCON...
MOVE C,B ;[NIC1003] ...USE CONNECTED DIRECTORY INSTEAD
JRST CONN0] ;[NIC1003] DO THE WORK
>;IFN NICSW
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>
CONN0: ;[NIC1003]
MOVEM C,ACDNUM ;REMEMBER DIRECTORY NUMBER
CONFIRM
TLNE Z,F2 ;CONNECT?
JRST NOCONN ;NO, SO NO OVER QUOTA REPORTING
.CONN0: GJINF ;[NIC1003] 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
IFN NICSW,< ;[NIC1003]
MOVE A,OLDCON ;[NIC1003] Save permanently
MOVEM A,LSTCON ;[NIC1003] last connected directory
TXNE Z,F4 ;[NIC1003] If a back-connect
ETYPE <%G%%_> ;[NIC1003] show where we are now.
>;IFN NICSW
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
IFE NICSW,<
SETOB B,C ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT
ODTIM
>;IFE NICSW
IFN NICSW,< ;[NIC1020] USE DIFFERENT TIME FORMAT
SETO B, ;[NIC1020] OUTPUT
MOVSI C,(OT%DAY+OT%FDY+OT%FMN+OT%4YR+OT%DAM+OT%SPA+OT%12H+OT%TMZ+OT%SCL)
ODTIM ;[NIC1020] A BETTER FORMAT
MOVSI C,(OT%NDA) ;[NIC1020] BUT NO DATE
TYPE < (> ;[NIC1020] OLD TIME IN PARENS
ODTIM ;[NIC1020] BUT NO DATE
TYPE <)> ;[NIC1020]
>;IFN NICSW
ETYPE <%_>
RET
;DELETE <FILE GROUP>
.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN>
TRO Z,F4
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: SKIPE A,DELDIR ;GET CURRENT DIRECTORY NUMBER - ANY?
TLNN Z,F2 ;OR EXPUNGE REQUESTED?
RET ;NO - NO NEED TO SAY ANYTHING ABOUT FREE PAGES
JUMPN Q2,PDLFR2 ;JUMP IF MULTIPLE DIRECTORY DEVICE
SETZ A, ;ELSE SAY NO PAGES FREED
PDLFR1: MOVE C,DELDIR ;TELL TYPFRE WHICH DIRECTORY TO PRINT
CALLRET TYPFRE ;PRINT RESULTS
PDLFR2: GTDAL% ;CHECK ALLOCATION:
MOVE A,DELPGS ;GET ORIGINAL ALLOCATION
SUB A,B ;TAKE DIFFERENCE
JUMPGE A,PDLFR1 ;CONTINUE IF THERE'S A DIFFERENCE
RET ;ELSE JUST RETURN
;DELINI TAKES DIRECTORY NUMBER IN A AND INITIALIZES DATA TO WORK ON THAT
;DIRECTORY
DELINI: MOVEM A,NEWDIR ;SET NEW DIRECTORY WE'RE WORKING ON
CAMN A,DELDIR ;IS NEW ONE THE SAME AS THE OLD ONE?
RET ;YES, SO DON'T RESET COUNTS OR TRY TO PRINT
SKIPE DELDIR ;WAS THERE A PREVIOUS DIRECTORY?
CALL PDLFRE ;YES, PRINT ITS RESULTS
MOVE A,NEWDIR ;SET UP NEW ONE AS CURRENT
MOVEM A,DELDIR ;REMEMBER DIRECTORY NUMBER
CAIE Q2,0 ;DON'T GET ALLOCATION FOR NON-DIRECTORY DEVICE
GTDAL ;GET ALLOCATION
MOVEM B,DELPGS ;SAVE PAGES IN USE
RET
;GETDNM DECIDES WHAT DIRECTORY NUMBER WE'RE WORKING ON
GETDNM: HRRZ A,@INIFH1 ;GET JFN
SETOM Q2 ;ASSUME MULTIPLE DIRECTORY DEVICE
CALL DIRQ ;SKIP IF DIRECTORY DEVICE
MOVEI Q2,0 ;NOT A MULTIPLE DIRECTORY DEVICE
JUMPE Q2,R ;SKIP DIRECTORY NAME STUFF IF NOT MULTIPLE DIRECTORY DEVICE
HRRZ B,@INIFH1 ;JFN TO B
LDF C,1B2+1B5+JS%PAF ;GET PUNCTUATED STRUCTURE AND DIRECTORY
HRROI A,DELBUF ;WHERE TO PUT IT
JFNS
MOVSI A,(RC%EMO) ;LITERAL MATCH
HRROI B,DELBUF ;STRING
RCDIR ;GET DIR #
HRROI B,DELBUF ;FOR ERROR MESSAGE
TLNE A,(RC%AMB+RC%NOM)
ERROR <No such directory - %2M>
MOVE A,C ;RETURN DIRECTORY NUMBER IN A
RET
;DIRQ SKIPS IFF THE CURRENT JFN IS A MULTIPLE DIRECTORY DEVICE
DIRQ: HRRZ A,@INIFH1 ;GET RID OF FLAGS
DVCHR ;GET DEVICE CHARACTERISTICS
ERCAL JERR ;UNEXPECTED FAILURE
TXNE B,DV%MDD ;SKIP IF NON-DIRECTORY DEVICE
RETSKP ;WE'LL SKIP, BECAUSE IT'S A DIRECTORY DEVICE
RET
$DELET: TABLE
T ARCHIVE,,..ARCH
T CONTENTS-ONLY,,.CNOLY
T DIRECTORY,,..DIR
T EXPUNGE,,..EXP
T FORGET,,..FORG
T KEEP,,..KEEP
TEND
..ARCH: NOISE <FILES INCLUDED>
CONFIRM
TLO Z,F5
RET
.CNOLY: CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
TRO Z,1B18
RET
..EXP: NOISE <AFTER DELETING>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TLO Z,F2 ;FLAG EXPUNGE
RET
..FORG: NOISE <WITHOUT DEASSIGNING DISK ADDRESSES>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "FORGET" at the same time>
MOVX B,WHLU+OPRU
CALL PRVCK
ERROR <WHEEL or OPERATOR capability required>
TLO Z,F3
RET
..KEEP: DEFX <1> ;DEFAULT IS "1"
DECX <Number of generations>
CMERRX ;NO DECIMAL NUMBER SUPPLIED
CAIN B,1
NOISE <GENERATION>
CAIE B,1
NOISE <GENERATIONS>
CONFIRM
SKIPN B
ERROR <Number of generations may not be 0>
TLNE Z,F3
ERROR <Can't "KEEP" and "FORGET" at the same time>
TLNE Z,F2
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TRNE Z,1B18
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
MOVEM B,KEPNUM
RET
..DIR: NOISE <AND "FORGET" FILE SPACE>
CONFIRM
MOVX B,WHLU+OPRU
CALL PRVCK ;MUST HAVE PRIVS FOR THIS FCN
ERROR <WHEEL or OPERATOR capability required>
SKIPN KEPNUM
TLZE Z,F2!F3
TYPE <% KEEP or EXPUNGE or FORGET subcommand ignored>
SETZM KEPNUM ;ZERO THIS
TLO Z,F4 ;SET FLAG FOR ZAP DIRECTORY
RET
;PRUNE NUMBER OF GENERATIONS
;SOME BUFFER DEFINITIONS
VERBUF==BUF0 ;PUT TABLE AT BUF0
VRTBLN==<BUFL-BUF0>/2 ;USE 1/2 THE SPACE FOR STRING POINTERS,
;THE OTHER 1/2 FOR STRINGS
VERSTR==VERBUF+VRTBLN ;START OF STRING SPACE
VEREND==BUFL+1000-5 ;5 WORDS FOR OVERFLOW
KEEPDL: CALL RLJFNS ;RELEASE ANY TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX TERMS
JRST KEEPDE ;END CHECK
HRROI A,DELBUF ;GET POINTER TO STRING BUFFER
HRRZ B,@INIFH1 ;GET JFN
LDF C,2B2+2B5+1B8+1B11+1B35 ;DEV, DIR, NAME, EXT
JFNS ;SAVE NAME OF FILE
ERCAL JERRE
MOVE A,[POINT 7,VERSTR] ;INIT POINTER TO VERSION STRING SPACE
MOVEM A,KEPJNM ;SAVE HERE
MOVSI Q1,-VRTBLN ;AOBJN PTR TO VER STRING PTR TABLE
LDF D,1B14+1B35 ;GENERATION + PUNCTUATION
KEEPD1: MOVE A,KEPJNM ;GET VERSION POINTER
TLNE Z,F5 ;ALLOWED TO DELETE ARCHIVE STUFF?
JRST KEEPD8 ;YES, BYPASS CHECKS
HRRZ A,@INIFH1 ;GET CURRENT JFN
MOVE B,[1,,.FBCTL] ;GET CONTROL BITS
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,FB%ARC ;NOT DELETABLE?
JRST KEEPD9 ;NO, PASS OVER IT
HRRZ A,@INIFH1
MOVE B,[1,,.FBBK0]
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,AR%RAR ;REQUESTED ARCHIVE?
JRST KEEPD9 ;YES, PASS OVER IT
KEEPD8: MOVE A,KEPJNM ;GET VERSION POINTER
HRRZ B,A
CAIL B,VEREND ;BUFFER SPACE FULL?
JRST KEEPOV ;YES
MOVEM A,VERBUF(Q1) ;SAVE IN TABLE
HRRZ B,@INIFH1
MOVE C,D ;GET DISPOSITION
JFNS ;INTO VERSION STRING SPACE
ERCAL JERRE
SETZ C,
IDPB C,A ;TERMINATE STRING
MOVEM A,KEPJNM ;STORE UPDATED STRING POINTER
KEEPD9: MOVE A,@INIFH1
TLNE A,770000 ;SKIP GNJFN IF NO STARS
GNJFN
JRST KEEPD3
TLNE A,(1B14+1B15+1B16) ;DIR, NAME, EXT CHANGED?
JRST KEEPD2 ;YES, FINISH THIS FILE
JUMPN C,KEEPD1 ;IF NONE FOUND
LDF D,1B14 ;GENERATION WITHOUT PUNCT.
AOBJN Q1,KEEPD1 ;INCREMENT VERSION PTR AND LOOP BACK
KEEPOV: TYPE <%Too many generations for internal storage, will not print generations
>
CALL KEEPPN ;PRINT NAME
CALL KEEPDO ;DO DELETE (RETURNS # DELETED IN A)
SKIPL A
ETYPE < [%1Q generations deleted]
>
MOVE A,@INIFH1
TLNE A,770000
KEEPD4: GNJFN
JRST [ AOS A,INIFH1
CAMLE A,INIFH2 ;OFF END?
SETZM INIFH1 ;YES, INDICATE SUCH
JRST KEEPDE]
TLNN A,(1B14+1B15+1B16)
JRST KEEPD4
JRST KEEPDE
KEEPD3: AOS A,INIFH1
CAMLE A,INIFH2
SETZM INIFH1
KEEPD2: MOVEI A,1(Q1) ;GET NUMBER OF VERSIONS
SUB A,KEPNUM ;GET NUMBER TO DELETE
JUMPLE A,KEEPDE ;JUMP IF NONE
CALL KEEPPN ;PRINT NAME
MOVNI A,1(Q1) ;GET -NUMBER OF VERSIONS
ADD A,KEPNUM ;GET NUMBER TO DELETE
HRLZ Q1,A ;MAKE AOBJN PTR
KEEPD5: MOVE A,VERBUF(Q1)
ETYPE <%1M>
AOBJN Q1,[PRINT "," ;PRINT THEM ALL
JRST KEEPD5]
CALL KEEPDO ;DO DELNF
JUMPL A,KEEPDE ;ERROR?
CALL TYPOK ;TYPE [OK]
KEEPDE: SKIPE INIFH1
JRST KEEPDL
JRST DTDEL2
KEEPPN: PRINT " "
HRROI A,DELBUF ;GET NAME POINTER
ETYPE <%1M> ;TYPE IT
RET
KEEPDO: MOVSI A,(GJ%OLD+GJ%PHY+GJ%SHT)
HRROI B,DELBUF ;GET FILE VERSION 0 (HIGHEST)
CALL GTJFS ;GET AND STACK JFN
JRST KEEPE1 ;GTJFN FAILED
MOVE B,KEPNUM ;NUMBER TO KEEP
TLNE Z,F5 ;ARCHIVE ALLOWED?
TXO A,DF%ARC ;YES, SAY SO.
DELNF
JRST KEEPE2
MOVE A,B ;RETURN NUMBER IN A
RET
KEEPE2: TYPE < >
CAIA
KEEPE1: TYPE < GTJFN failure for highest generation
?>
CALL $ERSTR
TYPE <
>
SETO A,
RET
;DISCARD (TAPE INFORMATION FOR FILES) <FILES>
.DISCA::NOISE <TAPE INFORMATION FOR FILES>
TRO Z,F2 ;SET THE FLAG
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRRZI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;NO SUBCOMMANDS
CALL SPECFN
JRST CERR ;DON'T ALLOW "STUFF,"
SETOM TYPGRP ;ALWAYS TYPE THE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;WHERE OUTPUT GOES
MOVE A,JBUFP
MOVEM A,.JBUFP
DISCA1: CALL RLJFNS ;RELEASE STRAY JFN'S
CALL NXFILE ;STEP TO NEXT FILE IN GROUP
JRST DISCA2 ;NO MORE IN THIS GROUP
CALL TYPIF ;DO NAME
CALL MFINP ;GET A SECOND JFN
JRST DISCA2 ;FAILED?
MOVX B,.ARDIS ;FUNCTION CODE FOR THE DISCARD
MOVX C,AR%CR1+AR%CR2 ;DO BOTH TAPES
ARCF
ERJMP DISCA9 ;FAILED...
CALL TYPOK ;TELL THE USER IT'S DONE
DISCA2: SKIPE INIFH1 ;DONE THEM ALL?
JRST DISCA1 ;NO, CONTINUE THE PROCESS
RET
DISCA9: ETYPE < %?
>
JRST DISCA2
;EXPUNGE (ALL DELETED FILES)
.EXPUN::TRVAR <EXPNST,EXPNFL,EXPDIR,OLDALC>
GJINF
MOVEM B,EXPDIR ;DEFAULT IS CONNECTED DIR
NOISE <DIRECTORY>
CALL CURNMS ;READ DIRECTORY NAME ALLOWING STARS
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
IFE STANSW,<
MOVEI A,[EXP 1B<3*8+2>,0,0,0] ;ONLY BREAK ON ^Z
>;IFE STANSW
IFN STANSW,<
MOVEI A,[EXP 1B12+1B<3*8+2>,0,0,0] ;BREAK ON ^Z AND ^L
>;IFN STANSW
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
IFE STANSW,<
MOVE A,.RDFLG+CMTXTB ;GET RESULTS
TXNE A,RD%BTM ;^Z TYPED YET?
JRST UNMAP ;YES, CLEAN UP AND RETURN
>;IFE STANSW
IFN STANSW,<
LDB A,.RDDBP+CMTXTB ;GET POINTER TO LAST CHAR TYPED
CAIN A,.CHCNZ ;CTRL-Z?
JRST UNMAP ;YES, CLEAN UP AND RETURN
CAIN A,.CHFFD ;CTRL-L?
CALL BLANK1 ;YES, BLANK THE SCREEN
>;IFN STANSW
JRST COM1 ;NOT YET, READ MORE
.CLOSE::NOISE <JFN>
CRRX <Octal JFN number or blank for all>
CAIA ;NOT JUST "CLOSE<CR>"
JRST SHUT
OCTX <Octal JFN number> ;SEE IF OCTAL NUMBER
CMERRX ;NOT OCTAL NUMBER EITHER!
CONFIRM
PUSH P,B ;SAVE THE JFN
CALL CLOPAT ;GO UNMAP THE FILES IF PA1050 THERE
POP P,A ;PUT JFN IN A
CAIG A,MAXJFN ;ERROR IF THE JFN IS NOT WITHIN BOUNDS
SKIPG A
ERROR <Illegal JFN number>
CALL JFNREL
ERROR <JFN not in use>
RET
;ENTER HERE WITH JFN TO RELEASE IN A
JFNREL: TDZA D,D ;NO SPECIAL BITS
JFNRLA::LDF D,CZ%ABT ;CLOSE WITH ABORT
HRRZ A,A ;CLEAR LHS
GTSTS
TXNN B,GS%NAM ;ANYTHING IN THIS JFN?
RET ;NO, RETURN
ETYPE < %1P %1S > ;TYPE JFN AND NAME
CAIN A,.PRIIN ;PRIMARY INPUT?
JRST NRLPRI ;YES
CAIN A,.PRIOU ;PRIMARY OUTPUT?
JRST NRLPRO
CALL NOTIO ;MAKE SURE JFN ISN'T BEING USED FOR EXEC COMMAND INPUT OR OUTPUT
JRST NRLEX ;NAUGHTY, NAUGHTY, TRYING TO CLOSE COMMAND JFN!
TXNN B,GS%OPN ;OPEN?
JRST [ RLJFN
JRST JFNER1
JRST JFNOK1]
HLL A,D ;USE BITS IN D
CLOSF
JRST JFNER2
JFNOK1: GTSTS
TXNE B,GS%NAM ;NAME STILL THERE?
JRST JFNOK2
TYPE < [OK]
>
RETSKP
NRLPRI: TYPE < Primary input not closed
>
RETSKP
NRLPRO: TYPE < Primary output not closed
>
RETSKP
;USER TRIED TO CLOSE COMMAND JFN. SEE WHETHER INPUT OR OUTPUT TO
;GIVE FANCY MESSAGE.
NRLEX: TXNE B,GS%WRF ;OPEN FOR WRITE?
JRST NRLEXO ;YES, ASSUME OUTPUT JFN
JRST NRLEXI ;NO, ASSUME INPUT
NRLEXI: TYPE < EXEC command input not closed
>
RETSKP
NRLEXO: TYPE < EXEC command output not closed
>
RETSKP
JFNOK2: TXNE B,GS%OPN
TYPE < Can't close file
>
TXNN B,GS%OPN
TYPE < Can't release JFN
>
RETSKP
JFNER1: TYPE < Can't release JFN - >
CAIA
JFNER2: TYPE < Can't close file - >
CALL $ERSTR ;PRINT ERROR IN A
ETYPE <%_>
RETSKP
SHUT: CALL CLOPAT ;GO UNMAP THE PA1050 OPEN FILES
MOVEI A,MAXJFN ;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1: PUSH P,A
CALL JFNREL ;RELEASE JFN
JFCL ;IGNORE NOTHING THERE
POP P,A
SOJG A,SHUT1
RET
;ADVISE (TERMINAL/USER)
.ADVIS::TLO Z,F2 ;FLAG ADVISE
NOISE <USER>
JRST LINK0
.JILEN==.JILNO+1 ;ROOM FOR ALL JOB INFO WE MAY NEED
;TALK (TERMINAL/USER)
.TALK:: TLZ Z,F2
NOISE <TO>
LINK0: TRVAR <DOLNKF,<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVJNM,DIRNO>
MOVEM P,TFRAME ;SAVE BEGINNING OF POSSIBITITES
USERX <User name or terminal number>
JRST LTTY ;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
CONFIRM
MOVEM B,DIRNO ;SAVE USER NUMBER
TLZ Z,F1 ;NO DETACHED JOBS SEEN YET
MOVEM P,TFRAME ;SAVE BEG OF ARGS
HLLZ D,JOBRT ;MAKE AOBJN PTR
LINK3: MOVEI B,(D) ;GET JOB NUMBER BY ITSELF
CAME B,JOBNO ;LOOKING AT MY OWN JOB?
SKIPN B ;OR JOB 0?
JRST LINK6 ;YES, SKIP IT
CALL USERNO ;GET USER NUMBER
CAME A,DIRNO
JRST LINK6 ;WRONG GUY
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LINK6 ;AND SKIP IT IF DETACHED
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
GTB .JOBPN ;GET PROGRAM NAME
PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6: AOBJN D,LINK3 ;MAY HAVE MORE JOBS
CAMN P,TFRAME ;FOUND ANY?
JRST [ TLNE Z,F1
ERROR <User has detached jobs only
Send mail to the user instead>
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 the user instead>]
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, Send mail to the user instead>
RET
;CODE TO GIVE ADVISE - CHECK TERMINAL PRINT JOB INFO
ADVISE: MOVEM A,ADVTNM
MOVX B,WHLU!OPRU
CALL PRVCK
CAIA
JRST ADVIS1 ;SKIP CHECK IF PRIVILEGED
TRO A,.TTDES
RFMOD
ERJMP [CALL TX1SKP ;FAILED, SEE IF FOR LINE NOT ACTIVE
CALL JERRE ;STRANGE ERROR, REPORT IT
JRST ADVIS1] ;NOTHING ON LINE, THAT'S O.K.
TRNN B,TT%AAD
ERROR <Destination not receiving advice>
ADVIS1: SETO D,
GTB .TTYJO
MOVNS A,A
CAMGE A,ADVTNM
ERROR <Illegal terminal number>
MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JITNO
GETJI
CALL JERR
CAMN C,ADVTNM
ERROR <Cannot advise self>
TYPE < Escape character is <CTRL>E, type <CTRL>^? for help
>
MOVE D,ADVTNM
GTB .TTYJO
HLRZ B,A
CAIN B,-1
JRST [ TYPE < No job on terminal.
>
JRST CONNECT]
CAIN B,-2
JRST [ TYPE < Terminal being assigned.
>
JRST CONNECT]
TRZE B,400000
TYPE < Not controlling terminal.
>
MOVEM B,ADVJNM
PRINT " "
MOVE A,ADVJNM
MOVEI B,JIBUF ;GET ADDRESS OF BUFFER
HRLI B,-.JILEN ;SPECIFY LENGTH
MOVEI C,0
GETJI
CALL JERR
SKIPN B,.JIUNO+JIBUF
JRST [ TYPE <Not logged in>
JRST NOLOGD]
ETYPE <%2R>
NOLOGD: MOVE B,.JIDNO+JIBUF
CAMN B,.JILNO+JIBUF
JRST NOCOND
UETYPE [ASCIZ /, %2R/]
NOCOND: MOVE B,ADVJNM
ETYPE < Job %2Q>
PRINT " "
SKIPN A,.JIPNM+JIBUF
MOVE A,.JISNM+JIBUF
CALL SIXPRT
ETYPE <%_>
;CODE TO GIVE ADVISE - MAKE CONNECTION, LOOP SENDING CHARACTERS
CONNEC: SETOM DOLNKF ;SAY TLINK NEEDED
MOVE B,ADVTNM ;GET TERMINAL NUMBER
TRO B,.TTDES ;SET UP TERMINAL NUMBER FOR STI
MOVEM B,ADVTNM
CALL CHKLNK ;TRY TO ESTABLISH LINK FIRST
MOVEI A,.FHSLF
RPCAP
MOVEI A,.FHJOB
MOVX B,1B<ADVESC> ;ONLY THE ADVICE ESCAPE CHARACTER DOESN'T GET SENT TO THE REMOTE JOB
TXNE C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
STIW
MOVE A,[ADVESC,,^D24] ;CONTROL-E IS USED TO GET OUT
ATI
SETOM ADVFLG ;FLAG IN ADVISE CODE
TLZ Z,F3 ;NOT IN COMMENT NOW
LDF A,GJ%SHT ;SHORT FORM GTJFN
HRROI B,[ASCIZ /TTY:/] ;WE NEED BINARY CHANNEL. THIS IS SO
;IF THINGS LIKE "TER RA" OR "TER NO RA"
;ARE "SENT" TO REMOTE JOB, THEY HAVE
;EFFECT
CALL GTJFS ;GET HANDLE ON TTY FOR BINARY COMMUNICATION
CALL CJERRE ;FAILURE, PRINT ERROR AND RETURN
MOVE B,[100000,,OF%RD] ;OPEN THE JFN FOR READ
OPENF
ERCAL CJERRE ;FAILED
MOVEM A,ADVJFN ;REMEMBER THE ADVISE JFN
MOVEI A,.CTTRM ;CONTROLLING TERMINAL
RFMOD ;GET CURRENT SETTING OF PAGE MODE
MOVE C,B ;GET A COPY OF IT
ANDX C,TT%PGM ;KEEP ONLY PAGE MODE
MOVEM C,SAVPGM ;REMEMBER CORRECT SETTING
TXZ B,TT%PGM ;TURN OFF PAGING SO WE CAN SEND CTRL/Q TO REMOTE TERMINAL
STPAR
ADVLOP: MOVE A,ADVJFN
TLNE Z,F3 ;COMMENT?
MOVE A,CIJFN ;YES, USE REGULAR ECHOING TTY CHANNEL
BIN
MOVE C,B ;PUT CHARACTER IN C
ANDI C,177 ;STRIP TO 7 BITS FOR IDENTIFICATION
CAIN C,"^"-100 ;^^ ?
JRST SNCTRL ;YES, SEND CONTROL CODE
ADVLP1: TLNE Z,F3 ;COMMENT?
JRST ADVLOP ;YES, DON'T SEND CHAR
MOVE A,ADVTNM
STI
ERJMP [SKIPL DOLNKF ;HAVE WE SUCCESSFULLY LINKED YET?
JRST ILISTI ;YES, SO ANALYZE ERROR
PRINT .CHBEL ;NO, SO ECHO A BELL TO TYPIST
JRST .+1] ;GO WAIT FOR TLINK TO SUCCEED (WAIT FOR USER TO TYPE ^C)
ADVLP2: CALL CHKLNK ;SEE IF TLINK NEEDED (MAYBE OTHER JOB WENT AWAY, WHICH BREAKS LINK)
JRST ADVLOP ;GO GET NEXT CHARACTER
;TX1SKP sees if the last error was due to line being not active.
;
;Returns+1: other error
; +2: TTYX01 was last error
TX1SKP: CALL DGETER ;GET REASON
CAIE A,TTYX01 ;IS LINE NOT ACTIVE?
RET ;OTHER ERROR
RETSKP ;LINE IS NOT ACTIVE
;CHKLNK ATTEMPTS TO ESTABLISH LINKS IF THEY'RE NOT ALREADY ESTABLISHED.
CHKLNK: MOVE B,ADVTNM
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERJMP [CALL TX1SKP ;TLINK FAILED, SEE IF BECAUSE LINE NOT ACTIVE
JRST CJERRE ;OTHER FAILURE, TELL USER WHAT IT IS
JRST CONN1] ;LINE NOT ACTIVE, DON'T CLEAR FLAG YET
AOSN DOLNKF ;GIVE ANNOUNCEMENT FIRST TIME
TYPE < [Advising]
>
CONN1: RET
ILISTI: SETOM DOLNKF ;REMEMBER TO RETRY LINK IF WE RECOVER
CALL %GETER
MOVE A,ERCOD
CAIN A,IOX33 ;INPUT BUFFER IS FULL?
JRST ADVLP2 ;RIGHT, ASSUME USER HEARD BELL
CAIN A,TTYX01 ;LINE BECAME INACTIVE AND USER ISN'T A WHEEL?
JRST IS1 ;WHAT A CROCK, STI SHOULD BE FIXED IN MONITOR
;TO MERELY WORK ON INACTIVE LINE. ^C SHOULD
;START JOB, AND OTHER CHARACTERS SHOULD BEEP
;JUST AS THOUGH REAL TYPIST WERE THERE.
CAIE A,DEVX2
CAIN A,DESX2
CAIA
JRST CJERR
IS1: TYPE <
[Destination refused advice]
>
JRST ADVDON
SNCTRL: BIN
MOVE C,B ;GET 7-BIT VERSION OF CHARACTER
ANDI C,177
CAIN C,"("
JRST STCOMM
CAIN C,")"
JRST ENCOMM
CAIN C,"+"
JRST RELINK
CAIN C,"?"
JRST TYPADV
CAIL C,141
CAILE C,172
CAIA ;NOT LOWER CASE LETTER
TRZ B,40 ;LOWER CASE, MAKE UPPER CASE
TRZ B,300 ;MAKE INTO A CONTROL (A BECOMES CTRL/A ETC.)
JRST ADVLP1
;START COMMENT
STCOMM: TYPE <^^(> ;ECHO CHARACTER HE TYPED
TLO Z,F3 ;FLAG NOT TO SEND CHARS
JRST ADVLOP
;END COMMENT
ENCOMM: TLZ Z,F3 ;FLAG TO SEND CHARS AGAIN
JRST ADVLOP
TYPADV: UTYPE [ASCIZ /
CMND EFFECT
---- ------
<CTRL>E Quit
<CTRL>^+ Relink to remote terminal
<CTRL>^( Start comment
<CTRL>^) End comment
<CTRL>^? Type this list
<CTRL>^<CHAR> Send <CTRL><CHAR>
/]
JRST ADVLOP
RELINK: MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
MOVE B,ADVTNM
TLINK ;PUT HIS OUTPUT ON OUR TERMINAL
JRST [ TYPE <
TLINK failure
>
JRST ADVLOP]
TYPE < [Advising]
>
JRST ADVLOP
ESCPSI::SKIPN ADVFLG
DEBRK ;JUST IN CASE
ADVDON: CALL ICLEAR ;DISMISS INTERRUPT TO .+1
CALL DOATI ;FIX ^C AND ^E (DO HERE SO ^C WORKS IF REMOTE IS XOFFED)
CALL FIXON ;FIX PAGE MODE
ADVMES::TYPE <
[Advice terminated]
>
MOVEI Q1,ETTYMD
CALL LTTYMD ;RESTORE TTY MODES
MOVE B,ADVTNM ;GET TERMINAL WE WERE ADVISING
CALL BREAK1 ;BREAK LINKS
SETZM ADVFLG
MOVE A,ADVJFN ;GET SPECIAL JFN AGAIN
CLOSF ;RELEASE IT
ERCAL CJERRE ;SHOULDN'T FAIL
JRST ERRET ;ERROR RETURN TO TTY MODES RESET
;"LIST" IS WITH "TYPE" BELOW.
;LOGIN COMMAND
;LOGIN (USER) NAME (ACCOUNT) ACCOUNT (SESSION-REMARK) REMARK
;PASSWORD: PASSWORD
IFN STANSW,<
LAZY:: TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT>
SETZM LERRF
CALL LAZY1
NOP ;IN CASE LOGIN ROUTINE SKIPS
JRST CMDIN4
LAZY1: CALL LAZUSR ;ENTER USER-NAME PARSING CODE
JRST LAZERR
JRST LAZLOG ;ENTER LOGIN CODE
>;IFN STANSW
.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
SETZM FSTLGN ;CLEAR FAST LOGIN FLAG
CALL FSTUSR ;READ USER NAME OR /FAST
IFN STANSW,<
LAZERR:
>;IFN STANSW
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]
IFN STANSW,<
LAZLOG:
>;IFN STANSW
MOVEM A,RCBITS ;SAVE INFO RETURNED BY "RCDIR"
IFN NICSW,< ;[NIC1015] CHECK FOR ANONYMOUS
MOVE B,[POINT 7,ATMBUF] ;[NIC1015] PARSED USERNAME HERE
MOVE A,[POINT 7,[ASCIZ /ANONYMOUS/]] ;[NIC1015] SPECIAL CHECK
STCMP% ;[NIC1015] CHECK FOR THIS USER
CAIE A,0 ;[NIC1047] check for equality
TXNE A,SC%SUB ;[NIC1047] check for initial substring
ERROR <ANONYMOUS logins are reserved for FTP use--please type HELP>
>;IFN NICSW
MOVEM C,LOGNO ;SAVE DIRECTORY NUMBER
CALL NOECHO ;NOISE STUFF WAITS FOR A CHARACTER!
NOISE (PASSWORD)
CALL PASFLD ;READ THE PASSWORD
IFE STANSW,<
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
>;IFE STANSW
IFN STANSW,<
SETZM LACCT ;DEFAULT ACCOUNT
CONFIRM ;CONFIRM THE WHOLE COMMAND
DO.
MOVEM A,LPASP ;REMEMBER POINTER TO PASSWORD
SKIPN LERRF ;IF BAD USER NAME, NEVER PROMPT FOR PASSWORD
CALL CHKPTY ;ALLOW NULL PASSWORD ON PTY'S
EXIT. ;IT IS A PTY.
ILDB A,A ;CHECK FOR NON-NULL
SKIPE A ;IS IT?
EXIT. ; NOT NULL...
CALL PASLIN ;PASSWORD IS NULL, ASK FOR IT AGAIN
LOOP.
ENDDO.
>;IFN STANSW
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN
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
IFN STANSW,<
MOVE A,LOGNO ;LOAD USER NUMBER
MOVE B,LPASP ;THE PASSWORD
CALL ATTNLI ;ASK IF ANY DETACHED JOBS SHOULD BE ATTACHED
>;IFN STANSW
CALL PIOFF ;^C BETWEEN LOGIN AND CUSRNO SETUP WOULD BE EMBARRASING
MOVE C,LACCT ;ACCT # OR PTR THERETO
MOVE B,LPASP ;PASSWORD PTR
MOVE A,LOGNO ;USER #
MOVE D,C ;GET ACCT STRING
ILDB D,D ;LOOK AT FINAL ACCOUNT
SKIPN D ;HAVE ONE?
SETZM C ;NO. USE NOTHING
MOVEI D,0 ;RESERVE D FOR FUTURE FLAGS
LOGIN
JRST [ CAIN A,LGINX1
ERROR <Illegal account>
CAIN A,LGINX4
ERROR <Incorrect password>
CALL CJERRE] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
MOVEI B,LDBLK ;GET THE LOGIN DATA BLOCK
MOVEM A,.CDLLD(B) ;SAVE LOGIN DATE AND TIME IN CASE NON WHEEL
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
IFE NICSW,< ;[NIC1016] DISABLE SU CHARGE LIMIT CODE
IFN STANSW,<
MOVE B,RCBITS ;GET FLAGS FROM RCUSR
TXNE B,CD%MRP ;MUST RUN PROGRAM?
SETOM MRPFLG ;YES. SET APPROPRIATE FLAG
IFXN. B,CD%CLM ;CHARGE-LIMITED USER?
MOVX A,CR%CAP ;RUN CHARGE LIMIT CHECKING PROGRAM
CFORK%
IFNJE. ;LET HIM THROUGH IF CAN'T MAKE A FORK
MOVEI D,(A) ;SAVE FORK HANDLE
MOVX A,<GJ%OLD!GJ%SHT>
HRROI B,[ASCIZ/ACCOUNT:MONEY.EXE/]
GTJFN%
IFNJE.
HRLI A,(D) ;GET PROGRAM INTO FORK
GET%
IFNJE.
MOVEI A,(D) ;GOT IT, START THE FORK
SETZ B, ;AT NORMAL START ADDRESS
SFRKV%
WFORK% ;WAIT FOR ITS TERMINATION
ENDIF.
ENDIF.
MOVEI A,(D)
KFORK%
ENDIF.
ENDIF.
IFN GSBSW,<
;THE SANDY LERNER MEMORIAL ACCESS CROCK FOR GSB-HOW. LOOK IN TTYRES.BIN
;TO FIGURE OUT WHETHER WE SHOULD SET A HIGH OR LOW PRIORITY ACCOUNT STRING
;FOR THIS LUSER. THE ACCOUNT STRING WILL BE USED FOR FILE ACCESS (!) AND
;FOR KEEPING ACCOUNTING INFORMATION (!!). IF RUN ON GSB-WHY, WE WILL
;PROBABLY FAIL AT RESERV. IF NOT, SETTING THE ACCOUNT WON'T HURT.
SETO A, ;FOR THIS TTY
CALL RESERV ;GET THE TTYRES INFORMATION
IFSKP.
MOVE C,A ;SAVE THE RESULT
MOVE A,[5B2+1] ;HIGH PRIORITY USER (COURSE)
TXNE C,1B17 ;LOW PRIORITY WAS SPECIFIED?
MOVE A,[5B2+2] ;YES, USER LOW PRIORITY ACCOUNT (TEXT)
CACCT% ;SET ACCOUNT STRING
ERJMP .+1 ;SOME ERROR, IGNORE IT
ENDIF.
>;IFN GSBSW
>;IFN STANSW
>;IFE NICSW
GJINF ;GET LOGGED-IN DIRECTORY NUMBER
MOVEM B,LIDNO ;SAVE IT.
IFN NICSW,< ;[NIC1003]
MOVEM B,LSTCON ;[NIC1003] SAVE FOR BACK COMMAND
>;IFN NICSW
CALL PION ;ALLOW ^C NOW THAT CUSRNO IS SET UP
IFE STANSW,<
MOVE A,Q1 ;POINTER TO SESSION REMARK
CALL SSR ;SET SESSION-REMARK
>;IFE STANSW
IFN STANSW,<
IFN LOTSW,<
MOVEI A,3 ;ARGUMENT FOR RUNOP1 - THIRD OFFSET INTO EVEC
MOVE B,RCBITS ;FETCH MODE BITS
TXNE B,CD%UPD ;USAGE-UPDATE SET?
CALL RUNOP1 ;YES, GO RUN THE ACCOUNT MAKER
>;IFN LOTSW
>;IFN STANSW
;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>"
IFE STANSW,<
MOVEI A,LDBLK ;GET ADDRESS OF THE DIRECTORY BLOCK
MOVE A,.CDLLD(A) ;GET THE TIME AND DATE OF LAST LOGIN
ETYPE < Job %J on %L %D %E, Last Login %1W
> ;EOL NEEDED BEFORE LOGIN MESSAGE
>;IFE STANSW
IFN STANSW,<
MOVX A,RC%EMO ;REQUIRE EXACT MATCH
SETZ C, ;GET OPERATOR'S USER NUMBER
HRROI B,[ASCIZ/OPERATOR/]
RCUSR%
IFNJE.
CAME C,CUSRNO ;DID WE LOG IN AS OPERATOR
IFSKP.
IFN NICSW,< ;[NIC1016]
MOVEM C,OPERF ;[NIC1024]
>;IFN NICSW ;[NIC1016]
SETOM LGXINI ;TAKE SYSTEM:LOGIN.CMD FIRST
SETOM LOGINI ;TAKE LOGIN.CMD AT NEXT OPPORTUNITY, BUT
SETZM MESMSF ; OTHERWISE BE SILENT
SETZM SYSMF
RET
IFN NICSW,< ;[NIC1016]
ELSE.
SETZM OPERF ;[NIC1024]
>;IFN NICSW
ENDIF.
ENDIF.
ETYPE < Job %J on %L %D %E
> ;EOL NEEDED BEFORE LOGIN MESSAGE
IFE NICSW,< ;[NIC1016]
SKIPE A,LOGDAT ;LAST LOGIN
ETYPE < Previous LOGIN: %1D %E
>
CALL JOBCNT ;PRINT OTHER JOBS LOGGED IN
>;IFE NICSW
IFN NICSW,< ;[NIC1016]
SKIPE OPERF ;[NIC1016] DON'T DO THIS STUFF FOR OPERATOR
JRST NOTOPR ;[NIC1016]
SKIPE A,LOGDAT ;[NIC1016] LAST LOGIN
ETYPE < Previous LOGIN: %1D %E %_> ;[NIC1016]
NOTOPR:
>;IFN NICSW
SKIPN LOGDAT
IFE LOTSW,<
TYPE <
This is your first login. Welcome! The following are system messages of
general interest. Type SPACE to see a message, BACKSPACE to skip a message,
or "Q" to skip reading any messages for now. Type "?" if you need help.
>
>;IFE LOTSW
IFN LOTSW,<
TYPE < This is your first login. Welcome to LOTS.
The following are messages of general interest (only some of
which are relevant to you). Type SPACE to see a message, BACKSPACE
to skip a message, or "Q" to skip reading any messages for now. Type
"?" if you need help.
>
>;IFN LOTSW
>;IFN STANSW
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
;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
IFN STANSW,<
MOVE A,B ;COPY STRING POINTER
STDEV% ;PRECEDED BY DEVICE?
IFNJE.
HRROI A,TAKBUF ;YES, DON'T DO DIRST
JRST TAKEI1 ;(USED TO TAKE SYSTEM:LOGIN/COMAND.CMD)
ENDIF.
>;IFN STANSW
MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
HRROI A,TAKBUF ;GET STRING SPACE POINTER
CAMN B,[-1] ;DEFAULT?
JRST TAKEI1 ;YES, SKIP DIR
DIRST ;STORE DIR STRING
CALL JERR ;WE JUST SCANNED IT?!
TAKEI1: MOVE B,A
MOVE A,SPB
SETZ C, ;READ TO NULL
SIN ;APPEND TO STRING
HRROI B,TAKBUF ;GET POINTER TO BEGINNING
CALL TRYGTL ;TRY TO FIND IT.
JRST TAKIN2 ;NO SUCH FILE, GO AWAY QUIETLY
MOVE B,[70000,,OF%RD]
OPENF
JRST [ HRROI B,TAKBUF ;GET POINTER FOR ERROR MESSAGE
LERROR <Can't read %2M%%_%%1?>
HRRZ A,JBUFP
HRRZ A,(A) ;GET SAVED JFN
RLJFN ;RELEASE IT
CALL JERR
HRRZ A,JBUFP
SETOM (A)
RET]
HRL A,A ;PUT INPUT JFN IN LEFT HALF
HRR A,COJFN ;USE SAME OUTPUT AS WERE USING
MOVE B,TAKDEF ;USE DEFAULT SETTINGS
CALL PUSHIO ;SAVE OLD IO STREAM, START NEW ONE
RETSKP ;DOUBLE RETURN WHEN SUCCESSFUL
TAKIN2: RET ;FAILED, TAKE SINGLE RETURN
;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF P2=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
; MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
; (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
; AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.
;THIS UNWRITTEN ROUTINE SHOULD SOMEHOW ALLOW CARRIAGE RETURN
;IN THE MIDDLE OF COMMANDS, SUCH THAT THE GUIDE WORDS FOR THE NEXT
;FIELD COME OUT ON THE NEW LINE, AS THOUGH THE CR WAS $. BEWARE
;OF THE FOLLOWING PITFALLS OF THIS:
;1) ON REPARSE, GUIDEWORDS ARE ALREADY IN BUFFER, SO SOMEHOW
; REPARSED CR SHOULD DO NOTHING. NOTE THAT REPARSED $ IS
; NONEXISTANT, AS $ CAUSES ACTION BUT DOESN'T STAY IN
; BUFFER. YOU CAN'T AFFORD NOT TO LEAVE CR IN BUFFER,
; BECAUSE ^R AND RUBOUT WON'T WORK CORRECTLY, ESPECIALLY
; ON SCREEN TERMINALS.
;2) IF THE CR PROVOKED GUIDEWORDS ARE IMPLEMENTED AS PROMPTS,
; RUBBING OUT WON'T WORK. USER WILL JUST GET A DING.
;3) MOST DESIRABLY, CR IN THE MIDDLE OF COMMANDS SHOULD WORK
; FOR ALL COMMANDS, NOT JUST SPECIAL ONES LIKE LOGIN,ATTACH.
; THIS CREATES A PROBLEM WITH CASES WHERE A FIELD HAS A
; DEFAULT VALUE. CONSIDER THE AMBIGUITY UPON SEEING
; CR: DOES THE CR MEAN DEFAULT THE FIELD VALUE, OR
; TYPE THE GUIDEWORDS. FOR INSTANCE, SHOULD "DIRECTORY<CR>"
; TYPE "(OF FILES)", OR DEFAULT THE FILE SPEC TO *.* AND
; TAKE OFF?
RET
;USERN
;INPUT USER NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS RCUSR'S RETURNED INFO IN A,B,C.
;SKIPS, BUT NOT IF BAD NAME TYPED, IN WHICH CASE A CONTAINS ERROR CODE
USERN: USERX <User name>
USERNR: JRST [ CALL %GETER ;FAILED, FIND OUT WHY
MOVE A,ERCOD ;RETURN ERROR IN A
RET]
IFN STANSW,<
LAZUSR: ;ENTRY FOR LAZY LOGIN
>;IFN STANSW
REGUSR: 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
;READ USER NAME OR /FAST FOR LOGIN COMMAND
FSTUSR: MOVX A,.SFXEC ;GET EXEC FLAGS WORD
TMON ;GET THE WORD
ERJMP USERN ;.SFXEC PROBABLY NOT IN MONITOR
TXNE B,XC%FST ;ARE FAST LOGINS ALLOWED ?
JRST USERN ;NO. ONLY EXCEPT USER NAME
MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name>,,[
FLDDB. .CMSWI,CM%SDH!CM%DPP,FASTAB,</FAST to get to command level quickly after LOGIN>,<FAST>]]
CALL FLDSKP ;PARSE THIS MESS
JRST [CAIN B,NPXNOM ;GOT A SWITCH OR KEYWORD ERROR ?
CMERRX ;YES. BLOW UP FROM BAD SWITCH
JRST USERNR] ;NO. USER NAME ERROR
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIN C,.CMUSR ;USER NAME ?
JRST REGUSR ;YES - CONVERT TO USER #
SETOM FSTLGN ;FLAG THE FAST LOGIN
NOISE (USER)
CALL USERN ;NOW GET USER NAME
RET ;FAILED
RETSKP
FASTAB: TABLE
[ASCIZ/FAST/],,0
TEND
;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
JRST BUFFF ;STRING CASE. SAVE IN BUFFER.
;PASWD
;SUBROUTINE TO INPUT PASSWORD FOR "LOGIN", "ATTACH", AND "CONNECT".
;HANDLES HALF AND FULL DUPLEX CASES.
;BUFFERS IT FOR USE AS A JSYS ARGUMENT AND RETURNS BYTE PTR IN A.
PASLIN::MOVEI A,[ASCIZ /Password: /]
PASSX:: MOVEI C,1
CALL NOECHO ;PROMPT TYPER LOOKS AT ONE INPUT CHARACTER SO TURN OFF ECHOING FIRST
UPROMPT @A ;TYPE PROMPT
CALL PASWD ;SPR 13716
CONFIRM ;SPR 13716
RET ;SPR 13716
PASFLD::TDZ C,C ;FOR A PASSWORD FIELD, NO CRLF WANTED (IE LOGIN)
PASWD:: CALL NOECHO ;MAKE SURE ECHOING OFF
CALL CHKPTY ;SKIP IF NOT A PTY
JRST PASWDF ;PTY - HANDLE FULL DUPLEX CASE ONLY
MOVE A,CIJFN
RFMOD ;READ TTY MODE
TRNE B,1B32 ;SKIP IF FULL DUPLEX
JRST PASWD1
;FULL DUPLEX CASE
;DON'T ECHO PASSWORD FIELD, DO ECHO TERMINATOR
PASWDF: CALL INPPAS ;INPUT THE PASSWORD
CALL DOECHO ;NOW WE WANT ECHOING ON
CALL GETTER ;GET THE TERMINATING CHARACTER
CAIE A,.CHCRT ;END OF LINE?
CAIN A,.CHLFD
CAIA ;YES
JRST PSWDF1 ;NO
MOVE A,CIJFN ;YES, SEE IF IT GOT ECHOED
RFPOS
TRNE B,-1 ;ARE WE AT COLUMN 1?
ETYPE <%_> ;NO, TYPE A CRLF
PSWDF1: CALLRET BUFFF ;BUFFER PASSWORD AND CHECK IT IF POSSIBLE
;PASWD...
;HALF DUPLEX CASE
;USE SEPARATE LINE, TYPE MASK FIRST
PASWD1: TYPE <
>
UPROMPT [BYTE (7)130,130,130,130,130,130,130,130,130,15
BYTE (7)127,127,127,127,127,127,127,127,127,15
BYTE (7)115,115,115,115,115,115,115,115,115,15
BYTE (7)15,15,0]
;PASSWORD MASK, OVERLAYED X, W, M, AND GARBAGE
CALL INPPAS ;INPUT THE PASSWORD
CALL DOECHO ;MAKE SURE ECHOING IS TURNED ON NOW
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: MOVE Q3,[ASCIZ /PSWD/] ;SET FLAG IN Q3
IFE STANSW,<
WORDX <Password> ;READ NON-NULL PASSWORD
>;IFE STANSW
IFN STANSW,<
LINEX <Password> ;READ NON-NULL PASSWORD
>;IFN STANSW
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
HRLOI B,377777 ;SET INF COUNT FOR US
MOVEM B,MWATN0
MOVE B,CUSRNO ;SET UP FOR MAIL CHECK FOR THIS USER
MOVEM B,MWATDR
CALL MALCHK ;DO MAIL CHECK
JRST MESMS9 ;NO MAIL
TYPE < You have >
TLNN B,77 ;CHECK NETWORK MAIL FLAG
TYPE <net >
ETYPE <mail %1\%%_%>
MOVE A,COJFN
DOBE ;WAIT FOR IT TO REALLY PRINT
GTAD ;SET UP NEXT LOOK TIME
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT
MESMS9: SETZM MESMSF ;CLEAR FLAG SO IT WONT BE REPEATED
RET
;CHKPTY - SKIPS IF NOT RUNNING ON PSEUDO-TELETYPE
CHKPTY::PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SETZ D,
GTB .PTYPA ;GET PSEUDO TTY PARMS
HRRZ D,A ;SAVE FIRST PTY NUMBER
PUSH P,D ;FIRST PTY ON STACK
HLRZ A,A ;NUMBER OF PTY'S
ADDI D,(A) ;LAST PTY NUMBER PLUS ONE
MOVNI A,1
MOVE B,[XWD -1,C] ;1 WORD INTO C
MOVEI C,.JITNO ;READ TERMINAL NUMBER
GETJI
CALL JERR
POP P,A ;RESTORE FIRST PTY NUMBER
CAML C,A ;ARE WE A PTY? (DET IS -1)
CAML C,D
AOS -4(P) ;NO, SKIP
POP P,D
POP P,C
POP P,B
POP P,A
RET
;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS: +1: NO SUCH FILE
; +2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.
TRYGTS::PUSH P,B ;THIS IS CALLED FROM CTRL/E-SPEAK
PUSH P,A
MOVSI A,(GJ%FOU!GJ%SHT!GJ%PHY)
JRST TRYGT1
TRYGTO::PUSH P,B
PUSH P,A
MOVSI A,(GJ%FOU!GJ%SHT)
JRST TRYGT1
TRGTV1::PUSH P,B
PUSH P,A
MOVE A,[GJ%OLD!GJ%SHT+1] ;OLD FILE, SHORT CALL, VERSION 1
JRST TRYGT1
TRYGTL: PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC) ;OLD FILE, SHORT, NO ACCESS
JRST TRYGT1
TRYGTJ::PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY AND SHORT FORM
TRYGT1: CALL GTJFS ;ASSIGN JFN USING STRING POINTER IN B
JRST [ POP P,A ;LOSE, ERROR RETURN
JRST TRYG9]
SUB P,[XWD 1,1] ;FORGET SAVED A
AOS -1(P) ;SKIP
TRYG9: POP P,B
RET
;LOGOUT
.LOGOU::SKIPN CUSRNO ;LOGGED IN?
JRST LOGOU1 ;NO, ONLY ONE CASE
DECX <Carriage return or job number>
JRST LOGOU1 ;NO NUMBER TYPED, LOG OUT THIS JOB
MOVE A,B ;PUT JOB NUMBER IN A
JRST ..LOGO ;GO LOG OUT REMOTE JOB
LOGOU1: CONFIRM
XTND,<
IFN STANSW,<
SKIPE LGOFLG ;INSIDE LOGOUT.CMD?
JRST LOGOU2
SKIPE BATCHF ;SKIP CLEARING SCREEN AND DOWNTIME IF BATCH
IFSKP.
>;IFN STANSW
CALL BLANK1 ;CLEAR SCREEN
CALL DWNPNT ;TELL USER WHEN SYSTEM WILL GO DOWN
IFN STANSW,<
ENDIF.
>;IFN STANSW
>
SKIPN CUSRNO
JRST LOGOU2
IFN STANSW,<
IFE SUMXSW,< ;DON'T DELETE .TMP FILES AT SUMEX
MOVX A,<GJ%OLD!GJ%IFG!GJ%SHT> ;DELETE ALL TMP FILES
HRROI B,[ASCIZ/*.TMP.*/]
GTJFN%
IFNJE.
MOVE C,A ;SAVE INDEXABLE FILE HANDLE
DO.
HRLI A,(DF%NRJ) ;DON'T RELEASE OUR HANDLE
DELF%
ERJMP .+1
MOVE A,C ;GET BACK OUR HANDLE
GNJFN%
IFNJE.
MOVE C,A ;UPDATED HANDLE
LOOP.
ENDIF.
ENDDO.
ENDIF.
>;IFE SUMXSW
CALL JOBCNT ;WARN USER OF OTHER JOBS ON SYSTEM
>;IFN STANSW
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
IFE STANSW,<
JUMPLE B,LOGOU2 ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
LOGOU2:
>;IFE STANSW
IFN STANSW,<
SKIPLE B ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
MOVE Q1,CIJFN
HRROI B,[ASCIZ/LOGOUT.CMD/]
SKIPN BATCHF ;IF BATCH DON'T DO LOGOUT.CMD
CALL TAKEIN ;TRY TO GET THIS FILE GOING
JRST LOGOU2 ;BATCH OR NO FILE
SETOM LGOFLG ;YES, FLAG LOGOUT.CMD IN PROGRESS
RET ;AND GO GET COMMANDS
LOGOU2::
>;IFN STANSW
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"
IFN NICSW,< ;[NIC1000] LABEL TO DIE ON
.KK0::
>;IFN NICSW
SETO A, ;SAY IT'S SUICIDE
LGOUT
IFE STANSW,<
CALL CJERR
;DOESN'T RETURN ON SUCCESS
>;IFE STANSW
IFN STANSW,<
ETYPE < You cannot be logged off. You might be in PHOTO or TELNET or some other
program that does not permit LOGOUTs. Do a POP and try again.>
JRST ERRET ;GO BACK TO COMMAND LOOP
.KK:: CONFIRM
JRST LOGOU2
; COUNT JOBS USER HAS ON SYSTEM
JOBCNT: GJINF ;GET THE JOB INFO.
MOVE Q1,A ;GET USER NUMBER.
HLLZ D,JOBRT ;GET MAX. POSSIBLE JOBS.
CALL JOBCNF ;GET OTHER JOBS.
IFSKP.
MOVEI Q2,0(D) ;GET JOB NUMBER.
MOVE Q3,A
CALL JOBCNN ;SEE IF OTHER JOBS THAN THIS ONE.
IFSKP.
ETYPE <[Jobs %6Q> ;MORE THAN ONE.
SKIPGE Q3 ;DETACHED?
TYPE <(DET)> ;YES.
DO.
MOVEI Q2,0(D) ;GET OTHER JOBS.
ETYPE <, %6Q> ;TYPE OUT.
SKIPGE A ;DETACHED?
TYPE <(DET)> ;YES.
CALL JOBCNN ;GET NEXT JOB.
EXIT. ;NO MORE.
LOOP.
ENDDO.
ELSE.
ETYPE <[Job %6Q> ;ONLY ONE JOB.
SKIPGE Q3 ;DETACHED?
TYPE <(DET)> ;YES.
ENDIF.
ETYPE < also logged in under %5R]%_>
ENDIF.
RET
JOBCNF: CALL USERNO
CAMN Q1,A ;IS THIS ONE HIS?
CAIN C,0(D) ;ANY MORE?
JOBCNN: AOBJN D,JOBCNF ;SEARCH MORE SLOTS.
IFL. D ;IF THERE ARE MORE...
GTB .JOBTT ;GET WHETHER DETACHED OR NOT.
AOS 0(P) ;SKIP RETURN
ENDIF.
RET
;ATTNLI - Ask during LOGIN if detached jobs should be attached instead
;Original code from from the Columbia University EXEC, heavily modified.
;Takes A/ user number
; B/ password pointer
;Returns +1, if at all
ATTNLI: ATSAVE ;SAVE TEMP VALUES
STKVAR <ATTUSR,ATTPWD,ATTNAM,<ATTBUF,^D50>>
MOVEM A,ATTUSR ;SAVE THE ARGS
MOVEM B,ATTPWD ;...
CALL CHKPTY ;IS THIS JOB A PTY?
RET ;YES... THEN FORGET IT
MOVX A,RC%EMO ;WANT AN EXACT MATCH
HRROI B,[ASCIZ/OPERATOR/] ;WANT OPERATOR'S USER NUMBER
RCUSR% ;GET IT
TXNN A,RC%NOM+RC%AMB ;SUCCESS?
CAMN C,ATTUSR ;IS THIS THE OPERATOR ASKING?
RET ;RCUSR% FAILED OR USER IS OPERATOR, JUST QUIT
SETO D, ;WANT LENGTH OF JOBRT TABLE
GTB .JOBRT ;JOBRT TABLE BY JOB #, LOGIN DIR # IN RH.
HRLZ D,A ;SET UP XWD LENGTH, INDEX FOR AOBJN & GTB.
ATTNL0: CALL USERNO ;GET USERNUMBER OF JOB IN D
CAME A,ATTUSR ;IS THIS THE CORRECT USER?
JRST ATTNL1 ;NO, GO LOOK AT NEXT JOB
GTB .JOBTT ;YES - GET TTY WORD
JUMPGE A,ATTNL1 ;JUMP IF ATTACHED
MOVEI A,ATTBUF ;SET UP BUFFER FOR PROMPT STRING
HRLI A,(POINT 7,) ;MAKE IT A POINTER
MOVEM A,COJFN ;SAVE "JFN"
MOVEI A,(D) ;JOB NUMBER
HRROI B,ATTNAM ;WANT JUST ONE WORD
MOVEI C,.JIPNM ;WANT THE PROGRAM NAME
GETJI% ;GET IT
SETZM ATTNAM ;FAILURE, SAY NO NAME
MOVE A,ATTUSR ;USER NUMBER TO A
HRRZ C,D ;AND THE JOB NUMBER
SKIPE B,ATTNAM ;PROGRAM NAME TO B
IFSKP.
ETYPE <[Press RETURN to attach to %1R, detached job %3Q]>
ELSE.
ETYPE <[Press RETURN to attach to %1R, detached job %3Q, running %2']>
ENDIF.
CALL FIXIO ;RETURN OUTPUT TO NORMAL PLACE
UPROMPT ATTBUF ;HERE IS THE STRING TO PROMPT WITH
MOVE A,COJFN ;WAIT FOR PROMPT TO FINISH PRINTING
DOBE% ; ...
MOVE A,CIJFN ;FLUSH TYPEAHEAD
CFIBF% ; ...
CRRX <Confirm with carriage return> ;WAIT FOR CONFIRMATION
IFSKP.
HRRZ A,D ;THE JOB NUMBER
MOVE B,ATTUSR ;GET THE USER NUMBER
MOVE C,ATTPWD ;AND THE PASSWORD STRING
ATACH% ;TRY THE ATTACH
ERJMP [ERROR <ATTACH failed - %?>]
ENDIF.
CALL LM ;NOT CONFIRMED, GO TO THE LEFT MARGIN.
MOVE A,CIJFN ;CLEAR TYPEAHEAD AGAIN
CFIBF% ; ...
ATTNL1: AOBJN D,ATTNL0 ;LOOP THROUGH ALL JOBS
RET ;NO MATCHES, LET USER LOGIN
ENDSV. ;PURGE STKVAR SYMBOLS
>;IFN STANSW
;"MERGE" IS WITH "GET" ABOVE.
;'PUSH' = 'PUSH EXEC' (FORMERLY 'EXEC')
;STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'
.PUSH:: NOISE (COMMAND LEVEL)
CONFIRM
HRROI B,[ASCIZ /DEFAULT-EXEC:/]
CALL TRYGTJ ;LOOK FOR THE DEFAULT EXEC; STACK THE JFN
JRST [ HRROI B,[GETSAVE(<SYSTEM:EXEC.>)]
CALL TRYGTJ ;FAILED - JUST GET SYSTEM EXEC
ERROR <EXEC not found>
JRST .+1]
PUSH P,A
MOVSI A,(1B1) ;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,[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 and REFUSE (LINKS/ADVICE/SYSTEM-MESSAGES)
; Can also get here from [SET] TERMINAL [NO] RECEIVE ...
; If so, F1 is on (see .TERNO routine) if the user typed NO.
; If F1 is on, do a REFUSE since the user typed NO RECEIVE.
.RECEI::TLNE Z,F1 ;DID USER SAY "NO RECEIVE" ?
SKIPA ;YES, IMPLIED REFUSE
TLZA Z,F4 ;SAY RECEIVE CMD AND SKIP .REFUS
.REFUS::TLO Z,F4 ;IF REFUSE, SAY SO.
SETZB Q1,Q2 ;ACCUMULATE LINKS/ADVICE BITS HERE
KEYWD $LNADV
T LINKS,,.RELNK
JRST CERR
CALL (P3)
CONFIRM ;GET CONFIRMATION
RECREF: TLZE Z,F2 ;USE MTOPR OR TLINK ?
JRST .REMTO ;MTOPR
MOVE A,Q1 ;GET THE BITS
HRRI A,.CTTRM
TLINK
CALL JERR
JRST CMDIN4
;Common code for REFUSE
.REMTO: MOVE B,Q1 ;GET THE FUNCTION
MOVE C,Q2 ;GET THE VALUE
MOVEI A,.CTTRM
MTOPR ;DO IT
ERCAL CJERRE ;COULDN'T
RET
;Here to get terminal flags.
RTTFLG::MOVEI A,.CTTRM
MOVEI B,.MORTF ;READ TERMINAL FLAGS
MTOPR ;DO IT
ERJMP R
RETSKP
$LNADV: TABLE
T ADVICE,,.READV
T LINKS,,.RELNK
T SYSTEM-MESSAGES,,.RESYS
T USER-MESSAGES,,.REUSR
TEND
;User-messages
.REUSR: CALL RTTFLG ;RETURN EXISTING TERMINAL FLAGS
JRST [CONFIRM
ERROR <The USER-MESSAGES function is not implemented>]
MOVE Q2,C
TXZ Q2,MO%NUM ;SET RECEIVE USER MESSAGES
TLNE Z,F4 ;BUT SHOULD IT REALLY BE REFUSE ?
TXO Q2,MO%NUM ;YES. TURN BIT ON.
TLO Z,F2 ;FLAG THE NEED TO USE MTOPR, NOT TLINK
MOVEI Q1,.MOSTF ;FUNCTION CODE FOR SETTING TERMINAL FLAGS
RET
;System-messages
.RESYS: MOVEI Q1,.MOSNT ;FUNCTION CODE FOR CONTROLLING MESSAGES
MOVEI Q2,.MOSMY ;SET RECEIVE BY DEFAULT
TLNE Z,F4 ;BUT SHOULD IT REALLY BE REFUSE ?
MOVEI Q2,.MOSMN ;YES
TLO Z,F2 ;FLAG THE NEED TO USE MTOPR, NOT TLINK
RET
;Advice
.READV: TLO Q1,(TL%STA) ;ADVISE "ENABLE" BIT
TLNE Z,F4 ;RECEIVE?
RET ;NO - ENABLE BIT AND "ADVICE" OFF
TLO Q1,(TL%SAB!TL%AAD!TL%ABS) ;ENABLE BITS AND "ADVICE AND LINKS" ON
NOISE <AND LINKS>
RET
;Links
.RELNK: TLO Q1,(TL%SAB) ;LINK "ENABLE" BIT
TLNE Z,F4 ;RECEIVE ?
JRST [NOISE <AND ADVICE> ;NO. REFUSE, SO ADVICE IS IMPLICIT
RET]
TLO Q1,(TL%ABS) ;YES. ENABLE BIT AND "LINK" BIT ON
RET
;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>
IFN NICSW,< ;[NIC1021]
MOVE A,JBUFP ;[NIC1021] GET PTR TO JFNS
HRRZ Q1,0(A) ;[NIC1021] GET TO FILE
HRRZ A,-1(A) ;[NIC1021] GET FROM FILE
DVCHR% ;[NIC1021] GET ITS DEVICE
ERJMP RENAM0 ;[NIC1021] DO NORMAL PROCESSING
EXCH A,Q1 ;[NIC1021] SAVE IT AND GET TO JFN
DVCHR% ;[NIC1021] GET TO DEVICE CHARS.
ERJMP RENAM0 ;[NIC1021] DO NORMAL PROCESSING
CAME A,Q1 ;[NIC1021] ARE THEY THE SAME?
JRST [ MOVEI Q1,CP%REN ;[NIC1021] SAY A RENAME-COPY
SETZM TYPGRP ;[NIC1021] TELL IT TO BE QUIET
CALL COP1A ;[NIC1021] NO, DO THE COPY
SETOM TYPGRP ;[NIC1021] NOISY AGAIN
CALL GNFIL ;[NIC1021] LOOK AT NEXT FILE
SETZM INIFH1 ;[NIC1021] CLEAR WHEN NO MORE
JRST RENAM2] ;[NIC1021] TRY NEXT FILE
RENAM0:
>;IFN NICSW
MOVE A,JBUFP
MOVEM A,.JBUFP ;SAVE THESE JFNS
RENAM1: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX FILE TERM
JRST RENAM2
CALL TYPIF ;TYPE INPUT NAME IF GROUP
CALL MFSET ;SET UP OUTPUT TERM
JRST [ CALL GNFIL ;ERROR, MESSAGE ALREADY PRINTED
SETZM INIFH1 ;CLEAR WHEN NO MORE
JRST RENAM2]
CALL MFINP ;GET SECOND JFN ON INPUT JFN
JRST RENAM2
HRRZ B,OUTDSG ;GET OUTPUT DESCRIPTOR
RNAMF ;RENAME FILE
ERJMP [LERROR <%1?> ;TELL USER WHY IT FAILED
JRST RENAM2] ;GO ON TO NEXT FILE
CALL TYPOK
RENAM2: SKIPE INIFH1 ;DID LAST GNFIL HIT END?
JRST RENAM1 ;NO
RET
;REQUEST A FILE BE RETRIEVED FROM OFFLINE STORAGE
.RETRI::STKVAR <NRETR>
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,0 ;DEFAULT VERSION IS 0
HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
TXZ Z,IGINV
RETRI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
SETZM NRETR ;KEEP TRACK OF HOW MANY RETRIEVED
RETRI3: CALL RLJFNS
CALL NXFILE
JRST RETRI4
CALL MFINP ;GET 2ND JFN
JRST RETRI4 ;FAILED
MOVE B,[1,,.FBCTL]
MOVEI C,C ;FIND OUT IF FILE IS OFFLINE
GTFDB
ERJMP RETRI4 ;SKIP FILE IF CAN'T FIND OUT
TXNN C,FB%OFF ;IS IT OFFLINE?
JRST [ETYPE <%%File is already online%_> ;[NIC1005]
JRST RETRI4] ;[NIC1005] 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
;SEND (MESSAGE) TO SPECIFIC USER ON THE SYSTEM (UNPRIVILEGED)
IFE STANSW,<
.USEND::SKIPE PRVENF ;ENABLED?
JRST .SEND ;YES - BEHAVE THE SAME AS ^ESEND
NOISE (TO)
OCTX <Octal line #>
CMERRX <Octal line number required>
TRVAR <SNDPT,SNDPTC,SNDLNO>
SETZM SNDLNO ;SAY NO POINTER TO END OF HEADER
SETZM SNDPTC ;SAY NO POINTER TO HEADER STRING
MOVEM B,SNDLNO ;SAVE LINE NUMBER
MOVE A,[POINT 7,BUF0] ;GET POINTER TO STRING BUFFER
HRROI B,[ASCIZ /
[/]
CALL SAPPND ;BEGIN THE MESSAGE
JRST SENDD0 ;JUMP INTO ^ESEND CODE
>;IFE STANSW
;^ESEND (MESSAGE) TO ALL ON SYSTEM
.SEND:: NOISE (TO)
OCTX <Octal line # or * for all>
CAIA ;NO NUMBER TYPED
JRST SENDA ;NUMBER TYPED.
STARX ;SEE IF "*" TYPED
CMERRX <Octal line number or * required>
SETO B, ;NOTE "*" WITH -1
SENDA: TRVAR <SNDPT,SNDPTC,SNDLNO>
MOVEM B,SNDLNO ;SAVE LINE NUMBER
MOVE A,[POINT 7,BUF0] ;GET POINTER TO STRING BUFFER
HRROI B,[ASCIZ /
[From /]
CALL SAPPND ;BEGIN THE MESSAGE
MOVE B,CUSRNO ;GET USER NAME
DIRST ;PUT NAME SO PEOPLE WILL KNOW WHO'S SWEARING
CALL JERR ;SHOULDN'T FAIL
PUSH P,A ;SAVE OUTPUT DESIGNATOR
GJINF ;FIND OUT ABOUT MY JOB
POP P,A ;RESTORE AC
JUMPL D,SENDD ;SKIP ON IF WE'RE DETACHED
HRROI B,[ASCIZ / on line /] ;GET SOME MORE TEXT
CALL SAPPND
MOVE B,D ;GET NUMBER IN RIGHT AC
MOVEI C,^D8 ;OCTAL OUTPUT
NOUT ;STORE TERMINAL NUMBER
CALL JERR
SENDD: HRROI B,[ASCIZ /:/]
SKIPGE SNDLNO ;IF SENDING TO ALL, SAY SO
HRROI B,[ASCIZ / to all:/]
CALL SAPPND ;FINISH OFF THE HEADER
MOVEM A,SNDPTC ;SAVE POINTER TO START OF CRLF
HRRI B,[ASCIZ /
/]
CALL SAPPND ;SEPARATE HEADER FROM CONTENTS WITH A CRLF
SENDD0: 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 ;POINT TO MESSAGE IN ATOM BUFFER
CALL SNDFIX ;COPY, ADDING CRLF WHEN LINE WILL OVERFLOW
HRROI B,[BYTE (7) "]",15,12,0]
CALL SAPPND ;TERMINATE WITH "]", CRLF
SETZ Q1, ;END THE MESSAGE WITH A NULL
IDPB Q1,A
HRRZ B,A ;GET ADDRESS OF END OF MESSAGE
CAIG B,BUF0+17 ;IS THE MESSAGE SHORTER THAN 80 CHARACTERS?
SKIPN A,SNDPTC ;YES - IS THERE A HEADER?
JRST SENDD1 ;NO TO EITHER - PROCEED
MOVEI B," " ;YES TO BOTH - REPLACE THE CRLF BETWEEN
IDPB B,A ; THE HEADER AND THE MESSAGE SO THE WHOLE
IDPB B,A ; THING WILL FIT ENTIRELY ON ONE LINE
SENDD1: MOVE B,[POINT 7,BUF0] ;GET POINTER TO THE MESSAGE STRING
SKIPL A,SNDLNO ;RESTORE LINE(S) FOR MESSAGE - JUST ONE?
ADDI A,.TTDES ;YES - ADD IN TERMINAL DESIGNATOR
TTMSG ;SEND THE MESSAGE
ERJMP CJERRE ;IT FAILED SOMEHOW
CALLRET UNMAP ;O.K. - UNMAP BUFFER PAGE AND RETURN
;SNDFIX - ROUTINE TO BREAK UP LONG ^ESEND TEXT INTO MULTIPLE LINES
;ACCEPTS IN A/ POINTER TO WHERE TO STORE TEXT
; B/ ADDRESS OF USER'S TEXT
;RETURNS: +1 ALWAYS, WITH A/ POINTER TO END OF TEXT
SNDSIZ==^D76 ;MAX SIZE OF ^ESEND LINES
SNDFIX: HRLI B,(POINT 7,) ;MAKE ADDRESS OF USER'S DATA BE A POINTER
SNDFX0: MOVEI D,SNDSIZ ;GET MAX SIZE FOR ^ESEND LINES
SNDFX1: ILDB C,B ;GET A CHARACTER FROM THE USER'S STRING
JUMPE C,R ;ALL DONE IF END OF STRING
CAIN C," " ;BETWEEN WORDS?
JRST SNDFXW ;YES - SEE IF NEAR END OF LINE
SNDFX2: IDPB C,A ;ELSE DEPOSIT CHARACTER IN NEW STRING
SOJG D,SNDFX1 ;LOOP OVER A LINE-FULL OF CHARACTERS
SNDFX3: MOVEI C,.CHCRT ;THEN PUT IN A CRLF AND A SPACE
IDPB C,A
MOVEI C,.CHLFD
IDPB C,A
MOVEI C," "
IDPB C,A
JRST SNDFX0 ;AND CONTINUE COPYING
SNDFXW: CAILE D,7 ;NEAR THE END OF THE LINE?
JRST SNDFX2 ;NO - PROCEED
JRST SNDFX3 ;YES - START THE NEW LINE NOW
;SUBROUTINE TO APPEND A STRING TO THE END OF (A)
;ENTER WITH ASCIZ STRING POINTER IN AC B
SAPPND: HRLI B,(POINT 7,) ;MAKE ADDRESS INTO A POINTER
SAPND1: ILDB Q1,B ;GET A CHARACTER
JUMPE Q1,R ;DONE IF NULL
IDPB Q1,A ;ELSE SAVE IT AT END OF MESSAGE
JRST SAPND1 ;AND GET MORE
;TAKE (EXEC INPUT FROM) FILESPEC
.TAKE:: TRVAR <TAKCON,JFN1,JFN2> ;CELLS TO HOLD NEW JFNS
NOISE <COMMANDS FROM>
SETZM JFN1 ;INDICATE NO INPUT JFN YET
MOVE A,TAKDEF ;GET THE DEFAULTS
MOVEM A,TAKCON ;REMEMBER SETTINGS BEFORE SUBCOMMANDS CHANGE THEM
MOVE A,COJFN
MOVEM A,JFN2 ;DEFAULT NEW JFNS TO OLD
DEXTX <CMD> ;DEFAULT INPUT EXTENSION IS CMD
MOVX A,GJ%OLD+GJ%ACC ;OLD FILE ONLY AND DON'T LET INFERIORS KILL IT
MOVEM A,CJFNBK+.GJGEN ;STORE FLAGS
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to end current command level>,,[
FLDDB. .CMCMA,CM%SDH,,<Comma to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Command file name>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED!
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST PRIRES ;YES
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GET SUBCOMMANDS
MOVEM B,JFN1 ;REMEMBER FIRST JFN
NOISE <LOGGING OUTPUT ON>
DEXTX <LOG> ;DEFAULT OUTPUT EXTENSION IS LOG
MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
MOVEM A,CJFNBK+.GJGEN ;AND DON'T LET INFERIORS TOUCH THIS JFN
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return if no change of output desired>,,[
FLDDB. .CMCMA,CM%SDH,,<Comma for no change, but to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Output file name>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST TAKE1 ;YES, DON'T CHANGE OUTPUT SIDE
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GO GET SUBCOMMANDS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
MOVEI Q1,0 ;FIRST ASSUME NO SUBCOMMANDS
COMMAX <Comma to enter subcommands, or confirm with carriage return>
CAIA ;NO SUBCOMMANDS COMING
MOVEI Q1,1 ;SUBCOMMANDS COMING
CONFIRM ;REQUIRE CONFIRMATION AFTER FILE NAME
JUMPE Q1,TAKE1 ;SKIP SUBCOMMAND STUFF IF NO COMMA
CAIA ;WE'VE ALREADY GOT CONFIRMATION
TAKEC: CONFIRM
SUBCOM $TAKE ;DO THE SUBCOMMANDS
TAKE1: SKIPN A,JFN1 ;INPUT FILE TYPED?
RET ;NO, THIS IS A NO-OP
MOVE B,[XWD 70000,OF%RD]
OPENF
ERCAL CJERRE ;COULDN'T OPEN TAKE FILE
MOVE A,JFN2
MOVE B,COJFN ;GET OLD OUTPUT
CAIN A,(B) ;OUTPUT BEING CHANGED?
JRST TAKE33 ;NO
MOVE B,[XWD 70000,OF%APP]
OPENF
ERCAL CJERRE ;GO PRINT ERROR MESSAGE
TAKE33: HRL A,JFN1 ;GET XWD INPUT,OUTPUT
MOVE B,TAKCON ;GET DESIRED SETTING FOR NESTED TAKE
CALLRET PUSHIO ;START NEW STREAM, REMEMBER OLD
PRIRES: CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
RET ;NOTHING TO CLOSE (WE'RE AT TOP LEVEL)
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL
IFN STANSW,<
SKIPE LGOFLG ;ARE WE IN A LOGOUT.CMD FILE?
JRST LOGOU2 ;YES, THEN LOG THE USER OUT
>;IFN STANSW
RET
;SUBCOMMANDS TO "TAKE" COMMAND
$TAKE: TABLE
T ALLOW ;IGNORE ERRORS DURING TAKE
T DISALLOW ;STOP ON ERRORS DURING TAKE
T ECHO ;ECHO COMMANDS IN TAKE FILE
T LOG-FILE,,.TKLOG ;FILE TO LOG OUTPUT ON
T NO,,.NOTAK ;NO
TEND
.ALLOW: CALL ALONOI
MOVX A,TKALEF ;BIT TO ALLOW ERRORS
IORM A,TAKCON ;TURN IT ON
RET
.DISAL: CALL ALONOI
MOVX A,TKALEF ;BIT FOR ALLOWING ERRORS
ANDCAM A,TAKCON ;TURN IT OFF
RET
.ECHO: CALL ECHNOI
MOVX A,TKECOF ;FLAG TO ALLOW ECHOING
IORM A,TAKCON ;TURN IT ON
RET
.TKLOG: DEXTX <LOG> ;DEFAULT OUTPUT EXTENSION IS LOG
MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
MOVEM A,CJFNBK+.GJGEN ;AND DON'T LET INFERIORS TOUCH THIS JFN
MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Output file name>]
CALL FLDSKP ;READ FILESPEC
CMERRX ;THAT'S NOT WHAT IT WAS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
CONFIRM ;DON'T FORGET
RET
.NECHO: CALL ECHNOI
MOVX A,TKECOF ;FLAG TO ALLOW ECHOING
ANDCAM A,TAKCON ;TURN IT OFF
RET
.NOTAK: KEYWD $NOTAK ;GET NEXT KEYWORD
T ECHO,,.NECHO
JRST CERR
JRST (P3) ;CALL PROPER ROUTINE
$NOTAK: TABLE
T ECHO,,.NECHO
TEND
;ROUTINE TO PUSH THE EXEC PRIMARY IO STREAM
;
;ACCEPTS: A/ INPUT JFN,,OUTPUT JFN
; B/ FLAG BITS (SUCH AS TKALEF, TKECOF)
;
;RETURNS +1
PUSHIO::MOVE C,TAKLEN ;GET CURRENT LENGTH
CAIL C,TAKLNX ;MAKE SURE WE'RE NOT AT MAXIMUM
JRST NOPE ;WE ARE
AOJ C, ;INCREASE LENGTH OF LIST
CALL PIOFF ;NO ^C WHILE WE STRAIGHTEN THINGS OUT
MOVEM A,TAKJFN-1(C) ;STORE JFNS
MOVEM B,TAKBTS-1(C) ;STORE CONTROL BITS
MOVEM C,TAKLEN ;REMEMBER NEW LENGTH
CALL FIXIO ;SET UP DYNAMIC VARIABLES
GJINF ;GET JOB INFO
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
SKIPGE D ; IF DETACHED
CAIE A,.PRIIN ; AND READING FROM PRIMARY INPUT
SKIPA
JRST [MOVE A,TAKCUR ;GET CURRENT SETTINGS
JRST PSH1] ;FALL IN TO TURN OFF TKTERF
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
DVCHR
LDB B,[221100,,B] ;GET DEVICE TYPE OF INPUT DEVICE
MOVE A,TAKCUR ;GET CURRENT SETTINGS
TXO A,TKTERF ;FIRST ASSUME INPUTTING FROM TERMINAL
CAIE B,.DVTTY ;GOOD GUESS?
PSH1: TXZ A,TKTERF ;NO, LOUSY GUESS.
MOVEM A,TAKCUR ;UPDATE SETTINGS
MOVE B,TAKLEN ;GET POINTER TO END OF LIST AGAIN
MOVEM A,TAKBTS-1(B) ;REMEMBER WHETHER INPUTTING FROM TERMINAL
CALLRET PION ;ALLOW ^C AGAIN
NOPE: MOVE C,A ;SAVE JFNS IN C
HRRZ A,C
MOVE B,TAKJFN-1(B) ;GET LAST JFNS ON LIST
CAIE A,(B) ;DON'T CLOSE IF LAST JFN IS SAME
CLOSF ;CLOSE THIS LAST SET OF JFNS, SINCE THEY'RE NOT ON THE STACK YET
ERJMP .+1 ;FAILED, PROBABLY BECAUSE 100 OR 101
HLRZ A,C ;GET OTHER JFN
CLOSF
ERJMP .+1
HLRZ A,C ;PCL Look at input
CAIN A,.NULIO ;PCL Command procedure?
ERROR <Command procedures nested too deeply> ;PCL
ERROR <TAKE commands nested too deeply>
;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.
;UNATTACH - DETACH REMOTE JOB WITHOUT REATTACHING HERE
.UNATT::TLO Z,F1 ;SAY UNATTACH INSTEAD OF ATTACH
JRST ATTAU1 ;GO JOIN ATTACH
;UNDELETE <DELETED FILE NAMES>
.UNDEL::NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
MOVX B,(GJ%OLD!GJ%NS!GJ%DEL!GJ%IFG!1B15!1B16!1B17) ;"MUST BE NEW" AND "IGNORE DELETED BIT"
; ALSO, NO SEARCHING TO BE DONE
HRLI B,-3 ;DEFAULT VERSION IS *
TRO Z,IGINV ;SEE INVISIBLE FILES
CALL SPECFN ;INPUT FILE NAME USING GTJFN FLAGS IN B
JFCL ;IGNORE SUBCOMMAND ENDING
SETOM TYPGRP ;ALWAYS PRINT FILENAME AT TYPIF
UNDEL1: HRRZ A,@INIFH1 ;JFN
DVCHR
TXNN B,DV%MDD ;MULT DIR DEVICE?
JRST [ ETYPE <?%1H: Can't undelete files on this device
>
MOVSI A,(77B5)
ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
JRST UNDEL8]
HRRZ A,@INIFH1
MOVE B,[XWD 1,.FBCTL] ;CONTROL BITS WORD OF FILE DESC BLOCK
MOVEI C,C ;READ INTO C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
SETO C, ;NO ACCESS, ASSUME DELETED
TXNN C,FB%DEL ;"FILE IS DELETED" BIT
JRST [ MOVE A,@INIFH1 ;GET JFN WITH FLAGS
TLNE A,<77B5>B53 ;ANY *'S?
JRST UNDEL8 ;YES, NO MESSAGE
CALL TYPIF ;PRINT NAME
TYPE < Wasn't deleted
>
JRST UNDEL8]
CALL TYPIF ;TYPE NAME IF GROUP
HRLI A,.FBCTL ;1: XWD DISPLACEMENT, JFN
LDF B,FB%DEL ;MASK OF BITS TO CHANGE
SETZ C, ;VALUE TO CHANGE TO: OFF.
CALL $CHFDB ;DO CHFDB AND FIELD ITRAP IF ANY
JRST [ TYPE < Access not allowed
>
JRST UNDEL8]
CALL TYPOK ;INDICATE DONE OK
UNDEL8: CALL GNFIL ;GET JFN OF NEXT FILE OF GROUP
RET ;NO MORE, GO GET NEXT COMMAND.
JRST UNDEL1 ;HAVE ANOTHER
;PRIVILEGED COMMANDS
;^E EDDT
;TRANSFER CONTROL TO TOPS20 DDT, GETTING IT IF IT ISN'T ALREADY THERE.
.EDDT:: SKIPE DDTORG
JRST EDDT4 ;DDT ALREADY THERE
SKIPN Q1,.JOBSY ;DO WE HAVE SOME SYMBOLS?
SKIPE Q1,JOBSYM ;???
SKIPA B,[-1,,[GETSAVE <SYS:UDDT.>]]
HRROI B,[GETSAVE <SYS:SDDT.>] ;USE SDDT IF NO SYMBOLS
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY, AND SHORT FORM
CALL GTJFS ;GET AND STACK THE JFN
CALL CJERRE ;IF CAN'T, JUST GIVE ERROR TO USER
HRLI A,.FHSLF ;SAY THIS FORK (JFN IS IN RH A)
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED, SAY WHY
CALL RLJFNS
;"GET" CHANGES ENTRY VECTOR TO POINT AT DDT.
;CHANGE IT BACK.
MOVEI A,.FHSLF
DMOVE B,[EXP EVLEN,EXEC] ;ENTRY VECTOR
CALL SETENT
;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.
SKIPN Q1 ;HAVE ONE?
JRST [TYPE <% No symbols
>
JRST EDDT4] ;NO - PROCEED
MOVEM Q1,@DDTORG+1 ;YES - STORE INTO DDT
EDDT4: MOVX A,OURNAM ;GET OUR NAME
SETNM ;SET IT IN CASE USER EXITS DDT AND TYPES "SAVE"
JRST DDTORG ;ENTER DDT
;DISABLE
;DISABLES PRIVILEGED COMMANDS,
;DISABLES USER (RH) SPEC CAPS IN EXEC AND INFERIOR FORK
; (CAPS POSSIBLE ARE STILL TRANSMITTED, SO INFERIOR CAN USE THEM
; IF IT ENABLES THEM ITSELF)
.DISAB::SETZ A, ;FLAG DISABLE
DISAB1: STKVAR <REMA>
MOVEM A,REMA ;REMEMBER DESIRED SETTING
NOISE <CAPABILITIES>
CONFIRM
MOVE A,REMA
MOVEM A,PRVENF ;GET DESIRED SETTING
MOVEI A,.FHSLF ;"ENABLE" JOINS HERE
RPCAP
ERJMP CJERR
TRZ C,-1
SKIPE PRVENF
HRR C,B
MOVE D,C ;REMEMBER EXEC'S CAPS
EPCAP ;EXEC'S CAPABILITIES
ERJMP CJERR
;IFE STANSW,< ;[NIC1030]
SKIPG A,FORK
RET ;NO INFERIOR, DONE
RPCAP
ERJMP CJERR
MOVE C,D ;SET FORK TO WHATEVER WE ARE
EPCAP ;INFERIOR'S CAPS
ERJMP CJERR
;>;IFE STANSW ;[NIC1030]
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::TRVAR <<JUSBLK,.JIPNM+1>,JUSJOB>
MOVEM A,JUSJOB
GJINF
CAMN 3,JUSJOB ;THIS JOB?
ERROR <If you want to logout this job, use LOGOUT>
MOVE D,JUSJOB ;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
MOVE A,D ;JOB NUMBER
MOVSI B,-<.JIPNM+1> ;GET UP TO THE PROGRAM NAME
HRRI B,JUSBLK ;PUT DATA IN TEMP AREA
MOVEI C,.JIJNO ;START WITH JOB NUMBER
GETJI ;GET IT
ERJMP CJERR
MOVEI C,JUSBLK ;POINT AT TEMP AREA
SKIPN A,.JIUNO(C) ;GET USER #
IFSKP.
ETYPE <User %1N> ;TYPE USER NAME OUT
ELSE.
ETYPE <Not logged in> ;OR NOT LOGGED IN IF USER # IS 0
ENDIF.
SKIPGE A,.JITNO(C) ;GET TTY
IFSKP.
ETYPE < on TTY%1O> ;TYPE IT
ELSE.
ETYPE <, Detached> ;UNLESS -1
ENDIF.
SKIPN B,.JIPNM(C) ;AND PROGRAM NAME UNLESS IT'S 0
MOVE B,.JISNM(C) ;IF PROG NAME WAS ZERO, USE SYSTEM NAME
ETYPE <, running %2'>
ELOGO2: CALL FCONF ;CONFIRM
MOVE A,JUSJOB ;NOW, RECHECK THE USER NUMBERS
MOVE B,[1,,C] ;ONE WORD INTO AC C
MOVEI C,.JIUNO ;THE WORD IS THE USER NUMBER
GETJI ;GET IT
ERJMP CJERR
MOVEI B,JUSBLK
MOVE A,.JIUNO(B) ;GET JOB NUMBER
CAME C,A ;STILL THE SAME USER?
JRST CMDIN4 ;DIFFERENT USER, DO NOTHING
MOVE A,JUSJOB ;GET THE JOB NUMBER
LGOUT ;LOGOUT THE JOB
CALL CJERR
JRST CMDIN4
.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
CAIGE B,NTTYPS ;IS IT WITHIN THE TABLE?
SKIPN A,BLNKTB(B) ;YES - GET STRING TO DUMP
JRST BLANK2 ;NO - DO NOTHING
TLNN A,-1 ;STRING OR POINTER?
TLOA A,-1 ;POINTER 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
IFN STANSW&LOTSW,<
;.OPEN - CREATE OR MODIFY AN ACCOUNT AT LOTS
.OPEN:: NOISE <A NEW ACCOUNT> ;SOME NOISE
CONFIRM ;WAIT FOR CONFIRMATION
SKIPE CUSRNO ;LOGGED IN?
IFSKP.
CALL PIOFF ;TURN OFF CTRL-C
MOVE A,[XWD .FHSLF,.TIMAL] ;A/ THIS FORK, CLEAR ALL TIMER INTERUPTS
SETZB B,C ;B,C/ NOT USING THESE AC'S
TIMER% ;CLEAR AUTO-LOGOUT (AND RUNTIME LIMIT, ETC.)
ERROR <Unable to disable autologout timer - %?> ;SOME ERROR
SETZM ALOST ;RESTART AUTO-LOGOUT TIMER WHEN BACK AT EXEC
CALL PION ;TURN CTRL-C BACK ON
ENDIF.
MOVEI A,1 ;EVEC POS 1=MAKE NEW ACCOUNT
; CALLRET RUNOP1 ;RUN DBEDIT
RUNOP1: STKVAR <EVEC>
MOVEM A,EVEC
HRROI B,[GETSAVE(<SYS:DBEDIT.>)]
CALL TRYGTJ
ERROR <Account maker not found>
MOVE D,A ;SAVE JFN FOR GET
CALL JFNSTK ;STACK IT SO IT GOES AWAY LATER
MOVX A,CR%CAP ;TRANSMIT CAPS
CFORK%
CALL JERR ;IS THIS RIGHT?
MOVEM A,EFORK
MOVEM A,RUNFK ;MAKE ^C WORK RIGHT
HRLZS A
HRR A,D
GET% ;MAP FILE
ERCAL JERRE
MOVEI Q1,ETTYMD ;SAVE EXEC TTY MODES
CALL RTTYMD
TLO Z,RUNF
MOVE A,EFORK
MOVE B,EVEC ;START AT THIS EVEC POSITION
SFRKV%
RFORK% ;RESUME IT
WFORK% ;WAIT FOR IT
SETZM EFORK ;CLEAR FORK
KFORK%
CALL RLJFNS ;CLOSE FILES WE USED
TLZ Z,RUNF ;SAY PROG'S TTY MODES NOT IN EFFECT
MOVEI Q1,ETTYMD ;RESTORE EXEC'S TTY MODES
CALLRET LTTYMD ;..
ENDSV.
>;IFN STANSW&LOTSW
END