hercules 3.07-2.3 / usr / share / hercules / awssl-v19g

          TITLE 'AWSSL 1.9G AWS  Virtual Tape (standard labels)'
***********************************************************************
* AWSSL 1.9G, AWS Virtual Tape  (standard labels)                     *
*                                                                     *
* This program moves datasets to/from AWS virtual tape files.  HET    *
* virtual tape formats will likely be support in the "not to distant" *
* future.                                                             *
*                                                                     *
* Copyright (C) 2002, By Reed H. Petty, rhp@draper.net                *
*                                                                     *
* You are free to make any changes you like to this code for any      *
* purpose (including commercial for profit use) PROVIDED that you     *
* carry the credits forward into derived works.                       *
*                                                                     *
* NO WARRANTY OF ANY KIND IS MADE!  USE AT YOUR OWN RISK!             *
*                                                                     *
* JCL quick start example:                                            *
*                                                                     *
*  //MAKETAPE EXEC PGM=AWSSL                                          *
*  //STEPLIB  DD DSN=my.load.library,DISP=SHR                         *
*  //AWSPRINT DD SYSOUT=*                                             *
*  //myddnam1 DD DSN=my.file1,DISP=SHR (optional)                     *
*  //myddnam2 DD DSN=my.file2,DISP=SHR (optional)                     *
*  //AWSFILE  DD DSN=mytape.aws,DISP=(,CATLG,DELETE),                 *
*  //       SPACE=(whatever make sense to you in your environment),   *
*  //       DCB=(whatever makes sense to you in your environment)     *
*  //AWSCNTL  DD *                                                    *
*  AWSVOL  VOLSER=mytape                                              *
*  AWSPUT  INDSN=catalogued dataset name 1                            *
*  AWSPUT  INDSN=catalogued dataset name 2,UNLOAD=IEBCOPY             *
*  AWSPUT  INDD=myddnam1                                              *
*  AWSPUT  INDD=myddnam1,UNLOAD=IEBCOPY                               *
*  ... or ...                                                         *
*  AWSVOL  VOLSER=mytape                                              *
*  AWSGET  OUTDD=dd1,INDSN=dataset name on tape,FILENO=1              *
*  AWSGET  OUTDD=dd2,INDSN=dataset name on tape,FILENO=5,SL=NO        *
*  AWSGET  OUTDD=dd7,INDSN=dataset name on tape,FILENO=2,LOAD=IEBCOPY *
*  ... and so forth                                                   *
*  /*                                                                 *
*                                                                     *
* Feedback, good or bad, is always welcome!                           *
*                                                                     *
* Kudo's to Roger Bowler, somitcw@erols.com (whoever you are),        *
* Sam Golob, and to Linus Torvalds (who encouraged my trivial         *
* contributions to the Linux kernel).                                 *
*                                                                     *
* Special thanks to Michael A. Quinlan who was my boss at the         *
* University of Utah so many years ago.  Mike is by far the best      *
* assembler programmer that I have ever known.                        *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* AWS Virtual Tape Motivation, The Good, the Bad, and the Ugly.       *
* -------------------------------------------------------------       *
*                                                                     *
* This program creates AWS structures which contain one or more       *
* OS datasets of any record format (except spanned blocks), with or   *
* without standard labels, where the output AWS structure can also    *
* be of any record format (including spanned blocks).                 *
*                                                                     *
* This program will also retrieve datasets from an AWS structure of   *
* any record format (except spanned blocks). The retrieved datasets   *
* may be reblocked if necessary.  If DCB attributes are omitted on    *
* the receiving dataset, and if standard labels are present within    *
* the AWS structure, then the DCB attributes of the receiving dataset *
* will be defaulted to those within the HDR1 label.                   *
*                                                                     *
* AWS (acronym is unknown to me, someone please tell me!) was widely  *
* used by the IBM P/390 product family to implement an entire tape    *
* volume as a byte stream contained within an OS/2 file.  As          *
* implementations of the System/360/370/zArch architecture families   *
* in software expanded (such as Hercules, Flex/ES, and others) the    *
* AWS presence expanded as well.                                      *
*                                                                     *
* Recommended reading: Sam Golob's AWS article published by NaSPA.    *
* See URL: http://www.naspa.com/PDF/2001/1201%20PDF/T0112012.pdf      *
*                                                                     *
* Hercules provided the means for me to rekindle my MVT and MVS 3.8   *
* memories.  I found myself constantly moving datasets between        *
* these older operating systems and OS/390 running on real blue       *
* hardware.  As neither MVT nor MVS 3.8J implement TCP/IP it became   *
* necessary to move 1) entire disk volumes, 2) AWS tape volumes, or   *
* 3) card decks.  Hercules does an excellent job of reading/writing   *
* AWS tape volumes, but support in OS/390 was lacking (IMHO).         *
*                                                                     *
* Utilities available on OS/390 were a bit cumbersome.  If standard   *
* label functionality was needed then the structure first had to be   *
* copied to a real tape volume (AWSUTIL by Brandon Hill).  If a need  *
* existed to pluck a single file from an AWS structure, without first *
* copying the entire structure to a real volume, RAWSTAPE (written    *
* by Jan Jaeger) was required.  Also, RAWSTAPE requires that DCB      *
* attributes be manually set in a subsequent step.                    *
*                                                                     *
* As Jay Maynard (Hercules Maintainer) is fond of saying: If you have *
* an itch, then scratch it!  This work represents my scratching.      *
*                                                                     *
* The itch: find a way to easily and quickly move sequential files    *
* and PDS' (including PDSE's) between my OS/390 and MVS 3.8J systems. *
* The goals: easy syntax, standard label exploitation to set default  *
* DCB attributes in the receiving system, multiple file insertion     *
* or extraction in a single step execution, automatic PDS staging     *
* (this itch actually belongs to Roger Bowler but the idea is handy), *
* compatibility with all known AWS utilities, and so forth.           *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* Assembly                                                            *
* --------                                                            *
*                                                                     *
* To assemble on a MVS 3.8J system:                                   *
*                                                                     *
*  //my job card                                                      *
*  // EXEC ASMFCL,COND=(0,NE),MAC1='SYS1.AMODGEN',REGION=4096K,       *
*  //   PARM.LKED='LIST,LET,MAP,XREF,RENT,REFR'                       *
*  //SYSIN DD *                                                       *
*    this code                                                        *
*  //LKED.SYSLMOD DD DSN=my.load.library(AWSSL),DISP=SHR              *
*  //SYSIN DD *                                                       *
*   SETCODE AC(1)   (if UNLOAD=IEBCOPY is used)                       *
*  //                                                                 *
*                                                                     *
* To assemble on an OS/390 R2.10 system:                              *
*  //my job card                                                      *
*  // EXEC HLASMCL,COND=(0,NE),                                       *
*  //   PARM.L='LIST,LET,MAP,XREF,RENT,REFR'                          *
*  //SYSIN DD *                                                       *
*    this code                                                        *
*  //L.SYSLMOD DD DSN=my.load.library(AWSSL),DISP=SHR                 *
*  //SYSIN DD *                                                       *
*   SETCODE AC(1)   (if UNLOAD=IEBCOPY is used)                       *
*  //                                                                 *
*                                                                     *
* If the UNLOAD=IEBCOPY option is utilized this code must execute     *
* authorized.  This code runs in 24 bit mode and is reentrant.        *
* Assembly on older releases of MVS require that SYS1.AMODGEN be      *
* available to the assembler.                                         *
*                                                                     *
*                                                                     *
* Rant                                                                *
* ----                                                                *
*                                                                     *
* Some critical comments have been received regarding my programming  *
* style (too much uppercase, too much register saving, avoidance of   *
* new and spiffy instructions, linkage conventions, short 8 byte      *
* labels, uppercase labels, opcodes, operands, etc).                  *
*                                                                     *
* Normally I strive to generate reentrant 31 bit code sprinkled       *
* liberally with capabilities found in the "more recent MVS world".   *
* However, as this code is intended to assemble and run on any        *
* incarnation of MVS from 3.8J forward, I have tried hard to avoid    *
* dependency on facilities not present in older releases of MVS.      *
*                                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* Random thoughts for the future                                      *
* ------------------------------                                      *
* 1) Add HET format support (does anyone know of a gzip               *
*    implementation, preferably in System/370 assembler or others not *
*    requiring run time library support, and not encumbered by        *
*    overly restrictive licensing?                                    *
*    *** Found, implementation in progress ***                        *
*                                                                     *
* 2) Add capability to internally call IEBCOPY, IDCAMS, etc to create *
*    datasets in portable formats before adding to the AWS structure. *
*    *** Done ***                                                     *
*                                                                     *
* 3) Add capability to retrieve a dataset from a standard label AWS   *
*    structure and create an equivalent OS dataset.                   *
*    *** Done ***                                                     *
*                                                                     *
* 4) Implement a decent multiple input record keyword parser.         *
*    *** Done ***                                                     *
*                                                                     *
* 5) Implement capability to generate AWS structures in file formats  *
*    of undefined lengths (PREFERRED!!!), variable lengths (for       *
*    compatibility with output produced by AWSUTIL written by         *
*    Brandon Hill), and fixed lengths (for compatibility with         *
*    the VTT2* utilities written by Sam Golob).                       *
*    *** Done ***                                                     *
*                                                                     *
* 6) Add capability to IDCAMS repro and export VSAM objects.          *
*                                                                     *
* 7) Rewrite to position for never ending expansion while keeping     *
*    the code base maintainable.                                      *
*    *** Done ***                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* Change History                                                      *
* --------------                                                      *
* August  5, 2002   - Released to the public as v1.0                  *
*                                                                     *
* August 13, 2002   - V1.1 RELEASE                                    *
*   - corrected a never ending wait on a never posted ECB in some     *
*     environments (BSAM back to single buffering).                   *
*   - added INDD= keyword support.                                    *
*   - added DSN retrieval via RDJFCB support.                         *
*   - added AWSVOL verb support.                                      *
*   - revised DATASET verb format (removed VOLSER keyword).           *
*   - Ported to MVS 3.8J (TIOT structure changes, SVC99 RB            *
*     assembler F backward reference assembly problems, etc).         *
*   - added support for input datasets having RECFM=U (thanks to      *
*     Roger Bowler who identified the bug).                           *
*   - brought label formats forward to that documented in the         *
*     OS/390 R2.10 SMS manuals.                                       *
*                                                                     *
* August 16, 2002   - V1.2 Release (Internal Only)                    *
*   - added automatic staging (unload) of PDS(E) datasets.            *
*   - corrected RECFM=U ommission from HDR2/EOF2.                     *
*   - corrected RDJFCB end of list indicator.                         *
*   - converted input I/O from BSAM to QSAM for performance.          *
*                                                                     *
* September 9, 2002 - V1.9a Release Candidate (Internal Only)         *
*   - Nearly 100% rewrite.                                            *
*                                                                     *
* September 18, 2002- 1.9c  Release Candidate (public)                *
*   - Added retrieve from aws tape into OS dataset function.          *
*   - Added AWSGET PDS(e) staging.                                    *
*   - Renamed TAPEVOL, IMPORT, EXPORT to AWSVOL, AWSGET and AWSPUT.   *
*                                                                     *
* September 19, 2002- V1.9D Release Candidate (public)                *
*   - Bug! subtle, grrr... AWSIGET... when block fragmentation occurs *
*     between bytes 1 and 2 of AWSLENC then we cannot compute the     *
*     length of the fragmented block and therefore cannot aggregate   *
*     the remainder of the block.  The exposure is rare and is more   *
*     likely to be visible when using short record lengths (as is the *
*     case with AWS text produced by Sam Golob's VTT2DISK utility).   *
*                                                                     *
* September 23, 2002- V1.9E Release Candidate (public)                *
*   - Incompatibility between AWSSL and VTT2TAPE.  VTT2TAPE expects:  *
*     1) the last text record to be padded with x'20' characters, and *
*     2) that an additional record be written completedly filled with *
*        x'20' bytes.                                                 *
*     Modified AWSSL accordingly when producing fixed length output.  *
*                                                                     *
* September 25, 2002- V1.9F                                           *
*   - Added owner= keyword to AWSVOL function.                        *
*                                                                     *
* September 26, 2002- V1.9G                                           *
*   - Rewrite of AWSIGET csect, new AWSGTXT csect.                    *
*   - Force recfm=u when spanned records/blocks are encountered.      *
*     Issue warnings when spanned and other than IEBCOPY load.        *
*                                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* Input Parameters                                                    *
* ----------------                                                    *
* All input parameters are taken from control statements supplied by  *
* the dataset represented by the AWSCNTL dd statement.  Statements    *
* consist of a major function to be performed (i.e. TAPEVOL, EXPORT,  *
* etc), and a series of keywords which supply values to that function.*
*                                                                     *
* Control statement keywords may be continued to as many records as   *
* necessary.  Continued statements are indicated by the last keyword  *
* argument suffixed with a comma and additional keywords supplied     *
* on the next record.  Additional keywords must not begin in column   *
* one.                                                                *
*                                                                     *
* Example:                                                            *
*                                                                     *
* AWSVOL VOLSER=MYTAPE                                                *
* AWSPUT INDSN=SYS1.PROCLIB,OUTDSN=MY.SPECIAL.PROCLIB.D090802,        *
*        UNLOAD=IEBCOPY                                               *
*                                                                     *
*                                                                     *
*                                                                     *
* AWSVOL Control Statement                                            *
* -------------------------                                           *
* The AWSVOL control statement supplies characteristics of the        *
* virtual tape volume include volume serial number, compression       *
* techniques, and so forth.  TAPEVOL must also be the first control   *
* statement specified.                                                *
*                                                                     *
* Keywords: VOLSER=(1 to 6 byte argument),                            *
*           OWNER=(1 to 10 byte argument placed into VOL1 owner),     *
*           COMPRESS=0:1, (compress and IDRC control whether or not   *
*                   compression is to be used.  IDRC and COMPRESS     *
*                   are durrently synomyms of each other).            *
*           METHOD=1:2, (1 = gzip, 2=bzip2)                           *
*           LEVEL=1-9, (specifies the degree of compression required) *
*           IDRC=0:1,  (currently a synonym of COMPRESS)              *
*           CHUNKSIZE=nnnnn (specifies the size of the "chunk" to be  *
*                   compressed, should be avoided IMHO).              *
*                                                                     *
* If COMPRESS=0 then an AWS format is assumed.  Note that compression *
* related keywords will be implemented at a future date.              *
*                                                                     *
* Note COMPRESS, METHOD, LEVEL, IDRC, CHUNKSIZE have the same meaning *
* as in the Hercules configuration.                                   *
*                                                                     *
*                                                                     *
* Example:                                                            *
*                                                                     *
* AWSVOL  VOLSER=MYTAPE,COMPRESS=1,METHOD=1,LEVEL=9,IDRC=1,           *
*         CHUNKSIZE=65536,OWNER='AWSSL 1.9G'                          *
*                                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* AWSGET Control Statement                                            *
* ------------------------                                            *
* The AWSGET control statement will supply values necessary to        *
* retrieve a dataset FROM an AWS or HET virtual tape volume.          *
*                                                                     *
* keywords: INDSN=(up to 44 byte dsn of dataset stored inside of      *
*                   the AWS virtual tape)                             *
*           OUTDD=(ddname representing the dataset to receive data)   *
*           FILENO=nnnnn (file number of the dataset inside of the    *
*                   AWS virtual tape, may be a standard label file    *
*                   number or absolute file number depending on the   *
*                   value of the SL= keyword)                         *
*           SL=YES:NO (specifies if standard labels are present, also *
*                   impacts the meaning of the FILENO= keyword)       *
*                                                                     *
* Example:                                                            *
*                                                                     *
* AWSGET INDSN=sys1.proclib,OUTDD=dd1,SL=YES                          *
*                                                                     *
*                                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* AWSPUT Control Statement                                            *
* ------------------------                                            *
* The AWSPUT control statement causes a dataset to be copied into the *
* AWS or HET virtual tape file.  Multiple EXPORT statements may be    *
* specified.  A set of standard labels are produced as each statement *
* is processed.                                                       *
*                                                                     *
* If necessary the dataset is staged into a temporary dynamically     *
* allocated dataset prior to insertion into the virtual temp.         *
*                                                                     *
* Keywords: INDD=(statically allocated ddname representing the file   *
*                 to be copied and placed into the virtual tape file),*
*           INDSN=(dsname to be dynamically allocated and placed into *
*                 the virtual tape file),                             *
*           OUTDSN=(44 byte dataset name to be placed into the labels *
*                 which preceed and follow the file on virtual tape), *
*           TAPEDSN=(17 byte dataset name to be placed in label),     *
*           UNLOAD=IEBCOPY:IDCAMS, (the utility called to stage the   *
*                 input dataset prior to insertion into the virtual   *
*                 tape),                                              *
*           TYPE=EXPORT:REPRO (if UNLOAD=IDCAMS then TYPE specifies   *
*                 the method to be used to stage the dataset prior to *
*                 to insertion into the virtual tape)                 *
*                                                                     *
* The AWS or HET virtual tape OUTPUT file may specify any DCB         *
* attributes that are meaningful in the users environment.            *
*                                                                     *
* RECFM=V - Variable length output, lrecl and blksize as specified.   *
*           Records are output in a format consistent with that       *
*           produced by Brandon Hill's AWSUTIL (i.e. no aggregation   *
*           of AWS structures within a single output record).         *
*                                                                     *
* RECFM=F - Fixed length output, lrecl and blksize as specified.      *
*           Records are output in a format consistent with that       *
*           produced by Sam Golob's VTT2* family of utilities         *
*           (i.e. AWS structures are aggregated and "folded" at the   *
*           specified lrecl).                                         *
*                                                                     *
* RECFM=U - Undefined length output, blksize as specified.  Records   *
*           are output in an aggregated BLKSIZE length block.         *
*           (THIS IS THE PREFERRED METHOD WHEN THE VIRTUAL TAPE IS TO *
*           BE TRANSPORTED TO OTHER ENVIRONMENTS SUCH AS HERCULES).   *
*                                                                     *
*                                                                     *
*                                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* Implementation Conventions                                          *
* --------------------------                                          *
* An effort was made to structure the code such that a nearly endless *
* set of new features can be added without becoming unwieldly.  For   *
* that reason functions tend to be implemented as small discrete      *
* CSECTS.                                                             *
*                                                                     *
* Each CSECT name should begin with the string AWS to avoid name      *
* space collision with other code which may be statically linked in   *
* the future.  It is recommended that all labels within an individual *
* CSECT follow a name space convention unique to that CSECT.          *
*                                                                     *
* Each CSECT should contain an LTORG statement.  This reduces the     *
* need for multiple base registers to establish addressability to     *
* large literal pools.                                                *
*                                                                     *
* To avoid subtle addressability related bugs, each CSECT should      *
* contain a 'DROP ,' statement to release all USINGS in effect.       *
*                                                                     *
* A register save area stack mechanism is provided to ease linkage    *
* between internal functions and to minimize contention for scarce    *
* register resource.  All CSECTS should utilize the AWSENTRY and      *
* AWSEXIT macro instructions where possible.                          *
*                                                                     *
* This code is reentrant and refreshable.  All data areas which       *
* require modification should be placed in CSECT AWSDATA between      *
* labels DSDYNAM and DSBUFFER.  If the data areas contain initialized *
* data then they should be placed between labels DSBEGIN and DSBUFFER.*
* Data areas located between labels DSDYNAM and DSBEGIN have storage  *
* allocated for them but are not initialized (to other than nulls).   *
*                                                                     *
* Dynamic storage ADCON relocation, etc, code should be placed into   *
* CSECT AWSINIT.                                                      *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
* Register Usage Conventions                                          *
* --------------------------                                          *
*                                                                     *
* R14 - Linkage, contains the address at which instruction streaming  *
*       should resume.  May be used as an internal work register.     *
*                                                                     *
* R15 - Linkage, contains the address of the CSECT to be called.      *
*       Upon return contains the return code from the called CSECT.   *
*       May be used as an internal work register.                     *
*                                                                     *
* R0 through R6 - Preserved by AWSENTRY and AWSEXIT.  Available for   *
*       whatever usage the programmer desires within the scope of     *
*       the local CSECTs.                                             *
*                                                                     *
* R7 through R9 - Reserved for future unforeseen needs.  Please avoid *
*       usage except in the most dire of circumstances.               *
*                                                                     *
* R10 - Common storage addressability.  Set by AWSENTRY.              *
*                                                                     *
* R11 - Dynamic storage addressability.  Set by AWSENTRY.             *
*                                                                     *
* R12 - Local CSECT base register.  Set by AWSENTRY.                  *
*                                                                     *
* R13 - Pointer to current savearea.  Set to the next save area stack *
*       entry by AWSENTRY.                                            *
*                                                                     *
*                                                                     *
*                                                                     *
*                                                                     *
*                                                                     *
*                                                                     *
*                                                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
* Customizable Symbols                                                *
***********************************************************************
         SPACE 1
         GBLA  &AWSDBUG            debug switch
&AWSDBUG SETA  0                   1 = enable debugging support
         SPACE 1
STACKCT  EQU   10                  savearea stack entries
BUFSIZE  EQU   70000               max blksize + hdrs + aws cb + pad
         SPACE 1
***********************************************************************
* Register Equates (make registers visible in xref)                   *
***********************************************************************
         SPACE 1
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         TITLE 'AWSSL - macro definitions'
***********************************************************************
* MACRO DEFINITIONS                                                   *
***********************************************************************
         EJECT
         MACRO
&LBL     AWSENTRY
.**********************************************************************
.* AWSENTRY - push caller's registers into provided savearea, obtain  *
.*            a new savearea from the savearea stack, addressability. *
.**********************************************************************
         GBLA  &AWSDBUG            debug switch
         LCLA  &L,&I
         AIF   ('&LBL' EQ '').A010
&LBL     DS    0H
.A010    ANOP
&L       SETA  (K'&SYSECT+2+4)/2*2 offset to stm
&I       SETA  K'&SYSECT
         B     &L.(,R15)           branch around eyecatcher
         DC    AL1(&I)             eyecatcher length
         DC    C'&SYSECT'          CSECT name
         STM   R14,R12,12(R13)     save caller's environment
         LR    R12,R15             base register
         LA    R15,72(,R13)        next stack entry
         ST    R15,8(,R13)         forward linkage
         ST    R13,4(,R15)         backward linkage
         LR    R13,R15             establish new current savearea
         USING &SYSECT,R12         addressability
         USING AWSDYNAM,R11        addressability
         USING AWSCOMST,R10        addressability
         AIF   (&AWSDBUG EQ 0).MEND
         AIF   ('&SYSECT' EQ 'AWSPRNT').MEND
         AIF   ('&SYSECT' EQ 'AWSINIT').MEND
         AWSMSG 000I,'&SYSECT Entry'
.MEND    MEND
         EJECT
         MACRO
&LBL     AWSEXIT
.**********************************************************************
.* AWSEXIT  - release savearea stack entry, pop user's environment,   *
.*            return to caller.                                       *
.**********************************************************************
         GBLA  &AWSDBUG            debug switch
         AIF   ('&LBL' EQ '').A010
&LBL     DS    0H
.A010    AIF   (&AWSDBUG EQ 0).A020
         AIF   ('&SYSECT' EQ 'AWSPRNT').A020
         AIF   ('&SYSECT' EQ 'AWSTERM').A020
         MVC   DSMSG+1(7),=CL7'AWS000I'
         MVC   DSMSG+19(14),=CL14'&SYSECT EXIT'
         MVC   DSMSG+35(3),=CL3'RC:'
         CVD   R15,DSDWORK         convert to decimal
         MVC   DSMSG+38(6),=X'402020202120'
         ED    DSMSG+38(6),DSDWORK+5 make printable
         OI    DSMSG+43,C'0'
         LR    R2,R15              save return code
         AWSMSG ,                  print exit message
         LR    R15,R2              restore retern code
.A020    ANOP
         L     R13,4(,R13)         restore savearea pointer
         LM    R0,R12,20(R13)      restore caller's registers
         L     R14,12(,R13)        restore savearea address
         LTR   R15,R15             set condition code into psw
         BR    R14                 return to caller
         SPACE 1
         MEND
         EJECT
         MACRO
&LBL     AWSMSG &ID,&TXT
.**********************************************************************
.* AWSMSG - output a message to the AWSPRINT log                      *
.**********************************************************************
         GBLA  &AWSDBUG            debug switch
         LCLA  &L1,&L2
         LCLC  &C
         AIF   ('&ID' EQ '' AND '&TXT' EQ '').A040
         AIF   ('&ID' NE '').A010
         MNOTE 8,'*** MSG CSECT ID OMITTED'
.A010    AIF   ('&TXT' NE '').A020
         MNOTE 8,'*** MSG TEXT OMITTED'
.A020    AIF   ('&LBL' EQ '').A030
&LBL     DS    0H
.A030    ANOP
&C       SETC  'AWS&ID'
&L1      SETA  K'&C
         MVC   DSMSG+1(&L1),=C'&C'
&L2      SETA  K'&TXT-2
         MVC   DSMSG+19(&L2),=C&TXT
.A040    ANOP
         AWSCALL AWSPRNT           print function
         MEND
         EJECT
         MACRO
&LBL     AWSDMP &ID,&L,&R,&T
.**********************************************************************
.* AWSDMP - hex dump register (and optionally 16 bytes of storage)    *
.*          i.e. AWSDMP 00I,IGET900,R3   (dumps r3 and 16 bytes strg) *
.*          i.e. AWSDMP 00I,IGET100,R4,N (dumps r4 only)              *
.*                                                                    *
.* This macro is intended for debugging purposes only.                *
.**********************************************************************
         GBLA  &AWSDBUG            debug switch
         LCLA  &L1,&L2
         LCLC  &C
         STM   R14,R12,12(R13)
         LA    R13,72(,R13)
         AIF   ('&ID' NE '').A010
         MNOTE 8,'*** MSG CSECT ID OMITTED'
.A010    AIF   ('&R' NE '').A020
         MNOTE 8,'*** REGISTER OMITTED'
.A020    AIF   ('&LBL' EQ '').A030
&LBL     DS    0H
.A030    ANOP
&C       SETC  'AWS&ID'
&L1      SETA  K'&C
         MVC   DSMSG+1(&L1),=C'&C'
         AIF   ('&L' EQ '').A035
&L1      SETA  K'&L+1
         MVC   DSMSG+10(&L1),=C'&L:'
.A035    ANOP
&L1      SETA  K'&R
         MVC   DSMSG+19(&L1),=C'&R'
&L1      SETA  23
         ST    &R,DSFWORK                  register
         UNPK  DSHEXWK(9),DSFWORK(5)       unpack data
         TR    DSHEXWK(8),CSHEXTR          make printable
         MVC   DSMSG+&L1.(8),DSHEXWK       return code
         AIF   ('&T' EQ 'N').A040
&L1      SETA  &L1+12
         UNPK  DSHEXWK(9),0(5,&R)
         TR    DSHEXWK(8),CSHEXTR
         MVC   DSMSG+&L1.(8),DSHEXWK
&L1      SETA  &L1+9
         UNPK  DSHEXWK(9),4(5,&R)
         TR    DSHEXWK(8),CSHEXTR
         MVC   DSMSG+&L1.(8),DSHEXWK
&L1      SETA  &L1+9
         UNPK  DSHEXWK(9),8(5,&R)
         TR    DSHEXWK(8),CSHEXTR
         MVC   DSMSG+&L1.(8),DSHEXWK
&L1      SETA  &L1+9
         UNPK  DSHEXWK(9),12(5,&R)
         TR    DSHEXWK(8),CSHEXTR
         MVC   DSMSG+&L1.(8),DSHEXWK
         MVI   DSMSG+72,C'*'
         MVC   DSMSG+73(16),0(&R)
         MVI   DSMSG+89,C'*'
.A040    ANOP
         AWSCALL AWSPRNT           print function
         SH    R13,=H'72'
         LM    R14,12,12(R13)
         MEND
         EJECT
         MACRO
&LBL     AWSCALL &FUN
.**********************************************************************
.* AWSCALL - Call a function                                          *
.**********************************************************************
         AIF   ('&LBL' EQ '').A010
&LBL     DS    0H
.A010    ANOP
         AIF   ('&FUN' NE 'AWSDYNE').A020
         L     R15,CSAWSDYE        dynamic allocatione error handler
         AGO   .A999
.A020    AIF   ('&FUN' NE 'AWSEPUT').A030
         L     R15,CSAWSEPT        put text to virtual tape
         AGO   .A999
.A030    AIF   ('&FUN' NE 'AWSMARK').A040
         L     R15,CSAWSMRK        put tapemark to virtual tape
         AGO   .A999
.A040    AIF   ('&FUN' NE 'AWSPRNT').A050
         L     R15,CSAWSPRT        write to log
         AGO   .A999
.A050    AIF   ('&FUN' NE 'AWSIGET').A900
         L     R15,CSAWSIGE        read a logical aws block
         AGO   .A999
.A900    ANOP
         L     R15,=A(&FUN)        function to be called
.A999    ANOP
         BALR  R14,R15             issue call
         MEND
         EJECT
         MACRO
&LBL     AWSSWAP
.**********************************************************************
.* AWSSWAP - swap byte orders, set sizes                              *
.**********************************************************************
         AIF   ('&LBL' EQ '').A010
&LBL     DS    0H
.A010    ANOP
         ICM   R0,3,DSLSTSIZ       reverse previous size byte order
         STCM  R0,1,AWSLENP
         STCM  R0,2,AWSLENP+1
         ICM   R0,3,AWSLENC        size of current block
         STCM  R0,3,DSLSTSIZ       set new last size
         STCM  R0,1,AWSLENC        reverse current size byte order
         STCM  R0,2,AWSLENC+1
         MEND
         SPACE 1
         MACRO
&LBL     AWSSWAPR
.**********************************************************************
.* AWSSWAPR - swap byte orders, no sizes                              *
.**********************************************************************
         AIF   ('&LBL' EQ '').A010
&LBL     DS    0H
.A010    ANOP
         ICM   R0,3,AWSLENC        size of current block
         STCM  R0,1,AWSLENC        reverse current  size byte order
         STCM  R0,2,AWSLENC+1
         MEND
         SPACE 1
         MACRO
&LBL     AWSDUMMY ,                Dummy function
.**********************************************************************
.* AWSDUMMY - dummy function, merely returns                          *
.**********************************************************************
&LBL     CSECT ,                   dummy function
         AWSENTRY ,
         SLR   R15,R15             zero return code
         AWSEXIT ,
         DROP  ,
         MEND
         EJECT
***********************************************************************
* System control block definitions (Assembler F forward referenced)   *
***********************************************************************
         SPACE 1
         PRINT OFF
         DCBD  DSORG=PS
         IEFZB4D0 ,
         IEFZB4D2 ,
         IHAPSA ,                  PSA
         IKJTCB ,                  TCB
TIOT     DSECT  ,                  TIOT
         IEFTIOT1 ,
         PRINT ON
         EJECT
***********************************************************************
* AWSSL - Utility entry point                                         *
***********************************************************************
         SPACE 1
AWSSL    CSECT ,                   module entry point
         SAVE  (14,12),,'AWSSL &SYSDATE &SYSTIME'
         LR    R12,R15             base register
         USING AWSSL,R12           addressability
         SPACE 1
         GETMAIN R,LV=AWSDATAL+3*BUFSIZE Dynamic storage
         ST    R13,4(,R1)          backward linkage
         ST    R1,8(,R13)          forward linkage
         LR    R13,R1              current savearea
         LR    R11,R1              set dynamic storage location
         USING AWSDATA,R11         addressability
         ST    R11,DSDATAP         set pointer to awsdata origin
         LA    R0,DSSTACK          stack origin
         ST    R0,DSSTACKP         set stack origin pointer
         LA    R11,AWSDYNAM-AWSDATA(,R11) position beyond stack
         USING AWSDYNAM,R11        addressability
         SPACE 1
         L     R10,=A(AWSCOMST)    constant common data
         USING AWSCOMST,R10        addressability
         SPACE 1
         AWSCALL AWSINIT           initialization
         BNZ   SSLXIT              if not successful, branch
         SPACE 1
SSL010   DS    0H                  main processing loop
         AWSCALL AWSMAIN           invoke verb handler
         BZ    SSL010              continue until eof or error
         SPACE 1
SSLXIT   DS      0H                return to caller
         CH    R15,=H'-4'          eof from main?
         BNE   *+6                 no, branch
         SLR   R15,R15             else force zero return code
         LR    R2,R15              save rc for now
         AWSCALL AWSTERM           clean up for termination
         SPACE 1
         L     R3,4(,R13)          Callers savearea
         L     R4,DSDATAP          dynamic storage origin
         FREEMAIN R,LV=AWSDATAL+3*BUFSIZE,A=(R4) release storage
         SPACE 1
         LR    R15,R2              restore return code
         LR    R13,R3              restore savearea pointer
         RETURN (14,12),RC=(15)    return to caller
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSSL - Initialization'
***********************************************************************
* AWSINIT - initialization, relocation, open files                    *
*           msgs AWS01n                                               *
***********************************************************************
         SPACE 1
AWSINIT  CSECT ,                   initialization logic
         AWSENTRY ,                csect entry
         SPACE 1
         L     R2,=A(AWSRELOC)     start  of relocatable storage
         L     R3,=A(DSENDL)       length of relocateable storage
         LR    R1,R3               origin length = destination
         LA    R0,AWSRELOC-AWSDYNAM(,R11) target of move
         MVCL  R0,R2               copy storage model into dynamic area
         SPACE 1
         LA    R0,INFMJFCB         jfcb work area
         STCM  R0,7,DSJFCBL+1
         LA    R0,DSJFCBL          rdjfcb exist list location
         STCM  R0,7,AWSUT1+(DCBEXLSA-IHADCB)
         STCM  R0,7,AWSUT2+(DCBEXLSA-IHADCB)
         STCM  R0,7,AWSUT3+(DCBEXLSA-IHADCB)
         SPACE 1
         LA    R0,DSBUFFER         Buffer location
         ST    R0,DSBUFTP          Set location of next text
         SPACE 1
         LA    R0,DSARB            input dataset request block
         STCM  R0,7,DSARBP+1
         LA    R0,DSADDNM          input ddname
         ST    R0,DSATXTP
         LA    R0,DSADSNM          input dsn
         ST    R0,DSATXTP+4
         LA    R0,DSASTATS         input stats
         ST    R0,DSATXTP+8
         LA    R0,DSADISP          input disposition
         STCM  R0,7,DSATXTP+13
         LA    R1,DSARB            input rb location
         USING S99RB,R1            addressability
         LA    R0,DSATXTP          input text pointer
         ST    R0,S99TXTPP
         MVI   S99RBLN,S99RBEND-S99RB length of rb
         MVI   S99VERB,S99VRBAL    allocation request
         MVI   S99FLAG1,S99NOCNV+S99NOMNT do not issue mounts
         DROP  R1
         SPACE 1
         LA    R0,DSTARB           temp work dataset request block
         STCM  R0,7,DSTARBP+1
         LA    R0,DSTADDNM         temp work ddname
         ST    R0,DSTATXTP
         LA    R0,DSTAUNIT         temp work unit
         ST    R0,DSTATXTP+4
         LA    R0,DSTASPCU         temp work space primary   units
         ST    R0,DSTATXTP+8
         LA    R0,DSTASPCP         temp work space primary   qty
         ST    R0,DSTATXTP+12
         LA    R0,DSTASPCS         temp work space secondary qty
         STCM  R0,7,DSTATXTP+17
         LA    R1,DSTARB           temp work rb location
         USING S99RB,R1            addressability
         LA    R0,DSTATXTP         input text pointer
         ST    R0,S99TXTPP
         MVI   S99RBLN,S99RBEND-S99RB length of rb
         MVI   S99VERB,S99VRBAL    allocation request
         MVI   S99FLAG1,S99NOCNV+S99NOMNT do not issue mounts
         DROP  R1
         SPACE 1
         LA    R0,DSSARB           sysin dataset request block
         STCM  R0,7,DSSARBP+1
         LA    R0,DSSADDNM         sysin ddname
         ST    R0,DSSATXTP
         LA    R0,DSSAUNIT         sysin unit
         ST    R0,DSSATXTP+4
         LA    R0,DSSASPCU         sysin space primary   units
         ST    R0,DSSATXTP+8
         LA    R0,DSSASPCP         sysin space primary   qty
         ST    R0,DSSATXTP+12
         LA    R0,DSSASPCS         sysin space secondary qty
         STCM  R0,7,DSSATXTP+17
         LA    R1,DSSARB           sysin rb location
         USING S99RB,R1            addressability
         LA    R0,DSSATXTP         input text pointer
         ST    R0,S99TXTPP
         MVI   S99RBLN,S99RBEND-S99RB length of rb
         MVI   S99VERB,S99VRBAL    allocation request
         MVI   S99FLAG1,S99NOCNV+S99NOMNT do not issue mounts
         DROP  R1
         SPACE 1
         LA    R0,DSPARB           sysprint dataset request block
         STCM  R0,7,DSPARBP+1
         LA    R0,DSPADDNM         sysprint ddname
         ST    R0,DSPATXTP
         LA    R0,DSPADUMY         dummy dataset
         STCM  R0,7,DSPATXTP+5
         LA    R1,DSPARB           sysin rb location
         USING S99RB,R1            addressability
         LA    R0,DSPATXTP         input text pointer
         ST    R0,S99TXTPP
         MVI   S99RBLN,S99RBEND-S99RB length of rb
         MVI   S99VERB,S99VRBAL    allocation request
         MVI   S99FLAG1,S99NOCNV+S99NOMNT do not issue mounts
         SPACE 1
         LA    R0,DSURB            unallocation request block
         STCM  R0,7,DSURBP+1
         LA    R0,DSUDDNM          ddname
         STCM  R0,7,DSUTXTP+1
         LA    R1,DSURB            unallocation rb location
         USING S99RB,R1            addressability
         LA    R0,DSUTXTP          input text pointer
         ST    R0,S99TXTPP
         MVI   S99RBLN,S99RBEND-S99RB length of rb
         MVI   S99VERB,S99VRBUN    unallocation request
         MVI   S99FLAG1,S99NOCNV+S99NOMNT do not issue mounts
         DROP  R1
         SPACE 1
INIT010  DS    0H                  prepare AWSPRINT
         OPEN  (AWSPRINT,(OUTPUT)),MF=(E,DSOPENL)  open awsprint
         TM    AWSPRINT+(DCBOFLGS-IHADCB),DCBOFOPN open successful?
         BO    INIT020             yes, branch
         WTO   'AWS010E AWSPRINT OPEN FAILED'
         LA    R15,12              sysprint open failed
         B     INITXIT             exit with error
         SPACE 1
INIT020  DS    0H                  prepare AWSOUT
         AIF   (&AWSDBUG EQ 0).INIT010
         AWSMSG 011I,'AWSINIT Entry'
.INIT010 ANOP
         OPEN  (AWSCNTL,(INPUT)),MF=(E,DSOPENL)  open awscntl
         TM    AWSCNTL+(DCBOFLGS-IHADCB),DCBOFOPN open successful?
         BO    INIT030             yes, branch
         AWSMSG 012E,'AWSCNTL open failed'
         LA    R15,12              16=awscntl open failed
         B     INITXIT             exit with error
         SPACE 1
INIT030  DS    0H
         AWSCALL AWSJOBNM          Capture job and step name info
         SPACE 1
INIT040  DS    0H
         SPACE 1
INITXIT  DS    0H                  function exit
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSMAIN - Process next control statement'
***********************************************************************
* AWSMAIN - Verb dispatcher                                           *
*           msgs AWS02n                                               *
***********************************************************************
         SPACE 1
AWSMAIN  CSECT ,                   Process next control statement
         AWSENTRY ,
         SPACE 1
         LA    R0,MAINEOF          AWSCNTL eof
         STCM  R0,7,AWSCNTL+(DCBEODA-IHADCB) place into dcb
         SPACE 1
MAIN010  DS    0H                  scan for dataset verb
         GET   AWSCNTL             retrieve a cntl record
         LR    R3,R1               record location
         MVC   DSMSG+1(17),=C'AWS020I  AWSCNTL:'
         MVC   DSMSG+19(80),0(R3)  set statement into message buffer
         AWSMSG ,                  print function
         CLI   0(R1),C'*'          comment?
         BE    MAIN010             yes, branch
         CLC   0(80,R3),CSBLNKS    blank line?
         BE    MAIN010             yes, branch
         CLC   =C'AWSVOL ',0(R3)   tapevol verb?
         BE    MAIN020             yes, branch
         CLC   =C'AWSGET ',0(R3)   import verb?
         BE    MAIN030             yes, branch
         CLC   =C'AWSPUT ',0(R3)   export verb?
         BE    MAIN040             yes, branch
         AWSMSG 021E,'Statement is not recognized'
         LA    R15,8               rc=4, invalid statement
         B     MAINXIT             return to caller
         SPACE 1
MAIN020  DS    0H                  tapevol verb
         AWSCALL AWSTVOL           invoke tapevol
         B     MAINXIT
         SPACE 1
MAIN030  DS    0H                  import verb
         TM    DSFLAGS2,DSFEXPRT   export invoked previously?
         BO    MAIN050             yes, branch
         OI    DSFLAGS2,DSFIMPRT   indicate import invoked
         AWSCALL AWSIMPRT          invoke import
         B     MAINXIT
         SPACE 1
MAIN040  DS    0H                  export verb
         TM    DSFLAGS2,DSFIMPRT   import invoked previously?
         BO    MAIN060             yes, branch
         OI    DSFLAGS2,DSFEXPRT   indicate import invoked
         AWSCALL AWSEXPRT          invoke export
         B     MAINXIT
         SPACE 1
MAIN050  DS    0H                  import invoked after export
         AWSMSG 022E,'AWSGET is mutually exclusive with AWSPUT'
         LA    R15,8
         B     MAINXIT
         SPACE 1
MAIN060  DS    0H                  export invoked after import
         AWSMSG 023E,'AWSPUT is mutually exclusive with AWSGET'
         LA    R15,8
         B     MAINXIT
         SPACE 1
MAINEOF  DS    0H                  AWSCNTL reached eof
         MVC   DSMSG+10(8),=C'AWSCNTL:'
         AWSMSG 024I,'End of AWSCNTL input detected'
         L     R15,=F'-4'          indicate eof
         SPACE 1
MAINXIT  DS    0H                  function exit
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSTERM - Termination processing'
***********************************************************************
* AWSTERM - Termination, close files and release resources            *
*           msg AWS03n                                                *
***********************************************************************
         SPACE 1
AWSTERM  CSECT ,                   Termination processing
         AWSENTRY ,
         SPACE 1
         TM    DSFLAGS,DSFOPNEX    AWSFILE open for export?
         BZ    TERM010             no, branch
         OI    DSFLAGS,DSFFLUSH    flush last buffer (just in case)
         AWSCALL AWSMARK           write final tape mark
         SPACE 1
TERM010  DS    0H                  check stack integrity
         L     R1,DSSTACKP         stack origin
         LA    R0,STACKCT          max entries in stack
         SLR   R2,R2               clear counter
TERM020  DS    0H                  calculate max stack depth
         CLC   CSF0,4(R1)          entry ever been used?
         BE    TERM030             no, branch
         LA    R2,1(,R2)           increment count
         LA    R1,18*4(,R1)        position at next stack entry
         BCT   R0,TERM020          continue until exhausted
         AWSMSG 030W,'WARNING! Stack overflow detected, contact rhp@dra*
               per.net'
         B     TERM040
         SPACE 1
TERM030  DS    0H                  write max stack depth used
         AIF   (&AWSDBUG EQ 0).TERM030
         CVD   R2,DSDWORK          convert to packed
         MVC   DSXL16(4),=X'40202120' edit mask
         ED    DSXL16(4),DSDWORK+6
         OI    DSXL16+3,C'0'       make printable
         MVC   DSMSG+1(7),=C'AWS031I'
         MVC   DSMSG+19(20),=C'Maximum stack depth:'
         MVC   DSMSG+39(2),DSXL16+2 set count into message
         AWSMSG ,                  write the message
.TERM030 ANOP
         SPACE 1
TERM040  DS    0H                  unallocate as needed
         AWSCALL AWSUNALC          dynamic unallocation
         LR    R3,R15              save return code
         SPACE 1
         TM    AWSCNTL+(DCBOFLGS-IHADCB),DCBOFOPN   open?
         BZ    TERM050                              no, branch
         CLOSE AWSCNTL,MF=(E,DSCLOSEL)              close it
         FREEPOOL AWSCNTL                           release buffers
         SPACE 1
TERM050  DS    0H                  cleanup AWSFILE
         TM    AWSFILE+(DCBOFLGS-IHADCB),DCBOFOPN    open?
         BZ    TERM060                              no, branch
         CLOSE AWSFILE,MF=(E,DSCLOSEL)              close it
         FREEPOOL AWSFILE                           release buffers
         SPACE 1
TERM060  DS    0H                  cleanup AWSPRINT
         TM    AWSPRINT+(DCBOFLGS-IHADCB),DCBOFOPN  open?
         BZ    TERM070                              no, branch
         CLOSE AWSPRINT,MF=(E,DSCLOSEL)             close it
         FREEPOOL AWSPRINT                          release buffers
         SPACE 1
TERM070  DS    0H                  cleanup SYSIN
         TM    SYSIN+(DCBOFLGS-IHADCB),DCBOFOPN     open?
         BZ    TERM080                              no, branch
         CLOSE SYSIN,MF=(E,DSCLOSEL)                close it
         FREEPOOL SYSIN                             release buffers
         SPACE 1
TERM080  DS    0H                  cleanup AWSUT2
         TM    AWSUT2+(DCBOFLGS-IHADCB),DCBOFOPN    open?
         BZ    TERM090                              no, branch
         CLOSE AWSUT2,MF=(E,DSCLOSEL)               close it
         FREEPOOL AWSUT2                            release buffers
         SPACE 1
TERM090  DS    0H                  cleanup AWSUT2
         TM    AWSUT3+(DCBOFLGS-IHADCB),DCBOFOPN    open?
         BZ    TERM100                              no, branch
         CLOSE AWSUT3,MF=(E,DSCLOSEL)               close it
         FREEPOOL AWSUT3                            release buffers
         SPACE 1
TERM100  DS    0H
         LR    R15,R3              return code from unalloc
         SPACE 1
TERMXIT  DS    0H                  exit
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSTVOL - AWSVOL verb handler'
***********************************************************************
* AWSTVOL - AWSVOL verb handler                                       *
*           msg AWS04n                                                *
***********************************************************************
         SPACE 1
AWSTVOL  CSECT ,                   TAPEVOL verb handler
         AWSENTRY ,
         SPACE 1
         AWSCALL AWSTVPAR          invoke keyword parser
         SPACE 1
         AWSMSG ,                  print blank line
         AWSMSG ,                  print blank line
         SPACE 1
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSIMPRT - Import verb handler'
***********************************************************************
* AWSIMPRT - AWSGET verb handler                                      *
*            msg AWS05n                                               *
***********************************************************************
         SPACE 1
AWSIMPRT CSECT ,                   Import verb handler
         AWSENTRY ,
         SPACE 1
         LR    R3,R1               future reference
         TM    AWSUT2+(DCBOFLGS-IHADCB),DCBOFOPN  AWSUT2 open?
         BZ    IMPRT010            no, branch
         CLOSE AWSUT2,MF=(E,DSCLOSEL) close awsfile
         FREEPOOL AWSUT2           release buffers
         SPACE 1
IMPRT010 DS    0H                  prepare to open
         NI    DSFLAGS,255-DSFOPNEX clear open for export (in case)
         SPACE 1
         XC    DSBUFEND,DSBUFEND   indicate no blocks read
         XC    DSBUFTP,DSBUFTP
         LA    R2,AWSUT2           dcb location
         USING IHADCB,R2           addressability
         MVC   DCBDDNAM,=CL8'AWSFILE' set ddname
         XC    DCBBLKSI,DCBBLKSI   clear blocksize
         XC    DCBLRECL,DCBLRECL   clear lrecl
         OPEN  (AWSUT2,(INPUT)),MF=(E,DSOPENL)  open awsfile
         TM    DCBOFLGS,DCBOFOPN   open successful?
         BO    IMPRT020            yes, branch
         AWSMSG 050E,'AWSFILE open for AWSGET failed'
         LA    R15,8               awsout open failed
         B     IMPRTXIT            exit with error
         SPACE 1
IMPRT020 DS    0H                  import
         TM    AWSFILE+(DCBOFLGS-IHADCB),DCBOFOPN file open?
         BZ    IMPRT030            no, branch
         CLOSE AWSFILE,MF=(E,DSCLOSEL) else close it
         FREEPOOL AWSFILE
         SPACE 1
IMPRT030 DS    0H                  prepare to import
         SLR   R0,R0               clear register
         ICM   R0,3,DCBLRECL       get lrecl
         BZ    IMPRT040            if zero, branch
         CH    R0,=H'16'           at least 16 bytes?
         BNL   IMPRT050            yes, branch
         AWSMSG 051E,'Input lrecl must be at least 16 bytes'
         LA    R15,8
         B     IMPRTXIT
         SPACE 1
IMPRT040 DS    0H                  check blksize
         ICM   R0,3,DCBBLKSI       load blksize
         CH    R0,=H'16'           at least 16 bytes?
         BNL   IMPRT050            yes, branch
         AWSMSG 052E,'Input blksize must be at least 16 bytes'
         LA    R15,8
         B     IMPRTXIT
         DROP  R2
         SPACE 1
IMPRT050 DS    0H
         SLR   R0,R0               clear register
         ST    R0,DSGTXTP          clear pointer
         STH   R0,DSGTXTL          clear length
         RDJFCB AWSUT2,MF=(E,DSRDJFCB) read the jfcb
         SPACE 1
         AWSMSG ,                  blank line
         MVC   DSMSG+1(7),=C'AWS053I'
         MVC   DSMSG+19(31),=C'Virtual tape dataset name     :'
         MVC   DSMSG+51(44),JFCBDSNM
         AWSMSG ,
         SPACE 1
         MVC   DSRECFM,CSBLNKS     clear default recfm
         SLR   R0,R0               clear register
         STH   R0,DSLRECL          clear lrecl
         STH   R0,DSBLKSIZ         clear blksize
         SPACE 1
         LR    R1,R3               current control statement
         AWSCALL AWSIMPAR          parse import keywords
         BNZ   IMPRTXIT
         AWSCALL AWSSKPTF          position to file
         BNZ   IMPRTXIT
         AWSCALL AWSIMLBL          process header labels
         BNZ   IMPRTXIT
         AWSCALL AWSICOPY          copy data into MVS dataset
         BNZ   IMPRTXIT
         AWSCALL AWSIMTLR          process trailer labels
         SPACE 1
IMPRTXIT DS    0H                  EXIT
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSEXPRT - Export verb handler'
***********************************************************************
* AWSEXPRT - AWSPUT verb handler                                      *
*            msg AWS06n                                               *
***********************************************************************
         SPACE 1
AWSEXPRT CSECT ,                   Export verb handler
         AWSENTRY ,
         SPACE 1
         LR    R2,R1               future reference
         TM    AWSFILE+(DCBOFLGS-IHADCB),DCBOFOPN  already open?
         BO    EXPRT010            yes, branch
         CLOSE AWSFILE,MF=(E,DSCLOSEL) close file
         FREEPOOL AWSFILE
         SPACE 1
         OPEN  (AWSFILE,(OUTPUT)),MF=(E,DSOPENL)  open awsfile
         TM    AWSFILE+(DCBOFLGS-IHADCB),DCBOFOPN  open successful?
         BO    EXPRT010            yes, branch
         AWSMSG 060E,'AWSFILE open for EXPORT failed'
         LA    R15,8               awsout open failed
         B     EXPRTXIT            exit with error
         SPACE 1
EXPRT010 DS    0H                  prepare awscntl
         TM    AWSFILE+(DCBRECFM-IHADCB),DCBRECU recfm=u?
         BO    EXPRT020            yes, branch
         TM    AWSFILE+(DCBRECFM-IHADCB),DCBRECV recfm=v?
         BZ    EXPRT020            no, branch
         OI    DSFLAGS,DSFRECV     indicate variable length output
         SPACE 1
EXPRT020 DS    0H                  export main line
         OI    DSFLAGS,DSFOPNEX    indicate open for export
         LR    R1,R2               current control statement
         AWSCALL AWSEXPAR          parse export keywords
         BNZ   EXPRTXIT
         AWSCALL AWSJFDSN          extract JFCB dsname
         BNZ   EXPRTXIT
         AWSCALL AWSTPDSN          set 17 byte tape dsname
         BNZ   EXPRTXIT
         AWSCALL AWSUNLD           unload (stage) file if necessary
         BNZ   EXPRTXIT
         AWSCALL AWSECOPY          copy the file into AWS structure
         BNZ   EXPRTXIT
         AWSCALL AWSMARK           write tape mark
         BNZ   EXPRTXIT
         AWSCALL AWSTLR            write trailer labels
         BNZ   EXPRTXIT
         AWSCALL AWSUNALC          unallocate files
         SPACE 1
EXPRTXIT DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSTVPAR - Parse AWSVOL verb parameters'
***********************************************************************
* AWSTVPAR - Parse AWSVOL verb parameters                             *
*            msg AWS07n                                               *
*                                                                     *
* On entry, r1 = cntl card image containing extract verb.             *
* On exit,  appropriate data areas updated.                           *
***********************************************************************
         SPACE 1
AWSTVPAR CSECT ,                   Parse extract verb parameters
         AWSENTRY ,
         SPACE 1
         MVC   DSTVOL,CSBLNKS      clear volser
         MVI   DSHETCMP,C' '       clear
         MVI   DSHETMTH,C' '
         MVI   DSHETLVL,C' '
         MVI   DSHETIDR,C' '
         MVC   DSHETCSZ,CSBLNKS
         MVC   DSOWNER,=CL10'AWSSL 1.9G'
         SPACE 1
         LR    R3,R1               cntl statement image
         LR    R5,R1               current location in scan
         LA    R1,7                point beyond verb
         SPACE 1
TVPAR010 DS    0H                  locate a keyword
         ALR   R5,R1               end of previous keyword if any
         LA    R1,80(,R3)          end of statement
         SLR   R1,R3               length remaining
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX1         locate keyword
         BZ    TVPARRC0            if no keyword found, exit
         LR    R4,R1               keyword suffix location
         LA    R5,1(,R1)           argument origin
TVPAR020 DS    0H                  locate origin of keyword
         BCTR  R4,0                backup one byte
         CLI   0(R4),C','          comma delimiter?
         BE    TVPAR030            yes, branch
         CLI   0(R4),C' '          space delimiter?
         BE    TVPAR030            yes, branch
         CR    R4,R3               origin of statement reached?
         BH    TVPAR020            no, continue search
         AWSMSG 070E,'TAPEVOL parameter syntax error'
         LA    R15,8               export parameter syntax error
         B     TVPARXIT            return to caller
         SPACE 1
TVPAR030 DS    0H                  dispatch keyword handler
         LA    R4,1(,R4)           keyword origin
         CLC   =C'VOLSER=',0(R4)   volser= keyword?
         BE    TVPAR100            yes, branch
         CLC   =C'COMPRESS=',0(r4) COMPRESS= keyword?
         BE    TVPAR110            yes, branch
         CLC   =C'METHOD=',0(r4)   METHOD= keyword?
         BE    TVPAR120            yes, branch
         CLC   =C'LEVEL=',0(R4)    LEVEL= keyword?
         BE    TVPAR130            yes, branch
         CLC   =C'IDRC=',0(r4)     IDRC= keyword?
         BE    TVPAR140            yes, branch
         CLC   =C'CHUNKSIZE=',0(r4) CHUNKSIZE= keyword?
         BE    TVPAR150            yes, branch
         CLC   =C'OWNER=',0(R4)    OWNER= keyword?
         BE    TVPAR160            yes, branch
         MVC   DSMSG+1(7),=C'AWS071E'
         MVC   DSMSG+19(29),=C'TAPEVOL KEYWORD UNRECOGNIZED:'
         LR    R1,R5               argument origin
         SLR   R1,R4               length of argument
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX2         set keyword into message
         AWSMSG ,                  write the message
         LA    R15,8               export  keyword unrecognized
         B     TVPARXIT            return to caller
         SPACE 1
TVPAR100 DS    0H                  tapevol= keyword handler
         MVC   DSTVOL,CSBLNKS      clear volser
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,TVPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSTVOL)     greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSTVOL         else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX4         capture dsn
         B     TVPAR900
         SPACE 1
TVPAR110 DS    0H                  HET= keyword handler
         MVI   DSHETCMP,C' '       clear
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,TVPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSHETCMP)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSHETCMP       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX5         capture argument
         AWSMSG 072W,'Warning, COMPRESS keyword is not yet implemented,*
                ignored'
         B     TVPAR900
         SPACE 1
TVPAR120 DS    0H                  METHOD= keyword handler
         MVI   DSHETMTH,C' '       clear HETLVL
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,TVPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSHETMTH)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSHETMTH       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX6         capture argument
         AWSMSG 073W,'Warning, METHOD keyword is not yet implemented, i*
               gnored'
         B     TVPAR900
         SPACE 1
TVPAR130 DS    0H                  LEVEL= keyword handler
         MVI   DSHETLVL,C' '       clear HETLVL
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,TVPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSHETLVL)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSHETLVL       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX7         capture argument
         AWSMSG 074W,'Warning, LEVEL keyword is not yet implemented, ig*
               nored'
         B     TVPAR900
         SPACE 1
TVPAR140 DS    0H                  IDRC= keyword handler
         MVI   DSHETIDR,C' '       clear
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,TVPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSHETIDR)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSHETIDR       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX8         capture argument
         AWSMSG 075W,'Warning, IDRC keyword is not yet implemented, ign*
               ored'
         B     TVPAR900
         SPACE 1
TVPAR150 DS    0H                  CHUNKSIZE= keyword handler
         MVC   DSHETCSZ,CSBLNKS    clear
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,TVPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSHETCSZ)   greater than max length?
         BL    *+8                 no, branch
         LA    R1,L'DSHETCSZ       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREX9         capture argument
         AWSMSG 076W,'Warning, CHUNKSIZE keyword is not yet implemented*
               , ignored'
         B     TVPAR900
         SPACE 1
TVPAR160 DS    0H                  OWNER= keyword handler
         MVC   DSOWNER,CSBLNKS
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         TRT   0(1,R5),CSPARST3    quoted string?
         BZ    TVPAR162            no, branch
         LA    R5,1(,R5)           position at string origin
         EX    R1,TVPAREXA         locate trailing quote
         B     TVPAR164
TVPAR162 DS    0H                  handle non quoted string
         EX    R1,TVPAREX3         locate delimiter
TVPAR164 DS    0H
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    TVPAR930            if null, branch
         CH    R1,=Y(L'DSOWNER)    greater than max length?
         BL    *+8                 no, branch
         LA    R1,L'DSOWNER        else force to max length
         BCTR  R1,0                machine relative
         EX    R1,TVPAREXB         capture argument
*        B     TVPAR900
         SPACE 1
TVPAR900 DS    0H                  handle continuation if present
         CLC   =C', ',0(R6)        continuation to next card?
         BNE   TVPAR010            no, continue this statement, branch
         SPACE 1
TVPAR910 DS    0H                  retrieve continued statement
         GET   AWSCNTL             retrieve a cntl record
         LR    R3,R1               record location
         MVC   DSMSG+1(7),=C'AWS077I'
         MVC   DSMSG+19(80),0(R3)  set statement into message buffer
         AWSMSG ,                  print function
         CLI   0(R1),C'*'          comment?
         BE    TVPAR910            yes, branch
         CLC   0(80,R3),CSBLNKS    blank line?
         BE    TVPAR910            yes, branch
         CLI   0(R3),C' '          first byte non blank?
         BE    TVPAR920            yes, branch
         AWSMSG 078E,'Continuation statement error, 1st byte not blank'
         LA    R15,8               continuation error
         B     TVPARXIT            return to caller
         SPACE 1
TVPAR920 DS    0H                  setup for continue scan
         LA    R5,1(,R1)           current location in scan
         SLR   R1,R1               offset to argument
         B     TVPAR010            continue
         SPACE 1
TVPAR930 DS    0H                  keyword with null argument found
         LA    R1,1                position beyond delimiter
         B     TVPAR900            continue
         SPACE 1
TVPARRC0 DS    0H                  exit with rc = 0
         SLR   R15,R15             clear register
         SPACE 1
TVPARXIT DS    0H                  function exit
         AWSEXIT ,
         SPACE 1
TVPAREX1 TRT   0(0,R5),CSPARST1    *** execute only ***
TVPAREX2 MVC   DSMSG+49(0),0(R4)   *** execute only ***
TVPAREX3 TRT   0(0,R5),CSPARST2    *** execute only ***
TVPAREX4 MVC   DSTVOL(0),0(R5)     *** execute only ***
TVPAREX5 MVC   DSHETCMP(0),0(R5)   *** execute only ***
TVPAREX6 MVC   DSHETMTH(0),0(R5)   *** execute only ***
TVPAREX7 MVC   DSHETLVL(0),0(R5)   *** execute only ***
TVPAREX8 MVC   DSHETIDR(0),0(R5)   *** execute only ***
TVPAREX9 MVC   DSHETCSZ(0),0(R5)   *** execute only ***
TVPAREXA TRT   0(0,R5),CSPARST3    *** execute only ***
TVPAREXB MVC   DSOWNER(0),0(R5)    *** execute only ***
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSIMPAR - Parse IMPORT verb parameters'
***********************************************************************
* AWSIMPAR - Parse IMPORT verb parameters                             *
*            msg AWS08n                                               *
*                                                                     *
* On entry, r1 = cntl card image containing extract verb.             *
* On exit,  appropriate data areas updated.                           *
***********************************************************************
         SPACE 1
AWSIMPAR CSECT ,                   Parse IMPORT verb parameters
         AWSENTRY ,
         SPACE 1
         MVC   DSOUTDD,CSBLNKS     clear
         MVC   DSINDSN,CSBLNKS
         MVC   DSINFLNC,CSBLNKS
         MVC   DSINFLNO,=H'1'
         MVI   DSUSESL,C' '
         MVC   DSLODPGM,CSBLNKS
         SPACE 1
         LR    R3,R1               cntl statement image
         LR    R5,R1               current location in scan
         LA    R6,6(,R5)           point beyond verb
         SPACE 1
IMPAR010 DS    0H                  locate a keyword
         LA    R5,1(,R6)           end of previous keyword if any
         LA    R1,80(,R3)          end of statement
         SLR   R1,R3               length remaining
         BCTR  R1,0                machine relative
         EX    R1,IMPAREX1         locate keyword
         BZ    IMPAR940            if no keyword found, exit
         LR    R4,R1               keyword suffix location
         LA    R5,1(,R1)           argument origin
IMPAR020 DS    0H                  locate origin of keyword
         BCTR  R4,0                backup one byte
         CLI   0(R4),C','          comma delimiter?
         BE    IMPAR030            yes, branch
         CLI   0(R4),C' '          space delimiter?
         BE    IMPAR030            yes, branch
         CR    R4,R3               origin of statement reached?
         BH    IMPAR020            no, continue search
         AWSMSG 080E,'AWSGET parameter syntax error'
         LA    R15,8               import parameter syntax error
         B     IMPARXIT            return to caller
         SPACE 1
IMPAR030 DS    0H                  dispatch keyword handler
         LA    R4,1(,R4)           keyword origin
         CLC   =C'OUTDD=',0(R4)    OUTDD= keyword?
         BE    IMPAR100            yes, branch
         CLC   =C'INDSN=',0(R4)    INDSN= keyword?
         BE    IMPAR110            yes, branch
         CLC   =C'FILENO=',0(R4)   FILENO= keyword?
         BE    IMPAR120            yes, branch
         CLC   =C'SL=',0(R4)       SL= keyword?
         BE    IMPAR140            yes, branch
         CLC   =C'LOAD=',0(R4)     LOAD= keyword?
         BE    IMPAR150            yes, branch
         MVC   DSMSG+1(7),=C'AWS081E'
         MVC   DSMSG+19(29),=C'AWSGET keyword unrecognized:'
         LR    R1,R5               argument origin
         SLR   R1,R4               length of argument
         BCTR  R1,0                machine relative
         EX    R1,IMPAREX2         set keyword into message
         AWSMSG ,                  write the message
         LA    R15,8               import  keyword unrecognized
         B     IMPARXIT            return to caller
         SPACE 1
IMPAR100 DS    0H                  outdd= keyword handler
         MVC   DSOUTDD,CSBLNKS     clear volser
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,IMPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    IMPAR930            if null, branch
         CH    R1,=Y(L'DSOUTDD)    greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSOUTDD        else force to max length
         BCTR  R1,0                machine relative
         EX    R1,IMPAREX4         capture
         B     IMPAR900
         SPACE 1
IMPAR110 DS    0H                  indsn= keyword handler
         MVC   DSINDSN,CSBLNKS     clear
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,IMPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    IMPAR930            if null, branch
         CH    R1,=Y(L'DSINDSN)    greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSINDSN        else force to max length
         BCTR  R1,0                machine relative
         EX    R1,IMPAREX5         capture argument
         B     IMPAR900
         SPACE 1
IMPAR120 DS    0H                  fileno= keyword handler
         MVC   DSINFLNC,CSBLNKS    clear
         MVC   DSINFLNO,=H'1'      default
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,IMPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    IMPAR930            if null, branch
         CH    R1,=Y(L'DSINFLNC)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSINFLNC       else force to max length
         BCTR  R1,0                machine relative
         LR    R14,R1              save for future reference
         EX    R1,IMPAREX6         numeric?
         BZ    IMPAR130            yes, branch
         AWSMSG 082E,'FILENO= Argument is not numeric'
         LA    R15,8               return code
         B     IMPARXIT
IMPAR130 DS    0H
         EX    R14,IMPAREX7        pack fileno character argument
         CVB   R0,DSDWORK          convert to binary
         STH   R0,DSINFLNO         ... AND SAVE
         B     IMPAR900
         SPACE 1
IMPAR140 DS    0H                  SL= keyword handler
         MVI   DSUSESL,C' '        clear
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,IMPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    IMPAR930            if null, branch
         CH    R1,=Y(L'DSUSESL)    greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSUSESL        else force to max length
         BCTR  R1,0                machine relative
         EX    R1,IMPAREX8         capture argument
         SPACE 1
         CLI   DSUSESL,C' '        default?
         BE    IMPAR900            yes, branch
         CLI   DSUSESL,C'N'        sl=no?
         BE    IMPAR900            yes, branch
         CLI   DSUSESL,C'Y'        sl=yes?
         BE    IMPAR900            yes, branch
         AWSMSG 083E,'SL= Argument is invalid'
         LA    R15,8
         B     IMPARXIT
         SPACE 1
IMPAR150 DS    0H
         MVC   DSLODPGM,CSBLNKS    clear
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,IMPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    IMPAR930            if null, branch
         CH    R1,=Y(L'DSLODPGM)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSLODPGM       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,IMPAREX9         capture argument
*        B     IMPAR900
         SPACE 1
IMPAR900 DS    0H                  handle continuation if present
         CLC   =C', ',0(R6)        continuation to next card?
         BNE   IMPAR010            no, continue this statement, branch
         SPACE 1
IMPAR910 DS    0H                  retrieve continued statement
         GET   AWSCNTL             retrieve a cntl record
         LR    R3,R1               record location
         MVC   DSMSG+1(7),=C'AWS084I'
         MVC   DSMSG+19(80),0(R3)  set statement into message buffer
         AWSMSG ,                  print function
         CLI   0(R1),C'*'          comment?
         BE    IMPAR910            yes, branch
         CLC   0(80,R3),CSBLNKS    blank line?
         BE    IMPAR910            yes, branch
         CLI   0(R3),C' '          first byte non blank?
         BE    IMPAR920            yes, branch
         AWSMSG 085E,'Continuation statement error, 1st byte not blank'
         LA    R15,8               continuation error
         B     IMPARXIT            return to caller
         SPACE 1
IMPAR920 DS    0H                  setup for continue scan
         LA    R5,1(,R1)           current location in scan
         SLR   R1,R1               offset to argument
         B     IMPAR010            continue
         SPACE 1
IMPAR930 DS    0H                  keyword with null argument found
         LA    R1,1                position beyond delimiter
         B     IMPAR900            continue
         SPACE 1
IMPAR940 DS    0H                  exit with rc = 0
         CLI   DSOUTDD,C' '        output ddname specified?
         BH    IMPAR950            yes, branch
         AWSMSG 086E,'AWSGET requires that OUTDD= be specified'
         LA    R15,8
         B     IMPARXIT
         SPACE 1
IMPAR950 DS    0H                  normal return
         SLR   R15,R15             clear register
         SPACE 1
IMPARXIT DS    0H                  function exit
         AWSEXIT ,
         SPACE 1
IMPAREX1 TRT   0(0,R5),CSPARST1    *** execute only ***
IMPAREX2 MVC   DSMSG+49(0),0(R4)   *** execute only ***
IMPAREX3 TRT   0(0,R4),CSPARST2    *** execute only ***
IMPAREX4 MVC   DSOUTDD(0),0(R5)    *** execute only ***
IMPAREX5 MVC   DSINDSN(0),0(R5)    *** execute only ***
IMPAREX6 TRT   0(0,R5),CSNUMTRT    *** execute only ***
IMPAREX7 PACK  DSDWORK,0(0,R5)     *** execute only ***
IMPAREX8 MVC   DSUSESL(0),0(R5)    *** execute only ***
IMPAREX9 MVC   DSLODPGM(0),0(R5)   *** execute only ***
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSEXPAR - Parse extract verb parameters'
***********************************************************************
* AWSEXPAR - Parse extract verb parameters                            *
*            msg AWS09n                                               *
*                                                                     *
* On entry, r1 = cntl card image containing extract verb.             *
* On Exit,  appropriate data areas updated.                           *
***********************************************************************
         SPACE 1
AWSEXPAR CSECT ,                   Parse extract verb parameters
         AWSENTRY ,
         SPACE 1
         MVC   DSINDSN,CSBLNKS     clear input dsn
         MVC   DSOUTDSN,CSBLNKS    clear output dsn
         MVC   DSTDSN,CSBLNKS      clear tape dsn
         MVC   DSINDD,CSBLNKS      clear input dd name
         MVC   DSUNLPGM,CSBLNKS    clear unload program
         MVC   DSUNLTYP,CSBLNKS    clear unload type
         MVI   DSUSESL,C' '        clear use standard labels flag
         SPACE 1
         LR    R3,R1               cntl statement image
         LR    R5,R1               current location in scan
         LA    R1,7                point beyond verb
         SPACE 1
EXPAR010 DS    0H                  locate a keyword
         ALR   R5,R1               end of previous keyword if any
         LA    R1,80(,R3)          end of statement
         SLR   R1,R3               length remaining
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX1         locate keyword
         BZ    EXPARRC0            if no keyword found, exit
         LR    R4,R1               keyword suffix location
         LA    R5,1(,R1)           argument origin
EXPAR020 DS    0H                  locate origin of keyword
         BCTR  R4,0                backup one byte
         CLI   0(R4),C','          comma delimiter?
         BE    EXPAR030            yes, branch
         CLI   0(R4),C' '          space delimiter?
         BE    EXPAR030            yes, branch
         CR    R4,R3               origin of statement reached?
         BH    EXPAR020            no, continue search
         AWSMSG 090E,'AWSPUT parameter syntax error'
         LA    R15,8               export parameter syntax error
         B     EXPARXIT            return to caller
         SPACE 1
EXPAR030 DS    0H                  dispatch keyword handler
         LA    R4,1(,R4)           keyword origin
         CLC   =C'INDSN=',0(R4)    INDSN= keyword?
         BE    EXPAR100            yes, branch
         CLC   =C'OUTDSN=',0(R4)   OUTDSN= keyword?
         BE    EXPAR110            yes, branch
         CLC   =C'TAPEDSN=',0(R4)  TAPEDSN= keyword?
         BE    EXPAR120            yes, branch
         CLC   =C'INDD=',0(R4)     INDD= keyword?
         BE    EXPAR130            yes, branch
         CLC   =C'UNLOAD=',0(R4)   UNLOAD= keyword?
         BE    EXPAR140            yes, branch
         CLC   =C'TYPE=',0(R4)     TYPE= keyword?
         BE    EXPAR150            yes, branch
         CLC   =C'SL=',0(R4)       SL= keyword?
         BE    EXPAR160            yes, branch
         MVC   DSMSG+1(7),=C'AWS091E'
         MVC   DSMSG+19(28),=C'AWSPUT keyword unrecognized:'
         LR    R1,R5               argument origin
         SLR   R1,R4               length of argument
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX2         set keyword into message
         AWSMSG ,                  write the message
         LA    R15,8               export  keyword unrecognized
         B     EXPARXIT            return to caller
         SPACE 1
EXPAR100 DS    0H                  indsn= keyword handler
         MVC   DSINDSN,CSBLNKS     clear dataset name
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR930            if null, branch
         CH    R1,=Y(L'DSINDSN)    greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSINDSN        else force to max length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX4         capture dsn
         B     EXPAR900
         SPACE 1
EXPAR110 DS    0H                  outdsn= keyword handler
         MVC   DSOUTDSN,CSBLNKS    clear out dataset name
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR930            if null, branch
         CH    R1,=Y(L'DSOUTDSN)   greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSOUTDSN       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX5         capture dsn
         B     EXPAR900
         SPACE 1
EXPAR120 DS    0H                  tapedsn= keyword handler
         MVC   DSTDSN,CSBLNKS      clear tape dsn
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR930            if null, branch
         CH    R1,=Y(L'DSTDSN)     greater than maximum length?
         BL    *+8                 no, branch
         LA    R1,L'DSTDSN         else force to maximum length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX6         capture dsn
         B     EXPAR900
         SPACE 1
EXPAR130 DS    0H                  INDD= keyword handler
         MVC   DSINDD,CSBLNKS      clear input dd name
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR930            if null, branch
         CH    R1,=Y(L'DSINDD)     maximum length
         BL    *+8                 no, branch
         LA    R1,L'DSINDD         else force to max length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX7         capture indd
         B     EXPAR900
         SPACE 1
EXPAR140 DS    0H                  UNLOAD= keyword handler
         MVC   DSUNLPGM,CSBLNKS    clear unload program name
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR930            if null, branch
         CH    R1,=Y(L'DSUNLPGM)   maximum length
         BL    *+8                 no, branch
         LA    R1,L'DSUNLPGM       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX8         capture unload program
         B     EXPAR900
         SPACE 1
EXPAR150 DS    0H                  TYPE= keyword handler
         MVC   DSUNLTYP,CSBLNKS    clear unload type
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR930            if null, branch
         CH    R1,=Y(L'DSUNLTYP)   maximum length
         BL    *+8                 no, branch
         LA    R1,L'DSUNLTYP       else force to max length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREX9         capture unload program
         B     EXPAR900
         SPACE 1
EXPAR160 DS    0H                  TYPE= keyword handler
         MVI   DSUNLTYP,C' '       clear use standard labels flag
         LA    R1,80(,R3)          end of cntl statement
         SLR   R1,R5               length of statement remaining
         EX    R1,EXPAREX3         locate delimiter
         LR    R6,R1               delimiter location
         SR    R1,R5               length of argument
         BZ    EXPAR170            if null, branch
         CH    R1,=Y(L'DSUSESL)    maximum length
         BL    *+8                 no, branch
         LA    R1,L'DSUSESL        else force to max length
         BCTR  R1,0                machine relative
         EX    R1,EXPAREXA         capture
         SPACE 1
         CLI   DSUSESL,C' '        default?
         BE    EXPAR170            yes, branch
         CLI   DSUSESL,C'N'        sl=no?
         BE    EXPAR170            yes, branch
         CLI   DSUSESL,C'Y'        sl=yes?
         BE    EXPAR170            yes, branch
         AWSMSG 054E,'SL= Argument is invalid'
         LA    R15,8
         B     EXPARXIT
         SPACE 1
EXPAR170 DS    0H
         SPACE 1
EXPAR900 DS    0H                  handle continuation if present
         CLC   =C', ',0(R6)        continuation to next card?
         BNE   EXPAR010            no, continue this statement, branch
         SPACE 1
EXPAR910 DS    0H                  retrieve continued statement
         GET   AWSCNTL             retrieve a cntl record
         LR    R3,R1               record location
         MVC   DSMSG+1(7),=C'AWS052I'
         MVC   DSMSG+19(80),0(R3)  set statement into message buffer
         AWSMSG ,                  print function
         CLI   0(R1),C'*'          comment?
         BE    EXPAR910            yes, branch
         CLC   0(80,R3),CSBLNKS    blank line?
         BE    EXPAR910            yes, branch
         CLI   0(R3),C' '          first byte non blank?
         BE    EXPAR920            yes, branch
         AWSMSG 092E,'Continuation statement error, 1st byte not blank'
         LA    R15,8               continuation error
         B     EXPARXIT            return to caller
         SPACE 1
EXPAR920 DS    0H                  setup for continue scan
         LA    R5,1(,R1)           current location in scan
         SLR   R1,R1               offset to argument
         B     EXPAR010            continue
         SPACE 1
EXPAR930 DS    0H                  keyword with null argument found
         LA    R1,1                position beyond delimiter
         B     EXPAR900            continue
         SPACE 1
EXPARRC0 DS    0H                  exit with rc = 0
         SLR   R15,R15             clear register
         SPACE 1
EXPARXIT DS    0H                  function exit
         AWSEXIT ,
         SPACE 1
EXPAREX1 TRT   0(0,R5),CSPARST1    *** execute only ***
EXPAREX2 MVC   DSMSG+48(0),0(R4)   *** execute only ***
EXPAREX3 TRT   0(0,R5),CSPARST2    *** execute only ***
EXPAREX4 MVC   DSINDSN(0),0(R5)    *** execute only ***
EXPAREX5 MVC   DSOUTDSN(0),0(R5)   *** execute only ***
EXPAREX6 MVC   DSTDSN(0),0(R5)     *** execute only ***
EXPAREX7 MVC   DSINDD(0),0(R5)     *** execute only ***
EXPAREX8 MVC   DSUNLPGM(0),0(R5)   *** execute only ***
EXPAREX9 MVC   DSUNLTYP(0),0(R5)   *** execute only ***
EXPAREXA MVC   DSUSESL(0),0(R5)    *** execute only ***
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSJFDSN - Extract input dsn'
***********************************************************************
* AWSJFDSN - Extract input dsn                                        *
*            msg AWS10n                                               *
***********************************************************************
         SPACE 1
AWSJFDSN CSECT ,                   Extract input dsn
         AWSENTRY ,
         SPACE 1
         CLI   DSOUTDSN,C' '       output dsn specified?
         BH    JFDSNXIT            yes, exit
         CLI   DSTDSN,C' '         explicit tape dsn specified?
         BH    JFDSNXIT            yes, exit
         SPACE 1
         CLI   DSINDD,C' '         indd specified?
         BH    JFDSN010            yes, branch
         MVC   DSOUTDSN,DSINDSN    else default outdsn to indsn
         B     JFDSNXIT            exit
         SPACE 1
JFDSN010 DS    0H                  capture outdsn from indd=
         MVC   AWSUT1+(DCBDDNAM-IHADCB)(8),=CL8'AWSUT1'
         CLI   DSINDD,C' '         input dd present?
         BE    *+10                no, use awsut1, branch
         MVC   AWSUT1+(DCBDDNAM-IHADCB)(8),DSINDD
         SPACE 1
         RDJFCB AWSUT1,MF=(E,DSRDJFCB) read the jfcb
         MVC   DSOUTDSN,JFCBDSNM   default outdsn to input dsn
         SPACE 1
JFDSNXIT DS    0H                  function exit
         SLR   R15,R15             zero return code
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSTPDSN - Set 17 byte tape dsn'
***********************************************************************
* AWSTPDSN - Set 17 byte tape dsn                                     *
*            msg AWS11n                                               *
***********************************************************************
         SPACE 1
AWSTPDSN CSECT ,                   Set 17 byte tape dsn
         AWSENTRY ,
         SPACE 1
         CLI   DSTDSN,C' '         tape dsn explicitly given?
         BH    TPDSNXIT            yes, branch
         SPACE 1
         LA    R1,DSOUTDSN+L'DSOUTDSN point beyond outdsn
         TRT   DSOUTDSN,CSPARST2   locate end of outdsn
         LA    R2,DSOUTDSN         outdsn origin
         SLR   R1,R2               length of outdsn
         CH    R1,=Y(L'DSTDSN)     greater than maximum length?
         BH    TPDSN010            yes, branch
         MVC   DSTDSN,DSOUTDSN     else default outdsn as is
         B     TPDSNXIT            exit
         SPACE 1
TPDSN010 DS    0H                  capture right most 17 bytes
         SH    R1,=Y(L'DSTDSN)     offset to start of name
         ALR   R2,R1               origin of move
         MVC   DSTDSN,0(R2)        capture
         SPACE 1
TPDSNXIT DS    0H                  function exit
         SLR   R15,R15             zero return code
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSJOBNM - Capture job and step name info'
***********************************************************************
* AWSJOBNM - Capture job and step name info                           *
*            msg AWS12n                                               *
***********************************************************************
         SPACE 1
AWSJOBNM CSECT ,                   Capture job and step name info
         AWSENTRY ,
         USING PSA,R0
         L     R3,PSATOLD          current TCB location
         USING TCB,R3              TCB addressasbility
         L     R4,TCBTIO           TIOT location
         USING TIOT,R4
         MVC   DSJOBNM,TIOCNJOB    set job  name
         MVC   DSSTEPNM,TIOCSTEP+8 set step name
         CLI   DSSTEPNM,C' '       blank stepname?
         BNE   JOBNMXIT            no, branch
         MVC   DSSTEPNM,TIOCSTEP   else try w/o procstep
         SPACE 1
JOBNMXIT DS    0H                  function exit
         SLR   R15,R15             zero return code
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSUNLD - Unload (stage) dataset'
***********************************************************************
* AWSUNLD - Unload (stage) dataset                                    *
*           msg AWS13n                                                *
***********************************************************************
         SPACE 1
AWSUNLD  CSECT ,                   Unload (stage) dataset
         AWSENTRY ,
         SPACE 1
         SLR   R15,R15             zero return code
         CLI   DSUNLPGM,C' '       unload requested?
         BE    UNLODXIT            no, branch
         SPACE 1
         AWSCALL AWSALCI           allocate input dataset
         BNZ   UNLODXIT
         SPACE 1
         AWSCALL AWSALCT           allocate work dataset
         BNZ   UNLODXIT
         SPACE 1
         AWSCALL AWSALCS           allocate sysin dataset
         BNZ   UNLODXIT
         SPACE 1
         AWSCALL AWSALCP           allocate sysprint dataset
         BNZ   UNLODXIT
         SPACE 1
         OPEN  (SYSIN,(OUTPUT)),MF=(E,DSOPENL) open sysin for output
         SPACE 1
         TM    SYSIN+(DCBOFLGS-IHADCB),DCBOFOPN open ok?
         BO    UNLOD010            yes, branch
         AWSMSG 130E,'SYSIN open for output failed'
         LA    R15,8               set return code
         B     UNLODXIT
         SPACE 1
UNLOD010 DS    0H                  determine type of unload
         CLC   =C'IEBCOPY',DSUNLPGM iebcopy unload?
         BE    UNLOD100            yes, branch
         CLC   =C'IDCAMS',DSUNLPGM idcams export?
         BE    UNLOD200            yes, branch
         AWSMSG 131E,'Unrecognized unload program specified'
         LA    R15,8               unrecognized unload pgm
         B     UNLODXIT            exit
         SPACE 1
UNLOD100 DS    0H                  iebcopy unload request
         MVI   DSCARD,C' '         clear card image
         MVC   DSCARD+1(L'DSCARD-1),DSCARD
         MVC   DSCARD(15),=C' C O=AWSTEMP,I='
         MVC   DSCARD+15(8),DSINDD assume indd= statement present
         CLI   DSINDD,C' '         indd= keyword present?
         BH    UNLOD110            yes, branch
         MVC   DSCARD+15(8),=CL8'AWSUT1' else use default
         SPACE 1
UNLOD110 DS    0H                  write control statement
         PUT   SYSIN,DSCARD
         SPACE 1
         CLOSE SYSIN,MF=(E,DSCLOSEL) close file
         FREEPOOL SYSIN            release buffer pool
         SPACE 1
         SLR   R1,R1               clear parameter register
         LINK  EP=IEBCOPY          invoke iebcopy
         LTR   R15,R15             success?
         BZ    UNLOD120            yes, branch
         AWSMSG 132E,'IEBCOPY unload failed'
         LA    R15,8               set return code
         B     UNLODXIT            exit
         space 1
UNLOD120 DS    0H                  Unload via iebcopy successful msg
         AWSMSG ,                  blank line
         AWSMSG 133I,'PDS(E) unload successful'
         B     UNLODXIT            exit
         SPACE 1
UNLOD200 DS    0H                  idcams export
         AWSMSG 134F,'IDCAMS export not yet supported'
         LA    R15,12
*        B     UNLODXIT
         SPACE 1
UNLODXIT DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSALCI - Dynamically allocate input'
***********************************************************************
* AWSALCI - Dynamically allocate input                                *
*           msg AWS14n                                                *
***********************************************************************
         SPACE 1
AWSALCI  CSECT ,                   Dynamically allocate input
         AWSENTRY ,
         SPACE 1
         CLI   DSINDD,C' '         input dataset already allocated?
         BNE   ALOCI030            yes, branch
         SPACE 1
         MVC   DSADSNMT,DSINDSN    input dataset name
         LA    R1,DSARBP           input rb pointer
         SVC   99                  input allocation
         LTR   R15,R15             successful?
         BZ    ALOCI020            yes, branch
         LA    R3,DSARB            rb location
         USING S99RB,R3            input rb addressability
         CH    R15,CSH4            rc=4?
         BNE   ALOCI010            no, error, branch
         CLC   S99ERROR,=X'0410'   ddname already allocated?
         BE    ALOCI030            yes, branch
         SPACE 1
ALOCI010 DS    0H                  allocation error occured
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 140E,'Input dataset dynamic allocation failed'
         LA    R15,8               set return code
         B     ALOCIXIT            exit
         SPACE 1
ALOCI020 DS    0H                  successful dynamic allocation
         OI    DSFLAGS,DSFDYUT1    awsut1 dynamically allocated
         SPACE 1
ALOCI030 DS    0H                  normal return
         SLR   R15,R15             zero return code
         SPACE 1
ALOCIXIT DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSALCT - Dynamically allocate temporary work'
***********************************************************************
* AWSALCT - Dynamically allocate temporary work                       *
*           msg AWS15n                                                *
***********************************************************************
         SPACE 1
AWSALCT  CSECT ,                   Dynamically allocate temporary work
         AWSENTRY ,
         SPACE 1
         LA    R1,DSTARBP          temp work rb pointer
         SVC   99                  temp work allocation
         LTR   R15,R15             successful?
         BZ    ALOCT020            yes, branch
         LA    R3,DSTARB           rb location
         USING S99RB,R3            input rb addressability
         CH    R15,CSH4            rc=4?
         BNE   ALOCT010            no, error, branch
         CLC   S99ERROR,=X'0410'   ddname already allocated?
         BE    ALOCT030            yes, branch
         SPACE 1
ALOCT010 DS    0H                  allocation error occured
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 150E,'Temp work dataset dynamic allocation failed'
         LA    R15,8               set return code
         B     ALOCTXIT            exit
         SPACE 1
ALOCT020 DS    0H                  successful dynamic allocation
         OI    DSFLAGS,DSFDYTMP    awstemp dynamically allocated
         SPACE 1
ALOCT030 DS    0H                  normal return
         SLR   R15,R15             zero return code
         SPACE 1
ALOCTXIT DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSALCS - Dynamically allocate sysin'
***********************************************************************
* AWSALCS - Dynamically allocate temporary sysin                      *
*           msg AWS16n                                                *
***********************************************************************
         SPACE 1
AWSALCS  CSECT ,                   Dynamically allocate temporary work
         AWSENTRY ,
         SPACE 1
         LA    R1,DSSARBP          temp work rb pointer
         SVC   99                  temp work allocation
         LTR   R15,R15             successful?
         BZ    ALOCS020            yes, branch
         LA    R3,DSSARB           rb location
         USING S99RB,R3            input rb addressability
         CH    R15,CSH4            rc=4?
         BNE   ALOCS010            no, error, branch
         CLC   S99ERROR,=X'0410'   ddname already allocated?
         BE    ALOCS030            yes, branch
         SPACE 1
ALOCS010 DS    0H                  allocation error occured
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 160E,'SYSIN dataset dynamic allocation failed'
         LA    R15,8               set return code
         B     ALOCSXIT            exit
         SPACE 1
ALOCS020 DS    0H                  successful dynamic allocation
         OI    DSFLAGS,DSFDYSYI    sysin dynamically allocated
         SPACE 1
ALOCS030 DS    0H                  normal return
         SLR   R15,R15             zero return code
         SPACE 1
ALOCSXIT DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSALCP - Dynamically allocate sysprint'
***********************************************************************
* AWSALCP - Dynamically allocate sysprint                             *
*           msg AWS17n                                                *
***********************************************************************
         SPACE 1
AWSALCP  CSECT ,                   Dynamically allocate sysprint
         AWSENTRY ,
         SPACE 1
         LA    R1,DSPARBP          temp work rb pointer
         SVC   99                  temp work allocation
         LTR   R15,R15             successful?
         BZ    ALOCP020            yes, branch
         LA    R3,DSPARB           rb location
         USING S99RB,R3            input rb addressability
         CH    R15,CSH4            rc=4?
         BNE   ALOCP010            no, error, branch
         CLC   S99ERROR,=X'0410'   ddname already allocated?
         BE    ALOCP030            yes, branch
         SPACE 1
ALOCP010 DS    0H                  allocation error occured
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 170E,'SYSPRINT dataset dynamic allocation failed'
         LA    R15,8               set return code
         B     ALOCPXIT            exit
         SPACE 1
ALOCP020 DS    0H                  successful dynamic allocation
         OI    DSFLAGS,DSFDYSYP    sysprint dynamically allocated
         SPACE 1
ALOCP030 DS    0H                  normal return
         SLR   R15,R15             zero return code
         SPACE 1
ALOCPXIT DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSDYNE - Dyanamic allocation error'
***********************************************************************
* AWSDYNE - Dynamic allocation error, on entry r1 = s99rb, r0=rc      *
*           msg AWS18n                                                *
***********************************************************************
         SPACE 1
AWSDYNE  CSECT ,                   Dynamic allocation error
         AWSENTRY ,
         SPACE 1
         LR    R3,R1               dynalloc rb location
         USING S99RB,R3            addressability
         LR    R4,R0               dynalloc return code
         SPACE 1
         MVC   DSMSG+1(7),=C'AWS180E'
         MVC   DSMSG+19(54),=C'DYNALLOC FAILURE, RC=XXXX, S99ERROR=XXXX*
               , S99INFO=XXXX'
         ST    R4,DSFWORK                  rc
         UNPK  DSHEXWK(9),DSFWORK(5)       unpack data
         TR    DSHEXWK,CSHEXTR             make printable
         MVC   DSMSG+19+21(4),DSHEXWK+4    return code
         SPACE 1
         UNPK  DSHEXWK(5),S99ERROR(3)      s99error code
         TR    DSHEXWK,CSHEXTR             make printable
         MVC   DSMSG+19+36(4),DSHEXWK
         SPACE 1
         UNPK  DSHEXWK(5),S99INFO(3)       s99info code
         TR    DSHEXWK,CSHEXTR             make printable
         MVC   DSMSG+19+50(4),DSHEXWK
         SPACE 1
         AWSMSG ,                  write the message
         SPACE 1
         CH    R4,CSH4             RC = 4?
         BNE   DYNERXIT            NO, BRANCH
         CLC   S99ERROR,=X'1708'   ERROR = 1708?
         BNE   DYNERXIT            NO, BRANCH
         CLC   S99INFO,=X'0002'    INFO = 0002?
         BNE   DYNERXIT            NO, BRANCH
         AWSMSG 181E,'Dataset could not be found'
         SPACE 1
DYNERXIT DS    0H                  function exit
         SLR   R15,R15             zero return code
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSHDR - Header labels'
***********************************************************************
* AWSHDR - header labels                                              *
*          msg AWS19n                                                 *
***********************************************************************
         SPACE 1
AWSHDR   CSECT ,                   header labels
         AWSENTRY ,
         SPACE 1
         SLR   R15,R15             zero return code for now
         CLI   DSUSESL,C'N'        suppress standard labels?
         BE    HDRLBXIT            yes, branch
         TM    DSFLAGS,DSFVOLF     vol1 written previously?
         BO    HDRLB100            yes, branch
         L     R3,DSBUFTP          Next text location
         USING AWSREC,R3           Addressability
         MVC   AWSLENC,CSH80       block length
         AWSSWAP ,                 set sizes
         MVC   AWSFLGS,CSXA000     data follows
         LA    R3,6(,R3)           position beyond aws cb
         ST    R3,DSBUFTP          set current text pointer
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    HDRLB010            no, branch
         AWSCALL AWSEPUT           write the aws cb
         L     R3,DSBUFTP          current buffer pointer
         USING AWSDBLK,R3          data block origin
         SPACE 1
HDRLB010 DS    0H                  build vol1 label
         MVC   DSVOL1SR,DSTVOL     set volser into label
         MVC   DSVOL1OW,DSOWNER    set owner
         MVC   AWSDBLK(80),DSVOL1  VOL1 LABEL
         LA    R3,80(,R3)          Next data record origin
         ST    R3,DSBUFTP          Set current text pointer
         TM    DSFLAGS,DSFRECV     Variable length output?
         BZ    HDRLB100            No, branch
         AWSCALL AWSEPUT           Write the block
         SPACE 1
HDRLB100 DS    0H                  HDR1 LABEL
         L     R3,DSBUFTP          Next text location
         USING AWSREC,R3
         MVC   AWSLENC,CSH80       block length
         AWSSWAP ,                 set sizes
         MVC   AWSFLGS,CSXA000     data follows
         MVC   DSHDR1SR,DSTVOL     volser
         LA    R3,6(,R3)           position beyond aws cb
         ST    R3,DSBUFTP          set current text pointer
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    HDBLB110            no, branch
         AWSCALL AWSEPUT           write the aws cb
         L     R3,DSBUFTP          current buffer pointer
         USING AWSDBLK,R3          data block origin
         SPACE 1
HDBLB110 DS    0H                  build hdr1
         LH    R1,DSFILECT         file sequence number
         LA    R1,1(,R1)           ...increment
         STH   R1,DSFILECT         ...and save
         CVD   R1,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202020' edit mask
         ED    DSXL16(6),DSDWORK+5
         MVC   DSHDR1SQ,DSXL16+2   set file number into HDR1
         OI    DSHDR1SQ+L'DSHDR1SQ-1,C'0'
         MVC   DSHDR1NM,DSTDSN     Set dataset name into label
         SPACE 1
         TIME  DEC                 get todays date
         ST    R1,DSFWORK          set into work area
         MVC   DSXL16(8),=X'F020202020202020' edit mask
         UNPK  DSXL16(8),DSFWORK   unpack date
         OI    DSXL16+7,C'0'       valid last digit
         MVC   DSHDR1CD,DSXL16+2   set into header
         MVI   DSHDR1CD,C'0'       assume 2000-2099 for now
         CLI   DSXL16+2,C'0'       1900-1999?
         BNE   *+8                 no, branch
         MVI   DSHDR1CD,C' '       else so indicate
         SPACE 1
         MVC   AWSDBLK(80),DSHDR1  HDR1 label
         LA    R3,80(,R3)          Next data record origin
         ST    R3,DSBUFTP          Set current text pointer
         TM    DSFLAGS,DSFRECV     Variable length output?
         BZ    HDRLB200            No, branch
         AWSCALL AWSEPUT           Write the block
         SPACE 1
HDRLB200 DS    0H                  HDR2 label
         L     R3,DSBUFTP          Next text location
         USING AWSREC,R3
         MVC   AWSLENC,CSH80       block length
         AWSSWAP ,                 set sizes
         MVC   AWSFLGS,CSXA000     data follows
         LA    R3,6(,R3)           position beyond aws cb
         ST    R3,DSBUFTP          new current text pointer
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    HDRLB210            no, branch
         AWSCALL AWSEPUT           write the aws cb
         L     R3,DSBUFTP          current buffer pointer
         USING AWSDBLK,R3          data block
         SPACE 1
HDRLB210 DS    0H                  build hdr2
         LA    R15,AWSUT1          awsut1 DCB location
         USING IHADCB,R15          addressability
         MVI   DSHDR2RF,C'U'       assume recfm=u for now
         TM    DCBRECFM,DCBRECU    recfm=u?
         BO    HDRLB220            yes, branch
         MVI   DSHDR2RF,C'F'       assume fixed for now
         TM    DCBRECFM,DCBRECF    recfm=f?
         BO    HDRLB220            yes, branch
         MVI   DSHDR2RF,C'V'       else assume variable
         EJECT
HDRLB220 DS    0H
         SLR   R0,R0               clear register
         ICM   R0,3,DCBBLKSI       blocksize
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202020'
         ED    DSXL16(6),DSDWORK+5
         MVC   DSHDR2BL,DSXL16+1
         OI    DSHDR2BL+L'DSHDR2BL-1,C'0'
         SPACE 1
         SLR   R0,R0               clear register
         ICM   R0,3,DCBLRECL       lrecl
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202020'
         ED    DSXL16(6),DSDWORK+5
         MVC   DSHDR2RL,DSXL16+1
         OI    DSHDR2RL+L'DSHDR2RL-1,C'0'
         SPACE 1
         MVI   DSHDR2CC,C'A'       assume asa for now
         TM    DCBRECFM,DCBRECCA   asa carriage control?
         BO    HDRLB230            yes, branch
         MVI   DSHDR2CC,C'M'       assume machine for now
         TM    DCBRECFM,DCBRECCM   machine carriage control?
         BO    HDRLB230            yes, branch
         MVI   DSHDR2CC,C' '       else no carriage control
         SPACE 1
HDRLB230 DS    0H                  handle spanned and blocking
         MVI   DSHDR2BA,C'S'       assume spanned or standard
         TM    DCBRECFM,DCBRECSB   spanned or standard?
         BO    HDRLB240            yes, branch
         MVI   DSHDR2BA,C'B'       assume blocked for now
         TM    DCBRECFM,DCBRECBR   blocked?
         BO    HDRLB240            yes, branch
         MVI   DSHDR2BA,C' '       else unblocked
         EJECT
HDRLB240 DS    0H
         MVC   DSHDR2JB,DSJOBNM    Set job name
         MVC   DSHDR2ST,DSSTEPNM   Set step name
         SPACE 1
         SLR   R0,R0               clear register
         ICM   R0,3,AWSUT1+(DCBBLKSI-IHADCB) blocksize
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(12),=X'F02120202020202020202020'
         ED    DSXL16(12),DSDWORK+2 edit
         OI    DSXL16+11,C'0'      make printable
         MVC   DSHDR2LB,DSXL16+2   set large blocksize
         SPACE 1
         MVC   AWSDBLK(80),DSHDR2  HDR2 label
         LA    R3,80(,R3)          Next data record origin
         ST    R3,DSBUFTP          Set current text pointer
         TM    DSFLAGS,DSFRECV     Variable length output?
         BZ    HDRLB250            No, branch
         AWSCALL AWSEPUT           Write the block
         SPACE 1
HDRLB250 DS    0H                  Write labels to log
         AWSMSG ,                  blank line
         TM    DSFLAGS,DSFVOLF     volume header already written?
         BO    HDRLB260            yes, branch
         OI    DSFLAGS,DSFVOLF     indicate vol1 has been written
         MVC   DSMSG+1(7),=C'AWS190I'
         MVC   DSMSG+19(80),DSVOL1 vol1 label
         AWSMSG ,
         SPACE 1
HDRLB260 DS    0H                  log hdr1 and hdr2
         MVC   DSMSG+1(7),=C'AWS191I'
         MVC   DSMSG+19(80),DSHDR1 hdr1 label
         AWSMSG ,
         MVC   DSMSG+1(7),=C'AWS192I'
         MVC   DSMSG+19(80),DSHDR2 hdr2 label
         AWSMSG ,
         AWSMSG ,                  blank line
         SPACE 1
         AWSCALL AWSMARK           write tape mark
         SPACE 1
HDRLBXIT DS    0H                  exit
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSTLR - Write trailer labels'
***********************************************************************
* AWSTLR - Write trailer labels                                       *
*          msg AWS20n                                                 *
***********************************************************************
         SPACE 1
AWSTLR   CSECT ,                   Write trailer labels
         AWSENTRY ,
         SPACE 1
         CLI   DSUSESL,C'N'        suppress standard labels?
         BE    TLRLBXIT            yes, branch
         L     R3,DSBUFTP          current text pointer
         USING AWSREC,R3           addressability
         MVC   AWSLENC,CSH80       BLOCK LENGTH
         AWSSWAP ,                 swap byte order, set size
         MVC   AWSFLGS,CSXA000     DATA FOLLOWS
         LA    R3,6(,R3)           next output text
         ST    R3,DSBUFTP          set current pointer
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    TLRLB010            no, branch
         AWSCALL AWSEPUT           write the aws cb
         L     R3,DSBUFTP          current text pointer
         USING AWSDBLK,R3          ... addressability
         SPACE 1
TLRLB010 DS    0H                  eof1
         MVC   DSEOF1,DSHDR1       COPY HDR1 INTO EOF1
         MVC   DSEOF1(3),=C'EOF'
         SPACE 1
         MVC   DSXL16(12),=X'F02020202020202020202020'
         ED    DSXL16(12),DSBLKCNT
         OI    DSXL16+11,C'0'
         MVC   DSEOF1BL,DSXL16+6   low  block count
         MVC   DSEOF1BH,DSXL16+2   high block count
         MVC   AWSDBLK(80),DSEOF1  EOF1 label
         LA    R3,80(,R3)          next text pointer
         ST    R3,DSBUFTP          ...and save
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    TLRLB200            no, branch
         AWSCALL AWSEPUT           write the output text
         L     R3,DSBUFTP          current buffer location
         USING AWSREC,R3           addressability
         SPACE 1
TLRLB200 DS    0H                  TLR2 LABEL
         MVC   AWSLENC,CSH80       BLOCK LENGTH
         AWSSWAP ,                 swap byte order, set size
         MVC   AWSFLGS,CSXA000     DATA FOLLOWS
         LA    R3,6(,R3)           next current text pointer
         ST    R3,DSBUFTP          ... make current
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    TLRLB210            no, branch
         AWSCALL AWSEPUT           write aws cb
         L     R3,DSBUFTP          current text pointer
         USING AWSDBLK,R3          ... addressability
         SPACE 1
TLRLB210 DS    0H                  label text
         MVC   DSEOF2,DSHDR2       copy hdr2 to eof2
         MVC   DSEOF2(3),=C'EOF'
         MVC   AWSDBLK(80),DSEOF2  EOF2 label
         LA    R3,80(,R3)          current text pointer
         ST    R3,DSBUFTP          ... make current
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    TLRLB220            no, branch
         AWSCALL AWSEPUT           write text
         SPACE 1
TLRLB220 DS    0H
         AWSMSG ,                  blank line
         MVC   DSMSG+1(7),=C'AWS200I'
         MVC   DSMSG+19(80),DSEOF1 EOF1 LABEL
         AWSMSG ,
         MVC   DSMSG+1(7),=C'AWS201I'
         MVC   DSMSG+19(80),DSEOF2 EOF2 LABEL
         AWSMSG ,
         AWSMSG ,                  blank line
         SPACE 1
         AWSCALL AWSMARK           write tape mark
         AWSMSG ,                  blank line
         AWSMSG ,
         SPACE 1
TLRLBXIT DS    0H                  exit
         SLR   R15,R15             zero return code
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSPRNT - Write to AWSPRINT log'
***********************************************************************
* AWSPRNT - Write contents of DSBUF to AWSPRINT log                   *
*           msg AWS21n                                                *
***********************************************************************
         SPACE 1
AWSPRNT  CSECT ,                   Print Function
         AWSENTRY ,                Function Entry
         SPACE 1
         AP    DSLINECT,CSP1       increment line count
         CP    DSLINECT,=P'60'     page eject needed?
         BNH   PRINT010            no, branch
         ZAP   DSLINECT,CSP1
         AP    DSPAGECT,CSP1       increment page count
         MVC   DSPAGE,=X'40202120' page mask
         ED    DSPAGE,DSPAGECT     insert page count
         PUT   AWSPRINT,DSHEADER   write header
         PUT   AWSPRINT,DSMSG1     double space
         SPACE 1
         MVC   DSMSG1+1(22),=C'AWS210I  Execution Log'
         PUT   AWSPRINT,DSMSG1
         MVI   DSMSG1+6,C'1'
         MVI   DSMSG1+10,C'-'      fill with dashes
         MVC   DSMSG1+11(L'DSMSG1-11),DSMSG1+10
         PUT   AWSPRINT,DSMSG1
         SPACE 1
PRINT010 DS    0H                  write user specified line
         PUT   AWSPRINT,DSMSG      write record
         MVC   DSMSG,CSBLNKS       clear print buffer
         MVC   DSMSG1,CSBLNKS
         SLR   R15,R15             zero return code
         SPACE 1
         AWSEXIT ,                 Return to caller
         SPACE 1
         LTORG ,
         DROP ,
         TITLE 'AWSMARK - Output a tape mark'
***********************************************************************
* AWSMARK - Output a tape mark                                        *
*           msg AWS22n                                                *
***********************************************************************
         SPACE 1
AWSMARK  CSECT ,                   Write a tape mark
         AWSENTRY ,
         SPACE 1
         L     R3,DSBUFTP          Next text location
         USING AWSREC,R3
         XC    AWSLENC,AWSLENC     zero block length
         AWSSWAP ,                 set sizes
         MVC   AWSFLGS,CSX4000     tape mark
         SPACE 1
         LA    R3,6(,R3)           Next data record origin
         ST    R3,DSBUFTP          Set current text pointer
         TM    DSFLAGS,DSFRECV+DSFFLUSH write required?
         BZ    MARK010             No, branch
         AWSCALL AWSEPUT           Write the block
         SPACE 1
MARK010  DS    0H                  return
         AWSMSG 220I,'*** tape mark ***'
         SLR   R15,R15             zero return code
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSEPUT - Write text to AWSFILE output'
***********************************************************************
* AWSEPUT - Write output text                                         *
*           msg AWS23n                                                *
***********************************************************************
         SPACE 1
AWSEPUT  CSECT ,
         AWSENTRY ,
         SPACE 1
         LA    R3,DSBUFFER         output buffer origin
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    EPUT100             no, branch
         SPACE 1
***********************************************************************
* awsfile output is variable (recfm=v) test... good for debugging.    *
***********************************************************************
         SPACE 1
EPUT010  DS    0H                  handle variable length output
         L     R4,DSBUFTP          end of text
         SR    R4,R3               r4 = length of text
         BNP   EPUT900             if zero, done, branch
         SLR   R2,R2               clear register
         ICM   R2,3,AWSFILE+(DCBLRECL-IHADCB) r2 = awsfile lrecl
         SH    R2,CSH4             allow room for rdw
         CR    R4,R2               text at or exceeds lrecl?
         BL    *+6                 no, branch
         LR    R4,R2               else length = lrecl - 4
         SPACE 1
         LA    R2,DSBUFFER         buffer origin
         AL    R2,=A(BUFSIZE*2)    offset to variable length buffer
         LA    R0,4(,R2)           target of move
         LR    R1,R4               length of data to write
         LR    R14,R3              origin of data
         LR    R15,R4              length of source
         MVCL  R0,R14              copy data to variable buffer
         LA    R1,4(,R4)           length of variable record
         STCM  R1,3,0(R2)          set length into rdw
         XC    2(2,R2),2(R2)       clear rdw flags
         PUT   AWSFILE,(R2)        write the record
         SPACE 1
         ALR   R3,R4               position at next origin
         B     EPUT010             continue until done
         EJECT
***********************************************************************
* awsfile output is undefined (recfm=u) text... preferred.            *
***********************************************************************
         SPACE 1
EPUT100  DS    0H                  handle undefined length output
         TM    AWSFILE+(DCBRECFM-IHADCB),DCBRECU recfm=u?
         BNO   EPUT200             no, must be recfm=f, branch
         SPACE 1
EPUT110  DS    0H
         L     R4,DSBUFTP          end of current text
         SR    R4,R3               r4=length of text
         BNP   EPUT900             if zero, done, branch
         SLR   R2,R2               clear register
         ICM   R2,3,AWSFILE+(DCBBLKSI-IHADCB) r2 = awsfile blksize
         CR    R4,R2               text at or exceeds blksize?
         BL    EPUT130             no, branch
         LR    R4,R2               else length = blksize
         SPACE 1
EPUT120  DS    0H                  write undefined length record
         STCM  R4,3,AWSFILE+(DCBLRECL-IHADCB)  set length into dcb
         PUT   AWSFILE,(R3)        write the text
         SPACE 1
         ALR   R3,R4               position at next origin
         B     EPUT110             continue writing all possible
         SPACE 1
EPUT130  DS    0H                  short undefined block found
         TM    DSFLAGS,DSFFLUSH    flush requested?
         BO    EPUT120             else write short block
         LA    R1,DSBUFFER         output buffer origin
         CR    R1,R3               wrote from origin?
         BNL   EPUT900             yes, branch
         LA    R0,DSBUFFER         target of move
         LR    R1,R4               length of move
         LR    R14,R3              source of move
         LR    R15,R4              length of move
         MVCL  R0,R14              copy short block to buffer origin
         LA    R3,DSBUFFER         buffer origin
         ALR   R4,R3               offset to end of short block
         ST    R4,DSBUFTP          set new next pointer
         B     EPUTXIT
         EJECT
***********************************************************************
* awsfile output is fixed length (recfm=f) (folded) text... grrr.     *
***********************************************************************
         SPACE 1
EPUT200  DS    0H                  handle fixed length output
         L     R4,DSBUFTP          end of current text
         SR    R4,R3               r4=length of text
         BNP   EPUT900             if zero, done, branch
         SLR   R2,R2               clear register
         ICM   R2,3,AWSFILE+(DCBLRECL-IHADCB) r2 = awsfile lrecl
         CR    R4,R2               text at or exceeds lrecl?
         BL    EPUT220             no, branch
         LR    R4,R2               else length = blksize
         SPACE 1
EPUT210  DS    0H                  write undefined length record
         PUT   AWSFILE,(R3)        write the text
         SPACE 1
         ALR   R3,R4               position at next origin
         B     EPUT200             continue writing all possible
         SPACE 1
EPUT220  DS    0H                  short undefined block found
         TM    DSFLAGS,DSFFLUSH    flush requested?
         BO    EPUT230             else write short block
         LA    R1,DSBUFFER         output buffer origin
         CR    R1,R3               wrote from origin?
         BNL   EPUT900             yes, branch
         LA    R0,DSBUFFER         target of move
         LR    R1,R4               length of move
         LR    R14,R3              source of move
         LR    R15,R4              length of move
         MVCL  R0,R14              copy short block to buffer origin
         LA    R3,DSBUFFER         buffer origin
         ALR   R4,R3               offset to end of short block
         ST    R4,DSBUFTP          set new next pointer
         B     EPUTXIT
         SPACE 1
EPUT230  DS    0H                  flush short text
         LA    R2,DSBUFFER         target of move
         AL    R2,=A(BUFSIZE*2)    offset to variable length buffer
         LR    R0,R2               target of move
         SLR   R1,R1               clear high order nibbles
         ICM   R1,3,AWSFILE+(DCBLRECL-IHADCB) length of target
         LR    R14,R3              source of move
         LR    R15,R4              length of source
         ICM   R15,8,=X'20'        padding required by VTT2TAPE
         MVCL  R0,R14              copy and pad with nulls short text
         PUT   AWSFILE,(R2)        write short text
         LR    R0,R2               buffer location
         SLR   R1,R1               clear high order nibbles
         ICM   R1,3,AWSFILE+(DCBLRECL-IHADCB) length of target
         SLR   R15,R15             zero length source
         ICM   R15,8,=X'20'        padding required b y vtt2tape
         MVCL  R0,R14              propogate through entire record
         PUT   AWSFILE,(R2)
         SPACE 1
EPUT900  DS    0H                  all data has been written
         LA    R0,DSBUFFER         buffer origin
         ST    R0,DSBUFTP          set current text pointer
         SPACE 1
EPUTXIT  DS    0H                  return
         NI    DSFLAGS,255-DSFFLUSH reset forced flush flag
         SLR   R15,R15             zero return code
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSICOPY - copy from aws input'
***********************************************************************
* AWSICOPY - copy from aws input dataset (awsfile)                    *
*            msg AWS24n                                               *
***********************************************************************
         SPACE 1
AWSICOPY CSECT ,                   copy from aws input dataset
         AWSENTRY ,
         SPACE 1
         ZAP   DSIBLKCT,=P'0'      ZERO BLOCK COUNT
         ZAP   DSIRECCT,=P'0'      ... AND RECORD COUNT
         SPACE 1
         LA    R5,AWSUT3           input dcb location
         USING IHADCB,R5           addressability
         MVC   DCBDDNAM,DSOUTDD    set ddname
         SLR   R0,R0               clear register
         STCM  R0,3,DCBLRECL       clear previous lrecl
         STCM  R0,3,DCBBLKSI       clear previous blksize
         SPACE 1
         CLI   DSRECFM+1,C'S'      spanned records?
         BE    ICOPY010            yes, branch
         CLC   =C'IEBCOPY',DSLODPGM iebcopy load?
         BE    ICOPY010            yes, branch
         RDJFCB AWSUT3,MF=(E,DSRDJFCB) read the jfcb
         SPACE 1
         ICM   R0,3,JFCLRECL       lrecl specified in jcl?
         BZ    *+8                 no, branch
         STCM  R0,3,DCBLRECL       else set into dcb
         SPACE 1
         ICM   R0,3,JFCBLKSI       blksize specified in jcl?
         BZ    *+8                 no, branch
         STCM  R0,3,DCBBLKSI       else set into dcb
         SPACE 1
ICOPY010 DS    0H                  default from label if needed
         ICM   R0,3,DCBLRECL       lrecl specified?
         BNZ   *+10                no, branch
         MVC   DCBLRECL,DSLRECL    else default from tape label
         SPACE 1
         ICM   R0,3,DCBBLKSI       blocksize specified?
         BNZ   *+10                no, branch
         MVC   DCBBLKSI,DSBLKSIZ   else default from tape label
         SPACE 1
         OI    DCBRECFM,DCBRECU    assume undefined for now
         CLI   DSRECFM,C' '        recfm specified?
         BNH   ICOPY020            no, branch
         CLI   DSRECFM,C'U'        label undefined?
         BE    ICOPY020            yes, branch
         NI    DCBRECFM,255-DCBRECU reset bits
         OI    DCBRECFM,DCBRECF    assume fixed for now
         CLI   DSRECFM,C'F'        label fixed?
         BE    ICOPY020            yes, branch
         NI    DCBRECFM,255-DCBRECU reset bits
         OI    DCBRECFM,DCBRECV    else must be variable
         SPACE 1
ICOPY020 DS    0H                  set blocked attribute
         CLI   DSRECFM+1,C' '      blocked specified?
         BNH   ICOPY030            no, branch
         CLI   DSRECFM+1,C'B'      blocked records?
         BNE   *+8                 no, branch
         OI    DCBRECFM,DCBRECBR   else so indicate
         SPACE 1
         CLI   DSRECFM+1,C'S'      spanned records?
         BNE   *+8                 no, branch
         OI    DCBRECFM,DCBRECSB   else so indicate
         SPACE 1
ICOPY030 DS    0H                  allocate files if needed
         CLI   DSLODPGM,C' '       load program specified?
         BNH   ICOPY070            no, branch
         MVC   DCBDDNAM,=CL8'AWSTEMP' temporary file
         SPACE 1
         AWSCALL AWSALCI           allocate input dataset
         BNZ   ICOPYXIT
         SPACE 1
         AWSCALL AWSALCT           allocate work dataset
         BNZ   ICOPYXIT
         SPACE 1
         AWSCALL AWSALCS           allocate sysin dataset
         BNZ   ICOPYXIT
         SPACE 1
         AWSCALL AWSALCP           allocate sysprint dataset
         BNZ   ICOPYXIT
         SPACE 1
         OPEN  (SYSIN,(OUTPUT)),MF=(E,DSOPENL) open sysin for output
         SPACE 1
         TM    SYSIN+(DCBOFLGS-IHADCB),DCBOFOPN open ok?
         BO    ICOPY040            yes, branch
         AWSMSG 241E,'SYSIN open for output failed'
         LA    R15,8               set return code
         B     ICOPYXIT
         SPACE 1
ICOPY040 DS    0H                  determine type of unload
         CLC   =C'IEBCOPY',DSLODPGM iebcopy unload?
         BE    ICOPY050            yes, branch
         AWSMSG 242E,'Unrecognized load program specified'
         LA    R15,8               unrecognized unload pgm
         B     ICOPYXIT            exit
         SPACE 1
ICOPY050 DS    0H                  iebcopy load request
         MVC   DSCARD,CSBLNKS      clear
         MVC   DSCARD(15),=C' C I=AWSTEMP,O='
         MVC   DSCARD+15(8),DSOUTDD set OUTDD statement
         CLI   DSOUTDD,C' '        outdd= keyword present?
         BH    ICOPY060            yes, branch
         MVC   DSCARD+15(8),=CL8'AWSUT1' else use default
         SPACE 1
ICOPY060 DS    0H                  write control statement
         PUT   SYSIN,DSCARD
         SPACE 1
         CLOSE SYSIN,MF=(E,DSCLOSEL) close file
         FREEPOOL SYSIN            release buffer pool
         SPACE 1
ICOPY070 DS    0H                  open files
         RDJFCB AWSUT3,MF=(E,DSRDJFCB) read the jfcb
         SPACE 1
         AWSMSG ,                  blank line
         MVC   DSMSG+1(7),=C'AWS240I'
         MVC   DSMSG+19(31),=C'Writing to dataset            :'
         MVC   DSMSG+51(44),JFCBDSNM
         AWSMSG ,
         SPACE 1
         TM    DCBRECFM,DCBRECSB   spanned blocks?                      panned b
         BZ    ICOPY090            no, branch
         CLC   =C'IEBCOPY',DSLODPGM iebcopy load?
         BE    ICOPY080            yes, bypass warning, branch
         AWSMSG ,
         AWSMSG 24BW,'*** Warning, spanned formats not supported, force*
               d to recfm=u'
         AWSMSG 24CI,'*** Note that IEBCOPY can process unloaded PDS as*
                recfm=u'
         AWSMSG ,
ICOPY080 DS    0H                  spanned, force to RECFM=U
         OI    DCBRECFM,DCBRECU    indciate undefined lrecl
         NI    DCBRECFM,255-DCBRECSB reset spanned indicator
         SPACE 1
ICOPY090 DS    0H
         OPEN  (AWSUT3,(OUTPUT)),MF=(E,DSOPENL)
         TM    DCBOFLGS,DCBOFOPN   open successful?
         BO    ICOPY100            yes, branch
         AWSMSG 243E,'Open output file for import failed'
         LA    R15,8               return code
         B     ICOPYXIT            exit
         SPACE 1
ICOPY100 DS    0H                  produce messages
         SLR   R0,R0               clear register
         ICM   R0,3,DCBLRECL       load blocksize
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202120'
         ED    DSXL16(6),DSDWORK+5 edit
         MVI   DSXL16+5,C'0'       make printable
         MVC   DSMSG+1(7),=C'AWS244I'
         MVC   DSMSG+19(31),=C'Output dataset lrecl          :'
         MVC   DSMSG+51(5),DSXL16+1 set blksize into message
         AWSMSG ,                  write message
         SPACE 1
         SLR   R0,R0               clear register
         ICM   R0,3,DCBBLKSI       load blocksize
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202120'
         ED    DSXL16(6),DSDWORK+5 edit
         MVI   DSXL16+5,C'0'       make printable
         MVC   DSMSG+1(7),=C'AWS245I'
         MVC   DSMSG+19(31),=C'Output dataset blksize        :'
         MVC   DSMSG+51(5),DSXL16+1 set blksize into message
         AWSMSG ,                  write message
         SPACE 1
         MVC   DSMSG+1(7),=C'AWS246I'
         MVC   DSMSG+19(31),=C'Output dataset recfm          :'
         NI    DSFLAGS,255-DSFRECV reset variable length flag
         MVI   DSMSG+51,C'U'       assume recfm=u for now
         TM    DCBRECFM,DCBRECU    recfm=u?
         BO    ICOPY110            yes, branch
         MVI   DSMSG+51,C'F'       assume fixed for now
         TM    DCBRECFM,DCBRECF    recfm=f?
         BO    ICOPY110            yes, branch
         MVI   DSMSG+51,C'V'       else assume variable
         OI    DSFLAGS,DSFRECV     set variable length flag
ICOPY110 DS    0H
         MVI   DSMSG+53,C'A'       assume asa for now
         TM    DCBRECFM,DCBRECCA   asa carriage control?
         BO    ICOPY120            yes, branch
         MVI   DSMSG+53,C'M'       assume machine for now
         TM    DCBRECFM,DCBRECCM   machine carriage control?
         BO    ICOPY120            yes, branch
         MVI   DSMSG+53,C' '       else no carriage control
         SPACE 1
ICOPY120 DS    0H                  handle spanned and blocking
         MVI   DSMSG+52,C'S'       assume spanned or standard
         TM    DCBRECFM,DCBRECSB   spanned or standard?
         BO    ICOPY130            yes, branch
         MVI   DSMSG+52,C'B'       assume blocked for now
         TM    DCBRECFM,DCBRECBR   blocked?
         BO    ICOPY130            yes, branch
         MVI   DSMSG+52,C' '       else unblocked
         SPACE 1
ICOPY130 DS    0H                  produce recfm message
         CLI   DSMSG+52,C' '       not blocked or spanned?
         BNE   ICOPY140            no, branch
         MVC   DSMSG+52(1),DSMSG+53
         MVI   DSMSG+53,C' '
ICOPY140 DS    0H                  write recfm
         AWSMSG ,                  write message
         SPACE 1
ICOPY150 DS    0H                  copy aws input text to output file
         AWSCALL AWSIGET           retrieve a block
         BNZ   ICOPYEOF            if eof, branch
         L     R3,DSBUFTP          block location
         CLC   CSX4000,4(R3)       tape mark read?
         BE    ICOPYE10            yes, simulate eof, branch
         AP    DSIBLKCT,=P'1'      increment block count
         SLR   R4,R4               clear register
         ICM   R4,3,0(R3)          size of aws block
         lr    r14,r4              future reference
         ALR   R4,R3               end of aws block
         LA    R3,6(,R3)           position beyond aws header
         TM    DSFLAGS,DSFRECV     variable length records?
         BZ    ICOPY160            no, branch
         SLR   R4,R4               clear register
         ICM   R4,3,0(R3)          block length from rdw
         ALR   R4,R3               end of block
         LA    R3,4(,R3)           position beyond block rdw
         SPACE 1
ICOPY160 DS    0H                  copy logical records to output
         CLR   R3,R4               reached end of block?
         BNL   ICOPY150            yes, do next one, branch
         TM    DCBRECFM,DCBRECU    undefined output?
         BNO   *+8                 no, branch
         STCM  R14,3,DCBLRECL      else set lrecl
         PUT   AWSUT3,(R3)         else write logical record
         AP    DSIRECCT,=P'1'      increment record count
         TM    DSFLAGS,DSFRECV     variable length records?
         BO    ICOPY170            yes, branch
         AH    R3,DCBLRECL         position at next logical block
         B     ICOPY160            continue
         SPACE 1
ICOPY170 DS    0H                  position at next variable length rec
         SLR   R0,R0               clear register
         ICM   R0,3,0(R3)          record length
         ALR   R3,R0               origin of next record
         B     ICOPY160            continue
         SPACE 1
ICOPYEOF DS    0H                  eof reached?
         CH    R15,=H'-4'          eof?
         BNE   ICOPYXIT            no, error, branch
         SPACE 1
ICOPYE10 DS    0H                  logical eof detected
         CLOSE AWSUT3,MF=(E,DSCLOSEL) close file
         FREEPOOL AWSUT3           release buffers
         SPACE 1
         AWSMSG ,                  blank line
         MVC   DSXL16,=X'40202020202020202020202020202120'
         ED    DSXL16,DSIBLKCT     edit record count
         OI    DSXL16+15,C'0'      make last digit printable
         MVC   DSMSG+1(7),=C'AWS247I' message id
         MVC   DSMSG+19(31),=C'Total physical aws blocks read:'
         MVC   DSMSG+51(16),DSXL16 set count into message
         AWSMSG ,
         SPACE 1
         MVC   DSXL16,=X'40202020202020202020202020202120'
         ED    DSXL16,DSIRECCT     edit record count
         OI    DSXL16+15,C'0'      make last digit printable
         MVC   DSMSG+1(7),=C'AWS248I' message id
         MVC   DSMSG+19(31),=C'Total logical records written :'
         MVC   DSMSG+51(16),DSXL16 set count into message
         AWSMSG ,
         SPACE 1
*********************************************************************** 00010000
* iebcopy                                                             * 00020000
*********************************************************************** 00030000
         CLI   DSLODPGM,C' '       load program specified?
         BNH   ICOPYX00            no, branch
         SPACE 1
         AWSMSG ,                  blank line
         MVC   DCBDDNAM,DSOUTDD    output ddname
         RDJFCB AWSUT3,MF=(E,DSRDJFCB) read the jfcb
         MVC   DSMSG+1(7),=C'AWS240I'
         MVC   DSMSG+19(31),=C'PDS(E) loading to dataset     :'
         MVC   DSMSG+51(44),JFCBDSNM
         AWSMSG ,
         SPACE 1
         SLR   R1,R1               clear parameter register
         LINK  EP=IEBCOPY          invoke iebcopy
         LTR   R15,R15             success?
         BZ    ICOPYE90            yes, branch
         AWSMSG 24AE,'IEBCOPY unload failed'
         LA    R15,8               set return code
         B     ICOPYXIT            exit
         SPACE 1
ICOPYE90 DS    0H                  unallocate if needed
         AWSMSG 249I,'PDS(E) load successful'
         AWSCALL AWSUNALC          dynamic unallocation
         SPACE 1
ICOPYX00 DS    0H
         AWSMSG ,                  blank line
         SLR   R15,R15             zero return code
         SPACE 1
ICOPYXIT DS    0H                  return
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'AWSECOPY - copy to aws output'
***********************************************************************
* AWSECOPY - copy to aws output dataset (awsfile)                     *
*            msg AWS25n                                               *
***********************************************************************
         SPACE 1
AWSECOPY CSECT ,                   copy to aws output dataset
         AWSENTRY ,
         SPACE 1
         ZAP   DSBLKCNT,=P'0'      clear block counter
         SPACE 1
         MVC   AWSUT1+(DCBDDNAM-IHADCB)(L'DCBDDNAM),=CL8'AWSTEMP'
         CLI   DSUNLPGM,C' '       unload requested?
         BH    ECOPY010            yes, use awstemp, branch
         MVC   AWSUT1+(DCBDDNAM-IHADCB)(L'DCBDDNAM),DSINDD
         CLI   DSINDD,C' '         dataset already allocated?
         BH    ECOPY010            yes, use indd argument, branch
         MVC   AWSUT1+(DCBDDNAM-IHADCB)(L'DCBDDNAM),=CL8'AWSUT1'
         AWSCALL AWSALCI           else allocate input dataset
         BNZ   ECOPYXIT            if error, branch
         SPACE 1
ECOPY010 DS    0H                  dataset is allocated, now open it
         LA    R0,ECOPYEOF         eof location
         STCM  R0,7,AWSUT1+(DCBEODA-IHADCB)
         SLR   R0,R0               clear register
         STH   R0,AWSUT1+(DCBBLKSI-IHADCB) clear blocksize
         STH   R0,AWSUT1+(DCBLRECL-IHADCB) clear lrecl
         OPEN  (AWSUT1,(INPUT)),MF=(E,DSOPENL)    open input dataset
         TM    AWSUT1+(DCBOFLGS-IHADCB),DCBOFOPN  opened ok?
         BO    ECOPY020            yes, branch
         AWSMSG 250E,'Input dataset could not be opened'
         LA    R15,8               return code
         B     ECOPYXIT            return
ECOPY020 DS    0H                  write header labels
         AWSCALL AWSHDR            write header labels
         BNZ   ECOPYXIT
         SPACE 1
         CLOSE AWSUT1,MF=(E,DSCLOSEL)             close the file
         OI    AWSUT1+(DCBRECFM-IHADCB),DCBRECU   force to recfm=u
         OPEN  (AWSUT1,(INPUT)),MF=(E,DSOPENL)    reopen
         TM    AWSUT1+(DCBOFLGS-IHADCB),DCBOFOPN  opened ok?
         BO    ECOPY030            yes, branch
         AWSMSG 251E,'Input dataset could not be re-opened'
         LA    R15,8               return code
         B     ECOPYXIT            return
         SPACE 1
ECOPY030 DS    0H                  copy input dataset
         L     R3,DSBUFTP          current text pointer
         USING AWSREC,R3           addressability
         SPACE 1
         GET   AWSUT1              retrieve a block
         LR    R4,R1               save location for future reference
         AP    DSBLKCNT,CSP1       increment block count
         SLR   R2,R2               clear register
         ICM   R2,3,AWSUT1+(DCBLRECL-IHADCB) get block length
         STH   R2,AWSLENC          data block length
         AWSSWAP ,                 set size and swap bytes
         MVC   AWSFLGS,CSXA000     DATA FOLLOWS
         LA    R3,6(,R3)           point beyond aws cb
         ST    R3,DSBUFTP          ... make it so
         SPACE 1
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    ECOPY040            no, branch
         AWSCALL AWSEPUT           else write variable output
         L     R3,DSBUFTP          new current text pointer
         USING AWSDBLK,R3          data block addressability
         SPACE 1
ECOPY040 DS    0H                  copy block into output buffer
         LR    R0,R3               target of move
         LR    R1,R2               target length
         LR    R14,R4              source of move
         LR    R15,R2              source length
         MVCL  R0,R14              copy block into text buffer
         SPACE 1
         ALR   R3,R2               new current text pointer
         ST    R3,DSBUFTP          ... make it so
         SPACE 1
         LA    R0,DSBUFFER         buffer origin
         AL    R0,=A(BUFSIZE)      r0 = origin of 2nd buffer
         CR    R3,R0               text has extended into 2nd buffer?
         BL    ECOPY050            no, branch
         AWSCALL AWSEPUT           else write block immediately
         B     ECOPY030            process next block
         SPACE 1
ECOPY050 DS    0H                  handle variable case if appropriate
         TM    DSFLAGS,DSFRECV     variable length output?
         BZ    ECOPY030            no, process next block, branch
         AWSCALL AWSEPUT           write the block now
         B     ECOPY030            process next block
         EJECT
ECOPYEOF DS    0H                  awsut1 reached eof
         MVC   DSMSG+1(7),=C'AWS252I' blocks copied message
         MVC   DSMSG+19(35),=c'Blocks exported into AWS tape file:'
         MVC   DSMSG+54(12),=X'402020202020202020202120'
         ED    DSMSG+54(12),DSBLKCNT set count into message
         OI    DSMSG+65,C'0'
         AWSMSG ,                  write the message
         SPACE 1
         CLOSE AWSUT1,MF=(E,DSCLOSEL) close input file
         FREEPOOL AWSUT1           release buffers
         SPACE 1
         NI    AWSUT1+(DCBRECFM-IHADCB),255-DCBRECU  clear recfm
         SLR   R0,R0               clear register
         STH   R0,AWSUT1+(DCBBLKSI-IHADCB) clear blocksize
         STH   R0,AWSUT1+(DCBLRECL-IHADCB) clear lrecl
         SPACE 1
         SLR   R15,R15             zero return code
         SPACE 1
ECOPYXIT DS    0H                  exit
         AWSEXIT ,                 return to caller
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSUNALC - Unallocate files'
***********************************************************************
* AWSUNALC - Unallocate files                                         *
*            msg AWS26n                                               *
***********************************************************************
         SPACE 1
AWSUNALC CSECT ,                   Unallocate files
         AWSENTRY ,
         SPACE 1
         TM    DSFLAGS,DSFDYUT1    awsut1 dynamically allocated?
         BZ    UNALC010            no, branch
         MVC   DSUDDNM1,=CL8'AWSUT1'
         LA    R1,DSURBP
         SVC   99                  release awsut1
         LTR   R15,R15             ok?
         BZ    UNALC010            yes, branch
         LA    R3,DSURB            rb location
         USING S99RB,R3            input rb addressability
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 260E,'Unallocation of ddname AWSUT1 failed'
         LA    R15,8               set return code
         B     UNALCXIT            exit
         SPACE 1
UNALC010 DS    0H                  unallocate awstemp
         TM    DSFLAGS,DSFDYTMP    awstemp dynamically allocated?
         BZ    UNALC020            no, branch
         MVC   DSUDDNM1,=CL8'AWSTEMP'
         LA    R1,DSURBP
         SVC   99                  release awstemp
         LTR   R15,R15             ok?
         BZ    UNALC020            yes, branch
         LA    R3,DSURB            rb location
         USING S99RB,R3            input rb addressability
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 261E,'Unallocation of ddname AWSTEMP failed'
         LA    R15,8               set return code
         B     UNALCXIT            exit
         SPACE 1
UNALC020 DS    0H                  unallocate sysin
         TM    DSFLAGS,DSFDYSYI    sysinp dynamically allocated?
         BZ    UNALC030            no, branch
         MVC   DSUDDNM1,=CL8'SYSIN'
         LA    R1,DSURBP
         SVC   99                  release sysin
         LTR   R15,R15             ok?
         BZ    UNALC030            yes, branch
         LA    R3,DSURB            rb location
         USING S99RB,R3            input rb addressability
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 262E,'Unallocation of ddname AWSTEMP failed'
         LA    R15,8               set return code
         B     UNALCXIT            exit
         SPACE 1
UNALC030 DS    0H                  unallocate sysprint
         TM    DSFLAGS,DSFDYSYP    sysinp dynamically allocated?
         BZ    UNALC040            no, branch
         MVC   DSUDDNM1,=CL8'SYSPRINT'
         LA    R1,DSURBP
         SVC   99                  release sysin
         LTR   R15,R15             ok?
         BZ    UNALC040            yes, branch
         LA    R3,DSURB            rb location
         USING S99RB,R3            input rb addressability
         LR    R1,R3               set rb location
         LR    R0,R15              return code
         AWSCALL AWSDYNE           format dynalloc error messages
         AWSMSG 263E,'UNALLOCATION of ddname SYSPRINT failed'
         LA    R15,8               set return code
         B     UNALCXIT            exit
         SPACE 1
UNALC040 DS    0H                  successful
         NI    DSFLAGS,255-DSFDYUT1-DSFDYTMP-DSFDYSYI-DSFDYSYP
         SLR   R15,R15             zero return code
         SPACE 1
UNALCXIT DS    0H                  exit
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSSKPTF - skip to file'
***********************************************************************
* AWSSKPTF - skip to file                                             *
*            msg AWS27n                                               *
***********************************************************************
         SPACE 1
AWSSKPTF CSECT ,                   skip to file
         AWSENTRY ,
         SPACE 1
         LH    R3,DSINFLNO         file number requested
         CLI   DSUSESL,C'N'        standard labels in use?
         BE    SKPTF010            no, branch
         MH    R3,=H'3'            multiply by 3 (hdr + data + tlr)
         SH    R3,=H'2'            header absolute file number
         SPACE 1
SKPTF010 DS    0H                  position to absolute file number
         SLR   R2,R2               tape marks encountered
         BCTR  R3,0                tape marks needed relative to zero
         SPACE 1
SKPTF020 DS    0H                  check position
         CLR   R2,R3               desired tapemark?
         BE    SKPTF900            yes, exit
         SPACE 1
SKPTF030 DS    0H                  find next tape mark
         AWSCALL AWSIGET           get a block
         BNZ   SKPTF040            if error, branch
         L     R4,DSBUFTP          block location
         USING AWSREC,R4           addressability
         CLC   AWSFLGS,CSX4000     tape mark?
         BNE   SKPTF030            no, continue
         LA    R2,1(,R2)           increment tape marks found
         B     SKPTF020            continue
         SPACE 1
SKPTF040 DS    0H                  error handler
         CH    R15,=H'-4'          eof reached?
         BNE   SKPTFXIT            no, error, branch
         AWSMSG 270E,'End of tape reached while positioning'
         LA    R15,8
         B     SKPTFXIT
         SPACE 1
SKPTF900 DS    0H                  good return
         SLR   R15,R15             zero return code
         SPACE 1
SKPTFXIT DS    0H                  exit
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSIMLBL - get label values'
***********************************************************************
* AWSIMLBL - get label values                                         *
*            msg AWS28n, AWS29n, AWS30n                               *
***********************************************************************
         SPACE 1
AWSIMLBL CSECT ,                   process input labels
         AWSENTRY ,
         SPACE 1
         CLI   DSUSESL,C'N'        standard labels expected?
         BE    ILBL900             no, branch
         SPACE 1
         TM    DSFLAGS,DSFVOLF     vol1 encountered previously?
         BO    ILBL100             yes, branch
         OI    DSFLAGS,DSFVOLF     else indicate vol1 checked
         AWSCALL AWSIGET           get a block
         BNZ   ILBLXIT
         L     R3,DSBUFTP          current text pointer
         USING AWSREC,R3           addressability
         SPACE 1
ILBL010  DS    0H                  check vol1 if present
         CLC   AWSFLGS,CSXA000     correct flags?
         BE    ILBL030             yes, branch
         CLC   AWSFLGS,CSX4000     end of tape?
         BNE   ILBL020             no, branch
         AWSMSG 280E,'End of tape reached while positioning'
         LA    R15,8
         B     ILBLXIT
ILBL020  DS    0H
         AWSMSG 281E,'AWSFLGS unexpected value encountered'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL030  DS    0H                  check vol1 length
         CLC   =C'HDR1',6(R3)      hdr1 found?
         BE    ILBL110             yes, branch
         SLR   R0,R0               clear register
         ICM   R0,3,AWSLENC        current block length
         CH    R0,=H'80'           80 bytes?
         BE    ILBL040             yes, branch
         AWSMSG 282E,'VOL1 label record length is other than 80 bytes'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL040  DS    0H                  validate vol1
         LA    R3,6(,R3)           position at data block
         CLC   =C'VOL1',0(R3)      vol1 label?
         BE    ILBL050             yes, branch
         AWSMSG 283E,'VOL1 label not found'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL050  DS    0H                  verify volser
         SPACE 1
         CLC   DSTVOL,DSVOL1SR-DSVOL1(R3) volser correct?
         BE    ILBL100             yes, branch
         AWSMSG 285E,'Incorrect volume serial number encountered'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL100  DS    0H                  validate hdr1 values
         AWSCALL AWSIGET           get a block
         BNZ   ILBLXIT
         L     R3,DSBUFTP          current text pointer
         CLC   AWSFLGS,CSXA000     correct flags?
         BE    ILBL110             yes, branch
         AWSMSG 286E,'HDR1 AWSFLGS invalid'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL110  DS    0H                  check lengths
         SLR   R0,R0               clear register
         ICM   R0,3,AWSLENC        length of current block
         CH    R0,=H'80'           80 byte block?
         BE    ILBL120             yes, branch
         AWSMSG 287E,'HDR1 length is other than 80 bytes'
         LA    R15,8
         B     ILBLXIT             exit
         SPACE 1
ILBL120  DS    0H                  perform hdr1 checks
         LA    R3,6(,R3)           position beyond aws control block
         CLC   =C'HDR1',0(R3)      HDR1 label?
         BE    ILBL130             yes, branch
         SH    R3,=H'6'            backup six bytes
         CLC   =C'VOL1',6(R3)      VOL1 label?
         BE    ILBL030             yes, branch
         AWSMSG 288E,'HDR1 label not found'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL130  DS    0H                  process HDR1 values
         MVC   DSMSG+1(7),=C'AWS284I'
         MVC   DSMSG+19(31),=C'AWS HDR1 volume serial number :'
         MVC   DSMSG+51(6),DSHDR1SR-DSHDR1(R3)
         AWSMSG ,
         SPACE 1
         PACK  DSDWORK,DSHDR1SQ-DSHDR1(4,R3)
         CVB   R0,DSDWORK          convert seq to binary
         CH    R0,DSINFLNO         agrees with file number requested?
         BE    ILBL140             yes, branch
         AWSMSG 289E,'HDR1 file number disagrees with that expected'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL140  DS    0H                  validate dataset name
         MVC   DSTDSN,CSBLNKS      clear
         MVC   DSOUTDSN,DSINDSN
         AWSCALL AWSTPDSN          set 17 byte dsn expected
         MVC   DSMSG+1(7),=C'AWS290I'
         MVC   DSMSG+19(31),=C'Requested 44 byte dataset name:'
         MVC   DSMSG+51(44),DSINDSN
         AWSMSG ,
         SPACE 1
         MVC   DSMSG+1(7),=C'AWS291I'
         MVC   DSMSG+19(31),=C'AWS HDR1  17 byte dataset name:'
         MVC   DSMSG+51(17),DSHDR1NM-DSHDR1(R3)
         AWSMSG ,
         SPACE 1
         CLC   DSTDSN,DSHDR1NM-DSHDR1(R3)   tape dsn correct?
         BE    ILBL150             yes, branch
         CLC   DSTDSN,CSBLNKS      input dsn omitted?
         BE    ILBL150             yes, branch
         AWSMSG 292E,'HDR1 dataset name disagrees with that specified'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL150  DS    0H                  capture number blocks expected
         MVC   DSXL16(4),=4C'0'    fill with zeros
         MVC   DSXL16+4(6),DSHDR1BL-DSHDR1(R3) low block count
         CLI   DSHDR1BH-DSHDR1(R3),C'0' high block count specified?
         BL    *+10                no, branch
         MVC   DSXL16(4),DSHDR1BH-DSHDR1(R3)
         PACK  DSDWORK,DSXL16(10)  pack block count
         CVB   R0,DSDWORK          total block count
         ST    R0,DSBLKCTI         save for future reference
         SPACE 1
ILBL200  DS    0H                  process hdr2
         AWSCALL AWSIGET           get a block
         BNZ   ILBLXIT
         L     R3,DSBUFTP          block location
         CLC   AWSFLGS,CSXA000     correct flags?
         BE    ILBL210             yes, branch
         AWSMSG 293E,'AWSFLGS is other than expected value'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL210  DS    0H                  check hdr2 length
         SLR   R0,R0               clear register
         ICM   R0,3,AWSLENC        length of current block
         CH    R0,=H'80'           80 bytes?
         BE    ILBL220             yes, branch
         AWSMSG 294E,'HDR2 record length other than 80 bytes'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL220  DS    0H                  validate hdr2 label
         LA    R3,6(,R3)           position at data record
         CLC   =C'HDR2',0(R3)      hdr2 label?
         BE    ILBL230             yes, branch
         AWSMSG 295E,'HDR2 label not found'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL230  DS    0H                  gather hdr2 values
         MVC   DSRECFM(1),DSHDR2RF-DSHDR2(R3)    recfm
         MVC   DSRECFM+1(1),DSHDR2BA-DSHDR2(R3)  block attribute
         MVC   DSASA,DSHDR2CC-DSHDR2(R3)         carriage control
         PACK  DSDWORK,DSHDR2BL-DSHDR2(L'DSHDR2BL,R3)  block size
         CVB   R0,DSDWORK                        ... convert to binary
         STCM  R0,3,DSBLKSIZ                     ... and save
         PACK  DSDWORK,DSHDR2RL-DSHDR2(L'DSHDR2RL,R3)  lrecl
         CVB   R0,DSDWORK                        ... convert to binary
         STCM  R0,3,DSLRECL                      ... and save
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202120'
         ED    DSXL16(6),DSDWORK+5 edit
         MVI   DSXL16+5,C'0'       make printable
         MVC   DSMSG+1(7),=C'AWS296I'
         MVC   DSMSG+19(31),=C'AWS HDR2 tape dataset lrecl   :'
         MVC   DSMSG+51(5),DSXL16+1 set lrecl into message
         AWSMSG ,                  write message
         SPACE 1
         TRT   DSHDR2LB-DSHDR2(L'DSHDR2LB,R3),CSNUMTRT   lb numeric?
         BNZ   ILBL240                           no, branch
         PACK  DSDWORK,DSHDR2LB-DSHDR2(L'DSHDR2LB,R3)  large blocksize
         CVB   R0,DSDWORK                        convert to binary
         LTR   R0,R0                             specified?
         BZ    ILBL240                           no, branch
         STCM  R0,3,DSBLKSIZ                     else save as blocksize
         SPACE 1
ILBL240  DS    0H                  write messages
         SLR   R0,R0               clear register
         ICM   R0,3,DSBLKSIZ       load blocksize
         CVD   R0,DSDWORK          convert to decimal
         MVC   DSXL16(6),=X'F02020202120'
         ED    DSXL16(6),DSDWORK+5 edit
         MVI   DSXL16+5,C'0'       make printable
         MVC   DSMSG+1(7),=C'AWS297I'
         MVC   DSMSG+19(31),=C'AWS HDR2 tape dataset blksize :'
         MVC   DSMSG+51(5),DSXL16+1 set blksize into message
         AWSMSG ,                  write message
         SPACE 1
         MVC   DSMSG+1(7),=C'AWS298I'
         MVC   DSMSG+19(31),=C'AWS HDR2 tape dataset recfm   :'
         MVC   DSMSG+51(2),DSRECFM
         AWSMSG ,                  write message
         SPACE 1
ILBL250  DS    0H                  prepare for next block
         AWSCALL AWSIGET           get next block (should be tape mark)
         BNZ   ILBLXIT
         L     R3,DSBUFTP          text location
         CLC   AWSFLGS,CSX4000     tape mark?
         BE    ILBL900             yes, branch
         AWSMSG 299E,'Expected tape mark after HDR2 label'
         LA    R15,8
         B     ILBLXIT
         SPACE 1
ILBL900  DS    0H                  good return
         SLR   R15,R15             zero return code
         SPACE 1
ILBLXIT  DS    0H                  exit
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSIMTLR - import process trailer label'
***********************************************************************
* AWSIMTLR - import process trailer label                             *
*            msg AWS31n                                               *
***********************************************************************
         space 1
AWSIMTLR CSECT ,                   import process trailer label
         AWSENTRY ,
         SPACE 1
         CLI   DSUSESL,C'N'        standard labels expected?
         BE    ITLR900             no, branch
         AWSCALL AWSIGET           get a block
         BNZ   ITLRXIT
         L     R3,DSBUFTP          current text pointer
         USING AWSREC,R3           addressability
         SPACE 1
         CLC   AWSFLGS,CSXA000     correct flags?
         BE    ITLR020             yes, branch
         CLC   AWSFLGS,CSX4000     end of tape?
         BNE   ITLR010             no, branch
         AWSMSG 310E,'End of tape reached while positioning'
         LA    R15,8
         B     ITLRXIT
ITLR010  DS    0H
         AWSMSG 311E,'AWSFLGS unexpected value encountered'
         LA    R15,8
         B     ITLRXIT
         SPACE 1
ITLR020  DS    0H                  check vol1 length
         CLC   =C'EOF1',6(R3)      EOF1 found?
         BE    ITLR030             yes, branch
         AWSMSG 312E,'EOF1 label expected and not found'
         LA    R15,8
         B     ITLRXIT
         space 1
ITLR030  DS    0H
         LA    R3,6(,R3)           position beyond aws cb
         MVC   DSXL16(4),=4C'0'    fill with zeros
         MVC   DSXL16+4(6),DSHDR1BL-DSHDR1(R3) low block count
         CLI   DSHDR1BH-DSHDR1(R3),C'0' high block count specified?
         BL    *+10                no, branch
         MVC   DSXL16(4),DSHDR1BH-DSHDR1(R3)
         PACK  DSDWORK,DSXL16(10)  pack block count
         CVB   R0,DSDWORK          total block count
         ST    R0,DSBLKCTI         save for future reference
         MVC   DSXL16,=X'40202020202020202020202020202120'
         ED    DSXL16,DSDWORK      edit value
         OI    DSXL16+15,C'0'      make printable
         MVC   DSMSG+1(7),=C'AWS313I' message id
         MVC   DSMSG+19(31),=C'AWS EOF1 label block count    :'
         MVC   DSMSG+51(16),DSXL16 set count into message
         AWSMSG ,
         AWSMSG ,                  blank line
         AWSMSG ,                  blank line
         SPACE 1
ITLR900  DS    0H                  normal exit
         SLR   R15,r15             zero return code
         SPACE 1
ITLRXIT  DS    0H                  return
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSIGET - import (get) a block'
***********************************************************************
* AWSIGET - import (get) a block                                      *
*           msg AWS32n                                                *
*                                                                     *
* This function returns a pointer (dsbuftp) pointing to the next      *
* block in the input AWSFILE dataset.                                 *
*                                                                     *
***********************************************************************
         SPACE 1
AWSIGET  CSECT ,                   import (get) a block
         AWSENTRY ,
         SPACE 1
         LA    R0,6                r0=amount of text needed
         LA    R1,DSBUFFER         r1=position to place text
         ST    R1,DSBUFTP          for caller's reference
         SLR   R4,R4               r4=amount of text satisfied
         LR    R5,R0               r5=amount of text needed
         SPACE 1
IGET010  DS    0H                  retrieve aws header
         AWSCALL AWSGTXT           get some text
         BNZ   IGETEOF             if eof, branch
         ALR   R4,R0               amount of text accumlated
         ALR   R1,R0               r1=put text here
         LR    R0,R5               compute amount still needed
         SR    R0,R4               r0=amount of text still needed
         BNZ   IGET010             if more needed, branch
         SPACE 1
         LA    R3,DSBUFFER         aws header location
         USING AWSREC,R3           addressability
         AWSSWAP ,                 swap bytes, set sizes                wap byte
         SLR   R0,R0               clear register
         ICM   R0,3,AWSLENC        r0=amount of text needed
         LA    R1,6(,R3)           r1=position to place text
         SLR   R4,R4               r4=amount of text satisfied
         LR    R5,R0               r5=amount of text needed
         SPACE 1
IGET020  DS    0H                  retrieve data block
         AWSCALL AWSGTXT           get some text
         BNZ   IGETEOF             if eof, branch
         ALR   R4,R0               amount of text accumlated
         ALR   R1,R0               r1=put text here
         LR    R0,R5               compute amount still needed
         SR    R0,R4               r0=amount of text still needed
         BNZ   IGET020             if more needed, branch
         SPACE 1
IGET900  DS    0H                  exit
         SLR   R15,R15             zero return code
         B     IGETXIT             exit
         SPACE 1
IGETEOF  DS    0H                  eof reached
         LH    R15,=H'-4'          indicate eof
         SPACE 1
IGETXIT  DS    0H                  return to caller
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP  ,
         TITLE 'AWSGTXT - get AWS  text'
***********************************************************************
* AWSGTXT - get AWS text                                              *
*                                                                     *
* calling parameters: r1 -> location where text is to be placed       *
*                     r0 -> length of text requested                  *
*                                                                     *
* exit    parameters: r0 -> length of text returned                   *
*                     r15= -4 when eof                                *
*                                                                     *
***********************************************************************
         SPACE 1
AWSGTXT  CSECT ,                   get AWS text
         AWSENTRY ,
         SPACE 1
         LR    R3,R1               r3=location at which to return text
         LR    R4,R0               r4=length of text requested
         LA    R5,AWSUT2           r5=input dcb location
         USING IHADCB,R5           ... addressability
         LA    R0,GTXTEOF          eof routine location
         STCM  R0,7,DCBEODA        ... set into dcb
         SPACE 1
         SLR   R2,R2               clear register
         LR    R15,R2              clear registger
         ICM   R15,3,DSGTXTL       r15=length of source
         ICM   R14,15,DSGTXTP      r14=current location in input buffer
         ST    R2,DSGTXTP          assume all text will be used
         STH   R2,DSGTXTL          ... and entire length
*        LTR   R14,R14             r14=source text already present?
         BNZ   GTXT010             yes, branch
         SPACE 1
         GET   AWSUT2              get some data
         LR    R14,R1              r14=source text location
         SLR   R15,R15             clear register
         ICM   R15,3,DCBLRECL      r15=length of source
         TM    DCBRECFM,DCBRECU    undefined?
         BO    GTXT010             yes, branch
         TM    DCBRECFM,DCBRECF    fixed?
         BO    GTXT010             yes, branch
         LA    R14,4(,R14)         r14=source text location (after rdw)
         SH    R15,=H'4'           r15=source text length   (minus rdw)
         SPACE 1
GTXT010  DS     0H                 r3=trg,r4=trglen,r14=src,r15=srclen
         CLR   R15,R4              source length exceeds target length?
         BNH   GTXT020             no, branch
         LA    R0,0(R4,R14)        r0= *next* source location
         ST    R0,DSGTXTP          ... set next pointer (for next call)
         SLR   R15,R4              r15=*next* source length
         STCM  R15,3,DSGTXTL       ... set next length  (for next call)
         LR    R15,R4              override current source length
         SPACE 1
GTXT020  DS     0H                 r3=trg,r4=trglen,r14=src,r15=trglen
         LR    R2,R15              save length for later use
         LR    R0,R3               target location
         LR    R1,R15              target length
         MVCL  R0,R14              copy into user buffer
         SLR   R15,R15
         B     GTXTXIT             return
         SPACE 1
GTXTEOF  DS     0H                 end of input reached
         SLR   R2,R2               zero length returned
         ST    R2,DSGTXTP          zero pointer
         STH   R2,DSGTXTL          clear remaining length
         LH    R15,=H'-4'          indicate eof
         SPACE 1
GTXTXIT  DS     0H
         L     R1,4(,R13)          caller's savearea
         ST    R2,20(,R1)          length returned in caller's r0
         SPACE 1
         AWSEXIT ,
         SPACE 1
         LTORG ,
         DROP
         TITLE 'Dummy functions pending implementation'
***********************************************************************
* Dummy functions pending implementation                              *
***********************************************************************
         SPACE 1
*AWSDUMMY AWSDUMMY ,               dummy csect (expansion?)
         TITLE 'AWSCOMST - Constant common data'
***********************************************************************
* AWSCOMST - Constant common data                                     *
***********************************************************************
         SPACE 1
AWSCOMST CSECT ,                   constant common data
         SPACE 1
CSPARST1 DC    256YL1(0)           locate keyword
         ORG   CSPARST1+C'='       keyword suffix
         DC    C'='
         ORG   ,
         SPACE 1
CSPARST2 DC    256YL1(0)           locate keyword
         ORG   CSPARST2+C' '       delimiter #1
         DC    C' '
         ORG   CSPARST2+C','       delimiter #2
         DC    C','
         ORG   ,
         SPACE 1
CSPARST3 DC    256YL1(0)           locate keyword
         ORG   CSPARST3+c'"'       delimiter #1
         DC    C'"'
         ORG   CSPARST3+C''''      delimiter #2
         DC    C''''
         ORG   ,
         SPACE 1
CSNUMTRT DC    256X'FF'            NUMERIC TEXT TRT TABLE
         ORG   CSNUMTRT+C'0'
         DC    10X'00'
         ORG   ,
         SPACE 1
CSHEXTR  EQU   *-C'0'              hexadecimal translate table
         DC    C'0123456789ABCDEF'
         ORG   ,
         SPACE 1
CSAWSPRT DC    A(AWSPRNT)          print function
CSAWSDYE DC    A(AWSDYNE)          dynamic allocation error function
CSAWSEPT DC    A(AWSEPUT)          put function
CSAWSMRK DC    A(AWSMARK)          write tape mark function
CSAWSIGE DC    A(AWSIGET)          read a logical aws block
CSF0     DC    F'0'                full word of zero
CSH4     DC    Y(4)                half word 4
CSH80    DC    Y(80)               half word 80
CSP1     DC    P'1'                packed value 1
CSXA000  DC    X'A000'             block flags
CSX4000  DC    X'4000'             tape mark flags
CSBLNKS  DC    CL133' '            some blanks
         LTORG ,
         TITLE 'AWSDATA - Dynamic common data'
***********************************************************************
* AWSDATA - Dynamic common data                                       *
***********************************************************************
         SPACE 1
AWSDATA  CSECT ,                   dynamic storage data areas
DSSTACK  DS    (STACKCT*18)F       savearea stack
AWSDYNAM EQU   *                   origin addressable dynamic storage
DSDWORK  DS    D                   double word workarea
DSFWORK  DS    F                   full word work area
DSDATAP  DS    A                   origin of relocated awsdata
DSSTACKP DS    A                   origin of stack
DSBUFTP  DS    A                   loc of next text in output buffer
DSBUFEND DS    A                   end of current block
DSGTXTP  DS    A                   get text pointer
DSBLKCTI DS    F                   block count expected
DSHWORK  DS    H                   half word work area
DSFILECT DS    H                   logical file number
DSLSTSIZ DS    H                   size of last block written
DSCURSIZ DS    H                   size of current block written
DSINFLNO DS    H                   infile= numeric argument
DSBLKSIZ DS    H                   block size
DSGTXTL  DS    H                   get text length
DSLRECL  DS    H                   lrecl
DSRECFM  DS    CL2                 recfm
DSASA    DS    C                   carriage control
DSFLAGS  DS    X                   State flags
DSFVOLF  EQU   X'80'               ... VOL1 has been written
DSFRECV  EQU   X'40'               ... output variable length records
DSFFLUSH EQU   X'20'               ... flush residual output
DSFDYUT1 EQU   X'10'               ... awsut1   dynamically allocated
DSFDYTMP EQU   X'08'               ... awstemp  dynamically allocated
DSFDYSYI EQU   X'04'               ... sysin    dynamically allocated
DSFDYSYP EQU   X'02'               ... sysprint dynamically allocated
DSFOPNEX EQU   X'01'               ... awsfile is open for export
DSFLAGS2 DS    X                   State flags 2
DSFIMPRT EQU   X'80'               ... import function invoked
DSFEXPRT EQU   X'40'               ... export function invoked
DSFFRAGD EQU   X'20'               ... AWS CB ITSELF IS FRAGMENTED
         SPACE 1
DSHETCMP DS    CL1                 HET COMPRESSION REQUESTED
DSHETMTH DS    CL1                 HET COMPRESSION METHOD
DSHETLVL DS    CL1                 HET COMPRESSION LEVEL
DSHETIDR DS    CL1                 HET IDRC
DSHETCSZ DS    CL5                 HET CHUNK SIZE
DSBLKCNT DS    PL6                 DATASET BLOCK COUNT
DSOWNER  DS    CL10                owner=   volume owner
DSINDSN  DS    CL44                indsn=   dataset name
DSOUTDSN DS    CL44                outdsn=  dataset name
DSTDSN   DS    CL17                tapedsn= dataset name
DSINDD   DS    CL8                 indd=    ddname
DSOUTDD  DS    CL8                 outdd=   ddname
DSINFLNC DS    CL8                 infile=  character argument
DSUNLPGM DS    CL8                 unload=  program
DSLODPGM DS    CL8                 load=    program
DSUNLTYP DS    CL8                 unload type (repro, export, etc)
DSUSESL  DS    CL1                 use standard labels flag
DSCARD   DS    CL80                sysin control statements
DSTVOL   DS    CL6                 tape volser
DSJOBNM  DS    CL8                 job name
DSSTEPNM DS    CL8                 step name
         SPACE 1
DSXL16   DS    XL16                16 byte work area
DSHEXWK  DS    CL9                 hex work area
DSIBLKCT DS    PL8                 aws input block count
DSIRECCT DS    PL8                 aws input record count
         SPACE 1
         DS    0D
AWSRELOC EQU   *                   beginning of relocated storage
         SPACE 1
DSOPENL  OPEN  0,MF=L              open  parameter list
DSCLOSEL CLOSE 0,MF=L              close parameter list
DSRDJFCB RDJFCB 0,MF=L             rdjfcb parameter list
         SPACE 1
DSPAGECT DC    PL2'0'              page count
DSLINECT DC    PL2'90'             line count
DSMSG    DC    CL133' '            message buffer
DSMSG1   DC    CL133' '            message buffer
DSHEADER DC    CL133' '
         ORG   DSHEADER
         DC    C'1AWSSL - AWS Virtual Tape (standard labels) - '
         DC    C'Version 1.9G - Copyright (C) 2002 - '
         DC    C'By Reed H. Petty, rhp@draper.net'
         ORG   DSHEADER+123
         DC    C' Page'
DSPAGE   DC    CL4'   1'
         ORG   ,
         SPACE 1
DSJFCBL  DS    0F                  RDJFCB LIST
         DC    X'87',AL3(INFMJFCB) JFCB EXIT LST
         SPACE 1
         PRINT NOGEN
         IEFJFCBN LIST=YES         JFCB
         PRINT GEN
         EJECT
***********************************************************************
* Dynamic allocation control blocks                                   *
***********************************************************************
         SPACE 1
         DS    0F
DSARBP   DC    X'80',AL3(DSARB)    input dataset request block
DSARB    DC    XL(S99RBEND-S99RB)'00' request block
         SPACE 1
DSATXTP  DC    A(DSADDNM)          ddname
         DC    A(DSADSNM)          dataset name
         DC    A(DSASTATS)         dataset status
         DC    X'80',AL3(DSADISP)  normal disposition
         SPACE 1
DSADDNM  DC    YL2(DALDDNAM),YL2(1),YL2(8)
DSADDNM1 DC    CL8'AWSUT1'
         SPACE 1
DSADSNM  DC    YL2(DALDSNAM),YL2(1),YL2(DSADSNML)
DSADSNMT DC    CL44' '
DSADSNML EQU   *-DSADSNMT
         SPACE 1
DSASTATS DC    YL2(DALSTATS),YL2(1),YL2(1),X'08' SHR
         SPACE 1
DSADISP  DC    YL2(DALNDISP),YL2(1),YL2(1),X'08' KEEP
         SPACE 1
         DS    0F
DSTARBP  DC    X'80',AL3(DSTARB)   awstemp dataset request block
DSTARB   DC    XL(S99RBEND-S99RB)'00' request block
DSTATXTP DC    A(DSTADDNM)         ddname (AWSTEMP)
         DC    A(DSTAUNIT)         unit (SYSDA)
         DC    A(DSTASPCU)         space primary units (CYL)
         DC    A(DSTASPCP)         space primary qty   (100)
         DC    X'80',AL3(DSTASPCS) space secondary qty (100)
DSTADDNM DC    YL2(DALDDNAM),YL2(1),YL2(7),CL7'AWSTEMP'
DSTAUNIT DC    YL2(DALUNIT),YL2(1),YL2(5),CL5'SYSDA'
DSTASPCU DC    YL2(DALCYL),YL2(0)
DSTASPCP DC    YL2(DALPRIME),YL2(1),YL2(3),AL3(100)
DSTASPCS DC    YL2(DALSECND),YL2(1),YL2(3),AL3(100)
         SPACE 1
         DS    0F
DSSARBP  DC    X'80',AL3(DSSARB)   sysin dataset request block
DSSARB   DC    XL(S99RBEND-S99RB)'00' request block
DSSATXTP DC    A(DSSADDNM)         ddname (SYSIN)
         DC    A(DSSAUNIT)         unit (SYSDA)
         DC    A(DSSASPCU)         space primary units (CYL)
         DC    A(DSSASPCP)         space primary qty   (1)
         DC    X'80',AL3(DSSASPCS) space secondary qty (1)
DSSADDNM DC    YL2(DALDDNAM),YL2(1),YL2(5),CL7'SYSIN'
DSSAUNIT DC    YL2(DALUNIT),YL2(1),YL2(5),CL5'SYSDA'
DSSASPCU DC    YL2(DALTRK),YL2(0)
DSSASPCP DC    YL2(DALPRIME),YL2(1),YL2(3),AL3(1)
DSSASPCS DC    YL2(DALSECND),YL2(1),YL2(3),AL3(1)
         SPACE 1
         DS    0F
DSPARBP  DC    X'80',AL3(DSPARB)   sysprint dataset request block
DSPARB   DC    XL(S99RBEND-S99RB)'00' request block
DSPATXTP DC    A(DSPADDNM)         ddname (SYSPRINT)
         DC    X'80',AL3(DSPADUMY) dummy dd statement
DSPADDNM DC    YL2(DALDDNAM),YL2(1),YL2(8),CL8'SYSPRINT'
DSPADUMY DC    YL2(DALDUMMY),YL2(0)
         SPACE 1
         DS    0F
DSURBP   DC    X'80',AL3(DSURB)    unallocation request block
DSURB    DC    XL(S99RBEND-S99RB)'00' request block
DSUTXTP  DC    X'80',AL3(DSUDDNM)  ddname
DSUDDNM  DC    YL2(DUNDDNAM),YL2(1),YL2(8)
DSUDDNM1 DC    CL8'AWSUT1'
         EJECT
***********************************************************************
* VOL1 label                                                          *
***********************************************************************
         SPACE 1
DSVOL1   DC    CL80' '             vol1 label
         ORG   DSVOL1
         DC    CL4'VOL1'
DSVOL1SR DS    CL6                 volser
         DC    CL1' '              reserved
         DC    CL5' '              vtoc pointer
         DC    CL25' '             reserved
DSVOL1OW DC    CL10' '             owner
         DC    CL29' '             reserved
         SPACE 1
***********************************************************************
* HDR1 label                                                          *
***********************************************************************
         SPACE 1
DSHDR1   DC    CL80' '             hdr1 label
         ORG   DSHDR1
         DC    CL4'HDR1'
DSHDR1NM DS    CL17                last 17 bytes of dsn
DSHDR1SR DS    CL6                 volser
         DC    CL4'0001'           file section number
DSHDR1SQ DC    CL4'0000'           file sequence number
         DC    CL4' '              generation number
         DC    CL2' '              generation version number
DSHDR1CD DC    CL6'000001'         creation date, cyyddd,c=' '=1900
         DC    CL6'000000'         expiration date
         DC    CL1'0'              not password protected
DSHDR1BL DC    CL6'000000'         block count low order 6 bytes
         DC    CL13'IBM OS/VS 370' system code
         DC    CL3' '              reserved
DSHDR1BH DC    CL4' '              block count high order 4 bytes
         ORG   ,
         SPACE 1
***********************************************************************
* HDR2 label                                                          *
***********************************************************************
         SPACE 1
DSHDR2   DC    CL80' '             hdr2 label
         ORG   DSHDR2
         DC    C'HDR2'
DSHDR2RF DS    CL1                 record format
DSHDR2BL DS    CL5                 block length
DSHDR2RL DS    CL5                 record length
         DC    C'0'                tape density, 0 = cartridge
         DC    C'0'                volume switch is not in progress
DSHDR2JB DC    CL8' '              jobname
         DC    CL1'/'
DSHDR2ST DC    CL8' '              step name
         DC    CL2'  '             recording technique
DSHDR2CC DC    CL1' '              a=asa,m=machine,' '=none
         DC    CL1' '              reserved
DSHDR2BA DC    CL1' '              block attribute
*                                  b=blocked records
*                                  s=spanned or standard
*                                  r=blocked and spanned or standard
*                                  unblocked
         DC    CL2' '              reserved
         DC    CL6'AWS19G'         serial number of creating device
         DC    CL1' '              checkpoint identifier
         DC    CL22' '             reserved
DSHDR2LB DC    CL10' '             large block length
         ORG   ,
         EJECT
***********************************************************************
* EOF1 label                                                          *
***********************************************************************
DSEOF1   DC    CL80' '             eof1 label
         ORG   DSEOF1
         DC    CL4'EOF1'
DSEOF1NM DS    CL17                last 17 bytes of dsn
DSEOF1SR DS    CL6                 volser
         DC    CL4'0001'           file section number
DSEOF1SQ DC    CL4'0000'           file sequence number
         DC    CL4' '              generation number
         DC    CL2' '              generation version number
         DC    CL6'000001'         creation date, cyyddd,c=' '=1900
         DC    CL6'000001'         expiration date
         DS    CL1'0'              not password protected
DSEOF1BL DC    CL6'000000'         block count low order 6 bytes
         DC    CL13'IBM OS/VS 370' system code
         DC    CL3' '              reserved
DSEOF1BH DC    CL4'0000'           block count high order 4 bytes
         ORG   ,
         SPACE 1
***********************************************************************
* EOF2 label                                                          *
***********************************************************************
         SPACE 1
DSEOF2   DC    CL80' '             eof2 label
         ORG   DSEOF2
         DC    C'EOF2'
DSEOF2RF DS    CL1                 record format
DSEOF2BL DS    CL5                 block length
DSEOF2RL DS    CL5                 record length
         DC    C'0'                tape density, 0 = cartridge
         DC    C'0'                volume switch is not in progress
DSEOF2JB DC    CL8' '              jobname
         DC    CL1'/'
DSEOF2ST DC    CL8' '              step name
         DC    CL2'  '             recording technique
DSEOF2CC DC    CL1' '              a=asa,m=machine,' '=none
         DC    CL1' '              reserved
DSEOF2BA DC    CL1' '              block attribute
*                                  b=blocked records
*                                  s=spanned or standard
*                                  r=blocked and spanned or standard
*                                  unblocked
         DC    CL2' '              reserved
         DC    CL6'AWSSL '         serial number of creating device
         DC    CL1' '              checkpoint identifier
         DC    CL22' '             reserved
         DC    CL10' '             large block length
         ORG   ,
         SPACE 1
***********************************************************************
* Data control blocks                                                 *
***********************************************************************
         SPACE 1
         PRINT NOGEN
AWSPRINT DCB   DDNAME=AWSPRINT,DSORG=PS,MACRF=PM,RECFM=FBA,LRECL=133
         SPACE 1
AWSUT1   DCB   DDNAME=AWSUT1,DSORG=PS,MACRF=GL,EXLST=DSJFCBL
AWSUT2   DCB   DDNAME=AWSFILE,DSORG=PS,MACRF=GL
AWSUT3   DCB   DDNAME=AWSUT3,DSORG=PS,MACRF=PM
         SPACE 1
AWSFILE  DCB   DDNAME=AWSFILE,DSORG=PS,MACRF=PM
         SPACE 1
AWSCNTL  DCB   DDNAME=AWSCNTL,DSORG=PS,MACRF=GL
         SPACE 1
SYSIN    DCB   DDNAME=SYSIN,DSORG=PS,MACRF=PM,RECFM=FB,LRECL=80,       *
               BLKSIZE=3120
         PRINT GEN
         DROP
         SPACE 1
DSBUFFER DS    0D                  128k I/O buffer location
DSENDL   EQU   *-AWSRELOC          length of relocatable storage
AWSDATAL EQU   *-AWSDATA           data areas length
         EJECT
***********************************************************************
* AWS block header definition                                         *
***********************************************************************
         SPACE 1
AWSREC   DSECT ,                   AWS block header
AWSLENC  DS    H                   block length
AWSLENP  DS    H                   file data preceeding this block
AWSFLGS  DS    H                   block flags
AWSDBLK  DS    0X                  data block origin
         END