This sample was Assembled and tested during July 2003 on a z/OS 1.3 system. It was produced following dialogue with somebody using an IBM Assembler emulation tool on a PC. The tool had an extended instruction called XDECO which displayed the contents of a register. It was decided to simulate this capability in z/OS itself by defining a macro. At the same time it seemed a good idea to display register contents using the SNAP macro, and by printing a hexadecimal representation of the register for comparison purposes.
PRINT NOGEN
MACRO
&LAB XDECO &RG,&TARGET
&LAB B *+12 BRANCH AROUND WORK AREA
W&SYSNDX DS XL8 CONVERSION WORK AREA
CVD &RG,W&SYSNDX CONVERT TO DECIMAL
MVC &TARGET,=XL12'402120202020202020202020'
ED &TARGET,W&SYSNDX+2 MAKE FIELD PRINTABLE
BC 2,*+12 BYPASS NEGATIVE
MVI &TARGET+12,C'-' INSERT NEGATIVE SIGN
B *+8 BYPASS POSITIVE
MVI &TARGET+12,C'+' INSERT POSITIVE SIGN
MEND
*
TITLE 'REGDIS - PRINT REGISTER CONTENTS BY VARIOUS MEANS'
REGDIS CSECT
USING *,R15 INITIAL BASE REGISTER
BEGIN B START
DC AL1(6),CL8'REGDIS' PROGRAM NAME FOR DEBUGGING
*--------P-O-S-I-T-I-O-N-A-L-L-Y----D-E-P-E-N-D-E-N-T----C-O-D-E----*
SAVEAREA DS 0F MY SAVE AREA *
DC AL4(*-*) *
PRESAVE DC AL4(*-*) ADDR OF PREVIOUS SAVE AREA *
NEXTSAVE DC AL4(*-*) ADDR OF NEXT SAVE AREA *
SREG14 DC AL4(*-*) GENERAL *
SREG15 DC AL4(*-*) PURPOSE *
SREG0 DC 13AL4(*-*) REGISTER SAVE *
SAVEEND DS 0H END OF MY SAVE AREA *
*-------------------------------------------------------------------*
SPACE 1
START EQU *
DROP R15 DUMP INITIAL BASE REGISTER
STM R14,R12,12(R13) SAVE THE REGISTERS ON ENTRY
LR R12,R15 SET UP MY
USING BEGIN,R12 BASE REGISTER
ST R13,PRESAVE PERFORM SAVE
LA R15,SAVEAREA AREA
ST R15,8(R13) CHAINING
LR R13,R15 R13 = ADDR OF MY SAVE AREA
OPEN (OUTDCB,OUTPUT,SNAPDCB,OUTPUT) OPEN THE FILES.
EJECT
SR R4,R4 R4 = ZERO.
BAS R11,SNAPREGS DUMP THE REGISTERS
*
* PRINT A NEGATIVE NUMBER.
*
BCTR R4,0 SUBTRACT 1 FROM R4.
BAS R11,SNAPREGS DUMP THE REGISTERS
NEG1 XDECO R4,PREG MAKE REGISTER DISPLAYABLE
BAS R11,PRNTREG DUMP THE REGISTERS
BAS R11,PRNTREGX DUMP THE REGISTERS
*
* PRINT A NEGATIVE NUMBER.
*
AH R4,=H'11' R4 = TEN
BAS R11,SNAPREGS DUMP THE REGISTERS
POS1 XDECO R4,PREG MAKE REGISTER DISPLAYABLE
BAS R11,PRNTREG DUMP THE REGISTERS
BAS R11,PRNTREGX DUMP THE REGISTERS
SPACE 3
CLOSE (OUTDCB,,SNAPDCB) CLOSE THE INPUT FILE.
SR R15,R15 FORCE COND CODE ZERO
L R13,PRESAVE R13 = PREVIOUS SAVE AREA ADDR.
L R14,12(R13) RESTORE REGISTERS
LM R0,R12,20(R13) EXCEPT REGISTER 15
BR R14 RETURN TO CALLER (OS/390)
SPACE 3
SNAPREGS SNAP PDATA=REGS,DCB=SNAPDCB JUST DUMP THE REGISTERS
BR R11 RETURN FROM WHENCE I CAME.
SPACE 1
PRNTREG PUT OUTDCB,OUTAREA PRINT THE REGISTER VALUE.
MVC PREG,PREG-1 CLEAR RESULT FOR NEXT TIME.
BR R11 RETURN FROM WHENCE I CAME.
SPACE 1
PRNTREGX ST R4,REGSAVE SAVE THE REGISTER
MVO REGSAVEP,REGSAVE MAKE WAY FOR A ZONE.
UNPK REGEXPD,REGSAVEP UNPACK AND
TR REGEXPD,EBCDIC CONVERT
PUT OUTDCB,OUTAREA2 PRINT THE REGISTER VALUE.
BR R11 RETURN FROM WHENCE I CAME.
EJECT
LTORG
SPACE 1
REGSAVE DS F REGISTER SAVE AREA
REGSAVEP DC XL5'000000000F' REGISTER LOOKS PACKED
SNAPDCB DCB MACRF=W,DDNAME=SNAPDUMP,LRECL=125,RECFM=VBA, *
DSORG=PS,BLKSIZE=882
SPACE 1
OUTDCB DCB MACRF=PM,DDNAME=OUTDD,DSORG=PS
OUTAREA DS 0CL133
DC CL1' ' CONTROL CHARACTER
DC C'REGISTER 4 CONTAINS - '
PREG DC CL12' ' REGISTER VALUE GOES HERE.
DC CL98' '
OUTAREA2 DS 0CL133
DC CL1' ' CONTROL CHARACTER
DC C'REGISTER 4 HEX IS - '
REGEXPD DC CL8' ' REGISTER VALUE GOES HERE.
DC CL104' '
EBCDIC DC 256XL1'0'
ORG EBCDIC+C'0'
DC C'0123456789ABCDEF'
ORG ,
SPACE 1
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
END
Copyright © KMS-IT Limited 2003