TITLE 'QSAM SAMPLE PROGRAM'                                    00010000
IOTESTQS CSECT                                                          00020000
         REGEQU                                                         00030000
         SPACE 5                                                        00040000
*********************************************************************** 00050000
*        REGISTERS USED                                               * 00060000
*        R0    SYSTEM                                                 * 00070000
*        R1    SYSTEM - PARM POINTER                                  * 00080000
*        R2    WORK REGISTER                                          * 00090000
*        R3      AVAILABLE                                            * 00100000
*        R4      AVAILABLE                                            * 00110000
*        R5      AVAILABLE                                            * 00120000
*        R6      AVAILABLE                                            * 00130000
*        R7      AVAILABLE                                            * 00140000
*        R8      AVAILABLE                                            * 00150000
*        R9      AVAILABLE                                            * 00160000
*        R10     AVAILABLE                                            * 00170000
*        R11     AVAILABLE                                            * 00180000
*        R12     AVAILABLE                                            * 00190000
*        R13   SYSTEM - SAVE AREA                                     * 00200000
*        R14   SYSTEM - RETURN ADDRESS                                * 00210000
*        R15   SYSTEM - ENTRY POINT                                   * 00220000
*********************************************************************** 00230000
         XSAVE                                                          00240000
         OPEN (IOCRDDCB,(INPUT),IOPRTDCB,(OUTPUT))                      00250000
*                                                                       00260000
         OPEN (IODSKDCB,(OUTPUT))                                       00270000
         PUT  IOPRTDCB,IOTITLE1                                         00280000
*                                                                       00290000
*        THE FOLLOING LOOP READS A CARD FROM THE CARD READER,           00300000
*        PRINTS IT AS AN ECHO CHECK, THEN WRITES IT ON DISK,            00310000
*        CONTROL IS TRANSFRRED TO IOEOF1 WHENVER THERE ARE              00320000
*        NO MORE CARDS LEFT.                                            00330000
*                                                                       00340000
IOREAD   GET   IOCRDDCB,IOCARD     MOVE NEXT CARD TO IOCARD#            00350000
         PUT   IOPRTDCB,IOCARD     PRINT IT (IT HAS CARRIAGE CONTROL)   00360000
*                                                                       00370000
*        NEXT PUT ILLUSTRATES PUT-LOCATED.  SYSTEM/390 RETURNS IN       00380000
*        R1 THE ADDRESS OF NEXT BUFFER IN WHICH TO PLACE OUPTU          00390000
*        CARD.  WE MOVE IT THERE OURSELVES.                             00400000
*                                                                       00410000
         PUT   IODSKDCB            2ND OP OMITTED SINCE PL              00420000
         MVC   0(80,R1),IOCARD     MOVE THE CARD THERE                  00430000
         B     IOREAD              GO BACK FOR MORE                     00440000
         SPACE 1                                                        00450000
IOEOF1   EQU   *                                                        00460000
*                                                                       00470000
*        USE CLOSE MACRO TO CLEAN UP AT END OF PROCESSING.              00480000
*        WILL ALSO WRITE OUT LAST BUFFER CREATED.                       00490000
*                                                                       00500000
         CLOSE (IOCRDDCB,,IODSKDCB)                                     00510000
*                                                                       00520000
*        WE NOT REOPEN IODSKDCB FOR INPUT THIS TIME.  NOT THAT          00530000
*        THE NAME ONLY IS INCLUDED.  IF THE OPTION IS OMITTED,          00540000
*        INPUT IS IMPLIED.                                              00550000
*                                                                       00560000
         OPEN  (IODSKDCB)                                               00570000
         PUT   IOPRTDCB,IOTITLE2                                        00580000
         SPACE 1                                                        00590000
*                                                                       00600000
*        AT THIS POINT, WE CLOSE PRINT DCB, DYNAMICALLY CHANGE          00610000
*        LRECL AND BLKSIZE TO 80, SO WE DON'T HAVE TO PAD WITH          00620000
*        BLANKS THIS TIME, THEN RE-OPEN.                                00630000
*                                                                       00640000
         CLOSE (IOPRTDCB)          CLOSE IT, FLUSH BUFFERS              00650000
         MVC   IOPRTDCB+X'3E'(2),=H'80'  MAKE BLKSIZE 80                00660000
         MVC   IOPRTDCB+X'52'(2),=H'80'  MAKE LRECL 80                  00670000
         OPEN  (IOPRTDCB,(OUTPUT)) REOPEN THE DD CARD                   00680000
*                                                                       00690000
*        THE ABOVE KLUGE IS ONLY NECESSARY BECAUSE LAZY PROGRAMMERS     00700000
*        DON'T WANT TO PAD WITH BLANKS AND MOVE CARDS AROUND.           00710000
*                                                                       00720000
         SPACE 1                                                        00730000
*                                                                       00740000
*        FOLLOWING LOOP READS THE RECORDS BACK FROM DISK, THEN          00750000
*        PRINTES THEM OUT AGAIN.                                        00760000
*                                                                       00770000
IOREAD2  EQU   *                   LOOD HEAD FOR READING                00780000
         GET   IODSKDCB            GET-LOCATE - R1 = ADDR OF NEXT REC   00790000
         LR    R0,R1               MOVE TO PLACE BEST FOR PUT           00800000
         PUT   IOPRTDCB,(R0)       ILLUSTRATED REGISTER FOR PUT-MOVE    00810000
         B     IOREAD2             LOOP TILL DONE                       00820000
         SPACE 1                                                        00830000
IOEOF2   EQU   *                   BRANCH HERE - SEE EODAD=IOEOF2       00840000
         CLOSE (IODSKDCB)          DONE WITH IT - CLOSE IT              00850000
         LA    R2,IOTITLE3         POINT TO TITLE AREA                  00860000
         PUT   IOPRTDCB,(R2)       ILLUSTRATE REGISTER FORMAT           00870000
         CLOSE (IOPRTDCB)          MAKE SURE LAST LINE IS PRINTED       00880000
         SPACE 1                                                        00890000
         XRETURN RC=0                                                   00900000
IOCARD   DS    0D,CL80             80 BYTES ALIGNED ON DOUBLE WORD      00910000
         DC    CL53' '             PAD TO 133 BYTES FOR PRINTING        00920000
IOTITLE1 DC    CL133'1*** ECHO-CHECK OF INPUT CARDS BELOW ***'          00930000
IOTITLE2 DC    CL133'0*** FIRST PASS DONE, RECORDS FROM DISK FOLLOW BELX00940000
               OW ***'                                                  00950000
IOTITLE3 DC    CL133'0*** END OF EXAMPLE - LAST LINE PRINTED'           00960000
         SPACE 1                                                        00970000
IOCRDDCB DCB   DDNAME=CARDS,                                           X00980000
               DSORG=PS,                                               X00990000
               MACRF=GM,                                               X01000000
               EODAD=IOEOF1,                                           X01010000
               RECFM=F,                                                X01020000
               LRECL=80,                                               X01030000
               BLKSIZE=80                                               01040000
         SPACE 1                                                        01050000
IOPRTDCB DCB DDNAME=PRINT,                                             X01060000
               DSORG=PS,                                               X01070000
               MACRF=PM,                                               X01080000
               RECFM=FA,                                               X01090000
               LRECL=133,                                              X01100000
               BLKSIZE=133                                              01110000
         SPACE 1                                                        01120000
IODSKDCB DCB   DDNAME=DISK,                                            X01130000
               DSORG=PS,                                               X01140000
               MACRF=(GL,PL),                                          X01150000
               EODAD=IOEOF2                                             01160000
         END                                                            01170000