IBM Mainframe Forum

         MACRO
&NAME    SHOWPSW &MSG
         LCLC  &L,&LX
&L       SETC  'L''MSG&SYSNDX'
&LX      SETC  'MSG&SYSNDX'
&NAME    DC    0H'0',X'00FF'       SPECIFY THE SHOWPSW "OP CODE"
         B     PSW&SYSNDX          BR AROUND THE MSG
         DC    AL1(&L)             DEFINE THE MESSAGE LENGTH
&LX      DC    C&MSG               DEFINE THE MESSAGE
&LX      SETC  'PSW&SYSNDX'
&LX      DC    0H'0'
         MEND
SHOWPSW  CSECT                     DEFINE THE PROGRAM CSECT
         PUSH  PRINT
         PRINT NOGEN
         DCBD  DSORG=QS,DEVD=DA
         POP   PRINT
         IHAEPIE ,
SHOWPSW  CSECT                     RETURN TO THE PROGRAM CSECT
         USING *,12                DEFINE PROGRAM ADDRESSABILITY
         SAVE  (14,12),,SHOWPSW-&SYSDATE-&SYSTIME  SAVE REGISTERS
         LR    12,15               COPY ENTRY POINT ADDRESS TO REG 12
         LA    15,SAVEAREA         LOAD ADDRESS OF THE NEW SAVE AREA
         ST    15,8(,13)           ADD THE NEW SAVE AREA TO THE
         ST    13,4(,15)            SAVE AREA CHAIN
         LR    13,15               ESTABLISH NEW SAVE AREA POINTER
         ESPIE SET,SPIEEXIT,1      ESTABLISH AN ESPIE ENVIRONMENT     ->
                                    FOR AN S0C1 INTERRUPTION
         ST    1,TOKEN             SAVE THE TOKEN FOR SPIE RESET
         OPEN  MF=(E,OPARM)        OPEN THE PRINT DCB
         SHOWPSW 'TEST POINT'      SHOW THE PSW
         CLOSE MF=(E,CPARM)        CLOSETHE PRINT DCB
         L     13,4(,13)           LOAD ADDR OF THE PREVIOUS SAVE AREA
         RETURN (14,12),T,RC=0     RESTORE REGISTERS & RETURN
         DROP  ,                   KILL ADDRESSABILITY
* THE ESPIE EXIT ROUTINE
         DC    0D'0'
SPIEEXIT BALR  12,0                STORE THE CURRENT ADDRESS IN REG 12
         USING *,12                ESTABLISH EXIT ADDRESSABILITY
         USING EPIE,3              ESTABLISH EPIE ADDRESSABILITY
         LR    2,14                COPY THE RETURN ADDRESS TO REG 2
         LR    3,1                 COPY EPIE ADDRESS TO REG 3
         IC    0,EPIEILC1          LOAD THE ILC
         N     0,=A(B'11')         ISOLATE THE ILC ITSELF
         STC   0,XILC              SAVE THE ILC
         C     0,=F'2'             TEST IF ILC 2
         BNE   X0100               BR IF NOT 2
         L     1,EPIENXT1          LOAD THE ADDRESS OF THE NEXT       ->
                                    INSTRUCTION
         CLC   =X'47F0',0(1)       TEST IF IT'S A BC 15
         BNE   X0100               BR IF NOT
         BCTR  1,0                 SUBTRACT 2
         BCTR  1,0                  FROM THE PSW
         CLC   =X'00FF',0(1)       TEST IF THE "INSTRUCTION" IS X'0001'
         BNE   X0100               BR IF NOT
*                          ----+----1--
         MVC   XMSG(12),=C' THE PSW AT '
         LA    1,6(,1)             COMPUTE THE ADDRESS OF THE MSG
         SR    15,15               SET REG 15 = 0
         IC    15,0(,1)            LOAD THE LENGTH
         BCTR  15,0                REDUCE LENGTH BY 1
         EX    15,XMVC             COPY THE MSG TXT
         LA    14,XMSG+13(15)      COMPUTE THE RESUME POINT
         MVC   0(4,14),=C' IS '
         UNPK  4(9,14),EPIEPSW(5)
         TR    4(8,14),HEXTAB
         MVI   12(14),C' '
         UNPK  13(9,14),EPIEPSW+4(5)
         TR    13(8,14),HEXTAB
         LA    13,XSAVE
         PUT   PRINT,XMSG
         BR    2
X0100    DC    H'0'
XMVC     MVC   XMSG+12(*-*),1(1)   **EXECUTE ONLY **
XILC     DC    AL1(0)
XMSG     DC    CL121' ',0D'0'
HEXTAB   EQU   *-C'0'
         DC    C'0123456789ABCDEF'
         PUSH  PRINT
         PRINT NOGEN
PRINT    DCB   DSORG=PS,MACRF=PM,DDNAME=SYSPRINT,RECFM=FBA,LRECL=121
         POP   PRINT
XSAVE    DC    9D'0'
SAVEAREA DC    9D'0'
OPARM    OPEN  (PRINT,OUTPUT),MF=L
CPARM    CLOSE PRINT,MF=L
TOKEN    DC    F'0'
         DC    0D'0'
         LTORG ,
         DC    0D'0'
         END   SHOWPSW