QSAM

Home Up Search Credits Site Map Contact Info. Links Disclaimer Download

horizontal rule

This is a QSAM example program.  You may download this program here.

 

         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

horizontal rule

The information on this site is the combined effort of a lot of people, please credit the authors if you use their information.
Please read the Disclaimer page for the restrictions, copyright, and other uses of the information contained on this site.
For problems or questions regarding this web contact Bob.
Last updated: November 26, 2003.