Trailing-Edge
-
PDP-10 Archives
-
BB-FT68N-SM_1990
-
exec/exec4.mac
There are 47 other files named exec4.mac in the archive. Click here to see a list.
; *** Edit 3025 to EXEC4.MAC by WAGNER on 20-Dec-85, for SPR #20844
; Allow EPRINT to pass back error on INFORMATION DIRECTORY if structure is not
; mounted.
; UPD ID= 94, FARK:<5-WORKING-SOURCES.EXEC>EXEC4.MAC.2, 9-Sep-82 10:08:20 by TSANG
;EDIT - 904 ALLOW 40 ENTRIES IN EACH USER GROUPS.
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21, 28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 35, SNARK:<5.EXEC>EXEC4.MAC.3, 14-Aug-81 19:12:47 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
;<HELLIWELL.EXEC.5>EXEC4.MAC.1, 14-May-81 13:08:54, EDIT BY HELLIWELL
; UPD ID= 591, SNARK:<5.EXEC>EXEC4.MAC.5, 3-Jun-80 09:33:13 by OSMAN
;<5.EXEC>EXEC4.MAC.4, 2-Jun-80 16:41:52, EDIT BY OSMAN
;tco 5.1057 - Allow ENABLE, DISABLE, and PUSH under BUILD
;<5.EXEC>EXEC4.MAC.3, 8-May-80 14:03:45, EDIT BY OSMAN
;Remove R.L.5 and R.GE.5 macro calls and contents
; UPD ID= 424, SNARK:<4.1.EXEC>EXEC4.MAC.6, 9-Apr-80 14:02:16 by OSMAN
;tco 4.1.1141 - Fix ACCOUNT handling
; UPD ID= 413, SNARK:<4.1.EXEC>EXEC4.MAC.5, 4-Apr-80 17:42:29 by LYONS
;ADD CODE FOR ARPANET ACCESS AND DECNET ACCESS
; UPD ID= 200, SNARK:<4.1.EXEC>EXEC4.MAC.4, 10-Jan-80 14:44:43 by OSMAN
;tco 4.1.1064 - Ask for password after BUILD subcommands if needed.
; UPD ID= 194, SNARK:<4.1.EXEC>EXEC4.MAC.3, 8-Jan-80 14:28:44 by OSMAN
; UPD ID= 191, SNARK:<4.1.EXEC>EXEC4.MAC.2, 8-Jan-80 14:06:56 by OSMAN
;tco 4.1.1060 - Warn about non-accessed directories under INFO DIR
;<4.EXEC>EXEC4.MAC.49, 14-Sep-79 16:06:41, Edit by LCAMPBELL
; Account for DTIVX skip returning
;<4.EXEC>EXEC4.MAC.48, 12-Sep-79 10:36:05, EDIT BY OSMAN
;Use LERROR at NODIR instead of ERSTR
;<4.EXEC>EXEC4.MAC.44, 13-Jul-79 15:46:33, EDIT BY OSMAN
;TCO 4.2327 - PREVENT ?EXEC FREE SPACE EXHAUSTED - INFO DIR PS:[*]
;<4.EXEC>EXEC4.MAC.43, 21-Jun-79 13:36:15, EDIT BY OSMAN
;REMOVE EXTRANEOUS REF TO RLJFNS
;<4.EXEC>EXEC4.MAC.42, 7-Jun-79 14:15:20, EDIT BY EKLUND
;tco 4.2277 - add repeat-login-messages subcommand to build (again!)
;<4.EXEC>EXEC4.MAC.41, 6-Jun-79 10:40:14, EDIT BY HELLIWELL
;CHANGE WHLUO & OPRUO TO WHLU & OPRU IN "PRESERVE" SUBCOMMAND (NOSHIP)
;<4.EXEC>EXEC4.MAC.39, 1-May-79 11:20:10, EDIT BY OSMAN
;CHANGE GTJFN TO CALL GTJFS SO THAT ^C CAN'T LEAVE JFN AROUND
;<4.EXEC>EXEC4.MAC.38, 12-Mar-79 17:51:10, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXEC4.MAC.37, 28-Feb-79 11:05:02, EDIT BY OSMAN
;REMOVE REFS TO CTYPE (USE ETYPE INSTEAD)
;<4.EXEC>EXEC4.MAC.36, 7-Feb-79 13:51:39, EDIT BY OSMAN
;FIX PRINTOUT (GET RID OF _)
;<4.EXEC>EXEC4.MAC.34, 23-Jan-79 10:36:21, EDIT BY OSMAN
;CLEAR F1 ("NOT") BEFORE EACH "BUILD" SUBCOMMAND
;<4.EXEC>EXEC4.MAC.30, 18-Jan-79 18:08:55, EDIT BY OSMAN
;CHANGE THOSE SEMIS TO XARC
;<4.EXEC>EXEC4.MAC.27, 22-Dec-78 09:38:02, EDIT BY OSMAN
;put semicolons in front of all offline-exp/online-exp/archive-online stuff
;because we're not doing that stuff for r4
;<4.EXEC>EXEC4.MAC.26, 9-Nov-78 14:44:12, EDIT BY OSMAN
;TCO 4.2086 - FIX GRPCHK
;GET RID OF REFS TO UGBUF ETC. (MAKE THEM LOCAL REFS)
;<4.EXEC>EXEC4.MAC.17, 27-Sep-78 14:00:47, EDIT BY OSMAN
;CHANGE "B5" REFS TO 1B5 (VIA SYMBOL "NOTF")
;<4.EXEC>EXEC4.MAC.13, 15-Sep-78 23:21:51, EDIT BY OSMAN
;REMOVE ALL REFS TO CSBUFP
;<4.EXEC>EXEC4.MAC.12, 14-Sep-78 14:10:08, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXEC4.MAC.11, 13-Aug-78 14:00:27, Edit by HELLIWELL
;MAKE PRESERVE SUBCOMMAND CALL PRVCK
;<4.EXEC>EXEC4.MAC.10, 29-Jul-78 14:49:17, Edit by HELLIWELL
;ALWAYS CONVERT DIRECTORY NAME TO CONONICAL FORM AT CRET1
;<4.EXEC>EXEC4.MAC.7, 17-Jul-78 10:55:52, EDIT BY OSMAN
;GET RID OF GTBUF (USE LOCAL BLOCK IN PLACES WHERE ITS REFERENCED)
;<4.EXEC;MAKE DFBUF BE LOCAL
;<4.EXEC>EXEC4.MAC.4, 11-Jul-78 16:39:41, EDIT BY OSMAN
;MAKE ^EPRINT AND ^ECREATE USE LOCAL STORAGE
;<4.EXEC>EXEC4.MAC.3, 9-Jun-78 18:05:29, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<4.EXEC>EXEC4.MAC.2, 6-Jan-78 12:18:11, EDIT BY HELLIWELL
;<4.EXEC>EXEC4.MAC.1, 6-Jan-78 12:08:14, EDIT BY HELLIWELL
;ADD "PRESERVE (SUPERIOR QUOTAS)" SUBCOMMAND TO CREATE/BUILD
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
TTITLE EXEC4
;THIS FILE CONTAINS THE PRIVILEGED COMMANDS '^EPRINT' AND '^ECREATE'
;^E PRINT (NAME) <DIRECTORY NAME> [VERBOSE]
;"VERBOSE" MAY ONLY BE ENTERED AS A SUBCOMMAND. 4/21/77 EO
;PRINTS ALL OF THE CHARACTERISTICS ASSOCIATED WITH A DIRECTORY:
; PASSWORD, PRIVILEGES, MODE, SPECIAL RESOURCE INFO, DIRECTORY NUMBER,
; DEFAULT FILE PROT, DIREC PROT, FILE RETENTION SPECS,
; DIRECTORY & USER GROUPS.
;ADD'L KEYWORD "VERBOSE" OR SUBCOMMAND "VERBOSE" CAUSES ALL TO
;BE PRINTED, OTHERWISE ONLY NON-DEFAULT FIELDS.
EPRINT::TRVAR <<EPBLK,GTDLN>,EPFLG,EPDIR,EPWLS>
SETZM EPBLK ;NO BLOCK TO RELEASE YET
NOISE <DIRECTORY NAME>
TLZ Z,F1 ;ALLOW CURRENT DIR AS DEFAULT
CALL CURNMS ;INPUT DIRECTORY NAME, GET # AND BITS IN A
;**;[3025] REPLACE 1 LINE AT EPRINT::+5.L DSW 12/12/85
CALL CJERRE ;[3025] ERROR, FIND OUT WHICH AND RETURN IT
MOVEM A,EPFLG ;SAVE THE FLAGS FROM RCDIR
MOVEM B,EPWLS ;SAVE THE POINTER TO THE STRING
MOVEM C,EPDIR ;SAVE THE DIR #
TLZ Z,F3!F4 ;INITIALIZE FLAGS
CALL SPRTR ;ANALYZE & CHECK TERMINATOR
SUBCOM $PRINT ;READ SUBCOMMANDS
EPR1: MOVEI A,EPBLK
SKIPE EPBLK ;IS THERE A PREVIOUS BLOCK?
CALL RELDIR ;YES, RELEASE FREE SPACE USED
MOVE A,EPDIR ;GET THE DIR NUMBER
TLNE Z,F4 ;NAME-ONLY?
JRST EPR3 ;YES, DONT DO THE GETDIR
MOVEI C,EPBLK ;BLOCK INTO WHICH TO READ THE INFO
CALL GETDIR ;DO THE GTDIR JSYS
JRST [ MOVE A,EPDIR ;GET DIRECTORY NUMBER THAT FAILED
ETYPE <%%%%? - %1R%%_> ;SAY WHY THE FAILURE
JRST EPR2] ;DO REST IN SET
MOVEI A,EPBLK ;GET ADDRESS OF BLOCK
CALL GRPCHK ;CHECK FOR GROUP OVERFLOWS
EPR3: MOVE A,EPDIR ;GET THE DIR NUMBER FOR DIRPNT
MOVEI B,EPBLK ;GET BLOCK ADDRESS
CALL DIRPNT
EPR2: MOVE A,EPDIR ;NOW STEP TO THE NEXT DIR (IF ANY)
MOVE B,EPWLS ;GET POINTER TO ORIGINAL STRING
MOVE C,EPFLG ;GET FLAGS
TXNE C,RC%WLD ;ANY WILD CARD CHARACTERS IN STRING?
CALL STPDIR ;YES, GO STEP THE DIR NUMBER
JRST UNMDIR ;NO MORE DIRS, UNMAP DIR PAGES
MOVEM A,EPDIR ;SAVE THE NEW DIR NUMBER
JRST EPR1 ;LOOP BACK FOR THE OTHER DIRS
;DIRPNT
;PRINT DIRECTORY DESCRIPTION FROM GTDIR-FORMAT BLOCK THAT Q1 POINTS TO.
;OMITS DEFAULT VALUES UNLESS BIT F3 IN LH Z IS ON.
;PRINTS THE DIR NAME ONLY IF F4 IN LH Z IS ON.
;FOR "PRINT" COMMAND AND FOR "LIST" SUBCOMMAND OF "CREATE".
;ACCEPTS IN A/ DIR NUMBER OR POINTER TO DIR NAME STRING
;ACCEPTS IN B/ ADDRESS OF CRDIR-FORMAT BLOCK CONTAINING INFO
DIRPNT: SAVEAC <P1> ;GET A PERMANENT AC TO USE FOR ADDRESS
STKVAR <DACTPR,<DFBUF,GTDLN>>
MOVE C,.CDDAC(B) ;GET ACCOUNT POINTER
MOVEM C,DACTPR ;REMEMBER POINTER TO ACCOUNT
MOVE P1,B ;SAVE ADDRESS OF BLOCK
SKIPE A ;NAME IS NOT IN BLOCK FOR "PRINT".
ETYPE < Name %1R%%_>
TLNE Z,F4 ;PRINT NAME ONLY?
RET ;YES, EXIT
TYPE < Password >
SKIPN A,.CDPSW(P1)
JRST [ TYPE <- not available>
JRST PR2]
MOVE B,A ;SEE IF THERE IS A PASSWORD
ILDB B,B ;GET FIRST CHARACTER OF STRING
JUMPE B,[TYPE <- none set>
JRST PR2]
ETYPE <%1M>
PR2: ETYPE<%_>
SETZB A,C ;GET DEFAULT INFO
MOVEI B,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM B,.CDLEN+DFBUF ;IN FIRST WORD OF BUFFER
MOVEI B,DFBUF
GTDIR
ERCAL JERRE
MOVSI B,(<7B2>) ;CLEAR EXTRA BITS
ANDCAM B,.CDFPT+DFBUF
ANDCAM B,.CDDPT+DFBUF
MOVE B,.CDLIQ(P1) ;LOGGED IN QUOTA
ETYPE < Working disk storage page limit %2Q%%_>
MOVE B,.CDLOQ(P1) ;LOGGED OUT QUOTA
ETYPE < Permanent disk storage page limit %2Q%%_>
;PRIVILEGES
MOVE B,.CDPRV(P1)
TXNN B,SC%WHL
CALL F3NOT
TXZE B,SC%WHL
ETYPE < WHEEL%_>
TXNN B,SC%OPR
CALL F3NOT
TXZE B,SC%OPR
ETYPE < OPERATOR%_>
TXNN B,SC%CNF
CALL F3NOT
TXZE B,SC%CNF
ETYPE < CONFIDENTIAL INFORMATION ACCESS%_>
TXNN B,SC%MNT
CALL F3NOT
TXZE B,SC%MNT
ETYPE < MAINTENANCE%_>
TXNN B,SC%IPC
CALL F3NOT
TXZE B,SC%IPC
ETYPE < IPCF%_>
TXNN B,SC%ENQ
CALL F3NOT
TXZE B,SC%ENQ
ETYPE < ENQ-DEQ%_>
TXZE B,SC%NWZ ;ARPANET WIZARD?
ETYPE < ARPANET-WIZARD%_>
TXZE B,SC%NAS ;ABSOLUTE ARPANET SOCKETS?
ETYPE < ABSOLUTE-ARPANET-SOCKETS%_>
TXZE B,SC%DNA
ETYPE < DECNET-ACCESS%_>
TXZE B,SC%ANA
ETYPE < ARPANET-ACCESS%_>
JUMPE B,.+2 ;NO MORE PRIVILEGES
ETYPE < Other capabilities %2O%%_>
;DIRPNT
;MODE
MOVE B,.CDMOD(P1)
TXNN B,CD%DIR
CALL F3NOT
TXZE B,CD%DIR
ETYPE < FILES-ONLY%_>
TXZ B,CD%ANA ;IGNORE ALPHA NUMERIC BIT
TXZE B,CD%RLM
ETYPE < Repeat LOGIN messages%_>
XARC <
TXZE B,CD%DAR ; Default archive online-expired?
ETYPE < Archive online expired files%_>
>
JUMPE B,.+2 ;TEST FOR ADDITIONAL MODE BITS
ETYPE < Other mode bits %2O%%_>
SKIPN B,.CDNUM(P1)
JRST [ TLNE Z,F3
ETYPE < No directory number%_>
;0: NOT ASSIGNED YET ("CREATE" CASE)
JRST .+2]
ETYPE < Number of directory %2O%%_>
MOVE B,.CDFPT(P1)
TLZ B,(<7B2>)
TLNN Z,F3
CAME B,.CDFPT+DFBUF ;DON'T PRINT IF STANDARD
ETYPE < Default file protection %2O%%_>
MOVE B,DACTPR ;GET POINTER TO ACCOUNT STRING
ILDB B,B ;GET FIRST CHARACTER
SKIPN B ;IS THERE AN ACCOUNT DEFAULT?
SKIPA B,[-1,,[ASCIZ /- none set/]]
MOVE B,DACTPR ;YES, GET POINTER TO ACCOUNT STRING
ETYPE < Account default for LOGIN %2m%%_>
MOVE B,.CDDPT(P1)
TLZ B,(<7B2>)
TLNN Z,F3
CAME B,.CDDPT+DFBUF
ETYPE < Protection of directory %2O%%_>
;DIRPNT
MOVE B,.CDRET(P1) ;DEFAULT # VERSIONS TO KEEP
MOVE A,.CDRET+DFBUF ;DEFAULT VALUE
TLNN Z,F3
CAME B,A
ETYPE < Generations to keep %2Q%%_>
MOVE B,.CDSDQ(P1) ;NUMBER OF SUBDIRECTORIES
MOVE A,.CDSDQ+DFBUF ;DEFAULT VALUE
TLNN Z,F3
CAME B,A
ETYPE < Maximum subdirectories allowed %2Q%%_>
SKIPN A,.CDLLD(P1)
JRST [ TLNE Z,F3
ETYPE < Never logged in%_>
;CAN'T USE REG CASE CAUSE %D TYPES CURRENT
;DATE FOR 0
JRST .+2]
ETYPE < Last LOGIN %1D %1E%%_>
MOVE A,.CDUGP(P1)
MOVEI B,[ASCIZ /User groups/]
CALL GRPPNT
MOVE A,.CDDGP(P1)
MOVEI B,[ASCIZ /Directory groups/]
CALL GRPPNT
MOVE A,.CDCUG(P1) ;POINTER TO ALLOWABLE SUBDIRECTORY USER GROUPS
MOVEI B,[ASCIZ /Subdirectory user groups allowed/]
CALL GRPPNT
MOVE A,.CDDNE+DFBUF
MOVE B,.CDDNE(P1)
MOVEI C,[ASCIZ / Online expiration default /]
XARC <
CALL EXPPNT
>
MOVE A,.CDDFE+DFBUF
MOVE B,.CDDFE(P1)
MOVEI C,[ASCIZ / Offline expiration default /]
XARC <
CALL EXPPNT
>
ETYPE<%_>
RET
GRPPNT: PUSH P,B
JUMPE A,GRPPN0
MOVN B,(A) ;GET COUNT
AOJGE B,GRPPN0 ;COUNT = 1 IS NO GROUPS
HRL A,B
PRINT " "
POP P,B
UTYPE (B)
PRINT " "
AOSA A ;NOW WE HAVE AN AOBJN POINTER
GRPPN1: TYPE <, >
MOVE B,(A)
ETYPE <%2Q>
AOBJN A,GRPPN1
ETYPE<%_>
RET
GRPPN0: POP P,B
TLNN Z,F3
RET
PRINT " "
UTYPE (B)
TYPE < - none set
>
RET
;ROUTINE TO CHECK FOR LOST INFO DUE TO RESTRICTED SUBBLOCK LENGTHS. PASS
;THIS ROUTINE ADDRESS OF GTDIR/CRDIR BLOCK IN A.
GRPCHK: MOVE B,@.CDUGP(A) ;GET NUMBER OF WORDS RETURNED
;**;[904] Modify next line YKT 8-SEP-82
CAIL B,UGBUFL ;[904] CHECK FOR *POSSIBLE* OVERFLOW
TYPE < User group buffer overflow
>
MOVE B,@.CDDGP(A) ;SAME FOR OTHER GROUP BUFFERS
;**;[904] Modify next line YKT 8-SEP-82
CAIL B,DGBUFL ;[904]
TYPE < Directory group buffer overflow
>
MOVE B,@.CDCUG(A)
;**;[904] Modify next line YKT 8-SEP-82
CAIL B,SGBUFL ;[904]
TYPE < Subdirectory user group buffer overflow
>
RET
;SUBROUTINE TO TYPE " NOT" AND SKIP IF F3 ON
F3NOT: TLNN Z,F3
RET
TYPE < not>
RETSKP
EXPPNT: TLNN Z,F3 ;VERBOSE?
CAME A,B ;SAME AS DEFAULT?
CAIA ;EITHER VERBOSE OR NOT DEFAULT VALUE
RET ;YES, DON'T PRINT IT
UTYPE (C) ;WHAT IT IS
TLNN B,-1 ;INTERVAL OR DATE & TIME?
JRST EXPPN1
ETYPE <%2D
> ;PRINT DATE & TIME
RET
EXPPN1: CAIN B,1
ETYPE <%2Q Day
>
CAIE B,1
ETYPE <%2Q Days
>
RET
;"PRINT" SUBCOMMAND TABLE AND ROUTINES
$PRINT: TABLE
T FAST,ONEWRD,..FAST
T NAME-ONLY,ONEWRD,..NAME
T VERBOSE,ONEWRD,..VERB
TEND
..FAST: TLZA Z,F3
..VERB: TLO Z,F3
TLZ Z,F4 ;GET WHOLE LISTING
RET
..NAME: TLO Z,F4 ;NAME ONLY
RET
;^E CREATE (NAME) <DIRECTORY NAME> (PASSWORD) --
;EITHER FIELD CAN BE TERMINATED WITH COMMA TO INITIATE SUBCOMMANDS.
;CAN CREATE NEW DIRECTORIES OR MODIFY INFO ASSOCIATED WITH OLD ONES.
;Q1 HOLDS FLAGS AND BLOCK POINTER WHICH WILL BE IN B FOR CRDIR.
;FLAGS IN LH Q1 ARE SET ONLY FOR FIELDS EXPLICITLY INPUT BY USER,
; BUT ALL INFO IS IN BLOCK FOR "LIST" SUBCOMMAND.
.CREAT::NOISE <DIRECTORY NAME>
TRVAR <CRPASS,<CSTING,FILWDS>,<CRBLK,GTDLN>,KREDIR>
SETZM CRPASS ;NO PASSWORD YET
MOVX Q1,CD%LEN ;ALWAYS ENABLE .CDLEN ENTRY
MOVEI A,CRBLK ;ADDRESS OF BLOCK TO INITIALIZE
CALL DIRINI ;INIT BUFFER FOR GTDIR
;CREATE
;INPUT NAME AND TYPE [OLD/NEW] AND GET CURRENT INFO FOR OLD.
MOVEI B,[FLDDB. .CMDIR,CM%SDH,,<Old directory name being modified>,,[
FLDDB. .CMDIR,CM%PO+CM%SDH,,<New directory name being created>,,]]
CALL FLDSKP ;READ DIRECTORY NAME
CMERRX
MOVE A,.CMFNP(C) ;GET FUNCTION FLAGS TO DETERMINE IF DIRECTORY EXISTS OR NOT
TLZ Z,F2 ;ASSUME OLD NAME
TXNN A,CM%PO ;PARSE-ONLY?
JRST CRET1 ;NO
TLO Z,F2 ;YES, NEW NAME
CALL BUFFF ;GET STRING
MOVEM A,KREDIR ;SAVE POINTER TO DIRECTORY NAME STRING
DEXTX <> ;CLEAR GTJFN BLOCK
HRROI A,[ASCIZ /FOO/] ;NAME IS ARBITRARY
MOVEM A,CJFNBK+.GJNAM ;STORE NAME TO USE
MOVE A,[.NULIO,,.NULIO] ;DON'T LET GTJFN READ ANY MORE INPUT
MOVEM A,CJFNBK+.GJSRC ;STORE NON-JFN'S
MOVX A,GJ%OFG ;WE WANT PARSE ONLY
MOVEM A,CJFNBK+.GJGEN ;STORE FLAGS
MOVEI A,CJFNBK ;POINT GTJFN AT ARG BLOCK
MOVE B,KREDIR ;GET POINTER TO STRUCTURE AND DIRECTORY
CALL GTJFS ;GET DEVICE NAME
CALL JERR ;SHOULDN'T EVER FAIL
MOVE B,A ;PUT IN B FOR GETTING DEVICE NAME
HRROI A,CSTING ;AREA INTO WHICH TO WRITE DEVICE NAME
MOVX C,FLD(.JSAOF,JS%DEV) ;WE ONLY WANT DEVICE FIELD
JFNS ;GET DEVICE NAME
HRROI A,CSTING ;NOTE THAT WE COULDN'T JUST DO STDEV
;BECAUSE IN COMMON CASE, USER WILL
;TYPE "^ECREATE [FOO]", AND HENCE DEVICE
;NAME WILL BE NULL. UNFORTUNATELY,
;STDEV DOESN'T HAVE A SPECIAL ERROR CODE
;SAYING "DEVICE NAME WAS NOT SPECIFIED",
;NOR DOES IT RETURN UPDATED STRING POINTER
;IN AC1. OTHERWISE THE GTJFN,JFNS WOULD
;HAVE BEEN UNNECESSARY. NOTE THAT LEAVING
;OUT ALL THIS CODE IS BAD TOO, BECAUSE
;USER MIGHT SAY "^ECREATE ABC:[FOO]"
;WHERE ABC: IS NOT MOUNTED, AND EXEC WOULD
;JUST WAIT FOR ALL THE SUBCOMMANDS, AND
;THEN BOMB OUT, A VERY FRUSTRATING
;SITUATION.
MOVE C,A ;LEAVE POINTER IN 3 FOR ERROR MESSAGE
STDEV ;MAKE SURE STRUCTURE IS MOUNTED
ERCAL [ERROR <Structure %3m: not mounted>]
SETZB A,C ;USE DIRECTORY 0
MOVEI B,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM B,.CDLEN+CRBLK ;IN FIRST WORD OF BUFFER
MOVEI B,CRBLK ;POINT TO BUFFER
GTDIR ;GET DEFAULTS
MOVEI A,CRBLK ;GET ADRESS OF ENTIRE CRDIR BLOCK
MOVEI B,1 ;MAKE EMPTY GROUP BUFFERS
MOVEM B,@.CDUGP(A)
MOVEM B,@.CDDGP(A)
MOVEM B,@.CDCUG(A)
TXO Q1,CD%LIQ!CD%LOQ!CD%FPT!CD%DPT!CD%RET
JRST CRET1A
CRET1: MOVEM B,KREDIR ;REMEMBER DIRECTORY NUMBER
HRROI A,CSTING ;GET STRING STORAGE POINTER
DIRST
ERCAL CJERRE
HRROI A,CSTING ;GET TO BEGINNING OF STRING AGAIN
CALL BUFFS ;SAVE STRING
EXCH A,KREDIR ;RESTORE DIR # AND SAVE STR
;GET CURRENT INFORMATION FOR OLD DIRECTORY
MOVEI B,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM B,.CDLEN+CRBLK ;IN FIRST WORD OF BUFFER
MOVEI B,CRBLK
HRROI C,CSTING ;PASSWORD GOES HERE (POINTER STORED IN BUFFER BY GTDIR)
MOVE D,.CDDAC(B) ;GET POINTER TO WHERE ACCOUNT WILL GO
GTDIR
ERCAL CJERRE
MOVEM D,.CDDAC(B) ;RESTORE ACCOUNT POINTER TO POINT AT BEGINNING
HRROI A,CSTING ;POINT TO PASSWORD
CALL BUFFS ;ISOLATE IT
SKIPE .CDPSW+CRBLK ;NO POINTER STORED MEANS PASSWORD NOT AVAILABLE
MOVEM A,.CDPSW+CRBLK ;STORE POINTER TO ISOLATED PASSWORD
MOVEI A,CRBLK ;GET ADDRESS OF BLOCK
CALL GRPCHK ;CHECK FOR GROUP OVERFLOW
CRET1A:
;CREATE
;INPUT PASSWORD.
;FOR OLD DIRECTORY, THIS PASSWORD REPLACES OLD ONE - IS THAT GOOD?
NOISE <PASSWORD>
WORDX <Password>
CMERRX
CALL BUFFF
LDB B,[350700,,ATMBUF] ;SEE IF ANY PASSWORD TYPED
JUMPE B,CREAT3 ;JUMP IF NONE
MOVEM A,.CDPSW+CRBLK ;PASSWD STRING PTR TO PARAMETER BLOCK
TXO Q1,CD%PSW ;TELL CRDIR TO SET PASSWORD
CREAT3: COMMAX <Optional comma, then carriage return to go into subcommand mode>
JFCL ;NO COMMA REQUIRED
CONFIRM ;GET LINE CONFIRMATION
CALL NORO ;TYPE NEW OR OLD
;CHECK, CONFIRM, EXECUTE
SETZM .CDLEN+CRBLK ;CLEAR CRDIR BITS
CRSUB: SUBCOM $CREAT,[TLZ Z,F1
RET] ;GET SUBCOMMANDS, CLEAR "NOT" BEFORE EACH ONE
CRSUB1: MOVE A,KREDIR ;GET POINTER TO NAME STRING
MOVEI B,CRBLK
HLL B,Q1 ;XWD FLAGS, PARAMETER BLOCK ADDRESS
MOVE C,CRPASS ;GET 0 OR POINTER TO PASSWORD
CRDIR ;CREATE DIRECTORY !
ERJMP NODIR ;FAILED, LET USER FIX SUBCOMMANDS AND TRY AGAIN
CALLRET UNMDIR
;GET TO HERE IF CRDIR FAILED. TELL USER, LET HIM FIX SUBCOMMANDS AND
;TRY AGAIN.
NODIR: CALL DGETER ;SEE WHY IT FAILED
CAIN A,ACESX3 ;PASSWORD REQUIRED?
JRST CRSUB2 ;GET PASSWORD AND TRY AGAIN
CAIN A,CNDIX1 ;WRONG PASSWORD?
JRST [ LERROR <%?%%_> ;YES, TELL HIM
JRST CRSUB2] ;GET ANOTHER PASSWORD AND TRY AGAIN
LERROR <%?.%_Please fix incorrect subcommands.%_>
JRST CRSUB ;GO BACK INTO SUBCOMMAND MODE
;GET TO HERE IF CRDIR FAILS DUE TO PASSWORD MISSING OR WRONG. INPUT THE
;PASSWORD AND TRY CRDIR AGAIN. THIS IS DONE RATHER THAN BOMBING OUT, TO TRY
;TO SAVE THE USER FROM HAVING TO DO ANOTHER BUILD WITH ALL THE PARAMETERS.
CRSUB2: CALL PASLIN ;YES, GET ONE
MOVEM A,CRPASS ;REMEMBER IT
JRST CRSUB1 ;GO TRY AGAIN
;TYPE "[NEW]" OR "[OLD]" DEPENDING ON WHETHER DIRECTORY IS NEW OR OLD
NORO: TLNE Z,F2
TYPE <[New]
>
TLNN Z,F2
TYPE <[Old]
>
RET
;CREATE
;SUBCOMMAND DISPATCH TABLE
;FLAG B5 INDICATES "NOT" MAY PRECEDE THE SUBCOMMAND.
NOTF==1B5
$CREAT: TABLE
T ABORT,ONEWRD
T ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS
T ACCOUNT-DEFAULT,,.AD
XARC <
T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
>
T ARPANET-ACCESS,NOTF,..ANA
T ARPANET-WIZARD,NOTF,..ANW
T CONFIDENTIAL,NOTF
T DECNET-ACCESS,NOTF,..DNA
T DEFAULT-FILE-PROTECTION,,..PFIL
T DIRECTORY-GROUP,NOTF,..DIRE
T DISABLE
T ENABLE
T ENQ-DEQ,NOTF,..ENQ
T FILES-ONLY,NOTF,.FILES
T GENERATIONS,,..GENR
T IPCF,NOTF
T KILL,NOTF
T LIST,,..LIST
T MAINTENANCE,NOTF
T MAXIMUM-SUBDIRECTORIES,,.MAXIM
T NOT
T NUMBER
XARC <
T OFFLINE-EXPIRATION-DEFAULT,,.OFFLI
T ONLINE-EXPIRATION-DEFAULT,,.ONLIN
>
T OPERATOR,NOTF
T PASSWORD
T PERMANENT,,..LOQ
T PRESERVE,,...PRE
T PROTECTION,,...PRO
T PUSH,,...PUS
T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
T SUBDIRECTORY-USER-GROUP,,.SUSER
T USER-GROUP,NOTF,.USER
T WHEEL,NOTF
T WORKING,,..LIQ
TEND
;CREATE
;"NOT" CAN PRECEDE THOSE SUBCOMMANDS WHICH HAVE B5 SET IN TABLE.
;DISPATCH IS TO SAME ROUTINE BUT WITH "F1" SET TO REVERSE EFFECT.
.NOT: KEYWD $$CREA
0
JRST CERR
MOVE P4,P3
TLO Z,F1
JRST (P3)
$$CREA: TABLE
T ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS
XARC <
T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
>
T ARPANET-ACCESS,NOTF,..ANA
T ARPANET-WIZARD,NOTF,..ANW
T CONFIDENTIAL,NOTF
T DECNET-ACCESS,NOTF,..DNA
T DIRECTORY-GROUP,NOTF,..DIRE
T ENQ-DEQ,NOTF,..ENQ
T FILES-ONLY,NOTF,.FILES
T IPCF,NOTF
T KILL,NOTF
T MAINTENANCE,NOTF
T OPERATOR,NOTF
T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
T SUBDIRECTORY-USER-GROUP,,.SUSER
T USER-GROUP,NOTF,.USER
T WHEEL,NOTF
TEND
;ROUTINES FOR THE INDIVIDUAL SUBCOMMANDS
;PASSWORD
;CURRENTLY REDUNDANT EXCEPT THAT IT ALLOWS TYPIN IN A FORMAT MORE LIKE
; WHAT "PRINT" PUTS OUT AND ALLOWS GIVING A NULL STRING (USEFUL?).
.PASSW: WORDX <1 to 39 alphanumeric characters or hyphens>
CMERRX
CONFIRM
CALL BUFFF
MOVEM A,.CDPSW+CRBLK
TXO Q1,CD%PSW
RET
;"CREATE" SUBCOMMANDS
;LOGGED-IN (STORAGE LIMIT) <DECIMAL>
..LIQ: CALL ..DISK
MOVEM B,.CDLIQ+CRBLK
TXO Q1,CD%LIQ
RET
;LOGGED-OUT (STORAGE LIMIT) <DECIMAL>
..LOQ: CALL ..DISK
MOVEM B,.CDLOQ+CRBLK
TXO Q1,CD%LOQ
RET
..DISK: NOISE <DISK STORAGE PAGE LIMIT>
DECX <Decimal number of pages>
CMERRX
CONFIRM
CAML B,[^D1000000] ;LESS THAN A MILLION?
HRLZI B,377777 ;NO - GIVE INFINITE QUOTA
RET
;SUBCOMMANDS FOR SPECIFIC PRIVILEGES AND MODES.
;F1 ON AT ENTRY IF PRECEDED BY "NOT".
;AC USE: A: MASK INDICATING BITS TO SET (F1 OFF), OR CLEAR (F1 ON).
..AAS: SKIPA A,[SC%NAS] ;ABSOLUTE ARPANET SOCKETS
..ANW: MOVEI A,SC%NWZ ;ARPANET WIZARD
JRST CPRIV
..ANA: SKIPA A,[SC%ANA]
..DNA: MOVEI A,SC%DNA
JRST CPRIV
..ENQ: MOVEI A,SC%ENQ
JRST CPRIV
.IPCF: SKIPA A,[SC%IPC]
.MAINT: MOVEI A,SC%MNT
JRST CPRIV
.WHEEL: SKIPA A,[SC%WHL]
.OPERA: MOVEI A,SC%OPR
JRST CPRIV
.CONFI: NOISE <INFORMATION ACCESS CAPABILITY>
MOVEI A,1B20
JRST CPRIV1
CPRIV: NOISE <CAPABILITY>
CPRIV1: CONFIRM
IORM A,.CDPRV+CRBLK ;SET BITS IN QUESTION
TLNE Z,F1 ;BUT IF SUBCOMMAND PRECEDED BY "NOT",
ANDCAM A,.CDPRV+CRBLK ;CLEAR THE BITS.
TXO Q1,CD%PRV
RET
..RLM: MOVX A,CD%RLM ;CHANGE REPEAT LOGIN MESSAGE BIT
JRST CCMODE
..ARCH: SKIPA A,[CD%DAR]
.FILES: MOVX A,CD%DIR
; JRST CCMODE ;(FALL INTO CCMODE)
CCMODE: CONFIRM
IORM A,.CDMOD+CRBLK ;SET BIT
TLNE Z,F1 ;PRECEDED BY "NOT"?
ANDCAM A,.CDMOD+CRBLK ;YES, CLEAR BIT.
TXO Q1,CD%MOD
RET
;"CREATE" SUBCOMMANDS
;NUMBER <OCTAL>. SPECIFIES DIRECTORY NUMBER
.NUMBE: NOISE <OF DIRECTORY>
OCTX <Octal directory number>
CMERRX
TLNN Z,F2
JRST [ CAME B,.CDNUM+CRBLK
ERROR <You can't change the number of an old directory>
JRST NUMBE1]
;CHECK THAT THE NUMBER ISN'T IN USE BY TRYING TO CONVERT IT TO STRING.
HRROI A,CSTING
DIRST
CAIA ;NOT IN USE
ERROR <Number already in use>
NUMBE1: CONFIRM
MOVEM B,.CDNUM+CRBLK
SKIPE B
TXO Q1,CD%NUM
RET
.OFFLI: NOISE <IS>
DTIVX <Expiration date>
CMERRX
CONFIRM
MOVEM B,.CDDFE+CRBLK ;SAVE OFFLINE FLAG
MOVX B,CD%FED ;CHANGE OFFLINE FLAG
IORM B,.CDLEN+CRBLK
TXO Q1,CD%LEN ;INDICATE LENGTH & OFF/ON EXP TO BE CONSIDERED
RET
.ONLIN: NOISE <IS>
DTIVX <Expiration date>
CMERRX
CONFIRM
MOVEM B,.CDDNE+CRBLK ;SAVE ONLINE FLAG
MOVX B,CD%NED ;CHANGE ONLINE FLAG
IORM B,.CDLEN+CRBLK
TXO Q1,CD%LEN ;INDICATE LENGTH & OFF/ON EXP TO BE CONSIDERED
RET
;"CREATE" SUBCOMMANDS
;PROTECTION (OF DIRECTORY) <OCTAL>. LATER ALSO ALLOW NAMED PROT?
...PRO: NOISE <OF DIRECTORY>
OCTX <6-digit octal number>
CMERRX
CONFIRM
TLNE B,777777 ;ALLOW TALT+TSPC+TEOL
ERROR <6-digit value only>
TLO B,500000
MOVEM B,.CDDPT+CRBLK
TXO Q1,CD%DPT
RET
;PRESERVE (SUPERIOR QUOTAS)
...PRE: NOISE <SUPERIOR QUOTAS>
MOVX B,WHLU+OPRU
CALL PRVCK ;MUST HAVE PRIVS FOR THIS FCN
ERROR <WHEEL or OPERATOR capability required>
CONFIRM
MOVX B,CD%NSQ ;NO SUBTRACT QUOTAS BIT
IORM B,.CDLEN+CRBLK ;ASSUME ON
TLNE Z,F1 ;"NOT" ?
ANDCAM B,.CDLEN+CRBLK ;YES
RET
;ACCOUNT-DEFAULT
.AD: NOISE <FOR LOGIN>
LINEX <Default account for users logging into this directory>
CMERRX
CONFIRM
CALL BUFFF
MOVEM A,.CDDAC+CRBLK ;REMEMBER NEW ACCOUNT
TXO Q1,CD%DAC ;SAY TO SET STRING
RET
..PFIL: NOISE <NUMBER>
OCTX <6-digit octal number>
CMERRX
CONFIRM
TLNE B,777777 ;ALLOW TALT+TSPC+TEOL
ERROR <6-digit value only>
TLO B,500000
MOVEM B,.CDFPT+CRBLK
TXO Q1,CD%FPT
RET
..GENR: NOISE <TO KEEP>
DECX <Decimal number of generations to retain per file>
CMERRX
MOVE A,B ;LEAVE NUMBER IN A
CONFIRM
DMOVE B,[EXP 0,FB%RET] ;GET MASK FOR RETENTION COUNT FIELD
GENR1: JUMPE C,GENR2 ;IT'S RIGHT-JUSTIFIED WHEN C CONTAINS 0
LSHC B,1 ;DO A SHIFT
JRST GENR1
GENR2: JFFO B,.+1 ;GET NUMBER OF BITS TO LEFT OF RIGHT-JUSTIFIED FIELD
CAIL A,0
CAMLE A,B ;MAKE SURE NUMBER IS IN RANGE
ERROR <Must be 0-%2Q>
MOVEM A,.CDRET+CRBLK ;STORE NEW GNERATION RET COUNT DEFAULT
TXO Q1,CD%RET
RET
;"CREATE" SUBCOMMANDS
;SUBDIRECTORY
;SUBDIRECTORY MAXIMUM
.MAXIM: NOISE <ALLOWED>
DECX <Decimal number of subdirectories allowed under this directory>
CMERRX ;INVALID NUMBER OF SUBDIRECTORIES
CONFIRM
MOVEM B,.CDSDQ+CRBLK ;REMEMBER NUMBER SPECIFIED
TXO Q1,CD%SDQ ;REMEMBER TO SET THIS PARAMETER
RET
;[NOT] SUBDIRECTORY USER
.SUSER: NOISE <ALLOWED>
MOVE A,.CDCUG+CRBLK ;ADDRESS OF SUBDIRECTORY USER GROUPS ALLOWED BUFFER
HRLI A,SGBUFL ;SPECIFY LENGTH
TXO Q1,CD%CUG
CALLRET .GROUP ;CALL GROUP AND RETURN
;[NOT] USER (GROUP) <DECIMAL GROUP NUMBER 1-2**18>
;F1 ON IF PRECEDED BY "NOT"
.USER: NOISE <NUMBER>
MOVE A,.CDUGP+CRBLK ;USER GROUP BUFFER ADDRESS
HRLI A,UGBUFL ;SPECIFY LENGTH OF BLOCK
TXO Q1,CD%UGP ;SET USER GROUP FLAG
CALLRET .GROUP ;CALL GROUP AND RETURN
;[NOT] DIRECTORY (GROUP) <DECIMAL GROUP NUMBER 1-2**18>
..DIRE: NOISE <NUMBER>
MOVE A,.CDDGP+CRBLK ;GET ADDRESS OF DIRECTORY GROUP BUFFER
HRLI A,DGBUFL ;SPECIFY LENGTH
TXO Q1,CD%DGP ;SET DIRECTORY GROUP FLAG; FALL INTO .GROUP
; CALLRET .GROUP ;(FALL INTO .GROUP)
;SUBROUTINE TO ADD OR DELETE GROUP NUMBER FROM BUFFER IN A
.GROUP: PUSH P,A ;SAVE BUFFER POINTER
DECX <Decimal group number>
CMERRX
CONFIRM
MOVE A,B
JUMPLE A,GRPER1 ;OUT OF RANGE
CAILE A,777777 ;MUST FIT IN HALFWORD
GRPER1: ERROR <Group numbers must be between 1 and 262143.>
POP P,B ;GET BUFFER POINTER BACK
MOVN C,(B)
AOJGE C,GRPNX1 ;JUMP IF EMPTY GROUP
HRLZ C,C
HRRI C,1(B) ;MAKE AOBJN PTR
GRPFN1: CAMN A,(C)
JRST GRPFN2
AOBJN C,GRPFN1
GRPNX1: TLNE Z,F1
JRST [ ETYPE <%%No group to remove%_>
RET]
HLRZ C,B
CAMG C,(B) ;BUFFER FULL YET?
ERROR <Can't add new group; buffer full>
AOS C,(B) ;COUNT ANOTHER ENTRY
ADDI C,-1(B) ;POINT TO NEW ENTRY
MOVEM A,(C)
RET
GRPFN2: TLNN Z,F1
JRST [ ETYPE <%%Group already exists%_>
RET]
HRRI A,(C) ;DESTINATION
HRLI A,1(C) ;SOURCE
SOS C,(B)
ADDI C,-1(B) ;LAST WORD TO STORE
BLT A,(C)
SETZM 1(C) ;CLEAR LAST WORD FOR CLEANLINESS
RET
;"CREATE" SUBCOMMANDS
;KILL (THIS DIRECTORY)
.KILL: NOISE <THIS DIRECTORY>
CONFIRM
TLNN Z,F1
CALL FCONF ;FORCED CONFIRMATION IF KILL
TXO Q1,CD%DEL
TLNE Z,F1
TXZ Q1,CD%DEL ;"NOT KILL" REVERSES EFFECT.
RET
;ABORT: ABORT THIS CREATE. REDUNDANT FOR ^C.
.ABORT: MOVEI A,RERET
MOVEM A,CERET
CALL UNMDIR
JRST CMDIN4 ;GO GET NEXT EXEC COMMAND
;LIST. PRINTS WHAT "PRINT" WILL PRINT IF THIS "CREATE" IS COMPLETED.
;"LIST VERBOSE" PRINTS AS "PRINT" WITH VERBOSE SUBCOMMAND
..LIST: KEYWD $.LIST
T FAST,,0 ;DEFAULT IS "FAST"
JRST CERR
TLZ Z,F3!F4
CONFIRM
TRNE P3,F4
TLO Z,F4
TRNE P3,F3
TLO Z,F3
MOVE A,KREDIR ;GET POINTER TO STRING FOR DIRPNT
MOVEI B,CRBLK ;GET BLOCK ADDRESS
TXNN Q1,CD%DEL
JRST DIRPNT ;GO ACT LIKE "PRINT" COMMAND
TYPE < Killed
>
RET
;PUSH ALLOWS THE BUILDER TO PUSH OUT OF THE BUILD COMMAND, WHICH IS USEFUL
;IF ANOTHER BUILD COMMAND IS REQUIRED SUCCESSFULLY TO COMPLETE THE CURRENT
;ONE, OR IF ANOTHER COMMAND IS NECESSARY.
...PUS: CALL .PUSH ;DO THE PUSH
MOVE A,KREDIR ;GET POINTER TO DIRECTORY
ETYPE <[Continuing BUILD of directory %1R]%_>
RET
$.LIST: TABLE
T FAST,,0
T NAME-ONLY,,F4
T VERBOSE,,F3
TEND
END