Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
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