You are invited to browse the list of mainframe-loving sites.
[ Join Now | Ring Hub | Random | << Prev | Next >> ]
© 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. |
|
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.
|
|
|
|
||