.TITLE	CREFIL - CREATE FILE
	.IDENT	/01.00/
	.LIST	MEB
	.PSECT	CREFIL
;
; AUTHOR:	H. L. COLEMAN
;		MILLIKEN AND COMPANY
;		P. O. BOX 1926
;		MAIL STOP M-103
;		SPARTANBURG, S. C. 29304
;		(803)573-2556
;
; VERSION:	01.00
;
; DATE:		02/01/78
;
; MODIFICATIONS:
;
; FUNCTION:	CREATE A FILE ON DISK AND ENTER ITS NAME IN THE PROPER
;		DIRECTORY.
;
; INPUT:
;
;	R0 = A(PARAMETER LIST)
;
;	PARAMETER LIST FORMAT:
;
;	OFFSET	LENGTH	CONTENTS
;	  +01	  01	FLAGS
;		  BIT	MEANING IF SET
;		   0	FILE MUST BE CONTIGUOUS
;		   1	PLACEMENT CONTROL REQUIRED
;		   2	ANY ALLOCATION IF PLACEMENT FAILS
;		   3	NOT USED
;		   4	NOT USED
;		   5	NOT USED
;		   6	NOT USED
;		   7	NOT USED
;
;	  +00	  03	FILE SIZE
;	  +05	  01	NOT USED
;	  +04	  03	STARTING LBN DESIRED
;	  +10	  02	A(FILE NAME BLOCK)
;	  +12	  02	A(DUMMY FDB)
;
; OUTPUT:
;
;	R0 = STATUS CODE
;		VALUE	MEANING
;		  00	FILE CREATED - PARAMETER LIST + 5 CONTAINS LBN
;		  02	FILE CREATED BUT NOT PLACED - PARAMETER LIST + 5 HAS LBN
;		  04	ALLOCATION ERROR
;		  06	DEVICE FULL
;		  10	INDEX FILE FULL
;		  12	ANY OTHER ERROR
;
;	R1 = IOSB STATUS
;
	.MCALL	QIOW$S,QIOW$,CKDSW$S,DIR$,QIOSY$
	QIOSY$
	.PAGE
; CONSTANTS AND WORK AREAS
;
CREDPB:	QIOW$	IO.CREA,2,2,,IOSB,,<,ATRLIS,225*400>
PLABUF:	.WORD	0,0,0		;PLACEMENT CONTROL BUFFER
ATRLIS:	.BYTE	16,6		;PLACEMENT CONTROL
	.WORD	PLABUF		;A(PLACEMENT CONTROL BUFFER)
	.BYTE	4,16		;WRITE RECORD I/O AREA
ATRFDB:	.WORD	0		;A(DUMMY FDB)
PLAOVR:	.WORD	0
IOSB:	.WORD	0,0
	.PAGE
CREFIL:	MOV	R5,-(SP)	;SAVE REGISTERS
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R0,R5		;R5 = A(PARAMETER LIST)
	CLR	PLAOVR		;INITILIZE FLAG
	MOVB	0(R5),CREDPB+20 ;PUT FILE SIZE IN DPB
	MOV	2(R5),CREDPB+22
	MOV	#4,PLABUF	;ASSUME PLACEMENT CONTROL
	MOVB	4(R5),PLABUF+2	;MOVE IN STARTING LBN
	MOV	6(R5),PLABUF+4
	MOV	10(R5),R4	;R4 = A(FILE NAME BLOCK)
	MOV	R4,CREDPB+14	;INSERT A(FNB)
	MOV	12(R5),R3	;R3 = A(DUMMY FDB)
	MOV	R3,ATRFDB	;INSERT A(DUMMY FDB)
	BIT	#1,1(R5)	;CONTIGUOUS ALLOCATION?
	BNE	1000$		;IF NE, YES
	BIC	#5,CREDPB+21	;CLEAR CONTIGUOUS REQUEST
1000$:	BIT	#2,1(R5)	;PLACEMENT REQUIRED?
	BEQ	1200$		;IF EQ, NO
1100$:	DIR$	#CREDPB		;TRY TO CREATE THE FILE
	CKDSW$S	1100$,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB	;DID WE GET IT CREATED?
	BEQ	1700$		;IF EQ, YES
	CMPB	#IE.ALC,IOSB	;ALLOCATION FAILURE?
	BNE	1400$		;IF NE, NO
	BIT	#4,1(R5)	;CAN WE TRY ANYWHERE?
	BEQ	1400$		;IF EQ, NO
1200$:	MOV	#6,PLABUF	;ANY PLACE WILL DO
	CLR	PLABUF+2
	CLR	PLABUF+4
	DEC	PLAOVR		;SET PLACEMENT OVERIDE FLAG
1300$:	DIR$	#CREDPB		;TRY TO CREATE THE FILE
	CKDSW$S	1300$,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB	;DID WE GET IT CREATED?
	BEQ	1700$		;IF EQ, YES
1400$:	MOV	IOSB,R1		;R1 = IOSB STATUS
	CLR	R0		;INITILIZE STATUS RETURN
	CMPB	#IE.ALC,R1	;ALLOCATION FAILURE?
	BEQ	1599$		;IF EQ, YES
	CMPB	#IE.DFU,R1	;DEVICE FULL?
	BEQ	1598$		;IF EQ, YES
	CMPB	#IE.IFU,R1	;INDEX FILE FULL?
	BEQ	1597$		;IF EQ, YES
	INC	R0		;VECTOR TO SET RETURN STATUS
1597$:	INC	R0
1598$:	INC	R0
1599$:	INC	R0
	INC	R0
	ASL	R0		;TIMES 2
1600$:	MOV	(SP)+,R2	;RESTORE REGISTERS
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RETURN			;RETURN TO CALLER
1700$:	QIOW$S	#IO.ENA,#2,#2,,#IOSB,,<,,,,,R4> ;ENTER FILE IN DIRECTORY
	CKDSW$S	1700$,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB	;NAME ENTERED?
	BEQ	2000$		;IF EQ, YES
	MOV	IOSB,R1		;SAVE IOSB CODE
1800$:	QIOW$S	#IO.DEL,#2,#2,,#IOSB,,<R4> ;DELETE THE FILE
	CKDSW$S	1800$,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB	;DELETED?
	BEQ	1900$		;IF EQ, YES
	CALL	ABORT		;ABORT THE TASK
1900$:	MOV	R1,IOSB		;RESTORE IOSB
	BR	1400$		;GO RETURN ERROR
2000$:	MOV	PLABUF,4(R5)	;RETURN LBN TO CALLER
	MOV	PLABUF+2,6(R5)
	CLR	R0		;ASSUME PLACEMENT OK
	BIT	#2,1(R5)	;WAS PLACEMENT REQUESTED?
	BEQ	1600$		;IF EQ, NO
	TST	PLAOVR		;PLACEMENT OVERRIDDEN?
	BEQ	1600$		;IF EQ, NO
	TST	(R0)+		;SET RETURN SATAUS 2
	BR	1600$		;RETURN
ABORT:	HALT
	.END