/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/ EDIT #64
/
/ COPYRIGHT 1970,1971,1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/
/ MCR FUNCTION -- OPEN         13 NOV 70        H. KREJCI
/				30 JUN 71	R. MCLEAN
/				18 JAN 74	M. HEBENSTREIT
/
/ TASK NAME:  "...OPE"  TO OPEN A REGISTER (CORE CELL) FOR EXAMINATION
/ TO OPTIONALLY ALTER IT, AND TO OPTIONALLY OPEN A RELATED REGISTER.
/
/ THE FIRST LINE OF COMMAND INPUT FOR ANY MCR FUNCTION IS READ
/ BY THE RESIDENT MCR TASK ("...MCR").  FOR THE "OPEN" FUNCTION,
/ THE SYNTAX OF THE FIRST LINE IS:
/
/	SYNTAX = "OPE"$<CHARACTER><BREAK CHAR><NUMBER> 
/		(<BREAK CHAR><CDU>)(BREAK CHAR><BIAS>)<BREAK CHAR><CR>/AM>
/	    <CHARACTER> = <LETTER>/<DIGIT>
/	    <BREAK CHAR> = " "/","
/		<BIAS> = DISPLACEMENT BIAS
/		<CDU> = C OR RF#, RK#, OR RP# (C=CORE)
/	    <NUMBER> = <SIGN><RADIX><DIGIT>$<DIGITS>   [DEFAULT POSITIVE OCTAL]
/		<SIGN> = "+"/"-"/NUL
/		<RADIX> = "D"/O"/NUL
/		<DIGIT> = (0/1/2/3/4/5/6/7) / (0/1/2/3/4/5/6/7/8/9)
/	    <CR> = CARRIAGE RETURN
/	    <AM> = ALTMODE
/
/	$ -- "ANY NUMBER OF, INCLUDING ZERO"
/	NUL -- "THE EMPTY SET"
/
/ THE RESIDENT MCR READS A LINE, FETCHES THE FIRST THREE CHARACTERS
/ TO FORM THE MCR FUNCTION TASK NAME ("...OPE"), FLUSHES CHARACTERS
/ THRU THE FIRST BREAK CHARACTER, REQUESTS "...OPE", AND EXITS.
/
/ THE TASK "...OPE" FETCHES CHARACTERS FORMING THE ADDRESS OF
/ THE FIRST REGISTER TO BE OPENED, AND RECORDS THE LINE
/ TERMINATOR. FOR DISK ACCESSES THE FIRST NUMBER REPRESENTS A DISK BLOCK.
/ THE DIGIT FOLLOWING RF, RP, OR RK INDICATES THE UNIT. FOR THE RF
/ A UNIT NUMBER OF ZERO SHOULD BE USED SINCE ONLY ONE RF IS SUPPORTED.
/ THE BIAS SHOULD BE LESS THAN OR EQUAL TO 377 OCTAL.
/ 
/ NOTE WELL: DISK ADDRESSES ARE COMPUTED MOD 256 SO ANY LOCATION WITHIN
/ A BLOCK CAN BE ACCESSED BUT NO ACCESSES ARE PROCESSED OUTSIDE THE BLOCK,
/ UNTIL THE USER REQUESTS THE "...OPE" TASK AGAIN.
/  
/
/ IF THE ADDRESS IS VALID, THE REGISTER'S ADDRESS & CONTENTS ARE
/ TYPED OUT FOLLOWED BY A ">" PROMPTING CHARACTER.  THE SYNTAX
/ OF THE RESPONSE IS AS FOLLOWS:
/
/	SYNTAX = (<NUMBER>/NUL)(<AM>/<CR>/"^"<CR>/"*"<CR>)
/
/ IF A NUMBER IS TYPED IN, THAT QUANTITY REPLACES THE REGISTER
/ CONTENTS TYPED OUT, OTHERWISE, THE REGISTER IS UNALTERED.
/
/ IF THE RESPONSE IS TERMINATED BY AN ALTMODE, NO RELATED
/ REGISTER IS TO BE OPENED.  IF THE "OPE" LINE WAS CAR RTN
/ TERMINATED, THE RESIDENT MCR TASK WILL BE REQUESTED AND THE OPEN
/ MCR FUNCTION TASK WILL EXIT, ALLOWING ANOTHER REGISTER TO BE
/ OPENED (OR ANOTHER MCR FUNCTION PERFORMED).  IF THE "OPE" LINE
/ WAS ALTMODE TERMINATED, THE OPEN MCR FUNCTION TASK WILL EXIT
/ WITHOUT REQUESTING THE RESIDENT MCR TASK (^C IS NECESSARY TO 
/ RE-ESTABLISH MCR DIALOGUE).
/
/ IF THE RESPONSE IS TERMINATED BY A CARRIAGE-RETURN, THE NEXT
/ SEQUENTIAL REGISTER (ADR+1) IS OPENED.
/
/ IF THE RESPONSE IS TERMINATED BY AN UP-ARROW-CAR-RTN, THE
/ PREVIOUS REGISTER (ADR-1) IS OPENED.
/
/ IF THE RESPONSE IS TERMINATED BY AN ASTERISK-CAR-RTN, THE
/ REGISTER INDICATED BY THE FINAL CONTENT OF THE LOW ORDER 15 BITS
/ OF THE REGISTER JUST OPENED IS OPENED.
/
/
/
 .TITLE *** MCR FUNCTION 'OPEN'
/
ECLA=641000
CSIZE=136
DSIZE=137
RPDISK=303
RKDISK=302
MCRRI=171
IFAC=172
FAC=174
ECLA=641000
/
OPEN	LAW	-1	/SET DEFAULT TO CORE FETCH
	DAC	CORE
        LAW     -1	/SET FLAG FOR INITIAL LINE INPUT
        DAC     DSKFLG
	LAC	(OPEN)	/COMPUTE XR ADJUSTMENT
	AND	(070000) /MASK OFF PAGE BITS
	TCA
	DAC	XADJ	/SAVE XR ADJUSTMENT
	DZM	BIA
	DZM	DSKUN	/DEFAULT DISK 0
	JMS	FN	/FETCH ADDRESS OF FIRST REGISTER TO
	JMP	ERR	/OPEN (ERR IF NONE TYPED), AND SAVE
	DAC	ADR	/IN 'ADR'.
/
	LAC	FNB	/SAVE BREAK (TERMINAL) CHARACTER OF
	DAC	RQSW	/INITIAL COMMAND LINE.  "...MCR"
			/WILL BE REQUESTED IF LINE WAS TERMINATED
			/BY A CARRIAGE RETURN.
	SAD	(015)	/ERR IF "^" OR "*" BREAK.  RETURN CARRIAGE
	JMP	RNGX	/IF ALTMODE BREAK.
	SAD	(175)
	JMP	RNGX
	SAD	(040)	/IS IT A SPACE?
	JMP	CORDSK	/YES LOOK FOR OPTIONAL PARAMETERS
	SAD	(054)	/IS IT A COMMA
	JMP	CORDSK	/YES DECODE REST OF STATEMENT
	JMP	ERR
/
CORDSK  DZM     DSKFLG	/CLEAR INIT. LINE FLAG
        JMS     FN	/FETCH NEXT DISK, ORE, OR BIAS
	JMP	ERR	/DERROR SPACE CAR RTN
	DAC	BIA	/BIAS FOUND SAVE IT
        LAW     -1	/SET DSKFLG
        DAC     DSKFLG
        LAC     DEV0	/IS THE ADDRESS CORE OR DISK?
        SZA
        JMP     DSKFND	/DISK ADDRESS
	LAC	FNB	/CHECK FOR A C
	SAD	(103)
	JMP	CORFND	/FOUND A CORE ADDRESS
ALTCRX	LAC	FNB	/PICK UP BREAK CHARACTER
	DAC	RQSW
	SAD	(015)	/IS IT A CAR RTN?
	JMP	RNGX	/YES PROCESS LINE
	SAD	(175)	/IS IT AN ALTMODE?
	JMP	RNGXA	/YES RETURN CARRAGE FIRST
	JMP	ERR	/NO ERROR
CORFND	LAW	-1
	DAC	CORE	/SET CORE SWITCH
	LAC	BIA	/CHECK BIAS SWITCH
	SZA		/IF THERE IS A BIAS THERE IS AN ERROR
	JMP	ERR
	JMS*	(FAC)	/FETCH A CHARACTER
	DAC	FNB	/SAVE CHARACTER FOUND
	SAD	(040)	/IS IT A SPACE
	JMP	LKFBIA	/YES LOOK FOR A BIAS
	SAD	(054)	/IS IT A COMMA
	JMP	LKFBIA	/YES BO LOOK FOR A BIAS
	JMP	ALTCRX	/NO LOOK FOR AN ALTMODE OR CAR RTN
DSKFND	DZM	CORE	/SET DISK REQUEST
        LAC     DEV0	/WHAT DISK IS IT?
        SAD     (2	/RF?
        JMP     RF1	/YES
        SAD     (3	/NO -- RP?
        JMP     RP1	/YES
        SAD     (24	/NO -- RK?
        SKP		/YES
        JMP     ERR	/NO -- ERROR
RK1     LAC*    (RKDISK	/DOES RK EXIST?
        SPA
        JMP     ERR	/NO -- ERROR
        LAC     BIA	/IS UNIT NO. IN RANGE?
        TCA
        TAD*    (RKDISK
RK2     SPA
        JMP     ERR	/NO -- ERROR
        LAC     ADR	/CONVERT BLOCK NO. INTO PLATTER AND ADDRESS
        CLL
        LMQ
        LLSS!ECLA 10
        DAC     DSKUN
        LACQ
        DAC     ADR
        JMP     RF2
RP1     LAC*    (RPDISK	/DOES THE RP EXIST?
        SPA
        JMP     ERR	/NO -- ERROR
        LAC     BIA	/IS UNIT NO. IN RANGE?
        TCA
        TAD*    (RPDISK
        JMP     RK2
RF1     LAC*    (DSIZE	/DOES THE RF EXIST?
        SPA
        JMP     ERR	/NO -- ERROR
        LAC     BIA	/IS THE UNIT NO. 0?
        SZA
        JMP     ERR	/NO -- ERROR
        LAC     ADR	/CONVERT BLOCK NO. INTO PLATTER AND ADDR.
        CLL
        LRS     12
        DAC     DSKUN
        LAC     ADR
        AND     (1777
        ALS     10
        DAC     ADR
        LAC     DSKUN	/TEST FOR LEGAL PLATTER NO.
        TCA
        TAD*    (DSIZE
        SPA
        JMP     ERR	/ERROR -- ILLEGAL PLATTER NO. FOR RF
RF2     LAC     BIA	/SET DEVICE UNIT NUMBER
        DAC     DEVUNT
	DZM	BIA
	LAC	FNB	/IS CHARACTER FOLLOWING A BREAK CHARACTER?
	SAD	(040)	/SPACE?
	JMP	LKFBIA	/YES LOOK FOR A BIAS
	SAD	(054)	/COMMA?
	JMP	LKFBIA	/YES LOOK FOR A BIAS
	JMP	ALTCRX	/NO LOOK FOR A CAR RTN OR ALTMODE
LKFBIA	JMS	FN	/FETCH AN OCTAL NUMBER
	JMP	ERR	/NO NUMBER THEREFORE ERROR
	DAC	BIA	/SAVE BIAS
        LAC     CORE	/IS THIS A CORE ADDRESS?
        SZA
        JMP     ALTCRX	/YES
        LAC     BIA	/NO -- DISK
        AND     (377	/DISK ADDR. COMPUTED MOD 256 DECIMAL
        DAC     BIA
	JMP	ALTCRX	/CHECK FOR ALTMODE OR CAR RTN
RNGXA	JMS	CRTN
/
RNGX	CAL	AL2CPB	/ATTATCH TO TTY
	CAL	AL3CPB	/ATTACH TO TTY
	CAL	WFTEV
	LAC	ADR	/PICK UP THE ADDRESS
	TAD	BIA	/ADD THE BIAS
	DAC	ADR	/RETORE IT IN THE ADDRESS
RNGXB	LAC	CORE	/CHECK TO SEE IF CORE OR DISK ADDRESS
	SNA
	JMP	DSKR
	LAC	ADR	/TEST RANGE OF ADDRESS -- ERR IF OUT OF RANGE
	SPA
	JMP	ERR
	TCA
	TAD*	(CSIZE)
	SPA
	JMP	ERR
/
/
DKRTN	LAC	ADR	/CONVERT ADDRESS TO IMAGE ALPHA
        LMQ		/SAVE THE ADDRESS
        LAC     CORE	/IS THIS A CORE ADDRESS?
        SZA
        JMP     .+4	/YES
        LACQ		/NO -- DISK
        AND     (377
        SKP
        LACQ
	JMS	EX
	ADRB
	LAC	ADRB	/CHANGE LEADING ZERO TO BLANK
	SAD	(060)
	AAC	-20
	DAC	ADRB
	LAC	CORE	/CHECK FOR CORE ADDRESS
	SZA
	JMP	.+3	/YES DECODE IT
	LAC	WORD	/NO DISK ADDRESS
	JMP	DECODE	/DECODE THE WORD
/
	LAC	ADR	/PICK UP THE ADDRESS OF THE REQUESTED CORE
	TAD	XADJ	/LOCATION AND ADD XR ADJUST
	PAX		/PUT IT IN XR TO ACCESS GT 32K
	LAC	0,X	/COVERT REGISTER CONTENTS TO IMAGE ALPHA
DECODE	JMS	EX
	REGB
/
	JMS	TYPA	/TYPE ADDRESS, CONTENTS, & PROMPTING CHAR
	MES12
/
	JMS*	(IFAC)	/READ A LINE OF COMMAND INPUT
			/AND INITIALIZE THE FETCH-A-CHAR
			/SUBROUTINE.
/
	JMS	FN	/FETCH NUMBER -- IF NOT A ZERO LENGTH
	JMP	DKWRTN	/INPUT (TERMINATOR ONLY, STORE THE NUMBER)
	PAL	/SAVE NUMBER RETURNED IN LR
	LAC	FNB
	JMS	BCX	/MAKE SURE REQUEST WAS A NUMBER
	SKP
	JMP	ERR
	LAC	CORE
	SNA		/CHECK TO SEE IF CORE ADDRESS
	JMP	DSKW	/WRITE DISK
	LAC	ADR	/PICK UP THE ADDRESS POINTER
	TAD	XADJ	/ADD XR ADJUSTMENT
	PAX
	PLA
	DAC	0,X	/TYPED IN THE OPEN REGISTER
/
DKWRTN	LAC	FNB	/EXAMINE BREAK CHAR
	SAD	(175)	/ALTMODE?
	JMP	EXT	/YES -- EXIT TASK
	SAD	(052)	/NO -- ASTERISK?
	JMP	GNA1	/YES -- GET NEXT ADR FROM CONTENTS
	SAD	(136)	/NO -- UP ARROW?
	JMP	GNA2	/YES -- DECREMENT 'ADR'
	ISZ	ADR	/NO -- (ASSUME CAR RTN) INCREMENT 'ADR'
	NOP		/DON'T SKIP IF DISK ADDRESS 777777
        LAC     CORE	/IS THIS A CORE ADDR.?
        SZA
        JMP     RNGXB	/YES
        LAC     ADR	/NO -- DISK
        AAC     -1
        AND     (377
        SAD     (377
	SKP
        JMP     RNGXB
        DZM     ADR
	JMP	RNGXB	/AND OPEN NEXT REGISTER (IF ADR IN RANGE).
GNA1	LAC	CORE
	SNA		/IS THIS A CORE REQUEST?
	JMP	GNA4	/NO MUST BE DISK
	LAC	ADR	/REPLACE 'ADR' WITH THE LOW ORDER 15 BITS
	TAD	XADJ
	PAX
	LAC	0,X
	AND	(077777)/OF THE REGISTER JUST OPENED.
	JMP	GNA3
/
GNA2	LAW	-1	/DECREMENT 'ADR'
	TAD	ADR
        LMQ
        LAC     CORE
        SZA
        JMP     .+12
        LACQ
        AND     (377
        SAD     (377
        SKP
        JMP     .+5
        LAC     ADR
        AND     (777400
        TAD     (377
        SKP
        LACQ
GNA3	DAC	ADR
/
	JMS*	(FAC)	/IN EITHER CASE (^ OR *) THE NEXT CHAR SHOULD
	SAD	(015)	/BE A CAR RTN -- ERR IF NOT
	JMP	RNGXB
	JMP	ERR
GNA4	LAC	WORD	/PICK UP THE DATA WORD
        AND     (377
        DAC     TEMP
        LAC     ADR
        AND     (777400
        TAD     TEMP
	JMP	GNA3
/
EXT	CAL	DL2CPB	/DETACH TTY
	CAL	DL3CPB	/DETACH TTY LUN-3
	CAL	WFTEV
/
	LAC	RQSW	/IF FIRST LINE OF COMMAND INPUT (LINE READ BY
	SAD	(015)	/RESIDENT MCR) WAS CAR RTN TERMINATED, REQUEST
	CAL	REQCPB	/THE RESIDENT MCR TASK AND EXIT. IF THE FIRST
	SAD	(175)	/LINE WAS ALTMODE TERMINATED, CLEAR THE ^C REQUEST
	DZM*	(MCRRI)	/INHIBIT FLAG AND EXIT.
	CAL	(10)
/
ERR1	DAC	CDSKUN	/PREVENT A MATCH
	DAC	CADR	/NEXT TIME THROUGH.
	JMS	TYPA	/DISK ERROR.
	MES14
	JMP	ERRXT
/
ERR	JMS	TYPA	/AN ERROR HAS BEEN DETECTED, TYPE ERR
	MES13		/MESSAGE, REQUEST RESIDENT MCR TASK,
ERRXT	CAL	REQCPB
	CAL	DL2CPB	/DETACH TTY LUN-2
	CAL	DL3CPB	/DETACH TTY LUN-3
	CAL	WFTEV
	CAL	(10)
/
/ FN -- FETCH NUMBER SUBROUTINE.  NUMBER MAY BE A POSITIVE OR
/ NEGATIVE OCTAL OR DECIMAL INTEGER.  IF NEGATIVE,
/ THE FIRST CHAR MUST BE A MINUS SIGN.  IF DECIMAL, THE QUANTITY
/ MUST BE PRECEDED BY A "D" ("-D" FOR NEGATIVE DECIMAL INTEGERS).
/
/ RETURN AT JMS+1 IF ZERO LENGTH LINE, OTHERWISE,
/ RETURN AT JMS+2 WITH INTEGER IN AC.
/ IN EITHER CASE, THE BREAK CHAR IS LEFT IN 'FNB'.
/
FN	0
	LAC	(10)	/SET OCTAL RADIX
	DAC	FNR
	DZM	FNS	/SET SIGN POSITIVE
	DZM	FNQ	/SET QUANTITY ZERO
/
	JMS*	(FAC)	/FETCH A CHARACTER
	DAC	FNB
	JMS	BCX	/ZERO LENGTH LINE?
	JMP*	FN	/YES -- RETURN AT JMS+1
	ISZ	FN	/NO -- SETUP RETURN AT JMS+2
	SAD	(055)	/IS CHAR A MINUS SIGN?
	JMP	FN2	/YES -- NEGATE SIGN
	SAD	(053)	/NO -- PLUS SIGN?
	JMP	FN3	/YES -- IGNORE
	JMP	FN4	/TEST FOR RADIX INDICATOR
/
FN2	ISZ	FNS	/NEGATE SIGN
/
FN3	JMS*	(FAC)	/SIGN WAS INPUT, FETCH NEXT CHAR
/
FN4     SAD     (122	/IS THIS AN R?
        JMP     FN10	/YES
        SAD     (104	/DECIMAL INDICATOR ("D")?
	JMP	FN5	/YES -- SET DECIMAL RADIX
	SAD	(117)	/NO -- OCTAL INDICATOR ("O")?
	JMP	FN6	/YES -- IGNORE
	JMP	FN7	/NO -- ASSEMBLE QUANTITY
/
FN5	LAC	(12)	/SET DECIMAL RADIX
	DAC	FNR
/
FN6	JMS*	(FAC)	/FETCH CHAR TO ASSEMBLE QUANTITY
FN7	PAL		/SAVE CHARACTER
	JMS	BCX	/BREAK CHAR?
	JMP	FN8	/YES -- ADJUST FOR SIGN
	LRS	4	/NO -- WAS CHAR A DIGIT?
	AND	(7)
	SAD	(3)
	SKP
	JMP	FN9	/EXIT NON BREAK CHARACTER OR NUMBER
	ECLA!LLS	4	/YES -- SAVE VALUE
	DAC	FNB
	TCA		/IS VALUE LESS THAN RADIX?
	TAD	FNR
	SPA!SNA
	JMP	FN9
	LAC	FNQ	/ASSEMBLE INTO QUANTITY
	CLL
	MUL
FNR	XX
	SZA
	JMP	ERR	/(OVERFLOW)
	LACQ
	TAD	FNB
	DAC	FNQ
	SZL		/OVERFLOW?
	JMP	ERR	/YES -- ERR
	JMP	FN6	/NO -- FETCH NEXT CHAR
FN9	PLA		/RESTORE BREAK CHARACTER
/
FN8	DAC	FNB	/SAVE BREAK CHAR
/
	LAC	FNS	/QUANTITY HAS BEEN ASSEMBLED, COMPLIMENT
	RAR		/IF SIGN HAS BEEN SET, AND RETURN
	LAC	FNQ	/AT JMS+2
	SZL
	TCA
	JMP*	FN
FN10    JMS*    (FAC	/GET THE P,F, OR K FOR RP, RF, OR RK.
        SAD     (113
        JMP     RK0
        SAD     (120
        JMP     RP0
        SAD     (106
        SKP
        JMP     ERR
RF0     LAC     (2
        SKP
RP0     LAC     (3
        SKP
RK0     LAC     (24
        DAC     DEV0
        DAC     DEV1
        LAC     DSKFLG
        SZA
        JMP     ERR
        CLC
        DAC     DSKFLG
        JMP     FN6
/
FNS	0	/SIGN
FNQ	0	/QUANTITY
FNB	0	/BUFFER
/
/ BCX -- BREAK CHARACTER TEST.  RETURN AT JMS+1 IF THE CHAR IN AC
/ IS A CAR RTN, ALTMODE, ASTERISK, OR UP ARROW, OTHERWISE RETURN
/ AT JMS+2.  IN EITHER CASE, AC IS UNALTERED.
/
BCX	0
	SAD	(052)	/ASTERISK?
	JMP*	BCX	/YES -- RETURN AT JMS+1
	SAD	(136)	/NO -- UP ARROW?
	JMP*	BCX	/YES -- RETURN AT JMS+1
	SAD	(015)	/NO -- CAR RTN?
	JMP*	BCX	/YES -- RETURN AT JMS+1
	SAD	(175)	/NO -- ALTMODE?
	JMP*	BCX	/YES -- RETURN AT JMS+1
	ISZ	BCX	/NO -- RETURN AT JMS+2
	JMP*	BCX
/
/ DSKR AS BEEN CHANGED TO USE A 400 WORD SECTORED DEVICE
/ IN A MANNER TRANSPARENT TO THE REST OF THE PROCESS.
DSKR	LAC	ADR	/GET DISK ADDRESS(CALLED)
	AND	(377	/INTRABUFFER ADDRESS(RELATIVE)
	TAD	BUFST	/MAKE ABS RELATIVE TO CORE BUFFER
	DAC	BUFPT	/POINTER TO CORE LOCATION OF DESIRED WORD
	LAC	ADR	/DISK ADDRESS(CALLED)
	AND	(777400	/MOD 400
	DAC	NADR	/BACK TO CPB(ADDRESS USED)
	LAC	DSKUN	/GET UNIT NUMBER(CALLED)
        AND     (007777
        DAC     TEMP
        LAC     DEVUNT
        CLL
        ALS     17
        TAD     TEMP
	DAC	NCPB	/TO CPB(USED)(UNIT# CALLED=UNIT # USED)
	SAD	CDSKUN	/CHECK SAME AS PREVIOUS ACCESS
	SKP		/IF SO,NO NEED FOR ANOTHER
	JMP	.+4	/NO MATCH SKIRT REMAINDER OF TEST
	LAC	NADR	/MATCH-TEST DISK ADDRESS
	SAD	CADR	/
	JMP	SKPRD	/COMPLETE MATCH SKIP THE READ
	LAC	NADR	/NEW BLOCK REQ. UPDATE CUR ADDRESS
	DAC	CADR	/AND
	LAC	NCPB	/PLATTER
	DAC	CDSKUN	/
	CAL	GETCPB	/DO THE READ
	CAL	WFDKR	/WAIT FOR IT
	LAC	EV	/CHECK VALID READ
	SPA		/
	JMP	ERR1	/NO TAKE ERROR EXIT
SKPRD	LAC* BUFPT	/GET WORK DESIRED
	DAC	WORD	/PUT IN PROCESS WORKING REGISTER
	JMP	DKRTN	/BACK TO PROCESS
/
DSKW	PLA
	DAC*	BUFPT	/PUT IN CORE BUFFER
	CAL	PUTCPB	/WRITE BLOCK
	CAL	WFDKR	/WAIT
	LAC	EV	/CHECK ERROR
	SPA		/
	JMP	ERR1	/ERROR EXIT
	LAW	-1	/NO CURRENT
	DAC	CDSKUN	/UNIT
	DAC	CADR	/OR ADDRESS
	JMP	DKWRTN	/RETURN
/ EX -- SUBROUTINE TO EXPAND THE WORD IN AC INTO SIX IMAGE
/ ALPHA OCTAL CHARACTERS AND STORE IN SIX WORD BUFFER WHOSE
/ ADDRESS FOLLOWS THE JMS.
/
EX	0
	LMQ
	LAC*	EX
	ISZ	EX
	DAC	EXX
	CLX
	LAC	(6)
	PAL
EX1	ECLA!LLS	3
	AAC	60
	DAC*	EXX,X
	AXS	+1
	JMP	EX1
	JMP*	EX
/
EXX	0
/
/ CRTN -- SUBROUTINE TO RETURN CARRIAGE
/
CRTN	0
	JMS	TYPA
	MES11
	JMP*	CRTN
/
/ TYPA -- SUBROUTINE TO TYPE THE (IMAGE ALPHA) MESSAGE
/ WHOSE ADDRESS FOLLOWS THE JMS
/
TYPA	0
	LAC*	TYPA
	ISZ	TYPA
	DAC	WL2CPB+4
	CAL	WL2CPB
	CAL	WFTEV
	JMP*	TYPA
/
WFTEV	20	/WAIT FOR TTY (LUN-3) EVENT VARIABLE
	L2EV	/EVENT VARIABLE
/
MES11	002003	/HEADER
	000000
	15	/CR
	12	/LF
/
MES12	011003	/HEADER
	000000
ADRB	0	/ADDRESS BUFFER
	0
	0
	0
	0
	0
	057	/SLASH
REGB	0	/REGISTER BUFFER
	0
	0
	0
	0
	0
	076	/">" PROMPTING CHAR
	175	/ALTMODE
	0	/NULL
/
MES13	011003	/HEADER
	000000
	117	/"0"
	120	/"P"
	105	/"E"
	055	/"-"
	123	/"S"
	131	/"Y"
	116	/"N"
	124	/"T"
	101	/"A"
	130	/"X"
	040	/SPACE
	105	/"E"
	122	/"R"
	122	/"R"
	015	/CR
	012	/LF
/
MES14	010003
	0
	117	/O
	120	/P
	105	/E
	055	/-
	104	/D
	123	/S
	113	/K
	040	/SP
	105	/E
	122	/R
	122	/R
	040	/SP
	015	/CR
	012	/LF
/
/ CAL PARAMETER BLOCKS
/
AL3CPB	2400	/ATTACH LUN-3
	L2EV
	3
/
DL3CPB	2500	/DETACH LUN-3
	L2EV
	3
/
AL2CPB	2400	/ATTACH LUN-2
	L2EV
	2
/
DL2CPB	2500	/DETACH LUN-2
	L2EV
	2
/
WL2CPB	2700	/WRITE LUN-3
	L2EV
	3
	3
	0
/
REQCPB	1	/REQUEST MCR
	0
	.SIXBT	"...MCR"
	0
/
GETCPB	13000
	EV
	1
	NCPB
DEV0    0
/
PUTCPB	13100
	EV
	1
	NCPB
DEV1    0
/
HINF	3600	/USED TO FIND OUT WHAT DEVICE THIS IS
	EV
	1
/
WFDKR	20
	EV	/WAIT FOR DISK READ
NCPB		0	/
NADR		0	/
		BUF	/
		400	/
/
/ CONSTANTS & VARIABLES
/
WORD	0	/DISK READ WORD
BUFST	BUF	/CORE BUFFER TOP
BUFPT	0	/BUFFER POINTER TO CURRENT WORD
CDSKUN	-1	/CURRENT PLATTER NUMBER
CADR	0    	/CURRENT DISK ADDRESS
ADR	0	/DISK ADDRESS CALLED
DSKUN	0	/UNIT CALLED
EV	0	/DSK EVENT VARIABLE ADDRESS
BIA	0	/OFFSET BIAS
CORE	0	/CORE DISK SWITCH
RQSW	0	/REQUEST MCR SWITCH
L2EV	0	/LUN-3 (TTY) EVENT VARIABLE
XADJ	0	/XR ADJUSTMENT
TEMP    0
DEVUNT  0
DSKFLG  0
BUF	.BLOCK	400	/CORE BUFFER FOR CURRENT BLOCK
/
	.END	OPEN