.TITLE *** ACCESS MCR FUNCTION ***
/
/ COPYRIGHT (C) 1975
/ DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/ THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/ SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/ VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/ EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/ THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/ SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/ WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/ MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/ OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
/ DEC.
/
	.EJECT
/
/ EDIT 1	MAY 5,1975		M. HEBENSTREIT
/
/ THIS MCR FUNCTION WILL CHANGE THE SHARED ACCESS CHARACTERISTICS OF A
/ PARTITION OR SYSTEM COMMON BLOCK.  THE COMMAND STRING FORMAT IS:
/
/		MCR>ACC(ESS) NAME CHAR
/
/ WHERE NAME IS THE NAME OF A SYSTEM COMMON BLOCK OR PARTITION.
/ CHAR IS EITHER RO, RW, OR NOS FOR READ ONLY, READ/WRITE, OR NO SHARING.
/
/ THIS MCR FUNCTION WILL ONLY CHANGE THE ACCESS CHARACTERISTICS FOR A BLOCK
/ OF MEMORY IF THAT BLOCK IS NOT BEING USED OR IF IT IS BEING USED THE
/ OPERATOR IS REQUESTING GREATER ACCESS PRIVILAGES THAN WERE PREVIOUSLY
/ SPECIFIED.
/
	.EJECT
/
/ CONSTANTS FOR ACCESS
/
MCRRI=171		/MCR INHIBIT FLAG
FAC=174			/FETCH A CHARACTER SUBROUTINE ENTRY POINT
SCDL=254		/SYSTEM COMMON BLOCK LISTHEAD
PBDL=250		/PARTITION BLOCK LISTHEAD
R1=101			/RE-ENTRANT REGISTER R1
R2=102			/RE-ENTRANT REGISTER R2
SNAM=123		/FIND THE NAME IN LIST SUBROUTINE
S.ACC=10		/SCDL ACCESS CHARACTERISTICS WORD
S.USE=11		/SCDL IN USE FLAG
P.ACC=10		/PBDL ACCESS CHARACTERISTICS WORD
P.USE=47		/PBDL IN USE FLAG
IDX=ISZ			/USED WHEN INTENT IS TO INCREMENT BUT NOT SKIP
.INH=705522		/INHIBIT INTERRUPTS
.ENB=705521		/ENABLE INTERRUPTS
/
/ GET THE XR ADJUSTMENT
/
START	LAC	(START		/CALCULATE THE XR ADJUSTMENT 
	AND	(70000
	TCA
	DAC	XRADJ		/SAVE THE ADJUSTMENT
/
/ GET THE NAME OF THE PARTITION OR SYSTEM COMMON BLOCK
/
SCANN	JMS*	(FAC		/GET NEXT CHAR
	SAD	(40		/IS IT A SPACE?
	JMP	SCANN		/YES -- IGNORE IT
	JMS	GETNAM		/GET THE NAME OF THE BLOCK OF MEMORY
	NAME1			/STORE IT IN NAME1 AND NAME2
	JMP	FORERR		/RETURN HERE ON A N ERROR
	SAD	(40		/RETURN HERE IF OK -- IS BREAK CHAR A SPACE?
	SKP			/YES -- OK
	JMP	FORERR		/NO -- ERROR
/
/ GET THE ACCESS ABBREVIATION
/
SCANP	JMS*	(FAC		/GET THE NEXT CHAR
	SAD	(40		/IS IT A SPACE?
	JMP	SCANP		/YES -- IGNORE IT
	JMS	GETNAM		/NO -- GET THE ABBREVIATION
	PRIV1			/STORE IT IN PRIV1 AND PRIV2
	JMP	FORERR		/RETURN HERE ON AN ERROR
	SAD	(15		/RETURN HERE IF OK -- WAS BREAK CHAR A CR?
	JMP	EOSCAN		/YES
	SAD	(175		/NO -- ALTMODE?
	JMP	EOSCAN		/YES
	JMP	FORERR		/NO -- ERROR
/
/ CHECK THE ACCESS ABBREVIATION
/
EOSCAN	DAC	TERM		/SAVE THE LINE TERM
	LAC	PRIV2		/MAKE SURE NO EXTRA CHARS WERE INPUT
	SZA
	JMP	FORERR		/ERROR
	LAC	PRIV1		/GET ABBREVIATION
	SAD	(221700		/WAS IT RO?
	JMP	RO		/YES
	SAD	(222700		/NO -- RW?
	JMP	RW		/YES
	SAD	(161723		/NO -- NOS?
	SKP			/YES
	JMP	FORERR		/NO -- ERROR
/
/ ENTER THE ACCESS CODE IN PRIV -- 00=NOS, 01=RO, 10=RW
/
NOS	CLA
	JMP	PRIVOK
RW	LAC	(2
	JMP	PRIVOK
RO	CLA!IAC
PRIVOK	DAC	PRIV		/SAVE THE CODE
/
/ SCAN THE SCDL FOR THE BLOCK NAMED AND SET BITS IF APPROPRIATE
/
	LAC	(SCDL		/PREPARE TO SCAN THE SCDL
	DAC*	(R1
	LAC	(NAME1
	DAC*	(R2
	JMS*	(SNAM		/SCAN SCDL
	JMP	CHKPAR		/RETURN HERE IF BLOCK NOT IN SCDL
	JMS	SETXR		/RETURN HERE IF FOUND AND SET UP XR
	LAC	S.ACC,X		/GET CURRENT CHARACTERISTICS
	AND	(3
	TCA			/NEGATE
	TAD	PRIV		/ARE DESIRED CHARACTERISTICS GREATER ?
	SMA
	JMP	SETSC		/YES
	LAC	S.USE,X		/NO -- IS BLOCK IN USE?
	SZA
	JMP	USEERR		/YES -- ERROR
SETSC	.INH			/INHIBIT INTERRUPTS
	LAC	S.ACC,X		/GET CHARS.
	AND	(777774		/MASK OFF OLD CHAR FLAGS
	XOR	PRIV		/ENTER NEW CHAR
	DAC	S.ACC,X		/SAVE THEM
	.ENB			/ENABLE INTERRUPTS
	JMP	EXIT		/GO EXIT
/
/ SCAN THE PBDL FOR THIS BLOCK AND SET BITS IF APPROPRIATE
/
CHKPAR	LAC	(PBDL		/PREPARE TO SCAN PBDL FOR BLOCK NAMED
	DAC*	(R1
	LAC	(NAME1
	DAC*	(R2
	JMS*	(SNAM		/SCAN PBDL
	JMP	NAMERR		/RETURN HERE IF NOT FOUND -- ERROR
	JMS	SETXR		/RETURN HERE IF FOUND AND SET UP XR
	LAC	P.ACC,X		/GET ACCESS CHARS
	AND	(3		/REMOVE OTHER FLAGS
	TCA			/NEGATE
	TAD	PRIV		/DESIRE CHARS GREATER THAN CURRENT?
	SMA
	JMP	SETPAR		/YES
	LAC	P.USE,X		/NO -- IS PART. IN USE?
	SZA
	JMP	USEERR		/YES -- ERROR
SETPAR	.INH			/NO -- INHIBIT INTERRUPTS
	LAC	P.ACC,X		/GET FLAGS
	AND	(777774		/REMOVE OLD CHAR
	XOR	PRIV		/ENTER NEW CHARS.
	DAC	P.ACC,X		/STORE THEM IN PBDL
	.ENB			/ENABLE INTERRUPTS
/
/ EXIT ROUTINE -- LEAVE ACCORDING TO LINE TERMINATOR
/
EXIT	LAC	TERM		/WAS TERM A CR OR ALTM.?
	SAD	(15		/CR?
	CAL	REQMCR		/YES -- REQUEST ...MCR
	SAD	(175		/NO -- ALTM.?
	DZM*	(MCRRI		/YES -- SET MCRRI SO CNTRL/C WORKS
	CAL	(10		/EXIT
/
/ ERROR ROUTINES
/
FORERR	LAC	(MEFORM
	SKP
USEERR	LAC	(MEUSE
	SKP
NAMERR	LAC	(MENAM
	DAC	PRINT+4		/PUT MESSAGE ADDR IN CPB
	CAL	PRINT		/PRINT THE ERROR MESSAGE
	CAL	WAIT		/WAIT FOR COMPLETION OF PRINTING
	LAC	(15		/SET TERM TO INDICATE A
	DAC	TERM		/CARRIAGE RETURN SO MCR WILL BE REQUESTED
	JMP	EXIT		/GO EXIT
	.EJECT
/
/ CPB'S AND MESSAGES AND VARIABLES
/
REQMCR	1			/REQUEST MCR DISPATCHER CPB
	0			/EVENT VARIABLE ADDR (NONE SPECIFIED)
	.SIXBT "..."		/TASK NAME (1ST HALF)
	.SIXBT "MCR"		/TASK NAME (SECOND HALF)
	0			/TASK RUN PRIORITY (USE DEFAULT)
/
PRINT	2700			/PRINT A LINE CPB
	EV			/EVENT VARIABLE ADDR
	3			/LOGICAL UNIT NUMBER
	2			/DATA MODE (IOPS ASCII)
	XX			/MESSAGE ADDR (ENTERED BEFORE CALLING)
/
WAIT	20			/WAITFOR EV CPB
	EV			/EVENT VARIABLE ADDR
/
MEFORM	MEUSE-MEFORM/2*1000
	0
	.ASCII "ACC -- FORMAT ERROR"<15>
MEUSE	MENAM-MEUSE/2*1000
	0
	.ASCII "ACC -- MEMORY BLOCK IN USE"<15>
MENAM	EV-MENAM/2*1000
	0
	.ASCII "ACC -- MEMORY BLOCK NOT FOUND"<15>
EV	0			/PRINT MESSAGE EVENT VARIABLE
XRADJ	0			/XR ADJUSTMENT FACTOR
NAME1	0			/MEMORY BLOCK NAME BUFFER (FIRST HALF)
NAME2	0			/MEMORY BLOCK NAME BUFFER (SECOND HALF)
PRIV1	0			/ACCESS ABBREVIATION BUFFER (FIRST HALF)
PRIV2	0			/ACCESS ABBREVIATION BUFFER (SECOND HALF)
PRIV	0			/DESIRED ACCESS CODE (0=NOS, 1=RO, 2=RW)
TERM	0			/LINE TERMINATOR (15 FOR CR, 175 FOR ALTM.)
	.EJECT
/
/ SUBROUTINES
/
/
/ SUBROUTINE SETXR -- ADJUST THE XR TO ACCESS ADDRESS IN AC ON ENTRY
/			RETURN AT JMS+1 UNCONDITIONALLY
/
/			ON ENTRY THE DESIRED ADDRESS MUST BE IN THE AC
/
/			AC AND XR ARE ALTERED
/
SETXR	0
	TAD	XRADJ		/ADD THE XR ADJUSTMENT FACTOR
	PAX			/ENTER INTO XR
	JMP*	SETXR		/RETURN
/
/
/ SUBROUTINE GETNAM -- GET AN ASCII NAME FROM TTY LINE AND ENTER
/                      THE SIXBT VERSION OF THE NAME INTO THE  
/                      LOCATIONS SPECIFIED AT JMS+1
/			RETURN AT JMS+2 ON ERRORS
/			RETURN AT JMS+3 ON OK
/
/			AC ON ENTRY HAS 1 CHAR OR 0
/			AC ON RETURN HAS BREAK CHAR
/
/			AC AND MQ ARE MODIFIED
/
GETNAM	0
	DAC	GNTEMP		/SAVE THE CHAR
	LAC*	GETNAM		/GET A POINTER TO THE NAME BUFFER
	DAC	GNCNT		/SAVE THE POINTER TEMPOR ARILY
	DZM*	GNCNT		/ZERO 1ST HALF OF NAME
	IDX	GNCNT		/INCREMENT THE POINTER
	DZM*	GNCNT		/ZERO 2ND HALF OF NAME
	LAW	-6		/SET THE CHAR. COUNT TO 6 CHARS.
	DAC	GNCNT		/SAVE IN GNCNT
	LAC	GNTEMP		/PICK UP FORMER CONTENTS OF AC
	SNA			/SKIP IF AC IS A CHAR.
GNLOC2	JMS*	(FAC		/GET NEXT CHAR
	SAD	(40		/IS IT A SPACE?
	JMP	GNLOC3		/YES
	SAD	(15		/NO -- CARRIAGE RETURN?
	JMP	GNLOC3		/YES
	SAD	(175		/NO -- ALTMODE?
	JMP	GNLOC3		/YES
	SAD	(75		/NO -- EQUAL SIGN?
	JMP	GNLOC3		/YES
	AND	(77		/NO -- MASK TO 6 BITS
	DAC	GNTEMP		/SAVE THE SIXBT CHAR
	LAC	GNCNT		/DETERMINE IF THIS IS 1ST OR 2ND WORD STORE
	AAC	3
	SPA
	JMP	GNLOC5		/1ST WORD STORE
	LAC*	GETNAM		/2ND WORD STORE -- GET POINTER
	IAC			/(INCREMENT IT)
GNLOC6	DAC	GNPTR		/PTR NOW HAS ADDR OF 2ND WORD OF NAME
	LAC*	GNPTR		/PICK UP THE NAME
	CLL			/SET UP LINK FOR SHIFT
	ALS	6		/MAKE ROOM FOR NEXT CHAR
	TAD	GNTEMP		/INSERT NEXT CHAR
	DAC*	GNPTR		/STORE NAME
	ISZ	GNCNT		/HAVE SIX CHARS BEEN PROCESSED?
	JMP	GNLOC2		/NO -- GO GET THE NEXT CHAR
	JMS*	(FAC		/YES -- GET THE BREAK CHAR
/
/ PREPARE TO RETURN
/
GNLOC4	IDX	GETNAM		/PREPARE TO RETURN AT JMS+2
	IDX	GETNAM
	JMP*	GETNAM		/RETURN
/
/ PREPARE TO CONSTRUCT 1ST 1/2 OF NAME
/
GNLOC5	LAC*	GETNAM		/1ST WORD STORE
	JMP	GNLOC6
/
/ A BREAK CHAR HAS BEEN READ, SO SHIFT NAME BUFFER WORDS TO SHOW
/ THAT THERE ARE NULLS ON THE END OF THE WORD
/
GNLOC3	DAC	GNTEMP		/SAVE THE BREAK
	LAW	-6		/IS THERE A CHAR IN THE NAME?
	SAD	GNCNT
	JMP	GNERR		/NO -- ERROR
	LAC	GNCNT		/YES -- SHIFT THE WORDS
	AAC	3		/CHECK IF THE 1ST OR 2ND WORD WAS PROCESSED
	SMA!CLA
	IAC			/2ND WORD SO ADD 1 TO POINTER
	TAD*	GETNAM		/SET UP A POINTER TO NAME WORD
	DAC	GNPTR		/SAVE THE POINTER
/
/ FIND OUT WHERE LAST CHAR WAS PUT AND SHIFT AS APPROPRIATE
/
	LAC	GNCNT		/GET THE CHAR COUNT
	SAD	(-5		/WAS 1 CHAR READ?
	JMP	GNLOC9		/YES -- GO SHIFT
	SAD	(-2		/NO -- WERE 4 CHARS READ?
	JMP	GNLOC9		/YES -- GO SHIFT
	SAD	(-4		/NO -- WERE 2 CHARS READ?
	JMP	GNLOC8		/YES -- GO SHIFT
	SAD	(-1		/NO -- WERE 5 CHARS READ?
	JMP	GNLOC8		/YES -- GO SHIFT
	JMP	GNLOC7		/NO -- NO SHIFT REQUIRED
/
/ SHIFT TO SHOW 2 NULLS IN NAME
/
GNLOC9	LAC*	GNPTR		/GET THE NAME WORD
	CLL			/SET UP FOR SHIFT
	ALS	14		/SHIFT IN 2 NULLS
	JMP	GNLOC0		/GO STORE RESULT
/
/ SHIFT TO SHOW 1 NULL IN NAME
/
GNLOC8	LAC*	GNPTR		/GET THE NAME WORD
	CLL			/SET UP FOR SHIFT
	ALS	6		/SHIFT IN 1 NULL
GNLOC0	DAC*	GNPTR		/STORE THE RESULT
GNLOC7	LAC	GNTEMP		/GET THE BREAK CHAR
	JMP	GNLOC4		/PREPARE TO RETURN
/
/ AN ERROR WAS FOUND -- RETURN AT JMS+1
/
GNERR	IDX	GETNAM		/PREPARE TO RETURN AT JMS+1
	JMP*	GETNAM		/RETURN
/
/ LOCAL VARIABLES FOR GETNAM
/
GNCNT	0			/CHAR COUNTER
GNTEMP	0			/TEMP STORE FOR CHAR
GNPTR	0			/POINTER TO NAME BUFFER
	.END