.TITLE FPARSE .IDENT /01-001/ ;+ ; Copyright © 1992 by Hunter Goatley. This code may be freely distributed ; and modified for non-commercial purposes as long as this copyright notice ; is retained. ;- ;++ ; ; Facility: FPARSE ; ; Author: Hunter Goatley ; Western Kentucky University ; Academic Computing, STH 226 ; Bowling Green, KY 42101 ; E-mail: goathunter@WKUVX1.BITNET ; Voice: 502-745-5251 ; ; Date: March 18, 1988 ; ; Functional Description: ; ; Provide easy access to the $PARSE RMS routine. This routine is ; based on DCL's F$PARSE routine. It does a syntax-only parse on ; the name (the existence of the directory is not checked). ; ; Modified by: ; ; 01-001 Hunter Goatley 18-MAR-1988 07:21 ; Original version. ; ;------------------------------------------------------------------------------- ; ; Inputs: ; ; 4(AP) - Descriptor for buffer to receive information ; 8(AP) - Descriptor for file specification to be parsed ; 12(AP) - Descriptor for default file specification (default is ; SYS$DISK:[].;) ; 16(AP) - Descriptor for related file specification ; 20(AP) - Address of bit mask describing information to be returned ; (Default is NODE::DEVICE:[DIRECTORY]NAME.TYPE;VERSION) ; ; Bit 5 set - return node name (usually null) ; Bit 4 set - return device name ; Bit 3 set - return directory name ; Bit 2 set - return file name ; Bit 1 set - return file type name ; Bit 0 set - return version number ; ; Output: ; ; 4(AP) - Descriptor for parsed file specification ; ; Returns: ; ; Status value in R0 ; ; Calling sequence: ; ; STATUS% = FPARSE (RES$, FILE$, "CLYDE$ROOT:[EXE]",,128%) ; ;-- RESULT = 1 * 4 ; Descriptor for resultant name FILE = 2 * 4 ; File specification DEFAULT = 3 * 4 ; Default file spec RELATED = 4 * 4 ; Related file spec OPTIONS = 5 * 4 ; Bit mask for return info FP_V_NODE = 5 ; Bit 5 = node name (usually "") FP_V_DEV = 4 ; Bit 4 = device name FP_V_DIR = 3 ; Bit 3 = directory name FP_V_NAME = 2 ; Bit 2 = file name FP_V_TYPE = 1 ; Bit 1 = file type FP_V_VER = 0 ; Bit 0 = version number .EXTRN LIB$ANALYZE_SDESC_R2 ; Analyze string descriptors .EXTRN STR$COPY_DX ; Copy string by descriptor $SSDEF ; System service status symbols $LIBDEF ; LIB$ error symbols $RMSDEF ; RMS definitions $FABDEF ; File Access Block symbols $RABDEF ; Record Access Block symbols $NAMDEF ; Name block symbols .PSECT _FPARSE_DATA,NOEXE,WRT,LONG,SHR ; ;*** File Access Block for input ; PARSE_FAB: $FAB FOP=NAM, - ; Options: NAM block NAM=PARSE_NAM ; NAM block address PARSE_NAM: $NAM ESA=PARSE_RESULT, - ; Resultant string address ESS=NAM$C_MAXRSS, - ; Buffer size RLF=RELATED_NAM RELATED_NAM: $NAM ; NAM block for related spec PARSE_RESULT: .BLKB NAM$C_MAXRSS ; Buffer for resultant name .ALIGN LONG WORK_BUFFER: .BLKB NAM$C_MAXRSS ; Work buffer for final string .ALIGN LONG DEFAULT_SPEC: .ASCII /SYS$DISK:[].;/ ; Default default file DEFAULT_SPEC_L = . - DEFAULT_SPEC ; ... specification and length .PSECT _FPARSE_CODE,EXE,NOWRT,LONG,PIC,SHR .ENTRY FPARSE,^M CMPW #5,(AP) ; Were 5 arguments given? BEQLU 10$ ; Branch if yes - we're OK MOVL #LIB$_WRONUMARG,R0 ; Return error code RET ; Return to caller 10$: MOVAL PARSE_FAB,R6 ; Point R3 to FAB MOVAL PARSE_NAM,R7 ; Point R4 to resultant NAM MOVAL RELATED_NAM,R8 ; Point R5 to related file NAM ; ; Initialize structures ; CLRB FAB$B_FNS(R6) ; Clear file spec size CLRL FAB$L_FNA(R6) ; Clear file spec address ; CLRB FAB$B_DNS(R6) ; Clear default file spec size ; CLRL FAB$L_DNA(R6) ; Clear default file spec addr MOVB #DEFAULT_SPEC_L,FAB$B_DNS(R6) ; Set default file spec size MOVAB DEFAULT_SPEC,FAB$L_DNA(R6) ; Set default file spec addr CLRB NAM$B_RSL(R8) ; Clear related file spec size CLRL NAM$L_RLF(R8) ; Clear related file spec addr MOVL DEFAULT(AP),R0 ; Get related file spec address BEQLU 20$ ; Branch if not given JSB G^LIB$ANALYZE_SDESC_R2 ; Analyze for length and address MOVB R1,FAB$B_DNS(R6) ; Move length to FAB MOVL R2,FAB$L_DNA(R6) ; ... 20$: MOVL RELATED(AP),R0 ; Get related file spec address BEQLU 30$ ; Branch if not given JSB G^LIB$ANALYZE_SDESC_R2 ; Analyze for length and address MOVB R1,NAM$B_RSL(R8) ; Move length to related NAM MOVL R2,NAM$L_RLF(R8) ; ... 30$: MOVL FILE(AP),R0 ; Get file spec address BEQLU 40$ ; Branch if not given JSB G^LIB$ANALYZE_SDESC_R2 ; Analyze for length and address MOVB R1,FAB$B_FNS(R6) ; Move length to FAB MOVL R2,FAB$L_FNA(R6) ; ... 40$: $PARSE FAB=(R6) ; Go parse it BLBS R0,50$ ; Branch if successful BRW 140$ ; Branch to return on error 50$: MOVL OPTIONS(AP),R9 ; Get options address BEQLU 60$ ; Branch if not given MOVL (R9),R9 ; Get the options BRB 70$ ; Skip over default options 60$: MOVZBL #^XFF,R9 ; Set all options 70$: MOVAL WORK_BUFFER,R3 ; Get address of work buffer ; BBC #FP_V_NODE,R9,80$ ; Branch if node is not returned MOVZBL NAM$B_NODE(R7),R0 ; Get length of node name MOVC3 R0,@NAM$L_NODE(R7),(R3) ; Copy node to work buffer ; 80$: BBC #FP_V_DEV,R9,90$ ; Branch if device is not returned MOVZBL NAM$B_DEV(R7),R0 ; Get length of device name MOVC3 R0,@NAM$L_DEV(R7),(R3) ; Copy device to work buffer ; 90$: BBC #FP_V_DIR,R9,100$ ; Branch if dir is not returned MOVZBL NAM$B_DIR(R7),R0 ; Get length of directory spec MOVC3 R0,@NAM$L_DIR(R7),(R3) ; Copy directory to work buffer ; 100$: BBC #FP_V_NAME,R9,110$ ; Branch if name is not returned MOVZBL NAM$B_NAME(R7),R0 ; Get length of filename MOVC3 R0,@NAM$L_NAME(R7),(R3) ; Copy name to work buffer ; 110$: BBC #FP_V_TYPE,R9,120$ ; Branch if type is not returned MOVZBL NAM$B_TYPE(R7),R0 ; Get length of type MOVC3 R0,@NAM$L_TYPE(R7),(R3) ; Copy type to work buffer ; 120$: BBC #FP_V_VER,R9,130$ ; Branch if ver is not returned MOVZBL NAM$B_VER(R7),R0 ; Get length of version MOVC3 R0,@NAM$L_VER(R7),(R3) ; Copy version to work buffer ; 130$: MOVAL WORK_BUFFER,R0 ; Get address of work buffer PUSHL R0 ; Build descriptor for it SUBL3 R0,R3,-(SP) ; Get length on stack PUSHAL (SP) ; Copy work buffer to user's PUSHAQ @RESULT(AP) ; ... result buffer CALLS #2,G^STR$COPY_DX ; ... 140$: RET ; Return to caller .END