.TITLE	FILNAM
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	FILNAM
;
;  DATE:	03-JUL-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL FILNAM(STRING,[DEV],[UIC],[NAME],[EXT],[VER],[ISW])
;
;		STRING	= VARIABLE CONTAINING AN ASCII REPRESENTATION OF
;			  THE FILE SPECIFICATION TO BE CONVERTED.  THE
;			  STRING MUST BE TERMINATED BY AN ASCII NULL
;			  CHARACTER.
;
;		DEV,UIC,NAM,EXT,VER
;
;			= LITERALS SPECIFYING THE "DEFAULT" FILESPEC 
;			  COMPONENTS.  IF NOT SUPPLIED, THE DEFAULTS USED ARE:
;
;			  DEV = 'SY'
;			  UIC = CALLING ROUTINE'S DEFAULT UIC
;			  NAM = NO DEFAULT
;			  EXT = NO DEFAULT
;			  VER = NO DEFAULT (HIGHEST VERSION)
;
;		ISW	= VARIABLE TO RECEIVE THE INTEGER STATUS WORD.
;
;			   00 = CONVERSION SUCCESSFUL
;			  -01 = ILLEGAL FILE SPECIFICATION
;
;
;  DESCRIPTION:
;
;	"FILNAM" VERIFIES AND CONVERTS AN ASCII FILE SPECIFICATION, SUB-
;  STITUTING USER SUPPLIED DEFAULTS WHEN NECESSARY.
;
;  EXAMPLES:
;
;		FNAM1 = 'FNAM1.DAT'
;		FNAM2 = 'FNAM2'
;
;		CALL FILNAM(FNAM1)
;		CALL FILNAM(FNAM2,'DB0','[200,200]',,'DAT')
;
;		FNAM1 = 'SY0:[1,1]FNAM1.DAT'
;		FNAM2 = 'DB0:[200,200]FNAM2.DAT'
;
;

	.SBTTL	SYMBOL DEFINITIONS
;
;
					;
	.PSECT				;
	.MCALL	GTSK$S			;
	.MCALL	CSI$,CSI$1,CSI$2	;
					;
	CSI$				; DEFINE CSI OFFSETS
					;
TSKB:	.BLKW	16.			; TASK PARAMETERS BLOCK
CSIB:	.BLKB	C.SIZE			; CSI BLOCK
	.EVEN				;
					;
FSB:					; FILE SPECIFICATION BUFFER
DEV:	.ASCIZ	/SY00/			; DEVICE CODE BUFFER
UIC:	.ASCIZ	/[200,200]/		; UIC BUFFER
NAM:	.ASCIZ	/FILE-NAME/		; FILENAME BUFFER
EXT:	.ASCIZ	/EXT/			; FILENAME EXTENSION BUFFER
VER:	.ASCIZ	/77777/			; FILE VERSION BUFFER
	.EVEN				;
					;

	.SBTTL	LOCAL MACRO DEFINITIONS
;
;
					;
					; FETCH ASCII ARGUMENT
	.MACRO	GAARG	ARG,BUF		; MACRO GAARG DEFINITION
					;
	CMPB	#ARG,(R5)		; ARG ARGUMENTS?
	BGT	.+26			; NO MORE USER SPECIFIED DEFAULTS
	TST	2*ARG(R5)		; NULL ARGUMENT?
	BLT	.+20			; YES, DEFAULT NOT SUPPLIED
	MOV	2*ARG(R5),R0		; ARGUMENT STRING ADDRESS TO R0
	MOV	BUF,R1			; BUFFER ADDRESS TO R1
	MOVB	(R0),(R1)+		; MOVE ARGUMENT TO BUFFER
	TSTB	(R0)+			; END-OF-STRING?
	BNE	.-4			; NO, CONTINUE SCANNING
					;
	.ENDM	GAARG			;
					;

	.SBTTL	ENTRY POINT -- INITIALIZE DEFAULTS
;
;
					;
FILNAM::				;
					;
	MOV	#DEV,R0			; DEVICE BUFFER ADDRESS TO R0
	MOV	#"SY,(R0)+		; DEFAULT DEVICE CODE 'SY' TO BUFFER
	CLR	(R0)			; NULL FILL BUFFER
					;
	MOV	#TSKB,R0		; TASK PARAMETER BUFFER ADDRESS TO R0
	GTSK$S	R0			; FETCH TASK PARAMETERS
	MOV	G.TSPC(R0),R3		; TASK UIC TO R3
	MOV	#UIC,R2			; UIC BUFFER ADDRESS TO R2
	CLR	R4			; UIC CONVERSION MODE TO R4
	CALL	.PPASC			; CONVERT TASK UIC TO ASCII STRING
	CLRB	(R2)			; UIC ASCII STRING TERMINATOR
					;
	CLRB	NAM			; NO DEFAULT FILENAME
	CLRB	EXT			; NO DEFAULT FILENAME EXTENSION
	CLRB	VER			; NO DEFAULT FILE VERSION NUMBER
					;
					; FETCH USER SUPPLIED DEFAULTS (IF ANY)
	GAARG	2,#DEV			; DEVICE CODE
	GAARG	3,#UIC			; UIC
	GAARG	4,#NAM			; FILENAME
	GAARG	5,#EXT			; FILENAME EXTENSION
	GAARG	6,#VER			; VERSION NUMBER
					;

	.SBTTL	PARSE INPUT FILESPEC
;
;
					;
PRS:	MOV	2(R5),R1		; STRING ADDRESS TO R1
	CLR	R2			; CLEAR CHARACTER COUNT
2$:	TSTB	(R1)+			; END-OF-STRING?
	BEQ	4$			; YES, BRANCH FROM SCAN
	INC	R2			; NO, INCREMENT CHARACTER COUNT
	BR	2$			; AND CONTINUE TO SCAN
					;
4$:	MOV	#CSIB,R0		; CSI BLOCK ADDRESS TO R0
	MOV	2(R5),R1		; STRING ADDRESS TO R1
	CSI$1	R0,R1,R2		; CHECK FILENAME SYNTAX
	BCC	.+6			; RETURN ON ERROR
	JMP	ERR			;
	CSI$2	R0,OUTPUT		; PARSE FILENAME
	BCC	.+6			; RETURN ON ERROR
	JMP	ERR			;
					;
	BITB	#CS.DVF,C.STAT(R0)	; DEVICE NAME SPECIFIED?
	BEQ	10$			; NO, BRANCH AHEAD
	MOV	#DEV,R1			; DEVICE BUFFER ADDRESS TO R1
	MOV	C.DEVD+2(R0),R2		; DEVICE STRING ADDRESS TO R2
	MOV	C.DEVD(R0),R3		; DEVICE STRING LENGTH TO R3
6$:	MOVB	(R2)+,(R1)+		; COPY DEVICE STRING TO BUFFER
	SOB	R3,6$			; LOOP UNTIL COUNT IS ZERO
	CLRB	(R1)			; THEN SET BUFFER EOS MARKER
					;
10$:	BITB	#CS.DIF,C.STAT(R0)	; UIC SPECIFIED?
	BEQ	14$			; NO, BRANCH AHEAD
	MOV	#UIC,R1			; UIC BUFFER ADDRESS TO R1
	MOV	C.DIRD+2(R0),R2		; UIC STRING ADDRESS TO R2
	MOV	C.DIRD(R0),R3		; UIC STRING LENGTH TO R3
12$:	MOVB	(R2)+,(R1)+		; COPY UIC STRING TO BUFFER
	SOB	R3,12$			; LOOP UNTIL COUNT IS ZERO
	CLRB	(R1)			; THEN SET BUFFER EOS MARKER
					;
14$:	BITB	#CS.NMF,C.STAT(R0)	; FILENAME SPECIFIED?
	BEQ	PAK			; NO, BRANCH TO PACK AND VERIFY
	MOV	#NAM,R1			; FILENAME BUFFER ADDRESS TO R1
	MOV	C.FILD+2(R0),R2		; FILENAME STRING ADDRESS TO R2
	MOV	C.FILD(R0),R3		; FILENAME STRING LENGTH TO R3
16$:	CMPB	#'.,(R2)		; '.'?
	BEQ	20$			; YES, GO PARSE EXTENSION
	CMPB	#';,(R2)		; ';'?
	BEQ	24$			; YES, GO PARSE VERSION NUMBER
	MOVB	(R2)+,(R1)+		; COPY FILENAME STRING TO BUFFER
	CLRB	(R1)			; SET BUFFER EOS MARKER
	SOB	R3,16$			; LOOP UNTIL COUNT IS ZERO
	BR	PAK			; BRANCH TO PACK AND VERIFY
					;
20$:	INC	R2			; INCREMENT STRING POINTER
	DEC	R3			; DECREMENT CHARACTER COUNT
	MOV	#EXT,R1			; EXTENSION BUFFER ADDRESS TO R1
22$:	CMPB	#';,(R2)		; ';'?
	BEQ	24$			; YES, GO PARSE VERSION
	MOVB	(R2)+,(R1)+		; COPY EXTENSION STRING TO BUFFER
	CLRB	(R1)			; SET BUFFER EOS MARKER
	SOB	R3,22$			; LOOP UNTIL COUNT IS ZERO
	BR	PAK			; BRANCH TO PACK AND VERIFY
					;
24$:	INC	R2			; INCREMENT STRING POINTER
	DEC	R3			; DECREMENT CHARACTER COUNT
	MOV	#VER,R1			; VERSION BUFFER ADDRESS TO R1
26$:	MOVB	(R2)+,(R1)+		; COPY VERSION STRING TO BUFFER
	SOB	R3,26$			; LOOP UNTIL COUNT IS ZERO
	CLRB	(R1)			; THEN SET VERSION BUFFER EOS MARKER
					;

	.SBTTL	CONCATENATE AND VERIFY CONVERTED FILENAME
;
;
					;
PAK:	MOV	2(R5),R1		; STRING ADDRESS TO R1
	CLR	R2			; CLEAR CHARACTER COUNT
	MOV	#DEV,R3			; DEVICE BUFFER ADDRESS TO R3
2$:	TSTB	(R3)			; END-OF-STRING?
	BEQ	4$			; YES, CONTINUE ON TO UIC
	MOVB	(R3)+,(R1)+		; NO, COPY DEVICE TO STRING
	INC	R2			; INCREMENT CHARACTER COUNT
	BR	2$			; AND CONTINUE TO SCAN
4$:	MOVB	#':,(R1)+		; PACK DEVICE SEPERATOR
	INC	R2			; INCREMENT CHARACTER COUNT
	MOV	#UIC,R3			; UIC BUFFER ADDRESS TO R3
6$:	TSTB	(R3)			; END-OF-STRING?
	BEQ	10$			; YES, CONTINUE ON TO FILENAME
	MOVB	(R3)+,(R1)+		; MOVE UIC TO STRING
	INC	R2			; INCREMENT CHARACTER COUNT
	BR	6$			; AND CONTINUE TO SCAN
10$:	MOV	#NAM,R3			; FILENAME BUFFER ADDRESS TO R3
12$:	TSTB	(R3)			; END-OF-STRING?
	BEQ	14$			; YES, CONTINUE ON TO EXTENSION
	MOVB	(R3)+,(R1)+		; MOVE FILENAME TO STRING
	INC	R2			; INCREMENT CHARACTER COUNT
	BR	12$			; AND CONTINUE TO SCAN
14$:	MOV	#EXT,R3			; EXTENSION BUFFER ADDRESS TO R3
	TSTB	(R3)			; END-OF-STRING?
	BEQ	24$			; YES, GO VERIFY FILENAME
	MOVB	#'.,(R1)+		; NO, PACK EXTENSION SEPERATOR
	INC	R2			; INCREMENT CHARACTER COUNT
16$:	TSTB	(R3)			; END-OF-STRING?
	BEQ	20$			; YES, CONTINUE ON TO VERSION
	MOVB	(R3)+,(R1)+		; MOVE EXTENSION TO STRING
	INC	R2			; INCREMENT CHARACTER COUNT
	BR	16$			; AND CONTINUE TO SCAN
20$:	MOV	#VER,R3			; VERSION BUFFER ADDRESS TO R3
	TSTB	(R3)			; END-OF-STRING?
	BEQ	24$			; YES, RETURN TO USER
	MOVB	#';,(R1)+		; NO, PACK VERSION SEPERATOR
	INC	R2			; INCREMENT CHARACTER COUNT
22$:	TSTB	(R3)			; END-OF-STRING?
	BEQ	24$			; YES, GO VERIFY FILENAME
	MOVB	(R3)+,(R1)+		; MOVE VERSION TO STRING
	INC	R2			; INCREMENT CHARACTER COUNT
	BR	22$			; AND CONTINUE TO SCAN
24$:	CLRB	(R1)			; SET FILE SPECIFICATION EOS
					;
VFY:	MOV	2(R5),R1		; STRING ADDRESS TO R1
	CSI$1	R0,R1,R2		; CHECK FILE SPECIFICATION SYNTAX
	BCS	ERR			; RETURN ON ERROR
					;

	.SBTTL	RETURN TO CALLER
;
;
					;
RTN:	CLR	R4			; CLEAR ISW
	BR	.+6			;
ERR:	MOV	#-1,R4			; SET ISW = -1
	CMPB	#7,(R5)			; SEVEN ARGUMENTS?
	BGT	2$			; NO, RETURN TO CALLER
	TST	16(R5)			; NULL ARGUMENT?
	BLT	2$			; YES, RETURN TO CALLER
	MOV	R4,@16(R5)		; NO, RETURN STATUS
2$:	RTS	PC			; RETURN TO CALLER
	.END				;