.TITLE	FILHDR
;
; TASK TO DELETE, UNLOCK OR DETERMINE THE STATUS OF A DISK FILE.
; RECEIVES A DATA BLOCK DEFINING THE FILENAME AND TYPE OF REQUEST.
; 1ST WORD OF DATA BLOCK CONTAINS THE TYPE OF REQUEST AND AN INDICATOR
; IF FILE ATTRIBUTE INFORMATION IS DESIRED.  2ND WORD IS THE NUMBER OF
; CHARACTERS IN FILENAME.  REMAINDER OF BLOCK IS THE FILENAME.
; TASK WILL SEND AN ERROR RETURN INDICATOR TO AND RESUME THE REQUESTING
; TASK.  IF FILE ATTRIBUTES WERE REQUESTED, TWO ADDITIONAL WORDS WILL BE
; SENT CONTAINING F.RTYP, F.RATT AND F.RSIZ)
; 
; WRITTEN   NOVEMBER 1975   R B FRENCH   THE BOEING COMPANY
; MODIFIED  FEBRUARY 1976   R B FRENCH   (UNLOCK ANOTHER UIC)
;
; MODIFIED  JAN 1978        W W WOODS    (RETURN USERS DEFAULT UFD)
;
;	IF FILENAME STARTS WITH '$U', THEN THE DEFAULT UFD IS RETURNED.
;	THE GLUN$ DIRECT IS ISSUED TO DETERMINE THE USERS TERMINAL.
;	   LUN 2 MUST BE ASSINED TO TI:
;	THE USER TERMINAL TABLE (UTN) IS SEARCHED FOR MATCHING TERMINAL.
;	   (UTN IS CONTAINED IN THE GLOBAL COMMON AREA 'IASCOM')
;	THE UFD IS RETURNED AS FOLLOWS:
;
;		BUF+  6 = DEFAULT DEVICE UNIT (BYTE)
;		BUF + 10 = DEFAULT UIC (OCTAL INTEGER)
;
;
; TASK BUILD FILE
;
;   FILHDR/PR/-FP=FILHDR,[1,1]EXEC.STB
;   /
;   UNITS=2				;WWW
;   PRI=150
;   STACK=32
;   LIBR=IASCOM:RO		;WWW
;   LIBR=SYSRES:RO
;
	.MCALL	DELET$,FINIT$,CSI$1,CSI$2,FSRSZ$,FDBDF$,FDOP$A,NMBLK$
	.MCALL	DIR$,QIOW$,VRCX$,VSDR$,CLOSE$,GLUN$S
FILHDR:	FINIT$			;INITIALIZE FSR
RCVDAT:	DIR$	#VRCX		;RECEIVE DATA OR EXIT
	MOV	TASK,VSDR+S.DRTN ;PUT TASK NAME IN SEND DPB
	MOV	TASK+2,VSDR+S.DRTN+2
;			CHECK IF DEFAULT UFD REQUESTED  WWW
	CMPB	DOL,BUF+4	;FILENAME START WITH $ ? WWW
	BNE	1$		;BRANCH IF NO   WWW
	JMP	UFD		;GO GET UFD INFO WWW
1$:				;                WWW
; * * * * * * * * * * * * * * * * * * * * * * * * * * * WWW
	CSI$1	#CSIBLK,#BUF+4,BUF+2 ;CSI1 IT
	BCC	CSI2		;IF ALL OK, GO DO CSI2
SYNERR:	MOV	#-1,R1		;-1 MEANS BAD PARAMETERS
	BR	DONE
CSI2:	CSI$2	#CSIBLK,OUTPUT	;CSI2 IT
	BCS	SYNERR		;SYNTAX ERROR IF NOT OKAY
	MOV	#FDB,R0		;FDB ADDRESS IN R0
	MOV	#FDB+F.FNB,R1	;FNB ADDRESS IN R1
	MOV	#CSIBLK+C.DSDS,R2 ;DATASET POINTER IN R2
	MOV	#DNMBLK,R3	;DEFAULT NAMEBLOCK ADDRESS IN R3
	JSR	PC,.PARSE	;PARSE IT
	BCC	FIND		;IF ALL OK, GO SET UP FOR FIND
FCPERR:	MOV	FDB+F.ERR,R1	;PUT ERROR FLAG IN IERR
	BR	DONE
FIND:	JSR	PC,.FIND	;TRY TO FIND FILE
	BCC	FOUND		;CARRY CLEAR MEANS IT'S THERE
NSFERR:	CMPB	#-26.,FDB+F.ERR	;IS ERROR NO SUCH FILE (-26.)?
	BNE	FCPERR		;IF NOT, IT'S SOME OTHER FCP ERROR
	MOV	#1,R1		;1 MEANS NO SUCH FILE
	BR	DONE
FOUND:	CLR	R1		;CLEAR ERROR RETURN
	CMPB	DELFLG,BUF	;DELETE REQUEST?
	BNE	UNLOCK		;BRANCH IF NOT
	DELET$			;DELETE THE FILE
	BCS	FCPERR		;CHECK FOR ERRORS
	BR	DONE
UNLOCK:	CMPB	UNLFLG,BUF	;UNLOCK REQUEST?
	BNE	DATA
	MOV	#RDCHAR,QIOW+Q.IOPL+2 ;READ CHARACTERISTICS BLOCK IN DPB 
	DIR$	#QIOW		;READ THE CHARACTERISTICS
	BCS	FCPERR		;CHECK IF ALL OK
	BIT	#100,LOCBIT	;IS FILE LOCKED?
	BNE	10$		;BRANCH IF IT IS
	MOV	#2,R1		;2 MEANS FILE NOT LOCKED
	BR	DATA
10$:	MOV	#RDSTAT,QIOW+Q.IOPL+2 ;READ STATISTICS BLOCK IN DPB
	DIR$	#QIOW		;READ STATISTICS
	BCS	FCPERR
	TST	STAT+10		;IS FILE CURRENTLY IN USE?
	BEQ	20$		;NOPE, GO UNLOCK IT
	MOV	#3,R1		;3 MEANS FILE IS BEING ACCESSED
	BR	DATA
20$:	BITB	#CS.DIF,CSIBLK+C.STAT ;UIC GIVEN?
	BEQ	30$		;BRANCH IF NOT
	MOV	.CRTSK,R0	;GET ATL NODE ADR
	MOV	A.HA(R0),@#177642 ;CHANGE PAR1
	MOV	#77406,@#177602	;CHANGE PDR1
	MOV	#403,20000+H.UIC ;CHANGE HEADER UIC TO [1,3]
30$:	BIC	#100,LOCBIT	;CLEAR FILE LOCKED BIT
	MOV	#IO.WAT,QIOW+Q.IOFN ;WRITE ATTRIBUTES FUNCTION CODE IN DPB
	MOV	#WRCHAR,QIOW+Q.IOPL+2 ;WRITE CHARACTERISTICS BLOCK IN DPB
	DIR$	#QIOW		;DO IT
	BCS	FCPERR		;CHECK IF ALL OK
	CLR	R1		;CLEAR ERROR RETURN
DATA:	CMPB	DATFLG,BUF+1	;ATTRIBUTES REQUESTED?
	BNE	DONE		;BRANCH IF NOT
	MOV	#IO.RAT,QIOW+Q.IOFN ;READ ATTRIBUTES FUNCTION CODE
	MOV	#RDATRB,QIOW+Q.IOPL+2 ;READ ATTRIBUTES BLOCK IN DPB
	DIR$	#QIOW		;READ 'EM
	BCS	FCPERR
DONE:	MOV	R1,BUF		;ERROR FLAG IN R1
	MOV	TIADDR,S.DRTI+VSDR	;PUT TI INDICATOR INTO LIST
	DIR$	#VSDR		;SEND DATA AND RESUME
	CLOSE$	#FDB
	JMP	RCVDAT
; * * * * * * * * * * * * * * * * * * * *  * * * * * * * * WWW
;  ROUTINE TO SEARCH UTN FOR DEFAULT UFD                   WWW
;
UFD:
	CMPB	CCC,BUF+5	;THIS DESPOOL CARDREADER REQUEST?
	BEQ	DESPOL		;BRANCH IF YES
	MOV	.CRTSK,R1
	MOV	A.TI(R1),R1
	MOVB	U.UN(R1),LUNBUF+2
	MOV	U.DN(R1),LUNBUF
	CMPB	TTT,BUF+5	;IS THIS A TT UNIT REQUEST
	BNE	1$		;BRANCH IF NOT
	CLR	BUF+2		;CLEAR TT UNIT NUMBER
	MOVB	LUNBUF+2,BUF+2	;SET TO TT UNIT NUMBER
	JMP	DONE
1$:
;
	MOV	.CITHD,R1	;ADDRESS OF FIRST CIT
6$:	MOV	C.ST(R1),R3	;GET STD ENTRY 
	CMP	PDS,S.TN+2(R3)	;THIS PDS CLI?
	BEQ	4$		;BRANCH IF IT IS
	ADD	#C.PM+2,R1	;POINT TO NEXT CLI TABLE
	BR	6$		;GO SEE IF THIS ONE IS PDS
4$:
	MOV	R1,R3		;SAVE FOR END TEST
	ADD	#C.TU,R3	;POINTS TO LAST UTN
	MOV	C.TL(R1),R1	;IST UTN TO PROCESS
3$:	CMPB	LUNBUF+2,I.TT(R1) ;TERMINAL UNIT NUMBERS MATCH?
	BNE	5$		;BRANCH IF NOT
	CMP	LUNBUF,I.DN(R1)	;DOES TERMINAL TYPE AGREE?(TT OR BA)
	BNE	5$		;BRANCH IF NOT
;
;		FOUND UTN
;
	CMPB	SSS,BUF+5	;THIS A SET UFD REQUEST?
	BEQ	SET		;BRANCH IF YES
	CMPB	NNN,BUF+5	; THIS A USER NAME REQUEST?
	BEQ	NAME		;BRANCH IF YES
	MOV	I.DU(R1),BUF+4  ;GET DEFAULT UIC
	MOV	I.SY(R1),R1		;GET PUD ADDRESS
	MOVB	U.UN(R1),BUF+2	;GET DISK UNIT NUMBER
	CLR	R1		;SET NO ERROR
	JMP	DONE		;GO EXIT
;
5$:	MOV	2(R1),R1	;GET NEXT UTN
	CMP	R3,R1		;ALL  UTN'S CHECKED?
	BNE	3$		;BRANCH IF NOT
	MOV	#20,R1	;SET ERROR CODE
DEC:	CLR	BUF+2		;SET DEFAULT DISK TO DB0:
	MOV	#100200,BUF+4	;SET DEFAULT UIC=[200,200]
	JMP	DONE		;LEAVE COULD NOT FIND UTN
;
;	SET UFD REQUEST
;
SET:	MOV	.PUDBA,R2	;GET START OF PUD'S
COTSCN:	CMP	#"DB,U.DN(R2)	;THIS A DISK PUD?
	BEQ	FNDDEV		;YES, BRANCH
NXTPUD:	ADD	#U.SZ,R2	;INCREMENT TO NEXT PUD
	CMP	R2,.PUDEA	;THIS THE END?
	BEQ	NTFND		;BRANCH IF YES
	BR	COTSCN		;GO LOOK AT THIS PUD
FNDDEV:	CMPB	BUF+6,U.UN(R2)  ;THIS THE RIGHT DISK
	BNE	NXTPUD		;BRANCH IF NOT
	MOV	R2,I.SY(R1)	;PUT PUD INTO UTN NODE
NTFND:	MOV	BUF+10,I.DU(R1) ;PUT UIC INTO UTN NODE
	CLR	R1
	JMP	DONE
;
NAME:
	ADD	#I.UN,R1	;R1 POINTS TO USER NAME - 12 BYTES
	MOV	#BUF+2,R2	;R2 POINTS TO OUTPUT AREA
	MOV	#6,R3		;SET TO MOVE 12 BYTES - 2 AT A TIME
1$:	MOV	(R1)+,(R2)+	;MOVE USERNAME TO OUTPUT BUFFER
	SOB	R3,1$
	CLR	R1
	MOV	#6,S.DRBL+VSDR	;SET TO RETURN 6 WORDS
	JMP	DONE
;
DESPOL:
	MOV	#"CR,R3		;SET TO FIND CARDREADER PUD
	JSR	PC,PUDSCN	;GET THE PUD INTO R2
	MOV	R2,U.RP(R2)	;REDIRECT TO SELF
	BIC	#6000,U.C1(R2)	;SET NOT SPOOLED
	JMP	DONE
;
;
PUDSCN:
	MOV	.PUDBA,R2	;START OF PUDS
PUDCON:	CMP	R3,U.DN(R2)	;THIS THE RIGHT ONE?
	BEQ	2$		;BRANCH IF MATCH
	ADD	#U.SZ,R2	;POINT TO NEXT PUD
	CMP	R2,.PUDEA	;THIS THE END?
	BNE	PUDCON		;BRANCH IF NOT
2$:	RTS	PC
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * WWW
VRCX:	VRCX$	,TASK,17.,TIADDR
TASK:	.BLKW	2
BUF:	.BLKW	17.
VSDR:	VSDR$	,,,,,BUF,3,,,TIADDR
QIOW:	QIOW$	IO.RAT,1,1,,,,<FDB+F.FNB,0>
STAT:	.BLKW	5		;BUFFER FOR STATISTICS BLOCK
TIADDR:  .WORD  0
RDCHAR:	.BYTE	-3,1
	.WORD	LOCBIT
	.WORD	0
WRCHAR:	.BYTE	3,1		;WRITE ATTRIBUTES CODE FOR FILE CHARACTERISTICS
	.WORD	LOCBIT		;LOCK BIT IS IN 14TH BYTE
	.WORD	0
RDSTAT:	.BYTE	-11,12
	.WORD	STAT
	.WORD	0
RDATRB:	.BYTE	-4,4
	.WORD	BUF+2
	.WORD	0
LOCBIT:	.BYTE	0
UNLFLG:	.BYTE	1		;UNLOCK FLAG
DELFLG:	.BYTE	2		;DELETE FLAG
DATFLG:	.BYTE	1		;DATA REQUEST FLAG
CSIBLK:	.BLKB	C.SIZE		;CSI BLOCK
	FSRSZ$	1,0		;ONE LUN - ZERO LENGTH BUFFER, SINCE IT WON'T BE OPENED
FDB:	FDBDF$			;START OF FDB
	FDOP$A	1,CSIBLK+C.DSDS,DNMBLK
DNMBLK:	NMBLK$	,,,SY,0		;DEFAULT FILENAME BLOCK
; * * * * * * * * * * * *  * * * * * * * * * * * * * * * * * WWW
.EVEN
LUNBUF:	.WORD	6
	.BLKW 5
PDS:	.RAD50	/PDS/
SSS:	.ASCII /S/
DOL:	.ASCII /$/
TTT:	.ASCII	/T/
CCC:	.ASCII	/C/
NNN:	.ASCII	/N/
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * WWW
	.END	FILHDR