ibm:vm370-lib:cms:dmssqs.assemble_src
Table of Contents
DMSSQS Source
References
- Fixes Applied : 7
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R14923DS]
Source Listing
- DMSSQS.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmssqs.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator