Subroutine XXXXDECO:
V100 TITLE 'XXXXDECO'
00010001
* PUNCH ' CATALR XXXXDECO'
00020001
XXXXDECO CSECT
00030001
**--> MODULE : XXXXDECO EXTENDED DECIMAL OUTPUT CONVERSION MODULE * * *
00040001
* XXXXDECO IS CALLED BY MACRO XDECO TO CONVERT A REGISTER *
00050001
* VALUE TO EDITED DECIMAL IN A 12 BYTE AREA, WITH SIGN. *
00060001
* ENTRY CONDITIONS : *
00070001
* R14= ADDRESS OF XDECOB DSECT CREATED BY XDECO *
00080001
* R15= ENTRY POINT ADDRESS =V(XXXXDECO) *
00090001
* EXIT CONDITIONS : *
00100001
* EDITED 12-BYTE RESULT OF REGISTER ARGUMENT STORED AT ADDRESS ARG. *
00110001
* USES DSECT: XDECOB *
00120001
* NAMES: XXDO---- *
00130001
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
00140001
USING *,15 NOTE ENTRY POINT USING FOR BASE
00150001
USING XDECOB,14 NOTE XDECO CONTROL BLOCK
00160001
STM 1,2,XXDOSAVE SAVE WORK REGISTERS
00170001
LR 2,0 MOVE @ AREA WHERE CAN BE USED
00180001
L 0,XDECOV GET VALUE TO BE CONVERTED
00190001
CVD 0,XXDODWOR CONVERT THE VALUE
00200001
MVC 0(12,2),XXDODECP MOVE EDIT PATTERN IN
00210001
LA 1,11(2) SET UP FOR NEG NUMBER FOR EDMK
00220001
EDMK 0(12,2),XXDODWOR+2 EDIT THE VALUE OVER
00230001
BNM XXDORETN SKIP INSERTION OF - IF >= 0
00240001
BCTR 1,0 MOVE @ POINTER BACK 1
00250001
MVI 0(1),C'-' INSERT - IN FRONT OF FIRST DIGIT
00260001
XXDORETN LM 1,2,XXDOSAVE RESTORE WORKING REGS
00270001
SPM 14 RESTORE ORIGINAL COND CODE
00280001
B XDECORET RETURN TO CALLING XDECO
00290001
SPACE 1
00300001
XXDODECP DC X'402020202020202020202120' EDIT PATTERN
00310001
XXDODWOR DS D WORKAREA
00320001
XXDOSAVE DS 2F SAVE AREA FOR REGS 1-2
00330001
DROP 14,15 DROP BASE REGISTERS
00340001
EJECT
00350001
XDECOB DSECT
00360001
**--> DSECT : XDECOB CONTROL BLOCK CREATED BY XDECO MACRO * * * * *
00370001
* AN XDECOB IS CREATED FOR EACH XDECO CALL, AND CONTAINS THE *
00380001
* @ XXXXDECO MODULE, SAVEWORDS FOR REGS R14,R15,R0, AND A WORD *
00390001
* FOR THE VALUE TO BE CONVERTED TO DECIMAL. *
00400001
* XDECOB IS USED ONLY IN MODULE XXXXDECO. *
00410001
* GENERATION: XDECO *
00420001
* NAMES: XDECO--- *
00430001
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
00440001
DS V(XXXXDECO) ADCON TO GET HERE
00450001
DS 3F SAVE AREA FOR REGS 14,15,0
00460001
XDECOV DS F VALUE FOR CONVERSION
00470001
XDECORET LM 14,0,4(14) RETURN POINT @
00480001
END ,
00490001
