MVS Jan 2005.p65 - CBT Tape

SRL R15,4 Dump the 'sign'
ST R15,DBL2 Save the length
UNPK DBL1(9),DBL2(5) Unpack the value
NC DBL1(8),=8X'ØF' Clear high order nibbles
TR DBL1(8),=C'Ø123456789' Make the value readable
MVC WTO1WRK(WTO1LN),WTO1LST Copy WTO model
MVC WTO1WRK+4+25(8),DBL1 Copy readable parm length
MVC WTO1WRK+4+19(2),=C'#1' Set parm # indicator
MVC WTO1WRK+4+42(8),TCBADDR Copy TCB address
WTO MF=(E,WTO1WRK) Issue WTO
***********************************************************************
L R1,PARMADDR Load incoming parm address
L R3,4(,R1) Get parameter address
ICM R5,B'1111',Ø(R3) Copy parameter value
CVD R5,DBL1 Convert to decimal
L R15,DBL1+4 Load significant portion
SRL R15,4 Dump the 'sign'
ST R15,DBL2 Save the length
UNPK DBL1(9),DBL2(5) Unpack the value
NC DBL1(8),=8X'ØF' Clear high order nibbles
TR DBL1(8),=C'Ø123456789' Make the value readable
MVC WTO1WRK(WTO1LN),WTO1LST Copy WTO model
MVC WTO1WRK+4+25(8),DBL1 Copy readable parm length
MVC WTO1WRK+4+19(2),=C'#2' Set parm # indicator
MVC WTO1WRK+4+42(8),TCBADDR Copy TCB address
WTO MF=(E,WTO1WRK) Issue WTO
***********************************************************************
L R1,PARMADDR Load incoming parm address
L R3,8(,R1) Get parameter address
MVC WTO1WRK(WTO1LN),WTO1LST Copy WTO model
MVC WTO1WRK+4+25(8),=8C' ' Clear the data area
MVC WTO1WRK+4+19(2),=C'#3' Set parm # indicator
MVC WTO1WRK+4+42(8),TCBADDR Copy TCB address
LA R4,WTO1WRK+4+25 Get target area address
VAL3LP DS ØH
CLI Ø(R3),X'ØØ' End of data?
BE VAL3END Yes - done with the data
MVC Ø(1,R4),Ø(R3) Copy the next character
LA R3,1(,R3) Point to next source byte
LA R4,1(,R4) Point to next target byte
B VAL3LP Check for more data
VAL3END DS ØH
WTO MF=(E,WTO1WRK) Issue WTO
***********************************************************************
RETURN DS ØH
L R5,RETCODE Load return code
LR R1,R13 Get temp storage address
STORAGE RELEASE,LENGTH=WORKSIZE,ADDR=(R1)
LR R15,R5 Copy the return code
PR Return
46 © 2005. Xephon USA telephone (214) 340 5690, fax (214) 341 7081.