%TITLE 'FPARSE'!MODULE FPARSE (IDENT = 'V1.0') = BEGIN!++!! Facility: FPARSE!! Author: Hunter Goatley!! Date: December 7, 1994! ! Abstract:!>! Easy access to $PARSE system service. Modeled after the DCL! lexical F$PARSE().!! Modified by:!)! V1.0 Hunter Goatley 7-DEC-1994 15:05! Original version.!!--9LIBRARY 'SYS$LIBRARY:STARLET'; !Pull stuff from STARLETKSWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); FORWARD ROUTINE fparse; !The fparse routine EXTERNAL ROUTINE0 LIB$ANALYZE_SDESC, !Analyze string descriptor STR$COPY_R; !Copy a string+ LITERAL !Define the options bitmask fp_v_ver = 0, !... flags fp_v_type = 1, fp_v_name = 2, fp_v_dir = 3, fp_v_dev = 4, fp_v_node = 5; %SBTTL 'FPARSE'KGLOBAL ROUTINE fparse (result_a, file_a, default_a, related_a, options_a) =BEGIN!+!! Routine: FPARSE!! Functional Description:!A! Provide easy access to the $PARSE RMS routine. This routine isA! based on DCL's F$PARSE routine. It does a syntax-only parse on;! the name (the existence of the directory is not checked).!! Formal parameters:!9! result_a - Descriptor for buffer to receive information:! file_a - Descriptor for file specification to be parsedC! default_a - Descriptor for default file specification (default is! SYS$DISK:[].;)7! related_a - Descriptor for related file specification>! options_a - Address of bit mask describing information to be! returned<! (Default is NODE::DEVICE:[DIRECTORY]NAME.TYPE;VERSION)!0! 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! ! Returns:! ! R0 - Status!! Side effects:!!!- BIND result = .result_a : $BBLOCK, file = .file_a : $BBLOCK,! default = .default_a : $BBLOCK,! related = .related_a : $BBLOCK,' options = .options_a : BITVECTOR[32]; LOCAL' parse_result : $BBLOCK [NAM$C_MAXRSS],& work_buffer : $BBLOCK [NAM$C_MAXRSS], related_nam : $NAM(),& parse_nam : $NAM (ESA = parse_result, ESS = NAM$C_MAXRSS, RLF = related_nam),) parse_fab : $FAB (DNM = 'SYS$DISK:[].;', FOP = NAM, NAM = parse_nam), length, address : REF $BBLOCK, work_options : BITVECTOR [32], status : UNSIGNED LONG;6 IF (default NEQA 0) !Store the default filename' THEN !... in the $FAB, if given BEGIN. LIB$ANALYZE_SDESC (default, length, address);! parse_fab [FAB$B_DNS] = .length;" parse_fab [FAB$L_DNA] = .address; END;6 IF (related NEQA 0) !Store the related filename' THEN !... in the $NAM, if given BEGIN. LIB$ANALYZE_SDESC (related, length, address);# related_nam [NAM$B_RSL] = .length;$ related_nam [NAM$L_RLF] = .address; END;2 IF (file NEQA 0) !Store the filename in the THEN !... $FAB, if given BEGIN+ LIB$ANALYZE_SDESC (file, length, address);! parse_fab [FAB$B_FNS] = .length;" parse_fab [FAB$L_FNA] = .address; END; !6 ! Call $PARSE to parse the file specification(s). !& status = $PARSE (FAB = parse_fab); IF (.status) THEN BEGIN !2 ! If options is omitted, then return everything. !@ work_options = (IF (options EQLA 0) THEN %X'FF' ELSE .options);/ address = work_buffer; !Point to work buffer IF (.work_options [fp_v_node]) THEN BEGIN? CH$MOVE (.parse_nam [NAM$B_NODE], .parse_nam [NAM$L_NODE], .address);; address = CH$PLUS (.address, .parse_nam [NAM$B_NODE]); END; IF (.work_options [fp_v_dev]) THEN BEGIN= CH$MOVE (.parse_nam [NAM$B_DEV], .parse_nam [NAM$L_DEV], .address);: address = CH$PLUS (.address, .parse_nam [NAM$B_DEV]); END; IF (.work_options [fp_v_dir]) THEN BEGIN= CH$MOVE (.parse_nam [NAM$B_DIR], .parse_nam [NAM$L_DIR], .address);: address = CH$PLUS (.address, .parse_nam [NAM$B_DIR]); END; IF (.work_options [fp_v_name]) THEN BEGIN? CH$MOVE (.parse_nam [NAM$B_NAME], .parse_nam [NAM$L_NAME], .address);; address = CH$PLUS (.address, .parse_nam [NAM$B_NAME]); END; IF (.work_options [fp_v_type]) THEN BEGIN? CH$MOVE (.parse_nam [NAM$B_TYPE], .parse_nam [NAM$L_TYPE], .address);; address = CH$PLUS (.address, .parse_nam [NAM$B_TYPE]); END; IF (.work_options [fp_v_ver]) THEN BEGIN= CH$MOVE (.parse_nam [NAM$B_VER], .parse_nam [NAM$L_VER], .address);: address = CH$PLUS (.address, .parse_nam [NAM$B_VER]); END;* length = CH$DIFF (.address, work_buffer);3 status = STR$COPY_R (result, length, work_buffer); END;, RETURN (.status); !Set success status END; !End of routine FPARSEEND !End of module BEGINELUDOM !End of module