Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-exec/execse.mac
There are 47 other files named execse.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-EXEC>EXECSE.MAC.17, 15-May-85 17:08:01, Edit by HSS
; [NIC1041] Different SET TERMINAL COMMAND
;[SRI-NIC]SRC:<6-EXEC>EXECSE.MAC.16, 9-May-85 16:59:07, Edit by HSS
; [NIC1033] Add autokeep sttribute code.
;[SRI-NIC]PS:<HSS.EXEC>EXECSE.MAC.15, 17-Apr-85 12:33:15, Edit by HSS
; [NIC1017] Add SET HISTORY
;[SRI-NIC]PS:<HSS.EXEC>EXECSE.MAC.14, 11-Apr-85 14:05:33, Edit by HSS
; [NIC1011] Allow ^C-capability in batch jobs so Augment will work.
;<6-EXEC>EXECSE.MAC.13, 4-Jan-85 14:04:59, Edit by SATZ
; Make the SET [NO] TRAP [NO] PROCEED confirm before recording the facts
;<6-EXEC>EXECSE.MAC.12, 19-Oct-84 19:30:23, Edit by LOUGHEED
; Fix bug in edit 10
;<6-EXEC>EXECSE.MAC.11, 6-Sep-84 17:43:38, Edit by SATZ
; CM156 Fix COMMAND-TRACE ^U bug from CMU
;<6-EXEC>EXECSE.MAC.10, 26-Aug-84 23:09:40, Edit by SATZ
; Add some sanity code against the input protection
;<6-EXEC>EXECSE.MAC.9, 25-Aug-84 01:27:53, Edit by SATZ
; Add in SET [NO] LEVEL-INDICATION
;<6-EXEC>EXECSE.MAC.8, 24-Aug-84 16:03:55, Edit by SATZ
; Add in SET PROMPT
;<6-EXEC>EXECSE.MAC.7, 23-Aug-84 16:07:41, Edit by SATZ
; Removed extraneous line causing INPDIR to not default the correct directory
;<6-EXEC>EXECSE.MAC.6, 9-Aug-84 01:22:09, Edit by LOUGHEED
;<6-EXEC>EXECSE.MAC.5, 8-Aug-84 23:49:43, Edit by LOUGHEED
; Remove SET EXTRA cruft
; Reinstall account string code everywhere. Yes, only SUMEX uses it, but
; why mess up sources with pointless conditionals?
;SCORE:<MERGED-6-EXEC>EXECSE.MAC.2, 12-Jul-84 07:48:14, Edit by JPBION
;SUMEX changes:
; Reinstall account stuff but not session remark
; Check for valid account in SET DIRECTORY ACCOUNT-DEFAULT command
; ^ESET ETHERNET ON/OFF.
;LOTS changes:
; SET EXTRA commands
; CERAS and TERMAN nodes
; Check new passwords for special chars
;Stanford changes:
; New passwords must be six or more characters in length (in SET DIR PASS).
; - BUILD will still accept shorter passwords
; Various ^ESET PUP ... commands
; SET [NO] NEW-FORK (ON RESET)
; SET FILE PERMANENT
; SET FILE SAVE-BY-BACKUP-SYSTEM
; SET FILE TEMPORARY
; ^ESET [NO] LOGINS-ALLOWED (ON) ETHERNET-TERMINALS
; Remove all account and session remark stuff
; Fix error if % in an alert message text
; Remove unnecessary code duplication in .DPASS
; Initialize block in DMODE
; Allow defaulting in SET DIRECTORY commands
; Remove ^ESET DATE-AND-TIME
; Stanford CEASE command
; Add SET TYPEOUT RADIX
;
; UPD ID= 401, SNARK:<6.EXEC>EXECSE.MAC.42, 26-Apr-84 15:11:07 by PRATT
;TCO 6.2050 - Fix problem with arpa monitor / no host # set
; UPD ID= 398, SNARK:<6.EXEC>EXECSE.MAC.41, 3-Apr-84 09:19:11 by EVANS
;TCO 6.2012 - Replace FORTRAN ".LE." in message prompt for SET ALERT.
; UPD ID= 391, SNARK:<6.EXEC>EXECSE.MAC.40, 27-Feb-84 09:43:20 by PRATT
;TCO 6.1956 - Add ^Eset [no] FAST-LOGINS-ALLOWED
; UPD ID= 390, SNARK:<6.EXEC>EXECSE.MAC.38, 27-Feb-84 09:27:30 by PRATT
;TCO 6.1982 - Fix the ^ESET commands which aren't "confirm"ing
; UPD ID= 389, SNARK:<6.EXEC>EXECSE.MAC.37, 27-Feb-84 08:15:25 by PRATT
;More TCO 6.1956 - Fix typeo at CEASE3 code
; UPD ID= 388, SNARK:<6.EXEC>EXECSE.MAC.36, 27-Feb-84 07:35:55 by PRATT
;TCO 6.1967 - Do a confirm, and add the NOW arg for ^ECEASE
; UPD ID= 382, SNARK:<6.EXEC>EXECSE.MAC.35, 24-Jan-84 16:56:13 by PAETZOLD
;more TCO 6.1953 - Add some ^ESET commands. Add entries to the no table.
; UPD ID= 381, SNARK:<6.EXEC>EXECSE.MAC.34, 24-Jan-84 16:46:27 by PAETZOLD
;more TCO 6.1953 - Add some ^ESET commands. fix a typeo.
; UPD ID= 380, SNARK:<6.EXEC>EXECSE.MAC.33, 24-Jan-84 16:35:43 by PAETZOLD
;TCO 6.1953 - Add some ^ESET commands.
; UPD ID= 347, SNARK:<6.EXEC>EXECSE.MAC.32, 28-Nov-83 16:37:33 by LOMARTIRE
;More TCO 6.1676 - Improve error message "Invalid terminal range specified"
; UPD ID= 341, SNARK:<6.EXEC>EXECSE.MAC.31, 20-Nov-83 19:45:16 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 316, SNARK:<6.EXEC>EXECSE.MAC.30, 26-Oct-83 13:58:05 by PRATT
;TCO 6.1842 - No negative args and new error messages for SET TIME-LIMIT
; UPD ID= 287, SNARK:<6.EXEC>EXECSE.MAC.29, 14-Jun-83 11:56:25 by LOMARTIRE
;TCO 6.1676 - Allow range of terminal lines in ^ESET TERMINAL command
; UPD ID= 259, SNARK:<6.EXEC>EXECSE.MAC.28, 11-Feb-83 14:29:09 by TSANG
;TCO 6.1500 - Don't allow ESC to confirm SET LATE-CLEAR-TYPEAHEAD command
; UPD ID= 257, SNARK:<6.EXEC>EXECSE.MAC.27, 8-Feb-83 10:29:29 by TSANG
;TCO 6.1494 - Fix SET TRAP NO NO NO..... problem
; UPD ID= 249, SNARK:<6.EXEC>EXECSE.MAC.26, 15-Jan-83 19:27:15 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 220, SNARK:<6.EXEC>EXECSE.MAC.25, 11-Jan-83 13:51:56 by TSANG
;TCO 6.1116 - Fix SET TIME-LIMIT confusion
; UPD ID= 213, SNARK:<6.EXEC>EXECSE.MAC.24, 3-Jan-83 17:08:41 by LOMARTIRE
;TCO 6.1433 - Add code for ^ESET [NO] LOGINS-ALLOWED DECNET-LINES command
; UPD ID= 196, SNARK:<6.EXEC>EXECSE.MAC.23, 18-Nov-82 10:46:31 by PAETZOLD
;TCO 6.1384- Remove the ^ESET ARPANET commands
; UPD ID= 189, SNARK:<6.EXEC>EXECSE.MAC.22, 1-Nov-82 16:22:55 by WEETON
;TCO 6.1335 - Only ask for old password when nessesary
; UPD ID= 163, SNARK:<6.EXEC>EXECSE.MAC.21, 27-Sep-82 16:58:27 by ACARLSON
;Add USERID option to ^ESET PRIVATE-QUASAR (for GALAXY)
; UPD ID= 149, SNARK:<6.EXEC>EXECSE.MAC.20, 5-Aug-82 20:35:33 by LEACHE
;TCO 6.1215 Remove bogus JUMPN from JSYS trap code
; UPD ID= 142, SNARK:<6.EXEC>EXECSE.MAC.19, 4-Aug-82 17:28:57 by LEACHE
;TCO 6.1209 Fix JSYS trapping
; UPD ID= 100, SNARK:<6.EXEC>EXECSE.MAC.17, 8-Jan-82 15:59:45 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 80, SNARK:<6.EXEC>EXECSE.MAC.16, 20-Dec-81 18:10:18 by CHALL
;TCO 6.1049 .LOCAT- DON'T REQUIRE "::" IN NODE NAME (SET CM%NSF)
; UPD ID= 77, SNARK:<6.EXEC>EXECSE.MAC.15, 6-Nov-81 12:59:10 by CHALL
;TCO 5.1602 ALRDL7- FIX: "SET NO AL BEF" CLEARED ALL ALERTS
; UPD ID= 42, SNARK:<6.EXEC>EXECSE.MAC.12, 27-Aug-81 14:31:40 by GROUT
;TCO 5.1477 .PAXL- ADD ERJMP CJERRE AFTER SCVEC
; UPD ID= 41, SNARK:<6.EXEC>EXECSE.MAC.11, 21-Aug-81 14:31:40 by CHALL
;ADD DEFAULTS FOR THESE COMMANDS, WHICH TAKE A SINGLE KEYWORD:
;"SET DEF TAKE NO", "SET DIR NO", "^ESET TERM"
; UPD ID= 38, SNARK:<6.EXEC>EXECSE.MAC.9, 19-Aug-81 10:57:37 by CHALL
;TCO 5.1463 .NODEF: MOVE "SET NO DEFAULT" OPTIONS TABLE TO EXECCA
; UPD ID= 22, SNARK:<6.EXEC>EXECSE.MAC.8, 17-Aug-81 10:19:31 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
;.TYPEO: MAKE "MODE" BE THE DEFAULT FOR SET TYPEOUT
;TCO 5.1443 - TJSYS: ALLOW SET TRAP JSYS TO TAKE OCTAL ARGUMENTS
; UPD ID= 3, SNARK:<6.EXEC>EXECSE.MAC.6, 14-Jul-81 12:54:32 by CHALL
;TCO 5.1411 - DMODE: NEED TO SET LENGTH IN GTDIR BLOCK
; UPD ID= 2257, SNARK:<6.EXEC>EXECSE.MAC.4, 26-Jun-81 09:12:33 by CHALL
;TCO 5.1388 - .ALERT: IF NEW ALERT IS AT SAME TIME AS AN OLD ONE, SUPERCEDE OLD
;<6.EXEC>EXECSE.MAC.3, 12-Jun-81 14:18:33, EDIT BY HELLIWELL
;MAKE .KFRKC AND .NOLM INTERNAL (::)
; UPD ID= 1729, SNARK:<6.EXEC>EXECSE.MAC.2, 18-Mar-81 16:34:40 by OSMAN
;tco 6.1007 - Fix "SET ALERT +0" to not set alert to be tomorrow.
;REMOVE MFRK CONDITIONALS
;<4.EXEC>EXECSE.MAC.1, 28-Jul-80 15:06:24, Edit by DK32
;Programmable Command Language
; UPD ID= 1439, SNARK:<5.EXEC>EXECSE.MAC.18, 15-Jan-81 10:52:03 by OSMAN
;Tco 5.1233 - Make FILE-OPENINGS and JSYS OPENF independent
; UPD ID= 1427, SNARK:<5.EXEC>EXECSE.MAC.17, 9-Jan-81 11:18:02 by OSMAN
;More 5.1225 - Make "SET TRAP NO" and "SET NO TRAP" equivalent. Also,
;make "SET NO TRAP<cr>" get rid of all traps
; UPD ID= 1402, SNARK:<5.EXEC>EXECSE.MAC.16, 6-Jan-81 10:28:05 by OSMAN
;tco 5.1225 - Implement jsys trapping and file-opening trapping!
; UPD ID= 1386, SNARK:<5.EXEC>EXECSE.MAC.15, 29-Dec-80 09:12:09 by OSMAN
; Make SET NO ALERT take input the same as SET ALERT, so SET ALERT 300 followed
;immediately by SET NO ALERT 300 will usually work (not always since day may
;change!)
; UPD ID= 1338, SNARK:<5.EXEC>EXECSE.MAC.14, 8-Dec-80 10:07:54 by ACARLSON
;<GALAXY.DEVELOPMENT>EXECSE.MAC.2, 8-Dec-80 09:55:28, EDIT BY ACARLSON
;TCO 5.1210 - Add commands ^ESET (NO) PRIVATE-QUASAR for debugging GALAXY
; UPD ID= 1325, SNARK:<5.EXEC>EXECSE.MAC.13, 1-Dec-80 16:02:58 by OSMAN
; UPD ID= 1203, SNARK:<5.EXEC>EXECSE.MAC.12, 27-Oct-80 14:32:35 by OSMAN
;Fix SET NO ALERT
; UPD ID= 1132, SNARK:<5.EXEC>EXECSE.MAC.11, 6-Oct-80 10:44:10 by OSMAN
;tco 5.1167 - Remove "SET FILE [NO] AUTOKEEP"
; UPD ID= 1045, SNARK:<5.EXEC>EXECSE.MAC.10, 25-Sep-80 14:21:53 by OSMAN
;tco 5.1156
; UPD ID= 1027, SNARK:<5.EXEC>EXECSE.MAC.9, 22-Sep-80 10:38:01 by OSMAN
;tco 5.1150 - Add SET PROGRAM
; UPD ID= 859, SNARK:<5.EXEC>EXECSE.MAC.8, 10-Aug-80 15:20:23 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
; UPD ID= 804, SNARK:<5.EXEC>EXECSE.MAC.7, 28-Jul-80 10:25:44 by OSMAN
;tco 5.1114 - Don't give error on SET NO ALERT if none to remove
;<5.EXEC>EXECSE.MAC.6, 30-May-80 16:49:20, EDIT BY MURPHY
;PUT NEW MAIL WATCH AND ALERT UNDER NEWF
; UPD ID= 539, SNARK:<5.EXEC>EXECSE.MAC.5, 20-May-80 15:46:45 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 520, SNARK:<5.EXEC>EXECSE.MAC.4, 14-May-80 13:20:26 by OSMAN
;Don't make past time mean tomorrow if date was typed
; UPD ID= 495, SNARK:<5.EXEC>EXECSE.MAC.3, 30-Apr-80 14:34:58 by OSMAN
;Fix confirmation on TAKE subcommands and SET DEFAULT TAKE
;<4.1.EXEC>EXECSE.MAC.6, 25-Mar-80 10:39:43, EDIT BY OSMAN
;More ONEWRD fixes on SET PAGE-ACCESS
;<4.1.EXEC>EXECSE.MAC.5, 17-Mar-80 14:07:49, EDIT BY OSMAN
;Get rid of ONEWRD checks
; UPD ID= 93, SNARK:<4.1.EXEC>EXECSE.MAC.4, 5-Dec-79 10:24:11 by OSMAN
;tco 4.2589 - Change $DEFAU to TDEFAU to not conflict with GLXLIB
;<4.1.EXEC>EXECSE.MAC.2, 20-Nov-79 14:01:16, EDIT BY OSMAN
;TCO 4.1.1023 - Fix TAKE stuff
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982,1983 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
TTITLE EXECSE
;THIS FILE CONTAINS
;SET AND ^ESET COMMANDS
DEFINE SETSTG
< TRVAR <ATIME,NOW,AHELP,<ARANGE,2>,ENTADR,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>
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>
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>
ADDRX <Location on which to break>
ERROR <Invalid address>
TDNN B,[777776,,777760] ;CAN'T SET BREAK ON ANY ACS
ERROR <Address break won't work on the ACs>
TLNE B,777740 ;CHECK FOR TOO LARGE AN ADDRESS
ERROR <Break address not between 0 and 37,,777777>
PUSH P,B ;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>
MOVEM B,ABKCNT ;REMEMBER IT
CALLRET CONF ;CONFIRM AND RETURN
.ALL: TXO P1,AB%RED!AB%WRT!AB%XCT!1
NOISE <TYPES OF REFERENCES>
CALLRET CONF ;CONFIRM AND RETURN
.EXE: TXOA P1,AB%XCT!1
.REA: TXO P1,AB%RED!1
NOISE <REFERENCES>
CALLRET CONF ;CONFIRM AND RETURN
.WRI: TXOA P1,AB%WRT!1
.NON: TXOA P1,1
NOISE <REFERENCES>
CALLRET CONF ;CONFIRM AND RETURN
.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>
JRST (P3) ;DISPATCH TO COMMAND
;SET TRAP IS FOR CONTROLLING JSYS AND UUO TRAPPING
.TRAP:: KEYWD TRAPT
0 ;NO DEFAULT
CMERRX ;INVALID KEYWORD AFTER "TRAP" TYPED
CALLRET (P3) ;DO WHAT WAS ASKED AND RETURN
;SET NO TRAP AND SET TRAP NO TURN OFF VARIOUS TRAPPING
TRAPN: SETOM SETNOF ;REMEMBER THAT "NO" TYPED
NTRAP:: SKIPGE SETNOF ;IS "NO" ALREADY TYPED?
SKIPA B,[[FLDDB. .CMCFM,CM%SDH,,<Carriage return to turn off all traps>,,[
FLDDB. .CMKEY,,TRAPT1]]] ;YES, USE TABLE TRAPT1
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to turn off all traps>,,[
FLDDB. .CMKEY,,TRAPT]] ;NO, USE TABLE TRAPT
CALL FLDSKP ;READ WHAT'S AFTER "SET NO TRAP" OR "SET TRAP NO"
CMERRX
LOAD D,CM%FNC,.CMFNP(C) ;GET WHAT WAS TYPED
CAIN D,.CMCFM ;JUST CARRIAGE RETURN?
JRST UNTRAP ;YES, GO UNTRAP EVERYTHING
CALL GETKEY ;KEYWORD TYPED, GET INFO
CALLRET (P3)
TRAPT: TABLE
T FILE-OPENINGS,,FOPEN ;SET TRAP FILE-OPENINGS
T JSYS,,TJSYS ;SET TRAP JSYS X
T NO,,TRAPN ;SET TRAP NO
T PROCEED,,TPROC ;SET TRAP PROCEED
TEND
TRAPT1: TABLE
T FILE-OPENINGS,,FOPEN ;SET TRAP FILE-OPENINGS
T JSYS,,TJSYS ;SET TRAP JSYS X
T PROCEED,,TPROC ;SET TRAP PROCEED
TEND
;SET [NO] TRAP PROCEED CONTROLS WHETHER A JSYS OR UUO TRAPPED PROGRAM
;SHOULD PROCEED AUTOMATICALLY FROM THE TRAP. THIS COMMAND CONTROLS THE
;CURRENT FORK ONLY.
TPROC: NOISE (AUTOMATICALLY AFTER TRAPS)
IFN STANSW,<
CONFIRM
>;IFN STANSW
SKIPN SETNOF ;DIFFERENT ACTION ACCORDING TO "NO" FLAG
SETZM TSTOPF ;SET TRAP PROCEED
SKIPE SETNOF
SETOM TSTOPF ;SET NO TRAP PROCEED
IFE STANSW,<
CALLRET CONF ;CONFIRM AND RETURN
>;IFE STANSW
IFN STANSW,<
RET
>;IFN STANSW
;SET TRAP JSYS X CAUSES AN ANNOUNCEMENT EVERY TIME JSYS X IS EXECUTED
;FOR ANY FORK
TJSYS: MOVEM P,SAVSP ;SAVE STACK POINTER
MOVEI A,RESP ;GET CLEANUP ROUTINE
PUSH P,A ;PUT IT ON STACK
SETZM Q3 ;RESET FLAG
NOISE (NAMED OR NUMBERED)
MOVEI B,[FLDDB. .CMSWI,CM%DPP,JSWI,,</DEFINED>,[
FLDDB. .CMNUM,CM%SDH,10,<Octal JSYS number>,,[
FLDBK. .CMKEY,CM%SDH,JTAB,<JSYS name>,,[
BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<%>)],]]]
JRST PRSJ0 ;GO PARSE INPUT
PRSJSY: SETOM Q3 ;INDICATE PAST FIRST FIELD
MOVEI B,[FLDDB. .CMNUM,CM%SDH,10,<Octal JSYS number>,,[
FLDBK. .CMKEY,CM%SDH,JTAB,<JSYS name>,,[
BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<%>)]]]
PRSJ0: CALL SAVCM ;SAV COMND POINTERS
CALL FLDSKP ;READ JSYS NAME OR NUMBER
PRSJ1: JRST [SKIPN Q3
ETYPE <%@?JSYS name, JSYS number or switch required: %b%%_>
SKIPE Q3
ETYPE <%@?JSYS name or JSYS number required: %b%%_>
MOVE P,SAVSP ;RESET STACK MANUALLY
RET ]
PRSJ2: LOAD D,CM%FNC,.CMFNP(C) ;SEE WHAT WAS TYPED
NAMTST: CAIE D,.CMKEY ;NAME?
JRST NUMTST ;NO
HRRZI A,-JTAB(B) ;GET THE JTAB INDEX
LDB A,[POINT 9,JTAB(A),26] ;GET THE JSYS NUMBER
PUSH P,A ;STORE ON STACK
JRST PRSCOM ;TRY FOR COMMA/CONFIRM
NUMTST: CAIE D,.CMNUM ;AN OCTAL NUMBER?
JRST SWTST ;NO
SKIPLE B ;GREATER THAN ZERO?
CAIL B,JLEN ;LESS THAN MAX JSYS?
JRST [ETYPE <%@?Not a valid JSYS number: %b%%_>
MOVE P,SAVSP ;RESET STACK
CALLRET RESCM] ;BACK UP TO PREVIOUS ATOM
PUSH P,B ;SAVE VALUE
JRST PRSCOM ;TRY FOR COMMA/CONFIRM
SWTST: SKIPN Q3 ;SKIP TEST 2- N'TH TIME
CAIE D,.CMSWI ;A SWITCH?
JRST PRSJ1 ;NO, GO COMPLAIN
JRST [ CALL GETKEY ;YES, SEE WHICH ONE
JRST (P3)] ;GO EXECUTE THE SWITCH
PRSCOM: MOVEI B,[FLDDB. .CMCMA,,,,,[
FLDDB. .CMCFM]]
CALL FLDSKP
PRSCM1: JRST [ETYPE <?Comma or confirmation required%_>
RET]
LOAD D,CM%FNC,.CMFNP(C) ;SEE WHAT WAS TYPED
CMATST: CAIN D,.CMCMA ;COMMA?
JRST PRSJSY ;YES - BACK FOR MORE
CFMTST: CAIE D,.CMCFM ;CONFIRMED?
JRST PRSCM1 ;NO - GO COMPLAIN, UNKNOWN ATOM
POPLP: HRRZ A,(P) ;GET TOP OF STACK
CAIN A,RESP ;DONE ALL?
JRST SETBR ;YES, SET TRAP STATUS AND RETURN
POP P,A ;GET THE JSYS NUMBER
CAMN A,[FLD(OPENF,YFLD)];IS THIS OPENF?
JRST [ SETCM C,SETNOF ;YES, GET CORRECT VALUE FOR TOPENF
MOVEM C,TOPENF ;REMEMBER WHETHER WE'RE TRAPPING OPENF OR NOT
JRST .+1]
MOVE C,A ;GET THE JSYS NUMBER
MOVE Q1,A ;ALSO GET IT HERE
MOVE D,[POINT 1,JSBDEF] ;GET BYTE POINTER TO BIT MASK
ADJBP C,D ;INCREMENT TO THE BIT FOR THAT JSYS
ILDB D,C ;GET THE BIT
MOVEI B,JSBDEF ;GET ADDRESS OF BREAK MASK
SKIPN SETNOF ;CLEAR OR SET BIT ACCORDING TO YES OR NO
JRST SETB ;SET IT
JUMPE D,POPLP ;IT WAS ALREADY CLEAR, BACK FOR NEXT JSYS
LDB D,[POINT 9,JTAB(Q1),35] ;BIT WAS SET. DEFINED JSYS?
SKIPE D ; ...
SOS TRAPD ;IT WAS DEFINED
SKIPN D ;...
SOS TRAPU ;IT WAS UNDEFINED
CALL CLRBIT ;AND CLEAR THE BIT
JRST POPLP ;BACK FOR NEXT JSYS
SETB: JUMPN D,POPLP ;THE BIT WAS ALREADY SET, BACK FOR NEXT JSYS
LDB D,[POINT 9,JTAB(Q1),35] ;BIT WAS CLEAR. DEFINED JSYS?
SKIPE D ;...
AOS TRAPD ;IT WAS DEFINED
SKIPN D ;...
AOS TRAPU ;IT WAS UNDEFINED
CALL SETBIT ;SET IT
JRST POPLP ;BACK FOR NEXT JSYS
SETBR: CALL MRKTRP ;SET UP NEW TRAP STATUS
SJTRET: RET ;RETURN
RESP: MOVE P,SAVSP ;THIS IS A STACK CLEAN-UP ROUTINE
RET
;JSWI IS TABLE OF SWITCHES FOR SET TRAP JSYS
JSWI: TABLE
T ALL,,JALL ;SET TRAP JSYS /ALL
T DEFINED,,JDEF ; /DEFINED
T UNDEFINED,,JUND ; /UNDEFINED
TEND
;UNTRAP UNTRAPS EVERYTHING
UNTRAP: SETZM TFILEF ;SAY WE'RE NOT TRAPPING FILE-OPENINGS
CALLRET JALL3 ;GO UNTRAP ALL JSYS'S TOO
;JALL CONFIRMS AND EXECUTES "SET (NO) TRAP JSYS /ALL"
JALL: CONFIRM ;NOTE THAT SWITCH INTEAD OF KEYWORD ALLOWS A JSYS TO BE CALLED "ALL"
JALL3: MOVEI A,JSBDEF ;SAY WHERE BLOCK IS
SKIPE SETNOF ;CLEAR OR SET ALL BITS ACCORDING TO "NO"
JRST JALNO ;GO HANDLE SET NO TRAP JSYS /ALL
CALL SETALL
SETOM TOPENF ;SAY OPENF SHOULD BE TRAPPED
MOVEI B,SJLEN ;GET DEFINED COUNT
MOVEM B,TRAPD ;SAVE IT
MOVEI A,JLEN-1 ;GET TOTAL COUNT
SUB A,B ;GET UNDEFINED COUNT
MOVEM A,TRAPU ;SAVE IT
JRST JALL2
JALNO: CALL CLRALL
SETZM TRAPU ;CLEAR UNDEFINED COUNT
SETZM TRAPD ;CLEAR DEFINED COUNT
SETZM TOPENF ;SAY OPENF IS NOT BEING TRAPPED AS A JSYS
JALL2: MOVE A,FORK ;SAY WHICH FORK
CALLRET MRKTRP ;SET UP NEW TRAP STATUS
;JDEF COMFIRMS AND EXECUTES SET (NO) JSYS TRAP /DEFINED
JDEF: CONFIRM
SETOM TOPENF ;ASSUME TRAPPING OPENF
SKIPE SETNOF ;DID HE SAY NO?
SETZM TOPENF ;YES, SAY OPENF SHOULD NOT BE TRAPPED
MOVE Q1,[-SJLEN,,1] ;GET AOBJN POINTER
JDSLP: LDB C,[POINT 9,JTAB(Q1),26] ;GET THE JSYS NUMBER
MOVEM C,A ;KEEP A COPY IN A
MOVE B,[POINT 1,JSBDEF] ;GET BYTE POINTER TO BIT MASK
ADJBP C,B ;INCREMENT TO THE BIT FOR THAT JSYS
ILDB C,C ;GET THE BIT
MOVEI B,JSBDEF ;GET MASK ADDRESS
SKIPN SETNOF ;CLEAR OR SET ALL BITS ACCORDING TO "NO"
CALL SETBIT ;SET THE BIT
SKIPE SETNOF ;...
CALL CLRBIT ;CLEAR THE BIT
JDSN: AOBJN Q1,JDSLP ;BACK FOR MORE
MOVEI A,SJLEN ;GET NUMBER OF DEFINED JSYSES
MOVEM A,TRAPD ;MAKE THAT THE COUNT
SKIPE SETNOF ;DID HE SAY NO?
SETZM TRAPD ;YES
CALLRET MRKTRP ;SET UP NEW TRAP STATUS
;JUND COMFIRMS AND EXECUTES SET (NO) JSYS TRAP /UNDEFINED
JUND: CONFIRM
MOVE Q1,[-JLEN+1,,1] ;GET INCREMENTED AOBJN POINTER
JUSLP: LDB A,[POINT 9,JTAB(Q1),35] ;IS THIS AN UNDEFINED JSYS?
JUMPN A,JUSN ;NO
HRRZ D,Q1 ;GET THE JSYS NUMBER
MOVE B,[POINT 1,JSBDEF] ;GET BYTE POINTER TO BIT MASK
ADJBP D,B ;INCREMENT TO THE BIT FOR THAT JSYS
ILDB D,D ;GET THE BIT
HRRZ A,Q1 ;GET JSYS NUMBER
MOVEI B,JSBDEF ;GET MASK ADDRESS
SKIPN SETNOF ;CLEAR OR SET ALL BITS ACCORDING TO "NO"
CALL SETBIT ;SET THE BIT
SKIPE SETNOF ;...
CALL CLRBIT ;CLEAR THE BIT
JUSN: AOBJN Q1,JUSLP ;BACK FOR MORE
MOVEI A,JLEN-1 ;GET NUMBER OF ALL JSYS'S
SUBI A,SJLEN ;SUBTRACT DEFINED JSYS'S
MOVEM A,TRAPU ;MAKE THAT THE COUNT
SKIPE SETNOF ;DID HE SAY NO?
SETZM TRAPU ;YES
CALLRET MRKTRP ;SET UP NEW TRAP STATUS
;HERE WE BUILD A TBLUK-FORMAT TABLE THAT GETS SORTED IN THE
;EXEC'S ONCE-ONLY CODE.
DEFINE DEFJS (NAME,VALUE,TRASH,NIM,OLDNEW)
<
IFB <NIM>,<
RELOC JTAB+VALUE ;;ALLOW FOR GAPS IF SOME JSYSES UNDEFINED
IFB <OLDNEW>,<
[1B7
ASCIZ/NAME'%/],,VALUE_9
>
IFIDN <OLDNEW><OLD>,<
[1B7
ASCIZ/NAME/],,VALUE_9
>
SJLN=SJLN+1
>
IFG VALUE-LARGST,<LARGST==VALUE>
>
LARGST==0
JTAB:: SJLEN,,JLEN
SJLN=0 ;RESET COUNTER
JSLIST ;USE JSYS LISTER FROM MONSYM (CALLS DEFJS)
JLEN==:.-JTAB ;LENGTH OF TABLE
RELOC JTAB+LARGST+1 ;ALLOW FOR JSYSES NOT BEING IN ORDER IN JSLIST
SJLEN==:SJLN ;COUNT OF ALL DEFINED JSYS'S
;SET TRAP FILE-OPENINGS causes all forks' file-openings to be announced
FOPEN: CONFIRM ;MAKE SURE HE MEANS IT
SETCM A,SETNOF ;SET OR CLEAR TFILEF ACCORDING TO SETNOF
MOVEM A,TFILEF
; CALLRET MRKTRP ;GO UPDATE TRAP STATUS
;MRKTRP MARKS THAT TRAP STATUS HAS CHANGED AND HENCE HAS TO BE UPDATED.
;IT IS NOT UPDATED IMMEDIATELY, BECAUSE DOING SO CAN PREVENT EXECUTE-ONLY
;PROGRAMS FROM BEING LOADED WITH GET JSYS, SINCE SETTING TRAPS MAKES
;THE PROCESS NON-VIRGIN
MRKTRP::SETZM TRPOKF ;SAY TRAPS ARE NOT OK
LOAD A,YFLD,[OPENF] ;GET BIT POSITION OF OPENF JSYS
MOVEI B,JSBDEF ;POINT AT TRAP BITS
CALL CLRBIT ;FIRST CLEAR THE BIT
LOAD A,YFLD,[OPENF] ;GET BIT POSITION OF OPENF JSYS
MOVEI B,JSBDEF ;POINT AT TRAP BITS
SKIPN TOPENF ;TURN OPENF BIT ON IF TRAPPING OPENF JSYS
SKIPE TFILEF ;OR IF TRAPPING FILE-OPENINGS
JRST SETBIT
RET
.CIDLY::NOISE <FOR COMMANDS>
CALL CONF ;CONFIRM
SETCM A,SETNOF
MOVEM A,CIDLYF
RET
IFN NICSW,< ;[NIC1017]
;[NIC1017] SET HISTORY
.SEHST::SKIPE SETNOF ;[NIC1017] WAS "NO" SPECIFIED
JRST .SEHS1 ;[NIC1017] YES
DECX <Decimal number of commands to remember> ;[NIC1017] GET NUMBER
CMERRX ;[NIC1017] BAD INPUT
CAIG B,HSTMAX ;[NIC1017] LARGER THAN MAX?
JUMPG B,.SEHS2 ;[NIC1017] INPUT IS LEGIT.
MOVEI A,HSTMAX+1 ;[NIC1017] GET MAX NUMBER
ETYPE <?Number must be larger than zero but smaller then %1Q>
RET ;[NIC1017] AND RETURN
.SEHS1: SETZ B, ;[NIC1017] SET NO HISTORY
.SEHS2: CONFIRM ;[NIC1017] GET EOL
PUSH P,B ;[NIC1017] SAVE NEW VALUE
SKIPN A,HCNT ;[NIC1017] DO WE HAVE ANYTHING NOW?
JRST .SEHS4 ;[NIC1017] NO, SO JUST GO ALLOCATE ANEW
MOVEM A,CNUM ;[NIC1017] SAVE THIS NUMBER FOR LATER
.SEHS3: HLRZ C,HPTR ;[NIC1017] GET ADDRESS OF PTR BLOCK
ADD C,HCNT ;[NIC1017] LOOK AT EACH STRING
SUBI C,1 ;[NIC1017] BASE 0. OFFSET CORRECTLY
SKIPE A,(C) ;[NIC1017] GET PTR TO COMMAND STRING
CALL STREM ;[NIC1017] RETURN IF NOT NULL
SOSE HCNT ;[NIC1017] WORK UP THE LIST
JRST .SEHS3 ;[NIC1017] UNTIL IT IS EXHAUSTED
MOVE A,CNUM ;[NIC1017] GET NUMBER OF WORDS TO RETURN
HLRZ B,HPTR ;[NIC1017] ADDRESS OF PTR BLOCK
CALL RETBUF ;[NIC1017] RETURN IT
.SEHS4: POP P,A ;[NIC1017] GET NEW COUNT BACK
MOVEM A,HCNT ;[NIC1017] AND SAVE IT
SKIPN A ;[NIC1017] DON'T CALL ALLOCATION ROUTINE
JRST R ;[NIC1017] SKIP THIS MESS
CALL GTBUFX ;[NIC1017] IF NON-ZERO, GET PERM. SPACE
HRLZM A,HPTR ;[NIC1017] SAVE ADDRESS OF PTR BLOCK
ADD A,HCNT ;[NIC1017] MAKE PTR POINT TO LAST ENTRY
HRRM A,HPTR ;[NIC1017] AND SAVE IT
MOVN A,HCNT ;[NIC1017] GET -NUMBER OF WORDS TO CLEAR
HRLZS A ;[NIC1017] MOVE TO LEFT HALF
HLR A,HPTR ;[NIC1017] GET BASE ADDRESS BACK
SETZM (A) ;[NIC1017] CLEAR ALL WORDS TO ZERO
AOBJN A,.-1 ;[NIC1017] UNTIL DONE
SETZM CNUM ;[NIC1017] ALWAYS RESET COMMAND COUNT
RET ;[NIC1017] AND THEN RETURN
>;IFN NICSW
;SET LOCATION
IFN STANSW,<
IFN LOTSW,<
NEWFDB: FLDDB. (.CMNOD,CM%PO) ;ALTERNATIVE FDB FOR PARSING
>;IFN LOTSW
>;IFN STANSW
.LOCAT::NOISE (TO)
STKVAR <<NODFDB,.CMDEF+1>>
IFE STANSW,<
MOVX A,FLD(.CMNOD,CM%FNC)!CM%PO!CM%DPP!CM%NSF
>;IFE STANSW
IFN STANSW,<
IFE LOTSW,<
MOVX A,FLD(.CMNOD,CM%FNC)!CM%PO!CM%DPP!CM%NSF
>;IFE LOTSW
IFN LOTSW,<
MOVX A,FLD(.CMKEY,CM%FNC)!CM%DPP+NEWFDB
>;IFN LOTSW
>;IFN STANSW
MOVEM A,.CMFNP+NODFDB ;NODE FUNCTION, PARSE ONLY, DEFAULT PRESENT
IFN STANSW,<
IFN LOTSW,<
MOVEI A,[3,,3
[ASCIZ/CERAS/],,[ASCIZ/CERAS/]
[ASCIZ/REMOTE/],,[ASCIZ/CERAS/]
[ASCIZ/TERMAN/],,[ASCIZ/TERMAN/]
]
MOVEM A,.CMDAT+NODFDB
>;IFN LOTSW
>;IFN STANSW
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
IFN STANSW,<
IFN LOTSW,<
LDB D,[331100,,(C)] ;GET FUNCTION CODE
CAIN D,.CMKEY ;KEYWORD?
JRST [ HRRO A,(B) ;GET POINTER TO NODE FOUND
JRST .+2 ] ;AND GO CONFIRM
>;IFN LOTSW
>;IFN STANSW
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
;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
;SET ALERT (AT)
.ALERT::GTAD ;GET VALUE OF NOW FOR DATE DEFAULT IF NOT GIVEN
MOVEM A,NOW
SKIPE SETNOF ;SET NO?
JRST ALRDEL ;YES - GO DELETE AN ALERT
NOISE <AT TIME>
MOVEI A,[ASCIZ /Date and time, or time/]
CALL REDALT ;READ THE ALERT TIME
CMERRX ;COULDN'T
NOISE <MESSAGE>
LINEX <Message, must be 80 characters or less>
CMERRX
MOVE A,CMABP ;SAVE STRING IN PERMANENT FREE SPACE
ILDB C,A ;SEE IF STRING GIVEN
JUMPE C,.ALRT1 ;IF NOT DON'T READ IT
MOVE A,CMABP ;GET POINTER AGAIN
CALL XBUFFS
MOVE C,A ;GET STRING POINTER IN C
.ALRT1: CONFIRM
MOVE B,ATIME ;RESTORE TIME
SKIPG ALRTIM ;ALERTS ON?
JRST [ MOVEM B,ALRTIM ;NO - SET UP TIMER
MOVEM C,REASON ;SAVE THE FIRST ALERT
RET] ;EXIT - CHECK ON COMMAND RETURN
MOVSI D,-NALTS ;ALERTS ON - SEE IF THERE IS A DUPLICATE
.ALRT2: CAMN B,ALRTIM(D) ;GOT AN ALERT AT THIS TIME?
JRST [ EXCH C,REASON(D) ;YES - SWAP THE NEW MESSAGE FOR THE OLD
SKIPE A,C ;WAS THERE AN OLD MESSAGE?
CALLRET STREM ;YES - REMOVE IT FROM THE FREE POOL; DONE
RET] ;NO - DONE
AOBJN D,.ALRT2 ;LOOP LOOKING FOR DUPLICATES
MOVSI D,-NALTS ;NOW SEARCH TABLE FOR AN EMPTY 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] ;AND GO RE-SAVE THE OLD PENDING MESSAGE
MOVEM B,ALRTMS(D) ;FILL IN SLOT (ORDER LATER)
MOVEM C,REASON+1(D)
RET ;DONE
;REDALT READS IN THE INTERNAL TIME-AND-DATE OF AN ALERT.
;
;ACCEPTS: A/ ADDRESS OF HELP STRING
;
;RETURNS+1: USER TYPED SOMETHING ELSE
; +2: ATIME/ INTERNAL DATE AND TIME
REDALT: MOVEM A,AHELP ;REMEMBER ADDRESS OF HELP STRING
UDTR @AHELP
RET ;COULDN'T
TXNE A,DATBIT ;WAS A DATE TYPED?
JRST AL1 ;YES, SO NEVER TRY TO CHANGE THE DAY
CAMGE B,NOW ;DID HE SPECIFY A TIME BEFORE NOW?
ADD B,[1B17] ;YES - ASSUME TOMORROW
AL1: MOVEM B,ATIME ;SAVE TIME
RETSKP
;HERE TO REMOVE ONE OR MORE ALERTS
ALRDEL: MOVEI A,[ASCIZ /Date and time or BEFORE or AFTER time
at which to remove alert/]
CALL REDALT ;READ THE TIME
JRST ALRDL5 ;COULDN'T (MAYBE BEFORE, AFTER, CRLF)
CONFIRM
MOVSI D,-<NALTS+1> ;SCAN FULL TABLE AND PENDING
ALRDL2: MOVE A,ATIME ;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 POINTER
ALRDL3: AOBJN D,ALRDL2 ;LOOP
TLNN Z,F1 ;FOUND ANY?
ERROR <No alerts found>
ALRDL4: SKIPE ALRTIM ;CLEARED CURRENT PENDING ALERT?
RET ;NO - DONE
SETZ B, ;YES - SET UP FOR TABLE RE-ORDER
HRLOI Q1,377777
JRST ALRCH1 ;AND GO FIND A NEW ONE
;COME HERE TO PARSE "BEFORE" & "AFTER"
ALRDL5: 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
ALRD5A: DMOVE B,ARANGE ;GET RANGE TO CHECK
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
JRST ALRDL4 ;RE-ORDER THE TABLE AND FINISH OFF
$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
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
CALLRET CONF ;CONFIRM AND RETURN
;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
TYPE <> ;THEN RING THE CHIMES
ETYPE <[%5\%%2E% alert> ;START THE MESSAGE
SKIPE Q1 ;IS THE ALERT COMING OUT LATE?
ETYPE < at %D %E> ;YES - APOLOGIZE
IFE STANSW,<
SKIPE B,REASON ;GIVE MESSAGE SAVED
TYPE < - >
ETYPE <%2\]%_>
>;IFE STANSW
IFN STANSW,<
SKIPN B,REASON ; GIVE MESSAGE SAVED
JRST ALRCH0
TYPE < - >
UTYPE (B)
ALRCH0: ETYPE <]%_>
>;IFN STANSW
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) ;GOT AN ENTRY?
JRST ALRCH3 ;NO - SKIP IT
CAMG A,Q1 ;YES - 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) ;YES - 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
;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 - SET UP TIMER INTERRUPT
MOVEI B,^D60000 ;AT 1 MINUTE INTERVALS
MOVEI C,IITCHN ;GET CHANNEL
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 + 1 MIN
MOVEI C,IITCHN ;*** MONITOR CROCK REQUIRES CHL
TIMER
JFCL
SETZM IITSET ;NO MORE INTERRUPTS
RET
;SET (NO) UUO-SIMULATION
.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
ERJMP CJERRE ;FAILED - SAY WHY
RET
XTND,<
.KFRKC::NOISE <ON <CTRL-C>>
SKIPE SETNOF ;SET NO?
TDZA A,A ;YES - CLEAR
SETO A, ;SET
MOVEM A,CCKEEP ;CTRL-C KEEP FLAG
CALLRET CONF ;CONFIRM AND RETURN
;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
MOVE P3,(P3) ;GET CONTROL BITS
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]
T EXECUTE,,[PA%EX]
T NO,,[0]
T NONEXISTENT,,[-1]
T READ,,[PA%RD]
T WRITE,,[PA%WT]
TEND
.CTRAC::NOISE <OF GENERATED COMMANDS> ;PCL
IFN STANSW,<
CONFIRM ;CM156
>;IFN STANSW
MOVX A,PCFTRC ;TRACE BIT
ANDCAM A,PCFLAG ;CLEAR IT
SKIPN SETNOF ;WANT IT SET?
IORM A,PCFLAG ;SET IT
IFE STANSW,<
CALLRET CONF ;CONFIRM AND RETURN
>;IFE STANSW
IFN STANSW,<
RET ;CM156
>;IFN STANSW
.CTRLC::NOISE <OF PROGRAM>
CONFIRM
IFE NICSW,< ;[NIC1011] LET BATCH JOBS HAVE ^C CAPABILITY
IFNBATCH (ILLBAT)
>;IFE NICSW
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)
.SEDEF::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
;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
.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 ALLOW
T DISALLOW
T ECHO,,.ECHO
T NO,,.TKND
TEND
.ECHO: CALL ECHNOI ;FINISH COMMAND
MOVX A,TKECOF ;GET BIT SAYING ECHOING WANTED
IORM A,TAKDEF ;REMEMBER IN DEFAULTS WORD
RET
.TKND: KEYWD $NTKD ;PARSE NEXT KEYWORD ("ECHO")
T ECHO,,.NOECH
CMERRX <invalid option for SET DEFAULT TAKE command>
JRST (P3) ;DISPATCH TO DEFAULTING ROUTINE
$NTKD: TABLE
T ECHO,,.NOECH
TEND
.NOECH: CALL ECHNOI
MOVX A,TKECOF ;BIT SAYING WE WANT ECHOING
ANDCAM A,TAKDEF ;TURN IT OFF IN DEFAULT WORD
RET
.SDDCL::MOVEI B,[FLDDB. .CMSWI,,$SDEF,,,] ;PCL
CALL FLDSKP ;SEE WHAT HE WANTS
CMERRX
CALL GETKEY ;GET THE DATA WORD
CONFIRM ;FINISH IT OFF
MOVX B,PCFQDC ;GET THE QUIET-DECLARATION BIT
ANDCAM B,PCFLAG ;CLEAR IT TO ASSUME NOISY DECLARATION
SKIPN P3 ;NOCONFIRM?
IORM B,PCFLAG ;YES, USE QUIET DECLARATION
RET ;PCL All done
.ALLOW: CALL ALONOI ;FINISH COMMAND
MOVX A,TKALEF
IORM A,TAKDEF ;ALLOW ERRORS
RET
.DISAL: CALL ALONOI ;FINISH COMMAND
MOVX A,TKALEF
ANDCAM A,TAKDEF ;DISALLOW ERRORS DURING TAKE FILES
RET
ALONOI::NOISE (ERRORS DURING "TAKE" FILE) ;THE "NOISE" CALL *MUST* STAY ON THIS TAG
CALLRET CONF ;CONFIRM AND RETURN
ECHNOI::NOISE (COMMANDS FROM "TAKE" FILE) ;THE "NOISE" CALL *MUST* STAY ON THIS TAG
CALLRET CONF ;CONFIRM AND RETURN
;"SET DIRECTORY"
.SDIR:: SETZM SETNOF ;ASSUME "NO" NOT TYPED
SETZM PASSP ;TELL CRDIR THERE'S NO PASSWORD SUPPLIED YET
KEYWD $SDIR
0
JRST CERR
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
T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
JRST CERR
JRST (P3)
$SDNO: TABLE
T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
TEND
;SET PROGRAM ENTRY (VECTOR LOCATION) <OCTAL> (LENGTH) <OCTAL>
.ENTRY::SKIPGE FORK
ERROR <No program>
NOISE <LOCATION TO>
ADDRX <Memory location of entry vector>
ERROR <Invalid location>
MOVEM B,ENTADR ;REMEMBER ENTRY VECTOR LOCATION
NOISE <LENGTH>
DEFX <1> ;DEFAULT
ADDRX <Value between 1 and 777 octal
or 254000 for TOPS10-compatible entry vector.>
ERROR <Invalid length>
CAILE B,777 ;TOO LONG?
JRST [ CAIN B,254000 ;ALLOW JRST FOR COMPATIBLE
JRST .+1
ERROR <Invalid length>]
CONFIRM
MOVE C,ENTADR ;GET LOCATION OF VECTOR
MOVE A,FORK
CALLRET SETENT ;SET ENTRY VECTOR AND RETURN
IFN STANSW,<
;"SET NEW-FORK"
.NWFRK::NOISE <ON RESET>
CONFIRM ;FINISH COMMAND PARSE
SKIPE SETNOF ;NO TYPED?
TDZA A,A ;YES, CLEAR FLAG
SETO A, ;ELSE SET IT
MOVEM A,RNFORK ;SAVE FOR LATER
RET ;ALL DONE
>;IFN STANSW
;"SET FILE"
.SFILE::SETZM SETNOF ;FLAG "NO" WAS NOT SAID YET
KEYWD $SFILE
0
JRST CERR
JRST (P3)
.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>
JRST (P3) ;DO WHATEVER
;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 ;LOSES
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
IFE STANSW,<
TLO B,500000 ;INDICATE THAT THERE'S 18-BIT PROTECTION IN RH
>;IFE STANSW
FILEV1: CONFIRM
IFN STANSW,<
IFXN. Z,F3 ;WAS THIS A PROTECTION COMMAND
MOVE C,B ;SAVE INPUT PROTECTION
MOVX B,WHLU+OPRU ;SEE IF USER IS PRIVILEGED
SKIPE PRVENF ;IS HE ENABLED
IFSKP.
CALL PRVCK ;YES, SEE IF HE WAS WOPR
ANNSK. ;NOT PRIVILEGED, CHECK PROTECTION
SETZ B, ;INITIALIZE FOR ERROR STRING
TRNN C,20000 ;OR NO LIST ACCESS BY OWNER
HRROI B,[ASCIZ/No list access for owner/]
TLNE C,-1 ;LARGER THAN 18 BITS
HRROI B,[ASCIZ/Larger than 18 bits/] ;SAY WHAT IS WRONG
IFN. B ;OUTPUT ERROR IF SET
ETYPE<%@ %2M specified> ;OUTPUT ERROR
CALL FCONF ;MAKE SURE HE AGREES
ENDIF.
ENDIF.
MOVE B,C ;GET PROTECTION BACK
TLO B,500000 ;INDICATE THAT THERE'S 18-BIT PROTECTION IN RH
ENDIF.
>;IFN STANSW
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
;[NIC1033] SET FILE AUTOKEEP
IFN NICSW,< ;[NIC1033]
.AUTOK::MOVSI A,.FBKEP ;[NIC1033] CODE FOR KEEP THIS FILE
MOVX B,FB%FCF ;[NIC1033] THE MASK
JRST .EPHM0 ;[NIC1033] JOIN COMMON ROUTINE
>;IFN NICSW
IFN STANSW,<
;SET FILE PERMANENT
.PRMNT::MOVX A,FB%PRM ; CODE FOR PERMANENT
MOVX B,FB%PRM ; SELECT PERMANENT BIT AS BIT MASK
JRST .EPHM0 ; JOIN COMMON CODE WITH EPHEMERAL
.TMPRY::MOVX A,FB%TMP ; CODE FOR TEMPORARY
MOVX B,FB%TMP ; SELECT TEMPORARY BIT AS BIT MASK
JRST .EPHM0 ; JOIN COMMON CODE WITH EPHEMERAL
.SVBAK::STKVAR <FCODE,FBEPM> ;MUST BE SAME STKVAR AS AT .EPHM0!!
MOVX A,FB%NOD ;NOT TO BE DUMPED BY BACKUP SYSTEM
MOVEM A,FBEPM ;SAVE SELECTED BIT MASK
SETZM FCODE ;CLEAR CODE
SKIPE SETNOF ;SET NO ...?
MOVEM A,FCODE ;STORE ACTUAL CODE TO SET
JRST .EPHM1 ;GO FINISH PARSE
>; IFN STANSW
;SET FILE EPHEMERAL (ALSO SET NO ...)
.EPHM:: MOVSI A,.FBEPH ;CODE FOR EPHEMERAL
IFE STANSW,<
.EPHM0: STKVAR <FCODE>
>;IFE STANSW
IFN STANSW,<
MOVX B,FB%FCF ;SELECT FILE CLASS FIELD AS BIT MASK
.EPHM0: STKVAR <FCODE,FBEPM>
MOVEM B,FBEPM ;SAVE SELECTED BIT MASK
>;IFN STANSW
SETZM FCODE ;CLEAR CODE
SKIPN SETNOF ;SET NO ...?
MOVEM A,FCODE ;STORE ACTUAL CODE TO SET
IFE STANSW,<
CALL INFGNS ;COLLECT FILE NAME GROUPS
CONFIRM
>;IFE STANSW
IFN STANSW,<
.EPHM1: NOISE <FILES>
CALL TYPFLS ;COLLECT FILE NAME GROUPS (NOT WITH INFGNS!)
>;IFN STANSW
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 ;GET THE NEXT FILE
JRST EPHM2 ;NO MORE - FINISH UP
CALL TYPIF ;TYPE OUT THE FILE NAME
CALL MFINP ;GET A SECOND JFN
JRST EPHM2 ;COULDN'T - ON TO NEXT FILE
HRLI A,.FBCTL ;WORD IN FDB TO CHANGE
IFE STANSW,<
MOVX B,FB%FCF ;MASK FOR FILE TYPE CODE
>;IFE STANSW
IFN STANSW,<
MOVE B,FBEPM ; GET REQUESTED EPHEMERAL OR PERMANENT MASK
>;IFN STANSW
MOVE C,FCODE ;GET CODE OR 0
CALL $CHFDB ;SET CODE IN FDB
JRST [ TYPE < Access not allowed
>
JRST EPHM2]
CALL TYPOK ;SAY THE CHANGE SUCCEEDED
EPHM2: SKIPE INIFH1 ;ANYTHING LEFT?
JRST EPHM1 ;YES - LOOP
RET ;NO - DONE
;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 ;FALL TO 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 DWORK1 ;FAILED, SEE WHY
RET ;SUCCEEDED WITHOUT PASSWORD
DWORK1: CALL DGETER ;SEE WHY IT FAILED
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
;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:
IFE STANSW,<
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
>;IFE STANSW
IFN STANSW,<
CALL INPDIR ;WHY NOT DEFAULT THE DIRECTORY NAME
>;IFN STANSW
CONFIRM ;INPUT PASSWORDS ON SEPARATE LINES
SETZM PASSP ;DON'T WANT TO CHANGE ANYTHING
LDF A,CD%PSW ;SPECIFY WHAT WE'RE CHANGING
CALL CREDIR ;GO SEE IF WE NEED THE OLD PASSWORD
SKIPA A,[.FHSLF] ;PASSWORD MAY BE NEEDED
JRST DPASS1 ;NO PASSWORD NEEDED
GETER ;GET LAST ERROR FOR THIS PROCESS
HRRZS B ;CLEAR LH OF B
CAIE B,ACESX3 ;WAS LAST ERROR "PASSWORD NEEDED"?
CAIN B,CRDIX1 ;OR "WHEEL OR OPERATOR CAPABILITY REQUIRED"?
SKIPA ;YES, GET OLD PASSWORD
CALL CJERRE ;NO, PRINT MONITOR'S ERROR MESSAGE
DPASS0: MOVEI A,[ASCIZ /Old password: /]
CALL PASSX ;INPUT THE CURRENT PASSWORD
MOVEM A,PASSP ;SAVE POINTER TO IT IN PASSP
DPASS1: MOVEI A,[ASCIZ /New password: /]
CALL PASSX ;READ PASSWORD WITH NOISE WORDS "NEW PASSWORD"
MOVEM A,.CDPSW+SEBLK ;SAVE POINTER TO NEW PASSWORD STRING
IFN STANSW,<
CALL PASCHK ;MAKE SURE ALPHANUMERICS WERE USED
ERROR <Only alphanumeric characters and dashes allowed in passwords>
CAIGE C,6 ;MUST BE SIX CHARACTERS OR MORE
ERROR <Password must be six or more characters in length>
>;IFN STANSW
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
IFN STANSW,<
;MAKE SURE NEW PASSWORD HAS NO SPECIAL CHARS
;RETURNS +1 BAD CHARACTERS
; +2 GOOD CHARACTERS, C/ LENGTH
PASCHK: SETZ C, ;ACCUMULATE PASSWORD LENGTH HERE
PASCH0: ILDB B,A ;GET A BYTE
JUMPE B,RSKP ;GOOD PASSWORD IF WE REACHED NUL
CAIL B,"0"
CAILE B,"9"
SKIPA
AOJA C,PASCH0 ;ALLOW NUMERIC
CAIL B,"A"+40
CAILE B,"Z"+40
SKIPA
AOJA C,PASCH0 ;ALLOW LOWERCASE ALPHABETIC
CAIL B,"A"
CAILE B,"Z"
SKIPA
AOJA C,PASCH0 ;ALLOW UPPERCASE ALPHABETIC
CAIN B,"-"
AOJA C,PASCH0 ;ALLOW DASHES
RET ;ILLEGAL CHARACTER, TAKE A SINGLE RETURN
>;IFN STANSW
;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
IFN STANSW,<
SETZM SEBLK ;ZERO OUT FIRST WORD
HRLI A,SEBLK ;SET UP FOR BLT
HRRI A,1+SEBLK ;START OF BLT OUTPUT
BLT A,<GTDLN-1>+SEBLK ;ZERO OUT THE MEMORY
MOVEI A,GTDLN ;LENGTH OF THE GTDIR BLOCK
MOVEM A,.CDLEN+SEBLK ;PUT IT WHERE MONITOR CAN FIND IT
>;IFN STANSW
MOVX A,RC%EMO ;TAKE AS IS ONLY
MOVE B,DIRP ;DIRECTORY # IN QUESTION
SETZ C,
RCDIR ;GET THE DIRECTORY #
MOVEI A,.CDMOD ;READ SOME OF THE DIRECTORY
MOVEM A,.CDLEN+SEBLK
MOVE A,C ;SET UP DIRECTORY NUMBER
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 ;GET THE 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>
IFE STANSW,<
TLO Z,F1 ;DON'T DEFAULT THE DIRECTORY NAME
>;IFE STANSW
IFN STANSW,<
TLZ Z,F1 ;DEFAULT TO USER'S LOGIN DIRECTORY
>;IFN STANSW
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
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
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>
SETO A, ;OUR OWN JOB
MOVEI B,.SJDFR
MOVEI C,.SJRFA ;NO RETRIEVAL-WAIT
SKIPN SETNOF
MOVEI C,.SJRWA ;YES, RETRIEVAL-WAIT
SETJB
CALLRET CONF ;CONFIRM AND RETURN
;SET SESSION-REMARK (TO) TEXT
SETSRM::NOISE (TO)
CALL GSR ;GET SESSION REMARK
CALL SSR ;TELL SYSTEM THE REMARK
CALLRET CONF ;CONFIRM AND RETURN
;ROUTINE TO GET SESSION REMARK
;RETURNS POINTER IN A
GSR:: LINEX <Session remark, one line of text>
CMERRX
CALLRET BUFFF ;ISOLATE SESSION REMARK AND RETURN
;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 DATE-AND-TIME,,SETTAD ;^ESET SYSTEM DATE-AND-TIME
T FAST-LOGINS-ALLOWED,ONEWRD,SETFST ;^ESET FAST-LOGINS-ALLOWED
IFN STANSW,<
T INTERNET,,.INTRN ;^ESET INTERNET
>;IFN STANSW
T LEVEL-ONE-MESSAGE,ONEWRD,SETMS1 ;^ESET LEVEL-ONE-MESSAGES
T LEVEL-ZERO-MESSAGES,ONEWRD,SETMS0 ;^ESET LEVEL-ZERO-MESSAGES
T LOGINS-ALLOWED,,TTYLOG ;^ESET LOGINS-ALLOWED
T NO,NOLG,ESETNO ;^ESET NO
T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR ;^ESET OPERATOR
T PRIVATE-QUASAR,,.GDEBG ;^ESET PRIVATE-QUASAR
IFN STANSW,<
T PUP,,.PUP ;^ESET PUP
>;IFN STANSW
T RUN-TIME-GUARANTEE,,.JRUNG ;^ESET JOB RUN-TIME
T TERMINAL,,ETERMI ;^ESET TERMINAL (NUMBER)
T WORKING-SET-PRELOADING,ONEWRD,SETWSP ;^ESET WORKING-SET-PRELOADING
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>
JRST (P3) ;DISPATCH TO COMMAND
$ESETN: TABLE
T FAST-LOGINS-ALLOWED,ONEWRD,SETFST ;^ESET FAST-LOGINS-ALLOWED
IFN STANSW,<
T INTERNET,,.INTRN ;^ESET NO INTERNET
>;IFN STANSW
T LEVEL-ONE-MESSAGE,ONEWRD,SETMS1 ;^ESET NO LEVEL-ONE-MESSAGES
T LEVEL-ZERO-MESSAGES,ONEWRD,SETMS0 ;^ESET NO LEVEL-ZERO-MESSAGES
T LOGINS-ALLOWED,,TTYLOG ;^ESET NO LOGINS-ALLOWED
T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR ;^ESET NO OPERATOR
T PRIVATE-QUASAR,,.GDEBG ;^ESET NO PRIVATE-QUASAR
IFN STANSW,<
T PUP,,.PUP ;^ESET NO PUP
>;IFN STANSW
T RUN-TIME-GUARANTEE,,.JRUNG ;^ESET NO RUN-TIME
T WORKING-SET-PRELOADING,ONEWRD,SETWSP ;^ESET NO WORKING-SET-PRELOADING
TEND
IFN STANSW,<
;PRIVILEGED COMMANDS FOR MANIPULATING THE INTERNET SOFTWARE
.INTRN: KEYWD $INTTB ;PARSE THE NEXT KEYWORD
0 ;NO DEFAULTS
JRST CERR ;HANDLE ERRORS
JRST (P3) ;DISPATCH
$INTTB: TABLE
T BY-PASS,,.INBYP
T GATEWAY-TABLE,,.INGWY
T HOST-TABLE,,.INHST
T SERVICE,,.INSRV
TEND
IFNDEF .IPSIB,<.IPSIB==5> ;REMOVE THIS DEFINITION FOR REL 6
.INBYP: MOVEI A,.IPSIB ;"^ESET [NO] INTERNET BY-PASS"
JRST .INGW0
.INHST: SKIPA A,[.IPINI] ;"^ESET INTERNET HOST-TABLE"
.INGWY: MOVEI A,.IPGWY ;"^ESET INTERNET GATEWAY-TABLE"
.INGW0: PUSH P,A ;SAVE FUNCTION CODE
CONFIRM ;WAIT FOR CONFIRMATION
POP P,A ;RESTORE FUNCTION CODE
SKIPE SETNOF ;WHICH SENSE OF SET?
TDZA B,B ;TURNING SOMETHING OFF
MOVEI B,1 ;TURNING SOMETHING ON
IPOPR% ;PERFORM THE FUNCTION
ERCAL CJERRE ;SOME ERROR
RET ;RETURN TO CALLER
.INSRV: NOISE <FOR ADDRESS> ;GIVE USER A HINT
STKVAR <HSTNUM,HSTPTR,HSTCNT> ;LOCAL STORAGE
SETZM HSTNUM ;NO HOST NUMBER YET
MOVX A,<POINT 8,HSTNUM,3>
MOVEM A,HSTPTR ;SET UP POINTER
MOVEI A,4
MOVEM A,HSTCNT ;SET UP BYTE COUNT
INSRV0: MOVEI B,[FLDDB. .CMNUM,CM%SDH,^D10,<Decimal octet>]
CALL FLDSKP ;READ A NUMBER
CMERRX <Decimal octet required>
IDPB B,HSTPTR ;DEPOSIT BYTE
SOSG HSTCNT ;DECREMENT BYTE COUNT
JRST INSRV1 ;GO FINISH UP
MOVEI B,[FLDDB. .CMTOK,,<-1,,[ASCIZ/./]>]
CALL FLDSKP ;READ A PERIOD
CMERRX <"." required>
JRST INSRV0 ;GO GET NEXT OCTET
INSRV1: CONFIRM ;WAIT FOR CONFIRMATION
MOVEI A,.IPSNT ;FUNCTION IS SET NETWORK STATE
MOVE B,HSTNUM ;HOST NUMBER
SKIPE SETNOF ;WHICH SENSE OF SET?
TDZA C,C ;TURNING SOMETHING OFF
SETO C, ;TURNING SOMETHING ON (C = 1 WOULD CYCLE NET)
IPOPR% ;PERFORM THE FUNCTION
ERCAL CJERRE ;SOME ERROR
RET ;RETURN TO CALLER
ENDSV.
;PRIVILEGED COMMANDS FOR MANIPULATING THE PUP ETHERNET
.PUP: KEYWD $PUPTB ;PARSE THE NEXT KEYWORD
0 ;NO DEFAULTS
JRST CERR ;HANDLE ERRORS
CONFIRM ;WAIT FOR CONFIRMATION
JRST (P3) ;DISPATCH
$PUPTB: TABLE
T BUG-LOGGING,,.PUBUG
T GATEWAY,,.PUGAT
T HOST-TABLE,,.PUHST
T SERVICE,,.PUSRV
TEND
.PUHST: SKIPA A,[.SFDIR] ;"^ESET PUP HOST-TABLE"
.PUGAT: MOVEI A,.SFGAT ;"^ESET [NO] PUP GATEWAY"
JRST .PUPB0 ;JOIN COMMON CODE
.PUSRV: SKIPA A,[.SFPUP] ;"^ESET [NO] PUP SERVICE"
.PUBUG: MOVEI A,.SFBUG ;"^ESET [NO] PUP BUG-LOGGING"
.PUPB0: SKIPE SETNOF ;WHICH SENSE OF SET?
TDZA B,B ;TURNING SOMETHING OFF
MOVEI B,1 ;TURNING SOMETHING ON
SMON% ;DO THE FUNCTION
ERCAL CJERRE ;SOME ERROR
RET ;RETURN TO CALLER
>;IFN STANSW
;"^ESET TERMINAL (NUMBER)"
IFE NICSW,< ;[NIC1041]
ETERMI::TRVAR <ETNM,ETRG,ETTN>
NOISE <NUMBER>
OCTX <Octal terminal number>
CMERRX
MOVEM B,ETTN ;SAVE TERMINAL NUMBER
CALL ETSET ;OBTAIN TERMINAL DESIGNATOR
MOVEM B,ETNM ;SAVE DESIGNATOR
MOVEM B,ETRG ;ASSUME THIS IS THE HIGHEST
MOVEI B,$ETRM ;GET FIELDS TO PARSE
CALL FLDSKP ;PARSE TERMINAL NUMBER OR KEYWORD
CMERRX ;PARSING ERROR
HRRZ C,C ;ISOLATE FIELD PARSED
HRRZ P3,(B) ;GET TABLE ADDRESS IF KEYWORD
MOVE P3,(P3) ;ISOLATE ROUTINE
CAIE C,$ETRM ;JUST TYPED KEYWORD?
JRST ETKEY ;YES - SKIP RANGE PROCESSING
MOVEM B,ETTN ;SAVE TERMINAL NUMBER
CALL ETSET ;OBTAIN TERMINAL DESIGNATOR
MOVEM B,ETRG ;SAVE DESIGNATOR
MOVE A,ETNM ;GET STARTING TERMINAL DESIGNATOR
CAMGE B,A ;VALID RANGE?
ERROR <Invalid terminal range> ;NO, ERROR
KEYWD $ETERM
T SPEED,,SPEEDA
JRST CERR
ETKEY: MOVE A,ETNM ;GET STARTING TERMINAL DESIGNATOR
MOVE B,ETRG ;GET HIGHEST RANGE DESIGNATOR
JRST (P3) ;SET SPEEDS
ETSET: MOVE A,CSBUFP ;GET SOME SCRATCH SPACE
MOVEI C,0 ;END STRING ON NULL
HRROI B,[ASCIZ /TTY/] ;MAKE DEVICE NAME
SOUT
MOVE B,ETTN ;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 TERMINAL DOESN'T EXIST
RET ;RETURN WITH DESIGNATOR
$ETERM: TABLE
T SPEED,,SPEEDA
TEND
$ETRM: FLDDB. .CMNUM,CM%SDH,8,<Highest octal terminal number if specifing range>,SPEED,[FLDDB. .CMKEY,CM%DPP,$ETERM]
>;IFE NICSW
IFN NICSW,< ;[NIC1041]
ETERMI::STKVAR <ETNM> ;[NIC1041]
NOISE <NUMBER> ;[NIC1041]
OCTX <Octal terminal number> ;[NIC1041]
CMERRX ;[NIC1041]
MOVEM B,ETNM ;[NIC1041]
MOVE A,CSBUFP ;[NIC1041] GET SOME SCRATCH SPACE
MOVEI C,0 ;[NIC1041] END STRING OUTPUT ON NULL
HRROI B,[ASCIZ /TTY/] ;[NIC1041] MAKE DEVICE NAME
SOUT ;[NIC1041]
MOVE B,ETNM ;[NIC1041] GET NUMBER HE TYPED
MOVEI C,8 ;[NIC1041] OCTAL
NOUT ;[NIC1041] MAKE "TTYnnn"
ERCAL JERRE ;[NIC1041] SHOULD NEVER FAIL
MOVE A,CSBUFP ;[NIC1041] POINT AT THE NAME
STDEV ;[NIC1041] GET DESIGNATOR FOR IT
ERCAL CJERRE ;[NIC1041] FAILED, TELL USER THAT TERMINAL DOESN'T EXIST
MOVE Q1,B ;[NIC1041] SAVE TERMINAL TO USE HERE
JRST .TERM0 ;[NIC1041] JOIN CODE IN TEMRINAL COMMAND
>;IFN NICSW
;"^ESET [NO] SYSTEM LOGINS-ALLOWED"
TTYLOG: NOISE <ON>
KEYWD $LGTTY
T ANY-TERMINAL,ONEWRD,.ANTTY
JRST CERR
JRST (P3)
$LGTTY: TABLE
T ANY-TERMINAL,ONEWRD,.ANTTY
T ARPANET-TERMINALS,ONEWRD,.NVTTY
T CONSOLE-TERMINAL,ONEWRD,.CNTTY
T DECNET-TERMINALS,ONEWRD,.MCTTY
IFN STANSW&PUPSW,<
T ETHERNET-TERMINALS,ONEWRD,.ENTTY
>;IFN STANSW&PUPSW
T LOCAL-TERMINALS,ONEWRD,.LCTTY
T PSEUDO-TERMINALS,ONEWRD,.PSTTY
T REMOTE-TERMINALS,ONEWRD,.RMTTY
TEND
;DO SET FOR ALL TERMINALS
.ANTTY: CALL .CNTTY
IFN STANSW&PUPSW,<
CALL .ENTTY
>;IFN STANSW&PUPSW
CALL .LCTTY
CALL .NVTTY
CALL .PSTTY
CALL .MCTTY
; CALLRET .RMTTY
.RMTTY: MOVEI A,.SFRMT
DOSTTY: SKIPE SETNOF ;NO?
TDZA B,B ;DISALLOW LOGINS
MOVEI B,1 ;ALLOW LOGINS
SMON
ERCAL CJERRE
RET
.CNTTY: MOVEI A,.SFCTY
JRST DOSTTY
IFN STANSW&PUPSW,<
.ENTTY: MOVEI A,.SFPNV
JRST DOSTTY
>;IFN STANSW&PUPSW
.LCTTY: MOVEI A,.SFLCL
JRST DOSTTY
.NVTTY: MOVEI A,.SFNVT
JRST DOSTTY
.PSTTY: MOVEI A,.SFPTY
JRST DOSTTY
.MCTTY: MOVEI A,.SFMCB ;GET DECNET CODE
JRST DOSTTY ;CONTINUE AT LOGIN TEST
;^ESET FAST-LOGINS-ALLOWED
SETFST: MOVX A,.SFXEC ;GET THE EXEC FLAGS WORD
TMON
ERCAL CJERRE
TXO B,XC%FST ;SET THE NO FAST LOGINS FLAG BY DEFAULT
SKIPN SETNOF ;^ESET NO FAST-LOGINS-ALLOWED ?
TXZ B,XC%FST ;NO. ALLOW IT
SMON ;SET THE FLAGS WORD
ERCAL CJERRE
RET
;"^ESET SYSTEM OPERATOR-IN-ATTENDANCE"
SETOPR: MOVEI A,.SFOPR
JRST SETMSS ;JOIN COMMON CODE
;"^ESET LEVEL-ZERO-MESSAGES"
SETMS0: MOVEI A,.SFMS0 ;GET THE SMON FUNCTION
SETMSS: SETO B, ;ASSUME WE ARE SETTING
SKIPE SETNOF ;IS IT A NO COMMAND?
SETZ B, ;YES OF COURSE
SMON ;SET THE WORD FOR THE MONITOR
ERCAL CJERRE
RET ;AND GET ANOTHER COMMAND
;"^ESET LEVEL-ONE-MESSAGES"
SETMS1: MOVEI A,.SFMS1 ;GET THE SMON FUNCTION
JRST SETMSS ;JOIN COMMON CODE
;"^ESET WORKING-SET-PRELOADING"
SETWSP: MOVEI A,.SFWSP ;GET THE SMON FUNCTION
JRST SETMSS ;JOIN COMMON CODE
;^ESET PRIVATE-QUASAR ON OR OFF
GQFDB: FLDDB. .CMUSR,,,,,[ ;USER ID ONE POSSIBILITY
FLDDB. .CMCFM ] ;END OF LINE ANOTHER POSSIBILITY
.GDEBG: NOISE <for private GALAXY>
SKIPE SETNOF ;OFF?
JRST [CONFIRM ;YES - GET CONFIRMATION
SETZM QSRPID ;GET IT, CLEAR QUASAR'S PID
RET ] ;AND RETURN
MOVEI B,GQFDB ;POINT TO FDB ADDRESS
CALL FLDSKP ;SEE WHAT THE USER TYPED
ERROR <Invalid userid specified>
LDB A,[331100,,.CMFNP(C)] ;FIND OUT WHAT GOT TYPED
CAIN A,.CMCFM ;END OF LINE?
TDZA B,B ;YES - ZERO AC 2 AND SKIP
CONFIRM ;NO - GET CONFIRM
MOVE A,B ;GET THE USERID IN A
CALL GQSRPD ;GET PRIVATE QUASAR PID
RET ;RETURN
.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
.STMLM::NOISE <TO>
DECX <Number of seconds>
CMERRX
NOISE <SECONDS>
CONFIRM
JUMPE B,[ERROR <Use "SET NO TIME-LIMIT">]
JUMPL B,[ERROR <Negative number not allowed>]
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
CAIGE B,^D1000 ;IS IT LESS THAN 1 SECOND?
MOVEI B,^D1000 ;OK, MAKE IT 1 SECOND INSTEAD
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
IFE STANSW,<
MOVE A,B ;PUT TIME AND DATE INTO AC1
>;IFE STANSW
IFN STANSW,<
PUSH P,B
TYPE <If the system clock is wrong, you should reload the system>
CALL FCONF
POP P,A
>;IFN STANSW
STAD ;SET TIME AND DATE
CALL CJERR
RET
IFE STANSW,<
ECEASE::TRVAR <DWNAT>
NOISE <TIMESHARING AT>
DTX <Date/time, or NOW for immediately, or null to cancel shutdown>
JRST CEASE3
DT1: MOVEM B,DWNAT ;SAVE CURRENT DOWN TIME
NOISE <RESUMING AT>
DTX <Date and time of restart or null if unknown>
JRST CEASE4 ;NO DATE AND TIME TYPED
CEASE1: CONFIRM
SKIPN A,DWNAT
JRST CEASE2 ;SKIP CHECK IF CANCELING
CALL ECCNFM ;REALLY CONFIRM THE CEASE
GTAD
SETO C, ;CHECK FOR IMMEDIATE FLAG
CAMN C,DWNAT ;MATCH ?
JRST [MOVEM A,DWNAT ;YES. NOW CHECK "DOWN AT" TIME
JRST EC1A] ;CHECK "RESUME AT" TIME
CAML A,DWNAT
ERROR <Down time has already passed>
EC1A: JUMPE B,CEASE2
CAMGE B,DWNAT
ERROR <Timesharing will resume before it ends!>
CEASE2: MOVE A,DWNAT ;GET TIME TO GO DOWN
HSYS ;DO THE SHUTDOWN
JRST CJERR
RET
CEASE3: KEYWD $ECNOW ;SEE IF USER TYPED A KEYWD
0 ;NO DEFAULT
JRST EC3A ;NO. NULL RESPONSE
MOVE B,[-1] ;FLAG THE "NOW"
JRST DT1 ;SEE IF ANY RESUME AT TIME
EC3A: SETZM DWNAT ;FLAG FOR CANCEL
CEASE4: SETZ B, ;NO RESUME AT TIME
JRST CEASE1
$ECNOW: TABLE ;ARG TABLE FOR "NOW"
T NOW,,0
TEND
;Here to re-confirm the ^Ecease. Lots of systems are on networks now,
;and people have more than once ^Ecease'd the wrong system.
ECCNFM: SAVEAC <B>
CALL GETNOD ;TRY TO GET THE DECNET
JRST ECARPA ;PROBABLY NO DECNET. TRY ARPA
ETYPE < %1M> ;TYPE OUT DECNET NAME
JRST ECNAMD ;NAME HAS BEEN TYPED. DON'T TRY ARPA.
ECARPA: ETYPE < >
MOVEI A,.GTHSZ ;NOW TRY ARPANET
GTHST ;GET LOCAL HOST NUMBER
ERJMP ECNAMD ;PROBABLY NO ARPA
MOVEI A,.GTHNS ;RETURN HOST STRING TO THE
MOVE B,COJFN ; OUTPUT DESIGNATOR
MOVE C,D ;PICK UP LOCAL HOST NUMBER
GTHST ;TYPE THE HOST NUMBER OUT
ERJMP .+1 ;FAILS IF NO HOST # ON ARPA MONITOR
ECNAMD: MOVE A,DWNAT ;GET DOWNTIME BACK
CAME A,[-1] ;IS IT IMMEDIATELY
ETYPE < Shut down scheduled for %1D %1E> ;NO
CAMN A,[-1]
ETYPE < Will be shut down IMMEDIATELY > ;YES
CALL FCONF
RET
>;IFE STANSW
IFN STANSW,<
;STANFORD'S ^ECEASE COMMAND
ECEASE::NOISE <TIMESHARING>
DTX <Date and time,
or one of the following:
CANCEL NOW> ;WHAT A CROCK!!
JRST [ KEYWD $CEASE
0 ;NO DEFAULT
JRST CERR
JRST (P3)] ;DISPATCH TO COMMAND
GTAD%
CAML A,B ;IS SHUTDOWN TIME BEFORE NOW?
ERROR <Shutdown time has already passed>
PUSH P,B ;SAVE THE TIME
NOISE <RESUMING>
DTX <Date and time, or return if unknown>
JRST [ SETZ B,
JRST CEASE5]
CAMG B,(P) ;IS SHUTDOWN AFTER RESTART?
ERROR <Shutdown time is after restart time>
CEASE5: PUSH P,B ;SAVE RESTART TIME
CEASE4: CONFIRM
PROMPT <Reason: > ;PROMPT ON NEXT LINE
LINEX <Reason for shutdown (less than 80 characters)>
CMERRX
MOVEI C,ATMBUF ;POINTER TO REASON STRING
POP P,B ;GET BACK RESTART TIME
POP P,A ;GET BACK SHUTDOWN TIME
CEASE3: HSYS% ;DO IT!
ERCAL CJERR
RET
$CEASE: TABLE
T CANCEL,,CANCEA
T NOW,,NOWCEA
TEND
NOWCEA: CONFIRM
GTAD% ;GET CURRENT TIME
ADDI A,3*^D10 ;ADD A LITTLE FUZZ TO MAKE IT RIGHT
SETZB B,C ;MAKE OTHER AC'S RIGHT
JRST CEASE3
CANCEA: NOISE <SHUTDOWN>
CONFIRM
SETZB A,B ;NO TIME, CANCEL CURRENT
JRST CEASE3
>;IFN STANSW
;SET TYPEOUT CONTROLS HOW MEMORY ADDRESSES AND CONTENTS ARE DISPLAYED.
.TYPEO::KEYWD TYTAB
T MODE
CMERRX
CALLRET (P3) ;EXIT THROUGH SPECIFIED KEYWORD ROUTINE
TYTAB: TABLE
T MODE
IFN STANSW,<
T RADIX
>;IFN STANSW
; T RADIX ;ETC.
TEND
.MODE: NOISE (to)
KEYWD MODTAB
0
CMERRX
CALLRET (P3)
MODTAB: TABLE
; T ASCII
T NUMERIC,ONEWRD
T SYMBOLIC,ONEWRD
TEND
.NUMER: SETZM SYMF ;SAY NOT SYMBOLIC
RET
.SYMBO: SETOM SYMF ;SAY SYMBOLIC
RET
IFN STANSW,<
.RADIX: NOISE (TO)
DEFX <8>
DECX <Radix for numeric output>
CMERRX
CAIL B,2 ;BASE MUST BE BETWEEN 2 AND 36
CAILE B,^D36
ERROR <Base must be between 2 and 36>
CONFIRM
MOVEM B,TRADIX ;SET TYPEOUT RADIX
RET
>;IFN STANSW
IFN STANSW,<
; THE SET PROMPT COMMAND WILL ACCEPT FOUR QUOTED TEXT STRINGS AND USE
; THEM AS THE NONPRIV. PROMPT, NONPRIV. SUBCOMMAND PROMPT, PRIV. PROMPT,
; AND PRIV. SUBCOMMAND PROMPT.
.PROMP::TRVAR <NPMT,NSPMT,PPMT,PSPMT> ;TEMP. POINTERS FOR STRINGS
SETZM NPMT ;INITIALIZE ALL PTRS
SETZM NSPMT
SETZM PPMT
SETZM PSPMT
SKIPN PCSFRE ;PCL FREE SPACE INITIALIZED
JRST [ MOVSI A,PCSTRL*512 ;NO, SO DO IT
MOVEM A,PCSTRS
MOVEI A,PCSTRS
MOVEM A,PCSFRE
JRST .+1]
NOISE (To)
MOVEI B,[FLDDB. .CMQST,CM%SDH,,<Regular prompt in quotes>,<"@">,[
FLDDB. .CMCFM]]
CALL FLDSKP ;TRY TO PARSE THIS
CMERRX ;FORGET IT
LDB C,[POINT 9,0(C),8] ;GET WHAT WAS PARSED
CAIN C,.CMCFM ;WAS IT EOL
JRST .PROM1 ;YES, GO SET THEM
HRROI A,ATMBUF ;GET PTR TO ATOM BUFFER
HRROI B,REDPMT ;COMPARE IT TO DEFAULT
STCMP%
SKIPN A ;ARE THEY THE SAME
SETZM ATMBUF ;THEN ZERO BUFFER
HRROI A,ATMBUF ;GET PTR TO ATOM BUFFER
CALL BCOUNT ;COUNT THE CHARACTERS
MOVEI A,ATMBUF ;GET THE ADDRESS
HRL A,B ;SLIDE IN THE COUNT
CALL PCECST ;COPY THE STRING
MOVEM A,NPMT ;AND SAVE IT
NOISE <,>
MOVEI B,[FLDDB. .CMQST,CM%SDH,,<Subcommand prompt in quotes>,<"@@">,[
FLDDB. .CMCFM]]
CALL FLDSKP ;WAS IT PARSABLE
CMERRX ;NO
LDB C,[POINT 9,0(C),8] ;GET CODE OF PARSE
CAIN C,.CMCFM ;WAS IT CONFIRM
JRST .PROM1 ;GO SET THEM THEN
HRROI A,ATMBUF ;GET PTR TO ATOM BUFFER
HRROI B,REDPMT+3 ;COMPARE IT TO DEFAULT
STCMP%
SKIPN A ;IF NON-ZERO, THEN STRING DIFFER
SETZM ATMBUF ;ZERO BUFFER FOR NO CHANGE
HRROI A,ATMBUF ;GET PTR TO BUFFER
CALL BCOUNT ;GET CHARACTER COUNT
MOVEI A,ATMBUF ;ADDRESS TO ATOM BUFFER
HRL A,B ;COUNT OF CHARACTERS IN LH
CALL PCECST ;PCL COPY STRING
MOVEM A,NSPMT ;AND SAVE PTR
NOISE <,>
MOVEI B,[FLDDB. .CMQST,CM%SDH,,<Enabled prompt in quotes>,<"!">,[
FLDDB. .CMCFM]]
CALL FLDSKP ;ITS JUST IMPARSABLE
CMERRX ;YES
LDB C,[POINT 9,0(C),8] ;GET PARSE FUNCTION
CAIN C,.CMCFM ;WAS IT A CONFIRM
JRST .PROM1 ;YES, THEN GO SET PROMPTS
HRROI A,ATMBUF ;GET PTR TO ATOM BUFFER
HRROI B,REDPMT+1 ;COMPARE IT TO DEFAULT
STCMP%
SKIPN A ;IF NON-ZERO, THEN STRING DIFFER
SETZM ATMBUF ;ZERO BUFFER FOR NO CHANGE
HRROI A,ATMBUF ;GET PTR TO BUFFER
CALL BCOUNT ;GET CHARACTER COUNT
MOVEI A,ATMBUF ;ADDRESS TO ATOM BUFFER
HRL A,B ;COUNT OF CHARACTERS IN LH
CALL PCECST ;PCL COPY STRING
MOVEM A,PPMT ;SAVE IT
NOISE <AND> ;SOME MORE
MOVEI B,[FLDDB. .CMQST,CM%SDH,,<Enabled subcommand prompt in quotes>,<"!!">,[
FLDDB. .CMCFM]]
CALL FLDSKP ;PARSE IT
CMERRX ;NOPE
LDB C,[POINT 9,0(C),8] ;GET PARSE FUNCTION CODE
CAIN C,.CMCFM ;WAS IT CRLF
JRST .PROM1 ;YES, SET PROMPTS
HRROI A,ATMBUF ;GET PTR TO ATOM BUFFER
HRROI B,REDPMT+4 ;COMPARE IT TO DEFAULT
STCMP%
SKIPN A ;IF NON-ZERO, THEN STRING DIFFER
SETZM ATMBUF ;ZERO BUFFER FOR NO CHANGE
HRROI A,ATMBUF ;GET PTR TO BUFFER
CALL BCOUNT ;GET CHARACTER COUNT
MOVEI A,ATMBUF ;ADDRESS TO ATOM BUFFER
HRL A,B ;COUNT OF CHARACTERS IN LH
CALL PCECST ;PCL COPY STRING
MOVEM A,PSPMT ;SAVE THE PTR
CONFIRM
;HERE TO SET THE PROMPTS
.PROM1: SKIPE SETLVL ;ARE WE IN "SET LEVEL"
JRST [ ETYPE <Can't set prompts with level-indication enabled.%_>
JRST .PROM2] ;FINISH UP
CALL PIOFF ;NO ^C THROUGH HERE
MOVE A,NPMT ;GET NONPRIVED. PROMPT
MOVEI B,1 ;SAY TO SET PROMPT
CALL DIVPMR
MOVE A,NSPMT ;GET REG. SUB. PROMPT
MOVEI B,1 ;SET PROMPT
CALL DIVPMS
MOVE A,PPMT ;ENABLE PTR PROMPT
MOVEI B,1 ;SET PROMPT
CALL DIVPME
MOVE A,PSPMT ;GET PRIV. SUBCOMMAND.
MOVEI B,1 ;SET PROMPT
CALL DIVPMU
CALL PION ;ENABLE ^C NOW.
.PROM2: SETZM PCSFRE ;RESTORE PCL STRING SPACE
RET ;AND RETURN
; SET [NO] LEVEL-INDICATION
.SLEVL::STKVAR <NPMT,NSPMT,PPMT,PSPMT,LEVEL> ;STORAGE WITH .PROMP
SETZM NPMT ;INIT. ALL POINTERS
SETZM NSPMT
SETZM PPMT
SETZM PSPMT
SKIPN PCSFRE ;PCL FREE SPACE INITIALIZED
JRST [ MOVSI A,PCSTRL*512 ;NO, SO DO IT
MOVEM A,PCSTRS
MOVEI A,PCSTRS
MOVEM A,PCSFRE
JRST .+1]
CALL GSLEV ;RETURN SUB-LEVELS IN B
JUMPE B,R ;RETURN IF LEVEL 0.
MOVEM B,LEVEL ;SAVE IT FOR LATER
SKIPE SETNOF ;WAS "NO" SPECIFIED?
JRST .SLEV2 ;YES, SO REMOVE NUMBER
SKIPE SETLVL ;HAVE WE SET LEVEL ONCE?
RET ;YES, SO DON'T DO IT AGAIN
SKIPN A,PCLPMT ;GET PCL NONPRIV. REG. PROMPT
MOVEI A,REDPMT ;IF NOT, GET DEFAULT
HRROS A ;MAKE A STRING PTR
MOVE B,LEVEL ;GET LEVEL
CALL .SLEV1 ;CALL A ROUTINE TO BUILD STRING
MOVEM A,NPMT ;SAVE NEW PROMPT
SKIPN A,PCLPMT+3 ;PCL NON-PRIV. SUB. PROMPT
MOVEI A,REDPMT+3 ;DEFAULT
HRROS A ;MAKE PTR
MOVE B,LEVEL ;GET LEVEL
CALL .SLEV1 ;CREATE PROPER PROMPT
MOVEM A,NSPMT ;AND SAVE IT
SKIPN A,PCLPMT+1 ;PCL PRIV. PROMPT
MOVEI A,REDPMT+1 ;DEFAULT PRIV. PROMPT
HRROS A ;FORM PTR
MOVE B,LEVEL ;GET LEVEL
CALL .SLEV1 ;CREATE PROMPT
MOVEM A,PPMT ;AND SAVE IT
SKIPN A,PCLPMT+4 ;PCL PRIV. SUB. PROMPT
MOVEI A,REDPMT+4 ;DEFAULT.
HRROS A ;MAKE PTR
MOVE B,LEVEL ;GET LEVEL
CALL .SLEV1 ;ROUTINE TO ADD NUMBER
MOVEM A,PSPMT ;SAVE IT
SETOM SETLVL ;REMEMBER WE ARE LEVEL INDICATING
JRST .SLEV4 ;SET THE PROMPTS
;THIS ROUTINE TAKE A STRING PTR TO PROMPT IN A. IT WILL CREATE
; THE PROMPT WITH THE LEVEL IN FRONT. LEVEL NUMBER IS IN B.
; THE PTR TO THE NEW PROMPT WILL RETURN IN A.
.SLEV1: PUSH P,A ;SAVE ORIGINAL PTR
PUSH P,B ;SAVE LEVEL COUNT
CALL BCOUNT ;COUNT CHARACTERS AND WORDS
ADDI A,2 ;MAKE ROOM FOR LEVEL
CALL GETBUF ;AND GET A BUFFER
HRLI A,(<POINT 7,>) ;MAKE IT A POINTER
POP P,D ;GET LEVEL IN D
POP P,B ;GET ORIGINAL BACK
PUSH P,A ;AND SAVE NEW PTR FIRST
PUSH P,B ;THEN SAVE OLD PTR
MOVE B,D ;GET THE LEVEL BACK
MOVEI C,^D10 ;OUTPUT IT IN DECIMAL
NOUT%
CALL CJERR ;SHOULDN'T HAPPEN
POP P,B ;RESTORE PTR TO ORIG. PROMPT
SETZ C, ;COPY TILL NULL
SOUT%
ERJMP CJERR ;SHOULDN'T HAPPEN EITHER
MOVE A,0(P) ;POP PTR TO STRING WE JUST MADE
CALL BCOUNT ;COUNT IT UP
MOVE A,0(P) ;GET PTR BACK
HRL A,B ;PUT CHAR. COUNT IN LH.
CALL PCECST ;CALL PCL FREE SPACE ROUTINE
EXCH A,0(P) ;SAVE NEW AND RESTORE OLD
CALL STREM ;RESTORE OLD MEMORY
POP P,A ;RETURN NEW
RET
;SET NO LEVEL-INDICATION
.SLEV2: SKIPN SETLVL ;MAKE SURE WE HAVE SET LEVEL
RET ;IF NOT, THEN QUIT
MOVE D,LEVEL ;GET LEVEL NUMBER
IDIVI D,^D10 ;GET NUMBER OF DIGITS
ADDI D,1 ;MAKE IT CORRECT
MOVEM D,LEVEL ;SAVE IT
HRRO A,PCLPMT ;GET NON-PRIV PROMPT
HRLI A,(<POINT 7,>) ;MAKE PTR
HRROI B,REDPMT ;DEFAULT TO COMPARE AGAINST
MOVE C,LEVEL ;GET LEVEL
CALL .SLEV3 ;ROUTINE TO FIX PROMPT
MOVEM A,NPMT ;SAVE NEW PTR
HRRO A,PCLPMT+3 ;GET NON-PRIV SUB. PROMPT
HRLI A,(<POINT 7,>) ;MAKE PTR
HRROI B,REDPMT+3 ;COMPARE AGAINST THIS
MOVE C,LEVEL ;GET LEVEL
CALL .SLEV3 ;FIX IT
MOVEM A,NSPMT ;SAVE IT
HRRO A,PCLPMT+1 ;GET PRIV PROMPT
HRLI A,(<POINT 7,>) ;MAKE PTR
HRROI B,REDPMT+1 ;COMPARE AGAINST DEFAULT
MOVE C,LEVEL ;GET LEVEL
CALL .SLEV3 ;FIX IT UP
MOVEM A,PPMT ;SAVE IT FOR LATER
HRRO A,PCLPMT+4 ;GET PRIV SUB. PROMPT
HRLI A,(<POINT 7,>) ;MAKE PTR
HRROI B,REDPMT+4 ;USE THIS TO COMPARE AGAINST
MOVE C,LEVEL ;GET LEVEL
CALL .SLEV3 ;ROUTINE THAT FIXES PROMPT
MOVEM A,PSPMT ;SAVE IT
SETZM SETLVL ;MARK AS NO LEVEL
JRST .SLEV4 ;GO SET THE PROMPTS
;THIS ROUTINE WILL STRIP THE NUMBER OF CHARACTERS IN LEVEL
; OFF OF THE GIVEN STRING IN A. PASS STRING TO COMPARE IT TO IN B. LEVEL IN C.
; RETURN THE FIXED UP STRING IN A.
.SLEV3: ADJBP C,A ;ADJUST STRING PAST NUMBER
MOVE A,C ;GET CORRECT PTR IN A
PUSH P,A ;SAVE CURRENT PLACE
STCMP% ;TO SEE IF SAME
SKIPN A ;WERE THEY?
SETZM 0(P) ;YES, ZERO ORIGINAL
MOVE A,0(P) ;GET PTR BACK
CALL BCOUNT ;COUNT THE CHARACTERS AND WORDS
PUSH P,B ;SAVE CHAR. COUNT
CALL GETBUF ;GET NUMBER OF WORDS
HRLI A,(<POINT 7,>) ;MAKE A PTR
POP P,D ;GET CHAR. COUNT
POP P,B ;RESTORE ADVANCED PTR
PUSH P,A ;SAVE NEW PTR
SETZ C, ;COPY TILL NULL
SOUT%
ERJMP CJERR ;ERROR!
MOVE A,0(P) ;GET NEW PTR BACK
HRL A,D ;PUT CHAR. COUNT IN LH
CALL PCECST ;AND USE PCL FREE SPACE
EXCH A,0(P) ;SWAP PCL PTR WITH TEMP. PTR
CALL STREM ;AND RETURN IT TO FREE POOL
POP P,A ;RESTORE PCL PTR
RET ;AND BE DONE
;HERE TO SET THE PROMPTS
.SLEV4::CALL PIOFF ;NO ^C THROUGH HERE
MOVE A,NPMT ;GET NONPRIVED. PROMPT
MOVEI B,1 ;SAY TO SET PROMPT
CALL DIVPMR
MOVE A,NSPMT ;GET REG. SUB. PROMPT
MOVEI B,1 ;SET PROMPT
CALL DIVPMS
MOVE A,PPMT ;ENABLE PTR PROMPT
MOVEI B,1 ;SET PROMPT
CALL DIVPME
MOVE A,PSPMT ;GET PRIV. SUBCOMMAND.
MOVEI B,1 ;SET PROMPT
CALL DIVPMU
CALL PION ;ENABLE ^C NOW.
SETZM PCSFRE ;RESTORE PCL STRING SPACE
RET ;AND RETURN
;SUBROUTINE TO RETURN THE NUMBER OF SUPERIORS IN B.
; LEAVES ALL OTHER AC'S INTACT.
GSLEV: PUSH P,A ;SAVE AC'S
PUSH P,C
MOVX A,.FHTOP ;START AT THE TOP
SETZ B, ;RETURN NOTHING
MOVE C,[-300,,BUF0] ;RETURN STRUCTURE HERE
GFRKS% ;GET FORK STRUCTURE
JRST [ CAIE A,GFKSX1 ;AREA TOO SMALL?
JRST JERR ;SOMETHING ELSE
JRST .+1] ;THEN IGNORE
MOVE C,[-277,,BUF0+1] ;POINT TO TOP PROCESS HANDLE
GSLEV1: HRRZ A,(C) ;GET POSSIBLE HANDLE
CAIN A,.FHSLF ;US YET?
JRST GSLEV2 ;YES, GO COUNT SUPERIORS
AOBJP C,GSLEVE ;SKIP STATUS WORD
AOBJP C,GSLEVE ;AND POINTERS
AOBJN C,GSLEV1 ;GO BACK FOR ANOTHER LOOK
GSLEVE: ERROR <Can't find self in fork structure>
GSLEV2: HLRZ C,(C) ;GET POINTER TO SUPERIOR
JUMPE C,GSLEV3 ;IF NO SUPERIOR, WE'RE DONE
AOS C ;INCREMENT PTR TO SUPERIOR'S SUPERIOR
AOJA B,GSLEV2 ;COUNT AND TRY AGAIN
GSLEV3: POP P,C ;RESTORE AC'S
POP P,A
RET
>;IFN STANSW
END