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