SEB TITLE 'DMSSEB (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 * 00006000 * 00007000 * MODULE NAME: 00008000 * 00009000 * DMSSEB (SOEOB - END OF BLOCK) 00010000 * 00011000 * FUNCTION: 00012000 * 00013000 * CALLS DEVICE I/O ROUTINES TO DO I/O AND SETUP ECB 00014000 * AND IOB RETURN CODES. 00015000 * 00016000 * ATTRIBUTES: 00017000 * 00018000 * REENTRANT, SEGMENT RESIDENT 00019000 * 00020000 * ENTRY POINTS: 00021000 * 00022000 * DMSSEB, DMSSEBOS 00023000 * 00024000 * ENTRY CONDITIONS: 00025000 * 00026000 * R2 - A(DCB) 00027000 * R11 - A(FCB) 00028000 * R14 - RETURN ADDRESS 00029000 * R15 - A(DMSSEB) 00030000 * 00031000 * EXIT CONDITIONS: 00032000 * 00033000 * NORMAL - 00034000 * RETURN TO CALLER WITH CODE IN DECB AND FCB. 00035000 * THE 1ST BYTE OF CODE IN THE ECB IS X'42'(ERROR) OR X'7F'(NO 00036000 * ERROR), THE NEXT TWO BYTES ARE ZERO AND THE LAST BYTE IS THE 00037000 * RETURN CODE FROM THE ROUTINE CALLED TO DO THE I/O. 00038000 * 00039000 * ERROR - 00040000 * NONE. 00041000 * 00042000 * CALLS TO OTHER ROUTINES: 00043000 * 00044000 * DMSFNS, GETMAIN, DMSBRD, DMSBWR, DMSROS 00045000 * DMSCIO, DMSCRD, DMSCWR, DMSPIO, DMSTIO, AND THE FCBPROC 00046000 * ROUTINE IF ONE IS SPECIFIED. 00047000 * 00048000 * EXTERNAL REFERENCES: 00049000 * 00050000 * OPSECT, NUCON, FCBSECT, IHADCB, IHADECB. 00051000 * 00052000 * TABLES/WORKAREAS: 00053000 * 00054000 * NONE. 00055000 * 00056000 * REGISTER USAGE: 00057000 * 00058000 * R0 - WORK 00059000 * R1 - DECB 00060000 * R2 - DCB 00061000 * R3 - BASE 00062000 * R8 - OPSECT DSECT 00063000 * R11 - FCB DSECT 00064000 * R13 - SAVE AREA 00065000 * R14, R15 - WORK 00066000 * R2, R4 - R7, R9 - R13 - MUST NOT BE CHANGED BY DMSSEB 00067000 * 00068000 * OPERATION: 00069000 * 00070000 * EOBROUTN: IF THE FCB OS BIT IS ON, CONTROL IS PASSED 00071000 * TO OSREAD. OTHERWISE, IF NO SPECIAL I/O ROUTINE IS 00072000 * SPECIFIED IN FCBPROC, CONTROL PASSES TO EOB2. IF THE 00073000 * BATCH BIT IS NOT ON AND AN FCBPROC ROUTINE IS SPECIFIED, 00074000 * CONTROL IS PASSED TO THE ADDRESS IN FCBPROC. ON RETURN FROM 00075000 * FCBPROC, IF THE I/O WAS DONE, CONTROL IS PASSED TO EOBRETRN. 00076000 * IF THE I/O WAS NOT DONE, CONTROL IS PASSED TO EOB2. 00077000 * 00078000 * OSREAD: DMSROS IS CALLED TO PERFORM A READ OR WRITE 00079000 * AND THEN CONTROL IS PASSED TO EOBRETRN. 00080000 * 00081000 * EOB2: IF I/O IS TO BE PERFORMED OR IF THERE WAS NO 00082000 * ADDRESS IN FCBPROC, FCBDEV IS PICKED UP AND 00083000 * CONTROL PASSED TO THE APPROPRIATE DEVICE DEPENDENT 00084000 * CODE. IN ALL CASES, WHEN DEVICE DEPENDENT PROCESSING 00085000 * IS COMPLETED, RETURN IS VIA EOBRETRN. 00086000 * 00087000 * EOBRETRN: A COMPLETION CODE OF X'42'(ERROR) OR X'7F' 00088000 * (NO ERROR) IS STORED IN THE ECB AND IOBECBCC FIELDS 00089000 * ALONG WITH A CMS ERROR CODE; THE RESIDUAL COUNT, IF ANY, 00090000 * IS STORED IN IOBCSW+6 AND RETURN IS MADE TO THE CALLER. 00091000 * 00092000 * CONSOLE: IF A READ IS SPECIFIED, DMSCRD IS CALLED TO 00093000 * READ A RECORD FROM THE CONSOLE, THE RECORD IS MOVED TO THE 00094000 * USERS BUFFER AND CONTROL IS PASSED TO EOBRETRN. IF WRITE 00095000 * IS SPECIFIED, DCBRECFM IS CHECKED FOR THE ASA BIT. IF IT 00096000 * IS ON, THE FIRST BYTE OF THE RECORD IS USED AS A CHARIAGE 00097000 * CONTROL CHARACTER. DMSCWR IS THEN CALLED TO TYPE THE RECORD 00098000 * AND CONTROL IS PASSED TO EOBRETRN. 00099000 * 00100000 * DISK: A CHECK IS MADE TO DETERMINE IF DCBRECFM IS 00101000 * VARIABLE AND IF THE FILE MODE IS OTHER THAN 4. IF NOT, 00102000 * CONTROL IS PASSED TO CKRDWR. OTHERWISE, VARIABLE 00103000 * RECORDS ARE READ INTO OR WRITTEN OUT OF A BUFFER 00104000 * ONE AT A TIME BY CALLS TO CKRDWR UNTIL THE BUFFER 00105000 * IS ENTIRELY READ OR WRITTEN. CONTROL IS THEN PASSED 00106000 * TO EOBRETRN. 00107000 * 00108000 * CKRDWR: DMSBRD OR DMSBWR IS CALLED TO READ OR WRITE 00109000 * A RECORD. IF AN ERROR CODE OF 9 IS RETURNED, DMSFNS IS 00110000 * CALLED TO CLOSE THE FILE AND DMSBRD OR DMSBWR IS CALLED 00111000 * AGAIN. IF WRITE WAS SPECIFIED, CONTROL IS PASSED 00112000 * TO EITHER THE VARIABLE BLOCKING ROUTINE, IF IT WAS THE 00113000 * CALLER, OR EOBRETRN. IF READ WAS SPECIFIED AND IF ANY 00114000 * ERRORS WERE ENCOUNTERED, CONTROL IS RETURNED TO EITHER 00115000 * THE VARIABLE BLOCKING ROUTINE, IF IT WAS THE CALLER, 00116000 * OR EOBRETRN. IF READ WAS SPECIFIED AND NO ERRORS WERE 00117000 * ENCOUNTERED, A CHECK IS MADE OF THE BUFFER TO SEE IF 00118000 * A SHORT BLOCK OR EOF RECORD (X'61FFFF61') WAS READ. 00119000 * IF AN EOF RECORD WAS READ, AN ERROR CODE IS SET. IF 00120000 * A SHORT BLOCK WAS READ, AN INDICATOR IS SET IN 00121000 * DCBFDAD TO INSURE THAT ANOTHER READ TO THIS DATA 00122000 * SET WILL CAUSE AN EOF ERROR. CONTROL IS THEN RETURNED 00123000 * TO EITHER THE VARIABLE BLOCKING ROUTINE, IF IT WAS THE 00124000 * CALLER, OR EOBRETRN. 00125000 * 00126000 * READR: DMSCIO IS CALLED WITH THE ADDRESS 00127000 * OF THE IOAREA IN THE PLIST. 00128000 * AFTER THE RECORD IS READ IN, CONTROL IS PASSED TO EOBRETRN. 00129000 * 00130000 * PUNCH AND PRINT: RECORDS ARE WRITTEN OUT OF A BUFFER 00131000 * ONE AT A TIME BY CALLS TO DMSCIO OR DMSPIO UNTIL THE BUFFER 00132000 * IS EMPTY. CONTROL IS THEN RETURNED TO EOBRETRN. IF PRINT 00133000 * IS SPECIFIED AND NO CONTROL CHARACTERS ARE SPECIFIED IN 00134000 * DCBRECFM, A BLANK IS ADDED TO THE FRONT OF THE RECORD 00135000 * BEFORE CALLING DMSPIO. 00136000 * 00137000 * TAPE: A PLIST IS BUILT FROM INFORMATION IN THE FCB AND 00138000 * TAPEIO IS CALLED TO READ OR WRITE A BLOCK OF DATA. CONTROL 00139000 * IS THEN PASSED TO EOBRETRN. 00140000 * 00141000 * 00142000 *. 00143000 EJECT 00144000 * 00145000 DMSSEB START 0 00146000 USING DMSSEB,R3 00147000 LR R3,R15 SET BASE REG 00148000 USING OPSECT,R8 00149000 USING NUCON,R0 00150000 USING FCBSECT,R11 00151000 USING IHADCB,R2 00152000 USING IHADECB,R1 00153000 FS EQU X'08' FIXED STANDARD INDICATOR 00154000 ASA EQU X'04' ASA CNTRL SPECIFICATION 00155000 MCH EQU X'02' MACHINE CNTRL SPECIFICATION 00156000 L R8,AOPSECT GET V(OPSECT) BASE 00157000 STM R14,R1,SAVER14 SAVE SOME REGS 00158000 ST R14,SEBSAV DYNAMICALLY SAVE R14 @VA02691 00159000 XC FCBBYTE(2),FCBBYTE ZERO HIGH ORDER TWO BYTES 00160000 EJECT 00161000 * 00162000 * SET "EVENT CONTROL BLOCK" (ECB) STATUS 00163000 * 00164000 L R14,DCBIOBA GET IOB ADDR 00165000 MVI IOBBECBC(R14),X'80' SET IOB COMPLETION CODE 00166000 L R14,IOBBECBP(R14) GET ECB ADDR FROM IOB 00167000 MVI 0(R14),X'80' SIGNAL: AWAITING EVENT COMPLETION 00168000 ST R11,FCBIO SET A(LAST FCB REFERENCED) 00169000 TM FCBINIT,FCBOS IS THIS AN OS FCB @V201122 00170000 BO OSREAD YES, GO TO OS READ ROUTINE @V201122 00171000 EOB1 EQU * SERIVCE COMPILER DEPENDENT DATA SETS 00172000 EJECT 00173000 * 00174000 * DURING THE EXECUTION OF A LANGAGE PROCESSOR (ASSEMBLER, FORTRAN, 00175000 * PL/I, C...L; SPECIAL I/O HANDLING OF CERTAIN DATA SETS MAY BE 00176000 * DONE BY PLACING THE ADDRESSES OF THESE SPAECIAL ROUTINES INTO 00177000 * "FCBPROC ". THE EOB ROUTINE WILL TRANSFER TO THE LOCATION SPECIFIED 00178000 * BY "FCBPROC ". THE ROUTINE MUST SAVE ALL REGS, AND RESTORE THEM. 00179000 * UPON RETURN HERE: R15=0 PERFORM I/O REQUEST; R15>0 RESIDUAL 00180000 * COUNT; R15<0 ERROR CODE. 00181000 L R15,FCBPROC COMPILER-DEPENDENT I/O AUXILIARY ROUT 00182000 LTR R15,R15 IS IT ACTIVE? TR 00183000 BZ EOB2 NO. MIND YOUR OWN BUSINESS 00184000 BALR R14,R15 GO MAN. 00185000 LTR R15,R15 SHOULD I/O BE PERFORMED? 00186000 BZ EOB2 YES. 00187000 BP EOB3 I/O WAS DONE. R15 = RESIDUAL COUNT 00188000 LPR R15,R15 I/O WAS DONE. R15=ERROR CODE 00189000 B ERRRTN 00190000 EOB3 LR R1,R15 GET N'BYTES ACTUALLY READ 00191000 B DSKRET 00192000 EJECT 00193000 * 00194000 * EXECUTE DEVICE DEPENDENT I/O OPERATION IN CMS! 00195000 * 00196000 EOB2 IC R15,FCBDEV PICK UP DEVICE TYPE CODE TR 00197000 B *+4(R15) GO TO DEVICE DEPENDENT ROUTINE 00198000 B DUMMY 00199000 B PRINT 00200000 B READR 00201000 B CONSOLE 00202000 B TAPE 00203000 B DISK 00204000 B PUNCH 00205000 B CRT 00206000 * 00207000 * RETURN TO MASTER I/O MODULES 00208000 * 00209000 EOBRETRN DS 0H 00210000 * R1=F'RESIDUAL COUNT' R14=X'ECB CODE' R15=X'CMS CODE' 00211000 LR R0,R1 SAVE REG 1 00212000 L R1,DCBIOBA GET ADDR OF IOB 00213000 STH R0,IOBBCSW+6(,R1) SET RESIDUAL COUNT 00214000 STC R14,IOBBECBC(,R1) SET IOB ECB COMPLETION CODE 00215000 L R1,IOBBECBP(,R1) GET ECB PTR FROM IOB 00216000 ST R15,0(,R1) SET CMS ERROR CODE 00217000 STC R14,0(,R1) SET ECB CODE 00218000 ST R13,FCBR13 SAVE REG 13 00219000 L R14,SEBSAV RESTORE SAVED R14 FOR RETURN @VA02691 00220000 LA R14,0(0,R14) CLEAR HI ORDER BYTE @VA03023 00221000 BR R14 00222000 EJECT 00223000 * CODE FOR CMS OS ACCESS 00224000 * 00225000 OSREAD LA R1,FCBOP GET ADDR OF READ PLIST @V201122 00226000 LA R15,SEBOS GET ADDRESS FOR SVC 203 ROUTINE, @VM03048 00227000 SVC 203 AND CALL SVC 203 TO PASS CONTROL @VM03048 00228000 DC H'-16' TO SEBOS BELOW. @VM03048 00229000 LTR R15,R15 ANY DMSROS ERRORS ? @VM03048 00230000 BZ GETCNT NO, ALL FINE AND DANDY.. @VM03048 00231000 MVC SEBSAV(1),FCBFORM+1 PRESERVE THIS BYTE @VA03023 00232000 SR R14,R14 ELSE CLEAR INTERNAL RETURN, @VM03048 00233000 B DSKERR AND GO HANDLE ERROR. @VM03048 00234000 * 00235000 * NOTE: WHEN THE SVC 203 (ABOVE) IS ISSUED, REGISTER 15 POINTS 00236000 * TO SEBOS, SO THAT DMSITS GIVES CONTROL HERE. NOTE THAT 00237000 * REGISTER 14 CONTAINS THE ADDRESS OF CMSRET, SO AS WHEN 00238000 * DMSROS RETURNS TO DMSITS, CONTROL WILL RETURN BACK TO 00239000 * THE INSTRUCTION AFTER SVC 203 + 2 BYTES OF CODE . 00240000 * 00241000 SEBOS L R15,ADMSROS GET ADDRESS OF DMSROS @VM03048 00242000 B 8(R15) AND GO TO DMSROS READ SEQ. @VM03048 00243000 EJECT 00244000 *********************************************************************** 00245000 * * 00246000 * DEVICE DEPENDENT INPUT/OUTPUT SERVICES * 00247000 * * 00248000 *********************************************************************** 00249000 SPACE 3 00250000 * 00251000 * CRT 00252000 * 00253000 CRT EQU * 00254000 LA R15,X'FF' CMS: DEVICE NOT SUPPORTED 00255000 B ERRRTN 00256000 SPACE 10 00257000 * 00258000 * CONSOLE TYPEWRITER 00259000 * 00260000 CONSOLE DS 0H CONSOLE ACTIVITY 00261000 TM IOBIOFLG,IOBIN INPUT? 00262000 BO CONSOLRD YES. 00263000 * TYPE OUTPUT 00264000 CONSOLWR EQU * CONSOLE OUTPUT 00265000 L R14,FCBBYTE GET BYTE COUNT 00266000 L R1,FCBBUFF GET BUFFER ADDR 00267000 TM DCBRECFM,FXD IS RECFM VAR 00268000 BO CONWR NO, CONTINUE 00269000 LA R1,8(R1) ALLOW FOR BDW AND RDW 00270000 SH R14,HALF8 DO NOT PRINT BDW AND RDW 00271000 CONWR ST R1,CONWRBUF FILL IN BUFFER ADDR 00272000 TM DCBRECFM,ASA ARE ASA CNTRL CHARACTERS SPECIFIED 00273000 BNO TYPE NO, GO DO I/O 00274000 LA R15,1(,R1) DO NOT PRINT CNTRL CHARACTER 00275000 ST R15,CONWRBUF FILL IN NEW BUFFER ADDR 00276000 BCTR R14,R0 SUBTRACT 1 FROM BYTE COUNT 00277000 CLI 0(R1),C' ' IS NORMAL SPACING SPECIFIED 00278000 BE TYPE YES, GO DO I/O 00279000 CLI 0(R1),C'+' IS NO SPACING SPECIFIED 00280000 BNE SPACE1 NO, CONTINUE 00281000 OI CONWRCOD+1,X'80' INDICATE NO SPACE V0018 00282000 B TYPE GO DO I/O 00283000 SPACE1 SR R15,R15 ZERO BYTE COUNT 00284000 STH R15,CONWRCNT INDICATE NULL LINE 00285000 CLI 0(R1),C'-' ARE 2 SPACES SPECIFIED 00286000 LA R1,CONWRITE GET ADDR OF PLIST 00287000 BNE SPACE2 NO, ONLY SPACE ONCE 00288000 SVC 202 SPACE 1 00289000 DC AL4(*+4) 00290000 SPACE2 SVC 202 SPACE 1 00291000 DC AL4(*+4) 00292000 TYPE STH R14,CONWRCNT SET BYTE SIZE 00293000 OI CONWRCOD+1,X'20' SET NO MAX TO LINE LENGTH @VA05719 00294000 LA R1,CONWRITE 00295000 SVC 202 00296000 DC AL4(*+4) 00297000 NI CONWRCOD+1,X'5F' RESET NOMAX,NORETN INDICATOR @VA05719 00298000 B CONRET 00299000 * TYPE INPUT 00300000 CONSOLRD EQU * CONSOLE OUTPUT 00301000 MVI CONRDCOD,C'U' SET FOR TRANS TO UPPER CASE 00302000 TM FCBIOSW,FCBCASE IS LOWER CASE SW SET 00303000 BNO RDCON NO, GO READ FROM CONSOLE 00304000 MVI CONRDCOD,C'S' YES, SET FOR NO TRANSLATE @VA04103 00305000 RDCON LA R1,CONREAD GET ADDR OF CONSOLE PLIST 00306000 SVC 202 00307000 DC AL4(*+4) 00308000 TM TSOFLAGS,TSOATCNL WAS THIS READ CANCELLED P3056 00309000 BO RDCON YES, THEN RETRY READ P3056 00310000 LH R1,CONRDCNT GET NO. BYTES READ 00311000 CKCONEOF LTR R15,R1 BYTES READ = ZERO 00312000 BZ EOFERR YES, GO TO EOF ERROR RTN @VA13662 00313000 L R14,FCBBUFF GET 'TO' ADDR 00314000 L R0,FCBBYTE GET NO. BYTES REQUESTED 00315000 TM DCBRECFM,UND IS RECFM UNDEFINED 00316000 BO CKSIZE YES, CHECK SIZE OF BYTES READ 00317000 TM DCBRECFM,FXD IS RECFM VAR 00318000 BO CONRESID NO, CONTINUE 00319000 LA R1,4(R1) ADD 4 FOR LRECL 00320000 XC FCBOP(8),FCBOP CLEAR FCBOP 00321000 STH R1,FCBOP+4 STORE LRECL 00322000 LA R1,4(R1) ADD 4 FOR BLKSIZE 00323000 STH R1,FCBOP STORE BLKSI 00324000 MVC 0(8,R14),FCBOP MOVE BDW AND RDW INTO BUFFER 00325000 LA R14,8(R14) ADD 8 TO BUFFER ADDR 00326000 SH R0,HALF8 ALLOW FOR BDW AND RDW 00327000 CKSIZE C R1,FCBBYTE NO. BYTES READ > BYTES REQUESTED 00328000 BNH MOVEREC NO, THEN MOVE BYTES READ 00329000 LR R1,R0 SET BYTES READ = BYTES REQUESTED 00330000 B CKCONEOF RESET BDW AND RDW TO NEW COUNT 00331000 CONRESID LR R15,R0 MOVE NO. BYTES ASKED FOR 00332000 LR R1,R0 RESIDUAL COUNT= 0 00333000 SETMOVE C R1,FCBBYTE IS MOVE MORE THAN REQUESTED 00334000 BNH MOVEREC NO, THEN MOVE RECORD 00335000 LR R15,R0 MOVE ONLY NO. REQUESTED 00336000 L R1,FCBBYTE BYTES READ= BYTES REQUESTED 00337000 MOVEREC BCTR R15,R0 SUBTRACT ONE FOR MOVE 00338000 EX R15,MOVCONRD MOVE BYTES READ 00339000 L R15,FCBBYTE GET NO. REQUESTED 00340000 ST R1,FCBREAD SET NO. OF BYTES READ 00341000 SR R15,R1 GET RESIDUAL COUNT 00342000 LR R1,R15 SET FOR RETURN 00343000 B CONRET RETURN 00344000 MOVCONRD MVC 0(*-*,R14),CMNDLINE MOVE CONSOLE INPUT RECORD 00345000 EJECT 00346000 * 00347000 * DISK OPERATIONS 00348000 * 00349000 DISK EQU * 00350000 SR R14,R14 ZERO REG 14 00351000 TM DCBRECFM,FXD IS RECFM FXD OR UNFORMATED 00352000 BO CKRDWR YES, THEN GO DO I/O 00353000 CLI FCBDSMD+1,C'4' IS THIS A P4 FILE ? 00354000 BE CKRDWR YES, THEN GO DO I/O 00355000 MVC FCBOP+4(2),FCBITEM SAVE FCBITEM 00356000 TM IOBIOFLG,IOBIN INPUT? 00357000 BNO VAROUT NO, THEN GO TO OUTPUT RTN 00358000 * 00359000 VARIN EQU * 00360000 L R0,FCBBUFF GET BUFFER ADDR 00361000 L R1,FCBBYTE GET BLKSIZE @VA01052 00362000 TM DCBRECFM,BLK BLOCKING? @VA01052 00363000 BNO UPFORBDW NO,READ BLKSIZE @VA01052 00364000 LH R1,FCBRECL GET RECORD LENGTH 00365000 UPFORBDW EQU * @VA01052 00366000 SH R1,HALF4+2 SUBTRACT 4 00367000 STH R1,FCBBYTE+2 STORE BYTE SIZE 00368000 LR R1,R0 SET R1 00369000 LA R1,4(R1) BYPASS BDW 00370000 RDVAR LA R1,4(R1) BYPASS RDW 00371000 ST R1,FCBBUFF SET BUFFER ADDR 00372000 MVC FCBITEM(2),FCBOP+4 SET FCBITEM 00373000 BAL R14,CKRDWR GO DO I/O 00374000 STH R15,FCBOP+4 SAVE ITEM NO. 00375000 L R1,FCBBUFF GET BUFFER ADDR 00376000 LR R15,R1 SAVE BUFFER ADDR 00377000 SH R1,HALF4+2 GET ADDR OF RDW 00378000 L R14,FCBREAD GET NO. BYTES READ 00379000 LA R14,4(R14) ADD FOUR 00380000 ST R14,FCBBUFF 00381000 MVC 0(2,R1),FCBBUFF+2 FILL IN RDW 00382000 XC 2(2,R1),2(R1) CLEAR 2ND HALF OF RDW 00383000 AH R15,FCBREAD+2 GET ADDR. OF NEXT RECORD. 00384000 LR R1,R15 RESTORE REG 1 00385000 SR R15,R0 GET AMT. IN BUFFER 00386000 TM DCBRECFM,BLK IS BLOCKING SPECIFIED 00387000 BNO VARRET NO, THEN RETURN 00388000 AH R15,FCBRECL ADD LRECL 00389000 CH R15,DCBBLKSI IS BUFFER FULL 00390000 BNH RDVAR NO, GO READ RECORD 00391000 SH R15,FCBRECL GET SIZE OF BLOCK 00392000 VARRET ST R15,FCBREAD FILL IN FCBREAD 00393000 MVC FCBBYTE+2(2),DCBBLKSI SET FCBBYTE TO BLKSI 00394000 LR R15,R0 GET ADDR OF BDW 00395000 MVC 0(2,R15),FCBREAD+2 FILL IN BDW 00396000 XC 2(2,R15),2(R15) CLEAR 2ND HALF OF BDW 00397000 B RESIDUAL BLOCK COMPLETE, SO RETURN 00398000 VAREOF CH R15,=H'12' IS THIS AN EOF CODE 00399000 BNE ERRRTN NO, GO TO ERROR RTN. 00400000 TM IOBIOFLG,IOBIN WAS A READ JUST ISSUED? @VM28920 00401000 BNO ERRRTN NO, THEN RETURN ERROR CODE @VM28920 00402000 L R15,FCBBUFF GET ADDR OF BUFFER 00403000 SH R15,HALF4+2 GET RDW ADDR 00404000 SR R15,R0 GET NO. BYTES READ 00405000 CH R15,HALF4+2 IS THIS START OF BUFFER 00406000 BE ERR12 GO TO EOF ROUTINE 00407000 B VARRET BLOCK FULL, RETURN 00408000 * 00409000 VAROUT EQU * 00410000 L R15,FCBBUFF GET A(BDW) 00411000 MVC FCBOP(2),0(R15) ALLIGN BDW 00412000 LH R0,FCBOP GET BDW 00413000 N R0,HALFWORD 00414000 SH R0,HALF4+2 DISCOUNT L'BDW 00415000 LA R15,4(,R15) PTT A(FIRST RDW) 00416000 WRVAR MVC FCBOP(2),0(R15) ALLIGN RDW 00417000 LH R1,FCBOP GET RDW 00418000 SR R0,R1 DISCOUNT LENGTH OF RECORD 00419000 SH R1,HALF4+2 DISCOUNT L'RDW 00420000 ST R1,FCBBYTE SET OUTPUT BYTE COUNT 00421000 LA R15,4(,R15) PTT DATA IF THIS RECORD 00422000 ST R15,FCBBUFF SET OUTPUT BUFFER 00423000 MVC FCBITEM(2),FCBOP+4 SET ITEM NO. 00424000 BAL R14,CKRDWR GO DO I/O 00425000 STH R15,FCBOP+4 SAVE ITEM NO. 00426000 LTR R0,R0 HAS TOTAL BLOCK BEEN DISPOSED OF? 00427000 BNP DSKRET YES 00428000 L R15,FCBBUFF GET A(LAST RECORD) 00429000 AH R15,FCBBYTE+2 PTT NEXT RECORD 00430000 B WRVAR WRITE ANOTHER RECORD 00431000 * PERFORM DISK I/O FUNCTION 00432000 * 00433000 CKRDWR EQU * 00434000 TM DCBDSORG,PO FIRST CHECK FOR PDS. @VA05994 00435000 BNO CKRDWR1 NOT PO - BRANCH @VA05994 00436000 * IF MEMBER WAS NOT FOUND ON LAST FIND, DCBRELAD FIELD WILL BE ZERO. 00437000 * IF IT IS ZERO, WE ASSUME THIS I/O IS TO THE FIRST RECORD OF THE 00438000 * MEMBER, AND SET THE DCBRELAD FIELD TO THE ITEM NUMBER OF THIS 00439000 * READ OR WRITE. 00440000 OC DCBRELAD+1(2),DCBRELAD+1 WAS FIELD RESET? @VA05994 00441000 BNZ CKRDWR1 NO - NOT FIRST READ AFTER MEM @VA05994 00442000 * NOT FOUND 00443000 MVC DCBRELAD+1(2),FCBITEM SET ITEM NUMBER IN @VA05994 00444000 * DCBRELAD 00445000 CKRDWR1 DS 0H LABEL @VA05994 00446000 MVC FCBOP(8),=CL8'RDBUF' 00447000 TM IOBIOFLG,IOBIN INPUT? 00448000 BO DSKIO YES 00449000 MVC FCBOP(8),=CL8'WRBUF' 00450000 DSKIO LA 1,FCBOP 00451000 MVC SEBSAV(1),FCBFORM+1 PRESERVE THIS BYTE @VA03023 00452000 SVC X'CA' 00453000 DC AL4(DSKERR) 00454000 MVC FCBFORM+1(1),SEBSAV RESTORE BYTE @VA03023 00455000 * RETURN FROM DISK OPERATION, DOCTOR? 00456000 DSKEND EQU * 00457000 STC R15,FCBOP+7 SAVE ERROR CODE IF ANY 00458000 LH R15,FCBITEM GET ITEM NO. 00459000 N R15,HALFWORD CLEAR FIRST HALF 00460000 BZ CKR14 00461000 LA R15,1(R15) ADD ONE TO ITEM NO. 00462000 CKR14 EQU * 00463000 LTR R14,R14 IS REG 14 ZERO 00464000 BCR 7,R14 NO, THEN BRANCH 00465000 TM IOBIOFLG,IOBIN INPUT? 00466000 BNO DSKRET NOPE. 00467000 RESIDUAL EQU * 00468000 LH R15,FCBCOUT GET FCBCOUT 00469000 CLI FCBDSMD+1,C'4' IS MODE 4 00470000 BE MODE4 YES, COMPUTE RESIDUAL @VA09484 00470100 CLI FCBDSMD,C'*' IS MODE SPECIFIED? @VA09484 00470200 BNE GETBUFAD NO, GO GET BUFFER ADDR 00471000 TM JFCBIND2,M4FLAG IS MODE 4 FLAG ON? @VA09484 00471100 BNO GETBUFAD NO CHANCE OF MODE 4 FILE @VA09484 00471200 MODE4 EQU * MODE=4, ONE WAY OR ANOTHER @VA09484 00471300 TM DCBRECFM,VAR IS RECFM VAR 00472000 BO GETBUFAD YES, CONTINUE 00473000 LH R1,DCBLRECL GET LRECL 00474000 N R1,HALFWORD CLEAR 1ST HALF 00475000 BNZ CKCOUNT NOT ZERO, THEN CHECK COUNT 00476000 L R1,FCBBYTE ZERO, THEN USE READ COUNT 00477000 CKCOUNT L R15,FCBREAD GET NO. BYTES READ 00478000 SR R14,R14 ZERO REG 14 FOR DIVIDE 00479000 DR R14,R1 DIVIDE BY LRECL 00480000 LA R15,1(R15) ADD 1 TO MULTIPLE COUNT 00481000 LTR R14,R14 IS IT MULTIPLE OF LRECL 00482000 BNZ GETBUFAD NO, THEN GET BUFFER ADDR 00483000 BCTR R15,R0 SUBTRACT ONE FROM COUNT 00484000 GETBUFAD L R1,FCBBUFF GET BUFFER ADDR 00485000 CKEOF CLC 0(4,R1),=XL4'61FFFF61' IS THIS AN EOF INDICATOR 00486000 BNE NOTEOFIN @VA05054 00487000 TM FCBIOSW2,FCBMVFIL THIS COME FROM MOVE? @VA05054 00488000 BNO SETEND NO, THEN LEAVE @VA05054 00489000 CLI FCBMEMBR,0 MEMBER OPTION SPECIFIED? @VA05054 00490000 BE CHKPDS NO, THEN CHECK PDS OPTION @VA05054 00491000 B SETEND YES, THEN SETEND @VA05054 00492000 CHKPDS TM FCBIOSW2,FCBMVPDS IS IT PDS? @VA05054 00493000 BO SETEND @VA05054 00494000 NOTEOFIN EQU * @VA05054 00495000 CLC FCBDSTYP(8),=CL8'TXTLIB' IS THIS A CMS TXTLIB 00496000 BNE NOTXTLIB NO 00497000 CLC 0(4,R1),=X'02D3C4E3' LDT CARD 00498000 BE SETEND YES, SET END OF FILE 00499000 NOTXTLIB EQU * 00500000 AH R1,DCBLRECL CHECK NEXT RECORD 00501000 BCT R15,CKEOF CHECK AGAIN 00502000 B GETCNT GET COUNT 00503000 SETEND S R1,FCBBUFF GET BYTES READ 00504000 LA R15,12 SET EOF CODE 00505000 BZ CKERR IF GO TO EOF RTN 00506000 MVI DCBFDAD,C'P' SET POINT INDICATOR 00507000 MVC DCBFDAD+5(3),=XL3'00FFF8' SET ITEM NO. 00508000 SETRDCNT ST R1,FCBREAD SET NO. OF BYTES READ 00509000 GETCNT L R1,FCBBYTE COMPUTE RESIDUAL COUNT 00510000 S R1,FCBREAD 00511000 LA R15,8 BAD LENGTH ERROR CODE @V201122 00512000 TM DCBRECFM,FXD FXD OR UNDEFINED RECFM? @V201122 00513000 BO CKFXDSTD YES, BYPASS VAR CHECK @V201122 00514000 CLC FCBREAD+2(2),=H'8' NO. BYTES < 8 @V201122 00515000 BL FLAGERR YES, THEN ERROR @V201122 00516000 CKFXDSTD TM DCBRECFM,VAR+BLK RECFM=VAR OR BLKED @V201122 00517000 BNZ DSKRET YES, THEN RETURN 00518000 TM DCBRECFM,FS IS FIXED STANDARD BIT ON 00519000 BNO DSKRET NO, RETURN 00520000 CLC DCBFDAD+5(3),=XL3'00FFF8' END OF FILE SET? @VA02699 00521000 BE DSKRET YES, THEN RETURN WITH NO ERROR @VA02699 00522000 CLC FCBREAD+2(2),FCBBYTE+2 IS NO. BYTES READ < DCBLRECL 00523000 BL FLAGERR YES, RETURN WITH ERROR CODE 00524000 DSKRET EQU * 00525000 DUMMY EQU * 00526000 CONRET EQU * 00527000 SR R15,R15 ZERO REG 15 00528000 IORET LA R14,X'7F' SET ECB CODE 00529000 B EOBRETRN 00530000 EJECT 00531000 * 00532000 * GENERALIZED DISK ERROR VECTOR ROUTINE 00533000 * 00534000 DSKERR EQU * 00535000 MVC FCBFORM+1(1),SEBSAV RESTORE BYTE @VA03023 00536000 TM IOBIOFLG,IOBIN IS THIS A READ 00537000 BNO CKFOR9 NO, CHECK FOR ERR 9 00538000 CH R15,HALF8 CMS ERROR = 8 ? 00539000 BE DSKEND YES. OK FOR OS SIMULATION. 00540000 CH R15,HALF1 ERR CODE = ONE 00541000 BNE CKFOR9 NO, CHECK FOR ERR 9 00542000 TM FCBINIT,FCBOPCB DID OPEN ISSUE FILEDEF 00543000 BNO ERR12 NO, THEN GIVE EOF CODE 00544000 CKFOR9 CH R15,HALF9 OS IN/OUT CONFLICT 00545000 BNE CKERR CHECK FOR EOF 00546000 * DATA SET WAS OPENED AS "INOUT" OR "OUTIN". 00547000 MVC FCBOP(8),=CL8'FINIS' CLOSEOUT CMS FILE 00548000 SVC X'CA' 00549000 DC AL4(*+4) 00550000 B CKRDWR GO DO I/O AGAIN 00551000 ERR12 LA R15,12 GET ERROR CODE 00552000 * ERRORS WILL BE HANDLED BY THE QSAM/BSAM ROUTINES 00553000 ERRRTN EQU * ERROR ROUTINE 00554000 URERROR EQU * 00555000 SR R14,R14 ZERO REG 14 00556000 CKERR EQU * 00557000 LTR R14,R14 ARE WE DOING BLOCKING 00558000 BNZ VAREOF YES, THEN GO TO VAREOF 00559000 SR R1,R1 CLEAR RESIDUAL COUNT 00560000 FLAGERR LA R14,X'42' R14=ECB CODE, R15=CMS CODE 00561000 B EOBRETRN 00562000 EJECT 00563000 * 00564000 * CARD READER OPERATIONS 00565000 * 00566000 READR EQU * 00567000 MVC RDBUFF+1(3),FCBBUFF+1 TR 00568000 MVI RDBUFF,X'80' USE EXTENDED PLIST 00569000 MVC RDCCW(2),FCBBYTE+2 SET READ COUNT 00570000 LA 1,READLST 00571000 SVC X'CA' 00572000 DC AL4(READERR) 00573000 RD1 SR R1,R1 RESIDUAL COUNT=ZERO 00574000 B IORET 00575000 SPACE 3 00576000 READERR EQU * CARD READER ERROR RETURN 00577000 LH R1,RDCOUNT GET NO. OF BYTES READ 00578000 CH R15,=H'5' IS ERROR CODE = 5 00579000 BE SETRDCNT YES, IGNORE INCORRECT LENGTH 00580000 CH R15,HALF1 IS THIS EOF ERROR 00581000 BNE NORESID NOPE. @VA13662 00582000 SPACE 1 @VA13662 00582800 * @VA13662 00583600 **** COMMON END OF FILE ROUNTINE FOR CONSOLE,READER, AND TAPE @VA13662 00584400 * @VA13662 00585200 EOFERR EQU * @VA13662 00586000 LA R15,12 SET RET CODE FOR CMS @VA13662 00586800 LA R14,EOFCODE SET RET CODE FOR ECB @VA13662 00587600 B EOBRETRN RETURN @VA04019 00589000 SPACE 3 @VA13662 00589100 NORESID EQU * @VA13662 00589200 SR R1,R1 SET RESIDUAL COUNT = 0 @VA13662 00589300 PERMERR EQU * @VA13662 00589400 LA R14,PERMCODE SET RET CODE FOR ECB @VA13662 00589500 B EOBRETRN CLEAN UP AND RETURN @VA13662 00589600 * @VA13662 00589700 PERMCODE EQU X'41' INDICATES PERM. I/O ERROR @VA13662 00589800 EOFCODE EQU X'42' INDICATES END OF FILE @VA13662 00589900 EJECT 00590000 * 00591000 * 00592000 * COMBINED "PRINTER/PUNCH" UNIT RECORD OPERATIONS 00593000 * 00594000 * "PUNCH" INITIATOR 00595000 PUNCH DS 0H SIGNAL PUNCH CARD OUTPUT 00596000 MVC FCBPRPU(8),PUNCHLST SET I/O OPER = "PUNCH" 00597000 B PRTPUN JOIN FORCES 00598000 * "PRINT" INITIATOR 00599000 PRINT DS 0H SIGNAL PRINTER OUTPUT 00600000 MVC FCBPRPU(8),PRINTLST SET I/O OPER = "PRINT" 00601000 * LET ALL PRINTS & PUNCHYS COME TOGETHER 00602000 PRTPUN EQU * @VA11880 00602300 LA R15,36 INDICATE DEVICE ERROR @VA11880 00602600 TM IOBIOFLG,IOBIN CHECK FOR READ OPERATION @VA11880 00602900 BO PRPUERR NOT VALID FOR OUTPUT DEVICE @VA11880 00603200 TM DCBRECFM,FXD RECFM = VARIABLE? @VA11880 00603500 BNO PPVLR YES. 00604000 TM DCBRECFM,BLK RECFM = BLOCKED? 00605000 LA R14,DUMMY SET RETURN VECTOR 00606000 BNO GOPPOUT UNBLK. GO TO PRINT/PUNCH OUTPUTTER. 00607000 L R0,FCBBYTE GET BYTE SIZE OF BLOCK 00608000 LH R1,DCBLRECL GET L'DATA RECORD 00609000 STH R1,FCBBYTE+2 SET L'OUTPUT LINE 00610000 BAL R14,GOPPOUT OUTPUT FIRST RECORD OF BLOCK 00611000 PPFB1 LH R1,FCBBYTE+2 00612000 SR R0,R1 00613000 BNP DUMMY YES. 00614000 L R15,FCBBUFF GET A(NEXT RECORD WITHIN BLOCK) 00615000 AR R15,R1 00616000 ST R15,FCBBUFF SET A(PRINT BUFFER) 00617000 B GOPPOUT 00618000 * 00619000 PPVLR EQU * VARIABLE 00620000 L R15,FCBBUFF GET (ABUFFER: BDW) 00621000 MVC FCBOP(2),0(R15) ALLIGN BDW 00622000 LH R0,FCBOP GET BDW 00623000 SH R0,HALF4+2 DISCOUNT L'BDE(=4) 00624000 LA R15,4(,R15) PTT RDW 00625000 PPVLR1 MVC FCBOP(2),0(R15) ALLIGN RDW 00626000 LH R1,FCBOP GET RDW 00627000 SR R0,R1 SUBTRACT RDW 00628000 SH R1,HALF4+2 DISCOUNT L'RDW 00629000 STH R1,FCBBYTE+2 SET L'OUTPUT BUFFER 00630000 HALF4 LA R15,4(R15,R0) PTT DATA 00631000 ST R15,FCBBUFF SET A(THIS RECORD) 00632000 BAL R14,GOPPOUT 00633000 LTR R0,R0 HAS BLKSI BEEN EXHAUSTED? 00634000 BNP DUMMY YES. 00635000 L R15,FCBBUFF P3130 00636000 AH R15,FCBBYTE+2 PTT NEXT REC IN BLOCK 00637000 B PPVLR1 00638000 * 00639000 GOPPOUT MVC FCBOP(8),FCBBUFF SAVE BUFFER ADDR 00640000 CLI FCBPRPU,C'P' IS PRINTR SPECIFIED 00641000 BNE PUTOUT NO GO PUNCH OUTPUT 00642000 TM DCBRECFM,MCH IS MACHINE CNTRL SPECIFIED? 00643000 BNO CKCNTRL NO, GO CHECK FOR ASA 00644000 MVI FCBBYTE+1,X'01' SET INDICATOR FOR MACHINE CNTRL 00645000 CKCNTRL TM DCBRECFM,ASA+MCH ARE CNTRL CHARACTERS SPECIFIED 00646000 BNZ PUTOUT YES, THEN MOVE NOT NECCESSARY 00647000 L R1,FCBDSTYP GET ADDR OF MOVE BUFFER 00648000 LTR R1,R1 IS IT ZERO? 00649000 BNZ MOVEBUFF NO, GO MOVE RECORD 00650000 ST R0,FCBDSTYP SAVE REG 0 00651000 GETMAIN R,LV=160 00652000 L R0,FCBDSTYP RESTORE REG 0 00653000 ST R1,FCBDSTYP SAVE ADDR OF PRINT BUFFER 00654000 MOVEBUFF MVI 0(R1),C' ' SET CONTROL CHARACTERS @VA08538 00655100 L R15,FCBBUFF GET BUFFER ADDRESS @VA08538 00655200 MVC 1(159,R1),0(R15) MOVE RECORD TO ADD CNTRL CHAR 00657000 ST R1,FCBBUFF SET ADDR OF NEW BUFFER 00658000 LH R1,FCBBYTE+2 GET BYTE SIZE 00659000 LA R1,1(,R1) ADD ONE FOR CNTRL CHARACTER 00660000 STH R1,FCBBYTE+2 RESET BYTE SIZE 00661000 PUTOUT LA R1,FCBPRPU GET ADDR OF PLIST 00662000 SVC X'CA' 00663000 DC AL4(PRPUERR) 00664000 PRPUOK MVC FCBBUFF(8),FCBOP RESTORE BUFFER ADDR AND SIZE 00665000 BR R14 RETURN TO THE CALLER 00666000 PRPUERR CLI FCBPRPU,C'P' WAS THE PRINTER SPECIFIED? 00667000 BNE URERROR NO, THEN HANDLE PUNCH ERRORS 00668000 CH R15,HALF4+2 ERROR CODE < 4 00669000 BNL URERROR NO, THEN HANDLE ERROR 00670000 CH R15,HALF1 ERROR CODE = 1 00671000 BE URERROR ERROR, LENGTH TOO LARGE 00672000 LA R1,FCBPRPU GET ADD. OF PLIST @VA01467 00673000 CLC 12(2,R1),=XL2'0001' MACHINE CODE? @VA01467 00674000 BE ZER15 YES, LINE PRINTED RETURN @VA01467 00675000 L R15,8(R1) GET ADDRESS PRINT LINE @VA01467 00676000 MVI 0(R15),C'+' PRINT AND SUPPRESS SPACE @VA01467 00677000 B PUTOUT PRINT IT @VA01467 00678000 ZER15 SR R15,R15 ZERO RETURN CODE @VA01467 00679000 B PRPUOK RETURN @VA01467 00680000 EJECT 00681000 * 00682000 * I/O DEVICE IS A TAPE. HANDLE THE OPERATION, DOCTOR. 00683000 * 00684000 TAPE EQU * 00685000 MVC TAPEOPER(8),=CL8'READ' INDICATE TAPE "READ" TR 00686000 TM IOBIOFLG,IOBIN INPUT? 00687000 BO TAPEDO YES. 00688000 MVC TAPEOPER(8),=CL8'WRITE' INDICATE TAPE "WRITE" TR 00689000 TAPEDO MVC TAPEMASK(1),FCBMODE GET TAPE MODE TR 00690000 MVC TAPEDEV(4),FCBTAPID GET SYMBOLIC TAPE NAME TR 00691000 MVC TAPEBUFF(3),FCBBUFF+1 SET BUFFER ADDRESS 00692000 MVC TAPESIZE(4),FCBBYTE SET BLOCK LENGTH 00693000 LA R1,TAPELIST GET PLIST TR 00694000 SVC X'CA' 00695000 DC AL4(TAPEERR) 00696000 TAPEOK EQU * @VA07551 00696100 CLI TAPEOPER,C'W' OUTPUT? 00697000 BE TAPERET YES. 00698000 MVC FCBREAD(4),TAPECOUT FILL IN FCBREAD FIELD 00699000 L R1,TAPESIZE L'DESIRED BLOCK 00700000 S R1,TAPECOUT - N'BYTES READ=RESIDUAL COUNT 00701000 TAPERET B IORET 00702000 TAPEERR EQU * 00703000 CH R15,HALF8 IS ERROR WRONG LENGTH? @VA07551 00703100 BNE TAPEER NO THEN HANDLE AS ERROR @VA07551 00703200 TM FCBRECFM,RECUND YES/TEST FOR RECFM=UNDEF @VA07551 00703300 BNO TAPEER NO THEN HANDLE AS ERROR @VA07551 00703400 SR R15,R15 YES/THEN NO ERROR RETCDE=0@VA07551 00703500 B TAPEOK IGNORE WRONG LENGTH @VA07551 00703600 TAPEER EQU * @VA07551 00703700 CH R15,HALF2 IS IT END OF FILE ? 00704000 BE EOFCK YES, BRANCH @VA11136 00705000 CLI TAPEOPER,C'W' WRITE OPERATION? @VA11136 00705100 BE NORESID IF SO DON'T NEED RESIDUAL @VA13662 00705200 L R1,TAPESIZE CALC RESIDUAL BYTE COUNT, @VA11136 00705300 S R1,TAPECOUT PUT IN REG1 FOR RETURN @VA11136 00705400 B PERMERR GO SET ECB CODE @VA13662 00705500 EOFCK EQU * END OF FILE ERROR @VA11136 00705600 B EOFERR 00706000 EJECT 00707000 * 00708000 * SOME VARIABLE CONSTANTS 00709000 * 00710000 HALFWORD DC F'65535' 00711000 HALF8 DC H'8' 00712000 HALF9 DC H'9' 00713000 HALF2 DC H'2' 00714000 HALF1 DC H'1' 00715000 RECUND EQU X'C0' RECFM=UNDEFINED @VA07551 00715100 M4FLAG EQU X'01' FILEMODE=4 IF FM='*' @VA09484 00715200 EJECT 00716000 PRINT GEN 00717000 * 00718000 * A FEW DUMMIES FOLLOW ... 00719000 * 00720000 IO 00721000 EJECT 00722000 NUCON 00723000 EJECT 00724000 SPACE 3 00725000 DCBD DSORG=(PS) 00726000 EJECT 00727000 SPACE 3 00728000 CMSCB 00729000 EJECT 00730000 EJECT 00731000 REGEQU 00732000 SPACE 3 00733000 END 00734000