.TITLE	avl    - ASSIGN VIRTUAL DISK by block number and size
	.SBTTL	avl    - TITLE PAGE
	.IDENT	/X01.03/
;
; ************************************************************************
;                                                                        *
; THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY.  DIGITAL  EQUIPMENT *
; COMPUTER USER'S SOCIETY,  DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND *
; THE AUTHOR DISCLAIM  ALL WARRANTIES ON THE PROGRAM,  INCLUDING WITHOUT *
; LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS.      *
;									 *
; FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS  AND TO THE DECUS *
; SPECIAL INTEREST  GROUPS  TO  REPRODUCE,  DISTRIBUTE,  AND PUBLISH AND *
; PERMIT  OTHERS  TO  REPRODUCE  IN  WHOLE  OR  IN PART, IN ANY FORM AND *
; WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO *
;									 *
; ************************************************************************
;
; ASSIGN VIRTUAL DISK DEVICE TO SPECIFIED FILE.
;
; VERSION:	V01.02
;
; AUTHOR:	R.W. STAMERJOHN	MAPC	19-MAR-79
;
; MODIFICATION HISTORY:
;
;	V01.01	RWS	31-MAR-79	CHANGE PROTECTION TO [RW,RW,,]
;
;	V01.02	RWS	31-MAR-79	ALLOW DOUBLE-WORD CREATION SIZE
; 	v01.03 ebl	12-jun-80 this version takes only physical block numbers
;		GCE - ADD MULTI-ASSIGN CAPABILITY CONDITIONED ON
;			M$VE$$
	.SBTTL	avl    - DECLARATIONS
	.DSABL	GBL
;
; MACRO LIBRARY CALLS:
;
;	SYMBOLIC DEFINITIONS.
;
	.MCALL	HDRDF$			;DEFINE TASK HEADER OFFSETS
	HDRDF$
	.MCALL	UCBDF$			;DEFINE UCB OFFSETS
	UCBDF$
;
;	DIRECTIVE MACROS.
;
	.MCALL	DIR$			;ISSUE DIRECTIVE
	.MCALL	ALUN$S			;ASSIGN LUN
	.MCALL	EXIT$S			;EXIT SYSTEM
	.MCALL	GMCR$			;GET MCR COMMAND LINE
	.MCALL	QIOW$			;ISSUE QIO AND WAIT
	.MCALL	SVTK$S			;SETUP SST VECTOR TABLE
;
;	CSI MACROS.
;
	.MCALL	CSI$			;DEFINE CSI OFFSETS
	CSI$
	.MCALL	CSI$SW,CSI$SV,CSI$ND	;SWITCH TABLE MACROS
	.MCALL	CSI$1,CSI$2		;PARSE COMMAND LINE
;
;	FCS MACROS.
;
	.MCALL	FDOF$L			;DEFINE FCS OFFSETS
	FDOF$L
	.MCALL	NBOF$L			;DEFINE FNB OFFSETS
	NBOF$L
	.MCALL	FCSBT$			;DEFINE FCS BIT MASKS.
	FCSBT$
	.MCALL	FDBDF$			;DEFINE FDB
	.MCALL	FDAT$A			;DEFINE FILE ATTRIBUTES
	.MCALL	FDRC$A			;DEFINE RECORD ACCESS
	.MCALL	FDBK$A			;DEFINE BLOCK  ACCESS
	.MCALL	FDOP$A			;DEFINE OPEN CHARACTERISTICS
	.MCALL	FSRSZ$			;DEFINE FSR REGION
	.MCALL	NMBLK$			;DEFINE DEFAULT FILENAME BLOCK
;
;	OTHER MACROS.
;
	.MCALL	CALL,CALLR,RETURN	;SUBROUTINE MACROS
;
; GLOBAL DECLARATIONS:
;
	.GLOBL	avl			;TASK ENTRY
;
; GLOBAL REFERENCES:
;
;	SYSTEM LIBRARY ROUTINES, SYMBOLS.
;
	.GLOBL	.DD2CT			;DECIMAL TO DOUBLE-WORD
	.GLOBL	.FINIT			;INITIALIZE FSR REGION
	.GLOBL	.prsdv			;device and unit PARSE
	.GLOBL	$COTB			;CONVERT OCTAL TO BINARY
	.GLOBL	IO.CRE			;CREATE FILE
	.GLOBL	IO.ENA			;ENTER NAME IN DIRECTORY
	.GLOBL	IO.FNA			;FIND  NAME IN DIRECTORY
	.GLOBL	IO.ACW			;ACCESS FILE FOR WRITE
	.GLOBL	IO.DAC			;DEACCESS FILE
	.GLOBL	IO.WAT			;WRITE ATTRIBUTES
	.GLOBL	IO.DEL			;DELETE FILE
	.GLOBL	IO.WVB			;WRITE VIRTUAL BLOCK
	.GLOBL	IS.SUC			;I/O SUCCESS CODE
	.GLOBL	$DSW			;DIRECTIVE STATUS WORD
;
;	RSX11M SYSTEM ROUTINES, VARIABLES.
;
	.GLOBL	$ALOCB			;ALLOCATE CORE BLOCK
	.GLOBL	$DEACB			;DEALLOCATE CORE BLOCK
	.GLOBL	$HEADR			;CURRENT TASK HEADER ADDRESS
	.SBTTL	avl    - MACROS
;
; DEFINE ERROR DECLARATION MACRO.
;
	.MACRO	FATAL	MSG

	TRAP	1
	.ASCIZ	#MSG#
	.EVEN

	.ENDM	FATAL
;
; DEFINE SYSTEM STATE MACRO.
;
	.MACRO	SYSTEM	ADR

	EMT	376
	.WORD	ADR

	.ENDM	SYSTEM
;
; DEFINE FILES-11 QIO MACRO.
;
	.MACRO	F11QIO	DPB,ADR
	DIR$	#DPB

	.IF NB	ADR

	BCS	ADR
	CMPB	#IS.SUC,IOSTAT
	BNE	ADR

	.ENDC

	.ENDM	F11QIO
	.SBTTL	avl    - LOCAL DATA
;
; LOCAL SYMBOLS:
;
;	LOGICAL UNITS/EVENT FLAGS.
;
TSTLUN	= 1				;avl WORKING LUN
TTYLUN	= 2				;TERMINAL I/O LUN
FILLUN	= 3				;FILE I/O LUN
EV.QIO	= 1				;QIO WAIT EVENT FLAG
;
;	SWITCH BIT MASKS.
;
FL.beg	= 1				; begin
FL.siz	= 2				; size
FL.RON	= 4				;READ-ONLY ACCESS
FL.INI = 10				;/INIT SIZE OF VE: TO 0
;
; LOCAL DATA:
;
;	DIRECTIVES.
;
GETCMD:	GMCR$				;GET COMMAND LINE
CREDPB:	QIOW$	IO.CRE,FILLUN,EV.QIO,,IOSTAT,,<FILFDB+F.FNB,CRELST,102400,0,0,0>
ENADPB:	QIOW$	IO.ENA,FILLUN,EV.QIO,,IOSTAT,,<0,0,0,0,0,FILFDB+F.FNB>
DELDPB:	QIOW$	IO.DEL,FILLUN,EV.QIO,,IOSTAT,,<FILFDB+F.FNB,0,0,0,0,0>
FNADPB:	QIOW$	IO.FNA,FILLUN,EV.QIO,,IOSTAT,,<0,0,0,0,0,FILFDB+F.FNB>
ACWDPB:	QIOW$	IO.ACW,FILLUN,EV.QIO,,IOSTAT,,<FILFDB+F.FNB,ACWLST,0,0,100400,0>
DACDPB:	QIOW$	IO.DAC,FILLUN,EV.QIO,,IOSTAT,,<FILFDB+F.FNB,0,0,0,0,0>
WATDPB:	QIOW$	IO.WAT,FILLUN,EV.QIO,,IOSTAT,,<FILFDB+F.FNB,WATLST,0,0,0,0>
ERRDPB:	QIOW$	IO.WVB,TTYLUN,EV.QIO,,,,<ERRMSG,0,40,0,0,0>
;
;	ERROR MESSAGE STRING.
;
ERRMSG:	.ASCIZ	<15><12>/avl -- /
ERRSTR:	.BLKB	40.
	.EVEN
;
;	STT VECTOR TABLE.
;
SSTTBL:	.WORD	0			;ODD ADDRESS
	.WORD	0			;MEMORY PROTECTION
	.WORD	0			;T-BIT TRAP OR BPT
	.WORD	0			;IOT TRAP
	.WORD	0			;RESERVED INSTRUCTION
	.WORD	0			;NON-RSX EMT INSTRUCTION
	.WORD	ERRSRV			;TRAP INSTRUCTION
SSTSIZ	= <.-SSTTBL>/2
;
;	CSI CONTROL BLOCK.
;
CSIBLK:	.BLKB	C.SIZE			;DEFINE CSI EXTENSION BLOCK
	.EVEN
;
;	CSI SWITCH TABLES.
;
SWTTAB:	CSI$SW	BE,FL.beg,,SET,,BEVAL
	CSI$SW	SI,FL.siz,,SET,,SIVAL
	CSI$SW	RO,FL.RON,,SET,,
	CSI$SW	IN,FL.INI,SWIVAL,SET
	CSI$ND			
BEVAL:	CSI$SV	ASCII,STR1,8.
SIVAL:	CSI$SV	ASCII,STR2,8.
	CSI$ND
SWIVAL:	.WORD	0
;
;	FAKE FILE FDB (FOR PARSING PURPOSES).
;
FILFDB:	FDBDF$				;DEFINE FDB BLOCK.
	FDAT$A	R.FIX,,512.		;DEFINE FILE ATTRIBUTES
	FDRC$A	FD.RWM			;DEFINE RECORD ACCESS
	FDBK$A				;DEFINE BLOCK  ACCESS
	FDOP$A	FILLUN	 		;DEFINE OPEN ACCESS
;
;	DEFAULT FILENAME BLOCK.
;
FILDFB:	NMBLK$	,DSK,,SY,0		;DEFAULT FILENAME
;
;	CREATE WRITE ATTRIBUTE LIST.
;
CRELST:	.BYTE	02,02			;WRITE PROTECTION
	.WORD	PROATT			;
	.BYTE	04,16			;WRITE FCS ATTRIBUTES
	.WORD	FILFDB			;
	.BYTE	05,12			;WRITE FILENAME ATTRIBUTES
	.WORD	FILFDB+F.FNB+N.FNAM	;
	.BYTE	0,0			;END-OF-LIST
PROATT:	.WORD	177714			;FILE PROTECTION [RW,RW,,]
;
;	READ ATTRIBUTE LIST.
;
ACWLST:	.BYTE	-11,12			;READ STATISTICS BLOCK
	.WORD	STAATT			;
	.BYTE	0,0			;END-OF-LIST
STAATT:	.BLKB	12			;STATISTICS BLOCK
;
;	WRITE ATTRIBUTE LIST.
;
WATLST:	.BYTE	03,01			;WRITE USER CHARACTERISTICS
	.WORD	WATATT			;
	.BYTE	0,0			;END-OF-LIST
WATATT:	.BYTE	300			;MARK CONTIGIOUS, LOCKED
	.EVEN
;
;	OTHER VARIOUS BUFFERS.
;
IOSTAT:	.WORD	0,0			;I/O STATUS BLOCK
STR1:	.BLKB	8.			;DISK BLOCK STRING begin
STR2:	.BLKB	8.			;DISK BLOCK STRING size
BLKNUM:	.BLKW	2			;DISK BLOCK NUMBER of start
	.BLKW	2			;DISK BLOCK size not needed anymore
UCBADR:	.WORD	0			;VE: UCB ADDRESS
EXTADR:	.WORD	0			;VIRTUAL EXTENSION BLOCK ADDRESS
sizh:	.word 0
sizl:	.word 0
begh:	.word 0
begl:	.word 0
;
;	FSR REGION
;
	FSRSZ$	0			;NO RECORD I/O
	.SBTTL	avl    * MAIN-LINE TASK CODE
;
;+
; THIS SECTION CONTAINS THE ENTRY LEVEL CODE FOR THE avl TASK.
; IN GENERAL, THE STEPS PERFORMED ARE AS FOLLOWS:
;
;	1.  GET THE COMMAND LINE.
;	2.  PARSE COMMAND INTO ELEMENTS.
;	3.  ALLOCATE EXTENSION BLOCK IF VEN: IS AVAILABLE.
;	4.  IF NEW FILE, CREATE FILE OF SPECIFIED SIZE.
;	5.  ASSIGN FILE TO VIRTUAL DISK.
;
; INPUT:
;
;	MCR COMMAND LINE IN FORM SHOWN BELOW.
;
;               avl VEN:=/SW
;
;		VEN:	VIRTUAL DISK TO ASSIGN.
;               /SW     SWITCHES:
;
;                       /RO     ALLOW ONLY READ ACCESS (optional)
;                       /be:beginblock  (necessary)
;                       /si:size        (necessary)
;			/IN	INIT VE: DEV SIZE TO 0 (1ST ASSIGN)
;
; OUTPUT:
;
;       VIRTUAL DISK ASSIGNED TO area on disk  OR ERROR MESSAGE
;	OUTPUT TO USER'S TERMINAL.
;
;-
;
avl::					;REF. LABEL.
;
; SETUP SST VECTOR TABLE AND FSR REGION FOR PROCESSING.
;
	SVTK$S	#SSTTBL,#SSTSIZ		;SETUP SST VECTOR TABLE
	CALL	.FINIT			;INITIALIZE FSR REGION
;
;	ZERO VARIOUS VARIABLES.
;
	CLR	BLKNUM			;CLEAR NUMBER OF BLOCK TO ALLOCATE
	CLR	UCBADR			;CLEAR VEN: UCB ADDRESS
	CLR	EXTADR			;CLEAR EXTENSION BLOCK ADDRESS
;
; GET COMMAND LINE, ERROR IF NONE AVAIABLE.
;
	DIR$	#GETCMD			;GET MCR COMMAND LINE
	BCC	1000$			; IF CC - OK, CONTINUE
	FATAL	<NO COMMAND LINE>	;DECLARE ERROR
;
; SETUP FOR COMMAND PARSING.
;
1000$:	MOV	#GETCMD+G.MCRB,R1	;GET START OF COMMAND LINE
	MOV	$DSW,R2			;GET LENGTH OF COMMAND LINE
1100$:	CMPB	#' ,(R1)+		;SCAN FOR FIRST BLANK CHARACTER
	BEQ	1200$			; IF EQ - FOUND CHARACTER
	SOB	R2,1100$		;LOOP THROUGH ENTIRE LINE
	FATAL	<INVALID COMMAND LINE>	;DECLARE ERROR
;
; CHECK COMMAND FOR SYNTACICAL CORRECTNESS.
;
1200$:	DEC	R2			;CORRECT LINE LENGTH
	CSI$1	#CSIBLK,R1,R2		;CHECK COMMAND LINE SYNTAX
	BCC	1210$			; IF CC - OK, CONTINUE
	FATAL	<COMMAND SYNTAX ERROR>	;DECLARE ERROR
1210$:	BITB	#CS.EQU,C.STAT(R0)	;IS THERE AN EQUAL SIGN?
	BNE	1300$			; IF NE - YES, CONTINUE
	FATAL	<EQUAL SIGN REQUIRED>	;DECLARE ERROR
;
; GET OUTPUT FILENAME. MUST ONLY BE VEX:.
;
1300$:	CSI$2	#CSIBLK,OUTPUT		;GET OUTPUT SPECIFICATION
	BCS	1310$			; IF CS - BAD, ERROR
	BITB	#CS.NMF!CS.DIF!CS.MOR,C.STAT(R0) ;IS OUTPUT ONLY DEVICE?
	BNE	1310$			; IF NE - NO, ERROR
	BITB	#CS.DVF,C.STAT(R0)	;WAS A DEVICE SPECIFIED?
	BEQ	1310$			; IF EQ - NO, ERROR
	MOV	C.DEVD+2(R0),R0		;GET DEVICE FIELD ADDRESS
	CMPB	#'V,(R0)+		;CHECK FIRST CHARACTER OF NAME
	BNE	1310$			; IF NE - BAD, ERROR
	CMPB	#'E,(R0)+		;CHECK SECOND CHARACTER OF NAME
	BNE	1310$			; IF NE - BAD, ERROR
	CALL	$COTB			;CONVERT UNIT NUMBER
	CMPB	#':,R2			;CHECK FOR PROPER TERMINATOR
	BEQ	1400$			; IF EQ - OK, CONTINUE
1310$:	FATAL	<INVALID VIRTUAL DISK NAME>
;
; ASSIGN VIRTUAL DISK TO LUN.
;
1400$:	ALUN$S	#TSTLUN,#"VE,R1		;ASSIGN VIRTUAL DISK
	BCC	1500$			; IF CC - OK, CONTINUE
	FATAL	<VEN: NOT LOADED>	;DECLARE ERROR
;
; PARSE device and unit SPECIFICATION.
;
1500$:	CSI$2	#CSIBLK,INPUT,#SWTTAB	;GET INPUT SPECIFICATION
	BCS	1510$			; IF CS - BAD, ERROR
	BITB	#CS.MOR!CS.WLD,C.STAT(R0) ;CHECK FOR NO MORE/NO WILD-CARDS
	BEQ	1600$			; IF EQ - OK, CONTINUE
1510$:	FATAL	<INVALID INPUT SYNTAX>	;DECLARE ERROR
;
; SETUP FILENAME BLOCK.
;
1600$:	MOV	#FILFDB,R0		;GET FDB ADDRESS
	MOV	#FILFDB+F.FNB,R1	;GET FNB ADDRESS
	MOV	#CSIBLK+C.DSDS,R2	;GET DATASET DESCRIPTOR ADDRESS
	MOV	#FILDFB,R3		;GET DEFAULT FILENAME BLOCK
	CALL	.prsdv			;PARSE device into filename block
	BCC	2000$			; IF CC - OK, CONTINUE
	FATAL	<INVALID INPUT FILENAME>;DECLARE ERROR
;
; ALLOCATE EXTENSION BLOCK AND ASSIGN TO VIRTUAL DISK.
;
2000$:	SYSTEM	2020$			;;ENTER SYSTEM STATE
	MOV	$HEADR,R5		;;GET OUR TASK HEADER
	MOV	H.LUN(R5),R5		;;GET VE: UCB ADDRESS
	.IF	NDF,M$VE$$
	TST	U.NXT(R5)		;;IS VCB ALLOCATED?
	BNE	2010$			;; IF NE - YES, ERROR
	.IFF
	.ENDC
	MOV	R5,UCBADR		;;MARK GOOD UCB FOUND
	MOV	#X.LGTH,R1		;;SET EXTENSION BLOCK LENGTH
	.IF	DF,M$VE$$
	TST	U.NXT(R5)		;;IS THERE AN EXTENSION FROM PREV AVE?
	BEQ	2004$			;;IF EQ NO, ALLOCATE THE FIRST
	MOV	U.NXT(R5),R0
	MOV	R0,EXTADR		;;SAVE ADDRESS OF EXTENSION TOO
	BR	2005$
	.ENDC
2004$:	CALL	$ALOCB			;;ALLOCATE EXTENSION BLOCK
	BCS	2010$			;; IF CS - NO POOL, ERROR
	MOV	R0,U.NXT(R5)		;;ALLOCATE UCB
	MOV	R0,EXTADR		;; AND RETURN BLOCK ADDRESS
	.IF	DF,M$VE$$
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	TST	(R0)+		;PASS FLAG OF EXTENSION BLOCK
;MUST CLEAR N.FIL * 5 WORDS
	MOV	#X.NFIL*5,R1	;NO. WORDS TO ZERO
2006$:	CLR	(R0)+
	DEC	R1
	BGT	2006$
	CLR	U.CW2(R5)
	CLR	U.CW3(R5)	;;ZERO SIZE TOO
	MOV	(SP)+,R0
	MOV	(SP)+,R1	;;CLEAR ALL OF FILE SIZES, OFFSETS, UCB ADDRS
	BR	2007$
XX.XXX=10.*X.NFIL
2005$:	TST	XX.XXX(R0)	;;SEE IF 8TH FILE FILLED IN ALREADY
	BEQ	2007$		;;IF SO, ERROR TO DO ANY MORE
	CLR	UCBADR
2007$:
	.ENDC
	.IF	DF,O$WNRS
	CLR	U.TIU(R5)	;CLEAR OWNER TI UCB FLAG
	CLR	U.PWD(R5)	;AND PASSWORD FOR CHANGING IT.
	.ENDC
2010$:	RETURN				;;RETURN TO USER STATE
2020$:	TST	UCBADR			;WAS DISK ALLOCATED?
	BNE	2030$			; IF NE - YES, CONTINUE
	FATAL	<VEN: ALREADY ASSIGNED>	;DECLARE ERROR
2030$:	TST	EXTADR			;WAS EXTENSION BLOCK ALLOCATED?
	BNE	3000$			; IF NE - YES, CONTINUE
	FATAL	<POOL ALLOCATION FAILED>;DECLARE ERROR
;
;
3000$:	BIT	#FL.beg,CSIBLK+C.MKW1	; beg switch
	BEQ	3021$			; IF EQ - NO, stop
	MOV	#str1,R4		;GET START OF begin STRING
	MOV	R4,R5			;COPY START OF STRING
	MOV	#8.,R3			;SET size OF STRING
3001$:	TSTB	(R4)+			;SCAN FOR NULL CHARACTER
	BEQ	3002$			; IF EQ - FOUND END OF STRING
	SOB	R3,3001$		;LOOP TILL DONE
	BR	3030$			; IF NO NULL, BAD begin STRING
3002$:	SUB	#str1+1,R4		;GET LENGTH OF STRING
	MOV	#begh,R3		;GET STORAGE SPACE
	CALL	.DD2CT			;CONVERT NUMBER TO BINARY
	BCS	3035$			; IF CS - CONVERSION ERROR
;;	mov r0,begh
;;	mov r1,begl
	nop
	nop
	nop
	nop

3200$:	BIT	#FL.siz,CSIBLK+C.MKW1	;IS  disk size specified
	BEQ	3030$			; IF EQ - NO, stop
	MOV	#str2,R4		;GET START OF SIZE STRING
	MOV	R4,R5			;COPY START OF STRING
	MOV	#8.,R3			;SET SIZE OF STRING
3201$:	TSTB	(R4)+			;SCAN FOR NULL CHARACTER
	BEQ	3202$			; IF EQ - FOUND END OF STRING
	SOB	R3,3201$		;LOOP TILL DONE
	BR	3030$			; IF NO NULL, BAD SIZE STRING
3202$:	SUB	#str2+1,R4		;GET LENGTH OF STRING
	MOV	#sizh,R3		;GET STORAGE SPACE
	CALL	.DD2CT			;CONVERT NUMBER TO BINARY
	BCS	3035$			; IF CS - CONVERSION ERROR
;;	mov r0,sizh
;;	mov r1,sizl

	nop
	nop
	nop
	nop

	BR	4010$			; CONTINUE ON SUCCESS
3020$:	
3021$:	FATAL	<bad begin>		;DECLARE ERROR
3030$:	FATAL	<bad disk size>		;DECLARE ERROR
3035$:	FATAL	<number conversion error>
;
; LOOKUP SPECIFIED FILE.
;
;;4000$:	F11QIO	FNADPB,4001$		;ISSUE FIND REQUEST
;;	BR	4010$			; CONTINUE ON SUCCESS
;;4001$:	FATAL	<FILE NOT FOUND>	;DECLARE ERROR
;;;
;;; ACCESS AND DEACESS FILE, GET SIZE AND STARTING BLOCK NUMBER
;;;
;;4010$:	F11QIO	ACWDPB,4011$		;ISSUE ACCESS REQUEST
;;	F11QIO	DACDPB,4011$		; AND DEACCESS FILE (LOCKED)
;;	F11QIO	WATDPB,4011$		; AND LOCK FILE
;;	BR	4020$			; CONTINUE ON SUCCESS
;;4011$:	FATAL	<FILE ACCESS FAILED>	;DECLARE ERROR
;;;
;;; CHECK THAT FILE IS CONTIGIOUS AND STORE OFFSET, SIZE IN UCB.
;;;
4010$:
4020$:	MOV	UCBADR,R5		;GET UCB ADDRESS
	MOV	EXTADR,R4		; AND EXTENSION BLOCK
	.IF	DF,M$VE$$
	ADD	#2,R4			;PASS X.FLG
4021$:	TST	2(R4)			;FIND A VACANT SLOT
	BEQ	4022$			;IF THIS IS (LOW BLK COUNT=0) GO
	ADD	#10.,R4			;PASS THIS BLOCK ELSE
	BR	4021$			;THEN KEEP LOOKING
4022$:
	.ENDC
	MOV	begh,(R4)+		;STORE BLOCK OFFSET
	MOV	begl,(R4)+		; AND LOW PART
	.IF	DF,M$VE$$
	MOV	SIZH,(R4)+
	MOV	SIZL,(R4)+
	.IFF
4030$:	MOV	sizh,U.CW2(R5)		;STORE SIZE OF FILE (DISK)
	MOV	sizl,U.CW3(R5)		; AND LOW PART
	.IFT
	BIT	#FL.INI,SWIVAL		;WAS /IN SWITCH SET TO ZERO SIZE FIRST?
	BEQ	4038$			;IF EQ NO
	CLR	U.CW2(R5)
	CLR	U.CW3(R5)		;ELSE YES, ZERO SIZES
4038$:
	MOV	U.CW2(R5),-(SP)
	BIS	U.CW3(R5),(SP)		;TEST FOR 0 ALREADY THERE
	TST	(SP)+
	BEQ	4035$
;ACCOUNT FOR EXTRA DISKS BY ADDING 1 MORE BLOCK ONTO SIZE PROVIDED
;THAT SIZE WAS NOT 0 AT START.
	ADD	#1,U.CW3(R5)
	ADC	U.CW2(R5)		;ADD COUNT OF 1 FOR "BAD" END BLK
4035$:
	ADD	SIZL,U.CW3(R5)		;COUNT UP DISK SIZE
	ADC	U.CW2(R5)		;TO 32 BITS
	ADD	SIZH,U.CW2(R5)
	MOV	R4,NUCBAD		;SAVE ADDRESS FOR THE "NEXT UCB"
	.IFTF
	TST	(R4)+			;SKIP NEXT UCB ADDRESS
	.IFT
	MOV	EXTADR,R4
	.ENDC
	CLR	(R4)+			;CLEAR EXTENSION FLAGS
	BIT	#FL.RON,CSIBLK+C.MKW1	;SHOULD WE MARK READ-ONLY?
	BEQ	4040$			; IF EQ - NO, SKIP
	BIS	#XF.RON,-2(R4)		;SET READ-ONLY ACCESS
4040$:	MOV	#FILFDB+F.FNB,R1	;GET FILENAME BLOCK
	MOV	#S.FNB/2,R2		;GET SIZE OF FILENAME BLOCK
	.IF	DF,M$VE$$
	MOV	EXTADR,R4
	ADD	#X.FNB,R4		;POINT AT FILENAME BUFFER
	TST	X.FLG+10.+2(R4)		;LOW OFFSET NONZERO FOR LATER ENTRY?
	BNE	4046$			;IF SO FILL IN NO FILENAME
	.IFTF
4041$:	MOV	(R1)+,(R4)+		;STORE FILENAME BLOCK
	SOB	R2,4041$		;LOOP TILL DONE
4046$:
	.ENDC
	SYSTEM	4050$			;;ENTER SYSTEM STATE
	MOV	$HEADR,R0		;;GET OUR FILE HEADER
	ADD	#<FILLUN-1>*4+H.LUN,R0	;;POSITION TO FILE'S UCB POINTER
	MOV	(R0),R0			;;GET FILE'S UCB ADDRESS
4042$:	MOV	U.RED(R0),R1		;;GET REDIRECT UCB
	CMP	R0,R1			;;IS THIS LAST REDIRECTION
	BEQ	4043$			;; IF EQ - YES, SKIP
	MOV	R1,R0			;;COPY UCB ADDRESS
	BR	4042$			;; AND LOOP AGAIN
4043$:	MOV	EXTADR,R4		;;GET EXTENSION BLOCK
	.IF	DF,M$VE$$
	MOV	R0,@NUCBAD
	.IFF
	MOV	R0,X.UCB(R4)		;;STORE NEXT UCB IN EXTENSION BLOCK
	.ENDC
	BICB	#US.OFL,U.ST2(R5)	;;MARK DISK ENABLED
	RETURN				;;RETURN TO USER STATE
4050$:	EXIT$S				;ALL DONE, EXIT
	.IF	DF,M$VE$$
NUCBAD:	.WORD	0	;STORAGE FOR UCB ADDRESS AS NEEDED
	.ENDC
	.SBTTL	ERRSRV * ERROR MESSAGE PROCESSING
;
;+
; THIS ROUTINE IS ENTERED BY AN SST TRAP INSTRUCTION. IT OUTUTS
; THE ERROR MESSAGE AND EXITS THE TASK. IF THE VIRTUAL DISK IS
; ALLOCATED, THE EXTENSION BLOCK IS DEALLOCATED.
;
; INPUTS:
;
;	THE TRAP CAUSED BY THE FATAL MACRO. THE STACK SHOULD
;	BE SETUP AS SHOWN BELOW:
;
;		SP+04	PS
;		SP+02	PC OF TRAP+2
;		SP+00	TRAP OPERAND*2
;
;	THE TRAP INSTRUCTION IS FOLLOWED BY THE ASCIZ ERROR MESSAGE.
;
; OUTPUTS:
;
;	THE ERROR MESSAGE IS OUTPUT TO THE USER'S TERMINAL AND
;	THE TASK EXITS. ANY ALLOCATED EXTENSION BLOCK IS RETURNED.
;-
;
ERRSRV:	MOV	UCBADR,R5		;GET UCB ADDRESS
	BEQ	1000$			; IF EQ - NO UCB, NO EXTENSION BLOCK
	MOV	EXTADR,R0		;GET EXTENSION BLOCK ADDRESS
	BEQ	1000$			; IF EQ- NO EXTENSION BLOCK
	SYSTEM	1000$			;;ENTER SYSTEM STATE
	CLR	U.NXT(R5)		;;MARK DISK NOT ALLOCATED
	.IF	DF,M$VE$$
	CLR	U.CW2(R5)		;;ZERO SIZE OF VE: TOO
	CLR	U.CW3(R5)
	.ENDC
	MOV	#X.LGTH,R1		;;GET BLOCK SIZE
	CALLR	$DEACB			;;DEALLOCATE EXTENSION BLOCK
1000$:	MOV	#ERRSTR,R0		;GET START OF VARIABLE ERROR
	MOV	2(SP),R1		;GET START OF ERROR MESSAGE
1100$:	MOVB	(R1)+,(R0)+		;MOVE ERROR MESSAGE
	BNE	1100$			; AND LOOP IF NOT DONE
	MOVB	#15,-1(R0)		;MOVE IN EXTRA <CR>
	MOVB	#12,(R0)+		;MOVE IN EXTRA <LF>
	SUB	#ERRMSG,R0		;GET LENGTH OF STRING
	MOV	R0,ERRDPB+Q.IOPL+2	;STORE IN QIO DPB
	DIR$	#ERRDPB			;ISSUE OUTPUT
	EXIT$S				;EXIT TASK

	.END	avl