Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/execse.mac
There are 47 other files named execse.mac in the archive. Click here to see a list.
;<4.EXEC>EXECSE.MAC.129, 3-Jan-80 16:07:31, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 94, SNARK:<4.EXEC>EXECSE.MAC.128, 5-Dec-79 10:30:28 by OSMAN
;TCO 4.2589 - Change $DEFAU symbol to TDEFAU
;<4.EXEC>EXECSE.MAC.127, 12-Sep-79 15:35:33, Edit by HESS
; Fix mail-watch timers init (XTND only)
;<4.EXEC>EXECSE.MAC.126, 10-Sep-79 17:56:01, Edit by HESS
; TIMER JSYS requires valid chl even if clearing (See .AUTO2 , XTND only)
;<4.EXEC>EXECSE.MAC.125, 5-Sep-79 13:37:45, EDIT BY OSMAN
;TCO 4.2443 - Fix SET DIRECTORY PASSWORD
;<4.EXEC>EXECSE.MAC.124, 5-Sep-79 09:34:58, EDIT BY OSMAN
;tco 4.2439 - Don't run QUENCH on SET DIRECTORY PASSWORD
;<4.EXEC>EXECSE.MAC.123, 4-Sep-79 14:31:13, Edit by HESS
; Have SET NO ALERT<CR> clear all alerts (XTND only)
; Always ring bell on alert / Fix help message.
;<4.EXEC>EXECSE.MAC.121, 31-Aug-79 16:02:48, EDIT BY OSMAN
;MORE 4.2404 - Don't prompt for password unless it was not given and that's
;what's wrong.
;<4.EXEC>EXECSE.MAC.120, 30-Aug-79 17:58:10, Edit by HESS
; Add "SET NO LOGIN-MAIL" under XTND
;<HESS.E>EXECSE.MAC.23, 21-Aug-79 12:51:42, Edit by HESS
; Add extended features
;<4.EXEC>EXECSE.MAC.117, 16-Aug-79 10:14:46, EDIT BY OSMAN
;tco 4.2404 - Don't ask for password on SET DIRECTORY unless it fails without it
;<4.EXEC>EXECSE.MAC.115, 10-Aug-79 15:21:28, EDIT BY OSMAN
;tco 4.2385 - Allow escape and filespec after SET FILE INVIS FOO
;<4.EXEC>EXECSE.MAC.113, 1-Aug-79 10:22:00, EDIT BY OSMAN
;CHANGE $SETNO TO $SETN SINCE TRVAR OF SETNOF GENERATES $SETNO
;<4.EXEC>EXECSE.MAC.111, 1-Aug-79 10:12:33, EDIT BY OSMAN
;tco 4.2361 - Disallow SET NO DEFAULT TAKE
;MAKE SETNOF BE LOCAL
;<4.EXEC>EXECSE.MAC.110, 1-Aug-79 09:43:29, EDIT BY OSMAN
;tco 4.2360 - Handle illegal instruction trap on SET PAGE-ACCESS 2000
;<4.EXEC>EXECSE.MAC.109, 9-Jul-79 13:20:00, EDIT BY EKLUND
;check valid values for SET TAPE RECORD-LENGTH command
;<4.EXEC>EXECSE.MAC.108, 21-Jun-79 13:31:07, EDIT BY OSMAN
;REMOVE EXTRANEOUS CALLS TO RLJFNS
;tco 4.2304 - remove TAPE-RECYCLE commands
;<4.EXEC>EXECSE.MAC.107, 21-Jun-79 13:20:54, EDIT BY OSMAN
;put SET RETRIEVAL WAIT back in
;<4.EXEC>EXECSE.MAC.106, 19-Jun-79 13:10:15, EDIT BY OSMAN
;really do TCO 4.2268!
;<4.EXEC>EXECSE.MAC.105, 1-Jun-79 14:51:37, EDIT BY OSMAN
;tco 4.2268 - remove ^Eset retrieval-wait and ^Eset bias-control
;<4.EXEC>EXECSE.MAC.103, 2-Apr-79 13:30:56, EDIT BY OSMAN
;tco 4.2223 - CATCH "^ESET TERMINAL 4000 ..."
;<4.EXEC>EXECSE.MAC.102, 13-Mar-79 16:19:44, EDIT BY OSMAN
;remove all ^ESET STR commands. (They are being moved to OPR)
;<4.EXEC>EXECSE.MAC.101, 12-Mar-79 18:05:17, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECSE.MAC.100, 8-Feb-79 15:49:08, EDIT BY OSMAN
;ADD SET [NO] DEFAULTS (FOR) PLOT
;<4.EXEC>EXECSE.MAC.99, 8-Feb-79 13:31:00, EDIT BY OSMAN
;tco 4.2184 - Fix "^ESET NO RUNTIM-GUARANTEE" which used to work.
;<4.EXEC>EXECSE.MAC.97, 7-Feb-79 21:40:21, EDIT BY KIRSCHEN
;MAKE SET DEFAULT TAKE WORK AS PER EXEC.MEM SPEC
;<4.MONITOR>EXECSE.MAC.1, 7-Feb-79 10:40:06, EDIT BY OSMAN
;ON "SET LOCATION", MERELY DON'T HAVE A DEFAULT IF NO DECNET PRESENT
;<4.EXEC>EXECSE.MAC.94, 1-Feb-79 19:02:05, EDIT BY ACARLSON
;DELETE ^ESET DEBUG FUNCTION TO APPEASE BIG WIGS (CODE FREEZE)
;<4.EXEC>EXECSE.MAC.92, 1-Feb-79 14:20:29, EDIT BY HURLEY.CALVIN
; Clean up code in SET FILE PROHIBIT so nonx file doesn't blow up
;<4.EXEC>EXECSE.MAC.91, 31-Jan-79 20:29:02, EDIT BY ACARLSON
;Add ^ESET DEBUG (FOR PRIVATE GALAXY SYSTEM) ALSO 'NO DEBUG'
;<4.EXEC>EXECSE.MAC.89, 26-Jan-79 15:26:08, EDIT BY OSMAN
;put SET FILE INVISIBLE back in (take it out of XARC)
;<4.EXEC>EXECSE.MAC.88, 25-Jan-79 15:26:00, EDIT BY OSMAN
;AT PAC7, IT SHOULD BE ERCAL, NOT ERJMP
;<4.EXEC>EXECSE.MAC.87, 23-Jan-79 15:16:19, EDIT BY OSMAN
;ALLOW SET FILE [NO] PROHIBIT
;<4.EXEC>EXECSE.MAC.86, 22-Jan-79 10:07:51, EDIT BY OSMAN
;PUT XARC AROUND ONLINE-EXPIRED-FILES
;<4.EXEC>EXECSE.MAC.84, 18-Jan-79 18:06:14, EDIT BY OSMAN
;PUT XARC AROUND SET FILE EXPIRED/ON[OFF]LINE-EXPIRATION, SET DIR ONLINE-EXPIRATION-DEFAULT
;<4.EXEC>EXECSE.MAC.83, 18-Jan-79 17:57:26, EDIT BY OSMAN
;PUT XARC AROUND SET FILE [NO] RESIST/PROHIBIT/VISIBLE/INVISIBLE
;<4.EXEC>EXECSE.MAC.78, 16-Jan-79 18:22:35, EDIT BY OSMAN
;DEFAULT NODE NAME TO HOST NAME IN SET LOCATION
;<4.EXEC>EXECSE.MAC.77, 15-Jan-79 02:43:18, EDIT BY HEMPHILL
;MAKE "SET ADDRESS-BREAK" HANDLE LARGE ADDRESSES
;<4.EXEC>EXECSE.MAC.74, 5-Dec-78 11:26:26, EDIT BY OSMAN
;PUT IN ^ESET BIAS-CONTROL (FOR SCHEDULER)
;<4.EXEC>EXECSE.MAC.73, 1-Dec-78 11:41:04, EDIT BY KIRSCHEN
;<4.EXEC>EXECSE.MAC.72, 1-Dec-78 11:20:40, EDIT BY KIRSCHEN
;<4.EXEC>EXECSE.MAC.71, 1-Dec-78 10:41:01, EDIT BY KIRSCHEN
;ADD SET [NO] DEFAULT TAKE
;<4.EXEC>EXECSE.MAC.70, 29-Nov-78 14:54:06, EDIT BY OSMAN
;FIX ^ESET STRUCTURE DISMOUNTED (CHANGE ERCAL TO CALL)
;<4.EXEC>EXECSE.MAC.69, 17-Nov-78 18:44:40, EDIT BY HURLEY.CALVIN
; Fix SET FILE VISIBLE - MOVE A,@INIFH1 becomes HRRZ A,@INIFH1
;<4.EXEC>EXECSE.MAC.67, 10-Nov-78 09:10:49, EDIT BY OSMAN
;fix alphabetical order of set no defaults paper-tape/print, and remove garbage from table
;<4.EXEC>EXECSE.MAC.66, 7-Nov-78 05:18:00, Edit by CALVIN
; SAVE VIS/INVIS PARAMETER EARLIER SINCE SOMEONE NOW SEEMS TO CLOBBER IT
;<4.EXEC>EXECSE.MAC.65, 6-Nov-78 20:04:40, Edit by CALVIN
; CAUSE SET FILE VISIBLE TO PRINT ONLY FILES ACTUALLY BEING MADE VISIBLE
;<4.EXEC>EXECSE.MAC.64, 30-Oct-78 14:30:27, EDIT BY OSMAN
;FIX SET STR IGNORED (FORGOT TO CALL GOPID BEFORE SNDMSG)
;<4.EXEC>EXECSE.MAC.61, 26-Oct-78 15:56:39, EDIT BY OSMAN
;REMOVE REFS TO SSSBLK, GSSBLK, NAMBLK. MAKE THESE LOCAL VARIABLES
;<4.EXEC>EXECSE.MAC.60, 25-Oct-78 17:09:46, EDIT BY OSMAN
;CHANGE NETOFF TO NETFF (WAS GETTING M FROM MACRO)
;<4.EXEC>EXECSE.MAC.59, 25-Oct-78 16:16:13, EDIT BY OSMAN
;ADD SET LOCATION
;<ARC-DEC>EXECSE.MAC.7, 23-Aug-78 10:15:54, EDIT BY CALVIN
; Add ^ESet TAPE-RECYCLE-PERIOD and ^ESet ARCHIVE-TAPE-RECYCLE-PERIOD
;<CALVIN>EXECSE.MAC.9, 11-Aug-78 15:23:16, EDIT BY CALVIN
; Install ^ESET [NO] RETRIEVAL-WAITS & SET DIR [NO] ARCHIVE-ONLINE...
;<CALVIN>EXECSE.MAC.7, 11-Aug-78 12:01:27, EDIT BY CALVIN
; Install Set file [no] prohibit/resist <files>, also fixup pagination
;<CALVIN>EXECSE.MAC.4, 9-Aug-78 15:54:20, EDIT BY CALVIN
; Install SET DIRECTORY OFF/ON-EXPIRATION-DEFAULT commands
;<CALVIN>EXECSE.MAC.3, 9-Aug-78 14:05:01, EDIT BY CALVIN
; Install SET FILE OFFLINE-EXP/ONLINE-EXP/EXPIRED commands
;[BBN-TEN; Add SET FILE VISIBLE/INVISIBLE <Files>
;<3-ARC-EXEC>EXECSE.MAC.2, 14-May-78 15:59:32, Edit by MTRAVERS
; Added SET [NO] RETRIEVAL-WAIT
;<3-ARC-EXEC>EXECSE.MAC.1, 14-May-78 15:38:30, Edit by MTRAVERS
; Added SET FILE VISIBLE/INVISIBLE to command tables
;<4.EXEC>EXECSE.MAC.52, 7-Oct-78 00:43:48, EDIT BY OSMAN
;TCO 4.2037 - Smarten up SET PAGE-ACCESS
;FIX SET PAGE-ACCESS
;<4.EXEC>EXECSE.MAC.48, 1-Oct-78 19:44:32, Edit by OSMAN
;REMOVE CALL GETPID AT SIG1+n
;GET RID OF B0 SYMBOLS
;<4.EXEC>EXECSE.MAC.46, 25-Sep-78 10:46:06, EDIT BY OSMAN
;REMOVE SET OLD/NEW-QUEUE-COMMANDS
;CHANGE ONEWD TO ONEWRD, NOLOG TO NOLG
;<4.EXEC>EXECSE.MAC.44, 17-Sep-78 16:49:58, EDIT BY OSMAN
;CHANGE $SET TO $SET0 ($SET IS A MACRO IN GLXMAC)
;<4.EXEC>EXECSE.MAC.43, 16-Sep-78 00:03:20, EDIT BY OSMAN
;REMOVE REFS TO CSBUFP
;<4.EXEC>EXECSE.MAC.42, 15-Sep-78 13:32:19, EDIT BY OSMAN
;Make tape densities global ($TDENS)
;<4.EXEC>EXECSE.MAC.41, 14-Sep-78 14:13:30, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECSE.MAC.40, 21-Aug-78 16:47:12, EDIT BY HELLIWELL
;REMOVE "SET EDITOR"
;<4.EXEC>EXECSE.MAC.39, 14-Aug-78 15:15:58, Edit by HELLIWELL
;ADD EMACS TO SET EDITOR UNDER NOSHIP
;<4.EXEC>EXECSE.MAC.38, 13-Aug-78 15:22:40, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.37, 13-Aug-78 14:57:58, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.36, 13-Aug-78 14:47:13, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.35, 13-Aug-78 14:39:45, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.34, 13-Aug-78 14:34:31, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.33, 13-Aug-78 14:28:59, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.32, 13-Aug-78 14:22:59, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.31, 13-Aug-78 14:19:24, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.30, 13-Aug-78 14:07:24, Edit by HELLIWELL
;ADD "SET EDITOR"
;<4.EXEC>EXECSE.MAC.29, 21-Jul-78 10:30:42, Edit by PORCHER
;FIX SET PAGE ACCESS ... NONEXISTENT WITH EX-ONLY PROCESSES
;<4.EXEC>EXECSE.MAC.25, 17-Jul-78 11:46:01, EDIT BY OSMAN
;REMOVE REFS TO GTBUF (USE LOCAL STORAGE INSTEAD)
;<4.EXEC>EXECSE.MAC.24, 13-Jul-78 14:16:48, EDIT BY OSMAN
;MAKE PASSP LOCAL
;<4.EXEC>EXECSE.MAC.23, 11-Jul-78 17:00:39, EDIT BY OSMAN
;USE LOCAL STORAGE FOR ^ESET TERMINAL
;<4.EXEC>EXECSE.MAC.22, 29-Jun-78 15:58:50, EDIT BY OSMAN
;make dirp local
;<4.EXEC>EXECSE.MAC.21, 29-Jun-78 15:35:42, EDIT BY OSMAN
;make cdrdev, cdrstr, cdrdck be trvar'd
;<4.EXEC>EXECSE.MAC.20, 23-Jun-78 21:21:12, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMS: CRDINF, NOCDCK, STRCHK
;<4.EXEC>EXECSE.MAC.15, 22-Jun-78 14:28:49, EDIT BY OSMAN
;USE TIMER FOR MAIL-WATCH (AVOIDS DOING GTAD BEFORE EVERY COMMAND)
;<4.EXEC>EXECSE.MAC.13, 15-Jun-78 14:17:18, EDIT BY OSMAN
;ADD SET NO DEFAULT COMPILE-SWITCHES
;<4.EXEC>EXECSE.MAC.12, 13-Jun-78 14:20:28, EDIT BY OSMAN
;CHANGE COMPILER-SWITCHES TO COMPILE-SWITCHES
;<4.EXEC>EXECSE.MAC.11, 9-Jun-78 18:41:11, EDIT BY OSMAN
;ADD SET DEFAULT COMPILER-SWITCHES
;<4.EXEC>EXECSE.MAC.8, 9-Jun-78 18:08:52, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<3-EXEC-SNARK>EXECSE.MAC.72, 20-Apr-78 11:14:50, Edit by FORTMILLER
;<3-EXEC-SNARK>EXECSE.MAC.71, 20-Apr-78 11:09:53, Edit by FORTMILLER
;<FORTMILLER>EXECSE.MAC.70, 14-Apr-78 09:07:46, Edit by FORTMILLER
;<4.EXEC>EXECSE.MAC.4, 31-May-78 16:47:36, EDIT BY OSMAN
;<4.EXEC>EXECSE.MAC.3, 31-May-78 16:45:19, EDIT BY OSMAN
;ADD SET DEFAULT CPUNCH AND SET DEFAULT TPUNCH
;<4.EXEC>EXECSE.MAC.2, 2-Mar-78 09:41:44, Edit by PORCHER
;Remove time used from SET ACCOUNT
;<4.EXEC>EXECSE.MAC.1, 1-Feb-78 09:51:20, Edit by PORCHER
;Add ERJMPs for execute-only
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH XDEF
TTITLE EXECSE
;THIS FILE CONTAINS
;SET AND ^ESET COMMANDS
DEFINE SETSTG
< TRVAR <WBITS,SETNOF,CDRDEV,CDRSTR,CDRDCK,DIRP,PASSP,<SEBLK,GTDLN>,SPERF,SPCNT,SPPAG,SPERR,ACDIR> ;KEEP DEV,STR,DCK IN ORDER FOR JSYS
>
;"ESET" AND "ESET NO"
ESET:: SETSTG ;ALLOCATE LOCAL STORAGE
SETZM SETNOF ;CLEAR NO FLAG
KEYWD $ESET
0
JRST CERR
TXNN P3,NOLG ;NEED TO BE LOGGED IN?
SKIPE CUSRNO ;YES, ARE WE?
CAIA ;OK
ERROR <LOGIN please>
TXNE P3,ONEWRD ;COMMAND TO BE CONFIRMED HERE?
CONFIRM ;YES
JRST (P3) ;DISPATCH TO COMMAND
;"SET" AND "SET NO"
.SET:: SETSTG ;ALLOCATE STORAGE
SETZM SETNOF ;CLEAR NO FLAG
KEYWD $SET0
0
JRST CERR
TXNN P3,NOLG ;NEED TO BE LOGGED IN?
SKIPE CUSRNO ;YES, ARE WE?
CAIA ;OK
ERROR <LOGIN please>
TXNE P3,ONEWRD ;COMMAND TO BE CONFIRMED HERE?
CONFIRM ;YES
JRST (P3) ;DISPATCH TO COMMAND
;SET ACCOUNT
.CHANG::
NOISE <TO> ;OR STRING.
CALL ACCT ;INPUT, CHECK, CONVERT ACCT INTO A (USES A B1)
PUSH P,A ;SAVE POINTER TO ACCOUNT
NOISE (SESSION REMARK)
CALL GSR ;GET SESSION REMARK
EXCH A,(P) ;GET ACCOUNT, SAVE REMARK
CONFIRM
CACCT ;JSYS TO CHANGE ACCOUNT #
CALL CJERR
POP P,A ;GET SESSION REMARK POINTER
CALL SSR ;SET SESSION REMARK
JRST CMDIN4
;ACCOUNT (OF FILE) <NAME> (IS) <ACCOUNT # OR STRING>
.ACCOU::NOISE <OF FILES>
CALL INFGNS ;* VERSION, NO SEARCH, GROUP OK
MOVE B,INIFH1 ;START HERE
MOVEM B,OUTDSG
CAIA
ACCOU3: AOS B,OUTDSG
CAMLE B,INIFH2 ;ALL GONE YET?
JRST [ MOVX A,1B1 ;INDICATE STRING ACCOUNT
JRST ACCOU4]
HRRZ A,(B)
CAIN A,-2 ;FOUND REAL JFN YET?
JRST ACCOU3 ;NO, KEEP LOOKING
DVCHR ;DEVICE CHARACTERISTICS
LDB A,[POINT 9,B,17] ;DEVICE TYPE
CAIE A,.DVDSK
JRST ACCOU3 ;LOOP TILL WE FIND ONE
;DETERMINE WHETHER SPECIFIED FILE TAKES STRING OR NUMERIC ACCOUNT
STKVAR <<ABUF,FILWDS>>
HRROI A,ABUF
HRRZ B,@OUTDSG
LDF C,1B2+1B5+JS%PAF ;GET STR:<DIR>
JFNS ;GET STRING
ERCAL JERRE
MOVSI A,(RC%EMO) ;NO RECOGNITION
HRROI B,ABUF
RCDIR ;CONVERT STRING BACK TO DIR # TO GET BITS
TLNE A,(RC%NOM+RC%AMB) ;SKIP IF EXACT MATCH
JRST ACCOU3 ;TRY TO FIND LEGAL ONE
ACCOU4: NOISE <TO>
CALL ACCT ;GET ACCOUNT # OR STRING, USING A.
CONFIRM
MOVEM A,ACDIR ;SAVE ACCT # OR STRING HERE
SETOM TYPGRP ;TYPE FILES
MOVE A,JBUFP ;GET POINTER TO JFN STACK
MOVEM A,.JBUFP ;MARK HOW FAR BACK TO RELEASE JFNS
ACCOU1: CALL RLJFNS ;RELEASE TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX FILE TERM
JRST ACCOU2 ;GO SEE IF ANY MORE TO DO
CALL TYPIF ;TYPE NAME, GET JFN
CALL MFINP ;GET A TEMP JFN AND STEP TO NEXT FILE
JRST ACCOU2 ;FAILED
MOVE B,ACDIR ;ACCT # OR STRING PTR
SACTF ;SET ACCOUNT OF FILE
JRST [ TYPE < >
CALL $ERSTR
ETYPE<%_>
JRST ACCOU2]
CALL TYPOK
ACCOU2: SKIPE INIFH1 ;ANYTHING LEFT TO BE DONE?
JRST ACCOU1 ;YES, LOOP BACK FOR REST OF FILES
RET
;SET ADDRESS-BREAK
.ADDRE: SKIPGE SETNOF ;"NO" TYPED?
JRST [ CONFIRM ;YES, CONFIRM IT
SKIPG A,FORK ;FORK HANDLE
ERROR <No program>
HRLI A,.ABCLR ;FUNCTION TO REMOVE BREAKS
ADBRK ;DO IT
ERJMP CJERRE ;Failed-- type error string
SETZM ABKCNT ;ZERO REPEAT COUNT
RET] ;AND RETURN
PUSH P,P1 ;GET A SAFE REGISTER
SETZ P1, ;CLEAR IT (HOLDS FLAG BITS)
NOISE <AT>
MOVEI A,[ASCIZ /Location on which to break/]
MOVEI B,[ASCIZ /Confirm with carriage return
or comma to enter subcommands/]
CALL OCTCOM ;Read general octal number for large PCs
TDNN A,[777776,,777760] ;Can't set break on any ACs
ERROR <Address break won't work on the ACs>
TLNE A,777740 ;Check for too large an address
ERROR <Break address not between 0 and 37,,777777>
PUSH P,A ;SAVE ADDRESS
CALL SPRTR ;CHECK FOR COMMA OR CONFIRM
SUBCOM $ADBK ;COMMA TYPED, GET SUBCOMMANDS
TRZN P1,1 ;ANY SUBCOMMANDS TYPED?
TXO P1,AB%RED!AB%WRT!AB%XCT ;NO, TAKE DEFAULTS
SKIPG A,FORK ;FORK HANDLE
ERROR <No program>
HRLI A,.ABSET ;FUNCTION TO SET BREAK
POP P,B ;RECOVER ADDRESS
MOVE C,P1 ;PUT FLAGS IN RIGHT AC
POP P,P1 ;RESTORE P1
ADBRK ;SET IT
ERJMP CJERRE ;Failed-- say why
RET ;AND RETURN
$ADBK: TABLE
T AFTER,,.AFT
T ALL,,.ALL
T EXECUTE,,.EXE
T NONE,,.NON
T READ,,.REA
T WRITE,,.WRI
TEND
.AFT: DECX <Number of times to allow reference before trapping, in decimal>
CMERRX
NOISE <REFERENCES>
CONFIRM
MOVEM B,ABKCNT ;REMEMBER IT
RET
.ALL: TXO P1,AB%RED!AB%WRT!AB%XCT!1
NOISE <TYPES OF REFERENCES>
CONFIRM
RET
.REA: TXO P1,AB%RED!1
NOISE <REFERENCES>
CONFIRM
RET
.EXE: TXO P1,AB%XCT!1
NOISE <REFERENCES>
CONFIRM
RET
.WRI: TXO P1,AB%WRT!1
NOISE <REFERENCES>
CONFIRM
RET
.NON: TXO P1,1
CONFIRM
RET
$SET0: TABLE
T ACCOUNT,,.CHANG ;SET ACCOUNT
T ADDRESS-BREAK,,.ADDRE ;SET ADDRESS-BREAK
XTND,<
T ALERT ; SET ALERT
T AUTOMATIC ; SET AUTOMATIC (MAIL-WATCH AND ALERTS)
>
T CARD-READER-INPUT-SET,,CRDSET ;SET CARD-READER-INPUT-SET (TO)
T CONTROL-C-CAPABILITY,,.CTRLC ;SET ^C ALLOWED
T DEFAULT ;SET DEFAULT (FOR)
T DIRECTORY,,.SDIR ;SET DIRECTORY
T ENTRY-VECTOR,,.ENTRY ;SET PROGRAM ENTRY-VECTOR
T FILE,,.SFILE ;SET FILE
XTND,<
T KEEP-FORK,,.KFRKC ; SET KEEP-FORK (ON <CTRL-C>)
>
T LATE-CLEAR-TYPEAHEAD,NOLG,.CIDLY ;SET (DELAYED CLEAR)
T LOCATION ;SET LOGICAL LOCATION TO NODE NAME
NOXTND,<
T MAIL-WATCH,ONEWRD,.MWATC ;SET MAIL-WATCH
>
XTND,<
T MAIL-WATCH,,.MWATC ; SET MAIL-WATCH (FOR USER) USRNAM (COUNT) N
>
T NO,NOLG,.SETNO ;SET NO
T PAGE-ACCESS,,.PAC ;CONTROL PAGE ACCESS
T RETRIEVAL-WAIT,,.OFL ;SET RETRIEVAL-WAIT (FOR OFFLINE FILES)
T SESSION-REMARK,,SETSRM ;SET SESSION REMARK
T SPOOLED-OUTPUT,,SPLSET ;SET SPOOLED-OUTPUT (TO)
T TAPE ;SET TAPE
T TIME-LIMIT,nolg,.TIME ;TIME (TO) NUMBER
T UUO-SIMULATION,,.PAXL ;SET UUOS ALLOWED
TEND
.SETNO: SETOM SETNOF ;FLAG NO TYPED
KEYWD $SETN
0
JRST CERR
TXNN P3,NOLG ;NEED TO BE LOGGED IN?
SKIPE CUSRNO ;YES, ARE WE?
CAIA ;OK
ERROR <LOGIN please>
TXNE P3,ONEWRD ;COMMAND TO BE CONFIRMED HERE?
CONFIRM ;YES
JRST (P3) ;DISPATCH TO COMMAND
$SETN: TABLE
T ADDRESS-BREAK,,.ADDRE ;SET NO ADDRESS BREAK
XTND,<
T ALERT ; SET NO ALERT
T AUTOMATIC ; SET NO AUTOMATIC (MAIL-WATCH AND ALERTS)
>
T CONTROL-C-CAPABILITY,,.CTRLC ;NO ^C ALLOWED
T DEFAULT,,.NODEF ;SET NO DEFAULT
XTND,<
T KEEP-FORK,,.KFRKC ; SET NO KEEP-FORK (ON <CTRL-C>)
>
T LATE-CLEAR-TYPEAHEAD,NOLG,.CIDLY ;EARLY CLEAR
XTND,<
T LOGIN-MAIL,ONEWRD,.NOLM ; SET NO LOGIN-MAIL
>
NOXTND,<
T MAIL-WATCH,ONEWRD,.MWATC ;SET NO MAIL-WATCH
>
XTND,<
T MAIL-WATCH,,.MWATC ; SET NO MAIL-WATCH (FOR USER) USRNAM
>
T RETRIEVAL-WAIT,,.OFL ;SET NO RETRIEVAL-WAIT (FOR OFFLINE FILES)
T TIME-LIMIT,NOLG,.NOTIM ;CLEAR TIME LIMIT
T UUO-SIMULATION,,.PAXL ;NO UUOS ALLOWED
TEND
.CIDLY: NOISE <FOR COMMANDS>
CONFIRM
SETCM A,SETNOF
MOVEM A,CIDLYF
RET
;SET LOCATION
.LOCAT: NOISE (TO)
STKVAR <<NODFDB,.CMDEF+1>>
MOVX A,FLD(.CMNOD,CM%FNC)!CM%PO!CM%DPP
MOVEM A,.CMFNP+NODFDB ;NODE FUNCTION, PARSE ONLY, DEFAULT PRESENT
CALL GETNOD ;GET POINTER TO OUR NODE NAME
JRST [ MOVX A,CM%DPP ;FAILED, PROBABLY NO DECNET ON THIS SYSTEM
ANDCAM A,.CMFNP+NODFDB ;SAY NO DEFAULT PRESENT
JRST .+1]
MOVEM A,.CMDEF+NODFDB ;STORE POINTER TO DEFAULT
MOVEI B,NODFDB
CALL FLDSKP ;READ NODE NAME, DEFAULT TO SYSTEM'S
CMERRX ;FAILED, TELL USER WHY
CALL BUFFF ;REMEMBER NODE NAME TYPED BY USER
CONFIRM ;WAIT FOR COMMAND CONFIRMATION
MOVE C,A ;POINTER TO NODE NAME POINTER IN C
HRROI A,-1 ;OURSELF
MOVEI B,.SJLLO ;SET LOGICAL LOCATION
SETJB ;DO IT
ERCAL CJERRE ;FAILED, TELL USER WHY
RET ;DONE
NOXTND,<
.MWATC: SETCM C,SETNOF ;TURN ON OR OFF WATCHING OF MAIL FILE
EXCH C,MWATCF ;FLAG FOR WATCHING IS 0 (DEFAULT) FOR NO
CAMN C,MWATCF ;ANY CHANGE?
RET ;NO
JUMPE C,MALON ;JUMPE IF WAS OFF BEFORE
MOVE A,[.FHSLF,,.TIMDD] ;REMOVE TIMER INTERRUPT
MOVE B,MALWEN ;GET TIME AT WHICH INTERRUPT WAS TO OCCUR
MOVEI C,MALCHN ;6/23/78 TIMER REQUIRES CHANNEL BUT DOESN'T USE IT!!!
TIMER ;TURN OFF THE TIMER
ERJMP .+1 ;WILL FAIL IF TIMER ALREADY TIMED OUT
;NOTE: THIS COULD CAUSE PROBLEMS IF THE EXEC IS USING TIMER TO TIME
;SOMETHING ELSE, WHICH ALSO WANTS AN INTERRUPT AT THE SAME TIME. THIS
;TIMER HERE IN THE MAIL CODE WOULD ERRONEOUSLY TURN OFF THE OTHER
;TIMER. WHAT IS NEEDED IS FOR THE TIMER JSYS TO ALLOW US TO SPECIFY
;EXACTLY WHICH TIMER TO TURN OFF. THIS WOULD PREVENT THIS PROBLEM.
;
;NOTE ALSO THAT IT IS INDEED NECESSARY TO TURN OFF THE TIMER HERE.
;IF WE DIDN'T, THEN A USER TURNING MAIL OFF, ON, OFF, ON, OFF, ON ETC.
;WOULD PILE UP TIMERS WHICH WOULD GIVE MORE INTERRUPTS THAN THEY'RE
;SUPPOSED TO, OR WOULD HIT QUOTA CAUSING AN ERROR.
RET
;TURNING IT ON...
MALON: CALL MINT0 ;ENABLE FOR A MAIL INTERRUPT
RET
>
XTND,< ; More comprehensive mail-watch and alert facility
.MWATC: NOISE <FOR USER>
CALL USRNAM ; INPUT USER NAME
ERROR <No such user>
STKVAR <USRNUM>
MOVEM C,USRNUM ; SAVE USER NUMBER
SKIPE SETNOF ; SET NO?
JRST .MWAT0 ; TURN WATCH OFF
NOISE <MESSAGE COUNT>
DEFX <10000> ; DEFAULT TO LOTS
DECX <Number of times to tell of old "new" mail>
HRLOI B,377777 ; +INF IF NONE TYPED
MOVE Q1,B ; SAVE COUNT
.MWAT0: CONFIRM
MOVE A,USRNUM ; USER NUMBER
MOVEI C,NMWAT-1 ; INIT COUNT
SETO D,
.MWAT1: SKIPN B,MWATDR(C) ; LOOK FOR EMPTY SLOT
SKIPA D,C ; SAVE INDEX
CAME A,B ; MATCH USER?
JRST .MWAT2 ; FOUND EMPTY SLOT
SKIPN SETNOF ; FOUND USER - SET NO?
JRST .MWAT3 ; MATCH FOUND USE IT INSTEAD
SETZM MWATDR(C) ; TURN OFF MAIL WATCH ON THIS ONE
RET ; DONE
.MWAT2: SOJGE C,.MWAT1 ; LOOP OVER ALL SLOTS
SKIPE SETNOF ; SET NO?
RET ; YES - ALREADY TURNED OFF
SKIPGE C,D ; HAVE EMPTY SLOT?
ERROR <Maximum number of watches used up.>
MOVEM A,MWATDR(C) ; SET TO WATCH THIS USER
.MWAT3: SETOM MWATCF ; TURN ON WATCHING
; SETZM MWATAT ; RESET TIMERS
; SETZM MWATCT
MOVEM Q1,MWATN(C) ; STASH REPEAT COUNTS
MOVEM Q1,MWATN0(C)
RET ; EXIT
; STILL IN XTND
;SET ALERT (AT)
.ALERT: SKIPE SETNOF ; SET NO?
JRST ALRDEL ; YES - DELETE SOME
NOISE <AT TIME>
DTRX <Date and time, or time>
CMERRX
GTAD ; GET NOW
CAML A,B ; TIME BEFORE NOW?
ADD B,[1B17] ; YES - ASSUME TOMORROW
PUSH P,B ; SAVE TIME
NOISE <MESSAGE>
LINEX <Message, must be .le. 80 characters>
CMERRX
MOVE A,CMABP ; SAVE STRING IN PERMANENT FREE SPACE
ILDB C,A ; SEE IF STRING GIVEN
JUMPE C,.ALRT1
MOVE A,CMABP ; GET PNTR AGAIN
CALL XBUFFS
MOVE C,A ; STRING PNTR TO C
.ALRT1: CONFIRM
POP P,B ; RESTORE TIME
SKIPG ALRTIM ; ALERTS ON?
JRST [ MOVEM B,ALRTIM ; NO - SET UP TIMER
MOVEM C,REASON
RET] ; EXIT - CHECK ON COMMAND RETURN
MOVSI D,-NALTS ; SEARCH TABLE FOR PROPER SLOT
SKIPE ALRTMS(D) ; FIND EMPTY SLOT
AOBJN D,.-1
JUMPGE D,[ERROR <Alert table full>]
CAMG B,ALRTIM ; IS NEW ONE EARLIER THAN CURRENT PENDING?
JRST [ EXCH B,ALRTIM ; YES - EXCHANGE TIMES
EXCH C,REASON ; AND MESSAGE
JRST .+1]
MOVEM B,ALRTMS(D) ; FILL IN SLOT (ORDER LATER)
MOVEM C,REASON+1(D)
RET
;HERE TO REMOVE ONE OR MORE ALERTS
ALRDEL: SKIPN ALRTIM ; ANY PENDING?
ERROR <No alerts pending>
DTRX <Date and time or BEFORE or AFTER time
at which to remove alert>
JRST ALRDL5
CONFIRM
MOVSI D,-<NALTS+1> ; SCAN FULL TABLE AND PENDING
ALRDL2: MOVE A,B ; DATE/TIME REQUESTED
SUB A,ALRTIM(D) ; GET DIFFERENCE FROM ENTRY
MOVM A,A ; ABSOLUTE VALUE
CAIL A,^D182 ; WITHIN ONE MINUTE?
JRST ALRDL3 ; NO - STEP TO NEXT
TLO Z,F1 ; SAY WE FOUND ONE
SETZM ALRTIM(D) ; CLEAR ENTRY
SKIPE A,REASON(D) ; REMOVE MESSAGE
CALL STREM ; FROM FREE POOL
SETZM REASON(D) ; CLEAR PNTR
ALRDL3: AOBJN D,ALRDL2 ; LOOP
TLNN Z,F1 ; FOUND ANY?
ERROR <No alerts found>
SETZ B, ; SETUP FOR TABLE RE-ORDER
HRLOI Q1,377777
ALRDL4: SKIPN ALRTIM ; CLEARED CURRENT PENDING ALERT?
JRST ALRCH1 ; YEP - FIND A NEW ONE
RET ; ELSE, EXIT
; STILL IN XTND
;COME HERE TO PARSE "BEFORE" & "AFTER"
ALRDL5: TRVAR <<ARANGE,2>>
SETZB C,Q1 ; INIT RANGE VARIABLES
HRLOI B,377777
DMOVEM B,ARANGE ; SAVE
KEYWD $ALERT
0 ; NO DEFAULT
JRST [ CONFIRM ; HANDLE "SET NO ALERT<CR>"
JRST ALRD5A]
CALL 0(P3) ; INVOKE SUBR
DMOVE B,ARANGE ; GET RANGE TO CHECK
ALRD5A: MOVSI D,-<NALTS+1> ; CHECK ALL
ALRDL6: CAMG C,ALRTIM(D)
CAMGE B,ALRTIM(D) ; THIS ONE?
JRST ALRDL7 ; NOT IN RANGE
SETZM ALRTIM(D) ; IN RANGE - DELETE
SKIPE A,REASON(D) ; REMOVE MESSAGE IF ANY
CALL STREM
SETZM REASON(D)
ALRDL7: AOBJN D,ALRDL6 ; LOOP
MOVE Q1,B ; PASS RANGE TO RE-ORDER
MOVE A,C
JRST ALRDL4
$ALERT: TABLE
T AFTER,,ALRAFT
T BEFORE,,ALRBEF
TEND
ALRAFT: TLOA Z,F2 ; FLAG AFTER
ALRBEF: TLZ Z,F2 ; FLAG BEFORE
NOISE <TIME>
DTRX <Date and time>
CMERRX
CONFIRM
MOVE A,B ; SAVE USER INPUT IN A
MOVE B,ARANGE ; PREVIOUS TOP RANGE
TLNE Z,F2 ; RE-ORDER DEPENDING ON BEFORE/AFTER
SKIPA C,A
MOVE B,A ; USER INPUT AT TOP OR BOTTOM
DMOVEM B,ARANGE ; SAVE ARGS
RET ; RETURN
; STILL IN XTND
;CHECK FOR ALERT AND RE-ORDER
ALRCHK::SKIPG B,ALRTIM ; ANY ALERTS PENDING?
RET ; NOPE - EXIT
GTAD ; GET TIME NOW
CAMGE A,B ; IS IT TIME FOR ALERT
RET ; NOPE - EXIT
SUBI A,^D728 ; 4 MINUTES
CAMG A,B ; LATER THAN 4 MINS?
TDZA Q1,Q1 ; NO - OK
HRROI Q1,[ASCIZ "%2D "] ; YES - SPECIAL MESSAGE
MOVE A,COJFN
DOBE ; WAIT FOR TYPEOUT TO STOP
; SKIPE AUTOF ; IS THIS AUTOMATIC CHECK
TYPE <> ; YES - RING CHIMES
ETYPE <[%5\%%2E% alert> ; MESSAGE
SKIPE Q1 ; WANT SPECIAL
ETYPE < at %D %E> ; YES - APOLOGIZE
SKIPE B,REASON ; GIVE MESSAGE SAVED
TYPE < - >
ETYPE <%2\]%_>
GTAD ; GET TIME NOW
MOVE B,A ; INTO B
HRLOI Q1,377777 ; FOR RE-ORDER
ALRCH1: MOVSI D,-NALTS
SETO C, ; INIT FLAG
ALRCH2: SKIPN A,ALRTMS(D) ; ENTRY?
JRST ALRCH3 ; EMPTY - SKIP IT
CAMG A,Q1 ; WITHIN RANGE
CAMG A,B
JRST [SETZM ALRTMS(D) ;OUT OF RANGE - REMOVE IT
SKIPE A,REASON+1(D)
CALL STREM
SETZM REASON+1(D)
JRST ALRCH3]
SKIPL C ; FOUND ONE YET?
CAMGE A,ALRTMS(C) ; YES - BETTER ONE NOW?
MOVEI C,(D) ; REMEMBER THIS ENTRY
ALRCH3: AOBJN D,ALRCH2 ; LOOP
MOVE A,ALRTMS(C) ; SET NEW ENTRY (OR CLEAR ALRTIM)
MOVEM A,ALRTIM
SETZM ALRTMS(C) ; ...
SKIPE A,REASON ; CLEAR OLD MESSAGE
CALL STREM
SETZM REASON ; IN CASE IT WAS THE ONLY ONE
MOVE A,REASON+1(C) ; MOVE MESSAGE ALSO
MOVEM A,REASON
RET ; DONE
;STILL IN XTND
;SET AUTOMATIC MAIL-WATCH AND ALERTS
.AUTOM: NOISE <MAIL AND ALERT CHECKS>
CONFIRM
SKIPE SETNOF ; MAYBE SET NO
JRST .AUTO2 ; YES
SETZM MWATAT ; CLEAR AUTO TIME
SKIPE IITSET ; TIMERS ON?
RET ; YES - EXIT
MOVE A,[.FHSLF,,.TIMEL] ; NO SETUP TIMER INT
MOVEI B,^D60000 ; 1 MINUTE INTERVALS
MOVEI C,IITCHN ; CHANEL
TIMER
JRST CJERR ; JSYS LOSAGE
SETOM IITSET ; INTERRUPT ARMED
RET ; EXIT
.AUTO2: GTAD ; FLUSH TIMER IF
ADDI A,^D182 ; WITHIN ONE MINUTE
MOVE B,A
MOVE A,[.FHSLF,,.TIMBF] ; ALL TIMES BEFORE NOW + 1MIN
MOVEI C,IITCHN ; *** MONITOR CROCK REQUIRES CHL
TIMER
JFCL
SETZM IITSET ; NO MORE INTS
RET
> ;END XTND
.PAXL: NOISE <FOR PROGRAM>
CONFIRM
SKIPN SETNOF
TDZA A,A
SETO A,
MOVEM A,PAXLFL ;PA1050 FLAG
SKIPG A,FORK ;HANDLE OF CURRENT INFERIOR
RET ;NONE, LEAVE NOW
GCVEC ;GET CURRENT VECTOR
CAMN B,[-1] ;DISABLED?
JRST [ SKIPE PAXLFL ;YES, IS THAT WHAT WE WANT?
RET ;YES
SETZ B, ;NO, ENABLE
JRST PAXL1]
SKIPN PAXLFL ;ENABLED, IS THAT WHAT WE WANT?
RET ;YES
SETO B, ;NO, DISABLE IT
PAXL1: SETZ C,
SCVEC ;SET COMPATIBILITY ENTRY
RET
XTND,<
.KFRKC: NOISE <ON <CTRL-C>>
CONFIRM
SKIPE SETNOF ; SET NO?
TDZA A,A ; YES - CLEAR
SETO A, ; SET
MOVEM A,CCKEEP ; CTRL-C KEEP FLAG
RET
; SET NO LOGIN-MAIL
;Don't do any of the normal mail processing on LOGIN
.NOLM: SETZM SYSMF ; THIS SHOULD BE SUFFICIENT
SETZM MESMSF
RET
>
;SET PAGE-ACCESS (OF PAGES) P1,P2:P3... (ACCESS) ACCESS-TYPES
.PAC: SETZM SPCNT ;NO ERRORS YET
SKIPGE FORK ;MAKE SURE THERE'S A PROCESS
ERROR <No program>
NOISE (OF PAGES)
CALL OCTLST ;GET LIST OF OCTAL PAGE RANGES
NOISE (ACCESS)
SETZB Q1,Q2 ;Q1 ARE "YESES" AND Q2 ARE "NOS"
MOVEI Q3,0 ;Q3 NON-0 IF "NO" JUST TYPED
PAC2: MOVEI B,[
FLDDB. .CMCFM,,,,,[
FLDDB. .CMKEY,,$acces,<Access type,>,,]]
TRNE Q3,1 ;WAS "NO" JUST TYPED?
MOVE B,(B) ;YES, SO EOL ILLEGAL NOW
CALL FLDSKP ;GET EOL OR ACCESS-TYPE
CMERRX ;NO
LDB C,[331100,,(C)] ;FIND OUT WHAT TYPED
CAIN C,.CMCFM ;END OF LINE?
JRST PAC3 ;YES, GO EXECUTE COMMAND
CALL GETKEY ;KEYWORD TYPED, GET DATA
CAIN P3,0 ;IS KEYWORD "NO"?
AOJA Q3,PAC2 ;YES, REMEMBER AND GET NEXT KEYWORD
TRNN Q3,1 ;NO, DID "NO" PRECEDE THIS KEYWORD?
IOR Q1,P3 ;NO, ACCUMULATE TO "YES" LIST
TRNE Q3,1
IOR Q2,P3 ;YES, ACCUMULATE TO "NO" LIST
TRNN Q3,1
TDZ Q2,P3 ;IF "YES", CANCEL PREVIOUS "NO"
TRNE Q3,1
TDZ Q1,P3 ;IF "NO", CANCEL PREVIOUS "YES"
TRZ Q3,1 ;CLEAR "NO"
JRST PAC2 ;GO GET MORE INPUT
PAC3: SOSGE C,RLIST ;PREPARE TO GET NEXT SET OF PAGES FROM LIST
JRST PAC4 ;NO MORE PAGES
MOVE D,RLIST(C) ;GET BEGINNING OF RANGE
CAMLE D,RLIST+1(C) ;MAKE SURE RANGE GOES FROM SMALL TO LARGE
JRST BADRAN ;NO
HLR D,RLIST+1(C) ;MAKE SURE BOTH ENDS OF RANGE FIT IN 18 BITS
JUMPN D,BADPAG ;JUMP IF THEY DON'T
HRR A,RLIST(C) ;GET FIRST PAGE NUMBER OF RANGE TO SET
HRRZM A,SPPAG ;REMEMBER PAGE
PAC5: CAMN Q2,[-1] ;"NO NONEXISTENT"?
JRST PAC6 ;YES, DO NOTHING
HRL A,FORK ;USE CURRENT FORK
CAMN Q1,[-1] ;"NONEXISTENT"?
JRST PAC7 ;YES, GO REMOVE PAGE
RPACS ;GET OLD PAGE ACCESS
ERJMP [ CALL NOSPAC ;PRINT ERROR, RPACS FAILED.
JRST PAC6] ;GO ON TO NEXT PAGE
IOR B,Q1 ;TURN ON ACCESS DESIRED
TDZ B,Q2 ;TURN OFF ACCESS NOT WANTED
SPACS ;DO IT
ERCAL NOSPAC ;COULDN'T, TYPE ERROR MESSAGE
PAC6: HRRZ D,SPPAG ;ISOLATE PAGE NUMBER JUST DONE
AOS A,SPPAG ;STEP TO NEXT PAGE
MOVE C,RLIST ;C GETS CLOBBERED BY NOSPAC
CAMGE D,RLIST+1(C) ;HAVE WE DONE ENTIRE RANGE YET?
JRST PAC5 ;NOT YET
PAC8: SOS RLIST ;YES, GO TO NEXT SET
JRST PAC3
PAC4: CALL SPREP ;PERHAPS LAST ERROR CHUNK TO REPORT
CALLRET UNMAP ;ALL DONE, UNMAP PAGES AND RETURN
;HERE FOR THE CASE OF "SET PAGE N NONEXISTENT"
PAC7: MOVE B,A ;PUT PAGE IDENTIFIER IN B
HRROI A,-1 ;SAY GET RID OF PAGE
MOVEI C,0 ;SAY NO REPEAT COUNT
PMAP ;GET RID OF PAGE
ERCAL NOSPAC ;FAILED, GO PRINT ERROR
JRST PAC6
;PAGE NUMBERS OUT OF RANGE 0-777777
BADPAG: ETYPE <%%Page number negative or larger than 777777 - being skipped
>
JRST PAC8 ;SKIP THIS SET
;BEGINNING OF RANGE NOT LESS THAN OR EQUAL TO END
BADRAN: ETYPE <%%Beginning of range larger than end - Range being skipped
>
JRST PAC8
;GET HERE WHEN COULDN'T SET PAGE ACCESS. JUST PRINT WARNING ABOUT
;THAT PAGE AND RETURN
NOSPAC: CALL DGETER ;GET LATEST ERROR REASON
MOVEM A,SPERR ;REMEMBER
NOSP1: SKIPN SPCNT ;ANY ACCUMULATED ERRORS?
JRST [ MOVE A,SPPAG ;NO, GET STARTING PAGE NUMBER
HRRM A,SPERF ;REMEMBER WHERE NEW SET BEGINS
MOVE A,SPERR ;SEE WHAT THE ERROR IS
HRLM A,SPERF ;REMEMBER ERROR
MOVEI A,1
MOVEM A,SPCNT ;SAY ONE IN A ROW
RET] ;DONE UNTIL NEXT ERROR
HRRZ A,SPERF ;THERE'S ACCUMULATED ERRORS, GET STARTING PAGE
ADD A,SPCNT ;GET NEXT PAGE IN GROUP
HLRZ C,SPERF ;GET REASON WHY THIS GROUP FAILED
CAMN A,SPPAG ;IS THIS PAGE NOT NEXT ONE IN GROUP?
CAME C,SPERR ;OR IS REASON DIFFERENT THAT CURRENT GROUP?
CAIA ;SOMETHING'S DIFFERENT
JRST [ AOS SPCNT ;SAME ERROR AND CONSECUTIVE PAGE, JUST REMEMBER HOW MANY IN A ROW
RET]
CALL SPREP ;DIFFERENT REASON, REPORT PREVIOUS GROUP
SETZM SPCNT ;CAUSE NEW GROUP TO START
JRST NOSP1 ;LOOP TO GRAB THIS LATEST ERROR
;ROUTINE TO PRINT ERROR. TAKES NUMBER OF CONSECUTIVE PAGES THAT FAILED IN SPCNT.
;TAKES REASON FOR FAILURE IN LEFT HALF OF SPERF AND STARTING PAGE NUMBER IN
;RIGHT HALF OF SPERF.
SPREP: SKIPN C,SPCNT ;SEE HOW MANY FAILED IN A ROW
RET ;NONE, SO NOTHING TO REPORT
HLRZ A,SPERF ;GET REASON
HRRZ B,SPERF ;GET FIRST PAGE THAT FAILED
CAIN C,1 ;1 IS SPECIAL CASE
JRST [ LERROR <Couldn't set access of page %2O - %1?>
RET]
ADD C,B ;GET LAST PAGE THAT FAILED
SOJ C,
LERROR <Couldn't set access of pages %2O through %3O - %1?>
RET
$ACCES: TABLE ;OF ACCESS TYPES
T COPY-ON-WRITE,PA%CPY,0
T EXECUTE,PA%EX,0
T NO,0,0
T NONEXISTENT,-1,0
T READ,PA%RD,0
T WRITE,PA%WT,0
TEND
.CTRLC: NOISE <OF PROGRAM>
CONFIRM
IFNBATCH (ILLBAT)
SKIPN SETNOF
TDZA A,A
SETO A,
MOVEM A,CCFLAG ;CONTROL-C FLAG
SKIPG A,FORK ;CURRENT FORK?
RET ;NO, LEAVE NOW
RPCAP ;YES, GET CAPS
SKIPE CCFLAG ;ENABLE OR DISABLE?
TXZA B,SC%CTC ;DISABLE
TXO B,SC%CTC ;ENABLE
SKIPE PRVENF ;IF NO CAPS ENABLED, CLEAR ^C
SKIPE CCFLAG ;ENABLE OR DISABLE?
TXZA C,SC%CTC ;DISABLE
TXO C,SC%CTC ;ENABLE
EPCAP ;YES, SET
RET
ILLBAT: ERROR <Illegal under BATCH>
;SET DEFAULT (FOR)
.DEFAU: NOISE (FOR)
KEYWD TDEFAU ;SEE WHICH COMMAND DEFAULT BEING SET FOR
0 ;NO DEFAULT
CMERRX <Invalid command to set defaults for>
JRST (P3) ;DISPATCH TO DEFAULTING ROUTINE
TDEFAU: TABLE
T CARDS,,.SDC
T COMPILE-SWITCHES,,.SDCS
T PAPER-TAPE,,.SDT
T PLOT,,.SDPL ;SET DEFAULTS (FOR) PLOT
T PRINT,,.SDP
T SUBMIT,,.SDS ;SET DEFAULT (FOR) SUBMIT
T TAKE,,.TKD ;SET DEFAULT (FOR) TAKE
TEND
;SET NO DEFAULT (FOR)
.NODEF: NOISE (FOR)
KEYWD $NODEF ;SEE WHICH COMMAND DEFAULT BEING CLEARED FOR
0 ;NO DEFAULT
CMERRX <Invalid command to clear defaults for>
JRST (P3) ;DISPATCH TO DEFAULTING ROUTINE
$NODEF: TABLE
T CARDS,,.SNDCP
T COMPILE-SWITCHES,,.SNDCS ;SET NO DEFAULT COMPILE-SWITCHES
T PAPER-TAPE,,.SNDTP
T PLOT,,.SNDPL ;SET NO DEFAULTS (FOR) PLOT
T PRINT,,.SNDP
T SUBMIT,,.SNDS ;SET DEFAULT (FOR) SUBMIT
TEND
.TKD: KEYWD $TKD ;PARSE NEXT KEYWORD ("ECHO" OR "NO")
0 ;NO DEFAULT
CMERRX <invalid option for SET DEFAULT TAKE command>
JRST (P3) ;DISPATCH TO DEFAULTING ROUTINE
$TKD: table
T ECHO,,.ECHO
T NO,,.TKND
tend
.ECHO: CONFIRM
SETOM PECHOF ;NOTE PERMANENT ECHO OF TAKE FILES WANTED
RET
.TKND: KEYWD $NTKD ;PARSE NEXT KEYWORD ("ECHO")
0 ;NO DEFAULT
CMERRX <invalid option for SET DEFAULT TAKE command>
JRST (P3) ;DISPATCH TO DEFAULTING ROUTINE
$NTKD: table
T ECHO,,.NOECH
tend
.NOECH: CONFIRM
SETZM PECHOF ;NOTE NO ECHO OF TAKE FILES WANTED
RET
;"SET DIRECTORY"
.SDIR: SETZM SETNOF ; Assume "no" not typed
SETZM PASSP ;TELL CRDIR THERE'S NO PASSWORD SUPPLIED YET
KEYWD $SDIR
0
JRST CERR
TXNE P3,ONEWRD
CONFIRM
JRST (P3)
$SDIR: TABLE
T ACCOUNT-DEFAULT,,.DAD
XARC <
T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
>
T FILE-PROTECTION-DEFAULT,,.DFPD
T GENERATION-RETENTION-COUNT-DEFAULT,,.DGRCD
XARC <
T NO,,.SDNO
T OFFLINE-EXPIRATION-DEFAULT,,.DOFXP
T ONLINE-EXPIRATION-DEFAULT,,.DONXP
>
T PASSWORD,,.DPASS
T PROTECTION,,.DPRO
TEND
.SDNO: SETOM SETNOF ; Flag that NO was said
KEYWD $SDNO
0
JRST CERR
TXNE P3,ONEWRD
CONFIRM
JRST (P3)
$SDNO: TABLE
T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
TEND
;"SET FILE"
.SFILE: SETZM SETNOF ; Flag "NO" was not said yet
KEYWD $SFILE
0
JRST CERR
TXNE P3,ONEWRD
CONFIRM
JRST (P3)
$SFILE: TABLE
T ACCOUNT, ;SET FILE ACCOUNT (OF FILE) - (TO) -
xtnd,<
T AUTOKEEP,,.AUTOK ;SET FILE AUTOKEEP
T EPHEMERAL,,.EPHM ;SET FILE EPHEMERAL
>
XARC <
T EXPIRED,,.FEXP ; Set file expired
>
T GENERATION-RETENTION-COUNT,,.FILEV ;SET FILE VERSTION-RETENTION-COUNT
T INVISIBLE, ;Set file invisible <filegroup>
T NO,,.SFNO ; Set file NO
XARC <
T OFFLINE-EXPIRATION,,.FLINX ; Set file OFFLINE-EXPIRATION
T ONLINE-EXPIRATION,,.FLONX ; Set file ONLINE-EXPIRATION
>
T PROHIBIT,WHLU,.FPROH ; Set file prohibit (migration of files)
T PROTECTION, ;SET FILE PROTECTION (OF FILE) - (TO) -
XARC <
T RESIST,,.FRESI ; Set file RESIST (migration of files)
>
T VISIBLE, ;Set file visible <filegroup>
TEND
.SFNO: SETOM SETNOF
KEYWD $SFNO
0
JRST CERR
TXNN P3,NOLG ; Need to be logged in?
SKIPE CUSRNO ; Yes, and are we?
CAIA ; Yes, go ahead
ERROR <LOGIN please>
TXNE P3,ONEWRD ; Need confirmation here?
CONFIRM
JRST (P3) ; Do whatever
$SFNO: TABLE
xtnd,<
T AUTOKEEP,,.AUTOK
T EPHEMERAL,,.EPHM
>
T PROHIBIT,WHLU,.FPROH
XARC <
T RESIST,,.FRESI
>
TEND
; OFFLINE/ONLINE/EXPIRED code
.FLINX: SETZ A, ; No expiration yet
MOVX B,.RSFET ; Offset to guy we're chaning
JRST DOEXPI ; Join other code
.FEXP: GTAD ; Expire the file, now will do
CAIA
.FLONX: SETZ A, ; Say no date/time or interval
MOVX B,.RSNET ; Cell where this value goes
DOEXPI: PUSH P,A ; Save the value
PUSH P,B ; And the offset
CAIN A,0 ; Doing file expired? (have value if so)
NOISE <OF FILES>
CAIE A,0 ; Have a value?
NOISE <FILES> ; Yes, "SET FILE EXPIRED (FILES) <files>"
CALL INFGNS ; Get file groups
SKIPE -1(P) ; Have a value yet?
JRST DOEXI4 ; Yes
NOISE <TO>
DTIVX <Expiration date>
JRST CERR ; Looses
MOVEM B,-1(P) ; Remember value given us
CAIA
DOEXI4: CONFIRM
SETOM FTDBLK
MOVE A,[FTDBLK,,FTDBLK+1]
BLT A,FTDBLK+.RSFET ; Set up the blk
POP P,A ; Get desired offset
POP P,FTDBLK(A) ; Value requested
SETOM TYPGRP ; Type file names
MOVE A,JBUFP ; Set up JFN stack fence
MOVEM A,.JBUFP
DOEXI1: CALL RLJFNS
CALL NXFILE
JRST DOEXI2 ; No more files...
CALL TYPIF ; Do file name
CALL MFINP ; Get a temp JFN for the file
JRST DOEXI2 ; Failed...
MOVEI B,FTDBLK
MOVEI C,.RSFET+1 ; BLK length
SFTAD ; Set
ERJMP DOEXI3 ; Failed, say why
CALL TYPOK ; Say it went fine
DOEXI2: SKIPE INIFH1 ; Anything left to do?
JRST DOEXI1 ; Yes, keep going
RET
DOEXI3: ETYPE < %?
>
JRST DOEXI2
; Prohibit/resist-migration
.FPROH: MOVX A,.AREXM
CAIA
.FRESI: MOVX A,.ARNAR ; Do RESIST
MOVX B,.ARSET ; Assume user is setting it
SKIPE SETNOF ; User say "NO" ?
MOVX B,.ARCLR ; Yes, clear the bit
PUSH P,A ; Save function code
PUSH P,B ; And set/clear code
NOISE <MIGRATION OF FILES>
CALL TYPFLS ; Collect file name groups
SETOM TYPGRP ; Type the names as we go
MOVE A,JBUFP
MOVEM A,.JBUFP ; Cover JFN stack
DOPRRS: CALL RLJFNS ; Release spare JFNs
CALL NXFILE
JRST DOPRR1 ; No more
CALL TYPIF
CALL MFINP ; Get a second JFN
JRST DOPRR1 ; Couldn't
MOVE B,-1(P) ; Get desired function
MOVE C,0(P) ; Which way to set it
ARCF ; Do it
ERJMP [ETYPE < %?
>
JRST DOPRR1] ; Failed
CALL TYPOK
DOPRR1: SKIPE INIFH1 ; Anything left?
JRST DOPRRS ; No
ADJSP P,-2 ; Ditch params
RET
;PROTECTION (OF FILE) <EXISTING NAME> (IS) <18 BIT OCTAL>
;VERSION-RETENTION-COUNT ...
; Invisible/visible
.VISIB: TXO Z,IGINV ; Find invisible files
TDZA B,B ; Make files visible
.INVIS: MOVX B,FB%INV ; Make files invisible
TLO Z,F2 ; Flag doing inv/vis stuff
NOISE <FILES>
PUSH P,B ; SAVE OUR PARAM NOW
CALL TYPFLS ;NOT INFGNS, SINCE NO GUIDE WORD AFTER FILESPEC
JRST FILEV2 ; Enter down a little way
.FILEV::TLOA Z,F1 ;FLAG VERSION-RET...
.PROTE::TLO Z,F3
NOISE <OF FILES>
CALL INFGNS
NOISE <TO>
TLNE Z,F1
JRST [ DECX <Decimal generation retention count>
cmerrx
CAILE b,^D63 ;LEGAL?
ERROR <Generation retention count must be 0-63>
LSH b,^D36-^D6 ;LEFTMOST 6 BITS
JRST FILEV1]
OCTX <Octal file protection value>
CMERRX
TLO B,500000 ;INDICATE THAT THERE'S 18-BIT PROTECTION IN RH
FILEV1: CONFIRM
FILEV2: SETOM TYPGRP ;PRINT ALL FILES
TLNN Z,F2 ; VIS/INVIS?
PUSH P,B ; YES, ALREADY HAVE PARAM SAVED
PROTE1: CALL NXFILE
JRST [ SKIPE INIFH1 ;END OF TERMS?
JRST PROTE1 ;NO, DO ANOTHER
POP P,(P)
RET]
HRRZ A,@INIFH1 ;GET JFN
DVCHR
TXNN B,DV%MDD ;MULTIPLE DIRECTORY DEVICE?
JRST [ TLNE Z,F1
ETYPE <?%1H: Generation retention count not implemented for this device
>
TLNE Z,F2
ETYPE <?%1H: Invisible files not implemented for this device
>
TLNE Z,F3
ETYPE <?%1H: Protection not implemented for this device
>
MOVSI A,(77B5)
ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
JRST PROTE2]
TLNE Z,F2 ; INV/VIS?
JRST [ SKIPE 0(P) ; SET FILE VISIBLE?
JRST .+1 ; NO
HRRZ A,@INIFH1 ; YES, GET JFN
MOVE B,[1,,.FBCTL] ; FIND OUT IF CURRENTLY INVISIBLE
MOVEI C,C
GTFDB
ERJMP PROTE2 ; SKIP FILE IF WE CAN'T TELL
TXNE C,FB%INV ; IS IT INVISIBLE NOW?
JRST .+1 ; YES, PRINT NAME & MAKE VISIBLE
JRST PROTE2]
CALL TYPIF ;TYPE NAME IF GROUP (RETURNS JFN IN A)
TLNE Z,F2 ; INV/VIS?
JRST [ HRLI A,.FBCTL ; Where the bit be changed is
MOVX B,FB%INV ; Bit in question
JRST DOSFL1]
HRLI A,.FBPRT ;PROTECTION WORD IN FDB
TLNE Z,F1
HRLI A,.FBBYV ;THIS IS VER RET WORD
MOVEI B,777777 ;CHANGE RHS ONLY
TLNE Z,F1
LDF B,FB%RET ;RETENTION COUNT PART
DOSFL1: MOVE C,(P) ;GET PROTECTION OR VER RET COUNT
CALL $CHFDB
JRST [ TYPE < Access not allowed
>
JRST PROTE2]
CALL TYPOK
PROTE2: CALL GNFIL
SKIPA
JRST PROTE1
POP P,(P) ;FIX STACK
RET
XTND,<
;SET FILE AUTOKEEP / SET FILE EPHEMERAL (ALSO SET NO ...)
.AUTOK: MOVSI A,.FBKEP ; CODE FOR KEEP THIS FILE
JRST .EPHM0 ; JOIN COMMON ROUTINE
.EPHM: MOVSI A,.FBEPH ; CODE FOR EPHEMERAL
.EPHM0: STKVAR <FCODE>
SETZM FCODE ; CLEAR CODE
SKIPN SETNOF ; SET NO ...?
MOVEM A,FCODE ; STORE ACTUAL CODE TO SET
CALL INFGNS ; Collect file name groups
CONFIRM
SETOM TYPGRP ; Type the names as we go
MOVE A,JBUFP
MOVEM A,.JBUFP ; Cover JFN stack
EPHM1: CALL RLJFNS ; Release spare JFNs
CALL NXFILE
JRST EPHM2 ; No more
CALL TYPIF
CALL MFINP ; Get a second JFN
JRST EPHM2 ; Couldn't
HRLI A,.FBCTL ; WORD IN FDB TO CHANGE
MOVX B,FB%FCF ; MASK FOR FILE TYPE CODE
MOVE C,FCODE ; GET CODE OR 0
CALL $CHFDB ; SET CODE IN FDB
JRST [ TYPE < Access not allowed
>
JRST EPHM2]
CALL TYPOK
EPHM2: SKIPE INIFH1 ; ANYTHING LEFT?
JRST EPHM1 ; YES - LOOP
RET
> ; XTND
; Set directory [no] archive-online-expired-files (Of directory)
.DARF: CALL INPDIR ; Get the directory in question
MOVX A,CD%DAR ; Bit to change
CALLRET DMODE ; Go change a single mode bit
;SET DIRECTORY GENERATION-RETENTION-COUNT-DEFAULT
.DGRCD: CALL INPDIR ;GET DIRECTORY NAME
NOISE <TO>
DECX <Decimal number of generations per file to be retained>
CMERRX
MOVEM B,.CDRET+SEBLK ;REMEMBER NUMBER
CAIE B,1 ;DON'T SAY "1 (GENERATIONS...)"
NOISE <GENERATIONS PER FILE>
CAIN B,1
NOISE <GENERATION PER FILE>
LDF A,CD%RET ;SPECIFY WHICH PARAMETER TO CHANGE
CALLRET DWORK ;DO THE WORK AND RETURN
;ROUTINE USED FOR SET DIRECTORY COMMANDS. IT ATTEMPTS TO DO THE CRDIR
;JSYS, AND IF IT FAILS DUE TO A PASSWORD BEING REQUIRED, IT ASKS FOR ONE
;AND TRIES AGAIN.
;
;ACCEPTS: A/ BITS SHOWING PARAMETER TO CHANGE (CRDIR AC2)
;
;RETURNS: +1 ALWAYS
DWORK: MOVEM A,WBITS ;REMEMBER WHICH BITS
CONFIRM ;CONFIRM THE COMMAND
MOVE A,WBITS ;GET BITS TO SET
CALL CREDIR ;TRY TO CHANGE THE DIRECTORY
JRST [ CALL DGETER ;FAILED, SEE WHY
CAIE A,ACESX3 ;PASSWORD REQUIRED AND NOT GIVEN?
CALL CJERRE ;OTHER ERROR, FAIL NOW
CALL GETPAS ;FAILED, ASK FOR A PASSWORD
MOVE A,WBITS ;TRY AGAIN
CALL CREDIR
CALL CJERRE ;FAILED AGAIN, TELL USER WHY AND DIE.
RET] ;SUCCEEDED, DONE
RET ;SUCCEEDED WITHOUT PASSWORD
;ROUTINE TO GET PASSWORD FOR SET DIRECTORY COMMANDS.
GETPAS: CALL PASLIN ;INPUT THE PASSWORD
MOVEM A,PASSP ;SAVE POINTER TO IT IN PASSP
RET
;ROUTINE TO EXECUTE CRDIR FOR USER-SETTABLE PARAMETERS.
;ACCEPTS:
; A/ BITS DESIGNATING PARAMETERS BEING CHANGED
;RETURNS: +1 ERROR
; +2 SUCCESS
;NOTE: THIS ROUTINE IS NOT GENERALLY CALLABLE, AS PASSP IS A LOCAL
;VARIABLE. TO MAKE IT GENERAL, MAKE PASSP BE AN ARG.
CREDIR: MOVE B,A ;PUT CONTROL BITS IN AC2 FOR JSYS
MOVE A,DIRP ;GET DIRECTORY NUMBER
MOVE C,PASSP ;AND POINTER TO PASSWORD
HRRI B,SEBLK ;SPECIFY WHERE PARAMETER BLOCK IS.
CRDIR ;MAKE THE DIRECTORY MODIFICATION
ERJMP R ;FAILED, PROBABLY BECAUSE PASSWORD REQUIRED OR WRONG
RETSKP ;SUCCEEDED, SKIP
; Set directory offline-expiration-default
.DONXP: MOVX A,.CDDNE
CAIA
.DOFXP: MOVX A,.CDDFE
PUSH P,A ; Save what we're changing
CALL INPDIR ; Get a directory name
NOISE <TO>
DTIVX <Expiration date>
CMERRX
POP P,A ; What we're changing
CAIN A,.CDDNE ; Guess we're changing online
JRST [ MOVEM B,.CDDNE+SEBLK ; We are
MOVX B,CD%NED
JRST DOFXP1]
MOVEM B,.CDDFE+SEBLK ; Wrong, is offline default
MOVX B,CD%FED
DOFXP1: HRRI B,.CDDFE+1 ; Length of the blk
MOVEM B,.CDLEN+SEBLK
MOVX A,CD%LEN ; Set this so bits in CDLEN are noticed
CALLRET DWORK ; Do it & return
;SET DIRECTORY FILE-PROTECTION-DEFAULT
.DFPD: CALL INPDIR ;GET DIRECTORY NAME
NOISE <TO>
OCTX <Octal default file-protection value>
CMERRX
MOVEM B,.CDFPT+SEBLK ;REMEMBER GIVEN VALUE
LDF A,CD%FPT ;SPECIFY WHICH PARAMETER WE'RE CHANGING
CALLRET DWORK ;GO DO THE WORK
;SET DIRECTORY PASSWORD
.DPASS: NOISE <OF DIRECTORY>
TLO Z,F1 ;DON'T DEFAULT THE DIRECTORY NAME
CALL DIRNAM ;READ THE DIRECTORY NAME
ERROR <Invalid directory name or syntax>
CALL BUFFF ;GET POINTER TO DIRECTORY NAME
MOVEM A,DIRP ;LEAVE DIRECTORY NAME IN DIRP
CONFIRM ;INPUT PASSWORDS ON SEPARATE LINES
MOVEI A,[ASCIZ /Old password: /]
CALL PASSX ;INPUT THE CURRENT PASSWORD
MOVEM A,PASSP ;SAVE POINTER TO IT IN PASSP
MOVEI A,[ASCIZ /New password: /]
CALL PASSX ;READ PASSWORD WITH NOISE WORDS "NEW PASSWORD"
MOVEM A,.CDPSW+SEBLK ;SAVE POINTER TO NEW PASSWORD STRING
MOVEI A,[ASCIZ /Retype new password: /]
CALL PASSX ;READ NEW PASSWORD AGAIN
MOVE B,.CDPSW+SEBLK ;GET FIRST ATTEMPT AT TYPING IT
STCMP ;MAKE SURE THEY'RE THE SAME
CAIE A,0 ;ARE THEY?
ERROR <The two copies of the new password weren't the same>
LDF A,CD%PSW ;SPECIFY WHAT WE'RE CHANGING
CALL CREDIR ;GO DO THE WORK
CALL CJERRE ;PRINT MONITOR'S ERROR MESSAGE IF FAILS
RET ;SUCCESS
;SET DIRECTORY ACCOUNT-DEFAULT
.DAD: CALL INPDIR ;GET NAME
NOISE (TO)
LINEX <Default account string for directory>
CMERRX
CALL BUFFF
MOVEM A,.CDDAC+SEBLK ;SAVE POINTER TO DEFAULT ACCOUNT STRING
MOVX A,CD%DAC ;BIT FOR SETTING DEFAULT ACCOUNT STRING
CALLRET DWORK ;DO THE WORK AND RETURN
;set directory protection
.DPRO: CALL INPDIR ;INPUT DIRECTORY NAME
NOISE <TO>
OCTX <Octal directory protection value>
CMERRX
MOVEM B,.CDDPT+SEBLK ;SAVE DESIRED DIRECTORY PROTECTION
LDF A,CD%DPT ;BIT FOR CHANGING DIRECTORY PROTECTION
CALLRET DWORK ;DO THE WORK AND RETURN
; Routine to change a single mode bit in a directory
DMODE: MOVEM A,WBITS ; Save the desired mode bit
MOVX A,RC%EMO ; Take as is only
MOVE B,DIRP ; Directory # in question
SETZ C,
RCDIR ; Get the directory #
MOVE A,C ; since GTDIR wants # not name
MOVEI B,SEBLK ; Read what things are now
SETZ C, ; Don't want to know the password
GTDIR
ERJMP [ETYPE <No access to directory>
RET]
MOVE A,WBITS ; Bit we wanted to change
IORM A,.CDMOD+SEBLK ; Assume we wanted to set it
SKIPE SETNOF ; Did command have a "NO" in it?
ANDCAM A,.CDMOD+SEBLK ; Yes, clear the bit
LDF A,CD%MOD ; Tell DWORK what to change
CALLRET DWORK ; Go do it
;THIS ROUTINE INPUTS THE DIRECTORY NAME FOR "SET DIRECTORY"
;COMMANDS.
INPDIR: NOISE <OF DIRECTORY>
TLO Z,F1 ;DON'T DEFAULT THE DIRECTORY NAME
CALL DIRNAM ;READ THE DIRECTORY NAME
ERROR <Invalid directory name or syntax>
CALL BUFFF ;GET POINTER TO DIRECTORY NAME STRING
MOVEM A,DIRP ;REMEMBER POINTER TO IT
RET
;"SET TAPE"
.TAPE: KEYWD $TAPE
0
JRST CERR
TXNE P3,ONEWRD
CONFIRM
JRST (P3)
$TAPE: TABLE
T DENSITY,,TDENSI ;"SET TAPE DENSITY (TO)"
T FORMAT,,TFRMAT ;"SET TAPE FORMAT (TO)"
T PARITY,,TPARIT ;"SET TAPE PARITY (TO)"
T RECORD-LENGTH,,TRECLN ;"SET TAPE RECORD-LENGTH (TO)"
TEND
TDENSI: NOISE <TO>
KEYWD $TDENS
T SYSTEM-DEFAULT,,.SJDDN
JRST CERR
NOISE <BPI>
CONFIRM
MOVEI B,.SJDEN ;SET DENSITY
SETJOB: MOVEI C,(P3) ;GET VALUE
SETTAP: MOVNI A,1 ;SET FOR OUR JOB
SETJB
ERCAL CJERRE
RET
;THIS TABLE MUST BE IN ALPHABETIC ORDER
;
$TDENS:: TABLE
T 1600,,.SJD16
T 200,,.SJDN2
T 556,,.SJDN5
T 6250,,.SJD62
T 800,,.SJDN8
T SYSTEM-DEFAULT,,.SJDDN
TEND
TFRMAT: NOISE <TO>
KEYWD $TFRMT
T SYSTEM-DEFAULT,,.SJDDM
JRST CERR
CONFIRM
MOVEI B,.SJDM
JRST SETJOB
$TFRMT: TABLE
T ANSI-ASCII,,.SJDMA
T CORE-DUMP,,.SJDMC
T HIGH-DENSITY,,.SJDMH
T INDUSTRY-COMPATIBLE,,.SJDM8
T SIXBIT,,.SJDM6
T SYSTEM-DEFAULT,,.SJDDM
TEND
TPARIT: NOISE <TO>
KEYWD $TPARI
T ODD,,.SJPRO
JRST CERR
CONFIRM
MOVEI B,.SJPAR ;SET PARITY
JRST SETJOB
$TPARI: TABLE
T EVEN,,.SJPRE
T ODD,,.SJPRO
TEND
TRECLN: NOISE <TO>
DECX <Number of bytes in decimal>
CMERRX
NOISE <BYTES>
CONFIRM
TLNE B,777777
ERROR<Number of bytes must be 0-262143>
MOVE C,B
MOVEI B,.SJRS
JRST SETTAP
;"SET SPOOLED-OUTPUT"
SPLSET: NOISE <TO>
KEYWD $SPSET
0
JRST CERR
TXNE P3,ONEWRD
CONFIRM
MOVEI B,.SJDFS
JRST SETJOB
$SPSET: TABLE
T DEFERRED,ONEWRD,.SJSPD
T IMMEDIATE,ONEWRD,.SJSPI
TEND
;Set [no] retrieval-wait (for offline files)
.OFL: NOISE <For offline files>
CONFIRM
SETO A, ; Our own job
MOVEI B,.SJDFR
MOVEI C,.SJRFA ; No retrieval-wait
SKIPN SETNOF
MOVEI C,.SJRWA ; Yes, retrieval-wait
SETJB
RET
;SET SESSION-REMARK (TO) TEXT
SETSRM: NOISE (TO)
CALL GSR ;GET SESSION REMARK
CONFIRM ;GET COMMAND CONFIRMATION
CALL SSR ;TELL SYSTEM THE REMARK
RET
;ROUTINE TO GET SESSION REMARK
;RETURNS POINTER IN A
GSR:: LINEX <Session remark, one line of text>
CMERRX
CALL BUFFF ;ISOLATE SESSION REMARK
RET
;ROUTINE TO SET SESSION REMARK. GIVE IT POINTER IN A.
SSR:: MOVE C,A ;PUT POINTER TO REMARK IN C
MOVEI B,.SJSRM ;FUNCTION FOR SETTING SESSION REMARK
MOVNI A,1 ;SPECIFY CURRENT JOB
SETJB ;SET REMARK
ERJMP .+2 ;COULDN'T SET SESSION REMARK
RET ;DONE
ETYPE <%%Couldn't set session remark
>
RET
;"SET CARD-READER-INPUT-SET"
CRDSET: NOISE <TO>
WORDX <Name of input set>
CMERRX
CALL BUFFF ;BUFFER NAME
MOVEM A,CDRSTR ;SET A CDR INPUT SET NAME
NOISE <STARTING WITH DECK NUMBER>
DEFX <1> ;DEFAULT TO DECK #1
DECX <Deck number in decimal>
cmerrx
SKIPN b
ERROR <Zero is illegal for deck number>
MOVEM b,CDRDCK
CONFIRM
HRLOI A,.DVDES+.DVCDR ;SET FOR ALL CDR'S
MOVEM A,CDRDEV
MOVE A,[3,,.SPLDI]
MOVEI B,CDRDEV ;ARGUMENT BLOCK
SPOOL
CALL CJERR
ret
$ESET: TABLE
T ARPANET,,.NETWK ;^ESET ARPANET
T DATE-AND-TIME,,SETTAD ;^ESET SYSTEM DATE-AND-TIME
T LOGINS-ALLOWED,,TTYLOG ;^ESET LOGINS-ALLOWED
T NO,NOLG,ESETNO ;^ESET NO
T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR ;^ESET OPERATOR
T RUN-TIME-GUARANTEE,,.JRUNG ;^ESET JOB RUN-TIME
T TERMINAL,,ETERMI ;^ESET TERMINAL (NUMBER)
TEND
ESETNO: SETOM SETNOF ;FLAG NO TYPED
KEYWD $ESETN
0
JRST CERR
TXNE P3,NOLG ;NEED TO BE LOGGED IN?
SKIPE CUSRNO ;YES, ARE WE?
CAIA ;OK
ERROR <LOGIN please>
TXNE P3,ONEWRD ;COMMAND TO BE CONFIRMED HERE?
CONFIRM ;YES
JRST (P3) ;DISPATCH TO COMMAND
$ESETN: TABLE
T LOGINS-ALLOWED,,TTYLOG ;^ESET NO LOGINS-ALLOWED
T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR ;^ESET NO OPERATOR
T RUN-TIME-GUARANTEE,,.JRUNG ;^ESET NO RUN-TIME
TEND
;"^ESET TERMINAL (NUMBER)"
ETERMI: STKVAR <ETNM>
NOISE <NUMBER>
octx <Octal terminal number>
CMERRX
MOVEM B,ETNM
MOVE A,CSBUFP ;GET SOME SCRATCH SPACE
MOVEI C,0 ;END STRING OUTPUT ON NULL
HRROI B,[ASCIZ /TTY/] ;MAKE DEVICE NAME
SOUT
MOVE B,ETNM ;GET NUMBER HE TYPED
MOVEI C,8 ;OCTAL
NOUT ;MAKE "TTYnnn"
ERCAL JERRE ;SHOULD NEVER FAIL
MOVE A,CSBUFP ;POINT AT THE NAME
STDEV ;GET DESIGNATOR FOR IT
ERCAL CJERRE ;FAILED, TELL USER THAT TERMINAL DOESN'T EXIST
MOVEM B,ETNM ;REMEMBER DESIGNATOR
KEYWD $ETERM
0
JRST CERR
MOVE A,ETNM ;GET TERMINAL DESIGNATOR
JRST (P3)
$ETERM: TABLE
T SPEED,,SPEEDA
TEND
;"^ESET [NO] SYSTEM LOGINS-ALLOWED"
TTYLOG: NOISE <ON>
KEYWD $LGTTY
T ANY-TERMINAL,ONEWRD,.ANTTY
JRST CERR
TXNE P3,ONEWRD
CONFIRM
JRST (P3)
$LGTTY: TABLE
T ANY-TERMINAL,ONEWRD,.ANTTY
T ARPANET-TERMINALS,ONEWRD,.NVTTY
T CONSOLE-TERMINAL,ONEWRD,.CNTTY
T LOCAL-TERMINALS,ONEWRD,.LCTTY
T PSEUDO-TERMINALS,ONEWRD,.PSTTY
T REMOTE-TERMINALS,ONEWRD,.RMTTY
TEND
;DO SET FOR ALL TERMINALS
.ANTTY: CALL .CNTTY
CALL .LCTTY
CALL .NVTTY
CALL .PSTTY
CALLRET .RMTTY
.CNTTY: MOVEI A,.SFCTY
JRST DOSTTY
.LCTTY: MOVEI A,.SFLCL
JRST DOSTTY
.NVTTY: MOVEI A,.SFNVT
JRST DOSTTY
.PSTTY: MOVEI A,.SFPTY
JRST DOSTTY
.RMTTY: MOVEI A,.SFRMT
DOSTTY: SKIPE SETNOF ;NO?
TDZA B,B ;DISALLOW LOGINS
MOVEI B,1 ;ALLOW LOGINS
SMON
ERCAL CJERRE
RET
;"^ESET ARPANET" ON OR OFF
.NETWK: KEYWD $NETOO ;OFF OR ON
T ON,,NETON
JRST CERR
CONFIRM
JRST (P3)
$NETOO: TABLE
T OFF,,NETFF
T ON,,NETON
TEND
NETFF: TDZA B,B
NETON: MOVEI B,1
MOVEI A,.SFNTN ;SET ARPANET OFF OR ON
SMON
ERCAL CJERRE ;SHOULD SUCCEED EVEN IN NON-NET SYSTEMS
RET
;"^ESET SYSTEM OPERATOR-IN-ATTENDANCE"
SETOPR: MOVEI A,.SFOPR
SKIPE SETNOF
TDZA B,B ;NO OPERATOR
MOVEI B,1 ;OPERATOR IN ATTENDANCE
SMON
ERCAL CJERRE
RET
.JRUNG: NOISE <FOR JOB>
DECX <Job number in decimal>
CMERRX
PUSH P,B ;SAVE JOB NUMBER
SKIPE SETNOF ;NO?
JRST [SETZ B, ;YES, 0 PERCENTAGE
JRST .JRUN1]
NOISE <TO>
decx <Percentage>
CMERRX
NOISE <PERCENT>
CAIL B,1
CAILE B,^D100
ERROR <Run time guarantee percentage must be from 1-100>
.JRUN1: CONFIRM
HRLZ B,B ;MAKE LEFT HALF NUMBER
POP P,A ;GET JOB NUMBER BACK
SJPRI ;SET IT
ERJMP CJERRE
RET
;SET TIME-LIMIT (TO) N
.TIME: NOISE <TO>
DECX <Number of seconds>
CMERRX
NOISE <SECONDS>
CONFIRM
JUMPE B,[ERROR <Use "SET NO TIME-LIMIT" command>]
IMULI B,^D1000 ;MAKE IT MILLISECONDS
PUSH P,B
MOVEI A,.FHJOB
RUNTM ;GET TIME IN MILLISECONDS
POP P,B
ADD B,A ;ADD TO GET FINAL RUNTIME
MOVE A,[.FHJOB,,.TIMRT] ;SET TIME LIMIT CODE
MOVEI C,4 ;CHANNEL
TIMER
CALL CJERR
RET
.NOTIM: CONFIRM
IFNBATCH NOTIM1
MOVE A,[.FHJOB,,.TIMRT] ;SET TIME LIMIT CODE
SETZB B,C ;NO TIME, (HENCE NO CHANNEL)
TIMER
CALL CJERR
RET
NOTIM1: ERROR <Attempt to clear time limit during BATCH process>
;^ESET SYSTEM TIME-AND-DATE (TO)
SETTAD::NOISE <TO>
dtx <Date and time>
CMERRX
CONFIRM ;CHECK TERMINATOR, INPUT CR IF NECESSARY
MOVE A,B ;PUT TIME AND DATE INTO AC1
STAD ;SET TIME AND DATE
CALL CJERR
RET
ECEASE::NOISE <TIMESHARING AT>
dtx <Date and time or null to cancel shutdown>
jrst cease3
jrst dt1 ;got a time and date
dt1: PUSH P,b
NOISE <RESUMING AT>
dtx <Date and time of restart or null if unknown>
JRST CEASE4 ;no date and time typed
CEASE1: CONFIRM
SKIPN (P)
JRST CEASE2 ;SKIP CHECK IF CANCELING
GTAD
CAML A,(P)
ERROR <Down time has already passed>
JUMPE B,CEASE2
CAMGE B,(P)
ERROR <Timesharing will resume before it ends!>
CEASE2: POP P,A
HSYS
JRST CJERR
RET
CEASE3: PUSH P,[0]
CEASE4: SETZ B,
JRST CEASE1
END