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