MODULE SASCII (	IDENT = 'X00.09'	%TITLE 'XST$ASCII - Binary to ASCII Conversion'
		%BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) )
		%BLISS36( ,ENTRY( XST$ASCII ),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 XPORT $STR_ASCII string pseudo-function.
!
! ENVIRONMENT:  User mode - multiple host operating/file systems
!
! AUTHOR:  Ward Clark,	CREATION DATE:  25 February 1980
!
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    XST$ASCII,						! Binary to ASCII formatting routine
    BINARY_TO_ASCII,					! Actual binary to ASCII conversion routine
    UNSIGNED_DIVIDE;					! Unsigned integer divide 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:
!

GLOBAL ROUTINE XST$ASCII( options, value, length ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine implements the $STR_ASCII string pseudo-function.
!
! FORMAL PARAMETERS:
!
!	options - string options and function code
!	value - function-specific binary value
!	length - requested resulting string length
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	address of an XPORT temporary string descriptor
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	options :  $STR_OPTIONS;

    LOCAL
	ascii_length,
	temporary :  REF $STR_DESCRIPTOR( CLASS = DYNAMIC );

!
! Initialization
!

    $STR_MAIN_BEGIN( PSEUDO )				! Beginning of MAIN_BLOCK code block

    $STR_ALLOC_TEMP( temporary );			! Setup an XPORT temporary string descriptor.

!
! Select appropriate conversion processing based on the requested conversion function.
!

    CASE .options[STR$V_FUNCTION] FROM 1 TO STR$K_DAY OF
	SET

%TITLE 'XST$ASCII - Integer Conversion'

!+
!
!	Integer Conversion
!
!-

    [ STR$K_BASE2, STR$K_BASE8, STR$K_BASE10, STR$K_BASE16 ] :

	BEGIN
	LOCAL
	    number,					! Positive value to be converted
	    negative,					! Negative value indicator
	    base,					! Integer conversion base
	    string_buffer :				! Temporary string construction buffer
		    VECTOR[ CH$ALLOCATION(%BPVAL) ],
	    fill_character,				! Leading fill character (zero or blank)
	    signif_digits;				! Number of significant digits in resulting string

!
! Prepare for binary to ASCII conversion.
!

	IF .options[STR$V_SIGNED] AND .value LSS 0	! If a negative number was specified,
	THEN						!
	    BEGIN					!
	    number = -.value;				! convert it to a positive number
	    negative = yes;				! and indicate a minus sign will be needed.
	    END
	ELSE
	    BEGIN
	    number = .value;				! Otherwise, simply copy the number
	    negative = no;				! and indicate no sign is needed.
	    END;

	base = ( CASE .options[STR$V_FUNCTION]		! Calculate a base value.
		    FROM STR$K_BASE2 TO STR$K_BASE16 OF
			SET
			[ STR$K_BASE2 ] :  2;
			[ STR$K_BASE8 ] :  8;
			[ STR$K_BASE10 ] :  10;
			[ STR$K_BASE16 ] :  16;
			TES );

!
! Convert the absolute value of the number to ASCII.
!

	signif_digits = BINARY_TO_ASCII( .number, .base, %BPVAL, CH$PTR( string_buffer ) );

!
! Calculate the resulting string length.
!

	IF .length NEQ 0				! LENGTH=non-zero value:
	THEN						!
	    ascii_length = .length			!    specified length
	ELSE
	    IF .options[STR$V_LEADING_B]		! LEADING_BLANKS:
	    THEN					!
		ascii_length =				!    significant digits + possible minus sign
			.signif_digits + .negative
	    ELSE					! LEADING_ZERO:
		ascii_length =				!    maximum length integer + possible minus sign
		    ( CASE .options[STR$V_FUNCTION]
			FROM STR$K_BASE2 TO STR$K_BASE16 OF
			    SET
			    [ STR$K_BASE2 ] :  %BPVAL;
			    [ STR$K_BASE8 ] :  ( %BPVAL + 2 ) / 3;
			    [ STR$K_BASE10 ] :  %BLISS16( 5 )  %BLISS32( 10 )  %BLISS36( 11 );
			    [ STR$K_BASE16 ] :  %BPVAL / 4;
			    TES ) + .negative;

!
! Allocate a resulting string in dynamic memory.
!

	IF .signif_digits + .negative GTR		! If the caller requested a resulting string length
		.ascii_length				! that is too small for the converted value,
	THEN						!
	    fill_character = %C'*'			! fill the resulting string with asterisks rather than
							! a truncated number.
	ELSE
	    IF .options[STR$V_LEADING_B]		! Otherwise, determine the appropriate fill character.
	    THEN
		fill_character = %C' '
	    ELSE
		fill_character = %C'0';

	$XPO_IF_NOT( $XPO_GET_MEM(			! Allocate the string and fill it.
			    CHARACTERS = .ascii_length,
			    DESCRIPTOR = .temporary,
			    FILL = .fill_character,
			    FAILURE = 0 ) )
	THEN
	    $STR_QUIT( (.$XPO_STATUS) );

!
! Put the converted integer string into the resulting area.
!

	IF .fill_character EQL %C'*'			! If the resulting string is too small,
	THEN						!
	    $STR_QUIT( NORMAL );			! return the string of asterisks to the caller.

	IF .negative					! Put a minus sign in the string if the number is negative.
	THEN
	    IF .options[STR$V_LEADING_Z]		!    LEADING_ZERO :  1st character of the string
	    THEN
		CH$WCHAR( %C'-', .temporary[STR$A_POINTER] )
	    ELSE
		CH$WCHAR( %C'-',			!    LEADING_BLANK :  before 1st significant digit
		    CH$PLUS( .temporary[STR$A_POINTER],
				.temporary[STR$H_LENGTH] - .signif_digits - 1 ) );

	CH$MOVE( .signif_digits,			! Move the converted number into the resulting string.
		CH$PLUS( CH$PTR( string_buffer ), %BPVAL - .signif_digits ),
		CH$PLUS( .temporary[STR$A_POINTER], .temporary[STR$H_LENGTH] - .signif_digits ) );

	$STR_QUIT( NORMAL );				! Indicate successful integer conversion.
	END;

%TITLE 'XST$ASCII - Date/Time/Day Conversion'

!+
!
!	Date / Time / Day  Conversion
!
!-

    [ STR$K_DATE, STR$K_TIME, STR$K_DAY ] :

	$STR_QUIT( NO_SUPPORT );

    TES;

%TITLE 'XST$ASCII - Common Routine Termination'

!+
!
!	Common Routine Termination
!
!-

    $STR_MAIN_END;					! End of MAIN_BLOCK code block

!
! Modify the temporary string descriptor in the event of an error.
!

    IF NOT .primary_code				! If the conversion failed,
    THEN						!
	BEGIN						! modify the temporary string descriptor:
	temporary[STR$B_DTYPE] = STR$K_DTYPE_XXX;	!    indicate an erroneous temporary string
	temporary[STR$A_POINTER] = .primary_code;	!    save the error code for $STR_VALIDATE
	END;

!
! Return the address of the temporary string descriptor.
!

    RETURN .temporary

    END;

%TITLE 'BINARY_TO_ASCII - Binary to ASCII Conversion'

ROUTINE BINARY_TO_ASCII( value, base, string_length, string_pointer ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine creates an ASCII representation of a positive binary value.
!
! FORMAL PARAMETERS:
!
!	value - binary value to be converted
!	base - conversion base
!	string_length - length of the caller's ASCII string buffer
!	string_pointer - pointer to the caller's ASCII string buffer
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	number of significant digits in the resulting string
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    LOCAL
	integer,					! Local value to be converted
	pointer;					! Pointer into the caller's string buffer

!
! Initialization
!

    integer = .value;					! Copy the value to be converted.

    pointer = CH$PLUS( .string_pointer,			! Point to the last character of the string buffer.
			.string_length - 1 );

!
! Convert one digit at a time.
!

    DECR counter FROM .string_length TO 1 DO		! Loop backwards thru the string buffer.
	BEGIN
	LOCAL
	    remainder;					! Current remainder

	integer = unsigned_divide( .integer,		! Remove the low order power of "base" from the value.
				    .base,
				    remainder );

	CH$MOVE( 1, CH$PTR( UPLIT('0123456789ABCDEF'), .remainder ), .pointer );

	IF .integer EQL 0				! When all significant "digits" have been produced,
	THEN						!
	    EXITLOOP;					! exit the conversion loop.

	pointer = CH$PLUS( .pointer, -1 );		! Point to the previous character.
	END;

!
! Return the number of significant "digits" produced.
!

    RETURN  CH$DIFF( CH$PLUS( .string_pointer, .string_length ), .pointer )

    END;

%TITLE 'UNSIGNED_DIVIDE - Unsigned Integer Divide'

ROUTINE unsigned_divide( dividend, divisor, addr_remainder ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine performs a integer division operation where both the
!	divisor and dividend are assumed to unsigned (positive) numbers.
!
! FORMAL PARAMETERS:
!
!	dividend - dividend value
!	divisor - divisor value
!	addr_remainder - address of fullword to receive remainder
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	quotient value
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    LOCAL
	quotient;					! Quotient result of division

%IF %BLISS(BLISS36) %THEN
    BUILTIN
	LSH;						! BLISS-36 logical shift function
%FI

!
! Calculate the quotient.
!

    quotient = .dividend ^ -1				! Shift dividend right one bit (propagating the sign)
		    AND %BLISS16( %X'7FFF' )		! and force the sign bit to 0.
			%BLISS32( %X'7FFFFFFF' )
			%BLISS36( %X'7FFFFFFFF' );

    IF .divisor NEQ 2					! Unless the caller's divisor is 2,
    THEN						! divide the quotient by half the divisor.
	quotient = .quotient / unsigned_divide( .divisor, 2, 0 );

!
! Return the remainder to the caller.
!

    IF .addr_remainder NEQ 0				! Make sure the caller wants the remainder value.
    THEN
%IF %BLISS(BLISS36) %THEN
	.addr_remainder = .dividend - LSH( (.divisor/2) * .quotient, 1 );
%ELSE
	.addr_remainder = .dividend - ( .divisor * .quotient );
%FI

!
! Return the quotient to the caller.
!

    RETURN .quotient

    END;
END
ELUDOM