MODULE SBIN ( IDENT = 'X00.06' %TITLE 'XST$BINARY - ASCII-to-Binary Conversion' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XST$BINARY ),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_BINARY function. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHOR: Ward Clark, CREATION DATE: 21 February 1980 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XST$BINARY, ! ASCII-to-binary conversion function ASCII_TO_BINARY; ! Actual ASCII-to-binary conversion 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 yes = 1, ! Used to turn an indicator on no = 0; ! Used to turn an indicator off ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! %TITLE 'XST$BINARY - ASCII String to Binary Value Conversion' GLOBAL ROUTINE XST$BINARY( options, string, result, low_limit, high_limit, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine implements the $STR_BINARY function. ! ! FORMAL PARAMETERS: ! ! options - string processing options ! string - address of the source string descriptor ! result - address of the result deposit area ! low_limit - integer conversion lower limit ! high_limit - integer conversion high limit ! 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 conversion ! ! STR$_BAD_REQ - invalid request ! secondary = XPO$_BAD_ADDR - RESULT= does not point to a BLISS fullword ! STR$_BAD_SOURCE - invalid source string ! secondary = STR$_BAD_CHAR - invalid character ! STR$_OUT_RANGE - integer value is out of range ! failure completion code from $STR_VALIDATE ! failure completion code from ASCII_TO_BINARY ! STR$_NO_SUPPORT - requested conversion function is not yet supported ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP options : $STR_OPTIONS, string : REF $STR_DESCRIPTOR(); LOCAL scan_desc : $STR_DESCRIPTOR( CLASS = BOUNDED ); ! ! Initialization ! $STR_MAIN_BEGIN( BINARY ) ! Beginning of MAIN_BLOCK code block $STR_VALIDATE( .string, BAD_SOURCE ); ! Validate the source string. %IF %BLISS(BLISS16) %THEN IF .result ! Verify that the result area starts on a word boundary. THEN $STR_QUIT( BAD_REQ, (XPO$_BAD_ADDR) ); %FI %IF %BLISS(BLISS32) %THEN IF .result AND %X'03' ! Verify that the result area is at a longword boundary. THEN $STR_QUIT( BAD_REQ, (XPO$_BAD_ADDR) ); %FI $STR_DESC_INIT( DESCRIPTOR = scan_desc, ! Setup a local bounded string descriptor to be used CLASS = BOUNDED, ! in scanning the ASCII source string. STRING = .string ); ! ! Select appropriate processing based on the type of conversion requested. ! CASE .options[STR$V_FUNCTION] FROM 0 TO STR$K_DAY OF SET %TITLE 'XST$BINARY - Integer Conversion' !+ ! ! Integer Conversion ! !- [ STR$K_BASE2, STR$K_BASE8, STR$K_BASE10, STR$K_BASE16, STR$K_DFLT_FUNC ] : BEGIN LOCAL binary_value, ! Local binary work area negate_value, ! Indicates whether to negate the final binary value. delimiter, ! Sub-sting delimiter base; ! Integer conversion base negate_value = no; ! Initially assume a positive value. ! ! Process the character which precede the actual integer string. ! $STR_SCAN( REMAINDER = scan_desc, ! Skip past any leading spaces. SPAN = ' ', SUBSTRING = scan_desc, DELIMITER = delimiter ); SELECT .delimiter OF ! Use the delimiter character to select additional processing. SET [ %C'-' ] : ! Minus sign: negate_value = yes; ! Indicate final result must be negated. [ %C'-', %C'+' ] : ! Minus sign or plus sign: BEGIN scan_desc[STR$H_LENGTH] = ! Include the sign in the current substring. .scan_desc[STR$H_LENGTH] + 1; $STR_SCAN( REMAINDER = scan_desc, ! Skip past spaces between the sign and the number. SPAN = ' ', SUBSTRING = scan_desc ); END; TES; ! ! Convert the integer string to a binary value. ! base = ( CASE .options[STR$V_FUNCTION] ! Calculate a base value. FROM STR$K_DFLT_FUNC TO STR$K_BASE16 OF SET [ STR$K_DFLT_FUNC ] : 10; [ STR$K_BASE2 ] : 2; [ STR$K_BASE8 ] : 8; [ STR$K_BASE10 ] : 10; [ STR$K_BASE16 ] : 16; TES ); $XPO_IF_NOT( ASCII_TO_BINARY( .base, ! Convert from ASCII to binary. scan_desc, binary_value, delimiter ) ) THEN $STR_QUIT( BAD_SOURCE, (.$XPO_STATUS) ); ! ! Make sure the binary value is within the limits specified by the user. ! IF .negate_value ! Negate the binary value if necessary: THEN BEGIN IF .binary_value LSS 0 ! Make sure that the value is not too large THEN ! to convert to a negative value. $STR_QUIT( BAD_SOURCE, OUT_RANGE ); binary_value = -.binary_value; ! Make the final value negative. END; IF (.low_limit NEQ 0 OR .high_limit NEQ 0) AND ! If range checking has been requested ( .binary_value LSS .low_limit OR ! and the final value is too small .binary_value GTR .high_limit ) ! or too large, THEN ! $STR_QUIT( BAD_SOURCE, OUT_RANGE ); ! return error codes to the caller. ! ! Allow spaces after the integer string. ! IF $STR_SCAN( REMAINDER = scan_desc, ! Skip past any trailing spaces. SPAN = ' ', SUBSTRING = scan_desc ) NEQ STR$_END_STRING ! Make sure that the end of the string has been reached. THEN $STR_QUIT( BAD_SOURCE, BAD_CHAR ); ! ! Return the final binary integer value to the caller. ! IF .result NEQ 0 ! If a result value address was provided, THEN ! .result = .binary_value; ! return the final value to the caller. $STR_QUIT( NORMAL ); ! Jump to return a success code to the caller. END; %TITLE 'XST$BINARY - Date/Time Conversion' !+ ! ! Date/Time Conversion ! !- [ STR$K_DATE, STR$K_TIME, STR$K_DAY ] : $STR_QUIT( NO_SUPPORT ); TES; %TITLE 'XST$BINARY - Routine Termination' !+ ! ! XST$BINARY Common Routine Termination ! !- $STR_MAIN_END; ! End of MAIL_BLOCK code block ! ! Call an appropriate action routine. ! $STR_ACTION_RTN( .options[STR$V_FUNCTION], .string, .result ); ! ! Free a temporary string used in this conversion function. ! 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; %TITLE 'ASCII_TO_BINARY - Integer Conversion Routine' ROUTINE ASCII_TO_BINARY( base, substring, value_addr, delimiter_addr ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine converts an integer ASCII string into its corresponding binary value. ! ! FORMAL PARAMETERS: ! ! base - conversion base ! substring - address of a substring descriptor (BOUNDED) ! value_addr - address of the binary value result ! delimiter_addr - address the integer string delimiter result ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! The substring descriptor is updated to describe the integer string. ! ! COMPLETION CODES: ! ! STR$_NORMAL - ASCII-to-binary conversion was successful ! ! STR$_BAD_CHAR - integer string begins with an invalid character ! STR$_NULL_STRNG - null integer string specified ! STR$_OUT_RANGE - integer value is larger than a BLISS fullword ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP substring : REF $STR_DESCRIPTOR( CLASS = BOUNDED ); BIND value = .value_addr, delimiter = .delimiter_addr; LOCAL possible_chars, ! Number of possible integer characters pointer, ! Local integer string pointer digit, ! Single digit of the integer string status; ! Temporary routine completion code %IF %BLISS(BLISS36) %THEN BUILTIN LSH; ! BLISS-36 logical shift function %FI ! ! Find the end of the integer string. ! IF .base EQL 16 ! If this a hexidecimal conversion, THEN ! possible_chars = 16 + 6 ! there are 22 possible different digits. ELSE possible_chars = .base; ! Otherwise, there are only "base" possible characters. status = $STR_SCAN( REMAINDER = .substring, ! Span the integer substring. SPAN = ( .possible_chars, CH$PTR( UPLIT('0123456789abcdefABCDEF') ) ), DELIMITER = delimiter, SUBSTRING = .substring ); IF .substring[STR$H_LENGTH] EQL 0 ! If a null string was found, THEN ! return an appropriate error code. IF .status EQL STR$_END_STRING THEN RETURN STR$_NULL_STRNG ELSE RETURN STR$_BAD_CHAR; ! ! Convert the integer string one character at a time. ! pointer = .substring[STR$A_POINTER]; ! Point to the first character of the integer string. value = 0; ! Start out with a zero value. INCR counter FROM 1 TO .substring[STR$H_LENGTH] DO ! Loop to end of the integer string. BEGIN digit = CH$RCHAR_A( pointer ); ! Pickup a digit and advance the local pointer. IF .digit LEQ %C'9' ! Convert the character to a binary value. THEN digit = .digit - %C'0' ELSE digit = (.digit AND %X'4F') - %C'A' + 10; IF .value GTRU ! Make sure the following calculation will not overflow. ( ( (-1 - .digit) ^ -1 ) AND %BLISS16( %X'7FFF' ) %BLISS32( %X'7FFFFFFF' ) ! This expression is an unsigned version of %BLISS36( %X'7FFFFFFFF' ) ) / ! (-1 - .digit) / .base ( .base / 2 ) THEN RETURN STR$_OUT_RANGE; %IF %BLISS(BLISS36) %THEN ! Calculate a new intermediate value. value = LSH( .value * (.base/2), 1 ) + .digit; %ELSE value = .value * .base + .digit; %FI END; ! ! Return to the caller. ! RETURN STR$_NORMAL END; END ELUDOM