//ESPMAC  JOB (TSO),
//             'Install ESP MACLIB',
//             CLASS=A,
//             MSGCLASS=A,
//             MSGLEVEL=(1,1),
//             USER=IBMUSER,
//             PASSWORD=SYS1
//*
//*  Installs SYS2.ESPMAC
//*
//STEP1   EXEC PGM=PDSLOAD
//STEPLIB  DD  DSN=SYSC.LINKLIB,DISP=SHR
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DSN=SYS2.ESPMAC,DISP=(NEW,CATLG),
//             VOL=SER=PUB000,
//             UNIT=SYSDA,SPACE=(TRK,(80,14,30)),
//             DCB=(RECFM=FB,LRECL=80,BLKSIZE=19040)
//SYSUT1   DD  DATA,DLM=@@
./ ADD NAME=$$$COESP
//* COPYRIGHT (C) 1979 - 1994  EXPERT SYSTEM PROGRAMMING, INC.          00010000
//* COPYRIGHT (C) 1995 - 2000  GERHARD POSTPISCHIL                      00020000
//* COPYRIGHT (C) 2001 -       EXPERT SYSTEM PROGRAMMING                00030000
//* ALL RIGHTS RESERVED.                                                00040000
//* NOTE TO U.S. GOVERNMENT USERS .. DOCUMENTATION RELATED TO           00050000
//* RESTRICTED RIGHTS .. USE, DUPLICATION OR DISCLOSURE IS SUBJECT      00060000
//* TO RESTRICTIONS SET FORTH IN GSA ADP SCHEDULE CONTRACT              00070000
//*                                                                     00080000
//* THE MATERIAL IN THIS FILE IS COPYRIGHTED.                           00090000
//*                                                                     00100000
//* *  UNLESS MARKED OTHERWISE WITHIN THE PROGRAM CODE, THE             00110000
//*    MATERIAL IS COPYRIGHTED BY EXPERT SYSTEM PROGRAMMING             00120000
//*                                                                     00130000
//* *  SOME MEMBERS MAY BE THE PROPERTY OF OTHER COPYRIGHT HOLDERS,     00140000
//*    AND ARE IDENTIFIED AS SUCH IN THEIR TEXT.                        00150000
//*                                                                     00160000
//* PERMISSION IS GRANTED TO:                                           00170000
//*                                                                     00180000
//* *  MEMBERS WITH EXH IN THEIR NAMES ARE RESTRICTED TO LICENSED       00190000
//*    USERS OF THE EXHIBIT PACKAGE.                                    00200000
//*                                                                     00210000
//* *  MEMBERS NOT OTHERWISE RESTRICTED BY THEIR OWNERS ARE FREE-       00220000
//*    WARE, AND MAY BE USED FREELY FOR NOT-FOR-PROFIT USE. THEY        00230000
//*    MAY NOT BE SOLD, LICENSED, OR USED IN COMMERCIAL PRODUCTS.       00240000
//*                                                                     00250000
//* *  STORE THE COPYRIGHTED MATERIAL IN YOUR SYSTEM AND DISPLAY        00260000
//*    IT ON TERMINALS.                                                 00270000
//*                                                                     00280000
//* *  PRINT ONLY THE NUMBER OF COPIES REQUIRED FOR USE BY THOSE        00290000
//*    PERSONS RESPONSIBLE FOR INSTALLING THE ESP PROGRAMMING AND       00300000
//*    LICENSED PROGRAMS FOR WHICH THIS MATERIAL HAS BEEN PROVIDED.     00310000
//*                                                                     00320000
//* *  MODIFY THE MATERIAL TO MEET SPECIFIC INSTALLATION REQUIREMENTS.  00330000
//*                                                                     00340000
//* THE ESP COPYRIGHT NOTICE MUST APPEAR ON ALL PRINTED VERSIONS OF     00350000
//* THIS MATERIAL OR EXTRACTS THEREOF AND ON THE DISPLAY MEDIUM WHEN    00360000
//* IT IS BEING DISPLAYED.  PERMISSION IS NOT GRANTED TO FURTHER        00370000
//* REPRODUCE OR DISTRIBUTE THE MATERIAL, EXCEPT BY WRITTEN AGREEMENT.  00380000
//*                                                                     00390000
//* UNLESS PERMISSION IS RESCINDED, THE MATERIAL MAY BE STORED AND      00400000
//* DISTRIBUTED BY THE HERCULES MVS PROJECTS, AND THE CBTTAPE.ORG SITE. 00410000
//*                                                                     00420000
//* LIB: $$$COESP                                                       00430000
//* GDE: NONE                                                           00440000
//* DOC: THIS MEMBER CONTAINS COPYRIGHT INFORMATION.                    00450000
//*                                                                     00460000
./ ADD NAME=$$$#DATE
REGULAR CBT TAPE - VERSION 498    FILE:  861

    ORIGINAL DSNAME:  SBGOLOB.CBT498.FILE861
    ---------------
                    --RECFM-LRECL-BLKSIZE-DSORG
                      FB    80    5600    PO

   PDS117I 401 MEMBERS COUNTED; CUMULATIVE SIZE IS 30,111 RECORDS


TIME THIS PDS WAS SHIPPED:   11/13/19    11:18:56    UTC-5:00

./ ADD NAME=$$$INDEX
This library contains macros required for programs in CBT file 860.     00010000
Use and distribution is limited as stated in member $$RIGHTS.           00020000
Before assembling any programs, please configure the options in member  00030000
SYSPARM to match your environment.                                      00040000
                                                                        00050000
$FCB2    Builds 3211 FCB definitions for SYS1.IMAGELIB                  00060000
$FCB3    Builds 3800 FCB definitions for SYS1.IMAGELIB                  00070000
$HEAD    MIM#3 macro to generate ASM headers, by C.J. Goelz             00080000
$TCKCONV Replaces STCKCONV for MVS; slightly different keywords.        00090000
#CNVRT   String functions (deblank, etc.) and date/time (ext @FORMATS)  00100000
#FMT     Data conversion and formatting (external routine @FORMATS)     00110000
#FOOT    Debug macro; sets footprint in a work area                     00120000
#OPMSG   Produces a string, with text insertions, with RDW, and issues  00130000
           WTOs (by default). Or use to just format text.               00140000
#PRT     Simple printer macro, uses SUBPRT routine                      00150000
#PRTWRK  Defines work area for #PRT                                     00160000
#RDR     Simple input read macro, uses SUBRDR routine                   00170000
#RDRWRK  Defines work area for #RDR                                     00180000
#SORT    Bubble sort for simple table; by GPW ?                         00190000
#TGET    Interface to SUBTGET routine; either GETLINE or WTOR issued.   00200000
#TPUT    Interface to SUBTPUT routine; either PUTLINE or WTO issued.    00210000
#TRACE   Interface to instruction trace routine PGMTRACE                00220000
#TRAP    Interface to @SPIEDER to print PSW, registers, and storage.    00230000
#TRC     Interface to PGMTRACE instruction tracing.                     00240000
#TRCCLC  sample for using #TRC to trigger and stop tracing              00250000
@OBTAIN  Interface to @OBTAINS rutine for authorized programs. Reads    00260000
           VTOC by tracks, and stages when memory is availble.          00270000
@PROTECT Interface for PROTECT SVC, with local mods.                    00280000
@VOLRESB Alternative to @VOLREAD for unauthorized programs              00290000
@VOLREST Work area for @VOLRESB                                         00300000
AMODE    Dummy to allow assembly on MVS and older systems               00310000
AM24     Sets AM24 on 31-bit; NoOp on older systems (replaced by SAM24) 00320000
AM31     Sets AM31 on 31-bit; NoOp on older systems (replaced by SAM31) 00330000
ARM      Sets Access Register Mode on or off; optionally saves or loads 00340000
           the registers.                                               00350000
ARMODE   Different ARM                                                  00360000
AUTHBCDE Builds a CDE for arbitrary storage area; renamed from Gilbert  00370000
           Saint-Flour's BUILDCDE macro.                                00380000
A64D     Add 64-bit integer to 64-bit integer                           00390000
A64F     Add 32-bit integer to 64-bit integer                           00400000
BAKR     Very poor substitute for real BAKR; registers into save are    00410000
BALS     Generates BAL or BAS depending on options.                     00420000
BALSR    Generates BALR or BASR depending on options.                   00430000
BANDAID  Invokes GSF's SYSDEBUG (as @BANDAID) or @SPIEDER debugging.    00440000
BASS     Generates BAL or BAS depending on options.                     00450000
BASCALL  Simple subroutine call with AMODE setting.                     00460000
BASEND   PGMTRACE macro to end subroutine code.                         00470000
BASHEAD  PGMTRACE macro to begin a subroutine.                          00480000
BASR     Expands a BASR instruction for ASM X/F (use under Hercules)    00490000
BASRETD  PGMTRACE macro to return from a subroutine.                    00500000
BASSM    Generates BASSM or BAS depending on options.                   00510000
BCON     Builds text preceded by 1-byte length. May have intervening    00520000
           DCs if the END option is used.                               00530000
BIGBEN   Prints current time on @PRINTER file 1 (if open).              00540000
BIX      Branches to a list of up to 256 addresses depending on a       00550000
           one-byte branch value (may be in register, gets masked,      00560000
           and shifted, as specified).                                  00570000
BLANKOUT Clears are to spaces with MVC or MVCL, depending on options.   00580000
BLOOK    Generates in-line subroutine to perform a simple table (BTAB)  00590000
           lookup, and branches on match. Spaces over leading blanks.   00600000
BSM      Generates a BALR unless &MVSXA flag is set.                    00610000
BTAB     Generates a look-up table or BLOOK and VLOOK routines.         00620000
BUILDCDE Builds CDE for arbitrary storage (by GSF); fixed for MVS 3.8   00630000
CATCALL  Invokes SUBCAT or SUBICF for catalog lookup (name or generic)  00640000
CATSCAT  Expands user's work area for catalog functions.                00650000
CATSPARM Expands SUBCAT/SUBICF calling parameters.                      00660000
CATSWORK Expands SUBCAT/SUBICF work area.                               00670000
CLRL     Clear storage to specified character; default is hex zero.     00680000
CMASK    Generates code to compare a mask to a string; returns with     00690000
           condition code set.                                          00700000
CNVA     Converts a register address (24-bit) for display.  (INSECT)    00710000
CNVD     Converts an integer for display (needs INSECT macro).          00720000
CNVR     Converts a register value to hex display.          (INSECT)    00730000
CNVX     Converts storage to hex display (limit 7 bytes in) (INSECT)    00740000
CPOOL    Simple Cellpool substitute (see SUBCPOOL)                      00750000
CRMEND   Cross-memory service end of relocated code.                    00760000
CRMEXIT  Cross-memory service return code.                              00770000
CRMHEAD  Cross-memory service start of relocated code.                  00780000
CRMS     Cross-memory service invocation.                               00790000
CRMSPIE  Cross-memory service error recovery.                           00800000
CSADD    Add using Compare and Swap.                                    00810000
CSDEC    Subtract using Compare and Swap.                               00820000
CSIRWORK Maps IGGCSI00 return area.                                     00830000
CSREP    Replace a word using Compare and Swap.                         00840000
CSTART   Start of Exhibit conversational module (private)               00850000
CVH      Converts register to integer mode display.         (INSECT)    00860000
CVI      Converts integer register value to display.        (INSECT)    00870000
DASDTYPE In-line code to provide DASD information from UCB.             00880000
DBO      Very old debug macro; OS/360 & 370 only. See DEBTROLD program. 00890000
           Superceded by #TRAP and @SPIEDER.                            00900000
DBT      Debug macro for OS/390, using DEBTRACE program.                00910000
DCBEXITD Generates DCB exit list entries for optional services in       00920000
           Shmuel Metz's @DCBEXIT program.                              00930000
DCIN     Makes a DC with the label defined on the last byte for MVCIN.  00940000
DCLC     IBM macro generate mixed case text from upper-case only.       00950000
           Use / to upper-case next word; < to upper-case next letter,  00960000
           or define your own.                                          00970000
DCON     Builds text preceded by 1-byte length-1. May have intervening  00980000
           DCs if the END option is used.                               00990000
DCS      Bill Godfrey's 3270 screen definition macro (fixed sizes only) 01000000
DEBCNT   0C1 after n invocations.                                       01010000
DEBDO    Skips to DEBEND unless debug mode is on (&BUGBEAR).            01020000
DEBEND   Target for DEBDO.                                              01030000
DEBEX    Causes 0C3.                                                    01040000
DEBINLIN Obsolete DEBTRACE code that expanded in-line.                  01050000
DEBPRT   Toggles debug printing on/off (in DEBTROLD and DEBTRACE).      01060000
DEBSTOMP Sets one-byte progress indicator in user byte.                 01070000
DEBTRACE Old DEBTROLD/DEBTRACE invocation macro.                        01080000
DEBTRACY Inner macro for DBO/DBT.                                       01090000
DELETEST Checks whether a 3/4-byte address is non-zero, and issues a    01100000
           DELETE SVC for the same name.                                01110000
DIAG     Expands a Diagnose instruction in R1,R3,code format.           01120000
DISPLAY  (private) define 2260/3270 display areas.                      01130000
DSTART   (private) beginning of a display module.                       01140000
DSUBSECT (private) code for display modules'                            01150000
DSUBSPAC (private) code for display modules.                            01160000
DUMP     (private) old code for variable formatting to display.         01170000
DYNSPACE Inner macro for ALLOC and FREE.                                01180000
EBCDIG   Converts an absolute value, variable, or expression into an    01190000
           integer EBCDIC assembly value. Typically used to have        01200000
           assembler generated SORT control cards.                      01210000
EBCHEX   Converts an absolute value, variable, or expression into a     01220000
           hexadecimal EBCDIC assembly value.                           01230000
ENDM     Program return macro by Shmuel Metz. Also see SAVEM.           01240000
ESPCVT   (local CVT extension other than CVTUSER)                       01250000
ESPHEAD  Program entry macro                                            01260000
ESPIE    Expands as SPIE in older systems.                              01270000
ESPPDS   Defines IHAPDS bits not in the MS mapping.                     01280000
EXHM@ZAP (private)                                                      01290000
EXHMADVN (private)                                                      01300000
EXHMADVS (private)                                                      01310000
EXHMCAML (private)                                                      01320000
EXHMDIO  (private)                                                      01330000
EXHMDUMP (private)                                                      01340000
EXHMFSED (private)                                                      01350000
EXHMFSUP (private)                                                      01360000
EXHMGTFI (private)                                                      01370000
EXHMGTFX (private)                                                      01380000
EXHMKALA (private)                                                      01390000
EXHMLINE (private)                                                      01400000
EXHMSTAR (private)                                                      01410000
EXHMSTAS (private)                                                      01420000
EXHMTAPE (private)                                                      01430000
EXHMUPDC (private)                                                      01440000
EXHMUPDS (private)                                                      01450000
FD       Field Definition for @PRINTER and @SCREENS.                    01460000
FDBAR    FD for percentage bar.                                         01470000
FDBR     FD to branch on condition in list of FDs.                      01480000
FDBUMP   Increments registers in FD list.                               01490000
FDCLC    Compares two strings and branches on condition in FD list.     01500000
FDCLI    Compares byte to value and branches on condition in FD list.   01510000
FDDUMP   Simple storage formatting (hex + EBCDIC) with offset.          01520000
FDEXEC   Execute another FD sequence and return. May not nest.          01530000
FDFD     Defines a field label and value; may expand based on system.   01540000
FDFLAG   Prints text (defined by FLGTAB) matching flag bits.            01550000
FDGOTO   Transfers control to another FD (no return).                   01560000
FDIN     Define a 3270 input field.                                     01570000
FDINP    Define a privileged 3270 input field.                          01580000
FDLINE   Define a complete 3270 line (SCLINE service).                  01590000
FDLITEM  Define fields in an FDLINE.                                    01600000
FDLSET   Set an attribute in an FDLINE.                                 01610000
FDLVAL   Inner macro for FDL macros.                                    01620000
FDMODE   Switches address resolution in an FD list (24 or 31).          01630000
FDOPT    Sets non-field options (e.g., new line, indent, carriage       01640000
           control, field address {SBA}).                               01650000
FDPRT    Same as FD but for printer (no color or high-lighting).        01660000
FDREPT   Repeat a character.                                            01670000
FDROOM   Start new line unless there is enough room on current line.    01680000
FDSCAN   Combines several FD function - label, input field, options.    01690000
FDSECT   Maps FD entry expansion.                                       01700000
FDSNAP   Produces configurable storage displays.                        01710000
FDSPACE  Inserts specified number of spaces on current line.            01720000
FDTM     Test flags in a byte and branch in FD list.                    01730000
FDUEX    Request a user exit to be taken.                               01740000
FDUEXEND Define end of user exit code.                                  01750000
FDUEXHED Define start of user exit code.                                01760000
FDUEXRET Return from user exit.                                         01770000
FETWORK  Map request and work area for SUBFETCH (replaces LOAD SVC).    01780000
FIXD     Convert floating point to integer (no checking).               01790000
FLD      Shmuel Metz's 3270 field definition macro.                     01800000
FLGTAB   Define a table of text strings vs. flags. Used by FDFLAG.      01810000
FLOATD   Convert register integer to floating point.                    01820000
FSAWORK  Mapping of common portion of dynamic work area storage used    01830000
           by @-routine services.                                       01840000
GETCC    Place condition code bits into high byte of register.          01850000
GETJESID (private) routine to get id for a JES2 job.                    01860000
GETREG   Load a register from caller's save area, or from BAKR stack.   01870000
HAREAD   (private) read blocks from hasp/JES2 spool packs.              01880000
HASPQSCN (private) scan hasp/JES2 job queues.                           01890000
HASPTEST (private) test that HASP/JES2 is up; initialize local stuff.   01900000
HCON     Generate a string preceded by half-word length.                01910000
HQUE     (private) define HASP/JES2 queue names for display.            01920000
IAC      dummy for MVS; sets flags to zero.                             01930000
INC      Increment or decrement a register or full-word value.          01940000
INCH     Increment or decrement a register or half-word value.          01950000
INDEC    Convert 1-4 byte integer in storage to display.                01960000
INDSN    Convert input DSN with prefixing, etc. (local code).           01970000
INEDIT   Convert packed to display              (local code).           01980000
INHEX    Convert storage to hex display         (local code).           01990000
INITDAP  (private)                                                      02000000
INITIOWK (private)                                                      02010000
INPCLOSE Close one or more input files in @INPREAD.                     02020000
INPCOM   Inner macro for input functions.                               02030000
INPFEOV  Force End Of Volume on input file.                             02040000
INPFIND  Position to start of PDS member on input file.                 02050000
INPGET   Get a record from @INPREAD.                                    02060000
INPKEEP  Keep this for one subsequent INPGET.                           02070000
INPKEEPM Keep current member.                                           02080000
INPOPEN  Open one @INPREAD file (1-8).                                  02090000
INPQMEM  Get member information (directory info).                       02100000
INPREAD  Get a block from @INPREAD.                                     02110000
INPWORK  Define an @INPREAD work area (one per file).                   02120000
INSECT   Expands code for CV convert functions.                         02130000
INSETS   Inner macro for INSECT/Conversion.                             02140000
IPM      Loads program mask.                                            02150000
JOBSEPLN Maps the job separator line of the MVS Tur(n)key system.       02160000
LADJ     Left justifies a string that's followed by a space.            02170000
LAE      Generates an LA under MVS.                                     02180000
LAM      Generates a label, if any, under MVS.                          02190000
LAT      Loads a 3/4 byte address and branches on zero or non-zero.     02200000
LCSTR    Convert character string to lower case DC; no escapes.         02210000
LDSUB    (private)                                                      02220000
LIX      Operates similar to BIX, but returns resolved addresses on     02230000
           indices; branches on missing or excessive values.            02240000
LJIT     Locates the JIT on a HASP system.                              02250000
LMVC     OS/360 equivalent of MVCL.                                     02260000
LNE      Shmuel Metz's 3270 code - request a line.                      02270000
LNKSTK   Map of linkage stack entry (for OS/390 and z/OS)               02280000
LOCBYTE  Wrapper for SRST instruction, or expands code on OS/370.       02290000
LOCLEN   Find length of a string with arbitrary ending character.       02300000
           Suggested by an e-mail from Clement Clarke (author of JOL)   02310000
LPALOOK  Locates a module in LPA, or loads it; returns address.         02320000
LTCB     Loads current TCB; optionally with USING.                      02330000
LTJID    Loads TJID of current task.                                    02340000
LTJP     Loads JQE address for HASP.                                    02350000
LTJQEP   Loads JQE point for HASP.                                      02360000
LTP      Loads and tests nth parameter in a calling list.               02370000
MACAD    Expands A-constant in CSECT/RSECT, or A(0) in DSECT.           02380000
MACBDDDL Combines address and length: A,5 -> A(5)   dd(b),4 -> dd(4,b)  02390000
MACBL    Expands a branch in CSECT/RSECT, or A(0) in DSECT.             02400000
MACDC    Expands DC with or without label depending on global.          02410000
MACDEFXT Kludgy alternative for D' attribute for ASM/XF.                02420000
MACLIST  Converts macro list into 1-10 global values.                   02430000
MACMAPHD Header macro to generate CSECT, DSECT, or 0D.                  02440000
MACPARM  Generates instructions for macro operands, compensating for    02450000
           register vs. address forms, strings, etc.                    02460000
MACPLOP  Stores value in parameter list (ST for register; LA/ST other). 02470000
MACQOLIT Analyzes string operand (unquoted, quoted, literal).           02480000
MACQOTER Adds quotes to unquoted string, or removes quotes.             02490000
MACSRVLD Inner macro to check whether a module was loaded by @SERVICE   02500000
           (SERVLOAD macro); if not, loads address with =V(name).       02510000
MAPAUTO  Maps AUTOCMD/AUTORDR request block.                            02520000
MAPCMPR  Maps COMP3270 buffer compression routine parameter area.       02530000
MAPCMPRT Maps common printer option area for debug routines DEBTRACE,   02540000
           PGMTRACE, and others.                                        02550000
MAPCOMM  (private) communications area mapping and code.                02560000
MAPDEFMT Maps parameter and return area for SUBDEFMT (PDS directory).   02570000
MAPDSCHK Maps parameter and return area for SUBDSCHK (DS validation).   02580000
MAPEXK   (private) CSA area map.                                        02590000
MAPEXR   (private) CSA area map.                                        02600000
MAPEXTNT Maps extent entry as found in DSCB1 and DSCB3.                 02610000
MAPFD    Maps FD and FDPRT expansions.                                  02620000
MAPFDL   Maps FDLINE expansion.                                         02630000
MAPFDS   Maps entry for @SCREENS (old TSO full-screen I/O).             02640000
MAPFDW   Maps work area for 3270 full-screen functions (SC----).        02650000
MAPFIW   Maps input field for 3270 full-screen functions (SC----).      02660000
MAPINDEX Maps index entries in (local) IBM module data base.            02670000
MAPINP   Maps expansion of INPWORK macro.                               02680000
MAPINPWK Maps @INPREAD work area.                                       02690000
MAPIOWK  (private) I/O work area and code.                              02700000
MAPJOBDY (private) JES2 I/O area mapping.                               02710000
MAPJOBWK (private) JES2 job display area mapping.                       02720000
MAPLODCB (private) JES2 load module/DCB area mapping.                   02730000
MAPMTS   (private) user data area mapping.                              02740000
MAPMTV   (private) multi-user common vector table.                      02750000
MAPPARSE Maps request area for @PARSER routine.                         02760000
MAPPARST Maps @PARSER results, one entry for keyword or positional.     02770000
MAPPDS   Maps PDS directory entries (usually placed after IHAPDS) for   02780000
           SPF and IEBUPDTX entries.                                    02790000
MAPPINGS Old GBLC tables for system mapping macro versus USING label.   02800000
MAPPRT   Maps expansion of PRTWORK/PUNWORK macros.                      02810000
MAPPRTWK Maps @PRINTER work area.                                       02820000
MAPRDC   Maps return from Read Device Configuration CCWs (x'64', x'E4') 02830000
MAPRES   (private) maps CSA communication area.                         02840000
MAPSBALL Maps request parameters for SUBALLOC routine.                  02850000
MAPSBAWK Maps SUBALLOC return area (code, reason, mesages).             02860000
MAPSBP2W Maps SUBP2W return area (day, month, year, day of week).       02870000
MAPSCR   Maps expansion of SCRWORK area.                                02880000
MAPSCRWK Maps work area used by @SCREENS.                               02890000
MAPSQSP  (private) maps CSA data area.                                  02900000
MAPTSA   Maps common area for @SERVICE functions.                       02910000
MAPVOLRD Maps @VOLREAD return area.                                     02920000
MAPVTOCS (private) maps VTOC work area.                                 02930000
MAPWORK  (private) common functions, pointers, and data.                02940000
MAPXOPTS (private) maps option records.                                 02950000
MAPXWORK (private) maps debugging work area.                            02960000
MASKEQU  Defines mask bits using I and O rather than 0 and 1. E.g.,     02970000
           ICM r0,IIOO,data to load high half-word.                     02980000
MAX      Compares register to storage, and loads larger value. Use      02990000
           with TYPE= for H, E, D, A, or F. A/F is the default.         03000000
MAXH     Compares register with storage halfword; loads larger.         03010000
MDEF     Defines a message (in MDEFHEAD/MDEFEND range).                 03020000
MDEFDICT Builds a dictionary entry from MDEF text.                      03030000
MDEFEND  Ends a message table.                                          03040000
MDEFGBL  Defines globals for message processing.                        03050000
MDEFHEAD Begins a mesage module (one per message range or language).    03060000
MDEFPARM Message processing parameter area mapping (see XMSG).          03070000
MIN      Compares register to storage, and loads smaller value. Use     03080000
           with TYPE= for H, E, D, A, or F. A/F is the default.         03090000
MINH     Compares register with storage halfword; loads smaller.        03100000
MOTE     Shmuel Metz's MNOTE in open code.                              03110000
MSECT    Expands macros requested by NEED or USE (also see MAPPINGS)    03120000
MSORT    Expands code for shell sort.                                   03130000
MTITL    Shmuel Metz's TITLE facility - define fixed part (see STITL)   03140000
MVCLIT   Moves a literal to storage using literal's length.             03150000
MVC2     Move data to storage using second operand's length.            03160000
MVICC    Set a one-byte return code and optional one-byte reason code.  03170000
MVSDSAB  Invokes GETDSAB or local SUBDSAB depending on options.         03180000
MVSQUERY MVS substitute for CVSQUERY; calls SUBQUERY.                   03190000
MVSSVCUP MVS substitute for SVCUPDTE; calls SUBSVCUP.                   03200000
MVST     MVS substitute for MVST instruction.                           03210000
MYLVL    Generates a global integer corresponding to the system level.  03220000
NEED     Names a control block to be expanded by MSECT.                 03230000
NUSE     Names a control bock to be expanded, and a USING register.     03240000
OICCC    OR a one-byte return code and optional one-byte reason code.   03250000
ONEXIT   (private) names a recovery exit.                               03260000
ONSPIE   (private) sets/resets a SPIE recovery exit.                    03270000
OPTIONGB Defines assembly option global variables (also see SYSPARM).   03280000
PARFGSET Sets/resets parsed flags after @PARSER, using SUBVERB lookup.  03290000
PARKEYAD Builds branch address tables, using SUBVERB lookup.            03300000
PARKEYBX Builds BXLE words for table lookup (name, name2, ..., nameZ)   03310000
PARKEYFG Builds flag off and on settings for text string (PARFGSET)     03320000
PARMLOAD Loads PARM address/length in batch and TSO CP.                 03330000
PARSE    Invokes @PARSER to examine a string, with options.             03340000
PATCH    Creates a patch area (64 SL2(*) by default).                   03350000
PFKEYS   Defines assembler globals with PFK names and AID value.        03360000
PGMBAKR  Program header; uses PGMHEAD for MVS, or BAKR.                 03370000
PGMBAND  Returns in PGMBAKR headed code. R15-R1 preloaded.              03380000
PGMEXIT  Returns from a program entered via PGMHEAD.                    03390000
PGMHEAD  Standard program entry; gets storage for save and work areas,  03400000
           clears dynamic storage, sets base(s) and issues USINGS.      03410000
PGMPATCH Creates a patch area of 129S(*).                               03420000
PIT      (old) HASP PIT entry mapping.                                  03430000
PRTBIG   Using @PRINTER files, produces big letters; up to three sizes. 03440000
PRTCLOSE Closes one or more print/punch files.                          03450000
PRTCOM   Inner macro to produce @PRINTER calling parameters.            03460000
PRTDATA  Prints multiple items, each a valid FD operand.                03470000
PRTF     Prints string given address and length and carriage control.   03480000
PRTITEM  Prints a single FD item.                                       03490000
PRTL     Prints a literal string.                                       03500000
PRTLIST  Prints a list of FD items.                                     03510000
PRTOPEN  Opens a single print file, with primary or alternate DD name.  03520000
           Output may also be a TSO terminal or via WTO.                03530000
PRTROOM  Schedules page eject unless specified number of lines fit.     03540000
PRTS     Prints a null terminated string.                               03550000
PRTSNAP  Prints memory in dump format.                                  03560000
PRTSPACE Produces blank lines on current page.                          03570000
PRTV     Print text preceded by an RDW, e.g., WTO text.                 03580000
PRTWORK  Defines printer file: DDname(s), lines/page, width, # titles.  03590000
PSWSECT  (local) maps our MVT password records.                         03600000
PUNWORK  Defines punch file.                                            03610000
QUE      (private) HASP queue name table.                               03620000
RANDOM   Expands a pseudo-random number routine.                        03630000
READFDR  Calls @FDRREAD to get tracks and blocks from an FDR dump tape. 03640000
READTMC  Calls @TMSREAD to get data from UCC-1/CA-1 tape library.       03650000
REGEQU   Symbolic register definitions.                                 03660000
RESCALL  (private) calls CSA resident code.                             03670000
RESCODE  (private) expands CSA code and data.                           03680000
RESTRICT (private) test permissions.                                    03690000
RET31    Return macro for TSX call.                                     03700000
RMODE    Allow assembly under MVS of newer modules.                     03710000
RP       Generates RP expansion for assembler XF.                       03720000
RSECT    Allow assembly under MVS of newer modules; builds CSECT.       03730000
SAC      Defines label, if any, under MVS, else ignored.                03740000
SAVEM    Shmuel Metz's program entry macro (replaced by PGMHEAD).       03750000
SAVEX    Inner macro for SAVEM and PGMHEAD. Supports non-standard       03760000
           register saves, and setting AMODE.                           03770000
SCANAL   (private) routine to analyze 3270 input.                       03780000
SCBILD   (private) routine to build address and data list for SCLINE.   03790000
SCINIT   (private) initialize 3270 I/O.                                 03800000
SCITEM   (private) routine to format one display item (FD entry)        03810000
SCLINE   (private) routine to display FDLINE data and read input.       03820000
SCLIST   (private) routine to format an FD list.                        03830000
SCLOOP   (private) routine to take user exits in an FD list.            03840000
SCMOVE   (private) routine to move input data to storage, after SCANAL. 03850000
SCPAGE   (private) routine to display a page and read input.            03860000
SCRANAL  routine to analyze 3270 input.                                 03870000
SCRCLOSE close @SCREENS processing.                                     03880000
SCRCOM   Inner macro to generate parms for @SCREENS.                    03890000
SCREDIT  removes backspaces, unprintables, and leading/trailing blanks. 03900000
SCRINIT  initialize 3270 I/O.                                           03910000
SCRITEM  routine to format one display item (FD entry)                  03920000
SCRLIST  routine to format an FD list.                                  03930000
SCRLOOP  routine to take user exits in an FD list.                      03940000
SCRMARK  checks for errors and incomplete fields.                       03950000
SCRMOVE  routine to move input data to storage, after SCANAL.           03960000
SCRN     Shmuel Metz's 3270 definition macro.                           03970000
SCROPEN  opens 3270 for processing in @SCREENS.                         03980000
SCRPAGE  routine to display a page and read input.                      03990000
SCRSCAN  scans input from line mode terminal.                           04000000
SCRWORK  defines work area for @SCREENS.                                04010000
SERVCALC replacement for TRKCALC; supports DASD not in sysgen.          04020000
SERVCALL function call to the @SERVICE routine.                         04030000
SERVCOMP Expand WYLBUR line compression work area.                      04040000
SERVDEFS Expands fields (address and data) for preceding @SERVICEs.     04050000
SERVFLAG Maps @SERVICE function name to request values/flags.           04060000
SERVICE  Invokes @SERVICE as an SVC if in LPA; uses SERVCALL otherwise. 04070000
SERVINIT Initializes @SERVICE functions.                                04080000
SERVJES  Calls @SERVICE for JES2 related functions.                     04090000
SERVLOAD Loads named modules, and has SERVDEFS build address DCs.       04100000
SERVPDS  Formats PDS directory entry for display.                       04110000
SERVSORT Expands area for @SERVICE sorting and binary lookup functions. 04120000
SERVTERM Closes files, calls termination entries for loaded modules,    04130000
           releases storage, and deletes loaded modules in @SERVICE.    04140000
SERVTREE Defines work area for SUBTREE (balanced tree builder).         04150000
SERVWORK Acquires or frees work areas on save area chain for @SERVICEs. 04160000
SETAM    Another SAM24/SAM31 substitute.                                04170000
SETCC    Sets condition if higher than current one.                     04180000
SHOWHELP (private) displays DC array.                                   04190000
SIZER    Cause assembly error when module exceeds specified size.       04200000
SMFSEAC  (local) mapping for NCR/Comten 369n written accounting data.   04210000
SMI      (private) expands prompt message.                              04220000
SMPIOWK  (private) mapping of work area for SMP reader (V1 and V2).     04230000
SPFITS   (private) test if items fits on line.                          04240000
SPINDENT (private) indent lines.                                        04250000
SPINIT   (private) initialize 3270 screen builder in INSECT/DSUBSECT.   04260000
SPLEVEL  backward compatibility macro MVS assemblies.                   04270000
SPLINE   (private) conditionally start a new line.                      04280000
SPLINEUP (private) unconditionally start a new line.                    04290000
SPMOVE   (private) move data to screen line.                            04300000
SRST     functional replacement for SRST instruction.                   04310000
ST@      store register in 3 or 4 byte field, with optional high byte.  04320000
STAM     generates a label, if needed, under MVS.                       04330000
STITL    Shmuel Metz's title function, part 2. Replaces right size.     04340000
STMAX    Compare register to storage and store the larger value.        04350000
STMIN    Compare register to storage and store the smaller value.       04360000
STOMP    Debug macro to record a program milestone.                     04370000
STORAGE  MVS version; invokes GETMAIN or FREEMAAIN.                     04380000
STORQ    Removes framing quotes and halves doubled ones.                04390000
SUBCALL  Calls subroutine without using a V constant; accepts literal   04400000
           string as argument (passes address).                         04410000
SUBENT   (local) subroutine entry in program with stack.                04420000
SUBEX    (local) vectored return.                                       04430000
SUBHEAD  (local) subroutine entry in program with stack.                04440000
SUBRET   (local) return from SUBHEADed routine.                         04450000
SVCJFCB  calls SVCMJFCB to modify a JFCB (OS/360).                      04460000
SWAP     exchanges two areas.                                           04470000
SWAPR    exchanges two registers.                                       04480000
SWATCH   Provides stopwatch functions using TIMEUSED or local code (MVS)04490000
SYSPARM  ---===>>> SET LOCAL ENVIRONMENT AND ASSEMBLY OPTIONS <<<===--- 04500000
SYSPOLD  older SYSPARM.                                                 04510000
SYSPOUT  older SYSPARM.                                                 04520000
S64D     Subtract 64-bit value from 64-bit number.                      04530000
S64F     Subtract 32-bit value from 64-bit number.                      04540000
S99FAIL  Invokes DAIRFAIL/IKJEFT18 for SVC 99 error messages.           04550000
TIC      Shortcut for Transfer-In-Channel CCW.                          04560000
TMONSECT (old MVT) mapping record for CICS monitor.                     04570000
TMSREC   Mapping for local UCC-1/CA-1 tape library record.              04580000
TRACEPGM For tracing PGMTRACE problems (needs work).                    04590000
TRANHEAD (private) translation table header.                            04600000
TRENT    Generates DC and ORG for TR and TRT tables.                    04610000
TRINV    Translate table that reverses bits (Kenneth Wilkerson).        04620000
TRTAB    Expands tables for TR and TRT. Predefined are PN, TN, 2260,    04630000
           3270, 3278, Upper case, and Lower case.                      04640000
TRTSMF   (local) table of SMF record types with coded disposition.      04650000
TSX      Calls subroutine with BASSM or BALR, and sets AMODE.           04660000
TTYDEFIN (local) defines control strings for Wylbur devices.            04670000
TTYFLAGS (local) defines indices for terminals defined by TTYDEFIN.     04680000
TTYSEQ   (local) retrieves a control string entry from TTYDEFIN table.  04690000
UCBDEVN  Converts either UCBNAME or device number to 3 or 4 byte entry. 04700000
UNFRAG   (private) unfragments MVT region.                              04710000
UNITSKIP (private) during UCB lookup, skip specially defined units.     04720000
UNITY    Build table of UCBTBYT3/4 with device name.                    04730000
USE      (local) request control block expansion by MSECT.              04740000
USERHMT  (local) maps control area for Unisys An system sending action  04750000
           messages to the mainframe.                                   04760000
VCON     Builds text preceded by RDW field. May have intervening        04770000
           DCs if the END option is used.                               04780000
VERBTAB  Builds (short) string lookup table for BLOOK and VLOOK.        04790000
VFORM    (private) storage formatting interface.                        04800000
VLOOK    Similar to BLOOK, but accepts abbreviations (DEL for DELETE).  04810000
VNENTRY  (private) XCTL support.                                        04820000
VNEXITY  (private) XCTL support.                                        04830000
VOLREAD  Interface to @VOLREAD routine; read and writes VTOC and data.  04840000
VTAB     (local) build interface table for display routine.             04850000
VTOBYTE  prints string with text corresponding to bits on in a flag.    04860000
VTOCHAR  prints string with text corresponding to bits on in storage.   04870000
VTOTAB   builds table with flag and matching text for VTOBYTE/VTOCHAR.  04880000
WTBLD    builds WTO text with various options (single line, multi-line) 04890000
WTCLR    WTO facility by Shmuel Metz. Initializes WTO interface.        04900000
WTERM    writes message to terminal.                                    04910000
WTLST    defines text, with descriptor codes.                           04920000
WTLTP    sets line type flags for multi-line WTO.                       04930000
WTPVT    defines common WTO prefix and resets display area.             04940000
WTU      Write-To-User - issues WTO or TPUT depending on console id.    04950000
WTWRK    Defines work area for Shmuel's WTO facility.                   04960000
         (private)                                                      04970000
XATTACH  (private) issues ATTACH or DETACH.                             04980000
XCALL    (private) calls subroutine in non-zero key (usually TBPKF).    04990000
XCURCON  (private) converts current cursor address to line/indent #s.   05000000
XCURSE   (private) sets cursor display address in FDW area for SCLINE.  05010000
XCURSOR  (private) sets cursor display address in FDW area.             05020000
XDBT     (private) conditional debug expansion; also see XTRAP.         05030000
XDEFAID  (private) defines table of key names per AID byte.             05040000
XDEFCMD  (private) builds lookup table of AID vs. command.              05050000
XDELETE  (private) deletes a module.                                    05060000
XDEVOPT  (private) defines display options for a 3270 group or device.  05070000
XDEVPFK  (private) defines AID vs. command prior to XDEVOPT.            05080000
XDEVSKIP (private) skips specially defined units form UCB lops.         05090000
XDROP    (private) debug mode - drops register use.                     05100000
XDSN     (private) treats input as DSN; prefixes; separates mmeber name.05110000
XECHO    (private) clears screen buffer; echos input; sets up registers.05120000
XFIND    (private)                                                      05130000
XFORMAT  (private) inner macro to expand display conversion code.       05140000
XFREE    (private) frees specific or function storage.                  05150000
XGET     (private) obtains storage.                                     05160000
XHEX     (private) converts (short) storage to hex display.             05170000
XJESRD   (private) reads JES2 spool blocks by MTTR.                     05180000
XLINE    (private) places data into display buffer; skips to new line;  05190000
           converts data to hex display; sets title; etc.               05200000
XLOAD    (private) loads a module.                                      05210000
XLOOK    (private) table lookup (also see BLOOK).                       05220000
XMASK    (private) compares a mask to a string.                         05230000
XMSG     (private) formats a canned message, with optional parameter    05240000
            conversion and insertion. See MDEF macros for tables.       05250000
XOPT     (private) manipulate options control block.                    05260000
XPAGE    (private) display a 3270 page with prompt and get input.       05270000
XPARM    (private) invoke (mini) parser to get and examine next operand.05280000
XPATCH   (private) another patch generator - rounds module to 2K size.  05290000
XPDCHECK (private) test string for a valid packed decimal number.       05300000
XPOUT    (private) similar to XPAGE, but with default MORE prompt.      05310000
XPRINT   (private) debugger - print a line.                             05320000
XPUTGET  (private) display page, get response, and check common commands05330000
XQUEUE   (private) manipulate entries on a queue.                       05340000
XRAND    (private) call or initialize (pseudo) random number generator. 05350000
XREAD    (private) issue read to 3270.                                  05360000
XRENT    (private) initializes pre-allocated 4K work area.              05370000
XREQUIRE (private) checks authorization and environmental prerequisites.05380000
XRITE    (private) writes 3270 buffer.                                  05390000
XROOM    (private) for debug printing reserves room on current page.    05400000
XSCLINE  (private) writes page defined by XLINEs, and reads response.   05410000
XSDELETE (private) deletes modules brought in by XSLOAD.                05420000
XSLOAD   (private) loads subroutines.                                   05430000
XSNAP    (private) debug printer of PSW, registers, and storage.        05440000
XSPACE   (private) spaces lines on debug print.                         05450000
XTAB     (private) AID lookup table that defines XCTL suffices.         05460000
XTHINK   (private) sets and resets wait time from current to maximum.   05470000
XTRANS   (private) translates text for input or output, data or control.05480000
XTRAP    (private) debug interface to display PSW, registers, storage.  05490000
XUCBLOOP (private) loops through all system UCBs.                       05500000
XUSE     (private) debug - declare using register and matching DSECT.   05510000
XWAIT    (private) wait for 3270 attention.                             05520000
XXCTL    (private) XCTL to another module; specify trailing name bytes. 05530000
XXHEAD   (private) generates header code for FD user exit.              05540000
XXHEND   (private) generates exit code for FD exit, and sets cursor.    05550000
XXHHEX   (private) checks input field for valid hexadecimal.            05560000
XXHINT   (private) checks input field for valid integer.                05570000
XXTRKEY  (private) generates AID vs. command entry tables.              05580000
X4CMD    (local) generates command tables for Xerox 4050.               05590000
X4050    (local) generates Xerox 4050 DJDEs and work area.              05600000
YCON     Builds text preceded by 2-byte length. May have intervening    05610000
           DCs if the END option is used.                               05620000
YREGS    another mnemonic register definition (R1-R15)                  05630000
ZI       reset flag bits (ZI ,value instead of NI ,255-value).          05640000
./ ADD NAME=$$RIGHTS
*********************************************************************** 00010003
*                                                                     * 00020003
*                                                                     * 00030003
*          COPYRIGHT 1978, 1981 BY SHMUEL (SEYMOUR J.) METZ           * 00040003
*                                                                     * 00050003
*                   ALL RIGHTS RESERVED.                              * 00060003
*                                                                     * 00070003
*                                                                     * 00080003
* MATERIAL IN THIS LIBRARY IS MADE AVAILABLE SUBJECT TO THE           * 00090003
* FOLLOWING CONDITIONS:                                               * 00100003
*                                                                     * 00110003
*                                                                     * 00120003
* 1.)  ALL COPYRIGHT NOTICES MUST BE RETAINED, AS WELL AS ALL CODE    * 00130003
*      INTENDED TO GENERATE A COPYRIGHT NOTICE IN LISTINGS,           * 00140003
*      IN OBJECT CODE, OR IN FORMATTED DUMPS.  ALL GRANTS OF          * 00150003
*      PERMISSION TO COPY AND/OR USE THIS MATERIAL ARE CONTINGENT ON  * 00160003
*      ADHERANCE TO THIS REQUIREMENT.                                 * 00170003
*                                                                     * 00180003
*                                                                     * 00190003
* 2.)  NO MEMBERS MAY BE DISTRIBUTED WITHOUT EXPLICIT PERMISSION      * 00200003
*      FROM ME, EXCEPT AS SPECIFIED BELOW.                            * 00210003
*                                                                     * 00220003
*                                                                     * 00230003
* 3.)  MATERIAL SUBMITTED BY ME TO PROJECTS OF SHARE, INC.  MAY BE    * 00240003
*      FURTHER DISTRIBUTED ONLY IN ACCORDANCE WITH THE BYLAWS OF      * 00250003
*      SHARE, INC. AND THE RELEVANT PROJECT, AS AUGMENTED BY ANY      * 00260003
*      TERMS AND CONDITIONS ON THE SUBMITTAL FORM.                    * 00270003
*                                                                     * 00280003
*                                                                     * 00290003
* 4.) PERMISSION IS GRANTED FOR BOTH USE AND MARKETING OF THIS        * 00300003
*     MATERIAL TO:                                                    * 00310003
*        EXPERT SYSTEM PROGRAMMING                                    * 00320003
*        176 OLD STAGE COACH ROAD                                     * 00330003
*        BRADFORD, VERMONT  05033-8844                                * 00340003
*        802-222-5117                                                 * 00350003
*                                                                     * 00360003
*        PINKERTON COMPUTER CONSULTANTS, INC.                         * 00370003
*        1900 N BEAUREGARD ST                                         * 00380003
*        FALLS CHURCH, VIRGINIA   22041                               * 00390003
*        703-820-5571                                                 * 00400003
*                                                                     * 00410003
*                                                                     * 00420003
* 5.)  PERMISSION IS GIVEN TO BOTH USE THIS MATERIAL AND TO           * 00430003
*      DISTRIBUTE IT IN CONJUNCTION WITH SCRIPT OR OTHER UOW SOFTWARE * 00440003
*      TO:                                                            * 00450003
*        COMPUTING CENTRE                                             * 00460003
*        UNIVERSITY OF WATERLOO                                       * 00470003
*        WATERLOO, ONTARIO, CANADA                                    * 00480003
*                                                                     * 00490003
*                                                                     * 00500003
* 6.) USE AND DISTRIBUTION PERMISSION IS GIVEN TO THE FOLLOWING       * 00510003
*     SPECIFIC INDIVIDUALS:                                           * 00520003
*        THOMAS A. LITTLE                                             * 00530003
*        MITRE CORPORATION                                            * 00540003
*        BEDFORD, MASSACHUSSETTS                                      * 00550003
*                                                                     * 00560003
*        BRUCE UTTLEY                                                 * 00570003
*        COMPUTING CENTRE                                             * 00580003
*        UNIVERSITY OF WATERLOO                                       * 00590003
*                                                                     * 00600003
*        GERHARD POSTPISCHIL                                          * 00610003
*        ESP, INC.                                                    * 00620003
*                                                                     * 00630003
*                                                                     * 00640003
* 7.)  USE AND DISTRIBUTION PERMISSION IS GIVEN TO THE FOLLOWING:     * 00650003
*        COMPUTER CENTER                                              * 00660003
*        TECHNION, ISRAEL INSTITUTE OF TECHNOLOGY                     * 00670003
*        TECHNION CITY                                                * 00680003
*        HAIFA, ISRAEL                                                * 00690003
*                                                                     * 00700003
*                                                                     * 00710003
* 8.)  PERMISSION TO BOTH USE AND TO MAKE AVAILABLE FOR CUSTOMER USE  * 00720003
*      IS GIVEN TO THE FOLLOWING:                                     * 00730003
*      COMPUTER NETWORK CORPORATION / CONSUMERS COMPUTER SERVICES, INC. 00740003
*      5185 MACARTHUR BOULEVARD                                       * 00750003
*      WASHINGTON, D.C.  20016                                        * 00760003
*                                                                     * 00770003
*                                                                     * 00780003
* 9.)  WHILE IT IS NOT A REQUIREMENT OF DISTRIBUTION, RECIPIENTS OF   * 00790003
*      THIS MATERIAL ARE REQUESTED TO FORWARD TO ME ANY CORRECTIONS   * 00800003
*      OR ENHANCEMENTS WHICH THEY FEEL MAY BE OF GENERAL INTEREST, OR * 00810003
*      WHICH THEY WOULD LIKE TO SEE INCORPORATED IN FUTURE VERSIONS.  * 00820003
*      WHERE IT APPEARS REASONABLE, I WILL ENDEAVOR TO INCORPORATE    * 00830003
*      ANY SUCH ENHANCEMENTS, ALTHOUGH I MAY ELECT TO ISOLATE THEM    * 00840003
*      WITH AN AIF.  MAJOR CHANGES WILL BE IDENTIFIED WITH THE NAME   * 00850003
*      AND INSTALLATION OF THE AUTHOR, UNLESS ANONIMITY IS REQUESTED. * 00860003
*                                                                     * 00870003
*                                                                     * 00880003
*10.)  NO REPRESENTATIONS ARE MADE AS TO THE USABILITY OR CORRECTNESS * 00890003
*      OF ANY OF THIS MATERIAL; HOWEVER, IF YOU REPORT ANY ERRORS I   * 00900003
*      WILL ATTEMPT TO CORRECT THEM.                                  * 00910003
*                                                                     * 00920003
*                                                                     * 00930003
*11.)  MATERIAL IN THESE LIBRARIES MARKED WITH A COPYRIGHT NOTICE     * 00940003
*      FOR EXPERT SYSTEM PROGRAMMING, INC. MAY BE USED IN ACCORDANCE  * 00950003
*      WITH THE ABOVE RULES.                                          * 00960003
*                                                                     * 00970003
*                                                                     * 00980003
*12.)  MATERIAL MARKED IN ANY FASHION AS COPYRIGHTED BY OR            * 00990003
*      PROPRIETARY TO ANYONE OTHER THAN G. POSTPISCHIL, S. METZ,      * 01000003
*      OR ESP, INC. SHOULD NOT BE IN THIS LIBRARY.  PLEASE DELETE     * 01010003
*      ANY SUCH MEMBERS AND INFORM S. METZ OR G. POSTPISCHIL (CARE OF * 01020003
*      EXPERT SYSTEM PROGRAMMING) OF THE ERROR.                       * 01030003
*                                                                     * 01040003
*                                                                     * 01050003
*13.)  MATERIAL NOT MARKED AS PROPRIETARY OR COPYRIGHTED IS BELIEVED  * 01060003
*      TO BE IN THE PUBLIC DOMAIN; MUCH OF IT HAS BEEN ACQUIRED FROM  * 01070003
*      SHARE, INC. AND SIMILAR SOURCES.  THE MEMBERS DERIVING FROM    * 01080003
*      CBT, JES2, AND MVS MODS TAPES MAY BE BACK-LEVEL OR             * 01090003
*      SIGNIFICANTLY CHANGED FROM THE VERSIONS AVAILABLE FROM SHARE:  * 01100003
*      USE YOUR OWN JUDGEMENT.                                        * 01110003
*                                                                     * 01120003
*                                                                     * 01130003
*14.)  ALL IBM MAPPING MACROS ARE BELIEVED TO BE FROM PUBLIC-DOMAIN   * 01140003
*      SOURCES; HOWEVER, THEY ARE ALSO BELIEVED TO BE VALID ONLY FOR  * 01150003
*      THE SYSTEM AND PTF LEVEL I AM CURRENTLY RUNNING FROM.  IN      * 01160003
*      PARTICULAR, SOME OF THEM MAY BE HIT BY MULTIPLE PROGRAM        * 01170003
*      PRODUCTS AT YOUR INSTALLATION, AND SHOULD BE REPLACED FROM     * 01180003
*      THE APPROPRIATE OPTIONAL SOURCE PVTMAC OR AMODGEN.             * 01190003
*                                                                     * 01200003
*                                                                     * 01210003
*                                                                     * 01220003
*      REVIEW OF MEMBERS OPTIONDF, OPTIONGB, AND SYSPARM IN ASM.MAC   * 01230003
*      IS SUGGESTED PRIOR TO ASSEMBLING ANY OF THIS MATERIAL.         * 01240003
*                                                                     * 01250003
*********************************************************************** 01260003
./ ADD NAME=$FCB2
         MACRO -- $FCB2 -- GENERATE 3211 FORMS CONTROL BLOCK IMAGE      00010000
&LABEL   $FCB2 &LPI,&DEFAULT=YES,&INDEX=LEFT,&INDENT=0  ADDED ON 85350  00020000
.*                                                                      00030000
.*       AUTHOR UNKNOWN - OBTAINED FROM OLD SHARE OR CBT TAPE           00040000
.*         RENAMED $FCB2 (FROM $FCB) TO ALLOW FOR $FCB3 FOR 3800 93006  00050000
.*                                                                      00060000
         LCLA  &A(180),&LP,&N,&WK,&CC,&LAST,&K,&K1,&LI                  00070000
         LCLB  &Q,&C,&PASS,&CCH(12),&DFI                                00080000
         LCLC  &CH,&BLANK,&B,&B1,&IX                                    00090000
&LAST    SETA  N'&SYSLIST          GET NR OF OPERANDS                   00100000
         AIF   (&LAST LT 3).MACBAD ERROR IF LT 3                        00110000
.*                                                                      00120000
.*             STEP 1 - VERIFY LINES-PER-INCH OPERAND                   00130000
.*                                                                      00140000
.OP1     AIF   (T'&SYSLIST(1) NE 'N').OP1BAD  OP1 MUST BE NUMERIC       00150000
&LI      SETA  6                   ASSUME OP1 SAYS 6 LINES/INCH         00160000
         AIF   (&SYSLIST(1) EQ 6).OP2  B IF OP1 IS 6                    00170000
         AIF   (&SYSLIST(1) NE 8).OP1BAD  ERR IF NOT 6 OR 8             00180000
&LI      SETA  8                   SHOW 8 LINES/INCH                    00190000
.*                                                                      00200000
.*             STEP 2 - VERIFY LINES-PER-PAGE OPERAND                   00210000
.*                                                                      00220000
.OP2     AIF   (T'&SYSLIST(2) NE 'N').OP2BAD  OP2 MUST BE NUMERIC       00230000
         AIF   (&SYSLIST(2) LT 2 OR &SYSLIST(2) GT 180).OP2BAD          00240000
&LP      SETA  &SYSLIST(2)         SET NR OF LINES PER PAGE             00250000
.*                                                                      00260000
.*             STEP 3 - PROCESS OPERANDS                                00270000
.*                                                                      00280000
.OP3     ANOP                                                           00290000
&N       SETA  2                   SET OPERAND CTR TO 2                 00300000
.OPN     ANOP                      START LOOP                           00310000
&N       SETA  &N+1                ADD 1 TO OPERAND CTR                 00320000
         AIF   (&N GT &LAST).ENDSCAN  B IF NO MORE OPERANDS             00330000
         AIF   (T'&SYSLIST(&N) NE 'N').OPH  B IF NOT NUMERIC OPD        00340000
         AIF   (&N EQ 3).OP3BAD    ERROR IF OP3 NOT HYPHENATED          00350000
         AIF   (NOT &C).OPN        IGNORE OP IF INVALID &CC             00360000
&WK      SETA  &SYSLIST(&N)        SET WORK TO OPERAND VALUE            00370000
.OPN1    AIF   (&WK LT 1 OR &WK GT &LP).OPLBAD  B IF BAD LINE NR        00380000
         AIF   (&A(&WK) NE 0 AND &A(&WK) NE &CC).DUPBAD  B IF DUP       00390000
&A(&WK)  SETA  &CC                 SET &WK-TH LINE TO &CC               00400000
         AGO   .OPN                LOOP                                 00410000
.*                                                                      00420000
.*             STEP 3A - DECODE HYPHENATED OPERAND                      00430000
.*                                                                      00440000
.OPH     ANOP                      NON-NUMERIC OPERAND                  00450000
&K       SETA  K'&SYSLIST(&N)      SET OPERAND CHARACTER COUNT          00460000
&K1      SETA  0                   SET CHAR CT TO ZERO                  00470000
&WK      SETA  0                   SET WORK TO ZERO                     00480000
&PASS    SETB  0                   SHOW FIRST PASS                      00490000
.*                                                                      00500000
.*             1ST PASS - FIND CARRIAGE CHANNEL NUMBER                  00510000
.*             2ND PASS - FIND FIRST LINE NUMBER                        00520000
.*                                                                      00530000
.OPH1    ANOP                      START LOOP                           00540000
&K1      SETA  &K1+1               ADD 1 TO CHAR CTR                    00550000
         AIF   (&K1 GT &K).OPH3    B IF END OF STRING                   00560000
&CH      SETC  '&SYSLIST(&N)'(&K1,1)  GET A CHARACTER                   00570000
         AIF   ('&CH' LT '0' OR '&CH' GT '9').OPH2  B IF NON-NUM        00580000
&WK      SETA  &WK*10+&CH          COMPILE DECIMAL NUMBER               00590000
         AGO   .OPH1               LOOP                                 00600000
.*                                                                      00610000
.*             NON-NUMERIC CHARACTER FOUND.                             00620000
.*             IF FIRST PASS, EXPECT HYPHEN.                            00630000
.*             IF SECOND PASS, ERROR.                                   00640000
.*                                                                      00650000
.OPH2    AIF   (&PASS OR '&CH' NE '-').HYPBAD  B IF ERROR               00660000
&CC      SETA  &WK                 SET CARRIAGE CHANNEL                 00670000
&WK      SETA  0                   ZERO WORK                            00680000
&PASS    SETB  1                   SHOW SECOND PASS                     00690000
         AGO   .OPH1               RETURN TO LOOP                       00700000
.*                                                                      00710000
.*             END OF CHARACTER STRING.                                 00720000
.*             IF FIRST PASS, LOGIC ERROR.                              00730000
.*             IF SECOND PASS, VALIDIFY &CC.                            00740000
.*                                                                      00750000
.OPH3    AIF   (NOT &PASS).LOGBAD  ERROR IF FIRST PASS                  00760000
         AIF   (&CC LT 1 OR &CC GT 12).OPCBAD  B IF CC BAD              00770000
&CCH(&CC) SETB 1                   SHOW CARRIAGE CHANNEL USED           00780000
&C       SETB  1                   SHOW VALID &CC                       00790000
         AGO   .OPN1               GO CHECK VALID LINE NR               00800000
.*                                                                      00810000
.*             OPERAND SCAN IS ENDED.  TEST ITS SUCCESS.                00820000
.*                                                                      00830000
.ENDSCAN AIF   (&Q).QUITBAD        EXIT IF QUIT SWITCH                  00840000
         AIF   (K'&LABEL LE 4).LABBAD  B IF LABEL NOT SPECIFIED         00850000
         AIF   ('&LABEL'(1,4) NE 'FCB2').LABBAD                         00860000
&N       SETA  5                                                        00870000
&K       SETA  K'&LABEL                                                 00880000
.LABLOOP AIF   (&N GT &K).END6                                          00890000
&CH      SETC  '&LABEL'(&N,1)  GET A CHARACTER OF LABEL                 00900000
&N       SETA  &N+1          SET FOR NEXT TIME                          00910000
&C       SETB  0                                                        00920000
&C       SETB  (&C OR ('&CH' GE '0' AND '&CH' LE '9'))                  00930000
&C       SETB  (&C OR ('&CH' GE 'A' AND '&CH' LE 'I'))                  00940000
&C       SETB  (&C OR ('&CH' GE 'J' AND '&CH' LE 'R'))                  00950000
&C       SETB  (&C OR ('&CH' GE 'S' AND '&CH' LE 'Z'))                  00960000
         AIF   (NOT &C).LABBAD     B IF NOT NUM OR ALPHA                00970000
         AGO   .LABLOOP                                                 00980000
.END6    ANOP                                                           00990000
&DFI     SETB  1             PROVISIONALLY SET DEFAULT IMAGE            01000000
         AIF   ('&DEFAULT' EQ '' OR '&DEFAULT' EQ 'YES').END7           01010000
&DFI     SETB  0             SET NO DEFAULT IMAGE AS DEFAULT            01020000
         AIF   ('&DEFAULT' NE 'NO').DEFBAD                              01030000
.END7    ANOP  ,                                                        01040000
.*                                                                      01050000
.*             ENSURE ALL CHANNELS ARE PUNCHED TO PREVENT RUNAWAY       01060000
.*                                                                      01070000
&N       SETA  0                   ZERO CHANNEL COUNTER                 01080000
&C       SETB  0                   ZERO FIRST-TIME MSG SWITCH           01090000
&K       SETA  0                   ZERO TOP-DOWN LINE COUNTER           01100000
&K1      SETA  &LP+1               SET BOTTOM-UP LINE CTR TO MAX+1      01110000
.END11   ANOP                      START LOOP                           01120000
&N       SETA  &N+1                ADD ONE TO CHANNEL COUNTER           01130000
         AIF   (&N GT 12).END19    B IF DONE WITH ALL CHANNELS          01140000
         AIF   (&CCH(&N)).END11    B IF CHANNEL IS ASSIGNED             01150000
         AIF   (&C).END12          B IF NOT FIRST TIME                  01160000
         SPACE 1                                                        01170000
         MNOTE *,'THE FOLLOWING ASSIGNMENTS OF UNSPECIFIED '            01180000
         MNOTE *,'CARRIAGE CHANNELS PREVENT RUN-AWAY FORMS ---'         01190000
&C       SETB  1                   SHOW FIRST-TIME MSG WRITTEN          01200000
.END12   AIF   (&N EQ 9 OR &N EQ 12).END14  B IF CH 9 OR 12             01210000
.END13   ANOP                      UNASSIGNED CHANNEL FOUND             01220000
&K       SETA  &K+1                ADD ONE TO LINE COUNTER              01230000
         AIF   (&K GT &LP).END17   B IF ALL LINES HAVE CHANNELS         01240000
         AIF   (&A(&K) NE 0).END13 B IF THIS LINE HAS A CHANNEL         01250000
&WK      SETA  &K                  SET LINE NUMBER AND                  01260000
         AGO   .END15              GO ASSIGN CHANNEL TO IT              01270000
.END14   ANOP                      UNASSIGNED CHANNEL 9 OR 12           01280000
&K1      SETA  &K1-1               LOWER LINE COUNTER BY ONE            01290000
         AIF   (&K1 LT 1).END17    B IF ALL LINES HAVE CHANNELS         01300000
         AIF   (&A(&K1) NE 0).END14  B IF THIS LINE HAS A CHANNEL       01310000
&WK      SETA  &K1                 SET LINE NUMBER                      01320000
.END15   ANOP                      ASSIGN CHANNEL TO LINE               01330000
&BLANK   SETC  ''                  ASSUME CHANNEL 10 OR GREATER         01340000
         AIF   (&N GT 9).END16     B IF SO                              01350000
&BLANK   SETC  ' '                 ADD A BLANK FOR CHAN 9 OR LESS       01360000
.END16   MNOTE *,'   CARRIAGE CHANNEL &BLANK.&N IN LINE &WK'            01370000
&A(&WK)  SETA  &N                  ASSIGN CHANNEL TO LINE               01380000
&CCH(&N) SETB  1                   SHOW CHANNEL ASSIGNED                01390000
         AGO   .END11              B TO START OF LOOP                   01400000
.END17   AIF   (&CCH(1)).END18     GO IF CHANNEL 1 IS ASSIGNED          01410000
         MNOTE 4,'ERROR - CARRIAGE CHANNEL 1 IS NOT SPECIFIED AND'      01420000
         MNOTE *,'CANNOT BE INSERTED.  CHANNEL 1 PUNCH IS'              01430000
         MNOTE *,'REQUIRED FOR 3211 CARRIAGE-RESTORE FUNCTION.'         01440000
         AGO   .QUITBAD                                                 01450000
.END18   MNOTE 0,'WARNING - UNSPECIFIED CARRIAGE CHANNELS'              01460000
         MNOTE 0,'STARTING WITH CHANNEL &N CAN CAUSE'                   01470000
         MNOTE 0,'RUN-AWAY FORMS.'                                      01480000
.END19   ANOP  ,                                                        01490000
&IX      SETC  ''            NO INDEX                                   01500000
         AIF   (T'&INDENT EQ 'O' OR '&INDENT' EQ '0').SKIPIX            01510000
         AIF   (T'&INDENT EQ 'N').TESTIND                               01520000
.BADIND  MNOTE 4,'INDENT MUST BE NUMERIC (0 TO 31)'                     01530000
         AGO   .QUITBAD                                                 01540000
.TESTIND AIF   (&INDENT GT 31).BADIND                                   01550000
&IX      SETC  '10'          SET DEFAULT (LEFT) INDENT                  01560000
         AIF   (T'&INDEX EQ 'O' OR '&INDEX' EQ 'LEFT').SKIPIX           01570000
&IX      SETC  '01'          SET RIGHT                                  01580000
         AIF   ('&INDEX' EQ 'RIGHT').SKIPIX                             01590000
         MNOTE 4,'INVALID INDEX - SHOULD BE LEFT OR RIGHT'              01600000
         AGO   .QUITBAD                                                 01610000
.SKIPIX  ANOP  ,                                                        01620000
.*                                                                      01630000
.*             CREATE FORMS CONTROL BUFFER OVERLAY                      01640000
.*                                                                      01650000
******************************************************************      01660000
*                                                                *      01670000
         MNOTE *,'3211 FORMS CONTROL BUFFER LOAD FOR &LABEL'            01680000
*                                                                *      01690000
******************************************************************      01700000
*                                                                *      01710000
         SPACE 1                                                        01720000
&LABEL   CSECT ,                                                        01730000
         SPACE 1                                                        01740000
         DC    BL1'&DFI.0000000'  IMAGE TYPE (80=DEFAULT)               01750000
         AIF   ('&IX' EQ '').NOIX                                       01760000
         DC    AL1(&LP+1)    LINES PER FORM/IMAGE + INDEX               01770000
         DC    BL.2'&IX',BL.1'0',AL.5(&INDENT)    INDENTATION           01780000
         AGO   .COMIX                                                   01790000
.NOIX    DC    AL1(&LP)      LINES PER FORM/IMAGE                       01800000
.COMIX   SPACE 1                                                        01810000
*                             GENERATE FORMS CONTROL BUFFER             01820000
&PASS    SETB  (&LI EQ 8)          &PASS=1 FOR 8 LINES/INCH             01830000
&A(1)    SETA  &A(1)+16*&PASS      SET UP FIRST BYTE                    01840000
&A(&LP)  SETA  &A(&LP)+16          SET UP LAST BYTE                     01850000
&N       SETA  0                   SET CUR BYTE PTR TO ZERO             01860000
&K       SETA  0                   SET PREV NON-0 BYTE PTR TO 0         01870000
.DO      ANOP                      BUILD THE FCB                        01880000
&N       SETA  &N+1                POINT TO THE NEXT BYTE               01890000
         AIF   (&A(&N) EQ 0).DO    IF IT'S ZERO, LOOP.                  01900000
&K       SETA  &N-&K-1             COMPUTE NR OF ZERO BYTES             01910000
         AIF   (&K EQ 0).DO1       SKIP DOING THEM IF NONE              01920000
         DC    &K.AL1(0)                                                01930000
.DO1     ANOP                                                           01940000
.*                                                                      01950000
.*             SELECT PROPERLY-COMMENTED DC STATEMENT                   01960000
.*                                                                      01970000
&WK      SETA  &A(&N)              SET WORK TO BYTE'S VALUE             01980000
         AIF   (&WK EQ 16).DO3     B IF ZERO-DIGIT ENTRY                01990000
&B       SETC  ''                  SET TWO LCLC VARIABLES               02000000
&B1      SETC  ''                  TO NULL STRINGS                      02010000
         AIF   (&WK GT 9).DO2      B IF ADCON IS TWO DIGITS             02020000
&B       SETC  ' '                 ELSE ADD BLANK TO COMMENT            02030000
.DO2     ANOP                                                           02040000
&WK      SETA  &WK-&WK/16*16       GET CHANNEL NUMBER                   02050000
         AIF   (&WK GT 9).DO2A     B IF CHANNEL NR IS 2 DIGITS          02060000
&B1      SETC  ' '                 ELSE ADD BLANK TO COMMENT            02070000
.* ONE- OR TWO-DIGIT ENTRY                                              02080000
.DO2A    DC    AL1(&A(&N)),0C'         &B.CHAN &B1.&WK IS AT LINE &N'   02090000
         AGO   .DO4                                                     02100000
.* NO-DIGIT ENTRY                                                       02110000
.DO3     DC    AL1(&A(&N))                                              02120000
.DO4     AIF   (&N EQ &LP).END     B IF LAST BYTE PROCESSED             02130000
&K       SETA  &N                  SET K TO LAST NON-ZERO BYTE          02140000
         AGO   .DO                 GO LOOP                              02150000
.*                                                                      02160000
.*                                                                      02170000
.*                                                                      02180000
.*                                                                      02190000
.*             DIAGNOSTIC ERROR MESSAGES                                02200000
.*                                                                      02210000
.OP1BAD  MNOTE 4,'INVALID OPERAND 1 - &SYSLIST(1) -'                    02220000
         MNOTE *,'FIRST OPERAND MUST BE EITHER 6 OR 8.'                 02230000
&Q       SETB  1                                                        02240000
         AGO   .OP2                                                     02250000
.*                                                                      02260000
.OP2BAD  MNOTE 4,'INVALID OPERAND 2 - &SYSLIST(2) -'                    02270000
         MNOTE *,'SECOND OPERAND MUST BE A NUMBER GREATER THAN 1'       02280000
         MNOTE *,'AND NOT GREATER THAN 180.'                            02290000
&Q       SETB  1                                                        02300000
         AGO   .OP3                                                     02310000
.*                                                                      02320000
.OP3BAD  MNOTE 4,'INVALID OPERAND 3 - &SYSLIST(3) -'                    02330000
         MNOTE *,'THIRD OPERAND MUST HAVE A CARRIAGE CHANNEL'           02340000
         MNOTE *,'NUMBER, A HYPHEN, AND A LINE NUMBER.'                 02350000
&Q       SETB  1                                                        02360000
         AGO   .OPN                                                     02370000
.*                                                                      02380000
.OPLBAD  AIF   (T'&SYSLIST(&N) NE 'N').OPLBADA                          02390000
         MNOTE 4,'INVALID OPERAND &N - &SYSLIST(&N) -'                  02400000
         AGO   .OPLBADB                                                 02410000
.OPLBADA MNOTE 4,'INVALID SUBOPERAND &WK OF OPERAND &N - &SYSLIST(&N) -X02420000
               '                                                        02430000
.OPLBADB MNOTE *,'LINE NUMBER MUST BE GREATER THAN 1 AND '              02440000
         MNOTE *,'NOT GREATER THAN &LP..'                               02450000
&Q       SETB  1                                                        02460000
         AGO   .OPN                                                     02470000
.*                                                                      02480000
.DUPBAD  MNOTE 4,'DUPLICATE SPECIFICATION - OPERAND &N ASSIGNS'         02490000
         MNOTE *,'CARRIAGE CHANNEL &CC TO LINE &WK, WHICH WAS'          02500000
         MNOTE *,'PREVIOUSLY ASSIGNED CHANNEL &A(&WK)..'                02510000
&Q       SETB  1                                                        02520000
         AGO   .OPN                                                     02530000
.*                                                                      02540000
.HYPBAD  MNOTE 4,'INVALID OPERAND &N - &SYSLIST(&N) -'                  02550000
         AIF   (&PASS).HYPBADA                                          02560000
         MNOTE *,'UNRECOGNIZABLE CHARACTER ''&CH'''                     02570000
         AGO   .HYPBADB                                                 02580000
.HYPBADA MNOTE *,'UNRECOGNIZABLE CHARACTER ''&CH'' IN LINE NUMBER.'     02590000
.HYPBADB ANOP                                                           02600000
&Q       SETB  1                                                        02610000
         AGO   .OPN                                                     02620000
.*                                                                      02630000
.OPCBAD  MNOTE 4,'INVALID OPERAND &N - &SYSLIST(&N) -'                  02640000
         MNOTE *,'CARRIAGE CHANNEL MUST BE GREATER THAN 0'              02650000
         MNOTE *,'AND NOT GREATER THAN 12.'                             02660000
&C       SETB  0                   SHOW INVALID &CC                     02670000
&Q       SETB  1                                                        02680000
         AGO   .OPN                                                     02690000
.*                                                                      02700000
.LOGBAD  MNOTE 4,'INTERNAL LOGIC ERROR AT OPERAND &N'                   02710000
         AGO   .QUITBAD                                                 02720000
.*                                                                      02730000
.MACBAD  MNOTE 4,'TOO FEW OPERANDS SPECIFIED.  AT LEAST LINES PER'      02740000
         MNOTE *,'INCH, LINES PER PAGE, AND ONE CARRIAGE CONTROL'       02750000
         MNOTE *,'PUNCH MUST BE SPECIFIED.'                             02760000
         AIF   (N'&SYSLIST EQ 2).OP1                                    02770000
         AGO   .QUITBAD                                                 02780000
.*                                                                      02790000
.QUITBAD MNOTE *,'FCB WILL NOT BE GENERATED'                            02800000
         MEXIT                                                          02810000
.*                                                                      02820000
.LABBAD  MNOTE 8,'ERROR - LABEL MISSING OR INCORRECT'                   02830000
         AGO   .QUITBAD                                                 02840000
.*                                                                      02850000
.DEFBAD  MNOTE 8,'ERROR - DEFAULT OPTION MUST BE ''YES'' OR ''NO'''     02860000
         AGO   .QUITBAD                                                 02870000
.*                                                                      02880000
.END     ANOP                                                           02890000
         SPACE 2                                                        02900000
         MEND                                                           02910000
./ ADD NAME=$FCB3
         MACRO -- $FCB3 -- GENERATE 3800 FORMS CONTROL BLOCK IMAGE      00010000
&LABEL   $FCB3 &LDN,&LPP,&DEFAULT=YES,&INDEX=LEFT,&INDENT=0,           *00020000
               &SKIP=NO,&LPI=                                    93036  00030000
.*                                                                      00040000
.*       AUTHOR UNKNOWN - OBTAINED FROM OLD SHARE OR CBT TAPE           00050000
.*         $FCB RENAMED TO $FCB2; THIS VERSION ADAPTED FOR IBM 3800     00060000
.*         AND STC 6100. NOTE THAT THE STC 6100 DOES NOT HAVE THE HALF- 00070000
.*         INCH MULTIPLE PAPER LENGTH RESTRICTION THE 3800 HAS, AND     00080000
.*         THAT IT ACCEPTS FORMS LONGER THAN 11 INCHES, HENCE THERE     00090000
.*         ARE NO CHECKS FOR EITHER CONDITION.                   93006  00100000
.*       THE 6100 SUPPORTS (HARDWARE FEATURE) PERFORATION OVERPRINTING. 00110000
.*         THIS IS SET WITH SKIP=NO. CHANGE TO SKIP=YES FOR 3800S.      00120000
.*         SKIP=NO PRODUCES A "SIGNATURE FRAME" OF 0B0000 AND 000000    00130000
.*         AROUND THE ACTUAL FCB TEXT (LINE COUNT INCREASED TO MATCH).  00140000
.*         ADDITIONALLY, IN THIS MODE A LINE DENSITY OF 24/INCH IS      00150000
.*         SUPPORTED, AND FORMS LENGTH MAY BE MULTIPLE OF 1/6 INCH.     00160000
.*                                                               93036  00170000
.*         NOTE THAT CHANNEL ONE MAY APPEAR ONLY ONCE, ON LINE 1.       00180000
.*       THE DEFAULT, INDEX AND INDENT OPTIONS WERE KEPT TO ALLOW $FCB2 00190000
.*         DECKS TO BE USED AS IS (WITH FCB2 => FCB3)            93006  00200000
.*                                                                      00210000
.********************************************************************** 00220000
.*                                                                    * 00230000
.*   NOTE: $FCB3 IS COPIED TO MACLIB AFTER UPDATES FOR USER IMAGELIB  * 00240000
.*                                                                    * 00250000
.********************************************************************** 00260000
         LCLA  &A(336),&LP,&N,&WK,&CC,&LAST,&K,&K1,&LI,&NP,&I,&J,&MAX   00270000
         LCLA  &O1,&O2                                          GP03245 00280000
         LCLB  &Q,&C,&PASS,&CCH(12),&DFI,&POF                    93036  00290000
         LCLC  &V(336),&CH,&BLANK,&B,&B1,&IX,&NAM,&CD,&DV        93036  00300000
&POF     SETB  ('&SKIP' EQ 'NO')   PERFORATION SKIP              93036  00310000
&LAST    SETA  N'&SYSLIST          GET NR OF OPERANDS                   00320000
&DV      SETC  '3800'                                            93036  00330000
&MAX     SETA  336                                               93036  00340000
         AIF   (NOT &POF).DV3800                                 93036  00350000
&MAX     SETA  330                                               93036  00360000
&DV      SETC  '6100'                                            93036  00370000
.DV3800  AIF   (&LAST LT 3).MACBAD ERROR IF LT 3                        00380000
.*                                                                      00390000
.*             STEP 1 - VERIFY LINES-PER-INCH OPERAND                   00400000
.*                                                                      00410000
.OP1     AIF   (T'&LDN NE 'N').OP1BAD  OP1 MUST BE NUMERIC       93006  00420000
         AIF   (&LDN EQ 6 OR &LDN EQ 8).OP1GUD                   93036  00430000
         AIF   (&LDN NE 10 AND &LDN NE 12 AND &LDN NE 24).OP1BAD 93036  00440000
.OP1GUD  ANOP  ,                                                 93036  00450000
&LI      SETA  &LDN          SET LINES PER INCH                  93006  00460000
&NP      SETA  &LI/2         NON-PRINTING MARGIN                 93006  00470000
&CD      SETC  '.....0.1.2.3...........5'(&LI,1)  SET LPI FLAG VALUE    00480000
.*                                                                      00490000
.*             STEP 2 - VERIFY LINES-PER-PAGE OPERAND                   00500000
.*                                                                      00510000
.OP2     AIF   (T'&SYSLIST(2) NE 'N').OP2BAD  OP2 MUST BE NUMERIC       00520000
         AIF   (&SYSLIST(2) LE &LI OR &SYSLIST(2) GT &MAX).OP2BAD       00530000
&LP      SETA  &SYSLIST(2)         SET NR OF LINES PER PAGE             00540000
&N       SETA  1             SET LOOP INDEX                      93036  00550000
         AIF   (&POF).OP2I   PRINT OVER FOLD - KEEP LENGTH       93036  00560000
&LP      SETA  &LP-&LI       ALLOW FOR TOP AND BOTTOM MARGIN     93006  00570000
.OP2I    ANOP  ,                                                 93036  00580000
&V(&N)   SETC  '&CD'         PRESET ALL LINES FOR BASIC DENSITY  93036  00590000
&N       SETA  &N+1                                              93036  00600000
         AIF   (&N LE &LP).OP2I                                  93036  00610000
.*                                                               93036  00620000
.*   LOOK FOR LINE DENSITY OVERRIDES:                            93036  00630000
.*     LPI=((LPI),(LPI,N),(,N)...)                               93036  00640000
.*   WHERE (LPI) DOES ONE LINE AT 'LPI' DENSITY                  93036  00650000
.*       (LPI,N) DOES 'N' LINES AT DENSITY 'LPI'                 93036  00660000
.*     AND  (,N) DOES 'N' LINES AT DEFAULT DENSITY               93036  00670000
.*                                                               93036  00680000
         AIF   (T'&LPI EQ 'O').OP4   NO OVERRIDES                93036  00690000
&N       SETA  N'&LPI        NUMBER OF SUBOPERANDS               93036  00700000
&K       SETA  0                                                 93036  00710000
&I       SETA  1             ARRAY INDEX                         93036  00720000
.OP3LUP  AIF   (&K GE &N).OP4  ALL DONE                          93036  00730000
&K       SETA  &K+1                                              93036  00740000
         AIF   (N'&LPI(&K) LT 1).OP3LUP                          93036  00750000
&O1      SETA  &LDN          SET DEFAULT LINES PER INCH          93036  00760000
&O2      SETA  1             SET DEFAULT LINE COUNT              93036  00770000
         AIF   (N'&LPI(&K) LT 2).OP3S                            93036  00780000
         AIF   (N'&LPI(&K) GT 2).OP3BAD                          93036  00790000
         AIF   ('&LPI(&K,1)' EQ '').OP31D                        93036  00800000
&B       SETC  '&LPI(&K,1)'                                      93036  00810000
         AIF   (T'&B NE 'N').OP3BAD                              93036  00820000
&O1      SETA  &B                                                93036  00830000
.OP31D   AIF   (T'&LPI(&K,2) NE 'N').OP3BAD                      93036  00840000
&O2      SETA  &LPI(&K,2)                                        93036  00850000
         AGO   .OP3MAKE                                          93036  00860000
.OP3S    AIF   (T'&LPI(&K,1) NE 'N').OP3BAD                      93036  00870000
&O1      SETA  &LPI(&K,1)                                        93036  00880000
.OP3MAKE AIF   (&O1 EQ 6 OR &O1 EQ 8).OP3GUD                     93036  00890000
         AIF   (&O1 NE 10 AND &O1 NE 12 AND &O1 NE 24).OP3BAD    93036  00900000
.OP3GUD  ANOP  ,                                                 93036  00910000
&B       SETC  '.....0.1.2.3...........5'(&O1,1)  SET LPI FLAG VALUE    00920000
&J       SETA  &I+&O2                                            93036  00930000
         AIF   (&J LE &LP+1).OP3FILL                             93036  00940000
 MNOTE 8,'LPI OPERAND &K &LPI(&K) EXCEEDS NUMBER OF LINES SPECIFIED'    00950000
         AGO   .OP4                                              93036  00960000
.OP3FILL ANOP  ,                                                 93036  00970000
&V(&I)   SETC  '&B'                                              93036  00980000
&I       SETA  &I+1                                              93036  00990000
         AIF   (&I LT &J).OP3FILL                                93036  01000000
         AGO   .OP3LUP                                           93036  01010000
.OP3BAD  MNOTE 8,'INVALID LPI OPERAND &K : &LPI(&K) '            93036  01020000
         AGO   .OP3LUP                                           93036  01030000
.*                                                                      01040000
.*             STEP 4 - PROCESS OPERANDS                                01050000
.*                                                                      01060000
.OP4     ANOP  ,                                                        01070000
&N       SETA  2                   SET OPERAND CTR TO 2                 01080000
.OPN     ANOP                      START LOOP                           01090000
&N       SETA  &N+1                ADD 1 TO OPERAND CTR                 01100000
         AIF   (&N GT &LAST).ENDSCAN  B IF NO MORE OPERANDS             01110000
         AIF   (T'&SYSLIST(&N) NE 'N').OPH  B IF NOT NUMERIC OPD        01120000
         AIF   (&N EQ 3).OP3BAD    ERROR IF OP3 NOT HYPHENATED          01130000
         AIF   (NOT &C).OPN        IGNORE OP IF INVALID &CC             01140000
&WK      SETA  &SYSLIST(&N)        SET WORK TO OPERAND VALUE            01150000
.OPN1    AIF   (&WK LT 1 OR &WK GT &LP).OPLBAD  B IF BAD LINE NR        01160000
         AIF   (&A(&WK) NE 0 AND &A(&WK) NE &CC).DUPBAD  B IF DUP       01170000
&A(&WK)  SETA  &CC                 SET &WK-TH LINE TO &CC               01180000
         AGO   .OPN                LOOP                                 01190000
.*                                                                      01200000
.*             STEP 3A - DECODE HYPHENATED OPERAND                      01210000
.*                                                                      01220000
.OPH     ANOP                      NON-NUMERIC OPERAND                  01230000
&K       SETA  K'&SYSLIST(&N)      SET OPERAND CHARACTER COUNT          01240000
&K1      SETA  0                   SET CHAR CT TO ZERO                  01250000
&WK      SETA  0                   SET WORK TO ZERO                     01260000
&PASS    SETB  0                   SHOW FIRST PASS                      01270000
.*                                                                      01280000
.*             1ST PASS - FIND CARRIAGE CHANNEL NUMBER                  01290000
.*             2ND PASS - FIND FIRST LINE NUMBER                        01300000
.*                                                                      01310000
.OPH1    ANOP                      START LOOP                           01320000
&K1      SETA  &K1+1               ADD 1 TO CHAR CTR                    01330000
         AIF   (&K1 GT &K).OPH3    B IF END OF STRING                   01340000
&CH      SETC  '&SYSLIST(&N)'(&K1,1)  GET A CHARACTER                   01350000
         AIF   ('&CH' LT '0' OR '&CH' GT '9').OPH2  B IF NON-NUM        01360000
&WK      SETA  &WK*10+&CH          COMPILE DECIMAL NUMBER               01370000
         AGO   .OPH1               LOOP                                 01380000
.*                                                                      01390000
.*             NON-NUMERIC CHARACTER FOUND.                             01400000
.*             IF FIRST PASS, EXPECT HYPHEN.                            01410000
.*             IF SECOND PASS, ERROR.                                   01420000
.*                                                                      01430000
.OPH2    AIF   (&PASS OR '&CH' NE '-').HYPBAD  B IF ERROR               01440000
&CC      SETA  &WK                 SET CARRIAGE CHANNEL                 01450000
&WK      SETA  0                   ZERO WORK                            01460000
&PASS    SETB  1                   SHOW SECOND PASS                     01470000
         AGO   .OPH1               RETURN TO LOOP                       01480000
.*                                                                      01490000
.*             END OF CHARACTER STRING.                                 01500000
.*             IF FIRST PASS, LOGIC ERROR.                              01510000
.*             IF SECOND PASS, VERIFY &CC.                              01520000
.*                                                                      01530000
.OPH3    AIF   (NOT &PASS).LOGBAD  ERROR IF FIRST PASS                  01540000
         AIF   (&CC LT 1 OR &CC GT 12).OPCBAD  B IF CC BAD              01550000
&CCH(&CC) SETB 1                   SHOW CARRIAGE CHANNEL USED           01560000
&C       SETB  1                   SHOW VALID &CC                       01570000
         AGO   .OPN1               GO CHECK VALID LINE NR               01580000
.*                                                                      01590000
.*             OPERAND SCAN IS ENDED.  TEST ITS SUCCESS.                01600000
.*                                                                      01610000
.ENDSCAN AIF   (&Q).QUITBAD        EXIT IF QUIT SWITCH                  01620000
         AIF   (K'&LABEL LE 4).LABBAD  B IF LABEL NOT SPECIFIED         01630000
         AIF   ('&LABEL'(1,4) NE 'FCB3').LABBAD                         01640000
&N       SETA  5                                                        01650000
&K       SETA  K'&LABEL                                                 01660000
&NAM     SETC  '&LABEL'(5,&K-4)  MAKE FCB NAME                   93006  01670000
.LABLOOP AIF   (&N GT &K).END6                                          01680000
&CH      SETC  '&LABEL'(&N,1)  GET A CHARACTER OF LABEL                 01690000
&N       SETA  &N+1          SET FOR NEXT TIME                          01700000
&C       SETB  0                                                        01710000
&C       SETB  (&C OR ('&CH' GE '0' AND '&CH' LE '9'))                  01720000
&C       SETB  (&C OR ('&CH' GE 'A' AND '&CH' LE 'I'))                  01730000
&C       SETB  (&C OR ('&CH' GE 'J' AND '&CH' LE 'R'))                  01740000
&C       SETB  (&C OR ('&CH' GE 'S' AND '&CH' LE 'Z'))                  01750000
         AIF   (NOT &C).LABBAD     B IF NOT NUM OR ALPHA                01760000
         AGO   .LABLOOP                                                 01770000
.END6    ANOP                                                           01780000
&DFI     SETB  1             PROVISIONALLY SET DEFAULT IMAGE            01790000
         AIF   ('&DEFAULT' EQ '' OR '&DEFAULT' EQ 'YES').END7           01800000
&DFI     SETB  0             SET NO DEFAULT IMAGE AS DEFAULT            01810000
         AIF   ('&DEFAULT' NE 'NO').DEFBAD                              01820000
.END7    ANOP  ,                                                        01830000
.*                                                                      01840000
.*             ENSURE ALL CHANNELS ARE PUNCHED TO PREVENT RUNAWAY       01850000
.*                                                                      01860000
&N       SETA  0                   ZERO CHANNEL COUNTER                 01870000
&C       SETB  0                   ZERO FIRST-TIME MSG SWITCH           01880000
&K       SETA  0                   ZERO TOP-DOWN LINE COUNTER           01890000
&K1      SETA  &LP+1               SET BOTTOM-UP LINE CTR TO MAX+1      01900000
.END11   ANOP                      START LOOP                           01910000
&N       SETA  &N+1                ADD ONE TO CHANNEL COUNTER           01920000
         AIF   (&N GT 12).END19    B IF DONE WITH ALL CHANNELS          01930000
         AIF   (&CCH(&N)).END11    B IF CHANNEL IS ASSIGNED             01940000
         AIF   (&C).END12          B IF NOT FIRST TIME                  01950000
         SPACE 1                                                        01960000
         MNOTE *,'THE FOLLOWING ASSIGNMENTS OF UNSPECIFIED '            01970000
         MNOTE *,'CARRIAGE CHANNELS PREVENT RUN-AWAY FORMS ---'         01980000
&C       SETB  1                   SHOW FIRST-TIME MSG WRITTEN          01990000
.END12   AIF   (&N EQ 9 OR &N EQ 12).END14  B IF CH 9 OR 12             02000000
.END13   ANOP                      UNASSIGNED CHANNEL FOUND             02010000
&K       SETA  &K+1                ADD ONE TO LINE COUNTER              02020000
         AIF   (&K GT &LP).END17   B IF ALL LINES HAVE CHANNELS         02030000
         AIF   (&A(&K) NE 0).END13 B IF THIS LINE HAS A CHANNEL         02040000
&WK      SETA  &K                  SET LINE NUMBER AND                  02050000
         AGO   .END15              GO ASSIGN CHANNEL TO IT              02060000
.END14   ANOP                      UNASSIGNED CHANNEL 9 OR 12           02070000
&K1      SETA  &K1-1               LOWER LINE COUNTER BY ONE            02080000
         AIF   (&K1 LT 1).END17    B IF ALL LINES HAVE CHANNELS         02090000
         AIF   (&A(&K1) NE 0).END14  B IF THIS LINE HAS A CHANNEL       02100000
&WK      SETA  &K1                 SET LINE NUMBER                      02110000
.END15   ANOP                      ASSIGN CHANNEL TO LINE               02120000
&BLANK   SETC  ''                  ASSUME CHANNEL 10 OR GREATER         02130000
         AIF   (&N GT 9).END16     B IF SO                              02140000
&BLANK   SETC  ' '                 ADD A BLANK FOR CHAN 9 OR LESS       02150000
.END16   MNOTE *,'   CARRIAGE CHANNEL &BLANK.&N IN LINE &WK'            02160000
&A(&WK)  SETA  &N                  ASSIGN CHANNEL TO LINE               02170000
&CCH(&N) SETB  1                   SHOW CHANNEL ASSIGNED                02180000
         AGO   .END11              B TO START OF LOOP                   02190000
.END17   AIF   (&CCH(1)).END18     GO IF CHANNEL 1 IS ASSIGNED          02200000
         MNOTE 4,'ERROR - CARRIAGE CHANNEL 1 IS NOT SPECIFIED AND'      02210000
         MNOTE *,'CANNOT BE INSERTED.  CHANNEL 1 PUNCH IS'              02220000
         MNOTE *,'REQUIRED FOR 3800 CARRIAGE-RESTORE FUNCTION.'  93006  02230000
         AGO   .QUITBAD                                                 02240000
.END18   MNOTE 0,'WARNING - UNSPECIFIED CARRIAGE CHANNELS'              02250000
         MNOTE 0,'STARTING WITH CHANNEL &N CAN CAUSE'                   02260000
         MNOTE 0,'DATA CHECKS.'                                  93036  02270000
.END19   ANOP  ,                                                        02280000
&IX      SETC  ''            NO INDEX                                   02290000
         AIF   (T'&INDENT EQ 'O' OR '&INDENT' EQ '0').SKIPIX            02300000
         AIF   (T'&INDENT EQ 'N').TESTIND                               02310000
.BADIND  MNOTE 4,'INDENT MUST BE NUMERIC (0 TO 31)'                     02320000
         AGO   .QUITBAD                                                 02330000
.TESTIND AIF   (&INDENT GT 31).BADIND                                   02340000
&IX      SETC  '10'          SET DEFAULT (LEFT) INDENT                  02350000
         AIF   (T'&INDEX EQ 'O' OR '&INDEX' EQ 'LEFT').SKIPIX           02360000
&IX      SETC  '01'          SET RIGHT                                  02370000
         AIF   ('&INDEX' EQ 'RIGHT').SKIPIX                             02380000
         MNOTE 4,'INVALID INDEX - SHOULD BE LEFT OR RIGHT'              02390000
         AGO   .QUITBAD                                                 02400000
.SKIPIX  ANOP  ,                                                        02410000
.*                                                                      02420000
.*             CREATE FORMS CONTROL BUFFER OVERLAY                      02430000
.*                                                                      02440000
******************************************************************      02450000
*                                                                *      02460000
         MNOTE *,' &DV FORMS CONTROL BUFFER LOAD FOR &LABEL'     93006  02470000
*                                                                *      02480000
******************************************************************      02490000
*                                                                *      02500000
         SPACE 1                                                        02510000
&LABEL   CSECT ,                                                        02520000
         SPACE 1                                                        02530000
         DC    CL4'&NAM '    FCB3 NAME                                  02540000
         AIF   (NOT &POF).SKPFLD  SKIP OVER FOLD                 93036  02550000
         DC    A(&LPP+6)     LINES PER PAGE + SIGNATURE          93036  02560000
         DC    X'0B0000'     NON-SKIP REQUEST                    93036  02570000
         AGO   .PROVFD       SKIP SKIP CODE                      93036  02580000
.SKPFLD  DC    A(&LPP)       LINES PER PAGE                      93006  02590000
         DC    &NP.AL.4(&CD,0)  NON-PRINTING TOP MARGIN          93006  02600000
.PROVFD  SPACE 1                                                        02610000
*                             GENERATE FORMS CONTROL BUFFER             02620000
&N       SETA  0                   SET CUR BYTE PTR TO ZERO             02630000
.DOLP    ANOP  ,                   BUILD THE FCB                        02640000
&N       SETA  &N+1                POINT TO THE NEXT BYTE               02650000
&K       SETA  &N            REMEMBER THE STARTING POINT         93036  02660000
         AIF   (&A(&N) NE 0 OR &N GE &LP).DO1                    93036  02670000
.DOMR    AIF   (&N GE &LP).DOXP                                  93036  02680000
         AIF   (&A(&N) NE &A(&N+1) OR &V(&N) NE &V(&N+1)).DOXP   93036  02690000
&N       SETA  &N+1                                              93036  02700000
         AGO   .DOMR                                             93036  02710000
.DOXP    ANOP  ,                                                 93036  02720000
&I       SETA  &N-&K+1       SET NUMBER OF EQUAL LINES           93036  02730000
         AIF   (&I LT 2).DO1       SKIP DOING THEM IF NONE              02740000
         DC    &I.AL.4(&V(&N),&A(&N))                            93036  02750000
         AGO   .DO4          SET FOR NEXT                        93036  02760000
.DO1     ANOP  ,                                                        02770000
.*                                                                      02780000
.*             SELECT PROPERLY-COMMENTED DC STATEMENT                   02790000
.*                                                                      02800000
&WK      SETA  &A(&N)              SET WORK TO BYTE'S VALUE             02810000
         AIF   (&WK EQ 0).DO3      B IF ZERO-DIGIT ENTRY         93036  02820000
&B       SETC  ''                  SET TWO LCLC VARIABLES               02830000
         AIF   (&WK GT 9).DO2      B IF ADCON IS TWO DIGITS             02840000
&B       SETC  ' '                 ELSE ADD BLANK TO COMMENT            02850000
.* ONE- OR TWO-DIGIT ENTRY                                              02860000
.DO2     DC AL.4(&V(&N),&A(&N)),0C'      &B.CHAN &B.&WK IS AT LINE &N'  02870000
         AGO   .DO4                                                     02880000
.* NO-DIGIT ENTRY                                                       02890000
.DO3     DC    AL.4(&V(&N),&A(&N))                               93036  02900000
.DO4     AIF   (&N EQ &LP).END     B IF LAST BYTE PROCESSED             02910000
         AGO   .DOLP               GO LOOP                              02920000
.*                                                                      02930000
.*                                                                      02940000
.*                                                                      02950000
.*                                                                      02960000
.*             DIAGNOSTIC ERROR MESSAGES                                02970000
.*                                                                      02980000
.OP1BAD  MNOTE 4,'INVALID OPERAND 1 - &SYSLIST(1) -'                    02990000
         MNOTE *,'FIRST OPERAND MUST BE EITHER 6 OR 8.'                 03000000
&Q       SETB  1                                                        03010000
         AGO   .OP2                                                     03020000
.*                                                                      03030000
.OP2BAD  MNOTE 4,'INVALID OPERAND 2 - &SYSLIST(2) -'                    03040000
         MNOTE *,'SECOND OPERAND MUST BE A NUMBER GREATER THAN 1'       03050000
         MNOTE *,'AND NOT GREATER THAN &MAX.'                    93036  03060000
&Q       SETB  1                                                        03070000
         AGO   .OP4                                                     03080000
.*                                                                      03090000
.OP4BAD  MNOTE 4,'INVALID OPERAND 3 - &SYSLIST(3) -'                    03100000
         MNOTE *,'THIRD OPERAND MUST HAVE A CARRIAGE CHANNEL'           03110000
         MNOTE *,'NUMBER, A HYPHEN, AND A LINE NUMBER.'                 03120000
&Q       SETB  1                                                        03130000
         AGO   .OPN                                                     03140000
.*                                                                      03150000
.OPLBAD  AIF   (T'&SYSLIST(&N) NE 'N').OPLBADA                          03160000
         MNOTE 4,'INVALID OPERAND &N - &SYSLIST(&N) -'                  03170000
         AGO   .OPLBADB                                                 03180000
.OPLBADA MNOTE 4,'INVALID SUBOPERAND &WK OF OPERAND &N - &SYSLIST(&N) -X03190000
               '                                                        03200000
.OPLBADB MNOTE *,'LINE NUMBER MUST BE GREATER THAN 1 AND '              03210000
         MNOTE *,'NOT GREATER THAN &LP..'                               03220000
&Q       SETB  1                                                        03230000
         AGO   .OPN                                                     03240000
.*                                                                      03250000
.DUPBAD  MNOTE 4,'DUPLICATE SPECIFICATION - OPERAND &N ASSIGNS'         03260000
         MNOTE *,'CARRIAGE CHANNEL &CC TO LINE &WK, WHICH WAS'          03270000
         MNOTE *,'PREVIOUSLY ASSIGNED CHANNEL &A(&WK)..'                03280000
&Q       SETB  1                                                        03290000
         AGO   .OPN                                                     03300000
.*                                                                      03310000
.HYPBAD  MNOTE 4,'INVALID OPERAND &N - &SYSLIST(&N) -'                  03320000
         AIF   (&PASS).HYPBADA                                          03330000
         MNOTE *,'UNRECOGNIZABLE CHARACTER ''&CH'''                     03340000
         AGO   .HYPBADB                                                 03350000
.HYPBADA MNOTE *,'UNRECOGNIZABLE CHARACTER ''&CH'' IN LINE NUMBER.'     03360000
.HYPBADB ANOP                                                           03370000
&Q       SETB  1                                                        03380000
         AGO   .OPN                                                     03390000
.*                                                                      03400000
.OPCBAD  MNOTE 4,'INVALID OPERAND &N - &SYSLIST(&N) -'                  03410000
         MNOTE *,'CARRIAGE CHANNEL MUST BE GREATER THAN 0'              03420000
         MNOTE *,'AND NOT GREATER THAN 12.'                             03430000
&C       SETB  0                   SHOW INVALID &CC                     03440000
&Q       SETB  1                                                        03450000
         AGO   .OPN                                                     03460000
.*                                                                      03470000
.LOGBAD  MNOTE 4,'INTERNAL LOGIC ERROR AT OPERAND &N'                   03480000
         AGO   .QUITBAD                                                 03490000
.*                                                                      03500000
.MACBAD  MNOTE 4,'TOO FEW OPERANDS SPECIFIED.  AT LEAST LINES PER'      03510000
         MNOTE *,'INCH, LINES PER PAGE, AND ONE CARRIAGE CONTROL'       03520000
         MNOTE *,'PUNCH MUST BE SPECIFIED.'                             03530000
         AIF   (N'&SYSLIST EQ 2).OP1                                    03540000
         AGO   .QUITBAD                                                 03550000
.*                                                                      03560000
.QUITBAD MNOTE *,'FCB WILL NOT BE GENERATED'                            03570000
         MEXIT                                                          03580000
.*                                                                      03590000
.LABBAD  MNOTE 8,'ERROR - LABEL MISSING OR INCORRECT (NOT FCB3XXXX)'    03600000
         AGO   .QUITBAD                                                 03610000
.*                                                                      03620000
.DEFBAD  MNOTE 8,'ERROR - DEFAULT OPTION MUST BE ''YES'' OR ''NO'''     03630000
         AGO   .QUITBAD                                                 03640000
.*                                                                      03650000
.END     AIF   (NOT &POF).ENDSKP                                 93036  03660000
         DC    X'000000'     FAKE BOTTOM MARGIN                  93036  03670000
         MEXIT ,                                                 93036  03680000
.ENDSKP  DC    &NP.AL.4(&CD,0)   NON-PRINTING BOTTOM MARGIN      93006  03690000
         SPACE 2                                                        03700000
         MEND                                                           03710000
./ ADD NAME=$HEAD
         MACRO ,                                                        00020000
        $HEAD  &STRING,           STRING IS EXPANDED                   *00040000
               &BLOCK=YES,        STRING IS TO BE BLOCKED              *00060000
               &PRINT=GEN,        OPTIONAL OUTPUT SUPPRESSION          *00070000
               &TITLE=            (A,'B') -GEN TITLE STATEMENT WITH    *00080000
                                  NAME FIELD A, AND TITLE 'B'           00100000
.*                                                                      00120000
.*  THIS MACRO COPIED & ALTERED FROM 'MIM#3' WRITTEN BY C. J. GOELZ     00140000
.*                                                                      00160000
         LCLB  &HEADB                                                   00180000
         LCLC  &HEADC(497)                                              00200000
         LCLA  &I                                                       00220000
         LCLA  &J                                                       00240000
         LCLA  &K                                                       00260000
         LCLA  &L                                                       00280000
         LCLA  &M                                                       00300000
         LCLA  &N                                                       00320000
         LCLC  &F(64)                                                   00340000
         LCLC  &STR(64)                                                 00360000
         LCLC  &B                                                       00380000
         LCLC  &W                                                       00400000
.*                                                                      00420000
.*                                                                      00440000
         AIF   (&HEADB).PROC                                            00460000
&HEADB   SETB  (1)                                                      00480000
&HEADC(1)    SETC  ' '                                                  00500000
&HEADC(2)    SETC  '        '                                           00520000
&HEADC(3)    SETC  '        '                                           00540000
&HEADC(4)    SETC  '        '                                           00560000
&HEADC(5)    SETC  '        '                                           00580000
&HEADC(6)    SETC  '        '                                           00600000
&HEADC(7)    SETC  '        '                                           00620000
&HEADC(8)    SETC  '        '                                           00640000
&HEADC(9)    SETC  '        '                                           00660000
&HEADC(10)   SETC  'A'                                                  00680000
&HEADC(11)   SETC  '    A   '                                           00700000
&HEADC(12)   SETC  '   AAA  '                                           00720000
&HEADC(13)   SETC  '  AA AA '                                           00740000
&HEADC(14)   SETC  ' AA   AA'                                           00760000
&HEADC(15)   SETC  ' AA   AA'                                           00780000
&HEADC(16)   SETC  ' AAAAAAA'                                           00800000
&HEADC(17)   SETC  ' AA   AA'                                           00820000
&HEADC(18)   SETC  ' AA   AA'                                           00840000
&HEADC(19)   SETC  'B'                                                  00860000
&HEADC(20)   SETC  ' BBBBBB '                                           00880000
&HEADC(21)   SETC  ' BB   BB'                                           00900000
&HEADC(22)   SETC  ' BB   BB'                                           00920000
&HEADC(23)   SETC  ' BBBBBB '                                           00940000
&HEADC(24)   SETC  ' BB   BB'                                           00960000
&HEADC(25)   SETC  ' BB   BB'                                           00980000
&HEADC(26)   SETC  ' BB   BB'                                           01000000
&HEADC(27)   SETC  ' BBBBBB '                                           01020000
&HEADC(28)   SETC  'C'                                                  01040000
&HEADC(29)   SETC  '  CCCCC '                                           01060000
&HEADC(30)   SETC  ' CC   CC'                                           01080000
&HEADC(31)   SETC  ' CC   CC'                                           01100000
&HEADC(32)   SETC  ' CC     '                                           01120000
&HEADC(33)   SETC  ' CC     '                                           01140000
&HEADC(34)   SETC  ' CC   CC'                                           01160000
&HEADC(35)   SETC  ' CC   CC'                                           01180000
&HEADC(36)   SETC  '  CCCCC '                                           01200000
&HEADC(37)   SETC  'D'                                                  01220000
&HEADC(38)   SETC  ' DDDDDD '                                           01240000
&HEADC(39)   SETC  ' DD   DD'                                           01260000
&HEADC(40)   SETC  ' DD   DD'                                           01280000
&HEADC(41)   SETC  ' DD   DD'                                           01300000
&HEADC(42)   SETC  ' DD   DD'                                           01320000
&HEADC(43)   SETC  ' DD   DD'                                           01340000
&HEADC(44)   SETC  ' DD   DD'                                           01360000
&HEADC(45)   SETC  ' DDDDDD '                                           01380000
&HEADC(46)   SETC  'E'                                                  01400000
&HEADC(47)   SETC  ' EEEEEE '                                           01420000
&HEADC(48)   SETC  ' EE     '                                           01440000
&HEADC(49)   SETC  ' EE     '                                           01460000
&HEADC(50)   SETC  ' EEEE   '                                           01480000
&HEADC(51)   SETC  ' EE     '                                           01500000
&HEADC(52)   SETC  ' EE     '                                           01520000
&HEADC(53)   SETC  ' EE     '                                           01540000
&HEADC(54)   SETC  ' EEEEEEE'                                           01560000
&HEADC(55)   SETC  'F'                                                  01580000
&HEADC(56)   SETC  ' FFFFFFF'                                           01600000
&HEADC(57)   SETC  ' FF     '                                           01620000
&HEADC(58)   SETC  ' FF     '                                           01640000
&HEADC(59)   SETC  ' FFFFF  '                                           01660000
&HEADC(60)   SETC  ' FF     '                                           01680000
&HEADC(61)   SETC  ' FF     '                                           01700000
&HEADC(62)   SETC  ' FF     '                                           01720000
&HEADC(63)   SETC  ' FF     '                                           01740000
&HEADC(64)   SETC  'G'                                                  01760000
&HEADC(65)   SETC  '  GGGGG '                                           01780000
&HEADC(66)   SETC  ' GG   GG'                                           01800000
&HEADC(67)   SETC  ' GG   GG'                                           01820000
&HEADC(68)   SETC  ' GG     '                                           01840000
&HEADC(69)   SETC  ' GG  GGG'                                           01860000
&HEADC(70)   SETC  ' GG   GG'                                           01880000
&HEADC(71)   SETC  ' GG   GG'                                           01900000
&HEADC(72)   SETC  '  GGGGG '                                           01920000
&HEADC(73)   SETC  'H'                                                  01940000
&HEADC(74)   SETC  ' HH   HH'                                           01960000
&HEADC(75)   SETC  ' HH   HH'                                           01980000
&HEADC(76)   SETC  ' HH   HH'                                           02000000
&HEADC(77)   SETC  ' HHHHHHH'                                           02020000
&HEADC(78)   SETC  ' HH   HH'                                           02040000
&HEADC(79)   SETC  ' HH   HH'                                           02060000
&HEADC(80)   SETC  ' HH   HH'                                           02080000
&HEADC(81)   SETC  ' HH   HH'                                           02100000
&HEADC(82)   SETC  'I'                                                  02120000
&HEADC(83)   SETC  '  IIII  '                                           02140000
&HEADC(84)   SETC  '   II   '                                           02160000
&HEADC(85)   SETC  '   II   '                                           02180000
&HEADC(86)   SETC  '   II   '                                           02200000
&HEADC(87)   SETC  '   II   '                                           02220000
&HEADC(88)   SETC  '   II   '                                           02240000
&HEADC(89)   SETC  '   II   '                                           02260000
&HEADC(90)   SETC  '  IIII  '                                           02280000
&HEADC(91)   SETC  'J'                                                  02300000
&HEADC(92)   SETC  '      JJ'                                           02320000
&HEADC(93)   SETC  '      JJ'                                           02340000
&HEADC(94)   SETC  '      JJ'                                           02360000
&HEADC(95)   SETC  '      JJ'                                           02380000
&HEADC(96)   SETC  '      JJ'                                           02400000
&HEADC(97)   SETC  ' JJ   JJ'                                           02420000
&HEADC(98)   SETC  ' JJ   JJ'                                           02440000
&HEADC(99)   SETC  '  JJJJJ '                                           02460000
&HEADC(100)  SETC  'K'                                                  02480000
&HEADC(101)  SETC  ' KK   KK'                                           02500000
&HEADC(102)  SETC  ' KK  KK '                                           02520000
&HEADC(103)  SETC  ' KK KK  '                                           02540000
&HEADC(104)  SETC  ' KKKK   '                                           02560000
&HEADC(105)  SETC  ' KKKK   '                                           02580000
&HEADC(106)  SETC  ' KK KK  '                                           02600000
&HEADC(107)  SETC  ' KK  KK '                                           02620000
&HEADC(108)  SETC  ' KK   KK'                                           02640000
&HEADC(109)  SETC  'L'                                                  02660000
&HEADC(110)  SETC  ' LL     '                                           02680000
&HEADC(111)  SETC  ' LL     '                                           02700000
&HEADC(112)  SETC  ' LL     '                                           02720000
&HEADC(113)  SETC  ' LL     '                                           02740000
&HEADC(114)  SETC  ' LL     '                                           02760000
&HEADC(115)  SETC  ' LL     '                                           02780000
&HEADC(116)  SETC  ' LL     '                                           02800000
&HEADC(117)  SETC  ' LLLLLLL'                                           02820000
&HEADC(118)  SETC  'M'                                                  02840000
&HEADC(119)  SETC  ' M     M'                                           02860000
&HEADC(120)  SETC  ' MM   MM'                                           02880000
&HEADC(121)  SETC  ' MMM MMM'                                           02900000
&HEADC(122)  SETC  ' MMMMMMM'                                           02920000
&HEADC(123)  SETC  ' MM M MM'                                           02940000
&HEADC(124)  SETC  ' MM   MM'                                           02960000
&HEADC(125)  SETC  ' MM   MM'                                           02980000
&HEADC(126)  SETC  ' MM   MM'                                           03000000
&HEADC(127)  SETC  'N'                                                  03020000
&HEADC(128)  SETC  ' NN   NN'                                           03040000
&HEADC(129)  SETC  ' NNN  NN'                                           03060000
&HEADC(130)  SETC  ' NNN  NN'                                           03080000
&HEADC(131)  SETC  ' NNNN NN'                                           03100000
&HEADC(132)  SETC  ' NN NNNN'                                           03120000
&HEADC(133)  SETC  ' NN  NNN'                                           03140000
&HEADC(134)  SETC  ' NN  NNN'                                           03160000
&HEADC(135)  SETC  ' NN   NN'                                           03180000
&HEADC(136)  SETC  'O'                                                  03200000
&HEADC(137)  SETC  '  OOOOO '                                           03220000
&HEADC(138)  SETC  ' OO   OO'                                           03240000
&HEADC(139)  SETC  ' OO   OO'                                           03260000
&HEADC(140)  SETC  ' OO   OO'                                           03280000
&HEADC(141)  SETC  ' OO   OO'                                           03300000
&HEADC(142)  SETC  ' OO   OO'                                           03320000
&HEADC(143)  SETC  ' OO   OO'                                           03340000
&HEADC(144)  SETC  '  OOOOO '                                           03360000
&HEADC(145)  SETC  'P'                                                  03380000
&HEADC(146)  SETC  ' PPPPPP '                                           03400000
&HEADC(147)  SETC  ' PP   PP'                                           03420000
&HEADC(148)  SETC  ' PP   PP'                                           03440000
&HEADC(149)  SETC  ' PP   PP'                                           03460000
&HEADC(150)  SETC  ' PPPPPP '                                           03480000
&HEADC(151)  SETC  ' PP     '                                           03500000
&HEADC(152)  SETC  ' PP     '                                           03520000
&HEADC(153)  SETC  ' PP     '                                           03540000
&HEADC(154)  SETC  'Q'                                                  03560000
&HEADC(155)  SETC  '  QQQQQ '                                           03580000
&HEADC(156)  SETC  ' QQ   QQ'                                           03600000
&HEADC(157)  SETC  ' QQ   QQ'                                           03620000
&HEADC(158)  SETC  ' QQ   QQ'                                           03640000
&HEADC(159)  SETC  ' QQ Q QQ'                                           03660000
&HEADC(160)  SETC  ' QQ  QQQ'                                           03680000
&HEADC(161)  SETC  ' QQ   QQ'                                           03700000
&HEADC(162)  SETC  '  QQQQQQ'                                           03720000
&HEADC(163)  SETC  'R'                                                  03740000
&HEADC(164)  SETC  ' RRRRRR '                                           03760000
&HEADC(165)  SETC  ' RR   RR'                                           03780000
&HEADC(166)  SETC  ' RR   RR'                                           03800000
&HEADC(167)  SETC  ' RR   RR'                                           03820000
&HEADC(168)  SETC  ' RRRRRR '                                           03840000
&HEADC(169)  SETC  ' RR RR  '                                           03860000
&HEADC(170)  SETC  ' RR  RR '                                           03880000
&HEADC(171)  SETC  ' RR   RR'                                           03900000
&HEADC(172)  SETC  'S'                                                  03920000
&HEADC(173)  SETC  '  SSSSS '                                           03940000
&HEADC(174)  SETC  ' SS   SS'                                           03960000
&HEADC(175)  SETC  ' SS     '                                           03980000
&HEADC(176)  SETC  '  SSSSS '                                           04000000
&HEADC(177)  SETC  '      SS'                                           04020000
&HEADC(178)  SETC  ' SS   SS'                                           04040000
&HEADC(179)  SETC  ' SS   SS'                                           04060000
&HEADC(180)  SETC  '  SSSSS '                                           04080000
&HEADC(181)  SETC  'T'                                                  04100000
&HEADC(182)  SETC  'TTTTTTTT'                                           04120000
&HEADC(183)  SETC  '   TT   '                                           04140000
&HEADC(184)  SETC  '   TT   '                                           04160000
&HEADC(185)  SETC  '   TT   '                                           04180000
&HEADC(186)  SETC  '   TT   '                                           04200000
&HEADC(187)  SETC  '   TT   '                                           04220000
&HEADC(188)  SETC  '   TT   '                                           04240000
&HEADC(189)  SETC  '   TT   '                                           04260000
&HEADC(190)  SETC  'U'                                                  04280000
&HEADC(191)  SETC  ' UU   UU'                                           04300000
&HEADC(192)  SETC  ' UU   UU'                                           04320000
&HEADC(193)  SETC  ' UU   UU'                                           04340000
&HEADC(194)  SETC  ' UU   UU'                                           04360000
&HEADC(195)  SETC  ' UU   UU'                                           04380000
&HEADC(196)  SETC  ' UU   UU'                                           04400000
&HEADC(197)  SETC  ' UU   UU'                                           04420000
&HEADC(198)  SETC  '  UUUUU '                                           04440000
&HEADC(199)  SETC  'V'                                                  04460000
&HEADC(200)  SETC  ' VV   VV'                                           04480000
&HEADC(201)  SETC  ' VV   VV'                                           04500000
&HEADC(202)  SETC  ' VV   VV'                                           04520000
&HEADC(203)  SETC  ' VV   VV'                                           04540000
&HEADC(204)  SETC  ' VV   VV'                                           04560000
&HEADC(205)  SETC  '  VV VV '                                           04580000
&HEADC(206)  SETC  '   VVV  '                                           04600000
&HEADC(207)  SETC  '    V   '                                           04620000
&HEADC(208)  SETC  'W'                                                  04640000
&HEADC(209)  SETC  ' WW   WW'                                           04660000
&HEADC(210)  SETC  ' WW   WW'                                           04680000
&HEADC(211)  SETC  ' WW   WW'                                           04700000
&HEADC(212)  SETC  ' WW   WW'                                           04720000
&HEADC(213)  SETC  ' WW W WW'                                           04740000
&HEADC(214)  SETC  ' WWWWWWW'                                           04760000
&HEADC(215)  SETC  ' WWW WWW'                                           04780000
&HEADC(216)  SETC  '  W   W '                                           04800000
&HEADC(217)  SETC  'X'                                                  04820000
&HEADC(218)  SETC  ' XX   XX'                                           04840000
&HEADC(219)  SETC  ' XX   XX'                                           04860000
&HEADC(220)  SETC  '  XX XX '                                           04880000
&HEADC(221)  SETC  '   XXX  '                                           04900000
&HEADC(222)  SETC  '   XXX  '                                           04920000
&HEADC(223)  SETC  '  XX XX '                                           04940000
&HEADC(224)  SETC  ' XX   XX'                                           04960000
&HEADC(225)  SETC  ' XX   XX'                                           04980000
&HEADC(226)  SETC  'Y'                                                  05000000
&HEADC(227)  SETC  ' YY   YY'                                           05020000
&HEADC(228)  SETC  ' YY   YY'                                           05040000
&HEADC(229)  SETC  ' YY   YY'                                           05060000
&HEADC(230)  SETC  '  YY YY '                                           05080000
&HEADC(231)  SETC  '   YYY  '                                           05100000
&HEADC(232)  SETC  '   YY   '                                           05120000
&HEADC(233)  SETC  '   YY   '                                           05140000
&HEADC(234)  SETC  '   YY   '                                           05160000
&HEADC(235)  SETC  'Z'                                                  05180000
&HEADC(236)  SETC  ' ZZZZZZZ'                                           05200000
&HEADC(237)  SETC  '      ZZ'                                           05220000
&HEADC(238)  SETC  '     ZZ '                                           05240000
&HEADC(239)  SETC  '    ZZ  '                                           05260000
&HEADC(240)  SETC  '   ZZ   '                                           05280000
&HEADC(241)  SETC  '  ZZ    '                                           05300000
&HEADC(242)  SETC  ' ZZ     '                                           05320000
&HEADC(243)  SETC  ' ZZZZZZZ'                                           05340000
&HEADC(244)  SETC  '1'                                                  05360000
&HEADC(245)  SETC  '    1   '                                           05380000
&HEADC(246)  SETC  '   11   '                                           05400000
&HEADC(247)  SETC  '    1   '                                           05420000
&HEADC(248)  SETC  '    1   '                                           05440000
&HEADC(249)  SETC  '    1   '                                           05460000
&HEADC(250)  SETC  '    1   '                                           05480000
&HEADC(251)  SETC  '    1   '                                           05500000
&HEADC(252)  SETC  '   111  '                                           05520000
&HEADC(253)  SETC  '2'                                                  05540000
&HEADC(254)  SETC  '   222  '                                           05560000
&HEADC(255)  SETC  '  2   2 '                                           05580000
&HEADC(256)  SETC  '      2 '                                           05600000
&HEADC(257)  SETC  '      2 '                                           05620000
&HEADC(258)  SETC  '   222  '                                           05640000
&HEADC(259)  SETC  '  2     '                                           05660000
&HEADC(260)  SETC  '  2     '                                           05680000
&HEADC(261)  SETC  '  22222 '                                           05700000
&HEADC(262)  SETC  '3'                                                  05720000
&HEADC(263)  SETC  '   333  '                                           05740000
&HEADC(264)  SETC  '  3   3 '                                           05760000
&HEADC(265)  SETC  '      3 '                                           05780000
&HEADC(266)  SETC  '    33  '                                           05800000
&HEADC(267)  SETC  '      3 '                                           05820000
&HEADC(268)  SETC  '  3   3 '                                           05840000
&HEADC(269)  SETC  '  3   3 '                                           05860000
&HEADC(270)  SETC  '   333  '                                           05880000
&HEADC(271)  SETC  '4'                                                  05900000
&HEADC(272)  SETC  '     4  '                                           05920000
&HEADC(273)  SETC  '    44  '                                           05940000
&HEADC(274)  SETC  '   4 4  '                                           05960000
&HEADC(275)  SETC  '  4  4  '                                           05980000
&HEADC(276)  SETC  ' 444444 '                                           06000000
&HEADC(277)  SETC  '     4  '                                           06020000
&HEADC(278)  SETC  '     4  '                                           06040000
&HEADC(279)  SETC  '     4  '                                           06060000
&HEADC(280)  SETC  '5'                                                  06080000
&HEADC(281)  SETC  '  55555 '                                           06100000
&HEADC(282)  SETC  '  5     '                                           06120000
&HEADC(283)  SETC  '  5     '                                           06140000
&HEADC(284)  SETC  '  5555  '                                           06160000
&HEADC(285)  SETC  '      5 '                                           06180000
&HEADC(286)  SETC  '  5   5 '                                           06200000
&HEADC(287)  SETC  '  5   5 '                                           06220000
&HEADC(288)  SETC  '   555  '                                           06240000
&HEADC(289)  SETC  '6'                                                  06260000
&HEADC(290)  SETC  '   666  '                                           06280000
&HEADC(291)  SETC  '  6   6 '                                           06300000
&HEADC(292)  SETC  '  6     '                                           06320000
&HEADC(293)  SETC  '  6666  '                                           06340000
&HEADC(294)  SETC  '  6   6 '                                           06360000
&HEADC(295)  SETC  '  6   6 '                                           06380000
&HEADC(296)  SETC  '  6   6 '                                           06400000
&HEADC(297)  SETC  '   666  '                                           06420000
&HEADC(298)  SETC  '7'                                                  06440000
&HEADC(299)  SETC  '  77777 '                                           06460000
&HEADC(300)  SETC  '      7 '                                           06480000
&HEADC(301)  SETC  '      7 '                                           06500000
&HEADC(302)  SETC  '     7  '                                           06520000
&HEADC(303)  SETC  '    7   '                                           06540000
&HEADC(304)  SETC  '   7    '                                           06560000
&HEADC(305)  SETC  '   7    '                                           06580000
&HEADC(306)  SETC  '   7    '                                           06600000
&HEADC(307)  SETC  '8'                                                  06620000
&HEADC(308)  SETC  '   888  '                                           06640000
&HEADC(309)  SETC  '  8   8 '                                           06660000
&HEADC(310)  SETC  '  8   8 '                                           06680000
&HEADC(311)  SETC  '   888  '                                           06700000
&HEADC(312)  SETC  '  8   8 '                                           06720000
&HEADC(313)  SETC  '  8   8 '                                           06740000
&HEADC(314)  SETC  '  8   8 '                                           06760000
&HEADC(315)  SETC  '   888  '                                           06780000
&HEADC(316)  SETC  '9'                                                  06800000
&HEADC(317)  SETC  '   999  '                                           06820000
&HEADC(318)  SETC  '  9   9 '                                           06840000
&HEADC(319)  SETC  '  9   9 '                                           06860000
&HEADC(320)  SETC  '  9   9 '                                           06880000
&HEADC(321)  SETC  '   9999 '                                           06900000
&HEADC(322)  SETC  '      9 '                                           06920000
&HEADC(323)  SETC  '  9   9 '                                           06940000
&HEADC(324)  SETC  '   999  '                                           06960000
&HEADC(325)  SETC  '0'                                                  06980000
&HEADC(326)  SETC  '   000  '                                           07000000
&HEADC(327)  SETC  '  0   0 '                                           07020000
&HEADC(328)  SETC  '  0   0 '                                           07040000
&HEADC(329)  SETC  '  0   0 '                                           07060000
&HEADC(330)  SETC  '  0   0 '                                           07080000
&HEADC(331)  SETC  '  0   0 '                                           07100000
&HEADC(332)  SETC  '  0   0 '                                           07120000
&HEADC(333)  SETC  '   000  '                                           07140000
&HEADC(334)  SETC  '$'                                                  07160000
&HEADC(335)  SETC  '    $   '                                           07180000
&HEADC(336)  SETC  '  $$$$$ '                                           07200000
&HEADC(337)  SETC  ' $$ $ $$'                                           07220000
&HEADC(338)  SETC  ' $$ $   '                                           07240000
&HEADC(339)  SETC  '  $$$$$ '                                           07260000
&HEADC(340)  SETC  '    $ $$'                                           07280000
&HEADC(341)  SETC  ' $$ $ $$'                                           07300000
&HEADC(342)  SETC  '  $$$$$ '                                           07320000
&HEADC(343)  SETC  '#'                                                  07340000
&HEADC(344)  SETC  '  ## ## '                                           07360000
&HEADC(345)  SETC  '  ## ## '                                           07380000
&HEADC(346)  SETC  ' #######'                                           07400000
&HEADC(347)  SETC  '  ## ## '                                           07420000
&HEADC(348)  SETC  '  ## ## '                                           07440000
&HEADC(349)  SETC  ' #######'                                           07460000
&HEADC(350)  SETC  '  ## ## '                                           07480000
&HEADC(351)  SETC  '  ## ## '                                           07500000
&HEADC(352)  SETC  '@'                                                  07520000
&HEADC(353)  SETC  '  @@@@@ '                                           07540000
&HEADC(354)  SETC  ' @     @'                                           07560000
&HEADC(355)  SETC  ' @  @@ @'                                           07580000
&HEADC(356)  SETC  ' @ @ @ @'                                           07600000
&HEADC(357)  SETC  '  @  @ @'                                           07620000
&HEADC(358)  SETC  ' @   @ @'                                           07640000
&HEADC(359)  SETC  ' @   @ @'                                           07660000
&HEADC(360)  SETC  '  @@@ @ '                                           07680000
&HEADC(361)  SETC  ','                                                  07700000
&HEADC(362)  SETC  '        '                                           07720000
&HEADC(363)  SETC  '        '                                           07740000
&HEADC(364)  SETC  '        '                                           07760000
&HEADC(365)  SETC  '        '                                           07780000
&HEADC(366)  SETC  '   ,,   '                                           07800000
&HEADC(367)  SETC  '   ,,   '                                           07820000
&HEADC(368)  SETC  '    ,   '                                           07840000
&HEADC(369)  SETC  '   ,    '                                           07860000
&HEADC(370)  SETC  '.'                                                  07880000
&HEADC(371)  SETC  '        '                                           07900000
&HEADC(372)  SETC  '        '                                           07920000
&HEADC(373)  SETC  '        '                                           07940000
&HEADC(374)  SETC  '        '                                           07960000
&HEADC(375)  SETC  '        '                                           07980000
&HEADC(376)  SETC  '   ..   '                                           08000000
&HEADC(377)  SETC  '   ..   '                                           08020000
&HEADC(378)  SETC  '        '                                           08040000
&HEADC(379)  SETC  '('                                                  08060000
&HEADC(380)  SETC  '    (   '                                           08080000
&HEADC(381)  SETC  '   (    '                                           08100000
&HEADC(382)  SETC  '  (     '                                           08120000
&HEADC(383)  SETC  '  (     '                                           08140000
&HEADC(384)  SETC  '  (     '                                           08160000
&HEADC(385)  SETC  '  (     '                                           08180000
&HEADC(386)  SETC  '   (    '                                           08200000
&HEADC(387)  SETC  '    (   '                                           08220000
&HEADC(388)  SETC  ')'                                                  08240000
&HEADC(389)  SETC  '   )    '                                           08260000
&HEADC(390)  SETC  '    )   '                                           08280000
&HEADC(391)  SETC  '     )  '                                           08300000
&HEADC(392)  SETC  '     )  '                                           08320000
&HEADC(393)  SETC  '     )  '                                           08340000
&HEADC(394)  SETC  '     )  '                                           08360000
&HEADC(395)  SETC  '    )   '                                           08380000
&HEADC(396)  SETC  '   )    '                                           08400000
&HEADC(397)  SETC  '+'                                                  08420000
&HEADC(398)  SETC  '        '                                           08440000
&HEADC(399)  SETC  '    +   '                                           08460000
&HEADC(400)  SETC  '    +   '                                           08480000
&HEADC(401)  SETC  '    +   '                                           08500000
&HEADC(402)  SETC  ' +++++++'                                           08520000
&HEADC(403)  SETC  '    +   '                                           08540000
&HEADC(404)  SETC  '    +   '                                           08560000
&HEADC(405)  SETC  '    +   '                                           08580000
&HEADC(406)  SETC  '/'                                                  08600000
&HEADC(407)  SETC  '       /'                                           08620000
&HEADC(408)  SETC  '      / '                                           08640000
&HEADC(409)  SETC  '     /  '                                           08660000
&HEADC(410)  SETC  '    /   '                                           08680000
&HEADC(411)  SETC  '   /    '                                           08700000
&HEADC(412)  SETC  '  /     '                                           08720000
&HEADC(413)  SETC  ' /      '                                           08740000
&HEADC(414)  SETC  '/       '                                           08760000
&HEADC(415)  SETC  '"'                                                  08780000
&HEADC(416)  SETC  '   ""   '                                           08800000
&HEADC(417)  SETC  '   ""   '                                           08820000
&HEADC(418)  SETC  '    "   '                                           08840000
&HEADC(419)  SETC  '   "    '                                           08860000
&HEADC(420)  SETC  '        '                                           08880000
&HEADC(421)  SETC  '        '                                           08900000
&HEADC(422)  SETC  '        '                                           08920000
&HEADC(423)  SETC  '        '                                           08940000
&HEADC(424)  SETC  '-'                                                  08960000
&HEADC(425)  SETC  '        '                                           08980000
&HEADC(426)  SETC  '        '                                           09000000
&HEADC(427)  SETC  '        '                                           09020000
&HEADC(428)  SETC  '        '                                           09040000
&HEADC(429)  SETC  ' -------'                                           09060000
&HEADC(430)  SETC  '        '                                           09080000
&HEADC(431)  SETC  '        '                                           09100000
&HEADC(432)  SETC  '        '                                           09120000
&HEADC(433)  SETC  '*'                                                  09140000
&HEADC(434)  SETC  '        '                                           09160000
&HEADC(435)  SETC  '  *   * '                                           09180000
&HEADC(436)  SETC  '   * *  '                                           09200000
&HEADC(437)  SETC  ' *******'                                           09220000
&HEADC(438)  SETC  '   * *  '                                           09240000
&HEADC(439)  SETC  '  *   * '                                           09260000
&HEADC(440)  SETC  '        '                                           09280000
&HEADC(441)  SETC  '        '                                           09300000
&HEADC(442)  SETC  'END'           MARKS END OF THE CHARACTER LIST      09320000
.PROC    AIF   ('&PRINT' EQ 'NOGEN' OR '&PRINT' EQ 'NODATA').MEND       09340000
.*                                                                      09360000
.*                                                                      09380000
         AIF   (K'&TITLE LE 0).NTITL                                    09400000
.*                                                                      09420000
         AIF   ('&TITLE' NE 'EJECT').NEJEC                              09440000
         EJECT                                                          09460000
         AGO   .NTITL                                                   09480000
.*                                                                      09500000
.NEJEC   ANOP                                                           09520000
&TITLE(1) TITLE &TITLE(2)                                               09540000
.*                                                                      09560000
.*                                                                      09580000
.NTITL   ANOP                                                           09600000
.*                                                                      09620000
.*                                                                      09640000
&K       SETA  K'&STRING                                                09660000
         AIF   ((&K EQ 0) OR (&K GT 64)).DONE                           09680000
.*                                                                      09700000
.*                                                                      09720000
         AIF   ('&BLOCK' EQ 'NO').NBLK1                                 09740000
 MNOTE   '**************************************************************09760000
               **********'                                              09780000
&B       SETC  '*'                                                      09800000
.NBLK1   ANOP  ,                                                        09820000
.*                                                                      09840000
.*                                                                      09860000
.*                                                                      09880000
&M       SETA  1                                                        09900000
.COPY2   ANOP  ,                                                        09920000
&STR(&M) SETC  '&STRING'(&M,1)                                          09940000
&M       SETA  &M+1                                                     09960000
         AIF   (&M LE &K).COPY2                                         09980000
.*                                                                      10000000
&J       SETA  0                                                        10020000
&M       SETA  0                                                        10040000
.*                                                                      10060000
.*                                                                      10080000
.EDIT    AIF   (&M EQ &K).AGIN                                          10100000
&M       SETA  &M+1                                                     10120000
&I       SETA  &M                                                       10140000
         AIF   ('&STR(&M)' NE '''').EDIT                                10160000
.*                                                                      10180000
         AIF   (&J GT 0).QTCK                                           10200000
.*                                                                      10220000
&J       SETA  1                                                        10240000
         AGO   .COMP                                                    10260000
.*                                                                      10280000
.*                                                                      10300000
.QTCK    AIF   ('&STR(&M+1)' NE '''').COMP                              10320000
.*                                                                      10340000
&STR(&M) SETC  '"'                                                      10360000
&J       SETA  0                                                        10380000
&M       SETA  &M+1                                                     10400000
&I       SETA  &M                                                       10420000
.*                                                                      10440000
.*                                                                      10460000
.COMP    ANOP                                                           10480000
&STR(&I) SETC  '&STR(&I+1)'                                             10500000
&I       SETA  &I+1                                                     10520000
         AIF   (&I LT &K).COMP                                          10540000
.*                                                                      10560000
&STR(&K) SETC  ' '                                                      10580000
&K       SETA  &K-1                                                     10600000
&M       SETA  &M-1                                                     10620000
         AGO   .EDIT                                                    10640000
.*                                                                      10660000
.*                                                                      10680000
.AGIN    ANOP                                                           10700000
&I       SETA  1                                                        10720000
&L       SETA  &K-&N                                                    10740000
         AIF   (&L LE 0).ENDOFF                                         10760000
.*                                                                      10780000
         AIF   (&L LE 8).CK4                                            10800000
.*                                                                      10820000
&L       SETA  8                                                        10840000
.*                                                                      10860000
.*                                                                      10880000
.CK4     ANOP                                                           10900000
&J       SETA  (8-&L)/2*8                                               10920000
.*                                                                      10940000
.*                                                                      10960000
.FILT    AIF   (&I GT &J).SETL                                          10980000
.*                                                                      11000000
&F(&I)   SETC  '        '                                               11020000
&F(&I+1) SETC  '        '                                               11040000
&F(&I+2) SETC  '        '                                               11060000
&F(&I+3) SETC  '        '                                               11080000
&F(&I+4) SETC  '        '                                               11100000
&F(&I+5) SETC  '        '                                               11120000
&F(&I+6) SETC  '        '                                               11140000
&F(&I+7) SETC  '        '                                               11160000
&I       SETA  &I+8                                                     11180000
         AGO   .FILT                                                    11200000
.*                                                                      11220000
.*                                                                      11240000
.SETL    ANOP                                                           11260000
&L       SETA  &L+&N                                                    11280000
.*                                                                      11300000
.*                                                                      11320000
.LOOP    AIF   (&N EQ &L).FINI                                          11340000
.*                                                                      11360000
&N       SETA  &N+1                                                     11380000
&J       SETA  1                                                        11400000
&W       SETC  '&STR(&N)'                                               11420000
.*                                                                      11440000
.*                                                                      11460000
.MTCH    AIF   ('&W' EQ '&HEADC(&J)').GO                                11480000
.*                                                                      11500000
&J       SETA  &J+9                                                     11520000
         AIF   ('&HEADC(&J)' NE 'END').MTCH                             11540000
&J       SETA  &J-9                                                     11560000
.*                                                                      11580000
.*                                                                      11600000
.GO      ANOP                                                           11620000
.*                                                                      11640000
&F(&I)   SETC  '&HEADC(&J+1)'                                           11660000
&F(&I+1) SETC  '&HEADC(&J+2)'                                           11680000
&F(&I+2) SETC  '&HEADC(&J+3)'                                           11700000
&F(&I+3) SETC  '&HEADC(&J+4)'                                           11720000
&F(&I+4) SETC  '&HEADC(&J+5)'                                           11740000
&F(&I+5) SETC  '&HEADC(&J+6)'                                           11760000
&F(&I+6) SETC  '&HEADC(&J+7)'                                           11780000
&F(&I+7) SETC  '&HEADC(&J+8)'                                           11800000
&I       SETA  &I+8                                                     11820000
         AGO   .LOOP                                                    11840000
.*                                                                      11860000
.*                                                                      11880000
.FINI    AIF   (&I GT 64).DOIT                                          11900000
.*                                                                      11920000
&F(&I)   SETC  '        '                                               11940000
&F(&I+1) SETC  '        '                                               11960000
&F(&I+2) SETC  '        '                                               11980000
&F(&I+3) SETC  '        '                                               12000000
&F(&I+4) SETC  '        '                                               12020000
&F(&I+5) SETC  '        '                                               12040000
&F(&I+6) SETC  '        '                                               12060000
&F(&I+7) SETC  '        '                                               12080000
&I       SETA  &I+8                                                     12100000
         AGO   .FINI                                                    12120000
.*                                                                      12140000
.*                                                                      12160000
.DOIT    AIF   ('&BLOCK' EQ 'NO').SPACE                                 12180000
 MNOTE   '*                                                            *12200000
                        *'                                              12220000
 MNOTE   '*                                                            *12240000
                        *'                                              12260000
         AGO   .DOIT2                                                   12280000
.SPACE   ANOP   ,                                                       12300000
         SPACE 2                                                        12320000
.DOIT2   ANOP  ,                                                        12340000
 MNOTE   '&B  &F(1)&F(9)&F(17)&F(25)&F(33)&F(41)&F(49)&F(57)   &B'      12360000
 MNOTE   '&B  &F(2)&F(10)&F(18)&F(26)&F(34)&F(42)&F(50)&F(58)   &B'     12380000
 MNOTE   '&B  &F(3)&F(11)&F(19)&F(27)&F(35)&F(43)&F(51)&F(59)   &B'     12400000
 MNOTE   '&B  &F(4)&F(12)&F(20)&F(28)&F(36)&F(44)&F(52)&F(60)   &B'     12420000
 MNOTE   '&B  &F(5)&F(13)&F(21)&F(29)&F(37)&F(45)&F(53)&F(61)   &B'     12440000
 MNOTE   '&B  &F(6)&F(14)&F(22)&F(30)&F(38)&F(46)&F(54)&F(62)   &B'     12460000
 MNOTE   '&B  &F(7)&F(15)&F(23)&F(31)&F(39)&F(47)&F(55)&F(63)   &B'     12480000
 MNOTE   '&B  &F(8)&F(16)&F(24)&F(32)&F(40)&F(48)&F(56)&F(64)   &B'     12500000
         AGO   .AGIN                                                    12520000
.*                                                                      12540000
.*                                                                      12560000
.ENDOFF  AIF   ('&BLOCK' EQ 'NO').DONE                                  12580000
 MNOTE   '*                                                            *12600000
                        *'                                              12620000
 MNOTE   '*                                                            *12640000
                        *'                                              12660000
 MNOTE   '**************************************************************12680000
               **********'                                              12700000
.*                                                                      12720000
.*                                                                      12740000
.DONE    ANOP                                                           12760000
         SPACE 3                                                        12780000
.MEND    MEND                                                           12800000
./ ADD NAME=$TCKCONV
         MACRO ,                                                        00010000
&NM      $TCKCONV &STCKVAL=,&CONVVAL=,&TIMETYP=,&DATETYP=,&MF=S,&ZONE=G*00020000
               MT                                                       00030000
.********************************************************************** 00040000
.*   THIS MACRO INVOKES LOCAL SUBROUTINE SUBSTCK TO PRODUCE OUTPUT    * 00050000
.*   COMPATIBLE WITH THE STCKCONV MACRO IN ESA AND LATER SYSTEMS.     * 00060000
.*   FOR USE UNDER THE XF ASSEMBLER, 8-BYTE KEYWORDS WERE SHORTENED   * 00070000
.*   TO 7 BYTES. THE ZONE=GMT|LT OPTION WAS ADDED AS IN TIME MACRO.   * 00080000
.*   STCKVAL=0 REQUESTS CURRENT TOD CLOCK VALUE.                      * 00090000
.********************************************************************** 00100000
         GBLC  &MACPLAB                                                 00110000
         LCLB  &TB(8),&DB(9)  TIME & DATE FLAG BITS                     00120000
         LCLC  &TV,&DV,&ERP                                             00130000
&TB(8)   SETB  ('&TIMETYP' EQ 'BIN' OR '&TIMETYP' EQ 'MIC')             00140000
&TB(7)   SETB  ('&TIMETYP' EQ 'DEC' OR '&TIMETYP' EQ 'MIC')             00150000
&TB(3)   SETB  1             STCKCONV FLAG                              00160000
&DB(8)   SETB  ('&DATETYP' EQ 'MMDDYYYY' OR '&DATETYP' EQ 'YYYYMMDD')   00170000
&DB(7)   SETB  ('&DATETYP' EQ 'DDMMYYYY' OR '&DATETYP' EQ 'YYYYMMDD')   00180000
&DB(2)   SETB  ('&ZONE' EQ 'LT')                                        00190000
&DB(9)   SETB  ('&DATETYP' EQ 'YYYYDDD')                                00200000
         AIF   ('&MF(1)' EQ 'L').LIST                                   00210000
&MACPLAB SETC  '&NM'         DEFERRED INSTRUCTION LABEL                 00220000
&ERP     SETC  'STCKVAL'                                                00230000
         AIF   ('&STCKVAL' EQ '').MISSING                               00240000
&ERP     SETC  'CONVVAL'                                                00250000
         AIF   ('&CONVVAL' EQ '').MISSING                               00260000
&ERP     SETC  'TIMETYP'                                                00270000
         AIF   ('&TIMETYP' EQ '').MISSING                               00280000
&ERP     SETC  'DATETYP'                                                00290000
         AIF   ('&DATETYP' EQ '').MISSING                               00300000
         AIF   ('&MF(1)' EQ 'S').INLINE                                 00310000
         AIF   ('&MF(1)' EQ 'E').EXEC                                   00320000
&ERP     SETC  'MF'                                                     00330000
.MISSING MNOTE 8,'KEYWORD &ERP MISSING OR INVALID'                      00340000
         MEXIT ,                                                        00350000
.*                                                                      00360000
.EXEC    MACPARM R1,&MF(2)                                              00370000
         AIF   ('&STCKVAL' NE '0').EXECU                                00380000
         MACPARM R14,4(,R1)  AVOID ALIGNMENT ERROR ASM MSG              00390000
         STCK  0(R14)        GET CURRENT TIME                           00400000
         AGO   .EXECC                                                   00410000
.EXECU   MACPARM R14,&STCKVAL     GET TOD POINTER                       00420000
         MVC   4(8,R1),0(R14)     COPY USER'S VALUE                     00430000
.EXECC   XC    12(16,R1),12(R1)   CLEAR RETURN VALUE                    00440000
&TV      SETC  '32*&TB(3)+2*&TB(7)+&TB(8)'                              00450000
&DV      SETC  '64*&DB(2)+2*&DB(7)+&DB(8)'                              00460000
         AIF   ('&DATETYP' EQ '').EXECND                                00470000
         MVI   2(R1),&DV     SET DATE TYPE FLAGS                        00480000
.EXECND  AIF   ('&TIMETYP' EQ '').EXECNT                                00490000
         MVI   3(R1),&TV     SET TIME TYPE FLAGS                        00500000
.EXECNT  AGO   .COMRET                                                  00510000
.*                                                                      00520000
.INLINE  CNOP  0,4                                                      00530000
         MACPARM R1,*+4+28,OP=BAL                                       00540000
         DC    7A(0)                                                    00550000
         XC    12(16,R1),12(R1)   CLEAR RETURN VALUE                    00560000
         AIF   ('&STCKVAL' NE '0').LINEU                                00570000
         MACPARM R14,4(,R1)  AVOID ALIGNMENT ERROR ASM MSG              00580000
         STCK  0(R14)        GET CURRENT TIME                           00590000
         AGO   .LINEC                                                   00600000
.LINEU   MACPARM R14,&STCKVAL     GET TOD POINTER                       00610000
         MVC   4(8,R1),0(R14)     COPY USER'S VALUE                     00620000
.LINEC   ANOP  ,                                                        00630000
&TV      SETC  '32*&TB(3)+2*&TB(7)+&TB(8)'                              00640000
&DV      SETC  '64*&DB(2)+2*&DB(7)+&DB(8)'                              00650000
         MVI   2(R1),&DV     SET DATE TYPE FLAGS                        00660000
         MVI   3(R1),&TV     SET TIME TYPE FLAGS                        00670000
.COMRET  L     R15,=V(SUBSTCK)  GET SUBROUTINE ADDRESS                  00680000
         BALR  R14,R15       CALL SUBROUTINE                            00690000
         MACPARM R14,&CONVVAL  GET OUTPUT ADDRESS                       00700000
         MVC   0(16,R14),12(R1)  RETURN RESULT                          00710000
         MEXIT ,                                                        00720000
.*                                                                      00730000
.LIST    ANOP  ,                                                        00740000
&TV      SETC  '32*&TB(3)+2*&TB(7)+&TB(8)'                              00750000
&DV      SETC  '64*&DB(2)+2*&DB(7)+&DB(8)'                              00760000
&NM      DC    0A(0),AL1(0,0,&TV,&DV),2A(0),2XL8'0'                     00770000
.MEND    MEND  ,                                                        00780000
./ ADD NAME=A64D
         MACRO ,                                                        00010000
&NM      A64D  &CTR,&INC,&WK=R14                                        00020000
         GBLC  &MACPLAB                                                 00030000
.*  ADD A 64-BIT VALUE TO A 64-BIT VALUE.                               00040000
.*  WK MUST BE AN EVEN REGISTER, AND NOT THE '(INC)' PAIR               00050000
.*  CTR MAY BE A DOUBLE-WORD STORAGE ADDRESS, OR AN EVEN REGISTER       00060000
.*  INC MAY BE A DOUBLE-WORD STORAGE ADDRESS, OR AN EVEN REGISTER       00070000
.*                                                   UPD 2013/05/01 GYP 00080000
         LCLA  &K                                                       00090000
         LCLB  &TOR,&FRO     ON IF REGISTER                             00100000
         LCLC  &N,&RE,&RO,&FE,&FO                                       00110000
&N       SETC  'ZZA'.'&SYSNDX'                                          00120000
&MACPLAB SETC  '&NM'                                                    00130000
         AIF   ('&CTR(1)' EQ '&WK').REGROUT                             00140000
&K       SETA  K'&CTR                                                   00150000
         AIF   (&K LT 3).NOTROUT                                        00160000
         AIF   ('&CTR'(1,1) NE '(').NOTROUT  POSSIBLE REGISTER SPEC?    00170000
         AIF   ('&CTR'(2,1) EQ '(').NOTROUT  EXPRESSION?                00180000
         AIF   ('&CTR'(&K,1) NE ')').NOTROUT  POSSIBLE REGISTER SPEC?   00190000
         AIF   ('&CTR'(&K-1,1) EQ ')').NOTROUT  EXPRESSION?             00200000
.REGROUT ANOP  ,                                                        00210000
&TOR     SETB  1                                                        00220000
&RE      SETC  '(&CTR(1))'                                              00230000
&RO      SETC  '(1+&CTR(1))'                                            00240000
.NOTROUT  ANOP  ,                                                       00250000
&RE      SETC  '&WK'                                                    00260000
&RO      SETC  '1+&WK'                                                  00270000
.LOOKINC ANOP  ,                                                        00280000
&K       SETA  K'&INC                                                   00290000
         AIF   (&K LT 3).NOTRINC                                        00300000
         AIF   ('&INC'(1,1) NE '(').NOTRINC  POSSIBLE REGISTER SPEC?    00310000
         AIF   ('&INC'(2,1) EQ '(').NOTRINC  EXPRESSION?                00320000
         AIF   ('&INC'(&K,1) NE ')').NOTRINC  POSSIBLE REGISTER SPEC?   00330000
         AIF   ('&INC'(&K-1,1) EQ ')').NOTRINC  EXPRESSION?             00340000
.REGRINC ANOP  ,                                                        00350000
&FRO     SETB  1                                                        00360000
&FE      SETC  '(&INC(1))'                                              00370000
&FO      SETC  '(1+&INC(1))'                                            00380000
         AGO   .PROCESS                                                 00390000
.NOTRINC ANOP  ,                                                        00400000
&FE      SETC  '&INC'                                                   00410000
&FO      SETC  '4+&INC'                                                 00420000
.PROCESS AIF   (&TOR).NOLM   OUTPUT IN REGS - SKIP LOAD                 00430000
         MACPARM &RE,&RO,&CTR,OP=LM,MODE=THREE                          00440000
.NOLM    MACPARM &RO,&FO,OP=AL,OPR=ALR                                  00450000
         MACPARM 12,&N.N,OP=BC   NO CARRY                               00460000
         MACPARM &RE,=F'1',OP=A     PROPAGATE CARRY                     00470000
&N.N     MACPARM &RE,&FE,OP=A,OPR=AR                                    00480000
         AIF   (&TOR).MEND                                              00490000
         MACPARM &RE,&RO,&CTR,OP=STM,MODE=THREE                         00500000
.MEND    MEND  ,                                                        00510000
./ ADD NAME=A64F
         MACRO ,                                                        00010000
&NM      A64F  &CTR,&INC,&WK=R14                                        00020000
         GBLC  &MACPLAB                                                 00030000
.*  ADD A 32-BIT VALUE TO A 64-BIT VALUE.                               00040000
.*  WK MUST BE AN EVEN REGISTER, AND NOT THE '(INC)' REGISTER           00050000
.*  CTR MAY BE A DOUBLE-WORD STORAGE ADDRESS, OR AN EVEN REGISTER       00060000
.*  INC MAY BE A WORD STORAGE ADDRESS, OR ANY UNUSED REGISTER           00070000
.*                                                   UPD 2013/05/01 GYP 00080000
         LCLA  &K                                                       00090000
         LCLB  &TOR,&FRO     ON IF REGISTER                             00100000
         LCLC  &N,&RE,&RO,&FO                                           00110000
&N       SETC  'ZZA'.'&SYSNDX'                                          00120000
&MACPLAB SETC  '&NM'                                                    00130000
         AIF   ('&CTR(1)' EQ '&WK').REGROUT                             00140000
&K       SETA  K'&CTR                                                   00150000
         AIF   (&K LT 3).NOTROUT                                        00160000
         AIF   ('&CTR'(1,1) NE '(').NOTROUT  POSSIBLE REGISTER SPEC?    00170000
         AIF   ('&CTR'(2,1) EQ '(').NOTROUT  EXPRESSION?                00180000
         AIF   ('&CTR'(&K,1) NE ')').NOTROUT  POSSIBLE REGISTER SPEC?   00190000
         AIF   ('&CTR'(&K-1,1) EQ ')').NOTROUT  EXPRESSION?             00200000
.REGROUT ANOP  ,                                                        00210000
&TOR     SETB  1                                                        00220000
&RE      SETC  '(&CTR(1))'                                              00230000
&RO      SETC  '(1+&CTR(1))'                                            00240000
.NOTROUT  ANOP  ,                                                       00250000
&RE      SETC  '&WK'                                                    00260000
&RO      SETC  '1+&WK'                                                  00270000
.LOOKINC ANOP  ,                                                        00280000
&K       SETA  K'&INC                                                   00290000
         AIF   (&K LT 3).NOTRINC                                        00300000
         AIF   ('&INC'(1,1) NE '(').NOTRINC  POSSIBLE REGISTER SPEC?    00310000
         AIF   ('&INC'(2,1) EQ '(').NOTRINC  EXPRESSION?                00320000
         AIF   ('&INC'(&K,1) NE ')').NOTRINC  POSSIBLE REGISTER SPEC?   00330000
         AIF   ('&INC'(&K-1,1) EQ ')').NOTRINC  EXPRESSION?             00340000
.REGRINC ANOP  ,                                                        00350000
&FRO     SETB  1                                                        00360000
&FO      SETC  '(&INC(1))'                                              00370000
         AGO   .PROCESS                                                 00380000
.NOTRINC ANOP  ,                                                        00390000
&FO      SETC  '&INC'                                                   00400000
.PROCESS AIF   (&TOR).NOLM   OUTPUT IN REGS - SKIP LOAD                 00410000
         MACPARM &RE,&RO,&CTR,OP=LM,MODE=THREE                          00420000
.NOLM    MACPARM &RO,&FO,OP=AL,OPR=ALR                                  00430000
         MACPARM 12,*+4+4,OP=BC   NO CARRY                              00440000
         MACPARM &RE,=F'1',OP=A     PROPAGATE CARRY                     00450000
         AIF   (&TOR).MEND                                              00460000
         MACPARM &RE,&RO,&CTR,OP=STM,MODE=THREE                         00470000
.MEND    MACPARM MODE=LBL                                               00480000
         MEND  ,                                                        00490000
./ ADD NAME=AM24
         MACRO ,                                                        00010000
&NM      AM24  &WORK=R1                                 ADDED ON 90346  00020000
         GBLB  &MVSXA                                           GP04234 00030000
         GBLC  &SYSSPLV                                          93097  00040000
         AIF   (NOT &MVSXA AND '&SYSSPLV' LT '2').TLAB           93097  00050000
&NM      LA    &WORK,*+6     GET PAST BSM WITH BIT 0 OFF                00060000
         BSM   0,&WORK       CONTINUE IN 24-BIT MODE                    00070000
         MEXIT ,                                                        00080000
.TLAB    AIF   ('&NM' EQ '').MEND                                       00090000
&NM      DS    0H            DEFINE LABEL ONLY                          00100000
.MEND    MEND  ,                                                        00110000
./ ADD NAME=AM31
         MACRO ,                                                        00010000
&NM      AM31  &WORK=R1                                 ADDED ON 90346  00020000
         GBLB  &MVSXA                                           GP04234 00030000
         GBLC  &SYSSPLV                                          93097  00040000
         AIF   (NOT &MVSXA AND '&SYSSPLV' LT '2').TLAB           93097  00050000
&NM      LA    &WORK,*+10    GET PAST BSM WITH BIT 0 ON                 00060000
         O     &WORK,=X'80000000'  SET MODE BIT                         00070000
         BSM   0,&WORK       CONTINUE IN 31-BIT MODE                    00080000
         MEXIT ,                                                        00090000
.TLAB    AIF   ('&NM' EQ '').MEND                                       00100000
&NM      DS    0H            DEFINE LABEL ONLY                          00110000
.MEND    MEND  ,                                                        00120000
./ ADD NAME=AMODE
         MACRO ,                                                        00010000
         AMODE ,                                                        00020000
.*   DUMMY MACRO CREATED TO SUPPORT ASSEMBLY UNDFER HERCULES (XF ASM)   00030000
         MEND  ,                                                        00040000
./ ADD NAME=ARMODE
         MACRO ,                                                        00010000
&NM      ARMODE &OP,&@ALET,&AR=R14,&WK=R14                              00020000
.*                                                                    * 00030000
.*   ACCESS SPACE CONTROL SUPPORT                                     * 00040000
.*                                                                    * 00050000
.*   ARMODE 0 | P | PRI   SETS PRIMARY MODE                           * 00060000
.*   ARMODE     S | SEC   SETS SECONDARY MODE                         * 00070000
.*   ARMODE     H | HOME  SETS HOME SPACE MODE (PRIVILEGED)           * 00080000
.*   ARMODE AR            SETS ACCESS REGISTER MODE                   * 00090000
.*   ARMODE AR,@ALET,AR=N SETS AR#N FROM @ALET, THEN AR MODE          * 00100000
.*   ARMODE ANY           CONTENTS OF WORD ANY TO WK, THEN SAC 0(WK)  * 00110000
.*   ARMODE (R)           SAC 0(R)                                    * 00120000
.*                                                                    * 00130000
.*   ALL OF THE ABOVE ISSUE A SYSSTATE =P (PRIMARY), ELSE =AR         * 00140000
.*                                                                    * 00150000
.*   ARMODE SAVE          COPIES IAC MODE INTO WK REGISTER            * 00160000
.*   ARMODE SAVE,WORD     IAC MODE INTO WK REGISTER AND STORE TO WORD * 00170000
.*                                                                    * 00180000
         GBLC  &MACPLAB                                                 00190000
         GBLB  &MVSXA                                           GP04234 00200000
         AIF   (&MVSXA).ENOUGH                                  GP04234 00210000
&NM      MACPARM MODE=LBL                                       GP04234 00220000
         MEXIT ,                                                GP04234 00230000
.ENOUGH  ANOP  ,                                                GP04234 00240000
&MACPLAB SETC  '&NM'                                                    00260000
         LCLC  &EXP,&AEO                                                00270000
         LCLA  &K                                                       00280000
&EXP     SETC  '0'                                                      00290000
&AEO     SETC  'P'                                                      00300000
         AIF   (T'&OP NE 'O').HAVEOP                                    00310000
         MNOTE 8,'ARMODE: FUNCTION OR OPERAND REQUIRED'                 00320000
         MEXIT ,                                                        00330000
.*                                                                      00340000
.HAVEOP  AIF   ('&OP' EQ '0').SAC                                       00350000
         AIF   ('&OP' EQ 'P').SAC                                       00360000
         AIF   ('&OP' EQ 'PRI').SAC                                     00370000
.*                                                                      00380000
&AEO     SETC  'AR'                                                     00390000
&EXP     SETC  'X''100'''                                               00400000
         AIF   ('&OP' EQ 'S').SAC                                       00410000
         AIF   ('&OP' EQ 'SEC').SAC                                     00420000
.*                                                                      00430000
&EXP     SETC  'X''300'''                                               00440000
         AIF   ('&OP' EQ 'H').SAC                                       00450000
         AIF   ('&OP' EQ 'HOME').SAC                                    00460000
.*                                                                      00470000
&EXP     SETC  'X''200'''                                               00480000
         AIF   ('&OP' EQ 'AR').SAR                                      00490000
         AIF   ('&OP' EQ 'SAVE').IAC                                    00500000
.*  NOT A PREDEFINED OPERAND                                            00510000
&K       SETA  K'&OP                                                    00520000
         AIF   (&K LT 3).LOAD   ?                                       00530000
         AIF   ('&OP'(1,1) NE '(' OR '&OP'(2,1) EQ '(').LOAD            00540000
         AIF   ('&OP'(&K,1) NE ')' OR '&OP'(&K-1,1) EQ ')').LOAD        00550000
         MACPARM 0(&OP(1)),OP=SAC,MODE=ONE                              00560000
         AGO   .STATE                                                   00570000
.LOAD    MACPARM &WK,&OP,OP=L  LOAD STORED VALUE (FROM IAC?)            00580000
         MACPARM 0(&WK),OP=SAC,MODE=ONE  IF 0, NEED ASCENV=P            00590000
         AGO   .STATE                                                   00600000
.IAC     MACPARM &WK,OP=IAC,MODE=ONE                                    00610000
         AIF   (T'&@ALET EQ 'O').MEND                                   00620000
         MACPARM &WK,&@ALET,OP=ST,MODE=REV                              00630000
         MEXIT ,                                                        00640000
.SAR     AIF   (T'&@ALET EQ 'O').SAC                                    00650000
         MACPARM &WK,@ALET,OP=L                                         00660000
         MACPARM &AR,(&WK),OP=SAR,OPR=SAR,MODE=EQU                      00670000
.SAC     MACPARM &EXP,OP=SAC,MODE=ONE                                   00680000
.STATE   SYSSTATE ASCENV=&AEO                                           00690000
.MEND    MEND  ,                                                        00700000
./ ADD NAME=ARM
         MACRO ,                                                        00010000
&NM      ARM   &ACT,&AR=                                                00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*   THIS MACRO SETS AR MODE ON OR OFF, SETS MATCHING GLOBAL,         * 00050000
.*   AND OPTIONALLY LOADS/STORES CONTIGUOUS ACCESS REGISTERS          * 00060000
.*                                                                    * 00070000
.*   ARM  ON                 BEGIN ACCESS REGISTER MODE               * 00080000
.*   ARM  OFF                END ACCESS REGISTER MODE                 * 00090000
.*                                                                    * 00100000
.*     OPTIONAL:  AR=ADDR          LAM/STAM AR0,AR15,ADDR             * 00110000
.*     OPTIONAL:  AR=(R,ADDR)      LAM/STAM AR0,AR15,ADDR             * 00120000
.*     OPTIONAL:  AR=(RS,RT,ADDR)  LAM/STAM RS,RT,ADDR                * 00130000
.*                                                                    * 00140000
.*--------------------------------------------------------------------* 00150000
         GBLB  &MVSXA                                           GP04234 00160000
         LCLC  &R1,&R2,&ADDR                                            00170000
         LCLB  &EXPAR                                                   00180000
         LCLA  &K                                                       00190000
&K       SETA  N'&AR                                                    00200000
         AIF   (&K EQ 0).NOK                                            00210000
&EXPAR   SETB  1                                                        00220000
         AIF   (&K EQ 1).OK1                                            00230000
         AIF   (&K EQ 2).OK2                                            00240000
         AIF   (&K EQ 3).OK3                                            00250000
&EXPAR   SETB  0                                                        00260000
  MNOTE 8,'ARM: TOO MANY OPERANDS AR=&AR'                               00270000
         AGO   .NOK                                                     00280000
.OK1     ANOP  ,                                                        00290000
&R1      SETC  'R0'                                                     00300000
&R2      SETC  'R15'                                                    00310000
&ADDR    SETC  '&AR(1)'                                                 00320000
         AGO   .NOK                                                     00330000
.OK2     ANOP  ,                                                        00340000
&R1      SETC  '&AR(1)'                                                 00350000
&R2      SETC  '&AR(1)'                                                 00360000
&ADDR    SETC  '&AR(2)'                                                 00370000
         AGO   .NOK                                                     00380000
.OK3     ANOP  ,                                                        00390000
&R1      SETC  '&AR(1)'                                                 00400000
&R2      SETC  '&AR(2)'                                                 00410000
&ADDR    SETC  '&AR(3)'                                                 00420000
.NOK     AIF   (&MVSXA).ENOUGH                                  GP04234 00430000
&NM      MACPARM MODE=LBL                                       GP04234 00440000
         MEXIT ,                                                GP04234 00450000
.ENOUGH  AIF   ('&ACT' EQ 'ON' OR '&ACT' EQ 'S' OR '&ACT' EQ 'SEC' OR  *00460000
               '&ACT' EQ '512' OR '&ACT' EQ 'X''200''').ARON            00470000
         AIF   ('&ACT' EQ 'OFF' OR'&ACT' EQ 'P' OR '&ACT' EQ 'PRI' OR  *00480000
               '&ACT' EQ '0' OR '&ACT' EQ 'X''0''').AROF                00490000
 MNOTE 8,'ARM: INVALID ACTION &ACT; SPECIFY ON OR OFF'                  00500000
.ARON    AIF   (NOT &EXPAR).NOLAM                                       00510000
&NM      MACPARM &R1,&R2,&ADDR,OP=LAM,MODE=THREE                        00520000
.NOLAM   MACPARM 512,OP=SAC,MODE=ONE                                    00530000
         SYSSTATE ASCENV=AR                                             00540000
         MEXIT ,                                                        00550000
.AROF    ANOP  ,                                                        00560000
&NM      MACPARM 0,OP=SAC,MODE=ONE                                      00570000
         SYSSTATE ASCENV=P                                              00580000
         AIF   (NOT &EXPAR).NOSTAM                                      00590000
         MACPARM &R1,&R2,&ADDR,OP=LAM,MODE=THREE                        00600000
.NOSTAM  MEND  ,                                                        00610000
./ ADD NAME=AUTHBCDE
         MACRO (AUTHORIZED VERSION)                                     00010000
&REF     AUTHBCDE &RU,&LENGTH=,&SP=0,&WORKREG=,&BNDRY=DBLWD,           X00020000
               &EP=BUILDCDE,&LOC=,&AUTH=YES,&RENT=,&SYS=MVS     GP06320 00030000
.********************************************************************** 00040000
.*                                                                    * 00050000
.* MACRO NAME = BUILDCDE - RENAMED TO AUTHBCDE FOR AC=1 USERS         * 00060000
.*                                                                    * 00070000
.* DESCRIPTIVE NAME = GET STORAGE AND BUILD A CDE TO NAME IT          * 00080000
.*                                                                    * 00090000
.* FUNCTION = MAKES A STORAGE AREA EASIER TO LOCATE IN A              * 00100000
.*            DUMP BY MAKING IT APPEAR AS A LOAD_MODULE.              * 00110000
.*                                                                    * 00120000
.* STATUS = R200                                                      * 00130000
.*                                                                    * 00140000
.* AUTHOR = GILBERT SAINT-FLOUR <GSF@POBOX.COM>                       * 00150000
.*                                                                    * 00160000
.* ENVIRONMENT = SEE BELOW                                            * 00170000
.*                                                                    * 00180000
.*     AMODE = ANY                                                    * 00190000
.*     SCP   = MVS/XA OR MVS/ESA   |  MVS 3.8J WITH SYS=MVS           * 00200000
.*     KEY   = USER                                                   * 00210000
.*     MODE  = PROBLEM                                                * 00220000
.*     APF   = OFF                                                    * 00230000
.*                                                                    * 00240000
.* OPERATION = BUILDCDE USES THE "LOADER" FORM OF IDENTIFY TO CREATE  * 00250000
.*             A MAJOR CDE AND CORRESPONDING XL, THEN ISSUES A LOAD   * 00260000
.*             SVC TO CREATE AN LLE AND ASSOCIATE THE CDE WITH THE    * 00270000
.*             CURRENT TCB.                                           * 00280000
.*                                                                    * 00290000
.* INVOCATION = SEE BELOW                                             * 00300000
.*                                                                    * 00310000
.*          (BEFORE)     GETMAIN RU,LV=20000                          * 00320000
.*                                                                    * 00330000
.*          (AFTER)      GETMAIN RU,LV=20000                          * 00340000
.*                       BUILDCDE LENGTH=(0),ADDR=(1),EP=DYNAM        * 00350000
.*                                                                    * 00360000
.* NOTES = SEE BELOW                                                  * 00370000
.*                                                                    * 00380000
.*        BUILDCDE MAY BE ISSUED MORE THAN ONCE, PROVIDED THE EP      * 00390000
.*        KEY-WORD HAS A DIFFERENT VALUE EACH TIME.                   * 00400000
.*                                                                    * 00410000
.*        IF STORAGE WAS ALLOCATED IN SUB-POOL ZERO (SP=0 IS          * 00420000
.*        SPECIFIED OR DEFAULTED TO IN THE GETMAIN MACRO),            * 00430000
.*        THE DELETE MACRO MAY BE ISSUED AGAINST THE SPECIFIED EP     * 00440000
.*        TO DELETE THE CDE AND FREE UP THE STORAGE.                  * 00450000
.*                                                                    * 00460000
.*        IF GETMAIN SPECIFIES A NON-ZERO SUBPOOL, THE DELETE MACRO   * 00470000
.*        DELETES THE CDE BUT DOES NOT FREE UP THE STORAGE:  YOU      * 00480000
.*        MUST ISSUE FREEMAIN YOURSELF.                               * 00490000
.*                                                                    * 00500000
.*        IN A MAJOR CDE CREATED BY THE "LOADER" FORM OF IDENTIFY,    * 00510000
.*        THE "RENT" AND "REUS" ATTRIBUTES ARE OFF.  THIS MEANS       * 00520000
.*        THAT YOU MAY NOT ISSUE LOAD AGAINST THE EP NAME (BUILDCDE   * 00530000
.*        HAS ALREADY ISSUED LOAD), BUT YOU MAY ISSUE LINK, ATTACH    * 00540000
.*        OR XCTL IF YOU WANT TO (ONCE ONLY).  YOU MAY ALSO ISSUE     * 00550000
.*        THE STANDARD FORM OF IDENTIFY TO DEFINE SECONDARY ENTRY     * 00560000
.*        POINTS WHICH HAVE THE "RENT" ATTRIBUTE.                     * 00570000
.*        YOU MAY USE RENT=YES TO SET RENT/REUS IF AUTHORIZED   GP    * 00580000
.*                                                                    * 00590000
.*        IF THIS MACRO IS USED BY AN AUTHORIZED PROGRAM, THEN        * 00600000
.*        A S306 ABEND WILL OCCUR UNLESS AUTH=YES IS SPECIFIED OR     * 00610000
.*        DEFAULTED.                                            GP    * 00620000
.*                                                                    * 00630000
.*        THE IDENTIFY MACRO SUPPLIED IN SYS1.MACLIB SUPPORTS THE     * 00640000
.*        "LOADER" FORM, BUT THE FORMAT OF THE PARAMETER LIST IS      * 00650000
.*        NOT DOCUMENTED, AS FAR AS I KNOW.  THE RETURN CODES X'18'   * 00660000
.*        OR X'1C' MAY BE RETURNED IN R15 WHEN THE PARAMETER LIST     * 00670000
.*        IS INVALID.  THESE RETURN CODES ARE DOCUMENTED ALONG WITH   * 00680000
.*        THE IDENTIFY MACRO.                                         * 00690000
.*                                                                    * 00700000
.*        WHEN THE LOAD-LIST IS EMPTY (I.E. NO LOAD HAS BEEN ISSUED   * 00710000
.*        FOR THIS TCB YET), IDENTIFY FAILS WITH A RETURN CODE 12.    * 00720000
.*        THIS CAN BE CIRCUMVENTED BY ISSUING THE FOLLOWING SEQUENCE: * 00730000
.*                                                                    * 00740000
.*                       LOAD    EP=IEFBR14                           * 00750000
.*                       L     R0,length                              * 00760000
.*                       AUTHBCDE RU,LENGTH=(0),ADDR=(1),EP=DYNAM     * 00770000
.*                       DELETE  EP=IEFBR14                           * 00780000
.*                                                                    * 00790000
.********************************************************************** 00800000
.*     CORRECTIONS AND CHANGES BY GERHARD POSTPISCHIL  2006-11-15     * 00810000
.*        RETROFIT TO FUNCTION CORRECTLY UNDER MVS 3.8J (SYS=MVS)     * 00820000
.*        CHANGE TO ASSEMBLE UNDER ASM/XF                             * 00830000
.*        ADDED AUTH=  RENT=  AND SYS=  KEYWORDS                      * 00840000
.********************************************************************** 00850000
         LCLA  &O16                    OFFSETS IN PARM LIST     GP06320 00860000
         LCLC  &LABEL,&R               FOR ASM XF               GP06320 00870000
.*   USE SYS=MVS TO EXPAND FOR MVS 3.8J                         GP06320 00880000
      MNOTE *,'       GETMAIN &RU,LV=&LENGTH,SP=&SP,BNDRY=&BNDRY,&LOC=' 00890000
&REF     GETMAIN &RU,LV=&LENGTH,SP=&SP,BNDRY=&BNDRY,&LOC=               00900000
&O16     SETA  16                      OFFSET TO EXTENT LIST    GP06320 00910000
         AIF   ('&SYS' NE 'MVS').NEWSYS                         GP06320 00920000
&O16     SETA  12                      OFFSET TO EXTENT LIST    GP06320 00930000
.NEWSYS  ANOP  ,                       XA, ESA, .....           GP06320 00940000
         ST    R1,0(,R1)               STORE ENTRY-POINT ADDR           00950000
         MVC   4(8,R1),=CL8'&EP '      CDNAME                   GP06320 00960000
         AIF   ('&SYS' EQ 'MVS').OLDSYS   SHORTER LIST IN 3.8   GP06320 00970000
         XC    12(4,R1),12(R1)         CLEAR BYTES 12-15                00980000
.OLDSYS  LA    R14,16                  LENGTH OF PSEUDO XL      GP06320 00990000
         LA    R15,1                   NUMBER OF RELOCATION FACTORS     01000000
         STM   R14,R1,&O16.(R1)        FORMAT BYTES 16-23       GP06320 01010000
         MVI   &O16+8(R1),X'80'        END OF LIST              GP06320 01020000
         LR    R14,R1                  SAVE GETMAINED ADDRESS           01030000
         MNOTE *,'       IDENTIFY EPLOC=0,ENTRY=(R1)'                   01040000
         SLR   R0,R0                   LOADER-TYPE IDENTIFY             01050000
         SVC   41                      ISSUE IDENTIFY SVC               01060000
&LABEL   SETC  'IHB&SYSNDX'                                             01070000
&R       SETC  '&WORKREG(1)'           SHORT FORM                       01080000
         AIF   (T'&WORKREG NE 'O').WKREG2                               01090000
         MNOTE 4,'WORKREG OPERAND OMITTED, WORKREG=(R2) ASSUMED'        01100000
&R       SETC  'R2'                                                     01110000
.WKREG2  L     &R,X'021C'              PSATOLD (MY TCB)                 01120000
         L     &R,TCBJSCB-TCB(,&R)     MY JSCB                          01130000
         USING IEZJSCB,&R                                               01140000
         TM    JSCBOPTS,JSCBAUTH       CHECK AUTHORIZATION              01150000
         BZ    &LABEL.N                JUMP IF NOT AUTHORIZED           01160000
         MODESET KEY=ZERO              SWITCH TO KEY ZERO               01170000
         NI    JSCBOPTS,255-JSCBAUTH   TURN APF FLAG OFF                01180000
         SYNCH &LABEL.L                EXECUTE ROUTINE WITH TCB KEY     01190000
         OI    JSCBOPTS,JSCBAUTH       TURN APF FLAG BACK ON            01200000
         AIF   ('&AUTH' NE 'YES' AND '&RENT' NE 'YES').NOAPF    GP06320 01210000
.*   IN MVS 3.8J, THE TEST PROGRAM'S LINK FAILS WITH IEA703I 306-C      01220000
.*     TO AVOID THIS, WE SET THE CDE TO AUTH LIB & AUTH MODULE          01230000
.*     WHEN THE USER REQUESTS AUTH=YES                          GP06320 01240000
.*     WHEN RENT=YES, CDE IS FLAGGED REENTRANT AND REUSABLE     GP06320 01250000
         L     &R,X'021C'              PSATOLD (MY TCB)         GP06320 01260000
         ICM   &R,15,TCBJPQ-TCB(&R)    GET JOB PACK QUEUE       GP06320 01270000
         BZ    &LABEL.C                                         GP06320 01280000
         USING CDENTRY,&R              CDE MAPPING (IHACDE)     GP06320 01290000
&LABEL.A CLC   =CL8'&EP ',CDNAME       MATCHING MODULE ?        GP06320 01300000
         BE    &LABEL.B                YES; SET IT              GP06320 01310000
         ICM   &R,15,CDCHAIN           ANOTHER CDE ON CHAIN?    GP06320 01320000
         BNZ   &LABEL.A                YES; TRY IT              GP06320 01330000
         B     &LABEL.C                OOPS - WHAT HAPPENED?    GP06320 01340000
&LABEL.B DS    0H                                               GP06320 01350000
         AIF   ('&AUTH' NE 'YES').NOAPFL                        GP06320 01360000
         OI    CDATTR2,CDSYSLIB+CDAUTH  FLAG AUTHORIZED         GP06320 01370000
.NOAPFL  AIF   ('&RENT' NE 'YES').NOAPF                         GP06320 01380000
         OI    CDATTR,CDREN+CDSER      SET RENT/REUS            GP06320 01390000
.NOAPF   DROP  &R                                                       01400000
&LABEL.C LR    &R,R0                   SAVE EP ADDRESS                  01410000
         MODESET KEY=NZERO             SWITCH TO TCB KEY                01420000
         LR    R0,&R                   EP ADDRESS                       01430000
         B     &LABEL.X                                                 01440000
         AIF   ('&SYS' EQ 'MVS').OLDASM                         GP06320 01450000
&LABEL.I EQU   &R-2                    WORKREG MUST BE R2-R13           01460000
&LABEL.J EQU   13-&R                   WORKREG MUST BE R2-R13           01470000
.OLDASM  ANOP  ,           WORKS ONLY IF &R PREVIOUSLY DEFINED  GP06320 01480000
&LABEL.N LA    R14,&LABEL.X            RET FROM LOAD                    01490000
         MNOTE *,'       LOAD EP=&EP,DCB=0'                             01500000
&LABEL.L LA    R0,=CL8'&EP'            POINT TO EP NAME         GP06320 01510000
         SLR   R1,R1                   NO DCB FOR LOAD                  01520000
         SVC   8                       ISSUE LOAD SVC                   01530000
         BR    R14                     RETURN NEXT OR SYNCH EX          01540000
&LABEL.X LR    R1,R0                   ADDRESS IN R1                    01550000
         SLR   R0,R0                                                    01560000
         ICM   R0,B'0111',&O16+9(R14)  LENGTH IN R0             GP06320 01570000
         MEND                                                           01580000
./ ADD NAME=BAKR
         MACRO ,                                                        00010000
&NM      BAKR  &R,&A                                    ADDED ON 04234  00020000
.*                                                                      00030000
.*    HERCULES MVS 3.8 SUPPORT                                          00040000
.*                                                                      00050000
         GBLB  &MVSXA        SET BY OPTIONGB/SYSPARM            GP04234 00060000
         GBLC  &MACPLAB                                                 00070000
&NM      STM   R14,R12,12(R13)  SAVE STUFF                              00080000
         MEND  ,                                                        00090000
./ ADD NAME=BALSR
         MACRO ,                                                        00010000
&NM      BALSR &R,&S                                    ADDED ON 92281  00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES EITHER                                   00040000
.*       A BALR OR BASR, DEPENDING ON THE SYSTEM. BAS AND BASR          00050000
.*       REQUIRE AT LEAST SP 2 (MVS/XA)                                 00060000
.*                                                                      00070000
         GBLB  &MVT          SET BY OPTIONGB/SYSPARM            GP04234 00080000
         AIF   (&MVT).BAL                                               00090000
&NM      DC    0H'0',AL.4(0,13,&R,&S)                                   00100000
         MEXIT ,                                                        00110000
.BAL     ANOP  ,                                                        00120000
&NM      BALR  &R,&S                                                    00130000
         MEND  ,                                                        00140000
./ ADD NAME=BALS
         MACRO ,                                                        00010000
&NM      BALS  &R,&A                                    ADDED ON 90308  00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES EITHER A BAL OR A BAS, OR POSSIBLY       00040000
.*       A BALR OR BASR, DEPENDING ON THE SYSTEM. BAS AND BASR          00050000
.*       REQUIRE AT LEAST SP 2 (MVS/XA)                                 00060000
.*                                                                      00070000
         GBLB  &MVT                                                     00080000
         LCLA  &K                                                       00090000
&K       SETA  K'&A                                                     00100000
         AIF   (&K LT 3).NORMAL                                         00110000
         AIF   ('&A'(1,1) NE '(' OR '&A'(2,1) EQ '(').NORMAL            00120000
         AIF   ('&A'(&K,1) NE ')' OR '&A'(&K-1,1) EQ ')').NORMAL        00130000
         AIF   (&MVT).BALR                                              00140000
&NM      DC    0H'0',AL.4(0,13,&R,&A(1))  BASR                          00150000
         MEXIT ,                                                        00160000
.BALR    ANOP  ,                                                        00170000
&NM      BALR  &R,&A(1)                                                 00180000
         MEXIT ,                                                        00190000
.NORMAL  ANOP  ,                                                        00200000
&NM      BAL   &R,&A                                                    00210000
         AIF   (&MVT).MEND                                              00220000
         ORG   *-4                                                      00230000
         DC    X'4D'         BAS                                        00240000
         ORG   *+3                                                      00250000
.MEND    MEND  ,                                                        00260000
./ ADD NAME=BANDAID
         MACRO ,                                       NEW 2003/01/01   00010000
&NM      BANDAID &ARG,&A=                                               00020000
         GBLC  &LOCAL                                           GP09301 00030000
         GBLB  &ZZSTAE,&ZZSPIE                                          00040000
         LCLA  &OV,&I,&J,&K,&L,&N                                       00050000
         LCLB  &SYSDEB,&SPIE                                            00060000
         LCLC  &C,&OPT,&OPT1,&OPT2,&LBL                                 00070000
&N       SETA  N'&SYSLIST    NUMBER OF ARGUMENTS                        00080000
&LBL     SETC  '&NM'                                                    00090000
         AIF   (&N GT 0).OKARG                                          00100000
.NOARG   MNOTE 8,'BANDAID REQUIRES AN ARGUMENT'                         00110000
         MEXIT ,                                                        00120000
.OKARG   AIF   (&L GE &N).EXPAND                                        00130000
&L       SETA  &L+1                                                     00140000
&OPT     SETC  '&SYSLIST(&L)'                                           00150000
         AIF   ('&OPT' EQ '').OKARG                                     00160000
&C       SETC  '&OPT'(1,3).'   '                                        00170000
&C       SETC  '&C'(1,3)                                                00180000
&I       SETA  -2                                                       00190000
&J       SETA  1+8*3                                                    00200000
.ARGLOOP AIF   (&I GE &J).FAIL                                          00210000
&I       SETA  &I+3                                                     00220000
         AIF   ('&C' NE 'INITERCLOSPITRARESPUSPOP'(&I,3)).ARGLOOP       00230000
         AIF   (&I GE 7).PART2                                          00240000
         AIF   (&SYSDEB).DUPE                                           00250000
&SYSDEB  SETB  1                                                        00260000
&OPT1    SETC  '&OPT'                                                   00270000
         AGO   .OKARG                                                   00280000
.*                                                                      00290000
.PART2   AIF   (&SPIE).DUPE                                             00300000
&OV      SETA  ((&I-6)/3)                                               00310000
&OPT2    SETC  '&OPT'                                                   00320000
&SPIE    SETB  1                                                        00330000
         AGO   .OKARG                                                   00340000
.*                                                                      00350000
.EXPAND  AIF   (NOT &SYSDEB AND NOT &SPIE).NOARG                        00360000
         AIF   (NOT &SYSDEB).DONDEB                                     00370000
.*   When OPT is INIT:        FOR TERM INVOKES WITHDRAWAL               00380000
.*   USE THIS MACRO TO INITIALIZE THE @BANDAID (SYSDEBUG) ESTAE/ESPIE   00390000
.*   SERVICE ROUTINE.  REQUIRES //SYSDEBUG OUTPUT DD                    00400000
&LBL     LOAD  EP=@BANDAID   LOAD @BANDAID, ISSUE ESTAE, ESPIE, ETC.    00410000
&LBL     SETC  ' '                                                      00420000
         LR    R15,R0                                                   00430000
         L     R0,=CL4'&OPT1'  PASS OPTION (FOR LATER ESPIE SUPPORT)    00440000
         BASSM R14,R15       INVOKE WITH AMODE31                        00450000
&ZZSTAE  SETB  1                                                        00460000
.*                                                                      00470000
.DONDEB  AIF  (NOT &SPIE).MEND                                          00480000
.*   When OPT is SPIE:  initialize SPIE services                        00490000
.*   When OPT is TRAP:  specify address of recovery routine             00500000
.*   When OPT is RESET: cancel recovery                                 00510000
.*   When OPT is PUSH:  specify new recovery routine; save old one      00520000
.*   When OPT is POP:   cancel current and reinstate old recovery       00530000
.*   When OPT is CLOSE: close SYSDEBUG DCB, remove SPIE                 00540000
.*   REQUIRES //SYSDEBUG OUTPUT DD                                      00550000
&LBL     LOAD  EP=@SPIEDER   LOAD @SPIEDER, ISSUE ESPIE, ETC.           00560000
&LBL     SETC  ' '                                                      00570000
         LR    R15,R0                                                   00580000
         AIF   ('&LOCAL' EQ '').ALIEN  NOT ESP ENVIRONMENT      GP09301 00590000
         ST    R15,@SPIEDER                                             00600000
.ALIEN   LA    R0,&OV        PASS OPTION TO INIT                        00610000
         MACPARM R1,&A,NULL=SKIP                                        00620000
         BASSM R14,R15       INVOKE WITH AMODE                          00630000
&ZZSPIE  SETB  1                                                        00640000
         MEXIT ,                                                        00650000
.DUPE    MNOTE 4,'BANDAID: OPTION &OPT CONFLICTS'                       00660000
         MEXIT ,                                                        00670000
.FAIL    MNOTE 4,'BANDAID: OPTION &OPT NOT RECOGNIZED'                  00680000
.MEND    MEND  ,                                                        00690000
./ ADD NAME=BASCALL
         MACRO ,                                                GP97349 04370000
&NM      BASCALL &MD,&AM                                        GP97349 04380000
         AIF   ('&AM' EQ '').DEF31                              GP97349 04390000
&NM      TSX   R9,/&MD,AMODE=&AM                                GP97349 04400000
         MEXIT ,                                                GP97349 04410000
.DEF31   ANOP  ,                                                GP97349 04420000
&NM      TSX   R9,/&MD,AMODE=AM31                               GP97349 04430000
         MEND  ,                                                GP97349 04440000
./ ADD NAME=BASEND
         MACRO ,                                                GP97349 04300000
&NM      BASEND ,                                               GP97349 04310000
&NM      DS    0X                                               GP97349 04320000
PGMTRACE CSECT ,                                                GP97349 04330000
         POP   USING                                            GP97349 04340000
         MEND  ,                                                GP97332 04350000
./ ADD NAME=BASHEAD
         MACRO ,                                                GP97332 04060000
&NM      BASHEAD ,           START A SUBROUTINE                 GP97349 04070000
         PUSH  USING                                            GP97349 04080000
         DROP  R11,R12                                          GP97349 04090000
SUBRTNES CSECT ,                                                GP97349 04100000
&NM      STM   R0,R15,8(R13)  SAVE CALLER'S REGISTERS           GP97349 04110000
         LA    R13,LOCSAVE1-LOCSAVE(,R13)  PUSH THE STACK       GP97349 04120000
         LR    R11,R15       MAKE LOCAL BASE                    GP97349 04130000
         LA    R12,2048                                         GP97349 04140000
         LA    R12,2048(R11,R12)                                GP97349 04150000
         USING &NM,R11,R12                                      GP97349 04160000
         MEND  ,                                                GP97349 04170000
./ ADD NAME=BASRET
         MACRO ,                                                        00010001
&NM      BASRET &POP,&TYPE=BSM,&RS=R0,&RE=R15,&VECT=0                   00020001
&NM      SH    R13,=Y(LOCSAVE1-LOCSAVE)  POP THE STACK                  00030001
         AIF   ('&POP' EQ '*NO').POP                                    00040001
         AIF   ('&VECT' EQ '0').BSM0                                    00050001
         LA    R9,&VECT      GET RETURN OFFSET                          00060001
         A     R9,4*R9+8(R13) ADJUST RETURN                             00070001
         ST    R9,4*R9+8(R13) ADJUST RETURN                             00080001
.BSM0    LM    &RS,&RE,4*&RS+8(R13)  RESTORE CALLER'S REGISTERS         00090001
         RET31 R9            RETURN IN CALLER'S MODE                    00100001
         MEXIT ,                                                        00110001
.POP     LM    &RS,&RE,4*&RS+8(R13)  RESTORE CALLER'S REGISTERS         00120001
         MEND  ,                                                        00130001
./ ADD NAME=BASR
         MACRO ,                                                        00010000
&NM      BASR  &R,&S                                    ADDED ON 04234  00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES A BASR FOR IFOX (MIN. HERC 370)          00040000
.*                                                                      00050000
&NM      DC    0H'0',AL.4(0,13,&R,&S)   BASR                            00060000
         MEND  ,                                                        00070000
./ ADD NAME=BASSM
         MACRO ,                                                        00010000
&NM      BASSM &R,&A                                   ADDED ON GP04234 00020000
         GBLB  &MVSXA                                           GP10054 00030000
         GBLC  &MODEL                                           GP10054 00040000
.*                                                                      00050000
.*       THIS MODULE GENERATES A BASR FOR MVS COMPATIBILITY.            00060000
.*       REQUIRE AT LEAST SP 2 (MVS/XA) FOR HARDWARE SUPPORT            00070000
.*                                                                      00080000
.*R1   R2   BALR R1,R2                                                  00090000
.*0    R2   BALR 0,R2                                                   00100000
.*R1   0    BALR R1,0                                                   00110000
.*0    0    BALR 0,0                                                    00120000
.*                                                                      00130000
         AIF   ('&MODEL' EQ '380').BASSM                        GP10054 00140000
         AIF   (NOT &MVSXA).OLD                                 GP10054 00150000
.BASSM   ANOP  ,                                                GP10054 00160000
&NM      DC    0H'0',AL.4(0,12,&R,&A)   BASSM                   GP10054 00170000
         MEXIT ,                                                        00180000
.OLD     ANOP  ,                                                GP10054 00190000
&NM      DC    0H'0',AL.4(0,13,&R,&A)   BASR                    GP10054 00200000
         MEND  ,                                                        00210000
./ ADD NAME=BAS
         MACRO ,                                                        00010000
&NM      BAS   &R,&A                                    ADDED ON 04234  00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES EITHER A BAL FOR MVS COMPATIBILIY        00040000
.*       BAS NEEDS AT LEAST SP 2 (MVS/XA) OR HERCULES 370               00050000
.*                                                                      00060000
         GBLB  &MVT                                                     00070000
&NM      BAL   &R,&A                                                    00080000
         AIF   (&MVT).MEND                                              00090000
         ORG   *-4                                                      00100000
         DC    X'4D'         BAS                                        00110000
         ORG   *+3                                                      00120000
.MEND    MEND  ,                                                        00130000
./ ADD NAME=BCON
         MACRO ,                                                        00010000
&NM      BCON  &STR,&END=                              ADDED ON GP02242 00020001
         GBLB  &VCON@OP                                                 00030000
         GBLC  &VCON@NM                                                 00040000
         LCLA  &I,&J,&K,&L                                              00050000
.********************************************************************** 00060001
.**                                                                  ** 00070001
.**  BCON BUILDS A TEXT MESSAGE BEGINNING WITH A ONE-BYTE LENGTH,    ** 00080001
.**    FOLLOWED BY TEXT.                                             ** 00090001
.**                                                                  ** 00100001
.**  USE   BCON  'TEXT'                                              ** 00110001
.**                                                                  ** 00120001
.**  OR    BCON  'TEXT1',END=LABEL                                   ** 00130001
.**        DC     ...ZERO OR MORE STORAGE ITEMS                      ** 00140001
.**  LABEL BCON   *END    TO GENERATE A SINGLE MESSAGE               ** 00150001
.**                                                                  ** 00160001
.********************************************************************** 00170001
&K       SETA  K'&STR                                                   00180000
         AIF   (T'&END NE 'O').TSTOPEN                                  00190000
         AIF   (T'&STR EQ 'O').CLOSE                                    00200000
         AIF   ('&STR'(1,1) EQ '*').CLOSE                               00210000
.TSTOPEN AIF   (&K EQ 0).COMLEN                                         00220000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00230000
&I       SETA  2                                                        00240000
&J       SETA  &K-2                                                     00250000
&K       SETA  &J                                                       00260000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00270000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00280000
&I       SETA  &I+1                                                     00290000
         AGO   .INC                                                     00300000
.SK2     ANOP  ,                                                        00310000
&I       SETA  &I+2                                                     00320000
&K       SETA  &K-1                                                     00330000
.INC     AIF   (&I LE &J).LOOP                                          00340000
.COMLEN  AIF   (NOT &VCON@OP).NOPEN                                     00350000
         MNOTE 4,'PRIOR BCON/VCON NOT TERMINATED'                       00360001
&VCON@OP SETB  0                                                        00370000
.NOPEN   AIF   (T'&END NE 'O').OPEN                                     00380001
         AIF   (&K EQ 0).REQSTR                                         00390000
         AIF   ('&STR'(1,1) EQ '''').QSTR                               00400000
&NM      DC    AL1(&K),C'&STR'                                          00410002
         AGO   .MEND                                                    00420000
.QSTR    ANOP  ,                                                        00430000
&NM      DC    AL1(&K),C&STR                                            00440002
         AGO   .MEND                                                    00450000
.OPEN    AIF   (&K NE 0).OPSTR                                          00460000
&NM      DC    AL1(&END-*-1)                                            00470002
         AGO   .SETOPEN                                                 00480000
.OPSTR   AIF   ('&STR'(1,1) EQ '''').OQSTR                              00490000
&NM      DC    AL1(&END-*-1),C'&STR'                                    00500002
         AGO   .SETOPEN                                                 00510000
.OQSTR   ANOP  ,                                                        00520000
&NM      DC    AL1(&END-*-1),C&STR                                      00530002
.SETOPEN ANOP  ,                                                        00540000
&VCON@NM SETC  '&END'                                                   00550000
&VCON@OP SETB  1                                                        00560000
         MEXIT ,                                                        00570000
.REQSTR  MNOTE 4,'TEXT STRING REQUIRED'                                 00580000
         MEXIT ,                                                        00590000
.CLOSE   AIF   (&VCON@OP).WASOPEN                                       00600000
         MNOTE 4,'BCON/VCON END OUT OF SEQUENCE'                        00610001
.WASOPEN AIF   ('&NM' EQ '' OR '&NM' EQ '&VCON@NM').BLAB                00620000
&NM      EQU   *                                                        00630000
.BLAB    ANOP  ,                                                        00640000
&VCON@NM EQU   *                                                        00650000
&VCON@NM SETC  ''                                                       00660000
&VCON@OP SETB  0                                                        00670000
.MEND    MEND  ,                                                        00680000
./ ADD NAME=BIGBEN
         MACRO ,                                                        00010000
&NM      BIGBEN ,                                                       00020000
&NM      $TCKCONV STCKVAL=0,CONVVAL=DB3,TIMETYP=BIN,DATETYP=YYYYMMDD    00030000
 PRTDATA ' At the tone the time will be',(DB3,TIME,PAD),'on',          *00040000
               (DB3+8,2,X,PADL),'-',(DB3+10,1,X),'-',(DB3+11,1,X)       00050000
         MEND  ,                                                        00060000
./ ADD NAME=BIX
         MACRO ,                                                        00010000
&NM      BIX   &VAL=(R0),&WK=R15,&W2=R0,&SRL=0,&BHI=,  UPDATED GP03020 *00020000
               &BASE=,&LOC=,&ERR=,&PFX=                    ADDED 81193  00030000
.*--------------------------------------------------------------------* 00040000
.*                                                                    * 00050000
.*  BIX PERFORMS AN INDEXED BRANCH WITH UP TO 256 TARGETS.            * 00060000
.*                                                                    * 00070000
.*  &VAL (R0) SPECIFIES THE REGISTER CONTAINING THE BRANCH VALUE      * 00080000
.*  &SRL (0)  SPECIFIES A NUMERIC RIGHT SHIFT COUNT                   * 00090000
.*  &BHI      LABEL TO GO TO WHEN THE VALUE MATCHES THE MASK          * 00100000
.*   MASK (BHI(2)   MASK APPLIED AFTER SHIFTING                       * 00110000
.*     { N'&LOC USED TO COMPUTE WHEN NOT SUPPLIED }                   * 00120000
.*  &ERR      LABEL TO GO TO ON AN INVALID VALUE AFTER SHIFT/MASK, OR * 00130000
.*              AN EMPTY TARGET LOCATION                              * 00140000
.*  &BASE     VALUE SUBTRACTED FROM TARGET LOCATION. CURRENT CSECT IS * 00150000
.*              THE DEFAULT                                           * 00160000
.*  &LOC      LIST OF TARGET LOCATIONS, IN ORDER CORRESPONDING TO THE * 00170000
.*              VALUE; I.E. FIRST ENTRY FOR 0, SECOND FOR 1, ETC.     * 00180000
.*              OMITTED ENTRIES CAUSE A BRANCH TO &ERR                * 00190000
.*  &PFX      PREFIX TO PREPEND TO THE LOC LABELS FOR A SHORTER LIST. * 00200000
.*              THE PREFIX IS *NOT* APPLIED TO BHI OR ERR NAMES.      * 00210000
.*  &WK  (R15)  A WORK REGISTER (ANY BUT 0)                           * 00220000
.*  &W2  (R0)   A WORK REGISTER (ANY BUT WORK)                        * 00230000
.*                                                                    * 00240000
.*  SAMPLE USE:                                                       * 00250000
.*                                                                    * 00260000
.*       IBMMACRO THAT RETURNS 0, 4, 8, ETC., OR SUBROUTINE CALL      * 00270000
.*         LR   R15,R0        COPY VALUE TO WORK REGISTER             * 00280000
.*         BIX  VAL=(R15),SRL=2,LOC=(RET0,RET4),ERR=MACFAIL           * 00290000
.*                                                                    * 00300000
.*  NOTE THAT BITS SHIFTED OUT, AND BITS LEFT OF THE MASK ARE NOT     * 00310000
.*  TESTED FOR ZERO. THIS IS INTENTIONAL TO PERMIT USE OF LOW FLAG    * 00320000
.*  BITS AND OTHER USE OF UNREFERENCED DATA.                          * 00330000
.*                                                                    * 00340000
.*--------------------------------------------------------------------* 00350000
         LCLA  &I,&J,&N                                                 00360000
         LCLC  &LB           TABLE BASE                                 00370000
         LCLC  &BH1,&BH2     BHI OPERANDS                               00380000
         LCLC  &SPACES                                                  00390000
&LB      SETC  '&SYSECT'                                                00400000
&SPACES  SETC  '    '                                                   00410000
         AIF   ('&BASE' EQ '' OR '&BASE' EQ '*').DEFBASE                00420000
&LB      SETC  '&BASE'                                                  00430000
.DEFBASE AIF   (N'&BHI NE 2).NOTBHI                                     00440000
&BH1     SETC  '&BHI(1)'     FIRST OF TWO ARGUMENTS                     00450000
&BH2     SETC  '&BHI(2)'     SECOND OF TWO ARGUMENTS                    00460000
.NOTBHI  AIF   (N'&BHI NE 1).DONBHI                                     00470000
&BH1     SETC  '&BHI'        ONE OF ONE, WITH PARENTHESES               00480000
.DONBHI  ANOP  ,                                                        00490000
.*--------------------------------------------------------------------* 00500000
.*  DETERMINE NUMBER OF ADDRESSES, AND CORRESPONDING MASK             * 00510000
.*--------------------------------------------------------------------* 00520000
&N       SETA  N'&LOC                                                   00530000
&J       SETA  2             SET SMALLEST MASK + 1 (=1 FAILS)           00540000
&I       SETA  &N            FOR NON-NUM SIZE, USE COUNT                00550000
         AIF   (&N NE 0 AND &N LE 256).GOTSIZE                          00560000
.BADSIZE MNOTE 8,'BIX: LOC LIST BAD - NEED 1 TO 256 TARGET LABELS'      00570000
.GOTSIZE AIF   (&J GE &I).GOTMASK                                       00580000
&J       SETA  &J*&J                                                    00590000
         AGO   .GOTSIZE                                                 00600000
.GOTMASK ANOP  ,                                                        00610000
&I       SETA  &J-1          CONVERT POWER OF TWO TO MASK               00620000
.USEMASK ANOP  ,                                                        00630000
&NM      MACPARM &WK(1),&VAL,OP=IC,OPR=LR  LOAD INDEX VALUE             00640000
         AIF   ('&SRL' EQ '0').NOSHFT                                   00650000
         MACPARM &WK(1),&SRL,OP=SRL,OPR=SRL,MODE=EVEN,NULL=SKIP         00660000
.NOSHFT  MACPARM &W2(1),&I,OP=LA,MODE=EVEN LOAD MASK VALUE              00670000
         NR    &WK(1),&W2(1) ISOLATE SIGNIFICANT PORTION                00680000
         AIF   ('&BH1' EQ '').DOWK2                                     00690000
         MACPARM &W2(1),&BH2,OP=LA,NULL=SKIP  ALLOW OVERRIDE            00700000
         CR    &WK(1),&W2(1) EXACTLY MASK MAXIMUM ?                     00710000
         MACPARM &BH1,OP=BE,OPR=BER,MODE=ONE                            00720000
.DOWK2   AIF   (T'&ERR EQ 'O').NOLIM                                    00730000
         AIF   ('&N' EQ '&BH2').TOOMASK  LIST HIGH SAME AS MAX ?        00740000
         CH    &WK(1),=Y(&N) VALID INDEX ?                              00750000
.TOOMASK BNL   &ERR          NO; TOO HIGH                               00760000
.NOLIM   SLL   &WK(1),1      CONVERT INDEX TO OFFSET                    00770000
         LH    &WK(1),*+8(&WK(1)) LOAD LABEL OFFSET FROM BASE           00780000
         B     &LB.(&WK(1))  ENTER ROUTINE                              00790000
&J       SETA  0                                                        00800000
.INC     AIF   (&J GE &N).DONE                                          00810000
&J       SETA  &J+1                                                     00820000
         AIF   ('&LOC(&J)' EQ '').DFLT                                  00830000
         DC    AL2(&PFX.&LOC(&J)-&LB)&SPACES.&J  BRANCH                 00840000
         AGO   .INC                                                     00850000
.DFLT    DC    AL2(&ERR-&LB)&SPACES.&J  ERROR                           00860000
         AGO   .INC                                                     00870000
.DONE    MEND  ,                                                        00880000
./ ADD NAME=BLANKOUT
         MACRO                                                          00010000
&NM      BLANKOUT &RET=R14,&ADD=R1,&LEN=R3,&CPU=,&WK=R15         78187  00020000
         SPACE 1                                                        00030000
*        THIS ROUTINE BLANKS OUT AN AREA OF ANY LENGTH                  00040000
         AIF   ('&CPU' NE '360').MVCL                                   00050000
*                                                                       00060000
&NM      SH    &LEN,H1       AT LEAST ONE BYTE ?                 78187  00070000
         BMR   &RET          NO                                  78187  00080000
         MVI   0(&ADD),C' '  SET FIRST BYTE BLANK                       00090000
         BZR   &RET .        DONE IF ONLY ONE                    78187  00100000
&NM.A    BCTR  &LEN,0        LESS ONE FOR EXECUTE                78187  00110000
         LA    &WK,255       SET LENGTH-1                        78187  00120000
         NR    &WK,&LEN      MASK OUT NUMBER THIS TIME           78187  00130000
         EX    &WK,&NM.B     MOVE SPECIFIED NUMBER               78187  00140000
         LA    &ADD,1(&WK,&ADD)  BUMP POINTER                    78187  00150000
         XR    &LEN,&WK      ACCOUNT FOR NUMBER DONE             78187  00160000
         BL    &NM.A .       DO NEXT SEGMENT                     78187  00170000
         BR    &RET          RETURN DONE                         78187  00180000
&NM.B    MVC   1(0,&ADD),0(&ADD)                                 78187  00190000
         MEXIT                                                          00200000
.MVCL    SPACE 1                                                 78187  00210000
&NM      LTR   &LEN,&LEN .   AT LEAST ONE BYTE ?                 79182  00220000
         BNPR  &RET .        NO, RETURN                          79182  00230000
         STM   R15,R1,12(R13) .  SAVE REGS                       78187  00240000
         AIF   ('&LEN' NE '0' AND '&LEN' NE 'R0').M01                   00250000
         MACPARM R1,(&LEN)                                              00260000
         MACPARM R0,(&ADD)                                              00270000
         AGO   .MCOM                                                    00280000
.M01     MACPARM R0,(&ADD)                                              00290000
         MACPARM R1,(&LEN)                                              00300000
.MCOM    SR    R15,R15                                                  00320000
         ICM   R15,8,BLANKS .  BLANK IS PADDING BYTE                    00330000
         MVCL  R0,R14 .      CLEAR ALL                                  00340000
         LM    R15,R1,12(R13) .  RESTORE                                00350000
         BR    &RET                                                     00360000
         MEND                                                           00370000
./ ADD NAME=BLOOK
         MACRO                                                          00010000
&NM      BLOOK &T=,&ERR=*+8,&B=*,&R=,&PFX=,&X=R5,&Y=R6,&Z=R4,          *00020000
               &STRIP=,&ABBR=,&FULL=                            GP13189 00030000
         GBLB  &ZZ@BLUK                                                 00040000
         GBLC  &MACPLAB,&ZZ@BLUF                                GP08269 00050000
.********************************************************************** 00060000
.*                                                                   ** 00070000
.*    Verb lookup routine; see BTAB macro for matching verb defs     ** 00080000
.*    T     - address of BTAB definitions                            ** 00090000
.*    X     - pointer for scanning                             (R5)  ** 00100000
.*    Y     - register pointing at last byte of text           (R6)  ** 00110000
.*    Z     - register for BTAB scanning                       (R4)  ** 00120000
.*    R     - address of text                                        ** 00130000
.*    B     - base address for (b)ddd branching; B=A (absolute)      ** 00140000
.*            branches to BTAB with BASE=0; B=* (default) branches   ** 00150000
.*            from CSECT                                             ** 00160000
.*    ERR   - branch address/register for no match                   ** 00170000
.*    PFX   - 0-4 character label prefix (default VERB)              ** 00180000
.*    STRIP - (default) skip leading blanks                          ** 00190000
.*            =NEVER    process at current input address             ** 00200000
.*    ABBR  - when specified, accepts matches for abbreviated verbs  ** 00210000
.*            of any length from original to ABBR value (no default) ** 00220000
.*            ABBR=3 for 'COMMAND' would match COMMAND, COMMAN,      ** 00230000
.*            COMMA, COMM, and COM                                   ** 00240000
.*    FULL  - one or more trailing characters inhibiting shorter     ** 00250000
.*            compares. No default; common are = and (               ** 00260000
.*            e.g., FULL='=' (valid are FULL=alphanum; FULL='chars'; ** 00270000
.*            FULL=C'chars'; and FULL=X'hexchars')                   ** 00280000
.*            FULL== and FULL='' are valid (= and ' comnpares)       ** 00290000
.*                                                                   ** 00300000
.********************************************************************** 00310000
.*                                                                   ** 00320000
.*    X returns next byte after match, or last text + 1 for no match ** 00330000
.*    R14 is a return register; R15-R1 are work registers.           ** 00340000
.*                                                                   ** 00350000
.*    Y unchanged.                                                   ** 00360000
.*    Z returns last process table entry.                            ** 00370000
.*                                                                   ** 00380000
.********************************************************************** 00390000
.*                                                                   ** 00400000
.*    BLOOK expands an in-line subroutine, called by other           ** 00410000
.*    references. To use in an assembly with multiple, not mutually  ** 00420000
.*    addressable CSECTs, use a unique PFX in each.                  ** 00430000
.*                                                                   ** 00440000
.********************************************************************** 00450000
         LCLC  &L,&D,&LAB,&D1,&D2,&D3                           GP13189 00460000
         LCLA  &I,&J,&K                                         GP13189 00470000
&L       SETC  'L'''                                                    00480000
         AIF   ('&ZZ@BLUF' NE '').OLDLAB                        GP08269 00490000
&ZZ@BLUF SETC  'VERB'        DEFAULT LABEL                      GP08269 00500000
.OLDLAB  ANOP  ,                                                GP08269 00510000
         AIF   ('&PFX' EQ '' OR '&PFX' EQ '&ZZ@BLUF').DONLAB    GP08269 00520000
&ZZ@BLUF SETC  '&PFX'                                           GP08269 00530000
&ZZ@BLUK SETB  0             EXPAND CODE WITH NEW LABELS        GP08269 00540000
.DONLAB  ANOP  ,                                                GP08269 00550000
&LAB     SETC  '&ZZ@BLUF'                                       GP08269 00560000
&NM      MACPARM &Z,&T,NULL==X'FF'                                      00570000
&D       SETC  '('.'&Y'.')'                                      89152  00580000
         AIF   ('&D' EQ '&R' OR '&R' EQ '&Y').NOEND              89152  00590000
         MACPARM &Y,&R+&L&R-1                                           00600000
.NOEND   AIF   (&ZZ@BLUK).NOTONCE                                       00610000
&ZZ@BLUK SETB  1                                                        00620000
         B     &LAB.END      BRANCH AROUND                       88024  00630000
&LAB.LOOK SLR  R15,R15       ZERO IC REGISTER                    88024  00640000
         AIF   ('&STRIP' EQ 'NEVER').NODEBLK                     89152  00650000
&LAB.1   CLI   0(&X),C' '    LOOK FOR NON-BLANK INPUT            88024  00660000
         BNE   &LAB.2        OK                                  88024  00670000
         LA    &X,1(,&X)     SKIP TO NEXT BYTE                          00680000
         CR    &X,&Y         REACHED END OF INPUT BUFFER                00690000
         BNH   &LAB.1        NO, LOOK FOR NON-BLANK              88024  00700000
         BR    R14           RETURN, BUFFER EXHAUSTED                   00710000
         AGO   .YESBLNK                                          88269  00720000
.NODEBLK B     &LAB.2        NO DEBLANKING                       88269  00730000
.YESBLNK ANOP  ,                                                 88269  00740000
&LAB.CHEK CLC  4(0,&Z),0(&X) MATCHING VERB ?                     88024  00750000
&LAB.3   LA    &Z,5(R15,&Z)  BUMP TO NEXT TABLE ENTRY            88024  00760000
&LAB.2   CLI   0(&Z),X'FF'   END OF TABLE ?                      88024  00770000
         BER   R14           YES, VERB NOT FOUND                        00780000
         IC    R15,0(,&Z)    LENGTH - 1  OF TABLE ENTRY                 00790000
         EX    R15,&LAB.CHEK  SAME VERB ?                        88024  00800000
         AIF   ('&ABBR' EQ '').NOABBR                           GP13189 00810000
         BE    &LAB.MAT                                         GP13189 00820000
         LA    R0,1(,R15)    COPY LENGTH                        GP13189 00830000
         SH    R0,=AL2(&ABBR)    SHORTER ALLOWED ?              GP13189 00840000
         BNP   &LAB.3               NO; TRY NEXT                GP13189 00850000
         AIF   ('&FULL' EQ '').LABNKC      SKIP IF NO KEYWORDS  GP13190 00860000
&D       SETC  '&FULL'                                          GP13189 00870000
&D1      SETC  'C'''                                            GP13189 00880000
&D2      SETC  ''''                                             GP13189 00890000
&K       SETA  K'&FULL                                          GP13189 00900000
&J       SETA  1             STRIDE                             GP13189 00910000
         AIF   ('&FULL' EQ '''').LABNKS                         GP13189 00920000
         AIF   (&K LT 3).LABNKS                                 GP13189 00930000
         AIF   ('&D'(1,2) EQ 'X''').HEXSTR       HEX            GP13189 00940000
         AIF   ('&D'(1,2) EQ 'C''').TXTSTR       TEXT           GP13189 00950000
         AIF   ('&D'(1,1) NE '''').LABNKS       PLAIN STRING    GP13189 00960000
&D       SETC  '&D'(2,&K-2)                                     GP13189 00970000
&K       SETA  K'&D                                             GP13189 00980000
         AGO   .LABNKS                                          GP13189 00990000
.TXTSTR  ANOP  ,             TEXT NOTATION   C' '               GP13189 01000000
&D       SETC  '&D'(3,&K-3)                                     GP13189 01010000
&K       SETA  K'&D                                             GP13189 01020000
         AGO   .LABNKS                                          GP13189 01030000
.HEXSTR  ANOP  ,             HEX NOTATION                       GP13189 01040000
&D1      SETC  'X'''                                            GP13189 01050000
&D       SETC  '&D'(3,&K-3)                                     GP13189 01060000
&K       SETA  K'&D                                             GP13189 01070000
&J       SETA  2             STRIDE                             GP13189 01080000
.LABNKS  LA    R1,4(R15,&Z)  POINT TO LAST BYTE OF VERB         GP13189 01090000
&I       SETA  1                                                GP13189 01100000
         AIF   (&K GE &J).LABNKL                                GP13189 01110000
         MNOTE 4,'BLOOK: MALFORMED FULL=&FULL'                  GP13189 01120000
         AGO   .LABNKC                                          GP13189 01130000
.LABNKL  ANOP  ,                                                GP13189 01140000
&D3      SETC  '&D'(&I,&J)                                      GP13189 01150000
         AIF   (&J NE 1 OR ('&D3' NE '''' AND '&D3' NE '&&')).LABNDB    01160000
.*TEST   AIF   ('&D'(&I,&J+1) NE '&D3').LABOOPS                 GP13189 01170000
&I       SETA  &I+1                                             GP13189 01180000
.LABOOPS ANOP  ,             USER ERROR                         GP13189 01190000
&D3      SETC  '&D3'.'&D3'                                      GP13189 01200000
.LABNDB  CLI   0(R1),&D1&D3&D2    SPECIAL?                      GP13189 01210000
         BE    &LAB.3          YES; NO ABBR                     GP13189 01220000
&I       SETA  &I+&J                                            GP13189 01230000
         AIF   (&I LE &K).LABNKL      TRY AGAIN                 GP13189 01240000
.LABNKC  LR    R1,R15                                           GP13189 01250000
&LAB.ALP BCTR  R1,0                                             GP13189 01260000
         EX    R1,&LAB.CHEK  MATCH ?                            GP13189 01270000
         BE    &LAB.MA1        YES; GET OUT                     GP13189 01280000
         BCT   R0,&LAB.ALP   SHORTER ALLOWED ?                  GP13189 01290000
         B     &LAB.3          NO; TRY NEXT                     GP13189 01300000
         AGO   .DOABBR                                          GP13189 01310000
.NOABBR  BNE   &LAB.3        NO, KEEP LOOKING                    88024  01320000
.DOABBR  ANOP  ,                                                GP13189 01330000
&LAB.MA1 LA    R15,1(,R15)   SET FOR CORRECT INPUT POSITION     GP13189 01340000
&LAB.MAT LA    &X,1(R15,&X)  POINT TO FIRST BYTE PAST VERB              01350000
         ICM   R15,7,1(&Z)   LOAD DISPLACEMENT ADDRESS                  01360000
         B     4(,R14)       RETURN FOUND CONDITION                     01370000
&LAB.END DS    0H                                                88024  01380000
.NOTONCE AIF   ('&STRIP' EQ 'NO' OR '&STRIP' EQ 'NEVER').STRIPPD 89152  01390000
         MACPARM R14,&LAB.LOOK,OP=BAL                           GP04234 01400000
         AGO   .REJOIN                                          GP04234 01410000
.STRIPPD AIF   ('&STRIP' EQ 'NEVER').STRIPPR                     89152  01420000
         MACPARM R15,0       CLEAR R15 FIRST                     89152  01430000
.STRIPPR MACPARM R14,&LAB.LOOK,OP=BAL                           GP10164 01440000
.REJOIN  AIF   ('&T' EQ '').NOERR                                       01450000
         AIF   ('&ERR' EQ '*+8' AND '&B' EQ 'A').S6                     01460000
         B     &ERR                                                     01470000
         AGO   .S8                                                      01480000
.S6      B     *+6           SKIP OVER 'BR A'                           01490000
.S8      ANOP                                                           01500000
         AIF   ('&B' EQ '').NOERR                                       01510000
         AIF   ('&B' EQ '*').RELDEF                                     01520000
         AIF   ('&B'(1,1) EQ '(').REL                                   01530000
         AIF   ('&B' EQ 'A').ABS                                        01540000
         MNOTE 8,'B NOT A OR (REG)'                                     01550000
         AGO   .NOERR                                                   01560000
.REL     B     0(&B(1),R15)                                             01570000
         AGO   .NOERR                                                   01580000
.RELDEF  B     &SYSECT.(R15)                                            01590000
         AGO   .NOERR                                                   01600000
.ABS     BR    R15                                                      01610000
.NOERR   MEND  ,                                                        01620000
./ ADD NAME=BSM
         MACRO ,                                                        00010000
&NM      BSM   &R,&A                                   ADDED ON GP04234 00020000
         GBLB  &MVSXA                                           GP08292 00030000
         GBLC  &MODEL                                           GP08292 00040000
.*                                                                      00050000
.*       THIS MODULE GENERATES A BALR FOR COMPATIBILITY                 00060000
.*                                                                      00070000
         AIF   ('&MODEL' EQ '380').BSM                          GP08292 00080000
         AIF   (NOT &MVSXA).OLD                                 GP08292 00090000
.BSM     ANOP  ,                                                GP08292 00100000
&NM      DC    0H'0',AL.4(0,11,&R,&A)   BSM                     GP08292 00110000
         MEXIT ,                                                        00120000
.OLD     AIF   ('&R(1)' EQ '0' OR '&R(1)' EQ 'R0').BR           GP08292 00130000
         AIF   ('&A(1)' EQ '0' OR '&A(1)' EQ 'R0').SETAM        GP10159 00140000
&NM      MACPARM MODE=LBL                                       GP08292 00150000
         MEXIT ,                                                GP08292 00160000
.SETAM   ANOP  ,                                                GP10159 00170000
&NM      LA    &R,0(,&R)     CLEAN HIGH BYTE (AM24)             GP10159 00180000
         MEXIT ,                                                GP10159 00190000
.BR      ANOP  ,                                                GP08292 00200000
&NM      BR    &A                                                       00210000
         MEND  ,                                                        00220000
./ ADD NAME=BTAB
         MACRO                                                          00010000
&NM      BTAB  &STRING,&TO,&XCT,&S,&BASE=                               00020000
         GBLC  &CRT                                                     00030000
         GBLC  &TABMBAS,&TABMOPT                                        00040000
         GBLC  &PFKEY(52),&PFKEX(52)                             88211  00050000
         GBLA  &#PFKEY                                           88211  00060000
         LCLC  &TEXT                                             88211  00070000
         LCLA  &I,&J,&K,&L                                              00080000
&K       SETA  K'&STRING-1                                              00090000
         AIF   ('&STRING' EQ '').PARMA                                  00100000
         AIF   ('&STRING'(1,1) NE '''').COMLEN                          00110000
&I       SETA  2                                                        00120000
&J       SETA  &K-1                                                     00130000
&K       SETA  &J                                                       00140000
.LOOP    AIF   ('&STRING'(&I,2) EQ '''''').SK2                          00150000
         AIF   ('&STRING'(&I,2) EQ '&&').SK2                            00160000
&I       SETA  &I+1                                                     00170000
         AGO   .INC                                                     00180000
.SK2     ANOP                                                           00190000
&I       SETA  &I+2                                                     00200000
&K       SETA  &K-1                                                     00210000
.INC     AIF   (&I LE &J).LOOP                                          00220000
&K       SETA  &K-1                                                     00230000
         AIF   (&K GE 0).COMLEN                                         00240000
&K       SETA  0                                                        00250000
.COMLEN  AIF   ('&BASE' EQ '').NBAS                                     00260000
         AIF   ('&BASE' NE '*').UBAS                                    00270000
&TABMBAS SETC  '&SYSECT'                                                00280000
         AGO   .NBAS                                                    00290000
.UBAS    ANOP                                                           00300000
&TABMBAS SETC  '&BASE'                                                  00310000
.NBAS    AIF   ('&TABMBAS' NE '').BASOK                                 00320000
&TABMBAS SETC  'EXHBCOMM' .   DEFAULT BASE CSECT                        00330000
.BASOK   ANOP                                                           00340000
         AIF   ('&STRING' EQ '*END').LAST                               00350000
         AIF   ('&TO' NE '' AND '&XCT' EQ '' AND '&S' EQ '').TO         00360000
         AIF   ('&TO' EQ '' AND '&XCT' NE '' AND '&S' EQ '').XCT        00370000
         AIF   ('&TO' EQ '' AND '&XCT' EQ '' AND '&S' NE '').S          00380000
.PARMA   MNOTE 8,'MISSING OR CONFLICTING PARAMETERS'                    00390000
         MEXIT                                                          00400000
.BADBASE MNOTE 8,'INCORRECT BASE PARAMETER'                             00410000
         MEXIT                                                          00420000
.TO      AIF   ('&TABMOPT' EQ '' OR '&TABMOPT' EQ 'TO').TOTO            00430000
.NONO    MNOTE 8,'INCORRECT MACRO NAME, OR PREVIOUS *END MISSING'       00440000
         MEXIT                                                          00450000
.TOTO    ANOP                                                           00460000
&TABMOPT SETC  'TO'                                                     00470000
         AIF   ('&STRING'(1,1) EQ '*').SPEC                             00480000
         AIF   ('&STRING'(1,1) EQ '''').TOAP                            00490000
&NM      DC    AL1(&K),AL3(&TO-(&TABMBAS)),C'&STRING'                   00500000
         MEXIT                                                          00510000
.TOAP    ANOP                                                           00520000
&NM      DC    AL1(&K),AL3(&TO-(&TABMBAS)),C&STRING                     00530000
         MEXIT                                                          00540000
.XCT     AIF   ('&TABMOPT' NE '' AND '&TABMOPT' NE 'XCT').NONO          00550000
&TABMOPT SETC  'XCT'                                                    00560000
         AIF   ('&STRING'(1,1) EQ '*').SPEC                             00570000
         AIF   ('&STRING'(1,1) EQ '''').XAP                             00580000
&NM      DC    AL1(&K),CL3'&XCT',C'&STRING'                             00590000
         MEXIT                                                          00600000
.XAP     ANOP                                                           00610000
&NM      DC    AL1(&K),CL3'&XCT',C&STRING                               00620000
         MEXIT                                                          00630000
.S       AIF   ('&TABMOPT' NE '' AND '&TABMOPT' NE 'S').NONO            00640000
&TABMOPT SETC  'S'                                                      00650000
         AIF   ('&STRING'(1,1) EQ '''').SAP                             00660000
         AIF   ('&STRING'(1,1) EQ '*').SPEC                             00670000
&NM      DC    AL1(&K,0),SL2(&S),C'&STRING'                             00680000
         MEXIT                                                          00690000
.SAP     ANOP                                                           00700000
&NM      DC    AL1(&K,0),SL2(&S),C&STRING                               00710000
         MEXIT                                                          00720000
.SPEC    AIF   ('&STRING' EQ '*').PARMA                                 00730000
         PFKEYS ,            INVOKE PFK HEX EQUIVALENTS          88211  00740000
&TEXT    SETC  '&STRING'(2,&K)                                          00750000
&I       SETA  0                                                        00760000
.SPLP    AIF   (&I GE &#PFKEY).SPHEX                             88211  00770000
&I       SETA  &I+1                                                     00780000
         AIF   ('&TEXT' NE '&PFKEY(&I)').SPLP                    88211  00790000
&TEXT    SETC  '&PFKEX(&I)'                                      88211  00800000
&K       SETA  0                                                        00810000
         AIF   ('&CRT' EQ '3270' OR '&CRT' EQ '').HEXT          GP04045 00820000
         AIF   ('&NM' EQ '').MEND   SKIP IF NOT 3270                    00830000
&NM      EQU   * .           PLANT A LABEL - NO 3270 CODE EXPANDED      00840000
.MEND    MEXIT                                                          00850000
.SPHEX   ANOP                                                           00860000
&I       SETA  0                                                        00870000
.SPHL    AIF   (&I GE &K).SPHEXS                                        00880000
&I       SETA  &I+1                                                     00890000
&J       SETA  1                                                        00900000
.SPHLD   AIF   ('&TEXT'(&I,1) EQ '0123456789ABCDEF'(&J,1)).SPHL         00910000
&J       SETA  &J+1                                                     00920000
         AIF   (&J GT 16).PARMA                                         00930000
         AGO   .SPHLD                                                   00940000
.SPHEXS  ANOP                                                           00950000
&K       SETA  (&K-1)/2                                                 00960000
.HEXT    AIF   ('&TABMOPT' EQ 'TO').HEXTO                               00970000
         AIF   ('&TABMOPT' EQ 'XCT').HEXCT                              00980000
&NM      DC    AL1(&K,0),SL2(&S),X'&TEXT'                               00990000
         MEXIT                                                          01000000
.HEXCT   ANOP                                                           01010000
&NM      DC    AL1(&K),CL3'&XCT',X'&TEXT'                               01020000
         MEXIT                                                          01030000
.HEXTO   ANOP                                                           01040000
&NM      DC    AL1(&K),AL3(&TO-(&TABMBAS)),X'&TEXT'                     01050000
         MEXIT                                                          01060000
.LAST    ANOP                                                           01070000
&TABMOPT SETC  ''                                                       01080000
&NM      DC    X'FF' .       END OF TABLE                               01090000
         MEND                                                           01100000
./ ADD NAME=BUILDCDE
         MACRO                                                          00010000
&REF     BUILDCDE &LENGTH=,&ADDR=,&EP=,&SYS=MVS,&LIST=(1)       GP06320 00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.* MACRO NAME = BUILDCDE                                              * 00050000
.*                                                                    * 00060000
.* DESCRIPTIVE NAME = BUILD A MAJOR CDE TO IDENTIFY A STORAGE AREA    * 00070000
.*                                                                    * 00080000
.* FUNCTION = MAKES A STORAGE AREA EASIER TO LOCATE IN A              * 00090000
.*            DUMP BY MAKING IT APPEAR AS A LOAD_MODULE.              * 00100000
.*                                                                    * 00110000
.* STATUS = R200                                                      * 00120000
.*                                                                    * 00130000
.* AUTHOR = GILBERT SAINT-FLOUR <GSF@POBOX.COM>                       * 00140000
.*                                                                    * 00150000
.* ENVIRONMENT = SEE BELOW                                            * 00160000
.*                                                                    * 00170000
.*     AMODE = ANY                                                    * 00180000
.*     SCP   = MVS/XA OR MVS/ESA   |  MVS 3.8J WITH SYS=MVS           * 00190000
.*     KEY   = USER                                                   * 00200000
.*     MODE  = PROBLEM                                                * 00210000
.*     APF   = OFF                                                    * 00220000
.*                                                                    * 00230000
.* OPERATION = BUILDCDE USES THE "LOADER" FORM OF IDENTIFY TO CREATE  * 00240000
.*             A MAJOR CDE AND CORRESPONDING XL, THEN ISSUES A LOAD   * 00250000
.*             SVC TO CREATE AN LLE AND ASSOCIATE THE CDE WITH THE    * 00260000
.*             CURRENT TCB.                                           * 00270000
.*                                                                    * 00280000
.* INVOCATION = SEE BELOW                                             * 00290000
.*                                                                    * 00300000
.*          (BEFORE)     GETMAIN RU,LV=20000                          * 00310000
.*                                                                    * 00320000
.*          (AFTER)      GETMAIN RU,LV=20000                          * 00330000
.*                       BUILDCDE LENGTH=(0),ADDR=(1),EP=DYNAM        * 00340000
.*                                                                    * 00350000
.* NOTES = SEE BELOW                                                  * 00360000
.*                                                                    * 00370000
.*        BUILDCDE MAY BE ISSUED MORE THAN ONCE, PROVIDED THE EP      * 00380000
.*        KEY-WORD HAS A DIFFERENT VALUE EACH TIME.                   * 00390000
.*                                                                    * 00400000
.*        IF STORAGE WAS ALLOCATED IN SUB-POOL ZERO (SP=0 IS          * 00410000
.*        SPECIFIED OR DEFAULTED TO IN THE GETMAIN MACRO),            * 00420000
.*        THE DELETE MACRO MAY BE ISSUED AGAINST THE SPECIFIED EP     * 00430000
.*        TO DELETE THE CDE AND FREE UP THE STORAGE.                  * 00440000
.*                                                                    * 00450000
.*        IF GETMAIN SPECIFIES A NON-ZERO SUBPOOL, THE DELETE MACRO   * 00460000
.*        DELETES THE CDE BUT DOES NOT FREE UP THE STORAGE:  YOU      * 00470000
.*        MUST ISSUE FREEMAIN YOURSELF.                               * 00480000
.*                                                                    * 00490000
.*        IN A MAJOR CDE CREATED BY THE "LOADER" FORM OF IDENTIFY,    * 00500000
.*        THE "RENT" AND "REUS" ATTRIBUTES ARE OFF.  THIS MEANS       * 00510000
.*        THAT YOU MAY NOT ISSUE LOAD AGAINST THE EP NAME (BUILDCDE   * 00520000
.*        HAS ALREADY ISSUED LOAD), BUT YOU MAY ISSUE LINK, ATTACH    * 00530000
.*        OR XCTL IF YOU WANT TO (ONCE ONLY).  YOU MAY ALSO ISSUE     * 00540000
.*        THE STANDARD FORM OF IDENTIFY TO DEFINE SECONDARY ENTRY     * 00550000
.*        POINTS WHICH HAVE THE "RENT" ATTRIBUTE.                     * 00560000
.*                                                                    * 00570000
.*        IF THIS MACRO IS USED BY AN AUTHORIZED PROGRAM, THEN        * 00580000
.*        A S306 ABEND WILL OCCUR (THE CDE CREATED HAS ITS CDSYSLIB   * 00590000
.*        BIT OFF).  LOOK FOR A SECOND VERSION OF THE MACRO THAT MAY  * 00600000
.*        BE USED IN AN AUTHORIZED PROGRAM AT THE END OF THIS JOB.    * 00610000
.*                                                                    * 00620000
.*        THE IDENTIFY MACRO SUPPLIED IN SYS1.MACLIB SUPPORTS THE     * 00630000
.*        "LOADER" FORM, BUT THE FORMAT OF THE PARAMETER LIST IS      * 00640000
.*        NOT DOCUMENTED, AS FAR AS I KNOW.  THE RETURN CODES X'18'   * 00650000
.*        OR X'1C' MAY BE RETURNED IN R15 WHEN THE PARAMETER LIST     * 00660000
.*        IS INVALID.  THESE RETURN CODES ARE DOCUMENTED ALONG WITH   * 00670000
.*        THE IDENTIFY MACRO.                                         * 00680000
.*                                                                    * 00690000
.*        WHEN THE LOAD-LIST IS EMPTY (I.E. NO LOAD HAS BEEN ISSUED   * 00700000
.*        FOR THIS TCB YET), IDENTIFY FAILS WITH A RETURN CODE 12.    * 00710000
.*        THIS CAN BE CIRCUMVENTED BY ISSUING THE FOLLOWING SEQUENCE: * 00720000
.*                                                                    * 00730000
.*                       LOAD    EP=IEFBR14                           * 00740000
.*                       GETMAIN RU,LV=20000                          * 00750000
.*                       BUILDCDE LENGTH=(0),ADDR=(1),EP=DYNAM        * 00760000
.*                       DELETE  EP=IEFBR14                           * 00770000
.*                                                                    * 00780000
.*        I'VE NOTICED THAT ON MVS SYSTEMS PRIOR TO MVS/ESA 4.3, THE  * 00790000
.*        "LOADER" FORM OF IDENTIFY RETURNS THE ADDRESS OF THE CDE IT * 00800000
.*        CREATED IN REG1.  IN MVS/ESA 4.3 THIS IS NO LONGER TRUE.    * 00810000
.*                                                                    * 00820000
.********************************************************************** 00830000
.*     CORRECTIONS AND CHANGES BY GERHARD POSTPISCHIL  2006-11-15     * 00840000
.*        BY DEFAULT, BUILDCDE USES THE GETMAINED AREA TO BUILD THE   * 00850000
.*          IDENTIFY LIST. IF YOU USE THIS AREA BETWEEN THE GETMAIN   * 00860000
.*          AND BUILDCDE (E.G., SAVE AREA, OR INIT TO ZERO) THEN      * 00870000
.*          USE LIST= FOR AN ALTERNATE LIST ADDRESS. FOR EXAMPLE,     * 00880000
.*          TRY LIST=20(R13) - USE ANY RS FORMAT ADDRESS LENGTH 32    * 00890000
.*                                                                    * 00900000
.*        RETROFIT TO FUNCTION CORRECTLY UNDER MVS 3.8J (SYS=MVS)     * 00910000
.*        CHANGE TO ASSEMBLE UNDER ASM/XF                             * 00920000
.********************************************************************** 00930000
         LCLA  &O16                    OFFSETS IN PARM LIST     GP06320 00940000
&O16     SETA  16                      OFFSET TO EXTENT LIST    GP06320 00950000
         AIF   ('&SYS' NE 'MVS').NEWSYS                         GP06320 00960000
&O16     SETA  12                      OFFSET TO EXTENT LIST    GP06320 00970000
.NEWSYS  ANOP  ,                       XA, ESA, .....           GP06320 00980000
&REF     IHBINNRA &ADDR,&LENGTH        SET R0,R1                        00990000
         LR    R15,R1                  PRESERVE ENTRY ADDRESS   GP06320 01000000
         IHBINNRA &LIST                SET LIST ADDRESS INTO R1 GP06320 01010000
         ST    R15,0(,R1)              STORE ENTRY-POINT ADDR   GP06320 01020000
         ST    R15,&O16+12(,R1)        ALSO AS LOAD ADDRESS     GP06320 01030000
         MVC   4(8,R1),=CL8'&EP '      CDNAME                   GP06320 01040000
         AIF   ('&SYS' EQ 'MVS').OLDSYS   SHORTER LIST IN 3.8   GP06320 01050000
         XC    12(4,R1),12(R1)         CLEAR BYTES 12-15                01060000
.OLDSYS  LA    R14,16                  LENGTH OF PSEUDO XL      GP06320 01070000
         LA    R15,1                   NUMBER OF RELOCATION FACTORS     01080000
         STM   R14,R0,&O16.(R1)        FORMAT BYTES 16-23       GP06320 01090000
         MVI   &O16+8(R1),X'80'        END OF LIST              GP06320 01100000
         MNOTE *,'       IDENTIFY MF=(E,(R1))'                          01110000
         SLR   R0,R0                   LOADER-TYPE IDENTIFY             01120000
         SVC   41                      ISSUE IDENTIFY SVC               01130000
         LR    R14,R1                  PASS CDE ADDRESS                 01140000
         MNOTE *,'       LOAD EP=&EP,DCB=0'                             01150000
         LA    R0,=CL8'&EP '           POINT TO EP NAME         GP06320 01160000
         SLR   R1,R1                   NO DCB FOR LOAD                  01170000
         SVC   8                       ISSUE LOAD SVC                   01180000
         LR    R1,R0                   EP ADDRESS IN R1                 01190000
         SLR   R0,R0                                                    01200000
         ICM   R0,B'0111',&O16+9(R1)  LENGTH IN R0              GP06320 01210000
         MEND                                                           01220000
./ ADD NAME=CATCALL
         MACRO ,                                                        00010000
&NM      CATCALL &FUN,&ARG,&PFX=CSP,&MODE=(V,BASSM),&PARM=PARM          00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*  CATCALL - USED TO INVOKE THE SUBCAT SERVICE FOR SIMPLE AND        * 00050000
.*    MASKED CATALOG LOOKUP. 'FUN' IS LOOK (SINGLE REQUEST),          * 00060000
.*    INIT, THEN LOOP, FOR MASKED REQUEST, CLOSE TO FREE STORAGE.     * 00070000
.*                                                                    * 00080000
.*--------------------------------------------------------------------* 00090000
         GBLB  &MACPNUL,&MVSXA                                          00100000
         GBLC  &MACPLAB                                                 00110000
         LCLA  &I,&J,&K                                                 00120000
         LCLC  &C,&D,&E,&SUBNM                                          00130000
&SUBNM   SETC  'UBICF'       ICF CATALOG INTERFACE                      00140000
         AIF   (&MVSXA).SYSXA  AT LEAST MVS XA ?                        00150000
&SUBNM   SETC  'UBCAT'       VSAM & CVOL CATALOG INTERFACE              00160000
.SYSXA   ANOP  ,                                                        00170000
&MACPLAB SETC  '&NM'                                                    00180000
&C       SETC  '&FUN'.'    '                                            00190000
&C       SETC  '&C'(1,4)                                                00200000
&J       SETA  1                                                        00210000
.FUNLOOP AIF   ('&C' EQ 'CLOSLOOKINITLOOP'(&J,4)).HAVEFUN               00220000
&J       SETA  &J+4                                                     00230000
         AIF   (&J LT 16).FUNLOOP                                       00240000
&J       SETA  0                                                GP09149 00250000
         AIF   ('&C' EQ 'END ').HAVEFUN    ALTERNATE FOR CLOSE  GP09149 00260000
         MNOTE 8,'CATCALL: INVALID FUNCTION REQUEST &FUN'               00270000
.HAVEFUN MACPARM &PFX.$REQ,&J/4,OP=MVI                                  00280000
         MACPARM R14,&ARG,NULL=SKIP                                     00290000
         AIF   (&MACPNUL).NOARG                                         00300000
         MACPARM R14,&PFX.@REQ,OP=ST                                    00310000
.NOARG   AIF   ('&MODE(1)' EQ '').DOV                                   00320000
         AIF   ('&MODE(1)' NE 'V').NOTV                                 00330000
.DOV     MACPARM R15,=V(&SUBNM),OP=L                                    00340000
         O     R15,=X'80000000'    GET HIGH                             00350000
         AGO   .INVOKE                                                  00360000
.NOTV    AIF   ('&MODE(1)' NE 'A').NOTA                                 00370000
         MACPARM R15,=A(&SUBNM),OP=L                                    00380000
         O     R15,=X'80000000'    GET HIGH                             00390000
         AGO   .INVOKE                                                  00400000
.NOTA    AIF   ('&MODE(1)' NE '@').NOTD                                 00410000
         MACPARM R15,@&SUBNM,OP=L                                       00420000
         AGO   .INVOKE                                                  00430000
.NOTD    MNOTE 8,'CATCALL: LOAD ADDRESS MODE &MODE(1) NOT RECOGNIZED'   00440000
.INVOKE  MACPARM R1,&PFX.&PARM,NULL=SKIP  PASS WORK AREA                00450000
         AIF   (&MVSXA).AM31  NEWFLANGLED 370 INSTRUCTIONS              00460000
&C       SETC  'BALR'                                                   00470000
&E       SETC  'R14'         RETURN REGISTER                            00480000
         AIF   (N'&MODE LE 1).REGOP2                                    00490000
&D       SETC  '&MODE(2)'                                               00500000
         AIF   ('&D' EQ 'BAKR' OR '&D' EQ 'BASSM').REGOP2               00510000
         AIF   ('&D' EQ 'BASR' OR '&D' EQ 'BALR').REGOP2                00520000
         AIF   ('&D' EQ 'BSM').REGOP2                                   00530000
         AGO   .BADMODE                                                 00540000
.AM31    ANOP  ,                                                        00550000
&C       SETC  'BAKR'                                                   00560000
&E       SETC  '0'           NO RETURN REGISTER                         00570000
         AIF   ('&D' EQ 'BAKR').REGOP2                                  00580000
&C       SETC  'BASSM'                                                  00590000
&E       SETC  'R14'         RETURN REGISTER                            00600000
         AIF   (N'&MODE LE 1).REGOP2                                    00610000
&D       SETC  '&MODE(2)'                                               00620000
         AIF   ('&D' EQ 'BASSM').REGOP2                                 00630000
&C       SETC  'BSM'                                                    00640000
         AIF   ('&D' EQ 'BSM').REGOP2                                   00650000
&C       SETC  'BASR'                                                   00660000
         AIF   ('&D' EQ 'BASR').REGOP2                                  00670000
&C       SETC  'BALR'                                                   00680000
         AIF   ('&D' EQ 'BALR').REGOP2                                  00690000
.BADMODE MNOTE 8,'CATCALL: BRANCH TYPE MODE &D NOT RECOGNIZED'          00700000
.REGOP2  MACPARM R14,(R15),OP=&C,OPR=&C                                 00710000
         MEND  ,                                                        00720000
./ ADD NAME=CATSCAT
         MACRO ,                                                        00010000
&NM      CATSCAT &PFX=CSC,&DSECT=YES                                    00020001
         AIF   ('&DSECT' NE 'YES').ALTSECT                              00030002
&PFX.DSECT DSECT ,                                                      00040002
         AGO   .NODSECT ,                                               00050002
.ALTSECT ANOP  ,                                                        00060002
&PFX.DSECT  DS 0D            PLANT A LABEL                              00070002
.NODSECT AIF   (T'&NM EQ 'O').NOLABEL                                   00080001
&NM      DS    0F                                                       00090001
.NOLABEL ANOP  ,                                                        00100001
&PFX.LINK  DS  A             LINK TO NEXT ELEMENT                       00110000
&PFX.NAME  DS  CL44          NAME                                       00120000
&PFX.CAX   DS  A             ADDRESS OF CAX OR 0                        00130003
&PFX.FLGS  DS  X             PROCESSING FLAG                            00140003
&PFX.FGUS  EQU X'80'           ENTRY WAS USED (IN MULTIPLE CAT SEARCH)  00150004
           DS  X             RESERVED                                   00160003
           DS  X             RESERVED                                   00170003
           DS  X             RESERVED                                   00180003
           DS  X             RESERVED                                   00190003
&PFX.SIZE  EQU  *-&PFX.LINK  AREA SIZE                                  00200000
         MEND  ,                                                        00210000
./ ADD NAME=CATSPARM
         MACRO ,                                                        00010000
&NM      CATSPARM &PFX=CSP,&DSECT=YES                                   00020001
         AIF   ('&DSECT' NE 'YES').ALTSECT                              00030004
&PFX.DSECT DSECT ,                                                      00040000
         AGO   .NODSECT ,                                               00050004
.ALTSECT ANOP  ,                                                        00060004
&PFX.DSECT  DS 0D            PLANT A LABEL                              00070004
.NODSECT AIF   ('&NM' EQ '').NOLABEL                                    00080003
&NM      DS    0F                                                       00090001
.NOLABEL AIF   ('&NM' EQ '&PFX'.'PARM').NOLPARM                         00100009
&PFX.PARM   DS 0F            DEFINE START OF PARM                       00110009
.NOLPARM ANOP  ,                                                        00120009
&PFX.@WORK  DC A(0)          ADDRESS OF DYNAMIC WORK AREA               00130000
&PFX.@SCAT  DC A(0)          ADDRESS OF LOADED SUBCAT ROUTINE           00140020
&PFX.@SCMP  DC A(0)          ADDRESS OF LOADED SUBCOMP ROUTINE          00150020
&PFX.#SP    DC AL1(0)        WORK AREA SUBPOOL                          00160000
&PFX.#SPL   DC AL3(0)        WORK AREA SIZE GOTTEN                      00170000
&PFX.#LEN   DC H'0'          ZERO OR LENGTH OF REQUEST NAME             00180000
&PFX.$FLGS  DC X'00'         PROCESSING FLAGS                           00190000
&PFX.$FGCP  EQU X'80'          APPLY COMPARE MASK                       00200010
&PFX.$FGUC  EQU X'40'          USER SUPPLIED CATALOG NAME (IN ...RCAT)  00210017
&PFX.$FG1C  EQU X'20'          LIMIT TO ONE CATALOG                     00220017
&PFX.$FGMC  EQU X'10'          CALLER HAS ALTERED MASK                  00230018
&PFX.$FULL  EQU X'01'          RETURN ERROR INFORMATION, CATALOGS,...   00240011
&PFX.$REQ   DC X'00'         REQUEST (0-CLOSE; 1-LOOKUP; 2-INITLOOP*    00250000
*                              3-NEXT ENTRY)                            00260002
&PFX.$RFX   EQU X'00'          CLOSE AND FREEMAIN                       00270002
&PFX.$RF1   EQU X'01'          SINGLE DSN LOOKUP                        00280002
&PFX.$RFI   EQU X'02'          INITIATE NULTIPLE LOOKUP                 00290002
&PFX.$RFN   EQU X'03'          GET NEXT ENTRY                           00300002
.*                                                                      00310002
&PFX.@REQ   DC A(0)          LOOK/INIT: ITEM ADDRESS                    00320007
&PFX.RCOD   DC F'0'          RETURN CODE                                00330006
&PFX.REAS   DC F'0'          REASON CODE                                00340019
&PFX.@RAW   DC A(0)          ADDRESS OF THE RAW DATA            GP03042 00350016
&PFX.#RAW   DC A(0)          LENGTH OF THE RAW DATA             GP03042 00360017
&PFX.MASK   DC CL44' '       DSN MASK FOR LOOP REQUEST                  00370018
&PFX.MVOL   DC CL6' '        VOL MASK FOR LOOP REQUEST          GP03043 00380018
&PFX.RCAT   DC CL44' '       CATALOG FOUND IN                           00390007
&PFX.RTYP   DC CL01' '  1/2  RETURNED ENTRY TYPE CODE           GP03042 00400013
&PFX.RTYN   DC CL07' '  2/2  RETURNED ENTRY TYPE NAME/ABBREV    GP03042 00410013
&PFX.RDSN   DC CL44' '       RETURNED DSNAME                            00420000
&PFX.#VOL   DC X'0'          RETURNED NO. OF VOLUMES                    00430000
&PFX.RDTYS  DC 0XL(5*4)'0'   RETURNED DEVICE TYPE(S)                    00440014
&PFX.RDTY   DC 5XL4'0'         RETURNED DEVICE TYPE(S)                  00450014
&PFX.RVOLS  DC 0CL(5*6)' '   RETURNED VOLUME SERIAL(S)                  00460014
&PFX.RVOL   DC 5CL6' '         RETURNED VOLUME SERIAL(S)                00470014
&PFX.RDAC   DC CL08' '       DATA CLASS                                 00480000
&PFX.RMGC   DC CL08' '       MANAGEMENT CLASS                           00490000
&PFX.RSTC   DC CL08' '       STORAGE CLASS                              00500000
&PFX.RGRP   DC CL08' '       SMS GROUP                                  00510000
&PFX.ASTYP  DC CL(2*1)' '    ASSOCIATED TYPES                           00520015
&PFX.ASSOC  DC 0CL(2*44)' '  ASSOCIATED NAMES                           00530014
&PFX.ASSO1  DC CL44' '         FIRST NAME (DATA FOR CLUSTER)            00540012
&PFX.ASSO2  DC CL44' '         SECOND NAME (INDEX FOR CLUSTER)          00550012
&PFX.SIZE  EQU  *-&PFX.PARM   AREA SIZE                                 00560009
&PFX.XCLR  EQU  &PFX.#LEN,*-&PFX.#LEN,X'00'  AREA TO CLEAR              00570022
         MEND  ,                                                        00580000
./ ADD NAME=CATSWORK
         MACRO ,                                                        00010000
&NM      CATSWORK &PFX=CSW,&DSECT=YES                                   00020001
         AIF   ('&DSECT' NE 'YES').ALTSECT                              00030002
&PFX.DSECT DSECT ,                                                      00040002
         AGO   .NODSECT ,                                               00050002
.ALTSECT ANOP  ,                                                        00060002
&PFX.DSECT  DS 0D            PLANT A LABEL                              00070002
.NODSECT AIF   (T'&NM EQ 'O').NOLABEL                                   00080001
&NM      DS    0F                                                       00090001
.NOLABEL ANOP  ,                                                        00100001
&PFX.SAVE   DC 18A(0)        MAIN OS SAVE AREA                          00110000
&PFX.SAV1   DC 18A(0)        INTERNAL SUBROUTINE SAVE AREA              00120000
&PFX.SAV2   DC 18A(0)        INTERNAL SUBROUTINE SAVE AREA              00130000
&PFX.DB     DC D'0'          WORK AREA                                  00140003
&PFX.@CAHD  DC A(0)          HEAD OF CATALOG NAME LIST                  00150003
&PFX.@CATL  DC A(0)          ADDRESS OF LAST ALLOCATED ELEMENT          00160000
&PFX.@CAMS  DC A(0)          ADDRESS OF ENTRY FOR MASTER CATALOG        00170011
&PFX.#MASK  DC F'0'          LENGTH OF MASK                             00180000
&PFX.#CCOD  DC F'0'          PROGRAM RETURN CODE                        00190003
&PFX.@CSI   DC A(0)          ADDRESS OF IGGCSI00                        00200000
&PFX.@CPRM  DC 3A(0)         CSI CALL PARAMETER                         00210000
&PFX.@CBXL  DC 3A(0)         CSI RETURN SCANNING                        00220000
&PFX.@CRTN  DC A(0)          RETURN CODE                                00230000
&PFX.@FORM  DC A(0)          ADDRESS OF EXTRACTION ROUTINE              00240003
&PFX.@FLD   DC A(0)          ADDRESS OF FORMATTING ROUTINE              00250007
         SPACE 1                                                        00260000
&PFX.MSCAT  DC CL44' '       MASTER CATALOG                             00270000
&PFX.CUCAT  DC CL44' '       CURRENT CATALOG NAME (FROM CSI)            00280000
&PFX.DACLS  DC CL8' '        DATA SET CLASS                             00290000
&PFX.MGCLS  DC CL8' '        MANAGEMENT CLASS                           00300000
&PFX.STCLS  DC CL8' '        STORAGE CLASS                              00310000
&PFX.FDLEN  DC F'0'          LENGTH OF CSI FIELD LENGHTS                00320000
&PFX.CULEN  DC F'0'          LENGTH OF CURRENT CSI ENTRY                00330000
&PFX.PFLGS  DC X'00'         MISCELLANEOUS FLAGS                        00340000
&PFX.PFCSI  EQU  X'80'          IGGCSI00 LOADED                         00350000
&PFX.PFCMP  EQU  X'40'          WE LOADED SUBCOMP ROUTINE               00360010
&PFX.PFMST  EQU  X'20'          FIRST CATALOG PROCESS - STACK OTHERS    00370010
&PFX.PFLUK  EQU  X'10'          LOOK OR NON-LOOP REQUEST                00380006
&PFX.PFBUF  EQU  X'08'          LOOP INITIATED                          00390006
&PFX.PF1CT  EQU  X'04'          ONE CATALOG ONLY                        00400006
&PFX.PFCT1  EQU  X'02'          FIRST CATALOG FOUND                     00410006
&PFX.PFONE  EQU  X'01'          AT LEAST ONE MATCHED ENTRY              00420000
         SPACE 1                                                        00430003
*   SUBCOMP PARAMETER LIST PASSED                                       00440003
*                                                                       00450000
&PFX.CMPRM  DC A(CSWCMMSK,CSW@CFLT,CSPMASK,CSWCM@WK)                    00460000
&PFX.CM@WK  DC A(0)          ADDRESS OFGETMAINED WORK AREA              00470000
&PFX.CMMSK  DC C'MSK'        EXAMINE MASK                               00480000
&PFX.CMDSN  DC C'DSN'        COMPARE DSN TO MASK                        00490000
&PFX.CMVOL  DC C'VOL'        COMPARE VOLSER MASK                        00500000
&PFX.CIMSK  DC CL44' '       MASK REWORKED FOR CSI CALLS                00510000
&PFX.CIVMS  DC CL6' ',CL2' '    REFERENCED VOLUME (COMPARE PAD)         00520000
&PFX.CIVTS  DC CL6' ',CL2' '    VOLUME SERIAL FOR COMPARE               00530000
         SPACE 1                                                        00540003
*   IGGCSI00 PARAMETER LIST PASSED                                      00550003
*                                                                       00560003
&PFX.@CFLD  DS 0F        CSI REQUEST AREA                               00570003
&PFX.@CFLT  DC CL44' '       (MAJOR) KEY                                00580003
&PFX.@CCAT  DC CL44' '       CATALOG NAME OR BLANKS                     00590003
&PFX.@CRES  DC CL44' '       ..RESUME DATA..                            00600003
&PFX.@CTYP  DC 16C' '        ENTRY TYPE SELECTION. BLANK FOR ALL        00610003
&PFX.@COPT  DC 0CL4' '     CSI OPTIONS                                  00620003
&PFX.@CODI  DC C' '          ..RETURN DATA OR INDEX, OR BLANKS..        00630003
&PFX.@CORS  DC C' '          ..RESUME..                                 00640003
&PFX.@CO1C  DC C' '          Y - SEARCH ONE CATALOG ONLY; BLANK - ALL   00650003
&PFX.@CORV  DC C' '                                                     00660003
&PFX.@C#EN  DC HL2'0'        NUMBER OF FIELD NAMES                      00670003
&PFX.@C$EN  DC (PATFIENM)CL8' '   NAME1, NAME2, .....                   00680003
&PFX.SIZE  EQU  *-&PFX.SAVE  AREA SIZE                                  00690000
         MEND  ,                                                        00700000
./ ADD NAME=CLRL
         MACRO ,                                                        00010000
&NM      CLRL  &A,&LN,&WORK1=14,&WORK2=0,&FILL=,&OPLEN=LA        84254  00020000
.*--------------------------------------------------------------------* 00030000
.*  CLEAR AN AREA OF ANY LENGTH USING MVCL (WAS MVC ON 360)           * 00040000
.*--------------------------------------------------------------------* 00050000
         LCLA  &K                                                       00060000
         LCLC  &W1E,&W1O,&W2E,&W2O                                      00070000
         LCLC  &L                                               GP03093 00080000
&L       SETC  'L'''                                            GP03093 00090000
.*                                                                      00100000
         AIF   (T'&A EQ 'O').BADA                                       00110000
.*USE L*  AIF   (T'&LN EQ 'O').BADLN                                    00120000
         AIF   (N'&A NE 1).BADA                                         00130000
.*USE L*  AIF   (N'&LN NE 1).BADLN                                      00140000
.*                                                                      00150000
         AIF   (T'&WORK1 EQ 'O').BADW1                                  00160000
         AIF   (T'&WORK2 EQ 'O').BADW2                                  00170000
         AIF   (N'&WORK1 NE 1).BADW1                                    00180000
         AIF   (N'&WORK2 NE 1).BADW2                                    00190000
.*                                                                      00200000
&W1E     SETC  '&WORK1(1)'                                              00210000
&W1O     SETC  '&W1E'.'+1'                                              00220000
&W2E     SETC  '&WORK2(1)'                                              00230000
&W2O     SETC  '&W2E'.'+1'                                              00240000
&NM      MACPARM &W1E,&A                                                00250000
         MACPARM &W1O,&LN,NULL=&L&A,OP=&OPLEN                   GP03093 00260000
         MACPARM &W2O,0      CLEAR SOURCE LENGTH                        00270000
         AIF   (T'&FILL EQ 'O').NOFILL                                  00280000
         AIF   ('&FILL' EQ '0').NOFILL                                  00290000
&K       SETA  K'&FILL                                                  00300000
         AIF   ('&FILL'(&K,1) EQ '''' OR '&FILL'(&K,1) EQ ')').FILLICM  00310000
         ICM   &W2O,8,=AL1(&FILL)                                       00320000
         AGO   .NOFILL                                                  00330000
.FILLICM ICM   &W2O,8,=&FILL                                            00340000
.NOFILL  MVCL  &W1E,&W2E     CLEAR THE AREA                             00350000
         MEXIT ,                                                        00360000
.BADLN   MNOTE 4,'INVALID AREA LENGTH &LN'                              00370000
         MEXIT ,                                                        00380000
.BADA    MNOTE 4,'INVALID AREA ADDRESS &A'                              00390000
         MEXIT ,                                                        00400000
.BADW1   MNOTE 4,'INVALID WORK1 &WORK1'                                 00410000
         MEXIT ,                                                        00420000
.BADW2   MNOTE 4,'INVALID WORK2 &WORK2'                                 00430000
         MEXIT ,                                                        00440000
         MEND  ,                                                        00450000
./ ADD NAME=CMASK
         MACRO ,                                                        00010000
&NM      CMASK &MASKEND='*-',&MASKEQU='?%', 2260 HAD "  ADDED ON 89016 *00020000
               &ML=R15,&MA=R14,&L=R0,&A=R1,&RET=R9                      00030000
         LCLA  &I,&J,&K                                                 00040000
         LCLB  &LEQ                                                     00050000
         LCLC  &N,&C                                             89078  00060000
&I       SETA  &SYSNDX                                                  00070000
&LEQ     SETB  ('&ML' EQ '&L')                                          00080000
&N       SETC  '&NM'                                                    00090000
         AIF   (&LEQ).NOCOMP                                            00100000
&N       CR    &ML,&L        IS MASK LONGER THAN DATA ?                 00110000
&N       SETC  ''                                                       00120000
         BHR   &RET          RETURN WITH CC UNEQUAL                     00130000
.NOCOMP  ANOP  ,             MASK LENGTH DEFINED SAME AS LENGTH         00140000
&N       LTR   &ML,&ML       MASK EXHAUSTED ?                           00150000
         BNPR  &RET          YES - RETURN EQUAL                         00160000
CMK&I.M  DS    0H                                                       00170000
&J       SETA  1                                                        00180000
&K       SETA  K'&MASKEND-2  LENGTH W/O QUOTES                          00190000
.LOOPEND AIF   (&J GT &K).ENDLOOP                                       00200000
&J       SETA  &J+1          SET FOR NEXT ONE                           00210000
&C       SETC  '&MASKEND'(&J,1)                                  89078  00220000
         CLI   0(&MA),C'&C'  FORCED END ?                        89078  00230000
         BER   &RET          'END' CHARACTER - RETURN EQUAL             00240000
         AGO   .LOOPEND                                                 00250000
.ENDLOOP ANOP  ,                                                        00260000
&J       SETA  1                                                        00270000
&K       SETA  K'&MASKEQU-2  LENGTH W/O QUOTES                          00280000
.LOOPEQU AIF   (&J GT &K).EQULOOP                                       00290000
&J       SETA  &J+1          SET FOR NEXT ONE                           00300000
&C       SETC  '&MASKEQU'(&J,1)                                  89078  00310000
         CLI   0(&MA),C'&C'  NON-COMPARE ?                       89078  00320000
         BE    CMK&I.E       'EQU' CHARACTER - SKIP COMPARE             00330000
         AGO   .LOOPEQU                                                 00340000
.EQULOOP ANOP  ,                                                        00350000
         CLC   0(1,&MA),0(&A)    EQUAL ?                                00360000
         BNER  &RET          NO - RETURN UNEQUAL                        00370000
CMK&I.E  LA    &MA,1(,&MA)   NEXT MASK BYTE                             00380000
         LA    &A,1(,&A)     NEXT DATA BYTE                             00390000
         BCT   &ML,CMK&I.M   NEW MASK LENGTH                            00400000
         LTR   &ML,&ML       SET CC EQUAL                               00410000
         BR    &RET                                                     00420000
         MEND  ,                                                        00430000
./ ADD NAME=CNVA
         MACRO                                                          00010000
&NM      CNVA  &R,&AD,&LEN,&DB=DB                                       00020000
&NM      ST    &R,&DB                                                   00030000
         LA    R0,&DB                                                   00040000
         CNVX  (R0),&AD,&LEN                                            00050000
         MEND                                                           00060000
./ ADD NAME=CNVD
         MACRO                                                          00010000
&NM      CNVD  &R,&AD,&LEN,&FORM=I                                      00020000
         GBLB  &INLINE(50)                                              00030000
         GBLB  &MVS,&MVSXA,&MVSESA,&OS390,&Z900                 GP04234 00040000
         GBLC  &MACPLAB                                                 00050000
&MACPLAB SETC  '&NM'                                                    00060000
         LCLC  &L,&RTNE                                         GP13008 00070000
         LCLA  &IX                                                      00080000
&L       SETC  'L'''                                                    00090000
&RTNE    SETC  'DCONVERT'    NORMAL INTEGER FORMATTING          GP13008 00100000
&IX      SETA  6             STANDARD FLAG INDEX                GP13008 00110000
         AIF   ('&FORM' EQ 'I').COMCODE                         GP13008 00120000
&RTNE    SETC  'DCONVONE'    INTEGER PLUS SINGLE DECIMAL        GP13008 00130000
&IX      SETA  12            SPECIAL INDEX                      GP13008 00140000
         AIF   ('&FORM' EQ 'P1').COMCODE                        GP13008 00150000
&RTNE    SETC  'DCONVTWO'    INTEGER PLUS TWO DECIMALS          GP13008 00160000
&IX      SETA  13            SPECIAL INDEX                      GP13008 00170000
         AIF   ('&FORM' EQ 'P2').COMCODE                        GP13008 00180000
&RTNE    SETC  'DCONVTRE'    INTEGER PLUS THREE DECIMALS        GP13008 00190000
&IX      SETA  14            SPECIAL INDEX                      GP13008 00200000
         AIF   ('&FORM' EQ 'P3').COMCODE                        GP13008 00210000
         MNOTE 8,'CNVD: UNRECOGNIZED FORM=&FORM VALUE'          GP13008 00220000
&IX      SETA  6             STANDARD FLAG INDEX                GP13008 00230000
.COMCODE MACPARM R0,(&R(1)),OP=LR   SET VALUE                   GP13003 00240000
&INLINE(&IX) SETB 1                                             GP13008 00250000
         MACPARM R1,&AD      GET OUTPUT ADDRESS                         00260000
         MACPARM R15,&LEN,NULL=&L&AD   OUTPUT LENGTH                    00270000
         MACPARM R14,&RTNE,OP=BAL                               GP13008 00280000
         MEND                                                           00290000
./ ADD NAME=#CNVRT
         MACRO ,                                                        00010000
&NM      #CNVRT &FUN,&ADR,&LEN,&OPF,&OPT=,&BZ=,&BNZ=,&BM=,&BP=  GP03122 00020000
         GBLC  &ZZCFXNM(32)                                             00030000
         GBLC  &ZZCFXF@                                         GP04055 00040000
         GBLC  &ZZCFXFC                                         GP04055 00050000
         GBLC  &MACPLAB                                                 00060000
         GBLB  &ZZCFXFG                                                 00070000
         GBLA  &ZZCFXFM                                                 00080000
.*--------------------------------------------------------------------* 00090000
.*                                                                    * 00100000
.*  MACRO #CNVRT IS USED BY FUNCTIONS @PRINTER, @SCREENS, AND EXHIBIT * 00110000
.*  MODULE EXHASCRN TO INVOKE COMMON DATA CONVERSION ROUTINES IN      * 00120000
.*  MODULE @FORMATS                                                   * 00130000
.*                                                                    * 00140000
.*--------------------------------------------------------------------* 00150000
         LCLA  &I                                                       00160000
&MACPLAB SETC  '&NM'                                                    00170000
         AIF   ('&OPT' EQ 'TABLE' OR '&OPT' EQ 'EXPAND').LOCOPT GP04055 00180000
         AIF   ('&OPT' EQ '').KEEPOPT                           GP04055 00190000
&ZZCFXFC SETC  '&OPT'                                           GP04055 00200000
.KEEPOPT AIF   ('&ZZCFXFC' NE '').LOCOPT                        GP04055 00210000
&ZZCFXFC SETC  'CALL'        DEFAULT INVOKATION MODE            GP04055 00220000
.LOCOPT  AIF   ('&ZZCFXF@' NE '').HAVEPT                        GP04055 00230000
&ZZCFXF@ SETC  '@FORMATS'    DEFAULT ADDRESS OF @FORMATS        GP04055 00240000
     AIF   ('&SYSECT' NE 'EXHASCRN' AND '&SYSECT' NE '@SCREENS').HAVEPT 00250000
&ZZCFXF@ SETC  'ADFORMAT'    ADDRESS OF @FORMATS                GP04055 00260000
.HAVEPT  AIF   (&ZZCFXFG).DEFINED                               GP04055 00270000
&ZZCFXFG SETB  1                                                        00280000
&ZZCFXNM(01) SETC 'DBK'      DEBLANK (STRIP "B")                        00290000
&ZZCFXNM(02) SETC 'DBKL'     DEBLANK (STRIP "H")                        00300000
&ZZCFXNM(03) SETC 'DBKR'     DEBLANK (STRIP "T")                        00310000
&ZZCFXNM(04) SETC 'DBKZ'     REMOVE LEADING HEX AND CHAR ZEROES         00320000
&ZZCFXNM(05) SETC 'CENTER'   DEBLANK, THEN CENTER                       00330000
&ZZCFXNM(06) SETC 'DATE'     8-CHAR DATE MM/DD/YY                       00340000
&ZZCFXNM(07) SETC 'TIME'     8-CHAR TIME; 24-HOUR                       00350000
&ZZCFXNM(08) SETC 'CONVERT'  NUMERIC (FD BASED) CONVERSION (INT->EXT)   00360000
&ZZCFXNM(09) SETC 'TREVNOC'  CONVERSION FROM EXTERNAL TO INTERNAL       00370000
&ZZCFXFM SETA  9                                                        00380000
.DEFINED AIF   ('&OPT' EQ 'TABLE').EXPAND                       GP04055 00390000
         AIF   ('&OPT' EQ 'EXPAND').EXPAND                      GP04055 00400000
.LOOKUP  AIF   (&I GE &ZZCFXFM).NOMATCH                                 00410000
&I       SETA  &I+1                                                     00420000
         AIF   ('&ZZCFXNM(&I)' EQ '&FUN').MATCH                         00430000
         AGO   .LOOKUP                                                  00440000
.NOMATCH MNOTE 8,'#CNVRT: FUNCTION &FUN NOT DEFINED'                    00450000
&I       SETA  8             SET FOR CONVERT (?)                        00460000
.MATCH   MACPARM R0,&LEN,NULL=SKIP   LOAD OPTIONS/LENGTH                00470000
         MACPARM R15,&OPF,NULL=SKIP  LOAD OPTIONS/OUTLEN                00480000
         MACPARM R1,&ADR,NULL=SKIP   LOAD ITEM ADDRESS                  00490000
         AIF   ('&ZZCFXFC' EQ 'CALL').LOAD@                     GP03287 00500000
         AIF   ('&ZZCFXFC' EQ 'CALLA').LOADA                    GP03287 00510000
         AIF   ('&ZZCFXFC' EQ 'CALLV').LOADV                    GP03287 00520000
         MNOTE 4,'#CNVRT: UNRECOGNIZED OPT=&ZZCFXFC '           GP03287 00530000
.LOADV   MACPARM R14,=V(@FORMATS),OP=L                          GP03287 00540000
         AGO   .LOADCOM                                         GP03287 00550000
.LOADA   MACPARM R14,=A(@FORMATS),OP=L                          GP03287 00560000
         AGO   .LOADCOM                                         GP03287 00570000
.LOAD@   MACPARM R14,&ZZCFXF@,OP=L   LOAD CONVERSION ROUTINE ADDRESS    00580000
.LOADCOM ANOP  ,                                                GP03287 00590000
&I       SETA  &I-1                                                     00600000
         AH    R14,32+&I*2(,R14)  GET FUNCTION ENTRY ADDRESS            00610000
         BASR  R14,R14       INVOKE FUNCTION                            00620000
 AIF ('&BZ' EQ '' AND '&BNZ' EQ '' AND '&BM' EQ '' AND '&BP' EQ '').MND 00630000
.*OOPS   LTR   R0,R0         SET CONDITION CODE                 GP05032 00640000
         MACPARM &BZ,MODE=ONE,NULL=SKIP,OP=BZ,OPR=BZR           GP05032 00650000
         MACPARM &BM,MODE=ONE,NULL=SKIP,OP=BM,OPR=BMR           GP05032 00660000
         MACPARM &BP,MODE=ONE,NULL=SKIP,OP=BP,OPR=BPR           GP05032 00670000
         MACPARM &BNZ,MODE=ONE,NULL=SKIP,OP=BNZ,OPR=BNZR        GP05032 00680000
.MND     MEXIT ,                                                        00690000
.EXPAND  AIF   (&I GE &ZZCFXFM).MEND                                    00700000
&I       SETA  &I+1                                                     00710000
&MACPLAB DC    AL2(&ZZCFXNM(&I)-&SYSECT)                                00720000
&MACPLAB SETC  ' '                                                      00730000
         AGO   .EXPAND                                                  00740000
.MEND    MEND  ,                                                        00750000
./ ADD NAME=CNVR
         MACRO                                                          00010000
&NM      CNVR  &R,&AD,&LEN,&DB=DB                                       00020000
&NM      ST    &R,&DB                                                   00030000
         LA    R0,1+&DB                                                 00040000
         CNVX  (R0),&AD,&LEN                                            00050000
         MEND                                                           00060000
./ ADD NAME=CNVX
         MACRO                                                          00010000
&NM      CNVX  &R,&AD,&LEN                                              00020000
         GBLB  &INLINE(50)                                              00030000
         GBLB  &MVS,&MVSXA,&MVSESA,&OS390,&Z900                 GP04234 00040000
         LCLC  &L                                                       00050000
&INLINE(7) SETB 1                                                       00060000
&L       SETC  'L'''                                                    00070000
&NM      MACPARM R0,&R                                                  00080000
         MACPARM R1,&AD                                                 00090000
         AIF   ('&LEN' NE '').LEN                                       00100000
         AIF   ('&AD'(1,1) EQ '(').TLEN                                 00110000
         MACPARM R15,&L&AD                                              00120000
         AGO   .BAL                                                     00130000
.TLEN    AIF   ('&LEN' NE '').LEN                                       00140000
         MNOTE 4,'LENGTH REQUIRED'                                      00150000
.LEN     ANOP                                                           00160000
         MACPARM R15,&LEN                                               00170000
.BAL     ANOP                                                           00180000
         MACPARM R14,XCONVERT,OP=BAL                                    00190000
         MEND                                                           00200000
./ ADD NAME=CPOOL
         MACRO ,                                                        00010000
&NM      CPOOL &FUN,&OPT,&LINKAGE=,&REGS=,&LOC=,&KEY=,&TCB=,&HDR=,     *00020000
               &PCELLCT=,&SCELLCT=,&CSIZE=,&SP=,&CPID=,&CELL=,         *00030000
               &MF=S,&VERIFY=,&OWNER=                                   00040000
         GBLC  &MACPLAB                                                 00050000
&MACPLAB SETC  '&NM'                                                    00060000
.********************************************************************** 00070000
.*                                                                    * 00080000
.*   THIS VERSION OF THE CPOOL MACRO INTERFACES TO SUBROUTINE         * 00090000
.*   SUBCPOOL. IT PROVIDES BACKWARD COMPATIBILITY FOR HERCULES        * 00100000
.*   RUNNING MVS 3.8J                                                 * 00110000
.*     NOT SUPPORTED ARE KEY, TCB, LIST/WORKAREA, PRIV. SP,           * 00120000
.*     VERIFY, AND OWNER.                                             * 00130000
.*                                                                    * 00140000
.********************************************************************** 00150000
.*                                                                    * 00160000
.*       GET    R0 = CPID  @ -> CELL  CALL SUBCPOOL                   * 00170000
.*       FREE   R0 = CPID, R1 = CELL  CALL SUBPOOL+24*                * 00180000
.*       BUILD  R1 = PARM LIST        CALL SUBPOOL+28*                * 00190000
.*       DELETE R0 = CPID             CALL SUBPOOL+32*                * 00200000
.*                                                                    * 00210000
.********************************************************************** 00220000
.*                                                                    * 00230000
.*   PARM LIST IS SAME AS IBM'S FOR COMPATIBILITY                     * 00240000
.*      0 - 3     NUMBER OF CELLS REQUESTED                             00250000
.*      4 - 7     SECONDARY AMOUNT                                      00260000
.*      8 -11     SIZE OF EACH CELL                                     00270000
.*     12         SUBPOOL (ONLY 0-127 WORK)                             00280000
.*     13         KEY(IGNORED)                                          00290000
.*     14         FLAGS                                                 00300000
.*         80       LOC HAS REAL (IGNORED)                              00310000
.*         60       LOC ANY; 20 BELOW (FORCED); 00 RES                  00320000
.*         10       USER SPECIFIED TCB (IGNORED)                        00330000
.*         08       USER SPECIFIED KEY (IGNORED)                        00340000
.*         04       USER SPECIFIED HDR                                  00350000
.*         03       OWNER IS SYSTEM; 01 PRIMARY; 00 HOME (IGNORED)      00360000
.*     15         UNUSED                                                00370000
.*     16-19      TCB (IGNORED)                                         00380000
.*     20-43      HEADER                                                00390000
.*                                                                    * 00400000
.********************************************************************** 00410000
         GBLC  &MACPLOD                                         GP12154 00420000
         LCLA  &BOFF         FUNCTION'S BRANCH OFFSET                   00430000
         LCLC  &ISN          SECONDARY CELL COUNT                       00440000
         LCLA  &FGLOC,&FGTCB,&FGKEY,&FGHDR,&FGOWN                       00450000
         LCLC  &VPN,&VSN,&VSZ,&VSP,&VKY,&VTC,&VHD                       00460000
         AIF   ('&FUN' EQ 'GET').COMMID     NO OFFSET                   00470000
&BOFF    SETA  24                                                       00480000
         AIF   ('&FUN' EQ 'FREE').FREECEL   BRANCH WITH POOL ID         00490000
&BOFF    SETA  28                                                       00500000
         AIF   ('&FUN' EQ 'BUILD').BUILDER  BRANCH WITH POOL ID         00510000
&BOFF    SETA  32                                                       00520000
         AIF   ('&FUN' EQ 'DELETE').COMMID  BRANCH WITH POOL ID         00530000
         MACPARM MODE=LBL    EXPAND LABEL, IF ANY                       00540000
 MNOTE 8,'CPOOL: UNSUPPORTED FUNCTION &FUN '                            00550000
         MEXIT ,                                                        00560000
.FREECEL MACPARM R1,&CELL,NULL=CELL-ADD                                 00570000
.COMMID  MACPARM R0,&CPID,OP=L,NULL=POOL-ID  LOAD THE CELL POOL ID      00580000
.CALL    MACSRVLD SUBCPOOL   GET AD-CON NAME FOR SUBROUTINE             00590000
         MACPARM R15,&MACPLOD,OP=L  GET SUBROUTINE ADDRESS              00600000
         AIF   (&BOFF NE 0).U  ONLY GET HAS COND ENTRY                  00610000
         AIF   ('&OPT' EQ '' OR '&OPT' EQ 'U' OR '&OPT' EQ 'UNCOND').U  00620000
         AIF   ('&OPT' EQ 'C' OR '&OPT' EQ 'COND').C                    00630000
 MNOTE 8,'CPOOL: REQUEST NOT COND NOR UNCOND. &OPT INVALID'             00640000
         AGO   .U                                                       00650000
.C       O     R15,=X'80000000'  CONDITIONAL REQUEST                    00660000
.U       AIF   (&BOFF EQ 0).BR  NO OFFSET                               00670000
         MACPARM R14,&BOFF.(,R15),OP=BAL  GET ENTRY ADDRESS             00680000
         AIF   (&BOFF NE 28).MEXIT  NOT BUILD                           00690000
         MACPARM R0,&CPID,OP=ST,MODE=REV                                00700000
.MEXIT   MEXIT ,                                                        00710000
.BR      MACPARM R14,(R15),OP=BALR,OPR=BALR                             00720000
         MACPARM R1,&CELL,OP=ST,MODE=REV,NULL=SKIP  GET RETURNS CELL @  00730000
         MEXIT ,                                                        00740000
.BUILDER AIF   ('&MF' EQ '').TYPES                                      00750000
         AIF   ('&MF(1)' EQ 'L').TYPEL                                  00760000
         AIF   ('&MF(1)' EQ 'S').TYPES                                  00770000
         AIF   ('&MF(1)' EQ 'E').TYPEE                                  00780000
         MACPARM MODE=LBL                                               00790000
 MNOTE 8,'CPOOL: INVALID TYPE &MF'                                      00800000
         MEXIT ,                                                        00810000
.TYPEE   MACPARM R1,&MF(2),NULL=LIST-ADD                                00820000
         AGO   .POPLIST                                                 00830000
.TYPES   MACPARM 2,4,OP=CNOP,OPR=CNOP                                   00840000
         MACPARM R1,*+4+44,OP=BAL  BRANCH AROUND IN-LINE PARM LIST      00850000
         DC    XL44'0'       IN-LINE PARM LIST                          00860000
.POPLIST MACPLOP &PCELLCT,0(,R1),NULL=PCELL-CT                          00870000
&ISN     SETC  '&PCELLCT'                                               00880000
         AIF   ('&SCELLCT' EQ '').HV2                                   00890000
&ISN     SETC  '&SCELLCT'                                               00900000
.HV2     MACPLOP &ISN,4(,R1),NULL=SCELL-#                               00910000
         MACPLOP &CSIZE,8(,R1),NULL=CELL-SZ                             00920000
         AIF   ('&SP' EQ '').NOSP                                       00930000
         MACPLOP &SP,14(,R1),OP=STC                                     00940000
.NOSP    AIF   ('&KEY' EQ '').NOKEY                                     00950000
         MACPLOP &KEY,15(,R1),OP=STC                                    00960000
&FGKEY   SETA  8             KEY SPECIFIED                              00970000
.NOKEY   AIF   ('&TCB' EQ '').NOTCB                                     00980000
         MACPLOP &TCB,16(,R1)                                           00990000
&FGTCB   SETA  16            TCB SPECIFIED                              01000000
.NOTCB   AIF   ('&HDR' EQ '').NOHDR                                     01010000
&FGHDR   SETA  4             HDR SPECIFIED                              01020000
         AIF   ('&HDR'(1,1) NE '''').NOQ                                01030000
         MACPARM 20(24,R1),=C&HDR,OP=MVC                                01040000
         AGO   .NOHDR                                                   01050000
.NOQ     MACPARM R15,&HDR                                               01060000
         MACPLOP 20(24,R1),0(R15),OP=MVC                                01070000
.NOHDR   MVI   14(R1),&FGLOC+&FGTCB+&FGKEY+&FGHDR+&FGOWN                01080000
         AGO   .CALL         CALL THE BUILD FUNCTION                    01090000
.TYPEL   ANOP  ,                                                        01100000
&VPN     SETC  '0'                                                      01110000
&VSN     SETC  '0'                                                      01120000
&VSZ     SETC  '0'                                                      01130000
&VSP     SETC  '0'                                                      01140000
&VKY     SETC  '0'                                                      01150000
&VTC     SETC  '0'                                                      01160000
&VHD     SETC  '0'                                                      01170000
         AIF   (T'&PCELLCT EQ 'O').DPN                                  01180000
&VPN     SETC  '&PCELLCT'                                               01190000
&VSN     SETC  '&VPN'                                                   01200000
.DPN     AIF   (T'&SCELLCT EQ 'O').DSN                                  01210000
&VSN     SETC  '&SCELLCT'                                               01220000
.DSN     AIF   (T'&CSIZE EQ 'O').DSZ                                    01230000
&VSZ     SETC  '&CSIZE'                                                 01240000
.DSZ     AIF   (T'&SP EQ 'O').DSP                                       01250000
&VSP     SETC  '&CSIZE'                                                 01260000
.DSP     AIF   (T'&KEY EQ 'O').DKY                                      01270000
&VKY     SETC  '&KEY'                                                   01280000
&FGKEY   SETA  8                                                        01290000
.DKY     AIF   (T'&TCB EQ 'O').DTC                                      01300000
&VTC     SETC  '&TCB'                                                   01310000
&FGTCB   SETA  16                                                       01320000
.DTC     AIF   (T'&HDR EQ 'O').DHD                                      01330000
&FGHDR   SETA  4                                                        01340000
&VHD     SETC  '&HDR'                                                   01350000
.DHD     MACPARM A(&VPN,&VSN,&VSZ),MODE=ONE,OP=DC                       01360000
         DC    AL1(&VSP,&VKY,&FGLOC+&FGTCB+&FGKEY+&FGHDR+&FGOWN,0)      01370000
         AIF   ('&HDR' NE '').HVHD                                      01380000
         DC    A(&VTC),XL24'0'                                          01390000
         MEXIT ,                                                        01400000
.HVHD    AIF   ('&HDR'(1,1) NE '''').PNHD                               01410000
         DC    A(&VTC),CL24&VHD                                         01420000
         MEXIT ,                                                        01430000
.PNHD    DC    A(&VTC),CL24'&VHD '                                      01440000
         MEND  ,                                                        01450000
./ ADD NAME=CRMEND
         MACRO ,                                                        00010000
&NM      CRMEND &PFX=                                   ADDED ON 85070  00020000
         GBLC  &CRM@NAM                                                 00030000
         LCLC  &P                                                       00040000
&P       SETC  '&PFX'                                                   00050000
         AIF   ('&P' NE '').HP                                          00060000
&P       SETC  '&CRM@NAM'                                               00070000
         AIF   ('&P' NE '').HP                                          00080000
&P       SETC  'CRX'                                                    00090000
.HP      ANOP  ,                                                        00100000
         LTORG ,                                                        00110000
         SPACE 1                                                        00120000
&P.LAST  DS    0D                                                       00130000
&P.SIZE  EQU   &P.LAST-&P.CODE  SIZE OF CSA RELOCATION                  00140000
         MEND  ,                                                        00150000
./ ADD NAME=CRMEXIT
         MACRO ,                                                        00010000
&NM      CRMEXIT &RC,&PFX=                              ADDED ON 85070  00020000
         GBLC  &CRM@NAM                                                 00030000
         LCLC  &P                                                       00040000
&P       SETC  '&PFX'                                                   00050000
         AIF   ('&P' NE '').HP                                          00060000
&P       SETC  '&CRM@NAM'                                               00070000
         AIF   ('&P' NE '').HP                                          00080000
&P       SETC  'CRX'                                                    00090000
.HP      ANOP  ,                                                        00100000
&NM      MACPARM R15,&RC                                                00110000
         MACPARM R14,&P.SAVE+14*4,OP=L  RESTORE RETURN                  00120000
         BR    R14           RETURN TO SRB CONTROL CODE                 00130000
         MEND  ,                                                        00140000
./ ADD NAME=CRMHEAD
         MACRO ,                                                        00010000
&NM      CRMHEAD &PFX=                                  ADDED ON 85070  00020000
         GBLC  &CRM@NAM                                                 00030000
         LCLC  &P                                                       00040000
&P       SETC  '&PFX'                                                   00050000
         AIF   ('&P' NE '').HP                                          00060000
&P       SETC  'CRX'                                                    00070000
.HP      AIF   ('&NM' EQ '').NL                                         00080000
&NM      DS    0D .                                                     00090000
.NL      DROP  ,             NO ADDRESSABILITY                          00100000
&CRM@NAM SETC  '&P'          SAVE PREFIX GLOBALLY                       00110000
&P.CODE  DS    0D                                                       00120000
&P.SAVE  DC    16A(0)        SAVE AREA USED BY @SERVICE'S SRB           00130000
&P.SPEX  DC    A(0,0)        SPIE EXIT CODE ADDRESS/COUNT               00140000
         USING &P.CODE,R13   SET BY SRB CODE                            00150000
&P.ENTY  STM   R0,R15,&P.SAVE-&P.SAVE(R13)  SAVE ALL REGISTERS   90274  00160000
         MEND  ,                                                        00170000
./ ADD NAME=CRMSPIE
         MACRO ,                                                        00010000
&NM      CRMSPIE &AD,&PFX=                              ADDED ON 85070  00020000
         GBLC  &CRM@NAM                                                 00030000
         LCLC  &P                                                       00040000
&P       SETC  '&PFX'                                                   00050000
         AIF   ('&P' NE '').HP                                          00060000
&P       SETC  '&CRM@NAM'                                               00070000
         AIF   ('&P' NE '').HP                                          00080000
&P       SETC  'CRX'                                                    00090000
.HP      ANOP  ,                                                        00100000
         AIF   ('&AD' EQ '0').CANCEL                                    00110000
         AIF   ('&AD' NE '').SET                                        00120000
         MNOTE 8,'EXIT ADDRESS OPERAND REQUIRED'                        00130000
         MEXIT ,                                                        00140000
.CANCEL  ANOP  ,                                                        00150000
&NM      XC    &P.SPEX,&P.SPEX                                          00160000
         MEXIT ,                                                        00170000
.SET     ANOP  ,                                                        00180000
&NM      MACPARM R0,R12,&P.SAVE,OP=STM,MODE=THREE  REFRESH USER REGS    00190000
         MACPARM R15,&AD     LOAD ADDRESS OF EXIT                       00200000
         MACPARM R15,&P.SPEX,OP=ST   SET SPIE EXIT ADDRESS              00210000
         MEND  ,                                                        00220000
./ ADD NAME=CRMS
         MACRO ,                                                        00010000
&NM      CRMS  &FUN,&R0,&R1,&OPT=                        UPDATED 90177  00020000
         GBLC  &MACPLAB                                          90177  00030000
         GBLB  &MVS,&MVSXA,&MVSESA,&OS390,&Z900                 GP04234 00040000
         LCLC  &B                                                       00050000
&MACPLAB SETC  '&NM'         SET LABEL GENERATION                90177  00060000
         AIF   ('&FUN' EQ 'SRB' OR '&FUN' EQ 'SCHEDULE').SRB            00070000
         AIF   ('&FUN' EQ 'INIT').INIT                                  00080000
         AIF   ('&FUN' EQ 'GET').GET                                    00090000
         AIF   ('&FUN' EQ 'FREE').FREE                                  00100000
         MNOTE 8,'FUNCTION OPERAND REQUIRED'                            00110000
         MEXIT ,                                                        00120000
.FREE    ANOP  ,                                                        00130000
&B       SETC  'EXWCRSFR'                                               00140000
         AGO   .BAL                                                     00150000
.GET     ANOP  ,                                                        00160000
&B       SETC  'EXWCRSGT'                                               00170000
         AGO   .L0                                                      00180000
.INIT    ANOP  ,                                                        00190000
&B       SETC  'EXWCRSIN'                                               00200000
         MACPARM R1,&R1,NULL=SKIP                               GP02241 00210000
.L0      MACPARM R0,&R0,NULL=SKIP                               GP02241 00220000
         AGO   .BAL                                                     00230000
.SRB     ANOP  ,                                                        00240000
&B       SETC  'EXWCRSCH'                                               00250000
         MACPARM R1,0        LOAD A ZERO                         90177  00260000
         AIF   ('&OPT' EQ '').BAL                                90177  00270000
         AIF   ('&OPT' EQ 'SPVR').SCH1                           90177  00280000
         MNOTE 4,'*** UNSUPPORTED OPT= VALUE'                    90177  00290000
         AGO   .BAL                                              90177  00300000
.SCH1    MACPARM R1,0,OP=BCTR,OPR=BCTR  SET -1                   90177  00310000
.BAL     ANOP  ,                                                 82200  00320000
         MACPARM R14,&B,OP=BAL,OPR=BALR   CALL SCHEDULE SERVICES 90177  00330000
         MEND  ,                                                        00340000
./ ADD NAME=CSADD
         MACRO ,                                                        00010000
&NM      CSADD &CTR,&INC=1,&WK1=R14,&WK2=R15                     87001  00020000
         LCLC  &N                                                       00030000
&N       SETC  '&NM'                                                    00040001
         AIF   ('&N' NE '').NOLB                                        00050001
&N       SETC  'ZZCS'.'&SYSNDX'                                         00060000
.NOLB    ANOP  ,                                                        00070001
&N       L     &WK1,&CTR     LOAD OLD VALUE                             00080000
         AIF   (K'&INC LT 3).NOREG                                      00090000
         AIF   ('&INC'(1,1) EQ '(' AND '&INC'(2,1) NE '(').REG          00100000
.NOREG   AIF   ('&WK1(1)' EQ '0' OR '&WK1(1)' EQ 'R0').NOLA             00110000
         LA    &WK2,&INC.(,&WK1)  INCREASE                              00120000
         AGO   .COM                                                     00130000
.NOLA    LA    &WK2,&INC     INCREMENT                                  00140000
         AR    &WK2,&WK1                                                00150000
         AGO   .COM                                                     00160000
.REG     ANOP  ,                                                        00170000
         LR    &WK2,&WK1                                                00180000
         AR    &WK2,&INC(1)  INCREASE                                   00190000
.COM     CS    &WK1,&WK2,&CTR  REPLACE                                  00200000
         BNZ   &N            ELSE TRY AGAIN                             00210000
         MEND  ,                                                        00220000
./ ADD NAME=CSDEC
         MACRO ,                                                        00010000
&NM      CSDEC &CTR,&DEC=1,&WK1=R14,&WK2=R15                     87001  00020000
         LCLC  &N                                                       00030000
&N       SETC  '&NM'                                                    00040000
         AIF   ('&N' NE '').HAVELB                                      00050000
&N       SETC  'ZZCS'.'&SYSNDX'                                         00060000
.HAVELB  ANOP  ,                                                        00070000
&N       L     &WK1,&CTR     LOAD OLD VALUE                             00080000
         LR    &WK2,&WK1     COPY CURRENT VALUE                         00090000
         AIF   (K'&DEC LT 3).NOREG                                      00100000
         AIF   ('&DEC'(1,1) EQ '(' AND '&DEC'(2,1) NE '(').REG          00110000
.NOREG   AIF   ('&DEC' EQ '1').SPEC                                     00120000
         SH    &WK2,=Y(&DEC) DECREASE                                   00130000
         AGO   .COM                                                     00140000
.SPEC    BCTR  &WK2,0        DECREASE                                   00150000
         AGO   .COM                                                     00160000
.REG     SR    &WK2,&DEC(1)  DECREASE                                   00170000
.COM     CS    &WK1,&WK2,&CTR  REPLACE                                  00180000
         BNZ   &N            ELSE TRY AGAIN                             00190000
         MEND  ,                                                        00200000
./ ADD NAME=CSIRWORK
         MACRO ,                                                        00010000
&NM      CSIRWORK ,                                      ADDED: GP00043 00020000
.********************************************************************** 00030000
.*                                                                   ** 00040000
.*  THIS MACRO MAPS THE RETURN AREA FROM THE IGGCSI00 SERVICE.       ** 00050000
.*  (COULDN'T FIND AN IBM VERSION AS OF OS/390 2.8)                  ** 00060000
.*                                                                   ** 00070000
.********************************************************************** 00080000
         AIF   ('&NM' NE '').UNAME                                      00090000
CSIRWORK DSECT ,                                                        00100000
         AGO   .COMMON                                                  00110000
.UNAME   ANOP  ,                                                        00120000
&NM      DS    0D                                                       00130000
.COMMON  ANOP  ,                                                        00140000
CSIUSRLN DC    F'4096'       USER PROVIDED WORK AREA SIZE               00150000
CSIREQLN DC    F'0'          MINIMUM REQUIRED LENGTH                    00160000
CSIUSDLN DC    F'0'          ACTUAL LENGTH USED                         00170000
CSINUMFD DC    H'0'          NUMER OF SPECIFIED FIELD NAMES + 1         00180000
CSIRWENT EQU   *             START OF DIFFERENT ENTRY TYPES             00190000
         SPACE 1                                                        00200000
         ORG   CSIRWENT      DEFINE FOR ICF CATALOG                     00210000
CSICFLG  DS    X             CATALOG FLAG                               00220000
CSINTICF EQU   X'80'           UNSUPPORTED - NON-ICF CAT                00230000
CSINOENT EQU   X'40'           NO ENTRIES FOUND                         00240000
CSINTCMP EQU   X'20'           INCOMPLETE RESPONSE                      00250000
CSICERR  EQU   X'10'           CAT.ERR. - NOTHING PROCESSED             00260000
CSICERRP EQU   X'08'           CAT.ERR. - PARTIALLY PROCESSED           00270000
CSICTYPE DS    C             CATALOG TYPE (ICF - '0')                   00280000
CSICNAME DS    CL44          CATALOG NAME                               00290000
CSICRETN DS    0XL4          RETURN CODES                               00300000
CSICRETM DS    CL2             CAT. MODULE ID                           00310000
CSICRETR DS    X               REASON CODE                              00320000
CSICRETC DS    X               RETURN CODE                              00330000
CSICLENG EQU   *-CSICFLG     SIZE OF ENTRY                              00340000
         SPACE 1                                                        00350000
         ORG   CSIRWENT      DEFINE FOR OTHERS                          00360000
CSIEFLG  DS    X             ENTRY FLAG                                 00370000
CSIPMENT EQU   X'80'           PRIMARY ENTRY                            00380000
CSIENTER EQU   X'40'           ERROR - CODE AFTER NAME                  00390000
CSIEDATA EQU   X'20'           DATA ARE RETURNED FOR THIS ENTRY         00400000
CSIETYPE DS    C             ENTRY TYPE                                 00410000
CSIETYP0 EQU   C'0'            ICF CATALOG                              00420000
CSIETYPA EQU   C'A'            NON-VSAM DATA SET                        00430000
CSIETYPB EQU   C'B'            GENERATION DATA GROUP                    00440000
CSIETYPC EQU   C'C'            CLUSTER                                  00450000
CSIETYPD EQU   C'D'            DATA COMPONENT                           00460000
CSIETYPH EQU   C'G'            ALTERNATE INDEX                          00470000
CSIETYPG EQU   C'H'            GENERATION DATA SET                      00480000
CSIETYPI EQU   C'I'            INDEX                                    00490000
CSIETYPR EQU   C'R'            PATH                                     00500000
CSIETYPX EQU   C'X'            ALIAS                                    00510000
CSIETYPU EQU   C'U'            USER CATALOG CONNECTOR                   00520000
CSIETYPL EQU   C'L'            ATL LIBRARY ENTRY                        00530000
CSIETYPW EQU   C'W'            ATL VOLUME ENTRY                         00540000
CSIENAME DS    CL44          ENTRY NAME                                 00550000
CSIERETN DS    0XL4          RETURN CODES                               00560000
CSIERETM DS    CL2             CAT. MODULE ID                           00570000
CSIERETR DS    X               REASON CODE                              00580000
CSIERETC DS    X               RETURN CODE                              00590000
CSIELENG EQU   *-CSIEFLG     SIZE OF ENTRY ON ERROR                     00600000
         ORG   CSIERETN                                                 00610000
CSITOTLN DS    HL2           LENGTH OF ENTRY AFTER CSIENAME END         00620000
         DS    HL2             RESERVED                                 00630000
CSILENFD DS    0HL2          FIELD LENGTH ARRAY                         00640000
CSILENF1 DS    HL2             LENGTH OF FIRST ENTRY                    00650000
.*                                                                      00660000
.*  DATA, IF ANY, FOLLOW A(CSITOTLN+2)+2*CSINUMFD                       00670000
.*                                                                      00680000
         MEND  ,                                                        00690000
./ ADD NAME=CSREP
         MACRO ,                                                        00010000
&NM      CSREP &NEW,&OLD,&WK1=R14,&WK2=R15                       87001  00020000
         GBLC  &MACPLAB                                                 00030000
         LCLC  &N                                                       00040000
         LCLA  &K                                                       00050000
&K       SETA  K'&NEW                                                   00060000
&N       SETC  '&SYSNDX'                                                00070000
&L       SETC  'CS'.'&SYSNDX'                                           00080000
&MACPARM SETC  '&NM'                                                    00090000
         AIF   (&K LT 3).OLD                                            00100000
         AIF   ('&NEW'(1,1) NE '(' OR '&NEW'(&K,1) NE ')').OLD          00110000
         AIF   ('&NEW'(2,1) EQ '(').OLD        ((EXPRESSION)) ?         00120000
         AIF   ('&NEW'(&K-1,1) EQ ')').OLD     ((EXPRESSION)) ?         00130000
&WK2     SETC  '&NEW(1)'                                                00140000
         AGO   .COM                                                     00150000
.OLD     MACPARM &WK2,&NEW,OP=L           LOAD NEW VALUE                00160000
.COM     MACPARM &WK1,&OLD,OP=L,OPR=L     LOAD OLD VALUE                00170000
&L.L     CS    &WK1,&WK2,&OLD  REPLACE                                  00180000
         BNZ   &L.L          ELSE TRY AGAIN                             00190000
         MEND  ,                                                        00200000
./ ADD NAME=CVH
         MACRO                                                          00010000
&NM      CVH   &R,&AD,&LEN                                              00020000
         GBLB  &INLINE(50)                                              00030000
         GBLB  &MVS,&MVSXA,&MVSESA,&OS390,&Z900                 GP04234 00040000
         GBLC  &MACPLAB                                                 00050000
         LCLC  &L                                                       00060000
&INLINE(6) SETB 1                                                       00070000
&L       SETC  'L'''                                                    00080000
&MACPLAB SETC  '&NM'                                                    00090000
         AIF   (T'&R NE 'F' AND T'&R NE 'V' AND T'&R NE 'A').LH         00100000
         MACPARM R0,&R,OP=L                                             00110000
         AGO   .COM                                                     00120000
.LH      MACPARM R0,&R,OP=LH                                            00130000
.COM     MACPARM R1,&AD .    GET OUTPUT ADDRESS                         00140000
         AIF   ('&LEN' NE '').LEN                                       00150000
         AIF   ('&AD'(1,1) EQ '(').TLEN                                 00160000
         MACPARM R15,&L&AD   USE IMPLICIT OUTPUT LENGTH                 00170000
         AGO   .BAL                                                     00180000
.TLEN    AIF   ('&LEN' NE '').LEN                                       00190000
         MNOTE 4,'CVH: LENGTH REQUIRED'                                 00200000
.LEN     MACPARM R15,&LEN .    GET OUTPUT LENGTH                        00210000
.BAL     MACPARM R14,DCONVERT,OP=BAL                                    00220000
         MEND                                                           00230000
./ ADD NAME=CVI
         MACRO                                                          00010000
&NM      CVI   &R,&AD,&LEN                                  NEW GP09347 00020000
.*   THIS MACRO CONVERTS AN INTEGER TO PRINTABLE FORM. EXPECTED         00030000
.*   OUTPUT LENGTH IS 7. VALUES BELOW 1 MILLION ARE SHOWN WITH          00040000
.*   A COMMA; LARGER VALUES AS TRUNCATED K WITH NO COMMAS.              00050000
.*                                                                      00060000
         GBLB  &INLINE(50)                                              00070000
&INLINE(8) SETB 1            REQUEST ICONVERT EXPANSION                 00080000
         LCLC  &L                                                       00090000
&L       SETC  'L'''                                                    00100000
         AIF   (T'&R EQ 'H').LH                                         00110000
&NM      MACPARM R0,&R,OP=L                                             00120000
         AGO   .COM                                                     00130000
.LH      ANOP  ,                                                        00140000
&NM      MACPARM R0,&R,OP=LH                                            00150000
.COM     MACPARM R1,&AD                                                 00160000
         MACPARM R15,&LEN,NULL=&LEN&AD                                  00170000
         MACPARM R14,ICONVERT,OP=BAL                                    00180000
         MEND                                                           00190000
./ ADD NAME=DASDTYPE
         MACRO                                                          00010000
&NM    DASDTYPE &UCB=R3,&OUT=R1,&R=R15,&S=R14,&T=R0                     00020000
         GBLC  &SYSTEM                                           82158  00030000
         LCLA  &I                                                       00040000
.*  THIS MACRO EXPANDS IN-LINE CODE TO SIMULATE THE DEVTYPE SVC         00050000
.*  FOR DISK DEVICES. INPUT IS A UCB ADDRESS IN REGISTER UCB;           00060000
.*  OUTPUT IS 20 BYTES IN AREA POINTED TO BY REGISTER OUT;              00070000
.*  ON A WORD BOUNDARY, CORRESPONDING TO WORDS 2-6 OF DEVTYPE.          00080000
.*   CODE WAS LIFTED FROM DEVTYPE SVC OS 21.8                           00090000
.*                                                                      00100000
&I       SETA  &SYSNDX                                                  00110000
         PUSH  USING                                             93032  00120000
&NM      XC    0(20,&OUT),0(&OUT)     CLEAR OUTPUT AREA                 00130000
         NEED  CVT           REQUEST EXPANSIONS VIA MSECT               00140000
         NUSE  UCB,&UCB                                          93032  00150000
         IC    &R,UCBTBYT4   GET THE DISK SUB-TYPE               93032  00160000
         LA    &S,X'0F'      MASK FOR SUB-TYPE INDEX                    00170000
         NR    &R,&S         GET INDEX                                  00180000
         L     &S,CVTPTR     GET CVT                                    00190000
         L     &S,CVTZDTAB-CVTMAP(,&S)  GET CVT DEVICE POINTER          00200000
         IC    &R,0(&R,&S)    GET INDEX TO DEVICE ENTRY                 00210000
         AR    &S,&R         GET ENTRY FOR THIS TYPE                    00220000
         MVC   4(12,&OUT),0(&S)    MOVE DATA                            00230000
         TM    UCBTBYT2,UCB2OPT3    RPS DEVICE ?                 93032  00240000
         BZ    *+10          NO                                         00250000
         MVC   16(4,&OUT),14(&S)     MOVE RPS WORD ALSO                 00260000
         LH    &R,4(,&S)     GET BLOCK SIZE                             00270000
         AIF   ('&SYSTEM' EQ 'MVS').ISMVS                        82157  00280000
         TM    UCBFL5,UCBEXTSN     EXTENDED SENSE DEVICE ?       93032  00290000
         BZ    ZZZZ&I        NO; SKIP RECALCULATION                     00300000
.ISMVS   XR    &T,&T                                             82157  00310000
         IC    &T,6(,&S)     GET OVERHEAD                               00320000
         TM    9(&S),8       TWO BYTE OVERHEAD ?                        00330000
         BZ    *+8           NO                                         00340000
         LH    &T,6(,&S)     GET FULL OVERHEAD                          00350000
         SR    &R,&T         ADJUST                                     00360000
         XR    &T,&T                                                    00370000
         IC    &T,8(,&S)     GET ADJUSTMENT TO ADJUSTMENT               00380000
         AR    &R,&T         FINAL ADJUSTED SIZE                        00390000
ZZZZ&I   ST    &R,0(,&OUT)   SET RECALCULATED BLOCKSIZE                 00400000
         POP   USING                                             93032  00410000
         MEND                                                           00420000
./ ADD NAME=DBO
         MACRO ,                                                        00010000
&NM      DBO   &LBL,&TEXT=,&REGS=YES,&HEX=,&MODE=S,     ADDED ON 85360 *00020000
               &WK=R9,&DEV=1,&TCB=,         WTO VS @PRT  CHANGED 94011 *00030000
               &ROUT=13,&DES=4,&BUGPARM=NO,                ADDED 95067 *00040000
               &CTEXT=,&PACK=,                             ADDED 96081 *00050000
               &PRTMODE=0,&DCB=0,   USER PRINT DCB/MODE    ADDED 99058 *00060000
               &COUNT=,&CALL=DYN,&OPT=,                  CHANGED 98222 *00070000
               &WA=DBTSAVE,                                ADDED 99114 *00080000
               &LIST=                                      ADDED 95235  00090000
.********************************************************************** 00100000
.*>>>>>>>>> KEPT FOR OLD CODE ONLY - NEW CODE SHOULD USE DBT <<<<<<<<<* 00110000
.********************************************************************** 00120000
.*                                                                    * 00130000
.*  THIS MACRO INVOKES EXTERNAL LOAD MODULE DEBTROLD TO PRODUCE       * 00140000
.*  TRACING, REGISTER CONTENTS, AND VARIABLES. (DEBTROLD SHOULD BE IN * 00150000
.*  A LINKLIB; AUTHORIZATION IS NOT REQUIRED). OUTPUT WILL BE BY WTO  * 00160000
.*  UNLESS A DEBTRACE DD CARD IS SUPPLIED.                            * 00170000
.*                                                                    * 00180000
.*  REQUIRED:  IN A CSECT OR RSECT:   DEBTRACE MODE=C  DEFINES CODE   * 00190000
.*             IN A CSECT OR DSECT:   DEBTRACE MODE=D  DEFINES DATA   * 00200000
.*             IN A CSECT (¬RENT) :   DEBTRACE MODE=DC   BOTH         * 00210000
.*    (NOTE: REQUIRED FORMS MUST NOT APPEAR PRIOR TO FIRST OPTIONAL)  * 00220000
.*                                                                    * 00230000
.*  OPTIONAL:  LABEL DEBTRACE ...                                     * 00240000
.*                TAG OR ,  -  IDENTIFIER ON OUTPUT LISTING / CONSOLE * 00250000
.*                                                                    * 00260000
.*                REGS= (DEFAULT) | REGS=NO - NO REGISTERS            * 00270000
.*                REGS=YES  -  REGISTERS R0 THROUGH R15               * 00280000
.*                REGS=(R1,R2) - REGISTERS R1 THROUGH R2              * 00290000
.*                REGS=SHORT   - R14 THROUGH R1                       * 00300000
.*                                                                    * 00310000
.*                TEXT=NAME -  TEXT STRING TO BE SHOWN                * 00320000
.*                TEXT=(NAME,LEN) - TEXT W/EXPLICIT LENGTH            * 00330000
.*                                                                    * 00340000
.*                CTEXT=NAME - CONDITIONAL TEXT STRING TO BE SHOWN    * 00350000
.*                CTEXT=(NAME,LEN) - TEXT W/EXPLICIT LENGTH           * 00360000
.*                              OUTPUT IN HEX IF NOT PRINTABLE        * 00370000
.*                                                                    * 00380000
.*                HEX=NAME   -  DATA TO BE SHOWN IN HEXADECIMAL       * 00390000
.*                HEX=(NAME,LEN) - TEXT W/EXPLICIT LENGTH             * 00400000
.*                                                                    * 00410000
.*                PACK=NAME  -  DATA TO BE CONVERTED FROM PACKED      * 00420000
.*                PACK=(NAME,LEN) - TEXT W/EXPLICIT LENGTH (LEN IGNRD)* 00430000
.*                                                                    * 00440000
.*           LIST=((OP1,LN1,FM1),(OP2,LN2,FM2), ... )                 * 00450000
.*                                                                    * 00460000
.*                OP - ADDRESS EXPRESSION VALID IN S CONSTANT         * 00470000
.*                LN - LENGTH EXPRESSION; DEFAULT IS L'OP             * 00480000
.*                FM - TEXT | CTEXT | HEX | PACK - DEFAULT IS HEX     * 00490000
.*                     OR ABBREVIATED   T | CT | H | P                * 00500000
.*                                                                    * 00510000
.*  THE REQUIRED FORMS MAY BE OMITTED WHEN PGMTRACE WILL ALSO BE USED * 00520000
.*  AND ACTIVATED. IN THAT CASE THE FIRST OPTIONAL FORM MUST INCLUDE  * 00530000
.*  CALL=TRC TO GENERATE SHORTER PARAMETER LISTS.                     * 00540000
.*                                                                    * 00550000
.********************************************************************** 00560000
.*  MAINTENANCE:                                                      * 00570000
.*                                                                    * 00580000
.*  2000/01/03  GYP  REMOVED IN-LINE DEBUG CODE;                      * 00590000
.*                   FIXED MODE=C AND MODE=D FOR USE WITH REENTRANT   * 00600000
.*                     PROGRAMS.                                      * 00610000
.*                                                                    * 00620000
.********************************************************************** 00630000
     GBLB  &BUGBEAR,&BUGTCB,&BUGSWCH,&BUGSWRT,&BUGFAR,&BUGEXT,&BUGDYN   00640000
     GBLB  &BUGTRC,&BUGDBO   USED WITH ACTIVE PGMTRACE (ESPIE)  GP99113 00650000
         GBLA  &MACP#        NUMBER OF SUBLIST PARAMETERS       GP04234 00660000
         GBLC  &MACP1,&MACP2,&MACP3,&MACP4,&MACP5               GP04234 00670000
         GBLC  &MACP6,&MACP7,&MACP8,&MACP9,&MACP10              GP04234 00680000
         GBLC  &V                                                       00690000
         LCLA  &LN,&I,&EN,&EM,&EO                               GP95235 00700000
         LCLC  &L,&ET,&EL,&EK                                   GP95235 00710000
&L       SETC  'L'''                                            GP95235 00720000
&V       SETC  'DBT'.'&SYSNDX'                                          00730000
&BUGFAR  SETB  (&BUGFAR OR ('&CALL' EQ 'FAR'))                   95079  00740000
&BUGEXT  SETB  (&BUGEXT OR ('&CALL' EQ 'EXTRN'))                 95227  00750000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ 'DYN'))                  GP97261 00760000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ ''))  DROP LOCAL CODE    GP00004 00770000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ 'DYNAMIC'))              GP97261 00780000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'TRC'))                  GP99113 00790000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'TRACE'))                GP99113 00800000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'PGMTRACE'))             GP99113 00810000
         AIF   (&BUGBEAR OR '&BUGPARM' EQ 'NO').DOSOME                  00820000
         AIF   ('&NM' EQ '').MEND                                       00830000
&NM      DS    0H            DEBUG SWITCH NOT ON                        00840000
         AGO   .MEND                                                    00850000
.DOSOME  ANOP  ,                                                 95067  00860000
&BUGSWCH SETB  1                                                 95067  00870000
         AIF   ('&MODE' EQ 'D' OR '&MODE' EQ 'M').DATA           95228  00880000
         AIF   ('&MODE' EQ 'C').CODE                                    00890000
         AIF   ('&MODE' EQ 'DC').CODE   EXPAND BOTH              95067  00900000
         AIF   ('&MODE' EQ 'ON').SWON                            95079  00910000
         AIF   ('&MODE' EQ 'OFF').SWOFF                          95079  00920000
         AIF   ('&MODE' EQ 'CLOSE').SWEND  CLOSE AND QUIT       GP98222 00930000
&BUGDBO  SETB  1             DBO STATEMENT EXPANDED             GP09183 00940000
         AIF   (NOT &BUGTRC).NOTTRC                             GP99113 00950000
&NM      DC    X'83CD',S(&WA,&V.X-*)             INVOKE TRACE   GP99113 00960000
         AGO   .DONEBAS                                         GP99113 00970000
.NOTTRC  ANOP  ,                                                GP99113 00980000
&NM      STM   R0,R15,&WA    SAVE ALL REGISTERS                         00990000
         AIF   ('&COUNT' EQ '').DONECNT                          95079  01000000
.*  COUNT(3) - SKIP FIRST N CALLS                                95079  01010000
         AIF   ('&COUNT(3)' EQ '').CNTNO3                        95079  01020000
         ICM   R14,15,&V.3   LOAD SKIP COUNT                     95079  01030000
         BNP   &V.C          LIMIT REACHED - PROCESS             95079  01040000
         BCTR  R14,0         DECREMENT                           95079  01050000
         STCM  R14,15,&V.3   SAVE FOR NEXT TIME                  95079  01060000
         B     &V.X          AND SKIP CALL                       95079  01070000
&V.3     DC    AL4(&COUNT(3))  INITIAL SKIP COUNT                95079  01080000
&V.C     DS    0H                                                95079  01090000
.CNTNO3  AIF   ('&COUNT(2)' EQ '').CNTNO2                        95079  01100000
         AIF   ('&COUNT(2)' EQ '1').CNTNO2                       95079  01110000
         AIF   ('&COUNT(2)' EQ '0').CNTNO2                       95079  01120000
.*  COUNT(2) - PROCESS EVERY NTH CALL ONLY                       95079  01130000
         ICM   R14,15,&V.2   LOAD COUNTER                        95079  01140000
         BNP   &V.L          BAD - PROCESS CALL                  95079  01150000
         BCT   R14,&V.N      NON-ZERO; SAVE AND SKIP             95079  01160000
         MVC   &V.2,=AL4(&COUNT(2))  REFRESH                     95079  01170000
         B     &V.L          AND GO                              95079  01180000
&V.2     DC    AL4(1)        INTERVAL COUNTER (DO FIRST ONE)     95079  01190000
&V.N     STCM  R14,15,&V.2   UPDATE COUNTER                      95079  01200000
         B     &V.X          AND EXIT                            95079  01210000
.CNTNO2  AIF   ('&COUNT(1)' EQ '').DONECNT                       95079  01220000
         AIF   ('&COUNT(1)' EQ '0').DONECNT                      95079  01230000
         ICM   R14,15,&V.1   LOAD LIMIT COUNT                    95079  01240000
         BNP   &V.X          SKIP OUT IF NOT VALID               95079  01250000
         BCTR  R14,0         DECREMENT                           95079  01260000
         B     &V.M          SAVE, AND CONTINUE                  95079  01270000
&V.1     DC    AL4(&COUNT(1))  MAXIMUM CALLS TO MAKE             95079  01280000
&V.M     STCM  R14,15,&V.1   SAVE FOR NEXT TIME                  95079  01290000
.DONECNT ANOP  ,                                                 95079  01300000
&V.L     BAS   R1,&V.B                                           95079  01310000
.DONEBAS AIF   ('&LBL' EQ '' AND (&BUGEXT OR &BUGDYN OR &BUGTRC)).NOLBL 01320000
         DC    CL8'&LBL '                                               01330000
.NOLBL   AIF   ('&REGS' EQ '' OR '&REGS' EQ 'NO').NOREGS         95079  01340000
         AIF   ('&REGS' EQ 'R15' OR '&REGS' EQ 'SHORT'                 *01350000
               OR '&REGS' EQ 'RET').RETREG                      GP97225 01360000
         AIF   ('&REGS' EQ 'YES' OR '&REGS' EQ 'ALL').REGSALL   GP02246 01370000
         AIF   (N'&REGS EQ 2).REGS2                             GP97225 01380000
         DC    AL1(0,0),SL2(&REGS(1),&REGS(1))                  GP97225 01390000
         AGO   .NOREGS                                          GP97225 01400000
.REGS2   DC    AL1(0,0),SL2(&REGS(1),&REGS(2))                  GP97225 01410000
         AGO   .NOREGS                                          GP97225 01420000
.REGSALL DC    AL1(0,0),SL2(0,15)                               GP97225 01430000
         AGO   .NOREGS                                          GP97225 01440000
.RETREG  DC    SL2(0,14,1)    R15-R1 ONLY                       GP97225 01450000
.NOREGS  AIF   ('&TEXT' EQ '').NOTEXT                                   01460000
         AIF   (N'&TEXT GE 2).TEXT2                             GP97225 01470000
         DC    AL1(1,0),SL2(&TEXT(1)),AL2(&L&TEXT(1))           GP97225 01480000
         AGO   .NOTEXT                                          GP97225 01490000
.TEXT2   DC    AL1(1,0),SL2(&TEXT(1),&TEXT(2))                          01500000
.NOTEXT  AIF   ('&CTEXT' EQ '').NOCTEXT                         GP97225 01510000
         AIF   (N'&CTEXT GE 2).CTEXT2                           GP97225 01520000
         DC    AL1(2,0),SL2(&CTEXT(1)),AL2(&L&CTEXT(1))         GP97225 01530000
         AGO   .NOCTEXT                                         GP97225 01540000
.CTEXT2  DC    AL1(2,0),SL2(&CTEXT(1),&CTEXT(2))                GP97225 01550000
.NOCTEXT AIF   ('&HEX' EQ '').NOHEX                             GP97225 01560000
         AIF   (N'&HEX GE 2).HEX2                               GP97225 01570000
         DC    AL1(3,0),SL2(&HEX(1)),AL2(&L&HEX(1))             GP97225 01580000
         AGO   .NOHEX                                           GP97225 01590000
.HEX2    DC    AL1(3,0),SL2(&HEX(1),&HEX(2))                    GP97225 01600000
.NOHEX   AIF   ('&PACK' EQ '').NOPACK                           GP97225 01610000
         AIF   (N'&PACK GE 2).PACK2                             GP97225 01620000
         DC    AL1(4,0),SL2(&PACK(1)),AL2(&L&PACK(1))           GP97225 01630000
         AGO   .NOPACK                                          GP97225 01640000
.PACK2   DC    AL1(4,0),SL2(&PACK(1),&PACK(2))                  GP97225 01650000
.NOPACK  AIF   ('&LIST' EQ '' OR N'&LIST LT 1).NOLIST           GP95235 01660000
&LN      SETA  N'&LIST                                          GP95235 01670000
.DOLIST  AIF   (&I GE &LN).NOLIST   DONE WITH LIST              GP95235 01680000
&I       SETA  &I+1          BUMP LOOP INDEX                    GP95235 01690000
&EN      SETA  K'&EK         GET LENGTH                         GP04234 01700000
         MACLIST &LIST(&I)   GET SUBLIST ITEMS                  GP04234 01710000
&EN      SETA  &MACP#        NUMBER OF ENTRIES (CHG FOR XF ASM) GP04234 01720000
         AIF   (&EN LT 1).DOLIST  USER IN COMA?                 GP95235 01730000
         AIF   (&EN LT 4).TOOLIST WARN                          GP95235 01740000
         MNOTE 4,'MORE THAN 3 SUBPARMS IN &LIST(&I) '           GP95235 01750000
.TOOLIST ANOP  ,                                                GP95235 01760000
&EK      SETC  '&MACP1'                                         GP04234 01770000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01780000
&EO      SETA  0             PRESET FOR NORMAL ADDRESSING MODE          01790000
&ET      SETC  '03'          PRESET FOR HEX DEFAULT             GP95235 01800000
         AIF   (&EM GT 0).TPFX                                  GP04234 01810000
&EK      SETC  '0'           ALLOW EXPANSION WITHOUT ERROR      GP04234 01820000
&EM      SETA  1                                                GP04234 01830000
         MNOTE 4,'DEBTRACE: PARAMETER &I REQUIRES AN ADDRESS'   GP04234 01840000
.TPFX    AIF   (&EM LT 2).NOTA31                                GP04234 01850000
         AIF   ('&EK'(1,1) NE '/').NOTIND                               01860000
&EO      SETA  &EO+1         REQUEST INDIRECT ADDRESSING                01870000
&EK      SETC  '&EK'(2,&EM-1)  DELETE LEADING CONTROL BYTE              01880000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01890000
.NOTIND  AIF   ('&EK'(&EM,1) NE '%').NOTA24                             01900000
&EO      SETA  &EO+2         REQUEST FORCED 24-BIT ADDRESSING           01910000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01920000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01930000
.NOTA24  AIF   ('&EK'(&EM,1) NE '?').NOTA31                             01940000
&EO      SETA  &EO+4         REQUEST FORCED 31-BIT ADDRESSING           01950000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01960000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01970000
.NOTA31  AIF   (&EN LT 3 OR '&MACP3' EQ 'HEX').HTYPE            GP95235 01980000
         AIF   ('&MACP3' EQ 'X').HTYPE                          GP97225 01990000
         AIF   ('&MACP3' EQ 'HEX').HTYPE                                02000000
         AIF   ('&MACP3' EQ 'T').TTYPE                          GP98189 02010000
         AIF   ('&MACP3' EQ 'TEXT').TTYPE                       GP95235 02020000
         AIF   ('&MACP3' EQ 'TXT').TTYPE                                02030000
         AIF   ('&MACP3' EQ 'C').CTYPE                          GP97225 02040000
         AIF   ('&MACP3' EQ 'CT').CTYPE                                 02050000
         AIF   ('&MACP3' EQ 'CTEXT').CTYPE                      GP97225 02060000
         AIF   ('&MACP3' EQ 'PACK').PTYPE                       GP97225 02070000
         AIF   ('&MACP3' EQ 'PACKED').PTYPE                     GP97225 02080000
         AIF   ('&MACP3' EQ 'P').PTYPE                          GP97225 02090000
         AIF   ('&MACP3' EQ 'PD').PTYPE                                 02100000
         AIF   ('&MACP3' EQ 'D').PTYPE                          GP97225 02110000
 MNOTE 4,'TYPE MUST BE TEXT, CTEXT, HEX, OR PACKED, NOT &MACP3'         02120000
         AGO   .HTYPE                                           GP95235 02130000
.TTYPE   ANOP  ,                                                GP95235 02140000
&ET      SETC  '01'          SET FOR TEXT                       GP95235 02150000
         AGO   .HTYPE                                           GP95235 02160000
.CTYPE   ANOP  ,                                                GP97225 02170000
&ET      SETC  '02'          SET FOR CONDITIONAL TEXT, ELSE HEX GP97225 02180000
         AGO   .HTYPE                                           GP97225 02190000
.PTYPE   ANOP  ,                                                GP97225 02200000
&ET      SETC  '04'          SET FOR PACKED                     GP97225 02210000
.HTYPE   ANOP  ,                                                GP97225 02220000
&EL      SETC  '&MACP2'                                         GP95235 02230000
         AIF   ('&EL' NE '').HLEN                               GP95235 02240000
&EL      SETC  '&L'.'&EK'                                               02250000
.HLEN    DC    X'0800',CL8'&MACP1',AL1(&ET,&EO),S(&EK,&EL)              02260000
         AGO   .DOLIST                                          GP95235 02270000
.NOLIST  AIF   (&BUGFAR).FARCL                                   95079  02280000
         AIF   (&BUGDYN).FARCL                                  GP97261 02290000
         AIF   (&BUGTRC).TRCCL                                  GP99113 02300000
         AIF   (&BUGEXT).EXTCL                                   95215  02310000
&V.B     BAL   R14,DBTRACE                                       92271  02320000
         AGO   .CMCAL                                            95079  02330000
.EXTCL   ANOP  ,                                                 95215  02340000
&V.B     L     R15,=V(DEBTRACE)    MEMBER DEBTROLD              GP05013 02350000
         LA    R0,&WA        PASS ADDRESS OF WORK AREA           95215  02360000
         AGO   .FARCM                                            95215  02370000
.FARCL   ANOP  ,                                                 95079  02380000
&V.B     L     R15,=A(DBTRACE)                                   95079  02390000
.FARCM   BASR  R14,R15                                           95079  02400000
.CMCAL   ANOP  ,                                                 95079  02410000
&V.X     LM    R0,R15,&WA                                               02420000
         AGO   .MEND                                                    02430000
.TRCCL   ANOP  ,             INVOKE PGMTRACE VIA ESPIE          GP99113 02440000
&V.X     DS    0H            END OF TRACE LIST                  GP99113 02450000
         AGO   .MEND                                            GP99113 02460000
.SWON    OI    DBTFLAG,DBTFLON  SET TRACING ON                   95079  02470000
         AGO   .MEND                                             95079  02480000
.SWEND   OI    DBTFLAG,DBTFLEND  CLOSE DCB AND STOP TRACE       GP98222 02490000
.SWOFF   NI    DBTFLAG,255-DBTFLON  SET TRACING OFF              95079  02500000
         AGO   .MEND                                             95079  02510000
.CODE    AIF   (&BUGFAR OR &BUGEXT).TESTDC                      GP97262 02520000
         AIF   ('&NM' EQ '').NONAME                                     02530000
&NM      DS    0H                                                       02540000
.NONAME  AIF   (NOT &BUGDYN).NOLODYN                            GP97262 02550000
         AIF   ('&MODE' NE 'DC').NOPUP                          GP00004 02560000
         PUSH  PRINT                                            GP00004 02570000
         PUSH  USING                                            GP00004 02580000
.*       PRINT GEN                                              GP00004 02590000
         DROP  ,                                                GP00004 02600000
         USING DBTRACE,R15                                      GP97265 02610000
.NOPUP   ANOP  ,                                                GP00004 02620000
DBTRACE  LA    R0,&WA        PASS ADDRESS OF WORK AREA          GP97262 02630000
         STM   R12,R1,DBTLOCSV  SAVE BASE AND RETURN            GP97265 02640000
         ICM   R15,15,@DEBTRAC  SEE IF PREVIOUSLY LOADED        GP97265 02650000
         BNZR  R15           INVOKE; RETURN VIA R14 TO CALLER   GP97265 02660000
         AIF   ('&MODE' NE 'DC').NODRP                          GP00004 02670000
         BASR  R12,0         MAKE LOCAL BASE                    GP97262 02680000
         DROP  R15                                              GP97265 02690000
         USING *,R12                                            GP97265 02700000
         AGO   .CMDRP                                           GP00004 02710000
.NODRP   MVC   #DEBTRAC,=CL8'DEBTROLD'                          GP00004 02720000
.CMDRP   LOAD  EPLOC=#DEBTRAC  LOAD EXTERNAL MODULE             GP97261 02730000
         ST    R0,@DEBTRAC   SAVE FOR NEXT TIME                 GP97261 02740000
.*FAILS* AIF   ('&MODE' NE 'DC').NOCLB                          GP00004 02750000
         ST    R0,DBTLOCSV+(15-12)*4  UPDATE TARGET ADDRESS     GP97265 02760000
  MACPARM DBTFLAG,(&OPT),NULL=&BUGSWCH*DBTFLON+DBTFLWID,OP=MVI,OPR=MVI  02770000
.NOCLB   LM    R12,R1,DBTLOCSV  RESTORE                         GP97265 02780000
         BR    R15           RETURN TO CALLER VIA R14           GP97262 02790000
         AIF   ('&MODE' NE 'DC').NOPOP                          GP00004 02800000
         POP   USING                                            GP97262 02810000
         POP   PRINT                                            GP97262 02820000
.NOPOP   AGO   .TESTDC                                          GP97262 02830000
.NOLODYN MNOTE 4,'INLINE EXPANSION NOT SUPPORTED - USE MACRO DEBINLIN'  02840000
.TESTDC  AIF   ('&MODE' NE 'DC').MEND                            95067  02850000
         AGO   .NODRTE                                           95067  02860000
.DATA    AIF   ('&NM' EQ '').NODLBL                                     02870000
&NM      DS    0D                                                       02880000
.NODLBL  AIF   ('&ROUT' EQ '').NODRTE                            95067  02890000
&BUGSWRT SETB  1                                                 95067  02900000
.NODRTE  AIF   (&BUGFAR OR '&MODE' EQ 'M').MEND                  95230  02910000
DBTPRESV DC    2F'0'  1/2    FOR SHORT FORMATTING                95230  02920000
.NOSVPFX ANOP  ,                                                 95230  02930000
&WA      DC    16F'0' 2/2    DEBUG SAVE AREA                    GP97265 02940000
DBTFLAG  DC    AL1(&BUGSWCH*DBTFLON+DBTFLWID)  DEBUG FLAG       GP98222 02950000
DBTFLTCB EQU   128             INCLUDE TCB ADDRESS IN MESSAGE           02960000
DBTFLWTO EQU   64              USE WTO INSTEAD OF PRT            95240  02970000
DBTFLWID EQU   32              USE WIDE FORMAT WHEN PRINTING    GP98222 02980000
DBTFLPRO EQU   16              PRODUCTION MODE / NEED DD TO PRT GP99113 02990000
DBTFLEND EQU   2               THIS IS A TERMINATION CALL       GP98222 03000000
DBTFLON  EQU   1               DEBUG BIT                                03010000
DBTFLAG2 DC    AL1(0)        ..RESERVED..                       GP99062 03020000
DBTFLAG3 DC    AL1(0)        ..RESERVED..                       GP99062 03030000
DBTFLAG4 DC    AL1(0)        ..RESERVED..                       GP99062 03040000
DBTCNT1  DC    A(&COUNT(1)+0)  COUNT OPTION                      95228  03050000
DBTCNT2  DC    A(&COUNT(2)+0)  COUNT OPTION                      95228  03060000
DBTCNT3  DC    A(&COUNT(3)+0)  COUNT OPTION                      95228  03070000
         MAPCMPRT PFX=DBT,DCB=&DCB,PRTMODE=&PRTMODE,DEV=&DEV    GP99113 03080000
         AIF   (NOT &BUGDYN).NODYNS                             GP97261 03090000
.BUGDYN  WXTRN DEBTRACE      SUPPORT LINKED-IN VERSION          GP97262 03100000
@DEBTRAC DC    A(DEBTRACE)   ADDRESS OF LOADED DEBTRACE         GP97261 03110000
#DEBTRAC DC    CL8'DEBTROLD'  LOAD MODULE NAME                  GP97261 03120000
DBTLOCSV DC    6A(0)         SAVE AREA                          GP97265 03130000
         AGO   .MEND                                            GP97262 03140000
.NODYNS  AIF   (&BUGFAR OR '&MODE' EQ 'M').MEND                  95228  03150000
DBTLOCSV DC    4F'0'         BASE SAVE                                  03160000
DBTWTO   DC    Y(56,0)       VCON                                93357  03170000
DBTWTOM  DC    C'MSG666 '    DEBUG HEADER                        93357  03180000
DBTWTON  DC    CL8' ',C' '   USER'S LABEL                               03190000
DBTWTOT  DC    CL36' '       USER'S HEX OR EBCDIC TEXT                  03200000
         AIF   ('&TCB' NE 'YES' AND NOT &BUGTCB).NOTCB           94011  03210000
         DC    C' '          EXTRA FOR UNPACK                    94011  03220000
DBTWTCB  DC    CL8' '        CURRENT TCB ADDRESS                 94011  03230000
.NOTCB   ANOP  ,                                                 94011  03240000
DBTWTOC  DC    C' '          EXTRA FOR UNPACK                           03250000
         AIF   (NOT &BUGSWRT).MEND  NO ROUTING CODE              95067  03260000
         DC    XL3'0'        EXTRA FOR DESCRIPTOR/ROUTING CODES  95067  03270000
.MEND    MEND  ,                                                        03280000
./ ADD NAME=DCBEXITD
         MACRO ,                                                        00010000
&L    DCBEXITD &DSECT=NO,&PREFIX=DX,&LEVEL2=,                          *00020000
               &USER=0,&FLAG1=0,&FLAG2=0,&FLAG3=0,&FLAG4=0,&DRECFM=0,  *00030000
               &BLOCKF=0,&LRECLF=0,&LRECLV=0,&LRECLD=0,&LRECLU=0 82178  00040000
         LCLC  &NM                                                      00050000
         LCLC  &P                                                       00060000
&P       SETC  '&PREFIX'                                                00070000
         AIF   (T'&PREFIX EQ 'O').NOPFX                                 00080000
         AIF   (K'&PREFIX LE 2).COMPFX                                  00090000
         MNOTE 8,'PREFIX=&PREFIX EXCESSIVE LENGTH'                      00100000
         AGO   .DEFPFX                                                  00110000
.NOPFX   MNOTE 8,'PREFIX= KEYWORD NOT ALLOWED TO BE NULLIFIED'          00120000
.DEFPFX  MNOTE 8,'PREFIX=DX' ASSUMED'                                   00130000
&P       SETC  'DX'                                                     00140000
.COMPFX  ANOP  ,                                                        00150000
&NM      SETC  '&L'                                                     00160000
         AIF   ('&L' NE '' OR '&DSECT' NE 'YES').NAMEOK                 00170000
&NM      SETC  'DCBEXITD'                                               00180000
*              AREA POINTED TO BY NOP (00 OR 80) IN DCB EXIT LIST:      00190000
.NAMEOK  AIF   ('&DSECT' NE 'YES').NODSECT                       81154  00200000
&NM      DSECT ,                                                        00210000
         AGO   .ID                                                      00220000
.NODSECT ANOP  ,                                                        00230000
&NM       DS   0D                                                       00240000
         SPACE 1                                                        00250000
.ID      ANOP  ,                                                        00260000
&P.DCBXID DC   CL8'DCBEXITP'           VALIDITY CHECK                   00270000
&P.DCBPTR DC   A(0)                    SET TO DCB ADDRESS               00280000
&P.USER   DC   A(&USER)                AVAILABLE TO USER         82178  00290000
&P.DOUBLE DC   D'0'                    DOUBLE WORD WORK AREA            00300000
&P.FLAG1  DC   AL1(&FLAG1)                                       82178  00310000
&P.1RCINT EQU  128                     RECORD INTERFACE (BFTEK=A) IF:   00320000
*                                      RECFM=VS | VBS                   00330000
*                                      QSAM                             00340000
*                                      LRECL¬=X, IE LRECL>=0            00350000
*                                      LRECL¬=0                         00360000
*                                      ELSE TURN OFF                    00370000
&P.1BLOCK EQU  64                      ERROR IF BAD BLOCK SIZE, I.E.    00380000
*                                      MOD(BLKSIZE,LRECL)¬=0            00390000
&P.1NOFBS EQU  32                      TURN OFF STANDARD IF RECFM=FBS   00400000
&P.1NOPCI EQU  16                      TURN OFF OPTCD=C                 00410000
&P.1NOSD  EQU  08                      TURN OFF OPTCD=Z  IF DA          00420000
&P.1FULLT EQU  04                      DEFAULT  BLKSIZE TO FULL TRACK   00430000
*                                                         (EQUIVALENT)  00440000
&P.1TRUNC EQU  02                      TRUNCATE BLKSIZE TO FULL TRACK   00450000
*                                      TRUNCATE BLKSIZE TO N*LRECL      00460000
*                                                          IF RECFM=FB  00470000
&P.FLAG2  DC   AL1(&FLAG2)                                       82178  00480000
&P.2CONCT EQU  128                     CONCAT. OF UNLIKE ATTRIBUTES     00490000
&P.2REGET EQU  64                      READ/GET MUST BE REISSUED        00500000
&P.2CCERR EQU  4                       FAIL CONTROL CHARACTER/NOCC      00510000
&P.2CCADJ EQU  2                       ADJUST DFLT LEN IF CC/NOCC V.V.  00520000
&P.2TARER EQU  1                       KEEP OPTCD=Z FOR TAPE (R.E.R.)   00530000
&P.FLAG3  DC   AL1(&FLAG3)                                       82178  00540000
&P.3BLKTB EQU  08                      USE CANNED DEVICE/BLKSI TABLE    00550000
&P.3BLKWY EQU  04                      USE WYLBUR BLKSIZE/LIMIT TABLE   00560000
&P.3ISWYL EQU  02                      IF IT LOOKS LIKE WYLBUR   81210  00570000
&P.3DFWYL EQU  01                      DEFAULT RECFM TO U (WYLBUR)      00580000
&P.FLAG4  DC   AL1(&FLAG4)                                       82178  00590000
&P.RETCOD DC   X'00'                   RETURN CODE FROM DCBEXIT         00600000
&P.DRECFM DC   AL1(&DRECFM)            DEFAULT RECFM             82178  00610000
&P.BLOCKF DC   Y(&BLOCKF)              DEFAULT BLOCKING FACTOR   82178  00620000
&P.LRECLF DC   Y(&LRECLF)              DEFAULT LRECL FOR RECFM=F..      00630000
&P.LRECLV DC   Y(&LRECLV)              DEFAULT LRECL FOR RECFM=V..      00640000
&P.LRECLD DC   Y(&LRECLD)              DEFAULT LRECL FOR RECFM=D..      00650000
&P.LRECLU DC   Y(&LRECLU)              DEFAULT LRECL FOR RECFM=U..      00660000
          DS   0A                                                       00670000
&P.OPLIST DC   AL.1(1),AL.7(0),AL3(0)  ONE PER ENTRY:                   00680000
*        DS    AL.1                    1 IF LAST                        00690000
*        DS    AL.7                    TYPE                             00700000
*        DS    AL3                     PARAMETERS FOR TYPE              00710000
&P.TNOP   EQU  0                       NULL ENTRY                       00720000
&P.TEXIT  EQU  1                       2ND LEVEL EXIT                   00730000
&P.TBLOCK EQU  2                       BLKSIZE BY DEVICE TYPE           00740000
&P.TWYLBK EQU  3                       WYLBUR BLOCKSIZE LIMIT TABLE     00750000
&P.TPREX  EQU  4                       PRE-DCBEXIT EXIT          82308  00760000
&P.TMAXBK EQU  5                       BLOCKSIZE LIMIT TABLE     82308  00770000
&P.TEXITF EQU  6                       POST-DCBEXIT EXIT         83275  00780000
         AIF   (T'&LEVEL2 EQ 'O').NOLVL                          81154  00790000
         AIF   (&LEVEL2 LT 2).NOLVL                              81154  00800000
         DC    (&LEVEL2-1)X'80000000'  LEVEL 2 FIELDS            81154  00810000
.NOLVL   SPACE 1                                                        00820000
*        DS    0F                                                       00830000
*              BLOCKSIZE TABLE FOR CODE DXTBLOCK                        00840000
*        DC    AL1(CLASS,TYPE)         UCBTBYT3,4                       00850000
*        DC    AL2(BLKSIZE)            DEFAULT FOR THIS TYPE            00860000
*                  CLASS     TYPE      CONDITION                        00870000
*                  CLASS     TYPE      CLASS=UCBTBYT3 & TYPE=UCBTBYT4   00880000
*                  CLASS     X'FF'     CLASS=UCBTBYT3                   00890000
*                  X'FF'     TYPE      TYPE =DCBDEVT                    00900000
*                  X'FF'     X'FF'     DEFAULT - END OF LIST            00910000
         SPACE 1                                                        00920000
*              BLOCKSIZE TABLE FOR DXTWYLBK (WYLBUR EDIT)               00930000
*                                  DXTMAXBK (ANY)                82308  00940000
*        DC    AL1(CLASS,TYPE)         UCBTBYT3,4                       00950000
*        DC    AL2(DEFAULT,MIN,MAX)    VALUES FOR THIS TYPE      81154  00960000
*                  CLASS     TYPE      CONDITION                        00970000
*                  CLASS     TYPE      CLASS=UCBTBYT3 & TYPE=UCBTBYT4   00980000
*                  CLASS     X'FF'     CLASS=UCBTBYT3                   00990000
*                  X'FF'     TYPE      TYPE =DCBDEVT                    01000000
*                  X'FF'     X'FF'     DEFAULT - END OF LIST            01010000
.END     MEND  ,                                                        01020000
./ ADD NAME=DCIN
         MACRO ,                                                        00010000
&NM      DCIN  &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9,&O10         GP04234 00020000
.********************************************************************** 00030000
.*                                                                      00040000
.*   SOME OF US ARE HORRIBLY LAZY - THIS MACRO DEFINES A (PRESUMED      00050000
.*   CHARACTER) CONSTANT WITH THE LABEL POINTING TO THE *LAST*          00060000
.*   BYTE OF THE CONSTANT, AS USED BY MVCIN FROM FIELD                  00070000
.*                                                                      00080000
.********************************************************************** 00090000
.*                                                                      00100000
         LCLC  &BL                                                      00110000
         LCLA  &I                                                       00120000
&I       SETA  &SYSNDX                                                  00130000
&BL      SETC  'ZZB'.'&I'                                               00140000
         AIF   (N'&SYSLIST LE 1).NUM1                                   00150000
         AIF   (N'&SYSLIST LE 2).NUM2                                   00160000
         AIF   (N'&SYSLIST LE 3).NUM3                                   00170000
         AIF   (N'&SYSLIST LE 4).NUM4                                   00180000
         AIF   (N'&SYSLIST LE 5).NUM5                                   00190000
         AIF   (N'&SYSLIST LE 6).NUM6                                   00200000
         AIF   (N'&SYSLIST LE 7).NUM7                                   00210000
         AIF   (N'&SYSLIST LE 8).NUM8                                   00220000
         AIF   (N'&SYSLIST LE 9).NUM9                                   00230000
&BL      DC    &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9,&O10                 00240000
         AIF   (N'&SYSLIST LE 10).NUMOK                                 00250000
         MNOTE 4,'DCIN: MORE THAN 10 OPERANDS'                          00260000
         AGO   .NUMOK                                                   00270000
.NUM9    ANOP  ,                                                        00280000
&BL      DC    &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9                      00290000
         AGO   .NUMOK                                                   00300000
.NUM8    ANOP  ,                                                        00310000
&BL      DC    &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8                          00320000
         AGO   .NUMOK                                                   00330000
.NUM7    ANOP  ,                                                        00340000
&BL      DC    &O1,&O2,&O3,&O4,&O5,&O6,&O7                              00350000
         AGO   .NUMOK                                                   00360000
.NUM6    ANOP  ,                                                        00370000
&BL      DC    &O1,&O2,&O3,&O4,&O5,&O6                                  00380000
         AGO   .NUMOK                                                   00390000
.NUM5    ANOP  ,                                                        00400000
&BL      DC    &O1,&O2,&O3,&O4,&O5                                      00410000
         AGO   .NUMOK                                                   00420000
.NUM4    ANOP  ,                                                        00430000
&BL      DC    &O1,&O2,&O3,&O4                                          00440000
         AGO   .NUMOK                                                   00450000
.NUM3    ANOP  ,                                                        00460000
&BL      DC    &O1,&O2,&O3                                              00470000
         AGO   .NUMOK                                                   00480000
.NUM2    ANOP  ,                                                        00490000
&BL      DC    &O1,&O2                                                  00500000
         AGO   .NUMOK                                                   00510000
.NUM1    ANOP  ,                                                        00520000
&BL      DC    &O1                                                      00530000
.*                                                                      00540000
.NUMOK   ANOP  ,                                                        00550000
&NM      EQU   *-1,*-&BL+1,C'C'                                         00560000
         MEND  ,                                                        00570000
./ ADD NAME=DCLC
         MACRO                                                          00010000
&NAME    DCLC  &AA,&DUMMY1,&DUMMY2,&CAPWORD=,&CAPLETR=,&PRINT=          00020000
         GBLB  &DCLCLST      IF ON, PRINT COMMENTS SHOWING FLAGS        00030000
         LCLA  &LENGTH,&AIN,&AOUT,&K,&USERLNG,&QUOTE1                   00040000
         LCLB  &CW           IF ON , PROCESSING A CAPITAL WORD          00050000
         LCLC  &CAPL,&CAPW,&CIN,&COUT,&DUPLC,&LNC,&T                    00060000
         LCLC  &P(15),&Q(120)                                           00070000
         ACTR  30*K'&AA+3    30 TIMES NO. OF CHARACTERS IN OPERAND      00080000
.*360D-CM-000  DCLC          DEFINE-CONSTANT-LOWER-CASE    V 01/08/69 * 00090000
.* BY  CHUCK MEYER, IBM, N.Y.PUBLISHING, 555 MADISON, NYC, 10022, USA * 00100000
&DCLCLST SETB  ((&DCLCLST AND '&PRINT' NE 'OFF')  OR  '&PRINT' EQ 'ON') 00110000
.*                                                                      00120000
         AIF   (K'&AA LT 3).ERROR1                                      00130000
         AIF   ('&AA'(K'&AA,1)  EQ  '''').OKPARAM                       00140000
.ERROR1  AIF   ('&PRINT'  EQ  'ON'  OR  '&PRINT'  EQ  'OFF').MEND       00150000
         MNOTE 4,'INVALID OR MISSING OPERAND.  DATA IGNORED   '         00160000
         AIF   ('&NAME'  EQ  '').MEND                                   00170000
&NAME    EQU   *             BUT AT LEAST YOUR -NAME- WILL BE DEFINED.  00180000
         AGO   .MEND                                                    00190000
.*                                                                      00200000
.OKPARAM ANOP                                                           00210000
.*   DETERMINE CAP-WORD,  BYTE WHICH WILL -FLAG- START OF CAPITAL WORD. 00220000
&CAPW    SETC  '/'     SLASH     *STD-VALU*                             00230000
         AIF   (K'&CAPWORD NE  1  AND  K'&CAPWORD  NE  3).OKCAPW        00240000
&CAPW    SETC  '&CAPWORD'(1,1)    PICK UP FIRST POSITION                00250000
         AIF   (K'&CAPWORD  NE  3).OKCAPW                               00260000
&CAPW    SETC  '&CAPWORD'(2,1)   PICK UP SECOND POSITION                00270000
.OKCAPW  ANOP                                                           00280000
.*                                                                      00290000
.*   DETERMINE CAP-LETTER,  BYTE TO -FLAG- NEXT LETTER AS A CAPITAL     00300000
&CAPL    SETC  '<'   LESS-THAN SIGN    *STD-VALU*                       00310000
         AIF   (K'&CAPLETR  NE  1  AND  K'&CAPLETR  NE  3).OKCAPL       00320000
&CAPL    SETC  '&CAPLETR'(1,1)   PICK UP FIRST POSITION                 00330000
         AIF   (K'&CAPLETR  NE  3).OKCAPL                               00340000
&CAPL    SETC  '&CAPLETR'(2,1)    PICK UP SECOND POSITION               00350000
.OKCAPL  ANOP                                                           00360000
.*                                                                      00370000
         AIF   (NOT  &DCLCLST).NONOTES    PRINT NOTES, IF REQUESTED     00380000
         MNOTE *,'CAP-WORD   CHARACTER IS ''&CAPW'' .'                  00390000
         MNOTE *,'CAP-LETTER CHARACTER IS ''&CAPL'' .'                  00400000
.NONOTES ANOP                                                           00410000
.*                                                                      00420000
.QTLOOP  ANOP  ,   SCAN LEFT-TO-RIGHT FOR FIRST QUOTE                   00430000
&QUOTE1  SETA  &QUOTE1+1     BUMP TO NEXT POSITION                      00440000
         AIF   ('&AA'(&QUOTE1,1)  NE  '''').QTLOOP                      00450000
.*  &QUOTE1  NOW  POINTS  TO  LEADING  QUOTE  IN  CONSTANT              00460000
.*   CHECK FOR USER-SUPPLIED DUPLICATION-FACTOR                         00470000
         AIF   ('&AA'(1,1) LT '0').NODUPL                               00480000
.DUPLOOP AIF   ('&AA'(&AIN+1,1)  LT  '0').DUPEND                        00490000
&AIN     SETA  &AIN+1                                                   00500000
         AIF   (&AIN  LT  8).DUPLOOP                                    00510000
.DUPEND  ANOP                                                           00520000
&DUPLC   SETC  '&AA'(1,&AIN)   PICK UP USERS DUPLICATION-FACTOR         00530000
.NODUPL  ANOP  ,   &AIN POINTS TO LAST DIGIT IN DUPL.FACTOR OR ZERO     00540000
.*                                                                      00550000
.*   CHECK FOR USER-SUPPLIED LENGTH ASSIGNMENT                          00560000
.LNGLOOP ANOP  ,       LOOP TO FIND BEGINNING OF LENGTH FIELD           00570000
&AIN     SETA  &AIN+1                                                   00580000
         AIF   ('&AA'(&AIN,1)  EQ  '''').NOLNGTH                        00590000
         AIF   ('&AA'(&AIN,1)  LT  '0'  AND  &AIN  LT  &QUOTE1).LNGLOOP 00600000
.*  &AIN NOW POINTS TO FIRST DIGIT IN LENGTH ATTRIBUTE.                 00610000
&LNC     SETC  '&AA'(&AIN,&QUOTE1-&AIN)       USERS-LENGTH IN CHARS     00620000
&USERLNG SETA  &LNC          USERS-LENGTH IN NUMERICS                   00630000
.NOLNGTH ANOP                                                           00640000
.*                                                                      00650000
.*   NOW WE CAN START SCANNING THE ACTUAL DATA                          00660000
.*                                                                      00670000
&AIN     SETA  &QUOTE1       SET INPUT POINTER TO FIRST QUOTE           00680000
&LENGTH  SETA  K'&AA-&AIN-1    TENTATIVE LENGTH ATTRIBUTE               00690000
.*                                                                      00700000
.LOOP1   ANOP  ,   LOOP THRU HERE AS WE SCAN EACH INPUT CHARACTER       00710000
&AIN     SETA  &AIN+1        BUMP INPUT-POINTER                         00720000
&AOUT    SETA  &AOUT+1       BUMP OUTPUT-POINTER                        00730000
         AIF   (&AIN  GE  K'&AA).ENDSCAN   IF LAST CHARACTER, ALL DONE. 00740000
&CIN     SETC  '&AA'(&AIN,1)  SAVE THIS INPUT CHARACTER                 00750000
&CW      SETB  ((&CW  AND  '&CIN'  NE  ' ')  OR  '&CIN'  EQ  '&CAPW')   00760000
.*   TURN ON &CW IF THIS IS CAP-WORD CHAR, TURN OFF &CW IF THIS IS BLNK 00770000
         AIF   ('&CIN'  EQ  '&CAPW'  OR  '&CIN'  EQ  'CAPL').CAPITAL    00780000
         AIF   ('&CIN'  EQ  ''''   OR '&CIN'  EQ  '&&'(1,1)).QUOTE      00790000
         AIF   ('&CIN'  LT  'A'  OR  '&CIN'  GT  'Z'  OR  &CW).SETSAME  00800000
.*                                                                      00810000
.*  &AIN NOW POINTS TO A CAPITAL LETTER ON INPUT, WHICH MUST BE         00820000
.*  CONVERTED TO ITS LOWER-CASE EQUIVALENT.                             00830000
.*   THE 26 LETTERS OF THE ALPHABET ARE LISTED HERE,                    00840000
.*   ORDERED BY THEIR FREQUENCY OF OCCURANCE IN THE ENGLISH LANGUAGE .. 00850000
.*              'ETAOSINRHLDCUMYBPWFGVKJXQZ'                            00860000
.*             ERGO,  WE WILL BUILD OUR TABLE IN THAT ORDER.            00870000
.*                                                                      00880000
&K       SETA  1                                                        00890000
.LOOP2   AIF   ('ETAOSINRHLDCUMYBPWFGVKJXQZ'(&K,1)  EQ  '&CIN').LCFOUND 00900000
&K       SETA  &K+1                                                     00910000
         AIF   (&K  LE  26).LOOP2                                       00920000
         AGO   .SETSAME      WAS NOT ALPHABETIC                         00930000
.LCFOUND ANOP  ,    &K POINTS TO POSITION IN TABLE FOR THIS LETTER      00940000
&COUT    SETC  'etaosinrhldcumybpwfgvkjxqz'(&K,1)  LOWER CASE PUNCHES   00950000
&Q(&AOUT) SETC '&COUT'       SET OUTPUT LETTER TO THIS L-C LETTER       00960000
         AGO   .LOOP1        GET NEXT LETTER                            00970000
.*                                                                      00980000
.*                                                                      00990000
.QUOTE   ANOP  ,   TO HANDLE PAIRED QUOTES AND PAIRED AMPERSANDS        01000000
&Q(&AOUT) SETC '&CIN'        SET UP OUTPUT CHARACTER                    01010000
&AOUT    SETA  &AOUT+1       BUMP OUTPUT-CHARACTER-POINTER              01020000
.*                                                                      01030000
.CAPITAL ANOP  ,   TO HANDLE CAP-LETR AND CAP-WORD CHARACTERS           01040000
&LENGTH  SETA  &LENGTH-1     DOESN'T COUNT IN LENGTH                    01050000
         AIF   (&AIN+1  GE  K'&AA).ENDSCAN    LAST CHARACTER  IN  LIT ? 01060000
&AIN     SETA  &AIN+1        BUMP INPUT-CHARACTER-POINTER               01070000
&CIN     SETC  '&AA'(&AIN,1)   PICK UP NEXT INPUT CHARACTER             01080000
.*                                                                      01090000
.SETSAME ANOP  ,   TO SET UP OUTPUT CHARACTER WITHOUT CHANGING IT       01100000
&Q(&AOUT) SETC '&CIN'                                                   01110000
         AGO   .LOOP1        GET NEXT LETTER                            01120000
.*                                                                      01130000
.ENDSCAN ANOP  ,  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  01140000
.*  WE HAVE COMPLETED THE SCAN OF INPUT,  NOW PREPARE THE -DC-.      *  01150000
.*                                                                   *  01160000
         AIF   (&USERLNG  EQ  &LENGTH  OR  &USERLNG  EQ  0).OKLNGTH     01170000
&T       SETC  '*'           SET UP MNOTE TO BE JUST A COMMENT          01180000
         AIF   (&USERLNG  GT  &LENGTH).LNMNOTE                          01190000
&T       SETC  '1'           MAKE IT AN ERROR,  TRUNCATION              01200000
.LNMNOTE AIF   (NOT &DCLCLST).LNMNPRT  SKIP MNOTE IF PRINT OFF   87287  01210000
         MNOTE &T,'YOUR ''CL&USERLNG'' SPEC. OVERRIDES ASSUMED LENGTH O*01220000
               F &LENGTH..'                                             01230000
.LNMNPRT ANOP  ,                                                 87287  01240000
&LENGTH  SETA  &USERLNG      PICK UP USER'S LENGTH                      01250000
.OKLNGTH ANOP                                                           01260000
&AIN     SETA  1                                                        01270000
&AOUT    SETA  1                                                        01280000
.*  THE NEXT 5 LINES CONVERT THE 120 SUBSCRIPTED SET SYMBOLS            01290000
.*  (EACH OF WHICH CONTAINS ONE BYTE OF DATA OR NULL)  INTO 15          01300000
.*  SUBSCRIPTED SET SYMBOLS (EACH CONTAING 8 BYTES).                    01310000
.LOOP3   ANOP                                                           01320000
&P(&AOUT) SETC '&Q(&AIN)&Q(&AIN+1)&Q(&AIN+2)&Q(&AIN+3)&Q(&AIN+4)&Q(&AIN+01330000
               +5)&Q(&AIN+6)&Q(&AIN+7)'    EIGHT AT A TIME              01340000
&AIN     SETA  &AIN+8                                                   01350000
&AOUT    SETA  &AOUT+1                                                  01360000
         AIF   (&AOUT  LE  15).LOOP3    KEPP LOOKING                    01370000
.*                                                                      01380000
&NAME    DC   &DUPLC.CL&LENGTH'&P(1)&P(2)&P(3)&P(4)&P(5)&P(6)&P(7)&P(8)&01390000
               &P(9)&P(10)&P(11)&P(12)&P(13)&P(14)&P(15)'               01400000
.MEND    MEND                                                           01410000
./ ADD NAME=DCON
         MACRO ,                                                        00010000
&NM      DCON  &STR,&END=                              ADDED ON GP02242 00020000
         GBLB  &VCON@OP                                                 00030000
         GBLC  &VCON@NM                                                 00040000
         LCLA  &I,&J,&K,&L                                              00050000
.********************************************************************** 00060000
.**                                                                  ** 00070000
.**  DCON BUILDS A TEXT MESSAGE BEGINNING WITH A ONE-BYTE LENGTH-1,  ** 00080000
.**    FOLLOWED BY TEXT.                                             ** 00090000
.**                                                                  ** 00100000
.**  USE   DCON  'TEXT'                                              ** 00110000
.**                                                                  ** 00120000
.**  OR    DCON  'TEXT1',END=LABEL                                   ** 00130000
.**        DC     ...ZERO OR MORE STORAGE ITEMS                      ** 00140000
.**  LABEL DCON   *END    TO GENERATE A SINGLE MESSAGE               ** 00150000
.**                                                                  ** 00160000
.********************************************************************** 00170000
&K       SETA  K'&STR                                                   00180000
         AIF   (T'&END NE 'O').TSTOPEN                                  00190000
         AIF   (T'&STR EQ 'O').CLOSE                                    00200000
         AIF   ('&STR'(1,1) EQ '*').CLOSE                               00210000
.TSTOPEN AIF   (&K EQ 0).COMLEN                                         00220000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00230000
&I       SETA  2                                                        00240000
&J       SETA  &K-2                                                     00250000
&K       SETA  &J                                                       00260000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00270000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00280000
&I       SETA  &I+1                                                     00290000
         AGO   .INC                                                     00300000
.SK2     ANOP  ,                                                        00310000
&I       SETA  &I+2                                                     00320000
&K       SETA  &K-1                                                     00330000
.INC     AIF   (&I LE &J).LOOP                                          00340000
.COMLEN  AIF   (NOT &VCON@OP).NOPEN                                     00350000
         MNOTE 4,'PRIOR DCON/VCON NOT TERMINATED'                       00360000
&VCON@OP SETB  0                                                        00370000
.NOPEN   AIF   (T'&END NE 'O').OPEN                                     00380000
         AIF   (&K EQ 0).REQSTR                                         00390000
         AIF   ('&STR'(1,1) EQ '''').QSTR                               00400000
&NM      DC    AL1(&K-1),C'&STR'                                        00410000
         AGO   .MEND                                                    00420000
.QSTR    ANOP  ,                                                        00430000
&NM      DC    AL1(&K-1),C&STR                                          00440000
         AGO   .MEND                                                    00450000
.OPEN    AIF   (&K NE 0).OPSTR                                          00460000
&NM      DC    AL1(&END-*-2)                                            00470000
         AGO   .SETOPEN                                                 00480000
.OPSTR   AIF   ('&STR'(1,1) EQ '''').OQSTR                              00490000
&NM      DC    AL1(&END-*-2),C'&STR'                                    00500000
         AGO   .SETOPEN                                                 00510000
.OQSTR   ANOP  ,                                                        00520000
&NM      DC    AL1(&END-*-2),C&STR                                      00530000
.SETOPEN ANOP  ,                                                        00540000
&VCON@NM SETC  '&END'                                                   00550000
&VCON@OP SETB  1                                                        00560000
         MEXIT ,                                                        00570000
.REQSTR  MNOTE 4,'TEXT STRING REQUIRED'                                 00580000
         MEXIT ,                                                        00590000
.CLOSE   AIF   (&VCON@OP).WASOPEN                                       00600000
         MNOTE 4,'DCON/VCON END OUT OF SEQUENCE'                        00610000
.WASOPEN AIF   ('&NM' EQ '' OR '&NM' EQ '&VCON@NM').BLAB                00620000
&NM      EQU   *                                                        00630000
.BLAB    ANOP  ,                                                        00640000
&VCON@NM EQU   *                                                        00650000
&VCON@NM SETC  ''                                                       00660000
&VCON@OP SETB  0                                                        00670000
.MEND    MEND  ,                                                        00680000
./ ADD NAME=DCS
         MACRO                                                          00010000
&NAME    DCS                                                            00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*        DCS  -  DEFINE CONSTANT FOR SCREEN                          * 00050000
.*                                                                    * 00060000
.*        WRITTEN BY BILL GODFREY                                     * 00070000
.*        PLANNING RESEARCH CORPORATION                               * 00080000
.*        PRC COMPUTER CENTER, MCLEAN VA 22101                        * 00090000
.*        DATE WRITTEN: JANUARY 8 1981.                               * 00100000
.*        DATE UPDATED: MARCH 18 1982. (ROW AND COL IN PARENS)        * 00110000
.*        GP@P6          JULY 25 1986. (EXTENDED ATTRS, MEDIUM INTENS)* 00120000
.*        GP@P6     SEPTEMBER 23 1986. (ESCAPES, WRITES, RA, MFA, MF) * 00130000
.*        GP@P6        AUGUST 24 1987. (EAU, WSF, RB, RM, RMA)        * 00140000
.*        GP@P6       OCTOBER 15 1987. (3270 AND GRAPHIC EXTRAS)      * 00150000
.*                                                                    * 00160000
.*        THIS MACRO IS USED FOR CODING A FULLSCREEN 3270 DISPLAY.    * 00170000
.*                                                                    * 00180000
.*        SAMPLE                                                      * 00190000
.*           DCS    AL1(WCC),SBA,(1,1),RTA,(7,1),X'00',IC             * 00200000
.*                                                                    * 00210000
.*        IT SIMPLIFIES THE CODING OF A SCREEN IN THE FOLLOWING WAYS. * 00220000
.*        .  BUFFER ADDRESSES ARE SPECIFIED AS ROW AND COLUMN NUM-    * 00230000
.*           BER.  THE MACRO TRANSLATES THEM INTO THE 3270 CODE.      * 00240000
.*        .  ORDERS ARE SPECIFIED BY NAME, SUCH AS 'SBA' AND 'SF',    * 00250000
.*           SO YOU DONT HAVE TO KNOW THE HEX CODES FOR THEM,         * 00260000
.*        .  COMMONLY USED ATTRIBUTE BYTES ARE SPECIFIED BY NAME      * 00270000
.*           (A SET OF RESERVED NAMES) SO YOU DONT HAVE TO KNOW       * 00280000
.*           THE HEX CODES FOR THEM.                                  * 00290000
.*        .  IT SAVES A LOT OF DOCUMENTATION WORK, AND MAKES          * 00300000
.*           THE CODE EASIER FOR OTHERS TO UNDERSTAND.                * 00310000
.*                                                                    * 00320000
.*        THE USER OF THE MACRO MUST STILL UNDERSTAND HOW A SCREEN    * 00330000
.*        IS CONSTRUCTED BEFORE USING IT. THE MACRO MERELY MAKES IT   * 00340000
.*        EASIER TO SPECIFY THE VALUES.  IT DOES VERY LITTLE ERROR    * 00350000
.*        CHECKING.  FOR INSTANCE, IT DOES NOT CHECK TO SEE IF        * 00360000
.*        YOU FOLLOW AN 'SBA' WITH A BUFFER ADDRESS.  IT IS POSSIBLE  * 00370000
.*        TO CODE A THOROUGHLY INVALID SCREEN.                        * 00380000
.*                                                                    * 00390000
.*        THE MACRO MAY HAVE ANY NUMBER OF OPERANDS, CONSISTING OF    * 00400000
.*        ANY COMBINATION OF THE FOLLOWING.                           * 00410000
.*                                                                    * 00420000
.*        .  AN ESCAPE CHARACTER.                                     * 00430000
.*           VALID ESCAPE CHARACTERS ARE:                             * 00440000
.*           ESC - ESCAPE                                             * 00450000
.*           GE  - GRAPHIC ESCAPE                                     * 00460000
.*        .  A WRITE COMMAND.                                         * 00470000
.*           VALID WRITE COMMANDS ARE:                                * 00480000
.*           WR  - WRITE (WRT)                                        * 00490000
.*           EW  - ERASE/WRITE                                        * 00500000
.*           EWA - ERASE/WRITE ALTERNATE                              * 00510000
.*           EAU - ERASE ALL UNPROTECTED                              * 00520000
.*           WSF - WRITE STRUCTURED FIELD                             * 00530000
.*        .  A READ COMMAND.                                          * 00540000
.*           VALID READ COMMANDS ARE:                                 * 00550000
.*           RB  - READ BUFFER                                        * 00560000
.*           RM  - READ MODIFIED                                      * 00570000
.*           RMA - READ MODIFIED ALL                                  * 00580000
.*        .  A 3270 ORDER.                                            * 00590000
.*           VALID 3270 ORDERS ARE:                                   * 00600000
.*           SBA, SF, RA (RTA), IC, PT (HT), EUA, SA, SFE, MF (MFA).  * 00610000
.*        .  A BUFFER ADDRESS IN PARENTHESES.                         * 00620000
.*           IF AN OPERAND IS IN PARENTHESES, IT IS ASSUMED THAT      * 00630000
.*           THE ROW AND COLUMN NUMBER ARE BETWEEN THE PARENS,        * 00640000
.*           SEPARATED BY A COMMA.  EXAMPLE: (1,1)                    * 00650000
.*           THIS FORM OF BUFFER ADDRESS IS NEW AS OF MARCH 18 1982.  * 00660000
.*        .  A ROW OR COLUMN NUMBER OF A BUFFER ADDRESS (OLD FORMAT). * 00670000
.*           IF AN OPERAND IS NUMERIC, IT IS ASSUMED TO BE            * 00680000
.*           A ROW OR COLUMN NUMBER.  IT TAKES 2 OPERANDS TO          * 00690000
.*           SPECIFY THE BUFFER ADDRESS (ROW AND COLUMN) SO NUMERIC   * 00700000
.*           OPERANDS MUST ALWAYS BE SPECIFIED IN PAIRS, THE          * 00710000
.*           FIRST BEING THE ROW AND THE SECOND BEING THE COLUMN.     * 00720000
.*           THIS FORMAT IS SUPPORTED ONLY FOR COMPATIBILITY WITH     * 00730000
.*           THE ORIGINAL VERSION OF THIS MACRO.                      * 00740000
.*        .  AN ATTRIBUTE BYTE.                                       * 00750000
.*           VALID ATTRIBUTE BYTES ARE:                               * 00760000
.*           UNPLO  - UNPROTECTED NORMAL INTENSITY                    * 00770000
.*           UNPMD  - UNPROTECTED MEDIUM INTENSITY                    * 00780000
.*           UNPHI  - UNPROTECTED HIGH INTENSITY                      * 00790000
.*           UNPNP  - UNPROTECTED NO-DISPLAY                          * 00800000
.*           PROLO  - PROTECTED NORMAL INTENSITY                      * 00810000
.*           PROLOS - PROTECTED NORMAL INTENSITY AUTO-SKIP            * 00820000
.*           PROMD  - PROTECTED MEDIUM INTENSITY                      * 00830000
.*           PROMDS - PROTECTED MEDIUM INTENSITY AUTO-SKIP            * 00840000
.*           PROHI  - PROTECTED HIGH INTENSITY                        * 00850000
.*           PROHIS - PROTECTED HIGH INTENSITY AUTO-SKIP              * 00860000
.*        .  AN EXTENDED ATTRIBUTE TYPE.                              * 00870000
.*           VALID ATTRIBUTE TYPES ARE:                               * 00880000
.*           FIELD, VALIDN, OUTLIN, HILITE, COLOUR, PGMSYM, BKCOLR    * 00890000
.*           AND TRANSP.                                              * 00900000
.*        .  AN EXTENDED HIGHLIGHTING SPECIFICATION.                  * 00910000
.*           VALID HIGHLIGHTINGS ARE:                                 * 00920000
.*           NORMAL, BLINK, REVERSE AND USCORE.                       * 00930000
.*        .  AN EXTENDED COLOUR SPECIFICATION.                        * 00940000
.*           VALID COLOURS ARE:                                       * 00950000
.*           BLUE, RED, PINK, GREEN, TURQ, YELLOW, WHITE AND NORMAL.  * 00960000
.*        .  A BACKGROUND TRANSPARENCY SPECIFICATION.                 * 00970000
.*           VALID TRANSPARENCIES ARE:                                * 00980000
.*           NORMAL (TRANSPARENT) AND OPAQUE (NON-TRANSPARENT).       * 00990000
.*        .  A FORMAT CONTROL ORDER.                                  * 01000000
.*           VALID FORMAT CONTROL ORDERS ARE:                         * 01010000
.*           NUL, SUB, DUP, FM, FF, CR, NL, EM, EO, BYP, RES, SI, SO. * 01020000
.*        .  A GRAPHIC ORDER.                                         * 01030000
.*           VALID GRAPHIC ORDERS ARE TOO NUMEROUS TO MENTION.        * 01040000
.*        .  A HEX, CHARACTER, OR ADDRESS CONSTANT.                   * 01050000
.*           FOR EXAMPLE, X'00', OR C'ENTER SIGNON'                   * 01060000
.*           THIS CAN BE USED FOR DATA WITHIN FIELDS OR FOR           * 01070000
.*           ATTRIBUTE BYTES, ORDERS, THE 'WCC', OR BUFFER            * 01080000
.*           ADDRESSES (IF YOU WANT TO FIGURE THEM OUT).              * 01090000
.*                                                                    * 01100000
.*        IF THE OPERANDS DO NOT ALL FIT ON ONE LINE, YOU CAN         * 01110000
.*        EITHER CONTINUE THE LINE IN THE STANDARD ASSEMBLER WAY      * 01120000
.*        OR CODE THE MACRO AGAIN ON THE NEXT LINE WITH THE           * 01130000
.*        REMAINING OPERANDS.  THE RESULT IS THE SAME EITHER WAY.     * 01140000
.*                                                                    * 01150000
.*        THE BUFFER ADDRESS CONVERSIONS ARE FOR A                    * 01160000
.*        SCREEN SIZE OF 24 ROWS BY 80 COLUMNS. FOR SCREENS           * 01170000
.*        OF OTHER DIMENSIONS (43 BY 80, 12 BY 40) THE MACRO          * 01180000
.*        NEEDS ONLY A FEW CHANGES.                                   * 01190000
.*                                                                    * 01200000
.*        WARNING: IF YOU CODE THE MACRO WITH A LABEL IN COLUMN 1,    * 01210000
.*        AND YOU LIKE USING LENGTH ATTRIBUTES, BEWARE THAT THE       * 01220000
.*        LENGTH ATTRIBUTE OF THE LABEL IS NOT NECESSARILY THE        * 01230000
.*        TOTAL LENGTH OF THE DATA GENERATED BY THE MACRO.            * 01240000
.*                                                                    * 01250000
.*        PROGRAMMING NOTE:                                           * 01260000
.*        SA,NORMAL,NORMAL     WILL DO IN THREE BYTES WHAT            * 01270000
.*        SA,HILITE,NORMAL,SA,COLOUR,NORMAL,SA,PGMSYM,NORMAL          * 01280000
.*                             WILL DO IN NINE BYTES.                 * 01290000
.*                                                                    * 01300000
.*        TECHNICAL NOTES:                                            * 01310000
.*        ATTRIBUTES WITH CODES IN THE RANGE X'00' TO X'7F' HAVE      * 01320000
.*        VALUES GIVEN BY A 1-BYTE BINARY NUMBER.  EG. X'42' (COLOUR) * 01330000
.*        ATTRIBUTES WITH CODES IN THE RANGE X'C0' TO X'FF' HAVE      * 01340000
.*        BIT-ENCODED VALUES.  EG. X'C0' (3270 FIELD ATTRIBUTE)       * 01350000
.*        CHARACTER SETS:                                             * 01360000
.*        X'00' - DEFAULT               X'40'-X'EF' - LOADABLE LCID   * 01370000
.*        X'F0'-X'F7' - NON-LOADABLE LCID   X'F8'-X'FE' - DBCS LCID   * 01380000
.*        FIELD VALIDATION:                                           * 01390000
.*        SPECIFY A BYTE IN THE RANGE X'00' TO X'07' ON THE BASIS OF  * 01400000
.*        X'01' ON FOR TRIGGER, X'02' ON FOR MANDATORY ENTRY AND      * 01410000
.*        X'04' ON FOR MANDATORY FILL.                                * 01420000
.*        FIELD OUTLINING:                                            * 01430000
.*        SPECIFY A BYTE IN THE RANGE X'00' TO X'0F' ON THE BASIS OF  * 01440000
.*        X'01' ON FOR UNDERLINE, X'02' ON FOR RIGHT VERTICAL LINE,   * 01450000
.*        X'04' ON FOR OVERLINE AND X'08' ON FOR LEFT VERTICAL LINE.  * 01460000
.*                                                                    * 01470000
.********************************************************************** 01480000
.*                                                                      01490000
         LCLA  &R,&C,&P,&Q                                              01500000
         LCLA  &AN,&AS,&AL                                              01510000
         LCLB  &B,&NUMERIC,&INTEGER                                     01520000
         LCLC  &T(64)                                                   01530000
         LCLC  &N,&ROW,&COL                                             01540000
         LCLC  &CS,&STRING                                              01550000
&T(1)    SETC  '40'                                                     01560000
&T(2)    SETC  'C1'                                                     01570000
&T(3)    SETC  'C2'                                                     01580000
&T(4)    SETC  'C3'                                                     01590000
&T(5)    SETC  'C4'                                                     01600000
&T(6)    SETC  'C5'                                                     01610000
&T(7)    SETC  'C6'                                                     01620000
&T(8)    SETC  'C7'                                                     01630000
&T(9)    SETC  'C8'                                                     01640000
&T(10)   SETC  'C9'                                                     01650000
&T(11)   SETC  '4A'                                                     01660000
&T(12)   SETC  '4B'                                                     01670000
&T(13)   SETC  '4C'                                                     01680000
&T(14)   SETC  '4D'                                                     01690000
&T(15)   SETC  '4E'                                                     01700000
&T(16)   SETC  '4F'                                                     01710000
.*                                                                      01720000
&T(17)   SETC  '50'                                                     01730000
&T(18)   SETC  'D1'                                                     01740000
&T(19)   SETC  'D2'                                                     01750000
&T(20)   SETC  'D3'                                                     01760000
&T(21)   SETC  'D4'                                                     01770000
&T(22)   SETC  'D5'                                                     01780000
&T(23)   SETC  'D6'                                                     01790000
&T(24)   SETC  'D7'                                                     01800000
&T(25)   SETC  'D8'                                                     01810000
&T(26)   SETC  'D9'                                                     01820000
&T(27)   SETC  '5A'                                                     01830000
&T(28)   SETC  '5B'                                                     01840000
&T(29)   SETC  '5C'                                                     01850000
&T(30)   SETC  '5D'                                                     01860000
&T(31)   SETC  '5E'                                                     01870000
&T(32)   SETC  '5F'                                                     01880000
.*                                                                      01890000
&T(33)   SETC  '60'                                                     01900000
&T(34)   SETC  '61'                                                     01910000
&T(35)   SETC  'E2'                                                     01920000
&T(36)   SETC  'E3'                                                     01930000
&T(37)   SETC  'E4'                                                     01940000
&T(38)   SETC  'E5'                                                     01950000
&T(39)   SETC  'E6'                                                     01960000
&T(40)   SETC  'E7'                                                     01970000
&T(41)   SETC  'E8'                                                     01980000
&T(42)   SETC  'E9'                                                     01990000
&T(43)   SETC  '6A'                                                     02000000
&T(44)   SETC  '6B'                                                     02010000
&T(45)   SETC  '6C'                                                     02020000
&T(46)   SETC  '6D'                                                     02030000
&T(47)   SETC  '6E'                                                     02040000
&T(48)   SETC  '6F'                                                     02050000
.*                                                                      02060000
&T(49)   SETC  'F0'                                                     02070000
&T(50)   SETC  'F1'                                                     02080000
&T(51)   SETC  'F2'                                                     02090000
&T(52)   SETC  'F3'                                                     02100000
&T(53)   SETC  'F4'                                                     02110000
&T(54)   SETC  'F5'                                                     02120000
&T(55)   SETC  'F6'                                                     02130000
&T(56)   SETC  'F7'                                                     02140000
&T(57)   SETC  'F8'                                                     02150000
&T(58)   SETC  'F9'                                                     02160000
&T(59)   SETC  '7A'                                                     02170000
&T(60)   SETC  '7B'                                                     02180000
&T(61)   SETC  '7C'                                                     02190000
&T(62)   SETC  '7D'                                                     02200000
&T(63)   SETC  '7E'                                                     02210000
&T(64)   SETC  '7F'                                                     02220000
.*                                                                      02230000
&N       SETC  '&NAME'                                                  02240000
&AN      SETA  N'&SYSLIST          NUMBER OF OPERANDS                   02250000
&AS      SETA  0                                                        02260000
&B       SETB  0 FALSE                                                  02270000
.EACH    AIF   (&AN EQ 0).EPILOG                                        02280000
&AS      SETA  &AS+1                                                    02290000
&CS      SETC  '&AS'                                                    02300000
&AL      SETA  K'&SYSLIST(&AS)                                          02310000
         AIF   (T'&SYSLIST(&AS) EQ 'O').NEXT                            02320000
         AIF   ('&SYSLIST(&AS)'(1,1) EQ '(').PAIR                       02330000
&NUMERIC SETB  (T'&SYSLIST(&AS) EQ 'N')                                 02340000
&INTEGER SETB  ('&SYSLIST(&AS)'(1,1) GE '0')                            02350000
         AIF   (&NUMERIC AND &INTEGER).ROWCOL                           02360000
         AIF   (NOT &B).ROWCOLX                                         02370000
         MNOTE 4,'             &CS.) MISSING COLUMN NUMBER'             02380000
&B       SETB  0 FALSE                                                  02390000
.ROWCOLX ANOP                                                           02400000
&STRING  SETC  '&SYSLIST(&AS)'                                          02410000
.*             ESCAPES                                                  02420000
         AIF   ('&STRING' EQ 'ESC').ESC                                 02430000
         AIF   ('&STRING' EQ 'GE').GE                                   02440000
.*             WRITES                                                   02450000
         AIF   ('&STRING' EQ 'WR').WR                                   02460000
         AIF   ('&STRING' EQ 'WRT').WR                                  02470000
         AIF   ('&STRING' EQ 'EW').EW                                   02480000
         AIF   ('&STRING' EQ 'EWA').EWA                                 02490000
         AIF   ('&STRING' EQ 'EAU').EAU                                 02500000
         AIF   ('&STRING' EQ 'WSF').WSF                                 02510000
.*             READS                                                    02520000
         AIF   ('&STRING' EQ 'RB').RB                                   02530000
         AIF   ('&STRING' EQ 'RM').RM                                   02540000
         AIF   ('&STRING' EQ 'RMA').RMA                                 02550000
.*             3270 ORDERS                                              02560000
         AIF   ('&STRING' EQ 'SBA').SBA                                 02570000
         AIF   ('&STRING' EQ 'SF').SF                                   02580000
         AIF   ('&STRING' EQ 'SFE').SFE                                 02590001
         AIF   ('&STRING' EQ 'RA').RA                                   02600000
         AIF   ('&STRING' EQ 'RTA').RA                                  02610000
         AIF   ('&STRING' EQ 'IC').IC                                   02620000
         AIF   ('&STRING' EQ 'PT').PT                                   02630000
         AIF   ('&STRING' EQ 'HT').PT                                   02640000
         AIF   ('&STRING' EQ 'EUA').EUA                                 02650000
         AIF   ('&STRING' EQ 'SA').SA                                   02660000
         AIF   ('&STRING' EQ 'MF').MF                                   02670000
         AIF   ('&STRING' EQ 'MFA').MF                                  02680000
.*             ATTRIBUTES                                               02690000
         AIF   ('&STRING' EQ 'UNPLO').UNPLO                             02700000
         AIF   ('&STRING' EQ 'UNPMD').UNPMD                             02710000
         AIF   ('&STRING' EQ 'UNPHI').UNPHI                             02720000
         AIF   ('&STRING' EQ 'UNPNP').UNPNP                             02730000
         AIF   ('&STRING' EQ 'PROLO').PROLO                             02740000
         AIF   ('&STRING' EQ 'PROLOS').PROLOS                           02750000
         AIF   ('&STRING' EQ 'PROMD').PROMD                             02760000
         AIF   ('&STRING' EQ 'PROMDS').PROMDS                           02770000
         AIF   ('&STRING' EQ 'PROHI').PROHI                             02780000
         AIF   ('&STRING' EQ 'PROHIS').PROHIS                           02790000
.*             EXTENDED ATTRIBUTE TYPES                                 02800000
         AIF   ('&STRING' EQ 'FIELD').FIELD                             02810000
         AIF   ('&STRING' EQ 'VALIDN').VALIDN                           02820000
         AIF   ('&STRING' EQ 'OUTLIN').OUTLIN                           02830000
         AIF   ('&STRING' EQ 'HILITE').HILITE                           02840000
         AIF   ('&STRING' EQ 'COLOUR').COLOUR                           02850000
         AIF   ('&STRING' EQ 'PGMSYM').PGMSYM                           02860000
         AIF   ('&STRING' EQ 'BKCOLR').BKCOLR                           02870000
         AIF   ('&STRING' EQ 'TRANSP').TRANSP                           02880000
.*             HIGHLIGHTING                                             02890000
         AIF   ('&STRING' EQ 'NORMAL').NORMAL                           02900000
         AIF   ('&STRING' EQ 'BLINK').BLINK                             02910000
         AIF   ('&STRING' EQ 'REVERSE').REVERSE                         02920000
         AIF   ('&STRING' EQ 'USCORE').USCORE                           02930000
.*             COLOURS                                                  02940000
         AIF   ('&STRING' EQ 'BLUE').BLUE                               02950000
         AIF   ('&STRING' EQ 'RED').RED                                 02960000
         AIF   ('&STRING' EQ 'PINK').PINK                               02970000
         AIF   ('&STRING' EQ 'GREEN').GREEN                             02980000
         AIF   ('&STRING' EQ 'TURQ').TURQ                               02990000
         AIF   ('&STRING' EQ 'YELLOW').YELLOW                           03000000
         AIF   ('&STRING' EQ 'WHITE').WHITE                             03010000
.*             TRANSPARENCIES                                           03020000
         AIF   ('&STRING' EQ 'OPAQUE').OPAQUE                           03030000
.*             FORMAT CONTROL ORDERS                                    03040000
         AIF   ('&STRING' EQ 'NUL').NUL                                 03050000
         AIF   ('&STRING' EQ 'SUB').SUB                                 03060000
         AIF   ('&STRING' EQ 'DUP').DUP                                 03070000
         AIF   ('&STRING' EQ 'FM').FM                                   03080000
         AIF   ('&STRING' EQ 'FF').FF                                   03090000
         AIF   ('&STRING' EQ 'CR').CR                                   03100000
         AIF   ('&STRING' EQ 'NL').NL                                   03110000
         AIF   ('&STRING' EQ 'EM').EM                                   03120000
         AIF   ('&STRING' EQ 'EO').EO                                   03130000
         AIF   ('&STRING' EQ 'BYP').BYP                                 03140000
         AIF   ('&STRING' EQ 'RES').RES                                 03150000
         AIF   ('&STRING' EQ 'SI').SI                                   03160000
         AIF   ('&STRING' EQ 'SO').SO                                   03170000
.*             GRAPHIC ORDERS                                           03180000
         AIF   ('&STRING' EQ 'GBAR').GBAR                               03190000
         AIF   ('&STRING' EQ 'GBIMG').GBIMG                             03200000
         AIF   ('&STRING' EQ 'GCBIMG').GCBIMG                           03210000
         AIF   ('&STRING' EQ 'GCHST').GCHST                             03220000
         AIF   ('&STRING' EQ 'GCCHST').GCCHST                           03230000
         AIF   ('&STRING' EQ 'GEAR').GEAR                               03240000
         AIF   ('&STRING' EQ 'GEIMG').GEIMG                             03250000
         AIF   ('&STRING' EQ 'GFLT').GFLT                               03260000
         AIF   ('&STRING' EQ 'GCFLT').GCFLT                             03270000
         AIF   ('&STRING' EQ 'GFARC').GFARC                             03280000
         AIF   ('&STRING' EQ 'GCFARC').GCFARC                           03290000
         AIF   ('&STRING' EQ 'GIMD').GIMD                               03300000
         AIF   ('&STRING' EQ 'GLINE').GLINE                             03310000
         AIF   ('&STRING' EQ 'GCLINE').GCLINE                           03320000
         AIF   ('&STRING' EQ 'GMRK').GMRK                               03330000
         AIF   ('&STRING' EQ 'GRLINE').GRLINE                           03340000
         AIF   ('&STRING' EQ 'GCRLINE').GCRLINE                         03350000
         AIF   ('&STRING' EQ 'GSBMX').GSBMX                             03360000
         AIF   ('&STRING' EQ 'GSCA').GSCA                               03370000
         AIF   ('&STRING' EQ 'GSCC').GSCC                               03380000
         AIF   ('&STRING' EQ 'GSCD').GSCD                               03390000
         AIF   ('&STRING' EQ 'GSCR').GSCR                               03400000
         AIF   ('&STRING' EQ 'GSCS').GSCS                               03410000
         AIF   ('&STRING' EQ 'GSCH').GSCH                               03420000
         AIF   ('&STRING' EQ 'GSCOL').GSCOL                             03430000
         AIF   ('&STRING' EQ 'GSECOL').GSECOL                           03440000
         AIF   ('&STRING' EQ 'GSLT').GSLT                               03450000
         AIF   ('&STRING' EQ 'GSLW').GSLW                               03460000
         AIF   ('&STRING' EQ 'GSMC').GSMC                               03470000
         AIF   ('&STRING' EQ 'GSMP').GSMP                               03480000
         AIF   ('&STRING' EQ 'GSMS').GSMS                               03490000
         AIF   ('&STRING' EQ 'GSMT').GSMT                               03500000
         AIF   ('&STRING' EQ 'GSMX').GSMX                               03510000
         AIF   ('&STRING' EQ 'GSPS').GSPS                               03520000
         AIF   ('&STRING' EQ 'GSPT').GSPT                               03530000
         AIF   ('&STRING' EQ 'GCOMT').GCOMT                             03540000
         AIF   ('&STRING' EQ 'GSAP').GSAP                               03550000
         AIF   ('&STRING' EQ 'GSCP').GSCP                               03560000
         AIF   ('&STRING' EQ 'GSGCH').GSGCH                             03570000
         AIF   ('&STRING' EQ 'GEPROL').GEPROL                           03580000
         AIF   ('&STRING' EQ 'GESD').GESD                               03590000
         AIF   ('&STRING' EQ 'GERASE').GERASE                           03600000
         AIF   ('&STRING' EQ 'GSTOPDR').GSTOPDR                         03610000
         AIF   ('&STRING' EQ 'GATTCUR').GATTCUR                         03620000
         AIF   ('&STRING' EQ 'GDETCUR').GDETCUR                         03630000
         AIF   ('&STRING' EQ 'GSETCUR').GSETCUR                         03640000
         AIF   ('&STRING' EQ 'GSCUDEF').GSCUDEF                         03650000
         AIF   ('&STRING' EQ 'GNOP1').GNOP1                             03660000
.*             CONSTANTS                                                03670000
.*             IF THE OPERAND IS NONE OF THE ABOVE, IT IS               03680000
.*             PRESUMED TO BE ANY VALID 'DC' CONSTANT.                  03690000
.DC      ANOP                                                           03700000
&N       DC    &STRING                                                  03710000
         AGO   .NEXT                                                    03720000
.ESC     ANOP                                                           03730000
&N       DC    X'27'               ESCAPE                               03740000
         AGO   .NEXT                                                    03750000
.GE      ANOP                                                           03760000
&N       DC    X'08'               GRAPHIC ESCAPE                       03770000
         AGO   .NEXT                                                    03780000
.WR      ANOP                                                           03790000
&N       DC    X'F1'               WRITE                                03800000
         AGO   .NEXT                                                    03810000
.EW      ANOP                                                           03820000
&N       DC    X'F5'               ERASE/WRITE                          03830000
         AGO   .NEXT                                                    03840000
.EWA     ANOP                                                           03850000
&N       DC    X'7E'               ERASE/WRITE ALTERNATE                03860000
         AGO   .NEXT                                                    03870000
.EAU     ANOP                                                           03880000
&N       DC    X'6F'               ERASE ALL UNPROTECTED                03890000
         AGO   .NEXT                                                    03900000
.WSF     ANOP                                                           03910000
&N       DC    X'F3'               WRITE STRUCTURED FIELD               03920000
         AGO   .NEXT                                                    03930000
.RB      ANOP                                                           03940000
&N       DC    X'F2'               READ BUFFER                          03950000
         AGO   .NEXT                                                    03960000
.RM      ANOP                                                           03970000
&N       DC    X'F6'               READ MODIFIED                        03980000
         AGO   .NEXT                                                    03990000
.RMA     ANOP                                                           04000000
&N       DC    X'6E'               READ MODIFIED ALL                    04010000
         AGO   .NEXT                                                    04020000
.SBA     ANOP                                                           04030000
&N       DC    X'11'               SET BUFFER ADDRESS                   04040000
         AGO   .NEXT                                                    04050000
.SF      ANOP                                                           04060000
&N       DC    X'1D'               START FIELD                          04070000
         AGO   .NEXT                                                    04080000
.RA      ANOP                                                           04090000
&N       DC    X'3C'               REPEAT TO ADDRESS                    04100000
         AGO   .NEXT                                                    04110000
.IC      ANOP                                                           04120000
&N       DC    X'13'               INSERT CURSOR                        04130000
         AGO   .NEXT                                                    04140000
.PT      ANOP                                                           04150000
&N       DC    X'05'               PROGRAM TAB  (HORIZONTAL TAB)        04160000
         AGO   .NEXT                                                    04170000
.EUA     ANOP                                                           04180000
&N       DC    X'12'               ERASE UNPROTECTED TO ADDRESS         04190000
         AGO   .NEXT                                                    04200000
.SA      ANOP                                                           04210000
&N       DC    X'28'               SET ATTRIBUTE                        04220000
         AGO   .NEXT                                                    04230000
.SFE     ANOP                                                           04240000
&N       DC    X'29'               START FIELD EXTENDED                 04250000
         AGO   .NEXT                                                    04260000
.MF      ANOP                                                           04270000
&N       DC    X'2C'               MODIFY FIELD ATTRIBUTES              04280000
         AGO   .NEXT                                                    04290000
.UNPLO   ANOP                                                           04300000
&N       DC    X'40'               UNPROTECTED NORMAL INTENSITY         04310000
         AGO   .NEXT                                                    04320000
.UNPMD   ANOP                                                           04330000
&N       DC    X'C4'               UNPROTECTED MEDIUM INTENSITY         04340000
         AGO   .NEXT                                                    04350000
.UNPHI   ANOP                                                           04360000
&N       DC    X'C8'               UNPROTECTED HIGH INTENSITY           04370000
         AGO   .NEXT                                                    04380000
.UNPNP   ANOP                                                           04390000
&N       DC    X'4C'               UNPROTECTED NO-DISPLAY               04400000
         AGO   .NEXT                                                    04410000
.PROLO   ANOP                                                           04420000
&N       DC    X'60'               PROTECTED NORMAL INTENSITY           04430000
         AGO   .NEXT                                                    04440000
.PROLOS  ANOP                                                           04450000
&N       DC    X'F0'               PROTECTED NORMAL INTENSITY SKIP      04460000
         AGO   .NEXT                                                    04470000
.PROMD   ANOP                                                           04480000
&N       DC    X'E4'               PROTECTED MEDIUM INTENSITY           04490000
         AGO   .NEXT                                                    04500000
.PROMDS  ANOP                                                           04510000
&N       DC    X'F4'               PROTECTED MEDIUM INTENSITY SKIP      04520000
         AGO   .NEXT                                                    04530000
.PROHI   ANOP                                                           04540000
&N       DC    X'E8'               PROTECTED HIGH INTENSITY             04550000
         AGO   .NEXT                                                    04560000
.PROHIS  ANOP                                                           04570000
&N       DC    X'F8'               PROTECTED HIGH INTENSITY SKIP        04580000
         AGO   .NEXT                                                    04590000
.FIELD   ANOP                                                           04600000
&N       DC    X'C0'               3270 FIELD ATTRIBUTE                 04610000
         AGO   .NEXT                                                    04620000
.VALIDN  ANOP                                                           04630000
&N       DC    X'C1'               FIELD VALIDATION                     04640000
         AGO   .NEXT                                                    04650000
.OUTLIN  ANOP                                                           04660000
&N       DC    X'C2'               FIELD OUTLINING                      04670000
         AGO   .NEXT                                                    04680000
.HILITE  ANOP                                                           04690000
&N       DC    X'41'               EXTENDED HIGHLIGHTING                04700000
         AGO   .NEXT                                                    04710000
.COLOUR  ANOP                                                           04720000
&N       DC    X'42'               EXTENDED COLOUR                      04730000
         AGO   .NEXT                                                    04740000
.PGMSYM  ANOP                                                           04750000
&N       DC    X'43'               PROGRAMMED SYMBOLS                   04760000
         AGO   .NEXT                                                    04770000
.BKCOLR  ANOP                                                           04780000
&N       DC    X'45'               BACKGROUND COLOUR                    04790000
         AGO   .NEXT                                                    04800000
.TRANSP  ANOP                                                           04810000
&N       DC    X'46'               BACKGROUND TRANSPARENCY              04820000
         AGO   .NEXT                                                    04830000
.NORMAL  ANOP                                                           04840000
&N       DC    X'00'               CHARACTER ATTRIBUTE RESET (DEFAULT)  04850000
         AGO   .NEXT                                                    04860000
.BLINK   ANOP                                                           04870000
&N       DC    X'F1'               BLINK HIGHLIGHTING                   04880000
         AGO   .NEXT                                                    04890000
.REVERSE ANOP                                                           04900000
&N       DC    X'F2'               REVERSE VIDEO HIGHLIGHTING           04910000
         AGO   .NEXT                                                    04920000
.USCORE  ANOP                                                           04930000
&N       DC    X'F4'               UNDERSCORE HIGHLIGHTING              04940000
         AGO   .NEXT                                                    04950000
.BLUE    ANOP                                                           04960000
&N       DC    X'F1'               BLUE COLOUR                          04970000
         AGO   .NEXT                                                    04980000
.RED     ANOP                                                           04990000
&N       DC    X'F2'               RED COLOUR                           05000000
         AGO   .NEXT                                                    05010000
.PINK    ANOP                                                           05020000
&N       DC    X'F3'               PINK COLOUR                          05030000
         AGO   .NEXT                                                    05040000
.GREEN   ANOP                                                           05050000
&N       DC    X'F4'               GREEN COLOUR                         05060000
         AGO   .NEXT                                                    05070000
.TURQ    ANOP                                                           05080000
&N       DC    X'F5'               TURQUOISE COLOUR                     05090000
         AGO   .NEXT                                                    05100000
.YELLOW  ANOP                                                           05110000
&N       DC    X'F6'               YELLOW COLOUR                        05120000
         AGO   .NEXT                                                    05130000
.WHITE   ANOP                                                           05140000
&N       DC    X'F7'               WHITE COLOUR                         05150000
         AGO   .NEXT                                                    05160000
.OPAQUE  ANOP                                                           05170000
&N       DC    X'FF'               OPAQUE (NON-TRANSPARENT)             05180000
         AGO   .NEXT                                                    05190000
.NUL     ANOP                                                           05200000
&N       DC    X'00'               NULL                                 05210000
         AGO   .NEXT                                                    05220000
.SUB     ANOP                                                           05230000
&N       DC    X'3F'               SUBSTITUTE                           05240000
         AGO   .NEXT                                                    05250000
.DUP     ANOP                                                           05260000
&N       DC    X'1C'               DUPLICATE                            05270000
         AGO   .NEXT                                                    05280000
.FM      ANOP                                                           05290000
&N       DC    X'1E'               FIELD MARK                           05300000
         AGO   .NEXT                                                    05310000
.FF      ANOP                                                           05320000
&N       DC    X'0C'               FORM FEED                            05330000
         AGO   .NEXT                                                    05340000
.CR      ANOP                                                           05350000
&N       DC    X'0D'               CARRIAGE RETURN                      05360000
         AGO   .NEXT                                                    05370000
.NL      ANOP                                                           05380000
&N       DC    X'15'               NEW LINE                             05390000
         AGO   .NEXT                                                    05400000
.EM      ANOP                                                           05410000
&N       DC    X'19'               END OF MESSAGE                       05420000
         AGO   .NEXT                                                    05430000
.EO      ANOP                                                           05440000
&N       DC    X'FF'               EIGHT ONES                           05450000
         AGO   .NEXT                                                    05460000
.BYP     ANOP                                                           05470000
&N       DC    X'24'               BYPASS  (INHIBIT PRESENTATION)       05480000
         AGO   .NEXT                                                    05490000
.RES     ANOP                                                           05500000
&N       DC    X'14'               RESTORE  (ENABLE PRESENTATION)       05510000
         AGO   .NEXT                                                    05520000
.SI      ANOP                                                           05530000
&N       DC    X'0F'               SHIFT IN                             05540000
         AGO   .NEXT                                                    05550000
.SO      ANOP                                                           05560000
&N       DC    X'0E'               SHIFT OUT                            05570000
         AGO   .NEXT                                                    05580000
.GBAR    ANOP                                                           05590000
&N       DC    X'68'               BEGIN AREA                           05600000
         AGO   .NEXT                                                    05610000
.GBIMG   ANOP                                                           05620000
&N       DC    X'D1'               BEGIN IMAGE                          05630000
         AGO   .NEXT                                                    05640000
.GCBIMG  ANOP                                                           05650000
&N       DC    X'91'               BEGIN IMAGE                          05660000
         AGO   .NEXT                                                    05670000
.GCHST   ANOP                                                           05680000
&N       DC    X'C3'               CHARACTER STRING                     05690000
         AGO   .NEXT                                                    05700000
.GCCHST  ANOP                                                           05710000
&N       DC    X'83'               CHARACTER STRING                     05720000
         AGO   .NEXT                                                    05730000
.GEAR    ANOP                                                           05740000
&N       DC    X'60'               END AREA                             05750000
         AGO   .NEXT                                                    05760000
.GEIMG   ANOP                                                           05770000
&N       DC    X'93'               END IMAGE                            05780000
         AGO   .NEXT                                                    05790000
.GFLT    ANOP                                                           05800000
&N       DC    X'C5'               FILLET                               05810000
         AGO   .NEXT                                                    05820000
.GCFLT   ANOP                                                           05830000
&N       DC    X'85'               FILLET                               05840000
         AGO   .NEXT                                                    05850000
.GFARC   ANOP                                                           05860000
&N       DC    X'C7'               FULL ARC                             05870000
         AGO   .NEXT                                                    05880000
.GCFARC  ANOP                                                           05890000
&N       DC    X'87'               FULL ARC                             05900000
         AGO   .NEXT                                                    05910000
.GIMD    ANOP                                                           05920000
&N       DC    X'92'               IMAGE DATA                           05930000
         AGO   .NEXT                                                    05940000
.GLINE   ANOP                                                           05950000
&N       DC    X'C1'               LINE                                 05960000
         AGO   .NEXT                                                    05970000
.GCLINE  ANOP                                                           05980000
&N       DC    X'81'               LINE                                 05990000
         AGO   .NEXT                                                    06000000
.GMRK    ANOP                                                           06010000
&N       DC    X'C3'               MARKER                               06020000
         AGO   .NEXT                                                    06030000
.GRLINE  ANOP                                                           06040000
&N       DC    X'E1'               RELATIVE LINE                        06050000
         AGO   .NEXT                                                    06060000
.GCRLINE ANOP                                                           06070000
&N       DC    X'A1'               RELATIVE LINE                        06080000
         AGO   .NEXT                                                    06090000
.GSBMX   ANOP                                                           06100000
&N       DC    X'0D'               SET BACKGROUND MIX                   06110000
         AGO   .NEXT                                                    06120000
.GSCA    ANOP                                                           06130000
&N       DC    X'34'               SET CHARACTER ANGLE                  06140000
         AGO   .NEXT                                                    06150000
.GSCC    ANOP                                                           06160000
&N       DC    X'33'               SET CHARACTER CELL                   06170000
         AGO   .NEXT                                                    06180000
.GSCD    ANOP                                                           06190000
&N       DC    X'3A'               SET CHARACTER DIRECTION              06200000
         AGO   .NEXT                                                    06210000
.GSCR    ANOP                                                           06220000
&N       DC    X'39'               SET CHARACTER PRECISION              06230000
         AGO   .NEXT                                                    06240000
.GSCS    ANOP                                                           06250000
&N       DC    X'38'               SET CHARACTER SET                    06260000
         AGO   .NEXT                                                    06270000
.GSCH    ANOP                                                           06280000
&N       DC    X'35'               SET CHARACTER SHEAR                  06290000
         AGO   .NEXT                                                    06300000
.GSCOL   ANOP                                                           06310000
&N       DC    X'0A'               SET COLOUR                           06320000
         AGO   .NEXT                                                    06330000
.GSECOL  ANOP                                                           06340000
&N       DC    X'26'               SET EXTENDED COLOUR                  06350000
         AGO   .NEXT                                                    06360000
.GSLT    ANOP                                                           06370000
&N       DC    X'18'               SET LINE TYPE                        06380000
         AGO   .NEXT                                                    06390000
.GSLW    ANOP                                                           06400000
&N       DC    X'19'               SET LINE WIDTH                       06410000
         AGO   .NEXT                                                    06420000
.GSMC    ANOP                                                           06430000
&N       DC    X'37'               SET MARKER CELL                      06440000
         AGO   .NEXT                                                    06450000
.GSMP    ANOP                                                           06460000
&N       DC    X'3B'               SET MARKER PRECISION                 06470000
         AGO   .NEXT                                                    06480000
.GSMS    ANOP                                                           06490000
&N       DC    X'3C'               SET MARKER SET                       06500000
         AGO   .NEXT                                                    06510000
.GSMT    ANOP                                                           06520000
&N       DC    X'29'               SET MARKER SYMBOL                    06530000
         AGO   .NEXT                                                    06540000
.GSMX    ANOP                                                           06550000
&N       DC    X'0C'               SET MIX                              06560000
         AGO   .NEXT                                                    06570000
.GSPS    ANOP                                                           06580000
&N       DC    X'08'               SET PATTERN SET                      06590000
         AGO   .NEXT                                                    06600000
.GSPT    ANOP                                                           06610000
&N       DC    X'28'               SET PATTERN SYMBOL                   06620000
         AGO   .NEXT                                                    06630000
.GCOMT   ANOP                                                           06640000
&N       DC    X'01'               COMMENT                              06650000
         AGO   .NEXT                                                    06660000
.GSAP    ANOP                                                           06670000
&N       DC    X'22'               SET ARC PARAMETERS                   06680000
         AGO   .NEXT                                                    06690000
.GSCP    ANOP                                                           06700000
&N       DC    X'21'               SET CURRENT POSITION                 06710000
         AGO   .NEXT                                                    06720000
.GSGCH   ANOP                                                           06730000
&N       DC    X'04'               SEGMENT CHARACTERISTICS              06740000
         AGO   .NEXT                                                    06750000
.GEPROL  ANOP                                                           06760000
&N       DC    X'3E'               END PROLOGUE                         06770000
         AGO   .NEXT                                                    06780000
.GESD    ANOP                                                           06790000
&N       DC    X'FF'               END OF SYMBOL DEFINITION             06800000
         AGO   .NEXT                                                    06810000
.GERASE  ANOP                                                           06820000
&N       DC    X'0A'               ERASE GRAPHIC PRESENTATION SPACE     06830000
         AGO   .NEXT                                                    06840000
.GSTOPDR ANOP                                                           06850000
&N       DC    X'0F'               STOP DRAW                            06860000
         AGO   .NEXT                                                    06870000
.GATTCUR ANOP                                                           06880000
&N       DC    X'08'               ATTACH GRAPHIC CURSOR                06890000
         AGO   .NEXT                                                    06900000
.GDETCUR ANOP                                                           06910000
&N       DC    X'09'               DETACH GRAPHIC CURSOR                06920000
         AGO   .NEXT                                                    06930000
.GSETCUR ANOP                                                           06940000
&N       DC    X'31'               SET GRAPHIC CURSOR POSITION          06950000
         AGO   .NEXT                                                    06960000
.GSCUDEF ANOP                                                           06970000
&N       DC    X'21'               SET CURRENT DEFAULTS                 06980000
         AGO   .NEXT                                                    06990000
.GNOP1   ANOP                                                           07000000
&N       DC    X'00'               NO OPERATION                         07010000
         AGO   .NEXT                                                    07020000
.********************************************************************** 07030000
.PAIR    ANOP                                                           07040000
         AIF   (N'&SYSLIST(&AS) NE 2).PERR1                             07050000
&NUMERIC SETB  (T'&SYSLIST(&AS,1) EQ 'N')                               07060000
&INTEGER SETB  ('&SYSLIST(&AS,1)'(1,1) GE '0')                          07070000
         AIF   (NOT &NUMERIC OR NOT &INTEGER).PERR2                     07080000
&R       SETA  &SYSLIST(&AS,1)                                          07090000
&NUMERIC SETB  (T'&SYSLIST(&AS,2) EQ 'N')                               07100000
&INTEGER SETB  ('&SYSLIST(&AS,2)'(1,1) GE '0')                          07110000
         AIF   (NOT &NUMERIC OR NOT &INTEGER).PERR2                     07120000
&C       SETA  &SYSLIST(&AS,2)                                          07130000
         AIF   (&R LT 1 OR &R GT 24).ROWERR                             07140000
         AIF   (&C LT 1 OR &C GT 80).COLERR                             07150000
&P       SETA  (&R-1)*80+&C-1                                           07160000
&Q       SETA  &P/64               QUOTIENT                             07170000
&R       SETA  &P-&Q*64+1          REMAINDER+1                          07180000
&Q       SETA  &Q+1                QUOTIENT+1                           07190000
&N       DC    X'&T(&Q)&T(&R)'     ROW AND COLUMN                       07200000
         AGO   .NEXT                                                    07210000
.PERR1   MNOTE 4,'             &CS.) PARENS FOUND BUT NOT 2 NUMBERS'    07220000
         MEXIT                                                          07230000
.PERR2   MNOTE 4,'             &CS.) NON NUMERIC ROW/COLUMN'            07240000
         MEXIT                                                          07250000
.********************************************************************** 07260000
.ROWCOL  ANOP                                                           07270000
         AIF   (&B).COL            BRANCH IF ROW HAS BEEN CAPTURED      07280000
&R       SETA  &SYSLIST(&AS)                                            07290000
&B       SETB  1 TRUE              SET ROW-HAS-BEEN-CAPTURED            07300000
         AGO   .NEXTR                                                   07310000
.COL     ANOP                                                           07320000
&C       SETA  &SYSLIST(&AS)                                            07330000
&B       SETB  0 FALSE             RESET SWITCH                         07340000
         AIF   (&R LT 1 OR &R GT 24).ROWERR                             07350000
         AIF   (&C LT 1 OR &C GT 80).COLERR                             07360000
&P       SETA  (&R-1)*80+&C-1                                           07370000
&Q       SETA  &P/64               QUOTIENT                             07380000
&R       SETA  &P-&Q*64+1          REMAINDER+1                          07390000
&Q       SETA  &Q+1                QUOTIENT+1                           07400000
&N       DC    X'&T(&Q)&T(&R)'     ROW AND COLUMN                       07410000
         AGO   .NEXT                                                    07420000
.ROWERR  MNOTE 4,'             &CS.) VALUE &R INVALID, MUST BE 1 TO 24' 07430000
         AGO   .NEXT                                                    07440000
.COLERR  MNOTE 4,'             &CS.) VALUE &C INVALID, MUST BE 1 TO 80' 07450000
.NEXT    ANOP                                                           07460000
&N       SETC  ''                  TURN OFF NAME                        07470000
.NEXTR   ANOP                                                           07480000
&AN      SETA  &AN-1                                                    07490000
         AGO   .EACH                                                    07500000
.EPILOG  ANOP                                                           07510000
         MEND                                                           07520000
./ ADD NAME=DEBCNT
         MACRO ,                                                        00010000
&NM      DEBCNT &N,&WK=R0                               ADDED ON 94225  00020000
.*                                                                      00030000
.*    THIS MACRO CAUSES AN 0C1 THE "N"TH TIME IT IS INVOKED             00040000
.*                                                                      00050000
         AIF   ('&N' EQ '0').ONCE                                       00060000
&NM      ICM   &WK,15,*+8    LOAD TRAP COUNTER                          00070000
         BCT   &WK,*+8       CONTINUE IF COUNT NOT REACHED              00080000
         DC    AL4(&N)       COUNTER (BETTER NOT BE 0)                  00090000
         STCM  &WK,15,*-4    UPDATE THE COUNTER                         00100000
         MEXIT ,                                                        00110000
.ONCE    ANOP  ,                                                        00120000
&NM      DC    X'00',C'TRP'  BOMB FIRST TIME                            00130000
         MEND  ,                                                        00140000
./ ADD NAME=DEBDO
         MACRO ,                                                        00010000
&NM      DEBDO ,                                      ADDED ON 20090628 00020000
.*                                                                      00030000
.*    EXCEPT IN DEBUG MODE, BRANCHES TO THE MATCHING DEBEND             00040000
.*                                                                      00050000
         GBLB  &BUGBEAR                                                 00060000
         GBLC  &ZZDEBDO                                                 00070000
         AIF   ('&ZZDEBDO' EQ '').OK                                    00080000
 MNOTE 0,'NESTED DEBDO STATEMENTS NOT SUPPORTED'                        00090000
         MEXIT ,                                                        00100000
.OK      ANOP  ,                                                        00110000
&ZZDEBDO SETC  'ZZDB'.'&SYSNDX'                                         00120000
         AIF   (&BUGBEAR).MEND                                          00130000
         B     &ZZDEBDO                                                 00140000
.MEND    MEND  ,                                                        00150000
./ ADD NAME=DEBEND
         MACRO ,                                                        00010000
&NM      DEBEND ,                                     ADDED ON 20090628 00020000
.*                                                                      00030000
.*    TARGET OF PRIOR DEBDO                                             00040000
.*                                                                      00050000
         GBLB  &BUGBEAR                                                 00060000
         GBLC  &ZZDEBDO                                                 00070000
         AIF   ('&ZZDEBDO' NE '').OK                                    00080000
 MNOTE 0,'DEBDO/DEBEND STATEMENT MISMATCH'                              00090000
         MEXIT ,                                                        00100000
.OK      ANOP  ,                                                        00110000
         AIF   (&BUGBEAR).MEND                                          00120000
&ZZDEBDO DS    0H                                                       00130000
.MEND    ANOP  ,                                                        00140000
&ZZDEBDO SETC  ''                                                       00150000
         MEND  ,                                                        00160000
./ ADD NAME=DEBEX
         MACRO ,                                                        00010000
&NM      DEBEX  &N                                    ADDED ON 2012064  00020000
.*                                                                      00030000
.*    THIS MACRO CAUSES AN 0C3 - USED FOR DEBUGGING                     00040000
.*      (easier to FIND than plain EX)                                  00050000
&NM      EX    0,*                                                      00060000
         MEND  ,                                                        00070000
./ ADD NAME=DEBINLIN
         MACRO ,                                                        00010000
&NM      DEBTRACE &LBL,&TEXT=,&REGS=,&HEX=,&MODE=S,     ADDED ON 85360 *00020000
               &WK=R9,&DEV=1,&TCB=,         WTO VS @PRT  CHANGED 94011 *00030000
               &ROUT=13,&DES=4,&BUGPARM=NO,                ADDED 95067 *00040000
               &CTEXT=,&PACK=,                             ADDED 96081 *00050000
               &PRTMODE=0,&DCB=0,   USER PRINT DCB/MODE    ADDED 99058 *00060000
               &COUNT=,&CALL=DYN,&OPT=,                  CHANGED 98222 *00070000
               &WA=DBTSAVE,                                ADDED 99114 *00080000
               &LIST=  (WORKS WITH CALL=EXTRN ONLY)        ADDED 95235  00090000
.********************************************************************** 00100000
.*                                                                   ** 00110000
.* THIS IS A SAVED VERSION OF DEBTRACE SUPPORTING IN-LINE DUMPING (CODE 00120000
.* EXPANDED IN CALLER'S PROGRAM)                                        00130000
.*                                                                   ** 00140000
.********************************************************************** 00150000
     GBLB  &BUGBEAR,&BUGTCB,&BUGSWCH,&BUGSWRT,&BUGFAR,&BUGEXT,&BUGDYN   00160000
     GBLB  &BUGTRC           USED WITH ACTIVE PGMTRACE (ESPIE)  GP99113 00170000
         GBLC  &V                                                       00180000
         LCLA  &LN,&I,&EN,&EM,&EO                               GP95235 00190000
         LCLC  &L,&ET,&EL,&EK                                   GP95235 00200000
&L       SETC  'L'''                                            GP95235 00210000
&V       SETC  'DBT'.'&SYSNDX'                                          00220000
&BUGFAR  SETB  (&BUGFAR OR ('&CALL' EQ 'FAR'))                   95079  00230000
&BUGEXT  SETB  (&BUGEXT OR ('&CALL' EQ 'EXTRN'))                 95227  00240000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ 'DYN'))                  GP97261 00250000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ 'DYNAMIC'))              GP97261 00260000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'TRC'))                  GP99113 00270000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'TRACE'))                GP99113 00280000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'PGMTRACE'))             GP99113 00290000
         AIF   (&BUGBEAR OR '&BUGPARM' EQ 'NO').DOSOME                  00300000
         AIF   ('&NM' EQ '').MEND                                       00310000
&NM      DS    0H            DEBUG SWITCH NOT ON                        00320000
         AGO   .MEND                                                    00330000
.DOSOME  ANOP  ,                                                 95067  00340000
&BUGSWCH SETB  1                                                 95067  00350000
         AIF   ('&MODE' EQ 'D' OR '&MODE' EQ 'M').DATA           95228  00360000
         AIF   ('&MODE' EQ 'C').CODE                                    00370000
         AIF   ('&MODE' EQ 'DC').CODE   EXPAND BOTH              95067  00380000
         AIF   ('&MODE' EQ 'ON').SWON                            95079  00390000
         AIF   ('&MODE' EQ 'OFF').SWOFF                          95079  00400000
         AIF   ('&MODE' EQ 'CLOSE').SWEND  CLOSE AND QUIT       GP98222 00410000
         AIF   (NOT &BUGTRC).NOTTRC                             GP99113 00420000
&NM      DC    X'83CD',S(&WA,&V.X-*)  INVOKE TRACE              GP99113 00430000
         AGO   .DONEBAS                                         GP99113 00440000
.NOTTRC  ANOP  ,                                                GP99113 00450000
&NM      STM   R0,R15,&WA    SAVE ALL REGISTERS                         00460000
         AIF   ('&COUNT' EQ '').DONECNT                          95079  00470000
.*  COUNT(3) - SKIP FIRST N CALLS                                95079  00480000
         AIF   ('&COUNT(3)' EQ '').CNTNO3                        95079  00490000
         ICM   R14,15,&V.3   LOAD SKIP COUNT                     95079  00500000
         BNP   &V.C          LIMIT REACHED - PROCESS             95079  00510000
         BCTR  R14,0         DECREMENT                           95079  00520000
         STCM  R14,15,&V.3   SAVE FOR NEXT TIME                  95079  00530000
         B     &V.X          AND SKIP CALL                       95079  00540000
&V.3     DC    AL4(&COUNT(3))  INITIAL SKIP COUNT                95079  00550000
&V.C     DS    0H                                                95079  00560000
.CNTNO3  AIF   ('&COUNT(2)' EQ '').CNTNO2                        95079  00570000
         AIF   ('&COUNT(2)' EQ '1').CNTNO2                       95079  00580000
         AIF   ('&COUNT(2)' EQ '0').CNTNO2                       95079  00590000
.*  COUNT(2) - PROCESS EVERY NTH CALL ONLY                       95079  00600000
         ICM   R14,15,&V.2   LOAD COUNTER                        95079  00610000
         BNP   &V.L          BAD - PROCESS CALL                  95079  00620000
         BCT   R14,&V.N      NON-ZERO; SAVE AND SKIP             95079  00630000
         MVC   &V.2,=AL4(&COUNT(2))  REFRESH                     95079  00640000
         B     &V.L          AND GO                              95079  00650000
&V.2     DC    AL4(1)        INTERVAL COUNTER (DO FIRST ONE)     95079  00660000
&V.N     STCM  R14,15,&V.2   UPDATE COUNTER                      95079  00670000
         B     &V.X          AND EXIT                            95079  00680000
.CNTNO2  AIF   ('&COUNT(1)' EQ '').DONECNT                       95079  00690000
         AIF   ('&COUNT(1)' EQ '0').DONECNT                      95079  00700000
         ICM   R14,15,&V.1   LOAD LIMIT COUNT                    95079  00710000
         BNP   &V.X          SKIP OUT IF NOT VALID               95079  00720000
         BCTR  R14,0         DECREMENT                           95079  00730000
         B     &V.M          SAVE, AND CONTINUE                  95079  00740000
&V.1     DC    AL4(&COUNT(1))  MAXIMUM CALLS TO MAKE             95079  00750000
&V.M     STCM  R14,15,&V.1   SAVE FOR NEXT TIME                  95079  00760000
.DONECNT ANOP  ,                                                 95079  00770000
&V.L     BAS   R1,&V.B                                           95079  00780000
.DONEBAS AIF   ('&LBL' EQ '' AND (&BUGEXT OR &BUGDYN OR &BUGTRC)).NOLBL 00790000
         DC    CL8'&LBL '                                               00800000
.NOLBL   AIF   ('&REGS' EQ '' OR '&REGS' EQ 'NO').NOREGS         95079  00810000
         AIF   ('&REGS' EQ 'R15' OR '&REGS' EQ 'SHORT'                 *00820000
               OR '&REGS' EQ 'RET').RETREG                      GP97225 00830000
         AIF   ('&REGS' EQ 'YES').REGSALL                       GP97225 00840000
         AIF   (N'&REGS EQ 2).REGS2                             GP97225 00850000
         DC    AL1(0,0),SL2(&REGS(1),&REGS(1))                  GP97225 00860000
         AGO   .NOREGS                                          GP97225 00870000
.REGS2   DC    AL1(0,0),SL2(&REGS(1),&REGS(2))                  GP97225 00880000
         AGO   .NOREGS                                          GP97225 00890000
.REGSALL DC    AL1(0,0),SL2(0,15)                               GP97225 00900000
         AGO   .NOREGS                                          GP97225 00910000
.RETREG  DC    SL2(0,14,1)    R15-R1 ONLY                       GP97225 00920000
.NOREGS  AIF   ('&TEXT' EQ '').NOTEXT                                   00930000
         AIF   (N'&TEXT GE 2).TEXT2                             GP97225 00940000
         DC    AL1(1,0),SL2(&TEXT(1)),AL2(&L&TEXT(1))           GP97225 00950000
         AGO   .NOTEXT                                          GP97225 00960000
.TEXT2   DC    AL1(1,0),SL2(&TEXT(1),&TEXT(2))                          00970000
.NOTEXT  AIF   ('&CTEXT' EQ '').NOCTEXT                         GP97225 00980000
         AIF   (N'&CTEXT GE 2).CTEXT2                           GP97225 00990000
         DC    AL1(2,0),SL2(&CTEXT(1)),AL2(&L&CTEXT(1))         GP97225 01000000
         AGO   .NOCTEXT                                         GP97225 01010000
.CTEXT2  DC    AL1(2,0),SL2(&CTEXT(1),&CTEXT(2))                GP97225 01020000
.NOCTEXT AIF   ('&HEX' EQ '').NOHEX                             GP97225 01030000
         AIF   (N'&HEX GE 2).HEX2                               GP97225 01040000
         DC    AL1(3,0),SL2(&HEX(1)),AL2(&L&HEX(1))             GP97225 01050000
         AGO   .NOHEX                                           GP97225 01060000
.HEX2    DC    AL1(3,0),SL2(&HEX(1),&HEX(2))                    GP97225 01070000
.NOHEX   AIF   ('&PACK' EQ '').NOPACK                           GP97225 01080000
         AIF   (N'&PACK GE 2).PACK2                             GP97225 01090000
         DC    AL1(4,0),SL2(&PACK(1)),AL2(&L&PACK(1))           GP97225 01100000
         AGO   .NOPACK                                          GP97225 01110000
.PACK2   DC    AL1(4,0),SL2(&PACK(1),&PACK(2))                  GP97225 01120000
.NOPACK  AIF   ('&LIST' EQ '' OR N'&LIST LT 1).NOLIST           GP95235 01130000
&LN      SETA  N'&LIST                                          GP95235 01140000
.DOLIST  AIF   (&I GE &LN).NOLIST   DONE WITH LIST              GP95235 01150000
&I       SETA  &I+1          BUMP LOOP INDEX                    GP95235 01160000
&EN      SETA  N'&LIST(&I)   NUMBER OF ENTRIES                  GP95235 01170000
         AIF   (&EN LT 1).DOLIST  USER IN COMA?                 GP95235 01180000
         AIF   (&EN LT 4).TOOLIST WARN                          GP95235 01190000
         MNOTE 4,'LIST(&I) HAS TOO MANY (&EN) ENTRIES'          GP95235 01200000
.TOOLIST ANOP  ,                                                GP95235 01210000
&EK      SETC  '&LIST(&I,1)'                                            01220000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01230000
&EO      SETA  0             PRESET FOR NORMAL ADDRESSING MODE          01240000
&ET      SETC  '03'          PRESET FOR HEX DEFAULT             GP95235 01250000
         AIF   ('&EK'(1,1) NE '/').NOTIND                               01260000
&EO      SETA  &EO+1         REQUEST INDIRECT ADDRESSING                01270000
&EK      SETC  '&EK'(2,&EM-1)  DELETE LEADING CONTROL BYTE              01280000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01290000
.NOTIND  AIF   ('&EK'(&EM,1) NE '%').NOTA24                             01300000
&EO      SETA  &EO+2         REQUEST FORCED 24-BIT ADDRESSING           01310000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01320000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01330000
.NOTA24  AIF   ('&EK'(&EM,1) NE '?').NOTA31                             01340000
&EO      SETA  &EO+4         REQUEST FORCED 31-BIT ADDRESSING           01350000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01360000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01370000
.NOTA31  AIF   (&EN LT 3 OR '&LIST(&I,3)' EQ 'HEX').HTYPE       GP95235 01380000
         AIF   ('&LIST(&I,3)' EQ 'X').HTYPE                     GP97225 01390000
         AIF   ('&LIST(&I,3)' EQ 'HEX').HTYPE                           01400000
         AIF   ('&LIST(&I,3)' EQ 'T').TTYPE                     GP98189 01410000
         AIF   ('&LIST(&I,3)' EQ 'TEXT').TTYPE                  GP95235 01420000
         AIF   ('&LIST(&I,3)' EQ 'TXT').TTYPE                           01430000
         AIF   ('&LIST(&I,3)' EQ 'C').CTYPE                     GP97225 01440000
         AIF   ('&LIST(&I,3)' EQ 'CT').CTYPE                            01450000
         AIF   ('&LIST(&I,3)' EQ 'CTEXT').CTYPE                 GP97225 01460000
         AIF   ('&LIST(&I,3)' EQ 'PACK').PTYPE                  GP97225 01470000
         AIF   ('&LIST(&I,3)' EQ 'PACKED').PTYPE                GP97225 01480000
         AIF   ('&LIST(&I,3)' EQ 'P').PTYPE                     GP97225 01490000
         AIF   ('&LIST(&I,3)' EQ 'PD').PTYPE                            01500000
         AIF   ('&LIST(&I,3)' EQ 'D').PTYPE                     GP97225 01510000
 MNOTE 4,'TYPE MUST BE TEXT, CTEXT, HEX, OR PACKED, NOT &LIST(&I,3)'    01520000
         AGO   .HTYPE                                           GP95235 01530000
.TTYPE   ANOP  ,                                                GP95235 01540000
&ET      SETC  '01'          SET FOR TEXT                       GP95235 01550000
         AGO   .HTYPE                                           GP95235 01560000
.CTYPE   ANOP  ,                                                GP97225 01570000
&ET      SETC  '02'          SET FOR CONDITIONAL TEXT, ELSE HEX GP97225 01580000
         AGO   .HTYPE                                           GP97225 01590000
.PTYPE   ANOP  ,                                                GP97225 01600000
&ET      SETC  '04'          SET FOR PACKED                     GP97225 01610000
.HTYPE   ANOP  ,                                                GP97225 01620000
&EL      SETC  '&LIST(&I,2)'                                    GP95235 01630000
         AIF   ('&EL' NE '').HLEN                               GP95235 01640000
&EL      SETC  '&L'.'&EK'                                               01650000
.HLEN    DC    X'0800',CL8'&LIST(&I,1)',AL1(&ET,&EO),S(&EK,&EL)         01660000
         AGO   .DOLIST                                          GP95235 01670000
.NOLIST  AIF   (&BUGFAR).FARCL                                   95079  01680000
         AIF   (&BUGDYN).FARCL                                  GP97261 01690000
         AIF   (&BUGTRC).TRCCL                                  GP99113 01700000
         AIF   (&BUGEXT).EXTCL                                   95215  01710000
&V.B     BAS   R14,DBTRACE                                       92271  01720000
         AGO   .CMCAL                                            95079  01730000
.EXTCL   ANOP  ,                                                 95215  01740000
&V.B     L     R15,=V(DEBTRACE)                                         01750000
         LA    R0,&WA        PASS ADDRESS OF WORK AREA           95215  01760000
         AGO   .FARCM                                            95215  01770000
.FARCL   ANOP  ,                                                 95079  01780000
&V.B     L     R15,=A(DBTRACE)                                   95079  01790000
.FARCM   BASR  R14,R15                                           95079  01800000
.CMCAL   ANOP  ,                                                 95079  01810000
&V.X     LM    R0,R15,&WA                                               01820000
         AGO   .MEND                                                    01830000
.TRCCL   ANOP  ,             INVOKE PGMTRACE VIA ESPIE          GP99113 01840000
&V.X     DS    0H            END OF TRACE LIST                  GP99113 01850000
         AGO   .MEND                                            GP99113 01860000
.SWON    OI    DBTFLAG,DBTFLON  SET TRACING ON                   95079  01870000
         AGO   .MEND                                             95079  01880000
.SWEND   OI    DBTFLAG,DBTFLEND  CLOSE DCB AND STOP TRACE       GP98222 01890000
.SWOFF   NI    DBTFLAG,255-DBTFLON  SET TRACING OFF              95079  01900000
         AGO   .MEND                                             95079  01910000
.CODE    AIF   (&BUGFAR OR &BUGEXT).TESTDC                      GP97262 01920000
.*       PUSH  PRINT                                                    01930000
.*       PUSH  USING                                                    01940000
.*OOPS*  DROP  ,                                                        01950000
.*       PRINT GEN                                                      01960000
         AIF   ('&NM' EQ '').NONAME                                     01970000
&NM      DS    0H                                                       01980000
.NONAME  AIF   (NOT &BUGDYN).NOLODYN                            GP97262 01990000
         DROP  ,                                                GP97262 02000000
         USING DBTRACE,R15                                      GP97265 02010000
DBTRACE  LA    R0,&WA        PASS ADDRESS OF WORK AREA          GP97262 02020000
         STM   R12,R1,DBTLOCSV  SAVE BASE AND RETURN            GP97265 02030000
         ICM   R15,15,@DEBTRAC  SEE IF PREVIOUSLY LOADED        GP97265 02040000
         BNZR  R15           INVOKE; RETURN VIA R14 TO CALLER   GP97265 02050000
         BASR  R12,0         MAKE LOCAL BASE                    GP97262 02060000
         DROP  R15                                              GP97265 02070000
         USING *,R12                                            GP97265 02080000
         LOAD  EPLOC=#DEBTRAC  LOAD EXTERNAL MODULE             GP97261 02090000
         ST    R0,@DEBTRAC   SAVE FOR NEXT TIME                 GP97261 02100000
         ST    R0,DBTLOCSV+(15-12)*4  UPDATE TARGET ADDRESS     GP97265 02110000
         LM    R12,R1,DBTLOCSV  RESTORE                         GP97265 02120000
         BR    R15           RETURN TO CALLER VIA R14           GP97262 02130000
.*       POP   USING                                            GP97262 02140000
.*       POP   PRINT                                            GP97262 02150000
         AGO   .TESTDC                                          GP97262 02160000
.NOLODYN ANOP  ,                                                 95215  02170000
DBTRACE  STM   R12,R15,DBTLOCSV  SAVE BASE AND RETURN                   02180000
         BASR  R12,(0)       SET LOCAL BASE                      92271  02190000
         USING *,R12                                                    02200000
         LA    R6,DBTEXITS   SET FOR QUICK EXIT (LABEL ONLY)     95080  02210000
         TM    DBTFLAG,DBTFLON  DEBUG ON ?                              02220000
         BZR   R6            NO; JUST TAKE QUICK RETURN          95080  02230000
         AIF   ('&COUNT(1)' EQ '').CNTDONE                       95079  02240000
         AIF   ('&COUNT(1)' EQ '0').CNTDONE                      95079  02250000
         ICM   R14,15,DBTRACNO   LOAD LIMIT COUNT                95079  02260000
         BNPR  R6            IGNORE IF REACHED                   95080  02270000
         BCTR  R14,0         DECREMENT                           95079  02280000
         B     DBTRACNM      SAVE, AND PROCESS                   95079  02290000
DBTRACNO DC    AL4(&COUNT(1))  MAXIMUM CALLS TO MAKE             95079  02300000
DBTRACNM STCM  R14,15,DBTRACNO   SAVE FOR NEXT TIME              95079  02310000
.CNTDONE ANOP  ,                                                 95079  02320000
         LR    &WK,R1        COPY PARM REGISTER                         02330000
         MVC   DBTWTO(DBTPATL),DBTPAT                                   02340000
         MVC   DBTWTON(DBTWTOC-DBTWTON),DBTWTON-1   BLANK THE LINE      02350000
         AIF   ('&TCB' NE 'YES').DBTLUP                          94011  02360000
&BUGTCB  SETB  1                                                 94011  02370000
         UNPK  DBTWTCB(9),PSATOLD-PSA(5)                         94011  02380000
         TR    DBTWTCB,DBTHEXTB-C'0'                             94011  02390000
         MVI   DBTWTCB+L'DBTWTCB,C' '                            94011  02400000
.DBTLUP  MVC   DBTWTON,0(&WK)  MOVE USER'S LABEL                        02410000
DBTLOOP  CLI   8(&WK),3      VALID FLAG ?                               02420000
         BH    DBTLAST       NO                                         02430000
         SLR   R2,R2                                                    02440000
         IC    R2,10(,&WK)   GET S(ADDR)                                02450000
         SRL   R2,4          DELETE LOW BITS OF OFFSET                  02460000
         SLA   R2,2          *4 => INDEX INTO DBTSAVE                   02470000
         BZ    *+8           R0 = 0                                     02480000
         L     R2,&WA(R2)      GET USER'S REGISTER                      02490000
         LA    R0,4095       MAKE MASK                                  02500000
         N     R0,8(,&WK)    MASK OFFSET OF ADDRESS                     02510000
         ALR   R2,R0         MAKE EFFECTIVE ADDRESS                     02520000
         SLR   R3,R3                                                    02530000
         IC    R3,12(,&WK)   GET S(LEN)                                 02540000
         SRL   R3,4          DELETE LOW BITS OF OFFSET                  02550000
         SLA   R3,2          *4 => INDEX INTO DBTSAVE                   02560000
         BZ    *+8           R0 = 0                                     02570000
         L     R3,&WA(R3)      GET USER'S REGISTER                      02580000
         LA    R0,4095       MAKE MASK                                  02590000
         N     R0,10(,&WK)   MASK OFFSET OF LENGTH                      02600000
         ALR   R3,R0         MAKE EFFECTIVE ADDRESS                     02610000
         CLI   8(&WK),0      REALLY SHORT REGISTERS ?                   02620000
         BH    DBTTTYP       NO; CHECK TYPE                             02630000
         MVC   DBTPRESV(8),&WA+14*4      PUT 14-15 BEFORE 0-1           02640000
         LA    R2,DBTPRESV   POINT TO R14, R15, R0, R1 SEQUENCE         02650000
         LA    R3,16         DO THREE REGISTERS                         02660000
         B     DBTFHEX       AND DO IT SHORTLY                          02670000
DBTTTYP  CLI   8(&WK),2      TEXT, REGS OR HEX ?                        02680000
         BL    DBTFTEXT      TEXT                                       02690000
         BH    DBTFHEX       HEX                                        02700000
         LA    R2,&WA        REGS                                       02710000
         LA    R3,16*4                                                  02720000
DBTFHEX  BASR  R6,(0)        SET RETURN ADDRESS                  92271  02730000
         SLR   R4,R4                                                    02740000
         LA    R1,DBTWTOT    POINT TO TEXT                              02750000
         LA    R5,16         MAX INPUT CHARACTERS ON LINE        92093  02760000
DBTFHEXL LTR   R3,R3         ANY MORE TO DO ?                           02770000
         BNP   DBTLAST                                                  02780000
         UNPK  0(3,R1),0(2,R2)  UNPACK ONE BYTE                         02790000
         TR    0(2,R1),DBTHEXTB-C'0'  MAKE IT PRINTABLE                 02800000
         MVI   2(R1),C' '    BLANK NEXT                                 02810000
         LA    R2,1(,R2)                                                02820000
         LA    R1,2(,R1)                                                02830000
         BCTR  R3,0          ADJUST RESIDUAL COUNT                      02840000
         LA    R4,1(,R4)     ADD ONE TO COUNT DONE                      02850000
         LA    R15,3                                                    02860000
         NR    R15,R4        END OF A WORD ?                            02870000
         BNZ   *+8           NO                                         02880000
         LA    R1,1(,R1)     LEAVE A GAP BETWEEN WORDS                  02890000
         CR    R4,R5         DONE ONE LINE ?                     92093  02900000
         BNL   DBTLAST       YES; PROCESS IT                            02910000
         B     DBTFHEXL      SEE IF MORE TO DO                          02920000
DBTFTEXT LA    R4,L'DBTWTOT  SET MAXIMUM TEXT PRINTABLE                 02930000
         BASR  R6,(0)        SET RETURN POINT                    92271  02940000
         LTR   R3,R3         ANY MORE ?                                 02950000
         BNP   DBTLAST       NO; EXIT                                   02960000
         LR    R15,R4        SET TEXT LENGTH                            02970000
         CR    R3,R15        IS REQUEST LONGER ?                        02980000
         BNL   *+6           YES                                        02990000
         LR    R15,R3        ELSE USE SHORTER                           03000000
         BCTR  R15,0         SET EXECUTE LENGTH                         03010000
         EX    R15,DBTFTMVC  MOVE TO LINE                               03020000
         AR    R2,R4         UP TEXT ADDRESS                            03030000
         SR    R3,R4         SET RESIDUAL PRINT LENGTH                  03040000
         B     DBTLAST       PRINT IT                                   03050000
DBTFTMVC MVC   DBTWTOT(0),0(R2)  MOVE USER'S TEXT                       03060000
DBTLAST  CLC   DBTWTON(DBTWTOC-DBTWTON),DBTWTON-1  ANYTHING TO PRINT ?  03070000
         BE    DBTLASTL      NO                                         03080000
         AIF   (T'&DEV EQ 'O').NOPRT  NO PRT FILE # - WTO        92284  03090000
         AIF   ('&DEV' EQ '0').NOPRT  NO PRT FILE # - WTO        95067  03100000
         PRTV  DBTWTO,CC=NO,DEV=&DEV  PRINT ON REQUESTED FILE  GP95226  03110000
         AGO   .NOWTO                                            92284  03120000
.NOPRT   AIF   (&BUGSWRT).NOPRT2           ROUTING/DESCRIPTORS   95067  03130000
         AIF   ('&ROUT' EQ '').NOROUT   NO ROUTING/DESCRIPTORS   95067  03140000
&BUGSWRT SETB  1                                                 95067  03150000
.NOPRT2  MVC   DBTWTOC(4),DBTRTDSC  ADD ROUTING/DESCRIPTOR CODE  95067  03160000
.NOROUT  WTO   MF=(E,DBTWTO)   WRITE TO CONSOLE                  95067  03170000
.NOWTO   ANOP  ,                                                 92284  03180000
DBTLASTL MVC   DBTWTON(DBTWTOC-DBTWTON),DBTWTON-1  BLANK IT      93357  03190000
         MVC   DBTWTOM,DBTWTON  CLEAR MESSAGE NUMBER             93357  03200000
         MVI   DBTWTOM+5,C'+' INDICATE CONTINUATION              93357  03210000
         LTR   R3,R3         ANY MORE TO DO ?                           03220000
         BPR   R6            RESTART                                    03230000
DBTEXIT  LA    &WK,6(,&WK)   SKIP TO NEXT OPTION ENTRY                  03240000
         CLI   8(&WK),3      VALID REQUEST ?                            03250000
         BNH   DBTLOOP       YES; DO IT                                 03260000
DBTEXITS LM    R12,R15,DBTLOCSV  RESTORE BASE AND RETURN                03270000
         BR    R14           AND RETURN TO USER                         03280000
DBTWPAT  WTO   'MSG666 ',ROUTCDE=&ROUT,DESC=&DES,MF=L                   03290000
DBTPATL  EQU   *-DBTPAT                                                 03300000
DBTHEXTB DC    C'0123456789ABCDEF'                                      03310000
         ORG   DBTWPAT                                                  03320000
DBTPAT   DC    Y(56+9*&BUGTCB)  TRUE LENGTH AFTER MOVE                  03330000
DBTRTDSC EQU   DBTHEXTB-4,4,C'X'  DESCRIPTOR/ROUTCDE, IF ANY            03340000
         ORG   DBTHEXTB+L'DBTHEXTB  RESUME                              03350000
.*       POP   PRINT                                                    03360000
.*       POP   USING                                                    03370000
.TESTDC  AIF   ('&MODE' NE 'DC').MEND                            95067  03380000
         AGO   .NODRTE                                           95067  03390000
.DATA    AIF   ('&NM' EQ '').NODLBL                                     03400000
&NM      DS    0D                                                       03410000
.NODLBL  AIF   ('&ROUT' EQ '').NODRTE                            95067  03420000
&BUGSWRT SETB  1                                                 95067  03430000
.NODRTE  AIF   (&BUGFAR OR '&MODE' EQ 'M').MEND                  95230  03440000
DBTPRESV DC    2F'0'  1/2    FOR SHORT FORMATTING                95230  03450000
.NOSVPFX ANOP  ,                                                 95230  03460000
&WA      DC    16F'0' 2/2    DEBUG SAVE AREA                    GP97265 03470000
DBTFLAG  DC    AL1(&BUGSWCH*DBTFLON+DBTFLWID)  DEBUG FLAG       GP98222 03480000
DBTFLTCB EQU   128             INCLUDE TCB ADDRESS IN MESSAGE           03490000
DBTFLWTO EQU   64              USE WTO INSTEAD OF PRT            95240  03500000
DBTFLWID EQU   32              USE WIDE FORMAT WHEN PRINTING    GP98222 03510000
DBTFLPRO EQU   16              PRODUCTION MODE / NEED DD TO PRT GP99113 03520000
DBTFLEND EQU   2               THIS IS A TERMINATION CALL       GP98222 03530000
DBTFLON  EQU   1               DEBUG BIT                                03540000
DBTFLAG2 DC    AL1(0)        ..RESERVED..                       GP99062 03550000
DBTFLAG3 DC    AL1(0)        ..RESERVED..                       GP99062 03560000
DBTFLAG4 DC    AL1(0)        ..RESERVED..                       GP99062 03570000
DBTCNT1  DC    A(&COUNT(1)+0)  COUNT OPTION                      95228  03580000
DBTCNT2  DC    A(&COUNT(2)+0)  COUNT OPTION                      95228  03590000
DBTCNT3  DC    A(&COUNT(3)+0)  COUNT OPTION                      95228  03600000
         MAPCMPRT PFX=DBT,DCB=&DCB,PRTMODE=&PRTMODE,DEV=&DEV    GP99113 03610000
         AIF   (NOT &BUGDYN).NODYNS                             GP97261 03620000
.BUGDYN  WXTRN DEBTRACE      SUPPORT LINKED-IN VERSION          GP97262 03630000
@DEBTRAC DC    A(DEBTRACE)   ADDRESS OF LOADED DEBTRACE         GP97261 03640000
#DEBTRAC DC    CL8'DEBTRACE'  LOAD MODULE NAME                  GP97261 03650000
DBTLOCSV DC    6A(0)         SAVE AREA                          GP97265 03660000
         AGO   .MEND                                            GP97262 03670000
.NODYNS  AIF   (&BUGFAR OR '&MODE' EQ 'M').MEND                  95228  03680000
DBTLOCSV DC    4F'0'         BASE SAVE                                  03690000
DBTWTO   DC    Y(56,0)       VCON                                93357  03700000
DBTWTOM  DC    C'MSG666 '    DEBUG HEADER                        93357  03710000
DBTWTON  DC    CL8' ',C' '   USER'S LABEL                               03720000
DBTWTOT  DC    CL36' '       USER'S HEX OR EBCDIC TEXT                  03730000
         AIF   ('&TCB' NE 'YES' AND NOT &BUGTCB).NOTCB           94011  03740000
         DC    C' '          EXTRA FOR UNPACK                    94011  03750000
DBTWTCB  DC    CL8' '        CURRENT TCB ADDRESS                 94011  03760000
.NOTCB   ANOP  ,                                                 94011  03770000
DBTWTOC  DC    C' '          EXTRA FOR UNPACK                           03780000
         AIF   (NOT &BUGSWRT).MEND  NO ROUTING CODE              95067  03790000
         DC    XL3'0'        EXTRA FOR DESCRIPTOR/ROUTING CODES  95067  03800000
.MEND    MEND  ,                                                        03810000
./ ADD NAME=DEBPRT
         MACRO ,                                                        00010000
         DEBPRT &N,&WK=R0                             ADDED ON 20080418 00020000
         GBLB  &ZZDEPRT                                                 00030000
.*                                                                      00040000
.*    THIS MACRO TOGGLES DEBUG PRINTING ON AND OFF                      00050000
.*                                                                      00060000
         AIF   (NOT &ZZDEPRT AND '&N' EQ 'OFF').MEND                    00070000
         AIF   (&ZZDEPRT AND '&N' EQ 'ON').MEND                         00080000
         AIF   ('&N' EQ 'ON').PUSH                                      00090000
         AIF   ('&N' EQ 'OFF').POP                                      00100000
&ZZDEPRT SETB  (NOT &ZZDEPRT)     FLIP                                  00110000
         AIF   (NOT &ZZDEPRT).POP                                       00120000
.PUSH    PUSH PRINT                                                     00130000
         PRINT ON,GEN,DATA                                              00140000
&ZZDEPRT SETB  1                                                        00150000
         MEXIT ,                                                        00160000
.POP     POP   PRINT                                                    00170000
&ZZDEPRT SETB  0                                                        00180000
.MEND    MEND  ,                                                        00190000
./ ADD NAME=DEBSTOMP
         MACRO ,                                                        00010000
&NM      DEBSTOMP &I,&VAR=                                              00020000
         GBLC  &MACPLAB                                                 00030000
         GBLC  &ZZSTMNM                                                 00040000
         GBLB  &BUGBEAR                                                 00050000
         GBLA  &ZZSTMNO                                                 00060000
&MACPLAB SETC  '&NM'                                                    00070000
.*--------------------------------------------------------------------* 00080000
.*   THIS SETS A SIMPLE (ONE BYTE) PROGRESS INDICATOR FLAG FOR DEBUG  * 00090000
.*--------------------------------------------------------------------* 00100000
         AIF   ('&VAR' EQ '').HAVEVAR                                   00110002
&ZZSTMNM SETC  '&VAR'                                                   00120000
.HAVEVAR AIF   ('&ZZSTMNM' NE '').HAVEVAT                               00130000
&ZZSTMNM SETC  'DEBSTOMP'                                               00140000
.HAVEVAT AIF   ('&I' EQ '').EXPAND                                      00150000
&ZZSTMNO SETA  &I                                                       00160000
.EXPAND  AIF   (NOT &BUGBEAR AND '&ZZSTMNO' EQ 'DEBSTOMP').EXIT         00170000
         MACPARM &ZZSTMNM,&ZZSTMNO,OP=MVI,OPR=MVI  MARK MY SPOT         00180000
         MNOTE 0,'DEBSTOMP: FOOTPRINT NUMBER &ZZSTMNO'                  00190001
.EXIT    MACPARM MODE=LBL                                               00200000
&ZZSTMNO SETA  &ZZSTMNO+1                                               00210000
         MEND  ,                                                        00220000
./ ADD NAME=DEBTRACE
         MACRO ,                                                        00010000
&NM      DEBTRACE &LBL,&TEXT=,&REGS=,&HEX=,&MODE=S,     ADDED ON 85360 *00020000
               &WK=R9,&DEV=1,&TCB=,         WTO VS @PRT  CHANGED 94011 *00030000
               &ROUT=13,&DES=4,&BUGPARM=NO,                ADDED 95067 *00040000
               &CTEXT=,&PACK=,                             ADDED 96081 *00050000
               &PRTMODE=0,&DCB=0,   USER PRINT DCB/MODE    ADDED 99058 *00060000
               &COUNT=,&CALL=DYN,&OPT=,                  CHANGED 98222 *00070000
               &WA=DBTSAVE,                                ADDED 99114 *00080000
               &LIST=                                      ADDED 95235  00090000
.********************************************************************** 00100000
.*>>>>>>>>> KEPT FOR OLD CODE ONLY - NEW CODE SHOULD USE DBT <<<<<<<<<* 00110000
.********************************************************************** 00120000
.*                                                                    * 00130000
.*  THIS MACRO INVOKES EXTERNAL LOAD MODULE DEBTROLD TO PRODUCE       * 00140000
.*  TRACING, REGISTER CONTENTS, AND VARIABLES. (DEBTROLD SHOULD BE IN * 00150000
.*  A LINKLIB; AUTHORIZATION IS NOT REQUIRED). OUTPUT WILL BE BY WTO  * 00160000
.*  UNLESS A DEBTRACE DD CARD IS SUPPLIED.                            * 00170000
.*                                                                    * 00180000
.*  REQUIRED:  IN A CSECT OR RSECT:   DEBTRACE MODE=C  DEFINES CODE   * 00190000
.*             IN A CSECT OR DSECT:   DEBTRACE MODE=D  DEFINES DATA   * 00200000
.*             IN A CSECT (¬RENT) :   DEBTRACE MODE=DC   BOTH         * 00210000
.*    (NOTE: REQUIRED FORMS MUST NOT APPEAR PRIOR TO FIRST OPTIONAL)  * 00220000
.*                                                                    * 00230000
.*  OPTIONAL:  LABEL DEBTRACE ...                                     * 00240000
.*                TAG OR ,  -  IDENTIFIER ON OUTPUT LISTING / CONSOLE * 00250000
.*                                                                    * 00260000
.*                REGS= (DEFAULT) | REGS=NO - NO REGISTERS            * 00270000
.*                REGS=YES  -  REGISTERS R0 THROUGH R15               * 00280000
.*                REGS=(R1,R2) - REGISTERS R1 THROUGH R2              * 00290000
.*                REGS=SHORT   - R14 THROUGH R1                       * 00300000
.*                                                                    * 00310000
.*                TEXT=NAME -  TEXT STRING TO BE SHOWN                * 00320000
.*                TEXT=(NAME,LEN) - TEXT W/EXPLICIT LENGTH            * 00330000
.*                                                                    * 00340000
.*                CTEXT=NAME - CONDITIONAL TEXT STRING TO BE SHOWN    * 00350000
.*                CTEXT=(NAME,LEN) - TEXT W/EXPLICIT LENGTH           * 00360000
.*                              OUTPUT IN HEX IF NOT PRINTABLE        * 00370000
.*                                                                    * 00380000
.*                HEX=NAME   -  DATA TO BE SHOWN IN HEXADECIMAL       * 00390000
.*                HEX=(NAME,LEN) - TEXT W/EXPLICIT LENGTH             * 00400000
.*                                                                    * 00410000
.*                PACK=NAME  -  DATA TO BE CONVERTED FROM PACKED      * 00420000
.*                PACK=(NAME,LEN) - TEXT W/EXPLICIT LENGTH (LEN IGNRD)* 00430000
.*                                                                    * 00440000
.*           LIST=((OP1,LN1,FM1),(OP2,LN2,FM2), ... )                 * 00450000
.*                                                                    * 00460000
.*                OP - ADDRESS EXPRESSION VALID IN S CONSTANT         * 00470000
.*                LN - LENGTH EXPRESSION; DEFAULT IS L'OP             * 00480000
.*                FM - TEXT | CTEXT | HEX | PACK - DEFAULT IS HEX     * 00490000
.*                     OR ABBREVIATED   T | CT | H | P                * 00500000
.*                                                                    * 00510000
.*  THE REQUIRED FORMS MAY BE OMITTED WHEN PGMTRACE WILL ALSO BE USED * 00520000
.*  AND ACTIVATED. IN THAT CASE THE FIRST OPTIONAL FORM MUST INCLUDE  * 00530000
.*  CALL=TRC TO GENERATE SHORTER PARAMETER LISTS.                     * 00540000
.*                                                                    * 00550000
.********************************************************************** 00560000
.*  MAINTENANCE:                                                      * 00570000
.*                                                                    * 00580000
.*  2000/01/03  GYP  REMOVED IN-LINE DEBUG CODE;                      * 00590000
.*                   FIXED MODE=C AND MODE=D FOR USE WITH REENTRANT   * 00600000
.*                     PROGRAMS.                                      * 00610000
.*                                                                    * 00620000
.********************************************************************** 00630000
     GBLB  &BUGBEAR,&BUGTCB,&BUGSWCH,&BUGSWRT,&BUGFAR,&BUGEXT,&BUGDYN   00640000
     GBLB  &BUGTRC           USED WITH ACTIVE PGMTRACE (ESPIE)  GP99113 00650000
         GBLA  &MACP#        NUMBER OF SUBLIST PARAMETERS       GP04234 00660000
         GBLC  &MACP1,&MACP2,&MACP3,&MACP4,&MACP5               GP04234 00670000
         GBLC  &MACP6,&MACP7,&MACP8,&MACP9,&MACP10              GP04234 00680000
         GBLC  &V                                                       00690000
         LCLA  &LN,&I,&EN,&EM,&EO                               GP95235 00700000
         LCLC  &L,&ET,&EL,&EK                                   GP95235 00710000
&L       SETC  'L'''                                            GP95235 00720000
&V       SETC  'DBT'.'&SYSNDX'                                          00730000
&BUGFAR  SETB  (&BUGFAR OR ('&CALL' EQ 'FAR'))                   95079  00740000
&BUGEXT  SETB  (&BUGEXT OR ('&CALL' EQ 'EXTRN'))                 95227  00750000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ 'DYN'))                  GP97261 00760000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ ''))  DROP LOCAL CODE    GP00004 00770000
&BUGDYN  SETB  (&BUGDYN OR ('&CALL' EQ 'DYNAMIC'))              GP97261 00780000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'TRC'))                  GP99113 00790000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'TRACE'))                GP99113 00800000
&BUGTRC  SETB  (&BUGTRC OR ('&CALL' EQ 'PGMTRACE'))             GP99113 00810000
         AIF   (&BUGBEAR OR '&BUGPARM' EQ 'NO').DOSOME                  00820000
         AIF   ('&NM' EQ '').MEND                                       00830000
&NM      DS    0H            DEBUG SWITCH NOT ON                        00840000
         AGO   .MEND                                                    00850000
.DOSOME  ANOP  ,                                                 95067  00860000
&BUGSWCH SETB  1                                                 95067  00870000
         AIF   ('&MODE' EQ 'D' OR '&MODE' EQ 'M').DATA           95228  00880000
         AIF   ('&MODE' EQ 'C').CODE                                    00890000
         AIF   ('&MODE' EQ 'DC').CODE   EXPAND BOTH              95067  00900000
         AIF   ('&MODE' EQ 'ON').SWON                            95079  00910000
         AIF   ('&MODE' EQ 'OFF').SWOFF                          95079  00920000
         AIF   ('&MODE' EQ 'CLOSE').SWEND  CLOSE AND QUIT       GP98222 00930000
         AIF   (NOT &BUGTRC).NOTTRC                             GP99113 00940000
&NM      DC    X'83CD',S(&WA,&V.X-*)             INVOKE TRACE   GP99113 00950000
         AGO   .DONEBAS                                         GP99113 00960000
.NOTTRC  ANOP  ,                                                GP99113 00970000
&NM      STM   R0,R15,&WA    SAVE ALL REGISTERS                         00980000
         AIF   ('&COUNT' EQ '').DONECNT                          95079  00990000
.*  COUNT(3) - SKIP FIRST N CALLS                                95079  01000000
         AIF   ('&COUNT(3)' EQ '').CNTNO3                        95079  01010000
         ICM   R14,15,&V.3   LOAD SKIP COUNT                     95079  01020000
         BNP   &V.C          LIMIT REACHED - PROCESS             95079  01030000
         BCTR  R14,0         DECREMENT                           95079  01040000
         STCM  R14,15,&V.3   SAVE FOR NEXT TIME                  95079  01050000
         B     &V.X          AND SKIP CALL                       95079  01060000
&V.3     DC    AL4(&COUNT(3))  INITIAL SKIP COUNT                95079  01070000
&V.C     DS    0H                                                95079  01080000
.CNTNO3  AIF   ('&COUNT(2)' EQ '').CNTNO2                        95079  01090000
         AIF   ('&COUNT(2)' EQ '1').CNTNO2                       95079  01100000
         AIF   ('&COUNT(2)' EQ '0').CNTNO2                       95079  01110000
.*  COUNT(2) - PROCESS EVERY NTH CALL ONLY                       95079  01120000
         ICM   R14,15,&V.2   LOAD COUNTER                        95079  01130000
         BNP   &V.L          BAD - PROCESS CALL                  95079  01140000
         BCT   R14,&V.N      NON-ZERO; SAVE AND SKIP             95079  01150000
         MVC   &V.2,=AL4(&COUNT(2))  REFRESH                     95079  01160000
         B     &V.L          AND GO                              95079  01170000
&V.2     DC    AL4(1)        INTERVAL COUNTER (DO FIRST ONE)     95079  01180000
&V.N     STCM  R14,15,&V.2   UPDATE COUNTER                      95079  01190000
         B     &V.X          AND EXIT                            95079  01200000
.CNTNO2  AIF   ('&COUNT(1)' EQ '').DONECNT                       95079  01210000
         AIF   ('&COUNT(1)' EQ '0').DONECNT                      95079  01220000
         ICM   R14,15,&V.1   LOAD LIMIT COUNT                    95079  01230000
         BNP   &V.X          SKIP OUT IF NOT VALID               95079  01240000
         BCTR  R14,0         DECREMENT                           95079  01250000
         B     &V.M          SAVE, AND CONTINUE                  95079  01260000
&V.1     DC    AL4(&COUNT(1))  MAXIMUM CALLS TO MAKE             95079  01270000
&V.M     STCM  R14,15,&V.1   SAVE FOR NEXT TIME                  95079  01280000
.DONECNT ANOP  ,                                                 95079  01290000
&V.L     BAS   R1,&V.B                                           95079  01300000
.DONEBAS AIF   ('&LBL' EQ '' AND (&BUGEXT OR &BUGDYN OR &BUGTRC)).NOLBL 01310000
         DC    CL8'&LBL '                                               01320000
.NOLBL   AIF   ('&REGS' EQ '' OR '&REGS' EQ 'NO').NOREGS         95079  01330000
         AIF   ('&REGS' EQ 'R15' OR '&REGS' EQ 'SHORT'                 *01340000
               OR '&REGS' EQ 'RET').RETREG                      GP97225 01350000
         AIF   ('&REGS' EQ 'YES' OR '&REGS' EQ 'ALL').REGSALL   GP02246 01360000
         AIF   (N'&REGS EQ 2).REGS2                             GP97225 01370000
         DC    AL1(0,0),SL2(&REGS(1),&REGS(1))                  GP97225 01380000
         AGO   .NOREGS                                          GP97225 01390000
.REGS2   DC    AL1(0,0),SL2(&REGS(1),&REGS(2))                  GP97225 01400000
         AGO   .NOREGS                                          GP97225 01410000
.REGSALL DC    AL1(0,0),SL2(0,15)                               GP97225 01420000
         AGO   .NOREGS                                          GP97225 01430000
.RETREG  DC    SL2(0,14,1)    R15-R1 ONLY                       GP97225 01440000
.NOREGS  AIF   ('&TEXT' EQ '').NOTEXT                                   01450000
         AIF   (N'&TEXT GE 2).TEXT2                             GP97225 01460000
         DC    AL1(1,0),SL2(&TEXT(1)),AL2(&L&TEXT(1))           GP97225 01470000
         AGO   .NOTEXT                                          GP97225 01480000
.TEXT2   DC    AL1(1,0),SL2(&TEXT(1),&TEXT(2))                          01490000
.NOTEXT  AIF   ('&CTEXT' EQ '').NOCTEXT                         GP97225 01500000
         AIF   (N'&CTEXT GE 2).CTEXT2                           GP97225 01510000
         DC    AL1(2,0),SL2(&CTEXT(1)),AL2(&L&CTEXT(1))         GP97225 01520000
         AGO   .NOCTEXT                                         GP97225 01530000
.CTEXT2  DC    AL1(2,0),SL2(&CTEXT(1),&CTEXT(2))                GP97225 01540000
.NOCTEXT AIF   ('&HEX' EQ '').NOHEX                             GP97225 01550000
         AIF   (N'&HEX GE 2).HEX2                               GP97225 01560000
         DC    AL1(3,0),SL2(&HEX(1)),AL2(&L&HEX(1))             GP97225 01570000
         AGO   .NOHEX                                           GP97225 01580000
.HEX2    DC    AL1(3,0),SL2(&HEX(1),&HEX(2))                    GP97225 01590000
.NOHEX   AIF   ('&PACK' EQ '').NOPACK                           GP97225 01600000
         AIF   (N'&PACK GE 2).PACK2                             GP97225 01610000
         DC    AL1(4,0),SL2(&PACK(1)),AL2(&L&PACK(1))           GP97225 01620000
         AGO   .NOPACK                                          GP97225 01630000
.PACK2   DC    AL1(4,0),SL2(&PACK(1),&PACK(2))                  GP97225 01640000
.NOPACK  AIF   ('&LIST' EQ '' OR N'&LIST LT 1).NOLIST           GP95235 01650000
&LN      SETA  N'&LIST                                          GP95235 01660000
.DOLIST  AIF   (&I GE &LN).NOLIST   DONE WITH LIST              GP95235 01670000
&I       SETA  &I+1          BUMP LOOP INDEX                    GP95235 01680000
&EN      SETA  K'&EK         GET LENGTH                         GP04234 01690000
         MACLIST &LIST(&I)   GET SUBLIST ITEMS                  GP04234 01700000
&EN      SETA  &MACP#        NUMBER OF ENTRIES (CHG FOR XF ASM) GP04234 01710000
         AIF   (&EN LT 1).DOLIST  USER IN COMA?                 GP95235 01720000
         AIF   (&EN LT 4).TOOLIST WARN                          GP95235 01730000
         MNOTE 4,'MORE THAN 3 SUBPARMS IN &LIST(&I) '           GP95235 01740000
.TOOLIST ANOP  ,                                                GP95235 01750000
&EK      SETC  '&MACP1'                                         GP04234 01760000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01770000
&EO      SETA  0             PRESET FOR NORMAL ADDRESSING MODE          01780000
&ET      SETC  '03'          PRESET FOR HEX DEFAULT             GP95235 01790000
         AIF   (&EM GT 0).TPFX                                  GP04234 01800000
&EK      SETC  '0'           ALLOW EXPANSION WITHOUT ERROR      GP04234 01810000
&EM      SETA  1                                                GP04234 01820000
         MNOTE 4,'DEBTRACE: PARAMETER &I REQUIRES AN ADDRESS'   GP04234 01830000
.TPFX    AIF   (&EM LT 2).NOTA31                                GP04234 01840000
         AIF   ('&EK'(1,1) NE '/').NOTIND                               01850000
&EO      SETA  &EO+1         REQUEST INDIRECT ADDRESSING                01860000
&EK      SETC  '&EK'(2,&EM-1)  DELETE LEADING CONTROL BYTE              01870000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01880000
.NOTIND  AIF   ('&EK'(&EM,1) NE '%').NOTA24                             01890000
&EO      SETA  &EO+2         REQUEST FORCED 24-BIT ADDRESSING           01900000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01910000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01920000
.NOTA24  AIF   ('&EK'(&EM,1) NE '?').NOTA31                             01930000
&EO      SETA  &EO+4         REQUEST FORCED 31-BIT ADDRESSING           01940000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01950000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01960000
.NOTA31  AIF   (&EN LT 3 OR '&MACP3' EQ 'HEX').HTYPE            GP95235 01970000
         AIF   ('&MACP3' EQ 'X').HTYPE                          GP97225 01980000
         AIF   ('&MACP3' EQ 'HEX').HTYPE                                01990000
         AIF   ('&MACP3' EQ 'T').TTYPE                          GP98189 02000000
         AIF   ('&MACP3' EQ 'TEXT').TTYPE                       GP95235 02010000
         AIF   ('&MACP3' EQ 'TXT').TTYPE                                02020000
         AIF   ('&MACP3' EQ 'C').CTYPE                          GP97225 02030000
         AIF   ('&MACP3' EQ 'CT').CTYPE                                 02040000
         AIF   ('&MACP3' EQ 'CTEXT').CTYPE                      GP97225 02050000
         AIF   ('&MACP3' EQ 'PACK').PTYPE                       GP97225 02060000
         AIF   ('&MACP3' EQ 'PACKED').PTYPE                     GP97225 02070000
         AIF   ('&MACP3' EQ 'P').PTYPE                          GP97225 02080000
         AIF   ('&MACP3' EQ 'PD').PTYPE                                 02090000
         AIF   ('&MACP3' EQ 'D').PTYPE                          GP97225 02100000
 MNOTE 4,'TYPE MUST BE TEXT, CTEXT, HEX, OR PACKED, NOT &MACP3'         02110000
         AGO   .HTYPE                                           GP95235 02120000
.TTYPE   ANOP  ,                                                GP95235 02130000
&ET      SETC  '01'          SET FOR TEXT                       GP95235 02140000
         AGO   .HTYPE                                           GP95235 02150000
.CTYPE   ANOP  ,                                                GP97225 02160000
&ET      SETC  '02'          SET FOR CONDITIONAL TEXT, ELSE HEX GP97225 02170000
         AGO   .HTYPE                                           GP97225 02180000
.PTYPE   ANOP  ,                                                GP97225 02190000
&ET      SETC  '04'          SET FOR PACKED                     GP97225 02200000
.HTYPE   ANOP  ,                                                GP97225 02210000
&EL      SETC  '&MACP2'                                         GP95235 02220000
         AIF   ('&EL' NE '').HLEN                               GP95235 02230000
&EL      SETC  '&L'.'&EK'                                               02240000
.HLEN    DC    X'0800',CL8'&MACP1',AL1(&ET,&EO),S(&EK,&EL)              02250000
         AGO   .DOLIST                                          GP95235 02260000
.NOLIST  AIF   (&BUGFAR).FARCL                                   95079  02270000
         AIF   (&BUGDYN).FARCL                                  GP97261 02280000
         AIF   (&BUGTRC).TRCCL                                  GP99113 02290000
         AIF   (&BUGEXT).EXTCL                                   95215  02300000
&V.B     BAS   R14,DBTRACE                                       92271  02310000
         AGO   .CMCAL                                            95079  02320000
.EXTCL   ANOP  ,                                                 95215  02330000
&V.B     L     R15,=V(DEBTRACE)    MEMBER DEBTROLD              GP05013 02340000
         LA    R0,&WA        PASS ADDRESS OF WORK AREA           95215  02350000
         AGO   .FARCM                                            95215  02360000
.FARCL   ANOP  ,                                                 95079  02370000
&V.B     L     R15,=A(DBTRACE)                                   95079  02380000
.FARCM   BASR  R14,R15                                           95079  02390000
.CMCAL   ANOP  ,                                                 95079  02400000
&V.X     LM    R0,R15,&WA                                               02410000
         AGO   .MEND                                                    02420000
.TRCCL   ANOP  ,             INVOKE PGMTRACE VIA ESPIE          GP99113 02430000
&V.X     DS    0H            END OF TRACE LIST                  GP99113 02440000
         AGO   .MEND                                            GP99113 02450000
.SWON    OI    DBTFLAG,DBTFLON  SET TRACING ON                   95079  02460000
         AGO   .MEND                                             95079  02470000
.SWEND   OI    DBTFLAG,DBTFLEND  CLOSE DCB AND STOP TRACE       GP98222 02480000
.SWOFF   NI    DBTFLAG,255-DBTFLON  SET TRACING OFF              95079  02490000
         AGO   .MEND                                             95079  02500000
.CODE    AIF   (&BUGFAR OR &BUGEXT).TESTDC                      GP97262 02510000
         AIF   ('&NM' EQ '').NONAME                                     02520000
&NM      DS    0H                                                       02530000
.NONAME  AIF   (NOT &BUGDYN).NOLODYN                            GP97262 02540000
         AIF   ('&MODE' NE 'DC').NOPUP                          GP00004 02550000
         PUSH  PRINT                                            GP00004 02560000
         PUSH  USING                                            GP00004 02570000
.*       PRINT GEN                                              GP00004 02580000
         DROP  ,                                                GP00004 02590000
         USING DBTRACE,R15                                      GP97265 02600000
.NOPUP   ANOP  ,                                                GP00004 02610000
DBTRACE  LA    R0,&WA        PASS ADDRESS OF WORK AREA          GP97262 02620000
         STM   R12,R1,DBTLOCSV  SAVE BASE AND RETURN            GP97265 02630000
         ICM   R15,15,@DEBTRAC  SEE IF PREVIOUSLY LOADED        GP97265 02640000
         BNZR  R15           INVOKE; RETURN VIA R14 TO CALLER   GP97265 02650000
         AIF   ('&MODE' NE 'DC').NODRP                          GP00004 02660000
         BASR  R12,0         MAKE LOCAL BASE                    GP97262 02670000
         DROP  R15                                              GP97265 02680000
         USING *,R12                                            GP97265 02690000
         AGO   .CMDRP                                           GP00004 02700000
.NODRP   MVC   #DEBTRAC,=CL8'DEBTROLD'                          GP00004 02710000
         MVI   DBTFLAG,&BUGSWCH*DBTFLON+DBTFLWID                GP00004 02720000
.CMDRP   LOAD  EPLOC=#DEBTRAC  LOAD EXTERNAL MODULE             GP97261 02730000
         ST    R0,@DEBTRAC   SAVE FOR NEXT TIME                 GP97261 02740000
         AIF   ('&MODE' NE 'DC').NOCLB                          GP00004 02750000
         ST    R0,DBTLOCSV+(15-12)*4  UPDATE TARGET ADDRESS     GP97265 02760000
.NOCLB   LM    R12,R1,DBTLOCSV  RESTORE                         GP97265 02770000
         BR    R15           RETURN TO CALLER VIA R14           GP97262 02780000
         AIF   ('&MODE' NE 'DC').NOPOP                          GP00004 02790000
         POP   USING                                            GP97262 02800000
         POP   PRINT                                            GP97262 02810000
.NOPOP   AGO   .TESTDC                                          GP97262 02820000
.NOLODYN MNOTE 4,'INLINE EXPANSION NOT SUPPORTED - USE MACRO DEBINLIN'  02830000
.TESTDC  AIF   ('&MODE' NE 'DC').MEND                            95067  02840000
         AGO   .NODRTE                                           95067  02850000
.DATA    AIF   ('&NM' EQ '').NODLBL                                     02860000
&NM      DS    0D                                                       02870000
.NODLBL  AIF   ('&ROUT' EQ '').NODRTE                            95067  02880000
&BUGSWRT SETB  1                                                 95067  02890000
.NODRTE  AIF   (&BUGFAR OR '&MODE' EQ 'M').MEND                  95230  02900000
DBTPRESV DC    2F'0'  1/2    FOR SHORT FORMATTING                95230  02910000
.NOSVPFX ANOP  ,                                                 95230  02920000
&WA      DC    16F'0' 2/2    DEBUG SAVE AREA                    GP97265 02930000
DBTFLAG  DC    AL1(&BUGSWCH*DBTFLON+DBTFLWID)  DEBUG FLAG       GP98222 02940000
DBTFLTCB EQU   128             INCLUDE TCB ADDRESS IN MESSAGE           02950000
DBTFLWTO EQU   64              USE WTO INSTEAD OF PRT            95240  02960000
DBTFLWID EQU   32              USE WIDE FORMAT WHEN PRINTING    GP98222 02970000
DBTFLPRO EQU   16              PRODUCTION MODE / NEED DD TO PRT GP99113 02980000
DBTFLEND EQU   2               THIS IS A TERMINATION CALL       GP98222 02990000
DBTFLON  EQU   1               DEBUG BIT                                03000000
DBTFLAG2 DC    AL1(0)        ..RESERVED..                       GP99062 03010000
DBTFLAG3 DC    AL1(0)        ..RESERVED..                       GP99062 03020000
DBTFLAG4 DC    AL1(0)        ..RESERVED..                       GP99062 03030000
DBTCNT1  DC    A(&COUNT(1)+0)  COUNT OPTION                      95228  03040000
DBTCNT2  DC    A(&COUNT(2)+0)  COUNT OPTION                      95228  03050000
DBTCNT3  DC    A(&COUNT(3)+0)  COUNT OPTION                      95228  03060000
         MAPCMPRT PFX=DBT,DCB=&DCB,PRTMODE=&PRTMODE,DEV=&DEV    GP99113 03070000
         AIF   (NOT &BUGDYN).NODYNS                             GP97261 03080000
.BUGDYN  WXTRN DEBTRACE      SUPPORT LINKED-IN VERSION          GP97262 03090000
@DEBTRAC DC    A(DEBTRACE)   ADDRESS OF LOADED DEBTRACE         GP97261 03100000
#DEBTRAC DC    CL8'DEBTROLD'  LOAD MODULE NAME                  GP97261 03110000
DBTLOCSV DC    6A(0)         SAVE AREA                          GP97265 03120000
         AGO   .MEND                                            GP97262 03130000
.NODYNS  AIF   (&BUGFAR OR '&MODE' EQ 'M').MEND                  95228  03140000
DBTLOCSV DC    4F'0'         BASE SAVE                                  03150000
DBTWTO   DC    Y(56,0)       VCON                                93357  03160000
DBTWTOM  DC    C'MSG666 '    DEBUG HEADER                        93357  03170000
DBTWTON  DC    CL8' ',C' '   USER'S LABEL                               03180000
DBTWTOT  DC    CL36' '       USER'S HEX OR EBCDIC TEXT                  03190000
         AIF   ('&TCB' NE 'YES' AND NOT &BUGTCB).NOTCB           94011  03200000
         DC    C' '          EXTRA FOR UNPACK                    94011  03210000
DBTWTCB  DC    CL8' '        CURRENT TCB ADDRESS                 94011  03220000
.NOTCB   ANOP  ,                                                 94011  03230000
DBTWTOC  DC    C' '          EXTRA FOR UNPACK                           03240000
         AIF   (NOT &BUGSWRT).MEND  NO ROUTING CODE              95067  03250000
         DC    XL3'0'        EXTRA FOR DESCRIPTOR/ROUTING CODES  95067  03260000
.MEND    MEND  ,                                                        03270000
./ ADD NAME=DEBTRACY
         MACRO ,             EXPAND PARSER                              00010000
&NM      DEBTRACY &VA,&VL,&VT,&VKO,&VKL,&DT,&LABEL=N,&VL80=0            00020000
.*  DEBTRACY IS USED AS AN INNER MACRO TO EXPAND ONE OPERAND, OR TO     00030000
.*    CHANGE THE DEFAULT VARIABLE TYPE, FOR THE DBT MACRO               00040000
         GBLA  &ZZZDBA#,&ZZZDBAN                                        00050000
         GBLB  &ZZZDBTF      (FIRST TIME FLAG)                          00060000
         GBLB  &ZZZ80FG      SET WHEN END OF LIST GENERATED             00070000
         GBLC  &ZZZDBTV,&ZZZDBTT,&ZZZDBAT(40),&ZZZDBAI(40),&ZZZDBAL(40) 00080000
         LCLA  &LN,&I,&EN,&EM,&EO                                       00090000
         LCLC  &L,&ET,&EL,&EK,&DFT,&EKO,&EKL                            00100000
&EK      SETC  '&VA'                                                    00110000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    00120000
&DFT     SETC  '&DT'         SET TYPE OVERRIDE                          00130000
&EKO     SETC  '0'           DEFAULT CHAIN POINTER OFFSET               00140000
&EKL     SETC  '4'           DEFAULT CHAIN POINTER LENGTH               00150000
.*  SEE WHETHER THE CURRENT VARIABLE NAME IS ONE OR TWO CHARACTERS,     00160000
.*  HAS NO LENGTH OR TYPE SPECIFICATIONS, AND APPEARS IN TYPE TABLE.    00170000
.*  IF SO, JUST RESET GLOBAL TYPE TO SPECIFIED ONE.                     00180000
         AIF   (&EM GT 2).NOLOOPT                                       00190000
         AIF   (&EM LE 0).MEND                                          00200000
         AIF   ('&VL' NE '' OR  '&VT' NE '').NOLOOPT                    00210000
.LOOPTYP AIF   (&I GE &ZZZDBA#).NOLOOPT  NOT A REDEFINITION             00220000
&I       SETA  &I+1                                                     00230000
         AIF   ('&VA' NE '&ZZZDBAT(&I)').LOOPTYP                GP02365 00240000
&ZZZDBTT SETC  '&ZZZDBAI(&I)'  SET NEW DEFAULT                          00250000
         MEXIT ,                                                        00260000
.*  FIRST CHECK THE DEFAULT TYPE - IF NULL, ASSIGN THE GLOBAL ONE.      00270000
.*  IF GLOBAL IS NULL, SET GLOBAL AND LOCAL TO HEX (03)                 00280000
.NOLOOPT AIF   ('&DFT' NE '').NONUTYP                                   00290000
&DFT     SETC  '&ZZZDBTT'    COPY GLOBAL TYPE                           00300000
         AIF   ('&DFT' NE '').NONUTYP                                   00310000
&DFT     SETC  '10'          DEFAULT IS HEX                             00320000
&ZZZDBTT SETC  '10'          DEFAULT IS HEX                             00330000
.NONUTYP AIF   ('&VKO' EQ '').NONVKO                                    00340000
&EKO     SETC  '&VKO'                                                   00350000
.NONVKO  AIF   ('&VKL' EQ '').NONVKL                                    00360000
&EKL     SETC  '&VKL'                                                   00370000
.NONVKL  ANOP  ,                                                        00380000
&L       SETC  'L'''                                                    00390000
&EL      SETC  '&VL'                                                    00400000
&EO      SETA  0             PRESET FOR NORMAL ADDRESSING MODE          00410000
&ET      SETC  '&DFT'        PRESET FOR DEFAULT                         00420000
         AIF   ('&EK'(1,1) NE '/' AND '&EK'(1,1) NE '*').NOTIND GP03128 00430001
&EO      SETA  &EO+1         REQUEST INDIRECT ADDRESSING                00440000
&EK      SETC  '&EK'(2,&EM-1)  DELETE LEADING CONTROL BYTE              00450000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    00460000
.NOTIND  AIF   (&EM LE 0).MEND                                          00470000
         AIF   ('&EK'(&EM,1) NE '%').NOTA24                             00480000
&EO      SETA  &EO+2         REQUEST FORCED 24-BIT ADDRESSING           00490000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             00500000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    00510000
.NOTA24  AIF   (&EM LE 0).MEND                                          00520000
         AIF   ('&EK'(&EM,1) NE '?').NOTA31                             00530000
&EO      SETA  &EO+4         REQUEST FORCED 31-BIT ADDRESSING           00540000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             00550000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    00560000
.NOTA31  AIF   (&EM LE 0).MEND                                          00570000
&I       SETA  0                                                        00580000
.TESTTYP AIF   (&I GE &ZZZDBAN).NOTYPED  NOT A VALID ENTRY              00590000
&I       SETA  &I+1                                                     00600000
         AIF   ('&VT' NE '&ZZZDBAT(&I)').TESTTYP                        00610000
&ET      SETC  '&ZZZDBAI(&I)'   SET NEW TYPE                            00620000
         AGO   .EXPAND                                                  00630000
.NOTYPED AIF   ('&VT' NE '').NOTYPO                                     00640000
&ET      SETC  '&DFT'           ESLE SET DEFAULT                        00650000
         AGO   .EXPAND                                                  00660000
.NOTYPO  MNOTE 4,'DEBTRACY: VARIABLE/REQUEST TYPE INVALID: &VT'         00670000
.*  NOW WE HAVE THE VARIABLE NAME AND THE TYPE. CHECK LENGTH            00680000
.EXPAND  AIF   ('&EL' NE '').HLEN                                       00690000
&EL      SETC  '&L'.'&EK'                                               00700000
.HLEN    AIF   ('&LABEL' EQ 'N').NOLABEL                                00710000
         DC    X'0100',CL8'&VA '  ITEM LABEL                            00720000
.NOLABEL ANOP  ,                                                        00730000
&ZZZ80FG SETB  (&ZZZ80FG OR &VL80)                                      00740000
         AIF   ('&ZZZDBAL(&I)' EQ '6' OR '&ZZZDBAL(&I)' EQ '').LEN6     00750000
         AIF   ('&ZZZDBAL(&I)' EQ '2').LEN2                             00760000
         AIF   ('&ZZZDBAL(&I)' EQ '4').LEN4                             00770000
         AIF   ('&ZZZDBAL(&I)' EQ '8').LEN8                             00780000
         MNOTE 'DEBTRACY: INVALID ENTRY PASSED: &VA,&VL,&VT,&VKO,&VKL'  00790000
.LEN8    AIF   ('&ZZZDBAI(&I)' NE '16').LEN811   NOT FLAG               00800000
.LEN820  DC    AL1(X'80'*&VL80+&ET,&EO),SL2(&EK,&EL,&EKO)               00810000
         MEXIT ,                                                        00820000
.LEN811  DC    AL1(X'80'*&VL80+&ET,&EO),SL2(&EK,&EL),AL1(&EKO,&EKL)     00830000
         MEXIT ,                                                        00840000
.LEN6    DC    AL1(X'80'*&VL80+&ET,&EO),SL2(&EK,&EL)            GP02365 00850000
         MEXIT ,                                                        00860000
.LEN4    DC    AL1(X'80'*&VL80+&ET,&EO),SL2(&EK)                        00870000
         MEXIT ,                                                        00880000
.LEN2    DC    AL1(X'80'*&VL80+&ET,&EO)                                 00890000
.MEND    MEND  ,                                                        00900000
./ ADD NAME=DELETEST
         MACRO ,                                                        00010000
&NM      DELETEST &EP=,&EPLOC=,&LEN=4                   ADDED ON 81194  00020000
.*--------------------------------------------------------------------* 00030000
.*   DELETE A MODULE IF IT HAS PREVIOUSLY BEEN LOADED.                * 00040000
.*   NOTE:  ASSUMES VARIABLE WITH MODULE ADDRESS (OR 0) TO HAVE THE   * 00050000
.*     SAME NAME AS THE MODULE                                        * 00060000
.*--------------------------------------------------------------------* 00070000
         LCLC  &MOD                                                     00080000
         LCLA  &NDX,&I,&J                                       GP04118 00090000
&NDX     SETA  &SYSNDX                                                  00100000
&MOD     SETC  '&EP'                                                    00110000
         AIF   (T'&EPLOC EQ 'O').EP                                     00120000
&MOD     SETC  '&EPLOC'                                                 00130000
&J       SETA  K'&EPLOC                                         GP04118 00140003
         AIF   (&J LT 5).EP                                     GP04118 00150001
         AIF   ('&EPLOC'(1,1) NE '=').EP                        GP04118 00160000
&I       SETA  4             SKIP =C'                           GP04118 00170000
         AIF   ('&EPLOC'(1,3) EQ '=C''').LOCLIT                 GP04118 00180000
&I       SETA  6             SKIP =C'                           GP04118 00190000
         AIF   ('&EPLOC'(1,5) NE '=CL8''').EP  LET IT FAIL      GP04118 00200000
.LOCLIT  ANOP  ,                                                GP04118 00210000
&MOD     SETC  '&EPLOC'(&I,&J-&I)                               GP04118 00220004
.EP      AIF   ('&LEN' EQ '3').LOWAD                             81284  00230000
&NM      ICM   R0,15,&MOD                                               00240000
         BNP   ZZZZ&NDX                                                 00250000
         AGO   .COMDEL                                           81284  00260000
.LOWAD   ANOP  ,                                                 81284  00270000
&NM      ICM   R0,7,1+&MOD                                              00280000
         BZ    ZZZZ&NDX                                                 00290000
.COMDEL  DELETE EP=&EP,EPLOC=&EPLOC                                     00300000
ZZZZ&NDX XC    &MOD.(4),&MOD                                            00310000
         MEND  ,                                                        00320000
./ ADD NAME=DIAG
         MACRO ,                                                        00010000
&NM      DIAG  &R1,&R3,&I2                                 NEW  GP10041 00020000
.*  ADDED FOR HERCULES SUPPORT                                          00030000
&NM      DC    0H'0',AL.4(8,3,&R1,&R3),AL2(&I2)                         00040000
.MEXIT   MEND  ,                                                        00050000
./ ADD NAME=DUMP
         MACRO ,                                                        00010000
&L       DUMP  &TYPE                                                    00020000
.********************************************************************** 00030000
.*                                                                   ** 00040000
.*  EXHIBIT MACRO TO CONTROL STORAGE FORMATTING                      ** 00050000
.*                                                                   ** 00060000
.********************************************************************** 00070000
         LCLA  &DISP                                                    00080000
         AIF   ('&TYPE' EQ 'EBCDIC').EBC                                00090000
         AIF   ('&TYPE' EQ 'HEX').HEX                                   00100000
         AIF   ('&TYPE' EQ 'LABEL').LAB                                 00110000
         AIF   ('&TYPE' EQ 'VAR').VAR                                   00120000
&L       MOTE  'TYPE MUST BE EBCDIC, HEX, LABEL, OR VAR'                00130000
         MEXIT                                                          00140000
.VAR     ANOP                                                           00150000
&DISP    SETA  4                                                        00160000
.LAB     ANOP                                                           00170000
&DISP    SETA  &DISP+4                                                  00180000
.HEX     ANOP                                                           00190000
&DISP    SETA  &DISP+4                                                  00200000
.EBC     ANOP                                                           00210000
.CALLIT  ANOP                                                           00220000
&L       LA    R1,DUMPLIST                                              00230000
         L     R15,DUMP                                                 00240000
         L     R2,&DISP.(R15)                                           00250000
         BALS  R14,0(R2,R15)                                            00260000
         MEND  ,                                                        00270000
./ ADD NAME=DYNSPACE
         MACRO                                                          00010000
&NAME    DYNSPACE &TYPE                                                 00020000
.*                                                                      00030000
.*    THIS IS AN INNER MACRO TO ALLOC/FREE.                             00040000
.*    IT IS CALLED TO   A) NAME AN AREA FOR THE PARMLIST                00050000
.*                      B) LOG THE VARIOUS AMOUNTS NEEDED BY            00060000
.*                         EACH, REMEMBERING THE LARGEST.               00070000
.*                      C) GENERATING A DS FOR THE LARGEST AMOUNT.      00080000
.*    THE FIRST TWO FUNCTIONS ARE INVOKED BY ALLOC/FREE MACROS ONLY,    00090000
.*    AND THE THIRD IS USED BY THE PROGRAMMER, EITHER EXPLICITLY,       00100000
.*    OR BY BEGINWKA, IF THE LATTER IS USED.                            00110000
.*                                                                      00120000
.*     TO INVOKE THE NAMING FUNCTION, ALLOC/FREE GENERATE               00130000
.*     NAME DYNSPACE                                                    00140000
.*     NOTE. THE NAMING OPERATION ONLY GENERATES A NAME ON THE          00150000
.*     FIRST CALL IN THE ASSEMBLY. THE NAME REMAINS THE SAME UNTIL      00160000
.*     DYNSPACE IS CALLED TO EXPAND INTO A DS.                          00170000
.*                                                                      00180000
.*     THE SECOND FUNCTION IS INVOKED BY THE MACRO CALL                 00190000
.*          DYNSPACE ADD                                                00200000
.*     (NO NAME FIELD AND ONE OPERAND)                                  00210000
.*     IT USES THE GLOBAL VARIABLES &DTUO AND &DTUPO TO CALCULATE       00220000
.*     THE SPACE FOR THIS REQUEST, AND UPDATES &DYNSPQ ONLY IF THE      00230000
.*     CURRENT REQUEST IS FOR A GREATER AMOUNT                          00240000
.*                                                                      00250000
.*     THE THIRD FUNCTION IS INVOKED BY CALLING DYNSPACE WITH NO        00260000
.*     NAME OR OPERAND FIELD.                                           00270000
.*     THIS EXPANDS INTO A DEFINE STORAGE, CLEARS THE DYNSPACE NAME     00280000
.*     GLOBAL SETC, AND THE &DYNSPQ GLOBAL SETA.                        00290000
.*     THUS, THE MACRO IS SERIALLY REUSABLE IN ALL FUNCTIONS.           00300000
.*                                                                      00310000
         GBLA  &DYNSPQ,&DTUO,&DTUPO,&RCPDYN                             00320000
         GBLC  &DYNP,&DYNSP                                             00330000
         LCLA  &I                                                       00340000
         AIF   ('&NAME' NE '').NAME                                     00350000
         AIF   ('&TYPE' EQ '').ALLOC                                    00360000
.*   THE ACCUMULATE FUNCTION IS REQUIRED                                00370000
&I       SETA  24+&DTUO+&DTUPO         GET AMOUNT FOR THIS REQUEST      00380000
         AIF   (&I LE &DYNSPQ).EXIT    IF CURRENT < MAX, EXIT           00390000
&DYNSPQ  SETA  &I                      ELSE UPDATE CURRENT MAXIMUM      00400000
         MEXIT                                                          00410000
.NAME    AIF   ('&DYNSP' NE '').EXIT   IF NAME ALREADY EXISTS, EXIT     00420000
&DYNSP   SETC  'DYNSP&RCPDYN'           ELSE GENERATE A NAME            00430000
.EXIT    MEXIT                                                          00440000
.ALLOC   AIF   ('&DYNSP' EQ '').EXIT                                    00450000
*                                                                       00460000
**     RESERVE SPACE FOR ALLOC/FREE MACRO WORK AREA                     00470000
*                                                                       00480000
&DYNSP   DS    0F,CL&DYNSPQ            RESERVE SPACE                    00490000
&DYNSP   SETC  ''                      SET MAX QUANTITY TO 0            00500000
&DYNSPQ  SETA 0                                                         00510000
         MEND                                                           00520000
./ ADD NAME=EBCDIG
         MACRO ,                                                        00010000
&NM      EBCDIG &VAL,&LEN                                               00020000
.********************************************************************** 00030000
.*                                                                      00040000
.*   THIS MACRO CONVERTS AN ABSOLUTE NUMBER, VARIABLE, OR EXPRESSION    00050000
.*   INTO AN EBCDIC CONSTANT OF LENGTH &LEN (NO WARNING ON OVERFLOW).   00060000
.*   IT'S USEFUL FOR GENERATING CONTROL CARDS, ESPECIALLY FOR SORT.     00070000
.*                                                                      00080000
.*   FOR EXAMPLE:                                                       00090000
.*     X EQU 15                                                         00100000
.*       EBCDIG X,3   EXPANDS:                                          00110000
.*       DC    AL1(240+0,240+1,240+5)  (MORE OR LESS)  C'015'           00120000
.*                                                                      00130000
.********************************************************************** 00140000
         LCLA  &I,&J,&K                                                 00150000
&I       SETA  9                                                        00160000
&J       SETA  1000000000                                               00170000
&K       SETA  100000000                                                00180000
         AIF   (T'&VAL EQ 'O').BADVAL                                   00190000
         AIF   (T'&LEN NE 'N').BADLEN                                   00200000
         AIF   ('&NM' EQ '').NODC                                       00210000
&NM      DC    0CL(&LEN)' '                                             00220000
.NODC    AIF   (&LEN GT 9).BADLEN                                       00230000
         AIF   (&LEN GT 0).OKLEN                                        00240000
.BADLEN  MNOTE 8,'LENGTH (OPERAND 2) IS UNACCEPTABLE: &LEN '            00250000
         MEXIT ,                                                        00260000
.BADVAL  MNOTE 8,'VALUE (OPERAND 1) IS MISSING'                         00270000
         MEXIT ,                                                        00280000
.OKLEN   AIF   (&LEN LT &I).NOTLEN                                      00290000
         DC    AL1(240+((&VAL)/&K-((&VAL)/&J)*10))                      00300000
.NOTLEN  AIF   (&I EQ 1).MEND                                           00310000
&I       SETA  &I-1                                                     00320000
&J       SETA  &K                                                       00330000
&K       SETA  &K/10                                                    00340000
         AGO   .OKLEN                                                   00350000
.MEND    MEND  ,                                                        00360000
./ ADD NAME=EBCHEX
         MACRO ,                                                        00010000
&NM      EBCHEX &VAL,&LEN                                       GP97272 00020000
.********************************************************************** 00030000
.*                                                                   ** 00040000
.*       THIS MACRO CONVERTS A NUMERIC VARIABLE (E.G. L') INTO AN       00050000
.*       EBCDIC CONSTANT OF LENGTH &LEN IN HEXADECIMAL FORMAT           00060000
.*                                                                   ** 00070000
.********************************************************************** 00080000
         LCLA  &I,&J,&K                                                 00090000
&I       SETA  8                                                        00100000
&K       SETA  268435456                                                00110000
         AIF   (T'&LEN NE 'N').BADLEN                                   00120000
         AIF   ('&NM' EQ '').NODC                                       00130000
&NM      DC    0CL(&LEN)' '                                             00140000
.NODC    AIF   (&LEN GT 8).BADLEN                                       00150000
         AIF   (&LEN GT 0).OKLEN                                        00160000
.BADLEN  MNOTE 8,'LENGTH (OPERAND 2) IS UNACCEPTABLE: &LEN '            00170000
         MEXIT ,                                                        00180000
.OKLEN   AIF   (&LEN LT &I).NOTLEN                                      00190000
         AIF   (&I LT 8).LONGFM                                         00200000
         DC    AL1(240+((&VAL)/&K)-((C'0'-C'A'+10)*(((&VAL)/&K)/10)))   00210000
         AGO   .NOTLEN                                                  00220000
.LONGFM  DC    AL1(240+(((&VAL)/&K)-((&VAL)/&J)*16)-((C'0'-C'A'+10)*(((*00230000
               (&VAL)/&K)-((&VAL)/&J)*16)/10)))                         00240000
.NOTLEN  AIF   (&I EQ 1).MEND                                           00250000
&I       SETA  &I-1                                                     00260000
&J       SETA  &K                                                       00270000
&K       SETA  &K/16                                                    00280000
         AGO   .OKLEN                                                   00290000
.MEND    MEND  ,                                                        00300000
./ ADD NAME=ENDM
         MACRO                                                          00010000
&L       ENDM  &DUMMY,&DISP=FREEMAIN,&PFX=SAVE,&NEXT=,                 *00020000
               &RC=,&RC0=,&RC1=,&COPYRET=,&RETADDR=(R14)         83087  00030000
.*                                                                      00040000
.*             COPYRIGHT 1978 BY SHMUEL (SEYMOUR J.) METZ               00050000
.*                        ALL RIGHTS RESERVED.                          00060000
.*                                                                      00070000
.*             THIS MACRO IS NOT TO BE DISTRIBUTED WITHOUT PERMISSION,  00080000
.*             AS DESCRIBED IN MEMBER $$RIGHTS.                         00090000
.*                                                                      00100000
         LCLC  &LB                 LABEL                         81208  00110000
         LCLC  &SB                 SAVE AREA BASE NAME           81208  00120000
         LCLC  &SV                 SAVE AREA PREFIX              81208  00130000
&LB      SETC  '&L'                                                     00140000
&SV      SETC  '&PFX'                                                   00150000
&SB      SETC  '&SV'.'SPLN'                                      81208  00160000
         AIF   ('&DISP' EQ 'FREEMAIN' OR '&DISP' EQ 'RETAIN'           *00170000
               OR '&DISP' EQ 'POP' OR '&DISP' EQ 'STATIC'              *00180000
               OR '&DISP' EQ 'TEST').DISPOK                      81347  00190000
         MNOTE 4,'UNSUPPORTED VALUE DISP=&DISP'                  81347  00200000
.DISPOK  AIF   ('&DISP' EQ 'RETAIN').RETAIN                      81347  00210000
&L       L     R0,&SV.SPLN-&SB.(,R13)                            81208  00220000
         LR    R1,R13                                                   00230000
         L     R13,&SV.13-&SB.(,R13)                             81208  00240000
&LB      SETC  ''                                                       00250000
.RETAIN  AIF   (T'&COPYRET EQ 'O').DONCOPY                       81154  00260000
         AIF   (N'&COPYRET LT 2).ONECOPY                         81154  00270000
         AIF   (N'&COPYRET EQ 2).TWOCOPY                         81154  00280000
         MNOTE 4,' COPYRET PARAMETER INVALID; USE (ADDR-EXPR,LENGTH)'   00290000
.TWOCOPY ANOP  ,                                                 81154  00300000
&LB      MVC   &SV.15-&SB.(&COPYRET(2),R13),&COPYRET(1)          81208  00310000
         AGO   .TSTCOPY                                          81154  00320000
.ONECOPY ANOP  ,                                                 81154  00330000
&LB      MVC   &SV.15-&SB.(4,R13),&COPYRET(1)                    81208  00340000
.TSTCOPY ANOP  ,                                                 81154  00350000
&LB      SETC  ''                                                81154  00360000
.DONCOPY AIF   (T'&NEXT NE 'O').XCTL                             81154  00370000
         AIF   (T'&RC EQ 'O').T1RC0                                     00380000
         AIF   ('&RC'(1,1) EQ '(').SVRC                                 00390000
         AIF   (T'&RC EQ 'N').T1RC0                                     00400000
         MNOTE 12,'INVALID RETURN CODE &RC'                             00410000
         MEXIT                                                          00420000
.SVRC    ANOP  ,                                                        00430000
&LB      ST    &RC(1),&SV.15-&SB.(,R13)                          81208  00440000
&LB      SETC  ''                                                       00450000
.T1RC0   AIF   (T'&RC0 EQ 'O').T1RC1                                    00460000
         AIF   ('&RC0' EQ '(0)' OR '&RC0' EQ '(R0)').BUMRC0             00470000
         AIF   ('&RC0'(1,1) EQ '(').SVRC0                               00480000
         AIF   (T'&RC0 EQ 'N').EXIT                                     00490000
.BUMRC0  MNOTE 12,'INVALID SECONDARY RETURN CODE &RC0'                  00500000
         MEXIT                                                          00510000
.SVRC0   ANOP  ,                                                        00520000
&LB      ST    &RC0(1),&SV.0-&SB.(,R13)                          81208  00530000
&LB      SETC  ''                                                       00540000
.T1RC1   AIF   (T'&RC1 EQ 'O').EXIT                                     00550000
         AIF   ('&RC1' EQ '(1)' OR '&RC1' EQ '(R1)').BUMRC1             00560000
         AIF   ('&RC1'(1,1) EQ '(').SVRC1                               00570000
         AIF   (T'&RC1 EQ 'N').EXIT                                     00580000
.BUMRC1  MNOTE 12,'INVALID SECONDARY RETURN CODE &RC1'                  00590000
         MEXIT                                                          00600000
.SVRC1   ANOP  ,                                                        00610000
&LB      ST    &RC1(1),&SV.1-&SB.(,R13)                          81208  00620000
&LB      SETC  ''                                                       00630000
         AGO   .EXIT                                                    00640000
.XCTL    AIF   ('&DISP' EQ 'FREEMAIN').XCTL1                     81347  00650000
         AIF   ('&DISP' NE 'TEST').XCTL2                         81347  00660000
&LB      ICM   R0,7,1+&SV.SPLN-&SB.(R1) ZERO LENGTH ?            81347  00670000
&LB      SETC  ''                                                81347  00680000
         BZ    *+6           SKIP FREE IF SO                     81347  00690000
.XCTL1   ANOP  ,                                                 81347  00700000
.*       FREEMAIN R,LV=(0),A=(1)                                 81347  00710000
&LB      SVC   10                                                81347  00720000
&LB      SETC  ''                                                       00730000
.XCTL2   ANOP  ,                                                        00740000
&LB      LA    R15,X@&SYSNDX                                            00750000
         LM    R0,R12,&SV.0-&SB.(R13)                            81208  00760000
         MVI   &SV.14-&SB.(R13),X'FF'   FLAG AS LAST SAVE AREA   81208  00770000
         XCTL  SF=(E,(15))                                              00780000
X@&SYSNDX XCTL EP=&NEXT,SF=L                                            00790000
         MEXIT                                                          00800000
.EXIT    AIF   ('&DISP' EQ 'FREEMAIN').EXIT1                     81347  00810000
         AIF   ('&DISP' NE 'TEST').NOFM                          81347  00820000
&LB      ICM   R0,7,1+&SV.SPLN-&SB.(R1) ZERO LENGTH ?            81347  00830000
&LB      SETC  ''                                                81347  00840000
         BZ    *+6           SKIP FREE IF SO                     81347  00850000
.EXIT1   ANOP  ,                                                 81347  00860000
.*       FREEMAIN R,LV=(0),A=(1)                                 81347  00870000
&LB      SVC   10                                                81347  00880000
&LB      SETC  ''                                                       00890000
.NOFM    ANOP  ,                                                        00900000
&LB      LM    R14,R12,&SV.14-&SB.(R13)                          81208  00910000
         MVI   &SV.14-&SB.(R13),X'FF'   FLAG AS LAST SAVE AREA   81208  00920000
         AIF   (T'&RC NE 'N').T2RC0                                     00930000
         AIF   ('&RC'(1,1) EQ '(').T2RC0                                00940000
         AIF   ('&RC' EQ '0').EFES                                      00950000
         LA    R15,&RC                                                  00960000
         AGO   .T2RC0                                                   00970000
.EFES    XR    R15,R15                                                  00980000
.T2RC0   AIF   (T'&RC0 NE 'N').T2RC1                                    00990000
         AIF   ('&RC0' EQ '0').EFES0                                    01000000
         LA    R0,&RC0                                                  01010000
         AGO   .T2RC1                                                   01020000
.EFES0   XR    R0,R0                                                    01030000
.T2RC1   AIF   (T'&RC1 NE 'N').BR                                       01040000
         AIF   ('&RC1' EQ '0').EFES1                                    01050000
         LA    R1,&RC1                                                  01060000
         AGO   .BR                                               83087  01070000
.EFES1   XR    R1,R1                                                    01080000
.BR      AIF   (T'&RETADDR EQ 'O').END                           83087  01090000
         AIF   (K'&RETADDR LT 3).BRL                             83087  01100000
         AIF   ('&RETADDR'(1,1) EQ '(' AND '&RETADDR'(2,1) NE '(').BRR  01110000
.BRL     B     &RETADDR                                          83087  01120000
         AGO   .END                                              83087  01130000
.BRR     BR    &RETADDR(1)                                       83087  01140000
.END     MEND                                                           01150000
./ ADD NAME=ESPCVT
         MACRO ,                                                        00010000
&NM      ESPCVT &SECT=D,&OPT=                                           00020000
         GBLC  &HOOKCVT                                         GP11214 00030000
         LCLC  &NAME,&USECT                                             00040000
         LCLB  &D                                               GP11214 00050000
&USECT   SETC  '&SYSECT'     SAVE USER'S CSECT NAME             GP11214 00060000
&D       SETB  ('&OPT' EQ 'LIST')                               GP11214 00070000
&NAME    SETC  '&NM'                                                    00080000
.*                                                                      00090000
.*   THIS MACRO MAPS THE 'ESP' CVT EXTENSION                    GP11214 00100000
.*   THAT IS POINTED TO BY 'CVTJOB'. BUILT BY 'ESPINIT'         GP11214 00110000
&HOOKCVT SETC  'CVTLINK+4'   POINTER TO THIS TABLE              GP11214 00120000
.*                                                              GP11214 00130000
.*   WHEN OPT=LIST IS SPECIFIED, THIS MACRO ALSO EXPANDS A LIST OF DC   00140000
.*       CONSTANTS FOR LOADING AND SETTING THE CONTENTS OF ADDRESSES.   00150000
.*                                                                      00160000
         AIF   ('&SECT' EQ 'NO').NOSECT                                 00170000
         AIF   ('&NM' NE '').OK                                         00180000
         MNOTE 4,'CSECT/DSECT NAME MISSING, ''ESPCVT'' ASSUMED.'        00190000
&NAME    SETC  'ESPCVT'                                                 00200000
.OK      AIF   ('&SECT' NE 'C').DSECT                                   00210000
&NAME    CSECT ,                                                        00220000
         AGO   .BLNM                                                    00230000
.DSECT   ANOP                                                           00240000
&NAME    DSECT ,                                                        00250000
         AGO   .BLNM                                                    00260000
.NOSECT  AIF   ('&NM' EQ '').BLNM                                       00270000
&NAME    DS    0F .          START OF USER CVT MAPPING                  00280000
.BLNM    ANOP                                                           00290000
.*                                                                      00300000
UCFLAGS  DC    X'1' .        FLAG BYTE                                  00310000
UCIPL    EQU   X'80' .       IPL AUTO STARTS PENDING                    00320000
UCRJE    EQU   X'40' .       RJE RUN AT LEAST ONCE SINCE LAST IPL       00330000
UCAUTO   EQU   X'20' .       AT LEAST ONE 'AUTO' COMMAND ACTIVE         00340000
UCAPEN   EQU   X'10' .       AT LEAST ONE AUTO START PENDING            00350000
UCASCRCH EQU   X'04'         ON IF IPL TIME SYSDA SCRATCHED      91049  00360000
UCACCBAD EQU   X'02'           A$GINIT OPEN FAILED               84317  00370000
UCCONLT  EQU   1 .           ON IF LOTS OF MESSAGES WITH CONID          00380000
.*                                                                      00390000
         SPACE                                                          00400000
UCCONID  DC    X'1' .        NON-ZERO IF SPECIAL MESSAGES ARE TO BE WTO 00410000
*        CONTENTS IS UCMID OF DESTINATION CONSOLE                       00420000
.*                                                                      00430000
         SPACE                                                          00440000
UCIPLCNT DC    X'0' .        NO. OF IPL AUTO STARTS STILL PENDING       00450000
UCSMFNM  DC    C'H' .   BYTE TO COMPLETE SMF PARM NAME 'SMFDEFL_'       00460000
*        U IS STANDARD SMF; T GIVES OPI; N CANCELS SMF SUPPORT          00470000
.*       H (DEFAULT) PROVIDES HASP SUPPORT                              00480000
UCAUTCHN DC    A(0)          AUTORDR COMMAND CHAIN              GP11214 00490000
UCAUTCNT DC    F'0'          AUTORDR ACTIVE COUNT               GP11214 00500000
UCRSV01  DC    A(0)                                              92292  00510000
UCRSV02  DC    A(0)                                              92292  00520000
.*                                                                      00530000
         SPACE                                                          00540000
UCIPLTIM DC    F'0' .        IPL OR LAST MODIFIED TIME (BIN)            00550000
UCIPLDAT DC    F'0' .        IPL OR LAST MODIFIED DATE                  00560000
UCRSV03  DC    XL2'0'                                            92292  00570000
UCRSV04  DC    XL2'0'                                            92292  00580000
UCRSV05  DC    3A(0)                                             92292  00590000
UCA$ANCR DS    0D      1/3   ACCOUNTING ANCHOR WORDS (DB FOR CDS)       00600000
UCA$USCT DC    F'0'    2/3   USE COUNT                           83142  00610000
UCA$GDA  DC    A(0)    3/3   GLOBAL ACCOUNTING DATA AREA         83142  00620000
UCLINDX  DC    A(0)          => (BXLE) INDEX TABLE               92292  00630000
UCLUADS  DC    A(0)          => (BXLE) UADS/ACCOUNT TABLE        85182  00640000
UCLACCT  DC    A(0)          LPA/CSA ADDRESS OF ACCOUNT TABLE    92292  00650000
UCLVOLT  DC    A(0)          LPA ADDRESS OF LEXVOLT SUBROUTINES         00660000
UCLSERV  DC    A(0)          LPA ADDRESS OF @SERVICE             83044  00670000
UCLSERV2 DC    A(0)            @SRVJES2 - PRIMARY SUBSYSTEM I/F  92292  00680000
UCLPRINT DC    A(0)          @PRINTER ROUTINE                    83044  00690000
UCLINPUT DC    A(0)          @INPREAD ROUTINE                    83044  00700000
UCLVOLRD DC    A(0)          @VOLREAD ROUTINE                    83044  00710000
UCLSCRNS DC    A(0)          @SCREENS ROUTINE                    87308  00720000
UCLFORMS DC    A(0)          @FORMATS CONVERSIONS               GP11219 00730000
UCLPARSE DC    A(0)          @PARSER                            GP11219 00740000
         DC    4A(0)         LPA ADDRESSES (OR 0) OF SPECIAL MODULES    00750000
UCXSVC99 DC    A(0)          SVC 99 USER EXIT ADDRESS            83142  00760000
UCXACTEX DC    A(0)          ACCOUNTING - EXIT ROUTINE           83142  00770000
UCXLOGON DC    A(0)          TSO - PRE-LOGON EXIT ROUTINE        86143  00780000
UCHARRIS DC    A(0)          HARRIS MOUNT MESSAGE POINTER        92288  00790000
         DC    A(0)            RESERVED                          89009  00800000
UCLVOLS  DC    A(0)          => (BXLE) VOLUME/SERIAL TABLE       89009  00810000
UCLOUD   DC    A(0)          CHAIN OF LOCAL ONLINE USER DATA     87277  00820000
UCLWYL   DC    A(0)          LPA ADDRESS OF WYLBUR VTOC TABLE    85200  00830000
.*                                                                      00840000
ESPGMLEN EQU   *-&NAME         GETMAIN LENGTH                    83044  00850000
         AIF   (NOT &D).MEND                                    GP11214 00860000
&USECT   CSECT ,             RESTORE USER'S CSECT (IT HAD BETTER BE)    00870000
PATULIST DC    A(UCLVOLT-&NAME),CL8'LEXVOLT'  RESIDENT SUBROUTINES      00880000
PATULENG EQU   *-PATULIST,4,C'A'  LENGTH OF ONE ENTRY           GP11214 00890000
         DC    A(UCLSERV-&NAME),CL8'@SERVICE'  COMMON SERVICES  GP11214 00900000
         DC    A(UCLSERV2-&NAME),CL8'@SRVJES2'  SUBSYSTEM SERVICES      00910000
         DC    A(UCLPRINT-&NAME),CL8'@PRINTER'  PRINTING        GP11214 00920000
         DC    A(UCLINPUT-&NAME),CL8'@INPREAD'  READING         GP11214 00930000
         DC    A(UCLVOLRD-&NAME),CL8'@VOLREAD'  VTOC/DSCB INTERFACE     00940000
         DC    A(UCLSCRNS-&NAME),CL8'@SCREENS'  3270 SCREEN HANDLING    00950000
         DC    A(UCLFORMS-&NAME),CL8'@FORMATS'  CONVERSION SUBROUTINES  00960000
         DC    A(UCLPARSE-&NAME),CL8'@PARSER '  PARSING    SUBROUTINES  00970000
         DC    A(UCXSVC99-&NAME),CL8'LEXSVC99'  ALLOCATION EXIT GP11214 00980000
         DC    A(UCXACTEX-&NAME),CL8'TMSACTRT'  CA-1 TMS ACCOUNTING     00990000
PATULEND DC    A(UCXLOGON-&NAME),CL8'LEXLOGON'  TSO PRE-LOGON EXIT      01000000
.MEND    MEND                                                           01010000
./ ADD NAME=ESPHEAD
         MACRO                                                          00010000
&MODULE ESPHEAD &R0=,&R1=,&HEADER=,&REENT=Y,&BASE=R12,&CLEAR=YES,      *00020001
               &LOC=,&PATCH=,&ENTRY=,&SP=0                     GP00126  00030001
         GBLB  &RENTFLG                                                 00040000
         GBLC  &CPYWRIT                                                 00050000
         GBLC  &VERSION                                                 00060000
         GBLC  &MODNAME                                                 00070000
         LCLC  &LABEL,&NAME                                             00080000
         LCLC  &PBAS,&CBAS,&FBAS,&LBAS                          GP99357 00090000
         LCLB  &FGPATCH,&FGENT,&FGENTB                          GP00126 00100000
&FGPATCH SETB  (T'&PATCH EQ 'N')                                        00110000
&FGENT   SETB  (T'&ENTRY NE 'O')                                GP00126 00120000
         LCLA  &I,&J,&K                                         GP99357 00130000
         SPACE 1                                                        00140001
&LABEL   SETC  'ZZM'.'&SYSNDX'    PREFIX FOR GENERATED LABELS           00150001
&NAME    SETC  '&MODULE'                                                00160001
&MODNAME SETC  '&MODULE'                                                00170001
&NAME    CSECT ,                                                        00180001
&NAME    AMODE 31                                                       00190000
&NAME    RMODE 24                                                       00200000
         AIF   ('&HEADER' EQ 'TABLE').TABLE1                            00210000
         SPACE 1                                                        00220001
         USING *,R15                                                    00230000
         B     &LABEL                  BRANCH AROUND HEADER INFO        00240000
.TABLE1  ANOP  ,                                                        00250001
         DC    AL1(&LABEL-&NAME)       LENGTH(HEADER TEXT)              00260000
         DC    CL9'&NAME'              EYE CATCHER - MODULE NAME        00270000
         DC    CL9'&SYSDATE'           EYE CATCHER - ASSEMBLE DATE      00280000
         DC    CL6'&VERSION'           ESP VERSION N.NN                 00290000
         DC    C'&CPYWRIT'             COPYRIGHT INFO                   00300000
         AIF   ('&HEADER' NE 'TABLE').NOTTAB                            00310000
&LABEL   DC    0D'0'                   DOUBLEWORD ALIGNMENT FOR TABLE   00320000
.MEXIT   MEXIT ,                                                GP00126 00330000
.NOTTAB  ANOP  ,                                                        00340001
&LABEL   DC    0H'0'                   TAG FOR BRANCH AROUND TEXT       00350000
         AIF   ('&HEADER' EQ 'TABLE').MEXIT                             00360000
         SPACE 1                                                        00370001
         STM   R14,R12,12(R13)         SAVE REGISTERS                   00380000
         AIF   (NOT &FGENT).NOENT                               GP00126 00390000
&I       SETA  0                                                GP00126 00400000
&K       SETA  N'&ENTRY                                         GP00126 00410000
         SR    R2,R2         FLAG MAIN ENTRY                    GP00126 00420000
         B     BAS&MODULE-&NAME.(,R15)                          GP00126 00430000
.ENTLOOP AIF   (&I GE &K).DONENT                                GP00126 00440000
&I       SETA  &I+1                                             GP00126 00450000
&PBAS    SETC  '&ENTRY(&I)'                                     GP00126 00460000
         AIF   (NOT &FGENTB).NOENB                              GP00126 00470000
         B     COM&MODULE-&PBAS.(,R15)                          GP00126 00480000
&FGENTB  SETB  0                                                GP00126 00490000
.NOENB   AIF   ('&PBAS' EQ '').ENTLOOP                          GP00126 00500000
         ENTRY &PBAS                                            GP00126 00510000
&PBAS    STM   R14,R12,12(R13)                                  GP00126 00520000
         LA    R2,&I                                            GP00126 00530000
&FGENTB  SETB  1                                                GP00126 00540000
         AGO   .ENTLOOP                                         GP00126 00550000
.DONENT  ANOP  ,                                                GP00126 00560000
COM&MODULE BASR R15,0                                           GP00126 00570000
         LA    R0,*-&NAME                                       GP00126 00580000
         SLR   R15,R0                                           GP00126 00590000
BAS&MODULE DS  0H                                               GP00126 00600000
.NOENT   ANOP  ,                                                GP00126 00610000
.*   CODE CHANGED TO ALLOW LIST OF BASE REGISTERS: BASE=(R1,R2...)      00620000
&K       SETA  N'&BASE                                          GP99357 00630000
&FBAS    SETC  '&BASE(1)'                                       GP99357 00640000
         AIF   (&K GE 1).HAVBASE                                GP99357 00650000
&FBAS    SETC  'R12'         SET DEFAULT BASE                   GP99357 00660000
.HAVBASE AIF   (&K LE 1).OLDBASE                                GP99357 00670000
&PBAS    SETC  '&FBAS'                                          GP99357 00680000
&I       SETA  1                                                GP99357 00690000
&CBAS    SETC  '&FBAS'                                          GP99357 00700000
         DROP  R15                                              GP99357 00710000
         LR    &FBAS,R15     LOAD FIRST BASE                    GP99357 00720000
         LA    &BASE(&K),2048  LOAD INCREMENT                   GP99357 00730000
&LBAS    SETC  '&BASE(&K)'                                      GP99357 00740000
.BASLOOP AIF   (&I GE &K).USEBASE                               GP99357 00750000
&I       SETA  &I+1                                             GP99357 00760000
&PBAS    SETC  '&FBAS'                                          GP99357 00770000
&FBAS    SETC  '&BASE(&I)'                                      GP99357 00780000
&CBAS    SETC  '&CBAS'.','.'&FBAS'                              GP99357 00790000
         LA    &FBAS,2048(&LBAS,&PBAS)  SET NEXT BASE           GP99357 00800000
         AGO   .BASLOOP                                         GP99357 00810000
.USEBASE USING &NAME,&CBAS  DECLARE BASES                       GP99357 00820000
         AGO   .COMBASE                                         GP99357 00830000
.OLDBASE AIF   ('&FBAS' EQ '15' OR '&FBAS' EQ 'R15').COMBASE    GP99357 00840000
         DROP  R15                                              GP99357 00850000
         LR    &FBAS,R15               LOAD THE BASE REGISTER   GP99357 00860000
         USING &NAME,&FBAS             TELL THE ASSEMBLER       GP99357 00870000
.COMBASE AIF   ('&REENT' EQ 'N').NOREENT                                00880000
&RENTFLG SETB  1                       SET REENT FOR MODEXIT            00890001
         L     R0,=A(SAVEEND-SAVE)     SAVE AREA AND ANY WORK AREA      00900001
         STORAGE OBTAIN,LENGTH=(0),LOC=&LOC                             00910001
         AGO   .REENT                                                   00920000
         SPACE 1                                                        00930001
.NOREENT ANOP  ,                                                        00940001
&RENTFLG SETB  0                       SET NON REENT FOR MODEXIT        00950001
         LA    R1,SAVE                 A(NON REENT DATA EXPANSION)      00960001
.REENT   ANOP  ,                                                        00970000
         AIF   (T'&CLEAR EQ 'O').UNCLEAR                        GP00117 00980000
         AIF   ('&CLEAR'(1,1) NE 'Y').UNCLEAR                   GP00117 00990000
         AIF ('&BASE(1)' EQ 'R15' OR '&BASE(1)' EQ '15').UNCLEAR  99357 01000000
         AIF ('&BASE(1)' EQ 'R14' OR '&BASE(1)' EQ '14').UNCLEAR  99357 01010000
         AIF ('&BASE(1)' EQ 'R13' OR '&BASE(1)' EQ '13').UNCLEAR  99357 01020000
         AIF ('&BASE(1)' EQ 'R1' OR '&BASE(1)' EQ '1').UNCLEAR  GP99357 01030000
         AIF   ('&REENT' NE 'N').RENTCLR                        GP99357 01040000
         L     R0,=A(SAVEEND-SAVE)     SAVE AREA AND WORK LEN   GP99357 01050001
.RENTCLR LR    R14,R1        SAVE SAVE AREA ADDRESS             GP99357 01060000
         LR    R1,R0         COPY THE LENGTH                    GP99357 01070000
         LR    R0,R14        GET THE ADDRESS BACK               GP99357 01080000
         SR    R15,R15       CLEAR FROM LENGTH                  GP99357 01090000
         MVCL  R0,R14        CLEAR SAVE/WORK AREA               GP99357 01100000
         ST    R13,4(,R14)   STORE FORWARD POINTER              GP99357 01110000
         ST    R14,8(,R13)   STORE BACKWARD POINTER             GP99357 01120000
         LR    R13,R14       A(NEW SAVEAREA)                    GP99357 01130000
         USING SAVE,R13                                         GP99357 01140001
         AIF   (K'&R0 EQ 0 AND K'&R1 EQ 0).CMCLEAR              GP99357 01150000
         L     R14,4(,R13)   RESTORE OLD SAVE AREA FOR RELOAD   GP99357 01160000
         AGO   .CMCLEAR                                         GP99357 01170000
.UNCLEAR LR    R14,R13                 SAVE BACKWARD SAVEAREA POINTER   01180000
         LR    R13,R1                  A(NEW SAVEAREA)                  01190000
         USING SAVE,R13                                                 01200001
         XC    ESPSAVE(ESPSAVEL),ESPSAVE    CLEAR THE NEW SAVE AREA     01210000
         ST    R13,8(,R14)             STORE FORWARD POINTER            01220000
         ST    R14,4(,R13)             STORE BACKWARD POINTER           01230000
.CMCLEAR AIF   (NOT &FGENT).NOEL                                GP00126 01240000
         LR    R15,R2        RETURN ENTRY COUNTER                       01250000
         L     R2,28(,R14)   RESTORE USER'S R2                  GP00126 01260000
.NOEL    AIF   (('&R0' NE '0' AND '&R0' NE 'R0') OR                    *01270000
               ('&R1' NE '1' AND '&R1' NE 'R1')).CMREST         GP99357 01280000
         LM    &R0,&R1,20(R14)         RESTORE R0 AND R1 FROM SAVE      01290000
         AGO   .NOREST1                                         GP99357 01300000
.CMREST  AIF   (K'&R0 EQ 0).NOREST0                                     01310000
         L     &R0,20(,R14)            RESTORE REG 0 FROM SAVEAREA      01320000
.NOREST0 ANOP  ,                                                        01330001
         AIF   (K'&R1 EQ 0).NOREST1                                     01340000
         L     &R1,24(,R14)            RESTORE REG 1 FROM SAVEAREA      01350000
.NOREST1 ANOP  ,                                                        01360001
.*                                                                      01370000
         USING $ESPCVT,R11             $ESPCVT DSECT SETUP              01380000
         USING $TSB,R10                $TSB DSECT SETUP                 01390000
         AIF   (NOT &FGPATCH).MEND                              GP00126 01400000
         B     BEG&MODULE                                       GP00126 01410000
ESPPATCH DC    &PATCH.S(*)                                      GP00126 01420000
BEG&MODULE DS  0H                                               GP00126 01430000
.MEND    MEND  ,                                                GP00126 01440000
./ ADD NAME=ESPIE
         MACRO ,                                                        00010000
&NM      ESPIE &FUN,&OP1,&OP2,&MF=I,&PARAM=IGNORED                      00020000
.*   MVS 3.8 REPLACEMENT FOR ESPIE, TO RUN EXISTING CODE                00030000
.*   UNDER HERCULES                                                     00040000
.*                                                                      00050000
         AIF   ('&MF(1)' EQ 'L').LISTER                                 00060000
         AIF   ('&FUN' EQ 'SET').GOSET                                  00070000
         AIF   ('&FUN' EQ 'RESET').GORES                                00080000
         MNOTE 8,'ESPIE: UNSUPPORTED FUNCTION &FUN'                     00090000
         MEXIT ,                                                        00100000
.GOSET   AIF   (N'&MF GT 1).GOSET2                                      00110000
.* MNOTE 0,'SPIE  &OP1,&OP2,MF=&MF '                                    00120000
&NM      SPIE  &OP1,&OP2,MF=&MF                                         00130000
         MEXIT ,                                                        00140000
.GOSET2  ANOP  ,                                                        00150000
.* MNOTE 0,'SPIE  &OP1,&OP2,MF=(&MF(1),&MF(2)) '     *****DEBUG*****    00160000
&NM      SPIE  &OP1,&OP2,MF=(&MF(1),&MF(2))                             00170000
         MEXIT ,                                                        00180000
.GORES   AIF   ('&OP1' EQ '0').GOCAN                                    00190000
.* MNOTE 0,'SPIE  &MF(2),&OP1,MF=&MF(1) '                               00200000
&NM      SPIE  MF=(E,&OP1)                                              00210000
         MEXIT ,                                                        00220000
.GOCAN   ANOP  ,                                                        00230000
.* MNOTE 0,'SPIE  0,MF=&MF(1) '                                         00240000
&NM      SPIE  0,MF=&MF(1)                                              00250000
         MEXIT ,                                                        00260000
.LISTER  ANOP  ,                                                        00270000
.* MNOTE 0,'SPIE &OP1,&OP2,MF=L '                                       00280000
&NM      SPIE &OP1,&OP2,MF=L                                            00290000
         MEND  ,                                                        00300000
./ ADD NAME=ESPPDS
         MACRO ,             ADDED FOR HERCULES SUPPORT         GP04234 00010000
&NM      ESPPDS &PDSBLDL=,&DSECT=                                       00020000
         GBLB  &MVS,&MVSXA,&MVSESA,&OS390,&Z900                         00030000
&NM      IHAPDS PDSBLDL=&PDSBLDL,DSECT=&DSECT                           00040000
         AIF   (&OS390).MEND                                            00050000
PDS2BIG  EQU   X'40'                                                    00060000
PDS2PGMO EQU   X'04'                                                    00070000
PDS2NMIG EQU   X'80'                                                    00080000
         AIF   (&MVSXA).MEND                                            00090000
PDSMAMOD EQU   X'03'                                                    00100000
PDSLRMOD EQU   X'10'                                                    00110000
.MEND    MEND  ,                                                        00120000
./ ADD NAME=FDBAR
         MACRO                                                          00010000
&NM      FDBAR &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9,&O10,&O11,&O12,&O13,*00020000
               &O14,&O15,&O16,&LEN=50,                                 *00030000
               &CHAR=C'*',&MAX=0                                        00040000
.*--------------------------------------------------------------------* 00050000
.*   FDBAR PRODUCES A BAR (E.G., PERCENTAGE BY MAKING THE LEN= AREA   * 00060000
.*     NON-BLANK FOR THE CALCULATED PERCENTAGE OF &O1 * 100 / MAX=    * 00070000
.*     THE EXPANSION IS THE SAME AS FOR A REGULAR FD, FOLLOWED BY THE * 00080000
.*     PLOT CHARACTER AND THE S(MAX-ADDR)  MAX=0 DEFAULTS TO 100      * 00090000
.*--------------------------------------------------------------------* 00100000
         LCLA  &N,&K                                                    00110000
         LCLB  &I1,&I2,&I3                                              00120000
         LCLC  &C                                                       00130000
&N       SETA  N'&SYSLIST                                               00140000
&K       SETA  1             FIRST IS DIVIDEND, SKIP TEST               00150000
.LOOP    AIF   (&K GE &N).TEST                                          00160000
&K       SETA  &K+1                                                     00170000
&C       SETC  '&SYSLIST(&K)'                                           00180000
&I1      SETB  (('&C' EQ 'I') OR &I1)                                   00190000
&I2      SETB  (('&C' EQ 'D') OR &I2)                                   00200000
&I3      SETB  (('&C' EQ 'F') OR &I3)                                   00210000
         AGO   .LOOP                                                    00220000
.TEST    AIF   ((&I1+&I2+&I3) NE 1).BADTYP                              00230000
         AIF   ('&CHAR' NE '').CHAROK                                   00240000
.BADTYP  MNOTE 'FDBAR: CHAR= MISSING'                                   00250000
         MEXIT ,                                                        00260000
.CHAROK  AIF   ('&MAX' NE '').GOOD                                      00270000
         MNOTE 'FDBAR: MAX= (DIVISOR) MISSING'                          00280000
         MEXIT ,                                                        00290000
.GOOD    ANOP  ,                                                        00300000
&N       SETA  48+&I2+2*&I3                                             00310000
         FD    &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9,&O10,&O11,&O12,&O13,*00320000
               &O14,&O15,&O16,LEN=&LEN,TYPE=&N                          00330000
         DC    SL2(&MAX),AL1(&CHAR,0)                                   00340000
         MEND  ,                                                        00350000
./ ADD NAME=FDBR
         MACRO                                                          00010000
&NM      FDBR  &STR,&BE=0,&BL=0,&BH=0,&BNE=0,&BM=0,&BO=0,&BZ=0   81133  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLB  &NOP                                              81133  00050000
         LCLC  &FDCHN,&FL,&FH,&FZ                                81133  00060000
&FDCNTR  SETA  &FDCNTR+1                                                00070000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00080000
&C       SETA  &FDCNTR+1                                                00090000
         AIF   ('&NM' EQ '').NONAME                                     00100000
&NM      EQU   *                                                        00110000
.NONAME  AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00120000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00130000
         MEXIT ,                                                        00140000
.PROCESS AIF   ('&STR' NE 'NOP').PROCNOP                         81133  00150000
&NOP     SETB  1                                                 81133  00160000
.PROCNOP ANOP  ,                                                 81133  00170000
&FZ      SETC  '&BE'                                             81133  00180000
         AIF   ('&BZ' EQ '0').SETZ                               81133  00190000
&FZ      SETC  '&BZ'                                             81133  00200000
         AIF   ('&BE' EQ '0').SETZ                               81133  00210000
         MNOTE 8,'*** MUTUALLY EXCLUSIVE BZ AND BE'              81133  00220000
.SETZ    ANOP  ,                                                 81133  00230000
&FL      SETC  '&BL'                                                    00240000
         AIF   ('&BM' EQ '0').SETL                                      00250000
&FL      SETC  '&BM'                                                    00260000
         AIF   ('&BL' EQ '0').SETL                                      00270000
         MNOTE 8,'*** MUTUALLY EXCLUSIVE BL AND BM'                     00280000
.SETL    ANOP  ,                                                        00290000
&FH      SETC  '&BH'                                                    00300000
         AIF   ('&BO' EQ '0').SETH                                      00310000
&FH      SETC  '&BO'                                                    00320000
         AIF   ('&BH' EQ '0').SETH                                      00330000
         MNOTE 8,'*** MUTUALLY EXCLUSIVE BH AND BO'                     00340000
.SETH    AIF   ('&BNE' EQ '0').CHECK                                    00350000
         AIF   ('&FL' NE '0' OR '&FH' NE '0').BHEX               81133  00360000
&FL      SETC  '&BNE'                                                   00370000
&FH      SETC  '&BNE'                                                   00380000
.BHEX    MNOTE 8,'*** MUTUALLY EXCLUSIVE BNE AND BL/BH OR BM/BO' 81133  00390000
.CHECK   ANOP  ,                                                        00400000
&T       SETA  64*&NOP+18                                               00410000
&FDCHN DC AL1(ZFD&C-*,&T),SL2(&FZ,&FL,&FH)                       81133  00420000
         MEND  ,                                                        00430000
./ ADD NAME=FDBUMP
         MACRO                                                          00010000
&NM      FDBUMP &O,&TYPE=H                             ADDED ON 2007006 00020000
         GBLA  &FDCNTR                                                  00030000
.********************************************************************** 00040000
.*   THIS MACRO CAUSES REGISTERS IN AN FD LIST TO BE INCREMENTED      * 00050000
.*   SEE LABEL MAKELLUP IN EXHASCRN OR @FORMATS FOR DETAILS           * 00060000
.*   X'80' IS END OF OPERAND LIST BIT   X'7x' IS RESET ALL            * 00070000
.*   X'0r' ONE BYTE POSITIVE INCREMENT  X'1r' HALF-WORD INCREMENT     * 00080000
.*   X'3r' FULLWORD INCREMENT                                         * 00090000
.********************************************************************** 00100000
         LCLA  &C,&I,&J,&K,&L,&LD,&N,&T,&SA(17)                         00110000
         LCLC  &O1,&O2,&O3,&RA(17),&VA(17),&FDCHN                       00120000
&FDCNTR  SETA  &FDCNTR+1                                                00130000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00140000
&C       SETA  &FDCNTR+1                                                00150000
&N       SETA  N'&SYSLIST                                               00160000
&T       SETA  16+9                                                     00170000
&LD      SETA  2             DEFAULT INCREMENT LENGTH                   00180000
         AIF   ('&TYPE' EQ 'H' OR '&TYPE' EQ ' ').HAVELD                00190000
&LD      SETA  1             DEFAULT INCREMENT LENGTH                   00200000
         AIF   ('&TYPE' EQ 'X' OR '&TYPE' EQ 'B').HAVELD                00210000
&LD      SETA  4             DEFAULT INCREMENT LENGTH                   00220000
         AIF   ('&TYPE' EQ 'F' OR '&TYPE' EQ 'H').HAVELD                00230000
&LD      SETA  2             DEFAULT INCREMENT LENGTH                   00240000
.HAVELD  AIF   ('&NM' EQ '').NONAME                                     00250000
&NM      EQU   *                                                        00260000
.NONAME  AIF   ('&N' NE 'END' AND '&N' NE '*END').PROCESS               00270000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00280000
         MEXIT ,                                                        00290000
.PROCESS AIF   (&N GE 1 AND &N LE 17).DECODE                            00300000
 MNOTE 8,'FDBUMP: INCORRECT NUMBER OF OPERANDS'                         00310000
         MEXIT ,                                                        00320000
.DECODE  AIF   (&I GE &N).EXPAND                                        00330000
&I       SETA  &I+1                                                     00340000
         AIF   ('&SYSLIST(&I)' NE 'RESET').VALUE                        00350000
&J       SETA  &J+1          COUNT ACCEPTED OPERANDS                    00360000
&RA(&J)  SETC  '15'                                                     00370000
&SA(&J)  SETA  6                                                        00380000
         AGO   .DECODE                                                  00390000
.VALUE   AIF   (N'&SYSLIST(&I) EQ 2).SPLITT2                            00400000
         AIF   (N'&SYSLIST(&I) EQ 3).SPLITT3                            00410000
 MNOTE 8,'FDBUMP: INCORRECT NUMBER OF ARGUMENTS IN OPERAND &I'          00420000
         AGO   .DECODE                                                  00430000
.SPLITT2 ANOP  ,                                                        00440000
&L       SETA  &LD           SET DEFAULT LENGTH                         00450000
         AGO   .SPLITTR                                                 00460000
.SPLITT3 AIF   ('&SYSLIST(&I,3)' EQ '1' OR '&SYSLIST(&I,3)' EQ '2'     *00470000
               OR '&SYSLIST(&I,3)' EQ '4').SPLITL3                      00480000
         MNOTE 'FDBUMP: LENGTH IN OPERAND &I NOT 1, 2, OR 4'            00490000
&L       SETA  4             SHOULD BE VALID ?                          00500000
         AGO   .SPLITTR                                                 00510000
.SPLITL3 ANOP  ,                                                        00520000
&L       SETA  &SYSLIST(&I,3)  OVERRIDE LENGTH                          00530000
.SPLITTR ANOP  ,                                                        00540000
&O1      SETC  '&SYSLIST(&I,1)'                                         00550000
&O2      SETC  '&SYSLIST(&I,2)'                                         00560000
         AIF   ('&O1&O2' NE '').STASH                                   00570000
         MNOTE 8,'FDBUMP: OMITTED ARGUMENT IN OPERAND &I'               00580000
         AGO   .DECODE                                                  00590000
.STASH   ANOP  ,                                                        00600000
&J       SETA  &J+1          COUNT ACCEPTED OPERANDS                    00610000
&RA(&J)  SETC  '&O1'         PRESUMED REGISTER NUMBER                   00620000
&SA(&J)  SETA  &L-1          CONTROL FUNCTION                           00630000
&VA(&J)  SETC  '&O2'         INCREMENT                                  00640000
         AGO   .DECODE       DO ANOTHER                                 00650000
.EXPAND  AIF   (&J GT 0).EXPANDS                                        00660000
         MNOTE 8,'FDBUMP: NO VALID ARGUMENTS FOUND'                     00670000
         MEXIT ,                                                        00680000
.EXPANDS ANOP  ,                                                        00690000
&FDCHN   DC    AL1(ZFD&C-*,&T)  IDENTIFY AS FDBUMP                      00700000
&I       SETA  0                                                        00710000
.EXPANDL AIF   (&I GE &J).MEND                                          00720000
&I       SETA  &I+1                                                     00730000
&L       SETA  128*(&I/&J)   END LIST BIT                               00740000
         AIF   (&SA(&I) EQ 6).RESET                                     00750000
         DC    AL1(&L+16*&SA(&I)+&RA(&I)),AL(&SA(&I)+1)(&VA(&I))        00760000
         AGO   .EXPANDL                                                 00770000
.RESET   DC    AL1(&L+127)   RESET ALL REGISTERS                        00780000
         AGO   .EXPANDL                                                 00790000
.MEND    MEND  ,                                                        00800000
./ ADD NAME=FDCLC
         MACRO                                                          00010000
&NM      FDCLC &STR,&STR2,&LEN,&BE=0,&BL=0,&BH=0,&BNE=0                 00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLB  &NOP                                              81133  00050000
         LCLC  &FDCHN,&FL,&FH,&L                                        00060000
&FDCNTR  SETA  &FDCNTR+1                                                00070000
&FDCHN SETC  'ZFD'.'&FDCNTR'                                            00080000
&C       SETA  &FDCNTR+1                                                00090000
         AIF   ('&NM' EQ '').NONAME                                     00100000
&NM      EQU   *                                                        00110000
.NONAME  AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00120000
&FDCHN DC    AL1(0)        END OF FD LIST                               00130000
         MEXIT ,                                                        00140000
.PROCESS ANOP  ,                                                        00150000
&FL      SETC  '&BL'                                                    00160000
&FH      SETC  '&BH'                                                    00170000
         AIF   ('&BNE' EQ '0').CHECK                                    00180000
&FL      SETC  '&BNE'                                                   00190000
&FH      SETC  '&BNE'                                                   00200000
         AIF   ('&BL' EQ '0' AND '&BH' EQ '0').CHECK                    00210000
         MNOTE 8,'*** MUTUALLY EXCLUSIVE BNE AND BL/BH'                 00220000
.CHECK   ANOP  ,                                                        00230000
&T       SETA  64*&NOP+21                                               00240000
         AIF   (T'&LEN EQ 'O').NOL                                      00250000
&FDCHN DC AL1(ZFD&C-*,&T),SL2(&BE,&FL,&FH,&STR),AL1(&LEN),SL2(&STR2)    00260000
         MEXIT ,                                                        00270000
.NOL     ANOP                                                           00280000
&L       SETC  'L'''                                                    00290000
&FDCHN DC AL1(ZFD&C-*,&T),SL2(&BE,&FL,&FH,&STR),AL1(&L&STR),SL2(&STR2)  00300000
         MEND  ,                                                        00310000
./ ADD NAME=FDCLI
         MACRO                                                          00010000
&NM      FDCLI &STR,&MASK,&BE=0,&BL=0,&BH=0,&BNE=0                      00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLB  &NOP                                              81133  00050000
         LCLC  &FDCHAIN,&FL,&FH                                         00060000
&FDCNTR  SETA  &FDCNTR+1                                                00070000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                          00080000
&C       SETA  &FDCNTR+1                                                00090000
         AIF   ('&NM' EQ '').NONAME                                     00100000
&NM      EQU   *                                                        00110000
.NONAME  AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00120000
&FDCHAIN DC    AL1(0)        END OF FD LIST                             00130000
         MEXIT ,                                                        00140000
.PROCESS ANOP  ,                                                        00150000
&FL      SETC  '&BL'                                                    00160000
&FH      SETC  '&BH'                                                    00170000
         AIF   ('&BNE' EQ '0').CHECK                                    00180000
&FL      SETC  '&BNE'                                                   00190000
&FH      SETC  '&BNE'                                                   00200000
         AIF   ('&BL' EQ '0' AND '&BH' EQ '0').CHECK                    00210000
         MNOTE 8,'*** MUTUALLY EXCLUSIVE BNE AND BL/BH'                 00220000
.CHECK   ANOP  ,                                                        00230000
&T       SETA  64*&NOP+20                                               00240000
&FDCHAIN DC AL1(ZFD&C-*,&T),SL2(&BE,&FL,&FH,&STR),AL1(&MASK)            00250000
         MEND  ,                                                        00260000
./ ADD NAME=FDDUMP
         MACRO ,                                                        00010000
&NM      FDDUMP &ADR,&LEN,&OPT1,&OPT2,&OPT3           ADDED ON GP13228  00020000
.*                                                                      00030000
.*   FDDUMP is a macro that invokes FDSNAP to produce the most          00040000
.*   frequently used form of dump (two hex columns + text)              00050000
.*                                                                      00060000
&NM      FDSNAP &ADR,64,DUAL,NOABS,OFFSET,&OPT1,&OPT2,&OPT3,           *00070000
               BASE=&ADR,LEN=&LEN                                       00080000
         MEND  ,                                                        00090000
./ ADD NAME=FDEXEC
         MACRO                                                          00010000
&NM      FDEXEC &S,&N                                                   00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS ANOP  ,                                                        00140000
&T       SETA  17                                                       00150000
         AIF   ('&N' NE '').TWO                                         00160000
&FDCHN   DC    AL1(ZFD&C-*,&T),2SL2(&S)                                 00170000
         AGO   .MEND                                                    00180000
.TWO     ANOP  ,                                                        00190000
&FDCHN   DC    AL1(ZFD&C-*,&T),SL2(&S,&N)                               00200000
.MEND    MEND  ,                                                        00210000
./ ADD NAME=FDFD
         MACRO ,                                                 92087  00010000
&NM      FDFD  &FIELD,&TYPE=HEX,&LEN=0,&OPT=,&OPTS=,&OPTL=,&ROOM=5+2+8,*00020000
               &PFX=,&SYS=,&COLL=TURQ,&COLD=GREEN               GP01017 00030000
         GBLA  &FDFDPFX                                          92087  00040000
         GBLB  &MVS,&MVSSP,&MVSXA,&MVSESA,&OS390,&Z900          GP04234 00050000
         GBLC  &MACPLAB                                                 00060000
         LCLA  &PF,&I,&N                                        GP00017 00070000
         LCLC  &FN,&GN                                           92087  00080000
&MACPLAB SETC  '&NM'         PRESERVE NAME FIELD                GP04234 00090000
&N       SETA  N'&SYS        SYSTEM SELECTION                   GP04234 00100000
         AIF   ('&PFX' EQ '').NOFXOV                             92087  00110000
&FDFDPFX SETA  &PFX+1                                            92087  00120000
.NOFXOV  AIF   (&FDFDPFX GT 0).DOPFX                             92087  00130000
&FDFDPFX SETA  3+1           SET FOR TYPICAL CONTROL BLOCK       92087  00140000
.DOPFX   AIF   (&N LT 1).SELECT                                 GP04234 00150000
.SYSLOOP AIF   (&I GE &N).SKIP                                  GP04234 00160000
&I       SETA  &I+1                                             GP04234 00170000
&GN      SETC  '&SYS(&I)'                                       GP04234 00180000
         AIF   ('&GN' EQ '').SYSLOOP                            GP04234 00190000
         AIF   ('&GN' EQ 'Z900' AND &Z900).SELECT               GP04234 00200000
         AIF   ('&GN' EQ 'ESA' AND &MVSESA).SELECT              GP04234 00210000
         AIF   ('&GN' EQ 'XA' AND &MVSXA).SELECT                GP04234 00220000
         AIF   ('&GN' EQ 'SP' AND &MVSSP).SELECT                GP04234 00230000
         AIF   ('&GN' EQ 'MVS' AND &MVS).SELECT                 GP04234 00240000
         AGO   .SYSLOOP                                         GP04234 00250000
.SKIP    MACPARM MODE=LBL                                       GP04234 00260000
         MEXIT ,                                                GP04234 00270000
.SELECT  ANOP  ,                                                 92087  00280000
&PF      SETA  &FDFDPFX-1                                       GP00017 00290000
&GN      SETC  '&FIELD'.'        '                               92087  00300000
&FN      SETC  '&GN'(1+&PF,8-&PF)                               GP00017 00310000
&NM      FDROOM &ROOM        MAKE IT FIT ON ONE LINE             92087  00320000
         FD    ' &FN',DEBR,PAD,&COLL,&OPTL                      GP01017 00330000
         FD    &FIELD,&OPT,&TYPE,&OPTS,&COLD,LEN=&LEN           GP01017 00340000
         MEND  ,                                                 92087  00350000
./ ADD NAME=FDFLAG
         MACRO                                                          00010000
&NM      FDFLAG &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9,&O10,&O11,&O12,&O13*00020001
               ,&O14,&O15,&O16,&LEN=0,                                 *00030005
               &TABLE='?',&SEP=C',',&SPACE=0                            00040001
.*--------------------------------------------------------------------* 00050000
.*   FDFLAG REQUESTS TABLE LOOKUP. THE TABLE IS DEFINED WITH MACRO    * 00060000
.*     FLGTAB (FLAG BITS,TEXT,MLEN=L'FLAG)                            * 00070000
.*     THE EXPANSION IS THE SAME AS FOR A REGULAR FD, FOLLOWED BY THE * 00080001
.*     TABLE ADDRESS AND THE ATTRIBUTES:                              * 00090001
.*   OPERANDS ARE: S(TABLE ADDRESS) AL1(SEP CHAR OR 0) AL1(ADDL SPC)  * 00100002
.*--------------------------------------------------------------------* 00110000
&NM      FD    &O1,&O2,&O3,&O4,&O5,&O6,&O7,&O8,&O9,&O10,&O11,&O12,&O13,*00120001
               &O14,&O15,&O16,LEN=&LEN,TYPE=64                          00130005
         AIF   ('&O1' EQ 'END' OR '&O1' EQ '*END').MEND                 00140003
         AIF   ('&SEP' EQ 'NO' OR '&SEP' EQ 'NONE').NONO                00150003
         DC    SL2(&TABLE),AL1(&SEP,&SPACE)                             00160004
         AGO   .MEND                                                    00170003
.NONO    DC    SL2(&TABLE),AL1(0,&SPACE)                                00180004
.MEND    MEND  ,                                                        00190001
./ ADD NAME=FDGOTO
         MACRO                                                          00010000
&NM      FDGOTO &S                                                      00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS ANOP  ,                                                        00140000
&T       SETA  16                                                       00150000
&FDCHN   DC    AL1(ZFD&C-*,&T),SL2(&S)                                  00160000
         MEND  ,                                                        00170000
./ ADD NAME=FDINP
         MACRO                                                          00010000
&NM      FDINP &S,&EXLEN,&VALUES,&LEN=0,&MAX=,&EXIT=             89095  00020000
         GBLA  &FDCNTR,&FDOFFS                                   84146  00030000
         LCLA  &C,&I,&J,&K,&N,&U                                 84146  00040000
         LCLA  &T,&E,&O7,&O9,&DATA,&EXFG                         89095  00050000
         LCLC  &L,&FDCHAIN,&W,&UEX                               89095  00060000
         LCLB  &NOP,&IN,&SKPLEN,&INDAD                           81270  00070000
         LCLB  &NL,&DEBL,&DEBR,&DEBZ,&PADL,&PADR,&RADJ,&UP              00080000
         LCLB  &BLUE,&GREEN,&PINK,&RED,&TURQ,&WHITE,&YELLOW,&C1,&C2,&C3 00090000
         LCLB  &UNDER,&BLINK,&REVERSE,&MONO,&MDT                 87313  00100000
         LCLB  &INTENSE,&DETECT,&NONDISP,&NUMERIC,&SKIP,&PROTECT,&NULL  00110000
         LCLB  &DEFAULT,&PREV                                           00120000
&U       SETA  &FDOFFS                                           84146  00130000
&UEX     SETC  'AL2('.'&U'.')'                                   89095  00140000
&FDCNTR  SETA  &FDCNTR+1                                                00150000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                          00160000
&C       SETA  &FDCNTR+1                                                00170000
         AIF   ('&S' EQ '*END' OR '&S' EQ 'END').NOOFF  END OF CHAIN    00180000
         AIF   ('&S' NE '*EXPAND').NOEXPND                       84214  00190000
         AIF   ('&NM' EQ '').NOXNAM                              84214  00200000
&NM      DC    (&FDOFFS)X'00'                                    84214  00210000
         AGO   .NOXCOM                                           84214  00220000
.NOXNAM  AIF   (&FDOFFS LT 1).NOXCOM                             84214  00230000
         DC    (&FDOFFS)X'00'                                    84214  00240000
.NOXCOM  AIF   ('&SYSLIST(2)' EQ 'NORESET').MEND                 84214  00250000
&FDOFFS  SETA  0                                                 84214  00260000
         AGO   .MEND                                             84214  00270000
.NOEXPND AIF   (T'&EXIT EQ 'O').NOUEX                            89095  00280000
         AIF   (N'&EXIT GE 2).CKUEXR                            GP07008 00290000
&UEX     SETC  '&UEX'.',SL2('.'&EXIT'.')'                        89095  00300000
&EXFG    SETA  1                                                 89095  00310000
         AGO   .NOUEX                                           GP07008 00320000
.CKUEXR  AIF   ('&EXIT(1)' NE 'R').BADUEX                       GP07008 00330000
&UEX     SETC  '&UEX'.',SL2('.'&EXIT(2)'.'-*)'                  GP07008 00340000
&EXFG    SETA  1                                                 89095  00350000
         AGO   .NOUEX                                           GP07008 00360000
.BADUEX  MNOTE 8,'FDIN: EXIT= ADDRESS MALFORMED'                GP07008 00370000
.NOUEX   AIF   (T'&MAX EQ 'O').NOMAXQ                            89095  00380000
         AIF   (T'&MAX EQ 'N').CKMAX                             89095  00390000
         MNOTE 4,'NON-NUMERIC MAX= NOT SUPPORTED'                89095  00400000
         AGO   .NOMAXQ                                           89095  00410000
.CKMAX   AIF   (&MAX LT 0).NOMAXQ                                89095  00420000
&I       SETA  &MAX                                              84146  00430000
         AGO   .HAVMAX                                           84146  00440000
.NOMAXQ  AIF   (T'&LEN NE 'N' OR '&LEN' EQ '0').NOLENQ           84146  00450000
         AIF   (&LEN LE 0).NOLENQ                                84146  00460000
&I       SETA  &LEN                                              84146  00470000
         AGO   .HAVMAX                                           84146  00480000
.NOLENQ  MNOTE 0,'LEN=/MAX= MISSING - WIDTH DEFAULTED TO 255'    84146  00490000
&I       SETA  255                                               84146  00500000
.HAVMAX  ANOP  ,                                                 84146  00510000
&FDOFFS  SETA  &FDOFFS+4+&I  SET OFFSET OF NEXT ENTRY            84146  00520000
         AIF   (K'&SYSLIST(0) LT 1 OR K'&SYSLIST(0) GT 4).NOOFF  84146  00530000
OFFS&SYSLIST(0) EQU &U,&I                                        84214  00540000
.NOOFF   AIF   ('&NM' EQ '').NONAME                              84146  00550000
&NM      EQU   *                                                        00560000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS        84146  00570000
&FDCHAIN DC    AL1(0)        END OF FD LIST                             00580000
         MEXIT ,                                                        00590000
.PROCESS ANOP  ,                                                        00600000
&I       SETA  N'&SYSLIST                                               00610000
&J       SETA  1                                                        00620000
         AIF   ('&S'(1,1) NE '''').NOLIT                         84146  00630000
&SKPLEN  SETB  1                                                        00640000
.NOLIT   AIF   (&J GE &I).CHECK                                         00650000
&J       SETA  &J+1                                                     00660000
&L       SETC  '&SYSLIST(&J)'                                           00670000
         AIF   ('&L' EQ '').NOLIT                                       00680000
&NOP     SETB  (&NOP  OR '&L' EQ 'NOP')                                 00690000
&NL      SETB  (&NL  OR '&L' EQ 'NL' OR '&L' EQ 'NEWLINE')              00700000
&DEBL SETB (&DEBL OR '&L' EQ 'DEBL' OR '&L' EQ 'DEB' OR '&L' EQ 'DEBZ') 00710000
&DEBR    SETB  (&DEBR OR '&L' EQ 'DEBR' OR '&L' EQ 'DEB')               00720000
&DEBZ    SETB  (&DEBZ OR '&L' EQ 'DEBZ')                                00730000
&PADL    SETB  (&PADL OR '&L' EQ 'PADL' OR '&L' EQ 'PAD')               00740000
&PADR    SETB  (&PADR OR '&L' EQ 'PADR' OR '&L' EQ 'PAD')               00750000
&RADJ    SETB  (&RADJ OR '&L' EQ 'RADJ')                                00760000
&UP      SETB  (&UP OR '&L' EQ 'UP')                                    00770000
&UP      SETB  (&UP OR '&L' EQ 'UPPER')                                 00780000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BLUE')                                00790000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GREEN')                              00800000
&PINK    SETB  (&PINK OR '&L' EQ 'PINK')                                00810000
&RED     SETB  (&RED  OR '&L' EQ 'RED')                                 00820000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TURQ' OR '&L' EQ 'CYAN')      90326  00830000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WHITE')                              00840000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YELLOW')                            00850000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BL')                          GP10240 00860000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GR')                         GP10240 00870000
&PINK    SETB  (&PINK OR '&L' EQ 'PI')                          GP10240 00880000
&RED     SETB  (&RED  OR '&L' EQ 'RE')                          GP10240 00890000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TU' OR '&L' EQ 'CY')         GP10240 00900000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WH')                         GP10240 00910000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YE')                        GP10240 00920000
&MONO    SETB  (&MONO OR '&L' EQ 'MONO')                         87313  00930000
&UNDER   SETB  (&UNDER OR '&L' EQ 'UL' OR '&L' EQ 'UNDER')              00940000
&BLINK   SETB  (&BLINK OR '&L' EQ 'BLINK')                              00950000
&REVERSE SETB  (&REVERSE OR '&L' EQ 'REVERSE')                          00960000
&INTENSE SETB  (&INTENSE OR '&L' EQ 'INTENSE' OR '&L' EQ 'INT')         00970000
&DETECT  SETB  (&DETECT OR '&L' EQ 'DETECT' OR '&L' EQ 'LP')            00980000
&NONDISP SETB  (&NONDISP OR '&L' EQ 'NONDISP' OR '&L' EQ 'NDISP')       00990000
&NUMERIC SETB  (&NUMERIC OR '&L' EQ 'NUMERIC' OR '&L' EQ 'NUM')         01000000
&SKIP    SETB  (&SKIP OR '&L' EQ 'SKIP')                                01010000
&PROTECT SETB  (&PROTECT OR '&L' EQ 'PROTECT')                          01020000
&MDT     SETB  (&MDT OR '&L' EQ 'MDT')                           87313  01030000
&NULL    SETB  (&NULL OR '&L' EQ 'NULL')                         84146  01040000
&DEFAULT SETB  (&DEFAULT OR '&L' EQ 'DEFAULT' OR '&L' EQ 'DFLT')        01050000
&PREV    SETB  (&PREV OR '&L' EQ 'PREVIOUS' OR '&L' EQ 'PREV')          01060000
&INDAD   SETB  (&INDAD OR '&L' EQ '*')                           81270  01070000
         AIF   (&DATA NE 0).NOLIT                                       01080000
         AIF   (K'&L GT 4).OMLEN                                        01090000
&K       SETA  0                                                        01100000
&L       SETC  '&L'.'    '                                              01110000
&L       SETC  '&L'(1,4)                                                01120000
         AIF   ('&L' NE 'X   ').DT                              GP10240 01130000
&L       SETC  'HEX '                                           GP10240 01140000
.DT      AIF   (&K GE 35).OMLEN                                 GP07004 01150000
&K       SETA  &K+1                                                     01160000
&N       SETA  (&K-1)*4+1                                               01170000
&W      SETC  'CHARCON ASISADDRHEX SHEXBIT I   $I  D   $D  F   TIMETIMD*01180000
               DATEDATJWDAYMTH DAY MD  DMY MDY CHEXICM ICN IZ  IA  DCM *01190000
               DCN DZ  DA  EDATDATDCCHHTTR '(&N,4)              GP07004 01200000
         AIF   ('&L' NE '&W').DT                                        01210000
&DATA    SETA  &K                                                       01220000
         AIF   (&J EQ 2).OMSET                                          01230000
         AGO   .NOLIT                                                   01240000
.OMLEN   AIF   (&J NE 2 OR &SKPLEN).NOLIT                               01250000
 AIF (&NOP OR &IN OR &NL OR &DEBL OR &DEBR OR &DEBZ OR &PADL).OMSET     01260000
 AIF (&UP OR &PADR OR &RADJ OR &BLUE OR &GREEN OR &PINK OR &RED).OMSET  01270000
 AIF (&TURQ OR &WHITE OR &YELLOW OR &UNDER OR &BLINK OR &NULL).OMSET    01280000
 AIF (&REVERSE OR &INTENSE OR &DETECT OR &NONDISP OR &INDAD).OMSET      01290000
 AIF (&NUMERIC OR &SKIP OR &PROTECT OR &DEFAULT OR &PREV).OMSET         01300000
         AIF   (&MDT OR &MONO).OMSET                             87313  01310000
         AGO   .NOLIT                                                   01320000
.OMSET   ANOP  ,             EXPLICIT LENGTH OMITTED                    01330000
&SKPLEN  SETB  1             USE L'                                     01340000
         AGO   .NOLIT                                                   01350000
.CHECK   ANOP  ,                                                        01360000
&L       SETC  'L'''                                                    01370000
&IN      SETB  1                                                 84146  01380000
&T       SETA  128*&IN+64*&NOP+4*&EXFG+&INDAD+8                  89107  01390000
&E SETA 128*&NL+64*&DEBL+32*&DEBR+16*&DEBZ+8*&PADL+4*&PADR+2*&RADJ+&UP  01400000
&O7      SETA  128*&DEFAULT+64*&PREV+&MDT                        87313  01410000
&PROTECT SETB  (&PROTECT OR &SKIP)                                      01420000
&NUMERIC SETB  (&NUMERIC OR &SKIP)                                      01430000
&DETECT  SETB  (&DETECT  OR &NONDISP)                                   01440000
&INTENSE SETB  (&INTENSE OR &NONDISP)                                   01450000
&O7      SETA  &O7+32*&PROTECT+16*&NUMERIC+8*&INTENSE+4*&DETECT+2*&NULL 01460000
&C1      SETB  (&GREEN OR &TURQ OR &WHITE OR &YELLOW)                   01470000
&C2      SETB  (&RED OR &PINK OR &WHITE OR &YELLOW)                     01480000
&C3      SETB  (&BLUE OR &PINK OR &TURQ OR &WHITE)                      01490000
&O9      SETA  64*&C1+32*&C2+16*&C3+8*&MONO+4*&UNDER+2*&REVERSE+&BLINK  01500000
         AIF   ((&O7 NE 0 AND &O7 NE 128) OR &O9 NE 0).LONG      86244  01510000
&T       SETA  &T+48         USE FDPRT SHORT FORM                86244  01520000
         AIF   ('&S'(1,1) EQ '''').CSTRPRT                       86244  01530000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).EXLPRT           86244  01540000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&L&S),SL2(&S),&UEX      89095  01550000
         MEXIT ,                                                 86244  01560000
.EXLPRT  AIF   (K'&EXLEN LT 2).NORLPRT                           86244  01570000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NORLPRT   01580000
&T       SETA  &T+2          ILEN IS REGISTER FORM               86244  01590000
.NORLPRT ANOP  ,                                                 86244  01600000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&EXLEN),SL2(&S),&UEX    89095  01610000
         MEXIT ,                                                 86244  01620000
.CSTRPRT ANOP  ,                                                 86244  01630000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,1,&LEN,&L.ZFD&C.C),SL2(ZFD&C.C),&UEX      01640000
ZFD&C.C  DC    C&S                                               89095  01650000
         MEXIT ,                                                 86244  01660000
.LONG    AIF   ('&S'(1,1) EQ '''').CSTRING                       86244  01670000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).EXLEN                   01680000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,&DATA,&LEN,&L&S),SL2(&S),&UEX     01690000
         MEXIT                                                          01700000
.EXLEN   AIF   (K'&EXLEN LT 2).NORLEN                            81270  01710000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NORLEN    01720000
&T       SETA  &T+2          ILEN IS REGISTER FORM               81270  01730000
.NORLEN  ANOP  ,                                                 81270  01740000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,&DATA,&LEN,&EXLEN),SL2(&S),&UEX   01750000
         MEXIT ,                                                        01760000
.CSTRING ANOP  ,                                                        01770000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,1,&LEN,&L.ZFD&C.C),SL2(ZFD&C.C),&*01780000
               UEX                                               89095  01790000
ZFD&C.C  DC    C&S                                               89095  01800000
.MEND    MEND  ,                                                 84214  01810000
./ ADD NAME=FDIN
         MACRO                                                          00010000
&NM      FDIN  &S,&EXLEN,&VALUES,&LEN=0,&MAX=,&EXIT=             89095  00020000
         GBLA  &FDCNTR,&FDOFFS                                   84146  00030000
         LCLA  &C,&I,&J,&K,&N,&U                                 84146  00040000
         LCLA  &T,&E,&O7,&O9,&DATA,&EXFG                         89095  00050000
         LCLC  &L,&FDCHAIN,&W,&UEX                               89095  00060000
         LCLB  &NOP,&IN,&SKPLEN,&INDAD                           81270  00070000
         LCLB  &NL,&DEBL,&DEBR,&DEBZ,&PADL,&PADR,&RADJ,&UP              00080000
         LCLB  &BLUE,&GREEN,&PINK,&RED,&TURQ,&WHITE,&YELLOW,&C1,&C2,&C3 00090000
         LCLB  &UNDER,&BLINK,&REVERSE,&MONO,&MDT                 87313  00100000
         LCLB  &INTENSE,&DETECT,&NONDISP,&NUMERIC,&SKIP,&PROTECT,&NULL  00110000
         LCLB  &DEFAULT,&PREV                                           00120000
&U       SETA  &FDOFFS                                           84146  00130000
&UEX     SETC  'AL2('.'&U'.')'                                   89095  00140000
&FDCNTR  SETA  &FDCNTR+1                                                00150000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                          00160000
&C       SETA  &FDCNTR+1                                                00170000
         AIF   ('&S' EQ '*END' OR '&S' EQ 'END').NOOFF  END OF CHAIN    00180000
         AIF   ('&S' NE '*EXPAND').NOEXPND                       84214  00190000
         AIF   ('&NM' EQ '').NOXNAM                              84214  00200000
&NM      DC    (&FDOFFS)X'00'                                    84214  00210000
         AGO   .NOXCOM                                           84214  00220000
.NOXNAM  AIF   (&FDOFFS LT 1).NOXCOM                             84214  00230000
         DC    (&FDOFFS)X'00'                                    84214  00240000
.NOXCOM  AIF   ('&SYSLIST(2)' EQ 'NORESET').MEND                 84214  00250000
&FDOFFS  SETA  0                                                 84214  00260000
         AGO   .MEND                                             84214  00270000
.NOEXPND AIF   (T'&EXIT EQ 'O').NOUEX                            89095  00280000
         AIF   (N'&EXIT GE 2).CKUEXR                            GP07008 00290000
&UEX     SETC  '&UEX'.',SL2('.'&EXIT'.')'                        89095  00300000
&EXFG    SETA  1                                                 89095  00310000
         AGO   .NOUEX                                           GP07008 00320000
.CKUEXR  AIF   ('&EXIT(1)' NE 'R').BADUEX                       GP07008 00330000
&UEX     SETC  '&UEX'.',SL2('.'&EXIT(2)'.'-*)'                  GP07008 00340000
&EXFG    SETA  1                                                 89095  00350000
         AGO   .NOUEX                                           GP07008 00360000
.BADUEX  MNOTE 8,'FDIN: EXIT= ADDRESS MALFORMED'                GP07008 00370000
.NOUEX   AIF   (T'&MAX EQ 'O').NOMAXQ                            89095  00380000
         AIF   (T'&MAX EQ 'N').CKMAX                             89095  00390000
         MNOTE 4,'NON-NUMERIC MAX= NOT SUPPORTED'                89095  00400000
         AGO   .NOMAXQ                                           89095  00410000
.CKMAX   AIF   (&MAX LT 0).NOMAXQ                                89095  00420000
&I       SETA  &MAX                                              84146  00430000
         AGO   .HAVMAX                                           84146  00440000
.NOMAXQ  AIF   (T'&LEN NE 'N' OR '&LEN' EQ '0').NOLENQ           84146  00450000
         AIF   (&LEN LE 0).NOLENQ                                84146  00460000
&I       SETA  &LEN                                              84146  00470000
         AGO   .HAVMAX                                           84146  00480000
.NOLENQ  MNOTE 0,'LEN=/MAX= MISSING - WIDTH DEFAULTED TO 255'    84146  00490000
&I       SETA  255                                               84146  00500000
.HAVMAX  ANOP  ,                                                 84146  00510000
&FDOFFS  SETA  &FDOFFS+4+&I  SET OFFSET OF NEXT ENTRY            84146  00520000
         AIF   (K'&SYSLIST(0) LT 1 OR K'&SYSLIST(0) GT 4).NOOFF  84146  00530000
OFFS&SYSLIST(0) EQU &U,&I                                        84214  00540000
.NOOFF   AIF   ('&NM' EQ '').NONAME                              84146  00550000
&NM      EQU   *                                                        00560000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS        84146  00570000
&FDCHAIN DC    AL1(0)        END OF FD LIST                             00580000
         MEXIT ,                                                        00590000
.PROCESS ANOP  ,                                                        00600000
&I       SETA  N'&SYSLIST                                               00610000
&J       SETA  1                                                        00620000
         AIF   ('&S'(1,1) NE '''').NOLIT                         84146  00630000
&SKPLEN  SETB  1                                                        00640000
.NOLIT   AIF   (&J GE &I).CHECK                                         00650000
&J       SETA  &J+1                                                     00660000
&L       SETC  '&SYSLIST(&J)'                                           00670000
         AIF   ('&L' EQ '').NOLIT                                       00680000
&NOP     SETB  (&NOP  OR '&L' EQ 'NOP')                                 00690000
&NL      SETB  (&NL  OR '&L' EQ 'NL' OR '&L' EQ 'NEWLINE')              00700000
&DEBL SETB (&DEBL OR '&L' EQ 'DEBL' OR '&L' EQ 'DEB' OR '&L' EQ 'DEBZ') 00710000
&DEBR    SETB  (&DEBR OR '&L' EQ 'DEBR' OR '&L' EQ 'DEB')               00720000
&DEBZ    SETB  (&DEBZ OR '&L' EQ 'DEBZ')                                00730000
&PADL    SETB  (&PADL OR '&L' EQ 'PADL' OR '&L' EQ 'PAD')               00740000
&PADR    SETB  (&PADR OR '&L' EQ 'PADR' OR '&L' EQ 'PAD')               00750000
&RADJ    SETB  (&RADJ OR '&L' EQ 'RADJ')                                00760000
&UP      SETB  (&UP OR '&L' EQ 'UP')                                    00770000
&UP      SETB  (&UP OR '&L' EQ 'UPPER')                                 00780000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BLUE')                                00790000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GREEN')                              00800000
&PINK    SETB  (&PINK OR '&L' EQ 'PINK')                                00810000
&RED     SETB  (&RED  OR '&L' EQ 'RED')                                 00820000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TURQ' OR '&L' EQ 'CYAN')      90326  00830000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WHITE')                              00840000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YELLOW')                            00850000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BL')                          GP10240 00860000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GR')                         GP10240 00870000
&PINK    SETB  (&PINK OR '&L' EQ 'PI')                          GP10240 00880000
&RED     SETB  (&RED  OR '&L' EQ 'RE')                          GP10240 00890000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TU' OR '&L' EQ 'CY')         GP10240 00900000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WH')                         GP10240 00910000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YE')                        GP10240 00920000
&MONO    SETB  (&MONO OR '&L' EQ 'MONO')                         87313  00930000
&UNDER   SETB  (&UNDER OR '&L' EQ 'UL' OR '&L' EQ 'UNDER')              00940000
&BLINK   SETB  (&BLINK OR '&L' EQ 'BLINK')                              00950000
&REVERSE SETB  (&REVERSE OR '&L' EQ 'REVERSE')                          00960000
&INTENSE SETB  (&INTENSE OR '&L' EQ 'INTENSE' OR '&L' EQ 'INT')         00970000
&DETECT  SETB  (&DETECT OR '&L' EQ 'DETECT' OR '&L' EQ 'LP')            00980000
&NONDISP SETB  (&NONDISP OR '&L' EQ 'NONDISP' OR '&L' EQ 'NDISP')       00990000
&NUMERIC SETB  (&NUMERIC OR '&L' EQ 'NUMERIC' OR '&L' EQ 'NUM')         01000000
&SKIP    SETB  (&SKIP OR '&L' EQ 'SKIP')                                01010000
&PROTECT SETB  (&PROTECT OR '&L' EQ 'PROTECT')                          01020000
&MDT     SETB  (&MDT OR '&L' EQ 'MDT')                           87313  01030000
&NULL    SETB  (&NULL OR '&L' EQ 'NULL')                         84146  01040000
&DEFAULT SETB  (&DEFAULT OR '&L' EQ 'DEFAULT' OR '&L' EQ 'DFLT')        01050000
&PREV    SETB  (&PREV OR '&L' EQ 'PREVIOUS' OR '&L' EQ 'PREV')          01060000
&INDAD   SETB  (&INDAD OR '&L' EQ '*')                           81270  01070000
         AIF   (&DATA NE 0).NOLIT                                       01080000
         AIF   (K'&L GT 4).OMLEN                                        01090000
&K       SETA  0                                                        01100000
&L       SETC  '&L'.'    '                                              01110000
&L       SETC  '&L'(1,4)                                                01120000
         AIF   ('&L' NE 'X   ').DT                              GP10240 01130000
&L       SETC  'HEX '                                           GP10240 01140000
.DT      AIF   (&K GE 35).OMLEN                                 GP07004 01150000
&K       SETA  &K+1                                                     01160000
&N       SETA  (&K-1)*4+1                                               01170000
&W      SETC  'CHARCON ASISADDRHEX SHEXBIT I   $I  D   $D  F   TIMETIMD*01180000
               DATEDATJWDAYMTH DAY MD  DMY MDY CHEXICM ICN IZ  IA  DCM *01190000
               DCN DZ  DA  EDATDATDCCHHTTR '(&N,4)              GP07004 01200000
         AIF   ('&L' NE '&W').DT                                        01210000
&DATA    SETA  &K                                                       01220000
         AIF   (&J EQ 2).OMSET                                          01230000
         AGO   .NOLIT                                                   01240000
.OMLEN   AIF   (&J NE 2 OR &SKPLEN).NOLIT                               01250000
 AIF (&NOP OR &IN OR &NL OR &DEBL OR &DEBR OR &DEBZ OR &PADL).OMSET     01260000
 AIF (&UP OR &PADR OR &RADJ OR &BLUE OR &GREEN OR &PINK OR &RED).OMSET  01270000
 AIF (&TURQ OR &WHITE OR &YELLOW OR &UNDER OR &BLINK OR &NULL).OMSET    01280000
 AIF (&REVERSE OR &INTENSE OR &DETECT OR &NONDISP OR &INDAD).OMSET      01290000
 AIF (&NUMERIC OR &SKIP OR &PROTECT OR &DEFAULT OR &PREV).OMSET         01300000
         AIF   (&MDT OR &MONO).OMSET                             87313  01310000
         AGO   .NOLIT                                                   01320000
.OMSET   ANOP  ,             EXPLICIT LENGTH OMITTED                    01330000
&SKPLEN  SETB  1             USE L'                                     01340000
         AGO   .NOLIT                                                   01350000
.CHECK   ANOP  ,                                                        01360000
&L       SETC  'L'''                                                    01370000
&IN      SETB  1                                                 84146  01380000
&T       SETA  128*&IN+64*&NOP+4*&EXFG+&INDAD                    89095  01390000
&E SETA 128*&NL+64*&DEBL+32*&DEBR+16*&DEBZ+8*&PADL+4*&PADR+2*&RADJ+&UP  01400000
&O7      SETA  128*&DEFAULT+64*&PREV+&MDT                        87313  01410000
&PROTECT SETB  (&PROTECT OR &SKIP)                                      01420000
&NUMERIC SETB  (&NUMERIC OR &SKIP)                                      01430000
&DETECT  SETB  (&DETECT  OR &NONDISP)                                   01440000
&INTENSE SETB  (&INTENSE OR &NONDISP)                                   01450000
&O7      SETA  &O7+32*&PROTECT+16*&NUMERIC+8*&INTENSE+4*&DETECT+2*&NULL 01460000
&C1      SETB  (&GREEN OR &TURQ OR &WHITE OR &YELLOW)                   01470000
&C2      SETB  (&RED OR &PINK OR &WHITE OR &YELLOW)                     01480000
&C3      SETB  (&BLUE OR &PINK OR &TURQ OR &WHITE)                      01490000
&O9      SETA  64*&C1+32*&C2+16*&C3+8*&MONO+4*&UNDER+2*&REVERSE+&BLINK  01500000
         AIF   ((&O7 NE 0 AND &O7 NE 128) OR &O9 NE 0).LONG      86244  01510000
&T       SETA  &T+48         USE FDPRT SHORT FORM                86244  01520000
         AIF   ('&S'(1,1) EQ '''').CSTRPRT                       86244  01530000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).EXLPRT           86244  01540000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&L&S),SL2(&S),&UEX      89095  01550000
         MEXIT ,                                                 86244  01560000
.EXLPRT  AIF   (K'&EXLEN LT 2).NORLPRT                           86244  01570000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NORLPRT   01580000
&T       SETA  &T+2          ILEN IS REGISTER FORM               86244  01590000
.NORLPRT ANOP  ,                                                 86244  01600000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&EXLEN),SL2(&S),&UEX    89095  01610000
         MEXIT ,                                                 86244  01620000
.CSTRPRT ANOP  ,                                                 86244  01630000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,1,&LEN,&L.ZFD&C.C),SL2(ZFD&C.C),&UEX      01640000
ZFD&C.C  DC    C&S                                               89095  01650000
         MEXIT ,                                                 86244  01660000
.LONG    AIF   ('&S'(1,1) EQ '''').CSTRING                       86244  01670000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).EXLEN                   01680000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,&DATA,&LEN,&L&S),SL2(&S),&UEX     01690000
         MEXIT                                                          01700000
.EXLEN   AIF   (K'&EXLEN LT 2).NORLEN                            81270  01710000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NORLEN    01720000
&T       SETA  &T+2          ILEN IS REGISTER FORM               81270  01730000
.NORLEN  ANOP  ,                                                 81270  01740000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,&DATA,&LEN,&EXLEN),SL2(&S),&UEX   01750000
         MEXIT ,                                                        01760000
.CSTRING ANOP  ,                                                        01770000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,1,&LEN,&L.ZFD&C.C),SL2(ZFD&C.C),&*01780000
               UEX                                               89095  01790000
ZFD&C.C  DC    C&S                                               89095  01800000
.MEND    MEND  ,                                                 84214  01810000
./ ADD NAME=FDLINE
         MACRO                                                          00010000
&NM      FDLINE &ARGS,&END=                                             00020000
.*                                                                      00030000
.*   BUILD ONE DISPLAY LINE DEFINITION FOR THE SCLINE SERVICE           00040000
.*                                                                      00050000
.*   FDLINE (FLAGS),LABEL:,(FIELD ATTRIBS),OFF-,TEXT.....   SINGLE DEF. 00060000
.*   FDLINE (FLAGS),fields.....,    (trailing comma)  1/n               00070000
.*   DC or FDLITEM ...                                m/n               00080000
.*   FDLINE *END             GENERATE CLOSING NAME    n/n               00090000
.*                                                                      00100000
.*   ATTRIBUTES:                                                        00110000
.*                                                                      00120000
.*   IN, OUT, INT(ENSE OUT),  N.B. INTENSE INPUT NOT IMPLEMENTED        00130000
.*   RED, BLUE, GREEN, CYAN, TURQ(OISE), WHITE, YELLOW                  00140000
.*   BLACK (NON-DISPLAY)     FORCES INPUT MODE                  GP09355 00150000
.*                                                                      00160000
.*   FLAGS:  LADJ   RADJ                                                00170000
.*           UPPER  SCROLL                                              00180000
.*           MDT                                                        00190000
.*                                                                      00200000
         GBLC  &ZZZLEND      PRIOR/NEXT END LABEL                       00210000
         GBLC  &ZZZFLAB      NEXT FIELD LABEL                           00220000
         GBLC  &ZZZFLAN      FDLINE STATEMENT LABEL             GP09358 00230000
         LCLC  &LABEL,&C,&D                                     GP09358 00240000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                          00250000
         LCLB  &INP,&INT,&BLACK                                 GP09353 00260000
         LCLA  &I,&J,&K,&L,&M,&N                                        00270000
         AIF   ('&ARGS' EQ '*END').CLOSED                               00280000
         AIF   ('&ZZZLEND' EQ '').PRVENDD                               00290000
&ZZZLEND DC    X'00'         PRIOR LINE UNCLOSED                        00300000
&ZZZLEND SETC  ''            SHOW LABEL USED                            00310000
         MNOTE *,'FDLINE: PRIOR END= NOT DEFINED; GENERATED'            00320000
.PRVENDD ANOP  ,                                                        00330000
&N       SETA  N'&SYSLIST                                               00340000
&ZZZLEND SETC  '&END'                                                   00350000
         AIF   ('&ZZZLEND' NE '').HAVELAB                               00360000
&ZZZLEND SETC  'ZZL'.'&SYSNDX'.'Z'                                      00370000
.HAVELAB ANOP  ,                                                        00380000
&LABEL   SETC  '&NM'                                                    00390000
         AIF   ('&LABEL' NE '').HAVELOC                                 00400000
&LABEL   SETC  'ZZL'.'&SYSNDX'.'L'                                      00410000
.HAVELOC ANOP  ,                                                        00420000
&LABEL   DC    0A(0),AL2(&ZZZLEND-&LABEL-3)  TEXT AND CONTROL LENGTH    00430000
&ZZZFLAN SETC  '&LABEL'      REMEMBER FOR OFFSET                GP09358 00440000
&I       SETA  0                                                        00450000
         AIF   (&N GT 0).ARGSOME  HAVE MULTIPLE ARGUMENTS               00460000
         DC    AL1(0)        FLAGS - NONE                               00470000
         AGO   .MEND         NEEDS END= ?                       GP09355 00480000
.ARGSOME AIF   ('&SYSLIST(1)' EQ '').ARGFLGS                            00490000
         AIF   ('&SYSLIST(1)'(1,1) EQ '(').ARGFLGS                      00500000
         DC    AL1(0)        FLAGS - NONE                               00510000
         AGO   .LOOP         START WITH FIRST ARGUMENT                  00520000
.ARGFLGS ANOP  ,                                                        00530000
&I       SETA  1             FIRST ARG IS FLAGS; START LOOP AT 2        00540000
&J       SETA  0                                                        00550000
&L       SETA  N'&SYSLIST(1)  NUMBER OF SUBARGUMENTS                    00560000
.FGLOOP  AIF   (&J GE &L).EXPFLAG                                       00570000
&J       SETA  &J+1                                                     00580000
&C       SETC  '&SYSLIST(&I,&J)'                                        00590000
         AIF   ('&C' EQ '').FGLOOP                                      00600000
&M       SETA  &M+1                                                     00610000
&F3      SETB  (&F3 OR ('&C' EQ 'LADJ'))                                00620000
&F4      SETB  (&F4 OR ('&C' EQ 'RADJ'))                                00630000
&F5      SETB  (&F5 OR ('&C' EQ 'UPPER'))                               00640000
&F5      SETB  (&F5 OR ('&C' EQ 'UPP'))                                 00650000
&F6      SETB  (&F6 OR ('&C' EQ 'SCROLL'))                              00660000
&F6      SETB  (&F6 OR ('&C' EQ 'SCR'))                                 00670000
&F7      SETB  (&F7 OR ('&C' EQ 'MDT'))                                 00680000
         AIF   (&M EQ (&F0+&F1+&F2+&F3+&F4+&F5+&F6+&F7)).FGLOOP         00690000
         MNOTE 4,'FDLINE: INVALID FLAG PARM &C '                        00700000
         AGO   .FGLOOP                                                  00710000
.EXPFLAG ANOP  ,                                                        00720000
&ZZZFLAB DC    B'&F0&F1&F2&F3&F4&F5&F6&F7'                              00730000
&ZZZFLAB SETC  ''                                                       00740000
.LOOP    AIF   (&I GE &N).DONE                                          00750000
&I       SETA  &I+1                                                     00760000
&C       SETC  '&SYSLIST(&I)'                                           00770000
         AIF   ('&C' EQ '').LOOP                                        00780000
         AIF   ('&C'(1,1) EQ '(').FIELD                                 00790000
         AIF   ('&C'(1,1) EQ '''').STRING                               00800000
         AIF   ('&C'(K'&C,1) EQ ':').LABEL                              00810000
         AIF   ('&C'(K'&C,1) EQ '-').OFFSET                     GP09358 00820000
         AIF   ('&C'(1,1) EQ 'C').COUNT                                 00830000
         AIF   ('&C'(1,1) EQ 'X').HEXER                                 00840000
         AIF   ('&C'(1,1) GE '0' AND '&C'(1,1) LE '9').COUNT            00850000
.ARGBAD  MNOTE 8,'FDLINE: ARGUMENT &I INVALID - &C NOT A VALID ENTRY'   00860000
         AGO   .LOOP                                                    00870000
.*                                                                      00880000
.STRING  ANOP  ,                                                        00890000
&ZZZFLAB DC    C&C                                                      00900000
&ZZZFLAB SETC  ''                                                       00910000
         AGO   .LOOP                                                    00920000
.*                                                                      00930000
.COUNT   AIF   ('&C'(K'&C,1) NE '''').COUNTS                            00940000
&ZZZFLAB DC    &C                                                       00950000
&ZZZFLAB SETC  ''                                                       00960000
         AGO   .LOOP                                                    00970000
.COUNTS  ANOP  ,                                                        00980000
&ZZZFLAB DC    &C' '                                                    00990000
&ZZZFLAB SETC  ''                                                       01000000
         AGO   .LOOP                                                    01010000
.HEXER   AIF   ('&C'(K'&C,1) NE '''').HEXED                             01020000
&ZZZFLAB DC    &C                                                       01030000
&ZZZFLAB SETC  ''                                                       01040000
         AGO   .LOOP                                                    01050000
.HEXED   ANOP  ,                                                        01060000
&ZZZFLAB DC    &C'0'                                                    01070000
&ZZZFLAB SETC  ''                                                       01080000
         AGO   .LOOP                                                    01090000
.*                                                                      01100000
.FIELD   ANOP  ,                                                        01110000
&J       SETA  0                                                        01120000
&L       SETA  N'&SYSLIST(&I)  NUMBER OF SUBARGUMENTS                   01130000
&F0      SETB  0             MUST BE OFF                                01140000
&F1      SETB  0             MUST BE OFF (RANGE 01-3F)                  01150000
&F2      SETB  0                                                        01160000
&F3      SETB  0        1 0  OUTPUT  ;  1 1  OUT INTENSE                01170000
&F4      SETB  0        0 1  INPUT   ;  1 1  OUT INTENSE                01180000
&F5      SETB  0             COLOR: GREEN                               01190000
&F6      SETB  0             COLOR: RED                                 01200000
&F7      SETB  0             COLOR: BLUE                                01210000
&INP     SETB  0             INPUT                              GP09355 01220000
&INT     SETB  0             INTENSE                            GP09355 01230000
&BLACK   SETB  0             NON-DISPLAY                        GP09355 01240000
.FDLOOP  AIF   (&J GE &L).EXPFLD                                        01250000
&J       SETA  &J+1                                                     01260000
&C       SETC  '&SYSLIST(&I,&J)'                                        01270000
         AIF   ('&C' EQ '').FDLOOP                                      01280000
.*DEFER* AIF   ('&C' EQ 'REVERSE').REVERSE                              01290000
.*DEFER* AIF   ('&C' EQ 'BLINK').BLINK                                  01300000
.*DEFER* AIF   ('&C' EQ 'UNDER').UNDER                                  01310000
.*DEFER* AIF   ('&C' EQ 'DFLT').NULL                                    01320000
         AIF   ('&C' EQ 'BL').BLUE                                      01330000
         AIF   ('&C' EQ 'RE').RED                                       01340000
         AIF   ('&C' EQ 'PI').PINK                                      01350000
         AIF   ('&C' EQ 'MA').PINK                                      01360000
         AIF   ('&C' EQ 'GR').GREEN                                     01370000
         AIF   ('&C' EQ 'CY').TURQ                                      01380000
         AIF   ('&C' EQ 'TU').TURQ                                      01390000
         AIF   ('&C' EQ 'YE').YELLOW                                    01400000
         AIF   ('&C' EQ 'WH').WHITE                                     01410000
         AIF   ('&C' EQ 'BK').BLACK                             GP09355 01420000
         AIF   ('&C' EQ 'ND').BLACK                             GP09355 01430000
         AIF   ('&C' EQ 'BLUE').BLUE                                    01440000
         AIF   ('&C' EQ 'RED').RED                                      01450000
         AIF   ('&C' EQ 'PINK').PINK                                    01460000
         AIF   ('&C' EQ 'MAGENTA').PINK                                 01470000
         AIF   ('&C' EQ 'GREEN').GREEN                                  01480000
         AIF   ('&C' EQ 'CYAN').TURQ                                    01490000
         AIF   ('&C' EQ 'TURQ').TURQ                                    01500000
         AIF   ('&C' EQ 'TURQOISE').TURQ                                01510000
         AIF   ('&C' EQ 'YELLOW').YELLOW                                01520000
         AIF   ('&C' EQ 'WHITE').WHITE                                  01530000
         AIF   ('&C' EQ 'BLACK').BLACK                          GP09355 01540000
         AIF   ('&C' EQ 'IN').INPUT                                     01550000
         AIF   ('&C' EQ 'INPUT').INPUT                                  01560000
         AIF   ('&C' EQ 'OUT').OUTPUT                                   01570000
         AIF   ('&C' EQ 'INT').INTENSE                                  01580000
         AIF   ('&C' EQ 'INTENSE').INTENSE                              01590000
       MNOTE 8,'FDLINE: ARGUMENT &I,&J INVALID - &C NOT A VALID ENTRY'  01600000
         AGO   .FDLOOP                                                  01610000
.BLUE    ANOP  ,                                                        01620000
&F5      SETB  0                                                        01630000
&F6      SETB  0                                                        01640000
&F7      SETB  1                                                        01650000
         AGO   .FDLOOP                                                  01660000
.*                                                                      01670000
.RED     ANOP  ,                                                        01680000
&F5      SETB  0                                                        01690000
&F6      SETB  1                                                        01700000
&F7      SETB  0                                                        01710000
         AGO   .FDLOOP                                                  01720000
.*                                                                      01730000
.PINK    ANOP  ,                                                        01740000
&F5      SETB  0                                                        01750000
&F6      SETB  1                                                        01760000
&F7      SETB  1                                                        01770000
         AGO   .FDLOOP                                                  01780000
.*                                                                      01790000
.GREEN   ANOP  ,                                                        01800000
&F5      SETB  1                                                        01810000
&F6      SETB  0                                                        01820000
&F7      SETB  0                                                        01830000
         AGO   .FDLOOP                                                  01840000
.*                                                                      01850000
.TURQ    ANOP  ,                                                        01860000
&F5      SETB  1                                                        01870000
&F6      SETB  0                                                        01880000
&F7      SETB  1                                                        01890000
         AGO   .FDLOOP                                                  01900000
.*                                                                      01910000
.YELLOW  ANOP  ,                                                        01920000
&F5      SETB  1                                                        01930000
&F6      SETB  1                                                        01940000
&F7      SETB  0                                                        01950000
         AGO   .FDLOOP                                                  01960000
.*                                                                      01970000
.WHITE   ANOP  ,                                                        01980000
&F5      SETB  1                                                        01990000
&F6      SETB  1                                                        02000000
&F7      SETB  1                                                        02010000
         AGO   .FDLOOP                                                  02020000
.*                                                                      02030000
.BLACK   ANOP  ,                                                GP09355 02040000
&F5      SETB  0                                                GP09355 02050000
&F6      SETB  0                                                GP09355 02060000
&F7      SETB  1             FORCE NON-ZERO                     GP09355 02070000
&BLACK   SETB  1             NON-DISPLAY FLAG                   GP09355 02080000
         AGO   .FDLOOP                                          GP09355 02090000
.*                                                                      02100000
.INPUT   ANOP                                                           02110000
&INP     SETB  1                                                GP08356 02120000
&F3      SETB  0                                                        02130000
&F4      SETB  1                                                        02140000
         AIF   (&INT).CONFII                                    GP08356 02150000
         AGO   .FDLOOP                                                  02160000
.*                                                                      02170000
.OUTPUT  ANOP  ,                                                        02180000
&F3      SETB  1                                                        02190000
&F4      SETB  0                                                        02200000
         AGO   .FDLOOP                                                  02210000
.*                                                                      02220000
.INTENSE ANOP  ,                                                        02230000
&INT     SETB  1                                                GP08356 02240000
&F4      SETB  1                                                        02250000
         AIF   (&INP).CONFII                                    GP08356 02260000
&F3      SETB  1                                                        02270000
         AGO   .FDLOOP                                                  02280000
.CONFII  MNOTE *,'FDLINE: INTENSE INPUT NOT IMPLEMENTED'        GP08356 02290000
         AGO   .FDLOOP                                          GP08356 02300000
.*                                                                      02310000
.EXPFLD  AIF   (NOT &BLACK).EXPFLD1                             GP09355 02320000
&F4      SETB  0             FORCED INPUT MODE                  GP09353 02330000
         AIF   (NOT &F3).EXPFLD2                                GP09353 02340000
    MNOTE 4,'FDLINE: CONFLICTING NON-DISPLAY AND OUTPUT ATTR &I'        02350000
.EXPFLD1 AIF   (&F3 OR &F4).EXPFLD2                                     02360000
&F3      SETB  1             OUTPUT IS DEFAULT                          02370000
.EXPFLD2 ANOP  ,                                                        02380000
&ZZZFLAB DC    B'&F0&F1&F2&F3&F4&F5&F6&F7'                              02390000
&ZZZFLAB SETC  ''                                                       02400000
&INT     SETB  0                                                GP08356 02410000
&INP     SETB  0                                                GP08356 02420000
         AGO   .LOOP                                                    02430000
.*                                                                      02440000
.LABEL   AIF   ('&ZZZFLAB' EQ '').LABNEW                                02450000
&ZZZFLAB DC    X'00'         ERROR ?                                    02460000
         MNOTE 0,'FDLINE: CONSECUTIVE LABELS &ZZZFLAB AND &C '          02470000
.LABNEW  ANOP  ,                                                        02480000
&ZZZFLAB SETC  '&C'(1,K'&C-1)                                           02490000
         AGO   .LOOP                                                    02500000
.*                                                                      02510000
.OFFSET  ANOP  ,                                                GP09358 02520000
&D       SETC  '&C'(1,K'&C-1)                                   GP09358 02530000
&D       EQU   *-&ZZZFLAN    FIELD OFFSET (NO LEN)              GP09358 02540000
         AGO   .LOOP                                            GP09358 02550000
.*                                                                      02560000
.DONE    AIF   ('&ZZZFLAB' EQ '').DONEL                                 02570000
&ZZZFLAB DC    X'00'         ERROR ?                            GP09355 02580000
&ZZZFLAB SETC  ''                                                       02590000
.DONEL   AIF   ('&ZZZLEND' EQ '').DONED                                 02600000
         AIF   ('&SYSLIST(&N)' EQ '').MEND   CONTINUATION       GP09355 02610000
.*       AGO   .CLOSED                                          GP09355 02620000
.DONED   AIF   ('&END' NE '').MEND   REMOTE END                         02630000
.*                                                                      02640000
.CLOSER  AIF   ('&ZZZFLAB' EQ '').CLOSED                                02650000
&ZZZFLAB DC    X'00'         ERROR ?                                    02660000
&ZZZFLAB SETC  ''                                                       02670000
         AGO   .MEND                                                    02680000
.CLOSED  AIF   ('&ZZZLEND' EQ '').MEND                                  02690000
&ZZZLEND DC    X'00'                                                    02700000
&ZZZLEND SETC  ''                                                       02710000
.*                                                                      02720000
.MEND    MEND  ,                                                        02730000
./ ADD NAME=FDLITEM
         MACRO                                                          00010000
&NM      FDLITEM &ARGS                                                  00020000
.*                                                                      00030000
.*   BUILD ONE DISPLAY ITEM DEFINITION FOR THE SCLINE SERVICE           00040000
.*                                                                      00050000
.*   USE AFTER  FDLINE ...END=name                    1/n               00060000
.*   FDLITEM LABEL:,(FIELD ATTRIBS),LBL:,TEXT.....    2/n               00070000
.*   DC or whatever                                   m/n               00080000
.*   FDLINE *END             GENERATE CLOSING NAME    n/n               00090000
.*                                                                      00100000
.*   ATTRIBUTES:                                                        00110000
.*                                                                      00120000
.*   IN, OUT, INT(ENSE OUT),                                            00130000
.*   RED, BLUE, GREEN, CYAN, TURQ(OISE), WHITE, YELLOW                  00140000
.*   BLACK (NON-DISPLAY) - FORCES INPUT MODE                    GP09353 00150000
.*                                                                      00160000
.*   THIS MACRO GENERATES NEITHER THE LINE NOR FLAG FIELDS; USE FDLINE  00170000
.*   FOR THOSE                                                          00180000
.*                                                                      00190000
         GBLC  &ZZZLEND      PRIOR/NEXT END LABEL                       00200000
         GBLC  &ZZZFLAB      NEXT FIELD LABEL                           00210000
         GBLC  &ZZZFLAN      FDLINE  LABEL                      GP09358 00220000
         LCLC  &LABEL,&C,&FLAB,&D                               GP09358 00230000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                          00240000
         LCLB  &INP,&INT,&BLACK                                 GP09353 00250000
         LCLA  &I,&J,&K,&L,&M,&N                                        00260000
         AIF   ('&ARGS' EQ '*END').CLOSER                               00270000
&N       SETA  N'&SYSLIST                                               00280000
&LABEL   SETC  '&NM'                                                    00290000
&I       SETA  0                                                        00300000
         AIF   (&N GT 0).LOOP     HAVE MULTIPLE ARGUMENTS               00310000
         MNOTE 0,'FDLITEM: NO ARGUMENTS SUPPLIED'                       00320000
         AGO   .DONE                                                    00330000
.LOOP    AIF   (&I GE &N).DONE                                          00340000
&I       SETA  &I+1                                                     00350000
&C       SETC  '&SYSLIST(&I)'                                           00360000
         AIF   ('&C' EQ '').LOOP                                        00370000
         AIF   ('&C'(1,1) EQ '(').FIELD                                 00380000
         AIF   ('&C'(1,1) EQ '''').STRING                               00390000
         AIF   ('&C'(K'&C,1) EQ ':').LABEL                              00400000
         AIF   ('&C'(K'&C,1) EQ '-').OFFSET                             00410000
         AIF   ('&C'(1,1) EQ 'C').COUNT                                 00420000
         AIF   ('&C'(1,1) EQ 'X').HEXER                                 00430000
         AIF   ('&C'(1,1) GE '0' AND '&C'(1,1) LE '9').COUNT            00440000
.ARGBAD  MNOTE 8,'FDLITEM: ARGUMENT &I INVALID - &C NOT A VALID ENTRY'  00450000
         AGO   .LOOP                                                    00460000
.*                                                                      00470000
.STRING  ANOP  ,                                                        00480000
&LABEL   DC    C&C                                                      00490000
&LABEL   SETC  ''                                                       00500000
         AGO   .LOOP                                                    00510000
.*                                                                      00520000
.COUNT   AIF   ('&C'(K'&C,1) NE '''').COUNTS                            00530000
&LABEL   DC    &C                                                       00540000
&LABEL   SETC  ''                                                       00550000
         AGO   .LOOP                                                    00560000
.COUNTS  ANOP  ,                                                        00570000
&LABEL   DC    &C' '                                                    00580000
&LABEL   SETC  ''                                                       00590000
         AGO   .LOOP                                                    00600000
.HEXER   AIF   ('&C'(K'&C,1) NE '''').HEXED                             00610000
&LABEL   DC    &C                                                       00620000
&LABEL   SETC  ''                                                       00630000
         AGO   .LOOP                                                    00640000
.HEXED   ANOP  ,                                                        00650000
&LABEL   DC    &C'0'                                                    00660000
&LABEL   SETC  ''                                                       00670000
         AGO   .LOOP                                                    00680000
.*                                                                      00690000
.FIELD   ANOP  ,                                                        00700000
&J       SETA  0                                                        00710000
&L       SETA  N'&SYSLIST(&I)  NUMBER OF SUBARGUMENTS                   00720000
&F0      SETB  0             MUST BE OFF                                00730000
&F1      SETB  0             MUST BE OFF (RANGE 01-3F)                  00740000
&F2      SETB  0                                                        00750000
&F3      SETB  0        1 0  OUTPUT  ;  1 1  OUT INTENSE                00760000
&F4      SETB  0        0 1  INPUT   ;  0 0  NON-DISPLAY                00770000
&F5      SETB  0             COLOR: GREEN                               00780000
&F6      SETB  0             COLOR: RED                                 00790000
&F7      SETB  0             COLOR: BLUE                                00800000
&INP     SETB  0             INPUT                              GP09353 00810000
&INT     SETB  0             INTENSE                            GP09353 00820000
&BLACK   SETB  0             NON-DISPLAY                        GP09353 00830000
.FDLOOP  AIF   (&J GE &L).EXPFLD                                        00840000
&J       SETA  &J+1                                                     00850000
&C       SETC  '&SYSLIST(&I,&J)'                                        00860000
         AIF   ('&C' EQ '').FDLOOP                                      00870000
.*DEFER* AIF   ('&C' EQ 'REVERSE').REVERSE                              00880000
.*DEFER* AIF   ('&C' EQ 'BLINK').BLINK                                  00890000
.*DEFER* AIF   ('&C' EQ 'UNDER').UNDER                                  00900000
.*DEFER* AIF   ('&C' EQ 'DFLT').NULL                                    00910000
         AIF   ('&C' EQ 'BL').BLUE                                      00920000
         AIF   ('&C' EQ 'RE').RED                                       00930000
         AIF   ('&C' EQ 'PI').PINK                                      00940000
         AIF   ('&C' EQ 'MA').PINK                                      00950000
         AIF   ('&C' EQ 'GR').GREEN                                     00960000
         AIF   ('&C' EQ 'CY').TURQ                                      00970000
         AIF   ('&C' EQ 'TU').TURQ                                      00980000
         AIF   ('&C' EQ 'YE').YELLOW                                    00990000
         AIF   ('&C' EQ 'WH').WHITE                                     01000000
         AIF   ('&C' EQ 'BK').BLACK                             GP09353 01010000
         AIF   ('&C' EQ 'ND').BLACK                             GP09353 01020000
         AIF   ('&C' EQ 'IN').INPUT                                     01030000
         AIF   ('&C' EQ 'BLUE').BLUE                                    01040000
         AIF   ('&C' EQ 'RED').RED                                      01050000
         AIF   ('&C' EQ 'PINK').PINK                                    01060000
         AIF   ('&C' EQ 'MAGENTA').PINK                                 01070000
         AIF   ('&C' EQ 'GREEN').GREEN                                  01080000
         AIF   ('&C' EQ 'CYAN').TURQ                                    01090000
         AIF   ('&C' EQ 'TURQ').TURQ                                    01100000
         AIF   ('&C' EQ 'TURQOISE').TURQ                                01110000
         AIF   ('&C' EQ 'YELLOW').YELLOW                                01120000
         AIF   ('&C' EQ 'WHITE').WHITE                                  01130000
         AIF   ('&C' EQ 'BLACK').BLACK                          GP09353 01140000
         AIF   ('&C' EQ 'INPUT').INPUT                                  01150000
         AIF   ('&C' EQ 'OUT').OUTPUT                                   01160000
         AIF   ('&C' EQ 'INT').INTENSE                                  01170000
         AIF   ('&C' EQ 'INTENSE').INTENSE                              01180000
       MNOTE 8,'FDLITEM: ARGUMENT &I,&J INVALID - &C NOT A VALID ENTRY' 01190000
         AGO   .FDLOOP                                                  01200000
.BLUE    ANOP  ,                                                        01210000
&F5      SETB  0                                                        01220000
&F6      SETB  0                                                        01230000
&F7      SETB  1                                                        01240000
         AGO   .FDLOOP                                                  01250000
.*                                                                      01260000
.RED     ANOP  ,                                                        01270000
&F5      SETB  0                                                        01280000
&F6      SETB  1                                                        01290000
&F7      SETB  0                                                        01300000
         AGO   .FDLOOP                                                  01310000
.*                                                                      01320000
.PINK    ANOP  ,                                                        01330000
&F5      SETB  0                                                        01340000
&F6      SETB  1                                                        01350000
&F7      SETB  1                                                        01360000
         AGO   .FDLOOP                                                  01370000
.*                                                                      01380000
.GREEN   ANOP  ,                                                        01390000
&F5      SETB  1                                                        01400000
&F6      SETB  0                                                        01410000
&F7      SETB  0                                                        01420000
         AGO   .FDLOOP                                                  01430000
.*                                                                      01440000
.TURQ    ANOP  ,                                                        01450000
&F5      SETB  1                                                        01460000
&F6      SETB  0                                                        01470000
&F7      SETB  1                                                        01480000
         AGO   .FDLOOP                                                  01490000
.*                                                                      01500000
.YELLOW  ANOP  ,                                                        01510000
&F5      SETB  1                                                        01520000
&F6      SETB  1                                                        01530000
&F7      SETB  0                                                        01540000
         AGO   .FDLOOP                                                  01550000
.*                                                                      01560000
.WHITE   ANOP  ,                                                        01570000
&F5      SETB  1                                                        01580000
&F6      SETB  1                                                        01590000
&F7      SETB  1                                                        01600000
         AGO   .FDLOOP                                                  01610000
.*                                                                      01620000
.BLACK   ANOP  ,                                                GP09353 01630000
&F5      SETB  0                                                GP09353 01640000
&F6      SETB  0                                                GP09353 01650000
&F7      SETB  1             FORCE NON-ZERO                     GP09353 01660000
&BLACK   SETB  1                                                GP09353 01670000
         AGO   .FDLOOP                                                  01680000
.*                                                                      01690000
.INPUT   ANOP                                                           01700000
&F3      SETB  0                                                        01710000
&F4      SETB  1                                                        01720000
&INP     SETB  1                                                GP08356 01730000
         AIF   (&INT).CONFII                                    GP08356 01740000
         AGO   .FDLOOP                                                  01750000
.*                                                                      01760000
.OUTPUT  ANOP  ,                                                        01770000
&F3      SETB  1                                                        01780000
&F4      SETB  0                                                        01790000
         AGO   .FDLOOP                                                  01800000
.*                                                                      01810000
.INTENSE ANOP  ,                                                        01820000
&F4      SETB  1                                                        01830000
&INT     SETB  1                                                GP08356 01840000
         AIF   (&INP).CONFII                                    GP08356 01850000
&F3      SETB  1                                                        01860000
         AGO   .FDLOOP                                                  01870000
.CONFII  MNOTE *,'FDLITEM: INTENSE INPUT NOT SUPPORTED'         GP08356 01880000
         AGO   .FDLOOP                                          GP08356 01890000
.*                                                                      01900000
.EXPFLD  AIF   (NOT &BLACK).EXPFLD1                             GP09353 01910000
&F4      SETB  0             FORCED INPUT MODE                  GP09353 01920000
         AIF   (NOT &F3).EXPFLD2                                GP09353 01930000
         MNOTE 4,'FDLITEM: CONFLICTING NON-DISPLAY & OUTPUT ATTR &I'    01940000
.EXPFLD1 AIF   (&F3 OR &F4).EXPFLD2                                     01950000
&F3      SETB  1             OUTPUT IS DEFAULT                          01960000
.EXPFLD2 ANOP  ,                                                        01970000
&LABEL   DC    B'&F0&F1&F2&F3&F4&F5&F6&F7'                              01980000
&LABEL   SETC  ''                                                       01990000
&INP     SETB  0                                                GP08356 02000000
&INT     SETB  0                                                GP08356 02010000
         AGO   .LOOP                                                    02020000
.*                                                                      02030000
.LABEL   AIF   ('&LABEL' EQ '').LABNEW                                  02040000
         MNOTE 0,'FDLITEM: CONSECUTIVE LABELS &LABEL AND &C '           02050000
&LABEL   DS    0X                                                       02060000
.LABNEW  ANOP  ,                                                        02070000
&LABEL   SETC  '&C'(1,K'&C-1)                                           02080000
         AGO   .LOOP                                                    02090000
.*                                                                      02100000
.OFFSET  ANOP  ,                                                GP09358 02110000
&D       SETC  '&C'(1,K'&C-1)                                   GP09358 02120000
&D       EQU   *-&ZZZFLAN    FIELD OFFSET (NO LEN)              GP09358 02130000
         AGO   .LOOP                                            GP09358 02140000
.*                                                                      02150000
.DONE    AIF   ('&LABEL' EQ '').MEND                                    02160000
&LABEL   DS    0X                                                       02170000
         AGO   .MEND                                                    02180000
.*                                                                      02190000
.CLOSER  AIF   ('&LABEL  ' EQ '').CLOSED                                02200000
&ZZZFLAB DC    X'00'         ERROR ?                                    02210000
&ZZZFLAB SETC  ''                                                       02220000
.CLOSED  AIF   ('&ZZZLEND' EQ '').MEND                                  02230000
&ZZZLEND DC    X'00'                                                    02240000
&ZZZLEND SETC  ''                                                       02250000
.*                                                                      02260000
.MEND    MEND  ,                                                        02270000
./ ADD NAME=FDLSET
         MACRO ,                                       ADDED ON GP12303 00010000
&NM      FDLSET &FIELD,&ATTR1,&ATTR2 ...                                00020000
.*                                                                      00030000
.*   SET OR ALTER A FIELD ATTRIBUTE IN A DISPLAY LINE DEFINED           00040000
.*   WITH FDLINE OR FDLITEM MACROS, FOR THE SCLINE SERVICE.             00050000
.*                                                                      00060000
.*   FIRST POSITIONAL IS THE ADDRESS OF THE FIELD ATTRIBUTE             00070000
.*     TO BE CHANGED                                                    00080000
.*   SECOND AND SUBSEQUENT POSITIONALS ARE THE ATTRIBUTES               00090000
.*     COLOR, HIGH-LIGHTING, AND INPUT VS. OUTPUT                       00100000
.*     THE SECOND, AND ONLY SECOND, OPERAND MAY BE A LIST, SIMILAR TO   00110000
.*       FDLINE AND FDLITEM ENTRIES.                                    00120000
.*   ATTRIBUTES:                                                        00130000
.*                                                                      00140000
.*   IN, OUT, INT(ENSE OUT),                                            00150000
.*   RED, BLUE, GREEN, CYAN, TURQ(OISE), WHITE, YELLOW                  00160000
.*   BLACK (NON-DISPLAY) - FORCES INPUT MODE                            00170000
.*                                                                      00180000
.*   THIS MACRO GENERATES NEITHER THE LINE NOR FLAG FIELDS; USE FDLINE  00190000
.*   OR FDLITEM FOR THOSE                                               00200000
.*                                                                      00210000
.*   EXAMPLE:                                                           00220000
.*       FDLINE (UPPER,LADJ),(GR),'Cmd:',CL40,MSGCOL:,(CY),ERRMSG:,CL39 00230000
.*   the message will be cyan (light blue)                              00240000
.*   To change it to yellow, use                                        00250000
.*       FDLSET MSGCOL,YE                                               00260000
.*   or intense red                                                     00270000
.*       FDLSET MSGCOL,INT,RED                                          00280000
.*                                                                      00290000
.*                                                                      00300000
         LCLC  &C,&D                                                    00310000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                          00320000
         LCLB  &INP,&INT,&BLACK                                         00330000
         LCLA  &I,&J,&K,&L,&M,&N,&NN,&NJ                        GP12357 00340000
&N       SETA  N'&SYSLIST                                               00350000
         AIF   (&N GT 1).FIELD    HAVE MULTIPLE ARGUMENTS               00360000
         MNOTE 4,'FDLSET: NO ATTRIBUTES SUPPLIED'                       00370000
         MEXIT ,                                                        00380000
.*                                                                      00390000
.FIELD   ANOP  ,                                                        00400000
&J       SETA  1             START WITH SECOND                          00410000
&L       SETA  N'&SYSLIST    NUMBER OF ARGUMENTS                        00420000
&F0      SETB  0             MUST BE OFF                                00430000
&F1      SETB  0             MUST BE OFF (RANGE 01-3F)                  00440000
&F2      SETB  0                                                        00450000
&F3      SETB  0   DFLT 1 0  OUTPUT  ;  1 1  OUT INTENSE                00460000
&F4      SETB  0        0 1  INPUT   ;  0 0  NON-DISPLAY                00470000
&F5      SETB  0             COLOR: GREEN                               00480000
&F6      SETB  0             COLOR: RED                                 00490000
&F7      SETB  0             COLOR: BLUE                                00500000
&INP     SETB  0             INPUT                                      00510000
&INT     SETB  0             INTENSE                                    00520000
&BLACK   SETB  0             NON-DISPLAY                                00530000
.FDLOOM  AIF   (&J GE &L).EXPFLD                                        00540000
&J       SETA  &J+1                                                     00550000
&NJ      SETA  0                                                GP12357 00560000
&NN      SETA  N'&SYSLIST(&J)                                   GP12357 00570000
.FDLOOP  AIF   (&NJ GE &NN).FDLOOM                              GP12357 00580000
&NJ      SETA  &NJ+1                                            GP12357 00590000
.*                                                              GP12357 00600000
&C       SETC  '&SYSLIST(&J,&NJ)'                               GP12357 00610000
         AIF   ('&C' EQ '').FDLOOP                                      00620000
.*DEFER* AIF   ('&C' EQ 'REVERSE').REVERSE                              00630000
.*DEFER* AIF   ('&C' EQ 'BLINK').BLINK                                  00640000
.*DEFER* AIF   ('&C' EQ 'UNDER').UNDER                                  00650000
.*DEFER* AIF   ('&C' EQ 'DFLT').NULL                                    00660000
         AIF   ('&C' EQ 'BL').BLUE                                      00670000
         AIF   ('&C' EQ 'RE').RED                                       00680000
         AIF   ('&C' EQ 'PI').PINK                                      00690000
         AIF   ('&C' EQ 'MA').PINK                                      00700000
         AIF   ('&C' EQ 'GR').GREEN                                     00710000
         AIF   ('&C' EQ 'CY').TURQ                                      00720000
         AIF   ('&C' EQ 'TU').TURQ                                      00730000
         AIF   ('&C' EQ 'YE').YELLOW                                    00740000
         AIF   ('&C' EQ 'WH').WHITE                                     00750000
         AIF   ('&C' EQ 'BK').BLACK                                     00760000
         AIF   ('&C' EQ 'ND').BLACK                                     00770000
         AIF   ('&C' EQ 'IN').INPUT                                     00780000
         AIF   ('&C' EQ 'BLUE').BLUE                                    00790000
         AIF   ('&C' EQ 'RED').RED                                      00800000
         AIF   ('&C' EQ 'PINK').PINK                                    00810000
         AIF   ('&C' EQ 'MAGENTA').PINK                                 00820000
         AIF   ('&C' EQ 'GREEN').GREEN                                  00830000
         AIF   ('&C' EQ 'CYAN').TURQ                                    00840000
         AIF   ('&C' EQ 'TURQ').TURQ                                    00850000
         AIF   ('&C' EQ 'TURQOISE').TURQ                                00860000
         AIF   ('&C' EQ 'YELLOW').YELLOW                                00870000
         AIF   ('&C' EQ 'WHITE').WHITE                                  00880000
         AIF   ('&C' EQ 'BLACK').BLACK                                  00890000
         AIF   ('&C' EQ 'INPUT').INPUT                                  00900000
         AIF   ('&C' EQ 'OUT').OUTPUT                                   00910000
         AIF   ('&C' EQ 'INT').INTENSE                                  00920000
         AIF   ('&C' EQ 'INTENSE').INTENSE                              00930000
&I       SETA  &J-1                                                     00940000
       MNOTE 8,'FDLSET: ATTRIBUTE &I INVALID - &C NOT A VALID ENTRY'    00950000
         AGO   .FDLOOP                                                  00960000
.BLUE    ANOP  ,                                                        00970000
&F5      SETB  0                                                        00980000
&F6      SETB  0                                                        00990000
&F7      SETB  1                                                        01000000
         AGO   .FDLOOP                                                  01010000
.*                                                                      01020000
.RED     ANOP  ,                                                        01030000
&F5      SETB  0                                                        01040000
&F6      SETB  1                                                        01050000
&F7      SETB  0                                                        01060000
         AGO   .FDLOOP                                                  01070000
.*                                                                      01080000
.PINK    ANOP  ,                                                        01090000
&F5      SETB  0                                                        01100000
&F6      SETB  1                                                        01110000
&F7      SETB  1                                                        01120000
         AGO   .FDLOOP                                                  01130000
.*                                                                      01140000
.GREEN   ANOP  ,                                                        01150000
&F5      SETB  1                                                        01160000
&F6      SETB  0                                                        01170000
&F7      SETB  0                                                        01180000
         AGO   .FDLOOP                                                  01190000
.*                                                                      01200000
.TURQ    ANOP  ,                                                        01210000
&F5      SETB  1                                                        01220000
&F6      SETB  0                                                        01230000
&F7      SETB  1                                                        01240000
         AGO   .FDLOOP                                                  01250000
.*                                                                      01260000
.YELLOW  ANOP  ,                                                        01270000
&F5      SETB  1                                                        01280000
&F6      SETB  1                                                        01290000
&F7      SETB  0                                                        01300000
         AGO   .FDLOOP                                                  01310000
.*                                                                      01320000
.WHITE   ANOP  ,                                                        01330000
&F5      SETB  1                                                        01340000
&F6      SETB  1                                                        01350000
&F7      SETB  1                                                        01360000
         AGO   .FDLOOP                                                  01370000
.*                                                                      01380000
.BLACK   ANOP  ,                                                        01390000
&F3      SETB  0                                                        01400000
&F4      SETB  0                                                        01410000
&F5      SETB  0                                                        01420000
&F6      SETB  0                                                        01430000
&F7      SETB  1             FORCE NON-ZERO                             01440000
&BLACK   SETB  1                                                        01450000
         AGO   .FDLOOP                                                  01460000
.*                                                                      01470000
.INPUT   ANOP                                                           01480000
&F3      SETB  0                                                        01490000
&F4      SETB  1                                                        01500000
&INP     SETB  1                                                        01510000
         AIF   (&INT).CONFII                                            01520000
         AGO   .FDLOOP                                                  01530000
.*                                                                      01540000
.OUTPUT  ANOP  ,                                                        01550000
&F3      SETB  1                                                        01560000
&F4      SETB  0                                                        01570000
         AGO   .FDLOOP                                                  01580000
.*                                                                      01590000
.INTENSE ANOP  ,                                                        01600000
&F4      SETB  1                                                        01610000
&INT     SETB  1                                                        01620000
         AIF   (&INP).CONFII                                            01630000
&F3      SETB  1                                                        01640000
         AGO   .FDLOOP                                                  01650000
.CONFII  MNOTE *,'FDLSET: INTENSE INPUT NOT SUPPORTED'                  01660000
         AGO   .FDLOOP                                                  01670000
.*                                                                      01680000
.EXPFLD  AIF   (NOT &BLACK).EXPFLD1                                     01690000
&F4      SETB  0             FORCED INPUT MODE                          01700000
         AIF   (NOT &F3).EXPFLD2                                        01710000
         MNOTE 4,'FDLSET: CONFLICTING NON-DISPLAY AND OUTPUT ATTR &I'   01720000
.EXPFLD1 AIF   (&F3 OR &F4).EXPFLD2                                     01730000
&F3      SETB  1             OUTPUT IS DEFAULT                          01740000
.*                                                                      01750000
.EXPFLD2 ANOP  ,                                                        01760000
&NM      MVI   &FIELD,B'&F0&F1&F2&F3&F4&F5&F6&F7'                       01770000
.MEND    MEND  ,                                                        01780000
./ ADD NAME=FDLVAL
         MACRO ,                                       ADDED ON GP12303 00010000
&NM      FDLVAL &ATTR1,&ATTR2,&FROM=                                    00020000
.*                                                                      00030000
.*   INNER MACRO FOR FDLINE,FDLITEM, AND FDLSET TO DERIVE BIT           00040000
.*   COMBINATIONS FOR ATTRIBUTE CONTROL BYTES                           00050000
.*                                                                      00060000
.*   ATTRIBUTES:                                                        00070000
.*     COLOR, HIGH-LIGHTING, AND INPUT VS. OUTPUT                       00080000
.*     THE FIRST, AND ONLY FIRST, OPERAND MAY BE A LIST, SIMILAR TO     00090000
.*       FDLINE AND FDLITEM ENTRIES.                                    00100000
.*                                                                      00110000
.*   IN, OUT, INT(ENSE OUT),                                            00120000
.*   RED, BLUE, GREEN, CYAN, TURQ(OISE), WHITE, YELLOW                  00130000
.*   BLACK (NON-DISPLAY) - FORCES INPUT MODE                            00140000
.*                                                                      00150000
.*   THIS MACRO GENERATES NEITHER THE LINE NOR FLAG FIELDS; USE FDLINE  00160000
.*   OR FDLITEM FOR THOSE                                               00170000
.*                                                                      00180000
.*                                                                      00190000
         GBLB  &MACBIT0,&MACBIT1,&MACBIT2,&MACBIT3                      00200000
         GBLB  &MACBIT4,&MACBIT5,&MACBIT6,&MACBIT7                      00210000
         GBLB  &MACPERR,&MACPNUL                                        00220000
.*                                                                      00230000
         LCLC  &C,&D,&MOD                                               00240000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                          00250000
         LCLB  &INP,&INT,&BLACK,&UCOL,&UHI                              00260000
         LCLA  &I,&J,&K,&L,&M,&N,&NN,&NJ                        GP12357 00270000
&N       SETA  N'&SYSLIST                                               00280000
         AIF   (&N GE 1).FIELD    HAVE MULTIPLE ARGUMENTS               00290000
         MNOTE 4,'FDLVAL: NO ATTRIBUTES SUPPLIED'                       00300000
&MACPERR SETB  1                                                        00310000
&MACPNUL SETB  1                                                        00320000
         MEXIT ,                                                        00330000
.*                                                                      00340000
.FIELD   ANOP  ,                                                        00350000
&MOD     SETC  '&FROM'                                                  00360000
         AIF   ('&MOD' NE '').OKMOD                                     00370000
&MOD     SETC  'FDLVAL'                                                 00380000
.OKMOD   ANOP  ,                                                        00390000
&MACBIT0 SETB  0                                                        00400000
&MACBIT1 SETB  0                                                        00410000
&MACBIT2 SETB  0                                                        00420000
&MACBIT3 SETB  0                                                        00430000
&MACBIT4 SETB  0                                                        00440000
&MACBIT5 SETB  0                                                        00450000
&MACBIT6 SETB  0                                                        00460000
&MACBIT7 SETB  0                                                        00470000
.*                                                                      00480000
&J       SETA  0             START WITH FIRST                           00490000
&L       SETA  N'&SYSLIST    NUMBER OF ARGUMENTS                        00500000
&F0      SETB  0             MUST BE OFF                                00510000
&F1      SETB  0             MUST BE OFF (RANGE 01-3F)                  00520000
&F2      SETB  0                                                        00530000
&F3      SETB  0   DFLT 1 0  OUTPUT  ;  1 1  OUT INTENSE                00540000
&F4      SETB  0        0 1  INPUT   ;  0 0  NON-DISPLAY                00550000
&F5      SETB  0             COLOR: GREEN                               00560000
&F6      SETB  0             COLOR: RED                                 00570000
&F7      SETB  0             COLOR: BLUE                                00580000
&INP     SETB  0             INPUT                                      00590000
&INT     SETB  0             INTENSE                                    00600000
&BLACK   SETB  0             NON-DISPLAY                                00610000
.FDLOOM  AIF   (&J GE &L).EXPFLD                                        00620000
&J       SETA  &J+1                                                     00630000
&NJ      SETA  0                                                GP12357 00640000
&NN      SETA  N'&SYSLIST(&J)                                   GP12357 00650000
.FDLOOP  AIF   (&NJ GE &NN).FDLOOM                              GP12357 00660000
&NJ      SETA  &NJ+1                                            GP12357 00670000
.*                                                              GP12357 00680000
&C       SETC  '&SYSLIST(&J,&NJ)'                               GP12357 00690000
         AIF   ('&C' EQ '').FDLOOP                                      00700000
         AIF   ('&C' EQ 'REVERSE').REVERSE                              00710000
         AIF   ('&C' EQ 'BLINK').BLINK                                  00720000
         AIF   ('&C' EQ 'UNDER').UNDER                                  00730000
         AIF   ('&C' EQ 'DFLT').NULL                                    00740000
         AIF   ('&C' EQ 'BL').BLUE                                      00750000
         AIF   ('&C' EQ 'RE').RED                                       00760000
         AIF   ('&C' EQ 'PI').PINK                                      00770000
         AIF   ('&C' EQ 'MA').PINK                                      00780000
         AIF   ('&C' EQ 'GR').GREEN                                     00790000
         AIF   ('&C' EQ 'CY').TURQ                                      00800000
         AIF   ('&C' EQ 'TU').TURQ                                      00810000
         AIF   ('&C' EQ 'YE').YELLOW                                    00820000
         AIF   ('&C' EQ 'WH').WHITE                                     00830000
         AIF   ('&C' EQ 'BK').BLACK                                     00840000
         AIF   ('&C' EQ 'ND').BLACK                                     00850000
         AIF   ('&C' EQ 'IN').INPUT                                     00860000
         AIF   ('&C' EQ 'BLUE').BLUE                                    00870000
         AIF   ('&C' EQ 'RED').RED                                      00880000
         AIF   ('&C' EQ 'PINK').PINK                                    00890000
         AIF   ('&C' EQ 'MAGENTA').PINK                                 00900000
         AIF   ('&C' EQ 'GREEN').GREEN                                  00910000
         AIF   ('&C' EQ 'CYAN').TURQ                                    00920000
         AIF   ('&C' EQ 'TURQ').TURQ                                    00930000
         AIF   ('&C' EQ 'TURQOISE').TURQ                                00940000
         AIF   ('&C' EQ 'YELLOW').YELLOW                                00950000
         AIF   ('&C' EQ 'WHITE').WHITE                                  00960000
         AIF   ('&C' EQ 'BLACK').BLACK                                  00970000
         AIF   ('&C' EQ 'INPUT').INPUT                                  00980000
         AIF   ('&C' EQ 'OUT').OUTPUT                                   00990000
         AIF   ('&C' EQ 'INT').INTENSE                                  01000000
         AIF   ('&C' EQ 'INTENSE').INTENSE                              01010000
&I       SETA  &J-1                                                     01020000
       MNOTE 8,'&MOD: ATTRIBUTE &I INVALID - &C NOT A VALID ENTRY'      01030000
         AGO   .FDLOOP                                                  01040000
.BLUE    AIF   (&UCOL).DUPE                                             01050000
         AIF   (&UHI).CONFL                                             01060000
&UCOL    SETB  1                                                        01070000
&F5      SETB  0                                                        01080000
&F6      SETB  0                                                        01090000
&F7      SETB  1                                                        01100000
         AGO   .FDLOOP                                                  01110000
.*                                                                      01120000
.RED     AIF   (&UCOL).DUPE                                             01130000
         AIF   (&UHI).CONFL                                             01140000
&UCOL    SETB  1                                                        01150000
&F5      SETB  0                                                        01160000
&F6      SETB  1                                                        01170000
&F7      SETB  0                                                        01180000
         AGO   .FDLOOP                                                  01190000
.*                                                                      01200000
.PINK    AIF   (&UCOL).DUPE                                             01210000
         AIF   (&UHI).CONFL                                             01220000
&UCOL    SETB  1                                                        01230000
&F5      SETB  0                                                        01240000
&F6      SETB  1                                                        01250000
&F7      SETB  1                                                        01260000
         AGO   .FDLOOP                                                  01270000
.*                                                                      01280000
.GREEN   AIF   (&UCOL).DUPE                                             01290000
         AIF   (&UHI).CONFL                                             01300000
&UCOL    SETB  1                                                        01310000
&F5      SETB  1                                                        01320000
&F6      SETB  0                                                        01330000
&F7      SETB  0                                                        01340000
         AGO   .FDLOOP                                                  01350000
.*                                                                      01360000
.TURQ    AIF   (&UCOL).DUPE                                             01370000
         AIF   (&UHI).CONFL                                             01380000
&UCOL    SETB  1                                                        01390000
&F5      SETB  1                                                        01400000
&F6      SETB  0                                                        01410000
&F7      SETB  1                                                        01420000
         AGO   .FDLOOP                                                  01430000
.*                                                                      01440000
.YELLOW  AIF   (&UCOL).DUPE                                             01450000
         AIF   (&UHI).CONFL                                             01460000
&UCOL    SETB  1                                                        01470000
&F5      SETB  1                                                        01480000
&F6      SETB  1                                                        01490000
&F7      SETB  0                                                        01500000
         AGO   .FDLOOP                                                  01510000
.*                                                                      01520000
.WHITE   AIF   (&UCOL).DUPE                                             01530000
         AIF   (&UHI).CONFL                                             01540000
&UCOL    SETB  1                                                        01550000
&F5      SETB  1                                                        01560000
&F6      SETB  1                                                        01570000
&F7      SETB  1                                                        01580000
         AGO   .FDLOOP                                                  01590000
.*                                                                      01600000
.BLACK   AIF   (&UCOL).DUPE                                             01610000
         AIF   (&UHI).CONFL                                             01620000
&UCOL    SETB  1                                                        01630000
&F3      SETB  0                                                        01640000
&F4      SETB  0                                                        01650000
&F5      SETB  0                                                        01660000
&F6      SETB  0                                                        01670000
&F7      SETB  1             FORCE NON-ZERO                             01680000
&BLACK   SETB  1                                                        01690000
         AGO   .FDLOOP                                                  01700000
.*                                                                      01710000
.BLINK   AIF   (&UCOL).CONFL                                            01720000
&UHI     SETB  1                                                        01730000
&F2      SETB  1                                                        01740000
&F7      SETB  1                                                        01750000
         AGO   .FDLOOP                                                  01760000
.*                                                                      01770000
.REVERSE AIF   (&UCOL).CONFL                                            01780000
&UHI     SETB  1                                                        01790000
&F2      SETB  1                                                        01800000
&F6      SETB  1                                                        01810000
         AGO   .FDLOOP                                                  01820000
.*                                                                      01830000
.UNDER   AIF   (&UCOL).CONFL                                            01840000
&UHI     SETB  1                                                        01850000
&F2      SETB  1                                                        01860000
&F5      SETB  1                                                        01870000
         AGO   .FDLOOP                                                  01880000
.*                                                                      01890000
.NULL    AIF   (&UCOL).CONFL                                            01900000
&UHI     SETB  1                                                        01910000
&F2      SETB  1                                                        01920000
&F5      SETB  0                                                        01930000
&F6      SETB  0                                                        01940000
&F7      SETB  0                                                        01950000
         AGO   .FDLOOP                                                  01960000
.*                                                                      01970000
.INPUT   ANOP                                                           01980000
&F3      SETB  0                                                        01990000
&F4      SETB  1                                                        02000000
&INP     SETB  1                                                        02010000
         AIF   (&INT).CONFII                                            02020000
         AGO   .FDLOOP                                                  02030000
.*                                                                      02040000
.OUTPUT  ANOP  ,                                                        02050000
&F3      SETB  1                                                        02060000
&F4      SETB  0                                                        02070000
         AGO   .FDLOOP                                                  02080000
.*                                                                      02090000
.INTENSE ANOP  ,                                                        02100000
&F4      SETB  1                                                        02110000
&INT     SETB  1                                                        02120000
         AIF   (&INP).CONFII                                            02130000
&F3      SETB  1                                                        02140000
         AGO   .FDLOOP                                                  02150000
.CONFII  MNOTE *,'&MOD: INTENSE INPUT NOT SUPPORTED'                    02160000
         AGO   .FDLOOP                                                  02170000
.*                                                                      02180000
.CONFL MNOTE 8,'&MOD: CONFLICT - COLOR AND HIGH-LIGHTING NOT SUPPORTED' 02190000
         AGO   .FDLOOP                                                  02200000
.*                                                                      02210000
.DUPE    MNOTE 8,'&MOD: ERROR - COLOR PREVIOUSLY SPECIFIED'             02220000
         AGO   .FDLOOP                                                  02230000
.*                                                                      02240000
.EXPFLD  AIF   (NOT &BLACK).EXPFLD1                                     02250000
&F4      SETB  0             FORCED INPUT MODE                          02260000
         AIF   (NOT &F3).EXPFLD2                                        02270000
         MNOTE 4,'&MOD: CONFLICTING NON-DISPLAY AND OUTPUT ATTR &I'     02280000
.EXPFLD1 AIF   (&F3 OR &F4).EXPFLD2                                     02290000
&F3      SETB  1             OUTPUT IS DEFAULT                          02300000
.*                                                                      02310000
.EXPFLD2 ANOP  ,                                                        02320000
&MACBIT0 SETB  (&F0)                                                    02330000
&MACBIT1 SETB  (&F1)                                                    02340000
&MACBIT2 SETB  (&F2)                                                    02350000
&MACBIT3 SETB  (&F3)                                                    02360000
&MACBIT4 SETB  (&F4)                                                    02370000
&MACBIT5 SETB  (&F5)                                                    02380000
&MACBIT6 SETB  (&F6)                                                    02390000
&MACBIT7 SETB  (&F7)                                                    02400000
 MNOTE 0,'&MOD: &F0 &F1 &F2 &F3 &F4 &F5 &F6 &F7 '                       02410000
.MEND    MEND  ,                                                        02420000
./ ADD NAME=FDMODE
         MACRO                                                          00010000
&NM      FDMODE &S                                    ADDED ON   92307  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C,&B1,&B2                                            00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS AIF   ('&S' EQ '24' OR '&S' EQ 'AM24').EXPAND                  00140000
&B1      SETA  1              SET 31-BIT ADDRESSING MODE                00150000
         AIF   ('&S' EQ '31' OR '&S' EQ 'AM31').EXPAND                  00160000
         MNOTE 8,'UNSUPPORTED MODE VALUE &S '                           00170000
         MEXIT ,                                                        00180000
.EXPAND  ANOP  ,                                                        00190000
&T       SETA  8+16                                                     00200000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(&B1,&B2)                             00210000
         MEND  ,                                                        00220000
./ ADD NAME=FDOPT
         MACRO                                                          00010000
&NM      FDOPT &S,&SBA=,&CUR=,&CC=,&IND=                         81270  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &C,&I,&J,&K,&N                                           00040000
         LCLA  &T,&E,&O7,&O9,&WCC                                       00050000
         LCLC  &SB1,&CU1,&L,&FDCHN,&COM1,&COM2                          00060000
         LCLB  &NOP,&OPT,&SKPLEN                                        00070000
         LCLB  &NL,&WCCP,&SBAP,&CURP,&CCP,&INDP,&ALARM,&O79      81270  00080000
         LCLB  &BLUE,&GREEN,&PINK,&RED,&TURQ,&WHITE,&YELLOW,&C1,&C2,&C3 00090000
         LCLB  &UNDER,&BLINK,&REVERSE,&MONO,&MDT                 87313  00100000
         LCLB  &INTENSE,&DETECT,&NONDISP,&NUMERIC,&SKIP,&PROTECT        00110000
         LCLB  &DEFAULT,&PREV                                           00120000
&FDCNTR  SETA  &FDCNTR+1                                                00130000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00140000
&C       SETA  &FDCNTR+1                                                00150000
         AIF   ('&NM' EQ '').NONAME                                     00160000
&NM      EQU   *                                                        00170000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS               00180000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00190000
         MEXIT ,                                                        00200000
.PROCESS ANOP  ,                                                        00210000
&I       SETA  N'&SYSLIST                                               00220000
&J       SETA  0                                                        00230000
&SB1     SETC  '0'                                                      00240000
&CU1     SETC  '0'                                                      00250000
.NOLIT   AIF   (&J GE &I).CHECK                                         00260000
&J       SETA  &J+1                                                     00270000
&L       SETC  '&SYSLIST(&J)'                                           00280000
         AIF   ('&L' EQ '').NOLIT                                       00290000
&NOP     SETB  (&NOP  OR '&L' EQ 'NOP')                                 00300000
&NL      SETB  (&NL  OR '&L' EQ 'NL' OR '&L' EQ 'NEWLINE')              00310000
&ALARM    SETB  (&ALARM OR '&L' EQ 'ALARM')                             00320000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BLUE')                                00330000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GREEN')                              00340000
&PINK    SETB  (&PINK OR '&L' EQ 'PINK')                                00350000
&RED     SETB  (&RED  OR '&L' EQ 'RED')                                 00360000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TURQ' OR '&L' EQ 'CYAN')      90326  00370000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WHITE')                              00380000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YELLOW')                            00390000
&MONO    SETB  (&MONO OR '&L' EQ 'MONO')                         87313  00400000
&UNDER   SETB  (&UNDER OR '&L' EQ 'UL' OR '&L' EQ 'UNDER')              00410000
&BLINK   SETB  (&BLINK OR '&L' EQ 'BLINK')                              00420000
&REVERSE SETB  (&REVERSE OR '&L' EQ 'REVERSE')                          00430000
&INTENSE SETB  (&INTENSE OR '&L' EQ 'INTENSE' OR '&L' EQ 'INT')         00440000
&DETECT  SETB  (&DETECT OR '&L' EQ 'DETECT' OR '&L' EQ 'LP')            00450000
&NONDISP SETB  (&NONDISP OR '&L' EQ 'NONDISP' OR '&L' EQ 'NDISP')       00460000
&NUMERIC SETB  (&NUMERIC OR '&L' EQ 'NUMERIC' OR '&L' EQ 'NUM')         00470000
&SKIP    SETB  (&SKIP OR '&L' EQ 'SKIP')                                00480000
&PROTECT SETB  (&PROTECT OR '&L' EQ 'PROTECT')                          00490000
&MDT     SETB  (&MDT OR '&L' EQ 'MDT')                           87313  00500000
&DEFAULT SETB  (&DEFAULT OR '&L' EQ 'DEFAULT' OR '&L' EQ 'DFLT')        00510000
         AGO   .NOLIT                                                   00520000
.CHECK   ANOP  ,                                                        00530000
         AIF   ('&SBA' EQ '').NOSBA                                     00540000
         AIF   (N'&SBA EQ 2).SBA2                                       00550000
         AIF   (N'&SBA NE 1).BADSBA                                     00560000
&SBAP    SETB  1                                                        00570000
&SB1     SETC  '254*256+254'                                            00580000
         AIF   ('&SBA(1)' EQ '*').NOSBA                                 00590000
&SB1     SETC  '&SBA'                                                   00600000
         AGO   .NOSBA                                                   00610000
.BADSBA  MNOTE 4,'INVALID SBA= FIELD'                                   00620000
         AGO   .NOSBA                                                   00630000
.SBA2    ANOP  ,                                                        00640000
&COM1    SETC  '&SBA(1)'                                                00650000
&COM2    SETC  '&SBA(2)'                                                00660000
         AGO   .ADDCOM                                                  00670000
.RETSBA  ANOP  ,                                                        00680000
&SBAP    SETB  1             SET SBA PRESENT                            00690000
&SB1     SETC  '&CU1'                                                   00700000
&CU1     SETC  '0'                                                      00710000
.NOSBA   AIF   ('&CUR' EQ '').NOCUR                                     00720000
&CURP    SETB  1                                                        00730000
         AIF   (N'&CUR EQ 2).CUR2                                       00740000
         AIF   (N'&CUR NE 1).BADCUR                                     00750000
&CU1     SETC  '254*256+254'                                            00760000
         AIF   ('&CUR(1)' EQ '*').NOCUR                                 00770000
         AIF   ('&CUR(1)' EQ '0').BADCUR                                00780000
&CU1     SETC  '&CUR'                                                   00790000
         AGO   .NOCUR                                                   00800000
.ADDERR  AIF   (NOT &CURP).BADSBA                                       00810000
.BADCUR  MNOTE 4,'INVALID CUR= FIELD'                                   00820000
         AGO   .NOCUR                                                   00830000
.CUR2    ANOP  ,                                                        00840000
&COM1    SETC  '&CUR(1)'                                                00850000
&COM2    SETC  '&CUR(2)'                                                00860000
.ADDCOM  ANOP  ,                                                        00870000
&CU1     SETC  '254'                                                    00880000
         AIF   ('&COM1' EQ 'NULL' OR '&COM1' EQ '*').AD1COM             00890000
&CU1     SETC  '255'                                                    00900000
         AIF   ('&COM1' EQ 'NEXT' OR '&COM1' EQ '+').AD1COM             00910000
&CU1     SETC  '253'                                                    00920000
         AIF   ('&COM1' EQ 'PREV' OR '&COM1' EQ '-').AD1COM             00930000
&CU1     SETC  '253'.'&COM1'                                            00940000
         AIF   (K'&COM1 LT 1).ADDERR                                    00950000
         AIF   ('&COM1'(1,1) EQ '-').AD1COM                             00960000
         AIF   ('&COM1' EQ '0').ADDERR                                  00970000
&CU1     SETC  '&COM1'.'+63'                                            00980000
.AD1COM  ANOP  ,                                                        00990000
&COM1    SETC  '254'                                                    01000000
         AIF   ('&COM2' EQ 'NULL' OR '&COM2' EQ '*').AD2COM             01010000
&COM1    SETC  '255'                                                    01020000
         AIF   ('&COM2' EQ 'NEXT' OR '&COM2' EQ '+').AD2COM             01030000
&COM1    SETC  '253'                                                    01040000
         AIF   ('&COM2' EQ 'PREV' OR '&COM2' EQ '-').AD2COM             01050000
&COM1    SETC  '253'.'&COM2'                                            01060000
         AIF   (K'&COM2 LT 1).ADDERR                                    01070000
         AIF   ('&COM2'(1,1) EQ '-').AD2COM                             01080000
         AIF   ('&COM2' EQ '0').ADDERR                                  01090000
&COM1    SETC  '&COM2'.'-1'                                             01100000
.AD2COM  ANOP  ,                                                        01110000
&CU1     SETC  '('.'&CU1'.')*256+'.'&COM1'                              01120000
         AIF   (NOT &CURP).RETSBA                                       01130000
.NOCUR   AIF   (T'&CC EQ 'O').NOCC                               81201  01140000
         AIF   (NOT &CURP).SETCC                                 81201  01150000
         MNOTE 4,'CC= AND CUR= ARE MUTUALLY EXCLUSIVE'           81201  01160000
         AGO   .NOCC                                             81201  01170000
.SETCC   ANOP  ,                                                 81201  01180000
&CCP     SETB  1                                                 81201  01190000
.NOCC    AIF   (T'&IND EQ 'O').NOIND                             81270  01200000
         AIF   (NOT &CURP).SETIND                                81270  01210000
         MNOTE 4,'IND= AND CUR= ARE MUTUALLY EXCLUSIVE'          81270  01220000
         AGO   .NOIND                                            81270  01230000
.SETIND  ANOP  ,                                                 81270  01240000
&INDP    SETB  1                                                 81270  01250000
.NOIND   ANOP  ,                                                 81270  01260000
&OPT     SETB  1                                                        01270000
&T       SETA  32*&OPT+64*&NOP                                          01280000
&WCC     SETA  4*&ALARM                                                 01290000
&WCCP    SETB  (&ALARM)                                                 01300000
&E      SETA 128*&NL+64*&WCCP+32*&SBAP+8*&CURP+&CCP+4*&INDP      81270  01310000
&O7      SETA  128*&DEFAULT+64*&PREV+&MDT                        87313  01320000
&PROTECT SETB  (&PROTECT OR &SKIP)                                      01330000
&NUMERIC SETB  (&NUMERIC OR &SKIP)                                      01340000
&DETECT  SETB  (&DETECT  OR &NONDISP)                                   01350000
&INTENSE SETB  (&INTENSE OR &NONDISP)                                   01360000
&O7      SETA  &O7+32*&PROTECT+16*&NUMERIC+8*&INTENSE+4*&DETECT         01370000
&C1      SETB  (&GREEN OR &TURQ OR &WHITE OR &YELLOW)                   01380000
&C2      SETB  (&RED OR &PINK OR &WHITE OR &YELLOW)                     01390000
&C3      SETB  (&BLUE OR &PINK OR &TURQ OR &WHITE)                      01400000
&O9      SETA  64*&C1+32*&C2+16*&C3+8*&MONO+4*&UNDER+2*&REVERSE+&BLINK  01410000
&O79     SETB  (&O7 NE 0 OR &O9 NE 0)                                   01420000
&E       SETA  &E+2*&O79                                                01430000
         AIF   (&CCP).EXPCC                                      81201  01440000
         AIF   (&CURP).EXPSC                                     81270  01450000
         AIF   (&INDP).EXPSI                                     81270  01460000
&FDCHN   DC    AL1(ZFD&C-*,&T,&E,&O9,&O7,&WCC),AL2(&SB1)                01470000
         MEXIT ,                                                 81270  01480000
.EXPSI   ANOP  ,                                                 81270  01490000
&FDCHN   DC    AL1(ZFD&C-*,&T,&E,&O9,&O7,&WCC),AL2(&SB1),AL1(0,&IND)    01500000
         MEXIT ,                                                 81270  01510000
.EXPSC   ANOP  ,                                                 81270  01520000
&FDCHN   DC    AL1(ZFD&C-*,&T,&E,&O9,&O7,&WCC),AL2(&SB1,&CU1)           01530000
         MEXIT ,                                                 81201  01540000
.EXPCC   AIF   (&INDP).EXPCI                                     81270  01550000
&FDCHN   DC    AL1(ZFD&C-*,&T,&E,&O9,&O7,&WCC),AL2(&SB1),AL1(&CC)       01560000
         MEXIT ,                                                 81270  01570000
.EXPCI   ANOP  ,                                                 81270  01580000
&FDCHN   DC    AL1(ZFD&C-*,&T,&E,&O9,&O7,&WCC),AL2(&SB1),AL1(&CC,&IND)  01590000
         MEND  ,                                                        01600000
./ ADD NAME=FDPRT
         MACRO                                                          00010000
&NM      FDPRT &STR,&EXLEN,&VALUES,&LEN=0,                             *00020000
               &LABEL=,&LABOPT=PAD,&KEEP=0                       85119  00030000
.*                                                                      00040000
.*       PROVIDED FOR COMPATIBILITY WITH GOSSIP FD MACROS, BUT USING    00050000
.*       SHORTER DATA SECTION TO SAVE STORAGE                           00060000
.*         INTENDED FOR PRINT PROCESSING                                00070000
.*                                                                      00080000
         GBLA  &FDCNTR                                                  00090000
         LCLA  &C,&I,&J,&K,&N,&Z                                 85119  00100000
         LCLA  &T,&E,&O7,&O9,&DATA                                      00110000
         LCLC  &L,&FDCHAIN,&W                                           00120000
         LCLB  &NOP,&IN,&SKPLEN,&INDAD,&CNLOCK                   92086  00130000
         LCLB  &NL,&DEBL,&DEBR,&DEBZ,&PADL,&PADR,&RADJ,&UP              00140000
         LCLB  &BLUE,&GREEN,&PINK,&RED,&TURQ,&WHITE,&YELLOW,&C1,&C2,&C3 00150000
         LCLB  &UNDER,&BLINK,&REVERSE,&MONO,&MDT                 87313  00160000
         LCLB  &INTENSE,&DETECT,&NONDISP,&NUMERIC,&SKIP,&PROTECT        00170000
         LCLB  &DEFAULT,&PREV                                           00180000
&FDCNTR  SETA  &FDCNTR+1                                                00190000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                          00200000
&C       SETA  &FDCNTR+1                                                00210000
         AIF   ('&NM' EQ '').NONAME                                     00220000
&NM      EQU   *                                                        00230000
.NONAME  AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00240000
&FDCHAIN DC    AL1(0)        END OF FD LIST                             00250000
         MEXIT ,                                                        00260000
.PROCESS AIF   (T'&LABEL EQ 'O').PROCEED                         85118  00270000
         AIF   ('&KEEP' EQ '' OR '&KEEP' EQ '0').DEFKEEP         85119  00280000
&FDCHAIN DC    AL1(ZFD&C-*,30,0,&KEEP)  FDKEEP                   85119  00290000
         AGO   .DEFKCOM                                          85119  00300000
.DEFKEEP ANOP  ,                                                 85119  00310000
&Z       SETA  &C+1                                              85119  00320000
&FDCHAIN DC    AL1(ZFD&C-*,30,0,12+ZFD&Z-*)  FDKEEP              85119  00330000
.DEFKCOM ANOP  ,                                                 85119  00340000
&FDCNTR  SETA  &FDCNTR+1                                         85119  00350000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                   85119  00360000
&C       SETA  &FDCNTR+1                                         85119  00370000
&I       SETA  12            DEFAULT PADL+PADR                   85118  00380000
         AIF   ('&LABOPT' EQ 'PAD').PROPAD                       85119  00390000
         AIF   ('&LABOPT' EQ '' OR '&LABOPT' EQ '0').PADNONE     85119  00400000
&I       SETA  8                                                 85118  00410000
         AIF   ('&LABOPT' EQ 'PADL').PROPAD                      85118  00420000
&I       SETA  4                                                 85118  00430000
         AIF   ('&LABOPT' EQ 'PADR').PROPAD                      85118  00440000
         MNOTE 4,'UNSUPPORTED LABOPT=&LABOPT'                    85118  00450000
.PADNONE ANOP  ,                                                 85119  00460000
&I       SETA  0                                                 85119  00470000
.PROPAD  AIF   ('&LABEL'(1,1) NE '''').LABNQ                     85118  00480000
&FDCHAIN DC    AL1(ZFD&C-*,48,&I,129,0,ZFD&C-*-1),C&LABEL        85118  00490000
         AGO   .PROCOM                                           85118  00500000
.LABNQ   ANOP  ,                                                 85118  00510000
&FDCHAIN DC    AL1(ZFD&C-*,48,&I,129,0,ZFD&C-*-1),C'&LABEL'      85118  00520000
.PROCOM  ANOP  ,                                                 85118  00530000
&FDCNTR  SETA  &FDCNTR+1                                         85118  00540000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                   85118  00550000
&C       SETA  &FDCNTR+1                                         85118  00560000
.PROCEED ANOP  ,                                                 85118  00570000
&I       SETA  N'&SYSLIST                                               00580000
&J       SETA  1                                                        00590000
         AIF   ('&STR'(1,1) NE '''').NOLIT                              00600000
&SKPLEN  SETB  1                                                        00610000
.NOLIT   AIF   (&J GE &I).CHECK                                         00620000
&J       SETA  &J+1                                                     00630000
&L       SETC  '&SYSLIST(&J)'                                           00640000
         AIF   ('&L' EQ '').NOLIT                                       00650000
&NOP     SETB  (&NOP  OR '&L' EQ 'NOP')                                 00660000
&CNLOCK  SETB  (&CNLOCK OR '&L' EQ 'LOCK' OR '&L' EQ 'LOCKED')   92086  00670000
&NL      SETB  (&NL  OR '&L' EQ 'NL' OR '&L' EQ 'NEWLINE')              00680000
&DEBL SETB (&DEBL OR '&L' EQ 'DEBL' OR '&L' EQ 'DEB' OR '&L' EQ 'DEBZ') 00690000
&DEBR    SETB  (&DEBR OR '&L' EQ 'DEBR' OR '&L' EQ 'DEB')               00700000
&DEBZ    SETB  (&DEBZ OR '&L' EQ 'DEBZ')                                00710000
&PADL    SETB  (&PADL OR '&L' EQ 'PADL' OR '&L' EQ 'PAD')               00720000
&PADR    SETB  (&PADR OR '&L' EQ 'PADR' OR '&L' EQ 'PAD')               00730000
&RADJ    SETB  (&RADJ OR '&L' EQ 'RADJ')                                00740000
&UP    SETB  (&UP OR '&L' EQ 'UP')                                      00750000
&UP      SETB  (&UP OR '&L' EQ 'UPPER')                                 00760000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BLUE')                                00770000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GREEN')                              00780000
&PINK    SETB  (&PINK OR '&L' EQ 'PINK')                                00790000
&RED     SETB  (&RED  OR '&L' EQ 'RED')                                 00800000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TURQ')                               00810000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WHITE')                              00820000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YELLOW')                            00830000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BL')                          GP10240 00840000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GR')                         GP10240 00850000
&PINK    SETB  (&PINK OR '&L' EQ 'PI')                          GP10240 00860000
&RED     SETB  (&RED  OR '&L' EQ 'RE')                          GP10240 00870000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TU' OR '&L' EQ 'CY')         GP10240 00880000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WH')                         GP10240 00890000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YE')                        GP10240 00900000
&MONO    SETB  (&MONO OR '&L' EQ 'MONO')                         87313  00910000
&UNDER   SETB  (&UNDER OR '&L' EQ 'UL' OR '&L' EQ 'UNDER')              00920000
&BLINK   SETB  (&BLINK OR '&L' EQ 'BLINK')                              00930000
&REVERSE SETB  (&REVERSE OR '&L' EQ 'REVERSE')                          00940000
&INTENSE SETB  (&INTENSE OR '&L' EQ 'INTENSE' OR '&L' EQ 'INT')         00950000
&DETECT  SETB  (&DETECT OR '&L' EQ 'DETECT' OR '&L' EQ 'LP')            00960000
&NONDISP SETB  (&NONDISP OR '&L' EQ 'NONDISP' OR '&L' EQ 'NDISP')       00970000
&NUMERIC SETB  (&NUMERIC OR '&L' EQ 'NUMERIC' OR '&L' EQ 'NUM')         00980000
&SKIP    SETB  (&SKIP OR '&L' EQ 'SKIP')                                00990000
&PROTECT SETB  (&PROTECT OR '&L' EQ 'PROTECT')                          01000000
&MDT     SETB  (&MDT OR '&L' EQ 'MDT')                           87313  01010000
&DEFAULT SETB  (&DEFAULT OR '&L' EQ 'DEFAULT' OR '&L' EQ 'DFLT')        01020000
&PREV    SETB  (&PREV OR '&L' EQ 'PREVIOUS' OR '&L' EQ 'PREV')          01030000
&INDAD   SETB  (&INDAD OR '&L' EQ '*')                           81270  01040000
         AIF   (&DATA NE 0).NOLIT                                       01050000
         AIF   (K'&L GT 4).OMLEN                                        01060000
&K       SETA  0                                                        01070000
&L       SETC  '&L'.'    '                                              01080000
&L       SETC  '&L'(1,4)                                                01090000
         AIF   ('&L' NE 'X   ').DT                              GP10240 01100000
&L       SETC  'HEX '                                           GP10240 01110000
.DT      AIF   (&K GE 35).OMLEN                                 GP07004 01120000
&K       SETA  &K+1                                                     01130000
&N       SETA  (&K-1)*4+1                                               01140000
&W      SETC  'CHARCON ASISADDRHEX SHEXBIT I   $I  D   $D  F   TIMETIMD*01150000
               DATEDATJWDAYMTH DAY MD  DMY MDY CHEXICM ICN IZ  IA  DCM *01160000
               DCN DZ  DA  EDATDATDCCHHTTR '(&N,4)              GP07004 01170000
         AIF   ('&L' NE '&W').DT                                        01180000
&DATA    SETA  &K                                                       01190000
         AIF   (&J EQ 2).OMSET                                          01200000
         AGO   .NOLIT                                                   01210000
.OMLEN   AIF   (&J NE 2 OR &SKPLEN).NOLIT                               01220000
 AIF (&NOP OR &IN OR &NL OR &DEBL OR &DEBR OR &DEBZ OR &PADL).OMSET     01230000
 AIF (&UP OR &PADR OR &RADJ OR &BLUE OR &GREEN OR &PINK OR &RED).OMSET  01240000
 AIF (&TURQ OR &WHITE OR &YELLOW OR &UNDER OR &BLINK).OMSET             01250000
 AIF (&REVERSE OR &INTENSE OR &DETECT OR &NONDISP OR &INDAD).OMSET      01260000
 AIF (&NUMERIC OR &SKIP OR &PROTECT OR &DEFAULT OR &PREV).OMSET         01270000
         AIF   (&MDT OR &MONO OR &CNLOCK).OMSET                  92086  01280000
         AGO   .NOLIT                                                   01290000
.OMSET   ANOP  ,             EXPLICIT LENGTH OMITTED                    01300000
&SKPLEN  SETB  1             USE L'                                     01310000
         AGO   .NOLIT                                                   01320000
.CHECK   ANOP  ,                                                        01330000
&T       SETA  64*&NOP+48+&INDAD+8*&CNLOCK                       92086  01340000
&E SETA 128*&NL+64*&DEBL+32*&DEBR+16*&DEBZ+8*&PADL+4*&PADR+2*&RADJ+&UP  01350000
&O7      SETA  128*&DEFAULT+64*&PREV+&MDT                        87313  01360000
&PROTECT SETB  (&PROTECT OR &SKIP)                                      01370000
&NUMERIC SETB  (&NUMERIC OR &SKIP)                                      01380000
&DETECT  SETB  (&DETECT  OR &NONDISP)                                   01390000
&INTENSE SETB  (&INTENSE OR &NONDISP)                                   01400000
&O7      SETA  &O7+32*&PROTECT+16*&NUMERIC+8*&INTENSE+4*&DETECT         01410000
&C1      SETB  (&GREEN OR &TURQ OR &WHITE OR &YELLOW)                   01420000
&C2      SETB  (&RED OR &PINK OR &WHITE OR &YELLOW)                     01430000
&C3      SETB  (&BLUE OR &PINK OR &TURQ OR &WHITE)                      01440000
&O9      SETA  64*&C1+32*&C2+16*&C3+8*&MONO+4*&UNDER+2*&REVERSE+&BLINK  01450000
         AIF   ('&STR'(1,1) EQ '''').CSTRING                            01460000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).EXLEN                   01470000
&L       SETC  'L'''                                                    01480000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&L&STR),SL2(&STR)              01490000
         MEXIT                                                          01500000
.EXLEN   AIF   (K'&EXLEN LT 2).NORLEN                            81270  01510000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NORLEN    01520000
&T       SETA  &T+2          ILEN IS REGISTER FORM               81270  01530000
.NORLEN  ANOP  ,                                                 81270  01540000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&EXLEN),SL2(&STR)              01550000
         MEXIT ,                                                        01560000
.CSTRING ANOP  ,                                                        01570000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,129,&LEN,ZFD&C-*-1),C&STR                 01580000
         MEND  ,                                                        01590000
./ ADD NAME=FDREPT
         MACRO                                                          00010000
&NM      FDREPT &N,&S                                   ADDED ON 82109  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&N' NE 'END' AND '&N' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS ANOP  ,                                                        00140000
&T       SETA  30                                                       00150000
         AIF   (T'&S EQ 'O').BLANK                                      00160000
         AIF   (T'&N EQ 'O').DFLT                                       00170000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(&N,&S)                               00180000
         MEXIT ,                                                        00190000
.DFLT    ANOP  ,                                                        00200000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(1,&S)                                00210000
         MEXIT ,                                                        00220000
.BLANK   ANOP  ,                                                        00230000
         AIF   (T'&N EQ 'O').BLAND                                      00240000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(&N,C' ')                             00250000
         MEXIT ,                                                        00260000
.BLAND   ANOP  ,                                                        00270000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(1,C' ')                              00280000
         MEND  ,                                                        00290000
./ ADD NAME=FDROOM
         MACRO                                                          00010000
&NM      FDROOM &N                                      ADDED ON 82109  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&N' NE 'END' AND '&N' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS ANOP  ,                                                        00140000
&T       SETA  30                                                       00150000
         AIF   (T'&N EQ 'O').DFLT                                       00160000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(0,&N)                                00170000
         MEXIT ,                                                        00180000
.DFLT    ANOP  ,                                                        00190000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(0,1)                                 00200000
         MEND  ,                                                        00210000
./ ADD NAME=FDSCAN
         MACRO ,                                                        00010000
&NM      FDSCAN &STR,&FDW,&OPTS,&MOVE=                           87312  00020000
.*                                                                      00030000
.*       PROVIDED FOR COMPATIBILITY WITH 3270 FULL-SCREEN FACILITY      00040000
.*                                                                      00050000
         LCLA  &C,&I,&J,&K,&N,&Z                                        00060000
         LCLB  &MORE,&POS,&KEY,&REQ,&ABBR                        87314  00070000
         AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00080000
&NM      DC    X'FF00'       END OF LIST                                00090000
         MEXIT ,                                                        00100000
.PROCESS AIF   ('&MOVE' EQ '').NOMORE                                   00110000
&MORE    SETB  1                                                        00120000
.NOMORE  ANOP  ,                                                        00130000
&N       SETA  N'&SYSLIST                                               00140000
&J       SETA  &N-2                                              87360  00150000
&I       SETA  3                                                        00160000
.OPTLOOP AIF   (&I GT &N).PROCEED                                       00170000
&POS     SETB  (&POS OR '&SYSLIST(&I)' EQ 'POS')                        00180000
&KEY     SETB  (&KEY OR '&SYSLIST(&I)' EQ 'KEY')                        00190000
&ABBR    SETB  (&ABBR OR '&SYSLIST(&I)' EQ 'LONG')                      00200000
&REQ     SETB  (&REQ OR '&SYSLIST(&I)' EQ 'REQ')                 87314  00210000
&POS     SETB  (&POS OR '&SYSLIST(&I)' EQ 'POS2')  CHAINED POS   87360  00220000
&KEY     SETB  (&KEY OR '&SYSLIST(&I)' EQ 'POS2') CHAINED POS    87360  00230000
&I       SETA  &I+1                                                     00240000
         AIF   ('&SYSLIST(&I-1)' NE 'POS2').OPTLOOP              87360  00250000
&J       SETA  &J+1          FINAGLE                             87360  00260000
         AGO   .OPTLOOP                                                 00270000
.PROCEED AIF   (&J NE (&POS+&KEY+&ABBR+&REQ)).PARMA              87360  00280000
&C       SETA  128*&MORE+64*&POS+32*&KEY+2*&REQ+&ABBR            87314  00290000
.* &K       SETA  0             DEFAULT FOR POSITIONAL           87360  00300000
.*       AIF   (&POS).COMLEN  NOP'D FOR SCRMARK ERRMSG OPTION    87360  00310000
         AIF   ('&STR' EQ '').PARMA                                     00320000
&K       SETA  K'&STR-1                                                 00330000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00340000
&I       SETA  2                                                        00350000
&J       SETA  &K-1                                                     00360000
&K       SETA  &J                                                       00370000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00380000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00390000
&I       SETA  &I+1                                                     00400000
         AGO   .INC                                                     00410000
.SK2     ANOP  ,                                                        00420000
&I       SETA  &I+2                                                     00430000
&K       SETA  &K-1                                                     00440000
.INC     AIF   (&I LE &J).LOOP                                          00450000
&K       SETA  &K-1                                                     00460000
         AIF   (&K GE 0).COMLEN                                         00470000
.PARMA   MNOTE 8,'MISSING OR CONFLICTING PARAMETERS'                    00480000
         MEXIT ,                                                        00490000
.COMLEN  AIF   ('&STR'(1,1) EQ '''').TOAP                               00500000
&NM      DC    AL1(&K,&C),SL2(&FDW),CL(&K+1)'&STR'                      00510000
         AGO   .MORE                                                    00520000
.TOAP    ANOP  ,                                                        00530000
&NM      DC    AL1(&K,&C),SL2(&FDW),CL(&K+1)&STR                        00540000
.MORE    AIF   ('&MOVE' EQ '').MEND                                     00550000
&K       SETA  K'&MOVE-1                                                00560000
         AIF   ('&MOVE'(1,1) EQ '''').MORQUO                            00570000
         DC    AL1(&K),CL(&K+1)'&MOVE '                                 00580000
         AGO   .MEND                                                    00590000
.MORQUO  ANOP  ,                                                        00600000
&I       SETA  2                                                        00610000
&J       SETA  &K-1                                                     00620000
&K       SETA  &J                                                       00630000
.MOOP    AIF   ('&MOVE'(&I,2) EQ '''''').MK2                            00640000
         AIF   ('&MOVE'(&I,2) EQ '&&').MK2                              00650000
&I       SETA  &I+1                                                     00660000
         AGO   .MNC                                                     00670000
.MK2     ANOP  ,                                                        00680000
&I       SETA  &I+2                                                     00690000
&K       SETA  &K-1                                                     00700000
.MNC     AIF   (&I LE &J).MOOP                                          00710000
&K       SETA  &K-1                                                     00720000
         AIF   (&K LT 0).MEND                                           00730000
         DC    AL1(&K),CL(&K+1)&MOVE                                    00740000
.MEND    MEND  ,                                                        00750000
./ ADD NAME=FDSECT
         MACRO                                                          00010000
&NM      FDSECT ,                                                       00020000
         GBLB  &MAPFDS                                                  00030000
         AIF   (&MAPFDS).MEND                                           00040000
&MAPFDS  SETB  1                                                        00050000
         AIF   ('&NM' NE '').EXNAME                                     00060000
FDSECT   DSECT ,             FD ITEM MAPPING                            00070000
         AGO   .COMNAME                                                 00080000
.EXNAME  ANOP  ,                                                        00090000
&NM      DSECT ,             FD ITEM MAPPING                            00100000
.COMNAME ANOP  ,                                                        00110000
FDLINK   DS    AL1           LENGTH TO NEXT ENTRY OR 0                  00120000
FDTYPE   DS    X             ENTRY TYPE (IN, OUT, NOP)                  00130000
FDFNOP   EQU   X'40'           IGNORE THIS ENTRY                        00140000
FDFIN    EQU   X'80'           INPUT ENTRY                              00150000
FDFCIN   EQU   X'08'           FDIN IS LOCKED (COND. INPUT)      87156  00160000
FDFPRT   EQU   X'30'           FD/FDIN - NO 3270 FIELDS          81127  00170000
FDFIND@  EQU   X'01'             FDSADD IS INDIRECT ADDRESS      81270  00180000
FDFINDAD EQU   X'01'             FDSADD IS INDIRECT ADDRESS     GP08076 00190000
FDFREG#  EQU   X'02'             FDILEN IS REGISTER WITH LENGTH  81270  00200000
FDFREGLN EQU   X'02'             FDILEN IS REGISTER WITH LENGTH GP08076 00210000
FDFEXAD  EQU   X'04'             EXPANSION HAS USER EXIT ADDRESS 89095  00220000
FDFOPT   EQU   X'20'           OPTION LIST                              00230000
FDFGOTO  EQU   X'10'           BRANCH TO ANOTHER FD ENTRY               00240000
FDFEXEC  EQU   X'11'           PERFORM NEW FD RANGE              81131  00250000
FDFBR    EQU   X'12'           BRANCH/TEST AFTER PRIOR TEST      81131  00260000
FDFTM    EQU   X'13'           TM/BRANCH                         81131  00270000
FDFCLI   EQU   X'14'           CLI/BRANCH                        81131  00280000
FDFCLC   EQU   X'15'           CLC/BRANCH                        81131  00290000
FDFSPC   EQU   X'1E'           SPACE/ROOM/REPT SERVICE           82109  00300000
FDFUEX   EQU   X'1F'           USER EXIT                         81193  00310000
FDGOTO   DS    0SL2(0)       ADDRESS OF TARGET FD OF GO TO              00320000
FDEDIT   DS    X             EDITING OPTIONS                            00330000
FDFNL    EQU   X'80'           POSITION TO NEW LINE                     00340000
FDFDEBL  EQU   X'40'           STRIP LEADING BLANKS                     00350000
FDFDEBR  EQU   X'20'           STRIP TRAILING BLANKS                    00360000
FDFDEBZ  EQU   X'10'           STRIP LEADING ZEROES                     00370000
FDFPADL  EQU   X'08'           LEFT BLANK OR SF                         00380000
FDFPADR  EQU   X'04'           RIGHT BLANK OR SF                        00390000
FDFRADJ  EQU   X'02'           RIGHT-ADJUST IN OUTPUT                   00400000
FDFUP    EQU   X'01'           UPPER CASE INPUT TRANSLATE               00410000
*        REDEFINITION FOR FDOPT                                  82109  00420000
*FDFNL   EQU   X'80'           POSITION TO NEW LINE                     00430000
FDOWCCP  EQU   X'40'         WCC OPTIONS PRESENT                        00440000
FDOSBAP  EQU   X'20'         SBA PRESENT                                00450000
FDOCURP  EQU   X'08'         CURSOR ADDRESS PRESENT                     00460000
FDOINDP  EQU   X'04'           AUTO INDENT VALUE PRESENT         81270  00470000
FDOPTP   EQU   X'02'         COLOR OR DISPLAY OPTIONS PRESENT           00480000
FDOPCCP  EQU   X'01'         PRT CARRIAGE CONTROL INSTEAD OF CURP       00490000
FDOPT9   DS    X             3279 OPTIONS                               00500000
FDFCOLOR EQU   X'70' 0DFLT,1BLUE,2RED,3PINK,4GREEN,5TURQ,6YELLOW,7WHITE 00510000
FDFMONO  EQU   X'08'         APPLY HIGH-LIGHT ON MONOCHROME ONLY 87313  00520000
FDFUNDER EQU   X'04'           UNDERLINE                                00530000
FDFREV   EQU   X'02'           REVERSE                                  00540000
FDFBLINK EQU   X'01'           BLINK                                    00550000
FDOPT7   DS    X             3277/3278 OPTIONS                          00560000
FDFINT   EQU   X'08'           INTENSIFIED                              00570000
FDFLPEN  EQU   X'04'           LIGHT-PEN DETECTABLE                     00580000
FDFNDISP EQU   X'0C'           NON-DISPLAY                              00590000
FDFNUM   EQU   X'10'           NUMERIC INPUT                            00600000
FDFSKIP  EQU   X'30'           SKIP DISPLAY                             00610000
FDFPROT  EQU   X'20'           PROTECTED                                00620000
FDFDFLT  EQU   X'80'           DEFAULT OPTIONS/COLORS                   00630000
FDFPREV  EQU   X'40'           PREVIOUS OPTIONS/COLORS                  00640000
FDFNULL  EQU   X'02'           SUPPRESS X'00' IN INPUT FIELDS           00650000
FDFMTD   EQU   X'01'           MODIFIED DATA TAG                 87313  00660000
FDDATA   DS    X             DATA TYPE                                  00670000
FDDLIT   EQU   X'80'           FD CONTAINS LITERAL, NOT ADDRESS         00680000
FDDCHAR  EQU   1               EBCDIC, TRANSLATED                       00690000
FDDCON   EQU   2               EBCDIC WITH CONTROL CHARACTERS           00700000
FDDASIS  EQU   3               EBCDIC(?), NO TRANSLATE                  00710000
FDDADDR  EQU   4               ADDRESS                                  00720000
FDDHEX   EQU   5               HEXADECIMAL                              00730000
FDDSHEX  EQU   6               HEXADECIMAL WITH EXPLICIT SIGN           00740000
FDDBIT   EQU   7               BIT STRING                               00750000
FDDINT   EQU   8               INTEGER                                  00760000
FDD$INT  EQU   9               INTEGER.DD                               00770000
FDDDEC   EQU   10              PACKED DECIMAL                           00780000
FDD$DEC  EQU   11              PACKED DECIMAL.DD                        00790000
FDDFIX   EQU   12              FLOATING POINT                           00800000
FDDTIME  EQU   13              TIME (BIN 1/100 SECONDS)          81193  00810000
FDDTIMD  EQU   14              TIME (PACKED)                     81193  00820000
FDDDATE  EQU   15              DATE (PACKED; O/P MM/DD/YY)       81193  00830000
FDDDATJ  EQU   16              DATE (PACKED; O/P YY.DDD)         81193  00840000
FDDFLAG  EQU   64              FLAG/TABLE FORMATTING            GP06273 00850000
FDOLEN   DS    AL1           OUTPUT LENGTH; 0 FOR DEFAULT; MAX FOR FDIN 00860000
FDILEN   DS    AL1           CURRENT LENGTH OF ITEM                     00870000
FDTEXT   DS    0CL132        (FD/FDPRT) LITERAL TEXT                    00880000
FDSADD   DS    SL2           ADDRESS OF DATA ITEM                       00890000
FDIOFF   DS    AL2           FDIN - OFFSET TO FIW AREA           84237  00900000
FDIXAD   DS    SL2           FDIN - USER EXIT ADDRESS            89095  00910000
         ORG   FDIOFF          REDEFINE FOR FLAG PROCESSING     GP03287 00920000
FDTBAD   DS    SL2           ADDRESS OF BIT EQUIVALENT TEXT     GP03287 00930000
FDTSEP   DS    C             OUTPUT SEPARATOR CHARACTER OR 00   GP03287 00940000
FDTSPC   DS    XL1           NUMBER OF SPACES BETWEEN ITEMS     GP03287 00950000
         ORG   FDDATA                                                   00960000
FDOWCC   DC    X'0'          WCC OPTIONS                                00970000
FDOSBA   DC    XL2'0'        SBA ADDRESS                                00980000
FDOCUR   DC    0XL2'0'       CURSOR ADDRESS                             00990000
FDOCC    DS    C             PRINTER CARRIAGE CONTROL            81201  01000000
FDOIND   DS    AL1           AUTOMATIC LINE INDENT               81270  01010000
         SPACE 1                                                 81127  01020000
         ORG   FDGOTO                                            81127  01030000
FDBRE    DS    SL2           BRANCH EQUAL                        81127  01040000
FDBRL    DS    SL2           BRANCH LOW/MIXED                    81127  01050000
FDBRH    DS    SL2           BRANCH HIGH/ONES                    81127  01060000
FDBVAR   DS    SL2           TEST VARIABLE                       81127  01070000
FDBIDA   DS    0X              IMMEDIATE DATA FOR TEST           81127  01080000
FDBLEN   DS    X               LENGTH FOR FDCLC                  81127  01090000
FDBCLC   DS    SL2           COMPARE STRING                      81127  01100000
         SPACE 1                                                 81193  01110000
         ORG   FDGOTO        DEFINITION FOR USER EXIT REQUEST    81193  01120000
FDUXAD   DS    SL2           USER EXIT ADDRESS                   81193  01130000
FDUXFPRM DS    0X            USER SUPPLIED PARM INFO             81193  01140000
         ORG   ,                                                 81193  01150000
FDXOK    EQU   0             RETURN CODES - NORMAL PROCESSING    81193  01160000
FDXGOTO  EQU   2               NEW FD ADDRESS IN R1              81193  01170000
FDXCLR   EQU   4               CLEAR CURRENT LINE                81193  01180000
FDXPRT   EQU   8               PRINT CURRENT LINE                81193  01190000
FDXADD   EQU   FDXCLR+FDXPRT   DATA ADDED TO LINE                81193  01200000
FDXQUIT  EQU   16              TERMINATE CURRENT PRTLIST         81193  01210000
         SPACE 1                                                 81193  01220000
FDUXPARM DSECT ,             MAPPING OF R1 LIST SUPPLIED TO EXIT 81193  01230000
FDUXFD   DS    A               ADDRESS OF CURRENT FD             81193  01240000
FDUXPWRK DS    A               ADDRESS OF PRINTER WORK AREA      81193  01250000
FDUXSAVE DS    A               ADDRESS OF ORIGINAL SAVE AREA     81193  01260000
FDUXPRT  DS    A               ADDRESS OF CURRENT PRINT LINE     81193  01270000
         DS    A                 RESERVED                        81193  01280000
.MEND    MEND  ,                                                        01290000
./ ADD NAME=FDSNAP
         MACRO ,                                                        00010000
&NM      FDSNAP &ADR,&HLN,&OPTS,&BASE=,&LEN=            ADDED ON 83331  00020000
.*                                                                      00030000
.*   FDSNAP IS USED IN AN FDLIST TO DUMP MEMORY.                        00040000
.*     LIST    (DEFAULT) PRINTS TEXT ONLY (PERIOD FOR UNPRINTABLES)     00050000
.*     HEX     FORMATS IN HEXADECIMAL                                   00060000
.*     DUAL    FORMATS HEX ON LEFT, AND TEXT ON RIGHT                   00070000
.*     VERT    FORMATS THREE LINES: TEXT/ZONES/NUMERICS                 00080000
.*                                                                      00090000
.*     ABS     DISPLAYS MEMORY ADDRESS (DEFAULT)                        00100000
.*     NOABS   OMITS MEMORY ADDRESS                                     00110000
.*                                                                      00120000
.*     OFFSET  PRINTS OFFSET RELATIVE TO BASE= VALUE                    00130000
.*     NOOFFSET  OMITS OFFSET VALUE                                     00140000
.*                                                                      00150000
.*     ANSI                                                             00160000
.*     ASCII   CONVERT TEXT TO ASCII (IN OUTPUT LINE)                   00170000
.*                                                                      00180000
.*                                                                      00190000
         GBLA  &FDCNTR                                                  00200000
         LCLA  &T,&C,&FG1,&FG2,&I,&MAX                                  00210000
         LCLB  &NOP,&B0,&B1,&B2,&B3,&B4,&B5,&B6,&B7,&B8,&B9,&B10,&B11   00220000
         LCLB  &B12,&B13,&B14,&B15                                      00230000
         LCLC  &FDCHN,&OP,&RA,&RB,&LOP,&LVAL                    GP11288 00240000
&LOP     SETC  'AL'                                             GP11288 00250000
&LVAL    SETC  '&HLN'                                           GP11288 00260000
&FDCNTR  SETA  &FDCNTR+1                                                00270000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00280000
&C       SETA  &FDCNTR+1                                                00290000
&MAX     SETA  N'&SYSLIST                                               00300000
&I       SETA  3             FIRST OPTION                               00310000
         AIF   (T'&LEN EQ 'O').NOLEN                                    00320000
&I       SETA  2             KEYWORD, NOT POSITIONAL, LENGTH            00330000
&B0      SETB  1             SET S-FORMAT LENGTH FIELD                  00340000
&LVAL    SETC  '&LEN'                                           GP11288 00350000
.NOLEN   AIF   (T'&BASE EQ 'O').NOBASE                                  00360000
&B13     SETB  1                                                        00370000
.NOBASE  AIF   ('&NM' EQ '').NONAME                                     00380000
&NM      EQU   *                                                        00390000
.NONAME  AIF   ('&ADR' NE 'END' AND '&ADR' NE '*END').PROCESS           00400000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00410000
         MEXIT ,                                                        00420000
.PROCESS AIF   (&I GT &MAX).CHECK                                       00430000
&OP      SETC  '&SYSLIST(&I)'                                           00440000
&I       SETA  &I+1                                                     00450000
         AIF   ('&OP' EQ '').PROCESS                                    00460000
&B7      SETB  (&B7 OR ('&OP' EQ 'ASCII') OR ('&OP' EQ 'ANSI'))  83331  00470000
&B8      SETB  (&B8 OR ('&OP' EQ 'HEX') OR ('&OP' EQ 'VERT'))           00480000
&B9      SETB  (&B9 OR ('&OP' EQ 'DUAL') OR ('&OP' EQ 'VERT'))          00490000
&B8      SETB  (&B8 AND '&OP' NE 'LIST' AND '&OP' NE 'DUAL')            00500000
&B9      SETB  (&B9 AND '&OP' NE 'LIST' AND '&OP' NE 'HEX')             00510000
&B14     SETB  ((&B14 OR '&OP' EQ 'NOABS') AND '&OP' NE 'ABS')          00520000
&B15     SETB  ((&B15 OR '&OP' EQ 'OFFSET') AND '&OP' NE 'NOOFFSET')    00530000
         AGO   .PROCESS                                                 00540000
.CHECK   ANOP  ,                                                        00550000
&T       SETA  64*&NOP+29                                               00560000
         AIF   (K'&ADR LT 3).NORA                                85118  00570000
         AIF   ('&ADR'(1,1) NE '(').NORA                         85118  00580000
         AIF   ('&ADR'(K'&ADR,1) NE ')').NORA                    85118  00590000
         AIF   ('&ADR'(2,1) EQ '(').NORA                         85118  00600000
&RA      SETC  '0'           CHANGE R TO S FORMAT                85118  00610000
.NORA    AIF   (&B0).TESTL                                       85118  00620000
         AIF   (K'&HLN LT 3).TESTD                               85118  00630000
         AIF   ('&HLN'(1,1) NE '(').TESTD                        85118  00640000
         AIF   ('&HLN'(K'&HLN,1) NE ')').TESTD                   85118  00650000
         AIF   ('&HLN'(2,1) EQ '(').TESTD                        85118  00660000
&B0      SETB  1             SET S-FORMAT LENGTH FIELD          GP11288 00670000
&LOP     SETC  'SL'                                             GP11288 00680000
&LVAL    SETC  '0'.'&HLN'                                       GP11288 00690000
         AGO   .TESTD                                            85118  00700000
.TESTL   AIF   (K'&LEN LT 3).TESTD                               85118  00710000
         AIF   ('&LEN'(1,1) NE '(').TESTD                        85118  00720000
         AIF   ('&LEN'(K'&LEN,1) NE ')').TESTD                   85118  00730000
         AIF   ('&LEN'(2,1) EQ '(').TESTD                        85118  00740000
&LOP     SETC  'SL'                                             GP11288 00750000
&LVAL    SETC  '0'.'&LEN'                                       GP11288 00760000
.TESTD   ANOP  ,                                                GP11288 00770000
&FG1     SETA  128*&B0+64*&B1+32*&B2+16*&B3+8*&B4+4*&B5+2*&B6+&B7       00780000
&FG2     SETA  128*&B8+64*&B9+32*&B10+16*&B11+8*&B12+4*&B13+2*&B14+&B15 00790000
&FG1     SETA  &FG1*256+&FG2                                            00800000
         AIF   (&B13).BASED                                      85118  00810000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL2(&FG1),SL2(&RA&ADR),&LOP.2(&LVAL)     00820000
         MEXIT ,                                                        00830000
.BASED   AIF   (K'&BASE LT 3).BASES                              85118  00840000
         AIF   ('&BASE'(1,1) NE '(').BASES                       85118  00850000
         AIF   ('&BASE'(K'&BASE,1) NE ')').BASES                 85118  00860000
         AIF   ('&BASE'(2,1) EQ '(').BASES                       85118  00870000
&RB      SETC  '0'           CHANGE R TO S FORMAT                85118  00880000
.BASES   ANOP  ,                                                GP11288 00890000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL2(&FG1),SL2(&RA&ADR),&LOP.2(&LVAL),SL2*00900000
               (&RB&BASE)                                       GP11288 00910000
         MEND  ,                                                        00920000
./ ADD NAME=FDSPACE
         MACRO                                                          00010000
&NM      FDSPACE &N                                     ADDED ON 82109  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&N' NE 'END' AND '&N' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS ANOP  ,                                                        00140000
&T       SETA  30                                                       00150000
         AIF   (T'&N EQ 'O').DFLT                                       00160000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(&N,0)                                00170000
         MEXIT ,                                                        00180000
.DFLT    ANOP  ,                                                        00190000
&FDCHN   DC    AL1(ZFD&C-*,&T),AL1(1,0)                                 00200000
         MEND  ,                                                        00210000
./ ADD NAME=FDTM
         MACRO                                                          00010000
&NM      FDTM  &STR,&MASK,&BZ=0,&BM=0,&BO=0,&BNO=0,&BNZ=0        81264  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLB  &NOP                                              81133  00050000
         LCLC  &FDCHAIN,&FZ,&FM,&FO                              81264  00060000
&FDCNTR  SETA  &FDCNTR+1                                                00070000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                          00080000
&C       SETA  &FDCNTR+1                                                00090000
         AIF   ('&NM' EQ '').NONAME                                     00100000
&NM      EQU   *                                                        00110000
.NONAME  AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00120000
&FDCHAIN DC    AL1(0)        END OF FD LIST                             00130000
         MEXIT ,                                                        00140000
.PROCESS ANOP  ,                                                        00150000
&FZ      SETC  '&BZ'                                             81264  00160000
&FM      SETC  '&BM'                                             81264  00170000
&FO      SETC  '&BO'                                             81264  00180000
         AIF   ('&BNZ' EQ '0' OR '&BNO' EQ '0').BNZBNO           81264  00190000
         MNOTE 8,'MUTUALLY EXCLUSIVE BNZ AND BNO'                81264  00200000
.BNZBNO  AIF   ('&BNO' EQ '0').NOBNO                             81264  00210000
         AIF   ('&FZ' EQ '0' AND '&FM' EQ '0').DOBNO             81264  00220000
         MNOTE 8,'MUTUALLY EXCLUSIVE BNO AND BZ/BM'              81264  00230000
.DOBNO   ANOP  ,                                                 81264  00240000
&FZ      SETC  '&BNO'                                            81264  00250000
&FM      SETC  '&BNO'                                            81264  00260000
.NOBNO   AIF   ('&BNZ' EQ '0').CHECK                             81264  00270000
         AIF   ('&FM' EQ '0' AND '&FO' EQ '0').DOBNZ             81264  00280000
         MNOTE 8,'MUTUALLY EXCLUSIVE BNZ AND BM/BO'              81264  00290000
.DOBNZ   ANOP  ,                                                 81264  00300000
&FM      SETC  '&BNZ'                                            81264  00310000
&FO      SETC  '&BNZ'                                            81264  00320000
.CHECK   ANOP  ,                                                        00330000
&T       SETA  64*&NOP+19                                               00340000
&FDCHAIN DC AL1(ZFD&C-*,&T),SL2(&FZ,&FM,&FO,&STR),AL1(&MASK)     81264  00350000
         MEND  ,                                                        00360000
./ ADD NAME=FD
         MACRO                                                          00010000
&NM      FD    &STR,&EXLEN,&VALUES,&LEN=0,&TYPE=                GP03287 00020000
.*--------------------------------------------------------------------* 00030000
.*   TYPE= ADDED FOR FDFLAG AND FDBAR SUPPORT                         * 00040000
.*--------------------------------------------------------------------* 00050000
         GBLA  &FDCNTR                                                  00060000
         LCLA  &C,&I,&J,&K,&N                                           00070000
         LCLA  &T,&E,&O7,&O9,&DATA                                      00080000
         LCLC  &L,&FDCHAIN,&W                                           00090000
         LCLB  &NOP,&IN,&SKPLEN,&INDAD,&CNLOCK                   92086  00100000
         LCLB  &NL,&DEBL,&DEBR,&DEBZ,&PADL,&PADR,&RADJ,&UP              00110000
         LCLB  &BLUE,&GREEN,&PINK,&RED,&TURQ,&WHITE,&YELLOW,&C1,&C2,&C3 00120000
         LCLB  &UNDER,&BLINK,&REVERSE,&MDT,&MONO                 87313  00130000
         LCLB  &INTENSE,&DETECT,&NONDISP,&NUMERIC,&SKIP,&PROTECT        00140000
         LCLB  &DEFAULT,&PREV                                           00150000
&FDCNTR  SETA  &FDCNTR+1                                                00160000
&FDCHAIN SETC  'ZFD'.'&FDCNTR'                                          00170000
&C       SETA  &FDCNTR+1                                                00180000
         AIF   ('&NM' EQ '').NONAME                                     00190000
&NM      EQU   *                                                        00200000
.NONAME  AIF   ('&STR' NE 'END' AND '&STR' NE '*END').PROCESS           00210000
&FDCHAIN DC    AL1(0)        END OF FD LIST                             00220000
         MEXIT ,                                                        00230000
.PROCESS ANOP  ,                                                        00240000
&I       SETA  N'&SYSLIST                                               00250000
&J       SETA  1                                                        00260000
         AIF   ('&STR'(1,1) NE '''').PRMLOOP                    GP04048 00270000
&SKPLEN  SETB  1                                                        00280000
.*--------------------------------------------------------------------* 00290000
.*   LOOP THROUGH POSITIONAL PARAMETERS:                              * 00300000
.*   #1 - VARIABLE NAME OR QUOTED STRING                              * 00310000
.*   #2 - IF UNRECOGNIZED, EXPLICIT VARIABLE LENGTH                   * 00320000
.*--------------------------------------------------------------------* 00330000
.PRMLOOP AIF   (&J GE &I).CHECK                                 GP04048 00340000
&J       SETA  &J+1                                                     00350000
&L       SETC  '&SYSLIST(&J)'                                           00360000
         AIF   ('&L' EQ '').PRMLOOP                             GP04048 00370000
&NOP     SETB  (&NOP  OR '&L' EQ 'NOP')                                 00380000
&CNLOCK  SETB  (&CNLOCK OR '&L' EQ 'LOCK' OR '&L' EQ 'LOCKED')   92086  00390000
&NL      SETB  (&NL  OR '&L' EQ 'NL' OR '&L' EQ 'NEWLINE')              00400000
&DEBL SETB (&DEBL OR '&L' EQ 'DEBL' OR '&L' EQ 'DEB' OR '&L' EQ 'DEBZ') 00410000
&DEBR    SETB  (&DEBR OR '&L' EQ 'DEBR' OR '&L' EQ 'DEB')               00420000
&DEBZ    SETB  (&DEBZ OR '&L' EQ 'DEBZ')                                00430000
&PADL    SETB  (&PADL OR '&L' EQ 'PADL' OR '&L' EQ 'PAD')               00440000
&PADR    SETB  (&PADR OR '&L' EQ 'PADR' OR '&L' EQ 'PAD')               00450000
&RADJ    SETB  (&RADJ OR '&L' EQ 'RADJ')                                00460000
&UP    SETB  (&UP OR '&L' EQ 'UP')                                      00470000
&UP      SETB  (&UP OR '&L' EQ 'UPPER')                                 00480000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BLUE')                                00490000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GREEN')                              00500000
&PINK    SETB  (&PINK OR '&L' EQ 'PINK')                                00510000
&RED     SETB  (&RED  OR '&L' EQ 'RED')                                 00520000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TURQ' OR '&L' EQ 'CYAN')      90326  00530000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WHITE')                              00540000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YELLOW')                            00550000
&BLUE    SETB  (&BLUE OR '&L' EQ 'BL')                          GP10240 00560000
&GREEN   SETB  (&GREEN OR '&L' EQ 'GR')                         GP10240 00570000
&PINK    SETB  (&PINK OR '&L' EQ 'PI')                          GP10240 00580000
&RED     SETB  (&RED  OR '&L' EQ 'RE')                          GP10240 00590000
&TURQ    SETB  (&TURQ  OR '&L' EQ 'TU' OR '&L' EQ 'CY')         GP10240 00600000
&WHITE   SETB  (&WHITE OR '&L' EQ 'WH')                         GP10240 00610000
&YELLOW  SETB  (&YELLOW OR '&L' EQ 'YE')                        GP10240 00620000
&MONO    SETB  (&MONO OR '&L' EQ 'MONO')                         87313  00630000
&UNDER   SETB  (&UNDER OR '&L' EQ 'UL' OR '&L' EQ 'UNDER')              00640000
&BLINK   SETB  (&BLINK OR '&L' EQ 'BLINK')                              00650000
&REVERSE SETB  (&REVERSE OR '&L' EQ 'REVERSE')                          00660000
&INTENSE SETB  (&INTENSE OR '&L' EQ 'INTENSE' OR '&L' EQ 'INT')         00670000
&DETECT  SETB  (&DETECT OR '&L' EQ 'DETECT' OR '&L' EQ 'LP')            00680000
&NONDISP SETB  (&NONDISP OR '&L' EQ 'NONDISP' OR '&L' EQ 'NDISP')       00690000
&NUMERIC SETB  (&NUMERIC OR '&L' EQ 'NUMERIC' OR '&L' EQ 'NUM')         00700000
&SKIP    SETB  (&SKIP OR '&L' EQ 'SKIP')                                00710000
&PROTECT SETB  (&PROTECT OR '&L' EQ 'PROTECT')                          00720000
&MDT     SETB  (&MDT OR '&L' EQ 'MDT')                           87313  00730000
&DEFAULT SETB  (&DEFAULT OR '&L' EQ 'DEFAULT' OR '&L' EQ 'DFLT')        00740000
&PREV    SETB  (&PREV OR '&L' EQ 'PREVIOUS' OR '&L' EQ 'PREV')          00750000
&INDAD   SETB  (&INDAD OR '&L' EQ '*')                           81270  00760000
         AIF   (K'&L GT 4).OMLEN                                        00770000
&K       SETA  0                                                        00780000
&L       SETC  '&L'.'    '                                              00790000
&L       SETC  '&L'(1,4)                                                00800000
         AIF   ('&L' NE 'X   ').DT                              GP10240 00810000
&L       SETC  'HEX '                                           GP10240 00820000
.DT      AIF   (&K GE 35).OMLEN                                 GP07004 00830000
&K       SETA  &K+1                                                     00840000
&N       SETA  (&K-1)*4+1                                               00850000
&W      SETC  'CHARCON ASISADDRHEX SHEXBIT I   $I  D   $D  F   TIMETIMD*00860000
               DATEDATJWDAYMTH DAY MD  DMY MDY CHEXICM ICN IZ  IA  DCM *00870000
               DCN DZ  DA  EDATDATDCCHHTTR '(&N,4)              GP07004 00880000
         AIF   ('&L' NE '&W').DT                                        00890000
&DATA    SETA  &K                                                       00900000
         AIF   (&J EQ 2).OMSET                                          00910000
         AGO   .PRMLOOP                                         GP04048 00920000
.OMLEN   AIF   (&J NE 2 OR &SKPLEN).PRMLOOP                     GP04048 00930000
 AIF (&NOP OR &IN OR &NL OR &DEBL OR &DEBR OR &DEBZ OR &PADL).OMSET     00940000
 AIF (&UP OR &PADR OR &RADJ OR &BLUE OR &GREEN OR &PINK OR &RED).OMSET  00950000
 AIF (&TURQ OR &WHITE OR &YELLOW OR &UNDER OR &BLINK).OMSET             00960000
 AIF (&REVERSE OR &INTENSE OR &DETECT OR &NONDISP OR &INDAD).OMSET      00970000
 AIF (&NUMERIC OR &SKIP OR &PROTECT OR &DEFAULT OR &PREV).OMSET         00980000
         AIF   (&MDT OR &MONO OR &CNLOCK).OMSET                  92086  00990000
         AGO   .PRMLOOP                                         GP04048 01000000
.OMSET   ANOP  ,             EXPLICIT LENGTH OMITTED                    01010000
&SKPLEN  SETB  1             USE L'                                     01020000
         AGO   .PRMLOOP                                         GP04048 01030000
.*--------------------------------------------------------------------* 01040000
.*   END OF PARAMETER LOOP                                            * 01050000
.*--------------------------------------------------------------------* 01060000
.CHECK   AIF   ('&TYPE' EQ '').NOTYPE                           GP03287 01070000
.*FDBAR  AIF   (T'&TYPE NE 'N').NOTYPE                          GP03287 01080000
&DATA    SETA  &TYPE                                            GP03287 01090000
.NOTYPE  ANOP  ,                                                GP04048 01100000
&T       SETA  128*&IN+64*&NOP+8*&CNLOCK+&INDAD                  92086  01110000
&E SETA 128*&NL+64*&DEBL+32*&DEBR+16*&DEBZ+8*&PADL+4*&PADR+2*&RADJ+&UP  01120000
&O7      SETA  128*&DEFAULT+64*&PREV                                    01130000
&PROTECT SETB  (&PROTECT OR &SKIP)                                      01140000
&NUMERIC SETB  (&NUMERIC OR &SKIP)                                      01150000
&DETECT  SETB  (&DETECT  OR &NONDISP)                                   01160000
&INTENSE SETB  (&INTENSE OR &NONDISP)                                   01170000
&O7      SETA  &O7+32*&PROTECT+16*&NUMERIC+8*&INTENSE+4*&DETECT+&MDT    01180000
&C1      SETB  (&GREEN OR &TURQ OR &WHITE OR &YELLOW)                   01190000
&C2      SETB  (&RED OR &PINK OR &WHITE OR &YELLOW)                     01200000
&C3      SETB  (&BLUE OR &PINK OR &TURQ OR &WHITE)                      01210000
&O9      SETA  64*&C1+32*&C2+16*&C3+8*&MONO+4*&UNDER+2*&REVERSE+&BLINK  01220000
         AIF   (&O7 NE 0 OR &O9 NE 0).LONG                       81138  01230000
&T       SETA  &T+48         USE FDPRT SHORT FORM                81138  01240000
         AIF   ('&STR'(1,1) EQ '''').CSTRPRT                     81138  01250000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).PRTLEN           81138  01260000
&L       SETC  'L'''                                             81138  01270000
&FDCHAIN DC    AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&L&STR),SL2(&STR)    81138  01280000
         MEXIT ,                                                 81138  01290000
.PRTLEN  AIF   (K'&EXLEN LT 2).NOPLEN                            81270  01300000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NOPLEN    01310000
&T       SETA  &T+2          ILEN IS REGISTER FORM               81270  01320000
.NOPLEN  ANOP  ,                                                 81270  01330000
&FDCHAIN DC    AL1(ZFD&C-*,&T,&E,&DATA,&LEN,&EXLEN),SL2(&STR)    81138  01340000
         MEXIT ,                                                 81138  01350000
.CSTRPRT ANOP  ,                                                 81138  01360000
&FDCHAIN DC    AL1(ZFD&C-*,&T,&E,129,&LEN,ZFD&C-*-1),C&STR       81138  01370000
         MEXIT ,                                                 81138  01380000
.LONG    AIF   ('&STR'(1,1) EQ '''').CSTRING                     81138  01390000
         AIF   ('&EXLEN' NE '' AND NOT &SKPLEN).EXLEN                   01400000
&L       SETC  'L'''                                                    01410000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,&DATA,&LEN,&L&STR),SL2(&STR)      01420000
         MEXIT                                                          01430000
.EXLEN   AIF   (K'&EXLEN LT 2).NORLEN                            81270  01440000
         AIF   ('&EXLEN'(1,1) NE '(' OR '&EXLEN'(2,1) EQ '(').NORLEN    01450000
&T       SETA  &T+2          ILEN IS REGISTER FORM               81270  01460000
.NORLEN  ANOP  ,                                                 81270  01470000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,&DATA,&LEN,&EXLEN),SL2(&STR)      01480000
         MEXIT ,                                                        01490000
.CSTRING ANOP  ,                                                        01500000
&FDCHAIN DC AL1(ZFD&C-*,&T,&E,&O9,&O7,129,&LEN,ZFD&C-*-1),C&STR         01510000
         MEND  ,                                                        01520000
./ ADD NAME=FDUEXEND
         MACRO ,                                                        00010000
&NM      FDUEXEND ,                                                     00020000
&NM      MACPARM MODE=LBL                                               00030000
         POP   USING                                                    00040000
         MEND  ,                                                        00050000
./ ADD NAME=FDUEXHED
         MACRO ,                                                        00010000
&NM      FDUEXHED ,                                                     00020000
.*                                                                      00030000
.*    SIMPLE INPUT VALIDITY CHECK FOR FDIN FIELDS                       00040000
.*    DO NOT USE R13'S SAVE AREA                                        00050000
.*                                                                      00060000
         PUSH  USING                                                    00070000
         DROP  ,                                                        00080000
         USING &NM,R15                                                  00090000
&NM      LM    R4,R6,4(R1)   LOAD FD, FIW, AND FDW ADDRESSES            00100000
         USING FHDLINK,R4    MAP FIELD REQUEST                          00110000
         USING FIWFG,R5      MAP FIELD INPUT WORK AREA                  00120000
         USING FDWFDA,R6     MAP FIELD DEFINITION WORK AREA             00130000
         USING EXHBWORK,R11  PASSED                                     00140000
         MEND  ,                                                        00150000
./ ADD NAME=FDUEXRET
         MACRO ,                                                        00010000
&NM      FDUEXRET ,                                                     00020000
&NM      BR    R14           RETURN TO CALLER                           00030000
         MEND  ,                                                        00040000
./ ADD NAME=FDUEX
         MACRO                                                          00010000
&NM      FDUEX &S                                       ADDED ON 81190  00020000
         GBLA  &FDCNTR                                                  00030000
         LCLA  &T,&C                                                    00040000
         LCLC  &FDCHN                                                   00050000
&FDCNTR  SETA  &FDCNTR+1                                                00060000
&FDCHN   SETC  'ZFD'.'&FDCNTR'                                          00070000
&C       SETA  &FDCNTR+1                                                00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&NM      EQU   *                                                        00100000
.NONAME  AIF   ('&S' NE 'END' AND '&S' NE '*END').PROCESS               00110000
&FDCHN   DC    AL1(0)        END OF FD LIST                             00120000
         MEXIT ,                                                        00130000
.PROCESS ANOP  ,                                                        00140000
&T       SETA  16+15                                                    00150000
&FDCHN   DC    AL1(ZFD&C-*,&T),SL2(&S)                                  00160000
         MEND  ,                                                        00170000
./ ADD NAME=FETWORK
         MACRO ,                                                        00010000
&NM      FETWORK &PFX=FT,&DSECT=YES   MAP PARMS FOR SUBFETCH ROUTINE    00020000
         LCLC  &NAME                                                    00030000
&NAME    SETC  '&NM'                                                    00040000
         AIF   ('&DSECT' EQ 'YES' OR '&DSECT' EQ '').DOD                00050000
         AIF   ('&NM' EQ '').DONES                                      00060000
&NM      DS    0F            SUBFETCH PARAMTER LIST                     00070000
         AGO   .DONES                                                   00080000
.DOD     AIF   ('&NM' NE '').HAVNAM                                     00090000
&NAME    SETC  'FETWORK'                                                00100000
.HAVNAM  ANOP  ,                                                        00110000
&NAME    DSECT ,             SUBFETCH PARAMETER LIST                    00120000
.DONES   ANOP  ,                                                        00130000
&PFX.@DCB   DC  A(0)         PROGRAM LIBRARY OPEN DCB                   00140000
&PFX.@NAME  DC  A(0)         MEMBER NAME                                00150000
&PFX.MFBLD  EQU X'80'          ABOVE POINTS TO BLDL RESULTS             00160000
&PFX.@LOAD  DC  A(0)         REQUESTED/RETURNED LOAD ADDRESS            00170000
&PFX.#LOAD  DC  F'0'         STORAGE ACQUIRED (24-BITS)                 00180000
&PFX.@RELOC DC  A(0)         REQUESTED/RETURNED RELOCATION BASE         00190000
&PFX.@ENTRY DC  A(0)         ENTRY ADDRESS WITH AMODE BIT               00200000
&PFX.#MODSZ DC  F'0'         MODULE SIZE                                00210000
&PFX.OFLGSP DC  X'0'         SUBFETCH - SUBPOOL FOR LOADING             00220000
&PFX.OFLGS1 DC  X'0'         OPTION FLAGS FOR SUBFETCH                  00230000
&PFX.OFALTN EQU X'80'          USE AN ALTERNATE NAME FOR CDE            00240000
&PFX.OFBCDE EQU X'40'          FETCH TO CALL CDE TO BUILD ONE           00250000
&PFX.OFBCDF EQU X'20'          CDE BUILD FAILED                 GP06308 00260000
&PFX.OFNOLO EQU X'10'          CDE NOT TO ISSUE LOAD                    00270000
&PFX.OFREFR EQU X'08'          USE SP252 IF RENT/REFR AND AUTH  GP11270 00280000
&PFX.OFFREN EQU X'04'          FORCE RE-ENTRANT                 GP11270 00290000
&PFX.OFCLR0 EQU X'02'          CLEAR GOTTEN STORAGE TO 0        GP05261 00300000
&PFX.OFCLRC EQU X'01'          CLEAR GOTTEN STORAGE TO X'CC'    GP05261 00310000
&PFX.OFLGS2 DC  X'0'         OPTION FLAGS FOR SUBCDE                    00320000
&PFX.OFRENT EQU X'20'          FLAG LOADED MODULE RE-ENTRANT            00330000
&PFX.OFREUS EQU X'10'          FLAG LOADED MODULE RE-USABLE             00340000
&PFX.OFLGS3 DC  X'0'         OPTION FLAGS FOR SUBCDE                    00350000
&PFX.OFAPFL EQU X'02'          FLAG AS COMING FROM APF LIBRARY          00360000
&PFX.OFAUTH EQU X'01'          FLAG AS BEING AUTHORIZED AC=1            00370000
&PFX.FWCLRS EQU *-&PFX.@DCB    SIZE TO CLEAR                            00380000
         MEND  ,                                                        00390000
./ ADD NAME=@FILE861
//***FILE 861 is from Gerhard Postpischil and contains his macro    *   FILE 861
//*           library.  This file is intended to be used for        *   FILE 861
//*           assembling Gerhard's source code in File 860 and      *   FILE 861
//*           File 862.                                             *   FILE 861
//*                                                                 *   FILE 861
//*       My dear friend, and programmer par excellence, Gerhard    *   FILE 861
//*       Postpischil, has passed away.  Please send support        *   FILE 861
//*       requests to:   Sam Golob  email: sbgolob@cbttape.org      *   FILE 861
//*                                                                 *   FILE 861
//*     - - - - - - - - - - - - - - - - - - - - - - - - - - - -     *   FILE 861
//*                                                                 *   FILE 861
//*     Description and Notes for use:                              *   FILE 861
//*                                                                 *   FILE 861
//*     Files 860, 861, and 862 should really be looked at          *   FILE 861
//*     together.                                                   *   FILE 861
//*                                                                 *   FILE 861
//*     This file (860) contains (mostly) assembler programs        *   FILE 861
//*     without JCL.                                                *   FILE 861
//*                                                                 *   FILE 861
//*     File 861 contains most macros required for proper           *   FILE 861
//*     assembly.                                                   *   FILE 861
//*                                                                 *   FILE 861
//*     File 862 contains additional files with procedures,         *   FILE 861
//*     parmlib data, and other supporting material. It also        *   FILE 861
//*     contains auxiliary macros, as PVTMACS, once available       *   FILE 861
//*     from IBM on optional source material tapes. Some            *   FILE 861
//*     macros not available have been concocted from dumps         *   FILE 861
//*     or IBM documentation.                                       *   FILE 861
//*                                                                 *   FILE 861
//*     The programs all ran in production at some point, but       *   FILE 861
//*     some were used under OS/360 only, and some only under       *   FILE 861
//*     MVS/ESA and later. A few members came straight from the     *   FILE 861
//*     CBT for me to look at, but haven't been used yet (e.g.,     *   FILE 861
//*     the HASPX exits, DSAT9).                                    *   FILE 861
//*                                                                 *   FILE 861
//*     Before assembling anything, look at members OPTIONGB and    *   FILE 861
//*     SYSPARM in the macro file. If you have any of the SVCs      *   FILE 861
//*     installed, set their SVC numbers correctly (OS/360,         *   FILE 861
//*     pre-XA only - not used in later systems).  The exception    *   FILE 861
//*     is @SERVICE, described later. Note that the options have    *   FILE 861
//*     provision for ESA and later systems, but only a few         *   FILE 861
//*     members will function correctly. Note that large 3390s      *   FILE 861
//*     were never used nor tested.  If you wish to start from      *   FILE 861
//*     scratch and assemble/link everything, run the SUBnnnnn      *   FILE 861
//*     modules first, then the @nnnnnnn modules (only one of       *   FILE 861
//*     the @SRVJnnn module, matching your JES2 release; this       *   FILE 861
//*     module needs the alias @SRVJES2). Then do individual        *   FILE 861
//*     programs as desired.                                        *   FILE 861
//*                                                                 *   FILE 861
//*     Some modules will not assemble because the macros they      *   FILE 861
//*     reference (USERCVT, USERVOLT, A$GDA, ...) are parts of      *   FILE 861
//*     a proprietary security and accounting system. However,      *   FILE 861
//*     the code may still be useful as groundwork for your own     *   FILE 861
//*     adaptations.                                                *   FILE 861
//*                                                                 *   FILE 861
//*     - - - - - - - - - - - - - - - - - - - - - - - - - - - -     *   FILE 861
//*       At any given MVS system level, the users of the           *   FILE 861
//*       various programs here, may have to do some coding         *   FILE 861
//*       work to fit the programs to their current system.         *   FILE 861
//*       These programs are being presented as-is, for their       *   FILE 861
//*       intrinsic utility value.                                  *   FILE 861
//*                                                                 *   FILE 861
//*       Please see our explanation of the source code in          *   FILE 861
//*       File 860 to better understand what this collection        *   FILE 861
//*       is about.                                                 *   FILE 861
//*                                                                 *   FILE 861
//*       If you have any question about any specific macros        *   FILE 861
//*       mentioned here, please email Gerhard or call him,         *   FILE 861
//*       for further information.                                  *   FILE 861
//*                                                                 *   FILE 861
//*       If Gerhard has time in the future, he may write           *   FILE 861
//*       some more doc.  See also, member DOC in File 862.         *   FILE 861
//*                                                                 *   FILE 861
./ ADD NAME=FIXD
         MACRO                                                          00010000
&NM      FIXD  &RI,&WORK=DB,&RO=R0                               85132  00020000
         GBLB  &ZZF@FIX                                                 00030000
         LCLA  &I                                                       00040000
&I       SETA  &SYSNDX                                                  00050000
&NM      MACPARM R0,(&RI),OP=LDR,OPR=LDR,OPM=LDCR,OPMR=LDCR             00060000
         MACPARM R14,ZZF@FIX,OP=BAL                                     00070000
         MACPARM &RO,(R0),OP=LR,OPR=LR,OPM=LCR,OPMR=LCR                 00080000
         AIF   (&ZZF@FIX).MEND                                          00090000
&ZZF@FIX SETB  1                                                        00100000
         B     ZZF@&I                                                   00110000
ZZF@FIX  SD    R0,=X'4F00000008000000'                                  00120000
         BC    11,ZZF@FIXO   OVERLFOW                                   00130000
         AW    R0,=X'4E00000100000000'  UNNORMALIZE                     00140000
         BC    4,ZZF@FIXO    OVERFLOW                                   00150000
         STD   R0,0+&WORK    STASH                                      00160000
         XI    4+&WORK,X'80' FIX SIGN                                   00170000
         ICM   R0,15,4+&WORK GET LOW WORD AND SET CC                    00180000
         BR    R14           RETURN                                     00190000
ZZF@FIXO ICM   R0,15,=X'7FFFFFFF'  SET HUGE AND CC                      00200000
         BR    R14           RETURN                                     00210000
ZZF@&I   DS    0H                                                       00220000
.MEND    MEND  ,                                                        00230000
./ ADD NAME=FLD
         MACRO                                                          00001000
&L       FLD   &TYP,&LEN,&LAB,&BLEN,&SEP=1                              00002000
.*             TYP IS V, H, S, OR T                                     00003000
.*             LEN IS THE DECIMAL LENGTH FOR H AND V,.*                 00004000
.*                    THE COLUMN NUMBER FOR T,                          00005000
.*                    AND THE NUMBER OF COLUMNS FOR S.                  00006000
.*             LAB IS THE LABEL OR LABEL LENGTH FOR H AND V             00007000
.*             BLEN IS THE NUMBER OF BLANKS TO ALLOW AFTER THE FIELD    00008000
.*             SEP, FOR H ONLY, IS THE NUMBER OF BLANKS BETWEEN         00009000
.*                              THE LABEL AND THE FIELD                 00010000
         GBLA  &PCCLINE,&PCCPOS,&PCCLTYP                                00011000
         GBLB  &DBMAC                                                   00012000
         LCLA  &L2,&L3,&LN                                              00013000
         LCLC  &KLUDGE                                                  00014000
         AIF   (NOT &DBMAC).NOSNAP                                      00015000
         MNOTE *,'PCCPOS=&PCCPOS PCCLINE=&PCCLINE'                      00016000
.NOSNAP  ANOP                                                           00017000
         AIF   ('&TYP' EQ 'H').H        IS IT HORIZONTAL FIELD?         00018000
         AIF   ('&TYP' EQ 'V').V        IS IT VERTICAL FIELD?           00019000
         AIF   ('&TYP' EQ 'T').T        IS IT TAB?                      00020000
         AIF   ('&TYP' EQ 'S').S        IS IT SPACE?                    00021000
         MNOTE 8,'1ST OPERAND NOT H, V, S, OR T'                        00022000
         MEXIT                                                          00023000
.*                                                                      00024000
.*                                                                      00025000
.*                                                                      00026000
.S       AIF   ('&LEN'(1,1) EQ '-').SBACK                               00027000
         AIF   (&PCCPOS+&LEN GT 80).SPACEU                              00028000
&PCCPOS  SETA  &PCCPOS+&LEN                                             00029000
         MEXIT                                                          00030000
.SBACK   ANOP                                                           00031000
&KLUDGE  SETC  '&LEN'(2,K'&LEN-1)                                       00032000
         AIF   (NOT &DBMAC).NOSNAP1                                     00033000
         MNOTE *,'KLUDGE=&KLUDGE'                                       00034000
.NOSNAP1 ANOP                                                           00035000
         AIF   (&PCCPOS-&KLUDGE LE 0).BACKU                             00036000
&PCCPOS  SETA  &PCCPOS-&KLUDGE                                          00037000
         MEXIT                                                          00038000
.BACKU   MNOTE 8,'BACKSPACE PAST START OF LINE - POS SET TO 1'          00039000
&PCCPOS  SETA  1                                                        00040000
         MEXIT                                                          00041000
.*                                                                      00042000
.*                                                                      00043000
.*                                                                      00044000
.T       AIF   (&LEN GT 80).TABU                                        00045000
&PCCPOS  SETA  &LEN                                                     00046000
         MEXIT                                                          00047000
.TABU    MNOTE 4,'TAB PAST POSITION 80 TREATED AS LNE NEXT'             00048000
.SPACEU  LNE                                                            00049000
         MEXIT                                                          00050000
.*                                                                      00051000
.*                                                                      00052000
.*                                                                      00053000
.H       ANOP                                                           00054000
&PCCLTYP SETA  0                                                        00055000
         AGO   .TSTLAB                                                  00056000
.*                                                                      00057000
.*                                                                      00058000
.*                                                                      00059000
.V       ANOP                                                           00060000
&PCCLTYP SETA  1                                                        00061000
.TSTLAB  AIF   (T'&LAB EQ 'N').LABN                                     00062000
         AIF   (T'&LAB EQ 'O').TSTBLEN                                  00063000
&L2      SETA  K'&LAB                                                   00064000
         AIF   ('&LAB'(1,1) NE '''').TSTBLEN                            00065000
&L2      SETA  &L2-2                                                    00066000
         AGO   .TSTBLEN                                                 00067000
.LABN    ANOP                                                           00068000
&L2      SETA  &LAB                                                     00069000
.TSTBLEN AIF   (T'&BLEN EQ 'O').NOBLEN                                  00070000
&L3      SETA  &BLEN                                                    00071000
.NOBLEN  AIF   ('&TYP' EQ 'V' AND &PCCPOS+&L2 LE 81                    *00072000
               AND &PCCPOS+&LEN LE 81                                  *00073000
               OR &PCCPOS+&L2+&LEN LE 81).NOSKIP                        00074000
         LNE                                                            00075000
.NOSKIP  AIF   ('&TYP' EQ 'H').HORG                                     00076000
&LN      SETA  &L2                                                      00077000
         AIF   (&LN GE &LEN).VORG                                       00078000
&LN      SETA  &LEN                                                     00079000
.VORG    AIF   (&L2 EQ 0).NOVL                                          00080000
         ORG   BUF+(&PCCLINE-1)*80+&PCCPOS+&LN-&L2-1                    00081000
L&L      DS    CL&L2                                                    00082000
.NOVL    ORG   BUF+&PCCLINE*80+&PCCPOS+&LN-&LEN-1                       00083000
B&L      DS    CL&LEN                                                   00084000
&PCCPOS  SETA  &PCCPOS+&LN+&L3                                          00085000
         MEXIT                                                          00086000
.HORG    ORG   BUF+(&PCCLINE-1)*80+&PCCPOS-1                            00087000
         AIF   (&L2 EQ 0).NOHL                                          00088000
L&L      DS    CL&L2                                                    00089000
         AIF   ('&SEP' EQ '' OR '&SEP' EQ '0').NOHL                     00090000
&L2      SETA  &L2+&SEP                                                 00091000
         DS    CL&SEP                                                   00092000
.NOHL    AIF   (&LEN EQ 0).NOHB                                         00093000
B&L      DS    CL&LEN                                                   00094000
.NOHB    ANOP                                                           00095000
&PCCPOS  SETA  &PCCPOS+&L2+&LEN+&L3                                     00096000
         MEND                                                           00097000
./ ADD NAME=FLGTAB
         MACRO                                                          00010000
&NM      FLGTAB &MASK,&TEXT,&LEN,&MLEN=                                 00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*  THIS MACRO GENERATES A TABLE OF FLAG BITS AND MATCHING TEXT       * 00050000
.*  &MLEN (ON THE FIRST ENTRY) SPECIFIES THE BIT MASK LENGTH IN BYTES * 00060000
.*  &TEXT SPECIFIES THE QUOTED OR UNQUOTED TEXT FOR THAT BIT MASK     * 00070000
.*  &LEN OPTIONALLY OVERRIDES THE CALCULATED TEXT LENGTH              * 00080000
.*                                                                    * 00090000
.*--------------------------------------------------------------------* 00100000
         GBLC  &ZZFGTLN      REMEMBER LENGTH GLOBALLY                   00110000
         LCLA  &I,&K,&L                                                 00120000
         LCLB  &QUO                                                     00130000
         LCLC  &Q1,&Q2                                                  00140000
.*                                                                      00150000
.*  CHECK END REQUEST                                                   00160000
.*                                                                      00170000
         AIF   ('&MASK' EQ '*END').END                                  00180000
.*                                                                      00190000
&QUO     SETB  ('&TEXT'(1,1) EQ '''')                                   00200000
         AIF   (&QUO).NOFRAME                                           00210000
&Q1      SETC  ''''                                                     00220000
&Q2      SETC  ''''                                                     00230000
.*                                                                      00240000
.*  SET GLOBAL LENGTH AS NEEDED                                         00250000
.*                                                                      00260000
.NOFRAME AIF   ('&MLEN' EQ '').NOTMLEN                                  00270000
&ZZFGTLN SETC  '&MLEN'                                                  00280000
.NOTMLEN AIF   ('&ZZFGTLN' NE '').GOTMLEN                               00290000
&ZZFGTLN SETC  '1'           DEFAULT MASK LENGTH IS 1                   00300000
.*                                                                      00310000
.*  WHEN USER SPECIFIES A LENGTH, JUST EXPAND THE REQUEST               00320000
.*                                                                      00330000
.GOTMLEN AIF   ('&LEN' EQ '').COMLEN                                    00340000
&NM      DC    AL1(&LEN-1),AL(&ZZFGTLN)(&MASK),CL(&LEN)&Q1&TEXT&Q2      00350000
         MEXIT ,                                                        00360000
.*                                                                      00370000
.*  CALCULATE THE LENGTH OF THE TEXT ITEM                               00380000
.*                                                                      00390000
.COMLEN  AIF   (&QUO).QUOADJ                                            00400000
&L       SETA  K'&TEXT                                                  00410000
&I       SETA  &L                                                       00420000
&K       SETA  1                                                        00430000
         AGO   .LOOP                                                    00440000
.QUOADJ  ANOP  ,                                                        00450000
&L       SETA  K'&TEXT-2                                                00460000
&I       SETA  &L-1                                                     00470000
&K       SETA  2                                                        00480000
.*                                                                      00490000
.*  SCAN FOR DOUBLE QUOTES, AND DECREMENT LENGTH BY ONE                 00500000
.*                                                                      00510000
.LOOP    AIF   (&K GE &I).EXPQ                                          00520000
         AIF   ('&TEXT'(&K,2) EQ '''''').DOUB                           00530000
&K       SETA  &K+1                                                     00540000
         AGO   .LOOP                                                    00550000
.DOUB    ANOP                                                           00560000
&K       SETA  &K+2                                                     00570000
&L       SETA  &L-1                                                     00580000
         AGO   .LOOP                                                    00590000
.*                                                                      00600000
.*  GENERATE WITH FORCED LENGTH                                         00610000
.*                                                                      00620000
.EXPQ    ANOP                                                           00630000
&NM      DC    AL1(&L-1),AL(&ZZFGTLN)(&MASK),CL(&L)&Q1&TEXT&Q2          00640000
         MEXIT ,                                                        00650000
.END     ANOP  ,                                                        00660000
&NM      DC    AL1(255)      END OF FLAG TABLE ENTRIES                  00670000
         MEND  ,                                                        00680000
./ ADD NAME=FLOATD
         MACRO                                                          00010000
&NM      FLOATD &RI,&WORK=DB,&RO=R0                              85132  00020000
         GBLB  &ZZF@FLT                                                 00030000
         LCLA  &I                                                       00040000
&I       SETA  &SYSNDX                                                  00050000
&NM      MACPARM R0,(&RI),OP=LR,OPR=LR,OPM=LCR,OPMR=LCR                 00060000
         MACPARM R14,ZZF@FLT,OP=BAL                                     00070000
         MACPARM &RO,(R0),OP=LER,OPR=LER,OPM=LCER,OPMR=LCER     GP03007 00080000
         AIF   (&ZZF@FLT).MEND                                          00090000
&ZZF@FLT SETB  1                                                        00100000
         B     ZZF@&I                                                   00110000
ZZF@FLT  ST    R0,4+&WORK    STASH                                      00120000
         XI    &WORK+4,X'80' FLIP A BIT                                 00130000
         MVC   &WORK.(4),=X'4E00000080000000'                           00140000
         LD    R0,&WORK                                                 00150000
         SD    R0,=X'4E00000080000000' NORMALIZE                        00160000
         BR    R14           RETURN                                     00170000
ZZF@&I   DS    0H                                                       00180000
.MEND    MEND  ,                                                        00190000
./ ADD NAME=#FMT
         MACRO ,                                                        00010000
&NM      #FMT  &VALUE,&OLN,&SIGN=,&CENT=N,&GROUP=N,                    *00020000
               &FILL=N,&LJUST=N,&SPACE=N,&TRUNC=N,&TYPE=DEC,           *00030000
               &OPT=,&CALL=CALL,&MF=S                           GP04118 00040000
.*--------------------------------------------------------------------* 00050000
.*  THIS MACRO INVOKES NUMERIC FORMATTING SERVICES (VIA @FORMATS)     * 00060000
.*                                                                    * 00070000
.*  FIRST POSITIONAL IS ADDRESS/NAME OF VALUE                         * 00080000
.*  SECOND POSITIONAL USED TO SPECIFY (FORCED) OUTPUT LENGTH          * 00090000
.*                                                                    * 00100000
.*  OTHER SERVICES:    SIGN=Y - NEGATIVE # PREFIXED BY MINUS(DEFAULT) * 00110000
.*     CENT=Y  - FORMAT A DECIMAL NUMBER WITH TWO PLACES WWW.PP       * 00120000
.*     GROUP=Y - FORMAT IN GROUPS OF THREE 123,456                    * 00130000
.*     FILL=Y  - FILL WITH LEADING ZEROES  00012300                   * 00140000
.*     LJUST=Y - LEFT JUSTIFY THE NUMBER, THEN ABUT TEXT              * 00150000
.*     SPACE=Y - ONE SPACE BETWEEN NUMBER AND TEXT                    * 00160000
.*     TRUNC=N - OVERFLOW (***) WHEN SIGNIFICANT DIGITS LOST (CC=4)   * 00170000
.*                                                                    * 00180000
.*  TYPE=TEXT ADDED. WHEN INPUT=OUTPUT LENGTH, MOVED AND TRANSLATED   * 00190000
.*     OTHERWISE RIGHT JUSTIFIED EXCEPT WHEN LJUST=Y OR CENT=Y        * 00200000
.*  FOR MF NOT =L, VALUE MAY NOW BE A LITERAL                         * 00210000
.*                                                                    * 00220000
.*     CLOSE=YES - FREE THEE DYNAMICALLY ACQUIRED WORK AREA           * 00230000
.*                                                                    * 00240000
.*  EXCEPT FOR LJUST=Y, ALL OUTPUT FIELDS WILL BE THE MAXIMUM LENGTH  * 00250000
.*  POSSIBLE (TO MAINTAIN COMMON ALIGNMENT) DEPENDING ON THE INPUT    * 00260000
.*  LENGTH.  OUTPUT LENGTH INCLUDES SIGN (UNLESS SIGN=N) AND COMMAS   * 00270000
.*  AND PERIODS.  OR SPECIFY EXPLICIT OUTPUT LENGTH (NUM,LEN)         * 00280000
.*  LJUST=Y WITH SHORT LENGTH TRUNCATES ON RIGHT, ELSE LEFT.          * 00290000
.*                                                                    * 00300000
.* INVOCATION WITH #FMT *END OR #FMT OPT=CLOSE RELEASES THE WORK AREA * 00310000
.*                                                                    * 00320000
.* MF=L EXPANDS A FOUR BYTE DEFINITION; REQUIRES ABSOLUTE OR SELF-    * 00330000
.*  DEFINING TERMS FOR THE LENGTHS (USED WITH #OPMSG/SUBWTO)          * 00340000
.*--------------------------------------------------------------------* 00350000
.*  MAINTENANCE  2012-11-15  CHANGED DEFAULTS FOR SIGN TO DEPEND ON   * 00360000
.*                           TYPE (N FOR ABS, HEX, AND TEXT; Y OTHER) * 00370000
.*                                                                    * 00380000
.*                                                                    * 00390000
.*                                                                    * 00400000
.*                                                                    * 00410000
.*--------------------------------------------------------------------* 00420000
         GBLC  &MACPLAB                                                 00430000
&MACPLAB SETC  '&NM'                                                    00440000
         LCLA  &EPYT,&OPTS                                              00450000
         LCLA  &K,&I,&J,&N                                      GP04118 00460000
         LCLB  &O01,&O02,&O04,&O08,&O10,&O20,&O40,&O80                  00470000
         LCLC  &L,&LOL,&LIN,&LON                                GP04118 00480000
&L       SETC  'L'''                                                    00490000
         AIF   ('&VALUE' EQ '*END').QUIT                                00500000
&N       SETA  N'&VALUE                                         GP04118 00510000
         AIF   ('&OPT' EQ 'CLOSE' OR '&OPT' EQ 'END').QUIT              00520000
&O80     SETB  ('&SIGN' EQ 'Y' OR '&SIGN' EQ 'YES')                     00530000
&O40     SETB  ('&LJUST' EQ 'Y' OR '&LJUST' EQ 'YES')                   00540000
&O20     SETB  ('&SPACE' EQ 'Y' OR '&SPACE' EQ 'YES')                   00550000
&O10     SETB  ('&FILL' EQ 'Y' OR '&FILL' EQ 'YES')                     00560000
&O08     SETB  ('&TRUNC' EQ 'Y' OR '&TRUNC' EQ 'YES')                   00570000
.*&O04     SETB  ('&O04' EQ 'Y' OR '&O04' EQ 'YES')                     00580000
&O02     SETB  ('&GROUP' EQ 'Y' OR '&GROUP' EQ 'YES')                   00590000
&O01     SETB  ('&CENT' EQ 'Y' OR '&CENT' EQ 'YES')                     00600000
&EPYT    SETA  1                                                GP04118 00610000
         AIF   ('&VALUE'(1,1) EQ '''').LITT                     GP12319 00620000
         AIF   ('&TYPE' EQ 'TXT' OR '&TYPE' EQ 'TEXT').LADD     GP04118 00630000
&EPYT    SETA  2                                                        00640000
         AIF   ('&TYPE' EQ 'DEC' OR '&TYPE' EQ 'PACKED').LADD           00650000
&EPYT    SETA  3                                                        00660000
         AIF   ('&TYPE' EQ 'ADEC' OR '&TYPE' EQ 'ABSDEC').LADD          00670000
&EPYT    SETA  4                                                        00680000
         AIF   ('&TYPE' EQ 'INT' OR '&TYPE' EQ 'INTEGER').LADD          00690000
&EPYT    SETA  5                                                        00700000
         AIF   ('&TYPE' EQ 'AINT' OR '&TYPE' EQ 'ABSINT').LADD          00710000
&EPYT    SETA  6                                                        00720000
         AIF   ('&TYPE' EQ 'SHEX').LADD                                 00730000
&EPYT    SETA  7                                                        00740000
         AIF   ('&TYPE' EQ 'HEX' OR '&TYPE' EQ 'X').LADD        GP12319 00750000
&EPYT    SETA  8                                                        00760000
         AIF   ('&TYPE' EQ 'SBIN' OR '&TYPE' EQ 'SBIT').LADD            00770000
&EPYT    SETA  9                                                        00780000
         AIF   ('&TYPE' EQ 'BIN' OR '&TYPE' EQ 'BINARY').LADD           00790000
         MNOTE 8,'#FMT: INVALID DATA TYPE &TYPE '               GP12319 00800000
&EPYT    SETA  7             DO AS HEX                                  00810000
         AGO   .LADD                                            GP12319 00820000
.LITT    AIF   ('&TYPE' EQ '' OR '&TYPE' EQ 'TEXT' OR '&TYPE' EQ 'TXT')*00830000
               .LADD                                                    00840000
         MNOTE 4,'#FMT: QUOTED STRING INVALID WITH TYPE &TYPE'  GP12319 00850000
.LADD    AIF   (T'&SIGN NE 'O').LADDLE   HAVE SIGN PREFERENCE   GP12319 00860000
&O80     SETB  (&O80 OR ('010101010'(1,&EPYT) EQ '1'))          GP12319 00870000
.LADDLE  ANOP  ,                                                GP12319 00880000
&OPTS    SETA  &O80*128+&O40*64+&O20*32+&O10*16                         00890000
&OPTS    SETA  &OPTS+&O08*8+&O04*4+&O02*2+&O01                          00900000
         AIF   ('&MF' EQ 'L').DCONLY                            GP04118 00910000
         AIF   ('&VALUE'(1,1) NE '''').NOLIT                    GP04118 00920000
&EPYT    SETA  K'&VALUE-2    BORROW VARIABLE                    GP04118 00930000
&LIN     SETC  '&EPYT'       SET INPUT LENGTH DEFAULT           GP04118 00940000
&EPYT    SETA  1             FORCE TEXT MODE FOR LITERAL        GP04118 00950000
         AIF   (&N LT 2).LITLEN                                 GP04118 00960000
&LIN     SETC  '&VALUE(2)'                                      GP04118 00970000
.LITLEN  MACPARM R0,=AL1(&OLN,&LIN,&EPYT,&OPTS),OP=L            GP04118 00980000
         MACPARM R1,=C&VALUE(1)                                 GP04118 00990000
         AGO   .CMNUML                                          GP04118 01000000
.NOLIT   AIF   ('&OLN' EQ '').NOLOAD                            GP04118 01010000
         MACPARM R0,12,=Y(&OLN*256),OP=ICM,MODE=THREE USER'S LENGTH     01020000
         MACPARM R0,3,=Y(&EPYT*256+&OPTS),OP=ICM,MODE=THREE TYPE        01030000
         AGO   .TESTCC                                                  01040000
.NOLOAD  MACPARM R0,&EPYT*256+&OPTS,OP=LA   LOAD FORMATTING SELECTION   01050000
.TESTCC  AIF   (&N LT 2).NONUML                                 GP04118 01060000
         MACPARM R1,&VALUE(1),OP=LA LOAD ADDRESS OF PACKED COUNTER      01070000
         MACPARM R0,4,=AL1(&VALUE(2)),OP=ICM,MODE=THREE                 01080000
         AGO   .CMNUML                                                  01090000
.NONUML  MACPARM R1,&VALUE,OP=LA LOAD ADDRESS OF PACKED COUNTER         01100000
         MACPARM R0,4,=AL1(&L&VALUE),OP=ICM,MODE=THREE                  01110000
         AGO   .CMNUML                                                  01120000
.QUIT    MACPARM R0,(R0),OP=SR,OPR=SR,MODE=EVEN SET THE SHUTDOWN SIGNAL 01130000
         MACPARM R1,(R1),OP=SR,OPR=SR,MODE=EVEN   R0=R1=0       GP03122 01140000
.CMNUML  AIF   ('&CALL' EQ 'CALL').LOAD@                        GP03287 01150000
         AIF   ('&CALL' EQ 'CALLA').LOADA                       GP03287 01160000
         AIF   ('&CALL' EQ 'CALLV').LOADV                       GP03287 01170000
         MNOTE 4,'#CNVRT: UNRECOGNIZED CALL=&CALL '             GP03287 01180000
.LOADV   MACPARM R15,=V(@FORMATS),OP=L                          GP03287 01190000
         AGO   .LOADCOM                                         GP03287 01200000
.LOADA   MACPARM R15,=A(@FORMATS),OP=L                          GP03287 01210000
         AGO   .LOADCOM                                         GP03287 01220000
.LOAD@   MACPARM R15,@FORMATS,OP=L   LOAD CONVERSION ROUTINE ADDRESS    01230000
.LOADCOM ANOP  ,                                                GP03287 01240000
         BASR  R14,R15       CALL FORMATTING SERVICES                   01250000
         MEXIT ,                                                        01260000
.DCONLY  AIF   (&N LT 2).DCNUML                                 GP04118 01270000
&LIN     SETC  '&VALUE(2)'                                      GP04118 01280000
         AGO   .QUOUT                                           GP04118 01290000
.DCNUML  ANOP  ,                                                GP04118 01300000
&LIN     SETC  '&L'.'&VALUE'                                    GP04118 01310000
.QUOUT   AIF   ('&OLN' EQ '').QUODEF                            GP04118 01320000
&LON     SETC  '&OLN'                                           GP04118 01330000
         AGO   .DCDC                                            GP04118 01340000
.QUODEF  ANOP  ,                                                GP04118 01350000
&LON     SETC  '0'                                              GP04118 01360000
.*                                                              GP04118 01370000
.DCDC    MACPARM AL1(&LON,&LIN,&EPYT,&OPTS),MODE=ONE,OP=DC      GP04118 01380000
         MEND  ,                                                        01390000
./ ADD NAME=FMT
         MACRO ,                                                        00010000
&NM      FMT   &VALUE,&OLN,&SIGN=Y,&CENT=N,&GROUP=N,                   *00020000
               &FILL=N,&LJUST=N,&SPACE=N,&TRUNC=N,&TYPE=DEC             00030000
.********************************************************************** 00040000
.*                                                                      00050000
.*  THIS MACRO INVOKES NUMERIC FORMATTING SERVICES (VIA @FORMATS)       00060000
.*                                                                      00070000
.*  FIRST POSITIONAL IS ADDRESS/NAME OF VALUE                           00080000
.*  SECOND POSITIONAL USED TO SPECIFY (FORCED) OUTPUT LENGTH            00090000
.*                                                                      00100000
.*  OTHER SERVICES:    SIGN=Y - NEGATIVE # PREFIXED BY MINUS(DEFAULT)   00110000
.*     CENT=Y  - FORMAT A DECIMAL NUMBER WITH TWO PLACES WWW.PP         00120000
.*     GROUP=Y - FORMAT IN GROUPS OF THREE 123,456                      00130000
.*     FILL=Y  - FILL WITH LEADING ZEROES  00012300                     00140000
.*     LJUST=Y - LEFT JUSTIFY THE NUMBER, THEN ABUT TEXT                00150000
.*     SPACE=Y - ONE SPACE BETWEEN NUMBER AND TEXT                      00160000
.*     TRUNC=N - OVERFLOW (***) WHEN SIGNIFICANT DIGITS LOST (CC=4)     00170000
.*                                                                      00180000
.*  EXCEPT FOR LJUST=Y, ALL OUTPUT FIELDS WILL BE THE MAXIMUM LENGTH    00190000
.*  POSSIBLE (TO MAINTAIN COMMON ALIGNMENT) DEPENDING ON THE INPUT      00200000
.*  LENGTH.  OUTPUT LENGTH INCLUDES SIGN (UNLESS SIGN=N) AND COMMAS     00210000
.*  AND PERIODS.  OR SPECIFY EXPLICIT OUTPUT LENGTH (NUM,LEN)           00220000
.*  LJUST=Y WITH SHORT LENGTH TRUNCATES ON RIGHT, ELSE LEFT.            00230000
.*                                                                      00240000
.********************************************************************** 00250000
         GBLC  &MACPLAB                                                 00260000
&MACPLAB SETC  '&NM'                                                    00270000
         LCLA  &EPYT,&OPTS                                              00280000
         LCLA  &K,&I,&J                                                 00290000
         LCLB  &O01,&O02,&O04,&O08,&O10,&O20,&O40,&O80                  00300000
         LCLC  &L                                                       00310000
&L       SETC  'L'''                                                    00320000
&O80     SETB  ('&SIGN' EQ 'Y' OR '&SIGN' EQ 'YES')                     00330000
&O40     SETB  ('&LJUST' EQ 'Y' OR '&LJUST' EQ 'YES')                   00340000
&O20     SETB  ('&SPACE' EQ 'Y' OR '&SPACE' EQ 'YES')                   00350000
&O10     SETB  ('&FILL' EQ 'Y' OR '&FILL' EQ 'YES')                     00360000
&O08     SETB  ('&TRUNC' EQ 'Y' OR '&TRUNC' EQ 'YES')                   00370000
.*&O04     SETB  ('&O04' EQ 'Y' OR '&O04' EQ 'YES')                     00380000
&O02     SETB  ('&GROUP' EQ 'Y' OR '&GROUP' EQ 'YES')                   00390000
&O01     SETB  ('&CENT' EQ 'Y' OR '&CENT' EQ 'YES')                     00400000
&OPTS    SETA  &O80*128+&O40*64+&O20*32+&O10*16                         00410000
&OPTS    SETA  &OPTS+&O08*8+&O04*4+&O02*2+&O01                          00420000
         AIF   ('&TYPE' EQ 'DEC' OR '&TYPE' EQ 'PACKED').LADD           00430000
&EPYT    SETA  1                                                        00440000
         AIF   ('&TYPE' EQ 'ADEC' OR '&TYPE' EQ 'ABSDEC').LADD          00450000
&EPYT    SETA  2                                                        00460000
         AIF   ('&TYPE' EQ 'INT' OR '&TYPE' EQ 'INTEGER').LADD          00470000
&EPYT    SETA  3                                                        00480000
         AIF   ('&TYPE' EQ 'AINT' OR '&TYPE' EQ 'ABSINT').LADD          00490000
&EPYT    SETA  5                                                        00500000
         AIF   ('&TYPE' EQ 'HEX').LADD                                  00510000
&EPYT    SETA  6                                                        00520000
         AIF   ('&TYPE' EQ 'SBIN' OR '&TYPE' EQ 'SBIT').LADD            00530000
&EPYT    SETA  7                                                        00540000
         AIF   ('&TYPE' EQ 'BIN' OR '&TYPE' EQ 'BINARY').LADD           00550000
         MNOTE 8,'INVALID NUMERIC TYPE=&TYPE '                          00560000
&EPYT    SETA  4             DO AS HEX                                  00570000
.LADD    AIF   ('&OLN' EQ '').NOLOAD                                    00580000
         MACPARM R0,12,=Y(&OLN*256),OP=ICM,MODE=THREE USER'S LENGTH     00590000
         MACPARM R0,3,=Y(&EPYT*256+&OPTS),OP=ICM,MODE=THREE TYPE        00600000
         AGO   .TESTCC                                                  00610000
.NOLOAD  MACPARM R0,&EPYT*256+&OPTS,OP=LA   LOAD FORMATTING SELECTION   00620000
.TESTCC  AIF   (N'&VALUE LT 2).NONUML                                   00630000
         MACPARM R1,&VALUE(1),OP=LA LOAD ADDRESS OF PACKED COUNTER      00640000
         MACPARM R0,4,=AL1(&VALUE(2)),OP=ICM,MODE=THREE                 00650000
         AGO   .CMNUML                                                  00660000
.NONUML  MACPARM R1,&VALUE,OP=LA LOAD ADDRESS OF PACKED COUNTER         00670000
         MACPARM R0,4,=AL1(&L&VALUE),OP=ICM,MODE=THREE                  00680000
.CMNUML  MACPARM R15,=V(@FORMATS),OP=L                                  00690000
         BASR  R14,R15       CALL FORMATTING SERVICES                   00700000
         MEND  ,                                                        00710000
./ ADD NAME=#FOOT
         MACRO ,                                                        00010000
&NM      FOOT  &VAL,&LEN,&ID=                                           00020000
&NM      STM   R14,R1,12(R13)     SAVE A LOT                            00030000
         L     R14,EXW@RENT+8     NEW WORK AREA #2                      00040000
         L     R15,0(,R14)        GET CURRENT OFFSET                    00050000
         LA    R1,4(R15,R14)      NEW INSERTION ADDRESS                 00060000
         AIF   ('&ID' EQ '').NOID                                       00070000
         MVC   0(8,R1),=CL8'&ID '                                       00080000
         LA    R15,8(,R15)        INCREMENT                             00090000
         LA    R1,8(,R1)                                                00100000
.NOID    MVC   0(&LEN,R1),&VAL    PRESERVE TEXT                         00110000
         LA    R15,&LEN.(,R15)                                          00120000
         ST    R15,0(,R14)                                              00130000
         LM    R14,R1,12(R13)     RESTORE                               00140000
         MEND  ,                                                        00150000
./ ADD NAME=FSAWORK
         MACRO ,                                                        00010000
&NM      FSAWORK &PFX=FSA                               ADDED ON 81149  00020000
         LCLC  &NAME                                                    00030000
&NAME    SETC  'FSAWORK'                                                00040000
         AIF   ('&NM' EQ '').NONAME                                     00050000
&NAME    SETC  '&NM'                                                    00060000
.NONAME  ANOP  ,                                                        00070000
&NAME    DSECT ,             HEADER FOR WORK AREAS CHAINED FROM TCBFSA  00080000
&PFX.LINK  DC  A(0)          POINTER TO NEXT AREA ON CHAIN              00090000
&PFX.ID    DC  CL4' '        NAME OF THIS WORK AREA                     00100000
&PFX.SPLEN DC  F'0'          SUBPOOL/LENGTH OF THIS ENTRY               00110000
&PFX.TCB   DC  A(0)          TCB ADDRESS OF OWNER                       00120000
&PFX.PFXL  EQU *-&PFX.LINK   SIZE OF PREFIX                             00130000
         MEND  ,                                                        00140000
./ ADD NAME=GETCC
         MACRO ,                                                        00010000
&NM      GETCC &R                                       ADDED ON 93168  00020000
         GBLB  &MVSXA                                                   00030000
         GBLC  &SYSSPLV                                          93097  00040000
         AIF   (NOT &MVSXA AND '&SYSSPLV' LT '2').TLAB           93097  00050000
&NM      IPM   &R            INSERT COND.CODE AND PROG.MASK             00060000
         MEXIT ,                                                        00070000
.TLAB    ANOP  ,                                                GP08252 00080000
&NM      BALR  &R,0          LOAD COND.CODE AND PROG.MASK               00090000
.MEND    MEND  ,                                                        00100000
./ ADD NAME=GETJESID
         MACRO ,                                                        00010000
&NM      GETJESID &ASCBREG=R15,&HCTREG=R15,&SVT=,&HCT=ADDRHCT,&SVTREG=R*00020000
               1,&ERR=EXCXCB                                            00030000
.********************************************************************** 00040000
.*                                                                   ** 00050000
.*   EXHIBIT SUBROUTINE TO FIND JES2 INFORMATION                     ** 00060000
.*                                                                   ** 00070000
.********************************************************************** 00080000
&NM      MVC   INVOKE(8),=CL8'* JES2 *'                                 00090000
         SLR   R0,R0         SET FUNCTION = GET SUBSYSTEM        87268  00100000
         BALS  R14,EXWMVS    GET EXTENDED FUNCTION               87268  00110000
         MVC   INVOKE+2(4),EXWJ2NAM  GET CURRENT SUBSYSTEM NAME         00120000
         MACPARM R15,R15,&ERR,OP=BXH,MODE=THREE                 GP08225 00130000
         L     R0,EXWJ2AID   GET JES ASID                               00140000
         BALS  R14,EXWGETAS  CHECK STATUS                               00150000
         AIF   ('&ASCBREG' EQ '').SKPASCB                       GP08225 00160000
         LTR   &ASCBREG,R15  TEST ASCB ADDRESS                  GP08225 00170000
         MACPARM &ERR,OP=BZ,OPR=BZR,MODE=ONE     JES GONE ?     GP08225 00180000
.SKPASCB ICM   &SVTREG,15,HASPHCT  TEST SVT ADDRESS             GP08225 00190000
         MACPARM &ERR,OP=BZ,OPR=BZR,MODE=ONE     JES GONE ?     GP08225 00200000
         USING SSVT,&SVTREG                                     GP08225 00210000
         MACPARM &SVTREG,&SVT,OP=ST,OPR=LR,NULL=SKIP            GP08225 00220000
         CLC   $SVQLOKE,EXWJ2NAM  NOT CLOBBERED ?                       00230000
         MACPARM &ERR,OP=BNE,OPR=BNER,MODE=ONE   JES GONE ?     GP08225 00240000
         MVC   EXWCRMID,EXWJ2AID  SET ASID                              00250000
         AIF   ('&HCTREG' EQ '').SKIPHCT                        GP08225 00260000
         MACPARM &HCTREG,15,$SVHCT,OP=ICM,MODE=THREE,NULL=SKIP  GP08225 00270000
         AIF   ('&HCT' EQ '').SKIPHCT                                   00280000
         ST    &HCTREG,&HCT  STASH $HCT ADDRESS                 GP08225 00290000
.SKIPHCT NEED  $HCT          FORCE HCT AND SVT                          00300000
         DROP  &SVTREG                                                  00310000
         MEND  ,                                                        00320000
./ ADD NAME=GETREG
         MACRO ,                                                        00010000
&NM      GETREG &R1,&R2,&MODE=OS,&WORK=R15                      GP04234 00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*   LOAD REGISTER(S) FROM SAVE AREA OR STACK                         * 00050000
.*   MODE = OS - R13 IS CURRENT SAVE AREA; GET FROM OLDER S.A.        * 00060000
.*   MODE = USER - R13 POINTS TO USER'S AREA                          * 00070000
.*   MODE = BAKR (OR ZZZBAKR GLOBAL ON) - USE EREG                    * 00080000
.*                                                                    * 00090000
.*   ONLY R14 - R12 ARE VALID, AND OPTIONAL SECOND REGISTER MUST      * 00100000
.*     NOT BE SAVE AREA AFTER FIRST (R14-R5 OK; R12-R15 NOT)          * 00110000
.*                                                                    * 00120000
.********************************************************************** 00130000
         GBLB  &MVSESA,&ZZZBAKR                                         00140000
         GBLC  &MACPLAB                                                 00150000
         LCLC  &O1,&O2,&W,&F                                            00160000
&MACPLAB SETC  '&NM'                                                    00170000
&W       SETC  '&WORK'                                                  00180000
&O1      SETC  '&R1(1)'                                                 00190000
&O2      SETC  '&R2(1)'                                                 00200000
         AIF   ('&O2' NE '').O                                          00210000
&O2      SETC  '&O1'                                                    00220000
.O       AIF   ('&MODE' EQ 'BAKR' OR &ZZZBAKR).BAKR                     00230000
&F       SETC  '4*((&O1+2)-(((&O1+2)/16)*16))+12'                       00240000
   AIF   ('&MODE' EQ 'OS' OR '&MODE' EQ 'OSSAVE' OR '&MODE' EQ '').STD  00250000
&W       SETC  'R13'         ALREADY POINTS TO USER'S SAVE AREA         00260000
         AIF   ('&MODE' EQ 'USER').USER                                 00270000
         MNOTE 4,'GETREG: INVALID MODE=&MODE '                          00280000
.STD     AIF   ('&O2' EQ '0' OR '&O2' EQ 'R0').STD1                     00290000
&W       SETC  '&O2'                                                    00300000
         AGO   .STDL                                                    00310000
.STD1    AIF   ('&O1' EQ '0' OR '&O1' EQ 'R0').STDL                     00320000
&W       SETC  '&O1'                                                    00330000
.STDL    MACPARM &W,4(,R13),OP=L  USER'S SAVE AREA                      00340000
.USER    AIF   ('&O1' NE '&O2').STDLM                                   00350000
         MACPARM &O1,&F.(,&W),OP=L                                      00360000
         MEXIT ,                                                        00370000
.STDLM   MACPARM &O1,&O2,&F.(&W),OP=LM,MODE=THREE                       00380000
         MEXIT ,                                                        00390000
.BAKR    EREG  &O1,&O2                                                  00400000
         MEND  ,                                                        00410000
./ ADD NAME=HCON
         MACRO ,                                                        00010000
&NM      HCON  &STR,&END=                              ADDED ON GP02298 00020000
         GBLB  &VCON@OP                                                 00030000
         GBLC  &VCON@NM                                                 00040000
         LCLA  &I,&J,&K,&L                                              00050000
.********************************************************************** 00060000
.**                                                                  ** 00070000
.**  HCON BUILDS A TEXT MESSAGE BEGINNING WITH A TWO-BYTE LENGTH,    ** 00080000
.**    FOLLOWED BY TEXT.                                             ** 00090000
.**                                                                  ** 00100000
.**  USE   HCON  'TEXT'                                              ** 00110000
.**                                                                  ** 00120000
.**  OR    HCON  'TEXT1',END=LABEL                                   ** 00130000
.**        DC     ...ZERO OR MORE STORAGE ITEMS                      ** 00140000
.**  LABEL HCON   *END    TO GENERATE A SINGLE MESSAGE               ** 00150000
.**                                                                  ** 00160000
.********************************************************************** 00170000
&K       SETA  K'&STR                                                   00180000
         AIF   (T'&END NE 'O').TSTOPEN                                  00190000
         AIF   (T'&STR EQ 'O').CLOSE                                    00200000
         AIF   ('&STR'(1,1) EQ '*').CLOSE                               00210000
.TSTOPEN AIF   (&K EQ 0).COMLEN                                         00220000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00230000
&I       SETA  2                                                        00240000
&J       SETA  &K-2                                                     00250000
&K       SETA  &J                                                       00260000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00270000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00280000
&I       SETA  &I+1                                                     00290000
         AGO   .INC                                                     00300000
.SK2     ANOP  ,                                                        00310000
&I       SETA  &I+2                                                     00320000
&K       SETA  &K-1                                                     00330000
.INC     AIF   (&I LE &J).LOOP                                          00340000
.COMLEN  AIF   (NOT &VCON@OP).NOPEN                                     00350000
         MNOTE 4,'PRIOR HCON/VCON NOT TERMINATED'                       00360000
&VCON@OP SETB  0                                                        00370000
.NOPEN   AIF   (T'&END NE 'O').OPEN                                     00380000
         AIF   (&K EQ 0).REQSTR                                         00390000
         AIF   ('&STR'(1,1) EQ '''').QSTR                               00400000
&NM      DC    AL2(&K),C'&STR'                                          00410000
         AGO   .MEND                                                    00420000
.QSTR    ANOP  ,                                                        00430000
&NM      DC    AL2(&K),C&STR                                            00440000
         AGO   .MEND                                                    00450000
.OPEN    AIF   (&K NE 0).OPSTR                                          00460000
&NM      DC    AL2(&END-*-2)                                            00470000
         AGO   .SETOPEN                                                 00480000
.OPSTR   AIF   ('&STR'(1,1) EQ '''').OQSTR                              00490000
&NM      DC    AL2(&END-*-2),C'&STR'                                    00500000
         AGO   .SETOPEN                                                 00510000
.OQSTR   ANOP  ,                                                        00520000
&NM      DC    AL2(&END-*-2),C&STR                                      00530000
.SETOPEN ANOP  ,                                                        00540000
&VCON@NM SETC  '&END'                                                   00550000
&VCON@OP SETB  1                                                        00560000
         MEXIT ,                                                        00570000
.REQSTR  MNOTE 4,'TEXT STRING REQUIRED'                                 00580000
         MEXIT ,                                                        00590000
.CLOSE   AIF   (&VCON@OP).WASOPEN                                       00600000
         MNOTE 4,'HCON/VCON END OUT OF SEQUENCE'                        00610000
.WASOPEN AIF   ('&NM' EQ '' OR '&NM' EQ '&VCON@NM').BLAB                00620000
&NM      EQU   *                                                        00630000
.BLAB    ANOP  ,                                                        00640000
&VCON@NM EQU   *                                                        00650000
&VCON@NM SETC  ''                                                       00660000
&VCON@OP SETB  0                                                        00670000
.MEND    MEND  ,                                                        00680000
./ ADD NAME=IAC
         MACRO ,                                                        00010000
&NM      IAC   &R                                       ADDED ON 05189  00020000
.*                                                                      00030000
.*       THIS MODULE SHOWS PRIMARY ADDRESS SPACE MODE FOR MVS 3.8       00040000
.*                                                                      00050000
&NM      MACPARM &R,2,=X'00',OP=ICM,MODE=THREE                          00060000
         MEND  ,                                                        00070000
./ ADD NAME=INCH
         MACRO ,                                                        00010000
&NM      INCH  &R,&INC=,&WORK=R0,&IN@=    RENAMED FROM COUNTH ON 89247  00020000
         GBLC  &MACPLAB                                                 00030000
         LCLA  &K                                               GP09016 00040000
         LCLB  &REG                                             GP09016 00050000
         LCLC  &WROK,&CNI                                       GP09016 00060000
&WROK    SETC  '&WORK(1)'                                       GP09016 00070000
&MACPLAB SETC  '&NM'                                                    00080000
&K       SETA  K'&R                                             GP09016 00090000
         AIF   (&K LT 3).NREG                                   GP09016 00100000
         AIF   ('&R'(1,1) NE '(' OR '&R'(2,1) EQ '(').NREG      GP09016 00110000
         AIF   ('&R'(&K,1) NE ')' OR '&R'(&K-1,1) EQ ')').NREG  GP09016 00120000
&WROK    SETC  '&R(1)'                                          GP09016 00130000
&REG     SETB  1                                                GP09016 00140000
.NREG    AIF   ('&IN@' NE '').LOAD                              GP02250 00150000
         AIF   ('&INC' EQ '-1').BCTR                                    00160000
&K       SETA  K'&INC                                           GP09016 00170000
         AIF   (&K LT 3).LA                                     GP09016 00180000
         AIF   ('&INC'(1,1) NE '(' OR '&INC'(2,1) EQ '(').LA            00190000
         AIF   ('&INC'(&K,1) NE ')' OR '&INC'(&K-1,1) EQ ')').LA        00200000
         MACPARM &WROK,&R,OP=LH,OPR=LR                                  00210000
         MACPARM &WROK,&INC,OPR=AR,OPMR=SR                       82003  00220000
         AGO   .COMST                                                   00230000
.BCTR    MACPARM &WROK,&R,OP=LH,OPR=LR                                  00240000
         MACPARM &WROK,(0-0),OPR=BCTR                                   00250000
         AGO   .COMST                                                   00260000
.LOAD    AIF   ('&INC' EQ '' OR '&INC' EQ '1').LOADER           GP02250 00270000
         MNOTE 'INCH: INC KEYWORD &INC CONFLICTS WITH IN@; IGNORED'     00280000
.LOADER  AIF   ('&WROK' EQ '&IN@(1)').LOADRV                    GP02250 00290000
         MACPARM &WROK,&R,OP=LH,OPR=LR                          GP02250 00300000
         MACPARM &WROK,&IN@,OP=AH,OPR=AR,OPM=SH,OPMR=SR         GP02250 00310000
         AGO   .COMST                                           GP02250 00320000
.LOADRV  MACPARM &WROK,(&IN@(1)),OP=LH,OPR=LR                   GP02250 00330000
         MACPARM &WROK,&R,OP=AH,OPR=AR                          GP02250 00340000
         AGO   .COMST                                           GP02250 00350000
.LA      AIF   (NOT &REG).LAST                                  GP09016 00360000
         AIF   ('&INC' NE '').AINC                              GP09016 00370000
         MACPARM &WROK,=H'1',OP=AH                              GP09016 00380000
         MEXIT ,                                                GP09016 00390000
.AINC    AIF   ('&INC'(1,1) NE '-').BINC                        GP09016 00400000
&K       SETA  K'&INC                                           GP09016 00410000
         AIF   (&K LT 4).BINC                                   GP09016 00420000
         AIF   ('&INC'(2,1) NE '(' OR '&INC'(3,1) EQ '(').BINC  GP09016 00430000
         AIF   ('&INC'(&K,1) NE ')' OR '&INC'(&K-1,1) EQ ')').BINC      00440000
&CNI     SETC  '&INC'(2,&K-1)                                           00450000
         MACPARM &WROK,&CNI,OP=SR,OPR=SR                        GP09016 00460000
         MEXIT ,                                                GP09016 00470000
.BINC    MACPARM &WROK,=AL2(&INC),OP=AH                         GP09016 00480000
         MEXIT ,                                                GP09016 00490000
.LAST    MACPARM &WROK,&INC,NULL=1                                      00500000
         MACPARM &WROK,&R,OP=AH,OPR=AR,OPM=SH,OPMR=SR            82003  00510000
.COMST   MACPARM &WROK,&R,OP=STH,OPR=LR,MODE=REV                        00520000
         MEND  ,                                                        00530000
./ ADD NAME=INC
         MACRO ,                                                        00010000
&NM      INC   &R,&INC=,&WORK=R0,&IN@=     RENAMED FROM COUNT ON 89247  00020000
         GBLC  &MACPLAB                                                 00030000
         LCLA  &K                                               GP09016 00040000
         LCLB  &REG                                             GP09016 00050000
         LCLC  &WROK,&CNI                                       GP09016 00060000
&WROK    SETC  '&WORK(1)'                                       GP09016 00070000
&MACPLAB SETC  '&NM'                                                    00080000
&K       SETA  K'&R                                             GP09016 00090000
         AIF   (&K LT 3).NREG                                   GP09016 00100000
         AIF   ('&R'(1,1) NE '(' OR '&R'(2,1) EQ '(').NREG      GP09016 00110000
         AIF   ('&R'(&K,1) NE ')' OR '&R'(&K-1,1) EQ ')').NREG  GP09016 00120000
&WROK    SETC  '&R(1)'                                          GP09016 00130000
&REG     SETB  1                                                GP09016 00140000
.NREG    AIF   ('&IN@' NE '').LOAD                              GP02250 00150000
         AIF   ('&INC' EQ '-1').BCTR                                    00160000
&K       SETA  K'&INC                                           GP09016 00170000
         AIF   (&K LT 3).LA                                     GP09016 00180000
         AIF   ('&INC'(1,1) NE '(' OR '&INC'(2,1) EQ '(').LA            00190000
         AIF   ('&INC'(&K,1) NE ')' OR '&INC'(&K-1,1) EQ ')').LA        00200000
         MACPARM &WROK,&R,OP=L,OPR=LR                                   00210000
         MACPARM &WROK,&INC,OPR=AR,OPMR=SR                       82003  00220000
         AGO   .COMST                                                   00230000
.BCTR    MACPARM &WROK,&R,OP=L,OPR=LR                                   00240000
         MACPARM &WROK,(0-0),OPR=BCTR                                   00250000
         AGO   .COMST                                                   00260000
.LOAD    AIF   ('&INC' EQ '' OR '&INC' EQ '1').LOADER           GP02250 00270000
         MNOTE 'INC: INC KEYWORD &INC CONFLICTS WITH IN@; IGNORED'      00280000
.LOADER  AIF   ('&WROK' EQ '&IN@(1)').LOADRV                    GP02250 00290000
         MACPARM &WROK,&R,OP=L,OPR=LR                           GP02250 00300000
         MACPARM &WROK,&IN@,OP=A,OPR=AR,OPM=S,OPMR=SR           GP02250 00310000
         AGO   .COMST                                           GP02250 00320000
.LOADRV  MACPARM &WROK,(&IN@(1)),OP=L,OPR=LR                    GP02250 00330000
         MACPARM &WROK,&R,OP=A,OPR=AR                           GP02250 00340000
         AGO   .COMST                                           GP02250 00350000
.LA      AIF   (NOT &REG).LAST                                  GP09016 00360000
         AIF   ('&INC' NE '').AINC                              GP09016 00370000
         MACPARM &WROK,=F'1',OP=A                               GP09016 00380000
         MEXIT ,                                                GP09016 00390000
.AINC    AIF   ('&INC'(1,1) NE '-').BINC                        GP09016 00400000
&K       SETA  K'&INC                                           GP09016 00410000
         AIF   (&K LT 4).BINC                                   GP09016 00420000
         AIF   ('&INC'(2,1) NE '(' OR '&INC'(3,1) EQ '(').BINC  GP09016 00430000
         AIF   ('&INC'(&K,1) NE ')' OR '&INC'(&K-1,1) EQ ')').BINC      00440000
&CNI     SETC  '&INC'(2,&K-1)                                           00450000
         MACPARM &WROK,&CNI,OP=SR,OPR=SR                        GP09016 00460000
         MEXIT ,                                                GP09016 00470000
.BINC    MACPARM &WROK,=A(&INC),OP=A                            GP09016 00480000
         MEXIT ,                                                GP09016 00490000
.LAST    MACPARM &WROK,&INC,NULL=1                                      00500000
         MACPARM &WROK,&R,OP=A,OPR=AR,OPM=S,OPMR=SR              82003  00510000
.COMST   MACPARM &WROK,&R,OP=ST,OPR=LR,MODE=REV                         00520000
         MEND  ,                                                        00530000
./ ADD NAME=INDEC
         MACRO                                                          00010000
&NM      INDEC &TO,&FROM,&FL                                            00020000
         GBLB  &INLINE(50)                                              00030000
         GBLC  &MACPLAB                                                 00040000
.********************************************************************** 00050000
.*                                                                   ** 00060000
.*   INLINE DECIMAL CONVERSION FROM INTEGER TO EBCDIC                ** 00070000
.*                                                                   ** 00080000
.********************************************************************** 00090000
         LCLC  &L                                                       00100000
&MACPLAB SETC  '&NM'                                                    00110000
&INLINE(11) SETB 1                                                      00120000
&L       SETC  'L'''                                                    00130000
         AIF   ('&FROM'(1,1) EQ '(').L                                  00140000
         AIF   ('&FL' EQ '').DEF                                        00150000
         AIF   ('&FL' EQ '1').IC                                        00160000
         AIF   ('&FL' EQ '2').LH                                        00170000
         AIF   ('&FL' EQ '3').LA                                        00180000
         AIF   ('&FL' EQ '4').L                                         00190000
         MNOTE 4,'INVALID LENGTH ON INDEC'                              00200000
         MEXIT                                                          00210000
.IC      ANOP                                                           00220000
         MACPARM R0,(R0),MODE=EVEN  CLEAR FOR IC                        00230000
         IC    R0,&FROM .       LOAD VALUE                              00240000
         AGO   .COM                                                     00250000
.DEF     ANOP                                                           00260000
.LH      ANOP                                                           00270000
         MACPARM R0,&FROM,OP=LH                                         00280000
         AGO   .COM                                                     00290000
.LA      ANOP                                                           00300000
         MACPARM DB+1(3),&FROM,MODE=EVEN,OP=MVC                         00310000
         MVC   DB+1(3),&FROM .     MOVE VALUE                           00320000
         MVI   DB,0 .        CLEAR HIGH BYTE                            00330000
         L     R0,DB .       LOAD VALUE                                 00340000
         AGO   .COM                                                     00350000
.L       ANOP                                                           00360000
         MACPARM R0,&FROM,OP=L                                          00370000
.COM     ANOP                                                           00380000
         MACPARM R0,DB,OP=CVD . CONVERT TO PACKED                       00390000
         MVC   DCONWORK,DCONPAT .   MOVE EDIT PATTERN                   00400000
         ED    DCONWORK,DB .   EDIT                                     00410000
         MVC   &TO,DCONWORK+16-&L&TO .   MOVE OUTPUT                    00420000
         MEND                                                           00430000
./ ADD NAME=INDSN
         MACRO ,                                                        00010000
&NM      INDSN &DSN=DRDSN,&OUT=R1,&LEN=R2,&LV=44,&IN=R5,&SAVE=   84289  00020002
         LCLA  &I,&LONG                                                 00030000
         LCLB  &SV                                              GP01013 00040002
&I       SETA  &SYSNDX                                                  00050000
&SV      SETB  ('&SAVE' EQ 'Y')                                 GP01013 00060002
&SV      SETB  (&SV OR '&SAVE' EQ 'YES')                        GP01013 00070002
&NM      MACPARM R14,&DSN                                               00080000
         MACPARM R15,&LV                                                00090000
         MACPARM R1,(&IN)                                               00100000
         AIF   (NOT &SV).NSAV1                                  GP01013 00110002
         MACPARM R10,0(R13),OP=ST                               GP01013 00120002
.NSAV1   MACPARM R10,15,EXRESAD,OP=ICM,MODE=THREE  RESIDENT MODULE ?    00130002
         BZ    ZZI&I.A       NO; JUST CHECK SYS1                        00140000
         BALS  R9,20(,R10)   CALL LPA RESIDENT FUNCTION          93046  00150000
         B     ZZI&I.L       SKIP AROUND IF PREFIX FOUND                00160000
ZZI&I.A  DS    0H                                                93046  00170000
         AIF   (NOT &SV).NSAV2                                  GP01013 00180002
         MACPARM R10,0(R13),OP=L                                GP01013 00190002
.NSAV2   AIF   (NOT &LONG).SYS                                   93046  00200002
         CLI   0(R1),C'.'    UID PREFIX ?                        93002  00210000
         BE    ZZI&I.U       YES                                 93002  00220000
         CLI   0(R1),C';'    UID+ACCT PREFIX ?                   93002  00230000
         BE    ZZI&I.U       YES                                 93002  00240000
         CLI   0(R1),C'¢'    ACCOUNT ONLY ?                      93002  00250000
         BE    ZZI&I.N       YES                                 93002  00260000
.SYS     CLI   0(R1),C'&&'   SPECIAL INPUT NAME ?                       00270000
         BNE   ZZI&I.L       NO                                         00280000
         MVC   0(4,R14),=C'SYS1' MOVE INDEX LEVEL                93002  00290000
         B     ZZI&I.4       JOIN COMMON                         93002  00300000
         AIF   (NOT &LONG).SYSC                                  93046  00310000
ZZI&I.U  CLI   EXWUID,C' '   IS THERE A USER ID ?                93002  00320000
         BNH   ZZI&I.L       NO; FAIL                            93002  00330000
         MVC   0(8,R14),EXWUID  MOVE USER ID                     93002  00340000
         LA    R0,8          SET LENGTH TO SKIP                  93002  00350000
         ST    R14,12(,R13)  SAVE START                          93002  00360000
         AR    R14,R0        PAST LAST BYTE                      93002  00370000
ZZI&I.V  BCTR  R14,0         BACK-UP ONE                         93002  00380000
         CLI   0(R14),C' '   TRAILING GUNK ?                     93002  00390000
         BH    ZZI&I.W       NO                                  93002  00400000
         BCT   R0,ZZI&I.V                                        93002  00410000
ZZI&I.W  L     R14,12(,R13)  RESTORE START                       93002  00420000
         CLI   0(R1),C';'    UID PLUS ACCOUNT ?                  93002  00430000
         BNE   ZZI&I.X       NO; GO TO COMMON EXIT               93002  00440000
         CLI   EXWACCT,C' '  ANY ACCOUNT ?                       93002  00450000
         BNH   ZZI&I.X       NO; GO TO COMMON                    93002  00460000
         AR    R14,R0        GET END AGAIN                       93002  00470000
         MVI   0(R14),C'.'   MAKE INDEX POINT                    93002  00480000
         MVC   1(8,R14),EXWACCT  MOVE ACCOUNT                    93002  00490000
ZZI&I.9  LA    R14,9(R14,0)  MAKE HALF-WORD CONSTANT             93002  00500000
         AH    R0,ZZI&I.9+2  SET NEW LENGTH                      93002  00510000
ZZI&I.C  BCTR  R14,0         BACK-SPACE ONE                      93002  00520000
         CLI   0(R14),C' '   ANY THERE THERE ?                   93002  00530000
         BH    ZZI&I.D       YES                                 93002  00540000
         BCT   R0,ZZI&I.C    GO AGAIN                            93002  00550000
ZZI&I.D  L     R14,12(,R13)  RESTORE START                       93002  00560000
         B     ZZI&I.X       ADD INDEX POINT, ETC.               93002  00570000
ZZI&I.N  CLI   EXWACCT,C' '   ANY ACCOUNT ?                      93002  00580000
         BNH   ZZI&I.L       NO; WILL FAIL                       93002  00590000
         MVC   0(4,R14),EXWACCT  MAKE MAJOR ACCOUNT              93002  00600000
.SYSC    ANOP  ,                                                 93046  00610000
ZZI&I.4  LA    R0,4          SET LENGTH TO FOUR                  93002  00620000
ZZI&I.X  LA    R1,1(,R1)     SKIP OVER SPECIAL CHARACTER                00630000
         AR    R14,R0        ADJUST OUTPUT ADDRESS                      00640000
         SR    R15,R0        ADJUST OUTPUT LENGTH                       00650000
         MVI   0(R14),C'.'   MAKE INDEX POINT                    93002  00660000
         LA    R14,1(,R14)   SKIP IT                             93002  00670000
         BCTR  R15,0         AND SET FINAL LENGTH                93002  00680000
ZZI&I.L  MACPARM &IN,(R1)    RESTORE INPUT ADDRESS REGISTER             00690000
         MACPARM &OUT,(R14)  AND OUTPUT                                 00700000
         MACPARM &LEN,(R15)  AND RESIDUAL LENGTH                        00710000
         AIF   (NOT &SV).NSAV3                                  GP01013 00720002
         MACPARM R10,0(R13),OP=L                                GP01013 00730002
.NSAV3   MEND  ,                                                GP01013 00740002
./ ADD NAME=INEDIT
         MACRO                                                          00010000
&NM      INEDIT &OUT,&IN,&MASK                                          00020000
         LCLC  &L                                                       00030000
&L       SETC  'L'''                                                    00040000
       INSETS  INDEC                                                    00050000
         AIF   ('&MASK' EQ '').DEF                                      00060000
&NM      MVC   DCONWORK(&L&OUT+1),&MASK                                 00070000
         ED    DCONWORK(&L&OUT+1),&IN                                   00080000
.COM     MVC   &OUT,DCONWORK+1                                          00090000
         MEXIT                                                          00100000
.DEF     ANOP                                                           00110000
&NM      MVC   DCONWORK,DCONMASK                                        00120000
         ED    DCONWORK,&IN                                             00130000
         AGO   .COM                                                     00140000
         MEND                                                           00150000
./ ADD NAME=INHEX
         MACRO                                                          00010000
&NM      INHEX &OUT,&IN,&LIN,&MAKE=                             GP03011 00020000
         GBLB  &INLINE(50)                                              00030000
         GBLC  &ZZIXMAK                                         GP03016 00040000
         LCLC  &L                                                       00050000
&INLINE(5) SETB 1                                                       00060000
&L       SETC  'L'''                                                    00070000
         AIF   ('&MAKE' EQ '').NORIDE                           GP03016 00080000
&ZZIXMAK SETC  '&MAKE'                                          GP03016 00090000
.NORIDE  AIF   ('&ZZIXMAK' NE '').BRANCH                        GP03016 00100000
&ZZIXMAK SETC  'UPD'         DEFAULT FORMATTING                 GP03016 00110000
.BRANCH  AIF   ('&ZZIXMAK' EQ 'DEB').DEB                        GP03011 00120000
         AIF   ('&ZZIXMAK' EQ 'OUT').OUT                         89260  00130000
         AIF   ('&ZZIXMAK' EQ 'OUTC').OUT                       GP06353 00140000
         AIF   ('&LIN' NE '').UPDLIN                            GP06282 00150000
&NM      UNPK  UPD(&L&OUT+1),&IN.(&L&OUT/2+1)                           00160000
         TR    UPD(&L&OUT),HEXTAB                                       00170000
         MVC   &OUT,UPD                                                 00180000
         MEXIT ,                                                 89260  00190000
.UPDLIN  ANOP  ,                                                GP06282 00200000
&NM      UNPK  UPD(2*&LIN+1),&IN.(&LIN+1)                       GP06282 00210000
         TR    UPD(2*&LIN),HEXTAB                               GP06282 00220000
         MVC   &OUT.(2*&LIN),UPD                                GP06282 00230000
         MEXIT ,                                                GP06282 00240000
.OUT     AIF   ('&LIN' NE '').OUTLIN                            GP06282 00250000
&NM      UNPK  &OUT.(&L&OUT+1),&IN.(&L&IN+1)                     89260  00260000
         TR    &OUT,HEXTAB                                       89260  00270000
         AIF   ('&ZZIXMAK' NE 'OUTC').MEND                      GP06353 00280000
         MVI   &OUT+L'&OUT,C' '                                 GP06353 00290000
         MEXIT ,                                                        00300000
.OUTLIN  ANOP  ,                                                GP06282 00310000
&NM      UNPK  DB(2*&LIN+1),&IN.(&LIN+1)                        GP06282 00320000
         TR    DB(2*&LIN),HEXTAB                                GP06282 00330000
         MVC   &OUT.(2*&LIN),DB                                 GP06282 00340000
         MEXIT ,                                                GP06282 00350000
.DEB     AIF   ('&LIN' NE '').DEBLIN                            GP03011 00360000
&NM      UNPK  DBWDB(&L&OUT+1),&IN.(&L&OUT/2+1)                 GP03011 00370000
         TR    DBWDB(&L&OUT),TABHEXTR                           GP03011 00380000
         MVC   &OUT,DBWDB                                       GP03011 00390000
         MEXIT ,                                                GP03011 00400000
.DEBLIN  ANOP  ,                                                GP03011 00410000
&NM      UNPK  DBWDB(2*&LIN+1),&IN.(&LIN+1)                     GP03011 00420000
         TR    DBWDB(2*&LIN),TABHEXTR                           GP03011 00430000
         MVC   &OUT.(2*&LIN),DBWDB                              GP03011 00440000
.MEND    MEND                                                           00450000
./ ADD NAME=INPCLOSE
         MACRO                                                          00010000
&NM      INPCLOSE &TYPE,&DEV=,&OPT=DISP                 ADDED ON 81194  00020000
         LCLA  &FN,&DSP                                          86113  00030000
&DSP     SETA  2                                                 86113  00040000
         AIF   ('&OPT' EQ 'LEAVE').DONDISP                       86113  00050000
&DSP     SETA  1                                                 86113  00060000
         AIF   ('&OPT' EQ 'REREAD').DONDISP                      86113  00070000
&DSP     SETA  0                                                 86113  00080000
         AIF   ('&OPT' EQ 'DISP' OR '&OPT' EQ '').DONDISP        86113  00090000
         MNOTE 4,'INVALID DISPOSITION OPTION DISP=&OPT'          86113  00100000
.DONDISP AIF   ('&TYPE' EQ '').COMM                              86113  00110000
         AIF   ('&TYPE' EQ 'TCLOSE').SET1                               00120000
         MNOTE 4,'*** UNRECOGNIZED TYPE &TYPE'                          00130000
.SET1    ANOP  ,                                                        00140000
&FN      SETA  1             SET TCLOSE FUNCTION                        00150000
.COMM    ANOP  ,                                                        00160000
&NM      INPCOM &DSP,0,&FN,DEV=&DEV  EXPAND REQUEST              86113  00170000
         MEND  ,                                                        00180000
./ ADD NAME=INPCOM
         MACRO                                                          00010000
&NM      INPCOM &B0,&B1,&FN,&P0,&A1,&DEV=             UPDATED ON 99007  00020000
.********************************************************************** 00030000
.*                                                                   ** 00040000
.*   COMMON INNER MACRO FOR @INPREAD INVOCATION                      ** 00050000
.*                                                                   ** 00060000
.*  ESA AND OS/390 CHANGE - FLAG BYTE NOW IN R0:1 FROM R1:0     GP98365 00070000
.********************************************************************** 00080000
         GBLC  &MACPLAB,&INPMODE                                        00090000
         LCLA  &I,&J,&K,&VD,&D(8)                                       00100000
         LCLB  &INDEV                                            82116  00110000
         LCLC  &DC,&A0                                           82116  00120000
&MACPLAB SETC  '&NM'                                             82116  00130000
&A0      SETC  '&P0'                                            GP99007 00140000
         AIF   ('&A0' NE '').LENOK                              GP99007 00150000
&A0      SETC  '0'                                              GP99007 00160000
.LENOK   AIF   ('&DEV' EQ '' OR '&DEV' EQ '0').NODV             GP99007 00170000
         AIF   ('&DEV' NE 'ALL').DVSOM                                  00180000
&VD      SETA  255                                                      00190000
         AGO   .NODV                                                    00200000
.DVSOM   AIF   (K'&DEV LT 2).DVSOL                               82116  00210000
         AIF   ('&DEV'(1,1) NE '=').DVSOL                        82116  00220000
&INDEV   SETB  1             SET INDIRECT DEVICE NUMBER          82116  00230000
         AGO   .NODV                                             82116  00240000
.DVSOL   ANOP  ,                                                 82116  00250000
&I       SETA  0                                                        00260000
&J       SETA  N'&DEV                                                   00270000
.DEVLOOP ANOP  ,                                                        00280000
&I       SETA  &I+1                                                     00290000
         AIF   (&I GT &J).DVEND                                         00300000
         AIF   ('&DEV(&I)' EQ '').DEVLOOP                               00310000
         AIF   ('&DEV(&I)' EQ '0').DEVLOOP                              00320000
         AIF   ('&DEV(&I)' LT '1' OR '&DEV(&I)' GT '8').DVERR           00330000
&D(&DEV(&I)) SETA  1                                                    00340000
         AGO   .DEVLOOP                                                 00350000
.DVERR   MNOTE 8,'*** INVALID DEVICE NUMBER &DEV(&I)'                   00360000
         AGO   .DEVLOOP                                                 00370000
.DVEND   ANOP  ,                                                        00380000
&VD      SETA  128*&D(8)+64*&D(7)+32*&D(6)+16*&D(5)+8*&D(4)             00390000
&VD      SETA  &VD+4*&D(3)+2*&D(2)+&D(1)                                00400000
.NODV    AIF   ('&B0' NE '0' OR '&A0' NE '0').LONG              GP98365 00410000
         AIF   (&VD GT 15).LONG                                         00420000
&K       SETA  &VD*256+&FN                                              00430000
         MACPARM R0,&K       LOAD DEVICE/FUNCTION INDEX          82116  00440000
         AIF   ('&A0' EQ '0').POST0                             GP99007 00450000
         ICM   R0,4,=AL1(&A0)                                   GP98365 00460000
         AGO   .POST0                                            82116  00470000
.LONG    ANOP  ,                                                        00480000
&MACPLAB L     R0,=AL1(&B0,&A0,&VD,&FN)                         GP98365 00490000
&MACPLAB SETC  ''            CANCEL LABEL                        82116  00500000
.POST0   AIF   (NOT &INDEV).LOAD1                                82116  00510000
&VD      SETA  K'&DEV-1                                          82116  00520000
&DC      SETC  '&DEV'(2,&VD)                                     82116  00530000
&MACPLAB ICM   R0,2,&DC                                          82116  00540000
&MACPLAB SETC  ''                                                82116  00550000
.LOAD1   AIF   ('&FN' EQ '0' OR '&FN' EQ '1').BAL                       00560000
         MACPARM R1,&A1      LOAD PARAMETER REGISTER                    00570000
.BAL     AIF   ('&INPMODE' EQ 'V').VCON                                 00580000
         L     R15,@INPREAD                                             00590000
         AGO   .BALR                                                    00600000
.VCON    L     R15,=V(@INPREAD)                                         00610000
.BALR    BALSR R14,R15                                                  00620000
.*ALR    BASSM R14,R15                                                  00630000
         MEND  ,                                                        00640000
./ ADD NAME=INPFEOV
         MACRO                                                          00010000
&NM      INPFEOV &COUNT,&DEV=                           ADDED ON 90233  00020000
&NM      INPCOM 0,0,6,,0,DEV=&DEV                                       00030000
         MEND                                                           00040000
./ ADD NAME=INPFIND
         MACRO                                                          00010000
&NM      INPFIND &WORK,&DEV=                             NEW ON GP02248 00020000
.*   @INPREAD CALL TO (RE)POSITION TO A MEMBER                          00030000
&NM      INPCOM 0,0,8,0,&WORK,DEV=&DEV                                  00040000
         MEND  ,                                                        00050000
./ ADD NAME=INPGET
         MACRO                                                          00010000
&NM      INPGET &IMAGE,&DEV=,&FILL=                      ADDED ON 81194 00020000
         LCLA  &N                                               GP03034 00030001
         LCLC  &L                                               GP03034 00040000
&NM      INPCOM 0,0,3,,0,DEV=&DEV                                       00050000
.*                                                              GP03034 00060000
.*--------------------------------------------------------------------* 00070000
.*                                                                    * 00080000
.*  WHEN A POSITIONAL OPERNAD IS SPECIFIED, IT INDICATES MOVE MODE.   * 00090000
.*  INPGET X     EXPANDS  MVC X{L'X},0(R1)                            * 00100000
.*  INPGET (X,L) EXPANDS  MVC X{L},0(R1)                              * 00110000
.*    NOTE THAT LENGTH OF X MUST BE LESS THAN OR EQUAL TO THE         * 00120000
.*    WIDTH= PARAMETER ON THE CORRESPONDING INPWORK MACRO             * 00130000
.*                                                                    * 00140000
.*  WHEN FILL= IS SPECIFIED, A LONGER EXPANSION USING MVCL ALLOWS     * 00150000
.*  DISPARATE LENGTHS                                                 * 00160000
.*                                                                    * 00170000
.*--------------------------------------------------------------------* 00180000
&N       SETA  N'&IMAGE                                         GP03034 00190001
         AIF   (&N LT 1).MEND                                   GP03034 00200001
         AIF   (T'&FILL NE 'O').FILL                            GP03034 00210001
         AIF   (&N EQ 1).DEFLEN                                 GP03034 00220001
         MVC   &IMAGE(1)(&IMAGE(2)),0(R1)                       GP03034 00230000
         MEXIT ,                                                GP03034 00240000
.DEFLEN  MVC   &IMAGE(1),0(R1)                                  GP03034 00250000
         MEXIT ,                                                GP03034 00260000
.FILL    SAR   R0,R15        PRESERVE RETURN CODE               GP03034 00270000
         LR    R14,R1        SET SOURCE RECORD ADDRESS          GP03034 00280000
         LR    R15,R0        SET SOURCE LENGTH                  GP03034 00290000
         AIF   (&N EQ 1).DEFILL                                 GP03034 00300001
         MACPARM R0,&IMAGE(1)  LOAD ADDRESS                     GP03034 00310000
         MACPARM R1,&IMAGE(2)  LOAD LENGTH                      GP03034 00320000
         AGO   .FILLCOM                                         GP03034 00330000
.DEFILL  MACPARM R0,&IMAGE     LOAD RECORD ADDRESS              GP03034 00340000
&L       SETC  'L'''                                            GP03034 00350000
         MACPARM R1,&L&IMAGE   LOAD LENGTH                      GP03034 00360000
.FILLCOM AIF   ('&FILL' EQ '0' OR '&FILL' EQ 'X''0'''                  *00370000
               OR '&FILL' EQ 'X''00''').FILLZER                 GP03034 00380000
         ICM   R15,8,=AL1(&FILL)  INSERT FILL CHARACTER         GP03034 00390000
.FILLZER MVCL  R0,R14        MOVE INPUT RECORD                  GP03034 00400000
         EAR   R15,R0        RESTORE RETURN CODE                GP03034 00410000
.MEND    MEND  ,                                                GP03034 00420000
./ ADD NAME=INPKEEPM
         MACRO                                                          00010000
&NM      INPKEEPM &COUNT,&DEV=                           ADDED ON 90233 00020000
&NM      INPCOM 0,0,7,,0,DEV=&DEV                                       00030000
         MEND                                                           00040000
./ ADD NAME=INPKEEP
         MACRO                                                          00010000
&NM      INPKEEP &COUNT,&DEV=                           ADDED ON 81194  00020000
&NM      INPCOM 0,0,4,,0,DEV=&DEV                                       00030000
         MEND                                                           00040000
./ ADD NAME=INPOPEN
         MACRO                                                          00010000
&NM      INPOPEN &WORK,&DEV=,&OPT=                    UPDATED ON 93307  00020000
         LCLA  &I,&J                                                    00030000
         LCLB  &A,&D,&W,&F,&X,&U                                GP04114 00040000
&J       SETA  N'&OPT                                                   00050000
.OPTL    ANOP  ,                                                        00060000
&I       SETA  &I+1                                                     00070000
         AIF   (&I GT &J).OPTN                                          00080000
         AIF   ('&OPT(&I)' EQ '').OPTL                                  00090000
&A       SETB  (&A OR '&OPT(&I)' EQ 'ABE' OR '&OPT(&I)' EQ 'ABEND')     00100000
&D       SETB  (&D OR '&OPT(&I)' EQ 'DUMMY')                            00110000
&W       SETB  (&W OR '&OPT(&I)' EQ 'NOWTO')                            00120000
&F       SETB  (&F OR '&OPT(&I)' EQ 'JFCB' OR '&OPT(&I)' EQ 'OPENJ')    00130000
&X       SETB  (&X OR '&OPT(&I)' EQ 'VER' OR '&OPT(&I)' EQ 'EXIST')     00140000
&U       SETB  (&U OR '&OPT(&I)' EQ 'FOLD')                     GP04114 00150000
         AGO   .OPTL                                                    00160000
.OPTN    AIF   (&J EQ (&A+&D+&W+&F+&X+&U)).OPTOK                GP04114 00170000
         MNOTE 4,'UNDEFINED OR DUPLICATE OPTION SPECIFIED'       82116  00180000
.OPTOK   ANOP  ,                                                 82116  00190000
&I       SETA  128*&A+64*&D+32*&W+16*&F+8*&X+1*&U               GP04114 00200000
&NM      INPCOM 0,0,2,&I,&WORK,DEV=&DEV                                 00210000
         MEND  ,                                                        00220000
./ ADD NAME=INPQMEM
         MACRO                                                          00010000
&NM      INPQMEM &WORK,&DEV=                             NEW ON         00020000
.*   @INPREAD CALL TO OBTAIN MEMBER INFORMATION (RC=0 & DIRECTORY)      00030000
&NM      INPCOM 0,0,9,0,&WORK,DEV=&DEV                                  00040000
         MEND  ,                                                        00050000
./ ADD NAME=INPREAD
         MACRO                                                          00010000
&NM      INPREAD &COUNT,&DEV=                           ADDED ON 90216  00020000
&NM      INPCOM 0,0,5,,0,DEV=&DEV                                       00030000
         MEND                                                           00040000
./ ADD NAME=INPWORK
         MACRO                                                          00010000
&NM      INPWORK &DD,&ALTDD,&WIDTH=80,&EODAD=1,&FILL=0,&EDIT=0,&JFCB=, *00020000
               &PDE=0,&PDS=NO,&BUF=                             GP08088 00030000
         LCLA  &PFG,&IPDS,&I,&J,&K                               89351  00040000
         LCLB  &I0,&I1,&I2,&I3,&I4,&I5,&I6,&I7                   89351  00050000
&K       SETA  N'&PDS                                            89351  00060000
         AIF   ('&BUF' NE '1').NOBUF1  NOT SINGLE BUFFER OPTION GP08088 00070000
&PFG     SETA  &PFG+1        SET ONE BUFFER ONLY                GP08088 00080000
.NOBUF1  AIF   ('&PDE' EQ '0').NOPDE                            GP08088 00090000
&PFG     SETA  &PFG+8        SHOW PDS FEEDBACK REQUESTED         89351  00100000
.NOPDE   AIF   (&I GE &K).ENDPDE                                 89351  00110000
&I       SETA  &I+1                                              89351  00120000
&I0      SETB  (&I0 OR ('&PDS(&I)' EQ 'DIR'))  PROCESS DIRECTORY 89351  00130000
&I1      SETB  (&I1 OR ('&PDS(&I)' EQ 'MEM'))  PROCESS MEMBERS   89351  00140000
&I2      SETB  (&I2 OR ('&PDS(&I)' EQ 'ALI'))  PROCESS ALIAS TOO 89351  00150000
&I7      SETB  (&I7 OR ('&PDS(&I)' EQ 'UPD'))  BUILD ./ ADD      89351  00160000
         AGO   .NOPDE        TRY NEXT ENTRY                      89351  00170000
.ENDPDE  AIF   ('&PDS' EQ 'NO').OKPDE                            89351  00180000
&IPDS    SETA  128*&I0+64*&I1+32*&I2+16*&I3+8*&I4+4*&I5+2*&I6+&I7       00190000
&J       SETA  &I0+&I1+&I2+&I3+&I4+&I5+&I6+&I7                   89351  00200000
         AIF   (&J EQ &K).OKPDE                                  89351  00210000
         MNOTE 4,'*** INVALID PDS= PARAMETER ***'                89351  00220000
.OKPDE   AIF   (T'&JFCB NE 'O').ADDJFCB                          82116  00230000
         DC    0F'0'                                                    00240000
&NM      DC    CL8'&DD ',CL8'&ALTDD ',A(&EODAD,&PDE),AL2(&WIDTH,0),AL1(*00250000
               &PFG,&FILL,&EDIT,&IPDS)                           89351  00260000
         MEXIT ,                                                 82116  00270000
.ADDJFCB ANOP  ,                                                 82116  00280000
&PFG     SETA  16+&PFG       SET JFCB PRESENT                    82116  00290000
         DC    0F'0'                                                    00300000
&NM      DC    CL8'&DD ',CL8'&ALTDD ',A(&EODAD,&PDE),AL2(&WIDTH,0),AL1(*00310000
               &PFG,&FILL,&EDIT,&IPDS),A(&JFCB)                  89351  00320000
         MEND  ,                                                        00330000
./ ADD NAME=IPM
         MACRO ,                                                        00010000
&NM      IPM   &R,&WORK=R0                              ADDED ON 05189  00020000
.*                                                                      00030000
.*       THIS MODULE LOADS THE PROGRAM MASK THE HARD WAY, FOR MVS 3.8   00040000
.*                                                                      00050000
         AIF   ('&R' EQ '&WORK').FAST                                   00060000
&NM      BALR  &WORK,0                                                  00070000
         N     &R,=X'00FFFFFF'                                          00080000
         N     &WORK,=X'3F000000'                                       00090000
         OR    &R,&WORK                                                 00100000
         MEXIT ,                                                        00110000
.FAST    ANOP  ,             OK TO CLOBBER ADDRESS                      00120000
&NM      BALR  &R,0                                                     00130000
         MEND  ,                                                        00140000
./ ADD NAME=JOBSEPLN
         MACRO ,                                    ADDED BY/ON GP06280 00010000
&NM    JOBSEPLN &PFX=SEP,&DSECT=    DEFAULT JOB SEPARATOR LINE          00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*  THIS MACRO MAPS THE JOB SEPARATOR DATA LINE AS PRODUCED BY THE    * 00050000
.*  HERCULES MVS 3.8J TURNKEY SYSTEM                                  * 00060000
.*                                                                    * 00070000
.********************************************************************** 00080000
         LCLC &P                                                        00090000
&P       SETC 'SEP'                                                     00100000
         AIF  ('&PFX' EQ '').DEFPFX                                     00110000
&P       SETC  '&PFX'                                                   00120000
.DEFPFX  ANOP  ,                                                        00130000
&NM      MACMAPHD PFX=&P,DSECT=&DSECT                                   00140000
&P.LINE  DC   0CL133' '      DEFAULT LENGTH                             00150000
&P.CC    DC   C' '           CARRIAGE CONTROL                           00160000
&P.AST1  DC   C'****'        EYE CATCHER                                00170000
&P.CLS1  DC   C' ',CL2' '    SYSOUT CLASS                               00180000
&P.FUN1  DC   C'START ',C' '   START- OR -END--                         00190000
&P.NUM1  DC   C'JOB nnnn',CL2' '   JES JOB IDENTIFER JOB/STC/TSU        00200000
&P.NAME  DC   CL8' ',CL2' '  JOB NAME                                   00210000
&P.PGMN  DC   CL20' ',CL2' '  PROGRAMMER NAME                           00220000
&P.RUME  DC   C'ROOM',C' '                                              00230000
&P.ROOM  DC   CL4' ',CL2' '  ROOM (OR SUBACCOUNT?)                      00240000
&P.TIME  DC   CL11'hh.mm.ss AM',C' '  TIME                              00250000
&P.DATE  DC   CL9'dd mon yy',CL2' '   DATE                              00260000
&P.PRT   DC   CL8' ',CL2' '  PRINTER NAME                               00270000
&P.SYS   DC   C'SYS',C' '    CONSTANT                                   00280000
&P.SID   DC   CL4' ',CL2' '                                             00290000
&P.NUM2  DC   C'JOB nnnn',CL2' '   JES JOB IDENTIFER JOB/STC/TSU        00300000
&P.FUN2  DC   C'START ',C' '   START- OR -END--                         00310000
&P.CLS2  DC   C' '           SYSOUT CLASS                               00320000
&P.AST2  DC   C'****'        EYE CATCHER                                00330000
         MEND  ,                                                        00340000
./ ADD NAME=LADJ
         MACRO ,                                                        00010000
&NM      LADJ  &CH,&LEN,&WK=R15,&MASK=C' '  DELETE BLANKS               00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*  THIS MACRO CREATES CODE TO LEFT-JUSTIFY A FIELD.                  * 00050000
.*  &FIELD MUST NOT BE A REGISTER SPECIFICATION, BUT A RELOCATABLE    * 00060000
.*  &LEN MAY BE ABSOLUTE, OR A REGISTER                               * 00070000
.*    &FIELD+LEN MUST BE A TRAILING FILL CHARACTER (NORMALLY BLANK)   * 00080000
.*  &WK IS A WORK REGISTER, NORMALLY R15                              * 00090000
.*  &MASK SPECIFIES EITHER BLANK OR ZERO (C' ' OR C'0'). SHIFTING     * 00100000
.*    STOPS WHEN OTHER THAN THE EXCLUDED BITS ARE ON.                 * 00110000
.*                                                                    * 00120000
.*--------------------------------------------------------------------* 00130000
         GBLC  &MACPLAB                                         GP03245 00140000
         LCLC  &L,&TAG,&FIELD                                   GP03016 00150000
         LCLC  &D,&B         BASE/DISPLACEMENT                  GP12307 00160000
         LCLA  &I,&J,&K                                         GP12307 00170000
&TAG     SETC  'ZZJ'.'&SYSNDX'                                  GP03016 00180000
&L       SETC  'L'''                                                    00190000
&FIELD   SETC  '&CH'                                            GP12307 00200000
&K       SETA  K'&CH                                            GP12307 00210000
         AIF   ('&FIELD' EQ '').BOO                                     00220000
         AIF   (&K LT 3).NOREG                                  GP12307 00230000
         AIF   ('&CH'(1,1) NE '(' OR '&CH'(2,1) EQ '(').NOREG   GP12307 00240000
       AIF ('&CH'(&K,1) NE ')' OR '&CH'(&K-1,1) EQ ')').NOREG   GP12307 00250000
&FIELD   SETC  '0'.'&CH'     CHANGE (REG) TO 0(REG)             GP12304 00260000
.NOREG   AIF   ('&LEN' EQ '').DEF                                       00270000
         AIF   (T'&LEN NE 'N').MAC                              GP03016 00280000
&NM      LA    &WK,&LEN-1    NO. OF BYTES TO MOVE                       00290000
         AGO   .COM                                                     00300000
.MAC     ANOP  ,                                                GP03016 00310000
&NM      MACPARM &WK,&LEN                                       GP03016 00320000
&MACPLAB MACPARM &WK,0,OP=BCTR,OPR=BCTR                         GP03016 00330000
         AGO   .COM                                                     00340000
.DEF     ANOP  ,                                                        00350000
&NM      LA    &WK,&L&FIELD-1  NO. OF BYTES TO MOVE                     00360000
.COM     ANOP  ,                                                GP12307 00370000
&TAG.L   TM    &FIELD,X'FF'-&MASK LEADING BLANK OR ZERO ?       GP03016 00380000
         BNZ   &TAG.X        RETURN                             GP03016 00390000
         EX    &WK,&TAG.M    SHIFT LEFT ONE POSITION            GP03016 00400000
         BCT   &WK,&TAG.L    REPEAT FOR ALL                     GP03016 00410000
         B     &TAG.X        DONE                               GP03016 00420000
&K       SETA  K'&FIELD                                         GP12307 00430000
         AIF   ('&FIELD'(&K,1) NE ')').SYMBOL                   GP12307 00440000
.*  PARSE xxx ( yyy ) - CHANGE TO xxx ( 1 , yyy )               GP12307 00450000
&I       SETA  &K                                               GP12307 00460000
&J       SETA  1                                                GP12307 00470000
.LOOP    AIF   (&I LE 1).ERRTO                                  GP12307 00480000
&I       SETA  &I-1                                             GP12307 00490000
         AIF   ('&FIELD'(&I,1) EQ '(').HAVLEFT                  GP12307 00500000
         AIF   ('&FIELD'(&I,1) EQ ')').HAVRITE                  GP12307 00510000
         AGO   .LOOP                                            GP12307 00520000
.HAVRITE ANOP  ,                                                GP12307 00530000
&J       SETA  &J+1                                             GP12307 00540000
         AGO   .LOOP                                            GP12307 00550000
.HAVLEFT ANOP  ,                                                GP12307 00560000
&J       SETA  &J-1                                             GP12307 00570000
         AIF   (&J GT 0).LOOP                                   GP12307 00580000
         AIF   (&I LE 1).SYMBOL   ((XYZ-RST))                   GP12307 00590000
&D       SETC  '&FIELD'(1,&I-1)                                 GP12307 00600000
&B       SETC  '&FIELD'(&I+1,&K-&I-1)                           GP12307 00610000
&TAG.M   MVC   &D.(0,&B),1+&FIELD                               GP12307 00620000
&TAG.X   DS    0H                                               GP12307 00630000
         MEXIT ,                                                GP12307 00640000
.SYMBOL  ANOP  ,             STASH LENGTH IN MVC                GP12307 00650000
&TAG.M   MVC   &FIELD.(0),1+&FIELD     SHIFT LEFT               GP12307 00660000
&TAG.X   DS    0H                                               GP03016 00670000
         MEXIT ,                                                        00680000
.ERRTO   MNOTE 4,'LADJ - FIELD NAME MALFORMED'                  GP12307 00690000
         MEXIT ,                                                GP12307 00700000
.BOO     MNOTE 4,'LADJ - FIELD NAME OMITTED'                            00710000
         AIF   ('&NM' EQ '').MEND                               GP03016 00720000
&NM      DS    0H            BUT AT LEAST DEFINE THE LABEL      GP03016 00730000
.MEND    MEND  ,                                                        00740000
./ ADD NAME=LAE
         MACRO ,                                                        00010000
&NM      LAE   &R,&A,&CRUD                             ADDED ON GP04234 00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES A LA FOR MVS COMPAT.                     00040000
.*       ORIGINAL REQUIRES AT LEAST SP 2 (MVS/XA)                       00050000
&NM      MACPARM &R,&A,&CRUD,OP=LA,OPR=LA                               00060000
         MEND  ,                                                        00070000
./ ADD NAME=LAM
         MACRO ,                                                        00010000
&NM      LAM   &R,&S,&T                                 ADDED ON 05189  00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES A LABEL FOR MVS COMPATIBILITY            00040000
.*                                                                      00050000
         GBLC  &MACPLAB                                                 00060000
&MACPLAB SETC  '&NM'                                                    00070000
         MACPARM MODE=LBL                                               00080000
         MEND  ,                                                        00090000
./ ADD NAME=LAT
         MACRO ,                                                        00010000
&NM      LAT   &R,&ADDR,&BZ,&BNZ,&LA=FW                         GP98339 00020000
         GBLB  &MVSXA                                            91216  00030000
         GBLC  &MACPLAB                                                 00040000
.********************************************************************** 00050000
.*                                                                   ** 00060000
.*   LOAD AN ADDRESS INTO A REGISTER AND TEST FOR ZERO; OPTIONALLY   ** 00070000
.*     BRANCH ON ZERO BZ=label  OR NONZERO BNZ=label                 ** 00080000
.*                                                                   ** 00090000
.********************************************************************** 00100000
&MACPLAB SETC  '&NM'                                                    00110000
         AIF   ('&LA' EQ '').ICM370                                     00120000
         AIF   ('&LA' EQ '34' OR '&LA' EQ '34Z').ICM34           91216  00130000
         AIF   ('&LA' EQ 'RX').ICMRX                                    00140000
         AIF   ('&LA' EQ '0').ICMSR                                     00150000
         AIF   ('&LA' EQ 'FW').ICMFW                                    00160000
         MNOTE 8,'&&LA=&LA INVALID - MUST BE RX, 0, OR FW'              00170000
         MNOTE 8,'&&LA=RX ASSUMED'                                      00180000
.ICMRX   MACPARM &R,&ADDR,OP=LA  OFFSET(X,BASE)                         00190000
         MACPARM &R(1),7,1(&R(1)),OP=ICM,MODE=THREE                     00200000
         AGO   .BRT                                                     00210000
.ICMSR   MACPARM &R,0                                                   00220000
         AGO   .ICM370                                           92273  00230000
.ICM34   AIF   (&MVSXA).ICMFW                                    91216  00240000
.ICM370  MACPARM &R(1),7,1+&ADDR,OP=ICM,MODE=THREE  LOAD ADDRESS        00250000
         AGO   .BRT                                                     00260000
.ICMFW   MACPARM &R(1),15,&ADDR,OP=ICM,MODE=THREE  LOAD FULLWORD        00270000
         AIF   ('&LA' NE '34Z').BRT                              91216  00280000
         MACPARM &R(1),0(,&R(1))                                 91216  00290000
.*                                                                      00300000
.BRT     MACPARM &BZ,OP=BZ,OPR=BZR,MODE=ONE,NULL=SKIP           GP06266 00310000
         MACPARM &BNZ,OP=BNZ,OPR=BNZR,MODE=ONE,NULL=SKIP        GP06266 00320000
.MEX     MEND  ,                                                        00330000
./ ADD NAME=LCSTR
         MACRO ,                                                        00010000
         LCSTR &S            MACRO TO MAKE STRING LOWER CASE     87193  00020000
         GBLC  &LCSTR                                                   00030000
         LCLA  &I,&J,&K                                                 00040000
         LCLC  &C                                                       00050000
&K       SETA  K'&S                                                     00060000
&LCSTR   SETC  '&S'                                                     00070000
.LOOP    AIF   (&I GE &K).MEND                                          00080000
&I       SETA  &I+1                                                     00090000
&C       SETC  '&LCSTR'(&I,1)                                           00100000
         AIF   ('&C' LT 'A' OR '&C' GT 'Z').LOOP                        00110000
&J       SETA  1                                                        00120000
.CHAR    AIF   ('&C' EQ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&J,1)).REP         00130000
&J       SETA  &J+1                                                     00140000
         AIF   (&J LE 26).CHAR                                          00150000
.REP     ANOP  ,                                                        00160000
&C       SETC  'abcdefghijklmnopqrstuvwxyz'(&J,1)                       00170000
         AIF   (&I EQ &K).LAST                                          00180000
         AIF   (&I EQ 1).FIRST                                          00190000
&LCSTR   SETC  '&LCSTR'(1,&I-1).'&C'.'&LCSTR'(&I+1,&K-&I)               00200000
         AGO   .LOOP                                                    00210000
.FIRST   ANOP  ,                                                        00220000
&LCSTR   SETC  '&C'.'&LCSTR'(2,&K-1)                                    00230000
         AGO   .LOOP                                                    00240000
.LAST    ANOP  ,                                                 87193  00250000
&LCSTR   SETC  '&LCSTR'(1,&K-1).'&C'                                    00260000
.MEND    MEND  ,                                                        00270000
./ ADD NAME=LDSUB
         MACRO                                                          00010000
&L       LDSUB &DUMMY,&NAME=DMP,&PAD=,&RESERVE=ALL,&SIZE=,             *00020000
               &REG=R2,&LOADADD=R7,&MODE=32K,&MIN=12*1024,&MAX=62*1024  00030000
         GBLC  &SYSTEM                                                  00040000
         GBLB  &OS390,&MVS   EXHFSIZ NOT HONORED BY SYSTEM      GP04234 00050000
         LCLC  &L1,&L2,&L3                                              00060000
         LCLC  &MASK                                                    00070000
         AIF   ('&PAD' EQ '').NOPAD1                                    00080000
         AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').NOPAD1  80013  00090000
         MNOTE 12,'&&PAD AND &&RESERVE ARE MUTUALLY EXCLUSIVE'          00100000
         MEXIT                                                          00110000
.NOPAD1  ANOP  ,                                                        00120000
         AIF   ('&SIZE' EQ '').NOSIZ1                                   00130000
         AIF   ('&PAD' EQ '').NOPAD2                                    00140000
         MNOTE 12,'&&PAD AND &&SIZE ARE MUTUALLY EXCLUSIVE'             00150000
         MEXIT                                                          00160000
.NOPAD2  AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').NOSIZ1         00170000
         MNOTE 12,'&&SIZE AND &&RESERVE ARE MUTUALLY EXCLUSIVE'         00180000
         MEXIT                                                          00190000
.NOSIZ1  ANOP  ,                                                        00200000
&L1      SETC  'TRA&SYSNDX'                                             00210000
&L2      SETC  'TRB&SYSNDX'                                             00220000
&L3      SETC  'TRC&SYSNDX'                                             00230000
&MASK    SETC  '00FFF000'                                               00240000
         AIF   ('&SYSTEM' EQ 'SVS' OR '&SYSTEM' EQ 'MVS').PAGE4K        00250000
&MASK    SETC  '00FFF800'                                               00260000
.*AGE4K  AIF   ('&MODE' EQ '64K' OR '&MODE' EQ '65K').BIGLOAD    85317  00270000
.PAGE4K  AIF   ('&MODE' EQ '64K' OR '&MODE' EQ '65K').LITLOAD   GP04234 00280000
         AIF   ('&MODE' EQ '' OR '&MODE' EQ '32K').LITLOAD       85317  00290000
         MNOTE 4,'INVALID MODE OPERAND (NOT 32K OR 64K)'         85317  00300000
.LITLOAD AIF   (&MVS).NEWCODE  DROP REGION MANAGEMENT           GP04234 00310000
&L       MVI   EXCINVOK+22,0           RESET FOR BLDL TEST              00320000
         MVC   EXCINVOK+5(3),=C'&NAME' COMPLETE NAME OF SUBROUTINE      00330000
         LA    R0,EXCSBLDL   POINT TO BLDL HEADER                86349  00340000
         L     R15,SQBLDLA   GET ADDRESS OF BLDL CODE            86349  00350000
         BALR  R14,R15       INVOKE BLDL                         86349  00360000
         MVI   DB,0                                             GP04234 00370000
         MVC   DB+1(3),EXHFSIZ-EXHBWENT+EXCINVOK    SAVE ACTUAL SIZE    00380000
         AIF   ('&SIZE' NE '').SIZ2                                     00390000
         AIF   ('&PAD' EQ '').NOPAD3                                    00400000
         L     R0,DB         ADD PAD TO ACTUAL SIZE             GP04234 00410000
         MACPARM R0,&PAD,OP=AH,OPR=AR                                   00420000
         AGO   .NOSIZ2                                                  00430000
.SIZ2    MACPARM R0,&SIZE,OP=LH,OPR=LR GET DESIRED LOAD SIZE            00440000
         C     R0,DB                   IS IT LESS THAN MODULE SIZE ?    00450000
         BL    &L2                      YES - REJECT REQUEST            00460000
.NOSIZ2  ST    R0,DB                   SET MODULE SIZE TO NEW VALUE     00470000
         L     &REG,EXCSTGMX           GET FREE STORAGE SIZE    GP04234 00480000
         N     &REG,=X'&MASK'          TRUNCATE TO PAGE BOUNDARY        00490000
         CR    &REG,R0                 WILL MODULE FIT ?                00500000
         AGO   .PAD3                                                    00510000
.NOPAD3  L     &REG,EXCSTGMX           GET FREE STORAGE SIZE    GP04234 00520000
         AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').NORSV1         00530000
         LR    R0,&REG                 SAVE FOR RESERVE CALCULATION     00540000
.NORSV1  ANOP  ,                                                        00550000
         N     &REG,=X'&MASK'          TRUNCATE TO PAGE BOUNDARY        00560000
         AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').NORSV2         00570000
         SR    R0,&REG                 R0=FREE STORAGE IN LAST PAGE     00580000
         MACPARM R0,&RESERVE,OP=CH,OPR=CR IS IT ENOUGH FOR RESERVE?     00590000
         BNL   &L1                       YES - LEAVE WELL ENOUGH ALONE  00600000
         MACPARM &REG,&RESERVE,OP=SH,OPR=SR NO - CUT BACK LOAD SIZE     00610000
.NORSV2  ANOP  ,                                                        00620000
&L1      ST    &REG,DB+4               SAVE CALCULATED LOAD SIZE        00630000
         S     &REG,DB                 AMOUNT IN EXCESS OF MODULE SIZE  00640000
.PAD3    BNM   &L3                     GOOD, MODULE FITS                00650000
&L2      MVC   INVOKE(8),EXCINVOK      COPY NAME                        00660000
         B     EXCXCB               AND SHOW MODULE TO BE UNAVAILABLE   00670000
&L3      MVC   EXHFSIZ-EXHBWENT+EXCINVOK(3),DB+5    FORCE LARGEST       00680000
         BAL   R9,EXCLOD2    TEST IF REALLY AVAILABLE                   00690000
         LTR   &LOADADD,R0             GOT IT ?                         00700000
         BZ    &L2                     NO, SIGNAL ERROR                 00710000
         MEXIT ,                                                 85317  00720000
.BIGLOAD ANOP  ,                                                 85317  00730000
&L       MVI   EXCINVOK+22,0           RESET FOR BLDL TEST       85317  00740000
         MVC   EXCINVOK+5(3),=C'&NAME' COMPLETE NAME OF SUBROUTINE      00750000
         LA    R0,EXCSBLDL   POINT TO BLDL HEADER                86349  00760000
         L     R15,SQBLDLA   GET ADDRESS OF BLDL CODE            86349  00770000
         BALR  R14,R15       INVOKE BLDL                         86349  00780000
         TM    EXCINVOK+22,EXHF1ATT  REUS + EXEC ?               85317  00790000
         BNO   &L2           NO                                  85317  00800000
         L     R0,EXCSTGMX   GET AVAILABLE STORAGE              GP04234 00810000
         ST    R0,DB+4       SET AS AVAILABLE MAXIMUM            85317  00820000
         GETMAIN VC,LA=&L1.L,A=&L1.A   GET SOME STORAGE          85317  00830000
         BXH   R15,R15,&L1.F   NONE GOTTEN                       85317  00840000
         LM    R15,R0,&L1.A  GET ADDRESS/LENGTH                  85317  00850000
         LR    R1,R15        SWAP                                85317  00860000
         ST    R0,DB+4       SAVE SIZE AVAILABLE                 85317  00870000
         FREEMAIN R,LV=(0),A=(1)  FREE IT UP AGAIN               85317  00880000
         B     &L1.F         BRANCH AROUND LISTS                 85317  00890000
&L1.L    DC    A(&MIN,&MAX)  REQUESTED STORAGE                   85317  00900000
&L1.A    DC    A(0,0)        OBTAINED ADDRESS/LENGTH             85317  00910000
&L1.F    MVC   DB+1(3),EXHFSIZ-EXHBWENT+EXCINVOK   ACTUAL SIZE  GP04234 00920000
         AIF   ('&SIZE' NE '').BSIZ2                             85317  00930000
         AIF   ('&PAD' EQ '').BNOPAD3                            85317  00940000
         MACPARM R0,&PAD,OP=LH,OPR=LR  GET PAD SIZE              85317  00950000
         N     R0,=X'0000FFFF'  KILL SIGN EXTENSION              85317  00960000
         A     R0,DB         ADD THE MODULE SIZE                 85317  00970000
         AGO   .BNOSIZ2                                          85317  00980000
.BSIZ2   MACPARM R0,&SIZE,OP=LH,OPR=LR GET DESIRED LOAD SIZE     85317  00990000
         N     R0,=X'0000FFFF'  KILL SIGN EXTENSION              85317  01000000
         CL    R0,DB         IS IT LESS THAN MODULE SIZE ?       85317  01010000
         BL    &L2           YES - REJECT REQUEST                85317  01020000
.BNOSIZ2 ST    R0,DB                   SET MODULE SIZE TO NEW VALUE     01030000
         L     &REG,DB+4     GET FREE STORAGE SIZE               85317  01040000
         N     &REG,=X'&MASK'          TRUNCATE TO PAGE BOUNDARY 85317  01050000
         CR    &REG,R0       WILL MODULE FIT ?                   85317  01060000
         AGO   .BPAD3                                            85317  01070000
.BNOPAD3 L     &REG,DB+4     GET FREE STORAGE SIZE               85317  01080000
         AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').BNORSV1 85317  01090000
         LR    R0,&REG                 SAVE FOR RESERVE CALCULATION     01100000
.BNORSV1 ANOP  ,                                                 85317  01110000
         N     &REG,=X'&MASK'          TRUNCATE TO PAGE BOUNDARY 85317  01120000
         AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').BNORSV2 85317  01130000
         SR    R0,&REG                 R0=FREE STORAGE IN LAST PAGE     01140000
         MACPARM R15,&RESERVE,OP=LH,OPR=LR GET RESERVE SIZE      85317  01150000
         N     R15,=X'0000FFFF'        KILL SIGN EXTENSION       85317  01160000
         CR    R0,R15        ENOUGH FOR RESERVE ?                85317  01170000
         BNL   &L1                       YES - LEAVE WELL ENOUGH ALONE  01180000
         SR    &REG,R15      REMOVE RESERVE SIZE                 85317  01190000
.BNORSV2 ANOP  ,                                                 85317  01200000
&L1      ST    &REG,DB+4               SAVE CALCULATED LOAD SIZE 85317  01210000
         L     R15,DB        GET MODULE SIZE BACK                85317  01220000
         N     R15,=X'00FFFFFF'   KILL SIGN EXTENSION            85317  01230000
         SR    &REG,R15      AMOUNT IN EXCESS OF MODULE SIZE     85317  01240000
.BPAD3   BNM   &L3                     GOOD, MODULE FITS         85317  01250000
&L2      MVC   INVOKE(8),EXCINVOK      COPY NAME                 85317  01260000
         B     EXCXCB               AND SHOW MODULE TO BE UNAVAILABLE   01270000
&L3      MVC   EXHFSIZ-EXHBWENT+EXCINVOK(3),DB+5  FORCE LARGEST GP04234 01280000
         AIF   ('&RESERVE' NE '' AND '&RESERVE' NE 'ALL').BNORSVL       01290000
         SLR   R15,R15                                           85317  01300000
.BNORSVL AIF   ('&RESERVE' EQ '' OR '&RESERVE' EQ 'ALL').BNORSV3 85317  01310000
         MACPARM R15,&RESERVE,OP=LH,OPR=LR GET RESERVE SIZE      85317  01320000
         N     R15,=X'0000FFFF'        KILL SIGN EXTENSION       85317  01330000
.BNORSV3 L     R0,EXCSTGMX   GET SUPPOSED AVAILABLE STORAGE     GP04234 01340000
         SR    R0,R15        SUBTRACT THE RESERVE SIZE           85317  01350000
         ST    R0,EXCSZLOD   SET AS FAKE MODULE SIZE            GP04234 01360000
         ST    R15,EXCSTGMX  SET RESERVE AS REMAINDER           GP04234 01370000
         BAL   R9,EXCLOD5    LOAD THE MODULE                     85317  01380000
         LTR   &LOADADD,R0             GOT IT ?                  85317  01390000
         BZ    &L2                     NO, SIGNAL ERROR          85317  01400000
         MEXIT ,                                                GP02231 01410000
.NEWCODE ANOP  ,                                                GP02231 01420000
.*  IN THE LATEST INCARNATION, REGION MANAGEMENT HAS BEEN DROPPED.      01430000
.*  LOAD MODULE SIZE IS FIXED (FOR DAP DETERMINED BY NAME), RESERVE,    01440000
.*  SIZE, AND PAD ARE NO LONGER MEANINGFUL.                     GP02231 01450000
&L       XLOAD '&NAME',&LOADADD  LOAD THE MODULE                GP02231 01460000
.*            EXITS TO EXCXCB WITH MESSAGE IF UNAVAILABLE       GP02231 01470000
         MVI   DB,0                                             GP02231 01480000
         MVC   DB+1(3),EXHFSIZ-EXHBWENT+EXCINVOK  SAVE ACTUAL SIZE      01490000
         MVC   DB+4(4),=A(&MAX)                                 GP02231 01500000
         SR    &REG,&REG                                        GP02231 01510000
.MEND    MEND  ,                                                GP02231 01520000
./ ADD NAME=LIX
         MACRO ,                                                        00010000
&NM      LIX   &VAL=(R0),&WK=R15,&W2=R0,&SRL=0,&BHI=,                  *00020001
               &BASE=,&LOC=,&ERRGO=,&PFX=,&ERRLOC=       ADDED  GP03144 00030003
.*--------------------------------------------------------------------* 00040000
.*                                                                    * 00050000
.*  LIX PERFORMS AN INDEXED LOOKUP WITH UP TO 256 TARGETS.            * 00060001
.*                                                                    * 00070000
.*  &VAL (R0) SPECIFIES THE REGISTER CONTAINING THE BRANCH VALUE      * 00080000
.*  &SRL (0)  SPECIFIES A NUMERIC RIGHT SHIFT COUNT                   * 00090000
.*  &BHI      LABEL TO GO TO WHEN THE VALUE MATCHES THE MASK          * 00100000
.*   MASK (BHI(2)   MASK APPLIED AFTER SHIFTING                       * 00110000
.*     { N'&LOC USED TO COMPUTE WHEN NOT SUPPLIED }                   * 00120000
.*  &ERRGO    LABEL TO GO TO ON AN INVALID VALUE AFTER SHIFT/MASK     * 00130003
.*  &ERRLOC   LABEL TO GO TO ON AN EMPTY TARGET LOCATION              * 00140002
.*  &BASE     VALUE SUBTRACTED FROM TARGET LOCATION. CURRENT CSECT IS * 00150000
.*              THE DEFAULT                                           * 00160000
.*  &LOC      LIST OF VALUES/LOCATIONS, IN ORDER CORRESPONDING TO THE * 00170001
.*              VALUE; I.E. FIRST ENTRY FOR 0, SECOND FOR 1, ETC.     * 00180000
.*              OMITTED ENTRIES CAUSE A BRANCH TO &ERRLOC             * 00190002
.*  &PFX      PREFIX TO PREPEND TO THE LOC LABELS FOR A SHORTER LIST. * 00200000
.*              THE PREFIX IS *NOT* APPLIED TO BHI OR ERR NAMES.      * 00210000
.*  &WK  (R15)  A WORK REGISTER (ANY BUT 0)                           * 00220000
.*  &W2  (R0)   A WORK REGISTER (ANY BUT WORK)                        * 00230000
.*                                                                    * 00240000
.*  SAMPLE USE:                                                       * 00250000
.*                                                                    * 00260000
.*       IBMMACRO THAT RETURNS 0, 4, 8, ETC., OR SUBROUTINE CALL      * 00270000
.*         LR   R15,R0        COPY VALUE TO WORK REGISTER             * 00280000
.*         LIX  VAL=(R15),SRL=2,LOC=(RET0,RET4),ERRGO=MACFAIL         * 00290003
.*                                                                    * 00300000
.*  NOTE THAT BITS SHIFTED OUT, AND BITS LEFT OF THE MASK ARE NOT     * 00310000
.*  TESTED FOR ZERO. THIS IS INTENTIONAL TO PERMIT USE OF LOW FLAG    * 00320000
.*  BITS AND OTHER USE OF UNREFERENCED DATA.                          * 00330000
.*                                                                    * 00340000
.*--------------------------------------------------------------------* 00350000
         LCLA  &I,&J,&N                                                 00360000
         LCLC  &LB           TABLE BASE                                 00370000
         LCLC  &BH1,&BH2     BHI OPERANDS                               00380000
         LCLC  &SPACES                                                  00390000
         LCLC  &GLBL         GENERATED LABELS                           00400001
&GLBL    SETC  'ZZLX'.'&SYSNDX'                                         00410001
&LB      SETC  '&SYSECT'                                                00420000
&SPACES  SETC  '    '                                                   00430000
         AIF   ('&BASE' EQ '' OR '&BASE' EQ '*').DEFBASE                00440000
&LB      SETC  '&BASE'                                                  00450000
.DEFBASE AIF   (N'&BHI NE 2).NOTBHI                                     00460000
&BH1     SETC  '&BHI(1)'     FIRST OF TWO ARGUMENTS                     00470000
&BH2     SETC  '&BHI(2)'     SECOND OF TWO ARGUMENTS                    00480000
.NOTBHI  AIF   (N'&BHI NE 1).DONBHI                                     00490000
&BH1     SETC  '&BHI'        ONE OF ONE, WITH PARENTHESES               00500000
.DONBHI  ANOP  ,                                                        00510000
.*--------------------------------------------------------------------* 00520000
.*  DETERMINE NUMBER OF ADDRESSES, AND CORRESPONDING MASK             * 00530000
.*--------------------------------------------------------------------* 00540000
&N       SETA  N'&LOC                                                   00550000
&J       SETA  2             SET SMALLEST MASK + 1 (=1 FAILS)           00560000
&I       SETA  &N            FOR NON-NUM SIZE, USE COUNT                00570000
         AIF   (&N NE 0 AND &N LE 256).GOTSIZE                          00580000
.BADSIZE MNOTE 8,'LIX: LOC LIST BAD - NEED 1 TO 256 TARGET LABELS'      00590001
.GOTSIZE AIF   (&J GE &I).GOTMASK                                       00600000
&J       SETA  &J*&J                                                    00610000
         AGO   .GOTSIZE                                                 00620000
.GOTMASK ANOP  ,                                                        00630000
&I       SETA  &J-1          CONVERT POWER OF TWO TO MASK               00640000
.USEMASK ANOP  ,                                                        00650000
&NM      MACPARM &WK(1),&VAL,OP=IC,OPR=LR  LOAD INDEX VALUE             00660000
         AIF   ('&SRL' EQ '0').NOSHFT                                   00670000
         MACPARM &WK(1),&SRL,OP=SRL,OPR=SRL,MODE=EVEN,NULL=SKIP         00680000
.NOSHFT  MACPARM &W2(1),&I,OP=LA,MODE=EVEN LOAD MASK VALUE              00690000
         NR    &WK(1),&W2(1) ISOLATE SIGNIFICANT PORTION                00700000
         AIF   ('&BH1' EQ '').DOWK2                                     00710000
         MACPARM &W2(1),&BH2,OP=LA,NULL=SKIP  ALLOW OVERRIDE            00720000
         CR    &WK(1),&W2(1) EXACTLY MASK MAXIMUM ?                     00730000
         MACPARM &BH1,OP=BE,OPR=BER,MODE=ONE                            00740000
.DOWK2   AIF   (T'&ERRGO EQ 'O').NOLIM                                  00750003
         AIF   ('&N' EQ '&BH2').TOOMASK  LIST HIGH SAME AS MAX ?        00760000
         CH    &WK(1),=Y(&N) VALID INDEX ?                              00770000
.TOOMASK MACPARM &ERRGO,OP=BNL,OPR=BNLR,MODE=ONE   NO; TOO HIGH         00780005
.NOLIM   SLL   &WK(1),1      CONVERT INDEX TO OFFSET                    00790000
         LH    &WK(1),*+8(&WK(1)) LOAD LABEL OFFSET FROM BASE           00800000
         B     &GLBL.Z       BRANCH AROUND STUFF                        00810001
&J       SETA  0                                                        00820000
.INC     AIF   (&J GE &N).DONE                                          00830000
&J       SETA  &J+1                                                     00840000
         AIF   ('&LOC(&J)' EQ '').DFLT                                  00850000
         DC    AL2(&PFX.&LOC(&J)-&LB)&SPACES.&J  BRANCH                 00860000
         AGO   .INC                                                     00870000
.DFLT    DC    AL2(&ERRLOC-&LB)&SPACES.&J ERROR                         00880002
         AGO   .INC                                                     00890000
.DONE    ANOP  ,                                                        00900001
&GLBL.Z  DS    0H            END OF EXPANSION                           00910001
         MEND  ,                                                        00920001
./ ADD NAME=LMVC
         MACRO                                                          00010000
&NM      LMVC  &R1,&R3                                                  00020000
         GBLC  &MODEL                                                   00030000
         LCLC  &N,&A1,&A3                                               00040000
         LCLA  &I                                                       00050000
.*                                                                      00060000
.*       THIS MACRO SUPPORTS LONG MOVES OF EQUAL LENGTH AREAS           00070000
.*       REGISTERS MUST BE SPECIFIED AS FOR MVCL                        00080000
.*       AND ARE RESTRICTED TO ABSOLUTE VALUES OR THE FORM              00090000
.*       R||ABSOLUTE; E.G. 2 4 OR R4, R6, ETC.                          00100000
.*                                                                      00110000
&I       SETA  K'&R1                                                    00120000
         AIF   (&I LT 1 OR &I GT 3).BADONE                              00130000
&A1      SETC  '&R1'                                                    00140000
         AIF   ('&A1'(1,1) NE 'R').HAV1                                 00150000
&A1      SETC  '&A1'(2,&I-1)                                            00160000
.HAV1    AIF   ('&A1' EQ '2' OR '&A1' EQ '4').GOOD1                     00170000
         AIF   ('&A1' EQ '6' OR '&A1' EQ '8' OR '&A1' EQ '10').GOOD1    00180000
         AIF   ('&A1' EQ '12' OR '&A1' EQ '14').GOOD1                   00190000
.BADONE  MNOTE 8,'INVALID TO REGISTER ''&R1'''                          00200000
         MEXIT                                                          00210000
.GOOD1   ANOP  ,                                                        00220000
&I       SETA  K'&R3                                                    00230000
         AIF   (&I LT 1 OR &I GT 3).BADTHRE                             00240000
&A3      SETC  '&R3'                                                    00250000
         AIF   ('&A3'(1,1) NE 'R').HAV3                                 00260000
&A3      SETC  '&A3'(2,&I-1)                                            00270000
.HAV3    AIF   ('&A3' EQ '2' OR '&A3' EQ '4').GOOD3                     00280000
         AIF   ('&A3' EQ '6' OR '&A3' EQ '8' OR '&A3' EQ '10').GOOD3    00290000
         AIF   ('&A3' EQ '12' OR '&A3' EQ '14').GOOD3                   00300000
.BADTHRE MNOTE 8,'INVALID FROM REGISTER ''&R3'''                        00310000
         MEXIT                                                          00320000
.GOOD3   AIF   ('&A1' NE '&A3').LAPOK                                   00330000
         MNOTE 8,'TO AND FROM REGISTERS EQUAL'                          00340000
         MEXIT                                                          00350000
.LAPOK   ANOP  ,                                                        00360000
&N       SETC  '&NM' .                                                  00370000
         AIF   ('&N' NE '').NOK                                  86010  00380000
&N       SETC  'LM'.'&SYSNDX'                                    86010  00390000
.NOK     AIF   ('&MODEL' NE '360').MVCL                                 00400000
&N       LA    &R3+1,256 .   SET MVC MAX LENGTH                         00410000
&N.1     CR    &R1+1,&R3+1 . FULL BLOCK ?                               00420000
         BNH   &N.2 .        NO, MOVE PART                              00430000
         MVC   0(256,&R1),0(&R3) MOVE BLOCK                             00440000
         AR    &R1,&R3+1 .   UP TO ADDRESS                              00450000
         AR    &R3,&R3+1 .   UP FROM                                    00460000
         SR    &R1+1,&R3+1 . REMAINDER                                  00470000
         BP    &N.1 .        CHECK RESIDUAL LENGTH                      00480000
         B     &N.4 .        DONE                                       00490000
&N.3     MVC   0(0,&R1),0(&R3)  EXECUTE PATTERN                         00500000
&N.2     BCTR  &R1+1,0 .     REMAINING LENGTH - 1                       00510000
         EX    &R1+1,&N.3 .  MOVE REMAINDER                             00520000
&N.4     EQU   *                                                        00530000
         MEXIT                                                          00540000
.MVCL    ANOP  ,                                                        00550000
&N       MVCL  &R1,&R3 .     MOVE EQUAL AREAS                           00560000
         MEND                                                           00570000
./ ADD NAME=LNE
         MACRO                                                          00001000
         LNE   &LNE                                                     00002000
         GBLA  &PCCLINE,&PCCPOS,&PCCLTYP                                00003000
         LCLC  &I                                                       00004000
&PCCPOS  SETA  1                                                        00005000
         AIF   (T'&LNE EQ 'O' OR '&LNE' EQ 'NEXT').NEXT                 00006000
         AIF   (T'&LNE EQ 'N').FIXED                                    00007000
         AIF   ('&LNE'(1,2) EQ '*+').INC                                00008000
         MNOTE 8,'OPERAND OF LNE IS NOT ''NEXT'', N, OR *+N'            00009000
.NEXT    ANOP                                                           00010000
&PCCLINE SETA  &PCCLINE+1+&PCCLTYP                                      00011000
         MEXIT                                                          00012000
.FIXED   ANOP                                                           00013000
&PCCLINE SETA  &LNE                                                     00014000
         MEXIT                                                          00015000
.INC     ANOP                                                           00016000
&I       SETC  '&LNE'(3,K'&LNE-2)                                       00017000
&PCCLINE SETA  &PCCLINE+&I                                              00018000
         MEND                                                           00019000
./ ADD NAME=LNKSTK
         MACRO ,                                                        03830000
&NM      LNKSTK &DSECT=YES                                              03840000
.*--------------------------------------------------------------------* 03850000
.*  LNKSTK PRODUCES MAPPINGS FOR STACK ENTRIES. PREFIX IS LS + THE    * 03860000
.*  ENTRY TYPE IN HEX                                                 * 03870000
.*                                                                    * 03880000
.*  LSX - COMMON ENTRY DESCRIPTOR (SAME FOR OS390 AND Z900)           * 03890000
.*  LS1 - OS390 HEADER                                                * 03900000
.*  LS2 - OS390 TRAILER                                               * 03910000
.*  LS4 - OS390 BRANCH STATE ENTRY                                    * 03920000
.*  LS5 - OS390 PROGRAM-CALL STATE                                    * 03930000
.*                                                                    * 03940000
.*  LS9 - Z/900 HEADER                                                * 03950000
.*  LSA - Z/900 TRAILER                                               * 03960000
.*  LSC - Z/900 BRANCH STATE ENTRY                                    * 03970000
.*  LSD - Z/900 PROGRAM-CALL STATE                                    * 03980000
.*                                                                    * 03990000
.*--------------------------------------------------------------------* 04000000
&NM      MACMAPHD DSECT=&DSECT,SFX=_CED,DFLT=LNKSTK                     04010000
LSCED    DS    0D            COMMON ENTRY DESCRIPTOR                    04020000
LSXET    DC    X'00'         ENTRY TYPE                                 04030000
LSXU     EQU   X'80'           UNSTACK SUPPRESSION BIT                  04040000
LSXSI    DC    X'00'         SECTION IDENTIFICATION                     04050000
LSXRFS   DC    XL2'0'        REMAINING FREE SPACE                       04060000
LSXNES   DC    XL2'0'        NEXT ENTRY SIZE (0 FOR CURRENT)            04070000
         DC    XL2'0'          RESERVED                                 04080000
LSXSIZE  EQU   *-LSXET       ENTRY DESCRIPTOR SIZE                      04090000
.*--------------------------------------------------------------------* 04100000
.*  OS390 HEADER                                                      * 04110000
.*--------------------------------------------------------------------* 04120000
&NM      MACMAPHD DSECT=&DSECT,DFLT=LNKSTK                              04130000
LSENTRY  DS    0D                                                       04140000
LS1RSV   DC    A(0)            RESERVED                                 04150000
LS1BSEA  DC    A(0)          BACKWARD STACK ENTRY ADDRESS               04160000
LS1B     EQU   X'80'           BACKWARD STACK ENTRY VALIDITY BIT        04170000
LS1LSX   DC    XL(LSXSIZE)'0' STACK ENTRY                               04180000
LS1SIZE  EQU   *-LS1RSV      SIZE WITH DESCRIPTOR                       04190000
.*--------------------------------------------------------------------* 04200000
.*  OS390 TRAILER                                                     * 04210000
.*--------------------------------------------------------------------* 04220000
         ORG   LSENTRY                                                  04230000
LS2RSV   DC    A(0)            RESERVED                                 04240000
LS2FSHA  DC    A(0)          FORWARD SECTION HEADER ADDRESS             04250000
LS2F     EQU   X'80'           FORWARD SECTION HEADER VALIDITY BIT      04260000
LS2LSX   DC    XL(LSXSIZE)'0' STACK ENTRY                               04270000
LS2SIZE  EQU   *-LS2RSV      SIZE WITH DESCRIPTOR                       04280000
.*--------------------------------------------------------------------* 04290000
.*  OS390 BRANCH STATE ENTRY                                          * 04300000
.*--------------------------------------------------------------------* 04310000
         ORG   LSENTRY                                                  04320000
LS4REGS  DC    16A(0)        GENERAL PURPOSE REGISTERS                  04330000
LS4ACRS  DC    16A(0)        ACCESS CONTROL REGISTERS                   04340000
LS4PKM   DC    XL2'0'        PSW-KEY MASK                               04350000
LS4SASN  DC    XL2'0'        SECONDARY ASN                              04360000
LS4EAX   DC    XL2'0'        EXTENDED AUTHORIZATION INDEX               04370000
LS4PASN  DC    XL2'0'        PRIMARY ASN                                04380000
LS4PSW   DC    XL8'0'                                                   04390000
LS4RSV   DC    XL4'0'          RESERVED                                 04400000
LS4BRAD  DC    XL4'0'        BRANCH ADDRESS                             04410000
LS4MOD   DC    XL8'0'        (USER) MODIFIABLE AREA                     04420000
LS4LSX   DC    XL(LSXSIZE)'0' ENTRY DESCRIPTOR                          04430000
LS4SIZE  EQU   *-LS4REGS     SIZE WITH DESCRIPTOR                       04440000
.*--------------------------------------------------------------------* 04450000
.*  OS390 PC-CALL STATE ENTRY                                         * 04460000
.*--------------------------------------------------------------------* 04470000
         ORG   LSENTRY                                                  04480000
LS5REGS  DC    16A(0)        GENERAL PURPOSE REGISTERS                  04490000
LS5ACRS  DC    16A(0)        ACCESS CONTROL REGISTERS                   04500000
LS5PKM   DC    XL2'0'        PSW-KEY MASK                               04510000
LS5SASN  DC    XL2'0'        SECONDARY ASN                              04520000
LS5EAX   DC    XL2'0'        EXTENDED AUTHORIZATION INDEX               04530000
LS5PASN  DC    XL2'0'        PRIMARY ASN                                04540000
LS5PSW   DC    XL8'0'                                                   04550000
LS5CSI   DC    XL4'0'        CALLED SPACE ID                            04560000
LS5PCN   DC    XL4'0'        PC NUMBER                                  04570000
LS5MOD   DC    XL8'0'        (USER) MODIFIABLE AREA                     04580000
LS5LSX   DC    XL(LSXSIZE)'0' ENTRY DESCRIPTOR                          04590000
LS5SIZE  EQU   *-LS5REGS     SIZE WITH DESCRIPTOR                       04600000
.*--------------------------------------------------------------------* 04610000
.*  Z/900 HEADER                                                      * 04620000
.*--------------------------------------------------------------------* 04630000
         ORG   LSENTRY                                                  04640000
LS9BSEA  DC    XL8'0'        BACKWARD STACK ENTRY ADDRESS               04650000
LS9B     EQU   X'01'           BACKWARD STACK ENTRY VALIDITY BIT        04660000
LS9LSX   DC    XL(LSXSIZE)'0' STACK ENTRY                               04670000
LS9SIZE  EQU   *-LS9BSEA     SIZE WITH DESCRIPTOR                       04680000
.*--------------------------------------------------------------------* 04690000
.*  Z/900 TRAILER                                                     * 04700000
.*--------------------------------------------------------------------* 04710000
         ORG   LSENTRY                                                  04720000
LSAFSHA  DC    XL8'0'        FORWARD SECTION HEADER ADDRESS             04730000
LSAF     EQU   X'01'           FORWARD SECTION HEADER VALIDITY BIT      04740000
LSALSX   DC    XL(LSXSIZE)'0' STACK ENTRY                               04750000
LSASIZE  EQU   *-LSAFSHA     SIZE WITH DESCRIPTOR                       04760000
.*--------------------------------------------------------------------* 04770000
.*  Z/900 BRANCH STATE ENTRY                                          * 04780000
.*--------------------------------------------------------------------* 04790000
         ORG   LSENTRY                                                  04800000
LSCREGS  DC    16XL8'0'      GENERAL PURPOSE REGISTERS                  04810000
LSCPKM   DC    XL2'0'        PSW-KEY MASK                               04820000
LSCSASN  DC    XL2'0'        SECONDARY ASN                              04830000
LSCEAX   DC    XL2'0'        EXTENDED AUTHORIZATION INDEX               04840000
LSCPASN  DC    XL2'0'        PRIMARY ASN                                04850000
LSCPSWL  DC    XL8'0'                                                   04860000
LSCBRAD  DC    XL8'0'        BRANCH ADDRESS                             04870000
LSCBR64  EQU   X'01'           AM64 IF LOW BIT ON                       04880000
LSCMOD   DC    XL8'0'        (USER) MODIFIABLE AREA                     04890000
LSCRSV   DC    XL8'0'          RESERVED                                 04900000
LSCPSWR  DC    XL8'0'        PSW                                        04910000
LSCRSV2  DC    XL48'0'         RESERVED                                 04920000
LSCACRS  DC    16XL4'0'      ACCESS CONTROL REGISTERS                   04930000
LSCLSX   DC    XL(LSXSIZE)'0' ENTRY DESCRIPTOR                          04940000
LSCSIZE  EQU   *-LSCREGS     SIZE WITH DESCRIPTOR                       04950000
.*--------------------------------------------------------------------* 04960000
.*  Z/900 PC-CALL STATE ENTRY                                         * 04970000
.*--------------------------------------------------------------------* 04980000
         ORG   LSENTRY                                                  04990000
LSDREGS  DC    16XL8'0'      GENERAL PURPOSE REGISTERS                  05000000
LSDPKM   DC    XL2'0'        PSW-KEY MASK                               05010000
LSDSASN  DC    XL2'0'        SECONDARY ASN                              05020000
LSDEAX   DC    XL2'0'        EXTENDED AUTHORIZATION INDEX               05030000
LSDPASN  DC    XL2'0'        PRIMARY ASN                                05040000
LSDPSWL  DC    XL8'0'        PSW                                        05050000
LSDCSI   DC    XL4'0'        CALLED SPACE ID                            05060000
LSDPCN   DC    XL4'0'        PC NUMBER                                  05070000
LSDPC64  EQU   X'80'           AM64 IF HIGH BIT ON                      05080000
LSDMOD   DC    XL8'0'        (USER) MODIFIABLE AREA                     05090000
LSDRSV   DC    XL8'0'          RESERVED                                 05100000
LSDPSWR  DC    XL8'0'        PSW                                        05110000
LSDRSV2  DC    XL48'0'         RESERVED                                 05120000
LSDACRS  DC    16XL4'0'      ACCESS CONTROL REGISTERS                   05130000
LSDLSX   DC    XL(LSXSIZE)'0' ENTRY DESCRIPTOR                          05140000
LSDSIZE  EQU   *-LSDREGS     SIZE WITH DESCRIPTOR                       05150000
         ORG   ,                                                        05160000
         MEND  ,                                                        05170000
./ ADD NAME=LOCBYTE
         MACRO ,                                                        00010000
&NM      LOCBYTE &TEXT,&WK=R14,&W2=R15,&BYTE=C' ',&LEN=,  ADDED GP03080*00020000
               &END=                                            GP03199 00030000
.*--------------------------------------------------------------------* 00040000
.*                                                                    * 00050000
.*  LOCBYTE SETS UP REGISTERS FOR A SEARCH STRING FOR BYTE (SRST)     * 00060000
.*    OPERATION.                                                      * 00070000
.*  &TEXT     SPECIFIES THE ADDRESS OF THE TEXT STRING TO BE SEARCHED * 00080000
.*    USE EITHER LEN= OR END=                                         * 00090000
.*  &END      SPECIFIES THE TEXT END ADDRESS + 1                      * 00100000
.*  &LEN      SPECIFIES THE TEXT LENGTH; DEFAULT IS L'&TEXT           * 00110000
.*  &WK (14)  WORK REGISTER                                           * 00120000
.*  &W2 (15)  RESULT REGISTER (TEXT+LEN IF NOTHING FOUND)             * 00130000
.*  &BYTE     SELF-DEFINING TERM FOR SEARCH CHARACTER                 * 00140000
.*                                                                    * 00150000
.*  WHEN DONE,                                                        * 00160000
.*                                                                    * 00170000
.*         CONDITION CODE 1 (BH) NO MATCH FOUND                       * 00180000
.*         CONDITION CODE 2 (BL) MATCH FOUND; ADDRESS IN &W2          * 00190000
.*                                                                    * 00200000
.*  SAMPLE USE:                                                       * 00210000
.*                                                                    * 00220000
.*       LOCBYTE INBUFF      BUFFER, CARD IMAGE, ETC. BUFFER          * 00230000
.*       BH    NOTFOUND        NOTHING FOUND                          * 00240000
.*       BCTR  R15,0     E.G., SPACE TO LAST BYTE                     * 00250000
.*                                                                    * 00260000
.*--------------------------------------------------------------------* 00270000
         LCLC  &L,&LAB                                                  00280000
&L       SETC  'L'''                                                    00290000
&LAB     SETC  'ZZ'.'&SYSNDX'                                           00300000
&NM      MACPARM R0,&BYTE                                       GP03199 00310000
         MACPARM &WK,&TEXT   LOAD TEXT ADDRESS                          00320000
         AIF   ('&END' EQ '').HAVELEN                           GP03199 00330000
         MACPARM &W2,&END    LOAD END ADDRESS+1                 GP03199 00340000
         AIF   ('&LEN' EQ '').DONELEN                           GP03199 00350000
         MNOTE 8,'LOCBYTE: END= AND LEN= ARE MUTUALLY EXCLUSIVE'        00360000
.HAVELEN MACPARM &W2,&LEN,NULL=&L&TEXT                          GP03199 00370000
         MACPARM &W2,(&WK),OP=AR,OPR=AR                                 00380000
.DONELEN ANOP  ,                                                GP03199 00390000
&LAB.LP  SRST  &W2,(&WK)                                        GP04234 00400000
         BO    &LAB.LP                                                  00410000
.DONE    MEND  ,                                                        00420000
./ ADD NAME=LOCLEN
         MACRO ,                                                        00010000
&NM      LOCLEN &AD,&LN,&BYTE=C' '                     ADDED ON GP09333 00020000
         LCLC  &L                                                       00030000
&L       SETC  'L'''                                                    00040000
.*  LOCLEN SUGGESTED BY FINDLBLK, AS PUBLISHED ON ASSEMBLER-LIST        00050000
.*    BY CLEMENT VICTOR CLARKE                                          00060000
.*                                                                      00070000
&NM      MACPARM R15,&AD     LOAD STRING ADDRESS                        00080000
         MACPARM R1,&LN,NULL=&L&AD   LOAD THE LENGTH                    00090000
         MACPARM R0,=4&BYTE,OP=L     SEARCH ARGUMENT                    00100000
         MACPARM R14,=H'-4',OP=LH    DECREMENT                          00110000
         CH    R1,=H'4'      LONG ENOUGH FOR WORD TEST?                 00120000
         BL    ZZ&SYSNDX.W   USE BYTE COMPARE                           00130000
         AR    R1,R15        END ADDRESS                                00140000
         AR    R1,R14        LAST WORD                                  00150000
         CLM   R0,15,0(R1)   LAST FOUR MATCH ?                          00160000
         BNE   ZZ&SYSNDX.X   NO; USE BYTE COMPARE                       00170000
         NR    R1,R14        TRUNCATE TO WORD BOUNDARY                  00180000
ZZ&SYSNDX.L C  R0,0(,R1)     WORD MATCHED?                              00190000
         BNE   ZZ&SYSNDX.X   NO; USE BYTE COMPARE                       00200000
         BXH   R1,R14,ZZ&SYSNDX.L   TRY AGAIN                           00210000
ZZ&SYSNDX.V SR R1,R1                                                    00220000
         B     ZZ&SYSNDX.Z   EXIT                                       00230000
ZZ&SYSNDX.W LTR R1,R1        ANY USABLE LENGTH ?                        00240000
         BNP   ZZ&SYSNDX.V   NO; RETURN 0                               00250000
         AR    R1,R15        END ADDRESS                                00260000
         AR    R1,R14        LAST WORD                                  00270000
ZZ&SYSNDX.X LA R1,3(,R1)     ADVANCE TO END                             00280000
         LH    R14,=H'-1'    DECREMENT BY 1                             00290000
ZZ&SYSNDX.Y CLI 0(R1),&BYTE   MATCH ?                                   00300000
         BNE   *+8           NO; DONE                                   00310000
         BXH   R1,R14,ZZ&SYSNDX.Y  TRY AGAIN                            00320000
         SR    R1,R15        CALCULATE LENGTH - 1                       00330000
         SR    R1,R14        TRUE LENGTH                                00340000
ZZ&SYSNDX.Z DS 0H                                                       00350000
         MEND  ,                                                        00360000
./ ADD NAME=LPALOOK
         MACRO ,                                                        00010000
&NM      LPALOOK &EP=,&EPLOC=,&DCB=,&MEMBER=,&ALIAS=,&ERR=              00020000
.*--------------------------------------------------------------------* 00030000
.*  LPALOOK INVOKES SUBROUTINE SUBLPALK, WHICH USES CSVQUERY TO LOOK  * 00040000
.*    FOR THE MODULE REQUESTED BY EITHER EP=, OR NAMED IN EPLOC.      * 00050000
.*  WHEN THE DCB IS NON-ZERO, THE MODULE IS LOADED IF NOT IN AN LPA   * 00060000
.*    LIST. LOAD USES DCB=0 WHEN DCB PARAMETER<256                    * 00070000
.*                                                                    * 00080000
.*  AN EXTRN IS ISSUED UNLESS THE MODULE WAS NAMED IN A SERVLOAD REQ. * 00090000
.*--------------------------------------------------------------------* 00100000
         GBLC  &MACPLAB                                                 00110000
         GBLC  &SRVLMOD(20),&SRVLDEL(20)                                00120000
         GBLB  &MVSXA                                           GP04234 00130000
         GBLB  &SRVBMOD(20)                                             00140000
         GBLA  &SRVNMOD                                                 00150000
         GBLB  &ZLPAKFG                                                 00160000
         LCLA  &I                                                       00170000
         LCLC  &CALLMOD                                                 00180000
&CALLMOD SETC  '=A(SUBLPALK)'    LPA LOOKUP/LOAD MODULE                 00190000
&MACPLAB SETC  '&NM'                                                    00200000
.LOOKLUK AIF   (&I GE &SRVNMOD).SKIPLUK  NOT IN SERVLOAD LIST           00210000
&I       SETA  &I+1                                                     00220000
         AIF   ('&SRVLDEL(&I)' NE 'SUBLPALK').LOOKLUK                   00230000
&CALLMOD SETC  '&SRVLMOD(&I)'  USE SERVLOAD ADDRESS                     00240000
         AGO   .COMMLUK                                                 00250000
.SKIPLUK AIF   (&ZLPAKFG).COMMLUK                                       00260000
         EXTRN SUBLPALK                                                 00270000
&ZLPAKFG SETB  1                                                        00280000
.COMMLUK AIF   ('&EP' EQ '' AND '&EPLOC' EQ '').OMIT                    00290000
         AIF   ('&EP' NE '' AND '&EPLOC' NE '').DUPE                    00300000
         MACPARM R0,&DCB,NULL=0                                         00310000
         AIF   ('&EP' EQ '').NOEP                                       00320000
         MACPARM R1,=CL8'&EP '                                          00330000
         AGO   .COMMON                                                  00340000
.NOEP    MACPARM R1,&EPLOC                                              00350000
.COMMON  MACPARM R15,&CALLMOD,OP=L                                      00360000
         AIF   (&MVSXA).DOBAS                                   GP04234 00370000
         MACPARM R14,(R15),OP=BAL,OPR=BALR                              00380000
         AGO   .NOBAS                                                   00390000
.DOBAS   MACPARM R14,(R15),OP=BAS,OPR=BASR                              00400000
.NOBAS   AIF ('&MEMBER' EQ '' AND '&ALIAS' EQ '' AND '&ERR' EQ '').MEND 00410000
         MACPARM R15,=H'4',OP=CH  CHECK RETURN CODE                     00420000
         MACPARM &MEMBER,OP=BL,OPR=BLR,MODE=ONE,NULL=SKIP               00430000
         MACPARM &ALIAS,OP=BE,OPR=BER,MODE=ONE,NULL=SKIP                00440000
         MACPARM &ERR,OP=BH,OPR=BHR,MODE=ONE,NULL=SKIP                  00450000
         MEXIT ,                                                 81169  00460000
.OMIT    MNOTE 8,'NEITHER EP= NOR EPLOC= SUPPLIED'               81169  00470000
         AGO   .DEFLAB                                           81169  00480000
.DUPE    MNOTE 8,'EP= AND EPLOC= ARE MUTUALLY EXCLUSIVE'         81169  00490000
.DEFLAB  MACPARM MODE=LBL    EXPAND LABEL ONLY                          00500000
.MEND    MEND  ,                                                        00510000
./ ADD NAME=LTCB
         MACRO ,                                                        00010000
&NM      LTCB  &R,&HAVE=,&USE=NO                        ADDED ON 86138  00020000
         GBLB  &MVS                                                     00030000
         LCLC  &N                                                       00040000
&N       SETC  '&NM'                                                    00050000
         AIF   (&MVS).PSA                                               00060000
         AIF   ('&HAVE' EQ 'CVT').HAVCVT                                00070000
&N       L     &R,CVTPTR                                                00080000
&N       SETC  ''                                                       00090000
         L     &R,CVTTCBP-CVTMAP(,&R)                            90327  00100000
         AGO   .OLDBOX                                           90327  00110000
.HAVCVT  ANOP  ,                                                        00120000
&N       L     &R,CVTTCBP                                               00130000
.OLDBOX  L     &R,4(,&R)                                                00140000
         AGO   .EXIT                                                    00150000
.PSA     ANOP  ,                                                        00160000
&N       L     &R,PSATOLD-PSA                                           00170000
.EXIT    AIF   ('&USE' EQ 'NO').MEND                                    00180000
         USING TCB,&R                                                   00190000
.MEND    MEND                                                           00200000
./ ADD NAME=LTJID
         MACRO                                                          00010000
&L       LTJID &REG,&BYTE1,&BYTE2,&MASK=YES                             00020000
         GBLC  &MODEL                                                   00030000
         LCLC  &NM                                                      00040000
&NM      SETC  '&L'                                                     00050000
         AIF   ('&MASK' NE 'NO').NOMA                                   00060000
&NM      XR    &REG,&REG                                                00070000
&NM      SETC  ''                                                       00080000
.NOMA    AIF   ('&MODEL' EQ '360').TJID360                              00090000
&NM      ICM   &REG,3,&BYTE1           BITS 1-7 OF TJID                 00100000
         AGO   .TJID370                NOW ARE YOU HAPPY?               00110000
.TJID360 ANOP ,                                                         00120000
&NM      IC    &REG,&BYTE1             BITS  1-7 OF TJID                00130000
         SLL   &REG,8                  MAKE ROOM FOR SECOND BYTE        00140000
.TJID370 AIF   ('&BYTE2' EQ '').UP4                                     00150000
         IC    &REG,&BYTE2                   8-F OF TJID                00160000
         AGO   .COMASK                                                  00170000
.UP4     IC    &REG,4+&BYTE1                 8-F OF TJID                00180000
.COMASK  AIF   ('&MASK' EQ '' OR '&MASK' EQ 'NO').MEND                  00190000
         AIF   ('&MASK' EQ 'YES').MLIT                                  00200000
         MACPARM &REG,&MASK,OP=N,OPR=NR         KILL HIGH BITS          00210000
         MEXIT ,                                                        00220000
.MLIT    N     &REG,=X'00007FFF'       MASK HIGH BIT                    00230000
.MEND    MEND                                                           00240000
./ ADD NAME=LTJP
         MACRO ,                                                        00010000
&NM      LTJP  &REG,&OFFSET,&BASE=,&END=                ADDED ON 83332  00020000
         GBLC  &SYSTEM,&MACPLAB,&LOCAL                           84317  00030000
         GBLB  &MVSXA                                            92309  00040000
         GBLA  &REL                                                     00050000
&MACPLAB SETC  ''                                                       00060000
         AIF   ('&SYSTEM' NE 'MVS').MEND                                00070000
         AIF   (&REL LT 102).OLDJESP                                    00080000
         AIF   (&REL EQ 102 AND '&LOCAL' EQ 'CCSI').OLDJESP      84317  00090000
         AIF   ('&OFFSET' NE 'JQECHAIN').NOTOLD                  83345  00100000
&NM      ICM   &REG,15,JQENEXT                                   83345  00110000
         AGO   .COMNAM                                           83345  00120000
.NOTOLD  ANOP  ,                                                 83345  00130000
&NM      ICM   &REG,15,&OFFSET                                          00140000
.COMNAM  AIF   (NOT &MVSXA OR &REL LT 220).COMASK                92309  00150000
         N     &REG,=X'00FFFFFF'  OOPS                           92309  00160000
         AGO   .COMMON                                           92309  00170000
.COMASK  N     &REG,=X'00FFFFFF'                                 83345  00180000
         AGO   .COMMON                                                  00190000
.OLDJESP ANOP  ,                                                        00200000
&NM      ICM   &REG,12,&OFFSET                                          00210000
         SRL   &REG,16                                                  00220000
         SLA   &REG,2                                                   00230000
.COMMON  AIF   (T'&END EQ 'O').NOEND                                    00240000
         MACPARM &END,OP=BZ,OPR=BZR                                     00250000
.NOEND   AIF   (T'&BASE EQ 'O').MEND                                    00260000
         MACPARM &BASE,OP=AL,OPR=ALR                                    00270000
.MEND    MEND  ,                                                        00280000
./ ADD NAME=LTJQEP
         MACRO ,                                                        00010000
&NM      LTJQEP &REG,&OFFSET,&BASE=,&END=               ADDED ON 85076  00020000
         COPY  OPTIONGB                                                 00030000
         GBLC  &MACPLAB                                                 00040000
&MACPLAB SETC  ''                                                       00050000
         AIF   (NOT &MVS).MEND                                          00060000
         AIF   (K'&JES2REL LT 3).OLDJESP                                00070000
&NM      ICM   &REG,15,&OFFSET                                          00080000
         N     &REG,=X'00FFFFFF'                                        00090000
         AGO   .COMMON                                                  00100000
.OLDJESP ANOP  ,                                                        00110000
&NM      ICM   &REG,12,&OFFSET                                          00120000
         SRL   &REG,16                                                  00130000
         SLA   &REG,2                                                   00140000
.COMMON  AIF   (T'&END EQ 'O').NOEND                                    00150000
         MACPARM &END,OP=BZ,OPR=BZR                                     00160000
.NOEND   AIF   (T'&BASE EQ 'O').MEND                                    00170000
         MACPARM &BASE,OP=AL,OPR=ALR                                    00180000
.MEND    MEND  ,                                                        00190000
./ ADD NAME=LTP
         MACRO ,                                                        00010000
&NM      LTP   &R,&INDEX,&BZ=,&BNZ=,&PARM=                              00020000
         GBLC  &ZZLTPRM                                                 00030000
.*--------------------------------------------------------------------* 00040000
.*   LTP LOADS AND TESTS A PARAMETER E.G., CALL SUBR(A,B,C..) A=0,B=1 * 00050000
.*   OP1:REGISTER TO BE LOADED  INDEX:PARAMETER NUMBER (REL. TO 0)    * 00060000
.*   BZ:TARGET WHEN ADDRESS IS ZERO     PARM:REG. WITH PARM ADDRESS   * 00070000
.*   PARM DEFAULTS TO R9, ELSE MAY BE SET ON THE FIRST INVOCATION     * 00080000
.*--------------------------------------------------------------------* 00090000
         AIF   ('&PARM' NE '').SETPARM                                  00100000
         AIF   ('&ZZLTPRM' NE '').COMPARM                               00110000
&ZZLTPRM SETC  'R9'          DEFAULT PARM REGISTER                      00120000
.SETPARM ANOP  ,                                                        00130000
&ZZLTPRM SETC  '&PARM(1)'                                               00140000
.COMPARM ANOP  ,                                                        00150000
&NM      L     &R(1),&INDEX*4(,&ZZLTPRM)                                00160000
         AIF   ('&BZ' EQ '' AND '&BNZ' EQ '').MEND                      00170000
         LA    &R(1),0(,&R(1))                                          00180000
         LTR   &R(1),&R(1)                                              00190000
         MACPARM &BZ,OP=BZ,OPR=BZR,NULL=SKIP,MODE=ONE                   00200000
         MACPARM &BNZ,OP=BNZ,OPR=BNZR,NULL=SKIP,MODE=ONE                00210000
.MEND    MEND  ,                                                        00220000
./ ADD NAME=MACAD
         MACRO ,                                                        00010000
&NM      MACAD &LABEL                                  NEW 2009.081 GYP 00020000
.*--------------------------------------------------------------------* 00030000
.*   MACAD EXPANDS A LABELLED DC WITH EITHER AN ADDRESS CONSTANT OR   * 00040000
.*     A WORD OF ZEROES.                                              * 00050000
.*   USED AS AN INNER MACRO TO EXPAND DEFINITIONS OR MAPPING          * 00060000
.*--------------------------------------------------------------------* 00070000
         GBLB  &ZZLABYN                                                 00080000
         LCLA  &I,&N                                                    00090000
         LCLC  &STR,&LAB                                                00100000
&N       SETA  N'&SYSLIST    GET NUMBER OF OPERANDS                     00110000
         AIF   (NOT &ZZLABYN).SIMPLE                                    00120000
&LAB     SETC  '&NM'                                                    00130000
.DOLAB   AIF   (&I GE &N).MEND                                          00140000
&I       SETA  &I+1                                                     00150000
&LAB     DC    A(&SYSLIST(&I))                                          00160000
&LAB     SETC  ''                                                       00170000
         AGO   .DOLAB                                                   00180000
.SIMPLE  ANOP  ,                                                        00190000
&NM      DC    &N.A(0)                                                  00200000
.MEND    MEND  ,                                                        00210000
./ ADD NAME=MACBDDDL
         MACRO ,                                                        00010000
         MACBDDDL &OP,&LEN                               NEW ON 2010290 00020000
         GBLC  &MACSTR       RETURN OPERAND STRING                      00030000
         GBLA  &MACTYP       RETURN OPERAND TYPE (1-REG,2-TXT,3-MIX)    00040000
.*                                                                      00050000
.*   THIS MACRO ACCEPTS AN OPERAND EXPRESSION AND A LENGTH,             00060000
.*   AND RETURNS A SINGLE OPERAND COMBINING THE TWO.  E.G.,             00070000
.*     TEXT,5                -> TEXT(5)                                 00080000
.*     (R6),4                -> 0(4,R6)                                 00090000
.*     XYZ(R9),3             -> XYZ(3,R9)                               00100000
.*     ((R6)),8              -> ((R6))(8)                               00110000
.*                                                                      00120000
         LCLC  &OP1,&OP2                                                00130000
         LCLA  &I,&J,&K,&L                                              00140000
&MACSTR  SETC  ''            ERROR INDICATION                           00150000
&MACTYP  SETA  0             ERROR INDICATION                           00160000
&K       SETA  K'&OP         LENGTH OF INPUT OPERAND                    00170000
         AIF   (&K LT 1).MEND     ERROR                                 00180000
         AIF   (&K LT 3).BDDD     PLAIN TEXT                            00190000
         AIF   ('&OP'(&K,1) NE ')').BDDD    SIMPLE TEXT                 00200000
         AIF   ('&OP'(&K-1,1) EQ ')').BDDD                              00210000
         AIF   ('&OP'(1,1) NE '(' OR '&OP'(2,1) EQ '(').MIX             00220000
.REG0    ANOP  ,                                                        00230000
&MACTYP  SETA  1             REGISTER                                   00240000
&MACSTR  SETC  '0('.'&LEN'.','.'&OP'.')' GENERATE OPERAND FIELD         00250000
         MEXIT ,                                                        00260000
.MIX     ANOP  ,                                                        00270000
.*  PARSE xxx ( yyy ) - CHANGE TO xxx ( len , yyy )                     00280000
&I       SETA  &K                                                       00290000
&J       SETA  1                                                        00300000
.QLOOP   AIF   (&I LE 1).BDDD                                           00310000
&I       SETA  &I-1                                                     00320000
         AIF   ('&OP'(&I,1) EQ '(').QLEFT                               00330000
         AIF   ('&OP'(&I,1) EQ ')').QRITE                               00340000
         AGO   .QLOOP                                                   00350000
.QRITE   ANOP  ,                                                        00360000
&J       SETA  &J+1                                                     00370000
         AGO   .QLOOP                                                   00380000
.QLEFT   ANOP  ,                                                        00390000
&J       SETA  &J-1                                                     00400000
         AIF   (&J GT 0).QLOOP                                          00410000
         AIF   (&I LE 1).BDDD                                           00420000
&OP1     SETC  '&OP'(1,&I)                                              00430000
&OP2     SETC  '&OP'(&I+1,&K-&I)                                        00440000
&MACSTR  SETC  '&OP1'.'&LEN'.','.'&OP2'                                 00450000
&MACTYP  SETA  3             MIXED                                      00460000
         MEXIT ,                                                        00470000
.BDDD    ANOP  ,                                                        00480000
&MACSTR  SETC  '&OP'.'('.'&LEN'.')'    GENERATE OPERAND FIELD           00490000
&MACTYP  SETA  2             TEXT                                       00500000
.MEND    MEND  ,                                                        00510000
./ ADD NAME=MACBL
         MACRO ,                                                        00000100
&NM      MACBL &LABEL                                  NEW 2009.082 GYP 00000202
.*--------------------------------------------------------------------* 00000300
.*   MACAD EXPANDS A LABELLED BRANCH TO THE TARGET ADDRESS, OR        * 00000400
.*     A WORD OF ZEROES.                                              * 00000500
.*   USED AS AN INNER MACRO TO EXPAND DEFINITIONS OR MAPPING          * 00000600
.*--------------------------------------------------------------------* 00000700
         GBLB  &ZZLABYN                                                 00000800
         LCLA  &I,&N                                                    00000900
         LCLC  &STR,&LAB                                                00001000
&N       SETA  N'&SYSLIST    GET NUMBER OF OPERANDS                     00001100
         AIF   (NOT &ZZLABYN).SIMPLE                                    00001200
&LAB     SETC  '&NM'                                                    00001300
.DOLAB   AIF   (&I GE &N).MEND                                          00001400
&I       SETA  &I+1                                                     00001500
&LAB     B     &SYSLIST(&I)                                             00001600
&LAB     SETC  ''                                                       00001700
         AGO   .DOLAB                                                   00001800
.SIMPLE  ANOP  ,                                                        00001900
&NM      DC    &N.AL4(0)                                                00002000
.MEND    MEND  ,                                                        00002100
./ ADD NAME=MACDC
         MACRO ,                                                        00010000
&NM      MACDC &TEXT                                   NEW 2003.091 GYP 00020000
.*--------------------------------------------------------------------* 00030000
.*   MACDC EXPANDS A LABELLED DC WHEN GLOBAL ZZLABYN IS TRUE, ELSE    * 00040000
.*     IT EXPANDS AN UNLABELLED DC                                    * 00050000
.*   USED AS AN INNER MACRO TO EXPAND DEFINITIONS OR MAPPING          * 00060000
.*--------------------------------------------------------------------* 00070000
         GBLB  &ZZLABYN                                                 00080000
         LCLA  &I,&N                                                    00090000
         LCLC  &STR,&LAB                                                00100000
&N       SETA  N'&SYSLIST    GET NUMBER OF OPERANDS                     00110000
         AIF   (NOT &ZZLABYN).NOLAB                                     00120000
&LAB     SETC  '&NM'                                                    00130000
.NOLAB   AIF   (&I GE &N).MEND                                          00140000
&I       SETA  &I+1                                                     00150000
&LAB     DC    &SYSLIST(&I)                                             00160000
&LAB     SETC  ''                                                       00170000
         AGO   .NOLAB                                                   00180000
.MEND    MEND  ,                                                        00190000
./ ADD NAME=MACDEFXT
         MACRO ,                                                        00010000
         MACDEFXT &NAME,&TYPE                            ADDED  GP05250 00020000
.*                                                                      00030000
.*  (POOR) REPLACEMENT FOR D' ATTRIBUTE TO ALLOW ASSEMBLY UNDER ASM XF  00040000
.*                                                                      00050000
         GBLC  &ZZEXTNM(100) NAMES OF PREVIOUSLY DEFINED EXTERNALS      00060000
         GBLA  &ZZEXTFG      0 ON ERROR; 1 IF ADDED; 2 IF OLD           00070000
         GBLA  &ZZEXT##      NUMBER OF EXTERNALS DEFINED                00080000
.*                                                                      00090000
         LCLC  &WHAT   TYPE: EXTRN, WXTRN, OR 'OTHER' (NAME SAVED ONLY) 00100000
         LCLA  &I,&J                                                    00110000
&ZZEXTFG SETA  0             SET ERROR                                  00120000
         AIF   ('&NAME' EQ '').MEND    NULL SUBSTITUTE?                 00130000
         AIF   ('&TYPE' EQ 'OTHER').TYPOK                               00140000
&WHAT    SETC  'WXTRN'       MOST FREQUENT ?                            00150000
         AIF   ('&TYPE' EQ 'WXTRN').TYPOK                               00160000
&WHAT    SETC  'EXTRN'       DEFAULT                                    00170000
         AIF   (T'&TYPE EQ 'O' OR '&TYPE' EQ 'EXTRN').TYPOK             00180000
         MNOTE 8,'MACDEFXT: UNSUPPORTED TYPE &TYPE - NOT EXRTN, WXTRN'  00190000
.TYPOK   AIF   (&I GE &ZZEXT##).NEW                                     00200000
&I       SETA  &I+1                                                     00210000
         AIF   ('&ZZEXTNM(&I)' NE '&NAME').TYPOK                        00220000
&ZZEXTFG SETA  2             SET OLD                                    00230000
         MEXIT ,             PREVIOUSLY DEFINED - NO ACTION             00240000
.*                                                                      00250000
.FULL    MNOTE 4,'MACDEFXT: NAME TABLE FULL - NAME NOT SAVED'           00260000
         MEXIT ,             PREVIOUSLY DEFINED - NO ACTION             00270000
.*                                                                      00280000
.NEW     AIF   ('&TYPE' EQ 'OTHER').JUSTADD                             00290000
         &WHAT &NAME                                                    00300000
.JUSTADD AIF   (&ZZEXT## GT 99).FULL                                    00310000
&ZZEXT## SETA  &ZZEXT##+1                                               00320000
&ZZEXTNM(&ZZEXT##) SETC '&NAME'   REMEMBER THE NAME                     00330000
&ZZEXTFG SETA  1             SET NEW                                    00340000
.MEND    MEND  ,             PREVIOUSLY DEFINED - NO ACTION             00350000
./ ADD NAME=MACLIST
         MACRO ,                                                        00010000
         MACLIST &LIST                                 NEW 2004.234 GYP 00020000
.*--------------------------------------------------------------------* 00030000
.*   MACLIST IS USED TO COMPENSATE FOR ASSEMBLER F/XF INABILITY TO    * 00040000
.*     PROVIDE N'&LIST(&I,&N) SUPPORT.                                * 00050000
.*   THIS MACRO STRIPS UP TO 10 INNER VALUES                          * 00060000
.*   E.G.       MYMAC OPTS=(A,(B1,B2,B3),(C1,C2))                     * 00070000
.*    HLASM N'&OPTS(2) IS 3, N'&OPTS(3) IS 2                          * 00080000
.*    XFASM FAILS ALL BUT N'&OPTS                                     * 00090000
.*                                                                    * 00100000
.*    USE:   MACLIST &OPTS(2)                                         * 00110000
.*    RESULTS RETURNED IN &MACP1-&MACP10, COUNT IN &MACP#             * 00120000
.*--------------------------------------------------------------------* 00130000
         GBLA  &MACP#        NUMBER OF (SUB)LIST ARGUMENTS              00140000
         GBLC  &MACP1,&MACP2,&MACP3,&MACP4,&MACP5                       00150000
         GBLC  &MACP6,&MACP7,&MACP8,&MACP9,&MACP10                      00160000
         LCLA  &I,&J,&K,&N                                              00170000
         LCLC  &STR,&LAB                                                00180000
         LCLC  &VAL(10)                                                 00190000
&STR     SETC  '&LIST'                                                  00200000
&J       SETA  1             OUTPUT SUBSCRIPT                           00210000
&K       SETA  K'&LIST                                                  00220000
         AIF   (&K LT 1).DONE                                           00230000
         AIF   ('&STR'(1,1) NE '(' OR '&STR'(&K,1) NE ')').NOPARS       00240000
&STR     SETC  '&STR'(2,&K-2)                                           00250000
&K       SETA  K'&STR                                                   00260000
.NOPARS  AIF   (&I GE &K).DONE                                          00270000
&I       SETA  &I+1                                                     00280000
         AIF   ('&STR'(&I,1) EQ ',').NEWPRM                             00290000
&VAL(&J) SETC  '&VAL(&J)'.'&STR'(&I,1)                                  00300000
         AGO   .NOPARS                                                  00310000
.NEWPRM  AIF   (&J GE 10).TOOMANY                                       00320000
&J       SETA  &J+1                                                     00330000
         AGO   .NOPARS                                                  00340000
.TOOMANY MNOTE 8,'MACLIST SUPPORTS MAX OF 10 SUBLIST ITEMS'             00350000
.DONE    ANOP  ,                                                        00360000
&MACP#   SETA  &J            GET NUMBER OF OPERANDS                     00370000
&MACP1   SETC  '&VAL(1)'                                                00380000
&MACP2   SETC  '&VAL(2)'                                                00390000
&MACP3   SETC  '&VAL(3)'                                                00400000
&MACP4   SETC  '&VAL(4)'                                                00410000
&MACP5   SETC  '&VAL(5)'                                                00420000
&MACP6   SETC  '&VAL(6)'                                                00430000
&MACP7   SETC  '&VAL(7)'                                                00440000
&MACP8   SETC  '&VAL(8)'                                                00450000
&MACP9   SETC  '&VAL(9)'                                                00460000
&MACP10  SETC  '&VAL(10)'                                               00470000
.MEND    MEND  ,                                                        00480000
./ ADD NAME=MACMAPHD
         MACRO                                                          00010000
&NM    MACMAPHD &OP1,&DSECT=,&PFX=,&SFX=,&DFLT=,&NULL=SKIP      GP03144 00020000
         LCLC  &FOOF                                                    00030000
.*--------------------------------------------------------------------* 00040000
.*  MACMAPHD IS USED AS AN INNER MACRO TO DEFINE DS/DSECT/CSECT       * 00050000
.*  FOR CONTROL BLOCK MAPPINGS                                        * 00060000
.*                                                                    * 00070000
.*  &NM IS THE (OPTIONAL) BLOCK NAME                                  * 00080000
.*  &OP1 IS AN ALTERNATE NAME WHEN &NM IS VOID                        * 00090000
.*  &DFLT IS A DEFAULT NAME WHEN BOTH &NM AND &OP1 ARE OMITTED        * 00100000
.*    WHEN BOTH ARE VOID, AND DSECT= IS VOID, AND NULL=SKIP, THEN     * 00110000
.*    NOTHING IS EXPANDED                                             * 00120000
.*                                                                    * 00130000
.*  &PFX AND &SFX DEFINE AN OPTIONAL PREFIX AND SUFFIX THAT WILL BE   * 00140000
.*    APPLIED TO ALL NAMES EXCEPT &NM                                 * 00150000
.*                                                                    * 00160000
.*  &DSECT - WHEN VOID OR =YES, GENERATES DSECT                       * 00170000
.*    WHEN =NO, EXPANDS DS 0D (UNLESS ALL LABELS VOID AND NULL-SKIP)  * 00180000
.*    OTHERWISE USED AS IS (FOR RSECT AND CSECT)                      * 00190000
.*--------------------------------------------------------------------* 00200000
         LCLC  &LBL          EXPANDED NAME FIELD                        00210000
         LCLB  &DS,&LBF                                                 00220000
         LCLC  &OPCD         DSECT, DS, OR ?                            00230000
         LCLC  &OPER         MATCHING OPERAND (, OR 0D)                 00240000
         AIF   ('&NM' EQ '').NONAME                                     00250000
&LBF     SETB  1             USER SUPPLIED LABEL                        00260000
&LBL     SETC  '&NM'                                                    00270000
         AGO   .TYPETST                                                 00280000
.NONAME  AIF   ('&OP1' EQ '').NOALTNM                                   00290000
&LBF     SETB  1             USER SUPPLIED LABEL                        00300000
&LBL     SETC  '&PFX'.'&OP1'.'&SFX'                                     00310000
         AGO   .TYPETST                                                 00320000
.NOALTNM AIF   ('&DFLT' NE '').GOODFLT                                  00330000
&FOOF    SETC  '&SYSNDX'                                                00340000
&LBL     SETC  '&PFX'.'MAP'.'&FOOF'.'&SFX'                              00350000
         AIF   ('&DSECT' NE 'NO' AND '&DSECT' NE 'DS').NODFLT           00360000
         AIF   (NOT &LBF AND '&NULL' EQ 'SKIP').MEND                    00370000
.NODFLT  MNOTE 4,'MACMAPHD: LABEL, OPERAND, AND DFLT ALL VOID'          00380000
         AGO   .TYPETST                                                 00390000
.GOODFLT ANOP  ,                                                        00400000
&LBL     SETC  '&PFX'.'&DFLT'.'&SFX'                                    00410000
.TYPETST AIF   ('&DSECT' NE 'NO' AND '&DSECT' NE 'DS').NOTDS            00420000
         AIF   (NOT &LBF AND '&NULL' EQ 'SKIP').MEND                    00430000
&OPCD    SETC  'DS'                                                     00440000
&OPER    SETC  '0D'                                                     00450000
         AGO   .EXPAND                                                  00460000
.NOTDS   AIF   ('&DSECT' NE ''   AND '&DSECT' NE 'YES').NOTDSY          00470000
&OPCD    SETC  'DSECT'                                                  00480000
&OPER    SETC  ','                                                      00490000
         AGO   .EXPAND                                                  00500000
.NOTDSY  ANOP  ,                                                        00510000
&OPCD    SETC  '&DSECT'                                                 00520000
&OPER    SETC  ','                                                      00530000
.EXPAND  ANOP  ,                                                        00540000
&LBL     &OPCD &OPER                                                    00550000
.MEND    MEND  ,                                                        00560000
./ ADD NAME=MACPARM
         MACRO                                                          00010000
&NM    MACPARM &OP1,         FIRST OPERAND (USUALLY R1 FOR LA/LR)      *00020000
               &OP2,         SECOND OPERAND (R2/B2D2 OR R3 IF MODE=3   *00030000
               &OP3,         THIRD OPERAND (B2D2 WHEN MODE=3)          *00040000
               &OP4,         FOURTH OPERAND  (WHEN MODE=4)             *00050000
               &OP=LA,       OPCODE WHEN OP2 IS NOT A REGISTER         *00060000
               &OPM=,        OPCODE WHEN OP2 IS NEGATED AND NOT REG.   *00070000
               &OPR=LR,      OPCODE WHEN OP2 IS REGISTER               *00080000
               &OPMR=LCR,    OPCODE WHEN OP2 IS NEGATED REGISTER       *00090000
               &QUOTE=,      OPCODE FOR QUOTED STRING/EXPLICIT LEN     *00100000
               &MODE=,       ONE/THREE/REV/EQU/EVEN                    *00110000
               &NAME=,       OUTER MACRO FOR MNOTES                    *00120000
               &OMIT=NO,     SKIP COMPLETELY IF BLANK                  *00130000
               &NULL=  SKIP, YES, OR OPERAND TO USE FOR NULL &OP2       00140000
.*                                                              GP00196 00150000
.*   THIS IS AN INNER MACRO USED TO CONVERT MACRO PARAMETERS TO         00160000
.*     INSTRUCTIONS APPROPRIATE TO THE OPERAND TYPE.                    00170000
.*                                                                      00180000
.*   THIS MACRO WAS SUGGESTED BY A MUCH OLDER VERSION (LODE/LODESTAR)   00190000
.*     BY SEYMOUR (SHMUEL) J. METZ THAT HANDLED TWO OPERANDS ONLY.      00200000
.*     NONE OF THE ORIGINAL CODE IS USED HEREIN.                        00210000
.*                                                                      00220000
.*   WITH DEFAULTS, IT EXPANDS:                                         00230000
.*    MACPARM R5,WORD      AS   LA R5,WORD                              00240000
.*    MACPARM R5,(R5)      AS   NOTHING (LABEL IS SAVED IN MACPLAB)     00250000
.*    MACPARM R5,(R4)      AS   LR R5,R4                                00260000
.*                                                                      00270000
.*   IN ORDER TO BE RECOGNIZED AS MATCHING, REGISTER SPECIFICATIONS     00280000
.*    SHOULD BE MADE IN ABSOLUTE FORM (0)-(15), OR MNEMONIC (R0)-(R15). 00290000
.*    OP1 NORMALLY DOES NOT NEED THE PARENTHESES.                       00300000
.*                                                                      00310000
.*   TO AVOID CONFLICTS WITH REGISTER SPECIFICATIONS, EXPRESSIONS MUST  00320000
.*    EITHER BEGIN WITHOUT A PARENTHESIS, OR WITH TWO: ((B-A)/(C-A))    00330000
.*                                                                      00340000
.*    OP2 PARAMETER IS AN EXPRESSION OR (REG)                           00350000
.*       EITHER FORM MAY BE PREFIXED BY A MINUS SIGN                    00360000
.*       LA REQUESTS MAY BE PREFIXED BY / TO USE L =A(OP2)              00370000
.*       LA REQUESTS MAY BE PREFIXED BY * TO USE L ,OP2                 00380000
.*       FOR A NEGATED SECOND OPERAND, THE EXPANSION WILL USE           00390000
.*       &OPMR FOR REGISTER, &OPM IF SPECIFIED, OR &OP/LNR              00400000
.*    MODE=REV      FOR &OPR, REVERSE REGISTERS                         00410000
.*    MODE=EQU      IF FIRST=SECOND OPERAND, EXPAND ANYWAY              00420000
.*    MODE=NONE     EXPAND OP= ONLY; EITHER NO OPERAND OR OPT.  GP03144 00430000
.*                    OPERAND. (MAY BE ENCLOSED IN QUOTES)      GP03144 00440000
.*    MODE=ONE      SINGLE OPERAND (E.G., BX, BXR TYPE)                 00450000
.*    MODE=THREE    THREE OPERAND TYPE; EXPANDS &OP &OP1,&OP2,&OP3      00460000
.*    MODE=FOUR     FOUR OPERAND TYPE; EXPANDS &OP &OP1,&OP2,&OP3,&OP4  00470000
.*    MODE=EVEN     EXPAND (TWO OPERAND FORM) EVEN WHEN SAME    GP01028 00480000
.*    MODE=LBL      NO OPERANDS - EXPANDS PENDING LABEL(S)              00490000
.*                    OPERAND 1 - OPTIONAL ALIGNMENT (E.G., 0F) GP03144 00500000
.*    NULL=         OMITTED PARM CAUSES ASSEMBLY ERROR (?)              00510000
.*    NULL=YES      NULL FINAL PARAMETER EXPANDS WITHOUT PARM           00520000
.*    NULL=TERM     EXPANSION USES SUPPLIED TERM IF PARM=NULL           00530000
.*    NULL=SKIP     NULL FINAL PARAMETER SKIPS EXPANSION                00540000
.*    NAME=         (OPTIONAL) NAME OF OUTER MACRO FOR MNOTES           00550000
.*                                                                      00560000
.*    QUOTE=(LA,8)  TURNS  'TEXT' INTO   LA RX,=CL(8)'TEXT' (MODE 2)    00570000
.*                                                                      00580000
         GBLC  &MACPLAB,&MACPSIZ,&MACQSTR                       GP08090 00590000
         GBLB  &MACPERR,&MACPNUL,&MVS,&MVSXA,&MVSESA            GP00196 00600000
         GBLB  &MACQUOT                                         GP08090 00610000
         GBLA  &MACPLEN                                         GP08090 00620000
         LCLA  &K,&I,&J                                         GP08090 00630000
         LCLB  &MINUS,&MOD0,&MOD1,&MOD3,&MOD4,&MODQ,&MODR,&MODV         00640000
         LCLB  &FGR1,&FGR2   ON WITH REGISTER OPERAND                   00650000
         LCLC  &FD1,&FD2,&FD3,&FD4,&LBL,&OPRR,&MNONM,&OPLA,&L   GP08090 00660000
         AIF   ('&OMIT' EQ '').NO  SKIP COMPLETELY IF NULL      GP06277 00670000
&MNONM   SETC  'MACPARM:'                                               00680000
&MACPERR SETB  0             RESET RETURN FLAG                  GP00196 00690000
&MACPNUL SETB  0             RESET RETURN FLAG                  GP00196 00700000
&OPLA    SETC  '&OP'         MAY NEED UPDATING                  GP08090 00710000
&MACPSIZ SETC  ''                                               GP08090 00720000
         AIF   ('&NM' EQ '').NONAME                                     00730000
&MNONM   SETC  '&NAME'.'/MACPARM:'                                      00740000
.NONAME  ANOP  ,                                                        00750000
&MOD0    SETB  ('&MODE' EQ 'NONE' OR '&MODE' EQ '0')            GP03144 00760000
&MOD1    SETB  ('&MODE' EQ 'ONE' OR '&MODE' EQ '1')                     00770000
&MOD3    SETB  ('&MODE' EQ 'THREE' OR '&MODE' EQ '3')                   00780000
&MOD4    SETB  ('&MODE' EQ 'FOUR' OR '&MODE' EQ '4')            GP00196 00790000
&MODQ    SETB  ('&MODE' EQ 'EQU' OR '&MODE' EQ 'EQUAL')                 00800000
&MODR    SETB  ('&MODE' EQ 'REV' OR '&MODE' EQ 'REVERSE')               00810000
&MODV    SETB  ('&MODE' EQ 'EVEN' OR '&MODE' EQ 'SAME')         GP01028 00820000
.*                                                                      00830000
.*  TEST FOR UNUSED LABEL EXPANSION ONLY                                00840000
.*                                                                      00850000
&LBL     SETC  '&NM'         INDICATE LOCAL LABEL UNUSED                00860000
         AIF   ('&MODE' NE 'LBL' AND '&MODE' NE 'LABEL').NOTLBL         00870000
&FD1     SETC  '&OP1(1)'     ALLOW USER TO SPECIFY ALIGNMENT    GP03144 00880000
         AIF   ('&FD1' NE '').XAV                               GP03144 00890000
&FD1     SETC  '0H'          DEFAULT ALIGNMENT                  GP03144 00900000
.XAV     AIF   ('&MACPLAB' EQ '').XNM                                   00910000
         AIF   ('&MACPLAB' EQ '&LBL').X1LBL                             00920000
&MACPLAB DS    &FD1                                             GP03144 00930000
.X1LBL   ANOP  ,                                                        00940000
&MACPLAB SETC  ''                                                       00950000
.XNM     AIF   ('&LBL' EQ '').XNOP                                      00960000
&NM      DS    &FD1                                             GP03144 00970000
&LBL     SETC  ''            LOCAL LABEL EXPANDED                       00980000
.XNOP    AIF   (T'&OP2 EQ 'O' AND T'&OP3 EQ 'O'                        *00990000
               AND T'&OP4 EQ 'O').MEXIT                                 01000000
         MNOTE 4,'&MNONM POSITIONAL PARAMETERS IGNORED'                 01010000
&MACPERR SETB  1             RETURN ERROR                       GP00196 01020000
.MEXIT   MEXIT ,                                                        01030000
.*                                                                      01040000
.*  TEST FOR CORRECT MODE OPERAND                                       01050000
.*                                                                      01060000
.NOTLBL  AIF   ('&MODE' EQ '' OR &MOD0 OR &MOD1 OR &MOD3 OR &MODQ      *01070000
               OR &MODR OR &MODV).MODG                          GP03144 01080000
         MNOTE 8,'&MNONM INVALID MODE=&MODE '                           01090000
&MACPERR SETB  1             RETURN ERROR                       GP00196 01100000
.*                                                                      01110000
.*  CHECK LOCAL VS. GLOBAL LABEL, EXPAND GLOBAL AND RELOAD              01120000
.*                                                                      01130000
.MODG    AIF   ('&MACPLAB' EQ '' OR '&LBL' EQ '').N2LBL                 01140000
&MACPLAB DS    0H                                                       01150000
         AGO   .PROPLBL      PROPAGATE LOCAL LABEL                      01160000
.N2LBL   AIF   ('&MACPLAB' NE '').NOLAB                                 01170000
.PROPLBL ANOP  ,                                                        01180000
&MACPLAB SETC  '&LBL'        NO GLOBAL LABEL - USE LOCAL                01190000
&LBL     SETC  ''                                                       01200000
.*                                                                      01210000
.*  TEST FOR CORRECT NUMBER OF PARAMETERS, AND SUBSTITUTE &NULL         01220000
.*                                                                      01230000
.NOLAB   AIF   (NOT &MOD0).NOTNONE   OPCODE ONLY ?              GP03144 01240000
&FD1     SETC  '&OP1'                                           GP03144 01250000
         AIF   ('&FD1' EQ '').DONONE                            GP03144 01260000
         AIF   ('&FD1'(1,1) NE '"').DONONE                      GP03144 01270000
&FD1     SETC  '&FD1'(2,K'&FD1-2)                               GP03144 01280000
.DONONE  ANOP  ,                                                GP03144 01290000
&MACPLAB &OP   &FD1                                             GP03144 01300000
         AIF   (T'&OP2 EQ 'O' AND T'&OP3 EQ 'O'                        *01310000
               AND T'&OP4 EQ 'O').GO                            GP03144 01320000
         MNOTE 4,'&MNONM POSITIONAL PARAMETERS IGNORED'         GP03144 01330000
&MACPERR SETB  1             RETURN ERROR                       GP03144 01340000
         AGO   .GO                                              GP03144 01350000
.NOTNONE ANOP  ,                                                        01360000
&FD1     SETC  '&OP1'                                                   01370000
&FD2     SETC  '&OP2'                                                   01380000
&FD3     SETC  '&OP3'                                                   01390000
&FD4     SETC  '&OP4'                                           GP00196 01400000
         AIF   (T'&OP1 NE 'O').HAVE1                                    01410000
&MACPNUL SETB  1             RETURN NULL FLAG                   GP00196 01420000
         AIF   (NOT &MOD1).NOTONE                                       01430000
         AIF   ('&NULL' EQ '').NOTONE                                   01440000
         AIF   ('&NULL' EQ 'YES').HAVE1  NOTHING ELSE TO DO     GP01009 01450000
         AIF   ('&NULL' EQ 'SKIP').MEXIT  SKIP OUT WITHOUT      GP01009 01460000
&FD1     SETC  '&NULL'                                                  01470000
         AGO   .HAVE1                                                   01480000
.NOTONE  MNOTE 8,'&MNONM FIRST POSITIONAL OPERAND REQUIRED'             01490000
&MACPERR SETB  1             RETURN ERROR                       GP00196 01500000
         AGO   .MEXIT                                                   01510000
.HAVE1   AIF   (&MOD1).HAVEALL                                          01520000
         AIF   (T'&OP2 NE 'O').HAVE2                                    01530000
&MACPNUL SETB  1             RETURN NULL FLAG                   GP00196 01540000
         AIF   (&MOD3).NOTTWO                                           01550000
         AIF   ('&NULL' EQ '').NOTTWO                                   01560000
         AIF   ('&NULL' EQ 'YES').HAVE2  NOTHING ELSE TO DO     GP01009 01570000
         AIF   ('&NULL' EQ 'SKIP').MEXIT  SKIP OUT WITHOUT      GP01009 01580000
&FD2     SETC  '&NULL'                                                  01590000
         AGO   .HAVE2                                                   01600000
.NOTTWO  MNOTE 8,'&MNONM SECOND POSITIONAL OPERAND REQUIRED'            01610000
&MACPERR SETB  1             RETURN ERROR                       GP00196 01620000
         AGO   .MEXIT                                                   01630000
.HAVE2   AIF   (NOT &MOD3).HAVE3                                GP00196 01640000
         AIF   (T'&OP3 NE 'O').HAVE3                            GP00196 01650000
&MACPNUL SETB  1             RETURN NULL FLAG                   GP00196 01660000
         AIF   ('&NULL' EQ '').NOTHREE                                  01670000
         AIF   ('&NULL' EQ 'YES').HAVEALL  NOTHING ELSE TO DO   GP01009 01680000
         AIF   ('&NULL' EQ 'SKIP').MEXIT  SKIP OUT WITHOUT      GP01009 01690000
&FD3     SETC  '&NULL'                                                  01700000
         AGO   .HAVEALL                                                 01710000
.NOTHREE MNOTE 8,'&MNONM THIRD POSITIONAL OPERAND REQUIRED'             01720000
&MACPERR SETB  1             RETURN ERROR                       GP00196 01730000
         AGO   .MEXIT                                                   01740000
.HAVE3   AIF   (NOT &MOD4).HAVEALL                              GP00196 01750000
         AIF   (T'&OP4 NE 'O').HAVEALL                          GP00196 01760000
&MACPNUL SETB  1             RETURN NULL FLAG                   GP00196 01770000
         AIF   ('&NULL' EQ '').NOFOUR                           GP00196 01780000
         AIF   ('&NULL' EQ 'YES').HAVEALL  NOTHING ELSE TO DO   GP01009 01790000
         AIF   ('&NULL' EQ 'SKIP').MEXIT  SKIP OUT WITHOUT      GP01009 01800000
&FD4     SETC  '&NULL'                                          GP00196 01810000
         AGO   .HAVEALL                                         GP00196 01820000
.NOFOUR  MNOTE 8,'&MNONM FOURTH POSITIONAL OPERAND REQUIRED'    GP03207 01830000
&MACPERR SETB  1             RETURN ERROR                       GP00196 01840000
         AGO   .MEXIT                                           GP00196 01850000
.*                                                                      01860000
.*  CHANGE OP1 AND OP2 (UNLESS MOD1 OR MOD3) TO PREFERRED FORM          01870000
.*    IF MODE 3, GO TO EXPAND IT                                        01880000
.*                                                                      01890000
.HAVEALL AIF   (&MOD3).DO3   SIMPLE EXPANSION OF THREE OPERANDS         01900000
         AIF   (&MOD4).DO4   SIMPLE EXPANSION OF FOUR OPERANDS  GP00196 01910000
         AIF   (NOT &MOD1).CLNOP1                                       01920000
&K       SETA  K'&FD1                                                   01930000
         AIF   (&K LT 2 OR '&FD1'(1,1) NE '-').CLNOP1                   01940000
&MINUS   SETB  1                                                        01950000
&FD1     SETC  '&FD1'(2,&K-1)                                           01960000
&K       SETA  K'&FD1                                                   01970000
.CLNOP1  ANOP  ,                                                        01980000
         AIF   (&K LT 3).NORG1                                          01990000
         AIF   ('&FD1'(1,1) NE '(' OR '&FD1'(&K,1) NE ')').NORG1        02000000
         AIF   ('&FD1'(2,1) EQ '(').NOSY1        ((EXPRESSION)) ?       02010000
&FGR1    SETB  1             FLAG OP1 AS REGISTER EXPRESSION            02020000
&FD1     SETC  '&FD1'(2,&K-2)                                           02030000
&K       SETA  K'&FD1                                                   02040000
.*  LOOK FOR SINGLE OR DOUBLE DIGIT - PREFIX BY R                       02050000
.NORG1   AIF   (&K LT 1 OR &K GT 2).NOSY1                               02060000
         AIF   ('&FD1'(1,1) LT '0').NOSY1  LEAVE IF NOT NUMERIC         02070000
&FD1     SETC  'R'.'&FD1'    MAKE SYMBOLIC REGISTER                     02080000
.*                                                                      02090000
.*  HAVE OP1 CLEANED FROM (N) TO RN; GO TO EXPAND MODE 1                02100000
.*    ELSE TEST AND CLEAN OPERAND 2                                     02110000
.*                                                                      02120000
.NOSY1   AIF   (&MOD1).DO1                                              02130000
&K       SETA  K'&FD2                                                   02140000
&OPRR    SETC  '&OPR'                                                   02150000
         AIF   (&K LT 2 OR '&FD2'(1,1) NE '-').NONEG2                   02160000
&MINUS   SETB  1                                                        02170000
&FD2     SETC  '&FD2'(2,&K-1)                                           02180000
&K       SETA  K'&FD2                                                   02190000
&OPRR    SETC  '&OPMR'                                                  02200000
.NONEG2  AIF   (&K LT 3).NORG2                                          02210000
         AIF   ('&FD2'(1,1) NE '''' OR T'&QUOTE EQ 'O').NOQUO2  GP08090 02220000
         AIF   ('&FD2'(&K,1) NE '''').NOQUO2                    GP08090 02230000
         MACQOLIT &FD2,LEN=&QUOTE(2)                            GP08090 02240000
         AIF   (&MACPERR OR &MACPNUL).NOQUO2                    GP08090 02250000
&FD2     SETC  '&MACQSTR'                                       GP08090 02260000
&MACPSIZ SETC  '&MACPLEN'    RETURN LENGTH                      GP08090 02270000
         AIF   ('&QUOTE(1)' EQ '').LOPP                         GP08090 02280000
&OPLA    SETC  '&QUOTE(1)'                                      GP08090 02290000
         AGO   .LOPP                                            GP08090 02300000
.NOQUO2  AIF   ('&FD2'(1,1) NE '(' OR '&FD2'(&K,1) NE ')').NORG2        02310000
         AIF   ('&FD2'(2,1) EQ '(').NORG2        ((EXPRESSION)) ?       02320000
&FD2     SETC  '&FD2'(2,&K-2)                                           02330000
&K       SETA  K'&FD2                                                   02340000
&FGR2    SETB  1             FLAG OP1 AS REGISTER EXPRESSION            02350000
         AIF   ('&FD2'(1,1) LT '0').NOSY2  LEAVE IF NOT NUMERIC         02360000
         AIF   (&K LT 1 OR &K GT 2).NOSY2                               02370000
&FD2     SETC  'R'.'&FD2'    MAKE SYMBOLIC REGISTER                     02380000
.*                                                                      02390000
.*  REG: CHECK FOR NEG PREFIX, MODE=EQU, ELSE IF OP1=OP2, NO EXPANSION  02400000
.*                                                                      02410000
.NOSY2   AIF   ('&FD2' NE '&FD1' OR &MINUS OR &MODV).LR         GP01028 02420000
         AIF   (NOT &MODQ).NO                                           02430000
.LR      AIF   (NOT &MODR).NOREV                                        02440000
&MACPLAB &OPRR &FD2,&FD1                                                02450000
         AGO   .GO                                                      02460000
.*                                                                      02470000
.*  REG: NORMAL FORM, (EXPANDS MINUS, ALSO - OPR OR OPMR IN OPRR)       02480000
.*                                                                      02490000
.NOREV   ANOP  ,                                                        02500000
&MACPLAB &OPRR &FD1,&FD2                                                02510000
         AGO   .GO                                                      02520000
.*                                                                      02530000
.*  NOT REG: CHECK FOR LA AND SPECIAL CASES                             02540000
.*                                                                      02550000
.NORG2   ANOP  ,                                                GP08090 02560000
&MACPSIZ SETC  '&L'.'&FD2'   RETURN LENGTH FOR USUAL CASE       GP08090 02570000
         AIF   ('&OPLA' EQ 'LA' AND '&FD2' EQ '0').SR                   02580000
         AIF   ('&OPM' NE '' AND &MINUS).OPM                            02590000
.*                                                                      02600000
.*  LA OP1,/OP2   GENERATES L OP1,=A(OP2)                               02610000
.*                                                                      02620000
         AIF   ('&OPLA' NE 'LA' OR '&FD2'(1,1) NE '/').LOP              02630000
&FD2     SETC  '&FD2'(2,K'&FD2-1)                                       02640000
&MACPLAB L     &FD1,=A(&FD2)                                            02650000
         AGO   .LOPCO                                                   02660000
.*                                                                      02670000
.*  LA OP1,*OP2   GENERATES L OP1,OP2                                   02680000
.*                                                                      02690000
.LOP     AIF   ('&OPLA' NE 'LA' OR '&FD2'(1,1) NE '*').LOPP             02700000
         AIF   (K'&FD2 EQ 1).LOPP                                       02710000
&FD2     SETC  '&FD2'(2,K'&FD2-1)                                       02720000
&MACPLAB L     &FD1,&FD2                                                02730000
         AGO   .LOPCO                                                   02740000
.LOPP    ANOP  ,                                                        02750000
&MACPLAB &OPLA &FD1,&FD2                                                02760000
.LOPCO   AIF   (NOT &MINUS).GO                                          02770000
         &OPMR &FD1,&FD1                                                02780000
         AGO   .GO                                                      02790000
.*                                                                      02800000
.*  USER SPECIFIED OPM AND -OP2                                         02810000
.*                                                                      02820000
.OPM     ANOP  ,                                                        02830000
&MACPLAB &OPM  &FD1,&FD2                                                02840000
         AGO   .GO                                                      02850000
.*                                                                      02860000
.*  SINGLE OPERAND INSTRUCTION - EXPAND, CHECK FOR -OP1                 02870000
.*                                                                      02880000
.DO1     AIF   (&FGR1).DO1REG                                           02890000
         AIF   ('&OPM' NE '' AND &MINUS).DO1NEG                         02900000
&MACPLAB &OP   &FD1                                                     02910000
         AIF   (NOT &MINUS).GO                                          02920000
         &OPMR &FD1                                                     02930000
         AGO   .GO                                                      02940000
.DO1NEG  ANOP  ,                                                        02950000
&MACPLAB &OPM  &FD1                                                     02960000
         AGO   .GO                                                      02970000
.DO1REG  AIF   (&MINUS).DO1MIN                                          02980000
&MACPLAB &OPR  &FD1                                                     02990000
         AGO   .GO                                                      03000000
.DO1MIN  ANOP  ,                                                        03010000
&MACPLAB &OPMR &FD1                                                     03020000
         AGO   .GO                                                      03030000
.*                                                                      03040000
.*  EXPAND THREE OPERAND INSTRUCTIONS - NO SPECIAL CHECKING             03050000
.*                                                                      03060000
.DO3     ANOP  ,                                                        03070000
&MACPLAB &OPLA &FD1,&FD2,&FD3                                           03080000
         AGO   .GO                                                      03090000
.*                                                              GP00196 03100000
.*  EXPAND FOUR OPERAND INSTRUCTIONS - NO SPECIAL CHECKING      GP00196 03110000
.*                                                              GP00196 03120000
.DO4     ANOP  ,                                                GP00196 03130000
&MACPLAB &OPLA &FD1,&FD2,&FD3,&FD4                              GP00196 03140000
         AGO   .GO                                              GP00196 03150000
.*                                                                      03160000
.*  ON SOME OLD MACHINES LA,0 WAS SLOWER AND LONGER. RETAIN SR ?        03170000
.*                                                                      03180000
.SR      ANOP                                                           03190000
&MACPLAB SR    &FD1,&FD1                                                03200000
.*                                                                      03210000
.*  INSTRUCTION(S) EXPANDED; CLEAR LABEL                                03220000
.*                                                                      03230000
.GO      ANOP  ,                                                        03240000
&MACPLAB SETC  ''                                                       03250000
.*                                                                      03260000
.*  NOTHING EXPANDED - MAINTAIN LABELS                                  03270000
.*                                                                      03280000
.NO      MEND  ,                                                        03290000
./ ADD NAME=MACPLOP
         MACRO ,                                                        00010000
&NM      MACPLOP &FROM,&TO,&NULL=,&OP=ST                                00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*  MACPLOP IS AN INNER MACRO (PART OF THE MACPARM GROUP) FOR         * 00050000
.*  PROCESSING USER SUPPLIED VALUES FOR AN MF=E/S PARAMETER LIST.     * 00060000
.*                                                                    * 00070000
.*  1) &FROM IS (R) - GENERATE SIMPLE STORE                           * 00080000
.*  2) &FROM IS QUOTED STRING - GENERATE LA/ST                        * 00090000
.*  3) OTHER - LA/ST                                                  * 00100000
.*                                                                    * 00110000
.********************************************************************** 00120000
         LCLC  &V                                                       00130000
         LCLA  &K                                                       00140000
&V       SETC  '&FROM'                                                  00150000
         AIF   ('&V' NE '').TEST                                        00160000
&V       SETC  '&NULL'                                                  00170000
         AIF   ('&V' NE 'YES').FSKIP                                    00180000
&V       SETC  '0'                                                      00190000
.FSKIP   AIF   ('&V' EQ 'SKIP').MEND   SKIP IF OMITTED OK               00200000
         AIF   ('&V' NE '').TEST                                        00210000
 MNOTE 8,'MACPLOP: SOURCE ADDRESS REQUIRED'                             00220000
         MEXIT ,                                                        00230000
.TEST    AIF   ('&TO' NE '').BOTH                                       00250000
 MNOTE 8,'MACPLOP: DESTINATION ADDRESS REQUIRED'                        00260000
         MEXIT ,                                                        00270000
.BOTH    AIF   ('&V'(1,1) EQ '''').QUOTE                                00280000
&K       SETA  K'&V                                                     00290000
         AIF   (&K LT 3).NORMAL                                         00300000
         AIF   ('&V'(1,1) NE '(' OR '&V'(2,1) EQ '(').NORMAL            00310000
         AIF   ('&V'(&K,1) NE ')' OR '&V'(&K-1,1) EQ ')').NORMAL        00320000
&NM      MACPARM &V,&TO,OP=ST,OPR=ST,MODE=EVEN                          00330000
         MEXIT ,                                                        00340000
.NORMAL  ANOP  ,                                                        00350000
&NM      MACPARM R0,&V,OP=LA                                            00360000
         AGO   .ST                                                      00370000
.QUOTE   ANOP  ,                                                        00380000
&NM      MACPARM R0,=C&V                                                00390000
.ST      MACPARM R0,&TO,OP=&OP                                          00400000
.MEND    MEND  ,                                                        00410000
./ ADD NAME=MACQOLIT
         MACRO ,                                                        00010000
       MACQOLIT &STR,&LEN=   DETERMINE LENGTH OF STRING; MAKE QUOTED    00020000
.*                                                                      00030000
.*   INNER MACRO FOR MACRO PROCESSING                                   00040000
.*       MACQOLIT &STR  WHERE &STR IS UNQUOTED, QUOTED, OR CONSTANT     00050000
.*                 FORMAT (E.G.,  XYZ, 'text', X'12AB', CL8'HI', =C'A') 00060000
.*   RETURNS:                                                           00070000
.*       MACPNUL   FOR OMITTED PARAMETER OR EMPTY STRING ('')           00080000
.*       MACQUOT=0  IF UNQUOTED; &STR IN MACQSTR, K'&STR IN MACPLEN     00090000
.*       MACQUOT=1  =CLnn'text' OR =X'hex' - LITERAL FORMAT             00100000
.*                                                                      00110000
         GBLA  &MACPLEN      RETURN SIGNIFICANT LENGTH OF STRING        00120000
         GBLB  &MACPNUL      TRUE IF NULL STRING                        00130000
         GBLB  &MACQUOT      TRUE IF ORIGINAL WAS QUOTED                00140000
         GBLB  &MACPERR      TRUE IF ERROR                              00150000
         GBLC  &MACQSTR      RETURN QUOTED STRING                       00160000
         LCLA  &I,&J,&K,&L                                              00170000
         LCLC  &C,&D,&TYPE                                              00180000
.*                                                                      00190000
&MACQUOT SETB  0             SET UNQUOTED                               00200000
&MACPERR SETB  0             SET NOT IN ERROR                           00210000
&MACPLEN SETA  K'&STR        SET PROVISIONAL LENGTH                     00220000
&MACQSTR SETC  '&STR'        DEFAULT - RETURN AS IS                     00230000
&TYPE    SETC  'C'           SET STRING TYPE (C OR X) DEFAULT           00240000
.*  RETURN IF STRING IS NULL                                            00250000
&MACPNUL SETB  (T'&STR EQ 'O')                                          00260000
&MACPNUL SETB  (&MACPNUL OR ('&STR' EQ ''''''))                         00270000
         AIF   (&MACPNUL).MEND   DONE IF NULL STRING                    00280000
.*  RETURN IF STRING IS UNQUOTED                                        00290000
         AIF   (&MACPLEN LT 2).SHORT                                    00300000
&MACQUOT SETB  ('&STR'(1,1) EQ '''' OR '&STR'(&MACPLEN,1) EQ '''')      00310000
.SHORT   AIF   (NOT &MACQUOT).MEND                                      00320000
.*  DELETE LITERAL'S EQUAL SIGN IF PRESENT                              00330000
         AIF   ('&STR'(1,1) NE '=').NOTEQU                              00340000
&MACQSTR SETC  '&MACQSTR'(2,&MACPLEN)  STRIP EQUAL                      00350000
&MACPLEN SETA  K'&MACQSTR              UPDATE LENGTH                    00360000
.*  LOOK FOR LEADING QUOTE, C OR X - FAIL REST                          00370000
.NOTEQU  ANOP  ,                                                        00380000
&C       SETC  '&MACQSTR'(1,1)         ISOLATE FIRST BYTE               00390000
&MACPERR SETB  ('&C' NE '''' AND '&C' NE 'C' AND '&C' NE 'X')           00400000
         AIF   (&MACPERR).ERROR                                         00410000
.*  LOOK FOR LEADING QUOTE, C OR X - FAIL REST                          00420000
.STRING  AIF   ('&C' EQ '''').COUNT                                     00430000
&TYPE    SETC  '&C'                    REMEMBER THE TYPE                00440000
&MACQSTR SETC  '&MACQSTR'(2,K'&MACQSTR)  STRIP TYPE                     00450000
&MACPLEN SETA  K'&MACQSTR              UPDATE LENGTH                    00460000
&C       SETC  '&MACQSTR'(1,1)         ISOLATE FIRST BYTE               00470000
&MACPERR SETB  ('&C' NE '''' AND '&C' NE 'L')                           00480000
         AIF   (&MACPERR).ERROR                                         00490000
.*  LOOK FOR LEADING QUOTE OR L  (I.E., WE WANT 'text' OR CLn'text')    00500000
         AIF   ('&C' EQ '''').COUNT    COUNT LENGTH                     00510000
&L       SETA  0                       NO LENGTH YET                    00520000
.EXPLOOP ANOP  ,                                                        00530000
&MACQSTR SETC  '&MACQSTR'(2,K'&MACQSTR)  STRIP TYPE                     00540000
&MACPLEN SETA  K'&MACQSTR              UPDATE LENGTH                    00550000
&C       SETC  '&MACQSTR'(1,1)         ISOLATE FIRST BYTE               00560000
         AIF   ('&C' EQ '''').HAVEXPL  DONE WITH EXPLICIT LENGTH        00570000
         AIF   ('&C' LT '0' OR '&C' GT '9').ERROR                       00580000
&L       SETA  &L*10+&C                UPDATE LENGTH                    00590000
         AGO   .EXPLOOP                TRY ONE MORE                     00600000
.*   MACQSTR NOW HAS QUOTED STRING, AND L HAS THE LENGTH                00610000
.HAVEXPL ANOP  ,                                                        00620000
&MACPLEN SETA  &L                      RETURN THE LENGTH                00630000
&MACQSTR SETC  '='.'&TYPE'.'L'.'&L'.'&MACQSTR'                          00640000
         MEXIT ,                                                        00650000
.ERROR   ANOP  ,                                                        00660000
&MACPERR SETB  1                       RETURN AN ERROR                  00670000
         MEXIT ,                                                        00680000
.*   MACQSTR IS A QUOTED STRING WHOSE LENGTH WE NEED                    00690000
.*     NOTE THAT APOSTROPHES AND AMPERSANDS ARE DOUBLED (ELSE ERROR)    00700000
.COUNT   ANOP  ,                                                        00710000
&MACPLEN SETA  K'&MACQSTR              UPDATE LENGTH                    00720000
&I       SETA  1                       LOOP INDEX (2 TO K'-2)           00730000
&L       SETA  0                       SIGNIFICANT LENGTH               00740000
.CNTLOOP  ANOP ,                                                        00750000
&I       SETA  &I+1                                                     00760000
&C       SETC  '&MACQSTR'(&I,1)                                         00770000
         AIF   ('&C' NE '''' AND '&C' NE '&&').CNTONE                   00780000
         AIF   (&I GE &MACPLEN-1).ERROR                                 00790000
         AIF   ('&MACQSTR'(&I+1,1) NE '&C').ERROR    ERROR?             00800000
&I       SETA  &I+1          SKIP DOUBLED CARACTER                      00810000
.CNTONE  ANOP  ,                                                        00820000
&L       SETA  &L+1                                                     00830000
         AIF   (&I LE &MACPLEN-2).CNTLOOP                               00840000
&MACPLEN SETA  &L            SET STRIPPED LENGTH                        00850000
         AIF   ('&LEN' EQ '').DEFLN                             GP08090 00860000
&MACQSTR SETC  '='.'&TYPE'.'L('.'&LEN'.')'.'&MACQSTR'           GP08090 00870000
&MACPLEN SETA  &LEN                                             GP08090 00880000
         AGO   .MEND                                            GP08090 00890000
.DEFLN   ANOP  ,                                                GP08090 00900000
&MACQSTR SETC  '='.'&TYPE'.'&MACQSTR'                                   00910000
.MEND    MEND  ,                                                        00920000
./ ADD NAME=MACQOTER
         MACRO ,                                                        00010000
        MACQOTER  &STR,&OPT=,&USE=,&FILL=,&NULL=,&NAME=,&TYPE=C         00020000
.*-------------------------------------------------------------------*. 00030000
.*  NAME:                M A C Q O T E R                             *. 00040000
.* PURPOSE:                                                          *. 00050000
.*                                                                   *. 00060000
.*  INTERNAL MACRO TO DETERMINE IF A PARAMETER IS A QUOTED STRING    *. 00070000
.*    AND OPTIONALLY QUOTE IT OR STRIP QUOTES.                       *. 00080000
.*                                                                   *. 00090000
.*  INPUT :                                                          *. 00100000
.*    THE STRING PARAMETER                                           *. 00110000
.*                                                                   *. 00120000
.*  OUTPUT:                                                          *. 00130000
.*   MACPERR  GLOBAL FLAG TO INDICATE AN ERROR OCCURRED              *. 00140000
.*   MACQUOT  GLOBAL FLAG TO INDICATE THAT INPUT WAS A QUOTED STRING *. 00150000
.*   MACPNUL  GLOBAL FLAG TO INDICATE THAT INPUT WAS NULL            *. 00160000
.*   MACQSTR  ORIGINAL OR MODIFIED STRING                            *. 00170000
.*-------------------------------------------------------------------*. 00180000
.* KEYWORD PARAMETERS:                                               *. 00190000
.*    OPT=   USE=   FILL=   NULL=   NAME=                            *. 00200000
.*  RESERVED FOR LATER:  USE=LITERAL (CREATE =C'PARM')               *. 00210000
.*  RESERVED FOR LATER:  TYPE=G  (SPECIAL CHARACTER SET SUPPORT)     *. 00220000
.*********************************************************************. 00230000
.* POSITIONAL PARAMETERS:                                            *. 00240000
.*    THE STRING TO BE TESTED / CHANGED                              *. 00250000
.*********************************************************************. 00260000
.* EXAMPLES:                                                         *. 00270000
.*    MACQOTER HAM&EGGS,USE=HEX,OPT=QUOTE,NULL=YES,NAME=OUTER        *. 00280000
.*                                                                   *. 00290000
.* &MACQSTR  SET TO  'HAM&&EGGS'                                     *. 00300000
.* &MACQUOT  SET TO  1                                               *. 00310000
.* &MACPERR  SET TO  0                                               *. 00320000
.* &MACPNUL  SET TO  0                                               *. 00330000
.*                                                                   *. 00340000
.*********************************************************************. 00350000
.* CHANGE LOG:                                                       *. 00360000
.*                                                                   *. 00370000
.* YYYY-MM-DD INT COMMENTS                                           *. 00380000
.* ---------- --- --------                                           *. 00390000
.* 1999-03-12 GYP CREATED                                            *. 00400000
.* 2003-05-24 GYP CHANGED MACERR TO MACPERR TO MATCH MACPARM         *. 00410000
.*                                                                   *. 00420000
.*********************************************************************. 00430000
.* THIS INNER MACRO CONVERTS AN ARGUMENT STRING INTO ANOTHER ONE.    *. 00440000
.* WHEN NO CONVERT OPTIONS ARE USED, ONLY GLOBAL SETB VALUES ARE SET.*. 00450000
.*                                                                   *. 00460000
.*  OPT=QUOTE    SPECIFIES THAT A QUOTED STRING IS NEEDED            *. 00470000
.*                 WITH USE=/USE=QUOTE WILL NOT CHANGE QUOTED STRING *. 00480000
.*  USE= OR USE=QUOTE    ADD QUOTES TO STRING                        *. 00490000
.*  USE=PROC     SPECIFIES THAT QUOTES ARE DOUBLED AGAIN             *. 00500000
.*  USE=HEX      ALLOWS X'NNN', B'010101', AND SIMILAR EXPRESSIONS   *. 00510000
.*                 WITHOUT ALTERATION (OTHERS AS USE=QUOTE)          *. 00520000
.*  OPT=STRIP    HALVES THE QUOTES IN A QUOTED STRING AND UNQUOTES   *. 00530000
.*  FILL='X' OR FILL=X    REPLACES BLANKS BY THE SPECIFIED CHARACTER *. 00540000
.*                 DOES NOT SUPPORT AMPERSAND OR APOSTROPHE.         *. 00550000
.*  NULL=YES     SPECIFIES THAT AN EMPTY STRING DOES NOT SET AN      *. 00560000
.*                 ERROR; THE MACPNUL FLAG IS SET, MACPERR IS NOT.   *. 00570000
.*                 RETURNS EMPTY STRING UNLESS QUOTING, THEN ''      *. 00580000
.*                 IGNORED IF STRING IS NOT NULL. OPT=STRIP FOR ''   *. 00590000
.*                 GENERATES A NULL STRING AND SETS THE FLAGS.       *. 00600000
.*                                                                   *. 00610000
.*  TYPE=C (DEFAULT) OR TYPE=G - NOT SUPPORTED YET                   *. 00620000
.*                                                                   *. 00630000
.* REQUEST:    OPT=  OPT=QUOTE  USE=HEX  USE=PROC  OPT=STRIP RESULT  *. 00640000
.*  STRING        Y                Y                      STRING     *. 00650000
.*  'STRING'      Y                Y                      'STRING'   *. 00660000
.*  X'123'        Y                Y                      X'123'     *. 00670000
.*  STRING              Y          Y                      'STRING'   *. 00680000
.*  'STRING'            Y          Y                      'STRING'   *. 00690000
.*  X'123'              Y          Y                      X'123'     *. 00700000
.*  X'123'              Y                                 'X''123''' *. 00710000
.*  STRING              Y                   Y             ''STRING'' *. 00720000
.*  'STRING'            Y                   Y             ''STRING'' *. 00730000
.*  X'123'              Y                   Y       ''X''''123'''''' *. 00740000
.*  X'123'              Y          Y        Y             X'123'     *. 00750000
.*  'IT''S &&'                                        Y   IT'S &     *. 00760000
.*  ..ANY..    NO FLAGS ON (OTHER THAN NULL AND FILL)  SETB ONLY     *. 00770000
.*                                                                   *. 00780000
.*  (STRIP AND QUOTE CANCEL; STRIP AND PROC ACTS AS QUOTE)           *. 00790000
.*                                                                   *. 00800000
.* N.B.: STRIPPING AND DOUBLING APPLIES TO APOSTROPHES AND AMPERSANDS*. 00810000
.*********************************************************************. 00820000
.*  LIMITATIONS:  MAXIMUM INPUT LENGTH: 255 (ARBITRARY, <256)        *. 00830000
.* >>>>> DOES NOT CHECK FOR STRING LENGTH EXCESSION (>255) <<<<<     *. 00840000
.*********************************************************************. 00850000
         GBLB  &MACPNUL,&MACPERR,&MACQUOT                               00860000
         GBLC  &MACQSTR                                                 00870000
         LCLB  &DEL,&DOUB,&FOUR                                         00880000
         LCLC  &PAD,&MYSTR,&CH                                          00890000
         LCLA  &I,&J,&K,&L,&M,&N                                        00900000
&MACPERR SETB  0                                                        00910000
&MACPNUL SETB  0                                                        00920000
&MACQUOT SETB  0                                                        00930000
&MYSTR   SETC  '&STR'                                                   00940000
&MACQSTR SETC  '&STR'        PRESET AS NULL IF EMPTY                    00950000
&K       SETA  K'&STR                                                   00960000
&DEL     SETB  ('&OPT' EQ 'STRIP')                                      00970000
&DOUB    SETB  ('&OPT' EQ 'QUOTE')                                      00980000
&FOUR    SETB  ('&USE' EQ 'PROC')                                       00990000
         AIF   (&K LT 2).NOQUOCH                                        01000000
&MACQUOT SETB  ('&STR'(1,1) EQ '''' AND '&STR'(&K,1) EQ '''')           01010000
.NOQUOCH AIF   (NOT &MACQUOT).UNQUO                                     01020000
.*  ALREADY QUOTED STRING CANCELS ONE LEVEL OF QUOTING                  01030000
&DOUB    SETB  (&FOUR)                                                  01040000
&FOUR    SETB  0                                                        01050000
.UNQUO   AIF   (NOT &DEL OR (NOT &DOUB AND NOT &FOUR)).NODEL            01060000
.*  STRIP CANCELS ONE LEVEL OF QUOTING                                  01070000
&DOUB    SETB  (&FOUR)                                                  01080000
&FOUR    SETB  0                                                        01090000
&DEL     SETB  0             CANCEL STRIP REQUEST                       01100000
.NODEL   AIF   ('&NULL' EQ '' OR '&NULL' EQ 'Y' OR '&NULL' EQ 'YES').NU 01110000
         AIF   ('&NULL' EQ 'N' OR '&NULL' EQ 'NO').NU                   01120000
        MNOTE  4,'&NAME/MACQOTER *****  INVALID NULL OPTION ''&NULL'''  01130000
        MNOTE  4,'  USE NULL= (DEFAULT), OR NULL=YES'                   01140000
&MACPERR SETB  1                                                        01150000
.NU      AIF   (&K GT 0 AND &K LE 255).OKLEN                            01160000
         AIF   (&K NE 0).TOOLONG                                        01170000
&MACPNUL SETB  1                                                        01180000
         AIF   (&FOUR).DO4NU                                            01190000
         AIF   (NOT &DOUB).NO2NU                                        01200000
&MACQSTR SETC  ''''''        MAKE NULL STRING                           01210000
         AGO   .NO2NU                                                   01220000
.DO4NU   ANOP  ,                                                        01230000
&MACQSTR SETC  ''''''''''    MAKE NULL STRING                           01240000
.NO2NU   AIF   ('&NULL' EQ 'YES').TEST                                  01250000
&MACPERR SETB  1                                                        01260000
         AGO   .TEST                                                    01270000
.TOOLONG MNOTE 8,'&NAME/MACQOTER INPUT EXCEEDS DESIGN LENGTH OF 255'    01280000
&MACPERR SETB  1                                                        01290000
         MEXIT ,                                                        01300000
.OKLEN   AIF   ('&OPT' EQ '' OR '&OPT' EQ 'QUOTE' OR                   *01310000
               '&OPT' EQ 'STRIP').OKOPT                                 01320000
        MNOTE 4,'&NAME/MACQOTER  *****  INVALID STRING OPTION ''&OPT''' 01330000
        MNOTE 4,'  SUPPORTED OPTIONS ARE OPT=QUOTE AND OPT=STRIP'       01340000
&MACPERR SETB  1                                                        01350000
         MEXIT ,                                                        01360000
.OKOPT   AIF   ('&USE'  EQ ''  OR  '&USE'  EQ  'PROC'                  *01370000
                 OR  '&USE'  EQ  'HEX'  OR '&USE' EQ 'QUOTE').OKUSE     01380000
        MNOTE 4,'&NAME/MACQOTER  *****  INCORRECT USE OPTION ''&USE'''  01390000
        MNOTE 4,'  SUPPORTED OPTIONS ARE USE=HEX AND USE=PROC'          01400000
&MACPERR SETB  1                                                        01410000
         MEXIT ,                                                        01420000
.OKUSE   AIF   ('&FILL' EQ '').NOPAD                                    01430000
&J       SETA  2                                                        01440000
         AIF   (K'&FILL EQ 3 AND '&FILL'(1,1) EQ '''').PADQ             01450000
&J       SETA  1                                                        01460000
         AIF   (K'&FILL EQ 1).PADQ                                      01470000
.BADFILL MNOTE 4,'&NAME/MACQOTER  *****  INVALID FILL OPTION ''&FILL''' 01480000
         MNOTE 4,'  SPECIFY SINGLE CHARACTER WITH FILL=X OR FILL=''X''' 01490000
&MACPERR SETB  1                                                        01500000
         MEXIT ,                                                        01510000
.PADQ    ANOP                                                           01520000
&PAD     SETC  '&FILL'(&J,1)                                            01530000
.*                                                                      01540000
.*  DO CURSORY CHECK FOR X'NNN' AND B'0101', ETC. (ONLY APOSTROPHES)    01550000
.*                                                                      01560000
.NOPAD   AIF   (&MACQUOT).NOTHEX                                        01570000
         AIF   (&K LT 4).NOHEX                                          01580000
         AIF   ('&STR'(2,1) NE '''' OR '&STR'(&K,1) NE '''').NOHEX      01590000
         AIF   ('&USE' EQ 'HEX').MEND   BYPASS .TEST CHECKS (FAIL)      01600000
.*  FOR UNQUOTED STRING AND STRIP OPTION, RETURN                        01610000
.NOHEX   AIF   (&DEL).TEST                                              01620000
.NOTHEX  ANOP  ,                                                        01630000
&I       SETA  0                                                        01640000
.*                                                                      01650000
.*  WHEN CALLER SPECIFIES FILL CHARACTER, REPLACE BLANKS                01660000
.*                                                                      01670000
&MYSTR   SETC  '&STR'        USE WORKING STRING                         01680000
&K       SETA  K'&MYSTR      JUST IN CASE                               01690000
         AIF   ('&PAD' EQ '').PADDED                                    01700000
.SCANBLK AIF   (&I GE &K).PADDED                                        01710000
&I       SETA  &I+1                                                     01720000
&CH      SETC  '&MYSTR'(&I,1)                                           01730000
         AIF   ('&CH' NE ' ').SCANBLK                                   01740000
         AIF   (&I EQ &K).PADRITE                                       01750000
         AIF   (&I GT 1).PADMID                                         01760000
&MYSTR   SETC  '&PAD'.'&MYSTR'(2,&K-1)                                  01770000
         AGO   .SCANBLK                                                 01780000
.PADMID  ANOP  ,                                                        01790000
&MYSTR   SETC  '&MYSTR'(1,&I-1).'&PAD'.'&MYSTR'(&I+1,&K-&I)             01800000
         AGO   .SCANBLK                                                 01810000
.PADRITE ANOP  ,                                                        01820000
&MYSTR   SETC  '&MYSTR'(1,&I-1).'&PAD'                                  01830000
         AGO   .SCANBLK                                                 01840000
.*                                                                      01850000
.*  NOW PROCESS THE STRING:                                             01860000
.*                                                                      01870000
.*  1) STRIP - FOR EACH DOUBLED AMPERSAND AND APOSTROPHE, COPY ONLY ONE 01880000
.*     FOR QUOTED STRING, DOUB AND FOUR OFF - STRIP FRAMING QUOTES      01890000
.*  2) DOUB/FOUR - FOR EACH, ADD TWO/FOUR AMPERSANDS OR APOSTROPHES     01900000
.*                                                                      01910000
.PADDED  ANOP  ,                                                        01920000
&MACQSTR SETC  '&MYSTR'      PROVISIONAL                                01930000
&K       SETA  K'&MYSTR      JUST IN CASE                               01940000
         AIF   (&DOUB OR &FOUR).PROCEED                                 01950000
         AIF   (NOT &DEL).TEST                                          01960000
         AIF   (NOT &MACQUOT OR &K LT 2).PROCEED                        01970000
&MYSTR   SETC  '&MYSTR'(2,&K-2)  ELIMINATE FRAME                        01980000
&K       SETA  K'&MYSTR      ADJUST                                     01990000
&MACQSTR SETC  '&MYSTR'      RETURN                                     02000000
         AIF   (&K EQ 0).NU  SET NULL FLAG IF DIMINISHED TOO MUCH       02010000
.PROCEED ANOP  ,                                                        02020000
&I       SETA  1                                                        02030000
&MACQSTR SETC  ''                                                       02040000
.CHARLUP ANOP  ,                                                        02050000
&CH      SETC  '&MYSTR'(&I,1)                                           02060000
         AIF   ('&CH' NE '''' AND '&CH' NE '&&').COPYONE                02070000
         AIF   (&DEL).STRIPPR                                           02080000
&CH      SETC  '&CH'.'&CH'                                              02090000
         AIF   (NOT &FOUR).COPYONE                                      02100000
&CH      SETC  '&CH'.'&CH'                                              02110000
         AGO   .COPYONE                                                 02120000
.STRIPPR AIF   (&I GE &K).COPYONE                                       02130000
         AIF   ('&MYSTR'(&I+1,1) NE '&CH').COPYONE  ERROR?              02140000
&I       SETA  &I+1          SKIP DOUBLED CHARACTER                     02150000
.COPYONE ANOP  ,                                                        02160000
&MACQSTR SETC  '&MACQSTR'.'&CH'                                         02170000
&I       SETA  &I+1                                                     02180000
         AIF   (&I LE &K).CHARLUP                                       02190000
.*                                                                      02200000
.*  NOW SEE WHETHER AND WHAT WE NEED TO DO TO THE STRING                02210000
.*                                                                      02220000
.*  1) UNQUOTED STRING, AND DOUB OR FOUR ON - FRAME IN QUOTES           02230000
.*       FOR FOUR, MUST DO PRIOR TO DOUBLING                            02240000
.*  2) EXAMINE THE RESULT STRING - SET MACQUOT FLAG IF QUOTED,          02250000
.*       OTHERWISE CHECK FOR ILLEGAL APOSTROPHES AND SET MACPERR        02260000
.*                                                                      02270000
         AIF   (NOT &DOUB AND NOT &FOUR AND &MACQUOT).TEST              02280000
&MACQSTR SETC  ''''.'&MACQSTR'.''''                                     02290000
         AIF   (NOT &FOUR).TEST                                         02300000
&MACQSTR SETC  ''''.'&MACQSTR'.''''                                     02310000
.TEST    ANOP  ,                                                        02320000
&K       SETA  K'&MACQSTR                                               02330000
&MACQUOT SETB  0             RESET FOR SHORT OR NULL STRING             02340000
         AIF   (&K LT 2).SKPQUOT                                        02350000
&MACQUOT SETB  ('&MACQSTR'(1,1) EQ '''' AND '&MACQSTR'(&K,1) EQ '''')   02360000
.SKPQUOT AIF   (&MACQUOT).MEND                                          02370000
&I       SETA  0                                                        02380000
.UNBALUP AIF   (&I GE &K).MEND                                          02390000
&I       SETA  &I+1                                                     02400000
         AIF   ('&MACQSTR'(&I,1) NE '''').UNBALUP                       02410000
&MACPERR SETB  1                                                        02420000
.MEND    MEND                                                           02430000
./ ADD NAME=MACSRVLD
         MACRO ,                                                        00010000
&NM      MACSRVLD &NAME                                                 00020000
.*--------------------------------------------------------------------* 00030000
.*  MACSRVLD IS AN INNER MACRO TO DETERMINE WHETHER A MODULE &NAME    * 00040000
.*  HAS BEEN REQUESTED BY THE SERVLOAD MACRO/SERVICE.  IF IT HAS,     * 00050000
.*  GLOBAL &MACPLOD IS SET TO THE NAME OF THE ADDRESS CONTAINING THE  * 00060000
.*  LOADED ADDRESS (USUALLY THE MODULE NAME).                         * 00070000
.*    OTHERWISE THE VALUE RETURNED IS =V(&NAME)                       * 00080000
.*  2012-06-02  GYP  NEW; ADDED TO SUPPORT THE CPOOL MACRO            * 00090000
.*--------------------------------------------------------------------* 00100000
         GBLC  &MACPLOD                                                 00110000
         GBLC  &SRVLMOD(20),&SRVLDEL(20)                                00120000
         GBLB  &SRVBMOD(20),&BUGBEAR                                    00130000
         GBLA  &SRVNMOD                                                 00140000
         LCLC  &CL,&CM                                                  00150000
         LCLA  &I,&J,&N                                                 00160000
&CL      SETC  '&NAME'                                                  00170000
&CM      SETC  '&NAME'                                                  00180000
         AIF   ('&NAME' NE '').MEMLOOP                                  00190000
         MNOTE 8,'MACSRVLD: ROUTINE NAME OMITTED'                       00200000
         MEXIT ,                                                        00210000
.*                                                                      00220000
.MEMLOOP AIF   (&I GE &SRVNMOD).OOPS                                    00230000
&I       SETA  &I+1                                                     00240000
         AIF   ('&NAME' NE '&SRVLDEL(&I)').MEMLOOP                      00250000
&MACPLOD SETC  '&SRVLMOD(&I)'                                           00260000
         MEXIT  ,                                                       00270000
.OOPS    ANOP  ,                                                        00280000
&MACPLOD SETC  '=V('.'&NAME'.')'                                        00290000
         MEND  ,                                                        00300000
./ ADD NAME=MAPAUTO
         MACRO ,                                                        00010000
&NM      MAPAUTO &PFX=AUR,&SECT=D                                       00020000
         LCLC  &P                                                       00030000
&P       SETC  '&PFX'                                                   00040000
         AIF   ('&SECT' EQ 'D').USED                                    00050000
         AIF   ('&NM' NE '').USENM                                      00060000
MAPAUTO  DS    0A                                                       00070000
         AGO   .COM                                                     00080000
.USENM   ANOP  ,                                                        00090000
&NM      DS    0A                                                       00100000
         AGO   .COM                                                     00110000
.USED    AIF   ('&NM' NE '').USECT                                      00120000
MAPAUTO  DSECT ,                                                        00130000
         AGO   .COM                                                     00140000
.USECT   ANOP  ,                                                        00150000
&NM      DSECT ,                                                        00160000
.COM     ANOP  ,                                                        00170000
.*   THIS IS THE DEFINITION ENTRY FOR AUTOMATIC COMMANDS                00180000
.*   AN UNSOLICITED ATTENTION OF AN UNALLOCATED UCB, PREVIOUSLY         00190000
.*   DEFINED HERE, RESULTS IN ISSUING THE MATCHING COMMAND.             00200000
.*     NORMALLY USED TO ISSUE A START COMMAND FOR THE DEVICE,           00210000
.*   OR TO ISSUE A VARY COMMAND.                                        00220000
.*     A SEMI-COLON MAY BE USED TO ISSUE MULTIPLE COMMANDS FROM         00230000
.*   ONE LINE                                                           00240000
.*             FULL DETAILS IN THE AUTORDR MODULE                       00250000
.*                                                                      00260000
&P.LINK  DC    A(0)          NEXT ENTRY IN CHAIN                        00270000
&P.UCB   DC    A(0)          UCB ADDRESS OF DEVICE                      00280000
&P.ID    DC    CL4' '        DEVICE NAME, LEFT JUSTIFIED                00290000
.*                                                                      00300000
.*    COMPLETE IQE                                                      00310000
&P.IQE   DC    A(0)   1/5    IQE LINK                                   00320000
&P.IQPRM DC    A(0)   2/5    IQE PARM                                   00330000
&P.IQIRB DC    A(0)   3/5    IQE'S IRB ADDRESS                          00340000
&P.IQTCB DC    A(0)   4/5    IQE'S TCB ADDRESS                          00350000
         DC    3A(0)  5/5      DCB, OUTLIM, ETC ?                       00360000
.*                                                                      00370000
&P.ATI   DC    X'00'         UCB'S ORIGINAL ATTENTION INDEX             00380000
.*                                                                      00390000
&P.FLAGS DC    X'00'         FLAGS                                      00400000
&P.PEND  EQU   X'80'           START PENDING                            00410000
&P.PIQE  EQU   X'40'           IQE ISSUED                               00420000
.*                                                                      00430000
&P.CMDLN DC    X'00'         LENGTH OF COMMAND BUFFER                   00440000
&P.CMD   DC    CL64' '       COMMAND(S)                                 00450000
&P.SIZE  EQU   *-&P.LINK                                                00460000
         MEND  ,                                                        00470000
./ ADD NAME=MAPCMPRT
         MACRO ,                                                        00010000
&NM    MAPCMPRT &PFX=CPR,&DCB=0,&PRTMODE=0,&DEV=1                       00020000
.*  THIS MACRO MAPS THE COMMON PRINTER DEFINITION SHARED BY PGMTRACE,   00030000
.*    DEBTRACE, EXORCIST, AND ?                                         00040000
         LCLC  &P                                                       00050000
&P       SETC  '&PFX'                                                   00060000
&P.@UDCB DC    A(&DCB)       USER (OPEN) PRINT DCB                      00070000
&P.FGMOD DC    AL1(&PRTMODE)  USER OUTPUT DCB/PRT MODE                  00080000
&P.F@LCL EQU   0                 ADDR IS LOCAL DCB                      00090000
&P.F@WTO EQU   1                 ISSUE WTO (NARROW)                     00100000
&P.F@DCB EQU   2                 ADDR IS AN OPEN (PRINT) DCB            00110000
&P.F@EXT EQU   3                 ADDR IS FOR USER EXIT                  00120000
&P.FXPRT EQU   4                 ADDR IS FOR XPRINT                     00130000
&P.F@PRT EQU   5                 ADDR IS FOR @PRINTER                   00140000
&P.FGOPT DC    AL1(0)        ..RESERVED..                               00150000
&P.FGSPR DC    AL1(0)        ..RESERVED..                               00160000
&P.F@DEV DC    AL1(&DEV)     @PRINTER DEVICE SELECTION BITS             00170000
         MEND  ,                                                        00180000
./ ADD NAME=MAPCMPR
         MACRO ,                                        ADDED ON 91100  00010000
&NM      MAPCMPR &PREFIX=OP,&DSECT=YES   COMP3270 CALLING PARM          00020000
         LCLC  &DS,&P                                                   00030000
&P       SETC  '&PREFIX'                                                00040000
&DS      SETC  '&P'.'TIONS'                                             00050000
         AIF   ('&NM' EQ '').HAVEDS                                     00060000
&DS      SETC  '&NM'                                                    00070000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00080000
&DS      DSECT ,             MAPPING OF COMP3270 EXPANSION              00090000
         AGO   .COMDS                                                   00100000
.NODSECT ANOP  ,                                                        00110000
&DS      DS    0H            MAPPING OF COMP3270 EXPANSION              00120000
.COMDS   ANOP  ,                                                        00130000
&P.FUN   DS    X             REQUESTED FUNCTIONS                 90140  00140000
&P.FSF   EQU   X'80'           INSERT PROT. SF IF NO SF IN LINE 2       00150000
&P.NCMP  EQU   X'40'           BYPASS BUFFER COMPRESSION, ETC.   90140  00160000
&P.NCOL  EQU   X'20'           BYPASS COLOR SUBSTITUTION         90140  00170000
&P.YESC  EQU   X'10'           BUFFER MAY CONTAIN ESCAPE (BTAM)  90140  00180000
&P.YCCW  EQU   X'08'           BUFFER CONTAINS CCW               90140  00190000
&P.YWCC  EQU   X'04'           BUFFER CONTAINS WCC/PCC           90140  00200000
&P.YCCO  EQU   X'01'           O/P BUFFER-1 HAS CCW CODE         93331  00210000
         SPACE 1                                                 90140  00220000
&P.ADD   DS    X             ADDRESSING MODE                     90140  00230000
&P.A16   EQU   X'02'           USE 16-BIT ADDRESSING ONLY        90140  00240000
&P.A14   EQU   X'01'           14-BIT ADDRESSING SUPPORTED       90140  00250000
         SPACE 1                                                 90140  00260000
&P.COL   DS    X             COLOR MODE                          90140  00270000
&P.SEVEN EQU   X'07'           7-COLOR MODE                      90140  00280000
&P.BACK  EQU   X'70'           BACKGROUND COLOR AVAILABLE        90140  00290000
         SPACE 1                                                 90140  00300000
&P.HIGH  DS    X             EXTENDED HIGH-LIGHTING              90140  00310000
*PSEVEN  EQU   X'07'           ALL EXTENDED HIGH-LIGHTING        90140  00320000
         SPACE 1                                                 90140  00330000
&P.MISC  DS    X             MISCELLANEOUS OPTIONS               90140  00340000
         SPACE 1                                                 90140  00350000
&P.FVAL  EQU   X'80'           FIELD VALIDATION SUPPORTED        90140  00360000
&P.FOUT  EQU   X'40'           FIELD OUTLINING                   90140  00370000
&P.FGE   EQU   X'08'           USE TEXT/APL GRAPHICS ESCAPE             00380000
         MEND  ,                                                        00390000
./ ADD NAME=MAPDEFMT
         MACRO ,                                                        00010000
&NM      MAPDEFMT &DSECT=YES,&PFX=PDD,&RETURN=,&VER=1           GP05180 00020000
.*                                                                      00030000
.*  MAPPING MACRO FOR SUBROUTINE SUBDEFMT (ADAPTED FROM @SERVICE PDSDE) 00040000
.*   1) WHENEVER USER READS A DIRECTORY BLOCK, STORE ADDRESS (OF LENGTH 00050000
.*      FIELD) IN pddNEXT, 2 (LENGTH OF LENGTH) IN pddINCR, AND         00060000
.*      BYTE -1 (BLOCK-1+(length)) IN pddLAST                           00070000
.*   2) COPY THE RECFM TO pddRECFM (NEEDED FOR LKED/BINDER vs OTHER)    00080000
.*   3) CALL SUBDEFMT, USE RESULTS, DO BXLE ON pddNEXT/pddINCR/pddLAST  00090000
.*      READ NEXT BLOCK IF BXLE FALLS THROUGH                           00100000
.*                                                                      00110000
.*   CHANGED FOR Y2K SUPPORT, ETC.                              GP98365 00120000
.*                                                                      00130000
         LCLC  &P                                                       00140000
&P       SETC  'PDD'                                                    00150000
         AIF   ('&PFX' EQ '').HAVEP                                     00160000
&P       SETC  '&PFX'                                                   00170000
.HAVEP   ANOP  ,                                                        00180000
&NM      MACMAPHD MAP,PFX=&PFX,DSECT=&DSECT,DFLT=DEFMT          GP05180 00190000
&P.NEXT  DC    A(0)          ADDRESS OF CURRENT MEMBER                  00200000
&P.INCR  DC    A(0)          BXLE INCREMENT FOR CURRENT MEMBER          00210000
&P.LAST  DC    A(0)          LAST USED BYTE IN BLOCK                    00220000
&P.RECFM DC    AL1(0)        RECFM                                      00230000
&P.TYPE  DC    X'00'         ENTRY TYPE                                 00240000
&P.TLKED EQU   X'80'           LINKAGE EDITOR ENTRY                     00250000
&P.TSPF  EQU   X'40'           SPF ENTRY                                00260000
&P.TWYL  EQU   X'20'           WYLBUR ENTRY (LOCAL)                     00270000
&P.TDTX  EQU   X'10'           IEBUPDTX ENTRY                           00280000
&P.FLAGS DC    X'00'         ENTRY FLAGS (FIELDS PRESENT)               00290000
&P.AOSLE EQU   X'80'           PRODUCED BY VS LINKAGE EDITOR            00300000
&P.FREAL EQU   X'20'           MAIN MEMBER/EPA PRESENT                  00310000
&P.FSSI  EQU   X'10'           SSI FIELD PRESENT                        00320000
&P.FAPF  EQU   X'08'           APF FIELD PRESENT                        00330000
&P.FSCTR EQU   X'04'           SCATTER LOAD MODULE                      00340000
&P.FBIND EQU   X'01'           PRODUCED BY BINDER               GP05180 00350000
&P.FLAG2 DC    X'00'         SECOND FLAG BYTE                   GP98365 00360000
&P.FLAG3 DC    X'00'         THIRD FLAG BYTE                    GP98365 00370000
&P.UDLEN DC    X'00'         NUMBER OF HALFWORDS OF USER DATA           00380000
&P.OSSI  DC    H'0'          OFFSET TO SSI FROM NAME                    00390000
&P.OAPF  DC    H'0'          OFFSET TO APF FROM NAME                    00400000
         DC    4H'0'         EXTRA FOR EXPANSION                GP98365 00410000
&P.CLRLN EQU   *-&P.TYPE       LENGTH TO CLEAR                          00420000
&P.RALIS DC    C' '          BLANK OR * FOR ALIAS OR ¬ FOR SCLM GP98365 00430000
&P.RNAME DC    CL8' '        EDITED MEMBER NAME                 GP98365 00440000
&P.RTTR  DC    CL6' '        PRIMARY TTR                        GP05180 00450000
&P.RSSI  DC    CL8' '        SSI OR BLANKS                      GP98365 00460000
&P.RYMD  DC    CL10' '       CHANGE DATE YYYYMMDD               GP98365 00470000
&P.RJDAY DC    CL3' '        CHANGE DATE JJJ (JULIAN FORM)      GP98365 00480000
&P.RTIME DC    CL5' '        TIME MODIFED/ADDED   HH:MM         GP05180 00490000
&P.VVMM  DC    0CL5' '       SPF VERSION/MODIFICATION           GP98365 00500000
&P.RAPF  DC    CL4'AC=N',C' '  APF CODE > 0 OR BLANKS           GP98365 00510000
&P.SIZE  DC    0CL8' '       LOAD MODULE SIZE                   GP05180 00520000
&P.RLINE DC    CL8' '        CURRENT LINE COUNT                 GP05180 00530000
&P.RMAIN DC    CL8' '        MAIN MEMBER OR SPF UID OR BLANKS   GP98365 00540000
&P.REPAD DC    CL8' '        ENTRY POINT OFFSET OF MODULE       GP98365 00550000
&P.RMODE DC    CL4' '        AaRa/A3R2/etc. MODE                GP98365 00560000
&P.RATTR DC    6CL4' '       REFR/RENT/REUS/OVLY/NXEC/PAGE      GP98365 00570000
&P.RATTN EQU   (*-&P.RATTR)/L'&P.RATTR  NUMBER OF ENTRIES       GP98365 00580000
&P.RBLNK EQU   *-&P.RALIS      LENGTH TO BLANK                  GP98365 00590000
.MEND    MEND  ,                                                        00600000
./ ADD NAME=MAPDSCHK
         MACRO ,                                                        00010000
&NM      MAPDSCHK &PFX=DSC,&DSECT=                                      00020000
&NM      MACMAPHD MAP,PFX=&PFX,DSECT=&DSECT                             00030000
&PFX.DSN   DS  CL44          UNQUOTED, TRUE NAME                        00040000
&PFX.MEM   DS  CL8           MEMBER NAME                                00050000
&PFX.VOL   DS  XL12          1 VOL ENTRY FOR DS1; ALL VOLUMES FOR DSQ   00060000
&PFX.SER   EQU &PFX.VOL+6,6,C'C'  FIRST VOLUME SERIAL                   00070000
&PFX.#TRKS DS  F             TRACKS IN DATA SET/PRIMARY SPACE REQUEST   00080000
&PFX.#DES  DS  F             NUMBER/REQUESTED DIRECTORY BLOCKS          00090000
&PFX.@UCB  DS  A             ADDRESS OF UCB OF FIRST VOLUME             00100000
&PFX.#TPC  DS  H             TRACKS PER CYLINDER                        00110000
&PFX.DSCB1 DS  CL44          DS1DSNAM; TRUE NAME AFTER CATALOG LOCATE   00120000
&PFX.FMTID DS  XL96          REST OF DSCB                               00130000
&PFX.DSCB3 DS  CL(44+96)     LAST DSCB3, IF ANY                         00140000
&PFX.DIRM  DS  XL74          DIRECTORY ENTRY FOR MEMBER                 00150000
         DS    CL32          WORK SPACE                                 00160000
&PFX.LEN EQU   *-&PFX.DSN      LENGTH OF STORAGE REQUIRED               00170000
         MEND  ,                                                        00180000
./ ADD NAME=MAPEXTNT
         MACRO ,                                                        00010000
&NM      MAPEXTNT &DSECT=YES                            ADDED ON 82105  00020000
         LCLC  &DS                                                      00030000
&DS      SETC  'MAPEXTNT'    SET DEFAULT NAME                           00040000
         AIF   ('&NM' EQ '').HAVEDS                                     00050000
&DS      SETC  '&NM'                                                    00060000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00070000
&DS      DSECT ,             MAPPING OF DSCB1/DSCB3 EXTENT ENTRY        00080000
         AGO   .COMDS                                                   00090000
.NODSECT ANOP  ,                                                        00100000
&DS      DS    0H            MAPPING OF DSCB1/DSCB3 EXTENT ENTRY        00110000
.COMDS   ANOP  ,                                                        00120000
XTWHOLE  DC    0XL10'0'      DUMMY FOR CLC/XC                           00130000
XTTYPE   DC    X'0'          EXTENT TYPE                                00140000
XTTTRK   EQU   X'01'           TRACK ALIGNMENT                          00150000
XTTLABEL EQU   X'40'           LABEL EXTENT                             00160000
XTTCYL   EQU   X'81'           CYLINDER ALIGNMENT                       00170000
XTTSPLIT EQU   X'80'           SPLIT CYLINDER ALLOCATION                00180000
XTSEQ    DC    X'0'          EXTENT SEQUENCE (0-15)                     00190000
XTLOCYL  DC    H'0'          LOW CYLINDER                               00200000
XTLOTRK  DC    H'0'          LOW TRACK                                  00210000
XTHICYL  DC    H'0'          HIGH CYLINDER                              00220000
XTHITRK  DC    H'0'          HIGH TRACK                                 00230000
XTLEN    EQU   *-&DS         LENGTH OF ONE ENTRY                        00240000
         MEND  ,                                                        00250000
./ ADD NAME=MAPFDL
         MACRO ,             MAP SINGLE ENTRY FOR SCLINE FUNCTION       00010000
&NM      MAPFDL &DSECT=YES,&PFX=FDL                                     00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*  EXHIBIT - MAP HEADER DATA FOR FDLINE EXPANSIONS (SEE SCLINE)      * 00050000
.*                                                                    * 00060000
.********************************************************************** 00070000
         LCLC  &P                                                       00080000
&P       SETC  '&PFX'                                                   00090000
&NM      MACMAPHD DSECT,DSECT=&DSECT,PFX=&P                             00100000
&P.LEN   DC    AL2(0)        LENGTH OF CONTROL/TEXT DATA                00110000
&P.FLAG  DC    X'00'         LINE CONTROL FLAGS                         00120000
&P.FLAD  EQU   X'10'           INPUT FIELDS TO BE LEFT-JUSTIFIED        00130000
&P.FRAD  EQU   X'08'           INPUT FIELDS TO BE RIGHT-JUSTIFIED       00140000
&P.FUPP  EQU   X'04'           INPUT FIELDS TO BE UPPER CASED           00150000
&P.FSCR  EQU   X'02'           LINE IS SCROLLABLE (LEFT/RIGHT)          00160000
&P.FMDT  EQU   X'01'           LINE CONTAINS MODIFIED INPUT FIELD       00170000
&P.CNTL  DS    X             CONTROL BYTE (01-3F)  {REPEATED W/TEXT}    00180000
&P.CIN   EQU   X'08'           INPUT FIELD                              00190000
&P.COU   EQU   X'10'           OUTPUT                                   00200000
&P.CHI   EQU   X'18'           HIGH INTENSITY OUT                       00210000
&P.MCOL  EQU   X'07'           MASK FOR COLOR BITS                      00220000
&P.TEXT  DS    0C              TEXT DATA                                00230000
         MEND  ,                                                        00240000
./ ADD NAME=MAPFDS
         MACRO ,                                                        00010000
&NM      MAPFDS &DSECT=,&PFX=FDS,&LEN=0                 ADDED ON 87312  00020000
.*   MAPPING FOR USE IN @SCREENS                                        00030000
         LCLC  &P,&Q                                                    00040000
&P       SETC  '&PFX'                                                   00050000
&Q       SETC  '&P'.'SECT'                                              00060000
         AIF   ('&NM' EQ '').DFDS                                       00070000
&Q       SETC  '&NM'                                                    00080000
.DFDS    AIF   ('&DSECT' EQ 'NO').NODS                                  00090000
&Q       DSECT ,                                                        00100000
         AGO   .CMDS                                                    00110000
.NODS    AIF   ('&NM' EQ '').CMDS                                       00120000
&Q       DS    0X                                                       00130000
.CMDS    ANOP  ,                                                        00140000
&P.LEN   DC    X'00'         LENGTH-1 OF TEXT                           00150000
&P.FG    DC    X'00'         OPTION FLAGS                               00160000
&P.FMOVE EQU   X'80'           ENTRY CONTAINS REPLACEMENT TEXT          00170000
&P.FPOS  EQU   X'40'           POSITIONAL PARAMETER ENTRY               00180000
&P.FKEY  EQU   X'20'           KEYWORD=VALUE OR (VALUE) ENTRY           00190000
&P.FPOS2 EQU   &P.FPOS+&P.FKEY  CHAINED POSITIONAL UID/PSW/NPSW  87361  00200000
&P.FREQ  EQU   X'02'           MANDATORY FIELD                   87314  00210000
&P.FLONG EQU   X'01'           KEYWORD NOT ABBREVIATED                  00220000
&P.FDAD  DC    SL2(0)        ADDRESS OF FDIN/FDINP DEFINITION           00230000
         AIF   ('&LEN' EQ '0' OR '&LEN' EQ '').NULLEN                   00240000
&P.TEXT  DC    CL(&LEN)' '   TEXT FIELD                                 00250000
         AGO   .COMLEN                                                  00260000
.NULLEN  ANOP  ,                                                        00270000
&P.TEXT  DC    0C' '         TEXT FIELD                                 00280000
.COMLEN  ANOP  ,                                                        00290000
&P.RLEN  DC    AL1(0)        (OPTIONAL) REPLACEMENT TEXT LENGTH         00300000
&P.RTXT  DC    0C' '         (OPTIONAL) REPLACEMENT TEXT                00310000
         MEND  ,                                                        00320000
./ ADD NAME=MAPFD
         MACRO                                                          00010000
&NM      MAPFD ,                                                        00020000
         GBLB  &MAPFDS                                                  00030000
.*--------------------------------------------------------------------* 00040000
.*   THIS MAPPING REPLACES FDSECT                                     * 00050000
.*   IT SUPPORTS SPLIT DSECTS AS REQUIRED FOR EXHASCR WHILE EXAMINING * 00060000
.*   MIXED FD AND FDPRT REQUESTS                                      * 00070000
.*                                                                    * 00080000
.*   PREFIX IS FHD FOR ALL COMMON MAPPINGS, AND FFD FOR FDPRT VARS.   * 00090000
.*--------------------------------------------------------------------* 00100000
         AIF   (&MAPFDS).MEND                                           00110000
&MAPFDS  SETB  1                                                        00120000
         AIF   ('&NM' NE '').EXNAME                                     00130000
FHDSECT  DSECT ,             FD ITEM MAPPING                            00140000
         AGO   .COMNAME                                                 00150000
.EXNAME  ANOP  ,                                                        00160000
&NM      DSECT ,             FD ITEM MAPPING                            00170000
.COMNAME ANOP  ,                                                        00180000
FHDLINK  DS    AL1           LENGTH TO NEXT ENTRY OR 0                  00190000
FHDTYPE  DS    X             ENTRY TYPE (IN, OUT, NOP)                  00200000
FHDFNOP  EQU   X'40'           IGNORE THIS ENTRY                        00210000
FHDFIN   EQU   X'80'           INPUT ENTRY                              00220000
FHDFCIN  EQU   X'08'           FHDIN IS LOCKED (COND. INPUT)     87156  00230000
FHDFPRT  EQU   X'30'           FD/FDIN - NO 3270 FIELDS          81127  00240000
FHDFIND@ EQU   X'01'             FDSADD IS INDIRECT ADDRESS      81270  00250000
FHDFREG# EQU   X'02'             FDILEN IS REGISTER WITH LENGTH  81270  00260000
FHDFEXAD EQU   X'04'             EXPANSION HAS USER EXIT ADDRESS 89095  00270000
FHDFOPT  EQU   X'20'           OPTION LIST                              00280000
FHDFGOTO EQU   X'10'           BRANCH TO ANOTHER FD ENTRY               00290000
FHDFEXEC EQU   X'11'           PERFORM NEW FD RANGE              81131  00300000
FHDFBR   EQU   X'12'           BRANCH/TEST AFTER PRIOR TEST      81131  00310000
FHDFTM   EQU   X'13'           TM/BRANCH                         81131  00320000
FHDFCLI  EQU   X'14'           CLI/BRANCH                        81131  00330000
FHDFCLC  EQU   X'15'           CLC/BRANCH                        81131  00340000
FHDFMOD  EQU   X'18'           SET ADDRESS RESOLUTION MODE       92307  00350000
FHDFSPC  EQU   X'1E'           SPACE/ROOM/REPT SERVICE           82109  00360000
FHDFUEX  EQU   X'1F'           USER EXIT                         81193  00370000
FHDGOTO  DS    0SL2(0)       ADDRESS OF TARGET FD OF GO TO              00380000
FHDEDIT  DS    X             EDITING OPTIONS                            00390000
FHDFNL   EQU   X'80'           POSITION TO NEW LINE                     00400000
FHDFDEBL EQU   X'40'           STRIP LEADING BLANKS                     00410000
FHDFDEBR EQU   X'20'           STRIP TRAILING BLANKS                    00420000
FHDFDEBZ EQU   X'10'           STRIP LEADING ZEROES                     00430000
FHDFPADL EQU   X'08'           LEFT BLANK OR SF                         00440000
FHDFPADR EQU   X'04'           RIGHT BLANK OR SF                        00450000
FHDFRADJ EQU   X'02'           RIGHT-ADJUST IN OUTPUT                   00460000
FHDFUP   EQU   X'01'           UPPER CASE INPUT TRANSLATE               00470000
*        REDEFINITION FOR FDOPT                                  82109  00480000
*FHDFNL  EQU   X'80'           POSITION TO NEW LINE                     00490000
FHDOWCCP EQU   X'40'         WCC OPTIONS PRESENT                        00500000
FHDOSBAP EQU   X'20'         SBA PRESENT                                00510000
FHDOCURP EQU   X'08'         CURSOR ADDRESS PRESENT                     00520000
FHDOINDP EQU   X'04'           AUTO INDENT VALUE PRESENT         81270  00530000
FHDOPTP  EQU   X'02'         COLOR OR DISPLAY OPTIONS PRESENT           00540000
FHDOPCCP EQU   X'01'         PRT CARRIAGE CONTROL INSTEAD OF CURP       00550000
FHDOPT9  DS    X             3279 OPTIONS                               00560000
FHDFCOLR EQU   X'70' 0DFLT,1BLUE,2RED,3PINK,4GREEN,5TURQ,6YELLOW,7WHITE 00570000
FHDFMONO EQU   X'08'         APPLY HIGH-LIGHT ON MONOCHROME ONLY 87313  00580000
FHDFUNDR EQU   X'04'           UNDERLINE                                00590000
FHDFREV  EQU   X'02'           REVERSE                                  00600000
FHDFBLNK EQU   X'01'           BLINK                                    00610000
FHDOPT7  DS    X             3277/3278 OPTIONS                          00620000
FHDFINT  EQU   X'08'           INTENSIFIED                              00630000
FHDFLPEN EQU   X'04'           LIGHT-PEN DETECTABLE                     00640000
FHDFNDSP EQU   X'0C'           NON-DISPLAY                              00650000
FHDFNUM  EQU   X'10'           NUMERIC INPUT                            00660000
FHDFSKIP EQU   X'30'           SKIP DISPLAY                             00670000
FHDFPROT EQU   X'20'           PROTECTED                                00680000
FHDFDFLT EQU   X'80'           DEFAULT OPTIONS/COLORS                   00690000
FHDFPREV EQU   X'40'           PREVIOUS OPTIONS/COLORS                  00700000
FHDFNULL EQU   X'02'           SUPPRESS X'00' IN INPUT FIELDS           00710000
FHDFMTD  EQU   X'01'           MODIFIED DATA TAG                 87313  00720000
FHDDATA  DS    0X            START OF LONG DATA                         00730000
.*                                                                      00740000
FHDOWCC  DC    X'0'          WCC OPTIONS                                00750000
FHDOSBA  DC    XL2'0'        SBA ADDRESS                                00760000
FHDOCUR  DC    0XL2'0'       CURSOR ADDRESS                             00770000
FHDOCC   DS    C             PRINTER CARRIAGE CONTROL            81201  00780000
FHDOIND  DS    AL1           AUTOMATIC LINE INDENT               81270  00790000
         SPACE 1                                                 81127  00800000
         ORG   FHDGOTO                                           81127  00810000
FHDBRE   DS    SL2           BRANCH EQUAL                        81127  00820000
FHDBRL   DS    SL2           BRANCH LOW/MIXED                    81127  00830000
FHDBRH   DS    SL2           BRANCH HIGH/ONES                    81127  00840000
FHDBVAR  DS    SL2           TEST VARIABLE                       81127  00850000
FHDBIDA  DS    0X              IMMEDIATE DATA FOR TEST           81127  00860000
FHDBLEN  DS    X               LENGTH FOR FDCLC                  81127  00870000
FHDBCLC  DS    SL2           COMPARE STRING                      81127  00880000
         SPACE 1                                                 81193  00890000
         ORG   FHDGOTO       DEFINITION FOR USER EXIT REQUEST    81193  00900000
FHDUXAD  DS    SL2           USER EXIT ADDRESS                   81193  00910000
FHDUXFPM DS    0X            USER SUPPLIED PARM INFO             81193  00920000
         ORG   ,                                                 81193  00930000
FHDXOK   EQU   0             RETURN CODES - NORMAL PROCESSING    81193  00940000
FHDXGOTO EQU   2               NEW FD ADDRESS IN R1              81193  00950000
FHDXCLR  EQU   4               CLEAR CURRENT LINE                81193  00960000
FHDXPRT  EQU   8               PRINT CURRENT LINE                81193  00970000
FHDXADD  EQU   FHDXCLR+FHDXPRT DATA ADDED TO LINE                81193  00980000
FHDXQUIT EQU   16              TERMINATE CURRENT PRTLIST         81193  00990000
.*                                                                      01000000
.*  PORTION DISTINCT FOR FDPRT                                          01010000
.*                                                                      01020000
FFDDSECT DSECT ,             SPECIAL SECTION FOR FDPRT/FD COMMON DATA   01030000
FFDDATA  DS    X             DATA TYPE                                  01040000
FFDDLIT  EQU   X'80'           FD CONTAINS LITERAL, NOT ADDRESS         01050000
FFDDCHAR EQU   1               EBCDIC, TRANSLATED                       01060000
FFDDCON  EQU   2               EBCDIC WITH CONTROL CHARACTERS           01070000
FFDDASIS EQU   3               EBCDIC(?), NO TRANSLATE                  01080000
FFDDADDR EQU   4               ADDRESS                                  01090000
FFDDHEX  EQU   5               HEXADECIMAL                              01100000
FFDDSHEX EQU   6               HEXADECIMAL WITH EXPLICIT SIGN           01110000
FFDDBIT  EQU   7               BIT STRING                               01120000
FFDDINT  EQU   8               INTEGER                                  01130000
FFDD$INT EQU   9               INTEGER.DD                               01140000
FFDDDEC  EQU   10              PACKED DECIMAL                           01150000
FFDD$DEC EQU   11              PACKED DECIMAL.DD                        01160000
FFDDFIX  EQU   12              FLOATING POINT                           01170000
FFDDTIME EQU   13              TIME (BIN 1/100 SECONDS)          81193  01180000
FFDDTIMD EQU   14              TIME (PACKED)                     81193  01190000
FFDDDATE EQU   15              DATE (PACKED; O/P MM/DD/YY)       81193  01200000
FFDDDATJ EQU   16              DATE (PACKED; O/P YY.DDD)         81193  01210000
FFDDFLAG EQU   64              FLAG/TABLE FORMATTING            GP06273 01220000
FFDOLEN  DS    AL1           OUTPUT LENGTH; 0 FOR DEFAULT; MAX FOR FDIN 01230000
FFDILEN  DS    AL1           CURRENT LENGTH OF ITEM                     01240000
FFDTEXT  DS    0CL132        (FD/FDPRT) LITERAL TEXT                    01250000
FFDSADD  DS    SL2           ADDRESS OF DATA ITEM                       01260000
FFDIOFF  DS    AL2           FDIN - OFFSET TO FIW AREA           84237  01270000
FFDIXAD  DS    SL2           FDIN - USER EXIT ADDRESS            89095  01280000
         ORG   FFDIOFF         REDEFINE FOR FLAG PROCESSING     GP03287 01290000
FFDTBAD  DS    SL2           ADDRESS OF BIT EQUIVALENT TEXT     GP03287 01300000
FFDTSEP  DS    C             OUTPUT SEPARATOR CHARACTER OR 00   GP03287 01310000
FFDTSPC  DS    XL1           NUMBER OF SPACES BETWEEN ITEMS     GP03287 01320000
         ORG   ,                                                GP03287 01330000
         SPACE 1                                                 81193  01340000
FDUXPARM DSECT ,             MAPPING OF R1 LIST SUPPLIED TO EXIT 81193  01350000
FDUXFD   DS    A               ADDRESS OF CURRENT FD             81193  01360000
FDUXPWRK DS    A               ADDRESS OF PRINTER WORK AREA      81193  01370000
FDUXSAVE DS    A               ADDRESS OF ORIGINAL SAVE AREA     81193  01380000
FDUXPRT  DS    A               ADDRESS OF CURRENT PRINT LINE     81193  01390000
         DS    A                 RESERVED                        81193  01400000
.MEND    MEND  ,                                                        01410000
./ ADD NAME=MAPFDW
         MACRO ,                                                        00010000
&NM      MAPFDW &DSECT=,&PFX=FDW                        ADDED ON 84237  00020000
         LCLC  &P,&Q                                                    00030000
&P       SETC  '&PFX'                                                   00040000
&Q       SETC  '&P'.'SECT'                                              00050000
         AIF   ('&NM' EQ '').DFDS                                       00060000
&Q       SETC  '&NM'                                                    00070000
.DFDS    AIF   ('&DSECT' EQ 'NO').NODS                                  00080000
&Q       DSECT ,                                                        00090000
         AGO   .CMDS                                                    00100000
.NODS    AIF   ('&NM' EQ '').CMDS                                       00110000
&Q       DS    0A                                                       00120000
.CMDS    ANOP  ,                                                        00130000
&P.FDA   DC    A(0)          ADDRESS OF FD/FDIN SEQUENCE                00140000
&P.FWA   DC    A(0)          ADDRESS OF INPUT WORK AREA (FIW)           00150000
&P.FWL   DC    F'0'          LENGTH OF FIW                              00160000
&P.SCAN  DC    A(0)          CURRENT INPUT SCANNER ADDRESS       86209  00170000
&P.SCAL  DC    F'0'          RESIDUAL INPUT LENGTH TO SCAN       86209  00180000
&P.BIA   DC    A(0)          ADDRESS OF INPUT BUFFER                    00190000
&P.BIL   DC    F'0'          CURRENT LENGTH OF INPUT                    00200000
&P.BIM   DC    Y(0)          MAXIMUM INPUT SIZE                  86209  00210000
&P.BOM   DC    Y(0)          MAXIMUM OUTPUT SIZE                 86209  00220000
&P.BOA   DC    A(0)          ADDRESS OF OUTPUT BUFFER                   00230000
&P.BOL   DC    F'0'          LENGTH OF OUTPUT BUFFER                    00240000
&P.BOS   DC    Y(0)          SCREEN CAPACITY USED BY OUTPUT      86209  00250000
&P.CUR   DC    X'FFFF' 1/3   0 OR REQUESTED CURSOR ADDRESS              00260000
&P.CUD   DC    X'FFFF' 2/3   DEFAULT CURSOR ADDRESS                     00270000
&P.ICUD  DC    Y(0)    3/3   (LAST) INPUT CURSOR ADDRESS         85034  00280000
&P.IAID  DC    C' '          (LAST) INPUT AID                    85034  00290000
&P.ICOD  DC    AL1(0)        (LAST) INPUT AID CONVERTED          85034  00300000
&P.FG    DC    X'00'         ENTRY FLAG (OR'ED FROM ALL FIWFG)          00310000
&P.FTXT  EQU   X'80'           ENTRY CONTAINS TEXT                      00320000
&P.FERR  EQU   X'40'           TEXT IS IN ERROR                         00330000
&P.FPEN  EQU   X'20'           FIELD SELECTED BY LIGHT-PEN              00340000
&P.FHLP  EQU   X'10'           TEXT IS HELP OR ?                 88221  00350000
&P.FF1   EQU   X'08'           FIRST FDIN MODIFIED               86338  00360000
&P.FF2   EQU   X'04'           OTHER FDIN MODIFIED               86338  00370000
&P.FINT  EQU   X'02'           INTENSIFIED DISPLAY FIELD         86338  00380000
&P.FINV  EQU   X'01'           INVERT INTENSITY                  86338  00390000
&P.OPT   DC    X'00'         PROCESSING OPTIONS                         00400000
&P.OKEEP EQU   X'80'           SCINIT NOT TO ERASE FIW AREA      86231  00410000
&P.MKEEP EQU   X'40'           SCMOVE TO KEEP FIW FLAGS          87159  00420000
&P.MKDEL EQU   X'20'           SCMARK TO CLEAR NON-ESSENTIAL IWS 87360  00430000
&P.OSA   EQU   X'10'           SCLIST TO USE SA, NOT SFE         87336  00440000
&P.LOCK  EQU   X'08'           IF OFF, COND. INPUT IS LOCKED     87156  00450000
&P.OHELP EQU   X'04'           LOOK FOR 'HELP' AND '?'           88221  00460000
&P.SFTAB EQU   X'02'           DON'T MERGE SF - TABLE PROC.     GP02363 00470000
&P.NREAD EQU   X'02'           SCLINE WRITE ONLY; NO READ       GP13068 00480000
&P.KYFLP EQU   X'00' >LATER<   SWAP KEYS 13-24 WITH 1-12        GP12305 00490000
&P.KEY12 EQU   X'01'           CONVERT KEYS 13-24 TO 1-12        88211  00500000
&P.SCAC  DC    A(0)          SCANNER CONTROL LIST ADDRESS        87312  00510000
&P.SCMSG DC    A(0)          ERROR MESSAGE ADDRESS               87360  00520000
&P.DEVIC DC    A(0)          DEVICE ATTRIBUTE POINTER (MAPCMPR)  93344  00530000
&P.FDRST DC    A(0)          FD ADDR - RESTART AFT. FULL SCREEN GP02363 00540000
.*                             (FDOPT ADDR. IF FDKEEP SEQUENCE) GP02363 00550000
&P.RELOC DC    A(0)          ADDRESS OF REGISTER AREA FOR FD    GP03269 00560000
.*                             ADDRESS RESOLUTION (SUBXSCRN)    GP03269 00570000
&P.PROFG DC    X'00'         PROCESSING FLAG FOR SUBXSCRN, ETC. GP03273 00580000
&P.PFHED EQU   X'80'           NEED PAGE HEADER                 GP03273 00590000
&P.PFSHO EQU   X'40'           DISPLAY PAGE                     GP03273 00600000
&P.PFENT EQU   X'20'           RETURN TO CALLER ON ENTER ONLY   GP04108 00610000
&P.PFCUR EQU   X'10'           USE CURSOR                       GP12297 00620000
&P.PFARC EQU   X'08'           CURSORS IN (ROW,COL) FORMAT      GP09356 00630000
&P.PFCAN EQU   X'04'           CAN COMMAND AFTER DISPLAY        GP09356 00640000
&P.PFEND EQU   X'02'           END COMMAND AFTER DISPLAY        GP09350 00650000
&P.PFDAT EQU   X'01'           DATA ON PAGE                     GP03273 00660000
         DC    X'00'           RESERVED                         GP03273 00670000
&P.SVCUR DC    H'0'          SCINIT SAVED CURSOR ADDRESS        GP05338 00680000
.*       ZAP SPACE                                               87360  00690000
&P.SVPAG DC    A(0)          ADDRESS OF INITIAL (PAGE) FD CHAIN GP03277 00700000
&P.@HLP  DC    A(0)          FD OR FDLINE FOR HELP SCREEN       GP05080 00710000
&P.CATR  DC    XL2'0'  1/3   CURSOR ADDRESS FOR SPECIAL SA      GP10021 00720000
&P.CATL  DC    XL1'0'  2/3     LENGTH OF SA FIELD               GP10021 00730000
&P.CATC  DC    CL1'6'          SA COLOR CODE                    GP10021 00740000
         DC    1A(0)           RESERVED                         GP05080 00750000
&P.FDWLN EQU   *-&P.FDA      SIZE TO BE CLEARED                  93344  00760000
         MEND  ,                                                        00770000
./ ADD NAME=MAPFIW
         MACRO ,                                                        00010000
&NM      MAPFIW &DSECT=,&PFX=FIW,&LEN=0                 ADDED ON 84237  00020000
         LCLC  &P,&Q                                                    00030000
&P       SETC  '&PFX'                                                   00040000
&Q       SETC  '&P'.'SECT'                                              00050000
         AIF   ('&NM' EQ '').DFDS                                       00060000
&Q       SETC  '&NM'                                                    00070000
.DFDS    AIF   ('&DSECT' EQ 'NO').NODS                                  00080000
&Q       DSECT ,                                                        00090000
         AGO   .CMDS                                                    00100000
.NODS    AIF   ('&NM' EQ '').CMDS                                       00110000
&Q       DS    0X                                                       00120000
.CMDS    ANOP  ,                                                        00130000
&P.FG    DC    X'00'         ENTRY FLAG                                 00140000
&P.FTXT  EQU   X'80'           ENTRY CONTAINS TEXT                      00150000
&P.FERR  EQU   X'40'           TEXT IS IN ERROR                         00160000
&P.FPEN  EQU   X'20'           FIELD SELECTED BY LIGHT-PEN              00170000
&P.FHLP  EQU   X'10'           TEXT IS HELP OR ?                 88221  00180000
&P.FPRO  EQU   X'08'           PROCESSED BY EXIT; IGNORE        GP04111 00190000
&P.FINT  EQU   X'02'           DISPLAY FIELD INTENSIFIED                00200000
&P.FINV  EQU   X'01'           DISPLAY OPPOSITE INTENSITY               00210000
&P.LEN   DC    AL1(0)        CURRENT TEXT LENGTH                        00220000
&P.ATB   DC    AL2(0)        ADDRESS+1 OF ATTRIBUTE BYTE                00230000
         AIF   ('&LEN' EQ '0' OR '&LEN' EQ '').NULLEN            87166  00240000
&P.TEXT  DC    CL(&LEN)' '   TEXT FIELD (FROM CRT)               87166  00250000
         AGO   .COMLEN                                           87166  00260000
.NULLEN  ANOP  ,                                                 87166  00270000
&P.TEXT  DC    0C' '         TEXT FIELD (FROM CRT)                      00280000
.COMLEN  ANOP  ,                                                 87166  00290000
&P.SIZE  EQU   *-&P.FG       SIZE OF ONE ENTRY (+FDOLEN)         87166  00300000
         MEND  ,                                                        00310000
./ ADD NAME=MAPINDEX
         MACRO ,                                                        00010000
&NM      MAPINDEX &DSECT=YES,&PFX=MIX                  NEW 2010.187 GYP 00020000
.*--------------------------------------------------------------------* 00030000
.*  MAPS ENTRIES IN THE IBM DISTRIBUTION SOURCE LIBRARY INDEX         * 00040000
.*--------------------------------------------------------------------* 00050000
         LCLC  &P                                                       00060000
&P       SETC  '&PFX'                                                   00070000
         AIF   ('&DSECT' NE 'YES').ALTSECT                              00080000
&PFX.DSECT DSECT ,                                                      00090000
         AGO   .NODSECT ,                                               00100000
.ALTSECT ANOP  ,                                                        00110000
&PFX.DSECT  DS 0D            PLANT A LABEL                              00120000
.NODSECT AIF   ('&NM' EQ '').NOLABEL                                    00130000
&NM      DS    0F                                                       00140000
.NOLABEL AIF   ('&NM' EQ '&PFX'.'TENT').NOLTENT                         00150000
&PFX.TENT   DS 0F            DEFINE START OF TEXT ENTRY                 00160000
.NOLTENT ANOP  ,                                                        00170000
&P.MEM   DC    CL8' '        MEMBER NAME (PROGRAM OR MACRO)             00180000
&P.VOL   DC    CL6' '        VOLUME SERIAL                              00190000
&P.LBL   DC    CL1' '        LABEL TAPE (S/N)                           00200000
&P.FIL   DC    CL3'  0' '    FILE NUMBER (0 FOR DASD)                   00210000
&P.DSN   DC    CL44' '       DATA SET NAME                              00220000
&P.DST   DC    CL8' '        (OPTIONAL) DISTLIB                         00230000
&P.TGT   DC    CL8' '        PROGRAM NAME                               00240000
         DC    CL2' '          FILLER                                   00250000
&P.LEN   EQU   *-&P.MEM        ENTRY LENGTH                             00260000
         MEND  ,                                                        00270000
./ ADD NAME=MAPINP
         MACRO ,                                        ADDED ON 82116  00010000
&NM      MAPINP &PREFIX=PN,&DSECT=YES  INPWORK MAPPING                  00020000
.*    UPDATED FOR ESA AND OS/390 BY G.P.                                00030000
         LCLC  &DS,&P                                                   00040000
&P       SETC  '&PREFIX'                                                00050000
&DS      SETC  '&P'.'PARM'                                              00060000
         AIF   ('&NM' EQ '').HAVEDS                                     00070000
&DS      SETC  '&NM'                                                    00080000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00090000
&DS      DSECT ,             MAPPING OF INPWORK EXPANSION               00100000
         AGO   .COMDS                                                   00110000
.NODSECT ANOP  ,                                                        00120000
&DS      DS    0H            MAPPING OF INPWORK EXPANSION               00130000
.COMDS   ANOP  ,                                                        00140000
&P.DDNAM  DC   CL8' '        PRIMARY DDNAME                             00150000
&P.DDALT  DC   CL8' '        ALTERNATE DDNAME                           00160000
&P.EODAD  DC   A(1)          EODAD OR 0,1 IF NONE                       00170000
&P.EODAM  EQU  X'80'         WHEN ON, EODAD ENTERED AMODE 31, ELSE 24   00180000
&P.PPDE   DC   A(0)          POINTER TO RETURNED DIRECTORY DATA  89351  00190000
&P.WIDTH  DC   H'0'          LINE WIDTH FOR TRUNCATION                  00200000
          DC   H'0'               RESERVED                              00210000
&P.PRFG   DC   X'00'         OPTION FLAGS                               00220000
&P.FGABE  EQU  X'80'           ABEND IF OPEN FAILS/DD MISSING           00230000
&P.FGDUM  EQU  X'40'           ALLOW DD DUMMY (ELSE ABEND)              00240000
&P.FGNWTO EQU  X'20'           SUPPRESS WTO IF BAD OPEN AND NO ABEND    00250000
&P.FGJFCB EQU  X'10'           WORD FOLLOWING INPWORK IS JFCB FOR OPEN  00260000
&P.FGPDE  EQU  X'08'           USER REQUESTED PDE FEEDBACK       89351  00270000
&P.FG1BUF EQU  X'01'           SINGLE BUFFER (SHORT ON MEMORY)  GP08088 00280000
&P.FILL   DC   X'00'         FILL BYTE FOR PADDED RECORDS               00290000
&P.EDIT   DC   X'80'         EDIT OPTIONS (MATCH DCMFG1)                00300000
&P.FESET  EQU  X'80'           OPTION BITS SET (ELSE USE DEFAULTS)      00310000
&P.FEOSI  EQU  X'40'           OSI LINE NUMBER FORMAT                   00320000
&P.FEHWD  EQU  X'20'           HALF-WORD LINE NUMBERS                   00330000
&P.FEINT  EQU  X'10'           CREATE INTEGER LINE NUMBERS              00340000
&P.FEEDT  EQU  X'08'           CREATE EDIT LINE NUMBERS 4C.3C           00350000
&P.FETSO  EQU  X'04'           LINE NUMBERS LEFT-ADJUSTED IN RECFM=V    00360000
&P.FENB#  EQU  X'01'           INSERT LINE NUMBERS EVEN IF NON-BLANK    00370000
&P.PDS    DC   X'00'         PDS PROCESSING OPTIONS              89351  00380000
&P.FPDIR  EQU  X'80'           OPEN PDS DIRECTORY                89351  00390000
&P.FPMEM  EQU  X'40'           PROCESS ALL MEMBERS               89351  00400000
&P.FPALI  EQU  X'20'           ALSO PROCESS ALIAS ENTRIES        89351  00410000
&P.FPUPA  EQU  X'01'           BUILD ./ ADD CARDS                89351  00420000
&P.JFCB   DC   0A(0)         OPTIONAL JFCB ADDRESS FOR OPENJ OR 0       00430000
         MEND  ,                                                        00440000
./ ADD NAME=MAPINPWK
         MACRO ,                                        ADDED ON 90260  00010000
&NM      MAPINPWK &PREFIX=IP,&WIDTH=500 INPUT READER WORK AREA MAPPING  00020000
.*   UPDATED FOR ESA AND OS/390                                 GP98365 00030000
.*   UPDATED FOR DESERV AND CONCATENATED PDS & PDS/E SUPPORT    GP03244 00040000
         LCLC  &DS                                                      00050000
         LCLC  &P            SHORT PREFIX                               00060000
&P       SETC  '&PREFIX'                                                00070000
&DS      SETC  '&P'.'WORK'                                              00080000
         AIF   ('&NM' EQ '').NONAME                                     00090000
&DS      SETC  '&NM'                                                    00100000
.NONAME  ANOP  ,                                                        00110000
&DS      DSECT ,             MAPPING OF PRINT DCB AND WORK AREA         00120000
&P.LINK  DS    F             LINK TO NEXT GETMAINED AREA                00130000
&P.ID    DS    C'INP-'       ID OF INPUT FILE 'N'                       00140000
&P.SPLEN DS    F             SUBPOOL/LENGTH OF THIS AREA                00150000
&P.TCB   DS    A             ADDRESS OF OWNING TCB                      00160000
&P.DCB@  DS    X'90',AL3(&P.DCB)  DCB POINTER (24-BIT ADDRESS)          00170000
&P.PU@   DS    A             ADDRESS OF USER'S OPEN WORK AREA           00180000
&P.@SERV DS    A             ADDRESS OF @SERVICE ROUTINE                00190000
         SPACE 1                                                        00200000
&P.O2LVL DCBEXITD DSECT=NO,PREFIX=IX,LEVEL2=2                    90260  00210000
&P.WLIST SERVCOMP DSECT=NO,PFX=&P.D                              90260  00220000
&P.UFLAG DS    X             USER'S PROCESSING FLAGS                    00230000
&P.UFILL DS    C             FILL BYTE FOR SHORT RECORDS         81200  00240000
&P.FLAG  DS    X             PROCESSING FLAGS                           00250000
&P.FEOF  EQU   X'80'           END FILE READ                            00260000
&P.FEOM  EQU   X'40'           END MEMBER READ                   89352  00270000
&P.FEXT  EQU   X'20'           PDS EXTENSION PRESENT            GP03244 00280002
&P.FKEEP EQU   X'10'           RE-GET OF CURRENT RECORD                 00290000
&P.FWYL  EQU   X'08'           POTENTIAL WYLBUR EDIT BLOCK              00300000
&P.FWIL  EQU   X'04'           WYLBUR RECORD READY FOR DEBLOCK          00310000
&P.FACB  EQU   X'02'           PROCESSING ACB, NOT DCB           89360  00320000
&P.FASCI EQU   X'01'           TRANSLATE ASCII TO EBCDIC         82175  00330000
&P.BUFSP DC    X'00'         GETPOOL SUBPOOL NUMBER              85157  00340000
&P.ACB   ACB   DDNAME=SYSUT1,MACRF=(ADR,SEQ,IN)                  89360  00350000
&P.RPLEN DC    F'0'    1/2   LENGTH OF GOTTEN RPL                89360  00360000
&P.RPL@  DC    A(0)    2/2   ADDRESS OF GOTTEN RPL               89360  00370000
&P.RRN   DC    A(0)          RELATIVE RECORD NO. FEEDBACK        90201  00380000
         ORG   &P.ACB         RE-USE                             89360  00390000
&P.DCB   DCB   DDNAME=ANY,DSORG=PS,MACRF=GL,EROPT=ACC, OPTCD=Z,        *00400000
               EODAD=1,EXLST=&P.XLIST ,BFTEK=A                   82178  00410000
         ORG   ,             COMMON END OF ACB/DCB               89360  00420000
&P.XLIST DC    0A(0),X'87',AL3(0),A(0,0,0) +JFCB+@DCBEXIT+ABND   86272  00430000
&P.VCON  DC    F'0'          V-FORMAT RECORD HEADER                     00440000
&P.RECCC DC    C' '          CARRIAGE CONTROL                           00450000
&P.REC   DC    2CL(&WIDTH/2)' '     TEXT RECORD                         00460000
&P.TRUPP DS    A             UPPER CASE TRANSLATE OR NO-OP      GP04114 00470006
&P.WKEND DS    0D            END OF WORK AREA                           00480004
         SPACE 1                                                 89352  00490000
*        EXTENSION PRESENT WHEN USER REQUESTS PDS SERVICES       89352  00500000
&P.POD   DCB   DDNAME=ANY,DSORG=PS,MACRF=GL,RECFM=U,EODAD=1 DEODAD      00510000
         ORG   &P.POD         RE-USE                            GP03244 00520003
&P.DIR   DCB   DDNAME=ANY,DSORG=PS,MACRF=GL,EROPT=ACC,                 *00530003
               EODAD=1 EXLST=&P.XLIST                           GP03244 00540003
         ORG   ,             COMMON END OF ACB/DCB               89360  00550003
&P.PCARD DC    CL15'./       ADD   '   IEBUPDTE CARD             89352  00560000
&P.PCAME DC    CL65'SSI=XXXXXXXX,NAME=XXXXXXXX'  VARIABLE PART  GP10192 00570000
&P.CONCT DC    X'00'         CONCATENATION # FROM SMDEMLTK (0->255)     00580000
&P.PFLAG DC    X'00'         MORE FLAGS                         GP03244 00590001
&P.PFDE  EQU   X'80'           DESERV BUFFERS AVAILABLE         GP03244 00600001
&P.PFPDS EQU   X'20'           PROCESSING A PDS                 GP03244 00610002
&P.RSVD8 DC    X'00'         RESERVED                           GP03244 00620003
&P.@DSAB DC    A(0)          ADDRESS OF DSAB FOR INPUT DD       GP03244 00630005
&P.@POD  DC    A(&P.POD)      OPEN/CLOSE LIST                    89352  00640000
&P.PXLST DC    2A(0)         POD EXIT LIST/JFCB                  89352  00650000
&P.@ROOT DC    A(0)          ROOT OF DESERV BUFFERS             GP03244 00660005
&P.@DBXL DC    4A(0)         BXLE/@BUF FOR DESERV LOOP          GP03244 00670005
&P.@DSRV DC    A(0)          ADDRESS OF SUBDSERV ROUTINE        GP03244 00680005
&P.PDDNM DC    CL8' '        NAME OF DYNAMICALLY ALLOCATED DD   GP03244 00690005
&P.PJFCB DS    XL(JFCBLGTH)  JFCB FOR INDIVIDUAL MEMBER          89352  00700000
&P.PDSDE DS    XL(8+1+3+62)  (FAKE) DIRECTORY ENTRY             GP03244 00710005
&P.PBXLE SERVPDS PFX=PE,DSECT=NO,RETURN=YES,VER=1                89352  00720000
&P.PBXLN EQU   *-&P.PBXLE    LENGTH OF PDE WORK AREA             89352  00730000
&P.PWKND EQU   *             END OF PDS EXTENSION                89352  00740000
         MEND  ,                                                 90260  00750000
./ ADD NAME=MAPJOBDY
         MACRO ,                                       ADDED ON GP05020 00010000
         MAPJOBDY ,    MAP DYNWORK FOR EXHC$JCL AND EXHCX$J- OVERLAYS   00020000
.*    MUST BE PLACED AFTER MSECT ,                                      00030000
.*                                                                      00040000
EXHBSQSP DSECT ,                                                        00050000
         ORG   DYNWORK                                                  00060000
HAJCTTTR DS    F             JCT MTTR                                   00070000
HANUM    DS    H             JES2 JOB NUMBER                            00080000
HADSN    DS    H             DATASET COUNT                              00090000
HAQUE    DS    H             (MY) RELATIVE QUEUE NUMBER          78090  00100000
         SPACE 1                                                        00110000
HAFG     DS    X                                                        00120000
HAFJCT   EQU   X'80'           DISPLAY JCT INFORMATION           88284  00130000
HAFLOG   EQU   X'40'           DISPLAY JOB LOG                   88284  00140000
HAFJCL   EQU   X'30'           DISPLAY JCL DSN(S)                88284  00150000
HAFJCLI  EQU   X'20'           DISPLAY INPUT JCL (PRE-INP ONLY)  88284  00160000
HAFJCLO  EQU   X'10'           DISPLAY OUTPUT JCL                88284  00170000
HAFMSG   EQU   X'08'           DISPLAY MESSAGE DSN               88284  00180000
HAFTXT   EQU   X'04'           CONVERTER/INTERPRETER TEXT       GP05020 00190000
HAFQUE   EQU   X'02'           JOB QUEUE                        GP05020 00200000
HAFDSN   EQU   X'01'           DISPLAY DATA                      88284  00210000
HAFJOB   EQU   HAFDSN+HAFJCT+HAFLOG+HAFJCL+HAFMSG                88284  00220000
         SPACE 1                                                        00230000
HAFG2    DS    X                                                        00240000
HAFSLOG  EQU   X'80'           SYSLOG DISPLAY FUNCTION           88284  00250000
HAFSUM   EQU   X'40'           SUMMARY DISPLAY ONLY (WAS HAFMSG) 88284  00260000
HAFUSER  EQU   X'20'           USER SET OVERRIDING DSN #        GP05050 00270000
HAFSPIN  EQU   X'01'           SPIN PROCESSING FLAG              88284  00280000
HAADD    DS    H             ADD CONSTANT FOR S= AND T=          82353  00290000
         SPACE 1                                                        00300000
         MEND  ,                                                        00310000
./ ADD NAME=MAPJOBWK
         MACRO ,                                                        00010000
         MAPJOBWK &DOC=NO    COMMON I/O WORK AREA       ADDED ON 88094  00020000
         COPY  OPTIONS                                                  00030000
         GBLC  &VERSION,&JQENUML                                        00040000
&JQENUML SETC  '5'                                                      00050000
         AIF   ('&HASP' EQ 'JES2').LAB5                                 00060000
   AIF ('&VERSION'(1,1) LT '4' AND '&VERSION'(1,1) GE '0').LAB3         00070000
&JQENUML SETC  '4'           FOUR BYTE JOB NUMBER                       00080000
         AGO   .LAB5                                                    00090000
.LAB3    ANOP  ,                                                        00100000
&JQENUML SETC  '3'           THREE BYTE JOB NUMBER                      00110000
.LAB5    ANOP  ,                                                        00120000
IOWORK   DSECT ,                                                        00130000
         MAPIOWK ,           DEFINE $JCL WORK SPACE                     00140000
         PUSH  PRINT                                             88094  00150000
         AIF   ('&DOC' EQ 'NO').NODOC                            88094  00160000
         PRINT ON,GEN                                            88094  00170000
.NODOC   SPACE 1                                                        00180000
         ORG   DRBUF         RE-USE BUFFER SPACE FOR DATA               00190000
LOCDB    DC    2D'0'                                                    00200000
SAVE29   DC    8F'0'         SAVE AREA                                  00210000
SAFE6    DC    9F'0'         SECOND SAVE AREA                           00220000
JAWWORK  DS    0A            POINTERS AND STUFF                         00230000
JTIOT    DC    F'0'          CURRENT IOT ADDRESS                        00240000
JTIOTOF  DC    F'0'          CURRENT IOT OFFSET                         00250000
JTIOT1   DC    F'0'          FIRST IOT ADDRESS                          00260000
JTBUFAD  DC    F'0'          NEXT AVAILABLE DSIPLAY BUFFER LINE         00270000
JTDSKEY  DC    F'0'          DATABLOCK ID WORD                          00280000
OFFSDDB  DC    F'0'          IOT OFFSET TO FIRST PDDB (VAR. IN 1.6)     00290000
JSPIOT   DC    F'0'          CURRENT SPIN IOT ADDRESS                   00300000
JSPIOTOF DC    F'0'          CURRENT SPIN IOT OFFSET                    00310000
JSPIOT1  DC    F'0'          FIRST SPIN IOT ADDRESS                     00320000
JSPACCT  DC    CL4' ',CL8' ' CCSI ACCOUNT NUMBER (+PAD)                 00330000
PTRBASE  DC    A(0)          ADDRESS OF FIRST RECORD POINTER            00340000
PTRLAST  DC    A(0)          LAST AVAILABLE ENTRY                       00350000
PTRINT   DC    F'0'          ENTRY INTERVAL                             00360000
MAXLEN   DS    F'0'          CURRENT BUFFER SIZE                GP08362 00370000
RECFOUND DC    F'0'          LAST RECORD FOUND BY FIND                  00380000
HOROFF   DC    H'0'          HORIZONTAL INDENT (WINDOWING OPTION)       00390000
FNDLEN   DC    H'0'          LENGTH OF FIND TEXT                        00400000
FNDLEN2  DC    H'0'          LENGTH OF FIND TEXT2                88284  00410000
FNDTEXT  DC    CL40' '       COMPARE TEXT                               00420000
FNDTEXT2 EQU   FNDTEXT+20,20,C'C'  SUB-ALLOCATED SECOND STRING   88284  00430000
FNDDESC  DC    X'0000'       SYSLOG - DESCRIPTORS                88284  00440000
FNDTIME  DC    2CL6' '       SYSLOG - TIME RANGE                 88284  00450000
FNDFG    DC    X'00'         SYSLOG - CONTROL FLAG               88284  00460000
FFGDESC  EQU   X'80'           MATCH ON DESCRIPTOR CODE(S)       88284  00470000
FFGTIME  EQU   X'40'           MATCH ON TIME                     88284  00480000
FFGTIMED EQU   X'20'           TIME MATCHED                      88284  00490000
MODEFG   DC    X'0'          PROCESSING OPTIONS                         00500000
MFSCALE  EQU   X'80'           SHOW COLUMN SCALE                        00510000
MFNUM    EQU   X'40'           SHOW RCD NUMBERS ON EACH LINE            00520000
MFCC     EQU   X'20'           SHOW MACHINE OR ANSI CARR. CONTROL       00530000
MFWRAP   EQU   X'10'           DISPLAY FULL (WRAPPED) TEXT (NO WINDOW)  00540000
MFUPP    EQU   X'08'           FOLD UPPER CASE ON FIND                  00550000
MFHEX    EQU   X'04'           HEX TEXT                                 00560000
MFFIND   EQU   X'01'           FIND REQUEST MADE                        00570000
JSVFLAGS DC    X'00'         PRINT/SAVE FLAGS                           00580000
JFFAIL   EQU   X'80'           REQUEST IN ERROR                         00590000
JFERR    EQU   X'40'           ERROR DURING PROCESSING                  00600000
JFNULL   EQU   X'20'           NO DATA PROCESSED                        00610000
JFABE    EQU   X'01'           DCB ABEND ENTERED                        00620000
JSVCOUNT DC    F'0'          DATA SET RECORD COUNT                      00630000
JSVMTTR  DC    XL4'0'        DATA SET MTTR                              00640000
JSVRET   DC    XL4'0'        #RECS COPIED / SYS ABEND CODE / ERROR CODE 00650000
JSVCLEAR EQU   JSVFLAGS,*-JSVFLAGS,C'X'  AREA TO CLEAR IN $JC           00660000
         SPACE 1                                                        00670000
JADWORK  DS    0F            FUNCTION WORK AREA                         00680000
RECMAX   DC    F'0'          HIGHEST RECORD EVER READ                   00690000
CURTTR   DC    F'0'          TTR OF CURRENT BLOCK                       00700000
REQTTR   DC    F'0'          REQUESTED TTR                              00710000
CURREC   DC    F'0'          CURRENT RECORD NUMBER                      00720000
REQREC   DC    F'0'          REQUESTED RECORD NUMBER                    00730000
TOPREC   DC    F'0'          RECORD ON TOP OF PAGE                      00740000
CURROF   DC    F'0'          OFFSET TO CURRENT RECORD IN BLOCK  GP08362 00750000
TOPTTR   DC    F'0'          BLOCK OF TOP LINE                  GP08362 00760000
TOPOFF   DC    F'0'          OFFSET OF TOP LINE                 GP08362 00770000
TOPFG    DC    X'00'         EXT. FUNCTION FLAG                 GP08362 00780000
TFSET    EQU   X'80'           TOP TTR/OFF SET                  GP08362 00790000
TFRET    EQU   X'40'           RETURN - RESET TO TOP            GP08362 00800000
TFERR    EQU   X'20'           ERROR DURING SAVE/PRINT          GP08362 00810000
PROFG    DC    X'00'         PROCESSING FLAG                            00820000
PFEOF    EQU   X'80'           END-FILE PROCESSED                       00830000
PFMSG    EQU   X'01'           EOF MSG ON SCREEN                        00840000
SAVECC   DS    C             CARRIAGE CONTROL FOR CURRENT RECORD        00850000
SAVFLAG1 DS    X             COPY OF LRCFLAG1                           00860000
TOPMSG   DC    CL20' '       ERROR MESSAGE FROM SAVE/PRINT/FIND GP08362 00870000
JAWCLEAR EQU   JAWWORK,*-JAWWORK,C'A'  GLOBAL CLEAR                     00880000
JADCLEAR EQU   JADWORK,*-JADWORK,C'A'  FUNCTION CLEAR                   00890000
         SPACE 1                                                        00900000
JTPROC   DS    CL8,C         PROC STEP                                  00910000
JTSTEP   DS    CL8,C         STEP NAME                                  00920000
JTDDN    DS    0CL8,C        DDNAME                                     00930000
JTITLE   DS    CL7,C         TITLE - JCT/LOG/JCL/MSG/DSN=NNN            00940000
JQUE     DS    CL4,C         QUEUE                                      00950000
JNAME    DS    CL8,C         JOB NAME                                   00960000
JCTLPA1  DS    C'('                                                     00970000
JNUM     DS    CL&JQENUML    JOB NUMBER                                 00980000
JCTLPA2  DS    C') '                                                    00990000
JCTTRA   DS    CL8           TTR OF JCT OR CURRENT MTTR                 01000000
JTSHORT  EQU   JTDDN,*-JTDDN,C'C'  NARROW TITLE                         01010000
JTWIDE   EQU   JTPROC,*-JTPROC,C'C'  WIDE TITLE                         01020000
IOBUF    DS    0D ,          INPUT BUFFER FOR JCT/IOT/BUFFER            01030000
         POP   PRINT                                             88094  01040000
         MEND  ,                                                        01050000
./ ADD NAME=MAPLODCB
         MACRO ,                                                        00010000
&NM      MAPLODCB &PFX=LOD,&DSECT=YES                            87280  00020000
.*   EXHIBIT - SUPPORT FOR JESx LOAD LIBRARIES                          00030000
         LCLC  &P,&N                                                    00040000
&N       SETC  '&NM'                                                    00050000
&P       SETC  '&PFX'                                                   00060000
         AIF   ('&NM' NE '').OK                                         00070000
&N       SETC  '&P'.'CB'                                                00080000
.OK      AIF   ('&DSECT' EQ 'NO').NOS                                   00090000
&N       DSECT ,                                                        00100000
         AGO   .COMM                                                    00110000
.NOS     AIF   ('&NM' EQ '').COMM                                       00120000
&NM      DS    0F                                                       00130000
.COMM    ANOP  ,                                                        00140000
&P.LINK  DC    A(0)          POINTER TO NEXT ENTRY                      00150000
&P.SPLEN DC    A(0)          SUBPOOL/LENGTH OF THIS BLOCK               00160000
&P.DDNM  DC    CL8'LOADXXXX'  DDNAME OF ENTRY                           00170000
&P.DCB   DCB   DDNAME=LOADXXXX,DSORG=PO,DEVD=DA,MACRF=(E)               00180000
&P.SIZE  EQU   *-&P.LINK                                                00190000
         MEND  ,                                                        00200000
./ ADD NAME=MAPMTS
         MACRO ,                                                        00010000
&NM      MAPMTS &TYPE=DSECT,&PFX=MTS,&MODE=,&FLAVOR=EXHIBIT,           *00020000
               &ACB=MYACB,&ETX=XETXR,&EPLOC=EXHABASS,            87012 *00030000
               &MAXLINE=62,&MAXWITH=160                          92269  00040000
.*  EXHABASE CREATED TABLE FOR EACH EXHIBIT SESSION                     00050000
         LCLC  &P,&LACB,&LETX,&LLOC                                     00060000
&LACB    SETC  '&ACB'                                                   00070000
&LETX    SETC  '&ETX'                                                   00080000
&LLOC    SETC  '&EPLOC'                                                 00090000
&P       SETC  'MTS'                                                    00100000
         AIF   ('&PFX' EQ '').NOP                                       00110000
&P       SETC  '&PFX'                                                   00120000
.NOP     AIF   ('&TYPE' NE 'DSECT').NOD                                 00130000
&P.WORK  DSECT ,             MULTI-TASKING MODE SUBTASK WORK AREA       00140000
&LACB    SETC  '1'                                                      00150000
&LETX    SETC  '1'                                                      00160000
&LLOC    SETC  '1'                                                      00170000
         AIF   ('&NM' EQ '').NONM                                89065  00180000
.NOD     ANOP  ,                                                        00190000
&NM      DS    0F                                                       00200000
.NONM    ANOP ,                                                  89065  00210000
&P.ID    DC    0CL4'MTS '    VECTOR TABLE SELF-ID                       00220000
&P.NIB   NIB   MODE=RECORD,PROC=TRUNC                                   00230000
&P.WRPL  RPL   AM=VTAM,ACB=&LACB,STYPE=REQ,CONTROL=DATA,POST=RESP,     *00240000
               BRACKET=(BB,NEB),RTYPE=DFSYN,OPTCD=(ASY,CA),            *00250000
               RESPOND=(NEX,FME,NRRN),NIB=&P.NIB                        00260000
&P.CRPL  RPL   AM=VTAM,ACB=&LACB,STYPE=REQ,CONTROL=DATA,POST=RESP,     *00270000
               OPTCD=SYN,RESPOND=(NEX,FME,NRRN),NIB=&P.NIB              00280000
&P.PDCB  DCB   DSORG=PS,MACRF=PM,DDNAME=EXHPRINT,EROPT=ACC,            *00290000
               RECFM=VBA,LRECL=137,BLKSIZE=689                          00300000
&P.PMG14 VCON  'EXH414E EXHPRINT ABENDED XXX-CC '                       00310000
&P.PRDD  EQU   &P.PMG14+4+8,8,C'C'   PRINT DCB DDNAME (DYNALLOC)        00320000
&P.DEB   DC   4A(0),X'05',AL3(0),X'FF',AL3(0),X'0F',AL3(0),X'02',AL3(0) 00330000
&P.DEBND DC    X'33',AL3(0)  UCB POINTER FOR CRT                        00340000
         DC    3AL1(X'73',0,0,0)  DUMMY EXTENTS                         00350000
&P.DEBPR DC    X'37',AL3(0)  PRINTER UCB POINTER                        00360000
&P.UCB   DC    0A(0),X'0000FF88',X'00AF0000',X'00000000',X'00',C'VTM'   00370000
         DC    X'12501009',A(0,0,0,0,0,0)                               00380000
&P.UCBX  DC    6A(0)                                                    00390000
&P.UCBD  DC    2A(0)         DDT                                        00400000
&P.ATT7  DC    18A(0)        ENOUGH ROOM FOR SP2 ATTACH          93270  00410000
         ORG   &P.ATT7                                           93270  00420000
&P.ATT   ATTACH EPLOC=&LLOC,ETXR=&LETX,SZERO=NO, STAI=XESTAI,          *00430000
               ASYNCH=NO,PURGE=NONE,SF=L                                00440000
         ORG   ,             ALLOW EITHER LENGTH ATTACH          93270  00450000
&P.CSCB  DC    A(0,0),CL8'ID',CL8'EXHABASE',CL3'UCB',5AL1(0)            00460000
         DC    4A(0),X'00',CL7' ',2A(0),C'CSCB'                         00470000
         ORG   &P.CSCB+X'DC'                                    GP97290 00480000
&P.CSCX  DC    A(&P.CSCB+32) CSCB EXTENSION OVERLAPS FAKE CSCB  GP97290 00490000
         ORG   ,                                                GP97290 00500000
         AIF   ('&PFX' EQ 'PAT').MEND                                   00510000
         SPACE 1                                                        00520000
&P.QLINK DC    A(0)          LINK TO NEXT AREA ON CHAIN                 00530000
&P.SAVER DC    16F'0'        SUBROUTINE SAVE AREA                       00540000
&P.SAVES DC    16F'0'        SECOND SUBROUTINE SAVE AREA                00550000
&P.INPAD DC    A(&P.BUFIN) 1/2  INPUT BUFFER                            00560000
&P.INPLN DC    F'0'       2/2  SIZE OF SAVED INPUT                      00570000
&P.WECB  DC    A(0)                                                     00580000
&P.FEAT  DC    0A(0),XL18'0' FEATURE/SIZE INFORMATION                   00590000
&P.SCRSZ EQU   &P.FEAT+6,4,C'Y'  TERMINAL SIZES (ROWS ; COLUMNS)        00600000
&P.BUFSZ EQU   &P.FEAT+4,2,C'Y'  TERMINAL SIZE (ROWS * COLUMNS)  89327  00610000
&P.ROWS  EQU   &P.FEAT+8,2,C'Y'  ROWS ON SCREEN                  89327  00620000
&P.COLS  EQU   &P.FEAT+10,2,C'Y' COLUMNS ON SCREEN               89327  00630000
&P.FLGV  DC    X'00'         SPECIAL PROCESSING FLAGS                   00640000
&P.FBKER EQU   X'80'           BRACKET ERROR (RECOVERY)          87257  00650000
&P.FENAT EQU   X'10'           RE-ENABLE ATTENTIONS AFTER WRITE         00660000
&P.UA90  EQU   X'04'           SKIP UNSOLICITED 3290 ATTENTION   94073  00670000
&P.FRSVP EQU   X'02'           NEXT WRITE IS A RESPONSE                 00680000
&P.FVONC EQU   X'01'           FIRST TIME FLAG;  POSSIBLE RACE ERROR    00690000
         SPACE 1                                                        00700000
&P.FLGT  DC    X'00'         TERMINAL STATUS FLAGS                      00710000
&P.FGONE EQU   X'80'           TERMINAL IS GONE                         00720000
&P.FXEND EQU   X'40'           EXECUTION TO BE ENDED             89327  00730000
&P.FGOIN EQU   X'20'           GRADUAL SHUT-DOWN (QUIESCE)       90231  00740000
&P.FNSTA EQU   X'08'           SKIP STAE MSGS (DONE BY ESPIE)    93185  00750000
&P.FTTIM EQU   X'02'           FIRST INPUT WAIT INTERVAL EXPIRED 92108  00760000
&P.FBUG  EQU   X'01'           DEBUG TRACE REQUEST                      00770000
&P.SAVE4 DC    18F'0'        SAVE AREA                                  00780000
&P.PDCBX DC    0A(0),X'91',AL3(0)    DCB ABEND EXIT                     00790000
         SPACE 1                                                        00800000
&P.DDB   DC    D'0'          DOUBLE WORD WORK AREA                      00810000
&P.SAVCK DC    5A(0)         RPL CHECK ROUTINE SAVE AREA                00820000
&P.NAPPL DC    CL8' '        NEXT APPLICATION OR NULL                   00830000
&P.@WORK DC    A(0)          ADDRESS OF WORK AREA                       00840000
&P.@SQSP DC    A(0)          ADDRESS OF SQA WORK AREA                   00850000
&P.TASK  DC    A(0)          ADDRESS OF SUBTASK                         00860000
&P.ERRCT DC    F'0'          CONSECUTIVE I/O ERROR COUNT                00870000
&P.@PARM DC    A(0) ATTPARM  POINTER TO PARM OPTIONS                    00880000
&P.@MTV  DC    A(0) MTVECT   POINTER TO MAIN-TASK AREA                  00890000
&P.UID   DC    CL8' '        NAME OF USER                        87012  00900000
&P.ACCT  DC    CL8' ',CL4' '   ACCOUNT + SPARE                   87012  00910000
&P.LOUD  DC    A(0)          LOCAL ONLINE USER DATA              89107  00920000
&P.#WRIT DC    A(0)          WRITE I/O COUNT                            00930000
&P.#READ DC    A(0)          READ I/O COUNT                             00940000
&P.PRVWR DC    2A(0)         ADDRESS/LENGTH OF LAST FULL-SCREEN WRITE   00950000
&P.CURSA DC    A(0)          CURSOR ADDRESS                             00960000
&P.BFEND DC    A(0)          LOGICAL BUFFER END                         00970000
&P.SPARM DC    0A(0)         COMPRESSION ROUTINE PARMS           90147  00980000
&P.CMPO@ DC    A(0)          OUTPUT BUFFER ADDRESS               90147  00990000
&P.CMPOL DC    A(0)          ADDRESS OF MAX/ACT OUTPUT LENGTH    90147  01000000
&P.CMPI@ DC    A(0)          INPUT BUFFER ADDRESS                90147  01010000
&P.CMPIL DC    A(0)          ADDRESS OF INPUT LENGTH             90147  01020000
&P.CMPB@ DC    A(0)          ADDRESS OF BUFFER SIZE              90147  01030000
&P.CMPF@ DC    A(0)          ADDRESS OF OPTION FLAGS             90147  01040000
&P.CMPC@ DC    A(0)          ADDRESS OF COLOR CONVERSION TABLE   90147  01050000
&P.CMPTY DC    A(0)          ADDRESS OF TTY TYPE FOR SIMULATION  93331  01060000
         DC    A(0)            SPARE                             90147  01070000
&P.CMPOS DC    A(0)          OUTPUT LENGTH (MAX, THEN RESULT)    90147  01080000
&P.CMPIS DC    A(0)          INPUT LENGTH                        90147  01090000
&P.CMPBS DC    A(0)          BUFFER SIZE                         90147  01100000
&P.CMPFG DC    X'00'         REQUESTED FUNCTIONS                 90147  01110000
&P.CMFSF EQU   X'80'           INSERT PROT. SF IF NO SF IN LINE 2       01120000
&P.CMNCM EQU   X'40'           BYPASS BUFFER COMPRESSION, ETC.   90147  01130000
&P.CMNCO EQU   X'20'           BYPASS COLOR SUBSTITUTION         90147  01140000
&P.CMESC EQU   X'10'           BUFFER MAY CONTAIN ESCAPE (BTAM)  90147  01150000
&P.CMCCW EQU   X'08'           BUFFER CONTAINS CCW               90147  01160000
&P.CMWCC EQU   X'04'           BUFFER CONTAINS WCC/PCC           90147  01170000
&P.CMCCO EQU   X'01'           O/P BUFFER HAS CCW @ ADDR-1       93331  01180000
&P.CMPFA DC    X'00'         ADDRESSING MODE                     90147  01190000
&P.CMA16 EQU   X'02'           USE 16-BIT ADDRESSING ONLY        90147  01200000
&P.CMA14 EQU   X'01'           14-BIT ADDRESSING SUPPORTED       90147  01210000
&P.CMPFC DC    X'00'         COLOR MODE                          90147  01220000
&P.CMCO7 EQU   X'07'           7-COLOR MODE                      90147  01230000
&P.CMCOB EQU   X'70'           BACKGROUND COLOR AVAILABLE        90147  01240000
&P.CMPFH DC    X'00'         EXTENDED HIGH-LIGHTING              90147  01250000
&P.CMHI7 EQU   X'07'           ALL EXTENDED HIGH-LIGHTING        90147  01260000
&P.CMPFM DC    X'00'         MISCELLANEOUS OPTIONS               90147  01270000
&P.CMVAL EQU   X'80'           FIELD VALIDATION SUPPORTED        90147  01280000
&P.CMOUT EQU   X'40'           FIELD OUTLINING                   90147  01290000
&P.CMGE  EQU   X'08'           GRAPHICS ESCAPE PROCESSING        91101  01300000
         DC    X'00'         SPARE                               90147  01310000
         DC    X'00'         SPARE                               90147  01320000
         DC    X'00'         SPARE                               90147  01330000
&P.PPARM DC    CL8' '        PRINT WORK WORDS                           01340000
&P.PLINE DC    H'0'          LNE WORK AREA                              01350000
&P.PLIN# DC    H'-1'                                                    01360000
&P.PPRFX DC    XL5'0'        SAVE AREA FOR LEN, FGS, CC ON H BOUND      01370000
&P.PPRCC EQU   &P.PPRFX+4,1,C'C'  SAVED CARRIAGE CONTROL                01380000
&P.FLGM  DC    X'00'         CONTROL FLAG                               01390000
&P.FREAD EQU   X'80'           DISPLAY READ INPUT INSTEAD OF WRITE      01400000
&P.FSFO  EQU   X'40'           START FIELD ORDER FOUND                  01410000
&P.FNOND EQU   X'20'           NON-DISPLAY FIELD                        01420000
&P.FFSF  EQU   X'10'           FAKE SF TO BE INSERTED                   01430000
&P.FNCOL EQU   X'08'           BYPASS COLOR MAPPING              87172  01440000
&P.FNCMP EQU   X'02'           BYPASS COMPRESSION (AND COL.MAP)         01450000
&P.FATTN EQU   X'01'           WRITE INTERRUPTED BY ATTN                01460000
&P.PPAG# DC    PL3'0'        PAGE NUMBER                                01470000
&P.TRMTY DC    X'00'         - RESERVED FOR TERMINAL TYPE               01480000
         DC    X'00'                                                    01490000
&P.TRMFG DC    X'00'         TERMINAL MODE FLAGS                        01500000
&P.FAUCR EQU   X'80'           IF ON, SKIP CR IF LEN=WIDTH              01510000
&P.FAULF EQU   X'40'           IF ON, CR INCLUDES LF                    01520000
&P.FSAS  EQU   X'10'           SAS TPUT CONTROL MODS ON TCAM            01530000
&P.FVTAM EQU   X'08'           VTAM TERMINAL (DIRECT OR TSO)     89065  01540000
&P.FWYLB EQU   X'04'           RUNNING AS WYLBUR SUBSYSTEM       91267  01550000
         AIF   ('&FLAVOR' NE 'KERMIT').NOTKERM                   89327  01560000
&P.ATECB DC    F'0'          ATTENTION ECB                       89327  01570000
&P.CNECB DC    F'0'          CANCEL ECB                          89327  01580000
&P.TMECB DC    F'0'          STIMER ECB                          89327  01590000
&P.TLIST DC    A(&P.TMECB)   ECB LIST WITH TIMER                 89327  01600000
&P.ELIST DC    A(&P.ATECB,&P.CNECB),X'80',AL3(&P.WECB)           89327  01610000
&P.GETLN DC    A(0)          GETLINE ROUTINE ADDRESS             89327  01620000
&P.PUTLN DC    A(0)          PUTLINE ROUTINE ADDRESS             89327  01630000
&P.PUTFS DC    A(0)          FULL-SCREEN PUT                     89327  01640000
&P.PUTPG DC    A(0)          PUT STRUCTURED FIELD/RESPONSE       89327  01650000
&P.LOGOF DC    A(0)          LOGOFF EXIT                         89337  01660000
&P.COMND DC    A(0)          COMMAND (PRE)PROCESSING             89337  01670000
&P.DDACC DC    A(0)          DDNAME ACCESS CONTROL CHECKING      89337  01680000
         DC    4A(0)           RESERVED ...                      90049  01690000
&P.DDNIO DC    CL8' '        DYN.ALL.DDN FOR I/O FILES           90049  01700000
&P.DDNCT DC    CL8' '        DYN.ALL.DDN FOR CONTROL FILES       90049  01710000
         DC    1A(0)           RESERVED ...                      90049  01720000
&P.TETOA DC    A(0)          EBCDIC TO ASCII TRANSLATE TABLE     91315  01730000
&P.TATOE DC    A(0)          ASCII TO EBCDIC TRANSLATE TABLE     91315  01740000
&P.KMXPK DC    A(0)          MAX PACKET IF NON-ZERO              91267  01750000
.*                           ZAP SPACE                           89327  01760000
.*                           ZAP SPACE                           89327  01770000
&P.SMF   DS    0F                  SMF TS STEP TERMINATION RECORD       01780000
&P.RLEN  DS    BL2'0'    RECORD LENGTH                           89337  01790000
&P.RSEG  DS    BL2'0'    SEGMENT DESCRIPTOR                      89337  01800000
&P.RFLG  DC    BL1'0'              HEADER FLAG BYTE              89337  01810000
&P.RCDTY DC    BL1'0'              RECORD TYPE (34 DECIMAL)      89337  01820000
&P.RCDTS DC    BL4'0'              TIME STAMP  TOD .01 SECS      89337  01830000
&P.RCDTE DC    PL4'0000'                       DATE 00YYDDDF     89337  01840000
&P.CPUID DC    CL4' '              CPU IDENTIFICATION (SYSTEM, MODEL)   01850000
&P.UIF   DC    CL8' '              USER IDENTIFICATION FIELD     Y02901 01860000
&P.ONTME DC    BL4'0'              LOGON TIME  TOD .01 SECS      89337  01870000
&P.ONDTE DC    PL4'0000'                       DATE 00YYDDDF     89337  01880000
&P.UDATA DC    CL8' '              RESV FOR USER                 89337  01890000
&P.INVSQ DC    BL1'0'              STEP SEQUENCE NUMBER          89337  01900000
&P.SIT   DC    BL4'0'              TOD STEP INITIATION         @YL026WA 01910000
&P.OUTCT DC    BL4'0'              LINE OUT COUNT                89337  01920000
&P.INCT  DC    BL4'0'              LINE IN COUNT                 89337  01930000
&P.STAT  DC    BL2'0'              STEP TERMINATION STATUS       89337  01940000
&P.PRI   DC    BL1'0'              STEP DISPATCHING PRIORITY     89337  01950000
&P.PRGNM DC    CL8' '              NAME OF PROGRAM INVOKED       89337  01960000
&P.INVNM DC    CL8' '              STEP (PROC) NAME              89337  01970000
&P.EFRGN DC    BL2'0'              EFFECTIVE REGION SIZE IN 1K BLKS     01980000
&P.SYST  DC    BL2'0'              SYST AREA USED, TOP PRI AREA  Y02901 01990000
&P.MCRE  DC    BL2'0'              CORE ACTUALLY USED IN  1K BLKS       02000000
&P.RVC   DC    BL6'0'              RESERVED                      89337  02010000
&P.SPK   DC    BL1'0'              STORAGE PROTECT KEY           A40791 02020000
&P.STI   DC    BL1'0'              STEP TERMINATION INDICATORS   89337  02030000
*                        BIT6 - 0=NORMAL COMPLETION              89337  02040000
*                               1=ABEND                          89337  02050000
&P.RV1   DC    BL2'0'              RESERVED                      A40791 02060000
&P.AST   DC    BL4'0'              ALLOC. START TIME             A40791 02070000
&P.PPST  DC    BL4'0'              PROBLEM PROG. START TIME      A40791 02080000
&P.RV2   DC    BL1'0'              RESERVED                    @YL026WA 02090000
&P.SRBT  DC    BL3'0'              STEP CPU UNDER SRB(.01 SEC) @YL026WA 02100000
&P.RIN   DC    BL2'0'              RECORD INDICATORS             89337  02110000
&P.RLCT  DC    BL2'0'              OFFSET TO RELOCATE SECTION    89337  02120000
&P.VAR   DC    BL2'0'              LENGTH OF EXCP COUNT FIELDS   89337  02130000
*                                  (INCLUDING THESE TWO BYTES)   89337  02140000
&P.EXCP  EQU   *                   DEVICES USED AND EXCP COUNTS  89337  02150000
*                                                                89337  02160000
*                                  EACH ENTRY                    89337  02170000
*                                                                89337  02180000
&P.DEVC  DC    BL1'0'              DEVICE CLASS                  89337  02190000
&P.UTYP  DC    BL1'0'              UNIT TYPE                     89337  02200000
&P.CUAD  DC    BL2'00'             CHANNEL/UNIT ADDRESS          89337  02210000
&P.VDV   EQU   X'80'               VIRTUAL INDICATOR           @Y30AQPF 02220000
&P.NEXCP DC    BL4'0'              EXCP COUNT                    89337  02230000
*                                                                89337  02240000
&P.OXCP  DC    XL8'0'        OUTPUT COUNTS                       89337  02250000
&P.VARA  DC    BL1'0'              LENGTH OF CPU AND ACCT. SECTION      02260000
*                                  (NOT INCLUDING THIS BYTE)     89337  02270000
&P.CPUTM DC    BL3'0'              STEP CPU UNDER TCB(.01 SEC) @YL026WA 02280000
&P.NBRAC DC    BL1'0'              NUMBER OF ACCOUNTING FIELDS   89337  02290000
&P.RCEND EQU   *             END OF SMF RECORD                   89337  02300000
&P.STAXP DC    5A(0)         STAE PARAMETER AREA                 89327  02310000
&P.SAVPR DC    X'0'          GLOBAL PRIVILEGE FLAGS              89327  02320000
&P.SAVPO DC    X'0'          ADDITIONAL OPTIONS                  89327  02330000
&P.SAFIO EQU   X'80'         DELAY IF INTERVENTION REQ.          89327  02340000
&P.SAFIG EQU   X'40'         DELAY IF ANY ERROR                  89327  02350000
&P.SAFSH EQU   X'20'         MULTIPLE INPUT CRTS PER TASK        89327  02360000
&P.SAPRM EQU   X'10'         WRITE PROMPT ON DISPLAY CYCLE       89327  02370000
&P.SNGAM EQU   X'08'         GAMES NOT PERMITTED ON THIS CRT     89327  02380000
&P.SAMUL EQU   X'02'           MULTI-TASKING ENVIRONMENT         89327  02390000
&P.SAFVM EQU   X'01'         RUNNING UNDER VM                    89327  02400000
&P.SEDFG DC    X'00'         EDIT OPTIONS FOR SQEXCP             89327  02410000
&P.SENED EQU   X'80'           BYPASS EDITING                    89327  02420000
&P.SENCM EQU   X'40'           BYPASS BUFFER COMPRESSION         89327  02430000
&P.SENCT EQU   X'20'           BYPASS COMPR. ON NEXT WRITE ONLY  89327  02440000
&P.SENCO EQU   X'10'           BYPASS COLOR MAPPING ON NEXT WRT  89327  02450000
         DC    X'00'         RESERVED                            89327  02460000
&P.SECFG DC    X'00'         SECURITY FLAGS                      89327  02470000
&P.SECRQ EQU   X'80'           SIGNON REQUIRED                   89327  02480000
&P.SECMD EQU   X'20'           SIGNON REQ. FOR ANY CONV.         89327  02490000
&P.SECUN EQU   X'40'           SIGNON FOR PRIV. ONLY             89327  02500000
&P.SECON EQU   X'02'           USER SIGNED ON                    89327  02510000
&P.SIMFG DC    X'00'         EXTENDED FLAGS                      89327  02520000
&P.SICRT EQU   X'80'           OUTPUT IS TO A CRT                89327  02530000
&P.SIPRT EQU   X'40'           PRINTED OUTPUT REQUESTED          89327  02540000
&P.SITSO EQU   X'20'           TSO FLAG (SAME AS OPTSO)          89327  02550000
&P.SIVTM EQU   X'10'           RUNNING UNDER VTAM                89327  02560000
&P.SIFSC EQU   X'08'           FULL-SCREEN I/O SUPPORT PRESENT   89327  02570000
&P.SIF78 EQU   X'04'           EXTENDED HIGH-LIGHTING AVAILABLE  89327  02580000
&P.SIF79 EQU   X'02'           SEVEN-COLOR SUPPORT AVAILABLE     89327  02590000
&P.SINPR EQU   X'01'           PRINT FUNCTION PERMANENTLY DISABLED      02600000
.NOTKERM SPACE 2                                                        02610000
&P.PTITL DC    0A(0),CL137' '                                           02620000
         ORG   &P.PTITL                                                 02630000
&P.PH137 DC    H'137,0',C'1'                                            02640000
&P.PTITX DC    CL60'     *****     EXHIBIT TERMINAL ACTIVITY LOG     ***02650000
               ***     '                                                02660000
&P.PTITE DC    C'RUN ON '                                               02670000
&P.PTIDT DC    CL6'YY.DDD',C' AT '                                      02680000
&P.PTITM DC    CL8'HH:MM:SS',CL4' '                                     02690000
         DC    C'PAGE'                                                  02700000
&P.PTIPG DC    C'123456'                                                02710000
&P.PTILE EQU   &P.PTITE-&P.PTITX                                        02720000
         ORG   &P.PTITL+137                                             02730000
&P.PVLIN DC    0A(0),AL2(137,0)    PRINT LINE                           02740000
&P.PFLIN DC    CL133' '      PRINT DATA                                 02750000
         ORG   &P.PFLIN+5                                               02760000
&P.PLNDC DC    C'WRITE AT LINE '                                        02770000
&P.PLNAD DC    C'  ',C'   **'                                           02780000
&P.PLNTX DC    CL80' ',C'**'                                            02790000
         ORG   &P.PVLIN+138 ,   SET FOR NEXT LINE                       02800000
&P.PVLN2 DC    0A(0),AL2(137,0)    PRINT LINE 2                         02810000
&P.PFLN2 DC    CL133' '      PRINT DATA                                 02820000
&P.BINDS DC    XL120'0'      SESSION INFO (CURR MAX IS 88 BYTES)        02830000
&P.STAVC VCON   'EXH513E EXHIBIT  ABENDED SXXX; APSW=FF00CCCC FFAAAAAA;*02840000
                PSW=FF00CCCC FFAAAAAA'   STAE ABEND MESSAGE             02850000
&P.STAMG EQU   &P.STAVC+4,*-&P.STAVC+4,C'C'                             02860000
&P.STADB DC    D'0'          STAE WORK SPACE                            02870000
         DC    CL73' '       WITH ABOVE, REGISTER FORMAT AREA           02880000
         SPACE 1                                                        02890000
*        BUFFER PREFIX FOR 3180 EXPLICIT PARTITION DATASTREAM    88243  02900000
&P.XPART DC    X'F3000A0C'   CCW; SIZE; CREATE PARTITION         88243  02910000
&P.XPNM  DC    X'00',X'0000' PART.ID; CELL, 12/14 BIT; UNPROT    88243  02920000
&P.XPROW DC    X'0018'       ROWS                                88243  02930000
&P.XPCOL DC    X'0050'       COLUMNS                             88243  02940000
&P.DSSIZ DC    X'0000'       SIZE OF DATA STREAM                 88243  02950000
         DC    X'4000'       3270DS ID; CCW FOLLOWS              88243  02960000
&P.PRCCW DC    X'F5'         CCW CODE FOR WRITE TYPE                    02970000
&P.BUFF  DC    (&MAXLINE)CL&MAXWITH' '    WORK BUFFER            92269  02980000
&P.BUFND DC    (&MAXLINE/2+1)CL&MAXWITH' ' MSG LINE / COLOR+HILIGHT     02990000
&P.BUFLN EQU   &P.BUFND-&P.BUFF   BUFFER LENGTH                         03000000
&P.BUFIN DC    CL256' ' 1/2  INPUT AREA  (TTY-WHOLE, CRT 1/2)           03010000
&P.BUFTY DC    (&MAXLINE)CL(&MAXWITH+3)' '  LEAVE ROOM FOR ATB PER LINE 03020000
*                                       2/2 (TTY-PREV.BUF, CRT - INPUT) 03030000
&P.BUFIL EQU   *-&P.BUFIN    LENGTH OF INPUT BUFFER              93190  03040000
&P.WORKL EQU   *-&P.WORK     LENGTH OF STORAGE                          03050000
.MEND    MEND  ,                                                        03060000
./ ADD NAME=MAPPARSE
         MACRO ,                                                        00010000
&NM      MAPPARSE &DSECT=YES,&PFX=PAR                  NEW 2003.091 GYP 00020000
.*--------------------------------------------------------------------* 00030000
.*  THIS MACRO MAPS THE USER'S REQUEST PARAMETERS FOR @PARSER         * 00040000
.*--------------------------------------------------------------------* 00050000
         LCLC  &P                                                       00060000
&P       SETC  '&PFX'                                                   00070000
         AIF   ('&DSECT' NE 'YES').ALTSECT                              00080000
&PFX.DSECT DSECT ,                                                      00090000
         AGO   .NODSECT ,                                               00100000
.ALTSECT ANOP  ,                                                        00110000
&PFX.DSECT  DS 0D            PLANT A LABEL                              00120000
.NODSECT AIF   ('&NM' EQ '').NOLABEL                                    00130000
&NM      DS    0F                                                       00140000
.NOLABEL AIF   ('&NM' EQ '&PFX'.'PARM').NOLPARM                         00150000
&PFX.PARM   DS 0F            DEFINE START OF PARM                       00160000
.NOLPARM ANOP  ,                                                        00170000
.*--------------------------------------------------------------------* 00180000
.*  USER'S INFO: TEXT ADDRESS/LENGTH/KEYWORDS/FLAGS/REQUESTS          * 00190000
.*--------------------------------------------------------------------* 00200000
&PFX.@TEXT  DC A(0)          ADDRESS OF TEXT TO BE PARSED               00210000
&PFX.#TEXT  DC F'0'          LENGTH OF TEXT                             00220000
&PFX.@KEYS  DC A(0)          ADDRESS OF KEYWORD TABLE (OPTIONAL)        00230000
.*                                                                      00240000
&PFX.$TYPE  DC X'00'         REQUEST FLAGS (PARSE OPT=)                 00250000
&PFX.$TPBK  EQU X'00'          SEPARATE WORDS BY SPACES ONLY            00260000
&PFX.$TPBC  EQU X'01'          SEPARATE BY COMMAS AND SPACES            00270000
&PFX.$TPKW  EQU X'02'          SEPARATE BY =, COMMAS, SPACES            00280000
&PFX.$TPLS  EQU X'03'          SEPARATE BY =, COMMAS, SPACES, LISTS     00290000
&PFX.$TPLI  EQU X'04'          SEPARATE BY =, COM, SPC, LIST ITEMS      00300000
&PFX.$RQFG  DC X'00'         REQUEST PROCESSING FLAGS                   00310000
&PFX.$PARK  EQU X'80'          TREAT XXX(YYY) AS KEYWORD=, NOT DSN(MEM) 00320000
&PFX.$COSP  EQU X'40'          TREAT (XX,YY) AS SEPARATE TEXT STRINGS   00330000
&PFX.$COKW  EQU X'20'          TREAT : COLON AS KEYWORD SEPARATOR       00340000
&PFX.$COUQ  EQU X'10'          STORE QUOTED STRING IN UNQUOTED FORM     00350000
&PFX.$COMI  EQU X'02'          TREAT MINUS AS END CHARACTER     GP08250 00360000
&PFX.$COUP  EQU X'01'          UPPER CASE EVERYTHING            GP08095 00370000
.*--------------------------------------------------------------------* 00380000
.*  PARSER INFO: RESULT CHAIN/CONDCODE/REASON/FLAGS/COUNTS            * 00390000
.*--------------------------------------------------------------------* 00400000
            DS 0F                                                       00410000
&PFX.CLRST  EQU *              START OF AREA CLEARED ON ENTRY           00420000
&PFX.@TABL  DC A(0)          ADDRESS OF RESULT TABLE (MACRO MAPPARST)   00430000
&PFX.#CODE  DC A(0)          RESULT CONDITION CODE                      00440000
&PFX.#REAS  DC A(0)          RESULT REASON CODE                         00450000
&PFX.$FLGS  DC X'00'         RETURN PROCESSING FLAGS                    00460000
&PFX.#OPER  DC X'00'         RETURN NUMBER OF OPERANDS                  00470000
&PFX.#OPOS  DC X'00'         RETURN NUMBER OF POSITIONALS               00480000
&PFX.#OPKW  DC X'00'         RETURN NUMBER OF KEYWORDS                  00490000
&PFX.CLEAR  EQU &PFX.CLRST,*-&PFX.CLRST,C'X'  AREA TO CLEAR             00500000
.*  ABOVE AREA CLEAR IN PARSER INITIALIZATION                           00510000
&PFX.SIZE  EQU  *-&PFX.PARM   AREA SIZE                                 00520000
         MEND  ,                                                        00530000
./ ADD NAME=MAPPARST
         MACRO ,                                                        00010000
&NM      MAPPARST &DSECT=YES,&PFX=PRS                  NEW 2003.091 GYP 00020000
.*--------------------------------------------------------------------* 00030000
.*  THIS MACRO MAPS INDIVIDUAL RETURN ENTRIES FROM A @PARSER CALL     * 00040000
.*--------------------------------------------------------------------* 00050000
         LCLC  &P                                                       00060000
&P       SETC  '&PFX'                                                   00070000
         AIF   ('&DSECT' NE 'YES').ALTSECT                              00080000
&PFX.DSECT DSECT ,                                                      00090000
         AGO   .NODSECT ,                                               00100000
.ALTSECT ANOP  ,                                                        00110000
&PFX.DSECT  DS 0D            PLANT A LABEL                              00120000
.NODSECT AIF   ('&NM' EQ '').NOLABEL                                    00130000
&NM      DS    0F                                                       00140000
.NOLABEL AIF   ('&NM' EQ '&PFX'.'TENT').NOLTENT                         00150000
&PFX.TENT   DS 0F            DEFINE START OF TEXT ENTRY                 00160000
.NOLTENT ANOP  ,                                                        00170000
&P.LINK  DC    A(0)          LINK TO NEXT ENTRY OR ZERO                 00180000
&P.@TEXT DC    A(0)          ADDRESS OF TEXT STRING (OR ONE BLANK)      00190000
&P.#TEXT DC    F'0'          LENGTH OF TEXT                             00200000
&P.@KEY  DC    A(0)          ADDRESS OF MATCHED KEYWORD ENTRY           00210000
&P.#THEX DC    XL8'0'        IF VALID HEX, VALUE                        00220000
&P.#TINT DC    XL8'0'        IF VALID INTEGER, VALUE                    00230000
&P.TYPE  DC    X'00'         ENTRY TYPE                                 00240000
&P.CHAR  DC    C' '          END CHARACTER                              00250000
.*                                                                      00260000
&P.PROF  DC    X'00'         PROCESSING FLAG                            00270000
&P.PFKEY EQU   X'80'           MATCHED KEYWORD                          00280000
&P.PFSDT EQU   X'40'           SELF-DEFINING KEYWORD                    00290000
&P.PFPOS EQU   X'C0'           MATCHED POSITIONAL                       00300000
&P.PFTUE EQU   X'20'           USER EXIT TAKEN                          00310000
&P.PFFUE EQU   X'10'           FAILED BY USER EXIT                      00320000
&P.PFFKY EQU   X'08'           UNMATCHED KEYWORD                        00330000
&P.PFFPO EQU   X'04'           EXCESSIVE POSITIONAL                     00340000
&P.PFFOT EQU   X'02'           OTHER ERROR                              00350000
&P.PFPAS EQU   X'01'           TESTED AND PASSED                        00360000
.*                                                                      00370000
&P.STOP  DC    X'00'         END CHARACTER CODE                         00380000
&P.STBLK EQU   X'01'           TEXT ENDED AT TERMINAL BLANK/ZERO        00390000
&P.STEQU EQU   X'02'           TEXT ENDED AT = OR (                     00400000
&P.STEPL EQU   X'04'           TEXT ENDED AT (                          00410000
&P.STEPR EQU   X'08'           TEXT ENDED AT )                          00420000
&P.STCOM EQU   X'10'           TEXT ENDED AT COMMA OR SEMI-COLON        00430000
&P.STQUO EQU   X'20'           TEXT IS A QUOTED STRING                  00440000
&P.STPAR EQU   X'40'           ONE LEVEL OF PARENTHESES STRIPPED        00450000
&P.STSUB EQU   X'80'           TEXT IS PART OF A LIST                   00460000
.*                                                                      00470000
&P.FLAGS DC    X'00'         FLAGS                                      00480000
&P.FGHEX EQU   X'80'           TEXT IS VALID HEX                        00490000
&P.FGINT EQU   X'40'           TEXT IS VALID INTEGER (ALSO)             00500000
&P.FGUNQ EQU   X'10'           TEXT IS STRIPPED QUOTED STRING           00510001
&P.KEYWD DC    CL8' '        EDITED TEXT FRAGMENT - FIRST EIGHT BYTES   00520000
&P.$TEXT DC    CL64' '       EDITED TEXT FRAGMENT                       00530000
         DS    0A              ALIGNMENT FOR NEXT ENTRY                 00540000
&PFX.SIZE  EQU  *-&PFX.TENT   AREA SIZE                                 00550000
         MEND  ,                                                        00560000
./ ADD NAME=MAPPDS
         MACRO ,                                                        00010000
         MAPPDS &PDSBLDL=NO   EXPAND SPECIAL DIRECTORY MAPPINGS         00020000
.*       THIS MACRO SHOULD BE PLACED IMMEDIATELY FOLLOWING REQUEST      00030000
.*       FOR IHAPDS PDSBLDL=NO TO MAP LOCAL/SPECIAL DIRECTORY ENTRY     00040000
.*       FORMATS.                                       ADDED ON 82122  00050000
*        USER DATA FOR SPF ENTRIES                                      00060000
*                                                                       00070000
         ORG   PDS2USRD      REDEFINE USER DATA                         00080000
SPFVERL  DS    X             VERSION NUMBER                             00090000
SPFMODL  DS    X             MODIFICATION LEVEL                         00100000
SPFFLGS  DS    X             FLAGS                              GP04234 00110000
SPFGSCLM EQU   X'80'           SCLM OWNED                       GP04234 00120000
SPFMDSEC DS    PL1           TIME MODIFIED - SECONDS            GP04234 00130000
SPFCRTDT DS    PL4           CREATION DATE                              00140000
SPFMODDT DS    PL4           MODIFICATION DATE                          00150000
SPFMODTM DS    XL2           MODIFICATION TIME (PACKED, NO SIGN)        00160000
SPFCURLN DS    XL2           CURRENT LINE COUNT                         00170000
SPFINILN DS    XL2           INITIAL LINE COUNT                         00180000
SPFMODLN DS    XL2           NUMBER MODIFIED                            00190000
SPFUID   DS    CL7           USER ID                                    00200000
         DS    C' '            RESERVED (BLANK)                         00210000
         DS    CL2' '          RESERVED (BLANK)                         00220000
SPFUDLEN EQU   (*-PDS2USRD+1)/2   HALF-WORD LENGTH OF ENTRY             00230000
         SPACE 2                                                        00240000
*        USER DATA PORTION FOR IEBUPDTX CHAINED ENTRIES                 00250000
*                                                                       00260000
         ORG   PDS2USRD                                                 00270000
DTXSSI   DS    XL4           SSI OR FF200000                            00280000
DTXMODNM DS    CL8           PRODUCTION MEMBER NAME                     00290000
DTXID    DS    CL2           LIBRARY ID                                 00300000
DTXMODNO DS    PL2           MODULE NUMBER                              00310000
DTXVER   DS    PL2           VERSION NUMBER                             00320000
DTXUDLEN EQU   (*-PDS2USRD+1)/2   HALF-WORD LENGTH OF SHORT ENTRY       00330000
DTXTIMES DS    XL4           (OPTIONAL) TIME STAMP YYDDDHHF             00340000
DTXUDLTM EQU   (*-PDS2USRD+1)/2   HALF-WORD LENGTH OF SPECIAL ENTRY     00350000
         ORG   ,                                                        00360000
         MEND  ,                                                        00370000
./ ADD NAME=MAPPRT
         MACRO ,                                        ADDED ON 81201  00010000
&NM      MAPPRT &PREFIX=PU,&DSECT=YES,&EXPARM=NO PRTWORK MAPPING 84171  00020000
         LCLC  &DS,&P                                                   00030000
&P       SETC  '&PREFIX'                                                00040000
&DS      SETC  '&P'.'PARM'                                              00050000
         AIF   ('&NM' EQ '').HAVEDS                                     00060000
&DS      SETC  '&NM'                                                    00070000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00080000
&DS      DSECT ,             MAPPING OF PRTWORK/PUNWORK EXPANSION       00090000
         AGO   .COMDS                                                   00100000
.NODSECT ANOP  ,                                                        00110000
&DS      DS    0H            MAPPING OF PRTWORK/PUNWORK EXPANSION       00120000
.COMDS   ANOP  ,                                                        00130000
&P.DDNAM  DC   CL8' '        PRIMARY DDNAME                             00140000
&P.DDALT  DC   CL8' '        ALTERNATE DDNAME                           00150000
&P.LPP    DC   H'0'          LINES PER PAGE                             00160000
&P.FILL   DC   X'0'          TRANSLATE TABLE UNPRINTABLE CHARACTER      00170000
&P.WIDTH  DC   X'0'          LINE WIDTH FOR TRUNCATION                  00180000
&P.TIT#   DC   X'00'         NUMBER OF TITLES                           00190000
&P.FOOT#  DC   X'00'         NUMBER OF FOOTERS                          00200000
&P.CCFG   DC   X'00'         GLOBAL CARRIAGE CONTROL FLAG               00210000
&P.PRFG   DC   X'00'         OPTION FLAGS                               00220000
&P.PUNCH  EQU  X'80'           PUNCH FILE                               00230000
&P.FG1BUF EQU  X'10'           SIGNLE BUFFER                    GP08088 00240000
&P.PGXLST EQU  X'04'           EXIT LIST SUPPLIED                84169  00250000
&P.PUPAGE EQU  X'02'           PAGE NUMBERS MAINTAINED IN USER AREA     00260000
&P.PGPAGE EQU  X'01'           PAGE NUMBER FEED-BACK                    00270000
*        PAGE NUMBERS PRESENT ONLY IF USER REQUESTED FEED-BACK          00280000
*        OR USER UPDATING.  EXIT LIST (IF PRESENT) FOLLOWS PAGE #S.     00290000
&P.PAGE   DC   H'0'          CURRENT PAGE NUMBER                        00300000
&P.SPAGE  DC   H'0'          PAGE NUMBER SINCE LAST TITLE REQUEST       00310000
&P.EXLST DC    A(0)          OPTIONAL EXIT LIST                  84169  00320000
         DC    H'0'            RESERVED                         GP02234 00330000
         DC    H'0'            RESERVED                         GP02234 00340000
*        EXIT LIST FORMAT : 6 BYTES PER ENTRY                    84169  00350000
*          FIRST BYTE: TYPE FLAGS AND END OF LIST X'80'          84169  00360000
*          SECOND BYTE: TITLE, FOOTER OR LINE NUMBER             84169  00370000
*          FOUR BYTES: 0 OR EXIT ADDRESS                         84169  00380000
&P.XOTYPE EQU   0,1,C'B'     EXIT LIST - TYPE FIELD              84171  00390000
&P.XFEND EQU   X'80'           END OF LIST                       84169  00400000
&P.XFOOT EQU   X'04'           FOOTER EXIT                       84169  00410000
&P.XFTIT EQU   X'02'           TITLE EXIT                        84169  00420000
&P.XFLIN EQU   X'01'           LINE EXIT                         84169  00430000
         AIF   ('&EXPARM' EQ 'NO').MEND                          84171  00440000
&P.XONUM EQU   1,1,C'F'      OFFSET TO LINE NUMBER               84171  00450000
&P.XOADDR EQU  2,4,C'A'      OFFSET TO EXIT ADDRESS              84171  00460000
&P.XOLEN EQU   6               LENGTH OF ONE EXIT ENTRY          84171  00470000
&P.XPLIST DSECT ,                                                84171  00480000
&P.XPTYPE DS   X             EXIT TYPE                           84171  00490000
&P.XPNUM  DS   X             LINE NUMBER OR MAXIMUM # OF HDR/FTR 84171  00500000
&P.XPSIZE DS   H             MAXIMUM LINE WIDTH, INCL. RDW+CC    84171  00510000
&P.XPPWAD DS   A             ADDRESS OF PRINTER WORK AREA        84171  00520000
&P.XPSAVE DS   A             ORIGINAL SAVE AREA                  84171  00530000
&P.XPLINE DS   A             ADDRESS OF PRINT LINE(S)            84171  00540000
         DS    A               RESERVED                          84171  00550000
.MEND    MEND  ,                                                        00560000
./ ADD NAME=MAPPRTWK
         MACRO ,                                        ADDED ON 81201  00010000
&NM      MAPPRTWK &PREFIX=PW,&WIDTH=    PRINTER WORK AREA MAPPING       00020000
         LCLC  &DS                                                      00030000
         LCLC  &P            SHORT PREFIX                               00040000
&P       SETC  '&PREFIX'                                                00050000
&DS      SETC  '&P'.'WORK'                                              00060000
         AIF   ('&NM' EQ '').NONAME                                     00070000
&DS      SETC  '&NM'                                                    00080000
.NONAME  ANOP  ,                                                        00090000
&DS      DSECT ,             MAPPING OF PRINT DCB AND WORK AREA         00100000
&P.LINK   DS   F             LINK TO NEXT GETMAINED AREA                00110000
&P.ID     DS   C'PRT-'       ID OF PRINT FILE 'N'                       00120000
&P.SPLEN  DS   F             SUBPOOL/LENGTH OF THIS AREA                00130000
&P.TCB    DS   A             ADDRESS OF OWNING TCB                      00140000
&P.DCB@   DS   X'BF',AL3(&P.DCB)  DCB POINTER                           00150000
&P.PU@    DS   A             ADDRESS OF USER'S OPEN WORK AREA           00160000
&P.TRAN   DC   F'0'          ADDRESS OF TRANSLATE TABLE OR 0            00170000
&P.DDNAM  DS   CL8           DDNAME                                     00180000
&P.UCS    DS   CL4           UCS NAME                                   00190000
&P.FCB    DS   CL4           FCB NAME                                   00200000
&P.LSTWRK DS   0XL14         WORK AREA FOR EACH FD ENTRY                00210000
&P.LSTLEN DS   A             FIELD LENGTH                               00220000
&P.LSTLTX DS   A             ITEM LENGTH                                00230000
&P.LSTADD DS   A             ITEM ADDRESS                               00240000
&P.LSTDAT DS   X             DATA TYPE                                  00250000
&P.CUROPT DS   X             CURRENT PROCESSING OPTIONS                 00260000
&P.PREOPT DS   X             PRIOR OPTIONS                              00270000
&P.LSTEDT DS   X             EDIT OPTIONS                               00280000
&P.BUFNXT DS   A             ADDRESS OF NEXT BYTE                       00290000
&P.SCRCUR DS   H             BYTES USED IN CURRENT LINE                 00300000
&P.FLAG   DS   X             PROCESSING FLAG                            00310000
&P.FPUN   EQU  X'80' =PUPUNCH   THIS IS A PUNCH FILE                    00320000
&P.FAKE   EQU  X'40'         IN-STORAGE ACCESS METHOD            83275  00330000
&P.FCON   EQU  X'20'         OUTPUT ROUTED TO CONSOLE                   00340000
&P.FHEAD  EQU  X'10'         TITLE PRINTED ON THIS PAGE                 00350000
&P.FPRINT EQU  X'08'         BUFFER CONTAINS TEXT                       00360000
&P.FPXLST EQU  X'04' =PUPGXLST   EXIT LIST PRESENT               84169  00370000
&P.FUPAGE EQU  X'02' =PUPUPAGE   USER MAINTAINS PAGE #S          84169  00380000
&P.FGPAGE EQU  X'01' =PUPGPAGE   USER PAGE # FEED-BACK OPTION           00390000
&P.FLG2  DS    X             PROCESSING FLAGS                    90309  00400000
&P.F3800 EQU   X'80'           IBM 3800 LASER MODE (?)           90309  00410000
&P.F4050 EQU   X'40'           XEROX 4050/9700/2700 ...(?)       90309  00420000
&P.FNUST EQU   X'10'           EJECT TO NEW SHEET                90309  00430000
&P.FOVER EQU   X'02'           REPLACE BOLD(OVERPRINT) BY FONT+1 90309  00440000
&P.FOPTJ EQU   X'01'           INSERT FONT CONTROL CHARACTERS    90309  00450000
&P.FONT# DS    X             CURRENT FONT NUMBER                 90309  00460000
&P.FONTB DS    XL2           FONT # PUSHDOWN STACK               90309  00470000
&P.CHARS DS    4CL4          SAVED CHARACTERS/XEROX SETUP/PAPER  90309  00480000
&P.FONT$ DS    8Y            CHARACTERS/LINE PER FONT (0-7)      90309  00490000
&P.EXTEN DS    2A            SUBPOOL/LENGTH/ADDRESS OF EXTENSION 90309  00500000
&P.SOUTFM DC   CL8' '        SYSOUT FORM NAME (BLANKS IF N/A)    91001  00510000
&P.SOUTWT DC   CL8' '        SYSOUT SPECIAL WRITER NAME          91001  00520000
&P.FILL   DC   AL1(0)        UNPRINTABLE CHARACTER REPLACEMENT          00530000
&P.SOUTCL DC   C' '          SYSOUT CLASS (OR MSGCLASS IF *)     91001  00540000
          DC   AL1(0,0)         RESERVED                                00550000
&P.DCB    DCB  DDNAME=ANY,DSORG=PS,MACRF=PM,EROPT=ACC,                 *00560000
               RECFM=VBSA,LRECL=137,EXLST=&P.EXLIST                     00570000
&P.EXLIST DC   0A(0),X'87',AL3(0),A(0,0) +JFCB+@DCBEXIT                 00580000
&P.TOPPG  DC   F'0'          EDIT LEN/ADDRESS FOR PAGE NUMBER           00590000
&P.TOPPS  DC   F'0'             DITTO FOR SUB-PAGE                      00600000
&P.TOPDT  DC   F'0'             DITTO FOR DATE                          00610000
&P.TOPTM  DC   F'0'             AND TIME                                00620000
&P.BOTPG  DC   F'0'          EDIT LEN/ADDRESS FOR PAGE NUMBER           00630000
&P.BOTPS  DC   F'0'             DITTO FOR SUB-PAGE                      00640000
&P.BOTDT  DC   F'0'             DITTO FOR DATE                          00650000
&P.BOTTM  DC   F'0'             AND TIME                                00660000
&P.CURLN  DC   H'-1'                                                    00670000
&P.MAXLN  DC   H'60'         MAXIMUM LINES PER PAGE (INCL. TITLES)      00680000
&P.WIDTH  DC   H'0'          DATA WIDTH FOR TRUNCATION                  00690000
&P.TIT#   DC   H'0'          NUMBER OF TITLE LINES                      00700000
&P.FOOT#  DC   H'0'          NUMBER OF FOOTER LINES                     00710000
&P.PAGE   DC   H'0'          CURRENT PAGE NUMBER                        00720000
&P.SPAGE  DC   H'0'          PAGE SINCE LAST TITLE CHANGE               00730000
&P.TRTAB  DC   256AL1(0)     TRANSLATE TABLE                            00740000
&P.CCSAV  DC   C' '          SAVE PWRECCC OVER PUT                      00750000
&P.BUFSP  DC   AL1(0)        SUB-POOL OF GETPOOL REQUEST         83275  00760000
&P.VCON   DC   F'0'          V-FORMAT RECORD HEADER                     00770000
&P.RECCC  DC   C' '          CARRIAGE CONTROL                           00780000
         AIF   ('&WIDTH' NE '').HAVEW                                   00790000
&P.REC    EQU  *             DATA RECORD                                00800000
         AGO   .MEND         TRUNCATE THE MAPPING                       00810000
.HAVEW   ANOP  ,                                                        00820000
&P.REC    DC   CL(&WIDTH+1)' '   TEXT RECORD                     90309  00830000
         DS    0F                                                       00840000
&P.MCREC  DC   CL((&WIDTH+6+3)/4*4)' '   MACHINE CONTROL SAVE RECORD    00850000
&P.MCC    EQU  &P.MCREC+4,1,C'C'        CARRIAGE CONTROL                00860000
         SPACE 1                                                        00870000
         DS    0F                                                       00880000
&P.SIZE  EQU   *-&DS         LENGTH OF FIXED AREA                       00890000
&P.ULOP   DC   CL((&WIDTH+6+3)/4*4)' '   UNDERLINE/OVERPRINT RCD        00900000
         DS    0F                                                       00910000
&P.TIT1   DC   CL((&WIDTH+6+3)/4*4)' '   1-14 TITLE/FOOTER RECORDS      00920000
.MEND    MEND  ,                                                        00930000
./ ADD NAME=MAPRDC
         MACRO ,                                                        00010000
&NM      MAPRDC &DSECT=YES,&PFX=                       ADDED ON GP10248 00020000
         LCLC  &DS,&P                                                   00030000
&DS      SETC  'MAPRDC'      SET DEFAULT NAME                           00040000
&P       SETC  '&PFX'                                                   00050000
         AIF   ('&NM' EQ '').HAVEDS                                     00060000
&DS      SETC  '&NM'                                                    00070000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00080000
&DS      DSECT ,             MAPPING OF DEVICE CHARACTERISTICS          00090000
         AGO   .COMDS                                                   00100000
.NODSECT ANOP  ,                                                        00110000
&DS      DS    0H            MAPPING OF DEVICE CHARACTERISTICS          00120000
.COMDS   AIF   ('&PFX' NE '').COMPFX                                    00130000
&P       SETC  'RDC'                                                    00140000
.COMPFX  ANOP  ,                                                        00150000
&P.CONTY DS    XL2           CONTROLLER TYPE                            00160000
&P.CONMD DS    XL1           CONTROLLER MODEL                           00170000
&P.DEVTY DS    XL2           DEVICE TYPE                                00180000
&P.DEVMD DS    XL1           DEVICE MODEL                               00190000
&P.DEVFT DS    XL4           DEVICE & CONTROLLER FEATURES               00200000
&P.DEVCL DS    XL1           DEVICE CLASS (UCBTBYT3)                    00210000
&P.DEVCD DS    XL1           DEVICE CODE  (UCBTBYT4)                    00220000
&P.PRICY DS    XL2           PRIMARY CYLINDER NUMBER                    00230000
&P.PRITK DS    XL2           TRACKS PER CYLINDER                        00240000
&P.PRISC DS    XL1           SECTORS PER TRACK                          00250000
&P.TRKLN DS    XL3           BYTES PER TRACK (DATA)                     00260000
&P.HA0LN DS    XL2           HOME ADDRESS & R0 LENGTH                   00270000
&P.CAPCD DS    XL1           TRACK CAPACITY CODE                        00280000
&P.CAPFA DS    XL1           TRACK CAPACITY FACTOR                      00290000
&P.NKOHD DS    XL2           NON-KEYED OVERHEAD                         00300000
&P.KYOHD DS    XL2           KEYED AREA OVERHEAD                        00310000
&P.ALTAD DS    XL2           ALTERNATE CYLINDER ADDRESS                 00320000
&P.ALTNO DS    XL2           ALTERNATE TRACK NUMBER                     00330000
&P.DIAAD DS    XL2           DIAGNOSTIC CYLINDER ADDRESS                00340000
&P.DIANO DS    XL2           DIAGNOSTIC TRACK NUMBER                    00350000
&P.SARAD DS    XL2           SA CYLINDER START                          00360000
&P.SARNO DS    XL2           SA TRACK NUMBER                            00370000
&P.MDRID DS    XL1           MDR ID                                     00380000
&P.OBRID DS    XL1           OBR ID                                     00390000
&P.CONTP DS    XL1           CONTROLLER TYPE (?)                        00400000
         DS    XL1             RESERVED                                 00410000
&P.RCDLN DS    XL2           LENGTH OF RECORD                           00420000
         DS    XL18            RESERVED                                 00430000
&P.LEN   EQU   *-&DS         LENGTH OF ONE ENTRY                        00440000
         MEND  ,                                                        00450000
./ ADD NAME=MAPSBALL
         MACRO ,                                                        00010000
&NM      MAPSBALL &PFX=ALD,&DSECT=                                      00020000
.********************************************************************** 00030000
.*  THIS MACRO MAPS THE CALLING SEQUENCE FOR SUBALLOC                 * 00040000
.********************************************************************** 00050000
         LCLC  &P                                                       00060000
&P       SETC  '&PFX'                                                   00070000
&NM      MACMAPHD PFX=&PFX,DSECT=&DSECT                                 00080000
.*                           MAPPING OF USER'S CALLING AREA             00090000
&P.FUN   DC    C' '          FUNCTION CODE (A-ALLOC; U-UNALLOC)         00100000
&P.VER   DC    C' '          VERSION CODE (FOR LATER EXPANSION?)        00110000
&P.DSNAM DC    CL44' '       REQUESTED/RETURNED DATA SET NAME           00120000
&P.MEMBR DC    CL8' '        MEMBER NAME OR BLANK OR HEX ZERO           00130000
&P.DDNAM DC    CL8' '        REQUESTED/RETURNED DD NAME                 00140000
&P.MGCL  DC    CL8' '        SMS - MANAGEMENT CLASS                     00150000
&P.DACL  DC    CL8' '        SMS - DATA CLASS                           00160000
&P.STCL  DC    CL8' '        SMS - STORAGE CLASS                        00170000
&P.UNIT  DC    CL8' '        REQUESTED UNIT (OR BLANK)                  00180000
&P.STATS DC    CL3' '        NEW/OLD/MOD/SHR                            00190000
&P.NDISP DC    CL3' '        CAT/KEE/DEL/UNC/PAS                GP10191 00200000
&P.CDISP DC    CL3' '        CAT/KEE/DEL/UNC/PAS                GP10191 00210000
&P.SPC   DC    CL8' '        CYL/TRK/###(NUMERIC, BLOCKS)               00220000
&P.PRIME DC    CL8' '        PRIMARY AMOUNT                             00230000
&P.SECND DC    CL8' '        SECONDARY AMOUNT                           00240000
&P.DIR   DC    CL8' '        DIRECTORY BLOCKS                           00250000
&P.RETPD DC    CL4' '        RETENTION PERIOD IN DAYS                   00260000
&P.DSORG DC    CL3' '        DSORG                                      00270000
&P.RECFM DC    CL5' '        RECORD FORMAT                              00280000
&P.LRECL DC    CL5' '        RECORD LENGTH OR 'X'                       00290000
&P.BLKSZ DC    CL5' '        BLOCK SIZE                                 00300000
&P.KYLEN DC    CL3' '        KEY LENGTH                                 00310000
&P.VLSER DC    5CL6' '       VOLUME SERIALS                             00320000
&P.SIZE  EQU   *-&P.FUN        SIZE                             GP10191 00330000
         MEND  ,                                                        00340000
./ ADD NAME=MAPSBAWK
         MACRO ,                                                        00010000
&NM      MAPSBAWK &PFX=ALW,&DSECT=                                      00020000
.********************************************************************** 00030000
.*  THIS MACRO MAPS THE CALLING SEQUENCE FOR SUBALLOC                 * 00040000
.********************************************************************** 00050000
         LCLC  &P                                                       00060000
&P       SETC  '&PFX'                                                   00070000
&NM      MACMAPHD PFX=&PFX,DSECT=&DSECT                                 00080000
.*                           MAPPING OF USER'S WORK/RETURN AREA         00090000
&P.RET   DC    F'0'          RETURN CODE                                00100000
&P.ERR   DC    F'0'          ERROR CODE                                 00110000
&P.INF   DC    F'0'          INFORMATIONAL CODE                         00120000
         DC    F'0'            SPARE (DEBUG - ALLOC PARM ADDRESS)       00130000
&P.MSG   DC    10CL256' '    RETURNED MESSAGES                          00140000
&P.SIZE  EQU   *-&P.RET        SIZE                             GP10191 00150000
         MEND  ,                                                        00160000
./ ADD NAME=MAPSBP2W
         MACRO ,                                                        00010000
&NM      MAPSBP2W &PFX=,&DSECT=NO                         ADDED GP02323 00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*  THIS MAPPING MACRO IS USED BY SUBP2W TO DEFINE THE RETURN AREA.   * 00050000
.*  AREA ADDRESS IS PASSED BACK IN R1                                 * 00060000
.*                                                                    * 00070000
.*  CURRENTLY USED BY HOB                                             * 00080000
.*                                                                    * 00090000
.*--------------------------------------------------------------------* 00100000
         AIF   ('&DSECT' NE '' AND '&DSECT' NE 'YES').NODSECT           00110000
         AIF   ('&NM' EQ '').NODSLAB                                    00120000
&NM      DSECT ,                                                        00130000
         AGO   .NOLABEL                                                 00140000
.NODSLAB ANOP  ,                                                        00150000
MAPSBP2W DSECT ,                                                        00160000
         AGO   .NOLABEL                                                 00170000
.NODSECT AIF   ('&NM' EQ '').NOLABEL                                    00180000
&NM      DS    0D                                                       00190000
.NOLABEL ANOP  ,                                                        00200000
&PFX.MONTH1   DC C'MONTH1'     MONTH/WEEK OF MONTH                      00210000
&PFX.MONTHL   DC C'MONTHL'     SAME AS MONTH1 IN LAST 7 DAYS/MO         00220000
&PFX.MONDH1   DC C'DAYNN'      DAY OF MONTH                             00230000
&PFX.MONDHL   DC C'DAY32'      LAST DAY OF MONTH                        00240000
&PFX.WEEKNO   DC C'WEEKXX'     WEEK OF YEAR                             00250000
&PFX.WEEKDAY  DC X'07',CL9'SATURDAY'  SET TO CURRENT DAY                00260000
&PFX.JULDATE  DS P'1989123'    JULIAN DATE FOR RUN                      00270000
         MEND  ,                                                        00280000
./ ADD NAME=MAPSCR
         MACRO ,                                        ADDED ON 88211  00010000
&NM      MAPSCR &PREFIX=SU,&DSECT=YES,&EXPARM=NO SCRWORK MAPPING        00020000
         LCLC  &DS,&P                                                   00030000
&P       SETC  '&PREFIX'                                                00040000
&DS      SETC  '&P'.'PARM'                                              00050000
         AIF   ('&NM' EQ '').HAVEDS                                     00060000
&DS      SETC  '&NM'                                                    00070000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00080000
&DS      DSECT ,             MAPPING OF SCRWORK EXPANSION               00090000
         AGO   .COMDS                                                   00100000
.NODSECT ANOP  ,                                                        00110000
&DS      DS    0H            MAPPING OF SCRWORK EXPANSION               00120000
.COMDS   ANOP  ,                                                        00130000
&P.DDNAM  DC   CL8' '        DDNAME (BTAM OR VTAM)                      00140000
&P.DDALT  DC   CL8' '        ALTERNATE DDNAME (BTAM) OR LU ID (VTAM)    00150000
&P.HIL    DC    X'07'        MASK FOR EXTENDED HIGH-LIGHTING            00160000
&P.LPP    DC   X'0'          PREFERRED LINES PER PAGE                   00170000
&P.FILL   DC   X'0'          TRANSLATE TABLE UNPRINTABLE CHARACTER      00180000
&P.WIDTH  DC   X'0'          MAXIMUM WIDTH TO USE (0, 80 OR 132)        00190000
&P.TIT#   DC   X'00'         NUMBER OF TITLES                           00200000
&P.FOOT#  DC   X'00'         NUMBER OF FOOTERS                          00210000
&P.COL    DC   X'07'         MASK FOR EXTENDED COLOR                    00220000
&P.PRFG   DC   X'00'         OPTION FLAGS                               00230000
&P.FVTAM  EQU  X'80'           USE VTAM RATHER THAN BTAM                00240000
&P.PGXLST EQU  X'04'           EXIT LIST SUPPLIED                84169  00250000
&P.PUPAGE EQU  X'02'           PAGE NUMBERS MAINTAINED IN USER AREA     00260000
&P.PGPAGE EQU  X'01'           PAGE NUMBER FEED-BACK                    00270000
*        PAGE NUMBERS PRESENT ONLY IF USER REQUESTED FEED-BACK          00280000
*        OR USER UPDATING.  EXIT LIST (IF PRESENT) FOLLOWS PAGE #S.     00290000
&P.PAGE   DC   H'0'          CURRENT PAGE NUMBER                        00300000
&P.SPAGE  DC   H'0'          PAGE NUMBER SINCE LAST TITLE REQUEST       00310000
&P.EXLST DC    F'0'          OPTIONAL EXIT LIST                  84169  00320000
*        EXIT LIST FORMAT : 6 BYTES PER ENTRY                    84169  00330000
*          FIRST BYTE: TYPE FLAGS AND END OF LIST X'80'          84169  00340000
*          SECOND BYTE: TITLE, FOOTER OR LINE NUMBER             84169  00350000
*          FOUR BYTES: 0 OR EXIT ADDRESS                         84169  00360000
&P.XOTYPE EQU   0,1,C'B'     EXIT LIST - TYPE FIELD              84171  00370000
&P.XFEND EQU   X'80'           END OF LIST                       84169  00380000
&P.XFOOT EQU   X'04'           FOOTER EXIT                       84169  00390000
&P.XFTIT EQU   X'02'           TITLE EXIT                        84169  00400000
&P.XFLIN EQU   X'01'           LINE EXIT                         84169  00410000
         AIF   ('&EXPARM' EQ 'NO').MEND                          84171  00420000
&P.XONUM EQU   1,1,C'F'      OFFSET TO LINE NUMBER               84171  00430000
&P.XOADDR EQU  2,4,C'A'      OFFSET TO EXIT ADDRESS              84171  00440000
&P.XOLEN EQU   6               LENGTH OF ONE EXIT ENTRY          84171  00450000
&P.XPLIST DSECT ,                                                84171  00460000
&P.XPTYPE DS   X             EXIT TYPE                           84171  00470000
&P.XPNUM  DS   X             LINE NUMBER OR MAXIMUM # OF HDR/FTR 84171  00480000
&P.XPSIZE DS   H             MAXIMUM LINE WIDTH, INCL. RDW+CC    84171  00490000
&P.XPPWAD DS   A             ADDRESS OF PRINTER WORK AREA        84171  00500000
&P.XPSAVE DS   A             ORIGINAL SAVE AREA                  84171  00510000
&P.XPLINE DS   A             ADDRESS OF PRINT LINE(S)            84171  00520000
         DS    A               RESERVED                          84171  00530000
.MEND    MEND  ,                                                        00540000
./ ADD NAME=MAPSCRWK
         MACRO ,                                        ADDED ON 81201  00010000
&NM      MAPSCRWK &PREFIX=SW,&WIDTH=    PRINTER WORK AREA MAPPING       00020000
         LCLC  &DS                                                      00030000
         LCLC  &P            SHORT PREFIX                               00040000
&P       SETC  '&PREFIX'                                                00050000
&DS      SETC  '&P'.'WORK'                                              00060000
         AIF   ('&NM' EQ '').NONAME                                     00070000
&DS      SETC  '&NM'                                                    00080000
.NONAME  ANOP  ,                                                        00090000
&DS      DSECT ,             MAPPING OF PRINT DCB AND WORK AREA         00100000
&P.LINK   DS   F             LINK TO NEXT GETMAINED AREA                00110000
&P.ID     DS   C'SCR-'       ID OF PRINT FILE 'N'                       00120000
&P.SPLEN  DS   F             SUBPOOL/LENGTH OF THIS AREA                00130000
&P.TCB    DS   A             ADDRESS OF OWNING TCB                      00140000
&P.DCB@   DS   X'BF',AL3(SWDCB)  DCB POINTER                            00150000
&P.PU@    DS   A             ADDRESS OF USER'S OPEN WORK AREA           00160000
&P.TRAN   DC   F'0'          ADDRESS OF TRANSLATE TABLE OR 0            00170000
&P.DDNAM  DS   CL8           DDNAME                                     00180000
&P.@BCC DC    A(0)           ADDRESS OF BUFFER PREFIX                   00190000
&P.@OBUF DS    A(&P.OBUF)    OUTPUT BUFFER START                        00200000
&P.@IBUF DS    A(&P.IBUF)    INPUT BUFFER ADDRESS                       00210000
&P.WUMASK DC   XL4'00'       DEVICE CAPABILITY MASKS                    00220000
&P.WUDFLT DC   XL4'0'        DEFAULT FD OPTIONS                         00230000
&P.LSTWRK DS   0XL14         WORK AREA FOR EACH FD ENTRY                00240000
&P.LSTLEN DS   A             FIELD LENGTH                               00250000
&P.LSTLTX DS   A             ITEM LENGTH                                00260000
&P.LSTADD DS   A             ITEM ADDRESS                               00270000
&P.LSTDAT DS   F             DATA TYPE                                  00280000
&P.PREOPT DS   F             PRIOR OPTIONS                              00290000
&P.CUROPT DS   F             CURRENT PROCESSING OPTIONS                 00300000
&P.LSTEDT DS   X             EDIT OPTIONS                               00310000
&P.LSTCC  DS   X                                                        00320000
&P.BUFNXT DS   A             ADDRESS OF NEXT BYTE                       00330000
&P.SCRCUR DS   H             BYTES USED IN CURRENT LINE                 00340000
&P.LSTDO  DC    X'00'        CONTROL FLAG                               00350000
&P.FUN    DC    X'00'        CALLER'S REQUEST                           00360000
&P.FLIST  EQU   X'80'          BUILD BUFFER FROM FD LIST                00370000
&P.FANAL  EQU   X'40'          ANALYZE USER'S RESPONSE                  00380000
&P.FMOVE  EQU   X'10'          MOVE ERROR-FREE INPUT TO MEMORY          00390000
&P.FLOOP  EQU   X'04'          LOOP FDS AND TAKE USER EXIT       87173  00400000
&P.FITEM  EQU   X'01'          SCITEM CALL                      GP03011 00410000
&P.OPT9   DC    X'00'  1/2   FD OPTION BYTES; 0 IF NONE                 00420000
&P.OPT7   DC    X'00'  2/2   SECOND OPTION BYTE; DFLT IF MISSING        00430000
&P.LSTXEQ DC    A(0)         ADDRESS OF EXEC FD                         00440000
&P.LSTXEN DC    A(0)         END ADDRESS OF EXEC RANGE                  00450000
         DC    (4*2)A(0)     PUSH-DOWN STACK                            00460000
&P.TRNLOW DC    A(TNTRTAB)   TRANSLATE TABLE                            00470000
         SPACE 1                                                 87173  00480000
&P.XEXIT  DC    A(0,0,&P.XPARM)  R15-R1 TO USER (EXIT,LIST,PARM)        00490000
&P.XPARM  DC    A(&P.XSAVE,0,0,0) SAVE/FD/FIW/FDW                       00500000
&P.XSAVE  DC    18F'0'       SAVE AREA FOR USER'S USE            87173  00510000
&P.XMYSV  DC    12F'0'       MY SAVE AREA                        87173  00520000
&P.FLAG   DS   X             PROCESSING FLAG                            00530000
&P.FVTAM  EQU  X'80' =PUFVTAM   THIS IS VTAM, NOT BTAM                  00540000
&P.FAKE   EQU  X'40'         IN-STORAGE ACCESS METHOD            83275  00550000
&P.FTSU   EQU  X'20'         OUTPUT ROUTED TO TSO USER                  00560000
&P.FHEAD  EQU  X'10'         TITLE PRINTED ON THIS PAGE                 00570000
&P.SETAT  EQU  X'08'           USE SET ATTRIB, NOT SFE                  00580000
&P.FPXLST EQU  X'04' =PUPGXLST   EXIT LIST PRESENT               84169  00590000
&P.FUPAGE EQU  X'02' =PUPUPAGE   USER MAINTAINS PAGE #S          84169  00600000
&P.FGPAGE EQU  X'01' =PUPGPAGE   USER PAGE # FEED-BACK OPTION           00610000
&P.FILL   DC   AL1(0)        UNPRINTABLE CHARACTER REPLACEMENT          00620000
&P.DCB    DCB  DDNAME=ANY,DSORG=PS,MACRF=PM,EROPT=ACC,                 *00630000
               RECFM=VBSA,LRECL=137,EXLST=SWEXLIST                      00640000
&P.EXLIST DC   0A(0),X'87',AL3(0),A(0,0) +JFCB+@DCBEXIT                 00650000
&P.TOPPG  DC   F'0'          EDIT LEN/ADDRESS FOR PAGE NUMBER           00660000
&P.TOPPS  DC   F'0'             DITTO FOR SUB-PAGE                      00670000
&P.TOPDT  DC   F'0'             DITTO FOR DATE                          00680000
&P.TOPTM  DC   F'0'             AND TIME                                00690000
&P.BOTPG  DC   F'0'          EDIT LEN/ADDRESS FOR PAGE NUMBER           00700000
&P.BOTPS  DC   F'0'             DITTO FOR SUB-PAGE                      00710000
&P.BOTDT  DC   F'0'             DITTO FOR DATE                          00720000
&P.BOTTM  DC   F'0'             AND TIME                                00730000
&P.CURLN  DC   H'-1'                                                    00740000
&P.MAXLN  DC   H'24'         MAXIMUM LINES PER PAGE (INCL. TITLES)      00750000
&P.WIDTH  DC   H'80'         DATA WIDTH FOR TRUNCATION                  00760000
&P.BUFSIZ DC   Y(&P.IBUF-&P.OBUF)  BUFFER SIZE                          00770000
&P.SCRSIZ DC   Y(24*80)      SCREEN SIZE                                00780000
&P.TIT#   DC   H'0'          NUMBER OF TITLE LINES                      00790000
&P.FOOT#  DC   H'0'          NUMBER OF FOOTER LINES                     00800000
&P.PAGE   DC   H'0'          CURRENT PAGE NUMBER                        00810000
&P.SPAGE  DC   H'0'          PAGE SINCE LAST TITLE CHANGE               00820000
&P.QUEREP DC    XL128'0'     WSF QUERY REPLY DATA                87315  00830000
&P.BINDS  DC    XL128'0'     BIND DATA                           87315  00840000
&P.PRSZ  DC    2X'0'         PRIMARY SIZE                        87315  00850000
&P.ALSZ  DC    2X'00'        ALTERNATE SIZE                      87315  00860000
&P.ATTR  DC    XL4'0'        ATTRIBUTE STRING                    87315  00870000
&P.VCON   DC   F'0'          V-FORMAT RECORD HEADER                     00880000
&P.RECCC  DC   C' '          CARRIAGE CONTROL                           00890000
         AIF   ('&WIDTH' NE '').HAVEW                                   00900000
&P.REC    EQU  *             DATA RECORD                                00910000
         AGO   .MEND         TRUNCATE THE MAPPING                       00920000
.HAVEW   ANOP  ,                                                        00930000
&P.REC    DC   CL(&WIDTH)' '   TEXT RECORD                              00940000
         DS    0F                                                       00950000
&P.SIZE  EQU   *-&DS         LENGTH OF FIXED AREA                       00960000
&P.TIT1   DC   14CL((&WIDTH+5+3)/4*4)' '   14 TITLE/FOOTER RECORDS      00970000
&P.CBUF  DS    16X           BUFFER CONTROL BYTES (VAR. LENGTH)         00980000
&P.OBUF  DS    (27+13)CL132' '  ROOM FOR COLOR OUTPUT                   00990000
&P.IBUF  DS    27CL132' '    ROOM FOR FULL INPUT                        01000000
&P.BUFND  EQU  *               END OF BUFFERS                           01010000
.MEND    MEND  ,                                                        01020000
./ ADD NAME=MAPTSA
         MACRO ,                                                        00010000
&NM      MAPTSA &PFX=TSA,&DSECT=                                        00020000
         GBLC  &ZZZLNM(128)                                             00030000
         GBLB  &ZZZLFG                                                  00040000
         GBLA  &ZZZLNO                                                  00050000
         LCLC  &P,&N                                                    00060000
&P       SETC  '&PFX'                                                   00070000
&N       SETC  '&NM'                                                    00080000
         AIF   ('&N' NE '').HAVSECT                                     00090000
&N       SETC  'MAP'.'&P'                                               00100000
.HAVSECT AIF   ('&DSECT' EQ 'NO').NOSEC                                 00110000
&N       DSECT ,                                                        00120000
         AGO   .COMSEC                                                  00130000
.NOSEC   AIF   ('&NM' EQ '').COMSEC                                     00140000
&NM      DS    0D                                                       00150000
.COMSEC  ANOP  ,                                                        00160000
&P.@SERV DC    A(0)          ADDRESS OF @SERVICE ROUTINE                00170000
&P.EXSVC SVC   0             SVC OR BASR TO @SERVICE (TARGET OF EX 0,)  00180000
&P.#SIZE DC    AL2(&P.SIZE)  AMOUNT OF STORAGE GOTTEN                   00190001
&P.FIX@  DC    D'0'          BASE OF FIXED OFFSET WORK AREA ADDRESSES   00200000
         SERVWORK OPT=EXPAND  EXPAND FIXED STORAGE SAVERS               00210000
&P.SIZE  EQU   *-&P.@SERV    SIZE TO GET                                00220000
         MEND  ,                                                        00230000
./ ADD NAME=MAPVOLRD
         MACRO ,                                                        00010000
&NM      MAPVOLRD &DSECT=YES,&PFX=                        ADDED GP09158 00020000
.*                                                                      00030000
.*   THIS MACRO MAPS THE DATA RETURNED FROM @VOLREAD USING THE          00040000
.*     VOLREAD TRACK,CCHH    MACRO CALL                                 00050000
.*                                                                      00060000
         LCLC  &DS,&P                                                   00070000
&DS      SETC  'MAPVOLRD'    SET DEFAULT NAME                           00080000
&P       SETC  'TRK'                                                    00090000
         AIF   ('&PFX' EQ '').DEFPFX                                    00100000
&P       SETC  '&PFX'                                                   00110000
.DEFPFX  AIF   ('&NM' EQ '').HAVEDS                                     00120000
&DS      SETC  '&NM'                                                    00130000
.HAVEDS  AIF   ('&DSECT' NE 'YES').NODSECT                              00140000
&DS      DSECT ,             MAPPING OF @VOLREAD TRACK DATA             00150000
         AGO   .COMDS                                                   00160000
.NODSECT ANOP  ,                                                        00170000
&DS      DS    0H            MAPPING OF @VOLREAD TRACK DATA             00180000
.COMDS   ANOP  ,                                                        00190000
&P.CCHH  DC    XL4'0'        CCHH TRACK ADDRESS                         00200000
&P.PCYL  DC    FL4'0'        TRACKS PER CYLINDER                        00210000
&P.MAXSZ DC    FL4'0'        MAXIMUM (RAW) TRACK CAPACITY               00220000
&P.#BLOK DC    FL4'0'        NUMBER OF BLOCKS (1-N)                     00230000
&P.R0DAT DC    XL8'0'        R0 DATA                                    00240000
&P.@DATA DC    AL4(0)  1/2   ADDRESS OF TRACK DATA                      00250000
&P.CURSZ DC    FL4'0'  2/2   CURRENT SIZE OF ALL BLOCKS                 00260000
&P.SIZE  EQU   *-&DS           SIZE OF RETURN AREA                      00270000
         MEND  ,                                                        00280000
./ ADD NAME=MAPVTOCS
         MACRO                                                          00010000
         MAPVTOCS                                                       00020000
         USING *,R7                                                     00030000
NOTMOUNT LA    R2,SMINMT .   GET NOT MOUNTED MESSAGE                    00040000
         LA    R3,L'SMINMT                                              00050000
         B     EXCSLOP                                                  00060000
         SPACE                                                          00070000
PROCERR  CNVX  RDCCHHR,SMIPCC  .    FORMAT THE BAD CCHHR                00080000
         CNVX  RDCCHHR+2,SMIPHH                                         00090000
         CNVX  RDCCHHR+4,SMIPRR                                         00100000
         LA    R2,SMIPROC .   PROCESSING ERROR MSG                      00110000
         LA    R3,L'SMIPROC                                             00120000
         B     EXCSLOP                                                  00130000
         SPACE 2                                                        00140000
NEXTDSCB SR    R1,R1                                                    00150000
         IC    R1,CCHHR+4 .  GET CURRENT RECORD NUMBER                  00160000
         LA    R1,1(R1) .    POINT TO NEXT                              00170000
         STC   R1,CCHHR+4 .   STASH BACK                                00180000
         CH    R1,HIGHR .    FIT ON TRACK ?                             00190000
         BNH   MVCCHHR .     GO TO MOVE CORRECT CCHHR INTO REQUEST      00200000
         MVI   CCHHR+4,1 .     RESET TO RECORD 1                        00210000
         LH    R1,CCHHR+2 .   GET TRACK                                 00220000
         LA    R1,1(R1) .    UP IT                                      00230000
         STH   R1,CCHHR+2 .   STASH IT BACK                             00240000
         CH    R1,HIGHTRK .   FITS ON CYL ?                             00250000
         BL    MVCCHHR .     GO TO MOVE CORRECT CCHHR INTO REQUEST      00260000
         MVC   CCHHR+2(2),ZERO .   CLEAR TRACK #                        00270000
         LH    R1,CCHHR .    GET CYL. NO.                               00280000
         LA    R1,1(R1) .    UP                                         00290000
         STH   R1,CCHHR .    STASH BACK                                 00300000
MVCCHHR  MVC   RDCCHHR,CCHHR .    MOVE REQUESTED CCHHR TO READ          00310000
         CLC   CCHHR(5),HIGHMARK .  IN USED PART OF VTOC ?              00320000
         BHR   R9 .          NO, TAKE END-FILE EXIT                     00330000
         SPACE 2                                                        00340000
*        ROUTINE TO GET A DSCB - CCHHR MOVED TO RDCCHHR, BAL R9         00350000
*                                                                       00360000
READDSCB OBTAIN  DSCB .      GET THE DSCB - SEEK                        00370000
         CH    R15,H4 .      GOOD COMP CODE ?                           00380000
         BE    NOTMOUNT .    NOT MOUNTED                                00390000
         BH    4(R9) .       OTHER ERROR                                00400000
         B     8(R9) .       NORMAL EXIT                                00410000
         SPACE 2                                                        00420000
ENDSCAN  L     R10,SPCURR .    GET CURRENT DISPLAY LINE ADDRESS AGAIN   00430000
         SPLINE , ,          GET A FREE LINE                            00440000
         BNL   ENDSMI .      END OF PAGE - USE SMI                      00450000
         MVC   (40-L'EOFMSG)/2(L'EOFMSG,R10),EOFMSG                     00460000
         B     EXCYES .      EXEUNT                                     00470000
ENDSMI   LA    R2,SMIEOF .   GET EOF MESSAGE                            00480000
         LA    R3,L'SMIEOF .   AND LENGTH                               00490000
         B     EXCSLOP .     AND EXIT                                   00500000
         SPACE 2                                                        00510000
*        CONDITIONAL PAGE OUTPUT - ONLY IF LINE 2 IS NON-BLANK          00520000
*                                                                       00530000
CONPOUT  L     R1,BUFAD .    GET START OF BUFFER                        00540000
         CLC   BLANKS,80(R1)   ARE THERE DATA ON FIRST LINE ?           00550000
         BE    PTOP .        NO, SKIP PAGE OUTPUTTING                   00560000
         SPACE 2                                                        00570000
*        OUTPUT THE CURRENT PAGE                                        00580000
*                                                                       00590000
POUT     ST    R9,POUT9 .    SAVE RETURN ADDR.                          00600000
         XPOUT ,             WRITE 'MORE', ETC.                         00610000
         B     *+8 .         ENTER ONLY                                 00620000
         B     EXCIN .       LOOK AT NEW INPUT                          00630000
         L     R9,POUT9 .    RELOAD AGAIN                               00640000
         SPACE 2                                                        00650000
*        INITIALIZE PAGE OUTPUT                                         00660000
*                                                                       00670000
PTOP     ST    R9,POUT9 .    SAVE RETURN ADDR.                          00680000
         BALS  R14,BLANKER . CLEAR BUFFER                               00690000
         SPINIT 0                                                       00700000
         L     R1,BUFAD .    GET START OF BUFFER                        00710000
         MVC   29(L'DSNAM,R1),DSNAM .   PROV. USER DSNAM AS TITLE       00720000
         TR    29(L'DSNAM,R1),TRTAB .  MAKE SURE ITS GOOD               00730000
         MVC   74(L'VOLSER,R1),VOLSER .   ADD VOL-SER                   00740000
         SPLINE ,            COND. LINE ADVANCE FOR SMALL SCREEN        00750000
         L     R9,POUT9 .    RESTORE RETURN ADDR.                       00760000
         BR    R9 .          RETURN                                     00770000
         SPACE 2                                                        00780000
*        ROUTINE TO MOVE ONE LINE; AND PAGE OUT IF NECESSARY            00790000
*                                                                       00800000
LOUT     STM   R2,R3,LOUT23  .  SAVE CALL REGISTERS                     00810000
LOUT1    SPMOVE (R2),(R3)                                               00820000
         B     *+6 .         PAGE WRITE NEXESSARY                       00830000
         BR    R4 .          RETURN, LINE MOVED                         00840000
         BALS  R9,POUT .     ELSE OUTPUT THE PAGE AND WAIT              00850000
         LM    R2,R3,LOUT23 .  RESTORE THE PARM REGISTERS               00860000
         B     LOUT1 .       AND MOVE ON TOP OF PAGE                    00870000
         SPACE 3                                                        00880000
DSCB     CAMLST  SEEK,1,2,3  COMPLETED BY EXHCCVTO                      00890000
SMINMT   SMI    '''ABCXXX'' NOT MOUNTED  '                              00900000
         ORG   SMINMT+1+SMILOFF .   OVERLAY DATA PORTION                00910000
VOLSER   DS    CL6 .         VOL-SER                                    00920000
         ORG   SMINMT+L'SMINMT .    CAN'T USE BLANK ORG                 00930000
SMIPROC  SMI   'ERROR PROCESSING CCCC.HHHH.RR  '                        00940000
         ORG   SMIPROC+SMILOFF .   OVERLAY DATA PORTION                 00950000
         DS    C'ERROR PROCESSING '                                     00960000
SMIPCC   DS    C'CCCC'                                                  00970000
         DS    C                                                        00980000
SMIPHH   DS    C'HHHH'                                                  00990000
         DS    C                                                        01000000
SMIPRR   DS    C'RR'                                                    01010000
         ORG   SMIPROC+L'SMIPROC                                        01020000
SMIEOF   SMI   '**** END OF DISPLAY ****  '                             01030000
         ORG   SMIEOF+SMILOFF . REDEFINE                                01040000
EOFMSG   DC    C'**** END OF DISPLAY ****'                              01050000
         ORG   SMIEOF+L'SMIEOF                                          01060000
         SPACE 2                                                        01070000
POUT9    DC    F'0' .        RETURN ADDR. SAVE WORD                     01080000
LOUT23   DC    2A(0) .       REGISTER STORAGE                           01090000
         SPACE                                                          01100000
HIGHTRK  DC    H'0' .        HIGH TRK PER CYL                           01110000
HIGHR    DC    H'0' .        HIGH DSCB RECORD PER TRK                   01120000
         DS    0H            FORCE ALIGNMENT                            01130000
HIGHMARK DC    XL5'0' .      DSCB 1 HIGH ADDRESS                        01140000
F6PTR    DC    XL5'0' .      FIRST FORMAT 6 ADDRESS IN INITIAL PROC.    01150000
         DS    0H                                                       01160000
CCHHR    DC    XL5'0' .      CURRENT CCHHR FOR SEQUENTIAL PASS OF VTOC  01170000
RDCCHHR  DC    XL5'0' .      CCHHR FOR 'READDSCB' ROUTINE               01180000
F4PTR    DC    XL5'0' .      CCHHR OF FORMAT 4 DSCB                     01190000
         SPACE                                                          01200000
PF       DC    X'0' .        PROCESSING FLAG FOR INDEX, ETC.            01210000
PFIND    EQU   X'80' .       INDEX PAGE REQUESTED                       01220000
PFION    EQU   X'40' .       INDEX PAGE ONLY                            01230000
PFRAW    EQU   X'01'         DISPLAY DSCBS IN HEX               GP01008 01240001
         SPACE                                                          01250000
DSNCLC   CLC   DS1DSNAM(0),DSNMASK .    MASKED DSNAME TEST              01260000
DSNLEN   EQU   DSNCLC+1 .    LEN - 1 OF MASK, IF ANY                    01270000
DSNAM    DC    CL44' ' .     DSNAME FOR SPECIFIC REQUEST PROCESSING     01280000
DSNMASK  DC    CL43' ' .     DSN MASK VALUE, IF USED                    01290000
         SPACE 2                                                        01300000
       INSETS  SPINIT,SPMOVE,INHEX,CVH,CNVR,TRTAB                       01310000
         INSECT                                                         01320000
         SPACE 2                                                        01330000
WRKINPUT DS    0D .          CAMLST WORK AREA                           01340000
         DC    XL100'0' .    WORK AREA                                  01350000
         DC    XL100'0' .    WORK AREA                                  01360000
         DC    XL65'0' .     WORK AREA                                  01370000
         SPACE                                                          01380000
         ORG   WRKINPUT                                                 01390000
     IECSDSL1  1                                                        01400000
         SPACE                                                          01410000
         ORG   WRKINPUT                                                 01420000
     IECSDSL1  2                                                        01430000
         SPACE                                                          01440000
         ORG   WRKINPUT                                                 01450000
     IECSDSL1  3                                                        01460000
         SPACE                                                          01470000
         ORG   WRKINPUT                                                 01480000
DS4DSNAM DS    CL44 .        FORCE OBTAIN IN SAME LOCATION AS FMT 1     01490000
         SPACE                                                          01500000
     IECSDSL1  4                                                        01510000
         SPACE                                                          01520000
         ORG   WRKINPUT                                                 01530000
     IECSDSL1  5                                                        01540000
         SPACE                                                          01550000
         ORG   WRKINPUT                                                 01560000
     IECSDSL1  6                                                        01570000
         SPACE 2                                                        01580000
         ORG   WRKINPUT+148+L'DS1DSNAM+5                                01590000
XVTXWORK DS    0D                                                       01600000
         DS    CL256         FORCE WORK SPACE                           01610000
         ORG                                                            01620000
         MEND                                                           01630000
./ ADD NAME=MAPXWORK
         MACRO ,             USED SOLELY BY EXORCIST ROUTINES           00010000
       MAPXWORK &SECT=D                                                 00020000
         COPY OPTIONS                                                   00030000
         AIF   ('&SECT' NE 'D').INLINEA                                 00040000
EXORWORK DSECT ,                                                        00050000
         AGO   .INLINEB                                                 00060000
.INLINEA ANOP  ,                                                        00070000
WORKHORS CSECT ,                                                        00080000
.INLINEB ANOP  ,                                                        00090000
         DC    CL8'CURR-PIE'                                            00100000
CURRPIE  DC    F'0'          PIE ADDRESS                                00110000
MYPIE    DC    F'0'                                                     00120000
MIEGPR   DC    16F'0'        REGISTERS 0-15 AT TIME OF ERROR     93198  00130000
MIEPSW   DC    F'0'          LEFT-HALF                                  00140000
MIEADD   DC    F'0'          MODE BIT/ADDRESS                           00150000
MIELNIC  DC    F'0'          LENGTH/INTERRUPT CODE                      00160000
MIELEN   EQU   *-MYPIE                                                  00170000
MIESAVLN EQU   *-CURRPIE                                                00180000
         SPACE 1                                                        00190000
         DC    CL8'PREV-PIE'                                            00200000
CUTEYPIE DC    XL(MIESAVLN)'0'                                          00210000
         SPACE 1                                                        00220000
DDB      DC    D'0'                                                     00230000
DDB2     DC    D'0'                                             GP05095 00240000
DDB3     DC    D'0'                                             GP05095 00250000
OLDREGS  DS    0XL(16*4)     LENGTH OF REGISTER AREA                    00260000
OLDREG0  DC    A(0)          USER'S OLD REGISTER                        00270000
OLDREG1  DC    A(0)          USER'S OLD REGISTER                        00280000
OLDREG2  DC    A(0)          USER'S OLD REGISTER                        00290000
OLDREG3  DC    A(0)          USER'S OLD REGISTER                        00300000
OLDREG4  DC    A(0)          USER'S OLD REGISTER                        00310000
OLDREG5  DC    A(0)          USER'S OLD REGISTER                        00320000
OLDREG6  DC    A(0)          USER'S OLD REGISTER                        00330000
OLDREG7  DC    A(0)          USER'S OLD REGISTER                        00340000
OLDREG8  DC    A(0)          USER'S OLD REGISTER                        00350000
OLDREG9  DC    A(0)          USER'S OLD REGISTER                        00360000
OLDREG10 DC    A(0)          USER'S OLD REGISTER                        00370000
OLDREG11 DC    A(0)          USER'S OLD REGISTER                        00380000
OLDREG12 DC    A(0)          USER'S OLD REGISTER                        00390000
OLDREG13 DC    A(0)          USER'S OLD REGISTER                        00400000
OLDREG14 DC    A(0)          USER'S OLD REGISTER                        00410000
OLDREG15 DC    A(0)          USER'S OLD REGISTER                        00420000
CRTECB1  DC    A(0)          POST MAIN TASK FOR CRT I/O                 00430000
CRTECB2  DC    A(0)          POST AT CRT I/O COMPLETION                 00440000
DUMECB1  DC    F'0'          DUMMY ECB - STOP / MODIFY                  00450000
DUMECB2  DC    F'0'          DUMMY ECB - CANCEL                         00460000
CRTPARM  DS    0D            CRT SIZES FOR PHYSICAL/SIMULATED TERMINAL  00470000
CRTLEN   DC    H'80'         LINE WIDTH                                 00480000
CRTNUM   DC    AL2(&CRT/1635*12)  NUMBER OF LINES                       00490000
CRTSIZ   DC    H'0'          PHYSICAL CRT - BUFFER SIZE                 00500000
CRTPFX   DC    H'0'          PREFIX CHARACTER LENGTH                    00510000
CRSPARM  DS    0D          TEST PROGRAM'S CRT VALUES                    00520000
CRSLEN   DC    H'0'          LINE LENGTH                                00530000
CRSNUM   DC    H'0'          LINE NUMBER                                00540000
CRSSIZ   DC    H'0'          SCREEN SIZE                                00550000
CRSPFX   DC    H'0'          PREFIX SIZE                                00560000
SYMCCW   DC    X'06',AL3(WAITREPL),A(256)  PSEUDO-READ CCW              00570000
CRTCCW   DC    D'0'          I/O REQUEST CCW                            00580000
STEPDCB  DC    A(0,0)        STEPLIB (LOADLIB) DCB OPEN LIST    GP05005 00590000
STEPDDN  DC    CL8'LOADLIB' .NAME OF STEPLIB (LOADLIB) DD               00600000
STEPDCB2 DC    A(0,0)        EXORPSYM COPY OF STEPLIB OPEN LIST GP05005 00610000
JOBQDCB  DC    A(0) .        DCB ADDRESS OF SYSJOBQE OR ZERO            00620000
CL16     DC    CL16' '                                                  00630000
BUFPARM  DC    CL8' '        BUFFER PRINT - HEADER                      00640000
         SPACE 1                                                        00650000
MILF     DC    X'0'          MILTEN PROCESSING FLAG                     00660000
MFATTN   EQU   X'80'         WRITE CANCELLED BY ATTN                    00670000
MFLONG   EQU   X'40'         NO ERASE/SUPPRESS TRAILING BLANK SUPPRESS  00680000
MFNOND   EQU   X'20'         NON-DISPLAY FIELD - DON'T PRINT            00690000
         SPACE 1                                                        00700000
SYNTAX   DC    X'00'         SYSIN CONTROL BYTE                         00710000
SYNFSKIP EQU   X'02'           SKIP ENTER-ONLY AFTER DUMP               00720000
SYNFOPEN EQU   X'01'           SYSIN IS OPEN                            00730000
         SPACE 1                                                        00740000
CRF      DC    X'0'          CRT PROCESSING FLAG                        00750000
CRFTSO   EQU   X'80'         TSO TERMINAL FOR SIMULATION                00760000
CRFMIL   EQU   X'40'         MILTEN TERMINAL                            00770000
CRFCRT   EQU   X'20'         CRT OUTPUT (ALONE OR WITH ABOVE)           00780000
CRFSYN   EQU   X'10'         SYSIN SUPPLIED AND OPEN                    00790000
CRFEND   EQU   X'08'         SYSIN END OF FILE READ                     00800000
CRFEOF   EQU   X'04'         SYSIN TO CRT SWITCH SWITCH                 00810000
CRFVTAM  EQU   X'02'         VTAM TERMINAL                       82291  00820000
CRFDATA  EQU   X'01'         'WAITREPL' HAS USER INPUT BUFFER           00830000
         SPACE 1                                                        00840000
IOFLAG   DC    X'0'          I/O PROCESSING FLAG                        00850000
IOPEND   EQU   X'80'         READ TI PENDING                            00860000
IORED    EQU   X'40'         READ COMPLETED                             00870000
IOCAN    EQU   X'20'         CANCEL READ ONLY - NO WRITE                00880000
IOPNRIT  EQU   X'10'         SUPPRESS RITE                              00890000
IOPATT   EQU   X'08'         ENABLE READ AFTER WRITE                    00900000
IOWSF    EQU   X'04'         WSF ISSUED                          87116  00910000
         SPACE 1                                                        00920000
BFMODE   DC    X'0'          BUFFER PRINT OPTIONS                       00930000
BFREAD   EQU   X'80'         READ INPUT BUFFER                          00940000
BFCORE   EQU   X'40'         IN-CORE BUFFER / BOTH OFF - WRITE BUFFER   00950000
BFCNTL   EQU   X'20'         CONTROL I/O - USE ACTUAL SIZES             00960000
BFSF     EQU   X'08'         3270 - START FIELD FOUND DURING FORMAT     00970000
         SPACE 1                                                        00980000
COMMODE  DC    X'0'          CONTROL PROGRAM PROCESSING FLAG            00990000
CFCNTL   EQU   X'80'         CP IN CONTROL                              01000000
CFTEST   EQU   X'40'         TEST TASK RUNNING                          01010000
CFATTN   EQU   X'20'         TEST IN ATTENTION WAIT                     01020000
CFEXIT   EQU   X'10'         END OF JOB FLAG                            01030000
CFPORD   EQU   X'04'         PRINT SCREEN DETAIL ORDERS/ATTR     90150  01040000
CFCHECK  EQU   X'02'         CHECK WRITE BUFFER CONTENTS         90150  01050000
CFDATA   EQU   X'01'         BUFFER HAS DATA FOR USER READ              01060000
CFNOTEST EQU   255-CFTEST-CFATTN-CFDATA  TEST RESET FLAGS               01070000
         SPACE 1                                                        01080000
HEXTRA   DC    C'0123456789ABCDEF'                                      01090000
HEXTRT   EQU   HEXTRA-C'0'                                              01100000
         SPACE 1                                                        01110000
STAEFLGS DC    X'00'         TEST SUBTASK ESTAE CONTROLS        GP05286 01120000
SFEXIT   EQU   X'80'           EXIT WAS ENTERED                 GP05286 01130000
STAMFLGS DC    X'00'         MAIN TASK ESTAE CONTROLS           GP05286 01140000
*FEXIT   EQU   X'80'           EXIT WAS ENTERED                 GP05286 01150000
SFS322   EQU   X'40'                                            GP05286 01160000
         SPACE 1                                                        01170000
         DS    0F                                                       01180000
BUF      DC    XL72'0',CL4' '   HANGOVER - OLD BUFFER FOR XCTL / LOAD   01190000
STIT     WTO   '#  ',MF=L    SUB-TITLE                                  01200000
STITD    WTO   '@  ',MF=L    DELAYED/CONDITIONAL SUB-TITLE              01210000
PRITE    DC    0A(0),AL2(137,0)                                         01220000
MRITE    DC    CL133' '                                                 01230000
         ORG   MRITE+5                                                  01240000
MWRITE   DC    C'WRITE AT LINE '                                        01250000
MLINEAD  DC    C'  ',C'   **'                                           01260000
MBUF     DC    CL80' ',C'**'                                            01270000
         ORG                                                            01280000
READMISS WTO   '0***** MISSING ATTN OR BAD CODE',MF=L                   01290000
         SPACE 2                                                        01300000
PLINE    DC    0A(0),AL2(137,0)                                         01310000
MLINE    DC    CL133' '                                                 01320000
MSAVE    DC    18F'0'                                                   01330000
SVAR1    DC    18F'0'        TEST TASK TOP SAVE AREA                    01340000
SVAR4    DC    18F'0'        SPIE PROCESSING SAVE                       01350000
COMSAVE  DC    6F'0'                                                    01360000
         SPACE 1                                                        01370000
SAVEIT   DC    4A(0)         SPACE FOR CRITICAL REGISTERS               01380000
SPIETRAP DC    A(0)          EXORDUMP, ETC. SPIE TRAP (WAS FRS)         01390000
AYERETA  DC    A(0)                                                     01400000
FWAITIME DC    F'25'         TIMER DELAY  1/4TH SECOND                  01410000
MYDEB    DC    10A(0)                                                   01420000
         SPACE 2                                                        01430000
@KEYLAB  DC    A(0)          ADDRESS OF FUNCTION KEY (INTERRUPT) LABELS 01440000
ENDCCW   CCW   5,ENDSMI,0,L'ENDSMI                                      01450000
         AIF   ('&CRT' EQ '2260').END60                                 01460000
ENDPFX   SCRN  (RESTMDT),SBA,(1,1),SF,(PROT,INT)  FINAL WRITES   78037  01470000
         SCRN  '       EXH599I  CIAO   ',SF,(NONE),IC            78280  01480000
ENDEND   EQU   *                                                        01490000
ENDSMI   EQU   ENDPFX,(ENDEND-ENDPFX),C'C'                              01500000
         AGO   .ENDCOM                                                  01510000
.END60   ANOP  ,                                                        01520000
ENDSMI   SMI   '0       EXH599I  CIAO     '                      78280  01530000
.ENDCOM  SPACE 1                                                        01540000
WORK     DC    3D'0'                                                    01550000
AYESAVE  DC    6F'0'         PARTIAL SAVE AREA                   86219  01560000
FAIMAT   DC    0A(0),AL2(FAIMATE-*,0),CL5' '                            01570000
         DC    C'FAILING INSTRUCTION AT '                               01580000
FAIMAD   DC    CL8' '                                            93198  01590000
         DC    C' IS '                                                  01600000
FAIMAI   DC    CL5' '         MNEMONIC                                  01610000
         DC    C' '                                                     01620000
FAIMAH   DC    CL4' ',C','                                              01630000
         DC    CL10' '                                                  01640000
FAIMATE  EQU   *                                                        01650000
TRAPREGS DC    16F'0'        REGISTERS WHEN ONEXIT WAS ISSUED           01660000
PSPIE    DC    0A(0),AL2(PSPIEX-*,0)                                    01670000
MSPIE    DC    CL133'1'                                                 01680000
         ORG   MSPIE+4                                                  01690000
MSPIEDC  DC    C'PROGRAM CHECK     PSW = '                              01700000
MPSW     DC    CL17' ',C'  LEN '                                GP13091 01710000
MLNIC1   DC    CL4' ',CL2' '                                    GP13091 01720000
MDCIC    DC    C'INT '                                          GP13091 01730000
MLNIC2   DC    CL4' ',CL3' '                                    GP13091 01740000
MRELOC   DC    C'AT LOC '                                               01750000
MRAD     DC    CL8' ',C' IN '                                    93198  01760000
MRPGM    DC    CL8' '                                                   01770000
PSPIEX   EQU   *                                                        01780000
         ORG   ,                                                GP01028 01790000
         SPACE 2                                                        01800000
SPIECCW  CCW   1,SPIESMI,0,L'SPIESMI                                    01810000
OKCCW    CCW   1,DONSMI,0,L'DONSMI                                      01820000
BADCCW   CCW   1,BADSMI,0,L'BADSMI                                      01830000
SNAPCCW  CCW   1,SNAPSMI,0,L'SNAPSMI                                    01840000
AHAPFX   SCRN  (RESTMDT,RESTKBY),SBA,(1,1),SF,(PROT,INT),' AHA  ? '     01850000
         SCRN  SF,(NONE),IC                                             01860000
AHAEND   EQU   *                                                        01870000
         ORG   AHAPFX                                                   01880000
AHASMI   DS    CL(AHAEND-AHAPFX)                                        01890000
         SPACE 1                                                        01900000
AHSOPFX  SCRN  (RESTMDT,RESTKBY),SBA,(1,1),SF,(PROT)                    01910000
         SCRN  AHSOTXT:,CL80' ','    ECB = ',ECBCODE:,CL8' '            01920000
         SCRN  SF,(PROT,INT),' AHA  ? ',SF,(NONE),IC                    01930000
AHSOEND  EQU   *                                                        01940000
         ORG   AHSOPFX                                                  01950000
AHSOSMI  DS    CL(AHSOEND-AHSOPFX)                                      01960000
         SPACE 1                                                        01970000
SPIEPFX  SCRN  (NONE),SBA,(1,1),SF,(PROT)                               01980000
         SCRN  SPIETXT:,CL80' ',IC                                      01990000
SPIEEND  EQU   *                                                        02000000
         ORG   SPIEPFX                                                  02010000
SPIESMI  DS    CL(SPIEEND-SPIEPFX)                                      02020000
         SPACE 1                                                        02030000
NOSMI    DC    C'''ENTER'' ONLY'                                        02040000
         SPACE 1                                                        02050000
BADPFX   SCRN  (RESTMDT,RESTKBY),SBA,(1,1),SF,(PROT,INT)                02060000
         SCRN  'INVALID CONTROL INPUT - REDO :',SF,(NONE),IC            02070000
BADEND   EQU   *                                                        02080000
         ORG   BADPFX                                                   02090000
BADSMI   DS    CL(BADEND-BADPFX)                                        02100000
         SPACE 1                                                        02110000
DONPFX   SCRN  (RESTMDT,RESTKBY),SBA,(1,1),SF,(PROT,INT)                02120000
         SCRN  'CONTROL REQUEST DONE :',SF,(NONE),IC                    02130000
DONEND   EQU   *                                                        02140000
         ORG   DONPFX                                                   02150000
DONSMI   DS    CL(DONEND-DONPFX)                                        02160000
         SPACE 1                                                        02170000
SNAPPFX  SCRN  (RESTMDT,RESTKBY),SBA,(1,1),SF,(PROT,INT)                02180000
         SCRN  'SNAP DONE  :',SF,(NONE),IC                              02190000
SNAPEND  EQU   *                                                        02200000
         ORG   SNAPPFX                                                  02210000
SNAPSMI  DS    CL(SNAPEND-SNAPPFX)                                      02220000
         SPACE 1                                                 86219  02230000
         DS    0A                                               GP99042 02240000
USRNMASK DC    X'7FFFFFFF'   USER'S MODE ADDRESSING MASK        GP99042 02250000
USROMASK DC    X'80000000'   USER'S MODE ADDRESSING MASK        GP99042 02260000
SPEXFLAG DC    X'00'         CONDITION FLAGS                    GP99042 02270000
SPEXSERV EQU   X'80'           PROCESSING A SERVICE REQUEST     GP99042 02280000
SPEXRET  EQU   X'40'           (NORMAL) RETURN VIA SPIE EXIT    GP99042 02290000
SPEXRETU EQU   X'20'           (USER) RETURN VIA SPIE EXIT      GP99042 02300000
SPEXNSYM EQU   X'10'           PSYM STEPLIB FAILED              GP02263 02310000
SPEXING  EQU   X'01'           ALREADY PROCESSING A DUMP        GP99042 02320000
SPEXTEST EQU   SPEXSERV+SPEXRET+SPEXRETU+SPEXING  TEST TASK RESET       02330000
SNAPFLAG DC    X'00'         DUMP ELEMENTS:                     GP99042 02340000
SNPPREG  EQU   X'20'           PRINT REGISTER LINE              GP99042 02350000
SNPPREGS EQU   X'10'           PRINT REGISTERS VS. LOAD LIST    GP99042 02360000
SNPPLOAD EQU   X'08'           PRINT LOAD LIST                  GP99042 02370000
SNPPBUF  EQU   X'04'           PRINT DISPLAY BUFFER             GP99042 02380000
SNPNOT   EQU   X'02'           SKIP INITIAL PAGE EJECT          GP05287 02390000
SNPPPGM  EQU   X'01'           DUMP MEMORY/PROGRAMS             GP99042 02400000
DBUGFLAG DC    X'00'         USER'S SPIE/SNAP OPTIONS           GP99042 02410000
DBFSPALL EQU   X'80'           PRINT EPIE CONTENTS ON ALL ENTRIES       02420000
DBFEXITP EQU   X'40'           PRINT ALL ONEXIT DATA            GP99042 02430000
DBFEXITF EQU   X'20'           TREAT USER'S ONEXIT AS FAILURE   GP99042 02440000
DBFEXITN EQU   X'10'           USER'S ONEXIT SKIPS OUTPUT       GP05310 02450000
DBFNOSTA EQU   X'08'           DON'T ISSUE (E)STAE              GP05321 02460000
DBFONCE  EQU   X'02'           NO RETRY AFTER EXTEST ERROR      GP03275 02470000
DBFEXOR  EQU   X'01'           DEBUG EXORCIST CODE, TOO         GP99050 02480000
AYESPC   DC    C'0'          DOUBLE-SPACE (OR SINGLE)            86219  02490000
*        DATA, DATA, DATA AND GARBAGE                                   02500000
*                                                                       02510000
@TAPROOT DC    A(0)          EXORZAPS - BASE OF MEMBER INFORMATION      02520000
@CURROOT DC    A(0)          EXORZAPS - ROOT ADDRESS FOR CURRENT MEMBER 02530000
@CURRCHN DC    A(0)          EXORZAPS - CURRENT VER OR REP CHAIN ADDR   02540000
MEMBER   DC    CL8' '        EXORZAPS - MEMBER NAME FROM LAST NAME CARD 02550000
@TAPSIZE EQU   *-@TAPROOT      SIZE TO CLEAR IN SUBTASK                 02560000
         SPACE 1                                                        02570000
REGNEND  DC    A(0)          APPROX. END OF REGION               78363  02580000
AYERET   DC    A(0)                                                     02590000
@PGMTAB  DC    A(0)          ADDRESS OF PROGRAM TABLE                   02600000
OFFEP    EQU   00,8,C'C'        OFFSET TO EPNAME OF CURRENT PGM         02610000
OFFLD    EQU   16,8,C'C'        OFFSET TO EPNAME OF CURRENT LOAD        02620000
OFFGM    EQU   32,8,C'C'        OFFSET TO EPNAME OF CURRENT GETMAIN     02630000
OFFCS    EQU   48,8,C'C'        OFFSET TO EPNAME OF CURRENT CSA         02640000
OFFBF    EQU  144,8,C'C'        OFFSET TO SCREEN BUFFER                 02650000
OFFDYN   EQU  160,8,C'C'        OFFSET TO EPNAME OF SPIE DETECTED MOD   02660000
@PGMTABX DC    A(0)          ADDRESS OF PROGRAM TABLE END               02670000
@PGMTABD DC    A(0)          ADDRESS OF END OF DUMPED ENTRIES           02680000
@MAPREG  DC    A(0)          ADDRESS OF REGISTER MAPPING TABLE          02690000
@COMM    DC    A(0)          ADDRESS OF EXHBCOMM                        02700000
@SQSP    DC    A(0)          ADDRESS OF EXHBSQSP                        02710000
@WORK    DC    A(0)          ADDRESS OF EXHBWORK                        02720000
@SRBFG   DC    A(0)          ADDRESS OF WEXFLAG                         02730000
@ALLDN   DC    A(0)          ADDRESS OF ALLDONE IN EXORCIST             02740000
@LOOPR   DC    A(0)          ADDRESS OF LOOPER  IN EXORCIST             02750000
@BUF     DC    A(0)          BUFFER ADDRESS                             02760000
@WKCMD   DC    A(0)          4K COMMAND WORK AREA               GP04234 02770000
@WKSUB   DC    A(0)          4K SUB-CMD WORK AREA               GP04234 02780000
CRTISAV  DC    4A(0)                                                    02790000
FCLMVC   MVC   1(0,R1),0(R1)   CLEAR STORAGE                            02800000
UDISPLAY DC    X'0'          USER VS. TEST MODE                  78284  02810000
UDREQ    EQU   X'80'           DISPLAY REQUESTED                 78284  02820000
UDRUN    EQU   X'40'           DISPLAY COMMAND ISSUED            78284  02830000
UDBAD    EQU   X'04'           DISPLAY BOMBED                    78284  02840000
SNIPFLAG DC    X'00'         SNAP ENTRY CONDITIONS                      02850000
SNIPABND EQU   X'80'           FORMAT ABEND INFORMATION                 02860000
SNIPDUMP EQU   X'40'           ENTERED FOR -DUMP COMMAND                02870000
SNIPSNAP EQU   X'20'           ENTERED FOR -SNAP COMMAND                02880000
SNIPSPIE EQU   X'10'           ENTERED FOR ESPIE                        02890000
         DS    0F            ENSURE CORRECT REGISTER ALIGNMENT          02900000
NEWREGS  DS    0XL(16*4)     LENGTH OF REGISTER AREA                    02910000
NEWREG0  DC    A(0)          NEW USER REGISTER                          02920000
NEWREG1  DC    A(0)          NEW USER REGISTER                          02930000
NEWREG2  DC    A(0)          NEW USER REGISTER                          02940000
NEWREG3  DC    A(0)          NEW USER REGISTER                          02950000
NEWREG4  DC    A(0)          NEW USER REGISTER                          02960000
NEWREG5  DC    A(0)          NEW USER REGISTER                          02970000
NEWREG6  DC    A(0)          NEW USER REGISTER                          02980000
NEWREG7  DC    A(0)          NEW USER REGISTER                          02990000
NEWREG8  DC    A(0)          NEW USER REGISTER                          03000000
NEWREG9  DC    A(0)          NEW USER REGISTER                          03010000
NEWREG10 DC    A(0)          NEW USER REGISTER                          03020000
NEWREG11 DC    A(0)          NEW USER REGISTER                          03030000
NEWREG12 DC    A(0)          NEW USER REGISTER                          03040000
NEWREG13 DC    A(0)          NEW USER REGISTER                          03050000
NEWREG14 DC    A(0)          NEW USER REGISTER                          03060000
NEWREG15 DC    A(0)          NEW USER REGISTER                          03070000
NEWPSW   DC    0D'0',XL4'0'  NEW PSW, MASK AND STUFF                    03080000
NEWIC    DC    A(0)          NEW INSTRUCTION COUNTER, WITH AMODE BIT    03090000
NEWICOF  DC    A(0)          OFFSET TO NEWIC BEFORE USE                 03100000
NEWAM    DC    A(0)          NEW AMODE BIT                              03110000
OLDPSW   DC    0D'0',F'0'    LEFT PSW                                   03120000
OLDIC    DC    A(0)          RIGHT PSW WITH AMODE BIT                   03130000
OLDLNIC  DC    H'0,0'        LENGTH / INTERRUPT CODE                    03140000
         DS    0F            ENSURE CORRECT REGISTER ALIGNMENT          03150000
SNPREGS  DS    0XL(16*4)     LENGTH OF REGISTER AREA                    03160000
SNPREG0  DC    A(0)          SNAP REQUEST REGISTER                      03170000
SNPREG1  DC    A(0)          SNAP REQUEST REGISTER                      03180000
SNPREG2  DC    A(0)          SNAP REQUEST REGISTER                      03190000
SNPREG3  DC    A(0)          SNAP REQUEST REGISTER                      03200000
SNPREG4  DC    A(0)          SNAP REQUEST REGISTER                      03210000
SNPREG5  DC    A(0)          SNAP REQUEST REGISTER                      03220000
SNPREG6  DC    A(0)          SNAP REQUEST REGISTER                      03230000
SNPREG7  DC    A(0)          SNAP REQUEST REGISTER                      03240000
SNPREG8  DC    A(0)          SNAP REQUEST REGISTER                      03250000
SNPREG9  DC    A(0)          SNAP REQUEST REGISTER                      03260000
SNPREG10 DC    A(0)          SNAP REQUEST REGISTER                      03270000
SNPREG11 DC    A(0)          SNAP REQUEST REGISTER                      03280000
SNPREG12 DC    A(0)          SNAP REQUEST REGISTER                      03290000
SNPREG13 DC    A(0)          SNAP REQUEST REGISTER                      03300000
SNPREG14 DC    A(0)          SNAP REQUEST REGISTER                      03310000
SNPREG15 DC    A(0)          SNAP REQUEST REGISTER                      03320000
SNPPSW   DC    0D'0',XL4'0'  SNAP PSW, MASK AND STUFF                   03330000
SNPIC    DC    A(0)          SNAP INSTRUCTION COUNTER, WITH AMODE BIT   03340000
SNPLNIC  DC    A(0)          SNAP PSW LENGTH/CODE                       03350000
         DC    X'00'           SPARE                            GP05295 03360000
SNPCMPC  DC    XL3'0'        ESTAE ABEND CODE                   GP05295 03370000
CRTINUMB DC    A(0)                                              94073  03380000
REGNSIZE DC    A(128*1024)   WORKING REGION SIZE                GP04234 03390000
CRTIBAD  WTO   '-*** PROGRAM OR I/O ERROR ***',MF=L                     03400000
MONECB   DC    F'0'                                                     03410000
MONTCB   DC    F'0'                                                     03420000
MONHEAD  DC    0A(0),AL2(MONHEADE-MONHEAD,0)                            03430000
         DC    C'$            *****   EXORCISE DEBUG PROGRAM   *****  ' 03440000
         DC    C'       '                                               03450000
MONHEADT DC    C'TEST',C' #'                                            03460000
MONHEADN DC    CL4' '                                                   03470000
MONHEADE EQU   *                                                        03480000
MONCNT   DC    PL2'0'                                                   03490000
MONP1    DC    P'1'                                                     03500000
MONMASK  DC    X'40202120'                                              03510000
#XPRINT  DC    V(EXORPRNT)   PRINT ROUTINE MAIN ENTRY                   03520000
@TRACE   DC    A(0)          FOR PGMTRACE CALLS                         03530000
         DEBTRACE MODE=D,CALL=DYN,PRTMODE=DBTFXPRT              GP99116 03540000
         ORG   DBT@UDCB      RESPECIFY THE EXORPRNT ADDRESS             03550000
@XPRINT  DC    V(EXORPRNT)   PRINT ROUTINE MAIN ENTRY                   03560000
         ORG   ,                                                        03570000
FPREGS   DC    4D'0'         360/370 STYLE FLOATING REGS        GP11253 03580000
TAILEND  EQU   *                                                        03590000
         SPACE 3                                                        03600000
         AIF   ('&SECT' NE 'D').INLBUFA                                 03610000
BUFSECT  DSECT                                                          03620000
         AGO   .INLBUFB                                                 03630000
.INLBUFA ANOP                                                           03640000
         ENTRY BUFSECT                                                  03650000
BUFSECT  DS    0D                                                       03660000
.INLBUFB ANOP                                                           03670000
DATALEN  DC    F'0'          USER DATA LENGTH / 0-ENTER ONLY            03680000
WAITREPL DC    CL256' '      3270 ATTN/INPUT BUFFER                     03690000
DATAREPL DC    CL256' '      PROGRAM DATA INPUT                         03700000
         DC    CL4' ' .      SPACE FOR TSO PREFIX CHARACTERS            03710000
         AIF   ('&CRT' NE '3270').DBUF                                  03720000
SCREEN   DC    X'C3114040'                                              03730000
         AGO   .CBUF                                                    03740000
.DBUF    ANOP                                                           03750000
         DC    CL3' '                                                   03760000
SCREEN   DC    C'0'          2260 WITH LNE DEFINITION                   03770000
.CBUF    ANOP                                                           03780000
BUFFER   DC    124CL80' '    BUFFER FOR 3290 (62*160)                   03790000
MSGBUF   EQU   BUFFER+24*80,80,C'C'  MESSAGE LINE FOR 24*80 BUFFER      03800000
         DC    64CL80' '     OVERFLOW FOR ORDERS                 93198  03810000
         DC    CL4' '        PADDING                                    03820000
PRTBUF   DC    124CL80' '    SIMULATION PROCESSING BUFFER        93198  03830000
         MEND                                                           03840000
./ ADD NAME=MASKEQU
         MACRO ,
         MASKEQU ,                                      ADDED ON 87223
.*  THE FUNCTION OF THIS SET OF EQUATES IS TO PROVIDE AN EASY
.*  WAY OF DEFINING CLM, ICM AND SIMILAR MASK BITS, WITHOUT
.*  HAVING TO USE B' ' FORMS OR INTEGERS.
OOOO     EQU   0
OOOI     EQU   1
OOIO     EQU   2
OOII     EQU   3
OIOO     EQU   4
OIOI     EQU   5
OIIO     EQU   6
OIII     EQU   7
IOOO     EQU   8
IOOI     EQU   9
IOIO     EQU   10
IOII     EQU   11
IIOO     EQU   12
IIOI     EQU   13
IIIO     EQU   14
IIII     EQU   15
         MEND  ,
./ ADD NAME=MAXH
         MACRO ,                                                        00010000
&NM      MAXH  &R,&A                                     ADDED  GP04128 00020000
         LCLA  &I                                                       00030000
&I       SETA  &SYSNDX                                                  00040000
&NM      MACPARM &R,&A,OP=CH,OPR=CR,MODE=EQU                            00050000
         MACPARM ZZZZ&I,OP=BNL,MODE=ONE                                 00060000
         MACPARM &R,&A,OP=LH,OPR=LR,MODE=EQU                            00070000
ZZZZ&I   DS    0H                                                       00080000
.MEND    MEND  ,                                                        00090000
./ ADD NAME=MAX
         MACRO ,                                                        00010000
&NM      MAX   &R,&A,&TYPE=                                      85195  00020000
         GBLC  &MACPLAB                                                 00030000
         LCLA  &I                                                       00040000
         LCLC  &SUF                                             GP04234 00050000
         AIF   ('&TYPE' EQ 'F' OR '&TYPE' EQ 'A').NOSUF         GP04234 00060000
&SUF     SETC  '&TYPE'                                          GP04234 00070000
.NOSUF   ANOP  ,                                                GP04234 00080000
&I       SETA  &SYSNDX                                                  00090000
&NM      MACPARM &R,&A,OP=C&SUF,OPR=C&SUF.R,MODE=EQU                    00100000
         MACPARM ZZZZ&I,OP=BNL,MODE=ONE                                 00110000
         MACPARM &R,&A,OP=L&SUF,OPR=L&SUF.R,MODE=EQU                    00120000
ZZZZ&I   DS    0H                                                       00130000
.MEND    MEND  ,                                                        00140000
./ ADD NAME=MDEFDICT
         MACRO ,                                                        00010000
         MDEFDICT &WORD,&TYPE=C                                         00020000
         COPY  MDEFGBL                                                  00030000
         LCLA  &I,&J,&K                                                 00040000
         LCLC  &LQ,&CHIX                                                00050000
.*  FIND WORD IN DICTIONARY                                             00060000
.LOOP    AIF   (&I GE &ZZDCTIX).ADDWORD                                 00070000
&I       SETA  &I+1                                                     00080000
         AIF   ('&WORD' NE '&ZZDCT(&I)').LOOP                           00090000
.*  FOUND. RETURN INDEX                                                 00100000
&ZZDCTRT SETA &I                                                        00110000
         MEXIT ,                                                        00120000
.*  NOT FOUND. ERROR IF DICTIONARY FULL; OTHERWISE BUILD ENTRY.         00130000
.*  RETURN INDEX IN ZZDCTRT                                             00140000
.ADDWORD AIF   (&ZZDCTIX GE &ZZDICMX).MUCH2                             00150000
&ZZDCTIX SETA &ZZDCTIX+1                                                00160000
&ZZDCT(&ZZDCTIX) SETC '&WORD'                                           00170000
&ZZDCTRT SETA &ZZDCTIX                                                  00180000
MSGDSCT  CSECT ,                                                        00190000
&LQ      SETC  'L'''                                                    00200000
&CHIX    SETC  '00000'.'&ZZDCTIX'                                       00210000
&J       SETA  K'&CHIX                                                  00220000
&CHIX    SETC  '&CHIX'(&J-4,5)                                          00230000
DWD&CHIX DC    AL1(&LQ.DWT&CHIX,&LQ.DWT&CHIX,C'&TYPE')                  00240000
&K       SETA  K'&WORD                                                  00250000
         AIF   (&K LT 4).NOSPEC                                         00260000
         AIF   ('&WORD'(1,1) EQ '''' OR '&WORD'(2,1) NE '''').NOSPEC    00270000
DWT&CHIX DC    &WORD         EXPAND SELF-DEFINING TERM                  00280000
         AGO   .USECT                                                   00290000
.NOSPEC  ANOP  ,                                                        00300000
DWT&CHIX DC    &TYPE.&WORD                                              00310000
.USECT   ANOP  ,                                                        00320000
&ZZSECT  CSECT ,                                                        00330000
         MEXIT ,                                                        00340000
.MUCH2 MNOTE 12,'DESIGN LIMIT OF &ZZDICMX DICTIONARY ENTRIES EXCEEDED.' 00350000
         MEND  ,                                                        00360000
./ ADD NAME=MDEFEND
         MACRO ,                                                        00010000
&NM      MDEFEND ,                                                      00020000
         COPY  MDEFGBL                                                  00030000
         LCLA  &I,&J,&K,&N                                              00040000
         LCLC  &CH,&CHIX,&STRING                                        00050000
&CHIX    SETC  '00000'.'&ZZMSGIX'                                       00060000
&J       SETA  K'&CHIX                                                  00070000
&CHIX    SETC  '&CHIX'(&J-4,5)                                          00080000
MPTLAST  EQU   MPT&CHIX,MPTSIZE,C'A'  DEFINE LAST MSG PTR FOR MDEFHEAD  00090000
 MNOTE *,'************************************************************' 00100000
 MNOTE *,'**                                                          ' 00110000
 MNOTE *,'**  MESSAGE TABLE &ZZSECT CONTAINS &ZZMSGIX MESSAGES,       ' 00120000
 MNOTE *,'**  AND USED &ZZDCTIX DICTIONARY ENTRIES.                  '  00130000
 MNOTE *,'**                                                          ' 00140000
 MNOTE *,'**  THE LOWEST MESSAGE IDENTIFIER WAS  &ZZMGLO              ' 00150000
 MNOTE *,'**  THE HIGHEST MESSAGE IDENTIFIER WAS &ZZMGHI              ' 00160000
 MNOTE *,'**                                                          ' 00170000
 MNOTE *,'**  THE MESSAGE TABLE &ZZMGSRT IN SORT SEQUENCE.            ' 00180000
 MNOTE *,'**                                                          ' 00190000
 MNOTE *,'************************************************************' 00200000
         MEND  ,                                                        00210000
./ ADD NAME=MDEFGBL
.*   GLOBAL DEFINITIONS FOR MESSAGE DEFINITION (MDEFXXXX) MODULES       00010000
         GBLA  &ZZDCTIX,&ZZDCTRT,&ZZMSGIX,&ZZLNGIX,&ZZIDLEN             00020000
         GBLA  &ZZDOFLN,&ZZMOFLN,&ZZDICMX                               00030000
         GBLC  &ZZMDTYP,&ZZSECT,&ZZMPFX,&ZZTABNM                        00040000
         GBLC  &ZZDCT(32000)                                            00050000
         GBLC  &ZZSTR,&ZZMGLO,&ZZMGHI,&ZZMGPRE,&ZZMGSRT                 00060000
&ZZDICMX SETA  32000                                                    00070000
./ ADD NAME=MDEFHEAD
         MACRO ,                                                        00010000
&NM      MDEFHEAD &LANG=0001,&PFX=,&VERID=V0R9,&SECT=,&TYPE=,          *00020000
               &RENT=YES,    (OPTIONAL RENT=NO SLIGHTLY FASTER)        *00030000
               &LENID=8,     MAXIMUM MESSAGE ID LENGTH                 *00040000
               &UDATA=0,     AVAILABLE TO DESIGNER                     *00050000
               &DOFFLEN=2,   LENGTH OF A DICTIONARY OFFSET ENTRY       *00060000
               &MOFFLEN=2,   LENGTH OF A MESSAGE POINTER OFFSET        *00070000
               &COM='U.S. ENGLISH / EBCDIC'                             00080000
.********************************************************************** 00090000
.*                                                                    * 00100000
.* MDEFHEAD - THIS MACRO IS THE FIRST IN A MESSAGE DEFINITION MODULE. * 00110000
.*       ONLY ONE IS PERMITTED PER ASSEMBLY, AND IT IS ANTICIPATED    * 00120000
.*       THAT EACH MESSAGE MODULE WILL BE COMPLETE FOR ONE PRODUCT.   * 00130000
.*                                                                    * 00140000
.*   AFTER MDEFHEAD, USE ONE MDEF STATEMENT PER MESSAGE.              * 00150000
.*   THE MODULE IS COMPLETED WITH THE MDEFEND MACRO (AND AN END CARD) * 00160000
.*                                                                    * 00170000
.*   PARAMETERS:                                                      * 00180000
.*                                                                    * 00190000
.*   SECT=  EXPANDS IN-LINE TEXT AND RSECT STATEMENTS                 * 00200000
.*   SECT=DSECT  EXPANDS A MAPPING OF THE MODULE HEADER AREA.         * 00210000
.*       NOTE THAT THE ENTRIES PRIOR TO POINT ARE VARIABLE LENGTH.    * 00220000
.*       TO GET CORRECT RESULTS, LOAD THE FIRST FOUR BYTES, MASK WITH * 00230000
.*       X'00000FFF' (RETAIN ONLY DISPLAVEMENT), AND THE LOAD ADDRESS * 00240000
.*       AND USE THAT ADDRESS FOR A USING MTVPOINT                    * 00250000
.*                                                                    * 00260000
.*   LANG=  ANY VALUE LEGAL IN AN A CONSTANT. NOT USED, NOT CHECKED.  * 00270000
.*                                                                    * 00280000
.*   PFX=   WITH SECT=DSECT, THE LABEL PREFIX                         * 00290000
.*          OTHERWISE, THE PREFIX FOR MESSAGE IDENTIFIERS             * 00300000
.*                                                                    * 00310000
.*   TYPE=  USE C OR G(NOT SUPPORTED) - GLOBAL DC TYPE                * 00320000
.*                                                                    * 00330000
.*   VERID= VERSION IDENTIFIER (I.E., V_R_)                           * 00340000
.*                                                                    * 00350000
.*   LENID= MAXIMUM MESSAGE IDENTIFIER LENGTH. LONGER IDS WILL FAIL.  * 00360000
.*          SHORTER ONES ARE LEFT-JUSTIFIED AND BLANK PADDED          * 00370000
.*                                                                    * 00380000
.*   DOFFLEN=2 (LEGAL ARE 2, 3, AND 4) LENGTH OF DICTIONARY OFFSET    * 00390000
.*          ENTRY. USE 2 FOR SMALL MODULES, 3 FOR LARGE.              * 00400000
.*                                                                    * 00410000
.*   MOFFLEN=2 (LEGAL ARE 2, 3, AND 4) LENGTH OF MESSAGE PTR OFFSET   * 00420000
.*          ENTRY. USE 2 FOR SMALL MODULES, 3 FOR LARGE.              * 00430000
.*                                                                    * 00440000
.*   COM=   ARBITRARY TEXT TO IDENTIFY THE MODULE IN A DUMP.          * 00450000
.*                                                                    * 00460000
.*   UDATA= ANY TEXT LEGAL IN AN A CONSTANT.                          * 00470000
.*                                                                    * 00480000
.********************************************************************** 00490000
.*                                                                    * 00500000
.*   PRODUCES:  RSECT,AM31,RMANY WITH SECT=,  DSECT WITH SECT=DSECT   * 00510000
.*     RSECT NAME MUST APPEAR ON MACRO INVOCATION                     * 00520000
.*     DSECT NAME USES LABEL. IF NONE, DEFAULTS TO MTVDSECT, AND      * 00530000
.*              PFX DEFAULTS TO MTV                                   * 00540000
.*                                                                    * 00550000
.*   PFX.BCODE  BRANCH TO MESSAGE BUILD CODE                          * 00560000
.*   PFX.POINT  LABEL FOR USING                                       * 00570000
.*   PFX.UDAT   USER DATA                                             * 00580000
.*   PFX.LANG   LANGUAGE INDICATOR                                    * 00590000
.*   PFX.MPTR   1/3 FIRST MESSAGE POINTER ADDRESS      |              * 00600000
.*   PFX.MPLN   2/3 LENGTH OF MESSAGE POINTER (2,3,4)  |  BXLE        * 00610000
.*   PFX.MPND   3/3 LAS DEFINED MESSAGE POINTER        |              * 00620000
.*   PFX.@MSG   ADDRESS OF MESSAGE RSECT                              * 00630000
.*   PFX.@DIC   ADDRESS OF DICTIONARY RSECT                           * 00640000
.*   PFX.LMID   MAXIMUM LENGTH OF A MESSAGE IDENTIFIER                * 00650000
.*   PFX.LMOF   SIZE OF MESSAGE OFFSET (2,3,4)                        * 00660000
.*   PFX.LDOF   LENGTH OF MESSAGE OFFSET LIST ENTRY                   * 00670000
.*                                                                    * 00680000
.*   TO LOCATE A MESSAGE:                                             * 00690000
.*                                                                    * 00700000
.*   CALCULATE ADDRESS OF PFX.POINT                                   * 00710000
.*   LM R1,R3,PFX.MPTR - USE BXLE OR (IF ORDERED) BINARY TABLE LOOKUP * 00720000
.*     RESULT IS POINTER TO MESSAGE DEFINITION:                       * 00730000
.*     (2,3,4 BYTE) OFFSET TO MESSAGE WORD LIST; MESSAGE ID           * 00740000
.*     WORDLIST OFFSET IS OFFSET FROM MESSAGE RSECT IN PFX.@MSG       * 00750000
.*   WORDLIST: (2,3,4 BYTE EACH): NUMBER OF ENTRIES FOLLOWING;        * 00760000
.*     A) OFFSET FROM ADDR IN PFX.@DIC TO WORD IN DICTIONARY          * 00770000
.*     B) CODE (>ZZDICMX) FOR SPECIAL FUNCTION (DEFAULT IS 48000)     * 00780000
.*                                                                    * 00790000
.*   DICTIONARY ENTRY:                                                * 00800000
.*     (1 BYTE) PHYSICAL LENGTH OF TEXT                               * 00810000
.*     (1 BYTE) LOGICAL LENGTH OF TEXT                                * 00820000
.*     (1 BYTE) TYPE (C, G, X)                                        * 00830000
.*     (PHYS. LEN) QUOTED STRING                                      * 00840000
.*                                                                    * 00850000
.********************************************************************** 00860000
         COPY  MDEFGBL                                                  00870000
         LCLC  &P,&LBL,&OPDS,&MYSECT                                    00880000
.*  ESTABLISH GLOBAL VALUES                                             00890000
&ZZDOFLN SETA  &DOFFLEN      LENGTH OF OFFSET WORD - DICTIONARY LOOKUP  00900000
&ZZMOFLN SETA  &MOFFLEN      LENGTH OF OFFSET WORD - MESSAGE LOOKUP     00910000
&ZZIDLEN SETA  &LENID                                                   00920000
&ZZMDTYP SETC  '&TYPE'       GLOBAL DC ATTRIBUTE (C OR G)               00930000
&LBL     SETC  '&NM'                                                    00940000
&P       SETC  '&PFX'                                                   00950000
&MYSECT  SETC  '&SYSECT'                                                00960000
.*  CHECK MDEFHEAD USAGE - BY DESIGN, ONE PER MODULE. (IGNORE IF DSECT) 00970000
         AIF   ('&SECT' EQ 'DSECT').UNFORKD                             00980000
&ZZMGLO  SETC  (&LENID)'9'   LOWEST ID TO DATE                          00990000
&ZZMGHI  SETC  ''            HIGHEST MESSAGE ID TO DATE                 01000000
&ZZMGPRE SETC  ''            PREVIOUS MESSAGE ID                        01010000
&ZZMGSRT SETC  'IS'          TABLE IS IN SEQUENCE (?)                   01020000
&ZZLNGIX SETA &ZZLNGIX+1                                                01030000
         AIF   (&ZZLNGIX LE 1).UNFORKD                                  01040000
         MNOTE 4,'ONLY ON MDEFHEAD PER MODULE IS SUPPORTED.'            01050000
.*  SET DEFAULT NAME (MTVDSECT) AND PREFIX (MTV) FOR SECT=DSECT ONLY    01060000
.UNFORKD AIF   ('&P' NE '').UPFX                                        01070000
&P       SETC  'MTV'         MESSAGE TABLE VECTOR MAPPING               01080000
.UPFX    AIF   ('&NM' NE '').HAVELBL                                    01090000
&LBL     SETC  'MTVDSECT'                                               01100000
.HAVELBL AIF   ('&SECT' EQ 'DSECT').MAPPER                              01110000
         AIF   ('&NM' NE '').HAVEMOD                                    01120000
         MNOTE 4,'MDEFHEAD SHOULD HAVE A NAME FIELD'                    01130000
.*  EXPAND RSECT FOR MODULE HEADER                                      01140000
.HAVEMOD ANOP  ,                                                        01150000
&NM      CSECT ,                                                        01160000
&NM      AMODE 31                                                       01170000
&NM      RMODE ANY                                                      01180000
&ZZTABNM SETC  '&NM'                                                    01190000
&OPDS    SETC  ''                                                       01200000
         AIF   ('&P' NE '').COMGO                                       01210000
&P       SETC  '&NM'(1,3)    IF NO PREFIX - CHEAT AND USE PRODUCT NAME  01220000
         AGO   .COMGO                                                   01230000
.*  ELSE SET DSECT HEADER                                               01240000
.MAPPER  ANOP  ,             MAP THE MESSAGE TABLE HEADER               01250000
&LBL     DSECT ,             MAP THE MESSAGE TABLE HEADER               01260000
&OPDS    SETC  '0) '         PREVENT UNDEFINED ERRORS                   01270000
.COMGO   ANOP  ,                                                        01280000
.*  BUILD BRANCH AROUND, AND BUILD VARIABLE HEADER INFORMATION          01290000
&P.BROF  B     &P.BCODE-&LBL.(,R15)    DEFINE OFFSET TO CONSTANTS       01300000
         DC    AL1(&OPDS.&P.POINT-&P.COPR)  LENGTH OF EYEBALLER         01310000
&P.COPR  DC    C'&LBL &VERID &SYSDATE &SYSTIME '                        01320000
         DC    C'COPYRIGHT 2003,2008 EXPERT SYSTEM PROGRAMMING'         01330000
         DC    C' - ALL RIGHTS RESERVED '                               01340000
         CNOP  2,4           FORCE ALIGNMENT PRIOR TO POINT             01350000
&P.TBVR  DC    C' 1'         TABLE VERSION 1                            01360000
.*  START OF MESSAGE TABLE VECTORS                                      01370000
         DS   0A             MALIGN                                     01380000
&P.BCODE B    &P.CODE-&LBL.(,R15)  GO TO MESSAGE BUILDER                01390000
&P.POINT DS   0A   SPECIFY THIS IN USING AFTER CALCULATING ADDRESS      01400000
&P.UDAT  DC    A(&OPDS.&UDATA) USER SPECIFIED DATA                      01410000
&P.LANG  DC    A(&OPDS.&LANG) LANGUAGE / CODE PAGE COMBINATION          01420000
&P.MPTR  DC    A(&OPDS.MPT00001) FIRST MESSAGE POINTER (1/3 FOR BXLE)   01430000
&P.MPLN  DC    A(&OPDS.MPTSIZE) SIZE OF MSG PTR ENTRY (2/3)             01440000
&P.MPND  DC    A(&OPDS.MPTLAST) LAST DEFINED MESSAGE (3/3 FOR BXLE)     01450000
&P.@MSG  DC    A(&OPDS.MSGSECT) ADDRESS OF MESSAGE BASE                 01460000
&P.@DIC  DC    A(&OPDS.MSGDSCT) ADDRESS OF DICTIONARY START             01470000
&P.LMOF  DC    A(&OPDS.MPTSIZE-&LENID-2) SIZE OF MSG ID OFFSET          01480000
&P.LMID  DC    A(&OPDS.&LENID) LENGTH OF MESSAGE IDENTIFIER (MAX)       01490000
&P.LCOF  DC    A(&OPDS.MPTSIZE-2) SIZE OF LEN OFFSET                    01500000
&P.LCID  DC    A(&OPDS.2)    LENGTH OF LENGTH                           01510000
&P.LDOF  DC    A(&OPDS.LENWDPTR) LENGTH OF MESSAGE OFFSET LIST ENTRY    01520000
          DC    A(0)           RESERVED                                 01530000
          DC    A(0)           RESERVED                                 01540000
          DC    A(0)           RESERVED                                 01550000
          DC    A(0)           RESERVED                                 01560000
&P.TCOMD DC    C'MESSAGE TABLE FOR ',C&COM                              01570000
&ZZMPFX  SETC  '&PFX'                                                   01580000
&P.CODE  DS    0H            START OF EXECUTABLE CODE                   01590000
         AIF   ('&SECT' EQ 'DSECT').MEND                                01600000
         SPACE 2                                                        01610000
         STM   R14,R12,12(R13)    SAVE                                  01620000
         LR    R12,R15       LOCAL BASE                                 01630000
         DROP  ,                                                        01640000
         USING &LBL,R12                                                 01650000
         AIF   ('&RENT' NE 'YES').NOGET                                 01660000
         LA    R0,LOCEND-LOCSAVE  DYNAMIC SIZE                          01670000
         STORAGE OBTAIN,LENGTH=(0)                                      01680000
         LR    R9,R1         COPY RETURN                                01690000
         USING LOCSAVE,R13   DECLARE GOTTEN STORAGE                     01700000
         AGO   .CMGET                                                   01710000
.NOGET   LA    R9,LOCSAVER                                              01720000
.CMGET   ST    R13,4(,R9)                                               01730000
         ST    R9,8(,R13)                                               01740000
         LM    R0,R1,20(R13) RELOAD R0, R1 FOR RENT CASE                01750000
         LR    R13,R9        MAKE NEW SAVE AREA                         01760000
         STM   R0,R1,CALLR0  SAVE ENTRY VALUES                          01770000
         XC    RETR15(3*4),RETR15   ZERO RETURN VALUES                  01780000
         L     R10,CALLR1    RESTORE CALL PARM                          01790000
         USING XMSGMGPM,R10   DECLARE IT                                01800000
         LM    R8,R9,XMSGBUF  LOAD BUFFER ADDRESS AND LENGTH            01810000
         LTR   R8,R8         HAVE AN ADDRESS ?                          01820000
         BNP   DISASTER      NO; TOO BAD                                01830000
         CH    R9,=H'44'     AT LEAST MINIMUM LENGTH ?                  01840000
         BL    DISASTER      NO; FAIL                                   01850000
         CLRL  (R8),(R9),FILL=C' '  BLANK THE BUFFER                    01860000
         USING MESSBUF,R8    DECLARE THE BUFFER                         01870000
         MVC   MESSLEN(4),=X'00040000'  CLEAR BUFFER LENGTH             01880000
         LA    R11,&P.POINT                                             01890000
         USING MTVPOINT,R11  OR RENAME MTV -> &P                        01900000
         LM    R3,R5,MTVMPTR  GET FIRST MESSAGE                         01910000
         USING MTPDSECT,R3                                              01920000
         SPACE 1                                                        01930000
MSGLOOP  LM    R14,R15,MTVLMOF  GET MSG ID OFFSET AND LENGTH            01940000
         SH    R15,=H'1'     CHANGE FOR EXECUTE                         01950000
         BM    BADMISS       TAKE A DIVE                                01960000
         LA    R14,MTPDSECT(R14)  ADDRESS OF MESSAGE IDENTIFIER         01970000
         CLC   XMSGMID,0(R14)     REQUESTED MESSAGE ?                   01980000
         BE    FOUNDREQ                                                 01990000
         BXLE  R3,R4,MSGLOOP                                            02000000
BADMISS  OICC  4,4           RETURN MESSAGE NOT FOUND                   02010000
         MVC   DB(MGBADMSL),MGBADMIS   MISSING MESSAGE DEFINITION       02020000
         MVC   DB+21(8),XMSGMID                                         02030000
         LA    R2,DB         POINT TO MISSING MESSAGE MESSAGE           02040000
         LA    R5,1          SINGLE MESSAGE ELEMENT                     02050000
         B     DICTMSG       OOPS                                       02060000
BADMDF   OICC  4,4           RETURN MESSSUB NOT FOUND                   02070000
         MVC   DB(MGBADMDL),MGBADMDF   MISSING MESSAGE DEFINITION       02080000
         MVC   DB+21(8),XMSGMID                                         02090000
         LA    R2,DB         POINT TO MISSING MESSAGE MESSAGE           02100000
         LA    R5,1          SINGLE MESSAGE ELEMENT                     02110000
         B     DICTMSG       OOPS                                       02120000
         SPACE 1                                                        02130000
FOUNDREQ LR    R7,R3         (USE OLD MAPPING)                          02140000
         DROP  R3                                                       02150000
         USING MTPDSECT,R3                                              02160000
         MVI   MESSAGE,C' '                                             02170000
         MVC   MESSAGE+1(L'MESSAGE-1),MESSAGE  SPACE IT                 02180000
         EX    R15,BUILDID   MAKE MESSAGE ID                            02190000
         LA    R15,6(,R15)   MAKE MESSAGE LENGTH WITH RDW               02200000
         STH   R15,MESSLEN   STASH IT                                   02210000
         AL    R14,MTVLMID   SPACE TO WORD COUNT                        02220000
         MVI   MSGFLAGS,0    RESET MESSAGE FLAGS                        02230000
         SR    R5,R5         CLEAR FOR ICM                              02240000
         STH   R5,ENDSPACE   CLEAR ENDING SPACE COUNT                   02250000
         ICM   R5,3,0(R14)   GET MESSAGE WORD COUNT                     02260000
         BZ    BADMDF        OOPS                                       02270000
         SPACE 1                                                        02280000
         L     R1,MTVLMOF    GET OFFSET LENGTH AGAIN                    02290000
         SLL   R1,2          CONVERT TO VECTOR OFFSET                   02300000
         SR    R6,R6         CLEAR FOR ICM                              02310000
         EX    0,GETMSGOF-4(R1)  LOAD MESSAGE OFFSET                    02320000
         AL    R6,MTV@MSG    MAKE MESSAGE ADDRESS                       02330000
         USING MTMDSECT,R6                                              02340000
         L     R4,MTVLDOF    LENGTH OF DICTIONARY OFFSET                02350000
         LR    R3,R4         COPY                                       02360000
         SLL   R3,2          CONVERT TO INSTRUCTION INDEX               02370000
DICTLOOP SR    R2,R2         CLEAR FOR ICM                              02380000
         CLI   0(R6),MTSPFUN  SPECIAL ENTRY?                            02390000
         BL    DICTWORD      NO; DO A WORD                              02400000
         CLI   0(R6),MTSPPRM  SPECIAL FUNCTION?                         02410000
         BL    BADFUN        YES; PROCESS IT                            02420000
         CLI   0(R6),MTSPMETA SPECIAL GIMMICKING?                       02430000
         BL    DICTPARM      NO; PROCESS A PARM                         02440000
         MVC   ENDCHAR,1(R6)  COPY THE OPTION CHARACTER                 02450000
         IC    R2,0(,R6)     GET THE REQUESTED FUNCTION                 02460000
         N     R2,=X'0000000F'  ISOLATE REQUEST                         02470000
         SLL   R2,1          CONVERT TO HALF-WORD OFFSET                02480000
         LH    R15,METAPHOR(R2) GET CORRESPONDING PROCESSING ROUTINE    02490000
         B     &LBL.(R15)    INVOKE THE PROCESSOR                       02500000
METAPHOR DC    Y(BADFUN-&LBL)      F0 - UNASSIGNED                      02510000
         DC    Y(BADFUN-&LBL)      F1 - UNASSIGNED                      02520000
         DC    Y(BADFUN-&LBL)      F2 - UNASSIGNED                      02530000
         DC    Y(BADFUN-&LBL)      F3 - UNASSIGNED                      02540000
         DC    Y(BADFUN-&LBL)      F4 - UNASSIGNED                      02550000
         DC    Y(BADFUN-&LBL)      F5 - UNASSIGNED                      02560000
         DC    Y(BADFUN-&LBL)      F6 - UNASSIGNED                      02570000
         DC    Y(BADFUN-&LBL)      F7 - UNASSIGNED                      02580000
         DC    Y(BADFUN-&LBL)      F8 - UNASSIGNED                      02590000
         DC    Y(BADFUN-&LBL)      F9 - UNASSIGNED                      02600000
         DC    Y(BADFUN-&LBL)      FA - UNASSIGNED                      02610000
         DC    Y(BADFUN-&LBL)      FB - UNASSIGNED                      02620000
         DC    Y(BADFUN-&LBL)      FC - UNASSIGNED                      02630000
         DC    Y(CHARWSP-&LBL)      FD - SUFFIX CHARACTER, SPACE        02640000
         DC    Y(CHARNSP-&LBL)      FE - SUFFIX CHARACTER, NO SPACE     02650000
         DC    Y(BADFUN-&LBL)      FF - UNASSIGNED                      02660000
         SPACE 1                                                        02670000
*  CHARNSP - SUPPRESS INTER-WORD SPACING                                02680000
*     APPEND THE CURRENT CHARACTER TO PRIOR WORD, UNLESS IT IS A BLANK  02690000
CHARNSP  MVI   ENDSPACE+L'ENDSPACE-1,0  SET NO TRAILING SPACE           02700000
         CLI   ENDCHAR,C' '  IS IT A SPACE ?                            02710000
         BNE   CHARNOW       NO; SUFFIX IT                              02720000
         B     DICTBUMP      ELSE REQUEST IS DONE                       02730000
         SPACE 1                                                        02740000
*  CHARWSP - APPEND CHARACTER TO CURRENT TEXT, AND SET TRAILING SPACE   02750000
*     APPEND THE CURRENT CHARACTER TO PRIOR WORD UNCONDITIONALLY        02760000
CHARWSP  MVI   ENDSPACE+L'ENDSPACE-1,1  APPEND TRAILING SPACE           02770000
CHARNOW  LH    R14,MESSLEN   CURRENT MESSAGE LENGTH                     02780000
         LA    R0,1(,R14)    NEW LENGTH                                 02790000
         STH   R0,MESSLEN    UPDATE LENGTH                              02800000
         LA    R14,MESSLEN(R14)  NEXT ENTRY                             02810000
         MVC   0(1,R14),ENDCHAR  MOVE SUFFIX CHARACTER                  02820000
         B     DICTBUMP      DO NEXT WORD                               02830000
         SPACE 1                                                        02840000
*  DICTFUN - INVOKE A FUNCTION FOR PARM N (N=0 - ALL PARMS)             02850000
*    **NOT DEFINED YET**                                                02860000
DICTFUN  LA    R2,BADFUNC                                               02870000
         B     DICTMSG                                                  02880000
BADFUN   LA    R2,BADFUNC                                               02890000
         OICC  4,16                                                     02900000
         B     DICTMSG                                                  02910000
         SPACE 1                                                        02920000
*  DICTPARM - FORMAT CALLER'S PARM N AS SPECIFIED BY FORMAT BYTE        02930000
*                                                                       02940000
DICTPARM MVC   WDHED,MGBADTOO  MOVE WORD/MSG HEADER                     02950000
*    **FOR TESTING - JUST DISPLAY REQUEST**                             02960000
*TEST*   MVC   DB(16),BADPARM                                           02970000
*TEST*   MVC   DB3(2),0(R6)  GET TEXT WITHOUT 0C4                       02980000
*TEST*   UNPK  DB+3+1(5),DB3(3)  SHOW ENTIRE CALL                       02990000
*TEST*   TR    DB+3+1(4),TRHEXTAB                                       03000000
*TEST*   MVI   DB+3+1+4,C'>'                                            03010000
*TEST*   LA    R2,DB                                                    03020000
         LA    R0,15         MAKE PARAMETER # MASK                      03030000
         IC    R2,0(,R6)     LOAD DEFINITION                            03040000
         NR    R2,R0         EXTRACT PARAMETER                          03050000
         MH    R2,=AL2(XMSGPR2-XMSGPRM)  GET OFFSET                     03060000
         LA    R2,XMSGPRM(R2)  POINT TO ADDRESS & LENGTH                03070000
         SR    R14,R14                                                  03080000
         SR    R15,R15                                                  03090000
         ICM   R15,1,5(R2)   LOAD LENGTH                                03100000
         BZ    DICTBUMP      NULL VALUE - IGNORE                        03110000
         ICM   R14,1,4(R2)   LOAD TYPE                                  03120000
         BNZ   DICTYPE       USE OVERRIDE TYPE                          03130000
         IC    R14,1(,R6)    GET DEFAULT TYPE FROM MESSAGE              03140000
DICTYPE  STC   R14,PROFG     SAVE PROCESSING FLAGS                      03150000
         N     R14,=X'0000000F'  DELETE MODIFIER BITS                   03160000
         L     R2,0(,R2)     GET PARM ADDRESS                           03170000
         N     R2,=X'7FFFFFF'  IGNORE END OF LIST BIT                   03180000
         BNZ   DICTBRTY      BRANCH BY TYPE                             03190000
         CH    R14,=H'2'     IS IT ADDRESS FUNCTION ?                   03200000
         BNE   DICTBUMP      NO; IGNORE ZERO ADDRESS                    03210000
DICTBRTY BIX   VAL=(R14),WK=R1,ERR=BADCOD,BASE=&LBL,PFX=UPM,           *03220000
               LOC=(TEXT,     0 - TEXT                                 *03230000
               TEXT,          1 - TEXT                                 *03240000
               ADDR,          2 - ADDRESS                              *03250000
               SDEC,          3 - SIGNED DECIMAL                       *03260000
               ADEC,          4 - UNSIGNED DECIMAL                     *03270000
               SINT,          5 - SIGNED INTEGER                       *03280000
               AINT,          6 - UNSIGNED INTEGER                     *03290000
               SHEX,          7 - SIGNED HEX ?                         *03300000
               AHEX,          8 - HEXADECIMAL                          *03310000
               SBIN,          9 - SIGNED BINARY                        *03320000
               ABIN,         10 - UNSIGNED BINARY                      *03330000
               )             END OF LIST                                03340000
         SPACE 1                                                        03350000
UPMSBIN  DS    0H                                                       03360000
UPMABIN  STM   R3,R6,12(R13) SAVE A FEW REGISTERS                       03370000
         LR    R3,R15        INPUT LOOP COUNTER                         03380000
         SLL   R15,3         NEW OUTPUT LENGTH                          03390000
         LA    R4,DB3        SET OUTPUT POSITION                        03400000
UPMABINB ICM   R1,8,0(R2)    LOAD BITS TO BE PROCESSED                  03410000
         LA    R6,8          DO8 BITS PER BYTE                          03420000
UPMABINL LA    R0,C'0'/2     MAKE 0 OR 1 WITH NEXT SHIFT                03430000
         SLDL  R0,1          ISOLATE LEFT-MOST BIT                      03440000
         STC   R0,0(,R4)     STASH IT                                   03450000
         LA    R4,1(,R4)     NEXT BIT POSITION                          03460000
         BCT   R6,UPMABINL   DO ALL BITS IN BYTE                        03470000
         LA    R2,1(,R2)     NEXT INPUT BYTE                            03480000
         BCT   R3,UPMABINB   REPEAT FOR NEXT BYTE                       03490000
         LM    R3,R6,12(R13) RESTORE REGISTERS                          03500000
         LA    R2,DB3        POINT TO RESULTS                           03510000
         B     UPMTEXT       NO EDITING                                 03520000
UPMSINT  DS    0H                                                       03530000
UPMAINT  XC    DB(16),DB                                                03540000
         XC    DB2,DB2                                                  03550000
         LA    R14,DB2+8                                                03560000
         SR    R14,R15       MOVE DESTINATION                           03570000
         EX    R15,EXMVT14   MOVE INPUT                                 03580000
         LM    R0,R1,DB2     LOAD IT                                    03590000
         CVD   R1,DB+8       PACK LOW WORD                              03600000
         B     UPMADIN                                                  03610000
         SPACE 1                                                        03620000
UPMSDEC  DS    0H                                                       03630000
UPMADEC  XC    DB(16),DB     CLEAR TO MAX                               03640000
         LTR   R15,R15       ANY LENGTH ?                               03650000
         BP    MADECLOK                                                 03660000
   LA  R15,16     *****TEST***** LATER CALCULATE LENGTH                 03670000
MADECLOK CH    R15,=H'16'    DESIGN LIMIT ?                             03680000
         BH    BADTOO        YES; TOO LONG                              03690000
         LA    R14,DB+16     MOVE TO TEMP WORK                          03700000
         SR    R14,R15       SET MOVE DESTINATION                       03710000
         SH    R15,=H'1'     MAKE EXECUTE LENGTH                        03720000
         EX    R15,EXMVT14   MOVE USER'S DATA RIGHT JUSTIFIED           03730000
UPMADIN  MVI   DB3,C' '      SET EDIT FILL BYTE                         03740000
         MVI   DB3+1,X'20'     MAKE EDIT BYTE                           03750000
         MVC   DB3+2(L'DB3-2),DB3+1   PROPAGATE IT                      03760000
         MVI   DB3+30,X'21'  TURN SIGNIFICANCE ON                       03770000
         LA    R1,DB3+31     SET DEFAULT SIGNIFICANCE START             03780000
         EDMK  DB3(32),DB    EDIT USER'S TEXT                           03790000
         BNM   MADEPLUS                                                 03800000
         TM    PROFG,PFABS   DOING ABSOLUTE VALUE ?                     03810000
         BZ    MADEPLUS      YES; IGNORE THE SIGN                       03820000
         BCTR  R1,0                                                     03830000
         MVI   0(R1),C'-'    MOVE SIGN TO FRONT                         03840000
MADEPLUS LA    R15,DB3+32    GETEND + 1                                 03850000
         SR    R15,R1        TOTAL LENGTH                               03860000
         LR    R2,R1         POINT TO TEXT START                        03870000
         B     UPMTEXT       FINAGLE                                    03880000
         SPACE 1                                                        03890000
UPMADDR  ST    R2,DB2        FORMAT ADDRESS                             03900000
         LA    R2,DB2                                                   03910000
         LA    R15,4                                                    03920000
         SPACE 1                                                        03930000
UPMSHEX  DS    0H            TREAT AS UNSIGNED                          03940000
UPMAHEX  XC    DB(16),DB     CLEAR TO MAX                               03950000
         CH    R15,=H'16'    DESIGN LIMIT ?                             03960000
         BH    BADTOO        YES; TOO LONG                              03970000
         SH    R15,=H'1'     MAKE EXECUTE LENGTH                        03980000
         BM    DICTBUMP       SHOULDN'T GET HERE                        03990000
         EX    R15,EXMVCTX   MOVE TEXT TO WORK AREA                     04000000
         UNPK  DB3+00(9),DB+00(5)  UNPACK TEXT                          04010000
         UNPK  DB3+09(9),DB+04(5)  UNPACK TEXT                          04020000
         UNPK  DB3+18(9),DB+08(5)  UNPACK TEXT                          04030000
         UNPK  DB3+27(9),DB+12(5)  UNPACK TEXT                          04040000
         TR    DB3(35),TRHEXTAB    MAKE DISPLAYABLE                     04050000
         LR    R14,R15       COPY INPUT LENGTH-1                        04060000
         MVI   DB3+08,C' '   GAP                                        04070000
         MVI   DB3+17,C' '   GAP                                        04080000
         MVI   DB3+26,C' '   GAP                                        04090000
         SRL   R14,2         NUMBER OF INTERWORD GAPS                   04100000
         SLL   R15,1         DOUBLE INPUT LENGTH (-2)                   04110000
         LA    R15,2(R14,R15)  NEW OUTPUT LENGTH                        04120000
         LA    R2,DB3        NEW TEXT                                   04130000
*NEXT*   B     UPMTEXT       ADJUST                                     04140000
         SPACE 1                                                        04150000
UPMTEXT  STC   R15,WDHOLEN   INPUT=OUTPUT LENGTH                        04160000
         SPACE 1                                                        04170000
MASSAGE  LTR   R15,R15       ANY STRING LENGTH ?                        04180000
         BNP   DICTBUMP      BUMP      NO; SKIP IT                      04190000
         TM    PROFG,PFDEBL  SUPPRESS DEBLANKING ?                      04200000
         BNZ   SKIPDEBL      YES                                        04210000
LOOPDEBL TM    0(R2),255-C' '    LEADING BLANK/NULL ?                   04220000
         BNZ   SKIPDEBL      NO                                         04230000
         LA    R2,1(,R2)     ADVANCE                                    04240000
         BCT   R15,LOOPDEBL                                             04250000
         B     DICTBUMP      ALL GONE                                   04260000
SKIPDEBL TM    PROFG,PFDEBR  SUPPRESS DEBLANKING ?                      04270000
         BNZ   SKIPDEBR      YES                                        04280000
         LA    R14,0(R15,R2)                                            04290000
LOOPDEBR BCTR  R14,0         SPACE TO LAST BYTE                         04300000
         TM    0(R14),255-C' '   TRAILING BLANK/NULL ?                  04310000
         BNZ   SKIPDEBR      NO                                         04320000
         BCT   R15,LOOPDEBR                                             04330000
         B     DICTBUMP      ALL GONE                                   04340000
SKIPDEBR B     DICTMSG2      PROCESS WHAT'S LEFT                        04350000
EXMVT14  MVC   0(0,R14),0(R2)  MOVE TEXT RIGHT-JUSTIFIED                04360000
EXMVCTX  MVC   DB(0),0(R2)   MOVE USER'S TEXT                           04370000
         SPACE 1                                                        04380000
BADDEF   LA    R2,MGBADDEF   ERROR IN DEFINITION                        04390000
         OICC  4,16                                                     04400000
         B     DICTMSG       INSERT                                     04410000
BADCOD   LA    R2,MGBADCOD   ERROR IN TYPE                              04420000
         OICC  4,32                                                     04430000
         B     DICTMSG       INSERY                                     04440000
BADTOO   LA    R2,MGBADTOO   INPUT DATA TOO LONG                        04450000
         OICC  4,64                                                     04460000
         B     DICTMSG       INSERY                                     04470000
         SPACE 1                                                        04480000
DICTWORD SR    R2,R2         CLEAR FOR ICM                              04490000
         EX    0,GETDICOF-4(R3)  OFFSET TO DICTIONARY ENTRY             04500000
         AL    R2,MTV@DIC    GET ADDRESS IN DICTIONARY                  04510000
         USING MTDDSECT,R2                                              04520000
DICTMSG  SR    R15,R15                                                  04530000
         IC    R15,MTDPHYLN  GET PHYSICAL LENGTH                        04540000
         MVC   WDHED,0(R2)   MOVE MESSAGE HEADER                        04550000
         LA    R2,MTDTEXT    POINT TO TEXT                              04560000
         DROP  R2                                                       04570000
DICTMSG2 SH    R15,=H'1'     SET EXECUTE LENGTH                         04580000
         BM    DICTBUMP      OOPS                                       04590000
         LH    R14,MESSLEN   CURRENT MESSAGE LENGTH                     04600000
         AH    R14,ENDSPACE  LEADING SPACE, IF ANY                      04610000
         LA    R0,1(R14,R15)  NEW LENGTH                                04620000
         C     R0,XMSGBUF+4  WILL IT FIT ?                              04630000
         BNH   DICTLNOK      YES                                        04640000
         OICC  8             SET TRUNCATION ERROR                       04650000
         S     R0,XMSGBUF+4  GET SIZE OF EXCESS                         04660000
         SR    R14,R0        MAX THAT WILL FIT IN OUTPUT BUFFER         04670000
         SR    R15,R0        MAXIMUM TO BE MOVED                        04680000
         BM    XMSGWTOT      TRUNCATE                                   04690000
         LA    R0,1(R14,R15)  NEW LENGTH                                04700000
DICTLNOK STH   R0,MESSLEN    UPDATE LENGTH                              04710000
         LA    R14,MESSLEN(R14)  NEXT ENTRY                             04720000
         EX    R15,EXMVT14   MOVE AN ENTRY                              04730000
         MVI   ENDSPACE+L'ENDSPACE-1,1  SET (DEFAULT) SPACE             04740000
         MVI   MSGFLAGS,0    RESET FLAGS                                04750000
DICTBUMP AR    R6,R4         SPACE TO NEXT ENTRY                        04760000
         BCT   R5,DICTLOOP   REPEAT UNTIL TIRED                         04770000
XMSGWTOT LA    R1,XMSGMSG    POINT TO TEXT                              04780000
         ST    R1,RETR1      MAKE IT EASY FOR CALLER                    04790000
         TM    CALLR0+L'CALLR0-1,1  WTO REQUESTED ?                     04800000
         BZ    XMSGEXIT      NO                                         04810000
         WTO   MF=(E,MESSLEN)  ISSUE WTO                                04820000
XMSGEXIT LR    R1,R13        SAVE FOR RENT CASE                         04830000
         L     R13,4(,R13)   LOAD CALLER'S SAVE AREA                    04840000
         MVC   16(12,R13),RETCODE-LOCSAVER(R1)  COPY RETURNS            04850000
         AIF   ('&RENT' NE 'YES').NOLET                                 04860000
         LA    R0,LOCEND-LOCSAVE  DYNAMIC SIZE                          04870000
         STORAGE RELEASE,LENGTH=(0),ADDR=(1)                            04880000
.NOLET   LM    R14,R12,12(R13)  LOAD REST                               04890000
         BR    R14           RETURN                                     04900000
         SPACE 1                                                        04910000
DISASTER MVICC 20            ERROR IN PARMS                             04920000
         B     XMSGEXIT      RETURN WITHOUT ACTION                      04930000
         SPACE 1                                                        04940000
BUILDID  MVC   MESSAGE(0),0(R14)  MOVE MESSAGE ID                       04950000
GETMSGOF IC    R6,0(,R7)  1/4  LOAD OFFSET                              04960000
         ICM   R6,3,0(R7) 2/4  LOAD OFFSET FROM AL2                     04970000
         ICM   R6,7,0(R7) 3/4  LOAD OFFSET FROM AL3                     04980000
         L     R6,0(,R7)  4/4  LOAD OFFSET FROM AL4                     04990000
         SPACE 1                                                        05000000
GETDICOF IC    R2,0(,R6)  1/4  LOAD OFFSET                              05010000
         ICM   R2,3,0(R6) 2/4  LOAD OFFSET FROM AL2                     05020000
         ICM   R2,7,0(R6) 3/4  LOAD OFFSET FROM AL3                     05030000
         L     R2,0(,R6)  4/4  LOAD OFFSET FROM AL4                     05040000
         SPACE 1                                                        05050000
BADFUNC  DC    AL1(30,30,C'C'),C'UNSUPPORTED TEXT IN DEFINITION'        05060000
BADPARM  DC    AL1(06,06,C'C'),C'<....>'                                05070000
MGBADDEF DC    AL1(13,13,C'C'),C'<msg.def.err>'                         05080000
MGBADCOD DC    AL1(10,10,C'C'),C'<inv.type>'                            05090000
MGBADTOO DC    AL1(10,10,C'C'),C'<inp.long>'                            05100000
MGBADMIS DC    AL1(L'MGBADMS1+10,L'MGBADMS1+10,C' '),CL10'&PFX.000E'    05110000
MGBADMS1 DC    C'Message XXXXXXXX not defined'                          05120000
MGBADMSL EQU   *-MGBADMIS    TOTAL PATTERN LENGTH                       05130000
MGBADMDF DC    AL1(L'MGBADMD1+10,L'MGBADMD1+10,C' '),CL10'&PFX.001E'    05140000
MGBADMD1 DC    C'Message XXXXXXXX in error'                             05150000
MGBADMDL EQU   *-MGBADMIS    TOTAL PATTERN LENGTH                       05160000
HEXTAB   DC    C'0123456789ABCDEF'                                      05170000
TRHEXTAB EQU   HEXTAB-C'0',256,C'C'                                     05180000
         LTORG ,                                                        05190000
         SPACE 1                                                        05200000
         AIF   ('&RENT' NE 'YES').NODS                                  05210000
LOCSAVE  DSECT ,                                                        05220000
.NODS    ANOP  ,                                                        05230000
LOCSAVER DS    18A                                                      05240000
CALLR0   DS    A    1/2                                                 05250000
CALLR1   DS    A    2/2                                                 05260000
RETCODE  DS    0A   0/3                                                 05270000
RETR15   DS    A    1/3                                                 05280000
RETR0    DS    A    2/3                                                 05290000
RETR1    DS    A    3/3                                                 05300000
DB       DS    2D            CONVERSION SPACE - INPUT                   05310000
DB2      DS    D             CONVERSION SPACE - INPUT                   05320000
DB3SIG   DS    5D            CONVERSION SPACE - SIGNED                  05330000
DB3      EQU   DB3SIG+1,5*8-1,C'C'  CONVERSION SPACE - OUTPUT           05340000
ENDSPACE DS    H                                                        05350000
MSGFLAGS DS    X             MESSAGE PROCESSING FLAGS                   05360000
MFCHAR   EQU   X'01'           APPEND ENDCHAR TO CURR. WORD             05370000
ENDCHAR  DS    C             SUFFIX CHARACTER, IF ANY                   05380000
PROFG    DS    X             PARAMETER PROCESSING FLAG                  05390000
PFABS    EQU   1               IGNORE SIGN                              05400000
PFDEBR   EQU   X'10'           SKIP RIGHT DEBLANKING                    05410000
PFDEBL   EQU   X'20'           SKIP LEFT DEBLANKING                     05420000
WDHED    DS    XL3           WORD DEFINITION HEADER                     05430000
WDHXLEN  EQU   WDHED,1,C'X'    EXPLICIT (INPUT) LENGTH                  05440000
WDHOLEN  EQU   WDHED+1,1,C'X'  OUTPUT LENGTH                            05450000
WDHCHAR  EQU   WDHED+2,1,C'C'  CHAR SET (C OR G)                        05460000
PFDEB    EQU   PFDEBL+PFDEBR   SKIP BOTH                                05470000
LOCEND   EQU   *                                                        05480000
.*                                                                      05490000
XMSGMGPM MDEFPARM SECT=DSECT                                            05500000
MESSBUF  DSECT ,                                                        05510000
MESSLEN  DS    XL2,XL2       V-FORMAT MESSAGE                           05520000
MESSAGE  DS    CL132         MESSAGE TEXT                               05530000
         YREGS ,                                                        05540000
&NM      CSECT ,             RESTORE                                    05550000
.MEND    MEND  ,                                                        05560000
./ ADD NAME=MDEFPARM
         MACRO ,                                                        00010000
&NM      MDEFPARM &PFX=XMSG,&SECT=                                      00020000
.*                                                                      00030000
.*   MDEFPARM IS THE MACRO USED TO DEFINE THE WORK AND CALLING          00040000
.*     PARAMETER AREA FOR THE XMSG/MDEFxxx MACROS AND THE MESSAGE       00050000
.*     FORMATTING SERVICE.                                              00060000
.*                                                                      00070000
.*   &PFX     SPECIFIES A PREFIX TO THE GENERATED LABELS                00080000
.*   WHEN SECT=DSECT IS SPECIFIED, MAPPING FOR THE PARAMETER AREA       00090000
.*   IS EXPANDED                                                        00100000
.*                                                                      00110000
.*                                      V1 WRITTEN 3/2008 BY GYP        00120000
         LCLC  &LABEL                                                   00130000
&LABEL   SETC  '&NM'                                                    00140000
         AIF   ('&LABEL' NE '').HAVELAB                                 00150000
&LABEL   SETC  '&PFX'.'MGPM'                                            00160000
.HAVELAB AIF   ('&SECT' EQ 'DSECT').DSECT                               00170000
&LABEL   DS    0D            SET LABEL                                  00180000
         AGO   .COMMON                                                  00190000
.DSECT   ANOP  ,                                                        00200000
&LABEL   DSECT ,             EXPAND DSECT                               00210000
.COMMON  ANOP  ,                                                        00220000
&PFX.ADD DC    A(0)          ADDRESS OF MESSAGE MODULE                  00230000
&PFX.BUF DC    A(&PFX.MSG,L'&PFX.MSG)  MESSAGE RETURN AREA              00240000
&PFX.MID DC    CL8' '        MESSAGE IDENTIFIER                         00250000
         SPACE 1                                                        00260000
&PFX.PRM DC    AL4(0),AL2(0) INSERTION ENTRY (ADDRESS/FLG/LEN)          00270000
&PFX.PR2 DC    15XL(&PFX.PR2-&PFX.PRM)'0'  16 ENTRIES TOTAL             00280000
         SPACE 1                                                        00290000
&PFX.MSG DC    XL(4+132)'0'  V-FORMAT MESSAGE ASSEMBLY AREA             00300000
         MEND  ,                                                        00310000
./ ADD NAME=MDEF
         MACRO ,                                                        00010000
&NM      MDEF  &LIST,&TYPE=,&PFX=,&SECT=                                00020000
.*                                                                      00030000
.*   MDEF IS THE MACRO USED TO DEFINE ONE ERROR MESSAGE.                00040000
.*     THIS MACRO IS LIMITED TO MESSAGE TABLE MODULES, STARTED WITH     00050000
.*     MDEFHEAD, AND TERMINATED BY MDEFEND. EACH COMBINATION OF         00060000
.*     LANGUAGE AND CHARACTER SET IS EXPECTED TO HAVE A SEPARATE TABLE. 00070000
.*                                                                      00080000
.*   &LB      THE NAME FIELD SPECIFIES THE MESSAGE IDENTIFIER           00090000
.*   &PFX     SPECIFIES A PREFIX TO THE MESSAGE ID, AND IS A GLOBAL     00100000
.*            (ONCE USED IT CAN BE CHANGED, BUT NOT TURNED OFF)         00110000
.*                                                                      00120000
.*   &LIST    ARE THE WORDS OF THE MESSAGE, SEPARATED BY COMMAS.        00130000
.*      ENTRIES MAY BE:                                                 00140000
.*        1) SIMPLE WORD, E.G.         DSNAME                           00150000
.*        2) QUOTED STRING, E.G.       'IT''S'                          00160000
.*        3) HEXADECIMAL TEXT, E.G.    X'070809'                        00170000
.*        4) REPLACEABLE USER PARAMETER:  *1 - *16                      00180000
.*        5) A FUNCTION INVOCATION (DEFERRED)                           00190000
.*                                                                      00200000
.*   &TYPE    TYPE OF DATA BEING DEFINED. TYPE IS LOCAL, BUT OVERRIDES  00210000
.*        ANY TYPE SPECIFIED IN MDEFHEAD.                               00220000
.*                                                                      00230000
.*      SUPPORTED ARE:      (DEFAULT IS C IF NOT SPECIFIED ANYWHERE)    00240000
.*        C  CHARACTER CONSTANT (USE FOR X', ETC. ANYWAY)               00250000
.*        G  DBDC VALUE (NOT SUPPORTED YET)                             00260000
.*                                                                      00270000
.*   REQUIRES INNER MACROS MDEFDICT, AND MACQOTER.                      00280000
.*     RELATED MACROS ARE MDEFHEAD, MDEFEND, AND MDEFGBL.               00290000
.*   MUST BE INVOKED IN AN RSECT. CREATES AND USES RSECTS NAMED         00300000
.*   MSGDSCT AND MSGSECT.                                               00310000
.*                                                                      00320000
.*   WHEN SECT=DSECT IS SPECIFIED, MAPPINGS FOR THREE CONTROL BLOCKS    00330000
.*   ARE EXPANDED: MTPDSECT - MAP MESSAGE POINTER                       00340000
.*                 MTMDSECT - MAP MESSAGE DEFINITION AND SPECIALS       00350000
.*                 MTDDSECT - MAP DICTIONARY DEFINITION                 00360000
.*                                                                      00370000
.*                                      V1 WRITTEN 3/1999 BY GYP        00380000
         COPY  MDEFGBL                                                  00390000
         GBLC  &MACQSTR                                                 00400000
         LCLA  &I,&J,&K,&N,&STRCNT,&STRDC                               00410000
         LCLC  &CH,&CHIX,&STRING,&LQ,&TCH,&FCODE,&LOTYP,&DCLAB          00420000
         LCLC  &QU,&TP,&LB                                      GP03245 00430000
&ZZSECT  SETC  '&SYSECT'                                                00440000
         AIF   ('&SECT' EQ 'DSECT').MAPPER                              00450000
&LB      SETC  '&NM'         SET LABEL TO SUPPLIED VALUE                00460000
         AIF   ('&ZZMPFX' EQ '').NMDOPF                         GP08078 00470000
&N       SETA  K'&ZZMPFX                                        GP08078 00480000
&DCLAB   SETC  '&LB'(1,&N)                                      GP08078 00490000
         AIF   ('&ZZMPFX' NE '&DCLAB').NMDOPF                   GP08078 00500000
&LB      SETC  '&NM'(&N+1,K'&NM)   REMOVE DUPLICATE PREFIX      GP08078 00510000
.NMDOPF  ANOP  ,                                                GP08078 00520000
&N       SETA  N'&SYSLIST                                               00530000
&DCLAB   SETC  '&ZZMPFX'.'&LB'  LABEL FOR FIRST/ONLY DEF STRING         00540000
.*  STRING ACCUMULATES ENTRIES FOR THE MESSAGE'S DICTIONARY LIST        00550000
.*  STRCNT CONTAINS THE NUMBER OF ENTRIES                               00560000
&STRING  SETC  ''                                                       00570000
&STRCNT  SETA  0                                                        00580000
.*  PFX OVERRIDES GLOBAL PREFIX, IF ANY, UNTIL CHANGED                  00590000
         AIF   ('&PFX' EQ '').NONUPFX                                   00600000
&ZZMPFX  SETC  '&PFX'                                                   00610000
.NONUPFX AIF   (&N GT 0).NUMGOOD                                        00620000
.*  NOTE THIS MAY APPEAR WHEN USER HAS UNBALANCED APOSTROPHES           00630000
         MNOTE 8,'MDEF: NO MESSAGE TEXT PROCESSABLE'                    00640000
         MEXIT ,                                                        00650000
.NUMGOOD AIF   ('&LB' NE '').LABGOOD                                    00660000
         MNOTE 8,'MDEF: MESSAGE ID (NAME FIELD) OMITTED'                00670000
         MEXIT ,                                                        00680000
.*  MAINTAIN GLOBAL TYPE. NOTE THAT X' IS TREATED AS C WITH X IN DATA   00690000
.LABGOOD ANOP  ,                                                        00700000
&LOTYP   SETC  'C'                                                      00710000
         AIF   ('&ZZMDTYP' EQ '').HAVEGBL                               00720000
&LOTYP   SETC  '&ZZMDTYP'                                               00730000
.HAVEGBL AIF   ('&TYPE' EQ '').GETWORD                                  00740000
&LOTYP   SETC  '&TYPE'                                                  00750000
.*                                                                      00760000
.*  LOOP THROUGH EACH WORD IN THE LIST                                  00770000
.*                                                                      00780000
.GETWORD AIF   (&K GE &N).PLANT                                         00790000
&K       SETA  &K+1                                                     00800000
&CH      SETC  '&SYSLIST(&K)'                                           00810000
&FCODE   SETC  ''            NO SPECIAL CODE                            00820000
&TCH     SETC  ''            NO SPECIAL TRAILER                         00830000
&I       SETA  K'&CH         SEE HOW LONG IT IS                         00840000
         AIF   (&I LT 1).COMMA  TREAT AS COMMA                          00850000
         AIF   (&I LT 2).WORD   NOTHING SPECIAL?                        00860000
         AIF   (N'&SYSLIST(&K) LE 1).NOSUB                              00870000
         AIF   ('&SYSLIST(&K,1)'(1,1) EQ '*').PARM                      00880000
.NOSUB   AIF   ('&CH'(1,1) EQ '*').PARM                                 00890000
&TCH     SETC  '&CH'(&I,1)                                              00900000
         AIF   ('&TCH' EQ '|').TRSP    ABUTTAL?                         00910000
         AIF   ('&TCH' EQ '¦').TRSP    ABUTTAL?                         00920000
         AIF   ('&TCH' EQ '-').TRCH                                     00930000
         AIF   ('&TCH' EQ '.').TRCH                                     00940000
         AIF   ('&TCH' EQ ':').TRCH                                     00950000
         AIF   ('&TCH' EQ ';').TRCH                                     00960000
         AIF   ('&TCH' EQ '/').TRCH                                     00970000
         AIF   ('&TCH' EQ '!').TRCH                                     00980000
         AIF   ('&TCH' EQ '?').TRCH                                     00990000
         AIF   ('&TCH' EQ '+').TRCH                                     01000000
         AIF   ('&TCH' EQ '*').TRCH                                     01010000
         AGO   .WORD                                                    01020000
.*                                                                      01030000
.*  PROCESS A PARM REFERENCE                                            01040000
.*    GENERAL FORM IS (*N,TYPE,MOD)                                     01050000
.*    N IS THE PARAMETER NUMBER IN CALL                                 01060000
.*    TYPE IS C (DEFAULT), I, P, ETC.                                   01070000
.*    MOD IS A FORMATTING MODIFIER                                      01080000
.*                                                                      01090000
.PARM    ANOP  ,             PRELIMINARY                                01100000
&J       SETA  1                                                        01110000
&QU      SETC  '0'                                                      01120000
&TP      SETC  'C'                                                      01130000
         AIF   (N'&SYSLIST(&K) LT 3).PARM2                              01140000
&QU      SETC  '&SYSLIST(&K,3)' QUALIFIER, IF ANY                       01150000
.PARM2   AIF   (N'&SYSLIST(&K) LT 2).PARM1                              01160000
&TP      SETC  '&SYSLIST(&K,2)' FORMATTING TYPE (C, O, X, P, I)         01170000
.PARM1   AIF   ('&TP' NE 'UI' AND '&TP' NE 'IU').PARMTP                 01180000
&TP      SETC  'U'                                                      01190000
.PARMTP  AIF   ('&TP' EQ 'CTAPDIIHXBBXXX'(&J,1)).PARMTPF                01200000
&J       SETA  &J+1                                                     01210000
         AIF   (&J LE 16).PARMTP                                        01220000
.PARMTPF ANOP  ,                                                        01230000
&J       SETA  &J-1                                                     01240000
&TP      SETC  '&J'                                                     01250000
&CH      SETC  '&SYSLIST(&K,1)'                                         01260000
&TCH     SETC  '&CH'(2,&I-1)  ISOLATE PARM NUMBER                       01270000
&FCODE   SETC  'X''E000''+('.'&TCH'.'-1)*256+16*'.'&QU'.'+'.'&TP'       01280000
         AGO   .CODESTR                                                 01290000
.*                                                                      01300000
.*  NULL PARAMETER - EXPAND A COMMA AND SPACE                           01310000
.*                                                                      01320000
.COMMA   ANOP  ,                                                        01330000
&CH      SETC  ','                                                      01340000
&FCODE   SETC  'X''FD00''+C'','''                                       01350000
         AGO   .CODESTR      ADD JUST A COMMA                           01360000
.*                                                                      01370000
.*  ABUTTAL - SEE WHETHER PRECEDING CHARACTER IS ALSO SPECIAL           01380000
.*                                                                      01390000
.TRSP    ANOP  ,             NO TRAILING SPACE                          01400000
&TCH     SETC  ' '                                                      01410000
&FCODE   SETC  'X''FE00''+C'''.'&TCH'.''''  ABUTTAL - NO SPACE          01420000
&CH      SETC  '&CH'(1,&I-1)  DROP TRAILER                              01430000
&I       SETA  K'&CH                                                    01440000
&TCH     SETC  '&CH'(&I,1)                                              01450000
         AIF   (&I LT 2).WORD   TOO SHORT -  PROCESS WORD PROPER        01460000
         AIF   ('&TCH' EQ '-').NSCH                                     01470000
         AIF   ('&TCH' EQ '.').NSCH                                     01480000
         AIF   ('&TCH' EQ ':').NSCH                                     01490000
         AIF   ('&TCH' EQ ';').NSCH                                     01500000
         AIF   ('&TCH' EQ '/').NSCH                                     01510000
         AIF   ('&TCH' EQ '!').NSCH                                     01520000
         AIF   ('&TCH' EQ '?').NSCH                                     01530000
         AIF   ('&TCH' EQ '+').NSCH                                     01540000
         AIF   ('&TCH' NE '*').WORD                                     01550000
.NSCH    ANOP  ,             SPECIAL CHARACTER + ABUTTAL                01560000
&CH      SETC  '&CH'(1,&I-1)  DROP TRAILER                              01570000
&FCODE   SETC  'X''FD00''+C'''.'&TCH'.''''                              01580000
         AGO   .WORD         PROCESS REST                               01590000
.*                                                                      01600000
.*  SPECIAL CHARACTER - STRIP FROM WORD, AND ADD LEXICAL SUFFIX ENTRY   01610000
.*                                                                      01620000
.TRCH    ANOP  ,                                                        01630000
&CH      SETC  '&CH'(1,&I-1)  DROP TRAILER                              01640000
&FCODE   SETC  'X''FD00''+C'''.'&TCH'.''''                              01650000
.*                                                                      01660000
.*  EXTRACT WORD; SEE WHAT IT IS; ADJUST ACCORDINGLY                    01670000
.*  REGARDLESS OF CURRENT FORM, PUT IT IN QUOTES                        01680000
.WORD    ANOP  ,                                                        01690000
&I       SETA  K'&CH                                                    01700000
         AIF   (&I LT 3).WORDQ                                          01710000
         AIF   ('&CH'(1,2) EQ 'X''').WORDH                              01720000
         AIF   ('&CH'(1,2) EQ 'B''').WORDH                              01730000
         AIF   ('&CH'(1,2) EQ 'C''').WORDC                              01740000
         AIF   ('&CH'(1,2) NE 'Z''').WORDQ                              01750000
.WORDC   ANOP  ,                                                        01760000
&CH      SETC  '&CH'(2,&I-1)                                            01770000
         AGO   .WORDQ                                                   01780000
.WORDH   ANOP  ,                                                        01790000
&MACQSTR SETC  '&CH'                                                    01800000
         AGO   .WORDD                                                   01810000
.WORDQ   MACQOTER &CH,OPT=QUOTE,NAME=MDEF,TYPE=&LOTYP                   01820000
.*  ADD THIS WORD TO DICTIONARY, OR GET DICTIONARY INDEX IN ZZDCTRT     01830000
.WORDD   MDEFDICT &MACQSTR,TYPE=&LOTYP                                  01840000
&CHIX    SETC  '00000'.'&ZZDCTRT'                                       01850000
&J       SETA  K'&CHIX                                                  01860000
&CHIX    SETC  '&CHIX'(&J-4,5)                                          01870000
.*                                                                      01880000
.*  ADD DICTIONARY OFFSET TO STRING, AND UP COUNTER                     01890000
.STRINGS AIF   ('&STRING' NE '').APPEND                                 01900000
&STRING  SETC  'DWD&CHIX-MSGDSCT'                                       01910000
         AGO   .APPCNT                                                  01920000
.APPEND  ANOP  ,                                                        01930000
&STRING  SETC  '&STRING'.','.'DWD&CHIX-MSGDSCT'                         01940000
.APPCNT  ANOP  ,             COUNT ENTRIES IN STRING                    01950000
&STRCNT  SETA  &STRCNT+1                                                01960000
.CODESTR AIF   ('&FCODE' EQ '').TESTDC                                  01970000
         AIF   (&ZZDOFLN EQ 4).SCALE4                                   01980000
         AIF   (&ZZDOFLN NE 3).SCALED                                   01990000
&FCODE   SETC  '('.'&FCODE'.')*256'                                     02000000
         AGO   .SCALED                                                  02010000
.SCALE4  ANOP  ,                                                        02020000
&FCODE   SETC  '('.'&FCODE'.')*65536'                                   02030000
.SCALED  AIF   ('&STRING' NE '').SUFFIX                                 02040000
&STRING  SETC  '&FCODE'                                                 02050000
         AGO   .SUFFCNT                                                 02060000
.SUFFIX  ANOP  ,                                                        02070000
&STRING  SETC  '&STRING'.','.'&FCODE'                                   02080000
.SUFFCNT ANOP  ,                                                        02090000
&STRCNT  SETA  &STRCNT+1                                                02100000
.*  WHEN THE STRING HAS AN ARBITRARY NUMBER OF ENTRIES, EXPAND IT       02110000
.*    TO AVOID OVERFLOWING LEGAL LENGTHS                                02120000
.TESTDC  AIF   ((&STRCNT-&STRDC) LE 6).GETWORD                  GP08082 02130000
MSGSECT  CSECT ,                                                        02140000
&STRDC   SETA  &STRCNT                                                  02150000
&DCLAB   DC    AL&ZZDOFLN.(&STRING)                                     02160000
&DCLAB   SETC  ''                                                       02170000
&STRING  SETC  ''                                                       02180000
         AGO   .GETWORD                                                 02190000
.*  LAST WORD PROCESSED. EXPAND MESSAGE DEFINITION                      02200000
.PLANT   AIF   ('&STRING' EQ '').PLEITE                                 02210000
MSGSECT  CSECT ,                                                        02220000
&DCLAB   DC    AL&ZZDOFLN.(&STRING)                                     02230000
.PLEITE  AIF   (&ZZMSGIX NE 1).PLINT                                    02240000
&LQ      SETC  'L'''                                                    02250000
LENWDPTR EQU   &LQ&ZZMPFX&LB DEFINE FIELD LENGTH FOR DICT. PTR          02260000
.PLINT   ANOP  ,                                                        02270000
.*  EXPAND POINTER TO MESSAGE STRING JUST CREATED                       02280000
&ZZSECT  CSECT ,                                                        02290000
&ZZMSGIX SETA  &ZZMSGIX+1                                               02300000
&CHIX    SETC  '00000'.'&ZZMSGIX'                                       02310000
&J       SETA  K'&CHIX                                                  02320000
&CHIX    SETC  '&CHIX'(&J-4,5)                                          02330000
MPT&CHIX DC    AL&ZZMOFLN.(&ZZMPFX&LB-MSGSECT),CL&ZZIDLEN'&ZZMPFX&LB',A*02340000
               L2(&STRCNT)                                              02350000
         AIF   (&ZZMSGIX NE 1).NOMPTLN                                  02360000
MPTSIZE  EQU   *-MPT&CHIX    DEFINE ENTRY LENGTH                        02370000
.NOMPTLN ANOP  ,                                                        02380000
&ZZSECT  CSECT ,                                                        02390000
&CH      SETC  '&ZZMPFX'.'&LB'  GET MESSAGE ID                          02400000
         AIF   ('&CH' GE '&ZZMGPRE').SEQOK                              02410000
&ZZMGSRT SETC  'IS NOT'      MESSAGES NOT IN SEQUENCE                   02420000
.SEQOK   AIF   ('&CH' GE '&ZZMGLO').SEQLO                               02430000
&ZZMGLO  SETC  '&CH'         REMEMBER LOWEST ID                         02440000
.SEQLO   AIF   ('&CH' LE '&ZZMGHI').SEQHI                               02450000
&ZZMGHI  SETC  '&CH'         REMEMBER HIGHEST ID                        02460000
.SEQHI   ANOP  ,                                                        02470000
&ZZMGPRE SETC  '&CH'         REMEMBER PREVIOUS ID                       02480000
.MEXIT   MEXIT ,                                                        02490000
.MAPPER  ANOP  ,             ENTRY MAPPING - FIXED NAMES                02500000
MTPDSECT DSECT ,             MESSAGE TABLE POINTER ENTRY                02510000
MTPMSGOF DS    AL&ZZMOFLN    OFFSET TO MESSAGE DEFINITION               02520000
MTPMSGID DS    CL&ZZIDLEN    MESSAGE IDENTIFIER                         02530000
MTPWDCNT DS    AL&ZZDOFLN    NUMBER OF ENTRIES FOLLOWING                02540000
         SPACE 1                                                        02550000
MTMDSECT DSECT ,             MESSAGE DEFINITION ENTRY                   02560000
MTMDICOF DS    AL&ZZDOFLN    ONE OR MORE DICTIONARY OFFSETS OR SPECIALS 02570000
MTSPFUN  EQU   X'D0'           FUNCTION INVOCATION                      02580000
MTSPPRM  EQU   X'E0'           CALL PARAMETER INSERTION                 02590000
MTSPMETA EQU   X'F0'           SYNTACTICAL FUNCTIONS                    02600000
         SPACE 1                                                        02610000
MTDDSECT DSECT ,             DICTIONARY ENTRY DEFINITION                02620000
MTDPHYLN DS    AL1           PHYSICAL ENTRY LENGTH                      02630000
MTDLOGLN DS    AL1           LOGICAL ENTRY LENGTH                       02640000
MTDTYPE  DS    C             ENTRY TYPE - C (OR G, LATER)               02650000
MTDTEXT  DS    0C            VARIABLE LENGTH TEXT                       02660000
         MEND  ,                                                        02670000
./ ADD NAME=MINH
         MACRO ,                                                        00010000
&NM      MINH  &R,&A                                     ADDED  GP04128 00020000
         LCLA  &I                                                       00030000
&I       SETA  &SYSNDX                                                  00040000
&NM      MACPARM &R,&A,OP=CH,OPR=CR,MODE=EQU                            00050000
         MACPARM ZZZZ&I,OP=BNH,MODE=ONE                                 00060000
         MACPARM &R,&A,OP=LH,OPR=LR,MODE=EQU                            00070000
ZZZZ&I   DS    0H                                                       00080000
.MEND    MEND  ,                                                        00090000
./ ADD NAME=MIN
         MACRO ,                                                        00010000
&NM      MIN   &R,&A,&TYPE=                                      85195  00020000
         LCLA  &I                                                       00030000
         LCLC  &SUF                                             GP04234 00040000
         AIF   ('&TYPE' EQ 'F' OR '&TYPE' EQ 'A').NOSUF         GP04234 00050000
&SUF     SETC  '&TYPE'                                          GP04234 00060000
.NOSUF   ANOP  ,                                                GP04234 00070000
&I       SETA  &SYSNDX                                                  00080000
&NM      MACPARM &R,&A,OP=C&SUF,OPR=C&SUF.R,MODE=EQU                    00090000
         MACPARM ZZZZ&I,OP=BNH,MODE=ONE                                 00100000
         MACPARM &R,&A,OP=L&SUF,OPR=L&SUF.R,MODE=EQU                    00110000
ZZZZ&I   DS    0H                                                       00120000
.MEND    MEND  ,                                                        00130000
./ ADD NAME=MOTE
         MACRO                                                          00010000
         MOTE  &LVL,&TXT                                ADDED ON 81164  00020000
         MNOTE &LVL,&TXT                                                00030000
.*       THIS MACRO NEEDED BECAUSE CAN'T ISSUE MNOTE FROM PROGRAM       00040000
.*       MNOTE MUST BE ISSUED FROM WITHIN A MACRO.   BOOO, HISS.        00050000
         MEND                                                           00060000
./ ADD NAME=MSORT
         MACRO                                                          00010000
&NM      MSORT &ADDR=,&SIZE=,&OFF=,&COMPL=,&NUM=,&RET=R14,&EXIT=,      *00020000
               &ORDER=A                                                 00030000
.*--------------------------------------------------------------------* 00040000
.*                                                                    * 00050000
.*     ADAPTED FROM SORT APPEARING IN 'FORTRAN PROGRAMMING' BY        * 00060000
.*     FREDRIC STUART, WILEY '69. ORIGINATED BY D.L. SHELL, MODIFIED  * 00070000
.*     BY MARLENE METZNER (PRATT&WHITNEY).                            * 00080000
.*                                                                    * 00090000
.*     INPUT PARAMETERS :                                             * 00100000
.*     ADDR  ADDRESS OF LIST TO BE SORTED; REL-EXP OR (REG 2-12)      * 00110000
.*     SIZE  SIZE OF LIST ENTRY; SELF-DEFINING TERM OR (REG 2-12)     * 00120000
.*     OFF   OFFSET OF COMPARE STRING FROM START OF ENTRY;  -''-      * 00130000
.*     COMPL LENGTH OF COMPARE STRING;                      -''-      * 00140000
.*     NUMBER  NUMBER OF ENTRIES IN LIST;                   -''-      * 00150000
.*                                                               92052* 00160000
.*     WHEN THE EXIT= PARAMETER IS SPECIFIED, OFF AND COMPL ARE NOT   * 00170000
.*     USED.  THE CODE INVOKES THE EXIT USING SORT'S R0-R9; R4 POINTS * 00180000
.*     TO CURRENT ENTRY, R8 TO NEXT ENTRY, USER RETURNS TO R14 WITH   * 00190000
.*     CC 2 TO SWAP ENTRIES, CC 0 OR 1 TO RETAIN.                92052* 00200000
.*                                                               92052* 00210000
.*     THE AREA POINTED TO BY REGISTER 13 IS USED TO SAVE CALLER'S    * 00220000
.*     REGISTERS AND AS A WORK AREA FOR RE-ENTRANCY.                  * 00230000
.*                                                                    * 00240000
.*     RET   RETURN REGISTER                                          * 00250000
.*           BR TO RET - ERROR IN PARAMETERS OR VALUES                * 00260000
.*           B TO RET+4 - COMPLETED                                   * 00270000
.*                                                                    * 00280000
.*     ADDED ORDER=A / ORDER=D FOR SORT DIRECTION               GP04020 00290000
.*                                                                    * 00300000
.*--------------------------------------------------------------------* 00310000
         GBLC  &MACPLAB                                                 00320000
         LCLA  &I                                                       00330000
         LCLC  &ORDBC                                                   00340000
&MACPLAB SETC  ''                                                       00350000
&I       SETA  &SYSNDX                                                  00360000
&ORDBC   SETC  'ADDR'                                           GP04020 00370000
         AIF   ('&ADDR' EQ '').MISSOP                           GP04020 00380000
&ORDBC   SETC  'SIZE'                                           GP04020 00390000
         AIF   ('&SIZE' EQ '').MISSOP                           GP04020 00400000
         AIF   ('&EXIT' NE '' AND '&EXIT' NE '0').NOOFF NO NEED GP04234 00410000
&ORDBC   SETC  'OFF'                                            GP04020 00420000
         AIF   ('&OFF' EQ '').MISSOP                            GP04020 00430000
&ORDBC   SETC  'COMPL'                                          GP04020 00440000
         AIF   ('&COMPL' EQ '').MISSOP                          GP04020 00450000
.NOOFF   ANOP  ,                                                GP04234 00460000
&ORDBC   SETC  'NUM'                                            GP04020 00470000
         AIF   ('&NUM' EQ '').MISSOP                            GP04020 00480000
&ORDBC   SETC  'RET'                                            GP04020 00490000
         AIF   ('&RET' EQ '').MISSOP                            GP04020 00500000
&ORDBC   SETC  'H'           ASCENDING (BNH)                            00510000
         AIF   ('&ORDER' EQ 'A').ORDNUNG                                00520000
&ORDBC   SETC  'L'           DESCENDING (BNL)                           00530000
         AIF   ('&ORDER' EQ 'D').ORDNUNG                                00540000
         MNOTE 8,'MSORT: ORDER MUST BE A (ASCENDING) OR D (DESCENDING)' 00550000
&ORDBC   SETC  'H'           ASCENDING (BNH)                            00560000
.ORDNUNG ANOP  ,                                                        00570000
&NM      STM   R14,R9,20(R13)   SAVE REGISTERS                   92052  00580000
         LA    R0,1                    MAKE CONSTANT                    00590000
         AIF   ('&EXIT' EQ '' OR '&EXIT' EQ '0').NOEXIT          92052  00600000
         MACPARM R15,&EXIT,OP=LA                                 92052  00610000
         LTR   R15,R15       VALID EXIT ?                        92052  00620000
         BZR   R14           NO; RETURN ERROR                    92052  00630000
         ST    R15,12(,R13)  SAVE EXIT ADDRESS                   92052  00640000
         AGO   .NOCLC                                            92052  00650000
.NOEXIT  MVC   12(6,R13),SRT&I.Z       MOVE PATTERN CLC                 00660000
         MACPARM R9,&OFF,OP=LA         GET COMPARE OFFSET               00670000
         STC   R9,15(,R13)             STASH INTO CLC                   00680000
         STC   R9,17(,R13)              FOR COMPARE                     00690000
         MACPARM R9,&COMPL,OP=LA       GET COMPARE LENGTH               00700000
         SR    R9,R0                   LENGTH FOR CLC                   00710000
         BM    SRT&I.Y                 TAKE ERROR EXIT                  00720000
         STC   R9,13(,R13)             SET INTO CLC LENGTH FIELD        00730000
.NOCLC   MACPARM R2,&SIZE,OP=LA        GET SIZE OF ENTRY                00740000
         LR    R3,R2                   COPY INTO EXECUTE REGISTER       00750000
         SR    R3,R0                   DECREMENT FOR EXECUTE            00760000
         BM    SRT&I.Y                 TAKE ERROR EXIT                  00770000
         MACPARM R9,&NUM,OP=L          GET NUMBER OF ENTRIES    GP09245 00780000
         CR    R9,R0                   CHECK AT LEAST TWO ENTRIES       00790000
         BNH   SRT&I.B                 TAKE GOOD EXIT IF NONE           00800000
         MR    R8,R2                   CONVERT TO TABLE LENGTH          00810000
         MACPARM R1,&ADDR,OP=LA        GET TABLE BASE ADDRESS           00820000
         LR    R7,R9                   COPY TO SUBLIST                  00830000
SRT&I.A  SRL   R7,1                    HALVE SUBLIST SIZE               00840000
         XR    R6,R6                     CLEAR FOR DIVIDE               00850000
         DR    R6,R2                   CONVERT TO LIST ENTRIES          00860000
         MR    R6,R2                   BACK TO INT(M/S)                 00870000
         LTR   R7,R7                   ANY LEFT TO BE DONE ?            00880000
         BP    SRT&I.C                 YES; PROCEED                     00890000
SRT&I.B  LM    R14,R9,20(R13)    RESTORE USER'S REGISTERS        92052  00900000
         B     4(,&RET)                TAKE GOOD EXIT                   00910000
SRT&I.C  LR    R6,R9                   GET ENTRY SIZE                   00920000
         SR    R6,R7                   GET SIZE OF OTHER HALF           00930000
         XR    R5,R5                   CLEAR COUNTER                    00940000
SRT&I.D  LA    R4,0(R5,R1)             GET ADDRESS OF NEXT ELEMENT      00950000
SRT&I.E  LA    R8,0(R4,R7)             GET ADDRESS OF OTHER ELEMENT     00960000
         AIF   ('&EXIT' EQ '' OR '&EXIT' EQ '0').EXCOMP          92052  00970000
         L     R15,12(,R13)  LOAD EXIT ADDRESS                   92052  00980000
         BASR  R14,R15       INVOKE THE EXIT                     92052  00990000
         AGO   .COMPAR       BRANCH AS SET BY USER               92052  01000000
.EXCOMP  EX    0,12(,R13)              COMPARE THE TWO                  01010000
.COMPAR  BN&ORDBC SRT&I.F              IN SEQUENCE - SKIP FLIP          01020000
         EX    R3,SRT&I.Z+6            FLIP THE                         01030000
         EX    R3,SRT&I.Z+12             TWO                            01040000
         EX    R3,SRT&I.Z+6                LIST ENTRIES                 01050000
         SR    R4,R7                   GET NEXT ELEMENT                 01060000
         CR    R4,R1                   BACK TO START OF TABLE ?         01070000
         BNL   SRT&I.E                 NO; TRY AGAIN                    01080000
SRT&I.F  AR    R5,R2                   NEXT COMPARE ELEMENT ADDRESS     01090000
         CR    R5,R6                   DONE THIS PART OF LIST ?         01100000
         BNL   SRT&I.A                 YES; GET ANOTHER SUBLIST         01110000
         B     SRT&I.D                 ELSE PROCEED                     01120000
SRT&I.Y  LM    R14,R9,20(R13)  RESTORE REGISTERS                 92052  01130000
         BR    &RET                    TAKE ERROR EXIT                  01140000
SRT&I.Z  CLC   0(0,R4),0(R8)           PATTERN COMPARE                  01150000
         XC    0(0,R4),0(R8)           FLIP 1/3                         01160000
         XC    0(0,R8),0(R4)           FLIP  2                          01170000
         MEXIT ,                                                GP04020 01180000
.MISSOP  MNOTE 8,'MSORT: MISSING OPERAND &ORDBC'                GP04020 01190000
&NM      MACPARM R14,OP=BR,MODE=ONE  EXPAND LABEL & ERROR RETURN        01200000
         MEND  ,                                                        01210000
./ ADD NAME=MTITL
         MACRO                                                          00010000
&L       MTITL &TIT,&LEN=40                                             00020000
.*             THIS MACRO IS CALLED AT THE BEGINNING OF AN ASSEMBLY,    00030000
.*             IN ORDER TO SET UP THE LEFT HALF OF THE TITLE.           00040000
.*             IT IS INTENDED TO BE USED IN CONJUNCTION WITH STITL.     00050000
.*             MAIN HALF OF TITLE IS PADDED TO &LEN CHARACTERS.         00060000
.*                                                                      00070000
.*             THIS MACRO MAY NOT BE USED WITH ASSEMBLER F.             00080000
.*             USE F EXTENDED(FROM OS/VS), G WITH LSETC=255, OR H.      00090000
.*       CHANGES DATED 81154 MADE TO SUPPORT ASSEMBLER G AS ADVERTISED  00100000
         GBLC  &MTITLE                                                  00110000
         LCLA  &I,&LN                                                   00120000
         LCLC  &BS                                               81154  00130000
&BS      SETC  '                                        '  L'40  81154  00140000
&I       SETA  1                                                        00150000
         AIF   ('&TIT'(1,1) NE '''' OR '&TIT'(K'&TIT,1) NE '''').DEL    00160000
.LOOP    AIF   (&I GE K'&TIT-1).ENDLOOP                                 00170000
         AIF   (&LN GE &LEN).TOOBIG                                     00180000
&I       SETA  &I+1                                                     00190000
&LN      SETA  &LN+1                                                    00200000
         AIF   ('&TIT'(&I,1) EQ '''' OR '&TIT'(&I,1) EQ '&&').SPECIAL   00210000
&MTITLE  SETC  '&MTITLE'.'&TIT'(&I,1)                                   00220000
         AGO   .LOOP                                                    00230000
.*                                                                      00240000
.DEL     MNOTE 4,'TITLE NOT DELIMITED BY "''" - IGNORED'                00250000
&MTITLE  SETC  'LEARN TO PUT QUOUTES AROUND THINGS'                     00260000
.*                                                                      00270000
.SPECIAL AIF   (&I EQ K'&TIT).NOTPAIR                                   00280000
         AIF   ('&TIT'(&I,1) NE '&TIT'(&I+1,1)).NOTPAIR                 00290000
&MTITLE  SETC  '&MTITLE'.'&TIT'(&I,2)                                   00300000
&I       SETA  &I+1                                                     00310000
         AGO   .LOOP                                                    00320000
.*                                                                      00330000
.NOTPAIR MNOTE 4,' CHARACTER "''" OR "&&" NOT PAIRED'                   00340000
&MTITLE  SETC  '&MTITLE'.'&TIT'(&I,1).'&TIT'(&I,1)               81154  00350000
         AGO   .LOOP                                                    00360000
.*                                                                      00370000
.TOOBIG  MNOTE 4,'TITLE LONGER THAN &LEN - EXCESS TRUNCATED'            00380000
         MEXIT                                                          00390000
.*                                                                      00400000
.ENDLOOP AIF   (&LN EQ &LEN).END                                        00410000
&I       SETA  &LEN-&LN                                          81154  00420000
.PADLOOP AIF   (&I LE 40).TRUNCB                                 81154  00430000
&MTITLE  SETC  '&MTITLE'.'&BS'                                   81154  00440000
&I       SETA  &I-40                                             81154  00450000
         AGO   .PADLOOP                                          81154  00460000
.TRUNCB  AIF   (&I LT 1).END                                     81154  00470000
&MTITLE  SETC  '&MTITLE'.'&BS'(1,&I)                             81154  00480000
.END     MEND                                                           00490000
./ ADD NAME=MVC2
         MACRO ,                                                        00010000
&NM      MVC2  &TO,&FR                                      NEW GP08096 00020000
.*                                                                      00030000
.*   THIS LITTLE GOODY IS BASED ON AN IDEA OFFERED IN THE ASSEMBLER     00040000
.*   LIST, NAMELY THAT THERE SHOULD BE A MOVE INSTRUCTION WHOSE DEFAULT 00050000
.*   LENGTH IS THAT OF THE SECOND OPERAND.                              00060000
.*                                                                      00070000
         GBLA  &MACPLEN      RETURN SIGNIFICANT LENGTH OF STRING        00080000
         GBLB  &MACPNUL      TRUE IF NULL STRING                        00090000
         GBLB  &MACQUOT      TRUE IF ORIGINAL WAS QUOTED                00100000
         GBLB  &MACPERR      TRUE IF ERROR                              00110000
         GBLC  &MACQSTR      RETURN QUOTED STRING                       00120000
         LCLA  &K,&I,&J                                                 00130000
         LCLC  &L,&LF,&RT                                               00140000
&L       SETC  'L'''                                                    00150000
         AIF   ('&TO' EQ '').NOTO                                       00160000
         AIF   ('&FR' EQ '').NOFR                                       00170000
&K       SETA  K'&TO                                                    00180000
         MACQOLIT &FR        CHECK FOR QUOTED STRING            GP08130 00190000
         AIF   (&MACQUOT).QUOTED                                GP08130 00200000
         AIF   ('&TO'(&K,1) NE ')').SIMPLE                              00210000
.*  PARSE xxx ( yyy ) - CHANGE TO xxx ( L'fr , yyy )                    00220000
&I       SETA  &K                                                       00230000
&J       SETA  1                                                        00240000
.LOOP    AIF   (&I LE 1).ERRTO                                          00250000
&I       SETA  &I-1                                                     00260000
         AIF   ('&TO'(&I,1) EQ '(').HAVLEFT                             00270000
         AIF   ('&TO'(&I,1) EQ ')').HAVRITE                             00280000
         AGO   .LOOP                                                    00290000
.HAVRITE ANOP  ,                                                        00300000
&J       SETA  &J+1                                                     00310000
         AGO   .LOOP                                                    00320000
.HAVLEFT ANOP  ,                                                        00330000
&J       SETA  &J-1                                                     00340000
         AIF   (&J GT 0).LOOP                                           00350000
         AIF   (&I LE 1).SIMPLE   ((XYZ-RST))                           00360000
&LF      SETC  '&TO'(1,&I)                                              00370000
&RT      SETC  '&TO'(&I+1,&K-&I)                                        00380000
&NM      MVC   &LF&L&FR,&RT,&FR                                         00390000
         MEXIT ,                                                        00400000
.QUOTED  AIF   ('&TO'(&K,1) NE ')').QSIMP                       GP08130 00410000
.*  PARSE xxx ( yyy ) - CHANGE TO xxx ( L'fr , yyy )            GP08130 00420000
&I       SETA  &K                                               GP08130 00430000
&J       SETA  1                                                GP08130 00440000
.QLOOP   AIF   (&I LE 1).ERRTO                                  GP08130 00450000
&I       SETA  &I-1                                             GP08130 00460000
         AIF   ('&TO'(&I,1) EQ '(').QLEFT                       GP08130 00470000
         AIF   ('&TO'(&I,1) EQ ')').QRITE                       GP08130 00480000
         AGO   .QLOOP                                           GP08130 00490000
.QRITE   ANOP  ,                                                GP08130 00500000
&J       SETA  &J+1                                             GP08130 00510000
         AGO   .QLOOP                                           GP08130 00520000
.QLEFT   ANOP  ,                                                GP08130 00530000
&J       SETA  &J-1                                             GP08130 00540000
         AIF   (&J GT 0).QLOOP                                  GP08130 00550000
         AIF   (&I LE 1).QSIMP   ((XYZ-RST))                    GP08130 00560000
&LF      SETC  '&TO'(1,&I)                                      GP08130 00570000
&RT      SETC  '&TO'(&I+1,&K-&I)                                GP08130 00580000
&NM      MVC   &LF&MACPLEN,&RT,&MACQSTR                         GP08130 00590000
         MEXIT ,                                                GP08130 00600000
.QSIMP   ANOP  ,                                                GP08130 00610000
&NM      MVC   &TO.(&MACPLEN),&MACQSTR                          GP08130 00620000
         MEXIT ,                                                GP08130 00630000
.ERRTO   MNOTE 8,'MVC2: TO OPERAND IS MALFORMED'                        00640000
         MEXIT ,                                                        00650000
.SIMPLE  ANOP  ,                                                        00660000
&NM      MVC   &TO.(&L&FR),&FR                                          00670000
         MEXIT ,                                                        00680000
.NOTO    MNOTE 8,'MVC2: TO OPERAND MISSING'                             00690000
         MEXIT ,                                                        00700000
.NOFR    MNOTE 8,'MVC2: FROM OPERAND MISSING'                           00710000
         MEND  ,                                                        00720000
./ ADD NAME=MVCLIT
         MACRO ,                                                        00010000
&NM      MVCLIT &TO,&FRO,&ULEN                                          00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*    MOVE DATA (LITERAL) FROM A FIELD TO A FIELD USING THE           * 00050000
.*      LENGTH OF THE SECOND OPERAND                                  * 00060000
.*                                                                    * 00070000
.********************************************************************** 00080000
         GBLA  &MACPLEN      RETURN SIGNIFICANT LENGTH OF STRING        00090000
         GBLB  &MACPNUL      TRUE IF NULL STRING                        00100000
         GBLB  &MACQUOT      TRUE IF ORIGINAL WAS QUOTED                00110000
         GBLB  &MACPERR      TRUE IF ERROR                              00120000
         GBLC  &MACQSTR      RETURN QUOTED STRING                       00130000
         LCLA  &K                                                       00140000
         LCLC  &C,&D,&L                                                 00150000
       MACQOLIT &FRO         SEE WHAT WE HAVE FOR SOURCE                00160000
&D       SETC  '&MACPLEN'                                               00170000
         AIF   (NOT &MACPNUL).QERR                                      00180000
         MNOTE 8,'MVCLIT: SOURCE IS REQUIRED'                           00190000
         AGO   .FRODO                                                   00200000
.QERR    AIF   (NOT &MACPERR).FRODO                                     00210000
         MNOTE 8,'MVCLIT: SOURCE IS MALFORMED'                          00220000
.FRODO   AIF   (&MACQUOT).QDEST        QUOTED ?                         00230000
&L       SETC  'L'''                                                    00240000
&D       SETC  '&L'.'&FRO'             NO; USE LENGTH ATTRIBUTE         00250000
.QDEST   AIF   (T'&TO NE 'O').FRQREG   CHECK FOR REGISTER FORM          00260000
         MNOTE 8,'MVCLIT: DESTINATION REQUIRED'                         00270000
         MEXIT ,                                                        00280000
.FRQREG  AIF   (T'&ULEN EQ 'O').CMPLEN                                  00290000
&D       SETC  '&ULEN'                                                  00300000
.CMPLEN  ANOP  ,                                                        00310000
&K       SETA  K'&TO                                                    00320000
         AIF   (&K LT 3).TOADD         DO AS ADDRESS FORM               00330000
         AIF   ('&TO'(1,1) NE '(' OR '&TO'(&K,1) NE ')').TOADD          00340000
         AIF   ('&TO'(2,1) EQ '(' OR '&TO'(&K-1,1) EQ ')').TOADD        00350000
&C       SETC  '&TO'(2,&K-1)           STRIP (                          00360000
&NM      MVC   0(&D,&C,&MACQSTR                                         00370000
         MEXIT ,                                                        00380000
.TOADD   ANOP  ,                                                        00390000
&NM      MVC   &TO.(&D),&MACQSTR                                        00400000
.MEND    MEND                                                           00410000
./ ADD NAME=MVICC
         MACRO ,                                                        00010000
&N       MVICC &CODE,&REAS,&RESULT=                    NEW 2003.091 GYP 00020000
         GBLC  &ZZCCNAM                                                 00030000
         LCLC  &L                                                       00040000
&L       SETC  'L'''                                                    00050000
         AIF   ('&RESULT' EQ '').NONEW                                  00060000
&ZZCCNAM SETC  '&RESULT'                                                00070000
.NONEW   AIF   ('&ZZCCNAM' NE '').NODEF                                 00080000
         MNOTE *,'MVICC: RESULT= NOT SPECIFIED - DEFAULTED TO RETCODE'  00090000
&ZZCCNAM SETC  'RETCODE'                                                00100000
.NODEF   ANOP  ,                                                        00110000
&N MACPARM &ZZCCNAM+&L&ZZCCNAM-1,&CODE,OP=MVI,OPR=STC,NULL=SKIP,       *00120000
               MODE=REV                                                 00130000
   MACPARM &ZZCCNAM+&L&ZZCCNAM+3,&REAS,OP=MVI,OPR=STC,NULL=SKIP,       *00140000
               MODE=REV                                                 00150000
         MEND  ,                                                        00160000
./ ADD NAME=MVSDSAB
         MACRO                                                          00010000
&NM      MVSDSAB &DDNAME=,&DCBPTR=,&DSABPTR=,&TCBPTR=,&RETCODE=,       *00020000
               &RSNCODE=,&MF=                                           00030000
         GBLB  &MVSESA       IF ESA, USE IBM'S MACRO AND SERVICE        00040000
         GBLC  &MACPLAB      FIRST LABEL EXPANDED, IF ANY               00050000
.********************************************************************** 00060000
.*                                                                    * 00070000
.*   THIS MACRO LINKS TO LOCAL SUBROUTINE SUBDSAB FOR EARLY SYSTEMS   * 00080000
.*   (E.G., MVS 3.8J). FOR ESA AND LATER, IT INVOKES IBM'S GETDSAB    * 00090000
.*   SERVICE                                                          * 00100000
.*                                                                    * 00110000
.********************************************************************** 00120000
         LCLC  &MF1,&MF2,&MF3,&LLN,&@REQ,&@TCB,&@RSN,&@RET              00130000
         LCLA  &I,&J,&K,&#REQ                                           00140000
&MF1     SETC  '&MF(1)'                                                 00150000
&MF2     SETC  '&MF(2)'                                                 00160000
&MF3     SETC  '&MF(3)'                                                 00170000
&LLN     SETC  '5'           NUMBER OF WORDS IN LIST                    00180000
         AIF   (NOT &MVSESA).USELOCL                                    00190000
&NM      GETDSAB &SYSLIST(1),DDNAME=&DDNAME,DCBPTR=&DCBPTR, *           00200000
               DSABPTR=&DSABPTR,TCBPTR=&TCBPTR,                        *00210000
               RETCODE=&RETCODE,RSNCODE=&RSNCODE,MF=&MF                 00220000
         MEXIT ,                                                        00230000
.USELOCL ANOP ,                                                         00240000
         AIF   ('&MF1' EQ 'L').LIST                                     00250000
&MACPLAB SETC  '&NM'         LABEL TO BE EXPANDED                       00260000
         AIF   ('&MF1' EQ 'S' OR '&MF1' EQ '').STND                     00270000
         AIF   ('&MF1' EQ 'E').EXEC                                     00280000
         MNOTE 8,'MF=&MF1 NOT A SUPPORTED OPTION'                       00290000
         MEXIT ,                                                        00300000
.*                                                                      00310000
.LIST    AIF   ('&MF3' NE '').LISTEX                                    00320000
&MF3     SETC  '0A'          DEFAULT ALIGNMENT                          00330000
.LISTEX  AIF   ('&MF3' EQ '0F' OR '&MF3' EQ '0D' OR                    *00340000
               '&MF3' EQ '0A').LISTAOK                                  00350000
         MNOTE 4,'MF= &MF3 NOT SUPPORTED; USING 0F'                     00360000
&MF3     SETC  '0A'          FORCED ALIGNMENT                           00370000
.LISTAOK AIF   ('&SYSLIST(1)' NE '').LISTBAD                            00380000
         AIF   ('&DDNAME' NE '').LISTBAD                                00390000
         AIF   ('&DCBPTR' NE '').LISTBAD                                00400000
         AIF   ('&DSABPTR' NE '').LISTBAD                               00410000
         AIF   ('&TCBPTR' NE '').LISTBAD                                00420000
         AIF   ('&RETCODE' NE '').LISTBAD                               00430000
         AIF   ('&RSNCODE' EQ '').LISTEXP                               00440000
.LISTBAD MNOTE 4,'KEYWORD SETTINGS IGNORED FOR MF=L'                    00450000
.LISTEXP ANOP  ,                                                        00460000
&MF2     DS    &MF3                                                     00470000
&NM      MACPARM MODE=LABEL  EXPAND ADDITIONAL LABEL, IF NEEDED         00480000
         DC    &LLN.AL4(0)                                              00490000
         MEXIT ,                                                        00500000
.*                                                                      00510000
.STND    ANOP  ,                                                        00520000
         MACPARM R1,*+4*&LLN+4,OP=BAL                                   00530000
         DC    &LLN.AL4(0)                                              00540000
         AGO   .EXECC                                                   00550000
.*                                                                      00560000
.EXEC    AIF   ('&MF2' NE '').EXECR1                                    00570000
         MNOTE 8,'MF=(E,LIST) NEEDS LIST ADDRESS'                       00580000
         MEXIT ,                                                        00590000
.EXECR1  MACPARM R1,&MF2                                                00600000
.EXECC   MACPARM 0(4*&LLN,R1),0(R1),OP=XC  CLEAR LIST                   00610000
         AIF   ('&DCBPTR' EQ '' AND '&DDNAME' EQ '').NODUPE             00620000
         MNOTE 8,'DCBPTR AND DDNAME ARE MUTUALLY EXCLUSIVE'             00630000
         MEXIT ,                                                        00640000
.EXCDCB  MNOTE 8,'FIRST/NEXT AND DCBPTR= ARE MUTUALLY EXCLUSIVE'        00650000
         MEXIT ,                                                        00660000
.EXCDDN  MNOTE 8,'FIRST/NEXT AND DDNAME= ARE MUTUALLY EXCLUSIVE'        00670000
         MEXIT ,                                                        00680000
.NODUPE  AIF   ('&SYSLIST(1)' NE '' AND '&DCBPTR' NE '').EXCDCB         00690000
         AIF   ('&SYSLIST(1)' NE '' AND '&DDNAME' NE '').EXCDDN         00700000
&#REQ    SETA  1             GET FIRST DSAB                             00710000
&@REQ    SETC  '0'           NO ADDRESS NEEDED                          00720000
         AIF   ('&SYSLIST(1)' EQ 'FIRST').OTHR   LOOK FOR OTHERS        00730000
&#REQ    SETA  2             GET NEXT DSAB                              00740000
&@REQ    SETC  '0'           NO ADDRESS NEEDED                          00750000
         AIF   ('&SYSLIST(1)' EQ 'NEXT').OTHR   LOOK FOR OTHERS         00760000
         AIF   ('&SYSLIST(1)' EQ '').TREQ   LOOK FOR NON-CHAINED        00770000
         MNOTE 8,'UNSUPPORTED POSITIONAL: &SYSLIST(1)'                  00780000
         MEXIT ,                                                        00790000
.TREQ    AIF   ('&DDNAME' NE '').SETDCB                                 00800000
&#REQ    SETA  3             GET DSAB BY DDNAME                         00810000
&@REQ    SETC  '&DDNAME'     DDN ADDRESS NEEDED                         00820000
         AGO   .OTHR                                                    00830000
.SETDCB  ANOP  ,                                                        00840000
&#REQ    SETA  4             GET DSAB BY DCB                            00850000
&@REQ    SETC  '&DCBPTR'     DCB ADDRESS NEEDED                         00860000
.OTHR    ANOP  ,                                                        00870000
         MVI   0(R1),&#REQ   SET REQUEST TYPE                           00880000
         MACPLOP &@REQ,4(R1)   PASS REQUEST ADDRESS OR 0                00890000
         MACPLOP &DSABPTR,8(R1)                                         00900000
         MACPLOP &TCBPTR,12(R1),NULL=SKIP                               00910000
         MACPARM R15,=V(SUBDSAB),OP=L                                   00920000
         MACPARM R14,R15,OP=BALR,OPR=BALR                               00930000
         MACPARM R15,&RETCODE,OP=ST,NULL=SKIP                           00940000
         MACPARM R0,&RSNCODE,OP=ST,NULL=SKIP                            00950000
         MEND  ,                                                        00960000
./ ADD NAME=MVSQUERY
         MACRO ,             LOCAL CSVQUERY REPLACEMENT (MVS 3.8)       00010000
&NM      MVSQUERY &INEPNM=,&INADDR=,&SEARCHM=,&SEARCH=JPALPA,&OLEN=,&OX*00020000
               TLST=,&OEPA=,&OEPNM=,&OMJNM=,&OLOADPT=,&OSP=,&OATTR1=,&O*00030000
               ATTR2=,&OATTR3=,&OVALID=,&OPDATA=,&OPID=,&ODIAG=,&RETCOD*00040000
               E=,&MF=S,&PFX=CVQ,&DSECT=DSECT,&OEPTKN=,&TCB=0           00050000
         GBLC  &MACPLAB                                                 00060000
         LCLC  &P                                                       00070000
         LCLC  &A01,&A02,&A03,&A04,&A05,&A06,&A07,&A08,&A09             00080000
         LCLC  &A10,&A11,&A12,&A13,&A14,&A15,&A16,&A17,&A18             00090000
         LCLA  &OPTFG,&I,&F                                             00100000
         LCLB  &OPJPA,&OPLPA,&OPMIN,&OPNAM                              00110000
&P       SETC  '&PFX'                                                   00120000
&MACPLAB SETC  '&NM'                                                    00130000
&I       SETA  &SYSNDX                                                  00140000
         AIF   ('&MF' EQ 'D').MAPDSCT                                   00150000
.*                                                                      00160000
&OPJPA   SETB  ('&SEARCH' EQ 'JPA' OR '&SEARCH' EQ 'JPALPA')            00170000
&OPLPA   SETB  ('&SEARCH' EQ 'LPA' OR '&SEARCH' EQ 'JPALPA')            00180000
&OPNAM   SETB  ('&INEPNM' NE '')                                        00190000
&OPMIN   SETB  ('&SEARCHM' EQ 'YES')                                    00200000
         AIF   (&OPNAM AND '&INADDR' EQ '').INOK                        00210000
         AIF   (NOT &OPNAM AND '&INADDR' NE '').INOK                    00220000
         AIF   ('&MF(1)' EQ 'L' OR '&MF(1)' EQ 'E').INOK  DEFER         00230000
 MNOTE 8,'EITHER INEPNM OR INADDR MUST BE SPECIFIED, BUT NOT BOTH'      00240000
         MEXIT ,                                                        00250000
.*                                                                      00260000
.INOK    AIF   ('&MF' EQ '').BADMF                                      00270000
&F       SETA  128*&OPJPA+64*&OPLPA+32*&OPNAM+16*&OPMIN                 00280000
         AIF   (N'&MF GT 1 AND '&MF(1)' EQ 'L').LFORM                   00290000
         AIF   ('&MF' EQ 'S').STDFORM                                   00300000
         AIF   (N'&MF LT 2).BADMF                                       00310000
         AIF   ('&MF(1)' EQ 'E').EFORM                                  00320000
         AIF   ('&MF(1)' EQ 'M').EFORM                                  00330000
         AIF   ('&MF(1)' EQ 'L').LFORM                                  00340000
.BADMF   MNOTE 8,'VALUE OF MF= IS UNSUPPORTED'                          00350000
         MEXIT ,                                                        00360000
.STDFORM CNOP  0,4           FORCE ALIGNMENT                            00370000
         MACPARM R1,ZZQ&I.S,OP=BAL  LOAD THE IN-LINE LIST ADDRESS       00380000
&MACPLAB SETC  'ZZQ'.'&I'.'S'  MAKE TARGET LABEL                        00390000
         DC    XL(18*4)'0'     DEFINE PARAMETER LIST SPACE              00400000
         AGO   .LOADLST                                                 00410000
.EFORM   MACPARM R1,&MF(2)   LOAD PARM LIST ADDRESS                     00420000
         AIF   (NOT &OPNAM AND '&INADDR' EQ '').LOADLST  MF=L HAS?      00430000
         MACPARM 0(R1),X'DF',OP=NI  RESET OLD INEPNM FLAG               00440000
         MACPARM 0(R1),&F,OP=OI,OPR=OI  SET  OPTION FLAGS               00450000
         AGO   .LOADFLG                                                 00460000
.LOADLST MACPARM 0(R1),&F,OP=MVI,OPR=MVI  LOAD OPTION FLAGS             00470000
.*       MVI   3(R1),AL1(&PLVER+0)  PLIST VERSION - IGNORE              00480000
.LOADFLG MACPARM R0,&INEPNM,NULL=SKIP                                   00490000
         MACPARM R0,&INADDR,NULL=SKIP                                   00500000
         ST    R0,04(,R1)     INPUT POINTER                             00510000
         AIF   ('&RETCODE' EQ '').SKIP08                                00520000
         MACPARM R0,&RETCODE                                            00530000
         ST    R0,08(,R1)     RETURN CODE                               00540000
.SKIP08  AIF   ('&OVALID' EQ '').SKIP12                                 00550000
         MACPARM R0,&OVALID                                             00560000
         ST    R0,12(,R1)     VALIDITY FLAGS                            00570000
.SKIP12  AIF   ('&OLEN' EQ '').SKIP16                                   00580000
         MACPARM R0,&OLEN                                               00590000
         ST    R0,16(,R1)     MODULE LENGTH                             00600000
.SKIP16  AIF   ('&OEPA' EQ '').SKIP20                                   00610000
         MACPARM R0,&OEPA                                               00620000
         ST    R0,20(,R1)     ENTRY ADDRESS W/AM FLAG IN HIGH BIT       00630000
.SKIP20  AIF   ('&OEPNM' EQ '').SKIP24                                  00640000
         MACPARM R0,&OEPNM                                              00650000
         ST    R0,24(,R1)     MODULE NAME/ALIAS                         00660000
.SKIP24  AIF   ('&OMJNM' EQ '').SKIP28                                  00670000
         MACPARM R0,&OMJNM                                              00680000
         ST    R0,28(,R1)     MAJOR NAME                                00690000
.SKIP28  AIF   ('&OSP' EQ '').SKIP32                                    00700000
         MACPARM R0,&OSP                                                00710000
         ST    R0,32(,R1)     SUBPOOL                                   00720000
.SKIP32  AIF   ('&OATTR1' EQ '').SKIP36                                 00730000
         MACPARM R0,&OATTR1                                             00740000
         ST    R0,36(,R1)     ATTRIBUTE 1                               00750000
.SKIP36  AIF   ('&OATTR2' EQ '').SKIP40                                 00760000
         MACPARM R0,&OATTR2                                             00770000
         ST    R0,40(,R1)     ATTRIBUTE 2                               00780000
.SKIP40  AIF   ('&OATTR3' EQ '').SKIP44                                 00790000
         MACPARM R0,&OATTR3                                             00800000
         ST    R0,44(,R1)     ATTIBUTE 3                                00810000
.SKIP44  AIF   ('&OLOADPT' EQ '').SKIP48                                00820000
         MACPARM R0,&OLOADPT                                            00830000
         ST    R0,48(,R1)     LOAD POINT (FIRST EXTENT)                 00840000
.SKIP48  AIF   ('&OPDATA' EQ '').SKIP52                                 00850000
         MACPARM R0,&OPDATA                                             00860000
         ST    R0,52(,R1)     P DATA                                    00870000
.SKIP52  AIF   ('&OPID' EQ '').SKIP56                                   00880000
         MACPARM R0,&OPID                                               00890000
         ST    R0,56(,R1)     P ID                                      00900000
.SKIP56  AIF   ('&OEPTKN' EQ '').SKIP60                                 00910000
         MACPARM R0,&OEPTKN                                             00920000
         ST    R0,60(,R1)     TOKEN - NOT SUPPORTED                     00930000
.SKIP60  AIF   ('&OXTLST' EQ '').SKIP64                                 00940000
         MACPARM R0,&OXTLST                                             00950000
         ST    R0,64(,R1)     EXTENT LIST                               00960000
.SKIP64  AIF   ('&ODIAG' EQ '').SKIP68                                  00970000
         MACPARM R0,&ODIAG                                              00980000
         ST    R0,68(,R1)     DIAG - NOT IMPLEMENTED                    00990000
.SKIP68  AIF   ('&MF(1)' EQ 'M').MEND  MODIFY ONLY                      01000000
         MACPARM R0,&TCB,NULL=0                                 GP08117 01010000
         MACPARM R15,=V(SUBQUERY),OP=L  ADDRESS OF SUBROUTINE           01020000
         MACPARM R14,(R15),OP=BALR,OPR=BALR                             01030000
         MEXIT ,                                                        01040000
.LFORM   ANOP  ,                                                        01050000
&A01     SETC  '&INEPNM&INADDR+0'                                       01060000
&A02     SETC  '&RETCODE+0'                                             01070000
&A03     SETC  '&OVALID+0'                                              01080000
&A04     SETC  '&OLEN+0'                                                01090000
&A05     SETC  '&OEPA+0'                                                01100000
&A06     SETC  '&OEPNM+0'                                               01110000
&A07     SETC  '&OMJNM+0'                                               01120000
&A08     SETC  '&OSP+0'                                                 01130000
&A09     SETC  '&OATTR1+0'                                              01140000
&A10     SETC  '&OATTR2+0'                                              01150000
&A11     SETC  '&OATTR3+0'                                              01160000
&A12     SETC  '&OLOADPT+0'                                             01170000
&A13     SETC  '&OPDATA+0'                                              01180000
&A14     SETC  '&OPID+0'                                                01190000
&A15     SETC  '&OEPTKN+0'                                              01200000
&A16     SETC  '&OXTLST+0'                                              01210000
&A17     SETC  '&ODIAG+0'                                               01220000
&A18     SETC  '0'                                                      01230000
&MF(2)   MACMAPHD DSECT=NO,PFX=&PFX                                     01240000
         AIF   ('&NM' EQ '').MAPCOM                                     01250000
&NM      DS    0A                                                       01260000
         AGO   .MAPCOM                                                  01270000
.MAPDSCT ANOP  ,                                                        01280000
&A01     SETC  '0'                                                      01290000
&A02     SETC  '0'                                                      01300000
&A03     SETC  '0'                                                      01310000
&A04     SETC  '0'                                                      01320000
&A05     SETC  '0'                                                      01330000
&A06     SETC  '0'                                                      01340000
&A07     SETC  '0'                                                      01350000
&A08     SETC  '0'                                                      01360000
&A09     SETC  '0'                                                      01370000
&A10     SETC  '0'                                                      01380000
&A11     SETC  '0'                                                      01390000
&A12     SETC  '0'                                                      01400000
&A13     SETC  '0'                                                      01410000
&A14     SETC  '0'                                                      01420000
&A15     SETC  '0'                                                      01430000
&A16     SETC  '0'                                                      01440000
&A17     SETC  '0'                                                      01450000
&A18     SETC  '0'                                                      01460000
&NM      MACMAPHD DSECT=&DSECT,PFX=&PFX,DFLT=DSECT                      01470000
.MAPCOM  ANOP  ,                                                        01480000
&P.FLAGS DC    0A(0),AL1(&F) REQUEST FLAGS                              01490000
&P.OPJPA EQU   X'80'           SEARCH JOB'S JPA AND LOAD LIST           01500000
&P.OPLPA EQU   X'40'           SEARCH SYSTEM'S MLPA AND PLPA            01510000
&P.OPNAM EQU   X'20'           SEARCH FOR NAME, NOT ADDRESS             01520000
&P.OPMIN EQU   X'10'           SEARCH INCLUDES MINOR CDES               01530000
         DC    X'00'                                                    01540000
         DC    X'00'                                                    01550000
&P.#PLST DC    B'0'          LIST VERSION                               01560000
&P.@INRQ DC    A(&A01)  4    ADDRESS REQUESTED, OR LOC OF NAME          01570000
&P.@OCOD DC    A(&A02)  8    ADDRESS OF OUTPUT RETURN CODE              01580000
&P.@OVAL DC    A(&A03) 12    ADDRESS OF OUTPUT VALIDITY FLAGS           01590000
&P.@OLEN DC    A(&A04) 16    ADDRESS OF OUTPUT LENGTH WORD              01600000
&P.@OEPA DC    A(&A05) 20    ADDRESS OF OUTPUT ENTRY ADDRESS            01610000
&P.@ONAM DC    A(&A06) 24    ADDRESS OF OUTPUT ENTRY NAME               01620000
&P.@OMAJ DC    A(&A07) 28    ADDRESS OF OUTPUT MAJOR NAME               01630000
&P.@OSP  DC    A(&A08) 32    ADDRESS OF OUTPUT SUBPOOL ADDRESS          01640000
&P.@OAT1 DC    A(&A09) 36    ADDRESS OF OUTPUT ATTRIBUTE ADDRESS        01650000
&P.@OAT2 DC    A(&A10) 40    ADDRESS OF OUTPUT ATTRIBUTE ADDRESS        01660000
&P.@OAT3 DC    A(&A11) 44    ADDRESS OF OUTPUT ATTRIBUTE ADDRESS        01670000
&P.@OLOD DC    A(&A12) 48    ADDRESS OF OUTPUT LOAD ADDRESS             01680000
&P.@OPDA DC    A(&A13) 52    ADDRESS OF OUTPUT ?     - NOT IMPLEMENTED  01690000
&P.@OPID DC    A(&A14) 56    ADDRESS OF OUTPUT ?     - NOT IMPLEMENTED  01700000
&P.@OTKN DC    A(&A15) 60    ADDRESS OF OUTPUT TOKEN - NOT IMPLEMENTED  01710000
&P.@OXTL DC    A(&A16) 64    ADDRESS OF OUTPUT EXTENT LIST AREA         01720000
&P.@ODIA DC    A(&A17) 68    ADDRESS OF OUTPUT DIAG  - NOT IMPLEMENTED  01730000
&P.LEN   EQU   *-&P.FLAGS      LIST LENGTH                              01740000
.MEND    MEND  ,                                                        01750000
./ ADD NAME=MVSSVCUP
         MACRO                                                          00010000
&NM      MVSSVCUP &SVC,&FUNC,&TYPE=,&EP=,&LOCKS=,&NPRMPT=,&MF=,        *00020000
               &APF=,&AR=,&EPNAME=,&RELATED=                            00030000
.********************************************************************** 00040000
.*   THIS IS AN MVS 3.8J IMPLEMENTATION OF THE SVCUPDTE FACILITY      * 00050000
.*   NEW-FANGLED PARAMETERS ARE IGNORED                               * 00060000
.*   CODE IS IMPLEMENTED IN SUBROUTINE SUBSVCUP                       * 00070000
.*   TRIED TO STAY COMPATIBLE WITH IBM                                * 00080000
.********************************************************************** 00090000
         ACTR    100               LIMIT LOOPING TO 100 ITERATIONS      00100000
         GBLC  &MACPLAB      GENERATE LABEL AS NEEDED                   00110000
.*                                                                      00120000
         LCLA &REQLOCK,&INDEX1,&INDEX2,&TEMP,&SVCNUM,&FUNCNUM,&TYPENUM,*00130000
               &APFNUM,&NPNUM,&NCMS,&NDISP,&NLOCAL,&NSRM,&NSALLOC,&NNP,*00140000
               &NAPF,&SVCFLAG,&SVCOFF,&DELETE,&REPLACE,&EXTRACT         00150000
         LCLA  &ARNUM,&NAR                                              00160000
.*                                                                      00170000
.*            APFNUM               APF CODE                             00180000
.*            ARNUM                AR CODE                              00190000
.*            DELETE               FUNCTION CODE VALUE FOR DELETE       00200000
.*            EXTRACT              FUNCTION CODE VALUE FOR EXTRACT      00210000
.*            FUNCNUM              FUNCTION NUMBER                      00220000
.*            INDEX1               GENERAL INDEX                        00230000
.*            INDEX2               GENERAL INDEX                        00240000
.*            NAPF                 VALUE OF THE APF BIT IN SVC ENTRY    00250000
.*            NAR                  VALUE OF AR BIT IN SVC ENTRY         00260000
.*            NCMS                 VALUE OF THE CMS BIT IN SVC ENTRY    00270000
.*            NDISP                VALUE OF THE DISP BIT IN SVC ENTRY   00280000
.*            NLOCAL               VALUE OF THE LOCAL BIT IN SVC ENTRY  00290000
.*            NNP                  VALUE OF THE NON-PREMPT BIT          00300000
.*            NSRM                 VALUE OF THE SRM BIT IN SVC @ZMC3226 00310000
.*                                 ENTRY                       @ZMC3226 00320000
.*            NSALLOC              VALUE OF THE SALLOC BIT IN SVC ENTRY 00330000
.*            REPLACE              REPLACE FUNCTION CODE VALUE          00340000
.*            SVCOFF               OFFSET OF THE SVC NUMBER IN PARM     00350000
.*            NPNUM                NON-PREEMPTIBILITY CODE              00360000
.*            REQLOCK              LOCKS BYTE                           00370000
.*            SVCNUM               SVC NUMBER                           00380000
.*            SVCFLAG              SVC NUMBER SUPPLIED INDICATOR        00390000
.*            TEMP                 TEMPORARY                            00400000
.*            TYPENUM              SVC TYPE NUMBER                      00410000
.*                                                                      00420000
         LCLC &VERSION,&CHARS,&ACHAR,&BADENT,&LAB1,&EPOFF               00430000
         LCLC &EPNOFF                                                   00440000
         LCLC &EPCHAR                                                   00450000
         LCLC &EPMSG                                                    00460000
         LCLC &INCONS      STRING FOR INCONSISTENT OPERANDS             00470000
         LCLC &INSPEC(10)  ARRAY OF KEYWORD ATTRIBUTES                  00480000
         LCLC &BADSPEC(10) ARRAY OF KEYWORD NAMES FOR MESSAGE           00490000
.*                                                                      00500000
.*            ACHAR                SINGLE CHARACTER TEMPORARY           00510000
.*            BADENT               SET TO 'YES' INDICATES FATAL ERROR   00520000
.*            CHARS                MULTIPLE CHARACTER TEMPORARY         00530000
.*            EPCHAR               TEMP VARIABLE: EP OR EPNAME          00540000
.*            EPMSG                TEMP VARIABLE: ENTRY-POINT MSG       00550000
.*            EPOFF                OFFSET OF ENTRY POINT IN PARM LIST   00560000
.*            EPNOFF               OFFSET OF EPNAME IN PARM LIST        00570000
.*            MACDATE              DATE MACRO LAST MODIFIED             00580000
.*            VERSION              SVCUPDTE VERSION NUMBER              00590000
.*                                                                      00600000
&BADENT  SETC  'NO'                   NO ERROR DETECTED YET             00610000
&EPOFF   SETC    '4'                  OFFSET OF THE ENTRY POINT IN LIST 00620000
&EPNOFF  SETC    '12'                 OFFSET OF THE EPNAME IN LIST      00630000
&LAB1    SETC  'ZZ'.'&SYSNDX'.'L' GENERATED LABEL                       00640000
&NAPF    SETA    8                    VALUE OF THE APF BIT IN SVC ENTRY 00650000
&NAR     SETA    4                    VALUE OF AR BIT IN SVC ENTRY      00660000
&NCMS    SETA   64                    VALUE OF THE CMS                  00670000
&NDISP   SETA    8                    VALUE OF THE DISP                 00680000
&NLOCAL  SETA  128                    VALUE OF THE LOCAL                00690000
&NNP     SETA    2                    VALUE OF THE NON-PREMPT           00700000
&NSRM    SETA   32                    VALUE OF THE SRM         @ZMC3226 00710000
&NSALLOC SETA   16                    VALUE OF THE SALLOC               00720000
&REPLACE SETA    1                    REPLACE FUNCTION CODE             00730000
&DELETE  SETA    2                    DELETE FUNCTION CODE              00740000
&EXTRACT SETA    3                    EXTRACT FUNCTION CODE             00750000
&SVCOFF  SETA    3                    OFFSET OF THE SVC NUMBER IN       00760000
.*                                    THE PARAMETER LIST                00770000
&VERSION SETC   '1'                   INITIALIZE TO VERSION 1  @YA11662 00780000
.********************************************************************** 00790000
.*                   VALIDATE MF PARAMETER                            * 00800000
.********************************************************************** 00810000
         AIF   (T'&MF EQ 'O' OR                                        -00820000
               '&MF(1)' EQ 'E' AND N'&MF EQ 2 OR                       -00830000
               '&MF' EQ 'L' AND N'&MF EQ 1).L0020                       00840000
.*       MSG: "INVALID MF OPERAND SPECIFIED- "                          00850000
         IHBERMAC 1001,MF,&MF                                           00860000
&BADENT  SETC  'YES'                  FATAL ERROR DETECTED              00870000
.L0020   ANOP                                                           00880000
         AIF   ('&MF(1)' NE 'E').L0040                                  00890000
.*                                                                      00900000
.*       IS THIS AN EXECUTE FORM OF THE MACRO?                          00910000
.*          YES: MAKE SURE THERE WERE NO UNNECESSARY PARAMETERS         00920000
.*                                                                      00930000
&INSPEC(1)  SETC T'&TYPE                                                00940000
&BADSPEC(1) SETC 'TYPE'                                                 00950000
&INSPEC(2)  SETC T'&LOCKS                                               00960000
&BADSPEC(2) SETC 'LOCKS'                                                00970000
&INSPEC(3)  SETC T'&NPRMPT                                              00980000
&BADSPEC(3) SETC 'NPRMPT'                                               00990000
&INSPEC(4)  SETC T'&APF                                                 01000000
&BADSPEC(4) SETC 'APF'                                                  01010000
&INSPEC(5)  SETC T'&AR                                                  01020000
&BADSPEC(5) SETC 'AR'                                                   01030000
.*                                                                      01040000
.* FIRST TEST IF REPLACE, DELETE, OR EXTRACT SPECIFIED                  01050000
.*                                                                      01060000
&INCONS  SETC  ''              CLEAR ERROR STRING                       01070000
         AIF   (T'&FUNC EQ 'O').L0022    IF A FUNCTION SPECIFIED        01080000
         AIF   ('&FUNC' EQ 'REPLACE' OR '&FUNC' EQ 'DELETE' OR         *01090000
               '&FUNC' EQ 'EXTRACT').L0022                              01100000
&INCONS  SETC '&FUNC'                   THEN MOVE TO ERROR MESSAGE      01110000
.L0022   ANOP                                                           01120000
.*                                                                      01130000
.* LOOP THROUGH INPUT DATA IN ARRAY AND FORMAT MESSAGE STRING           01140000
.*                                                                      01150000
&INDEX1  SETA 0                                                         01160000
.L0025   ANOP                                                           01170000
&INDEX1  SETA (&INDEX1+1)                    BUMP LOOP                  01180000
         AIF  (&INDEX1 GT 5).L0034                                      01190000
.*                                                                      01200000
.*       TEST FOR A KEYWORD SPECIFICATION                               01210000
.*         BY CHECKING ARRAY ENTRY NOT EQUAL TO "OMITTED"               01220000
.*                                                                      01230000
         AIF   ('&INSPEC(&INDEX1)' EQ 'O').L0032  TEST KEY              01240000
.*    INCONSISTENT KEYWORD DETECTED -- PUT KEY INTO ERROR MESSAGE       01250000
         AIF   ('&INCONS' EQ '').L0030       IF NOT 1ST ERROR           01260000
&INCONS  SETC  '&INCONS'.','.'&BADSPEC(&INDEX1)'  THEN ADD KEY          01270000
         AGO   .L0032                                                   01280000
.L0030   ANOP                                                           01290000
&INCONS  SETC  '&BADSPEC(&INDEX1)'           ELSE ASSIGN 1ST KEY        01300000
.L0032   ANOP                                                           01310000
         AGO   .L0025                        LOOP TILL DONE             01320000
.*                                                                      01330000
.*       END OF TEST LOOP - PRINT MNOTE IF NECESSARY                    01340000
.*                                                                      01350000
.L0034   ANOP                                                           01360000
         AIF   ('&INCONS' EQ '').L0040                                  01370000
.*                                                                      01380000
.*       MSG: "XX,YY,ZZ OPERAND INCONSISTENT-IGNORED."                  01390000
         IHBERMAC 147,&INCONS                                           01400000
.L0040   ANOP                                                           01410000
.*                                                                      01420000
.*  SCREEN 'EXTRACT' REQUESTS                                           01430000
.*                                                                      01440000
         AIF   ('&FUNC' EQ 'EXTRACT').L0300       YES: BRANCH           01450000
.*                                                                      01460000
.*  CHECK FOR EXTRACT REQUEST WITH SVC PARAMETER CODED WRONG            01470000
.*                                                                      01480000
         AIF   ('&SVC' NE 'EXTRACT').L0050        NO: BRANCH            01490000
&FUNCNUM SETA   &EXTRACT                                                01500000
.*       MSG: "EXTRACT PARAMETER SPECIFIED IN WRONG POSITION."          01510000
       MNOTE 12,'EXTRACT PARAMETER SPECIFIED IN WRONG POSITION.'        01520000
&BADENT  SETC  'YES'                      FATAL ERROR DETECTED          01530000
         AGO   .L0440                                                   01540000
.L0050   ANOP                                                           01550000
.********************************************************************** 01560000
.*                                                                    * 01570000
.*                   VALIDATE SVC PARAMETER                           * 01580000
.*                                                                    * 01590000
.********************************************************************** 01600000
.*                                                                      01610000
.*       IF THE SVC NUMBER IS NOT VALID INDICATE ERROR                  01620000
.*                                                                      01630000
.*            MF     OMITTED   REGISTER   SELF-DEFINING TERM DECIMAL#   01640000
.*            --     --------  --------   ------------------ --------   01650000
.*         STANDARD   ERROR       OK               OK          OK       01660000
.*            L         OK       ERROR             OK          OK       01670000
.*            E         OK        OK              ERROR       ERROR     01680000
.*                                                                      01690000
.*       IS THERE A SUB-PARAMETER LIST FOR THE SVC PARAMETER?           01700000
         AIF   (N'&SVC GT 1).L0140                  YES: ERROR          01710000
.*                                                                      01720000
.*       IS THE SVC NUMBER SUPPLIED?                                    01730000
         AIF   (T'&SVC  NE 'O').L0060               YES: CONTINUE       01740000
.*       THE SVC NUMBER IS OMITTED                                      01750000
&SVCFLAG SETA  1                                    REMEMBER FACT       01760000
.*       IS IT ANY CASE OTHER THAN THE MF STANDARD CASE?                01770000
         AIF   (T'&MF   NE 'O').L0200               YES: VALID          01780000
.*       MSG: "SVC OPERAND REQUIRED, NOT SPECIFIED"                     01790000
         IHBERMAC 1006,SVC                          NO:  INVALID        01800000
&BADENT  SETC  'YES'                                                    01810000
         AGO   .L0200                                                   01820000
.*                                                                      01830000
.*       IF THIS THE REGISTER FORM OF THE SVC PARAMETER?                01840000
.L0060   AIF   ('&SVC'(1,1) NE '(').L0080      NO: TRY OTHER CASES      01850000
.*       THIS IS THE REGISTER FORM - IS IT THE RIGHT MF TYPE?           01860000
         AIF   ('&MF' NE 'L').L0200                 YES: NOT MF=L       01870000
         AGO   .L0140                               NO:  ERROR          01880000
.*                                                                      01890000
.*       CHECK TO SEE IF THIS IS A SELF-DEFINING TERM                   01900000
.*                                                                      01910000
.L0080   AIF   ('&SVC'(1,1) GE '0' AND '&SVC'(1,1) LE '9').L0100        01920000
         AIF   ('&SVC'(1,1) LT 'A' OR  '&SVC'(1,1) GT 'Z').L0140        01930000
         AIF   ('&MF(1)' EQ 'E').L0140           MF=E CASE INVALID      01940000
         AGO   .L0200                                                   01950000
.*                                                                      01960000
.*       CHECK TO SEE IF THE SVC NUMBER IS NUMERICALLY VALID            01970000
.*                                                                      01980000
.L0100   AIF   ('&MF(1)' EQ 'E').L0140    NUMBER INVALID FOR MF=E       01990000
&INDEX1  SETA  1                          START WITH FIRST CHARACTER    02000000
&CHARS   SETC  '&SVC'                     TEMPORARY STRING              02010000
.L0120   AIF   (K'&SVC GT 3).L0140        TOO MANY DIGITS?              02020000
&ACHAR   SETC  '&CHARS'(&INDEX1,1)        GET A CHARACTER FROM STRING   02030000
         AIF   ('&ACHAR' LT '0' OR '&ACHAR' GT '9').L0140  DECIMAL?     02040000
&INDEX1  SETA  &INDEX1+1                  YES: INDICATE NEXT CHARACTER  02050000
         AIF   (&INDEX1 LE K'&SVC).L0120  ALL CHARACTERS DONE?          02060000
&SVCNUM  SETA  &SVC                       YES: CONVERT STRING TO NUMBER 02070000
         AIF   (&SVCNUM GE 0 AND &SVCNUM LE 255).L0160  TOO BIG?        02080000
.*       MSG: "INVALID SVC OPERAND SPECIFIED- "                         02090000
.L0140   IHBERMAC 1001,SVC,&SVC           YES: TELL USER                02100000
&BADENT  SETC  'YES'                      FATAL ERROR DETECTED          02110000
         AGO   .L0200                                                   02120000
.L0160   ANOP                                                           02130000
.*                                                                      02140000
.*       CHECK TO SEE IF THE SVC NUMBER IS                              02150000
.*       RESERVED FOR AN ESR TABLE                                      02160000
.*                                                                      02170000
         AIF   (&SVCNUM EQ 109).L0180                                   02180000
         AIF   (&SVCNUM EQ 116).L0180                                   02190000
         AIF   (&SVCNUM EQ 122).L0180                                   02200000
         AIF   (&SVCNUM EQ 137).L0180                                   02210000
         AGO   .L0200                                                   02220000
.L0180   ANOP                                                           02230000
       MNOTE 12,'SVC &SVC MAY NOT BE UPDATED. IT IS RESERVED FOR ESR.'  02240000
&BADENT  SETC  'YES'                      FATAL ERROR DETECTED          02250000
.L0200   ANOP                                                           02260000
         AIF   ('&MF(1)' EQ 'E').L0440    IF MF=E SKIP                  02270000
.********************************************************************** 02280000
.*                                                                    * 02290000
.*                   VALIDATE FUNCTION PARAMETER                      * 02300000
.*                                                                    * 02310000
.********************************************************************** 02320000
         AIF    ('&FUNC' NE 'REPLACE').L0220                            02330000
&FUNCNUM SETA   &REPLACE                                                02340000
         AGO    .L0340                                                  02350000
.*                                                                      02360000
.*         IF ITS A 'DELETE' THEN ENSURE NO EXTRA PARAMETERS            02370000
.*                                                                      02380000
.L0220   AIF    ('&FUNC' NE 'DELETE').L0240                             02390000
&FUNCNUM SETA   &DELETE                                                 02400000
&INSPEC(1)  SETC T'&TYPE                                                02410000
&BADSPEC(1) SETC 'TYPE'                                                 02420000
&INSPEC(2)  SETC T'&LOCKS                                               02430000
&BADSPEC(2) SETC 'LOCKS'                                                02440000
&INSPEC(3)  SETC T'&NPRMPT                                              02450000
&BADSPEC(3) SETC 'NPRMPT'                                               02460000
&INSPEC(4)  SETC T'&APF                                                 02470000
&BADSPEC(4) SETC 'APF'                                                  02480000
&INSPEC(5)  SETC T'&EP                                                  02490000
&BADSPEC(5) SETC 'EP'                                                   02500000
&INSPEC(6)  SETC T'&EPNAME                                              02510000
&BADSPEC(6) SETC 'EPNAME'                                               02520000
&INSPEC(7)  SETC T'&AR                                                  02530000
&BADSPEC(7) SETC 'AR'                                                   02540000
.*                                                                      02550000
.* LOOP THROUGH INPUT DATA IN ARRAY AND FORMAT MESSAGE STRING           02560000
.*                                                                      02570000
&INDEX1  SETA 0                INITIALIZE LOOP COUNTER                  02580000
&INCONS  SETC  ''              CLEAR ERROR STRING                       02590000
.L0224   ANOP                                                           02600000
&INDEX1  SETA (&INDEX1+1)                    BUMP LOOP                  02610000
         AIF  (&INDEX1 GT 7).L0236                                      02620000
.*                                                                      02630000
.*       TEST FOR A KEYWORD SPECIFICATION                               02640000
.*         BY CHECKING ARRAY ENTRY NOT EQUAL TO "OMITTED"               02650000
.*                                                                      02660000
         AIF   ('&INSPEC(&INDEX1)' EQ 'O').L0232  TEST KEY              02670000
.*    INCONSISTENT KEYWORD DETECTED -- PUT KEY INTO ERROR MESSAGE       02680000
         AIF   ('&INCONS' EQ '').L0228       IF NOT 1ST ERROR           02690000
&INCONS  SETC  '&INCONS'.','.'&BADSPEC(&INDEX1)'  THEN ADD KEY          02700000
         AGO   .L0232                                                   02710000
.L0228   ANOP                                                           02720000
&INCONS  SETC  '&BADSPEC(&INDEX1)'           ELSE ASSIGN 1ST KEY        02730000
.L0232   ANOP                                                           02740000
         AGO   .L0224                        LOOP TILL DONE             02750000
.*                                                                      02760000
.*       END OF TEST LOOP - PRINT MNOTE IF NECESSARY                    02770000
.*                                                                      02780000
.L0236   ANOP                                                           02790000
         AIF   ('&INCONS' EQ '').L0960                                  02800000
.*                                                                      02810000
.*       MSG: "XX,YY,ZZ OPERAND INCONSISTENT-IGNORED."                  02820000
         IHBERMAC 147,&INCONS                                           02830000
         AGO   .L0960                                                   02840000
.L0240   ANOP                                                           02850000
&BADENT  SETC  'YES'                 FATAL ERROR DETECTED               02860000
         AIF   (T'&FUNC EQ 'O').L0260                                   02870000
.*       MSG: "INVALID FUNCTION OPERAND SPECIFIED- "                    02880000
         IHBERMAC 1001,FUNCTION-CODE,&FUNC                              02890000
         AGO   .L0340                                                   02900000
.L0260   ANOP                                                           02910000
.*       MSG: "FUNCTION-CODE OPERAND REQUIRED, NOT SPECIFIED"           02920000
.L0280   IHBERMAC 1006,FUNCTION-CODE                                    02930000
         AGO   .L0340                                                   02940000
.L0300   ANOP                                                           02950000
.*                                                                      02960000
.*         FOR AN 'EXTRACT' ENSURE NO EXTRA PARAMETERS                  02970000
.*                                                                      02980000
&FUNCNUM SETA   &EXTRACT                                                02990000
&VERSION SETC   '2'       EXTRACT IS A VERSION 2 SPECIFICATION @YA11662 03000000
&SVCFLAG SETA  1                                                        03010000
         AIF    (T'&SVC EQ 'O').L0320               SVC SPECIFIED?      03020000
.*       MSG: "SVCNUM AND EXTRACT OPTIONS ARE MUTUALLY EXCLUSIVE"       03030000
       MNOTE 12,'SVCNUM AND EXTRACT OPTIONS ARE MUTUALLY EXCLUSIVE.'    03040000
&BADENT  SETC  'YES'                      FATAL ERROR DETECTED          03050000
.L0320   ANOP                                                           03060000
&INSPEC(1)  SETC T'&TYPE                                                03070000
&BADSPEC(1) SETC 'TYPE'                                                 03080000
&INSPEC(2)  SETC T'&LOCKS                                               03090000
&BADSPEC(2) SETC 'LOCKS'                                                03100000
&INSPEC(3)  SETC T'&NPRMPT                                              03110000
&BADSPEC(3) SETC 'NPRMPT'                                               03120000
&INSPEC(4)  SETC T'&APF                                                 03130000
&BADSPEC(4) SETC 'APF'                                                  03140000
&INSPEC(5)  SETC T'&AR                                                  03150000
&BADSPEC(5) SETC 'AR'                                                   03160000
.*                                                                      03170000
.* LOOP THROUGH INPUT DATA IN ARRAY AND FORMAT MESSAGE STRING           03180000
.*                                                                      03190000
&INDEX1  SETA 0                INITIALIZE LOOP COUNTER                  03200000
&INCONS  SETC  ''              CLEAR ERROR STRING                       03210000
.L0324   ANOP                                                           03220000
&INDEX1  SETA (&INDEX1+1)                    BUMP LOOP                  03230000
         AIF  (&INDEX1 GT 5).L0336                                      03240000
.*                                                                      03250000
.*       TEST FOR A KEYWORD SPECIFICATION                               03260000
.*         BY CHECKING ARRAY ENTRY NOT EQUAL TO "OMITTED"               03270000
.*                                                                      03280000
         AIF   ('&INSPEC(&INDEX1)' EQ 'O').L0332  TEST KEY              03290000
.*    INCONSISTENT KEYWORD DETECTED -- PUT KEY INTO ERROR MESSAGE       03300000
         AIF   ('&INCONS' EQ '').L0328       IF NOT 1ST ERROR           03310000
&INCONS  SETC  '&INCONS'.','.'&BADSPEC(&INDEX1)'  THEN ADD KEY          03320000
         AGO   .L0332                                                   03330000
.L0328   ANOP                                                           03340000
&INCONS  SETC  '&BADSPEC(&INDEX1)'           ELSE ASSIGN 1ST KEY        03350000
.L0332   ANOP                                                           03360000
         AGO   .L0324                        LOOP TILL DONE             03370000
.*                                                                      03380000
.*       END OF TEST LOOP - PRINT MNOTE IF NECESSARY                    03390000
.*                                                                      03400000
.L0336   ANOP                                                           03410000
         AIF   ('&INCONS' EQ '').L0440                                  03420000
.*                                                                      03430000
.*       MSG: "XX,YY,ZZ OPERAND INCONSISTENT-IGNORED."                  03440000
         IHBERMAC 147,&INCONS                                           03450000
         AGO   .L0440                                                   03460000
.********************************************************************** 03470000
.*                                                                    * 03480000
.*                   VALIDATE SVC TYPE PARAMETER                      * 03490000
.*                                                                    * 03500000
.********************************************************************** 03510000
.L0340   ANOP                                                           03520000
         AIF   ('&TYPE' EQ '1' OR '&TYPE' EQ '2' OR                    -03530000
               '&TYPE' EQ '3' OR '&TYPE' EQ '4' OR                     -03540000
               '&TYPE' EQ '5' OR '&TYPE' EQ '6').L0380                  03550000
&BADENT  SETC  'YES'                 FATAL ERROR DETECTED               03560000
         AIF   (T'&TYPE EQ 'O').L0360      PARAMETER OMITTED?           03570000
.*       MSG: "INVALID TYPE OPERAND SPECIFIED- "                        03580000
         IHBERMAC 1001,TYPE,&TYPE          NO: JUST IN ERROR            03590000
         AGO   .L0440                                                   03600000
.L0360   ANOP                              YES: PARAMETER OMITTED       03610000
.*       MSG: "TYPE OPERAND REQUIRED, NOT SPECIFIED"                    03620000
         IHBERMAC 1006,TYPE                                             03630000
         AGO   .L0440                                                   03640000
.L0380   ANOP                                                           03650000
&TYPENUM SETA  &TYPE                                                    03660000
.L0400   ANOP                                                           03670000
.*                                                                      03680000
.*       IF ITS A TYPE 5 SVC DON'T ALLOW AN ENTRY POINT TO BE SPECIFIED 03690000
.*                                                                      03700000
         AIF   (&TYPENUM NE 5).L0440                                    03710000
         AIF   (T'&EP EQ 'O' AND T'&EPNAME EQ 'O').L0580                03720000
       MNOTE 12,'TYPE=5 AND EPNAME OPTIONS ARE MUTUALLY EXCLUSIVE'      03730000
&BADENT  SETC  'YES'                 FATAL ERROR DETECTED               03740000
         AGO   .L0580                                                   03750000
.L0440   ANOP                                                           03760000
.********************************************************************** 03770000
.*                                                                    * 03780000
.*                   VALIDATE ENTRY POINT PARAMETER                   * 03790000
.*                   'EP' OR 'EPNAME'                                   03800000
.*                                                                    * 03810000
.********************************************************************** 03820000
.*                                                                      03830000
.*       CHECK ENTRY POINT -                                            03840000
.*                                                                      03850000
.*       MF        LABEL     REGISTER  OMITTED                          03860000
.*       --        -----     --------  --------                         03870000
.*        E        ERROR        OK        OK                            03880000
.*        L         OK        ERROR       OK                            03890000
.*   STANDARD       OK          OK      ERROR                           03900000
.*                                                                      03910000
.*                                                                      03920000
.*                                                                      03930000
.*       NEITHER "EP" OR "EPNAME" OPTIONS SPECIFIED?                    03940000
.*                                                                      03950000
         AIF   (T'&EP NE 'O' OR T'&EPNAME NE 'O').L0460  NO: OK         03960000
         AIF   ('&MF' EQ 'L' OR '&MF(1)' EQ 'E').L0580   MF=L/E OK      03970000
&BADENT  SETC  'YES'                              OTHERWISE: FATAL      03980000
.*       MSG: "ENTRY-POINT OPERAND REQUIRED, NOT SPECIFIED"             03990000
         IHBERMAC 1006,ENTRY-POINT                                      04000000
         AGO   .L0580                        GO TO LOCK PROCESSING      04010000
.L0460   ANOP                                                           04020000
.*                                                                      04030000
.*       BOTH "EP" AND "EPNAME" OPTIONS SPECIFIED?                      04040000
.*                                                                      04050000
         AIF   (T'&EP EQ 'O' OR T'&EPNAME EQ 'O').L0480  NO: OK         04060000
&BADENT  SETC  'YES'                                    YES: FATAL      04070000
.*     MSG: "BOTH "EP" AND "EPNAME" SPECIFIED. "                        04080000
     MNOTE 12,'*** BOTH "EP" AND "EPNAME" SPECIFIED. '                  04090000
         AGO   .L0580                        GO TO LOCK PROCESSING      04100000
.L0480   ANOP                                                           04110000
.*                                                                      04120000
.*       DETERMINE WHICH ENTRY POINT OPTION WAS USED                    04130000
.*                                                                      04140000
         AIF   (T'&EP EQ 'O').L0500                    EP OPTION?       04150000
&EPCHAR  SETC  '&EP'                     INITIALIZE MACRO VARIABLE      04160000
&EPMSG   SETC  'EP'                      INITIALIZE MSG VARIABLE        04170000
.*       ARE THERE ANY SUB-PARAMETERS?                                  04180000
         AIF   (N'&EP GT 1).L0560                   YES: ERROR          04190000
         AGO   .L0520                                                   04200000
.L0500   ANOP                                                           04210000
&EPCHAR  SETC  '&EPNAME'                 INITIALIZE MACRO VARIABLE      04220000
&EPMSG   SETC  'EPNAME'                  INITIALIZE MSG VARIABLE        04230000
&VERSION SETC  '2'         EPNAME IS A VERSION 2 SPECIFICATION @YA11662 04240000
.*       ARE THERE ANY SUB-PARAMETERS?                                  04250000
         AIF   (N'&EPNAME GT 1).L0560               YES: ERROR          04260000
.L0520   ANOP                                                           04270000
.*                                                                      04280000
.*       BREAK OUT PROCESSING DEPENDING ON MF TYPE                      04290000
.*                                                                      04300000
         AIF   (T'&MF EQ 'O').L0580                  STANDARD CASE      04310000
         AIF   ('&MF' EQ 'L').L0540                  LIST CASE          04320000
.*                                                                      04330000
.*       HANDLE THE MF=E CASES                                          04340000
.*                                                                      04350000
         AIF   ('&EPCHAR'(1,1) EQ '(' ).L0580                           04360000
         AGO   .L0560    ANYTHING OTHER THAN REGISTER FORM INVALID      04370000
.L0540   ANOP                                                           04380000
.*                                                                      04390000
.*       HANDLE THE MF=L CASES                                          04400000
.*                                                                      04410000
         AIF   ('&EPCHAR'(1,1) NE '(').L0580                            04420000
.*                                           REGISTER FORM INVALID      04430000
.L0560   ANOP                                                           04440000
.*                                                                      04450000
.*       ISSUE MNOTE FOR INVALID ENTRY-POINT OPERAND                    04460000
.*                                                                      04470000
&BADENT  SETC  'YES'                       FATAL ERROR DETECTED?        04480000
.*       MSG: "INVALID (EP,EPNAME) OPERAND SPECIFIED-XXX"               04490000
         IHBERMAC 1001,&EPMSG,&EPCHAR                                   04500000
.L0580   ANOP                                                           04510000
         AIF   ('&MF(1)' EQ 'E').L0960                                  04520000
.********************************************************************** 04530000
.*                                                                    * 04540000
.*               VALIDATE LOCKS PARAMETERS                            * 04550000
.*                                                                    * 04560000
.********************************************************************** 04570000
.*                                                                      04580000
.*       CHECK FOR VALID, NON-DUPLICATE LOCKS                           04590000
.*             - TYPE 1 DEFAULTS TO HAVING THE LOCAL LOCK               04600000
.*             - TYPE 3 + 4 MAY NOT HOLD ANY GLOBAL SPIN LOCK           04610000
.*             - TYPE 6 MAY NOT HOLD ANY LOCK                           04620000
.*                                                                      04630000
         AIF   (&FUNCNUM EQ &EXTRACT).L0960  EXTRACT CHECKING DONE      04640000
         AIF   (T'&LOCKS EQ 'O').L0840                                  04650000
         AIF   (&TYPENUM NE  6 ).L0600                                  04660000
         MNOTE 12,'*** A TYPE 6 SVC MAY NOT HAVE ANY LOCKS'             04670000
&BADENT  SETC  'YES'                 FATAL ERROR DETECTED               04680000
         AGO   .L0880                                                   04690000
.*                                                                      04700000
.*       IS THIS A DUPLICATE LOCK?                                      04710000
.*                                                                      04720000
.L0600   ANOP                                                           04730000
&INDEX1  SETA   1                                                       04740000
.L0620   AIF    (&INDEX1 GT N'&LOCKS).L0840   PROCESSED ALL LOCKS?      04750000
&INDEX2  SETA   &INDEX1+1                  NO: PROCESS NEXT             04760000
.L0640   AIF    (&INDEX2 GT N'&LOCKS).L0680   LAST LOCK IN LIST?        04770000
         AIF    ('&LOCKS(&INDEX1)'  NE '&LOCKS(&INDEX2)').L0660         04780000
.*                                             NO: IS IT A DUPLICATE?   04790000
         MNOTE 12,'*** DUPLICATE LOCK-- &LOCKS(&INDEX1)'                04800000
&BADENT  SETC  'YES'                       FATAL ERROR DETECTED         04810000
         AGO   .L0820                                                   04820000
.L0660   ANOP                                                           04830000
&INDEX2  SETA  &INDEX2+1                   NEXT LOCK IN LIST            04840000
         AGO   .L0640                                                   04850000
.L0680   ANOP                                                           04860000
.*                                                                      04870000
.*       MAP THE LOCK NAME INTO ITS NUMERIC REPRESENTATION              04880000
.*                                                                      04890000
&TEMP    SETA  0                                                        04900000
         AIF   ('&LOCKS(&INDEX1)' NE 'LOCAL').L0700                     04910000
&TEMP    SETA  &NLOCAL                                                  04920000
.L0700   AIF   ('&LOCKS(&INDEX1)' NE 'CMS').L0720                       04930000
&TEMP    SETA  &NCMS                                                    04940000
.L0720   AIF   ('&LOCKS(&INDEX1)' NE 'SRM').L0740                       04950000
&TEMP    SETA  &NSRM                                           @ZMC3226 04960000
.L0740   AIF   ('&LOCKS(&INDEX1)' NE 'SALLOC').L0760                    04970000
&TEMP    SETA  &NSALLOC                                                 04980000
.L0760   AIF   ('&LOCKS(&INDEX1)' NE 'DISP').L0780                      04990000
&TEMP    SETA  &NDISP                                                   05000000
.L0780   AIF   (&TEMP NE 0).L0800             VALID LOCK FOUND?         05010000
.*       MSG: "INVALID LOCK OPERAND SPECIFIED- "                        05020000
         IHBERMAC 1001,LOCK,&LOCKS(&INDEX1)   NO: INVALID LOCK          05030000
&BADENT  SETC  'YES'                  FATAL ERROR DETECTED              05040000
.L0800   ANOP                                                           05050000
&REQLOCK SETA  &REQLOCK+&TEMP         ADD LOCK TO LOCKS VALUE           05060000
.* CHECK FOR TYPE 3 OR TYPE 4 SVC REQUESTING A GLOBAL SPIN LOCK         05070000
         AIF   (&TYPENUM NE 3 AND &TYPENUM NE 4).L0820   TYPE 3/4?      05080000
         AIF   (&TEMP NE &NSRM AND &TEMP NE &NSALLOC                   -05090000
               AND &TEMP NE &NDISP).L0820              SPIN LOCK?       05100000
   MNOTE 12,'TYPE 3/4 SVC CANNOT GET SPIN (&LOCKS(&INDEX1)) LOCK.'      05110000
&BADENT  SETC  'YES'                  FATAL ERROR DETECTED              05120000
.L0820   ANOP                                                           05130000
&INDEX1  SETA  &INDEX1+1              ITERATE IN LOOP                   05140000
         AGO   .L0620                                                   05150000
.*                                                                      05160000
.*       DEFAULT THE LOCAL LOCK FOR TYPE 1 SVC                          05170000
.*                                                                      05180000
.L0840   AIF   (&TYPENUM NE 1).L0880  TYPE 1 SVC?                       05190000
&TEMP    SETA  &REQLOCK/&NLOCAL/2*2   ZERO THE LOCAL BIT DOWN           05200000
&TEMP    SETA  &REQLOCK/&NLOCAL-&TEMP ISOLATE THE LOCAL BIT             05210000
         AIF   (&TEMP NE 0).L0880    LOCAL LOCK ALREADY SPECIFIED?      05220000
&REQLOCK SETA  &REQLOCK+&NLOCAL       NO: DEFAULT IT                    05230000
.********************************************************************** 05240000
.*                                                                    * 05250000
.*               VALIDATE APF PARAMETER                               * 05260000
.*                                                                    * 05270000
.********************************************************************** 05280000
.L0880   ANOP                                                           05290000
         AIF   (T'&APF EQ 'O' OR '&APF' EQ 'NO').L0920                  05300000
         AIF   ('&APF' EQ 'YES').L0900                                  05310000
.*       MSG: "APF KEYWORD MUST BE YES OR NO. "                         05320000
         MNOTE 12,'APF KEYWORD MUST BE YES OR NO.'                      05330000
&BADENT  SETC  'YES'                    FATAL ERROR DETECTED            05340000
         AGO   .L0920                                                   05350000
.L0900   ANOP                                                           05360000
&APFNUM  SETA  &NAPF                                                    05370000
.********************************************************************** 05380000
.*                                                                    * 05390000
.*               VALIDATE AR PARAMETER                                * 05400000
.*                                                                    * 05410000
.********************************************************************** 05420000
.L0920   ANOP                                                           05430000
         AIF   (T'&AR EQ 'O' OR '&AR' EQ 'NO').L0930                    05440000
         AIF   ('&AR' EQ 'YES').L0925                                   05450000
.*       MSG: "AR KEYWORD VALUE MUST BE YES OR NO."                     05460000
         MNOTE 12,'AR KEYWORD VALUE MUST BE YES OR NO.'                 05470000
&BADENT  SETC  'YES'                    FATAL ERROR DETECTED            05480000
         AGO   .L0930                                                   05490000
.L0925   ANOP                                                           05500000
&ARNUM   SETA  &NAR  SET VALUE SO AR BIT=1 IN ATTRIBUTE BYTE            05510000
.L0930   ANOP                                                           05520000
.********************************************************************** 05530000
.*                                                                    * 05540000
.*               VALIDATE NON-PREEMPTIBILITY PARAMETER                * 05550000
.*                                                                    * 05560000
.********************************************************************** 05570000
         AIF   (T'&NPRMPT EQ 'O' OR '&NPRMPT' EQ 'NO').L0960            05580000
         AIF   ('&NPRMPT' EQ 'YES').L0940                               05590000
.*       MSG: "NPRMPT KEYWORD MUST BE YES OR NO."                       05600000
         MNOTE 12,'NPRMPT KEYWORD MUST BE YES OR NO.'                   05610000
&BADENT  SETC  'YES'                    FATAL ERROR DETECTED            05620000
.L0940   ANOP                                                           05630000
&NPNUM   SETA  &NNP                                                     05640000
.********************************************************************** 05650000
.*                                                                    * 05660000
.*               ARE THE PARAMETERS VALID?                            * 05670000
.*                                                                    * 05680000
.********************************************************************** 05690000
.L0960   AIF   ('&BADENT' NE 'YES').L0980                               05700000
         MNOTE 12,'*** ERROR(S) CAUSED MACRO EXPANSION TERMINATION'     05710000
         AIF   (T'&NM EQ 'O').L1380                                     05720000
&NM      DS    0H                                                       05730000
         AGO   .L1380                                                   05740000
.********************************************************************** 05750000
.*                                                                    * 05760000
.* GENERATE CODE TO FIND THE SVCUPDTE SERVICE IF THIS IS NOT MF=L     * 05770000
.*                                                                    * 05780000
.********************************************************************** 05790000
.L0980   AIF   ('&MF' EQ 'L').L1040                                     05800000
&NM      L     R15,=V(SUBSVCUP)   GET SERVICE ROUTINE                   05810000
.********************************************************************** 05820000
.*                                                                    * 05830000
.*       GENERATE CODE TO LOAD R1 WITH PARAMETER LIST IF NOT MF=L     * 05840000
.*                                                                    * 05850000
.********************************************************************** 05860000
.*                                                                      05870000
.*       IF THIS IS THE EXECUTE FORM - USE THE GIVEN PARAMETER LIST     05880000
.*                                                                      05890000
         AIF   ('&MF(1)' NE 'E').L1020  IF THIS ISN'T MF=E              05900000
         MACPARM R1,&MF(2)                                              05910000
         AGO   .L1280                                                   05920000
.*                                                                      05930000
.*       IF THIS IS STANDARD FORM - THE PARAMETER LIST FOLLOWS          05940000
.*                                                                      05950000
.L1020   AIF   (T'&MF NE 'O').L1040                                     05960000
         CNOP  0,4                     ENSURE ALIGNMENT FOR STD FORM    05970000
         BAS   R1,&LAB1                SET POINTER TO PARAMETER LIST    05980000
.********************************************************************** 05990000
.*                                                                    * 06000000
.*       GENERATE PARAMETER LIST IF THIS IS NOT MF=E                  * 06010000
.*                                                                    * 06020000
.********************************************************************** 06030000
.L1040   AIF   ('&MF' NE 'L').L1060                                     06040000
&NM      DS    0F                      FORCE WORD ALIGNMENT             06050000
.L1060   ANOP                                                           06060000
         DC    AL1(&VERSION)           SVCUPDTE VERSION NUMBER          06070000
         DC    AL1(&FUNCNUM)           FUNCTION TO PERFORM              06080000
         DC    AL1(&SVCFLAG)           SVC FLAG                         06090000
*                                          0 - SVC NUMBER SUPPLIED      06100000
*                                          1 - SVC NUMBER NOT GIVEN     06110000
.*                                                                      06120000
.*       IF THIS IS AN EXTRACT FUNCTION ZERO THE SVC NUMBER             06130000
.*       FIELD IN THE PARAMETER LIST                                    06140000
.*                                                                      06150000
         AIF   (&FUNCNUM NE &EXTRACT).L1080                             06160000
         DC    AL1(0)              SVC NUMBER NOT USED FOR EXTRACT      06170000
         AGO   .L1140                                                   06180000
.L1080   ANOP                                                           06190000
.*                                                                      06200000
.*       IF NO SVC PARAMETER SUPPLIED OR THE REGISTER FORM WAS USED     06210000
.*       THEN USE ZERO IN THE PARAMETER LIST FOR THE SVC PARAMETER      06220000
.*                                                                      06230000
         AIF   (T'&SVC EQ 'O').L1100                                    06240000
         AIF   ('&SVC'(1,1) EQ '(').L1100                               06250000
         DC    AL1(&SVC)               SVC TO MODIFY                    06260000
         AGO   .L1120                                                   06270000
.L1100   ANOP                                                           06280000
         DC    AL1(0)                  SVC NUMBER TO FILL IN LATER      06290000
.L1120   ANOP                                                           06300000
.*                                                                      06310000
.*       IF THIS IS A DELETE FUNCTION THE REST OF THE LIST IS ZEROES    06320000
.*                                                                      06330000
         AIF   (&FUNCNUM NE &DELETE).L1140                              06340000
         DC    16X'0'                  DUMMY ENTRY                      06350000
         AGO   .L1280                                                   06360000
.*                                                                      06370000
.*       IF A ENTRY POINT IS NOT SUPPLIED OR REGISTER FORM IS USED      06380000
.*       THEN USE ZERO AS THE ENTRY POINT                               06390000
.*                                                                      06400000
.L1140   AIF   (T'&EP EQ 'O').L1160                                     06410000
         AIF   ('&EP'(1,1) EQ '(').L1160                                06420000
         DC    AL4(&EP)                ENTRY POINT OF NEW SVC ROUTINE   06430000
         AGO   .L1200                                                   06440000
.L1160   AIF   (&TYPENUM EQ 5).L1180   TYPE 5 SVC?                      06450000
         DC    AL4(1)                  ENTRY POINT NOT SPECIFIED        06460000
         AGO   .L1200                                                   06470000
.L1180   ANOP                                                           06480000
         DC    AL4(0)                  ENTRY POINT NOT SPECIFIED        06490000
.L1200   ANOP                                                           06500000
.*                                                                      06510000
.*       IF THIS IS AN EXTRACT FUNCTION ZERO THE TYPE AND ATTRIBUTE     06520000
.*       FIELDS IN THE PARAMETER LIST                                   06530000
.*                                                                      06540000
         AIF   (&FUNCNUM NE &EXTRACT).L1220                             06550000
         DC    AL1(0)                                                   06560000
         DC    AL1(0)                                                   06570000
         DC    AL1(0)                                                   06580000
         DC    AL1(0)                    RESERVED                       06590000
         AGO   .L1240                                                   06600000
.L1220   ANOP                                                           06610000
         DC    AL1(&TYPENUM)           SVC TYPE                         06620000
&TEMP    SETA  &APFNUM+&ARNUM+&NPNUM   GENERATE ATTRIBUTE CONSTANT      06630000
         DC    AL1(&TEMP)              SVC ATTRIBUTE BITS               06640000
         DC    AL1(&REQLOCK)           SVC LOCKS                        06650000
         DC    AL1(0)                  RESERVED                         06660000
.L1240   ANOP                                                           06670000
.*                                                                      06680000
.*       IF AN EPNAME IS NOT SUPPLIED OR REGISTER FORM IS USED          06690000
.*       THEN ZERO EPNAME FIELD IN PARAMETER LIST                       06700000
.*                                                                      06710000
         AIF   (T'&EPNAME EQ 'O').L1260                                 06720000
         AIF   ('&EPNAME'(1,1) EQ '(').L1260                            06730000
         DC    CL8'&EPNAME'            EPNAME OF NEW SVC ROUTINE        06740000
         AGO   .L1280                                                   06750000
.L1260   ANOP                                                           06760000
         DC    8X'00'                  EPNAME NOT SPECIFIED             06770000
.L1280   AIF   ('&MF' EQ 'L').L1380                                     06780000
.********************************************************************** 06790000
.*                                                                    * 06800000
.*       GENERATE CODE TO DYNAMICALLY INSERT EP VALUE INTO            * 06810000
.*       THE PARAMETER LIST FOR MF=E AND STANDARD                     * 06820000
.*                                                                    * 06830000
.********************************************************************** 06840000
.L1300   ANOP                                                           06850000
&LAB1    DS    0H                                                       06860000
         AIF   (&FUNCNUM EQ &DELETE).L1340        END DELETE PROC       06870000
         AIF   (T'&EP    EQ 'O').L1320    ENTRY POINT INCLUDED?         06880000
         AIF   (T'&MF EQ 'O' AND '&EP'(1,1) NE '(').L1340               06890000
         ST    &EP(1),&EPOFF.(0,1)     STORE ADDRESS IN PARAMETER LIST  06900000
         AGO   .L1340                  GO PROCESS SVC NUMBER            06910000
.********************************************************************** 06920000
.*                                                                    * 06930000
.*       GENERATE CODE TO DYNAMICALLY INSERT EPNAME VALUE INTO    *     06940000
.*       THE PARAMETER LIST FOR MF=E AND STANDARD                     * 06950000
.*                                                                    * 06960000
.********************************************************************** 06970000
.L1320   ANOP                                                           06980000
         AIF   (T'&EPNAME EQ 'O').L1340     EPNAME INCLUDED?            06990000
         AIF   (T'&MF EQ 'O' AND '&EPNAME'(1,1) NE '(').L1340  REG      07000000
         MVC   &EPNOFF.(8,1),0(&EPNAME(1))  MOVE EPNAME INTO LIST       07010000
.********************************************************************** 07020000
.*                                                                    * 07030000
.*       GENERATE CODE TO DYNAMICALLY INSERT SVC VALUES INTO          * 07040000
.*       THE PARAMETER LIST FOR MF=E AND STANDARD                     * 07050000
.*                                                                    * 07060000
.********************************************************************** 07070000
.L1340   ANOP                                                           07080000
         AIF   (T'&SVC EQ 'O').L1360     SVC SUPPLIED?                  07090000
         AIF   ('&SVC'(1,1) NE '(').L1360  YES: REGISTER FORM?          07100000
         STH   &SVC(1),&SVCOFF-1(0,1)  RESET SVCFLAG & STORE SVC#       07110000
.L1360   ANOP                                                           07120000
         BALR  R14,R15       CALL UPDATE ROUTINE                        07130000
.L1380   ANOP                                                           07140000
         MEND                                                           07150000
./ ADD NAME=MVST
         MACRO ,                                                        00010000
&NM      MVST  &R,&S                                      ADDED GP09154 00020000
.*                                                                      00030000
.*    BACKLEVEL IMPLEMENTATION OF MVST FOR HERCULES                     00040000
.*    DOES NOT PRODUCE CODE 3                                           00050000
.*                                                                      00060000
         LCLA  &I                                                       00070000
&I       SETA  &SYSNDX                                                  00080000
&NM      MACPARM MODE=LBL                                               00090000
ZZS&I.L  MVC   0(1,&R),0(&S)                                            00100000
         CLM   R0,1,0(&R)    MOVED END CHAR ?                           00110000
         BE    ZZS&I.X                                                  00120000
         LA    &S,1(,&S)                                                00130000
         LA    &R,1(,&R)                                                00140000
         B     ZZS&I.L       DO AGAIN                                   00150000
ZZS&I.X  TM    ZZS&I.L,X'FF'   SET CC=1 - MIXED                         00160000
         MEND  ,                                                        00170000
./ ADD NAME=MYLVL
         MACRO ,                                                        00010000
         MYLVL ,                                                        00020000
         GBLA  &MYLVL,&REL                                              00030000
         GBLB  &MFT,&MVT,&SVS,&MVS,&MVSSP,&MVSXA,&MVSESA,&OS390,&Z900   00040000
*   ASSIGN AN (ARBITRARY, BUT CONSISTENT VALUE TO THE GENERATING        00050000
*   SYSTEM:   1-MFT   2-MVT   3-SVS   4-MVT   5-SE    6-SP1   7-SP3     00060000
*             8-SP6   9-XA   10-ESA  11-S390 12-Z900                    00070000
&MYLVL   SETA  12                                                       00080000
         AIF   (&Z900).LVLSET                                           00090000
&MYLVL   SETA  11                                                       00100000
         AIF   (&OS390).LVLSET                                          00110000
&MYLVL   SETA  10                                                       00120000
         AIF   (&MVSESA).LVLSET                                         00130000
&MYLVL   SETA  9                                                        00140000
         AIF   (&MVSXA).LVLSET                                          00150000
&MYLVL   SETA  8                                                        00160000
         AIF   (&MVSSP AND &REL GE 106).LVLSET                          00170000
&MYLVL   SETA  7                                                        00180000
         AIF   (&MVSSP AND &REL GE 103).LVLSET                          00190000
&MYLVL   SETA  6                                                        00200000
         AIF   (&MVSSP).LVLSET                                          00210000
&MYLVL   SETA  5                                                        00220000
         AIF   (&MVS AND &REL GT 41).LVLSET                             00230000
&MYLVL   SETA  4                                                        00240000
         AIF   (&MVS).LVLSET                                            00250000
&MYLVL   SETA  3                                                        00260000
         AIF   (&SVS).LVLSET                                            00270000
&MYLVL   SETA  2                                                        00280000
         AIF   (&MVT).LVLSET                                            00290000
&MYLVL   SETA  1                                                        00300000
.LVLSET  MEND  ,                                                        00310000
./ ADD NAME=@OBTAIN
         MACRO                                                          00010000
&NM      @OBTAIN &PARM,&OPT=                                     81152  00020000
         GBLB  &WX@OBT                                                  00030000
         GBLC  &MACPLAB                                                 00040000
.********************************************************************** 00050000
.*                                                                   ** 00060000
.*   REPLACEMENT FOR IBM OBTAIN MACRO/SVC. SEE MY @OBTAINS ROUTINE   ** 00070000
.*     FOR DETAILS.                                                  ** 00080000
.*                                                                   ** 00090000
.********************************************************************** 00100000
         LCLC  &NDX                                              82005  00110000
&NDX     SETC  'OBT'.'&SYSNDX'                                   82005  00120000
&MACPLAB SETC  '&NM'                                                    00130000
         AIF   ('&OPT' EQ '').OPTDEF                             81152  00140000
         AIF   ('&OPT' EQ 'CLOSE').CLOSE                         81342  00150000
         AIF   ('&OPT' EQ 'LOADED' OR '&OPT' EQ 'LOAD').OPTEXT   81342  00160000
         AIF   ('&OPT' EQ 'SIZE' OR '&OPT' EQ 'RESERVE').CLOSE   81342  00170000
         MNOTE 8,'INVALID OPT=&OPT '                             81152  00180000
         AGO   .OPTDEF       BUT KEEP EXPANDING                  81342  00190000
.OPTEXT  ANOP  ,                                                 81342  00200000
&WX@OBT  SETB  1             MODULE WAS LOADED BY USER           81342  00210000
.OPTDEF  MACPARM R1,&PARM                                        81152  00220000
         MACPARM R14,&NDX.S+2  SET EXIT ADDRESS     GP08296             00230000
         ICM   R15,15,@OBTAIN   LOAD ADDRESS                    GP99033 00240000
         BNZR  R15 .         CALL OBTAIN SUBROUTINE                     00250000
         AIF   (&WX@OBT).SECOND                                         00260000
         B     &NDX.S        ELSE DO SVC                         82005  00270000
@OBTAIN  DC    V(@OBTAINS)   ADDRESS OF OBTAIN ROUTINE           81152  00280000
         WXTRN @OBTAINS                                                 00290000
&WX@OBT  SETB  1                                                        00300000
.SECOND  ANOP  ,                                                        00310000
&NDX.S   SVC   27            INVOKE OBTAIN SVC                   82005  00320000
         AGO   .MEND                                             81152  00330000
.CLOSE   MACPARM R15,15,@OBTAIN,MODE=3,OP=ICM  EVER LOADED?     GP08296 00340000
         BZ    &NDX.X            NO                              82005  00350000
         AIF   ('&OPT' EQ 'CLOSE').CLOSCAL                       81342  00360000
         MACPARM R0,&PARM,OP=L   LOAD RESERVE SIZE               81342  00370000
         L     R15,28(,R15)  GET @OBSERVE ADDRESS                81342  00380000
         ST    R0,0(,R15)    SET STORAGE RESERVE SIZE            81342  00390000
         AGO   .CLOSOUT                                          81342  00400000
.CLOSCAL L     R15,24(,R15)  LOAD @OBCLOSE ADDRESS               81342  00410000
         BALSR R14,R15       CLOSE IT                            81152  00420000
.CLOSOUT ANOP  ,                                                 81342  00430000
&NDX.X   DS    0H                                                82005  00440000
.MEND    MEND  ,                                                        00450000
./ ADD NAME=OICC
         MACRO ,                                                        00010000
&N       OICC  &CODE,&REAS,&RESULT=                    NEW 2003.091 GYP 00020000
         GBLC  &ZZCCNAM                                                 00030000
         LCLC  &L                                                       00040000
&L       SETC  'L'''                                                    00050000
         AIF   ('&RESULT' EQ '').NONEW                                  00060000
&ZZCCNAM SETC  '&RESULT'                                                00070000
.NONEW   AIF   ('&ZZCCNAM' NE '').NODEF                                 00080000
         MNOTE *,'OICC: RESULT= NOT SPECIFIED - DEFAULTED TO RETCODE'   00090000
&ZZCCNAM SETC  'RETCODE'                                                00100000
.NODEF   ANOP  ,                                                        00110000
&N MACPARM &ZZCCNAM+&L&ZZCCNAM-1,&CODE,OP=OI,OPR=STC,NULL=SKIP,MODE=REV 00120000
   MACPARM &ZZCCNAM+&L&ZZCCNAM+3,&REAS,OP=OI,OPR=STC,NULL=SKIP,MODE=REV 00130000
         MEND  ,                                                        00140000
./ ADD NAME=#OPMSG
         MACRO ,                                                        00010000
&NM      #OPMSG &ADDR,&LEN,&TYPE=MSG,  WRITE A MESSAGE (WTO)           *00020000
               &LIST=,&PARM=CALLPARM   MESSAGE WITH TEXT INSERTION      00030000
         GBLC  &MACPLAB                                                 00040000
         LCLA  &K,&I,&J,&N,&M,&O                                        00050000
         LCLB  &TF                                                      00060000
         LCLC  &RA,&RL,&L    DEFINE ADDRESS AND LENGTH REGISTERS        00070000
         LCLC  &TEXT         USER SPECIFIED ADDRESS             GP12319 00080000
&RA      SETC  'R1'          SET NORMAL USE                             00090000
&RL      SETC  'R0'                                                     00100000
&L       SETC  'L'''                                                    00110000
&TEXT    SETC  '&ADDR'                                          GP12319 00120000
&MACPLAB SETC  '&NM'         SET NAME FIELD                             00130000
&N       SETA  N'&LIST                                                  00140000
&TF      SETB  ('&TYPE' EQ 'MSG')                               GP12319 00150000
.*--------------------------------------------------------------------* 00160000
.*                                                                    * 00170000
.*  #OPMSG GENERATES A CALL TO THE WTO SUBROUTINE SUBWTO              * 00180000
.*                                                                    * 00190000
.*  TEXT  SPECIFIES TEXT DATA NOT EXCEEDING 100 BYTES IN LENGTH,      * 00200000
.*    A) AS A QUOTED STRING                                           * 00210000
.*    B) ADDRESS OF A BCON VARIABLE AL1(LEN-1),C(LEN)'TEXT'           * 00220000
.*    C) ADDRESS OF A HCON VARIALBE AL2(LEN),C(LEN)'TEXT'             * 00230000
.*    D) ADDRESS OF A VCON VARIALBE AL2(LEN+4,0),C(LEN)'TEXT'         * 00240000
.*    E) ADDRESS OF TEXT STRING TERMINATED BY A NULL (X'00')          * 00250000
.*    F) ADDRESS OF A TEXT STRING; WITH AN EXPLICIT LENGTH            * 00260000
.*         SPECIFIED AS THE NEXT PARAMETER                            * 00270000
.*                                                                    * 00280000
.*  TYPE=INIT OR TYPE=NAME DEFINES THE TEXT (UP TO 32 BYTES)          * 00290000
.*    AS A PREFIX TO SUBSEQUENT MESSAGES                              * 00300000
.*                                                                    * 00310000
.*  TYPE=END (OR A TEXT SPECIFICATION OF *END) REQUESTS SUBWTO        * 00320000
.*    TO CLEAN UP AND RELEASE STORAGE                                 * 00330000
.*                                                                    * 00340000
.*  TYPE=MSG (DEFAULT) SPECIFIES A MESSAGE TO BE WRITTEN TO THE       * 00350000
.*    OPERATOR                                                        * 00360000
.*                                                                    * 00370000
.*  TYPE=MSG WITH LIST=(A,L,A,L...) SPECIFIES A MESSAGE WITH TEXT     * 00380000
.*    INSERTION (THE FIRST OPERAND IS PARSED FOR | SEPARATORS THAT    * 00390000
.*    ARE REPLACED BY THE CORRESPONDING A,L VARIABLES.                * 00400000
.*    A) THE FIRST OPERAND IS IN THE LIST, UNLESS EXPLICIT TEXT       * 00410000
.*       IS SPECIFIED AS THE FIRST POSITIONAL PARAMETER               * 00420000
.*    B) "L" MUST BE A SELF-DEFINING OR ABSOLUTE TERM < 256  OR       * 00430000
.*       "L" MAY BE THE ADDRESS OF A #FMT MF=L MACRO DEFINING THE     * 00440000
.*       INPUT DATA TYPE, LEN, AND CONVERSION/FORMATTING OPTIONS.     * 00450000
.*                                                                    * 00460000
.*  PARM=CALLPARM DEFINES A REMOTE PARAMETER LIST TO BE USED (NEEDS   * 00470000
.*    TWO WORDS PER TEXT AND INSERTION VARIABLE                       * 00480000
.*                                                                    * 00490000
.*  TYPE=TEXT WITH LIST= BYPASSES THE WTO, BUT RETURNS THE MESSAGE    * 00500000
.*    ADDRESS IN R1: H'LEN',CL(LEN)'TEXT'                             * 00510000
.*                                                                    * 00520000
.*--------------------------------------------------------------------* 00530000
         AIF   ('&TEXT' EQ '*END').CLOSE                                00540000
         AIF   ('&TYPE' EQ 'CLOSE' OR '&TYPE' EQ 'END').CLOSE           00550000
         AIF   ('&TYPE' NE 'INIT' AND '&TYPE' NE 'NAME').DOMSG          00560000
&RA      SETC  'R0'          EXCHANGE ASSIGNMENTS                       00570000
&RL      SETC  'R1'                                                     00580000
         AIF   (T'&ADDR NE 'O').DOMSG                           GP12319 00590000
         MACPARM &RL,2+&TF   SIGNAL NO TEXT PARAMETER           GP12319 00600000
         MACPARM &RA,257     MUST BE NON-ZERO; > 255            GP12319 00610000
         AGO   .COMBAS                                          GP12319 00620000
.DOMSG   AIF   (&N EQ 0).GOMSG                                          00630000
.*--------------------------------------------------------------------* 00640000
.*  PROCESS A MESSAGE LIST (TEXT/LEN OPTIONAL IF N'&LIST>2)           * 00650000
.*--------------------------------------------------------------------* 00660000
&M       SETA    1           OFFSET IN LIST=                            00670000
         MACPARM R1,&PARM    LOAD PARAMETER LIST                        00680000
         MACPARM R1,=X'80000000',OP=O  MAKE LIST FLAG                   00690000
         MACPARM R0,&TF      SET FLAG (0-WTO; 1-NO WTO,RETURN MSG ADD)  00700000
.*--------------------------------------------------------------------* 00710000
.*  CASE 1A - EXPLICIT TEXT/LEN SUPPLIED - STASH FIRST                * 00720000
.*--------------------------------------------------------------------* 00730000
         AIF   ('&TEXT' EQ '').LSTADD                                   00740000
         AIF   ('&TEXT'(1,1) EQ '''').LSTRNG                            00750000
         MACPARM R15,&TEXT,OP=LA LOAD ADDRESS OF NAME OR REGISTER       00760000
         MACPARM R15,0(,R1),OP=ST STORE ADDRESS IN CALL LIST            00770000
         MACPARM R15,&LEN,NULL=0  SET EXPLICIT LENGTH OR 0              00780000
         MACPARM R15,4(,R1),OP=ST STORE LENGTH IN CALL LIST             00790000
&O       SETA   &O+8         NEXT AVAILABLE LIST OFFSET                 00800000
         AGO   .LSTADD                                                  00810000
.*--------------------------------------------------------------------* 00820000
.*  CASE 1B - EXPLICIT QUOTED TEXT SUPPLIED                           * 00830000
.*--------------------------------------------------------------------* 00840000
.LSTRNG  ANOP  ,                                                        00850000
&K       SETA  K'&TEXT-2     LENGTH OF QUOTED STRING (EXC AMPSND/QOT)   00860000
&I       SETA  2             FIRST BYTE TO EXAMINE                      00870000
&J       SETA  &K            LAST BYTE (PAIR) TO EXAMINE                00880000
.LSTLOOP AIF   (&I GT &J).LSTEXP                                        00890000
         AIF   ('&TEXT'(&I,2) EQ '''''' OR '&TEXT'(&I,2) EQ '&&').LSTPR 00900000
&I       SETA  &I+1          TRY AGAIN                                  00910000
         AGO   .LSTLOOP                                                 00920000
.LSTPR   ANOP  ,                                                        00930000
&I       SETA  &I+2          SKIP THE PAIR                              00940000
&K       SETA  &K-1          AND CORRECT THE LENGTH                     00950000
         AGO   .LSTLOOP                                                 00960000
.LSTEXP  LA    R15,=C&TEXT   LOAD THE STRING ADDRESS                    00970000
         MACPARM R15,0(,R1),OP=ST STORE ADDRESS IN CALL LIST            00980000
         MACPARM R15,&K,OP=LA LOAD THE LENGTH OF THE STRING             00990000
         MACPARM R15,4(,R1),OP=ST STORE LENGTH IN CALL LIST             01000000
&O       SETA   &O+8         NEXT AVAILABLE LIST OFFSET                 01010000
.*--------------------------------------------------------------------* 01020000
.*  CASE 2  - LOOP THROUGH SUPPLIED ADDRESS/LEN PAIRS AND STASH       * 01030000
.*--------------------------------------------------------------------* 01040000
.LSTADD  AIF   (&M GT &N).LSTEND  DONE - SET VL BIT IN LIST             01050000
&RA      SETC  '&LIST(&M)'                                              01060000
&RL      SETC  '&LIST(&M+1)'                                            01070000
         AIF   ('&RA' NE '').HAVERA                                     01080000
&RA      SETC  '0'           NULL ADDRESS - NO SUBSTITUTION             01090000
.HAVERA  AIF   ('&RL' NE '').HAVERL                                     01100000
&RL      SETC  '0'           NULL ADDRESS - NO SUBSTITUTION             01110000
.*--------------------------------------------------------------------* 01120000
.*  CASE 2A - EXPLICIT TEXT/LEN SUPPLIED                              * 01130000
.*--------------------------------------------------------------------* 01140000
.HAVERL  AIF   ('&RA'(1,1) EQ '''').ENTRNG                              01150000
         MACPARM R15,&RA,OP=LA LOAD ADDRESS OF NAME OR REGISTER         01160000
         MACPARM R15,&O.(,R1),OP=ST STORE ADDRESS IN CALL LIST          01170000
         MACPARM R15,&RL,NULL=0   SET EXPLICIT LENGTH OR 0              01180000
         MACPARM R15,&O+4(,R1),OP=ST STORE LENGTH IN CALL LIST          01190000
&O       SETA   &O+8         NEXT AVAILABLE LIST OFFSET                 01200000
&M       SETA   &M+2                                                    01210000
         AGO   .LSTADD                                                  01220000
.*--------------------------------------------------------------------* 01230000
.*  CASE 2B - EXPLICIT QUOTED TEXT SUPPLIED                           * 01240000
.*--------------------------------------------------------------------* 01250000
.ENTRNG  ANOP  ,                                                        01260000
&K       SETA  K'&RA-2       LENGTH OF QUOTED STRING (EXC AMPSND/QOT)   01270000
&I       SETA  2             FIRST BYTE TO EXAMINE                      01280000
&J       SETA  &K            LAST BYTE (PAIR) TO EXAMINE                01290000
.ENTLOOP AIF   (&I GT &J).ENTEXP                                        01300000
         AIF   ('&RA'(&I,2) EQ '''''' OR '&RA'(&I,2) EQ '&&').ENDPR     01310000
&I       SETA  &I+1          TRY AGAIN                                  01320000
         AGO   .ENTLOOP                                                 01330000
.ENDPR   ANOP  ,                                                        01340000
&I       SETA  &I+2          SKIP THE PAIR                              01350000
&K       SETA  &K-1          AND CORRECT THE LENGTH                     01360000
         AGO   .ENTLOOP                                                 01370000
.ENTEXP  LA    R15,=C&RA     LOAD THE STRING ADDRESS                    01380000
         MACPARM R15,&O.(,R1),OP=ST STORE ADDRESS IN CALL LIST          01390000
         MACPARM R15,&K,OP=LA LOAD THE LENGTH OF THE STRING             01400000
         MACPARM R15,&O+4(,R1),OP=ST STORE LENGTH IN CALL LIST          01410000
&O       SETA   &O+8         NEXT AVAILABLE LIST OFFSET                 01420000
&M       SETA   &M+2                                                    01430000
         AGO   .LSTADD                                                  01440000
.LSTEND  ANOP  ,                                                        01450000
&O       SETA  &O-4          POSITION TO LAST WORD IN LIST              01460000
         MACPARM &O.(R1),X'80',OP=OI                                    01470000
         AGO   .COMBAS  DONE - INVOKE SUBWTO                            01480000
.*--------------------------------------------------------------------* 01490000
.*  PROCESS A NORMAL MESSAGE                                          * 01500000
.*--------------------------------------------------------------------* 01510000
.GOMSG   AIF   ('&TEXT'(1,1) EQ '''').MSGSTR                            01520000
         MACPARM &RA,&TEXT,OP=LA LOAD ADDRESS OF NAME OR REGISTER       01530000
         AIF   ('&LEN' EQ '').NOLEN                                     01540000
         MACPARM &RL,&LEN    LOAD TEXT LENGTH                           01550000
         AGO   .COMBAS                                                  01560000
.NOLEN   MACPARM &RL,&RL,OP=SLR,OPR=SLR,MODE=EVEN  SIGNAL INIT CALL     01570000
         AGO   .COMBAS                                                  01580000
.MSGSTR  ANOP  ,                                                        01590000
&K       SETA  K'&TEXT-2     LENGTH OF QUOTED STRING (EXC AMPSND/QOT)   01600000
&I       SETA  2             FIRST BYTE TO EXAMINE                      01610000
&J       SETA  &K            LAST BYTE (PAIR) TO EXAMINE                01620000
.MSGLOOP AIF   (&I GT &J).MSGEXP                                        01630000
         AIF   ('&TEXT'(&I,2) EQ '''''' OR '&TEXT'(&I,2) EQ '&&').MSGPR 01640000
&I       SETA  &I+1          TRY AGAIN                                  01650000
         AGO   .MSGLOOP                                                 01660000
.MSGPR   ANOP  ,                                                        01670000
&I       SETA  &I+2          SKIP THE PAIR                              01680000
&K       SETA  &K-1          AND CORRECT THE LENGTH                     01690000
         AGO   .MSGLOOP                                                 01700000
.*--------------------------------------------------------------------* 01710000
.*  SET R0=R1=0 TO SIGNAL TERMINATION                                 * 01720000
.*--------------------------------------------------------------------* 01730000
.CLOSE   MACPARM R0,0        CLEAR R0                                   01740000
         MACPARM R1,0        AND R1                                     01750000
         AGO   .COMBAS       TO SIGNAL END                              01760000
.*--------------------------------------------------------------------* 01770000
.*  LOAD R0 AND R1 APPROPRIATELY; CALL SUBWTO FOR SERVICE             * 01780000
.*--------------------------------------------------------------------* 01790000
.MSGEXP  MACPARM &RL,&K,OP=LA LOAD THE LENGTH OF THE STRING             01800000
         LA    &RA,=C&TEXT   LOAD THE STRING ADDRESS                    01810000
.COMBAS  MACPARM R15,=V(SUBWTO),OP=L                                    01820000
         BASR  R14,R15       INVOKE IT                                  01830000
         MEND  ,                                                        01840000
./ ADD NAME=OPTIONGB
         GBLA  &SYSPRM#            NUMBER OF SYSPARM TOKENS             00010000
         GBLA  &SVCJFCB            0 OR MODJFCB SVC NUMBER       82099  00020000
         GBLA  &SVC@SVC            0 OR @SERVICE ROUTINE SVC     83100  00030000
         GBLA  &SVCTMSX,&SVCTMSY   0 OR UCC-1 (TMS) SVC X/Y NMBR 83100  00040000
         GBLB  &BUGBEAR      (WAS &DEBUG - SAME AS HASP)         81331  00050000
         GBLB  &MVS                1 IF OS/VS2 MVS                      00060000
         GBLB  &MVSSP              1 IF OS/VS2 MVS/SP            82068  00070000
         GBLB  &MVSXA              1 IF OS/VS2 MVS/XA (SP2)      82068  00080000
         GBLB  &MVSESA             1 IF OS/VS2 MVS/ESA (SP3)     90217  00090000
         GBLB  &SVS                1 IF OS/VS2 SVS                      00100000
         GBLB  &VS1                1 IF OS/VS1                   82137  00110000
         GBLC  &CPU                360/370/470                          00120000
         GBLC  &JES2REL            JES2 LEVEL                    85076  00130000
         GBLC  &LOCAL              INSTALLATION ACRONYM/NAME            00140000
         GBLC  &MODEL              360/370/470                          00150000
         GBLC  &SPVEREL            MVS/SP VERSION/RELEASE/LEVEL  82091  00160000
         GBLC  &SYSPRMS(10)        SYSPARM TOKENS                       00170000
         GBLC  &PRTMAC             GEN OPTION FOR LOCAL  MAPS    81142  00180000
         GBLC  &PRTSOR             GEN OPTION FOR SOURCE         81142  00190000
         GBLC  &PRTSYS             GEN OPTION FOR SYSTEM MAPS    81142  00200000
         GBLC  &SYSTEM             MVT/SVS/MVS                          00210000
./ ADD NAME=PARFGSET
         MACRO ,                                                        00010001
&NM      PARFGSET &BXLE,&TEXT=PRS$TEXT,&ERR=?,&DONE=            GP03229 00020002
.*--------------------------------------------------------------------* 00030001
.*  PARFGSET IS USED AFTER A PARSE REQUEST FINDS A SELF-DEFINING      * 00040001
.*    KEYWORD REPRESENTING A FLAG TO BE TURNED ON OR OFF, AS DEFINED  * 00050001
.*    BY A TABLE BUILD WITH PARKEYBX/PARKEYFG MACROS.                 * 00060001
.*                                                                    * 00070001
.*  USES REGISTERS 14-2, AND WORK AREA DB                             * 00080001
.*--------------------------------------------------------------------* 00090001
         GBLB  &ZZPARFG                                                 00100001
         LCLC  &P                                               GP03229 00110002
&P       SETC  'ZZP'.'&SYSNDX'                                  GP03229 00120002
*---------------------------------------------------------------------* 00130001
*  LOOK UP TEXT &TEXT USING BXLE TABLE &BXLE                            00140001
*---------------------------------------------------------------------* 00150001
&NM      MACPARM R1,&BXLE    GET BXLE POINTER                           00160001
         MACPARM R0,&TEXT    VERB TO BE LOCATED                         00170001
         SUBCALL SUBVERB     (NEEDS EXTRN OR SERVLOAD FOR SUBVERB)      00180001
         LTR   R2,R15        DID IT WORK ?                              00190001
         MACPARM &ERR,OP=BZ,OPR=BZR,MODE=ONE  TAKE ERROR BRANCH         00200001
         SPACE 1                                                        00210001
*---------------------------------------------------------------------* 00220001
*  APPLY FLAG OFF, THEN FLAG ON REQUEST                               * 00230001
*---------------------------------------------------------------------* 00240001
         SR    R15,R15       GET THE LENGTH                             00250001
         IC    R15,OFOFLEN(,R2)  LOAD FLAG LENGTH - 1                   00260001
         MVC   DB,=8X'FF'                                               00270001
         EX    R15,EXFGOFF   SET FLAG(S) OFF                            00280001
         LA    R14,OFOFONN(R15,R2)  POINT TO ON FLAG                    00290001
         EX    R15,EXFGON    SET FLAGS ON                               00300001
         MACPARM &DONE,OP=B,OPR=BR,MODE=ONE,NULL=SKIP  KEYWORD PROC     00310002
         AIF   (&ZZPARFG).MEND                                          00320001
         AIF   ('&DONE' NE '').NORND                            GP03229 00330002
         B     &P.X                                                     00340002
.NORND   ANOP  ,                                                GP03229 00350002
EXFGOFF  NC    0(*-*,R1),OFOFOFF(R2)  SET FLAGS OFF                     00360001
EXFGON   OC    0(*-*,R1),0(R14)       SET FLAGS ON                      00370001
&ZZPARFG SETB  1                                                        00380001
         AIF   ('&DONE' NE '').MEND                             GP03229 00390002
&P.X     DS    0H                                                       00400002
.MEND    MEND  ,                                                        00410001
./ ADD NAME=PARKEYAD
         MACRO ,                                                        00010001
&NM      PARKEYAD &TEXT,&ADD,&MIN=3                                     00020001
.*--------------------------------------------------------------------* 00030000
.*  THIS MACRO BUILDS BRANCH ADDRESS TABLES FOR KEYWORD PROCESSING.   * 00040001
.*  USE IN CONJUNCTION WITH @PARSER/PARSE, AND PARKEYBX SERVICES,     * 00050001
.*  AND THE SUBVERB SUBROUTINE.                                       * 00060001
.*--------------------------------------------------------------------* 00070000
         GBLB  &ZZZOPT@                                                 00080001
         LCLA  &I,&J                                            GP03245 00090005
&I       SETA  N'&TEXT                                          GP03245 00100005
&J       SETA  16            SIGNAL SL2 ADDRESS                         00110002
         AIF   (&ZZZOPT@).LATER                                         00120001
OFO@TXT  EQU   0,8,C'C'      VERB                                       00130001
OFO@MIN  EQU   8,1,C'F'      MINIMUM LENGTH                             00140003
OFO@FLG  EQU   9,1,C'F'      (ARBITRARY) FLAG                           00150003
OFO@ADD  EQU  10,2,C'A'      OFFSET TO PROCESSING CODE                  00160003
&ZZZOPT@ SETB  1             DEFINITIONS DONE                           00170001
.LATER   AIF   ('&TEXT'(1,1) EQ '''').QUOTED                            00180001
&NM      DC    CL8'&TEXT ',AL1(&MIN-1,&J),SL2(&ADD)                     00190002
         MEXIT ,                                                        00200001
.QUOTED  ANOP  ,                                                        00210001
&I       SETA  &I-2                                                     00220001
&NM      DC    CL8&TEXT,AL1(&MIN-1,&J),SL2(&ADD)                        00230002
         MEND  ,                                                        00240001
./ ADD NAME=PARKEYBX
         MACRO ,                                                        00010000
&NM      PARKEYBX &PREFIX                                               00020001
.*--------------------------------------------------------------------* 00030000
.*  THIS MACRO BUILDS THE BXLE ADDRESS TABLE FOR THE SUBVERB ROUTINE. * 00040001
.*  USE IN CONJUNCTION WITH @PARSER/PARSE, AND PARKEYAD/PARKEYFG      * 00050001
.*  MACROS TO BUILD THE TABLES.                                       * 00060001
.*                                                                    * 00070001
.*  THE PREFIX OPERAND SPECIFIES THE NAME OF THE FIRST TABLE ENTRY.   * 00080001
.*  THE LAST ADDRESS IS PREFIX.Z, AND THE ENTRY LENGTH IS TAKEN AS    * 00090001
.*  PREFIX.2-PREFIX                                                   * 00100001
.*--------------------------------------------------------------------* 00110000
         GBLC  &ZZZOPTL,&MACPLAB                                        00120001
&ZZZOPTL SETC ''             RESET FLAG TABLE ENTRY LENGTH              00130001
         LCLC  &PFX                                                     00140001
&PFX     SETC  '&PREFIX'                                                00150001
         AIF   ('&PREFIX' NE '').HAVEPFX                                00160001
         MNOTE 8,'PARKEYBX: TABLE NAME MISSING'                         00170001
&PFX     SETC  'VERBTAB'                                                00180001
.HAVEPFX AIF   ('&NM' NE '').HAVENM                                     00190005
&MACPLAB SETC '&PFX'.'P'                                                00200005
.HAVENM  ANOP  ,                                                        00210005
&NM      MACPARM A(&PFX,&PFX.2-&PFX,&PFX.N,0),OP=DC,MODE=ONE            00220004
         MEND  ,                                                        00230001
./ ADD NAME=PARKEYFG
         MACRO ,                                                        00010001
&NM      PARKEYFG &TEXT,&FLAG,&OFF,&ON,&LEN=,&MIN=3                     00020003
.*--------------------------------------------------------------------* 00030001
.*  THIS MACRO BUILDS ON/OFF FLAG SETTINGS FOR KEYWORD PROCESSING.    * 00040001
.*  USE IN CONJUNCTION WITH @PARSER/PARSE, AND PARKEYBX SERVICES,     * 00050001
.*  AND THE SUBVERB SUBROUTINE.                                       * 00060001
.*--------------------------------------------------------------------* 00070001
         GBLB  &ZZZOPTF                                                 00080001
         GBLC  &ZZZOPTL                                                 00090001
         AIF   ('&LEN' EQ '').NOLOVR                                    00100001
&ZZZOPTL SETC  '&LEN'                                                   00110001
.NOLOVR  AIF   ('&ZZZOPTL' NE '').HAVELEN                               00120001
&ZZZOPTL SETC  '1'                                                      00130001
.HAVELEN AIF   (&ZZZOPTF).LATER                                         00140001
OFOFTXT  EQU   0,8,C'C'      VERB                                       00150001
OFOFMIN  EQU   8,1,C'F'      MINIMUM LENGTH (-1)                        00160002
OFOFLEN  EQU   9,1,C'F'      OFF/ON DATA LENGTH (-1)                    00170002
OFOFSAD  EQU  10,2,C'S'      FLAG ADDRESS S-CON                         00180002
OFOFOFF  EQU  12,1,C'X'      FLAGS TO BE RESET                          00190001
OFOFONN  EQU  13,1,C'X'      FLAGS TO BE SET                            00200001
&ZZZOPTF SETB  1             DEFINITIONS DONE                           00210001
.LATER   AIF   ('&TEXT'(1,1) EQ '''').QUOTED                            00220001
&NM      DC    CL8'&TEXT',AL1(&MIN-1,&ZZZOPTL-1),SL2(&FLAG),AL(&ZZZOPTL*00230005
               )(0-(&OFF+1),&ON+0)                                      00240010
         MEXIT ,                                                        00250001
.QUOTED  ANOP  ,                                                        00260001
&NM      DC    CL8&TEXT,AL1(&MIN-1,&ZZZOPTL-1),SL2(&FLAG),AL(&ZZZOPTL)(*00270005
               0-(&OFF+1),&ON+0)                                        00280010
         MEND  ,                                                        00290001
./ ADD NAME=PARMLOAD
         MACRO ,             LOAD PARM TEXT ADDRESS/LENGTH              00010000
&NM      PARMLOAD &R,&PTR=                                ADDED GP09247 00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*  GET PARM TEXT ADDRESS FOR MVS OR TSO CP INVOCATION                * 00050000
.*    FIRST OPERAND SPECIFIES THE EVEN REGISTER OF AN EVEN/ODD PAIR   * 00060000
.*      TO RECEIVE THE TEXT ADDRESS AND LENGTH.                       * 00070000
.*    PTR= SPECIFIES THE REGISTER CONTAINING THE ADDRESS OF THE PARM  * 00080000
.*      POINTER (AS RECEIVED BY MODULE ON ENTRY)                      * 00090000
.*                                                                    * 00100000
.********************************************************************** 00110000
         GBLC  &SAVZPRM      PGMHEAD SAVED PARM                         00120000
         LCLC  &OR1,&S       ORIGINAL POINTER                           00130000
&OR1     SETC  '&PTR'                                                   00140000
&S       SETC  '1+'.'&R'                                                00150000
         AIF   ('&OR1' NE '').HAVEOR                                    00160000
&OR1     SETC  '&SAVZPRM'    COPY FROM PGMHEAD MACRO                    00170000
.HAVEOR  ANOP  ,                                                        00180000
&NM      MACPARM &R,0(,&OR1),OP=L LOAD POINTER ADDRESS                  00190000
         LH    &S,0(,&R)     GET LENGTH                                 00200000
         CLI   2(&R),0       TSO CP CALL?                               00210000
         BH    *+16          NO, USE OS FORM                            00220000
         SH    &S,=H'4'      ALLOW FOR LENGTH LENGTH                    00230000
         SH    &S,2(,&R)     ALLOW FOR PARSED COMMAND NAME              00240000
         LA    &R,2(,&R)     SKIP SECOND LENGTH                         00250000
         LA    &R,2(,&R)     SKIP FIRST LENGTH                          00260000
         MEND  ,                                                        00270000
./ ADD NAME=PARSE
         MACRO ,                                                        00010000
&NM      PARSE &TEXT,&LEN,&OPT=COMMA,&PARM=PARPARM                      00020000
         GBLC  &MACPLAB                                                 00030000
         LCLC  &L                                                       00040000
         LCLC  &ON(10),&OV(10),&O1,&O2                                  00050000
         LCLC  &RN(10),&RV(10),&RQ                                      00060000
         LCLA  &OM,&RM,&I,&J,&N                                         00070000
&L       SETC  'L'''                                                    00080000
&MACPLAB SETC  '&NM'                                                    00090000
&ON(01)  SETC  'WORD'        REXX WORD LIST (BLANK SEPARATORS)          00100000
&OV(01)  SETC  'PAR$TPBK'      BLANK SEPARATION                         00110000
&ON(02)  SETC  'COMMA'       COMMA/BLANK SEPARATED LIST                 00120000
&OV(02)  SETC  'PAR$TPBC'      BLANK, COMMA                             00130000
&ON(03)  SETC  'KEYWORD'     COMMA/BLANK/KEYWORD=                       00140000
&OV(03)  SETC  'PAR$TPKW'      BLANK, COMMA, (OPT.PARENTHESES), EQUAL   00150000
&ON(04)  SETC  'LIST'        COMMA/BLANK/PARENTHESIZED LISTS            00160000
&OV(04)  SETC  'PAR$TPLS'      BLANK, COMMA, PARENTHESES                00170000
&ON(05)  SETC  'ITEM'        COMMA/BLANK/PARENTHESIZED LISTS            00180000
&OV(05)  SETC  'PAR$TPLI'      BLANK, COMMA, PARENTHESES (SEPARATED)    00190000
&OM      SETA  5             CURRENT MAXIMUM                            00200000
&ON(06)  SETC  '        '    RESERVED                                   00210000
&OV(06)  SETC  'PAR$TPBK'      RESERVED                                 00220000
.*                                                                      00230000
&RN(01)  SETC  'PARKEY'                                                 00240000
&RV(01)  SETC  'PAR$PARK'                                               00250000
&RN(02)  SETC  'SUBLIST'                                                00260000
&RV(02)  SETC  'PAR$COSP'                                               00270000
&RN(03)  SETC  'COLKEY'                                                 00280000
&RV(03)  SETC  'PAR$COKW'                                               00290000
&RN(04)  SETC  'UNQUOTE'                                                00300000
&RV(04)  SETC  'PAR$COUQ'                                               00310000
&RM      SETA  4             CURRENT MAXIMUM                            00320000
&RN(05)  SETC  '        '                                               00330000
&RV(05)  SETC  '        '                                               00340000
&N       SETA  N'&OPT                                                   00350000
         AIF   ('&TEXT' EQ '*END').DONE                                 00360000
         AIF   ('&OPT' NE 'CLOSE').TEXT                                 00370000
.DONE    MACPARM R1,(R1),OPR=SR,MODE=EQU                                00380000
         AGO   .CALL                                                    00390000
.TEXT    MACPARM R15,&TEXT                                              00400000
         MACPARM R0,&LEN,NULL=&L&TEXT                                   00410000
         MACPARM R1,&PARM                                               00420000
         MACPARM R15,R0,PAR@TEXT-PARPARM(R1),MODE=THREE,OP=STM          00430000
         AIF   (&N LT 1).CALL                                           00440000
&O1      SETC  '&OPT(1)'                                                00450000
         AIF   ('&O1' EQ '').SEESUB                                     00460000
&I       SETA  1                                                        00470000
.TRYOPT  AIF   ('&O1' EQ '&ON(&I)').HAVEOPT                             00480000
&I       SETA  &I+1                                                     00490000
         AIF   (&I LE &OM).TRYOPT                                       00500000
.BADOPT  MNOTE 4,'PARSE: OPTION &O1 NOT RECOGNIZED; IGNORED'            00510000
         AGO   .CALL                                                    00520000
.HAVEOPT MACPARM PAR$TYPE-PARPARM(R1),&OV(&I),OP=MVI  SET CALL TYPE     00530000
.SEESUB  AIF   (&N LT 2).CALL                                           00540000
&J       SETA  1                                                        00550000
.OPLOOP  AIF   (&J GE &N).EXPSUB                                        00560000
&J       SETA  &J+1                                                     00570000
&O1      SETC  '&OPT(&J)'                                               00580000
         AIF   ('&O1' EQ '').OPLOOP                                     00590000
&I       SETA  1                                                        00600000
.TRYSUB  AIF   ('&O1' EQ '&RN(&I)').HAVESUB                             00610000
&I       SETA  &I+1                                                     00620000
         AIF   (&I LE &RM).TRYSUB                                       00630000
         MNOTE 8,'PARSE: OPT &O1 NOT A VALID OPTION'                    00640000
         AGO   .OPLOOP                                                  00650000
.HAVESUB ANOP  ,                                                        00660000
&RQ      SETC  '&RQ'.'+'.'&RV(&I)'                                      00670000
         AGO   .OPLOOP                                                  00680000
.EXPSUB  AIF   ('&RQ' EQ '').CALL  SKIP ALL NULLS                       00690000
         MACPARM PAR$RQFG-PARPARM(R1),&RQ,OP=MVI  SET SUB OPTION        00700000
.CALL    MACPARM R15,@PARSER,OP=L                                       00710000
         MACPARM R14,(R15),OP=BALR,OPR=BALR                             00720000
         MEND  ,                                                        00730000
./ ADD NAME=PATCH
         MACRO                                                          00010000
&NM      PATCH &SIZE=64,&OPT=CODE                           NEW GP04234 00020000
.*                                                                      00030000
.*   THIS MACRO CREATES 'ZAP' SPACE WHERE USED                          00040000
.*   SIZE SPECIFES THE NUMBER OF HALFWORDS CREATED                      00050000
.*   USE OPT=DATA FOR SPACE NOT ADDRESSABLE, OR DATA ONLY               00060000
.*                                                                      00070000
         AIF   ('&OPT' EQ 'DATA').DATA                                  00080000
         AIF   ('&OPT' EQ 'CODE').CODE                                  00090000
 MNOTE 4,'PATCH: OPT= MUST BE CODE OR DATA'                             00100000
.CODE    ANOP  ,                                                        00110000
&NM      DC    (&SIZE)SL2(*)  PATCH SPACE                               00120000
         MEXIT ,                                                        00130000
.DATA    ANOP  ,                                                        00140000
&NM      DC    (&SIZE)AL2(0)  PATCH SPACE                               00150000
         MEND  ,                                                        00160000
./ ADD NAME=PFKEYS
         MACRO ,                                                        00010000
&NM      PFKEYS ,                                       ADDED ON 88211  00020000
         GBLA  &#PFKEY                                                  00030000
         GBLC  &PFKEY(52),&PFKEX(52)                                    00040000
         AIF   (&#PFKEY EQ 52).MEND                                     00050000
&#PFKEY  SETA  52                                                       00060000
.*       THE FOLLOWING HEXADECIMAL PFKEY VALUES RESULT FROM             00070000
.*       SPECIAL PROCESSING ON THE AID BYTE IN THE @SCREENS ROUTINE     00080000
.*       AND EXHABASE/EXHASCRN EXHIBIT ROUTINES.                        00090000
.*                                                                      00100000
&PFKEY(01) SETC '    '                                                  00110000
&PFKEX(01) SETC '01'                                                    00120000
&PFKEY(02) SETC '    '                                                  00130000
&PFKEX(02) SETC '02'                                                    00140000
&PFKEY(03) SETC '    '                                                  00150000
&PFKEX(03) SETC '03'                                                    00160000
&PFKEY(04) SETC '    '                                                  00170000
&PFKEX(04) SETC '04'                                                    00180000
&PFKEY(05) SETC '    '                                                  00190000
&PFKEX(05) SETC '05'                                                    00200000
&PFKEY(06) SETC 'OID'                                                   00210000
&PFKEX(06) SETC '06'                                                    00220000
&PFKEY(07) SETC 'MSR'                                                   00230000
&PFKEX(07) SETC '07'                                                    00240000
&PFKEY(08) SETC '¬PRT'                                                  00250000
&PFKEX(08) SETC '08'                                                    00260000
&PFKEY(09) SETC '    '                                                  00270000
&PFKEX(09) SETC '09'                                                    00280000
&PFKEY(10) SETC '    '                                                  00290000
&PFKEX(10) SETC '0A'                                                    00300000
&PFKEY(11) SETC 'PA3'                                                   00310000
&PFKEX(11) SETC '0B'                                                    00320000
&PFKEY(12) SETC 'PA1'                                                   00330000
&PFKEX(12) SETC '0C'                                                    00340000
&PFKEY(13) SETC 'CLEAR'                                                 00350000
&PFKEX(13) SETC '0D'                                                    00360000
&PFKEY(14) SETC 'PA2'                                                   00370000
&PFKEX(14) SETC '0E'                                                    00380000
&PFKEY(15) SETC '    '                                                  00390000
&PFKEX(15) SETC '0F'                                                    00400000
&PFKEY(16) SETC 'TEST'                                                  00410000
&PFKEX(16) SETC '10'                                                    00420000
&PFKEY(17) SETC 'PF1'                                                   00430000
&PFKEX(17) SETC '11'                                                    00440000
&PFKEY(18) SETC 'PF2'                                                   00450000
&PFKEX(18) SETC '12'                                                    00460000
&PFKEY(19) SETC 'PF3'                                                   00470000
&PFKEX(19) SETC '13'                                                    00480000
&PFKEY(20) SETC 'PF4'                                                   00490000
&PFKEX(20) SETC '14'                                                    00500000
&PFKEY(21) SETC 'PF5'                                                   00510000
&PFKEX(21) SETC '15'                                                    00520000
&PFKEY(22) SETC 'PF6'                                                   00530000
&PFKEX(22) SETC '16'                                                    00540000
&PFKEY(23) SETC 'PF7'                                                   00550000
&PFKEX(23) SETC '17'                                                    00560000
&PFKEY(24) SETC 'PF8'                                                   00570000
&PFKEX(24) SETC '18'                                                    00580000
&PFKEY(25) SETC 'PF9'                                                   00590000
&PFKEX(25) SETC '19'                                                    00600000
&PFKEY(26) SETC 'PF10'                                                  00610000
&PFKEX(26) SETC '1A'                                                    00620000
&PFKEY(27) SETC 'PF11'                                                  00630000
&PFKEX(27) SETC '1B'                                                    00640000
&PFKEY(28) SETC 'PF12'                                                  00650000
&PFKEX(28) SETC '1C'                                                    00660000
&PFKEY(29) SETC 'ENTER'                                                 00670000
&PFKEX(29) SETC '1D'                                                    00680000
&PFKEY(30) SETC 'LPEN'                                                  00690000
&PFKEX(30) SETC '1E'                                                    00700000
&PFKEY(31) SETC '    '                                                  00710000
&PFKEX(31) SETC '1F'                                                    00720000
&PFKEY(32) SETC '    '                                                  00730000
&PFKEX(32) SETC '20'                                                    00740000
&PFKEY(33) SETC 'PF13'                                                  00750000
&PFKEX(33) SETC '21'                                                    00760000
&PFKEY(34) SETC 'PF14'                                                  00770000
&PFKEX(34) SETC '22'                                                    00780000
&PFKEY(35) SETC 'PF15'                                                  00790000
&PFKEX(35) SETC '23'                                                    00800000
&PFKEY(36) SETC 'PF16'                                                  00810000
&PFKEX(36) SETC '24'                                                    00820000
&PFKEY(37) SETC 'PF17'                                                  00830000
&PFKEX(37) SETC '25'                                                    00840000
&PFKEY(38) SETC 'PF18'                                                  00850000
&PFKEX(38) SETC '26'                                                    00860000
&PFKEY(39) SETC 'PF19'                                                  00870000
&PFKEX(39) SETC '27'                                                    00880000
&PFKEY(40) SETC 'PF20'                                                  00890000
&PFKEX(40) SETC '28'                                                    00900000
&PFKEY(41) SETC 'PF21'                                                  00910000
&PFKEX(41) SETC '29'                                                    00920000
&PFKEY(42) SETC 'PF22'                                                  00930000
&PFKEX(42) SETC '2A'                                                    00940000
&PFKEY(43) SETC 'PF23'                                                  00950000
&PFKEX(43) SETC '2B'                                                    00960000
&PFKEY(44) SETC 'PF24'                                                  00970000
&PFKEX(44) SETC '2C'                                                    00980000
&PFKEY(49) SETC 'CANCEL'                                                00990000
&PFKEX(49) SETC '0E'                                                    01000000
&PFKEY(50) SETC 'TREQ'                                                  01010000
&PFKEX(50) SETC '10'                                                    01020000
&PFKEY(51) SETC 'PEN'                                                   01030000
&PFKEX(51) SETC '1E'                                                    01040000
&PFKEY(52) SETC '¬AID'                                                  01050000
&PFKEX(52) SETC '00'                                                    01060000
.MEND    MEND  ,                                                        01070000
./ ADD NAME=PGMBAKR
         MACRO ,                                                        00010000
&NM      PGMBAKR &OP1,&OP2,&BASE=R12,&AM=ANY,&ID=0,&BREG=               00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*   THIS MACRO INVOKES BAKR UNDER MVS ESA AND LATER, ELSE PGMHEAD    * 00050000
.*   UNDER BAKR, NO SAVE AREA IS OBTAINED                             * 00060000
.*                                                                    * 00070000
.********************************************************************** 00080000
         GBLB  &MVSESA,&ZZZBAKR,&MAPONCE                                00090000
         LCLA  &K,&I         BASE COUNT                         GP04234 00100000
         LCLC  &CASE,&CMU                                       GP04234 00110000
         AIF   (&MVSESA).BAKR                                           00120000
&NM      PGMHEAD &OP1,&OP2,NOENTRY,BASE=&BASE,AM=&AM,SETAM=&AM,CSECT=,I*00130000
               D=&ID,BREG=&BREG                                 GP05018 00140000
&ZZZBAKR SETB  0                                                        00150000
         AGO   .COMMON                                                  00160000
.BAKR    ANOP  ,                                                        00170000
&NM      BAKR  ,                                                        00180000
&ZZZBAKR SETB  1             NEED PR IN PGMBAND MACRO                   00190000
&K       SETA  N'&BASE      MAX NUMBER OF BASES SPECIFIED       GP04234 00200000
&CMU     SETC  '&BASE(1)'    SET THE FIRST ONE                  GP04234 00210000
&CASE    SETC  '&BASE(1)'    SET THE FIRST ONE                  GP04234 00220000
&K       SETA  N'&BASE                                          GP04234 00230000
         AIF   (&K LT 2).DONEBAS                                GP04234 00240000
&I       SETA  1                                                GP04234 00250000
         LA    &BASE(&K),2048                                   GP04234 00260000
.BASLOOP AIF   (&I GE &K).DONEBAS                               GP04234 00270000
&I       SETA  &I+1                                             GP04234 00280000
         AIF   ('&BASE(&I)' EQ '').BASLOOP                      GP04234 00290000
         LA    &BASE(&I),2048(&BASE(&K),&BASE(&I-1))            GP04234 00300000
&CMU     SETC  '&CMU'.','.'&BASE(&I)'                           GP04234 00310000
         AGO   .BASLOOP                                         GP04234 00320000
.DONEBAS USING &NM,&CMU                                         GP04234 00330000
         SETAM &AM           SET MODE AS REQUESTED (OR NOT)             00340000
.COMMON  AIF   (&MAPONCE).MEND                                          00350000
&MAPONCE SETB  1                                                        00360000
         YREGS ,                                                        00370000
         MASKEQU ,                                                      00380000
.MEND    MEND  ,                                                        00390000
./ ADD NAME=PGMBAND
         MACRO ,                                                        00010000
&NM      PGMBAND ,                                                      00020000
.********************************************************************** 00030000
.*                                                                    * 00040000
.*   THIS IS THE COMPANION MACRO TO PGMBAKR, USED INSTEAD OF PR       * 00050000
.*   UNDER OLDER SYSTEMS. ASSUMES RETURN VALUES ALREADY LOADED        * 00060000
.*   INTO R15, R0, AND R1                                             * 00070000
.*                                                                    * 00080000
.********************************************************************** 00090000
         GBLB  &ZZZBAKR      WAS BAKR USED ?                            00100000
         AIF   (&ZZZBAKR).BAKR  YES; JUST DO PR                         00110000
&NM      L     R2,4(,R13)    GET CALLER'S SAVE AREA                     00120000
         STM   R15,R1,16(R2)   ENSURE RETURN VALUES SET         GP05018 00130000
         PGMEXIT ,                                              GP05018 00140000
         MEXIT ,                                                        00170000
.BAKR    ANOP  ,                                                        00180000
&NM      PR    ,             RESTORE AND RETURN                         00190000
         MEND  ,                                                        00200000
./ ADD NAME=PGMEXIT
         MACRO ,                                                        00010000
&NM      PGMEXIT &DUMMY,&PFX=,&NEXT=,                                  *00020000
               &RC=,&RC0=,&RC1=,&COPYRET=,&RETADDR=(R14)         83087  00030000
         GBLB  &ZZSVBSM      SET BY SAVEM WHEN BSM IS USED ON ENTRY     00040000
         GBLB  &MVS,&MVSXA,&MVSESA,&OS390,&Z900,&BUGDBO         GP04234 00050000
         GBLC  &SAVTYPE,&SAVNAME                                GP04050 00060000
         GBLC  &MACPLAB                                         GP04051 00070000
.*--------------------------------------------------------------------* 00080000
.*                                                                    * 00090000
.*    PGMEXIT PROVIDES THE LOGICAL END OF A PROGRAM INITIATED WITH    * 00100000
.*    A PGMHEAD REQUEST. INFORMATION IS PASSED WITH GLOBALS, AND THE  * 00110000
.*    CODE DOES NOT SUPPORT INTERLEAVED PGMHEAD/PGMEXIT STATEMENTS.   * 00120000
.*                                                                    * 00130000
.*    THE PARAMETERS ARE:                                             * 00140000
.*                                                                    * 00150000
.*    RC=     NUMERIC VALUE (0-4095), REGISTER, OR RELOCATABLE WORD   * 00160000
.*    RC0=    NUMERIC VALUE (0-4095), REGISTER, OR RELOCATABLE WORD   * 00170000
.*    RC1=    NUMERIC VALUE (0-4095), REGISTER, OR RELOCATABLE WORD   * 00180000
.*                                                                    * 00190000
.*    RC LOADS REGISTER 15 (STANDARD RETURN CODE CONVENTION)          * 00200000
.*    RC0 AND RC1 LOAD REGISTERS 0 AND 1 AND ARE OPTIONAL             * 00210000
.*                                                                    * 00220000
.*    COPYRET=ADDRESS  OR COPYRET=(ADDRESS) LOAD R15 FROM STORAGE     * 00230000
.*    COPYRET=(ADDRESS,LENGTH)  LOAD R15,R0, ETC. DEPENDING ON LENGTH * 00240000
.*      ADDRESS IS A RELOCATABLE; LENGTH MUST BE AN ABSOLUTE TERM     * 00250000
.*                                                                    * 00260000
.*    ANY REGISTER NOT SPECIFIED IS RESTORED TO ITS VALUE ON ENTRY,   * 00270000
.*      UNLESS THE NOSAVE OPTION IS IN EFFECT                         * 00280000
.*                                                                    * 00290000
.*    R14 IS NOT SUPPORTED FOR A REGISTER OPERAND                     * 00300000
.*    R15, R0, AND R1 ARE ALLOWED PROVIDING THEY DO NOT CONFLICT      * 00310000
.*      E.G.  RC=(R15),RC1=(R1) IS VALID                              * 00320000
.*            RC=(R1),RC1=(R15) WILL FAIL                             * 00330000
.*                                                                    * 00340000
.*    RETADDR=R14 SPECIFIES THE REGISTER CONTAINING THE RETURN        * 00350000
.*      ADDRESS. IN BSM MODE, THIS MUST INCLUDE THE APPROPRIATE MODE  * 00360000
.*      SETTING BITS. OPERAND IS IGNORED IN BAKR/PR AND XCTL MODES.   * 00370000
.*                                                                    * 00380000
.*    PFX= SPECIFIES AN OVERRIDE TO THE SAVE AREA AND REGISTER NAME   * 00390000
.*      PREFIX. BY DEFAULT THE PFX FROM PGMHEAD IS USED.              * 00400000
.*                                                                    * 00410000
.*    NEXT= SPECIFIES THE NAME OF A MODULE TO XCTL TO, EITHER AS AN   * 00420000
.*      UNQUOTED NAME, OR AS QUOTED STRING, OR AS =CL8' ' LITERAL.    * 00430000
.*                                                                    * 00440000
.*                                                                    * 00450000
.*    THIS MACRO WAS SUGGESTED BY ENDM WRITTEN BY SHMUEL (SEYMOUR J.  * 00460000
.*    METZ, WHICH IS COPYRIGHT 1978 BY SHMUEL (SEYMOUR J.) METZ       * 00470000
.*                                                                      00480000
.*    THIS MACRO IS NOT TO BE DISTRIBUTED WITHOUT PERMISSION,           00490000
.*    AS DESCRIBED IN MEMBER $$RIGHTS.                                  00500000
.*                                                                      00510000
.*--------------------------------------------------------------------* 00520000
         LCLC  &SAVBASE      SAVE AREA START                            00530000
         LCLC  &OSVREG,&C    WORK REGISTER FOR HIGH LEVEL SAVE AREA     00540000
         LCLB  &NOSAVE,&OLDSAVE  PASSED BY PGMEXIT              GP04051 00550000
         LCLB  &OSVLOAD      FLAG THAT OSVREG LOADED AND SET            00560000
         LCLB  &LR15         FLAG THAT R15 HAS RC                       00570000
         LCLB  &LR0          FLAG THAT R15 HAS RC0                      00580000
         LCLB  &LR1          FLAG THAT R15 HAS RC0                      00590000
         LCLA  &I,&K                                                    00600000
&I       SETA  &SYSNDX                                                  00610000
&MACPLAB SETC  '&NM'                                            GP04051 00620000
         AIF   ('&PFX' EQ '').NOPFX                             GP04050 00630000
&SAVNAME SETC  '&PFX'                                                   00640000
.NOPFX   AIF   ('&SAVNAME' NE '').DFPFX                         GP04050 00650000
&SAVNAME SETC  'SAVE'                                           GP04050 00660000
.DFPFX   ANOP  ,                                                GP04050 00670000
&SAVBASE SETC '&SAVNAME'.'SPLN'                                         00680000
&NOSAVE  SETB  ('&SAVTYPE' EQ 'NO')                             GP04051 00690000
&OLDSAVE SETB  ('&SAVTYPE' EQ 'OLD')                            GP04051 00700000
.*--------------------------------------------------------------------* 00710000
.*   STEP 1:  EXCEPT FOR NOSAVE, SAVE ANY NON-NUMERIC RETURN CODES    * 00720000
.*       USE R14 AS A WORKING REGISTER                                * 00730000
.*       WITH NOSAVE, JUST LOAD THE NON-NUMERICS                      * 00740000
.*--------------------------------------------------------------------* 00750000
         AIF   (&NOSAVE).CPRCOM                                         00760000
         AIF   (NOT &OLDSAVE).CPROLD                                    00770000
&OSVREG  SETC  'R13'                                                    00780000
&OSVLOAD SETB  1                                                        00790000
         MACPARM R13,&SAVNAME.13-&SAVBASE.(R13),OP=L  LOAD OLD SV       00800000
         AGO   .CPRCOM                                                  00810000
.CPROLD  MACPARM R14,&SAVNAME.13-&SAVBASE.(R13),OP=L  LOAD WORK         00820000
&OSVREG  SETC  'R14'         WORK REGISTER                              00830000
&OSVLOAD SETB  1             WORK REGISTER LOADED                       00840000
.CPRCOM  AIF   (T'&COPYRET EQ 'O').DONCOPY                              00850000
         AIF   (N'&COPYRET LT 2).CPRONE                                 00860000
         AIF   (N'&COPYRET EQ 2).CPRTWO                                 00870000
.CPRBAD  MNOTE 4,' COPYRET PARAMETER INVALID; USE (ADDR-EXPR,LENGTH)'   00880000
         MEXIT ,                                                        00890000
.CPRTWO  AIF   (&NOSAVE).CPRTWON                                        00900000
&MACPLAB MVC   &SAVNAME.15-&SAVBASE.(&COPYRET(2),&OSVREG),&COPYRET(1)   00910000
&MACPLAB SETC  ''                                                       00920000
         AGO   .NOL15                                                   00930000
.CPRTWON MACPARM R15,&COPYRET(2)/4-2,&COPYRET(1),OP=LM                  00940000
         AGO   .NOL15                                                   00950000
.CPRONE  AIF   (&NOSAVE).CPRONEN                                        00960000
&MACPLAB MVC   &SAVNAME.15-&SAVBASE.(4,&OSVREG),&COPYRET(1)             00970000
&MACPLAB SETC  ''                                                       00980000
         AGO   .NOL15                                                   00990000
.CPRONEN MACPLAB R15,&COPYRET(1),OP=L,OPR=LR                            01000000
         AGO   .NOL15                                                   01010000
.*--------------------------------------------------------------------* 01020000
.*    NOTE THAT NUMERIC (T' = 'N') CODES ARE LOADED LATER ON          * 01030000
.*--------------------------------------------------------------------* 01040000
.DONCOPY AIF   (T'&RC EQ 'O').NOL15                                     01050000
         AIF   (T'&RC EQ 'N').NOL15                             GP04051 01060000
         AIF   (&NOSAVE).NSL15                                          01070000
         AIF   ('&RC'(1,1) EQ '(').STL15                                01080000
.NSL15   MACPARM R15,&RC,OP=L                                   GP04051 01090000
         AIF   (&NOSAVE).NOL15                                          01100000
         MACPARM R15,&SAVNAME.15-&SAVBASE.(,&OSVREG),OP=ST      GP04051 01110000
         AGO   .NOL15                                           GP04051 01120000
.STL15   MACPARM &RC(1),&SAVNAME.15-&SAVBASE.(,&OSVREG),OP=ST   GP04051 01130000
.NOL15   AIF   (T'&RC0 EQ 'O').NOL0                                     01140000
         AIF   (T'&RC0 EQ 'N').NOL0                             GP04051 01150000
         AIF   (&NOSAVE).NSL0                                           01160000
         AIF   ('&RC0'(1,1) EQ '(').STL0                                01170000
.NSL0    MACPARM R0,&RC0,OP=L                                   GP04051 01180000
         AIF   (&NOSAVE).NOL0                                           01190000
         MACPARM R0,&SAVNAME.0-&SAVBASE.(,&OSVREG),OP=ST        GP04051 01200000
         AGO   .NOL0                                            GP04051 01210000
.STL0    MACPARM &RC0(1),&SAVNAME.0-&SAVBASE.(,&OSVREG),OP=ST   GP04051 01220000
.NOL0    AIF   (T'&RC1 EQ 'O').DONLREG                                  01230000
         AIF   (T'&RC1 EQ 'N').DONLREG                          GP04051 01240000
         AIF   (&NOSAVE).NSL1                                           01250000
         AIF   ('&RC1'(1,1) EQ '(').STL1                                01260000
.NSL1    MACPARM R1,&RC1,OP=L                                   GP04051 01270000
         AIF   (&NOSAVE).DONLREG                                        01280000
         MACPARM R1,&SAVNAME.1-&SAVBASE.(,&OSVREG),OP=ST        GP04051 01290000
         AGO   .DONLREG                                         GP04051 01300000
.STL1    MACPARM &RC1(1),&SAVNAME.1-&SAVBASE.(,&OSVREG),OP=ST   GP04051 01310000
.*--------------------------------------------------------------------* 01320000
.*   STEP 2: REGAIN OLD SAVE AREA                                     * 01330000
.*--------------------------------------------------------------------* 01340000
.DONLREG AIF   (&NOSAVE).DONLSAV                                        01350000
         AIF   (&OLDSAVE).NSVSAVE                                       01360000
         MACPARM R1,(R13),OP=LR        SAVE STORAGE ADDRESS             01370000
.NSVSAVE AIF   (NOT &OSVLOAD).NSVLOAD  GET CALLER'S SAVE AREA           01380000
         AIF   ('&OSVREG' EQ 'R13').DONLSAV  HAVE IT ALREADY            01390000
         MACPARM R13,(&OSVREG),OP=LR   SKIP STORAGE IF HAVE             01400000
         AGO   .DONLSAV                                                 01410000
.NSVLOAD MACPARM R13,&SAVNAME.13-&SAVBASE.(R13),OP=L  OLD SAVE AREA     01420000
.*--------------------------------------------------------------------* 01430000
.*   STEP 3: FREE WORKING STORAGE                                     * 01440000
.*--------------------------------------------------------------------* 01450000
.DONLSAV AIF   (&NOSAVE OR &OLDSAVE).DONFREE                            01460000
         MACPARM R0,&SAVNAME.SPLN-&SAVBASE.(R1),OP=L                    01470000
         AIF   (&MVSESA).STOREL                                 GP04234 01480000
         ICM   R15,7,&SAVNAME.SPLN+1-&SAVBASE.(R1)  ANY LENGTH? GP04234 01490000
         BZ    ZZZ&I.L       SKIP IF ZERO LENGTH                GP04234 01500000
         FREEMAIN R,LV=(0),A=(1)  FREE STORAGE                  GP04234 01510000
ZZZ&I.L  DS    0H                                               GP06277 01520000
         AGO   .COMREL                                          GP04234 01530000
.STOREL  LR    R15,R0        COPY POSSIBLE SUBPOOL              GP04051 01540000
         SLL   R0,8                                                     01550000
         SRA   R0,8          REMOVE SUBPOOL                             01560000
         BZ    ZZZ&I.L       SKIP IF ZERO LENGTH                        01570000
         SRL   R15,24        RIGHT-JUSTIFY SUBPOOL                      01580000
.*       STORAGE RELEASE,ADDR=(1),LENGTH=(0),SP=(15)                    01590000
         STORAGE RELEASE,ADDR=(1),LENGTH=(0),SP=(15)                    01600000
.COMREL  ANOP  ,                                                GP04234 01610000
.*--------------------------------------------------------------------* 01620000
.*   STEP 4: LOAD NUMERIC RETURN CODES                                * 01630000
.*--------------------------------------------------------------------* 01640000
.DONFREE AIF   (T'&COPYRET NE 'O').LARDONE  COPYRET DONE ALREADY        01650000
         AIF   (T'&RC NE 'N').NOR15                                     01660000
&LR15    SETB  1             SHOW REGISTER LOADED                       01670000
         MACPARM R15,&RC,OP=LA                                  GP04051 01680000
.NOR15   AIF   (T'&RC0 NE 'N').NOR0                                     01690000
         MACPARM R0,&RC0,OP=LA                                          01700000
&LR0     SETB  1             SHOW REGISTER LOADED                       01710000
.NOR0    AIF   (T'&RC1 NE 'N').LARDONE                                  01720000
         MACPARM R1,&RC1,OP=LA                                          01730000
&LR1     SETB  1             SHOW REGISTER LOADED                       01740000
.*--------------------------------------------------------------------* 01750000
.*   STEP 5: RESTORE NON-RC REGISTERS AS NEEDED                       * 01760000
.*--------------------------------------------------------------------* 01770000
.LARDONE AIF   (&NOSAVE).LNRDONE                                        01780000
&OSVREG  SETC  'R14'                                                    01790000
         AIF   (NOT &LR15 AND NOT &LR0 AND NOT &LR1).LNRALL             01800000
         AIF   (NOT &LR15).LNR2LM                                       01810000
         MACPARM R14,&SAVNAME.14-&SAVBASE.(R13),OP=L                    01820000
&OSVREG  SETC  'R2'                                                     01830000
         AIF   (&LR1 AND &LR0).LNRALL                                   01840000
&OSVREG  SETC  'R0'                                                     01850000
         AIF   (NOT &LR0 AND NOT &LR1).LNRALL                           01860000
&OSVREG  SETC  'R1'                                                     01870000
         AIF   (&LR0).LNRALL                                            01880000
&OSVREG  SETC  'R2'                                                     01890000
         MACPARM R0,&SAVNAME.0-&SAVBASE.(R13),OP=L                      01900000
         AGO   .LNRALL                                                  01910000
.LNR2LM  ANOP  ,                                                        01920000
&OSVREG  SETC  'R1'.'+&LR1*4'                                           01930000
         AIF   (NOT &LR0).LNRE0                                         01940000
         MACPARM R14,R15,&SAVNAME.14-&SAVBASE.(R13),OP=LM,MODE=THREE    01950000
         AGO   .LNRALL                                                  01960000
.LNRE0   MACPARM R14,R0,&SAVNAME.14-&SAVBASE.(R13),OP=LM,MODE=THREE     01970000
.LNRALL  ANOP  ,                                                        01980000
&K       SETA   K'&OSVREG                                               01990000
&C       SETC   '&OSVREG'(2,&K-1)                                       02000000
        MACPARM &OSVREG,R12,&SAVNAME.&C-&SAVBASE.(R13),OP=LM,MODE=THREE 02010000
.*--------------------------------------------------------------------* 02020000
.*   STEP 6: XCTL OR RETURN ACCORDING TO ENTRY LINKAGE                * 02030000
.*--------------------------------------------------------------------* 02040000
.LNRDONE AIF   (&NOSAVE).RETFOOT                                GP04051 02050000
         MVI   &SAVNAME.14-&SAVBASE.(R13),X'FF' FLAG AS LAST SAVE AREA  02060000
.RETFOOT AIF   (T'&NEXT NE 'O').GOXCTL                                  02070000
         AIF   (T'&RETADDR EQ 'O').BUGME                        GP09183 02080000
         AIF   (&ZZSVBSM).GOBSM                                         02090000
         MACPARM &RETADDR,OP=B,OPR=BR,MODE=ONE                  GP04051 02100000
         AGO   .BUGME                                           GP09183 02110000
.GOXCTL  ANOP  ,                                                GP04234 02120000
&MACPLAB LA    R15,ZZZ&SYSNDX.X                                         02130000
         XCTL  SF=(E,(15))                                      GP04050 02140000
ZZZ&SYSNDX.X XCTL EP=&NEXT,SF=L                                         02150000
         AGO   .BUGME                                           GP09183 02160000
.GOBSM   MACPARM 0,&RETADDR(1),OP=BSM,OPR=BSM                   GP04051 02170000
.BUGME   AIF   (NOT &BUGDBO).END                                GP09183 02180000
         DBO   MODE=C        EXPAND DEBUG SUPPORT               GP09183 02190000
.END     MEND  ,                                                        02200000
./ ADD NAME=PGMHEAD
         MACRO ,                                                        00010000
&L       PGMHEAD &DUMMY,&PFX=SAVE,&END=,&ENDZERO=,&DSECT=,&PARM=R1,    *00020000
               &SAVE=*,                                          81208 *00030000
               &STARTOF=0,     LISTING OFFSET FOR SUBROUTINES   GP02257*00040000
               &BASE=R12,&BASED=*,&BREG=,                       GP02264*00050000
               &EID=SHORT,&ENTRY=,&ENTNO=,                             *00060000
               &RIGHT=,                                                *00070000
               &ID=*,&DATE=,&SP=0,&BNDRY=,&LOC=,                 82002 *00080000
               &CSECT=CSECT,&XOPT=BSM,&AM=31,&RM=24,&SETAM=     GP02285 00090000
.*                                                                      00100000
.*    REWRITTEN FROM MACRO SAVEM, WITH ESA AND OS/390 CHANGES   GP98365 00110000
.*             COPYRIGHT 1978 BY SHMUEL (SEYMOUR J.) METZ               00120000
.*                        ALL RIGHTS RESERVED.                          00130000
.*             NEW CODE COPYRIGHT 1998 GERHARD POSTPISCHIL      GP98365 00140000
.*                                                              GP98365 00150000
.*             THIS MACRO IS NOT TO BE DISTRIBUTED WITHOUT PERMISSION,  00160000
.*             AS DESCRIBED IN MEMBER $$RIGHTS.                         00170000
.*                                                                      00180000
.*       FOR SIMPLE ENTRIES, PARM=R1 NOW RELOADS R0 AND R1       87223  00190000
.*       BASE=(B1,B2,B3,B4) SUPPORT ADDED (EASIER TO USE?)       87223  00200000
.*                                                               87223  00210000
         COPY  OPTIONGB                                                 00220000
         GBLB  &DROP@1                                           81163  00230000
         GBLB  &MAPONCE                                                 00240000
         GBLB  &AMSET,&RMSET                                    GP98365 00250000
         GBLB  &SAV@REG                                                 00260000
         GBLB  &SAV@DYN(10)                                             00270000
         GBLC  &SAV@NAM(10)                                             00280000
         GBLC  &SAVTYPE,&SAVNAME                                GP04050 00290000
         GBLC  &MACPLAB                                          81154  00300000
         GBLC  &SYSSPLV      VERSION OF SP (1, 2...)             93174  00310000
         GBLC  &SAVZPRM      PGMHEAD SAVED PARM                 GP09247 00320000
         LCLA  &I,&J,&K,&N,&NUMENT                              GP03245 00330000
         LCLB  &BWOPT,&Y           BIGWORK  OPTION                      00340000
         LCLB  &HWOPT              HUGEWORK OPTION ( > 32767 )   84307  00350000
         LCLB  &CME                BASED/ENTRY PRESENT           81163  00360000
         LCLB  &CPYREGS            CPYREGS  OPTION                      00370000
         LCLB  &DSOPT              NODSECT  OPTION                      00380000
         LCLB  &EQUOPT             NOEQU    OPTION                      00390000
         LCLB  &NOENTRY            NOENTRY  OPTION                      00400000
         LCLB  &NOREG              NOREG    OPTION - SKIP YREGS GP04115 00410000
         LCLB  &NOSAVE             NOSAVE   OPTION                      00420000
         LCLB  &NWOPT              NOWORK   OPTION                      00430000
         LCLB  &OLDSAVE            OLDSAVE  OPTION                      00440000
         LCLB  &BZOPT              ZERO > 256                           00450000
         LCLB  &NOT1ST             NOT FIRST USE OF &PFX                00460000
         LCLB  &ZERO               ZERO     OPTION                      00470000
         LCLB  &ZERO8              ZERO     <= 256               81202  00480000
         LCLB  &ZERO12             ZERO     >  256               81202  00490000
         LCLB  &ZERO15             ZERO     > 4095               81208  00500000
         LCLB  &ZERO31             ZERO     > 32767              84307  00510000
         LCLC  &B@                 GENERATED LABEL FOR B TARGET         00520000
         LCLC  &CMB                COMMON BASE NAME              81163  00530000
         LCLC  &CMU                BASE REG. STRING FOR USING    81163  00540000
         LCLC  &DSVAR              NON-RENT SAVE AREA NAME      GP03033 00550000
         LCLC  &DSCTG              DSECT NAME                    81208  00560000
         LCLC  &ENDG               END LABEL FOR GETMAINED AREA  81208  00570000
         LCLC  &ENDZ               END OF ZEROED AREA            81208  00580000
         LCLC  &LAB                LABEL FOR ENTRY POINT                00590000
         LCLC  &LQ                 L'                                   00600000
         LCLC  &N@                 GENERATED NAME FOR DC                00610000
         LCLC  &SECT               CSECT NAME                           00620000
         LCLC  &SP@                SUBPOOL FOR GETMAIN                  00630000
         LCLC  &NAME               NAME FOR CONSTRUCTED ID              00640000
         LCLC  &SV                 SAVE AREA PREFIX              81208  00650000
         LCLC  &BEGZ         WHERE TO START ZEROING (FWD DEFAULT)       00660000
         LCLC  &PARMEXP                                                 00670000
         LCLC  &PARMREG                                                 00680000
         LCLC  &CASE         FIRST/ONLY BASE REG                GP02264 00690000
         LCLC  &C9           TEMP                               GP03245 00700000
         LCLC  &YOPT         COPY OF XOPT OR 'STM'              GP04234 00710000
       SYSPARM ,                   SET GLOBALS                          00720000
&SECT    SETC  '&SYSECT'                                                00730000
&SV      SETC  '&PFX'                                                   00740000
&SAVNAME SETC  '&PFX'                                           GP04050 00750000
&DSCTG   SETC  '&PFX'                                                   00760000
&ENDG    SETC  '&PFX'.'END'                                     GP98365 00770000
&BEGZ    SETC  '&PFX'.'FWD'        ZERO BEGINNING AT FWD LINK    94272  00780000
&SAVTYPE SETC  'DYN'         (AS OPPOSED TO NO OR OLD)          GP04050 00790000
.*                                                                      00800000
&YOPT    SETC  '&XOPT'                                          GP04234 00810000
         AIF   ('&YOPT' EQ 'BSM' AND &MVSESA).ASMVS             GP04234 00820000
&YOPT    SETC  'STM'                                            GP04234 00830000
.*                                                                      00840000
.ASMVS   AIF   ('&DSECT' EQ '').DSGOK                                   00850000
&DSCTG   SETC  '&DSECT'                                                 00860000
.DSGOK   AIF   ('&END' EQ '').ENDGOK                                    00870000
&ENDG    SETC  '&END'                                                   00880000
.ENDGOK  ANOP  ,                                                        00890000
&DSVAR   SETC  '&DSCTG'      DEFAULT START OF SAVE AREA         GP03033 00900000
         AIF   ('&SAVE' EQ '*').ENDGSV                          GP03033 00910000
&DSVAR   SETC  '&SAVE'       FOR LENGTH DEFINITION              GP03033 00920000
.ENDGSV  ANOP  ,                                                GP03033 00930000
.*                                                                      00940000
&N       SETA  1                                                        00950000
.NXTSLOT ANOP  ,                                                        00960000
&NOT1ST  SETB  (&NOT1ST OR ('&PFX' EQ '&SAV@NAM(&N)'))                  00970000
         AIF   (&NOT1ST).FND1ST                                         00980000
         AIF   ('&SAV@NAM(&N)' EQ '').FNDSLOT                           00990000
&N       SETA  &N+1                                                     01000000
         AIF   (&N LE 10).NXTSLOT                                       01010000
         MNOTE 12,'TOO MANY PGMHEAD DSECTS'                     GP98365 01020000
         MEXIT ,                                                        01030000
.FNDSLOT ANOP  ,                                                        01040000
&SAV@NAM(&N) SETC '&PFX'                                                01050000
.*                                                                      01060000
.FND1ST  AIF   ('&SYSECT' EQ '' AND T'&L EQ 'O').NOL                    01070000
&I       SETA  1                                                        01080000
         AIF   (N'&SYSLIST EQ 0).ENDOPT                                 01090000
.*                                                                      01100000
.LOOP    AIF   ('&SYSLIST(&I)' EQ 'CPYREGS').CPYREGS                    01110000
         AIF   ('&SYSLIST(&I)' EQ 'COPYREGS').CPYREGS            81154  01120000
         AIF   ('&SYSLIST(&I)' EQ 'COPYREGISTERS').CPYREGS              01130000
         AIF   ('&SYSLIST(&I)' EQ 'NODSECT').NODSECT                    01140000
         AIF   ('&SYSLIST(&I)' EQ 'NOEQU').NOEQU                        01150000
         AIF   ('&SYSLIST(&I)' EQ 'NOREG').NOREGS               GP04115 01160000
         AIF   ('&SYSLIST(&I)' EQ 'NOREGS').NOREGS              GP04115 01170000
         AIF   ('&SYSLIST(&I)' EQ 'BIGWORK').BIGWORK                    01180000
         AIF   ('&SYSLIST(&I)' EQ 'HUGEWORK').HUGWORK            84307  01190000
         AIF   ('&SYSLIST(&I)' EQ 'BIGZERO').BIGZERO                    01200000
         AIF   ('&SYSLIST(&I)' EQ 'HUGEZERO').ZERO31             84307  01210000
         AIF   ('&SYSLIST(&I)' EQ 'NOWORK').NOWORK                      01220000
         AIF   ('&SYSLIST(&I)' EQ 'NOSAVE').NOSAVE1                     01230000
         AIF   ('&SYSLIST(&I)' EQ 'OLDSAVE').OLDSAVE                    01240000
         AIF   ('&SYSLIST(&I)' EQ 'NOENTRY').NOENTRY                    01250000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO').ZERO                          01260000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO8').ZERO8                 81208  01270000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO12').ZERO12               81208  01280000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO15').ZERO15               81208  01290000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO31').ZERO31               84307  01300000
         AIF   ('&SYSLIST(&I)' EQ '').NXTOPT                            01310000
         MNOTE 4,'''&SYSLIST(&I)'' IS AN INVALID OPTION - IGNORED'      01320000
         AGO   .NXTOPT                                                  01330000
.*                                                                      01340000
.NOL     MNOTE 12,'LABEL REQUIRED IF NO CSECT'                          01350000
         MEXIT ,                                                        01360000
.*                                                                      01370000
.CPYREGS ANOP  ,                                                        01380000
&CPYREGS SETB  1                                                        01390000
         AGO   .NXTOPT                                                  01400000
.NODSECT ANOP  ,                                                        01410000
&DSOPT   SETB  1                                                        01420000
         AGO   .NXTOPT                                                  01430000
.NOEQU   ANOP  ,                                                        01440000
&EQUOPT  SETB  1                                                        01450000
         AGO   .NXTOPT                                                  01460000
.NOREGS  ANOP  ,                                                GP04115 01470000
&NOREG   SETB  1                                                GP04115 01480000
         AGO   .NXTOPT                                          GP04115 01490000
.HUGWORK ANOP  ,                                                 84307  01500000
&HWOPT   SETB  1             SET FOR HUGE WORK AREA              84307  01510000
.BIGWORK ANOP  ,                                                        01520000
&BWOPT   SETB  1                                                        01530000
&BZOPT   SETB  1                                                        01540000
         AGO   .NXTOPT                                                  01550000
.NOWORK  ANOP  ,                                                        01560000
&NWOPT   SETB  1                                                        01570000
         AGO   .NXTOPT                                                  01580000
.NOSAVE1 ANOP  ,                                                        01590000
&NOSAVE  SETB  1                                                        01600000
&SAVTYPE SETC  'NO'                                             GP04050 01610000
         AGO   .NXTOPT                                                  01620000
.OLDSAVE ANOP  ,                                                        01630000
&OLDSAVE SETB  1                                                        01640000
&SAVTYPE SETC  'OLD'                                            GP04050 01650000
         AGO   .NXTOPT                                                  01660000
.NOENTRY ANOP  ,                                                        01670000
&NOENTRY SETB  1                                                        01680000
         AGO   .NXTOPT                                                  01690000
.*                                                               81208  01700000
.ZERO8   ANOP  ,                                                 81208  01710000
&ZERO8   SETB  1                                                 81208  01720000
         AGO   .ZERO                                             81208  01730000
.ZERO12  ANOP  ,                                                 81208  01740000
&ZERO12  SETB  1                                                 81218  01750000
         AGO   .ZERO                                             81208  01760000
.ZERO31  ANOP  ,                                                 84307  01770000
&HWOPT   SETB  1             HUGE WORK AREA > 32767              84307  01780000
&ZERO31  SETB  1                                                 84307  01790000
.ZERO15  ANOP  ,                                                 81208  01800000
&ZERO15  SETB  1                                                 81208  01810000
&BWOPT   SETB  1                                                 81218  01820000
         AGO   .ZERO                                             81208  01830000
.BIGZERO ANOP  ,                                                        01840000
&BZOPT   SETB  1                                                 81202  01850000
.ZERO    ANOP  ,                                                        01860000
&ZERO    SETB  1                                                        01870000
.NXTOPT  ANOP  ,                                                        01880000
&I       SETA  &I+1                                                     01890000
         AIF   (&I LE N'&SYSLIST).LOOP                                  01900000
.ENDOPT  AIF   (&ZERO8 OR &ZERO12 OR &ZERO15).GOTZERO            81208  01910000
&ZERO31  SETB  (&ZERO AND &HWOPT)                                84307  01920000
&ZERO15  SETB  (&ZERO AND &BWOPT)                                81208  01930000
&ZERO12  SETB  (&BZOPT AND NOT &ZERO15)                          81208  01940000
&ZERO8   SETB  (&ZERO AND NOT &ZERO12 AND NOT &ZERO15)           81202  01950000
.GOTZERO AIF   (T'&L EQ 'O').CSECTOK                             81208  01960000
         AIF   ('&SYSECT' EQ '' OR '&L' EQ '&SYSECT').LABOK      81202  01970000
&LAB     SETC  '&L'                                                     01980000
         AIF   (&NOENTRY).LABOK                                         01990000
         SPACE 1                                                GP04050 02000000
         ENTRY &L                                                       02010000
.LABOK   AIF   ('&SYSECT' NE '').CSECTOK                                02020000
         AIF   ('&CSECT' EQ 'CSECT').CSECTDO                    GP98322 02030000
         AIF   ('&CSECT' EQ 'RSECT').RSECTDO                    GP98322 02040000
         AIF   ('&CSECT' EQ 'START').STARTDO                    GP98322 02050000
         MNOTE 4,'INVALID CSECT OPERAND; USE CSECT OR RSECT'    GP98322 02060000
         AGO   .CSECTDO      TRY TO CONTINUE?                   GP98322 02070000
.*                                                              GP98322 02080000
.STARTDO ANOP  ,                                                GP98322 02090000
&L       START &STARTOF                                         GP04234 02100000
         AGO   .CSECTCM                                         GP98322 02110000
.*                                                              GP98322 02120000
.RSECTDO AIF   (NOT &MVSESA).CSECTDO                            GP04234 02130000
&L       RSECT ,                                                GP98322 02140000
         AGO   .CSECTCM                                         GP98322 02150000
.*                                                              GP98322 02160000
.CSECTDO ANOP  ,                                                GP98322 02170000
&L       CSECT ,                                                        02180000
.CSECTCM ANOP  ,                                                        02190000
&SECT    SETC  '&L'                                                     02200000
         AIF   ('&AM' EQ '' OR &AMSET).NOAM                     GP98365 02210000
         AIF   (NOT &MVSESA).NOAM                               GP04234 02220000
&L       AMODE &AM                                                      02230000
&AMSET   SETB  1                                                GP98365 02240000
.NOAM    AIF   ('&RM' EQ '' OR &RMSET).CSECTOK                  GP98365 02250000
         AIF   (NOT &MVSESA).CSECTOK                            GP04234 02260000
         AIF   ('&RM' EQ '24' OR '&RM' EQ 'ANY').SETRM          GP99120 02270000
         AIF   ('&RM' EQ '31').ANYRM                            GP99120 02280000
         MNOTE 4,'INVALID RM=&RM '                              GP99120 02290000
.ANYRM   ANOP  ,                                                GP99120 02300000
&L       RMODE ANY                                              GP99120 02310000
         AGO   .FLGRM                                           GP99120 02320000
.SETRM   ANOP  ,                                                GP99120 02330000
&L       RMODE &RM                                              GP98365 02340000
.FLGRM   ANOP  ,                                                GP99120 02350000
&RMSET   SETB  1                                                GP98365 02360000
.CSECTOK AIF   (T'&BASED EQ 'O' AND T'&ENTRY EQ 'O').NOCLAB      81163  02370000
         AIF   (T'&ENTRY NE 'O').DOCLAB                          81163  02380000
         AIF   ('&BASED' EQ '*').NOCLAB                          81163  02390000
.DOCLAB  ANOP  ,                                                 81163  02400000
&CME     SETB  1             SET SPECIAL BASE PROCESSING         81163  02410000
.NOCLAB  AIF   ('&LAB' NE '').OKCLAB                             81163  02420000
&LAB     SETC  'A@&SYSNDX'                                       81163  02430000
.OKCLAB  ANOP  ,                                                 81163  02440000
&CMB     SETC  '&LAB'        DEFAULT BASED VALUE                 81163  02450000
         AIF   (T'&BASED EQ 'O').CLABOK                          81163  02460000
         AIF   ('&BASED' EQ '*').CLABOK                          81163  02470000
         AIF   ('&BASED' NE '*SYSECT').CLABSET                   81163  02480000
         AIF   ('&SYSECT' EQ '').CLABOK   BOO                    81163  02490000
&CMB     SETC  '&SYSECT'                                         81163  02500000
         AGO   .CLABOK                                           81163  02510000
.CLABSET ANOP  ,                                                 81163  02520000
&CMB     SETC  '&BASED'                                          81163  02530000
.CLABOK  ANOP  ,                                                 81163  02540000
&CMU     SETC  'R15'         DEFAULT BASE REGISTER ON USING      81163  02550000
&SAV@DYN(&N) SETB (NOT &NOSAVE)                                         02560000
&PARMEXP SETC  '(R1)'                                                   02570000
&PARMREG SETC  '1'                                                      02580000
&SAVZPRM SETC  ''            PASS TO PARMLOAD MACRO             GP10180 02590000
         AIF   ('&PARM' EQ '').PARM1                                    02600000
&SAVZPRM SETC  '&PARM(1)'    PASS TO PARMLOAD MACRO             GP10180 02610000
         AIF   (N'&PARM LT 2).PARM1                                     02620000
&PARMEXP SETC  '&PARM(2)'                                               02630000
         AIF   (NOT &OLDSAVE).PARM1                                     02640000
&PARMREG SETC  '&PARM(2)'                                               02650000
         AIF   ('&PARMEXP'(1,1) EQ '(').STRIP                           02660000
         MNOTE 8,'PARM=&PARM INVALID'                                   02670000
         MNOTE 8,'PARM=(&PARM(1),(&PARM(2)) ASSUMED'                    02680000
         AGO   .STRIPT                                                  02690000
.STRIP   AIF   ('&PARMEXP'(K'&PARMEXP,1) EQ ')').STRIP1                 02700000
         MNOTE 12,'PARM=&PARM INVALID'                                  02710000
         MEXIT ,                                                        02720000
.STRIP1  ANOP  ,                                                        02730000
&PARMREG SETC  '&PARMREG'(2,K'&PARMREG-2)                               02740000
.STRIPT  AIF   ('&PARMREG'(1,1) GE '0').PARM1                           02750000
&PARMREG SETC  '&PARMREG'(2,K'&PARMREG-1)                               02760000
.PARM1   AIF   (NOT &DROP@1).NODROP                              81163  02770000
         DROP  ,                                                 81163  02780000
.NODROP  ANOP  ,                                                 81163  02790000
&DROP@1  SETB  1                                                 81163  02800000
         AIF   (T'&BASE NE 'O').NEWBASE                         GP02264 02810000
.NOBASE  AIF   (T'&ENTRY NE 'O').NOBASEU                         81163  02820000
         DS    0H                                                       02830000
         USING *,R15                                             81163  02840000
.NOBASEU ANOP  ,                                                 81163  02850000
&CMU     SETC  'R15'                                             81163  02860000
&CASE    SETC  'R15'                                             81163  02870000
         AGO   .BASED                                                   02880000
.NEWBASE ANOP  ,                                                GP02264 02890000
&K       SETA  N'&BASE      MAX NUMBER OF BASES SPECIFIED       GP02264 02900000
&CMU     SETC  '&BASE(1)'    SET THE FIRST ONE                  GP02264 02910000
&CASE    SETC  '&BASE(1)'    SET THE FIRST ONE                  GP02264 02920000
.BASED   AIF   (&NOSAVE).BASED2                                 GP04050 02930000
         USING &DSCTG,R13                                               02940000
.BASED2  AIF   ('&ID' EQ 'NO').NAMEOK                           GP05017 02950000
&B@      SETC  'B@&SYSNDX'                                              02960000
&N@      SETC  'N@&SYSNDX'                                              02970000
&LQ      SETC  'L'''                                                    02980000
&LAB     B     &B@-*(,R15)                                              02990000
&LAB     SETC  ''                                               GP05017 03000000
         DC    AL1(&LQ&N@)                                              03010000
         AIF   ('&ID' NE '*').USEID                                     03020000
&NAME    SETC  '&L'                                                     03030000
         AIF   (T'&L NE 'O').USENAME                                    03040000
&NAME    SETC  '&SYSECT'                                                03050000
.USENAME AIF   ('&RIGHT' EQ '').NORIGHT                                 03060000
&NAME    SETC  '&NAME'.' '.'COPYRIGHT '.'&RIGHT'                        03070000
.NORIGHT AIF   ('&DATE' EQ 'NO').NODATE                                 03080000
&N@      DC    C'&NAME - &SYSDATE - &SYSTIME'                           03090000
         AGO   .NAMEOK                                                  03100000
.NODATE  ANOP  ,                                                        03110000
&N@      DC    C'&NAME'                                                 03120000
         AGO   .NAMEOK                                                  03130000
.USEID   ANOP  ,                                                        03140000
         AIF   ('&ID'(1,1) NE '''').USEIDQ                              03150000
&N@      DC    C&ID                                                     03160000
         AGO   .NAMEOK                                                  03170000
.USEIDQ  ANOP  ,                                                        03180000
&N@      DC    C'&ID'                                                   03190000
.NAMEOK  ANOP  ,                                                GP05017 03200000
&LAB     MACPARM MODE=LBL                                       GP05017 03210000
         AIF   (T'&ENTRY EQ 'O').NOENTR                          81163  03220000
&I       SETA  0                                                 81163  03230000
&J       SETA  N'&ENTRY                                          81163  03240000
&N@      SETC  ''            SHORT ID                            81163  03250000
         AIF   ('&EID' EQ 'SHORT').ENTRSH                        81163  03260000
&N@      SETC  ' - '.'&SYSDATE'.' - '.'&SYSTIME'                 81163  03270000
.ENTRSH  AIF   (&I GE &J).ENTRDN                                 81163  03280000
&I       SETA  &I+1                                              81163  03290000
&C9      SETC  '&ENTRY(&I)'                                      81163  03300000
         AIF   (&NOENTRY).ENTRNN                                 81347  03310000
         SPACE 1                                                GP04051 03320000
         ENTRY &C9                                               81163  03330000
.ENTRNN  AIF   (T'&ENTNO EQ 'O').ENTRNM                          88255  03340000
&NUMENT  SETA  &NUMENT+1     INCREASE ENTRY NUMBER               88255  03350000
         DC    Y(&NUMENT)    MAKE ENTRY PREFIX                   88255  03360000
.ENTRNM  ANOP  ,                                                 88255  03370000
&C9      B     &B@-*(,R15)                                       81163  03380000
         AIF   ('&EID' EQ 'NONE').ENTRSH                        GP99055 03390000
&N       SETA  K'&N@+K'&C9                                       81163  03400000
&N       SETA  ((&N/2)*2)+1  MAKE ODD LENGTH FOR ALIGNMENT       81163  03410000
         DC    AL1(&N),CL(&N)'&ENTRY(&I)&N@'                     81163  03420000
         AGO   .ENTRSH                                           81163  03430000
.ENTRDN  AIF   (T'&ENTNO EQ 'O').ENTRDM                          88255  03440000
         DC    Y(0)          SET ENTRY PREFIX =0 (MAIN)          88255  03450000
.ENTRDM  AIF   (&NOSAVE).ELDSVAM                                GP04050 03460000
.*WHY?   USING &C9,R15                                          GP99158 03470000
&B@      SAVEX R14,R12,&SV.14,TYPE=&YOPT,SETAM=&SETAM           GP99018 03480000
&B@      SETC  ''                                                81163  03490000
.*WHY?   DROP  R15                                              GP99158 03500000
         AGO   .ELDSV                                           GP04050 03510000
.ELDSVAM AIF   ('&SETAM' EQ '').ELDSV                           GP04050 03520000
         AIF   (NOT &MVSESA).ELDSV                              GP04234 03530000
         BASR  &CASE,0                                          GP04050 03540000
         USING *,&CASE                                          GP04050 03550000
         AM&SETAM WORK=&CASE                                    GP04050 03560000
         DROP  &CASE                                            GP04050 03570000
.ELDSV   AIF   ('&CASE' EQ '').ELDSVLR                           87223  03580000
         AIF   ('&BASED' NE '*').ELDSVLR                         81263  03590000
&B@      BASR  &CASE,0                                           93006  03600000
         LA    R15,*-&CMB                                        81263  03610000
         SLR   &CASE,R15                                         87223  03620000
         AGO   .COMBAS2                                          81263  03630000
.ELDSVLR ANOP  ,                                                 81263  03640000
&B@      BASR  R15,0                                             93006  03650000
         USING *,R15                                             81163  03660000
         AIF   ('&CASE' EQ '').NOBASE2                           87223  03670000
         L     &CASE,=A(&CMB)                                    87223  03680000
         DROP  R15                                               81163  03690000
         AGO   .COMBAS2                                          81163  03700000
.NOENTR  AIF   (&NOSAVE).OLDSVAM                                GP04050 03710000
.*WHY    USING &LAB,R15                                         GP99158 03720000
&B@      SAVEX R14,R12,&SV.14,TYPE=&YOPT,SETAM=&SETAM           GP98322 03730000
&B@      SETC  ''                                                       03740000
.*WHY    DROP  R15                                              GP99158 03750000
         AGO   .OLDSV                                           GP04050 03760000
.OLDSVAM AIF   ('&SETAM' EQ '').OLDSV                           GP04050 03770000
         AIF   (NOT &MVSESA).OLDSV                              GP04234 03780000
         BASR  &CASE,0                                          GP04050 03790000
         USING *,&CASE                                          GP04050 03800000
         AM&SETAM WORK=&CASE                                    GP04050 03810000
         DROP  &CASE                                            GP04050 03820000
.OLDSV   AIF   ('&CASE' EQ '').NOBASE2                           87223  03830000
         AIF   ('&BREG' NE 'SET').BASREG                        GP05017 03840000
&B@      BASR  &CASE,0                                          GP05017 03850000
         LA    R15,*-&CMB                                       GP05017 03860000
         SLR   &CASE,R15                                        GP05017 03870000
         AGO   .COMBAS2                                         GP05017 03880000
.BASREG  AIF   (&CME).BASEL                                      81163  03890000
&B@      LA    &CASE,0(,R15)  REMOVE AM BIT                             03900000
         AGO   .COMBAS2                                          81163  03910000
.BASEL   USING &LAB,R15                                          81163  03920000
&B@      L     &CASE,=A(&CMB)                                    87223  03930000
         DROP  R15                                               81163  03940000
.COMBAS2 ANOP  ,                                                GP02264 03950000
&K       SETA  N'&BASE                                          GP02264 03960000
         AIF   (&K LT 2).NOBASE2                                GP02264 03970000
&I       SETA  1                                                GP02264 03980000
         LA    &BASE(&K),2048                                   GP02264 03990000
.NOBASLP AIF   (&I GE &K).NOBASE2                               GP02264 04000000
&I       SETA  &I+1                                             GP02264 04010000
         AIF   ('&BASE(&I)' EQ '').NOBASLP                      GP02264 04020000
         LA    &BASE(&I),2048(&BASE(&K),&BASE(&I-1))            GP02264 04030000
&CMU     SETC  '&CMU'.','.'&BASE(&I)'                           GP02264 04040000
         AGO   .NOBASLP                                         GP02264 04050000
.NOBASE2 AIF   ('&CASE' EQ '').NOUSEB                            87223  04060000
         USING &CMB,&CMU                                         81163  04070000
.NOUSEB  AIF   (NOT &OLDSAVE).NOLDSV                                    04080000
.*WHY?   L     R15,&SV.13                                       GP04050 04090000
.*WHY?   ST    &CASE,&SV.15-&DSCTG.(,R15)                        87223  04100000
         AIF   ('&PARM' EQ '').NOLDSV1                                  04110000
         AIF   ('&PARM' EQ 'R1' OR '&PARM' EQ '1').NOLDSV1      GP04052 04120000
         AIF   (&NOSAVE).NOLDSV1                                GP04052 04130000
         L     &PARM(1),&SV.&PARMREG-&DSCTG.(,R13)              GP04050 04140000
         AGO   .NOLDSV1                                                 04150000
.NOLDSV  AIF   (&NOSAVE).NOLDSV1                                        04160000
         AIF   ('&PARM' EQ '').NOPARM                                   04170000
         AIF   ('&PARM' EQ '1' OR '&PARM' EQ 'R1').NOPARM        87223  04180000
&MACPLAB SETC  ''                                                81154  04190000
         MACPARM &PARM(1),&PARMEXP                               81154  04200000
.*                                                                      04210000
.NOPARM  AIF   ('&SAVE' NE '*' AND NOT &ZERO).NOSTO NON-RENT/NO LENGTH  04220000
         AIF   (NOT &HWOPT).LYLEN                                84307  04230000
         L     R14,=A(&ENDG-&DSVAR)                             GP03033 04240000
         AGO   .NOLA                                             84307  04250000
.LYLEN   AIF   (NOT &BWOPT).LALEN                                84307  04260000
         LH    R14,=Y(&ENDG-&DSVAR)                             GP03033 04270000
         AGO   .NOLA                                                    04280000
.LALEN   LA    R14,&ENDG-&DSVAR                                 GP03033 04290000
.*  NOTE THAT R14-R1 ARE USED BY STORAGE                                04300000
.NOLA    ST    R14,&SV.FWD   TEMP: LEN INTO OLD SAVE AREA       GP02304 04310000
         AIF   ('&SAVE' NE '*').NOSTO                           GP03033 04320000
*        STORAGE OBTAIN,LENGTH=(R14),SP=&SP,BNDRY=&BNDRY,LOC=&LOC       04330000
         STORAGE OBTAIN,LENGTH=(R14),SP=&SP,BNDRY=&BNDRY,LOC=&LOC       04340000
         AGO   .GTSTO                                           GP03033 04350000
.NOSTO   LA    R14,&SAVE     LOAD NON-RENT SAVE AREA            GP03033 04360000
         AIF   (&ZERO).ZRSTO                                    GP03033 04370000
         XC    0(4*18,R14),0(R14)  PREVENT S978 IN EXIT         GP03033 04380000
         AGO   .SKPLEN                                          GP03033 04390000
.GTSTO   LR    R14,R1        SAVE OVER CLEAR                    GP02264 04400000
         AIF   (NOT &ZERO).UNCLEAN                              GP02264 04410000
.ZRSTO   SR    R15,R15       ZERO SOURCE LENGTH AND INSERTION   GP02264 04420000
         LR    R0,R14        SET CLEAR ADDRESS                  GP02264 04430000
         L     R1,&SV.FWD    GET SAVED LENGTH                   GP02304 04440000
         MVCL  R0,R14        CLEAR GOTTEN STORAGE               GP02264 04450000
         AIF   ('&SAVE' NE '*').SKPLEN  PREVENT S978 IN EXIT    GP03033 04460000
.UNCLEAN MVC   &SV.SPLN-&DSCTG.(4,R14),&SV.FWD  SET LENGTH FOR PGMEXIT  04470000
.SKPLEN  AIF   ('&SP' EQ '0').NOGM                               82002  04480000
         MVI   &SV.SPLN-&DSCTG.(R14),&SP  AND SUBPOOL           GP02264 04490000
.NOGM    ST    R14,&SV.FWD   MAKE FOWARD SAVE AREA LINK         GP02264 04500000
         ST    R13,&SV.13-&DSCTG.(,R14) MAKE BACKWARD LINK      GP02264 04510000
         AIF   (NOT &CPYREGS).LR13                                      04520000
         MVC   &SV.14-&DSCTG.(&SV.12+4-&SV.14,R14),&SV.14        81151  04530000
.LR13    LR    R13,R14       ESTABLISH NEW SAVE AREA                    04540000
         AIF   (T'&ENTRY EQ 'O' OR T'&ENTNO EQ 'O').NOLDENT      88255  04550000
         L     R1,&SV.13     GET OLD SAVE AREA BACK              88255  04560000
         CLM   &CASE,7,&SV.15+1-&DSCTG.(R1)  MAIN ENTRY ?        88255  04570000
         BE    *+16          YES; DON'T MOVE                     88255  04580000
         L     R1,&SV.15-&DSCTG.(,R1) GET ENTRY ADDRESS BACK     88255  04590000
         BCTR  R1,0          SPACE TO ENTRY COUNTER              88255  04600000
         MVC   &ENTNO+L'&ENTNO-1(1),0(R1) COPY COUNT             88255  04610000
.NOLDSV1 ANOP  ,       TRY IT HERE                              GP03033 04620000
.NOLDENT AIF   ('&PARM' NE '1' AND '&PARM' NE 'R1').NOPARM1      87223  04630000
         AIF   (&NOSAVE OR &OLDSAVE).NOPARM1                    GP04052 04640000
         L     R1,&SV.13     OLD SAVE AREA                       87223  04650000
         LM    R0,R1,&SV.0-&DSCTG.(R1)  RESTORE ENTRY REGISTERS  94272  04660000
.NOPARM1 AIF   (&NOT1ST).END                                            04670000
         AIF   (&DSOPT OR &NOSAVE).DSOPT                        GP04050 04680000
&DSCTG   DSECT ,                                                GP04051 04690000
&SV.SPLN DS    F                                                        04700000
&SV.13   DS    F                                                        04710000
&SV.FWD  DS    A                                                        04720000
&SV.14   DS    A                                                        04730000
&SV.15   DS    A                                                        04740000
&SV.0    DS    A                                                        04750000
&SV.1    DS    A                                                        04760000
&SV.2    DS    A                                                        04770000
&SV.3    DS    A                                                        04780000
&SV.4    DS    A                                                        04790000
&SV.5    DS    A                                                        04800000
&SV.6    DS    A                                                        04810000
&SV.7    DS    A                                                        04820000
&SV.8    DS    A                                                        04830000
&SV.9    DS    A                                                        04840000
&SV.10   DS    A                                                        04850000
&SV.11   DS    A                                                        04860000
&SV.12   DS    A                                                        04870000
&SV.FWK  EQU   *                                                 94272  04880000
         AIF   (NOT &NWOPT).NOEND                                       04890000
&ENDG    EQU   *                                                        04900000
.NOEND   AIF   ('&CSECT' NE 'RSECT').NOENDC                             04910000
&SECT    RSECT ,                                                        04920000
         AGO   .DSOPT                                                   04930000
.NOENDC  ANOP  ,                                                        04940000
&SECT    CSECT ,                                                        04950000
.DSOPT   AIF   (&EQUOPT OR &MAPONCE OR &SAV@REG).END                    04960000
&MAPONCE SETB  1                                                        04970000
&SAV@REG SETB  1                                                        04980000
         AIF   (&NOREG).SKPYREG  AVOID JES2 MAPPING CONFLICT    GP04115 04990000
         YREGS ,                                                        05000000
.SKPYREG MASKEQU ,                                               87223  05010000
.END     AIF   ('&SAVE' EQ '*' OR &NOSAVE).MEND                 GP04051 05020000
&SAVTYPE SETC  'OLD'         PREVENT STORAGE RELEASE IN PGMEXIT GP04051 05030000
 MNOTE *,'SAVE IS &SAVE'                                                05040000
 MNOTE *,'SAVTYPE IS &SAVTYPE'                                          05050000
.MEND    MEND  ,                                                GP04051 05060000
./ ADD NAME=PGMPATCH
         MACRO ,                                                        00010000
&NM      PGMPATCH &LEN                                 ADDED ON 2000017 00020000
         LCLC  &LN                                                      00030000
&LN      SETC  '&LEN'                                                   00040000
         AIF   ('&LEN' NE '').USERS                                     00050000
&LN      SETC  '128'                                                    00060000
.USERS   ANOP  ,                                                        00070000
&NM      DC    ((&LN+1)/2)S(*)                                          00080000
         MEND  ,                                                        00090000
./ ADD NAME=@PROTECT
         MACRO                                                          00010000
&NM      @PROTECT &PARM                                                 00020000
         GBLB  &WX@PRO                                                  00030000
         GBLC  &MACPLAB                                                 00040000
.********************************************************************** 00050000
.*                                                                   ** 00060000
.*   REPLACEMENT FOR IBM PROTECT MACRO/SERVICE. SEE MY SOURCE FOR    ** 00070000
.*     @PROTECS FOR DETAILS.                                         ** 00080000
.*                                                                   ** 00090000
.********************************************************************** 00100000
&NM      MACPARM R1,&PARM                                               00110000
         MACPARM R14,7,PRO0001A+1,MODE=3                                00120000
         BZ    PRO&SYSNDX.S   NOT LINKED; ISSUE SVC                     00130000
         AIF   (&WX@PRO).SECOND                                         00140000
         B     PRO&SYSNDX.S-2 .  ELSE USE QUICKY                        00150000
PRO0001A DC    V(@PROTECT)   ADDRESS OF @PROTECT ROUTINE                00160000
         WXTRN @PROTECT                                                 00170000
&WX@PRO  SETB  1                                                        00180000
.SECOND  BALR  R14,R14 .     INVOKE @PROTECT                            00190000
PRO&SYSNDX.S SVC 98 .        INVOKE PROTECT SVC                         00200000
         MEND                                                           00210000
./ ADD NAME=PRTBIG
         MACRO ,                                                        00010000
&NM      PRTBIG &ITEM,&LIST=,&DEV=,&OPT=                ADDED ON 81159  00020000
         LCLA  &OP,&I,&J                                                00030000
         LCLB  &B1,&B2,&B4,&B8,&B16,&B32,&B64,&B128              91056  00040000
         AIF   ('&ITEM' NE '' AND '&LIST' NE '').BOTH                   00050000
         AIF   ('&LIST' NE '').LIST                                     00060000
&J       SETA  N'&OPT                                                   00070000
         AIF   (&J EQ 0).ITMNOPT                                        00080000
.ITMLOOP AIF   (&I GE &J).ITMTEST                                       00090000
&I       SETA  &I+1                                                     00100000
&B128    SETB  (&B128 OR '&OPT(&I)' EQ 'CH12' OR '&OPT(&I)' EQ 'BIG')   00110000
&B64     SETB  (&B64 OR '&OPT(&I)' EQ 'MORE')                    91056  00120000
&B32     SETB  (&B32 OR '&OPT(&I)' EQ 'SMALLER')                 91056  00130000
&B16     SETB  (&B16 OR '&OPT(&I)' EQ 'CH8' OR '&OPT(&I)' EQ 'SMALL')   00140000
&B8      SETB  (&B8 OR '&OPT(&I)' EQ 'CENT' OR '&OPT(&I)' EQ 'CENTER')  00150000
&B4      SETB  (&B4 OR '&OPT(&I)' EQ 'LEFT')                     91056  00160000
&B2      SETB  (&B2 OR '&OPT(&I)' EQ 'RIGHT')                    91056  00170000
&B1      SETB  (&B1 OR '&OPT(&I)' EQ 'NEG' OR '&OPT(&I)' EQ 'NEGATIVE') 00180000
         AGO   .ITMLOOP                                                 00190000
.ITMTEST AIF   ((&B128+&B16+&B32) LT 2).ITMSONE                  91056  00200000
       MNOTE 4,'MUTUALLY EXCLUSIVE SIZE OPTIONS SPECIFIED; SMALL USED'  00210000
.ITMSONE ANOP  ,                                                 86064  00220000
&OP      SETA  &B128+&B64+&B32+&B16+&B8+&B4+&B2+&B1              91056  00230000
         AIF   (&OP NE &J).BADOPT                                       00240000
&OP      SETA  &B128*128+&B64*64+&B32*32+&B16*16+&B8*8+&B4*4+&B2*2+&B1  00250000
.ITMNOPT ANOP  ,                                                        00260000
&NM      PRTCOM PRTBIG,FUN=8,B0=0,B1=&OP,A1=&ITEM,DEV=&DEV              00270000
         MEXIT ,                                                        00280000
.BOTH    MNOTE 4,'ITEM OPERAND AND LIST= MUTUALLY EXCLUSIVE'            00290000
         MEXIT ,                                                        00300000
.BADOPT  MNOTE 4,'ERRONEOUS OPT= VALUE; USE ''CENT'' AND ''NEG'' ONLY'  00310000
         MEXIT ,                                                        00320000
.LIST    ANOP  ,                                                        00330000
&NM      PRTCOM PRTBIG,FUN=8,A1=&LIST,DEV=&DEV,OPT=&OPT,A80=ON          00340002
         MEND  ,                                                        00350000
./ ADD NAME=PRTCLOSE
         MACRO                                                          00010000
&NM      PRTCLOSE &TYPE,&DEV=                                           00020000
         LCLA  &FN                                                      00030000
         AIF   ('&TYPE' EQ '').COMM                                     00040000
         AIF   ('&TYPE' EQ 'TCLOSE' OR '&TYPE' EQ 'SPIN').SET1          00050000
         MNOTE 4,'*** UNRECOGNIZED TYPE &TYPE'                          00060000
.SET1    ANOP  ,                                                        00070000
&FN      SETA  1             SET TCLOSE FUNCTION                        00080000
.COMM    ANOP  ,                                                        00090000
&NM      PRTCOM PRTCLOSE,FUN=&FN,DEV=&DEV  EXPAND REQUEST               00100000
         MEND  ,                                                        00110000
./ ADD NAME=PRTCOM
         MACRO                                                          00010000
&NM      PRTCOM &OM,&B0=,&B1=0,&DEV=0,&FUN=,&A0=,&A1=,&OPT=,&A80=OFF    00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*   PRTCOM PROVIDES THE INTERFACE TO THE @PRINTER SERVICE ROUTINE    * 00050000
.*   ARGUMENTS ARE PASSED IN R0, R1, AND ACR0 (PRTF,PRTS)             * 00060000
.*                                                                    * 00070000
.*   IN AM24, THE REGISTER USE IS:                                    * 00080000
.*                                                                    * 00090000
.*   R0:0           R0:1           R0:2           R0:3                * 00100000
.*                                                                    * 00110000
.*   OPT FLAGS      TITLE/FOOTER#  DEVICE MASK    PRT FUNCTION REQ.   * 00120000
.*   (EITHER B0 OR OPT=)                                              * 00130000
.*                                                                    * 00140000
.*   R1:0           R1:1           R1:2           R1:3                * 00150000
.*                                                                    * 00160000
.*   LENGTH/ENDCH   ADDRESS-OF-LIST-OR-PRINT-DATA-ETC.                * 00170000
.*                                                                    * 00180000
.*--------------------------------------------------------------------* 00190000
.*                                                                    * 00200000
.*   IN AM31, THE REGISTER USE IS:                                    * 00210000
.*                                                                    * 00220000
.*   R0:0           R0:1           R0:2           R0:3                * 00230000
.*                                                                    * 00240000
.*   FLAG           TITLE/FOOTER#  DEVICE MASK    PRT FUNCTION REQ.   * 00250000
.*   (EITHER B0 OR OPT=)                                              * 00260000
.*                                                                    * 00270000
.*   R1:0           R1:1           R1:2           R1:3                * 00280000
.*                                                                    * 00290000
.*   ADDRESS-OF-LIST-OR-PRINT-DATA-ETC.---------------                * 00300000
.*                                                                    * 00310000
.*                                                                    * 00320000
.*   ACR0:0         ACR0:1         ACR0:2         ACR0:3              * 00330000
.*                                                                    * 00340000
.*                                                LENGTH/ENDCH        * 00350000
.*                                                                    * 00360000
.*--------------------------------------------------------------------* 00370000
.*                                                                    * 00380000
.*   FLAGS :                                                          * 00390000
.*                                                                    * 00400000
.*     80 - ABEND IF NOT OPENED         (PRTOPEN)                     * 00410000
.*     40 - (DON'T USE)                 (PRTOPEN)                     * 00420000
.*     20 - SUPPRESS WTO IF NOT OPENED  (PRTOPEN)                     * 00430000
.*     10 - ABEND IF DD DUMMY           (PRTOPEN)                     * 00440000
.*     20 - NEW SHEET ON NEXT PAGE EJECT                              * 00450000
.*     04 - THIS RECORD CONTAINS ASA                                  * 00460000
.*     02 - THIS RECORD CONTAINS MACHINE CODE                         * 00470000
.*     01 - NO CONTROL CHARACTER IN RECORD                            * 00480000
.*                                                                    * 00490000
.*   TITLE/FOOTER #:   4 BITS EACH; TOTAL OF EACH (PRTOPEN); ELSE     * 00500000
.*     NUMBER OF TITLE/FOOTER THIS RECORD IS TO BE USED FOR           * 00510000
.*                                                                    * 00520000
.*   DEVICE MASK:  (0 TREATED AS 1)                                   * 00530000
.*                                                                    * 00540000
.*   NUMBER OF DEVICE (1-8) FOR PRTOPEN; R1 POINTS TO PRTWORK/PUNWORK * 00550000
.*   ONE BIT PER DEVICE TO RECEIVE THIS RECORD (E.G. DEV=3 WRITES THE * 00560000
.*     REQUEST TO DEVICES 1 AND 2)                                    * 00570000
.*                                                                    * 00580000
.*   FUNCTION:  INDEX TO REQUESTED FUNCTION:                          * 00590000
.*                                                                    * 00600000
.*   0 - CLOSE      1 - TCLOSE     2 - OPEN       3 - ROOM (COND.SPC) * 00610000
.*   4 - SPACE N    5 - FD LIST    6 - V-RECORD   7 - FIXED REC.      * 00620000
.*   8 - SEPARATE   9 - SNAP      10 - FD ITEM   11 - STRING RECORD   * 00630000
.*  12 - AM31 FREC                                                    * 00640000
.*                                                                    * 00650000
.*--------------------------------------------------------------------* 00660000
         GBLC  &MACPLAB,&PRTMODE                                        00670000
         GBLB  &MVSESA                                          GP04234 00680000
         LCLA  &I,&J,&K,&OPA,&VD,&D(8)                                  00690000
         LCLB  &F01,&F02,&F04,&F08,&F10,&F20,&F40,&F80,&B0Z             00700000
         LCLB  &INDEV                                            81259  00710000
         LCLC  &DC,&LNR,&OP                                      81259  00720000
.*   FOR AM31 SUPPORT, THE A0 FIELD IS NOW PLACED INTO ACCESS REGISTER  00730000
.*   0, BYTE 3                                                          00740000
.*                                                                      00750000
&MACPLAB SETC  '&NM'                                             81259  00760000
&K       SETA  N'&OPT                                            90309  00770000
&B0Z     SETB  ('&B0' EQ '' OR '&B0' EQ '0')  OPTION FLAGS ?            00780000
         AIF   (&B0Z AND &K EQ 0).DEFOPT      NO FLAGS, NO OPTIONS      00790000
         AIF   (&B0Z OR  &K EQ 0).WHATOPT                               00800000
         MNOTE 8,'&OM: BOTH B0 AND OPT SPECIFIED; B0=&B0 IGNORED'       00810000
.WHATOPT AIF   (NOT &B0Z).ITMNOPT    B0 - USE IT                        00820000
&J       SETA  0             COUNT OF PROCESSED OPERANDS                00830000
.ITMLOOP AIF   (&I GE &K).ITMTEST                                90309  00840000
&I       SETA  &I+1                                              90309  00850000
&DC      SETC  '&OPT(&I)'                                               00860000
         AIF   ('&DC' EQ '').ITMLOOP  IGNORE NULLS                      00870000
         AIF   ('&DC' EQ 'WTO').ITMLOOP  IGNORE SEMANTIC NULLS  GP03027 00880000
         AIF   ('&DC' EQ 'DUMMY').ITMLOOP  IGNORE SEMANTIC NULL         00890000
&J       SETA  &J+1                                              90309  00900000
&F80     SETB  (&F80 OR '&DC' EQ 'ABE' OR '&DC' EQ 'LIST')              00910000
&F80     SETB  (&F80 OR '&DC' EQ 'ABEND')                               00920000
&F40     SETB  (&F40 OR '&DC' EQ 'X9700')                               00930000
&F20     SETB  (&F20 OR '&DC' EQ 'SHEET' OR '&DC' EQ 'PAGE')            00940000
&F20     SETB  (&F20 OR '&DC' EQ 'AUX' OR '&DC' EQ 'TRAY2')             00950000
&F20     SETB  (&F20 OR '&DC' EQ 'AUXTRAY' OR '&DC' EQ 'TRAY')          00960000
&F20     SETB  (&F20 OR '&DC' EQ 'NOWTO')                               00970000
&F10     SETB  (&F40 OR '&DC' EQ 'NODUMMY')                             00980000
&F10     SETB  (&F40 OR '&DC' EQ 'ABDUMMY')                             00990000
&F04     SETB  (&F04 OR '&DC' EQ 'ASA')   (DEFAULT)                     01000000
&F02     SETB  (&F02 OR '&DC' EQ 'MC' OR '&DC' EQ 'MCC')                01010000
&F02     SETB  (&F02 OR '&DC' EQ 'SKIPEJE' OR '&DC' EQ 'NOEJE')         01020000
&F01     SETB  (&F01 OR '&DC' EQ 'NO' OR '&DC' EQ 'NOCC')               01030000
&F01     SETB  (&F01 OR '&DC' EQ 'EJECT2' OR '&DC' EQ '2EJECT')         01040000
         AGO   .ITMLOOP                                          90309  01050000
.ITMTEST ANOP  ,                                                        01060000
&OPA     SETA  &F80+&F40+&F20+&F10+&F08+&F04+&F02+&F01                  01070000
         AIF   (&OPA EQ &J).DONOPT  EACH OPERAND VALID ?                01080000
.BADOPT  MNOTE 4,'&OM: ERROR - OPT PARAMETER BAD: &OPT'                 01090000
.DONOPT  ANOP  ,                                                        01100000
&OPA     SETA  &F80*128+&F40+&F20*32+&F10*16+&F08*8+&F04*4+&F02*2+&F01  01110000
&OP      SETC  '&OPA'                                                   01120000
         AGO   .POSTOPT                                         GP99029 01130000
.ITMNOPT ANOP  ,                                                 90309  01140000
&OP      SETC  '&B0'         USE USER'S PASSED VALUE             90309  01150000
         AIF   ('&OP' NE '').POSTOPT                                    01160000
.DEFOPT  ANOP  ,                                                        01170000
&OP      SETC  '0'           MAKE IT NON-BLANK                          01180000
.POSTOPT AIF   ('&DEV' EQ '' OR '&DEV' EQ '0').NODV                     01190000
         AIF   ('&DEV' NE 'ALL' AND '&DEV' NE '255').DVSOM      GP03240 01200000
&VD      SETA  255                                                      01210000
         AGO   .NODV                                                    01220000
.DVSOM   AIF   (K'&DEV LT 2).DVSOL                               81259  01230000
         AIF   ('&DEV'(1,1) NE '=').DVSOL                        81259  01240000
&INDEV   SETB  1             SET INDIRECT DEVICE NUMBER          81259  01250000
         AGO   .NODV                                             81259  01260000
.DVSOL   ANOP  ,                                                 81259  01270000
&I       SETA  0                                                        01280000
&K       SETA  N'&DEV                                                   01290000
.DEVLOOP ANOP  ,                                                        01300000
&I       SETA  &I+1                                                     01310000
         AIF   (&I GT &K).DVEND                                         01320000
         AIF   ('&DEV(&I)' EQ '').DEVLOOP                               01330000
         AIF   ('&DEV(&I)' EQ '0').DEVLOOP                              01340000
         AIF   ('&DEV(&I)' LT '1' OR '&DEV(&I)' GT '8').DVERR           01350000
&D(&DEV(&I)) SETA  1                                                    01360000
         AGO   .DEVLOOP                                                 01370000
.DVERR   MNOTE 8,'*** INVALID DEVICE NUMBER &DEV(&I)'                   01380000
         AGO   .DEVLOOP                                                 01390000
.DVEND   ANOP  ,                                                        01400000
&VD      SETA  128*&D(8)+64*&D(7)+32*&D(6)+16*&D(5)+8*&D(4)             01410000
&VD      SETA  &VD+4*&D(3)+2*&D(2)+&D(1)                                01420000
.NODV    AIF   ('&OP' NE '0' OR '&B1' NE '0').LONG              GP99029 01430000
         AIF   (&VD GT 15).LONG                                         01440000
&J       SETA  &VD*256+&FUN                                             01450000
         MACPARM R0,&J       LOAD DEVICE/FUNCTION INDEX          81259  01460000
         AGO   .POST0                                            81259  01470000
.LONG    ANOP  ,                                                 82326  01480000
&MACPLAB L     R0,=AL1(&OP,&B1+0,&VD,&FUN)                       81259  01490000
&MACPLAB SETC  ''            CANCEL LABEL                        81259  01500000
.POST0   AIF   (NOT &INDEV).LOAD1                                81259  01510000
&VD      SETA  K'&DEV-1                                          81259  01520000
&DC      SETC  '&DEV'(2,&VD)                                     81259  01530000
&MACPLAB ICM   R0,2,&DC                                          81259  01540000
&MACPLAB SETC  ''                                                81259  01550000
.LOAD1   AIF   ('&FUN' EQ '0' OR '&FUN' EQ '1').BAL  CLOSE?             01560000
         MACPARM R1,&A1      LOAD PARAMETER REGISTER                    01570000
         AIF   ('&A80' EQ 'OFF').NOTHIGH                        GP03025 01580000
         O     R1,=X'80000000'  SET LIST BIT (PRTBIG)           GP03025 01590000
.NOTHIGH AIF   (NOT &MVSESA).VER24                              GP04234 01600000
         AIF   (&FUN EQ 11 OR &FUN EQ 12).ACR                   GP03025 01610000
.VER24   AIF   ('&A0' EQ '' OR '&A0' EQ '0').BAL                 90309  01620000
&K       SETA  K'&A0                                            GP05190 01630000
         AIF   (&K LT 3).VER24I                                 GP05190 01640000
         AIF   ('&A0'(1,1) NE '(' OR '&A0'(2,1) EQ '(').VER24I  GP05190 01650000
         AIF   ('&A0'(&K,1) NE ')' OR '&A0'(&K-1,1) EQ ')').VER24I      01660000
         LA    R1,0(,R1)     CLEAR HIGH BYTE                    GP05190 01670000
         MACPARM R14,&A0,OP=LR,OPR=LR                           GP05190 01680000
         SLL   R14,24                                           GP05190 01690000
         OR    R1,R14        INSERT LENGTH                      GP05190 01700000
         AGO   .BAL                                             GP05190 01710000
.VER24I  ICM   R1,8,=AL1(&A0)                                    90309  01720000
         AGO   .BAL                                                     01730000
.ACR     AIF   ('&A0' NE '' AND '&A0' NE '0').ACRLOAD                   01740000
         AIF   (&FUN EQ 11 AND '&A0' EQ '0').ACRLOAD                    01750000
         MNOTE 8,'&OM: REQUIRED LENGTH VALUE MISSING'                   01760000
.ACRLOAD MACPARM R15,&A0                                                01770000
.*NEED(R) N     R15,=X'000000FF'  FOR FUTURE USE                        01780000
         SAR   R0,R15        LOAD INTO ACCESS REGISTER                  01790000
.BAL     AIF   ('&PRTMODE' EQ 'V').VCON                                 01800000
         L     R15,@PRINTER                                             01810000
         AGO   .BALR                                                    01820000
.VCON    L     R15,=V(@PRINTER)                                         01830000
.BALR    BASR  R14,R15                                          GP99020 01840000
         MEND  ,                                                        01850000
./ ADD NAME=PRTDATA
         MACRO ,                                                        00010000
&NM      PRTDATA &LIST,&DEV=,&TITLE=0                                   00020000
         LCLA  &N,&I,&J,&K                                              00030000
         LCLC  &LBL,&C,&T(10)                                           00040000
&N       SETA  N'&SYSLIST                                               00050000
&LBL     SETC  'ZZ'.'&SYSNDX'                                           00060000
&NM      PRTLIST &LBL.L,DEV=&DEV,TITLE=&TITLE                           00070000
         B     &LBL.X                                                   00080000
&LBL.L   FDOPT NL                                                       00090000
.LOOP    ANOP  ,                                                        00100000
&I       SETA  &I+1                                                     00110000
&K       SETA  N'&SYSLIST(&I)                                           00120000
         AIF   (&K LT 1).LOOP                                           00130000
&T(2)    SETC  ''                                                       00140000
&T(3)    SETC  ''                                                       00150000
&T(4)    SETC  ''                                                       00160000
&T(5)    SETC  ''                                                       00170000
&T(6)    SETC  ''                                                       00180000
&T(7)    SETC  ''                                                       00190000
&T(8)    SETC  ''                                                       00200000
&T(9)    SETC  ''                                                       00210000
&T(10)   SETC  ''                                                       00220000
&J       SETA  0                                                        00230000
.PLUP    ANOP  ,                                                        00240000
&J       SETA  &J+1                                                     00250000
&T(&J)   SETC  '&SYSLIST(&I,&J)'                                        00260000
         AIF   (&J LT &K).PLUP                                          00270000
.POUT    FD    &T(1),&T(2),&T(3),&T(4),&T(5),&T(6),&T(7),&T(8)          00280000
         AIF   (&I LT &N).LOOP                                          00290000
         FD    *END                                                     00300000
&LBL.X   DS    0H                                                       00310000
         MEND  ,                                                        00320000
./ ADD NAME=PRTF
         MACRO                                                          00010000
&NM      PRTF  &FAD,&LN,&DEV=,&TITLE=0,&FOOTER=0,&CC=,&OPT=,&MODE=,    *00020000
               &AM=31                                           GP02235 00030000
         GBLB  &MVSESA                                          GP04234 00040000
.*  NOTE THAT OPT= USES THE HIGH BYTE OF R1 UNLESS AM=AM31 IS USED      00050000
         LCLA  &CT,&I,&J,&K,&FN,&HF                              84068  00060000
         LCLB  &AM24,&AM31                                      GP02235 00070000
         LCLC  &L                                                       00080000
         AIF   (&MVSESA).ACC                                    GP04234 00090000
&AM24    SETB  1             FORCE OLD MODE                     GP04234 00100000
         AGO   .GOODAM                                          GP04234 00110000
.ACC     ANOP  ,                                                GP04234 00120000
&AM24    SETB  ('&AM' EQ '24' OR '&AM' EQ 'AM24')               GP02235 00130000
&AM31    SETB  ('&AM' EQ '31' OR '&AM' EQ 'AM31' OR '&AM' EQ 'ANY')     00140000
         AIF   (&AM24 OR &AM31).GOODAM                          GP02235 00150000
         MNOTE 4,'PRTF: USING AM=31 - UNRECOGNIZED AM=&AM'      GP02235 00160000
&AM31    SETB  1                                                GP02235 00170000
.GOODAM  AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00180000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00190000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00200000
.OKT     ANOP  ,                                                        00210000
&HF      SETA  &TITLE*16+&FOOTER                                        00220000
.NOT     ANOP  ,                                                        00230000
&FN      SETA  7+5*&AM31     USE FUNCTION CODE APPROPRIATE TO MODE      00240000
         AIF   ('&LN' EQ '').DFLTLEN                             90309  00250000
         AIF   ('&FAD'(1,1) EQ '''').LITLEN                     GP02235 00260000
&NM      PRTCOM PRTF,FUN=&FN,DEV=&DEV,B1=&HF,A0=&LN,A1=&FAD,OPT=&CC     00270000
         MEXIT ,                                                GP02235 00280000
.LITLEN  ANOP  ,                                                GP02235 00290000
&NM      LA    R1,&FAD                                          GP02235 00300000
         PRTCOM PRTF,FUN=&FN,DEV=&DEV,B1=&HF,A0=&LN,A1=(R1),OPT=&CC     00310000
         MEXIT ,                                                GP02235 00320000
.DFLTLEN AIF   ('&FAD'(1,1) NE '''').LNNLIT                     GP02235 00330000
&K       SETA  K'&FAD-2                                         GP02235 00340000
         AIF   ('&FAD'(&K+2,1) NE '''').LNNLIT                  GP08114 00350000
         AIF   (&K LT 4).LNNSHRT                                GP08114 00360000
&I       SETA  2                                                GP02235 00370000
&J       SETA  &K                                               GP02235 00380000
&K       SETA  &J                                               GP02235 00390000
.LNNLUP  AIF   ('&FAD'(&I,2) EQ '''''').LNNSK2                  GP02235 00400000
         AIF   ('&FAD'(&I,2) EQ '&&').LNNSK2                    GP02235 00410000
&I       SETA  &I+1                                             GP02235 00420000
         AGO   .LNNINC                                          GP02235 00430000
.LNNSK2  ANOP  ,                                                GP02235 00440000
&I       SETA  &I+2                                             GP02235 00450000
&K       SETA  &K-1                                             GP02235 00460000
.LNNINC  AIF   (&I LE &J).LNNLUP                                GP02235 00470000
.*                                                              GP02235 00480000
.LNNSHRT AIF   (&K GE 0).LNNCOM                                 GP02235 00490000
&K       SETA  0                                                GP02235 00500000
.LNNCOM  ANOP  ,                                                GP02235 00510000
&NM      LA    R1,=C&FAD                                        GP02235 00520000
&HF      SETA  &TITLE*16+&FOOTER                                GP02235 00530000
         PRTCOM PRTF,FUN=&FN,DEV=&DEV,B1=&HF,A0=&K,A1=(R1),OPT=&CC      00540000
         MEXIT ,                                                GP02235 00550000
.LNNLIT  ANOP  ,                                                GP02235 00560000
&L       SETC  'L'''                                            GP02235 00570000
&NM      PRTCOM PRTF,FUN=&FN,DEV=&DEV,B0=&CT,B1=&HF,A0=&L&FAD,A1=&FAD,O*00580000
               PT=&CC                                           GP08110 00590000
         MEND  ,                                                        00600000
./ ADD NAME=PRTITEM
         MACRO                                                          00010000
&NM      PRTITEM &LAD,&DEV=,&TITLE=0,&FOOTER=0,&OPT=             90309  00020000
.*   CLONED FROM PRTLIST                                        GP99029 00030000
         LCLA  &HF                                                      00040000
         AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00050000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00060000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00070000
.OKT     ANOP  ,                                                        00080000
&HF      SETA  &TITLE*16+&FOOTER                                        00090000
.NOT     ANOP  ,                                                        00100000
&NM      PRTCOM PRTLIST,FUN=10,DEV=&DEV,B1=&HF,A1=&LAD,OPT=&OPT         00110000
         MEND                                                           00120000
./ ADD NAME=PRTLIST
         MACRO                                                          00010000
&NM      PRTLIST &LAD,&DEV=,&TITLE=0,&FOOTER=0,&OPT=,&MODE=      90309  00020000
         LCLA  &HF                                                      00030000
         AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00040000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00050000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00060000
.OKT     ANOP  ,                                                        00070000
&HF      SETA  &TITLE*16+&FOOTER                                        00080000
.NOT     ANOP  ,                                                        00090000
&NM      PRTCOM PRTLIST,FUN=5,B1=&HF,A1=&LAD,DEV=&DEV,OPT=&OPT          00100000
         MEND                                                           00110000
./ ADD NAME=PRTL
         MACRO                                                          00010000
&NM      PRTL  &VAD,&DEV=,&TITLE=0,&FOOTER=0,&CC=,&OPT=,&MODE=  GP02301 00020000
.*--------------------------------------------------------------------* 00030000
.*                                                                    * 00040000
.*  PRTL SERVES AS A TEMPORARY ADJUNCT TO PRTF, PENDING CORRECTION    * 00050000
.*  OF PRTF AND PRTS IN 31-BIT ADDRESSING MODE                        * 00060000
.*                                                                    * 00070000
.*  PRTL 'LITERAL STRING' - CONVERTED TO VCON AND INVOKES PRTV        * 00080000
.*                                                                    * 00090000
.*--------------------------------------------------------------------* 00100000
         LCLA  &CT,&I                                                   00110000
         LCLC  &M#                                                      00120000
&M#      SETC  '&SYSNDX'                                                00130000
&NM      PRTV  ZZVC&M#,                                                *00140000
               DEV=&DEV,                                               *00150000
               TITLE=&TITLE,                                           *00160000
               FOOTER=&FOOTER,                                         *00170000
               CC=&CC,                                                 *00180000
               OPT=&OPT,                                               *00190000
               MODE=&MODE                                               00200000
         B     ZZVD&M#                                                  00210000
ZZVC&M#  VCON  &VAD                                                     00220000
ZZVD&M#  DS    0H                                                       00230000
         MEND                                                           00240000
./ ADD NAME=PRTOPEN
         MACRO                                                          00010000
&NM      PRTOPEN &WORK,&DEV=,&OPT=                                      00020000
         LCLA  &I,&J                                                    00030000
         LCLB  &A,&D,&W                                                 00040000
&J       SETA  N'&OPT                                                   00050000
&NM      PRTCOM PRTOPEN,FUN=2,A1=&WORK,DEV=&DEV,OPT=&OPT                00060000
         MEND  ,                                                        00070000
./ ADD NAME=PRTROOM
         MACRO                                                          00010000
&NM      PRTROOM &COUNT,&DEV=,&OPT=                              90309  00020000
&NM      PRTCOM PRTROOM,FUN=3,A1=&COUNT,DEV=&DEV,OPT=&OPT               00030000
         MEND                                                           00040000
./ ADD NAME=PRTSNAP
         MACRO ,                                                        00010000
&NM      PRTSNAP &LISTAD,&DEV=,&OPT=                    ADDED ON 83331  00020000
&NM      PRTCOM PRTSNAP,FUN=9,A1=&LISTAD,DEV=&DEV,OPT=&OPT              00030000
         MEND  ,                                                        00040000
./ ADD NAME=PRTSPACE
         MACRO                                                          00010000
&NM      PRTSPACE &COUNT,&DEV=,&OPT=                             90309  00020000
&NM      PRTCOM PRTSPACE,FUN=4,A1=&COUNT,DEV=&DEV,OPT=&OPT              00030000
         MEND                                                           00040000
./ ADD NAME=PRTS
         MACRO                                                          00010000
&NM      PRTS  &FAD,&DEV=,&TITLE=0,&FOOTER=0,&CC=,&OPT=,&END=0,&MODE=   00020000
.*  NOTE THAT OPT= USES THE HIGH BYTE OF R1 - PERMANENT RESTRICTION     00030000
         LCLA  &CT,&HF,&J,&K,&L                                         00040000
         AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00050000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00060000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00070000
.OKT     ANOP  ,                                                        00080000
&HF      SETA  &TITLE*16+&FOOTER                                        00090000
.NOT     AIF   ('&FAD'(1,1) NE '''').NOTLIT                             00100000
&K       SETA  K'&FAD-1                                                 00110000
&L       SETA  2                                                        00120000
&J       SETA  &K-1                                                     00130000
&K       SETA  &J                                                       00140000
.LOOP    AIF   ('&FAD'(&L,2) EQ '''''').SK2                             00150000
         AIF   ('&FAD'(&L,2) EQ '&&').SK2                               00160000
&L       SETA  &L+1                                                     00170000
         AGO   .INC                                                     00180000
.SK2     ANOP                                                           00190000
&L       SETA  &L+2                                                     00200000
&K       SETA  &K-1                                                     00210000
.INC     AIF   (&L LE &J).LOOP                                          00220000
.*                                                                      00230000
         AIF   (&K GE 0).COMLEN                                         00240000
&K       SETA  0                                                        00250000
.COMLEN  ANOP  ,                                                        00260000
&NM      LA    R1,=C&FAD                                                00270000
      PRTCOM PRTS,FUN=11,DEV=&DEV,B1=&HF,A0=&END,A1=(R1),OPT=(&OPT,&CC) 00280001
         MEXIT ,                                                        00290000
.NOTLIT  ANOP  ,                                                        00300000
&NM   PRTCOM PRTS,FUN=11,DEV=&DEV,B1=&HF,A0=&END,A1=&FAD,OPT=(&OPT,&CC) 00310001
         MEND                                                           00320000
./ ADD NAME=#PRT
         MACRO ,                                                        00010000
&NM      #PRT  &AD,&LN,&TYPE=VCON,&DEV=0,&CC=YES                        00020000
         GBLB  &ZZ#PRTF                                                 00030000
         GBLC  &MACPLAB,&ZZ#PRTN(10),&ZZ#PRTI(10)                       00040000
.********************************************************************** 00050000
.*                                                                    * 00060000
.*   #PRT GENERATES CALLS TO SUBROUTINE SUBPRT FOR PRINTING ON UP TO  * 00070000
.*   EIGHT OPEN PRINT STREAMS (DEV=1 OR DEV=(3,7)...                  * 00080000
.*     MULTIPLE PRINTERS ARE VALID EXCEPT WITH TYPE=OPEN              * 00090000
.*   PRINT DDs ARE ASSOCIATED WITH #PRTWRK MACROS                     * 00100000
.*                                                                    * 00110000
.********************************************************************** 00120000
         LCLA  &I,&J,&K,&N                                              00130000
         LCLB  &B0,&B1,&B2,&B3,&B4,&B5,&B6,&B7                          00140000
         LCLC  &PT,&PD,&OP1,&L,&M,&DV,&FN                               00150000
&MACPLAB SETC  '&NM'                                                    00160000
&L       SETC  'L'''                                                    00170000
&M       SETC  '&SYSNDX'                                                00180000
&DV      SETC  '&DEV'                                                   00190000
&OP1     SETC  '&AD'                                                    00200000
&FN      SETC  '0'                                                      00210000
         AIF   ('&CC' NE 'NO').YESCC                                    00220000
&FN      SETC  '128'                                                    00230000
.YESCC   AIF   (T'&DEV EQ 'N').DEVASIS                                  00240000
         AIF   (N'&DEV EQ 1).DEVASIS                                    00250000
.DEVLOOP AIF   (&J GE N'&DEV).DEVDONE                                   00260000
&J       SETA  &J+1                                                     00270000
         AIF   ('&DEV(&J)' GE '1' OR '&DEV(&J)' LE '8').DEVOK           00280000
         MNOTE 8,'#PRT: DEV=&DEV(&J) UNACCEPTABLE'                      00290000
.DEVOK   ANOP  ,                                                        00300000
&B0      SETB  (&B0 OR ('&DEV(&J)' EQ '8'))                             00310000
&B1      SETB  (&B1 OR ('&DEV(&J)' EQ '7'))                             00320000
&B2      SETB  (&B2 OR ('&DEV(&J)' EQ '6'))                             00330000
&B3      SETB  (&B3 OR ('&DEV(&J)' EQ '5'))                             00340000
&B4      SETB  (&B4 OR ('&DEV(&J)' EQ '4'))                             00350000
&B5      SETB  (&B5 OR ('&DEV(&J)' EQ '3'))                             00360000
&B6      SETB  (&B6 OR ('&DEV(&J)' EQ '2'))                             00370000
&B7      SETB  (&B7 OR ('&DEV(&J)' EQ '1'))                             00380000
         AGO   .DEVLOOP                                                 00390000
.*                                                                      00400000
.DEVDONE ANOP  ,                                                        00410000
&DV      SETC  '128*&B0+64*&B1+32*&B2+16*&B3+8*&B4+4*&B5+2*&B6+&B7'     00420000
.DEVASIS AIF   (&ZZ#PRTF).NOT1ST                                        00430000
&ZZ#PRTN(01) SETC 'VCON'                                                00440000
&ZZ#PRTI(01) SETC '0'                                                   00450000
&ZZ#PRTN(02) SETC 'SPACE'                                               00460000
&ZZ#PRTI(02) SETC '1'                                                   00470000
&ZZ#PRTN(03) SETC 'SKIP'                                                00480000
&ZZ#PRTI(03) SETC '1'                                                   00490000
&ZZ#PRTN(04) SETC 'KEEP'                                                00500000
&ZZ#PRTI(04) SETC '2'                                                   00510000
&ZZ#PRTN(05) SETC 'RESERVE'                                             00520000
&ZZ#PRTI(05) SETC '2'                                                   00530000
&ZZ#PRTN(06) SETC 'OPEN'                                                00540000
&ZZ#PRTI(06) SETC '3'                                                   00550000
&ZZ#PRTN(07) SETC 'CLOSE'                                               00560000
&ZZ#PRTI(07) SETC '4'                                                   00570000
&ZZ#PRTN(08) SETC 'TEXT'                                                00580000
&ZZ#PRTI(08) SETC '5'                                                   00590000
&ZZ#PRTN(09) SETC 'PRINTF'                                              00600000
&ZZ#PRTI(09) SETC '5'                                                   00610000
&ZZ#PRTN(10) SETC 'BCON'                                                00620000
&ZZ#PRTI(10) SETC '6'                                                   00630000
&ZZ#PRTF SETB  1             FIRST TIME STUFF DONE                      00640000
.NOT1ST  AIF   (T'&AD NE 'O').HAVEAD                                    00650000
         AIF   ('&TYPE' EQ 'CLOSE').HAVEAD                              00660000
         MNOTE 8,'#PRT: FIRST OPERAND REQUIRED (ADDR/TEXT/PRTWRK)'      00670000
         MEXIT ,                                                        00680000
.HAVEAD  AIF   (&I GE 10).BADTYPE                                       00690000
&I       SETA  &I+1                                                     00700000
         AIF   ('&TYPE' NE '&ZZ#PRTN(&I)').HAVEAD                       00710000
&PT      SETC  '&ZZ#PRTI(&I)'                                           00720000
         AIF   ('&TYPE' EQ 'CLOSE').HAVTYPE                             00730000
         AIF   ('&AD'(1,1) NE '''').HAVTYPE                             00740000
         AIF   ('&PT' EQ '0' OR '&PT' EQ '5' OR '&PT' EQ '6').DEFTEXT   00750000
         MNOTE 4,'#PRT: TYPE=&TYPE INVALID WITH LITERAL STRING'         00760000
&PT      SETC  '6'           DO LITERAL AS BCON                         00770000
.BADTYPE AIF   ('&AD'(1,1) EQ '''').DEFTEXT                             00780000
         MNOTE 8,'#PRT: TYPE=&TYPE INVALID'                             00790000
         MEXIT ,                                                        00800000
.*                                                                      00810000
.DEFTEXT ANOP  ,                                                        00820000
&PT      SETC  '6'           DO LITERAL AS BCON                         00830000
         MACPARM ZZZ&M.C,OP=B,MODE=ONE                                  00840000
ZZZ&M.L  BCON  &AD           DEFINE LITERAL WITH LENGTH                 00850000
&MACPLAB SETC  'ZZZ'.'&M'.'C'                                           00860000
&OP1     SETC  'ZZZ'.'&M'.'L'                                           00870000
.*                                                                      00880000
.HAVTYPE AIF   ('&PT' NE '5').NOTLEN                                    00890000
         MACPARM R0,&LN,NULL=&L&AD     GET TEXT LENGTH                  00900000
         MACPARM R0,16,OP=SLL          LEFT JUSTIFY                     00910000
         MACPARM R0,3,=AL1(&PT,&DV),OP=ICM,MODE=THREE  SET FUNC/DEV     00920000
         AGO   .SETADD                                                  00930000
.*                                                                      00940000
.NOTLEN  MACPARM R0,=AL1(0,0,&PT,&DV),OP=L                              00950000
.SETADD  AIF   ('&FN' EQ '' OR '&FN' EQ '0').SETFUN             GP09275 00960000
         MACPARM R0,8,=AL1(&FN),OP=ICM,MODE=THREE  SET FUNCTION CODE    00970000
.SETFUN  MACPARM R1,&OP1,NULL=SKIP     GET STORAGE ADDRESS              00980000
         MACPARM R15,=V(SUBPRT),OP=L    GET SUBROUTINE ADDRESS          00990000
         MACPARM R14,R15,OP=BALR,OPR=BALR  CALL SUBROUTINE              01000000
.MEND    MEND ,                                                         01010000
./ ADD NAME=PRTV
         MACRO                                                          00010000
&NM      PRTV  &VAD,&DEV=,&TITLE=0,&FOOTER=0,&CC=,&OPT=,&MODE=   90309  00020000
         LCLA  &CT,&HF                                                  00030000
         AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00040000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00050000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00060000
.OKT     ANOP  ,                                                        00070000
&HF      SETA  &TITLE*16+&FOOTER                                        00080000
.NOT     ANOP  ,                                                 90309  00090000
&NM      PRTCOM PRTV,FUN=6,B1=&HF,A1=&VAD,DEV=&DEV,OPT=(&OPT,&CC)       00100001
         MEND                                                           00110000
./ ADD NAME=PRTWORK
         MACRO                                                          00010000
&NM      PRTWORK &DD,&ALTDD,&TITLE=0,&FOOTER=0,&LPP=0,&WIDTH=0,        *00020000
               &FILL=0,&RECFM=0,&PAGE=0,&SPAGE=0,&PGUP=NO,&EXLST=0,    *00030000
               &BUF=                                            GP08088 00040000
         LCLA  &PFG,&I,&J,&K                                     84169  00050000
         LCLB  &B0,&B1,&B2,&B3,&B4,&B5,&B6,&B7,&PFX             GP05120 00060000
         LCLC  &REC                                              81155  00070000
&REC     SETC  '&RECFM'                                          81155  00080000
         AIF   ('&REC' EQ '0').DEFREC                            81155  00090000
&I       SETA  K'&RECFM                                          81155  00100000
         AIF   (&I LT 4).NRECSD                                  81155  00110000
         AIF   ('&RECFM'(&I,1) EQ '''').DEFREC                   81155  00120000
.NRECSD  AIF   (&J GE &I).DONREC                                 81155  00130000
&J       SETA  &J+1                                              81155  00140000
         AIF   ('&REC'(&J,1) EQ 'U').RECU                        81155  00150000
         AIF   ('&REC'(&J,1) EQ 'V').RECV                        81155  00160000
         AIF   ('&REC'(&J,1) EQ 'F').RECF                        81155  00170000
         AIF   ('&REC'(&J,1) EQ 'D').RECD                        81155  00180000
         AIF   ('&REC'(&J,1) EQ 'T').RECT                        81155  00190000
         AIF   ('&REC'(&J,1) EQ 'B').RECB                        81155  00200000
         AIF   ('&REC'(&J,1) EQ 'S').RECS                        81155  00210000
         AIF   ('&REC'(&J,1) EQ 'M').RECM                        81155  00220000
         AIF   ('&REC'(&J,1) EQ 'N').RECN                        81271  00230000
         AIF   ('&REC'(&J,1) NE 'A').DEFREC                      81155  00240000
&B5      SETB  1                                                 81155  00250000
         AGO   .NRECSD                                           81155  00260000
.RECM    ANOP  ,                                                 81155  00270000
&B6      SETB  1                                                 81155  00280000
         AGO   .NRECSD                                           81155  00290000
.RECN    ANOP  ,             SUPPRESS CC DEFAULT IN PRTOPEN      81271  00300000
&B7      SETB  1                                                 81271  00310000
         AGO   .NRECSD                                           81271  00320000
.RECS    ANOP  ,                                                 81155  00330000
&B4      SETB  1                                                 81155  00340000
         AGO   .NRECSD                                           81155  00350000
.RECB    ANOP  ,                                                 81155  00360000
&B3      SETB  1                                                 81155  00370000
         AGO   .NRECSD                                           81155  00380000
.RECD    AIF   (&B0 OR &B1).DEFREC     FAIL VD, ETC.             81155  00390000
.RECT    ANOP  ,                                                 81155  00400000
&B2      SETB  1                                                 81155  00410000
.RECV    ANOP  ,                                                 81155  00420000
&B1      SETB  1                                                 81155  00430000
         AGO   .NRECSD                                           81155  00440000
.RECU    ANOP  ,                                                 81155  00450000
&B1      SETB  1                                                 81155  00460000
.RECF    ANOP  ,                                                 81155  00470000
&B0      SETB  1                                                 81155  00480000
         AGO   .NRECSD                                           81155  00490000
.DONREC  ANOP  ,                                                 81155  00500000
&REC     SETC  'B'''.'&B0&B1&B2&B3&B4&B5&B6&B7'.''''             81155  00510000
.DEFREC  AIF   ('&PAGE' EQ '0').NOPG                                    00520000
&I       SETA  &PAGE                                                    00530000
&PFG     SETA  1             SET PAGE FEED-BACK                         00540000
&PFX     SETB  1             EXPAND PAGE VALUES                 GP05120 00550000
.NOPG    AIF   ('&SPAGE' EQ '0').NOSPG                                  00560000
&J       SETA  &SPAGE                                                   00570000
&PFG     SETA  1             SET PAGE FEED-BACK                         00580000
&PFX     SETB  1             EXPAND PAGE VALUES                 GP05120 00590000
.NOSPG   AIF   ('&PGUP' EQ 'NO').NOPGUP                          84169  00600000
&PFG     SETA  3             SET UPDATING BY USER                84169  00610000
         AIF   ('&PGUP' EQ '' OR '&PGUP' EQ 'YES').NOPGUP        84169  00620000
         MNOTE 4,'INVALID PGUP OPTION : &PGUP'                   84169  00630000
.NOPGUP  AIF   ('&EXLST' EQ '0').NOLST1                                 00640000
&PFG     SETA  &PFG+4        SET EXIT LIST FLAG                  84169  00650000
.NOLST1  AIF   ('&BUF' NE '1').NOBUF1                           GP08088 00660000
&PFG     SETA  &PFG+16       SIGNLE BUFFER                      GP08088 00670000
.NOBUF1  ANOP  ,                                                GP08088 00680000
         DC    0H'0'                                                    00690000
&NM      DC    CL8'&DD ',CL8'&ALTDD ',AL2(&LPP),AL1(&FILL,&WIDTH,&TITLE*00700000
               ,&FOOTER,&REC,&PFG)                                      00710000
         AIF   (NOT &PFX).SKIPPG#                               GP05120 00720000
         DC    Y(&I,&J)      PAGE/SUB-PAGE FEEDBACK AREA                00730000
.SKIPPG# DC    AL4(&EXLST)   EXIT LIST POINTER                   84169  00740000
.MEND    MEND  ,                                                        00750000
./ ADD NAME=#PRTWRK
         MACRO ,                                                        00010000
&NM    #PRTWRK  &DDNAME=SYSPRINT,&MAXLPP=60,&PFX=PR1,&@TITLE=@HEADERS, *00020000
               &FLAGS=0,&WIDTH=132,&REPCH=0                             00030000
.*  This macro defines work space for one print file. The definition    00040000
.*     is used with the #PRT macro and the SUBPRT subroutine.           00050000
.*  A unique DDNAME is required, and a unique prefix. Only eight        00060000
.*   concurrent print files are supported, and it is suggested to use   00070000
.*   prefixes of PR1 to PR8 for convenience.  The name of this work     00080000
.*   area (invocation name field) must be placed into the @PRTWORK      00090000
.*   list at this printer number's offset using a #PRT TYPE=OPEN call.  00100000
.*  Title specifies the name of a variable length list of words. The    00110000
.*   first word specifies the address where the 4 byte page number      00120000
.*   will be updated; the next words the first, second, etc. header     00130000
.*   lines (first of these must have a page eject); the list is         00140000
.*   terminated by a word of zeroes.                                    00150000
.*  MAXLPP should be set to the desired lines per page, but not less    00160000
.*   than 15 and not more than 200                                      00170000
.*  FLAGS should be set (with the appropriate prefix):                  00180000
.*     =pr1FGPUN   punch file (no translation) - not tested             00190000
.*     =pr1FGTRN   inhibit translation of unprintable characters        00200000
.*     =pr1FGPRT   MCC ION printers only - use portrait mode            00210000
.*  WIDTH=132 - provided for future expansion (ibm 3800 = 204)          00220000
.*  REPCH= self-defining character - sets the replacement character     00230000
.*     for unprintable characters for all open files (only one table    00240000
.*     is defined for all files. defaults to reverse slash \            00250000
&NM      DS    0D            WORK AREA FOR PRINTER &PFX (PRT#)          00260000
&PFX.@HEAD DC  A(&@TITLE)    ADDRESS OF TITLE LIST                      00270000
         DC    3A(0)           RESERVED FOR FUTURE EXPANSION            00280000
         SPACE 1                                                        00290000
&PFX.DCB DCB   DDNAME=&DDNAME,DSORG=PS,MACRF=PM EXLST=PRTEXLST          00300000
&PFX.MAXTX DC  Y(&WIDTH)     MAXIMUM TEXT WIDTH                         00310000
&PFX.MAXLN DC  Y(&MAXLPP)    MAXIMUM LINES PER PAGE                     00320000
&PFX.CURLN DC  Y(1+&MAXLPP)  CURRENT LINE POSITION                      00330000
&PFX.PAGE  DC  Y(0)          PAGE NUMBER                                00340000
&PFX.FORCC DC  X'00'         FORCED CC OVERRIDE ON NEXT PRINT           00350000
&PFX.FLAGS DC  AL1(&FLAGS)   PROCESSING FLAGS                           00360000
&PFX.FGPUN EQU X'80'           PUNCH FILE; NO CC                        00370000
&PFX.FGTRN EQU X'40'           PRINT; INHIBIT TRANSLATE                 00380000
&PFX.FGPRT EQU X'20'  IRS MCC SPECIFIC - SET ION PRT PORTRAIT MODE      00390000
&PFX.REPCH DC  AL1(&REPCH)   UNPRINTABLE CHARACTER REPLACEMENT          00400000
&PFX.RDW   DC  Y(5,0)        RECORD DESCRIPTOR FOR RECFM=V              00410000
&PFX.CC    DC  X'8B'         CARRIAGE CONTROL                           00420000
.*FX.TRL   DC  C'1'          3800 OPTCD=J TABLE REFERENCE CHARACTER     00430000
&PFX.TEXT  DC  CL(&WIDTH)' ' DATA RECORD                                00440000
         DC    3X'00'          RESERVED                                 00450000
         MEND  ,                                                        00460000
./ ADD NAME=PSWSECT
           MACRO                                                        00010000
&NM      PSWSECT &PFX=PSW,&LIST=,&FLAGS=,&WYL=,&LCL=             81134  00020000
         LCLB  &FL,&FF,&FW,&FX,&FWO                              81134  00030000
&FL      SETB  ('&LIST' EQ '' OR '&LIST' EQ 'YES')               81134  00040000
&FF      SETB  ('&FLAGS' EQ '' OR '&FLAGS' EQ 'YES')             81134  00050000
&FW      SETB  ('&WYL' EQ 'YES')                                 81134  00060000
&FWO     SETB  ('&WYL' EQ 'ONLY')                                81134  00070000
&FX      SETB  ('&LCL' EQ 'YES')                                 81134  00080000
*********************************************************************** 00090000
*                                                                     * 00100000
*                 PROTECT (SVC98) PASSWORD WORK AREA                  * 00110000
*                                                                     * 00120000
*********************************************************************** 00130000
           SPACE 2                                                      00140000
           AIF   ('&NM' EQ '').DSECT                                    00150000
&NM        DS    0F .          PASSWORD/PROTECT WORK AREA               00160000
           AGO   .NOSECT                                                00170000
.DSECT     ANOP ,                                                       00180000
&PFX.SECT  DSECT ,             PASSWORD/PROTECT WORK AREA               00190000
.NOSECT  AIF   (NOT &FL).NOTLST1                                 81134  00200000
&PFX.LIST  DC    XL28'0' .     DEFINE FOR XC CLEAR                      00210000
           ORG   &PFX.LIST .   START INDIVIDUAL DEFINITIONS             00220000
           SPACE 1                                                      00230000
&PFX.PCODE DC    X'00' .       'PROTECT' FUNCTION REQUEST               00240000
.NOTLST1   AIF (NOT &FL AND NOT &FF).NOTLST2                     81134  00250000
&PFX.FADD  EQU   1 .           ADD A PASSWORD                           00260000
&PFX.FREP  EQU   2 .           CHANGE A PASSWORD                        00270000
&PFX.FDEL  EQU   3 .           DELETE A PASSWORD                        00280000
&PFX.FLIST EQU   4 .           FIND A PASSWORD                          00290000
&PFX.FTTR  EQU   5 .           RETURN TTR (LIKE FIND); TTR=>A(DATA)     00300000
&PFX.FTTD  EQU   6 .           SUPPLY DSN, GET TTR OF FIRST ENTRY       00310000
         AIF   (NOT &FL).NOTLST2                                 81134  00320000
           SPACE 1                                                      00330000
&PFX.PDATA DC    AL3(0) .      'FIND' OPERATION 80 BYTE DATA AREA PTR   00340000
&PFX.DSNL  DC    X'00' .       DSN LENGTH                               00350000
&PFX.DSNA  DC    AL3(0) .      DSN ADDRESS                              00360000
           DC    X'00' .       UNUSED                                   00370000
&PFX.PSWA  DC    AL3(0) .      PTR TO CURRENT PASSWORD                  00380000
           SPACE 1                                                      00390000
*          END OF LIST FOR 'FIND' OPERATION                             00400000
           SPACE 1                                                      00410000
           DC    X'00' .       UNUSED                                   00420000
&PFX.CONP  DC    AL3(0) .      PTR TO CONTROL PSW IF NOT CPSW OP        00430000
&PFX.VOL#  DC    X'00' .       NO. OF VOLUMES IN VOLUME LIST            00440000
&PFX.VOLA  DC    AL3(0) .      PTR TO VOLUME LIST                       00450000
           SPACE 1                                                      00460000
*          END OF LIST FOR 'DELETE' OPERATION                           00470000
           SPACE 1                                                      00480000
&PFX.TCODE DC    X'00' .       PROTECTION CODE                          00490000
.NOTLST2   AIF (NOT &FL AND NOT &FF).NOTLST3                     81134  00500000
&PFX.TDEF  EQU   0 .           DEFAULT ?                                00510000
&PFX.TRW   EQU   1 .           READ/WRITE ALLOWED                       00520000
&PFX.TRD   EQU   2 .           READ ALLOWED                             00530000
&PFX.TWR   EQU   3 .           WRITE ALLOWED                            00540000
         AIF   (NOT &FL).NOTLST3                                 81134  00550000
           SPACE 1                                                      00560000
&PFX.NPSWA DC    AL3(0) .      ADDRESS OF NEW PASSWORD                  00570000
&PFX.DATL  DC    X'00' .       LENGTH OF DATA FIELD                     00580000
&PFX.DATB  DC    AL3(0) .      ADDRESS OF DATA FIELD                    00590000
           SPACE 1                                                      00600000
*          END OF LIST FOR ADD AND REPLACE                              00610000
           SPACE 2                                                      00620000
*********************** END OF SVC 98 WORKAREA ************************ 00630000
           SPACE 2                                                      00640000
&PFX.NPSW  DC    CL8' ' .      NEW PASSWORD FOR ADD/REPLACE             00650000
&PFX.CPSW  DC    CL8' ' .      CONTROL PASSWORD FOR NON-CONTROL OP      00660000
.NOTLST3   SPACE 2                                               81134  00670000
*********************************************************************** 00680000
*                                                                     * 00690000
*                           PASSWORD RECORD                           * 00700000
*                                                                     * 00710000
*********************************************************************** 00720000
           SPACE 2                                                      00730000
&PFX.START DS    0F .          START OF PASSWORD RECORD                 00740000
         AIF   (&FWO).WYLSHRT                                    81134  00750000
&PFX.DSN   DC    CL44' ' .     DATASET NAME                             00760000
         AGO   .WYLFULL                                          81134  00770000
.WYLSHRT ANOP  ,                                                 81134  00780000
&PFX.DSN   DC    CL25' ' .     DSN FOR WYLBUR-ONLY CALLS         81134  00790000
.WYLFULL ANOP  ,                                                 81134  00800000
&PFX.PSWD  DC    CL8' ' .      PASSWORD                                 00810000
           SPACE 1                                                      00820000
*          END OF KEY FIELD                                             00830000
           SPACE 1                                                      00840000
         DS    0H ,          SET COUNTER ALIGNMENT               81134  00850000
&PFX.DATA  DC    CL80' ' .     DATA RECORD OF ENTRY                     00860000
&PFX.DATAN EQU   *                                                      00870000
           ORG   &PFX.DATA .   REDEFINE                                 00880000
&PFX.COUNT DC    H'0' .        ACCESS COUNTER                           00890000
&PFX.FLAG  DC    X'00' .       ENTRY TYPE FLAG                          00900000
&PFX.FCON  EQU   X'80' .       CONTROL PASSWORD                         00910000
&PFX.FRW   EQU   X'01' .       READ AND WRITE ACCESS ALLOWED            00920000
*                              READ ONLY IF OFF                         00930000
           ORG   &PFX.DATAN    END OF DATA FIELD                        00940000
&PFX.RECL  EQU   *-&PFX.START . LENGTH OF PASSWORD RECORD               00950000
.LOCOK   AIF   (NOT &FW AND NOT &FWO).NOWYL                      81134  00960000
           SPACE 2                                                      00970000
****************** WYLBUR DATA SET NAME DEFINITIONS ******************* 00980000
           SPACE 1                                                      00990000
           ORG   &PFX.DSN .    REDEFINE 'WYLBUR' RECORD                 01000000
&PFX.WYLB  DC    CL9'WYLBUR' . SYSTEM IDENTIFIER                        01010000
&PFX.ACCT  DC    0CL8' ' .     FULL ACCOUNT NUMBER                      01020000
&PFX.ACT   DC    CL4' ' .      ACCOUNT NUMBER                           01030000
&PFX.SUB   DC    CL4' ' .      SUB-ACCOUNT                              01040000
&PFX.USER  DC    CL8' ' .      USER ID                                  01050000
&PFX.WYLL  EQU   *-&PFX.WYLB . LENGTH OF DSN ENTRY FOR WYLBUR           01060000
           SPACE 1                                                      01070000
******************** WYLBUR DATA AREA DEFINITIONS ********************* 01080000
           SPACE 1                                                      01090000
           ORG   &PFX.FLAG+1 . START OF WYLBUR DATA FIELD               01100000
&PFX.WPRIV DC    X'00' .       USER PRIVILEGES                          01110000
&PFX.WOK   EQU   X'80' .       VALID PASSWORD (FOR ZAPS)                01120000
&PFX.WSYS  EQU   X'40' .       SYSTEM PROGRAMMER                        01130000
&PFX.WACCT EQU   X'20' .       CROSS ACCOUNTS PRIVILEGE                 01140000
&PFX.WOPER EQU   X'10' .       OPERATOR PRIVILEGE                       01150000
&PFX.WFAIL EQU   X'08' .       UNDER PRIVILEGED ?                       01160000
&PFX.WLCL  EQU   X'04' .       IN-HOUSE USER                     81134  01170000
&PFX.WTIME EQU   X'02' .       ALLOWED 'NOTIME-OUT'                     01180000
&PFX.WSUB  EQU   X'01' .       SUB-ACCOUNT PRIVILEGE                    01190000
           SPACE 1                                                      01200000
&PFX.WHASP DC    X'00' .       JOB ENTRY INTERFACE BITS                 01210000
&PFX.WNKEY EQU   X'80' .       DO KEYWORD CHECK FOR BATCH JOBS          01220000
&PFX.WNBAT EQU   X'40' .       BATCH JOB ENTRY PERMITTED                01230000
&PFX.WNSEQ EQU   X'20' .       USER RESTRICTED TO PDS ON WYLBUR PACKS   01240000
&PFX.WNWYB EQU   X'10' .       USER RESTRICTED TO 'LIB' DATASET  81134  01250000
&PFX.WXDAT EQU   X'01' .       DATA FIELD IS PRESENT                    01260000
           SPACE 1                                                      01270000
&PFX.WBIN  DC    CL3' ' .      DATE OF CREATION OR LAST MAINTENANCE     01280000
&PFX.HINDX DC    X'00' .       INDEX TO 'WYL' INDEX IN VOLT      81134  01290000
&PFX.WDATE DC    PL3'0' .      DATE OF LAST ACCESS                      01300000
&PFX.WFLAG DC    X'00' .       PROCESSING FLAGS                         01310000
&PFX.WAUL  EQU   X'80' .       AUTO LOAD LOGON GO (CONDITIONAL)         01320000
&PFX.MODP  EQU   X'40' .       USER PASSWORD MODIFY ALLOWED             01330000
&PFX.WAUA  EQU   X'20' .       AUTO LOGON FOR RECOVERY (UNCONDITIONAL)  01340000
&PFX.WCPU  DC    X'00' .       INDEX TO DEFAULT CPU                     01350000
&PFX.WRJID DC    2X'00' .      HASP RJE PRINT/PUNCH ROUTING             01360000
&PFX.WSSID DC    CL8' ' .      DEFAULT SUB-SYSTEM                       01370000
&PFX.WDVOL DC    CL6' ' .      DEFAULT SAVE VOLUME                      01380000
&PFX.WACTS DC    6CL4' ' .     ADDITIONAL ACCTS. FOR JOB ACCESS         01390000
&PFX.WAVOL DC    5CL5' ' .      PACKS PERMITTED TO ACCESS (1ST 5 DIG)   01400000
           SPACE 2                                                      01410000
.NOWYL   AIF   (NOT &FX).MDONE                                   81134  01420000
********************* LOCAL SPECIAL PASSWORD ENTRY ******************** 01430000
           SPACE 1                                                      01440000
           ORG   &PFX.FLAG+1                                            01450000
&PFX.AXACT DC    4CL8' ' .     ACCOUNTS                                 01460000
&PFX.AXUID DC    3CL8' ' .     TSO USER ID                              01470000
&PFX.AXRJE DC    3X'00' .      RJE REMOTE NUMBERS                       01480000
           ORG   &PFX.DATAN                                             01490000
.MDONE     SPACE 1                                               81134  01500000
*********************** END OF PASSWORD RECORD ************************ 01510000
           SPACE 2                                                      01520000
         MEND  ,                                                        01530000
./ ADD NAME=PUNWORK
         MACRO                                                          00010000
&NM      PUNWORK &DD,&ALTDD,&TITLE=0,&FOOTER=0,&LPP=0,                 *00020000
               &WIDTH=80,&RECFM=FBN,&EXLST=,&BUF=               GP08088 00030000
         LCLA  &PFG                                                     00040000
         LCLA  &I,&J                                             81155  00050000
         LCLB  &B0,&B1,&B2,&B3,&B4,&B5,&B6,&B7                   81155  00060000
         LCLC  &REC                                              81155  00070000
&REC     SETC  '&RECFM'                                          81155  00080000
&PFG     SETA  128           SET PUNCH OPTION                           00090000
         AIF   ('&REC' EQ '0').DEFREC                            81155  00100000
&I       SETA  K'&RECFM                                          81155  00110000
         AIF   (&I LT 4).NRECSD                                  81155  00120000
         AIF   ('&RECFM'(&I,1) EQ '''').DEFREC                   81155  00130000
.NRECSD  AIF   (&J GE &I).DONREC                                 81155  00140000
&J       SETA  &J+1                                              81155  00150000
         AIF   ('&REC'(&J,1) EQ 'U').RECU                        81155  00160000
         AIF   ('&REC'(&J,1) EQ 'V').RECV                        81155  00170000
         AIF   ('&REC'(&J,1) EQ 'F').RECF                        81155  00180000
         AIF   ('&REC'(&J,1) EQ 'D').RECD                        81155  00190000
         AIF   ('&REC'(&J,1) EQ 'T').RECT                        81155  00200000
         AIF   ('&REC'(&J,1) EQ 'B').RECB                        81155  00210000
         AIF   ('&REC'(&J,1) EQ 'S').RECS                        81155  00220000
         AIF   ('&REC'(&J,1) EQ 'M').RECM                        81155  00230000
         AIF   ('&REC'(&J,1) EQ 'N').RECN                        81271  00240000
         AIF   ('&REC'(&J,1) NE 'A').DEFREC                      81155  00250000
&B5      SETB  1                                                 81155  00260000
         AGO   .NRECSD                                           81155  00270000
.RECM    ANOP  ,                                                 81155  00280000
&B6      SETB  1                                                 81155  00290000
         AGO   .NRECSD                                           81155  00300000
.RECN    ANOP  ,             SUPPRESS CC INSERTION IN OPEN       81271  00310000
&B7      SETB  1                                                 81271  00320000
         AGO   .NRECSD                                           81271  00330000
.RECS    ANOP  ,                                                 81155  00340000
&B4      SETB  1                                                 81155  00350000
         AGO   .NRECSD                                           81155  00360000
.RECB    ANOP  ,                                                 81155  00370000
&B3      SETB  1                                                 81155  00380000
         AGO   .NRECSD                                           81155  00390000
.RECD    AIF   (&B0 OR &B1).DEFREC     FAIL VD, ETC.             81155  00400000
.RECT    ANOP  ,                                                 81155  00410000
&B2      SETB  1                                                 81155  00420000
.RECV    ANOP  ,                                                 81155  00430000
&B1      SETB  1                                                 81155  00440000
         AGO   .NRECSD                                           81155  00450000
.RECU    ANOP  ,                                                 81155  00460000
&B1      SETB  1                                                 81155  00470000
.RECF    ANOP  ,                                                 81155  00480000
&B0      SETB  1                                                 81155  00490000
         AGO   .NRECSD                                           81155  00500000
.DONREC  ANOP  ,                                                 81155  00510000
&REC     SETC  'B'''.'&B0&B1&B2&B3&B4&B5&B6&B7'.''''             81155  00520000
.DEFREC  AIF   ('&EXLST' EQ '').NOLST1                           84169  00530000
&PFG     SETA  &PFG+4        SET EXIT LIST PRESENT               84169  00540000
.NOLST1  AIF   ('&BUF' NE '1').NOBUF1                           GP08088 00550000
&PFG     SETA  &PFG+16       SIGNLE BUFFER                      GP08088 00560000
.NOBUF1  ANOP  ,                                                GP08088 00570000
         DC    0H'0'                                                    00580000
&NM      DC    CL8'&DD ',CL8'&ALTDD ',AL2(&LPP,&WIDTH),AL1(&TITLE,&FOOT*00590000
               ER,&REC,&PFG)                                            00600000
         AIF   ('&EXLST' EQ '').MEND                             84169  00610000
         DC    AL4(&EXLST)   EXIT LIST ADDRESS                   84169  00620000
.MEND    MEND  ,                                                 84169  00630000
./ ADD NAME=RANDOM
         MACRO ,                                        REPLACED 78029  00010000
&ALIAS   RANDOM &R=R14,&SECT=,&SCALE=10                 REWRITE 2003358 00020000
         GBLB  &MVS,&MVSSP,&MVSXA,&MVSESA,&OS390,&Z900          GP04234 00030000
         GBLC  &MACPLAB                                         GP03358 00040000
&MACPLAB SETC  '&ALIAS'                                         GP03358 00050000
.*--------------------------------------------------------------------* 00060000
.*   RANDOM - INLINE MACRO TO EXPAND RANDOM NUMBER GENERATION SUBRTNE * 00070000
.*     NEEDS LTORG FOR THE CURRENT CSECT PRIOR TO END                 * 00080000
.*                                                                    * 00090000
.*     INVOKE AS BAS R14,RANDOM                                       * 00100000
.*     XC RANDAU(4),RANDAU  TO RE-INITIALIZE                          * 00110000
.*     RETURN IN GPR 0 INTEGER 0 TO 9 UNLESS SCALE IS REQUESTED       * 00120000
.*                                                                    * 00130000
.*     SECT= SPECIFIES DSECT NAME WHEN REFRESHABLE CODE IS NEEDED     * 00140000
.*     (USE AFTER DEFINITION FOR THAT DSECT)                          * 00150000
.*                                                                    * 00160000
.*     WHEN USED WITH SCALE=(REG), THE REGISTER MAY BE ANY FLOATING   * 00170000
.*     POINT REGISTER, BUT IF REGISTER 0, MUST BE WRITTEN AS (0) OR   * 00180000
.*     (R0). THIS USAGE REQUIRES  LE REG,=E'MAXVAL'/BAS R14,RANDOM    * 00190000
.*     FOR ALL CALLS.                                                 * 00200000
.*--------------------------------------------------------------------* 00210000
         LCLC  &MYSECT,&FPR                                     GP03358 00220000
&MYSECT  SETC  '&SYSECT'                                        GP03358 00230000
&FPR     SETC  'R0'          USE FLOATING POINT REGISTER 0      GP03358 00240000
         AIF   ('&SCALE' EQ '').NOFREG                          GP03358 00250000
         AIF   ('&SCALE'(1,1) NE '(').NOFREG                    GP03358 00260000
         AIF   ('&SCALE' EQ '(0)').DOFREG                       GP03358 00270000
         AIF   ('&SCALE' EQ '(R0)').DOFREG                      GP03358 00280000
         AIF   ('&SCALE' EQ '(FR0)').DOFREG                     GP03358 00290000
         AIF   ('&SCALE' EQ '(FPR0)').DOFREG                    GP03358 00300000
         AGO   .NOFREG                                          GP03358 00310000
.DOFREG  ANOP  ,                                                GP03358 00320000
&FPR     SETC  'R6'          USE FLOATING POINT REGISTER 6      GP03358 00330000
.NOFREG  AIF   (NOT &MVSESA).OLDSV                              GP03358 00340000
RANDOM   MACPARM (&R),(0),OP=BAKR,OPR=BAKR                      GP03358 00350000
         MACPARM (R15),(R1),RANDSAVE,MODE=THREE,OP=STM,OPR=STM  GP03358 00360000
         AGO   .COMSV                                           GP04234 00370000
.OLDSV   ANOP  ,                                                GP04234 00380000
RANDOM   MACPARM (R14),(R1),RANDSAVD,MODE=THREE,OP=STM,OPR=STM  GP04234 00390000
.COMSV   ICM   R1,15,RANDAU  CALLED BEFORE ?                    GP03358 00400000
         BNZ   RANDOLD                                          GP03358 00410000
         TIME  BIN                                                      00420000
         AR    R1,R0                                                    00430000
         N     R1,=X'3FFFFFFF'                                  GP03358 00440000
         LA    R0,1                                                     00450000
         OR    R1,R0                                                    00460000
RANDOLD  M     R0,=F'13187'  WAS X'0001000D'                    GP03358 00470000
         SRL   R1,8          KILL SIGN AND SOME                 GP03358 00480000
         ST    R1,RANDAU     TEMP                               GP03358 00490000
         ST    R1,RANDSAV0   TEMP                               GP03358 00500000
         MVI   RANDSAV0,X'40' SET EXPONENT                      GP03358 00510000
         LE    &FPR,RANDSAV0                                    GP03358 00520000
         AIF   ('&SCALE' EQ '').NOSCALE                         GP03358 00530000
         AIF   (T'&SCALE NE 'N').VAR                            GP03358 00540000
         MACPARM &FPR,=E'&SCALE',OP=ME,OPR=MER                  GP03358 00550000
         AGO   .NOSCALE                                         GP03358 00560000
.VAR     MACPARM &FPR,&SCALE,OP=ME,OPR=MER                      GP03358 00570000
.NOSCALE ANOP  ,                                                        00580000
         AU    &FPR,=X'46000000' POSITION AS INTEGER            GP03358 00590000
         STE   &FPR,RANDSAV0                                            00600000
         MVI   RANDSAV0,0    KILL EXPONENT                              00610000
         AIF   (NOT &MVSESA).OLDRS                              GP04234 00620000
         LM    R15,R1,RANDSAVE                                  GP03358 00630000
         PR    ,             ANSWER IN (0)                      GP03358 00640000
         AGO   .COMRS                                           GP04234 00650000
.OLDRS   LM    R14,R1,RANDSAVD                                  GP04234 00660000
         BR    &R            RETURN ANSWER IN R0                GP04234 00670000
.COMRS   SPACE 1                                                GP03358 00680000
         AIF   ('&SECT' EQ '').NORENT                           GP03358 00690000
&SECT    DSECT ,             REFRESHABLE (ZEROED INITIALLY)     GP03358 00700000
.NORENT  ANOP  ,                                                GP03358 00710000
RANDAU   DC    D'0'                                             GP03358 00720000
RANDSAVD DC    F'0'   0/2    SAVE 14                            GP04234 00730000
RANDSAVE DC    F'0'   1/2    SAVE 15                             *TSM*  00740000
RANDSAV0 DC    2F'0'  2/2    SAVE 0,1                            *TSM*  00750000
         AIF   ('&SECT' EQ '').NOREFR                           GP03358 00760000
&MYSECT  CSECT ,             RESTORE USER'S SECTION             GP03358 00770000
.NOREFR  ANOP  ,                                                GP03358 00780000
         MEND  ,                                                        00790000
./ ADD NAME=#RDR
         MACRO ,                                                        00010000
&NM      #RDR  &AD,&TYPE=GET,&DEV=0,&OPT=                               00020000
         GBLB  &ZZ#RDRF                                                 00030000
         GBLC  &MACPLAB,&ZZ#RDRN(10),&ZZ#RDRI(10)                       00040000
.********************************************************************** 00050000
.*                                                                    * 00060000
.*   #RDR GENERATES CALLS TO SUBROUTINE SUBRDR FOR READING UP TO      * 00070000
.*   EIGHT OPEN INPUT STREAMS (DEV=1 OR DEV=(3,7)...                  * 00080000
.*                                                                    * 00090000
.*   INPUT DDs ARE ASSOCIATED WITH #RDRWRK MACROS                     * 00100000
.*                                                                    * 00110000
.********************************************************************** 00120000
         LCLA  &I,&J,&K,&N                                              00130000
         LCLB  &B0,&B1,&B2,&B3,&B4,&B5,&B6,&B7                          00140000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                          00150000
         LCLC  &PT,&PD,&M,&DV,&FN,&C                                    00160000
&MACPLAB SETC  '&NM'                                                    00170000
&M       SETC  '&SYSNDX'                                                00180000
&DV      SETC  '&DEV'                                                   00190000
&FN      SETC  '0'                                                      00200000
         AIF   (T'&DEV NE 'O').DEVNUMT                                  00210000
         AIF   ('&TYPE' NE 'CLOSE').DEVNUMT                             00220000
&DV      SETC  '255'         CLOSE ALL                                  00230000
         AGO   .DEVASIS                                                 00240000
.DEVNUMT AIF   (T'&DEV EQ 'N').DEVASIS                                  00250000
         AIF   (N'&DEV EQ 1).DEVASIS                                    00260000
&N       SETA  0                                                        00270000
.DEVLOOP AIF   (&J GE N'&DEV).DEVDONE                                   00280000
&J       SETA  &J+1                                                     00290000
&C       SETC  '&DEV(&J)'                                               00300000
         AIF   ('&C' EQ '').DEVLOOP                                     00310000
         AIF   ('&C' GE '1' OR '&C' LE '8').DEVOK                       00320000
         MNOTE 8,'#RDR: DEV=&C UNACCEPTABLE'                            00330000
         AGO   .DEVLOOP                                                 00340000
.DEVOK   ANOP  ,                                                        00350000
&N       SETA  &N+1                                                     00360000
&B0      SETB  (&B0 OR ('&C' EQ '8'))                                   00370000
&B1      SETB  (&B1 OR ('&C' EQ '7'))                                   00380000
&B2      SETB  (&B2 OR ('&C' EQ '6'))                                   00390000
&B3      SETB  (&B3 OR ('&C' EQ '5'))                                   00400000
&B4      SETB  (&B4 OR ('&C' EQ '4'))                                   00410000
&B5      SETB  (&B5 OR ('&C' EQ '3'))                                   00420000
&B6      SETB  (&B6 OR ('&C' EQ '2'))                                   00430000
&B7      SETB  (&B7 OR ('&C' EQ '1'))                                   00440000
         AGO   .DEVLOOP                                                 00450000
.*                                                                      00460000
.DEVDONE AIF   (&N EQ (&B0+&B1+&B2+&B3+&B4+&B5+&B6+&B7)).DOVDON         00470000
         MNOTE 4,'#RDR: ERROR IN DEV= PARAMETER'                        00480000
.DOVDON  ANOP  ,                                                        00490000
&N       SETA  (128*&B0+64*&B1+32*&B2+16*&B3+8*&B4+4*&B5+2*&B6+&B7)     00500000
&DV      SETC  '&N'                                                     00510000
.DEVASIS AIF   (&ZZ#RDRF).NOT1ST                                        00520000
&ZZ#RDRN(01) SETC 'GET'                                                 00530000
&ZZ#RDRI(01) SETC '0'                                                   00540000
&ZZ#RDRN(02) SETC 'READ'                                                00550000
&ZZ#RDRI(02) SETC '0'                                                   00560000
&ZZ#RDRN(03) SETC 'KEEP'                                                00570000
&ZZ#RDRI(03) SETC '1'                                                   00580000
&ZZ#RDRN(04) SETC 'OPEN'                                                00590000
&ZZ#RDRI(04) SETC '2'                                                   00600000
&ZZ#RDRN(05) SETC 'CLOSE'                                               00610000
&ZZ#RDRI(05) SETC '3'                                                   00620000
&ZZ#RDRN(06) SETC 'REREAD'                                              00630000
&ZZ#RDRI(06) SETC '1'                                                   00640000
&ZZ#RDRF SETB  1             FIRST TIME STUFF DONE                      00650000
.NOT1ST  AIF   (T'&OPT EQ 'O').DONEFUN                                  00660000
&J       SETA  0                                                        00670000
&N       SETA  0                                                        00680000
.LOOPFUN AIF   (&J GE N'&OPT).SETFUN                                    00690000
&J       SETA  &J+1                                                     00700000
&C       SETC  '&OPT(&J)'                                               00710000
         AIF   ('&C' EQ '').LOOPFUN                                     00720000
&N       SETA  &N+1                                                     00730000
&F1      SETB  (&F0 OR ('&C' EQ 'DUMP'))                                00740000
&F0      SETB  (&F0 OR ('&C' EQ 'NOCC'))                                00750000
&F1      SETB  (&F0 OR ('&C' EQ 'ABEND'))                               00760000
&F7      SETB  (&F7 OR ('&C' EQ 'NOWTO'))                               00770000
         AGO   .LOOPFUN                                                 00780000
.SETFUN  AIF   (&N EQ (&F0+&F1+&F2+&F3+&F4+&F5+&F6+&F7)).SATFUN         00790000
         MNOTE 4,'#RDR: ERROR IN OPT= PARAMETER'                        00800000
.SATFUN  ANOP  ,                                                        00810000
&N       SETA  (128*&F0+64*&F1+32*&F2+16*&F3+8*&F4+4*&F5+2*&F6+&F7)     00820000
&FN      SETC  '&N'                                                     00830000
.DONEFUN AIF   (T'&AD NE 'O').HAVEAD                                    00840000
         AIF   ('&TYPE' NE 'OPEN').HAVEAD                               00850000
         MNOTE 8,'#RDR: FIRST OPERAND REQUIRED (ADDR/TEXT/RDRWRK)'      00860000
         MEXIT ,                                                        00870000
.HAVEAD  AIF   (&I GE 6).BADTYPE                                        00880000
&I       SETA  &I+1                                                     00890000
         AIF   ('&TYPE' NE '&ZZ#RDRN(&I)').HAVEAD                       00900000
&PT      SETC  '&ZZ#RDRI(&I)'                                           00910000
         AGO   .HAVTYPE                                                 00920000
.BADTYPE MNOTE 8,'#RDR: TYPE=&TYPE INVALID'                             00930000
         MEXIT ,                                                        00940000
.*                                                                      00950000
.HAVTYPE AIF   ('&FN' NE '0').HAVTYPF                                   00960000
         MACPARM R0,256*&PT+&DV                                         00970000
         AGO   .HAVTYPA                                                 00980000
.HAVTYPF MACPARM R0,=AL1(&FN,0,&PT,&DV),OP=L                            00990000
.HAVTYPA MACPARM R1,&AD,NULL=SKIP     GET STORAGE ADDRESS               01000000
         MACPARM R15,=V(SUBRDR),OP=L    GET SUBROUTINE ADDRESS          01010000
         MACPARM R14,R15,OP=BALR,OPR=BALR  CALL SUBROUTINE              01020000
.MEND    MEND ,                                                         01030000
./ ADD NAME=#RDRWRK
         MACRO ,                                                        00010000
&NM      #RDRWRK  &DDNAME=SYSIN,&PFX=RD1,&FLAGS=0,&EODAD=0,            *00020000
               &WIDTH=0,&FILL=C' '                                      00030000
.*  This macro defines work space for one input file. The definition    00040000
.*     is used with the #RDR macro and the SUBRDR subroutine.           00050000
.*                                                                      00060000
.*  A unique DDNAME is required, and a unique prefix. Only eight        00070000
.*   concurrent input files are supported, and it is suggested to use   00080000
.*   prefixes of RD1 to RD8 for convenience.  The name of this work     00090000
.*   area (invocation name field) must be placed into the @RDRWORK      00100000
.*   list at this file number's offset using a #RDR TYPE=OPEN call.     00110000
.*                                                                      00120000
.*  FLAGS should be set (with the appropriate prefix):                  00130000
.*     =pr1xxxxx - none as yet                                          00140000
.*  WIDTH=0    requests locate mode. TYPE=GET will return the address   00150000
.*              (R1) and length (R0) of the input record.               00160000
.*  WIDTH>0    will truncate/expand the record in rd1REC DEFInED IN     00170000
.*              this macRo.                                             00180000
.*                                                                      00190000
.*  FILL=   self-defining character - sets the fill character for short 00200000
.*     records copied in move mode (WIDTH>0)                            00210000
.*                                                                      00220000
&NM      DS    0D            WORK AREA FOR PRINTER &PFX (PRT#)          00230000
&PFX.EODAD DC  A(&EODAD)     OPTIONAL END FILE BRANCH ADDRESS           00240000
&PFX.REC@  DC  A(0)          ADDRESS OF INPUT RECORD                    00250000
&PFX.REC#  DC  F'0'          LENGTH OF INPUT RECORD                     00260000
         DC    3A(0)           RESERVED FOR FUTURE EXPANSION            00270000
         SPACE 1                                                        00280000
&PFX.DCB DCB   DDNAME=&DDNAME,DSORG=PS,MACRF=GL RDREXLST RDREODAD       00290000
&PFX.WIDTH DC  Y(&WIDTH)     MAXIMUM TEXT WIDTH                         00300000
&PFX.FLAGS DC  AL1(&FLAGS)   PROCESSING FLAGS                           00310000
&PFX.FILL  DC  AL1(&FILL)    PADDING CHARACTER                          00320000
&PFX.RDW   DC  Y(5,0)        RECORD DESCRIPTOR FOR RECFM=V              00330000
&PFX.TEXT  DC  CL(1+&WIDTH)' ' DATA RECORD                              00340000
         DC    4X'00'          RESERVED                                 00350000
         MEND  ,                                                        00360000
./ ADD NAME=READFDR
         MACRO ,                                                        00010000
&NM      READFDR &TYPE,&OPERAND,&USE=                   ADDED ON 82248  00020000
         GBLC  &MACPLAB                                                 00030000
.*                                                                      00040000
.*   This macro is used for reading FDR dump tapes, in conjunction      00050000
.*   with the @FDRREAD service routine. The current version requires    00060000
.*   authorization to diddle the DEB.                                   00070000
.*                                                                      00080000
.*   Used by COPYFDR program, and the @OBTAINS and @VOLREAD routines.   00090000
.*                                                                      00100000
         LCLA  &I,&J                                                    00110000
&MACPLAB SETC  '&NM'                                                    00120000
&I       SETA  0                                                        00130000
         AIF   ('&TYPE' EQ 'CLOSE').CLOSE                               00140000
&I       SETA  1                                                        00150000
         AIF   ('&TYPE' EQ 'TCLOSE').CLOSE                              00160000
&I       SETA  2                                                        00170000
         AIF   ('&TYPE' EQ 'OPEN').CHKUSE                               00180000
&I       SETA  3                                                        00190000
         AIF   ('&TYPE' EQ 'READ').TEST1                                00200000
&I       SETA  4                                                        00210000
         AIF   ('&TYPE' EQ 'NEXT').TEST1                                00220000
&I       SETA  5                                                GP13222 00230000
         AIF   ('&TYPE' EQ 'TRACK').TEST1                       GP13222 00240000
         AIF   ('&TYPE' EQ 'RDM').TEST1                         GP13222 00250000
&I       SETA  6                                                GP13222 00260000
         AIF   ('&TYPE' EQ 'MORE').TEST1                        GP13222 00270000
         AIF   ('&TYPE' EQ 'LOAD' OR '&TYPE' EQ 'INIT').INIT            00280000
         MNOTE 8,'TYPE OPERAND REQUIRED'                                00290000
         MEXIT ,                                                        00300000
.INIT    ANOP  ,                                                        00310000
&I       SETA  &SYSNDX                                                  00320000
&NM      ICM   R15,7,@FDRREAD+1   PRIOR LOAD ?                          00330000
         BNZ   VLR@&I                                                   00340000
         SERVCALL LPALD,=CL8'@FDRREAD'                                  00350000
         ST    R0,@FDRREAD                                              00360000
VLR@&I   DS    0H                                                       00370000
         MEXIT ,                                                        00380000
.TEST1   AIF   (T'&OPERAND EQ 'O').CLOSE                                00390000
         AGO   .LR1                                                     00400000
.CHKUSE  AIF   (T'&USE EQ 'O').LOAD1                                    00410000
&J       SETA  128                                                      00420000
         AIF   ('&USE' EQ 'VTOC').LOAD1                                 00430000
&J       SETA  0                                                        00440000
         MNOTE 4,'INVALID USE PARAMETER &USE'                           00450000
.LOAD1   AIF   (T'&OPERAND NE 'O').LR1                                  00460000
         MNOTE 8,'FUNCTION &TYPE REQUIRES AN OPERAND'                   00470000
         MEXIT ,                                                        00480000
.LR1     MACPARM R1,&OPERAND,NULL=0                                     00490000
         AIF   (&J EQ 0).CLOSE                                          00500000
         ICM   R1,8,=AL1(&J)                                            00510000
.CLOSE   MACPARM R0,&I                                                  00520000
.BAL     ANOP  ,                                                        00530000
&MACPLAB L     R15,@FDRREAD                                             00540000
         BASR  R14,R15                                                  00550000
&MACPLAB SETC  ''                                                       00560000
         MEND  ,                                                        00570000
./ ADD NAME=READTMC
         MACRO ,                                                        00010000
&NM      READTMC &FUN,&PARM,&BUFNO=,&TEST=,&EXT=NO    UPDATED ON 81173  00020000
         GBLC  &MACPLAB                                                 00030000
         GBLB  &TMC@EXT                                          81173  00040000
         LCLA  &I                                                       00050000
&MACPLAB SETC  '&NM'         INIT LABEL                                 00060000
         AIF   ('&EXT' EQ 'NO').NTEXT                            81173  00070000
&TMC@EXT SETB  1                                                 81173  00080000
.NTEXT   AIF   ('&FUN' NE '').HAVEFUN                            81173  00090000
         MNOTE 8,'***** FUNCTION REQUIRED : OPEN/CLOSE/VOL/DSN'         00100000
         MEXIT ,                                                        00110000
.HAVEFUN AIF   ('&FUN' EQ 'OPEN' OR '&BUFNO' EQ '').BUFOK               00120000
         MNOTE 0,'***** BUFNO VALID FOR ''OPEN'' ONLY; IGNORED'         00130000
.BUFOK   AIF   ('&FUN' EQ 'CLOSE').DOC2                                 00140000
&I       SETA  1                                                        00150000
         AIF   ('&FUN' EQ 'OPEN').DOC0                                  00160000
&I       SETA  2                                                        00170000
         AIF   ('&FUN' EQ 'VOL').DOC0                            93025  00180000
&I       SETA  3                                                        00190000
         AIF   ('&FUN' EQ 'DSN' OR '&FUN' EQ 'DSNB').DOC0               00200000
&I       SETA  4                                                 93025  00210000
         AIF   ('&FUN' EQ 'TMC' OR '&FUN' EQ 'RAW').DOC0         93025  00220000
         MNOTE 8,'***** FUNCTION &FUN INVALID; USE OPEN/CLOSE/VOL/DSN'  00230000
         MEXIT ,                                                        00240000
.DOC0    AIF   ('&PARM' EQ '').ZR1                                      00250000
         MACPARM R1,&PARM    LOAD BUFFER ADDRESS (BXLE FOR OPEN)        00260000
         AGO   .DOC1                                                    00270000
.ZR1     MACPARM R1,0        CLEAR R1 (LOCATE MODE)                     00280000
.DOC1    AIF   (&I NE 1).DOC2                                           00290000
         AIF   ('&BUFNO' EQ '' OR '&BUFNO' EQ '0').DOC2                 00300000
&MACPLAB ICM   R1,8,=AL1(&BUFNO)  LOAD NO. OF BUFFERS                   00310000
&MACPLAB SETC  ''                                                       00320000
.DOC2    MACPARM R0,&I       SET FUNCTION CODE                          00330000
         AIF   (&TMC@EXT).DOEXT                                  81173  00340000
&MACPLAB L     R15,=V(@TMSREAD)                                         00350000
         AGO   .EXTCOM                                           81173  00360000
.DOEXT   ANOP  ,                                                 81173  00370000
&MACPLAB L     R15,@TMSREAD                                             00380000
.EXTCOM  BALR  R14,R15                                           81173  00390000
         AIF   ('&TEST' EQ '' OR '&TEST' EQ 'NO').MEND                  00400000
         CH    R15,=H'4'     TEST RETURN CODE                           00410000
.MEND    MEND  ,                                                        00420000
./ ADD NAME=REGEQU
         MACRO ,                                                        00010000
         REGEQU  ,                                                      00020000
         GBLA  &REGS                                                    00030000
         AIF   (&REGS EQ 1).MEND  ONLY EXPAND ONCE                      00040000
&REGS    SETA  1             MAINTAIN IBM COMPATIBILITY                 00050000
         LCLA  &I                                                       00060000
.LOUPE   AIF   (&I GT 15).MEND                                          00070000
R&I      EQU   &I                                                       00080000
&I       SETA  &I+1                                                     00090000
         AGO   .LOUPE                                                   00100000
.MEND    MEND                                                           00110000
./ ADD NAME=RET31
         MACRO ,                                                        00010000
&NM      RET31 &RET                                     ADDED ON 90308  00020000
.*                                                                      00030000
.*       THE MACRO NAME NOT-WITHSTANDING, THIS MACRO RETURNS WITH       00040000
.*       A BSM (IN XA) REGARDLESS OF CURRENT OR NEW MODE                00050000
.*                                                                      00060000
         GBLB  &MVSXA                                                   00070000
         AIF   (&MVSXA).BSM                                             00080000
&NM      MACPARM &RET,OP=BR,OPR=BR,MODE=ONE                             00090000
         MEXIT ,                                                        00100000
.BSM     ANOP  ,                                                        00110000
&NM      MACPARM 0,&RET,OP=BSM,OPR=BSM                                  00120000
         MEND  ,                                                        00130000
./ ADD NAME=RMODE
         MACRO ,                                                        00010000
         RMODE ,                                                        00020000
.*   DUMMY MACRO CREATED TO SUPPORT ASSEMBLY UNDFER HERCULES (XF ASM)   00030000
         MEND  ,                                                        00040000
./ ADD NAME=RP
         MACRO ,                                                        00010000
&NM      RP    &OP                                                      00020000
.*   PROVIDED TO ASSEMBLE OS/390 CODE UNDER OLDER SYSTEMS               00030000
&NM      DC    0H'0',X'B277',S(&OP)                                     00040000
         MEND  ,                                                        00050000
./ ADD NAME=RSECT
         MACRO ,                                                        00010000
&NM      RSECT ,             HERCULES SUPPORT             ADDED GP04234 00020000
&NM      CSECT ,                                                        00030000
         MEND  ,                                                        00040000
./ ADD NAME=S64D
         MACRO ,                                                        00010000
&NM      S64D  &CTR,&INC,&WK=R14                                        00020000
         GBLC  &MACPLAB                                                 00030000
.*  SUBTRACT A 64-BIT VALUE FROM A 64-BIT VALUE.                        00040000
.*  WK MUST BE AN EVEN REGISTER, AND NOT THE '(INC)' PAIR               00050000
.*  CTR MAY BE A DOUBLE-WORD STORAGE ADDRESS, OR AN EVEN REGISTER       00060000
.*  INC MAY BE A DOUBLE-WORD STORAGE ADDRESS, OR AN EVEN REGISTER       00070000
.*                                                   UPD 2013/05/01 GYP 00080000
         LCLA  &K                                                       00090000
         LCLB  &TOR,&FRO     ON IF REGISTER                             00100000
         LCLC  &N,&RE,&RO,&FE,&FO                                       00110000
&N       SETC  'ZZA'.'&SYSNDX'                                          00120000
&MACPLAB SETC  '&NM'                                                    00130000
         AIF   ('&CTR(1)' EQ '&WK').REGROUT                             00140000
&K       SETA  K'&CTR                                                   00150000
         AIF   (&K LT 3).NOTROUT                                        00160000
         AIF   ('&CTR'(1,1) NE '(').NOTROUT  POSSIBLE REGISTER SPEC?    00170000
         AIF   ('&CTR'(2,1) EQ '(').NOTROUT  EXPRESSION?                00180000
         AIF   ('&CTR'(&K,1) NE ')').NOTROUT  POSSIBLE REGISTER SPEC?   00190000
         AIF   ('&CTR'(&K-1,1) EQ ')').NOTROUT  EXPRESSION?             00200000
.REGROUT ANOP  ,                                                        00210000
&TOR     SETB  1                                                        00220000
&RE      SETC  '(&CTR(1))'                                              00230000
&RO      SETC  '(1+&CTR(1))'                                            00240000
.NOTROUT  ANOP  ,                                                       00250000
&RE      SETC  '&WK'                                                    00260000
&RO      SETC  '1+&WK'                                                  00270000
.LOOKINC ANOP  ,                                                        00280000
&K       SETA  K'&INC                                                   00290000
         AIF   (&K LT 3).NOTRINC                                        00300000
         AIF   ('&INC'(1,1) NE '(').NOTRINC  POSSIBLE REGISTER SPEC?    00310000
         AIF   ('&INC'(2,1) EQ '(').NOTRINC  EXPRESSION?                00320000
         AIF   ('&INC'(&K,1) NE ')').NOTRINC  POSSIBLE REGISTER SPEC?   00330000
         AIF   ('&INC'(&K-1,1) EQ ')').NOTRINC  EXPRESSION?             00340000
.REGRINC ANOP  ,                                                        00350000
&FRO     SETB  1                                                        00360000
&FE      SETC  '(&INC(1))'                                              00370000
&FO      SETC  '(1+&INC(1))'                                            00380000
         AGO   .PROCESS                                                 00390000
.NOTRINC ANOP  ,                                                        00400000
&FE      SETC  '&INC'                                                   00410000
&FO      SETC  '4+&INC'                                                 00420000
.PROCESS AIF   (&TOR).NOLM   OUTPUT IN REGS - SKIP LOAD                 00430000
         MACPARM &RE,&RO,&CTR,OP=LM,MODE=THREE                          00440000
.NOLM    MACPARM &RO,&FO,OP=SL,OPR=SLR                                  00450000
         MACPARM 3,&N.N,OP=BC   NO BORROW                               00460000
         MACPARM &RE,=F'1',OP=S    PROPAGATE CARRY                      00470000
&N.N     MACPARM &RE,&FE,OP=S,OPR=SR                                    00480000
         AIF   (&TOR).MEND                                              00490000
         MACPARM &RE,&RO,&CTR,OP=STM,MODE=THREE                         00500000
.MEND    MEND  ,                                                        00510000
./ ADD NAME=S64F
         MACRO ,                                                        00010000
&NM      S64F  &CTR,&INC,&WK=R14                                        00020000
         GBLC  &MACPLAB                                                 00030000
.*  SUBTRACT A 32-BIT VALUE FROM A 64-BIT VALUE.                        00040000
.*  WK MUST BE AN EVEN REGISTER, AND NOT THE '(INC)' REGISTER           00050000
.*  CTR MAY BE A DOUBLE-WORD STORAGE ADDRESS, OR AN EVEN REGISTER       00060000
.*  INC MAY BE A WORD STORAGE ADDRESS, OR ANY UNUSED REGISTER           00070000
.*                                                   UPD 2013/05/01 GYP 00080000
         LCLA  &K                                                       00090000
         LCLB  &TOR,&FRO     ON IF REGISTER                             00100000
         LCLC  &N,&RE,&RO,&FO                                           00110000
&N       SETC  'ZZA'.'&SYSNDX'                                          00120000
&MACPLAB SETC  '&NM'                                                    00130000
         AIF   ('&CTR(1)' EQ '&WK').REGROUT                             00140000
&K       SETA  K'&CTR                                                   00150000
         AIF   (&K LT 3).NOTROUT                                        00160000
         AIF   ('&CTR'(1,1) NE '(').NOTROUT  POSSIBLE REGISTER SPEC?    00170000
         AIF   ('&CTR'(2,1) EQ '(').NOTROUT  EXPRESSION?                00180000
         AIF   ('&CTR'(&K,1) NE ')').NOTROUT  POSSIBLE REGISTER SPEC?   00190000
         AIF   ('&CTR'(&K-1,1) EQ ')').NOTROUT  EXPRESSION?             00200000
.REGROUT ANOP  ,                                                        00210000
&TOR     SETB  1                                                        00220000
&RE      SETC  '(&CTR(1))'                                              00230000
&RO      SETC  '(1+&CTR(1))'                                            00240000
.NOTROUT  ANOP  ,                                                       00250000
&RE      SETC  '&WK'                                                    00260000
&RO      SETC  '1+&WK'                                                  00270000
.LOOKINC ANOP  ,                                                        00280000
&K       SETA  K'&INC                                                   00290000
         AIF   (&K LT 3).NOTRINC                                        00300000
         AIF   ('&INC'(1,1) NE '(').NOTRINC  POSSIBLE REGISTER SPEC?    00310000
         AIF   ('&INC'(2,1) EQ '(').NOTRINC  EXPRESSION?                00320000
         AIF   ('&INC'(&K,1) NE ')').NOTRINC  POSSIBLE REGISTER SPEC?   00330000
         AIF   ('&INC'(&K-1,1) EQ ')').NOTRINC  EXPRESSION?             00340000
.REGRINC ANOP  ,                                                        00350000
&FRO     SETB  1                                                        00360000
&FO      SETC  '(&INC(1))'                                              00370000
         AGO   .PROCESS                                                 00380000
.NOTRINC ANOP  ,                                                        00390000
&FO      SETC  '&INC'                                                   00400000
.PROCESS AIF   (&TOR).NOLM   OUTPUT IN REGS - SKIP LOAD                 00410000
         MACPARM &RE,&RO,&CTR,OP=LM,MODE=THREE                          00420000
.NOLM    MACPARM &RO,&FO,OP=AL,OPR=ALR                                  00430000
         MACPARM 3,*+4+4,OP=BC   NO CARRY                               00440000
         MACPARM &RE,=F'1',OP=S     PROPAGATE CARRY                     00450000
         AIF   (&TOR).MEND                                              00460000
         MACPARM &RE,&RO,&CTR,OP=STM,MODE=THREE                         00470000
.MEND    MACPARM MODE=LBL                                               00480000
         MEND  ,                                                        00490000
./ ADD NAME=S99FAIL
         MACRO                                                          00310600
&NAME    S99FAIL &RB=(R14),&RC=(R15),&CPPL=,&MF=G,&CP=                  00310700
         GBLB  &RCPCPPL(2)             CP INDICATOR                     00310800
         GBLC  &RCPPRE                                                  00310900
         LCLB  &GEN                                                     00311000
         LCLC  &C                                                       00311100
&NAME    DS    0H                                                       00311200
         AIF   ('&MF(1)' EQ 'G').GEN                                    00311300
         AIF   ('&MF(1)' EQ 'E').EXEC                                   00311400
         MNOTE 4,'&MF(1) IS AN INVALID MF, MF=G USED'                   00311500
.GEN     LA    R1,FAIL&SYSNDX     LOAD PLIST ADDRESS                    00311600
&GEN     SETB  1                                                        00311700
         AGO   .L                                                       00311800
.EXEC    AIF   ('&MF(2)' NE '').LISTOK                                  00311900
         MNOTE 8,'LIST ADDRESS NOT SPECIFIED'                           00312000
         MEXIT                                                          00312100
.LISTOK  AIF   ('&MF(3)' EQ '').TMF2                                    00312200
&MF(3)   EQU   24                      LENGTH OF PARAMETER LIST         00312300
.TMF2    AIF   ('&MF(2)' EQ '(R1)' OR '&MF(2)' EQ '(1)').L              00312400
         AIF   ('&MF(2)'(1,1) EQ '(').REG                               00312500
         LA    R1,&MF(2)          LOAD DAIRFAIL PARAM LIST ADDRESS      00312600
         AGO   .L                                                       00312700
.REG     ANOP                                                           00312800
&C       SETC  '&MF(2)'(2,K'&MF(2)-2)                                   00312900
         LR    R1,&C              LOAD DAIRFAIL PARAM LIST ADDR         00313000
.L       AIF   ('&RB'(1,1) EQ '(').RBR                                  00313100
         AIF   ('&RB' NE '').RBA                                        00313200
         MNOTE 8,'REQ BLOCK ADDRESS NOT SPECIFIED'                      00313300
         MEXIT                                                          00313400
.RBR     ST    &RB(1),0(R1)       STORE S99 RB ADDRESS                  00313500
         AGO   .RC                                                      00313600
.RBA     LA    R14,&RB            LOAD ADDRESS OF REQ BLOCK             00313700
         ST    R14,0(R1)          AND STORE IN PLIST                    00313800
.RC      AIF   ('&RC'(1,1) EQ '(').RCR                                  00313900
         LA    R14,&RC            LOAD ADDRESS OF RET CODE              00314000
         ST    R14,4(R1)          AND STORE IN PLIST                    00314100
         AGO   .EFF02                                                   00314200
.RCR     ANOP                                                           00314300
.GRC     LA    R14,20(R1)         LOAD ADDR RET CODE FLD                00314400
         ST    &RC(1),0(R14)      STORE RET CODE                        00314500
         ST    R14,4(R1)          AND STORE ITS ADDRESS                 00314600
.EFF02   LA    R14,=A(0)          LOAD ADDR OF FULLWORD OF 0            00314700
         ST    R14,8(R1)          STORE IT.                             00314800
         AIF   ('&CP' EQ 'YES' OR &RCPCPPL(1)).CPID                     00314900
         LA    R14,=X'8032'       LOAD ADDRESS OF CALLERID              00315000
         ST    R14,12(R1)          AND STORE IT                         00315100
         XC    16(4,R1),16(R1)    CLEAR CPPL POINTER                    00315200
         AGO   .GO                                                      00315300
.CPID    LA    R14,=Y(50)         LOAD ADDRESS OF CALLERID              00315400
         ST    R14,12(R1)         AND STORE IT                          00315500
         AIF   ('&CPPL' EQ '').DCPPL                                    00315600
         AIF   ('&CPPL'(1,1) EQ '(').RCPPL                              00315700
         LA    R14,&CPPL          LOAD CPPL ADDRESS                     00315800
         ST    R14,16(R1)          AND STORE IT                         00315900
         AGO   .GO                                                      00316000
.DCPPL   MVC   16(4,R1),&RCPPRE.CPPL MOVE IN CPPL ADDRESS               00316100
         AGO   .GO                                                      00316200
.RCPPL   ST    &CPPL(1),16(R1)    STORE ADDRESS OF CPPL                 00316300
.GO      LINK  EP=IKJEFF18                                              00316400
         AIF   (NOT &GEN).EXIT                                          00316500
         SPACE 1                                                        00316600
         RCPDS                                                          00316700
&C SETC 'FAIL&SYSNDX'                                                   00316800
&C       DS    6F             RESERVE SPACE FOR PARAM LIST              00316900
         RCPDS                                                          00317000
.EXIT    MEND                                                           00317100
./ ADD NAME=SAC
         MACRO ,                                                        00010000
&NM      SAC   &R                                       ADDED ON 04234  00020000
.*                                                                      00030000
.*    HERCULES MVS 3.8 SUPPORT                                          00040000
.*                                                                      00050000
&NM      MACPARM MODE=LBL                                               00060000
         MEND  ,                                                        00070000
./ ADD NAME=SAVEM
         MACRO ,                                                        00010000
&L       SAVEM &DUMMY,&PFX=SAVE,&END=,&ENDZERO=,&DSECT=,&PARM=R11,     *00020000
               &SAVE=*,                                          81208 *00030000
               &BASE=R12,&BASE2=,&BASE3=,&BASE4=,&BASED=*,             *00040000
               &EID=SHORT,&ENTRY=,&ENTNO=,                             *00050000
               &RIGHT=,                                                *00060000
               &ID=*,&DATE=,&SP=0,&BNDRY=                        82002  00070000
.********************************************************************** 00080000
.*                                                                      00090000
.*             COPYRIGHT 1978 BY SHMUEL (SEYMOUR J.) METZ               00100000
.*                        ALL RIGHTS RESERVED.                          00110000
.*                                                                      00120000
.*             THIS MACRO IS NOT TO BE DISTRIBUTED WITHOUT PERMISSION,  00130000
.*             AS DESCRIBED IN MEMBER $$RIGHTS.                         00140000
.*                                                                      00150000
.*       FOR SIMPLE ENTRIES, PARM=R1 NOW RELOADS R0 AND R1       87223  00160000
.*       BASE=(B1,B2,B3,B4) SUPPORT ADDED (EASIER TO USE?)       87223  00170000
.*                                                               87223  00180000
.********************************************************************** 00190000
         COPY  OPTIONGB                                                 00200000
         GBLB  &DROP@1                                           81163  00210000
         GBLB  &MAPONCE                                                 00220000
         GBLB  &SAV@REG                                                 00230000
         GBLB  &SAV@DYN(10)                                             00240000
         GBLC  &SAV@NAM(10)                                             00250000
         GBLC  &MACPLAB                                          81154  00260000
         GBLC  &SYSSPLV      VERSION OF SP (1, 2...)             93174  00270000
         LCLA  &I,&J,&N,&NUMENT                                         00280000
         LCLB  &BWOPT,&Y           BIGWORK  OPTION                      00290000
         LCLB  &HWOPT              HUGEWORK OPTION ( > 32767 )   84307  00300000
         LCLB  &CME                BASED/ENTRY PRESENT           81163  00310000
         LCLB  &CPYREGS            CPYREGS  OPTION                      00320000
         LCLB  &DSOPT              NODSECT  OPTION                      00330000
         LCLB  &EQUOPT             NOEQU    OPTION                      00340000
         LCLB  &NOENTRY            NOENTRY  OPTION                      00350000
         LCLB  &NOSAVE             NOSAVE   OPTION                      00360000
         LCLB  &NWOPT              NOWORK   OPTION                      00370000
         LCLB  &OLDSAVE            OLDSAVE  OPTION                      00380000
         LCLB  &BUMASM             ASM DOESN'T SUPPORT LONG SETC        00390000
         LCLB  &BZOPT              ZERO > 256                           00400000
         LCLB  &NOT1ST             NOT FIRST USE OF &PFX                00410000
         LCLB  &ZERO               ZERO     OPTION                      00420000
         LCLB  &ZERO8              ZERO     <= 256               81202  00430000
         LCLB  &ZERO12             ZERO     >  256               81202  00440000
         LCLB  &ZERO15             ZERO     > 4095               81208  00450000
         LCLB  &ZERO31             ZERO     > 32767              84307  00460000
         LCLC  &B@                 GENERATED LABEL FOR B TARGET         00470000
         LCLC  &CMB                COMMON BASE NAME              81163  00480000
         LCLC  &CMU                BASE REG. STRING FOR USING    81163  00490000
         LCLC  &C9                 TEST FOR LONG SETC SUPPORT           00500000
         LCLC  &DSCTG              DSECT NAME                    81208  00510000
         LCLC  &ENDG               END LABEL FOR GETMAINED AREA  81208  00520000
         LCLC  &ENDZ               END OF ZEROED AREA            81208  00530000
         LCLC  &LAB                LABEL FOR ENTRY POINT                00540000
         LCLC  &LQ                 L'                                   00550000
         LCLC  &N@                 GENERATED NAME FOR DC                00560000
         LCLC  &SECT               CSECT NAME                           00570000
         LCLC  &SP@                SUBPOOL FOR GETMAIN                  00580000
         LCLC  &NAME               NAME FOR CONSTRUCTED ID              00590000
         LCLC  &SV                 SAVE AREA PREFIX              81208  00600000
         LCLC  &BEGZ         WHERE TO START ZEROING (FWD DEFAULT)       00610000
         LCLC  &PARMEXP                                                 00620000
         LCLC  &PARMREG                                                 00630000
         LCLC  &CASE,&CASE2,&CASE3,&CASE4   LOCAL BASES          87223  00640000
       SYSPARM ,                   SET GLOBALS                          00650000
&C9      SETC  '*********'                                              00660000
&SECT    SETC  '&SYSECT'                                                00670000
&SV      SETC  '&PFX'                                                   00680000
&DSCTG   SETC  '&PFX'                                                   00690000
&ENDG    SETC  '&PFX'.'ND'                                              00700000
&BEGZ    SETC  '&PFX'.'FWD'        ZERO BEGINNING AT FWD LINK    94272  00710000
.*                                                                      00720000
         AIF   ('&C9' EQ '*********').ASMVS                             00730000
         MNOTE 4,'USE THE OS/VS-DOS/VS-CMS ASSEMBLER,'                  00740000
         MNOTE 4,'OR USE ASMG WITH LSETC=80'                            00750000
&BUMASM  SETB  1                                                        00760000
.*                                                                      00770000
.ASMVS   AIF   ('&DSECT' EQ '').DSGOK                                   00780000
&DSCTG   SETC  '&DSECT'                                                 00790000
.DSGOK   AIF   ('&END' EQ '').ENDGOK                                    00800000
&ENDG    SETC  '&END'                                                   00810000
.ENDGOK  ANOP                                                           00820000
.*                                                                      00830000
&N       SETA  1                                                        00840000
.NXTSLOT ANOP                                                           00850000
&NOT1ST  SETB  (&NOT1ST OR ('&PFX' EQ '&SAV@NAM(&N)'))                  00860000
         AIF   (&NOT1ST).FND1ST                                         00870000
         AIF   ('&SAV@NAM(&N)' EQ '').FNDSLOT                           00880000
&N       SETA  &N+1                                                     00890000
         AIF   (&N LE 10).NXTSLOT                                       00900000
         MNOTE 12,'TOO MANY SAVEM DSECTS'                               00910000
         MEXIT                                                          00920000
.FNDSLOT ANOP                                                           00930000
&SAV@NAM(&N) SETC '&PFX'                                                00940000
.*                                                                      00950000
.FND1ST  AIF   ('&SYSECT' EQ '' AND T'&L EQ 'O').NOL                    00960000
&I       SETA  1                                                        00970000
         AIF   (N'&SYSLIST EQ 0).ENDOPT                                 00980000
.*                                                                      00990000
.LOOP    AIF   ('&SYSLIST(&I)' EQ 'CPYREGS').CPYREGS                    01000000
         AIF   ('&SYSLIST(&I)' EQ 'COPYREGS').CPYREGS            81154  01010000
         AIF   ('&SYSLIST(&I)' EQ 'COPYREGISTERS').CPYREGS              01020000
         AIF   ('&SYSLIST(&I)' EQ 'NODSECT').NODSECT                    01030000
         AIF   ('&SYSLIST(&I)' EQ 'NOEQU').NOEQU                        01040000
         AIF   ('&SYSLIST(&I)' EQ 'BIGWORK').BIGWORK                    01050000
         AIF   ('&SYSLIST(&I)' EQ 'HUGEWORK').HUGWORK            84307  01060000
         AIF   ('&SYSLIST(&I)' EQ 'BIGZERO').BIGZERO                    01070000
         AIF   ('&SYSLIST(&I)' EQ 'HUGEZERO').ZERO31             84307  01080000
         AIF   ('&SYSLIST(&I)' EQ 'NOWORK').NOWORK                      01090000
         AIF   ('&SYSLIST(&I)' EQ 'NOSAVE').NOSAVE1                     01100000
         AIF   ('&SYSLIST(&I)' EQ 'OLDSAVE').OLDSAVE                    01110000
         AIF   ('&SYSLIST(&I)' EQ 'NOENTRY').NOENTRY                    01120000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO').ZERO                          01130000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO8').ZERO8                 81208  01140000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO12').ZERO12               81208  01150000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO15').ZERO15               81208  01160000
         AIF   ('&SYSLIST(&I)' EQ 'ZERO31').ZERO31               84307  01170000
         AIF   ('&SYSLIST(&I)' EQ '').NXTOPT                            01180000
         MNOTE 4,'''&SYSLIST(&I)'' IS AN INVALID OPTION - IGNORED'      01190000
         AGO   .NXTOPT                                                  01200000
.*                                                                      01210000
.NOL     MNOTE 12,'LABEL REQUIRED IF  NO  CSECT'                        01220000
         MEXIT                                                          01230000
.*                                                                      01240000
.CPYREGS ANOP                                                           01250000
&CPYREGS SETB  1                                                        01260000
         AGO   .NXTOPT                                                  01270000
.NODSECT ANOP                                                           01280000
&DSOPT   SETB  1                                                        01290000
         AGO   .NXTOPT                                                  01300000
.NOEQU   ANOP                                                           01310000
&EQUOPT  SETB  1                                                        01320000
         AGO   .NXTOPT                                                  01330000
.HUGWORK ANOP  ,                                                 84307  01340000
&HWOPT   SETB  1             SET FOR HUGE WORK AREA              84307  01350000
.BIGWORK ANOP                                                           01360000
&BWOPT   SETB  1                                                        01370000
&BZOPT   SETB  1                                                        01380000
         AGO   .NXTOPT                                                  01390000
.NOWORK  ANOP                                                           01400000
&NWOPT   SETB  1                                                        01410000
         AGO   .NXTOPT                                                  01420000
.NOSAVE1 ANOP                                                           01430000
&NOSAVE  SETB  1                                                        01440000
         AGO   .NXTOPT                                                  01450000
.OLDSAVE ANOP                                                           01460000
&OLDSAVE SETB  1                                                        01470000
         AGO   .NXTOPT                                                  01480000
.NOENTRY ANOP                                                           01490000
&NOENTRY SETB  1                                                        01500000
         AGO   .NXTOPT                                                  01510000
.*                                                               81208  01520000
.ZERO8   ANOP  ,                                                 81208  01530000
&ZERO8   SETB  1                                                 81208  01540000
         AGO   .ZERO                                             81208  01550000
.ZERO12  ANOP  ,                                                 81208  01560000
&ZERO12  SETB  1                                                 81218  01570000
         AGO   .ZERO                                             81208  01580000
.ZERO31  ANOP  ,                                                 84307  01590000
&HWOPT   SETB  1             HUGE WORK AREA > 32767              84307  01600000
&ZERO31  SETB  1                                                 84307  01610000
.ZERO15  ANOP  ,                                                 81208  01620000
&ZERO15  SETB  1                                                 81208  01630000
&BWOPT   SETB  1                                                 81218  01640000
         AGO   .ZERO                                             81208  01650000
.BIGZERO ANOP                                                           01660000
&BZOPT   SETB  1                                                 81202  01670000
.ZERO    ANOP                                                           01680000
&ZERO    SETB  1                                                        01690000
.NXTOPT  ANOP                                                           01700000
&I       SETA  &I+1                                                     01710000
         AIF   (&I LE N'&SYSLIST).LOOP                                  01720000
.ENDOPT  AIF   (&ZERO8 OR &ZERO12 OR &ZERO15).GOTZERO            81208  01730000
&ZERO31  SETB  (&ZERO AND &HWOPT)                                84307  01740000
&ZERO15  SETB  (&ZERO AND &BWOPT)                                81208  01750000
&ZERO12  SETB  (&BZOPT AND NOT &ZERO15)                          81208  01760000
&ZERO8   SETB  (&ZERO AND NOT &ZERO12 AND NOT &ZERO15)           81202  01770000
.GOTZERO AIF   (T'&L EQ 'O').CSECTOK                             81208  01780000
         AIF   ('&SYSECT' EQ '' OR '&L' EQ '&SYSECT').LABOK      81202  01790000
&LAB     SETC  '&L'                                                     01800000
         AIF   (&NOENTRY).LABOK                                         01810000
         ENTRY &L                                                       01820000
.LABOK   AIF   ('&SYSECT' NE '').CSECTOK                                01830000
.*                                                                      01840000
&L       CSECT                                                          01850000
&SECT    SETC  '&L'                                                     01860000
.CSECTOK AIF   (T'&BASED EQ 'O' AND T'&ENTRY EQ 'O').NOCLAB      81163  01870000
         AIF   (T'&ENTRY NE 'O').DOCLAB                          81163  01880000
         AIF   ('&BASED' EQ '*').NOCLAB                          81163  01890000
.DOCLAB  ANOP  ,                                                 81163  01900000
&CME     SETB  1             SET SPECIAL BASE PROCESSING         81163  01910000
.NOCLAB  AIF   ('&LAB' NE '').OKCLAB                             81163  01920000
&LAB     SETC  'A@&SYSNDX'                                       81163  01930000
.OKCLAB  ANOP  ,                                                 81163  01940000
&CMB     SETC  '&LAB'        DEFAULT BASED VALUE                 81163  01950000
         AIF   (T'&BASED EQ 'O').CLABOK                          81163  01960000
         AIF   ('&BASED' EQ '*').CLABOK                          81163  01970000
         AIF   ('&BASED' NE '*SYSECT').CLABSET                   81163  01980000
         AIF   ('&SYSECT' EQ '').CLABOK   BOO                    81163  01990000
&CMB     SETC  '&SYSECT'                                         81163  02000000
         AGO   .CLABOK                                           81163  02010000
.CLABSET ANOP  ,                                                 81163  02020000
&CMB     SETC  '&BASED'                                          81163  02030000
.CLABOK  ANOP  ,                                                 81163  02040000
&CMU     SETC  'R15'         DEFAULT BASE REGISTER ON USING      81163  02050000
&SAV@DYN(&N) SETB (NOT &NOSAVE)                                         02060000
&PARMEXP SETC  '(R1)'                                                   02070000
&PARMREG SETC  '1'                                                      02080000
         AIF   ('&PARM' EQ '').PARM1                                    02090000
         AIF   (N'&PARM LT 2).PARM1                                     02100000
&PARMEXP SETC  '&PARM(2)'                                               02110000
         AIF   (NOT &OLDSAVE).PARM1                                     02120000
&PARMREG SETC  '&PARM(2)'                                               02130000
         AIF   ('&PARMEXP'(1,1) EQ '(').STRIP                           02140000
         MNOTE 8,'PARM=&PARM INVALID'                                   02150000
         MNOTE 8,'PARM=(&PARM(1),(&PARM(2)) ASSUMED'                    02160000
         AGO   .STRIPT                                                  02170000
.STRIP   AIF   ('&PARMEXP'(K'&PARMEXP,1) EQ ')').STRIP1                 02180000
         MNOTE 12,'PARM=&PARM INVALID'                                  02190000
         MEXIT ,                                                        02200000
.STRIP1  ANOP  ,                                                        02210000
&PARMREG SETC  '&PARMREG'(2,K'&PARMREG-2)                               02220000
.STRIPT  AIF   ('&PARMREG'(1,1) GE '0').PARM1                           02230000
&PARMREG SETC  '&PARMREG'(2,K'&PARMREG-1)                               02240000
.PARM1   AIF   (NOT &DROP@1).NODROP                              81163  02250000
         DROP  ,                                                 81163  02260000
.NODROP  ANOP  ,                                                 81163  02270000
&DROP@1  SETB  1                                                 81163  02280000
         AIF   (T'&BASE EQ 'O').OLDBASE                          87223  02290000
         AIF   (N'&BASE LT 2).OLDBASE                            87223  02300000
 AIF (T'&BASE2 EQ 'O' AND T'&BASE3 EQ 'O' AND T'&BASE4 EQ 'O').NEWBASE  02310000
         MNOTE 8,'CONFLICTING SPECIFICATION: BASE=(.,.) AND BASEn='     02320000
.NEWBASE ANOP  ,                                                 87223  02330000
&CASE    SETC  '&BASE(1)'                                        87223  02340000
&CASE2   SETC  '&BASE(2)'                                        87223  02350000
&CASE3   SETC  '&BASE(3)'                                        87223  02360000
&CASE4   SETC  '&BASE(4)'                                        87223  02370000
         AIF   (N'&BASE LT 5).COMBASE                            87223  02380000
         MNOTE 0,'ONLY FOUR BASES SUPPORTED'                     87223  02390000
         AGO   .COMBASE      BOMB ON ADDRESSABILITY ?            87223  02400000
.OLDBASE ANOP  ,                                                 87223  02410000
&CASE    SETC  '&BASE(1)'                                        87223  02420000
&CASE2   SETC  '&BASE2'                                          87223  02430000
&CASE3   SETC  '&BASE3'                                          87223  02440000
&CASE4   SETC  '&BASE4'                                          87223  02450000
.COMBASE AIF   ('&CASE4' NE '').FORBASE                          87223  02460000
         AIF   ('&CASE3' NE '').THRBASE                          87223  02470000
         AIF   ('&CASE2' NE '').TWOBASE                          87223  02480000
         AIF   ('&CASE' NE '').ONEBASE                           87223  02490000
.NOBASE  AIF   (T'&ENTRY NE 'O').NOBASEU                         81163  02500000
         DS    0H                                                       02510000
         USING *,R15                                             81163  02520000
.NOBASEU ANOP  ,                                                 81163  02530000
&CMU     SETC  'R15'                                             81163  02540000
         AGO   .BASED                                                   02550000
.FORBASE AIF   ('&CASE3' EQ '').GAP43                            87223  02560000
         AIF   ('&CASE2' EQ '').GAP42                            87223  02570000
         AIF   ('&CASE' EQ '').GAP41                             87223  02580000
&CMU     SETC  '&CASE'.','.'&CASE2'.','.'&CASE3'.','.'&CASE4'    87223  02590000
         AGO   .BASED                                                   02600000
.GAP43   MNOTE 12,'BASE3 REQUIRED WHEN BASE4 SPECIFIED'                 02610000
         AIF   ('&CASE2' NE '').GAP41T                           87223  02620000
.GAP42   MNOTE 12,'BASE2 REQUIRED WHEN BASE4 SPECIFIED'                 02630000
.GAP41T  AIF   ('&CASE' NE '').NOBASE                            87223  02640000
.GAP41   MNOTE 12,'BASE REQUIRED WHEN BASE4 SPECIFIED'                  02650000
         AGO   .NOBASE                                                  02660000
.THRBASE AIF   ('&CASE2' EQ '').GAP32                            87223  02670000
         AIF   ('&CASE' EQ '').GAP31                             87223  02680000
&CMU     SETC  '&CASE'.','.'&CASE2'.','.'&CASE3'                 87223  02690000
         AGO   .BASED                                                   02700000
.GAP32   MNOTE 12,'BASE2 REQUIRED WHEN BASE3 SPECIFIED'                 02710000
         AIF   ('&CASE' NE '').NOBASE                            87223  02720000
.GAP31   MNOTE 12,'BASE REQUIRED WHEN BASE3 SPECIFIED'                  02730000
         AGO   .NOBASE                                                  02740000
.TWOBASE AIF   ('&CASE' EQ '').GAP21                             87223  02750000
&CMU     SETC  '&CASE'.','.'&CASE2'                              87223  02760000
         AGO   .BASED                                                   02770000
.GAP21   MNOTE 12,'BASE REQUIRED WHEN BASE2 SPECIFIED'                  02780000
         AGO   .NOBASE                                                  02790000
.ONEBASE ANOP  ,                                                 81163  02800000
&CMU     SETC  '&CASE'                                           87223  02810000
.BASED   USING &DSCTG,R13                                               02820000
&B@      SETC  'B@&SYSNDX'                                              02830000
&N@      SETC  'N@&SYSNDX'                                              02840000
&LQ      SETC  'L'''                                                    02850000
&LAB     B     &B@-*(,R15)                                              02860000
         DC    AL1(&LQ&N@)                                              02870000
         AIF   ('&ID' NE '*').USEID                                     02880000
&NAME    SETC  '&L'                                                     02890000
         AIF   (T'&L NE 'O').USENAME                                    02900000
&NAME    SETC  '&SYSECT'                                                02910000
.USENAME AIF   ('&RIGHT' EQ '').NORIGHT                                 02920000
&NAME    SETC  '&NAME'.' '.'COPYRIGHT '.'&RIGHT'                        02930000
.NORIGHT AIF   ('&DATE' EQ 'NO' OR &BUMASM).NODATE                      02940000
&N@      DC    C'&NAME - &SYSDATE - &SYSTIME'                           02950000
         AGO   .NAMEOK                                                  02960000
.NODATE  ANOP                                                           02970000
&N@      DC    C'&NAME'                                                 02980000
         AGO   .NAMEOK                                                  02990000
.USEID   ANOP                                                           03000000
         AIF   ('&ID'(1,1) NE '''').USEIDQ                              03010000
&N@      DC    C&ID                                                     03020000
         AGO   .NAMEOK                                                  03030000
.USEIDQ  ANOP                                                           03040000
&N@      DC    C'&ID'                                                   03050000
.NAMEOK  AIF   (T'&ENTRY EQ 'O').NOENTR                          81163  03060000
&I       SETA  0                                                 81163  03070000
&J       SETA  N'&ENTRY                                          81163  03080000
&N@      SETC  ''            SHORT ID                            81163  03090000
         AIF   ('&EID' EQ 'SHORT').ENTRSH                        81163  03100000
&N@      SETC  ' - '.'&SYSDATE'.' - '.'&SYSTIME'                 81163  03110000
.ENTRSH  AIF   (&I GE &J).ENTRDN                                 81163  03120000
&I       SETA  &I+1                                              81163  03130000
&C9      SETC  '&ENTRY(&I)'                                      81163  03140000
         AIF   (&NOENTRY).ENTRNN                                 81347  03150000
         ENTRY &C9                                               81163  03160000
.ENTRNN  AIF   (T'&ENTNO EQ 'O').ENTRNM                          88255  03170000
&NUMENT  SETA  &NUMENT+1     INCREASE ENTRY NUMBER               88255  03180000
         DC    Y(&NUMENT)    MAKE ENTRY PREFIX                   88255  03190000
.ENTRNM  ANOP  ,                                                 88255  03200000
&C9      B     &B@-*(,R15)                                       81163  03210000
         AIF   ('&EID' EQ 'NONE' OR '&EID' EQ 'NO').ENTRSH      GP99062 03220000
&N       SETA  K'&N@+K'&C9                                       81163  03230000
&N       SETA  ((&N/2)*2)+1  MAKE ODD LENGTH FOR ALIGNMENT       81163  03240000
         DC    AL1(&N),CL(&N)'&ENTRY(&I)&N@'                     81163  03250000
         AGO   .ENTRSH                                           81163  03260000
.ENTRDN  AIF   (T'&ENTNO EQ 'O').ENTRDM                          88255  03270000
         DC    Y(0)          SET ENTRY PREFIX =0 (MAIN)          88255  03280000
.ENTRDM  AIF   (&OLDSAVE).ELDSV                                  81163  03290000
&B@      SAVEX R14,R12,&SV.14,TYPE=STM                           81203  03300000
&B@      SETC  ''                                                81163  03310000
.ELDSV   AIF   ('&CASE' EQ '').ELDSVLR                           87223  03320000
         AIF   ('&BASED' NE '*').ELDSVLR                         81263  03330000
&B@      BASR  &CASE,0                                           93006  03340000
         LA    R15,*-&CMB                                        81263  03350000
         SLR   &CASE,R15                                         87223  03360000
         AGO   .COMBAS2                                          81263  03370000
.ELDSVLR ANOP  ,                                                 81263  03380000
&B@      BASR  R15,0                                             93006  03390000
         USING *,R15                                             81163  03400000
         AIF   ('&CASE' EQ '').NOBASE2                           87223  03410000
         L     &CASE,=A(&CMB)                                    87223  03420000
         DROP  R15                                               81163  03430000
         AGO   .COMBAS2                                          81163  03440000
.NOENTR  AIF   (&OLDSAVE).OLDSV                                  81163  03450000
&B@      SAVEX R14,R12,&SV.14,TYPE=STM                           81203  03460000
&B@      SETC  ''                                                       03470000
.OLDSV   AIF   ('&CASE' EQ '').NOBASE2                           87223  03480000
         AIF   (&CME).BASEL                                      81163  03490000
&B@      LR    &CASE,R15                                         87223  03500000
         AGO   .COMBAS2                                          81163  03510000
.BASEL   USING &LAB,R15                                          81163  03520000
&B@      L     &CASE,=A(&CMB)                                    87223  03530000
         DROP  R15                                               81163  03540000
.COMBAS2 AIF   ('&CASE2' EQ '').NOBASE2                          87223  03550000
         AIF   ('&CASE3' EQ '').NOBASE3                          87223  03560000
         AIF   ('&CASE4' EQ '').NOBASE4                          87223  03570000
         LA    &CASE4,2048                                       87223  03580000
         LA    &CASE2,2048(&CASE4,&CASE)                         87223  03590000
         LA    &CASE3,2048(&CASE4,&CASE2)                        87223  03600000
         LA    &CASE4,2048(&CASE4,&CASE3)                        87223  03610000
         AGO   .NOBASE2                                                 03620000
.NOBASE4 LA    &CASE3,2048                                       87223  03630000
         LA    &CASE2,2048(&CASE3,&CASE)                                03640000
         LA    &CASE3,2048(&CASE3,&CASE2)                        87223  03650000
         AGO   .NOBASE2                                                 03660000
.NOBASE3 LA    &CASE2,4095                                       87223  03670000
         LA    &CASE2,1(&CASE2,&CASE)                            87223  03680000
.NOBASE2 AIF   (NOT &OLDSAVE).NOLDSV                                    03690000
         L     R15,&SV.13                                               03700000
         ST    &CASE,&SV.15-&DSCTG.(,R15)                        87223  03710000
         AIF   ('&PARM' EQ '').NOLDSV1                                  03720000
         L     &PARM(1),&SV.&PARMREG-&DSCTG.(,R15)                      03730000
         AGO   .NOLDSV1                                                 03740000
.NOLDSV  AIF   (&NOSAVE).NOLDSV1                                        03750000
         AIF   ('&PARM' EQ '').NOPARM                                   03760000
         AIF   ('&PARM' EQ '1' OR '&PARM' EQ 'R1').NOPARM        87223  03770000
&MACPLAB SETC  ''                                                81154  03780000
         MACPARM &PARM(1),&PARMEXP                               81154  03790000
.*                                                                      03800000
.NOPARM  AIF   ('&CASE' EQ '').NOUSEB                            87223  03810000
         USING &CMB,&CMU                                         81163  03820000
.NOUSEB  AIF   ('&SAVE' NE '*').LA                               81163  03830000
         AIF   (NOT &HWOPT).LYLEN                                84307  03840000
         L     R14,=A(&ENDG-&DSCTG)                              84307  03850000
         AGO   .NOLA                                             84307  03860000
.LYLEN   AIF   (NOT &BWOPT).LALEN                                84307  03870000
         LH    R14,=Y(&ENDG-&DSCTG)                                     03880000
         AGO   .NOLA                                                    03890000
.LA      LA    R1,&SAVE                                                 03900000
         SLR   R15,R15                                                  03910000
         AGO   .NOGM                                                    03920000
.LALEN   LA    R14,&ENDG-&DSCTG                                         03930000
.*             NOTE THAT R15 IS DESTROYED (OS/VS2) BY RMAIN             03940000
.NOLA    AIF   (&MVSXA OR '&SYSSPLV' GT '1').DOXA                93174  03950000
         AIF   ('&BNDRY' NE 'PAGE').GMDBLWD                      82002  03960000
         AIF   (NOT &MVS).SOLA                                   82002  03970000
.DOXA    LR    R0,R14        COPY LENGTH                         82002  03980000
         SLR   R1,R1         CLEAR FREEMAIN ADDRESS              82002  03990000
&Y       SETB  ('&BNDRY' EQ 'PAGE')                              93174  04000000
         LA    R15,2+4*&Y    UNCONDITIONAL GETMAIN(PAGE BNDRY)   93174  04010000
         AIF   ('&SP' EQ '0').POLA                               82002  04020000
         ICM   R15,2,=AL1(&SP)                                   82002  04030000
.POLA    SVC   120           GET PAGE ALIGNED STORAGE            82002  04040000
         ST    R14,&SV.SPLN-&DSCTG.(R1)                          82002  04050000
         AIF   ('&SP' EQ '0').NOGM                               82002  04060000
         MVI   &SV.SPLN-&DSCTG.(R1),&SP                          82002  04070000
         AGO   .NOGM                                             82002  04080000
.*       FOR NON-MVS SYSTEMS, PAGE ALIGNMENT IS ATTEMPTED, BUT   82002  04090000
.*       NOT GUARANTEED BY DOING THE GETMAIN IN A 4K CHUNK IN A  82002  04100000
.*       NON-ZERO SUB-POOL.  MVT/MFT NOT SUPPORTED.              82002  04110000
.SOLA    LA    R14,4095(,R14)                                    82002  04120000
         SRL   R14,12                                            82002  04130000
         SLL   R14,12                                            82002  04140000
         AIF   ('&SP' NE '0').GMDBLWD                            82002  04150000
         ICM   R14,8,=AL1(10)                                    82002  04160000
         AGO   .GM                                               82002  04170000
.GMDBLWD AIF   ('&SP' EQ '0').GM                                 82002  04180000
         AIF   ('&MODEL' EQ '360').GM360                                04190000
.GMICM   ICM   R14,8,=AL1(&SP)                                   82002  04200000
.GM    GETMAIN R,LV=(R14)                                               04210000
         AGO   .GMCOM                                                   04220000
.GM360 GETMAIN R,SP=(&SP),LV=(R14)                                      04230000
         ST    R14,&SV.SPLN-&DSCTG.(R1)                          82002  04240000
         MVI   &SV.SPLN-&DSCTG.(R1),&SP                          82002  04250000
         AGO   .NOGM                                             82002  04260000
.GMCOM   ST    R14,&SV.SPLN-&DSCTG.(R1)                                 04270000
.NOGM    ST    R1,&SV.FWD                                               04280000
         ST    R13,&SV.13-&DSCTG.(R1)                                   04290000
         AIF   (NOT &CPYREGS).LR13                                      04300000
         MVC   &SV.14-&DSCTG.(&SV.12+4-&SV.14,R1),&SV.14         81151  04310000
&BEGZ    SETC  '&PFX'.'FWK'  CLEAR ONLY AFTER REGISTERS          94272  04320000
         AIF   (NOT &ZERO).LR13                                  94272  04330000
         XC    &SV.FWD-&DSCTG.(&SV.14-&SV.FWD,R1),&SV.FWD-&DSCTG.(R1)   04340000
.LR13    LR    R13,R1                                                   04350000
&ENDZ    SETC  '&ENDG'             DEFAULT END OF CLEAR          81208  04360000
         AIF   (T'&ENDZERO EQ 'O').CLRDFLT                       81209  04370000
&ENDZ    SETC  '&ENDZERO'                                        81208  04380000
&ZERO    SETB  1                                                 81208  04390000
&ZERO15  SETB  (NOT &ZERO8 AND NOT &ZERO12)                      81208  04400000
.CLRDFLT AIF   (NOT &ZERO).NOLDSV1                               81208  04410000
         AIF   (&ZERO8).XC                                       81202  04420000
         AIF   ('&MODEL' NE '360').MVCL                                 04430000
         LA    R0,(&ENDG-&BEGZ)/256-1 ASM ERROR IF LEN<256       94272  04440000
         ORG   *-4                                                      04450000
         LA    R0,(&ENDG-&BEGZ)/256   NUMBER OF SEGMENTS TO ZERO 94272  04460000
         LA    R1,&BEGZ      ZERO WORK AREA                      94272  04470000
         LA    R15,&ENDG-&BEGZ-(&ENDG-&BEGZ)/256*256             94272  04480000
         XC    0(256,R1),0(R1)          ZERO WORK AREA SEGMENT          04490000
         LA    R1,256(,R1)                                              04500000
         BCT   R0,*-10                                                  04510000
         SH    R15,=H'1'                                                04520000
         BM    *+14                                                     04530000
         EX    R15,*+4                  ZERO PARTIAL SEGMENT            04540000
         XC    0(0,R1),0(R1)            EXECUTED TO ZERO WORK AREA      04550000
         AGO   .NOLDSV1                                                 04560000
.XC      XC    &BEGZ.(&ENDG-&BEGZ),&BEGZ                         94272  04570000
         AGO   .NOLDSV1                                                 04580000
.MVCL    LA    R0,&BEGZ      ZERO WORK AREA                      94272  04590000
         AIF   (NOT &ZERO31).ZEROLY                              84307  04600000
         L     R1,=A(&ENDG-&BEGZ)                                94272  04610000
         AGO   .XR15                                             84307  04620000
.ZEROLY  AIF   (&ZERO12).ZEROLA                                  84307  04630000
         LH    R1,=Y(&ENDG-&BEGZ)                                94272  04640000
         AGO   .XR15                                             81202  04650000
.ZEROLA  LA    R1,&ENDG-&BEGZ                                    94272  04660000
.XR15    SLR   R15,R15                                           81202  04670000
         MVCL  R0,R14                                                   04680000
.NOLDSV1 AIF   (T'&ENTRY EQ 'O' OR T'&ENTNO EQ 'O').NOLDENT      88255  04690000
         L     R1,&SV.13     GET OLD SAVE AREA BACK              88255  04700000
         CLM   &CASE,7,&SV.15+1-&DSCTG.(R1)  MAIN ENTRY ?        88255  04710000
         BE    *+16          YES; DON'T MOVE                     88255  04720000
         L     R1,&SV.15-&DSCTG.(,R1) GET ENTRY ADDRESS BACK     88255  04730000
         BCTR  R1,0          SPACE TO ENTRY COUNTER              88255  04740000
         MVC   &ENTNO+L'&ENTNO-1(1),0(R1) COPY COUNT             88255  04750000
.NOLDENT AIF   ('&PARM' NE '1' AND '&PARM' NE 'R1').NOPARM1      87223  04760000
         L     R1,&SV.13     OLD SAVE AREA                       87223  04770000
         LM    R0,R1,&SV.0-&DSCTG.(R1)  RESTORE ENTRY REGISTERS  94272  04780000
.NOPARM1 AIF   (&NOT1ST).END                                            04790000
         AIF   (&DSOPT).DSOPT                                           04800000
&DSCTG   DSECT                                                          04810000
&SV.SPLN DS    F                                                        04820000
&SV.13   DS    F                                                        04830000
&SV.FWD  DS    A                                                        04840000
&SV.14   DS    A                                                        04850000
&SV.15   DS    A                                                        04860000
&SV.0    DS    A                                                        04870000
&SV.1    DS    A                                                        04880000
&SV.2    DS    A                                                        04890000
&SV.3    DS    A                                                        04900000
&SV.4    DS    A                                                        04910000
&SV.5    DS    A                                                        04920000
&SV.6    DS    A                                                        04930000
&SV.7    DS    A                                                        04940000
&SV.8    DS    A                                                        04950000
&SV.9    DS    A                                                        04960000
&SV.10   DS    A                                                        04970000
&SV.11   DS    A                                                        04980000
&SV.12   DS    A                                                        04990000
&SV.FWK  EQU   *                                                 94272  05000000
         AIF   (NOT &NWOPT).NOEND                                       05010000
&ENDG    EQU   *                                                        05020000
.NOEND   ANOP                                                           05030000
&SECT   CSECT                                                           05040000
.DSOPT   AIF   (&EQUOPT OR &MAPONCE OR &SAV@REG).END                    05050000
&MAPONCE SETB  1                                                        05060000
&SAV@REG SETB  1                                                        05070000
         REGEQU ,                                                       05080000
         MASKEQU ,                                               87223  05090000
.END     MEND  ,                                                        05100000
./ ADD NAME=SAVEX
         MACRO ,                                                        00010000
&L       SAVEX &R1,&R3,&LOC,&TYPE=*,&SETAM=,&WORK=R14           GP99018 00020000
         GBLB  &ZZSVBSM,&MVSESA                                         00030000
         LCLC  &NM                                                      00040000
&NM      SETC  '&L'                                                     00050000
.*                                                                      00060000
.*             COPYRIGHT 1981 BY EXPERT SYSTEMS PROGRAMMING INC.        00070000
.*                               347 ORCHARD STREET                     00080000
.*                               VIENNA, VIRGINIA   22180               00090000
.*                                                                      00100000
.*                        ALL RIGHTS RESERVED.                          00110000
.*                                                                      00120000
.*             THIS MACRO IS NOT TO BE DISTRIBUTED WITHOUT PERMISSION,  00130000
.*             AS DESCRIBED IN MEMBER $$RIGHTS.                         00140000
.*                                                                      00150000
.*       CODE ADDED TO PRESERVE CALLER'S AMODE AND OPTIONALLY SET AMODE 00160000
.*                                                              GP99018 00170000
         AIF   ('&TYPE' EQ 'BSM').BSM                           GP98322 00180000
         AIF   ('&TYPE' EQ 'STM').STM                                   00190000
         MNOTE 8,'SAVEX: TYPE=&TYPE UNKNOWN - TYPE=STM ASSUMED'         00200000
         AGO   .STM                                                     00210000
.BSM     ANOP  ,                                                GP98322 00220000
&ZZSVBSM SETB  1             SET FLAG FOR ENDM                          00230000
&NM      BSM   R14,0         GET CALLER'S AMODE                 GP98322 00240000
&NM      SETC  ''            DONE WITH LABEL                            00250000
.STM     ANOP  ,                                                        00260000
&NM      STM   &R1,&R3,&LOC                                             00270000
&NM      SETC  ''            DONE WITH LABEL                            00280000
         AIF   ('&SETAM' EQ '' OR '&SETAM' EQ 'ANY').MEND       GP04234 00290000
         AIF   (NOT &MVSESA).MEND                               GP04234 00300000
         BASR  R14,0                                            GP04050 00310000
         USING *,R14                                            GP04050 00320000
         LA    &WORK,ZZSV&SYSNDX                                GP99018 00330000
         AIF   ('&SETAM' EQ '24' OR '&SETAM' EQ 'AM24').SETCM   GP99018 00340000
         LA    R0,1                                             GP99018 00350000
         SLL   R0,31         MAKE 80000000                      GP99018 00360000
         OR    &WORK,R0                                         GP99018 00370000
         AIF   ('&SETAM' EQ '31' OR '&SETAM' EQ 'AM31').SETCM   GP99018 00380000
   MNOTE 8,'SAVEX: UNSUPPORTED SETAM VALUE: &SETAM - AM31 ASSUMED'      00390000
.SETCM   BSM   0,&WORK       CHANGE TO REQUIRED MODE            GP99018 00400000
         DROP  R14                                              GP04050 00410000
ZZSV&SYSNDX DS 0H                                               GP99018 00420000
.MEND    MEND  ,                                                GP99018 00430000
./ ADD NAME=SCBILD
         MACRO ,                                       ADDED ON GP12304 00010000
&NM      SCBILD &OP,&LIST,&FILL  BUILD A SCREEN ADDRESS LIST AND        00020000
&NM      MACPARM R1,&OP,NULL=SKIP  LOAD FDW LIST ADDRESS                00030000
.*   THIS MACRO BUILD AN ADDRESS LIST AND MATCHING DATA ARRAY IN        00040000
.*   PREVIOUSLY ALLOCATED STORAGE (EXW@STOR), FOR USE BY SCLINE.        00050000
.*   LIST DATA ARE COPIED AS SUPPLIED; FILL IS REPEATED FOR REMAINDER.  00060000
         MACPARM R15,&LIST,NULL=0  LOAD LIST ADDRESS                    00070000
         MACPARM R15,0(,R1),OP=ST    SET LIST ADDRESS INTO FDWFDA       00080000
         MACPARM R15,&FILL,NULL=0  LOAD FILLER ADDRESS                  00090000
         MACPARM R15,12(,R1),OP=ST   SET IT ADDRESS INTO FDWSCAN        00100000
         MACPARM R15,EXWASCRN,OP=L LOAD SCREEN SERVICE ROUTINE          00110000
         L     R15,80(,R15)  LOAD ADDRESS OF ROUTINE                    00120000
         BASR  R14,R15       CALL IT                                    00130000
         MEND  ,                                                        00140000
./ ADD NAME=SCRANAL
         MACRO                                                          00010000
&NM      SCRANAL &FDW,&DEV=                                             00020000
&NM      SCRCOM 0,0,5,,&FDW,DEV=&DEV  EXPAND REQUEST                    00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRCLOSE
         MACRO                                                          00010000
&NM      SCRCLOSE &TYPE,&DEV=                                           00020000
         LCLA  &FN                                                      00030000
         AIF   ('&TYPE' EQ '').COMM                                     00040000
         AIF   ('&TYPE' EQ 'TCLOSE' OR '&TYPE' EQ 'SPIN').SET1          00050000
         MNOTE 4,'*** UNRECOGNIZED TYPE &TYPE'                          00060000
.SET1    ANOP  ,                                                        00070000
&FN      SETA  1             SET TCLOSE FUNCTION                        00080000
.COMM    ANOP  ,                                                        00090000
&NM      SCRCOM 0,0,&FN,DEV=&DEV  EXPAND REQUEST                        00100000
         MEND  ,                                                        00110000
./ ADD NAME=SCRCOM
         MACRO                                                          00010000
&NM      SCRCOM &B0,&B1,&FN,&A0,&A1,&DEV=                               00020000
         GBLC  &MACPLAB,&SCRMODE                                        00030000
.********************************************************************** 00040000
.*                                                                   ** 00050000
.*   TSO INTERFACE TO @SCREENS FULL-SCREEN FORMATTING & I/O ROUTINE  ** 00060000
.*                                                                   ** 00070000
.********************************************************************** 00080000
         LCLA  &I,&J,&K,&VD,&D(8)                                       00090000
         LCLB  &INDEV                                            81259  00100000
         LCLC  &DC                                               81259  00110000
&MACPLAB SETC  '&NM'                                             81259  00120000
         AIF   ('&DEV' EQ '' OR '&DEV' EQ '0').NODV                     00130000
         AIF   ('&DEV' NE 'ALL').DVSOM                                  00140000
&VD      SETA  255                                                      00150000
         AGO   .NODV                                                    00160000
.DVSOM   AIF   (K'&DEV LT 2).DVSOL                               81259  00170000
         AIF   ('&DEV'(1,1) NE '=').DVSOL                        81259  00180000
&INDEV   SETB  1             SET INDIRECT DEVICE NUMBER          81259  00190000
         AGO   .NODV                                             81259  00200000
.DVSOL   ANOP  ,                                                 81259  00210000
&I       SETA  0                                                        00220000
&J       SETA  N'&DEV                                                   00230000
.DEVLOOP ANOP  ,                                                        00240000
&I       SETA  &I+1                                                     00250000
         AIF   (&I GT &J).DVEND                                         00260000
         AIF   ('&DEV(&I)' EQ '').DEVLOOP                               00270000
         AIF   ('&DEV(&I)' EQ '0').DEVLOOP                              00280000
         AIF   ('&DEV(&I)' LT '1' OR '&DEV(&I)' GT '8').DVERR           00290000
&D(&DEV(&I)) SETA  1                                                    00300000
         AGO   .DEVLOOP                                                 00310000
.DVERR   MNOTE 8,'*** INVALID DEVICE NUMBER &DEV(&I)'                   00320000
         AGO   .DEVLOOP                                                 00330000
.DVEND   ANOP  ,                                                        00340000
&VD      SETA  128*&D(8)+64*&D(7)+32*&D(6)+16*&D(5)+8*&D(4)             00350000
&VD      SETA  &VD+4*&D(3)+2*&D(2)+&D(1)                                00360000
.NODV    AIF   ('&B0' NE '0' OR '&B1' NE '0').LONG                      00370000
         AIF   (&VD GT 15).LONG                                         00380000
&K       SETA  &VD*256+&FN                                              00390000
         MACPARM R0,&K       LOAD DEVICE/FUNCTION INDEX          81259  00400000
         AGO   .POST0                                            81259  00410000
.LONG    AIF   (K'&B0 LT 2).LONGCON                              82326  00420000
         AIF   ('&B0'(1,1) NE '(').LONGCON                       82326  00430000
         AIF   ('&B0'(2,1) EQ '(').LONGCON                       82326  00440000
         MACPARM R0,&B0      LOAD R0                             82326  00450000
         SLL   R0,24         ALIGN LENGTH TO HIGH BYTE           82326  00460000
         O     R0,=AL1(0,&B1,&VD,&FN)                            82326  00470000
         AGO   .POST0                                            82326  00480000
.LONGCON ANOP  ,                                                 82326  00490000
&MACPLAB L     R0,=AL1(&B0,&B1,&VD,&FN)                          81259  00500000
&MACPLAB SETC  ''            CANCEL LABEL                        81259  00510000
.POST0   AIF   (NOT &INDEV).LOAD1                                81259  00520000
&VD      SETA  K'&DEV-1                                          81259  00530000
&DC      SETC  '&DEV'(2,&VD)                                     81259  00540000
&MACPLAB ICM   R0,2,&DC                                          81259  00550000
&MACPLAB SETC  ''                                                81259  00560000
.LOAD1   AIF   ('&FN' EQ '0' OR '&FN' EQ '1').BAL                       00570000
         MACPARM R1,&A1      LOAD PARAMETER REGISTER                    00580000
         AIF   ('&A0' EQ '' OR '&A0' EQ '0').BAL                        00590000
         ICM   R1,8,=AL1(&A0)                                           00600000
.BAL     AIF   ('&SCRMODE' EQ 'V').VCON                                 00610000
         L     R15,@SCREENS                                             00620000
         AGO   .BALR                                                    00630000
.VCON    L     R15,=V(@SCREENS)                                         00640000
.BALR    BASSM R14,R15                                                  00650000
         MEND  ,                                                        00660000
./ ADD NAME=SCREDIT
         MACRO                                                          00010000
&NM      SCREDIT &FDW,&DEV=                                      88340  00020000
&NM      SCRCOM 0,0,11,,&FDW,DEV=&DEV  EXPAND REQUEST            88340  00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRINIT
         MACRO                                                          00010000
&NM      SCRINIT &FDW,&DEV=                                             00020000
&NM      SCRCOM 0,0,3,,&FDW,DEV=&DEV  EXPAND REQUEST                    00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRITEM
         MACRO                                                          00010000
&NM      SCRITEM &LAD,&DEV=,&TITLE=0,&FOOTER=0                  GP03011 00020000
.*  PROCESS A SINGLE DISPLAY ITEM (IN LIST FORM)                        00030000
         LCLA  &I                                                       00040000
         AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00050000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00060000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00070000
.OKT     ANOP  ,                                                        00080000
&I       SETA  &TITLE*16+&FOOTER                                        00090000
.NOT     ANOP  ,                                                        00100000
&NM      SCRCOM 0,&I,12,,&LAD,DEV=&DEV                                  00110000
         MEND                                                           00120000
./ ADD NAME=SCRLIST
         MACRO                                                          00010000
&NM      SCRLIST &LAD,&DEV=,&TITLE=0,&FOOTER=0                          00020000
         LCLA  &I                                                       00030000
         AIF   (&TITLE EQ 0 AND &FOOTER EQ 0).NOT                       00040000
         AIF   (&TITLE LT 16 AND &FOOTER LT 16).OKT                     00050000
         MNOTE 4,'*** NON-NUMERIC TITLE/FOOTER NOT SUPPORTED'           00060000
.OKT     ANOP  ,                                                        00070000
&I       SETA  &TITLE*16+&FOOTER                                        00080000
.NOT     ANOP  ,                                                        00090000
&NM      SCRCOM 0,&I,4,,&LAD,DEV=&DEV                                   00100000
         MEND                                                           00110000
./ ADD NAME=SCRLOOP
         MACRO                                                          00010000
&NM      SCRLOOP &FDW,&DEV=                                             00020000
&NM      SCRCOM 0,0,8,,&FDW,DEV=&DEV  EXPAND REQUEST                    00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRMARK
         MACRO                                                          00010000
&NM      SCRMARK &FDW,&DEV=                                      87314  00020000
&NM      SCRCOM 0,0,10,,&FDW,DEV=&DEV  EXPAND REQUEST                   00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRMOVE
         MACRO                                                          00010000
&NM      SCRMOVE &FDW,&DEV=                                             00020000
&NM      SCRCOM 0,0,6,,&FDW,DEV=&DEV  EXPAND REQUEST                    00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRN
         MACRO                                                          00010000
&L       SCRN  &DUMMY,&WIDTH=                                    89298  00020000
.*                                                                      00030000
.*             COPYRIGHT 1978 BY SHMUEL (SEYMOUR J.) METZ               00040000
.*                        ALL RIGHTS RESERVED.                          00050000
.*                                                                      00060000
.*             THIS MACRO IS NOT TO BE DISTRIBUTED WITHOUT PERMISSION,  00070000
.*             AS DESCRIBED IN MEMBER $$RIGHTS.                         00080000
.*                                                                      00090000
.*             ANYONE MAKING ENHANCEMENTS IS REQUEST TO FORWARD THEM    00100000
.*             TO ME, IDENTIFIED BY "** XXX **' IN COLUMN 63,           00110000
.*             WHERE XXX IS THE SHARE INSTALLATION CODE.                00120000
.*                                                               89298  00130000
.*       PERFORMANCE ENHANCEMENT (?) - LINESZE=80 REPLACED BY    89298  00140000
.*       WIDTH= AND LINESZE MADE GLOBAL. REQUIRES ONLY ONE WIDTH 89298  00150000
.*       OVERRIDE FOR AN EXTENDED SERIES OF MACROS.  *GYP*       89298  00160000
.*       FIX FOR 'RA' ORDER POSITIONING.             *GYP*       89300  00170000
.*                                                                      00180000
.*                                                                      00190000
         GBLA  &ROW,&COL,&LINESZE,&SCRNRAF                       89300  00200000
         GBLB  &TAB70IN                                          87070  00210000
         GBLC  &TAB3270(64)                                      87070  00220000
         LCLA  &I,&I1,&I2,&J,&K                                         00230000
         LCLB  &LN40,&LN64,&LN80,&STARTPR,&SAL,&RSTKBY,&RSTMDT          00240000
         LCLB  &PROT,&NUMERIC,&DETCT,&INT,&MDT                   81328  00250000
         LCLB  &NONDISP,&SKIP      COMPOSITES                    81328  00260000
         LCLB  &OK                                                      00270000
         LCLC  &LABEL,&LABEL1,&CH1                               87070  00280000
&LABEL   SETC  '&L'                                                     00290000
         AIF   (&TAB70IN).TABINIT                                87070  00300000
&LINESZE SETA  80            DEFAULT SCREEN WIDTH                89298  00310000
&TAB3270(1)   SETC  ' '                                          89271  00320000
&TAB3270(2)   SETC  'A'                                          89271  00330000
&TAB3270(3)   SETC  'B'                                          89271  00340000
&TAB3270(4)   SETC  'C'                                          89271  00350000
&TAB3270(5)   SETC  'D'                                          89271  00360000
&TAB3270(6)   SETC  'E'                                          89271  00370000
&TAB3270(7)   SETC  'F'                                          89271  00380000
&TAB3270(8)   SETC  'G'                                          89271  00390000
&TAB3270(9)   SETC  'H'                                          89271  00400000
&TAB3270(10)  SETC  'I'                                          89271  00410000
&TAB3270(11)  SETC  '¢'                                          89271  00420000
&TAB3270(12)  SETC  '.'                                          89271  00430000
&TAB3270(13)  SETC  '<'                                          89271  00440000
&TAB3270(14)  SETC  '('                                          89271  00450000
&TAB3270(15)  SETC  '+'                                          89271  00460000
&TAB3270(16)  SETC  '|'                                          89271  00470000
&TAB3270(17)  SETC  '&&'                                         81335  00480000
&TAB3270(18)  SETC  'J'                                          89271  00490000
&TAB3270(19)  SETC  'K'                                          89271  00500000
&TAB3270(20)  SETC  'L'                                          89271  00510000
&TAB3270(21)  SETC  'M'                                          89271  00520000
&TAB3270(22)  SETC  'N'                                          89271  00530000
&TAB3270(23)  SETC  'O'                                          89271  00540000
&TAB3270(24)  SETC  'P'                                          89271  00550000
&TAB3270(25)  SETC  'Q'                                          89271  00560000
&TAB3270(26)  SETC  'R'                                          89271  00570000
&TAB3270(27)  SETC  '!'                                          89271  00580000
&TAB3270(28)  SETC  '$'                                          89271  00590000
&TAB3270(29)  SETC  '*'                                          89271  00600000
&TAB3270(30)  SETC  ')'                                          89271  00610000
&TAB3270(31)  SETC  ';'                                          89271  00620000
&TAB3270(32)  SETC  '¬'                                          89271  00630000
&TAB3270(33)  SETC  '-'                                          89271  00640000
&TAB3270(34)  SETC  '/'                                          89271  00650000
&TAB3270(35)  SETC  'S'                                          89271  00660000
&TAB3270(36)  SETC  'T'                                          89271  00670000
&TAB3270(37)  SETC  'U'                                          89271  00680000
&TAB3270(38)  SETC  'V'                                          89271  00690000
&TAB3270(39)  SETC  'W'                                          89271  00700000
&TAB3270(40)  SETC  'X'                                          89271  00710000
&TAB3270(41)  SETC  'Y'                                          89271  00720000
&TAB3270(42)  SETC  'Z'                                          89271  00730000
&TAB3270(43)  SETC  '¦'                                          89271  00740000
&TAB3270(44)  SETC  ','                                          89271  00750000
&TAB3270(45)  SETC  '%'                                          89271  00760000
&TAB3270(46)  SETC  '_'                                          89271  00770000
&TAB3270(47)  SETC  '>'                                          89271  00780000
&TAB3270(48)  SETC  '?'                                          89271  00790000
&TAB3270(49)  SETC  '0'                                          89271  00800000
&TAB3270(50)  SETC  '1'                                          89271  00810000
&TAB3270(51)  SETC  '2'                                          89271  00820000
&TAB3270(52)  SETC  '3'                                          89271  00830000
&TAB3270(53)  SETC  '4'                                          89271  00840000
&TAB3270(54)  SETC  '5'                                          89271  00850000
&TAB3270(55)  SETC  '6'                                          89271  00860000
&TAB3270(56)  SETC  '7'                                          89271  00870000
&TAB3270(57)  SETC  '8'                                          89271  00880000
&TAB3270(58)  SETC  '9'                                          89271  00890000
&TAB3270(59)  SETC  ':'                                          89271  00900000
&TAB3270(60)  SETC  '#'                                          89271  00910000
&TAB3270(61)  SETC  '@'                                          89271  00920000
&TAB3270(62)  SETC  ''''''                                       81328  00930000
&TAB3270(63)  SETC  '='                                          89271  00940000
&TAB3270(64)  SETC  '"'                                          89271  00950000
&TAB70IN SETB  1             INITIALIZATION DONE                 87070  00960000
.TABINIT AIF   ('&WIDTH' EQ '').SIZED                            89298  00970000
&LINESZE SETA  &WIDTH        RESET WIDTH FOR CURRENT SCREEN      89298  00980000
.SIZED   AIF   (N'&SYSLIST EQ 0).NOLIST                          89271  00990000
.NXTI    AIF   (&I EQ N'&SYSLIST).END                                   01000000
&I       SETA  &I+1                                                     01010000
         AIF   ('&SYSLIST(&I)'(1,1) EQ '(').ADDR                        01020000
&SCRNRAF SETA  0             CANCEL 'RA' ADJUSTMENT - NOT ADDRESS       01030000
         AIF   ('&SYSLIST(&I)'(1,1) EQ '''').STRING                     01040000
         AIF   ('&SYSLIST(&I)' EQ 'WDC').WDC                            01050000
         AIF   ('&SYSLIST(&I)' EQ 'W').WDC                       82273  01060000
         AIF   ('&SYSLIST(&I)' EQ 'WRE').WRE                            01070000
         AIF   ('&SYSLIST(&I)' EQ 'EW').WRE                      82273  01080000
         AIF   ('&SYSLIST(&I)' EQ 'EWA').EWA                     82273  01090000
         AIF   ('&SYSLIST(&I)' EQ 'EAU').EAU                            01100000
         AIF   ('&SYSLIST(&I)' EQ 'WSF').WSF                     82273  01110000
         AIF   ('&SYSLIST(&I)' EQ 'SBA').SBA                            01120000
         AIF   ('&SYSLIST(&I)' EQ 'SF').SF                              01130000
         AIF   ('&SYSLIST(&I)' EQ 'SFE').SFE                     82273  01140000
         AIF   ('&SYSLIST(&I)' EQ 'MF').MF                       83165  01150000
         AIF   ('&SYSLIST(&I)' EQ 'SA').SA                       83165  01160000
         AIF   ('&SYSLIST(&I)' EQ 'IC').IC                              01170000
         AIF   ('&SYSLIST(&I)' EQ 'PT').PT                              01180000
         AIF   ('&SYSLIST(&I)' EQ 'RA').RA                              01190000
         AIF   ('&SYSLIST(&I)' EQ 'EUA').EUA                            01200000
         AIF   ('&SYSLIST(&I)' EQ 'COLOR').COLOR                 89258  01210000
         AIF   ('&SYSLIST(&I)' EQ 'HIGHLITE').HIGHLIT            89258  01220000
         AIF   ('&SYSLIST(&I)' EQ 'ATTR').ATTR                   89258  01230000
         AIF   ('&SYSLIST(&I)' EQ 'REVERSE').REVERSE             89258  01240000
         AIF   ('&SYSLIST(&I)' EQ 'BLINK').BLINK                 89258  01250000
         AIF   ('&SYSLIST(&I)' EQ 'UNDER').UNDER                 89258  01260000
         AIF   ('&SYSLIST(&I)' EQ 'DFLT').NULL                   89258  01270000
         AIF   ('&SYSLIST(&I)' EQ 'BLUE').BLUE                   89258  01280000
         AIF   ('&SYSLIST(&I)' EQ 'RED').RED                     89258  01290000
         AIF   ('&SYSLIST(&I)' EQ 'PINK').PINK                   89258  01300000
         AIF   ('&SYSLIST(&I)' EQ 'GREEN').GREEN                 89258  01310000
         AIF   ('&SYSLIST(&I)' EQ 'CYAN').TURQ                   89258  01320000
         AIF   ('&SYSLIST(&I)' EQ 'TURQ').TURQ                   89258  01330000
         AIF   ('&SYSLIST(&I)' EQ 'TURQOISE').TURQ               89258  01340000
         AIF   ('&SYSLIST(&I)' EQ 'YELLOW').YELLOW               89258  01350000
         AIF   ('&SYSLIST(&I)' EQ 'WHITE').WHITE                 89258  01360000
         AIF   ('&SYSLIST(&I)' EQ 'NULL').NULL                          01370000
         AIF   ('&SYSLIST(&I)' EQ 'BLANK').BLANK                 81328  01380000
         AIF   ('&SYSLIST(&I)'(K'&SYSLIST(&I),1) EQ ':').LABEL          01390000
         AIF   ('&SYSLIST(&I)'(K'&SYSLIST(&I),1) EQ '-').LABEL1         01400000
         AIF   ('&SYSLIST(&I)'(1,2) EQ 'CL').DSC                        01410000
         AIF   ('&SYSLIST(&I)'(1,2) EQ 'XL').DSC                        01420000
         AIF   ('&SYSLIST(&I)'(1,4) EQ 'AL2(').DSA                      01430000
         MNOTE 12,'PARAMETER #&I INVALID - &SYSLIST(&I) NOT A VALID KEY*01440000
               WORD'                                                    01450000
         MEXIT                                                          01460000
.*                                                                      01470000
.STRING  ANOP                                                           01480000
&J       SETA  2                                                        01490000
&K       SETA  0                                                        01500000
.STRLOOP AIF   ('&SYSLIST(&I)'(&J,2) EQ '''''').STRDBL                  01510000
         AIF   ('&SYSLIST(&I)'(&J,2) NE '&&&&').STRSNGL                 01520000
.STRDBL  ANOP                                                           01530000
&J       SETA  &J+1                                                     01540000
.STRSNGL ANOP                                                           01550000
&J       SETA  &J+1                                                     01560000
&K       SETA  &K+1                                                     01570000
         AIF   (&J LT K'&SYSLIST(&I)).STRLOOP                           01580000
         AIF   (&COL+&K LE &LINESZE).STRFITS                            01590000
&ROW     SETA  &ROW+1                                                   01600000
&COL     SETA  1                                                        01610000
.STRFITS ANOP                                                           01620000
&LABEL   DC    C&SYSLIST(&I)                                            01630000
.SETL1   AIF   ('&LABEL1' EQ '').NOL1                                   01640000
&I2      SETA  (&ROW-1)*&LINESZE+&COL-1                                 01650000
         AIF   (&I2 LT 4096).ADDR2#6                            GP06262 01660000
&LABEL1  DC    AL2(&I2)      14-BIT ADDRESS                     GP06262 01670000
&LABEL1  SETC  ''                                               GP06262 01680000
         AGO   .NOL1                                            GP06262 01690000
.ADDR2#6 ANOP  ,                                                GP06262 01700000
&I1      SETA  &I2/64                                                   01710000
&CH1     SETC  '&TAB3270(&I1+1)'.'&TAB3270(&I2-64*&I1+1)'        87070  01720000
&LABEL1  EQU   C'&CH1'                                                  01730000
&LABEL1  SETC  ''                                                       01740000
.NOL1    ANOP                                                           01750000
&LABEL   SETC  ''                                                       01760000
&COL     SETA  &COL+&K                                                  01770000
.SLDEC   AIF   (&COL LE &LINESZE).NXTI                                  01780000
&ROW     SETA  &ROW+1                                                   01790000
&COL     SETA  &COL-&LINESZE                                            01800000
         AGO   .SLDEC                                                   01810000
.*                                                                      01820000
.ADDR    AIF   (N'&SYSLIST(&I) NE 2).CONBYTE                     90149  01830000
         AIF   ('&SYSLIST(&I,1)' EQ '*').RSAME                          01840000
         AIF   ('&SYSLIST(&I,1)'(1,1) EQ '+').RINC                      01850000
         AIF   ('&SYSLIST(&I,1)'(1,1) EQ '-').RDEC                      01860000
         AIF   ('&SYSLIST(&I,1)'(1,1) LT '0').CONBYTE                   01870000
         AIF   (K'&SYSLIST(&I,1) GT 3).CONBYTE                   90149  01880000
&ROW     SETA  &SYSLIST(&I,1)                                           01890000
         AGO   .RSAME                                                   01900000
.RINC    ANOP                                                           01910000
&CH1     SETC  '&SYSLIST(&I,1)'(2,K'&SYSLIST(&I,1)-1)                   01920000
&ROW     SETA  &ROW+&CH1                                                01930000
&COL     SETA  1                                                        01940000
         AGO   .RSAME                                                   01950000
.RDEC    ANOP                                                           01960000
&CH1     SETC  '&SYSLIST(&I,1)'(2,K'&SYSLIST(&I,1)-1)                   01970000
&ROW     SETA  &ROW-&CH1                                                01980000
&COL     SETA  1                                                        01990000
.RSAME   AIF   ('&SYSLIST(&I,2)' EQ '*').CSAME                          02000000
         AIF   ('&SYSLIST(&I,2)'(1,1) EQ '+').CINC                      02010000
         AIF   ('&SYSLIST(&I,2)'(1,1) EQ '-').CDEC                      02020000
&COL     SETA  &SYSLIST(&I,2)                                           02030000
         AGO   .CSAME                                                   02040000
.CINC    ANOP                                                           02050000
&CH1     SETC  '&SYSLIST(&I,2)'(2,K'&SYSLIST(&I,2)-1)                   02060000
&COL     SETA  &COL+&CH1                                                02070000
.TINC    AIF   (&COL LE &LINESZE).CSAME                                 02080000
&COL     SETA  &COL-&LINESZE                                            02090000
&ROW     SETA  &ROW+1                                                   02100000
         AGO   .TINC                                                    02110000
.CDEC    ANOP                                                           02120000
&CH1     SETC  '&SYSLIST(&I,2)'(2,K'&SYSLIST(&I,2)-1)                   02130000
&COL     SETA  &COL-&CH1                                                02140000
.TDEC    AIF   (&COL GE 0).CSAME                                        02150000
&COL     SETA  &COL+&LINESZE                                            02160000
&ROW     SETA  &ROW-1                                                   02170000
         AGO   .TDEC                                                    02180000
.CSAME   ANOP                                                           02190000
&I2      SETA  (&ROW-1)*&LINESZE+&COL-1                                 02200000
         AIF   (&I2 LT 4096).ADDR6#6                            GP06262 02210000
&LABEL   DC    AL2(&I2)      14-BIT ADDRESS                     GP06262 02220000
         AGO   .ADDRAF                                          GP06262 02230000
.ADDR6#6 ANOP  ,                                                GP06262 02240000
&I1      SETA  &I2/64                                                   02250000
&CH1     SETC  '&TAB3270(&I1+1)'.'&TAB3270(&I2-64*&I1+1)'        87070  02260000
&LABEL   DC    C'&CH1'                                                  02270000
.ADDRAF  ANOP  ,                                                GP06262 02280000
&LABEL   SETC  ''                                                       02290000
&COL     SETA  &COL-&SCRNRAF   FIX FOR 'RA' ORDER ADJUSTMENT     89300  02300000
&SCRNRAF SETA  0             DONE WITH ADJUSTMENT                89300  02310000
         AGO   .NXTI                                                    02320000
.*                                                                      02330000
.CONBYTE ANOP                                                           02340000
&SCRNRAF SETA  0             CANCEL 'RA' ADJUSTMENT - NOT ADDRESS       02350000
&K       SETA  0                                                        02360000
&J       SETA  1                                                        02370000
.CBLOOP  AIF   (&J GT N'&SYSLIST(&I)).CBEND                             02380000
&LN40    SETB  ('&SYSLIST(&I,&J)' EQ '40CHAR')                          02390000
&LN64    SETB  ('&SYSLIST(&I,&J)' EQ '64CHAR')                          02400000
&LN80    SETB  ('&SYSLIST(&I,&J)' EQ '80CHAR')                          02410000
&LN40    SETB  ('&SYSLIST(&I,&J)' EQ 'CHAR40' OR &LN40)          81328  02420000
&LN64    SETB  ('&SYSLIST(&I,&J)' EQ 'CHAR64' OR &LN64)          81328  02430000
&LN80    SETB  ('&SYSLIST(&I,&J)' EQ 'CHAR80' OR &LN80)          81328  02440000
&STARTPR SETB  ('&SYSLIST(&I,&J)' EQ 'STARTPR')                         02450000
&SAL     SETB  ('&SYSLIST(&I,&J)' EQ 'RING')                            02460000
&SAL     SETB  ('&SYSLIST(&I,&J)' EQ 'ALARM' OR &SAL)                   02470000
&SAL     SETB  ('&SYSLIST(&I,&J)' EQ 'SAL'   OR &SAL)                   02480000
&RSTKBY  SETB  ('&SYSLIST(&I,&J)' EQ 'RESTKBY')                         02490000
&RSTKBY  SETB  ('&SYSLIST(&I,&J)' EQ 'KBYRSTOR' OR &RSTKBY)             02500000
&RSTMDT  SETB  ('&SYSLIST(&I,&J)' EQ 'RESTMDT')                         02510000
&RSTMDT  SETB  ('&SYSLIST(&I,&J)' EQ 'RESETMDT' OR &RSTMDT)             02520000
&K       SETA  &K+&LN40*16+&LN64*32+&LN80*48+&STARTPR*8                 02530000
&K       SETA  &K+&SAL*4+&RSTKBY*2+&RSTMDT                              02540000
.*                                                                      02550000
&PROT    SETB  ('&SYSLIST(&I,&J)' EQ 'PROT')                            02560000
&NUMERIC SETB  ('&SYSLIST(&I,&J)' EQ 'NUM')                             02570000
&SKIP    SETB  ('&SYSLIST(&I,&J)' EQ 'SKIP')                     81328  02580000
&SKIP    SETB  ('&SYSLIST(&I,&J)' EQ 'AUTOSKIP' OR &SKIP)        81328  02590000
&PROT    SETB  (&PROT OR &SKIP)                                  81328  02600000
&NUMERIC SETB  (&NUMERIC OR &SKIP)                               81328  02610000
&DETCT   SETB  ('&SYSLIST(&I,&J)' EQ 'DETCTABLE')                       02620000
&DETCT   SETB  ('&SYSLIST(&I,&J)' EQ 'DECTABLE' OR &DETCT)       83165  02630000
&INT     SETB  ('&SYSLIST(&I,&J)' EQ 'INTENSE')                         02640000
&INT     SETB  ('&SYSLIST(&I,&J)' EQ 'INT' OR &INT)                     02650000
&NONDISP SETB  ('&SYSLIST(&I,&J)' EQ 'NONDISP')                         02660000
&DETCT   SETB  (&DETCT OR &NONDISP)                               *GPP* 02670000
&INT     SETB  (&INT OR &NONDISP)                                 *GPP* 02680000
&MDT     SETB  ('&SYSLIST(&I,&J)' EQ 'MDT')                             02690000
&K       SETA  &K+&PROT*32+&NUMERIC*16+&DETCT*4+&INT*8+&MDT       *GPP* 02700000
&OK      SETB  ('&SYSLIST(&I,&J)' EQ 'NONE' OR &LN40 OR &LN64 OR &LN80) 02710000
&OK      SETB  (&OK OR &STARTPR OR &SAL OR &RSTKBY OR &RSTMDT)          02720000
&OK      SETB  (&OK OR &PROT OR &NUMERIC OR &DETCT OR &INT OR &NONDISP) 02730000
&OK      SETB  (&OK OR &MDT)                                            02740000
         AIF   (&OK).CBBUMP                                             02750000
         MNOTE 12,'SUBPARAMETER #&J OF PARAMETER #&I INVALID - ''&SYSLI*02760000
               ST(&I,&J)'' NOT RECOGNIZED'                              02770000
.CBBUMP  ANOP                                                           02780000
&J       SETA  &J+1                                                     02790000
         AGO   .CBLOOP                                                  02800000
.CBEND   ANOP                                                           02810000
&CH1     SETC  '&TAB3270(&K+1)'                                  87070  02820000
&LABEL   DC    C'&CH1'                                                  02830000
&LABEL   SETC  ''                                                       02840000
         AGO   .NXTI                                                    02850000
.*                                                                      02860000
.WDC     ANOP                                                           02870000
&LABEL   DC    X'27'                    ESCAPE                          02880000
         DC    C'1'                     WRITE DISPLAY CURSOR            02890000
&K       SETA  0                                                        02900000
         AGO   .SETL1                                                   02910000
.*                                                                      02920000
.WRE     ANOP                                                           02930000
&LABEL   DC    X'27'                    ESCAPE                          02940000
         DC    C'5'                     ERASE/WRITE                     02950000
         AGO   .SETL1                                                   02960000
.*                                                                      02970000
.EWA     ANOP  ,                                                 82273  02980000
&LABEL   DC    X'27'                    ESCAPE                   82273  02990000
         DC    C'='                     ERASE/WRITE ALTERNATE    82273  03000000
         AGO   .SETL1                                            82273  03010000
.*                                                               82273  03020000
.EAU     ANOP                                                           03030000
&LABEL   DC    X'27'                    ESCAPE                          03040000
         DC    C'?'                     ERASE ALL UNPROTECTED           03050000
&K       SETA  0                                                        03060000
         AGO   .SETL1                                                   03070000
.*                                                                      03080000
.WSF     ANOP                                                    82273  03090000
&LABEL   DC    X'27'                    ESCAPE                   82273  03100000
         DC    C'3'                     WRITE STRUCTURED FIELD   82273  03110000
&K       SETA  0                                                 82273  03120000
         AGO   .SETL1                                            82273  03130000
.*                                                               82273  03140000
.SBA     ANOP                                                           03150000
&LABEL   DC    X'11'                    SET BUFFER ADDRESS              03160000
&K       SETA  0                                                        03170000
         AGO   .SETL1                                                   03180000
.*                                                                      03190000
.SF      ANOP                                                           03200000
&LABEL   DC    X'1D'                    START FIELD                     03210000
&K       SETA  1                                                        03220000
         AGO   .SETL1                                                   03230000
.*                                                                      03240000
.SFE     ANOP                                                    82273  03250000
&LABEL   DC    X'29'                    START FIELD EXTENDED     82273  03260000
&K       SETA  1                                                 82273  03270000
         AGO   .SETL1                                            82273  03280000
.*                                                               82273  03290000
.SA      ANOP                                                    82273  03300000
&LABEL   DC    X'28'                    SET ATTRIBUTE            82273  03310000
&K       SETA  0                                                 82273  03320000
         AGO   .SETL1                                            82273  03330000
.*                                                               82273  03340000
.MF      ANOP                                                    82273  03350000
&LABEL   DC    X'2C'                    MODIFY FIELD             82273  03360000
&K       SETA  1                                                 82273  03370000
         AGO   .SETL1                                            82273  03380000
.*                                                               82273  03390000
.IC      ANOP                                                           03400000
&LABEL   DC    X'13'                    INSERT CURSOR                   03410000
&K       SETA  0                                                        03420000
         AGO   .SETL1                                                   03430000
.*                                                                      03440000
.PT      ANOP                                                           03450000
&LABEL   DC    X'05'                    PROGRAM TAB                     03460000
&K       SETA  0                                                        03470000
         AGO   .NOL1                                                    03480000
.*                                                                      03490000
.RA      ANOP                                                           03500000
&LABEL   DC    X'3C'                    REPEAT TO ADDRESS               03510000
&K       SETA  0                                                        03520000
&SCRNRAF SETA  1             AFTER NEXT ADDRESS, ADJUST BY 1     89300  03530000
         AGO   .NOL1                                                    03540000
.*                                                                      03550000
.EUA     ANOP                                                           03560000
&LABEL   DC    X'12'                    ERASE UNPROTECTED TO ADDRESS    03570000
&K       SETA  0                                                        03580000
         AGO   .NOL1                                                    03590000
.*                                                               89258  03600000
.COLOR   ANOP  ,                                                 89258  03610000
&LABEL   DC    X'42'         FOREGROUND COLOR                    89258  03620000
&K       SETA  0                                                 89258  03630000
         AGO   .NOL1                                             89258  03640000
.*                                                               89258  03650000
.HIGHLIT ANOP  ,                                                 89258  03660000
&LABEL   DC    X'41'         EXTENDED HIGHLIGHTING               89258  03670000
&K       SETA  0                                                 89258  03680000
         AGO   .NOL1                                             89258  03690000
.*                                                               89258  03700000
.ATTR    ANOP  ,                                                 89258  03710000
&LABEL   DC    X'C0'         FIELD ATTRIBUTE                     89258  03720000
&K       SETA  0                                                 89258  03730000
         AGO   .NOL1                                             89258  03740000
.*                                                               89258  03750000
.UNDER   ANOP  ,                                                 89258  03760000
&LABEL   DC    X'F4'         UNDERLINE (NORMAL, NOT FIELD)       89258  03770000
&K       SETA  0                                                 89258  03780000
         AGO   .NOL1                                             89258  03790000
.*                                                               89258  03800000
.REVERSE ANOP  ,                                                 89258  03810000
&LABEL   DC    X'F2'         REVERSE                             89258  03820000
&K       SETA  0                                                 89258  03830000
         AGO   .NOL1                                             89258  03840000
.*                                                               89258  03850000
.BLINK   ANOP  ,                                                 89258  03860000
&LABEL   DC    X'F1'         BLINK                               89258  03870000
&K       SETA  0                                                 89258  03880000
         AGO   .NOL1                                             89258  03890000
.*                                                               89258  03900000
.BLUE    ANOP  ,                                                 89258  03910000
&LABEL   DC    X'F1'         DARK (UNREADABLE) BLUE              89258  03920000
&K       SETA  0                                                 89258  03930000
         AGO   .NOL1                                             89258  03940000
.*                                                               89258  03950000
.RED     ANOP  ,                                                 89258  03960000
&LABEL   DC    X'F2'         RED                                 89258  03970000
&K       SETA  0                                                 89258  03980000
         AGO   .NOL1                                             89258  03990000
.*                                                               89258  04000000
.PINK    ANOP  ,                                                 89258  04010000
&LABEL   DC    X'F3'         MAGENTA ?                           89258  04020000
&K       SETA  0                                                 89258  04030000
         AGO   .NOL1                                             89258  04040000
.*                                                               89258  04050000
.GREEN   ANOP  ,                                                 89258  04060000
&LABEL   DC    X'F4'         GREEN                               89258  04070000
&K       SETA  0                                                 89258  04080000
         AGO   .NOL1                                             89258  04090000
.*                                                               89258  04100000
.TURQ    ANOP  ,                                                 89258  04110000
&LABEL   DC    X'F5'         CYAN (TURQOISE IS TOO FANCY)        89258  04120000
&K       SETA  0                                                 89258  04130000
         AGO   .NOL1                                             89258  04140000
.*                                                               89258  04150000
.YELLOW  ANOP  ,                                                 89258  04160000
&LABEL   DC    X'F6'         YELLOW                              89258  04170000
&K       SETA  0                                                 89258  04180000
         AGO   .NOL1                                             89258  04190000
.*                                                               89258  04200000
.WHITE   ANOP  ,                                                 89258  04210000
&LABEL   DC    X'F7'         WHITE/TRIPLE-PLANE SELECT           89258  04220000
&K       SETA  0                                                 89258  04230000
         AGO   .NOL1                                             89258  04240000
.*                                                                      04250000
.NULL    ANOP                                                           04260000
&LABEL   DC    X'00'                    NULL                            04270000
&K       SETA  0                                                 81328  04280000
         AGO   .SETL1                                            81328  04290000
.*                                                               81328  04300000
.BLANK   ANOP  ,                                                 81328  04310000
&LABEL   DC    C' '                BLANK                         81328  04320000
&K       SETA  0                                                 81328  04330000
         AGO   .SETL1                                            81328  04340000
.*                                                                      04350000
.LABEL   AIF   ('&LABEL' EQ '').SETL                             80203  04360000
&LABEL   EQU   *                                                 80203  04370000
.SETL    ANOP  ,                                                 80203  04380000
&LABEL   SETC  '&SYSLIST(&I)'(1,K'&SYSLIST(&I)-1)                       04390000
         AGO   .NXTI                                                    04400000
.*                                                                      04410000
.LABEL1  ANOP                                                           04420000
&LABEL1  SETC  '&SYSLIST(&I)'(1,K'&SYSLIST(&I)-1)                       04430000
         AGO   .NXTI                                                    04440000
.*                                                                      04450000
.DSC     ANOP                                                           04460000
&J       SETA  3                                                        04470000
.DSLOOP  AIF   (&J GT K'&SYSLIST(&I)).DSEND                             04480000
         AIF   ('&SYSLIST(&I)'(&J,1) EQ '''').DSQ                       04490000
         AIF   ('&SYSLIST(&I)'(&J,1) LT '0').DSL                        04500000
&J       SETA  &J+1                                                     04510000
         AGO   .DSLOOP                                                  04520000
.DSL     MNOTE 12,'PARAMETER #&I INVALID - &SYSLIST(&I) NOT DS OPERAND' 04530000
         MEXIT                                                          04540000
.DSQ     ANOP                                                           04550000
&CH1     SETC  '&SYSLIST(&I)'(3,&J-3)                                   04560000
&K       SETA  &CH1                                                     04570000
&LABEL   DC    &SYSLIST(&I)                                             04580000
         AGO   .SETL1                                                   04590000
.DSEND   ANOP                                                           04600000
&CH1     SETC  '&SYSLIST(&I)'(3,&J-3)                                   04610000
&K       SETA  &CH1                                                     04620000
&LABEL   DS    &SYSLIST(&I)                                             04630000
         AGO   .SETL1                                                   04640000
.DSA     ANOP                                                           04650000
&LABEL   DC    &SYSLIST(&I)                                             04660000
&LABEL   SETC  ''                                                       04670000
         AGO   .NXTI                                                    04680000
.*                                                                      04690000
.END     AIF   ('&LABEL' EQ '').SOF                              80203  04700000
&LABEL   EQU   *                                                 80203  04710000
         MEXIT ,                                                 80203  04720000
.*                                                                      04730000
.NOLIST  MNOTE 12,'BUFFER LIST OMITTED'                                 04740000
.SOF     MEND  ,                                                 80203  04750000
./ ADD NAME=SCROPEN
         MACRO                                                          00010000
&NM      SCROPEN &WORK,&DEV=,&OPT=                                      00020000
         LCLA  &I,&J                                                    00030000
         LCLB  &A,&D,&W,&S                                       87317  00040000
&J       SETA  N'&OPT                                                   00050000
.OPTL    ANOP  ,                                                        00060000
&I       SETA  &I+1                                                     00070000
         AIF   (&I GT &J).OPTN                                          00080000
         AIF   ('&OPT(&I)' EQ '').OPTL                                  00090000
&A       SETB  (&A OR '&OPT(&I)' EQ 'ABE' OR '&OPT(&I)' EQ 'ABEND')     00100000
&D       SETB  (&D OR '&OPT(&I)' EQ 'DUMMY')                            00110000
&W       SETB  (&W OR '&OPT(&I)' EQ 'NOWTO')                            00120000
&S       SETB  (&S OR '&OPT(&I)' EQ 'SA')                        87317  00130000
         AGO   .OPTL                                                    00140000
.OPTN    ANOP  ,                                                        00150000
&I       SETA  128*&A+64*&D+32*&W+8*&S                           87317  00160000
&NM      SCRCOM 0,0,2,&I,&WORK,DEV=&DEV                                 00170000
         MEND  ,                                                        00180000
./ ADD NAME=SCRPAGE
         MACRO                                                          00010000
&NM      SCRPAGE &FDW,&DEV=                                             00020000
&NM      SCRCOM 0,0,7,,&FDW,DEV=&DEV  EXPAND REQUEST                    00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRSCAN
         MACRO                                                          00010000
&NM      SCRSCAN &FDW,&DEV=                                      87312  00020000
&NM      SCRCOM 0,0,9,,&FDW,DEV=&DEV  EXPAND REQUEST                    00030000
         MEND  ,                                                        00040000
./ ADD NAME=SCRWORK
         MACRO                                                          00010000
&NM      SCRWORK &DD,&ALTDD,&TITLE=0,&FOOTER=0,&LPP=0,&WIDTH=0,        *00020000
               &FILL=0,&PAGE=,&SPAGE=,&PGUP=NO,&EXLST=,&AM=VTAM,       *00030000
               &COL=7,&HIL=7                                     87306  00040000
         LCLA  &PFG,&I,&J,&K                                     84169  00050000
         AIF   ('&PAGE' EQ '').NOPG                              81155  00060000
&I       SETA  &PAGE                                                    00070000
&PFG     SETA  1             SET PAGE FEED-BACK                         00080000
.NOPG    AIF   ('&SPAGE' EQ '').NOSPG                                   00090000
&J       SETA  &SPAGE                                                   00100000
&PFG     SETA  1             SET PAGE FEED-BACK                         00110000
.NOSPG   AIF   ('&PGUP' EQ 'NO').NOPGUP                          84169  00120000
&PFG     SETA  3             SET UPDATING BY USER                84169  00130000
         AIF   ('&AM' EQ 'BTAM').NOAM                            87306  00140000
         AIF   ('&AM' EQ '' OR '&AM' EQ 'VTAM').DOVTAM           87306  00150000
         MNOTE 4,'INVALID ACCESS METHOD AM=&AM'                  87306  00160000
.DOVTAM  ANOP  ,                                                 87306  00170000
&PFG     SETA  &PFG+128      ACCESS METHOD BIT                   87306  00180000
.NOAM    AIF   ('&PGUP' EQ '' OR '&PGUP' EQ 'YES').NOPGUP        84169  00190000
         MNOTE 4,'INVALID PGUP OPTION : &PGUP'                   84169  00200000
.NOPGUP  AIF   ('&EXLST' EQ '').NOLST1                           84169  00210000
&PFG     SETA  &PFG+4        SET EXIT LIST FLAG                  84169  00220000
.NOLST1  ANOP  ,                                                 84169  00230000
&NM      DC    0H'0',CL8'&DD ',CL8'&ALTDD ',AL1(&HIL,&LPP,&FILL,&WIDTH,*00240000
               &TITLE,&FOOTER,&COL,&PFG)                         87306  00250000
&K       SETA  &PFG-(&PFG/2*2)                                   84169  00260000
         AIF   (&K NE 1).NOLST2                                  84169  00270000
         DC    Y(&I,&J)      PAGE/SUB-PAGE FEEDBACK AREA                00280000
.NOLST2  AIF   ('&EXLST' EQ '').MEND                             84169  00290000
         DC    AL4(&EXLST)   EXIT LIST POINTER                   84169  00300000
.MEND    MEND  ,                                                        00310000
./ ADD NAME=SERVCALC
         MACRO                                                          00010000
&NAME   SERVCALC &FUNCTN=,&DEVTAB=,&TYPE=,&UCB=,&BALANCE=,&REMOVE=,    *00020000
               &MAXSIZE=,&REGSAVE=,&RKDD=,&R=,&K=,&DD=,&LAST=,&MF=I     00030000
.***** START OF SPECIFICATIONS **************************************** 00040000
.*                                                                      00050000
.* MODULE NAME - SERVCALC;  ADAPTED FROM IBM'S TRKCALC MACRO     82105  00060000
.*                                                                      00070000
.* DESCRIPTIVE NAME -                                                   00080000
.*      SYSTEM TRACK ALGORITHM ROUTINE (STAR) SERVICE MACRO             00090000
.*                                                                      00100000
.* COPYRIGHT - NONE (PRE MVS/SE)                                        00110000
.*                                                                      00120000
.* STATUS - NEW                                                         00130000
.*                                                                      00140000
.* FUNCTION -                                                           00150000
.*    THIS MACRO, DEPENDING ON THE VALUE OF THE "MF" PARAMETER,         00160000
.*    PERFORMS ONE OF FOUR BASIC FUNCTIONS RELATED TO ESTABLISHING      00170000
.*    OR MAPPING THE INPUT PARAMETER LIST FOR THE SYSTEM TRACK          00180000
.*    ALGORITHM ROUTINE (STAR). THE FOUR FUNCTIONS ARE DESCRIBED        00190000
.*    BELOW:                                                            00200000
.*                                                                      00210000
.*    MF=I - DEFAULT - WITH A SPECIFICATION OF MF=I, THIS MACRO         00220000
.*       WILL ALLOCATE STORAGE FOR THE STAR PARAMETER LIST AND          00230000
.*       INITIALIZE IT ACCORDING TO THE OPTIONS SELECTED VIA THE        00240000
.*       ALLOWABLE KEYWORDS (SEE BELOW FOR KEYWORD DESCRIPTIONS).       00250000
.*       THIS IS CALLED THE STANDARD-FORM (INSTRUCTION FORMAT) OF       00260000
.*       THE MACRO.                                                     00270000
.*    MF=E - THIS SPECIFICATION WILL RESULT IN THE INITIALIZATION       00280000
.*       OF AN ALREADY EXISTING STAR PARAMETER LIST. THE ADDRESS        00290000
.*       OF THE EXISTING PARAMETER LISTS IS PROVIDED VIA A SECOND       00300000
.*       SUBPARAMETER OF THE "MF" KEYWORD. (SEE THE SECTION BELOW       00310000
.*       ON KEYWORDS FOR THE SOURCE OF THE INITIALIZATION DATA).        00320000
.*       THIS IS CALLED THE EXECUTE-FORM OF THE MACRO.                  00330000
.*                                                                      00340000
.*    NOTE - NO KEYWORDS ARE PROCESSED FOR THE FOLLOWING MACRO FORMS.   00350000
.*                                                                      00360000
.*    MF=L - THIS SPECIFICATION WILL RESULT IN THE ALLOCATION           00370000
.*       OF THE STAR PARAMETER LIST WITHOUT INITIALIZATION. THIS IS     00380000
.*       CALLED THE LIST-FORM OF THE MACRO.                             00390000
.*    MF=D - THIS SPECIFICATION WILL RESULT IN THE GENERATION OF A      00400000
.*       MAPPING OF THE SYMBOLS USED TO ADDRESS THE FIELDS AND          00410000
.*       FLAGS OF THE STAR PARAMETER LIST. THE CALLER MUST PROVIDE      00420000
.*       A "DSECT" STATEMENT IN ORDER TO OBTAIN SYMBOLIC ADDRESSING     00430000
.*       WITHOUT STORAGE ALLOCATION. THIS IS CALLED THE DSECT-FORM      00440000
.*       OF THE MACRO.                                                  00450000
.*                                                                      00460000
.*    KEYWORDS- (APPLICABLE ONLY FOR MF=I AND MF=E FORMS)               00470000
.*       FUNCTN - USED TO REQUEST TRACK BALANCE (TRKBAL) OR TRACK       00480000
.*          CAPACITY (TRKCAP) FUNCTIONS.                                00490000
.*       NOTE 1 - A SPECIAL OPTION IS PROVIDED TO ALLOW A TRKCALC CALL  00500000
.*                WITH THE 'FUNCTN' KEYWORD OMITTED. THIS OPTION IS     00510000
.*                ALLOWED ONLY IF THE KEYWORD MF=E IS CODED. IF THE     00520000
.*                'FUNCTN' KEYWORD IS OMITTED, NO INSTRUCTION WILL BE   00530000
.*                GENERATED TO SET THE PARAMETER LIST FLAGS. THUS,      00540000
.*                THE MUTUALLY EXCLUSIVE TEST FOR FUNCTN=TRKCAP AND     00550000
.*                REMOVE=YES, MAXSIZE=YES, AND LAST=YES IS BYPASSED.    00560000
.*                ALSO, THE FOLLOWING NOTE (2) DOES NOT APPLY.          00570000
.*       NOTE 2 - ONE OF THE FOLLOWING THREE KEYWORDS (DEVTAB,          00580000
.*                TYPE, OR UCB) MUST BE PROVIDED WHEN THE 'FUNCTN'      00590000
.*                KEYWORD IS CODED. THIS IS TO ENSURE A SOURCE FOR THE  00600000
.*                DEVICE CHARACTERISTICS TABLE. IF THE PARAMETER LIST   00610000
.*                HAS BEEN PREVIOUSLY SET WITH A SOURCE, THEN AN '*'    00620000
.*                SHOULD BE CODED AS THE INPUT VALUE FOR THE PROPER     00630000
.*                SOURCE KEYWORD. THIS WILL RESULT IN THE PROPER SOURCE 00640000
.*                FLAG SETTING WITHOUT ACTUALLY GENERATING THE CODE TO  00650000
.*                STORE THE DVCT.                                       00660000
.*       DEVTAB - USED TO SUPPLY THE ADDRESS OF THE DEVICE CHARACTER-   00670000
.*          ISTICS TABLE ENTRY.                                         00680000
.*       TYPE - USED TO SUPPLY THE UCB DEVICE TYPE VIA THE LOW ORDER    00690000
.*          BYTE OF A REGISTER OR AN ADDRESS. UCB TYPE IS USED BY STAR  00700000
.*          TO FIND THE DEVICE CHARACTERISTICS TABLE ENTRY.             00710000
.*       UCB - USED TO PROVIDE THE ADDRESS OF THE UCB. STAR WILL        00720000
.*          EXTRACT THE DEVICE TYPE TO FIND THE PROPER DEVICE CHAR-     00730000
.*          ACTERISTICS TABLE ENTRY.                                    00740000
.*       BALANCE - USED TO PROVIDE THE ADDRESS OF A TRACK BALANCE TO BE 00750000
.*          USED BY STAR IN THE CAPACITY AND BALANCE ALGORITHMS.        00760000
.*       RKDD - USED TO SUPPLY THE ADDRESS OF A FULL WORD CONTAINING    00770000
.*          A RECORD NUMBER, KEY LENGTH, AND DATA LENGTH OR TO DESIG-   00780000
.*          NATE A REGISTER CONTAINING SAME. THE FOLLOWING THREE KEY-   00790000
.*          WORDS SUPPLY THE SAME DATA, BUT FROM SEPARATE SOURCES.      00800000
.*                                                                      00810000
.*       NOTE - THE FOLLOWING THREE KEYWORDS PROVIDE THE CAPABILITY     00820000
.*              FOR THE CALLER TO CODE THE RECORD NUMBER, KEY LENGTH,   00830000
.*              AND DATA LENGTH AS SELF-DEFINING DECIMAL VALUES         00840000
.*              (REFERRED TO HERE AS IMMEDITATE DATA).                  00850000
.*                                                                      00860000
.*       R - USED TO PROVIDE THE SUBJECT RECORD NUMBER VIA THE LOW-     00870000
.*           ORDER BYTE OF A REGISTER, A STORAGE ADDRESS, OR IMMEDIATE  00880000
.*           DATA.                                                      00890000
.*       K - USED TO PROVIDE THE SUBJECT KEY LENGTH VIA THE LOW-ORDER   00900000
.*           BYTE OF A REGISTER, A STORAGE ADDRESS, OR IMMEDIATE        00910000
.*           DATA.                                                      00920000
.*       DD - USED TO PROVIDE THE SUBJECT DATA LENGTH VIA THE LOW-ORDER 00930000
.*           BYTE OF A REGISTER, A STORAGE ADDRESS, OR IMMEDIATE        00940000
.*           DATA.                                                      00950000
.*                                                                      00960000
.*       NOTE - THE FOLLOWING THREE KEYWORDS (REMOVE, MAXSIZE, AND      00970000
.*              LAST) ARE VALID ONLY WHEN 'FUNCTN=TRKBAL' IS CODED.     00980000
.*              THEY ARE IGNORED IF 'FUNCTN' IS OMITTED.                00990000
.*                                                                      01000000
.*       REMOVE - OPTIONALLY USED TO REQUEST THE DELETION OF A RECORD   01010000
.*          DURING A TRACK BALANCE REQUEST.                             01020000
.*       MAXSIZE - OPTIONALLY USED TO REQUEST A COUNT OF THE RESIDUAL   01030000
.*          DATA BYTES ON A TRACK AFTER IT IS FOUND THAT ANOTHER WHOLE  01040000
.*          RECORD WILL NOT FIT DURING A TRACK BALANCE REQUEST.         01050000
.*       LAST - A SPECIAL OPTION MADE AVAILABLE FOR ISAM. IF SPECIFIED, 01060000
.*          THE OVERHEAD FOR THE LAST RECORD IS USED IN CALCULATING     01070000
.*          A NEW TRACK BALANCE.                                        01080000
.*       REGSAVE - DEFINED FOR COMPATIBILITY WITH TRKCALC; NOT USED     01090000
.*          THE CALL TO @SERVICE PRESERVES REGISTERS 2-13        82105  01100000
.*       MF - USED TO SPECIFY WHICH FORM OF THE TRKCALC MACRO IS        01110000
.*          DESIRED. SEE OPENING PARAGRAPH ABOVE.                       01120000
.*                                                                      01130000
.*    INTERNAL PROCESSING FOR THE I AND E FORMS OF THE MACRO IS         01140000
.*    CONTROLLED BY A NUMBER OF LOCAL BINARY AND CHARACTER              01150000
.*    VARIABLES. THE L AND D FORMS OF THE MACRO ARE HANDLED BY          01160000
.*    DIRECT PATHS THROUGH THE MACRO AND AS SUCH DO NOT INVOLVE THE     01170000
.*    USE OF LOCAL VARIABLES. FOLLOWING ARE THE DESCRIPTIONS OF THE     01180000
.*    THE LOCAL VARIABLES USED FOR THE I AND E FORMS:                   01190000
.*                                                                      01200000
.*    LCLC'S -                                                          01210000
.*       &FUNFLG - 'B' = TRKBAL FUNCTION REQUESTED                      01220000
.*               - 'C' = TRKCAP FUNCTION REQUESTED                      01230000
.*               - (OMITTED) = USE FUNCTION FLAGS FROM LAST CALL        01240000
.*       &SAVAREA - 'NO' = DON'T SAVE AND RESTORE REGISTERS             01250000
.*                  'YES' = SAVE AND RESTORE REGISTERS                  01260000
.*       &SET(1) - DVCT SOURCE WITH POSSIBLE PARENTHESES REMOVED: DVCT  01270000
.*                 ADDRESS, UCB ADDRESS, OR DEVICE TYPE (ADDRESS        01280000
.*                 OR IMMEDIATE DATA)                                   01290000
.*       &SET(2) - RKDD PARAMETER VALUE WITH POSSIBLE PARENTHESES       01300000
.*                 REMOVED                                              01310000
.*       &SET(3) - R PARAMETER VALUE WITH POSSIBLE PARENTHESES REMOVED  01320000
.*       &SET(4) - K PARAMETER VALUE WITH POSSIBLE PARENTHESES REMOVED  01330000
.*       &SET(5) - DD PARAMETER VALUE WITH POSSIBLE PARENTHESES REMOVED 01340000
.*       &SET(6) - BALANCE PARAMETER VALUE WITH POSSIBLE PARENTHESES    01350000
.*                 REMOVED                                              01360000
.*       &SKIP - 'P3' = RKDD PARAMETER NOT SPECIFIED                    01370000
.*       &FLGA(1) - 'R' = &SET(1) (DVCT SOURCE PARAMETER) IS IN         01380000
.*                        REGISTER FORMAT                               01390000
.*                - 'A' = &SET(1) (DVCT SOURCE PARAMETER) IS IN ADDRESS 01400000
.*                        FORMAT                                        01410000
.*       &FLGA(2) - 'R' = RKDD PARAMETER IS IN REGISTER FORMAT          01420000
.*                - 'A' = RKDD PARAMETER IS IN ADDRESS FORMAT           01430000
.*       &FLGA(3) - 'R' = BALANCE PARAMETER IS IN REGISTER OR IMMED-    01440000
.*                        IATE DATA FORMAT                              01450000
.*                - 'A' = BALANCE PARAMETER IS IN ADDRESS FORMAT        01460000
.*       &FLGA(4) - 'R' = R PARAMETER IS IN REGISTER FORMAT             01470000
.*       &FLGA(5) - 'R' = K PARAMETER IS IN REGISTER FORMAT             01480000
.*       &FLGA(6) - 'R' = DD PARAMETER IS IN REGISTER FORMAT            01490000
.*       &LABEL - AID TO VARIABLE LABEL ASSIGNMENT                      01500000
.*       &BITS - USED TO COLLECT BIT SWITCHES FOR STAR PARM FLAGS       01510000
.*                                                                      01520000
.*    LCLB'S                                                            01530000
.*       &BIT(1) - 0 = TRKBAL REQUESTED OR FUNCTN WAS OMITTED           01540000
.*               - 1 = TRKCAP REQUESTED                                 01550000
.*       &BIT(2) - 0 = REMOVE OPTION NOT REQUESTED                      01560000
.*               - 1 = REMOVE OPTION REQUESTED                          01570000
.*       &BIT(3) - 0 = MAXSIZE OPTION NOT REQUESTED                     01580000
.*               - 1 = MAXSIZE OPTION REQUESTED                         01590000
.*       &BIT(4) - 0 = BALANCE NOT PROVIDED CALLER                      01600000
.*               - 1 = BALANCE PROVIDED BY CALLER                       01610000
.*       &BIT(5) - 0 = LAST OPTION NOT REQUESTED                        01620000
.*               - 1 = LAST OPTION REQUESTED                            01630000
.*       &BIT(6&7) - 00 = DVCT ENTRY ADDRESS PROVIDED                   01640000
.*                   01 = NOT USED                                      01650000
.*                   10 = UCB ADDRESS PROVIDED                          01660000
.*                   11 = DEVICE TYPE (ADDRESS OR IMMEDIATE) PROVIDED   01670000
.*       &QUIT - 0 = SUCCESSFUL PARAMETER LIST CONSTRUCTION             01680000
.*             - 1 = ERRORS DETECTED. DO NOT GENERATE ANY CODE          01690000
.*       &MSG - 0 = NO INFORMATION/WARNING MESSAGES ISSUED              01700000
.*              1 = INFORMATION/WARNING MESSAGES ISSUED                 01710000
.*                                                                      01720000
.* NOTES - EXECUTABLE CODE RESIDES IN @SERVICE, FUNCTION TRKCP   82105  01730000
.*                                                                      01740000
.* MACROS - IHBINNRA                                                    01750000
.*                                                                      01760000
.***** END OF SPECIFICATIONS ****************************************** 01770000
         LCLC  &FUNFLG,&SAVAREA,&SET(6),&SKIP,&FLGA(6),&LABEL,&BITS     01780000
         LCLB  &BIT(7),&QUIT,&MSG                                       01790000
&LABEL   SETC  '&NAME'                                                  01800000
         AIF   ('&MF' EQ 'L').LIST      BR IF LIST OPTION               01810000
         AIF   ('&MF' EQ 'D').DSECT     BR IF DSECT OPTION              01820000
*                                                                       01830000
*   STAR USES REGISTERS; 0(OUTPUT),1,9,10,11,14, AND 15(RETURN CODE)    01840000
*                                                                       01850000
.********************************************************************** 01860000
.*    KEYWORD SYNTAX CHECKING FOLLOWS                                   01870000
.********************************************************************** 01880000
.*                                                                      01890000
.********************************************************************** 01900000
.*    CHECK SYNTAX OF REGSAVE KEYWORD                                   01910000
.********************************************************************** 01920000
         AIF   (T'&REGSAVE EQ 'O').NOSAVE                               01930000
         AIF   ('&REGSAVE' EQ 'NO').NOSAVE                              01940000
         AIF   ('&REGSAVE' EQ 'YES').SAVE                               01950000
         SPACE 1                                                        01960000
         MNOTE 0,'REGSAVE= OPERAND NOT RECOGNIZED; ''NO'' IS ASSUMED'   01970000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         01980000
.NOSAVE  ANOP  ,                                                        01990000
&SAVAREA SETC  'NO'                     INDICATE REG SAVING NOT REQ'D   02000000
         AGO   .SYNTAX                                                  02010000
.SAVE    ANOP  ,                                                        02020000
*   REGSAVE OPTION SPECIFIED; ALL REGISTERS BUT 0 AND 15 WILL BE        02030000
*   SAVED AND RESTORED.                                                 02040000
*                                                                       02050000
&SAVAREA SETC  'YES'                    INDICATE REG SAVING REQ'D       02060000
.********************************************************************** 02070000
.*    SYNTAX CHECK OF FUNCTN KEYWORD                                    02080000
.********************************************************************** 02090000
.SYNTAX  ANOP  ,                                                        02100000
         AIF   (T'&FUNCTN EQ 'O').NOFUNC                                02110000
         AIF   ('&FUNCTN' EQ 'TRKBAL').BALFUN                           02120000
         AIF   ('&FUNCTN' EQ 'TRKCAP').CAPFUN                           02130000
         SPACE 1                                                        02140000
         MNOTE 8,'FUNCTN= OPERAND INVALID; PROCESSING TERMINATED'       02150000
         SPACE 1                                                        02160000
         MEXIT ,                        ABORT - CAN'T VALIDATE          02170000
.*                                      REMAINING KEYWORD CONFLICTS     02180000
.NOFUNC  ANOP  ,                                                        02190000
         AIF   ('&MF' NE 'I').NOPROBM   FUNCTN OMITTED AND MF=E IS OK   02200000
         SPACE 1                                                        02210000
         MNOTE 8,'FUNCTN= CAN NOT BE OMITTED WITH MF=I; PROCESSING TERM*02220000
               INATED'                                                  02230000
         SPACE 1                                                        02240000
         MEXIT ,                                                        02250000
.BALFUN  ANOP  ,                                                        02260000
&FUNFLG  SETC  'B'                      INDICATE TRKBAL REQ'D           02270000
.NOPROBM ANOP  ,                                                        02280000
&BIT(1)  SETB  0                        SET TRKBAL/OMITTED FLG FOR      02290000
.*                                      STAR PARMS                      02300000
         AGO   .TRKC010                                                 02310000
.CAPFUN  ANOP  ,                                                        02320000
&FUNFLG  SETC  'C'                      INDICATE TRKCAP REQ'D           02330000
&BIT(1)  SETB  1                        SET TRKCAP FLG FOR STAR PARMS   02340000
.********************************************************************** 02350000
.*   CHECK SYNTAX OF DEVTAB KEYWORD                                     02360000
.********************************************************************** 02370000
.TRKC010 ANOP  ,                                                        02380000
&BIT(6)  SETB  0                        INIT SOURCE FLAGS               02390000
&BIT(7)  SETB  0                        FOR DVCT ADDR                   02400000
         AIF   (T'&DEVTAB EQ 'O').TRKC020                               02410000
         AIF   ('&DEVTAB'(1,1) NE '(').DEVADDR                          02420000
         AIF   (N'&DEVTAB GT 1).DEVBAD                                  02430000
&SET(1)  SETC  '&DEVTAB(1)'             SAVE KEYW VALUE W/O PARENS      02440000
&FLGA(1) SETC  'R'                      INDICATE REG-FORM               02450000
         AGO   .TRKC020                 ON TO NEXT KEYW                 02460000
.DEVADDR ANOP  ,                                                        02470000
&SET(1)  SETC  '&DEVTAB'                SAVE KEYW VALUE                 02480000
&FLGA(1) SETC  'A'                      INDICATE ADDR-FORM              02490000
         AGO   .TRKC020                 ON TO NEXT KEYW                 02500000
.DEVBAD  ANOP  ,                                                        02510000
         SPACE 1                                                        02520000
         MNOTE 8,'DEVTAB= OPERAND INVALID; NO CODE PRODUCED'            02530000
&QUIT    SETB  1                        DEFER TERMINATION               02540000
.********************************************************************** 02550000
.*  CHECK SYNTAX OF TYPE KEYWORD                                        02560000
.********************************************************************** 02570000
.TRKC020 ANOP  ,                                                        02580000
         AIF   (T'&TYPE EQ 'O').TRKC030                                 02590000
         AIF   ('&FLGA(1)' NE '').DEVBAD2  HAVE DVCT SOURCE ALREADY?    02600000
         AIF   ('&TYPE'(1,1) NE '(').TYPADDR                            02610000
         AIF   (N'&TYPE GT 1).TYPEBAD                                   02620000
&SET(1)  SETC  '&TYPE(1)'               SAVE KEYW VALUE W/O PARENS      02630000
&FLGA(1) SETC  'R'                      INDICATE REG-FORM               02640000
         AGO   .SETTYPE                 ON TO SETTING OF TYPE FLG       02650000
.TYPADDR ANOP  ,                                                        02660000
&SET(1)  SETC  '&TYPE'                  SAVE KEYW VALUE                 02670000
&FLGA(1) SETC  'A'                      INDICATE ADDR-FORM              02680000
.SETTYPE ANOP  ,                                                        02690000
&BIT(6)  SETB  1                        SET TYPE FLGS FOR               02700000
&BIT(7)  SETB  1                        STAR PARMS                      02710000
         AGO   .TRKC030                 ON TO NEXT KEYW                 02720000
.TYPEBAD ANOP  ,                                                        02730000
         SPACE 1                                                        02740000
         MNOTE 8,'TYPE= OPERAND INVALID; NO CODE PRODUCED'              02750000
&QUIT    SETB  1                        DEFER TERMINATION               02760000
.********************************************************************** 02770000
.*  CHECK SYNTAX OF UCB KEYWORD                                         02780000
.********************************************************************** 02790000
.TRKC030 ANOP  ,                                                        02800000
         AIF   (T'&UCB EQ 'O').TRKC040                                  02810000
         AIF   ('&FLGA(1)' NE '').DEVBAD2  HAVE DVCT SOURCE ALREADY?    02820000
         AIF   ('&UCB'(1,1) NE '(').UCBADDR                             02830000
         AIF   (N'&UCB GT 1).UCBBAD                                     02840000
&SET(1)  SETC  '&UCB(1)'                SAVE KEYW VALUE W/O PARENS      02850000
&FLGA(1) SETC  'R'                      INDICATE REG-FORM               02860000
         AGO   .SETUCB                  ON TO SETTING UCB FLG           02870000
.UCBADDR ANOP  ,                                                        02880000
&SET(1)  SETC  '&UCB'                   SAVE KEYW VALUE                 02890000
&FLGA(1) SETC  'A'                      INDICATE ADDR-FORM              02900000
.SETUCB  ANOP  ,                                                        02910000
&BIT(6)  SETB  1                        SET UCB FLG FOR STAR PARMS      02920000
         AGO   .TRKC040                 ON TO NEXT KEYW                 02930000
.DEVBAD2 ANOP  ,                                                        02940000
         SPACE 1                                                        02950000
         MNOTE 8,'DEVTAB=, TYPE=, AND UCB= OPERANDS ARE MUTUALLY EXCLUS*02960000
               IVE;              NO CODE PRODUCED'                      02970000
&QUIT    SETB  1                        DEFER TERMINATION               02980000
         AGO   .TRKC040                 ON TO NEXT KEYW                 02990000
.UCBBAD  ANOP  ,                                                        03000000
         SPACE 1                                                        03010000
         MNOTE 8,'UCB= OPERAND INVALID; NO CODE PRODUCED'               03020000
&QUIT    SETB  1                        DEFER TERMINATION               03030000
.********************************************************************** 03040000
.*  ENSURE THAT A SOURCE (DEVTAB, UCB, OR TYPE) FOR THE DEVICE CHAR-    03050000
.*  ACTERISTICS TABLE WAS PROVIDED. IF NOT, DEFAULT TO A RESIDUAL       03060000
.*  DEVTAB ADDRESS AS THE DVCT SOURCE.                                  03070000
.********************************************************************** 03080000
.TRKC040 ANOP  ,                                                        03090000
         AIF   (T'&FUNCTN EQ 'O').TRKC045  BR, IF FUNCTN NOT PROVIDED - 03100000
.*                                      SOURCE ASSUMED, FLGS NOT SET    03110000
         AIF   ('&FLGA(1)' NE '').TRKC045  BR, IF DVCT SOURCE GIVEN     03120000
.*  AT THIS POINT IF &QUIT=1, THE CALLER PROVIDED A SOURCE FOR THE      03130000
.*  DVCT BUT IT WAS IN ERROR.                                           03140000
         AIF   (&QUIT).TRKC045          BR, IF &QUIT=1                  03150000
         SPACE 1                                                        03160000
         MNOTE 4,'DVCT SOURCE (DEVTAB=, UCB=, OR TYPE=) IS MISSING;    *03170000
                DEVTAB=* IS ASSUMED'                                    03180000
&SET(1)  SETC  '*'                      INDICATE A RESIDUAL DEVTAB      03190000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         03200000
.********************************************************************** 03210000
.*  CHECK SYNTAX OF RKDD KEYWORD                                        03220000
.********************************************************************** 03230000
.TRKC045 ANOP  ,                                                        03240000
         AIF   (T'&RKDD EQ 'O').TRKC050                                 03250000
         AIF   ('&RKDD'(1,1) NE '(').DORKDD                             03260000
         AIF   (N'&RKDD GT 1).RKDDBAD                                   03270000
&SET(2)  SETC  '&RKDD(1)'               SAVE KEYW VALUE W/O PARENS      03280000
&FLGA(2) SETC  'R'                      INDICATE REG-FORM               03290000
         AGO   .TSTDUP                                                  03300000
.DORKDD  ANOP  ,                                                        03310000
         AIF   (T'&RKDD EQ 'N').RKDDBAD  BR IF IMMEDIATE-FORM; ERROR    03320000
&SET(2)  SETC  '&RKDD'                  SAVE KEYW VALUE                 03330000
&FLGA(2) SETC  'A'                      INDICATE ADDR-FORM              03340000
         AGO   .TSTDUP                                                  03350000
.RKDDBAD ANOP  ,                                                        03360000
         SPACE 1                                                        03370000
         MNOTE 8,'RKDD= OPERAND INVALID; NO CODE PRODUCED'              03380000
&QUIT    SETB  1                        DEFER TERMINATION               03390000
.********************************************************************** 03400000
.*  SYNTAX CHECK FOR R, K, AND DD KEYWORDS                              03410000
.********************************************************************** 03420000
.TSTDUP  AIF   (T'&R NE 'O' OR T'&K NE 'O').MLTXERR  RKDD AND R, K, OR  03430000
         AIF   (T'&DD EQ 'O').TRKC060   DD ARE MUTUALLY EXCLUSIVE       03440000
.MLTXERR ANOP  ,                                                        03450000
         SPACE 1                                                        03460000
         MNOTE 4,'R=, K=, OR DD= MAY NOT BE CODED WITH RKDD=; R=, K=, A*03470000
               ND DD= ARE IGNORED'                               82105  03480000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         03490000
         AGO   .TRKC060                 ON TO NEXT KEYW                 03500000
.TRKC050 ANOP  ,                                                        03510000
&SKIP    SETC  'P3'                     INDICATE R/K/DD PROVIDED        03520000
         AIF   (T'&R EQ 'O').NORXX                                      03530000
         AIF   ('&R'(1,1) NE '(').NORXX                                 03540000
         AIF   (N'&R GT 1).BADPARM                                      03550000
&FLGA(4) SETC  'R'                      INDICATE REG-FORM               03560000
.NORXX   AIF   (T'&K EQ 'O').NOKXX                                      03570000
         AIF   ('&K'(1,1) NE '(').NOKXX                                 03580000
         AIF   (N'&K GT 1).BADPARM                                      03590000
&FLGA(5) SETC  'R'                      INDICATE REG-FORM               03600000
.NOKXX   AIF   (T'&DD EQ 'O').NODDXX                                    03610000
         AIF   ('&DD'(1,1) NE '(').NODDXX                               03620000
         AIF   (N'&DD GT 1).BADPARM                                     03630000
&FLGA(6) SETC  'R'                      INDICATE REG-FORM               03640000
.NODDXX  ANOP  ,                                                        03650000
&SET(3)  SETC  '&R(1)'                  SAVE KEYW VALUES AND            03660000
&SET(4)  SETC  '&K(1)'                  STRIP AWAY                      03670000
&SET(5)  SETC  '&DD(1)'                 POSSIBLE PARENS                 03680000
         AGO   .TRKC060                 ON TO NEXT KEYW                 03690000
.BADPARM ANOP  ,                                                        03700000
         SPACE 1                                                        03710000
         MNOTE 8,'R=, K=, OR DD= OPERAND INVALID; NO CODE PRODUCED'     03720000
&QUIT    SETB  1                        DEFER TERMINATION               03730000
.********************************************************************** 03740000
.*  SYNTAX CHECKING OF REMOVE KEYWORD                                   03750000
.********************************************************************** 03760000
.TRKC060 ANOP  ,                                                        03770000
         AIF   (T'&REMOVE EQ 'O').NOREMV                                03780000
         AIF   ('&REMOVE' EQ 'NO').NOREMV                               03790000
         AIF   ('&REMOVE' NE 'YES').GARMSG1                             03800000
         AIF   ('&FUNFLG' EQ 'C').WARN1                                 03810000
&BIT(2)  SETB  1                        SET REMOVE FLG FOR STAR PARMS   03820000
         AGO   .TRKC070                 ON TO NEXT KEYW                 03830000
.GARMSG1 ANOP  ,                                                        03840000
         SPACE 1                                                        03850000
         MNOTE 4,'REMOVE= OPERAND NOT RECOGNIZED; ''NO'' IS ASSUMED'    03860000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         03870000
         AGO   .NOREMV                                                  03880000
.WARN1   ANOP  ,                                                        03890000
         SPACE 1                                                        03900000
         MNOTE 4,'REMOVE=YES AND FUNCTN=TRKCAP ARE MUTUALLY EXCLUSIVE; *03910000
                REMOVE=YES IS IGNORED'                                  03920000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         03930000
.NOREMV  ANOP  ,                                                        03940000
&BIT(2)  SETB  0                        RESET REMOVE FLG FOR STAR PARMS 03950000
.********************************************************************** 03960000
.*  SYNTAX CHECKING OF MAXSIZE KEYWORD                                  03970000
.********************************************************************** 03980000
.TRKC070 ANOP  ,                                                        03990000
         AIF   ('&MAXSIZE' EQ 'NO').NOMAX                               04000000
         AIF   (T'&MAXSIZE EQ 'O').NOMAX                                04010000
         AIF   ('&MAXSIZE' NE 'YES').GARMSG2                            04020000
         AIF   ('&FUNFLG' EQ 'C').WARN2                                 04030000
&BIT(3)  SETB  1                        SET MAXSIZE FLG FOR STAR PARMS  04040000
         AGO   .TRKC080                 ON TO NEXT KEYW                 04050000
.GARMSG2 ANOP  ,                                                        04060000
         SPACE 1                                                        04070000
         MNOTE 4,'MAXSIZE= OPERAND NOT RECOGNIZED; ''NO'' IS ASSUMED'   04080000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         04090000
         AGO   .NOMAX                                                   04100000
.WARN2   ANOP  ,                                                        04110000
         SPACE 1                                                        04120000
         MNOTE 4,'MAXSIZE=YES AND FUNCTN=TRKCAP ARE MUTUALLY EXCLUSIVE;*04130000
                MAXSIZE=YES IS IGNORED'                                 04140000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         04150000
.NOMAX   ANOP  ,                                                        04160000
&BIT(3)  SETB  0                        RESET MAXSIZE FLG FOR           04170000
.*                                      STAR PARMS                      04180000
.********************************************************************** 04190000
.*  SYNTAX CHECKING OF LAST KEYWORD                                     04200000
.********************************************************************** 04210000
.TRKC080 ANOP  ,                                                        04220000
         AIF   ('&LAST' EQ 'NO').NOLAST                                 04230000
         AIF   (T'&LAST EQ 'O').NOLAST                                  04240000
         AIF   ('&LAST' NE 'YES').GARMSG3                               04250000
         AIF   ('&FUNFLG' EQ 'C').WARN3                                 04260000
&BIT(5)  SETB  1                        SET LAST FLG FOR STAR PARMS     04270000
         AGO   .TRKC090                 ON TO NEXT KEYW                 04280000
.GARMSG3 ANOP  ,                                                        04290000
         SPACE 1                                                        04300000
         MNOTE 4,'LAST= OPERAND NOT RECOGNIZED; ''NO'' IS ASSUMED'      04310000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         04320000
         AGO   .NOLAST                                                  04330000
.WARN3   ANOP  ,                                                        04340000
         SPACE 1                                                        04350000
         MNOTE 4,'LAST=YES AND FUNCTN=TRKCAP ARE MUTUALLY EXCLUSIVE;   *04360000
               LAST=YES IS IGNORED'                              82105  04370000
&MSG     SETB  1                        INDICATE MESSAGE ISSUED         04380000
.NOLAST  ANOP  ,                                                        04390000
&BIT(5)  SETB  0                        RESET LAST FLG FOR STAR PARMS   04400000
.********************************************************************** 04410000
.*  SYNTAX CHECKING OF BALANCE KEYWORD                                  04420000
.********************************************************************** 04430000
.TRKC090 ANOP  ,                                                        04440000
         AIF   (T'&BALANCE EQ 'O').BALOFF                               04450000
         AIF   ('&BALANCE'(1,1) EQ '(').BALREG                          04460000
&SET(6)  SETC  '&BALANCE'               SAVE KEYW VALUE                 04470000
&FLGA(3) SETC  'A'                      INDICATE ADDR-FORM              04480000
         AGO   .BALON                   ON TO SETTING BALANCE FLG       04490000
.BALREG  ANOP  ,                                                        04500000
         AIF   (N'&BALANCE GT 1).BADBAL                                 04510000
&SET(6)  SETC  '&BALANCE(1)'            SAVE KEYW VALUE W/O PARENS      04520000
&FLGA(3) SETC  'R'                      INDICATE REG-FORM               04530000
         AGO   .BALON                   ON TO SETTING BALANCE FLG       04540000
.BADBAL  ANOP  ,                                                        04550000
         SPACE 1                                                        04560000
         MNOTE 8,'BALANCE= OPERAND INVALID; NO CODE PRODUCED'           04570000
&QUIT    SETB  1                        DEFER TERMINATION               04580000
.BALOFF  ANOP  ,                                                        04590000
&BIT(4)  SETB  0                        RESET BALANCE FLG FOR           04600000
.*                                      STAR PARMS                      04610000
         AGO   .TSTERR                                                  04620000
.BALON   ANOP  ,                                                        04630000
&BIT(4)  SETB  1                        SET BALANCE FLG FOR STAR PARMS  04640000
.********************************************************************** 04650000
.*  TEST TO SEE IF ANY SERIOUS (TERMINATING) ERRORS WERE FOUND          04660000
.********************************************************************** 04670000
.TSTERR  AIF   (&MSG EQ 0 AND &QUIT EQ 0).SETBITS  DON'T SPACE IF CLEAN 04680000
         SPACE 1                                                        04690000
         AIF   (&QUIT EQ 0).SETBITS     CONTINUE IF NO TERMINAL ERRORS  04700000
         MEXIT ,                        OTHERWISE, GIVE IT UP           04710000
.********************************************************************** 04720000
.*  SET STAR PARM FLAGS FOR CODE GENERATION                             04730000
.********************************************************************** 04740000
.SETBITS ANOP  ,                                                        04750000
&BITS    SETC  '&BIT(1).&BIT(3).&BIT(2).&BIT(4).&BIT(5).&BIT(6).&BIT(7)*04760000
               .0'                                                      04770000
.********************************************************************** 04780000
.*  CHECK SYNTAX OF MF KEYWORD                                          04790000
.********************************************************************** 04800000
.MFCHECK AIF   ('&MF' EQ 'I').DOCNOP                                    04810000
         AIF   (N'&MF NE 2).MFBAD                                       04820000
         AIF   ('&MF(1)' NE 'E').MFBAD                                  04830000
         AGO   .TSTSA                   GO TEST FOR REG SAVE REQ        04840000
.DOCNOP  ANOP  ,                                                        04850000
         CNOP  0,4                      BOUNDARY ALIGNMENT              04860000
.TSTSA   ANOP  ,             SAVE REGISTER CODE REMOVED          82105  04870000
.NOSA    AIF   ('&MF' EQ 'I').STNDARD                                   04880000
&LABEL   IHBINNRA &MF(2)                GO LOAD PARM REG                04890000
         AGO   .XECUTE                  GO GEN CODE TO INIT PARM LIST   04900000
.MFBAD   ANOP  ,                                                        04910000
         MNOTE 8,'MF= OPERAND INVALID; PROCESSING TERMINATED'           04920000
         SPACE 1                                                        04930000
         MEXIT ,                        A BAD MF KEYW IS FATAL          04940000
.STNDARD ANOP  ,                                                        04950000
&LABEL   BALS  1,*+16                   BRANCH AROUND LIST              04960000
&LABEL   SETC  ''                       CAN USE A LABEL ONLY ONCE       04970000
.LIST    ANOP  ,                                                        04980000
&LABEL   DC    A(0)                     DVCT OR UCB ADDR, OR DEVTYPE    04990000
         AIF   ('&MF' EQ 'L').SKIPFLG   IF LIST, GEN ONLY ZERO'S        05000000
         DC    B'&BITS'                 FLAG BYTE                       05010000
         AGO   .TRKC100                 GO AROUND LIST CODE             05020000
.SKIPFLG ANOP  ,                                                        05030000
         DC    X'00'                    FLAG BYTE                       05040000
.TRKC100 ANOP  ,                                                        05050000
         DC    X'00'                    RESERVED                        05060000
         DC    AL2(0)                   TRACK BALANCE                   05070000
         AIF   ('&MF' EQ 'L').SKIPR     GEN ZERO FOR                    05080000
         AIF   ('&FLGA(4)' EQ 'R').SKIPR  RECORD NUMBER UNLESS          05090000
         AIF   (T'&R NE 'N').SKIPR      IT'S THE IMMEDIATE-FORM         05100000
         DC    AL1(&R)                  RECORD NUMBER                   05110000
         AGO   .TRKC110                                                 05120000
.SKIPR   ANOP  ,                                                        05130000
         DC    AL1(0)                   RECORD NUMBER                   05140000
.TRKC110 ANOP  ,                                                        05150000
         AIF   ('&MF' EQ 'L').SKIPK     GEN ZERO FOR                    05160000
         AIF   ('&FLGA(5)' EQ 'R').SKIPK  KEY LENGTH UNLESS             05170000
         AIF   (T'&K NE 'N').SKIPK      IT'S THE IMMEDIATE-FORM         05180000
         DC    AL1(&K)                  KEY LENGTH                      05190000
         AGO   .TRKC120                                                 05200000
.SKIPK   ANOP  ,                                                        05210000
         DC    AL1(0)                   KEY LENGTH                      05220000
.TRKC120 ANOP  ,                                                        05230000
         AIF   ('&MF' EQ 'L').SKIPDD    GEN ZERO FOR                    05240000
         AIF   ('&FLGA(6)' EQ 'R').SKIPDD  DATA LENGTH UNLESS           05250000
         AIF   (T'&DD NE 'N').SKIPDD    IT'S THE IMMEDIATE-FORM         05260000
         DC    AL2(&DD)                 DATA LENGTH                     05270000
         AGO   .TRKC130                                                 05280000
.SKIPDD  ANOP  ,                                                        05290000
         DC    AL2(0)                   DATA LENGTH                     05300000
.TRKC130 ANOP  ,                                                        05310000
         AIF   ('&MF' EQ 'L').FINISH    GEN NO INSTRUCTION IF LIST REQ  05320000
.XECUTE  ANOP  ,                                                        05330000
         AIF   ('&SET(1)' EQ '*').TRKC140  IF *, THEN DVCT SOURCE IS    05340000
.*                                      ALREADY IN THE STAR LIST        05350000
         AIF   (&BIT(7)).GOTTYPE        BR IF TYPE PROVIDED             05360000
         AIF   ('&FLGA(1)' EQ 'R').BR1  BR IF REG-FORM                  05370000
         AIF   ('&FLGA(1)' NE 'A').TRKC140  BR IF NOT ADDR-FORM         05380000
         ICM   15,15,&SET(1)            MOVE ADDR OF DEVTAB OR   86041  05390000
         ST    15,0(0,1)                UCB TO LIST                     05400000
         AGO   .TRKC140                                                 05410000
.BR1     ANOP  ,                                                        05420000
         ST    &SET(1),0(0,1)           ST @ OF DEVTAB OR UCB IN LIST   05430000
         AGO   .TRKC140                                                 05440000
.GOTTYPE AIF   ('&FLGA(1)' EQ 'R').TYPER  BR IF REG-FORM                05450000
.*                                      OTHERWISE, IT'S ADDR-FORM       05460000
         IC    15,&SET(1)               MOVE DEVICE TYPE                05470000
         STC   15,3(0,1)                TO LIST                         05480000
         AGO   .TRKC140                                                 05490000
.TYPER   ANOP  ,                                                        05500000
         STC   &SET(1),3(0,1)           ST DEVICE TYPE IN LIST          05510000
.TRKC140 ANOP  ,                                                        05520000
         AIF   ('&MF' EQ 'I').NOFLAG    FLGS ARE DC'D FOR I-FORM        05530000
         AIF   (T'&FUNCTN EQ 'O').NOFLAG  USE RESIDUAL FLGS IF NO FUNCT 05540000
         MVI   4(1),B'&BITS'            FLAGS TO LIST                   05550000
.NOFLAG  ANOP  ,                                                        05560000
         AIF   (&BIT(4) NE 1).TRKC150   BR IF NO BALANCE PROVIDED       05570000
         AIF   ('&SET(6)' EQ '*').TRKC150  IF '*', BAL IS IN STAR       05580000
.*                                      PARM LIST ALREADY               05590000
         AIF   ('&FLGA(3)' EQ 'R').BR2  BR IF REG-FORM                  05600000
         ICM   15,3,&SET(6)             TRK BALANCE              86041  05610000
         STH   15,6(0,1)                TO LIST                         05620000
         AGO   .TRKC150                                                 05630000
.BR2     ANOP  ,                                                        05640000
         STH   &SET(6),6(0,1)           ST TRK BALANCE IN LIST          05650000
.TRKC150 ANOP  ,                                                        05660000
         AIF   ('&SKIP' EQ 'P3').RKDD3  BR IF RKDD WAS NOT PROVIDED     05670000
         AIF   ('&FLGA(2)' EQ 'R').BR3  BR IF REG-FORM                  05680000
         ICM   15,15,&SET(2)            MOVE RKDD                86041  05690000
         ST    15,8(0,1)                TO LIST                         05700000
         AGO   .EXITBR                                                  05710000
.BR3     ANOP  ,                                                        05720000
         ST    &SET(2),8(0,1)           ST RKDD IN LIST                 05730000
         AGO   .EXITBR                                                  05740000
.RKDD3   ANOP  ,                                                        05750000
         AIF   (T'&R EQ 'O').AKY        BR IF R NOT PROVIDED            05760000
         AIF   ('&FLGA(4)' NE 'R').RADDR  BR IF NOT REG-FORM            05770000
         STC   &SET(3),8(0,1)           ST REC NO. IN LIST              05780000
         AGO   .AKY                                                     05790000
.RADDR   ANOP  ,                                                        05800000
         AIF   (T'&R EQ 'N').NRX        BR IF IMMEDIATE-FORM            05810000
         IC    15,&SET(3)               MOVE REC NO.                    05820000
         STC   15,8(0,1)                TO LIST                         05830000
         AGO   .AKY                                                     05840000
.NRX     ANOP  ,                                                        05850000
         AIF   ('&MF' EQ 'I').AKY       IF I-FORM, R IS DC'D            05860000
         MVI   8(1),&R                  ST REC NO. IN LIST              05870000
.AKY     ANOP  ,                                                        05880000
         AIF   (T'&K EQ 'O').ADDY       BR IF K NOT PROVIDED            05890000
         AIF   ('&FLGA(5)' NE 'R').KADDR  BR IF NOT REG-FORM            05900000
         STC   &SET(4),9(0,1)           ST KEY LENGTH IN LIST           05910000
         AGO   .ADDY                                                    05920000
.KADDR   ANOP  ,                                                        05930000
         AIF   (T'&K EQ 'N').NKX        BR IF IMMEDIATE-FORM            05940000
         IC    15,&SET(4)               MOVE KEY LENGTH                 05950000
         STC   15,9(0,1)                TO LIST                         05960000
         AGO   .ADDY                                                    05970000
.NKX     ANOP  ,                                                        05980000
         AIF   ('&MF' EQ 'I').ADDY      IF I-FORM, K IS DC'D            05990000
         MVI   9(1),&K                  ST KEY LENGTH IN LIST           06000000
.ADDY    ANOP  ,                                                        06010000
         AIF   (T'&DD EQ 'O').EXITBR    BR IF DD NOT PROVIDED           06020000
         AIF   ('&FLGA(6)' NE 'R').DDADDR  BR IF NOT REG-FORM           06030000
         STH   &SET(5),10(0,1)          ST DATA LENGTH IN LIST          06040000
         AGO   .EXITBR                                                  06050000
.DDADDR  ANOP  ,                                                        06060000
         AIF   (T'&DD EQ 'N').NDDX      BR IF IMMEDIATE-FORM            06070000
         ICM   15,3,&SET(5)             MOVE DATA LENGTH         86041  06080000
         STH   15,10(0,1)               TO LIST                         06090000
         AGO   .EXITBR                                                  06100000
.NDDX    ANOP  ,                                                        06110000
         AIF   ('&MF' EQ 'I').EXITBR    IF I-FORM, DD IS DC'D           06120000
         MVI   10(1),&DD/256            ST DATA LENGTH(1) IN LIST       06130000
         MVI   11(1),&DD-((&DD/256)*256) ST DATA LENGTH(2) IN LIST      06140000
.EXITBR  ANOP  ,                                                        06150000
         L     R15,@SERVICE  LOAD THE SERVICE ROUTINE ADDRESS    82105  06160000
         LA    R0,VENDVCAP   SET THE ENTRY CODE                  82105  06170000
         BALSR R14,R15       SERVICE THE REQUEST                 82105  06180000
.FINISH  MEXIT ,                                                        06190000
.DSECT   ANOP  ,                                                        06200000
         DS    0F                       ALIGN TO FULL WORD BOUNDARY     06210000
&NAME    DS    0CL12                    STAR PARM LIST MAP              06220000
STARUCBA DS    0F                       UCB ADDRESS                     06230000
STARDCTA DS    0F                       DEVICE TABLE ADDRESS            06240000
         DS    XL3                                                      06250000
STARTYPE DS    XL1                      DEVICE TYPE                     06260000
STARFLGS DS    XL1                      FUNCTION AND OPTIONS            06270000
STARFUNC EQU   B'10000000'              FUNCTION: 0=TRKBAL, 1=TRKCAP    06280000
STARMAXS EQU   B'01000000'              1=MAXSIZE REQUESTED             06290000
STARREMV EQU   B'00100000'              1=REMOVE REQUESTED              06300000
STARUBAL EQU   B'00010000'              1=CALLER PROVIDED BALANCE       06310000
STARLAST EQU   B'00001000'              1=SPECIAL LAST RCD REQUEST      06320000
STARDTU  EQU   B'00000110'              DVCT ENTRY SOURCE FLAGS:        06330000
*                                       00=DVCT ENTRY ADDRESS PROVIDED  06340000
*                                       01=RESERVED                     06350000
*                                       10=UCB ADDRESS PROVIDED         06360000
*                                       11=DEVICE TYPE PROVIDED         06370000
STARLOC  EQU   B'00000001'              LOC=ANY. DEVTAB OR UCB  GP99133 06380000
         DS    XL1                      RESERVED                        06390000
STARBAL  DS    H                        TRACK BALANCE                   06400000
STARRKDD DS    0F                       RECORD INFO AS DEFINED BELOW    06410000
STARR    DS    XL1                      RECORD NUMBER                   06420000
STARKL   DS    XL1                      KEY LENGTH                      06430000
STARDL   DS    H                        DATA LENGTH                     06440000
         MEND  ,                                                        06450000
./ ADD NAME=SERVCALL
         MACRO ,                                                        00010000
&NM      SERVCALL &CODE,&ADDR,&REG2,&ERR=,&CC0=,&CC4=,&CC8=,&LEN=,     *00020000
               &MODE=BAL,&OPT=                                  GP06287 00030000
         GBLC  &SRVCM@R,&MACPLAB                                 81148  00040000
         GBLB  &MVSXA                                           GP04234 00050000
         LCLA  &I,&J,&K,&OPA                                    GP06287 00060000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                  GP06287 00070000
         LCLC  &LERR,&DC                                         81148  00080000
         AIF   ('&MACPLAB' NE '' AND '&NM' NE '').LABTWO        GP12043 00090000
         AIF   ('&MACPLAB' NE '').LABCOM                        GP12043 00100000
         AGO   .LABSET                                          GP12043 00110000
.LABTWO  MACPARM MODE=LBL    EXPAND LABEL FOR MACPLAB           GP12043 00120000
.LABSET  ANOP  ,                                                GP12043 00130000
&MACPLAB SETC  '&NM'                                            GP12043 00140000
.LABCOM  MACPARM R2,&REG2,NULL=SKIP                              85070  00150000
         MACPARM R1,&ADDR,NULL=SKIP                                     00160000
         AIF   ('&CODE' EQ '').NOR0                                     00170000
         AIF   ('&CODE'(1,1) EQ '(').REG0                               00180000
         MACPARM R0,VEN&CODE                                            00190000
         AIF   ('&LEN' EQ '').NOR0                               81148  00200000
         MACPARM R0,8,=AL1(&LEN),OP=ICM,MODE=THREE               81148  00210000
         AGO   .NOR0                                                    00220000
.REG0    MACPARM R0,&CODE                                               00230000
.NOR0    AIF   (T'&OPT EQ 'O').NOOPT   NO OPTIONS               GP06287 00240000
&K       SETA  N'&OPT                                           GP06287 00250000
&J       SETA  0             COUNT OF PROCESSED OPERANDS        GP06287 00260000
&I       SETA  0             CLEAR INDEX                        GP06287 00270000
.ITMLOOP AIF   (&I GE &K).ITMTEST                               GP06287 00280000
&I       SETA  &I+1                                             GP06287 00290000
&DC      SETC  '&OPT(&I)'                                       GP06287 00300000
         AIF   ('&DC' EQ '').ITMLOOP  IGNORE REAL NULL          GP06287 00310000
         AIF   ('&DC' EQ 'NONE').ITMLOOP  IGNORE SEMANTIC NULL  GP06287 00320000
&J       SETA  &J+1                                             GP06287 00330000
&F0      SETB  (&F0  OR '&DC' EQ 'LIST')                        GP06287 00340000
&F0      SETB  (&F0  OR '&DC' EQ 'TEXT')                        GP06287 00350000
&F6      SETB  (&F6  OR '&DC' EQ '2'  OR '&DC' EQ '3')          GP06287 00360000
&F7      SETB  (&F7  OR '&DC' EQ '1'  OR '&DC' EQ '3')          GP06287 00370000
         AGO   .ITMLOOP                                         GP06287 00380000
.ITMTEST ANOP  ,                                                GP06287 00390000
&OPA     SETA  &F0+&F1+&F2+&F3+&F4+&F5+&F6+&F7                  GP06287 00400000
         AIF   (&OPA EQ &J).DONOPT  EACH OPERAND VALID ?        GP06287 00410000
.BADOPT  MNOTE 4,'SERVCALL: ERROR - OPT PARAMETER BAD: &OPT'    GP06287 00420000
.DONOPT  AIF   (&J EQ 0).NOOPT    SKIP IF ONLY NULLS            GP06287 00430000
         MACPARM R0,4,=AL1(&OPA),OP=ICM,MODE=THREE              GP06287 00440000
.NOOPT   MACPARM R15,@SERVICE,OP=L  GET MODULE ADDRESS                  00450000
         AIF   ('&MODE' EQ 'BAL' OR '&MODE' EQ '').BALMODE       90337  00460000
         AIF   ('&MODE' EQ 'SYNCH').SYNMODE                      90337  00470000
         MNOTE 8,'INVALID MODE=&MODE'                            90337  00480000
.SYNMODE ANOP  ,                                                 90337  00490000
&MACPLAB SYNCH (15),RESTORE=YES  INVOKE AND SAVE MODE            90337  00500000
         AGO   .COMMODE                                          90337  00510000
.BALMODE AIF   (&MVSXA).BASMODE                                 GP04234 00520000
&MACPLAB BALR  R14,R15       CALL THE @SERVICE ROUTINE          GP04234 00530000
         AGO   .COMMODE                                         GP04234 00540000
.BASMODE ANOP  ,                                                 90337  00550000
&MACPLAB BASSM R14,R15       CALL THE @SERVICE ROUTINE                  00560000
.COMMODE AIF   ('&CC0' EQ '' AND '&CC4' EQ '' AND '&CC8' EQ '').NOCC    00570000
         AIF   ('&ERR' EQ '' OR '&ERR' EQ 'NO').NODUPE           81148  00580000
         MNOTE 4,'CC= AND ERR= ARE MUTUALLY EXCLUSIVE'           81148  00590000
.NODUPE  ANOP  ,                                                 81148  00600000
&MACPLAB SETC  ''                                                81148  00610000
         CH    R15,=H'4'     TEST RETURN                         81148  00620000
         MACPARM &CC0,OP=BL,OPR=BLR,MODE=ONE,NULL=SKIP          GP02241 00630000
         MACPARM &CC4,OP=BE,OPR=BER,MODE=ONE,NULL=SKIP          GP02241 00640000
         MACPARM &CC8,OP=BH,OPR=BHR,MODE=ONE,NULL=SKIP          GP02241 00650000
         AGO   .MEND                                             81148  00660000
.NOCC    AIF   ('&ERR' EQ 'NO').MEND                             81148  00670000
&LERR    SETC  '&ERR'                                            81148  00680000
         AIF   ('&LERR' NE '').DOERR                             81148  00690000
&LERR    SETC  '&SRVCM@R'                                        81148  00700000
         AIF   ('&LERR' EQ '').MEND                              81148  00710000
.DOERR   BXH   R15,R15,&LERR  GO TO SET ERROR MESSAGE            81148  00720000
.MEND    MEND  ,                                                        00730000
./ ADD NAME=SERVCOMP
         MACRO ,                                                        00010000
&NM      SERVCOMP &DSECT=YES,&PFX=WCM,                                 *00020000
               &FG1=0,&FG2=0,&LINE#=0,&DELTA=1,                        *00030000
               &BUFAD=0,&BUFMX=0,&RECAD=0,&RECMX=0,&CODAD=0      81263  00040000
         LCLC  &P,&NAME                                                 00050000
&NAME    SETC  '&NM'                                                    00060000
&P       SETC  'WCM'                                                    00070000
         AIF   ('&NAME' NE '').HAVENM                                   00080000
&NAME    SETC  'SERVCOMP'                                               00090000
.HAVENM  AIF   ('&DSECT' NE 'YES').NOSECT                               00100000
&NAME    DSECT ,                                                        00110000
         AGO   .TESTP                                                   00120000
.NOSECT  AIF   ('&NM' EQ '').TESTP                                      00130000
&NM      DS    0A .                                                     00140000
.TESTP   AIF   ('&PFX' EQ '').HAVEP                                     00150000
&P       SETC  '&PFX'                                                   00160000
.HAVEP   ANOP  ,                                                        00170000
&P.BUFAD DC    A(&BUFAD)     CURRENT BLOCK ADDRESS                      00180000
&P.BUFMX DC    AL2(&BUFMX)     MAXIMUM BLOCK SIZE                       00190000
&P.BUFLN DC    H'0'            OFFSET TO NEXT LINE                      00200000
&P.RECAD DC    A(&RECAD)     CURRENT RECORD ADDRESS                     00210000
&P.RECMX DC    AL2(&RECMX)     MAXIMUM RECORD LENGTH                    00220000
&P.RECLN DC    H'0'            CURRENT RECORD LENGTH                    00230000
&P.CODAD DC    A(&CODAD)     ADDRESS OF CODE WORD OR ZERO               00240000
&P.LINE# DC    A(&LINE#)       CURRENT LINE NUMBER (BINARY)             00250000
&P.LINEB DC    CL8' '          CURRENT LINE NUMBER (EBCDIC)             00260000
&P.LINEP DC    A(&LINE#-&DELTA)  PREVIOUS LINE NUMBER                   00270000
&P.DELTA DC    A(&DELTA)     LINE NUMBERING INCREMENT (FWD)             00280000
&P.FG1   DC    AL1(&FG1)     PROCESSING FLAGS                           00290000
&P.F1NIH EQU   X'80'           NIH FORMAT                               00300000
&P.F1OSI EQU   X'40'           OSI FORMAT (X'80' IN LINE# FOR FWD)      00310000
&P.F1HWD EQU   X'20'           HALF-WORD LINE # (RAND, ETC.)            00320000
&P.F1INT EQU   X'10'           NUMBER IN CL8 FORMAT                     00330000
&P.F1EDT EQU   X'08'           NUMBER IN 4C.3C FORMAT                   00340000
&P.F1TSO EQU   X'04'           LEFT-ADJUSTED LINE NUMBERS               00350000
&P.F1LCC EQU   X'02'           RETURN CARR.CONTROL/LINE/TEXT (+F1TSO)   00360000
&P.F1NB# EQU   X'01'           INSERT NUMBERS EVEN IF NON-BLANK         00370000
&P.FG2   DC    AL1(&FG2)     CONTROL FLAGS                              00380000
&P.F2NPR EQU   X'80'           NO LINE DECOMPRESSION (REBLOCK)          00390000
&P.F2RDW EQU   X'40'           V-FORMAT RECORD RETURNED                 00400000
&P.F2COD EQU   X'02'           CODE WORD CHECKED                        00410000
&P.F2PSW EQU   X'01'           ENCRYPTION/DECRYPTION REQUIRED           00420000
&P.FG3   DC    X'00'         NEW NIH LINE FLAGS                         00430000
&P.F3RAW EQU   X'80'           UNCOMPRESSED RECORD                      00440000
&P.F3L16 EQU   X'40'           16-BIT LENGTH FIELD                      00450000
&P.F3NSP EQU   X'20'           NO SPECIAL CONTROL CHARACTERS            00460000
&P.F3MRK EQU   X'10'           LINE IS FLAGGED 'CHANGED'                00470000
&P.F308  EQU   X'08'             RESERVED                               00480000
&P.F3NIF EQU   X'F8'           ALL NEW NIH FLAG BITS                    00490000
&P.F3NIH EQU   X'04'           COPY OF NIH FORMAT FLAG                  00500000
&P.LINEH DC    C' '         SPILL BYTE FOR EDIT LINE OVERFLOW           00510000
         MEND  ,                                                        00520000
./ ADD NAME=SERVDEFS
         MACRO ,                                                        00010000
&NM     SERVDEFS &PARM=10                                               00020000
         GBLC  &MACPLAB,&SRVLMOD(20),&SRVLDEL(20)                       00030000
         GBLB  &SRVBMOD(20)                                             00040000
         GBLB  &BUGBEAR,&ZZSPIE                                         00050000
         GBLB  &MVS,&MVSSP,&MVSXA,&MVSESA                               00060000
         GBLA  &SRVNMOD                                                 00070000
.*--------------------------------------------------------------------* 00080000
.*  SERVDEFS IS USED IN THE PROGRAM'S MAIN SAVE AREA TO EXPAND THE    * 00090000
.*  ADDRESS LABELS FOR STANDARD SERVICE ROUTINES (@SERVICE, @PRINTER, * 00100000
.*  ETC.).  WHEN RUNNING IN DEBUG MODE, IT ALSO EXPANDS PGMTRACE AND  * 00110000
.*  DEBTRACE WORK AREAS.                                              * 00120000
.*--------------------------------------------------------------------* 00130000
         LCLA  &I,&J                                                    00140000
&MACPLAB SETC  '&NM'         ENSURE CORRECT VALUE                       00150000
         MACPARM MODE=LABEL                                             00160000
@SERVICE DS    A             ADDRESS OF @SERVICE ROUTINE                00170000
@SERVEXC DS    A             EXECUTED INSTRUCITON (SVC, BASSM, ...)     00180000
@SERVTCA DS    A             ADDRESS OF @SERVICE TASK CONTROL AREA      00190000
.DSLOOP  AIF   (&I GE &SRVNMOD).NDLOOP                                  00200000
&I       SETA  &I+1                                                     00210000
         AIF   (&SRVBMOD(&I)).DSLOOP  SKIP EXPANSION ?                  00220000
&SRVLMOD(&I)  DS  A                                                     00230000
         AGO   .DSLOOP                                                  00240000
.NDLOOP  AIF   (NOT &ZZSPIE).NDSPIE  SKIP IF NOT (E)SPIE MODE   GP09277 00250000
@SPIEDER DS    A  *DEBUG*    @SPIEDER (E)SPIE INTERCEPT         GP09277 00260000
.NDSPIE  AIF   (NOT &BUGBEAR).PARM  SKIP IF NOT DEBUG MODE              00270000
@TRACE   DS    A  *DEBUG*    PGMTRACE ROUTINE                           00280000
    #TRC  DATA    *DEBUG*    PGMTRACE RE-ENTRANT WORK AREA      GP06319 00290000
         AIF   (NOT &MVSXA AND NOT &MVSESA).OLDBUG                      00300000
         DBT   MODE=D  *DEBUG*  DEBTRACE WORK AREA                      00310000
         AGO   .PARM                                                    00320000
.OLDBUG  DBO   MODE=D  *DEBUG*  DEBTROLD WORK AREA                      00330000
.PARM    AIF   ('&PARM' EQ '').MEND                                     00340000
.*DEFER* AIF   (T'&PARM' NE 'N').MEND                                   00350000
         AIF   ('&PARM' EQ '0').MEND                                    00360000
CALLPARM DS    (&PARM)A      PARAMETER LIST FOR SUBCALL, ETC.           00370000
RETCODE  DS    F             PROGRAM RETURN CODE                        00380000
RSNCODE  DS    F             ERROR REASON                               00390000
RR1CODE  DS    F             RETURNED R1                        GP04068 00400000
.MEND    MEND  ,                                                        00410000
./ ADD NAME=SERVFLAG
*        SERVFLAG                                     UPDATED ON 90316  00010000
*          CALL CODES (R0) FOR '@SERVICE' ROUTINE                       00020000
VENMOD1  EQU   256           ENTRY MODIFIER 1                           00030000
VENMOD2  EQU   512           ENTRY MODIFIER 2                           00040000
VENMOD3  EQU   768           ENTRY MODIFIER 3                           00050000
VENMOD4  EQU   1024          ENTRY MODIFIER 4                           00060000
VENMOD5  EQU   1280          ENTRY MODIFIER 5                           00070000
VENMOD6  EQU   1536          ENTRY MODIFIER 6                           00080000
VENMOD7  EQU   1792          ENTRY MODIFIER 7                           00090000
VENMOD8  EQU   2048          ENTRY MODIFIER 8                           00100000
VENMOD9  EQU   2304          ENTRY MODIFIER 9                           00110000
VENMOD10 EQU   2560          ENTRY MODIFIER 10                          00120000
VENMOD11 EQU   2816          ENTRY MODIFIER 11                          00130000
VENMOD12 EQU   3072          ENTRY MODIFIER 12                          00140000
VENMOD13 EQU   3328          ENTRY MODIFIER 13                          00150000
VENMOD14 EQU   3584          ENTRY MODIFIER 14                          00160000
VENMOD15 EQU   3840          ENTRY MODIFIER 15                          00170000
         SPACE 1                                                        00180000
VENCLOSE EQU   00            CLOSE/FREEMAIN ENTRY                       00190000
VENFREEM EQU   00+VENMOD1      CLOSE/FREE - KEEP @PRINTER OPEN          00200000
VENINITG EQU   01            INIT - LOCAL GETMAINS/LOADS/OPENS          00210000
VENLPALD EQU   02            MODULE LOAD FROM LPA, OR STEP/LINKLIB      00220000
VENLPADL EQU   02+VENMOD1      MODULE CLOSE AND DELETE                  00230000
VENLPA@0 EQU   02+VENMOD2      ZERO MODULE ADDRESS IN USERCVT           00240000
VENAPFON EQU   03            AUTH - SET APF ON                          00250000
VENAPFOF EQU   03+VENMOD1      SET APF AUTH OFF                         00260000
VENPASON EQU   03+VENMOD2      SET JSCB PASS ON                         00270000
VENPASOF EQU   03+VENMOD3      SET JSCBPASS OFF                         00280000
VENCANON EQU   03+VENMOD4      SET CSCB CANCEL ON                       00290000
VENCANOF EQU   03+VENMOD5      SET CSCB CANCEL OFF                      00300000
VENNO522 EQU   03+VENMOD6      SET SMF OFF (NO 522)                     00310000
VENDO522 EQU   03+VENMOD7      SET SMF ON (ALLOW 522, ETC.)             00320000
VENUCBUM EQU   05            SEQUENTIAL UCB LOOKUP                      00330000
VENUCBNM EQU   05+VENMOD1      LOCATE UCB BY UNITNAME                   00340000
VENUCBVS EQU   05+VENMOD2      LOCATE UCB BY VOLSER                     00350000
VENUCBDK EQU   05+VENMOD3      LOCATE DISK UCB BY VOLSER                00360000
VENUCBGN EQU   05+VENMOD4      GET GENERIC NAME FOR UCB                 00370000
VENUCBDT EQU   05+VENMOD5      GET UCB TYPE FROM GENERIC                00380000
VENTIOLP EQU   06            TIOT ENTRY LOOP                            00390000
VENTIOLK EQU   06+VENMOD1      TIOT LOOP - SKIP SPECIAL ENTRIES         00400000
VENTIODD EQU   06+VENMOD2      TIOT - LOCATE DDNAME                     00410000
VENTIOUA EQU   06+VENMOD3      TIOT - LOCATE BY UCB ADDRESS             00420000
VENSIOTE EQU   06+VENMOD4      SIOT - LOCATE BY TIOT ADDRESS            00430000
VENSWARL EQU   06+VENMOD5      SWARL - GET SWA (TEXT) FROM SVA TOKEN    00440000
VENSWAAD EQU   06+VENMOD6      SWAAD - GET SWA ADDRESS FROM SVA TOKEN   00450000
VENSWAAB EQU   06+VENMOD7      SWAAB - GET SWA ADDRESS FROM SVA TOKEN   00460001
VENDSABL EQU   06+VENMOD8      DSAB - LOOP THROUGH ENTRIES              00470001
VENDSABD EQU   06+VENMOD9      DSAB - FIND BY DDNAME                    00480001
VENSORTB EQU   07            BUBBLE SORT                                00490000
VENSORTH EQU   07+VENMOD1      HEAP SORT                                00500000
VENBINLK EQU   07+VENMOD3      BINARY TABLE LOOKUP                      00510000
VENDVTBL EQU   08            DEVICE TABLE LOCATE                        00520000
VENDVCAP EQU   08+VENMOD1      DEVICE CAPACITY/BALANCE                  00530000
VENDVEXT EQU   08+VENMOD2      DEVICE EXTENT SIZE CALCULATION           00540000
VENDVSPC EQU   08+VENMOD3      TRK=>CYL; CYL=>TRK CONVERSION            00550000
VENSCHFR EQU   09            SCHEDULE - FREE WORK AREA                  00560000
VENSCHIN EQU   09+VENMOD1      GET/INIT CSA WORK AREA                   00570000
VENSCHMV EQU   09+VENMOD2      MOVE/UPDATE WORK AREA                    00580000
VENSCHED EQU   09+VENMOD3      SCHEDULE AN SRB                          00590000
VENPGFIX EQU   09+VENMOD4      PAGEFIX LPA PAGE                         00600000
VENSWAPY EQU   09+VENMOD5      SET SWAPPABLE                            00610000
VENSWAPN EQU   09+VENMOD6      SET ADDRESS SPACE NONSWAPPABLE           00620000
VENGASID EQU   09+VENMOD7      VALIDATE BY ASID                         00630000
VENGASJB EQU   09+VENMOD8      VALIDATE BY JOBNAME                      00640000
VENGASCB EQU   09+VENMOD9      VALIDATE ASCB ONLY                       00650000
VENSSLOC EQU   09+VENMOD10     LOCATE SUBSYSTEM                         00660000
VENSSSET EQU   09+VENMOD11     SPECIFY SUBSYSTEM                        00670000
VENLOCAT EQU   10            CATALOG LOOKUP                             00680000
VENLOCMT EQU   10+VENMOD1      CAT. LOOK ON P/R AND RSV PACKS           00690000
VENLOCRT EQU   10+VENMOD2      CAT. LOOK ON P/R PACKS ONLY              00700000
VENCATCO EQU   10+VENMOD6      CAT. CONNECT CVOL INDEX                  00710000
VENJESVC EQU   11            JES(2) GENERIC SERVICES :                  00720000
VENJ2INF EQU   11              JES(2) INFO - GET SUBSYSTEM NAME         00730000
VENLOJOB EQU   11+VENMOD1      GET JOB DATA                             00740000
VENMDJOB EQU   11+VENMOD2      RESET HOLD (AND LOCAL) FLAGS             00750000
VENACGET EQU   16            GET CURRENT ACCOUNT/PRIVILEGES             00760000
VENACTST EQU   16+VENMOD1      TEST ACCOUNT NUMBER IN R1                00770000
VENACTSM EQU   16+VENMOD2      TEST AND RETURN ACCOUNT IN R1            00780000
VENACCON EQU   16+VENMOD3      CONVERT INTEGER TO EBCDIC ACCOUNT        00790000
VENACCNX EQU   16+VENMOD4      CONVERT INTEGER ACCOUNT TO EXTERNAL      00800000
VENUSGET EQU   17            GET USER ID                                00810000
VENUSTST EQU   17+VENMOD1      TEST USER ID                             00820000
VENAUTST EQU   18            TEST ACCOUNT/USERID COMBINATION            00830000
VENAUWYL EQU   18+VENMOD1      TEST ACCT/UID COMBINATION FOR WYLBUR     00840000
VENFMTAC EQU   19            CHECK FORMAT, BUT NOT VALIDITY OF ACCT     00850000
VENFMTLB EQU   19+VENMOD1      CHECK FORMAT OF LIBPAK NAME              00860000
VENFMTWY EQU   19+VENMOD2      CHECK FORMAT OF WYLBUR NAME              00870000
VENFMTTS EQU   19+VENMOD3      CHECK FORMAT OF TSO DSN                  00880000
VENGFORM EQU   20            CHECK GDA FORM TABLE                       00890000
VENGPAPR EQU   20+VENMOD1      CHECK GDA PAPER COST TABLE               00900000
VENDSTST EQU   32            CHECK DSN (NON-CATLG)                      00910000
VENDSCAT EQU   32+VENMOD1      CHECK DSN FROM CATALOG (GDG)             00920000
VENDSABB EQU   32+VENMOD2      EXTRACT 8-BYTE PORTION FROM DSN          00930000
VENDSDS1 EQU   32+VENMOD3      OBTAIN FORMAT 1 DSCB                     00940000
VENDSDJ1 EQU   32+VENMOD4      OBTAIN FORMAT 1 DSCB FROM JFCB           00950000
VENDSFMT EQU   32+VENMOD5      FORMAT DSORG/RECFM/OPTCD/BLKL/LRECL      00960000
VENDSMEM EQU   32+VENMOD6      CHECK MEMBER NAME                        00970000
VENRJFCB EQU   32+VENMOD7      GET JFCB FOR DDNAME                      00980000
VENPDSDE EQU   32+VENMOD8      DECODE PDS DIRECTORY ENTRY               00990000
VENDSDS4 EQU   32+VENMOD9      OBTAIN FORMAT 4 DSCB                     01000000
VENDSDJ4 EQU   32+VENMOD10     OBTAIN FORMAT 4 DSCB                     01010000
VENDDCLR EQU   32+VENMOD11     RE-INITIALIZE DD HAVING DISP=MOD         01020000
VENDSLIB EQU   33            CHECK DSN ON LIBPAK                        01030000
VENDSLIX EQU   33+VENMOD1      CHECK LIBPAK INDEX                       01040000
VENDSWYL EQU   34            CHECK WYLBUR DSN                           01050000
VENWYLDX EQU   34+VENMOD1      CHECK FOR WYLBUR INDEX                   01060000
VENDSGET EQU   34+VENMOD2      CHANGE SHORT TO LONG WYLBUR NAME         01070000
VENDSWYC EQU   34+VENMOD3      CHECK WYLBUR DSN IN CATALOG              01080000
VENDSTSO EQU   35            CHECK TSO DSNAME                           01090000
VENDSTSX EQU   35+VENMOD1      CHECK TSO INDEX                          01100000
VENDSTET EQU   35+VENMOD2      CHANGE SHORT TO LONG TSO NAME            01110000
VENVSNFG EQU   36            CHECK VOLUME ATTRIBUTE FLAGS               01120000
VENDSANY EQU   36+VENMOD1      CHECK VOLUME/DSNAME FOR VALIDITY         01130000
VENVSTMS EQU   36+VENMOD2      CHECK VS FOR TMS ELIGIBILITY             01140000
VENWCOMP EQU   37            WYLBUR COMPRESS ROUTINE                    01150000
VENWDCOM EQU   37+VENMOD1      WYLBUR DECOMPRESS ROUTINE                01160000
VENALCVS EQU   38            ALLOCATION - GET DDNAME FOR VTOC OPEN      01170000
VENALCDS EQU   38+VENMOD1      ALLOCATE A (PERM) DSN FROM JFCB          01180000
VENALCFR EQU   38+VENMOD2      RELEASE ALLOCATED TIOT ENTRY             01190000
VENALCDD EQU   38+VENMOD3      ALLOCATE DD FOR DSN                      01200000
VENALCFD EQU   38+VENMOD4      FREE DD                                  01210000
VENWYLOC EQU   39            WYLBUR MULTI-VOLUME LOCATE                 01220000
         SPACE 1                                                        01230000
VAASTC   EQU   X'80'    ACCOUNT PRIVILEGES - INSTALLATION DEFAULT       01240000
VAASYS   EQU   X'40'         SYSTEM PRIVILEGES                          01250000
VAASUP   EQU   X'20'         TECH SUPPORT                               01260000
VAAINH   EQU   X'10'         IN-HOUSE STAFF                             01270000
VAAUSER  EQU   X'08'         PLAIN OLD USER                             01280000
VAAOHD   EQU   X'04'         OVERHEAD ACCOUNT (WITH STC,SYS,SUP)        01290000
         SPACE 1                                                        01300000
VRPGER   EQU   0        RETURN VALUES : DISASTROUS ERROR                01310000
VRPARM   EQU   1             BAD PARM OR ENTRY                          01320000
VRSYNT   EQU   2             BAD CHARACTER OR SYNTAX ERROR              01330000
VRACCT   EQU   3             BAD ACCOUNT                                01340000
         SPACE 1                                                        01350000
VRNTOS   EQU   4             NON-OS DSN                                 01360000
VRNWYL   EQU   5             NOT LIBPAK/WYLBUR NAME                     01370000
VRDLEN   EQU   6             TOO FEW INDEX LEVELS                       01380000
VRDLON   EQU   7             TOO MANY INDEX LEVELS                      01390000
VRNWYX   EQU   8             INVALID SPECIAL (WYLBUR) INDEX             01400000
VRNPSW   EQU   9             NO PASSWORD ENTRY FOR WYLBUR USER          01410000
         SPACE 1                                                        01420000
VCMPARM  EQU   1   WCOMP/WDCOM:  INVALID PARM OR OPTION LIST            01430000
VCMNEDIT EQU   2             BLOCK NOT IN EDIT FORMAT                   01440000
VCMBKLEN EQU   3             INVALID BLOCK LENGTH                       01450000
VCMRCLEN EQU   4             INVALID/TRUNCATED RECORD LENGTH            01460000
VCMSEQ#  EQU   5             INVALID SEQUENCE # OR OVERFLOW             01470000
VCMSEQSQ EQU   6             LINE NUMBER OUT OF SEQUENCE                01480000
         SPACE 1                                                        01490000
./ ADD NAME=SERVICE
         MACRO ,                                                        00010000
&NM      SERVICE &CODE,&ADDR,&REG2,&ERR=,&CC0=,&CC4=,&CC8=,&LEN=,      *00020000
               &MAP=                                             87036  00030000
         GBLA  &SVC@SVC                                          83100  00040000
         GBLB  &SRVCM@P                                          85021  00050000
         GBLB  &SRV#NUT      USE TSA BASSM/SVC IF TRUE          GP03142 00060000
         GBLC  &MACPLAB,&SRVCM@R                                 81148  00070000
         LCLC  &LERR                                             81148  00080000
.*--------------------------------------------------------------------* 00090000
.*  SERVICE INVOKES THE @SERVICE ROUTINE IN ANY OF THREE WAYS:        * 00100000
.*  1) OLD MODE - IF SVC GLOBAL IS NON-ZERO, VIA SVC IGC00SVC         * 00110000
.*  2) OLD MODE - IF SVC GLOBAL IS ZERO, VIA BASSM                    * 00120000
.*  3) NEW MODE - EXECUTE INSTRUCTION (EITHER BASSM OR SVC); REQUIRES * 00130000
.*     NEW SERVINIT MACRO AND SERVDEFS IN SAVE AREA                   * 00140000
.*--------------------------------------------------------------------* 00150000
&NM      MACPARM R2,&REG2,NULL=SKIP                              85070  00160000
         MACPARM R1,&ADDR,NULL=SKIP                                     00170000
.NOR1    AIF   ('&CODE' EQ '').NOR0                                     00180000
         AIF   ('&CODE'(1,1) EQ '(').REG0                               00190000
         MACPARM R0,VEN&CODE                                            00200000
         AIF   ('&LEN' EQ '').NOR0                              GP99026 00210000
         MACPARM R0,8,=AL1(&LEN),OP=ICM,MODE=THREE              GP99026 00220000
         AGO   .NOR0                                                    00230000
.REG0    MACPARM R0,&CODE                                               00240000
.NOR0    AIF   (NOT &SRV#NUT).NOTEXEC                           GP03142 00250000
         AIF   ('&CODE' EQ 'LPALD').NOTSVC   DOESN'T WORK IN SVC        00260000
         MACPARM R15,@SERVICE,OP=L  GET MODULE ADDRESS          GP03142 00270000
         MACPARM 0,@SERVEXC,OP=EX  EXECUTE BASSM OR SVC         GP03142 00280000
         AGO   .COMSVC                                          GP03142 00290000
.NOTEXEC AIF   (&SVC@SVC EQ 0).NOTSVC                            83100  00300000
&MACPLAB SVC   &SVC@SVC      CALL THE SERVICE ROUTINE                   00310000
&MACPLAB SETC  ''                                                83100  00320000
         AGO   .COMSVC                                           83100  00330000
.NOTSVC  MACPARM R15,@SERVICE,OP=L  GET MODULE ADDRESS                  00340000
&MACPLAB BASSM R14,R15       CALL THE @SERVICE ROUTINE                  00350000
.COMSVC  AIF   ('&CC0' EQ '' AND '&CC4' EQ '' AND '&CC8' EQ '').NOCC    00360000
         AIF   ('&ERR' EQ '' OR '&ERR' EQ 'NO').NODUPE           81148  00370000
         MNOTE 4,'CC= AND ERR= ARE MUTUALLY EXCLUSIVE'           81148  00380000
.NODUPE  ANOP  ,                                                 81148  00390000
&MACPLAB SETC  ''                                                81148  00400000
         CH    R15,=H'4'     TEST RETURN                         81148  00410000
         MACPARM &CC0,OP=BL,OPR=BLR,MODE=ONE,NULL=SKIP          GP02241 00420000
         MACPARM &CC4,OP=BE,OPR=BER,MODE=ONE,NULL=SKIP          GP02241 00430000
         MACPARM &CC8,OP=BH,OPR=BHR,MODE=ONE,NULL=SKIP          GP02241 00440000
         AGO   .MEND                                             81148  00450000
.NOCC    AIF   ('&ERR' EQ 'NO').MEND                             81148  00460000
&LERR    SETC  '&ERR'                                            81148  00470000
         AIF   ('&LERR' NE '').DOERR                             81148  00480000
&LERR    SETC  '&SRVCM@R'                                        81148  00490000
         AIF   ('&LERR' EQ '').MEND                              81148  00500000
.DOERR   BXH   R15,R15,&LERR  GO TO SET ERROR MESSAGE            81148  00510000
.MEND    AIF   (&SRVCM@P OR '&MAP' EQ 'NO').MMEND                87036  00520000
&SRVCM@P SETB  1                                                 85021  00530000
         COPY  SERVFLAG                                          85021  00540000
.MMEND   MEND  ,                                                        00550000
./ ADD NAME=SERVINIT
         MACRO ,                                                        00010000
&NM    SERVINIT &LPA=YES,&MAP=YES,&ERR=,&LIST=NO,&AMODE=*,       81167 *00020000
               &MODE=NEW                                        GP03129 00030000
         GBLA  &SVC@SVC      SVC NUMBER OF @SERVICE              83100  00040000
         GBLB  &MVSESA                                          GP04234 00050000
         GBLB  &SRVCM@P,&SRV#NUT                                        00060000
         GBLC  &PRTMAC,&SRVCM@R,&MACPLAB                                00070000
         AIF   ('&MODE' EQ 'NEW' AND &MVSESA).CALLSUB           GP04234 00080000
&NM      MACPARM R15,15,@SERVICE,MODE=THREE,OP=ICM,OPR=ICM              00090000
         BNZ   ZZZZ&SYSNDX+4                                            00100000
         AIF   ('&LPA' NE 'YES').NOLPA                                  00110000
         AIF   (&SVC@SVC EQ 0).DOLPA                             83100  00120000
         SR    R0,R0         REQUEST GETMAIN/INITIALIZATION      83100  00130000
         SVC   &SVC@SVC      CALL IT                             83100  00140000
         AGO   .COMMON                                           83100  00150000
.DOLPA   LPALOOK EP=@SERVICE,DCB=4                              GP03262 00160000
         AGO   .COMMON                                                  00170000
.NOLPA   AIF   ('&LPA' NE 'LINK').DOLOAD                        GP09179 00180000
         L     R0,=V(@SERVICE)    LINK IN                       GP09179 00190000
         AGO   .COMMON                                          GP09179 00200000
.DOLOAD  LOAD  EP=@SERVICE                                              00210000
.COMMON  AIF   ('&AMODE' EQ '*' AND &MVSESA).BSM                GP04234 00220000
ZZZZ&SYSNDX ST R0,@SERVICE                                              00230000
         AIF   (NOT &MVSESA).COMSET                             GP04234 00240000
         AIF   ('&AMODE' EQ '31').AM31                          GP99124 00250000
         AIF   ('&AMODE' EQ '24').AM24                          GP99124 00260000
         MNOTE 4,'UNDEFINED AMODE=&AMODE - AM24 ASSUMED'        GP99124 00270000
.AM24    MVI   @SERVICE,0    FORCE LOW                          GP99124 00280000
         AGO   .COMSET                                          GP99124 00290000
.AM31    OI    @SERVICE,X'80'   SET AM31 ON BASSM INVOCATION    GP99124 00300000
         AGO   .COMSET                                          GP99124 00310000
.BSM     ANOP  ,                                                GP99124 00320000
ZZZZ&SYSNDX LR R15,R0        COPY ADDRESS                       GP99124 00330000
         BSM   R15,0         IMPART CURRENT MODE                GP99124 00340000
         ST    R15,@SERVICE  AND STASH IT                       GP99124 00350000
         AGO   .COMSET                                                  00360000
.*--------------------------------------------------------------------* 00370000
.*  NEW INTERFACE FOR EXTERNAL INITIALIZATION ROUTINE SUBSERV         * 00380000
.*--------------------------------------------------------------------* 00390000
.*                                                                      00400000
.CALLSUB ANOP  ,                                                GP03129 00410000
&NM      MACPARM R0,(R0),MODE=EVEN,OP=SR,OPR=SR                 GP03129 00420000
         MACPARM R1,@SERVICE   LOCATE THE SERVDEFS AREA         GP03129 00430000
         L     R15,=V(SUBSERV)  CALL INITIALIZATION ROUTINE     GP03129 00440000
         BASR  R14,R15       CALL IT                            GP03129 00450000
&SRV#NUT SETB  1             USE NEW INTERFACE                  GP03129 00460000
.COMSET  AIF   ('&ERR' EQ '').NOERR                              81148  00470000
&SRVCM@R SETC  ''                                                81148  00480000
         AIF   ('&ERR' EQ 'NO').NOERR                            81148  00490000
&SRVCM@R SETC  '&ERR'                                            81148  00500000
.NOERR   AIF   ('&MAP' EQ 'NO').MEND                                    00510000
         AIF   (&SRVCM@P).MEND                                          00520000
&SRVCM@P SETB  1                                                        00530000
         PUSH  PRINT                                                    00540000
         AIF   ('&LIST' NE 'NO').DOLIST                          81167  00550000
         PRINT OFF                                               81167  00560000
         AGO   .CMLIST                                           81167  00570000
.DOLIST  PRINT ON,GEN                                            81167  00580000
.CMLIST  SPACE 1                                                 81167  00590000
         COPY  SERVFLAG                                                 00600000
         POP   PRINT                                                    00610000
.MEND    MEND  ,                                                        00620000
./ ADD NAME=SERVJES
         MACRO ,                                                        00010000
&NM      SERVJES &DSECT=,&OPT=,&PFX=SJ                  ADDED ON 90274  00020000
         LCLC  &S,&P                                                    00030000
         LCLA  &I,&J                                                    00040000
&P       SETC  '&PFX'                                                   00050000
&S       SETC  '&NM'                                                    00060000
         AIF   ('&DSECT' EQ 'NO').NODS                                  00070000
         AIF   ('&S' NE '').DODS                                        00080000
&S       SETC  'SERVJES'                                                00090000
.DODS    ANOP  ,                                                        00100000
&S       DSECT ,             @SERVICE JES INTERFACE MAPPING             00110000
         AGO   .PODS                                                    00120000
.NODS    ANOP  ,                                                        00130000
&S       DS    0D            @SERVICE JES INTERFACE LIST                00140000
.PODS    ANOP  ,                                                        00150000
&P.SSNAM DS    CL8           SUB-SYSTEM NAME                            00160000
&P.SSTOK DS    XL8           TOKEN FOR ALESERV ACCESS           GP02327 00170000
&P.SSASC DS    A             JES2 ASCB ADDRESS                  GP02327 00180000
&P.SSASI DS    H             JES2 ASID                          GP02327 00190000
&P.SSCOM DS    C             OS COMMAND CHARACTER                90288  00200000
&P.SSRCH DS    C             READER COMMAND CHARACTER            90288  00210000
.SSLOOP  AIF   (&I GE N'&OPT).DONELUP                                   00220000
&I       SETA  &I+1                                                     00230000
&S       SETC  '&OPT(&I)'    GET NEXT OPTION                            00240000
         AIF   ('&S' EQ '').SSLOOP  BAD KEYPUNCHING ?                   00250000
         AIF   ('&S' EQ 'LOJOB').LOJOB                                  00260000
         AIF   ('&S' EQ 'J2INF').JESINFO                         90288  00270000
         MNOTE 4,'UNDEFINED OPT=&S '                                    00280000
         AGO   .SSLOOP                                                  00290000
.LOJOB   ORG   &P.SSNAM+8                                               00300000
&P.1JNAM DS    CL8           JOB NAME (REQ/RET)                         00310000
&P.1JNUM DS    CL8           JOB ID/NUMBER (EBCDIC)                     00320000
&P.1ACCT DS    CL8           ACCOUNT   (REQ/RET)                        00330000
&P.1JQOF DS    XL4           OFFSET TO JQE (REQ/RET)             90288  00340000
&P.1J### DS    HL2           JOB NUMBER (BINARY) (REQ/RET)              00350000
.*.1     DS    XL2             SPARE                                    00360000
&P.1FLGS DS    X             JES FLAGS                                  00370000
&P.F1HA  EQU   X'80'           HOLD ALL                          90288  00380000
&P.F1H1  EQU   X'40'           HOLD THIS JOB                     90288  00390000
&P.F1H2  EQU   X'20'           HOLD FOR DUPLICATE JOBNAME        90288  00400000
&P.F1PG  EQU   X'10'           PURGE REQUESTED                   90288  00410000
&P.F1OC  EQU   X'08'           OPERATOR CANCELLED                90288  00420000
&P.F1BSY EQU   X'07'           BUSY ON CPU #                     90288  00430000
&P.1FLG2 DS    X             JES FLAGS                                  00440000
&P.F1IAF EQU   X'80'           INIT/AFFINITY                     90288  00450000
&P.F1SAF EQU   X'7F'           SYSTEM AFFINITY                   90288  00460000
&P.1FLG3 DS    X             JES FLAGS                                  00470000
&P.F1MRQ EQU   X'80'           MOVE REQUESTED                    90288  00480000
&P.F1USP EQU   X'40'           UNSPOOLED IOT                     90288  00490000
&P.F1NDP EQU   X'20'           DON'T PROCESS ON SPOOL DUMP       90288  00500000
&P.F1SYD EQU   X'10'                                             90288  00510000
&P.F1TMD EQU   X'08'                                             90288  00520000
&P.F1XMT EQU   X'04'                                             90288  00530000
&P.F1JOB EQU   X'03'           JQE IS A BATCH JOB                90288  00540000
&P.F1TSU EQU   X'02'           JQE IS A TIME SHARING USER        90288  00550000
&P.F1STC EQU   X'01'           JQE IS A START JOB                90288  00560000
&P.1FLG4 DS    X             JES FLAGS                                  00570000
.*.F1    EQU   X'80'                                             90288  00580000
.*.F1    EQU   X'40'                                             90288  00590000
.*.F1    EQU   X'20'                                             90288  00600000
.*.F1    EQU   X'10'                                             90288  00610000
.*.F1    EQU   X'08'                                             90288  00620000
.*.F1    EQU   X'04'                                             90288  00630000
.*.F1    EQU   X'02'                                             90288  00640000
&P.F1JHD EQU   X'01'           TYPRUN=JCLHOLD                    90288  00650000
&P.1LFG1 DS    X             LOCAL FLAGS                                00660000
.*.F1    EQU   X'80'                                             90288  00670000
.*.F1    EQU   X'40'                                             90288  00680000
.*.F1    EQU   X'20'                                             90288  00690000
.*.F1    EQU   X'10'                                             90288  00700000
&P.F1NPT EQU   X'08'           NO PRINT WHEN SENT TO HOPE        90288  00710000
.*.F1    EQU   X'04'                                             90288  00720000
.*.F1    EQU   X'02'                                             90288  00730000
.*.F1    EQU   X'01'                                             90288  00740000
&P.1LFG2 DS    X             LOCAL FLAGS                                00750000
&P.F1HDT EQU   X'80'           USER REQUESTED HOLD               90288  00760000
&P.F1RRN EQU   X'40'           JOB RERUN PERMITTED               90288  00770000
&P.F1NST EQU   X'20'           NO-SETUP JOB                      90288  00780000
&P.F1FET EQU   X'10'           ROUTE TO FETCH AFTER EXECUTION    90288  00790000
&P.F1NFY EQU   X'08'           NOTIFY USER                       90288  00800000
&P.F1PAS EQU   X'04'           PASSWORD SUPPLIED AND VERIFIED    90288  00810000
.*.F1    EQU   X'02'                                             90288  00820000
.*.F1    EQU   X'01'                                             90288  00830000
&P.1OCLS DS    0X            ORIGINAL CLASS (LOCAL)                     00840000
&P.1LFG3 DS    X             LOCAL FLAGS                                00850000
&P.1OPTY DS    0X            ORIGINAL PRIORITY                          00860000
&P.1LFG4 DS    X             LOCAL FLAGS                                00870000
&P.1QNAM DS    CL4           QUEUE NAME                                 00880000
&P.1CLS  DS    X             QUEUE TYPE                                 00890000
&P.1QUE  DS    XL2           QUEUE OFFSET                               00900000
&P.1PTY  DS    X             JOB PRIORITY                               00910000
         DS    4X            SPARE                                      00920000
         AGO   .SSLOOP                                                  00930000
.JESINFO ANOP  ,                                                 90288  00940000
&P.2VERS DS    CL8           $HCT VERSION                        90288  00950000
&P.2TON  DS    AL2           THIS NODE (BINARY)                 GP02328 00960000
&P.2TOQ  DS    C,C           THIS NODE (EBCDIC)                  90288  00970000
&P.2MSYS DS    AL2           MAXIMUM SYSTEM NUMBER              GP02328 00980000
&P.2MRJE DS    AL2           MAXIMUM REMOTE NUMBER               90288  00990000
&P.2$HCT DS    A             $HCT ADDRESS                       GP02327 01000000
&P.2$CAT DS    A             $CAT ADDRESS                       GP02327 01010000
&P.2$DCT DS    A             $DCT/RAT ADDRESS                   GP02327 01020000
&P.2$JOB DS    A             $JOBQPTR ADDRESS                   GP02327 01030000
&P.2$JOT DS    A             $JOT ADDRESS                       GP02327 01040000
&P.2$JQH DS    A             $JQHEAD ADDRESS                    GP02327 01050000
&P.2$QNX DS    A             $QINDEXA                           GP02327 01060000
&P.2COMC DS    C             OS COMMAND CHARACTER               GP04234 01070000
&P.2COMR DS    C             READER COMMAND CHARACTER           GP04234 01080000
         DS    2X              SPARES                           GP04234 01090000
         DS    7A              SPARES                            90288  01100000
         AGO   .SSLOOP                                           90288  01110000
.DONELUP ORG   ,                                                        01120000
         MEND  ,                                                        01130000
./ ADD NAME=SERVLOAD
         MACRO ,                                                        00010000
&NM      SERVLOAD &NAME1,&NAME2,&LFETCH=NO                      GP03246 00020000
.*--------------------------------------------------------------------* 00030000
.*  SERVLOAD INVOKES THE @SERVICE ROUTINE TO LOAD AND STORE MODULES   * 00040000
.*  USING STANDARD CONVENTIONS (E.G., @INPREAD, @PRINTER)             * 00050000
.*  MODULE NAME IS THE SAME AS THE ADDRESS {I.E., @INPREAD DC A(0)}   * 00060000
.*  UNLESS A SECOND PARAMETER IS SPECIFIED {E.G., (@INPREAD,READER) } * 00070000
.*    A THIRD SUBPARAMETER OF N MAY BE SPECIFIED TO INHIBIT EXPANSION * 00080000
.*  OF A DS BY SERVDEFS                                               * 00090000
.*                                                                    * 00100000
.*  2006-06-28  GYP  ADDED LFETCH VALUE LINK. EXPANDS V-CONSTANT TO   * 00110000
.*                   FORCE LINKER TO INCLUDE MODULE STATICALLY.       * 00120000
.*  2003-09-03  GYP  ADDED LFETCH KEYWORD. LFETCH=NO USES SERVCALL    * 00130000
.*                   LPA LOAD (OR PLAIN LOAD IF NOT IN LP); LFETCH=Y  * 00140000
.*                   USES LOAD; LFETCH=DFLT USES SERVCALL UNLESS      * 00150000
.*                   THE DEBUG SWITCH IS SET, THEN IT USES LOAD.      * 00160000
.*--------------------------------------------------------------------* 00170000
         GBLC  &MACPLAB                                                 00180000
         GBLC  &SRVLMOD(20),&SRVLDEL(20)                                00190000
         GBLB  &SRVBMOD(20),&BUGBEAR                            GP03246 00200000
         GBLA  &SRVNMOD                                                 00210000
         LCLC  &CL,&CM                                                  00220000
         LCLB  &USELOAD                                         GP03246 00230000
         LCLA  &I,&J,&K,&N                                              00240000
&N       SETA  N'&SYSLIST                                               00250000
&MACPLAB SETC  '&NM'                                                    00260000
         AIF   ('&LFETCH' EQ '').DEFLOAD                        GP03246 00270000
         AIF   ('&LFETCH'(1,1) EQ 'Y').SETLOAD                  GP03246 00280000
         AIF   ('&LFETCH' EQ 'LINK').SETLOAD                    GP09179 00290000
         AIF   ('&LFETCH'(1,1) EQ 'N').SVCLOAD                  GP03246 00300000
         AIF   ('&LFETCH' EQ 'DFLT').DEFLOAD                    GP09179 00310000
         MNOTE 4,'SERVLOAD: LFETCH=&LFETCH UNSUPPORTED; USING DFLT'     00320000
.DEFLOAD AIF   (NOT &BUGBEAR).SVCLOAD                           GP03246 00330000
.SETLOAD ANOP  ,                                                GP03246 00340000
&USELOAD SETB  1             USE LOAD RATHER THAN SERVCALL LPALD        00350000
.SVCLOAD AIF   (&N LT 1).OOPS                                   GP03246 00360000
.MEMLOOP AIF   (&I GE &N).TEST                                          00370000
&I       SETA  &I+1                                                     00380000
&SRVBMOD(&SRVNMOD+1) SETB 0    JUST IN CASE                             00390000
.*--------------------------------------------------------------------* 00400000
.*  SUBOPERAND OF FORM (MOD-NAME,DC-NAME)                             * 00410000
.*--------------------------------------------------------------------* 00420000
         AIF   (N'&SYSLIST(&I) EQ 1).TRYONE                             00430000
         AIF   ('&SYSLIST(&I,1)' EQ '').MEMLOOP                         00440000
&CL      SETC  '&SYSLIST(&I,1)'                                         00450000
&CM      SETC  '&SYSLIST(&I,1)'                                         00460000
         AIF   ('&SYSLIST(&I,2)' EQ '').SEE3SUB                         00470000
&CM      SETC  '&SYSLIST(&I,2)'                                         00480000
         AGO   .SEE3                                                    00490000
.SEE3SUB AIF   (K'&CL LT 4).SEE3                                        00500000
&K       SETA  K'&CM                                                    00510000
         AIF   ('&CL'(1,3) NE 'SUB').SEE3                               00520000
&CM      SETC  '&CM'(4,&K-3)                                    GP12154 00530000
&CM      SETC  '@UB'.'&CM.'      '                              GP12154 00540000
&CM      SETC  '&CM'(1,8)                                               00550000
.SEE3    AIF   (N'&SYSLIST(&I) LT 3).DONTWO                             00560000
         AIF   ('&SYSLIST(&I,3)' NE 'N' AND '&SYSLIST(&I,3)' NE 'NO'   *00570000
               AND '&SYSLIST(&I,3)' NE '''N''').DONTWO                  00580000
&SRVBMOD(&SRVNMOD+1) SETB 1    INHIBIT DS/DC EXPANSION                  00590000
         AGO   .DONTWO                                                  00600000
.*--------------------------------------------------------------------* 00610000
.*  SUBOPERAND OF FORM MOD-NAME - SAVE IN SAME NAME UNLESS SUB----    * 00620000
.*--------------------------------------------------------------------* 00630000
.TRYONE  ANOP  ,                                                        00640000
&CL      SETC  '&SYSLIST(&I)'                                           00650000
&CM      SETC  '&SYSLIST(&I)'                                           00660000
         AIF   (K'&CL LT 4).DONTWO                                      00670000
         AIF   ('&CL'(1,3) NE 'SUB').DONTWO                             00680000
&K       SETA  K'&CM                                                    00690000
&CM      SETC  '&CM'(4,&K-3)                                    GP12154 00700000
&CM      SETC  '@UB'.'&CM.'      '                              GP12154 00710000
&CM      SETC  '&CM'(1,8)                                               00720000
.DONTWO  AIF   ('&CL' EQ '').MEMLOOP                                    00730000
&J       SETA  &J+1                                                     00740000
         AIF   (&USELOAD).DOLOAD                                GP03246 00750000
.DOSVC   ANOP  ,                                                GP05013 00760000
         SERVCALL LPALD,=CL8'&CL '                              GP05013 00770000
         AGO   .SV8COM                                          GP03246 00780000
.DOLOAD  AIF   ('&LFETCH' NE 'LINK').SV8LOAD                    GP09179 00790000
&MACPLAB L     R0,=V(&CL)    LINK MODULE                        GP09179 00800000
         AGO   .SV8COM                                          GP09179 00810000
.SV8LOAD ANOP  ,                                                GP09179 00820000
&MACPLAB LOAD  0,EPLOC==CL8'&CL '                               GP03250 00830000
.SV8COM  ANOP  ,                                                GP09179 00840000
&MACPLAB SETC  ''                                               GP03250 00850000
         ST    R0,&CM                                           GP03246 00860000
.*--------------------------------------------------------------------* 00870000
.*  REMEMBER DS NAME FOR SAVE AREA; IF DS DIFFERENT, REMEMBER DELETE  * 00880000
.*--------------------------------------------------------------------* 00890000
&SRVNMOD SETA  &SRVNMOD+1                                               00900000
&SRVLMOD(&SRVNMOD) SETC  '&CM'                                          00910000
&SRVLDEL(&SRVNMOD) SETC  '&CL'                                          00920000
         AGO   .MEMLOOP                                                 00930000
.TEST    AIF   (&J GT 0).GOODBYE                                        00940000
.OOPS    MNOTE 0,'SERVLOAD - NO USABLE MODULE NAMES SPECIFIED'          00950000
         MACPARM MODE=LBL                                               00960000
.GOODBYE MEND  ,                                                        00970000
./ ADD NAME=SERVPDS
         MACRO ,                                                        00010000
&NM      SERVPDS &DSECT=YES,&PFX=PDD,&RETURN=,&VER=2,&OPT=      GP98365 00020000
.*   CHANGED FOR Y2K SUPPORT, ETC. (NOT FOR PGM OBJECTS)        GP98365 00030000
         LCLC  &P,&NAME                                                 00040000
&NAME    SETC  '&NM'                                                    00050000
&P       SETC  'PDD'                                                    00060000
         AIF   ('&NAME' NE '').HAVENM                                   00070000
&NAME    SETC  'SERVPDS'                                                00080000
.HAVENM  AIF   ('&DSECT' NE 'YES').NOSECT                               00090000
&NAME    DSECT ,                                                        00100000
         AGO   .TESTP                                                   00110000
.NOSECT  AIF   ('&NM' EQ '').TESTP                                      00120000
&NM      DS    0A .                                                     00130000
.TESTP   AIF   ('&PFX' EQ '').HAVEP                                     00140000
&P       SETC  '&PFX'                                                   00150000
.HAVEP   AIF   ('&OPT' EQ 'DISPLAY').DISPLAY  EXHIBIT FORMAT    GP08274 00160000
         AIF   (&VER EQ 1).OLDVER                               GP98365 00170000
&P.NEXT  DC    A(0)          ADDRESS OF CURRENT MEMBER                  00180000
&P.INCR  DC    A(0)          BXLE INCREMENT FOR CURRENT MEMBER          00190000
&P.LAST  DC    A(0)          LAST USED BYTE IN BLOCK                    00200000
&P.RECFM DC    AL1(0)        RECFM                                      00210000
&P.TYPE  DC    X'00'         ENTRY TYPE                                 00220000
&P.TLKED EQU   X'80'           LINKAGE EDITOR ENTRY                     00230000
&P.TSPF  EQU   X'40'           SPF ENTRY                                00240000
&P.TWYL  EQU   X'20'           WYLBUR ENTRY (LOCAL)                     00250000
&P.TDTX  EQU   X'10'           IEBUPDTX ENTRY                           00260000
&P.FLAGS DC    X'00'         ENTRY FLAGS (FIELDS PRESENT)               00270000
&P.AOSLE EQU   X'80'           PRODUCED BY VS LINKAGE EDITOR            00280000
&P.FREAL EQU   X'40'           MAIN MEMBER/EPA PRESENT                  00290000
&P.FSSI  EQU   X'10'           SSI FIELD PRESENT                        00300000
&P.FAPF  EQU   X'08'           APF FIELD PRESENT                        00310000
&P.FSCTR EQU   X'04'           SCATTER LOAD MODULE                      00320000
&P.FLAG2 DC    X'00'         SECOND FLAG BYTE                   GP98365 00330000
&P.FLAG3 DC    X'00'         THIRD FLAG BYTE                    GP98365 00340000
&P.UDLEN DC    X'00'         NUMBER OF HALFWORDS OF USER DATA           00350000
&P.OSSI  DC    H'0'          OFFSET TO SSI FROM NAME                    00360000
&P.OAPF  DC    H'0'          OFFSET TO APF FROM NAME                    00370000
         DC    4H'0'         EXTRA FOR EXPANSION                GP98365 00380000
&P.CLRLN EQU   *-&P.TYPE       LENGTH TO CLEAR                          00390000
         AIF   ('&OPT' EQ 'BASIC').MEND                         GP08274 00400000
         AIF   (T'&RETURN EQ 'O').MEND                          GP98365 00410000
         AIF   ('&RETURN' NE 'DSECT').NODS2                     GP98365 00420000
SERVPDSR DSECT ,                                                GP98365 00430000
.NODS2   ANOP  ,                                                GP98365 00440000
&P.RALIS DC    C' '          BLANK OR * FOR ALIAS               GP98365 00450000
&P.RNAME DC    CL8' '        EDITED MEMBER NAME                 GP98365 00460000
&P.RSSI  DC    CL8' '        SSI OR BLANKS                      GP98365 00470000
&P.RYMD  DC    CL8' '        CHANGE DATE YYYYMMDD               GP98365 00480000
&P.RJDAY DC    CL3' '        CHANGE DATE JJJ (JULIAN FORM)      GP98365 00490000
&P.RAPF  DC    CL4'AC=N'     APF OR BLANKS                      GP98365 00500000
&P.RMAIN DC    CL8' '        MAIN MEMBER OR SPF UID OR BLANKS   GP98365 00510000
&P.RRMOD DC    CL3' '        24 OR 31 - RESIDENCE MODE (OR ANY) GP98365 00520000
&P.RAMOD DC    CL3' '        24 OR 31 - ADDRESSING MODE         GP98365 00530000
&P.RBLNK EQU   *-&P.RALIS      LENGTH TO BLANK                  GP98365 00540000
         AGO   .MEND                                            GP98365 00550000
.OLDVER  AIF   (&VER EQ 1).VERONE                               GP98365 00560000
         MNOTE 8,'PLEASE USE VER=1 OR VER=2 TO MATCH SERVCALL'  GP98365 00570000
.VERONE  ANOP  ,                                                GP98365 00580000
&P.NEXT  DC    A(0)          ADDRESS OF CURRENT MEMBER          GP98365 00590000
&P.INCR  DC    A(0)          BXLE INCREMENT FOR CURRENT MEMBER  GP98365 00600000
&P.LAST  DC    A(0)          LAST USED BYTE IN BLOCK            GP98365 00610000
&P.RECFM DC    AL1(0)        RECFM                              GP98365 00620000
&P.TYPE  DC    X'00'         ENTRY TYPE                         GP98365 00630000
&P.TLKED EQU   X'80'           LINKAGE EDITOR ENTRY             GP98365 00640000
&P.TSPF  EQU   X'40'           SPF ENTRY                        GP98365 00650000
&P.TWYL  EQU   X'20'           WYLBUR ENTRY (LOCAL)             GP98365 00660000
&P.TDTX  EQU   X'10'           IEBUPDTX ENTRY                   GP98365 00670000
&P.FLAGS DC    X'00'         ENTRY FLAGS (FIELDS PRESENT)       GP98365 00680000
&P.AOSLE EQU   X'80'           PRODUCED BY VS LINKAGE EDITOR    GP98365 00690000
&P.FREAL EQU   X'40'           MAIN MEMBER/EPA PRESENT          GP98365 00700000
&P.FSSI  EQU   X'10'           SSI FIELD PRESENT                GP98365 00710000
&P.FAPF  EQU   X'08'           APF FIELD PRESENT                GP98365 00720000
&P.FSCTR EQU   X'04'           SCATTER LOAD MODULE              GP98365 00730000
&P.UDLEN DC    X'00'         NUMBER OF HALFWORDS OF USER DATA   GP98365 00740000
&P.OSSI  DC    H'0'          OFFSET TO SSI FROM NAME            GP98365 00750000
&P.OAPF  DC    H'0'          OFFSET TO APF FROM NAME            GP98365 00760000
&P.CLRLN EQU   *-&P.TYPE       LENGTH TO CLEAR                  GP98365 00770000
         AIF   ('&OPT' EQ 'BASIC').MEND                         GP08274 00780000
         AIF   (T'&RETURN EQ 'O').MEND                          GP98365 00790000
         AIF   ('&RETURN' NE 'DSECT').NODS                              00800000
SERVPDSR DSECT ,                                                        00810000
.NODS    ANOP  ,                                                        00820000
&P.RALIS DC    C' '          BLANK OR * FOR ALIAS                       00830000
&P.RNAME DC    CL8' '        EDITED MEMBER NAME                         00840000
&P.RSSI  DC    CL8' '        SSI OR BLANKS                              00850000
&P.RDATE DC    CL5' '        CHANGE DATE OR BLANKS                      00860000
&P.RAPF  DC    CL4'AC=N'     APF OR BLANKS                              00870000
&P.RMAIN DC    CL8' '        MAIN MEMBER OR SPF UID OR BLANKS           00880000
&P.RRMOD DC    CL2' '        24 OR 31 - RESIDENCE MODE           90204  00890000
&P.RAMOD DC    CL2' '        24 OR 31 - ADDRESSING MODE          90204  00900000
&P.RBLNK EQU   *-&P.RALIS      LENGTH TO BLANK                          00910000
         MEXIT ,                                                        00920000
.DISPLAY ANOP  ,             FORMATTED FOR 80 BYTE DISPLAY LINE         00930000
.*    USED BY SUBROUTINE SUBXDEFM                                       00940000
&P.RALIS DS    C             ALIAS INDICATOR                            00950000
&P.RNAME DS    CL8           MEMBER OR ALIAS NAME                       00960000
         DS    C                                                        00970000
&P.RTTR  DS    CL6           TTR OF FIRST RECORD                 81319  00980000
         DS    C                                                        00990000
&P.REPAD DS    CL6                                                      01000000
         DS    C                                                        01010000
&P.SIZE  DS    CL6                                                      01020000
         DS    C                                                        01030000
&P.TXT   DS    CL6                                                      01040000
         DS    CL2                                                      01050000
&P.RATTR DS    CL32          LKED OPTION FIELD                          01060000
&P.RATTN EQU   L'&P.RATTR/5    (TEMP)                           GP08274 01070000
         DS    C                                                        01080000
&P.RMODE DS    CL4                                              GP08274 01090000
         DS    C                                                GP08274 01100000
&P.RAPF  DS    CL4                                              GP08274 01110000
         DS    C                                                GP08274 01120000
&P.RMAIN DS    CL8                                              GP08274 01130000
         DS    C                                                        01140000
&P.RSSI  DS    CL8                                                      01150000
&P.EQU   EQU   *                                                        01160000
         SPACE 1                                                 80150  01170000
         ORG   &P.REPAD      REDEFINE FOR NON-LKED ENTRY         80150  01180000
&P.NSSI  DS    CL8           SSI FIELD                           80150  01190000
         DS    C                                                 80150  01200000
&P.DATA  DS    CL54          USER DATA                           80150  01210000
         SPACE 1                                                 83178  01220000
         ORG   &P.REPAD                                          83178  01230000
DSFCENT  DC    CL8'CCYY.DDD' DATE MODIFIED                      GP08274 01240000
         DC    C' '                                             GP08274 01250000
DSFTIM   DC    C'HH:MM'      TIME MODIFIED                       83178  01260000
         DC    C' '                                              83178  01270000
DSFDVER  DC    C'V'          VERSION ID                         GP08274 01280000
DSFVER   DC    C'MM.NN'      VERSION/ MOD                       GP08274 01290000
         DC    C' '                                              83178  01300000
DSFDUID  DC    C'U='                                             83178  01310000
DSFUID   DC    CL7' ',C' '   WYLBUR USES 8                       83178  01320000
         DC    C' '                                              83178  01330000
DSFLCUR  DC    CL7' ',C' '                                       83178  01340000
DSFDCL2  DC    C'CUR',C' '                                       83178  01350000
DSFLMOD  DC    CL7' ',C' '                                       83178  01360000
DSFDCL3  DC    C'CHG'                                            83178  01370000
         SPACE 1                                                 83178  01380000
         ORG   &P.REPAD                                          83178  01390000
DSXMAIN  DC    CL8' '        MAIN MEMBER                        GP08274 01400000
DSXVER   DC    C'VMM.NN',C' '                                   GP08274 01410000
DSXCENT  DC    C'CCYY.DDD',C' '                                 GP08274 01420000
DSXTIME  DC    C'HH:MM',C' '                                    GP08274 01430000
.MEND    MEND  ,                                                        01440000
./ ADD NAME=SERVSORT
         MACRO ,                                                        00010000
&NM      SERVSORT &DSECT=YES,&PFX=SOP,&LOW=0,&HIGH=0,&SEQ=C'A',        *00020000
               &COO=0,&COL=0,&LEN=0                     ADDED ON 82024  00030000
         LCLC  &P,&NAME                                                 00040000
&NAME    SETC  '&NM'                                                    00050000
&P       SETC  'SOP'                                                    00060000
         AIF   ('&NAME' NE '').HAVENM                                   00070000
&NAME    SETC  'SERVSORT'                                               00080000
.HAVENM  AIF   ('&DSECT' NE 'YES').NOSECT                               00090000
&NAME    DSECT ,                                                        00100000
         AGO   .TESTP                                                   00110000
.NOSECT  AIF   ('&NM' EQ '').TESTP                                      00120000
&NM      DS    0A .                                                     00130000
.TESTP   AIF   ('&PFX' EQ '').HAVEP                                     00140000
&P       SETC  '&PFX'                                                   00150000
.HAVEP   ANOP  ,                                                        00160000
&P.LOW   DC    A(&LOW)       LOWEST ENTRY ADDRESS                       00170000
&P.FAD   EQU   X'80'         ON IN HIGH TO SIGNAL ADDRESS               00180000
&P.HIGH  DC    A(&HIGH)      ADDRESS (-) / ELSE # OF ENTRIES            00190000
&P.SEQ   DC    AL1(&SEQ)     SORT SEQUENCE (C'A' OR C'D')               00200000
&P.COO   DC    AL1(&COO)     COMPARE OFFSET                             00210000
&P.COL   DC    AL1(&COL)     COMPARE LENGTH                             00220000
&P.LEN   DC    AL1(&LEN)     ENTRY LENGTH                               00230000
         MEND  ,                                                        00240000
./ ADD NAME=SERVTERM
         MACRO ,                                                        00010000
&NM    SERVTERM &DELETE=YES                             ADDED ON 81148  00020000
         GBLC  &MACPLAB                                                 00030000
         GBLC  &SRVLMOD(20),&SRVLDEL(20)                        GP03258 00040000
         GBLB  &MVSXA                                           GP04234 00050000
         GBLA  &SRVNMOD                                         GP03258 00060000
.*--------------------------------------------------------------------* 00070000
.*  SERVTERM OPTIONALLY FREES MODULES LOADED BY SERVLOAD (W/EXPLICIT  * 00080000
.*    SECOND NAME).                                                   * 00090000
.*  SERVTERM CALLS @SERVICE TO CLOSE AND FREE KNOWN WORK AREAS AND    * 00100000
.*    MODULES                                                         * 00110000
.*  SERVTERM FREES AND CLEARS THE @SERVICE POINTER                    * 00120000
.*--------------------------------------------------------------------* 00130000
         LCLA  &I,&J                                            GP03258 00140000
         LCLC  &X                                               GP03258 00150000
&X       SETC  '&SYSNDX'                                        GP03258 00160000
&NM      MACPARM R15,15,@SERVICE,OP=ICM,MODE=THREE                      00170000
         BZ    ZZZZ&SYSNDX                                              00180000
         SR    R0,R0                                                    00190000
         AIF   (&MVSXA).BASSM                                   GP04234 00200000
         BALR  R14,R15       CLOSE/FREE                         GP04234 00210000
         AGO   .DELETE                                          GP04234 00220000
.BASSM   BASSM R14,R15       CLOSE/FREE                                 00230000
.DELETE  DELETE EP=@SERVICE                                             00240000
ZZZZ&SYSNDX XC @SERVICE,@SERVICE                                        00250000
         AIF   ('&DELETE' NE 'YES').SKIPDEL                     GP03258 00260000
.DELLOOP AIF   (&I GE &SRVNMOD).SKIPDEL                         GP03258 00270000
&I       SETA  &I+1                                             GP03258 00280000
         AIF   ('&SRVLMOD(&I)' EQ '' OR '&SRVLDEL(&I)' EQ '').DELLOOP   00290000
         MACPARM R15,15,&SRVLMOD(&I),OP=ICM,MODE=THREE          GP03258 00300000
&J       SETA  &J+1                                             GP03258 00310000
         BZ    ZZ&X.D&J                                         GP03258 00320000
&MACPLAB SETC  'ZZ&X.D'.'&J'                                    GP03258 00330000
         DELETE EPLOC==CL8'&SRVLDEL(&I) '                       GP03258 00340000
         XC    &SRVLMOD(&I).(4),&SRVLMOD(&I)                    GP03258 00350000
         AGO   .DELLOOP                                         GP03258 00360000
.SKIPDEL MACPARM MODE=LBL    EXPAND FINAL LABEL                 GP03258 00370000
         MEND  ,                                                        00380000
./ ADD NAME=SERVTREE
         MACRO ,                                                        00010000
&NM      SERVTREE &PFX=?,&KEYLEN=4,&KEYOFF=0,&RECLEN=256,              *00020000
               &RECNUM=64*1024                                          00030000
         AIF   ('&NM' EQ '').NOLAB                                      00040000
&NM      DS    0A            TREE WORK AREA                             00050000
.NOLAB   ANOP  ,                                                        00060000
&PFX.ID    DC  C'TREE'       IDENTIFIER FOR THIS                        00070000
&PFX.HEAD  DC  2A(0)         HEAD OF TREE                               00080000
&PFX.WORK  DC  A(0)          ADDRESS OF WORK AREA                       00090000
&PFX.@REC  DC  A(0)          ADDRESS OF RECORD (SAME AS R1)             00100000
&PFX.COUNT DC  A(&RECNUM)    NUMBER OF RECORDS (ESTIMATED)              00110000
&PFX.RECL  DC  AL2(&RECLEN)  LENGTH OF RECORD (INCLUDING KEY)           00120000
&PFX.KEYO  DC  AL2(&KEYOFF)  KEY OFFSET IN RECORD                       00130000
&PFX.KEYL  DC  AL1(&KEYLEN)  KEY LENGTH                                 00140000
&PFX.REC   DC  CL(&RECLEN)' '  CURRENT RECORD (OR JUST KEY FOR LOC)     00150000
&PFX.SIZE  EQU *-&PFX.ID     SIZE OF USER CONTROL AREA                  00160000
         MEND  ,                                                        00170000
./ ADD NAME=SERVWORK
         MACRO ,                                                        00010000
&NM      SERVWORK &ID,&LEN,&REG=R13,&OPT=GET,&OREG=R9,&BASE=R6,&PREG=   00020000
.*--------------------------------------------------------------------* 00030000
.*  SERVWORK IS USED BY RESIDENT FUNCTIONS (@SERVICE, @PRINTER, ETC.) * 00040000
.*  TO MANAGE WORK AREAS.                                             * 00050000
.*    OPT=GET LOCATES A WORK AREA FOR THE FUNCTION, OR OBTAINS IT     * 00060000
.*      (R15=0 - OLD ADDRESS OF FSA HEADER IN R1; USER ADDRESS IN R0) * 00070000
.*      (R15=4 - R1, R0 SAME; STORAGE OBTAINED ON THIS CALL)          * 00080000
.*                                                                    * 00090000
.*    OPT=SHARE OR OPT=SHR FUNCTIONS LIKE OPT=GET, EXCEPT THAT A WORK * 00100000
.*      ARE OBTAINED PREVIOUSLY BY A HIGHER TASK WILL BE USED.        * 00110000
.*                                                                    * 00120000
.*    OPT=RELEASE FREES THE WORK AREA (LEN PARAMETER EITHER WORK AREA * 00130000
.*      ADDRESS OR ZERO)                                              * 00140000
.*                                                                    * 00150000
.*    ID - RESERVED FOUR BYTE FUNCTION NAME (E.G., '@PAR'), OR        * 00160000
.*      ADDRESS OF FOUR-BYTE NAME                                     * 00170000
.*    LEN - FSALEN (FSAPFXL+USER LENGTH)                              * 00180000
.*--------------------------------------------------------------------* 00190000
         GBLC  &MACPLAB                                                 00200000
         GBLC  &ZZZLNM(128)                                             00210000
         GBLB  &ZZZLFG,&MVSESA                                          00220000
         GBLA  &ZZZLNO                                                  00230000
         LCLC  &WHO,&ARG                                                00240000
         LCLA  &I,&N                                                    00250000
         LCLC  &TAG                                             GP05019 00260000
&TAG     SETC  'S@'.'&SYSNDX'                                   GP05019 00270000
&WHO     SETC  'SUBSERVW'    GET/LOCATE STORAGE                         00280000
&MACPLAB SETC  '&NM'                                                    00290000
         AIF   (NOT &MVSESA).OLDSTYL                            GP05019 00300000
         AIF   ('&OPT' NE 'SHR' AND '&OPT' NE 'SHARE').UNSHARE  GP03312 00310000
&WHO     SETC  'SUBSERVS'    GET/LOCATE SHARED STORAGE          GP03312 00320000
.UNSHARE AIF   ('&OPT' NE 'RELEASE').GET                        GP03312 00330000
&WHO     SETC  'SUBSERVZ'    RELEASE STORAGE                            00340000
.GET     AIF   (&ZZZLFG).INITDEF                                        00350000
&ZZZLFG  SETB  1             SHOW DEFINED                               00360000
.*--------------------------------------------------------------------* 00370000
.*  DEFINE MODULE<->ORDINAL CORRESPONDENCE FOR MAPTSA WORK AREA       * 00380000
.*    LISTED MODULES MAY OBTAIN A WORK AREA USING THE SERVWORK MACRO  * 00390000
.*    WITH FAST ACCESS (FIXED OFFSET IN TSA). APPROXIMATELY SAME AS   * 00400000
.*    MODULES IN @SERVICE LOADLIST                                    * 00410000
.*--------------------------------------------------------------------* 00420000
.*ZZLNM(000) SETC '@SERVICE'   MUST BE FIRST ONE BY DESIGN              00430000
&ZZZLNM(001) SETC '@SCREENS'   MUST BE FIRST TWO BY DESIGN              00440000
&ZZZLNM(002) SETC '@PRINTER'   MUST BE FIRST TWO BY DESIGN              00450000
&ZZZLNM(003) SETC '@BANDAID'                                            00460000
&ZZZLNM(004) SETC '@CATREAD'                                            00470000
&ZZZLNM(005) SETC '@CVLREAD'                                            00480000
&ZZZLNM(006) SETC '@DCBEXIT'                                            00490000
&ZZZLNM(007) SETC '@FDRREAD'                                            00500000
&ZZZLNM(008) SETC '@FORMATS'                                            00510000
&ZZZLNM(009) SETC '@INPREAD'                                            00520000
&ZZZLNM(010) SETC '@MESSAGE'                                            00530000
&ZZZLNM(011) SETC '@OBTAINS'                                            00540000
&ZZZLNM(012) SETC '@PARSER '                                            00550000
&ZZZLNM(013) SETC '@PROTECS'                                            00560000
&ZZZLNM(014) SETC '@SRVJES2'                                            00570000
&ZZZLNM(015) SETC '@TMSREAD'                                            00580000
&ZZZLNM(016) SETC '@VOLREAD'                                            00590000
&ZZZLNM(017) SETC '@WRITER '                                            00600000
&ZZZLNM(018) SETC 'DEBTRACE'                                            00610000
&ZZZLNM(019) SETC 'LEXVOLT '                                            00620000
&ZZZLNM(020) SETC 'PGMTRACE'                                            00630000
&ZZZLNM(021) SETC 'SUBCAT  '                                            00640000
&ZZZLNM(022) SETC 'SUBCOMP '                                            00650000
&ZZZLNM(023) SETC 'SUBCOMP '                                            00660000
&ZZZLNM(024) SETC 'SUBTIMER'                                            00670000
&ZZZLNM(025) SETC 'SUBWTO  '                                            00680000
&ZZZLNO  SETA  25                     NUMBER OF ENTRIES                 00690000
.INITDEF AIF   ('&OPT' EQ 'EXPAND').MAKEDC                              00700000
&ARG     SETC  '&ID'                                                    00710000
         AIF   ('&ID'(1,1) NE '''').LOOKED                              00720000
&N       SETA  K'&ID                                                    00730000
&ARG     SETC  '&ID'(2,&N-2)                                            00740000
.ARGNQ   ANOP  ,                                                        00750000
&ARG     SETC  '&ARG'.'        '                                        00760000
&ARG     SETC  '&ARG'(1,4)                                              00770000
.LOOKLUP AIF   (&I GE &ZZZLNO).LOOKED                                   00780000
&I       SETA  &I+1                                                     00790000
         AIF   ('&ZZZLNM(&I)'(1,4) NE '&ARG').LOOKLUP                   00800000
         MACPARM R0,&I                                                  00810000
         AGO   .DONLIT                                                  00820000
.LOOKED  AIF   ('&ID'(1,1) NE '''').NOTLIT                              00830000
         MACPARM R0,=CL4&ID                                             00840000
         AGO   .DONLIT                                                  00850000
.NOTLIT  MACPARM R0,&ID                                                 00860000
.DONLIT  AIF   ('&OPT' NE 'RELEASE').NEEDLEN                            00870000
         MACPARM R1,&LEN,NULL=0   CLEAR IF NOT USER SPECIFIED           00880000
         AGO   .COMLEN                                                  00890000
.NEEDLEN MACPARM R1,&LEN     LOAD THE WORK AREA LENGTH                  00900000
.COMLEN  MACPARM R15,=V(&WHO),OP=L                                      00910000
         MACPARM R14,(R15),OPR=BALR                                     00920000
         AIF  ('&REG' EQ '' OR '&OPT' NE 'GET').MEND                    00930000
         MACPARM &REG(1),(R0),OP=LR  LOAD SAVE AREA (FSAWORK+FSAPFXL)   00940000
         MEXIT ,                                                        00950000
.OLDSTYL AIF   ('&OPT' EQ 'EXPAND').MEND                                00960000
         AIF   ('&OPT' EQ 'SHR' OR '&OPT' EQ 'SHARE').OLDGET    GP05019 00970000
         AIF   ('&OPT' EQ 'RELEASE').OLDREL                     GP05019 00980000
.OLDGET  PUSH  USING                                            GP05019 00990000
.*    REGISTER USE DURING SETUP                                         01000000
.*    R1 - TEMP GETMAIN/OBTAIN RETURN                                   01010000
.*    R2 - CHAIN ELEMENT (WORK AREA) ID                                 01020000
.*    R3 - WORK AREA LENGTH                                             01030000
.*    R4 - CURRENT TCB                                                  01040000
.*    R6 - NEW WORK AREA ADDRESS                                        01050000
.*    R7 - TEMP CHAIN CHASING                                           01060000
.*                                                                      01070000
&NM      LTCB  R4,USE=YES    GET MY TCB                         GP05019 01080000
&MACPLAB SETC  ''                                               GP05019 01090000
         AIF   ('&ID' NE '').OHVID                              GP05019 01100000
&WHO     SETC  '&SYSECT'(1,4)                                   GP05019 01110000
         L     R2,=CL4'&WHO'                                    GP05019 01120000
         AGO   .OCMID                                           GP05019 01130000
.OHVID   AIF   ('&ID'(1,1) NE '''').OICID                       GP05019 01140000
         ICM   R2,15,=CL4&ID                                    GP05019 01150000
         AGO   .OCMID                                           GP05019 01160000
.OICID   MACPARM R2,15,&ID,OP=ICM,MODE=THREE                    GP05019 01170000
.OCMID   L     R7,TCBFSA     POINT TO CHAIN HEAD                GP05019 01180000
         N     R7,=X'00FFFFFF'  CLEAN FOR AM31                  GP05019 01190000
         SR    R6,R6         CLEAR HIGH BYTE                            01200000
         SR    R15,R15       PRESET RETURN CODE                         01210000
&TAG.L   ICM   R6,7,1(R7)    LAST ENTRY ON CHAIN ?              GP05019 01220000
         BZ    &TAG.G        YES; GET A WORK AREA               GP05019 01230000
         USING FSAWORK,R6    DECLARE IT                                 01240000
         CL    R2,FSAID      SAME ID ?                                  01250000
         BE    &TAG.H        YES; USE IT                        GP05019 01260000
         LR    R7,R6         SWAP                                       01270000
         B     &TAG.L        TRY AGAIN                          GP05019 01280000
&MACPLAB SETC  '&TAG.G'                                                 01290000
         AIF   ('&PREG' EQ '').ONEND                            GP05020 01300000
         MACPARM &PREG,(&PREG),OP=LTR,OPR=LTR,MODE=EVEN         GP05020 01310000
         BZ    &TAG.Z        NO STORAGE IF CLOSE CALL           GP05020 01320000
.ONEND   MACPARM R3,&LEN,NULL=FSALEN LN OF WORK AREA            GP05019 01330000
         STORAGE OBTAIN,LENGTH=(R3),COND=YES,LOC=BELOW          GP05019 01340000
         BXLE  R15,R15,&TAG.W  CLEAR IT                         GP05019 01350000
&TAG.Z   LM    R14,R12,12(R13)  ERROR IN PROCESSING OR ENVIRONMENT      01360000
         LA    R15,16        SET MAJOR ERROR                            01370000
         SLR   R0,R0         INDICATE ENVIRONMENT (PGM ERROR)           01380000
         BSM   0,R14         RETURN                             GP99026 01390000
         SPACE 1                                                        01400000
         DROP  R6                                                       01410000
         USING FSAWORK,R7                                               01420000
&TAG.W   LR    R6,R1         COPY THIS ONE TO PERMANENT REGISTER        01430000
         LR    R14,R1        COPY FOR MVCL                      GP05019 01440000
         LR    R15,R3                                           GP05019 01450000
         SR    R1,R1                                            GP05019 01460000
         MVCL  R14,R0        CLEAR GOTTEN AREA                  GP05019 01470000
         MVC   FSALINK-FSAWORK(4,R6),FSALINK  CHAIN OLD AREA    GP05019 01480000
         ST    R6,FSALINK    CHAIN THIS AHEAD OF OLD ONE        GP05019 01490000
         DROP  R7                                                       01500000
         USING FSAWORK,R6                                               01510000
         ST    R2,FSAID      SET ID OF THIS AREA                        01520000
         ST    R3,FSASPLEN   SAVE GETMAIN LENGTH                        01530000
         ST    R4,FSATCB     AND TCB                                    01540000
         LA    R15,4         FLAG NEW AREA                      GP05019 01550000
&MACPLAB SETC  '&TAG.H'                                         GP05019 01560000
         MACPARM &BASE,(R6)  PUT INTO USER'S REGISTER           GP05019 01570000
         AIF   ('&REG' EQ '' OR '&OREG' EQ '').ONSAVE           GP05019 01580000
         MACPARM &OREG,(&REG) PRESERVE OLD SAVE                 GP05019 01590000
         LA    &REG,SAVEAREA  HARD-CODED NAME                   GP05019 01600000
         ST    &REG,8(,&OREG) CHAIN                             GP05019 01610000
         ST    &OREG,4(,&REG) LINK                              GP05019 01620000
.ONSAVE  MACPARM MODE=LBL                                       GP05019 01630000
         POP   USING         SKIP ALL BUT BLANKS                GP05019 01640000
         MEXIT ,                                                        01650000
.OLDREL  ANOP  ,                                                        01660000
         PUSH  USING                                            GP05019 01670000
&NM      LA    &OREG,0(,R13)   GET CLEAN SAVE AREA              GP05019 01680000
         SH    &OREG,=AL2(SAVEAREA-FSAWORK)  BACK TO BEGINNING  GP05019 01690000
         USING FSAWORK,&OREG                                    GP05019 01700000
         L     R13,4(,R13)   GET CALLER'S SAVE AREA             GP05019 01710000
         LM    R2,R3,FSASPLEN  GET LENGTH AND TCB BACK                  01720000
         L     R3,TCBFSA-TCB(,R3)  POINT TO CHAIN HEAD                  01730000
         N     R3,=X'00FFFFFF'                                  GP05019 01740000
&TAG.L   CLM   &OREG,7,1(R3)    POINTER TO OUR AREA ?           GP05019 01750000
         BE    &TAG.F        YES; UNCHAIN                       GP05019 01760000
         ICM   R3,7,1(R3)    GET NEXT ENTRY                             01770000
         BNZ   &TAG.L        CHECK IT                           GP05019 01780000
         ABEND 222,DUMP      SHOULD NEVER HAPPEN ?                      01790000
         SPACE 1                                                        01800000
&TAG.F   MVC   0(4,R3),FSALINK  UNCHAIN OURS                            01810000
         LR    R15,R2        GET SUBPOOL AND LENGTH             GP05019 01820000
         SRL   R15,24        FIX SUBPOOL                        GP05019 01830000
         N     R0,=X'00FFFFFF'   DELETE SUBPOOL                 GP05019 01840000
         STORAGE RELEASE,ADDR=(&OREG),LENGTH=(R2),SP=(15),COND=YES      01850000
         LM    R14,R12,12(R13)    RELOAD CALLER'S REGS          GP05019 01860000
         SR    R15,R15       SET GOOD RETURN                    GP05019 01870000
         BSM   0,R14         RETURN                             GP99026 01880000
         POP   USING                                                    01890000
         MEXIT ,                                                        01900000
.MAKEDC  ANOP  ,                                                        01910000
&NM      DC    &ZZZLNO.D'0'  FIXED OFFSET WORK AREA POINTERS            01920000
         DC    (64-&ZZZLNO)D'0'   FUTURE EXPANSION                      01930000
.MEND    MEND  ,                                                        01940000
./ ADD NAME=SETAM
         MACRO ,                                                        00010000
&NM      SETAM &AM           SET AMODE PER PARAMETER                    00020000
         GBLC  &MACPLAB                                                 00030000
  AIF   ('&AM' EQ '31' OR '&AM' EQ 'AM31' OR '&AM' EQ 'AMODE31').AM31   00040000
  AIF   ('&AM' EQ '24' OR '&AM' EQ 'AM24' OR '&AM' EQ 'AMODE24').AM24   00050000
&MACPLAB SETC  '&NM'                                                    00060000
         AIF   ('&AM' EQ '' OR '&AM' EQ 'ANY').LBL                      00070000
         MNOTE 4,'SETAM: INVALID MODE &AM'                              00080000
.LBL     MACPARM MODE=LBL                                               00090000
         MEXIT ,                                                        00100000
.AM31    ANOP  ,                                                        00110000
 &NM     AM31  WORK=R15                                                 00120000
         MEXIT ,                                                        00130000
.AM24    ANOP  ,                                                        00140000
 &NM     AM24  WORK=R15                                                 00150000
         MEND  ,                                                        00160000
./ ADD NAME=SETCC
         MACRO ,                                                        00010000
&N       SETCC &CODE,&REAS,&RESULT=                    NEW 2003.091 GYP 00020000
.*                                                                      00030000
.*   SETCC replaces a condition code, and optional reason code,         00040000
.*   provided it is higher than the current one.                        00050000
.*                                                                      00060000
.*   For unconditional setting see MVICC and OICC                       00070000
.*                                                                      00080000
.*   &CODE MAY NOT SPECIFY A REGISTER                                   00090000
.*                                                                      00100000
         GBLC  &ZZCCNAM                                                 00110000
         LCLC  &L,&T                                                    00120000
&L       SETC  'L'''                                                    00130000
&T       SETC  'ZZ'.'&SYSNDX'.'X'                                       00140000
         AIF   ('&RESULT' EQ '').NONEW                                  00150000
&ZZCCNAM SETC  '&RESULT'                                                00160000
.NONEW   AIF   ('&ZZCCNAM' NE '').NODEF                                 00170000
         MNOTE *,'SETCC: RESULT= NOT SPECIFIED - DEFAULTED TO RETCODE'  00180000
&ZZCCNAM SETC  'RETCODE'                                                00190000
.NODEF   ANOP  ,                                                        00200000
&N MACPARM &ZZCCNAM+&L&ZZCCNAM-1,&CODE,OP=CLI,OPR=CLM,NULL=SKIP,       *00210000
               MODE=REV                                                 00220000
         MACPARM &T,OP=BNL,MODE=ONE   NO CHANGE UNLESS HIGHER CODE      00230000
   MACPARM &ZZCCNAM+&L&ZZCCNAM-1,&CODE,OP=MVI,OPR=STC,NULL=SKIP,       *00240000
               MODE=REV                                                 00250000
   MACPARM &ZZCCNAM+&L&ZZCCNAM+3,&REAS,OP=MVI,OPR=STC,NULL=SKIP,       *00260000
               MODE=REV                                                 00270000
&T       MACPARM MODE=LABEL                                             00280000
         MEND  ,                                                        00290000
./ ADD NAME=SMFSEAC
         MACRO ,                                                        00010000
&NM      SMFSEAC &P=SEAC                                ADDED ON 85270  00020000
.*       THIS MACRO DEFINES THE RECORDS WRITTEN BY THE NCR/COMTEN       00030000
.*       SEAC (STATISTICS AND EXTENDED ACCESS CONTROL) PROGRAMS.        00040000
.*                                                                      00050000
         AIF   ('&NM' EQ '').NONAME                                     00060000
&NM      DS    0F            SEAC SMF RECORD                            00070000
.NONAME  ANOP  ,                                                        00080000
&P.RDW   DC    Y(&P.END-*,0)   RECORD DESCRIPTOR                        00090000
&P.SYIN  DC    X'02'         SYSTEM ID (VS)                             00100000
&P.TYPE  DC    AL1(&P.SMF#)  RECORD TYPE                                00110000
&P.SMF#  EQU   X'C9'         DEFAULT RECORD TYPE 201                    00120000
&P.TIME  DC    XL4'0'        TIME RECORDED                              00130000
&P.DATE  DC    PL4'0'        DATE RECORDED                              00140000
&P.SID   DC    CL4' '        SYSTEM/MODEL ID                            00150000
&P.IDAT  DC    PL4'0'        DATE RECORD INITIALIZED                    00160000
&P.ITIM  DC    XL4'0'        TIME RECORD INITIALIZED (1/1000 SECS)      00170000
&P.TDAT  DC    PL4'0'        DATE RECORD CLOSED                         00180000
&P.TTIM  DC    XL4'0'        TIME RECORD CLOSED      (1/1000 SECS)      00190000
&P.VERS  DC    X'0'          SEAC VERSION                               00200000
&P.RTYP  DC    X'00'         RECORD TYPE                                00210000
&P.RTOK  EQU   0               NORMAL RECORD                            00220000
&P.RTTR  EQU   1               TIME-RELEASED RECORD                     00230000
&P.RTBU  EQU   2               BUSY RECORD                              00240000
&P.RTSR  EQU   3               SECURITY RECORD                          00250000
&P.HCH   DC    X'00'         HOST INTERFACE NUMBER                      00260000
&P.HSCH  DC    X'00'         HOST SUBCHANNEL NUMBER                     00270000
&P.EMU   DC    X'00'         CONTROLLING EMULATOR ID                    00280000
&P.CMF   DC    X'00'         MIM FUNCTION # FOR ABOVE                   00290000
&P.TLN   DC    XL2'0'        # OF PHYS LINE ON TERMINAL'S NODE          00300000
         DC    FL4'0'          RESERVED                          85273  00310000
         DC    FL4'0'          RESERVED                          85273  00320000
&P.WTCT  DC    XL4'0'        # OF WRITE COMMANDS FROM HOST              00330000
&P.RDCT  DC    XL4'0'        # OF READ/INHIBIT COMMANDS FROM HOST       00340000
&P.ACFG  DC    X'00'         ACCESS CONTROL FLAG (FOR SEC.RCD)          00350000
&P.SATT  DC    X'00'         # OF INVALID PASSWORDS ENTERED             00360000
         DC    Y(0)            SPARE                             85273  00370000
         DC    FL4'0'          SPARE                             85273  00380000
&P.HCC   DC    XL4'0'        # DATA CHARACTERS SENT BY HOST             00390000
&P.TCC   DC    XL4'0'        # DATA CHARACTERS SENT TO HOST             00400000
         DC    FL4'0'          SPARE                             85273  00410000
         DC    FL4'0'          SPARE                             85273  00420000
         DC    FL4'0'          SPARE                             85273  00430000
         DC    FL4'0'          SPARE                             85273  00440000
         DC    FL4'0'          SPARE                             85273  00450000
         DC    FL4'0'          SPARE                             85273  00460000
&P.HSIT  DC    CL3' '        SENDING NODE'S NAME (FROM CMT GEN)         00470000
         DC    C' '            SPARE                             85273  00480000
&P.TSIT  DC    CL3' '        TERMINAL'S NODE'S NAME                     00490000
         DC    C' '            SPARE                             85273  00500000
&P.WRU   DC    CL8' '        WRU ANSWERBACK CHARACTERS                  00510000
&P.TILS  DC    CL8' '        TILS SWITCHING CHARACTERS USED             00520000
&P.LSET  DC    CL8' '        LINESET (FROM EXTEN= MACRO)                00530000
&P.PASS  DS    0CL8' '       LAST INVALID PASSWORD                      00540000
&P.USID  DC    CL8' '        USER                                       00550000
&P.END   EQU   *               END OF LONGEST RECORD                    00560000
.*                                                                      00570000
.*       LOST DATA RECORD                                               00580000
.*                                                                      00590000
&P.RTLD  EQU   X'0F'           LOST DATA RECORD                         00600000
         ORG   &P.HCH                                                   00610000
&P.LDTY  DC    X'00'         REASON CODE                                00620000
&P.LRNI  EQU   X'01'           SEACSMF NOT INITIALIZED (BAD TIME)       00630000
&P.LRBS  EQU   X'02'           BUFFER SLOW-DOWN                         00640000
&P.LRFI  EQU   X'03'           SEACSMF FAILD AFTER INITIALIZATION       00650000
         DS    X                                                        00660000
         DS    FL4                                                      00670000
&P.SMFD  DC    PL4'0'        DATE FAILED                                00680000
&P.SMFT  DC    XL4'0'        TIME FAILED                                00690000
&P.USEK  DC    Y(0)          # OF LOST DATA USERS                       00700000
&P.LOGK  DC    Y(0)          # OF LOST DATA LOGONS                      00710000
&P.BUSK  DC    Y(0)          # LOST BUSY RECORDS                        00720000
&P.UAAK  DC    XL2'0'        # LOST SECURITY RECORDS                    00730000
         DS    2FL4                                                     00740000
&P.LDBU  DC    Y(0)          # BUFFERS USED BY SEAC                     00750000
&P.LDBM  DC    Y(0)          MAXIMUM BUFFERS GIVEN TO SEAC              00760000
&P.LDBT  DC    Y(0)          BUFFER DEPLETION LEVEL                     00770000
&P.LDBS  DC    Y(0)          BUFFER SLOWDOWN LEVEL                      00780000
&P.LDRU  DC    Y(0)          ACTIVE SEAC RECORDS USED                   00790000
&P.LDRM  DC    Y(0)          MAXIMUM SEAC RECORDS USED                  00800000
&P.LDQU  DC    Y(0)          ACTIVE TRANSMIT QUEUE COUNT                00810000
&P.LDQM  DC    Y(0)          MAXIMUM TRANSMIT QUEUE COUNT               00820000
&P.LDSM  DC    FL4'0'        MAXIMUM SYSTEM SEAC RECORDS                00830000
         ORG   &P.END        ENSURE PROPER LENGTH                       00840000
         MEND  ,                                                        00850000
./ ADD NAME=SMPIOWK
         MACRO                                                          00010000
       SMPIOWK ,                                                        00020000
         GBLA  &SMPREL       SMP RELEASE NUMBER                  79216  00030000
         MAPIOWK                                                        00040000
         SPACE 3                                                        00050000
         ORG   DRDSN .       REDEFINE DSN FOR HEADER                    00060000
SYSDSN   DS    CL4 .         CDS/ACDS/PTS                               00070000
         DS    C                                                        00080000
SYSVS    DS    CL6 .         VOL-SER                                    00090000
         DS    C                                                        00100000
SYSREL   DS    CL4 .         SYSTEM RELEASE TYPE/NUMBER                 00110000
         DS    C                                                        00120000
SYSTSO   DS    CL3 .         TSO                                        00130000
         DS    C                                                        00140000
SYSNUCC  DS    C'NUC' .      IDENTIFIER                                 00150000
SYSNUC   DS    C .           NUCLEUS NUMBER                             00160000
         DS    C                                                        00170000
SYSPEMC  DS    C'PE'                                                    00180000
SYSPEM   DS    CL5 .         PEMAX VALUE                         79216  00190000
         DS    CL3 ,         SPACER                              79216  00200000
SYSMEM   DS    CL8 .         CURRENT MEMBER NAME                        00210000
         SPACE 1                                                        00220000
         ORG   DRBUF                                                    00230000
DMCDSWK  DS    0F ,          SMP WORK AREA                              00240000
SCANCCW1 CCW   X'E9',0,X'60',8    SEARCH KEY <= DMKEY2                  00250000
SCANCCW2 DC    0A(0),X'08',AL3(0),A(0)    TIC BACK                      00260000
SCANCCW3 CCW   X'06',0,X'40',256  READ DATA INTO DMDE2                  00270000
SCANCCW4 CCW   X'92',0,0,8   READ CCHHR FOR NEXT TTR                    00280000
         SPACE 1                                                        00290000
OPFLAGS  DS    0CL2 .        USER SPECIFIED PROCESSING OPTIONS          00300000
OPF1     DC    X'0' .        LIBRARY TYPE/OPTIONS                       00310000
OPF1CDS  EQU   X'80' .       THIS IS A CDS                              00320000
OPF1ACDS EQU   X'40' .       ACDS                                       00330000
OPF1PTS  EQU   X'20' .       PTS                                        00340000
OPF1HLD  EQU   X'10' .       HLDS                                       00350000
OPF1NOT  EQU   X'01' .       MEMBER NOT FOUND/EMPTY DS/NO LIST OPTION   00360000
         SPACE 1                                                        00370000
OPF2     DC    X'0' .        LISTING FLAGS                              00380000
OPF2FULL EQU   X'80' .       LIST ASSEM/LDMOD CONTROL CARDS             00390000
OPF2ASM  EQU   X'40' .       LIST ASSEMBLER ENTRIES                     00400000
OPF2MAC  EQU   X'20' .       LIST MACRO ENTRIES                         00410000
OPF2MOD  EQU   X'10' .       LIST OBJECT MODULE ENTRIES                 00420000
OPF2LOAD EQU   X'08' .       LIST LOAD MODULE ENTRIES                   00430000
OPF2PTF  EQU   X'04' .       LIST PTF ENTRIES                           00440000
OPF2DLIB EQU   X'02' .       LIST DLIB ENTRIES                          00450000
         SPACE 1                                                        00460000
DMW1     DC    X'0' .        PROCESSING BYTE                            00470000
DMW2     DC    X'0' .         DITTO                                     00480000
DMPUTSAV DS    9F .          REGISTER SAVE AREA                         00490000
DMPUTS9  DS    F .           RETURN REGISTER SAVE AREA                  00500000
DMDEAT   DS    3A .          DIRECTORY ENTRY SCAN POINTERS              00510000
DMTTR    DC    A(0) .        TTR FOR SEQUENTIAL READ                    00520000
DMSCANT  DC    A(0) .        TTR FOR SCAN START                         00530000
DMTRTAB  DS    CL256 .       TRANSLATE TABLE                            00540000
DMTRINDX DS    5XL3 .        NAME/TTR INDEX FOR FASTER SCANNING         00550000
         SPACE 1                                                        00560000
         DS    0F ,          ALIGN                                      00570000
DMDE     DS    XL264 .       PRIMARY PROCESSING DIRECTORY BLOCK         00580000
DMKEY2   DS    CL8 .         KEY FIELD FOR SECOND BLOCK                 00590000
DMDE2    DS    XL256 .       SECONDARY DIRECTORY BLOCK                  00600000
DMDATA   DS    10CL80 .      DATA INPUT FIELD                           00610000
DMDATEND DS    9X'FF' .      SCAN STOPPER                               00620000
         ORG   ,                                                        00630000
         SPACE 3                                                        00640000
CDSDSECT DSECT ,             MAP THE CDS DIRECTORY ENTRIES              00650000
IOPNAME  DC    0CL8' ',X'0' . NAME/FLAG FIELD                           00660000
IOPCDTYP EQU   X'C0' .       OBJ IF ON/ASM IF OFF                       00670000
IOPCDTYL EQU   X'40' .       LOAD MODULE ENTRY                          00680000
IOPCDTYM EQU   X'80' .       MACRO ENTRY                                00690000
IOPTYPE  EQU   X'F0' .       SPECIAL ENTRY IF ALL ON                    00700000
IOPTYPED EQU   X'F0' .       DLIB ENTRY                                 00710000
IOPTYPES EQU   X'F1' .       SYSTEM ENTRY                               00720000
IOPTYPEE EQU   X'F2' .       EOF ENTRY                                  00730000
IOPTYPEP EQU   X'F9' .       PTF ENTRY                                  00740000
IOPNAME2 DS    CL7 .         REST OF NAME                               00750000
IOPTTR   DS    XL3 .         TTR OF DATA, EXTENDED DIRECTORY OR EOF RCD 00760000
IOPUSERL DS    X .           ALIAS FLAG; # OF USER DATA HALFWORDS       00770000
IOPUSERS EQU   *                                                        00780000
         AIF   (&SMPREL GT 1).NEWSMP                             79216  00790000
         SPACE 1                                                        00800000
*     OBJECT MODULE ENTRY                                               00810000
*                                                                       00820000
         ORG   IOPUSERS                                                 00830000
IOPMODID DS    CL2 .         ID OF PTF OR LOCAL OWNER                   00840000
IOPDLIB  DS    CL7 .         DISTRIBUTION LIBRARY                       00850000
IOPLMODS DS    CL8 .         LOAD MODULE NAMES                          00860000
         SPACE 1                                                        00870000
*     LOAD MODULE ENTRY                                                 00880000
*                                                                       00890000
         ORG   IOPUSERS                                                 00900000
IOPFLGS2 DS    X .           LKED ATTRIBUTES                            00910000
IOPAPF   EQU   X'80' .       ?                                          00920000
IOPRENT  EQU   X'40' .       RE-ENTRANT                                 00930000
IOPREUS  EQU   X'20' .       RE-USABLE                                  00940000
IOPSCTR  EQU   X'10' .       SCATTER LOADED                             00950000
IOPOVLY  EQU   X'08' .       OVERLAY                                    00960000
IOPREFR  EQU   X'04' .       RE-FRESHABLE                               00970000
IOPDC    EQU   X'02' .       DOWNWARD CONTEMPTIBLE                      00980000
IOPNE    EQU   X'01' .       NOT EDITABLE                               00990000
IOPFLGS3 DS    X .           ATTRIBUTE RELATED FLAGS                    01000000
IOPCOPY  EQU   X'80' .       COPIED AT SYSGEN TIME                      01010000
IOPLINK  EQU   X'40' .       LKED PARMS OBTAINED                        01020000
IOPCHREP EQU   X'20' .       TEXT INCLUDES CHANGE/REPLACE STATEMENTS    01030000
IOPSYSLB DS    CL8 .         LIBRARIES LINKED TO                 79217  01040000
IOPSYSL2 DS    CL8 .         ...                                 79217  01050000
         SPACE 1                                                        01060000
*     MACRO ENTRY                                                       01070000
*                                                                       01080000
         ORG   IOPUSERS                                                 01090000
         DS    CL2 .         OWNER ID                                   01100000
IOPASMOD DS    CL8 .         UP TO 50 NAMES OF REASSEMBLY MODULE NAMES  01110000
         SPACE 1                                                        01120000
*     PTF ENTRY                                                         01130000
*                                                                       01140000
         ORG   IOPUSERS                                                 01150000
IOPFLGS5 DS    X .           PROCESSING FLAGS                           01160000
IOPAPP   EQU   X'80' .       APPLIED                                    01170000
IOPACC   EQU   X'40' .       ACCEPTED                                   01180000
IOPFORCE EQU   X'20' .       FORCE RECEIVED                             01190000
IOPDUMMP EQU   X'10' .       NAME OF SUPERCEDING PTF EXISTS             01200000
IOPREGEN EQU   X'08' .       PTF APPLIED VIA SYSTEM REGENERATION        01210000
IOPDATE  DS    PL3 .         DATE OF RECEIVE                            01220000
IOPPNTRY DS    0CL9 .        SUPERCEDING PTF / LIST OF MODULES CHANGED  01230000
IOPPMODS DS    CL8 .         MODULE NAME                                01240000
IOPPIND  DS    X .           SUB-TYPE                                   01250000
IOPPIND0 EQU   0 .           MACRO CHANGE/REPLACE                       01260000
IOPPIND1 EQU   1 .           OBJECT MODULE REPLACEMENT                  01270000
IOPPIND2 EQU   2 .           ZAP (EITHER S/ZAP OR X/ZAP)                01280000
         SPACE 1                                                        01290000
*     SYSTEM ENTRY                                                      01300000
*                                                                       01310000
         ORG   IOPUSERS                                                 01320000
IOPFLGS7 DS    X .           SYSTEM OPTION FLAGS                        01330000
IOPTSO   EQU   X'80' .       SYSTEM HAS TSO                             01340000
IOPSREL  DS    CL4 .         SYSTEM TYPE/RELEASE                        01350000
IOPNUCID DS    C .           NUCLEUS NUMBER                             01360000
IOPPEMAX DS    AL2 .         MAX ENTRIES FOR RECEIVE PRIOR TO ACCEPT    01370000
IOPPDLM  DS    X'FF' .       END OF LIST DELIMITER                      01380000
         SPACE 1                                                        01390000
*     DLIB ENTRY                                                        01400000
*                                                                       01410000
         ORG   IOPUSERS                                                 01420000
IOPDSYS  DS    CL8 .         LIBRARIES COPIED TO DURING GEN             01430000
IOPDSYS2 DS    CL8                                               79216  01440000
         SPACE 2                                                        01450000
***   PTS LIBRARY ENTRY                                                 01460000
*                                                                       01470000
         ORG   IOPUSERS                                                 01480000
IOPPFLG1 DS    X .           LIBRARY PROCESSING                         01490000
IOPLIBLK EQU   X'80' .       INDIRECT LINKLIB                           01500000
IOPLIBTX EQU   X'40' .       INDIRECT TEXT LIBRARY                      01510000
IOPTALIS EQU   X'20' .       TARGET ALIAS EXISTS                        01520000
IOPDALIS EQU   X'10' .       DISTRIBUTION ALIAS EXISTS                  01530000
IOPDISTN DS    CL8 .         DLIB NAME                                  01540000
IOPINDLB DS    CL8 .         LIBRARY FROM HEADER                        01550000
IOPALISL DS    CL8 .         ALIAS ENTRIES                              01560000
         ORG   ,                                                        01570000
         MEXIT ,                                                 79216  01580000
.NEWSMP  SPACE 1                                                 79216  01590000
*     OBJECT MODULE ENTRY                                        79216  01600000
*                                                                79216  01610000
         ORG   IOPUSERS                                          79216  01620000
         DS    X                                                 79216  01630000
IOPMODAP DS    CL7           PTF/APAR NUMBER                     79216  01640000
IOPMODID DS    CL4 .         ID OF PTF OR LOCAL OWNER            79216  01650000
         DS    X                                                 79216  01660000
IOPDLIB  DS    CL8 .         DISTRIBUTION LIBRARY                79216  01670000
IOPLMODS DS    CL8 .         LOAD MODULE NAMES                   79216  01680000
         SPACE 1                                                 79216  01690000
*     LOAD MODULE ENTRY                                          79216  01700000
*                                                                79216  01710000
         ORG   IOPUSERS                                          79216  01720000
IOPFLGS2 DS    X .           LKED ATTRIBUTES                     79216  01730000
IOPAPF   EQU   X'80' .       ?                                   79216  01740000
IOPRENT  EQU   X'40' .       RE-ENTRANT                          79216  01750000
IOPREUS  EQU   X'20' .       RE-USABLE                           79216  01760000
IOPSCTR  EQU   X'10' .       SCATTER LOADED                      79216  01770000
IOPOVLY  EQU   X'08' .       OVERLAY                             79216  01780000
IOPREFR  EQU   X'04' .       RE-FRESHABLE                        79216  01790000
IOPDC    EQU   X'02' .       DOWNWARD CONTEMPTIBLE               79216  01800000
IOPNE    EQU   X'01' .       NOT EDITABLE                        79216  01810000
IOPFLGS3 DS    X .           ATTRIBUTE RELATED FLAGS             79216  01820000
IOPCOPY  EQU   X'80' .       COPIED AT SYSGEN TIME               79216  01830000
IOPLINK  EQU   X'40' .       LKED PARMS OBTAINED                 79216  01840000
IOPCHREP EQU   X'20' .       TEXT INCLUDES CHANGE/REPLACE STATEMENTS    01850000
IOPLODID DS    XL4                                               79216  01860000
IOPSYSLB DS    CL8 .         LIBRARIES LINKED TO                 79217  01870000
         DS    X                                                 79217  01880000
IOPSYSL2 DS    CL8 .         ...                                 79217  01890000
         SPACE 1                                                 79216  01900000
*     MACRO ENTRY                                                79216  01910000
*                                                                79216  01920000
         ORG   IOPUSERS                                          79216  01930000
         DS    X                                                 79216  01940000
IOPMACAP DS    CL7           PTF/APAR LEVEL                      79216  01950000
IOPMACID DS    XL3                                               79217  01960000
IOPASMOD DS    CL8 .         UP TO 50 NAMES OF REASSEMBLY MODULE NAMES  01970000
         SPACE 1                                                 79216  01980000
*     PTF ENTRY                                                  79216  01990000
*                                                                79216  02000000
         ORG   IOPUSERS                                          79216  02010000
         DS    X                                                 79216  02020000
IOPFLGS5 DS    X .           PROCESSING FLAGS                    79216  02030000
IOPAPP   EQU   X'80' .       APPLIED                             79216  02040000
IOPACC   EQU   X'40' .       ACCEPTED                            79216  02050000
IOPFORCE EQU   X'20' .       FORCE RECEIVED                      79216  02060000
IOPDUMMP EQU   X'10' .       NAME OF SUPERCEDING PTF EXISTS      79216  02070000
IOPREGEN EQU   X'08' .       PTF APPLIED VIA SYSTEM REGENERATION 79216  02080000
         DS    XL3                                               79216  02090000
IOPPMODS DS    CL7           SUPER. PTF #                        79216  02100000
         DS    X                                                 79216  02110000
IOPDATE  DS    PL3 .         DATE OF RECEIVE                     79216  02120000
IOPPNTRY DS    CL8 .         MODULE NAME                         79216  02130000
IOPPIND  DS    X .           SUB-TYPE                            79216  02140000
IOPPIND0 EQU   0 .           MACRO CHANGE/REPLACE                79216  02150000
IOPPIND1 EQU   1 .           OBJECT MODULE REPLACEMENT           79216  02160000
IOPPIND2 EQU   2 .           ZAP (EITHER S/ZAP OR X/ZAP)         79216  02170000
         SPACE 1                                                 79216  02180000
*     SYSTEM ENTRY                                               79216  02190000
*                                                                79216  02200000
         ORG   IOPUSERS                                          79216  02210000
         DS    XL2                                               79216  02220000
IOPFLGS7 DS    X .           SYSTEM OPTION FLAGS                 79216  02230000
IOPTSO   EQU   X'80' .       SYSTEM HAS TSO                      79216  02240000
IOPSREL  DS    CL4 .         SYSTEM TYPE/RELEASE                 79216  02250000
IOPNUCID DS    C .           NUCLEUS NUMBER                      79216  02260000
IOPPEMAX DS    AL2 .         MAX ENTRIES FOR RECEIVE PRIOR TO ACCEPT    02270000
IOPPDLM  DS    X'FF' .       END OF LIST DELIMITER               79216  02280000
         SPACE 1                                                 79216  02290000
*     DLIB ENTRY                                                 79216  02300000
*                                                                79216  02310000
         ORG   IOPUSERS                                          79216  02320000
         DS    X                                                 79216  02330000
IOPDSYS  DS    CL8 .         LIBRARIES COPIED TO DURING GEN      79216  02340000
         DS    X                                                 79216  02350000
IOPDSYS2 DS    CL8                                               79216  02360000
         SPACE 2                                                 79216  02370000
***   PTS LIBRARY ENTRY                                          79216  02380000
*                                                                79216  02390000
         ORG   IOPUSERS                                          79216  02400000
IOPPFLG1 DS    X .           LIBRARY PROCESSING                  79216  02410000
IOPLIBLK EQU   X'80' .       INDIRECT LINKLIB                    79216  02420000
IOPLIBTX EQU   X'40' .       INDIRECT TEXT LIBRARY               79216  02430000
IOPTALIS EQU   X'20' .       TARGET ALIAS EXISTS                 79216  02440000
IOPDALIS EQU   X'10' .       DISTRIBUTION ALIAS EXISTS           79216  02450000
IOPDISTN DS    CL8 .         DLIB NAME                           79216  02460000
IOPINDLB DS    CL8 .         LIBRARY FROM HEADER                 79216  02470000
IOPALISL DS    CL8 .         ALIAS ENTRIES                       79216  02480000
         ORG   ,                                                 79216  02490000
         MEND  ,                                                 79216  02500000
./ ADD NAME=#SORT
         MACRO                                                          00010000
&NAME    #SORT &FIELDS=(1,1,CH,A),&FIRST=,&LAST=,&LENGTH=               00020000
         MNOTE *,'       #SORT     VERSION 001 04/29/76  04/29/76  GPW' 00030000
.********************************************************************** 00040000
.*                                                                    * 00050000
.* #SORT                                                              * 00060000
.*                                                                    * 00070000
.* FUNCTION       GENERATE CODING TO SORT A TABLE IN ASCENDING OR     * 00080000
.*                DESCENDING ORDER BASED ON A KEY FIELD IN EACH       * 00090000
.*                ENTRY.                                              * 00100000
.*                                                                    * 00110000
.* DESCRIPTION    A BUBBLE SORT IS PERFORMED.  THE KEYS               * 00120000
.*                OF CONSECUTIVE ITEMS ARE COMPARED.  THE ITEMS       * 00130000
.*                ARE SWITCHED IF NECESSARY.  PROCESSING PROCEEDS     * 00140000
.*                TO THE NEXT PAIR OF ENTRIES.  AT THE END OF ONE     * 00150000
.*                PASS, AT LEAST THE HIGHEST KEY IS IN THE PROPER     * 00160000
.*                POSITION.  THE LIST IS REDUCED TO A SUBLIST         * 00170000
.*                FROM THE FIRST ENTRY TO THE LAST ENTRY WHICH        * 00180000
.*                WAS SWITCHED AND THE SUBLIST IS THEN PROCESSED      * 00190000
.*                AS WAS THE ORIGINAL LIST.  THIS CONTINUES UNTIL     * 00200000
.*                THE ENTIRE LIST HAS BEEN SORTED.  IF AT ANY POINT,  * 00210000
.*                PROCESSING THE LIST RESULTS IN NO ENTRIES BEING     * 00220000
.*                SWITCHED, THE LIST IS IN ORDER AND PROCESSING       * 00230000
.*                IS TERMINATED.                                      * 00240000
.*                                                                    * 00250000
.*                REGISTERS 0, 1, 14, AND 15 ARE USED BY THE          * 00260000
.*                SORT AND MUST NOT BE SPECIFIED AS FIRST OR          * 00270000
.*                LAST VALUES.                                        * 00280000
.*                                                                    * 00290000
.* SYNTAX         NAME     #SORT FIELDS=(KEYPOS,KEYLEN,FMT,ORDER),    * 00300000
.*                               FIRST=SYMBOL1,                       * 00310000
.*                               LAST=SYMBOL2,                        * 00320000
.*                               LENGTH=NUM                           * 00330000
.*                                                                    * 00340000
.*                NAME   - SPECIFIES THE SYMBOLIC TAG TO BE           * 00350000
.*                         ASSIGNED TO THE FIRST INSTRUCTION          * 00360000
.*                         GENERATED.  THIS OPERAND IS OPTIONAL.      * 00370000
.*                                                                    * 00380000
.*                FIELDS - SPECIFIES THE SORT PARAMETERS.             * 00390000
.*                         KEYPOS - SPECIFIES THE RELATIVE KEY        * 00400000
.*                                  POSITION IN THE RECORD.           * 00410000
.*                         KEYLEN - SPECIFIES THE LENGTH OF THE KEY.  * 00420000
.*                         FMT    - SPECIFIES THE FORMAT OF THE       * 00430000
.*                                  DATA TO BE SORTED.  THE ONLY      * 00440000
.*                                  VALID FORMAT IS CHARACTER (CH).   * 00450000
.*                         ORDER  - SPECIFIES IF THE LIST IS TO BE    * 00460000
.*                                  SORTED IN ASCENDING ORDER (A),    * 00470000
.*                                  OR DESCENDING ORDER (D).  THE     * 00480000
.*                                  DEFAULT IS A.                     * 00490000
.*                                                                    * 00500000
.*                FIRST  - SPECIFIES THE SYMBOLIC NAME OF THE FIRST   * 00510000
.*                         ENTRY IN THE TABLE OR A REGISTER WHICH     * 00520000
.*                         CONTAINS THE ADDRESS OF THE FIRST ENTRY.   * 00530000
.*                         IF A SYMBOLIC NAME IS SPECIFIED, IT MUST   * 00540000
.*                         BE ADDRESSABLE.  IF A REGISTER IS          * 00550000
.*                         SPECIFIED, IT MUST BE ENCLOSED IN          * 00560000
.*                         PARENTHESES.  THIS PARAMETER IS REQUIRED.  * 00570000
.*                                                                    * 00580000
.*                LAST   - SPECIFIES THE SYMBOLIC NAME OF THE LAST    * 00590000
.*                         ENTRY IN THE TABLE OR A REGISTER WHICH     * 00600000
.*                         CONTAINS THE ADDRESS OF THE LAST ENTRY.    * 00610000
.*                         IF A SYMBOLIC NAME IS SPECIFIED, IT MUST   * 00620000
.*                         BE ADDRESSABLE.  IF A REGISTER IS          * 00630000
.*                         SPECIFIED, IT MUST BE ENCLOSED IN          * 00640000
.*                         PARENTHESES.  THIS PARAMETER IS REQUIRED.  * 00650000
.*                                                                    * 00660000
.*                LENGTH - SPECIFIES THE LENGTH OF THE ENTRIES IN     * 00670000
.*                         THE TABLE.  THIS PARAMETER IS REQUIRED.    * 00680000
.*                                                                    * 00690000
.*       MINOR CHANGES TO ALLOW SYMBOLIC VALUES FOR ALL FIELDS  G.P.  * 00700000
.*                                                                    * 00740000
.* ERRORS         INVALID NUMBER OF ENTRIES IN FIELDS PARAMETER - 8   * 00750000
.*                FORMAT TYPE NOT SUPPORTED                     - 8   * 00760000
.*                FIRST VALUE NOT SPECIFIED                     - 8   * 00770000
.*                LAST  VALUE NOT SPECIFIED                     - 8   * 00780000
.*                LENGTH VALUE NOT SPECIFIED                    - 8   * 00790000
.*                                                                    * 00800000
.* EXAMPLE        SORT A TABLE OF ENTRIES WHERE THE FIRST 8 BYTES     * 00810000
.*                ARE THE KEYS.  THE LENGTH OF EACH ENTRY IS 50       * 00820000
.*                BYTES.                                              * 00830000
.*                                                                    * 00840000
.*                         #SORT FIELDS=(1,8,CH,A),LENGTH=50,         * 00850000
.*                               FIRST=BEGIN,LAST=END                 * 00860000
.*                                                                    * 00870000
.*                BEGIN    DC    CL8'A',CL42'ENTRY 1'                 * 00880000
.*                         DC    CL8'D',CL42'ENTRY 2'                 * 00890000
.*                         DC    CL8'X',CL42'ENTRY 3'                 * 00900000
.*                         DC    CL8'$',CL42'ENTRY 4'                 * 00910000
.*                         DC    CL8'Q',CL42'ENTRY 5'                 * 00920000
.*                END      DC    CL8'M',CL42'ENTRY 6'                 * 00930000
.*                                                                    * 00940000
.* GLOBALS                                                            * 00950000
.*                                                                    * 00960000
.*                NONE                                                * 00970000
.*                                                                    * 00980000
.* MACROS USED                                                        * 00990000
.*                                                                    * 01000000
.*                NONE                                                * 01010000
.*                                                                    * 01020000
.********************************************************************** 01030000
.*                                                                      01040000
         LCLC  &X,&Y,&Z,&LEN,&HI,&I                             GP08303 01050000
         LCLA  &N                                               GP08303 01060000
.*                                                                      01070000
&I       SETC  '#SOR'.'&SYSNDX'(2,3)                                    01080000
&N       SETA  N'&FIELDS                                                01090000
&HI      SETC  'H'                                                      01100000
         AIF   (&N LT 3 OR &N GT 4).ERR1                        GP08303 01110000
         AIF   ('&FIELDS(3)' NE 'CH').ERR2                              01120000
         AIF   (&N EQ 3).SETREGS                                GP08303 01130000
         AIF   ('&FIELDS(&N)' NE 'D').TESTA                             01140000
&HI      SETC  'L'                                                      01150000
         AGO   .SETREGS                                                 01160000
.TESTA   AIF   ('&FIELDS(&N)' EQ 'A').SETREGS                           01170000
         MNOTE *,'*** SORT TYPE NOT A OR D - A ASSUMED'                 01180000
.SETREGS ANOP                                                           01190000
&LEN     SETC  '&LENGTH'                                        GP08303 01200000
&X       SETC  '&FIELDS(1)'.'-1'       OFFSET WITHIN RECORD     GP08303 01210000
&Y       SETC  '&FIELDS(2)'            LENGTH OF SORT-KEY       GP08303 01220000
&Z       SETC  '&X'.'+'.'&LEN'         OFFSET WITHIN NEXT REC.  GP08303 01230000
         AIF   ('&FIRST'  EQ '').ERR3                                   01240000
         AIF   ('&LAST'   EQ '').ERR4                                   01250000
         AIF   ('&LENGTH' EQ '').ERR5                                   01260000
.*                                                                      01270000
&NAME    LA    R0,&LENGTH              LOAD LENGTH OF AN ENTRY          01280000
         AIF   ('&LAST'(1,1) EQ '(').RFORM1                             01290000
         LA    R1,&LAST                LOAD LAST ENTRY ADDRESS          01300000
         AGO   .CONT1                                                   01310000
.RFORM1  LR    R1,&LAST                LOAD LAST ENTRY ADDRESS          01320000
.CONT1   ANOP                                                           01330000
&I.A     SR    R14,R14                 CLEAR LAST SWITCH ADDRESS        01340000
         AIF   ('&FIRST'(1,1) EQ '(').RFORM2                            01350000
         LA    R15,&FIRST              LOAD FIRST ENTRY ADDRESS         01360000
         AGO   .CONT2                                                   01370000
.RFORM2  LR    R15,&FIRST              LOAD FIRST ENTRY ADDRESS         01380000
.CONT2   SR    R1,R0                   POINT TO PENULTIMATE             01390000
         CR    R15,R1                  TEST AGAINST FIRST ENTRY         01400000
         BH    &I.D                    IF HIGH, LIST SORTED             01410000
&I.B     CLC   &X.(&Y,R15),&Z.(R15)    COMPARE KEYS                     01420000
         BN&HI &I.C                                                     01430000
         XC    0(&LEN,R15),&LEN.(R15)  SWITCH ENTRIES                   01440000
         XC    &LEN.(&LEN,R15),0(R15)                                   01450000
         XC    0(&LEN,R15),&LEN.(R15)                                   01460000
         LR    R14,R15                 SAVE ADDRESS OF SWITCHED ENTRY   01470000
&I.C     BXLE  R15,R0,&I.B             POINT TO NEXT ENTRY              01480000
         LTR   R1,R14                  COPY AND TEST LAST SWITCHED ADDR 01490000
         BNZ   &I.A                                                     01500000
&I.D     EQU   *                                                        01510000
         MEXIT                                                          01520000
.ERR1    MNOTE 8,'INVALID NO. OF ENTRIES IN FIELDS PARAMETER'           01530000
         MEXIT                                                          01540000
.ERR2    MNOTE 8,'FORMAT TYPE IS NOT SUPPORTED'                         01550000
         MEXIT                                                          01560000
.ERR3    MNOTE 8,'FIRST ENTRY ADDRESS NOT SPECIFIED.'                   01570000
         MEXIT                                                          01580000
.ERR4    MNOTE 8,'LAST  ENTRY ADDRESS NOT SPECIFIED.'                   01590000
         MEXIT                                                          01600000
.ERR5    MNOTE 8,'LENGTH NOT SPECIFIED.'                                01610000
         MEND                                                           01620000
./ ADD NAME=SPLEVEL
         MACRO ,                                                        00010000
&NM      SPLEVEL &FUN,&SET=                                             00020000
.*                                                                      00030000
.*    BACKWARD COMPATIBILITY FOR MVS                                    00040000
.*                                                                      00050000
         GBLC  &SYSSPLV                                                 00060000
&SYSSPLV SETC  '0'           BREAK IT                                   00070000
.MEND    MEND  ,                                                        00080000
./ ADD NAME=SRST
         MACRO ,                                                        00010000
&NM      SRST  &R,&S                                      ADDED GP04234 00020000
         GBLC  &MACPLAB                                         GP08310 00030000
.*                                                                      00040000
.*    BACKLEVEL IMPLEMENTATION OF SRST FOR HERCULES                     00050000
.*    DOES NOT SUPPORT ALL POSSIBLE USES, ONLY MY COMMON ONES           00060000
.*    E.G., DOES NOT SUPPORT CASE WHERE R2 IS 0                         00070000
.*          DOES NOT IGNORE HIGH BYTE/BIT                               00080000
.*                                                                      00090000
         LCLA  &I                                                       00100000
&I       SETA  &SYSNDX                                                  00110000
&NM      ST    &R,24(,R13)   SAVE                                       00120000
         ST    &S,16(,R13)   CALLER'S                                   00130000
         MVI   20(R13),3     PRESET FOR                                 00140000
         MVI   21(R13),4     NO MATCH         CLC CC=2  L               00150000
&MACPLAB SETC  'ZZS'.'&I'.'L'  LOOP TAG                                 00160000
         AIF   ('&R' EQ '0' OR '&R' EQ 'R0').NOTEST                     00170000
         MACPARM &R,&S,OP=CR,OPR=CR,MODE=EQU  DONE YET ?                00180000
         BE    ZZS&I.X                                                  00190000
.NOTEST  MACPARM R0,1,0(&S),OP=CLM,MODE=THREE                           00200000
         BE    ZZS&I.Q                                                  00210000
         LA    &S,1(,&S)                                                00220000
         B     ZZS&I.L                                                  00230000
ZZS&I.Q  MVI   21(R13),2     SET MATCH        CLC CC=1  H               00240000
         ST    &S,24(,R13)   RETURN MATCH LOCATION                      00250000
ZZS&I.X  L     &R,24(,R13)   RETURN R1 SAME OR UPDATED                  00260000
         L     &S,16(,R13)   ORIGINAL R2                                00270000
         CLC   21(,R13),20(R13)  SET CC = MATCH, HI - NO MATCH  GP08076 00280000
         MEND  ,                                                        00290000
./ ADD NAME=STAM
         MACRO ,                                                        00010000
&NM      STAM  &R,&S,&T                                 ADDED ON 05189  00020000
.*                                                                      00030000
.*       THIS MODULE GENERATES A LABEL FOR MVS COMPATIBILITY            00040000
.*                                                                      00050000
&NM      MACPARM MODE=LBL                                               00060000
         MEND  ,                                                        00070000
./ ADD NAME=STITL
         MACRO                                                          00010000
&L       STITL &TIT                                                     00020000
.*             THIS MACRO IS USED IN CONJUNCTION WITH MTITL TO          00030000
.*             SPECIFY THE SUB-TITLE FOR A TITLE CARD.                  00040000
.*             THE MAIN PORTION OF THE TITLE IS SPECIFIED ONCE,         00050000
.*             VIA MTITL, WHILE EACH STITL SPECIFIES ITS OWN            00060000
.*             SUB-TITLE, WHICH IS PLACED ON THE RIGHT HAND SIDE.       00070000
.*             AN OPERAND OF OFF GENERATES A TITLE WITH NO SUB-TITLE.   00080000
         GBLC  &MTITLE                                                  00090000
         LCLC  &STIT                                                    00100000
         PUSH  PRINT                                             80140  00101000
         PRINT GEN                                               80140  00102000
         AIF   (T'&TIT EQ 'O').OFF                                      00110000
         AIF   ('&TIT' EQ 'OFF').OFF                                    00120000
         AIF   ('&TIT'(1,1) EQ '''' AND '&TIT'(K'&TIT,1) EQ '''').OK    00130000
         MNOTE 4,'SUBTITLE NOT DELIMITED BY "''" - IGNORED'             00140000
&STIT    SETC  '*** INVALID SUBTITLE ***'                               00150000
         AGO   .TIT                                                     00160000
.OK      ANOP                                                           00170000
&STIT    SETC  '&TIT'(2,K'&TIT-2)                                       00180000
.TIT     TITLE '&MTITLE- &STIT'                                         00190000
         POP   PRINT                                             80140  00191000
         MEXIT                                                          00200000
.OFF     TITLE '&MTITLE'                                                00210000
         POP   PRINT                                             80140  00211000
         MEND                                                           00220000
./ ADD NAME=STMAX
         MACRO ,                                                        00010000
&NM      STMAX &R,&A,&TYPE=                                      85195  00020000
         LCLA  &I                                                       00030000
&I       SETA  &SYSNDX                                                  00040000
&NM      MACPARM &R,&A,OP=C&TYPE,OPR=C&TYPE.R,MODE=EQU                  00050000
         MACPARM ZZZZ&I,OP=BNH,MODE=ONE                                 00060000
         MACPARM &R,&A,OP=ST&TYPE,OPR=L&TYPE.R,MODE=REV                 00070000
ZZZZ&I   DS    0H                                                       00080000
.MEND    MEND  ,                                                        00090000
./ ADD NAME=STMIN
         MACRO ,                                                        00010000
&NM      STMIN &R,&A,&TYPE=                                      85195  00020000
         LCLA  &I                                                       00030000
&I       SETA  &SYSNDX                                                  00040000
&NM      MACPARM &R,&A,OP=C&TYPE,OPR=C&TYPE.R,MODE=EQU                  00050000
         MACPARM ZZZZ&I,OP=BNL,MODE=ONE                                 00060000
         MACPARM &R,&A,OP=ST&TYPE,OPR=L&TYPE.R,MODE=REV                 00070000
ZZZZ&I   DS    0H                                                       00080000
.MEND    MEND  ,                                                        00090000
./ ADD NAME=STOMP
         MACRO ,                                                GP02318 00010000
&NM      STOMP &IV=,&ADDR=,&VAL=,&ADDRV=                        GP10236 00020000
         GBLA  &ZZSTMP#                                         GP02318 00030000
         GBLC  &ZZSTMP@,&ZZSTMPV                                GP02318 00040000
.*                                                                      00050000
.*   STOMP IS USED FOR DEBUGGING TO SET A FOOTPRINT.                    00060000
.*   THE FIRST PHYSICAL OCCURRENCE IN AN ASSEMBLY REQUIRES              00070000
.*   AND ADDR= OPERAND TO SPECIFY THE BYTE TO RECEIVE THE FOOTPRINT     00080000
.*   VALUE. THE IV PARAMETER SETS AN OPTION (RE)STARTING COUNT.         00090000
.*                                                                      00100000
.*   THE OPTIONAL VAL PARAMETER MAY BE USED TO SAVE UP TO 8 BYTES       00110000
.*   OF DATA IN ADDRV                                           GP10236 00120000
.*                                                                      00130000
.*                                                                      00140000
.*                                                                      00150000
         AIF   ('&IV' EQ '').NONUMB                             GP02318 00160000
&ZZSTMP# SETA  &IV                                              GP02318 00170000
.NONUMB  AIF   ('&ADDR' EQ '').NONADD                           GP02318 00180000
&ZZSTMP@ SETC  '&ADDR'                                          GP02318 00190000
.NONADD  AIF   ('&ADDRV' EQ '').NONVAD                          GP10236 00200000
&ZZSTMPV SETC  '&ADDRV'                                         GP10236 00210000
.NONVAD  ANOP  ,                                                GP02318 00220000
&ZZSTMP# SETA  &ZZSTMP#+1                                       GP02318 00230000
&NM      MVI   &ZZSTMP@,&ZZSTMP#                                GP02318 00240000
 MNOTE *,'***************** STOMP &ZZSTMP# ********************'        00250000
         AIF   ('&ZZSTMPV' EQ '' OR '&VAL' EQ '').MEND          GP10236 00260000
         AIF   (K'&VAL LT 3).MVC                                GP10236 00270000
         AIF   ('&VAL'(1,1) NE '(' OR '&VAL'(2,1) EQ '(').MVC   GP10236 00280000
      AIF   ('&VAL'(K'&VAL,1) NE ')' OR '&VAL'(K'&VAL-1,1) EQ ')').MVC  00290000
         ST    &VAL(1),&ZZSTMPV                                 GP10236 00300000
         MEXIT ,                                                GP10236 00310000
.MVC     MVC   &ZZSTMPV,&VAL                                    GP10236 00320000
.MEND    MEND  ,                                                GP02318 00330000
./ ADD NAME=STORAGE
         MACRO ,                                                        00010000
&NM      STORAGE &FUN,&LENGTH=,&ADDR=,&SP=,&BNDRY=,&LOC=,&COND=,       *00020000
               &CALLRKY=,&RELEASE=                                      00030000
.*                                                                      00040000
.*    BACKWARD COMPATIBILITY FOR MVS 3.8 UNDER HERCULES         GP04234 00050000
.*    ALLOW MOST OPERANDS USING GETMAIN/FREEMAIN                        00060000
.*                                                                      00070000
         LCLA  &K,&RK                                                   00080000
         LCLC  &SB                                              GP08258 00090000
         AIF   ('&SP' EQ '0').NOPOOL  TREAT AS SP=              GP08258 00100000
&SB      SETC  '&SP'                                            GP08258 00110000
.NOPOOL  ANOP  ,                                                GP08258 00120000
&K       SETA  K'&SB                                                    00130000
&RK      SETA  K'&LENGTH                                                00140000
         AIF   ('&FUN' EQ 'OBTAIN').GET                                 00150000
         AIF   ('&FUN' EQ 'RELEASE').FREE                               00160000
         MNOTE 8,'STORAGE: FUNCTION &FUN INVALID'                       00170000
         MEXIT ,                                                        00180000
.GET     AIF   ('&COND' EQ 'YES').GETC                                  00190000
         AIF   ('&BNDRY' NE '' OR '&SB' NE '').GETU                     00200000
&NM      GETMAIN R,A=&ADDR,LV=&LENGTH                                   00210000
         MEXIT ,                                                        00220000
.*                                                                      00230000
.GETC    AIF   ('&SB' EQ '' OR &K LT 3).GETCB                           00240000
         AIF   ('&SB'(1,1) EQ '(' AND '&SB'(2,1) NE '(' AND            *00250000
               '&SB'(&K,1) EQ ')' AND '&SB'(&K-1,1) NE ')').GETCR       00260000
.GETCB   ANOP  ,                                                        00270000
&NM      GETMAIN RC,A=&ADDR,LV=&LENGTH,BNDRY=&BNDRY,SP=&SB              00280000
         MEXIT ,                                                        00290000
.GETCR   ANOP  ,                                                        00300000
&NM      MACPARM R0,&LENGTH                                             00310000
         MACPARM R15,&SB     GET SUBPOOL                        GP08089 00320000
         GETMAIN RC,A=&ADDR,LV=(0),SP=(15),BNDRY=&BNDRY         GP08089 00330000
         MEXIT ,                                                        00340000
.*                                                                      00350000
.GETU    AIF   ('&SB' EQ '' OR &K LT 3).GETUB                           00360000
         AIF   ('&SB'(1,1) EQ '(' AND '&SB'(2,1) NE '(' AND            *00370000
               '&SB'(&K,1) EQ ')' AND '&SB'(&K-1,1) NE ')').GETUR       00380000
.GETUB   ANOP  ,                                                        00390000
&NM      GETMAIN RU,A=&ADDR,LV=&LENGTH,BNDRY=&BNDRY,SP=&SB              00400000
         MEXIT ,                                                        00410000
.GETUR   ANOP  ,                                                        00420000
&NM      MACPARM R0,&LENGTH                                             00430000
         MACPARM R15,&SB     GET SUBPOOL                        GP08089 00440000
         GETMAIN RU,A=&ADDR,LV=(0),SP=(15),BNDRY=&BNDRY         GP08089 00450000
         MEXIT ,                                                        00460000
.*                                                                      00470000
.FREE   AIF   ('&SB' NE '' AND '&LENGTH' EQ '' AND '&ADDR' EQ '').FPOOL 00480000
         AIF   ('&SB' NE '').FREESP                                     00490000
&NM      FREEMAIN R,A=&ADDR,LV=&LENGTH                                  00500000
         MEXIT ,                                                        00510000
.FREESP  AIF   ('&LENGTH' EQ '' OR &RK LT 3).FREESR                     00520000
         AIF   ('&LENGTH'(1,1) EQ '(' AND '&LENGTH'(2,1) NE '(' AND    *00530000
               '&LENGTH'(&RK,1) EQ ')' AND                             *00540000
               '&LENGTH'(&RK-1,1) NE ')').FRUR                          00550000
.FREESR  AIF   ('&SB' EQ '' OR &K LT 3).FREEUB                          00560000
         AIF   ('&SB'(1,1) EQ '(' AND '&SB'(2,1) NE '(' AND            *00570000
               '&SB'(&K,1) EQ ')' AND '&SB'(&K-1,1) NE ')').FRUR        00580000
.FREEUB  ANOP  ,                                                        00590000
&NM      FREEMAIN R,A=&ADDR,LV=&LENGTH,SP=&SB                           00600000
         MEXIT ,                                                        00610000
.FRUR  ANOP  ,                                                          00620000
&NM      MACPARM R0,&LENGTH                                             00630000
         MACPARM R0,8(R13),OP=ST      SAVE LENGTH                       00640000
         MACPARM R0,&SB                                                 00650000
         MACPARM R0,8(R13),OP=STC    COMBINE WITH SUBPOOL               00660000
         MACPARM R0,8(R13),OP=L      AND RELOAD                 GP08251 00670000
         FREEMAIN R,A=&ADDR,LV=(0)  LV=&LENGTH,SP=&SB                   00680000
         MEXIT ,                                                        00690000
.FPOOL   ANOP  ,                                                        00700000
&NM      FREEMAIN R,SP=&SB   FREE ENTIRE SUBPOOL                        00710000
.MEND    MEND  ,                                                        00720000
./ ADD NAME=STORQ
         MACRO ,                                        ADDED ON 79226  00010000
&NM      STORQ &IN=,&LEN=,&OUT=,&ERR=EXCSOP,                           *00020000
               &WK0=R0,&WK1=R1,&WK2=R2,&WK3=R3,&WK4=R4,&WK5=R5          00030000
.********************************************************************** 00040000
.*                                                                   ** 00050000
.*   USED BY EXHIBIT COMMANDS TO PARSE A QUOTED STRING               ** 00060000
.*                                                                   ** 00070000
.********************************************************************** 00080000
         LCLC  &T                                                       00090000
&T       SETC  'STQ'.'&SYSNDX'                                          00100000
&NM      LA    &WK0,1        CONSTANT ONE                               00110000
         MACPARM &WK1,&OUT                                              00120000
         MACPARM &WK2,&LEN                                              00130000
         MACPARM &WK5,&IN                                               00140000
         LR    &WK3,&WK2     SAVE FULL LENGTH                           00150000
         LNR   &WK4,&WK5     SET MINUS FOR UNQUOTED                     00160000
         CLI   0(&WK5),C''''  QUOTED ?                                  00170000
         BE    &T.A-2        YES                                        00180000
         CLI   0(&WK5),C'"'   REAL QUOTE ?                              00190000
         BNE   &T.A+2        NO                                         00200000
         LR    &WK4,&WK5     SAVE LOCATION OF QUOTE                     00210000
&T.A     AR    &WK5,&WK0     GET NEXT BYTE                              00220000
         LTR   &WK4,&WK4     DOING QUOTED STRING ?                      00230000
         BP    &T.C          YES                                        00240000
         CLI   0(&WK5),C' '  END OF INPUT ?                             00250000
         BE    &T.D          YES                                        00260000
         CLI   0(&WK5),C','  ALTERNATE END                              00270000
         BE    &T.D          YES                                        00280000
&T.B     LTR   &WK2,&WK2     ROOM FOR ANOTHER ?                         00290000
         BNP   &ERR          NO; FAIL                                   00300000
         MVC   0(1,&WK1),0(&WK5)  MOVE ONE                              00310000
         AR    &WK1,&WK0     UP ONE                                     00320000
         BCTR  &WK2,0        ADJUST LENGTH                              00330000
         B     &T.A          SKIP AND TEST AGAIN                        00340000
&T.C     CLC   0(1,&WK5),0(&WK4)  QUOTE ?                               00350000
         BNE   &T.B          NO; COPY                                   00360000
         AR    &WK5,&WK0     SKIP FIRST DOUBLED QUOTE            80328  00370000
         CLC   0(1,&WK5),0(&WK4)  DOUBLED ?                      89166  00380000
         BE    &T.B          AND MOVE SECOND                            00390000
         SR    &WK5,&WK0      FINAGLE FOR NEXT ADD                      00400000
&T.D     AR    &WK5,&WK0     SKIP SEPARATION CHARACTER                  00410000
         SR    &WK3,&WK2     SET STRING LENGTH                          00420000
         MEND  ,                                                        00430000
./ ADD NAME=ST@
         MACRO ,                                                        00010000
&NM      ST@   &R,&ADDR,&MVI=                                           00020000
         AIF   ('&ADDR'(1,1) EQ '(').REG                                00030000
&NM      STCM  &R(1),7,1+&ADDR .   STORE ADDRESS BYTES                  00040000
         AIF   ('&MVI' EQ '').MEND                                      00050000
         AIF   ('&MVI'(1,1) EQ '(').MR                                  00060000
         MVI   &ADDR,&MVI .    SET NEW HIGH BYTE                        00070000
         AGO   .MEND                                                    00080000
.MR      STC   &MVI(1),&ADDR .   SET NEW HIGH BYTE                      00090000
         AGO   .MEND                                                    00100000
.REG     ANOP  ,                                                        00110000
&NM      STCM  &R(1),7,1&ADDR .   STORE ADDRESS BYTES                   00120000
         AIF   ('&MVI' EQ '').MEND                                      00130000
         AIF   ('&MVI'(1,1) EQ '(').SR                                  00140000
         MVI   0&ADDR,&MVI .    SET NEW HIGH BYTE                       00150000
         AGO   .MEND                                                    00160000
.SR      STC   &MVI(1),0&ADDR .   SET NEW HIGH BYTE                     00170000
.MEND    MEND  ,                                                        00180000
./ ADD NAME=SUBCALL
         MACRO ,                                                 88150  00010000
&NM      SUBCALL &NAME,&PARM,&VL,&MF=S,&OP=BALR,&MODE=L     ADDED 88150 00020000
         GBLC  &MACPLAB                                          88150  00030000
         GBLC  &SRVLMOD(20),&SRVLDEL(20)                        GP03150 00040000
         GBLB  &MVSESA,&OS390,&Z900                             GP08076 00050000
         GBLA  &SRVNMOD                                         GP03150 00060000
         LCLA  &I,&J,&N                                                 00070000
         LCLC  &LBL,&M,&LOP                                     GP08076 00080000
         AIF   ('&MF' EQ 'L').MFL                                       00090000
&LOP     SETC  '&OP'                                            GP08076 00100000
.*--------------------------------------------------------------------* 00110000
.*  NON-STANDARD HANDLING OF PARAMETER LIST:                          * 00120000
.*                                                                    * 00130000
.*  &N IS 1 - GENERATE SIMPLE LA UNLESS PARENTHESIZED (BACKWARD COMP) * 00140000
.*  &N IS 2 OR MORE - NORMAL PARAMETER LIST                           * 00150000
.*--------------------------------------------------------------------* 00160000
&MACPLAB SETC  '&NM'                                             88150  00170000
&N       SETA  N'&PARM                                          GP03041 00180000
         AIF   (&MVSESA OR &OS390 OR &Z900).OKBASS              GP08076 00190000
         AIF   ('&OP' EQ 'BSM').FLAKY                           GP12162 00200000
         AIF   ('&OP' NE 'BASSM' AND '&LOP' NE 'BASR').OKBASS   GP12162 00210000
.FLAKY   ANOP  ,                                                GP12162 00220000
&LOP     SETC  'BALR'        DON'T HAVE BASSM ON 360/370        GP08076 00230000
.OKBASS  AIF   (&N LT 1).LAPARM                                 GP03041 00240000
         AIF   (&N GT 1).NOTONE                                 GP03041 00250000
         AIF   ('&PARM'(1,1) EQ '(' AND '&PARM'(1,2) NE '(').NOTONE     00260000
         AIF   ('&PARM'(1,2) NE '((' OR                                *00270000
               '&PARM'(K'&PARM-1,2) NE '))').LAPARM             GP03041 00280000
.NOTONE  AIF   ('&MF(1)' EQ 'E').NODC                           GP03041 00290000
*TEST*   CNOP  0,4           WORD ALIGN FOR PARM LIST           GP03041 00300000
         MACPARM *+(&N+1)*4,OP=B,MODE=ONE                       GP03041 00310000
&M       SETC  '&SYSNDX'                                        GP03041 00320000
ZZ&M.P   DC    &N.AL4(0)     INLINE, NONREFRESHABLE PARM LIST   GP03041 00330000
&LBL     SETC  'ZZ'.'&M'.'P'                                    GP03041 00340000
         AGO   .HAVEDC                                          GP03041 00350000
.NODC    ANOP  ,                                                GP03041 00360000
&LBL     SETC  '&MF(2)'                                         GP03041 00370000
.HAVEDC  MACPARM R1,&LBL     LOAD PARM LIST                     GP03041 00380000
&I       SETA  0             JUST IN CASE                       GP03041 00390000
         AIF   ((&N+1) EQ K'&PARM).GETADDR  PARM LIST IS NULL   GP03041 00400000
&M       SETC  'R1'          ABNORMAL PARM LIST POINTER         GP03041 00410000
&J       SETA  0             PARM OFFSET FOR NEXT ITEM          GP03041 00420000
.PRMLOOP AIF   (&I GE &N).GETADDR    DONE                       GP03041 00430000
&I       SETA  &I+1                                             GP03041 00440000
         AIF   ('&PARM(&I)' EQ '').NOLST                        GP03041 00450000
         AIF   ('&PARM(&I)'(1,1) NE '''').NOCHAR                GP03041 00460000
         MACPARM R0,=C&PARM(&I)                                 GP03041 00470000
         AGO   .HAVER0                                          GP03041 00480000
.NOCHAR  MACPARM R0,&PARM(&I)  LOAD USER'S ADDRESS              GP03041 00490000
.HAVER0  MACPARM R0,&J.(,&M),OP=ST   PLACE INTO PARAMETER LIST  GP03041 00500000
.NOLST   AIF   (&I NE &N).PRMBUMP                               GP03041 00510000
         AIF   ('&VL' NE 'VL').GETADDR                          GP03041 00520000
         OI    &J.(&M),X'80'  END LIST BIT                      GP03041 00530000
         AGO   .GETADDR                                         GP03041 00540000
.PRMBUMP ANOP  ,                                                GP03041 00550000
&J       SETA  &J+4          NEXT LIST OFFSET                   GP03041 00560000
         AGO   .PRMLOOP                                         GP03041 00570000
.*                                                              GP03041 00580000
.LAPARM  MACPARM R1,&PARM,NULL=SKIP                             GP02241 00590000
.*                                                                      00600000
.*--------------------------------------------------------------------* 00610000
.*  HAVE PARM ADDRESS IN R1; NOW GET ROUTINE ADDRESS IN R15 AND GO    * 00620000
.*--------------------------------------------------------------------* 00630000
.GETADDR AIF   ('&NAME' EQ '(15)' OR '&NAME' EQ '(R15)').BALR    88150  00640000
         AIF   ('&NAME'(1,1) NE '(').GETPGM                      88150  00650000
&MACPLAB LR    R15,&NAME(1)                                      88150  00660000
         AGO   .BAL                                              88150  00670000
.*--------------------------------------------------------------------* 00680000
.*  SUBCALL INTERACTS WITH THE SERVLOAD MACRO.                        * 00690000
.*  WHEN A MODULE LOADED BY SERVLOAD IS REFERENCED HERE, THE L =A()   * 00700000
.*  IS REPLACED BY A LOAD FROM THE NAME USED BY SERVLOAD.             * 00710000
.*                                                                    * 00720000
.*--------------------------------------------------------------------* 00730000
.GETPGM  AIF   ('&NAME'(1,1) NE '/' AND '&NAME'(1,1) NE '*').GETLOAD    00740000
         MACPARM R15,&NAME                                      GP03264 00750000
         AGO   .BAL                                             GP03264 00760000
.GETLOAD ANOP  ,                                                 88150  00770000
&I       SETA  0             SCAN THROUGH SERVLOAD MODULES      GP03150 00780000
.LODLOOP AIF   (&I GE &SRVNMOD).SKIPLOD                         GP03150 00790000
&I       SETA  &I+1                                             GP03150 00800000
 AIF ('&SRVLMOD(&I)' NE '&NAME' AND '&SRVLDEL(&I)' NE '&NAME').LODLOOP  00810000
         MACPARM R15,&SRVLMOD(&I),OP=L                          GP03150 00820000
         AGO   .BALR                                            GP03150 00830000
.SKIPLOD AIF   ('&MODE' NE 'LA').LOAD                           GP03150 00840000
&MACPLAB LA    R15,&NAME     GET SUBROUTINE ADDRESS             GP03150 00850000
.LOAD    ANOP  ,                                                 88150  00860000
&MACPLAB L     R15,=A(&NAME)  GET SUBROUTINE ADDRESS             88150  00870000
.BAL     ANOP  ,                                                 88150  00880000
&MACPLAB SETC  ''                                                88150  00890000
.BALR    AIF   ('&LOP' EQ 'BALR').OLDBAL                        GP12162 00900000
         AIF   (NOT &MVSESA).OLDBAL                             GP12162 00910000
&MACPLAB &LOP  R14,R15       INVOKE IT                          GP00020 00920000
&MACPLAB SETC  ''                                               GP00020 00930000
         MEXIT ,                                                GP03041 00940000
.OLDBAL  ANOP  ,                                                GP12162 00950000
&MACPLAB BALR  R14,R15       INVOKE IT                          GP12162 00960000
&MACPLAB SETC  ''                                               GP12162 00970000
         MEXIT ,                                                GP03041 00980000
.MFL     AIF   ('&PARM' EQ '' AND '&NAME' NE '').OOPS           GP03041 00990000
&NM      DC    A&PARM REMOTE PARM LIST FOR SUBCALL              GP03041 01000000
         MEXIT ,                                                GP03041 01010000
.OOPS    ANOP  ,                                                GP03041 01020000
&NM      DC    A&NAME REMOTE PARM LIST FOR SUBCALL              GP03041 01030000
.MEND    MEND  ,                                                 88150  01040000
./ ADD NAME=SUBENT
         MACRO ,                                                 88150  00010000
&NM      SUBENT &SAVE=YES,&WRK=R14,&BASE=R12   SUBROUTINE ENTRY  88150  00020000
.********************************************************************** 00030000
.*                                                                   ** 00040000
.*   DEFINE SUBROUTINE ENTRY; USES SAVE AREA STACK                   ** 00050000
.*                                                                   ** 00060000
.********************************************************************** 00070000
         LCLC  &N                                                88150  00080000
         DROP  ,             DROP EVERYTHING                     88150  00090000
&NM      STM   R14,R12,12(R13)                                   88150  00100000
         AIF   (N'&BASE LE 1).ONEBASE                            88150  00110000
         BALSR &BASE(1),0                                        88150  00120000
&N       SETC  '&NM'.'ZZZZ'                                      88150  00130000
&N       SETC  '&N'(1,4).'BASE'                                  88150  00140000
         USING &N,&BASE(1),&BASE(2)                              88150  00150000
&N       LA    &BASE(2),2048(,&BASE(1))                          88150  00160000
         LA    &BASE(2),2048(,&BASE(2))                          88150  00170000
         AGO   .COMBASE                                          88150  00180000
.ONEBASE BALSR &BASE,0       MAKE LOCAL BASE                     88150  00190000
&N       SETC  '&NM'.'ZZZZ'                                      88150  00200000
&N       SETC  '&N'(1,4).'BASE'                                  88150  00210000
&N       DS    0H            LOCAL BASE                          88150  00220000
         USING &N,&BASE                                          88150  00230000
.COMBASE USING RENTWORK,R11  GLOBAL BASE PASSED BY CALLER        88150  00240000
         USING DYNWORK,R10   DYNAMIC WORK AREA ALSO PASSED       88150  00250000
         AIF   ('&SAVE' EQ 'NO').NOSAVE                          88150  00260000
         LA    &WRK,72(,R13)   GET LOWER SAVE AREA               88150  00270000
         ST    R13,4(,&WRK)                                      88150  00280000
         ST    &WRK,8(,R13)  LINK                                88150  00290000
         LR    R13,&WRK      FLIP                                88150  00300000
.NOSAVE  MEND  ,                                                 88150  00310000
./ ADD NAME=SUBEX
         MACRO ,                                                 88150  00010000
&NM      SUBEX &Q,&OFF=,&RC=0                              ADDED 88150  00020000
         GBLC  &MACPLAB                                          88150  00030000
         AIF   ('&Q' EQ '').GOOD                                GP09215 00040000
         MNOTE 4,'SUBEX: EXTRANEOUS VALUE &Q IGNORED'           GP09215 00050000
         MNOTE 4,'SUBEX: ONLY OFF= AND RC= SUPPORTED'           GP09215 00060000
.GOOD    ANOP  ,                                                GP09215 00070000
&NM      L     R13,4(,R13)   GET HIGHER SAVE AREA                88150  00080000
&MACPLAB SETC  ''                                                88150  00090000
         MACPARM R15,&RC,NULL=0  RETURN CODE                     88150  00100000
         LM    R0,R12,20(R13)  RESTORE                           88150  00110000
         L     R14,12(,R13)  SET RETURN ADDRESS                  88150  00120000
         AIF   ('&OFF' EQ '' OR '&OFF' EQ '0').NOOFF            GP09216 00130000
         B     &OFF.(R14)    RETURN WITH OFFSET                  88150  00140000
         AGO   .COMOFF                                           88150  00150000
.NOOFF   BR    R14           RETURN TO CALLER                    88150  00160000
.COMOFF  MEND  ,                                                 88150  00170000
./ ADD NAME=SUBHEAD
         MACRO ,                                                GP97332 00010000
&NM      SUBHEAD &F,&L,&BASE=      START A SUBROUTINE           GP03034 00020008
.*  SUBHEAD BEGINS A SUBROUTINE, USING A SAVE AREA STACK                00030001
.*    THE MACRO MUST PHYSICALLY PRECEDE THE MATCHING SUBRET             00040001
.*    MACRO FOR CORRECT REGISTER RESTORE.                               00050001
.*  BY SPECIFYING &F AND &L APPROPRIATELY, (E.G., R2,R0),               00060001
.*    ALTERED REGISTER VALUES (IN THIS CASE, R1) CAN BE RETURNED        00070001
.*    TO THE CALLER                                                     00080001
.*    FOR FUTURE COMPATIBILITY (BAKR/PR) USE R0,R15             GP03034 00090008
.*                                                              GP03034 00100008
.* WHEN BASE= IS SPECIFIED, APPROPRIATE USINGS ARE ISSUED, OTHERWISE    00110008
.*    THE CALLER'S USINGS REMAIN IN EFFECT.                     GP03034 00120008
.*                                                              GP03034 00130008
.*                                                              GP03034 00140008
.*                                                              GP03034 00150008
         GBLC  &ZZSUBR1,&ZZSUBR2                                GP00020 00160001
         LCLC  &EX,&CMU                                         GP03029 00170008
         LCLA  &I,&K                                            GP03034 00180008
&ZZSUBR1 SETC  '&F'                                             GP00020 00190001
&ZZSUBR2 SETC  '&L'                                             GP00020 00200001
         AIF   ('&F' NE '').HAVE1                               GP00020 00210001
&ZZSUBR1 SETC  'R0'                                             GP00020 00220001
.HAVE1   AIF   ('&L' NE '').HAVE2                               GP00020 00230002
&ZZSUBR2 SETC  '((16+&ZZSUBR1-1)-(16+&ZZSUBR1-1)/16*16)'        GP03029 00240007
.HAVE2   ANOP  ,                                                GP00020 00250001
&NM      STM   &ZZSUBR1,&ZZSUBR2,8(R13) SAVE CALLER'S REGISTERS GP00020 00260001
         ST    R13,LOCSAVE1-LOCSAVE+4(,R13)  MAKE BACK CHAIN    GP03034 00270008
         LA    R13,LOCSAVE1-LOCSAVE(,R13)  PUSH THE STACK       GP97332 00280000
.*--------------------------------------------------------------------* 00290008
.*  LOAD AND DECLARE BASE REGISTERS                                   * 00300008
.*--------------------------------------------------------------------* 00310008
&K       SETA  N'&BASE      MAX NUMBER OF BASES SPECIFIED       GP03034 00320008
         AIF   (&K LT 1).MEND  *** NONE *** USE CALLER'S        GP03034 00330008
&CMU     SETC  '&BASE(1)'    SET THE FIRST ONE                  GP03034 00340008
         MACPARM &BASE(1),(R15),OP=LA                           GP03034 00350008
         AIF   (&K LT 2).DOUSE                                  GP03034 00360008
&I       SETA  1                                                GP03034 00370008
         LA    &BASE(&K),2048                                   GP03034 00380008
.BASLOOP AIF   (&I GE &K).DOUSE                                 GP03034 00390008
&I       SETA  &I+1                                             GP03034 00400008
         AIF   ('&BASE(&I)' EQ '').BASLOOP                      GP03034 00410008
         LA    &BASE(&I),2048(&BASE(&K),&BASE(&I-1))            GP03034 00420008
&CMU     SETC  '&CMU'.','.'&BASE(&I)'                           GP03034 00430008
         AGO   .BASLOOP                                         GP03034 00440008
.DOUSE   USING &NM,&CMU                                         GP03034 00450008
.MEND    MEND  ,                                                GP03034 00460008
./ ADD NAME=SUBRET
         MACRO ,                                                        00010001
&NM      SUBRET &RREG,&TYPE=BR,&RS=,&RE=,&OR=8,&VECT=0                  00020002
         GBLC  &ZZSUBR1,&ZZSUBR2                                GP00020 00030002
         LCLC  &RR                                              GP00020 00040002
.*  SUBRET ENDS A MATCHING SUBHEAD USING SUBROUTINE                     00050002
.*    &RREG SPECIFIES THE RETURN REGISTER (DEFAULT IS R14)              00060002
.*    &TYPE MAY SPECIFY POP (RELOAD, NO BRANCH), BR FOR BRANCH,         00070002
.*      OR BSM FOR A BSM 0,&&REG RETURN                                 00080002
.*    &RS AND &RE MAY OVERRIDE THE RESTORE REGISTERS, BUT NOTE THAT     00090002
.*      THIS WILL WORK ONLY IF RE IS LESS THAN THE SUBHEAD SECOND REG.  00100002
.*    &VECT SPECIFIES AN INTEGER RETURN OFFSET (CALLER'S RETURN + N)    00110002
.*                                                                      00120002
.*  SUBHEAD BEGINS A SUBROUTINE, USING A SAVE AREA STACK                00130002
.*    THE MACRO MUST PHYSICALLY PRECEDE THE MATCHING SUBRET             00140002
.*    MACRO FOR CORRECT REGISTER RESTORE.                               00150002
.*  BY SPECIFYING &F AND &L APPROPRIATELY, (E.G., R2,R0),               00160002
.*    ALTERED REGISTER VALUES (IN THIS CASE, R1) CAN BE RETURNED        00170002
.*    TO THE CALLER                                                     00180002
&RR      SETC  '&RREG(1)'                                       GP00020 00190003
         AIF   ('&RR' NE '').HAVER                              GP00020 00200002
&RR      SETC  'R14'                                            GP00020 00210002
.HAVER   AIF   ('&RS' EQ '').HAVE1                              GP00020 00220002
&ZZSUBR1 SETC  '&RS'                                            GP00020 00230002
.HAVE1   AIF   ('&RE' EQ '').HAVE2                              GP00020 00240002
&ZZSUBR2 SETC  '&RE'                                            GP00020 00250002
.HAVE2   ANOP  ,                                                GP00020 00260002
&NM      SH    R13,=Y(LOCSAVE1-LOCSAVE)  POP THE STACK                  00270001
         LM    &ZZSUBR1,&ZZSUBR2,&OR.(R13)  RESTORE CALLER'S REGISTERS  00280002
         AIF   ('&RR' EQ 'POP').MEND                            GP00020 00290002
         AIF   ('&TYPE' EQ 'POP' OR '&TYPE' EQ 'NO').MEND               00300001
         AIF   ('&TYPE' EQ 'BSM').BSM                                   00310001
         AIF   ('&VECT' EQ '0').BR                                      00320001
         B     &VECT.(,&RR)  VECTORED RETURN                            00330002
         MEXIT ,                                                        00340001
.BR      BR    &RR           RETURN TO CALLER                           00350002
         MEXIT ,                                                        00360001
.BSM     AIF   ('&VECT' EQ '0').BSM0                                    00370001
         AL    &RR,=A(&VECT) ADJUST RETURN ADDRESS                      00380002
.BSM0    RET31 &RR           RETURN IN CALLER'S MODE                    00390002
.MEND    MEND  ,                                                        00400001
./ ADD NAME=SVCJFCB
         MACRO ,                                                        00010000
&NM      SVCJFCB &PARM,&ERR=                            ADDED ON 84268  00020000
         GBLA  &SVCJFCB                                                 00030000
         GBLB  &ZZSJFCB                                         GP99053 00040000
         GBLC  &MACPLAB                                                 00050000
.********************************************************************** 00060000
.*                                                                   ** 00070000
.*   INVOKE JFCB MODIFICATION (VIA SVC).  USED IN ASMANY             ** 00080000
.*                                                                   ** 00090000
.********************************************************************** 00100000
&MACPLAB SETC  '&NM'                                                    00110000
         MACPARM R1,&PARM    LOAD R1 WITH LIST ADDRESS                  00120000
         AIF   (&SVCJFCB EQ 0).NOSVC                            GP99053 00130000
         MACPARM &SVCJFCB,MODE=ONE,OP=SVC  CALL SVC                     00140000
         AGO   .ERRT                                                    00150000
.NOSVC   AIF   (&ZZSJFCB).NOSVC2                                GP99053 00160000
*HOPE?*  MNOTE 0,'GLOBAL VARIABLE &&SVCJFCB IS ZERO'                    00170000
&ZZSJFCB SETB  1                                                GP99053 00180000
.NOSVC2  ANOP  ,                                                GP99053 00190000
&MACPLAB LINK  EPLOC=DCMJFCB        MUST BE AUTHORIZED TO CALL  GP99055 00200000
&MACPLAB SETC  ''                                                       00210000
.ERRT    AIF   ('&ERR' EQ '').MEND                                      00220000
         LTR   R15,R15       TEST RETURN                                00230000
         MACPARM &ERR,MODE=ONE,OP=BNZ,OPR=BNZR                          00240000
.MEND    MEND  ,                                                        00250000
./ ADD NAME=SWAPR
         MACRO ,                                                        00010000
&NM      SWAPR &A,&B         EXCHANGE TWO REGISTERS              86197  00020000
&NM      XR    &A,&B                                                    00030000
         XR    &B,&A                                                    00040000
         XR    &A,&B                                                    00050000
         MEND  ,                                                        00060000
./ ADD NAME=SWAP
         MACRO ,                                                        00010000
&NM      SWAP  &A,&B,&LEN=   EXCHANGE TWO STRINGS                86197  00020000
         LCLC  &L                                                       00030000
&L       SETC  'L'''                                                    00040000
         AIF   ('&LEN' EQ '').DFLT                                      00050000
&NM      XC    &A.(&LEN),&B                                             00060000
         XC    &B.(&LEN),&A                                             00070000
         XC    &A.(&LEN),&B                                             00080000
         MEXIT ,                                                        00090000
.DFLT    ANOP  ,                                                        00100000
&NM      XC    &A.(&L&A),&B                                             00110000
         XC    &B.(&L&A),&A                                             00120000
         XC    &A.(&L&A),&B                                             00130000
         MEND  ,                                                        00140000
./ ADD NAME=SWATCH
         MACRO ,                                                        00010000
&NM      SWATCH &FUN,&CODE,&PFX=STMR,&PAT=STMP,&TIME=,&SAVE=YES         00020000
.**                                                                  ** 00030000
.********************************************************************** 00040000
.**                                                                  ** 00050000
.**  MACRO TO RUN A SIMPLE STOP WATCH PROGRAM  (UPDATED 2013-05-12)  ** 00060000
.**                                                                  ** 00070000
.**  NAME SWATCH START[,'TEST NAME']  BEGIN TIMING                   ** 00080000
.**  NAME SWATCH STOP            STOP TIMING                         ** 00090000
.**  NAME SWATCH SHOW            CALCULATE INTERVAL, AND SHOW ON WTO ** 00100000
.**                              (SAVES IF FIRST START/STOP USE)     ** 00110000
.**  NAME SWATCH SAVE            SAVE FOR LATER COMPARISON           ** 00120000
.**                                                                  ** 00130000
.**  NAME SWATCH COMPARE         COMPARE CURRENT (AFTER SHOW) WITH   ** 00140000
.**                                PREVIOUS RESULT                   ** 00150000
.**                                                                  ** 00160000
.**  NAME SWATCH DATA            DEFINE DATA. IF DSECT, MOVE FROM    ** 00170000
.**                                PATTERN WITH INIT FUNCTION.       ** 00180000
.**                                                                  ** 00190000
.**  NAME SWATCH PATTERN         DEFINE WORK AREA PATTERN (PFX STMP) ** 00200000
.**  NAME SWATCH INIT            MOVES PATTERN TO DATA               ** 00210000
.**                                                                  ** 00220000
.**  NAME SWATCH CLEAR           PREPARES DATA AREA WITHOUT PATTERN  ** 00230000
.**                                OR INIT CALL                      ** 00240000
.**                                                                  ** 00250000
.**  NAME SWATCH OVERHEAD        RUNS EMPTY STOP/START TO GET        ** 00260000
.**                                OVERHEAD TIME WITHOUT A LOOP.     ** 00270000
.**                                                                  ** 00280000
.**  TIME= SETS GLOBAL MODE (REMAINS UNTIL RESPECIFIED). VALUE IS:   ** 00290000
.**    JST or CPU - USE APPLICATION CPU TIME ONLY                    ** 00300000
.**    SRB        - USE SYSTEM OVERHEAD ONLY                         ** 00310000
.**    ALL or BOTH- USE SUM OF CPU AND SRB TIME                      ** 00320000
.**                                                                  ** 00330000
.**  TO BE LINKED WITH MODULE SUBTIMER, AND ENTRY SUBTIMED.          ** 00340000
.**                                                                  ** 00350000
.********************************************************************** 00360000
         GBLA  &ZZSWAM       MODE (0-JST, 1-SRB, 2-BOTH)        GP13118 00370000
         GBLB  &MVSXA        WHEN DID TIMEUSED APPEAR ?         GP07015 00380000
         GBLB  &ZZSWAT         SET IF EQU EXPANDED              GP13111 00390000
         GBLC  &MACPLAB                                         GP03245 00400000
         LCLC  &P,&LB,&STORE,&LBL                               GP13111 00410000
&LB      SETC  'ZZT'.'&SYSNDX'                                  GP13111 00420000
&LBL     SETC  '&NM'                                            GP13111 00430000
&P       SETC  '&PFX'                                                   00440000
         AIF   ('&TIME' EQ '').KEEP                             GP13118 00450000
&ZZSWAM  SETA  1                                                GP13118 00460000
         AIF   ('&TIME' EQ 'JST' OR '&TIME' EQ 'CPU').KEEP      GP13118 00470000
&ZZSWAM  SETA  2                                                GP13118 00480000
         AIF   ('&TIME' EQ 'SRB').KEEP                          GP13118 00490000
&ZZSWAM  SETA  3                                                GP13118 00500000
         AIF   ('&TIME' EQ 'BOTH' OR '&TIME' EQ 'ALL').KEEP     GP13118 00510000
         AIF   ('&TIME' EQ 'TOTAL').KEEP                        GP13118 00520000
&ZZSWAM  SETA  1                                                GP13118 00530000
         MNOTE 4,'SWATCH: TIME=&TIME INVALID. USE JST, SRB, OR ALL'     00540000
.KEEP    ANOP  ,                                                GP13118 00550000
&STORE   SETC  'STMRSTRT'    PRESET FOR START                   GP13111 00560000
         AIF   ('&FUN' EQ 'START').BEGIN                                00570000
&STORE   SETC  'STMRSTOP'    PRESET FOR STOP                    GP13111 00580000
         AIF   ('&FUN' EQ 'STOP').BEGCOM    SAME AS START CODE  GP13111 00590000
         AIF   ('&FUN' EQ 'WTO').PRINT                                  00600000
         AIF   ('&FUN' EQ 'SHOW').PRINT                                 00610000
         AIF   ('&FUN' EQ 'PRINT').PRINT                                00620000
         AIF   ('&FUN' EQ 'COMPARE').COMPARE                            00630000
         AIF   ('&FUN' EQ 'SAVE').SAVE                                  00640000
         AIF   ('&FUN' EQ 'DATA').DATA                                  00650000
         AIF   ('&FUN' EQ 'PATTERN').PATTERN                            00660000
         AIF   ('&FUN' EQ 'INIT').INIT                                  00670000
         AIF   ('&FUN' EQ 'CLEAR').CLEAR                        GP13111 00680000
         AIF   ('&FUN' EQ 'OVERHEAD').OVERHD                    GP13118 00690000
         MNOTE 8,'SWATCH: UNRECOGNIZED FUNCTION &FUN'                   00700000
         MEXIT ,                                                        00710000
.OVERHD  ANOP  ,                                                GP13118 00720000
&NM      SWATCH START,'OVERHEAD',SAVE=NO                        GP13118 00730000
         SWATCH STOP,SAVE=NO                                    GP13118 00740000
         XC    &P.OHD,&P.OHD  *TEST                                     00750000
         LM    R14,R15,&P.STOP                                 GP13118  00760000
         SL    R15,&P.STRT+4                                   GP13118  00770000
         BC    3,*+4+4                                          GP13118 00780000
         S     R14,=F'1'                                        GP13118 00790000
         S     R14,&P.STRT                                     GP13118  00800000
         BM    *+8           SHOULD NOT BE NEGATIVE ?           GP13118 00810000
         STM   R14,R15,&P.OHD                                  GP13118  00820000
         SWATCH CLEAR                                           GP13118 00830000
         MEXIT ,                                                GP13118 00840000
.BEGIN   AIF   ('&CODE' EQ '').NOCODE                                   00850000
         AIF   ('&CODE'(1,1) EQ '''').STRCODE                           00860000
&NM      MVC   STMRCODE,=CL(16)'&CODE '                                 00870000
&LBL     SETC  ''                                               GP13111 00880000
         AGO   .BEGCOM                                                  00890000
.STRCODE ANOP  ,                                                        00900000
&NM      MVC   STMRCODE,=CL(16)&CODE                                    00910000
&LBL     SETC  ''                                               GP13111 00920000
         AGO   .BEGCOM                                                  00930000
.NOCODE  ANOP  ,                                                        00940000
&NM      MVC   STMRCODE,=CL16' '    NO CODE SPECIFIED                   00950000
&LBL     SETC  ''                                               GP13111 00960000
         MNOTE 0,'SWATCH: TEST NAME NOT SPECIFIED'                      00970000
.BEGCOM  AIF   (&MVSXA).BEGESA  TIMEUSED AVAILABLE ?            GP07015 00980000
         AIF   ('&SAVE' NE 'YES').NOSAV1                        GP13118 00990000
&LBL     STM   R14,R1,12(R13)     SAVE A BIT                    GP13118 01000000
&LBL     SETC  ''                                               GP13118 01010000
.NOSAV1  AIF   (&ZZSWAT).DONEQU                                 GP13111 01020000
.*       THIS CODE CALCULATES TOTAL CPU TIME FOR THE CURRENT TCB.     * 01030000
.*       FOR TASKS WITH MULTIPLE ACTIVE TCBS/SRBS USE AN SVC INSTEAD: * 01040000
.*         SEE IGC251 IN THE ESPSRC PDS.                              * 01050000
.*       LCCADTOD HAS THE TIME THE TASK WAS DISPATCHED                * 01060000
.*       TIME SINCE LAST DISPATCH IS:                                 * 01070000
.*         CURRENT TOD - LCCADTOD                                     * 01080000
.*                                                                    * 01090000
.*       THIS VALUE IS ADDED TO ASCBESTL (TIME=JST/ALL) OR            * 01100000
.*       ASCBSRBT (TIME=SRB/ALL).                                     * 01110000
.*                                                                    * 01120000
.*       CLOCK UNITS ARE CONVERTED TO MIC UNITS (10**-6 SECS)         * 01130000
.*                                                                    * 01140000
.*       EQUATES ARE USED TO RELIEVE THE USER FROM INCLUDING ESOTERIC * 01150000
.*       MAPPING MACROS (IHALCCA, ETC.). THE FIRST A IN EACH NAME HAS * 01160000
.*       BEEN CHANGED TO @.                                           * 01170000
.*                                                                    * 01180000
&ZZSWAT  SETB  1                                                GP13111 01190000
PS@      EQU   0                                                        01200000
PS@LCCAV EQU   528                 ADDRESS OF POINTER TO LCC@           01210000
PS@AOLD  EQU   548                 CURRENT @SCB POINTER         GP13111 01220000
@SCB     EQU   0                                                GP13111 01230000
@SCBEJST EQU   64                  ELAPSED JOB-STEP TIMING, TOD CLOCK   01240000
.*                                 UNITS (64-BITS)                      01250000
@SCBSRBT EQU   200                 ELAPSED JOB-STEP TIMING, TOD CLOCK   01260000
.*                                 UNITS (64-BITS)                      01270000
LCC@     EQU   0                                                GP13111 01280000
LCC@DTOD EQU   600                OFFSET OF TOD STAMP FROM              01290000
.*                                DISPATCH OF TCB                       01300000
.**  GET TIME FROM @SCBEJST/SRBT, AND SUBTRACT UNUSED TIME FROM LCCA    01310000
.DONEQU  ANOP  ,                                                        01320000
&LBL     L     R1,PS@AOLD-PS@     GET ASCB ADDRESS              GP13118 01330000
         AIF   (&ZZSWAM EQ 2).MVSA2                             GP13118 01340000
.MVSA1   LM    R14,R15,@SCBEJST-@SCB(R1)  GET JOB STEP TIME     GP13118 01350000
         AIF   (&ZZSWAM EQ 1).MVSAOK                            GP13118 01360000
         AL    R15,4+@SCBSRBT-@SCB(,R1)   ADD SRB TIME          GP13118 01370000
         BC    12,*+4+4                                         GP13118 01380000
         AL    R14,=F'1'                                        GP13118 01390000
         AL    R14,@SCBSRBT-@SCB(,R1)                           GP13118 01400000
         AGO   .MVSAOK                                          GP13118 01410000
.MVSA2   LM    R14,R15,@SCBSRBT-@SCB(R1)  GET SRB TIME          GP13118 01420000
.MVSAOK  STCK  &STORE             SAVE TOD CLOCK VALUE        GP13118   01430000
         AL    R15,4+&STORE       SUBTRACT TOD                GP13118   01440000
         BC    12,*+4+4                                         GP13118 01450000
         AL    R14,=F'1'                                        GP13118 01460000
         AL    R14,&STORE                                     GP13118   01470000
         L     R1,PS@LCCAV-PS@    GET A(LCCA FOR THIS CPU)      GP13118 01480000
         SL    R15,4+LCC@DTOD-LCC@(,R1)   ADD REMAINING         GP13118 01490000
         BC    3,*+4+4                                          GP13118 01500000
         SL    R14,=F'1'                      DISPATCH TIME     GP13118 01510000
         SL    R14,LCC@DTOD-LCC@(,R1)                           GP13118 01520000
&LB.X    SRDL  R14,12          CHANGE TO MIC                    GP07015 01530000
         STM   R14,R15,&STORE  UPDATE CPU TIME                GP07015   01540000
         AIF   ('&SAVE' NE 'YES').NOSAV2                        GP13118 01550000
         LM    R14,R1,12(R13)  RESTORE WORK REGISTERS           GP13118 01560000
.NOSAV2  MEXIT ,                                                GP07015 01570000
.BEGESA  AIF   (&ZZSWAM EQ 2).ESASRB                            GP13118 01580000
&LBL     TIMEUSED STORADR=&STORE,CPU=MIC,LINKAGE=SYSTEM       GP07015   01590000
         AIF   (&ZZSWAM NE 3).MEND                              GP13118 01600000
         TIMEUSED STORADR=STMRDB,VECTOR=MIC,LINKAGE=SYSTEM      GP13118 01610000
         LM    R14,R15,&STORE                                 GP13118   01620000
         AL    R15,STMRDB+4   ADD LOW ORDER                     GP13118 01630000
         BC    12,*+4+4                                         GP13118 01640000
         A     R14,=F'1'                                        GP13118 01650000
         A     R14,STMRDB                                       GP13118 01660000
         STM   R14,R15,&STORE  UPDATE CPU TIME                GP13118   01670000
         MEXIT ,                                                        01680000
.ESASRB  ANOP  ,                                                GP13118 01690000
&LBL     TIMEUSED STORADR=&STORE,VECTOR=MIC,LINKAGE=SYSTEM    GP13118   01700000
         MEXIT ,                                                        01710000
.PRINT   ANOP  ,                                                        01720000
&NM      LA    R1,STMRWORK                                              01730000
         L     R15,=V(SUBTIMER)                                         01740000
         BALR  R14,R15                                                  01750000
         MEXIT ,                                                        01760000
.COMPARE ANOP  ,                                                        01770000
&NM      LA    R1,STMRWORK                                              01780000
         L     R15,=V(SUBTIMED)                                         01790000
         BALR  R14,R15                                                  01800000
         MEXIT ,                                                        01810000
.INIT    ANOP  ,                                                        01820000
&NM      MVC   &P.WORK(&PAT.WKLR+L'&PAT.OHD),&PAT.WORK          GP13118 01830000
         MEXIT ,                                                        01840000
.CLEAR   ANOP  ,                                                        01850000
&NM      XC    &P.WORK(&P.WKLR),&P.WORK                         GP13111 01860000
         MVI   &P.CODE,C' '                                     GP13111 01870000
         MVC   &P.CODE+1(L'&P.CODE-1),&P.CODE                   GP13111 01880000
         MVC   &P.COD2,&P.CODE                                  GP13111 01890000
         MEXIT ,                                                        01900000
.SAVE    ANOP  ,                                                        01910000
&NM      MVC   &P.STR2(&P.SVLN),&P.STRT  SAVE THIS TIME'S COUNTERS      01920000
         MEXIT ,                                                        01930000
.PATTERN AIF   ('&P' NE '' AND '&P' NE 'STMR').DATA                     01940000
&P       SETC  'STMP'                                                   01950000
.DATA    AIF   ('&NM' EQ '').NOEXTRA                                    01960000
&NM      DS    0D                                                       01970000
.NOEXTRA ANOP  ,                                                        01980000
&P.WORK  DS    0D                                                       01990000
&P.SAVE  DC    18A(0)        LOWER SAVE AREA                            02000000
&P.DB    DC    D'0'          WORK WORDS                                 02010000
&P.ITER  DC    F'0'          ITERATION COUNTER (OPTIONAL)               02020000
&P.LTIM  DC    F'0'          TIME FOR ONE ITERATION             GP13118 02030000
.*  START OF CURRENT DATA                                               02040000
&P.STRT  DC    D'0'          STOPWATCH START TIME                       02050000
&P.STOP  DC    D'0'          STOPWATCH STOP TIME                        02060000
&P.TIME  DC    F'0'          TIME FOR THIS TEST                         02070000
&P.CODE  DC    CL16' '       USER'S MNEMONIC CODE FOR THIS FUNCTION     02080000
&P.SVLN  EQU   *-&P.STRT       LENGTH TO SAVE AFTER WRITE               02090000
.*  SAVED RESULT FROM AN EARLIER MEASUREMENT                            02100000
&P.STR2  DC    2F'0'         PRIOR STOPWATCH START TIME                 02110000
&P.STO2  DC    2F'0'         PRIOR STOPWATCH STOP TIME                  02120000
&P.TIM2  DC    F'0'          TIME FOR THIS TEST                         02130000
&P.COD2  DC    CL16' '       PRIOR CODE                                 02140000
&P.WKLR  EQU   *-&P.WORK       LENGTH TO BE CLEARED             GP13118 02150000
.*  OTHER STUFF - NOT CLEARED NOR COPIED                        GP13118 02160000
&P.OHD   DC    D'0'          OVERHEAD (OPTIONAL)                GP13118 02170000
&P.WTO   DC    XL92'0'       SPACE FOR WTO                              02180000
&P.WKLN  EQU   *-&P.WORK       LENGTH TO BE MOVED               GP13118 02190000
.MEND    MEND  ,                                                        02200000
./ ADD NAME=SYSPARM
         MACRO ,                                                        00010000
       SYSPARM &DBTEST=YES,&SETS=YES,&LIST=YES,&SHOW=,&PARM=            00020000
.********************************************************************** 00030000
.*   THIS MACRO, FOLLOWING OPTIONGB, SETS GLOBAL ASSEMBLY OPTIONS.      00040000
.*   OVERRIDES ARE MERGED FROM THE CONTENTS OF THE ASSEMBLER EXEC       00050000
.*   PARM SUBFIELD SYSPARM:  // EXEC ASMHC,PARM='SYSPARM(MVS/ESA)'      00060000
.********************************************************************** 00070000
         COPY  OPTIONGB                                                 00080000
         LCLA  &CURSOR                                                  00090000
         LCLA  &I,&J,&K                                                 00100000
         LCLB  &GOTLOC                                                  00110000
         LCLC  &CHAR                                                    00120000
         LCLC  &DEFSP1R,&DEFSP2R,&DEFSP3R,&DEFJES2               90217  00130000
         LCLC  &DELIM                                                   00140000
         LCLC  &TOKEN                                                   00150000
         LCLC  &DEFMOD,&DEFLOC,&DEFMAC,&DEFSOR,&DEFSYM,&DEFSYS   81169  00160000
&GOTLOC  SETB  ('&SETS' EQ 'NO' OR '&LOCAL' NE '' OR &SYSPRM# GT 0)     00170000
         AIF   (&SYSPRM# NE 0).BYEBYE                            81154  00180000
         AIF   ('&PARM' EQ 'IGNORE').NOFRAME                     83100  00190000
         AIF   (T'&PARM EQ 'O').OKPPRM                           83100  00200000
         MNOTE 8,'INVALID PARM=&PARM'                            83100  00210000
.OKPPRM  ANOP  ,                                                 83100  00220000
&K       SETA  K'&SYSPARM                                        82099  00230000
         AIF   (&K LT 2).NOFRAME                                 82099  00240000
         AIF   ('&SYSPARM'(1,1) NE '(').NOFRAME                  82099  00250000
         AIF   ('&SYSPARM'(&K,1) NE ')').NOFRAME                 82099  00260000
&K       SETA  &K-1          SUPPORT FORMAT (A,B,C)              82099  00270000
&CURSOR  SETA  &CURSOR+1                                         82099  00280000
.NOFRAME AIF   (&GOTLOC).FINDTOK                                 82099  00290000
&DEFLOC  SETC  'MVS'           INSTALLATION                      81154  00300000
&DEFMOD  SETC  '370'             DEFAULTS        (360 OR 370)    81154  00310000
&DEFSYS  SETC  'MVS'               HERE          (SYSTEM FLAVOR) 85077  00320000
&DEFSP1R SETC  '0303'                            SP1 RELEASE     85077  00330000
&DEFSP2R SETC  '0200'                            SP2 RELEASE     90252  00340000
&DEFSP3R SETC  '0100'                            SP3 RELEASE     90217  00350000
&DEFJES2 SETC  '41'                              JES2 VERSION    90189  00360000
&DEFMAC  SETC  'GEN'         PRINT OPTION FOR LOCAL MACROS       81154  00370000
&DEFSOR  SETC  'NOGEN'       PRINT OPTION FOR SOURCE CODE        81154  00380000
&DEFSYM  SETC  'NOGEN'       PRINT OPTION FOR SYSTEM MACROS      81154  00390000
&SVCJFCB SETA  0             MODJFCB SVC (SOURCE MEMBER IGC00240)82099  00400000
&SVC@SVC SETA  0             @SERVICE INSTALLED AS SVC ? (255)   84160  00410000
&SVCTMSX SETA  0             UCC-1 (TMS) SVC X                   92271  00420000
&SVCTMSY SETA  0             UCC-1 (TMS) SVC Y                   92271  00430000
.*                                                                      00440000
.FINDTOK AIF   (&CURSOR GE &K).MERGE                             82099  00450000
&CURSOR  SETA  &CURSOR+1                                                00460000
         AIF   ('&SYSPARM'(&CURSOR,1) EQ ' ').FINDTOK                   00470000
         AIF   ('&SYSPARM'(&CURSOR,1) EQ ',').FINDTOK                   00480000
.*                                                                      00490000
&DELIM   SETC  '&SYSPARM'(&CURSOR,1)                                    00500000
&TOKEN   SETC  '&DELIM'                                                 00510000
         AIF   ('&DELIM' EQ '''' OR '&DELIM' EQ '"').CURINC2            00520000
&DELIM   SETC  ''                                                       00530000
&TOKEN   SETC  ''                                                       00540000
.*                                                                      00550000
.SCANTOK AIF   (&CURSOR GT &K).ENDTOK                           82099   00560000
&CHAR    SETC  '&SYSPARM'(&CURSOR,1)                                    00570000
         AIF   ('&DELIM' EQ '&CHAR').CATDEL                             00580000
         AIF   ('&DELIM' EQ '').TESTEND                                 00590000
         AGO   .CATTOK                                                  00600000
.CATDEL  ANOP  ,                                                        00610000
&TOKEN   SETC  '&TOKEN'.'&CHAR'                                         00620000
&CURSOR  SETA  &CURSOR+1                                                00630000
         AIF   (&CURSOR GT &K).GOODTOK                           82099  00640000
&CHAR    SETC  '&SYSPARM'(&CURSOR,1)                                    00650000
         AIF   ('&CHAR' NE '&DELIM').ENDQTOK                            00660000
.TESTEND AIF   ('&CHAR' EQ ' ').GOODTOK                                 00670000
         AIF   ('&CHAR' EQ ',').GOODTOK                                 00680000
.CATTOK  ANOP  ,                                                        00690000
&TOKEN   SETC  '&TOKEN'.'&CHAR'                                         00700000
.CURINC2 ANOP  ,                                                        00710000
&CURSOR  SETA  &CURSOR+1                                                00720000
         AGO   .SCANTOK                                                 00730000
.ENDQTOK AIF   ('&CHAR' EQ ' ' OR '&CHAR' EQ ',').GOODTOK               00740000
         MNOTE 4,'TOKENS RUN TOGETHER - COMMA ASSUMED'                  00750000
         AGO   .GOODTOK                                                 00760000
.ENDTOK  AIF   ('&DELIM' EQ '').GOODTOK                                 00770000
         AIF   ('&TOKEN' NE '').GOODTOK                                 00780000
         MNOTE 8,'UNPAIRED DELIMITER IN &&SYSPARM:'                     00790000
         MNOTE 8,'&SYSPARM'                                             00800000
.GOODTOK AIF   ('&TOKEN' NE 'DEBUG' OR '&DBTEST' EQ 'NO').NOTDB         00810000
&BUGBEAR SETB  1                                                 81331  00820000
         AGO   .FINDTOK                                                 00830000
.NOTDB   AIF   ('&TOKEN' EQ '360' OR '&TOKEN' EQ '370' OR '&TOKEN'     *00840000
               EQ '470' OR '&TOKEN' EQ '390').SETMODL           GP04234 00850000
         AIF   ('&TOKEN' EQ 'MVS' OR '&TOKEN' EQ 'SVS' OR '&TOKEN'     *00860000
               EQ 'VS1' OR '&TOKEN' EQ 'MVT').SETSYS             82137  00870000
         AIF   ('&TOKEN     '(1,6) EQ 'MVS/SP').SETSP            82091  00880000
         AIF   ('&TOKEN     '(1,6) EQ 'MVS/XA').SETXA            82091  00890000
         AIF   ('&TOKEN     '(1,7) EQ 'MVS/ESA').SETESA          90217  00900000
         AIF   ('&TOKEN   '(1,3) EQ 'J2/').SETJES2               85076  00910000
         AIF   (K'&TOKEN NE 6 AND K'&TOKEN NE 8).NOTPROP         82099  00920000
         AIF   ('&TOKEN'(1,1) NE 'P').NOTPROP                    82099  00930000
         AIF   ('&TOKEN'(3,1) NE '/').NOTPROP                    82099  00940000
         AIF   ('&TOKEN'(K'&TOKEN-2,3) NE 'GEN').NOTPROP         82099  00950000
         AIF   ('&TOKEN'(2,1) EQ 'S').PROPSOR                    82099  00960000
         AIF   ('&TOKEN'(2,1) EQ 'M').PROPMAC                    82099  00970000
         AIF   ('&TOKEN'(2,1) EQ 'Y').PROPSYS                    82099  00980000
.NOTPROP AIF   (NOT &GOTLOC).GETLOC                              82099  00990000
         AIF   (&SYSPRM# GE 10).TOOMANY                                 01000000
&SYSPRM# SETA  &SYSPRM#+1                                               01010000
&SYSPRMS(&SYSPRM#) SETC '&TOKEN'                                        01020000
         AGO   .FINDTOK                                                 01030000
.SETMODL ANOP  ,                                                 81154  01040000
&MODEL   SETC  '&TOKEN'                                          81154  01050000
         AGO   .FINDTOK                                          81154  01060000
.*                                                               82099  01070000
.*       PRINT OPTIONS MAY BE PARTIALLY SET WITH THE FORM        82099  01080000
.*       SYSPARM=P?/GEN AND =P?/NOGEN, WHERE ? IS S, M, OR Y     82099  01090000
.PROPSOR ANOP  ,             PS/ - SET SOURCE OPTION             82099  01100000
&PRTSOR  SETC  '&TOKEN'(4,K'&TOKEN-3)                            82099  01110000
         AGO   .FINDTOK                                          82099  01120000
.PROPMAC ANOP  ,             PM/ - SET LOCAL MACRO OPTION        82099  01130000
&PRTMAC  SETC  '&TOKEN'(4,K'&TOKEN-3)                            82099  01140000
         AGO   .FINDTOK                                          82099  01150000
.PROPSYS ANOP  ,             PY/ - SET SYSTEM MACRO OPTION       82099  01160000
&PRTSYS  SETC  '&TOKEN'(4,K'&TOKEN-3)                            82099  01170000
         AGO   .FINDTOK                                          82099  01180000
.SETJES2 ANOP  ,                                                 85076  01190000
&JES2REL SETC  '&TOKEN'(4,K'&TOKEN-3)                            85076  01200000
         AGO   .FINDTOK                                          85076  01210000
.*                                                               85076  01220000
.*                                                               82091  01230000
.SETSP   AIF   ('&TOKEN' EQ 'MVS/SP').SETSYS                     82091  01240000
&SPVEREL SETC  ''                                                82091  01250000
.SETSP1  ANOP  ,                                                 82091  01260000
&I       SETA  6                                                 82091  01270000
.SETSP2  ANOP  ,                                                 82091  01280000
&CHAR    SETC  ''                                                82091  01290000
.SETSP3  ANOP  ,                                                 82091  01300000
&I       SETA  &I+1                                              82091  01310000
         AIF   ('&TOKEN'(&I,1) EQ '.').SPENDL                    82091  01320000
&CHAR    SETC  '&CHAR'.'&TOKEN'(&I,1)                            82091  01330000
         AIF   (&I LT K'&TOKEN).SETSP3                           82091  01340000
.SPENDL  AIF   (K'&CHAR LE 2).SPNERRL                            82091  01350000
         MNOTE 8,'"&CHAR" IN "&TOKEN" IS MORE THAN 2 DIGITS'     82091  01360000
         MNOTE 8,'"&CHAR" WILL BE TRUNCATED ON THE LEFT'         82091  01370000
.SPNERRL ANOP  ,                                                 82091  01380000
&CHAR    SETC  '00'.'&CHAR'                                      82091  01390000
&SPVEREL SETC  '&SPVEREL'.'&CHAR'(K'&CHAR-1,2)                   82091  01400000
         AIF   (&I LT K'&TOKEN).SETSP2                           82091  01410000
&SYSTEM  SETC  'MVS/SP'                                          82091  01420000
         AIF   (K'&SPVEREL GT 2).SPRELS                          82091  01430000
&SPVEREL SETC  '&SPVEREL'.'01'                                   82091  01440000
.SPRELS  AIF   (K'&SPVEREL GT 4).SPLEVS                          82091  01450000
&SPVEREL SETC  '&SPVEREL'.'00'                                   82091  01460000
.SPLEVS  AIF   ('&SPVEREL'(1,2) LE '01').FINDTOK                 82091  01470000
&MVSXA   SETB  1                                                 82091  01480000
         AIF   ('&SPVEREL'(1,2) LE '02').FINDTOK                 90217  01490000
&MVSESA  SETB  1                                                 90217  01500000
         AGO   .FINDTOK                                          82091  01510000
.*                                                               82091  01520000
.SETXA   AIF   ('&TOKEN' EQ 'MVS/XA').SETSYS                     82091  01530000
&SYSTEM  SETC  'MVS/SP'                                          82091  01540000
&SPVEREL SETC  '02'                                              82091  01550000
         AGO   .SETSP1                                           82091  01560000
.*                                                               90217  01570000
.SETESA  AIF   ('&TOKEN' EQ 'MVS/ESA').SETSYS                    90217  01580000
&SYSTEM  SETC  'MVS/SP'                                          90217  01590000
&SPVEREL SETC  '03'                                              90217  01600000
         AGO   .SETSP1                                           90217  01610000
.*                                                               82091  01620000
.SETSYS  ANOP  ,                                                 81154  01630000
&SYSTEM  SETC  '&TOKEN'                                          81154  01640000
         AGO   .FINDTOK                                          81154  01650000
.GETLOC  AIF   ('&TOKEN' EQ 'TSM').OPTTSM                               01660000
&DEFSYS  SETC  'MVS'         DEFAULT SYSTEM                      94217  01670000
&DEFMAC  SETC  'GEN'         LOCAL MACROS                        90031  01680000
&DEFSOR  SETC  'NOGEN'       LOCAL SOURCE                        90031  01690000
&DEFSYM  SETC  'NOGEN'       SYSTEM MACROS                       90031  01700000
&SVCJFCB SETA  0             NO MODJFCB SVC                      90031  01710000
&SVC@SVC SETA  0             @SERVICE NOT INSTALLED AS SVC       90031  01720000
&SVCTMSX SETA  0             UCC-1 TMS ?                         90031  01730000
&SVCTMSY SETA  0             UCC-1 TMS ?                         90031  01740000
         AGO   .OPT370                                           90031  01750000
.*                                                                      01760000
.OPTTSM  ANOP  ,                                                 82099  01770000
&SVCJFCB SETA  240           MODJFCB SVC                         82099  01780000
&SVC@SVC SETA  0             @SERVICE NOT INSTALLED AS SVC       83100  01790000
&SVCTMSX SETA  0             UCC-1 TMS ?                         82099  01800000
&SVCTMSY SETA  0             UCC-1 TMS ?                         82099  01810000
.*                                                                      01820000
.OPTMVS  ANOP  ,                                                        01830000
&DEFSYS  SETC  'MVS'                                                    01840000
         AGO   .OPT370                                           82099  01850000
.*                                                                      01860000
.OPTSVS  ANOP  ,                                                        01870000
&DEFSYS  SETC  'SVS'                                                    01880000
.OPT370  ANOP  ,                                                        01890000
&DEFMOD  SETC  '370'                                                    01900000
.COMLOC  ANOP  ,                                                 81154  01910000
&LOCAL   SETC  '&TOKEN'                                          81154  01920000
&GOTLOC  SETB  1                                                        01930000
         AGO   .FINDTOK                                          81154  01940000
.TOOMANY MNOTE 8,'MORE THAN 10 ELEMENTS IN &&SYSPARM:'                  01950000
         MNOTE 8,'&SYSPARM'                                             01960000
.MERGE   AIF   ('&LOCAL' NE '').MGLOC                            81154  01970000
&LOCAL   SETC  '&DEFLOC'                                         81154  01980000
.MGLOC   AIF   ('&MODEL' NE '').MGMOD                            81154  01990000
&MODEL   SETC  '&DEFMOD'                                         81154  02000000
.MGMOD   AIF   ('&PRTMAC' NE '').MGMAC                           81154  02010000
&PRTMAC  SETC  '&DEFMAC'                                         81154  02020000
.MGMAC   AIF   ('&PRTSOR' NE '').MGSOR                           81154  02030000
&PRTSOR  SETC  '&DEFSOR'                                         81154  02040000
.MGSOR   AIF   ('&PRTSYS' NE '').MGSYM                           81154  02050000
&PRTSYS  SETC  '&DEFSYM'                                         81154  02060000
.MGSYM   AIF   ('&SYSTEM' NE '').MGSYS                           81154  02070000
&SYSTEM  SETC  '&DEFSYS'                                         81154  02080000
.MGSYS   ANOP  ,                                                 81154  02090000
&MVSESA  SETB  (&MVSESA OR '&SYSTEM' EQ 'MVS/ESA')               90217  02100000
&MVSXA   SETB  (&MVSXA OR &MVSESA OR '&SYSTEM' EQ 'MVS/XA')      90217  02110000
&MVSSP   SETB  (&MVSSP OR &MVSXA OR '&SYSTEM' EQ 'MVS/SP')       90217  02120000
         AIF   (NOT &MVSSP OR '&SPVEREL' NE '').MGSP             82091  02130000
&SYSTEM  SETC  'MVS/SP'                                          82091  02140000
&SPVEREL SETC  '01'.'&DEFSP1R'                                   82091  02150000
         AIF   (NOT &MVSXA).MGSP                                 82091  02160000
&SYSTEM  SETC  'MVS/XA'                                          90217  02170000
&SPVEREL SETC  '02'.'&DEFSP2R'                                   82091  02180000
         AIF   (NOT &MVSESA).MGSP                                90217  02190000
&SYSTEM  SETC  'MVS/ESA'                                         90217  02200000
&SPVEREL SETC  '03'.'&DEFSP3R'                                   90217  02210000
.MGSP    AIF   ('&JES2REL' NE '').MGSJ2                          85076  02220000
&JES2REL SETC  '&DEFJES2'                                        85076  02230000
.MGSJ2   ANOP  ,                                                 85076  02240000
&CPU     SETC  '&MODEL'                                                 02250000
&MVS     SETB  ('&SYSTEM'(1,3) EQ 'MVS')                         82091  02260000
&SVS     SETB  ('&SYSTEM' EQ 'SVS')                                     02270000
&VS1     SETB  ('&SYSTEM' EQ 'VS1')                              82137  02280000
.BYEBYE  AIF   ('&LIST' EQ 'NO').MEND                            81154  02290000
         MNOTE *,'                                                  '   02300000
         MNOTE *,'               INSTALLATION &LOCAL                '   02310000
&CHAR    SETC  ''                                                85076  02320000
         AIF   (NOT &MVSSP).PRTVER                               85076  02330000
&CHAR    SETC  'V'.'&SPVEREL'(1,2)                               82091  02340000
         AIF   (K'&SPVEREL LE 3).PRTVER                          82091  02350000
&CHAR    SETC  '&CHAR'.'.R'.'&SPVEREL'(3,2)                      82091  02360000
         AIF   (K'&SPVEREL LE 5).PRTVER                          82091  02370000
&CHAR    SETC  '&CHAR'.'.L'.'&SPVEREL'(5,2)                      82091  02380000
.PRTVER  MNOTE *,'      CPU   &MODEL      SYSTEM &SYSTEM  &CHAR     '   02390000
         AIF   ('&JES2REL' EQ '').NOTJES2                        85076  02400000
         MNOTE *,'      JES2 RELEASE &JES2REL                       '   02410000
.NOTJES2 MNOTE *,'      PRINT SOR &PRTSOR  MAC &PRTMAC  SYS &PRTSYS '   02420000
         MNOTE *,'      SVC:  TMS=&SVCTMSX/&SVCTMSY  JFCB=&SVCJFCB  @SV*02430000
               C=&SVC@SVC '                                      83100  02440000
         MNOTE *,'                                                  '   02450000
         AIF   ('&SHOW' EQ '').IFBUG                                    02460000
         MNOTE *,'      MVS &MVS  MVS/SP &MVSSP  MVS/XA &MVSXA  MVS/ESA*02470000
               &MVSESA'                                                 02480000
.IFBUG   AIF   (NOT &BUGBEAR).MEND                               82099  02490000
         MNOTE *,'**************************************************'   02500000
         MNOTE *,'*                                                *'   02510000
         MNOTE *,'*              DEBUG MODE IN EFFECT              *'   02520000
         MNOTE *,'*                                                *'   02530000
         MNOTE *,'**************************************************'   02540000
.MEND    MEND  ,                                                 81154  02550000
./ ADD NAME=TERMTYPE
         MACRO                                                          00010000
&NAME    TERMTYPE &TERMIDL=                                             00020000
         CNOP 0,4                                                       00030000
&NAME    DS   0H                                                        00040000
         SR   1,1                  ZERO REGISTER 1                      00050000
         LA   0,&TERMIDL           LOAD TERMINAL ID LOCATION            00060000
         LA   15,2                 LOAD ENTRY CODE                      00070000
         SLL  15,24                SHIFT TO TOP BYTE                    00080000
         OR   0,15                 GATE INTO REGISTER 0                 00090000
         LNR  0,0                  MAKE NEGATIVE                        00100000
         SVC  94                   ISSUE TERMINAL CONTROL SVC           00110000
         MEXIT                                                          00120000
         MEND                                                           00130000
./ ADD NAME=#TGET
         MACRO ,                                                        00010000
&NM      #TGET &ADDR,&LEN,&NOTSO=WTOR                    NEW ON GP12313 00020000
         GBLC  &MACPLAB                                                 00030000
.*--------------------------------------------------------------------* 00040000
.*   #TGET IS A SIMPLE TGET REPLACEMENT. IT INVOKES SUBTGET TO ISSUE  * 00050000
.*     EITHER A GETLINE (FOR A TSO CALLER) OR A WTOR (BATCH).         * 00060000
.*                                                                    * 00070000
.*   USER PASSES BUFFER ADDRESS IN R1, AND MAX LENGTH IN R0           * 00080000
.*   NOTSO= ACTION WHEN NOT UNDER TSO: WTOR or SKIP                   * 00090000
.*--------------------------------------------------------------------* 00100000
         LCLA  &I,&NOTS                                                 00110000
         LCLC  &L,&C                                                    00120000
&MACPLAB SETC  '&NM'                                                    00130000
&L       SETC  'L'''                                                    00140000
         AIF   (T'&ADDR NE 'O').HAVEAD                                  00150000
         MNOTE 8,'#TGET: ADDRESS OPERAND REQUIRED'                      00160000
         MEXIT ,                                                        00170000
.HAVEAD  AIF   (T'&NOTSO EQ 'O').SKIPACT                                00180000
&C       SETC  '&NOTSO'.'    '                                          00190000
&C       SETC  '&C'(1,4)                                                00200000
.LOOPACT AIF   ('&C' EQ 'WTORSKIP'(&I*4+1,4)).HAVEACT                   00210000
&I       SETA  &I+1                                                     00220000
         AIF   (&I LT 2).LOOPACT                                        00230000
         MNOTE 4,'#TGET: UNSUPPORTED NOTSO &NOTSO'                      00240000
         AGO   .SKIPACT                                                 00250000
.HAVEACT ANOP  ,                                                        00260000
&NOTS    SETA  &I                                                       00270000
.*                                                                      00280000
.SKIPACT MACPARM R0,&LEN,NULL=&L&LEN                                    00290000
         MACPARM R1,&ADDR    LOAD ADDRESS REGISTER                      00300000
.SUBCALL AIF   (&NOTS EQ 0).TGET                                        00310000
         MACPARM R0,8,=AL1(&NOTS),OP=ICM,MODE=THREE   SET ACTION        00320000
.TGET    ANOP  ,                                                GP12162 00330000
         SUBCALL /SUBTGET                                       GP12162 00340000
.MEND    MEND  ,                                                        00350000
./ ADD NAME=TIC
         MACRO ,                                                        00010000
&NM      TIC   &ADDR         DEFINE TRANSFER-IN-CHANNEL CCW     GP07007 00020000
&NM      CCW   X'08',(&ADDR),0,0                                        00030000
         MEND  ,                                                        00040000
./ ADD NAME=TMONSECT
         MACRO ,                                                        00010000
&NM      TMONSECT &IO=5,&US=2,&DSECT=YES                ADDED ON 86155  00020000
         LCLC  &N                                                       00030000
&N       SETC  'TMONSECT'                                               00040000
         AIF   ('&NM' EQ '').DFLT                                       00050000
&N       SETC  '&NM'                                                    00060000
.DFLT    AIF   ('&DSECT' EQ 'YES' OR '&DSECT' EQ '').DSECT              00070000
         AIF   ('&DSECT' EQ 'DSECT').DSECT                              00080000
         AIF   ('&DSECT' EQ 'CSECT').CSECT                              00090000
&N       DS    0D            TMON APPLICATION DATA RECORD  10/84        00100000
         AGO   .COMMON                                                  00110000
.CSECT   ANOP  ,                                                        00120000
&N       CSECT ,             TMON APPLICATION DATA RECORD  10/84        00130000
         AGO   .COMMON                                                  00140000
.DSECT   ANOP  ,                                                        00150000
&N       DSECT ,             TMON APPLICATION DATA RECORD  10/84        00160000
.COMMON  ANOP  ,                                                        00170000
TMDRDW   DC    Y(TMDRLEN,0)  SAM RECORD DESCRIPTOR                      00180000
TMDALEN  DC    Y(TMDRLEN-4)  LENGTH WITHOUT SAM RDW                     00190000
TMDRECID DC    C'D'          RECORD TYPE (DETAIL RECORD)                00200000
TMDDETID EQU   C'D'            DETAIL RECORD ID                         00210000
TMDSYSID DC    CL4' '        APPLICATION ID OF CICS SYSTEM              00220000
TMDTRAID DC    CL8' '        TRANSACTION NAME                           00230000
TMDTERM  DC    CL4' '        TERMINAL ID                                00240000
TMDUSER  DC    CL3' '        OPERATOR ID                                00250000
TMDPGM   DC    CL8' '        PROGRAM NAME OF FIRST IN TRANSACTION       00260000
TMDACCT  DC    CL8' '        USER (ACCOUNT) FIELD                       00270000
TMDRECDT DC    CL6' '        TERMINATION DATE (YYMMDD)                  00280000
TMDABND  DC    CL4' '        CICS ABEND NAME                            00290000
TMDTSKID DC    PL3'0'        TCA TASK ID                                00300000
TMDFACFG DC    X'00'         FACILITY FLAG                              00310000
TMDSELVL DC    X'00'         SECURITY LEVEL                             00320000
TMDVEREL DC    X'00'         CICS VERSION/RELEASE                       00330000
TMDMONVR DC    AL1(0)        TMON VERSION NUMBER                        00340000
         DC    X'00'           RESERVED                                 00350000
TMDTASK# DC    XL4'0'        TMON'S ORIGINATED TASK COUNT               00360000
         DC    XL4'0'          RESERVED                                 00370000
TMDTIMON DC    XL4'0'        ATTACH START TIME                          00380000
TMDTIMOF DC    XL4'0'        DETACH TIME                                00390000
TMDTIMRN DC    XL4'0'        PROCESSING TIME                            00400000
TMDCPU   DC    XL4'0'        CPU TIME                                   00410000
TMDWAIT  DC    XL4'0'        WAIT TIME                                  00420000
TMDPAGIN DC    XL4'0'        PAGES PAGED IN                             00430000
TMDPAGOT DC    XL4'0'        PAGES PAGED OUT                            00440000
TMDSTHWM DC    XL4'0'        TCA/TIOA STORAGE HIGH-WATER MARK           00450000
TMD#GETM DC    XL4'0'        NUMBER OF GETMAINS ISSUED                  00460000
TMDHISTG DC    XL4'0'        HIGHEST NUMBER OF GETMAINS                 00470000
TMDTRMIN DC    XL4'0'        TERMINAL INPUT COUNT                       00480000
TMDTRMIL DC    XL4'0'        TERMINAL INPUT LENGTH                      00490000
TMDTRMOT DC    XL4'0'        TERMINAL OUTPUT COUNT                      00500000
TMDTRMOL DC    XL4'0'        TERMINAL OUTPUT LENGTH                     00510000
TMDTYPE  DC    X'00'         DEVICE TYPE FROM TCTTE                     00520000
TMDAID   DC    X'00'         TCTTE AID BYTE AT TASK START               00530000
TMDFG1   DC    X'00'         FLAGS                                      00540000
TMFMAXTK EQU   X'80'           MAX TASKS OCCURRED                       00550000
TMFMAXAC EQU   X'40'           MAXIMUM ACTIVE OCCURRED                  00560000
TMFSOS   EQU   X'20'           SOS OCCURRED                             00570000
TMFSTGV  EQU   X'10'           STORAGE VIOLATION                        00580000
TMFABND  EQU   X'08'           ABENDED                                  00590000
TMFABNDM EQU   X'04'           ABENDED BY MONITOR                       00600000
TMFSUSP  EQU   X'02'           SUSPENDED                                00610000
TMFENQ   EQU   X'01'           CICS ENQUEUE USED                        00620000
TMDFG2   DC    X'00'         MORE FLAGS                                 00630000
TMFIBMTK EQU   X'80'           IBM TASK                                 00640000
TMFCONTK EQU   X'40'           CONVERSATIONAL TASK                      00650000
TMFPRTTK EQU   X'20'           PRINTER TASK                             00660000
TMFATITK EQU   X'10'           ATI TASK                                 00670000
TMFSWAIT EQU   X'08'           STRING WAIT                              00680000
TMFBWAIT EQU   X'04'           BUFFER WAIT                              00690000
TMFDMS   EQU   X'02'           DMS USED                                 00700000
TMFUFO   EQU   X'01'           UFO USED                                 00710000
TMDFG3   DC    X'00'         STILL MORE FLAGS                           00720000
TMFBAL   EQU   X'80'           PROGRAM IN ASSEMBLER LANGUAGE            00730000
TMFPLI   EQU   X'40'           PL/I                                     00740000
TMFCOB   EQU   X'20'           COBOL                                    00750000
TMFRPG   EQU   X'10'           RPG                                      00760000
TMFPSPF  EQU   X'04'           PROGRAM SUBPOOL COMPRESSED               00770000
TMFPFET  EQU   X'02'           PROGRAM FETCH USED                       00780000
TMFABNDS EQU   X'01'           SYSTEM ABEND OCCURRED                    00790000
TMDFG4   DC    X'00'         AND YET MORE FLAGS                         00800000
TMFACP   EQU   X'80'           ACP                                      00810000
TMFIRC   EQU   X'40'           IRC                                      00820000
TMFISC   EQU   X'20'           ISC                                      00830000
TMFEIP   EQU   X'10'           EIP                                      00840000
TMFICP   EQU   X'08'           ICP                                      00850000
TMFFCP   EQU   X'04'           FCP                                      00860000
TMFTDP   EQU   X'02'           TDP                                      00870000
TMFTSP   EQU   X'01'           TSP                                      00880000
TMDFG5   DC    X'00'         ALMOST THE LAST FLAGS                      00890000
TMFDLI   EQU   X'80'           DL/I                                     00900000
TMFJCP   EQU   X'40'           JCP                                      00910000
TMFBMS   EQU   X'20'           BMS                                      00920000
TMFBIF   EQU   X'10'           BIF                                      00930000
TMFPSB   EQU   X'08'           PSB SCHEDULED                            00940000
TMFPRAY  EQU   X'04'           MANTIS USED                              00950000
TMFNATCH EQU   X'02'           NATURAL USED                             00960000
TMFSTAR  EQU   X'01'           GENER/OL USED                            00970000
TMDFG6   DC    X'00'         LAST, BUT NOT LEAST, FLAGS                 00980000
TMFDETL  EQU   X'80'           DETAIL RECORD                            00990000
TMFSUMRY EQU   X'40'           SUMMARY RECORD                           01000000
TMFSYSTM EQU   X'20'           SYSTEM DETAIL (TCP, KCP, JCP)            01010000
TMFCISPT EQU   X'02'           CI SPLIT OCCURRED                        01020000
TMFCASPT EQU   X'01'           CA SPLIT OCCURRED                        01030000
TMDFCPTM DC    XL4'0'        FCP FILE TIME                              01040000
TMDFCPCT DC    XL4'0'        FCP COUNT                                  01050000
TMDDLITM DC    XL4'0'        DL1 CALLS TIMES                            01060000
TMDDLICT DC    XL4'0'        DL1 COUNT                                  01070000
TMDSTGTM DC    XL4'0'        TEMPSTG TIMES                              01080000
TMDSTGCT DC    XL4'0'        TEMPSTG COUNT                              01090000
TMDELATM DC    XL4'0'        TD (EXTRA) ELAPSED TIME                    01100000
TMDELACT DC    XL4'0'        TD (EXTRA) COUNT                           01110000
TMDFETTM DC    XL4'0'        PROGRAM FETCH TIME                         01120000
TMDFETCT DC    XL4'0'        PROGRAM FETCH COUNT                        01130000
TMDJURTM DC    XL4'0'        JOURNAL TIME                               01140000
TMDJURCT DC    XL4'0'        JOURNAL COUNT                              01150000
TMDIONUM DC    AL1(&IO)      NUMBER OF ENTRIES THAT FOLLOW              01160000
TMDIOREC DS    0X            START OF I/O FILE ACCESS ENTRY             01170000
TMDIOFIT DC    CL8' '        FILE/DBD NAME                              01180000
TMDIOFG1 DC    X'00'         FILE TYPE FLAG                             01190000
TMFISAM  EQU   X'80'           ISAM                                     01200000
TMFBDAM  EQU   X'40'           BDAM                                     01210000
TMFVSAM  EQU   X'20'           VSAM                                     01220000
TMFIODLI EQU   X'10'           DL/I                                     01230000
TMFIORMT EQU   X'08'           REMOTE ?                                 01240000
TMFIOPSB EQU   X'04'           DL/I PSB                                 01250000
TMFUSER  EQU   X'01'           USER DATABASE                            01260000
TMDIOFG2 DC    X'00'         ACTION FLAGS                               01270000
TMFADD   EQU   X'80'           ADD/INSERT                               01280000
TMFUPDT  EQU   X'40'           UPDATE/REPLACE                           01290000
TMFGET   EQU   X'20'           GET                                      01300000
TMFPEEK  EQU   X'10'           BROWSE                                   01310000
TMFOC    EQU   X'08'           OPEN/CLOSE                               01320000
TMFVSSWT EQU   X'04'           VSAM STRING WAIT                         01330000
TMFVSBWT EQU   X'02'           VSAM BUFFER WAIT                         01340000
TMFSPLIT EQU   X'01'           VSAM SPLIT OCCURRED                      01350000
TMDIOUCB DC    XL2'0'        FILE/DBD UCB CUU                           01360000
TMDIOVOL DC    CL6' '        FILE/DBD VOLUME SERIAL                     01370000
TMDIOTIM DC    XL4'0'        ACCESS TIME                                01380000
TMDIOCT  DC    XL4'0'        ACCESS COUNT                               01390000
TMDIOLEN EQU   *-TMDIOREC      LENGTH OF ONE ENTRY                      01400000
         ORG   TMDIOREC      REDEFINE                                   01410000
TMDIOENT DC    (&IO)XL(TMDIOLEN)'0'    FILE ACCESS TABLE ENTRIES        01420000
TMDUSNUM DC    X'00'         NUMBER OF USER ENTRIES                     01430000
TMDUSREC EQU   *             START OF USER RECORD ENTRY                 01440000
TMDUSID  DC    X'00'         TMCT ID CODE                               01450000
TMDUSFG1 DC    X'00'         FLAG                                       01460000
TMFCLOCK EQU   X'80'           CLOCK ENTRY                              01470000
TMFCOUNT EQU   X'40'           COUNTER ENTRY                            01480000
TMDUSDAT DC    XL4'0'        ACCUMULATED DATA (TIMES OR COUNTS)         01490000
TMDUSOCC DC    XL4'0'        NUMBER OF OCCURRENCES                      01500000
TMDUSBEG DC    XL4'0'        START TIME                                 01510000
TMDUSLEN EQU   *-TMDUSREC    LENGTH OF ONE ENTRY                        01520000
         ORG   TMDUSREC      BUMP BACK                                  01530000
TMDUSENT DC    (&US)XL(TMDUSLEN)'0'  INITIALIZE                         01540000
TMDRLEN  EQU   *-TMDRDW      LENGTH OF RECORD                           01550000
         MEND  ,                                                        01560000
./ ADD NAME=TMSREC
         MACRO ,                                                        00010000
&NM     TMSREC &SECT=DSECT,&P=TM,&VERSION=50                     92364  00020000
         LCLC  &N                                                       00030000
.*       THIS IS A LOCAL VERSION OF THE CA-1 (UCC-1) VOLUME RECORD.     00040000
.*       THE COPY WAS ADDED HERE TO PERMIT UTILITIES AND REPORT         00050000
.*       PROGRAMS TO BE ASSEMBLED INDEPENDENTLY OF TMS LIBRARIES.       00060000
.*       UPDATED FOR TMS 4.8 (FUNNY EXPDT, 3480 SUPPORT)         90082  00070000
&N       SETC  '&NM'                                                    00080000
         AIF   ('&SECT' EQ 'DSECT').DSECT                               00090000
         AIF   ('&NM' EQ '').DONESEC                                    00100000
&NM       DS   0D            ALIGN RECORD                               00110000
         AGO   .DONESEC                                                 00120000
.DSECT   AIF   ('&N' NE '').HDSEC                                       00130000
&N       SETC  'TMRECORD'                                               00140000
.HDSEC   ANOP  ,                                                        00150000
&N       DSECT ,                                                        00160000
.DONESEC AIF   (&VERSION GE 50).NEWREC                           92364  00170000
&P.DSN    DS   CL44          DATASET                                    00180000
&P.STPNAM DS   CL8           NAME OF STEP (OR PROC?)                    00190000
&P.SLOT   DS   AL2           VAULT #                                    00200000
&P.VOLSEQ DS   AL2           VOLUME SEQUENCE                            00210000
&P.CRTDT  DS   PL3           CREATION DATE                              00220000
&P.EXPDT  DS   PL3           EXPIRATION DATE                            00230000
&P.TRTCH  DS   XL1           TAPE MODE                                  00240000
&P.9TRK  EQU   X'80'            9-TRACK TAPE                            00250000
&P.18TRK EQU   X'C0'           18-TRACK (CARTRIDGE)              90082  00260000
*        EQU   X'23'            7-TRACK, EVEN                           00270000
*        EQU   X'3B'            7-TRACK, TRANSLATE                      00280000
*        EQU   X'13'            7-TRACK, CONVERT                        00290000
*        EQU   X'2B'            7-TRACK, EVEN + TRANSLATE               00300000
&P.DEN    DS   XL1           RECORDING DENSITY                          00310000
&P.38000 EQU   X'E3'           18-TRACK IN 38K BPI MODE          90082  00320000
&P.38KC  EQU   X'E7'          38000 BPI  18-TRACK  COMPRESSED    90316  00330000
*        EQU   X'D3'           6250 BPI   9-TRACK                       00340000
*        EQU   X'C3'           1600 BPI   9-TRACK                       00350000
*        EQU   X'83'            800 BPI   7-TRACK                       00360000
*        EQU   X'43'            556 BPI   7-TRACK                       00370000
*        EQU   X'03'            200 BPI   7-TRACK                       00380000
&P.LTYPE  DS   XL1           LABEL TYPE                                 00390000
*        EQU   X'02'            SL                                      00400000
*        EQU   X'0A'            SUL                                     00410000
*        EQU   X'01'            NL                                      00420000
*        EQU   X'04'            NSL                                     00430000
*        EQU   X'10'            BLP                                     00440000
*        EQU   X'40'            AL     AL1                              00450000
*        EQU   X'48'            AU1                              90082  00460000
*        EQU   X'C0'            AL3                              90082  00470000
*        EQU   X'C8'            AU3                              90082  00480000
&P.RECFM  DS   XL1           RECFORM                                    00490000
&P.BLKSI  DS   AL2           BLKSIZE                                    00500000
&P.LRECL  DS   AL2           RECORD LENGTH                              00510000
&P.FLAG2  DS   XL1           TMS FLAGS                                  00520000
&P.CATLOG EQU  X'80'            DSN IS CATALOGED                        00530000
&P.OUTPUT EQU  X'40'            DS WAS WRITTEN                          00540000
&P.REUSE  EQU  X'20'            DS RECREATED                            00550000
&P.TEMPDS EQU  X'10'            TEMPORARY DS                            00560000
&P.E99000 EQU  X'08'            99000 EXPIRATION                        00570000
&P.E99CCC EQU  X'04'            99CCC CYCLE EXPIRATIO                   00580000
&P.E98DDD EQU  X'02'            98DDD ?                                 00590000
&P.ETMS   EQU  X'01'            EXPIRED BY TMS                          00600000
&P.VOLSER DS   CL6           VOLUME SERIAL                              00610000
&P.NXTVOL DS   CL6           NEXT VOLUME IN GROUP                       00620000
&P.PRVVOL DS   CL6           PRIOR VOLUME IN GROUP                      00630000
&P.DSSIF  DS   XL1           PSWD FLAGS                                 00640000
&P.DSSPW  DS   XL4           TMS ACCESS PASSWORD                        00650000
&P.#DSNBS DS   XL2           DSNB COUNT                                 00660000
&P.ADSNB  DS   AL4           BLOCK # OF FIRST DSNB                      00670000
&P.FRSVOL DS   CL6           FIRST VOLUME IN GROUP                      00680000
&P.BATCH# DS   XL1           UPDATE ID ?                                00690000
&P.FLAG3  DS   XL1           TMS FLAGS                                  00700000
&P.BADTAP EQU  X'80'           DO NOT USE FOR SCRATCH                   00710000
&P.XPDTCH EQU  X'40'           EXPDT IS PHONY                           00720000
&P.EXTAP  EQU  X'20'           MANAGED OUTSIDE TMS ?                    00730000
&P.DYNAM  EQU  X'10'           DYNAM-T TAPE ?                    90316  00740000
&P.CRTTI  DS   PL3           TIME CREATED                               00750000
&P.CRUNI  DS   XL2           CUU WRITTEN ON                             00760000
&P.USUNI  DS   XL2           CUU USED ON                                00770000
&P.LASUSD DS   PL3           LAST USED DATE                             00780000
&P.LASUSJ DS   CL8           LAST USED JOB                              00790000
&P.BTHDT  DS   PL3           FIRST EVER USE                             00800000
&P.UCOUNT DS   XL2           USE COUNT                                  00810000
&P.FLAG1  DS   XL1           TMS FLAGS                                  00820000
&P.INTAL  EQU  X'80'           FIELD CHANGED BY USER                    00830000
&P.CLOSED EQU  X'40'           CLOSED BY TMS                            00840000
&P.UPDATE EQU  X'20'           UPDATED BY USER                          00850000
&P.ABEND  EQU  X'10'           WRITER ABENDED                           00860000
&P.CLEAN  EQU  X'08'           SCHEDULE CLEANING                        00870000
&P.SCRTCH EQU  X'04'           LISTED ON SCRATCH                        00880000
&P.DELET  EQU  X'02'           PHYSICAL DELETION FROM TAPELIB           00890000
&P.DFAULT EQU  X'01'           DEFAULT EXPIRY                           00900000
&P.CLNCNT DS   XL1           # TIMES CLEANED                            00910000
&P.OUTDAT DS   PL3           DATE OF REMOVAL FROM SITE                  00920000
&P.OUTAR  DS   CL4           DESTINATION NICKNAME                       00930000
&P.USECLN DS   AL2           TIMES USED AT LAST CLEANING                00940000
&P.DATCLN DS   PL3           DATE CLEANED                               00950000
&P.BLKCNT DS   FL4           BLOCKS IN DS                               00960000
&P.RERROR DS   XL1           # OF READ ERRORS                           00970000
&P.WERROR DS   XL1           # OF WRITE ERRORS                          00980000
&P.JOBNM  DS   CL8           NAME OF (RE)CREATING JOB                   00990000
&P.USER   DS   0CL41         P.I.D.I. GOODIES FIELD                     01000000
IGPACCT  DS    0CL8          ACCT AND SUB-ACCT                          01010000
IGPACT   DC    CL4' '        ACCOUNT NUMBER                             01020000
IGPSUB   DC    CL4' '        SUB ACCOUNT                                01030000
IGPOWN   DC    C' '          OWNERSHIP FLAG                             01040000
IGPOCUS  EQU   C'C'          CUSTOMER OWNED                             01050000
IGPOIGP  EQU   C'D'          PIDI OWNED                                 01060000
IGPBILL  DC    C' '          BILLING FLAG                               01070000
IGPOBIL  EQU   C'B'          BILLABLE                                   01080000
IGPOFRE  EQU   C'F'          FREEBEE                                    01090000
IGPOFLAG DC    X'00'         SPECIAL PROCESSING FLAGS                   01100000
IGPFSYS  EQU   X'80'           SYSTEMS BYPASS - SMF DUMP ETC.           01110000
IGPFBACK EQU   X'40'           TAPE USED FOR BACKUP SERVICE             01120000
IGPODEC  EQU   X'20'           DEC SYSTEM TAPE                          01130000
IGPFBLP  EQU   X'10'           SKIP VOL PROMPT WITH BLP                 01140000
IGPFFLG5 EQU   X'08'           RESERVED                                 01150000
IGPFFLG6 EQU   X'04'           RESERVED                                 01160000
IGPFFLG7 EQU   X'02'           RESERVED                                 01170000
IGPFMANU EQU   X'01'           MANUAL PROCESSING                        01180000
IGPPGMNM DC    CL8' '        PROGRAM NAME                               01190000
IGPDUMMY DC    CL22' '       ROOM FOR MORE STUFF                        01200000
         MEXIT ,                                                 92364  01210000
.NEWREC  ANOP  ,                                                 92364  01220000
&P.VOLSER  DS  CL6           VOLUME SERIAL                       92364  01230000
&P.DSN     DS  CL44          DATA SET NAME                       92364  01240000
&P.EXPDT   DS  PL4           EXPIRATION DATE                     92364  01250000
&P.VOLSEQ  DS  H             VOLUME SEQUENCE NUMBER              92364  01260000
&P.FRSVOL  DS  CL6           FIRST VOLSER OF DATA SET            92364  01270000
&P.PRVVOL  DS  CL6           PREVIOUS VOLSER OF DATA SET         92364  01280000
&P.NXTVOL  DS  CL6           NEXT VOLSER OF DATA SET             92364  01290000
&P.#DSNBS  DS  H             NUMBER OF DATA SET NAME BLOCKS      92364  01300000
&P.ADSNB   DS  F             ADDRESS OF FIRST DSNB               92364  01310000
&P.ALDSNB  DS  F             ADDRESS OF LAST DSNB                92364  01320000
&P.FLAG1   DS  X             FLAGS (1-4)                         92364  01330000
F1INTAL  EQU   X'80'           FIELD CHANGED BY USER             92364  01340000
F1CLOSED EQU   X'40'           VOLUME CLOSED BY TMS              92364  01350000
F1UPDATE EQU   X'20'           RECORD UPDATED BY USER            92364  01360000
F1ABEND  EQU   X'10'           VOLUME CLOSED BY ABEND            92364  01370000
F1CLEAN  EQU   X'08'           TAPE IS TO BE CLEANED             92364  01380000
F1SCRTCH EQU   X'04'           LISTED ON SCRATCH LIST            92364  01390000
F1DELET  EQU   X'02'           VOLUME DELETED FROM LIBRARY       92364  01400000
F1DFAULT EQU   X'01'           DEFAULT EXPIRATION DATE USED      92364  01410000
&P.FLAG2   DS  X                                                 92364  01420000
F2CATLOG EQU   X'80'           DATA SET IS CATALOGED             92364  01430000
F2OUTPUT EQU   X'40'           DATA SET OPENED FOR OUTPUT        92364  01440000
F2REUSE  EQU   X'20'           DATA SET RECREATED                92364  01450000
F2TEMPDS EQU   X'10'           TEMPORARY DATA SET                92364  01460000
F2ECATLG EQU   X'08'           EXPIRE UNDER CATALOG CONTROL      92364  01470000
F2ECYCLE EQU   X'04'           EXPIRE UNDER CYCLE CONTROL        92364  01480000
F2ELDATE EQU   X'02'           EXPIRE UNDER FREQUENCY CONTROL    92364  01490000
F2ETMS   EQU   X'01'           EXPIRED BY TMS                    92364  01500000
&P.FLAG3   DS  X                                                 92364  01510000
F3BADTAP EQU   X'80'           BAD TAPE, DO NOT MOUNT FOR SCRATCH       01520000
F3EDMTAP EQU   X'20'           EXTERNALLY MANAGED TAPE           92364  01530000
F3DYNAM  EQU   X'10'           DYNAM-T OWNED TAPE                92364  01540000
F3FILCPY EQU   X'01'           FILE CREATED BY CA-1/COPYCAT      92364  01550000
&P.FLAG4   DS  X                                                 92364  01560000
&P.TRTCH   DS  X             TRTCH                               92364  01570000
FT9TRK   EQU   X'80'                                             92364  01580000
FT18TRK  EQU   X'C0'           3480                              92364  01590000
FT36TRK  EQU   X'E0'           3490                              92364  01600000
*        EQU   X'23'            7-TRACK, EVEN                           01610000
*        EQU   X'3B'            7-TRACK, TRANSLATE                      01620000
*        EQU   X'13'            7-TRACK, CONVERT                        01630000
*        EQU   X'2B'            7-TRACK, EVEN + TRANSLATE               01640000
&P.DEN     DS  X             DENSITY                             92364  01650000
FD38000  EQU   X'E3'           3480 CARTRIDGE @ 38000 BPI        92364  01660000
FD38KC   EQU   X'E7'                    -"-   COMPACTED          92364  01670000
*        EQU   X'D3'           6250 BPI   9-TRACK                       01680000
*        EQU   X'C3'           1600 BPI   9-TRACK                       01690000
*        EQU   X'83'            800 BPI   7-TRACK                       01700000
*        EQU   X'43'            556 BPI   7-TRACK                       01710000
*        EQU   X'03'            200 BPI   7-TRACK                       01720000
&P.LTYPE   DS  X             TAPE LABEL TYPE                     92364  01730000
*        EQU   X'02'            SL                                      01740000
*        EQU   X'0A'            SUL                                     01750000
*        EQU   X'01'            NL                                      01760000
*        EQU   X'04'            NSL                                     01770000
*        EQU   X'10'            BLP                                     01780000
*        EQU   X'40'            AL     AL1                              01790000
*        EQU   X'48'            AU1                              90082  01800000
*        EQU   X'C0'            AL3                              90082  01810000
*        EQU   X'C8'            AU3                              90082  01820000
&P.RECFM   DS  X             RECORD FORMAT                       92364  01830000
&P.LRECL   DS  F             RECORD LENGTH                       92364  01840000
&P.BLKSI   DS  F             MAXIMUM BLOCK SIZE                  92364  01850000
&P.BLKCNT  DS  F             DATA SET BLOCK COUNT                92364  01860000
&P.OUTDAT  DS  PL4           DATE TAKEN OUT OF AREA              92364  01870000
&P.OUTAR   DS  CL4           (OUT OF) AREA CODE                  92364  01880000
&P.SLOT    DS  F             VAULT SLOT NUMBER                   92364  01890000
&P.CRTDT   DS  PL4           CREATION DATE                       92364  01900000
           DS  X                                      FILLER     92364  01910000
&P.CRTTI   DS  PL3             AND TIME                          92364  01920000
&P.JOBNM   DS  CL8           CREATING JOB NAME                   92364  01930000
&P.STPNAM  DS  CL8             STEP NAME                         92364  01940000
&P.DDNAME  DS  CL8             DDNAME                            92364  01950000
&P.CRUNI   DS  XL2             UNIT                              92364  01960000
&P.LASUSD  DS  PL4           DATE LAST ACCESSED                  92364  01970000
           DS  X                                                 92364  01980000
&P.LASUST  DS  PL3             AND TIME                          92364  01990000
&P.LASUSJ  DS  CL8           JOB THAT LAST USED VOLUME           92364  02000000
&P.USUNI   DS  XL2             UNIT                              92364  02010000
&P.DSSIF   DS  X             INSECURITY FLAGS                    92364  02020000
TSSDPRO  EQU   X'80'           TMS SECURITY PROTECTED            92364  02030000
TSDDREA  EQU   X'40'             READ PROTECTED                  92364  02040000
TSDDWRT  EQU   X'20'             WRITE PROTECTED                 92364  02050000
&P.DSSPW   DS  XL4           SECURITY PASSWORD                   92364  02060000
&P.CLNCNT  DS  X             COUNT OF TAPE CLEANINGS             92364  02070000
&P.USECLN  DS  HL2           USE COUNT AT LAST CLEANING          92364  02080000
&P.DATCLN  DS  PL4           DATE OF LAST CLEANING               92364  02090000
&P.BTHDT   DS  PL4           DATE OF FIRST USE                   92364  02100000
&P.UCOUNT  DS  XL2           NUMBER OF USES                      92364  02110000
&P.VENDOR  DS  CL8           VENDOR'S NAME (???)                 92364  02120000
&P.EDMID   DS  CL4           EXT. MANAGER ID                     92364  02130000
&P.TRERRC  DS  XL2           TEMP READ ERRORS: CLEAN             92364  02140000
&P.TWERRC  DS  XL2           TEMP WRITE ERRORS: CLEAN            92364  02150000
&P.PRERRC  DS  XL2           PERM READ ERRORS: CLEAN             92364  02160000
&P.PWERRC  DS  XL2           PERM WRITE ERRORS: CLEAN            92364  02170000
&P.TRERRI  DS  XL2           TEMP READ ERRORS: INIT              92364  02180000
&P.TWERRI  DS  XL2           TEMP WRITE ERRORS: INIT             92364  02190000
&P.PRERRI  DS  XL2           PERM READ ERRORS: INIT              92364  02200000
&P.PWERRI  DS  XL2           PERM WRITE ERRORS: INIT             92364  02210000
&P.DSN17   DS  XL17          REAL TAPE DSN                       92364  02220000
           DS  XL35                       RESERVED               92364  02230000
&P.USER    DS  0CL50         USER'S PLAYGROUND                   92364  02240000
PIDACCT  DS    0CL8          ACCT AND SUB-ACCT                   92364  02250000
PIDACT   DS    CL4' '        ACCOUNT NUMBER                      92364  02260000
PIDSUB   DS    CL4' '        SUB ACCOUNT                         92364  02270000
PIDOWN   DS    C' '          OWNERSHIP FLAG                      92364  02280000
PIDOCUS  EQU   C'C'            CUSTOMER OWNED                    92364  02290000
PIDOPID  EQU   C'D'            DATACENTER OWNED                  92364  02300000
PIDBILL  DS    C' '          BILLING FLAG                        92364  02310000
PIDOBIL  EQU   C'B'            BILLABLE                          92364  02320000
PIDOFRE  EQU   C'F'            FREEBEE                           92364  02330000
PIDOFLAG DS    X'00'         SPECIAL PROCESSING FLAGS            92364  02340000
PIDFSYS  EQU   X'80'           SYSTEMS BYPASS - SMF DUMP ETC.    92364  02350000
PIDFBACK EQU   X'40'           TAPE USED FOR BACKUP SERVICE      92364  02360000
PIDODEC  EQU   X'20'           HARRIS SYSTEM TAPE                92364  02370000
PIDFBLP  EQU   X'10'           SKIP VOL PROMPT WITH BLP          92364  02380000
PIDFFLG5 EQU   X'08'             RESERVED                        92364  02390000
PIDFFLG6 EQU   X'04'             RESERVED                        92364  02400000
PIDFFLG7 EQU   X'02'             RESERVED                        92364  02410000
PIDFMANU EQU   X'01'             RESERVED                        92364  02420000
PIDPGMNM DS    CL8' '        PROGRAM NAME                        92364  02430000
PIDJNAME DS    CL8' '          ???                               92364  02440000
PIDDUMMY DS    CL23' '       ROOM FOR MORE STUFF                 92364  02450000
         DS    H               ???                               92366  02460000
         DS    PL4           DATE ?                              92366  02470000
         DS    PL4           TIME ?                              92366  02480000
         DS    4H              ???                               92366  02490000
TMCPUID  DS    CL4           SMCA ID                             92366  02500000
         DS    H                                                 92366  02510000
         MEND  ,                                                        02520000
./ ADD NAME=#TPUT
         MACRO ,                                                        00010000
&NM      #TPUT &ADDR,&LEN,&TYPE=,&NOTSO=WTO,&MF=                        00020000
         GBLC  &MACPLAB                                                 00030000
.*--------------------------------------------------------------------* 00040000
.*   #TPUT IS A SIMPLE TPUT REPLACEMENT. IT INVOKES SUBTPUT TO ISSUE  * 00050000
.*     EITHER A PUTLINE (FOR A TSO CALLER) OR A WTO (BATCH).          * 00060000
.*                                                                    * 00070000
.*   TYPE=  CON, BCON, HCON, VCON, DCS - LEN NOT REQUIRED, BECAUSE    * 00080000
.*     ADDR POINTS TO A SELF-DEFINING OBJECT (L/TEXT OR TEXT/X'0')    * 00090000
.*                                                                    * 00100000
.*   NOTSO= ACTION WHEN NOT UNDER TSO: WTO, WTL, SKIP {PRT}           * 00110000
.*--------------------------------------------------------------------* 00120000
         LCLA  &I,&NOTS                                                 00130000
         LCLB  &SDO                                                     00140000
         LCLC  &L                                                       00150000
         LCLC  &R0                                                      00160000
         LCLC  &C                                                       00170000
&MACPLAB SETC  '&NM'                                                    00180000
&R0      SETC  '&LEN'                                                   00190000
&L       SETC  'L'''                                                    00200000
         AIF   (T'&ADDR NE 'O').HAVEAD                                  00210000
         MNOTE 8,'#TPUT: ADDRESS OPERAND REQUIRED'                      00220000
         MEXIT ,                                                        00230000
.HAVEAD  ANOP  ,                                                        00240000
&SDO     SETB  ('&TYPE' EQ 'CON')                                       00250000
&SDO     SETB  (('&TYPE' EQ 'DCS') OR &SDO)                             00260000
&SDO     SETB  (('&TYPE' EQ 'BCON') OR &SDO)                            00270000
&SDO     SETB  (('&TYPE' EQ 'HCON') OR &SDO)                            00280000
&SDO     SETB  (('&TYPE' EQ 'VCON') OR &SDO)                            00290000
         AIF   (NOT &SDO).NEEDLEN                                       00300000
         AIF   (T'&LEN EQ 'O').SKIPLN                                   00310000
       MNOTE 4,'#TPUT:  LENGTH &LEN AND TYPE &TYPE MUTUALLY EXCLUSIVE'  00320000
&SDO     SETB  0                                                        00330000
.SKIPLN  AIF   ('&ADDR'(1,1) NE '''' AND '&ADDR'(1,1) NE '(').ZEROR0    00340000
         MNOTE 4,'#TPUT: TYPE &TYPE INVALID WITH LITERAL TEXT'          00350000
&SDO     SETB  0                                                        00360000
.ZEROR0  ANOP  ,                                                        00370000
&R0      SETC  '0'                                                      00380000
.NEEDLEN AIF   (T'&NOTSO EQ 'O').SKIPACT                                00390000
&C       SETC  '&NOTSO'.'    '                                          00400000
&C       SETC  '&C'(1,4)                                                00410000
.LOOPACT AIF   ('&C' EQ 'WTO WTL PRT SKIP'(&I*4+1,4)).HAVEACT           00420000
&I       SETA  &I+1                                                     00430000
         AIF   (&I LT 4).LOOPACT                                        00440000
         MNOTE 4,'#TPUT: UNSUPPORTED NOTSO &NOTSO'                      00450000
         AGO   .SKIPACT                                                 00460000
.HAVEACT ANOP  ,                                                        00470000
&NOTS    SETA  &I                                                       00480000
.SKIPACT AIF   ('&ADDR'(1,1) EQ '=').LIT                                00490000
         AIF   ('&ADDR'(1,1) NE '''').EXPLIC                            00500000
&I       SETA  K'&ADDR-2                                                00510000
         MACPARM R0,&I                                                  00520000
         MACPARM R1,=CL(&I)&ADDR                                        00530000
         AGO   .SUBCALL                                                 00540000
.*                                                                      00550000
.LIT     AIF   ('&ADDR'(2,2) EQ 'C''').CLIT                             00560000
         MNOTE 8,'#TPUT: ADDRESS OPERAND NOT SUPPORTED'                 00570000
.*                                                                      00580000
.CLIT    ANOP  ,                                                        00590000
&I       SETA  K'&ADDR-4                                                00600000
&R0      SETC   '&I'                                                    00610000
.*                                                                      00620000
.EXPLIC  AIF   ('&R0' NE '').HAVELEN                                    00630000
&R0      SETC  '&L'.'&ADDR'                                             00640000
         AIF   ('&ADDR'(1,1) NE '(').HAVELEN                            00650000
         MNOTE 8,'#TPUT: LENGTH OPERAND REQUIRED'                       00660000
.*                                                                      00670000
.HAVELEN MACPARM R0,&R0      LOAD LENGTH REGISTER                       00680000
         MACPARM R1,&ADDR    LOAD ADDRESS REGISTER                      00690000
.SUBCALL AIF   (&NOTS EQ 0).TPUT                                        00700000
         MACPARM R0,8,=AL1(&NOTS),OP=ICM,MODE=THREE   SET ACTION        00710000
.TPUT    AIF   ('&MF' EQ 'B').MEND                              GP12313 00720000
         SUBCALL /SUBTPUT                                       GP12162 00730000
.MEND    MEND  ,                                                        00740000
./ ADD NAME=#TRACE
         MACRO ,                                                        00010000
&NM      #TRACE &MODE,&REGSAVE=                             NEW GP10101 00020000
.*   THIS IS A QUICK AND DIRTY FRONT END FOR #TRC TO SAVE ME FROM       00030000
.*   ENTERING LOTS OF OPERANDS                                          00040000
&NM      #TRC  &MODE,ADCON=YES,RENT=NO,REGSAVE=&REGSAVE         GP11243 00050000
.MEND    MEND  ,                                                        00060000
./ ADD NAME=TRANHEAD
         MACRO                                                          00010000
&NM      TRANHEAD &DOLL=C';'                               ADDED 79299  00020000
         COPY  OPTIONS                                                  00030000
         LCLA  &I                                                       00040000
         LCLC  &N1                                                      00050000
&N1      SETC  '&NM'                                                    00060000
         AIF   ('&N1' EQ '').BOOBOO                                     00070000
&I       SETA  K'&NM-4                                                  00080000
         AIF   (&I LT 1).BOOBOO                                         00090000
         AIF   ('&N1'(1,4) NE 'EXHT').BOOBOO                            00100000
&N1      SETC  '&N1'(5,&I)                                              00110000
&NM      START 0                                                        00120000
         USING *,R15                                                    00130000
         NUSE  SQSP,R13                                                 00140000
         NUSE  WORK,R11                                                 00150000
*        THIS MODULE PROVIDES TRANSLATION CODE AND TRANSLATE TABLES     00160000
*        FOR SPECIFIC DEVICES.  THE CODE ASSUMES THAT THE TRANSLATE     00170000
*        INSTRUCTION MAY BE USED; E.G. APL AND SIMILAR KEYBOARDS        00180000
*        WITH TWO-CHARACTER SHIFT SEQUENCES ARE NOT SUPPORTED.          00190000
*                                                                       00200000
*        INPUT R2 - BUFFER TO BE TRANSLATED  R3 - BUFFER LENGTH         00210000
*              R0 - FUNCTION SWITCH 0/OUT,DATA  2/OUT,CONTROL           00220000
*                                   4/IN,VAR. CASE  6/IN,UPPER CASE     00230000
*              R15 - BASE ADDRESS OF THIS MODULE                        00240000
*              R14 - RETURN ADDRESS                                     00250000
*          R0-R3 ARE DESTROYED                                          00260000
*                                                                       00270000
         B     TRANSLAT      GO TO TRANSLATION CODE                     00280000
         SPACE 1                                                        00290000
         DC    CL4'&N1 '     MODULE ID                                  00300000
TRANPOIN DC    Y(OUTDATA-&NM)  OUTPUT TABLE; DATA ONLY                  00310000
         DC    Y(OUTCON-&NM)   OUTPUT TABLE; CONTROL AND DATA           00320000
TRANULOW DC    Y(INUPLOW-&NM)  INPUT TABLE; UPPER+LOWER CASE            00330000
         DC    Y(INUPPER-&NM)  INPUT TABLE; UPPER CASE ONLY             00340000
TRANSDOL DC    AL1(&DOLL)    ALTERNATE FOR $ IN COMMANDS         87176  00350000
         DC    XL3'0'          SPARE                             87176  00360000
         DC    3A(0)         FOR EXPANSION                              00370000
         SPACE 1                                                        00380000
TRANSLAT CH    R0,=Y(TRANULOW-TRANPOIN)  UPLOW INPUT ?                  00390000
         BNE   TRANSLAS      NO                                         00400000
         TM    SQTRANS,X'80'  UPLOW FLAG SET ?                          00410000
         BNZ   TRANSLAS      YES; LEAVE LOWER CASE                      00420000
         LA    R0,TRANULOW+2-TRANPOIN  SET UPPER CASE ONLY              00430000
TRANSLAS LR    R1,R0         COPY TABLE OFFSET                          00440000
         LH    R1,TRANPOIN(R1)  GET TABLE OFFSET IN MODULE              00450000
         AR    R1,R15        GET TABLE ADDRESS                          00460000
         LTR   R3,R3         VALID LENGTH ?                             00470000
         BNPR  R14           NO; RETURN                                 00480000
         LR    R0,R14        SAVE RETURN ADDRESS                        00490000
         LA    R14,255       MAKE LENGTH VALUE FOR EXECUTE              00500000
TRANLOOP CH    R3,=H'256'    MORE TO DO ?                               00510000
         BNL   *+8           YES                                        00520000
         LR    R14,R3                                                   00530000
         BCTR  R14,0         SET FOR EXECUTE                            00540000
         EX    R14,TRANTR    TRANSLATE                                  00550000
         LA    R2,1(R2,R14)  BUMP BUFFER                                00560000
         BCTR  R3,0          DECREMENT LENGTH                           00570000
         SR    R3,R14        MORE TO DO ?                               00580000
         BP    TRANLOOP                                                 00590000
         LR    R14,R0        REGAIN EXIT ADDRESS                        00600000
         BR    R14           RETURN TO CALLER                           00610000
TRANTR   TR    0(0,R2),0(R1)  TRANSLATE BUFFER                          00620000
         SPACE 1                                                        00630000
         LTORG ,                                                        00640000
         PUSH  PRINT                                                    00650000
         PRINT NOGEN                                                    00660000
&NM      CSECT ,                                                        00670000
         MSECT ,                                                        00680000
&NM      CSECT ,                                                        00690000
         POP   PRINT                                                    00700000
.MEXIT   MEXIT                                                          00710000
.BOOBOO  MNOTE 12,'NAME MISSING OR INVALID'                             00720000
         MEND                                                           00730000
./ ADD NAME=#TRAP
         MACRO ,                                                        00010000
&NM      #TRAP &LIST,&OPT=(PSW),&ID=,&REGS=YES,&MF=A   ADDED ON GP09277 00020000
.*                                                                    * 00030000
.*  THIS MACRO INVOKES EXTERNAL LOAD MODULE @SPIEDER TO PRODUCE       * 00040000
.*  TRACING, REGISTER CONTENTS, AND VARIABLES. PRIOR TO USE, @SPIEDER * 00050000
.*  MUST BE INITIALIZED WITH '  BANDAID SPIE ' OR ' #TRACE INIT '     * 00060000
.*                                                                    * 00070000
.*  ALTERNATIVELY, IT MAY BE USED IN ANY SECTION OF                   * 00080000
.*  CODE THAT HAS THE PGMTRACE FACILITY ACTIVE (SEE #TRC AND #TRACE   * 00090000
.*  MACROS).                                                          * 00100000
.*                                                                    * 00110000
.*    PRINT REQUIRES A SYSDEBUG DD CARD.                              * 00120000
.*                                                                    * 00130000
.*                                                                    * 00140000
.*  OPTIONAL:  ID=name   IDENTIFIES THE DEBUG PACKET                  * 00150000
.*                                                                    * 00160000
.*                REGS= (DEFAULT) | REGS=NO - NO REGISTERS            * 00170000
.*                REGS=YES  -  REGISTERS R0 THROUGH R15               * 00180000
.*                REGS=(R1,R2) - REGISTERS R1 THROUGH R2              * 00190000
.*                REGS=SHORT   - R14 THROUGH R1                       * 00200000
.*                                                                    * 00210000
.*             OPT=      LIST OF OPTIONAL FORMATTING ITEMS:           * 00220000
.*                PSW, GPR, FPR, CTL                                  * 00230000
.*                later (PGM, BUF, MAP) mini-dump information         * 00240000
.*                                                                    * 00250000
.*             MF=A      POINTER TO ITEM LIST IS ADDRESS CONSTANT     * 00260000
.*             MF=S      POINTER TO ITEM LIST IS BASE/DISPLACEMENT    * 00270000
.*                       (NEEDED FOR WYLBUR OVERLAYS)                 * 00280000
.*             MF=L      PRODUCES ID AND VARIABLE LIST ONLY           * 00290000
.*             MF=(E,list)  USES S CONSTANT TO PROCESS REMOTE LIST    * 00300000
.*                                                                    * 00310000
.*                                                                    * 00320000
.*                                                                    * 00330000
.*       Positional operands (0 to nnn):                              * 00340000
.*           (OP1,LN1,FM1),(OP2,LN2,FM2), ...                         * 00350000
.*                                                                    * 00360000
.*                OP - ADDRESS EXPRESSION VALID IN S CONSTANT         * 00370000
.*                LN - LENGTH EXPRESSION; DEFAULT IS L'OP             * 00380000
.*                FM - TEXT | CTEXT | HEX | PACK - DEFAULT IS HEX     * 00390000
.*                     OR ABBREVIATED   T | CT | H | P                * 00400000
.*                                                                    * 00410000
.*    EACH TRAP WILL EXPAND 8 BYTES IN THE CALLER'S SECTION, AND A    * 00420000
.*    REQUEST LIST IN RSECT TRPnnnnn: B2FF0000/AL4(traplist)          * 00430000
.*                 OR          B2FF0000,FFFF /SL2(traplist)           * 00440000
.*                                                                    * 00450000
.*                                                                    * 00460000
.*  ALLOW *var AS INDIRECT LOOKUP REQUEST - 24-BIT ADDRESS IN WORD    * 00470000
.*  ALLOW /var AS INDIRECT INDIRECT LOOKUP                            * 00480000
.*                2008-04-18  GYP                                     * 00490000
.*  ALLOW REGISTER (ONLY) AS A LENGTH FIELD OPERAND - CODE AS 800r    * 00500000
.*                                                                    * 00510000
.*                                                                    * 00520000
.********************************************************************** 00530000
.*  MAINTENANCE:                                                      * 00540000
.*  2011-12-1n  GYP  ADDED MF= SUPPORT (ALSO IN @SPIEDER & PGMTRACE)  * 00550000
.********************************************************************** 00560000
         GBLA  &MACP#        NUMBER OF SUBLIST PARAMETERS       GP04234 00570000
         GBLB  &BUGBEAR                                         GP09301 00580000
         GBLC  &MACP1,&MACP2,&MACP3,&MACP4,&MACP5,&LOCAL        GP09301 00590000
         GBLC  &MACP6,&MACP7,&MACP8,&MACP9,&MACP10              GP04234 00600000
         GBLC  &V                                                       00610000
         LCLA  &LN,&I,&EN,&EM,&EO,&J,&NL                        GP95235 00620000
         LCLB  &B80,&B40,&B20,&B10,&B08,&B04,&B02,&B01,&EXEC    GP11352 00630000
         LCLC  &L,&ET,&EL,&EK,&CURSECT,&TRPSECT,&TAG,&NMLST     GP11352 00640000
&L       SETC  'L'''                                            GP95235 00650000
&V       SETC  'ZZT'.'&SYSNDX'                                          00660000
&NMLST   SETC  'XTL'.'&SYSNDX'                                  GP11352 00670000
         AIF   (&BUGBEAR).DOSOME                                GP09301 00680000
         AIF   ('&LOCAL' EQ '').DOSOME  NON-ESP ENVIRONMENT     GP09301 00690000
         AIF   ('&NM' EQ '').MEND                                       00700000
&NM      DS    0H            DEBUG SWITCH NOT ON                        00710000
         AGO   .MEND                                                    00720000
.DOSOME  ANOP  ,                                                 95067  00730000
&CURSECT SETC  '&SYSECT'                                        GP09301 00740000
&TRPSECT SETC  '&SYSECT'.'ZZZZZZZZ'                             GP09301 00750000
&TRPSECT SETC  'TRP'.'&TRPSECT'(4,5)                            GP09301 00760000
&TAG     SETC  '&ID'         USE OVERRIDE LABEL                         00770000
         AIF   ('&TAG' NE '').HVTAG                                     00780000
&TAG     SETC  '&NM'         ELSE USE NAME FIELD                        00790000
.HVTAG   ANOP  ,                                                        00800000
&B80     SETB  ('&TAG' NE '' OR &B80)                                   00810000
.*       B01 RESERVED FOR FULL MEMORY DUMP                              00820000
&I       SETA  N'&OPT                                                   00830000
         AIF   (&I GT 0).OPTLOOP                                        00840000
*DEFER*  MNOTE 0,'OPTIONS OMITTED - PSW DEFAULTED'                      00850000
&B40     SETB  1                                                        00860000
         AGO   .OPTDONE                                                 00870000
.OPTLOOP AIF   (&J GE &I).OPTDONE                                       00880000
&J       SETA  &J+1                                                     00890000
&B40     SETB  ('&OPT(&J)' EQ 'PSW' OR &B40)                            00900000
&B20     SETB  ('&OPT(&J)' EQ 'REGS' OR &B20)                           00910000
&B20     SETB  ('&OPT(&J)' EQ 'GPR' OR &B20)                    GP10092 00920000
&B10     SETB  ('&OPT(&J)' EQ 'FPR' OR &B10)                    GP10092 00930000
&B08     SETB  ('&OPT(&J)' EQ 'CTL' OR &B08)   AUTH ONLY        GP10092 00940000
&B04     SETB  ('&OPT(&J)' EQ 'PGM' OR &B04)                            00950000
&B02     SETB  ('&OPT(&J)' EQ 'MAP' OR &B02)                            00960000
&B01     SETB  ('&OPT(&J)' EQ 'BUF' OR &B01)                            00970000
         AGO   .OPTLOOP                                                 00980000
.OPTDONE AIF   ((&B40+&B20+&B10+&B08+&B04+&B02+&B01) GE &I).OPTOK       00990000
         MNOTE 4,'UNRECOGNIZED OPTION SPECIFIED'                        01000000
.OPTOK   AIF   ('&REGS' EQ 'YES').FGREGS                        GP12336 01010000
         AIF   (N'&REGS NE 2).BGREGS                            GP12336 01020000
         AIF   ('&REGS(1)' NE 'R0' OR '&REGS(1)' NE '0').BGREGS GP12336 01030000
         AIF ('&REGS(2)' NE 'R15' OR '&REGS(2)' NE '15').BGREGS GP12336 01040000
.FGREGS  ANOP  ,                                                GP12336 01050000
&B20     SETB  1                                                GP12336 01060000
.BGREGS  ANOP  ,                                                GP12336 01070000
&I       SETA  N'&SYSLIST                                               01080000
&J       SETA  0                                                        01090000
         AIF   ('&REGS' EQ '' OR '&REGS' EQ 'NO').COUNTER               01100000
         AIF   (&B20).COUNTER                                   GP12336 01110000
&NL      SETA  1                                                        01120000
.COUNTER AIF   (&J GE &I).COUNTED                                       01130000
&J       SETA  &J+1                                                     01140000
         AIF   ('&SYSLIST(&J)' EQ '').COUNTER                           01150000
&NL      SETA  &NL+1                                                    01160000
         AGO   .COUNTER                                                 01170000
.COUNTED ANOP  ,                                                        01180000
&J    SETA  128*&B80+64*&B40+32*&B20+16*&B10+8*&B08+4*&B04+2*&B02+&B01  01190000
         AIF   (N'&MF NE 2).MFONE                               GP11352 01200000
         AIF   ('&MF(1)' NE 'E').MFONE                          GP11352 01210000
&EXEC    SETB  1                                                GP11352 01220000
&NMLST   SETC  '&MF(2)'                                         GP11352 01230000
         AGO   .POINTS                                          GP11352 01240000
.MFONE   AIF   ('&MF' EQ 'A').POINTA                            GP11346 01250000
         AIF   ('&MF' EQ 'S').POINTS                            GP11346 01260000
         AIF   ('&MF' EQ 'L').POINTL                            GP11352 01270000
         MNOTE 4,'MF= NOT RECOGNIZED; MF=A ASSUMED'             GP11346 01280000
.POINTA  ANOP  ,                                                GP11346 01290000
&NM      DC    0H'0',X'B2FF0000',AL4(&NMLST)                    GP11352 01300000
         AGO   .CPOINT                                          GP11346 01310000
.POINTS  ANOP  ,                                                GP11346 01320000
&NM      DC    0H'0',X'B2FF0000,FFFF',SL2(&NMLST)               GP11352 01330000
.CPOINT  AIF   (&EXEC).MEND                                     GP11352 01340000
&TRPSECT RSECT ,                                                GP09301 01350000
         AGO   .POINTCM                                         GP11352 01360000
.POINTL  ANOP  ,                                                GP11352 01370000
&NMLST   SETC  '&NM'                                            GP11352 01380000
.POINTCM ANOP  ,                                                GP11352 01390000
&NMLST   DC    0H'0',AL1(&J,&NL)  TRAP LIST                     GP11352 01400000
         AIF   (NOT &B80).EXPAND                                        01410000
         DC    CL8'&TAG '                                               01420000
.EXPAND  AIF   ('&REGS' EQ '' OR '&REGS' EQ 'NO').NOREGS         95079  01430000
         AIF   (&B20).NOREGS      ALREADY REQUESTED             GP12336 01440000
         AIF   ('&REGS' EQ 'R15' OR '&REGS' EQ 'SHORT'                 *01450000
               OR '&REGS' EQ 'RET').RETREG                      GP97225 01460000
         AIF   ('&REGS' EQ 'YES' OR '&REGS' EQ 'ALL').REGSALL   GP02246 01470000
         AIF   (N'&REGS EQ 2).REGS2                             GP97225 01480000
         DC    AL1(0,128),SL2(&REGS(1),&REGS(1))                GP09301 01490000
         AGO   .NOREGS                                          GP97225 01500000
.REGS2   DC    AL1(0,128),SL2(&REGS(1),&REGS(2))                GP09301 01510000
         AGO   .NOREGS                                          GP97225 01520000
.REGSALL DC    AL1(0,128),SL2(0,15)                             GP09301 01530000
         AGO   .NOREGS                                          GP97225 01540000
.RETREG  DC    SL2(128,14,1)    R15-R1 ONLY                     GP09301 01550000
.NOREGS  ANOP  ,                                                GP09301 01560000
&I       SETA  0                                                GP09301 01570000
&LN      SETA  N'&SYSLIST                                       GP95235 01580000
.DOLIST  AIF   (&I GE &LN).LISTDON  DONE WITH LIST              GP95235 01590000
&I       SETA  &I+1          BUMP LOOP INDEX                    GP95235 01600000
&EN      SETA  K'&EK         GET LENGTH                         GP04234 01610000
&EN      SETA  N'&SYSLIST(&I)                                           01620000
&MACP1   SETC  '&SYSLIST(&I,1)'                                         01630000
&MACP2   SETC  '&SYSLIST(&I,2)'                                         01640000
&MACP3   SETC  '&SYSLIST(&I,3)'                                         01650000
         AIF   (&EN LT 1).DOLIST  USER IN COMA?                 GP95235 01660000
         AIF   (&EN LT 4).TOOLIST WARN                          GP95235 01670000
         MNOTE 4,'MORE THAN 3 SUBPARMS IN &SYSLIST(&I) '        GP95235 01680000
.TOOLIST ANOP  ,                                                GP95235 01690000
&EK      SETC  '&MACP1'                                         GP04234 01700000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01710000
&EO      SETA  0             PRESET FOR NORMAL ADDRESSING MODE          01720000
&ET      SETC  '03'          PRESET FOR HEX DEFAULT             GP95235 01730000
         AIF   (&EM GT 0).TPFX                                  GP04234 01740000
&EK      SETC  '0'           ALLOW EXPANSION WITHOUT ERROR      GP04234 01750000
&EM      SETA  1                                                GP04234 01760000
         MNOTE 4,'TRAP: PARAMETER &I REQUIRES AN ADDRESS'       GP09301 01770000
.TPFX    AIF   (&EM LT 2).NOTA31                                GP04234 01780000
         AIF   ('&EK'(1,1) NE '/').NOTIND                               01790000
&EO      SETA  &EO+1         REQUEST INDIRECT ADDRESSING                01800000
&EK      SETC  '&EK'(2,&EM-1)  DELETE LEADING CONTROL BYTE              01810000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01820000
.NOTIND  AIF   ('&EK'(&EM,1) NE '%').NOTA24                             01830000
&EO      SETA  &EO+2         REQUEST FORCED 24-BIT ADDRESSING           01840000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01850000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01860000
.NOTA24  AIF   ('&EK'(&EM,1) NE '?').NOTA31                             01870000
&EO      SETA  &EO+4         REQUEST FORCED 31-BIT ADDRESSING           01880000
&EK      SETC  '&EK'(1,&EM-1)  DELETE TRAILING CONTROL BYTE             01890000
&EM      SETA  K'&EK         LENGTH OF FIRST OPERAND                    01900000
.NOTA31  AIF   (&EN LT 3 OR '&MACP3' EQ 'HEX').HTYPE            GP95235 01910000
         AIF   ('&MACP3' EQ 'X').HTYPE                          GP97225 01920000
         AIF   ('&MACP3' EQ 'HEX').HTYPE                                01930000
         AIF   ('&MACP3' EQ 'T').TTYPE                          GP98189 01940000
         AIF   ('&MACP3' EQ 'TEXT').TTYPE                       GP95235 01950000
         AIF   ('&MACP3' EQ 'TXT').TTYPE                                01960000
         AIF   ('&MACP3' EQ 'C').CTYPE                          GP97225 01970000
         AIF   ('&MACP3' EQ 'CT').CTYPE                                 01980000
         AIF   ('&MACP3' EQ 'CTEXT').CTYPE                      GP97225 01990000
         AIF   ('&MACP3' EQ 'PACK').PTYPE                       GP97225 02000000
         AIF   ('&MACP3' EQ 'PACKED').PTYPE                     GP97225 02010000
         AIF   ('&MACP3' EQ 'P').PTYPE                          GP97225 02020000
         AIF   ('&MACP3' EQ 'PD').PTYPE                                 02030000
         AIF   ('&MACP3' EQ 'D').PTYPE                          GP97225 02040000
 MNOTE 4,'TYPE MUST BE TEXT, CTEXT, HEX, OR PACKED, NOT &MACP3'         02050000
         AGO   .HTYPE                                           GP95235 02060000
.TTYPE   ANOP  ,                                                GP95235 02070000
&ET      SETC  '01'          SET FOR TEXT                       GP95235 02080000
         AGO   .HTYPE                                           GP95235 02090000
.CTYPE   ANOP  ,                                                GP97225 02100000
&ET      SETC  '02'          SET FOR CONDITIONAL TEXT, ELSE HEX GP97225 02110000
         AGO   .HTYPE                                           GP97225 02120000
.PTYPE   ANOP  ,                                                GP97225 02130000
&ET      SETC  '04'          SET FOR PACKED                     GP97225 02140000
.HTYPE   ANOP  ,                                                GP97225 02150000
&EL      SETC  '&MACP2'                                         GP95235 02160000
         AIF   ('&EL' NE '').HLEN                               GP95235 02170000
&EL      SETC  '&L'.'&EK'                                               02180000
         AGO   .BDLEN                                           GP10160 02190000
.HLEN    AIF   ('&EL'(1,1) NE '(' OR '&EL'(K'&EL,1) NE ')').BDLEN 10160 02200000
         AIF   (K'&EL LT 3).BDLEN                               GP10160 02210000
         AIF   ('&EL'(2,1) EQ '(' OR '&EL'(K'&EL-1,1) EQ ')').BDLEN     02220000
         DC    AL1(&ET,&EO),SL2(&EK),X'80',AL1(&EL),CL8'&MACP1' GP10160 02230000
         AGO   .DOLIST                                          GP95235 02240000
.BDLEN   DC    AL1(&ET,&EO),SL2(&EK,&EL),CL8'&MACP1 '                   02250000
         AGO   .DOLIST                                          GP95235 02260000
.LISTDON ANOP  ,                                                GP09301 02270000
&CURSECT CSECT ,                                                GP09301 02280000
.MEND    MEND  ,                                                        02290000
./ ADD NAME=#TRCCLC
 CLC =C'GERHARD.AMS.SRC',1(R7)   *******DEBUG***********                11790000
 BL TBEF                                                                11800000
 BH TAFT                                                                11810000
 #TRC INIT,RENT=NO,ADCON=YES                                            11820000
 B TBEF                                                                 11830000
TAFT #TRC KILL                                                          11840000
TBEF DS 0H                       *******DEBUG***********                11850000
./ ADD NAME=#TRC
         MACRO ,                                                        00010000
&NM      #TRC  &MODE,&FAST,&ARG,&LOAD=YES,&ADDR=@TRACE,     NEW GP98300*00020000
               &RENT=YES,&PFX=PGT,&DSECT=NO,&ADCON=NO,          GP08157*00030000
               &REGSAVE=                                        GP11243 00040000
         GBLB  &ZZ$TRFG,&ZZ$TDFG                                GP00192 00050000
         GBLB  &ZZ$TRNT                                         GP99364 00060000
         GBLC  &ZZ$TRAD                                                 00070000
         GBLC  &MACPLAB                                         GP99364 00080000
.********************************************************************** 00090000
.*                                                                   ** 00100000
.*   #TRC CONTROLS THE INVOCATION OF THE PROGRAM TRACE ROUTINE;      ** 00110000
.*                                                                   ** 00120000
.*   REQUIRES TRACEIN AND TRACEOUT DD CARDS. SEE PGMTRACE SOURCE.    ** 00130000
.*                                                                   ** 00140000
.********************************************************************** 00150000
         LCLC  &EPNAME,&PTR,&P                                          00160000
         LCLB  &DYN                                                     00170000
         LCLA  &OFF,&I,&RQC                                             00180000
&I       SETA  &SYSNDX                                                  00190000
&DYN     SETB  ('&LOAD' EQ 'YES' OR '&MODE' EQ 'DYN')                   00200000
&PTR     SETC  '&ADDR'                                                  00210000
&MACPLAB SETC  '&NM'                                            GP99364 00220000
&ZZ$TRNT SETB  (&ZZ$TRNT OR ('&RENT' EQ 'YES'))                 GP99364 00230000
&EPNAME  SETC  'TRACEON'                                                00240000
&OFF     SETA  8                                                        00250000
&RQC     SETA  1             TRACE ON FLAG                              00260000
         AIF   ('&MODE' EQ 'DATA').DODATA                       GP00192 00270000
         AIF   ('&REGSAVE' NE 'YES').NOSAVE                     GP11243 00280000
&MACPLAB STM   R14,R1,ZZ&I.V      SAVE USER'S REGISTERS         GP13222 00290000
&MACPLAB SETC  ''                                               GP11243 00300000
.NOSAVE  AIF   (NOT &DYN).HAVBAS                                        00310000
         AIF   ('&ADDR' EQ '').DEFBAS                                   00320000
&ZZ$TRAD SETC  '&ADDR'                                                  00330000
.DEFBAS  ANOP  ,                                                        00340000
&PTR     SETC  '&ZZ$TRAD'                                               00350000
         AIF   ('&PTR' NE '').HAVBAS                                    00360000
&PTR     SETC  '=A(PGMTRACE)'                                           00370000
&ZZ$TRAD SETC  '=A(PGMTRACE)'                                           00380000
.HAVBAS  AIF   (&ZZ$TRFG).LATER                                         00390000
&ZZ$TRFG SETB  1                                                        00400000
         WXTRN TRACE,TRACEON,TRACEOFF,TRACKILL                          00410000
.LATER   AIF   ('&MODE' EQ 'ON' OR '&MODE' EQ 'TRACEON').SPEED          00420000
&RQC     SETA  0             TRACE OFF FLAG                             00430000
&OFF     SETA  12                                                       00440000
&EPNAME  SETC  'TRACEOFF'                                               00450000
         AIF   ('&MODE' EQ 'OFF' OR '&MODE' EQ 'TRACEOFF').SPEED        00460000
&OFF     SETA  4                                                        00470000
&EPNAME  SETC  'TRACKILL'                                               00480000
         AIF   ('&MODE' EQ 'END' OR '&MODE' EQ 'TRACKILL').EXPAND       00490000
         AIF   ('&MODE' EQ 'QUIT' OR '&MODE' EQ 'EXIT').EXPAND          00500000
         AIF   ('&MODE' EQ 'KILL' OR '&MODE' EQ 'DONE').EXPAND          00510000
&OFF     SETA  24                                               \       00520000
&EPNAME  SETC  'TRACSUSP'                                       \       00530000
         AIF   ('&MODE' EQ 'SUS' OR '&MODE' EQ 'TRACSUSP').EXPAND       00540000
         AIF   ('&MODE' EQ 'SUSP' OR '&MODE' EQ 'SUSPEND').EXPAND       00550000
&OFF     SETA  0                                                        00560000
&EPNAME  SETC  'TRACE'                                                  00570000
         AIF   ('&MODE' EQ 'INIT' OR '&MODE' EQ 'TRACE').SPECIAL        00580000
         MNOTE 8,'#TRC - UNRECOGNIZED OPERAND : &MODE'                  00590000
         MEXIT ,                                                        00600000
.SPECIAL AIF   ('&ADCON' NE 'YES').NOADCON                      GP08157 00610000
         AIF   (&ZZ$TRNT).NOADZER                               GP99364 00620000
&MACPLAB B     4+&PTR                                           GP08255 00630000
&PTR     DC    A(0)                                             GP08157 00640000
&MACPLAB SETC  ''                                               GP99364 00650000
         AGO   .NOADCON                                                 00660000
.NOADZER ANOP  ,                                                GP08157 00670000
&MACPLAB B     4+&ZZ$TRAD                                       GP08157 00680000
&ZZ$TRAD DC    V(PGMTRACE)                                      GP08157 00690000
&MACPLAB SETC  ''                                               GP99364 00700000
&DYN     SETB  0             CANCEL DYNAMIC OPTION              GP99364 00710000
.NOADCON AIF   (&ZZ$TRNT).NOMOD                                 GP99364 00720000
&MACPLAB NOP   ZZ&I.B                                                   00730000
&MACPLAB SETC  ''                                               GP99364 00740000
         OI    *-4+1,X'F0'                                              00750000
.NOMOD   AIF   (&DYN).DYNLOAD                                   GP99364 00760000
         MACPARM R1,&FAST,NULL=0  SET API OPTION ADDRESS OR 0           00770000
         ICM   R15,15,&PTR                                              00780000
         BZ    ZZ&I.Z                                                   00790000
         BASR  R14,R15                                                  00800000
&EPNAME  SETC  'TRACEON'                                                00810000
&OFF     SETA  8                                                        00820000
ZZ&I.B   DS    0H                                                       00830000
         AGO   .EXPAND                                                  00840000
.DYNLOAD ANOP  ,                                                GP10164 00850000
&MACPLAB ICM   R15,15,&PTR  LOADED BEFORE?                              00860000
&MACPLAB SETC  ''                                               GP10164 00870000
         BNZ   ZZ&I.A        YES?                                       00880000
         LOAD  EP=PGMTRACE,ERRET=ZZ&I.Z                                 00890000
         LA    R15,&PTR                                                 00900000
         ST    R0,0(,R15)    NON-KOSHER                                 00910000
ZZ&I.A   DS    0H                                                       00920000
         AIF   ('&FAST' EQ 'ON').PRM3ON                                 00930000
         AIF   ('&FAST' NE 'OFF').PRM2                                  00940000
&OFF     SETA  12            INITIALIZE WITHOUT TRACE PRINTING          00950000
&EPNAME  SETC  'TRACEOFF'                                               00960000
         AGO   .PRM3                                                    00970000
.PRM3ON  ANOP  ,             ALREADY SET FOR NORMAL TRACE?              00980000
.PRM3    MACPARM R1,&ARG,NULL=0   SET API OPTION ADDRESS OR 0           00990000
         AGO   .PRM2N3                                                  01000000
.PRM2    MACPARM R1,&FAST,NULL=0  SET API OPTION ADDRESS OR 0           01010000
.PRM2N3  L     R15,&PTR                                                 01020000
         L     R15,&OFF+64(,R15)                                        01030000
         BASR  R14,R15                                                  01040000
         B     ZZ&I.Z                                                   01050000
         AIF   ('&REGSAVE' NE 'YES').NOS14R1                    GP13222 01060000
ZZ&I.V   DC    4A(0)                                            GP13222 01070000
.NOS14R1 AIF   (&OFF NE 0).PRMOFF                                       01080000
&EPNAME  SETC  'TRACEON'                                                01090000
&OFF     SETA  8                                                        01100000
.PRMOFF  ANOP  ,                                                        01110000
ZZ&I.B   DS    0H                                                       01120000
.EXPAND  AIF   (NOT &DYN).EXPANDS                                       01130000
         MACPARM  R15,15,&PTR,OP=ICM,MODE=THREE                 GP02242 01140000
         BZ    ZZ&I.Z                                                   01150000
         L     R15,&OFF+64(,R15)                                        01160000
         BASR  R14,R15                                                  01170000
         AGO   .REGREST                                                 01180000
.EXPANDS ANOP  ,                                                        01190000
         MACPARM  R15,15,=A(&EPNAME),OP=ICM,MODE=THREE          GP02242 01200000
         BZ    ZZ&I.Z                                                   01210000
         BASR  R14,R15                                                  01220000
.REGREST AIF   ('&REGSAVE' NE 'YES').GOAWAY                     GP11243 01230000
ZZ&I.Z   LM    R14,R1,ZZ&I.V                                    GP13222 01240000
         MEXIT ,                                                        01250000
.GOAWAY  ANOP  ,                                                        01260000
ZZ&I.Z   DS    0H                                                       01270000
         MEXIT ,                                                        01280000
.SPEED   AIF   ('&FAST' NE 'FAST').EXPAND                               01290000
         AIF   ('&ARG' EQ '').NOARG                                     01300000
&MACPLAB DC    0H'0',X'83',AL1(X'C0'+&RQC),SL2(&ARG)                    01310000
         MEXIT ,                                                        01320000
.NOARG   ANOP  ,                                                        01330000
&MACPLAB DC    0H'0',X'83',AL1(X'C0'+&RQC),AL2(0)                       01340000
         MEXIT ,                                                GP00192 01350000
.DODATA  ANOP  ,                                                GP00192 01360000
&P       SETC  '&PFX'                                           GP00192 01370000
         AIF   ('&DSECT' EQ 'NO').NODADSC                       GP00192 01380000
         AIF   ('&NM' EQ '').NFDADS                             GP00203 01390000
&MACPLAB DSECT ,             PGMTRADA PARAMETER LIST            GP00203 01400000
         AGO   .NODADS                                          GP00203 01410000
.NFDADS  ANOP  ,                                                GP00203 01420000
&P.SECT  DSECT ,             CALLER'S PARM DSECT                GP00192 01430000
         AGO   .NODADS                                          GP00203 01440000
.NODADSC AIF   ('&NM' EQ '').NODADS                             GP00203 01450000
&MACPLAB DS    0D            PGMTRADA PARAMETER LIST            GP00203 01460000
.NODADS  ANOP  ,                                                GP00192 01470000
&P.FUN   DS    X             FUNCTION (L - LOOK-UP; M-MEMBER BUILD)     01480000
         AIF   (&ZZ$TDFG).HAVEMAP                               GP00192 01490000
CFLOOK   EQU   C'L'            LOCATE MEMBER/OFFSET - PRINT DATA        01500000
CFPOINT  EQU   C'M'            LOCATE MEMBER; BUILD SOURCE CHAIN        01510000
CFCLOSE  EQU   C'C'            CLOSE AND FREE EVERYTHING        GP00192 01520000
.HAVEMAP ANOP  ,                                                GP00192 01530000
&P.FLG1  DC    AL1(0)        PRINT OPTIONS                      GP00192 01540000
         AIF   (&ZZ$TDFG).HAVEFG1                               GP00192 01550000
CFDIR    EQU   X'80'           PRINT DIRECTORY ENTRY DATA       GP00192 01560000
CFESD    EQU   X'40'           PRINT CESD LISTING               GP00192 01570000
CFRLD    EQU   X'20'           PRINT RLD LISTING                GP00192 01580000
CFSYM    EQU   X'10'           PRINT SYM LISTING                GP00192 01590000
CFDAT    EQU   X'08'           PRINT SYSADATA INFO (LATER)      GP00192 01600000
CFLBL    EQU   X'02'           PRINT LABELS                     GP00192 01610000
CFTRC    EQU   X'01'           PRINT THE TRACE TABLE ON ABNORMAL END    01620000
.HAVEFG1 ANOP  ,                                                GP00192 01630000
&P.FLG2  DC    AL1(0)        PRINT OPTIONS                      GP00192 01640000
         AIF   (&ZZ$TDFG).HAVEFG2                               GP00192 01650000
CFHEX    EQU   X'80'           PRINT THE CSECT HEX DUMP         GP00192 01660000
CFLST    EQU   X'40'           PRINT THE ASSEMBLY LISTING       GP00192 01670000
CFXRF    EQU   X'20'           PRINT A LABEL CROSS-REFERENCE    GP00192 01680000
CFPUN    EQU   X'10'           PUNCH OUTPUT (?)                 GP00192 01690000
CFBUG    EQU   X'01'           PRINT ADDITIONAL DEBUG INFO      GP00192 01700000
.HAVEFG2 ANOP  ,                                                GP00192 01710000
&P.FLG3  DC    X'00'         PROCESSING FLAG                    GP00192 01720000
         AIF   (&ZZ$TDFG).HAVEFG3                               GP00192 01730000
CFMAC    EQU   X'80'           INCLUDE MACRO EXPANDED CODE (SYSADATA)   01740000
CFIMAC   EQU   X'40'           INCLUDE INLINE MACRO CODE   (SYSADATA)   01750000
CFCMT    EQU   X'20'           INCLUDE COMMENTS            (SYSADATA)   01760000
CFASM    EQU   X'10'           INCLUDE ASSEMBLER PSEUDO-OPS(SYSADATA)   01770000
&ZZ$TDFG SETB  1                                                GP00192 01780000
.HAVEFG3 ANOP  ,                                                GP00192 01790000
&P.MEM   DC    CL8' '        MEMBER NAME                        GP00192 01800000
&P.ESD   DC    CL8' '        CSECT NAME (NOT USED AT PRESENT)   GP00192 01810000
&P.OFF   DC    AL4(0)        OFFSET FROM LOAD POINT             GP00192 01820000
&P.WORK  DC    A(0)          WORK AREA (BUILT/FREED HERE)       GP00192 01830000
&P.@PRT  DC    A(0)          CALLER'S PRINT ROUTINE (R1 - BUFFER)       01840000
.MEND    MEND  ,                                                        01850000
./ ADD NAME=TRENT
         MACRO ,                                                        00010000
&NM      TRENT &TAB,&VAL,&OFF,&FILL=                    ADDED ON 86311  00020000
.*                                                                      00030000
.*   This macro is used to create translate and translate and test      00040000
.*     tables in compact fashion.                                       00050000
.*                                                                      00060000
.*   The table may be built by (separate) DC statements, or by          00070000
.*     a TRENT entry with a FILL= operand and a name field.     GP12005 00080000
.*                                                                      00090000
.*   Any name field is attached to first expanded DC, if any            00100000
.*     First positional is name of table to be modified; may be         00110000
.*       null after first occurrence and after a FILL                   00120000
.*     Second positional is value to be placed in table; may be         00130000
.*       null after first occurrence. May be expression.                00140000
.*     Subsequent values are offsets in self-defining form, i.e.,       00150000
.*       X'nn', C'x', integer, equate value, or absolute expression.    00160000
.*     A sublist may be used, offset in first value, repeat count       00170000
.*       in second.                                                     00180000
.*     When the last parm is null, no final ' ORG ' is created.         00190000
.*       (requested by trailing comma)                                  00200000
.*     When no parameters are supplied, a final ' ORG ' is expanded.    00210000
.*                                                                      00220000
.*       ex.:  upper case translate:                                    00230000
.*       UPTAB DC    256AL1(*-UPTAB)     or                             00240000
.*       UPTAB TRENT FILL=(*-UPTAB)                                     00250000
.*             TRENT UPTAB,*-UPTAB+X'40',(X'81',9),(X'91',9),(X'A2,8)   00260000
.*                                                                      00270000
         GBLC  &ZZ@TAB,&ZZ@VAL                                          00280000
         LCLC  &N                                                       00290000
         LCLA  &I,&J                                                    00300000
&J       SETA  N'&SYSLIST                                               00310000
&N       SETC  '&NM'                                                    00320000
         AIF   (T'&FILL EQ 'O').DATA                            GP12005 00330000
         AIF   ('&N' NE '').BUILD                               GP12005 00340000
         MNOTE 8,'TRENT WITH FILL= REQUIRES A LABEL'            GP12005 00350000
         MEXIT ,                                                GP12005 00360000
.*   BUILD TRANSLATE OR TRT TABLE                               GP12005 00370000
.*                                                              GP12005 00380000
.BUILD   ANOP  ,                                                GP12005 00390000
&N       DC    256AL1(&FILL)                                    GP12005 00400000
&ZZ@TAB  SETC  '&N'                                             GP12005 00410000
&N       SETC  ''                                               GP12005 00420000
         AIF   (&J EQ 0).MEND                                   GP12005 00430000
.*   EXPAND TABLE MODIFICATIONS                                         00440000
.*                                                                      00450000
.DATA    AIF   (&J EQ 0).ORG                                            00460000
         AIF   ('&TAB' EQ '').NOTAB                                     00470000
&ZZ@TAB  SETC  '&TAB'                                                   00480000
.NOTAB   AIF   ('&VAL' EQ '').NOVAL                                     00490000
&ZZ@VAL  SETC  '&VAL'                                                   00500000
.NOVAL   AIF   (&J LT 3).MEND                                           00510000
&I       SETA  2                                                        00520000
.LOOP    AIF   (&I GE &J).DONE                                          00530000
&I       SETA  &I+1                                                     00540000
         AIF   ('&SYSLIST(&I)' EQ '').LOOP                              00550000
         AIF   (N'&SYSLIST(&I) EQ 2).PAIR                               00560000
         ORG   &ZZ@TAB+&SYSLIST(&I)                                     00570000
&N       DC    AL1(&ZZ@VAL)                                             00580000
&N       SETC  ''                                                       00590000
         AGO   .LOOP                                                    00600000
.PAIR    ORG   &ZZ@TAB+&SYSLIST(&I,1)                                   00610000
&N       DC    (&SYSLIST(&I,2))AL1(&ZZ@VAL)                             00620000
&N       SETC  ''                                                       00630000
         AGO   .LOOP                                                    00640000
.DONE    AIF   ('&SYSLIST(&J)' EQ '').MEND                              00650000
.ORG     ORG   ,                                                        00660000
.MEND    MEND  ,                                                        00670000
./ ADD NAME=TRINV
        MACRO                                                           00010000
&LABEL  TRINV  ,                                                        00020000
.* Construct reverse bits translate table                               00030000
.* Contributed by Kenneth Wilkerson on IBM-MAIN as REVTABLE             00040000
         LCLA  &I,&J,&K,&L,&M,&N,&O                                     00050000
         LCLC  &X                                                       00060000
&LABEL   DS    0D            LIKE EM DOUBLE WORD ALIGNED                00070000
&I       SETA  0             STARTING VALUE                             00080000
.TABLOOP ANOP  ,             LOOP UNTIL TABLE IS DONE                   00090000
&K       SETA  1             NEED SIXTEEN ENTRIES PER LINE              00100000
&X       SETC  'AL1('                                                   00110000
         AGO   .X16LP                                                   00120000
.X16NXT  ANOP  ,                                                        00130000
&X       SETC  '&X'.'&J'.','                                            00140000
.X16LP   ANOP  ,             16 ENTRY LOOP                              00150000
&J       SETA  0             STARTING RESULT                            00160000
&L       SETA  1             STARTING ADDEND                            00170000
&M       SETA  1             8 BITS PER BYTE                            00180000
&N       SETA  128           STARTING COMPARAND X'80'                   00190000
&O       SETA  &I            COPY CURRENT BYTE TO REVERSE               00200000
.BYTELP  ANOP  ,                                                        00210000
         AIF   (&O LT &N).BYTEFT     LESS THAN CURRENT - 0              00220000
&O       SETA  &O-&N                                                    00230000
&J       SETA  &J+&L                                                    00240000
.BYTEFT  ANOP  ,                                                        00250000
&L       SETA  &L*2          NEXT ADDEND                                00260000
&N       SETA  &N/2          NEXT COMPARAND                             00270000
&M       SETA  &M+1          NEED EIGHT BITS                            00280000
         AIF   (&M LE 8).BYTELP                                         00290000
&I       SETA  &I+1                                                     00300000
&K       SETA  &K+1                                                     00310000
         AIF   (&K LE 16).X16NXT                                        00320000
&X       SETC  '&X'.'&J'.')'                                            00330000
      DC &X                                                             00340000
         AIF   (&I LT 256).TABLOOP                                      00350000
         MEND  ,                                                        00360000
./ ADD NAME=TRTAB
         MACRO                                                          00010000
&NM      TRTAB &FILL=C'.',&CODE=,&OPT=,&TYPE=                    90241  00020000
         GBLC  &CRT                                                     00030000
         LCLC  &N                                                       00040000
         LCLA  &I,&J                                                    00050000
         LCLB  &C60,&C70,&C78,&PN,&TN,&FOLD,&ERR,&UP,&LOW,&TRT   86244  00060000
         LCLA  &LEN(30),&DISP(30),&ADD(30)                      GP08131 00070000
.********************************************************************** 00080000
.*                                                                    * 00090000
.*  TRTAB PRODUCES DIFFERENT FLAVORS OF TRANSLATE, AND TRANSLATE AND  * 00100000
.*  TEST TABLES.                                                      * 00110000
.*                                                                    * 00120000
.********************************************************************** 00130000
.*                                                                    * 00140000
.*  TYPE= EXPANDS A PREDEFINED CONVERSION: ATOE ETOA 7-BIT            * 00150000
.*                                         ITOE ETOI 8-BIT            * 00160000
.*                                         UPPER  LOWER               * 00170000
.*                                                                    * 00180000
.********************************************************************** 00190000
.*                                                                    * 00200000
.*  CODE= EXPANDS 3178 OR PRINT CONVERSION.                           * 00210000
.*    DEFINED ARE 2260, 3270 (3178), PN, AND TN                       * 00220000
.*                                                                    * 00230000
.*    THE TABLE MAY BE QUALIFIED WITH OPT=                            * 00240000
.*      OPT=3278  ADDS LEFT AND RIGHT BRACE, DEGREE, REVERSE SLASH    * 00250000
.*      OPT=LOW   ADDS LOWER CASE TO PN AND 2260                      * 00260000
.*      OPT=FOLD  ADDS LOWER CASE AS UPPER CASE                       * 00270000
.*      OPT=UP    ADDS LOWER CASE AS UPPER CASE                       * 00280000
.*      OPT=ERR   ADDS THE 2260 ERROR SYMBOL (X'7F')                  * 00290000
.*                                                                    * 00300000
.*    FILL=C'.' OR FILL=X'6A' SPECIFIES THE CHARACTER TO BE USED FOR  * 00310000
.*      AND UNPRINTABLE.                                              * 00320000
.*                                                                    * 00330000
.********************************************************************** 00340000
.*                                                                    * 00350000
.*    FILL=X'FF' IN COMBINATION WITH ANY CODE= AND OPT=               * 00360000
.*      CREATES A TRANSLATE AND TEST TABLE (VALID CHARACTERS ARE      * 00370000
.*      ZERO; INVALID ARE THE FILL CHARACTER.                         * 00380000
.*                                                                    * 00390000
.********************************************************************** 00400000
&DISP(1) SETA  75            .                                          00410000
&LEN(1)  SETA  6             . TO &                                     00420000
&DISP(2) SETA  91            $                                          00430000
&LEN(2)  SETA  7             $ TO /                                     00440000
&DISP(3) SETA  107           ,                                          00450000
&LEN(3)  SETA  5             , TO ?                                     00460000
&DISP(4) SETA  122           :                                          00470000
&LEN(4)  SETA  5             : TO =                                     00480000
&DISP(10) SETA 193           A-I                                        00490000
&LEN(10) SETA  9             A                                          00500000
&LEN(11) SETA  9             J                                          00510000
&DISP(11) SETA 209           J-R                                        00520000
&DISP(12) SETA 226           S-Z                                        00530000
&LEN(12) SETA  8             S                                          00540000
&DISP(13) SETA 240           0-9                                        00550000
&LEN(13) SETA  10            0                                          00560000
&TRT     SETB  ('&FILL' EQ 'X''FF''')  INVERSE TABLE                    00570000
&N       SETC  '&NM'                                                    00580000
         AIF   ('&N' NE '').OK                                          00590000
&N       SETC  'TRTA'.'&SYSNDX'                                         00600000
.OK      AIF   ('&TYPE' EQ '').PIZMEAL                           90241  00610000
         AIF   ('&TYPE' NE 'ATOE').NOTATOE                       90241  00620000
         SPACE 1                                                 90241  00630000
*        TRANSLATE TABLES LIFTED FROM SVC 103 (PTF 77533 LEVEL)  90241  00640000
*        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F          91312  00650000
&N DC X'00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F'  0X     90241  00660000
   DC X'10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F'  1X     90241  00670000
   DC X'40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61'  2X     90241  00680000
   DC X'F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F'  3X     90241  00690000
   DC X'7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6'  4X     90241  00700000
   DC X'D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D'  5X     90241  00710000
   DC X'79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96'  6X     90241  00720000
   DC X'97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07'  7X     90241  00730000
         AIF   ('&OPT' EQ 'SHORT').MEND                          90241  00740000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  8X     90241  00750000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  9X     90241  00760000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  AX     90241  00770000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  BX     90241  00780000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  CX     90241  00790000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  DX     90241  00800000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  EX     90241  00810000
   DC X'3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F,3F'  FX     90241  00820000
         MEXIT ,                                                 90241  00830000
.NOTATOE AIF   ('&TYPE' NE 'ETOA').NOTETOA                       90241  00840000
         SPACE 1                                                 90241  00850000
*        TRANSLATE TABLES LIFTED FROM SVC 103 (PTF 77533 LEVEL)  90241  00860000
*        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F          91312  00870000
&N DC X'00,01,02,03,1A,09,1A,7F,1A,1A,1A,0B,0C,0D,0E,0F'  0X     90241  00880000
   DC X'10,11,12,13,1A,1A,08,1A,18,19,1A,1A,1C,1D,1E,1F'  1X     90241  00890000
   DC X'1A,1A,1A,1A,1A,0A,17,1B,1A,1A,1A,1A,1A,05,06,07'  2X     90241  00900000
   DC X'1A,1A,16,1A,1A,1A,1A,04,1A,1A,1A,1A,14,15,1A,1A'  3X     90241  00910000
   DC X'20,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,2E,3C,28,2B,21'  4X     90241  00920000
   DC X'26,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,24,2A,29,3B,5E'  5X     90241  00930000
   DC X'2D,2F,1A,1A,1A,1A,1A,1A,1A,1A,7C,2C,25,5F,3E,3F'  6X     90241  00940000
   DC X'1A,1A,1A,1A,1A,1A,1A,1A,1A,60,3A,23,40,27,3D,22'  7X     90241  00950000
   DC X'1A,61,62,63,64,65,66,67,68,69,1A,1A,1A,1A,1A,1A'  8X     90241  00960000
   DC X'1A,6A,6B,6C,6D,6E,6F,70,71,72,1A,1A,1A,1A,1A,1A'  9X     90241  00970000
   DC X'1A,7E,73,74,75,76,77,78,79,7A,1A,1A,1A,1A,1A,1A'  AX     90241  00980000
   DC X'1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A,1A'  BX     90241  00990000
   DC X'7B,41,42,43,44,45,46,47,48,49,1A,1A,1A,1A,1A,1A'  CX     90241  01000000
   DC X'7D,4A,4B,4C,4D,4E,4F,50,51,52,1A,1A,1A,1A,1A,1A'  DX     90241  01010000
   DC X'5C,1A,53,54,55,56,57,58,59,5A,1A,1A,1A,1A,1A,1A'  EX     90241  01020000
   DC X'30,31,32,33,34,35,36,37,38,39,1A,1A,1A,1A,1A,1A'  FX     90241  01030000
         MEXIT ,                                                 90241  01040000
.NOTETOA AIF   ('&TYPE' NE 'ITOE').NOTITOE                       90241  01050000
         SPACE 1                                                 90241  01060000
*        TRANSLATE TABLES FROM APPENDIX E, GC26-4003-2           90241  01070000
*        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F          91312  01080000
&N DC X'00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F'  0X     90241  01090000
   DC X'10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F'  1X     90241  01100000
   DC X'40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61'  2X     90241  01110000
   DC X'F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F'  3X     90241  01120000
   DC X'7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6'  4X     90241  01130000
   DC X'D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D'  5X     90241  01140000
   DC X'79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96'  6X     90241  01150000
   DC X'97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07'  7X     90241  01160000
   DC X'20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B'  8X     90241  01170000
   DC X'30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1'  9X     90241  01180000
   DC X'41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57'  AX     90241  01190000
   DC X'58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75'  BX     90241  01200000
   DC X'76,77,78,80,8A,8B,8C,8D,8E,8F,90,9A,9B,9C,9D,9E'  CX     90241  01210000
   DC X'9F,A0,AA,AB,AC,AD,AE,AF,B0,B1,B2,B3,B4,B5,B6,B7'  DX     90241  01220000
   DC X'B8,B9,BA,BB,BC,BD,BE,BF,CA,CB,CC,CD,CE,CF,DA,DB'  EX     90241  01230000
   DC X'DC,DD,DE,DF,EA,EB,EC,ED,EE,EF,FA,FB,FC,FD,FE,FF'  FX     90241  01240000
         MEXIT ,                                                 90241  01250000
.NOTITOE AIF   ('&TYPE' NE 'ETOI').NOTETOI                       90241  01260000
         SPACE 1                                                 90241  01270000
*        TRANSLATE TABLES FROM APPENDIX E, GC26-4003-2           90241  01280000
*        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F          91312  01290000
&N DC X'00,01,02,03,9C,09,86,7F,97,8D,8E,0B,0C,0D,0E,0F'  0X     90241  01300000
   DC X'10,11,12,13,9D,85,08,87,18,19,92,8F,1C,1D,1E,1F'  1X     90241  01310000
   DC X'80,81,82,83,84,0A,17,1B,88,89,8A,8B,8C,05,06,07'  2X     90241  01320000
   DC X'90,91,16,93,94,95,96,04,98,99,9A,9B,14,15,9E,1A'  3X     90241  01330000
   DC X'20,A0,A1,A2,A3,A4,A5,A6,A7,A8,5B,2E,3C,28,2B,21'  4X     90241  01340000
   DC X'26,A9,AA,AB,AC,AD,AE,AF,B0,B1,5D,24,2A,29,3B,5E'  5X     90241  01350000
   DC X'2D,2F,B2,B3,B4,B5,B6,B7,B8,B9,7C,2C,25,5F,3E,3F'  6X     90241  01360000
   DC X'BA,BB,BC,BD,BE,BF,C0,C1,C2,60,3A,23,40,27,3D,22'  7X     90241  01370000
   DC X'C3,61,62,63,64,65,66,67,68,69,C4,C5,C6,C7,C8,C9'  8X     90241  01380000
   DC X'CA,6A,6B,6C,6D,6E,6F,70,71,72,CB,CC,CD,CE,CF,D0'  9X     90241  01390000
   DC X'D1,7E,73,74,75,76,77,78,79,7A,D2,D3,D4,D5,D6,D7'  AX     90241  01400000
   DC X'D8,D9,DA,DB,DC,DD,DE,DF,E0,E1,E2,E3,E4,E5,E6,E7'  BX     90241  01410000
   DC X'7B,41,42,43,44,45,46,47,48,49,E8,E9,EA,EB,EC,ED'  CX     90241  01420000
   DC X'7D,4A,4B,4C,4D,4E,4F,50,51,52,EE,EF,F0,F1,F2,F3'  DX     90241  01430000
   DC X'5C,9F,53,54,55,56,57,58,59,5A,F4,F5,F6,F7,F8,F9'  EX     90241  01440000
   DC X'30,31,32,33,34,35,36,37,38,39,FA,FB,FC,FD,FE,FF'  FX     90241  01450000
         MEXIT ,                                                 90241  01460000
.NOTETOI AIF   ('&TYPE' NE 'UPPER').NOTUPP                      GP13007 01470000
*        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F         GP13007 01480000
&N DC X'00,01,02,03,04,05,06,07,08,09,0A,0B,0C,0D,0E,0F'  0X    GP13007 01490000
   DC X'10,11,12,13,14,15,16,17,18,19,1A,1B,1C,1D,1E,1F'  1X    GP13007 01500000
   DC X'20,21,22,23,24,25,26,27,28,29,2A,2B,2C,2D,2E,2F'  2X    GP13007 01510000
   DC X'30,31,32,33,34,35,36,37,38,39,3A,3B,3C,3D,3E,3F'  3X    GP13007 01520000
   DC X'40,41,42,43,44,45,46,47,48,49,4A,4B,4C,4D,4E,4F'  4X    GP13007 01530000
   DC X'50,51,52,53,54,55,56,57,58,59,5A,5B,5C,5D,5E,5F'  5X    GP13007 01540000
   DC X'60,61,62,63,64,65,66,67,68,69,6A,6B,6C,6D,6E,6F'  6X    GP13007 01550000
   DC X'70,71,72,73,74,75,76,77,78,79,7A,7B,7C,7D,7E,7F'  7X    GP13007 01560000
   DC X'80,C1,C2,C3,C4,C5,C6,C7,C8,C9,8A,8B,8C,8D,8E,8F'  8X    GP13007 01570000
   DC X'90,D1,D2,D3,D4,D5,D6,D7,D8,D9,9A,9B,9C,9D,9E,9F'  9X    GP13007 01580000
   DC X'A0,E1,E2,E3,E4,E5,E6,E7,E8,A9,AA,AB,AC,AD,AE,AF'  AX    GP13007 01590000
   DC X'B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,BA,BB,BC,BD,BE,BF'  BX    GP13007 01600000
   DC X'C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,CA,CB,CC,CD,CE,CF'  CX    GP13007 01610000
   DC X'D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,DA,DB,DC,DD,DE,DF'  DX    GP13007 01620000
   DC X'E0,E1,E2,E3,E4,E5,E6,E7,E8,E9,EA,EB,EC,ED,EE,EF'  EX    GP13007 01630000
   DC X'F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,FA,FB,FC,FD,FE,FF'  FX    GP13007 01640000
.NOTUPP  AIF   ('&TYPE' NE 'LOWER').NOTCASE                     GP13007 01650000
*        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F         GP13007 01660000
&N DC X'00,01,02,03,04,05,06,07,08,09,0A,0B,0C,0D,0E,0F'  0X    GP13007 01670000
   DC X'10,11,12,13,14,15,16,17,18,19,1A,1B,1C,1D,1E,1F'  1X    GP13007 01680000
   DC X'20,21,22,23,24,25,26,27,28,29,2A,2B,2C,2D,2E,2F'  2X    GP13007 01690000
   DC X'30,31,32,33,34,35,36,37,38,39,3A,3B,3C,3D,3E,3F'  3X    GP13007 01700000
   DC X'40,41,42,43,44,45,46,47,48,49,4A,4B,4C,4D,4E,4F'  4X    GP13007 01710000
   DC X'50,51,52,53,54,55,56,57,58,59,5A,5B,5C,5D,5E,5F'  5X    GP13007 01720000
   DC X'60,61,62,63,64,65,66,67,68,69,6A,6B,6C,6D,6E,6F'  6X    GP13007 01730000
   DC X'70,71,72,73,74,75,76,77,78,79,7A,7B,7C,7D,7E,7F'  7X    GP13007 01740000
   DC X'80,81,82,83,84,85,86,87,88,89,8A,8B,8C,8D,8E,8F'  8X    GP13007 01750000
   DC X'90,91,92,93,94,95,96,97,98,99,9A,9B,9C,9D,9E,9F'  9X    GP13007 01760000
   DC X'A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF'  AX    GP13007 01770000
   DC X'B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,BA,BB,BC,BD,BE,BF'  BX    GP13007 01780000
   DC X'C0,81,82,83,84,85,86,87,88,89,CA,CB,CC,CD,CE,CF'  CX    GP13007 01790000
   DC X'D0,91,92,93,94,95,96,97,98,99,DA,DB,DC,DD,DE,DF'  DX    GP13007 01800000
   DC X'E0,A1,A2,A3,A4,A5,A6,A7,A8,E9,EA,EB,EC,ED,EE,EF'  EX    GP13007 01810000
   DC X'F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,FA,FB,FC,FD,FE,FF'  FX    GP13007 01820000
.NOTCASE MNOTE 8,'INVALID TYPE=&TYPE'                           GP13007 01830000
         MNOTE 8,'  ONLY ATOE, ETOA, ITOE, ETOI, UPPER, LOWER VALID'    01840000
         MEXIT ,                                                 90241  01850000
.PIZMEAL ANOP  ,                                                 90241  01860000
&N       DC    256&FILL .      FILLER CODE                              01870000
         ORG   &N+C' '                                                  01880000
         AIF   (&TRT).BLKOK                                             01890000
         DC    C' ' .        BLANK                                      01900000
         AGO   .BLKCM                                                   01910000
.BLKOK   DC    X'00'         BLANK                                      01920000
.BLKCM   AIF   ('&CODE' NE '').GOTCODE                                  01930000
&C60     SETB  ('&CRT' EQ '2260' OR '&CRT' EQ '2265')                   01940000
&C70     SETB  ('&CRT' EQ '3270')                                       01950000
.GOTCODE ANOP  ,                                                        01960000
&C60     SETB  ('&CODE' EQ '2260' OR '&CODE' EQ '2265' OR &C60)         01970000
&C70     SETB  ('&CODE' EQ '3270' OR &C70)                              01980000
&PN      SETB  ('&CODE' EQ 'PN' OR '&CODE' EQ 'P11')            GP04040 01990000
&TN      SETB  ('&CODE' EQ 'TN' OR '&CODE' EQ 'T11')            GP04040 02000000
         AIF   (&C60 OR &C70 OR &PN OR &TN).OKCODE                      02010000
         MNOTE 8,'CODE=''&CODE'' NOT SUPPORTED'                         02020000
         MEXIT ,                                                        02030000
.OKCODE  ANOP  ,                                                        02040000
&I       SETA  N'&OPT                                                   02050000
         AIF   (&I LT 1).NOPT                                           02060000
&J       SETA  1                                                        02070000
.OPTLOOP AIF   ('&OPT(&J)' EQ 'FOLD').FOLD                              02080000
         AIF   ('&OPT(&J)' EQ 'SVC').SVC                                02090000
         AIF   ('&OPT(&J)' EQ 'ERR').ERR                                02100000
         AIF   ('&OPT(&J)' EQ 'UP').UPR                                 02110000
         AIF   ('&OPT(&J)' EQ 'LOW').LOW                                02120000
         AIF   ('&OPT(&J)' EQ '3278').SET78                      86244  02130000
         AIF   ('&OPT(&J)' EQ '').OPTINC                                02140000
.BADOPT  MNOTE 8,'OPT=''&OPT(&J)'' NOT SUPPORTED'                       02150000
.OPTINC  AIF   (&J GE &I).NOPT                                          02160000
&J       SETA  &J+1                                                     02170000
         AGO   .OPTLOOP                                                 02180000
.FOLD    AIF   (&UP).BADOPT                                             02190000
&FOLD    SETB  1                                                 86244  02200000
         AGO   .OPTINC                                                  02210000
.SVC     ORG   &N+X'C0'                                                 02220000
         AIF   (&TRT).SVCOK                                             02230000
         DC    C'+' .        DISPLAY X'C0' IN SVC NAME AS PLUS SIGN     02240000
         AGO   .SVCCM                                                   02250000
.SVCOK   DC    X'00'         BLANK                                      02260000
.SVCCM   AGO   .OPTINC                                                  02270000
.ERR     ANOP  ,                                                        02280000
&ERR     SETB  (&C60)                                                   02290000
         AGO   .OPTINC                                                  02300000
.UPR     AIF   (&FOLD OR &LOW).BADOPT                                   02310000
&UP      SETB  1                                                        02320000
         AGO   .OPTINC                                                  02330000
.LOW     AIF   (&UP).BADOPT                                             02340000
&LOW     SETB  1                                                        02350000
         AGO   .OPTINC                                                  02360000
.SET78   AIF   (NOT &C70 AND NOT &TN).BADOPT                    GP04040 02370000
&C78     SETB  1                                                 86244  02380000
         AGO   .OPTINC                                           86244  02390000
.NOPT    ANOP  ,                                                        02400000
&LOW     SETB  (&LOW OR &FOLD OR &TN OR &C70)                           02410000
&ERR     SETB  (&ERR OR &TN OR &PN OR &C70)                             02420000
         AIF   (&C60 OR &PN).NOCENT                                     02430000
&DISP(1) SETA  74            ADD CENT SIGN                              02440000
&LEN(1)  SETA  7                                                        02450000
&DISP(2) SETA  90            ADD EXC. MARK                              02460000
&LEN(2)  SETA  8                                                        02470000
         AIF   (NOT &C70 AND NOT &TN).NOCENT                    GP08145 02480000
&DISP(3) SETA  106           ADD SPLIT BAR                       86244  02490000
&LEN(3)  SETA  6                                                 86244  02500000
         AIF   (NOT &C78 AND NOT &TN).NOCENT                    GP08145 02510000
&DISP(10) SETA 192           LEFT BRACE                          86244  02520000
&LEN(10)  SETA 10                                                86244  02530000
&DISP(11) SETA 208           RIGHT BRACE                         86244  02540000
&LEN(11)  SETA 10                                                86244  02550000
&DISP(18) SETA 121           REVERSE QUOTE                       86244  02560000
&LEN(18)  SETA 1                                                 86244  02570000
&DISP(19) SETA 161           TILDE                               86244  02580000
&LEN(19)  SETA 1                                                 86244  02590000
&DISP(20) SETA 224           REVERSE SLASH                       86244  02600000
&LEN(20)  SETA 1                                                 86244  02610000
&DISP(21) SETA 186           LEFT/RIGHT BRACKET                 GP08114 02620000
&LEN(21)  SETA 2                                                 86244  02630000
.NOCENT  AIF   (&C60 AND NOT &ERR).NOERR                                02640000
&LEN(4)  SETA  6             ADD QUOTE                                  02650000
.NOERR   AIF   (&UP OR NOT &LOW).NOLC                                   02660000
&DISP(5) SETA  129                                                      02670000
&LEN(5)  SETA  9                                                        02680000
&DISP(6) SETA  145                                                      02690000
&LEN(6)  SETA  9                                                        02700000
&DISP(7) SETA  162                                                      02710000
&LEN(7)  SETA  8                                                        02720000
         AIF   (NOT &TN OR &FOLD).NONUM                         GP13007 02730000
&DISP(8) SETA  176                                                      02740000
&LEN(8)  SETA  10                                                       02750000
         AIF   (&TN).NONUM                                              02760000
&ADD(8)  SETA  64                                                       02770000
.NONUM   AIF   (NOT &FOLD).NOLC                                  86244  02780000
&ADD(5)  SETA  64                                                       02790000
&ADD(6)  SETA  64                                                       02800000
&ADD(7)  SETA  64                                                       02810000
.NOLC    AIF   (NOT &TN).NOGRA                                          02820000
&LEN(13) SETA  11            ADD PLOTTING BAR TO 0-9            GP08145 02830000
&DISP(14) SETA 139           TN GRAPHICS                                02840000
&LEN(14) SETA  5                                                        02850000
&DISP(15) SETA 155                                                      02860000
&LEN(15) SETA  7                                                        02870000
&DISP(16) SETA 171                                                      02880000
&LEN(16) SETA  6                                                GP08145 02890000
&DISP(17) SETA 186           LEFT BRACKET                       GP08114 02900000
&LEN(17) SETA  6                                                        02910000
.NOGRA   ANOP  ,                                                        02920000
&I       SETA  1                                                        02930000
.NEXT    AIF   (&LEN(&I) LT 1).DCL                                      02940000
         ORG   &N+&DISP(&I)                                             02950000
         AIF   (&TRT).LSTOK                                             02960000
         DC    &LEN(&I)AL1(*-&N+&ADD(&I))                               02970000
         AGO   .DCL                                                     02980000
.LSTOK   DC    &LEN(&I)X'00'                                            02990000
.DCL     AIF   (&I GE 20).ORG                                    86244  03000000
&I       SETA  &I+1                                                     03010000
         AGO   .NEXT                                                    03020000
.ORG     ORG   &N+256 ,                                                 03030000
.MEND    MEND  ,                                                 90241  03040000
./ ADD NAME=TRTSMF
         MACRO ,                                                 90068  00010000
&NM      TRTSMF ,                                                90068  00020000
*        COMMON TRT TABLE FOR SMF RECORD PROCESSING.             90068  00030000
*        USED BY SMFMERGE AND SMFSELCT.                          90068  00040000
         SPACE 1                                                 90068  00050000
Z        EQU   16            SKIP THIS RECORD                    84171  00060000
G        EQU   12            SPECIAL JOB HEADER - TYPE 32        84171  00070000
F        EQU   8             SPECIAL JOB HEADER - TYPE 30        84171  00080000
J        EQU   4             PROCESS JOB-HEADER                  83327  00090000
C        EQU   0             COPY AS IS (NOT JOB RELATED)        83327  00100000
         SPACE 1                                                 83327  00110000
*                  0 1 2 3 4 5 6 7 8 9 A B C D E F               83327  00120000
&NM      DC    AL1(C,C,C,C,J,J,J,C,C,C,J,C,C,C,J,J)   0X         84171  00130000
         DC    AL1(C,J,J,C,J,C,C,C,C,J,J,C,C,C,F,C)   1X         83327  00140000
         DC    AL1(G,C,J,J,C,C,C,C,J,C,C,C,C,C,C,C)   2X         83327  00150000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,J,J)   3X         83327  00160000
         DC    AL1(J,C,C,J,J,J,C,C,C,C,C,C,C,C,C,C)   4X         83327  00170000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   5X         83327  00180000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   6X         83327  00190000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   7X         83327  00200000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   8X         83327  00210000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   9X         83327  00220000
         DC    AL1(C,C,C,C,C,C,J,C,C,C,C,C,C,C,C,C)   AX         83327  00230000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   BX         83327  00240000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   CX         83327  00250000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   DX         83327  00260000
         DC    AL1(C,C,C,C,C,C,C,C,C,C,C,C,C,C,C,C)   EX         83327  00270000
         DC    AL1(C,C,C,C,C,C,C,C,C,J,C,C,C,C,C,C)   FX         83326  00280000
         MEND  ,                                                 90068  00290000
./ ADD NAME=TSX
         MACRO ,                                                        00010000
&NM      TSX   &R,&A,&AMODE=ANY                         ADDED ON 90308  00020000
.*                                                                      00030000
.*       THIS MACRO CALLS A SUB-ROUTINE IN 31 OR 24 BIT MODE.           00040000
.*       IF AMODE=24, THE USER'S ADDRESS IS OVERRIDDEN                  00050000
.*       IF AMODE=31, THE USER'S ADDRESS IS FORCED TO 31-BIT MODE.      00060000
.*       IN PRE-XA SYSTEMS, ACTS AS BAL/BALR                            00070000
.*                                                                      00080000
         GBLB  &MVSXA                                                   00090000
&NM      MACPARM R15,&A      LOAD DESTINATION ADDRESS TO R15            00100000
         AIF   (NOT &MVSXA).BALR                                        00110000
         AIF   ('&AMODE' EQ 'ANY' OR 'AMODE' EQ '').BASSMX              00120000
         AIF   ('&AMODE' EQ '24' OR '&AMODE' EQ 'AM24').BASSM24         00130000
         AIF   ('&AMODE' EQ '31' OR '&AMODE' EQ 'AM31').BASSM31         00140000
         MNOTE 4,'INVALID AMODE OPERAND - USE: ANY, 24 OR 31'           00150000
         AGO   .BASSMX                                                  00160000
.BASSM24 MACPARM R15,=X'7FFFFFFF',OP=N  KILL 31-BIT MODE BIT            00170000
         AGO   .BASSMX                                                  00180000
.BASSM31 MACPARM R15,=X'80000000',OP=O  SET 31-BIT MODE                 00190000
.BASSMX  MACPARM &R,R15,OP=BASSM,OPR=BASSM,MODE=EQU                     00200000
         MEXIT ,                                                        00210000
.BALR    MACPARM &R,(R15),OP=BAL,OPR=BALR                               00220000
         MEND  ,                                                        00230000
./ ADD NAME=UCBDEVN
         MACRO                                                          00010000
&NM      UCBDEVN &UCBPTR=,&DEVN=,&NONBASE=,&HEXTAB=,&MODE=              00020000
         GBLC  &MACPLAB                                                 00030000
         GBLB  &MVSXA        ON IF X/A OR LATER                 GP10227 00040000
.*   QUICK AND DIRTY TO PROVIDE MODERN SYSTEM COMPATIBILITY             00050000
         LCLC  &R                                                       00060000
&R       SETC  '1'                                                      00070000
&MACPLAB SETC  '&NM'                                                    00080000
         AIF   (K'&UCBPTR LT 3).NOREG                                   00090000
         AIF   ('&UCBPTR'(1,1) NE '(' OR '&UCBPTR'(2,1) EQ '(').NOREG   00100000
         AIF   ('&UCBPTR'(K'&UCBPTR,1) NE ')').NOREG                    00110000
         AIF   ('&UCBPTR'(K'&UCBPTR-1,1) EQ ')').NOREG                  00120000
&R       SETC  '&UCBPTR(1)'                                             00130000
         AGO   .DOREG                                                   00140000
.NOREG   ANOP  ,                                                        00150000
         MACPARM &R,&UCBPTR,OP=L                                        00160000
.DOREG   AIF   ('&MODE' EQ '1' OR &MVSXA).NEWFORM               GP10227 00170000
         MACPARM R15,&DEVN                                      GP10227 00180000
         AIF   ('&MODE' EQ '2').MVS4                            GP13220 00190000
         MVC   0(3,R15),13(&R)    UCB NAME                      GP10227 00200000
         MVI   3(R15),C' '   DEVN COMPATIBILITY                 GP10227 00210000
         MEXIT ,                                                GP10227 00220000
.MVS4    MVC   1(3,R15),13(&R)    UCB NAME                      GP13220 00230000
         MVI   0(R15),C'0'   DEVN COMPATIBILITY                 GP13220 00240000
         MEXIT ,                                                GP13220 00250000
.NEWFORM MACPARM 20(5,13),4(3,&R),OP=UNPK  UCBCHAN/DEVN                 00260000
         AIF   ('&HEXTAB' EQ '').LONG                                   00270000
         TR    20(4,13),&HEXTAB                                         00280000
         AGO   .COMM                                                    00290000
.LONG    NC    20(4,13),=X'0F0F0F0F'                                    00300000
         TR    20(4,13),=C'0123456789ABCDEF'                            00310000
.COMM    MACPARM 15,&DEVN                                               00320000
         MVC   0(4,15),20(13)   RETURN RESULT                           00330000
         MEND                                                           00340000
./ ADD NAME=UNITY
         MACRO ,                                                        00010000
&NM      UNITY &FORMAT=,&DEVD=(DA,TA)     EARLY VERSION ADDED ON 90359  00020000
         GBLB  &MVS                                                     00030000
         LCLA  &I,&J,&K                                                 00040000
         LCLB  &DA,&TA,&UR,&GAM,&TP                                     00050000
         LCLC  &N                                                       00060000
&N       SETC  '&NM'                                                    00070000
&K       SETA  N'&DEVD                                                  00080000
.DEVLOOP ANOP  ,                                                        00090000
&I       SETA  &I+1                                                     00100000
         AIF   (&I GT &K).DEVDONE                                       00110000
&DA      SETB  (&DA OR ('&DEVD(&I)' EQ 'DA'))                           00120000
&TA      SETB  (&TA OR ('&DEVD(&I)' EQ 'TA'))                           00130000
&UR      SETB  (&UR OR ('&DEVD(&I)' EQ 'UR'))                           00140000
&TP      SETB  (&TP OR ('&DEVD(&I)' EQ 'TP'))                           00150000
&GAM     SETB  (&GAM OR ('&DEVD(&I)' EQ 'GAM'))                         00160000
         AGO   .DEVLOOP                                                 00170000
.DEVDONE ANOP  ,                                                GP10042 00180000
&I       SETA  4             WIDTH OF DEVICE NAME               GP10042 00190000
         AIF   ('&FORMAT' EQ '24').TAB24                                00200000
         AIF   ('&FORMAT' EQ '14').TAB14                        GP10042 00210000
&I       SETA  6             WIDTH OF DEVICE NAME               GP10042 00220000
         AIF   ('&FORMAT' EQ '26').TAB24                                00230000
         AIF   ('&FORMAT' EQ '16').TAB14                        GP10042 00240000
         MNOTE 4,'FORMAT &FORMAT NOT SUPPORTED'                         00250000
.TAB24   AIF   (NOT &DA).SK24DA                                         00260000
.*  NOTE:  THE DASD TABLE MUST BE KEPT IN REVERSE ORDER BY TBYT4,       00270000
.*   AND MUST BE COMPLETE. SOME PROGRAMS INDEX INTO THE TABLE.          00280000
&N       DC    X'200F',CL&I'3390'                                       00290000
&N       SETC  ''                                                       00300000
         DC    X'200E',CL&I'3380'                                       00310000
         DC    X'200D',CL&I'333D'                                       00320000
         DC    X'200C',CL&I'3375'                                       00330000
         DC    X'200B',CL&I'3350'                                       00340000
         DC    X'200A',CL&I'3340'                                       00350000
         DC    X'2009',CL&I'3330'                                       00360000
         DC    X'2008',CL&I'2314'                                       00370000
         DC    X'2007',CL&I'2305'                                       00380000
         DC    X'2006',CL&I'2305'                                       00390000
         DC    X'2005',CL&I'2321'                                       00400000
         AIF   (&MVS).NO24DA                                            00410000
         DC    X'2004',CL&I'2302'                                       00420000
         AGO   .CM24DA                                                  00430000
.NO24DA  DC    X'2004',CL&I'9345'                                       00440000
.CM24DA  DC    X'2003',CL&I'2303'                                       00450000
         DC    X'2002',CL&I'2301'                                       00460000
         DC    X'2001',CL&I'2311'                                       00470000
.SK24DA  AIF   (NOT &TA).NO24TA                                         00480000
&N       DC    X'8083',CL&I'3590'                                       00490000
&N       SETC  ''                                                       00500000
         DC    X'8081',CL&I'3490'                                       00510000
         DC    X'8080',CL&I'3480'                                       00520000
         DC    X'8003',CL&I'3400'                                       00530000
         DC    X'8001',CL&I'2400'                                       00540000
.NO24TA  MEXIT ,                                                        00550000
.TAB14   AIF   (NOT &DA).SK14DA                                         00560000
.*  NOTE:  THE DASD TABLE MUST BE KEPT IN REVERSE ORDER BY TBYT4,       00570000
.*   AND MUST BE COMPLETE. SOME PROGRAMS INDEX INTO THE TABLE.          00580000
&N       DC    X'0F',CL&I'3390'                                         00590000
&N       SETC  ''                                                       00600000
         DC    X'0E',CL&I'3380'                                         00610000
         DC    X'0D',CL&I'333D'                                         00620000
         DC    X'0C',CL&I'3375'                                         00630000
         DC    X'0B',CL&I'3350'                                         00640000
         DC    X'0A',CL&I'3340'                                         00650000
         DC    X'09',CL&I'3330'                                         00660000
         DC    X'08',CL&I'2314'                                         00670000
         DC    X'07',CL&I'2305'                                         00680000
         DC    X'06',CL&I'2305'                                         00690000
         DC    X'05',CL&I'2321'                                         00700000
         AIF   (&MVS).NO14DA                                            00710000
         DC    X'04',CL&I'2302'                                         00720000
         AGO   .CM14DA                                                  00730000
.NO14DA  DC    X'04',CL&I'9345'                                         00740000
.CM14DA  DC    X'03',CL&I'2303'                                         00750000
         DC    X'02',CL&I'2301'                                         00760000
         DC    X'01',CL&I'2311'                                         00770000
.SK14DA  AIF   (NOT &TA).NO14TA                                         00780000
&N       DC    X'83',CL&I'3590'                                         00790000
&N       SETC  ''                                                       00800000
         DC    X'81',CL&I'3490'                                         00810000
         DC    X'80',CL&I'3480'                                         00820000
         DC    X'03',CL&I'3400'                                         00830000
         DC    X'01',CL&I'2400'                                         00840000
.NO14TA  MEXIT ,                                                        00850000
         MEND  ,                                                        00860000
./ ADD NAME=USERHMT
         MACRO ,                                                        00010000
&NM    USERHMT &SECT=D,&PFX=                                     92288  00020000
         LCLC  &N,&NN                                                   00030000
&N       SETC  '&NM'                                                    00040000
&NN      SETC  '&N'                                                     00050000
         AIF   ('&SECT' NE 'D').NOD                                     00060000
         AIF   ('&N' NE '').DS                                          00070000
         MNOTE 4,'DSECT NAME OMITTED'                                   00080000
&N       SETC  'USERHMT'                                                00090000
&NN      SETC  '&N'                                                     00100000
.DS      ANOP  ,                                                        00110000
&N       DSECT ,                                                        00120000
&N       SETC  ''                                                       00130000
         AGO   .NOCOM                                                   00140000
.NOD     ANOP  ,                                                        00150000
&N       DS    0D            FORCE ALIGNMENT                            00160000
.NOCOM   ANOP  ,                                                        00170000
&PFX.LINK DC   A(0)          ADDRESS OF NEXT ELEMENT IN CHAIN           00180000
&PFX.DOM  DC   A(0)          NON-ZERO: MOUNT WTO ID FOR DOM             00190000
&PFX.TIME DC   F'0'          TIMESTAMP OF LAST ENTRY                    00200000
&PFX.DATE DC   PL4'0'        DATE OF LAST CHANGE                        00210000
&PFX.DRIV DC   CL3' '        DRIVE NAME (DEVICE ADDRESS)                00220000
&PFX.STAT DC   C' '          STATUS FLAG                                00230000
.*      M-MOUNT; R-MOUNT READ ONLY; W-WRITE RING; U-UP; F-FREE; I-INTRQ 00240000
&PFX.MSLN DC   AL2(0)        MESSAGE LENGTH                             00250000
&PFX.SER  DC   CL6' '        NORMAL MESSAGE - VOLUME SERIAL             00260000
&PFX.SIZE EQU  *-&NN             LENGTH OF EXTENSION                    00270000
         MEND  ,                                                        00280000
./ ADD NAME=VCON
         MACRO ,                                                        00010000
&NM      VCON  &STR,&END=,&BNDRY=H                      ADDED ON 81155  00020000
         GBLB  &VCON@OP                                                 00030000
         GBLC  &VCON@NM                                                 00040000
         LCLA  &I,&J,&K,&L                                              00050000
         LCLC  &L2                                                      00060000
.********************************************************************** 00070000
.**                                                                  ** 00080000
.**  VCON BUILDS A TEXT MESSAGE BEGINNING WITH A TWO-BYTE LENGTH,    ** 00090000
.**  TWO BYTES OF ZERO, AND TEXT OF THAT LENGTH (WTO / RECFM=V FMT)  ** 00100000
.**                                                                  ** 00110000
.**  USE   VCON  'TEXT'                                              ** 00120000
.**                                                                  ** 00130000
.**  OR    VCON  'TEXT1',END=LABEL                                   ** 00140000
.**        DC     ...ZERO OR MORE STORAGE ITEMS                      ** 00150000
.**  LABEL VCON   *END    TO GENERATE A SINGLE MESSAGE               ** 00160000
.**                                                                  ** 00170000
.********************************************************************** 00180000
&K       SETA  K'&STR                                                   00190000
         AIF   (T'&END NE 'O').TSTOPEN                                  00200000
         AIF   (T'&STR EQ 'O').CLOSE                                    00210000
         AIF   ('&STR'(1,1) EQ '*').CLOSE                               00220000
.TSTOPEN AIF   (&K EQ 0).COMLEN                                         00230000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00240000
&I       SETA  2                                                        00250000
&J       SETA  &K-2                                                     00260000
&K       SETA  &J                                                       00270000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00280000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00290000
&I       SETA  &I+1                                                     00300000
         AGO   .INC                                                     00310000
.SK2     ANOP  ,                                                        00320000
&I       SETA  &I+2                                                     00330000
&K       SETA  &K-1                                                     00340000
.INC     AIF   (&I LE &J).LOOP                                          00350000
.COMLEN  AIF   (NOT &VCON@OP).NOPEN                                     00360000
         MNOTE 4,'PRIOR VCON NOT TERMINATED'                            00370000
&VCON@OP SETB  0                                                        00380000
.NOPEN   AIF   ('&BNDRY' EQ 'H' OR '&BNDRY' EQ 'Y').NOBOUND             00390000
         AIF   ('&BNDRY' NE 'X' AND '&BNDRY' NE 'C').DOBOUND            00400000
&L2      SETC  'L2'                                                     00410000
         AGO   .NOBOUND                                                 00420000
.DOBOUND DS    0&BNDRY                                                  00430000
.NOBOUND AIF   (T'&END NE 'O').OPEN                                     00440000
         AIF   (&K EQ 0).REQSTR                                         00450000
         AIF   ('&STR'(1,1) EQ '''').QSTR                               00460000
&NM      DC    Y&L2.(&K+4,0),C'&STR'                                    00470000
         AGO   .MEND                                                    00480000
.QSTR    ANOP  ,                                                        00490000
&NM      DC    Y&L2.(&K+4,0),C&STR                                      00500000
         AGO   .MEND                                                    00510000
.OPEN    AIF   (&K NE 0).OPSTR                                          00520000
&NM      DC    Y&L2.(&END-*,0)                                          00530000
         AGO   .SETOPEN                                                 00540000
.OPSTR   AIF   ('&STR'(1,1) EQ '''').OQSTR                              00550000
&NM      DC    Y&L2.(&END-*,0),C'&STR'                                  00560000
         AGO   .SETOPEN                                                 00570000
.OQSTR   ANOP  ,                                                        00580000
&NM      DC    Y&L2.(&END-*,0),C&STR                                    00590000
.SETOPEN ANOP  ,                                                        00600000
&VCON@NM SETC  '&END'                                                   00610000
&VCON@OP SETB  1                                                        00620000
         MEXIT ,                                                        00630000
.REQSTR  MNOTE 4,'TEXT STRING REQUIRED'                                 00640000
         MEXIT ,                                                        00650000
.CLOSE   AIF   (&VCON@OP).WASOPEN                                       00660000
         MNOTE 4,'VCON END OUT OF SEQUENCE'                             00670000
.WASOPEN AIF   ('&NM' EQ '' OR '&NM' EQ '&VCON@NM').BLAB                00680000
&NM      EQU   *                                                        00690000
.BLAB    ANOP  ,                                                        00700000
&VCON@NM EQU   *                                                        00710000
&VCON@NM SETC  ''                                                       00720000
&VCON@OP SETB  0                                                        00730000
.MEND    MEND  ,                                                        00740000
./ ADD NAME=VERBTAB
         MACRO ,                                                        00010000
&NM      VERBTAB &STR,&LB,&BASE=,&LEN=                UPDATED ON 81169  00020000
         GBLA  &TABMBLN                                          81169  00030000
         GBLC  &TABMBAS                                                 00040000
         LCLA  &I,&J,&K,&L                                              00050000
         LCLC  &H                                                81169  00060000
&K       SETA  K'&STR-1                                                 00070000
         AIF   (&TABMBLN NE 0).HADLEN                            81169  00080000
&TABMBLN SETA  3             SET DEFAULT                         81169  00090000
         AIF   (T'&LEN EQ 'O').HADLEN                            81169  00100000
&TABMBLN SETA  &LEN                                              81169  00110000
.HADLEN  AIF   ('&STR' EQ '').PARMA                              81169  00120000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00130000
&I       SETA  2                                                        00140000
&J       SETA  &K-1                                                     00150000
&K       SETA  &J                                                       00160000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00170000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00180000
&I       SETA  &I+1                                                     00190000
         AGO   .INC                                                     00200000
.SK2     ANOP  ,                                                        00210000
&I       SETA  &I+2                                                     00220000
&K       SETA  &K-1                                                     00230000
.INC     AIF   (&I LE &J).LOOP                                          00240000
&K       SETA  &K-1                                                     00250000
         AIF   (&K GE 0).COMLEN                                         00260000
&K       SETA  0                                                        00270000
.COMLEN  AIF   ('&BASE' EQ '').NBAS                                     00280000
         AIF   ('&BASE' NE '*').UBAS                                    00290000
&TABMBAS SETC  '&SYSECT'                                                00300000
         AGO   .NBAS                                                    00310000
.UBAS    ANOP  ,                                                        00320000
&TABMBAS SETC  '&BASE'                                                  00330000
.NBAS    AIF   ('&TABMBAS' NE '').BASOK                                 00340000
&TABMBAS SETC  '&SYSECT'     DEFAULT BASE TO CURRENT                    00350000
.BASOK   AIF   ('&STR' EQ '*END').LAST                                  00360000
         AIF   ('&LB' NE '').THEX                                81169  00370000
.PARMA   MNOTE 8,'MISSING OR CONFLICTING PARAMETERS'                    00380000
         MEXIT ,                                                        00390000
.THEX    AIF   (&K LT 1).TO                                      81169  00400000
         AIF   ('&STR'(1,1) NE '*').TO                           81169  00410000
&L       SETA  &K            SUPPLIED LENGTH-1                   81169  00420000
&K       SETA  (&K+1)/2-1    NEW TEXT LENGTH                     81169  00430000
&H       SETC  '&STR'(2,&L)                                      81169  00440000
&NM      DC    AL1(&K),AL&TABMBLN.(&LB-&TABMBAS),X'&H'                  00450000
         MEXIT ,                                                 81169  00460000
.TO      AIF   ('&STR'(1,1) EQ '''').TOAP                               00470000
&NM      DC    AL1(&K),AL&TABMBLN.(&LB-&TABMBAS),C'&STR'                00480000
         MEXIT ,                                                        00490000
.TOAP    ANOP  ,                                                        00500000
&NM      DC    AL1(&K),AL&TABMBLN.(&LB-&TABMBAS),C&STR                  00510000
         MEXIT ,                                                        00520000
.LAST    ANOP  ,                                                        00530000
&NM      DC    X'FF'         END OF TABLE                               00540000
         MEND  ,                                                        00550000
./ ADD NAME=VFORM
         MACRO                                                          00010000
&NM      VFORM &P                                                       00020000
.********************************************************************** 00030000
.*                                                                   ** 00040000
.*   EXHIBIT MACRO FOR STORAGE FORMATTING                            ** 00050000
.*                                                                   ** 00060000
.********************************************************************** 00070000
&NM      LA    R1,&P                                                    00080000
         ST    R1,PARMSDMP                                              00090000
         L     R15,SDMPAD                                               00100000
         L     R10,12(,R15)                                             00110000
         LA    R1,PARMSDMP                                              00120000
         BALS  R14,0(R10,R15)                                           00130000
.MEXIT   MEND                                                           00140000
./ ADD NAME=VLOOK
         MACRO                                                          00010000
&NM      VLOOK &T=,&B=*,&R=,&PFX=,&X=R5,&Y=R6,&Z=R4,                   *00020000
               &STRIP=,&ABBR=,&FULL=                      ADDED GP13190 00030000
         GBLB  &ZZ@BLUK                              ADAPTED FROM BLOOK 00040000
         GBLC  &MACPLAB,&ZZ@BLUF                                        00050000
.********************************************************************** 00060000
.*                                                                   ** 00070000
.*    Verb lookup routine; see BTAB macro for matching verb defs     ** 00080000
.*    T     - address of BTAB definitions                            ** 00090000
.*    X     - pointer for scanning                             (R5)  ** 00100000
.*    Y     - register pointing at last byte of text           (R6)  ** 00110000
.*    Z     - register for BTAB scanning                       (R4)  ** 00120000
.*    R     - address of text                                        ** 00130000
.*    B     - base address for (b)ddd branching; B=A (absolute)      ** 00140000
.*            branches to BTAB with BASE=0; B=* (default) branches   ** 00150000
.*            from CSECT (as does B= )                               ** 00160000
.*    PFX   - 0-4 character label prefix (default VERB)              ** 00170000
.*    STRIP - (default) skip leading blanks                          ** 00180000
.*            =NEVER    process at current input address             ** 00190000
.*    ABBR  - when specified, accepts matches for abbreviated verbs  ** 00200000
.*            of any length from original to ABBR value (no default) ** 00210000
.*            ABBR=3 for 'COMMAND' would match COMMAND, COMMAN,      ** 00220000
.*            COMMA, COMM, and COM                                   ** 00230000
.*    FULL  - one or more trailing characters inhibiting shorter     ** 00240000
.*            compares. No default; common are = and (               ** 00250000
.*            e.g., FULL='=' (valid are FULL=alphanum; FULL='chars'; ** 00260000
.*            FULL=C'chars'; and FULL=X'hexchars')                   ** 00270000
.*                                                                   ** 00280000
.********************************************************************** 00290000
.*                                                                   ** 00300000
.*    X returns next byte after match, or last text + 1 for no match ** 00310000
.*    R14 is a return register; R15-R1 are work registers.           ** 00320000
.*      code branches to R15 on match, R14 otherwise.                ** 00330000
.*                                                                   ** 00340000
.*    Y unchanged.                                                   ** 00350000
.*    Z returns last process table entry.                            ** 00360000
.*                                                                   ** 00370000
.********************************************************************** 00380000
.*                                                                   ** 00390000
.*    VLOOK expands an in-line subroutine, called by other           ** 00400000
.*    references. To use in an assembly with multiple, not mutually  ** 00410000
.*    addressable CSECTs, use a unique PFX in each.                  ** 00420000
.*                                                                   ** 00430000
.********************************************************************** 00440000
         LCLC  &L,&D,&LAB,&D1,&D2,&D3                                   00450000
         LCLA  &I,&J,&K                                                 00460000
&L       SETC  'L'''                                                    00470000
         AIF   ('&ZZ@BLUF' NE '').OLDLAB                                00480000
&ZZ@BLUF SETC  'VERB'        DEFAULT LABEL                              00490000
.OLDLAB  ANOP  ,                                                        00500000
         AIF   ('&PFX' EQ '' OR '&PFX' EQ '&ZZ@BLUF').DONLAB            00510000
&ZZ@BLUF SETC  '&PFX'                                                   00520000
&ZZ@BLUK SETB  0             EXPAND CODE WITH NEW LABELS                00530000
.DONLAB  ANOP  ,                                                        00540000
&LAB     SETC  '&ZZ@BLUF'                                               00550000
&NM      MACPARM &Z,&T,NULL==X'FF'                                      00560000
&D       SETC  '('.'&Y'.')'                                             00570000
         AIF   ('&D' EQ '&R' OR '&R' EQ '&Y').NOEND                     00580000
         MACPARM &Y,&R+&L&R-1                                           00590000
.NOEND   AIF   (&ZZ@BLUK).NOTONCE                                       00600000
&ZZ@BLUK SETB  1                                                        00610000
         B     &LAB.END      BRANCH AROUND                              00620000
&LAB.LOOK SLR  R15,R15       ZERO IC REGISTER                           00630000
         AIF   ('&STRIP' EQ 'NEVER').NODEBLK                            00640000
&LAB.1   CLI   0(&X),C' '    LOOK FOR NON-BLANK INPUT                   00650000
         BNE   &LAB.2        OK                                         00660000
         LA    &X,1(,&X)     SKIP TO NEXT BYTE                          00670000
         CR    &X,&Y         REACHED END OF INPUT BUFFER                00680000
         BNH   &LAB.1        NO, LOOK FOR NON-BLANK                     00690000
         BR    R14           RETURN, BUFFER EXHAUSTED                   00700000
         AGO   .YESBLNK                                                 00710000
.NODEBLK B     &LAB.2        NO DEBLANKING                              00720000
.YESBLNK ANOP  ,                                                        00730000
&LAB.CHEK CLC  4(0,&Z),0(&X) MATCHING VERB ?                            00740000
&LAB.3   LA    &Z,5(R15,&Z)  BUMP TO NEXT TABLE ENTRY                   00750000
&LAB.2   CLI   0(&Z),X'FF'   END OF TABLE ?                             00760000
         BER   R14           YES, VERB NOT FOUND                        00770000
         IC    R15,0(,&Z)    LENGTH - 1  OF TABLE ENTRY                 00780000
         EX    R15,&LAB.CHEK  SAME VERB ?                               00790000
         AIF   ('&ABBR' EQ '').NOABBR                                   00800000
         BE    &LAB.MAT                                                 00810000
         LA    R0,1(,R15)    COPY LENGTH                                00820000
         SH    R0,=AL2(&ABBR)    SHORTER ALLOWED ?                      00830000
         BNP   &LAB.3               NO; TRY NEXT                        00840000
         AIF   ('&FULL' EQ '').LABNKC      SKIP IF NO KEYWORDS          00850000
&D       SETC  '&FULL'                                                  00860000
&D1      SETC  'C'''                                                    00870000
&D2      SETC  ''''                                                     00880000
&K       SETA  K'&FULL                                                  00890000
&J       SETA  1             STRIDE                                     00900000
         AIF   ('&FULL' EQ '''').LABNKS                                 00910000
         AIF   (&K LT 3).LABNKS                                         00920000
         AIF   ('&D'(1,2) EQ 'X''').HEXSTR       HEX                    00930000
         AIF   ('&D'(1,2) EQ 'C''').TXTSTR       TEXT                   00940000
         AIF   ('&D'(1,1) NE '''').LABNKS       PLAIN STRING            00950000
&D       SETC  '&D'(2,&K-2)                                             00960000
&K       SETA  K'&D                                                     00970000
         AGO   .LABNKS                                                  00980000
.TXTSTR  ANOP  ,             TEXT NOTATION   C' '                       00990000
&D       SETC  '&D'(3,&K-3)                                             01000000
&K       SETA  K'&D                                                     01010000
         AGO   .LABNKS                                                  01020000
.HEXSTR  ANOP  ,             HEX NOTATION                               01030000
&D1      SETC  'X'''                                                    01040000
&D       SETC  '&D'(3,&K-3)                                             01050000
&K       SETA  K'&D                                                     01060000
&J       SETA  2             STRIDE                                     01070000
.LABNKS  LA    R1,4(R15,&Z)  POINT TO LAST BYTE OF VERB                 01080000
&I       SETA  1                                                        01090000
         AIF   (&K GE &J).LABNKL                                        01100000
         MNOTE 4,'VLOOK: MALFORMED FULL=&FULL'                          01110000
         AGO   .LABNKC                                                  01120000
.LABNKL  ANOP  ,                                                        01130000
&D3      SETC  '&D'(&I,&J)                                              01140000
         AIF   (&J NE 1 OR ('&D3' NE '''' AND '&D3' NE '&&')).LABNDB    01150000
.*TEST   AIF   ('&D'(&I,&J+1) NE '&D3').LABOOPS                         01160000
&I       SETA  &I+1                                                     01170000
.LABOOPS ANOP  ,             USER ERROR                                 01180000
&D3      SETC  '&D3'.'&D3'                                              01190000
.LABNDB  CLI   0(R1),&D1&D3&D2    SPECIAL?                              01200000
         BE    &LAB.3          YES; NO ABBR                             01210000
&I       SETA  &I+&J                                                    01220000
         AIF   (&I LE &K).LABNKL      TRY AGAIN                         01230000
.LABNKC  LR    R1,R15                                                   01240000
&LAB.ALP BCTR  R1,0                                                     01250000
         EX    R1,&LAB.CHEK  MATCH ?                                    01260000
         BE    &LAB.MA1        YES; GET OUT                             01270000
         BCT   R0,&LAB.ALP   SHORTER ALLOWED ?                          01280000
         B     &LAB.3          NO; TRY NEXT                             01290000
         AGO   .DOABBR                                                  01300000
.NOABBR  BNE   &LAB.3        NO, KEEP LOOKING                           01310000
.DOABBR  ANOP  ,                                                        01320000
&LAB.MA1 LR    R15,R1        SET FOR CORRECT INPUT POSITION             01330000
&LAB.MAT LA    &X,1(R15,&X)  POINT TO FIRST BYTE PAST VERB              01340000
         ICM   R15,7,1(&Z)   LOAD DISPLACEMENT ADDRESS                  01350000
         AIF   ('&B' EQ '').RELDEF                                      01360000
         AIF   ('&B' EQ '*').RELDEF                                     01370000
         AIF   ('&B'(1,1) EQ '(').REL                                   01380000
         AIF   ('&B' EQ 'A').ABS                                        01390000
         MNOTE 8,'B NOT A OR (REG)'                                     01400000
.ABS     BR    R15                                                      01410000
         AGO   .BDONE                                                   01420000
.REL     B     0(R15,&B(1))                                             01430000
         AGO   .BDONE                                                   01440000
.RELDEF  B     &SYSECT.(R15)                                            01450000
.BDONE   ANOP  ,                                                        01460000
&LAB.END DS    0H                                                       01470000
.NOTONCE AIF   ('&STRIP' EQ 'NO' OR '&STRIP' EQ 'NEVER').STRIPPD        01480000
         MACPARM R14,&LAB.LOOK,OP=BAL                                   01490000
         AGO   .MEND                                                    01500000
.STRIPPD AIF   ('&STRIP' EQ 'NEVER').STRIPPR                            01510000
         MACPARM R15,0       CLEAR R15 FIRST (AM31,RM24)                01520000
.STRIPPR MACPARM R14,&LAB.LOOK,OP=BAL                                   01530000
.MEND    MEND  ,                                                        01540000
./ ADD NAME=VNENTRY
         MACRO                                                          00010000
&NM      VNENTRY &LIST       ENTRY POINT FOR XCTLS                      00020000
         LCLA  &I,&J                                                    00030000
&J       SETA  N'&SYSLIST                                               00040000
&NM      ONSPIE BUG99,X'7F'  TRAP PROGRAM CHECK INTERRUPTS              00050000
         MVI   SQSPICA+5,X'FF'  REALLY TRAP ALL                         00060000
&NM      LH    R15,BROFF                                                00070000
         LH    R15,VNENTRY(R15)                                         00080000
         B     0(R15,R12)    BRANCH                                     00090000
VNENTRY  EQU   *                                                        00100000
.LOOP    AIF   (&I GE &J).MEND                                          00110000
&I       SETA  &I+1                                                     00120000
         DC    AL2(L&SYSLIST(&I)-&SYSECT)                               00130000
         AGO   .LOOP                                                    00140000
.MEND    MEND  ,                                                        00150000
./ ADD NAME=VNEXIT
         MACRO ,                                                        00010000
         VNEXIT &LIST                                                   00020000
         LCLA  &I,&J                                                    00030000
&J       SETA  N'&SYSLIST                                               00040000
.LOOP    AIF   (&I GE &J).MEND                                          00050000
&I       SETA  &I+1                                                     00060000
L&SYSLIST(&I) LA R1,=AL1(M&SYSLIST(&I),B&SYSLIST(&I))                   00070000
         B     COMXCTL                                                  00080000
         AGO   .LOOP                                                    00090000
.MEND    MEND  ,                                                        00100000
./ ADD NAME=VOLREAD
         MACRO ,                                                        00010000
&NM      VOLREAD &TYPE,&OPERAND,&USE=,&SIZE=,&MODE=   UPDATED ON 85350  00020000
         GBLC  &MACPLAB                                                 00030000
         LCLA  &I,&J                                                    00040000
&MACPLAB SETC  '&NM'                                                    00050000
&I       SETA  0                                                        00060000
         AIF   ('&TYPE' EQ 'CLOSE').CLOSE                               00070000
&I       SETA  1                                                        00080000
         AIF   ('&TYPE' EQ 'TCLOSE').CLOSE                              00090000
&I       SETA  2                                                        00100000
         AIF   ('&TYPE' EQ 'OPEN').CHKUSE                               00110000
&I       SETA  3                                                        00120000
         AIF   ('&TYPE' EQ 'DSCB').TEST1                                00130000
&I       SETA  4                                                        00140000
         AIF   ('&TYPE' EQ 'DSC3').TEST1                                00150000
&I       SETA  5                                                        00160000
         AIF   ('&TYPE' EQ 'SEARCH').LOAD1                              00170000
&I       SETA  6                                                        00180000
         AIF   ('&TYPE' EQ 'SEEK').LOAD1                                00190000
&I       SETA  7                                                        00200000
         AIF   ('&TYPE' EQ 'FIND').LOAD1                                00210000
&I       SETA  8                                                        00220000
         AIF   ('&TYPE' EQ 'GETDE').TEST1                               00230000
&I       SETA  9                                                        00240000
         AIF   ('&TYPE' EQ 'READ').TEST1                                00250000
&I       SETA  10                                                       00260000
         AIF   ('&TYPE' EQ 'NOTE').TEST1                                00270000
&I       SETA  11                                                       00280000
         AIF   ('&TYPE' EQ 'POINT').LOAD1                               00290000
&I       SETA  12                                                       00300000
         AIF   ('&TYPE' EQ 'GET').TEST1                                 00310000
&I       SETA  13                                                85350  00320000
         AIF   ('&TYPE' EQ 'UPDATE').LOAD1                       85350  00330000
&I       SETA  14                                                85350  00340000
         AIF   ('&TYPE' EQ 'FEOM').CLOSE                        GP02247 00350000
&I       SETA  15                                                85350  00360000
         AIF   ('&TYPE' EQ 'TRACK').LOAD1                       GP09158 00370000
         AIF   ('&TYPE' EQ 'LOAD').INIT                                 00380000
         MNOTE 8,'TYPE OPERAND REQUIRED'                                00390000
         MEXIT ,                                                        00400000
.INIT    ANOP  ,                                                        00410000
&I       SETA  &SYSNDX                                                  00420000
         MACPARM R15,15,@VOLREAD,OP=ICM,OPR=ICM,MODE=THREE PRIOR LOAD?  00430000
         BNZ   VLR@&I                                                   00440000
         SERVCALL LPALD,=CL8'@VOLREAD'                                  00450000
         ST    R0,@VOLREAD                                              00460000
VLR@&I   DS    0H                                                       00470000
         MEXIT ,                                                        00480000
.TEST1   AIF   (T'&OPERAND EQ 'O').CLOSE                                00490000
         AGO   .LR1                                                     00500000
.CHKUSE  AIF   (T'&USE EQ 'O').MODE1                                    00510000
&J       SETA  128                                                      00520000
         AIF   ('&USE' EQ 'VTOC').MODE1                                 00530000
&J       SETA  64                                                       00540000
         AIF   ('&USE' EQ 'PDS').MODE1                                  00550000
&J       SETA  32                                                       00560000
         AIF   ('&USE' EQ 'DATA').MODE1                                 00570000
&J       SETA  0                                                        00580000
         MNOTE 4,'INVALID USE PARAMETER &USE'                           00590000
.MODE1   AIF   (T'&MODE EQ 'O').LOAD1                            85350  00600000
         AIF   ('&MODE' EQ 'INPUT').LOAD1                        85350  00610000
&J       SETA  &J+1          SET OUTPUT FLAG                     85350  00620000
         AIF   ('&MODE' EQ 'UPDAT' OR '&MODE' EQ 'OUTPUT' OR           *00630000
               '&MODE' EQ 'UPDATE').LOAD1                        85350  00640000
         MNOTE 4,'INVALID MODE OPERAND &MODE'                    85350  00650000
.LOAD1   AIF   (T'&OPERAND NE 'O').LR1P                                 00660000
         MNOTE 8,'FUNCTION &TYPE REQUIRES AN OPERAND'                   00670000
         MEXIT ,                                                        00680000
.LR1P    AIF   ('&TYPE' NE 'POINT').LR1                                 00690000
         MACPARM R1,&OPERAND,OP=L   LOAD TTR VALUE                      00700000
         AGO   .LR1CM                                                   00710000
.LR1     MACPARM R1,&OPERAND,NULL=0                                     00720000
.LR1CM   AIF   (&J EQ 0).CLOSE                                          00730000
         ICM   R1,8,=AL1(&J)                                            00740000
.CLOSE   AIF   (&I NE 2 OR T'&SIZE EQ 'O').CLOSET                       00750000
         MACPARM R0,&SIZE                                               00760000
         IC    R0,=AL1(&I)                                              00770000
         AGO   .BAL                                                     00780000
.CLOSET  MACPARM R0,&I                                                  00790000
.BAL     ANOP  ,                                                        00800000
&MACPLAB L     R15,@VOLREAD                                             00810000
         BALSR R14,R15                                                  00820000
&MACPLAB SETC  ''                                                       00830000
         MEND  ,                                                        00840000
./ ADD NAME=@VOLRESB
         MACRO ,                                                GP10187 00010000
         @VOLRESB ,                                             GP10187 00020000
         COPY  OPTIONGB                                         GP10187 00030000
*    THIS CODE ACTS AS A @VOLREAD SUBSTITUTE.                    90260  00040000
*    IT IS INVOKED WHEN CALLER IS NOT AUTHORIZED, OR WHEN       GP10187 00050000
*        INVOKED WITH THE 'UNAUTHORIZED' OPTION (USED WHEN CHANGES      00060000
*        ARE TO BE MADE IN OUTPUT ONLY, NOT IN SOURCE).          90260  00070000
*    IT IS INVOKED FOR UNSUPPORTED ACCESS METHODS (E.G., VSAM),  90260  00080000
*        AND FOR @VOLREAD UNSUPPORTED DEVICES (E.G., TAPE).      90260  00090000
*                                                                90260  00100000
VOLFAKE  PGMHEAD SAVE=FAKESAVE,BASE=R12,PARM=R1                  90260  00110000
         USING FAKESAVE,R13  DECLARE NEW START OF WORK AREA      90260  00120000
         XC    VFRET,VFRET   CLEAR RETURN CODES                  90260  00130000
         STM   R0,R1,VFREG0  SAVE ENTRY PARMS                    90260  00140000
         ST    R1,VFRET1     ALSO SAVE FOR RETURN                90260  00150000
         ICM   R0,15,@INPREAD  INPUT READER AVAILABLE ?          90260  00160000
         BNZ   VOLFAKEL      YES                                 90260  00170000
         SERVCALL LPALD,=CL8'@INPREAD'  LOAD IT NOW              90260  00180000
         ST    R0,@INPREAD                                       90260  00190000
VOLFAKEL LM    R0,R1,VFREG0  RELOAD ENTRY REGISTERS              90260  00200000
         LA    R7,0(,R1)     CLEAR PARM                          90260  00210000
         BIX   ERR=VFEXIT16,PFX=VF,BASE=VOLFAKE,                       *00220000
               LOC=(CLOSE,CLOSE,OPEN,DSCB,DSC3,SERCH,SEEK,FIND,GETDE,  *00230000
               READ,NOTE,POINT,GET,UPDAT)                        90260  00240000
VFUPDAT  DS    0H                                                90260  00250000
VFFIND   DS    0H                                                90260  00260000
VFGET    DS    0H                                                90260  00270000
VFEXIT16 MVI   VFRETCC,16    SET MAJOR ERROR                     90260  00280000
         B     VFEXIT        AND GET OUT                         90260  00290000
         SPACE 1                                                 90260  00300000
VFEXIT12 MVI   VFRETCC,12    SET SEVERE ERROR                    90260  00310000
         B     VFEXIT                                            90260  00320000
         SPACE 1                                                 90260  00330000
VFEXIT8  MVI   VFRETCC,8     SET ERROR                           90260  00340000
         B     VFEXIT                                            90260  00350000
         SPACE 1                                                 90260  00360000
VFEXIT4  MVI   VFRETCC,4     SET MINOR PROBLEM                   90260  00370000
         SPACE 1                                                 90260  00380000
VFEXIT   LM    R15,R1,VFRET  LOAD RETURN VALUES                  90260  00390000
         L     R13,4(,R13)   GET OLD SAVE                        90260  00400000
         L     R14,12(,R13)  GET RETURN                          90260  00410000
         LM    R2,R12,28(R13)  RETORE USER'S REGS                90260  00420000
         BR    R14           RETURN                              90260  00430000
         SPACE 1                                                 90260  00440000
VFCLOSE  INPCLOSE DEV=6      CLOSE THE FILE (DON'T CARE IF ANY)  90260  00450000
         ST    R15,VFRET     PROPAGATE RETURN CODE               90260  00460000
         MVI   VFFLAG,0      RESET FLAGS                         90260  00470000
         B     VFEXIT        RETURN WITH CC SET                  90260  00480000
         SPACE 1                                                 90260  00490000
VFOPEN   LTR   R7,R7         VOL-SER PASSED ?                    90260  00500000
         BZ    VFEXIT16      NO; MAJOR BOO-BOO                   90260  00510000
         MVC   VOLSER,0(R7)  SAVE IT                            GP99033 00520000
         TM    VFFLAG,VFGOPEN+VFGDSN  CURRENTLY OPEN ?           90260  00530000
         BO    VFEXIT12      YES; ERROR                          90260  00540000
         CLI   CURTYPE+2,UCB3DACC  DASD INPUT ?                  90260  00550000
         BNE   VFOPEN2       NO; DON'T NEED @OBTAINS             90260  00560000
         ICM   R0,15,@OBTAIN  LOADED BEFORE ?                    90260  00570000
         BNZ   VFOPEN0       YES                                GP99035 00580000
         SERVCALL LPALD,=CL8'@OBTAINS'  GET OLD CODE             90260  00590000
         ST    R0,@OBTAIN    SAVE ADDRESS                        90260  00600000
         LTR   R0,R0         FOUND IT ?                          90260  00610000
         BZ    VFOPEN2       NO; WILL DEFAULT TO OS OBTAIN SVC   90260  00620000
         SLR   R0,R0                                             90260  00630000
         ICM   R0,3,VFREG0   ANY SIZE ?                         GP99035 00640000
*?       BZ    VFOPEN0       NO                                 GP99035 00650000
         @OBTAIN (R0),OPT=SIZE  SET SIZE                         90260  00660000
         ST    R15,VFRET     SAVE RETURN                        GP99033 00670000
VFOPEN0  L     R14,PATFMT1   BUILD CAMLISTS                      81340  00680000
         LA    R15,CCHHR                                         81340  00690000
         LA    R0,VOLSER                                         81340  00700000
         LA    R1,DS1DSNAM   OUTPUT AND WORK AREA                81340  00710000
         STM   R14,R1,GTDSCB1  SEEK LIST                         81340  00720000
         LA    R15,CCHHR3    POINT TO DSCB1 LINKED DSCB         GP99034 00730000
         LA    R1,IECSDSL3   POINT TO SEEK ENTRY                GP99034 00740000
         STM   R14,R1,GTDSCB3  OTHER SEEK LIST                  GP99034 00750000
         L     R14,PATFMT4                                       81340  00760000
         LA    R15,DS1DSNAM  SET TO 44X'04'                      81340  00770000
*        LA    R0,VOLSER                                         81340  00780000
         LA    R1,DS4IDFMT                                       81340  00790000
         STM   R14,R1,GTDSCB4  SEARCH FOR FORMAT 4               81340  00800000
         MVI   DS1DSNAM,X'04'    MAKE FORMAT 4 DSCB DSNAME       81340  00810000
         MVC   DS1DSNAM+1(L'DS1DSNAM-1),DS1DSNAM                 81340  00820000
         @OBTAIN GTDSCB4,OPT=LOADED   LOOK FOR FMT4/SET LOAD FG  81357  00830000
         LA    R0,DS4IDFMT   RETURN DATA (NO KEY)               GP99033 00840000
         STM   R15,R0,VFRET  SET RETURN R15 AND R0              GP99033 00850000
         B     *+4(R15)      CHECK RETURN                       GP99033 00860000
         B     VFOPEN1       OK - BUT TAKEN FOR DSCB 1 ONLY     GP99033 00870000
         B     VFEXIT        NOT MOUNTED                        GP99033 00880000
         B     VFOPEN1   SAYS DSCB 4 NOT FOUND; BUT FOUND IT ANYWAY !   00890000
         NOP   0             I/O ERROR ?                        GP99033 00900000
         NOP   0             INVALID WORK-AREA ? COME ON ?      GP99033 00910000
VFOPEN1  MVC   CCHHR(4),DS4VTOCE+2  GET VTOC LOW EXTENT ( CCHH ) 81340  00920000
*SORT OPTION RETURNS 1ST FMT1 TWICE - FIX                       GP10187 00930000
*DEBUG*  MVI   DS1FMTID,X'A2'  PRESET FOR SORT ON NEXT CALL     GP99033 00940000
         SR    R15,R15                                          GP99035 00950000
         ST    R15,VFRET     SET GOOD RETURN                    GP99035 00960000
         STC   R15,R         SET TO READ RECORD 1 IN VFDSCB     GP99035 00970000
VFOPEN2  MVC   VFWORK(VFPATWN-VFPATWK),VFPATWK  @INPREAD REQUEST 90260  00980000
         MVC   VFWORK(L'DCBDDNAM),CURDDNM  PROPAGATE DD          90260  00990000
         LA    R0,INFMJFCB   GET JFCB                            90260  01000000
         ST    R0,VFWORK+32  SET JFCB ADDRESS                    90260  01010000
         LA    R0,DEBXLE     GET MEMBER RETURN AREA              90260  01020000
         ST    R0,VFWORK+20  SET PDE REQUEST                     90260  01030000
         OI    VFFLAG,VFGOPEN  SET VOLUME OPEN                   90260  01040000
         B     VFEXIT        RETURN OK                           90260  01050000
         SPACE 1                                                 90260  01060000
VFSERCH  LTR   R7,R7         ANY ?                               90260  01070000
         BZ    VFEXIT16      NO PARM, NO GLORY                   90260  01080000
         MVC   DS1DSNAM,0(R7)  SAVE DATASET NAME                 90260  01090000
         CLI   CURTYPE+2,UCB3DACC  DASD INPUT ?                  90260  01100000
         BNE   VFSERF        NO; FAKE IT                         90260  01110000
         SERVCALL DSDJ1,(R7)  GET DSCB FOR DESIRED DS            90260  01120000
         MVC   DS1FMTID(LENDSCB1-L'DS1DSNAM),0(R1)  COPY DATA    90260  01130000
         MVC   CCHHR3,DS1PTRDS  PRESET SEEK FUNCTION ADDRESS    GP99034 01140000
         LA    R0,DS1DSNAM   POINT TO USER'S AREA                90260  01150000
         STM   R15,R0,VFRET  RETURN CODE AND ADDRESS             90260  01160000
         TM    VFFLAG,VFGDSN      DS OPEN                       GP10196 01170000
         BZ    VFEXIT             NO                            GP10196 01180000
         INPCLOSE DEV=6           CLOSE IT                      GP10196 01190000
         ZI    VFFLAG,VFGDSN      SHOW CLOSED                   GP10196 01200000
         B     VFEXIT        RETURN DSCB                        GP99033 01210000
         SPACE 1                                                 90260  01220000
VFSERF   BAS   R9,VFOPNCK    OPEN THE DATASET                   GP99033 01230000
         XC    DS1FMTID(LENDSCB1-L'DS1DSNAM),DS1FMTID  CLEAR     90260  01240000
         L     R7,VF@WORK    GET WORK AREA ADDRESS               90260  01250000
         USING RDRMAP,R7     DECLARE MAPPING                     90260  01260000
         L     R2,RDDCB@     GET DCB ADDRESS                     90260  01270000
         MVC   DS1RECFM,DCBRECFM-IHADCB(R2)                      90260  01280000
         MVC   DS1LRECL,DCBLRECL-IHADCB(R2)                      90260  01290000
         MVC   DS1BLKL,DCBBLKSI-IHADCB(R2)                       90260  01300000
         MVI   DS1DSORG,JFCORGPS                                 90260  01310000
         MVI   DS1NOEPV,1 ONE EXTENT                             90260  01320000
         MVI   DS1LSTAR+L'DS1LSTAR-1,1 ONE BLOCK                GP99033 01330000
         MVI   DS1FMTID,C'1' FAKE ID                            GP99033 01340000
         LA    R0,DS1DSNAM   SET FAKE RETURN                     90260  01350000
         ST    R0,VFRET0     AND GIVE BACK TO USER               90260  01360000
         B     VFEXIT                                            90260  01370000
         DROP  R7                                                90260  01380000
         SPACE 1                                                 90260  01390000
VFNOTE   INC   CURTTR,INC=256,WORK=R15                           90260  01400000
         ST    R15,VFRET0                                        90260  01410000
         B     VFEXIT        QUIT                                90260  01420000
         SPACE 1                                                 90260  01430000
VFGETDE  BAS   R9,VFOPTST    SEE IF OPEN(ABLE)                  GP99033 01440000
VFGETDEG INPREAD DEV=6       GET ANOTHER BLOCK  (./ ADD CARD)    90262  01450000
         BXH   R15,R15,VFEODAD  GET OUT IF NO MORE               90260  01460000
         MVC   VFRET0,PDNEXT  SET NEXT MEMBER ADDRESS            90260  01470000
         OI    VFRET0,X'80'  SET 'LIST DONE' SIGNAL              90262  01480000
         B     VFEXIT        RETURN                              90260  01490000
         SPACE 1                                                 90260  01500000
*        IN PUNK, POINT IS CALLED ONLY TO REPOSITION TO THE      90260  01510000
*        START OF A MEMBER OR DATASET AFTER AT LEAST ONE READ.   90260  01520000
*          THEREFORE, THE TTR IS IGNORED, AND THE DS RE-OPENED.  90260  01530000
*        NOTE THAT VOLREAD POINT ALSO READS THE DESIRED BLOCK    90262  01540000
VFPOINT  TM    DS1DSORG,JFCORGPO PARTITIONED ? 90260            GP99033 01550000
         BNZ   VFPOINT2                                          90260  01560000
         INPCLOSE DEV=6      CLOSE CURRENT DATASET               90260  01570000
         NI    VFFLAG,255-VFGDSN  RESET DCB OPEN                 90260  01580000
         B     VFREAD        AND OPEN AND READ                   90262  01590000
VFPOINT2 INPKEEPM DEV=6      RE-OPEN THE CURRENT MEMBER          90262  01600000
*        B     VFREAD        READ THE FIRST BLOCK                90262  01610000
         SPACE 1                                                 90260  01620000
VFREAD   BAS   R9,VFOPNCK    SEE IF OPEN(ABLE)                  GP99033 01630000
         INPREAD DEV=6       GET NEXT BLOCK                      90260  01640000
         BXH   R15,R15,VFEODAD  I/O ERROR ?                      90260  01650000
         STM   R0,R1,VFRET0  RETURN LENGTH/ADDRESS               90260  01660000
         L     R7,VF@WORK    GET WORK AREA ADDRESS               90260  01670000
         USING RDRMAP,R7     DECLARE MAPPING                     90260  01680000
*PUNK*   TM    RDFLAG,RDFACB VSAM ?                              90260  01690000
*PUNK*   BNZ   VFREAD2       YES; RECORD LENGTH IS SET           90260  01700000
*PUNK*   L     R2,RDDCB@     GET DCB ADDRESS                     90260  01710000
*PUNK*   LH    R0,DS1LRECL GET ORIGINAL SIZE                     90260  01720000
*PUNK*   TM    DS1RECFM,DCBRECU F OR V ?                         90260  01730000
*PUNK*   BM    VFREAD2       YES                                 90260  01740000
*PUNK*   LH    R0,DCBLRECL-IHADCB(R2)  ELSE USE CURRENT          90260  01750000
VFREAD2  ST    R0,CURRECLN   FAKE FIXED LOGIC                    90260  01760000
         LTR   R1,R1         IS THIS A NEW MEMBER ?              90260  01770000
         BNM   VFEXIT        NO; RETURN                          90260  01780000
         INPKEEP DEV=6       SET TO REREAD                       90260  01790000
         B     VFEXIT4       AND RETURN END-FILE                 90260  01800000
         DROP  R7                                                90260  01810000
         SPACE 1                                                 90260  01820000
VFEODAD  INPCLOSE DEV=6      END-FILE READ; CLOSE INPUT          90260  01830000
         NI    VFFLAG,255-VFGDSN  SHOW CLOSED                   GP10196 01840000
         B     VFEXIT4       SET EOF RETURN CODE                 90260  01850000
         SPACE 1                                                 90260  01860000
VFOPTST  LTR   R7,R7         ANY PARM ?                          90260  01870000
         BZ    VFEXIT16      NO; GET OUT                         90260  01880000
VFOPNCK  TM    VFFLAG,VFGOPEN+VFGDSN   WAS OPEN CALLED/OPENED ?  90260  01890000
         BOR   R9            YES; RETURN TO CALLER               90260  01900000
         BZ    VFEXIT16      NO; FAIL                            90260  01910000
         OI    JFCBTSDM,JFCNWRIT+JFCNDSCB+JFCNDCB  NO MERGES     82053  01920000
         MVI   JFCRECFM,X'C0'  FAKE AS RECFM=U FOR INPREAD      GP99035 01930000
         MVC   JFCLRECL,=H'100'  AND SET DIRECTORY BLOCK SIZE   GP99035 01940000
         AIF   (&SVCJFCB EQ 0).KILLMSK  NO MASK PROCESSING       90260  01950000
         TM    DS1DSORG,JFCORGPO PARTITIONED ?                   90260  01960000
         BZ    VFOPNOM       NO; DON'T MESS WITH SWA             90260  01970000
         LA    R14,VFWORK                                        90260  01980000
         LA    R15,ZEROES    NO MEMBER NAME                      90260  01990000
         STM   R14,R15,VFDB    MAKE SKELETON                     90260  02000000
         MVI   VFDB,X'01'      SET DDNAME ENTRY                  90260  02010000
         MVI   VFDB+4,X'84'    SET MEMBER/END-LIST               90260  02020000
         LA    R1,VFDB                                           90260  02030000
         SVC   &SVCJFCB      REQUEST JFCB MODIFICATION           90260  02040000
VFOPNOM  DS    0H                                                90260  02050000
.KILLMSK INPOPEN VFWORK,OPT=(JFCB),DEV=6  OPEN THE DATASET       90260  02060000
VFOPCOM  CH    R15,=H'4'     DID IT WORK ?                       90260  02070000
         BH    VFEXIT8       NO                                  90260  02080000
         ST    R0,VF@WORK    SAVE WORK AREA ADDRESS              90260  02090000
         MVI   VFFLAG,VFGDSN+VFGOPEN  SHOW DSN OPEN              90260  02100000
         BR    R9            ELSE RETURN                         90260  02110000
         SPACE 1                                                GP99033 02120000
VFDSCB   XR    R2,R2                                            GP99033 02130000
         IC    R2,R          GET PREVIOUS RECORD NUMBER         GP99033 02140000
         LA    R2,1(,R2)     BUMP BY ONE                        GP99033 02150000
         STC   R2,R                                             GP99033 02160000
         CLM   R2,1,DS4DEVDT  IS IT HIGHER THAN FITS ON TRACK ?  81340  02170000
         BNH   FIND1         NO, CHECK AGAINST LAST DSCB 1      GP99033 02180000
         MVI   R,1           YES, RESET RECORD NO. TO 1         GP99033 02190000
         LH    R2,HH         GET TRACK NUMBER                   GP99033 02200000
         LA    R2,1(,R2)     AND BUMP BY ONE                    GP99033 02210000
         STH   R2,HH                                            GP99033 02220000
         CH    R2,DS4DEVSZ+2  STILL IN SAME CYLINDER ?           81340  02230000
         BL    FIND1         YES, CHECK FOR VALID ADDRESS       GP99033 02240000
         STCM  R2,12,HH      NO, RESET TRACK TO 0                81340  02250000
         LH    R2,CC         AND BUMP CYLINDER                  GP99033 02260000
         LA    R2,1(,R2)     NUMBER BY 1                        GP99033 02270000
         STH   R2,CC                                            GP99033 02280000
FIND1    CLC   CCHHR,DS4HPCHR   BEYOND LAST FORMAT 1 ?           81340  02290000
         BH    VFDSCBX       YES (MAY FAIL IF SORTED?)          GP99033 02300000
         @OBTAIN GTDSCB1     LOOK FOR FMT1                      GP99033 02310000
         ST    R15,VFRET     SET RETURN R15                     GP99033 02320000
         B     *+4(R15)      CHECK RETURN                       GP99033 02330000
         B     VFDSCB1       OK - BUT TAKEN FOR DSCB 1 ONLY     GP99033 02340000
         B     VFEXIT        NOT MOUNTED                        GP99033 02350000
         B     VFDSCB4   SAYS DSCB 4 NOT FOUND; BUT FOUND IT ANYWAY !   02360000
         NOP   0             I/O ERROR ?                        GP99033 02370000
         NOP   0             INVALID WORK-AREA ? COME ON ?      GP99033 02380000
         B     VFDSCBX                                          GP99033 02390000
IOERR    B     VFEXIT        SET FOR FORMAT 4 ERROR              81340  02400000
         SPACE 1                                                GP99033 02410000
VFDSCB1  CLI   DS1FMTID,X'FF'  END OF SORTED VTOC?              GP99033 02420000
         BE    VFDSCBX                                          GP99033 02430000
         CLI   DS1FMTID,C'1'    IS IT TYPE 1 DSCB ANYWAY ?      GP99033 02440000
         BNE   VFDSCB        IF NOT TYPE 1 IT'S A VALID 'NOT FOUND'     02450000
         MVC   CCHHR3,DS1PTRDS  PRESET SEEK FUNCTION ADDRESS    GP99034 02460000
VFDSCB4  LA    R0,DS1DSNAM   POINT TO START                     GP99033 02470000
         SR    R15,R15       FAKE GOOD RETURN                   GP99035 02480000
         STM   R15,R0,VFRET  RETURN IN R0                       GP99035 02490000
         TM    VFFLAG,VFGDSN      DS OPEN                       GP10196 02500000
         BZ    VFEXIT             NO                            GP10196 02510000
         INPCLOSE DEV=6           CLOSE IT                      GP10196 02520000
         ZI    VFFLAG,VFGDSN      SHOW CLOSED                   GP10196 02530000
         B     VFEXIT        RETURN FORMAT 4                    GP99033 02540000
VFDSCBX  LA    R15,8                                            GP99033 02550000
         SR    R0,R0                                            GP99033 02560000
         STM   R15,R0,VFRET  RETURN END OF VOLUME               GP99033 02570000
         B     VFEXIT                                           GP99033 02580000
         SPACE 1                                                 81340  02590000
VFSEEK   MVC   CCHHR3,VFREG1  SET CALLER'S CCHHR ADDRESS        GP99034 02600000
VFDSC3   OBTAIN GTDSCB3      READ USER'S ADDRESS                GP99034 02610000
         BXH   R15,R15,VFDSCBX  TAKE BAD EXIT                   GP99034 02620000
         LA    R0,IECSDSL3   POINT TO RETURN                    GP99034 02630000
         ST    R0,VFRET0                                        GP99034 02640000
         MVC   CCHHR3,DS3PTRDS  PRESET SEEK FUNCTION ADDRESS    GP99034 02650000
         B     VFEXIT                                           GP99034 02660000
         SPACE 1                                                 81340  02670000
*        LISTS FOR OBTAIN AND SCRATCH                           GP99033 02680000
*                                                               GP99033 02690000
PATFMT4  CAMLST SEARCH,1,2,3   DSN4,VOLSER,DS4IDFMT              81340  02700000
         ORG   PATFMT4+4                                         81340  02710000
PATFMT1  CAMLST SEEK,1,2,3  CCHHR,VOLSER,DS1DSNAM                81340  02720000
         ORG   PATFMT1+4                                         81340  02730000
         SPACE 2                                                 90260  02740000
VFPATWK  INPWORK DDNAME,WIDTH=0,JFCB=1,PDE=3, ODAD=VFEODAD,            *02750000
               PDS=(DIR)     READ DIRECTORY ONLY                GP99035 02760000
VFPATWN  EQU   *                                                 90260  02770000
         LTORG ,                                                        02780000
         MEND  ,                                                GP10187 02790000
./ ADD NAME=@VOLREST
         MACRO ,                                                GP10187 00010000
         @VOLREST ,                                             GP10187 00020000
.*  DATA AREAS FOR VOLFAKE ROUTINE (MACRO @VOLRESB)             GP10187 00030000
FAKESAVE DS    18F           VOLFAKE SAVE AREA                   90260  00040000
VFDB     DS    D                                                GP10187 00050000
@OBTAIN  DC    A(0)          OPTIONAL @OBTAINS ROUTINE           90260  00060000
@INPREAD DC    A(0)          NON-OPTIONAL INPUT READER           90260  00070000
VFREG0   DC    A(0)    1/2                                       90260  00080000
VFREG1   DC    A(0)    2/2                                       90260  00090000
VFRET    DC    A(0)    1/3                                       90260  00100000
VFRETCC  EQU   VFRET+3,1,C'X'  RETURN CODE                       90260  00110000
VFRET0   DC    A(0)    2/3                                       90260  00120000
VFRET1   DC    A(0)    3/3                                       90260  00130000
VFWORK   DS    XL(VFPATWN-VFPATWK)  @INPREAD WORK AREA           90260  00140000
VF@WORK  DS    A             ADDRESS OF @INPREAD DSECT           90260  00150000
GTDSCB4  CAMLST SEARCH,DS1DSNAM,VOLSER,DS4IDFMT                  81340  00160000
GTDSCB1  CAMLST SEEK,CCHHR,VOLSER,DS1DSNAM                       81340  00170000
GTDSCB3  CAMLST SEEK,3,VOLSER,IECSDSL3                          GP99034 00180000
CCHHR    DS    CL5' '        CCHHR OF THIS/NEXT DSCB             81340  00190000
CC       EQU   CCHHR,2         CYLINDER                         GP99033 00200000
HH       EQU   CCHHR+2,2         TRACK                          GP99033 00210000
R        EQU   CCHHR+4,1            RECORD                       81340  00220000
VFFLAG   DC    X'00'         VOLFAKE PROCESSING FLAG             90260  00230000
VFGOPEN  EQU   X'80'           OPEN WAS CALLED                   90260  00240000
VFGDSN   EQU   X'40'           DATASET OPEN                      90260  00250000
VFGMEM   EQU   X'20'           GETDE WAS CALLED ON MEMBER TRANSITION    00260000
         MEND  ,                                                GP10187 00270000
./ ADD NAME=VTAB
         MACRO                                                          00010000
&NM      VTAB  &OP,&TO,&IN,&INTO                                        00020000
         LCLA  &I                                                       00030000
         LCLC  &L,&T(16),&S(16)                                         00040000
&L       SETC  'L'''                                                    00050000
&T(1)    SETC  'ALL'                                                    00060000
&T(2)    SETC  'MVC'                                                    00070000
&T(3)    SETC  'REG'                                                    00080000
&T(4)    SETC  'HEX'                                                    00090000
&T(5)    SETC  'I1'                                                     00100000
&T(6)    SETC  'I2'                                                     00110000
&T(7)    SETC  'I3'                                                     00120000
&T(8)    SETC  'I4'                                                     00130000
&T(9)    SETC  'BIN'                                                    00140000
&T(10)   SETC  'DEC'                                                    00150000
&T(11)   SETC  'N A'                                                    00160000
&T(12)   SETC  'N A'                                                    00170000
&T(13)   SETC  'N A'                                                    00180000
&T(14)   SETC  'CLC'                                                    00190000
&T(15)   SETC  'N A'                                                    00200000
&T(16)   SETC  'LOOP'                                                   00210000
&S(1)    SETC  'NOP'                                                    00220000
&S(2)    SETC  'AGO'                                                    00230000
&S(3)    SETC  'LD'                                                     00240000
&S(4)    SETC  'LO'                                                     00250000
&S(5)    SETC  'LA'                                                     00260000
&S(6)    SETC  'LTR'                                                    00270000
&S(7)    SETC  'AH'                                                     00280000
&S(8)    SETC  'ST'                                                     00290000
&S(9)    SETC  'TM'                                                     00300000
&S(10)   SETC  'MAX'                                                    00310000
&S(11)   SETC  'BCT'                                                    00320000
&S(12)   SETC  'N A'         UNUSED                                     00330000
&S(13)   SETC  'N A'         UNUSED                                     00340000
&S(14)   SETC  'N A'         UNUSED                                     00350000
&S(15)   SETC  'N A'         UNUSED                                     00360000
&S(16)   SETC  'N A'         UNUSED                                     00370000
&I       SETA  1                                                        00380000
.LOOP    ANOP                                                           00390000
         AIF   ('&OP' EQ '&T(&I)').FND                                  00400000
&I       SETA  &I+1                                                     00410000
         AIF   (&I LT 17).LOOP                                          00420000
         AIF   ('&OP' EQ '*END').END                                    00430000
         AIF   ('&OP' NE 'END').BLKQ                                    00440000
.END     ANOP                                                           00450000
&NM      DC    X'FFFFFFFFFF' .   END OF TABLE                           00460000
         AGO   .MEX                                                     00470000
.BLKQ    AIF   ('&OP' NE 'BLK').LOTS                                    00480000
&I       SETA  1                                                        00490000
.FND     AIF   (&I EQ 16).DOL                                           00500000
&I       SETA  (&I-1)*16                                                00510000
         AIF   ('&OP' EQ 'BLK').BLK                                     00520000
         AIF   (&I EQ 0).ALL                                            00530000
         AIF   ('&TO'(1,1) EQ '(' AND '&TO(2)' NE '').SUB               00540000
&NM      DC    SL2(&TO),AL1(&I+((&L&TO-1)-((&L&TO-1)/16)*16)),SL2(&IN)  00550000
.MEX     MEXIT                                                          00560000
.SUB     ANOP                                                           00570000
&NM DC SL2(&TO(1)),AL1(&I+((&TO(2)-1)-((&TO(2)-1)/16)*16)),SL2(&IN)     00580000
         AGO   .MEX                                                     00590000
.BLK     AIF   ('&TO'(1,1) EQ '(' AND '&TO(2)' NE '').BSUB              00600000
&NM      DC    SL2(&TO),AL1(&I+((&L&TO-1)-((&L&TO-1)/16)*16)),AL1((&L&TX00610000
               O-1)/16,C' ') <    MOVE BLANKS                           00620000
         AGO   .MEX                                                     00630000
.BSUB    ANOP                                                           00640000
&NM      DC    SL2(&TO(1)),AL1(&I+((&TO(2)-1)-((&TO(2)-1)/16)*16)),AL1(X00650000
               (&TO(2)-1)/16,C' ') <     MOVE BLANKS                    00660000
         AGO   .MEX                                                     00670000
.ALL     AIF   ('&TO'(1,1) EQ '(' AND '&TO(2)' NE '').BALL              00680000
&NM      DC    SL2(&TO),AL1(&I+((&L&TO-1)-((&L&TO-1)/16)*16)),AL1((&L&TX00690000
               O-1)/16,&IN) <   MOVE ALL                                00700000
         AGO   .MEX                                                     00710000
.BALL    ANOP                                                           00720000
&NM      DC    SL2(&TO(1)),AL1(&I+((&TO(2)-1)-((&TO(2)-1)/16)*16)),AL1(X00730000
               (&TO(2)-1)/16,&IN) <    MOVE ALL                         00740000
         AGO   .MEX                                                     00750000
.DOL     ANOP                                                           00760000
&NM      DC    AL2(&IN),AL1(X'F0'+((&TO-1)-(&TO-1)/16*16)),AL2(&INTO)   00770000
         AGO   .MEX                                                     00780000
.LOTS    ANOP                                                           00790000
&I       SETA  1                                                        00800000
.LLOP    AIF   ('&OP' EQ '&S(&I)').LFND                                 00810000
&I       SETA  &I+1                                                     00820000
         AIF   (&I LT 17).LLOP                                          00830000
.BOOBOO  MNOTE 8,'INVALID OPERATION CODE ''&OP'''                       00840000
         MEXIT                                                          00850000
.LFND    ANOP                                                           00860000
&I       SETA  14*16+&I-1                                               00870000
         AIF   ('&OP' EQ 'AGO').SS                                      00880000
         AIF   ('&OP' EQ 'LD' OR '&OP' EQ 'LA'                         *00890000
               OR '&OP' EQ 'BCT'                                       *00900000
               OR '&OP' EQ 'ST').RS                                     00910000
         AIF   ('&OP' EQ 'LTR').RM                                      00920000
         AIF   ('&OP' EQ 'AH').RH                                       00930000
         AIF   ('&OP' EQ 'TM').SM                                       00940000
         AIF   ('&OP' EQ 'MAX' AND '&TO' NE '').SZ                      00950000
         AIF   ('&OP' EQ 'MAX').ZM                                      00960000
         AIF   ('&OP' EQ 'LO').RZ                                       00970000
.*       ASSUME NOP OR NOT CODED YET                                    00980000
&NM      DC    AL1(0,0,&I,0,0) .     NOP                                00990000
         AGO   .MEX                                                     01000000
.RS      ANOP                                                           01010000
&NM      DC    AL1(0,(&TO-(&TO/16)*16),&I),SL2(&IN)                     01020000
         AGO   .MEX                                                     01030000
.SS      ANOP                                                           01040000
&NM      DC    SL2(&TO),AL1(&I),SL2(&IN)                                01050000
         AGO   .MEX                                                     01060000
.RM      ANOP                                                           01070000
&NM      DC    AL1(0,(&TO-(&TO/16)*16),&I,0,&IN)                        01080000
         AGO   .MEX                                                     01090000
.RH      ANOP                                                           01100000
&NM      DC    AL1(0,(&TO-(&TO/16)*16),&I),AL2(&IN)                     01110000
         AGO   .MEX                                                     01120000
.SM      ANOP                                                           01130000
&NM      DC    SL2(&TO),AL1(&I,0,&IN)                                   01140000
         AGO   .MEX                                                     01150000
.ZM      DC    AL1(0,0,&I,0,&IN)                                        01160000
         AGO   .MEX                                                     01170000
.SZ      ANOP                                                           01180000
&NM      DC    SL2(&TO),AL1(&I,0,0)                                     01190000
         AGO   .MEX                                                     01200000
.RZ      ANOP                                                           01210000
&NM      DC    AL1(0,(&TO-(&TO/16)*16),&I,0,0)                          01220000
         AGO   .MEX                                                     01230000
         MEND                                                           01240000
./ ADD NAME=VTOBYTE
         MACRO                                                          00010000
      VTOBYTE  &CHAR=CHAR                                               00020000
.*       R1 => VTOTAB TABLE                                             00030000
.*       R5 => INPUT STRING                                             00040000
CHARBYTE MVI   &CHAR,0 .     CLEAR CHARACTER OUT                        00050000
         SR    R14,R14 .     CLEAR IC REG                               00060000
CHARBYTL CLI   1(R1),255 .   END OF TABLE ?                             00070000
         BER   R9 .          YES, RETURN                                00080000
         IC    R14,1(R1) .   ELSE GET LENGTH - 1 OF ENTRY               00090000
         EX    R14,CHARCLC .  IS THIS ENTRY IN INPUT STRING ?           00100000
         BNE   CHARBYTI .    NO, TRY NEXT TABLE ENTRY                   00110000
         OC    &CHAR,0(R1) .   OR FLAG(S) TO BYTE                       00120000
         LA    R5,1(R5,R14) .   SET INPUT TO NEXT                       00130000
CHARBYTI LA    R1,3(R1,R14) .   SET TO NEXT TABLE ENTRY                 00140000
         B     CHARBYTL .    TRY AGAIN                                  00150000
CHARCLC  CLC   2(0,R1),0(R5) .   IS INPUT SAME AS TABLE ENTRY ?         00160000
         MEND                                                           00170000
./ ADD NAME=VTOCHAR
         MACRO                                                          00010000
         VTOCHAR                                                        00020000
         LCLC  &SECT                                                    00030000
&SECT    SETC  '&SYSECT'                                                00040000
CHARBIT  LA    R14,CHAROUT   START OF OUTPUT,AT END WILL BE LENGTH      00050000
         LR    R15,R14       START ADDRESS - SETUP FOR SPMOVE           00060000
         MVC   CHAROUT,BLANKS   CLEAR OUTPUT FIELD                      00070000
         USING CHARMS,R1     MAP INPUT TABLE                            00080000
         SR    R2,R2         CLEAR IC REGISTER                          00090000
CHARLP   CLI   CHARL,255     END OF TABLE ?                             00100000
         BNE   CHARTS        NO, CONTINUE                               00110000
         SR    R14,R15       GET LENGTH OF OUTPUT STASHED               00120000
         BPR   R9            AT LEAST ONE BYTE ?                        00130000
         LA    R14,1         FORCE ONE                                  00140000
         BR    R9            RETURN                                     00150000
         SPACE                                                          00160000
CHARTS   IC    R2,CHARL      GET LENGTH - 1 OF TEXT                     00170000
         MVC   CHARN,CHAR    COPY TEST BYTE TO WORK BYTE                00180000
         NC    CHARN,CHART   MASK OUT ALL BUT TESTED BITS               00190000
        CLC   CHARN,CHART   IS THIS THE PATTERN ?                       00200000
         BNE   CHARINC       NO, TRY NEXT ONE                           00210000
         EX    R2,CHARMV     MOVE TEXT TO OUTPUT                        00220000
         MVI   CHARX,255     PREPARE TO COMPLIMENT                      00230000
         XC    CHARX,CHART   COMPLEMENT TEST PATTERN                    00240000
         NC    CHAR,CHARX    MASK OUT BITS USED BY TEST                 00250000
         LA    R14,1(R2,R14)    POINT TO NEXT O/P POSITION              00260000
         SPACE                                                          00270000
CHARINC  LA    R1,3(R1,R2)   POINT TO NEXT INPUT TABLE POSITION         00280000
         B     CHARLP        TEST FOR END OR NEXT                       00290000
         DROP  R1                                                       00300000
         SPACE 2                                                        00310000
CHARMS   DSECT                                                          00320000
CHART    DS    X             TEST BIT PATTERN                           00330000
CHARL    DS    X             LENGTH - 1 OF TEXT                         00340000
CHARC    DS    C             CHARACTERS                                 00350000
         SPACE                                                          00360000
&SECT    CSECT                                                          00370000
CHARMV   MVC   0(0,R14),2(R1)   MOVE TO OUTPUT                          00380000
CHAR     DC    X'0'          BYTE TO BE ANALYZED                        00390000
CHARN    DC    X'0'          TEST AREA                                  00400000
CHARX    DC    X'0'          COMPLEMENT OF TEST BYTE                    00410000
CHAROUT  DC    CL39' '       OUTPUT AREA                                00420000
         MEND                                                           00430000
./ ADD NAME=VTOTAB
         MACRO                                                          00010000
&NM     VTOTAB &BIT,&ITEM,&LEN                                          00020000
         LCLA  &I,&K,&L                                                 00030000
         AIF   ('&BIT' EQ '*END').END                                   00040000
         AIF   ('&LEN' EQ '').DEF                                       00050000
         AIF   ('&ITEM'(1,1) EQ '''').EXLQ                              00060000
&NM      DC    AL1(&BIT,&LEN-1),CL(&LEN)'&ITEM'                         00070000
         MEXIT                                                          00080000
.EXLQ    ANOP                                                           00090000
&NM      DC    AL1(&BIT,&LEN-1),CL(&LEN)&ITEM                           00100000
         MEXIT                                                          00110000
.DEF     ANOP                                                           00120000
&I       SETA  K'&ITEM                                                  00130000
         AIF   ('&ITEM'(1,1) EQ '''').IMLQ                              00140000
&NM      DC    AL1(&BIT,&I-1),CL&I'&ITEM'                               00150000
         MEXIT                                                          00160000
.IMLQ    ANOP                                                           00170000
&L       SETA  &I-2                                                     00180000
&I       SETA  &I-1                                                     00190000
&K       SETA  2                                                        00200000
.LOOP    AIF   (&K GE &I).EXPQ                                          00210000
         AIF   ('&ITEM'(&K,2) EQ '''''').DOUB                           00220000
&K       SETA  &K+1                                                     00230000
         AGO   .LOOP                                                    00240000
.DOUB    ANOP                                                           00250000
&K       SETA  &K+2                                                     00260000
&L       SETA  &L-1                                                     00270000
         AGO   .LOOP                                                    00280000
.EXPQ    ANOP                                                           00290000
&NM      DC    AL1(&BIT,&L-1),CL&L&ITEM                                 00300000
         MEXIT                                                          00310000
.END     ANOP                                                           00320000
&NM      DC    AL1(0,255) .    END OF LIST                              00330000
         MEND                                                           00340000
./ ADD NAME=WTBLD
         MACRO                                                          00010000
&L       WTBLD &DUM,&MSGSECT=,&PFX='---> ',&SFX=' <---',          78310*00020000
               &CPU=370,                                          *GPP**00030000
               &ROUTCDE=(2,13),&UCMID=,&DOM=,&SCON=NO,&WTOIN=NO,&ML=    00040000
         GBLC  &WTOSECT                                           78310 00050000
         LCLA  &I,&LPFX,&LSFX                                           00060000
.*                                                                      00070000
.*             THIS MACRO WAS WRITTEN BY:                               00080000
.*                            SHMUEL (SEYMOUR J.) METZ                  00090000
.*                            SIGMA DATA SERVICES CORPORATION     78310 00100000
.*                            GODDARD SPACE FLIGHT CENTER         78310 00110000
.*                            CODE 911                            78310 00120000
.*                            GREENBELT ROAD                      78310 00130000
.*                            GREENBELT, MARYLAND   20771         78310 00140000
.*                                                                      00150000
.*             IT MAY NOT BE DISTRIBUTED WITHOUT PERMISSION FROM ME:    00160000
.*             ANYONE REQUESTING A COPY SHOULD BE REFERRED TO THE       00170000
.*             SHARE MFT/MVT PROJECT, WHICH IS DISTRIBUTING IT          00180000
.*             ON THE "MICHIGAN MODS TAPE", AKA NMDBT;                  00190000
.*             ALTERNATIVELY, IT MAY BE OBTAINED BY ORDERING THE TDTR   00200000
.*             (TECHNION DTR) FROM THE TECHNION.                        00210000
.*                                                                      00220000
.*             THIS RESTRICTION IS INTENDED TO PREVENT A PROLIFERATION  00230000
.*             OF INCOMPATIBLE VERSIONS: ANY REASONABLE SUGGESTIONS     00240000
.*             OR CONTRIBUTIONS WILL BE ADDED TO THE DISTRIBUTED COPY.  00250000
.*                                                                78310 00260000
         AIF   ('&WTOSECT' EQ '').SECTSET                         78310 00270000
         AIF   ('&MSGSECT' EQ '&WTOSECT').SECTOK                  78310 00280000
         AIF   ('&MSGSECT' EQ '').SECTOK                          78310 00290000
         MNOTE 8,'MSGSECT=&MSGSECT INCONSISTENT'                  78310 00300000
         MNOTE 8,'MSGSECT=&WTOSECT PREVIOUSLY SPECIFIED'          78310 00310000
         AGO   .SECTOK                                            78310 00320000
.SECTSET ANOP  ,                                                  78310 00330000
&WTOSECT SETC  '&MSGSECT'                                         78310 00340000
         AIF   ('&WTOSECT' NE '').SECTOK                          78310 00350000
&WTOSECT SETC  'MSGCSECT'                                         78310 00360000
.SECTOK  ANOP  ,                                                  78310 00370000
         AIF   ('&PFX' EQ '').NOPFX                                     00380000
         AIF   ('&PFX'(1,1) EQ '''' AND '&PFX'(K'&PFX,1) EQ '''').PFOK  00390000
         MNOTE 12,'PFX INVALID - MUST BEGIN AND END WITH ''.'           00400000
         MEXIT                                                          00410000
.SPFX    MNOTE 12,'PFX INVALID - NO TEXT'                               00420000
         MEXIT                                                          00430000
.PFOK    AIF   ('&PFX' EQ '''' OR '&PFX' EQ '''''').SPFX                00440000
&I       SETA  2                                                        00450000
.PLOOP   AIF  ('&PFX'(&I,2) NE ''''''  AND                             *00460000
               '&PFX'(&I,2) NE '&&&&').PSNGL                            00470000
&I       SETA  &I+1                                                     00480000
.PSNGL   ANOP                                                           00490000
&I       SETA  &I+1                                                     00500000
&LPFX    SETA  &LPFX+1                                                  00510000
         AIF   (&I LT K'&PFX).PLOOP                                     00520000
         AIF   (&I EQ K'&PFX).NOPFX                                     00530000
         MNOTE 12,'PFX HAS UNMATCHED ''S.'                              00540000
         MEXIT                                                          00550000
.*                                                                      00560000
.NOPFX   AIF   ('&SFX' EQ '').NOSFX1                                    00570000
         AIF   ('&SFX'(1,1) EQ '''' AND '&SFX'(K'&SFX,1) EQ '''').SFOK  00580000
         MNOTE 12,'SFX INVALID - MUST BEGIN AND END WITH ''.'           00590000
         MEXIT                                                          00600000
.SSFX    MNOTE 12,'SFX INVALID - NO TEXT'                               00610000
         MEXIT                                                          00620000
.SFOK    AIF   ('&SFX' EQ '''' OR '&SFX' EQ '''''').SSFX                00630000
&I       SETA  2                                                        00640000
.SLOOP   AIF  ('&SFX'(&I,2) NE '''''' AND                              *00650000
               '&SFX'(&I,2) NE '&&&&').SSNGL                            00660000
&I       SETA  &I+1                                                     00670000
.SSNGL   ANOP                                                           00680000
&I       SETA  &I+1                                                     00690000
&LSFX    SETA  &LSFX+1                                                  00700000
         AIF   (&I LT K'&SFX).SLOOP                                     00710000
         AIF   (&I EQ K'&SFX).NOSFX1                                    00720000
         MNOTE 12,'SFX HAS UNMATCHED ''S.'                              00730000
         MEXIT                                                          00740000
.*                                                                      00750000
.NOSFX1  ANOP                                                           00760000
&I       SETA   1                                                       00770000
         SPACE 1                                                        00780000
*        R0    PAD                                                      00790000
*        R1    -> WTO/WTOR PARM LIST                                    00800000
*        R2    LENGTH-1 FOR MVC                                         00810000
*        R3    -> DESC (OR BYTE AFTER TEXT FOR MLWTO)                   00820000
*        R4    -> WTO PARM LIST, ADJUSTED FOR PREFIX                    00830000
*        R5    -> WTO PARM LIST (OR -> LENGTH FOR MLWTO)                00840000
*        R6    -> MSG                                                   00850000
*        R9    INTERNAL CALL REGISTER                                   00860000
*        R14   PARM/RETURN                                              00870000
*        +0    DESCRIPTOR                                               00880000
*        +2    LENGTH-1 OF TEXT                                         00890000
*        +3    FLAG BYTE                                                00900000
*        +4    DISPLACEMENT TO TEXT                                     00910000
*        +6    RETURN                                                   00920000
         SPACE 1                                                        00930000
*              FOR MULTI-LINE MESSAGES:                                 00940000
*        +0    DESCRIPTOR                                               00950000
*        +2    LENGTH-1                                                 00960000
*        +3    FLAG BYTE                                                00970000
*        +4    DISPLACEMENT TO TEXT                                     00980000
*        +6    LINE TYPE                                                00990000
*        +8    LENGTH-1 OF TEXT                                         01000000
*        +9    FLAG                                                     01010000
*        +10   DISPLACEMENT TO TEXT                                     01020000
*        +12   LINE TYPE                                                01030000
*        +14   LENGTH-1 OF TEXT                                         01040000
*        ...                                                            01050000
*              X'FFFF'                                                  01060000
*        +2    RETURN                                                   01070000
         SPACE 3                                                        01080000
*              CONSTRUCTED WTO/WTOR IS OF FORM:                         01090000
*        +0    L'REPLY                                                  01100000
*        +1    AL3(REPLY)                                               01110000
*        +4    A(ECB)                                                   01120000
*        +8    0                                                        01130000
*        +9    LENGTH                                                   01140000
*        +10   MCSFLAGS                                                 01150000
*        +12   TEXT                                                     01160000
*        ---   DESCRIPTOR                                               01170000
*        +2    ROUTCDE                                                  01180000
*        +4    LINE TYPE (IF MLWTO)                                     01190000
*        +6    AREA ID                                                  01200000
*        +7    # OF LINES                                               01210000
         SPACE 1                                                        01220000
*        +8    LENGTH                                                   01230000
*        +10   LINETYPE                                                 01240000
*        +12   TEXT                                                     01250000
*        ...                                                            01260000
         SPACE 3                                                        01270000
         USING WT1,R5                                                   01280000
         USING WT2,R3                                                   01290000
         USING WTPRM,R14                                                01300000
         AIF   ('&ML' EQ 'NO').NOML1                                    01310000
         SPACE 2                                                        01320000
*              ENTRY POINT TO ADD LINES TO MLWTO                        01330000
WTOEXTND XR    R0,R0                    DO NOT ALLOW FOR POSTFIX        01340000
         BCTR  R14,0                    FOR COMPATIBILITY WITH BUILD    01350000
         BCTR  R14,0                        R14=R14-2                   01360000
         AIF   ('&SCON' NE 'NO').SCON1                                  01370000
         STM   R14,R12,12(R13)                                          01380000
         AGO   .NOSCON1                                                 01390000
.SCON1   STM   R0,R15,WTOREGS                                           01400000
.NOSCON1 LA    R1,WTOMSGL                                               01410000
         L     R3,DESCPTR               R2 = # OF LINES ALREADY BUILT   01420000
         XR    R2,R2                                                    01430000
         IC    R2,WTNUMLIN                                              01440000
         LA    R5,WTNUMLIN+1                                            01450000
WTOE1    BCT   R2,*+8                                                   01460000
         B     WTOB2                                                    01470000
         AIF   ('&CPU' NE '360').SK370                            *TSM* 01480000
         XR    R4,R4                    SKIP TO NEXT LINE               01490000
         IC    R4,WTLENGTH+1                                            01500000
         AGO   .SK360                                                   01510000
.SK370   LH    R4,WTLENGTH              SKIP TO NEXT LINE               01520000
.SK360   AR    R5,R4                                                    01530000
         B     WTOE1                                                    01540000
.NOML1   SPACE 2                                                        01550000
*              ENTRY POINT TO CONSTRUCT WTO/WTOR                        01560000
WTOBUILD XR    R0,R0                    DO NOT ALLOW FOR POSTFIX        01570000
         AIF   ('&SCON' NE 'NO').SCON2                                  01580000
         STM   R14,R12,12(R13)                                          01590000
         AGO   .NOSCON2                                                 01600000
.SCON2   STM   R0,R15,WTOREGS                                           01610000
.NOSCON2 LA    R5,WTOMSGL               PTR FOR MSG BUILD               01620000
         LR    R1,R5                    PTR FOR EXIT                    01630000
         TM    WPFLAG,$WTOR             IS WTOR FLAG ON                 01640000
         BZ    WTOB0                                                    01650000
         LA    R1,REPLY                                                 01660000
         ST    R1,WTORRPLY                                              01670000
         MVI   WTORRPLY,L'REPLY                                         01680000
         LA    R1,WTORECB                                               01690000
         ST    R1,WTORECBA                                              01700000
         MVI   WTORECB,0                                                01710000
         LA    R1,WTOR                                                  01720000
         LA    R5,WTORMSGL                                              01730000
         USING WT1,R5                                                   01740000
         USING WT2,R3                                                   01750000
WTOB0    BALS  R9,WTOBLINE              SET UP 1ST OR ONLY LINE OF WTO  01760000
         MVC   WTDESC,WPDESC            DESC FROM CALLING SEQUENCE      01770000
         MVC   WTROUT,ROUTCDE           ROUTCDE=(2,13)                  01780000
         MVC   WTFLAG,WFLAG             SET MCS FLAG                    01790000
         AIF   ('&ML' EQ 'NO').NOML3                                    01800000
         ST    R3,DESCPTR               SAVE FOR SUBSEQUENT LINES       01810000
         TM    WPFLAG,$ML               ML WTO REQUESTED?               01820000
         BZ    WTOBEXIT                  NO  - CLEAN UP AND GO          01830000
         OI    WTFLAG+1,$MCMLWTO         YES - FLAG AS SUCH             01840000
         MVC   WTLINTYP,WPLINTYP        MOVE IN 1ST LINE TYPE           01850000
         WTPVT AREAID                   DEFAULT: MVI WTAREAID,0         01860000
         MVI   WTNUMLIN,1               INDICATE 1 LINE                 01870000
         LA    R5,WTNUMLIN+1            SETUP FOR NEXT LINE             01880000
WTOB1    CLI   WPSTOPER,X'FF'           DAY IS DUN?                     01890000
         BE    WTOBXTML                     YES - DEPART                01900000
         LA    R14,WPSTOPER-WPTXLENG+WTPRM  NO  - TO NEXT ENTRY         01910000
WTOB2    MVC   WTLINTP2,WPLINTYP        MOVE IN NEXT LINE TYPE          01920000
         L     R3,DESCPTR               BUMP # OF LINES                 01930000
         IC    R15,WTNUMLIN                                             01940000
         LA    R15,1(,R15)                                              01950000
         STC   R15,WTNUMLIN                                             01960000
         BALS  R9,WTOBLINE              SET UP SUBSEQUENT LINE OF WTO   01970000
         LR    R5,R3                    SET UP FOR NEXT LINE            01980000
         B     WTOB1                    OD PA'AM                        01990000
.NOML3   SPACE 2                                                        02000000
WTOBLINE LH    R6,WPTXDISP                                              02010000
         A     R6,=A(&WTOSECT)                                    78310 02020000
         XR    R2,R2                    PICK UP LENGTH-1 FOR MVC        02030000
         IC    R2,WPTXLENG                                              02040000
         AIF   ('&SCON' EQ 'NO').NOSCON3                                02050000
         TM    WPFLAG,$SCON             TEXT POINTER OR OFFSET?         02060000
         BZ    NOSCON                    OFFSET                         02070000
         MVC   WTOLA(2),=X'4160'        BUILD: LA R6,OFFSET(,R15)       02080000
         MVC   WTOLA+2(2),WPTXDISP                                      02090000
         OI    WTOLA+2,X'F0'                                            02100000
         SR    R15,R15                  LOCATE REGISTER SAVE FOR R      02110000
         IC    R15,WPTXDISP                                             02120000
         SRL   R15,4                                                    02130000
         SLL   R15,2                                                    02140000
         L     R15,WTOREGS(R15)         LOAD FROM SAVED VALUE           02150000
         EX    0,WTOLA                  R6->WTO (RECFM=V)               02160000
         AIF   ('&CPU' NE '360').LH370                            *GPP* 02170000
         SR    R2,R2         CLEAR FOR IC                         *GPP* 02180000
         IC    R2,1(,R6)     LENGTH FROM WTO                      *GPP* 02190000
         AGO   .LHCOM                                             *GPP* 02200000
.LH370   LH    R2,0(,R6)     LENGTH FROM WTO                      *GPP* 02210000
.LHCOM   SH    R2,=H'5'       - 5                                 *GPP* 02220000
         LA    R6,4(,R6)                R6->TEXT                        02230000
.NOSCON3 ANOP                                                           02240000
NOSCON   LA    R3,WTTEXT+1(R2)          -> DESC IF NO PFX/SFX           02250000
         AR    R3,R0                                                    02260000
         XR    R0,R0                    CLEAR FOR NEXT LINE IF MLWTO    02270000
         LR    R4,R5                                                    02280000
         TM    WPFLAG,$PFX              IS PREFIX FLAG ON?              02290000
         BZ    WTOBL1                                                   02300000
         WTPVT CODE,PFX=&PFX,LPFX=&LPFX,SFX=&SFX,LSFX=&LSFX             02310000
WTOBL1   EX    R2,WTOBMVC               MOVE IN CALLER'S MESSAGE        02320000
         SR    R3,R5                    SET WTO/WTOR LENGTH             02330000
         AIF   ('&CPU' NE '360').STH370                           *GPP* 02340000
         STC   R3,WTLENGTH+1       STORE LENGTH                   *GPP* 02350000
         MVI   WTLENGTH,0    FOLLOW CONVENTIONS                   *GPP* 02360000
         AGO   .STHCOM                                            *GPP* 02370000
.STH370  STH   R3,WTLENGTH     STORE LENGTH                       *GPP* 02380000
.STHCOM  AR    R3,R5         RESTORE DESC PTR                     *GPP* 02390000
         BR    R9                       BACK FOR NEXT LINE              02400000
         DROP  R3                                                       02410000
         DROP  R5                                                       02420000
         SPACE 1                                                        02430000
         USING WT1,R5                                                   02440000
         USING WT2,R3                                                   02450000
         AIF   ('&UCMID' EQ '').NOUCMID                                 02460000
         AIF   ('&ML' EQ 'NO').NOML2A                                   02470000
WTOBXTML LR    R5,R1                    RESTORE PFX POINTER IF MLWTO    02480000
.NOML2A  ANOP                                                           02490000
WTOBEXIT XR    R0,R0                    CLEAR FOR MLWTO IN KEY 0  *TSM* 02500000
         TM    WPFLAG,$UCMID            WTO WITH UCMID IN R0 DESIRED?   02510000
         BZ    NOUCMID                   NO                             02520000
         IC    R0,UCMID                 GET UCMID FOR WTO         *TSM* 02530000
         LTR   R0,R0                    IS UCMID PRESENT?               02540000
         BZ    NOUCMID                   NO - CAN'T DO WITH REG0        02550000
         OI    WTFLAG,$MCREG0           SET UCMID FLAG IN WTO           02560000
NOUCMID  TM    WPFLAG,$IMM              IS IMMEDIATE WTO FLAG ON?       02570000
         AGO   .UCMID                                                   02580000
.NOUCMID ANOP                                                           02590000
         AIF   ('&ML' EQ 'NO').NOML2B                                   02600000
WTOBXTML EQU   *                        RESTORE PFX POINTER IF MLWTO    02610000
*                                        NOT NEEDED SINCE NO UCMID      02620000
.NOML2B  ANOP                                                           02630000
WTOBEXIT TM    WPFLAG,$IMM              IS IMMEDIATE WTO FLAG ON?       02640000
.UCMID   BZ    WTOBXIT1                  NO - LET CALLER MUCK UP WTO    02650000
         WTO   MF=(E,(1))                                               02660000
         AIF   ('&DOM' EQ 'NO').NODOM1                                  02670000
         AIF   ('&ML' EQ 'NO').NOML4                                    02680000
         L     R3,DESCPTR               RESTORE PTR IF MLWTO            02690000
.NOML4   TM    WTDESC,$DSIMMAC          IS THIS DESC=2?                 02700000
         BZ    WTOBXIT1                   NO - DON'T NEED DOM           02710000
*              LEAVE DESC=1 FOR OPERATOR DELETE VIA K (CONTROL) CMD     02720000
         BALS  R15,SAVEDOM                                              02730000
.NODOM1  AIF   ('&SCON' NE 'NO').SCON4                                  02740000
WTOBXIT1 LM    R2,R10,28(R13)                                           02750000
         AGO   .NOSCON4                                                 02760000
.SCON4   ANOP                                                           02770000
WTOBXIT1 LM    R2,R10,WTOR2                                             02780000
.NOSCON4 AIF   ('&ML' EQ 'NO').NOML5                                    02790000
         TM    WPFLAG,$ML               WHERE IS THE RETURN POINT?      02800000
         BO    WPRTRN2                   +10                            02810000
.NOML5   B     WPRETRN                   +6                             02820000
         DROP  R5,R3                                                    02830000
         DROP  R14                                                      02840000
         SPACE 1                                                        02850000
         WTPVT DSECT,PFX=&PFX,LPFX=&LPFX,SFX=&SFX,LSFX=&LSFX            02860000
         SPACE 1                                                        02870000
WTOBMVC  MVC   4(0,R4),0(R6)            MOVE IN CALLER'S MESSAGE        02880000
         AIF   ('&WTOIN' EQ 'NO').NOWTOIN                               02890000
         SPACE 5                                                        02900000
*              THIS ENTRY POINT IS USED TO COMPLETE A PARTIALLY         02910000
*              CONSTRUCTED WTO.                                         02920000
*              THE CALLER MUST SET THE TEXT INTO WTOMSG AND THE         02930000
*              LENGTH INTO WTOMSGL(FIRST BYTE WILL BE ZEROED BY WTOIN). 02940000
*              CALLING SEQUENCE IS:                                     02950000
         SPACE 1                                                        02960000
*        BALS  R14,WTOIN                                                02970000
*        DC    XL2'DESCRIPTORS'                                         02980000
         SPACE 1                                                        02990000
WTOIN    MVI   WTOMSGL,0                                                03000000
         LA    R1,WTOMSG-4                                              03010000
         AH    R1,WTOMSGL                                               03020000
         MVC   0(2,R1),0(R14)           DESC FROM CALLING SEQUENCE      03030000
         MVC   2(2,R1),ROUTCDE          ROUTCDE=(2,13)                  03040000
         MVC   WTOFLGS(2),WFLAG                                         03050000
         LA    R1,WTOMSGL                                               03060000
         B     2(R14)                                                   03070000
.NOWTOIN AIF   ('&DOM' EQ 'NO').NODOM2                                  03080000
         SPACE 1                                                        03090000
         AIF   ('&DOM' EQ '1').ONEDOM1                                  03100000
SAVEDOM  MVC   DOMTABST,DOMTABLE+4      MAKE ROOM FOR NEW ENTRY         03110000
         AIF   ('&CPU' NE '360').SD370                            *TSM* 03120000
         ST    R1,DOMLAST    SAVE NEW ENTRY                       *TSM* 03130000
         MVI   DOMLAST,X'00'            BYTE0=00                  *TSM* 03140000
         AGO   .ONEDOM2                                           *TSM* 03150000
.SD370   STCM  R1,7,DOMLAST+1           SAVE NEW ENTRY (BYTE0=00)       03160000
         AGO   .ONEDOM2                                                 03170000
.ONEDOM1 ANOP                                                           03180000
SAVEDOM  ST    R1,DOMTABLE              SAVE NEW ENTRY (BYTE0=00)       03190000
.ONEDOM2 BR    R15                                                      03200000
         SPACE 1                                                        03210000
         AIF   ('&DOM' EQ '1').ONEDOM3                                  03220000
DOMITALL LA    R15,DOMTABLE                                             03230000
         LA    R0,4                                                     03240000
         LA    R1,DOMLAST                                               03250000
         OC    1(3,R15),1(R15)                                          03260000
         BNZ   *+10                                                     03270000
         BXLE  R15,R0,*-10                                              03280000
         BR    R14                                                      03290000
         MVI   DOMLAST,X'80'                                            03300000
         DOM   MSGLIST=0(15)                                            03310000
         AGO   .ONEDOM4                                                 03320000
.ONEDOM3 ANOP                                                           03330000
DOMITALL L     R1,DOMTABLE                                              03340000
         DOM   MSG=(1)                                                  03350000
.ONEDOM4 XC    DOMTABLE(DOMTABLN),DOMTABLE                              03360000
         BR    R14                                                      03370000
.NODOM2  SPACE 1                                                        03380000
WFLAG    DC    AL1($MCRTDS,0)           MCSFLAG                         03390000
ROUTCDE  WTLST &ROUTCDE,TYPE=ROUTCDE                                    03400000
         MEND                                                           03410000
./ ADD NAME=WTCLR
         MACRO                                                          00010000
&L       WTCLR &TXT,&FLAG=(PFX,IMM),&DESC=2,&PAD=,                78310*00020000
               &TYPE=BUILD,&MSGSECT=                              78310 00030000
.*       TXT   TEXT TO BE DISPLAYED, DELIMITED BY APOSTROPHES           00040000
.*       NAME  LABEL TO BE GENERATED ON DC                              00050000
.*       FLAG  LIST OF ONE OR MORE OPTIONS:                             00060000
.*             UCMID                    ROUTE TO SPECIFIC CONSOLE       00070000
.*             ML                       MULTI-LINE WTO                  00080000
.*             PFX                      PREFIX '&PFX' FROM WTBLD        00090000
.*                                      SUFFIX '&SFX' FROM WTBLD        00100000
.*             WTOR                     CONSTRUCT WTOR                  00110000
.*             IMM                      ISSUE SVC 35                    00120000
.*       PAD   SPACE TO BE ALLOWED FOLLOWING TEXT                       00130000
.*       DESC  DESCRIPTOR FOR WTO/WTOR                                  00140000
.*                                                                      00150000
.*             AT LEAST ONE OF TXT, NAME MUST BE SPECIFIED              00160000
.*                                                                      00170000
.*       TYPE  TYPE OF OPERATION TO BE PERFORMED:                       00180000
.*             BUILD                    BUILD NEW WTO/WTOR              00190000
.*             EXTEND                   ADD TO EXISTING WTO/WTOR        00200000
         GBLC  &WTOSECT,&MACPLAB                                  82171 00210000
         LCLA  &I,&J,&ILINE,&ITXT                                       00220000
         LCLB  &OPTS(5)                                                 00230000
         LCLC  &LB,&LD,&LP,&LQ                                          00240000
         LCLC  &ALFABET,&LTR                                            00250000
         LCLC  &ENTRY                                                   00260000
         LCLC  &FLAGS(5),&OPTION,&OPTSC                                 00270000
&MACPLAB SETC  '&L'                                               82171 00280000
         AIF   ('&WTOSECT' EQ '').SECTSET                         78310 00290000
         AIF   ('&MSGSECT' EQ '&WTOSECT').SECTOK                  78310 00300000
         AIF   ('&MSGSECT' EQ '').SECTOK                          78310 00310000
         MNOTE 8,'MSGSECT=&MSGSECT INCONSISTENT'                  78310 00320000
         MNOTE 8,'MSGSECT=&WTOSECT PREVIOUSLY SPECIFIED'          78310 00330000
         AGO   .SECTOK                                            78310 00340000
.SECTSET ANOP  ,                                                  78310 00350000
&WTOSECT SETC  '&MSGSECT'                                         78310 00360000
         AIF   ('&WTOSECT' NE '').SECTOK                          78310 00370000
&WTOSECT SETC  'MSGCSECT'                                         78310 00380000
.SECTOK  ANOP  ,                                                  78310 00390000
&ITXT    SETA  1                                                        00400000
&FLAGS(1) SETC 'UCMID'                                                  00410000
&FLAGS(2) SETC 'ML'                                                     00420000
&FLAGS(3) SETC 'WTOR'                                                   00430000
&FLAGS(4) SETC 'PFX'                                                    00440000
&FLAGS(5) SETC 'IMM'                                                    00450000
&ALFABET SETC  'ABCDEFGHIJKLMNOPQRSTUVWXYZ'                             00460000
&LD      SETC  '$'                                                      00470000
&LQ      SETC  'L'''                                                    00480000
.NXTLINE ANOP                                                           00490000
&ILINE   SETA  (&ITXT+1)/2                                              00500000
&LTR     SETC  '&ALFABET'(&ILINE,1)                                     00510000
&OPTSC   SETC  '+$SCON'                                                 00520000
         AIF   ('&SYSLIST(&ITXT)'(1,2) EQ 'S(').NAMEOK                  00530000
&OPTSC   SETC  ''                                                       00540000
&LB      SETC  '&SYSLIST(&ITXT,2)'                                      00550000
         AIF   ('&SYSLIST(&ITXT,2)' NE '').NAMEOK                       00560000
         AIF   ('&SYSLIST(&ITXT)' NE '').GENAME                         00570000
         MNOTE 12,'PARAMETER # &ITXT INVALID'                           00580000
         MNOTE *,'LINE &ILINE MUST SPECIFY EITHER NAME OR TEXT'         00590000
         MEXIT                                                          00600000
.*                                                                      00610000
.GENAME  ANOP                                                           00620000
&LB      SETC  '@&SYSNDX'.'&LTR'                                        00630000
.NAMEOK  AIF   (N'&SYSLIST EQ 1 OR &ITXT GT 1).NOML                     00640000
&OPTS(2) SETB  1                                                        00650000
&OPTION  SETC  '$ML'                                                    00660000
&LP      SETC  '+'                                                      00670000
.NOML    AIF   ('&OPTSC' NE '' OR '&SYSLIST(&ITXT,1)' EQ '').GENOP      00680000
&WTOSECT CSECT ,                                                  78310 00690000
&LB      DC    C&SYSLIST(&ITXT,1)                                       00700000
&SYSECT  CSECT ,                                                  78310 00710000
.GENOP   AIF   (&ITXT GT 1).NOT1ST                                      00720000
         AIF   (&I EQ N'&FLAG).OPTDONE                                  00730000
&I       SETA  &I+1                                                     00740000
&J       SETA  1                                                        00750000
.GENLOOP AIF   ('&FLAG(&I)' EQ '&FLAGS(&J)').SETOPT                     00760000
&J       SETA  &J+1                                                     00770000
         AIF   (&J LE 5).GENLOOP                                        00780000
         MNOTE 12,'&FLAG(&I) IS INVALID OPTION'                         00790000
         MEXIT                                                          00800000
.*                                                                      00810000
.*             CHECK FOR OPTION PREVIOUSLY SET                          00820000
.SETOPT  AIF   (&OPTS(&J)).GENOP                                        00830000
.*             SET OPTION AND FLAG BIT                                  00840000
&OPTION  SETC  '&OPTION'.'&LP'.'&LD&FLAG(&I)'                           00850000
&OPTS(&J) SETB 1                                                        00860000
&LP      SETC  '+'                                                      00870000
         AGO   .GENOP                                                   00880000
.OPTDONE AIF   ('&OPTION' NE '').TESTOPT                                00890000
&OPTION  SETC  '0'                                                      00900000
.*                                                                      00910000
.TESTOPT AIF   (&OPTS(2) AND &OPTS(3)).BUM1ML                           00920000
         AIF   (NOT &OPTS(3) OR '&TYPE' NE 'EXTEND').TESTYPE            00930000
         MNOTE 12,'TYPE=EXTEND ILLEGAL WITH WTOR - TYPE=BUILD ASSUMED'  00940000
&ENTRY   SETC  'WTOBUILD'                                               00950000
         AGO   .BAL                                                     00960000
.BUM1ML  MNOTE 12,'ML ILLEGAL WITH WTOR - MACRO TERMINATED'             00970000
         MEXIT                                                          00980000
.*                                                                      00990000
.TESTYPE ANOP                                                           01000000
&ENTRY   SETC  'WTOEXTND'                                               01010000
         AIF   ('&TYPE' EQ 'EXTEND').BAL                                01020000
&ENTRY   SETC  'WTOBUILD'                                               01030000
         AIF   ('&TYPE' EQ 'BUILD').BAL                                 01040000
         MNOTE 12,'TYPE=&TYPE INVALID - TYPE=BUILD ASSUMED'             01050000
.BAL     AIF   ('&PAD' EQ '' OR '&PAD' EQ '0').NOPAD              82171 01060000
         MACPARM R0,&PAD                                          82171 01070000
&ENTRY   SETC  '&ENTRY'.'+2'                                            01080000
.NOPAD   ANOP                                                           01090000
         MACPARM R14,&ENTRY,OP=BAL                                      01100000
         AIF   ('&TYPE' EQ 'EXTEND').NOT1ST                             01110000
         WTLST &DESC,TYPE=DESC                                          01120000
.NOT1ST  AIF   ('&OPTSC' NE '').DCSCON                                  01130000
         DC    AL1(&LQ.&LB-1,&OPTION&OPTSC)                             01140000
         DC    AL2(&LB-&WTOSECT)                                  78310 01150000
         AGO   .TSTML                                                   01160000
.DCSCON  DC    AL1(0,&OPTION&OPTSC)                                     01170000
         DC    &SYSLIST(&ITXT)                                          01180000
.TSTML   AIF   (NOT &OPTS(2)).BYBY                                      01190000
         WTLTP &SYSLIST(&ITXT+1),&ILINE                                 01200000
.*                                                                      01210000
.BMPITXT ANOP                                                           01220000
&ITXT    SETA  &ITXT+2                                                  01230000
         AIF   (&ITXT LT N'&SYSLIST).NXTLINE                            01240000
         AIF   (&ITXT GT N'&SYSLIST).DONE                               01250000
         MNOTE 12,'NUMBER OF PARAMETERS MUST BE ODD'                    01260000
         MNOTE *,'# &ITXT = &SYSLIST(&ITXT) IGNORED'                    01270000
.DONE    DC    X'FFFF'                                                  01280000
.BYBY    MEND                                                           01290000
./ ADD NAME=WTERM
         MACRO ,                                                 88255  00010000
&LAB     WTERM &AD,&LN,&MODE=EDIT                          ADDED 88150  00020000
         LCLC  &MD,&NM,&MN,&L                                    88255  00030000
         LCLA  &ML                                               88150  00040000
&MN      SETC  'TPUT'                                            88255  00050000
&NM      SETC  '&LAB'                                            88150  00060000
         AIF   ('&AD'(1,1) EQ '''').LIT                          88150  00070000
         AIF   ('&AD'(1,1) EQ '(').REG                           88150  00080000
&NM      LA    R1,&AD        LOAD MESSAGE ADDRESS                88150  00090000
         AGO   .BLN          PROCESS LENGTH OPERAND              88150  00100000
.LIT     ANOP  ,                                                 88150  00110000
&NM      LA    R1,=C&AD      LOAD MESSAGE ADDRESS                88150  00120000
         AIF   ('&LN' NE '').BLN                                 88150  00130000
&ML      SETA  K'&AD-2                                           88150  00140000
         LA    R0,&ML        LOAD MESSAGE LENGTH                 88150  00150000
         AGO   .BCAL                                             88150  00160000
.REG     AIF   ('&AD' EQ '(1)' OR '&AD' EQ '(R1)').LEN           88150  00170000
&NM      LR    R1,&AD(1)     LOAD MESSAGE ADDRESS                88150  00180000
.BLN     ANOP  ,                                                 88150  00190000
&NM      SETC  ''            LABEL ALREADY EXPANDED              88150  00200000
.LEN     AIF   ('&LN' NE '').LNP                                        00210000
&L       SETC  'L'''                                                    00220000
&NM      LA    R0,&L&AD                                                 00230000
         AGO   .BCAL                                                    00240000
.LNP     AIF   ('&LN'(1,1) EQ '(').REGL                          88150  00250000
&NM      LA    R0,&LN        LOAD MESSAGE LENGTH                 88150  00260000
         AGO   .BCAL         PROCESS CALL                        88150  00270000
.REGL    AIF   ('&LN' EQ '(0)' OR '&LN' EQ '(R0)').CALL          88150  00280000
&NM      LR    R0,&LN(1)     LOAD MESSAGE LENGTH                 88150  00290000
.BCAL    ANOP  ,                                                 88150  00300000
&NM      SETC  ''                                                88150  00310000
.CALL    AIF   ('&MODE' EQ 'EDIT' OR '&MODE' EQ 'ASIS' OR              *00320000
                '&MODE' EQ 'CONTROL').MOK                        88150  00330000
         AIF   ('&MODE' EQ 'DARK' OR '&MODE' EQ 'PROMPT').PUTGET 88255  00340000
&MD      SETC  'EDIT'        SET DEFAULT                         88150  00350000
         MNOTE 4,'INVALID MODE OPERAND - &MODE'                  88150  00360000
         AGO   .KALL                                             88150  00370000
.PUTGET  ANOP  ,                                                 88255  00380000
&MN      SETC  'PTGT'        USE PUTGET INSTEAD OF PUTLINE       88255  00390000
.MOK     ANOP  ,                                                 88150  00400000
&MD      SETC  '&MODE'(1,4)  TRUNCATE                            88150  00410000
.KALL    ANOP  ,                                                 88150  00420000
&NM      SUBCALL &MN&MD      PROCESS OUTPUT SERVICE              88255  00430000
         MEND  ,                                                 88255  00440000
./ ADD NAME=WTLST
         MACRO                                                          00001000
&L       WTLST &DUM,&TYPE=DESC                                          00002000
         GBLB  &WTFAIL                                                  00003000
         LCLA  &I,&J,&UNIQUE                                            00004000
         LCLB  &BIT(16)                                                 00005000
         LCLC  &DIGIT                                                   00006000
         AIF   (N'&SYSLIST(1) EQ 0).NOLIST                              00007000
         AIF   (N'&SYSLIST(1) LE 16).LOOP1                              00008000
         MNOTE 12,'&TYPE HAS MORE THAN 16 OPERANDS'                     00009000
.FAIL    ANOP                                                           00010000
&WTFAIL  SETB  1                                                        00011000
         MEXIT                                                          00012000
.NOLIST  MNOTE 12,'&TYPE IS A REQUIRED OPERAND'                         00013000
         AGO   .FAIL                                                    00014000
.NOTNUM  MNOTE 12,'&TYPE.(&I.) MUST BE NUMERIC'                         00015000
         AGO   .FAIL                                                    00016000
.RANGE   MNOTE 12,'&TYPE.(&I.) MUST BE IN THE RANGE 1-16'               00017000
         AGO   .FAIL                                                    00018000
.NOTU    MNOTE 12,'DESCRIPTORS CODES 1-7 MUST BE UNIQUE'                00019000
         AGO   .FAIL                                                    00020000
.LOOP1   ANOP                                                           00021000
&I       SETA  &I+1                                                     00022000
         AIF   (T'&SYSLIST(1,&I) NE 'N').NOTNUM                         00023000
         AIF   (&SYSLIST(1,&I) LE 0 OR &SYSLIST(1,&I) GT 16).RANGE      00024000
&BIT(&SYSLIST(1,&I)) SETB 1                                             00025000
         AIF   (&SYSLIST(1,&I) GT 7 OR '&TYPE' NE 'DESC').END1          00026000
&UNIQUE  SETA  &UNIQUE+1                                                00027000
.END1    AIF   (&I LT N'&SYSLIST(1)).LOOP1                              00028000
         AIF   (&UNIQUE GT 1).NOTU                                      00029000
         AIF   ('&TYPE' NE 'DESC' OR NOT &BIT(8) OR &BIT(9)).OUTOK      00030000
         MNOTE 8,'DESC=8(OUT OF LINE) REQUIRES DESC=9(ID ADDED)'        00031000
         MNOTE *,'DESC=9 ADDED TO LIST - ASSEMBLY CONTINUES'            00032000
&BIT(9)  SETB  1                                                        00033000
.OUTOK   ANOP                                                           00034000
&I       SETA  1                                                        00035000
.LOOP2   ANOP                                                           00036000
&J       SETA  1+8*&BIT(&I)+4*&BIT(&I+1)+2*&BIT(&I+2)+&BIT(&I+3)        00037000
&DIGIT   SETC  '&DIGIT'.'0123456789ABCDEF'(&J,1)                        00038000
&I       SETA  &I+4                                                     00039000
         AIF   (&I LE 16).LOOP2                                         00040000
&L       DC    X'&DIGIT'                                                00041000
         MEND                                                           00042000
./ ADD NAME=WTLTP
         MACRO                                                          00001000
         WTLTP &TYPE,&I                                                 00002000
         AIF   ('&TYPE' EQ 'C').CONTROL                                 00003000
         AIF   ('&TYPE' EQ 'L').LABEL                                   00004000
         AIF   ('&TYPE' EQ 'D').DATA                                    00005000
         AIF   ('&TYPE' EQ 'DE').DEND                                   00006000
         AIF   ('&TYPE' EQ 'E').END                                     00007000
         MNOTE 12,'LINETYPE # &I IS NOT C, L, D, DE, OR E - DE ASSUMED' 00008000
         AGO   .DEND                                                    00009000
.CONTROL DC    XL2'8000'                                                00010000
         MEXIT                                                          00011000
.LABEL   DC    XL2'4000'                                                00012000
         MEXIT                                                          00013000
.DATA    DC    XL2'2000'                                                00014000
         MEXIT                                                          00015000
.DEND    DC    XL2'3000'                                                00016000
         MEXIT                                                          00017000
.END     DC    XL2'1000'                                                00018000
         MEND                                                           00019000
./ ADD NAME=WTPVT
         MACRO                                                          00001000
&L       WTPVT &TYPE,&PFX=,&LPFX=0,&SFX=,&LSFX=0                        00002000
         AIF   ('&TYPE' EQ 'CODE').CODE                                 00003000
         AIF   ('&TYPE' EQ 'DSECT').DSECT                               00004000
         AIF   ('&TYPE' EQ 'AREAID').AREAID                             00005000
         MNOTE 12,'&TYPE INVALID - TYPE MUST BE AREAID, CODE OR DSECT.' 00006000
         MEXIT                                                          00007000
.CODE    ANOP                                                           00008000
         LA    R4,TEXTDISP-4(R4)        ADJUST FOR PFX                  00009000
         AIF   (&LPFX EQ 0).NOPFX                                       00010000
         MVC   4(&LPFX,R5),=C&PFX                                       00011000
.NOPFX   AIF   (&LSFX EQ 0).NOSFX                                       00012000
         MVC   LPFX(&LSFX,R3),=C&SFX                                    00013000
.NOSFX   LA    R3,&LSFX+LPFX(R3)        ADJUST FOR PREFIX/SUFFIX        00014000
         MEXIT                                                          00015000
.DSECT   ANOP                                                           00016000
LPFX     EQU   &LPFX                                                    00017000
TEXTDISP EQU   4+&LPFX                                                  00018000
         MEXIT                                                          00019000
.AREAID  ANOP                                                           00020000
         MVI   WTAREAID,0               L=Z                             00021000
         MEND                                                           00022000
./ ADD NAME=WTU
         MACRO                                                          00010000
&NAME    WTU   &MESG,&MF=I,&ROUTCDE=,&DESC=,&MSGTYP=,&MCSFLAG=,&UCMID=W*00020000
               RKUCMID,&TSO=NO                                          00030000
         GBLB  &IHBWTL,&IHBWTOR                                         00040000
         GBLC  &MACPLAB                                                 00050000
.********************************************************************** 00060000
.*                                                                   ** 00070000
.*   ISSUE MESSAGE AS TPUT UNDER TSO, AND WTO OTHERWISE              ** 00080000
.*     IF STC, USE START CONSOLE UCMID FOR RESPONSES                 ** 00090000
.*                                                                   ** 00100000
.********************************************************************** 00110000
         LCLA  &LT(256),&H,&I,&N,&J,&LEN,&LNUM,&LLCNT            S21002 00120000
         LCLB  &NODFLT                                                  00130000
         LCLB  &B(16),&AD,&E,&E1,&E2,&E3,&E4,&E5,&MCS,&MLW       S21002 00140000
         LCLB  &SECONDL,&SWM,&TWO,&PAIR                          S21002 00150000
         LCLC  &CFLG(16),&CD(16),&GNAME                          S21002 00160000
.*                                                                      00170000
.*       THIS IS A COPY OF IBM'S WTO MACRO - ONLY MODIFICATION          00180000
.*       WAS TO FORCE MCSFLAG=REG0 AND ADDED CODE TO LOAD               00190000
.*       UCMID FROM LABEL WRKUCMID VIA IC                               00200000
.*                                                                      00210000
&GNAME   SETC  'IHB'.'&SYSNDX'                                          00220000
&MACPLAB SETC  '&NAME'                                                  00230000
         AIF    ('&MF' EQ 'I' OR '&MF' EQ 'L').NUMCHK            S21002 00240000
         AIF   (N'&MF NE 2).E1                                          00250000
         AIF   ('&MF(1)' NE 'E').E1                                     00260000
&NAME    IHBINNRA &MF(2)                                                00270000
&MACPLAB SETC  ''                                                90014  00280000
         AIF   (&IHBWTL).END                                            00290000
.*       SVC   35                                ISSUE SVC              00300000
         AGO   .UCMSVC                                                  00310000
.NUMCHK  ANOP                                                    S21002 00320000
         AIF   (N'&SYSLIST LE 1).LABLL                            66488 00330000
         AIF   ('&SYSLIST(1)'(1,1) EQ '(').LABLL                  66488 00340000
         MNOTE 8,'MLWTO MSG LINES NOT ENCLOSED IN PARENTHESES'    66488 00350000
         AGO   .END                                               66488 00360000
.LABLL   AIF   (N'&SYSLIST EQ 0 OR N'&SYSLIST GT 10).NOTXT        66488 00370000
         AIF   ('&MF' EQ 'I').IROUT                              S21002 00380000
.LROUT   AIF   (&IHBWTOR).MESCHK                                        00390000
&NAME    DS    0H                                                       00400000
&MACPLAB SETC  ''                                                90014  00410000
.MESCHK  ANOP                                                           00420000
&I       SETA  1                                                        00430000
&MCS     SETB  (T'&ROUTCDE NE'O' OR T'&MSGTYP NE 'O' )                  00440000
&B(3)    SETB  0                                                   MCS  00450000
         AIF   ('&MESG' EQ '').NOTXT                             S21002 00460000
&MLW     SETB  (N'&SYSLIST NE 1 OR N'&SYSLIST(1) NE 1)           S21002 00470000
         AIF   (&IHBWTOR AND &MLW).MLWTOR                        S21002 00480000
         AIF   (T'&DESC EQ 'O').SETNCLR                                 00490000
&MCS     SETB  1                                                        00500000
.*                                                                      00510000
.*  DESCRIPTOR CODES                                                    00520000
.*                                                                      00530000
.DCHK    ANOP                                                           00540000
&N       SETA  &DESC(&I)                                                00550000
&I       SETA  &I+1                                                     00560000
         AIF   (&N GE 1 AND &N LE 16).ASSIGND                           00570000
         MNOTE 8,'&DESC(&I-1) IS INVALID DESCRIPTOR- IGNORED'     67737 00580000
         AGO   .NXTD                                                    00590000
.ASSIGND ANOP                                                           00600000
&B(&N)   SETB  1                                                        00610000
.NXTD    AIF   (&I LE N'&DESC).DCHK                                     00620000
&I       SETA  1                                                        00630000
         AGO   .SETNCLR                                                 00640000
.*                                                                      00650000
.*  ROUTE CODES                                                         00660000
.*                                                                      00670000
.RTCHK   AIF   (T'&ROUTCDE NE 'O').RCHK0                                00680000
.DEFLAG  ANOP                                                           00690000
&I       SETA  3                                                        00700000
         AIF   (&J EQ N'&MCSFLAG OR T'&MCSFLAG EQ 'O').DODEF            00710000
&J       SETA  &J+1                                                     00720000
         AIF   ('&MCSFLAG(&J)' EQ 'REG0' OR '&MCSFLAG(&J)' EQ 'QREG0').*00730000
               SETNCLR                                                  00740000
         AGO   .DEFLAG                                                  00750000
.DODEF   ANOP                                                           00760000
         AIF   (T'&MSGTYP NE 'O').SETNCLR                         68508 00770000
         AIF   (T'&UCMID NE 'O').SETNCLR                                00780000
&B(2)    SETB  (&MCS)                                                   00790000
&I       SETA  3                                                        00800000
         AGO   .SETNCLR                                                 00810000
.*                                                                      00820000
.RCHK0   ANOP                                                           00830000
.RCHK    ANOP                                                           00840000
&N       SETA  &ROUTCDE(&I)                                             00850000
&I       SETA  &I+1                                                     00860000
         AIF   (&N GE 1 AND &N LE 16).ASSIGNR                           00870000
         MNOTE 8,'ROUTCDE(&I-1) IS INVALID ROUTE- IGNORED'        66111 00880000
         AGO   .NXTR                                                    00890000
.ASSIGNR ANOP                                                           00900000
&NODFLT  SETB  (&NODFLT OR &N NE 16)                                    00910000
&B(&N)   SETB  1                                                        00920000
.NXTR    AIF   (&I LE N'&ROUTCDE).RCHK                                  00930000
&I       SETA  3                                                        00940000
&B(2)    SETB  (&B(2) OR NOT &NODFLT)                                   00950000
&NODFLT  SETB  0                                                        00960000
&B(16)   SETB  0                                                        00970000
.NOT11   ANOP                                                           00980000
.*                                                                      00990000
.*  SET OUTPUT AREAS AND CLEAR BINARY FLAGS                             01000000
.*                                                                      01010000
.SETNCLR ANOP                                                           01020000
&CD(&I)  SETC  '&B(1)&B(2)&B(3)&B(4)&B(5)&B(6)&B(7)&B(8)'               01030000
&CD(&I+1) SETC '&B(9)&B(10)&B(11)&B(12)&B(13)&B(14)&B(15)&B(16)'        01040000
&N       SETA  1                                                        01050000
.CLR     ANOP                                                           01060000
&B(&N)   SETB  0                                                        01070000
&N       SETA  &N+1                                                     01080000
         AIF   (&N LT 17).CLR                                           01090000
         AIF   (&I EQ 1).RTCHK                                          01100000
         AIF   (&I EQ 5).FLGCHK0                                        01110000
         AIF   (&I EQ 7).GENDCS                                  S21002 01120000
.*                                                                      01130000
.*  MESSAGE TYPES                                                       01140000
.*                                                                      01150000
.TYPCHK  AIF   (T'&MSGTYP EQ 'O').FLGCHK0                               01160000
         AIF   ('&MSGTYP(1)' EQ 'N').FLGCHK0                            01170000
&SWM     SETB  1                                                 S21002 01180000
&I       SETA  5                                                        01190000
&N       SETA  1                                                        01200000
         AIF   ('&MSGTYP(1)' EQ 'Y').SETNCLR                            01210000
&I       SETA  1                                                        01220000
.*                                                                      01230000
&CFLG(1) SETC  'JOBNAMES'                                               01240000
&CFLG(2) SETC  'STATUS'                                                 01250000
&CFLG(3) SETC  'ACTIVE'                                          S21002 01260000
&CFLG(4) SETC  ''                                                S21002 01270000
&CFLG(5) SETC  'SHOW'                                              CRJE 01280000
&CFLG(6) SETC  'SESS'                                            20034  01290000
.*                                                                      01300000
.TCHK    AIF   ('&MSGTYP(&I)' EQ '&CFLG(&N)').SETTYP                    01310000
&N       SETA  &N+1                                                     01320000
         AIF   (&N LE 8).TCHK                                           01330000
         MNOTE 8,'MESSAGE TYPE FIELD INVALID- N IS ASSUMED'             01340000
&N       SETA  1                                                 S21002 01350000
&I       SETA  5                                                 S21002 01360000
&SWM     SETB  0                                                 S21002 01370000
         AGO   .CLR                                              S21002 01380000
         AGO   .FLGCHK0                                                 01390000
.SETTYP  AIF   ('&CFLG(&N)' EQ '').ADDIT                                01400000
&B(&N)   SETB 1                                                         01410000
.ADDIT   ANOP                                                           01420000
&I       SETA  &I+1                                                     01430000
&N       SETA  1                                                        01440000
         AIF   (&I LE N'&MSGTYP).TCHK                                   01450000
&I       SETA  5                                                        01460000
         AGO   .SETNCLR                                                 01470000
.*                                                                      01480000
.*  MCSFLAGS                                                            01490000
.*                                                                      01500000
.FLGCHK0 ANOP                                                           01510000
&MCS    SETB  (T'&ROUTCDE NE 'O' OR T'&MSGTYP NE 'O' OR T'&DESC NE 'O') 01520000
.*                                                               S21002 01530000
&B(1)    SETB  (&MCS)                                                   01540000
         AIF   (T'&UCMID EQ 'O').NOUCMFG                                01550000
&B(2)    SETB  1             SET UCMID FLAG                             01560000
.NOUCMFG ANOP                                                           01570000
&B(4)    SETB  (&SWM)                                                   01580000
&B(10)   SETB  (&MLW)              THIS IS MLWTO LIST            S21002 01590000
&I       SETA  7                                                        01600000
         AIF   (T'&MCSFLAG EQ 'O').SETNCLR                              01610000
&I       SETA  1                                                        01620000
&N       SETA  1                                                        01630000
.*                                                                      01640000
&CFLG(1) SETC  'REG0'                                                   01650000
&CFLG(2) SETC  'RESP'                                                   01660000
&CFLG(3) SETC  ''                                                       01670000
&CFLG(4) SETC  'REPLY'                                                  01680000
&CFLG(5) SETC  'BRDCST'                                                 01690000
&CFLG(6) SETC  'HRDCPY'                                                 01700000
&CFLG(7) SETC  'QREG0'                                                  01710000
&CFLG(8) SETC  'NOTIME'                                                 01720000
&CFLG(13) SETC 'NOCPY'                                                  01730000
.*                                                                      01740000
.FLGCHK  AIF   ('&MCSFLAG(&I)' EQ '&CFLG(&N)').SETFLG                   01750000
&N       SETA  &N+1                                                     01760000
         AIF   (&N LE 15).FLGCHK                                        01770000
         MNOTE 8,'&MCSFLAG(&I) IS INVALID- IGNORED'                     01780000
         AGO   .ADDI                                                    01790000
.SETFLG  AIF   ('&CFLG(&N)' EQ '').ADDI                                 01800000
         AIF   ('&CFLG(&N)' NE 'HRDCPY').HDCYOK               BE A52575 01810000
         AIF   (NOT &MLW).HDCYOK                              BE A52575 01820000
         IHBERMAC 248                                         BE A52575 01830000
&GNAME.A DS    0H                                                       01840000
         MEXIT                                                          01850000
.HDCYOK  ANOP                                                 BE A52575 01860000
&B(&N+1) SETB  1                                                        01870000
.ADDI    ANOP                                                           01880000
&I       SETA  &I+1                                                     01890000
&N       SETA  1                                                        01900000
         AIF   (&I LE N'&MCSFLAG).FLGCHK                                01910000
         AIF   (&B(7) AND &B(14)).MUTEXC  THESE PARAM MUTUALLY EXCLUSIV 01920000
.*                                      HARDCOPY AND NO HARD COPY       01930000
         AGO   .SETTER                                                  01940000
.MUTEXC  ANOP                                                           01950000
&B(14)   SETB  0                                                        01960000
         MNOTE 8,'HRDCPY AND NOCPY MUTUALLY EXCLUSIVE, HRDCPY ASSUMED'  01970000
.SETTER  ANOP                                                           01980000
&I       SETA  7                                                        01990000
         AGO   .SETNCLR                                                 02000000
.IROUT   AIF   (&IHBWTOR).MESCHK                                        02010000
         CNOP  0,4                                                      02020000
&NAME    BAL   1,&GNAME.A                        BRANCH AROUND MESSAGE  02030000
&MACPLAB SETC  ''                                                90014  02040000
         AGO   .MESCHK                                                  02050000
.*                                                               S21002 02060000
.*  * *  SET LINETYPE  * * * * *                                 S21002 02070000
.*                                                               S21002 02080000
.GENDCS  AIF   (NOT &MLW).NOTMLW1  GENERATE REGULAR WTO          S21002 02090000
&H       SETA  1                                                 S21002 02100000
         AIF   ('&SYSLIST(1,1)' EQ '').MLW04                     S21002 02110000
         AIF   (N'&SYSLIST(1) GT 2).MLW05                        S21002 02120000
         AIF   ('&SYSLIST(1,2)' NE 'C').MLW02                    S21002 02130000
&LT(1)   SETA  80                                                S21002 02140000
.MLW01   AIF   (N'&SYSLIST LE &H).MLW11                          S21002 02150000
&H       SETA  &H+1                                              S21002 02160000
         AIF   (N'&SYSLIST(&H) GT 2).MLW05                       S21002 02170000
.MLW02   AIF   ('&SYSLIST(&H,2)' NE 'L' OR '&SYSLIST(&H,1)' EQ '').MLW0X02180000
               4                                                 S21002 02190000
&LT(&H)  SETA  40                                                S21002 02200000
         AIF   (&SECONDL).MLW03                                  S21002 02210000
&SECONDL SETB  1                                                 S21002 02220000
         AGO   .MLW01                                            S21002 02230000
.MLW03   AIF   (N'&SYSLIST LE &H).MLW11                          S21002 02240000
&H       SETA  &H+1                                              S21002 02250000
         AIF   (N'&SYSLIST(&H) GT 2).MLW05                       S21002 02260000
.MLW04   AIF   ('&SYSLIST(&H,2)' EQ 'E').MLW06                   S21002 02270000
         AIF   ('&SYSLIST(&H,1)' EQ '').MLW05                    S21002 02280000
         AIF   ('&SYSLIST(&H,2)' EQ 'DE').MLW08                  S21002 02290000
         AIF   ('&SYSLIST(&H,2)' EQ 'L' OR '&SYSLIST(&H,2)' EQ 'C').MLWX02300000
               09                                                S21002 02310000
         AIF   ('&SYSLIST(&H,2)' NE 'D' AND '&SYSLIST(&H,2)' NE '').MLW*02320000
               10                                                S21002 02330000
&LT(&H)  SETA  20                                                S21002 02340000
         AGO   .MLW03                                            S21002 02350000
.MLW05   ANOP                                                    S21002 02360000
&E5      SETB  1                                                 S21002 02370000
&LT(&H)  SETA  10                                                S21002 02380000
         AGO   .MLW11                                            S21002 02390000
.MLW06   ANOP                                                    S21002 02400000
&LT(&H)  SETA  10                                                S21002 02410000
.MLW07   ANOP                                                    S21002 02420000
&E4      SETB  (&H NE N'&SYSLIST)                                S21002 02430000
         AGO   .MLW11                                            S21002 02440000
.MLW08   ANOP                                                    S21002 02450000
&LT(&H)  SETA  30                                                S21002 02460000
         AGO   .MLW07                                            S21002 02470000
.MLW09   ANOP                                                    S21002 02480000
&E3      SETB  1                                                 S21002 02490000
&LT(&H)  SETA  30                                                S21002 02500000
         AGO   .MLW11                                            S21002 02510000
.MLW10   ANOP                                                    S21002 02520000
&E5      SETB  1                                                 S21002 02530000
&LT(&H)  SETA  30                                                S21002 02540000
.MLW11   ANOP                                                    S21002 02550000
&LLCNT   SETA  &H                                                S21002 02560000
&H       SETA  1                                                 S21002 02570000
.NOTMLW1 ANOP                                                    S21002 02580000
&I       SETA  1                                              MA S21002 02590000
&LEN     SETA  K'&SYSLIST(1,1)-2                              MA S21002 02600000
&PAIR    SETB  0                                              MA S21002 02610000
.QLOOP1  ANOP                                                 MA S21002 02620000
&I       SETA  &I+1+&PAIR                                     MA S21002 02630000
         AIF   (&I GE K'&SYSLIST(1,1)).QDONE1                 MA S21002 02640000
&PAIR    SETB  ('&SYSLIST(1,1)'(&I,2) EQ '''''' OR '&SYSLIST(1,1)'(&I,2*02650000
               ) EQ '&&')                                               02660000
&LEN     SETA  &LEN-&PAIR                                     MA S21002 02670000
         AGO   .QLOOP1                                        MA S21002 02680000
.QDONE1  ANOP                                                 MA S21002 02690000
&AD      SETB  (&LT(1) NE 10)      0 IF E-TYPE LINE, 1 IF NOT MA S21002 02700000
&LEN     SETA  4+&LEN*&AD                                     MA S21002 02710000
         DC    AL2(&LEN)           TEXT LENGTH                          02720000
         DC    B'&CD(7)&CD(8)'     MCS FLAGS                            02730000
         AIF   (&LEN EQ 4).SKIPDC                                S21002 02740000
         DC    C&SYSLIST(1,1)                                           02750000
.SKIPDC  AIF   (NOT &MCS).OLDEXIT                                S21002 02760000
         DC    B'&CD(1)&CD(2)'     DESCRIPTOR CODES                     02770000
         DC    B'&CD(3)&CD(4)'     ROUTING CODES                        02780000
         AIF   ('&MSGTYP(1)' NE 'Y' AND NOT &SWM).OLDEXIT        S21002 02790000
         DC    B'&CD(5)&CD(6)'     MESSAGE TYPE                         02800000
.OLDEXIT AIF   (NOT &MLW).NOTMLW2                                S21002 02810000
         DC    XL2'&LT(1)00'       LINE TYPE                            02820000
         DC    AL2(&LLCNT)         TOTAL NUMBER OF LINES                02830000
.MLW12   AIF   (&H GE &LLCNT).MLW14                              S21002 02840000
&H       SETA  &H+1                                              S21002 02850000
&I       SETA  1                                              MA S21002 02860000
&LEN     SETA  K'&SYSLIST(&H,1)-2                             MA S21002 02870000
&PAIR    SETB  0                                              MA S21002 02880000
.QLOOPH  ANOP                                                 MA S21002 02890000
&I       SETA  &I+1+&PAIR                                     MA S21002 02900000
         AIF   (&I GE K'&SYSLIST(&H,1)).QDONEH                MA S21002 02910000
&PAIR    SETB  ('&SYSLIST(&H,1)'(&I,2) EQ '''''' OR '&SYSLIST(&H,1)'(&I*02920000
               ,2) EQ '&&')                                             02930000
&LEN     SETA  &LEN-&PAIR                                     MA S21002 02940000
         AGO   .QLOOPH                                        MA S21002 02950000
.QDONEH  ANOP                                                 MA S21002 02960000
&AD      SETB  (&LT(&H) NE 10)     0 IF E-TYPE LINE, 1 IF NOT MA S21002 02970000
&LEN     SETA  4+&LEN*&AD                                     MA S21002 02980000
         DC    AL2(&LEN)           LENGTH                               02990000
         DC    XL2'&LT(&H)00'      LINE TYPE                            03000000
         AIF   (&LEN EQ 4).MLW12                                 S21002 03010000
         DC    C&SYSLIST(&H,1)                                          03020000
         AGO   .MLW12                                            S21002 03030000
.MLW14   AIF   (NOT &E4).MLW15                                   S21002 03040000
         IHBERMAC 242                                         MB  M1428 03050000
.MLW15   AIF   (NOT &E5).MLW17                                   S21002 03060000
         IHBERMAC 243                                         MB  M1428 03070000
.MLW17   AIF   (NOT &E3).NOTMLW2                                 S21002 03080000
         IHBERMAC 244                                         MB  M1428 03090000
.NOTMLW2 AIF   (&IHBWTOR OR '&MF' NE 'I').END                    S21002 03100000
.MLWHC   ANOP                                                 BE A52575 03110000
&GNAME.A DS    0H                                                       03120000
         AIF   (&E3 OR &IHBWTL).END                              S21002 03130000
.UCMSVC  AIF   (T'&UCMID EQ 'O').DOSVC                                  03140000
         AIF   ('&UCMID'(1,1) EQ '(').NOSR                              03150000
&MACPLAB SLR   R0,R0         CLEAR IC REGISTER                   90014  03160000
&MACPLAB SETC  ''                                                90014  03170000
.NOSR    MACPARM R0,&UCMID,OP=IC                                        03180000
         AIF   ('&TSO' EQ 'NO').DOSVC                                   03190000
&MACPLAB LA    R15,255       MAX UCMID                                  03200000
         CR    R0,R15        MAX ?                                      03210000
         BL    *+22          SKIP TPUT CODE                             03220000
         LH    R0,0(,R1)     LOAD LENGTH+4                              03230000
         SH    R0,*+6        ACTUAL LENGTH                              03240000
         LA    R1,4(R1,0)    TEXT START                                 03250000
         SVC   93            TPUT                                       03260000
         B     *+6           BRANCH AROUND WTO                          03270000
.DOSVC   ANOP  ,                                                        03280000
&MACPLAB SVC   35                                                       03290000
         MEXIT                                                   S21002 03300000
.E1      IHBERMAC 35,,&MF                                               03310000
         MEXIT                                                          03320000
.NOTXT   ANOP                                                    S21002 03330000
         IHBERMAC 245                                         MB  M1428 03340000
         MEXIT                                                   S21002 03350000
.MLWTOR  IHBERMAC 246                                         MB  M1428 03360000
.END     MEND                                                           03370000
./ ADD NAME=WTWRK
         MACRO                                                          00002000
&L       WTWRK &DUMMY,&MSGLEN=125,&REPLYLN=5,&NUMDOM=5,&ML=YES,        *00004000
               &SCON=NO                                                 00006000
         AIF   (&NUMDOM EQ 0).NODOM                                     00008000
DOMTABLE DS    (&NUMDOM)A          IDS TO BE DELETED AFTER REPLY        00010000
DOMTABLN EQU   4*&NUMDOM           LENGTH IN BYTES OF DOM ID TABLE      00012000
DOMTABST EQU   DOMTABLE,DOMTABLN-4 FIRST N-1 ENTRIES IN DOM ID TABLE    00014000
DOMLAST  EQU   *-4,4,C'A'          LAST ID IN DOM TABLE           78117 00016000
.NODOM   AIF   ('&ML' EQ 'NO').NOML                                     00018000
DESCPTR  DS    A                   SAVE ADDR OF DESC - USED FOR MLWTO   00020000
.NOML    AIF   ('&SCON' EQ 'NO').NOSCON                                 00022000
WTOREGS  DS    0F                  SAVE AREA IF SCONS ALLOWED           00024000
WTOR0    DS    F                                                        00026000
WTOR1    DS    F                                                        00028000
WTOR2    DS    F                                                        00030000
WTOR3    DS    F                                                        00032000
WTOR4    DS    F                                                        00034000
WTOR5    DS    F                                                        00036000
WTOR6    DS    F                                                        00038000
WTOR7    DS    F                                                        00040000
WTOR8    DS    F                                                        00042000
WTOR9    DS    F                                                        00044000
WTOR10   DS    F                                                        00046000
WTOR11   DS    F                                                        00048000
WTOR12   DS    F                                                        00050000
WTOR13   DS    F                                                        00052000
WTOR14   DS    F                                                        00054000
WTOR15   DS    F                                                        00056000
WTOLA    LA    R6,0(,R15)                                               00058000
.NOSCON  ANOP                                                           00060000
WTORAREA DS    0C                  INCLUDES REPLY AREA AND ECB          00062000
REPLY    DS    CL(&REPLYLN)                                             00064000
WTORECB  DS    F                                                        00066000
WTOAREA  DS    0C                  OVERLAY WTOS HERE                    00068000
WTOR     DS    0C                                                       00070000
WTORRPLY DS    AL4                 LENGTH OF REPLY AREA AND ITS ADDR    00072000
WTORECBA DS    AL4                 ADDRESS OF WTOR ECB                  00074000
WTORMSGL DS    AL2                                                      00076000
WTORFLGS DS    AL2                                                      00078000
WTORL    EQU   *-WTORAREA          AMOUNT TO ZERO                       00080000
WTORMSG  DS    CL60                MAX MSG LENGTH                       00082000
WTORROUT DS    CL4                                                      00084000
         ORG   WTOAREA             OVERLAY FOR WTOS                     00086000
WTO      DS    0C                                                       00088000
WTOMSGL  DS    AL2                 1ST BYTE IS 0 FOR WTO                00090000
WTOFLGS  DS    AL2                                                      00092000
WTOL     EQU   *-WTOAREA           AMOUNT TO ZERO                       00094000
WTOMSG   DS    CL(&MSGLEN)         MAX LENGTH OF WTO MSG                00096000
WTOROUT  DS    CL4                                                78117 00098000
         ORG                                                            00100000
         SPACE 1                                                        00102000
*              WTO PREFIX - END OF WTOR PREFIX                          00104000
WT1      DSECT                                                          00106000
WTLENGTH DS    Y                        LENGTH INCLUDING WTO PREFIX     00108000
WTFLAG   DS    XL2                      MCS FLAGS FOR FIRST LINE        00110000
$MCRTDS  EQU   128                      ROUTCDE/DESC FIELDS EXIST       00112000
$MCREG0  EQU   64                                                       00114000
$MCRESP  EQU   32                                                       00116000
$MCREPLY EQU   8                                                        00118000
$MCBRDCS EQU   4                                                        00120000
$MCHRDCP EQU   2                                                        00122000
$MCQREG0 EQU   1                                                        00124000
$MCNOTIM EQU   128                                                      00126000
$MCMLWTO EQU   64                                                       00128000
$MCNOCPY EQU   4                                                        00130000
WTLINTP2 EQU   WTFLAG,2,C'X'            LINE TYPE FOR SUBSEQUENT L78117 00132000
WTTEXT   EQU   *,1,C'C'                                           78117 00134000
         SPACE 1                                                        00136000
WT2      DSECT                                                          00138000
*              PORTION OF WTO FOLLOWING TEXT                            00140000
WTDESC   DS    XL2                      DESCRIPTOR FOR FIRST LINE       00142000
$DSSYSFA EQU   128                                                      00144000
$DSIMMAC EQU   64                                                       00146000
$DSEVNAC EQU   32                                                       00148000
$DSSYSST EQU   16                                                       00150000
$DSIMMCR EQU   8                                                        00152000
$DSJOBST EQU   4                                                        00154000
$DSAPPLP EQU   2                                                        00156000
$DSOUTLN EQU   1                                                        00158000
$DSDISMN EQU   128                      ID TO BE PUT INTO CONTROL LINE  00160000
WTROUT   DS    XL2                                                      00162000
WTLINTYP DS    XL2                      LINE TYPE FOR FIRST LINE        00164000
$LTC     EQU   128                      CONTROL LINE                    00166000
$LTL     EQU   64                       LABEL   LINE                    00168000
$LTD     EQU   32                       DATA    LINE                    00170000
$LTE     EQU   16                       END     LINE                    00172000
WTAREAID DS    X                                                        00174000
WTNUMLIN DS    X                                                        00176000
         SPACE 1                                                        00178000
WTPRM    DSECT                                                          00180000
WPDESC   DS    XL2                                                      00182000
WPTXLENG DS    AL1                      TEXT LENGTH-1 FOR MVC           00184000
WPFLAG   DS    X                                                        00186000
$UCMID   EQU   128                      ROUTE TO SPECIFIC CONSOLE       00188000
$ML      EQU   64                       ANOTHER LINE FOLLOWS            00190000
$WTOR    EQU   32                                                       00192000
$PFX     EQU   16                                                       00194000
$IMM     EQU   8                                                        00196000
$SCON    EQU   4                                                        00198000
$TPUT    EQU   2                                                        00200000
WPTXDISP DS    Y                        OFFSET TO TEXT FROM MSGCSECT    00202000
WPRETRN  EQU   *                                                        00204000
WPLINTYP DS    XL2                                                      00206000
WPSTOPER DS    XL2                                                      00208000
WPRTRN2  EQU   *                                                        00210000
&SYSECT  DSECT                                                          00212000
         MEND                                                           00214000
./ ADD NAME=X4050
         MACRO ,                                                        00010000
&NM      X4050 &JDE=DUPLEX,&JDL=DFAULT,                 ADDED ON 89143 *00020000
               &PAPER=LETTER,&FEED=MAIN,&MAXLEN=150,                   *00030000
               &PMODE=LAND,&DUPLEX=YES,&SEP=WIDE,                      *00040000
               &OVERFIX=YES,&CHARS=,&HCOUNT=1,&TCOUNT=1,&FLASH=,       *00050000
               &PREJES2=0,&PRESAM=0,&POSTJES=0,&POSTSAM=0,&MF=D         00060000
.********************************************************************** 00070000
.*                                                                   ** 00080000
.*   MACRO TO DEFINE/CORRELATE XEROX 4050 DJDE SETUP                 ** 00090000
.*     USED BY LOCAL JES2 MODS AND LOCAL WRITER ROUTINES             ** 00100000
.*                                                                   ** 00110000
.********************************************************************** 00120000
         LCLB  &B0,&B1,&B2,&B3,&B4,&B5,&B6,&B7                          00130000
         LCLB  &B8,&B9,&B10,&B11,&B12,&B13,&B14,&B15                    00140000
&B0      SETB  ('&OVERFIX' EQ 'YES')                                    00150000
&B1      SETB  ('&CHARS' EQ 'DUMP')                              89302  00160000
&B4      SETB  ('&SEP' EQ 'NARROW')                              89157  00170000
&B8      SETB  ('&DUPLEX' EQ 'YES')                                     00180000
&B12     SETB  ('&PMODE' EQ 'PORTRAIT')                                 00190000
         AIF   ('&MF' EQ 'D').MAP                                       00200000
.*                                                                      00210000
&NM      START 0             BEGIN DEFINITION MODULE                    00220000
         DC    B'&B0&B1&B2&B3&B4&B5&B6&B7'                              00230000
         DC    B'&B8&B9&B10&B11&B12&B13&B14&B15'                        00240000
         DC    B'0'                                                     00250000
         DC    B'0'                                                     00260000
         DC    B'0'                                                     00270000
         DC    B'0'                                                     00280000
         DC    AL1(&MAXLEN)                                      89157  00290000
         DC    AL1(&HCOUNT*16+&TCOUNT)                           89157  00300000
         DC    A(&NM+40,&PREJES2,&POSTJES,&PRESAM,&POSTSAM)             00310000
         DC    3A(0)         SPARES                                     00320000
         DC    CL8'&JDL ',CL8'&JDE ',CL8'&PAPER '                       00330000
         DC    CL8'&FEED ',CL8'&FLASH '                          89355  00340000
         MEXIT ,                                                        00350000
.MAP     ANOP  ,                                                        00360000
X4DSECT  DSECT ,                                                        00370000
X4F1     DS    X             LOCAL GOODIES                              00380000
X4FOFIX  EQU   X'80'           FIX OVERPRINT TO DARKEN OUTPUT           00390000
X4FODUMP EQU   X'40'           FIX CHARS=DUMP OUTPUT             89302  00400000
X4FCARD  EQU   X'08'           80-BYTE SEPARATOR MODE            89157  00410000
X4F2     DS    X             RENDITION                                  00420000
X4FDUPX  EQU   X'80'           DUPLEX (0=SIMPLEX)                       00430000
X4FPORT  EQU   X'08'           PORTRAIT (0=LANDSCAPE)                   00440000
X4F3     DS    X                                                        00450000
X4F4     DS    X                                                        00460000
X4F5     DS    X                                                        00470000
X4MAXLEN DS    AL1(&MAXLEN)     MAX WIDTH TO PROCESS             89157  00480000
X4HEAD#  DS    AL1(&HCOUNT*16+&TCOUNT)   HEADER/TRAILER PAGES    89157  00490000
X4@SET   DS    A             ADDRESS OF BASIC SETUP TEXT                00500000
X4@PREJ  DS    A             ADDRESS OF JES2 PREFIX                     00510000
X4@POSJ  DS    A             ADDRESS OF JES2 POST-AMBLE                 00520000
X4@PRES  DS    A             ADDRESS OF SAM PREFIX (ON-LINE)            00530000
X4@POSS  DS    A             ADDRESS OF SAM POST-AMBLE                  00540000
         DS    3A            SPARES                              89143  00550000
*        FLOATING SETUP                                          89143  00560000
X4JDLSCT DSECT ,                                                GP99354 00570000
X4JDL    DS    CL8           JDL/JSL                             89143  00580000
X4JDE    DS    CL8           JDE WITHIN JDL                      89143  00590000
X4PAPER  DS    CL8           TYPE OF PAPER                       89143  00600000
X4FEED   DS    CL8           FEED MODE                           89143  00610000
X4FLASH  DS    CL8           FORMS FLASH (IBM CL4, XEROX CL6)    89355  00620000
*        OPTIONAL SETUP COMMANDS                                 89143  00630000
X4CMDSCT DSECT ,                                                GP99354 00640000
X4CMD    DS    X             COMMAND LENGTH                             00650000
X4CFG    DS    X             COMMAND FLAGS                              00660000
X4CTX    DS    0C            COMMAND TEXT                               00670000
         MEND  ,                                                        00680000
./ ADD NAME=X4CMD
         MACRO ,                                                        00010000
&NM      X4CMD &TEXT,&ACTION=XEROX                               89143  00020000
         LCLA  &K                                                       00030000
         LCLB  &F0,&F1,&F2,&F3,&F4,&F5,&F6,&F7                          00040000
         AIF   ('&TEXT' EQ '*END').NULL                          89143  00050000
&F7      SETB  ('&ACTION' EQ 'XEROX' OR '&ACTION' EQ 'WTO')      89160  00060000
&F6      SETB  ('&ACTION' EQ 'TEXT' OR '&ACTION' EQ 'WTO')       89160  00070000
&K       SETA  K'&TEXT                                                  00080000
         AIF   (&K LT 2).NOQ                                            00090000
         AIF   ('&TEXT'(1,1) NE '''').NOQ                               00100000
         AIF   ('&TEXT'(&K,1) NE '''').NOQ                              00110000
&K       SETA  &K-2                                                     00120000
         AIF   (&K LT 1).NULL                                    89143  00130000
&NM      DC    AL1(&K),B'&F0&F1&F2&F3&F4&F5&F6&F7',C&TEXT               00140000
         MEXIT ,                                                        00150000
.NOQ     AIF   (&K LT 1).NULL                                    89143  00160000
&NM      DC    AL1(&K),B'&F0&F1&F2&F3&F4&F5&F6&F7',C'&TEXT'             00170000
         MEXIT ,                                                 89143  00180000
.NULL    ANOP  ,                                                 89143  00190000
&NM      DC    AL1(&K),B'&F0&F1&F2&F3&F4&F5&F6&F7'                      00200000
         MEND  ,                                                        00210000
./ ADD NAME=XCURCON
         MACRO ,                                                        00010000
&NM      XCURCON &XOFF=0,&YOFF=0,&ERR=,&XINT=2,&YINT=1,&XMAX=,&YMAX=,  *00020000
               &XFUZZ=0,&YFUZZ=0,                                      *00030000
               &FLAGS=FDWPROFG,&FBIT=FDWPFCUR,&VAL=FDWCUR   NEW GP13105 00040000
.*                                                                      00050000
.*   XCURCON ALLOWS THE USER TO PLACE THE CURSOR AT A SCREEN LOCATION   00060000
.*   AND HIT ENTER. THE MACRO EITHER BRANCHES TO THE 'ERR' LABEL,       00070000
.*   OR ENDS WITH AN X OFFSET IN R3 AND A Y OFFSET IN R1 (REL. TO 0).   00080000
.*     (FLAG AND CURSOR DEFAULTS SET FOR SCLINE SERVICE)                00090000
.*                                                                      00100000
.*   &VAL   - THE CURSOR ADDRESS SUITABLE FOR THE NEXT WRITE            00110000
.*   &FLAGS - CONTROL BYTE SET ON FOR A MINIMAL VALID ADDRESS           00120000
.*   &FBIT  - CONTROL BIT INDICATING A CURSOR ADDRESS PROCESSED         00130000
.*   &ERR   - LABEL FOR ERROR (CURSOR NOT IN TARGET RECTANGLE)          00140000
.*   &XOFF  - MINIMUM X OFFSET IN SCREEN LINE (DEFAULT IS 0)            00150000
.*   &XINT  - X SPACING (DEFAULT IS 2; INTEGER OR HALFWORD)             00160000
.*   &XMAX  - NUMBER OF HORIZONTAL POSITIONS                            00170000
.*   &XFUZZ - DEVIATION FROM MINIMUM (FUZZY POSITION)           GP13162 00180000
.*   &YOFF  - MINIMUM OFFSET ON SCREEN (DEFAULT IS 0)                   00190000
.*   &YINT  - Y SPACING (DEFAULT IS 1; INTEGER OR HALFWORD)     GP13162 00200000
.*   &YMAX  - NUMBER OF VERTICAL POSITIONS                              00210000
.*   &YFUZZ - DEVIATION FROM MINIMUM (FUZZY POSITION)           GP13162 00220000
.*                                                                      00230000
.*  XFUZZ/YFUZZ ALLOW CURSOR IN AN AREA TO REGISTER AS A POINT. GP13162 00240000
.*                                                                      00250000
&NM      MVC   DB(3),EXCRAWIN  COPY TO PARAMETER AREA                   00260000
         BAS   R14,EXWFRSBA  GET SCREEN ADDRESS OF CURSOR               00270000
         STH   R0,&VAL       SAVE BINARY CURSOR ADDRESS                 00280000
         MACPARM R15,&ERR    QUICK RETURN ON ERROR                      00290000
         SRDA  R0,32         MOVE TO R1 AND ZERO R0                     00300000
         LH    R2,LSIZE      GET SCREEN WIDTH                           00310000
         DR    R0,R2         GET COLUMN / ROW OF CURSOR                 00320000
         LR    R3,R0         COPY Y OFFSET                      GP13162 00330000
         AIF   (T'&XOFF EQ 'N').NUMX                                    00340000
         MACPARM R3,&XOFF,OP=SH,OPR=SR                                  00350000
         AGO   .TESTY                                                   00360000
.NUMX    SH    R3,=AL2(&XOFF)  LESS STARTING ROW                        00370000
.TESTY   BMR   R15           NOT IN DISPLAY AREA                        00380000
         AIF   (T'&YOFF EQ 'N').NUMY                                    00390000
         MACPARM R1,&YOFF,OP=SH,OPR=SR                                  00400000
         AGO   .TESTZ                                                   00410000
.NUMY    SH    R1,=AL2(&YOFF)  LESS STARTING ROW                        00420000
.TESTZ   BMR   R15           NOT IN DISPLAY AREA                        00430000
         SR    R0,R0         PREPARE FOR DIVIDE                 GP13162 00440000
         AIF   ('&YINT' EQ '1').VERTZ                           GP13162 00450000
         AIF   (T'&YINT NE 'N').VERTN                           GP13162 00460000
         LA    R14,&YINT                                        GP13162 00470000
         AGO   .VERTR                                           GP13162 00480000
.VERTN   MACPARM R14,&YINT,OP=LH                                GP13162 00490000
.VERTR   DR    R0,R14                                           GP13162 00500000
         AIF   ('&YFUZZ' EQ '0').VERTP                          GP13162 00510000
         CH    R0,=AL2(&YFUZZ)                                  GP13162 00520000
         BNLR  R15                                              GP13162 00530000
         AGO   .VERTZ                                           GP13162 00540000
.VERTP   LTR   R0,R0         ANY REMAINDER                      GP13162 00550000
         BNZR  R15           YES; NOT ON DISPLAY CHARACTER      GP13162 00560000
.VERTZ   OI    &FLAGS,&FBIT  SHOW CURSOR GENERATED                      00570000
         AIF   ('&XINT' EQ '2').TMODD                                   00580000
         AIF   ('&XINT' EQ '1').TMAXS                                   00590000
         SR    R2,R2                                                    00600000
         D     R2,=A(&XINT)  TEST                                       00610000
         AIF   ('&XFUZZ' EQ '0').HORFZ                          GP13162 00620000
         CH    R2,=AL2(&XFUZZ)                                  GP13162 00630000
         BNLR  R15                                              GP13162 00640000
         AGO   .TMAXS                                           GP13162 00650000
.HORFZ   LTR   R2,R2         REMAINDER ?                                00660000
         BNZR  R15             YES; INVALID OFFSET                      00670000
         AGO   .TMAXS        CHECK FOR MAXIMA                           00680000
.TMODD   EX    R3,EXTMODD    IS THE COLUMN OFFSET ODD ?                 00690000
         BNZR  R15           YES; NOT ON DISPLAY CHARACTER              00700000
         SRA   R3,1          CONVERT INDEX TO OFFSET                    00710000
.TMAXS   CH    R3,=AL2(&XMAX)  VALID ?                                  00720000
         BNLR  R15           NO; IGNORE                                 00730000
         CH    R1,=AL2(&YMAX)  VALID ?                                  00740000
         BNLR  R15           NO; IGNORE                                 00750000
         AIF   ('&XINT' NE '2').MEND                            GP13162 00760000
         B     *+8           PROCESS                                    00770000
EXTMODD  TM    =X'01',*-*    IS REGISTER ODD ?                          00780000
.MEND    MEND  ,                                                        00790000
./ ADD NAME=XCURSOR
         MACRO ,                                                        00010000
&NM      XCURSOR &A,&B,&BASE=1,&SAVE=YES                    NEW GP12297 00020000
         GBLC  &MACPLAB                                                 00030000
         GBLB  &ZZXCUR2      GLOBAL USE FLAG FOR SCINIT                 00040000
         LCLA  &K                                               GP12298 00050000
.*                                                                    * 00060000
.*   XCURSOR IS USED IN CONJUNCTION WITH EXHASCRN ROUTINES, INVOKED   * 00070000
.*   BY SCxxxx MACROS OTHER THAN SCLINE.                              * 00080000
.*                                                                    * 00090000
.*   XCURSOR n          SET IT TO A BINARY OFFSET                     * 00100000
.*   XCURSOR m,n        PLACES THE CURSOR INTO ROW m (1-max) AND      * 00110000
.*                      COLUMN n (1-max)                              * 00120000
.*          BASE=1      ACCEPTS COORDINATES RELATIVE TO 1 (1-24,1-80) * 00130000
.*          BASE=0      ACCEPTS COORDINATES RELATIVE TO 0 (0-42,0-132)* 00140000
.*                                                                    * 00150000
&MACPLAB SETC  '&NM'                                                    00160000
&ZZXCUR2 SETB  1             SHOW USER IS CONTROLLING THE CURSOR        00170000
         AIF   ('&A' EQ 'RESET').DEFAULT                                00180000
         AIF   ('&A' EQ 'RETAIN').PROP                                  00190000
         AIF   ('&A' EQ 'PUSH').SAVEIC                                  00200000
         AIF   ('&A' EQ 'POP').RESTIC                                   00210000
         AIF   ('&SAVE' NE 'YES').NOSAVE                                00220000
         MACPARM R14,R0,DB,OP=STM,MODE=THREE                            00230000
.NOSAVE  AIF   (N'&SYSLIST LT 1 OR N'&SYSLIST GT 2).BADPARM             00240000
         AIF   (N'&SYSLIST EQ 2).CALC                                   00250000
&K       SETA  K'&A                                             GP12298 00260000
         AIF   (&K LT 3).F1                                     GP12298 00270000
         AIF   ('&A'(1,1) NE '(').F1                            GP12298 00280000
         AIF   ('&A'(&K,1) NE ')').F1                           GP12298 00290000
         AIF   ('&A'(2,1) EQ '(' OR '&A'(&K-1,1) EQ ')').F1     GP12298 00300000
         MACPARM R0,&A,OP=LH GET BINARY POSITION (0-max)                00310000
         MACPARM R0,FDWCUR,OP=STH   AND SET                             00320000
         AGO   .COMOUT                                                  00330000
.F1      MACPARM FDWCUR,&A,OP=MVC                               GP12298 00340000
         AGO   .COMOUT                                          GP12298 00350000
.CALC    MACPARM R14,&A      GET ROW                                    00360000
         AIF   ('&BASE' EQ '0').NOSUB1                                  00370000
         MACPARM R14,0,OP=BCTR,OPR=BCTR                                 00380000
.NOSUB1  MACPARM R15,&B      GET COLUMN                                 00390000
         AIF   ('&BASE' EQ '0').NOSUB2                                  00400000
         MACPARM R15,0,OP=BCTR,OPR=BCTR                                 00410000
.NOSUB2  MH    R14,LSIZE     GET OFFSET TO CORRECT ROW                  00420000
         AR    R14,R15       GET TOTAL OFFSET                           00430000
         STH   R14,FDWCUR    STASH IT                                   00440000
.*                                                                      00450000
.COMOUT  AIF   ('&SAVE' NE 'YES').NOREST                                00460000
         MACPARM R14,R0,DB,OP=LM,MODE=THREE                             00470000
.NOREST  OI    FDWPROFG,FDWPFCUR  USE IT                                00480000
         MEXIT ,                                                        00490000
.BADPARM MNOTE 8,'XCURSOR TAKES ONE OR TWO ARGUMENTS'                   00500000
         MEXIT ,                                                        00510000
.SAVEIC  MACPARM FDWSVCUR,FDWICUD,OP=MVC  SAVE WHERE USER LEFT IT       00520000
         MEXIT ,                                                        00530000
.RESTIC  MACPARM FDWCUR,FDWSVCUR,OP=MVC  RESTORE FROM SAVE              00540000
         OI    FDWPROFG,FDWPFCUR  USE IT                                00550000
         MEXIT ,                                                        00560000
.PROP    MACPARM FDWCUR,FDWICUD,OP=MVC   SET WHERE USER LEFT IT         00570000
         OI    FDWPROFG,FDWPFCUR  USE IT                                00580000
         MEXIT ,                                                        00590000
.DEFAULT MACPARM FDWCUR,=X'FFFF',OP=MVC  DEFAULTS TO 1ST INPUT FIELD    00600000
         MEND  ,                                                        00610000
./ ADD NAME=XDEVOPT
         MACRO ,                                                        00010000
&NM    XDEVOPT &SW1=,&SW2=,&SW3=,&SW4=,&ULV=,&EXIT=,&ID=,&LAYOUT=,     *00020000
               &LOOP=,&WAIT=,&INPUT=,&PRIV=,&DELAY=NO,&GROUP=DFL,      *00030000
               &COLIN='46464646232300004646464623230000',        88364 *00040000
               &COLOUT='11115555777700001111555577770000',       88364 *00050000
               &EXPART=0,&IMPART=L,&COLREP='1234567',            88364 *00060000
               &GAMES=NO,&DASKIP=,&TRAN=,&TRGE=,&PROMPT=        GP99106 00070000
.*                                                                      00080000
.*       MACRO ADDED 76060                                              00090000
.*       PROVIDES SUPPORT FOR USER OPTIONS IN MODULES EXHPXXXX          00100000
.*       SEE EXHAINIT, XDEVPFK AND EXHPDFLT FOR ADDITIONAL COMMENTS     00110000
.*                                                                      00120000
         COPY  GBLDEF                                                   00130000
         GBLB  &PFKONE,&PFKEND,&OPTONE,&OPTEND                          00140000
         GBLC  &OPTNAM(20),&OPTVAL(20),&OPTCOM(20)                      00150000
         GBLC  &OPTCIN,&OPTCOT,&OPTCRP,&OPTEXP,&OPTIMP           88364  00160000
         GBLA  &OPTMAX                                                  00170000
         LCLC  &PRM                                                     00180000
         LCLA  &I,&J,&K                                                 00190000
         AIF   (&OPTONE).INIT                                           00200000
&OPTONE  SETB  1                                                        00210000
&OPTNAM(01) SETC 'LAYOUT'                                               00220000
&OPTVAL(01) SETC 'DFLT'                                                 00230000
&OPTCOM(01) SETC ''                                                     00240000
&OPTNAM(02) SETC 'LOOP TIME'                                            00250000
&OPTVAL(02) SETC '3'                                                    00260000
&OPTCOM(02) SETC 'SECONDS'                                              00270000
&OPTNAM(03) SETC 'WAIT TIME'                                            00280000
&OPTVAL(03) SETC '30'                                                   00290000
&OPTCOM(03) SETC 'SECONDS'                                              00300000
&OPTNAM(04) SETC 'PRIVILEGES'                                           00310000
&OPTVAL(04) SETC '00000000'                                             00320000
&OPTCOM(04) SETC ''                                                     00330000
&OPTNAM(05) SETC ''                                                     00340000
&OPTVAL(05) SETC '00000000'                                             00350000
&OPTCOM(05) SETC ''                                                     00360000
&OPTNAM(06) SETC 'SCREEN REFRESH TIME'                                  00370000
&OPTVAL(06) SETC '5'                                                    00380000
&OPTCOM(06) SETC 'SECONDS'                                              00390000
&OPTNAM(07) SETC 'SW2'                                                  00400000
&OPTVAL(07) SETC '2'                                                    00410000
&OPTCOM(07) SETC 'SECOND CYCLE UPDATES'                                 00420000
&OPTNAM(08) SETC 'SW3'                                                  00430000
&OPTVAL(08) SETC '12'                                                   00440000
&OPTCOM(08) SETC 'THIRD LEVEL UPDATES'                                  00450000
&OPTNAM(09) SETC 'SW4'                                                  00460000
&OPTVAL(09) SETC '5'                                                    00470000
&OPTCOM(09) SETC 'FOURTH LEVEL UPDATES'                                 00480000
&OPTNAM(10) SETC 'USER EXIT LEVEL'                                      00490000
&OPTVAL(10) SETC '3'                                                    00500000
&OPTCOM(10) SETC '(SW NUMBER - 1)'                                      00510000
&OPTNAM(11) SETC 'OPTION FLAGS'                                         00520000
&OPTVAL(11) SETC '00000001'                                             00530000
&OPTCOM(11) SETC ''                                                     00540000
&OPTVAL(12) SETC ''                                              79156  00550000
&OPTCOM(12) SETC 'LPA RESIDENT GROUP'                            79156  00560000
&OPTNAM(13) SETC 'DASKIP'                                        82361  00570000
&OPTVAL(13) SETC '00000000'                                      82361  00580000
&OPTCOM(13) SETC 'DISPLAY ACTIVE SKIP OPTIONS'                   82361  00590000
&OPTNAM(14) SETC 'TRAN'                                          82361  00600000
&OPTVAL(14) SETC ''                                              82361  00610000
&OPTCOM(14) SETC 'LPA/LSQA CRT TRANSLATE TABLES'                 82361  00620000
&OPTMAX  SETA  14                                                82361  00630000
.INIT    AIF   (NOT &PFKONE AND NOT &PFKEND).POK                        00640000
         MNOTE 8,'OUT OF SEQUENCE'                                      00650000
         MEXIT                                                          00660000
.POK     ANOP  ,                                                        00670000
.P1      AIF   ('&SW1' EQ '').P2                                        00680000
      EXGCHECK &SW1,&OPTVAL(6),OPT=NUM                                  00690000
         AIF   (NOT &OK).BOO1                                           00700000
         AIF   (&DUPL).P2                                               00710000
         AIF   (&SW1 LT 1 OR &SW1 GT 655).BOO1                          00720000
&OPTVAL(6) SETC '&SW1'                                                  00730000
         AGO   .P2                                                      00740000
.BOO1    MNOTE 8,'INVALID OPTION  SW1=''&SW1'''                         00750000
.P2      AIF   ('&SW2' EQ '').P3                                        00760000
      EXGCHECK &SW2,&OPTVAL(7),OPT=NUM                                  00770000
         AIF   (NOT &OK).BOO2                                           00780000
         AIF   (&DUPL).P3                                               00790000
         AIF   (&SW2 LT 1 OR &SW2 GT 255).BOO2                          00800000
&OPTVAL(7) SETC '&SW2'                                                  00810000
         AGO   .P3                                                      00820000
.BOO2    MNOTE 8,'INVALID OPTION  SW2=''&SW2'''                         00830000
.P3      AIF   ('&SW3' EQ '').P4                                        00840000
      EXGCHECK &SW3,&OPTVAL(8),OPT=NUM                                  00850000
         AIF   (NOT &OK).BOO3                                           00860000
         AIF   (&DUPL).P4                                               00870000
         AIF   (&SW3 LT 1 OR &SW3 GT 255).BOO3                          00880000
&OPTVAL(8) SETC '&SW3'                                                  00890000
         AGO   .P4                                                      00900000
.BOO3    MNOTE 8,'INVALID OPTION  SW3=''&SW3'''                         00910000
.P4      AIF   ('&SW4' EQ '').P5                                        00920000
      EXGCHECK &SW4,&OPTVAL(9),OPT=NUM                                  00930000
         AIF   (NOT &OK).BOO4                                           00940000
         AIF   (&DUPL).P5                                               00950000
         AIF   (&SW4 LT 1 OR &SW4 GT 255).BOO4                          00960000
&OPTVAL(9) SETC '&SW4'                                                  00970000
         AGO   .P5                                                      00980000
.BOO4    MNOTE 8,'INVALID OPTION  SW4=''&SW4'''                         00990000
.P5      AIF   ('&ULV' EQ '').P6                                        01000000
      EXGCHECK &ULV,&OPTVAL(10),OPT=NUM                                 01010000
         AIF   (NOT &OK).BOO5                                           01020000
         AIF   (&DUPL).P6                                               01030000
         AIF   (&ULV GT 255).BOO5                                       01040000
&OPTVAL(10) SETC '&ULV'                                                 01050000
         AGO   .P6                                                      01060000
.BOO5    MNOTE 8,'INVALID OPTION  ULV=''&ULV'''                         01070000
.P6      AIF   ('&EXIT' EQ '').P7                                       01080000
      EXGCHECK NONE,&EXIT,OPT=YES                                       01090000
         AIF   (NOT &OK).BOO6                                           01100000
         AIF   ('&EXIT' EQ 'NO').P6NO                                   01110000
&OPTVAL(11) SETC '&OPTVAL(11)'(1,4).'1'.'&OPTVAL(11)'(6,3)              01120000
         AGO   .P7                                                      01130000
.P6NO    ANOP  ,                                                        01140000
&OPTVAL(11) SETC '&OPTVAL(11)'(1,4).'0'.'&OPTVAL(11)'(6,3)              01150000
         AGO   .P7                                                      01160000
.BOO6    MNOTE 8,'INVALID OPTION  EXIT=''&EXIT'''                       01170000
.P7      AIF   ('&ID' EQ '').P8                                         01180000
      EXGCHECK NONE,&ID,OPT=YES                                         01190000
         AIF   (NOT &OK).BOO7                                           01200000
         AIF   ('&ID' EQ 'NO').P7NO                                     01210000
&OPTVAL(11) SETC '&OPTVAL(11)'(1,7).'1'                                 01220000
         AGO   .P8                                                      01230000
.P7NO    ANOP  ,                                                        01240000
&OPTVAL(11) SETC '&OPTVAL(11)'(1,7).'0'                                 01250000
         AGO   .P8                                                      01260000
.BOO7    MNOTE 8,'INVALID OPTION  ID=''&ID'''                           01270000
.P8      AIF   ('&LAYOUT' EQ '').P9                                     01280000
      EXGCHECK DFLT,&LAYOUT,OPT=ALPHA                                   01290000
         AIF   (NOT &OK).BOO8                                           01300000
         AIF   (&DUPL).P9                                               01310000
         AIF   (K'&LAYOUT NE 4).BOO8                                    01320000
&OPTVAL(1) SETC '&LAYOUT'                                               01330000
         AGO   .P9                                                      01340000
.BOO8    MNOTE 8,'INVALID OPTION  LAYOUT=''&LAYOUT'''                   01350000
.P9      AIF   ('&LOOP' EQ '').P10                                      01360000
      EXGCHECK &OPTVAL(2),&LOOP,OPT=NUM                                 01370000
         AIF   (NOT &OK).BOO9                                           01380000
         AIF   (&DUPL).P10                                              01390000
         AIF   (&LOOP LT 1 OR &LOOP GT 655).BOO9                        01400000
&OPTVAL(2) SETC '&LOOP'                                                 01410000
         AGO   .P10                                                     01420000
.BOO9    MNOTE 8,'INVALID OPTION  LOOP=''&LOOP'''                       01430000
.P10     AIF   ('&WAIT' EQ '').P11                                      01440000
      EXGCHECK &OPTVAL(3),&WAIT,OPT=NUM                                 01450000
         AIF   (NOT &OK).BOO10                                          01460000
         AIF   (&DUPL).P11                                              01470000
         AIF   (&WAIT LT 10 OR &WAIT GT 655).BOO10                      01480000
&OPTVAL(3) SETC '&WAIT'                                                 01490000
         AGO   .P11                                                     01500000
.BOO10    MNOTE 8,'INVALID OPTION  WAIT=''&WAIT'''                      01510000
.P11     AIF   ('&INPUT' EQ '').P12                                     01520000
      EXGCHECK NONE,&INPUT,(YES,NO,KEYS,PSWD),OPT=LIST                  01530000
         AIF   (NOT &OK).BOO11                                          01540000
         AIF   (&DUPL).P12                                              01550000
         AIF   ('&INPUT' EQ 'YES').P11YES                               01560000
         AIF   ('&INPUT' EQ 'KEYS').P11KEYS                             01570000
         AIF   ('&INPUT' EQ 'PSWD').P11PSWD                             01580000
&OPTVAL(11) SETC '&OPTVAL(11)'(1,5).'1'.'&OPTVAL(11)'(7,2)              01590000
         AGO   .P12                                                     01600000
.P11YES  ANOP  ,                                                        01610000
&OPTVAL(11) SETC '&OPTVAL(11)'(1,5).'0'.'&OPTVAL(11)'(7,2)              01620000
         AGO   .P12                                                     01630000
.P11KEYS ANOP  ,                                                        01640000
&OPTVAL(4) SETC '&OPTVAL(4)'(1,2).'1'.'&OPTVAL(4)'(4,5)                 01650000
         AGO   .P12                                                     01660000
.P11PSWD ANOP  ,                                                        01670000
&OPTVAL(4) SETC '&OPTVAL(4)'(1,1).'1'.'&OPTVAL(4)'(3,5).'1'             01680000
         AGO   .P12                                                     01690000
.BOO11    MNOTE 8,'INVALID OPTION  INPUT=''&INPUT'''                    01700000
.P12     AIF   ('&PRIV' EQ '').P13                                      01710000
&J       SETA  N'&PRIV                                                  01720000
&I       SETA  0                                                        01730000
.P12LOOP AIF   (&I GE &J).P13                                           01740000
&I       SETA  &I+1                                                     01750000
&PRM     SETC  '&PRIV(&I)'                                              01760000
         AIF   ('&PRM' EQ '').P12LOOP                                   01770000
      EXGCHECK NONE,&PRM,(SYS,CON,CAN,UNL,FAIL),OPT=LIST                01780000
         AIF   (NOT &OK).BOO12                                          01790000
         AIF   (&DUPL).P12LOOP                                          01800000
         AIF   ('&PRM' EQ 'SYS').P12SYS                                 01810000
         AIF   ('&PRM' EQ 'CON').P12CON                                 01820000
         AIF   ('&PRM' EQ 'CAN').P12CAN                                 01830000
         AIF   ('&PRM' EQ 'UNL').P12UNL                                 01840000
.*       DROP THROUGH TO 'FAIL'                                         01850000
&OPTVAL(4) SETC '1'.'&OPTVAL(4)'(2,7)                                   01860000
         AGO   .P12LOOP                                                 01870000
.P12SYS  ANOP  ,                                                        01880000
&OPTVAL(4) SETC '&OPTVAL(4)'(1,6).'1'.'&OPTVAL(4)'(8,1)                 01890000
         AGO   .P12LOOP                                                 01900000
.P12CON  ANOP  ,                                                        01910000
&OPTVAL(4) SETC '&OPTVAL(4)'(1,4).'1'.'&OPTVAL(4)'(6,3)                 01920000
         AGO   .P12LOOP                                                 01930000
.P12CAN  ANOP  ,                                                        01940000
&OPTVAL(4) SETC '&OPTVAL(4)'(1,5).'1'.'&OPTVAL(4)'(7,2)                 01950000
         AGO   .P12LOOP                                                 01960000
.P12UNL  ANOP  ,                                                        01970000
&OPTVAL(4) SETC '&OPTVAL(4)'(1,7).'1'                                   01980000
         AGO   .P12LOOP                                                 01990000
.BOO12    MNOTE 8,'INVALID OPTION  PRIV=''&PRM'''                       02000000
         AGO   .P12LOOP                                                 02010000
.P13     AIF   ('&DELAY' EQ 'NO').P14                            77117  02020000
      EXGCHECK NONE,&DELAY,(YES,DELAY,IGNORE,END),OPT=LIST      GP11230 02030000
         AIF   (NOT &OK).BOO13                                   77117  02040000
         AIF   (&INDX EQ 4).DELEND                              GP11230 02050000
&OPTVAL(5) SETC '1'.'&OPTVAL(5)'(2,7)                            77117  02060000
         AIF   (&INDX NE 3).P14                                 GP11230 02070000
&OPTVAL(5) SETC '11'.'&OPTVAL(5)'(3,6)                           79156  02080000
         AGO   .P14                                              77117  02090000
.DELEND  ANOP  ,             END TASK ON DISCONNECT (TN3270)    GP11230 02100000
&OPTVAL(5) SETC '&OPTVAL(5)'(1,5).'1'.'&OPTVAL(5)'(7,2)         GP11230 02110000
         AGO   .P14                                             GP11230 02120000
.BOO13   MNOTE 8,'INVALID OPTION  DELAY=''&DELAY'''              77117  02130000
.P14  EXGCHECK NONE,&GROUP,OPT=ALPHA,NULL=YES                    79156  02140000
         AIF   (NOT &OK).BOO14                                   79156  02150000
&OPTVAL(12) SETC ''                                              79156  02160000
         AIF   ('&GROUP' EQ '').P15                              79156  02170000
         AIF   (K'&GROUP NE 3).BOO14                             79156  02180000
&OPTVAL(12) SETC '&GROUP'                                        79156  02190000
         AGO   .P15                                              79156  02200000
.BOO14   MNOTE 4,'INVALID LPA GROUP=''&GROUP'''                  79156  02210000
.P15  EXGCHECK NONE,&GAMES,(NO,YES,GAMES),OPT=LIST,NULL=YES      79194  02220000
         AIF   (NOT &OK).BOO15                                   79194  02230000
         AIF   ('&GAMES' NE 'NO').P15A                           89020  02240000
&OPTVAL(5) SETC '&OPTVAL(5)'(1,4).'1'.'&OPTVAL(5)'(6,3)          79194  02250000
         AGO   .P15A                                             89020  02260000
.BOO15   MNOTE 8,'INVALID OPTION  GAMES=''&GAMES'''              79194  02270000
.P15A EXGCHECK NONE,&PROMPT,(NO,YES,ID),OPT=LIST,NULL=YES        89020  02280000
         AIF   (NOT &OK).BOO15A                                  89020  02290000
         AIF   ('&PROMPT' NE 'ID' AND '&PROMPT' NE 'YES').P16    89020  02300000
&OPTVAL(5) SETC '&OPTVAL(5)'(1,3).'1'.'&OPTVAL(5)'(5,4)          89020  02310000
         AGO   .P16                                              89020  02320000
.BOO15A  MNOTE 8,'INVALID OPTION  PROMPT=''&PROMPT'''            89020  02330000
.P16     AIF   ('&DASKIP' EQ '').P17                             82361  02340000
&J       SETA  N'&DASKIP                                         82361  02350000
&I       SETA  0                                                 82361  02360000
.P16LOOP AIF   (&I GE &J).P17                                    82361  02370000
&I       SETA  &I+1                                              82361  02380000
&PRM     SETC  '&DASKIP(&I)'                                     82361  02390000
         AIF   ('&PRM' EQ '').P16LOOP                            82361  02400000
 EXGCHECK NONE,&PRM,(IDLE,DRAIN,DRAINED,STC,TSU,START,TSO,TS,PRM,PERM),*02410000
               OPT=LIST                                         GP99016 02420000
         AIF   (NOT &OK).BOO16                                   82361  02430000
         AIF   (&DUPL).P16LOOP                                   82361  02440000
         AIF   ('&PRM' EQ 'IDLE').P16IDLE                        82361  02450000
         AIF   ('&PRM' EQ 'DRAIN' OR '&PRM' EQ 'DRAINED').P16DRAN       02460000
         AIF   ('&PRM' EQ 'STC' OR '&PRM' EQ 'START').P16STC     82361  02470000
         AIF   ('&PRM' EQ 'TSO' OR '&PRM' EQ 'TS').P16TSU       GP99016 02480000
.*       DROP THROUGH TO 'PRM'                                  GP99016 02490000
&OPTVAL(13) SETC '&OPTVAL(13)'(1,4).'1'.'&OPTVAL(13)'(6,3)      GP99016 02500000
         AGO   .P16LOOP                                         GP99016 02510000
.P16TSU  ANOP  ,                                                GP99016 02520000
&OPTVAL(13) SETC '&OPTVAL(13)'(1,3).'1'.'&OPTVAL(13)'(5,4)       82361  02530000
         AGO   .P16LOOP                                          82361  02540000
.P16STC  ANOP  ,                                                 82361  02550000
&OPTVAL(13) SETC '&OPTVAL(13)'(1,2).'1'.'&OPTVAL(13)'(4,5)       82361  02560000
         AGO   .P16LOOP                                          82361  02570000
.P16IDLE ANOP  ,                                                 82361  02580000
&OPTVAL(13) SETC '&OPTVAL(13)'(1,1).'1'.'&OPTVAL(13)'(3,6)       82361  02590000
         AGO   .P16LOOP                                          82361  02600000
.P16DRAN ANOP  ,                                                 82361  02610000
&OPTVAL(13) SETC '1'.'&OPTVAL(13)'(2,7)                          82361  02620000
         AGO   .P16LOOP                                          82361  02630000
.BOO16    MNOTE 8,'INVALID OPTION  DASKIP=''&PRM'''              82361  02640000
         AGO   .P16LOOP                                          82361  02650000
.P17  EXGCHECK NONE,&TRAN,OPT=ALPHA,NULL=YES                     82361  02660000
         AIF   (NOT &OK).BOO17                                   82361  02670000
&OPTVAL(14) SETC ''                                              82361  02680000
         AIF   ('&TRAN' EQ '').P17A                             GP99106 02690000
         AIF   (K'&TRAN GT 4).BOO17                              82361  02700000
&OPTVAL(14) SETC '&TRAN'                                         82361  02710000
         AGO   .P17A                                            GP99106 02720000
.BOO17   MNOTE 4,'INVALID LPA/LSQA TRAN=''&TRAN'''               82361  02730000
.P17A EXGCHECK NONE,&TRGE,OPT=ALPHA,NULL=YES                    GP99106 02740000
         AIF   (NOT &OK).BOO17A                                 GP99106 02750000
&OPTVAL(15) SETC '&OPTVAL(14)'                                  GP99106 02760000
         AIF   ('&TRGE' EQ '').P18                              GP99106 02770000
         AIF   (K'&TRGE GT 4).BOO17A                            GP99106 02780000
&OPTVAL(15) SETC '&TRGE'                                        GP99106 02790000
         AGO   .P18                                             GP99106 02800000
.BOO17A  MNOTE 4,'INVALID LPA/LSQA TRGE=''&TRAN'''              GP99106 02810000
.P18     AIF   (K'&COLIN EQ 34).P19                              88364  02820000
         MNOTE 8,'COLIN STRING INVALID'                          88364  02830000
         AGO   .MEND                                             88364  02840000
.P19     AIF   (K'&COLOUT EQ 34).P20                             88364  02850000
         MNOTE 8,'COLOUT STRING INVALID'                         88364  02860000
         AGO   .MEND                                             88364  02870000
.P20     AIF   (K'&COLREP EQ 9).P21                              88364  02880000
         MNOTE 8,'COLREP STRING INVALID'                         88364  02890000
         AGO   .MEND                                             88364  02900000
.P21     EXGCHECK NONE,&EXPART,(0,1,2,3,4,5),OPT=LIST            88364  02910000
         AIF   (&OK).P22                                         88364  02920000
         MNOTE 8,'INVALID EXPART'                                88364  02930000
         AGO   .MEND                                             88364  02940000
.P22     EXGCHECK NONE,&IMPART,(S,L,C,D),OPT=LIST                88364  02950000
         AIF   (&OK).NEWOK                                       88364  02960000
         MNOTE 8,'INVALID IMPART'                                88364  02970000
         AGO   .MEND                                             88364  02980000
.NEWOK   ANOP  ,                                                 88364  02990000
&OPTCIN  SETC  '&COLIN'                                          88364  03000000
&OPTCOT  SETC  '&COLOUT'                                         88364  03010000
&OPTCRP  SETC  '&COLREP'                                         88364  03020000
&OPTEXP  SETC  '&EXPART'                                         88364  03030000
&OPTIMP  SETC  '&IMPART'                                         88364  03040000
.MEND    MEND  ,                                                 88364  03050000
./ ADD NAME=XDEVPFK
         MACRO ,                                                        00010000
&NM    XDEVPFK &QUY,&TEXT,&COPIES=1                              93057  00020000
.*                                                                      00030000
.*       ADDED 76060 FOR EXHPCXXX AND EXHPDFLT MODULES                  00040000
.*             SETS 3270 PFK OPTIONS (OVERRIDES MAPSQSP SETTINGS)       00050000
.*             ALSO SEE EXHAINIT MODIFICATIONS                          00060000
.*                                                                      00070000
         GBLB  &PFKONE,&PFKEND,&OPTONE,&OPTEND,&OPTEND2          88364  00080000
         GBLC  &KEY(40),&HEX(40),&KVL(40),&SECT                  88272  00090000
         GBLC  &OPTNAM(20),&OPTVAL(20),&OPTCOM(20)                      00100000
         GBLC  &OPTCIN,&OPTCOT,&OPTCRP,&OPTEXP,&OPTIMP           88364  00110000
         GBLA  &IND(40),&DEF(40),&OPTMAX,&PFKMAX                 88272  00120000
         LCLA  &I,&J,&K,&L,&SI,&SM                              77110   00130000
         LCLC  &N,&PRIT(16),&OPTT(16)                                   00140000
&N       SETC  '&NM'                                                    00150000
&SM      SETA  N'&SYSLIST                                       77110   00160000
&SI      SETA  1                                                77110   00170000
         AGO   .TESTL                                           77110   00180000
.NEXTL   ANOP  ,                                                77110   00190000
&SI      SETA  &SI+2                                            77110   00200000
.TESTL   AIF   (&SI LE &SM).DOL                                 77110   00210000
         MEXIT ,                                                77110   00220000
.DOL     AIF   (NOT &PFKEND).OK                                 77110   00230000
         MNOTE 8,'OUT OF SEQUENCE'                                      00240000
         MEXIT                                                          00250000
.OK  AIF  ('&SYSLIST(&SI)' EQ '*END' OR '&SYSLIST(&SI)' EQ 'END').LAST  00260000
         AIF ('&SYSLIST(&SI)' EQ '' OR '&SYSLIST(&SI+1)' EQ '').BOOBOO  00270000
         AIF   (&PFKONE).INIT                                           00280000
.DEF     AIF   (&OPTONE).OPTOK                                          00290000
         MNOTE 0,' ''DOPT'' MACRO NOT USED - OPTIONS DEFAULTED'         00300000
&N       DOPT                                                           00310000
&N       SETC  ''                                                       00320000
.OPTOK   AIF   (&OPTEND).OPTDONE                                        00330000
&OPTEND  SETB  1                                                        00340000
&N       DC    C'OPTS' .     MODULE I.D.                                00350000
&N       SETC  ''                                                       00360000
         DC    CL4'&OPTVAL(1) ' .  LAYOUT                               00370000
         DC    AL2(&OPTVAL(2)*100) .   LOOP TIME                        00380000
         DC    AL2(&OPTVAL(3)*100) .   WAIT TIME                        00390000
         DC    B'&OPTVAL(4)&OPTVAL(5)' .  GLOBAL PRIVILEGES             00400000
         DC    AL2(&OPTVAL(6)*100) .   DISPLAY UPDATE TIME              00410000
         DC    AL2(&OPTVAL(7),&OPTVAL(8),&OPTVAL(9)) .  CYCLE #         00420000
         DC    AL1(&OPTVAL(10)) .      USER EXIT LEVEL                  00430000
         DC    B'&OPTVAL(11)' .         OPTION FLAGS                    00440000
         DC    CL3'&OPTVAL(12) '  LPA RESIDENT DISPLAY GROUP     79156  00450000
         DC    B'&OPTVAL(13)'  DA SKIP OPTIONS                   82361  00460000
         DC    CL4'&OPTVAL(14) '  CRT TRANSLATE TABLE SUFFIX     82361  00470000
.OPTDONE AIF   ('&OPTCIN' EQ '').OLDSECT  OLD FORMAT             88364  00480000
         AIF   (&OPTEND2).COMSECT                                88364  00490000
&OPTEND2 SETB  1                                                 88364  00500000
&N       DC    C'PFK2'       SET FOR NEW FORMAT                  88364  00510000
&N       SETC  'KEYS'        SET LABEL FOR FIRST KEY DEFINITION  88364  00520000
         DC    AL2(KEYS-&SYSECT,0)  DISPLACEMENT TO KEYS / FILLER       00530000
         DC    CL32&OPTCIN      1/3   MATCHES MAPWORK COLORMAP/SET      00540000
         DC    CL32&OPTCOT      2/3                              88364  00550000
         DC    X'00',CL7&OPTCRP 3/3                              88364  00560000
         DC    AL1(&OPTEXP),C'&OPTIMP'  SIZE(PARTITION) OPTIONS  88364  00570000
         DC    AL2(0)        FILLER                              88364  00580000
         DC    8A(0)         RESERVED                            88364  00590000
         DC    CL4'&OPTVAL(15) '  CRT GE TRANSLATE TABLE SUFFIX GP99106 00600000
         AGO   .COMSECT                                          88364  00610000
.OLDSECT ANOP  ,                                                 88364  00620000
&N       DC    C'PFKS' .     FUNCTION KEY DEFINITIONS                   00630000
&N       SETC  ''                                                       00640000
.COMSECT AIF   (K'&SYSECT EQ 8).SECTOK                           88364  00650000
.BADSECT MNOTE 4,'CONTROL SECTION NAME INVALID'                         00660000
         AGO   .CONT                                                    00670000
.SECTOK  AIF   ('&SYSECT'(1,4) NE 'EXHP').BADSECT                       00680000
&SECT    SETC  '&SYSECT'(5,4)                                           00690000
         AIF   ('&SECT'(1,1) NE 'C').CONT                               00700000
&SECT    SETC  'CRT '.'&SECT'(2,3)                                      00710000
.CONT    ANOP  ,                                                        00720000
&PFKONE  SETB  1                                                        00730000
&PFKMAX  SETA  40            NUMBER OF PFK ARRAY ENTRIES         88272  00740000
&HEX(11) SETC  '0B'                                                     00750000
&HEX(12) SETC  '0C'                                                     00760000
&HEX(13) SETC  '0D'                                                     00770000
&HEX(14) SETC  '0E'                                                     00780000
&HEX(16) SETC  '10'                                                     00790000
&HEX(17) SETC  '11'                                                     00800000
&HEX(18) SETC  '12'                                                     00810000
&HEX(19) SETC  '13'                                                     00820000
&HEX(20) SETC  '14'                                                     00830000
&HEX(21) SETC  '15'                                                     00840000
&HEX(22) SETC  '16'                                                     00850000
&HEX(23) SETC  '17'                                                     00860000
&HEX(24) SETC  '18'                                                     00870000
&HEX(25) SETC  '19'                                                     00880000
&HEX(26) SETC  '1A'                                                     00890000
&HEX(27) SETC  '1B'                                                     00900000
&HEX(28) SETC  '1C'                                                     00910000
&HEX(29) SETC '21'                                               88272  00920000
&HEX(30) SETC '22'                                               88272  00930000
&HEX(31) SETC '23'                                               88272  00940000
&HEX(32) SETC '24'                                               88272  00950000
&HEX(33) SETC '25'                                               88272  00960000
&HEX(34) SETC '26'                                               88272  00970000
&HEX(35) SETC '27'                                               88272  00980000
&HEX(36) SETC '28'                                               88272  00990000
&HEX(37) SETC '29'                                               88272  01000000
&HEX(38) SETC '2A'                                               88272  01010000
&HEX(39) SETC '2B'                                               88272  01020000
&HEX(40) SETC '2C'                                               88272  01030000
&IND(01) SETA  14            ALIAS FOR PA2                              01040000
&IND(02) SETA  02                                                       01050000
&IND(03) SETA  03                                                       01060000
&IND(04) SETA  04                                                       01070000
&IND(05) SETA  05                                                       01080000
&IND(06) SETA  06                                                       01090000
&IND(07) SETA  07                                                       01100000
&IND(08) SETA  08                                                       01110000
&IND(09) SETA  09                                                       01120000
&IND(10) SETA  10                                                       01130000
&IND(11) SETA  11                                                       01140000
&IND(12) SETA  12                                                       01150000
&IND(13) SETA  13                                                       01160000
&IND(14) SETA  14                                                       01170000
&IND(15) SETA  15                                                       01180000
&IND(16) SETA  16                                                       01190000
&IND(17) SETA  17                                                       01200000
&IND(18) SETA  18                                                       01210000
&IND(19) SETA  19                                                       01220000
&IND(20) SETA  20                                                       01230000
&IND(21) SETA  21                                                       01240000
&IND(22) SETA  22                                                       01250000
&IND(23) SETA  23                                                       01260000
&IND(24) SETA  24                                                       01270000
&IND(25) SETA  25                                                       01280000
&IND(26) SETA  26                                                       01290000
&IND(27) SETA  27                                                       01300000
&IND(28) SETA  28                                                       01310000
&IND(29) SETA  29                                                       01320000
&IND(30) SETA  30                                                       01330000
&IND(31) SETA  31                                                       01340000
&IND(32) SETA  32                                                       01350000
&IND(33) SETA  33                                                88272  01360000
&IND(34) SETA  34                                                88272  01370000
&IND(35) SETA  35                                                88272  01380000
&IND(36) SETA  36                                                88272  01390000
&IND(37) SETA  37                                                88272  01400000
&IND(38) SETA  38                                                88272  01410000
&IND(39) SETA  39                                                88272  01420000
&IND(40) SETA  40                                                88272  01430000
&KVL(11) SETC  '¬PA3 '                                                  01440000
&KVL(12) SETC  '¬PA1 '                                                  01450000
&KVL(13) SETC  'ASC  '              WAS ¬CLR                     93057  01460000
&KVL(14) SETC  '¬CAN '                                                  01470000
&KVL(16) SETC  'ASC *'                                           93057  01480000
&KVL(17) SETC  '$F   '                                                  01490000
&KVL(18) SETC  '$I   '                                                  01500000
&KVL(19) SETC  '$JOB '                                                  01510000
&KVL(20) SETC  '$N   '                                                  01520000
&KVL(21) SETC  '$U   '                                                  01530000
&KVL(22) SETC  '$MSG '                                                  01540000
&KVL(23) SETC  'CON -'                                           87176  01550000
&KVL(24) SETC  'STOR '                                                  01560000
&KVL(25) SETC  'ENQ  '                                                  01570000
&KVL(26) SETC  'PIO  '                                                  01580000
&KVL(27) SETC  'U M  '                                                  01590000
&KVL(28) SETC  'U D,T'                                                  01600000
&KVL(29) SETC  '$J   '                                           88272  01610000
&KVL(30) SETC  'ASC  '                                           88272  01620000
&KVL(31) SETC  '$DSN '                                           88272  01630000
&KVL(32) SETC  '$LA  '                                           88272  01640000
&KVL(33) SETC  'NET  '                                           88272  01650000
&KVL(34) SETC  '$LOG '                                           88272  01660000
&KVL(35) SETC  'DCO  '                                           88272  01670000
&KVL(36) SETC  'PFK  '                                           88272  01680000
&KVL(37) SETC  'RSV  '                                           93057  01690000
&KVL(38) SETC  'PAT  '                                           88272  01700000
&KVL(39) SETC  'SMC  '                                           88272  01710000
&KVL(40) SETC  'U CRT'                                           88272  01720000
&KEY(01) SETC  'CANCEL'      ALIAS FOR PA2                              01730000
&KEY(11) SETC  'PA3'                                                    01740000
&KEY(12) SETC  'PA1'                                                    01750000
&KEY(13) SETC  'CLEAR'                                                  01760000
&KEY(14) SETC  'PA2'                                                    01770000
&KEY(16) SETC  'TEST'                                                   01780000
&KEY(17) SETC  'PF1'                                                    01790000
&KEY(18) SETC  'PF2'                                                    01800000
&KEY(19) SETC  'PF3'                                                    01810000
&KEY(20) SETC  'PF4'                                                    01820000
&KEY(21) SETC  'PF5'                                                    01830000
&KEY(22) SETC  'PF6'                                                    01840000
&KEY(23) SETC  'PF7'                                                    01850000
&KEY(24) SETC  'PF8'                                                    01860000
&KEY(25) SETC  'PF9'                                                    01870000
&KEY(26) SETC  'PF10'                                                   01880000
&KEY(27) SETC  'PF11'                                                   01890000
&KEY(28) SETC  'PF12'                                                   01900000
&KEY(29) SETC  'PF13'                                            88272  01910000
&KEY(30) SETC  'PF14'                                            88272  01920000
&KEY(31) SETC  'PF15'                                            88272  01930000
&KEY(32) SETC  'PF16'                                            88272  01940000
&KEY(33) SETC  'PF17'                                            88272  01950000
&KEY(34) SETC  'PF18'                                            88272  01960000
&KEY(35) SETC  'PF19'                                            88272  01970000
&KEY(36) SETC  'PF20'                                            88272  01980000
&KEY(37) SETC  'PF21'                                            88272  01990000
&KEY(38) SETC  'PF22'                                            88272  02000000
&KEY(39) SETC  'PF23'                                            88272  02010000
&KEY(40) SETC  'PF24'                                            88272  02020000
&DEF(11) SETA  11                                                       02030000
&DEF(12) SETA  12                                                       02040000
&DEF(13) SETA  13                                                       02050000
&DEF(14) SETA  14                                                       02060000
&DEF(16) SETA  16                                                       02070000
&DEF(17) SETA  17                                                       02080000
&DEF(18) SETA  18                                                       02090000
&DEF(19) SETA  19                                                       02100000
&DEF(20) SETA  20                                                       02110000
&DEF(21) SETA  21                                                       02120000
&DEF(22) SETA  22                                                       02130000
&DEF(23) SETA  23                                                       02140000
&DEF(24) SETA  24                                                       02150000
&DEF(25) SETA  25                                                       02160000
&DEF(26) SETA  26                                                       02170000
&DEF(27) SETA  27                                                       02180000
&DEF(28) SETA  28                                                       02190000
&DEF(29) SETA  29                                                88272  02200000
&DEF(30) SETA  30                                                88272  02210000
&DEF(31) SETA  31                                                88272  02220000
&DEF(32) SETA  32                                                88272  02230000
&DEF(33) SETA  33                                                88272  02240000
&DEF(34) SETA  34                                                88272  02250000
&DEF(35) SETA  35                                                88272  02260000
&DEF(36) SETA  36                                                88272  02270000
&DEF(37) SETA  37                                                88272  02280000
&DEF(38) SETA  38                                                88272  02290000
&DEF(39) SETA  39                                                88272  02300000
&DEF(40) SETA  40                                                88272  02310000
      AIF ('&SYSLIST(&SI)' EQ '*END' OR '&SYSLIST(&SI)' EQ 'END').LAST  02320000
.INIT    ANOP  ,                                                77110   02330000
&I       SETA  0                                                77110   02340000
.INITL   AIF   (&I GT 31).BOOBOO                                77110   02350000
&I       SETA  &I+1                                                     02360000
         AIF   ('&KEY(&I)' NE '&SYSLIST(&SI)').INITL            77110   02370000
&I       SETA  &IND(&I)                                                 02380000
&J       SETA  K'&SYSLIST(&SI+1)                                77110   02390000
         AIF   ('&SYSLIST(&SI+1)'(1,1) EQ '''').QUOTE           77110   02400000
         AIF   (&J GT 5).BOOBOO                                         02410000
&L       SETA  &J                                                       02420000
&N       DC    X'&HEX(&I)',CL5'&SYSLIST(&SI+1) '                77110   02430000
&KVL(&I) SETC  '&SYSLIST(&SI+1)'                                77110   02440000
         AGO   .SAVE                                                    02450000
.BOOBOO  AIF   ('&SYSLIST(&SI+1)' EQ '').BOOB                   77110   02460000
         AIF   ('&SYSLIST(&SI+1)'(1,1) NE '''').BOOB            77110   02470000
   MNOTE 8,'INVALID :  KEY=''&SYSLIST(&SI)'', VALUE='&SYSLIST(&SI+1)''  02480000
         MEXIT                                                          02490000
.BOOB    ANOP  ,                                                77110   02500000
 MNOTE 8,'INVALID :  KEY=''&SYSLIST(&SI)'', VALUE=''&SYSLIST(&SI+1)'''  02510000
         MEXIT                                                          02520000
.QUOTE   ANOP  ,                                                        02530000
&L       SETA  &J-2                                                     02540000
&J       SETA  &L                                                       02550000
&K       SETA  2                                                        02560000
.LOOP    AIF   (&K GE &J).EXPQ                                          02570000
         AIF   ('&SYSLIST(&SI+1)'(&K,2) EQ '&&').DOUB           77110   02580000
         AIF   ('&SYSLIST(&SI+1)'(&K,2) EQ '''''').DOUB         77110   02590000
&K       SETA  &K+1                                                     02600000
         AGO   .LOOP                                                    02610000
.DOUB    ANOP  ,                                                        02620000
&K       SETA  &K+2                                                     02630000
&L       SETA  &L-1                                                     02640000
         AGO   .LOOP                                                    02650000
.EXPQ    AIF   (&L GT 5).BOOBOO                                         02660000
&KVL(&I) SETC  '&SYSLIST(&SI+1)'(2,&J)                          77110   02670000
&N       DC    X'&HEX(&I)',CL5&SYSLIST(&SI+1)                   77110   02680000
.SAVE    ANOP  ,                                                        02690000
&N       SETC  ''                                                       02700000
&DEF(&I) SETA  0                                                        02710000
         AIF   (&L EQ &J AND &L EQ 5).NEXTL                     77110   02720000
.NOT5    AIF   (&L GE 1).TACK                                           02730000
&KVL(&I) SETC  '     '                                                  02740000
         AGO   .NEXTL                                           77110   02750000
.TACK    ANOP  ,                                                        02760000
&KVL(&I) SETC  '&KVL(&I)'.'        '(1,5-&L)                            02770000
         AGO   .NEXTL                                           77110   02780000
.LAST    AIF   (&SI NE &SM).BOOBOO     FAIL END NOT AT END      77110   02790000
         AIF   (&PFKONE).LEAST                                  77110   02800000
         MNOTE 0,'NO PFK DEFINITIONS SUPPLIED - DEFAULTS WILL BE USED'  02810000
         AGO   .DEF                                                     02820000
.LEAST   ANOP  ,                                                        02830000
&I       SETA  0                                                        02840000
.DEFEX   AIF   (&I GE &PFKMAX).DOEND                             88272  02850000
&I       SETA  &I+1                                                     02860000
&J       SETA  &DEF(&I)                                                 02870000
         AIF   (&J EQ 0).NODEF                                          02880000
&N       DC    X'&HEX(&J)',CL5'&KVL(&J) ' .  DEFAULT                    02890000
&N       SETC  ''                                               GP99106 02900000
.NODEF   AIF   ('&KVL(&I)' EQ '').DEFEX                                 02910000
         AIF   ('&KVL(&I)'(1,1) NE '¬').DEFEX                           02920000
         AIF   ('&KVL(&I)'(2,3) EQ 'CAN').REPCAN                        02930000
         AIF   ('&KVL(&I)'(2,3) EQ 'CLR').REPCLR                        02940000
         AIF   ('&KVL(&I)'(2,3) EQ 'PA1').REPPA1                        02950000
         AIF   ('&KVL(&I)'(2,3) NE 'PA3').DEFEX                         02960000
&KVL(&I) SETC  '¬PA3 '       NOT USED                                   02970000
         AGO   .DEFEX                                                   02980000
.REPCAN  ANOP  ,                                                        02990000
&KVL(&I) SETC  'LOCK '                                                  03000000
         AGO   .DEFEX                                                   03010000
.REPCLR  ANOP  ,                                                        03020000
&KVL(&I) SETC  'CLEAR'                                                  03030000
         AGO   .DEFEX                                                   03040000
.REPPA1  ANOP  ,                                                        03050000
&KVL(&I) SETC  'HOLD '                                                  03060000
         AGO   .DEFEX                                                   03070000
.DOEND   ANOP  ,                                                        03080000
&N       DC    X'FF' .       END OF LIST                                03090000
&PFKEND  SETB  1                                                        03100000
&K       SETA  &OPTVAL(6)*&OPTVAL(7)                                    03110000
&OPTCOM(7) SETC 'SECOND LEVEL UPDATES EVERY '.'&K'.' SECONDS'           03120000
&K       SETA  &K*&OPTVAL(8)                                            03130000
&OPTCOM(8) SETC 'THIRD LEVEL UPDATES EVERY '.'&K'.' SECONDS'            03140000
&K       SETA  &K*&OPTVAL(9)                                            03150000
&OPTCOM(9) SETC 'FOURTH LEVEL UPDATES EVERY '.'&K'.' SECONDS'           03160000
&PRIT(9) SETC  'FAIL'                                                   03170000
&PRIT(11) SETC 'KEYS-ONLY'                                              03180000
&PRIT(12) SETC 'PSWD-ONLY'                                              03190000
&PRIT(13) SETC 'CON'                                                    03200000
&PRIT(14) SETC 'CAN'                                                    03210000
&PRIT(15) SETC 'SYS'                                                    03220000
&PRIT(16) SETC 'UNL'                                                    03230000
&OPTT(5)  SETC 'NOEXIT'                                                 03240000
&OPTT(13) SETC 'EXIT'                                                   03250000
&OPTT(14) SETC 'NO-INPUT'                                               03260000
&OPTT(16) SETC 'ID-LINE'                                                03270000
&I       SETA  0                                                        03280000
.PRILOOP AIF   (&I GE 8).PRILEND                                        03290000
&I       SETA  &I+1                                                     03300000
&N       SETC  '&OPTVAL(4)'(&I,1)                                       03310000
&J       SETA  &N                                                       03320000
&OPTCOM(4) SETC '&OPTCOM(4)'.' '.'&PRIT(8*&J+&I)'                       03330000
         AGO   .PRILOOP                                                 03340000
.PRILEND ANOP  ,                                                        03350000
&I       SETA  0                                                        03360000
.OPTTLOP AIF   (&I GE 8).OPTTLEN                                        03370000
&I       SETA  &I+1                                                     03380000
&N       SETC  '&OPTVAL(11)'(&I,1)                                      03390000
&J       SETA  &N                                                       03400000
&OPTCOM(11) SETC '&OPTCOM(11)'.' '.'&OPTT(8*&J+&I)'                     03410000
         AGO   .OPTTLOP                                                 03420000
.OPTTLEN ANOP  ,                                                        03430000
&I       SETA  &OPTVAL(10)+1                                            03440000
&OPTCOM(10) SETC 'INVOKED ON SW&I CYCLE'                                03450000
&PRIT(9) SETC  'DELAY'                                         77117    03460000
&PRIT(10) SETC 'IGNORE'                                          79194  03470000
&PRIT(13) SETC 'NOGAMES'                                         79194  03480000
&I       SETA  0                                               77117    03490000
.PR2LOOP AIF   (&I GE 8).PR2LEND                               77117    03500000
&I       SETA  &I+1                                            77117    03510000
&N       SETC  '&OPTVAL(5)'(&I,1)                              77117    03520000
&J       SETA  &N                                              77117    03530000
&OPTCOM(5) SETC '&OPTCOM(5)'.' '.'&PRIT(8*&J+&I)'              77117    03540000
         AGO   .PR2LOOP                                        77117    03550000
.PR2LEND ANOP  ,                                               77117    03560000
&OPTNAM(5) SETC '  OPT FLAGS 2'                                77117    03570000
&OPTNAM(12) SETC 'GROUP'                                         79156  03580000
         AIF   ('&OPTVAL(12)' NE '').HAVGRUP                     79156  03590000
&OPTVAL(12) SETC  'NO'                                           79156  03600000
.HAVGRUP AIF   ('&OPTVAL(14)' NE '').NTRTAB                      82361  03610000
&OPTVAL(14) SETC 'NO'                                            82361  03620000
.NTRTAB  AIF   ('&OPTVAL(13)' EQ '00000000').NDASKP              82361  03630000
.NDASKP  ANOP  ,                                                 82361  03640000
&L       SETA  0                                                        03650000
.PRTLOOP EJECT                                                          03660000
&I       SETA  0                                                        03670000
&J       SETA  &OPTMAX                                                  03680000
         MNOTE *,' '                                                    03690000
         MNOTE *,' '                                                    03700000
         MNOTE *,'        MODIFY / SET  OPTIONS :'                      03710000
         MNOTE *,' '                                                    03720000
         MNOTE *,' '                                                    03730000
.OPTLOOP AIF   (&I GE &J).ENDOPT                                        03740000
&I       SETA  &I+1                                                     03750000
         MNOTE *,'         &OPTNAM(&I) = &OPTVAL(&I) &OPTCOM(&I)'       03760000
         AGO   .OPTLOOP                                                 03770000
.ENDOPT  ANOP  ,                                                        03780000
         MNOTE *,' '                                                    03790000
         MNOTE *,' '                                                    03800000
 MNOTE *,'                                                      '       03810000
 MNOTE *,'                                                      '       03820000
 MNOTE *,'            FUNCTION KEY DEFINITIONS FOR &SECT        '       03830000
 MNOTE *,'                                                      '       03840000
 MNOTE *,'                                                    '         03850000
 MNOTE *,'                                                    '         03860000
 MNOTE *,'                        **************************  '         03870000
 MNOTE *,'                        *       *       *        *  '         03880000
 MNOTE *,'                        * &KVL(17) * &KVL(18) *  &KVL(19) *'  03890000
 MNOTE *,'                        *       *       *        *  '         03900000
 MNOTE *,'                        **************************  '         03910000
 MNOTE *,'                        *       *       *        *  '         03920000
 MNOTE *,'                        * &KVL(20) * &KVL(21) *  &KVL(22) *'  03930000
 MNOTE *,'                        *       *       *        *  '         03940000
 MNOTE *,'                        **************************  '         03950000
 MNOTE *,'                        *       *       *        *  '         03960000
 MNOTE *,'                        * &KVL(23) * &KVL(24) *  &KVL(25) *'  03970000
 MNOTE *,'                        *       *       *        *  '         03980000
 MNOTE *,'     *********************************************  '         03990000
 MNOTE *,'     *        *         *       *       *        *  '         04000000
 MNOTE *,'     *  &KVL(12) *  &KVL(14)  * &KVL(26) * &KVL(27) *  &KVL(2*04010000
               8) *'                                                    04020000
 MNOTE *,'     *        *         *       *       *        *  '         04030000
 MNOTE *,'     *********************************************  '         04040000
         MNOTE *,' '                                                    04050000
         MNOTE *,' '                                                    04060000
         MNOTE *,' '                                                    04070000
         MNOTE *,' '                                                    04080000
         MNOTE *,' '                                                    04090000
         MNOTE *,' '                                                    04100000
&L       SETA  &L+1                                                     04110000
         AIF   (&L LT &COPIES).PRTLOOP                           93057  04120000
         MEND ,                                                         04130000
./ ADD NAME=XFORMAT
         MACRO                                                          00010000
         XFORMAT &DB=DB                                         GP13008 00020000
         GBLB  &INLINE(50)                                              00030000
         COPY  OPTIONS                                                  00040000
         LCLC  &WK           DOUBLE-WORD WORK SPACE              88025  00050000
         LCLB  &INMOVE,&INWORK                                  GP09347 00060000
&WK      SETC  '&DB'         USE USER'S                          88025  00070000
         AIF   ('&WK' NE '').HAVEWK    OK                        88025  00080000
&WK      SETC  'DCONDB'      GENERATE LOCALLY                    88025  00090000
.*       (1)   EXPANSION SWITCH                                         00100000
.*       (5)   INLINE HEX EXPANSION                                     00110000
.*       (6)   CVH / CNVD CALL                                          00120000
.*       (7)   CNVR / CNVX CALL                                         00130000
.*       (8)   CVI - FORMAT INTEGER WITH COMMAS AND SCALING             00140000
.*       (9)   IN-LINE TRANSLATE TABLE (3278 CHARS)                     00150000
.*       (10)  CALL TO RANDOM                                           00160000
.*       (11)  INLINE DECIMAL EXPANSION                                 00170000
.*       (12)  INTEGER + 1 DECIMAL                              GP13008 00180000
.*       (13)  INTEGER + 2 DECIMALS                             GP13008 00190000
.*       (14)  INTEGER + 3 DECIMALS                             GP13008 00200000
.*                                                                      00210000
.HAVEWK  AIF   (NOT &INLINE(1)).OKONCE                          GP13008 00220000
         MNOTE 4,'MULTIPLE ''INSECT/XFORMAT'' CALLS INVALID'    GP13008 00230000
         MEXIT ,                                                        00240000
.OKONCE  ANOP  ,                                                GP13008 00250000
&INLINE(1) SETB 1            SHOW EXPANSION REQUESTED           GP13008 00260000
         AIF   (&INLINE(2) AND &INLINE(3)).OK1                          00270000
         AIF   (NOT &INLINE(2) AND NOT &INLINE(3)).OK3                  00280000
         MNOTE 4,'INCONSISTENT USE OF ''SPxxxx'' CALLS'         GP13008 00290000
.OK1     MNOTE 4,'REPLACE SPxxxx CALLS BY XLINE'                GP13008 00300000
.OK3     ANOP  ,                                                GP09347 00310000
&INLINE(5) SETB (&INLINE(5) OR &INLINE(11))                     GP09347 00320000
&INWORK  SETB  (&INLINE(5))                                     GP10037 00330000
         AIF   (NOT &INLINE(12)).OK6P1                          GP13008 00340000
         SPACE 1                                                        00350000
*        CONVERT BINARY TO EBCDIC  NNN.N                        GP13008 00360000
*        (0) - VALUE    (1) O/P ADDRESS     (15) - O/P LENGTH   GP13008 00370000
*                                                               GP13008 00380000
DCONVONE STM   R14,R3,12(R13)                                   GP13008 00390000
         MVC   DCONWORK-1(17),DCONPONE                          GP13008 00400000
         B     DCONPCOM                                         GP13008 00410000
DCONPONE DC    C' ',12X'20',X'21204B20' .   EDIT MASK           GP13008 00420000
.OK6P1   AIF   (NOT &INLINE(13)).OK6P2                          GP13008 00430000
         SPACE 1                                                        00440000
*        CONVERT BINARY TO EBCDIC  NNN.NN                       GP13008 00450000
*        (0) - VALUE    (1) O/P ADDRESS     (15) - O/P LENGTH   GP13008 00460000
*                                                               GP13008 00470000
DCONVTWO STM   R14,R3,12(R13)                                   GP13008 00480000
         MVC   DCONWORK-1(17),DCONPTWO                          GP13008 00490000
         B     DCONPCOM                                         GP13008 00500000
DCONPTWO DC    C' ',11X'20',X'21204B2020' .   EDIT MASK         GP13008 00510000
.OK6P2   AIF   (NOT &INLINE(14)).OK6COM                         GP13008 00520000
         SPACE 1                                                        00530000
*        CONVERT BINARY TO EBCDIC  NNN.NNN                      GP13008 00540000
*        (0) - VALUE    (1) O/P ADDRESS     (15) - O/P LENGTH   GP13008 00550000
*                                                               GP13008 00560000
DCONVTRE STM   R14,R3,12(R13)                                   GP13008 00570000
         MVC   DCONWORK-1(17),DCONPTRE                          GP13008 00580000
         B     DCONPCOM                                         GP13008 00590000
DCONPTRE DC    C' ',10X'20',X'21204B202020' . EDIT MASK         GP13008 00600000
.OK6COM  AIF (NOT &INLINE(12) AND NOT &INLINE(13) AND NOT &INLINE(14)).*00610000
               OK6P                                             GP13008 00620000
DCONPCOM CVD   R0,&WK        MAKE VALUE PACKED                  GP13008 00630000
         ED    DCONWORK-1(17),&WK                               GP13008 00640000
&INWORK  SETB  1                                                GP13008 00650000
&INMOVE  SETB  1                                                GP13008 00660000
         AIF   (NOT &INLINE(6)).OK6P                            GP13008 00670000
         B     DCONCOM       GO TO OUTPUT MOVE                          00680000
.OK6P    AIF   (NOT &INLINE(6)).OK6                                     00690000
         SPACE 2                                                        00700000
*        CONVERT BINARY TO EBCDIC                                       00710000
*        (0) - VALUE    (1) O/P ADDRESS     (15) - O/P LENGTH           00720000
*                                                                       00730000
DCONVERT STM   R14,R3,12(R13)                                           00740000
         MVC   DCONWORK(16),DCONPAT                                     00750000
DCONVCOM CVD   R0,&WK        MAKE VALUE PACKED                          00760000
         ED    DCONWORK,&WK                                             00770000
&INWORK  SETB  1                                                GP09347 00780000
&INMOVE  SETB  1                                                GP09347 00790000
         AIF   (NOT &INLINE(7) AND NOT &INLINE(8)).DOCON        GP09347 00800000
         B     DCONCOM       GO TO OUTPUT MOVE                          00810000
.OK6     AIF   (NOT &INLINE(8)).OK8                                     00820000
         SPACE 2                                                        00830000
*        CONVERT BINARY TO EBCDIC                               GP09347 00840000
*        (0) - VALUE    (1) O/P ADDRESS     (15) - O/P LENGTH   GP09347 00850000
*                                                               GP09347 00860000
ICONVERT STM   R14,R3,12(R13)                                   GP09347 00870000
&INWORK  SETB  1                                                GP09347 00880000
&INMOVE  SETB  1                                                GP09347 00890000
         CVD   R0,&WK        MAKE VALUE PACKED                  GP09347 00900000
         MVC   DCONWORK-1(17),DCOMPAT                           GP09347 00910000
         ED    DCONWORK-1(17),&WK                               GP09347 00920000
         CLI   DCONWORK+8,C' '    LESS THAN 1M?                 GP09347 00930000
         BE    DCONCOM       YES; MOVE IT                       GP09347 00940000
         LA    R2,DCONWORK+13                                   GP09347 00950000
         MVI   DCONWORK+12,C'K'                                 GP09347 00960000
         SR    R2,R15                                           GP09347 00970000
         LR    R3,R15                                           GP09347 00980000
         BCTR  R3,0                                             GP09347 00990000
         EX    R3,DCONMOVE                                      GP09347 01000000
         LM    R14,R3,12(R13)                                   GP09347 01010000
         BR    R14                                              GP09347 01020000
DCOMPAT  DC    X'402020202020202020202020206B202120'            GP09347 01030000
.OK8     AIF   (NOT &INLINE(7)).DOCON                           GP09347 01040000
         SPACE 2                                                        01050000
*        CONVERT HEX TO EBCDIC                                          01060000
*        (0) - INPUT ADDR.   (1) - O/P ADDR.   (15) - O/P LENGTH        01070000
*                                                                       01080000
XCONVERT STM   R14,R3,12(R13)                                           01090000
         LA    R3,1(,R15) .     O/P LEN + 1                             01100000
         SRA   R3,1 .        /2                                         01110000
         AR    R3,R0 .        I/P + 1/2  O/P LEN                        01120000
         SH    R3,DCONH8     - 8                                        01130000
&INWORK  SETB  1                                                GP09347 01140000
&INMOVE  SETB  1                                                GP09347 01150000
         UNPK  DCONWORK(9),0(5,R3) .    UNPACK FIRST WORD               01160000
         UNPK  DCONWORK+8(9),4(5,R3) .     SECOND WORD                  01170000
         TR    DCONWORK(16),HEXTAB .    MAKE VIEWABLE                   01180000
         SPACE                                                          01190000
.DOCON   AIF   (NOT &INMOVE).OK6Z                                       01200000
DCONCOM  LA    R2,DCONWORK+16                                           01210000
         SR    R2,R15                                                   01220000
         LR    R3,R15                                                   01230000
         BCTR  R3,0                                                     01240000
&INMOVE  SETB  1                                                GP09347 01250000
         EX    R3,DCONMOVE                                              01260000
         LM    R14,R3,12(R13)                                           01270000
         BR    R14                                                      01280000
         SPACE                                                          01290000
.OK6Z    AIF   ('&DB' NE '').OKWK                                88025  01300000
DCONDB   DC    D'0'          LOCAL WORK AREA                     88025  01310000
.OKWK    ANOP  ,                                                 88025  01320000
DCONPAT  DC    C' ',13X'20',X'2120' .     EDIT MASK                     01330000
         AIF   (NOT &INLINE(11) AND NOT &INMOVE).OK7            GP09347 01340000
DCONMOVE MVC   0(0,R1),0(R2)                                            01350000
DCONH8   DC    H'8'                                                     01360000
.OK7     AIF   (NOT &INWORK).B8                                 GP09347 01370000
         DS    C       1/2                                      GP09347 01380000
DCONWORK DS    CL16    2/2                                      GP09347 01390000
         DS    C                                                        01400000
         ORG   DCONWORK                                                 01410000
UPD      DS    CL9                                                      01420000
         ORG                                                            01430000
HEXTAB   EQU   *-C'0'                                                   01440000
         DC    C'0123456789ABCDEF'                                      01450000
.B8      AIF   (NOT &INLINE(9)).OK9                                     01460000
TRTAB    TRTAB CODE=&CRT,OPT=ERR                                        01470000
.OK9     AIF   (NOT &INLINE(10)).OK10                                   01480000
         RANDOM ,                                                       01490000
.OK10    ANOP                                                           01500000
         MEND                                                           01510000
./ ADD NAME=XMSG
         MACRO ,                                         NEW ON GP08079 00010000
&NM      XMSG  &MID,&TYPE=MSG,   FORMAT A MESSAGE FOR WTO OR PRT       *00020000
               &LIST=,&PARM=,&ERRET=  MSG WITH TEXT INSERTION           00030000
         GBLC  &MACPLAB,&ZZXMWRK                                        00040000
         GBLA  &MACP#        NUMBER OF (SUB)LIST ARGUMENTS              00050000
         GBLC  &MACP1,&MACP2,&MACP3,&MACP4,&MACP5                       00060000
         GBLC  &MACP6,&MACP7,&MACP8,&MACP9,&MACP10                      00070000
         LCLA  &K,&I,&J,&N,&M,&O                                        00080000
         LCLB  &TF                                                      00090000
         LCLC  &RA,&RL,&RT,&L  DEFINE ADDRESS AND LENGTH REGISTERS      00100000
         LCLC  &TYPA(23),&TYVL(23)                                      00110000
         LCLC  &LIT          SPECIAL HANDLING FOR LITERAL OPERANDS      00120000
&RA      SETC  'R1'          SET NORMAL USE                             00130000
&RL      SETC  'R0'                                                     00140000
&L       SETC  'L'''                                                    00150000
&MACPLAB SETC  '&NM'         SET NAME FIELD                             00160000
         AIF   ('&PARM' EQ '').DEFPARM                                  00170000
&ZZXMWRK SETC  '&PARM'       SET NEW WORK AREA                          00180000
.DEFPARM AIF   ('&ZZXMWRK' NE '').USEPARM                               00190000
&ZZXMWRK SETC  'XMSGMGPM'    USE DEFAULT MDEFPARM NAME                  00200000
.USEPARM ANOP  ,                                                        00210000
.*--------------------------------------------------------------------* 00220000
.*                                                                    * 00230000
.*  XMSG GENERATES A CALL TO MESSAGE FORMATTING/DEFINITION PROGRAM    * 00240000
.*  EXHMGxxx PREVIOUSLY LOADED AND STORED IN XMSGMGPM(1)              * 00250000
.*                                                                    * 00260000
.*   name XMSG  modname,LIST=(buffer,buflen),TYPE=INIT                * 00270000
.*      LOADS THE MESSAGE MODULE, AND SETS THE BUFFER INFORMATION     * 00280000
.*                                                                    * 00290000
.*   name XMSG  modname,TYPE=CLOSE                                    * 00300000
.*      FREES THE MESSAGE MODULE                                      * 00310000
.*                                                                    * 00320000
.*   name XMSG  mid,LIST=(addr,'text',(addr,len),(addr,len,type)...)  * 00330000
.*                                                                    * 00340000
.*  mid  SPECIFIES THE MESSAGE ID:                                    * 00350000
.*    A) AS A LITERAL                                                 * 00360000
.*    B) ADDRESS OF A TEXT STRING OF LENGTH 8                         * 00370000
.*                                                                    * 00380000
.*  TYPE=END (OR A TEXT SPECIFICATION OF *END) REQUESTS PROGRAM       * 00390000
.*    TO CLEAN UP AND RELEASE STORAGE                                 * 00400000
.*                                                                    * 00410000
.*  TYPE=TEXT (DEFAULT) BYPASSES THE WTO, BUT RETURNS THE MESSAGE     * 00420000
.*    ADDRESS: H'LEN,0',CL(LEN)'TEXT' USABLE IN WTO OR PRTV           * 00430000
.*  TYPE=MSG  SPECIFIES A MESSAGE TO BE WRITTEN TO THE OPERATOR       * 00440000
.*                                                                    * 00450000
.*    LIST OPERANDS SPECIFY TEXT TO BE INSERTED INTO THE MESSAGE      * 00460000
.*    AS DEFINED. AN OMITTED LENGTH FIELD (FOR NON-LITERAL) EXPANDS   * 00470000
.*    AS L'addr.                                                      * 00480000
.*    TYPE OPERANDS DEFAULT TO THOSE IN THE MESSAGE DEFINITION, OR    * 00490000
.*      CHARACTER STRING IF NOT DEFINED THERE, EITHER.                * 00500000
.*    VALID ARE: C or T FOR CHARACTER TEXT; A FOR ADDRESS (HEX);      * 00510000
.*      I or INT FOR INTEGERES; P, D, or PD FOR PACKED DECIMAL;       * 00520000
.*      H, X, or HEX FOR HEXADECIMAL; B or BIN FOR BINARY/BIT         * 00530000
.*                                                                    * 00540000
.*  PARM=mdefparm DEFINES A REMOTE PARAMETER LIST TO BE USED (SEE     * 00550000
.*    EXPANSION OF MDEFPARM FOR FORMAT.                               * 00560000
.*                                                                    * 00570000
.*                                                                    * 00580000
.*--------------------------------------------------------------------* 00590000
&N       SETA  N'&LIST                                                  00600000
&TYPA(01) SETC 'C'           CHARACTER STRING                           00610000
&TYPA(02) SETC 'CHAR'                                                   00620000
&TYPA(03) SETC 'T'           TEXT STRING                                00630000
&TYPA(04) SETC 'TEXT'                                                   00640000
&TYPA(05) SETC '@'           ADDRESS                                    00650000
&TYPA(06) SETC 'A'                                                      00660000
&TYPA(07) SETC 'ADDR'                                                   00670000
&TYPA(08) SETC 'P'           PACKED DECIMAL                             00680000
&TYPA(09) SETC 'D'                                                      00690000
&TYPA(10) SETC 'PD'                                                     00700000
&TYPA(11) SETC 'DEC'                                                    00710000
&TYPA(12) SETC 'UP'          UNSIGNED (ABSOLUTE) PD                     00720000
&TYPA(13) SETC 'UD'                                                     00730000
&TYPA(14) SETC 'UPD'                                                    00740000
&TYPA(15) SETC 'I'           INTEGER                                    00750000
&TYPA(16) SETC 'INT'                                                    00760000
&TYPA(17) SETC 'UI'          UNSIGNED / ABSOLUTE INT                    00770000
&TYPA(18) SETC 'AI'                                                     00780000
&TYPA(19) SETC 'H'           HEXADECIMAL                                00790000
&TYPA(20) SETC 'X'                                                      00800000
&TYPA(21) SETC 'HEX'                                                    00810000
&TYPA(22) SETC 'B'           BIT STRING                                 00820000
&TYPA(23) SETC 'BIN'                                                    00830000
&TYVL(01) SETC '1'                                                      00840000
&TYVL(02) SETC '1'                                                      00850000
&TYVL(03) SETC '1'                                                      00860000
&TYVL(04) SETC '1'                                                      00870000
&TYVL(05) SETC '2'                                                      00880000
&TYVL(06) SETC '2'                                                      00890000
&TYVL(07) SETC '2'                                                      00900000
&TYVL(08) SETC '3'                                                      00910000
&TYVL(09) SETC '3'                                                      00920000
&TYVL(10) SETC '3'                                                      00930000
&TYVL(11) SETC '3'                                                      00940000
&TYVL(12) SETC '4'                                                      00950000
&TYVL(13) SETC '4'                                                      00960000
&TYVL(14) SETC '4'                                                      00970000
&TYVL(15) SETC '5'                                                      00980000
&TYVL(16) SETC '5'                                                      00990000
&TYVL(17) SETC '6'                                                      01000000
&TYVL(18) SETC '6'                                                      01010000
&TYVL(19) SETC '8'                                                      01020000
&TYVL(20) SETC '8'                                                      01030000
&TYVL(21) SETC '8'                                                      01040000
&TYVL(22) SETC '9'                                                      01050000
&TYVL(23) SETC '9'                                                      01060000
         AIF   ('&MID' EQ '*END').CLOSE                                 01070000
         AIF   ('&TYPE' EQ 'CLOSE' OR '&TYPE' EQ 'END').CLOSE           01080000
         AIF   ('&TYPE' NE 'INIT' AND '&TYPE' NE 'NAME').DOMSG          01090000
         AIF   ('&MID' EQ '').NOMOD  LET IT FAIL                        01100000
&LIT     SETC  '&MID'                                                   01110000
         AIF   ('&MID'(1,1) NE '''').NOMOD                              01120000
&LIT     SETC  '=CL8'.'&LIT'                                            01130000
         MACPARM R0,&LIT,OP=LA  LOAD ADDRESS OF MODULE NAME             01140000
         AGO   .GOMOD                                                   01150000
.NOMOD   MACPARM R0,&LIT,OP=LA  LOAD ADDRESS OF MODULE NAME             01160000
.GOMOD   ANOP  ,                                                        01170000
&MACPLAB LOAD  EPLOC=(0),ERRET=&ERRET  LOAD; OPTIONAL RECOVERY          01180000
&MACPLAB SETC  ''                                                       01190000
         MACPARM R0,&ZZXMWRK,OP=ST   SAVE THE MODULE ADDRESS            01200000
         MACPARM R0,&LIST(1),NULL=XMSGMSG-XMSGADD+&ZZXMWRK              01210000
         MACPARM R1,&LIST(2),NULL=&L.XMSGMSG                            01220000
         MACPARM R0,R1,XMSGBUF-XMSGADD+&ZZXMWRK,MODE=THREE,OP=STM       01230000
.DONEIN  MEXIT ,                                                        01240000
.CLOSE   MACPARM &ZZXMWRK.(4),&ZZXMWRK,OP=XC  CLEAR THE ADDRESS         01250000
         AIF   ('&MID' EQ '').DONEND                                    01260000
&LIT     SETC  '&MID'                                                   01270000
         AIF   ('&MID'(1,1) NE '''').NODEL                              01280000
&LIT     SETC  '=CL8'.'&LIT'                                            01290000
         MACPARM R0,&LIT,OP=LA  LOAD MESSAGE ADDRESS                    01300000
         AGO   .GODEL                                                   01310000
.NODEL   MACPARM R0,&LIT,OP=LA  LOAD MESSAGE ADDRESS                    01320000
.GODEL   DELETE EPLOC=(0)    DELETE MESSAGE MODULE                      01330000
.DONEND  MEXIT ,                                                        01340000
.*--------------------------------------------------------------------* 01350000
.*  PROCESS A MESSAGE LIST (TEXT/LEN OPTIONAL DEPENDING ON MESSAGE)   * 01360000
.*--------------------------------------------------------------------* 01370000
.DOMSG   MACPARM R1,&ZZXMWRK LOAD CALLING AREA ADDRESS                  01380000
         AIF   ('&MID' EQ '').NOMID  LET IT FAIL                        01390000
&LIT     SETC  '&MID'                                                   01400000
         AIF   ('&MID'(1,1) NE '''').NOMID                              01410000
&LIT     SETC  '=CL8'.'&LIT'                                            01420000
         MACPARM R15,&LIT,OP=LA  LOAD MESSAGE ADDRESS                   01430000
         AGO   .GOMID                                                   01440000
.NOMID   MACPARM R15,&LIT,OP=L   LOAD MESSAGE ADDRESS                   01450000
.GOMID   MACPARM XMSGMID-XMSGMGPM(L'XMSGMID,R1),0(R15),OP=MVC MOVE TEXT 01460000
&TF      SETB   (NOT ('&TYPE' EQ 'MSG'))                                01470000
         MACPARM R0,&TF      SET FLAG (0-WTO; 1-NO WTO,RETURN MSG ADD)  01480000
         AIF   (&N EQ 0).GOMSG                                          01490000
&O       SETA    20          OFFSET IN GENERATED LIST                   01500000
&M       SETA    1           OFFSET IN LIST=                            01510000
.*--------------------------------------------------------------------* 01520000
.*  CASE 2  - LOOP THROUGH SUPPLIED ADDRESS/LEN PAIRS AND STASH       * 01530000
.*--------------------------------------------------------------------* 01540000
.LSTADD  AIF   (&M GT &N).LSTEND  DONE - SET VL BIT IN LIST             01550000
&K       SETA  0             TYPE NOT NEEDED                            01560000
         MACLIST &LIST(&M)   GET SUBLIST ITEMS                          01570000
&RA      SETC  '&MACP1'                                                 01580000
&RL      SETC  '&MACP2'                                                 01590000
         AIF   ('&RA' NE '').HAVERA                                     01600000
&RA      SETC  '0'           NULL ADDRESS - NO SUBSTITUTION             01610000
.HAVERA  AIF   ('&RL' NE '').HAVERL                                     01620000
&RL      SETC  '0'           NULL ADDRESS - NO SUBSTITUTION             01630000
.*--------------------------------------------------------------------* 01640000
.*  CASE 2A - EXPLICIT TEXT/LEN SUPPLIED                              * 01650000
.*--------------------------------------------------------------------* 01660000
.HAVERL  AIF   ('&RA'(1,1) EQ '''').ENTRNG                              01670000
         MACPARM R15,&RA,OP=LA LOAD ADDRESS OF NAME OR REGISTER         01680000
         MACPARM R15,&O.(,R1),OP=ST STORE ADDRESS IN CALL LIST          01690000
         AIF   ('&MACP2' NE '').GOODRL                                  01700000
         AIF   ('&MACP1' EQ '').GOODRL                                  01710000
         MACPARM R15,&L&MACP1   USE DEFAULT LENGTH                      01720000
         AGO   .COMMRL                                                  01730000
.GOODRL  MACPARM R15,&RL,NULL=0   SET EXPLICIT LENGTH OR 0              01740000
.COMMRL  MACPARM R15,&O+4(,R1),OP=STH STORE LENGTH IN CALL LIST         01750000
         AIF   ('&MACP3' EQ '').COMMK0                                  01760000
&I       SETA  1                                                        01770000
.TYLOOP  AIF   ('&MACP3' EQ '&TYPA(&I)').SETK0                          01780000
&I       SETA  &I+1                                                     01790000
         AIF   (&I LE 23).TYLOOP                                        01800000
 MNOTE 8,'XMSG: TYPE &MACP3 NOT RECOGNIZED, IGNORED'                    01810000
         AGO   .COMMK0                                                  01820000
.SETK0   ANOP  ,                                                        01830000
&K       SETA  &TYVL(&I)                                                01840000
         AIF   (&K EQ 0).COMMK0                                         01850000
         MACPARM &O+4(R1),&K,OP=MVI   SET PARM TYPE                     01860000
.COMMK0  ANOP  ,                                                        01870000
&O       SETA   &O+6         NEXT AVAILABLE LIST OFFSET                 01880000
&M       SETA   &M+1                                                    01890000
         AGO   .LSTADD                                                  01900000
.*--------------------------------------------------------------------* 01910000
.*  CASE 2B - EXPLICIT QUOTED TEXT SUPPLIED                           * 01920000
.*--------------------------------------------------------------------* 01930000
.ENTRNG  ANOP  ,                                                        01940000
&K       SETA  K'&RA-2       LENGTH OF QUOTED STRING (EXC AMPSND/QOT)   01950000
&I       SETA  2             FIRST BYTE TO EXAMINE                      01960000
&J       SETA  &K            LAST BYTE (PAIR) TO EXAMINE                01970000
.ENTLOOP AIF   (&I GT &J).ENTEXP                                        01980000
         AIF   ('&RA'(&I,2) EQ '''''' OR '&RA'(&I,2) EQ '&&').ENDPR     01990000
&I       SETA  &I+1          TRY AGAIN                                  02000000
         AGO   .ENTLOOP                                                 02010000
.ENDPR   ANOP  ,                                                        02020000
&I       SETA  &I+2          SKIP THE PAIR                              02030000
&K       SETA  &K-1          AND CORRECT THE LENGTH                     02040000
         AGO   .ENTLOOP                                                 02050000
.ENTEXP  LA    R15,=C&RA     LOAD THE STRING ADDRESS                    02060000
         MACPARM R15,&O.(,R1),OP=ST STORE ADDRESS IN CALL LIST          02070000
         MACPARM R15,&K+256,OP=LA LOAD THE LENGTH OF THE STRING / TYPE  02080000
         MACPARM R15,&O+4(,R1),OP=STH STORE LENGTH IN CALL LIST         02090000
&O       SETA   &O+6         NEXT AVAILABLE LIST OFFSET                 02100000
&M       SETA   &M+1                                                    02110000
         AGO   .LSTADD                                                  02120000
.LSTEND  ANOP  ,                                                        02130000
&O       SETA  &O-6          POSITION TO LAST WORD IN LIST              02140000
         MACPARM &O.(R1),X'80',OP=OI                                    02150000
         AGO   .COMBAS  DONE - INVOKE SUBWTO                            02160000
.GOMSG   MACPARM 20(16,R1),20(R1),OP=XC                                 02170000
         OI    20(R1),X'80'  EMPTY LIST                                 02180000
.*--------------------------------------------------------------------* 02190000
.*  LOAD R0 AND R1 APPROPRIATELY; CALL MESSAGE ROUTINE                * 02200000
.*--------------------------------------------------------------------* 02210000
.COMBAS  MACPARM R15,&ZZXMWRK,OP=L   MODE ADDRESS IN LIST               02220000
         BASR  R14,R15       INVOKE IT                                  02230000
         MEND  ,                                                        02240000
./ ADD NAME=XRAND
         MACRO ,                                                        00010000
&NM      XRAND &OPT=                                        NEW GP13105 00020000
.*                                                                      00030000
.*  INVOKES THE RANDOM NUMBER GENERATOR IN EXHBWORK                     00040000
.*  RETURN IS INTEGER 0-9 IN GPR 0, AND 0.0-9.0 IN FPR 0                00050000
.*    OPT=INIT RESTARTS WITH TIME-BASED VALUE                           00060000
.*                                                                      00070000
         GBLC  &MACPLAB                                                 00080000
&MACPLAB SETC  '&NM'                                                    00090000
         AIF   ('&OPT' NE 'INIT').CONTIN                                00100000
         MACPARM R15,EXWRANDI,OP=L                                      00110000
         XC    0(8,R15),0(R15)    INITIALIZE                            00120000
.CONTIN  MACPARM R15,EXWRAND,OP=L                                       00130000
         MACPARM R14,R15,OP=BALR,OPR=BALR                               00140000
         MEND  ,                                                        00150000
./ ADD NAME=XREQUIRE
         MACRO                                                          00010000
&NM      XREQUIRE &OPTS,&B=EXCXCB,&MINLS=,&MINLN=               GP10206 00020000
         GBLC  &MACPLAB                                                 00030000
.********************************************************************** 00040000
.*   EXHIBIT MACRO TO TEST (AND FAIL) IMPROPER MODULE INVOCATION     ** 00050000
.*     (WAS NAMED RESTRICT)                                          ** 00060000
.********************************************************************** 00070000
         LCLA  &I,&M                                                    00080000
         LCLB  &TRUE,&F(36)                                     GP07007 00090000
         LCLC  &C,&J                                            GP10213 00100000
&M       SETA  N'&SYSLIST                                               00110000
&J       SETC  '&SYSNDX'                                                00120000
&I       SETA  0                                                        00130000
&MACPLAB SETC  '&NM'                                                    00140000
.LOOP    AIF   (&I GE &M).LEND                                          00150000
&I       SETA  &I+1                                                     00160000
&C       SETC  '&SYSLIST(&I)'                                           00170000
         AIF   ('&C' EQ '').LOOP                                        00180000
&F(2)    SETB  (('&C' EQ 'PCP') OR &F(2))                               00190000
&F(3)    SETB  (('&C' EQ 'MFT') OR &F(3))                               00200000
&F(4)    SETB  (('&C' EQ 'MVT') OR &F(4))                               00210000
&F(6)    SETB  (('&C' EQ 'MP') OR &F(6))                                00220000
&F(7)    SETB  (('&C' EQ 'DAT') OR &F(7))                               00230000
&F(9)    SETB  (('&C' EQ 'TSO') OR &F(9))                        *TSO*  00240000
&F(10)   SETB  (('&C' EQ 'NOTSO') OR &F(10))                     *TSO*  00250000
&F(11)   SETB  (('&C' EQ 'DEBUG') OR &F(11))                            00260000
&F(12)   SETB  (('&C' EQ 'HASP') OR &F(12))                             00270000
&F(12)   SETB  (('&C' EQ 'JES2') OR &F(12))                      89211  00280000
&F(13)   SETB  (('&C' EQ 'CON') OR &F(13))                              00290000
&F(14)   SETB  (('&C' EQ 'PAS') OR &F(14))                              00300000
&F(15)   SETB  (('&C' EQ 'KEY') OR &F(15))                              00310000
&F(16)   SETB  (('&C' EQ 'UNL') OR &F(16))                              00320000
&F(17)   SETB  (('&C' EQ 'VM') OR &F(17))                        79194  00330000
&F(18)   SETB  (('&C' EQ 'GAME') OR ('&C' EQ 'GAMES') OR &F(18))        00340000
&F(19)   SETB  (('&C' EQ 'KEY0') OR &F(19))  ->WITH DEBUG ONLY  GP11260 00350000
&F(21)   SETB  (('&C' EQ '12') OR &F(21))                               00360000
&F(22)   SETB  (('&C' EQ '24') OR &F(22))                               00370000
&F(27)   SETB  (('&C' EQ '40') OR &F(27))                               00380000
&F(28)   SETB  (('&C' EQ '80') OR &F(28))                               00390000
&F(29)   SETB  (('&C' EQ '132') OR &F(29))                       89211  00400000
&F(30)   SETB  (('&C' EQ 'DRDEBUG') OR &F(30))                  GP07007 00410000
         AGO   .LOOP                                                    00420000
.LEND    ANOP  ,                                                        00430000
&TRUE    SETB (&F(2) OR &F(3) OR &F(4) OR &F(6) OR &F(7))               00440000
         AIF   (NOT &TRUE).SK1                                          00450000
         NEED  CVT                                                      00460000
&NM   MACPARM  WRKSYS,&F(2)*CVT1SSS+&F(3)*CVT2SPS+&F(4)*CVT4MS1+&F(6)*C*00470000
               VT4MPS+&F(7)*CVT6DAT,OP=TM  TEST SYSTEM BITS             00480000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 00490000
.SK1     ANOP  ,                                                        00500000
&TRUE    SETB (&F(13) OR &F(14) OR &F(16) OR &F(15))                    00510000
         AIF   (NOT &TRUE).SK2                                          00520000
         MACPARM EXCPRIV,EXCPSYS,OP=TM KEY MODE ?                       00530000
&TRUE    SETB (&F(13) OR &F(14) OR &F(16))                       *TSM*  00540000
         AIF   (NOT &TRUE).N15                                   *TSM*  00550000
         BO    ZZX&J.K       SKIP ALL TESTS IF IN KEY MODE      GP10213 00560000
         AIF   (NOT &F(13) OR NOT &F(14)).N13                           00570000
         TM    EXCPRIV,EXCONSOL .  CONTROL DESK ?                       00580000
         BZ    ZZX&J.I       NO; SKIP THE NEXT TEST             GP10206 00590000
         TM    EXCPRIV,EXCONCAN .   SUPPLIED PASSWORD ?                 00600000
.N15     MACPARM &B,MODE=ONE,OP=BZ,OPR=BZR                      GP10206 00610000
ZZX&J.I  EQU   * .           BYPASS IF IN KEY MODE              GP10206 00620000
&F(13)   SETB  0                                                        00630000
&F(14)   SETB  0                                                        00640000
.N13     ANOP                                                           00650000
         AIF   (NOT &F(16) AND NOT &F(14)).N16                          00660000
         TM    EXCPRIV,EXCAUTH*&F(16)+EXCONCAN*&F(14) .  PASS/UNL ?     00670000
         MACPARM &B,MODE=ONE,OP=BZ,OPR=BZR                      GP10206 00680000
.N16     AIF   (NOT &F(13)).SS2                                         00690000
         TM    EXCPRIV,EXCONSOL .  CONTROL DESK CRT ?                   00700000
         MACPARM &B,MODE=ONE,OP=BZ,OPR=BZR                      GP13221 00710000
.SS2     ANOP                                                           00720000
ZZX&J.K  EQU   * .           BYPASS IF IN KEY MODE                      00730000
.SK2     AIF   (NOT &F(12)).SKCRT                                       00740000
         MACPARM HASPHCT+1(3),ZEROES,OP=CLC                             00750000
         MACPARM &B,MODE=ONE,OP=BE,OPR=BER                      GP10206 00760000
.SKCRT   AIF   (NOT &F(21) AND NOT &F(22)).SKCB                         00770000
         MACPARM LNO+1,LN24+LN32,OP=TM . MORE THAN 15 LINES ?    78051  00780000
         AIF   (&F(22)).SKC2                                            00790000
         MACPARM &B,MODE=ONE,OP=BZ,OPR=BZR                      GP10206 00800000
         AGO   .SKCB                                                    00810000
.SKC2    MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 00820000
.SKCB    AIF   (NOT &F(27) AND NOT &F(28) AND NOT &F(29)).SKOTH  89211  00830000
         MACPARM LSIZE+1,80,OP=CLI  40 OR 80 BYTE CRT ?          88249  00840000
         BC    2*&F(29)+8*&F(28)+4*&F(27),&B                     91364  00850000
         MACPARM 2*&F(29)+8*&F(28)+4*&F(27),&B,OP=BC,OPR=BCR    GP10206 00860000
.SKOTH   AIF   (NOT &F(11)).SKNDEB                                      00870000
         AIF   (NOT &F(9)).SKBOPT  SKIP COMBINED TEST            78216  00880000
         MACPARM OPTS,DEBUG+OPTSO,OP=TM DEBUG OR TSO ?           78216  00890000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 00900000
         AGO   .SKTSO                                            78216  00910000
.SKBOPT  ANOP  ,                                                 78216  00920000
         MACPARM OPTS,DEBUG,OP=TM . RUNNING DEBUG MODE ?                00930000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 00940000
.SKNDEB  AIF   (NOT &F(9) AND NOT &F(10)).SKTSO                  *TSO*  00950000
         MACPARM OPTS,OPTSO,OP=TM . RUNNING UNDER TSO ?          *TSO*  00960000
         AIF   (NOT &F(9)).NTTSO                                 *TSO*  00970000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 00980000
         AGO   .SKTSO                                            *TSO*  00990000
.NTTSO   ANOP  ,                                                 *TSO*  01000000
         MACPARM &B,MODE=ONE,OP=BZ,OPR=BZR                      GP10206 01010000
.SKTSO   AIF   (NOT &F(17) AND NOT &F(18)).NOSS18                79194  01020000
         MACPARM SQSAVPO,SQSAFVM*&F(17)+SQSNGAM*&F(18),OP=TM     79194  01030000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 01040000
.NOSS18  AIF   (NOT &F(19)).NOSAVP     NO KEY0 CHECK            GP11260 01050000
         MACPARM OPTS,DEBUG,OP=TM . RUNNING DEBUG MODE ?        GP11260 01060000
         MACPARM &B,MODE=ONE,OP=BZ,OPR=BZR                      GP11260 01070000
         TESTAUTH KEY=YES,FCTN=0,RBLEVEL=1  KEY ZERO ?          GP11260 01080000
         LTR   R15,R15                                          GP11260 01090000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP11260 01100000
.NOSAVP  AIF   (NOT &F(30)).SS30                                        01110000
         TM    DRFLAG,DRDEBUG  DASD FUNCTION IN DEBUG MODE ?    GP07007 01120000
         MACPARM &B,MODE=ONE,OP=BNZ,OPR=BNZR                    GP10206 01130000
.SS30    AIF   (T'&MINLS EQ 'O').SS31                           GP10206 01140000
         CLI   LSIZE+1,&MINLS                                   GP10206 01150000
         MACPARM &B,MODE=ONE,OP=BL,OPR=BLR                      GP10206 01160000
.SS31    AIF   (T'&MINLN EQ 'O').SS32                           GP10206 01170000
         CLI   LNO+1,&MINLN                                     GP10206 01180000
         MACPARM &B,MODE=ONE,OP=BL,OPR=BLR                      GP10206 01190000
.SS32    ANOP  ,                                                GP10206 01200000
         MEND  ,                                                        01210000
./ ADD NAME=XSCLINE
         MACRO ,                                                        00010000
&NM      XSCLINE &FUN=PAGETAB                                   GP13162 00020000
.*   THE XSCLINE MACRO PROVIDES A FULL PAGE OUT, AND READ INPUT GP13162 00030000
.*   SERVICE FOR SCREENS DEFINED USING THE FDLINE SERVICE.      GP13162 00040000
.*   ON ENTRY R0 DEFINES A FUNCTION CODE, THAT *16 IS AN INDEX  GP13162 00050000
.*   INTO A TABLE OF ADDRESSES DEFINED AS:                      GP13162 00060000
.*    A(screen list,help list,prompt,quicktab)                  GP13162 00070000
.*   screen list IS THE ADDRESS VECTOR OF SCLINES THAT COMPOSE  GP13162 00080000
.*     THE SCREEN.                                              GP13162 00090000
.*   help list IS AN ADDRESS VECTOR WITH HELP INFORMATION OR 0  GP13162 00100000
.*   prompt IS THE ADDRESS OF BCON TEXT FOR THE PROMPT MESSAGE  GP13162 00110000
.*   quicktab IS A LIST OF BTAB ENTRIES FOR PF/PA KEYS          GP13162 00120000
.*                                                              GP13162 00130000
         LCLC  &NAME         SUBROUTINE NAME                    GP13162 00140000
&NAME    SETC  '&NM'                                            GP13162 00150000
         AIF   ('&NAME' NE '').DOPROM                           GP13162 00160000
&NAME    SETC  'PAGENEW'                                        GP13162 00170000
.DOPROM  ANOP  ,                                                GP13162 00180000
&NAME    STM   R5,R7,DB2     SAVE OVER SUBROUTINES              GP13162 00190000
         LR    R6,R0         PRESERVE ENTRY CODE                GP13162 00200000
         SLL   R6,4          * 16                               GP13162 00210000
         LA    R6,&FUN.(R6)  POINT TO FUNCTION ADDRESSES    GP13162     00220000
         LA    R5,REPLY      RESET                              GP13162 00230000
         ST    R5,REPPTR       INPUT POINTER                    GP13162 00240000
         ICM   R2,15,8(R6)   GET PROMPT ADDRESS                 GP13162 00250000
         BZ    PAGENPRO        NO PROMPT                        GP13162 00260000
         MVC   ZPROM,BLANKS  CLEAR PROMPT TEXT                  GP13162 00270000
         SR    R1,R1                                            GP13162 00280000
         IC    R1,0(,R2)     GET PROMPT LENGTH                  GP13162 00290000
         BCTR  R1,0            EX LENGTH                        GP13162 00300000
         EX    R1,EXMVCPRO   MOVE PROMPT TO SCREEN              GP13162 00310000
PAGENPRO LM    R2,R3,0(R6)   LOAD MAIN AND HELP SCREEN ADDR     GP13162 00320000
         SCINIT FDW,(R2)     PREPARE FOR SCREEN                 GP13162 00330000
         TM    PROFLAGS,PFCURSE   SET CURSOR ?                  GP13162 00340000
         BZ    PAGEQUE                                          GP13162 00350000
         MVC   FDWCUR,SAVECUR     SET POSITION                  GP13162 00360000
         OI    FDWPROFG,FDWPFCUR  USE CURSOR                    GP13162 00370000
PAGEQUE  MVC   ZCMD,BLANKS   CLEAR INPUT                        GP13162 00380000
         SCLINE FDW,(R2),(R3)  DISPLAY BUFFER AND HELP SCREEN   GP13162 00390000
         BNM   REPLANAL      CHECK INPUT                        GP13162 00400000
         CLI   FDWIAID,1     WHAT CONDITION ?                   GP13162 00410000
         BE    EXCWERR        WRITE ERROR                       GP13162 00420000
         BH    EXCRERR        READ ERROR                        GP13162 00430000
         TM    EXCPRIV,EXCPLOOP  LOOP MODE?                     GP13162 00440000
         BZ    GETOUT        NO RESPONSE FROM USER (OR ERROR)   GP13162 00450000
REPLANAL MVC   REPLY,BLANKS                                     GP13162 00460000
         ICM   R4,15,12(R6)  LOAD QUICKTAB                      GP13162 00470000
         BZ    PAGENQIK        SKIP IF NONE                     GP13162 00480000
         LA    R5,FDWICOD    POINT TO CONVERTED AID             GP13162 00490000
         L     R7,DB2+8      RESTORE GETMAIN BASE               GP13162 00500000
         XLOOK T=(R4),R=FDWICOD    LOOK FOR NON-DATA FUNCTIONS  GP13162 00510000
         MVC   REPLY+6(L'ZCMD),ZCMD  COPY MAJOR COMMAND         GP13162 00520000
PAGENQIK LM    R5,R7,DB2     RESTORE                            GP13162 00530000
         BR    R6                                               GP13162 00540000
EXMVCPRO MVC   ZPROM(*-*),1(R2)   OVE PROMPT TEXT               GP13162 00550000
         MEND  ,                                                        00560000
./ ADD NAME=XTAB
         MACRO                                                          00010000
&NM      XTAB  &STRING,&XCT                                             00020000
&NM      BTAB  &STRING,,&XCT                                            00030000
         MEND                                                           00040000
./ ADD NAME=XTRAP
         MACRO ,                                                        00010000
&NM      XTRAP &LIST,&OPT=(PSW,REGS),&TEST=,&ID=        ADDED ON 86218  00020000
.*                                                                      00030000
.*    THIS MACRO, RUNNING UNDER THE EXORCISE DEBUG PROGRAM, WILL TRACE  00040000
.*    INSTRUCTION FLOW, PRINT VARIABLES, AND DISPLAY REGISTERS          00050000
.*  NAME CHANGED TO XTRAP TO PREMIT XTRACE USE FOR INSTRUCTION TRACE    00060000
.*                                                                      00070000
.*  MAINTENANCE:  2005-06-14  GYP                                       00080000
.*  ALLOW *var AS INDIRECT LOOKUP REQUEST - 24-BIT ADDRESS IN WORD      00090000
.*  ALLOW /var AS INDIRECT INDIRECT LOOKUP                              00100000
.*    IMPLEMENTED BY TRUNCATING PRINTED NAME TO CL7                     00110000
.*                2008-04-18  GYP                                       00120000
.*  LENGTH FIELD CHANGED FROM AL2 TO SL2 USING DEBTROLD         GP10021 00130000
.*                                                                      00140000
         LCLC  &LN,&N,&V,&LAB,&TAG,&C                           GP08109 00150000
         LCLA  &I,&J,&K,&L,&FG,&NL,&R                           GP08109 00160000
         LCLB  &B80,&B40,&B20,&B10,&B08,&B04,&B02,&B01                  00170000
&TAG     SETC  '&ID'         USE OVERRIDE LABEL                         00180000
         AIF   ('&TAG' NE '').HVTAG                                     00190000
&TAG     SETC  '&NM'         ELSE USE NAME FIELD                        00200000
.HVTAG   ANOP  ,                                                        00210000
.*       B01 RESERVED FOR FULL MEMORY DUMP                              00220000
&I       SETA  N'&OPT                                                   00230000
&LN      SETC  'L'''                                                    00240000
&LAB     SETC  '&NM'                                                    00250000
         AIF   ('&TEST' NE '').TEST                                     00260000
         AIF   ('&SYSPARM' NE 'DEBUG').EASY                             00270000
         AGO   .PROCEED                                                 00280000
.TEST    ANOP  ,                                                        00290000
&LAB     TM    OPTS,DEBUG .   RUNNING UNDER EXORCISE ?                  00300000
         BZ    XTR&SYSNDX    NO; BYPASS TRACE                           00310000
&LAB     SETC  ''                                                       00320000
.PROCEED AIF   (&I GT 0).OPTLOOP                                        00330000
         MNOTE 0,'OPTIONS OMITTED - PSW DEFAULTED'                      00340000
&B40     SETB  1                                                        00350000
         AGO   .OPTDONE                                                 00360000
.OPTLOOP AIF   (&J GE &I).OPTDONE                                       00370000
&J       SETA  &J+1                                                     00380000
&B40     SETB  ('&OPT(&J)' EQ 'PSW' OR &B40)                            00390000
&B80     SETB  (('&OPT(&J)' EQ 'PSW' AND '&TAG' NE '') OR &B80)         00400000
&B20     SETB  ('&OPT(&J)' EQ 'REGS' OR &B20)                           00410000
&B10     SETB  ('&OPT(&J)' EQ 'MREGS' OR &B10)                          00420000
&B08     SETB  ('&OPT(&J)' EQ 'MAP' OR &B08)                            00430000
&B04     SETB  ('&OPT(&J)' EQ 'BUFFER' OR &B04)                         00440000
         AGO   .OPTLOOP                                                 00450000
.OPTDONE AIF   ((&B40+&B20+&B10+&B08+&B04+&B02+&B01) GE &I).OPTOK       00460000
         MNOTE 4,'UNRECOGNIZED OPTION SPECIFIED'                        00470000
.OPTOK   ANOP  ,                                                        00480000
&I       SETA  N'&SYSLIST                                               00490000
&J       SETA  0                                                        00500000
.COUNTER AIF   (&J GE &I).COUNTED                                       00510000
&J       SETA  &J+1                                                     00520000
         AIF   ('&SYSLIST(&J)' EQ '').COUNTER                           00530000
&K       SETA  (N'&SYSLIST(&J)+1)/2                                     00540000
&NL      SETA  &NL+&K                                                   00550000
         AGO   .COUNTER                                                 00560000
.COUNTED ANOP  ,                                                        00570000
&J    SETA  128*&B80+64*&B40+32*&B20+16*&B10+8*&B08+4*&B04+2*&B02+&B01  00580000
&LAB     DC    0H'0',X'830E',AL1(&J,&NL) DEBUG: TRACE                   00590000
         AIF   (&NL EQ 0 AND NOT &B80).EXPDONE                          00600000
         B     XTR&SYSNDX                                               00610000
&J       SETA  0                                                        00620000
         AIF   (NOT &B80).EXPAND                                        00630000
         DC    CL8'&TAG '                                               00640000
.EXPAND  AIF   (&J GE &I).EXPDONE                                       00650000
&J       SETA  &J+1                                                     00660000
         AIF   ('&SYSLIST(&J)' EQ '').EXPAND                            00670000
&K       SETA  N'&SYSLIST(&J)                                           00680000
&L       SETA  1                                                        00690000
.EXPITEM AIF   (&L GT &K).EXPAND                                        00700000
&N       SETC  '&SYSLIST(&J,&L)'                                        00710000
&V       SETC  '&N'                                             GP05165 00720000
         AIF   ('&V'(1,1) NE '*' AND '&V'(1,1) NE '/').NIND     GP05165 00730000
&V       SETC  '&V'(2,K'&N-1)  ELIMINATE * FROM VARIABLE NAME   GP05165 00740000
.* &N    SETC  '&V'          COPY   (DEFER)                     GP05165 00750000
.NIND    AIF   ('&SYSLIST(&J,&L+1)' EQ '').DEFLN                        00760000
&R       SETA  K'&SYSLIST(&J,&L+1)                              GP08109 00770000
         AIF   (&R LT 3).NOREGLN                                GP08109 00780000
&C       SETC  '&SYSLIST(&J,&L+1)'                              GP08109 00790000
         AIF   ('&C'(1,1) NE '(' OR '&C'(2,1) EQ '(').NOREGLN   GP08109 00800000
         AIF   ('&C'(&R,1) NE ')' OR '&C'(&K-1,1) EQ ')').NOREGLN       00810000
         DC    CL8'&N ',SL2(&V,0&C)                             GP10021 00820000
         AGO   .EXPITEX                                         GP08109 00830000
.NOREGLN DC    CL8'&N ',SL2(&V,&SYSLIST(&J,&L+1))               GP10021 00840000
         AGO   .EXPITEX                                         GP08109 00850000
.DEFLN   DC    CL8'&N ',SL2(&V,&LN&V)                           GP10021 00860000
.EXPITEX ANOP  ,                                                        00870000
&L       SETA  &L+2                                                     00880000
         AGO   .EXPITEM                                                 00890000
.EASY    AIF   ('&NM' EQ '').EXPDONE                                    00900000
&LAB     DS    0H            NO DEBUG MODE - NO TRACE                   00910000
.EXPDONE AIF   ('&TEST' EQ '' AND &NL EQ 0 AND NOT &B80).MEXIT          00920000
XTR&SYSNDX DS  0H                                                       00930000
.MEXIT   MEND  ,                                                        00940000
./ ADD NAME=XXHHEX
         MACRO ,                                         NEW ON GP12298 00010000
&NM      XXHHEX &LEN=R2,&WK=R3,&W2=R4,&MAXL=,&MAX=,&ERR=                00020000
.*   CHECK FOR A VALID HEX CONSTANT IN AN SCLINE/SCPAGE EXIT ROUTINE.   00030000
.*   CODE IS FUNNY, BUT DOESN'T NEED A TRT TABLE OR LOOP                00040000
.*   TRANSLATES TO HEX AND BACK, THEN COMPARES. CATCHES MOST ERRORS.    00050000
.*                                                                      00060000
         GBLC  &ZZXXHNM                                                 00070000
         LCLC  &LER,&LAB                                                00080000
&LER     SETC  '&ERR'                                                   00090000
         AIF   ('&LER' NE '').USERR                                     00100000
&LER     SETC  '&ZZXXHNM'.'R'     NORMAL ERROR LABEL                    00110000
.USERR   ANOP  ,                                                        00120000
&LAB     SETC  'ZZX'.'&SYSNDX'                                          00130000
&NM      MVC   DBWK,=8X'F0'  CLEAR OUTPUT                               00140000
         AIF   ('&MAXL' EQ '').NOLL                                     00150000
         CH    &LEN,=AL2(&MAXL)   VALID LENGTH ?                        00160000
         MACPARM &LER,OP=BH,OPR=BHR,MODE=ONE                            00170000
.NOLL    LR    &WK,&LEN      COPY LENGTH                                00180000
         BCTR  &WK,0         MAKE EXECUTE LENGTH                        00190000
         LA    &W2,DBWK+8                                               00200000
         SR    &W2,&LEN      LOCATION TO MOVE TO                        00210000
         EX    &WK,&LAB.M    MOVE TEXT                                  00220000
         NC    DBWK,=8X'1F'  KEEP ONLY SIGNIFICANT BITS                 00230000
         TR    DBWK,=X'000A0B0C0D0E0F0000000000000000000001020304050607*00240000
               0809000000000000'                                        00250000
         PACK  DB(5),DBWK(L'DBWK+1)                                     00260000
.*  CONVERTED TEXT IN DB(4); NOW DO BACKWADS TO CHECK VALIDITY          00270000
         UNPK  DB2(L'DB2+1),DB(5)  REVERSE                              00280000
         NC    DB2,=8X'0F'                                              00290000
         TR    DB2,=C'0123456789ABCDEF'                                 00300000
         MVC   DBWK,=8X'F0'  CLEAR OUTPUT                               00310000
         EX    &WK,&LAB.M    MOVE TEXT                                  00320000
         OC    DBWK,=8C' '   UPPER CASE TO ALLOW REVERSE COMPARE        00330000
         CLC   DB2,DBWK      SAME BOTH WAYS?                            00340000
         MACPARM &LER,OP=BNE,OPR=BNER,MODE=ONE                          00350000
         AIF   ('&MAX' EQ '').NOMAX                                     00360000
         CLC   DB(4),=A(&MAX)   VALID ?                                 00370000
         MACPARM &LER,OP=BH,OPR=BHR,MODE=ONE                            00380000
.NOMAX   B     *+4+6         CONTINUE PAST EXECUTIONERS                 00390000
&LAB.M   MVC   0(0,&W2),FIWTEXT                                         00400000
         MEND  ,                                                        00410000
./ ADD NAME=XXHINT
         MACRO ,                                         NEW ON GP12298 00010000
&NM      XXHINT &LEN=R2,&WK=R3,&W2=R4,&MAXL=,&MAX=,&ERR=                00020000
.*   THIS MACRO IS USED TO VALIDATE INTEGER FIELDS SPECIFIED ON AN      00030000
.*     FDIN MACRO WITH EXIT=                                            00040000
.*   IT IS NOT NEEDED EXCEPT TO VALIDATE SPECIAL CONDITIONS, SUCH AS    00050000
.*     POSITIVE VALUE ONLY, OR A MAXIMUM SMALLER THAN POSSIBLE (E.G.,   00060000
.*     255 IN A THREE-DIGIT FIELD)                                      00070000
.*                                                                      00080000
         GBLC  &ZZXXHNM                                                 00090000
         LCLC  &LER,&LAB                                                00100000
&LER     SETC  '&ERR'                                                   00110000
         AIF   ('&LER' NE '').USERR                                     00120000
&LER     SETC  '&ZZXXHNM'.'R'     NORMAL ERROR LABEL                    00130000
.USERR   ANOP  ,                                                        00140000
&LAB     SETC  'ZZX'.'&SYSNDX'                                          00150000
&NM      MVC   DBWK,=8X'F0'  CLEAR OUTPUT                               00160000
         AIF   ('&MAXL' EQ '').NOLL                                     00170000
         CH    &LEN,=AL2(&MAXL)   VALID LENGTH ?                        00180000
         MACPARM &LER,OP=BH,OPR=BHR,MODE=ONE                            00190000
.NOLL    LR    &WK,&LEN      COPY LENGTH                                00200000
         BCTR  &WK,0         MAKE EXECUTE LENGTH                        00210000
         LA    &W2,DBWK+8                                               00220000
         SR    &W2,&LEN      LOCATION TO MOVE TO                        00230000
         EX    &WK,&LAB.Z    MOVE ZONES                                 00240000
         CLC   DBWK,=8X'F0'  NUMERIC ZONES ?                            00250000
         MACPARM &LER,OP=BNE,OPR=BNER,MODE=ONE                          00260000
         EX    &WK,&LAB.M    MOVE TO WORK AREA                          00270000
         CVB   R0,DBWK       CONVERT                                    00280000
         AIF   ('&MAX' EQ '').NOMAX                                     00290000
         CL    R0,=A(&MAX)   VALID ?                                    00300000
         MACPARM &LER,OP=BH,OPR=BHR,MODE=ONE                            00310000
.NOMAX   B     *+4+6+6         RETURN TO CALLER                         00320000
&LAB.Z   MVZ   DBWK(0),FIWTEXT                                          00330000
&LAB.M   PACK  DBWK,FIWTEXT(*-*)                                        00340000
         MEND  ,                                                        00350000
./ ADD NAME=YCON
         MACRO ,                                                        00010000
&NM      YCON  &STR,&END=,&BNDRY=H                      ADDED ON 89272  00020000
         GBLB  &YCON@OP                                                 00030000
         GBLC  &YCON@NM                                                 00040000
         LCLA  &I,&J,&K,&L                                              00050000
         LCLC  &L2,&LQ                                          GP00027 00060001
&K       SETA  K'&STR                                                   00070000
         AIF   (T'&END NE 'O').TSTOPEN                                  00080000
         AIF   (T'&STR EQ 'O').CLOSE                                    00090000
         AIF   ('&STR'(1,1) EQ '*').CLOSE                               00100000
.TSTOPEN AIF   (&K EQ 0).COMLEN                                         00110000
         AIF   ('&STR'(1,1) NE '''').COMLEN                             00120000
&I       SETA  2                                                        00130000
&J       SETA  &K-2                                                     00140000
&K       SETA  &J                                                       00150000
.LOOP    AIF   ('&STR'(&I,2) EQ '''''').SK2                             00160000
         AIF   ('&STR'(&I,2) EQ '&&').SK2                               00170000
&I       SETA  &I+1                                                     00180000
         AGO   .INC                                                     00190000
.SK2     ANOP  ,                                                        00200000
&I       SETA  &I+2                                                     00210000
&K       SETA  &K-1                                                     00220000
.INC     AIF   (&I LE &J).LOOP                                          00230000
.COMLEN  AIF   (NOT &YCON@OP).NOPEN                                     00240000
         MNOTE 4,'PRIOR YCON NOT TERMINATED'                            00250000
&YCON@OP SETB  0                                                        00260000
.NOPEN   AIF   ('&BNDRY' EQ 'H' OR '&BNDRY' EQ 'Y').NOBOUND             00270000
         AIF   ('&BNDRY' NE 'X' AND '&BNDRY' NE 'C').DOBOUND            00280000
&L2      SETC  'L2'                                                     00290000
         AGO   .NOBOUND                                                 00300000
.DOBOUND DS    0&BNDRY                                                  00310000
.NOBOUND AIF   (T'&END NE 'O').OPEN                                     00320000
&I       SETA  K'&STR                                           GP00027 00330002
         AIF   (&I LT 5).NOXLN                                  GP00027 00340001
         AIF   ('&STR'(1,2) EQ 'CL' OR '&STR'(1,2) EQ 'XL').XCHR        00350001
.NOXLN   ANOP  ,                                                GP00027 00360001
         AIF   (&K EQ 0).REQSTR                                         00370000
         AIF   ('&STR'(1,1) EQ '''').QSTR                               00380000
&NM      DC    Y&L2.(&K+4),C'&STR'                               89272  00390000
         AGO   .MEND                                                    00400000
.XCHR    ANOP  ,                                                GP00027 00410001
&I       SETA  &SYSNDX                                          GP00027 00420001
&LQ      SETC  'L'''                                            GP00027 00430001
&NM      DC    Y&L2.(&LQ.ZZDH&I)                                        00440001
ZZDH&I   DC    &STR                                             GP00027 00450001
         AGO   .MEND                                            GP00027 00460001
.QSTR    ANOP  ,                                                        00470000
&NM      DC    Y&L2.(&K+4),C&STR                                 89272  00480000
         AGO   .MEND                                                    00490000
.OPEN    AIF   (&K NE 0).OPSTR                                          00500000
&NM      DC    Y&L2.(&END-*)                                     89272  00510000
         AGO   .SETOPEN                                                 00520000
.OPSTR   AIF   ('&STR'(1,1) EQ '''').OQSTR                              00530000
&I       SETA  K'&STR                                           GP00027 00540002
         AIF   (&I LT 5).NOXLEN                                 GP00027 00550001
         AIF   ('&STR'(1,2) EQ 'CL' OR '&STR'(1,2) EQ 'XL').OXCHR       00560001
.NOXLEN  ANOP  ,                                                GP00027 00570001
&NM      DC    Y&L2.(&END-*),C'&STR'                             89272  00580000
         AGO   .SETOPEN                                                 00590000
.OXCHR   ANOP  ,                                                GP00027 00600001
&NM      DC    Y&L2.(&END-*-2),&STR                                     00610001
         AGO   .SETOPEN                                         GP00027 00620001
.OQSTR   ANOP  ,                                                        00630000
&NM      DC    Y&L2.(&END-*),C&STR                               89272  00640000
.SETOPEN ANOP  ,                                                        00650000
&YCON@NM SETC  '&END'                                                   00660000
&YCON@OP SETB  1                                                        00670000
         MEXIT ,                                                        00680000
.REQSTR  MNOTE 4,'TEXT STRING REQUIRED'                                 00690000
         MEXIT ,                                                        00700000
.CLOSE   AIF   (&YCON@OP).WASOPEN                                       00710000
         MNOTE 4,'YCON END OUT OF SEQUENCE'                             00720000
.WASOPEN AIF   ('&NM' EQ '' OR '&NM' EQ '&YCON@NM').BLAB                00730000
&NM      EQU   *                                                        00740000
.BLAB    ANOP  ,                                                        00750000
&YCON@NM EQU   *                                                        00760000
&YCON@NM SETC  ''                                                       00770000
&YCON@OP SETB  0                                                        00780000
.MEND    MEND  ,                                                        00790000
./ ADD NAME=YREGS
         MACRO                                                          00010000
         YREGS ,                                                        00020000
         GBLA  &REGS                                                    00030000
         AIF   (&REGS EQ 1).MEND  ONLY EXPAND ONCE                      00040000
&REGS    SETA  1             MAINTAIN IBM COMPATIBILITY                 00050000
         LCLA  &I                                                       00060000
.LOUPE   AIF   (&I GT 15).MEND                                          00070000
R&I      EQU   &I                                                       00080000
&I       SETA  &I+1                                                     00090000
         AGO   .LOUPE                                                   00100000
.MEND    MEND                                                           00110000
./ ADD NAME=ZI
         MACRO ,                                       ADDED ON GP05355 00010000
&NM      ZI    &ADDRESS,&FLAGS                                          00020000
.*   ADDED IN RESPONSE TO A THREAD ON IBM-MAIN ABOUT RESETTING FLAGS    00030000
.*     THIS MACRO ALLOWS SPECIFICATION OF THE FLAGS TO BE RESET,        00040000
.*     INSTEAD OF THE NI CONVENTION OF ALL BUT                          00050000
.*                                                                      00060000
&NM      NI    &ADDRESS,255-(&FLAGS)                                    00070000
         MEND  ,                                                        00080000
@@
//*
