Trailing-Edge
-
PDP-10 Archives
-
bb-m081u-sm_t20_v7_0_23_exec_src_mod
-
exec/execse.mac
There are 47 other files named execse.mac in the archive. Click here to see a list.
; Edit= 4417 to EXECSE.MAC on 12-Jan-89 by WONG, for SPR #22042
;Add code to support @SET DEFAULT PRINTER /REMOTE-PRINT: command and fix some
;bugs in routine SRPPTR: which deals with validating the arguments to the @SET
;REMOTE PRINTER command.
; Edit= 4416 to EXECSE.MAC on 10-Jan-89 by RASPUZZI
;Add commands and modify INFO SYS for password dictionary.
; Edit= 4412 to EXECSE.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4409 to EXECSE.MAC on 12-Aug-88 by GSCOTT
;It's OK to have the second field of SET REMOTE-PRINTING PRINTER start with a
;mimeric character, remove code that checks for alphabetic only in SRPPTR.
; Edit= 4402 to EXECSE.MAC on 5-Apr-88 by EVANS (TCO 7.1265)
;Make the EXEC accept non-alphanumeric characters $,_,-,and . in LAT-type
;names for remote printing.
; UPD ID= 4128, RIP:<7.EXEC>EXECSE.MAC.21, 7-Mar-88 18:27:20 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4103, RIP:<7.EXEC>EXECSE.MAC.20, 18-Feb-88 15:56:46 by RASPUZZI
;TCO 7.1232 - Make NO PRIVATE-QUASAR clear NEBULA's PID too.
; UPD ID= 4098, RIP:<7.EXEC>EXECSE.MAC.19, 18-Feb-88 15:46:59 by RASPUZZI
;TCO 7.1231 - Add ^ESET MINIMUM-PASSWORD-LENGTH command.
; UPD ID= 77, RIP:<7.EXEC>EXECSE.MAC.18, 24-Nov-87 15:59:33 by MCCOLLUM
;TCO 7.1147 - Change offline structures default to 5 seconds
; UPD ID= 68, RIP:<7.EXEC>EXECSE.MAC.17, 17-Nov-87 14:50:18 by EVANS
; TCO 7.1136 - Move check for defining alias to itself to DOSRPP: routine.
; UPD ID= 62, RIP:<7.EXEC>EXECSE.MAC.16, 10-Nov-87 15:00:47 by EVANS
; TCO 7.1118 - Remove an extraneous CALL PIOFF at SRPCH2:
; UPD ID= 56, RIP:<7.EXEC>EXECSE.MAC.14, 29-Oct-87 15:35:03 by EVANS
; TCO 7.1099 Change help message when parsing .CMCFM in second field
; of SET REMOTE XXXX command.
; UPD ID= 54, RIP:<7.EXEC>EXECSE.MAC.13, 28-Oct-87 22:40:52 by RASPUZZI
;More of TCO 7.1076 - This time, merge the right .RED file...
; UPD ID= 51, RIP:<7.EXEC>EXECSE.MAC.12, 28-Oct-87 14:03:36 by EVANS
; TCO 7.1091 Resolve symbol conflict with MONSYM (7.0 only) by renaming
; routine .LATTY to .LTTTY.
; UPD ID= 46, RIP:<7.EXEC>EXECSE.MAC.11, 27-Oct-87 15:38:34 by EVANS
; More of TCO 7.1073 - Fix some bugs.
; UPD ID= 43, RIP:<7.EXEC>EXECSE.MAC.10, 22-Oct-87 11:04:27 by RASPUZZI
;TCO 7.1076 - Add ^ESET CLUSTER-INFO and ^ESET CLUSTER-SEND commands
; UPD ID= 32, RIP:<7.EXEC>EXECSE.MAC.9, 16-Oct-87 14:20:13 by EVANS
; TCO 7.1071 - More of TCO 7.1068 - fix some bugs.
; UPD ID= 31, RIP:<7.EXEC>EXECSE.MAC.8, 30-Sep-87 16:27:27 by EVANS
; More of TCO 7.1061 - Make user confirm if setting something to itself
; UPD ID= 29, RIP:<7.EXEC>EXECSE.MAC.7, 30-Sep-87 16:07:11 by EVANS
; TCO 7.1068 - Implement SET REMOTE-PRINTING PRINTER
; UPD ID= 28, RIP:<7.EXEC>EXECSE.MAC.6, 23-Sep-87 15:51:13 by MCCOLLUM
;TCO 7.1063 - Add ^ESET [NO] OFFLINE-STRUCTURES commands.
; UPD ID= 24, RIP:<7.EXEC>EXECSE.MAC.5, 22-Sep-87 11:46:48 by EVANS
; More TCO 7.1061 - Fill in TCO numbers around edits and add header line.
; UPD ID= 16, RIP:<7.EXEC>EXECSE.MAC.4, 22-Sep-87 10:47:51 by EVANS
; TCO 7.1061 - Implement SET REMOTE-PRINTING CHARACTERISTIC
; UPD ID= 8, RIP:<7.EXEC>EXECSE.MAC.3, 4-Aug-87 17:00:02 by EVANS
; TCO 7.1031 - Add processing for SET REMOTE-PRINTING SYSTEM-DEFINITIONS
; Also hooks and tables for other new SET REMOTE-PRINTING
; commands, CHARACTERISTIC and REMOTE-PRINTER.
; *** Edit 3064 to EXECSE.MAC by GSCOTT on 23-Apr-87, for SPR #19597
; Don't change the session remark if the user didn't change it in SET ACCOUNT.
; *** Edit 3042 to EXECSE.MAC by MCCOLLUM on 26-Jun-86
; Add a call to .LATTY at .ANTTY for SET LOGINS ANY enables LAT logins.
; *** Edit 3041 to EXECSE.MAC by MCCOLLUM on 24-Jun-86, for SPR #21297
; Add ^ESET [NO] LOGINS LAT-TERMINALS and fix up @INFO SYS to display status
; *** Edit 3040 to EXECSE.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; Edit 3012 to EXECSE.MAC by EVANS on 15-Aug-85 (TCO 6-1-1521 )
; Make user confirm SET NO TRAP PROCEED before setting the "NO" flag.
; Edit 3007 to EXECSE.MAC by EVANS on 9-Aug-85 (TCO 6-1-1507 )
; Tell the monitor what program we're running for the SET HOST command.
; UPD ID= 247, SNARK:<6.1.EXEC>EXECSE.MAC.24, 11-Jun-85 15:24:23 by SANTIAGO
;TCO 6.1.1441 - Require confirmation from SET STATUS-WATCH for subcommands
; UPD ID= 240, SNARK:<6.1.EXEC>EXECSE.MAC.23, 10-Jun-85 08:45:20 by DMCDANIEL
; UPD ID= 213, SNARK:<6.1.EXEC>EXECSE.MAC.22, 3-Jun-85 12:23:11 by PRATT
;TCO 6.1.1388 - Clear entry in REASON table after alert has gone off
; UPD ID= 212, SNARK:<6.1.EXEC>EXECSE.MAC.21, 31-May-85 10:41:25 by EVANS
;More TCO 6.1.1404 - Remove SETNOF from TRVAR, it's now global.
; UPD ID= 192, SNARK:<6.1.EXEC>EXECSE.MAC.19, 10-May-85 13:56:36 by EVANS
;TCO 6.1.1361 - Use ERROR macro if SET TRAP JSYS not confirmed properly.
; UPD ID= 189, SNARK:<6.1.EXEC>EXECSE.MAC.18, 6-May-85 23:14:33 by PRATT
;Again, more TCO 6.1.1243 - Changing LERROR to ETYPE screwed up crlfs
; UPD ID= 185, SNARK:<6.1.EXEC>EXECSE.MAC.17, 3-May-85 14:29:14 by PRATT
;TCO 6.1.1356 - Parse arbitrary string for node names in SET HOST
; UPD ID= 181, SNARK:<6.1.EXEC>EXECSE.MAC.16, 3-May-85 08:32:30 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 146, SNARK:<6.1.EXEC>EXECSE.MAC.15, 15-Mar-85 14:53:14 by EVANS
;TCO 6.1.1248 - Prevent user being left with null password. (RE: edits 925 & 2011)
; UPD ID= 143, SNARK:<6.1.EXEC>EXECSE.MAC.14, 15-Mar-85 13:07:18 by PRATT
;More TCO 6.1.1243 - Change the LERROR to an ETYPE
; UPD ID= 132, SNARK:<6.1.EXEC>EXECSE.MAC.13, 7-Mar-85 19:56:08 by PRATT
;TCO 6.1.1243 - Make error character for SET PAGE command be a percent
; UPD ID= 114, SNARK:<6.1.EXEC>EXECSE.MAC.10, 12-Dec-84 16:29:32 by PRATT
;TCO 6.1.1085 - Rename SET JFN-WATCH to SET STATUS-WATCH
; UPD ID= 109, SNARK:<6.1.EXEC>EXECSE.MAC.9, 12-Dec-84 13:51:11 by PRATT
;More TCO 6.1.1017 - Update to latest cterm-server, and bugfixes
; Run CTERM-SERVER at offset 3 in entry vector
; Always kill off server if NSPX20 error even if fork is kept
; Fix problem with kept/continue status of fork
; UPD ID= 66, SNARK:<6.1.EXEC>EXECSE.MAC.7, 12-Nov-84 03:51:17 by MERRILL
;TCO 6.1.1042 - Update for latest PCL we have
; Fix SET [NO] COMMAND-TRACE to not set/clear the trace flag until
; the command has been confirmed.
; UPD ID= 29, SNARK:<6.1.EXEC>EXECSE.MAC.6, 2-Oct-84 14:15:47 by PRATT
;More TCO 6.1.1016 - LIST-PAR... needs confirm in the right place
; UPD ID= 22, SNARK:<6.1.EXEC>EXECSE.MAC.4, 1-Oct-84 17:12:56 by PRATT
;TCO 6.1.1017 - Add SET HOST command
; UPD ID= 19, SNARK:<6.1.EXEC>EXECSE.MAC.3, 1-Oct-84 12:01:42 by PRATT
;More TCO 6.1.1016 - Also type out the connected directory
; UPD ID= 9, SNARK:<6.1.EXEC>EXECSE.MAC.2, 29-Sep-84 16:08:28 by PRATT
;TCO 6.1.1016 - Add SET JFN-WATCH command
; 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
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
SEARCH EXECDE
TTITLE EXECSE
;THIS FILE CONTAINS
;SET AND ^ESET COMMANDS
DEFINE SETSTG
< TRVAR <ATIME,NOW,AHELP,<ARANGE,2>,ENTADR,WBITS,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::STKVAR <SETSR,SETAC> ;[3064] Pointer session remark and account
SETZM SETSR ;[3064] Clear any pointer to session remark
NOISE (TO) ;[3064] Blurt out the noise word
CALL ACCT ;[3064] (/A) Input, check, convert account
MOVEM A,SETAC ;[3064] Save pointer to the account string
NOISE (SESSION REMARK) ;[3064] Mumble out session remark noise words
MOVEI B,[FLDDB. .CMCFM,,,,,[ ;[3064]
FLDDB. .CMTXT,,,<New session remark, one line of text>]] ;[3064]
CALL FLDSKP ;[3064] (B/B,C) Get a confirm or session remark
CMERRX ;[3064] Didn't parse (?) give an error message
LDB C,[POINT 9,(C),8] ;[3064] Get the function that parsed
CAIE C,.CMTXT ;[3064] Was it the confirm?
IFSKP. ;[3064] No, it was a session remark
CALL BUFFF ;[3064] (/A) Get a pointer to it into ac A
MOVEM A,SETSR ;[3064] Save pointer to session remark
CONFIRM ;[3064] Confirm that command please
ENDIF. ;[3064]
MOVE A,SETAC ;[3064] Load pointer to account string
CACCT ;[3064] Change the account string
CALL CJERR ;[3064] Give an error if it didn't work
SKIPE A,SETSR ;[3064] Is there a session remark to set?
CALL SSR ;[3064] (A/) Yes, set the session remark
RET ;[3064] Return to CMDIN4
ENDSV. ;[3064] End of .CHANG's STKVAR
;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 HOST FOR CONNECTING TO DECNET HOSTS USING THE CTERM-SERVER OR NRT:
.HOST:: TRVAR <NNAM,SWTNAM,SRVJFN,PNAMP,NAMFLG,PTBLP>
SETZM NNAM ;CLEAR AWAY 1ST PART OF NODE NAME
SETZM SWTNAM ;CLEAR SWITCH SEEN
MOVEI B,[FLDDB. .CMSWI,,$HOST,<Node name>,,[
FLDDB. .CMCFM,,,,,[
FLDBK. .CMTXT,,,<Node name>,,[
BRMSK. (EOLB0.,EOLB1.,EOLB2.,EOLB3.,,</>)],]]]
CALL FLDSKP ;PARSE THE NEXT FIELD
CMERRX
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
CAIN C,.CMCFM ;CONFIRMED ?
JRST HOST1 ;YES - INVOKE CTERM INTERACTIVELY
CAIN C,.CMSWI ;GOT A SWITCH ?
JRST HOST2 ;YES - GO PROCESS IT
CALL BUFFF ;BUFFER THE NODENAME
MOVEM A,NNAM ;SAVE ADDRESS OF NODE NAME
MOVEI B,[FLDDB. .CMSWI,,$HOST,,,[
FLDDB. .CMCFM]]
CALL FLDSKP ;PARSE THE NEXT FIELD
CMERRX
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
CAIN C,.CMCFM ;CONFIRMED ?
JRST HOST1 ;YES - INVOKE CTERM
HOST2: CALL GETKEY ;GOT A SWITCH, SEE WHICH ONE
MOVEM P3,SWTNAM ;SAVE IT
CONFIRM
HOST1: HLRO B,.HCTRM ;BY DEFAULT USE CTERM
SKIPE A,SWTNAM ;SWITCH SPECIFIED ?
HLRZ B,A ;YES - USE IT INSTEAD
HRLI B,(POINT 7,0) ;MAKE POINTER IN LEFT
MOVE A,[POINT 7,BUF0] ;USE TEMP PAGE FOR BUFFERING THE STRING
SETZ C, ;TERMINATE ON NULL
CALL ASOUT ;COPY THE STRING
SKIPN B,NNAM ;HAVE NODENAME ?
IFSKP.
HRLI B,(POINT 7,0) ;YES - MAKE POINTER TO IT
CALL ASOUT ;APPEND IT TO THE STRING
ENDIF.
MOVE B,[POINT 7,[BYTE (7) 15,12,0]] ;TERMINATE BUFFER WITH CRLF
CALL ASOUT ;COPY IT
HRROI A,BUF0 ;POINT AT FULL STRING
RSCAN ;BUILD RSCAN BUFFER FOR SERVICE PROGRAM
ERROR <RSCAN failed, cannot invoke protocol service program>
HRRO B,.HCTRM ;BY DEFAULT USE CTERM
SKIPE A,SWTNAM ;SWITCH SPECIFIED ?
HRRO B,A ;YES - USE IT INSTEAD
CALL TRYGTJ
ERROR <Couldn't invoke protocol service program: %?>
MOVEM A,SRVJFN ;SAVE SERVICE PROGRAM JFN AWAY
MOVEI Q1,ETTYMD ;MAKE SURE NORMAL TTY MODE RESTORED
CALL LTTYMD
CALL PSPNAM ;SET UP THE NAME
CALL PSPRUN ;GO RUN IT AND WAIT
SKIPE B,SWTNAM ;WAS ANY SERVICE SPECIFIED
IFSKP.
SKIPGE A,FORK ;NO - DEFAULTED TO CTERM - GET FORK HANDLE
JRST HOST4 ;DON'T HAVE IT FOR SOME REASON
GETER ;SEE WHAT THE LAST ERROR WAS
ERJMP HOST4 ;FORK GONE PROBABLY
HRRZS B ;SAVE ONLY THE ERROR CODE
CAIE B,NSPX20 ;"DESTINATION PROC DOES NOT EXIST" ?
JRST HOST4 ;NO - DON'T ATTEMPT TO USE NRT:
SKIPLE A,FORK ;GET FORK HANDLE AGAIN
CALL KEFORK ;NO - KILL IT
MOVE B,.HNRT ;POINT AT NRT:
MOVEM B,SWTNAM
JRST HOST1 ;TRY TO RUN IT
ENDIF.
HOST4: TLZ Z,RUNF ;SAY PROG'S TTY MODES NOT IN EFFECT
MOVEI Q1,ETTYMD ;RESTORE EXEC'S TTY MODES
CALL LTTYMD ;..
RET
$HOST: TABLE
[ASCIZ/CTERM/],,.HCTRM
[ASCIZ/NRT/],,.HNRT
TEND
.HCTRM: [ASCIZ/CTERM-SERVER /],,[GETSAVE (SYS:CTERM-SERVER.)]
.HNRT: [ASCIZ/NRT: /],,[ASCIZ/NRT:/]
;SET THE PROGRAM NAME FOR ^T AND FREINDS
PSPNAM: MOVEI A,EXTSIZ ;GET ROOM FOR FILENAME
CALL GETBUF ;GET BUFFER FOR IT
HRRO A,A ;MAKE POINTER TO THE SPACE
MOVEM A,PNAMP ;REMEMBER POINTER TO PROGRAM NAME
HRLM A,PRGCEL ;SET UP POINTER TO PROG NAME FOR ^T
MOVE B,SRVJFN ;GET PROGRAM NAME
MOVX C,1B8 ;WE WANT JUST THE NAME FIELD
JFNS ;GET FILE NAME
MOVEI B,PRGCEL
MOVEM B,COMAND
HLRO A, (B) ;[3007] POINT TO PROGRAM NAME STRING
CALL GETSIX ;[3007] MAKE INTO SIXBIT
JFCL ;[3007] TRUNCATED IF RETURNS HERE
SETNM ;[3007] TELL THE MONITOR ABOUT IT
RET
;HERE TO RUN THE PROTOCOL SERVICE PROGRAM
PSPRUN: MOVEI A,FRKNMS ;POINT TO LIST OF KNOWN FORKS
MOVE B,PNAMP ;POINT TO NAME OF PROTOCOL SERVICE
TBLUK ;LOOK IT UP IN KNOWN NAMES
TXNN B,TL%EXM ;IN LIST OF KNOWN FORKS?
IFSKP.
HRRZ C,(A) ;YES, GET ADDRESS OF FORK BLOCK
LOAD D,FKHAN,(C) ;GET FORK HANDLE
JUMPE D,PSPCK2 ;IF NONE, GO START NEW COPY
MOVEM D,FORK ;STORE AS CURRENT FORK
SETZM SYMOKF ;FORCE SYMBOLS TO BE RECOMPUTED
MOVE A,SLFTAB(D) ;GET FLAGS FOR THIS FORK
TXNN A,FK%KPT ;IS FORK KEPT ALREADY?
IFSKP.
ETYPE <[Starting]%_> ;YES
JRST PSPCK3 ;NO NEED TO "GET" A NEW COPY
ENDIF.
ENDIF.
PSPCK2: CALL ERESET ;PREPARE TO LOAD AND RUN PGM
MOVE A,SRVJFN ;GET SERVICE PROGRAM JFN AWAY
SETO C, ;FORCE OVERLAY
CALL $GET0 ;GET PROGRAM
PSPCK3: TLO Z,RUNF
MOVX B,FK%RUN ;FORK CAN BE CONTINUED LATER
MOVE A,FORK ;SET UP AS RUNNING FORK
IORM B,SLFTAB(A)
SKIPN C,SWTNAM ;SWITCH SPECIFIED ?
MOVE C,.HCTRM ;NO - BY DEFAULT USE CTERM
MOVEI B,3 ;DEFAULT IS CTERM'S "EXEC START" ADDRESS
CAME C,.HCTRM ;REALLY HAVE CTERM ?
SETZ B, ;NO - NORMAL START
SFRKV ;START FORK USING ENTRY VECTOR
RFORK ;RESUME IT
WFORK ;WAIT FOR IT
RET
;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)
CALL CONF ;[3013] REQUIRE CONFIRM BEFORE SETTING FLAGS
SKIPN SETNOF ;DIFFERENT ACTION ACCORDING TO "NO" FLAG
SETZM TSTOPF ;SET TRAP PROCEED
SKIPE SETNOF
SETOM TSTOPF ;SET NO TRAP PROCEED
RET ;[3013] AND RETURN
;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: ERROR <Comma or confirmation required>
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
BLOCK 1 ;[4412] Table is not big enough
;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
;SET [NO] JFN-WATCH
.JWAT:: SKIPE SETNOF ;[NO] FLAG TURNED ON ?
JRST .NJWT2 ;YES
TRVAR <TMPSEQ,<TMPPGS,JWPAGL>,LSTJWP,SUBMOD,CFMOK>
SETZM SUBMOD ;NOT IN SUBCOMMAND MODE
SETZM LSTJWP ;DON'T LIST PARAMETERS YET
MOVE A,IJWSEQ ;GET CURRENT INT CHARS
MOVEM A,TMPSEQ ;SAVE AWAY FOR LIST COMMAND
CALL JWTPG ;FILL UP TEMP PAGE GROUP TABLE FROM PERM
SETZM CFMOK ;CAN'T DO CONFIRM RIGHT AWAY
.JWAT1: MOVEI B,[FLDDB. .CMKEY,,$JWAT,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,<comma and carriage return to enter subcommands>,,[
FLDDB. .CMCFM]]]
SKIPN CFMOK
MOVEI B,[FLDDB. .CMKEY,,$JWAT,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,<comma and carriage return to enter subcommands>]]
CALL FLDSKP ;GET SOME INPUT
CMERRX
SETOM CFMOK ;OKAY TO DO CONFIRM NOW
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
CAIN C,.CMCFM ;CONFIRMED ?
JRST .JWAT2 ;YES
CAIE C,.CMKEY ;GOT KEYWORD ?
IFSKP.
CALL GETKEY ;YES - GET DISPATCH
CALL (P3) ;GO DO IT
JRST .JWAT1 ;AND TRY FOR ANOTHER
ENDIF.
CONFIRM ;IT'S A COMMA, MAKE SURE HE MEANS IT
.JWAT3: SETOM SUBMOD ;SET SUBCOMMAND MODE FLAG
SUBCOM $JWAT ;GO DO SUBCOMMANDS
.JWAT2: CALL JWSIC ;GO SET INTERRUPT CHAR(S)
SKIPE IJWSEQ ;YES - HAVE AN INTERRUPT SEQ ?
IFSKP.
SKIPL SUBMOD ;WERE WE IN SUBCOMMAND MODE ?
IFSKP.
ETYPE <%%Interrupt sequence must be specified>
JRST .JWAT3
ENDIF.
SKIPN LSTJWP ;NEED TO LIST PARAMTERS ?
ERROR <Interrupt sequence must be specified> ;YES - DON'T GEN ERROR
ENDIF.
CALL JWUPG ;GO UPDATE PAGE GROUP TABLE
SKIPE EXCBLK ;EXEC PAGES XRMAP ARG BLK ALREADY SET UP ?
IFSKP.
HRLI A,[EXP 4,<JWEPGE+1-JWEPGS>,JWEPGS,EXCBLK+4] ;NO
HRRI A,EXCBLK ;FORM ARGS FOR BLT
BLT A,EXCBLK+3 ;SET UP XRMAP ARG BLOCK
ENDIF.
SKIPE LSTJWP ;NEED TO LIST PARAMTERS ?
CALL JWLST ;YES
RET
$JWAT: TABLE
T INTERRUPT,,.JWINT ;INTERRUPT SEQUENCE
T LIST-PARAMETERS,,.JWLST
T NO,,.JWNO ;HANDLE "NO"
T PAGES,,.JWPAG ;GO READ PAGES
T TOPS-10-PAGES,,.JWT10
TEND
;"NO" PROCESSOR
.JWNO: KEYWD $NJWAT
0 ;NO DEFAULT
CMERRX ;INVALID KEYWORD
CALLRET (P3) ;DO WHAT WAS ASKED AND RETURN
$NJWAT: TABLE
T INTERRUPT,,NJWAT ;NO JFN-WATCHING
T PAGES,,.NJWPG ;NO PAGES AT ALL
TEND
;SET NO JFN-WATCH
NJWAT: CALL .NJWAT ;DISABLE THE INTERRUPTS
SETZM TMPSEQ ;CLEAR THE INTERRUPT FLAG
RET
.NJWT2: SKIPA ;.NJWT2 IS SET NO STATUS-WATCH
.NJWAT: SKIPE SUBMOD ;SUBCOMMAND MODE ?
CONFIRM ;YES
.NJWT1: SKIPG A,IJWSEQ ;HAVE A INTERRUPT SEQUENCE ?
RET ;NO - THEN IT'S ALREADY DISABLED
CAILE A,177 ;HAVE 1 OR 2 CHARACTERS
MOVEI A,.TITCE ;TWO
DTI ;DISABLE
ERJMP CJERR
SETOM IJWSEQ ;CLEAR THE REAL THING SINCE WE DID IT
RET
;HERE TO HANDLE SUBCOMMAND MODE FOR SET JFN-WATCH
.JWLST: SKIPE SUBMOD ;SUBCOMMAND MODE ?
IFSKP.
SETOM LSTJWP ;NO - SET FLAG, LIST PARAMS LATERS
RET
ENDIF.
CONFIRM
JWLST: SKIPG A,IJWSEQ ;GET INTERRUPT CHAR(S)
IFSKP.
ETYPE < Enabled on ">
LDB B,[POINT 7,A,^D28] ;HAVE IT - GET 1ST
SKIPE B ;HAVE 1ST CHAR ?
CALL JWTYPI ;YES - TYPE IT
LDB B,[POINT 7,A,^D35] ;GET NEXT CHAR
CALL JWTYPI ;TYPE IT
ETYPE <", >
ELSE.
ETYPE < No interrrupt characters set, >
ENDIF.
SKIPE TMPPGS
IFSKP.
ETYPE < No specified pages to check>
JRST JWSUB2
ENDIF.
ETYPE < Checking pages:>
SETZ A,
JWSUB1: CAML A,TMPPGS ;DONE ?
JRST JWSUB2 ;YES
MOVEI D,1+TMPPGS ;GET ADR OF TEMP PAGE GROUP TABLE
ADD D,A ;ADD IN THE OFFSET
HLRZ B,(D) ;GET 1ST PAGE IN GROUP
HRRZ C,(D) ;GET LAST PAGE IN GROUP
ETYPE < %2O>
CAME C,B ;SAME PAGE ?
ETYPE <-%3O> ;YEP
AOJA A,JWSUB1
JWSUB2: ETYPE <%_>
RET
;TYPE OUT THE CHARACTER IN B
JWTYPI: CAIL B," " ;CONTROL CHAR ?
IFSKP.
ADDI B,100 ;YES - MAKE IT A REAL CHAR
ETYPE <^> ;BUT SAY THAT IT WAS A CONTROL CHAR
ENDIF.
ETYPE <%2\> ;TYPE IT
RET
;INTERRUPT (USING)
.JWINT: QUOTEX <Quoted character or two character sequence to invoke file information>
CMERRX
SKIPE SUBMOD ;SUBCOMMAND MODE ?
CONFIRM ;YES
CALL .NJWT1 ;CLEAR THE EXISTING INTERRUPT IF ONE
MOVE B,[POINT 7,ATMBUF] ;POINT AT ATOM BUFFER FOR QUOTED STRING
ILDB C,B ;GET 1ST CHARACTER, DON'T CARE WHAT IT IS
JUMPE C,JWINT2 ;DON'T ALLOW NULL
ILDB A,B ;GET THE SECOND CHARACTER IF PROVIDED
JUMPE A,JWINT1 ;IF NULL, SINGLE CHARACTER, VALIDATE IT
LSH C,7 ;SHOVE IT OVER TO GET READY FOR 2ND CHAR
ADD C,A ;CONCATENATE THE 2ND CHARACTER
ILDB A,B ;SEE IF ANOTHER
JUMPN A,[ERROR <No more than two characters are allowed>]
CALLRET JWINT3 ;FINISH UP
JWINT1: CAIL C,^D27 ;MONITOR WILL FILTER SOME, WE FILTER OTHERS
JWINT2: ERROR <Not a valid interrupt character>
JWINT3: MOVEM C,IJWSEQ ;SAVE THE CHARACTERS
RET
;NO PAGES SUBCOMMAND
.NJWPG: SKIPE SUBMOD ;SUBCOMMAND MODE ?
CONFIRM ;YES
MOVEI A,1+TMPPGS ;GET ADR OF TABLE + 1
HRLI A,-1(A) ;GET ADR IN LH
AOS B,TMPPGS ;GET NUMBER OF ENTRIES + 1
ADDI B,TMPPGS ;GET LAST DEST ADR
SETZM TMPPGS ;CLEAR THE PAGE LIST
BLT A,(B) ;ZERO THE LIST
RET
;PAGES SUBCOMMAND
.JWPAG: CALL OCTLST ;GET THE LIST PAGES TO CHECK
SKIPE SUBMOD ;SUBCOMMAND MODE ?
CONFIRM ;YES
CALL JWUPDL ;GO UPDATE THE LIST
RET
;TOPS-10-PAGES SUBCOMMAND
PA10IO==730 ;NEAR BEGINNING OF PA1050 IO PAGES
PA10X==767 ;LAST POSSIBLE PAGE BEFORE DDT
.JWT10: SKIPE SUBMOD ;SUBCOMMAND MODE ?
CONFIRM ;YES
MOVEI A,2 ;SET RLIST COUNT TO 2 ENTRIES
MOVEM A,RLIST
DMOVE A,[EXP PA10IO,PA10X] ;APPROXIMATE RANGE OF PA1050 PAGES
DMOVEM A,RLIST+1 ;CREATE THE LIST
CALL JWUPDL ;UPDATE THE REAL PAGE LIST
RET
;UPDATE THE "WATCHED PAGES" LIST
JWUPDL: CALL JWPGCP ;CONVERT JWPAG LIST INTO BIT MAP
SETZ B, ;INDEX INTO RLIST
JWSRT1: CAML B,RLIST ;DONE ?
JRST JWSRTD ;YES
DMOVE C,RLIST+1(B) ;GET 1ST AND LAST PAGE
CAIG C,37777 ;1ST A LEGAL PAGE # ?
CAILE D,37777 ;YES - IS LAST LEGAL
ERROR <Invalid page number>
CAMLE C,D ;IS LAST LESS THAN 1ST ?
EXCH C,D ;YES, MAKE THE LAST BECOME THE 1ST
CALL JWINS ;ADD THIS GROUP OF PAGES TO BIT MAP
ADDI B,2 ;POINT AT NEXT DATA GROUP
JRST JWSRT1 ;AND TRY AGAIN
JWSRTD: CALL JWPGCM ;CONVERT BIT MAP BACK INTO JWPAG LIST
CAILE Q1,1000 ;HAVE MORE THAN 1 SECTIONS WORTH OF PAGES ?
JRST [SKIPE SUBMOD ;YES - DON'T RE-INIT IF NOT IN SUBCOMMAND
CALL JWTPG ;GO RE-INIT TEMP PAGE GROUP TABLE
ERROR <No more than 512 pages can be checked>]
RET
;HERE TO CONVERT THE JWPAG TO THE BITMAP
JWPGCP: SETZ P1,
SETZM XRMPAG ;USE XRMAP PAGE TO BUILD BIT MAP
MOVE A,[XRMPAG,,XRMPAG+1]
BLT A,XRMPAG+<<40*^D512>/^D36>+1 ;ZERO BIT MAP TABLE
PGCP1: CAML P1,TMPPGS ;THRU TABLE YET ?
RET ;YES
MOVEI B,1+TMPPGS ;GET ADDRESS OF TEMP PAGE GROUP TABLE
ADD B,P1 ;ADD THE OFFSET
HLRZ A,(B) ;GET BEGINNING PAGE
HRRZ C,(B) ;GET ENDING PAGE
CALL JWBIT ;TURN ON THE BIT IN THE MAP
AOJA P1,PGCP1 ;YES - GET NEXT TABLE ENTRY
;HERE TO UPDATE THE BITMAP
JWINS: SAVEAC <A,B>
MOVE A,C ;GET BEGINNING PAGE
MOVE C,D ;AND ENDING PAGE
JWBIT: CAMLE A,C ;THRU THIS RANGE OF PAGES ?
RET ;DONE
PUSH P,A
IDIVI A,^D36 ;GET BIT POSITION AND WORD OFFSET
MOVX D,1B0 ;GET A SINGLE BIT
MOVNS B ;SHIFT IT RIGHT
ROT D,(B) ;MOVE INTO CORRECT BIT POSITION
IORM D,XRMPAG(A) ;UPDATE THE BITTABLE
POP P,A
AOJA A,JWBIT
;HERE TO CONVERT BITTABLE INTO JWPAG LIST
JWPGCM: SETZ Q1,
SETZB P1,P2
SETZB P3,P4
SETZM TMPPGS
PGCM1: CAILE P1,<<40*^D512>/^D36>+1 ;THRU ENTIRE BITTABLE ?
RET ;YES
SKIPE B,XRMPAG(P1) ;ANYTHING IN THIS BITTABLE WORD ?
IFSKP.
SKIPE P2 ;HAVE A COUNT
CALL PGCM1A ;YES - GO UPDATE TEMP PAGE GROUP TABLE
AOJA P1,PGCM1 ;GO FOR MORE
ENDIF.
CAME B,[-1] ;ARE ALL BITS ON ?
IFSKP.
ADDI Q1,^D36
ADDI P2,^D36 ;YES - GOT 36 MORE
AOJA P1,PGCM1 ;TRY NEXT WORD
ENDIF.
SETZ C,
PGCM2: CAIL C,^D36 ;DONE FULL WORD ?
AOJA P1,PGCM1 ;YES - KEEP COUNTING
JUMPE B,PGCM2A ;NO MORE ? UPDATE TMP PAGE GROUP TABLE
SETZ A,
LSHC A,1 ;SHIFT B'S HIGH BIT INTO A
JUMPE A,PGCM2A ;ZERO BIT ? IF YES - SEE IF COUNT NEEDS UPDATING
SKIPE P2
IFSKP.
MOVE P2,P1 ;GET INDEX INTO BITTABLE
IMULI P2,^D36 ;NOW HAVE BEGINNING COUNT (UPTO THIS WORD)
ADD P2,C ;ADD BEGINNING BIT POSITION
MOVE P3,P2 ;SAVE AS BEGINNING ADDRESS
ENDIF.
AOS Q1 ;BUMP TOTAL NUMBER OF PAGES COUNTER
AOS P2 ;BUMP CONSECUTIVE COUNT
AOJA C,PGCM2 ;BUMP COUNTER - TRY NEXT BIT
PGCM2A: SKIPE P2 ;HAVE A COUNT
CALL PGCM1A ;YES - GO UPDATE TEMP PAGE GROUP TABLE
AOJA C,PGCM2 ;NO - TRY THE NEXT BIT
PGCM1A: MOVEI A,1+TMPPGS ;POINT TO TEMPORARY PAGE GROUP TABLE
ADD A,P4 ;ADD IN THE OFFSET
HRLM P3,(A) ;UPDATE THE 1ST PAGE
SOS P2 ;COUNT IS ONE TOO HIGH
HRRM P2,(A) ;UPDATE THE LAST PAGE
AOS TMPPGS ;BUMP COUNT
AOS P4 ;POINT AT NEXT JWPAG SLOT
CAIL P4,JWPAGL ;HAVE TOO MANY ?
ERROR <Too many page groups>
SETZ P2, ;CLEAR COUNT
RET
;HERE TO SET THE INTERRUPT CHARACTER(S)
JWSIC: SKIPL A,IJWSEQ ;HAS "NO INTERRUPT" BEEN SET ?
SKIPN A,IJWSEQ ;NO - HAVE A INTERRUPT SEQUENCE ?
RET
CAIG A,177 ;HAVE 1 OR 2 CHARACTERS
IFSKP.
MOVE A,[XWD .TITCE,IJWCHN] ;HOOK UP SWITCH SEQUENCE
ATI
MOVEI A,.PRIIN ;INTERRUPT ON PRIMARY INPUT
MOVEI B,.MOTCE ;SET TWO CHARACTER ESCAPE SEQEUNCE
MOVE C,IJWSEQ ;GET THE CHARACTERS
MTOPR ;ENABLE IT
ERJMP CJERR
ELSE.
MOVS A,IJWSEQ ;GET THE INTERRUPT CODE
HRRI A,IJWCHN ;USE OUR INT CHANNEL
ATI ;ENABLE IT
ERJMP CJERR
ENDIF.
RET
;HERE TO UPDATE THE PAGE GROUP TABLE
JWUPG: CALL JWPGT ;GO UPDATE JWPAG
SETZB A,Q1 ;INIT INDEX INTO JWPAG, INDEX INTO XRMPAG
MOVEI B,1 ;INIT INDEX INTO XRMAP ARG BLOCK
MOVEM B,XRMBLK ;ALSO INIT ARG BLOCK
JWUPD1: CAML A,JWPAG ;THRU ENTIRE LIST YET ?
JRST JWUPD2 ;YES
HLRZ C,JWPAG+1(A) ;GET THE 1ST PAGE
MOVEM C,XRMBLK+1(B) ;STORE AS 1ST PAGE OF GROUP
HRRZ D,JWPAG+1(A) ;GET THE 2ND PAGE
SUBI D,-1(C) ;GET THE NUMBER OF PAGES TO RETURN
HRRZM D,XRMBLK(B) ;STORE IT
MOVEI C,XRMPAG(Q1) ;MAKE POINTER TO PLACE TO STORE DATA
MOVEM C,XRMBLK+2(B) ;SAVE IT AWAY
LSH D,1 ;DATA AREA IS # OF PAGES * 2 WORDS
ADD Q1,D ;UPDATE INDEX INTO XRMPAG
AOS A ;UPDATE INDEX INTO JWPAG
MOVEI C,3 ;LENGTH OF ONE GROUP
ADDM C,XRMBLK ;UPDATE ARG BLOCK COUNT
ADDM C,B ;UPDATE POINTER TO END OF XRMBLK
JRST JWUPD1 ;NEXT
JWUPD2: RET
;HERE TO FILL UP THE PERMANENT GROUP TABLE FROM THE TEMPORARY ONE
JWPGT: MOVSI A,TMPPGS ;GET ADDRESS OF TEMP
HRRI A,JWPAG ;AND ADR OF REAL TABLE
MOVE B,TMPPGS ;GET LENGTH OF TABLE
AOS B ;PLUS 1
BLT A,JWPAG(B) ;MOVE THE TABLE
RET
;HERE TO FILL UP THE TEMP PAGE GROUP TABLE FROM THE PERMANENT ONE
JWTPG: MOVEI A,TMPPGS ;GET ADDRESS OF TEMP
HRLI A,JWPAG ;AND ADR OF REAL TABLE
MOVE B,JWPAG ;GET LENGTH OF TABLE
AOS B ;PLUS 1
ADDI B,TMPPGS ;NOW HAVE LAST DESTINATION ADR
BLT A,(B) ;MOVE THE TABLE
RET
;GOT HERE FROM INTERRUPT TO TYPE OUT JFN INFORMATION
IJWPSI::CALL SAVACS ;SAVE ACS
ETYPE <%_ Connected to %G >
CALL WATPMP ;CHECK FOR PMAPD FILES 1ST
SETZ P2, ;NOTHING TYPED
MOVEI P1,MAXJFN ;CHECK ALL JFNS
WATLUP: SKIPN A,P1 ;ZERO JFN IS NOT REAL
IFSKP.
GTSTS ;IN USE ?
TXNN B,GS%NAM ;FILE ASSOCIATED ?
IFSKP.
TXNE B,GS%XCF ;XCT ?
IFSKP.
TXNE B,GS%OPN ;NO - OPEN ?
CALL WATCHK ;YES - TYPE JFN IF OK
ENDIF.
ENDIF.
WATLP1: SOJG P1,WATLUP ;AND LOOK AGAIN
ENDIF.
WATDUN: SKIPN P2
ETYPE < %_>
CALL RESACS ;RESTORE THE ACS
DEBRK
;TYPE OUT JFN INFO
WATCHK: SAVEAC <P1>
STKVAR <FWJFN,FWSTS,FWBTIW,FWATBY,FWBSIZ>
MOVEM A,FWJFN ;SAVE THE JFN
MOVEM B,FWSTS ;SAVE THE FILE STATUS
CALL WCKJFN ;SEE IF WE SHOULD TYPE THIS JFN
IFNSK.
RFPTR ;NO PAGES MAPPED, GET CURRENT POSISTION
ERJMP R ;NO MAPPED PAGES, NO POSISTION, NO TYPE IT
JUMPE B,R ;DITTO IF ZERO
MOVEM B,FWATBY ;SAVE POSISTION
ENDIF.
SKIPN P2 ;ALREADY TYPED SOMETHING ?
ETYPE <%_>
SETO P2, ;NOW WE HAVE
ETYPE < >
MOVE A,COJFN
HRRZ B,FWJFN ;GET THE JFN
MOVE C,[XWD 4,10]
NOUT ;JFN, LEFT ADJ IN 4 COLS
ERJMP .+1
MOVE A,COJFN ;USE PROPER OUTPUT JFN
HRRZ B,FWJFN
SETZ C, ;DEFAULT FORMAT
JFNS ;PRINT NAME
ERJMP [CALL JFNSIL ;ANALYZE ERROR
JRST [CALL DGETER ;GET THE REASON FOR THE FAILURE
CAIE A,DESX3 ;MAKE SURE IT'S "JFN IS NOT ASSIGNED"
CALL JERR ;STRANGE ERROR, SO FAIL
ETYPE < ...[JFN has just been released]>
JRST WSDUNE]
JRST .+1] ;MESSAGE PRINTED, LIKE "RESTRICTED JFN"
MOVE A,FWJFN
RFBSZ
ERJMP WSDUNE
MOVEM B,FWBSIZ ;SAVE BYTE SIZE
MOVEI C,^D36
IDIV C,B
MOVEM C,FWBTIW ;PUSH NUMBER OF BYTES IN WORD
RFPTR ;GET CURRENT POSISTION
ERJMP WSDUNE
MOVEM B,FWATBY ;SAVE POSISTION
SKIPN B ;GOT BYTE POSITION ?
SKIPN WJPTAB ;NO, ANY PMAP'D PAGES ?
IFNSK.
SKIPE B ;ANY POSITION
IFSKP.
SIZEF ;NO - JUST GET THE SIZE
ERJMP WSDUNE
JUMPE C,WSDUNE ;IF NO SIZE SET, TYPE NOTHING
ETYPE < [%3Q page>
CAIE C,1 ;ONE PAGE ?
ETYPE <s> ;NO
ELSE.
IDIV B,FWBTIW ;NO - GET NUMBER OF WORDS
IDIVI B,^D512 ;GET PAGE NUMBER
SKIPE C ;IF ANY IN C THEN PLUS 1 PAGE
AOS B
MOVE D,B ;SAVE IT TILL WE TYPE IT
SIZEF ;GET SIZE OF FILE
ERJMP WSDUNE
ETYPE < [Page %4Q> ;TYPE PAGE WE'RE AT
SKIPE C ;HAVE LENGTH YET ?
ETYPE < of %3Q> ;YES
ENDIF.
ELSE.
CALL TPMAPF ;TRY TO TYPE PMAPD FILES FOR THIS FORK
JRST WSDUNE
ENDIF.
MOVE A,FWATBY ;GET BYTE WERE AT
MOVE B,FWBSIZ ;GET THE BYTE SIZE
SKIPE A
ETYPE <. Byte %1Q(%2Q)>
TYPE <.>
MOVE A,FWSTS
TXNE A,GS%RDF ;READING ?
ETYPE < Read>
TXNE A,GS%WRF ;WRITING ?
ETYPE < Write>
TXNN A,GS%RND ;APPEND ?
ETYPE < Append>
ETYPE <]>
WSDUNE: ETYPE < %_>
RET
;HERE TO TYPE OUT PMAP'D PAGES FOR A FILE IF THEY EXSIST
;
; CALL WITH A/ JFN
TPMAPF: SETZ D, ;CLEAR WJPTAB INDEX
SETZ P1, ;CLEAR FLAG FOR NO PAGES PMAPED
TMPFLP: CAMG D,WJPTAB ;DONE LOOKING ?
IFSKP.
SIZEF ;GET SIZE OF FILE
ERJMP R ;ERROR, RETURN
SKIPE P1 ;TYPED ANYTHING YET ?
IFSKP.
JUMPE C,R ;NO - IF NO SIZE SET, RETURN
ETYPE < [>
ELSE.
JUMPE C,RSKP ;IF NO SIZE, DON'T REPORT IT
ETYPE < of >
ENDIF.
ETYPE <%3Q page>
CAIE C,1 ;ONE PAGE ?
ETYPE <s> ;NO
RETSKP
ENDIF.
LDB B,[POINT 6,WJPTAB(D),5] ;GET THE JFN IN ENTRY
CAME A,B ;DO THE JFNS AGREE ?
AOJA D,TMPFLP ;NO, LOOK AT NEXT
LDB B,[POINT 12,WJPTAB(D),17] ;GET 1ST PAGE IN GROUP
SKIPN P1 ;ALREADY TYPED THIS
TYPE < [Mapped> ;NO
TYPE < >
SETO P1, ;SAY WE FOUND A PAGE
ETYPE <%2Q>
LDB C,[POINT 12,WJPTAB(D),35] ;GET LAST PAGE IN GROUP
CAME C,B ;SAME PAGE ?
ETYPE <-%3Q> ;YEP
AOJA D,TMPFLP ;GO DO NEXT
;HERE TO FIND OUT IN ADVANCE, IF THIS JFN HAS ANY MAPPED PAGES
WCKJFN: SETZ D, ;CLEAR WJPTAB INDEX
SETZ P1, ;CLEAR FLAG FOR NO PAGES PMAPED
WCK1: CAMLE D,WJPTAB ;DONE LOOKING ?
RET
LDB B,[POINT 6,WJPTAB(D),5] ;GET THE JFN IN ENTRY
CAME A,B ;DO THE JFNS AGREE ?
AOJA D,WCK1 ;NO, LOOK AT NEXT
RETSKP ;LFOUND ATLEAST ONE, THAT'S GOOD ENUF
WATPMP: TRVAR <LOOKFK,LJFNG,LPG,NPG,LDATA>
SETZM WJPTAB ;CLEAR CONDENSED LIST COUNT
MOVEI A,.FHSLF ;BY DEFAULT - LOOK AT SELF
MOVEI B,EXCBLK ;USE EXEC XRMAP BLOCK
SKIPGE CIPF ;COMMAND IN PROGRESS ?
IFSKP.
SKIPG A,FORK ;GET CURRENT FORK
RET ;NONE
MOVEI B,XRMBLK ;POINT AT NORMAL FORK XRMAP BLOCK
ENDIF.
MOVEM A,LOOKFK ;AND SAVE IT
MOVEM B,XRMPNT ;MAKE POINTER POINT AT IT FOR LATER
SKIPN @XRMPNT ;HAVE COUNT FOR XRMAP ARG BLOCK ?
RET ;NO - DONE
MOVS A,LOOKFK ;GET FORK HANDLE IN LH:
MOVE B,XRMPNT ;POINT AT XRMAP ARG BLOCK
XRMAP% ;RETRIEVE ALL THE PAGE INFO WE WANT
ERJMP R ;IGNORE THE ERROR
MOVEI P3,1 ;INDEX INTO XRMAP ARG BLOCK
SETZM LJFNG ;CLEAR LAST JFN
WMAP2: CAMGE P3,@XRMPNT ;DONE WITH ENTIRE ARG BLOCK
IFSKP.
MOVE A,LDATA ;GET LAST DATA
SKIPE B,LJFNG ;YES - GET THE LAST JFN WE HAD
CALL WMAP4 ;HAD ONE - WRITE AN ENTRY FOR IT
RET
ENDIF.
SETZM LJFNG ;CLEAR LAST JFN IN GROUP
SETZM NPG ;CLEAR THE PAGE COUNTER
SETZM LPG ;CLEAR LAST PAGE
SETZ P4, ;INDEX INTO THIS GROUP
MOVE P5,XRMPNT ;GET POINTER TO XRMAP ARG BLOCK
ADD P5,P3
MOVE P2,(P5) ;GET COUNT OF GROUP
SKIPA P1,2(P5) ;GET DATA ADDRESS OF GROUP
WMAP3: ADDI P1,2 ;POINT AT NEXT PAGES DATA
CAMGE P4,(P5) ;DONE WITH THIS GROUP ?
IFSKP.
ADDI P3,3 ;YES - POINT TO NEXT GROUP
JRST WMAP2 ;DO THE NEXT GROUP
ENDIF.
AOS P4 ;BUMP COUNTER NOW
SKIPGE A,(P1) ;IF B0 IS OFF, GOT A JFN,,PAGE #
JRST WMAP3 ;DIDN'T GET IT
MOVEM A,LDATA ;SAVE AS THE LAST DATA ITEM
LDB B,[POINT 9,A,17] ;JFN OR FORK #
CAME B,LJFNG ;SAME AS LAST JFN IN GROUP ?
IFSKP.
MOVEI C,-1(A) ;YES - GET THE PAGE # - 1 THATS MAPPED
CAME C,LPG ;SAME AS THE LAST ?
IFSKP.
AOS NPG ;YES - BUMP CONSECUTIVE PAGE COUNT
HRRZM A,LPG ;UPDATE LAST PAGE
JRST WMAP3 ;TRY THE NEXT
ENDIF.
CALL WMAP4 ;NO - CREATE CONDENSED LIST ENTRY
HRRZM A,LPG ;UPDATE THE LAST PAGE
JRST WMAP3 ;TRY NEXT PAGE
ENDIF.
EXCH B,LJFNG ;SAVE NEW JFN, NOW USE OLD TO BUILD TABLE
SKIPE B ;ZERO JFN ?
IFSKP.
HRRZM A,LPG ;YES - 1ST TIME THRU, UPDATE THE LAST PAGE
JRST WMAP3 ;TRY NEXT PAGE
ENDIF.
CALL WMAP4 ;CREATE A CONDENSED TABLE ENTRY
HRRZM A,LPG ;CLEAR LAST PAGE, NOT VALID ANYMORE
JRST WMAP3 ;TRY NEXT PAGE
WMAP4: AOS D,WJPTAB ;GET THE INDEX INTO CONDENSED TABLE
DPB B,[POINT 6,WJPTAB(D),5] ;SAVE THE JFN
MOVE B,LPG ;GET THE LAST PAGE #
DPB B,[POINT 12,WJPTAB(D),35] ;SAVE LAST PAGE
SUB B,NPG ;GET BEGINNING PAGE
DPB B,[POINT 12,WJPTAB(D),17] ;SAVE 1ST PAGE
SETZM NPG ;CLEAR THE COUNT
RET
.CIDLY::NOISE <FOR COMMANDS>
CALL CONF ;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!CM%NSF
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
;MORE COMPREHENSIVE MAIL-WATCH AND ALERT FACILITY
.MWATC::NOISE <FOR MAILBOX> ;[3040]
TRVAR <<USRDEF,EXTSIZ>,DEFPTR> ;[3040]
SKIPN CUSRNO ;[3040] ALREADY LOGGED IN?
JRST .MWATX ;[3040] NO - NO DEFAULT
MOVEI A,USRDEF ;[3040]
CALL DFUSER ;[3040](A/A)GET DEFAULT USER STRING
MOVEM A,DEFPTR ;[3040] SAVE POINTER TO DEFAULT
.MWATX: USERX <Mailbox name (User name, or Directory name without brackets)>
CALL MBOX ;[3040] MAYBE WE HAVE A MAILBOX NAME
CALL BUFFF ;[3040]( /A)BUFFER THE NAME
MOVE B,A ;[3040] GET POINTER IN AC2
CALL POBCHK ;[3040] (B/C ) THIS DIR ON POBOX: AND HAVE MAIL.TXT.1?
ERROR <No mailbox> ;[3040] GUESS NOT
STKVAR <PBDNUM> ;[3040] NUMBER OF DIRECTORY, WE NOW KNOW IT EXISTS ON POBOX:
MOVEM C,PBDNUM ;[3040]SAVE DIRECTORY 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,PBDNUM ;[3040] DIRECTORY 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
;[3040] ROUTINE TO ACCEPT A WORD - WE KNOW IT ISN'T A USERNAME, BUT IT STILL MAY BE
;[3040] A MAILBOX NAME
MBOX: WORDX ;[3040]GET INPUT
CMERRX <User name or Mailbox name required> ;[3040]
RET ;[3040]AND JOIN COMMON CODE
ENDTV.
ENDSV.
;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
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) ;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
SETZM REASON+1(C) ;MARK AS NO LONGER IN USE
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 [ ETYPE <%%Couldn't set access of page %2O - %1? %_>
RET]
ADD C,B ;GET LAST PAGE THAT FAILED
SOJ C,
ETYPE <%%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
CONFIRM ;[PCL]
MOVX A,PCFTRC ;TRACE BIT
ANDCAM A,PCFLAG ;CLEAR IT
SKIPN SETNOF ;WANT IT SET?
IORM A,PCFLAG ;SET IT
RET ;[PCL]
.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)
.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
;[4412]
;SET PASSWORD command
SETPAS::NOISE <OF LOGIN DIRECTORY>
CONFIRM ;Get EOL
MOVE A,[POINT 7,BUF0] ;Put directory name here
MOVEM A,DIRP ;Save byte pointer to where directory will be
MOVE B,LIDNO ;This is the directory
DIRST% ;Get name
ERCAL CJERRE ;Say what?
CALLRET DPASS0 ;And try this again
;"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
T SECURE,,DIRSEC ;[4412] SET DIRECTORY SECURE
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
T SECURE,,DIRSEC ;[4412] SET DIRECTORY NO SECURE
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
;"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
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
;SET FILE EPHEMERAL (ALSO SET NO ...)
.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 ;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
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 ;SAY THE CHANGE SUCCEEDED
EPHM2: SKIPE INIFH1 ;ANYTHING LEFT?
JRST EPHM1 ;YES - LOOP
RET ;NO - DONE
;[4412]
;SET FILE SECURE (ALSO SET NO ...)
SECFIL::NOISE <OF FILES> ;Type out some semi-help
CALL INFGNS ;Collect file name groups
CONFIRM ;Now parse end of line
SETOM TYPGRP ;Type the names as we go
MOVE A,JBUFP ;Get JFN stack
MOVEM A,.JBUFP ;Cover JFN stack
SECFL1: CALL RLJFNS ;Release spare JFNs
CALL NXFILE ;Get the next file
JRST SECFL2 ;No more - finish up
CALL TYPIF ;Type out the file name
CALL MFINP ;Get a second JFN
JRST SECFL2 ;Couldn't - on to next file
HRLI A,.FBCTL ;Word in FDB to change
MOVX B,FB%SEC ;Mask for file type code
SETZ C, ;Clearing this bit maybe?
SKIPN SETNOF ;Are we clearing this bit?
MOVX C,FB%SEC ;No, make sure we set it
CALL $CHFDB ;Set code in FDB
IFNSK. ;If CHFDB failed,
TYPE < Access not allowed
>
ELSE. ;If it worked,
CALL TYPOK ;Say the change succeeded
ENDIF.
SECFL2: SKIPE INIFH1 ;Anything left?
JRST SECFL1 ;Yes, do more
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
;[4412]
;DIRSEC - SET DIRECTORY SECURE (Also SET DIRECTORY NO ...)
DIRSEC: CALL INPDIR ;Get directory name
MOVX A,CD%SEC ;Bit for secure directory
CALLRET DMODE ;Do the work and return
;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
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
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 #
MOVEI A,.CDMOD+1 ;[4412] 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>
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
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
;DISPATCH USING TABLE OF COMMANDS FOR SET REMOTE-PRINTING
.RMPRT::SETZM SETNOF ;[7.1031] Flag "NO" was not said yet
KEYWD $RMPRT ;[7.1031] Get command from table
0 ;[7.1031]
JRST CERR ;[7.1031] Probably not there
JRST (P3) ;[7.1031] Go process command
;[7.1031] SET REMOTE-PRINTING SYSTEM-DEFINITIONS
;THIS 'TAKES' SYSTEM:REMOTE-PRINTING.CMD, WHICH WILL HAVE "SET REMOTE-PRINTNG"
;COMMANDS FOR THE AVAILABLE PRINTERS AND CHARACTERISTICS
SRPDEF::CONFIRM ;[7.1031] Look for CR
HRROI B,[ASCIZ /SYSTEM:REMOTE-PRINTING.CMD/] ;[7.1031]Use this file
CALL TAKSYS ;[7.1031] (B/ )Do the TAKE
IFNSK. ;[7.1031] Some error
ETYPE <?Could not set definitions - %?
> ;[7.1031] Tell last error
ENDIF.
RET ;[7.1031] Done
;[7.1061]
;HERE TO PARSE "SET REMOTE-PRINTING CHARACTERISTIC"
;CALLS SUBROUTINES TO SET BITS IN A 128-BIT BIT-MASK FOR THE DESIRED
;CHARACTERISTICS, DELETE AN EXISTING ENTRY, OR MAKE A NEW ENTRY. IF
;THE USER IS ONLY RE-DEFINING AN EXISTING CHARACTERISTIC, THIS ROUTINE
;WILL OVER-WRITE THE OLD BIT-MASK WITH THE NEW.
;
; Dispatch here from $RMPRT table
;FIRST, SEE IF THE TABLE HAS BEEN SET UP IN FREESPACE YET.
;IF NOT, GET SOME FREESPACE FOR IT AND SET UP THE FIRST WORD
;WITH "LENGTH,,MAX SIZE OF TABLE"
SRPCHR::SKIPN CHRTAB ;Table set up yet?
IFNSK. ;No
CALL PIOFF ;Let's set one up
MOVEI A,CTBLEN ;This many words
CALL GTBUFX ; A/A Gimme - permanent freespace
SKIPN A ; No freespace?
IFNSK. ; Guess not
ETYPE <?Cannot set up CHARACTERISTICs table
>
CALL PION
RET
ENDIF.
MOVEM A,CHRTAB ; Got some - save address of table
HRRZI B,CTBLEN ; Make 0,,length in AC2
MOVEM B,@CHRTAB ; Store in 1st table word
ENDIF. ; OK - ready to proceed
CALL PION ; Interrupts OK
;THE "EMPTY" TABLE HAS BEEN SET UP. NOW ADD THE TABLE ADDRESS INTO THE
;KEYWORD FDB WE ALREADY MADE IN EXECPR.MAC
MOVE A,CHRTAB ; Get the address
MOVEI B,CBKFDB
MOVEM A,.CMDAT(B) ; Plug it in
HRROI A,FDCHLP ; Now the help string *sigh*
MOVEM A,.CMHLP(B) ; Stuff it in
; Believe it or not, this works
;NOW BEGIN THE ACTUAL PARSING
TRVAR <<KEYWORD,3>,KEYLOC>
; NOTE: KEYWORD and KEYLOC must
; be kept in order, and in the same
; order in ALL TRVARs which use them.
STKVAR <<KEYWD2,3>,DELFLG,CFMOK>
; Now clear everything
SETZM BTMSK1 ; Start with the bit-mask
MOVE A,[BTMSK1,,BTMSK1+1]
BLT A,BTMSK1+3 ; Don't want any stray bits in the mask
SETZM KEYLOC ; Or the address of field-1 keyword
SETOM DELFLG ; But we want to set the "delete" flag
SETOM CFMOK ; And the "OK to confirm" flag
NOISE <NAME> ; Now we get to parsing, finally
;HERE WE ARE PARSING KEYWORDS, OR AN ARBITRARY FIELD (NEW CHARACTERISTIC)
MOVEI A,[FLDBK. .CMFLD,CM%BRK!CM%SDH,,<New characteristic name being created - 14 characters or less>,,[
BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_>]]
HRRM A,CBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,CBKFDB ; Get it into the correct AC
CALL FLDSKP ; Parse characteristic
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ;GET WHAT WAS TYPED
CAIN C,.CMKEY ; Keyword?
IFNSK.
MOVEM B,KEYLOC ; Save address
MOVSI A,(POINT 7,0)
HRRI A,KEYWORD ; Save keyword string here
MOVE B,CMABP ; Pointer to ATMBUF
SETZ C, ; End on null byte
CALL ASOUT ; (A,B,C/A,B)Copy keyword
ELSE.
; Gotta be an arbitrary string
MOVE A,CMABP ; Point to user's input
ILDB B,A ; Get first character
CAILE B,"Z" ; Lowercase char?
SUBI B,40 ; Yes, uppercase-ize
CAIL B,"A" ; If not between "A"
CAILE B,"Z" ; ...and "Z", it's not a letter.
ERROR <CHARACTERISTIC name must begin with alphabetic character>
MOVE A,CMABP ; point to ATMBUF
CALL BCOUNT ; (A/A,B)How many characters?
CAILE B,CHRCHR ; More than allowed?
ERROR <Too many characters in name>
;UPPERCASE HERE
MOVE A,CMABP ; Point to input
CALL UPRCAS ; Make uppercase
SETZM KEYLOC ; No table address (not in table yet)
MOVSI A,(POINT 7,0) ; Point
HRRI A,KEYWORD ; Save string here
MOVE B,CMABP ; Take it from here
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
ENDIF. ; We should now have the user's input
NOISE <IS>
;HERE WE ARE PARSING KEYWORDS, NUMBERS, OR CARRIAGE RETURN FOR SECOND FIELD
;OR LOOPING THROUGH TO PARSE KEYWORDS OR NUMBERS
SRPCH1: MOVEI A,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>,,[
FLDDB. .CMCFM,CM%SDH,,<Carriage return to delete an existing Characteristic name>,,]] ;[7.1099]
HRRM A,CBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,CBKFDB ; Get it into the correct AC
SKIPN CFMOK ; OK to confirm now?
IFNSK. ; No - ask for numbers or keywords
MOVEI A,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>]
HRRM A,CBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,CBKFDB ; Get it into the correct AC
ENDIF.
CALL FLDSKP ; Parse
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ;GET WHAT WAS TYPED
CAIN C,.CMCFM ; Carriage return?
IFNSK.
SKIPE DELFLG ; No input to second field, just CR?
JRST SPCDEL ; Yes, go delete this CHARACTERISTIC
JRST SRPCH2 ; Must be real end-of-command
ENDIF.
CAIN C,.CMKEY ; Keyword?
IFNSK. ; Yes.
MOVE A,B ; Save the address
CAMN A,KEYLOC ; Trying to define X as X? Silly.
IFNSK.
CONFIRM ; So get confirm, and
RET ; .... leave it alone
ENDIF.
CALL KBTMSK ; (A/ ) No, go set bit(s)
ELSE. ; Must've been a number
SKIPGE B ; Zero or more?
SKIPA ; No - error
CAILE B,CHRNUM
ERROR <Number must be in range 0-127> ; Nope, silly.
MOVE A,B ; Get number into AC1
CALL NBTMSK ; (A/ )Set the bit
ENDIF.
;AT THIS POINT THE USER MAY TYPE A COMMA SO THAT ADDITIONAL CHARACTERISTICS
;CAN BE INCLUDED IN THIS NEW CHARACTERISTIC, OR A CARRIAGE RETURN MAY BE
;TYPED TO END THE COMMAND AT THIS POINT
MOVEI B,[FLDDB. .CMCMA,,,,,[
FLDDB. .CMCFM]]
CALL FLDSKP
ERROR <Comma or confirmation required>
LOAD C,CM%FNC,.CMFNP(C) ;GET WHAT WAS TYPED
CAIN C,.CMCMA ; Comma? If so, more stuff to parse
IFNSK. ; Yes.
SETZM CFMOK ; Say "Not OK to confirm now"
JRST SRPCH1 ; Yes, continue parsing
ENDIF.
; JRST SRPCH2 ; We have a CR - go store the bit-mask
;HERE TO STORE THE COMPLETED BIT-MASK
SRPCH2: SKIPN KEYLOC ; [7.1118] New entry? Or already there?
IFNSK.
HLRZ A,@CHRTAB ; New. How many entries?
CAIGE A,CTBLEN ; [7.1073] More than allowed?
IFSKP. ; [7.1073] Yes.
CALL PION
ERROR <Table out of room> ; Sorry
ENDIF.
JRST NEWCHR ; Make new entry
ENDIF.
;HERE FOR RE-DEFINITION OF EXISTING ENTRY
HRRZ A,@KEYLOC ; Entry already there - get data address
HRRZ B,A ; Need it in RH for BLT
HRLI B,BTMSK1 ; Here's the bit-mask
BLT B,3(A) ; Store it in freespace
CALL PION
RET ; Done
;[7.1061]
;HERE TO CREATE A NEW CHARACTERISTIC
;WE FIRST GET FREESPACE TO STORE THE DATA, THEN BLT THE BIT-MASK FROM
;MEMORY LOCATIONS "BTMSK*" INTO FREESPACE.
;
;NEXT GET THE NAME FROM TRVAR "KEYWORD" AND STORE IT IN ASCIZ FORMAT.
;
;FINALLY,MAKE THE TBLUK TABLE ENTRY USING THE TWO FREESPACE ADDRESSES AT
;WHICH WE BEGAN STORING THE DATA.
NEWCHR: STKVAR <MSKLOC>
CALL PIOFF ; No interrupts
MOVEI A,CHARAC ; Get 7 words...
CALL GTBUFX ; (A/A) ...of permanent freespace
SKIPN A ; Wasn't enough?
IFNSK.
CALL PION ; You can interrupt me, now
ERROR <Cannot create new CHARACTERISTIC> ; Sorry
ENDIF.
MOVEM A,MSKLOC ; AC1 has address returned
HRRZ B,MSKLOC ; Destination beginning
HRLI B,BTMSK1 ; Source beginning
MOVE C,MSKLOC ; Destination end
BLT B,4(C) ; Move it
;BIT-MASK IS NOW STORED IN FREESPACE. STORE THE NEW CHARACTERISTIC NAME,
;OR ALIAS, IN THE NEXT THREE WORDS
MOVSI B,(POINT 7,0)
HRRI B,KEYWORD
MOVSI A,(POINT 7,0)
HRR A,MSKLOC ; Beginning of 7-word block
ADDI A,4 ; Store string 4 words into block
MOVE Q2,A ; Save this address
SETZ C, ; End on null byte
CALL ASOUT ; (A,B,C/A,B) Copy String
HRLZ B,Q2 ; Get address of name string
HRR B,MSKLOC ; Now address of mask into RH
HRRZ A,CHRTAB ; Here's where to find the table
TBADD
ERJMP BADADD ; Some problem
CALL PION
RET
BADADD: MOVEI A,CHARAC ; This many words
MOVE B,MSKLOC ; Here's the freespace
CALL RETBUF ; Give it back
CALL PION
ERROR <Could not add CHARACTERISTIC to table> ; Sorry
;[7.1061]
;HERE TO DELETE AN EXISTING ENTRY IN THE CHARACTERISTICS TABLE
SPCDEL: STKVAR <DELADR>
SETZM DELFLG ; Reset flag now
SKIPN KEYLOC ; Any address saved?
ERROR <No such CHARACTERISTIC> ; No - wasn't in table
HRRZ A,@KEYLOC ; RH of entry (beginning of 7-word data block)
MOVEM A,DELADR ; Save address for return of freespace
CALL PIOFF ; Yes, OK to delete
MOVE A,CHRTAB ; Table lives here
MOVE B,KEYLOC ; Entry to delete lives here
TBDEL ; Do it
ERJMP BADDEL ; Some problem - not expected
MOVEI A,CHARAC ; Return this many words
MOVE B,DELADR ; ...starting here
CALL RETBUF ; (A,B/) Return the freespace
CALL PION
RET
;HERE IF TBDEL FAILS, WHICH IS HIGHLY UNLIKELY
BADDEL: CALL PION
ERROR <Could not delete characteristic - %?> ; Tell last error
ENDSV.
ENDTV.
;[7.1068]
;HERE TO PARSE "SET REMOTE-PRINTING PRINTER"
;
; Dispatch here from $RMPRT table
;FIRST, SEE IF THE TABLE HAS BEEN SET UP IN FREESPACE YET.
;IF NOT, GET SOME FREESPACE FOR IT AND SET UP THE FIRST WORD
;WITH "LENGTH,,MAX SIZE OF TABLE"
SRPPTR::SKIPE PTRTAB ;Table set up yet?
IFSKP. ;No
CALL PIOFF ;Let's set one up
MOVEI A,CTBLEN ;This many words
CALL GTBUFX ;(A/A) Gimme - permanent freespace
SKIPE A ; No freespace?
IFSKP. ; Guess not
ETYPE <?Cannot set up REMOTE PRINTER table
>
CALL PION
RET
ENDIF.
MOVEM A,PTRTAB ; Got some - save address of table
HRRZI B,PTBLEN ; Make 0,,length in AC2
MOVEM B,@PTRTAB ; Store in 1st table word
CALL PION
ENDIF. ; OK - ready to proceed
;THE "EMPTY" TABLE HAS BEEN SET UP. NOW ADD THE TABLE ADDRESS INTO THE
;KEYWORD FDB WE ALREADY MADE IN EXECPR.MAC
MOVE A,PTRTAB ; Get the address
MOVEI B,PBKFDB
MOVEM A,.CMDAT(B) ; Plug it in
HRROI A,FDPHLP ; [7.1071] Now the help string *sigh*
MOVEM A,.CMHLP(B) ; Stuff it in
; Believe it or not, this works
;NOW BEGIN THE ACTUAL PARSING
TRVAR <<ALINAM,7>,ALILOC,<PTRNAM,7>,PTRLOC,<NODNAM,2>,FLDSZ1,FLDSZ2>
; NOTE: PT*KEY, PT*LOC, & NODNAM must
; be kept in order, and in the same
; order in ALL TRVARs which use them.
; Clear out some things
SETZM ALILOC ; Address of field 1 string (if in table)
SETZM PTRLOC ; Address of field 2 string (if in table)
SETZM NODNAM ; (You guessed it) Node name
SETZM FLDSZ1 ; Size of field 1 string
SETZM FLDSZ2 ; Size of field 2 string
NOISE <NAME> ; Guideword
;HERE WE ARE PARSING KEYWORDS, OR AN ARBITRARY FIELD (NEW PRINTER NAME)
MOVEI A,[FLDBK. .CMFLD,CM%BRK!CM%SDH,,<New remote printer name being created - 31 characters or less>,,[
BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_>]]
HRRM A,PBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,PBKFDB ; Get it into the correct AC
CALL FLDSKP ; Parse printer name
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ;GET WHAT WAS TYPED
CAIN C,.CMKEY ; Keyword?
IFNSK. ; Yes
MOVEM B,ALILOC ; Save address
MOVSI A,(POINT 7,0)
HRRI A,ALINAM ; Save keyword string here
MOVSI B,(POINT 7,0)
HLR B,@ALILOC ; Take from where stored
SETZ C, ; End on null byte
CALL ASOUT ; (A,B,C/A,B)Copy keyword
ELSE. ; Gotta be an arbitrary string
MOVE A,CMABP ; Point to user's input
ILDB B,A ; Get first character
CAILE B,"Z" ; Lowercase char?
SUBI B,40 ; Yes, uppercase-ize
CAIL B,"A" ; If not between "A"
CAILE B,"Z" ; and "Z", it's not a letter.
ERROR <Printer alias name must begin with alphabetic character>
MOVE A,CMABP ; point to ATMBUF
CALL BCOUNT ; (A/A,B)How many characters?
CAILE B,PTRCHR ; More than allowed?
ERROR <Too many characters in printer alias name>
MOVEM B,FLDSZ1 ; Save number of characters
;UPPERCASE HERE
MOVE A,CMABP ; Point to input
CALL UPRCAS ; (A/A) Make uppercase
SETZM ALILOC ; No table address (not in table yet)
MOVSI A,(POINT 7,0) ; Point
HRRI A,ALINAM ; Save string here
MOVE B, CMABP ; Take it from here
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
ENDIF. ; We should now have the user's input
NOISE <IS>
;HERE WE ARE PARSING KEYWORD, ARBITRARY FIELD, OR CARRIAGE RETURN FOR
;SECOND FIELD
MOVEI A,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to delete an existing Remote Printer name>,,[
FLDBK. .CMFLD,CM%BRK!CM%SDH,,<DQS Queue - 31 characters or less
or LAT Port/Service - 16 characters or less>,,[
BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_-.>]]] ;[7.1099][4402][****]
HRRM A,PBKFDB+.CMFNP ; Link in the Keyword FDB
MOVEI B,PBKFDB ; Get it into the correct AC
CALL FLDSKP ; Parse printer name
CMERRX
LOAD C,CM%FNC,.CMFNP(C) ;GET WHAT WAS TYPED
CAIN C,.CMCFM ; Carriage return?
JRST SRPDEL ; Yes, go delete this REMOTE-PRINTER
CAIE C,.CMKEY ; Keyword?
IFSKP. ; Yes.
MOVEM B,PTRLOC ; [7.1136] Save the address.
ELSE. ; Must've been arbitrary field
MOVE A,CMABP ; point to ATMBUF
CALL BCOUNT ; (A/A,B)How many characters?
CAILE B,PTRCHR ; More than allowed?
ERROR <Too many characters in DQS Queue, or LAT Port/Service name> ;[4409]
MOVEM B,FLDSZ2 ; Save number of characters
ENDIF.
;
;WHETHER WE HAVE KEYWORD OR ARBITRARY STRING, UPPERCASE IT, AND COPY INTO TRVAR
;
MOVE A,CMABP ; Point to input
CALL UPRCAS ; (A/A) Make uppercase
MOVSI A,(POINT 7,0) ; Point
HRRI A,PTRNAM ; Save string here
MOVE B,CMABP ; Take it from here
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
NOISE <ON>
;
;INPUT TO FIELDS ONE AND TWO ARE NOW SAVED, PROCEED TO PARSE THIRD FIELD
;
;IF LAST FIELD WAS AN ARBITRARY FIELD, THIS FIELD HAD BETTER BE A NODENAME
;
SKIPN PTRLOC ; Was last field a keyword?
IFSKP. ; Yes
MOVE Q3,[ASCIZ /LAT/] ;[4402] Set flag in Q3
WORDX <Node name, LAT Server name, or confirm with carriage return> ;[4402]
CMERRX ;[4417]Handle the error return
ELSE.
MOVE Q3,[ASCIZ /LAT/] ;[4402] Set flag in Q3
WORDX <Node name or LAT Server name> ;[4402]
CMERRX <Node name or LAT Server name required> ;[7.1071]
ENDIF. ; So we have to get a node name
;[4402] Check node/LAT Server name length
MOVE A,CMABP ;[4402] Point to input
CALL BCOUNT ;[4402] (A/A,B) How many characters?
CAILE B,NODSIZ ;[4402] More than allowed in node name (6)?
IFSKP. ;[4417]No
IFE. B ;[4417]No, but
SKIPN PTRLOC ;[4417]Was last field a keyword?
ERROR <Missing node name in SET REMOTE-PRINTER command> ;[4417]No
JRST RPPEND ;[4417]Yes, try confirm
ENDIF.
ELSE.
ERROR <Too many characters in node or LAT Server name> ;[4402]
ENDIF.
;UPPERCASE THE NODE NAME
MOVE A,CMABP ; Point to input
CALL UPRCAS ; (A/A) Make uppercase
;NOW SAVE IT AWAY
MOVSI A,(POINT 7,0) ; Point
HRRI A,NODNAM ; Save string here
MOVE B,CMABP ; Take it from here
SETZ C, ; End on null
CALL ASOUT ; (A,B,C/A,B)Copy string
; JRST RPPEND
;WE NOW HAVE THE INPUT TO ALL FIELDS SAVED IN TRVARs, SO CONFIRM AND
;PROCESS THE COMMAND.
;HERE FOR CONFIRM
RPPEND: CONFIRM ; That's all you can do
JRST DOSRPP ; Now process the command
;[7.1068]
;HERE TO PROCESS THE SET REMOTE-PRINTING PRINTER COMMAND
;KEYWORD AND ADDRESSES, ARBITRARY FIELD AND SIZE, AND NODENAME ARE ALL
;IN TRVARS WHICH WERE CREATED IN SRPPTR: .
;
; ALINAM,ALILOC - Alias name from field 1 of command; table address if
; name is in table, zero if new name being created
;
; PTRNAM,PTRLOC - Printer (or alias) name from field 2 of command;
; table address if name is in table, zero if new
; name being created
;
; NODNAM - Nodename, or zero if no nodename given
;
; FLDSZ1 - Number of characters in arbitrary field from field 1 of command
;
; FLDSZ2 - Number of characters in arbitrary field from field 2 of command
;
;
;COME HERE FROM SRPPTR
;
DOSRPP: SKIPE NODNAM ; Do we have a nodename?
JRST SRPNOD ; Yes, process
MOVE A,ALILOC ;[7.1136] Get address of field 1
CAMN A,PTRLOC ;[7.1136] Same as field 2? (setting it to itself?)
RET ;[7.1136] Yes. Leave it alone and go away quietly
STKVAR <ALILEN,TMPLC1,TMPLC2,BLKSIZ,ALIAD,PNTRAD,DLNTRY,OLDDAT> ;[7.1071]
SETZM DLNTRY ; [7.1071]
SKIPN ALILOC ; Field 1 string already in table?
IFSKP. ; Yes.
HRRZ C,@ALILOC ; [7.1071] Address of data word
SKIPE C ; [7.1071] If zero, this is a deleted entry
IFSKP. ; [7.1071] Deleted.
SETOM DLNTRY ; [7.1071] Indicate field 1 was a deleted entry
JRST DLORPP ; [7.1071]
ENDIF.
HLRZ D,(C) ; Does this alias point to phys printer? (LH not= 0)
SKIPN D ; Well?
IFSKP. ; Yes
DLORPP: MOVE A,@ALILOC ; [7.1073] Get table data
MOVEM A,OLDDAT ; [7.1071] ...and save it
CALL PIOFF
HLRZ D,@ALILOC ; [7.1071] Get string addr someplace safe
HRRZ A,PTRTAB ; Table addr
HRRZ B,ALILOC ; This entry
TBDEL ; Delete now, release freespace later
ERJMP BADPDL
MOVEM C,TMPLC2 ; Save AC3 - TBLUK stomps on it
MOVE A,PTRTAB ; Now we have to find out where field 2 is
MOVSI B,(POINT 7,0) ; Cuz TBDEL'ing will have re-ordered the table
HRRI B,PTRNAM ; Point to Field 2 string
TBLUK ; Where?
ERJMP BADLUK
MOVEM A,PTRLOC ; Here.
MOVE C,TMPLC2 ; Restore AC3
;WE'VE DELETED THE OLD ENTRY, AND LOOKED-UP THE LOCATION OF THE NEW
;SO IT'S SAFE TO RELEASE THE OLD FREESPACE DATA
MOVSI A,(POINT 7,0)
HRR A,D ; [7.1071] Point to string
MOVEM C,TMPLC1 ; Save these - BCOUNT gorches 'em
MOVEM D,TMPLC2
CALL BCOUNT ; What size is the string only?
MOVEM B,ALILEN ; Save for later
MOVE C,TMPLC1 ; Restore
MOVE D,TMPLC2
;RELEASE THE FREESPACE FOR THE STRING
HRR B,D ; [7.1071] String addr into AC2
SOS B ; Decrement to block size
MOVE A,(B) ; Get the size
CALL RETBUF ; (A,B/ ) Return the string block
SKIPN DLNTRY ; [7.1071] Was this entry deleted?
IFSKP. ; [7.1071] Yes.
CALL PION
JRST ALDEF ; [7.1071] So we have TBDEL'd and released freespace
ENDIF. ; [7.1071] ...proceed as if this was a new entry
;THIS HAD BEEN A PHYSICAL PRINTER ENTRY, SO RELEASE THE BLOCK FOR THAT DATA
HRRZ B,OLDDAT ; [7.1073] Get addr of data
SOS B ; Back up to block size
MOVE A,(B) ; Get size in AC1
CALL RETBUF ; (A,B/ )Return it
CALL PION
JRST ALDEF ; Now proceed as if new alias for existing entry
ENDIF. ; This alias points to another alias
CALL PIOFF
HLRZ A,@PTRLOC ; Field string 2 already in table (or COMND% would've barfed)
HRRZ B,@ALILOC ; So get pointer to data
MOVEM A,(B) ; Over-write old data (pointer to other alias)
CALL PION
RET
ENDIF.
;THIS CREATES A NEW ALIAS FOR AN EXISTING ENTRY. (FIELD 1 STRING NOT IN TABLE)
ALDEF: HLRZ A,@PTRTAB ; See if enough room in table
CAIL A,PTBLEN ; [7.1073]Well?
ERROR <Table out of room> ; Sorry
MOVE A,FLDSZ1 ; Try here for size - assume not in table
SKIPN A ; Re-defining something already in table?
MOVE A,ALILEN ; Not in table yet, so size is here
IDIVI A,5 ; How many words?
SKIPE B ; Any partial word needed?
AOS A ; Yes, add one
ADDI A,3 ; [7.1073] ...3 more for block size,addr of old
; ... alias, and null
CALL PIOFF
CALL STORAL ; (A/ ) Store alias name
ERROR <Could not store new REMOTE-PRINTER data>
MOVEM A,ALIAD ; Remember where alias stored
MOVEM B,PNTRAD ; ....and pointer to existing alias
HRRZ A,PTRTAB ; Address of table
HRL B,ALIAD ; Address of new alias
HRR B,PNTRAD ; Address of pointer to old string
TBADD
ERJMP BADADA
CALL PION
RET ; Done
BADADA: MOVE B,@ALIAD ; Address of new alias string
SOJ B, ; Decrement to top of block
MOVE A,(B) ; Size lives here
CALL RETBUF ; (A,B/ ) Return the freespace
CALL PION
ERROR <Could not add new Printer alias to table - %?> ; Sorry
;HERE WHEN TBDEL HAS OCCURRED ON THE OLD ENTRY, AND WE NEED TO FIND WHERE
;THE ALIAS WE NOW WANT TO POINT AT LIVES. HOWEVER, THE TBLUK TO FIND THE
;SUCKER HAS FAILED. TRY TO TBADD THE OLD ENTRY BACK.
;WE ARE PIOFF ON ENTRY TO EITHER OF THESE ROUTINES
BADLUK: MOVE A,PTRTAB ; Table addr
MOVE B,DLNTRY ; Old entry
TBADD
ERJMP TBOHNO ; Weird - this shouldn't fail
CALL PION
ETYPE <?Unexpected error in making new entry. Previous data restored - %?
>
RET
;COULDN'T TBADD THE OLD ENTRY BACK. DEEP-6 THE OLD FREESPACE DATA AND TELL
;THE USER THERE'S A PROBLEM
TBOHNO: MOVSI A,(POINT 7,0)
HLR A,@ALILOC ; Point to string
MOVEM C,TMPLC1 ; Save these - BCOUNT gorches 'em
MOVEM D,TMPLC2
CALL BCOUNT ; What size is the string only?
MOVEM B,ALILEN ; Save for later
MOVE C,TMPLC1 ; Restore
MOVE D,TMPLC2
SOS B,C ; Decrement to address of block length
MOVE A,(C) ; Get block size into AC1
CALL RETBUF ; (A,B/ )Return the block
HLRZ B,@ALILOC ; Get address of string
SOS B ; Back up to block size
MOVE A,(B) ; Get size in AC1
CALL RETBUF ; (A,B/ ) Return the freespace
CALL PION
ETYPE <?Unexpected error. Could not make new entry, nor restore previous - %?
>
RET
BADPDL: CALL PION
ETYPE <?Unexpected error in changing table entry - %?>
RET
;[7.1068]
;HERE IF NODENAME TYPED
SRPNOD: STKVAR <BLKSIZ,ALIAD,PPRINT,TMPLOC>
SETZM TMPLOC ; Clear temp holder for table data
SKIPE ALILOC ; Alias name already in table?
IFSKP.
HLRZ A, @PTRTAB ; New name. Have room in table?
CAILE A,PTBLEN ; Well?
ERROR <Table out of room> ; Sorry
ENDIF.
;
;IF THIS IS A NEW ENTRY, WE HAVE ROOM FOR IT IN THE TABLE. THIS MAY ALSO
;BE A REDEFINITION OF AN EXISTING ALIAS. IN ANY CASE, STORE THE PHYSICAL
;PRINTER DATA IN FREESPACE FIRST
;
;FOR REDEFINITIONS -
;IF THIS ALIAS *WAS* POINTING TO A PHYSICAL PRINTER, ALL WE NEED DO
;IS CHANGE THE DATA ADDRESS OF THE TABLE ENTRY TO POINT TO THE NEW QUEUE/
;NODENAME BLOCK. IF, HOWEVER, THIS ALIAS USED TO POINT TO ANOTHER ALIAS,
;AND NOW POINTS TO A PHYSICAL PRINTER, WE NEED TO GET RID OF ALL THE OLD
;DATA, BECAUSE THE BLOCK FORMAT(S) WILL BE DIFFERENT. THEN, WE WILL
;TBADD THE ENTRY AS IF IT WERE ENTIRELY NEW.
CALL PIOFF
CALL PHYPRT ; ( /A) Store "physical printer" data in freespace
MOVEM A,PPRINT ; And save where we put it
SKIPN ALILOC ; New entry? Or re-definition?
IFSKP. ; Re-definition.
HRRZ B,@ALILOC ; Address of "old" data word
SKIPN B ; Is this deleted?
JRST ALIAS ; Yes. Proceed to process as new entry
HLRZ C,(B) ; Was this pointing to an alias? (LH=0)
SKIPN C ; Well?
IFSKP. ; No, physical printer - so the block format stays the same
HRRZ B,@ALILOC ; Find old physical printer data
SOS B ; Block size here
MOVE A,(B) ; Get it into AC1
CALL RETBUF ; Return the old space
MOVE A,PPRINT ; Address of new pointers
HRRM A,@ALILOC ; We just store new address in table.
RET ; And done
ENDIF. ; This WAS pointing to another alias and is NOW
ENDIF. ; ...going to point to a physical printer, so the
; ...block format changes
;
;WE NOW HAVE THE "PHYSICAL PRINTER" (NAME, NODENAME) SAVED, SAVE THE ALIAS
;
ALIAS: MOVE B,FLDSZ1 ; Size of alias name
SKIPE B ; No size? This is already in table, then.
IFSKP. ; And had been pointing to another alias
MOVSI A,(POINT 7,0) ; Point
HLR A,@ALILOC ; To the string
CALL BCOUNT ; How long?
ENDIF.
IDIVI B,5 ; How many words do we need for this block?
SKIPLE B ; Less than 5 chars?
SKIPE C ; Or need a partial word?
AOS B ; Yes, add one to number of words
ADDI B,2 ; [7.1073] Add one for block size and one for null
MOVE A,B ; [7.1073] Now put in AC1
CALL STORAL ; (A/ )Store alias name in freespace
IFNSK.
MOVE B,PPRINT ; Address of pointers
SOS B ; Decrement to top of block
MOVE A,B ; Size lives here
CALL RETBUF ; (A,B/ ) Return the freespace we got before
CALL PION ; You can interrupt me, now
ERROR <Could not store new printer data>
ENDIF.
MOVEM A,ALIAD ; Remember where alias stored
;FIRST, TBDEL THE ENTRY JUST IN CASE THE TBADD FAILS
;NEXT, TRY THE TBADD WITH THE NEW DATA. IF IT FAILS, TRY TO RESTORE THE OLD DATA
;THEN, RETURN FREESPACE FOR "OLD" PHYSICAL PRINTER DATA
;IF TBADD'S FOR BOTH NEW AND OLD DATA FAIL, THIS USER IS A BIG LOSER
;
SKIPN ALILOC ; Well, IS there anything to delete?
IFSKP. ; Yes, do it now
MOVE D,@ALILOC ; So save the actual data in case we need it
MOVEM D,TMPLOC ; ....and have to restore it later
HRRZ A,PTRTAB ; Table addr
HRRZ B,ALILOC ; This entry
TBDEL ; Wipe it out
ERJMP BADADL ; Couldn't. How strange.
ENDIF.
;
;TRY TO MAKE THE NEW TABLE ENTRY
;
HRRZ A,PTRTAB ; Address of table
HRLZ B,ALIAD ; Address of alias
HRR B,PPRINT ; Address of physical printer (name, nodename)
TBADD
ERJMP TRYOLD ; Uh-oh. See if we can put the old stuff back
; Success. New table entry is now in place
;Save addr of alias in PTRTAB in case it is the alias is the default queue
;name.
HRLM A,DEFADR ;[4417]Save alias addr in left half BUT
; remember to clear it after we check to see
; if we are changing the default printer.
;Since the table just got updated we better check to see if the address of
;the default printer is still pointing at the correct alias.
CALL UPDFPR ;[4417]Check to see if we have to update
;default printer alias
AOS DEFADR ;[4417]Entry comes before default printer
SKIPN TMPLOC ; Was there "old" data?
IFSKP. ; Yes, wipe it out
HRRZ B,TMPLOC ; Address of data word
SUBI B,2 ; So decrement to loc holding block size
MOVE A,(B) ; And get block size
CALL RETBUF ; (A,B/ )Return the freespace
ENDIF. ;
SKIPN DEFQUE ;[4417]Do we have default to just queue name
IFSKP. ;[4417]yes
MOVE A,ALIAD ;[4417]Get alias
HRLI A,(POINT 7,0) ;[4417]pointer to alias
MOVE B,[POINT 7,DEFQUE] ;[4417]pointer to default just queue name
CALL RPEQUE ;[4417](A,B/)Check to see if they are the same
ENDIF. ;[4417]
HRRZS DEFADR ;[4417]Clear the left half of default printer
; address
CALL PION
RET ; There wasn't any old data, so..Done
;RPEQUE - Check to see whether the alias in remote printer is a default queue
;name. If so, change the default printer to what the alias is pointing to and
;tell the user. If not the caller of RPEQUE should clear the left half of
;DEFADR.
;ACCEPTS A/POINTER OF ASCIZ STRING
; B/POINTER OF ASCIZ STRING
;RETURNS +1 ALWAYS
RPEQUE: CALL MATCH ;[4417]Do they match?
RET ;[4417]No
HLRZ B,DEFADR ;[4417]Get addr of alias
CALL RESLV1 ;[4417](B/B)Resolve alias
HLRZS B,DEFADR ;[4417]Save the new addr
HLRZ A,(B) ;[jw[Get address of alias string
MOVSI B,(POINT 7,0) ;[4417]Pointer
HRR B,A ;[4417]Take it from here
MOVSI A,(POINT 7,0) ;[4417]Pointer
HRRI A,DEFREM ;[4417]Save input arg from SET DEF /REMOTE
SETZ C, ;[4417]End on null
CALL ASOUT ;[4417](A,B,C/A,B)Copy string
HRROI A,DEFREM ;[4417]Get default remote printer name
HRROI B,RPQUE ;[4417]Get default Que/Port/Service name
MOVE C,RPNODE ;[4417]Get default node name
ETYPE <Default printer is %1M --- %2M on node %3' %_>
SETONE PR%RDF,PRIFLG ;[4417]Default /REMOTE takes precedent
SETZRO PR%DDF,PRIFLG ;[4417]Default /DESTINATION take a back seat
SETZRO PR%LFT,PRIFLG ;[4417]Clear the left half
RET ;[4417]
;Match two ASICZ strings
;Returns +1 on no match
; +2 on match
MATCH: ILDB C,A ;[4417]Get a byte
ILDB D,B ;[4417]Get a byte
CAILE C,"Z" ;[4417]Lower case?
SUBI C,40 ;[4417]Make it uppercase
CAILE D,"Z" ;[4417]Lower case?
SUBI D,40 ;[4417]Make it uppercase
CAME C,D ;[4417]Are they the same?
RET ;[4417]No, all done
JUMPN C,MATCH ;[4417]If nul then we have a match
RETSKP ;[4417]
;UPDFPR - Since routine ALIAS: or SRPDEL just modified PTRTAB, DEFADR might
;be off be one. Check to see if the new entry is alphabetically before the
;default alias. If so, ALIAS: should add 1 to DEFADR and SRPDEL: should
;subtract 1 to DEFADR.
;Accepts DEFADR/addr of entry in question (add/delete),,addr of default printer
;entry
;Returns +1/if entry comes alphabetically before default printer
; +2/If entry doesn't comes alphabetically before default printer
UPDFPR: HRRZ A,DEFADR ;[4417]Get the address of default printer
JUMPE A,RSKP ;[4417]No address, no default printer
HLRZ B,DEFADR ;[4417]Get the address of entry
CAMLE B,A ;[4417]Entry comes before default printer
RETSKP ;[4417]Yes
RET ;[4417]No,
;ERROR ROUTINES FOR TBADD AND TBDEL FAILURES
;THESE ROUTINES ASSUME: CALLED FROM SRPNOD, AND CALLED PIOFF
;HERE FOR GARDEN-VARIETY FAILURE TO MAKE NEW ENTRY
BADADP: MOVE B,PPRINT ; Address of pointers
SOS B ; Decrement to top of block
MOVE A,(B) ; Size lives here
CALL RETBUF ; (A,B/ ) Return the freespace
MOVE B,ALIAD ; Address of alias
SOS B
MOVE A,(B) ; Get size
CALL RETBUF ; (A,B/ ) Return the freespace
CALL PION
ERROR <Could not add REMOTE PRINTER to table - %?> ; Sorry
;HERE IF DELETION OF OLD ALIAS FAILS
BADADL: MOVE B,PPRINT ; Address of pointers
SOS B ; Decrement to top of block
MOVE A,(B) ; Size lives here
CALL RETBUF ; (A,B/ ) Return the freespace
MOVE B,ALIAD ; Address of alias
SOS B
MOVE A,(B) ; Get size
CALL RETBUF ; (A,B/ ) Return the freespace
ETYPE <?Could not change entry - %?>
CALL PION
RET
;HERE IF OLD ENTRY DELETED, BUT TBADD FAILED ON NEW ONE
TRYOLD: SKIPN TMPLOC ; Was there any old data?
JRST BADADP ; No, so we can't restore anything. Just bomb out.
HRRZ A,PTRTAB ; Address of table
MOVE B,TMPLOC ; Old data - addr of string,,addr of data
TBADD
ERJMP BADOLD
CALL PION
RET
;WELL, ISN'T THIS A MESS. THE OLD ENTRY IS DELETED, TBADD FOR THE NEW ENTRY
;FAILED, AND TRYING TO TBADD BACK THE OLD STUFF FAILED, TOO.
;JUST RELEASE THE "OLD" DATA AND THE "NEW" DATA AND TELL THE USER THE BAD NEWS
BADOLD: MOVE B,PPRINT ; Address of pointers
SOS B ; Decrement to top of block
MOVE A,(B) ; Size lives here
CALL RETBUF ; (A,B/ ) Return the freespace
MOVE B,ALIAD ; Address of alias
SOS B
MOVE A,(B) ; Get size
CALL RETBUF ; (A,B/ ) Return the freespace
;NOW RELEASE THE OLD DATA, IT'S USELESS ANYWAY
HRRZ B,@TMPLOC ; Address of data word
SUBI B,2 ; So decrement to loc holding block size
MOVE A,(B) ; And get block size
CALL RETBUF ; (A,B/ )Return the freespace
ETYPE <?Fatal error encountered. State of REMOTE-PRINTER data is indeterminate
%?>
CALL PION
RET
ENDSV.
;[7.1068]
;HERE TO STORE AN ALIAS NAME IN FREESPACE.
;THIS WILL ACCEPT BLOCK SIZE NEEDED FROM THE CALLER, GET THAT MANY WORDS
;FROM THE FREESPACE HANDLER, AND STORE THE ALIAS NAME AND ANY ASSOCIATED
;POINTERS (ADDRESSES).
;
; A/ NUMBER OF WORDS OF FREESPACE NEEDED
;
; CALL STORAL
;
; RETURNS +1 ON FAILURE
; RETURNS +2 ON SUCCESS: ADDRESS OF STORED ALIAS IN AC1
; ADDRESS OF STORED POINTER (IF ANY) IN AC2
;
STORAL: STKVAR <BLSIZ,ALADD>
MOVEM A,BLSIZ ; Save the number of words wanted
CALL GTBUFX ; (A/A) Get permanent freespace
SKIPN A ; Wasn't enough?
RET ;
MOVEM A,ALADD ; Save the address
CALL PIOFF
MOVE A,BLSIZ ; Get the block size
MOVEM A,@ALADD ; Stuff into first word
AOS ALADD ; Now increment to where name will live
MOVE D,ALADD ; Save current address
MOVSI B,(POINT 7,0) ; Source
HRRI B,ALINAM ; Field 1 - the new alias name
MOVSI A,(POINT 7,0)
HRR A,ALADD ; Where to store it
SETZ C, ; End on null byte
CALL ASOUT ; (A,B,C/A,B) Copy String
IDPB C,A ; [7.1073] Tie off with null
SKIPN NODNAM ; Defining physical printer?
IFSKP. ; Yes, so no pointer stored with alias
MOVE A,ALADD ; Get back address where alias stored
SETZM B ; Indicate no additional pointer word
CALL PION
RETSKP
ENDIF. ; Not physical printer - make pointer to existing alias
AOS D ; Store some data in next word - get addr in AC4
HLRZ B,@PTRLOC ; of table entry for field 2
MOVEM B,(D) ; Store 0,,addr of old alias
MOVE A,ALADD ; Tell caller where alias stored
MOVE B,D ; ....and where pointer to existing alias is
CALL PION
RETSKP ;
ENDSV.
;[7.1068]
;HERE TO STORE THE PHYSICAL PRINTER DATA
;THIS ROUTINE GETS FREESPACE FOR THE PHYSICAL PRINTER/NODENAME STORAGE
;ALSO A WORD AT THE TOP OF THE BLOCK TO HOLD BLOCK SIZE, AND A WORD
;TO HOLD THE ADDRESSES OF THE PRINTER NAME AND NODE NAME. THE TABLE ENTRY
;RIGHT HALF POINTS TO THIS LATTER WORD.
;
;RETURNS +1 ALWAYS, UNLESS AN ERROR CONDITION IS ENCOUNTERED, IN WHICH
;CASE, THE USER IS RETURNED TO EXEC PROMPT LEVEL.
;
; CALL PHYPRT
PHYPRT: STKVAR <BLOKSZ,PTRWRD,PNTRZ>
MOVE A,FLDSZ2 ; Size of Printer name
IDIVI A,5 ; How many words?
SKIPG A ; Less than 5 chars in string?
AOS A ; Yes, so add 1 to number of words
AOS A ; Add one for final null
ADDI A,4 ; Plus 2 words for node name and ...
; ...another 2 for pointers and block size
MOVEM A,BLOKSZ ; Save the number
CALL PIOFF
CALL GTBUFX ; (A/A) Get permanent freespace
SKIPE A ; Wasn't enough?
IFSKP.
CALL PION ; Guess not
ERROR <Cannot store new REMOTE PRINTER data> ; Sorry
ENDIF.
MOVEM A,PTRWRD ; Save the address
MOVE A,BLOKSZ
MOVEM A,@PTRWRD ; Stuff the size in the first word
MOVE B,PTRWRD
AOS B ; Increment the address and put in AC2
MOVEM B,PNTRZ ; Store - this loc holds the pointers
AOS D,B ; Increment again - point to printer name spot
MOVSI B,(POINT 7,0) ; Source
HRRI B,PTRNAM ; Field 2 - the printer name
MOVSI A,(POINT 7,0)
HRR A,D ; Where to store printer name
HRLZM A,@PNTRZ ; Put the address in the pointer word
SETZ C, ; End on null byte
CALL ASOUT ; (A,B,C/A,B) Copy String
IDPB C,A ; Tie off with null
AOS A ; Start nodename in next word
HRRM A,@PNTRZ ; Put nodename address in pointer word
HRLI A,(POINT 7,0) ; Make pointer to next full word
MOVSI B,(POINT 7,0) ; Now make source pointer
HRRI B,NODNAM ; Now copy nodename
SETZ C, ; Using updated pointer for destination
CALL ASOUT ; (A,B,C/A,B)
CALL PION
MOVE A,PNTRZ ; Pass the address back
RET
ENDSV.
;[7.1068]
;HERE TO DELETE AN ENTRY IN THE TABLE
SRPDEL: STKVAR <COMPAD,COUNTP> ; To hold string addr for compare and
; Counter for number of pointers to this alias
SETZM COUNTP ; Prevent strays in our count
SKIPE ALILOC ; Is it in the table?
IFSKP. ;
ETYPE <?No such REMOTE-PRINTER
> ; No, silly.
RET
ENDIF.
CALL PIOFF ; No interrupts
HLRZ A,@ALILOC ; Get the address of the data for this string
MOVEM A,COMPAD ; Save it to compare - see if anybody else points to it
MOVE A,PTRTAB ; Table address
SRPDL1: AOS A ; Step
HLRZ B,(A) ; Get address of string
JUMPE B,SRPDL2 ; When we hit a zero, end of table
HRRZ B,(A) ; Get address of data
SKIPN B ; Already zero?
JRST SRPDL1 ; Yes, no data to find here. Move along.
HLRZ C,(B) ; Get LH of data word
JUMPN C,SRPDL1 ; If not zero, this isn't an alias, so keep going
HRRZ C,(B) ; LH=0. This is an alias. Points to whom?
CAMN C,COMPAD ; Is it me?
AOS COUNTP ; Yes, somebody pointing here
JRST SRPDL1 ; No, keep looking
SRPDL2: SKIPN COUNTP ; Anybody pointing to me?
IFSKP. ; Yes, release my data if I'm a physical printer
HRRZ A,@ALILOC ; Data address for this entry
SKIPE A ; Already zero?
IFSKP.
CALL PION
ERROR <There are aliases pointing to this deleted entry> ;Yes, nothing more to do
ENDIF.
ETYPE <%%There are aliases pointing to this entry
> ; Give 'em a warning
HRRZ B,@ALILOC ; .."physical printer"
HLRZ C,(B) ; Was I a "p.p"?
SKIPN C ; Well?
JRST SRPDL3 ; No
;SOMEBODY WAS POINTING TO THIS ENTRY, SO WE DON'T TBDEL - WE JUST RELEASE
;ANY PHYSICAL PRINTER INFO (THE RH OF THIS ENTRY WILL BECOME 0 ANYWAY)
SOS B ; Yes, so release my "p.p" data - starting here
MOVE A,(B) ; Block size
CALL RETBUF ; (A,B/ ) Give back the freespace
JRST SRPDL3
ENDIF.
;NOBODY WAS POINTING TO THIS ENTRY - GO AHEAD AND WIPE IT OUT
HRRZ A,PTRTAB ; Table addr
HRRZ B,ALILOC ; This entry
TBDEL ; Wipe it out
IFJER.
CALL PION
ETYPE <Could not delete REMOTE-PRINTER - %?
> ; Failed - this is unlikely
RET
ENDIF.
CAME B,DEFADR ;[4417]Did we just deleted our default printer
IFSKP. ;[4417]Yes,
CALL SRPDL4 ;[4417]Tell the user
ELSE. ;[4417]No
HRLM B,DEFADR ;[4417]Setup DEFADR for UPDFPR
CALL UPDFPR ;[4417]See if we have to adjust the entry in
;[4417] PTRTAB so that the default printer is
;[4417] still pointing at the right entry
SOS DEFADR ;[4417]Adjust the pointer
HRRZS DEFADR ;[4417]Clear the left half
ENDIF.
CALL PION ;[4417]
RET
;HERE WHEN SOMEBODY WAS POINTING TO THE ENTRY TO DELETE
SRPDL3: SETZ A, ; Get a zero
HRRM A,@ALILOC ; Put in RH of table entry for this string
MOVE A,DEFADR ;[4417]Get default printer addr
CAMN A,ALILOC ;[4417]Are we deleting it
CALL SRPDL4 ;[4417]Yes,
CALL PION
RET ; Done
ENDSV.
ENDTV.
SRPDL4: HRROI A,DEFREM ;[4417]Get default remote printer name
ETYPE <Default printer %1M no longer applies to the PRINT command>
SETZM DEFADR ;[4417]Clear default addr
SETZM DEFQUE ;[4417]Clear just queue name
SETZM DEFREM ;[4417]Clear default alias name
SETZRO PR%RDF,PRIFLG ;[4417]Clear default /REMOTE seen
SKIPE DEFDST ;[4417]Any default /DEST
SETONE PR%DDF,PRIFLG ;[4417]Yes,
RET ;[4417]
$ESET: TABLE
T CLUSTER-INFORMATION,ONEWRD,SETINF ;[7.1076] ^ESET CLUSTER-INFO
T CLUSTER-SENDALLS,ONEWRD,SETTMG ;[7.1076] ^ESET CLUSTER-SENDs
T DATE-AND-TIME,,SETTAD ;^ESET SYSTEM DATE-AND-TIME
T FAST-LOGINS-ALLOWED,ONEWRD,SETFST ;^ESET FAST-LOGINS-ALLOWED
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 MINIMUM-PASSWORD-LENGTH,,SETMPL ;[7.1231] ^ESET MINIMUM-PASSWORD-LENGTH
T NO,NOLG,ESETNO ;^ESET NO
T OFFLINE-STRUCTURES,,ENAOFS ;[7.1063] ^ESET OFFLINE-STRUCTURES
T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR ;^ESET OPERATOR
T PASSWORD-DICTIONARY,ONEWRD,SETPWD ;[4416] ^ESET Password dictionary
T PASSWORD-EXPIRATION,,STPEXP ;[4412] ^ESET PASS-EXP
T PRIVATE-QUASAR,,.GDEBG ;^ESET PRIVATE-QUASAR
T RUN-TIME-GUARANTEE,,.JRUNG ;^ESET JOB RUN-TIME
T SYSTEM-ACCESS-CONTROL-JOB,,SETACJ ;[4412] ^ESET SYSTEM-ACJ
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 CLUSTER-INFORMATION,ONEWRD,SETINF ;[7.1076] ^ESET NO CLUSTER-INFO
T CLUSTER-SENDALLS,ONEWRD,SETTMG ;[7.1076] ^ESET NO CLUSTER-SENDs
T FAST-LOGINS-ALLOWED,ONEWRD,SETFST ;^ESET FAST-LOGINS-ALLOWED
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 MINIMUM-PASSWORD-LENGTH,ONEWRD,DISMPL ;[7.1231] ^ESET NO MINIMUM-PASSWORD-LENGTH
T OFFLINE-STRUCTURES,ONEWRD,DISOFS ;[7.1063] ^ESET NO OFFLINE-STRUCTURES
T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR ;^ESET NO OPERATOR
T PASSWORD-DICTIONARY,ONEWRD,SETPWD ;[4416] ^ESET Password Dictionary
T PASSWORD-EXPIRATION,ONEWRD,DISEXP ;[4412] ^ESET NO PASS-EXP
T PRIVATE-QUASAR,,.GDEBG ;^ESET NO PRIVATE-QUASAR
T RUN-TIME-GUARANTEE,,.JRUNG ;^ESET NO RUN-TIME
T WORKING-SET-PRELOADING,ONEWRD,SETWSP ;^ESET NO WORKING-SET-PRELOADING
TEND
;"^ESET TERMINAL (NUMBER)"
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]
;"^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
T LAT-TERMINALS,ONEWRD,.LTTTY ;[3041][7.1091]
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
CALL .MCTTY
CALL .LTTTY ;[7.1091
; 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
.LTTTY: MOVEI A,.SFLAT ;[3041][7.1091] LAT terminals
JRST DOSTTY ;[3041]Do SMON
.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
;[7.1231] ^ESET MINIMUM-PASSWORD-LENGTH character-count
SETMPL: STKVAR <MINLEN> ;Place to save parsed number
MOVEI B,[FLDDB. .CMNUX,<CM%SDH>,^D10,<minimum number of characters a password must be>] ;Get a number
CALL FLDSKP ;(A,B/) Get length
CMERRX ;User made a mistake
CAIL B,1 ;Is it at least this?
CAILE B,^D39 ;But not more than this?
JRST SETMP1 ;It's bad, say error
MOVEM B,MINLEN ;Save for now
CONFIRM ;Tie off the input
MOVEI A,.SFMPL ;Say setting min password length
MOVE B,MINLEN ;Get count
SMON% ;Set it
ERJMP CJERRE ;Report any failure
RET ;And done
SETMP1: ERROR <Must be between 1 and 39>
RET
ENDSV.
;[4412] ^ESET SYSTEM-ACJ gets here
SETACJ: CONFIRM ;Parse a CRLF
MOVEI A,.SFACJ ;Get function
SETZ B, ;Say we want to enable
SMON% ;Try it
ERJMP CJERRE ;Couldn't do it, tell user why
RET ;Done, back to command level
;[4412] ^ESET PASS-EXP does work here
STPEXP: STKVAR <EXPDAY> ;Place to save parsed number
MOVEI B,[FLDDB. .CMNUX,<CM%SDH>,^D10,<number of days a password remains valid>] ;Get a number
CALL FLDSKP ;(A,B/) Get days
CMERRX ;User made a mistake
CAIL B,1 ;Is it at least this?
CAILE B,^D366 ;But not more than this?
JRST STPXP1 ;It's bad, say error
MOVEM B,EXPDAY ;Save for now
CONFIRM ;Tie off the input
MOVEI A,.SFPEX ;Say setting min password length
MOVE B,EXPDAY ;Get count
SMON% ;Set it
ERJMP CJERRE ;Report any failure
RET ;And done
STPXP1: ERROR <Must be between 1 and 366 days>
RET
ENDSV.
;^ESET NO PASS-EXP
DISEXP: MOVEI A,.SFPEX ;Get function
JRST SETMSS ;And disable it
;[7.1063]"^ESET OFFLINE STRUCTURES mm:ss"
ENAOFS: STKVAR <MINUTE,SECOND> ;Reserve some storage
NOISE <timeout interval> ;Some guide words
MOVEI B,[FLDDB. .CMCFM,<CM%SDH>,,<return to set to 5 seconds>,,[
FLDDB. .CMNUX,<CM%SDH>,^D10,<timeout interval in the form mm:ss>,,]] ;[7.1147]
CALL FLDSKP ;Get minutes or confirm
CMERRX ;Couldn't parse it
LDB C,[POINTR ((C),CM%FNC)] ;[7.1147]Get COMND% function parsed
CAIE C,.CMCFM ;End of line?
IFSKP. ;If yes...
MOVEI B,^D5 ;[7.1147]Load up default timeout
JRST OFS1 ;And go do SMON%
ENDIF. ;
MOVEM B,MINUTE ;Save the minutes
MOVE A,[POINT 7,[ASCIZ/:/]] ;Get default
MOVEM A,CMDEF ;Save in FDB
COLONX <timeout interval in the form mm:ss> ;Parse a colon
CMERRX ;COMND% failed
DECX <timeout interval in the form mm:ss> ;Get a decimal number
CMERRX ;COMND% failed
MOVEM B,SECOND ;Save the seconds
CONFIRM ;Confirm the command
SKIPL A,MINUTE ;Get the minutes given
CAIL A,^D60 ;And range check it
JRST BADTIM ;Must be >= 0 and < 60
IMULI A,^D60 ;And convert this to seconds
SKIPL B,SECOND ;Get the seconds given
CAIL B,^D60 ;And range check it
JRST BADTIM ;Must be >= 0 and < 60
ADD B,A ;Get the total number of seconds
JUMPE B,BADTIM ;Must be non-zero to enable
OFS1: MOVEI A,.SFOFS ;Get the SMON% function code
SMON% ;And try to set the interval
ERJMP CJERRE ;Go complain about it
RET ;Done
ENDSV.
;[7.1063]
; Here if the minutes or seconds specified above are bogus
;
BADTIM: ERROR <Invalid time specified> ;Display error message
RET ;Done
;[7.1063]"^ESET NO OFFLINE-STRUCTURES"
DISOFS: MOVEI A,.SFOFS ;Get SMON% function code
JRST SETMSS ;Join common code
;[7.1231] ^ESET NO MINIMUM-PASSWORD-LENGTH
DISMPL: MOVEI A,.SFMPL ;Get SMON% function code
JRST SETMSS ;Join common code
;[7.1076] ^ESET [NO] CLUSTER-INFORMATION
SETINF: MOVEI A,.SFCLU ;Here's the SMON% function
JRST SETMSS ;Do the setting
;[7.1076] ^ESET [NO] CLUSTER-SENDALLS
SETTMG: MOVEI A,.SFTMG ;Here's the SMON% function
JRST SETMSS ;Join the common code
;"^ESET SYSTEM OPERATOR-IN-ATTENDANCE"
SETOPR: MOVEI A,.SFOPR
JRST SETMSS ;JOIN COMMON CODE
;[4416]
SETPWD: MOVEI A,.SFPWD ;[4416] Get password dictionary
JRST SETMSS ;[4416] And 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
SETZM NEBPID ;[7.1232] Clear NEBULA's PID too
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
MOVE A,B ;PUT TIME AND DATE INTO AC1
STAD ;SET TIME AND DATE
CALL CJERR
RET
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
;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
; 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
END