ISM TITLE 'DMKISM (CP) VM/370 - RELEASE 6' 00001000 ISEQ 73,80 VALIDATE SEQUENCING OF SOURCE 00002000 *. 00003000 * MODULE NAME - 00004000 * 00005000 * DMKISM 00006000 * 00007000 * FUNCTION - 00008000 * 00009000 * TO LOCATE THE ISAM MODIFYING READ IN THE TRANSLATED CCW STRING 00010000 * PASSED BY DMKCCW AND VERIFY THAT IT IS A TRUE ISAM READ. 00011000 * THE REAL CCW STRING (IN RCWTASKS) IS THEN MODIFIED SO THAT 00012000 * THE RESULTING CCW STRING RUNS WITH SELF MODIFYING I/O USING 00013000 * DATA IN THE VIRTUAL MACHINE STORAGE AREA. 00014000 * 00015000 * ATTRIBUTES - 00016000 * 00017000 * RE-ENTRANT, PAGEABLE, CALLED VIA SVC 00018000 * 00019000 * ENTRY POINT - 00020000 * 00021000 * DMKISMTR - FIND AND MODIFY ISAM CCW STRING 00022000 * 00023000 * ENTRY CONDITIONS - 00024000 * 00025000 * R10 = ADDRESS OF IOBLOK 00026000 * R11 = ADDRESS OF VMBLOK 00027000 * R12 = ADDRESSABILITY FOR DMKISM 00028000 * R13 = STANDARD SAVEAREA 00029000 * 00030000 * EXIT CONDITIONS - 00031000 * 00032000 * THE RCWTASK CCW'S HAVE BEEN MODIFIED TO REFERENCE THE 00033000 * VIRTUAL CCW'S SO THAT A SELF MODIFYING SEQUENCE WILL RUN 00034000 * THE IOBIRA HAS BEEN SET TO DMKUNTIS SO THAT UPON 00035000 * COMPLETION OF THE I/O OPERATION CONTROL IS RECEIVED 00036000 * TO UNDO THE MODIFICATIONS AND THEN PROCESS NORMALLY 00037000 * 00038000 * CALLS TO OTHER ROUTINES - 00039000 * 00040000 * DMKFREE - TO GET SAVE BLOCK 00041000 * 00042000 * EXTERNAL REFERENCES - 00043000 * 00044000 * DMKUNTIS - TO GET RETURN ADDRESS 00045000 * 00046000 * TABLES/WORK AREAS - 00047000 * 00048000 * RCWTASK - GET CCW STRINGS, MODIFY 00049000 * SAVE BLOCK - SAVE DATA FOR RESTORE BY DMKUNTIS 00050000 EJECT 00051000 * REGISTER USAGE - 00052000 * 00053000 * R0 - SCRATCH 00054000 * R1 - SCRATCH 00055000 * R2 - REAL ADDRESS OF MODIFIED ISAM CCW 00056000 * R3 - ADDRESS OF ISAM CONTROL WORD AT END OF RCWTASK 00057000 * R4 - RCWTASK BEING EXAMINED FOR ISAM READ 00058000 * R5 - SCRATCH, AND FIRST CCW IN NEXT RCWTASK 00059000 * R6 - LAST CCW IN RCWTASK ( TIC), POINTED TO BY R4 00060000 * R7 - NEXT RCWTASK, AND CCWS IN NEXT RCWTASK 00061000 * R8 - REAL ADDRESS OF ISAM SEEK ARGUMENT 00062000 * R9 - DATA ADDRESS OF ISAM READ CCW 00063000 * R10 - IOBLOK ADDRESSING 00064000 * R11 - VMBLOK ADDRESSING 00065000 * R12 - BASE ADDRESSING 00066000 * R13 - SAVEAREA ADDRESSING 00067000 * R14 - SCRATCH 00068000 * R15 - SCRATCH 00069000 * 00070000 * NOTES - 00071000 * 00072000 * ONLY VERY SPECIFIC ISAM CCWS ARE HANDLED BY THIS PROGRAM 00073000 * THE CCW STRING IS EXAMINED VERY CAREFULLY AND MUST PASS 00074000 * SEVERAL TESTS BEFORE BEING ACCEPTED AS AN ISAM SEQUENCE 00075000 * ONLY THE FOLLOWING OS ISAM CCW STRINGS WILL BE ACCEPTED 00076000 * ( REFER TO OS ISAM PLM FOR DETAILS) 00077000 * 00078000 * CHANNEL PROGRAMS: CP1, CP4/5, CP6, CP8, CP23, CP26 00079000 EJECT 00080000 * OPERATION - 00081000 * 00082000 * 1. EACH RCWTASK IS CHECKED TO FIND THE ISAM CONTROL 00083000 * WORD AT THE END 00084000 * 2. IF THE CONTROL WORD IS NON-ZERO IT CONTAINS THE 00085000 * DISPLACEMENT FROM THE BEGINNING OF THE RCWTASK OF THE 00086000 * ISAM MODIFYING READ. 00087000 * 3. ONCE FOUND THE CCW STRINGS HAVE TO PASS A NUMBER 00088000 * OF TESTS FOR VERIFICATION OF ISAM SEQUENCE. 00089000 * THE FOLLOWING TEST ARE MADE 00090000 * A. THE LAST CCW IN RCWTASK IS A TIC 00091000 * B. THIS RCWTASK POINT TO ANOTHER (NEXT) RCWTASK 00092000 * C. THE NEXT RCWTASK HAS AT LEAST 2 CCWS 00093000 * E. THE FIRST CCW (MODIFIED) IS IN REAL STORAGE 00094000 * F. THE LAST BYTE OF THE ISAM READ OVERLAYS THE 00095000 * OP CODE OF THE FIRST CCW IN THE NEXT RCWTASK 00096000 * G. THE TIC IN THE RCWTASK IS TO THE NEXT RCWTASK 00097000 * FIRST CCW 00098000 * H. THE DATA ADDRESS OF THE FIRST CCW IN THE NEXT RCWTASK 00099000 * (USUALLY A SEEK) IS THE SAME AS THE DATA ADDRESS OF 00100000 * THE ISAM READ PLUS 1, AND IS IN REAL STORAGE 00101000 * 00102000 * 4. IF ALL THE TESTS ARE SATISFIED THE RCWTASK IS ACCEPTED 00103000 * AS AN ISAM MODIFYING SEQUENCE 00104000 * 5. GET AN EIGHT DOUBLE-WORD WORK AREA FROM FREE STORAGE. 00105000 * 6. COPY THE ISAM READ AND TIC CCW'S INTO THE WORK AREA. 00106000 * 7. CHANGE THE READ TO READ INTO THE WORK AREA BLOCK. 00107000 * 8. CHANGE THE TIC TO GO TO A COPY OF THE SEEK WHICH IS 00108000 * BUILT INTO THE WORK AREA, ALSO. 00109000 * 9. BUILD THE SEEK IN THE WORK AREA, USING THE WORK AREA 00110000 * READ BUFFER AS A SEEK ARGUMENT. 00111000 * 10. ADD A TIC FOLLOWING THE SEEK TO RE-JOIN THE ALREADY 00112000 * TRANSLATED STRING (SECOND RCWTASK). 00113000 * 13. SET THE IOBIRA TO DMKUNTIS 00114000 * 14. REPEAT THE STEPS FOR ALL RCWTASKS 00115000 * 15. EXIT TO DMKCCW WHEN COMPLETE 00116000 *. 00117000 EJECT 00118000 DMKISM CSECT 00119000 EXTRN DMKUNTIS 00120000 EXTRN DMKPTRUL @VA02130 00121000 USING PSA,R0 00122000 USING VMBLOK,R11 00123000 USING SAVEAREA,R13 00124000 USING DMKISM,R12 00125000 USING IOBLOK,R10 00126000 USING RCWTASK,R4 00127000 SPACE 00128000 DC CL8'DMKISM' MODULE IDENTIFIER 00129000 SPACE 00130000 DMKISMTR RELOC 00131000 L R4,IOBCAW GET CCW START 00132000 LA R4,0(,R4) CLEAR HI BYTE 00133000 SL R4,F16 BACKUP TO HEADER OF RCWTASK 00134000 * R4 NOW POINTS TO FIRST RCWTASK 00135000 * NOW FIND A NON-ZERO ISAM WORD IN THE RCWTASK 00136000 * IF FOUND R3 POINTS TO THE WORD 00137000 FINDISM LR R3,R4 RCWTASK ADDRESS IN R3 00138000 LH R15,RCWCCNT GET RCWTASK SIZE 00139000 SLL R15,3 SIZE IN BYTES 00140000 ALR R3,R15 POINT R3 TO END OF RCWTASK 00141000 SL R3,F4 BACK OFF 4 BYTES TO ISAM WORD 00142000 L R0,0(,R3) LOAD THE ISAM WORD 00143000 LTR R0,R0 TEST IF ANY ISAM READ IN THIS RCWTASK 00144000 BNZ CHKRD YES, CHECK OUT AND MODIFY 00145000 NXTASK L R4,RCWPNT GET NEXT TCWTASK 00146000 LTR R4,R4 TEST FOR LAST ONE 00147000 BNZ FINDISM NO, CHECK OUT THIS RCWTASK 00148000 EXIT ALL DONE 00149000 EJECT 00150000 * NOW CHECK OUT THE ISAM READ TO SEE IF IT REALLY IS ONE 00151000 CHKRD LR R6,R4 GET ADDRESS OF RCWTASK 00152000 LH R15,RCWRCNT GET REAL CCW COUNT 00153000 LA R15,1(,R15) ONE MORE FOR HEADER SKIP 00154000 SLL R15,3 GET SIZE IN BYTES 00155000 ALR R6,R15 POINT TO LAST CCW IN RCWTASK 00156000 * R6 NOW POINTS TO LAST CCW IN RCWTASK (TIC) 00157000 * LAST CCW IN RCWTASK MUST BE A TIC FOR ISAM 00158000 CLI 0(R6),X'08' IS IT A TIC ?? 00159000 BE CHKTSK YES, CHECK THE READ 00160000 * THE CCW STRING IS NOT A TRUE ISAM SEQUENCE 00161000 NOTISM SR R0,R0 CLEAR 00162000 ST R0,0(,R3) ZERO ISAM WORD 00163000 B NXTASK CHECK OUT NEXT RCWTASK 00164000 SPACE 2 00165000 * TEST FOR ANOTHER RCWTASK .... MUST BE FOR ISAM 00166000 CHKTSK L R7,RCWPNT GET ADDRESS OF NEXT RCWTASK 00167000 LTR R7,R7 TEST FOR MORE 00168000 BZ NOTISM NO MORE, NOT ISAM CCW STRING 00169000 * R7 NOW POINTS TO NEXT RCWTASK 00170000 * NEXT RCWTASK MUST HAVE AT LEAST 2 CCW 00171000 LH R15,RCWRCNT-RCWTASK(R7) GET CCW COUNT 00172000 C R15,F2 IS IT AT LEAST 2 ?? 00173000 BL NOTISM NO, NOT ISAM 00174000 L R5,RCWVCAW-RCWTASK(R7) GET VIRTUAL CCW ADDRESS 00175000 LA R1,0(0,R5) SAVE VIRTUAL ADDRESS IN GR1 @VA02334 00176000 LA R8,4096-8 BOUNDARY DISPLACEMENT 00177000 NR R5,R8 AND OUT ALL BUT DISPLACEMENT 00178000 * TEST THAT VIRTUAL ADDRESS IS IN REAL STORAGE 00179000 TRANS 2,1 GET REAL STORAGE ADDRESS OF ISAM MOD CCW 00180000 BC 6,NOTISM NOT IN STORAGE, NOT ISAM 00181000 * TEST THAT CCW DATA ADDRESS EQUALS CCW ADDRESS MINUS EIGHT 00182000 SL R1,F8 VIRTUAL CCW ADDRESS IS IN GR1 @VA02334 00183000 CLM R1,7,1(R2) IS THE DATA ADDRESS CORRECT ? @VA02334 00184000 BNE NOTISM NO -- NOT AN ISAM CHANNEL PROGRAM@VA02334 00185000 TRANS 8,1 GET THE SEEK ARGUMENT REAL ADDR @VA02334 00186000 BC 6,NOTISM DATA AREA MUST BE IN CORE @VA02334 00187000 * TEST ISAM READ LAST BYTE INTO ISAM MOD CCW 00188000 LR R9,R4 GET ADDRESS OF RCWTASK 00189000 AL R9,0(,R3) ADD DISPLACEMENT - POINT TO ISAM READ 00190000 TM 4(R9),IDA IDA SET IN ISAM READ ? (REMEMBER C.C.) 00191000 L R9,0(,R9) GET ADDRESS OF READ DATA (OR IDAL) 00192000 BZ CHKTSK1 IF IDA NOT SET, JUST BUMP R9 BY 9. 00193000 L R9,4(,R9) IDA SET, GET THE 2ND IDAW 00194000 CL R5,F8 SEEK CCW SHOULD BE 1ST OR 2ND CCW IN PAGE 00195000 BL CHKTSK2 IF R5 (DISP. ONLY) < 8, IT'S THE FIRST. 00196000 BH NOTISM IF R5 > 8, IT CAN'T BE REAL ISAM. 00197000 ALR R9,R5 R5=8, BUMP 2ND IDAW ADDR BY 8 TO CHECK 00198000 B CHKTSK2 10TH BYTE, AND GO CHECK FOR MATCHING ADDR 00199000 CHKTSK1 LA R9,9(,R9) IDA NOT SET - CLEAR HIGH BYTE & ADD NINE 00200000 CHKTSK2 CLR R9,R2 REAL ADDRESSES SHOULD BE THE SAME 00201000 BNE NOTISM NOT AN ISAM SEQUENCE 00202000 * TEST TIC ADDRESS IS TO NEXT RCWTASK FIRST CCW 00203000 L R5,0(,R6) GET TIC ADDRESS 00204000 LA R5,0(,R5) CLEAR HI BYTE 00205000 LA R7,16(,R7) POINT TO FIRST CCW IN NEXT RCWTASK 00206000 CLR R5,R7 TIC MUST GO TO THIS CCW 00207000 BNE NOTISM NOT ISAM SEQUENCE 00208000 * R2 POINTS TO ISAM MODIFIED CCW 00209000 * R3 POINTS TO ISAM WORD IN RCWTASK 00210000 * R4 POINTS TO RCWTASK FOR ISAM READ 00211000 * R5 = R7 POINTS TO FIRST CCW IN NEXT RCWTASK 00212000 * R6 POINTS TO CP TIC IN RCWTASK 00213000 * R8 POINTS TO ISAM SEEK ARGUMENT 00214000 SPACE 2 00215000 * FOR SURE THIS IS AN ISAM MODIFYING READ CCW SEQUENCE 00216000 LA R0,ISMSIZE SIZE OF WORK-AREA BLOCK @VA02130 00217000 CALL DMKFREE ALLOCATE SOME FREE STORAGE @VA02130 00218000 XC 0(ISMSIZE*8,R1),0(R1) CLEAR IT TO ZEROES @VA02130 00219000 USING ISMBLOK,R1 @VA02130 00220000 L R7,0(0,R3) GR7 = DISPLACEMENT TO ISAM READ @VA02130 00221000 ST R1,0(0,R3) SAVE ISMBLOK ADDR IN ISAM WORD @VA02130 00222000 ALR R7,R4 GR7 = ADDR OF ACTUAL ISAM READ @VA02130 00223000 ST R7,ISMRDAD SAVE ADDRESS OF ISAM READ @VA02130 00224000 ST R6,ISMTCAD SAVE ADDRESS OF CP TIC @VA02130 00225000 MVC ISMREAD(8),0(R7) SAVE THE TRANSLATED READ @VA02130 00226000 MVC ISMRTIC(8),0(R6) SAVE THE TRANSLATED TIC @VA02130 00227000 SR R9,R9 CLEAR ADDRESS REGISTER @VA05299 00228100 ICM R9,7,ISMREAD+1 GET READ DATA ADDRESS @VA05299 00228200 TM ISMREAD+4,IDA IS IT AN IDA LIST ? @VA05299 00228300 BO ISMIDA YES,A BIT TRICKY @VA05299 00228400 MVC ISMRBUF(10),0(R9) MOVE DATA TO ISMBLOK @VA05299 00228500 B SETREAD SET ISAM READ @VA05299 00228600 ISMIDA L R14,0(R9) GET FIRST IDA WORD @VA05299 00228700 LA R15,10 TO MOVE 10 BYTES @VA05299 00228800 LA R0,ISMRBUF BUFFER ADDRESS @VA05299 00228900 LA R1,4095(R14) ROUND UP TO PAGE @VA05299 00229000 N R1,XPAGNUM LEAVE ONLY PAGE NUMBER @VA05299 00229100 SR R1,R14 COUNT IN FIRST PAGE @VA05299 00229200 MVCL R0,R14 MOVE DATA TO BUFFER @VA05299 00229300 LR R1,R15 SET REMAINING COUNT @VA05299 00229400 L R14,4(R9) GET SECOND IDA WORD @VA05299 00229500 MVCL R0,R14 REMAINING DATA TO BUFFER @VA05299 00229600 L R1,0(R3) RESTORE ISMBLOK ADDRESS @VA05299 00229700 SETREAD LA R0,ISMRBUF READ DATA ADDRESS @VA05299 00229800 STCM R0,7,1(R7) REPLACE PREVIOUS ADDRESS IN CCW @VA02130 00232000 NI 4(R7),255-(CD+IDA) NO CHAIN DATA OR IDAL @VA02130 00233000 LA R0,ISMODSK NEW ADDRESS FOR TIC CCW @VA02130 00234000 STCM R0,7,1(R6) . . . @VA02130 00235000 MVC ISMODSK+4(4),4(R5) COPY SECOND HALF OF SEEK @VA02130 00236000 LA R0,ISMVARG NEW ARGUMENT ADDR FOR THE SEEK @VA02130 00237000 ST R0,ISMODSK NOTE -- VALID ISAM OPCODE X'00' @VA02130 00238000 LA R5,8(0,R5) GR5 = ADDRESS TO RE-JOIN STRING @VA02130 00239000 CLI 0(R5),X'08' TIC TO ANOTHER TIC ? @VA02130 00240000 BNE *+8 NO -- O.K. AS IS @VA02130 00241000 L R5,0(0,R5) USE THE NEXT TIC ADDRESS DIRECTLY@VA02130 00242000 ST R5,ISMNTIC SETUP TO RE-JOIN OLD CCW STRING @VA02130 00243000 MVI ISMNTIC,X'08' . . . VIA A TIC CCW @VA02130 00244000 EJECT 00245000 LA R9,2(0,R8) REAL ADDRESS OF SEEK ARG + 2 @VA02130 00246000 L R7,IOBCAW GET CCW START @VA03618 00247000 LA R7,0(,R7) CLEAR HI BYTE @VA03618 00248000 SL R7,F16 BACKUP TO HEADER OF RCWTASK @VA03618 00249000 * R7 NOW POINTS TO THE FIRST RCWTASK AND WE WILL 00250000 * RE-EXAMINE THE ENTIRE STRING. 00251000 ISMSRCH EQU * LOOK FOR SEARCH CCW'S ALSO @VA02130 00252000 L R7,RCWPNT-RCWTASK(,R7) NEXT RCWTASK @VA02130 00253000 LTR R7,R7 HAVE WE REACHED THE END ? @VA02130 00254000 BNP FIXIRAD YES - FIX UP THE IRA AND GO @VA02130 00255000 LH R8,RCWRCNT-RCWTASK(,R7) COUNT OF REAL CCW'S @VA02130 00256000 LA R6,RCWCCW-RCWTASK(,R7) POINT TO FIRST CCW @VA02130 00257000 ISMFIND EQU * LOOK FOR SEARCH POINTING TO SEEK @VA02130 00258000 CLM R9,7,1(R6) SAME ARGUMENTS AS MOVED SEEK ? @VA02130 00259000 BNE ISMCONT NO -- CONTINUE @VA02130 00260000 LA R0,5(0) LENGTH MUST BE FIVE FOR SEARCH @VA02130 00261000 CH R0,6(0,R6) ...OTHERWISE WE WON'T ALLOW IT @VA02130 00262000 BL ISMCONT MORE THAN FIVE, HOWEVER WE @VA04002 00263000 BCTR R0,R0 WILL ACCEPT A LENGTH OF @VA04002 00264000 CH R0,6(0,R6) FOUR FOR A SEARCH @VA04002 00265000 BH ISMCONT LESS THAN FOUR...JUST CONTINUE @VA04002 00266000 TM 5(R6),RCWIO IS THE DATA PAGE LOCKED? @VA03169 00267000 BZ ISMCONT NO - NO NEED TO UNLOCK IT @VA03169 00268000 LA R0,ISMVARG+2 CORRESPONDING REAL ADDRESS @VA02130 00269000 STCM R0,7,1(R6) CHANGE DATA ADDRESS IN THE CCW @VA02130 00270000 LR R2,R9 REAL ADDRESS TO GR2 FOR DMKPTR @VA02130 00271000 CALL DMKPTRUL UNLOCK IT ONCE @VA02130 00272000 NI 5(R6),255-RCWIO NO UNLOCK IS NECESSARY @VA02130 00273000 * N.B. - PAGE IS STILL LOCKED FROM ISAM READ @VA02130 00274000 * - FIVE-BYTE AREA CANNOT CROSS PAGE BOUNDARY @VA02130 00275000 ISMCONT EQU * SEARCH ALL CCW'S @VA02130 00276000 LA R6,8(0,R6) NEXT REAL CCW @VA02130 00277000 BCT R8,ISMFIND KEEP LOOKING @VA02130 00278000 B ISMSRCH CHECK ALL THE RCWTASK'S @VA02130 00279000 DROP R1 @VA02130 00280000 SPACE 00281000 FIXIRAD EQU * @VA02130 00282000 * THE CCW STRING HAS BEEN MODIFIED 00283000 * NOW CHANGE IRA TO GET CONTROL TO UNDO IT LATER 00284000 L R0,IOBIRA GET RETURN ADDRESS 00285000 CL R0,=A(DMKUNTIS) IOBIRA ALREADY = A(DMKUNTIS) ? 00286000 BE NXTASK IF YES, LEAVE WELL ENOUGH ALONE. 00287000 ICM R0,8,IOBCAW SAVE USER'S CAW PROT. KEY @VA02130 00288000 ST R0,IOBMISC SAVE 00289000 L R0,=A(DMKUNTIS) RETURN ADDRESS 00290000 ST R0,IOBIRA SET RETURN ADDRESS IN IOBLOK 00291000 MVI IOBCAW,X'00' ZERO KEY TO READ IN REAL CORE @VA02130 00292000 B NXTASK CHECK NEXT RCWTASK 00293000 SPACE 3 00294000 LTORG 00295000 EJECT 00296000 ISMBLOK DSECT , WORK AREA FOR ISAM CCW STRINGS @VA02130 00297000 SPACE 00298000 ISMRDAD DS 1F ADDRESS OF THE ISAM READ CCW @VA02130 00299000 ISMTCAD DS 1F ADDRESS OF TIC TO NEXT RCWTASK @VA02130 00300000 DS XL7 (PADDING) @VA02130 00301000 ISMRBUF DS 1X START OF 10-BYTE READ BUFFER @VA02130 00302000 ISMVARG DS XL8 SEEK ARGUMENTS FOR FOLLOWING CCW @VA02130 00303000 ISMODSK DS 1D CCW WHICH WILL BE MODIFIED @VA02130 00304000 ISMNTIC DS 1D TIC TO RE-JOIN ORIGINAL STRING @VA02130 00305000 ISMREAD DS 1D SAVE AREA FOR ORIGINAL READ CCW @VA02130 00306000 ISMRTIC DS 1D SAVE AREA FOR ORIGINAL TIC CCW @VA02130 00307000 SPACE 00308000 ISMSIZE EQU (*-ISMBLOK)/8 BLOCK SIZE IN DOUBLE-WORDS @VA02130 00309000 EJECT 00310000 COPY IOBLOKS 00311000 COPY VMBLOK 00312000 COPY EQU 00313000 COPY SAVE 00314000 PSA 00315000 END 00316000