Convert 8-byte binary to zoned numeric

© Copyright John Ehrman, 2003. All rights reserved.

This software is free; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
More information is available from the Free Software Foundation or the Open Source Initiative.

This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this software; if not, write to either of the following:

the Free Software Foundation, Inc.
59 Temple Place, Suite 330
Boston, MA 02111-1307
United States of America
B.V. Bixoft
Rogge 9
7261 JA Ruurlo
The Netherlands
  email: bixoft@bixoft.nl
phone: +31-6-22755401

Remark:
This software - and more programs and macros - are available in a format more suitable for uploading to your mainframe. Please e-mail B.V. Bixoft with your request and you will receive a zipped IEBUPDTE job with the program sources.


*                                                                       00000100
* This program is free software; you can redistribute it and/or modify  00000200
* it under the terms of the GNU General Public License as published by  00000300
* the Free Software Foundation; either version 2 of the License         00000400
* or (at your option) any later version.                                00000500
* The license text is available at the following internet addresses:    00000600
* - http://www.bixoft.com/english/gpl.htm                               00000700
* - http://fsf.org                                                      00000800
* - http://opensource.org                                               00000900
*                                                                       00001000
* This program is distributed in the hope that it will be useful,       00001100
* but WITHOUT ANY WARRANTY; without even the implied warranty of        00001200
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  00001300
* See the GNU General Public License for more details.                  00001400
*                                                                       00001500
* You should have received a copy of the GNU General Public License     00001600
* along with this program; if not, write to either of the following:    00001700
* the Free Software Foundation, Inc.      B.V. Bixoft                   00001800
* 59 Temple Place, Suite 330              Rogge 9                       00001900
* Boston, MA 02111-1307                   7261 JA Ruurlo                00002000
* United States of America                The Netherlands               00002100
*                                                                       00002200
*                                         e-mail: bixoft@bixoft.nl      00002300
*                                         phone : +31-6-22755401        00002400
*                                                                       00002500
         TITLE 'INTEGER*8 Arithmetic: Signed Output'                    00010000
*                                                                       00020000
*        Calling Sequences:                                             00030000
*                                                                       00040000
*        CALL I8CVD(n1, s1, l1)                                         00050000
*             n1 is a 64-bit integer                                    00060000
*                  n1 is converted to a decimal character string        00070000
*             s1 is a string of decimal EBCDIC characters, with no      00080000
*                  blanks, always preceded by a + or - sign. The        00090000
*                  field must be at least 20 bytes long.                00100000
*             l1 is a 32-bit fullword integer, the length of s1         00110000
*                  (also returned in GR0)                               00120000
*                                                                       00130000
I8CVD    RSECT ,                                                        00140000
         SAVE  (14,4),,*          Save registers                        00150000
         USING I8CVD,R15                                                00160000
         USING I8CVDSAV,R13       Map save area temps                   00170000
         LM    R1,R3,0(R1)        Get parameter addresses               00180000
         LM    R0,R1,0(R1)        Get n1                                00190000
         SLDA  R0,0               Check sign and for zero               00200000
         BM    I8CVDA             Branch if - to complement             00210000
         MVI   0(R2),C'+'         Set + sign if not negative            00220000
         BP    I8CVDB             Branch if positive and non-zero       00230000
         MVI   1(R2),C'0'         Set single zero digit                 00240000
         LA    R0,2               Set result length                     00250000
         B     I8CVDX             And exit                              00260000
I8CVDA   DS    0H                                                       00270000
         MVI   0(R2),C'-'         Set - sign                            00280000
         LCR   R0,R0              Complement the number                 00290000
         LCR   R1,R1              Low half                              00300000
         BZ    I8CVDB             Skip if low-order half was zero       00310000
         BCTR  R0,0               Deduct the spurious carry             00320000
I8CVDB   DS    0H                                                       00330000
         ZAP   I8CVDT12,I8CVDP0   Clear accumulation area               00340000
         LTR   R0,R0              See if high-order half is zero        00350000
         BZ    I8CVDB1            Branch if yes, avoid all that work    00360000
         CVD   R0,I8CVDTMP        Convert to decimal                    00370000
         OI    I8CVDTMP+7,X'0F'   Force + sign (in case of max neg no.) 00380000
         ZAP   I8CVDT12,I8CVDTMP  Copy for multiplication               00390000
         MP    I8CVDT12,I8CVD232  Multiply by 2**32                     00400000
I8CVDB1  DS    0H                                                       00410000
         LTR   R1,R1              Check sign of low-order half          00420000
         BP    I8CVDC             Skip if +                             00430000
         BZ    I8CVDD             Skip more if zero                     00440000
         AP    I8CVDT12,I8CVD231  Add 2**31 for the "sign" bit          00450000
         X     R1,I8CVDHOB        Blot off the sign bit                 00460000
I8CVDC   DS    0H                                                       00470000
         CVD   R1,I8CVDTMP        Convert low half to decimal           00480000
         AP    I8CVDT12,I8CVDTMP  Accumulate last part of result        00490000
I8CVDD   DS    0H                                                       00500000
         MVC   1(19,R2),I8CVDPAT  Move pattern to result area           00510000
         SR    R1,R1              Clear junk in high-order part of R1   00520000
         EDMK  1(19,R2),I8CVDT12+2  Edit the result                     00530000
         LA    R0,21(,R2)         Point just past end of work area      00540000
         SR    R0,R1              Calculate result digit length         00550000
         LR    R4,R0              Copy for execute instruction          00560000
         BCTR  R4,0               Decrement for execute                 00570000
         BCTR  R4,0               Decrement for execute                 00580000
         EX    R4,I8CVDMV         Move result                           00590000
I8CVDX   DS    0H                                                       00600000
         ST    R0,0(,R3)          Store length of result                00610000
         RETURN (2,4)             Restore registers and return          00620000
I8CVDMV  MVC   1(*-*,R2),0(R1)    Move result to caller's area          00630000
         DROP  R15                                                      00640000
I8CVDONE DC    F'1'               Constant 1                            00650000
I8CVDHOB DC    A(X'80000000')     High order bit for masking            00660000
I8CVD231 DC    P'2147483648'      2**31 in packed decimal               00670000
I8CVD232 DC    P'4294967296'      2**32 in packed decimal               00680000
I8CVDP0  DC    P'0'               Packed decimal zero                   00690000
I8CVDPAT DC    19X'20'            Edit-and-Mark pattern                 00700000
*                                                                       00710000
*        General Purpose Registers                                      00720000
*                                                                       00730000
R0       EQU   0                                                        00740000
R1       EQU   1                                                        00750000
R2       EQU   2                                                        00760000
R3       EQU   3                                                        00770000
R4       EQU   4                                                        00780000
R13      EQU   13                                                       00790000
R15      EQU   15                                                       00800000
*                                                                       00810000
I8CVDSAV DSECT ,                  Save area mapping                     00820000
         DC  10F'0'               Head;links;R14-R4                     00830000
I8CVDTMP DC    D'0'               Work area for CVD, CVB, float, fix    00840000
I8CVDT12 DC    PL12'0'            Accumulate decimal result             00850000
         END                                                            00860000

 

This site is a member of WebRing.
You are invited to browse the list of mainframe-loving sites.
Running
    Tyrannosaurus Rex Dinos are not dead. They are alive and well and living in data centers all around you. They speak in tongues and work strange magics with computers. Beware the dino! And just in case you're waiting for the final demise of these dino's: remember that dinos ruled the world for 155-million years!
Dinos and other anachronisms
[ Join Now | Ring Hub | Random | << Prev | Next >> ]
 

Below you find the logo of our sponsor and logos of the web-standards that this page adheres to.