Trailing-Edge
-
PDP-10 Archives
-
BB-M081M-SM
-
exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
; *** Edit 3050 to EXEC1.MAC by EVANS on 29-Oct-86, for SPR #00092
; Reset STATSW to zero to prevent mulitply defined symbols when linking with
; distributed PCL and MIC modules; remove the STAT code so we don't do the
; statistics.
; *** Edit 3049 to EXEC1.MAC by EVANS on 28-Oct-86
; Prevent bogus error message on DELETE with EXPUNGE subcommand.
; *** Edit 3045 to EXEC1.MAC by EVANS on 12-Aug-86, for SPR #21270
; Make the EXEC check for STRX09 when coming back from DELDF% on an EXPUNGE. If
; found, do not continue looping thru all directories on the structure. RE
; monitor edit 7351.
; *** Edit 3040 to EXEC1.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; *** Edit 3023 to EXEC1.MAC by WAGNER on 26-Nov-85, for SPR #20947
; Make DELETE command know about offline files by setting G1%IIN for
; consideration of invisible files. GTJFN changed to require this bit being
; set.
; Edit 3016 to EXEC1.MAC by EVANS on 15-Oct-85 (TCO none)
; Change error message to account for unmounted structure in case user attempts
; to expunge such a structure. (RE: 6.1 monitor edit 7117)
; Edit 3011 to EXEC1.MAC by SANTIAGO on 15-Aug-85
; more TCO 6.1.1519 - make code less gross
; Edit 3010 to EXEC1.MAC by SANTIAGO on 13-Aug-85 (TCO 6-1-1519 )
; Make ADVISE work if Wheel is trying to advise user with TERMINAL INHIBIT
; UPD ID= 244, SNARK:<6.1.EXEC>EXEC1.MAC.25, 10-Jun-85 09:09:49 by SANTIAGO
;TCO 6.1.1430 - Make DISCARD command see invisible files
; UPD ID= 217, SNARK:<6.1.EXEC>EXEC1.MAC.24, 10-Jun-85 08:42:20 by DMCDANIEL
; UPD ID= 201, SNARK:<6.1.EXEC>EXEC1.MAC.23, 24-May-85 14:13:14 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 193, SNARK:<6.1.EXEC>EXEC1.MAC.22, 10-May-85 15:45:16 by EVANS
;TCO 6.1.1362 - Save TAKLEN when begin LOGOUT process, and test against it
; (SAVTAK) when TAKE encountered in LOGOUT.CMD.
; UPD ID= 161, SNARK:<6.1.EXEC>EXEC1.MAC.21, 3-May-85 08:29:16 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 153, SNARK:<6.1.EXEC>EXEC1.MAC.20, 2-May-85 11:15:23 by PRATT
;TCO 6.1.1353 - Handle GNJFN errors better
; UPD ID= 147, SNARK:<6.1.EXEC>EXEC1.MAC.19, 15-Mar-85 16:19:41 by EVANS
;Yet more TCO 6.1.1027 - Require confirm of LOGOUT when not logged-in.
; UPD ID= 145, SNARK:<6.1.EXEC>EXEC1.MAC.18, 15-Mar-85 13:22:55 by PRATT
;TCO 6.1.1068 - Change CAIGE to CAMGE in .BLANK
; UPD ID= 140, SNARK:<6.1.EXEC>EXEC1.MAC.17, 14-Mar-85 16:18:14 by SANTIAGO
;Still more TCO 6.1.1261 - Put previous patch in proper place.
; UPD ID= 139, SNARK:<6.1.EXEC>EXEC1.MAC.16, 14-Mar-85 15:40:41 by SANTIAGO
;More TCO 6.1.1261 - Don't bother checking for over quota if GTDAL% fails
; UPD ID= 134, SNARK:<6.1.EXEC>EXEC1.MAC.15, 13-Mar-85 17:06:21 by SANTIAGO
;TCO 6.1.1261 - Fix LOGOUT when GETAB% capabilities are off.
; UPD ID= 131, SNARK:<6.1.EXEC>EXEC1.MAC.14, 7-Mar-85 08:46:15 by PRATT
;TCO 6.1.1240 - If never logged in before, output Last Login Never
; UPD ID= 127, SNARK:<6.1.EXEC>EXEC1.MAC.13, 7-Feb-85 09:38:15 by PRATT
;TCO 6.1.1179 - Remove output filespec on TAKE, use LOG-FILE instead.
; UPD ID= 122, SNARK:<6.1.EXEC>EXEC1.MAC.12, 9-Jan-85 14:04:52 by EVANS
;TCO 6.1.1123 - Change confusing error message if SENDer gives wrong term #.
; UPD ID= 103, SNARK:<6.1.EXEC>EXEC1.MAC.11, 11-Dec-84 15:21:25 by MOSER
;TCO 6.1.1077 - ADD STAT STUFF
; UPD ID= 101, SNARK:<6.1.EXEC>EXEC1.MAC.10, 10-Dec-84 13:39:21 by EVANS
;More TCO 6.1.1027 - In case user redefines SYSTEM:, set GJ%PHY for GTJFN so
; system logicals ONLY will be considered.
; UPD ID= 93, SNARK:<6.1.EXEC>EXEC1.MAC.9, 15-Nov-84 13:33:50 by EVANS
;Still more TCO 6.1.1027 - Account for case of "TAKE" at end of LOGOUT.CMD
; UPD ID= 52, SNARK:<6.1.EXEC>EXEC1.MAC.8, 5-Nov-84 15:18:04 by MCCOLLUM
;TCO 6.1.1025 - Fix up call to MFSET in .RENAM
; UPD ID= 49, SNARK:<6.1.EXEC>EXEC1.MAC.7, 1-Nov-84 12:58:14 by PRATT
;More TCO 6.1.1027 - LOGO n has an unecessary CONFIRM
; UPD ID= 38, SNARK:<6.1.EXEC>EXEC1.MAC.6, 26-Oct-84 13:35:43 by EVANS
;TCO 6.1.1027 - Add LOGOUT.CMD; SYSTEM: and user flavors, with /FAST option.
; UPD ID= 36, SNARK:<6.1.EXEC>EXEC1.MAC.5, 20-Oct-84 12:08:33 by PRATT
;More TCO 6.1.1014 - Verify the selected line to match requested username
; UPD ID= 26, SNARK:<6.1.EXEC>EXEC1.MAC.4, 1-Oct-84 22:40:56 by PRATT
;TCO 6.1.1019 - Allow some commands set CM%NSF (no suffix) for devices
; UPD ID= 5, SNARK:<6.1.EXEC>EXEC1.MAC.3, 28-Sep-84 18:44:58 by PRATT
;TCO 6.1.1014 - Allow usernames to be typed as an argument to SEND
; UPD ID= 4, SNARK:<6.1.EXEC>EXEC1.MAC.2, 28-Sep-84 18:34:47 by PRATT
;TCO 6.1.1013 - Add recognition to the DEFINE command
; UPD ID= 442, SNARK:<6.EXEC>EXEC1.MAC.48, 26-Sep-84 15:07:59 by MCCOLLUM
;TCO 6.2228 - Add entry point RTFLG1 to RTTFLG so caller can supply line #.
; 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) BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 1980,1985
;ALL RIGHTS RESERVED.
SEARCH EXECDE
TTITLE EXEC1
;THIS FILE CONTAINS
;LOTS OF COMMANDS...
;ARCHIVE <Files>
;F2 - DON'T FLUSH FILE CONTENTS
.ARCHI::NOISE <FILES>
TLZ Z,F2 ;DEFAULT IS NOT TO RETAIN CONTENTS
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
CALL SPECFN
JRST ARCHI1
JRST ARCHI2 ;DO IT
ARCHI1: SUBCOM $ARCHI
ARCHI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
MOVX C,.ARSET ;WITH NO FLAGS
TLNE Z,F2 ;WANT TO RETAIN FILE CONTENTS?
TXO C,AR%NDL ;RIGHT, FLAG THAT ON THE CALL
PUSH P,C ;SAVE DISPOSITION BITS ETC
ARCHI3: CALL RLJFNS
CALL NXFILE
JRST ARCHI9
CALL TYPIF
CALL MFINP ;GET 2ND JFN
JRST ARCHI9 ;FAILED
MOVX B,.ARRAR ;FUNCTION CODE TO USE (PLS ARCHIVE)
MOVE C,0(P) ;AND BITS
ARCF
ERJMP [ETYPE < %?%%_>
JRST ARCHI9]
HRLI A,.FBCTL
MOVX B,FB%INV ;MAKE THE FILE INVISIBLE TOO
MOVX C,FB%INV
TLNN Z,F2 ;RETAIN CONTENTS?
CHFDB
ERJMP [ETYPE < %?%%_>
JRST .+1]
TYPE < [Requested]
>
ARCHI9: SKIPE INIFH1 ;DONE THEM ALL?
JRST ARCHI3 ;NO, LOOP
SETZM .JBUFP
ADJSP P,-1 ;FLAGS NO LONGER USEFUL
RET
;TABLES ETC. TO ARCHIVE
$ARCHI: TABLE
T RETAIN,,.ARFL
TEND
.ARFL: NOISE <DISK CONTENTS>
CONFIRM
TLO Z,F2
RET
;LET (LOGICAL NAME) -- (AS) --
EDEFIN::TLO Z,F2
NOISE <SYSTEM LOGICAL NAME>
JRST .ASSO
.DEFIN::TRVAR <SAVBPT>
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: HRROI B,[ASCIZ/Logical name to define or delete/]
CALL STRN ;GET THE NAME
CMERRX
CALL BUFFF ;GET POINTER TO NAME
PUSH P,A ;SAVE POINTER
.ASSO2: SKIPN (P) ;ALL?
JRST .ASS3B ;YES, SEPARATE ROUTINE
NOISE <AS>
MOVE B,SBLOCK+.CMPTR ;GET POINTER TO COMMAND BUFFER
MOVEM B,SAVBPT ;SAVE IT
CALL PARSTX ;CHECK THE STRING, IS IT COMPLETE ?
JRST .ASS2B ;NO, USE RECOGNITION
; .. ;FALL THRU INTO NORMAL .CMTXT
;HERE TO READ THE WHOLE STRING AT ONCE, NO RECOGNITION NEEDED
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
JRST .ASSO3 ;GO JOIN COMMON CODE
;HERE TO READ THE STRING USING RECOGNITION
.ASS2B: DEXTX <> ;CLEAR GTJFN BLOCK
MOVX B,GJ%NEW!GJ%OLD!GJ%IFG
MOVEM B,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,,,[
FLDDB. .CMFIL,CM%SDH,,<Definition list or null to delete>,,[
FLDDB. .CMCFM,CM%SDH]]]
CALL FLDSKP ;GET SOME INPUT
JFCL ;IGNORE THE ERROR RIGHT NOW, CHECK IT LATER
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
CAIN C,.CMCFM ;GOT A CONFIRM ?
IFSKP.
TXNN A,CM%NOP ;NO - NO PARSE ?
IFSKP.
DEXTX <> ;CLEAR GTJFN BLOCK
MOVX A,GJ%OFG ;WE WANT SPEC, DON'T CARE IF EXISTS ANYMORE
IORM A,CJFNBK+.GJGEN
FILEX <> ;TRY TO READ THE FILESPEC
CMERRX ;COULDN'T, THIS LINE HAS REAL PROBLEMS
ENDIF.
JRST .ASS2B ;HAVEN'T GOTTEN EOL YET
ENDIF. ;GOT END OF LINE
MOVE A,SAVBPT ;GET POINTER TO CURRENT STRING
CALL BUFFS ;GET POINTER TO DEFINITION STRING
; .. ;JOIN COMMON CODE
;HERE FOR COMMON CODE FOR CREATING THE LOGICAL NAME
.ASSO3: MOVE C,A ;NEW POINTER 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 TO CHECK FOR COMPLETE COMMAND
PARSTX: MOVE C,SBLOCK+.CMPTR ;GET THE POINTER
PARST1: ILDB A,C ;GET THE NEXT CHARACTER
JUMPE A,R ;NULL MEANS COMMAND HASN'T COMPLETED
CAIE A,14 ;FORMFEED COUNTS AS END OF LINE
CAIN A,12 ;LINEFEED?
RETSKP ;YES - AT END
CAIE A,15 ;CARRIAGE RETURN?
JRST PARST1 ;NEITHER, HAVEN'T REACHED END YET
RETSKP ;YES - AT END
;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> --
.CONNE::TLZ Z,F2+F3 ;OFF MEANS "CONNECT", ON MEANS "ACCESS"
CONNX: TRVAR <ACDNUM,ACPASS,ACJNUM,OLDCON> ;KEEP ACDNUM,ACPASS,ACJNUM CONSECUTIVE AND IN ORDER!!
SETZM ACPASS ;NO PASSWORD ASSUMED THIS TIME
SETOM ACJNUM ;USE OUR OWN JOB NUMBER
NOISE <TO DIRECTORY>
TLNE Z,F2 ;WANT DEFAULTING?
TLOA Z,F1 ;NO (ACCESS, END ACCESS)
TLZ Z,F1 ;YES (CONNECT)
CALL DIRNAM ;INPUT & CHECK DIRECTORY NAME
ERROR <No such directory or structure not mounted>
MOVEM C,ACDNUM ;REMEMBER DIRECTORY NUMBER
CONFIRM
TLNE Z,F2 ;CONNECT?
JRST NOCONN ;NO, SO NO OVER QUOTA REPORTING
GJINF ;GET CONNECTED DIRECTORY
MOVEM B,OLDCON ;REMEMBER OLD ONE
CALL CHKDAL ;CHECK CURRENT DIRECTORY BEFORE LEAVING
NOCONN: SETZM ACPASS ;FIRST TRY WITHOUT PASSWORD
CALL DOACC ;DO THE JSYS
TLNE Z,F2 ;CONNECT?
JRST CMDIN4 ;NO, ACCESS, SO NO OVER QUOTA REPORT
GJINF ;GET CONNECTED DIRECTORY NOW
CAME B,OLDCON ;DON'T GIVE SAME REPORT TWICE!
CALL CHKDAL ;CHECK NEW DIRECTORY
JRST CMDIN4
;ROUTINE TO DO JSYS FOR ACCESS, END-ACCESS, CONNECT
DOACC: MOVE A,[AC%CON+3] ;SAY "CONNECT"+"3 WORDS IN INFO BLOCK"
TLNE Z,F2 ;"ACCESS"?
TXC A,AC%CON+AC%OWN ;YES, TURN OFF CONNECT AND ON ACCESS
TLNE Z,F3 ;END-ACCESS?
TXC A,AC%OWN+AC%REM ;YES, TURN OFF "ACCESS", TURN ON "END-ACCESS"
MOVEI B,ACDNUM ;WHERE THE BLOCK IS.
ACCES
ERCAL ACCHK ;FAILED
RET ;SUCCEEDED
;CHECK FOR FAILING END-ACCESS AND USER WASN'T ACCESSING THE DIRECTORY
ACCHK: CALL %GETER ;GET ERROR CODE FOR FAILING ACCES JSYS
MOVE A,ERCOD
CAIE A,ACESX6 ;"DIRECTORY ISN'T BEING ACCESSED" ERROR?
JRST ACNOP ;NO, MAYBE PASSWORD NOT GIVEN BUT REQUIRED
MOVE A,ACDNUM ;GET DIRECTORY NUMBER REFERRED TO
ETYPE <%%Directory %1R wasn't being ACCESSed
>
JRST CMDIN4 ;GIVE SUCCESS RETURN FOR COMMAND
;CONNECT OR ACCESS FAILED. SEE IF PASSWORD NOT GIVEN, BUT REQUIRED.
;IF SO, PROMPT FOR IT AND TRY AGAIN. IF NOT, PRINT SYSTEM ERROR.
ACNOP: CAIE A,ACESX3 ;"?PASSWORD IS REQUIRED"?
JRST CJERRE ;NO, OTHER ERROR. PRINT ERROR MESSAGE.
CALL PASLIN ;YES, GET PASSWORD ON NEW LINE.
MOVEM A,ACPASS ;STORE NEW PASSWORD POINTER
JRST DOACC ;TRY THE JSYS AGAIN
;"COPY" IS IN X2CMD.MAC.
;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.
.DAYTI::PRINT " "
MOVE A,COJFN ;DESTINATION
SETOB B,C ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT
ODTIM
ETYPE <%_>
RET
;DELETE <FILE GROUP>
.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN>
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
;**;[3023] REPLACE 2 LINES WITH 12 AT .DELET:+7.L DSW 11/26/85
PUSH P,Z ;[3023]SAVE FLAGS
TXO Z,IGINV ;[3023]FIND INVISIBLE FILES
CALL SPECFN ;[3023]DO PARSE ONLY
JRST [ POP P,A ;[3023]ERROR, GET FLAGS BACK
TXZ Z,IGINV ;[3023]AND SET IGINV AS BEFORE
TXNE A,IGINV ;[3023]
TXO Z,IGINV ;[3023]
JRST DELET1] ;[3023]
POP P,A ;[3023]SUCCESS, RESTORE FLAGS
TXZ Z,IGINV ;[3023]
TXNE A,IGINV ;[3023]
TXO Z,IGINV ;[3023]
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
CALL GNJFS ;STEP TO NEXT FILE
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: CALL GNJFS ;STEP TO NEXT
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
TXO Z,IGINV ;LET IT SEE INVISIBLE FILES
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRRZI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;NO SUBCOMMANDS
CALL SPECFN
JRST CERR ;DON'T ALLOW "STUFF,"
SETOM TYPGRP ;ALWAYS TYPE THE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;WHERE OUTPUT GOES
MOVE A,JBUFP
MOVEM A,.JBUFP
DISCA1: CALL RLJFNS ;RELEASE STRAY JFN'S
CALL NXFILE ;STEP TO NEXT FILE IN GROUP
JRST DISCA2 ;NO MORE IN THIS GROUP
CALL TYPIF ;DO NAME
CALL MFINP ;GET A SECOND JFN
JRST DISCA2 ;FAILED?
MOVX B,.ARDIS ;FUNCTION CODE FOR THE DISCARD
MOVX C,AR%CR1+AR%CR2 ;DO BOTH TAPES
ARCF
ERJMP DISCA9 ;FAILED...
CALL TYPOK ;TELL THE USER IT'S DONE
DISCA2: SKIPE INIFH1 ;DONE THEM ALL?
JRST DISCA1 ;NO, CONTINUE THE PROCESS
RET
DISCA9: ETYPE < %?
>
JRST DISCA2
;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
;**;[3016] Change 1 line at .EXPUN+5 DEE 15-OCT-85
;**;[3045] Change 1 line at .EXPUN+5 DEE 5-AUG-86
ERROR <No such directory> ;[3016][3045]
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
;**;[3045] Add a literal at EXPUN1:+1L DEE 5-AUG-86
;**;[3049] Rework code at EXPUN1: DEE 28-OCT-86
EXPUN1: CALL EXPDO ;GO EXPUNGE THIS DIRECTORY
JRST [CAIN B,STRX09 ;[3045] SOME ERROR - IS "STRUCTURE NOT MOUNTED"?
RET ;[3045] YES, THEN DON'T CONTINUE
JRST EXPUN2] ;[3045] [3049] SOME OTHER ERROR, KEEP GOING
EXPUN2: CALL TYPFRE ;[3049] NOW TELL PAGES FREED
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
;**;[3045] Add 1 line in literal at EXPDO:+6L DEE 5-AUG-86
ERJMP [TYPE <% > ;HANDLE ERROR
CALL %GETER ;GET ERROR CODE
MOVE A,ERCOD
MOVE B,A ;[3045] SAVE ERROR CODE
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
RETSKP ;[3049] RETURN AND CALL TYPFRE - NO LONGER FALL THRU
;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]
>
;**;[3049]Change one line at TYPFRE:+8L DEE 28-OCT-86
;**;[3045]Change one line at TYPFRE:+8L DEE 5-AUG-86
RET ;[3045] [3049] ALWAYS RETURN +1 FROM TYPFRE
;ROUTINE TO GET EXPUNGE SUBCOMMANDS
%EXPUN: SETZ Q1, ;CLEAR BITS
CALL SPRTR
SUBCOM $EXPUN ;SUBCOMMANDS, READ 'EM
RET
$EXPUN: TABLE
T DELETE,,.TEXP
T PURGE,,.NXEXP
T REBUILD,,.REBLD
TEND
.TEXP: NOISE <TEMPORARY FILES>
CONFIRM
TXO Q1,DD%DTF
RET
.NXEXP: NOISE <NOT COMPLETELY CREATED FILES>
CONFIRM
TXO Q1,DD%DNF
RET
.REBLD: NOISE <SYMBOL TABLE>
CONFIRM
TXO Q1,DD%RST
RET
;COMMENT (END WITH ^Z)
.REMAR::NOISE (MODE)
CONFIRM ;GET COMMAND CONFIRMATION
TYPE <Type remark. End with CTRL/Z.
>
STKVAR <<CMTXTB,10>>
SETZM .RDBFP+CMTXTB ;SAY NO BACKUP POINTER
SETZM .RDRTY+CMTXTB ;SAY NO ^R POINTER
COM1: MOVEI A,.RDBRK ;THIS MANY WORDS IN TEXTI BLOCK
MOVEM A,.RDCWB+CMTXTB
MOVX A,RD%JFN ;SAY WE'RE GIVING JFNS
MOVEM A,.RDFLG+CMTXTB
HRL A,CIJFN ;INPUT STREAM
HRR A,COJFN ;EDITING STREAM
MOVEM A,.RDIOJ+CMTXTB
HRROI A,BUF0 ;USE BUFFER SPACE FOR INPUT
MOVEM A,.RDDBP+CMTXTB
MOVX A,<BUFEND-BUF0+1>*5;THIS MANY CHARACTERS AVAILABLE IN BUFFER
MOVEM A,.RDDBC+CMTXTB
MOVEI A,[EXP 1B<3*8+2>,0,0,0] ;ONLY BREAK ON ^Z
MOVEM A,.RDBRK+CMTXTB ;SET UP BREAK MASK
MOVEI A,CMTXTB ;POINT TO BLOCK
TEXTI ;INPUT SOME OF THE COMMENT
ERCAL CJERRE ;FAILED, GO SEE WHY
MOVE A,.RDFLG+CMTXTB ;GET RESULTS
TXNE A,RD%BTM ;^Z TYPED YET?
JRST UNMAP ;YES, CLEAN UP AND RETURN
JRST COM1 ;NOT YET, READ MORE
.CLOSE::NOISE <JFN>
CRRX <Octal JFN number or blank for all>
CAIA ;NOT JUST "CLOSE<CR>"
JRST SHUT
OCTX <Octal JFN number> ;SEE IF OCTAL NUMBER
CMERRX ;NOT OCTAL NUMBER EITHER!
CONFIRM
PUSH P,B ;SAVE THE JFN
CALL CLOPAT ;GO UNMAP THE FILES IF PA1050 THERE
POP P,A ;PUT JFN IN A
CAIG A,MAXJFN ;ERROR IF THE JFN IS NOT WITHIN BOUNDS
SKIPG A
ERROR <Illegal JFN number>
CALL JFNREL
ERROR <JFN not in use>
RET
;ENTER HERE WITH JFN TO RELEASE IN A
JFNREL: TDZA D,D ;NO SPECIAL BITS
JFNRLA::LDF D,CZ%ABT ;CLOSE WITH ABORT
HRRZ A,A ;CLEAR LHS
GTSTS
TXNN B,GS%NAM ;ANYTHING IN THIS JFN?
RET ;NO, RETURN
ETYPE < %1P %1S > ;TYPE JFN AND NAME
CAIN A,.PRIIN ;PRIMARY INPUT?
JRST NRLPRI ;YES
CAIN A,.PRIOU ;PRIMARY OUTPUT?
JRST NRLPRO
CALL NOTIO ;MAKE SURE JFN ISN'T BEING USED FOR EXEC COMMAND INPUT OR OUTPUT
JRST NRLEX ;NAUGHTY, NAUGHTY, TRYING TO CLOSE COMMAND JFN!
TXNN B,GS%OPN ;OPEN?
JRST [ RLJFN
JRST JFNER1
JRST JFNOK1]
HLL A,D ;USE BITS IN D
CLOSF
JRST JFNER2
JFNOK1: GTSTS
TXNE B,GS%NAM ;NAME STILL THERE?
JRST JFNOK2
TYPE < [OK]
>
RETSKP
NRLPRI: TYPE < Primary input not closed
>
RETSKP
NRLPRO: TYPE < Primary output not closed
>
RETSKP
;USER TRIED TO CLOSE COMMAND JFN. SEE WHETHER INPUT OR OUTPUT TO
;GIVE FANCY MESSAGE.
NRLEX: TXNE B,GS%WRF ;OPEN FOR WRITE?
JRST NRLEXO ;YES, ASSUME OUTPUT JFN
JRST NRLEXI ;NO, ASSUME INPUT
NRLEXI: TYPE < EXEC command input not closed
>
RETSKP
NRLEXO: TYPE < EXEC command output not closed
>
RETSKP
JFNOK2: TXNE B,GS%OPN
TYPE < Can't close file
>
TXNN B,GS%OPN
TYPE < Can't release JFN
>
RETSKP
JFNER1: TYPE < Can't release JFN - >
CAIA
JFNER2: TYPE < Can't close file - >
CALL $ERSTR ;PRINT ERROR IN A
ETYPE <%_>
RETSKP
SHUT: CALL CLOPAT ;GO UNMAP THE PA1050 OPEN FILES
MOVEI A,MAXJFN ;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1: PUSH P,A
CALL JFNREL ;RELEASE JFN
JFCL ;IGNORE NOTHING THERE
POP P,A
SOJG A,SHUT1
RET
;ADVISE (TERMINAL/USER)
.ADVIS::TLO Z,F2 ;FLAG ADVISE
NOISE <USER>
JRST LINK0
.JILEN==.JILNO+1 ;ROOM FOR ALL JOB INFO WE MAY NEED
;TALK (TERMINAL/USER)
.TALK:: TLZ Z,F2
NOISE <TO>
LINK0: TRVAR <DOLNKF,<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVJNM,DIRNO>
MOVEM P,TFRAME ;SAVE BEGINNING OF POSSIBITITES
USERX <User name or terminal number>
JRST LTTY ;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
CONFIRM
MOVEM B,DIRNO ;SAVE USER NUMBER
TLZ Z,F1 ;NO DETACHED JOBS SEEN YET
MOVEM P,TFRAME ;SAVE BEG OF ARGS
HLLZ D,JOBRT ;MAKE AOBJN PTR
LINK3: MOVEI B,(D) ;GET JOB NUMBER BY ITSELF
CAME B,JOBNO ;LOOKING AT MY OWN JOB?
SKIPN B ;OR JOB 0?
JRST LINK6 ;YES, SKIP IT
CALL USERNO ;GET USER NUMBER
CAME A,DIRNO
JRST LINK6 ;WRONG GUY
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LINK6 ;AND SKIP IT IF DETACHED
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
GTB .JOBPN ;GET PROGRAM NAME
PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6: AOBJN D,LINK3 ;MAY HAVE MORE JOBS
CAMN P,TFRAME ;FOUND ANY?
JRST [ TLNE Z,F1
ERROR <User has detached jobs only
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 CHKLK1 ;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: TLZ Z,F4 ;Assume everything's gonna go OK.
CHKLK1: MOVE B,ADVTNM
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERJMPR [CAIN A,TTYX01 ;Failed because Line not active?
JRST CONN1 ; yes, ignore for now
CAIN A,TTMSX2 ;Was it because user has TERMINAL INHIBIT?
TLNE Z,F4 ;Yes, is this the second try?
JRST CJERRE ; yes, or not INHIBIT. Tell user what happened
JRST LKFAIL ] ;Let's try to link once more if we're WHEEL
AOSN DOLNKF ;GIVE ANNOUNCEMENT FIRST TIME
TYPE < [Advising]
>
CONN1: RET
LKFAIL: MOVX A,.FHSLF ;User has INHIBIT set, try to turn it off
RPCAP%
ERJMP INHERR ; shouldn't fail
TXNN C,<SC%WHL!SC%OPR> ;Do we have privs?
JRST CJERRE ; no, tell user we couldn't link and why
MOVE A,ADVTNM ;Get destination terminal number
MOVEI B,.MORTF
MTOPR% ;Read user's terminal inhibit word
ERJMP INHERR ;Couldn't, let user know we tried anyway.
MOVEI B,.MOSTF
TXZ C,MO%NTM ;Reset his TERMINAL INHIBIT bit
MTOPR%
ERJMP INHERR ;Couldn't
TLO Z,F4 ;Remember this is the second attempt
JRST CHKLK1 ;Try, try again!
INHERR: ERROR <Could not advise TTY, couldn't turn off TERMINAL INHIBIT status>
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]
>
TLNE Z,F4 ;Did we set user's terminal to NO INHIBIT?
JRST [ MOVE A,ADVTNM ; Yes, set it back to INHIBIT
MOVX B,.MORTF
MTOPR% ;Read terminal inhibit word
ERJMP CJERRE ; Shouldn't fail
MOVX B,.MOSTF
TXO C,MO%NTM ;Set TERMINAL INHIBIT bit, leave else the same.
MTOPR% ;Do it
ERJMP CJERRE
JRST .+1 ]
MOVEI Q1,ETTYMD
CALL LTTYMD ;RESTORE TTY MODES
MOVE B,ADVTNM ;GET TERMINAL WE WERE ADVISING
CALL BREAK1 ;BREAK LINKS
SETZM ADVFLG
MOVE A,ADVJFN ;GET SPECIAL JFN AGAIN
CLOSF ;RELEASE IT
ERCAL CJERRE ;SHOULDN'T FAIL
JRST ERRET ;ERROR RETURN TO TTY MODES RESET
;"LIST" IS WITH "TYPE" BELOW.
;LOGIN COMMAND
;LOGIN (USER) NAME (ACCOUNT) ACCOUNT (SESSION-REMARK) REMARK
;PASSWORD: PASSWORD
.LOGIN::TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT>
SKIPE CUSRNO
ERROR <You are already logged in>
;DECODE ARGUMENTS
;FIRST ARGUMENT: USER NAME
NOISE <USER> ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
SETZM LERRF ;NO ERROR YET
SETZM FSTLGN ;CLEAR FAST LOGIN FLAG
CALL FSTUSR ;READ USER NAME OR /FAST
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]
SETOM CEBPTR ;DON'T SAVE THE LOGIN COMMAND FOR COMMAND EDITOR
MOVEM A,RCBITS ;SAVE INFO RETURNED BY "RCDIR"
MOVEM C,LOGNO ;SAVE DIRECTORY NUMBER
CALL NOECHO ;NOISE STUFF WAITS FOR A CHARACTER!
NOISE (PASSWORD)
CALL PASFLD ;READ THE PASSWORD
MOVEM A,LPASP ;REMEMBER POINTER TO PASSWORD
NOISE <ACCOUNT>
MOVEI A,0 ;NO SPECIAL BITS FOR RCDIR
MOVE B,LOGNO ;USER NUMBER
SKIPE LERRF ;USER NAME CORRECT?
JRST LOGIN1 ;NO, SO DON'T TRY TO SET UP ACCOUNT DEFAULT
RCDIR ;GET LOGGED-IN DIRECTORY NUMBER
MOVE A,C ;PUT DIR NUMBER INTO A
MOVE B,LPASP ;GET POINTER TO PASSWORD
MOVEI C,LDBLK ;GET ADDRESS TO USE FOR CRDIR BLOCK
CALL GETDRP ;GET ACCOUNT FOR DEFAULT
JRST LOGIN1 ;FAILED, ASSUME NO DEFAULT
MOVEM A,CMDEF ;USE DEFAULT ACCOUNT AS DEFAULT FOR FIELD
ILDB A,A ;GET FIRST CHARACTER
CAIN A,0
LOGIN1: SETZM CMDEF ;NO DEFAULT
CALL ACCT ;INPUT AND DECODE ACCT # (USES A)
MOVEM A,LACCT ;SAVE FOR LOGIN JSYS
NOISE (SESSION-REMARK)
CALL GSR ;GET SESSION-REMARK
MOVE Q1,A ;SAVE POINTER TO SESSION-REMARK
CONFIRM ;CONFIRM THE WHOLE COMMAND
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN
GTAD ;SET UP MAIL WATCH INTERVAL HERE
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT ; IN CASE "MESMES" NEVER CALLED
SETOM MESMSF ;SAY TYPE "YOU HAVE A MESSAGE" IF APPROPRIATE,
;EVEN AFTER ^C'S
SKIPE A,LERRF ;ERROR ALREADY?
ERROR <%1?> ;YES, PRINT MESSAGE INSTEAD OF TRYING TO LOG IN
CALL PIOFF ;^C BETWEEN LOGIN AND CUSRNO SETUP WOULD BE EMBARRASING
MOVE C,LACCT ;ACCT # OR PTR THERETO
MOVE B,LPASP ;PASSWORD PTR
MOVE A,LOGNO ;USER #
MOVE D,C ;GET ACCT STRING
ILDB D,D ;LOOK AT FINAL ACCOUNT
SKIPN D ;HAVE ONE?
SETZM C ;NO. USE NOTHING
MOVEI D,0 ;RESERVE D FOR FUTURE FLAGS
LOGIN
JRST [ CAIN A,LGINX1
ERROR <Illegal account>
CAIN A,LGINX4
ERROR <Incorrect password>
CALL CJERRE] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
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
GJINF ;GET LOGGED-IN DIRECTORY NUMBER
MOVEM B,LIDNO ;SAVE IT.
;**:[3050] Remove one line at LOGIN1:+35 DEE 29-OCT-86
CALL PION ;ALLOW ^C NOW THAT CUSRNO IS SET UP
MOVE A,Q1 ;POINTER TO SESSION REMARK
CALL SSR ;SET SESSION-REMARK
;LOGIN...
;THE AUTOLOGOUT FOR USE TO GET KILLED HERE, NOW WE MUST KILL OFF THE
;PENDING TIMER CLOCK
MOVE A,[.FHSLF,,.TIMBF] ;DELETE ALL ENTRIES BEFORE GIVEN TIME
MOVE B,[377777,,-1] ;TIME WAY OUT IN THE BOONIES (WON'T
;CLOBBER ANY RUNTIME LIMIT SETTING
SETZ C,
TIMER
JFCL ;DON'T CARE IF NONE PENDING
;TYPE "JOB <N> ON LINE N <DATE> <TIME>"
ETYPE < Job %J on %L %D %E, Last Login >
MOVEI A,LDBLK ;GET ADDRESS OF THE DIRECTORY BLOCK
SKIPN A,.CDLLD(A) ;GET THE TIME AND DATE OF LAST LOGIN
IFSKP.
ETYPE <%1W
> ;EOL NEEDED BEFORE LOGIN MESSAGE
ELSE.
ETYPE <Never
>
ENDIF.
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
;COME TO TAKSYS FOR SETTING UP DIRECTORY/FILENAME STRING FOR SYSTEM: COMMAND FILES
;TAKEIN SETS UP FOR USER'S COMMAND FILES
TAKSYS::STKVAR <<TAKBUF,FILWDS>,SPB>
MOVEM B, SPB ;SAVE THE FILENAME STRING
HRROI A, TAKBUF ;PUT STRING HERE
SETZ C,
SOUT
ERJMP CJERR ;SHOULDN'T FAIL
MOVEI C,(GJ%PHY) ;ALLOW SYSTEM-WIDE LOGICALS ONLY
JRST TAKEI2
TAKEIN::STKVAR <<TAKBUF,FILWDS>,SPB>
MOVEM B,SPB ;SAVE STRING POINTER
MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
HRROI A,TAKBUF ;GET STRING SPACE POINTER
CAMN B,[-1] ;DEFAULT?
JRST TAKEI1 ;YES, SKIP DIR
DIRST ;STORE DIR STRING
CALL JERR ;WE JUST SCANNED IT?!
TAKEI1: MOVE B,A
MOVE A,SPB
SETZ C, ;READ TO NULL
SIN ;APPEND TO STRING
TAKEI2: 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]
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
SETOM CEBPTR ;DON'T SAVE PASSWORD FOR COMMAND EDITOR
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
WORDX <Password> ;READ NON-NULL PASSWORD
CMERRX
RET
;MESMES
;SUBROUTINE TO TYPE "YOU HAVE A MESSAGE" IF FLAG "MESMSF" IS ON AND
;THERE IS A MESSAGE FILE IN CONNECTED DIRECTORY.
;USED IN LOGIN, MAIN LOOP. CLOBBERS A,B,C.
MESMES::SKIPN CUSRNO
JRST MESMS9 ;IGNORE IF NOT LOGGED IN
SKIPE BATCHF ;DON'T CHECK FOR MESSAGES IN BATCH (TO SAVE TIME)
JRST MESMS9 ;YES, SKIP MESSAGES
CALL CHKDAL ;NOTE OVER ALLOCATION IN PRESENT FIRST
HRLOI B,377777 ;SET INF COUNT FOR US
MOVEM B,MWATN0
;**;[3040] Change one line at MESMES::+7L DEE 23-Jun-86
MOVE B,POBXNO ;[3040] 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
CAIN C,(GJ%PHY) ;WANT SYSTEM LOGICALS ONLY?
MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC!GJ%PHY) ; YES, TELL GTJFN
SETZ C, ;RESET FOR USER CASE
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::SKIPE LGORET ;ARE WE ALREADY TAKING LOGOUT.CMD?
JRST ERRFIN ;YES. CAN'T SAY "LOGOUT" IN LOGOUT.CMD (MUCH LOOPING)
MOVE A, TAKLEN ;WE NEED TO GET OUR CURRENT I/O (TAKE FILE) LEVEL
MOVEM A, SAVTAK ;AND SAVE IT FOR LATER
SETZM FSTOUT ;INIT FAST LOGOUT FLAG
SKIPN CUSRNO ;LOGGED IN?
IFNSK.
CONFIRM ;REQUIRE CONFIRM
JRST LOGOU1
ENDIF.
MOVEI B,[FLDDB. .CMNUM,CM%SDH,12, <Job number, to log out another job >,,[
FLDDB. .CMCFM,CM%SDH,,<Carriage return, to log out this job >,,[
FLDDB. .CMSWI,CM%SDH!CM%DPP,FLOTAB,</FAST to log out this job quickly >, <FAST>]]]
CALL FLDSKP
CMERRX
LDB C,[POINT 9,0(C),8]
CAIN C,.CMSWI ;GOT A SWITCH?
JRST LGOFS1 ;YES,SET UP FOR FAST LOGOUT
CAIN C, .CMCFM ;CARRIAGE RETURN?
JRST LOGOU1 ;YES, LOG OUT THIS JOB
MOVE A,B ;PUT JOB NUMBER IN A
JRST ..LOGO ;GO LOG OUT REMOTE JOB
LOGOU1: XTND,<
CALL BLANK1 ;CLEAR SCREEN
CALL DWNPNT ;TELL USER WHEN SYSTEM WILL GO DOWN
>
SKIPN CUSRNO
JRST LOGOU2
SKIPE FSTOUT ;USER WANT FAST LOGOUT?
JRST LGOFST ;YES, BYPASS .CMD FILES
;SEE IF THERE'S A SYSTEM:LOGOUT.CMD, THEN TRY FOR USER'S LOGOUT.CMD
SETOM LGORET ;SET THE "TAKING LOGOUT.CMD" FLAG
HRROI B, [ASCIZ/SYSTEM:LOGOUT.CMD/]
CALL TAKSYS ;SEE IF IT'S THERE
CAIA ;PROBABLY NO SUCH FILE
CALL CMDOUT ;IT'S THERE, GO DO IT
HRROI B, [ASCIZ "LOGOUT.CMD"]
CALL TAKEIN ;SEE IF USER'S LOGOUT.CMD IS THERE
CAIA ;GUESS THEY DON'T HAVE ONE
CALL CMDOUT ;IT'S THERE - GO DO IT
SETZM LGORET ;DONE WITH LOGOUT.CMD FILES - RESET THE FLAG
LGOFST: GJINF ;GET CONNECTED DIRECTORY NUMBER
CAMN B,LIDNO ;DIFFERENT FROM LOGGED-IN ONE?
JRST LOGOU3 ;NO SO DON'T BOTHER EXPUNGING CONNECTED DIR
LDF A,DD%DTF ;FLUSH TEMPORARY FILES
DELDF ;EXPUNG CONNECTED DIR
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE <%_>
JRST .+1]
CALL CHKDAL ;NOW CHECK IT
LOGOU3: MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
LDF A,DD%DTF ;FLUSH TEMPORARY FILES ALSO
DELDF
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE <%_>
JRST .+1]
MOVE A,LIDNO
GTDAL ;GET USAGE/ALLOCATION
ERJMP [TYPE <%Warning -- Disk allocation info not available...>
ETYPE <%_>
JRST LOGOU2]
JUMPE B,LOGOU2 ;CAN'T BE OVER IF USAGE=0
SUB B,C ;SUBTRACT PERMANENT ALLOCATION FROM USAGE
JUMPLE B,LOGOU2 ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
LOGOU2: TLO Z,LOGOFF ;SAY LOGGING OUT (TELLS ERROR AND ^C
;ROUTINES TO SAY "NOT LOGGED OUT AFTER ALL").
MOVE A,COJFN
DOBE ;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.
;SET MAP TO "USER"
SETO A, ;SAY IT'S SUICIDE
LGOUT
CALL CJERR
;DOESN'T RETURN ON SUCCESS
;HERE TO SET UP IF /FAST SWITCH SEEN - USER DOESN'T WANT LOGOUT.CMD FILES TAKEN
LGOFS1: CONFIRM
SETOM FSTOUT ;SET THE "FAST LOGOUT" FLAG
JRST LOGOU1 ;AND CONTINUE LOGOUT PROCESS
FLOTAB: TABLE
[ASCIZ/FAST/],,0
TEND
;"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. RTFLG1 can be called with a terminal number in A.
RTTFLG::MOVEI A,.CTTRM
RTFLG1::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>
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
SETZM A ;NOT COPYING FILES
CALL MFSET ;SET UP OUTPUT TERM
JRST [ CALL GNFIL ;ERROR, MESSAGE ALREADY PRINTED
SETZM INIFH1 ;CLEAR WHEN NO MORE
JRST RENAM2]
CALL MFINP ;GET SECOND JFN ON INPUT JFN
JRST RENAM2
HRRZ B,OUTDSG ;GET OUTPUT DESCRIPTOR
RNAMF ;RENAME FILE
ERJMP [LERROR <%1?> ;TELL USER WHY IT FAILED
JRST RENAM2] ;GO ON TO NEXT FILE
CALL TYPOK
RENAM2: SKIPE INIFH1 ;DID LAST GNFIL HIT END?
JRST RENAM1 ;NO
RET
;REQUEST A FILE BE RETRIEVED FROM OFFLINE STORAGE
.RETRI::STKVAR <NRETR>
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,0 ;DEFAULT VERSION IS 0
HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
TXZ Z,IGINV
RETRI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
SETZM NRETR ;KEEP TRACK OF HOW MANY RETRIEVED
RETRI3: CALL RLJFNS
CALL NXFILE
JRST RETRI4
CALL MFINP ;GET 2ND JFN
JRST RETRI4 ;FAILED
MOVE B,[1,,.FBCTL]
MOVEI C,C ;FIND OUT IF FILE IS OFFLINE
GTFDB
ERJMP RETRI4 ;SKIP FILE IF CAN'T FIND OUT
TXNN C,FB%OFF ;IS IT OFFLINE?
JRST RETRI4 ;NO, CAN'T POSSIBLEY RETRIEVE IT
ETYPE < %1S> ;TYPE FILE NAME - SHOULD USE TYPIF
;BUT NXFILE MAY HAVE STEPPED US OFF
;THE END CAUSING TYPIF TO LOSE BIG
MOVEI B,.ARRFR ;REQUEST TO RETRIEVE IT
SETZ C, ;NO FLAGS
ARCF
ERJMP [ETYPE < %?
>
JRST RETRI4]
CALL TYPOK
AOS NRETR ;REMEMBER HOW MANY
RETRI4: SKIPE INIFH1 ;DONE THEM ALL?
JRST RETRI3 ;NO, LOOP
SKIPN NRETR ;DON'T BE TOO QUIET IF NOTHING DONE
ETYPE <%%No files found for retrieving%_>
RET
;SEND (MESSAGE) TO SPECIFIC USER ON THE SYSTEM (UNPRIVILEGED)
.USEND::SKIPE PRVENF ;ENABLED?
JRST .SEND ;YES - BEHAVE THE SAME AS ^ESEND
NOISE (TO)
MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,[
FLDDB. .CMNUM,CM%SDH,8]]
CALL FLDSKP ;GET THE TO FIELD
CMERRX ;CAN'T
TRVAR <SNDPT,SNDPTC,SNDLNO,USRNO,SAVP>
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIE C,.CMUSR ;GOT A USER NAME ?
IFSKP.
MOVEM B,USRNO ;SAVE THE USER NUMBER
MOVEI B,-1 ;NOTE USER NAME WITH -1 IN RIGHT HALF ONLY
ENDIF.
CAIE C,.CMNUM ;LINE # ?
IFSKP.
SKIPL B ;CHECK FOR BIT 0
CAIL B,-1 ;LESS THAN 777777
ERROR <Invalid terminal number> ;NO OR BIT 0 ON
ENDIF.
SETZM SNDPT ;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
;^ESEND (MESSAGE) TO ALL ON SYSTEM
.SEND:: NOISE (TO)
MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,
[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,,,
[FLDDB. .CMNUM,CM%SDH,8]]]
CALL FLDSKP ;GET THE TO FIELD
CMERRX ;CAN'T
TRVAR <SNDPT,SNDPTC,SNDLNO,USRNO,SAVP>
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIE C,.CMUSR ;GOT A USER NAME ?
IFSKP.
MOVEM B,USRNO ;SAVE THE USER NUMBER
MOVEI B,-1 ;NOTE USER NAME WITH -1 IN RIGHT HALF ONLY
ENDIF.
CAIN C,.CMTOK ;GOT A STAR ?
SETO B, ;NOTE "*" WITH -1
CAIE C,.CMNUM ;LINE # ?
IFSKP.
SKIPL B ;CHECK FOR BIT 0
CAIL B,-1 ;LESS THAN 777777
ERROR <Invalid terminal number> ;NO OR BIT 0 ON
ENDIF.
SENDA: 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
HRRI 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: CALL LINCHK ;CHECK THE LINE NUMBER
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
;HERE TO CHECK THE LINE NUMBER TO SEE IF IT'S REALLY THE USER FLAG
LINCHK: MOVE A,SNDLNO ;GET THE LINE NUMBER
CAIE A,-1 ;GOT USER ARGUMENT ?
RET ;NO
MOVEM P,SAVP ;SAVE THE CURRENT STACK POINTER
TLZ Z,F1!F2 ;INIT FLAGS
HLLZ D,JOBRT ;-# OF JOBS AS AOBJN CNTR
LICK2: CALL USERNO ;GET USER # OF JOB IN D
CAME A,USRNO ;IS IT THE ONE WE WANT?
JRST LICK3 ;NO
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LICK3 ;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.)
LICK3: AOBJN D,LICK2 ;LOOP THRU ALL JOBS
CAME P,SAVP ;FOUND ANY?
IFSKP.
TLNE Z,F1
ERROR <User has detached jobs only, Send mail instead>
ERROR <User is not logged in, Send mail instead>
ENDIF.
POP P,A ;SUBSYSTEM NAME
POP P,B ;TTY#
CAMN P,SAVP ;ONLY ONE POSSIBILITY?
JRST LICK9 ;YES - USE IT
LICK7: ETYPE < TTY%2O%, running >
JUMPE A,[PRINT "?" ;GOT PROGRAM NAME ? NO
JRST LINK8]
CALL SIXPRT ;YES - PRINT SUBSYSTEM
LICK8: ETYPE <%_>
CAMN P,SAVP ;DONE ALL?
IFSKP.
POP P,A ;NO - NOT YET - GET PROGRAM NAME
POP P,B ;GET TTY
JRST LICK7
ENDIF.
PROMPT <TTY: >
OCTX <Terminal number>
CMERRX ;NON-OCTAL NUMBER TYPED
LICK9: MOVEM B,SNDLNO ;SAVE THE LINE NUMBER
TRO B,.TTDES ;MAKE LINE DESIGNATOR
MOVE A,B ;PUT WHERE GETJI LIKES LINE #
MOVE B,[-1,,A] ;PUT 1 WORD IN AC A
MOVEI C,.JIUNO ;THAT WORD IS USER NUMBER
GETJI ;GET IT
CMERRX
CAME A,USRNO ;SAME USER NAME THAT WAS ORIGNALLY WANTED ?
ERROR <Terminal number does not belong to specified user>
RET ;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
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
;HERE IF "TAKE" SEEN WITH NO FILESPEC - WILL SUPPRESS "END OF filespec" MESSAGE
PRIRES: SKIPE LGORET ;ARE WE LOGGING OUT? (i.e.,"TAKE" AT END OF LOGOUT.CMD)
JRST PRIR01 ;YES, DO THIS A LITTLE DIFFERENTLY
CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
RET ;NOTHING TO CLOSE (WE'RE AT TOP LEVEL)
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL
RET
PRIR01: CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
JRST @LGORET ;NO LEVEL TO CLOSE - KEEP ON LOGGIN' OUT
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL HERE, EITHER
MOVE A, TAKLEN ;SEE WHAT LEVEL WE'RE ON NOW
CAME A, SAVTAK ;SAME AS WHEN WE ENTERED "LOGOUT" PROCESSING?
RET ;NO, MUST BE MORE TO DO (TAKING A FILE INSIDE LOGOUT.CMD)
JRST @LGORET ;YES - ALL DONE NOW, KEEP LOGGING OUT
;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
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
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
CAMGE 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
END