MODULE SSCAN ( IDENT = 'X00.06' %TITLE 'XST$SCAN - String Scanning Function' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XST$SCAN ),OTS='' ) ) = BEGIN ! ! COPYRIGHT (c) 1980 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module implements the $STR_SCAN function. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHOR: Ward Clark, CREATION DATE: 20 February 1980 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XST$SCAN; ! String scanning function ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $ALL ) ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE XST$SCAN( options, string, pattern, output, delimiter, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine implements the $STR_SCAN function. ! ! FORMAL PARAMETERS: ! ! options - string handling options ! string - address of the source string descriptor ! pattern - address of the pattern descriptor ! output - address of a substring or target descriptor ! delimiter - address of substring delimiter deposit fullword ! success_action - address of a success action routine ! failure_action - address of a failure action routine ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: (secondary passed to action routine only) ! ! STR$_NORMAL - successful string scan ! STR$_END_STRING - successful string scan, end of string reached ! STR$_FAILURE - unsuccessful string scan ! ! STR$_BAD_PATTRN - invalid pattern string ! secondary = STR$_NULL_STRNG - null string not permitted ! failure completion code from $STR_VALIDATE ! STR$_BAD_SOURCE - invalid source string ! secondary = STR$_BAD_CLASS - invalid descriptor class (REMAINDER= only) ! STR$_NO_TEMP - temporary string not permitted ! failure completion code from $STR_VALIDATE ! STR$_BAD_TARGET - invalid target string ! secondary = STR$_BAD_CLASS - invalid descriptor class (SUBSTRING= only) ! STR$_CONFLICT - same descriptor as STRING= ! failure completion code from $STR_VALIDATE ! failure completion code from $STR_COPY ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP options : $STR_OPTIONS, string : REF $STR_DESCRIPTOR( CLASS = BOUNDED ), pattern : REF $STR_DESCRIPTOR(), output : REF $STR_DESCRIPTOR( CLASS = BOUNDED ); LOCAL source_length, ! Length of source string source_pointer, ! Pointer to source string sub_length, ! Length of resulting substring sub_pointer; ! Pointer to resulting substring ! ! Initialization ! $STR_MAIN_BEGIN( SCAN ) ! ! Validate the source string descriptor. ! $STR_VALIDATE( .string, BAD_SOURCE ); IF .options[STR$V_REMAINDER] AND ! If REMAINDER= was specified instead of STRING= ( .string[STR$B_CLASS] NEQ STR$K_CLASS_B AND ! and the descriptor class is not BOUNDED or .string[STR$B_CLASS] NEQ STR$K_CLASS_DB ) ! DYNAMIC_BOUNDED, THEN ! $STR_QUIT( BAD_SOURCE, BAD_CLASS ); ! return an error code to the caller. ! ! Validate the pattern descriptor. ! $STR_VALIDATE( .pattern, BAD_PATTRN ); IF .pattern[STR$H_LENGTH] EQL 0 ! Make sure a non-null pattern was specified. THEN $STR_QUIT( BAD_PATTRN, NULL_STRNG ); ! ! Validate the substring/target descriptor. ! IF .output NEQ 0 ! Check for the following output descriptor errors: THEN BEGIN $STR_VALIDATE( .output, BAD_TARGET ); ! the output descriptor is invalid IF .string EQLA .output AND ( NOT .options[STR$V_REMAINDER] OR ! STRING= and SUBSTRING= point to same descriptor .options[STR$V_TARGET] ) ! STRING= and TARGET= point to same descriptor THEN $STR_QUIT( BAD_TARGET, CONFLICT ); IF NOT .options[STR$V_TARGET] THEN BEGIN IF .string[STR$B_CLASS] EQL STR$K_CLASS_XT ! STRING=temporary and SUBSTRING=any_desc THEN $STR_QUIT( BAD_SOURCE, NO_TEMP ); IF .output[STR$B_CLASS] EQL ! SUBSTRING=dynamic_desc STR$K_CLASS_D OR ( .output[STR$B_CLASS] EQL ! SUBSTRING=dynamic_bounded_desc and STR$K_CLASS_DB AND ! REMAINDER=different_desc .output NEQ .string ) THEN $STR_QUIT( BAD_TARGET, BAD_CLASS ); END; END; ! ! Setup the length of and pointer to the string to be scanned. ! IF .options[STR$V_REMAINDER] ! REMAINDER= setup THEN BEGIN source_length = .string[STR$H_MAXLEN] - .string[STR$H_PFXLEN] - .string[STR$H_LENGTH]; source_pointer = CH$PLUS( .string[STR$A_POINTER], .string[STR$H_LENGTH] ); END ELSE ! STRING= setup BEGIN source_length = .string[STR$H_LENGTH]; source_pointer = .string[STR$A_POINTER]; END; ! ! Use the scan function code to select appropriate scan processing. ! CASE .options[STR$V_FUNCTION] FROM 1 TO STR$K_STOP OF SET %TITLE 'XST$SCAN - FIND Substring' !+ ! ! $STR_SCAN( FIND = substring, ... ) ! !- [ STR$K_FIND ] : BEGIN sub_pointer = CH$FIND_SUB( .source_length, ! Search for the specified substring. .source_pointer, .pattern[STR$H_LENGTH], .pattern[STR$A_POINTER] ); IF CH$FAIL( .sub_pointer ) ! Check for a search failure.sub_ THEN $STR_QUIT( FAILURE ); sub_length = .pattern[STR$H_LENGTH]; ! The result substring is the same length as ! the pattern string. END; %TITLE 'XST$SCAN - SPAN Characters' !+ ! ! $STR_SCAN( SPAN = character-stream, ... ) ! !- [ STR$K_SPAN ] : BEGIN LOCAL scan_pointer; ! Local scan pointer scan_pointer = .source_pointer; ! Start search at the beginning of the string. INCR index FROM 1 TO .source_length DO ! Check each character for a match in the pattern string. BEGIN IF CH$FAIL( CH$FIND_SUB( .pattern[STR$H_LENGTH], .pattern[STR$A_POINTER], 1, .scan_pointer ) ) THEN EXITLOOP; scan_pointer = CH$PLUS( .scan_pointer, 1 ); ! Point to the next character. END; sub_length = CH$DIFF( .scan_pointer, ! Calculate the length of the substring found. .source_pointer ); sub_pointer = .source_pointer; ! The substring always starts at the beginning ! of the source string. END; %TITLE 'XST$SCAN - STOP At Delimiter' !+ ! ! $STR_SCAN( STOP = character-stream, ... ) ! !- [ STR$K_STOP ] : BEGIN LOCAL scan_pointer; ! Local scan pointer scan_pointer = .source_pointer; ! Start search at the beginning of the string. INCR index FROM 1 TO .source_length DO ! Check each character for no match in the pattern string. BEGIN IF NOT CH$FAIL( CH$FIND_SUB( .pattern[STR$H_LENGTH], .pattern[STR$A_POINTER], 1, .scan_pointer ) ) THEN EXITLOOP; scan_pointer = CH$PLUS( .scan_pointer, 1 ); ! Point to the next character. END; sub_length = CH$DIFF( .scan_pointer, ! Calculate the length of the substring found. .source_pointer ); sub_pointer = .source_pointer; ! The substring always starts at the beginning ! of the source string. END; TES; %TITLE 'XST$SCAN - Common Post-scan Processing' !+ ! ! Continuation of common scan processing. ! !- ! ! Determine an appropriate scanning success completion code ! and return the character following the substring found. ! IF CH$PLUS( .sub_pointer, .sub_length ) EQLA ! If the substring is at the end of the source string, CH$PLUS( .source_pointer, .source_length ) THEN ! BEGIN ! primary_code = STR$_END_STRING; ! indicate that the end of the string has been reached IF .delimiter NEQ 0 ! THEN ! .delimiter = %CHAR( 0 ); ! and return a null delimiter code. END ELSE BEGIN primary_code = 1; ! Otherwise, indicate a normal successful scan IF .delimiter NEQ 0 ! and return the character following the substring. THEN .delimiter = CH$RCHAR( CH$PLUS( .sub_pointer, .sub_length ) ); END; ! ! If requested, return a copy of the substring found. ! IF .output EQL 0 ! If neither SUBSTRING= or TARGET= was specified, THEN ! $STR_QUIT(); ! jump to return to the caller. IF .options[STR$V_TARGET] ! If TARGET=desc was specified, THEN ! return a copy of the substring found. BEGIN $XPO_IF_NOT( $STR_COPY( STRING = (.sub_length,.sub_pointer), TARGET = .output, FAILURE = 0 ) ) THEN $STR_QUIT( BAD_TARGET, (.$XPO_STATUS) ); END ! ! If requested, fill in the caller's substring descriptor. ! ELSE BEGIN IF .output[STR$B_CLASS] EQL STR$K_CLASS_B OR ! Special SUBSTRING=bounded-desc processing .output[STR$B_CLASS] EQL STR$K_CLASS_DB THEN BEGIN IF .output EQLA .string THEN BEGIN output[STR$H_PFXLEN] = .string[STR$H_PFXLEN] + CH$DIFF( .sub_pointer, .string[STR$A_POINTER] ); output[STR$H_MAXLEN] = .string[STR$H_MAXLEN]; END ELSE BEGIN output[STR$H_PFXLEN] = CH$DIFF( .sub_pointer, .string[STR$A_POINTER] ); output[STR$H_MAXLEN] = .string[STR$H_LENGTH]; END; END; output[STR$H_LENGTH] = .sub_length; ! SUBSTRING=any_desc processing output[STR$A_POINTER] = .sub_pointer; END; $STR_MAIN_END; ! ! Call an appropriate action routine. ! $STR_ACTION_RTN( .options[STR$V_FUNCTION], .string, .pattern ); ! ! Free any temporary XPORT strings input to this scanning function. ! IF NOT .options[STR$V_NO_FREE_T] ! Unless this is an internal XPORT call, THEN ! BEGIN ! $STR_FREE_TEMP( .string ); ! free the source and pattern strings if they $STR_FREE_TEMP( .pattern ); ! are temporary strings. END; ! ! Return the final completion code to the caller. ! RETURN .primary_code END; END ELUDOM