|
| 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 |
The information on this site is the combined effort of a lot of people,
please credit the authors if you use their information.
|