TITLE 'ICATS CONVERT TO EBCDIC HEX ROUTINE' CON00010
*********************************************************************** CON00020
* * CON00030
* MODULE NAME = CONVERT A HEX NUMBER TO EBCDIC HEX CHARACTERS * CON00040
* * CON00050
* FUNCTION = TAKE THE NUMBER IN R1 AND CONVERT IT TO IT'S EBCDIC * CON00060
* HEX REPRESENTATION AND PUT IT IN R0 AND R1. * CON00070
* (E.G. R1 = X'0123ABCD' --> R0 = X'F0F1F2F3' * CON00080
* AND R1 = X'C1C2C3C4') * CON00090
* * CON00100
* ENTRY POINTS = CONEHEX * CON00110
* * CON00120
* LINKAGE = BALR R14,R15 FROM ANYWHERE IN ICATS PROGRAM. * CON00130
* THE ADDRESS OF THIS ROUTINE IS KEPT IN AN ADDRESS * CON00140
* CONSTANT IN THE ICATS COMMON DATA AREA (ICDATA). * CON00150
* FOR EXAMPLE, * CON00160
* L R1,NUMBER * CON00170
* L R15,ACONEHEX * CON00180
* BALR R14,R15 * CON00190
* * CON00200
* REGISTER CONTENTS UPON ENTRY = * CON00210
* R0 = UNIMPORTANT. THIS REGISTER GETS CHANGED HERE. * CON00220
* R1 = CONTAINS THE HEX NUMBER TO BE CONVERTED TO EBCDIC. * CON00230
* R14 = RETURN ADDRESS BACK TO CALLER. * CON00240
* R15 = ADDRESS OF THIS SUBROUTINE (USED FOR BASE REG). * CON00250
* * CON00260
* REGISTER CONTENTS UPON EXIT = * CON00270
* R0 = CONTAINS THE FIRST 4 DIGITS IN EBCDIC. * CON00280
* R1 = CONTAINS THE SECOND 4 DIGITS IN EBCDIC. * CON00290
* R15 = 0 * CON00300
* * CON00310
* REGISTER USAGE: * CON00320
* R0 = FREE * CON00330
* RX = XXXX * CON00340
* R14 = RETURN ADDRESS FOR WHEN I CALL SUBROUTINES * CON00350
* R15 = SUBROUTINE ADDRESS * CON00360
* * CON00370
* CHANGE ACTIVITY * CON00380
* DATE NAME REASON FOR CHANGE * CON00390
* 04/27/83 RICK JASPER INITIAL PROGRAM CREATION * CON00400
* * CON00410
*********************************************************************** CON00420
EJECT CON00430
PRINT GEN,NODATA CON00440
CONEHEX CSECT CON00450
USING CONEHEX,15 USE R15 FOR NEXT INSTRUCTION ONLY CON00460
STM 2,14,HEXREGS SAVE CALLERS REGISTERS CON00470
DROP 15 CON00480
USING CONEHEX,11 USE R11 FOR THIS ROUTINE'S BASE REG CON00490
LR 11,15 SWITCH BASE REGISTER TO R11 CON00500
LA 15,8 SET UP LOOP COUNTER CON00510
LA 8,WORKA+7 CON00520
HEXLOOP DS 0H CON00530
LR 7,1 CON00540
SRDL 0,4 CON00550
N 7,=X'0000000F' CON00560
C 7,=X'0000000A' CON00570
BL CONCONA CON00580
A 7,=X'000000B7' CON00590
B CONCONB CON00600
CONCONA A 7,=X'000000F0' CON00610
CONCONB STC 7,0(8) CON00620
BCTR 8,0 CON00630
BCT 15,HEXLOOP CON00640
LM 0,1,WORKA PICK UP THE EBCDIC CHARACTERS CON00650
HEXBYE LM 2,14,HEXREGS CON00660
BR 14 BYE CON00670
WORKA DS D CON00680
HEXREGS DS 13F CON00690
LTORG CON00700
END CON00710