.TITLE	CRFIL - CREATE FILE
	.IDENT	/01.00/
	.LIST	MEB
	.PSECT	CRFIL
;
; 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:		8-FEB-78
;
; MODIFICATIONS:
;
; FUNCTION:	CREATE A FILE ON A FILES 11 DEVICE AND ENTER ITS NAME IN
;		THE PROPER DIRECTORY.
;
; INPUT:
;	R0 = A(PARAMETER LIST)
;
; OUTPUT:
;
;	IF CC - FILE WAS CREATED
;
;		IF VC - PLACEMENT AS REQUESTED.
;		IF VS - PLACEMENT WAS NOT POSSIBLE.
;
;	IF CS - FILE WAS NOT CREATED
;
;		R0 = ERROR CODE
;
;		VALUE	MEANING
;		 02	FILE SPECIFICATION CONTAINS WILD CARDS
;		 04	DIRECTORY NOT FOUND
;		 06	I/O ERROR FINDING DIRECTORY - R1 = IOSB CODE
;		 10	ALLOCATION FAILURE
;		 12	DEVICE FULL
;		 14	INDEX FILE FULL
;		 16	I/O ERROR ON CREATE - R1 = IOSB CODE
;
; PARAMETER LIST FORMAT:
;
;	OFFSET	LENGTH	CONTENTS
;	  00	  02	A(PARSE BUFFER - $PARFL FORMAT)
;	  02	  02	A(DUMMY FDB - FIRST 14. BYTES)
;	  04	  02	LUN ASSIGNED TO DEVICE
;	  06	  04	FILE SIZE
;	  12	  04	STARTING LBN IF PLACEMENT DESIRED
;	  16	  02	FLAGS
;			BITS	MEANING IF SET
;			   0	FILE MUST BE CONTIGUOUS.
;			   1	PLACEMENT REQUIRED
;			   2	ANY ALLOCATION IF PLACEMENT FAILS
;			3-15	NOT USED
;	  20	  02	ACTUAL STARTING LBN
;
	.PAGE
; MACRO CALLS AND SYSTEM OFFSET AND BIT DEFINITIONS
;
	.MCALL	DIR$,QIOW$,QIOW$S,CKDSW$S
	.MCALL	FDOF$L,NBOF$L,FCSBT$,QIOSY$
	FDOF$L			;DEFINE FCS OFFSETS
	NBOF$L			;DEFINE FNB OFFSETS
	FCSBT$			;DEFINE FCS BITS
	QIOSY$			;DEFINE QIO FUNCTION AND ERROR CODES
	.PSECT	CRFIL
	.PAGE
; LOCAL OFFSET AND BIT DEFINITIONS
;
PL.PBF=0			;A(PARSE BUFFER)
PL.FDB=2			;A(DUMMY FDB)
PL.LUN=4			;LUN ASSIGNED TO DEVICE
PL.FSI=6			;FILE SIZE
PL.SLB=12			;STARTING LBN
PL.FLG=16			;FLAGS
PL.ALB=20			;ACTUAL STARTING LBN
PF.CTG=1			;CONTIGUOUS ALLOCATION
PF.PRQ=2			;PLACEMENT REQUIRED
PF.ANY=4			;ANY ALLOCATION IF PLACEMENT FAILS
 
ANYWC=NB.SVR!NB.STP!NB.SNM!NB.SD1!NB.SD2
	.PAGE
; CONSTANTS AND WORK AREAS
;
PCOFLG:	.WORD	0		;PLACEMENT OVERRIDE FLAG
FNB:	.BLKW	15.		;FILE NAME BLOCK
CREDPB:	QIOW$	IO.CREA,,24.,,IOSB,,<,ATRLIS> ;DPB FOR CREATE QIOW
IOSB:	.BLKW	2		;IOSB - USED FOR ALL I/O
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)
	.WORD	0		;END OF LIST
PLABUF:	.BLKW	3		;PLACEMENT CONTROL BUFFER
PLASLB:	.BLKW	2		;ACTUAL STARTING LBN
DEIOSB:	.BLKW	2		;IOSB USED FOR DELETE
	.PAGE
$CRFIL::MOV	R5,-(SP)	;SAVE REGISTERS
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	CLR	-(SP)		;INITILIZE ERROR CODE ON STACK
	BR	CRFIL		;GO TO MAIN LINE CODE
EV16:	INC	(SP)		;ERROR EXIT VECTOR
EV14:	INC	(SP)
EV12:	INC	(SP)
EV10:	INC	(SP)
EV06:	INC	(SP)
EV04:	INC	(SP)
EV02:	INC	(SP)
	ASL	(SP)		;ERROR CODE TIMES 2
EV00:	MOV	(SP)+,R0	;R0 = RETURN CODE
	MOV	(SP)+,R1	;R1 = ERROR CODE OR ORIGINAL CONTENTS
	MOV	(SP)+,R2	;RESTORE REMAINING REGISTERS
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	TST	R0		;WAS FILE CREATED?
	BEQ	1000$		;IF EQ, YES - GO CHECK PLACEMENT
	SEC			;INDICATE FILE NOT CREATED
	RETURN			;RETURN TO CALLER
1000$:	TST	PCOFLG		;WAS PLACEMENT OVERRIDDEN?
	BEQ	1100$		;IF EQ, NO - VC IS OK
	SEV			;INDICATE PLACEMENT OVERRIDE
1100$:	RETURN			;RETURN TO CALLER
	.PAGE
CRFIL:	CLR	PCOFLG		;CLEAR PLACEMENT OVERRIDE FLAG
	MOV	R0,R5		;R5 = A(PARAMETER LIST)
	MOV	(R5),R4		;R4 = A(PARSE BUFFER)
	BIT	#ANYWC,PBFSTS(R4) ;ANY WILD CARDS SPECIFIED?
	BNE	EV02		  ;IF NE, YES - ERROR RETURN 02
;
; SET UP FNB FOR FIND DIRECTORY
;
	MOV	PBFDNM(R4),FNB+N.DVNM	;COPY DEVICE NAME
	MOV	PBFDUN(R4),FNB+N.UNIT	;COPY UNIT NUMBER
;
; FIND THE DIRECTORY
;
	MOV	PBFUIC(R4),R0	;R0 = UIC
	MOV	#FNB,R1		;R1 = A(FNB)
	MOV	PL.LUN(R5),R2	;R2 = LUN
	CALL	$FNDIR		;FIND THE DIRECTORY
	BCC	1000$		;IF CC, DIRECTORY FOUND - CONTINUE
	CMPB	#IE.NSF,R1	;DOES DIRECTORY EXIST?
	BEQ	EV04		;IF EQ, NO - ERROR RETURN 04
	MOV	R1,2(SP)	;PUT IOSB CODE IN R1 ON STACK
	BR	EV06		;ERROR RETURN 06
;
; SET UP FNB FOR CREATE
;
1000$:	MOV	#FNB,R0		;R0 = A(FILE NAME BLOCK)
	CLR	(R0)+		;CLEAR FILE ID
	CLR	(R0)+
	CLR	(R0)+
	MOV	PBFNAM(R4),(R0)+	;COPY FILE NAME
	MOV	PBFNAM+2(R4),(R0)+
	MOV	PBFNAM+4(R4),(R0)+
	MOV	PBFTYP(R4),(R0)+	;COPY FILE TYPE
	MOV	PBFVER(R4),(R0)+	;COPY FILE VERSION
	MOV	PBFSTS(R4),(R0)+	;COPY STATUS FLAGS
;
; SET UP DPB
;
	MOV	PL.LUN(R5),CREDPB+4	;INSERT LUN
	MOV	#FNB,CREDPB+14		;INSERT A(FID)
	MOV	#220*400,R0		;ENABLE EXTEND AND
					;PLACEMENT CONTROL
	BIT	#PF.CTG,PL.FLG(R5)	;CONTIGUOUS ALLOCATION?
	BEQ	1100$			;IF EQ, NO - FLAGS OK
	BIS	#5*400,R0		;CONTIGUOUS EXTEND
					;FILE MUST END UP CONTIGUOUS
1100$:	BISB	PL.FSI(R5),R0		;INSERT FILE SIZE(HIGH BYTE)
	MOV	R0,CREDPB+20		;INSERT EXTEND CONTROL FLAGS
					;DELTA SIZE (HIGH BYTE)
	MOV	PL.FSI+2(R5),CREDPB+22	;DELTA SIZE (LOW WORD)
;
; SET UP STTRIBUTES LIST
;
	MOV	PL.FDB(R5),ATRFDB	;A(DUMMY FDB)
;
; SET UP PLACEMENT CONTROL BUFFER
;
	MOV	#4,PLABUF		;ASSUME PLACEMENT
					;WITH FEEDBACK
	MOV	PL.SLB(R5),PLABUF+2	;STARTING LBN (HIGH BYTE)
	MOV	PL.SLB+2(R5),PLABUF+4	;STARTING LBN (LOW WORD)
;
; BEGIN ALLOCATION
;
	BIT	#PF.PRQ,PL.FLG(R5)	;PLACEMENT REQUIRED?
	BEQ	1300$			;IF EQ, NO - GO PUT IT ANYWHERE
1200$:	DIR$	#CREDPB			;TRY TO CREATE THE FILE
	CKDSW$S	1200$,ABORT		;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB		;DID WE CREATE IT?
	BEQ	1600$			;IF EQ, YES - GO ENTER IT IN DIR
	CMPB	#IE.ALC,IOSB		;ALLOCATION FAILURE?
	BNE	1500$			;IF NE, NO - GO CHECK FURTHER
	BIT	#PF.ANY,PL.FLG(R5)	;CAN WE PUT IT ANYWHERE?
	BEQ	EV10			;IF EQ, NO - ERROR RETURN 10
	DEC	PCOFLG			;SET PLACEMENT OVERRIDE FLAG
1300$:	MOV	#6,PLABUF		;ANY ALLOCATION WITH FEEDBACK
	CLR	PLABUF+2
	CLR	PLABUF+4
1400$:	DIR$	#CREDPB			;TRY TO CREATE THE FILE
	CKDSW$S	1400$,ABORT		;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB		;DID WE CREATE IT?
	BEQ	1600$			;IF EQ, YES - GO ENTER IT IN DIR
	CMPB	#IE.ALC,IOSB		;ALLOCATION FAILURE?
	BEQ	1510$			;IF EQ, YES - ERROR RETURN 10
1500$:	CMPB	#IE.DFU,IOSB		;DEVICE FULL?
	BEQ	1512$			;IF EQ, YES - ERROR RETURN 12
	CMPB	#IE.IFU,IOSB		;INDEX FILE FULL?
	BEQ	1514$			;IF EQ, YES - ERROR RETURN 14
	MOVB	IOSB,R1			;PUT IOSB CODE IN R1 ON STACK
	MOV	R1,2(SP)
	BR	1516$			;ERROR RETURN 16
1510$:	JMP	EV10			;ERROR RETURN 10
1512$:	JMP	EV12			;ERROR RETURN 12
1514$:	JMP	EV14			;ERROR RETURN 14
1516$:	JMP	EV16			;ERROR RETURN 16
1600$:	QIOW$S	#IO.ENA,PL.LUN(R5),#24.,,#IOSB,,<,,,,,#FNB> ;ENTER FILE
	CKDSW$S	1600$,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB	;NAME ENTERED?
	BEQ	1800$		;IF EQ, YES - GO FINISH UP
1700$:	QIOW$S	#IO.DEL,PL.LUN(R5),#24.,,DEIOSB,,<#FNB> ;DELETE THE FILE
	CKDSW$S	1700$,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,DEIOSB	;DELETED?
	BEQ	1500$		;IF EQ, YES - GO ANALYZE ERROR
1800$:	MOV	PLASLB,PL.ALB(R5) ;RETURN STARTING LBN TO CALLER
	MOV	PLASLB+2,PL.ALB+2(R5)
	JMP	EV00		;EXIT
;
; ABORT THE TASK
;
ABORT:	HALT
	.END