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