Path: utzoo!utgpu!watmath!att!tut.cis.ohio-state.edu!ucbvax!@rice.edu:attctc!royf@TUT.CIS.OHIO-STATE.EDU
From: @rice.edu:attctc!royf@TUT.CIS.OHIO-STATE.EDU (Roy Frederick)
Newsgroups: comp.lang.asm370
Subject: Floating pt to and from EBCDIC
Message-ID: <8908150746.AA25875@brazos.rice.edu>
Date: 15 Aug 89 04:07:10 GMT
Sender: usenet@ucbvax.BERKELEY.EDU
Reply-To: IBM 370 Assembly Programming Discussion List <@rice.edu:ASM370%UCF1VM.BITNET@icsa.rice.edu>
Distribution: inet
Organization: The Internet
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