ibm:vm370-lib:cms:dmssbs.assemble_src
Table of Contents
DMSSBS Source
References
- Fixes Applied : 6
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R15172DS]
Source Listing
- DMSSBS.ASSEMBLE.txt
- SBS TITLE 'DMSSBS (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * 00004000
- * MODULE NAME: 00005000
- * 00006000
- * DMSSBS (DMSSBS - BASIC SEQUENTIAL ACCESS METHOD) 00007000
- * 00008000
- * FUNCTION: 00009000
- * 00010000
- * THE CMS BSAM ROUTINE PROCESSES SEQUENTIAL READ AND 00011000
- * WRITE MACROES. 00012000
- * 00013000
- * ATTRIBUTES: 00014000
- * 00015000
- * REENTRANT, NUCLEUS RESIDENT 00016000
- * 00017000
- * ENTRY POINTS: 00018000
- * 00019000
- * DMSSBS - OS READ OR WRITE MACRO 00020000
- * DMSSBSRT - ERROR RETURN FROM CALL TO DMSSBD 00021000
- * 00022000
- * ENTRY CONDITIONS: 00023000
- * 00024000
- * UPON ENTRY: 00025000
- * R1 = V(DECB) 00026000
- * R13 = V(SAVEAREA) 00027000
- * R14 = V(RETURN) 00028000
- * R15 = V(DMSSBS) 00029000
- * 00030000
- * MUST BE CALLED BY OS READ OR WRITE MACRO. 00031000
- * 00032000
- * EXIT CONDITIONS: 00033000
- * 00034000
- * THE DMSSBS ROUTINE PASSES CONTROL BACK TO THE USER 00035000
- * WITH THE FOLLOWING ERROR CODES IN THE ECB AND A ZERO 00036000
- * IN REGISTER 15: 00037000
- * 00038000
- * ECB CODE REGISTER 15 00039000
- * 00040000
- * SUCCESSFUL COMPLETION 7F 0 00041000
- * UNSUCCESSFUL COMPLETION 42 0 00042000
- * END OF EXTENT 7F 8 00043000
- * @VA11908 00044000
- * IF A BDAM/BSAM WRITE IS ATTEMPTED TO A CMS DISK IN @VA11908 00044100
- * READ-ONLY MODE, MESSAGE DMSSBS120S IS ISSUED WITH A @VA11908 00044200
- * R/C '012' , FOLLOWED BY AN ABEND 001. @VA11908 00044300
- * @VA11908 00044400
- * @VA11908 00044500
- * CALLS TO OTHER ROUTINES: 00044600
- * 00046000
- * DMSSBD, DMSSVT, DMSSEB, DMSTIO 00047000
- * 00048000
- * EXTERNAL REFERENCES: 00049000
- * 00050000
- * NUCON, FCBSECT, IHADECB, IHADCB, OPSECT 00051000
- * 00052000
- * TABLES/WORKAREAS: 00053000
- * 00054000
- * NONE. 00055000
- * 00056000
- * REGISTER USAGE: 00057000
- * 00058000
- * R1 - DECB 00059000
- * R2 - DCB 00060000
- * R3 - BASE 00061000
- * R8 - OPSECT 00062000
- * R11 - FCB 00063000
- * R0,R4-R7,R9,R10,R12,R14,R15 - WORK 00064000
- * R13 - SAVE AREA 00065000
- * 00066000
- * OPERATION: 00067000
- * 00068000
- * THE CMS BSAM ROUTINE IS CALLED BY AN OS READ OR WRITE 00069000
- * MACRO. IT CHECKS DCBFDAD TO SEE IF THE FIRST BYTE IS 00070000
- * A P. IF SO, THE CONTENTS OF THE LAST TWO BYTES OF 00071000
- * DCBFDAD ARE INCREMENTED BY ONE AND STORED IN FCBITEM. 00072000
- * IF P IS SPECIFIED AND THE DEVICE IS A TAPE, DMSTIO 00073000
- * IS USED TO BACKSPACE OR FORWARD SPACE TO THE SPECIFIED 00074000
- * ITEM. NEXT THE FCB DUMMY OPTION IS CHECKED. IF IT 00075000
- * IS SPECIFIED, HEX '4200000C' (EOF ERROR) OR HEX '7F000000' 00076000
- * (NO ERROR) IS STORED IN THE ECB, DEPENDING ON WHETHER A 00077000
- * READ OR WRITE WAS ISSUED, AND CONTROL IS RETURNED TO THE 00078000
- * USER. IF THE FCB DUMMY OPTION IS NOT SPECIFIED, THE 00079000
- * DSORG OPTION IS CHECKED. 00080000
- * 00081000
- * . IF THE DSORG OPTION IN THE DCB IS DA (DIRECT 00082000
- * ACCESS), CONTROL IS GIVEN TO THE 00083000
- * DMSSBD ROUTINE TO 00084000
- * CONVERT THE RECORD IDENTIFICATION INTO AN ITEM NUMBER 00085000
- * AND PROCESS 00086000
- * ANY KEYS USED. IF DMSSBD COMPLETES SUCCESSFULLY, 00087000
- * CONTROL IS RETURNED TO DMSSBS. 00088000
- * OTHERWISE, CONTROL IS RETURNED TO THE USER WITH AN 00089000
- * ERROR CODE. 00090000
- * 00091000
- * . IF THE DSORG OPTION IN THE DCB IS PO (PARTITIONED 00092000
- * ORGANIZATION) AND A WRITE IS SPECIFIED AND THE FCBPDS 00093000
- * ENTRY IS ZERO, CONTROL IS PASSED TO THE PDSSAVE 00094000
- * ROUTINE 00095000
- * IN DMSSVT 00096000
- * TO SAVE THE DIRECTORY OF THE PDS (PARTITIONED DATA 00097000
- * SET) AND POINT THE FCB FILE ITEM NUMBER TO A FREE 00098000
- * MEMBER SLOT. IF PDSSAVE COMPLETES SUCCESSFULLY, 00099000
- * CONTROL IS RETURNED TO DMSSBS. OTHERWISE, CONTROL IS 00100000
- * RETURNED TO THE USER WITH AN ERROR CODE. 00101000
- * 00102000
- * . IF THE DSORG OPTION IN THE DCB IS PS (PHYSICAL 00103000
- * SEQUENTIAL) AND THE MACRF OPTION IS WL (CREATE A BDAM 00104000
- * DATA SET)*, AN EIGHT IS PUT IN REGISTER 15 AND A 00105000
- * CHECK IS MADE TO SEE IF END OF EXTENT HAS BEEN 00106000
- * REACHED. IF SO, CONTROL IS RETURNED TO THE USER. IF 00107000
- * NOT, REGISTER 15 IS SET TO ZERO AND A CHECK IS MADE 00108000
- * OF THE OPTION SPECIFIED IN THE WRITE MACRO'S DECB. 00109000
- * IF SZ IS SPECIFIED AND THE KEYLENGTH IS ZERO, 00110000
- * CONTROL IS RETURNED TO THE USER WITH A HEX '7F' 00111000
- * IN THE ECB. IF SD OR SZ IS SPECIFIED AND THE 00112000
- * KEYLENGTH IS NONZERO, DMSSBD IS CALLED TO WRITE 00113000
- * 256 DUMMY KEYS AND 00114000
- * UPON RETURN FROM DMSSBD CONTROL IS PASSED BACK 00115000
- * TO THE USER WITH A HEX '7F' IN THE ECB. IF SD IS 00116000
- * IS SPECIFIED AND THE KEYLENGTH IS ZERO, A KEY OF X'FF' IS 00117000
- * PUT IN THE DATA AREA AND DMSSBS PROCESSES THE DATA AS A 00118000
- * NORMAL WRITE. IF SF IS 00119000
- * SPECIFIED, A HEX '7F' IS STORED IN THE ECB AND IF THE 00120000
- * KEYLENGTH IS NOT ZERO 00121000
- * DMSSBD IS CALLED TO PROCESS A KEY. IF THE DMSSBD 00122000
- * ROUTINE 00123000
- * AND/OR THE CHECK FOR VALID OPTIONS IS COMPLETED 00124000
- * SUCCESSFULLY DMSSBS BEGINS FILLING IN THE IOB AND THE 00125000
- * I/O PLIST. OTHERWISE CONTROL IS RETURNED TO THE 00126000
- * USER WITH A HEX '42' IN THE ECB, DENOTING AN ERROR. 00127000
- * 00128000
- * . IF THE DSORG OPTION IN THE DCB IS PS OR PO AND A 00129000
- * NONZERO KEYLENGTH IS SPECIFIED AND THE MACRF OPTION IS 00130000
- * NOT WL, DMSSBD IS CALLED TO READ OR WRITE A KEY. IF 00131000
- * DMSSBD COMPLETES SUCCESSFULLY, DMSSBS BEGINS FILLING 00132000
- * IN THE I/O PLIST. IF NOT, CONTROL IS RETURNED TO 00133000
- * THE USER WITH A HEX '42' IN THE ECB. 00134000
- * 00135000
- * . AFTER THE NECESSARY CHECKS AND CALLS FROM DMSSBD 00136000
- * AND PDSSAVE ARE MADE, DMSSBS FILLS IN THE IOBIOFLG 00137000
- * BIT, THE IOTYPE BYTE, THE DCBOFLGS BIT, THE BUFFER 00138000
- * LENGTH, THE BUFFER 00139000
- * ADDRESS, THE DECB I/O STARTED BIT, THE IOB POINTER IN 00140000
- * THE DECB AND THE ECB POINTER IN THE IOB. 00141000
- * CONTROL IS THEN PASSED TO THE DMSSEB ROUTINE TO DO 00142000
- * THE I/O AND FILL IN THE ECB. 00143000
- * AFTER CONTROL IS PASSED BACK TO DMSSBS FROM DMSSEB, 00144000
- * CONTROL IS PASSED BACK TO THE USER. 00145000
- * 00146000
- * * IF THE WL (CREATE A BDAM DATA SET) OPTION IS 00147000
- * SPECIFIED, THE NUMBER OF RECORDS IN THE DATA SET 00148000
- * EXTENT MUST BE SPECIFIED USING THE FILEDEF 00149000
- * COMMAND. THE DEFAULT SIZE IS 50 RECORDS. 00150000
- * 00151000
- * 00152000
- * 00153000
- * 00154000
- *. 00155000
- EJECT 00156000
- * 00157000
- * 00158000
- DMSSBS START 0 COMMON ENTRY POINT 00159000
- ENTRY DMSSBSRT 00160000
- SPACE 00161000
- BDAMREAD EQU X'08' 00162000
- BSAMREAD EQU X'80' 00163100
- UPDT EQU X'80' UPDATE MODE 00163200
- SLNGTH EQU X'80' 00165000
- WL EQU X'28' 00166000
- WRSZ EQU X'04' 00167000
- WRSDSZ EQU X'14' 00168000
- WRSD EQU X'10' 00169000
- CHNGBYTE EQU X'0E' 00170000
- *********************************************************************** 00171000
- SPACE 00172000
- STM R14,R12,12(R13) SAVE REGS 00173000
- LR R3,R15 00174000
- USING DMSSBS,R3 00175000
- USING NUCON,R0 00176000
- USING FCBSECT,R11 00177000
- USING IHADECB,R1 00178000
- USING IHADCB,R2 00179000
- USING OPSECT,R8 00180000
- EJECT 00181000
- * 00182000
- * BASIC SEQUENTIAL ACCESS METHOD, SIMULATION THEREOF ... 00183000
- * 00184000
- SPACE 00185000
- L R8,AOPSECT 00186000
- L R2,DECDCBAD GET V(DCB) 00187000
- L R11,DCBDEBAD GET ADDR OF DEB IN FCB 00188000
- SH R11,=AL2(IHADEB-FCBINIT) GET ADDR OF FCB 00189000
- L R14,DCBIOBA GET ADDR OF IOB 00190000
- L R14,0(R14) GET ADDR OF NEXT IOB IN CHAIN 00191000
- ST R14,DCBIOBA UPDATE DCB IOB PTR 00192000
- ST R1,IOBBECBP(R14) SET ECB ADDR IN IOB 00193000
- LA R14,8(,R14) GET ADDR OF IHAIOB 00194000
- L R15,DECIOBPT GET ADDR OF IOB V0206 00195000
- ST R14,DECIOBPT SET ADDR OF IHAIOB IN DECB @VA04367 00196000
- NI IOBIOFLG,255-IOBIN-IOBOUT TURN OFF I/O BITS @VA04367 00197000
- TM DCBDSORG,PO PARTITIONED DATA? @VA04367 00198000
- BZ KEPGO NO, TRANSFER @VA04367 00199000
- NI DCBCIND2,255-UPDT TURN OFF STOW/UPDATE BIT @VA04367 00200000
- * (STOW FOR PO) 00201000
- EJECT 00202000
- KEPGO SR R5,R5 INDICATE NO POINT @VA04367 00203000
- TM DCBDSORG,DA BDAM DATA SET ? @VA05079 00204000
- BO CKFORDA YES, SKIP POINT CHECK @VA05079 00205000
- CLI DCBFDAD,C'P' WAS A POINT ISSUED 00206000
- BNE CKFORDA NO, GO CHECK DSORG 00207000
- TM FCBINIT,FCBOS IS THIS AN OS IO REQUEST@VM28920 00208000
- BO CHNGITEM YES, IGNORE POINT @VM28920 00209000
- * 00210000
- * IF A POINT WAS ISSUED, UPDATE DISK OR TAPE POINTER 00211000
- * 00212000
- MVC FCBOP+1(3),DCBFDAD+5 ALLIGN ITEM NO. 00213000
- L R5,FCBOP GET ITEM NO. 00214000
- LA R5,1(R5) ADD ONE 00215000
- CLI FCBDEV,FCBTAP IS DEVICE TAPE 00216000
- BE SPACETAP YES, SPACE TAPE @VA01052 00217000
- C R5,=F'65529' EOF POINTER? @VA01052 00218000
- BNE CHNGITEM NO, CONTINUE @VA01052 00219000
- LA R15,12 SET EOF CODE @VA01052 00220000
- XC DCBFDAD(8),DCBFDAD CLEAR DCB EOF POINTER @VA10855 00220500
- B BSAMDUMY DON'T CHANGE ITEM NO. @VA01052 00221000
- SPACETAP EQU * @VA01052 00222000
- MVC TAPEOPER(8),=CL8'BSR' SET OP CODE TO BACKSPACE 00223000
- LH R4,FCBTBSP GET NUM RECORDS BACKSPACED @VA04853 00224000
- SR R0,R0 CLEAR A REGISTER @VA04853 00225000
- STH R0,FCBTBSP CLEAR BACKSPACE COUNT @VA04853 00226000
- LTR R4,R4 ARE THERE ANY RECORDS? @VA04853 00227000
- BNZ SETDEV BRANCH IF SO @VA04853 00228000
- LH R4,FCBITEM GET CURRENT ITEM NO. 00229000
- N R4,HALFWORD CLEAR FIRST HALF OF REGISTER 00230000
- SR R4,R5 GET NO. OF RECORDS IN MOVE 00231000
- BZ CHNGITEM IF ZERO, NO MOVE 00232000
- BP SETDEV IF PLUS, MOVE BACKWARDS 00233000
- LPR R4,R4 SET NO. POSITIVE 00234000
- MVI TAPEOPER,C'F' SET TO FORWARD SPACE 00235000
- SETDEV MVC TAPEDEV(4),FCBDSNAM GET DEVICE NAME 00236000
- MVC TAPEMASK(1),FCBMODE SET TAPE MODE 00237000
- LR R6,R1 SAVE DECB ADDR 00238000
- LA R1,TAPELIST GET ADDR OF PLIST 00239000
- MOVETAPE SVC 202 MOVE TAPE 00240000
- DC AL4(*+4) 00241000
- BCT R4,MOVETAPE KEEP MOVING TAPE 00242000
- LR R1,R6 RESTORE DECB ADDR 00243000
- CHNGITEM STH R5,FCBITEM SET NEW ITEM NO. 00244000
- XC DCBFDAD(8),DCBFDAD CLEAR DCBFDAD 00245000
- CKFORDA EQU * 00246000
- * 00247000
- * DETERMINE I/O TYPE AND RECFM DATA SET CHARACTERISTICS 00248000
- * 00249000
- CLI FCBDEV,0 IS THIS A DUMMY FILE 00250000
- BE BSAMDUMY YES, GO TO DUMMY ROUTINE 00251000
- EJECT 00252000
- TM DCBDSORG,DA DIRECT ACCESS ORGANIZATION? 00253000
- BO DIRECT YES, CALL BDAM 00254000
- TM DECTYPE,SLNGTH IS S SPECIFIED FOR LENGTH 00255000
- BNO CKFORRD NO, CHECK READ SWITCH 00256000
- MVC DECLNGTH(2),DCBBLKSI YES, GET IT FROM DCB 00257000
- CKFORRD TM DECTYPE+1,BSAMREAD IS THIS A READ 00258000
- BNO CKUPDT NO, DO WRITE CHECKS P3040 00259000
- MVC IOBBCSW+2(2,R14),FCBITEM SAVE ITEM NO. IN IOB V0206 00260000
- OI IOBIOFLG,IOBIN SET INPUT FLAG V0017 00261000
- CLI DCBKEYLE,0 IS KEYLENGTH SPECIFIED P3040 00262000
- BE READ NO, THEN SETUP READ P3040 00263000
- B SFKEY YES, THEN READ KEY P3040 00264000
- CKUPDT TM DCBCIND2,UPDT IS THIS UPDATE MODE P3040 00265000
- BNO CLEARECB NO, GO CLEAR ECB 00266000
- LTR R5,R5 WAS A POINT ISSUED 00267000
- BNZ CLEARECB YES, GO CLEAR ECB 00268000
- MVC FCBITEM(2),IOBBCSW+2(R15) GET ITEM NO. FROM IOB V0206 00269000
- CLEARECB XC DECSDECB(4),DECSDECB CLEAR ECB 00270000
- TM DCBDSORG,PO PARTITIONED ORGANIZATION? 00271000
- BNO TESTMACR NO, GO TEST FOR WL OPTION 00272000
- TM DCBMACRF+1,X'20' WRITE SPECIFIED? V0277 00273000
- BNO BSAMERR NO, INDICATE ERROR V0277 00274000
- TM FCBINIT,FCBCATML CONCATONATION SPECIFIED? V0277 00275000
- BO BSAMERR YES, THEN INDICATE ERROR V0277 00276000
- SETCHNG L R15,FCBPDS GET DIRECTORY ADDR 00277000
- MVI CHNGBYTE(R15),X'05' INDICATE CHANGE IN PDS 00278000
- TESTMACR TM DCBMACRF+1,WL IS BDAM CREATE OPTION ON 00279000
- BNO CKFORKY NO, CHECK FOR KEY 00280000
- MVI DECSDECB,X'7F' SET ECB CODE 00281000
- TM DECTYPE+1,WRSZ WRITE CAPACITY SPECIFIED V0300 00282000
- BO DMSSBSRT YES, RETURN WITH EOF CODE V0300 00283000
- TM DECTYPE+1,WRSD WRITE DUMMY SPECIFIED V0300 00284000
- BNO CKFORKY NO, CHECK FOR KEY LENGTH V0300 00285000
- L R15,DECAREA GET AREA ADDRESS V0300 00286000
- MVI 0(R15),X'FF' SET DUMMY INDICATOR V0300 00287000
- CKFORKY CLI DCBKEYLE,X'00' ARE KEYS USED 00288000
- BE WRITE NO, GO SET UP WRITE 00289000
- B SFKEY YES, PROCESS KEYS 00290000
- DIRECT L R15,VBDAM BRANCH TO BDAM RTN 00291000
- BALR R14,R15 00292000
- TM DECTYPE+1,BDAMREAD DA: READ OR WRITE? 00293000
- BO READ SET UP FOR READ 00294000
- B WRITE SET UP FOR WRITE 00295000
- SFKEY L R15,VBDAM BRANCH TO BDAM RTN 00296000
- LH R5,FCBITEM GET ITEM NO. 00297000
- N R5,HALFWORD CLEAR FIRST HALF P3056 00298000
- BALR R14,R15 00299000
- L R15,DECAREA ADJUST AREA ADDRESS 00300000
- LA R15,1(R6,R15) TO ALLOW FOR KEY 00301000
- TM DECTYPE+1,BSAMREAD IS THIS A READ P3040 00302000
- BO KEYREAD YES, SETUP FOR READ P3040 00303000
- TM DECTYPE+1,WRSD WRITE DUMMY RECORD V0300 00304000
- BNO LOADR9 NO, CONTINUE V0300 00305000
- LA R15,4 SET END OF TRACK ERROR V0300 00306000
- CLI FCBITEM+1,X'FF' END OF TRACK V0300 00307000
- BNE DMSSBSRT NO, CONTINUE V0300 00308000
- CLC FCBITEM(2),FCBXTENT ARE WE AT END? @VA02857 00309000
- BL UPITEM NO, RETURN TO CALLER WITH END@VA15172 00310100
- * OF TRACK 00311000
- B DMSSBSRT YES, RETURN NORMALLY @VA02857 00312000
- BSAMERR MVI DECSDECB,X'42' SET ECB ERROR FLAGS 00313000
- MVI DECSDECB+3,X'FF' FILL IN ERROR BYTE 00314000
- B DMSSBSRT RETURN TO USER 00315000
- EJECT 00316000
- * 00317000
- * SIMULATE BSAM-WRITE FUNCTION 00318000
- * 00319000
- WRITE EQU * SIMULATE BSAM - WRITE 00320000
- L R15,DECAREA GET DATA ADDRESS 00321000
- LOADR9 OI IOBIOFLG,IOBOUT SIGNAL OUTPUT IN PROGRESS 00322000
- MVI OSIOTYPE,C'W' SIGNAL "WRITE" 00323000
- OI DCBOFLGS,PREVIOUS 00324000
- B TBYTE SET BUFFER LENGTH 00325000
- SPACE 5 00326000
- * 00327000
- * SIMULATE BSAM-READ FUNCTION 00328000
- * 00329000
- READ EQU * SIMULATE BSAM-READ 00330000
- L R15,DECAREA GET DATA ADDRESS 00331000
- KEYREAD EQU * SET READ INDICATORS P3040 00332000
- OI IOBIOFLG,IOBIN SIGNAL INPUT IN PROGRESS 00333000
- MVI OSIOTYPE,C'R' SIGNAL "READ" 00334000
- NI DCBOFLGS,255-PREVIOUS SIGNAL PREVIOUS READ(=0) 00335000
- EJECT * 00336000
- * SET BUFFER PARAMETER ACCORDING TO RECORD FORMAT 00337000
- * 00338000
- TBYTE EQU * SET BUFFER LENGTH 00339000
- LH R0,DCBBLKSI GET BLKSIZE 00340000
- TM DCBRECFM,VAR RECFM=FIXED 00341000
- BO RVAR NOT FIXED, CHECK FOR UNDEFINED 00342000
- TM DCBDSORG,DA ACCESS METHOD= BDAM V0206 00343000
- BO BDAMIO GET BDAM LENGTH V0300 00344000
- TM IOBIOFLG,IOBIN INPUT? 00345000
- BO TBUFF YES, THEN USE NEW BLKSIZE 00346000
- LR R5,R0 GET NEW BLKSIZE 00347000
- N R5,HALFWORD ZERO FIRST HALF 00348000
- C R5,FCBBYTE IS NEW BLKSIZE LESS THAN OLD 00349000
- BNL TBUFF NO, GO DO I/O 00350000
- CLI FCBDSMD+1,C'4' IS THIS A P4 FILE 00351000
- BNE CKCOUT NO, CONTINUE 00352000
- AR R5,R15 GET ADDR OF END OF RECORD 00353000
- MVC 0(4,R5),EOF SET EOF INDICATOR 00354000
- B TBUFF2 GO DO I/O 00355000
- CKCOUT CLI FCBCOUT+1,1 IS BLOCKING FACTOR 1 00356000
- BE TBUFF2 YES, DO NOT CHANGE BLKSIZE 00357000
- SR R4,R4 ZERO REG 4 00358000
- LH R6,DCBLRECL GET LRECL 00359000
- N R6,HALFWORD ZERO FIRST HALF 00360000
- DR R4,R6 GET BLOCKING FACTOR 00361000
- STH R5,FCBCOUT SET BLOCK COUNT 00362000
- B TBUFF SETUP TO DO I/O 00363000
- RVAR TM DCBRECFM,UND RECFM=UNDEFINED? 00364000
- BO RUND YES 00365000
- LH R0,DCBBLKSI FOR VARIABLE RECORDS, 00366000
- TM IOBIOFLG,IOBIN INPUT? 00367000
- BO TBUFF YES. 00368000
- MVC FCBBYTE+2(2),0(R15) SET LENGTH OF I/O 00369000
- B TBUFF2 GO DO I/O 00370000
- BDAMIO TM DCBCIND2,UPDT IS THIS UPDATE MODE V0300 00371000
- BNO RUND NO, USE DECB LENGTH V0300 00372000
- TM IOBIOFLG,IOBIN INPUT? V0300 00373000
- BNO TBUFF NO, USE LNGTH LAST RECORD V0300 00374000
- RUND EQU * UNDEFINED. 00375000
- LH R0,DECLNGTH GET L'RECORD FROM DECB 00376000
- * 00377000
- * SET CMS I/O PARAMETERS 00378000
- * 00379000
- TBUFF EQU * SET BUFFER ADDRESS 00380000
- ST R0,FCBBYTE SET I/O LENGTH 00381000
- TBUFF2 ST R15,FCBBUFF SET BUFFER ADDRESS 00382000
- OI DECSDECB,X'80' SIGNAL I/O IN PROGRESS OR REGRESSION 00383000
- L R14,DCBIOBA GET DCB IOB PTR 00384000
- MVC IOBBFLG(1,R14),IOBIOFLG SET IOB FLG BYTE 00385000
- * 00386000
- * TRANSFER TO "END-OF-BLOCK" ROUTINE TO PERFORM CMS I/O 00387000
- * 00388000
- L R15,=V(DMSSEB) GET V(END-OF-BLOCK ROUTINE) 00389000
- BALR R14,R15 GO COMMIT I/O 00390000
- * 00391000
- * RETURN TO PROCESSING PROGRAM 00392000
- * 00393000
- L R3,16(R13) RESTORE OUR BASE REG 00394000
- TM IOBIOFLG,IOBOUT CHECK FOR OUTPUT @VA11908 00394200
- BO TESTERR YES, BRANCH @VA11908 00394400
- NOTERR EQU * @VA11908 00394600
- TM IOBIOFLG,IOBIN INPUT ? @VA03979 00394800
- BNO DMSSBSRT NO, KEEP GOING @VA03979 00396000
- TM DCBCIND2,UPDT UPDATE? @VA03979 00397000
- BO DMSSBSRT YES, KEEP GOING @VA03979 00398000
- TM DCBRECFM,UND IS IT UNDEFINED? @VA03979 00399000
- BNO CKDA NO, THEN CONTINUE NORMALLY @VA03979 00400000
- MVC DCBLRECL(2),FCBREAD+2 SAVE NUM BYTES READ @VA03979 00401000
- B DMSSBSRT @VA03979 00402000
- CKDA TM DCBDSORG,DA BDAM I/O? @VA03979 00403000
- BNO DMSSBSRT @VA03979 00404000
- CLC DECLNGTH,DCBBLKSI CHECK DECB SIZE VS BLKSIZE @VA06128 00405000
- BNE BDAMERR BRANCH TO ERROR ROUTINE @VA06128 00406000
- MVC DECLNGTH(2),FCBREAD+2 STORE BYTES READ @VA03979 00407000
- DMSSBSRT TM DCBMACRF+1,WL IS IT CREATE BDAM? @VA01756 00408000
- BNO DMSSBSR2 NO, RETURN @VA01756 00409000
- TM DCBDSORG,PS IS IT CREATE BDAM? @VA01756 00410000
- BNO DMSSBSR2 NO, RETURN @VA01756 00411000
- TM IOBIOFLG,IOBIN INPUT? @VA01756 00412000
- BO DMSSBSR2 YES, RETURN @VA01756 00413000
- LA R15,8 END CODE @VA01756 00414000
- CLC FCBITEM(2),FCBXTENT END OF XTENT? @VA01756 00415000
- BNL RETRN YES, GO BACK @VA01756 00416000
- DMSSBSR2 LR R14,R15 SAVE REG 15 @VA01756 00417000
- SR R15,R15 CLEAR R15 ERROR CODE V0300 00418000
- CH R14,=H'12' ERROR CODE = EOF V0300 00419000
- BE RETRN YES, DON'T UPDATE ITEM NO. V0300 00420100
- UPITEM LH R5,FCBITEM UPDATE ITEM NUMBER V0300 00420200
- N R5,HALFWORD 00422000
- AH R5,FCBCOUT UPDATE ITEM NO. 00423000
- STH R5,FCBITEM STORE ITEM NO. 00424000
- RETRN ST R15,16(R13) SET RETURN CODE 00425000
- TM DCBDSORG,DA BDAM? @VA03006 00426000
- BNO RETRNA NO, RETURN @VA03006 00427000
- TM IOBIOFLG,IOBIN INPUT? @VA03006 00428000
- BO RETRNA YES, RETURN @VA03006 00429000
- LR R0,R1 @VA03006 00430000
- LR R1,R2 @VA03006 00431000
- SVC 57 FREE BUFFER (DYNAMIC BDAM WRITE) @VA03006 00432000
- RETRNA LM R14,R12,12(R13) RESTORE REGS @VA03006 00433000
- BR R14 00434000
- SPACE 3 00435000
- * 00436000
- * THIS ROUTINE HANDLES DCB'S WITH A DUMMY FCB 00437000
- * 00438000
- BSAMDUMY MVC DECSDECB(4),=XL4'4200000C' SET EOF DECB CODE 00439000
- TM DCBDSORG,DA IS THIS A BDAM FILE 00440000
- BNO CKIOTYPE NO, THEN USE BSAM CHECK 00441000
- TM DECTYPE+1,BDAMREAD IS THIS A READ 00442000
- BO DMSSBSRT YES, SIGNAL EOF 00443000
- B WRITDUMY NO, RETURN WITH 0 CODE 00444000
- CKIOTYPE TM DECTYPE+1,BSAMREAD IS THIS A READ 00445000
- BO DMSSBSRT YES, SIGNAL EOF 00446000
- WRITDUMY MVC DECSDECB(4),=XL4'7F000000' SET 0 RETURN CODE 00447000
- B DMSSBSRT RETURN 00448000
- * 00449000
- * THIS ROUTINE DRIVEN FOR WRONG LENGTH RECORD ON BDAM IO 00450000
- * 00451000
- BDAMERR MVI DECSDECB,X'42' SET ECB ERROR FLAGS @VA06128 00452000
- MVI DECSDECB+3,X'FF' FILL IN ERROR BYTE @VA06128 00453000
- MVI DECSDECB+1,X'40' IND WRONG LENGTH RECORD @VA06128 00454000
- MVI IOBCSW+5,X'40' IN CSW AND ECB @VA06128 00455000
- BDAMRND MVC DCBLRECL(2),DCBBLKSI MOVE IN BYTES READ @VA06128 00456000
- B DMSSBSRT RETURN WITH ERROR SHOWING @VA06128 00457000
- * @VA11908 00457040
- * THIS ROUTINE CHECKS FOR A WRITE TO A READ-ONLY DISK FOR @VA11908 00457080
- * BPAM AND BDAM. IF YES, AN OUTPUT ERROR WILL OCCUR @VA11908 00457120
- * WITH AN ABEND 001. @VA11908 00457160
- * @VA11908 00457200
- TESTERR EQU * @VA11908 00457240
- TM FCBDEV,FCBTAP A TAPE FILE ? @VA13077 00457280
- BO NOTERR YES @VA13077 00457320
- CLI 3(R1),X'0C' CHECK FOR R/O DISK @VA11908 00457360
- BNE NOTERR BRANCH ON NO ERROR @VA11908 00457400
- ST R2,24(R13) STORE DCB ADDRESS IN R1 @VA11908 00457440
- ST R1,20(R13) STORE ECB PTR IN R0 @VA11908 00457480
- MVI 24(R13),X'40' STORE OUTPUT INDICATOR @VA11908 00457520
- LM R0,R1,20(R13) LOAD REGS FROM SAVEAREA @VA11908 00457560
- LA R15,SYNABEND POINT TO SYNABEND @VA11908 00457600
- BALR R14,R0 SET BASE REG @VA11908 00457640
- SYNABEND EQU * @VA11908 00457680
- SYNADAF ACSMETH=BSAM @VA11908 00457720
- LA R4,54(R1) @VA11908 00457760
- DMSERR MF=I,NUM=120,LET=S,SUB=(CHARA,(R4)), @VA11908X00457800
- TEXT='.............................' @VA11908 00457840
- SYNADRLS @VA11908 00457880
- ABEND 1 @VA11908 00457920
- EJECT 00457960
- * 00459000
- * SOME BEAUTIFUL BODIES 00460000
- * 00461000
- VBDAM DC V(DMSSBD) 00462000
- HALFWORD DC F'65535' 00463000
- EOF DC X'61FFFF61' 00464000
- LTORG 00465000
- EJECT 00466000
- * 00467000
- * LET THE DUMMIES OUT 00468000
- * 00469000
- DCBD DSORG=(PS) 00470000
- EJECT 00471000
- CMSCB 00472000
- EJECT 00473000
- IO 00474000
- EJECT 00475000
- NUCON 00476000
- EJECT 00477000
- SPACE 5 00478000
- CMSAVE 00479000
- REGEQU 00480000
- END 00481000
ibm/vm370-lib/cms/dmssbs.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator