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