XCP TITLE 'DMSXCP (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME 00004000 * 00005000 * DMSXCP ( EXCP ROUTINE ) 00006000 * 00007000 * FUNCTION 00008000 * 00009000 * PROVIDE THE FACILITY TO SIMULATE THE DOS/VS 00010000 * EXCP (SVC 0) UNDER THE CMS/DOS ENVIRONMENT. 00011000 * EXCP (EXECUTE CHANNEL PROGRAM) REQUESTS THE 00012000 * INITIATION OF AN I/O OPERATION TO A SPECIFIC 00013000 * LOGICAL UNIT. 00014000 * 00015000 * ATTRIBUTES 00016000 * 00017000 * CMSDOS SEGMENT RESIDENT MODULE 00018000 * REENTRANT 00019000 * 00020000 * ENTRY POINTS 00021000 * 00022000 * DMSXCP 00023000 * 00024000 * ENTRY CONDITIONS 00025000 * 00026000 * THIS ROUTINE IS CALLED BY DMSDOS VIA BALR R14,R15 00027000 * 00028000 * R14 = RETURN ADDRESS 00029000 * R15 = ENTRY POINT 00030000 * R11 = EXCP WORK AREA ADDRESS 00031000 * R1 = CCB (COMMAND CONTROL BLOCK) POINTER 00032000 * 00033000 * DS XL2 RESIDUAL COUNT 00034000 * DS XL1 COMMUNICATIONS BYTE 1 00035000 * DS XL1 COMMUNICATIONS BYTE 2 00036000 * DS XL1 CSW STATUS BYTE 1 00037000 * DS XL1 CSW STATUS BYTE 2 00038000 * DS XL2 SYMBOLIC (LOGICAL) UNIT 00039000 * DS XL4 CCW ADDRESS 00040000 * DS XL4 CCW ADDRESS IN CSW OR 00041000 * DOSCB POINTER IF I/O TO DISK 00042000 * 00043000 * EXIT CONDITIONS 00044000 * 00045000 * RETURN TO CALLER WITH RETURN CODE IN R15 00046000 * 00047000 * RETURN CODES AND MESSAGES: 00048000 * 00049000 * 36 - SPECIFIED TAPE IS FILE PROTECTED 00050000 * 100 - SPECIFIED DEVICE IS NOT ATTACHED 00051000 * 100 - INPUT|OUTPUT ERROR ON SYSXXX 00052000 * 100 - ERROR READING CMS FILE FROM DISK 00053000 * 100 - ERROR WRITING CMS FILE TO DISK 00054000 * 100 - UNEXPECTED ERROR ON SYSXXX 00055000 * 00056000 * CALLS TO OTHER ROUTINES 00057000 * 00058000 * DMSFRE, DMSPIO, DMSCIO, DMSCRD, DMSCWR 00059000 * DMSBRD, DMSBWR, DMSFNS, DMKGIO, DMSERR 00060000 * 00061000 * EXTERNAL REFERENCES 00062000 * 00063000 * NUCON, BGCOM, ADT, CMSAVE, MAPPUB 00064000 * 00065000 * TABLES/WORK AREAS 00066000 * 00067000 * DMSCCB, IOCCW 00068000 * CNCODES, CDCODES, SDCODES 00069000 * 00070000 * NOTES 00071000 * 00072000 * SUPPORT CODE FOR DMSXCP ROUTINE = @V305001 00073000 * EXCEPT FOR THE 'IKQLAB HANDLER' SECTION. 00074000 * SUPPORT CODE FOR IKQLAB SECTION = @V305132 00075000 * 00076000 * REGISTER USAGE 00077000 * 00078000 * R0 NUCON ADDRESSABILITY & FREE/FERT REGISTER 00079000 * R1 WORK & FREE/FRET REGISTER 00080000 * R2 CCB POINTER 00081000 * R3 CURRENT CCW POINTER 00082000 * R4 WORK & INTERNAL LINKAGE 00083000 * R5 WORK 00084000 * R6 WORK 00085000 * R7 WORK & INTERNAL LINKAGE 00086000 * R8 WORK 00087000 * R9 WORK & INTERNAL LINKAGE 00088000 * R10 IOCCW (PLIST WORK) POINTER 00089000 * R11 DOSCB POINTER 00090000 * R12 DMSXCP ADDRESSABILITY 00091000 * R13 DMSXCP ADDRESSABILITY 00092000 * R14 EXTERNAL LINKAGE & RETURN REGISTER 00093000 * R15 ADDRESS OF EXTERNAL LINKAGE & RETURN CODE 00094000 * 00095000 * OPERATION 00096000 * 00097000 * 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00098000 * SOME REGISTERS IN THE EXCP WORK AREA. CHECK 00099000 * IF THE SPECIFIED CCW ADDRESS IN THE CCB IS 00100000 * NOT ZERO. 00101000 * 00102000 * 2. DETERMINE IF THE SPECIFIED LOGICAL UNIT IN 00103000 * THE CCB IS ASSIGNED. IF IT IS ASSIGNED, USE 00104000 * THE PUB DEVICE TYPE TO INDEX AND BRANCH TO 00105000 * THE ONE INTERNAL ROUTINE THAT WILL PROCESS 00106000 * THAT SPECIFIC DEVICE. IF THE LOGICAL UNIT IS 00107000 * ASSIGNED TO IGNORE, ANOTHER ROUTINE IS GIVEN 00108000 * CONTROL. 00109000 * 00110000 * 3. LOGICAL UNIT ASSIGNED TO 'IGNORE'. 00111000 * 00112000 * VERIFY THAT ALL THE CCW'S SPECIFIED ARE VALID. 00113000 * SEARCH THROUGH CCW CHAIN LOOKING FOR ANY READS. 00114000 * IF NO READ CCW IS FOUND, THE CCB IS POSTED WITH 00115000 * THE NORMAL C.E. + D.E. . IF A READ CCW IS FOUND, 00116000 * ASIDE FROM THE NORMAL C.E. + D.E., THE CCB IS 00117000 * POSTED FOR EOF. 00118000 * 00119000 * 4. LOGICAL UNIT ASSIGNED TO 'PRINTER'. 00120000 * 00121000 * A 4 DOUBLE WORD WORK AREA IS ACQUIRED FROM FREE 00122000 * STORAGE TO BUILD THE DMSPIOSI PLIST. THE PLIST IS 00123000 * INITIALIZED WITH THE COMMAND NAME AND THE BUFDATA 00124000 * POINTER. THE FIRST USER CCW IS MOVED TO 'BUFDATA', 00125000 * AND A NO-OP CCW IS MOVED AFTER IT. IF THE CCW IS 00126000 * CHAINED, AN INTERNAL FLAG IS SET TO REMEBER THERE 00127000 * ARE MORE CCW'S TO EXECUTE. IF CCW IS NOT CHAINED, 00128000 * IT IS CHAINED TO THE NO-OP CCW. AN SVC 202 IS MADE 00129000 * TO DMSPIOSI TO EXECUTE THIS CCW. UPON RETURN, IF 00130000 * THERE ARE MORE CCWS, THE OPERATION IS REPEATED AS 00131000 * BEFORE. OTHERWISE, THE CCB IS POSTED ACCORDINGLY. 00132000 * 00133000 * 5. LOGICAL UNIT ASSIGNED TO 'READER' OR 'PUNCH'. 00134000 * 00135000 * CHECK IF CCW CODE IS VALID. TURN STACKER SELECT 00136000 * AND DATA MODE BITS OFF (IF ON) AND PASS CCW CODE 00137000 * THROUGH TABLE OF SUPPORTED CCWS. ONCE A MATCH IS 00138000 * FOUND (WILL MATCH ON READ, WRITE, OR NO-OP), THE 00139000 * PLIST FOR DMSCIO IS BUILT, AND AN SVC 202 IS MADE 00140000 * TO CARDRD OR CARDPH (READ OR WRITE) TO PERFORM 00141000 * THE I/O OPERATION. UPON RETURN (OR IF THE CCW IS 00142000 * TO BE NO-OPED), IF THE CCW IS CHAINED, THE OPERA- 00143000 * TION IS REPEATED AS BEFORE. OTHERWISE, THE CCB IS 00144000 * POSTED ACCORDINGLY. 00145000 * 00146000 * 6. LOGICAL UNIT ASSIGNED TO 'TERMINAL'. 00147000 * 00148000 * CHECK IF CCW CODE IS VALID BY PASSING CCW THROUGH 00149000 * A TABLE OF SUPPORTED CCWS. ONCE A MATCH IS FOUND 00150000 * (WILL MATCH ON READ, WRITE, OR NO-OP), THE PLIST 00151000 * FOR DMSCRD OR DMSCWR IS BUILT. IF READING, A 160 00152000 * BYTE BUFFER IS ACQUIRED FROM FREE STORAGE TO HOLD 00153000 * THE INPUT LINE. AN SVC 202 IS ISSUED TO CONREAD OR 00154000 * TYPLIN TO PERFORM THE I/O OPERATION. UPON RETURN, 00155000 * IF THE CCW IS CHAINED, THE OPERATION IS REPEATED 00156000 * AS BEFORE. OTHERWISE, THE CCB IS POSTED ACCORDINGLY. 00157000 * IF A READ WAS ISSUED, THE NUMBER OF BYTES SPECIFIED 00158000 * IN THE CCW ARE MOVED TO THE USER'S BUFFER. THEN THE 00159000 * ACQUIRED FREE STORAGE AREA IS FREED. 00160000 * 00161000 * 7. LOGICAL UNIT ASSIGNED TO 'TAPE'. 00162000 * 00163000 * THE VIRTUAL DEVICE ADDRESS IS DECODED INTO A HEX 00164000 * ( EBCDIC ) REPRESENTATION FOR ANY POSSIBLE ERROR 00165000 * MESSAGE SUBSTITUTION. 00166000 * TWO DUMMY CCWS (MODESET AND TIC) ARE MOVED TO THE 00167000 * EXCP WORK AREA. A TEST IS MADE TO DETERMINE IF THE 00168000 * PUB CONTAINS A MODE SET VALUE. IF NOT, THE DEFAULT 00169000 * VALUE X'B3' IS USED. THE USER CCW CHAIN ADDRESS IS 00170000 * STORED INTO THE ADDRESS PORTION OF THE TIC CCW AND 00171000 * A CALL IS MADE TO DIAGNOSE THE CCW CHAIN TO CP. 00172000 * RETURN IS ONLY MADE IF AN I/O ERROR IS RETURNED BY 00173000 * CP (EXCLUDING UNIT EXCEPTION OR INCORRECT LENGTH). 00174000 * IF AN I/O ERROR OCCURED, THE SENSE BYTES ARE TESTED 00175000 * TO DIFFERENTIATE BETWEEN FILE PROTECTED TAPE OR I/O 00176000 * ERROR. OTHERWISE, THE CCW IS POSTED ACCORDINGLY. 00177000 * 00178000 * 8. LOGICAL UNIT ASSIGNED TO 'DISK'. 00179000 * 00180000 * FIRST A CHECK IS MADE TO DETERMINE IF I/O IS TO CMS 00181000 * FORMATTED DISK, OR TO O/S OR DOS FORMATTED DISK. IF 00182000 * THE I/O IS TO A CMS FORMATTED DISK, THE CCW IS CHECKED 00183000 * FOR VALIDITY. IF THE CCW IS 'TIC', THE NEXT CCW IN THE 00184000 * CHAIN IS PROCESSED. IF THE CCW IS VALID AND NOT 'TIC', 00185000 * THE CCW IS PASSED THROUGH THE TABLE OF SUPPORTED CCW 00186000 * CODES. ONCE A MATCH IS FOUND, CONTROL WILL PASS TO THE 00187000 * ROUTINE TO PROCESS THAT CCW CODE. SUPPORTED CCW CODES 00188000 * UNDER CMS/DOS ARE: READ DATA, WRITE DATA, SEARCH ID, 00189000 * WRITE COUNT KEY & DATA, READ COUNT KEY & DATA, READ KEY 00190000 * AND DATA, AND READ COUNT. ALL OTHER VALID CCWS ARE NO- 00191000 * OPED. ONCE THE CCW HAS BEEN PROCESSED SUCCESSFULLY, A 00192000 * CHECK IS MADE TO DETERMINE IF THE CCW IS CHAINED. IF 00193000 * SO, THE NEXT CCW IS PROCESSED AS BEFORE, OTHERWISE, THE 00194000 * CCB IS POSTED ACCORDINGLY. 00195000 * 00196000 * IF THE DISK IS NOT A CMS FORMATTED DISK, A CHECK IS 00197000 * MADE TO DETERMINE IF THE DISK IS O/S OR DOS FORMATTED. 00198000 * THE CCW CHAIN IS THEN PASSED THROUGH A TEST TO FIND OUT 00199000 * IF THERE ARE ANY WRITE CCWS. IF A WRITE CCW IS FOUND, 00200000 * THE DISK IS CHECKED FOR WRITE MODE. IF THE DISK IS R/O 00201000 * THE CHANNEL PROGRAM IS NOT EXECUTED. NOW, THE CHANNEL 00202000 * PROGRAM IS DIAGNOSED TO CP FOR EXECUTION. UPON RETURN 00203000 * FROM THE CP DIAGNOSE, THE CCB IS POSTED ACCORDINGLY. 00204000 *. 00205000 EJECT 00206000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00207000 * * 00208000 * INITALIZATION... SAVE SOME REGISTERS IN EXCP WORK AREA. * 00209000 * CHECK IF CHANNEL PROGRAMS SUPPLIED WITH CCB. * 00210000 * * 00211000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00212000 PUNCH 'SPB' @VA06270 00213000 SPACE 2 00214000 DMSXCP CSECT @V305001 00215000 USING NUCON,R0 ADDRESSABILITY @V305001 00216000 USING IOCCW,R10 ... @V305001 00217000 USING DOSSECT,R11 ... @V305001 00218000 USING DMSXCP,R12 ... @V305001 00219000 STM R12,R1,DOSSAVE SAVE SOME REGISTERS @V305001 00220000 LR R12,R15 ESTABLISH BASE @V305001 00221000 LA R13,2048(,R12) GET 2ND PAGE OF ADDRESSABILITY @V305001 00222000 LA R13,2048(,R13) ... @V305001 00223000 USING DMSXCP+4096,R13 ... @V305001 00224000 LR R2,R1 SAVE CCB POINTER @V305001 00225000 USING DMSCCB,R2 REFERENCE "CCB" DSECT @V305001 00226000 ICM R3,7,CCBCCW GET CCW ADDRESS FROM CCB @V305001 00227000 BZ NOCCWA IF NONE, ERROR @V305001 00228000 EJECT 00229000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00230000 * * 00231000 * DETERMINE IF UNIT IS ASSIGNED. IF UNIT ASSIGNED, * 00232000 * USE THE PUB DEVTYPE TO BRANCH TO CORRESPONDING * 00233000 * I/O ROUTINE. * 00234000 * * 00235000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00236000 SPACE 2 00237000 BAL R4,GETPUB GET DEVICE PUB ADDR @V305001 00238000 USING PUBADR,R5 @V305001 00239000 SR R1,R1 CLEAR @V305001 00240000 IC R1,PUBDEVT GET PUB DEVICE TYPE @V305001 00241000 SRL R1,4 ... @V305001 00242000 CH R1,=H'6' EXCEEDS MAX ALLOWED ? @V305001 00243000 BH UNSUPP YES, ERROR @V305001 00244000 SLL R1,2 ... @V305001 00245000 B IORTN(R1) BRANCH TO CORRECT RTNE @V305001 00246000 DROP R5 @V305001 00247000 SPACE 1 00248000 IORTN B IOCON CONSOLE @V305001 00249000 B IORDR READER @V305001 00250000 B IOPCH PUNCH @V305001 00251000 B UNSUPP ERROR @V305001 00252000 B IOPRT PRINTER @V305001 00253000 B IOTAP TAPE @V305001 00254000 B IODSK DISK @V305001 00255000 EJECT 00256000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00257000 * * 00258000 * I/O ROUTINE TO PROCESS UNIT ASSIGNED TO IGNORE. * 00259000 * * 00260000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00261000 SPACE 2 00262000 IODUM SR R5,R5 ... @V305001 00263000 DUMLOOP TM 0(R3),VALCCW VALID CCW CODE? @V305066 00264000 BZ INVCCW NO, ERROR @V305001 00265000 TM 0(R3),CONTROL CONTROL CCW @V305066 00266000 BO DUMNXT YES, GET NEXT CCW @V305001 00267000 BM DUMRW POSSIBLE READ/WRITE @V305001 00268000 TM 0(R3),RDBKCCW READ BACK CCW ? @V305066 00269000 BO DUMRD YES, BRANCH @V305001 00270000 TM 0(R3),TICCCW TIC CCW ? @V305066 00271000 BZ DUMTIC YES, BRANCH @V305001 00272000 DUMNXT TM 4(R3),CC CCW CHAINED ? @V305001 00273000 BZ DUMEND NO, GET OUT @V305001 00274000 DUMNXT2 LR R6,R3 SAVE THIS CCW ADDRESS @V305001 00275000 LA R3,8(,R3) GET NEXT CCW ADDRESS @V305001 00276000 B DUMLOOP GO PROCESS THIS ONE @V305001 00277000 SPACE 00278000 DUMTIC TM 0(R6),STATMOD WAS LAST CCW A STATUS MODIFIER? @V305066 00279000 BZ DUMTIC2 NO, USE TIC ADDRESS TO CONTINUE @V305001 00280000 TM 0(R6),STATMOD2 STILL LOOKS LIKE STATUS MODIFIER @V305066 00281000 BZ DUMTIC2 NO, GO USE TIC ADDRESS @V305001 00282000 B DUMNXT2 ASSUME STATUS MODIFIER BEFORE TIC@V305001 00283000 DUMTIC2 L R3,0(,R3) GET TIC TRANSFER TO ADDRESS @V305001 00284000 LA R3,0(,R3) CLEAR HI ORDER BYTE (CCW CODE) @V305001 00285000 B DUMLOOP CONTINUE SEARCH FOR READ CCW @V305001 00286000 SPACE 1 00287000 DUMRW TM 0(R3),WRITECCW IS CCW FOR WRITE? @V305066 00288000 BO DUMNXT YES, BRANCH @V305001 00289000 DUMRD LA R5,READSW SET READ SWITCH @V305066 00290000 B DUMNXT GO GET NEXT CCW @V305001 00291000 SPACE 1 00292000 DUMEND XC CCBCNT(2),CCBCNT CLEAR RESIDUAL COUNT @V305001 00293000 NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 00294000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 00295000 LTR R5,R5 WERE WE READING ? @V305001 00296000 BZ EXCPEND NO, ALL DONE @V305001 00297000 LH R4,6(,R3) GET DATA COUNT FROM CCW @V305001 00298000 STH R4,CCBCNT SAVE RESIDUAL COUNT @V305001 00299000 OI CCBCOM1,CCBEOF SET BYTE 2 CCB FOR EOF @V305001 00300000 OI CCBCOM2,CCBEOC+CCBVER SET BYTE 3 CCB FOR EOF @V305001 00301000 OI CCBCSW1,CCBUE SET BYTE 1 CSW FOR EOF @V305001 00302000 B EXCPEND ALL DONE @V305001 00303000 EJECT 00304000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00305000 * * 00306000 * I/O ROUTINE TO PROCESS UNIT ASSIGNED TO PRINTER. * 00307000 * * 00308000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00309000 SPACE 2 00310000 IOPRT EQU * @V305001 00311000 LA R0,DWS4 GET NO. DOUBLE WORDS @V305066 00312000 DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR @V305001 00313000 ST R1,DOSOP+8 SAVE WORK IN DOS @V305001 00314000 XC 0(16,R1),0(R1) ZERO OUT FIRST 16 BYTES @V305001 00315000 LA R10,16(,R1) POINT TO BUFDATA @V305001 00316000 MVC DOSOP(8),PIOSI SET COMMAND NAME @V305001 00317000 OI DOSFLAGS,EIGHT IF UC/UE IND. BREAK CCW CHAIN @V305066 00318000 PRNEXT MVC IOCCW(8),0(R3) MOVE CCW TO BUFDATA @V305001 00319000 MVC IOCCW+8(8),NOOP MOVE NO-OP CCW TOO @V305001 00320000 LA R5,CHAINON SET CHAIN SWITCH ON @V305066 00321000 TM 4(R10),CC IS CCW CHAINED ? @V305001 00322000 BO PRCALL YES, JUST CALL PIO @V305001 00323000 OI 4(R10),CC TURN CHAIN BIT ON @V305001 00324000 SR R5,R5 SET CHAIN SWITCH OFF @V305001 00325000 PRCALL LA R1,DOSOP GET ADDR PLIST @V305001 00326000 SVC 202 CALL DMSPIOSI @V305001 00327000 DC AL4(PRERR) ERROR EXIT @V305001 00328000 LTR R5,R5 WAS CCW CHAINED ? @V305001 00329000 BZ PREXIT NO, EXIT @V305001 00330000 LA R3,8(,R3) BUMP TO NEXT CCW @V305001 00331000 B PRNEXT PROCESS NEXT ONE @V305001 00332000 SPACE 1 00333000 PREXIT LA R0,DWS4 GET NO. OF DOUBLE WORDS @V305066 00334000 L R1,DOSOP+8 GET WORK ADDRESS @V305001 00335000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305001 00336000 NI DOSFLAGS,F7 TURN OFF PRINTER INDICATOR @V305066 00337000 B IODONE2 ALL DONE @V305001 00338000 EJECT 00339000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00340000 * * 00341000 * PROCESS I/O ERRORS TO PRINTER. ONLY ERRORS RETURNED * 00342000 * TO USER ARE CHANNEL 9/12 SENSED CONDITIONS. * 00343000 * * 00344000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00345000 SPACE 2 00346000 PRERR NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 00347000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 00348000 NI DOSFLAGS,F7 TURN OFF PRINTER INDICATOR @V305066 00349000 LH R3,CSW+6 GET RESIDUAL COUNT FROM CSW @V305001 00350000 STH R3,CCBCNT SAVE IN CCB @V305001 00351000 LR R3,R15 SAVE RETURN CODE @V305001 00352000 LA R0,DWS4 NO. DWORDS TO FREE @V305066 00353000 L R1,DOSOP+8 AREA ADDR TO FREE @V305001 00354000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305001 00355000 CH R3,=H'100' DEVICE NOT ATTACHED ? @V305001 00356000 BE CANCEL YES, ERROR @V305001 00357000 CH R3,=H'2' CHANNEL 12 SENSED ? @V305001 00358000 BE PRCH12 YES, GO POST IT @V305001 00359000 LR R15,R3 ERROR CODE TO R15 @V305001 00360000 BL OUTERR NO, ERROR @V305001 00361000 CH R3,=H'3' CHANNEL 9 SENSED ? @V305001 00362000 BH OUTERR NO, ERROR @V305001 00363000 PRCH9 OI CCBCOM2,CCBVER POST CHANNEL 9 IN CCB @V305001 00364000 B EXCPEND GET OUT @V305001 00365000 PRCH12 OI CCBCSW1,CCBUE POST CHANNEL 12 IN CCB @V305001 00366000 B EXCPEND GET OUT @V305001 00367000 EJECT 00368000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00369000 * * 00370000 * I/O ROUTINE TO PROCESS UNIT ASSIGNED TO CARD. * 00371000 * NO STACKER SELECT OR COLUMN BINARY IS ALLOWED. * 00372000 * * 00373000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00374000 SPACE 2 00375000 IORDR EQU * @V305001 00376000 IOPCH EQU * @V305001 00377000 LA R10,DOSOP+8 GET IOCCW ADDRESS @V305001 00378000 CDNEXT MVC IOCCW(8),0(R3) MOVE CCW TO WORK @V305001 00379000 TM IOCCW,READCCW IS CCW CODE FOR READ? @V305066 00380000 BO CDCCOK YES, GOOD SO FAR @V305001 00381000 NI IOCCW,255-STACKOFF TURN STACKER OFF @V305066 00382000 CDCCOK NI IOCCW,255-DATAOFF TURN DATA MODE OFF @V305066 00383000 LA R4,CDCODES GET CCW CODES LIST @V305001 00384000 LA R5,ENDCDC GET NUMBER CODES IN LIST @V305001 00385000 B IOSRCH FIND PROPER ROUTINE @V305001 00386000 SPACE 1 00387000 CDREAD LA R4,CARDRD GET COMMAND NAME @V305001 00388000 B CDCOMM GO TO COMMON CODE @V305001 00389000 CDPUNCH LA R4,CARDPH GET COMMAND NAME @V305001 00390000 CDCOMM MVC DOSOP(8),0(R4) MOVE COMMAND NAME @V305001 00391000 MVC IOLEN1(2),IOLEN2 MOVE DATA LENGTH @V305001 00392000 MVI IOSW,OFF .... @V305066 00393000 LA R1,DOSOP GET PLIST ADDRESS @V305001 00394000 SVC 202 GO TO CARDRD OR CARDPH @V305001 00395000 DC AL4(CDERR) ERROR EXIT @V305001 00396000 CDEXIT TM 4(R3),CC CCW CHAINED ? @V305001 00397000 BZ CDDONE NO, SET RESIDUAL COUNT @V305001 00398000 LA R3,8(,R3) BUMP TO NEXT CCW @V305001 00399000 B CDNEXT GO PROCESS IT @V305001 00400000 SPACE 1 00401000 CDDONE CLC DOSOP(8),CARDRD WHERE WE DOING READS ? @V305001 00402000 BNE IODONE2 NO, SET RESIDUAL COUNT TO ZERO @V305001 00403000 LH R4,IOLEN1 GET USER DATA LENGTH @V305001 00404000 LH R5,IOLEN2 GET NUMBER BYTES READ @V305001 00405000 SR R4,R5 COMPUTE RESIDUAL COUNT @V305001 00406000 BP CDCOUNT BRANCH IF POSITIVE @V305001 00407000 SR R4,R4 NEGATIVE - ZERO COUNT @V305001 00408000 CDCOUNT STH R4,CCBCNT SAVE COUNT IN CCB @V305001 00409000 B IODONE ALL DONE @V305001 00410000 EJECT 00411000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00412000 * * 00413000 * PROCESS I/O ERRORS TO CARD. ONLY ERRORS RETURNED * 00414000 * TO USER ARE INCORRECT LENGTH OR END-OF-FILE. * 00415000 * * 00416000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00417000 SPACE 2 00418000 CDERR NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 00419000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 00420000 CH R15,=H'100' DEVICE NOT ATTACHED ? @V305001 00421000 BE CANCEL YES, ERROR @V305001 00422000 CH R15,=H'3' UNKNOWN ERROR ? @V305001 00423000 BE INERR YES, BRANCH @V305001 00424000 BL CDEOF MUST BE END-OF-FILE @V305001 00425000 OI CCBCSW2,CCBILEN SET INCORRECT LENGTH @V305001 00426000 XC CCBCNT(2),CCBCNT CLEAR RESIDUAL COUNT @V305001 00427000 B EXCPEND GET OUT @V305001 00428000 CDEOF OI CCBCOM1,CCBEOF SET BYTE 2 CCB FOR EOF @V305001 00429000 OI CCBCOM2,CCBEOC+CCBVER SET BYTE 3 CCB FOR EOF @V305001 00430000 OI CCBCSW1,CCBUE SET BYTE 1 CSW FOR EOF @V305001 00431000 LH R4,IOLEN1 GET DATA COUNT @V305001 00432000 STH R4,CCBCNT SAVE AS RESIDUAL COUNT @V305001 00433000 B EXCPEND GET OUT @V305001 00434000 EJECT 00435000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00436000 * * 00437000 * I/O ROUTINE TO PROCESS UNIT ASSIGNED TO CONSOLE. * 00438000 * * 00439000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00440000 SPACE 2 00441000 IOCON EQU * @V305001 00442000 LA R10,DOSOP+8 GET IOCCW ADDRESS @V305001 00443000 LA R6,UPCASE SET UP DEFAULT UPCASE @V305066 00444000 USING PUBADR,R5 @V305001 00445000 TM PUBTAPM1,LOWCHK USER WANTS LOWER CASE? @V305066 00446000 BZ CNNEXT NO, USE DEFAULT UPPER CASE @V305001 00447000 LA R6,LOWCASE SET UP LOWCASE FLAG @V305066 00448000 DROP R5 @V305001 00449000 CNNEXT MVC IOCCW(8),0(R3) MOVE CCW TO WORK @V305001 00450000 LA R4,CNCODES GET CCW CODES LIST @V305001 00451000 LA R5,ENDCNC GET NUMBER CODES IN LIST @V305001 00452000 B IOSRCH FIND PROPER ROUTINE @V305001 00453000 SPACE 1 00454000 CNREAD LA R4,CONRD GET COMMAND NAME @V305001 00455000 STC R6,IOLEN1 SET UPPER/LOWER CASE @V305001 00456000 LA R0,DWS20 GET BUFFER @V305066 00457000 DMSFREE DWORDS=(0),TYPCALL=BALR @V305001 00458000 STCM R1,MASK7,IOBUF SAVE BUFFER ADDR @V305066 00459000 B CNCOMM GO TO COMMON CODE @V305001 00460000 CNWRITE1 MVI IOLEN1+1,CARRRET SET CARRIAGE RETURN @V305066 00461000 B CNWRITE GO TO COMMON WRITE CODE @V305001 00462000 CNWRITE2 MVI IOLEN1+1,NOCARRET SET NO CARR RETURN @V305066 00463000 CNWRITE LA R4,CONWR GET COMMAND NAME @V305001 00464000 MVI IOLEN1,B SET CODE @V305066 00465000 EJECT 00466000 CNCOMM MVC DOSOP(8),0(R4) MOVE COMMAND TO PLIST @V305001 00467000 MVI IOSW,ON JUST A FLAG @V305066 00468000 LA R1,DOSOP GET PLIST ADDRESS @V305001 00469000 SVC 202 GO TO CONSOLE I/O @V305001 00470000 CLC DOSOP(8),CONRD DOING READS ? @V305001 00471000 BNE CNEXIT NO, CHECK NEXT CCW @V305001 00472000 TM 4(R3),SKIP SKIP BIT ON IN CCW? @VA08352 00473000 * IE. NO TRANSFER OF DATA 00474000 BO CNEXIT IF NOTDATA THEN DON'T MVC @VA08352 00475000 LH R4,6(,R3) GET DATA LENGTH @V305001 00476000 CLC IOLEN1+2,=H'0' ANYTHING READ ? @V305001 00477000 BE CNEOF NO, SET UP FOR EOF... @V305001 00478000 LR R5,R4 SAVE LENGTH @VA05628 00479000 SH R5,IOLEN2 DETERMINE RESIDUAL COUNT @VA05628 00480000 STH R5,CCBCNT STORE IT IN CCB @VA05628 00481000 BCTR R4,R0 LENGTH LESS ONE FOR MVC @V305066 00482000 ICM R5,MASK7,1(R3) GET USER'S BUFFER ADDR @V305066 00483000 ICM R1,MASK7,IOBUF GET OUR BUFFER ADDR @V305066 00484000 EX R4,CNMOVE MOVE FROM OURS TO HIS @V305001 00485000 LA R0,DWS20 GET BUFFER LENGTH @V305066 00486000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305001 00487000 TM 4(R3),CC IS CCW CHAINED ? @VA05628 00488000 BZ IODONE NO, GET OUT ! @VA05628 00489000 CNEXIT TM 4(R3),CC CCW CHAINED ? @V305001 00490000 BZ IODONE2 NO, GET OUT @V305001 00491000 LA R3,8(,R3) GET NEXT CCW @V305001 00492000 B CNNEXT GO PROCESS IT @V305001 00493000 SPACE 1 00494000 CNEOF OI CCBCOM2,CCBEOC+CCBVER SET BYTE 3 CCB FOR EOF @V305001 00495000 OI CCBCSW1,CCBUE SET BYTE 1 CSW FOR EOF @V305001 00496000 STH R4,CCBCNT SAVE RESIDUAL COUNT @V305001 00497000 B EXCPEND GET OUT @V305001 00498000 SPACE 1 00499000 CNMOVE MVC 0(0,R5),0(R1) MVC EXECUTED @V305001 00500000 EJECT 00501000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00502000 * * 00503000 * I/O ROUTINE TO PROCESS UNIT ASSIGNED TO TAPE. * 00504000 * * 00505000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00506000 SPACE 2 00507000 IOTAP EQU * @V305001 00508000 LR R10,R11 GET IOCCW ADDRESS @V305001 00509000 USING PUBADR,R5 PUB ADDRESSABILITY @V305001 00510000 XC DOSDSMD(8),DOSDSMD ZERO WORK @V305001 00511000 LH R4,PUBCUU GET UNIT ADDRESS @V305001 00512000 SLL R4,4 1/2 BYTE TO LEFT @V305001 00513000 ST R4,DOSDSMD+4 SAVE IN WORK @V305001 00514000 OI DOSDSMD+7,H0C DUMMY A SIGN @V305066 00515000 UNPK DOSTAPID(4),DOSDSMD+4(4) UNPACK UNIT ADDRESS @V305001 00516000 OI DOSTAPID+3,ZONE ZONE IT AND ALL DONE @V305066 00517000 MVC IOCCW(16),MDSET MOVE DUMMY CCWS TO WORKAREA @V305001 00518000 CLI PUBTAPM1,USERMODE USER SPECIFIED MODE? @V305066 00519000 BE IOTAP2 NO, BRANCH AROUND @V305001 00520000 MVC IOSW,PUBTAPM1 SET USER TAPE MODE SET @V305001 00521000 DROP R5 @V305001 00522000 IOTAP2 STCM R3,MASK7,IOCCW+9 PT. TIC TO USER'S CCW CHAIN @V305066 00523000 BAL R9,CHKWRCCW CHECK IF ANY WRITE CCW ON CHAIN @V305001 00524000 LR R1,R10 GET CHANNEL PROG. ADDRESS @V305001 00525000 LA R6,TAPE ERROR MSG SUBSTITUTION @V305001 00526000 BAL R9,DIAGCON GO DIAGNOSE THE I/O @V305001 00527000 SPACE 2 00528000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00529000 * * 00530000 * THE ONLY I/O ERROR RETURNED TO USER IS END-OF-FILE * 00531000 * OR INCORRECT LENGTH. * 00532000 * ALL OTHER I/O ERRORS WILL BE CONSIDERED TERMINAL. * 00533000 * * 00534000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00535000 SPACE 2 00536000 TM DOSSENSE+1,FILEPROT TAPE FILE PROTECTED? @V305066 00537000 BO ERR43E YES, GIVE ERROR MSG @V305001 00538000 LA R15,THREE ERROR MSG SUBSTITUTION @V305066 00539000 B ERR411S PERM I/O ERROR THEN @V305066 00540000 EJECT 00541000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00542000 * * 00543000 * I/O ROUTINE TO PROCESS UNIT ASSIGNED TO DISK. * 00544000 * * 00545000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00546000 SPACE 2 00547000 IODSK LR R10,R11 SAVE WORK AREA POINTER @V305001 00548000 ICM R11,MASK7,CCBCSW GET POSSIBLE DOSCB ADDRESS @V305066 00549000 BZ CHKDSK NO DOSCB, CHECK DASD @V305001 00550000 CLC DOSCBID,=CL4'DLBL' IS THIS GOOD DLBL ? @V305001 00551000 BNE CHKDSK NO, LOOKS LIKE NOT-CMS DISK @V305001 00552000 CLI DOSDEV,DOSDSK CHECK SOME MORE IN DOSCB @V305001 00553000 BNE CHKDSK SHOULD BE EQUAL FOR DOSCB @V305001 00554000 MVC INDEX(24,R11),INDEX(R10) MVE SAVD REGS->NEW AREA@V305001 00555000 SR R4,R4 CLEAR.. @V305001 00556000 C R4,DOSOSFST IS I/O TO NON-CMS DISK ? @V305001 00557000 BNE CHKDSK2 BRANCH IF NOT CMS DISK @V305001 00558000 LA R10,DOSBUFF GET IOCCW ADDRESS @V305001 00559000 USING PUBADR,R5 @V305001 00560000 SPACE 00561000 * INDEX IS USED TO PICKUP PROPER TRK/CYL FOR THE SPECIFIED 00562000 * DASD DEVICE. CON2314 WILL BE INDEX 0, ETC. 00563000 SPACE 00564000 SR R8,R8 SET INDEX TO 0 @V305001 00565000 CLI PUBDEVT,T2314 2314 DASD ? @V305001 00566000 BE SDNEXT YES, BRANCH @V305001 00567000 LA R8,INDEX2 SET INDEX TO 2 @V305066 00568000 CLI PUBDEVT,T3330 3330 DASD ? @V305001 00569000 BE SDNEXT YES, BRANCH @V305001 00570000 CLI PUBDEVT,T333B 3330-11 DASD ? @V505098 00571000 BE SDNEXT YES, BRANCH @V505098 00572000 LA R8,INDEX4 SET INDEX TO 4 @V305066 00573000 TM PUBDEVT,T3340 IS IT 3340 (69 OR 6A) @VA08259 00574000 BO SDNEXT IF YES BR, IF NOT TST NXT @VA08259 00575000 LA R8,INDEX6 SET INDEX TO 6 @V505098 00576000 DROP R5 @V305001 00577000 SDNEXT MVC IOCCW(8),0(R3) MOVE CCW TO WORK @V305001 00578000 SR R4,R4 CLEAR @VA08678 00579050 IC R4,IOSW GET CCW CODE @VA08678 00579100 A R4,ASDCODES DISPLACE INTO CODES LIST @VA08678 00579150 SR R5,R5 CLEAR @VA08678 00579200 IC R5,0(0,R4) GET ROUTINE ID @VA08678 00579250 B DSKRTN(R5) BRANCH TO PROPER ROUTINE @VA08678 00579300 DSKRTN DS 0H @VA08678 00579350 B INVCCW 00 INVALID CCW CODE @VA08678 00579400 B SDEXIT 04 NO-OP @VA08678 00579450 B SDSRCHID 08 SEARCH ID @VA08678 00579500 B SDRDCNT 0C READ COUNT @VA08678 00579550 B SDREAD 10 READ KEY AND DATA @VA08678 00579600 B SDRDCKD 14 READ COUNT, KEY AND DATA @VA08678 00579650 B SDWRCKD 18 WRITE COUNT,KEY AND DATA @VA08678 00579700 B SDWRITE 1C WRITE, KEY AND DATA @VA08678 00579750 B SDEXIT2 20 TIC CCW @VA08678 00579800 EJECT 00586000 SDREAD LA R4,RDBUF GET COMMAND NAME @V305001 00587000 TM 4(R3),SKIP SKIP FLAG ON ? @V305001 00588000 BO SDEXIT YES, DON'T BOTHER THEN.. @V305001 00589000 B SDCOMM GO TO COMMON CODE @V305001 00590000 SDWRITE LA R4,WRBUF GET COMMAND NAME @V305001 00591000 CLC CCBSYMU,=H'2' WRITING TO SYSPCH ? @V305001 00592000 BNE SDCOMM NO, CONTINUE AS NORMAL @V305001 00593000 LA R9,EIGHTY1 PREPARE TO CHECK IF WRITING 81 @V305066 00594000 CH R9,DOSBYTE+2 WRITING 81 BYTES? @V305001 00595000 BNE SDCOMM NO, MUST NOT BE TEXT DECK @V305001 00596000 BCTR R9,R0 DECREMENT TO 80 @V305066 00597000 STH R9,DOSBYTE+2 STORE NEW LENGTH IN PLIST @V305001 00598000 L R9,DOSBUFF ADDRESS I/O BUFFER @V305001 00599000 LA R9,1(,R9) POINT TO 2ND POSITION IN BUFFER @V305001 00600000 STCM R9,7,DOSBUFF+1 STORE NEW ADDRESS IN PLIST @V305001 00601000 SDCOMM LA R1,DOSOP GET PLIST ADDRESS @V305001 00602000 CLC DOSOP(8),0(R4) DOING SAME OPER AS BEFORE ? @V305001 00603000 BE SDCOMM2 YES, DO NOT FINIS @V305001 00604000 L R15,AFINIS GET DMSFNS ADDRESS @V305001 00605000 BALR R14,R15 FINIS THIS FILE @V305001 00606000 SDCOMM2 MVC DOSOP(8),0(R4) MOVE COMMAND NAME @V305001 00607000 XC DOSBYTE(2),DOSBYTE CLEAR 1ST HALF LENGTH @V305001 00608000 MVI DOSBUFF,OFF CLEAR 1ST BYTE BUFF ADD @V305066 00609000 MVC DOSCOUT(2),=H'1' SET ITEM COUNT TO 1 @V305001 00610000 CLC DOSITEM,=H'1' ITEM LESS THAN ONE ? @V305001 00611000 BNL SDCOMM3 NO, BRANCH @V305001 00612000 MVC DOSITEM,=H'1' SET ITEM NUMBER TO 1 @V305001 00613000 SDCOMM3 LA R1,DOSOP GET PLIST ADDRESS @V305001 00614000 L R15,ARDBUF GET RDBUF ADDRESS @V305001 00615000 CLC DOSOP,RDBUF DOING READS ? @V305001 00616000 BE SDCOMM4 YES, BRANCH AROUND @V305001 00617000 L R15,AWRBUF GET WRBUF ADDRESS @V305001 00618000 SDCOMM4 BALR R14,R15 GO DO I/O @V305001 00619000 BNZ SDERR BRANCH IF ERRORS ... @V305001 00620000 SDEXIT TM 4(R3),CC CCW CHAINED ? @V305001 00621000 BZ SDDONE NO, CHECK RESIDUAL COUNT @V305001 00622000 SDEXIT2 LA R3,8(,R3) BUMP TO NEXT CCW @V305001 00623000 B SDNEXT GO PROCESS IT @V305001 00624000 EJECT 00625000 SDDONE CLI 20(R2),DTFSD IS THIS SD DTF? @VM03081 00626000 BNE SDDONE2 NO, JUST EXIT @V305001 00627000 TM 21(R2),SDWORK IS THIS DTFSD WORKFILE? @VM03081 00628000 BNO SDDONE1 @V305066 00629000 XC 30(2,R2),30(R2) ZERO TRACK CAPACITY @V305001 00630000 L R14,DOSSAVE+4 RECOVER R13 AT INPUT @V305001 00631000 USING SSAVE,R14 REFERENCE SAVE AREA BRIEFLY @V305001 00632000 CLC EGPR5(4),=F'19069' TRACK CAPACITY JUNK ? @V505098 00633000 BH SDDONE2 NO, BRANCH @V305001 00634000 XC EGPR5(4),EGPR5 ZERO TRACK CAPACITY @V305001 00635000 DROP R14 @V305001 00636000 SDDONE2 CLC DOSOP(8),RDBUF WHERE WE DOING READS ? @V305001 00637000 BE SDRDBUF YES, COMPUTE RESIDUAL COUNT @V305066 00638000 CLI 20(R2),DTFSD IS THIS DTFSD? @VM03081 00639000 BNE IODONE2 NO @VM03081 00640000 TM 21(R2),SDWORK SD WORKFILE ? @VM03081 00641000 BO IODONE2 YES @VM03081 00642000 TM 21(R2),BLOCK BLOCKED DTFSD FILE? @VM03081 00643000 BNO IODONE2 NO, SKIP NEXT INST @VM03081 00644000 XC 154(2,R2),154(R2) ZERO TRK CAP FOR TRUNCS @V305066 00645000 B IODONE2 BR TO SET RESIDUAL COUNT @V305066 00646000 SDRDBUF EQU * @VA06022 00647000 * ELIMINATE WLR ON VAR RECORDS 00648000 CLC DOSFORM(L'VAR),VAR FIXED FILE? @VA06022 00649000 BNE SDRDBUF1 YES CONTINUE NORMALLY @VA06022 00650000 TM 100(2),FIXED FIXED @VA06022 00651000 BZ SDNORES NO, NO LENGTH CHECK @VA08357 00652000 SDRDBUF1 EQU * @VA06022 00653000 CLI 0(R3),VSRDCNT IS CURRENT CCW A READ COUNT @VA10745 00653100 BNE VSROK1 NO-FORGET RD CNT AFTER READ @VA10745 00653200 ICM R4,15,DOSREAD SEE IF EOF ON READCNT @VA10745 00653300 BZ SDNORES YES-IN THIS CASE NO RESID CNT @VA10745 00653400 VSROK1 EQU * CONTINUE TO TEST FOR RESID CNT @VA10745 00653500 L R4,DOSBYTE GET USERS DATA LENGTH @VA06022 00654000 L R5,DOSREAD GET NUMBER BYTES READ @V305001 00655000 SR R4,R5 COMPUTE RESIDUAL COUNT @V305001 00656000 BP SDCOUNT BRANCH IF COUNT POSITIVE @V305001 00657000 SDNORES EQU * @VA06022 00658000 SR R4,R4 SET COUNT TO ZERO @V305001 00659000 STH R4,CCBCNT STORE COUNT IN CCB @VA05550 00660000 B IODONE AND FINISH UP @VA05550 00661000 SDCOUNT STH R4,CCBCNT SAVE COUNT IN CCB @V305001 00662000 OI CCBCSW2,CCBILEN INDICATE INCORRECT LENGTH @VA05550 00663000 NC CCBERMAP(4),NOPIOCS TURN OFF PIOS BITS @VA05550 00664000 B IODONE2 I/O COMPLETE @VA12870 00665000 SDDONE1 CLI 104(R2),CPSD DTFCP CONVERTED TO DTFSD? @VA04510 00666000 BE SDDONE2 YES, SKIP DTF MODIFICATION @VA04510 00667000 * FIX DTF CORE OVERLAY ON VAR READ 00668000 TM 21(R2),INP INPUT FILE? @VA06022 00669000 BO SDDONE2 YES - NO MODIFICATION @VA06022 00670000 TM 100(R2),FIXED FIXED LENGTH RECORDS? @VA04411 00671000 BO SDDONE2 YES, NO DTF MODIFICATION @V305066 00672000 TM 100(R2),UNDEF UNDEFINED OUTPUT? @V305066 00673000 BZ SDDONE3 NO, NO DTF MODIFICATION @V305066 00674000 MVC 160(2,R2),82(R2) MOVE TRK CAP TO DTF FIELD @V305066 00675000 B SDDONE2 @V305066 00676000 SDDONE3 EQU * @VA06022 00677000 XC 164(2,R2),164(R2) CLEAR TRACK CAP ON VARBLK OP @V305066 00678000 B SDDONE2 CONTINUE . . . @V305066 00679000 EJECT 00680000 SDSRCHID L R4,0(R3) GET CCHHR ADDRESS @V305001 00681000 LA R4,0(,R4) ... @V305001 00682000 SR R5,R5 CLEAR REG 5 @VA15315 00683000 ICM R5,B'0011',0(R4) LOAD CC INTO REG 5 @VA15315 00683500 MH R5,CON2314(R8) COMPUTE RELATIVE TRACK @V305001 00684000 AH R5,2(,R4) ADD HH TO RELATIVE TRACK @V305001 00685000 SR R6,R6 ... @V305001 00686000 IC R6,4(,R4) GET R NUMBER @V305001 00687000 AR R5,R6 ADD RECORD NUMBER @V305001 00688000 STH R5,DOSITEM SAVE AS NEW DOSITEM @V305001 00689000 B SDEXIT @V305001 00690000 SPACE 1 00691000 SDWRCKD LH R4,DOSITEM GET ITEM NO. (FROM LAST SEARCH) @V305001 00692000 LA R4,1(,R4) UP BY ONE @V305001 00693000 STH R4,DOSITEM SAVE NEW ITEM NUMBER @V305001 00694000 L R4,DOSBUFF GET BUFFER ADDRESS @V305001 00695000 SR R1,R1 ZERO CONSTANT @V305001 00696000 CH R1,6(,R4) IS DATA LENGTH ZERO ? @V305001 00697000 BE SDEXIT YES, TRY NEXT CCW @V305001 00698000 LA R4,8(,R4) BYPASS COUNT FIELD @V305001 00699000 ST R4,DOSBUFF SAVE NEW BUFFER ADDRESS @V305001 00700000 LH R4,DOSBYTE+2 GET DATA LENGTH @V305001 00701000 SH R4,=H'8' LESS COUNT LENGTH @V305001 00702000 STH R4,DOSBYTE+2 SAVE NEW DATA LENGTH @V305001 00703000 BNZ SDWRITE IF MORE DATA, GO TO WRITE @V305001 00704000 TM 4(R3),CD IS CCW DATA CHAINED ? @V305001 00705000 BZ SDEXIT NO, THEN TRY NEXT CCW @V305001 00706000 LA R3,8(,R3) POINT TO NEXT CCW @V305001 00707000 MVC IOCCW(8),0(R3) MOVE NEW CCW TO WORK @V305001 00708000 B SDWRITE GO PERFORM DATA WRITE @V305001 00709000 SPACE 1 00710000 SDRDCKD BAL R7,SDRDCNT1 GO READ COUNT FIRST @V305001 00711000 TM 4(R3),CD IS CCW DATA CHAINED ? @V305001 00712000 BO SDRDKD YES, GO READ FROM NEXT CCW @V305001 00713000 LH R4,6(,R3) GET CCW DATA LENGTH @V305001 00714000 SH R4,=H'8' LESS COUNT LENGTH @V305001 00715000 STH R4,DOSBYTE+2 SAVE NEW DATA LENGTH @V305001 00716000 BZ SDEXIT IF DATA LENGTH 0, EXIT @V305001 00717000 LR R4,R6 GET CCW BUFFER ADDRESS @V305001 00718000 LA R4,8(,R4) BUMP PAST COUNT READ @V305001 00719000 ST R4,DOSBUFF SAVE NEW BUFFER ADDRESS @V305001 00720000 B SDREAD GO READ KEY & DATA @V305001 00721000 SDRDKD LA R3,8(,R3) BUMP TO NEXT CCW @V305001 00722000 MVC IOCCW(8),0(R3) MOVE NEW CCW TO WORK @V305001 00723000 B SDREAD GO READ KEY & DATA @V305001 00724000 EJECT 00725000 SDRDCNT LA R7,SDEXIT SET RETURN ADDRESS @V305001 00726000 OI 0(R3),MT INSURE MULTI TRACK OPERATION @VA05969 00727000 * (PROTECTS AGAINST LOST RECORDS) @VA05969 00728000 SDRDCNT1 TM 4(R3),SKIP SKIP FLAG ON ? @V305001 00729000 BO SDEXIT YES, DON'T BOTHER @V305001 00730000 LH R4,DOSITEM GET ITEM NUMBER @V305001 00731000 LA R4,1(,R4) POINT TO NEXT ITEM @V305001 00732000 STH R4,DOSITEM SAVE IN PLIST @V305001 00733000 * ELIMINATE DROP VAR RECORDS ON READ 00734000 CLC DOSOP,RDBUF READ ? @VA06022 00735000 BNE SDRDCNT4 NO - CONTINUE NORMALLY @VA06022 00736000 CLC DOSDSTYP(THREE),SYS IS IT A SYSTEM WORK FILE @VA07764 00737000 BE SDRDCNT5 YES - GO GET MAX RECLEN OR EOF @VA07764 00738000 TM 100(2),FIXED VARIABLE TYPE RECORD? @VA06022 00739000 BO SDRDCNT4 NO - CONTINUE NORMALLY @VA06022 00740000 TM 21(R2),INP INPUT FILE? @VA10244 00740250 BO SDBYPASS BYPASS OUTPUT TEST @VA10244 00740500 TM 100(2),UNDEF VARIABLE FILE? @VA06022 00741000 BZ SDRDCNT4 NO - HANDLE NORMALLY @VA06022 00742000 SDBYPASS EQU * @VA10244 00742500 CLC DOSFORM(L'VAR),VAR VARIABLE FILE? @VA06022 00743000 BNE SDRDCNT4 NO - GO UPDATE @VA06022 00744000 TM 21(2),SDWORKF WORK FILE? @VA06022 00745000 BO SDRDCNT4 YES - HANDLE NORMALLY @VA06022 00746000 NI 73(2),255-2 RESET NEXT HEAD FLAG @VA06022 00747000 SDRDCNT4 EQU * @VA06022 00748000 LA R1,DOSOP POINT TO FILE'S FILEID @V305001 00749000 L R15,AFINIS GET FINIS ADDRESS @V305001 00750000 BALR R14,R15 TEMP. CLOSE THIS FILE @V305001 00751000 L R15,VCFSTLKP GET FST LOOKUP ROUTINE ADDR. @VM03093 00752000 BALR R14,R15 GO FIND FST... @V305001 00753000 BNZ SDRDCNT3 NOT FOUND OR ERROR..BRANCH @V305001 00754000 L R1,32(,R1) GET MAX ITEM LENGTH @V305001 00755000 ST R1,DOSBYTE SAVE IN PLIST AS LENGTH @V305001 00756000 MVC DOSOP(8),RDBUF PREPARE TO READ ITEM @V305001 00757000 LA R1,7(,R1) PREPARE TO ROUND @V305001 00758000 SRL R1,3 TO DOUBLE WORD @V305001 00759000 LR R0,R1 NOW MOVE IT TO R0.. @V305001 00760000 DMSFREE DWORDS=(0),TYPCALL=BALR @V305001 00761000 ST R1,DOSBUFF AND SAVE BUFFER ADDR IN PLIST @V305001 00762000 XC DOSBYTE(2),DOSBYTE MAKE SURE LENGTH OK @V305001 00763000 MVI DOSBUFF,OFF AND BUFFER IS LEGAL @V305066 00764000 MVC DOSCOUT(2),=H'1' SET ITEM COUNT TO 1 @V305001 00765000 LA R1,DOSOP GET PLIST ADDRESS @V305001 00766000 L R15,ARDBUF GET RDBUF ADDRESS @V305001 00767000 BALR R14,R15 GO READ ... @V305001 00768000 LR R5,R15 SAVE RET CODE TEMPORARILY @V305001 00769000 L R1,DOSBYTE GET BUFFER LENGTH @V305001 00770000 LA R1,7(,R1) PREPARE TO ROUND @V305001 00771000 SRL R1,3 TO DOUBLE WORD BOUNDARY @V305001 00772000 LR R0,R1 MOVE TO REG. 0 @V305001 00773000 L R1,DOSBUFF GET FREE AREA LOCATION @V305001 00774000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305001 00775000 LTR R15,R5 RESTORE RETURN CODE @V305001 00776000 BZ SDRDCNT2 IF ZERO, BRANCH @V305001 00777000 CH R15,=H'8' INCORRECT LENGTH ? @V305001 00778000 BE SDRDCNT2 YES, BRANCH @V305001 00779000 CH R15,=H'12' END-OF-FILE ? @V305001 00780000 BNE ERR104S NO, GIVE ERROR MSG @V305001 00781000 SDRDCNT3 XC DOSREAD(4),DOSREAD ZERO BYTES READ IF HERE.. @V305001 00782000 EJECT 00783000 SDRDCNT2 LH R6,CON2314(R8) GET DEVICE CONSTANT @V305001 00784000 LR R5,R4 SET UP FOR DIVIDE @V305001 00785000 BCTR R5,R0 ITEM NO. - 1 TO ACCOUNT FOR R1 @V305066 00786000 SR R4,R4 ... @V305001 00787000 DR R4,R6 COMPUTE CYL & TRK NOS. @V305001 00788000 L R6,0(,R3) POINT TO USER'S BUFFER @V305001 00789000 LA R6,0(,R6) ... @V305001 00790000 STH R4,2(,R6) SUPPLY TRACK NUMBER @V305001 00791000 STH R5,0(,R6) SUPPLY CYLINDER NUMBER @V305001 00792000 MVI 4(R6),REC1 AND RECORD NUMBER TO 1 @V305066 00793000 L R4,DOSREAD GET NUMBER BYTES READ @V305001 00794000 STCM R4,MASK7,5(R6) SUPPLY KL &DL @V305066 00795000 BR R7 ALL DONE @V305001 00796000 SPACE 00797000 SDRDCNT5 DS 0H @VA07764 00798000 LR R5,R4 LOAD RECORD NUMBER PLUS ONE @VA07764 00799000 BCTR R5,R0 RECORD NUMBER TO BE PROCESSED @VA07764 00800000 STH R5,DOSITEM SAVE IN PLIST @VA07764 00801000 LA R1,DOSOP ADDR OF PLIST FOR FST FILE LKUP @VA07764 00802000 L R15,ASTATE PREPARE TO CALL STATE @VA07764 00803000 BALR R14,R15 DOES FILE EXIST @VA07764 00804000 BNZ SDRDCNT3 NO - ZERO OUT BYTES READ @VA07764 00805000 L R5,DOSBUFF GET ADDRESS OF I/O BUFFER @VA07764 00806000 USING FSTSECT,R5 ADDRESS FST @VA07764 00807000 CH R4,FSTIC HAVE WE READ LAST RECORD @VA07764 00808000 BH SDRDCNT3 YES - ZERO OUT BYTES READ @VA07764 00809000 MVC DOSREAD,FSTIL NUMBER OF BYTES TO BE READ @VA07764 00810000 B SDRDCNT2 COMPUTE CYL/TRACK AND EXIT @VA07764 00811000 EJECT 00812000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00813000 * * 00814000 * THE ONLY I/O ERRORS RETURNED TO THE USER IS END-OF-FILE * 00815000 * OR INCORRECT LENGTH. ALL OTHER I/O ERRORS WILL BE CON- * 00816000 * SIDERED TERMINAL. * 00817000 * * 00818000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00819000 SPACE 2 00820000 SDERR NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 00821000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 00822000 CLC DOSOP(8),WRBUF DOING WRITES ? @V305001 00823000 BE ERR105S YES, GIVE ERROR MSG @V305001 00824000 CH R15,=H'12' WAS IT END-OF-FILE ? @V305001 00825000 BE SDEOF YES, BRANCH @V305001 00826000 CH R15,=H'8' WAS IT INCORRECT LENGTH ? @V305001 00827000 BNE ERR104S NO, GIVE ERROR MSG @V305001 00828000 TM 4(R3),SILI SUPP. I.L. SPECIFIED ? @V305001 00829000 BO SDEXIT YES, IGNORE ERROR THEN.. @V305001 00830000 OI CCBCSW2,CCBILEN SET IL FLAG IN CCB @V305001 00831000 L R4,DOSBYTE GET USER DATA LENGTH @V305001 00832000 L R5,DOSREAD GET NUMBER BYTES READ @V305001 00833000 SR R4,R5 COMPUTE RESIDUAL COUNT @V305001 00834000 B SDERR2 GO BELOW.... @V305001 00835000 SDEOF OI CCBCOM1,CCBEOF SET BYTE 2 CCB FOR EOF @V305001 00836000 OI CCBCOM2,CCBEOC+CCBVER SET BYTE 3 CCB FOR EOF @V305001 00837000 OI CCBCSW1,CCBUE SET BYTE 1 CSW FOR EOF @V305001 00838000 L R4,DOSBYTE GET USER DATA LENGTH @V305001 00839000 SDERR2 STH R4,CCBCNT SAVE RESIDUAL COUNT IN CCB @V305001 00840000 B EXCPEND GET OUT @V305001 00841000 EJECT 00842000 USING PUBADR,R5 @V305001 00843000 USING ALTWORK,R10 @V305001 00844000 CHKDSK LR R11,R10 GET DMSXCP WORK IN R11 @V305001 00845000 CHKDSK2 LA R1,PUBDSKM POINT TO DISK MODE IN PUB @V305001 00846000 SH R1,=H'24' PREPARE ADTLKP PLIST @V305001 00847000 L R15,VCADTLKP GET ADTLKP ADDRESS @VM03093 00848000 BALR R14,R15 GO FIND ADT @V305001 00849000 BC 2,NOADT NO ADT FOUND, ERROR @V305001 00850000 USING ADTSECT,R1 @V305001 00851000 TM ADTFLG2,ADTFROS+ADTFDOS DOS OR O/S DISK ? @V305001 00852000 BZ NOTDOSOS NO, I DON'T KNOW WHAT'S HAPP'NG @V305001 00853000 LA R9,CHKEND INITIALIZE FOR LOOP EXIT @V305001 00854000 CHKWRCCW SR R4,R4 CLEAR... @V305001 00855000 CHKLUP TM 0(R3),VALCCW LET'S LOOK AT CCW'S @V305066 00856000 BZ INVCCW IF INVALID CCW, ERROR @V305001 00857000 TM 0(R3),TICCCW IS IT TIC CCW? @V305066 00858000 BZ CHKTIC YES, BRANCH TO GET NEXT ADDRESS @V305001 00859000 TM 0(R3),CONTROL CHECK FOR CONTROL/READ/WRITE @V305066 00860000 BZ CHKNXT BRANCH IF NONE OF ABOVE @V305001 00861000 BO CHKNXT BRANCH FOR CONTROL @V305001 00862000 CHKWRT TM 0(R3),WRITECCW IS IT WRITE CCW? @V305066 00863000 BZ CHKNXT NO, BRANCH @V305001 00864000 TM 0(R3),CCWE0 IS IT WRITE CCW? @V305066 00865000 BNZ CHKNXT NO, BRANCH @V305001 00866000 LA R4,WRITEFLG SET WRITE FLAG @V305066 00867000 CHKNXT TM 4(R3),CC CCW CHAINED ? @V305001 00868000 BZR R9 NO, ALL DONE WITH CHECK @V305001 00869000 CHKNXT2 LR R6,R3 SAVE THIS CCW ADDRESS @V305001 00870000 LA R3,8(,R3) BUMP TO NEXT CCW IN CHAIN @V305001 00871000 B CHKLUP KEEP CHECKING @V305001 00872000 SPACE 00873000 CHKTIC TM 0(R6),STATMOD WAS LAST CCW A STATUS MODIFIER? @V305066 00874000 BZ CHKTIC2 NO, USE ADDR OF TIC TO CONTINUE @V305001 00875000 TM 0(R6),STATMOD2 STILL LOOKS LIKE STATUS MODIFIER @V305066 00876000 BZ CHKTIC2 NO, USE ADDRESS IN TIC CCW @V305001 00877000 B CHKNXT2 ASSUME STATUS MODIFIER BEFORE TIC@V305001 00878000 CHKTIC2 L R3,0(,R3) GET TIC TRANSFER TO ADDRESS @V305001 00879000 LA R3,0(,R3) CLEAR HI ORDER BYTE (CCW CODE) @V305001 00880000 B CHKLUP CONTINUE SEARCH FOR R/W CCW @V305001 00881000 SPACE 00882000 CHKEND LTR R4,R4 ATTEMPTING TO WRITE ? @V305001 00883000 BZ DIAGCP NO, THEN CHANNEL PGMS OK @V305001 00884000 TM ADTFLG3,ADTFRW IS DISK ACCESSED FOR WRITES ? @V305001 00885000 BZ NOTRW NO, THEN WON'T LET WRITE @V305001 00886000 DROP R1 @V305001 00887000 EJECT 00888000 DIAGCP DS 0H LET 'CP' DO THE I/O: @V305001 00889000 LA R6,DISK GET 'DISK' MSG SUBSTITUTION @V305001 00890000 LA R9,DIAGCON1 GET RETURN FROM DIAGNOSE @V305001 00891000 L R14,DOSSAVE+4 RECOVER "R13 AT INPUT" @V305001 00892000 USING SSAVE,R14 AND REF. THE SAVE AREA BRIEFLY @V305001 00893000 L R15,CALLER GET ADDR OF 'CALLER'(LIKE OLDPSW)@V305001 00894000 CL R15,ADIKQLAB IS HE PERCHANCE 'IKQLAB' ? @V305001 00895000 BL DIAGIO NO - FORGET IT - CONTINUE. @V305001 00896000 CL R15,NDIKQLAB LOOKS PROMISING - CHECK FURTHER: @V305001 00897000 BL IKQLAB YES - MUST HANDLE SPECIALLY. @V305001 00898000 DROP R14 NO - CONTINUE: @V305001 00899000 DIAGIO ICM R1,MASK7,CCBCCW GET CHANNEL PGMS @V305066 00900000 DIAGCON LH R0,PUBCUU GET VIRTUAL DEVICE ADDRESS @V305001 00901000 XC CSW,CSW ZERO OUT CSW @V305001 00902000 DC X'83010020' DIAGNOSE I/O TO CP @V305001 00903000 LM R7,R8,CSW GET CSW TO REGS. 7 AND 8 @V305001 00904000 STH R8,CCBCNT PASS RESIDUAL COUNT @VA12729 00905000 BZ IODONE GOOD I/O, EXIT @VA12729 00905250 BM ERR113S DEVICE NOT ATTACHED EXIT @V305001 00906000 BP DIAGCON3 CHECK EOF (UNIT EXCEPTION) @V305001 00907000 STH R1,DOSSENSE SAVE STATUS INFORMATION @V305001 00908000 BR R9 RETURN TO CALLER @V305001 00909000 SPACE 1 00910000 DIAGCON1 TM DOSSENSE,F5 ONLY TRACK OR DATA CHECK ALLOWED @V305066 00911000 BNZ IOERR NO, ERROR @V305001 00912000 TM DOSSENSE+1,HEX17 ANYMORE NOT ALLOWED @V305066 00913000 BNZ IOERR YES, ERROR @V305001 00914000 TM DOSSENSE,TRACK TRACK CONDITION? @V305066 00915000 BO ALTRACK YES, HANDLE ALTERNATE TRACK @V305001 00916000 DIAGCON2 NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 00917000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 00918000 STCM R8,MASK12,CCBCSW1 CSW STATUS TO CCB @V305066 00919000 STH R8,CCBCNT SAVE RESIDUAL COUNT @V305001 00920000 OC CCBCOM2(1),DOSSENSE+1 SET TRANSMISION OF SENSE @V305001 00921000 STCM R7,MASK7,CCBCSW CSW ADDRESS IN CSW TO CCB @V305066 00922000 TM DOSSENSE,DATACHK ANY DATA CHECK? @V305066 00923000 BZ EXCPEND NO, GET OUT @V305001 00924000 OI CCBCOM2,CCBDC POST DATA CHECK IN CCB @V305001 00925000 B EXCPEND GET OUT @V305001 00926000 SPACE 1 00927000 DIAGCON3 NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 00928000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 00929000 CH R15,=H'2' IS ERROR UNIT EXCEPTION ? @V305001 00930000 BE DIAGCON4 YES, PROCESS AS EOF @V305001 00931000 OI CCBCSW2,CCBILEN SET BYTE 2 CSW FOR I.L. @V305001 00932000 B DIAGCON6 CONTINUE BELOW.. @V305001 00933000 DIAGCON4 LTR R4,R4 WERE ANY WRITES DONE ? @V305001 00934000 BNZ DIAGCON5 YES, DO NOT SET CCBEOF @V305001 00935000 CLC CCBSYMU,IPTLUB IS UNIT EXCEPTION ON SYSIPT ? @VM03090 00936000 BE IODONE2 YES, DON'T REFLECT ERROR IN CCB @VM03090 00937000 OI CCBCOM1,CCBEOF SET BYTE 2 CCB FOR EOF @V305001 00938000 DIAGCON5 OI CCBCOM2,CCBEOC+CCBVER SET BYTE 3 CCB FOR EOF @V305001 00939000 OI CCBCSW1,CCBUE SET BYTE 1 CSW FOR EOF @V305001 00940000 DIAGCON6 STCM R7,MASK7,CCBCSW CCW ADDRESS IN CSW TO CCB @V305066 00941000 STH R8,CCBCNT SAVE RESIDUAL COUNT IN CCB @V305001 00942000 B EXCPEND GET OUT @V305001 00943000 EJECT 00944000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00945000 * * 00946000 * ALTERNATE TRACK ROUTINE. SWITCHES FROM PRIME TRACK * 00947000 * TO ALTERNATE TRACK AND FROM ALTERNATE TO PRIME. * 00948000 * * 00949000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00950000 SPACE 2 00951000 ALTRACK MVC EDCCW0(ALTWLEN),ALTCCWS INITIALIZE WORK AREA @V305001 00952000 LA R1,EDNH GET SEEK BBCCHHR AREA @V305001 00953000 STCM R1,7,EDCCW0+1 INITIALIZE CCW0 BUFFER @V305001 00954000 LA R1,EDHA GET HOME ADDRESS AREA @V305001 00955000 STCM R1,7,EDCCW1+1 INITIALIZE CCW1 BUFFER @V305001 00956000 STCM R1,7,EDCCW6+1 INITIALIZE CCW6 BUFFER @V305001 00957000 LA R1,EDR0 GET RECORD ZERO AREA @V305001 00958000 STCM R1,7,EDCCW2+1 INITIALIZE CCW2 BUFFER @V305001 00959000 STCM R1,7,EDCCW4+1 INITIALIZE CCW4 BUFFER @V305001 00960000 LA R1,EDSA GET SEEK RECORD ZERO AREA @V305001 00961000 STCM R1,7,EDCCW3+1 INITIALIZE CCW3 BUFFER @V305001 00962000 LA R1,EDCCW4 GET TIC TO CCW4 ADDRESS @V305001 00963000 STCM R1,7,EDCCW5+1 INITIALIZE CCW5 BUFFER @V305001 00964000 SH R7,=H'8' POINT TO CCW IN ERROR @V305001 00965000 STCM R7,7,EDCCW7+1 SET TIC TO CCW IN ERROR @V305001 00966000 ICM R3,7,CCBCCW GET CCW CHAIN START @V305001 00967000 ALTLUP TM 0(R3),TICCCW IS IT TIC CCW? @V305066 00968000 BZ ALTTIC YES, BRANCH TO GET NEXT ADDRESS @V305001 00969000 TM 0(R3),CONTROL CHECK FOR CONTROL/READ/WRITE @V305066 00970000 BZ ALTNXT BRANCH IF NONE OF ABOVE @V305001 00971000 BM ALTNXT BRANCH IF POSSIBLE WRITE @V305001 00972000 TM 0(R3),HF0 LOOKS LIKE CONTROL CCW? @V305066 00973000 BNZ ALTNXT NO, BRANCH @V305001 00974000 TM 0(R3),H0C LAST TEST FOR CONTROL @V305066 00975000 BZ ALTNXT NO, BRANCH (IT IS NO-OP) @V305001 00976000 CLM R3,7,EDCCW7+1 IS CONTROL BEFORE CCW IN ERROR ? @V305001 00977000 BNL ALTEND NO, STOP HERE (FOUND ALREADY) @V305001 00978000 ICM R8,7,1(R3) GET CONTROL BBCCHH ADDRESS @V305001 00979000 LH R1,2(,R8) LOAD CC PORTION OF ADDRESS @V305001 00980000 STH R1,EDNH+2 SAVE CC PORTION IN OUR AREA @V305001 00981000 LH R1,4(,R8) LOAD HH PORTION OF ADDRESS @V305001 00982000 LA R1,1(,R1) UP HEAD BY ONE @V305001 00983000 STH R1,EDNH+4 AND SAVE THE NEW HH PORTION @V305001 00984000 ALTNXT TM 4(R3),CC CCW CHAINED ? @V305001 00985000 BZ ALTEND NO, ALL DONE WITH CHECK @V305001 00986000 ALTNXT2 LR R6,R3 GET ADDRESS CURRENT CCW @V305001 00987000 LA R3,8(,R3) BUMP TO NEXT CCW @V305001 00988000 B ALTLUP KEEP CHECKING @V305001 00989000 EJECT 00990000 ALTTIC TM 0(R6),STATMOD WAS LAST CCW A STATUS MODIFIER? @V305066 00991000 BZ ALTTIC2 NO, USE TIC ADDRESS TO CONTINUE @V305001 00992000 TM 0(R6),STATMOD2 STILL LOOKS LIKE STATUS MODIFIER?@V305066 00993000 BZ ALTTIC2 NO, USE TIC ADDRESS THEN @V305001 00994000 B ALTNXT2 ASSUME STATUS MODIFIER BEFORE TIC@V305001 00995000 ALTTIC2 L R3,0(,R3) GET TIC TRANSFER TO ADDRESS @V305001 00996000 LA R3,0(,R3) CLEAR HI ORDER BYTE (CCW CODE) @V305001 00997000 B ALTLUP CONTINUE SEARCH FOR CONTROL @V305001 00998000 SPACE 00999000 ALTEND LH R0,PUBCUU GET VIRTUAL DEVICE ADDRESS @V305001 01000000 LH R0,PUBCUU GET VIRTUAL DEVICE ADDRESS @V305001 01001000 LA R1,EDCCW1 GET READ HOME ADDR & REC 0 CHAIN @V305001 01002000 TM 0(R7),MT IS CCW IN ERROR MT CCW ? @V305001 01003000 BZ ALTIO NO MULTIPLE TRACK, BRANCH @V305001 01004000 LA R1,EDCCW0 GET SEEK CHANNEL PROGRAM @V305001 01005000 ALTIO XC CSW,CSW ZERO OUT CSW @V305001 01006000 DC X'83010020' DIAGNOSE I/O TO CP @V305001 01007000 TM EDHA,ALT IS IT ALTERNATE TRACK? @V305066 01008000 BZ EXITC NO, DEFECTIVE TRACK THEN @V305001 01009000 CLI PUBDEVT,T3350 IS IT A 3350 ? @V505098 01010000 BNE CONTINUE NO, CONTINUE WITH ORGINAL LOGIC @V505098 01011000 CLI EDR0+3,HEAD30 IS HEAD LARGER THAN 30 CYLINDERS @V505098 01012000 BNL CYLEND YES, CYLINDER END THEN @V505098 01013000 B NOT3340 CAN'T BE A 3340 @V505098 01014000 CONTINUE CLI EDR0+3,HEAD19 IS HEAD LARGER THAN 19 ? @V505098 01015000 BNL CYLEND YES, CYLINDER END THEN @V305001 01016000 TM PUBDEVT,T3340 IS IT A 3340 ? @V305001 01017000 BNO NOT3340 NO, THEN BRANCH @V305001 01018000 CLI EDR0+3,HEAD11 IS HEAD LARGER THAN 11? @V305066 01019000 BNL CYLEND YES, CYLINDER END THEN @V305001 01020000 NOT3340 LH R1,EDR0+2 GET ADDRESS OF DEFECTIVE TRACK @V305001 01021000 LA R1,1(,R1) PLUS ONE @V305001 01022000 STH R1,EDR0+2 FOR NEW SEEK ADDRESS @V305001 01023000 EXITC LA R1,EDCCW3 GET NEW CCW CHAIN @V305001 01024000 B DIAGCON AND REISSUE THE I/O @V305001 01025000 SPACE 1 01026000 CYLEND OI CCBCOM2,ENDCYL SET UP CYLINDER END @V305066 01027000 OC CCBCOM2,DOSSENSE+1 POST TRACK OVERRUN OR EOC @V305001 01028000 B EXCPEND GET OUT NOW.. @V305001 01029000 DROP R5,R10 @V305001 01030000 USING IOCCW,R10 @V305001 01031000 SPACE 1 01032000 ALTCCWS CCW SEEK,0,CC,SIX SEEK TO NEW HEAD @V305066 01033000 CCW RDHOME,0,CC+SILI,FIVE READ HOME ADDRESS @V305066 01034000 CCW RDREC0,0,SILI,FOUR READ RECORD ZERO @V305066 01035000 SPACE 1 01036000 CCW SEEK,0,CC,SIX SEEK TO HOME ADDRESS @V305066 01037000 CCW SHHA,0,CC+SILI,FOUR SEARCH HOME ADDRESS EQUAL @V305066 01038000 CCW TIC,0,0,0 TIC TO SEARCH @V305001 01039000 CCW RDHOME,0,CC+SKIP,FIVE READ HOME ADDRESS @V305066 01040000 CCW TIC,0,0,0 TIC TO USER CCW CHAIN @V305001 01041000 SPACE 1 01042000 ALTBUFS DC 3H'0' SEEK TO NEW HEAD BBCCHHR @V305001 01043000 DC 3H'0' READ HOME ADDRESS AREA @V305001 01044000 DC 1H'0' BBCCHHR TO SEEK HOME ADDR @V305001 01045000 DC 2H'0' READ RECORD ZERO AREA @V305001 01046000 SPACE 1 01047000 ALTWLEN EQU (*-ALTCCWS) LENGTH OF WORK AREA @V305001 01048000 EJECT 01049000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01050000 * * 01051000 * IKQLAB HANDLER. PERFORMS SIMULATION OF I/O UTILIZING * 01052000 * DATA AVAILABLE IN DOSCB BLOCK(S) FROM 'DLBL' CALLS BY USER. * 01053000 * * 01054000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01055000 SPACE 01056000 * NOTE: "SUPPORT CODE" FOR THIS SECTION = @V305132 01057000 SPACE 01058000 USING DMSCCB,R2 REMINDER: STILL IN EFFECT @V305001 01059000 SPACE 01060000 * NOTE: R0, R1, R4, R5, R6, R7, R8, R14 AND R15 OK FOR WORK REGISTERS 01061000 SPACE 01062000 IKQLAB SR R4,R4 HNDL 'EXCP' ISSUED BY 'IKQLAB'PRG@V305001 01063000 ICM R4,7,CCBCCW POINT TO CCW-STRING @V305001 01064000 SR R7,R7 CLEAR FOR ICM USE @V305001 01065000 SR R8,R8 ... @V305001 01066000 LA R14,CON5 5 INTO R14 TO CK READ COUNT CCW @V305066 01067000 LA R15,16(,R2) POINT TO CCB + 16 @V305001 01068000 CR R4,R15 DOES CCW-STRING START AT CCB+16? @V305001 01069000 BNE IKQXTENT NO - MUST BE OF "SDCCWS" FORM. @V305001 01070000 LR R4,R2 YES - PURPOSELY SET R4=R2 (N.B.),@V305001 01071000 * NOTE: THIS MEANS "VSAM" 01072000 USING LBLCCW,R4 AND REFERENCE "LBLCCW" CCW-STRING@V305001 01073000 LA R15,CON512 LOOK FOR BYTE COUNT OF 512 @V305066 01074000 CH R15,LBLCCW5+6 IS READ BYTE-COUNT "CORRECT" ? @V305001 01075000 BNE IKQLABNG IF NOT, SOMEBODY GOOFED. @V305001 01076000 CH R14,LBLCCW6+6 & BYTE-CNT OF READ-CNT CCW = 05? @V305001 01077000 BNE IKQLABNG AN ERROR SOMEWHERE IF NOT. @V305001 01078000 L R5,LBLCCW3 PICK UP "SEARCH KEY EQUAL" CCW @V305001 01079000 ICM R7,7,LBLCCW5+1 GET ADDR OF 512-BYTE LABEL RCD, @V305001 01080000 ICM R8,7,LBLCCW6+1 AND ADDRESS OF 5-BYTE COUNT @V305001 01081000 LR R14,R7 ADDR OF 512-BYTE RECORD INTO R14 @V305001 01082000 SR R1,R1 CLEAR R1; R0 IMMATERIAL; R15=512 @V305001 01083000 MVCL R14,R0 CLEAR 512-BYTE LABEL RECORD @V305001 01084000 XC 0(5,R8),0(R8) ALSO CLEAR 5-BYTE COUNT @V305001 01085000 * REMEMBER: R4 = R2. 01086000 USING LABXTREC,R7 REFERENCE LABEL INFORMATION RCD @V305001 01087000 IKQLABJN LR R14,R11 START WITH DOSCB GIVEN BY CALLER @V305001 01088000 USING DOSSECT,R14 ... @V305001 01089000 CLC 0(7,R5),DOSDD DDNAME (E.G. AT 'X48') MATCH ? @V305001 01090000 BE DOSCBFND YES - WE'RE "RIGHT THERE". @V305001 01091000 LH R0,DOSNUM NO - HAVE TO DO IT THE HARD WAY. @V305001 01092000 LTR R0,R0 WE SHOULD HAVE AT LEAST ONE @V305001 01093000 BNP IKQLABNF 'NOT FOUND' IF NO DOSCB BLOCKS @V305001 01094000 L R14,DOSFIRST GET ADDRESS OF FIRST DOSCB BLOCK @V305001 01095000 CHKDOSCB CLC 0(7,R5),DOSDD DDNAME (E.G. AT 'X48') MATCH ? @V305001 01096000 BE DOSCBFND YES - FOUND RIGHT DOSCB BLOCK. @V305001 01097000 ICM R14,MASK7,DOSNEXT+1 NO - GET ADDR OF NEXT BLOCK @V305001 01098000 BCT R0,CHKDOSCB & SEARCH ALL REMAINING DOSCB BLKS@V305001 01099000 DROP R11,R14 @V305001 01100000 B IKQLABNF 'NOT FOUND' IF NOT FOUND ANYWHERE@V305001 01101000 DOSCBFND EQU * CORRECT DOSCB BLOCK FOUND: @V305001 01102000 LR R5,R14 REF. DOSCB VIA R5 FROM NOW ON @V305001 01103000 USING DOSSECT,R5 ... @V305001 01104000 * FILL IN APPROPRIATE DATA FROM DOSCB BLOCK (EXCEPT FOR EXTENT DATA): 01105000 MVC XT001,DOSDD DDNAME @V305001 01106000 MVI XT053,ID1 FORMAT ID = NUMERIC 1 @V305066 01107000 MVI XT060+1,VOLSEQ1 VOLUME SEQ NO. ALWAYS = X'00 @V305066 01108000 MVC XT070(1),DOSTYPE SET OPEN CODE TO 'A' OR 'S' @V305066 01109000 * SET XTUCNAM AND XTBUFSP TO SAME DEFAULT VALUES AS SET BY IKQOPN: 01110000 MVC XTUCNAM,=CL8' ' BLANK VSAM USER CATALOG DDNAME @V305001 01111000 MVC XTBUFSP,=F'-1' SET BUFFER-SPACE TO -1 (X'FF'S)@V305001 01112000 CLI DOSUCNAM,BINZERO WAS USER CATALOG DDNAME GIVEN? @V305066 01113000 BE CHKBUFSP NO - CHECK BUFFER-SPACE FIELD. @V305001 01114000 MVC XTUCNAM,DOSUCNAM YES-STOR VSAM USER CATLG DDNAME@V305001 01115000 CHKBUFSP ICM R15,15,DOSBUFSP GET SIZE OF VSAM I/O BUFFER(S) @V305001 01116000 BZ *+8 IF EMPTY, LEAVE DEFAULT VALUE @V305001 01117000 ST R15,XTBUFSP STORE SIZE OF VSAM I/O BUFFR(S)@V305001 01118000 * OTHER FIELDS = 00 (AND ARE ALREADY CLEAR) 01119000 ICM R6,15,DOSOSDSN GET ADDR OF DATASET-NAME(IF ANY)@V305001 01120000 BZ GETEXTTB IF NONEXISTENT, FORGET IT. @V305001 01121000 MVC XT009(44),0(R6) STORE FILE-ID = DATA-SET-NAME @V305001 01122000 * NOW FILL IN APPROPRIATE EXTENT INFORMATION FROM DOSCB BLOCK: 01123000 GETEXTTB SR R0,R0 INITIALIZE TO ZERO. @V305066 01124000 ICM R6,15,DOSEXTTB GET DOS EXTENT BLOCK @V305066 01125000 IC R0,DOSEXTNO (GET NUMBER DOS EXTENT ENTRIES) @V305066 01126000 LA R9,ELEVEN (SET EXTENT BLOCK LENGTH) @V305066 01127000 BNZ EXTMULTB IF IT EXISTS, BRANCH @V305066 01128000 ICM R6,15,DOSVOLTB GET DOS MULTI-VOL BLOCK @V305066 01129000 IC R0,DOSVOLNO (GET NUMBER MULTI-VOL ENTRIES) @V305066 01130000 LA R9,THREE (SET MULTI-VOL BLOCK LENGTH) @V305066 01131000 BZ GETMINDT IF NEITHER, GET MINIMUM DATA. @V305066 01132000 EXTMULTB STC R0,XT000 SAVE NUMBER OF EXTENT/MULT BLOCKS@V305066 01133000 CLR R2,R4 ARE WE DOING 'VSAM' PROCESSING ? @V305066 01134000 BE XTNTSET8 YES - PROCESS ALL RECORDS. @V305001 01135000 SR R15,R15 NO, ("SEQUENTIAL DISK" NON-VSAM) @V305001 01136000 IC R15,DOSEXTCX GET OLD "CURR.EXTENT" (MAY BE 0) @V305001 01137000 LA R15,1(,R15) ADD ONE, @V305001 01138000 STC R15,DOSEXTCX AND STORE UPDATED VALUE. @V305001 01139000 CR R15,R0 EXCEED TOTAL NUMBER OF EXTENTS? @V305001 01140000 BH XTNTNOMO IF YES, NO "MO" EXTENTS LEFT. @V305001 01141000 XTNTSET8 LA R8,XT084 PT. TO 1ST BLK OF EXTENT ENTRIES @V305001 01142000 USING XT084,R8 AND REFERENCE VIA R8 @V305001 01143000 * NOTE: CMS EXTENT BLOCK IS 11-BYTES EACH, IN THE FOLLOWING FORMAT: 01144000 * BYTE 0: DISK MODE LETTER 01145000 * BYTES 1-2: 2-BYTE LUB 01146000 * BYTES 3-6: STARTING TRACK NUMBER 01147000 * BYTES 7-10: NUMBER OF TRACKS 01148000 * LOOP TO PUT CMS EXTENT INFORMATION INTO THE DOS EXTENT RECORD: 01149000 XTNTLOOP LR R1,R6 PT. TO 1ST ENTRY IN DMS EXT. BLK @V305001 01150000 SH R1,=H'24' (-24) - LOOKING AT A MODE-LETTER @V305001 01151000 L R15,VCADTLKP FIND THE DISK IT'S ON @VM03093 01152000 BALR R14,R15 ... @V305001 01153000 BNZ STRXT090 IF NOT FOUND, DON'T STORE VOLID @V305001 01154000 USING ADTSECT,R1 REFERENCE ADT BRIEFLY @V305001 01155000 MVC XT084,ADTID STORE VOLUME SERIAL NUMBER @V305001 01156000 DROP R1 @V305001 01157000 STRXT090 MVI XT090,EXTYP STORE EXTENT TYPE AS FLAG X'01' @V305066 01158000 SR R1,R1 GET TOTAL NO. OF EXTENTS AGAIN @V305001 01159000 IC R1,XT000 ... @V305001 01160000 SR R1,R0 MINUS NO. EXTENTS LEFT TO PROCESS@V305001 01161000 LA R1,1(,R1) PLUS 1 = NUMBER OF "THIS" EXTENT @V305001 01162000 CLR R2,R4 ARE WE DOING "VSAM" PROCESSING ? @V305001 01163000 BE XTNTSTC YES - PROCESS ALL RECORDS. @V305001 01164000 CLM R1,MASK1,DOSEXTCX IS THIS THE ONE WE WANT? @V305066 01165000 BL XTNTNEXT NOPE - KEEP LOOKING TILL FIND IT @V305001 01166000 XTNTSTC STC R1,XT091 STORE "EXTENT NUMBER" (WHEW) @V305001 01167000 MVC XT100,1(R6) NOW SAVE THE LUB ENTRY @V305001 01168000 CH R9,=H'3' PROCESSING MULTI-VOL BLOCKS ? @V305066 01169000 BE XTNTNOEX YES, BYPASS EXTENT INFORMATION @V305066 01170000 LM R14,R15,3(R6) GET START TRACK NO. & NO. TRACKS @V305001 01171000 STH R14,XT092 STORE EXTENT LOWER- AND @V305001 01172000 STH R15,XT094 THE LENGTH OF THE EXTENT @V305001 01173000 XTNTNOEX CLR R2,R4 ARE WE DOSING 'VSAM' PROCESSING? @V305066 01174000 BNE XTNTDONE NO - WE'RE ALL DONE HERE. @V305001 01175000 LA R8,20(,R8) ADV TO NEXT VOL. SERIAL NO. ETC. @V305001 01176000 XTNTNEXT LA R6,0(R9,R6) AND ADVANCE TO NEXT BLOCK RECORD @V305066 01177000 BCT R0,XTNTLOOP & GET NEXT BLK OF EXTENT INFO @V305001 01178000 DROP R8 WHEN ALL EXTENTS PROCESSED ... @V305001 01179000 XTNTDONE MVC XT054,XT084 FILE SERIAL NO. = 1ST VOL SER NO.@V305001 01180000 B IODONE2 ALL FINISHED; SET SUCCESS & EXIT @V305001 01181000 SPACE 01182000 XTNTNOMO MVI DOSEXTCX,OFF CLEAR CURRENT EXTENT @V305066 01183000 B IKQLABNF GO SET BITS = "NOT FOUND". @V305001 01184000 SPACE 01185000 * NO EXTENT BLOCK - STORE MINIMUM AMOUNT OF DATA WE CAN GET ALONG WITH: 01186000 GETMINDT MVC XT100,DOSYSXXX STORE THE 2-BYTE "LUB", @V305001 01187000 CLI DOSDEV,DOSDUM IS THIS DOSCB FOR A DUMMY FILE? @V305066 01188000 BNE CALLADTL NO, MUST BE DISK THEN.. @V305066 01189000 MVC XT084,=CL6'DUMMY' SUPPLY A DUMMY LABEL, @V305066 01190000 MVI XT070,T INDICATE TLBL, @V305066 01191000 B XTNTDONE AND WE ARE ALL DONE. @V305066 01192000 CALLADTL LA R1,DOSDSMD-24 POINT TO MODE LETTER @V305066 01193000 L R15,VCADTLKP FIND THE DISK IT'S ON @VM03093 01194000 BALR R14,R15 ... @V305001 01195000 BNZ IODONE2 IF NOT THERE, DON'T STORE VOLID @V305001 01196000 USING ADTSECT,R1 REFERENCE ADT BRIEFLY @V305001 01197000 MVC XT084,ADTID STORE VOLUME SERIAL NUMBER @V305001 01198000 DROP R1 @V305001 01199000 MVI XT000,EXT1 SHOW ONE EXTENT FOR VSAM @V305066 01200000 CLI XT070,SAM SEQUENTIAL (SAM) FILE ? @V305066 01201000 BNE XTNTDONE NO, WE'RE ALL DONE @V305066 01202000 MVI XT000,LASTEXT X'40' = LAST EXTENT FOR THIS FILE@V305066 01203000 B XTNTDONE AND WE'RE ALMOST DONE. @V305001 01204000 SPACE 01205000 DROP R5 THRU WITH DOSCB HERE. @V305001 01206000 SPACE 01207000 IKQXTENT DS 0H CCW-STRING IS OF "SDCCWS" FORM: @V305001 01208000 * NOTE: R4 NOT EQUAL TO R2. 01209000 * THIS MEANS "SEQUENTIAL DISK" (NON-VSAM) 01210000 USING CCWSD1,R4 REF. CCWSD1 AND FOLLOWING CCW'S: @V305001 01211000 LA R15,HUNDRED4 LOOK FOR BYTE COUNT OF 104 @V305066 01212000 CH R15,CCWSD8+6 IS READ BYTE-COUNT "CORRECT" ? @V305001 01213000 BNE IKQLABNG IF NOT, SOMEBODY GOOFED. @V305001 01214000 CH R14,CCWSD9+6 BYTE-COUNT OF READ-COUNT CCW=05? @V305001 01215000 BNE IKQLABNG AN ERROR SOMEWHERE IF NOT. @V305001 01216000 L R5,CCWSD6 PICK UP "SEARCH KEY EQUAL" CCW @V305001 01217000 ICM R7,MASK7,CCWSD8+1 GET ADDR OF 104 BYTE EXT. RCD @V305066 01218000 ICM R8,MASK7,CCWSD9+1 AND ADDRESS OF 5 BYTE COUNT @V305066 01219000 LR R14,R7 ADDR OF 104-BYTE RECORD INTO R14 @V305001 01220000 SR R1,R1 CLEAR R1; R0 IMMATL; R15 = 104 @V305001 01221000 MVCL R14,R0 CLEAR 104-BYTE LABEL RECORD @V305001 01222000 XC 0(5,R8),0(R8) ALSO CLEAR 5-BYTE COUNT @V305001 01223000 * REMEMBER: R4 IS NOT EQUAL TO R2 01224000 B IKQLABJN JOIN REGULAR PATH. @V305001 01225000 SPACE 01226000 IKQLABNG EQU * CCW-STRING DOESN'T LOOK CORRECT: @V305001 01227000 SPACE 01228000 IKQLABNF NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 01229000 OC CCBERMAP(4),=X'80000C00' SET CCBWAIT+(CE+DE)BITS@V305001 01230000 DROP R4 @V305066 01231000 USING LBLCCW,R4 @V305066 01232000 TM LBLCCW3,MT IS THIS 'MULTI-TRACK' SEARCH ? @V305066 01233000 BO IKQMTON YES, POST END-OF-CYLINDER THEN...@V305066 01234000 OI CCBCOM2,CCBNOREC SIGNAL 'NO-RECORD-FOUND' @V305001 01235000 B EXCPEND AND GET OUT. @V305001 01236000 IKQMTON OI CCBCOM2,CCBEOC SIGNAL 'END-OF-CYLINDER' @V305066 01237000 B EXCPEND AND GET OUT. @V305066 01238000 SPACE 01239000 DROP R4,R7 DROP LOCAL USAGE; @V305001 01240000 USING DOSSECT,R11 RESTORE NORMAL DOSCB ADDR'BLITY @V305001 01241000 EJECT 01242000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01243000 * * 01244000 * THIS ROUTINE SEARCHES PROPER COMMAND CODE TABLE AND * 01245000 * GIVES CONTROL TO THE ROUTINE THAT WILL SIMULATE * 01246000 * THAT I/O REQUEST. * 01247000 * * 01248000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01249000 SPACE 2 01250000 IOSRCH CLC IOCCW(1),0(R4) DO WE HAVE A MATCH ? @V305001 01251000 BE IOFND YES, GO GET ROUTINE @V305001 01252000 LA R4,4(,R4) BUMP TO NEXT CODE @V305001 01253000 BCT R5,IOSRCH KEEP LOOKING @V305001 01254000 B NOCCWC ERROR IF HERE @V305001 01255000 IOFND L R4,0(,R4) GET ROUTINE ADDRESS @V305001 01256000 BR R4 GO TO IT @V305001 01257000 SPACE 2 01258000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01259000 * * 01260000 * ROUTINE TO CONVERT THE 2-BYTE LOGICAL UNIT IN THE * 01261000 * CCB TO AN EBCDIC SYSXXX LITERAL. * 01262000 * * 01263000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01264000 SPACE 2 01265000 CONVERT SR R5,R5 CLEAR @V305001 01266000 IC R5,CCBSUNUM GET UNIT NUMBER @V305001 01267000 TM CCBSUCLS,PROG IS IT PROGRAMMER UNIT? @V305066 01268000 BO CNVPROG YES, BRANCH @V305001 01269000 SLL R5,2 MULTIPLY BY 4 @V305001 01270000 LA R5,SYSTAB(R5) INDEX TO CORRECT XXX @V305001 01271000 MVC DOSWORK+3(3),0(R5) MOVE XXX TO AREA @V305001 01272000 CONVERT2 MVC DOSWORK(3),=CL3'SYS' MOVE THE SYS TO AREA @V305001 01273000 BR R4 RETURN TO CALLER @V305001 01274000 CNVPROG CVD R5,DOSOSDSN CONVERT UNIT NUMBER @V305001 01275000 UNPK DOSWORK(6),DOSOSDSN(8) UNPACK TO AREA @V305001 01276000 OI DOSWORK+5,ZONE SET LAST ZONE @V305066 01277000 B CONVERT2 GO TO MOVE SYS TO AREA @V305001 01278000 EJECT 01279000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01280000 * * 01281000 * EXITS FROM DMSXCP. * 01282000 * * 01283000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01284000 SPACE 2 01285000 IODONE2 XC CCBCNT(2),CCBCNT CLEAR RESIDUAL COUNT @V305001 01286000 IODONE NC CCBERMAP(4),=X'1F050000' TURN OFF PIOCS BITS @V305001 01287000 IODONE3 EQU * @VA05550 01288000 OC CCBERMAP(4),=X'80000C00' INIT CCB WITH GOOD I/O @V305001 01289000 EXCPEND SR R10,R10 ZERO RETURN CODE @V305001 01290000 XCPOUT LM R12,R1,DOSSAVE RESTORE SAVED REGS @V305001 01291000 LR R15,R10 RETURN CODE TO R15 @V305001 01292000 BR R14 RETURN TO DMSDOS @V305001 01293000 SPACE 2 01294000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01295000 * * 01296000 * THIS ROUTINE WILL FIND THE PROPER LUB FOR THE UNIT * 01297000 * SPECIFIED IN THE CCB. IF THE LUB IS ASSIGNED TO * 01298000 * IGNORE, LABEL IODUM GETS CONTROL. IF THE UNIT IS * 01299000 * NOT ASSIGNED, AND ERROR MESSAGE IS ISSUED. * 01300000 * IF ASSIGNED, THE PROPER PUB IS FOUND, AND WE RETURN * 01301000 * WITH THE ADDRESS OF THE PUB IN R5. * 01302000 * * 01303000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01304000 SPACE 2 01305000 GETPUB L R1,ASYSREF GET BGCOM ADDRESS @V305001 01306000 USING BGCOM,R1 ... @V305001 01307000 SR R5,R5 CLEAR @V305001 01308000 IC R5,CCBSUNUM GET LUB INDEX NO. @V305001 01309000 TM CCBSUCLS,PROG IS IT PROGRAMMER? @V305066 01310000 BNO SYSTEM NO, BRANCH @V305001 01311000 LH R6,NICLPT GET NICL POINTER @V305001 01312000 IC R6,0(,R6) GET NO. SYSTEM UNITS @V305001 01313000 N R6,=X'000000FF' ISOLATE LAST BYTE @V305001 01314000 AR R5,R6 ADD NICL TO LUB INDEX @V305001 01315000 SYSTEM AR R5,R5 LUB INDEX * 2 @V305001 01316000 AH R5,LUBPT INDEX TO CORRECT LUB @V305001 01317000 TM 0(R5),FF UNIT ASSIGNED? @V305066 01318000 BO UNASSGN NO, ERROR @V305001 01319000 TM 0(R5),FE ASSIGNED TO IGNORE @V305066 01320000 BO IODUM YES, GO PROCESS @V305001 01321000 LH R5,0(,R5) LUB ENTRY TO R5 @V305001 01322000 SRL R5,8 ISOLATE PUB POINTER @V305001 01323000 SLL R5,3 MULTIPLY BY 8 @V305001 01324000 AH R5,PUBPT INDEX TO CORRECT PUB @V305001 01325000 BR R4 RETURN TO CALLER @V305001 01326000 DROP R1 @V305001 01327000 EJECT 01328000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01329000 * * 01330000 * EQUATES AND CONSTANTS * 01331000 * * 01332000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01333000 SPACE 1 01334000 * 01335000 * IMPORTANT CCW FLAGS 01336000 * 01337000 CD EQU X'80' @V305001 01338000 CC EQU X'40' @V305001 01339000 SILI EQU X'20' @V305001 01340000 SKIP EQU X'10' @V305001 01341000 * 01342000 SPACE 2 01343000 * ADDITIONAL EQUATES 01344000 SPACE 2 01345000 ELEVEN EQU 11 @V305066 01346000 THREE EQU 3 @V305066 01347000 T EQU C'T' @V305066 01348000 EXT1 EQU X'01' @V305066 01349000 SAM EQU C'S' @V305066 01350000 LASTEXT EQU X'40' @V305066 01351000 VSRDCNT EQU X'92' READ COUNT CCW (VSAM SPECIAL) @VA10745 01351500 VALCCW EQU X'0F' @V305066 01352000 CONTROL EQU X'03' @V305066 01353000 RDBKCCW EQU X'0C' @V305066 01354000 TICCCW EQU X'07' @V305066 01355000 STATMOD EQU X'60' @V305066 01356000 STATMOD2 EQU X'01' @V305066 01357000 WRITECCW EQU X'01' @V305066 01358000 READSW EQU 1 @V305066 01359000 DWS4 EQU 4 @V305066 01360000 CHAINON EQU 1 @V305066 01361000 READCCW EQU X'C0' @V305066 01362000 STACKOFF EQU X'C0' @V305066 01363000 DATAOFF EQU X'20' @V305066 01364000 OFF EQU X'00' @V305066 01365000 UPCASE EQU X'E4' @V305066 01366000 LOWCHK EQU X'08' @V305066 01367000 LOWCASE EQU X'E2' @V305066 01368000 DWS20 EQU 20 @V305066 01369000 MASK7 EQU B'0111' @V305066 01370000 CARRRET EQU X'00' @V305066 01371000 NOCARRET EQU 128 @V305066 01372000 B EQU C'B' @V305066 01373000 ON EQU X'01' @V305066 01374000 H0C EQU X'0C' @V305066 01375000 ZONE EQU X'F0' @V305066 01376000 USERMODE EQU X'00' @V305066 01377000 FILEPROT EQU X'02' @V305066 01378000 INDEX2 EQU 2 LOCATES TRK/CYL FOR 3330'S @V505098 01379000 INDEX4 EQU 4 LOCATES TRK/CYL FOR 3340'S @V505098 01380000 INDEX6 EQU 6 LOCATES TRK/CYL FOR 3350 @V505098 01381000 EIGHTY1 EQU 81 @V305066 01382000 FIXED EQU X'02' @V305066 01383000 UNDEF EQU X'04' @V305066 01384000 INP EQU X'02' @V305066 01385000 REC1 EQU 1 @V305066 01386000 CCWE0 EQU X'E0' @V305066 01387000 WRITEFLG EQU 1 @V305066 01388000 F5 EQU X'F5' @V305066 01389000 HEX17 EQU X'17' @V305066 01390000 TRACK EQU X'02' @V305066 01391000 MASK12 EQU B'1100' @V305066 01392000 DATACHK EQU X'08' @V305066 01393000 HF0 EQU X'F0' @V305066 01394000 HEX0C EQU X'0C' @V305066 01395000 ALT EQU X'01' @V305066 01396000 HEAD30 EQU 30 @V505098 01397000 HEAD19 EQU 19 @V305066 01398000 HEAD11 EQU 11 @V305066 01399000 ENDCYL EQU X'20' @V305066 01400000 SIX EQU 6 @V305066 01401000 FIVE EQU 5 @V305066 01402000 FOUR EQU 4 @V305066 01403000 CON5 EQU 5 @V305066 01404000 CON512 EQU 512 @V305066 01405000 ID1 EQU C'1' @V305066 01406000 VOLSEQ1 EQU X'01' @V305066 01407000 BINZERO EQU X'00' @V305066 01408000 EXTYP EQU X'01' @V305066 01409000 MASK1 EQU B'0001' @V305066 01410000 HUNDRED4 EQU 104 @V305066 01411000 PROG EQU X'01' @V305066 01412000 FF EQU X'FF' @V305066 01413000 FE EQU X'FE' @V305066 01414000 ONE EQU 1 @V305066 01415000 CON179 EQU 179 @V305066 01416000 DTFSD EQU X'20' DTFSD FILE @VM03081 01417000 SDWORK EQU X'24' DTFSD OPEN WORKFILE @VM03081 01418000 BLOCK EQU X'40' BLOCKED FILE @VM03081 01419000 CPSD EQU X'08' DTFCP HAS TIC CCW IN DTF @VA04510 01420000 IPTLUB DC H'1' LUB VALUE FOR SYSIPT @VM03090 01421000 SDWORKF EQU X'20' SD WORK FILE BIT ONLY @VA06022 01422000 VAR DC C'V' COMPARE CONSTANT FOR DOSFORM @VA06022 01423000 EJECT 01424000 * 01425000 * TRACKS / CYLINDER FOR SUPPORTED DASD DEVICES 01426000 * 01427000 CON2314 DC H'20' TRACKS/CYL @V305001 01428000 CON3330 DC H'19' TRACKS/CYL (3330 & 3330-11) @V505098 01429000 CON3340 DC H'12' TRACKS/CYL @V305001 01430000 CON3350 DC H'30' TRACKS/CYL @V505098 01431000 * 01432000 T2314 EQU X'62' 2314 DASD TYPE @V305001 01433000 T3330 EQU X'63' 3330 DASD TYPE @V305001 01434000 T3340 EQU X'68' 3340 DASD TYPE @V305001 01435000 T333B EQU X'65' 3330-11 DASD TYPE @V505098 01436000 T3350 EQU X'67' 3350 DASD TYPE @V505098 01437000 * 01438000 EIGHT EQU X'08' DOS PRINTER INDICATOR @V305066 01439000 F7 EQU X'F7' MASK TO CLEAR DOS PRT FLAG @VM03055 01440000 * 01441000 NOPIOCS DC X'1F050040' ALLOW INCORRECT LENGTH @VA05550 01442000 * 01443000 * COMMANDS AND FUNCTIONS FOR CMS PLISTS 01444000 * 01445000 PIOSI DC CL8'DMSPIOSI' COMMANDS @V305001 01446000 CARDRD DC CL8'CARDRD' COMMANDS @V305001 01447000 CARDPH DC CL8'CARDPH' COMMANDS @V305001 01448000 CONRD DC CL8'CONREAD' COMMANDS @V305001 01449000 CONWR DC CL8'TYPLIN' COMMANDS @V305001 01450000 RDBUF DC CL8'RDBUF' COMMANDS @V305001 01451000 WRBUF DC CL8'WRBUF' COMMANDS @V305001 01452000 SYS DC CL8'SYS' SYSTEM WORK FILE TYPE @VA07764 01453000 * 01454000 * ERROR MESSAGE CONSTANTS 01455000 * 01456000 TAPE DC CL8'TAPE' ... @V305001 01457000 DISK DC CL8'DISK' ... @V305001 01458000 INPUT DC CL8'INPUT' ... @V305001 01459000 OUTPUT DC CL8'OUTPUT' ... @V305001 01460000 READING DC CL8'READING' ... @V305001 01461000 WRITING DC CL8'WRITING' ... @V305001 01462000 EJECT 01463000 * 01464000 * SYSXXX CONSTANTS FOR SYSTEM LOGICAL UNITS 01465000 * 01466000 SYSTAB DS 0H @V305001 01467000 DC CL4'RDR' 00 @V305001 01468000 DC CL4'IPT' 01 @V305001 01469000 DC CL4'PCH' 02 @V305001 01470000 DC CL4'LST' 03 @V305001 01471000 DC CL4'LOG' 04 @V305001 01472000 DC CL4'LNK' 05 @V305001 01473000 DC CL4'RES' 06 @V305001 01474000 DC CL4'SLB' 07 @V305001 01475000 DC CL4'RLB' 08 @V305001 01476000 DC CL4'USE' 09 @V305001 01477000 DC CL4'REC' 0A @V305001 01478000 DC CL4'CLB' 0B @V305001 01479000 DC CL4'VIS' 0C @V305001 01480000 DC CL4'CAT' 0D @V305001 01481000 SPACE 2 01482000 * 01483000 * DUMMY CCWS 01484000 * 01485000 NOOP CCW NOP,0,SILI,ONE NO-OP FOR DMSPIOSI CALL @V305066 01486000 MDSET CCW CON179,0,CC+SILI,ONE DEFAULT MODE SET CCW @V305066 01487000 CCW TIC,0,0,0 TIC TO USER CCW CHAIN @V305001 01488000 EJECT 01489000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01490000 * * 01491000 * CONSOLE CCW CODES * 01492000 * * 01493000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01494000 SPACE 2 01495000 CNCODES DC AL1(10),AL3(CNREAD) - READ INQUIRY @V305001 01496000 DC AL1(2),AL3(CNREAD) - READ READER 2 @V305001 01497000 DC AL1(9),AL3(CNWRITE1) - WRITE, AUTO CARR @V305001 01498000 DC AL1(1),AL3(CNWRITE2) - WRITE, NO AUTO CARR @V305001 01499000 DC AL1(3),AL3(CNEXIT) - NO-OP @V305001 01500000 DC AL1(4),AL3(CNEXIT) - SENSE @V305001 01501000 DC AL1(11),AL3(CNEXIT) - ALARM @V305001 01502000 ENDCNC EQU (*-CNCODES)/4 @V305001 01503000 SPACE 2 01504000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01505000 * * 01506000 * CARD / PUNCH CCW CODES * 01507000 * * 01508000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01509000 SPACE 2 01510000 CDCODES DC AL1(2),AL3(CDREAD) CARD - READ, FEED, SS @V305001 01511000 DC AL1(10),AL3(CDREAD) CARD - READ, FEED, SS @V305001 01512000 DC AL1(1),AL3(CDPUNCH) CARD PUNCH,FEED,SS @VA08678 01512100 DC AL1(4),AL3(CDEXIT) CARD - SENSE @V305001 01513000 DC AL1(17),AL3(CDEXIT) CARD - WRITE RCE @V305001 01514000 DC AL1(49),AL3(CDEXIT) CARD - WRITE OMR @V305001 01515000 DC AL1(194),AL3(CDREAD) CARD - READ @V305001 01516000 DC AL1(204),AL3(CDREAD) CARD - READ @V305001 01517000 DC AL1(210),AL3(CDREAD) CARD - READ, FEED @V305001 01518000 DC AL1(3),AL3(CDEXIT) CARD - FEED, SS @V305001 01519000 DC AL1(11),AL3(CDEXIT) CARD - FEED, SS @V305001 01520000 DC AL1(9),AL3(CDEXIT) CARD - PNCH,FEED,SS,READ@V305001 01521000 ENDCDC EQU (*-CDCODES)/4 LENGTH OF CDCODES @VA08678 01523100 ASDCODES DC A(SDCODES) ADDRESS OF SDCODES TABLE @VA08678 01523200 EJECT 01524000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01525000 * * 01526000 * DASD CCW CODES * 01527000 * * 01528000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01529000 SPACE 2 01530000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 01531100 SDCODES DC X'00,18,04,04,04,1C,10,04,20,00,00,04,00,1C,10,04' 00 01531200 DC X'00,04,0C,04,00,04,04,04,20,04,04,04,00,18,14,04' 10 01531300 DC X'00,00,04,04,04,04,00,04,20,04,00,04,00,04,00,00' 20 01531400 DC X'00,08,00,00,00,04,00,00,20,04,00,00,00,00,00,00' 30 01531500 DC X'00,00,00,00,04,04,00,00,20,04,00,00,00,04,00,00' 40 01531600 DC X'00,08,00,04,00,04,00,00,20,00,00,00,00,00,00,00' 50 01531700 DC X'00,00,00,00,00,04,00,00,20,04,00,00,00,04,00,00' 60 01531800 DC X'00,00,00,04,00,04,00,00,20,00,00,00,00,00,00,00' 70 01531900 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 01532000 DC X'00,00,00,08,00,00,10,04,20,00,00,00,00,00,10,00' 80 01532100 DC X'00,00,0C,00,04,00,04,00,20,00,04,00,00,00,14,00' 90 01532200 DC X'00,00,00,00,04,04,00,00,20,04,00,00,00,04,00,00' A0 01532300 DC X'00,08,00,00,04,04,00,00,20,04,00,00,00,00,00,00' B0 01532400 DC X'00,00,00,00,00,04,00,00,20,04,00,00,00,04,00,00' C0 01532500 DC X'00,08,00,00,00,04,00,00,20,00,00,00,00,00,00,00' D0 01532600 DC X'00,00,00,00,00,04,00,00,20,04,00,00,00,04,00,00' E0 01532700 DC X'00,08,00,00,00,04,00,00,20,00,00,00,00,00,00,00' F0 01532800 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 01532900 EJECT 01608000 LTORG @V305001 01609000 EJECT 01610000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01611000 * * 01612000 * ERROR MESSAGES * 01613000 * * 01614000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01615000 SPACE 2 01616000 ERR43E BAL R4,GETPUB GO FIND PUB FOR THIS UNIT @V305001 01617000 USING PUBADR,R5 @V305001 01618000 LH R7,PUBCUU GET CUU FOR THIS UNIT @V305001 01619000 DROP R5 @V305001 01620000 DMSERR TEXT='TAPE (....) IS FILE PROTECTED',NUM=43,LET=E, *01621000 SUB=(HEX,(R7)) @V305001 01622000 LA R10,36 RETURN CODE @V305001 01623000 B XCPOUT CANCEL THE JOB @V305001 01624000 EJECT 01625000 USING ADTSECT,R1 @VM03127 01626000 NOTRW LA R6,ADTM @VM03127 01627000 L R7,ADTDTA @VM03127 01628000 LH R7,0(,R7) @VM03127 01629000 DMSERR TEXT='OUTPUT DISK ''.. (...)'' IS READ/ONLY', @VM03127*01630000 LET=E,NUM=37,SUB=(CHARA,((R6),1),HEX,(R7)),MF=(E,'SYS') 01631000 LA R10,36 @VM03127 01632000 B XCPOUT @VM03127 01633000 DROP R1 @VM03127 01634000 EJECT 01635000 ERR113S LR R15,R6 SAVE SUB. 1 FOR NOW... @VM03055 01636000 BAL R4,GETPUB GO FIND PUB FOR THIS UNIT @VM03055 01637000 LR R6,R15 RESTORE SUB. 1 POINTER. @VM03055 01638000 USING PUBADR,R5 @V305001 01639000 LH R7,PUBCUU GET CUU FOR THIS UNIT @V305001 01640000 DROP R5 @V305001 01641000 DMSERR TEXT='.... (....) NOT ATTACHED',NUM=113,LET=S, @V305001*01642000 MF=(E,'SYS'),SUB=(CHARA,(R6),HEX,(R7)) @V305001 01643000 CANCEL LA R10,100 RETURN CODE @V305001 01644000 B XCPOUT CANCEL THE JOB @V305001 01645000 EJECT 01646000 ERR104S LA R8,READING ERR MSG OPERATION @V305001 01647000 LA R9,104 ERR MSG NUMBER @V305001 01648000 B ERRCOMM GO TYPE MSG @V305001 01649000 ERR105S LA R8,WRITING ERR MSG OPERATION @V305001 01650000 LA R9,105 ERR MSG NUMBER @V305001 01651000 ERRCOMM LR R6,R15 SAVE RDBUF/WRBUF RETURN CODE @V305001 01652000 LA R7,DOSDSNAM POINT TO FILEID @V305001 01653000 DMSERR TEXT='ERROR ''..'' ........ FILE ''....................*01654000 '' ON DISK',NUM=(R9),LET=S,MF=(E,'SYS'), @V305001*01655000 SUB=(DEC,(R6),CHARA,(R8),CHAR8A,(R7)) @V305001 01656000 B CANCEL CANCEL THE JOB @V305001 01657000 EJECT 01658000 IOERR LA R6,INPUT MSG SUBSTITUTION @V305001 01659000 LTR R4,R4 DOING READ ? @V305001 01660000 BZ ERR411S YES, BRANCH @V305066 01661000 B OUTERR IS WRITING THEN... @V305001 01662000 INERR LA R6,INPUT MSG SUBSTITUTION @V305001 01663000 CLC DOSOP(8),CARDRD DOING CARDIO READ ? @V305001 01664000 BE ERR411S YES, BRANCH @V305066 01665000 OUTERR LA R6,OUTPUT MSG SUBSTITUTION @V305001 01666000 ERR411S LR R7,R15 CODE 'NN' TO R7 @V305066 01667000 BAL R4,CONVERT GET SYSXXX LITERAL @V305001 01668000 DMSERR TEXT='........ ERROR CODE ''..'' ON ''......''', *01669000 NUM=411,LET=S,MF=(E,'SYS'), @V305066*01670000 SUB=(CHARA,(R6),DEC,(R7),CHARA,DOSWORK) @V305001 01671000 B CANCEL CANCEL THE JOB @V305001 01672000 EJECT 01673000 NOCCWA LA R6,1 NN CODE @V305001 01674000 B ERRMSG TYPE MSG @V305001 01675000 UNASSGN LA R6,2 NN CODE @V305001 01676000 L R14,DOSSAVE+4 RECOVER 'R13' AT INPUT @V305001 01677000 USING SSAVE,R14 AND REFERENCE SAVE AREA BRIEFLY @V305001 01678000 L R15,CALLER GET ADDR OF 'CALLER' (AS OLDPSW) @V305001 01679000 CL R15,ADIKQLAB IS HE PERCHANCE 'IKQLAB' ? @V305001 01680000 BL ERRMSG NO, ISSUE ERROR MSG THEN... @V305001 01681000 CL R15,NDIKQLAB LOOKS PROMISING, CHECK FURTHER: @V305001 01682000 BL IKQLAB YES, MUST HANDLE SPECIALLY. @V305001 01683000 DROP R14 NO, CONTINUE: @V305001 01684000 B ERRMSG TYPE MSG @V305001 01685000 UNSUPP LA R6,3 NN CODE @V305001 01686000 B ERRMSG TYPE MSG @V305001 01687000 INVCCW LA R6,4 NN CODE @V305001 01688000 B ERRMSG TYPE MSG @V305001 01689000 NOADT LA R6,5 NN CODE @V305001 01690000 B ERRMSG TYPE MSG @V305001 01691000 NOTUSED LA R6,6 (THIS CODE OPEN FOR FUTURE USE) @VM03127 01692000 B ERRMSG TYPE MSG @V305001 01693000 NOCCWC LA R6,7 NN CODE @V305001 01694000 B ERRMSG TYPE MSG @V305001 01695000 NOTDOSOS LA R6,8 NN CODE @V305001 01696000 SPACE 1 01697000 ERRMSG BAL R4,CONVERT CONVERT 2 BYTE UNIT @V305001 01698000 DMSERR TEXT='UNEXPECTED ERROR CODE ''..'' ON ''......''', *01699000 NUM=161,LET=S,MF=(E,'SYS'),SUB=(DEC,(R6),CHARA,DOSWORK) 01700000 B CANCEL CANCEL THE JOB @V305001 01701000 EJECT 01702000 LTORG @V305001 01703000 EJECT 01704000 DMSCCB , DSECT TO MAP A CCB: @V305001 01705000 EJECT 01706000 * FORM OF CHANNEL PROGRAMS USED BY 'IKQLAB': 01707000 SPACE 01708000 LBLCCW DSECT , CCW-STG TO FIND LABEL INFO RECORD BY KEY: @V305001 01709000 DS 2D CCB IMMED PRECEDES THE CCW-STG: @V305001 01710000 LBLCCW1 CCW SEEK,X40,CC+SILI,6 SEEK TO CYLDR AND HEAD @V305001 01711000 LBLCCW2 CCW SHHA,X42,CC+SILI,4 SEARCH HOME ADDR F/MULT TRK @V305001 01712000 LBLCCW3 CCW SRCHK,X48,CC+SILI,8 SEARCH KEY EQUAL @V305001 01713000 LBLCCW4 CCW TIC,*-8,CC+SILI,1 TIC BACK TO SCHKE @V305001 01714000 LBLCCW5 CCW RDDT,*-*,CC+SILI,512 $ READ LABEL RECORD @V305001 01715000 LBLCCW6 CCW RDCNT+MT,XA8,SILI,5 $ READ CNT OF NEXT RCD(MT)@V305001 01716000 * 01717000 X40 DS 8X SEEK ARGUMENT @V305001 01718000 X42 EQU X40+2 SEARCH HOME ADDRESS ARGUMENT@V305001 01719000 X48 DS 8X SEARCH KEY EQUAL ARG = ACB NAME @V305001 01720000 ORG LBLCCW+X'A8' @V305001 01721000 XA8 DS 5X READ COUNT ARGUMENT @V305001 01722000 * 01723000 SEEK EQU X'07' $ FULL SEEK @V305001 01724000 SHHA EQU X'39' $ SEARCH HOME ADDRESS EQUAL @V305001 01725000 SRCHK EQU X'29' $ SEARCH KEY EQUAL @V305001 01726000 TIC EQU X'08' $ TIC @V305001 01727000 RDDT EQU X'06' $ READ DATA @V305001 01728000 RDCNT EQU X'12' $ READ COUNT @V305001 01729000 RDHOME EQU X'1A' $ READ HOME ADDRESS @V305001 01730000 RDREC0 EQU X'16' $ READ RECORD ZERO @V305001 01731000 MT EQU X'80' MULTI-TRACK BIT IN CMND CODE@V305001 01732000 SPACE 2 01733000 SDCCWS DSECT , CCW-STG TO READ IN AN EXTENT RCD:@V305001 01734000 DB104 DS 104X 104-BYTE DATA-BUFFER PRECEDES CCW-STG@V305001 01735000 CCWSD1 CCW SEEK,*-*,CC+SILI,6 (X40) SEEK TO CYL AND HEAD@V305001 01736000 CCWSD2 CCW SHHA,*-*,CC+SILI,4 (X42) SEARCH HOME ADDRESS @V305001 01737000 CCWSD3 CCW TIC,*-8,CC+SILI,1 TIC BACK TO SHHA @V305001 01738000 CCWSD4 CCW SIDE,*-*,CC+SILI,8 (X42) SEARCH ID EQUAL @V305001 01739000 CCWSD5 CCW TIC,*-8,CC+SILI,1 TIC BACK TO SEARCH ID EQUAL @V305001 01740000 CCWSD6 CCW SRCHK,*-*,CC+SILI,8 (X48) SEARCH KEY EQUAL @V305001 01741000 CCWSD7 CCW TIC,*-8,CC+SILI,1 TIC BACK TO SEARCH KEY EQUAL@V305001 01742000 CCWSD8 CCW RDDT,DB104,CC+SILI,104 $ READ EXTENT RECORD @V305001 01743000 CCWSD9 CCW RDCNT+MT,*-*,SILI,5 (XA8) $ READ CNT OF NXT RCD @V305001 01744000 CCW NOP,0,SILI,1 NO-OP @V305001 01745000 CCW NOP,0,SILI,1 NO-OP @V305001 01746000 * 01747000 SIDE EQU X'31' SEARCH ID EQUAL @V305001 01748000 NOP EQU X'03' NO-OP COMMAND CODE @V305001 01749000 SPACE 01750000 * '$' IS A REMINDER THAT DATA IS READ INTO CALLER'S STORAGE BY THIS CCW 01751000 EJECT 01752000 LABXTREC DSECT , CONTENTS OF LABEL INFO OR EXTENT RCD: @V305001 01753000 * FIRST 84 BYTES: 01754000 XT000 DS XL1 DLBL EXTENT FLAG BYTE @V305001 01755000 XT001 DS CL7 FILENAME @V305001 01756000 XT008 DS XL1 DAM/ISAM SWITCH @V305001 01757000 XT009 DS CL44 FILE ID @V305001 01758000 XT053 DS XL1 FORMAT ID @V305001 01759000 XT054 DS XL6 FILE SERIAL NUMBER @V305001 01760000 XT060 DS XL2 VOLUME SEQUENCE NUMBER @V305001 01761000 XT062 DS XL3 CREATION DATE (4004 B.C. ?) @V305001 01762000 XT065 DS XL3 EXPIRATION DATE @V305001 01763000 XT068 DS XL2 RESERVED @V305001 01764000 XT070 DS XL1 OPEN CODE @V305001 01765000 XT071 DS XL13 SYSTEM CODE @V305001 01766000 ORG XT071 CONTENTS OF "SYSTEM CODE" FIELD: @V305001 01767000 XTUCNAM DS CL8' ' USER CATALOG NAME @V305001 01768000 DS XL1 RESERVED @V305001 01769000 XTBUFSP DS F'-1' BUFFER SPACE @V305001 01770000 * NEXT 20 BYTES (SEE NOTE BELOW): 01771000 XT084 DS CL6 VOLUME SERIAL NUMBER @V305001 01772000 XT090 DS XL1 EXTENT TYPE @V305001 01773000 XT091 DS XL1 EXTENT SEQUENCE NUMBER @V305001 01774000 XT092 DS XL2 EXTENT LOWER LIMIT (REL TRACK) @V305001 01775000 XT094 DS XL2 LENGTH OF THE EXTENT (NO. TRACKS)@V305001 01776000 XT096 DS XL4 EXTENT UPPER LIMIT @V305001 01777000 XT100 DS XL2 LOGICAL (SYMBOLIC) UNIT ADDRESS @V305001 01778000 XT102 DS XL1 2321 LOWER CELL @V305001 01779000 XT103 DS XL1 2321 UPPER CELL @V305001 01780000 SPACE 01781000 * NOTE: FOR SAM FILES, A COMPLETE 104-BYTE BLOCK IS REPEATED FOR 01782000 * EACH NEW EXTENT. FOR DAM, VSAM, AND ISAM FILES, ONLY THE 01783000 * FIELDS FROM THE VOLUME SERIAL NUMBER (XT084) THRU THE 01784000 * LOGICAL (SYMBOLIC) UNIT ADDRESS (XT100) ARE REPEATED. 01785000 EJECT 01786000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01787000 * * 01788000 * DSECT TO MAP A CCW * 01789000 * * 01790000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01791000 SPACE 2 01792000 IOCCW DSECT @V305001 01793000 IOSW DS X @V305001 01794000 IOBUF DS XL3 @V305001 01795000 IOLEN1 DS XL2 @V305001 01796000 IOLEN2 DS XL2 @V305001 01797000 SPACE 2 01798000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01799000 * * 01800000 * DSECT TO MAP A PUB ENTRY * 01801000 * * 01802000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01803000 SPACE 2 01804000 MAPPUB @V305001 01805000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01806000 * * 01807000 * WORK AREA FOR ALTERNATE TRACK SUPPORT. * 01808000 * CONTAINS CCWS AND DATA AREAS TO READ * 01809000 * HOME ADDRESS AND RECORD ZERO. * 01810000 * * 01811000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01812000 SPACE 2 01813000 ALTWORK DSECT @V305001 01814000 EDCCW0 CCW SEEK,0,CC,6 SEEK TO NEW HEAD @V305001 01815000 EDCCW1 CCW RDHOME,0,CC+SILI,5 READ HOME ADDRESS @V305001 01816000 EDCCW2 CCW RDREC0,0,SILI,4 READ RECORD ZERO @V305001 01817000 SPACE 1 01818000 EDCCW3 CCW SEEK,0,CC,6 SEEK TO HOME ADDRESS @V305001 01819000 EDCCW4 CCW SHHA,0,CC+SILI,4 SEARCH HOME ADDRESS EQUAL @V305001 01820000 EDCCW5 CCW TIC,0,0,0 TIC TO SEARCH @V305001 01821000 EDCCW6 CCW RDHOME,0,CC+SKIP,5 READ HOME ADDRESS @V305001 01822000 EDCCW7 CCW TIC,0,0,0 TIC TO USER CCW CHAIN @V305001 01823000 SPACE 1 01824000 EDNH DC 3H'0' SEEK TO NEW HEAD BBCCHHR @V305001 01825000 EDHA DC 3H'0' READ HOME ADDRESS AREA @V305001 01826000 EDSA DC 1H'0' BBCCHHR TO SEEK HOME ADDRESS@V305001 01827000 EDR0 DC 2H'0' READ RECORD ZERO AREA @V305001 01828000 EJECT 01829000 NUCON @V305001 01830000 DOSCB @V305001 01831000 BGCOM @V305001 01832000 ADT @V305001 01833000 FSTB @VA07764 01834000 CMSAVE @V305001 01835000 REGEQU @V305001 01836000 DMSXCP CSECT @V305001 01837000 INDEX EQU (DOSSAVE-DOSINIT) @V305001 01838000 LTORG @V305001 01839000 END 01840000