;
;	.TITLE	PARSE
;
;	TEST THE RESULTS OF $PARSE - INTENT BEING TO DEFINE
;	A FORTRAN SUBROUTINE WHICH, WHEN SUPPLIED WITH A VMS
;	FILE SPEC STRING, WILL RETURN THE EXPANDED FILE NAME,
;	THE DEVICE NAME, AND THE DIRECTORY ID. $PARSE IS CALLED
;	WITH 'OFP' SET - FILE CREATE MODE.
;
;	STRING ARGUMENTS ARE ASSUMED TO BE BYTE ARRAYS WITH 0 BYTE
;	MARKING END-OF-STRING. NO ATTEMPT IS MADE TO CHECK STRING
;	LENGTH FOR RETURN ARGUMENTS. IF YOUR ARRAY IS TOO SHORT -
;	T O U G H  L U C K !
;
;	CALL PARSE(FILENAME, DEV_ID, DIR_ID, RSS, ESS)
;
;		FILENAME - FILE SPEC STRING TO BE ESTABLISHED
;		DEV_ID	 - DEVICE ID (16 BYTE COUNTED STRING) OUTPUT
;		DIR_ID	 - DIRECTORY ID ( 3 WORDS) OUTPUT
;		RSS	 - RESULTANT FILE NAME STRING OUTPUT
;		ESS	 - EXPANDED FILE NAME STRING OUTPUT
;

;
;	DEFINE THE FAB, NAME BLOCK AND STRING STORAGE AREAS
;

FAB:	$FAB	NAM=NAM,FOP=OFP

NAM:	$NAM	ESA=ESS_B,ESS=ESS_L,RSA=RSS_B,RSS=RSS_L

RSS_L = 180
RSS_B:	.BLKB	RSS_L

ESS_L = 180
ESS_B:	.BLKB	ESS_L



	.ENTRY	PARSE, ^M<R2,R3,R4,R5,R6,R7,R8>

;	First determine the file spec string length. Put the length
;	and location into the FAB.

	MOVAL	FAB,R6			; LOC OF FAB
	MOVAL	NAM,R7			;   AND NAME BLOCK

	MOVL	4(AP),R2		; LOC OF FILESPEC STRING
	MOVL	R2,FAB$L_FNA(R6)	; FILE NAME ADDR TO FAB
	LOCC	#0, #RSS_L, (R2)	; DETERMINE LENGTH
	SUBB3	R0, #RSS_L, FAB$B_FNS(R6) ;   AND STORE IN FAB

	$PARSE	FAB=FAB			; PARSE THE NAME
	BLBC	R0 , QUIT		; BR IF ERROR
	MOVL	R0,R8			; SAVE THE STATUS CODE
	ADDL3	#NAM$T_DVI,R7,R2	; LOC OF NAME BLOCK DEVICE ID FIELD
	MOVL	8(AP),R3		; USER'S ARRAY LOC
	MOVQ	(R2)+,(R3)+		; MOVE IT
	MOVQ	(R2)+,(R3)+

	ADDL3	#NAM$W_DID,R7,R2	; LOC OF DIRECTORY ID FIELD
	MOVL	12(AP),R3		; USER'S ARRAY LOC
	MOVL	(R2)+,(R3)+		; MOVE TWO WORDS
	MOVW	(R2)+,(R3)+		;  AND THE LAST

	MOVZBL	NAM$B_RSL(R7),R0	; LENGTH OF RESULTANT FILE STRING
	MOVC3	R0,RSS_B,@16(AP)	; MOVE THE STRING
	CLRB	(R3)			; STUFF IN THE END-OF STRING

	MOVZBL	NAM$B_ESL(R7),R0	; LENGTH OF EXTENDED FILE STRING
	MOVC3	R0,ESS_B,@20(AP)	; MOVE THE STRING
	CLRB	(R3)			; STUFF IN THE END-OF-STRING

	MOVL	R8,R0			; RESTORE PARSE STATUS

QUIT:	RET

	.END