Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/rmscnv.b36
There are 3 other files named rmscnv.b36 in the archive. Click here to see a list.
MODULE RMSCNV (					! Data conversions
               IDENT='1'
              )=
BEGIN              
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
!	ALL RIGHTS RESERVED.
!
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY: RMS-20
!
! ABSTRACT: This module contains routines to convert among the datatypes
!           known to RMS:  ASCII, Packed decimal, Integer, Long (2 word)
!           Integer, and Unsigned Integer.
!           Floating-point conversion routines are in RMSFLO.
!
!
! ENVIRONMENT: TOPS-20 or TOPS-10 (KL only)
!
! AUTHOR:	Andrew Nourse, CREATION DATE: 30-August-83
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	cvtps,                          ! Convert PACKED to ASCII string
        cvtsp,                          ! Convert ASCII string to PACKED
	cvtzp,                          ! Convert ASCIZ string to PACKED
        cvtsi,                          ! Convert ASCII string to INTEGER
        cvtsl,                          ! Convert ASCII string to LONG INTEGER
        cvtzl,                          ! Convert ASCIZ string to LONG INTEGER
        cvtsu,                          ! Convert ASCII string to UNSIGNED
        cvtzu,                          ! Convert ASCIZ string to UNSIGNED
        cvtsd,                          ! Convert ASCII string to DOUBLE
        cvtzd,                          ! Convert ASCIZ string to DOUBLE
        cvtsg,                          ! Convert ASCII string to G-FLOATING
        cvtzg,                          ! Convert ASCIZ string to G-FLOATING
        signbe,                         ! Check for sign at begin and end
        signb,                          ! Check for sign at beginning
        plusminus;                      ! Check char for + or -

!
! INCLUDE FILES:
!

!
! MACROS:
!
MACRO                                   ! All legal forms of BCD signs
    Visible_Plus_signs=%X'A',%X'C' %,
    Invisible_Plus_signs=%X'E',%X'F' %,
    Minus_signs=%X'B',%X'D' %;

MACRO DMUL(r,y)=MACHOP(%O'116',r,y) %;

!
! EQUATED SYMBOLS:
!

LITERAL                                 ! The form of BCD signs we store
    Visible_Plus_sign=%X'A',
    Invisible_Plus_sign=%X'E',
    Minus_sign=%X'B';

LITERAL maximum_packed_field_length=12;
LITERAL digit_size=4,
    	digit_mask=%X'F';

!
! OWN STORAGE:
!

!
! BUILTIN FEATURES:
!

BUILTIN MACHOP;

!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
    cvtld,
    cvtlg;
GLOBAL ROUTINE cvtps(packednum,str)=		! Convert Packed to String
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert a packed decimal number to a string
!
! FORMAL PARAMETERS:
!
!   	packednum:	Address of Byte Pointer to packed decimal string
!   	str:		Address of Byte Pointer to store ascii string
!
! RETURNED VALUE:
!
!   	Number of characters in string
!
! SIDE EFFECTS:
!
!   	The byte pointers are updated past the strings
!--
BEGIN
LOCAL len;	! Temp to store length of result

len=( 
    INCR i from 1 TO maximum_packed_field_length
    DO
	BEGIN
	LOCAL b;	! Current byte from packed-decimal string
	LOCAL d;	! Current decimal digit

	b=CH$RCHAR_A(.packednum);	! This will contain 2 digits

	d=(.b^-digit_size) AND digit_mask;	! Fetch the first digit
	d=.d+%C'0';                     ! Convert the first digit to ASCII
	CH$WCHAR_A(.d,.str);		! Write it out to the destination

	d=.b AND digit_mask;		! Fetch the second digit
	CASE .d FROM %X'A' TO %X'F' OF
	    SET
                [Visible_plus_signs]:
		BEGIN
		CH$WCHAR_A(%C'+',.str);	! Write out a trailing plus sign
		EXITLOOP .i*2;
		END;
	    [Minus_signs]:
		BEGIN
		CH$WCHAR_A(%C'-',.str);	! Write out trailing minus sign
		EXITLOOP .i*2;
		END;
	    [Invisible_Plus_signs]:
		EXITLOOP .i*2-1;	! We are done
	    [OUTRANGE]:			   ! Has to be a real digit
		CH$WCHAR_A(.d+%C'0',.str); ! Write it out to the destination
	    TES
	END ! Loop
    );
CH$WCHAR(0,.str); ! Write a null after the digits to make ASCIZ
    		  ! This does not update the pointer, so the null
    		  ! gets overwritten if the string is appended to
.len ! Return length of output string
END;                                    ! END OF CVTPS
GLOBAL ROUTINE cvtsp(str,alen,packednum,len)=  ! Convert ASCIZ String to PACKED
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCII string to a packed decimal number 
!
! FORMAL PARAMETERS:
!
!   	str:		Address of Byte Pointer to ascii string
!	alen:		Length of ascii string
!   	packednum:	Address of Byte Pointer to store packed decimal string
!       len:            Length of packed decimal string
!
! RETURNED VALUE:
!
!   	0	If ASCII field cannot be converted to packed decimal
!       1	If ASCII field can be converted to packed decimal
!
! SIDE EFFECTS:
!
!   	The byte pointers are updated past the strings
!--
BEGIN
BIND bcdsign=UPLIT(Minus_sign,          ! [-1] Minus
                   Invisible_Plus_sign, ! [0]  No sign provided, thereby plus
                   Visible_Plus_sign)   ! [1]  Explicit plus sign provided
             + 1 : VECTOR;              ! Add 1 to make origin -1

LOCAL sign: INITIAL(0),
      byt: INITIAL(0),                  ! byte to stuff 2 nibbles into
      nibbles,                          ! number of nibbles
      fillers;                          ! number of leading 0's to add

sign=signbe(.str,alen);                 ! Get the sign & adjust ptr & count

nibbles=.len*2;                         ! Number of digits in field incl sign
fillers=.nibbles-1-.alen;               ! Number of leadig zero digits to add
IF .fillers LSS 0 THEN RETURN 0;        ! Won't fit. Lose!

INCR i FROM 1 TO .nibbles-1
DO  BEGIN
    LOCAL c;
    IF .fillers GTR 0                   ! Still padding?
    THEN
        BEGIN
        fillers=.fillers-1;             ! countdown
        c=0;                            ! Pad with a leading zero
        END
    ELSE c=CH$RCHAR_A(.str)-%C'0';      ! Done padding, get a real character

    IF (.c LSS 0) OR (.c GTR 9)         ! Is this a real digit?
    THEN RETURN 0;                      ! No. Lose!

    IF .i                                   ! 1st,3rd,5th... digits
    THEN byt=.c^digit_size                  ! go in left nibble of byte
    ELSE CH$WCHAR_A(.byt OR .c,.packednum); ! even digits into right nibble
    END;

CH$WCHAR_A(.byt OR .bcdsign[.sign],.packednum);  ! Write out the sign
1                                       ! Return TRUE
END;
GLOBAL ROUTINE cvtzp(str,packednum,len)=     ! Convert ASCIZ String to PACKED
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to a packed decimal number 
!
! FORMAL PARAMETERS:
!
!   	str:		Byte Pointer to ascii string
!   	packednum:	Byte Pointer to store packed decimal string
!       len:            Length of packed decimal string
!
! RETURNED VALUE:
!
!   	Number of characters in ASCIZ string, or
!   	0	If ASCII field cannot be converted to packed decimal
!
!--
BEGIN
LOCAL alen: INITIAL(0);                 ! Length of string
LOCAL tptr;                             ! Copy of pointer to string

tptr=.str;

WHILE (CH$RCHAR_A(tptr) NEQ 0) DO alen=.alen+1; ! Count until we see a null

IF cvtsp(str,.alen,packednum,.len)      ! Routine that uses counted strings
THEN .alen                              ! Success, return length of source str
ELSE 0                                  ! Failure, return 0
END;                                    ! CVTZP
GLOBAL ROUTINE cvtsi(str,len,int)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCII string to INTEGER
!
! FORMAL PARAMETERS:
!
!   	str:		Address of Byte Pointer to ascii string
!       len:            Length of ASCII string
!       int:            Address to store Long Integer
!
! RETURNED VALUE:
!
!	1	If ASCII field can be converted
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL
    sign;

.int=0;                                 ! Init destination cell

sign=signb(.str,len) OR 1;              ! Get the sign & adjust ptr & count
                                        ! Make unspecified sign positive

DECR I FROM .len-1 TO 0
DO  BEGIN
    LOCAL c;

    c=CH$RCHAR_A(.str)-%C'0';           ! Get next character and un-ascify
    IF (.c LSS 0) OR (.c GTR 9)         ! Make sure it is a digit
    THEN RETURN 0;                      ! It wasn't. Lose!

    .int=..int*10+.c;                   ! Multiply it all by 10
    END;

.int=..int*.sign;                       ! Put sign back
1                                       ! Return TRUE
END;                                    ! CVTSI
GLOBAL ROUTINE cvtsl(str,len,longint: REF VECTOR)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCII string to a LONG INTEGER
!
! FORMAL PARAMETERS:
!
!   	str:		Address of Byte Pointer to ascii string
!       len:            Length of ASCII string
!       longint:        Address to store Long Integer
!
! RETURNED VALUE:
!
!	1	If ASCII field can be converted
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL
    sign;

REGISTER
    temp1=6: INITIAL(0),
    temp2=7: INITIAL(0),
    temp3=8: INITIAL(0),
    temp4=9: INITIAL(0);

sign=signb(.str,len) OR 1;              ! Get the sign & adjust ptr & count
                                        ! Make unspecified sign positive

DECR I FROM .len-1 TO 0
DO  BEGIN
    LOCAL c;

    c=CH$RCHAR_A(.str)-%C'0';           ! Get next character and un-ascify
    IF (.c LSS 0) OR (.c GTR 9)         ! Make sure it is a digit
    THEN RETURN 0;                      ! It wasn't. Lose!

    dmul(temp1,UPLIT(0,10));            ! Multiply it all by 10
    temp2=.temp2; temp3=.temp3; temp4=.temp4; ! Hack to keep compiler away

    IF (.temp1 NEQ 0) OR (.temp2 NEQ 0) ! Check if we will overflow
    THEN RETURN 0;                      ! Yes. Lose!

    temp1=.temp3;                       ! Move low order result up
    temp2=.temp4+.c;                    ! and add in new digit
    END;

IF .sign LSS 0                          ! Is this negative
THEN
    BEGIN                               ! yep.
    dmul(temp1,UPLIT(-1,-1));           ! Negate it.
    longint[0]=.temp3;                  ! Store result including sign
    longint[1]=.temp4;                  !
    END
ELSE
    BEGIN
    longint[0]=.temp1;
    longint[1]=.temp2;
    END;

1                                       ! Return TRUE
END;                                    ! CVTSL
GLOBAL ROUTINE cvtsls(str,len,longint: REF VECTOR, scale)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCII string to a LONG INTEGER with scale factor 
!
! FORMAL PARAMETERS:
!
!   	str:		Address of Byte Pointer to ascii string
!       len:            Length of ASCII string
!       longint:        Address to store Long Integer
!       scale:          Decimal scale factor
!
! RETURNED VALUE:
!
!	1	If ASCII field can be converted
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL
    sign,
    mantissa: VECTOR[CH$ALLOCATION(20)],
    mptr,
    digits_in_mantissa: INITIAL(0),
    digits_before_point: INITIAL(-1),
    c,
    expptr;                             ! pointer to exponent, if any

mptr=CH$PTR(mantissa);
!
! Look for exponent
!
expptr=..str;                           ! Look for exponent starting here
.scale=0;

INCR i FROM 0 TO .len-1                 ! Loop through the string
DO SELECT (c=CH$RCHAR_A(expptr)) OF     !  looking for
    SET
    [%C'D' TO %C'G', %C'd' TO %C'g']:   ! a character that introduces 
        BEGIN                           !     an exponent.
        IF cvtsi(expptr,.len-.i-1,.scale) EQL 0 ! Convert scale factor
        THEN RETURN 0;                  	! unless we can't 
        len=.i;                         ! Length of mantissa
        EXITLOOP;
        END;
    [%C'.']: digits_before_point=.digits_in_mantissa;

    [%C'+', %C'-', %C'0' TO %C'9']:
        BEGIN
        CH$WCHAR_A(.c,mptr);   ! copy mantissa
        digits_in_mantissa=.digits_in_mantissa+1;
        END;
    TES;        

.str=.expptr;                           ! Update caller's byte pointer

IF .digits_before_point GEQ 0           ! If decimal point seen
THEN .scale=..scale+.digits_before_point-.digits_in_mantissa; ! Adjust scale

cvtsl(%REF(CH$PTR(mantissa)),.digits_in_mantissa,.longint)
                                        ! Convert the rest as normally
END;                                    ! CVTSLS
GLOBAL ROUTINE cvtzl(str,longint: REF VECTOR)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to a LONG INTEGER
!
! FORMAL PARAMETERS:
!
!   	str:		Byte Pointer to ascii string
!       longint:        Address to store Long Integer
!
! RETURNED VALUE:
!
!   	Number of characters in ASCIZ string, or
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL alen: INITIAL(0);                 ! Length of string
LOCAL tptr;                             ! Copy of pointer to string

tptr=.str;

WHILE (CH$RCHAR_A(tptr) NEQ 0) DO alen=.alen+1; ! Count until we see a null

IF cvtsl(str,.alen,.longint)            ! Routine that uses counted strings
THEN .alen                              ! Success, return length of source str
ELSE 0                                  ! Failure, return 0
END;                                    ! CVTZL
GLOBAL ROUTINE cvtsu(str,len,unsint)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCII string to a UNSIGNED INTEGER
!
! FORMAL PARAMETERS:
!
!   	str:		Byte Pointer to ascii string
!       len:            Length of ASCII string
!       unsint:         Address to store Unsigned Integer
!
! RETURNED VALUE:
!
!	1	If ASCII field can be converted
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL
    longint: VECTOR[2];                 ! Temp for Long-integer result

IF CVTSL(.str,.len,longint)             ! Convert to long-integer
THEN RETURN 0;                          ! If we can, if not return failure

unsint=.longint[1];                     ! All significant data should be here
                                        ! so the high word should be all zero
.longint[0] EQL 0                       ! If so, win, else lose
END;                                    ! CVTSU
GLOBAL ROUTINE cvtzu(str,unsint)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to a UNSIGNED INTEGER
!
! FORMAL PARAMETERS:
!
!   	str:		Byte Pointer to ascii string
!       unsint:         Address to store Unsigned Integer
!
! RETURNED VALUE:
!
!   	Number of characters in ASCIZ string, or
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL alen: INITIAL(0);                 ! Length of string
LOCAL tptr;                             ! Copy of pointer to string

tptr=.str;

WHILE (CH$RCHAR_A(tptr) NEQ 0) DO alen=.alen+1; ! Count until we see a null

IF cvtsu(str,.alen,.unsint)             ! Routine that uses counted strings
THEN .alen                              ! Success, return length of source str
ELSE 0                                  ! Failure, return 0
END;                                    ! CVTZU
GLOBAL ROUTINE cvtsd(str,len,dbl: REF VECTOR)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to a DOUBLE FLOAT
!
! FORMAL PARAMETERS:
!
!   	str:		Addr of Byte Pointer to ASCII string
!       len:            Length of ASCII string
!       dbl:            Address to store Double Float
!
! RETURNED VALUE:
!
!	1	If ASCII field can be converted
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL
    longint: VECTOR[2],                 ! Temp for Long-integer intermediate
    scale;                              ! Scale factor for intermediate

IF cvtsls(.str,.len,longint,scale) EQL 0  ! Convert to Long-integer first
THEN RETURN 0;                          ! Fail if it did

IF cvtld(longint,.scale,.dbl)           ! Convert long to double
THEN 1                                  ! Win, return TRUE
ELSE 0                                  ! Failure, return FALSE
END;                                    ! CVTSD
GLOBAL ROUTINE cvtzd(str,dbl: REF VECTOR)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to a DOUBLE FLOAT
!
! FORMAL PARAMETERS:
!
!   	str:		Byte Pointer to ascii string
!       dbl:           Address to store Double Float
!
! RETURNED VALUE:
!
!   	Number of characters in ASCIZ string, or
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL alen: INITIAL(0);                 ! Length of string
LOCAL tptr;                             ! Copy of pointer to string

tptr=.str;

WHILE (CH$RCHAR_A(tptr) NEQ 0) DO alen=.alen+1; ! Count until we see a null

IF cvtsd(str,.alen,.dbl)                ! Routine that uses counted strings
THEN .alen                              ! Success, return length of source str
ELSE 0                                  ! Failure, return 0
END;
GLOBAL ROUTINE cvtsg(str,len,gfl: REF VECTOR)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to GFLOAT
!
! FORMAL PARAMETERS:
!
!   	str:		Addr of Byte Pointer to ASCII string
!       len:            Length of ASCII string
!       gfl:            Address to store G-Float
!
! RETURNED VALUE:
!
!	1	If ASCII field can be converted
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL
    longint: VECTOR[2],                 ! Temp for Long-integer intermediate
    scale;                              ! Scale factor for intermediate

IF cvtsls(.str,.len,longint,scale) EQL 0  ! Convert to Long-integer first
THEN RETURN 0;                          ! Fail if it did

IF cvtlg(longint,.scale,.gfl)           ! Convert long to G-float
THEN 1                                  ! Win, return TRUE
ELSE 0                                  ! Failure, return FALSE
END;                                    ! CVTSG
GLOBAL ROUTINE cvtzg(str,gfl: REF VECTOR)=
!++
! FUNCTIONAL DESCRIPTION:
!
!   	Convert ASCIZ string to a DOUBLE FLOAT
!
! FORMAL PARAMETERS:
!
!   	str:		Byte Pointer to ascii string
!       gfl:           Address to store GFLOAT
!
! RETURNED VALUE:
!
!   	Number of characters in ASCIZ string, or
!   	0	If ASCII field cannot be converted
!
!--
BEGIN
LOCAL alen: INITIAL(0);                 ! Length of string
LOCAL tptr;                             ! Copy of pointer to string

tptr=.str;

WHILE (CH$RCHAR_A(tptr) NEQ 0) DO alen=.alen+1; ! Count until we see a null

IF cvtsg(str,.alen,.gfl)                ! Routine that uses counted strings
THEN .alen                              ! Success, return length of source str
ELSE 0                                  ! Failure, return 0
END;                                    ! CVTZG
ROUTINE signbe(str,alen) =              ! Check for leading or trailing sign
BEGIN
LOCAL sign;

sign=plusminus(CH$RCHAR(..str));        ! Look for sign at beginning of string
IF .sign NEQ 0                          ! If we did find one...
THEN CH$RCHAR_A(.str)                   ! Incr pointer over it
ELSE sign=plusminus(CH$RCHAR(CH$PLUS(..str,..alen)));
                                        ! Else Look for sign at end
IF .sign NEQ 0 THEN .alen=..alen-1;     ! Sign supplied, we just want # digits
.sign                                   ! Return state of sign
END;                                    ! check_sign
ROUTINE signb(str,alen) =             ! Check for leading sign
BEGIN
LOCAL sign;

sign=plusminus(CH$RCHAR(..str));        ! Look for sign at beginning of string
IF .sign NEQ 0                          ! If we did find one...
THEN
    BEGIN
    CH$RCHAR_A(.str);                   ! Incr pointer over it
    .alen=..alen-1;                     ! Sign supplied, we just want # digits
    END;
.sign                                   ! Return state of sign
END;                                    ! check_sign
ROUTINE plusminus(c)=(IF .c EQL %C'+'   ! Local routine to check for signs
                      THEN 1
                      ELSE IF .c EQL %C'-'
                           THEN -1
                           ELSE 0);
END ELUDOM