Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE DECASC	(
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%ELSE
		    LANGUAGE(BLISS36)
		%FI
		) =
BEGIN

!
!			COPYRIGHT (c) 1982 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:	CMS Library processor
!
! ABSTRACT:
!
!	Convert decimal to ASCII and hex to ASCII
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 21-Sep-79
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	DECASC,
	DECASZ,
	HEXASC,
	HEXASZ;

!
! INCLUDE FILES:
!

%if %bliss(bliss32) %then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi

LIBRARY 'XPORT:';		!XPORT I/O macros

REQUIRE 'SCONFG:';		!CMS configuration options

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
	BUG;

GLOBAL ROUTINE DECASC (VALUE,BUFPTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Convert decimal to ASCII
!
! FORMAL PARAMETERS
!
!	VALUE - value to be converted to ASCII
!	BUFPTR - pointer to buffer where value will be stored(if not zero)
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    DECASZ(.VALUE,.BUFPTR,0)

    END;				!End of DECASC

GLOBAL ROUTINE DECASZ (VALUE,BUFPTR,FIELD_SZ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Convert decimal to ASCII
!
! FORMAL PARAMETERS
!
!	VALUE - value to be converted to ASCII
!	BUFPTR - pointer to buffer where value will be stored(if not zero)
!	FIELD_SZ - If <> 0 leading zero fill to max field size of FIELD_SZ
!		   (FIELD_SZ is always less or equal to MAX_NUM_SIZE)
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	COUNT,
	LEFT_OVER,
	PTR,
	TEXT: VECTOR[CH$ALLOCATION(MAX_NUM_SIZE)],
	TEXT_PTR;

    IF
	.FIELD_SZ GTR MAX_NUM_SIZE
    THEN
	FIELD_SZ=MAX_NUM_SIZE;

    PTR=.BUFPTR;

    !Initialize residue value
    LEFT_OVER=.VALUE;

    !Zero characters so far
    COUNT=0;

    !Start of temporary text buffer
    TEXT_PTR=CH$PTR(TEXT);

    !Accumulate the string of characters
    DO
	BEGIN
	IF
	    .COUNT GTR MAX_NUM_SIZE
	THEN
	    BUG(LIT('Conversion error in DECASC'));
	!Convert value to ASCII characters
	CH$WCHAR_A(((.LEFT_OVER MOD 10) + %C'0'),TEXT_PTR);
	!Discard used character
	LEFT_OVER=.LEFT_OVER/10;
	!Remember how many characters so far
	COUNT=.COUNT+1
	END
    UNTIL
	!Quit when nothing left
	.LEFT_OVER EQL 0;

    IF .BUFPTR NEQ 0
    THEN
	BEGIN

        !Place the fill in the buffer
        INCR I FROM 1 TO .FIELD_SZ-.COUNT DO
	    CH$WCHAR_A(%C'0',PTR);

        !Place the converted number in the user's buffer
        INCR I FROM 1 TO .COUNT DO
	    CH$WCHAR_A(CH$RCHAR(CH$PLUS(.TEXT_PTR,-.I)),PTR);

	END;
    IF
	.FIELD_SZ EQL 0
    THEN
	.COUNT
    ELSE
	.FIELD_SZ

    END;				!End of DECASZ

GLOBAL ROUTINE HEXASC (VALUE,BUFPTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Convert hexadecimal to ASCII
!
! FORMAL PARAMETERS
!
!	VALUE - value to be converted to ASCII
!	BUFPTR - pointer to buffer where value will be stored(if not zero)
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    HEXASZ(.VALUE,.BUFPTR,0)

    END;				!End of HEXASC

GLOBAL ROUTINE HEXASZ (VALUE,BUFPTR,FIELD_SZ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Convert HEXADECIMAL to ASCII
!
! FORMAL PARAMETERS
!
!	VALUE - value to be converted to ASCII
!	BUFPTR - pointer to buffer where value will be stored(if not zero)
!	FIELD_SZ - If <> 0 leading zero fill to max field size of FIELD_SZ
!		   (FIELD_SZ is always less or equal to MAX_NUM_SIZE)
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	The length of the string is returned
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	COUNT,
	NEW_VAL,
	num_len,
	PTR,
	TEXT: VECTOR[CH$ALLOCATION(MAX_NUM_SIZE)],
	TEXT_PTR;

    IF
	.FIELD_SZ GTR MAX_NUM_SIZE
    THEN
	FIELD_SZ=MAX_NUM_SIZE;
   if .field_sz eql 0 
   then
	num_len = 32
    else
	num_len = .field_sz * 4 ;

    PTR=.BUFPTR;

    !Zero characters so far
    COUNT=0;

    !Start of temporary text buffer
    TEXT_PTR=CH$PTR(TEXT);

    !Accumulate the string of characters

     incr i from 0 to .num_len - 4 by 4 do
     	begin
	local
	    num;
	if .count gtr max_num_size
	then
	    BUG(LIT('Conversion error in HEXASC'));
	! Get a number
	new_val = .value< .i,4 >;

	!Convert value to ASCII characters
	IF .NEW_VAL GEQ 10 
	THEN
	    NEW_VAL = .NEW_VAL + %X'37'
	ELSE
            NEW_VAL = .NEW_VAL + %C'0';

	!Write character in save buffer
	CH$WCHAR_A(.NEW_VAL,TEXT_PTR);
	!Remember how many characters so far
	COUNT=.COUNT+1
	END ;

    IF .BUFPTR NEQ 0
    THEN
	BEGIN

        !Place the fill in the buffer
        INCR I FROM 1 TO .FIELD_SZ-.COUNT DO
	    CH$WCHAR_A(%C'0',PTR);

        !Place the converted number in the user's buffer
        INCR I FROM 1 TO .COUNT DO
	    CH$WCHAR_A(CH$RCHAR(CH$PLUS(.TEXT_PTR,-.I)),PTR);

	END;
    IF
	.FIELD_SZ EQL 0
    THEN
	.COUNT
    ELSE
	.FIELD_SZ

    END;				!End of DECHEX

END				!End of Module DECASC
ELUDOM