Path: utzoo!utgpu!watmath!iuvax!mailrus!tut.cis.ohio-state.edu!attctc!royf
From: royf@attctc.Dallas.TX.US (Roy Frederick)
Newsgroups: comp.lang.asm370
Subject: Floating pt to and from EBCDIC
Keywords: Floating Point
Message-ID: <9003@attctc.Dallas.TX.US>
Date: 15 Aug 89 04:07:10 GMT
Organization: The Unix(R) Connection, Dallas, Texas
Lines: 437


Here are a couple of routines I cut out of a calculator program I
wrote several years ago.  The calculator itself runs on a TP monitor
used only at Dallas County - but these routines should be usable
anywhere (on an IBM mainframe or compatible, of course).

AFP converts an EBCDIC string into internal long floating point.  Put
the address of the first character of the string into SCAN.  SCAN
should not point to a space.  Put the length of the string into SCAN
+ 4 - trailing spaces are ok.  AFP will leave the result in FPR0 if
RC = 0.  RC = 4 means it found an error.  SCAN and SCAN + 4 will be
updated to point past the portion of the string converted.

CEF converts to external floating format.  Input is in FPR0.  R1
points to flags that control the result format.  Try r1->x'2785' for
a first attempt.  This should be similar to G15.5 in fortran.  Look
at the comments at the start of CEF for the details.  These routines
work only with long floating format - but it is a simple matter to
convert to and from short format if desired - at the input of CEF and
the output of AFP.

It is quite possible that there are easier and/or better ways to do
these conversions.  These routines are not claimed to be the best of
their genre - but they work for me.  Note that I did have to modify
them slightly to remove some macro calls peculiar to our TP system -
Entry and Exit macros dealing with save areas.  Hopefully I did not
introduce any errors in the process.

AFP, CEF, and FAM are free of copyright restrictions.

------------------ Cut Here -----------------------------
.AFP	 SPACE 2
**	 AFP --	ASSEMBLE FLOATING POINT	OPERAND
*
*	 ENTRY SCAN CONTAINS ADDR OF CHARS TO CONVERT
*	       SCAN + 4	CONTAINS LENGTH	OF STRING
*
*	 EXIT  RC = 0, FPR0 CONTAINS LONG FP RESULT
*	       RC = 4, STRING WAS INVALID NUMBER
*
*
AFP	 STM   14,12,12(13)	  SAVE REGS
	 SR    3,3		  SET EXPONENT TO ZERO
	 LD    0,=D'1.0'	  SET MULTIPLIER = 1
	 MVI   AFPF,0		  CLEAR	FLAG
	 LD    6,=D'0'		  PRESET ZERO RESULT
	 LM    4,5,SCAN		  POINT	TO INPUT OPERAND
*
AFP1	 CLI   0(4),C'+'	  SEE IF POSITIVE
	 BE    AFP8
	 CLI   0(4),C'-'	  SEE IF NEGATIVE
	 BE    AFP4
	 CLI   0(4),C'.'	  SEE IF DECIMAL POINT
	 BE    AFP6
	 CLI   0(4),C'E'	  SEE IF EXPONENT
	 BE    AFP7
*
	 CLI   0(4),C'0'	  MUST BE A DECIMAL DIGIT
	 BL    AFP10		  IF NOT
	 CLI   0(4),C'9'
	 BH    AFP10		  IF NOT
	 OI    AFPF,X'08'	  SHOW DIGITS FOUND
	 MVN   AFPW+7(1),0(4)	  SET DIGIT VALUE
	 TM    AFPF,X'80'	  SEE IF DIGIT IN EXPONENT
	 BO    AFP3		  IF SO
	 TM    AFPF,X'40'	  SEE IF FRACTION DIGIT
	 BO    AFP2		  IF SO
	 MD    6,=D'10.0'	  SHIFT	RESULT 1 DIGIT
	 AD    6,AFPW		  ADD IN CURRENT DIGIT
	 B     AFP9
*
AFP2	 LD    2,AFPW		  GET CURRENT DIGIT
	 AD    2,=D'0'		  NORMALIZE IT
	 DD    0,=D'10.0'	  SCALE	MULTIPLIER
	 MDR   2,0		  SHIFT	CURRENT	DIGIT
	 ADR   6,2		  ADD IN CURRENT SHIFTED DIGIT
	 B     AFP9		  NEXT CHARACTER
*
AFP3	 MH    3,=H'10'		  SHIFT	EXPONENT
	 AH    3,AFPW+6		  ADD IN CURRENT DIGIT
	 B     AFP9		  NEXT CHARACTER
*
AFP4	 TM    AFPF,X'68'	  SEE IF SIGN, DIGITS, OR DECIMAL
	 BNZ   AFP10		  END OF NUMBER	IF SO
	 TM    AFPF,X'80'	  SEE IF EXPONENT SIGN
	 BO    AFP5
	 OI    AFPF,X'30'	  SET NEGATIVE
	 B     AFP9		  NEXT CHARACTER
*
AFP5	 OI    AFPF,X'24'	  SET NEGATIVE EXPONENT, SIGN CHAR
	 B     AFP9		  NEXT CHARACTER
*
AFP6	 TM    AFPF,X'C0'	  SEE IF DECIMAL OR E
	 BNZ   ERR2		  *INVALID FP NUMBER*
	 OI    AFPF,X'40'	  SHOW DECIMAL ENCOUNTERED
	 B     AFP9		  NEXT CHARACTER
*
AFP7	 TM    AFPF,X'80'	  SEE IF E ALREADY FOUND
	 BO    ERR2
	 TM    AFPF,X'08'	  MUST BE SOME DIGITS
	 BZ    ERR2
	 NI    AFPF,255-X'68'	  NO SIGN, NO DIGITS
	 OI    AFPF,X'80'	  SHOW EXPONENT	PRESENT
	 B     AFP9		  NEXT CHARACTER
*
AFP8	 TM    AFPF,X'68'	  SEE IF SIGN, DIGITS, OR DECIMAL
	 BNZ   AFP10		  END OF NUMBER	IF SO
	 OI    AFPF,X'20'	  SET SIGN FLAG
*
AFP9	 LA    4,1(,4)		  NEXT INPUT CHARACTER
	 BCT   5,AFP1		  LOOP FOR ALL CHARACTERS
*
AFP10	 STM   4,5,SCAN		  RESET	SCAN PTRS
	 TM    AFPF,X'80'	  SEE IF ANY EXPONENT
	 BZ    AFP11		  IF NOT
	 TM    AFPF,X'08'	  MUST BE SOME DIGITS IF E
	 BZ    ERR2		  *INVALID FP NUMBER*
*
AFP11	 TM    AFPF,X'10'	  SEE IF NEGATIVE MANTISSA
	 BZ    AFP12		  IF NOT
	 LNDR  6,6		  MAKE IT NEGATIVE
*
AFP12	 LTR   3,3		  SEE IF ANY EXPONENT SPECIFIED
	 BNP   AFP14		  IF NOT
	 LD    0,=D'10.0'	  ASSUME POSITIVE EXPONENT
	 TM    AFPF,X'04'	  SEE IF NEGATIVE EXPONENT
	 BZ    AFP13		  IF NOT
	 LD    0,=D'0.10'	  SET NEGATIVE EXPONENT	MULTIPLIER
*
AFP13	 MDR   6,0		  SCALE	RESULT
	 BCT   3,AFP13
*
AFP14	 STD   6,AFPR		  STORE	RESULT
	 CLC   AFPR+1(7),=XL7'00' SEE IF TRUE ZERO REQUIRED
	 BNE   AFPX
	 XC    AFPR,AFPR	  INSURE RESULT	IS A TRUE ZERO
APFX	 LD    0,AFPR		  GET RESULT IN	FPR0
	 LM    14,12,12(13)	  RESTORE REGS
	 SR    15,15		  GIVE GOOD RC
	 BR    14		  RETURN TO CALLER
*
ERR2	 XC    AFPR,AFPR	  CLEAR	RESULT
	 LD    0,AFPR
	 LM    14,12,12(13)
	 LA    15,4		  GIVE BAD RC
	 BR    14
*
AFPR	 DC    D'0'		  RESULT
*
AFPW	 DC    X'4E00000000000000' WORK	AREA
*
AFPF	 DC    X'00'
*	 ...   X'80'		  'E' ENCOUNTERED
*	 ...   X'40'		  '.' ENCOUNTERED
*	 ...   X'20'		  SIGN ENCOUNTERED
*	 ...   X'10'		  NEGATIVE MANTISSA
*	 ...   X'08'		  DIGITS ENCOUNTERED
*	 ...   X'04'		  NEGATIVE EXPONENT
*
SCAN	 DC    A(0)		  SCAN ADDRESS
	 DC    F'0'		  LENGTH
.CEF	 SPACE 2
**	 CEF --	CONVERT	TO EXTERNAL FLOATING
*
*	 FPR0 -	NUMBER TO BE CONVERTED
*
*	 R1 -> FFNM
*	       FF = 80,	F, FIXED FORMAT
*		    40,	S, SCIENTIFIC FORMAT
*		    20,	G, EITHER OF ABOVE
*		    10,	E, ENGINEERING FORMAT
*		    08,	%, FIXED NOTATION, SCALE BY 100
*
*		    B'00000111'	SIGN OPTION
*
*		    00,	NO SIGN	DISPLAYED
*		    01,	TRAILING - SIGN	OPTION
*		    02,	CR SIGN	OPTION
*		    03,	DB SIGN	OPTION
*		    04,	$, CR
*		    05,	$, DB
*		    06,	+ SIGN OPTION
*		    07,	- SIGN OPTION
*
*	       N  = NUMBER OF FRACTION DIGITS
*	       M  = NUMBER OF INTEGER DIGITS
*
*
CEF	 STM   14,12,12(13)	  SAVE REGS
	 ST    13,CEFV+4	  BACKCHAIN
	 LA    13,CEFV		  POINT	TO SAVE	AREA
*
	 MVC   CEFB,0(1)	  SAVE FLAG BYTE
	 MVC   CEFC,CEFB	  SET SIGN CONTROL BITS
	 NI    CEFC,X'07'	  SAVE ONLY SIGN BITS
	 MVN   CEFI+1(1),1(1)	  SAVE NUMBER OF INTEGER DIGITS
	 IC    1,1(,1)		  SAVE NUMBER OF FRACTION DIGITS
	 SRL   1,4
	 STC   1,CEFF+1
	 NI    CEFF+1,X'0F'	  ...
*
	 TM    CEFB,X'08'	  SEE IF PERCENT NOTATION
	 BZ    CEF1		  IF NOT
	 MD    0,=D'100.0'	  SCALE	PERCENTAGE
*
CEF1	 LA    1,3		  CHECK	FOR MIN	INTEGER	LOCATIONS
	 TM    CEFB,X'10'	  SEE IF ENG NOTATION
	 BO    CEF2
	 LA    1,1
	 TM    CEFB,X'60'	  SCI OR SCI/FIX
	 BO    CEF2
	 SR    1,1		  NO INTEGER PORTION REQUIRED
CEF2	 CH    1,CEFI		  CHECK	AGAINST	LIMIT
	 BNH   CEF3
	 STH   1,CEFI		  SET MINIMUM
*
CEF3	 MVI   CEFS,C'+'	  ASSUME POSITIVE VALUE
	 LTDR  0,0		  TEST INPUT VALUE
	 BNM   CEF4		  IF NOT NEGATIVE
	 MVI   CEFS,C'-'	  SET NEGATIVE SIGN
*
CEF4	 MVC   CEFO,CEFO-1	  CLEAR	OUTPUT AREA
	 LA    7,CEFO		  POINT	TO OUTPUT AREA
	 CLI   CEFC,X'04'	  SEE IF LEADING SIGN OR CURRENCY
	 BL    CEF8		  DO NOT ALLOW SPACE FOR IT
	 CLI   CEFC,X'06'	  SEE IF + SIGN	OPTION
	 BE    CEF6
	 CLI   CEFC,X'07'	  SEE IF - SIGN	OPTION
	 BE    CEF5		  IF SO
	 MVI   0(7),C'$'	  SET CURRENCY SIGN
	 B     CEF7
CEF5	 CLI   CEFS,C'+'	  SEE IF POSITIVE
	 BE    CEF7		  IF SO
CEF6	 MVC   0(1,7),CEFS	  STORE	SIGN
CEF7	 LA    7,1(,7)		  ADVANCE POINTER
*
CEF8	 SR    6,6		  SET ZERO EXPONENT
	 LPDR  0,0		  SET POSITIVE SIGN
	 BZ    CEF14		  IF ZERO ARG
*
	 LD    4,=D'1.0'	  COMPUTE ROUNDING FACTOR
	 LH    2,CEFF		  GET NUMBER OF	FRACTION DIGITS
	 SLL   2,3		  INDEX	INTO SCALE TABLE
	 DD    4,CEFT00(2)	  1.0/SCALE FACTOR
	 HDR   4,4		  1.0/(2*SCALE FACTOR)
*
CEF9	 TM    CEFB,X'40'	  SEE IF SCI FORMAT
	 BO    CEF10		  IF SO
	 LH    1,CEFI		  GET INTEGER DIGITS REQUIRED
	 SLL   1,3		  X LENGTH OF FP NUMBER
	 CD    0,CEFT00(1)	  SEE IF TOO LARGE FOR F FORMAT
	 BNL   CEF10		  IF NOT
	 TM    CEFB,X'80'	  SEE IF FIXED POINT
	 BO    CEF13		  NO SCALING IF	SO
	 CD    0,=D'1.0'	  SEE IF ARG LT	1
	 BNL   CEF13		  IF NOT
	 TM    CEFB,X'10'	  SEE IF ENG FORMAT
	 BO    CEF10		  SCALE	ARG IF ENG
	 LH    1,CEFF		  PREPARE FOR SIGNIFICANCE LOSS	TEST
	 SLL   1,3
	 LD    2,=D'1.0'
	 DD    2,CEFT00(1)	  SIGNIFICANCE FACTOR
	 CDR   0,2
	 BH    CEF13		  IF SOME SIGNIFICANCE RETAINED
*
CEF10	 LD    2,CEFT01		  PRESET SCI SCALING FACTOR
	 LA    2,1		  SET SCALE = 1
	 TM    CEFB,X'10'	  SEE IF ENG FORMAT REQUIRED
	 BZ    CEF11		  IF NOT
	 LD    2,CEFT03		  SET ENG SCALING FACTOR
	 LA    2,3		  SET SCALE = 3
CEF11	 CD    0,=D'1.0'
	 BNL   CEF12		  IF NEG SCALING NOT REQUIRED
	 MDR   0,2		  SCALE	IT
	 SR    6,2		  ADJUST EXPONENT
	 B     CEF11		  LOOP FOR ALL NEG SCALING
CEF12	 CDR   0,2		  CHECK	FOR POSITIVE SCALING
	 BL    CEF13		  IF OK
	 DDR   0,2		  SCALE	IT
	 AR    6,2		  ADJUST EXPONENT
	 B     CEF12
*
CEF13	 LTDR  4,4		  SEE IF ANY ROUNDING FACTOR
	 BZ    CEF14
	 ADR   0,4		  ROUND	SCALED RESULT
	 LD    4,=D'0'		  ZERO OUT ROUNDING FACTOR
	 B     CEF9
*
CEF14	 STD   0,CEFA		  SAVE ROUNDED ABS OF INPUT VALUE
*
	 LH    2,CEFI		  GET INTEGER POSITIONS
	 BAL   14,FAM		  FIX AND MOVE INTEGER DIGITS
*
	 LH    2,CEFF		  GET NUMBER OF	FRACTION DIGITS
	 SLA   2,3		  X LENGTH OF FP NUMBER
	 BZ    CEF15		  IF NO	FRACTION DIGITS	REQUIRED
	 MVI   0(7),C'.'	  STORE	DECIMAL	POINT
	 LA    7,1(,7)		  SKIP DECIMAL POINT
	 AD    0,=D'0'		  GET FRACTION
	 SD    0,CEFA
	 LPDR  0,0		  ...
	 MD    0,CEFT00(2)	  SCALE	FRACTION INTO INTEGER
	 LH    2,CEFF		  GET FRACTION POSITIONS
	 BAL   14,FAM		  FIX AND MOVE FRACTION	DIGITS
*
CEF15	 TM    CEFB,X'40'	  SEE IF SCIENTIFIC
	 BO    CEF16		  ALWAYS DISPLAY EXPONENT IF SCI
	 LTR   6,6		  SEE IF ANY EXPONENT
	 BZ    CEF18		  IF NOT
CEF16	 MVC   0(2,7),=C'E+'	  STORE	EXP INDICATOR
	 LTR   6,6		  SEE IF NEGATIVE EXPONENT
	 BNM   CEF17
	 MVI   1(7),C'-'	  SET NEGATIVE EXP
CEF17	 LPR   6,6		  CONVERT EXPONENT
	 CVD   6,DWORK		  ...
	 OI    DWORK+7,X'0F'	  PRINTABLE SIGN
	 UNPK  2(2,7),DWORK	  MOVE TO OUTPUT LINE
	 LA    7,4(,7)		  SKIP EXPONENT
*
CEF18	 CLI   CEFS,C'-'	  SEE IF NEGATIVE
	 BNE   CEF21		  IF NOT
	 CLI   CEFC,X'05'	  CHECK	FOR LEADING SIGN
	 BH    CEF21		  IF LEADING SIGN
	 CLI   CEFC,X'01'
	 BL    CEF21		  IF NO	SIGN DISPLAYED
	 BH    CEF19		  IF CR	OR DB
	 MVI   0(7),C'-'	  STORE	NEG SIGN
	 LA    7,1(,7)		  SKIP NEG SIGN
	 B     CEF21
CEF19	 MVC   0(2,7),=C'DB'	  STORE	A DEBIT	SYMBOL
	 TM    CEFC,X'01'	  SEE IF DEBIT
	 BO    CEF20		  IF SO
	 MVC   0(2,7),=C'CR'	  STORE	A CREDIT SYMBOL
CEF20	 LA    7,2(,7)		  SKIP CR OR DB
*
CEF21	 TM    CEFB,X'08'	  SEE IF PERCENTAGE OUTPUT
	 BZ    CEF22		  IF NOT
	 MVI   0(7),C'%'	  STORE	PERCENT	SIGN
	 LA    7,1(,7)		  SKIP PERCENT SIGN
*
CEF22	 LA    1,CEFO-1		  ZERO SUPPRESS	OUTPUT
CEF23	 LA    1,1(,1)		  NEXT DIGIT
	 CLI   1(1),C'0'	  SEE IF ZERO
	 BNE   CEFX		  IF DONE
	 CLI   2(1),C'0'	  SEE IF NEXT CHAR IS A	DIGIT
	 BL    CEFX		  IF NOT
	 MVC   1(1,1),0(1)	  MOVE SIGN OR CURRENCY
	 MVI   0(1),C' '	  SPACE	OUT ORIGINAL LOC
	 B     CEF23		  LOOP FOR ALL ZEROS TO	BE SUPPRESSED
*
CEFX	 L     13,4(,13)	  RESTORE SAVE AREA ADDR
	 LM    14,12,12(13)	  RESTORE REGS
	 SR    15,15
	 BR    14
*
	 DC    C' '
CEFO	 DC    CL40' '		  OUTPUT AREA
*
CEFT00	 DC    D'1.0E+00'	  POWERS OF 10
CEFT01	 DC    D'1.0E+01'
CEFT02	 DC    D'1.0E+02'
CEFT03	 DC    D'1.0E+03'
CEFT04	 DC    D'1.0E+04'
CEFT05	 DC    D'1.0E+05'
CEFT06	 DC    D'1.0E+06'
CEFT07	 DC    D'1.0E+07'
CEFT08	 DC    D'1.0E+08'
CEFT09	 DC    D'1.0E+09'
CEFT10	 DC    D'1.0E+10'
CEFT11	 DC    D'1.0E+11'
CEFT12	 DC    D'1.0E+12'
CEFT13	 DC    D'1.0E+13'
CEFT14	 DC    D'1.0E+14'
CEFT15	 DC    D'1.0E+15'
CEFT16	 DC    D'1.0E+16'
*
CEFA	 DC    D'0'		  HOLD FOR INPUT ARG
*
CEFB	 DC    X'00'		  FLAG BYTE
CEFC	 DC    X'00'		  SIGN OPTION
*
CEFR	 DC    X'0000000000000001' ROUNDING FACTOR
*
CEFS	 DC    C'+'		  SIGN
*
CEFF	 DC    H'0'		  NUMBER OF FRACTION DIGITS
CEFI	 DC    H'0'		  NUMBER OF INTEGER DIGITS
*
CEFV	 DC    18F'0'		  SAVE AREA
.FAM	 SPACE 2
**	 FAM --	FIX AND	MOVE
*
*
FAM	 STM   14,2,12(13)
	 AW    0,FAMF		  ADD IN FIX CONSTANT
	 STD   0,DWORK		  SAVE FIXED VALUE
	 CLI   DWORK,X'4E'	  SEE IF OVERFLOW
	 BH    ERR1		  IF OVERFLOW
	 XC    FAMW,FAMW	  CLEAR	WORK AREA
	 SR    0,0		  GET UPPER PART OF INTEGER
	 ICM   0,B'0111',DWORK+1  ...
	 L     1,DWORK+4	  GET LOWER PART
	 SLDL  0,1		  MAKE BOTTOM POSITIVE
	 SRL   1,1		  ...
	 CVD   0,FAMW+8		  CONVERT UPPER
	 MP    FAMW,=P'2147483648' SCALE IT
	 CVD   1,DWORK		  CONVERT LOWER	TO DECIMAL
	 AP    FAMW,DWORK	  ADD IN LOWER PART
	 OI    FAMW+15,X'0F'	  PRINTABLE SIGN
	 BCTR  2,0		  LENGTH CODE
	 SLL   2,4		  SHIFT	INTO POSITION
	 EX    2,FAMX1		  MOVE DIGITS TO OUTPUT
	 SRL   2,4		  RESTORE LENGTH CODE
	 LA    7,1(2,7)		  SKIP DIGITS MOVED
	 LM    14,2,12(13)
	 BR    14
*
ERR1	 L     13,4(,13)	  RESTORE SAVE AREA ADDR
	 LM    14,12,12(13)	  RESTORE REGS
	 LA    15,4		  GIVE RC = 4, OVERFLOW
	 BR    14
*
FAMX1	 UNPK  0(0,7),FAMW	  MOVE DIGITS TO OUTPUT	AREA
*
	 DS    0D
FAMF	 DC    X'4E00000000000000' FIX CONSTANT
*
FAMW	 DC    XL16'00'		  WORK AREA
*
DWORK	 DC    D'0'		  WORK
------------------ Cut Here -----------------------------

Roy Frederick - royf@attctc
Dallas County Data Services
504 Records Building
Dallas, TX 75202
(214) 653-6340