MODULE SCOPY ( IDENT = 'X00.08' %TITLE 'XST$COPY - String Append Function' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XST$COPY ),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_COPY function. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHOR: Ward Clark, CREATION DATE: 27 February 1980 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XST$COPY; ! BLISS string copy routine ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $ALL ) ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! LITERAL db_allocate = ! Allocation increment for a DYNAMIC_BOUNDED string %BLISS16( 20 ) %BLISS32( 80 ) %BLISS36( 80 ); ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! GLOBAL ROUTINE XST$COPY( options, string, target, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine implements the $STR_COPY function. ! ! FORMAL PARAMETERS: ! ! options - string processing options ! string - address of the source string descriptor ! target - address of the target string descriptor ! 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 - string copy was successful ! ! STR$_BAD_SOURCE - invalid source string ! secondary = failure completion code from $STR_VALIDATE ! STR$_BAD_TARGET - invalid target string ! secondary = failure completion code from $STR_VALIDATE ! or STR$_NO_SPACE - insufficient space ! XPO$_FREE_MEM - dynamic memory deallocation error ! secondary = failure completion code from $XPO_FREE_MEM ! XPO$_GET_MEM - dynamic memory allocation error ! secondary = failure completion code from $XPO_GET_MEM ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP options : $STR_OPTIONS, string : REF $STR_DESCRIPTOR(), target : REF $STR_DESCRIPTOR( CLASS = BOUNDED ); LOCAL string_length; ! ! Initialization ! $STR_MAIN_BEGIN( COPY ) ! Beginning of MAIN_BLOCK code block $STR_VALIDATE( .string, BAD_SOURCE ); ! Validate the source and target string descriptors. $STR_VALIDATE( .target, BAD_TARGET ); string_length = .string[STR$H_LENGTH]; ! Save the original string length for potential upcasing. ! ! Select appropriate string copy processing depending on the target descriptor class. ! SELECTONE .target[STR$B_CLASS] OF SET %TITLE 'XST$COPY - Copy to FIXED String' !+ ! ! Copy source string to FIXED target string. ! !- [ STR$K_CLASS_F ] : BEGIN IF NOT .options[STR$V_TRUNCATE] AND ! Make sure that the target area is big enuf. .string[STR$H_LENGTH] GTRU .target[STR$H_LENGTH] THEN $STR_QUIT( BAD_TARGET, NO_SPACE ); CH$COPY( .string[STR$H_LENGTH], ! Copy the source string into the target area .string[STR$A_POINTER], ! truncating the source string if it is too big %C' ', ! or padding it with blanks if the target area is too big. .target[STR$H_LENGTH], .target[STR$A_POINTER] ); END; %TITLE 'XST$COPY - Copy to a DYNAMIC String' !+ ! ! Copy source string to DYNAMIC target string. ! !- [ STR$K_CLASS_D ] : BEGIN MACRO round_up( length ) = ( %BLISS16( length + 3 AND %X'FFFC' ) %BLISS32( length + 7 AND %X'FFF8' ) %BLISS36( ((length + 4) / 5) * 5 ) ) %; IF round_up( .string[STR$H_LENGTH] ) EQLU ! If the source string will exactly fit in the target area, round_up( .target[STR$H_LENGTH] ) ! THEN ! BEGIN ! CH$MOVE( .string[STR$H_LENGTH], ! move the source string into the target area .string[STR$A_POINTER], ! .target[STR$A_POINTER] ); ! ! target[STR$H_LENGTH] = ! and set the new target string length. .string[STR$H_LENGTH]; END ELSE ! If the source string will not fit in the target area, BEGIN ! a new target area must be allocated. LOCAL new_target_ptr; ! Pointer to the new target area $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a new target area. CHARACTERS = .string[STR$H_LENGTH], RESULT = new_target_ptr, FAILURE = 0 ) ) THEN $STR_QUIT( (XPO$_GET_MEM), (.$XPO_STATUS) ); CH$MOVE( .string[STR$H_LENGTH], ! Copy the source string into the target area. .string[STR$A_POINTER], .new_target_ptr ); $XPO_IF_NOT( $XPO_FREE_MEM( ! Free the old target area. STRING = .target, FAILURE = 0 )) THEN $STR_QUIT( (XPO$_FREE_MEM), (.$XPO_STATUS) ); ! Update the target area descriptor: target[STR$H_LENGTH] = ! resulting string length .string[STR$H_LENGTH]; ! target[STR$A_POINTER] = .new_target_ptr; ! pointer to new target area END; END; %TITLE 'XST$COPY - Copy to a BOUNDED String' !+ ! ! Copy source string to BOUNDED target string. ! !- [ STR$K_CLASS_B ] : BEGIN IF .string[STR$H_LENGTH] LEQU ! Compare length of source string to the available .target[STR$H_MAXLEN] - ! space in the target area. .target[STR$H_PFXLEN] THEN ! Source length LEQ target space: string_length = .string[STR$H_LENGTH] ! setup to copy entire source string ELSE ! Source length GTR target space: IF .options[STR$V_TRUNCATE] THEN ! OPTION=TRUNCATE specified: string_length = .target[STR$H_MAXLEN] - ! setup to truncate source string .target[STR$H_PFXLEN] ELSE ! Truncation not permitted: $STR_QUIT( BAD_TARGET, NO_SPACE ); ! return error codes to the caller CH$MOVE( .string_length, ! Copy the source string into the target area. .string[STR$A_POINTER], .target[STR$A_POINTER] ); ! Update the target descriptor: target[STR$H_LENGTH] = .string_length; ! string length END; %TITLE 'XST$COPY - Copy to a DYNAMIC_BOUNDED String' !+ ! ! Copy source string to a DYNAMIC_BOUNDED target string. ! !- [ STR$K_CLASS_DB ] : BEGIN LOCAL new_target_maxl, ! Maximum length of new target area new_target_ptr; ! Address of the new target area IF .string[STR$H_LENGTH] LEQU ! If the source string will fit in the target area, .target[STR$H_MAXLEN] - ! .target[STR$H_PFXLEN] ! THEN ! BEGIN ! CH$MOVE( .string[STR$H_LENGTH], ! move the source string into the target area. .string[STR$A_POINTER], .target[STR$A_POINTER] ); target[STR$H_LENGTH] = ! Set the new target string length. .string[STR$H_LENGTH]; END ELSE ! If the source string will not fit in the target area, BEGIN ! a new target area must be allocated. new_target_maxl = .target[STR$H_MAXLEN]; ! Pickup the current target area size. WHILE .new_target_maxl LSS ! Increase the memory size until it is large enough. .string[STR$H_LENGTH] + .target[STR$H_PFXLEN] DO new_target_maxl = .new_target_maxl + db_allocate; $XPO_IF_NOT( $XPO_GET_MEM( ! Allocate a new target area. CHARACTERS = .new_target_maxl, RESULT = new_target_ptr, FAILURE = 0 ) ) THEN $STR_QUIT( (XPO$_GET_MEM), (.$XPO_STATUS) ); CH$COPY( ! Copy the following strings into the target area: .target[STR$H_PFXLEN], ! prefix string CH$PLUS( .target[STR$A_POINTER], ! -.target[STR$H_PFXLEN] ), ! .string[STR$H_LENGTH], ! source string .string[STR$A_POINTER], 0, .new_target_maxl, .new_target_ptr ); $XPO_IF_NOT( $XPO_FREE_MEM( ! Free the old target area. STRING = .target, FAILURE = 0 )) THEN $STR_QUIT( (XPO$_FREE_MEM), (.$XPO_STATUS) ); ! Update the target area descriptor: target[STR$H_LENGTH] = ! resulting string length .string[STR$H_LENGTH]; ! target[STR$A_POINTER] = .new_target_ptr; ! pointer to new target area target[STR$H_MAXLEN] = .new_target_maxl; ! maximum string length END; END; TES; %TITLE 'XST$COPY - Convert to Upper Case' !+ ! ! Convert the copied string to upper case if requested. ! !- IF .options[STR$V_UP_CASE] THEN BEGIN LOCAL character, ! A single ASCII character pointer; ! Pointer into target string pointer = CH$PLUS( .target[STR$A_POINTER], ! Point to the character preceding the copied string. .target[STR$H_LENGTH] - .string_length - 1 ); INCR index FROM 1 TO .string_length DO ! Loop through the copied string. BEGIN character = CH$A_RCHAR( pointer ); ! Pickup a single ASCII character. IF .character GEQ %C'a' AND ! If it is a lower-case character, .character LEQ %C'z' ! THEN ! CH$WCHAR( .character - %C' ', ! convert it to upper-case. .pointer ); END; END; %TITLE 'XST$COPY - Routine Termination' !+ ! ! XST$COPY Routine Termination ! !- ! ! Setup a normal routine completion code. ! $STR_QUIT( NORMAL ); $STR_MAIN_END; ! End of MAIN_BLOCK code block ! ! Call an appropriate action routine. ! $STR_ACTION_RTN( .options, .string, .target ); ! ! Free an temporary XPORT string used in this string copy. ! IF NOT .options[STR$V_NO_FREE_T] ! Unless this is an internal XPORT call, THEN ! $STR_FREE_TEMP( .string ); ! free the source string if it is a temporary string. ! ! Return the final completion code to the caller. ! RETURN .primary_code END; END ELUDOM