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