TITLE 'ICATS CONVERT TO DECIMAL ROUTINE' CON00010
*********************************************************************** CON00020
* * CON00030
* MODULE NAME = CONVERT TO DECIMAL (CONDEC) * CON00040
* * CON00050
* FUNCTION = TAKE AN 8-BYTE EBCDIC TOKEN REPRESENTING A DECIMAL * CON00060
* NUMBER, AND CONVERT IT TO A REAL HEX NUMBER * CON00070
* (E.G. CL8'1024' --> X'00000400'). * CON00080
* THE EBCDIC TOKEN CAN BE PADDED ON EITHER SIDE WITH * CON00090
* BLANKS AND CANNOT CONTAIN A LEADING MINUS SIGN. * CON00100
* * CON00110
* ENTRY POINTS = CONDEC * CON00120
* * CON00130
* LINKAGE = BALR R14,R15 FROM ANYWHERE IN ICATS PROGRAM. * CON00140
* THE ADDRESS OF THIS ROUTINE IS KEPT IN AN ADDRESS * CON00150
* CONSTANT IN THE ICATS COMMON DATA AREA (ICDATA). * CON00160
* FOR EXAMPLE, * CON00170
* LA R1,PARMX * CON00180
* L R15,ACONDEC * CON00190
* BALR R14,R15 * CON00200
* * CON00210
* REGISTER CONTENTS UPON ENTRY = * CON00220
* R0 = UNIMPORTANT. THIS REGISTER GETS CHANGED HERE. * CON00230
* R1 = CONTAINS THE ADDRESS OF THE CHARACTER STRING. * CON00240
* R2 = POINTS TO THE ICATS COMMON DATA AREA AS ALWAYS. * CON00250
* R14 = RETURN ADDRESS BACK TO CALLER. * CON00260
* R15 = ADDRESS OF THIS SUBROUTINE (USED FOR BASE REG). * CON00270
* * CON00280
* REGISTER CONTENTS UPON EXIT = * CON00290
* EXAMPLES: PARM3 = CL8'099' * CON00300
* R0 = CONTAINS THE HEX VALUE. R0 = X'00000063' * CON00310
* R15 = 0 = EVERYTHING WENT OK R15 = X'00000000' * CON00320
* * CON00330
* OR PARM5 = CL8' ' * CON00340
* R0 = 0 R0 = X'00000000' * CON00350
* R15 = 4 = THE PARAMETER IS ALL BLANKS. R15 = X'00000004' * CON00360
* * CON00370
* OR PARM3 = CL8' 09A' * CON00380
* R0 = WHICH DIGIT IS IN ERROR (1-8) R0 = X'00000004' * CON00390
* R15 = 8 = FOUND AN INVALID DECIMAL DIGIT. R15 = X'00000008' * CON00400
* * CON00410
* REGISTER USAGE: * CON00420
* R0 = FREE * CON00430
* RX = XXXX * CON00440
* R14 = RETURN ADDRESS FOR WHEN I CALL SUBROUTINES * CON00450
* R15 = SUBROUTINE ADDRESS * CON00460
* * CON00470
* MODULE LOGIC = * CON00480
* I) CHECK FOR NULL CASE (ALL BLANKS) FIRST. IF TOKEN IS ALL * CON00490
* BLANKS, RETURN R0 = 0, R15 = 4 (I.E. CALL IT AN ERROR). * CON00500
* II) SKIP OVER LEADING BLANKS. * CON00510
* III) CONVERT REST OF CHARACTERS TO A HEX NUMBER. * CON00520
* 1) IS IT 0-9 ?? ERROR IF NOT. * CON00530
* 2) ADD DIGIT TO REST OF NUMBER. * CON00540
* 3) LOOP TO NEXT DIGIT. * CON00550
* * CON00560
* NORMAL EXIT = * CON00570
* R15 = 0 * CON00580
* * CON00590
* EXTERNAL REFERENCES = NONE * CON00600
* * CON00610
* CONTROL BLOCKS = ICDATA (ICATS COMMON DATA AREA) * CON00620
* * CON00630
* NON-STANDARD MACROS (FOUND IN ICATS MACLIB) * CON00640
* ICDATA = ICATS COMMON DATA AREA DSECT. * CON00650
* * CON00660
* CHANGE ACTIVITY * CON00670
* DATE NAME REASON FOR CHANGE * CON00680
* 04/18/83 RICK JASPER BROKEN AWAY FROM ICATS MAINLINE INTO * CON00690
* SEPARATE SUBROUTINE * CON00700
* * CON00710
*********************************************************************** CON00720
EJECT CON00730
PRINT GEN,NODATA CON00740
CONDEC CSECT CON00750
USING ICDATA,R2 ADDRESS ICATS COMMON DATA AREA CON00760
USING CONDEC,R15 USE R15 FOR NEXT INSTRUCTION ONLY CON00770
STM R1,R14,DECREGS SAVE CALLERS REGISTERS CON00780
DROP R15 CON00790
USING CONDEC,R11 USE R11 FOR THIS ROUTINE'S BASE REG CON00800
LR R11,R15 SWITCH BASE REGISTER TO R11 CON00810
CLC 0(8,R1),=CL8' ' CHECK THE EASY CASE FIRST CON00820
BNE DECCONTA RATS, NOT SO EASY CON00830
LA R0,0 PARM WAS NOT THERE CON00840
LA R15,4 LOAD RETURN CODE AND CON00850
B DECBYE GET OUT OF HERE CON00860
DECCONTA DS 0H CON00870
LA R15,8 SET UP LOOP COUNTER CON00880
DECLOOPA DS 0H CON00890
CLI 0(R1),C' ' SKIP OVER LEADING BLANKS CON00900
BNE DECCONTB GOOD, FOUND FIRST SIGNIFICANT DIGIT CON00910
LA R1,1(R1) ELSE BUMP TO NEXT DIGIT IN PARM CON00920
BCT R15,DECLOOPA CON00930
DECCONTB DS 0H CON00940
LA R14,0 INITIALIZE PARM VALUE CON00950
DECLOOPB DS 0H CON00960
CLI 0(R1),C' ' CHECK FOR DELIMITING BLANK CON00970
BNE DECCONTC NOPE, NOT DONE YET CON00980
LR R0,R14 MOVE PARM VALUE IN PLACE CON00990
LA R15,0 SET ZERO RETURN CODE CON01000
B DECBYE SEE YOU LATER CON01010
DECCONTC DS 0H CON01020
CLI 0(R1),C'0' CON01030
BL DECINVLD INVALID, BELOW A '0' CON01040
CLI 0(R1),C'9' CON01050
BH DECINVLD INVALID, IT'S GREATER THAN '9' CON01060
* WE NOW KNOW IT'S A VALID DIGIT CON01070
IC R0,0(R0,R1) PICK UP THE CHARACTER CON01080
N R0,=X'0000000F' STRIP OFF UNWANTED BITS CON01090
* NOW MERGE THE NEW DIGIT (IN R0) IN WITH THE PARM VALUE (IN R14) CON01100
MH R14,=H'10' MULTIPLY PARM VALUE BY 10 CON01110
AR R14,R0 ADD THIS NEW DIGIT CON01120
LA R1,1(R1) BUMP POINTER TO NEXT DIGIT CON01130
BCT R15,DECLOOPB GO ON TO NEXT CHARACTER CON01140
LR R0,R14 MOVE PARM VALUE IN PLACE CON01150
B DECBYE WHEN DONE WITH ALL 8 CHARACTERS, LEAVE (RC=0) CON01160
* CON01170
DECINVLD DS 0H CON01180
LA R0,9 9-LOOP INDEX = NUMBER OF CHARACTER- CON01190
SR R0,R15 IN-ERROR GOES IN R0 CON01200
LA R15,8 RETURN CODE = 8 = INVALID CHARACTER FOUND CON01210
* CON01220
DECBYE LM R1,R14,DECREGS CON01230
BR R14 BYE CON01240
DECREGS DS 14F CON01250
LTORG CON01260
ICDATA CON01270
END CON01280