SQS TITLE 'DMSSQS (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 * MODULE NAME: 00006000 * 00007000 * DMSSQS (SOQSAM - QUEUED SEQUENTIAL ACCESS METHOD) 00008000 * 00009000 * FUNCTION: 00010000 * 00011000 * TO ANALYZE RECORD FORMAT AND SET UP THE BUFFERS 00012000 * ACCORDINGLY FOR GET, PUT AND PUTX REQUESTS. 00013000 * 00014000 * ATTRIBUTES: 00015000 * 00016000 * REENTRANT, NUCLEUS RESIDENT 00017000 * 00018000 * ENTRY POINTS: 00019000 * DMSSQSGT - OS GET MACRO 00020000 * DMSSQSPT - OS PUT MACRO 00021000 * DMSSQSUP - OS GET AND PUTX MACROES FOR QSAM UPDATE 00022000 * 00023000 * ENTRY CONDITIONS: 00024000 * 00025000 * MUST BE CALLED BY OS GET, PUT OR PUTX MACRO 00026000 * 00027000 * EXIT CONDITIONS: 00028000 * 00029000 * NORMAL CONTROL IS RETURNED TO USER WITH REGISTERS 00030000 * SPECIFIED AS IN THE OS DATA MANAGEMENT SERVICES 00031000 * MANUAL 00032000 * 00033000 * ERRORS: CONTROL IS PASSED TO DMSSCTCE TO HANDLE ERRORS 00034000 * 00035000 * CALLS TO OTHER ROUTINES: 00036000 * 00037000 * DMSSEB, DMSSCT 00038000 * 00039000 * EXTERNAL REFERENCES: 00040000 * 00041000 * FCBSECT, OPSECT, NUCON, IHADCB 00042000 * 00043000 * TABLES/WORKAREAS: 00044000 * 00045000 * NONE 00046000 * 00047000 * REGISTER USAGE: 00048000 * 00049000 * R0,R1,R4-R10,R12,R14,R15 WORK 00050000 * R2 DCB 00051000 * R3 DMSSQS BASE 00052000 * R13 SAVE AREA 00053000 * 00054000 * OPERATION: 00055000 * 00056000 * INITIALIZATION 00057000 * 00058000 * OSIOTYPE AND IOBECBPT ARE SET TO INDICATE ACCESS 00059000 * METHOD AND FCB ADDRESS RESPECTIVELY. THEN, IF 00060000 * THE DUMMY OPTION IS NOT SPECIFIED IN THE FCB, A 00061000 * BRANCH IS TAKEN TO GETTER, PUTTER OR PUTXER 00062000 * DEPENDING ON WHETHER THE REQUEST IS A GET, PUT OR 00063000 * PUTX RESPECTIVELY. IF DUMMY IS SPECIFIED IN THE FCB, 00064000 * CONTROL IS PASSED TO QSAMDUMY. 00065000 * 00066000 * GETTER 00067000 * 00068000 * AFTER FCBIOSW AND IOBIOFLG ARE SET TO INDICATE 00069000 * INPUT IN PROCESS, DCB FIELDS DCBMACF AND DCBRECFM 00070000 * ARE ANALYZED TO DETERMINE THE TYPE OF MODE DESIRED 00071000 * - MOVE OR LOCATE - AND THE RECORD FORMAT. IF THE 00072000 * MODE IS MOVE, THE USER SPECIFIED 'MOVE TO' ADDRESS 00073000 * IS STORED IN DEBTCBAD. BOTH MODES CONTINUE BY 00074000 * DETERMINING WHETHER IT IS CALLED FROM CLOSE 00075000 * (DMSSOP). IF SO, A CHECK IS MADE TO DETERMINE 00076000 * WHETHER THE UPDATE FLAG (IOBUBD) IN THE "IOBIOFLG" 00077000 * IS ON INDICATING A "PUTX" ISSUED ON THE LAST 00078000 * BLOCK. 00079000 * 00080000 * IF THE UPDATE FLAG IS NOT ON, CONTROL IS RETURNED 00081000 * TO CLOSE. 00082000 * 00083000 * IF THE UPDATE FLAG IS ON, CONTROL IS PASSED TO THE 00084000 * ROUTINE "GETXER" TO REWRITE THE LAST BLOCK BEFORE 00085000 * RETURNING TO CLOSE. (SEE "GETXER" BELOW). 00086000 * 00087000 * IF NOT CALLED BY CLOSE, A CHECK IS MADE TO 00088000 * DETERMINE WHETHER AN "END OF BLOCK" CONDITION 00089000 * EXISTS. 00090000 * 00091000 * IF "END OF BLOCK" CONDITION DOES EXIST, A CHECK 00092000 * IS MADE OF THE UPDATE FLAG TO DETERMINE WHETHER A 00093000 * RECORD IN THE JUST COMPLETED BLOCK WAS UPDATED. 00094000 * IF SO, "GETXER" RECEIVES CONTROL TO REWRITE THE 00095000 * LAST BLOCK; (SEE "GETXER" BELOW). ROUTINE "SETEOB" 00096000 * THEN RECEIVES CONTROL TO GET THE NEXT BUFFER FROM 00097000 * THE POOL; (SEE "SETEOB" BELOW). 00098000 * 00099000 * UPON RETURN FROM "SETEOB", THE APPROPRIATE "FCB" 00100000 * FIELDS ARE UPDATED AND A CALL IS MADE TO DMSSEB TO 00101000 * FILL THE NEW BUFFER WITH THE NEXT BLOCK. 00102000 * 00103000 * UPON RETURN, THE "FCBITEM" COUNT IS UPDATED, AND 00104000 * THE "ECB" IS CHECKED FOR AN ERROR. IF ONE EXISTS, 00105000 * CONTROL IS PASSED TO DMSSCT (CHECK SIMULATION). 00106000 * 00107000 * AFTER IT IS DETERMINED THAT THERE IS A RECORD IN THE 00108000 * BUFFER, THE RECORD IS DEBLOCKED FROM THE BUFFER AND, IF 00109000 * THE RECFM IS VARIABLE OR UNDEFINED, DCBLRECL IS SET TO THE 00110000 * LENGTH OF THE RECORD. IF THE MODE IS LOCATE, CONTROL 00111000 * IS RETURNED TO THE USER WITH THE ADDRESS OF THE RECORD. IF 00112000 * THE MODE IS MOVE, THE RECORD IS MOVED TO THE ADDRESS 00113000 * PROVIDED BY THE USER AND CONTROL IS RETURNED TO THE USER. 00114000 * 00115000 * PUTTER 00116000 * 00117000 * RECEIVES CONTROL FROM "PUT" MACRO INSTRUCTION. 00118000 * AFTER "FCBIOSW" AND "IOBIOFLG" ARE SET TO INDICATE 00119000 * OUTPUT IN PROGRESS, A CHECK IS MADE TO DETERMINE 00120000 * WHETHER THIS CALL WAS MADE FROM CLOSE. 00121000 * 00122000 * IF NOT CALLED FROM CLOSE AND THE MODE IS LOCATE, 00123000 * AND THIS IS THE FIRST "PUT" CALL, THE ADDRESS OF 00124000 * THE FIRST BUFFER IS PLACED IN REGISTER 1 AND 00125000 * CONTROL IS RETURNED TO THE USER. 00126000 * 00127000 * IF CALLED FROM CLOSE, A CHECK IS MADE TO SEE IF A PUT 00128000 * IS NECESSARY. IF NOT, CONTROL IS RETURNED TO THE USER. 00129000 * IF A PUT IS NECESSARY, THE POINTERS ARE SETUP TO WRITE 00130000 * A SHORT BLOCK. 00131000 * 00132000 * IF OTHER THAN THE FIRST "PUT" CALL, IT IS 00133000 * DETERMINED WHETHER THE CURRENT BUFFER HAS 00134000 * SUFFICIENT SPACE FOR ANOTHER RECORD. IF IT HAS, 00135000 * REGISTER 1 IS UPDATED TO THE ADDRESS OF THE NEXT 00136000 * RECORD WITHIN THE CURRENT BUFFER AND CONTROL IS 00137000 * RETURNED TO THE CALLER. IF THE CURRENT BUFFER IS 00138000 * FULL, A CALL IS MADE TO DMSSEB TO WRITE THE 00139000 * CURRENT BUFFER TO THE FILE. 00140000 * 00141000 * UPON RETURN FROM DMSSEB THE "ECB" IS CHECKED FOR 00142000 * ERROR INDICATION AND IF ONE EXISTS CONTROL IS 00143000 * PASSED TO DMSSCT (CHECK SIMULATION). IF NO ERROR 00144000 * CONDITION EXISTS THE "FCBITEM" COUNT IS UPDATED TO 00145000 * REFLECT THE LAST BLOCK WRITTEN. 00146000 * 00147000 * ROUTINE "SETEOB" THEN RECEIVES CONTROL TO GET THE 00148000 * NEXT BUFFER FROM THE POOL; (SEE "SETEOB" BELOW). 00149000 * IF LOCATE IS SPECIFIED, CONTROL IS RETURNED TO THE 00150000 * USER. IF MOVE MODE IS SPECIFIED, THE ROUTINE MOVEMODE 00151000 * IS USED TO MOVE THE RECORD INTO THE BUFFER AND CONTROL 00152000 * IS RETURNED TO THE USER. 00153000 * 00154000 * 00155000 * PUTXER 00156000 * 00157000 * RECEIVES CONTROL FROM "PUTX" MACRO INSTRUCTION. 00158000 * SETS THE UPDATE FLAG ("IOBUPD") IN THE "IOBIOFLG" 00159000 * FIELD OF THE IOB TO INDICATE THAT THE CURRENT 00160000 * BLOCK HAS BEEN UPDATED AND THEREFORE WILL BE 00161000 * REWRITTEN AT "END OF BLOCK" TIME. RETURNS 00162000 * CONTROL TO THE USER. 00163000 * 00164000 * GETXER 00165000 * 00166000 * RECEIVES CONTROL FROM ROUTINE "GETTER" AT "CLOSE" 00167000 * TIME OR "END OF BLOCK" TIME WHEN THE UPDATE FLAG 00168000 * (IOBUPD) HAS BEEN SET IN THE "IOBIOFLG" BY A 00169000 * PREVIOUS "PUTX" CALL. 00170000 * 00171000 * THE "FCBIOSW" AND "IOBIOFLG" ARE CHANGED FROM A 00172000 * "GET" CALL TO A "PUT" CALL. THE "FCBITEM" COUNT 00173000 * IS RESET TO THE FIRST RECORD OF THE CURRENT BLOCK. 00174000 * 00175000 * DMSSEB IS CALLED TO REWRITE THE UPDATED BLOCK. 00176000 * 00177000 * UPON RETURN, THE "ECB" IS CHECKED FOR AN ERROR 00178000 * CONDITION. IF ONE EXISTS, A CALL IS MADE TO 00179000 * DMSSCT (CHECK SIMULATION). IF NO ERROR INDICATION, 00180000 * THE "FCBITEM" COUNT IS RESTORED TO THE NEXT BLOCK, 00181000 * THE "FCBIOSW" AND "IOBIOFLG" ARE RESET TO INDICATE 00182000 * THE "GET" CALL AND IF NOT "CLOSE" TIME, CONTROL IS 00183000 * RETURNED TO ROUTINE "GETTER". IF "CLOSE" TIME 00184000 * CONTROL IS RETURNED TO DMSSOP (CLOSE). 00185000 * 00186000 * SETEOB 00187000 * 00188000 * RECEIVES CONTROL FROM ROUTINES "GETTER" OR 00189000 * "PUTTER" AT "END OF BLOCK" TIME. 00190000 * 00191000 * DCB AND IOB ADDRESSES ARE UPDATED TO POINT TO THE 00192000 * NEXT BUFFER IN THE POOL AND CONTROL IS RETURNED TO 00193000 * THE CALLING ROUTINE. 00194000 * 00195000 * MOVEMODE 00196000 * 00197000 * MOVES THE RECORD FROM THE 00198000 * USER BUFFER TO THE SYSTEM BUFFER IN THE CASE OF 00199000 * "PUT" AND FROM THE SYSTEM BUFFER TO THE USER 00200000 * BUFFER IN THE CASE OF "GET". IT THEN RETURNS 00201000 * CONTROL TO THE CALLING ROUTINE. 00202000 * 00203000 * QSAMDUMY 00204000 * 00205000 * QSAMDUMY FIRST CHECKS TO DETERMINE IF A GET OR 00206000 * A PUT WAS ISSUED. IF A GET WAS ISSUED, AN END OF FILE 00207000 * ERROR CODE IS SET AND CONTROL IS PASSED TO DMSSCTCE. 00208000 * IF A PUT WAS ISSUED, CONTROL IS RETURNED TO THE USER 00209000 * WITH THE ADDRESS OF THE NEXT RECORD AREA IN REGISTER 00210000 * ONE. 00211000 *. 00212000 EJECT 00213000 * 00214000 DMSSQS START X'0' 00215000 ENTRY DMSSQSGT,DMSSQSPT,DMSSQSUP 00216000 EJECT 00217000 *********************************************************************** 00218000 * * 00219000 * QSAM INPUT/OUTPUT ROUTINES SIMULATORS: GET, PUT * 00220000 * * 00221000 *********************************************************************** 00222000 SPACE 00223000 * QSAM "GET" ENTRY POINT 00224000 DMSSQSGT EQU * GET ROUTINE ENTRY POINT 00225000 USING *,R15 00226000 STM R14,R12,12(R13) SAVE REGS IN CALLING ROUTINE SAVE 00227000 LA R4,C'G' IOTYPE = "GET" 00228000 LA R15,TOGETHER PLAY GAMES 00229000 BR R15 00230000 DROP R15 00231000 * QSAM "PUT" ENTRY POINT 00232000 DMSSQSPT EQU * PUT ROUTINE ENTRY POINT 00233000 USING *,R15 00234000 STM R14,R12,12(R13) SAVE REGS IN CALLING ROUTINE SAVE TR 00235000 LA R4,C'P' IOTYPE = "PUT" 00236000 LA R15,TOGETHER JOIN FORCES 00237000 BR R15 00238000 DROP R15 00239000 * QSAM UPDATE ENTRY POINT (GET,PUTX) 00240000 DMSSQSUP EQU * 00241000 USING *,R15 00242000 B GETX GO TO "GET" UPDATE ENTRY POINT 00243000 PUTX STM R14,R12,12(R13) SAVE REGISTERS 00244000 LA R4,C'X' "PUTX", MAKE IOTYPE = "PUTX" 00245000 GOTO LA R15,TOGETHER 00246000 BR R15 GO TO COMMON ROUTINE 00247000 GETX STM R14,R12,12(R13) SAVE REGISTERS 00248000 LA R4,C'G' IOTYPE = "GET" 00249000 B GOTO 00250000 DROP R15 00251000 SPACE 00252000 TOGETHER DS 0H COMMON INITIALIZATION SEQUENCE 00253000 USING *,R15 00254000 L R3,AQSAM SET COMMON ADDRESSABILITY 00255000 DROP R15 00256000 USING DMSSQS,R3 00257000 USING NUCON,R0 00258000 USING IHADCB,R2 00259000 USING FCBSECT,R11 00260000 LR R2,R1 GET V(DCB) 00261000 L R11,DCBDEBAD GET ADDR OF DEB 00262000 SH R11,=AL2(IHADEB-FCBINIT) GET ADDR OF FCB 00263000 L R15,AOPSECT POINT TO OPSECT 00264000 USING OPSECT,R15 00265000 STC R4,OSIOTYPE SET METHOD TYPE 00266000 LA R4,IOBECB SET QSAM ECB 00267000 ST R4,IOBECBPT 00268000 CLI FCBDEV,0 IS THIS A DUMMY CMSCB 00269000 BE QSAMDUMY YES, GO TO DUMMY ROUTINE 00270000 CLI OSIOTYPE,C'G' "GET" CALL? 00271000 BE GETTER YES 00272000 CLI OSIOTYPE,C'X' IS IT "PUTX"? 00273000 BE PUTXER YES, GO TO PUTX ROUTINE 00274000 B PUTTER NO, THEN GO TO PUT ROUTINE 00275000 SPACE 3 00276000 * 00277000 * THIS ROUTINE HANDLES DCB'S WITH DUMMY CMSCB'S 00278000 * 00279000 QSAMDUMY CLI OSIOTYPE,C'G' IS THIS A GET 00280000 BNE PUTDUMY NO, THIS IS A DUMMY PUT 00281000 MVC IOBECB(4),=XL4'4200000C' SET EOF CODE IN ECB 00282000 B CKFORERR GO TO CHECK ROUTINE 00283000 PUTDUMY TM DCBRECFM,FXD FIXED OR VAR. ? @VA04605 00284000 BO SETUPFXD GO SET UP FOR FIXED @VA04605 00284070 L R1,DCBBUFCB GET BUFFER CTRL BLOCK ADDR. @VA04605 00284140 L R1,0(R1) ADDR. OF FIRST BUFFER @VA04605 00284210 LA R1,4(R1) PLUS RDW @VA04605 00284280 B UPDRECAD UPDATE RECORD ADDR. @VA04605 00284350 SETUPFXD L R1,DCBRECAD GET ADDR. OF NEXT RECORD AREA@VA04605 00284420 L R7,DCBEOBAD GET END OF BLOCK ADDR. @VA04605 00284490 CR R1,R7 RECAD = EOBAD ? (FOR PL/1) @VA04605 00284560 BE RESETRAD YES, RESET TO START OF BLOCK@VA04605 00284630 TM DCBMACRF+1,LOC ARE WE DOING DUMMY LOCATE @VA08068 00284720 BO UPDRECAD YES THEN UPDT RECAD @VA08068 00284740 AH R1,DCBLRECL UPDATE TO NEXT RECORD @VA09543 00284750 CR R1,R7 NOW AT END OF BLOCK ? @VA04605 00284770 BNL RESETRAD YES, RESET TO START OF BLOCK @VA04605 00284840 UPDRECAD ST R1,DCBRECAD STORE NEW RECORD ADDR IN DCB @VA04605 00284910 B RETP RETURN TO USER 00285000 RESETRAD EQU * 00285100 TM DCBMACRF+1,LOC ARE WE DOING DUMMY LOCATE @VA08068 00285200 BO RETP IF YES THEN NO EOB COND @VA08068 00285300 SH R1,DCBBLKSI BACK UP TO START OF BUF @VA08068 00285400 B UPDRECAD UPDATE RECORD ADDR AND RETURN@VA04605 00285666 DROP R15 00286000 EJECT 00287000 * THE FOLLOWING CODE SIMULATES THE QSAM UPDATE (GL,PL) "PUTX" CALL 00289000 * BY MARKING THE BUFFER FOR WRITING AT THE NEXT "EOB" CONDITION ON 00290000 * A CALL TO "GET". 00291000 SPACE 00292000 PUTXER OI DCBOFLGS,PREVIOUS SET WRITE BIT @VA04694 00293000 OI IOBIOFLG,IOBUPD INDICATE "PUTX" AT NEXT "EOB" 00294000 B RETX GO TO RETURN 00295000 SPACE 00296000 * "GETXER" DOES THE ACTUAL REWRITE OF THE BLOCK AT THE NEXT "EOB" 00297000 * TIME....AND THEN RETURNS TO NORMAL GET CODE. 00298000 SPACE 00299000 GETXER DS 0H 00300000 OI IOBIOFLG,IOBOUT CHANGE TO OUTPUT 00301000 NI IOBIOFLG,255-IOBIN 00302000 OI FCBIOSW,FCBIOWR CHANGE TO WRITE 00303000 NI FCBIOSW,255-FCBIORD 00304000 LH R7,FCBITEM PICK UP FCB ITEM COUNT 00305000 N R7,HALFWORD 00306000 SH R7,FCBCOUT RESET TO 1ST RECORD OF CURRENT BLOCK 00307000 STH R7,FCBITEM UPDATE ITEM COUNT 00308000 L R14,DCBBUFCB GET ADDR. BUF. CONTROL BLOCK 00309000 L R14,0(,R14) GET ADDR. OF CURRENT BUFFER 00310000 LH R7,DCBLRECL LENGHT OF CURRENT OR NEXT RECORD 00311000 N R7,HALFWORD 00312000 LM R4,R5,DCBEOBAD ADDR. OF END OF BUFFER 00313000 MVC FCBOP(2),0(R5) ALLIGN RDW 00314000 TM FCBIOSW,FCBCLOSE DURING CLOSE? 00315000 BNO PUTXLOC NO 00316000 SR R1,R1 00317000 SR R6,R6 00318000 LR R1,R7 GET LRECL IN REG. 1 00319000 LH R6,FCBOP GET RDW 00320000 TM DCBRECFM,FXD FIXED? 00321000 BO FXCLOSE YES 00322000 AR R5,R6 ADD LRECL 00323000 SR R5,R14 GET BYTE SIZE 00324000 CH R5,=H'4' IS IT ZERO? 00325000 BE GETXEND YES, RETURN 00326000 B PUTXVB 00327000 FXCLOSE EQU * 00328000 AR R5,R1 ADD LRECL 00329000 SR R5,R14 GET RECORD LENGHT 00330000 BZ GETXEND ZERO, RETURN 00331000 TM DCBRECFM,UND UNDEFINED RECORDS? 00332000 BO PUTXBUF PUT OUT RECORD V0307 00333000 CH R5,DCBBLKSI IS BUFFER FULL? 00334000 BE UNDSIZE2 YES 00335000 LR R6,R5 SAVE RECORD LENGHT 00336000 SR R4,R4 00337000 DR R4,R7 GET FCBCOUT 00338000 STH R5,FCBCOUT STORE IT 00339000 LR R7,R6 SET LENGHT 00340000 B PUTXBUF GO WRITE IT 00341000 PUTXLOC EQU * 00342000 TM DCBOFLGS,PREVIOUS FIRST WRITE? 00343000 BO PXLOC1 NO 00344000 OI DCBOFLGS,PREVIOUS INDICATE FIRST WRITE DONE 00345000 MVC FCBBYTE+2(2),DCBLRECL SAVE LENGHT 00346000 PXLOC1 EQU * 00347000 TM DCBRECFM,BLK BLOCKED RECORDS? 00348000 BO PXLOCBLK YES 00349000 UNDSIZE2 EQU * 00350000 L R7,FCBBYTE GET LRECL 00351000 TM DCBRECFM,UND UNDEFINED? 00352000 BO PUTXBUF YES 00353000 LH R7,DCBBLKSI RECFM = UNBLOCKED 00354000 TM DCBRECFM,FXD FIXED? 00355000 BO PUTXBUF YES 00356000 MVC FCBOP+4(2),4(R14) ALLIGN RDW 00357000 LH R7,FCBOP+4 GET RDW 00358000 LA R7,4(R7,R0) ACCOUNT FOR BLOCK DESCRIPTOR 00359000 PXLOC4 EQU * 00360000 STH R7,FCBOP+4 ALLIGN BDW 00361000 MVC 0(2,R14),FCBOP+4 SET BDW 00362000 XC 2(2,R14),2(R14) ZERO OUT 2ND HALF OF BDW @VA04100 00362500 PUTXBUF EQU * 00363000 ST R7,FCBBYTE SET BLOCK LENGHT 00364000 ST R14,FCBBUFF SET BLOCK ADDR. 00365000 L R15,=V(DMSSEB) LOAD ADDR. OF EOB ROUT. 00366000 BALR R14,R15 00367000 USING *,R14 00368000 L R3,AQSAM 00369000 BAL R15,CKFORERR GO CHECK FOR ERROR 00370000 DROP R14 00371000 USING DMSSQS,R3 00372000 LH R6,FCBITEM LOAD FCBITEM COUNT 00373000 N R6,HALFWORD TO THE NEXT 00374000 AH R6,FCBCOUT BLOCK AND 00375000 STH R6,FCBITEM STORE IT 00376000 GETXEND EQU * 00377000 TM FCBIOSW,FCBCLOSE DURING CLOSE? 00378000 BO RETP YES , RETURN TO CLOSE 00379000 OI FCBIOSW,FCBIORD RESET FLAGS TO INDICATE THE 00380000 OI IOBIOFLG,IOBIN "GET" WE'RE REALLY DOING 00381000 NI FCBIOSW,255-FCBIOWR ........... 00382000 NI IOBIOFLG,255-IOBOUT-IOBUPD TURN OFF UPDATE FLAG 00383000 B GET1D GO FINISH "GET" 00384000 PXLOCBLK EQU * 00385000 TM DCBRECFM,FXD FIXED OR UNDEFINED? 00386000 BZ PXLVB NO, VARIABLE 00387000 AR R5,R7 ADD LRECL 00388000 LR R6,R5 SAVE BUFFER ADDR. 00389000 SR R5,R14 GET ACTUAL LENGHT 00390000 TM DCBRECFM,UND IS IT UNDEFUNED? 00391000 BO UNDSIZE2 YES 00392000 CH R5,DCBBLKSI RECORD LENGHT = TO BLOCK SIZE? 00393000 BE UNDSIZE2 YES 00394000 MVC 0(4,R6),=XL4'61FFFF61' SET EOF INDICATOR 00395000 CLI FCBDSMD+1,C'4' MODE 4? 00396000 BE UNDSIZE2 YES 00397000 LR R6,R5 SAVE LENGHT 00398000 SR R4,R4 00399000 DR R4,R7 GET FCBCOUT 00400000 STH R5,FCBCOUT STORE IT 00401000 LR R7,R6 GET BUFFER LENGHT 00402000 B PUTXBUF GO WRITE IT 00403000 PXLVB EQU * 00404000 AH R5,FCBOP ADD RDW FOR EOB 00405000 SR R5,R14 GET LENGHT 00406000 PUTXVB EQU * 00407000 LR R7,R5 PUT LENGHT IN REG. 7 00408000 B PXLOC4 GO PUT IT OUT 00409000 EJECT 00410000 * 00411000 * PERFORM BOOKKEEPING FOR "GET" EXECUTION 00412000 * 00413000 GETTER OI FCBIOSW,FCBIORD SIGNAL INPUTTING 00414000 OI IOBIOFLG,IOBIN SIGNAL INPUT 00415000 NI IOBIOFLG,255-IOBOUT AVOID CONFUSION 00416000 NI DCBOFLGS,255-PREVIOUS TURN OFF WRITE BIT 00417000 GET1A TM DCBMACRF,LOC LOCATE MODE? TR 00418000 BO GET1B YES. LOCATE MODE 00419000 ST R0,DEBTCBAD SET USER "MOVE-TO" ADDRESS 00420000 GET1B TM FCBIOSW,FCBCLOSE DURING CLOSE? 00421000 BNO GET1C NO 00422000 TM IOBIOFLG,IOBUPD UPDATE FLAG ON? 00423000 BO GETXER YES, GO DO "PUTX" 00424000 B RETP NO CLOSE TIME UPDATES, RETURN 00425000 GET1C LM R4,R5,DCBEOBAD A(END-OF-BLOCK), A(LAST RECORD) 00426000 AH R5,DCBLRECL A(LAST REC) + L'LAST REC = A(NEXT REC) 00427000 CR R4,R5 IF A(EOB) GT A(NEXT RECD), THEN 00428000 BNH GET1C1 NO END OF BLOCK - ELSE BRANCH @VA10035 00429050 TM DCBRECFM,VAR VARIABLE FILE ? @VA10035 00429100 BNO GOT NO , NOT EOB @VA10035 00429150 CLC FCBREAD+2(2),=XL2'0012' MINIMUM BLKSIZE ? @VA10035 00429200 BNE GOT NO,CORRECT LENGTH @VA10035 00429250 GET1C1 EQU * END OF BLOCK @VA10035 00429300 TM IOBIOFLG,IOBUPD UPDATE FLAG ON? 00430000 BO GETXER YES, EOB "PUTX" 00431000 GET1D BAL R14,SETEOB HANDLE EOB CONDITION 00432000 * FILL UP A BUFFER 00433000 * (IF RECFM=V, ALLOW FOR BDW) 00434000 GOGET EQU * GO GET A FILLED BUFFER 00435000 ST R5,FCBBUFF SET BUFFER ADDRESS FOR CMS PLIST 00436000 LH R15,DCBBLKSI GET INTENDED LENGTH OF RECORD 00437000 ST R15,FCBBYTE SET LENGTH IN CMS PLIST 00438000 L R15,=V(DMSSEB) GET V(END-OF-BLOCK ROUTINE) 00439000 BALR R14,R15 00440000 USING *,R14 00441000 L R3,AQSAM REGAIN BASE REG 00442000 DROP R14 00443000 USING DMSSQS,R3 00444000 * VERIFY COMPLETION CODE AND CLEAN ERROR CODE 00445000 LH R6,FCBITEM GET FCB ITEM COUNT 00446000 N R6,HALFWORD 00447000 AH R6,FCBCOUT ADD BLOCK JUST READ 00448000 C R6,=X'00010000' DOES COUNT OVERFLOW HALFWORD @VA09696 00448008 BL GET1E NO, CONTINUE @VA09696 00448016 XR R6,R6 CLEAR REGISTER FOR DIVIDE @VA09696 00448024 L R7,FCBREAD GET ACTUAL NUM OF BYTES READ @VA09696 00448032 LH R8,FCBRECL GET LOGICAL RECORD LENGTH @VA09696 00448040 N R8,HALFWORD CLEAR TOP OF REGISTER @VA09696 00448048 DR R6,R8 CALC ITEMS IN LAST BLOCK @VA09696 00448056 LH R6,FCBITEM PICK UP ITEM COUNT @VA09696 00448064 N R6,HALFWORD CLEAR TOP OF REGISTER @VA09696 00448072 AR R6,R7 ADD COUNT OF ITEMS JUST READ @VA09696 00448080 GET1E EQU * @VA09696 00448088 CLC DCBFDAD+5(3),=XL3'00FFF8' END OF FILE? @VA02735 00448100 BNE NOSTR NO , THEN STORE ITEM NUMBER @VA02735 00448200 TM DCBCIND2,X'80' IS THIS UPDATE MODE? @VA05025 00448230 BO NOSTR YES,THEN NO NEED TO FORCE EOF @VA05025 00448260 MVC FCBITEM,=XL2'FFF8' SET EOF FOR NEXT READ @VA02735 00448300 B STOR @VA02735 00448400 NOSTR STH R6,FCBITEM UPDATE FCB ITEM COUNT @VA02735 00449000 STOR L R6,FCBREAD GET NO BYTES READ @VA02735 00450000 AR R6,R5 ADD THIS TO CURRENT POINTER 00451000 ST R6,FCBOP ALLIGN THIS NO. 00452000 MVC DCBEOBAD+1(3),FCBOP+1 UPDATE END OF BUFFER ADDR 00453000 L R5,DCBRECAD GET ADDR OF RECORD 00454000 LA R15,GOT SET RETURN ADDR 00455000 CKFORERR EQU * 00456000 L R6,IOBECBPT GET V(IOB) 00457000 CLI 3(R6),X'00' IS ERROR CODE ZERO 00458000 BCR 8,R15 RETURN TO CALLING RTN 00459000 L R15,=V(DMSSCTCE) NOT ZERO, TAKE ERROR EXIT 00460000 L R12,=V(DMSSCTCK) GET BASE REG FOR CHECK RTN 00461000 BR R15 GO TO ERROR RTN 00462000 * PASS RECORD AND COMPUTE SOME VARIABLES 00463000 GOT EQU * EOB CONDITION SATISFIED 00464000 TM DCBRECFM,UND UNDEFINED RECORD FORMAT? 00465000 BO RUND YES 00466000 TM DCBRECFM,VAR VARIABLE RECORD FORMAT? 00467000 BO RVAR YES. 00468000 * RECORD FORMAT = "FIXED" 00469000 RFXD DS 0H 00470000 B GIVERECD (LRECL) HAS BEEN SET 00471000 * RECORD FORMAT = "UNDEFINED" 00472000 RUND DS 0H 00473000 MVC DCBLRECL(2),FCBREAD+2 SET LRECL = BLOCK READ 00474000 B GIVERECD GET SIZE FOR MOVE 00475000 * RECORD FORMAT = "VARIABLE" 00476000 RVAR DS 0H 00477000 MVC DCBLRECL(2),0(R5) SET LRECL FROM RECORD 00478000 GIVERECD EQU * PASS RECORD BACK TO USER PROGRAM 00479000 L R1,IOBECBPT GET V(IOB) @VM03048 00480000 LH R6,DCBLRECL GET LRECL @V201122 00480100 LTR R6,R6 IS IT POSITIVE @V201122 00480200 BP GETSIZE YES, CONTINUE @V201122 00480300 MVI 3(R1),8 NO, LENGTH ERROR @V201122 00480400 B CKFORERR GO TO ERROR ROUTINE @V201122 00480500 GETSIZE N R6,HALFWORD CLEAR FIRST TWO BYTES 00481000 TM DCBMACRF,LOC LOCATE MODE? 00482000 LR R1,R5 SET RECORD LOCATION 00483000 ST R5,DCBRECAD RESET VALUES 00484000 BO RETP RETURN. LOCATE MODE. 00485000 L R7,DEBTCBAD A(USER MOVE-TO LOCATION ) 00486000 LR R1,R7 USER WORKAREA FOR MOVE MODE @VA09791 00486500 BAL R14,MOVEMODE MOVE THE RECORD TO USER BUFFER 00487000 B RETP RETURN TO PROCESSING PROGRAM 00488000 EJECT 00489000 * 00490000 * MOVE THE RECORD 00491000 * 00492000 SPACE 00493000 * REGISTER ASSIGNMENTS: 00494000 * R6=L'RECORD R7=A("TO") R5=A("FROM") R14=A(RETURN) 00495000 MOVEMODE DS 0H HEAD 'EM UP; MOVE 'EM OUT! 00496000 MV1 SH R6,HALF256+2 N'BYTES-TO-BE-MOVED GT 256? 00497000 BM LT256 NO 00498000 MVC 0(256,R7),0(R5) MOVE 256 BYTES OD THE RECORD 00499000 BCR 8,R14 L'RECORD = 256 BYTES 00500000 HALF256 LA R7,256(R7,R0) INCREMENT "MOVE-TO" LOCATION 00501000 LA R5,256(,R5) INCREMENT "MOVE-FROM" LOCATION 00502000 B MV1 MOVE ANOTHER CHUNK 00503000 LT256 AH R6,HALF256+2 RESTORE THE TRUTH 00504000 BCTR R6,0 PLAY GAMES 00505000 EX R6,MOVEREC MOVE ALONG 00506000 BR R14 RETURN 00507000 MOVEREC MVC 0(*-*,R7),0(R5) MOVE THE RECORD 00508000 SPACE 3 00509000 * 00510000 * "END-OF-BLOCK" CONDITIONS EXIST. GET NEW BUFFER FROM POOL. 00511000 * 00512000 * UPON ENTRY: 00513000 * C(DCBBUFCB)=A(BUFCB) BUFCB: A(CURRENT BUFFER),H'BUFNO',H'BUFL' 00514000 * C(IOBNXTAD)=A(NEXT VALID BUFFER TO-BE-USED) 00515000 * C(IOBSTART)=X'ID OF NEXT BUFFER',AL3(INITIAL BUFFER IN BLOCK) 00516000 * DURING: 00517000 * THE "NEXT" BUFFER BECOMES THE "CURRENT" BUFFER. 00518000 * THE "CURRENT" BUFFER + BUFL = "NEXT" BUFFER. 00519000 * THE ID + 1 = THE ID OF THE "NEXT" BUFFER THAT WILL BE USED. 00520000 * IF ID > BUFNO, ID IS SET = 1; AND C(IOBNXTAD)=C(IOBSTART). 00521000 SETEOB DS 0H GET NEW BUFFER 00522000 L R7,DCBBUFCB GET V(BUFFER CONTROL BLOCK) 00523000 SR R10,R10 00526000 IC R10,IOBSTART GET N'BUFFER TO BE USED 00527000 LR R4,R10 GET NO. OF BUFFER V0206 00527100 BCTR R4,R0 PREPARE FOR MULTIPLY V0206 00527200 MH R4,DCBBUFL GET RELATIVE ADDR OF BUFFER V0206 00527300 L R5,IOBSTART GET ADDR OF START OF BUFFER V0206 00527400 LA R5,0(R4,R5) GET ACTUAL ADDR OF BUFFER V0206 00527500 ST R5,DCBRECAD SET A(NEXT BUFFER AS NEXT RECORD) 00528000 ST R5,0(,R7) SET A(BUFFER TO BE USED) INTO BUFCB 00529000 LR R0,R5 00530000 AH R0,DCBBUFL GET A(END BUFF+1)=A(NEXT BUFFER) 00531000 LR R4,R0 SET A(END-OF-BUFFER TO BE USED) 00532000 ST R4,FCBOP 00533000 MVC DCBEOBAD+1(3),FCBOP+1 00534000 HALF1 LA R10,1(R10,R0) GET N'NEXT BUFFER IN CHAIN TO BE USED 00536000 CH R10,4(,R7) HAS BUFNO BEEN EXCCEDED? 00537000 BNH SET1 NO. DO NOT RESET CHAIN OF BUFFERS 00538000 LA R10,1 NEXT BUFF WILL BE FIRST BUFF IN POOL 00539000 SET1 STC R10,IOBSTART SET N'NEXT BUFFER = 1. 00541000 TM DCBRECFM,FXD RECFM=FXD,UND? 00542000 BCR 1,R14 YES 00543000 XC 0(8,R5),0(R5) CLEAR BDW AND RDW @VA12285 00543500 LA R5,4(,R5) VAR. SKIP OVER BDW 00544000 ST R5,DCBRECAD RESET RECAD 00545000 SH R5,HALF4+2 00546000 BR R14 00547000 * 00548000 * RETURN TO PROCESSING PROGRAM 00549000 * 00550000 RETP EQU * HATE TO SEE YA GO.... 00551000 ST R1,24(,R13) 00552000 RETX EQU * 00553000 LM R14,R12,12(R13) RESTORE REGISTERS 00554000 BR R14 00555000 EJECT 00556000 * 00557000 * QSAM SIMULATION OF A MARVELOUS "PUT" FUNCTION 00558000 * 00559000 PUTTER OI IOBIOFLG,IOBOUT SIGNAL OUTPUT 00560000 NI IOBIOFLG,255-IOBIN AVOID CONFUSION 00561000 OI FCBIOSW,FCBIOWR SIGNAL OUTPUTTING 00562000 PUT1A L R14,DCBBUFCB GET A(BUFFER CONTROL BLOCK) 00563000 L R14,0(,R14) GET A(CURRENT BUFFER) 00564000 LH R7,DCBLRECL L'CURRENT OR NEXT RECORD 00565000 N R7,HALFWORD 00566000 LM R4,R5,DCBEOBAD A(END-OF-BUFFER) 00567000 LA R4,0(,R4) CLEAR HIGH ORDER BYTE V0206 00567100 MVC FCBOP(2),0(R5) ALLIGN RDW 00568000 TM FCBIOSW,FCBCLOSE DURING CLOSING? 00569000 BNO CKMODE NO, GO CHECK MODE 00570000 SR R1,R1 ZERO REG 1 00571000 SR R6,R6 ZERO REG 6 00572000 TM DCBMACRF+1,LOC LOCATE MODE? 00573000 BZ CKRECFM NO, CHECK RECFM 00574000 TM DCBRECFM,VAR RECFM= VAR OR UND? V0206 00574100 BNO FXDCLOSE NO, DON'T ADD TO RECAD V0206 00574200 LR R1,R7 GET LRECL 00575000 LH R6,FCBOP GET RDW 00576000 CKRECFM TM DCBRECFM,FXD RECFM FIXED? 00577000 BO FXDCLOSE YES 00578000 AR R5,R6 ADD LRECL IF ANY 00579000 SR R5,R14 GET BYTE SIZE 00580000 CH R5,=H'4' IS SIZE EQUAL TO FOUR 00581000 BE RETP YES, THEN RETURN 00582000 B PUTVB PUT BLOCK 00583000 FXDCLOSE AR R5,R1 ADD LRECL IF ANY 00584000 LR R6,R5 SAVE BUFFER ADDR 00585000 SR R5,R14 GET RECORD LENGTH 00586000 BZ RETP IF ZERO RETURN 00587000 TM DCBRECFM,UND IF RECFM UNDEFINED, WRITE RECORD 00588000 BO UNDSIZE YES, WRITE RECORD @VA14923 00589110 CH R5,DCBBLKSI IS BUFFER FULL 00590000 BE UNDSIZE YES, WRITE RECORD 00591000 MVC 0(4,R6),=XL4'61FFFF61' SET EOF INDICATOR 00592000 CLI FCBDSMD+1,C'4' IS THIS A P4 FILE 00593000 BE UNDSIZE YES, WRITE RECORD 00594000 LR R6,R5 SAVE LENGTH 00595000 SR R4,R4 ZERO REG 4 00596000 DR R4,R7 GET FCBCOUT 00597000 STH R5,FCBCOUT FILL IN FCBCOUT 00598000 LR R7,R6 GET BUFFER LENGTH 00599000 B PUTBUF WRITE BUFFER 00600000 CKMODE EQU * 00601000 TM DCBMACRF+1,LOC LOCATE MODE? 00602000 BZ PUTMOVE NO. MOVE MODE 00603000 PUTLOC EQU * QSAM-PUT-LOCATE. HAVE FUN! 00604000 TM DCBOFLGS,PREVIOUS IS THIS THE FIRST PUT EVER? 00605000 BO PLOC1 NO. THERE HAVE BEEN OTHERS 00606000 OI DCBOFLGS,PREVIOUS INDICATE THIS OUTPUT 00607000 CR R5,R4 IS BUFFER FULL V0206 00608000 BL SAVELREC NO, RETURN TO CALLER V0206 00608100 PLOC1 TM DCBRECFM,BLK SUBSEQUENT PUTS. BLOCK RECORDS? 00609000 BO PLOCBLK YES. 00610000 UNDSIZE L R7,FCBBYTE GET LRECL OF UND RECORD 00611000 PLOCUBLK EQU * UNBLOCKED. EOB EXISTS AFTER EVERY PUT 00612000 TM DCBRECFM,UND IS RECFM UNDEFINED 00613000 BNO NOUND NO, CONTINUE @VA03362 00614100 LR R15,R14 GET A(CURRENT BUFFER) @VA03362 00614200 SR R15,R4 LESS PREV. BUFFER @VA03362 00614300 LTR R15,R15 CORRECT BUFFER? @VA03362 00614400 BM PUTBUF NO,THEN PUT AS IS @VA03362 00614500 SR R7,R15 CALCULATE UNDEF. LENGTH @VA03362 00614600 B PUTBUF PUT THAT BUFFER @VA03362 00614700 NOUND LH R7,DCBBLKSI FOR RECFM=UNBLOCKED @VA03362 00614800 TM DCBRECFM,FXD RECFM=FIXED/UNDEFINED 00616000 BO PUTBUF YES. GO OUTPUT PREVIOUS RECORD 00617000 XC BD6(RDRES,R14),BD6(R14) ZERO 2 BYTES OF RDW @VA06228 00617500 PLOC3 MVC FCBOP+4(2),4(R14) ALLIGN RDW 00618000 LH R7,FCBOP+4 GET RDW 00619000 HALF4 LA R7,4(R7,R0) ACCOUNT FOR BLOCK-DESCRIPTOR-WORD 00620000 PLOC4 STH R7,FCBOP+4 ALLIGN BDW 00621000 MVC 0(2,R14),FCBOP+4 SET BDW 00622000 XC 2(2,R14),2(R14) ZERO OUT 2ND HALF OF BDW @VA04100 00622500 PUTBUF EQU * OUTPUT CURRENT FILLED BLOCK 00623000 ST R7,FCBBYTE SET BLOCK LENGTH FOR CMS PLIST 00624000 ST R14,FCBBUFF SET BLOCK LOCATION 00625000 PUT2 L R15,=V(DMSSEB) GET V(END-OF-BLOCK ROUTINE) 00626000 BALR R14,R15 00627000 USING *,R14 00628000 L R3,AQSAM REGAIN ADDRESSABILITY 00629000 BAL R15,CKFORERR CHECK FOR ERROR 00630000 DROP R14 00631000 USING DMSSQS,R3 00632000 LH R6,FCBITEM GET FCB ITEM COUNT 00633000 N R6,HALFWORD 00634000 AH R6,FCBCOUT ADD BLOCK JUST WRITTEN 00635000 STH R6,FCBITEM UPDATE ITEM COUNT 00636000 TM FCBIOSW,FCBCLOSE DURING CLOSING? 00637000 BO RETP YES, RETURN 00638000 BAL R14,SETEOB GET FRESH BUFFER 00639000 SAVELREC MVC FCBBYTE+2(2),DCBLRECL SAVE LRECL OF THIS PUT 00640000 TM FCBIOSW,FCBPVMB PUT-MOVE-VAR-BLK? 00641000 BO PVMB2 YES 00642000 LR R1,R5 GET RETURN BUFFER ADDR V0206 00642050 TM DCBRECFM,VAR RECFM= VAR OR UND V0206 00642100 BO PUTRET RETURN TO CALLER V0206 00642150 TM DCBMACRF+1,LOC IS THIS A PUT LOCATE V0206 00642200 BZ RETP NO, RETURN TO CALLER V0206 00642250 AH R5,DCBLRECL POINT RECAD TO NEXT RECORD ADDR V0206 00642300 ST R5,DCBRECAD SET RECORD ADDRESS POINTER V0206 00642350 B RETP RETURN TO CALLER V0206 00642400 PUTLRET EQU * @VA09591 00642550 SR R5,R7 ADDRESS(END OF CURRENT RECORD) @VA09591 00642700 XC 0(4,R5),0(R5) CLEAR NEXT POSSIBLE RDW @VA09591 00642850 PUTRET EQU * RETURN TO PROCESSING PROGRAM 00643000 L R1,DCBRECAD GET A(BUFFER FOR NEXT RECORD) 00644000 B RETP 00645000 PLOCBLK EQU * BLOCKED. VERIFY EOB CONDITIONS 00646000 TM DCBRECFM,FXD FIXED/UNDEFINED? 00647000 BZ PLVB NO. VARIABLE. 00648000 PLFB EQU * PUT-LOCATE-BLOCKED-FIXED/UNDEFINED 00649000 LR R1,R5 SETUP RETURN REG V0213 00649100 AR R5,R7 A(LAST REC)+L'LAST REC=A(NEXT REC) 00650000 ST R5,DCBRECAD SET A(NEXT RECORD) 00651000 CR R4,R5 VERIFY THAT NEXT REC FITS CURRENT BUF 00653000 BNL RETP RETURN TO CALLER V0213 00654000 PLOC2 LH R7,DCBBLKSI USE BLOCK SIZE FOR 00655000 B PUTBUF NO. PUT THIS BUFF; THEN EOB 00656000 PLVB EQU * PUT-LOCATE-BLOCKED-VARIABLE 00657000 XC RD2(RDRES,R5),RD2(R5) ZERO 2 BYTES OF RDW @VA06228 00657500 AH R5,FCBOP ADD RDW 00658000 ST R5,DCBRECAD SET A(NEXT RECORD) 00659000 AR R5,R7 A(NEXT REC)+EST L'NEXT REC=A(NEXT+1 REC) 00660000 CR R4,R5 VERIFY THAT NEXT REC FITS CURR BUF 00661000 BNL PUTLRET YES, NEXT RECORD WILL FIT @VA09591 00662000 SR R5,R7 GET A(END-OF-CURRENT BUFFER) 00663000 SR R5,R14 GET L'BUFFER FOR BDW 00664000 PUTVB EQU * 00665000 LR R7,R5 00666000 B PLOC4 PUT BLOCK / EOB 00667000 PUTMOVE EQU * QSAM-PUT-MOVE 00668000 OI DCBOFLGS,PREVIOUS INDICATE LSAT OPERATION OUTPUT 00669000 ST R0,DEBTCBAD SAVE USERS V(BUFFER) 00670000 TM DCBRECFM,BLK BLOCKED? 00671000 BO PMOVBLK YES. 00672000 PMOVUBLK EQU * UNBLOCKED. EOB ON EVERY PUT 00673000 TM DCBRECFM,FXD RECFM=FIXED/UNDEFINED? 00674000 BZ PMVU NO. VARIABLE. 00675000 PMFU EQU * PUT-MOVE-UNBLOCKED-FIXED/UNDEFINED 00676000 LR R6,R7 00677000 LR R7,R5 00678000 LR R5,R0 00679000 LR R0,R14 00680000 BAL R14,MOVEMODE MOVE RECORD INTO BUFFER 00681000 LR R14,R0 00682000 LH R7,DCBLRECL GET LRECL OF RECORD 00683000 TM DCBRECFM,UND RECFM=UNDEFINED? @VA03362 00684100 BO PUTBUF YES, THEN PUT BUFFER @VA03362 00684200 B NOUND NO, NOT UNDEFINED @VA03362 00684300 PMVU EQU * PUT-MOVE-UNBLOCKED-VARIABLE 00685000 LR R7,R5 R7=A(RECAD)=A("TO") 00686000 LR R5,R0 A(FROM BUFFER) 00687000 MVC FCBOP(2),0(R5) ALLIGN RDW 00688000 LH R6,FCBOP GET RDW 00689000 N R6,HALFWORD 00690000 LR R0,R14 00691000 BAL R14,MOVEMODE MOVE RECORD 00692000 LR R14,R0 00693000 XC BD6(RDRES,R14),BD6(R14) ZERO 2 BYTES OF RDW @VA06228 00693500 MVC FCBOP+4(2),4(R14) ALLIGN RDW 00694000 LH R6,FCBOP+4 GET RDW 00695000 LA R6,4(,R6) ACCOUNT FOR THE BDW 00696000 STH R6,FCBOP+4 ALLIGN BDW 00697000 MVC 0(2,R14),FCBOP+4 SET BDW 00698000 XC 2(2,R14),2(R14) ZERO OUT 2ND HALF OF BDW @VA04100 00698500 LR R7,R6 00699000 B PUTBUF PUT CURRENT BUFFER/EOB 00700000 PMOVBLK EQU * QSAM-PUT-MOVE-BLOCKED 00701000 TM DCBRECFM,FXD RECFM=FIXED/UNDEFINED? 00702000 BZ PVMB NO. VARIABLE. 00703000 PFMB EQU * PUT-MOVE-BLOCKED-FIXED/UNDEFINED 00704000 LR R6,R7 GET L'RECORD (=DCBLRECL) 00705000 LR R7,R5 A(TO) (=DCBRECAD, A OF NEXT REC) 00706000 LR R5,R0 A(FROM) 00707000 LR R0,R14 00708000 BAL R14,MOVEMODE MOVE THEE RECORD. IT WILL ALWAYS FIT. 00709000 LR R14,R0 00710000 L R5,DCBRECAD A(CURRENT RECORD) 00711000 AH R5,DCBLRECL A(NEXT RECORD) 00712000 ST R5,DCBRECAD FILL IN RECORD ADDR 00713000 AH R5,DCBLRECL ADD LRECL 00714000 CR R4,R5 VERIFY THAT NEXT REC FITS CURR BUF 00715000 BNL PUTRET YES. BUFF WILL ACCOMMODATE NEXT REC 00716000 B PLOC2 PUT BUFFER/EOB 00717000 PVMB EQU * PUT-MOVE-BLOCKED-VARIABLE 00718000 LR R7,R0 A(USER RECORD, RDW) 00719000 MVC FCBOP(2),0(R7) ALLIGN RDW 00720000 AH R5,FCBOP ADD RDW 00721000 CR R4,R5 VERIFY FITAGE INTO CURRENT BUFFER 00722000 ST R5,DCBRECAD SET A(NEXT RECORD) 00723000 BNL PVMB1 IT FITS. MOVE INTO BUFFER. 00724000 SH R5,FCBOP SUBTRACR RDW 00725000 SR R5,R14 A(END LAST REC)-A(BUFFER)=LL OF BDW 00726000 OI FCBIOSW,FCBPVMB SIGNAL PUT-MOVE-VAR-BLK 00727000 B PUTVB PUT BUFFER 00728000 PVMB2 NI FCBIOSW,255-FCBPVMB 00729000 LA R7,4(R5) SKIP OVER BDW 00730000 LR R14,R7 SAVE RECORD ADDR 00731000 L R5,DEBTCBAD GET ADDR OF USER RECORD 00732000 MVC FCBOP(2),0(R5) ALLIGN RDW 00733000 LH R6,FCBOP GET RDW 00734000 AR R14,R6 GET ADDR FOR NEXT RECORD 00735000 LR R1,R7 GET ADDR OF OUTPUT BUFFER @VA03887 00735100 ST R14,DCBRECAD SET ADDR OF NEXT RECORD 00736000 BAL R14,MOVEMODE MOVE THE RECORD *** 00737000 XC RD2(RDRES,R1),RD2(R1) ZERO 2 BYTES OF RDW @VA06228 00737500 B RETP LEAVE US @VA03887 00738100 PVMB1 EQU * RECORD WILL FIT INTO CURRENT BUFFER 00739000 LH R6,FCBOP GET RDW 00740000 LR R7,R5 A(TO) (=DCBRECAD) 00741000 SR R7,R6 GET RECORD ADDR 00742000 LR R5,R0 A(FROM) 00743000 LR R1,R7 GET ADDR OF OUTPUT BUFFER @VA03887 00743100 BAL R14,MOVEMODE 00744000 XC RD2(RDRES,R1),RD2(R1) ZERO 2 BYTES OF RDW @VA06228 00745000 B RETP LEAVE US @VA03887 00745100 EJECT 00746000 * 00747000 * SOME VALUES FOR THE CAUSE 00748000 * 00749000 SPACE 00750000 AQSAM DC A(DMSSQS) BASE ADDRESS 00751000 HALFWORD DC F'65535' CONSTANT X'0000FFFF' @VA06228 00751200 RDRES EQU 2 RESERVED BYTES OF RDW @VA06228 00751400 RD2 EQU 2 RDW+2 FOR BLOCKED RECORDS @VA06228 00751600 BD6 EQU 6 BDW+6 FOR UNBLOCKED RECORDS @VA06228 00751800 LTORG 00752100 EJECT 00753000 PRINT GEN 00754000 * 00755000 * PRESENTING THE DUMMIES ... 00756000 * 00757000 SPACE 00758000 IO 00759000 EJECT 00760000 NUCON 00761000 EJECT 00762000 DCBD DSORG=(PS) 00763000 EJECT 00764000 CMSCB 00765000 EJECT 00766000 EJECT 00767000 REGEQU 00768000 END 00769000