       *>=IHAPSA  Macro ================================DSA 09/20/96====
       *> PSA - Prefixed Save Area (low core addressing 0 - 2047)
       *>       MVS Subpool 239, Key 0, below 16 MB
       *>     - Only the first 2048 bytes mapped since second 2048
       *>       bytes are fetch-protected and cannot be accessed by
       *>       problem state programs
       *>     - Of the first 2048, only 552 bytes are really necessary
       *>  - unless otherwise stated, all data is S/390 style
       *>
       *> Copyright (C) 1996-2007 Micro Focus (IP) Limited. All rights
       *>                         reserved.
       *>===============================================================
       01 (tag).
          03 filler.
             05 (tag)-union1     pic x(2048).
             05 filler redefines (tag)-union1.
                07 (tag)-job-env     pic x(1).
                   78 (tag)-job-env-es    value x'80'.
                   78 (tag)-job-env-mfe   value x'00'.
                07 filler        pic x(3).
                *>=====================================================
                *> The following flags valid only if -flags2 = -mfefp.
                *> The attribute is true if the byte is non-zero
                *>=====================================================
                07 (tag)-charset-ebcdic       pic 9(2) comp.
                07 (tag)-binary-little-endian pic 9(2) comp.
                07 (tag)-amode                pic 9(2) comp.
                   78 (tag)-amode24           value 1.
                   78 (tag)-amode31           value 2.
                07 (tag)-flags1 pic x(1) comp-x.
                   *>Bit definitions
                   78 (tag)-4byte-addrs value h'01'. *> 4-byte addrs
                                           *> that are 3-byte on S/390
                                           *> (PC == odd new PSW addr
             05 filler redefines (tag)-union1.
                07 filler        pic x(16).
                07 (tag)-cvt     pointer.
             05 filler redefines (tag)-union1.
                07 filler        pic x(76).
                07 (tag)-cvt2    pointer.
             05 filler redefines (tag)-union1.
                07 filler        pic x(112).
                *>=====================================================
                *> The following fields valid only if -flags2 = -mfefp.
                *>=====================================================
                07 (tag)-mfex    pointer. *> ptr to MFEX
                07 filler        pic x(1).
                *>=====================================================
                *> Active System and Subsystems combinations are:
                *>   System Subsystem
                *>   ----------------
                *>   JCL    JCL
                *>   JCL    TSO-SSTM
                *>   JCL    IMS-SSTM
                *>   JCL    CICS-SSTM
                *>   JCL    TSO  (IKJEFTxx)
                *>   JCL    IMS  (DFSRC000)
                *>   TSO    TSO
                *>   TSO    IMS  (CALL DFSRC000)
                *>   IMS    IMS
                *>   CICS   CICS
                *>====================================================
                07 (tag)-system          pic 9(2) comp.
                   78  (tag)-system-jcl  value 0.
                   78  (tag)-system-tso  value 1.
                   78  (tag)-system-ims  value 2.
                   78  (tag)-system-cics value 3.
                07 (tag)-subsystem       pic 9(2) comp.
                   78  (tag)-subsystem-jcl       value 0.
                   78  (tag)-subsystem-tso       value 1.
                   78  (tag)-subsystem-ims       value 2.
                   78  (tag)-subsystem-cics      value 3.
                   78  (tag)-subsystem-tso-sstm  value 11.
                   78  (tag)-subsystem-ims-sstm  value 12.
                   78  (tag)-subsystem-cics-sstm value 13.
                07 (tag)-flags2 pic x(1) comp-x.
                   78 (tag)-mfefp value h'01'. *> used as MFE flags/ext
             05 filler redefines (tag)-union1.
                07 filler        pic x(120).
                *>=====================================================
                *> The following fields valid only if -flags2 = -mfefp.
                *>=====================================================
                07 filler                pic x(1).
                07 (tag)-jcl-sys-version pic x(7).
                07 (tag)-mvs-ptr         pointer.
                07 (tag)-stg-ptr         pointer.
                07 (tag)-stg-mfpm        pointer.
                07 (tag)-stg-len         pic s9(9) comp.
             05 filler redefines (tag)-union1.
                07 filler        pic x(512).
                07 (tag)-id      pic x(4).
                   78 (tag)-id-ebc  value x'D7E2C140'.  *> 'PSA 'e
                   78 (tag)-id-asc  value 'PSA '.
             05 filler redefines (tag)-union1.
                07 filler        pic x(536).
                07 (tag)-tnew    pointer.
             05 filler redefines (tag)-union1.
                07 filler        pic x(540).
                07 (tag)-told    pointer.
             05 filler redefines (tag)-union1.
                07 filler        pic x(544).
                07 (tag)-anew    pointer.
             05 filler redefines (tag)-union1.
                07 filler        pic x(548).
                07 (tag)-aold    pointer.
       *>============================================================
