./ ADD SSI=00050308,NAME=IGC054,SOURCE=0 COPY LCGASMSW 00003001 IGC054 CSECT 00020000 TITLE 'IGC054 - SVC 54 DISABLE' 00022021 *STATUS CHANGE LEVEL 001 00024021 *1041 A35340 00030020 *1041008768,009200-009400 A38514 00035020 *1451007400,007710 S21045 00036021 *1041007710 M6610 00037020 * RELEASE 21 DELETIONS 00039021 * A51488 00039100 * A53751 00039200 * 009140-009500,009100 A46391 00039421 * SA53798 00041400 *****007300,007400,009560,009580,010700,010800 M4355 00043400 * A008724 SA65481 00045400 * VSAPARS OX02373 AND OY02210 APEARS AS SA65481 00047400 * 00049421 * FUNCTION/OPERATION - 00080000 * 1. RESET THE PSW TO USE THE SAME PROTECTION KEY AS THE CALLING 00100000 * ROUTINE. 00120000 * 2. PICK UP THE ADDRESS OF THE PRIVILEGED ROUTINE FROM THE DEB 00140000 * AND TRANSFER CONTROL. 00160000 * 3. UPON RETURN, RESTORE THE BASE ADDRESS OF THE CALLING ROUTINE. 00180000 * 4. EXIT 00200000 * ENTRY POINT - RELATIVE ADDRESS ZERO 00220000 * INPUT - N/A 00240000 * OUTPUT - N/A 00260000 * CALLING ROUTINE - NON-PRIVILEGED MACRO TIME ROUTINE 00280000 * EXTERNAL ROUTINES - PRIVILIGED MACRO-TIME ROUTINE 00300000 * EXITS - EXIT SVC 00320000 * TABLES/WORK AREAS- N/A 00340000 * ATTRIBUTES - TYPE II SVC 00360000 * NOTES - NONE 00380000 * GENERAL REGISTERS ARE USED AS FOLLOWS 00400000 R0 EQU 0 REG 0 00420000 R1 EQU 1 DCB ADDR A35340 00430020 R2 EQU 2 DECB ADDRESS 00440000 R3 EQU 3 WORK REGISTER 00450000 R4 EQU 4 DCB ADDRESS 00460000 R5 EQU 5 ADDRESS OF REG SAVE AREA 00480000 R6 EQU 6 DCBFA ADDRESS A35340 00490020 R7 EQU 7 TEMP WORK AREA ADDR A47331 00492021 R11 EQU 11 WORK REGISTER 00495000 R12 EQU 12 BASE ADDR, PRIV MACRO TIME RTN 00500000 R13 EQU 13 RETURN ADDR, PRIV MACRO-TIME RT 00520000 R14 EQU 14 WORK REGISTER 00530000 R15 EQU 15 BASE ADDR, NON-PRIV MACRO-TIME 00540000 * TABLES/WORK AREAS - DEB, DCB, DECB, TCB, REGISTER SAVE AREA 00560000 * RELATIVE ADDRESSES WITHIN THESE AREAS ARE AS FOLLOWS 00580000 REGSAVER EQU 32 DISPLACEMENT TO REG SAVE AREA 00600000 SHARE EQU X'80' A35340 00646020 SCAN EQU X'40' A35340 00652020 TCBPKF EQU 28 OFFSET OF PROTECT KEY IN TCB 00760000 IDLEN EQU 8 LENGTH OF DFAID A47331 00771800 BASEREG EQU 92 A35340 00772020 * 00780000 EXIT EQU 3 RETURN SVC NUMBER 00800000 L4 EQU 4 LENGTH OF REGISTER 00810000 * 00820000 WKNACT EQU X'80' WRITE KN IN PROG SA53798 00822000 USING IHADCB,R1 ADDRESSABILITY ON DCB 00826000 USING IHADECB,R2 ADDRESSABILITY ON DECB 00832000 BALR R15,0 ESTABLISH ADDRESSABILITY 00840000 USING *,R15 00860000 * IF DISP=SHR THEN REFRESH THE DCB FIELDS WITH THE 00860820 * DCBFA AND EXIT IF SCAN, OTHERWISE CONTINUE ROUTINE 00861620 TM DCBMACRF,SCAN TEST IF SCAN A35340 00862400 BZ BISAM IF NOT, BR TO GET BISAM A35340 00863220 * PT A35340 00864020 L R6,DCBWKPT1 PT TO QISAM WORK AREA A35340 00864800 USING SCANWA,R6 ADDRESSABILITY SCAN WA 00865200 L R6,W1DCBFA PT TO DCBFA A35340 00865600 USING DCBFA,R6 ADDRESSABILITY ON FIELD AREA 00865800 CLC DFAID,DCBWKPT3 CHECK CORRECT ID A47331 00866000 BNE NOREFRSH DO NOT REFRESH IF NOT A47331 00869200 B COMMON BR TO MOVE FIELDS A35340 00870600 BISAM L R6,DCBWKPT2 PT TO BISAM WORK AREA A35340 00872000 L R2,REGSAVER+R2*L4(R5) GET DECB ADDR SA65481 00872400 USING BISAMWA,R6 ADDRESSABILITY BISAM WA 00872700 TM DCWDCBFA,SHARE TEST IF DISP=SHR A35340 00873400 BZ CNTINU BR IF NOT TO COMPLETE A35340 00874800 * SVC RTN A35340 00880300 SPACE 3 00880400 * IF A WRITE KN IS IN PROGRESS ON THIS DCB, THE FIELD AREA WILL BE 00880700 * UPDATED BY THE ASYNCHRONOUS ROUTINE TO RFLECT THE DCB SO A MERGE 00881100 * IS UNNECESSARY AND DANGEROUS. 00881200 TM DCWWKNI,WKNACT IS A WRITE KN ACTIVE SA53798 00881300 BO CNTINU YES - SKIP MERGE SA53798 00881400 SPACE 2 00881500 LR R7,R6 ADDR FOR COMPARE A47331 00881800 L R6,DCWDCBFA ADDR OF DCBFA A35340 00882500 USING BISAMWA,R7 ADDRESSABILITY BISAM WA 00883600 USING DCBFA,R6 ADDRESSABILITY FIELD AREA 00884700 CLC DFAID,DCWOPCLS CHECK FOR CORRECT ID A47331 00885800 BNE NOREFRSH NO REFRESH IF NOT A47331 00886900 COMMON EQU * MOVE A51488 00888000 MVC DCBRORG3,DFARORG3 DCBFA A35340 00889100 SPACE 2 00889300 * FOR BISAM READ REQUESTS ONLY THE RORG3 FIELD MAY CHANGE SO A 00889500 * MERGE FOR THE OTHER FIELDS IS UNNECESSARY AND MAY HURT A 00889700 * CONCURRENT WRITE KN OPERATION. 00889900 TM DCBMACRF,SCAN IS IT SCAN MODE 00890200 BO WHOLEMRG YES MERGE COMPLETE FA 00891300 TM DECBTYP2,DECBWKN IS IT WRITE KN 00892400 BZ CNTINU NO - MERGE COMPLETE 00893500 SPACE 2 00893700 WHOLEMRG EQU * YES MERGE COMPLETE FA 00894600 MVC DCBNREC(L'DCBNREC+L'DCBST),DFANREC * 00895700 MVC DCBLPDA,DFALPDA FIELDS A35340 00896800 MVC DCBNBOV,DFANBOV TO A35340 00897900 MVC DCBRORG2,DFARORG2 DCB A35340 00899000 MVC DCBNOREC(L'DCBNOREC+L'DCBLIOV+L'DCBRORG1),DFANOREC 00900100 DROP R6 00901200 NOREFRSH EQU * A47331 00902300 TM DCBMACRF,SCAN TEST IF SCAN ISSUED SVC A35340 00903400 BZ CNTINU IF NOT, EXECUTE ROUTINE A38514 00904500 L R15,BASEREG(R5) RESTORE BASE REG A35340 00905600 SVC EXIT AND IF SO, EXIT A35340 00906700 * PICK UP STORAGE PROTECTION KEY OF 00907800 * THE CALLING TASK. 00908900 CNTINU EQU * A35340 00910020 AIF ('&LIB' EQ 'LIB1').NOT001 00910801 LR R12,R15 SAVE BASE ACROSS SVC'S 00910900 LR R13,R1 SAVE DCB ADDRESS REG 00911200 MODESET KEY=NZERO SET PROTECTION KEY 00911601 LR R1,R13 RESTORE DCB ADDRESS REG 00912000 AGO .AOS001 00912401 .NOT001 ANOP 00913201 L R12,DCBDEBAD R12 IS PTR TO DEB A46391 00946000 USING IHADEB,R12 * M4355 00956000 MVZ PSWKEY(1),DEBPROTG MOVE KEY FROM DEB TO PSW M4355 00958000 LPSW PSW LOAD NEW PSW 00960000 .AOS001 ANOP 00970001 * 00980000 NEXTINST EQU * 01000000 AIF ('&LIB' EQ 'LIB1').NOTD00 01002000 USING IHADEB,R12 DEB ADDRESSABILITY M4355 01002421 DEBCHK (1),TYPE=VERIFY,AM=ISAM GET DEB POINTER 01004000 LR R15,R12 RESTORE BASE 01004400 LR R12,R1 SAVE DEB POINTER 01006000 L R4,DEBDCBAD GET ADDR OF DCB FROM DEB M5234 01006421 L R14,BASEREG-L4(R5) RESTORE REST 01008000 LM R6,R11,REGSAVER+R6*L4(R5) RESTORE REGISTERS 01010000 AGO .AOSD00 01014000 .NOTD00 ANOP 01016000 LM R0,R15,REGSAVER(R5) RESTORE REGISTERS 01020000 .AOSD00 ANOP 01022000 USING IHADCB,R4 ADDRESSABILITY ON DCB 01030000 AIF ('&LIB' NE 'LIB1').AOSD00A 01050000 L R4,DECBDCBA GET ADDR OF DCB FROM DECB M5234 01052021 L R12,DCBDEBAD GET ADDR OF DEB FROM DCB 01060000 .AOSD00A ANOP 01065000 L R12,DEBEXPTR DEB EXTENSION ADDR M4355 01070000 USING DEBEXT,R12 ISAM DEPENDANT SECTION M4355 01072000 L R12,DEBDISAD GET ADDR DISABLED RTN M4355 01080000 DROP R1 01090000 AIF ('&LIB' EQ 'LIB1').NOTR00 01092000 EJECT 01092100 * THE FOLLOWING LOOP IS USED TO BRING PAGES INTO CORE 01092400 * TO PREVENT PAGE FAULTS AND PROGRAM CHECKS IN THE 01092821 * PRIVLAGE MACRO TIME MODULE. 01093221 SPACE 2 01093600 ********************************************************************* 01093700 L R2,REGSAVER+R2*L4(R5) GET DECB ADDR 01093800 SREAL EQU * 01094000 LRA R13,0(R2) LOAD DECB REAL 01096000 BZ ISREAL BRANCH IF IN CORE 01098000 LOOP EQU * 01098400 STOSM DECBECB,ENABLED ENABLE FOR INTERRUPTS 01098800 L R13,0(R2) GET DECB IN CORE 01099200 L R13,0(R4) GET DCB IN CORE 01099600 L R13,0(R12) GET PRIV MOD IN CORE 01099700 LR R13,R15 SAVE BASE FOR MODSET 01099800 MODESET ENABLE=NO 01099900 LR R15,R13 RESET BASE 01103200 B SREAL 01107000 ISREAL EQU * 01110300 LRA R13,0(R4) IS DCB IN CORE YET 01113600 BNZ LOOP NO, TRY AGAIN 01116900 LRA R13,0(R12) IS PRIV MOD IN CORE YET 01120200 BNZ LOOP NO, TRY AGAIN 01123500 NI DECBECB,MASK ZERO BYTE USED IN STOSM 01125500 LM R0,R3,REGSAVER(R5) RESTORE REST OF 01126800 L R15,BASEREG(R5) REGS NOT RESTORED 01128800 L R5,REGSAVER+R5*L4(R5) ABOVE 01129221 ********************************************************************* 01129600 .NOTR00 ANOP 01130100 SPACE 2 01132100 BALR R13,R12 BRANCH TO DISABLED (PRIV) RTN 01133400 BALR R12,0 UPON RETURN, RESTORE BASE ADDR 01136700 USING *,R12 OF NON-PRIVILEGED MACRO-TIME 01140000 TM DECBTYP2,DECBWKN ROUTINE AND RETURN TO 01160000 BNE A NON-PRIVILEGED ROUTINE 01180000 L R15,DCBLRAN 01200000 SVC EXIT 01220000 A L R15,DCBLWKN 01240000 SVC EXIT 01260000 * 01280000 AIF ('&LIB' EQ 'LIB1').AOS002X 01290000 MASK EQU X'00' USED TO ZERO A FIELD 01292000 ENABLED EQU X'02' SYSTEM MASK FOR ENABLE 01294000 AGO .AOS002 01294400 .AOS002X ANOP 01296000 PSW DS 0D NEW PSW TO BE LOADED 01300000 PSWMASK DC X'00' 01320000 PSWKEY DC X'04' 01340000 PSWINTCD DC X'0000' 01360000 PSWICP DC X'00' 01380000 PSWADDR DC AL3(NEXTINST) 01400000 .AOS002 ANOP 01402000 EJECT 01404000 IHADEB IGGDEBD DEB DSECTS M4355 01406000 EJECT 01410000 * DATA EVENT CONTROL BLOCK 01412000 IHADECB DSECT 01415500 DS 0F 01416000 DECBCODE DS BL1 WAIT BIT AND POST BIT 01416400 DECBECB DS CL3 EVENT CONTROL BLOCK (ECB) 01416500 DECBTYP1 DS BL1 TYPE B6 - 1 IF LENGTH IS S 01417000 * B7 - 1 IF AREA IS S 01417500 DECBTYP2 DS BL1 B0 - 1 IF READ K 01418000 * B1 - 1 IF READ KX 01418500 * B2 - 1 IF READ KU 01419000 * B4 - 1 IF WRITE K 01419500 DECBWKN EQU X'04' B5 - 1 IF WRITE KN 01420000 DECBLGTH DS CL2 LENGTH OF BLOCK 02420000 DECBDCBA DS A POINTER TO DCB 03420000 DECBAREA DS A ADDRESS OF AREA 04420000 DECBLOGR DS A POINTER TO LOGICAL RECORD 05420000 DECBKEY DS A POINTER TO KEY 06420000 DECBEXC1 DS BL1 EXCPTN CD B0-RECORD NOT FOUND 07420000 * B1-RECORD LGTH CHK 08420000 * B2-NO SPACE 09420000 * B3-INVALID REQUEST 10420000 * B4-UNCORRECTABLE IO 11420000 * B5-UNREACHABLE BLOCK 12420000 * B6-OVERFLOW RECORD 13420000 * B7-DUPLICATE 14420000 DECBEXC2 DS BL1 B7-READ KU 15420000 EJECT 16420000 IHADCB DCBD DSORG=IS DCB 17420000 EJECT 18420000 DCBFA IGGDCBFA 19420000 EJECT 20420000 BISAMWA IGGBISAM 21420000 EJECT 22420000 SCANWA IGGSCAN 23420000 END 24420000 ./ ADD SSI=21780589,NAME=IGG019GA,SOURCE=0 COPY LCGASMSW 00010000 TITLE 'IGG019GA - PUT, W/O WR CHK' 00020000 IGG019GA CSECT 00040000 * RELEASE 16 DELETIONS * 00045000 *1671157800-158800,163000,178600,179000-179400 13165 00046016 *1671 13711 00047016 *1671061000-061200 14251 00048016 *1671 16305 00049016 * RELEASE 17 DELETIONS * 00050000 *1650000920,082400,102000-102400,115600-116000,286400, P4701 00051000 *1650341800-342200,369200,369600,402600 P4701 00052000 *1650215600-216000 17925 00053000 *1650063400,063800,069600 20852 00054000 *1650176000 7M568 00054500 * RELEASE 18 DELETIONS * 00055000 *0381262600 22619 00057018 *0381036600,036800-038040,064000-064600 25463 00058018 * RELEASE 19 DELETIONS * 00060000 *2182215200 A27810 00062019 * RELEASE 20 DELETIONS * 00065000 *3512062860-062880,066200-066600,082260-082440 A32496 00066020 *3512062840,063400-063600 A31998 00067020 *3512069600-069700 M1857 00067120 *3512017800,018000-024600,025000,025200-038120,082400-082600, S20201 00067320 *3512147200-147400,147600-148000,148200-148400,148600-149000, S20201 00067620 *3512149200-149600,265400,265600,347400,349000,349200,349400, S20201 00067920 *3512349800,350000,350200,352000,352200,352400,352600,352800, S20201 00068220 *3512353000,355400,355600,355800,356000,356200,356400,356600, S20201 00068520 *3512356800,357000,357200,357400,359600,373600,373800,374000, S20201 00068820 *3512374200,374400,376600,376800,377000,377200,377400,377600, S20201 00069120 *3512377800,378000,378400,379200,379400,379600,380000,389800, S20201 00069420 *3512394600,394800,395000,395200,395600,396000,396200,396400 S20201 00069720 * RELEASE 21 DELETIONS * 00070000 *0273147300-148600 A46109 00071021 *0273106400-106600 A42181 00072021 *0273289600-290600 M0170 00073021 *D062920 XM6075 00073400 * RELEASE 22 DELETIONS * 00075000 * RELEASE 23 DELETIONS * 00080000 * RELEASE 24 DELETIONS * 00085000 * STATUS CHANGE LEVEL 010 00092021 * * 00100000 *FUNCTION/OPERATION- THIS MODULE CONTAINS THE BASIC LOAD MODE PUT * 00120000 * ROUTINES. THESE ROUTINES INVOLVE RECORD PROCESSING FOR MOVE MODE * 00140000 * AND FOR LOCATE MODE, BUFFER MANAGEMENT, CHANNEL PROGRAM INITIAL- * 00160000 * IZATION, AND CHANNEL PROGRAM EXECUTION. * 00180000 * * 00200000 *ENTRY POINTS- 'IGG019GA' (ISLFX01) IS THE ENTRY FOR A LOAD MODE PUT * 00220000 * MACRO INSTRUCTION. THE GENERATED CALLING SEQUENCE IS, * 00240000 * LA 1,DCB * 00260000 * LA 0,RECORD FOR MOVE MODE * 00280000 * L 15,48(0,1) * 00300000 * BALR 14,15 * 00320000 * * 00340000 *INPUT- REGISTER 0 -POINTS TO USERS RECORD IN WORK AREA (MOVE MODE). * 00360000 * REGISTER 1 -POINTS TO DCB. * 00380000 * REGISTER 13 -POINTS TO USER SAVE AREA. * 00400000 * REGISTER 14 -POINTS TO RETURN FROM PUT. * 00420000 * * 00440000 *OUTPUT- REGISTER 1 -POINTS TO NEXT AVAILABLE SPACE IN OUTPUT BUFFER * 00460000 * (LOCATE MODE). * 00480000 * REGISTER 1 -POINTS TO BAD BUFFER IF WRITE ERROR OCCURRED. * 00500000 * REGISTER 0 -POINTS TO IOB IF WRITE ERROR OCCURRED. * 00520000 * REGISTER 14-POINTS TO RETURN TO CLOSE IF WRITE ERROR * 00540000 * OCCURRED DURING CLOSE. * 00560000 * * 00580000 *EXTERNAL ROUTINES- 'IGG019GC'-CHANNEL PROGRAM APPENDAGE ROUTINES * 00600000 * USED TO PROCESS I/O RETURNS. ALSO, CHANNEL PROGRAMS AND IOS. * 00620000 * * 00640000 *EXITS-NORMAL- (ISLFX13), USER RECORD HAS BEEN PROCESSED SUCCESSFULLY.* 00660000 * -ERROR- (ISLFX05), AN ERROR OCCURRED DURING THE PROCESSING OF * 00680000 * THE USER RECORD. THE ERROR CONDITION IS FLAGGED AS FOLLOWS, * 00700000 * DCBEXCD1 BIT 5 ON = WRITE ERROR, REG 1 POINTS TO BAD BUFFER. * 00720000 * REG 0 POINTS TO IOB. * 00740000 * DCBEXCD1 BIT 2 ON = SPACE ERROR, NOT ENOUGH SPACE FOR DATA SET. * 00760000 * DCBEXCD2 BIT 1 ON = DUPLICATE KEY. * 00780000 * DCBEXCD2 BIT 0 ON = KEY OUT OF SEQUENCE. * 00800000 * REG 0 POINTS TO HIGH KEY 20852 00810000 * * 00820000 *TABLES/WORK AREAS- * 00840000 * DCB - COMMUNICATION WITH USER. * 00860000 * DEB - COMMUNICATION WITH IOS. * 00880000 * ISLCOMON - COMMUNICATION WITHIN LOAD MODE. * 00900000 * ISLIOBA - COMMUNICATION WITH I/O FOR CP18 AND CP20. * 00920000 * ISLIOBB - COMMUNICATION WITH I/O FOR CP21. * 00940000 * ISLIOBC - COMMUNICATION WITH I/O FOR CP19. * 00960000 * ISLAREAZ - WORK AREA USED FOR PREFORMATTING. * 00980000 * ISLIXLT - INDEX LOCATION TABLE, LOCATES HI-LEVEL INDICIES. * 01000000 * ISLY - WORK AREA USED WHEN WRITING INDICIES. * 01020000 * ISLVPTRS - VARIABLE POINTERS, REFERENCE VARIABLE LENGTH BLOCKS. * 01040000 * IOBBCT - BUFFER CONTROL TABLE, CONTROLS BUFFER USAGE. * 01060000 * * 01080000 *ATTRIBUTES- READ ONLY, REENTRANT, REUSABLE. * 01100000 * * 01120000 *NOTES- THIS MODULE, TOGETHER WITH THE APPENDAGE MODULE 'IGG019GC', * 01140000 * AND THE CHANNEL PROGRAMS, CREATE THE ISAM DATA SET WHEN NO WRITE- * 01160000 * CHECKING IS SPECIFIED. ALL OTHER LOAD MODE MODULES MERELY PROVIDE * 01180000 * THE OPEN AND CLOSE FUNCTIONS. * 01200000 * SECTIONS OF THE PROCESSING IN THIS MODULE ARE ENTERED * 01220000 * DIRECTLY FROM CLOSE PROCESSING. IN SUCH CASES, PROCESSING IS * 01240000 * CARRIED ON AS THOUGH IT WAS PART OF CLOSE. * 01260000 * ENTRY POINTS - ISLFX01 * 01280000 * - ISLFX20 * 01300000 * - ISLFY01 * 01320000 * - ISLFZ01 * 01340000 * - ISLPA01 * 01360000 * * 01380000 * ****************************************************************** 01400000 * THE FOLLOWING NOTATION IS FREQUENTLY USED THROUGHOUT COMMENTS - * 01420000 * C(FIELD X) = A(FIELD Y) * 01440000 * CONTENTS OF FIELD X = ADDRESS OF FIELD Y * 01460000 * ****************************************************************** 01480000 * * 01500000 EJECT 01520000 ******************** 01560000 * DCB REFERENCE * 01580000 ******************** 01600000 * 01620000 DCBD DSORG=(IS) 01640000 USING IHADCB,R1 01660000 EJECT 01680000 ******************** 01700000 * DEB REFERENCE * 01720000 ******************** 01740000 * 01760000 IHADEB IGGDEBD 01770020 USING IHADEB,R8 S20201 01780020 EJECT 02480000 ISLCOMON IGGLOAD 02490020 USING ISLCOMON,R12 S20201 02500020 * 03820000 * 03840000 * IOBBCT REFERENCE C(ISLVPTRS+8)=A(IOBBCT) 03860000 * 03880000 IOBBCT DSECT 03900000 USING IOBBCT,R11 03920000 DS 0D 03940000 IOBFLAGS DS 0CL1 FLAGS 03960000 IOBPTRA DS A PTR A 03980000 IOBB DS 0CL1 B 04000000 IOBPTRB DS A PTR B 04020000 IOBS DS 0CL1 S - STATUS FIELD FOR BUF NO 1 04040000 IOBABUF DS A A(BUF NO 1) - ADR OF BUF NO 1 04060000 * 04080000 *------------------ VARIABLE AREA ------------------------------------ 04100000 * 04120000 * -- 04140000 * -- 04160000 * -- 04180000 * -- 04200000 * 04220000 * ISLY REFERENCE C(ISLVPTRS)=A(ISLY) 04240000 * 04260000 ISLY DSECT 04280000 USING ISLY,R9 04300000 DS 0D 04320000 DS CL8 CYL-MAST IX COUNT Y+0 04340000 DS CL10 DATA Y+8 04360000 DS CL8 TRK IX NORM COUNT Y+18 04380000 DS CL10 DATA Y+26 04400000 DS CL8 TRK IX OVFL COUNT Y+36 04420000 DS CL10 DATA Y+44 04440000 DS CL8 TRK IX DUMM COUNT Y+54 04460000 * DS CL(IL) KEY 1S Y+62 04480000 * DS CL10 DATA Y+62+IL 04500000 * 04520000 EJECT 04540000 IHAIOB DSECT 04560000 USING IHAIOB,R2 04580000 DS 0D 04600000 IOBFLG1 DS CL1 FLAGS 1 04620000 IOBFLG2 DS CL1 FLAGS 2 04640000 DS CL1 04660000 IOBSENSE DS CL1 SENSE 04680000 IOBECBAD DS A ECB POINTER 04700000 IOBCSW DS CL8 CHANNEL STATUS WORD 04720000 IOBSIOCC DS 0CL1 SIO CC 04740000 IOBCPSAD DS A CHANNEL PROG START ADR 04760000 IOBWT DS 0CL1 WEIGHT 04780000 IOBDCBAD DS A DCB POINTER 04800000 IOBCPRAD DS A CHANNEL PROG RESTART ADR 04820000 IOBBCTI DS CL2 BLK CTR INCR 04840000 IOBECT DS CL2 ERROR CTR 04860000 IOBDADAD DS CL8 DIR ACCESS DEV ADR MBBCCHHR 04880000 * 04900000 IXLT DSECT 04920000 USING IXLT,R7 04940000 DS 0D 04960000 IXLTIND DS CL1 INDICATOR 04980000 IXLBEG DS CL8 BEGINING COUNT MBBCCHHR 05000000 IXLSTP DS CL8 STEPPING COUNT MBBCCHHR 05020000 IXLEND DS CL8 ENDING COUNT NBBCCHHR 05040000 DS CL1 05060000 DS CL26 LEV2 05080000 DS CL26 LEV3 05100000 DS CL26 LEV4 05120000 EJECT 05125020 CPSX DSECT 05130020 IGGLDCP RECFM=F LOAD CHANNEL PROGRAMS S20201 05135020 EJECT 05140000 *********************************************************************** 05160000 * ISL PUT - BEGIN * 05180000 *********************************************************************** 05200000 * 05220000 * 05240000 IGG019GA CSECT 05260000 ISLF800 SAVE (14,12) SAVE USERS REGS 05280000 BALR R15,0 05300000 USING *,R15 05320000 B ISLFX01 05340000 B ISLFX20 05360000 B ISLFY01 05380000 B ISLFZ01 05400000 B ISLPA01 05420000 * 05440000 * EQUATE SYMBOLIC REGISTERS 05460000 * 05480000 R0 EQU 0 05500000 R1 EQU 1 05520000 R2 EQU 2 05540000 R3 EQU 3 05560000 R4 EQU 4 05580000 R5 EQU 5 05600000 R6 EQU 6 05620000 R7 EQU 7 05640000 R8 EQU 8 05660000 R9 EQU 8 05680000 R10 EQU 10 05700000 R11 EQU 11 05720000 R12 EQU 12 05740000 R13 EQU 13 05760000 R14 EQU 14 05780000 R15 EQU 9 05800000 R16 EQU 15 05820000 CVTPTR EQU 16 05840000 RSLOAD EQU X'20' DCBST - RESUME LOAD S20201 05841020 * * INDICATOR 05842020 K1 EQU 1 CONSTANT S20201 05843020 L3 EQU 3 LENGTH S20201 05844020 K14 EQU 14 CONSTANT S20201 05845020 K0 EQU 0 CONSTANT S20201 05846020 K2301 EQU X'F8' 2301 MASK S20201 05847020 K3 EQU 3 CONSTANT S20201 05848020 L4 EQU 4 LENGTH S20201 05849020 K7 EQU 7 CONSTANT S20201 05850020 L7 EQU 7 LENGTH S20201 05851020 * 05860000 K4 EQU 4 CONSTANT S20201 05870020 COMPLETE EQU X'40' IOB COMPLETED A42181 05873021 IOERROR EQU X'04' DCBEXCD1 - I/O ERROR A42181 05876021 ISLKEYVL EQU X'04' KEY SEQUENCE VALID(IXLT) XM6075 05878000 EJECT 05880000 *********************************************************************** 05900000 * CHART FX - PUT (MOVE/LOCATE) * 05920000 *********************************************************************** 05940000 * 05960000 USING IHADEB,R8 05980000 * 06000000 * FX HOUSEKEEPING 06020000 * 06040000 ISLFX01 L R12,DCBWKPT1 C(R12)=A(COMMON) 06060000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 14251 06065016 L R11,8(R10) C(R11)=A(BCT) 14251 06070016 TM IOBFLAGS,X'10' DID WE COME FROM CLOSE 14251 06075016 BO CONTINUE YES TAKE BRANCH 14251 06080016 ST R13,ISLVRSAV+4 14251 06085016 CONTINUE EQU * 14251 06090016 LA R2,ISLIOBA C(R2)=A(IOBA) 06140000 NI DCBEXCD2,X'3F' SET EXCD2 BITS 0 AND 1 = 00 06160000 * 06180000 TM DCBEXCD1,X'04' HAS AN OUTPUT ERROR A31998 06185020 * * OCCURRED$ 06190020 BO ISLFX02 YES TAKE SYNAD A31998 06195020 * TEST DCBST BIT 1 FOR LOAD MODE (FIRST TIME SW) 06200000 * 06220000 TM DCBST,X'40' TEST ST BIT 1 (1=NOT FRST TIME) 06240000 BC 14,ISLFX10A BRANCH NOT ON 06260000 LH R5,DCBRKP RELATIVE KEY POSITION A32496 06270020 * 06280000 TM DCBST,X'20' RESUME LOAD P4701 06282000 BZ ISLFX022 NOT RESUME LOAD A31998 06284020 TM DCBMACRF+1,X'08' PUT - LOCATE MODE P4701 06290000 BO ISLFX07A BR-YES XM6075 06292000 L R4,4(R10) PT TO HIGH KEY A32496 06294020 B ISLFY022 BRANCH TO CHECK SEQUENCE A32496 06296020 * TEST DCBEXCD1 BIT 5 FOR PREVIOUS UNCORRECTABLE WRITE ERROR 06300000 * 06320000 ISLFX02 L R13,ISLVRSAV+4 C(R13)=A(USERS SAVE AREA) 20852 06330000 MVC 24(4,R13),ISLVPTRA A(BAD BUFFER) IN USER R1 25463 06420018 LA R0,ISLIOBA C(R0)=A(IOBA) 06480000 ST R0,20(R13) STORE A(IOBA) IN USERS R0 06500000 B ISLFX05 B TO TAKE SYNAD 06520000 * 06540000 * SEQUENCE CHECK 06560000 **************** 06580000 * 06600000 ISLFX022 EQU * * A32496 06610020 L R4,ISLCBF A32496 06620020 AR R4,R5 PT TO KEY A32496 06630020 ISLFY022 EQU * A32496 06640020 SR R3,R3 06680000 IC R3,DCBKEYLE C(R3)=KEYLEN, 000000NN 06700000 BCTR R3,0 C(R3)=KEYLEN-1, FOR EXECUTE 06720000 * 06740000 * TEST FOR MOVE OR LOCATE PUT 06760000 * 06780000 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 06800000 BC 1,ISLFX08 B IF ON = MOVE PUT 06820000 * 06840000 * LOCATE PUT *** 06860000 * 06880000 L R5,4(R10) C(R5)=A(KEYSAVE)=A(PREV KEY) 06900000 EX R3,ISLFX02A C(CBF+RKP) VS C(KEYSAVE) 06920000 BH ISLFX06 B IF NEW KEY HIGH 06940000 BE ISLFX023 B IF KEY SEQ CORRECT 20852 06950000 LR R4,R5 PTR TO KEY M1857 06960020 B ISLFX041 BR TO POST ERROR M1857 06970020 * 06980000 * LOCATE PUT,KEYS EQUAL- TEST IF 2ND PUT (SEQ CHK ONLY AFTER 2ND PUT) 07000000 * 07020000 ISLFX023 EQU * 20852 07030000 L R6,DCBNREC C(R6)=NREC 07040000 C R6,ISLONEF TEST NREC VS 1 07060000 BE ISLFX06 B IF NREC = 1, ONLY 2ND PUT 07080000 * 07100000 * DUPLICATE RECORDS = ERROR 07120000 * 07140000 ISLFX03 OI DCBEXCD2,X'40' SET EXCD2 BIT 1 ON = DUPLICATE 07160000 B ISLFX05 07180000 * 07200000 * MOVE PUT *** 07220000 * 07240000 ISLFX08 AR R5,R0 C(R5)=C(AREA+RKP)=A(NEW KEY) 07260000 EX R3,ISLFX08A C(NEW KEY) VS C(CBF+RKP) 07280000 BH ISLFX07 BRANCH IF NEW KEY HIGH 07300000 BE ISLFX03 BR IF KEYS EQUAL=DUPLIC ATES 07320000 ISLFX041 EQU * * M1857 07322020 TM IOBFLAGS,X'10' IN CLOSE M1857 07324020 BO ISLFX04 YES - DON'T SAVE KEY M1857 07326020 ST R4,20(0,R13) HI KEY ADDR INTO USER R0 20852 07330000 * 07340000 * SEQUENCE ERROR 07360000 * 07380000 ISLFX04 OI DCBEXCD2,X'80' SET EXCD2 BIT 0 ON = SEQ ERR 07400000 * 07420000 * TAKE SYNAD EXIT 07440000 * 07460000 ISLFX05 LR R4,R14 SAVE RETURN IN R4 07480000 L R16,DCBSYNAD 07500000 C R16,ISLONEF TEST SYNAD VS 1 07520000 BE ISLFX052 BR IF 1 - NO SYNAD 07540000 TM IOBFLAGS,X'10' TEST FLAGS BIT 3 (CLOSE) 07560000 BC 1,ISLFX051 B IF ON = CLOSE 07580000 L R13,ISLVRSAV+4 RESTORE USER R13 07600000 L R14,12(R13) RESTORE USER R14 07620000 LM 0,12,20(R13) RESTORE REGS 07640000 BR R16 TAKE SYNAD EXIT 07660000 ISLFX051 TM DCBEXCD2,X'20' TEST EXCD2 BIT 2 ***CLOSE*** 07680000 BC 1,0(R4) B IF ON, RETURN TO CLOSE 07700000 L R5,CVTPTR FIND USERS SAVE AREA 07720000 L R5,0(R5) 07740000 L R5,4(R5) 07760000 L R5,0(R5) 07780000 LR R3,R1 SAVE R1 07800000 STM 2,13,96(R5) SAVE PUTS REGS 2 - 13 07820000 OI DCBEXCD2,X'20' SET EXCD2 BIT 2 ON = CLOSE 07840000 LM 0,1,20(R13) SET REGS 0 AND 1 07860000 LM 2,13,40(R5) RESTORE USERS REGS 2 - 13 07880000 SYNCH (15) TAKE SYNAD EXIT (RETURN VIA 14) 07900000 L R5,CVTPTR FIND USERS SAVE AREA 07920000 L R5,0(R5) 07940000 L R5,4(R5) 07960000 L R5,0(R5) 07980000 LM 2,13,96(R5) RESTORE PUTS REGS 2 - 13 08000000 LR R1,R3 RESTORE R1 08020000 BR R4 RETURN TO CLOSE 08040000 ISLFX052 L R1,ISLABEND NO SYNAD = ABEND 31 08060000 ABEND (1) ABEND 08080000 * 08100000 * LOCATE PUT,SEQUENCE OK- MOVE KEY TO KEYAVE AREA 08120000 * 08140000 ISLFX06 EX R3,ISLFX06A MOVE C(CBF+RKP) TO C(KEYSAVE) 08160000 * 08180000 * BUMP CBF 08200000 * 08220000 ISLFX07 EQU * * A32496 08230020 OI ISLIXLT,ISLKEYVL VALID RECORD ADDED XM6075 08232000 ISLFX07A L R7,ISLCBF C(R7)=A(CURR BUFR PTR) S20201 08240020 * P470 S20201 08250020 A R7,ISLBMPR C(R7)=CBF+BMPR S20201 08260020 ST R7,ISLCBF C(CBF)=CBF+BMPR 08280000 B ISLFX10 08300000 * 08320000 * BUMP NREC 08340000 * 08360000 ISLFX10A OI DCBST,X'40' SET ST BIT ON 08380000 CLC DCBLPDA(1),DCBMSWA TEST FOR SAME M 16305 08383016 BNE KEEPGOIN 16305 08386016 CLC DCBLPDA+3(4),DCBMSWA+3 TEST SAME CCHHR 16305 08389016 BH ISLPA205 BRANCH OUT OF SPACE 16305 08392016 KEEPGOIN EQU * 16305 08395016 ISLFX10 L R3,DCBNREC C(R3)=NREC 08400000 A R3,ISLONEF C(R3)=NREC+1 08420000 ST R3,DCBNREC C(NREC)=NREC+1 08440000 * 08460000 * TEST BOB SWITCH (APPLIES ONLY TO MOVE PUT, BOBSW = 1 FOR LOCATE PUT) 08480000 * 08500000 TM IOBFLAGS,X'08' TEST FLAGS BIT 4 VS 1 (BOBSW) 08520000 BC 1,ISLFX11 B IF ON = NOT 0 08540000 * 08560000 * BOBSW = 0 08580000 OI IOBFLAGS,X'08' SET FLAGS BIT 4 = 1 (BOBSW ON) 08600000 BAL R14,ISLPA01 *LINK TO BOB ROUTINE 08620000 * 08640000 TM DCBST,RSLOAD IS IT RESUME LOAD S20201 08645020 BZ ISLFX11 NO - O.K. S20201 08650020 MVC IOBPTRA+K1(L3),IOBPTRB+K1 CORRECT PTRS S20201 08655020 * BOBSW = 1 08660000 * TEST FOR MOVE OR LOCATE PUT 08680000 * 08700000 ISLFX11 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 08720000 BC 1,ISLFX20 B IF ON = MOVE PUT 08740000 * 08760000 * LOCATE PUT 08780000 * TEST FOR EOB, HAS USERS LAST RCD FILLED A BUFFER - 08800000 * 08820000 L R7,ISLCBF C(R7)=CBF 08840000 C R7,ISLEOB TEST CBF VS EOB 08860000 BNL ISLFX24 B IF EOB 08880000 * 08900000 * NOT EOB 08920000 ISLFX12 TM IOBFLAGS,X'40' TEST FLAGS BIT 1 08940000 BC 1,ISLFX14 B IF ON = WRITE SHOULD BE 08960000 * ATTEMPTED 08980000 * 09000000 * NOT EOB, FLAGS BIT 1 OFF, RESTORE REGS AND RETURN TO USER 09020000 * 09040000 * EXIT PUT 09060000 * 09080000 ISLFX13 TM IOBFLAGS,X'10' TEST FLAGS BIT-3 (CLOSE) 09100000 BC 1,0(R14) B IF ON = CLOSE 09120000 * * INDICATOR 09122020 TM DCBST,RSLOAD RESUME LOAD S20201 09124020 BZ ISLFX13R NO - BUFFERS CORRECT S20201 09126020 NI DCBST,X'FF'-RSLOAD TURN OFF RESUME LOAD S20201 09128020 MVC IOBPTRA+K1(L3),IOBPTRB+K1 MAKE IT THE FIRST S20201 09130020 ISLFX13R EQU * * S20201 09132020 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 (MOVE PUT) 09140000 BC 1,ISLFX132 B IF ON = MOVE PUT 09160000 L R1,ISLCBF C(R1)=CBF, FOR LOCATE PUT 09180000 ISLFX132 L R13,ISLVRSAV+4 09200000 L R14,12(R13) RESTORE R14 09220000 RETURN (2,12) RESTORE USERS REGS AND EXIT 09240000 * 09260000 * 09280000 * 09300000 * NOT EOB, FLAGS BIT 1 ON, SET FLAGS BIT 1 OFF AND ATTEMPT WRITE 09320000 * 09340000 ISLFX14 NI IOBFLAGS,X'BF' SET FLAGS BIT 1 OFF 09360000 OI IOBFLAGS,X'20' SET FLAGS BIT 2 ON (NOT EOB) 09380000 B ISLFY02 * 09400000 * 09420000 * 09440000 * 09460000 * MOVE PUT 09480000 * MOVE RECORD FROM USER AREA TO CURRENT BUFFER VIA CBF 09500000 * 09520000 ISLFX20 L R3,ISLMVC C(R3)=COUNT OF EXECUTED MOVE 09540000 L R4,ISLCBF C(R4)=CBF=MOVE DESTINATION 09560000 LR R5,R0 C(R5)=MOVE ORIGIN 09580000 L R6,ISLMVCT C(R6)=NBR OF 255 BYTE MOVES 09600000 ISLFX21 BCT R6,ISLFX22 TO MOVE 255 BYTES 09620000 EX R3,ISLFX21A MOVE RCD AT R0 TO CBF 09640000 B ISLFX23 MOVE COMPLETED 09660000 ISLFX22 MVC 0(255,R4),0(R5) MOVE 255 BYTES OF RECORD 09680000 A R4,ISL255 BUMP DESTINATION 09700000 A R5,ISL255 BUMP ORIGIN 09720000 B ISLFX21 TO MOVE REST OF RECORD 09740000 * 09760000 * TEST FOR EOB, HAS RCD JUST MOVED FILLED A BUFFER 09780000 * 09800000 ISLFX23 L R7,ISLCBF C(R7)=CBF 09820000 A R7,ISLBMPR C(R7)=CBF+BMPR 09840000 C R7,ISLEOB TEST CBF+BMPR VS EOB 09860000 BL ISLFX12 B IF NOT EOB 09880000 * 09900000 * 09920000 * EOB 09940000 * 09960000 * SET BOB SW TO ZERO (RESET) 09980000 * 10000000 NI IOBFLAGS,X'F7' SET FLAGS BIT 4 = 0 (BOBSW OFF) 10020000 NI DCBST,X'FF'-RSLOAD TURN OFF RESUME LOAD S20201 10030020 * 10040000 * MARK CURRENT BUFFER AND BUMP B IN BCT. 10060000 * 10080000 ISLFX24 L R3,IOBPTRB C(R3)=PTR B = A(CURRENT SLOT) 10100000 TM DCBST,RSLOAD IS IT RESUME LOAD S20201 10106020 BO ISLFY01 YES DON'T SCHEDULE IT S20201 10112020 NI 0(R3),X'DF' SET STATUS BIT 2 = 0 10120000 OI 0(R3),X'40' SET STATUS BIT 1 = 1 10140000 * STATUS BITS 1 AND 2 = 10 10160000 * =BUF FULL BUT NOT SCHED 10180000 IC R4,IOBB C(R4)-000N, FULL BUFRS P4701 10200000 LA R4,1(0,R4) C(R4)-000000NN+1 P4701 10220000 STC R4,IOBB C(PTRB)=NNAAAAAA, NN = B 10260000 B ISLFY01 * 10280000 * 10300000 EJECT 10320000 *********************************************************************** 10340000 * CHART FY - PUT (EOB) * 10360000 *********************************************************************** 10380000 * 10400000 * TEST B VS FBW (ARE WE READY TO ATTEMPT TO WRITE) 10420000 * 10440000 ISLFY01 SR R3,R3 10460000 IC R3,IOBB C(R3)=000N N=NO. FILLED, 10480000 * UNSCHEDULED BUFFERS 10500000 C R3,ISLFBW TEST B VS FBW 10520000 BL ISLFY41 B IF NOT ENOUGH BUFFERS FILLED 10540000 * 10560000 * B G.E. FBW, ATTEMPT WRITE 10580000 * TEST FLAGS BIT 0 VS 1, (IWR)-IS CP AVAILABLE 10600000 * 10620000 ISLFY02 EQU * * A42181 10628021 TM ISLECBA,COMPLETE IOB AVAILABLE A42181 10636021 BZ ISLFY41A NO - SCHEDULE LATER A42181 10644021 TM DCBEXCD1,IOERROR HAS AN I/O ERROR A42181 10652021 * OCCURRED A42181 10660021 BO ISLFX02 YES - TERMINATE LOAD. A42181 10668021 * 10680000 * B GE FBW AND FLAGS BIT 0 = 0 (CP AVAILABLE), SET UP TO WRITE 10700000 * 10720000 ISLFY03 SR R3,R3 10740000 IC R3,IOBB C(R3)=000N 10760000 S R3,ISLFBW C(R3)=B-FBW, WE WILL SCHED FBW 10780000 * BUFFRS 10800000 STC R3,IOBB C(PTRB)=NNAAAAAA, NN = B 10820000 * 10840000 NI IOBFLAGS,X'BF' SET FLAGS BIT 1 OFF 10860000 * 10880000 * 10900000 * 10920000 * WAIT FOR PREVIOUS I/O TO COMPLETE 10940000 * 10960000 * 10980000 * 11000000 * MAKE SURE CP21 HAS COMPLETED 11020000 * 11040000 LA R2,ISLIOBB SET BASE FOR IOB FOR CP21 11060000 BAL R4,ISLFY99 BR TO WAIT SUBROUTINE 11080000 * 11100000 * TEST STATUS BIT-6 (PF BIT) PERTAING TO 1ST BFR. IF PF BIT ON, THIS 11120000 * IS THE 1ST BUFFER TO BE WRITTEN ON A NEW CYLINDER WITH SHARED TRACKS 11140000 * 11160000 TM 0(R3),X'02' TEST STATUS BIT-6 11180000 BC 8,ISLFY08 B IF PF NOT ON 11200000 * 11220000 * STATUS BIT-6 (PF BIT) IS ON. WE ARE ABOUT TO SCHED THE 1ST WRITE ON 11240000 * A NEW, SHARED-TRACK, CYLINDER. FIRST WE MUST BE SURE CP19 HAS 11260000 * FINISHED PRE-FORMATTING. 11280000 * 11300000 LA R2,ISLIOBC SET BASE FOR IOB FOR CP19 11320000 BAL R4,ISLFY99 BR TO WAIT SUBROUTINE 11340000 NI 0(R3),X'FD' SET STATUS BIT 6 (PF BIT) OFF 11360000 * 11380000 * 11400000 * SCHED FBW BUFFRS FOR WRITING VIA PTR A (STATUS BITS 1,2 ON) 11420000 * AT THE SAME TIME TEST STATUS BYTES FOR BIT-3 ON = NEW EXTENT 11440000 * 11460000 ISLFY08 L R4,ISLFBW C(R4)= NO OF SLOTS TO SCHED 11480000 ISLFY10 OI 0(R3),X'60' SET STATUS BITS 1,2 = 11 11500000 TM 0(R3),X'10' TEST STATUS BIT-3 11520000 BC 8,ISLFY11 B IF 0, SAME EXTENT 11540000 IC R5,IOBDADAD C(R5)-M P4701 11560000 LA R5,1(0,R5) C(R5)-M+1 P4701 11580000 STC R5,IOBDADAD C(IOBA+32)=MBBCCHHR, M=M+1 11620000 BAL R5,ISLFZ21 11630013 NI 0(R3),X'EF' SET STATUS BIT-3 = 0 11640000 ISLFY11 A R3,ISL4 BUMP R3 TO ADR NEXT SLOT 11660000 C R3,ISLBUFN TEST FOR ADR OF NTH SLOT 11680000 BC 13,ISLFY20A BR IF NOT HIGH 11700000 ISLFY12 BCT R4,ISLFY13 WRAPAROUND POSSIBLE 11720000 B ISLFY20 OUT, SLOT N WAS LAST 11740000 ISLFY13 LA R3,IOBABUF WRAPAROUND REAL, C(R3)=A(SLOT1) 11760000 B ISLFY10 LOOP AGAIN 11780000 * 11800000 * SAVE ADR OF LAST SLOT IN REG 7 11820000 ISLFY20A BCT R4,ISLFY10 11840000 ISLFY20 LR R7,R3 C(R7)=A(LAST SLOT SCHED + 4) 11860000 S R7,ISL4 C(R7)=A(LAST SLOT SCHED) 11880000 * 11900000 * INITIALIZE CP18 AND CP20 IN SUBROUTINE 11920000 * 11940000 * 11960000 STM R2,R11,ISLVRSAV+28 SAVE REGS 2-11 11980000 B ISLF801 12000000 ISLFY21 LM R2,R11,ISLVRSAV+28 RESTORE REGS 2-11 12020000 * 12040000 * SAVE CONTENTS OF BCT SLOT WITH STATUS AND POINTER OF LAST BUFF SCHED 12060000 * 12080000 L R3,0(R7) C(R3)=LAST BCT SLOT CONTENTS 12100000 ST R3,ISLF9WK1 SAVE SLOT CONTENTS 12120000 * 12140000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 12160000 * 12180000 TM 0(R7),X'04' TEST S BIT 5 VS 1 (C-BIT) 12200000 BC 1,ISLFZ01 B IF ON 12220000 * 12240000 * 12260000 * EXECUTE CP18 (CP20) 12280000 * 12300000 * 12320000 ISLFY30 LA R13,ISLVRSAV C(R13)=A(VRSAV) 12340000 LR R3,R0 SAVE R0 12360000 LR R4,R1 SAVE R1 12380000 LR R5,R14 SAVE R14 12400000 * 8791 12420000 * 8791 12440000 * 8791 12460000 * SET FLAGS BIT-0 (IWR BIT)=1, CP IS NOT AVAIL 8791 12480000 * 8791 12500000 OI IOBFLAGS,X'80' TURN ON FLAGS BIT 0 8791 12520000 * 8791 12540000 EXCP IHAIOB EXECUTE CHANNEL PROGRAM 12560000 LR R0,R3 RESTORE R0 12580000 LR R1,R4 RESTORE R1 12600000 LR R14,R5 RESTORE R14 12620000 * 12640000 * SET FBW IN SUBROUTINE 12660000 * 12680000 LA R7,ISLF9WK1 C(R7)=A(LAST SLOT) FROZEN 12700000 B ISLPB01 GO TO SUBROUTINE 12720000 ISLFY41A OI IOBFLAGS,X'40' SET FLAGS BIT 1 ON TO ATTEMPT 12740000 * TO WRITE LATER 12760000 * 12780000 * 12800000 * 12820000 * TEST FLAGS BIT 2 (NOT EOB INDICATOR) 12840000 * 12860000 ISLFY41 TM IOBFLAGS,X'20' TEST FLAGS BIT 2 12880000 BC 8,ISLFY42 B IF NOT ON (EOB) 12900000 NI IOBFLAGS,X'DF' TURN FLAGS BIT 2 OFF 12920000 B ISLFX13 RTRN TO FX (DONT GET LOC BUFF) 12940000 * 12960000 * TEST FOR MOVE OR LOCATE PUT 12980000 * 13000000 ISLFY42 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 13020000 BC 1,ISLFX13 B IF ON = MOVE PUT, RTRN TO FX 13040000 * 13060000 * LOCATE PUT 13080000 * 13100000 BAL R14,ISLPA01 *LINK TO BOB ROUTINE 13120000 B ISLFX13 RETURN TO FX 13140000 * 13160000 * 13180000 ***WAIT SUBROUTINE*** 13200000 * THIS SUBROUTINE DETERMINES IF A CHANNEL PROGRAM IS AVAILABLE, AND 13220000 * IF IT IS NOT, WAITS UNTIL IT IS. THE ROUTINE EXPECTS THE FOLLOWING 13240000 * INPUT - R2 = ADDR OF IOB FOR CHANNEL PROGRAM TO BE TESTED 13260000 * R4 = RETURN ADDRESS 13280000 * 13300000 ISLFY99 EQU * 13320000 ST R4,ISLVRSAV SAVE RETURN ADDRESS 0700 13340000 LR R3,R1 SAVE R1 13360000 L R1,IOBECBAD C(R1)=A(ECB) 13380000 TM 0(R1),X'40' TEST ECB BIT 1 (C-BIT) 13400000 BC 1,ISLFY995 B IF 1, I/O COMPLETE-DON'T WAIT 13420000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 13440000 LR R4,R0 SAVE R0 13460000 LR R5,R14 SAVE R14 13480000 WAIT ECB=(1) 13500000 LR R0,R4 RESTORE R0 13520000 LR R1,R3 RESTORE R1 13540000 LR R14,R5 RESTORE R14 13560000 * 13580000 ISLFY995 LA R2,ISLIOBA C(R2)=A(IOBA) 13600000 LR R1,R3 RESTORE R1 13620000 L R3,IOBPTRA C(R3)=A(1ST SLOT TO SCHED) 13640000 LA R3,0(R3) 13660000 L R4,ISLVRSAV GET RETURN ADDRESS 0700 13680000 BCR 15,R4 RETURN 13700000 * 13720000 EJECT 13740000 *********************************************************************** 13760000 * CHART FZ - CYLINDER INDEX ENTRY SETUP * 13780000 *********************************************************************** 13800000 * 13820000 * 13840000 * STORE ADDR OF STATUS BYTE WITH C-BIT ON IN CP21 AT CQ41 13860000 * -THIS IS DONE TO PERMIT APPENDAGE TO TURN OFF C-BIT- 13880000 * * R7 CONTAINS ADDR OF THE STATUS BYTE * 13900000 * 13920000 ISLFZ01 L R10,DCBWKPT6 C(R10)=A(VPTRS) 13940000 L R10,24(R10) C(R10)=A(CP21-CQ40) 13960000 ST R7,12(R10) C(CQ41+4)=A(LAST SLOT SCHED) 13980000 NI ISLIXLT,X'F7' SET IXLT LEV1 BIT-4 OFF- TRK IX 14000000 * 14020000 * 14040000 * LOCATE LEVEL IN INDEX LOCATION TABLE AT CYLINDER INDEX 14060000 * 14080000 LA R7,ISLIXLT C(R7)=A(IXLT) 14100000 OI 0(R7),X'20' IXLTIND BIT-2 ON IN LEV1 14120000 NI 26(R7),X'DF' BIT-2 OFF IN LEV2 14140000 NI 52(R7),X'DF' LEV3 14160000 NI 78(R7),X'DF' LEV4 14180000 * 14200000 * CONSTRUCT COUNT FOR CYLINDER INDEX ENTRY IN AREA Y, Y+0 14220000 * 14240000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 14260000 L R9,0(R10) C(R9)=A(AREA Y) 14280000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT S0 14300000 SR R3,R3 14320000 IC R3,16(R7) C(R3)=R FROM IXLT S0, 000N 14340000 A R3,ISLONEF C(R3)=R+1 14360000 STC R3,4(R9) COUNT = CCHHR WITH R=R+1 14380000 * 14400000 * CONSTRUCT DATA FOR CYLINDER INDEX ENTRY IN AREA Y, Y+8 14420000 * 14440000 TM 0(R7),X'40' TEST IXLTIND BIT 1 (DUMMY SW) 14460000 BC 1,ISLFZ10 B IF ON 14480000 * 14500000 * DUMMY SW OFF 14520000 * A. NORMAL DATA 14540000 * 14560000 MVC 8(7,R9),IOBDADAD DATA=MBBCCHH FROM IOBA+32 14580000 CLI DCBDEVT,X'02' IS IT 2301 14600000 BE ISLFZ015 B IF YES 14620000 CLI DCBDEVT,X'05' IS IT 2321 14640000 BE ISLFZ019 BR IF YES 14660000 * 14680000 MVC 13(2,R9),ISLZEROF DATA=MBBCCHH HH=00 14700000 ISLFZ012 EQU * A46109 14720021 CLI DCBFIRSH+1,K0 H OF FIRSH VS 0 A46109 14740021 BNE ISLFZ02 BIF HH NOT 00 A46109 14760021 * HH OF FIRSH = 00 14780021 MVC 15(1,R9),DCBFIRSH+2 DATA = MBBCCHHR WITH R A46109 14800021 * OF FIRSH 14820021 B ISLFZ03 A46109 14840021 ISLFZ015 NI K14(R9),K2301 2301 - HEAD = 0 A46109 14860021 B ISLFZ012 B TO COMPARE A46109 14880021 ISLFZ019 MVI K14(R9),K0 2321 - HEAD = 0 A46109 14900021 B ISLFZ012 B TO COMPARE A46109 14920021 ISLFZ02 MVI 15(R9),X'00' DATA = MBBCCHHR WITH R=00 14980000 ISLFZ03 MVI 16(R9),X'01' DATA = MBBCCHHRF WITH F = 01 15000000 * 15020000 SR R6,R6 15040000 IC R6,9(R7) C(R6) = M FROM IXLT S0 15060000 BCTR R6,0 C(R6)=M-1 15080013 SLL R6,4 C(R6) = M-1 X 16 (USE AS INDX) 15100000 * 15120000 SR R5,R5 15140000 IC R5,IOBDADAD C(R5) = M FROM IOBA+32 15160000 BCTR R5,0 C(R5)=M-1 15180013 SLL R5,4 C(R5) = M-1 X 16 (USE AS INDX) 15200000 * 15220000 L R8,DCBDEBAD C(R8)=A(DEB) 15240000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 15280000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTENT ENTRY) 15300000 L R3,DEBFPEAD C(R3)=A(1ST PRIM EXTENT ENTRY) 15320000 LA R3,0(R5,R3) C(R3)=A(CURR PRIM EXTENT ENTRY) 15340000 L R9,0(R10) C(R9)=A(AREA Y) 15360000 * 15380000 CLC 1(3,R3),1(R4) COMP UCB ADDRS, PRIM VS INDX 15400000 BNE ISLFZ04 B IF NOT EQUAL 15420000 * 15440000 * UCBS EQUAL 15460000 CLI DCBDEVT,X'05' IS IT A 2321 15480000 BC 7,ISLFZ04A BR IF NOT A 2321 15500000 CLC 0(2,R9),11(R9) COMPARE CC OF IX ENTRY 15520000 * WITH CC OF REF'D TRACK 15540000 BNE ISLFZ04 BRANCH IF UNEQUAL TO SET P=07 15560000 ISLFZ04A EQU * 15580000 MVI 17(R9),X'0B' DATA = MBBCCHHRFP WITH P=0B 15600000 B ISLFZ05 15620000 * 15640000 * UCBS UNEQUAL 15660000 ISLFZ04 MVI 17(R9),X'07' DATA = MBBCCHHRFP WITH P=07 15680000 * 15700000 * SET CQ43 (CP21) TO ADDRESS KEY 15720000 * OF LAST RECORD IN LAST BUFFER 15740000 * 15760000 ISLFZ05 L R4,ISLKEYAD =A(KEY OF LAST WR CKD) 13165 15830016 B ISLFZ20 15900000 * 15920000 * DUMMY SW ON = END OF CYLINDER 15940000 * B. DUMMY DATA 15960000 * 15980000 * TEST CC+1 VS DEBENDCC FOR 16000000 * POSSIBLE END OF INDEX EXTENT 16020000 * 16040000 ISLFZ10 EQU * 16060000 SR R6,R6 16080000 IC R6,9(R7) C(R6)=M FROM IXLT S0, 000M 16100000 BCTR R6,0 16120013 SLL R6,4 C(R6)= 16(M-1) USE FOR INDEX 16140013 * TO DEB ENTRY FOR CURR IX EXTNT 16160000 * 16180000 L R8,DCBDEBAD C(R8)=A(DEB) 16200000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 16240000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTNT ENTRY) 16260000 * 16280000 L R9,0(R10) C(R9)=A(AREA Y) 16320000 MVC ISLFXWK1(4),12(R7) C(FXWK1)=CCHH OF IXLT SO 13165 16340016 L R3,ISLFXWK1 C(R3)=CCHH 16360000 MVC ISLFXWK2(4),10(R4) C(FXWK2)=CCHH FROM DEBENDCC 16380000 CLI ISLAREAZ+86,X'02' IS IT 2301 16400000 BC 8,ISLFZ103 BR IF EQ - IT IS 2301 16420000 * 16440000 CLI ISLAREAZ+86,X'05' IS IT 2321 16460000 BC 8,ISLFZ105 BR EQ - 2321 16480000 * 16500000 SRL R3,16 C(R3)=00CC 16520000 LA R3,1(R3) ADD 1 FOR NEXT CYL C(R3)=00CC+1 16540000 SLL R3,16 C(R3)=CC+100 16560000 ST R3,ISLFXWK1 C(FXWK1)=CC+100 16580000 CLC ISLFXWK1(2),ISLFXWK2 CC+1 VS ENDCC 16600000 BH ISLFZ11 BR IF CC+1 HI - IN NEW EXTENT 16620000 * 16640000 * CC+1 IN CURRENT EXTENT 16660000 ISLFZ11A MVC 8(3,R9),9(R7) DATA=MBB FROM IXLT S0 16680000 MVC 11(4,R9),ISLFXWK1 DATA=MBBCCHH CC=CC+1 HH=00 16700000 BC 15,ISLFZ12 BR TO PICK UP R, ETC. 16720000 * 16740000 * COMPUTE CYL+1 FOR 2301 16760000 ISLFZ103 N R3,CONSF8 C(R3)=000H H=CYL 16780000 LA R3,8(R3) C(R3)=CYL+1 16800000 NC ISLFXWK2(4),CONSF8 C(FXWK2)=000H H=END CYL OF EXT 16820000 * 16840000 * COMPARE CYL+1 VS END CYL OF CURRENT EXTENT 16860000 ISLFZ107 ST R3,ISLFXWK1 C(FXWK1)=CYL+1 16880000 CLC ISLFXWK1(4),ISLFXWK2 CYL+1 VS END CYL 16900000 BH ISLFZ11 CYL+1 HI - BR TO GET NEXT EXTNT 16920000 B ISLFZ11A CYL+1 IN CURRENT EXTENT 16940000 * 16960000 * COMPUTE CYL+1 FOR 2221 16980000 ISLFZ105 MVI ISLFXWK2+3,X'00' ZERO TRACK BYTE IN EXTNT END 17000000 SRL R3,8 C(R3)=0CCH ADR FROM IOB+32 17020000 ST R3,ISLFXWK1 C(FXWK1)=0CCH 17040000 CLI ISLFXWK1+3,X'04' TEST FOR LAST CYL IN STRIP 17060000 BC 8,ISLFZ1A5 BR EQ - AT END OF STRIP 17080000 LA R3,1(R3) NOT LAST CYL - SET TO NEXT 17100000 SLL R3,8 C(R3)=CC(H+1)0 17120000 B ISLFZ107 BR TO COMPARE 17140000 * 17160000 ISLFZ1A5 EQU * 17180000 CLI ISLFXWK1+2,X'09' TEST FOR LAST STRIP IN SUBCELL 17200000 BC 8,ISLFZ1B5 BR EQ - AT END OF SUBCELL 17220000 SRL R3,8 C(R3)=00CC 17240000 LA R3,1(R3) NOT LAST STRIP - STEP TO NEXT 17260000 SLL R3,16 C(R3)=CC+100 17280000 B ISLFZ107 BR TO COMPARE 17300000 * 17320000 ISLFZ1B5 EQU * 17340000 SRL R3,16 C(R3)=000C 17360000 LA R3,1(R3) AT END OF SUBCELL-SET TO NEXT 17380000 SLL R3,24 C(R3)=C+1000 17400000 B ISLFZ107 BR TO COMPARE 17420000 * 17440000 * 17460000 ISLFZ11 EQU * 17480000 LA R6,16(R6) C(R6)=MX16 INDEX TO NEXT EXTENT 17500000 MVC ISLFXWK1(1),3(R4) C(FXWK1)= H FROM BUFR CNT 17520000 L R8,DCBDEBAD C(R8)=A(DEB) 13165 17530016 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 17540000 LA R4,0(R6,R4) C(R4)=A(NEXT INDX EXTENT ENTRY) 17560000 * 17580000 L R9,0(R10) C(R9)=A(AREA Y) 13165 17590016 MVC 11(4,R9),6(R4) DATA=CCHH OF NEW EXTENT 7M568 17600000 SRL R6,4 C(R6) = M FOR NEXT EXTENT 17620000 A R6,ISLONEF C(R6) = M+1 (M=1 FOR EXTENT 0) 17640000 STC R6,8(R9) DATA = MBBCCHH OF NEW EXTENT 17660000 * 17680000 ISLFZ12 MVI 15(R9),X'00' DATA = MBBCCHHR WITH R=00 17700000 * 17720000 MVI 16(R9),X'29' DATA = MBBCCHHRF WITH F=29 17740000 MVI 17(R9),X'07' DATA = MBBCCHHRFP WITH P=07 17760000 * 17780000 * SET CQ43(CP21) TO ADDRESS KEY 17800000 * OF ALL ONES AT AREA Y +62 17820000 * 17840000 LA R4,62(R9) C(R4)=A(AREA Y +62) 17880000 * 17960000 * PLACE IXLT S0 IN IOBB+32 17980000 * 18000000 ISLFZ20 L R10,24(R10) C(R10)=A(CP21-CQ40) 13165 18004016 IC R5,24(R10) SAVE OP 13165 18008016 ST R4,24(R10) PTR TO REAL OR DUMMY KEY 13165 18012016 STC R5,24(R10) RESTORE OP 13165 18016016 LA R2,ISLIOBB C(R2)=A(IOBB) 13165 18020016 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT SO) 13165 18024016 BAL R5,ISLFZ21 18030013 * 18040000 * 18060000 * 18080000 * EXECUTE CP21 18100000 * 18120000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 18140000 LR R3,R0 SAVE R0 18160000 LR R4,R1 SAVE R1 18180000 LR R5,R14 SAVE R14 18200000 EXCP IHAIOB EXECUTE CHANNEL PROGRAM 18220000 LR R0,R3 RESTORE R0 18240000 LR R1,R4 RESTORE R1 18260000 LR R14,R5 RESTORE R14 18280000 * 18300000 LA R2,ISLIOBA C(R2)=A(IOBA) 18320000 TM IOBFLAGS,X'12' TEST FLAGS BITS 3&6 (CLOSE X) 18340000 BCR 1,R14 BR IF ON = CLOSE 18360000 B ISLFY30 EXIT 18380000 ISLFZ21 EQU * 18382013 L R13,DCBDEBAD 18384013 LA R13,32(R13) START MOVE OF DEB BB INTO IOB 18386013 SR R8,R8 18388013 IC R8,IOBDADAD 18390013 SLL R8,4 18392013 AR R8,R13 18394013 MVC IOBDADAD+2(1),5(R8) 18396013 BR R5 RETURN 18398013 * 18400000 EJECT 18420000 *********************************************************************** 18440000 * CHART PA - BEGINING OF BUFFER * 18460000 *********************************************************************** 18480000 * 18500000 * 18520000 * USING PTR B TO REFERENCE COUNT IN LAST BUFFER FILLED - 18540000 * SET REG 5 = R - REG A = 000R 18560000 * SET REG 6 = CCHH - REG B = CCHH 18580000 * SET REG 7 = HI-RCD ON TRACK - REG C = 000R 18600000 * 18620000 ISLPA01 ST R14,ISLF9WK1 SAVE R14 FOR RETURN TO FX 18640000 MVC DCBFTMI3(8),DCBLPDA SAVE PREVIOUS LPDA FOR CLOSE 18660000 L R3,IOBPTRB C(R3)=C(PTRB) 18680000 LA R3,0(R3) C(R3)=A(SLOT S) 18700000 L R4,0(R3) C(R4)=C(SLOT S)=A(BUF B) 18720000 SR R5,R5 18740000 IC R5,4(R4) C(R5)=000R 18760000 MVC ISLFXWK2(4),0(R4) C(FXWK2)=CCHH 18780000 L R6,ISLFXWK2 C(R6)=CCHH 18800000 * 18820000 * TEST HH FOR SHARED TRACK 18840000 SR R7,R7 18860000 CLI DCBHIRSH,X'00' HIRSH VS 0 18880000 BE ISLPA02 BR IF 0 - NO SHARED TRACKS 18900000 STC R6,ISLFXWK1 C(FXWK1)= H FROM BUF CNT 18920000 ISLPA01A NC ISLFXWK1(1),DCBFIRSH+3 REDUCE TO TRACK 18940000 ISLPA01B CLC DCBFIRSH+1(1),ISLFXWK1 H OF FIRSH VS H OF BUFR CNT 18960000 IC R7,DCBHIRSH C(R7)=HIRSH 18980000 BE ISLPA03 BR EQ, SHARED TRK - R7=HIRSH 19000000 ISLPA02 IC R7,DCBHIRPD NOT A SHARED TRACK, C(R7)=HIRPD 19020000 * 19040000 * STEP PTR B TO NEXT SLOT IN BCT (MAY WRAPAROUND) 19060000 * 19080000 ISLPA03 C R3,ISLBUFN TEST FOR ADR OF NTH SLOT 19100000 LA R3,4(R3) STEP TO NEXT SLOT 19120000 BNE ISLPA05 NOT NTH SLOT, GO UPDATE PTR B 19140000 ISLPA04 LA R3,IOBABUF C(R3)=0AAA, AAA= ADR 1ST SLOT 19160000 ISLPA05 IC R4,IOBB SAVE B 19180000 ST R3,IOBPTRB STORE UPDATED PTR B 19200000 STC R4,IOBB RESTORE B 19220000 * 19240000 * UPDATE CBF AND EOB FOR NEW BUFFER VIA PTR B 19260000 * 19280000 L R4,0(R3) C(R4)=C(SLOT S)=A(BUFF B) 19300000 LA R4,0(R4) 19320000 LR R3,R4 C(R3)=A(BUFF B) 19340000 A R3,ISL8 C(R3)=A(BUFF B)+8 19360000 ST R3,ISLCBF C(CBF)=A(BUFF B)+8 19380000 L R3,DCBBUFL C(R3)=NNXX, NN=BUFL 19400000 SRL R3,16 C(R3)=00NN 19420000 BCTR R3,0 C(R3)=00NN-1 19440013 AR R3,R4 C(R3)=A(BUFF B)+BUFL-1 19460000 ST R3,ISLEOB C(EOB)=A(BUFF B)+BUFL-1 19480000 * 19500000 * 19520000 * ROUTINE TO SET UP NEW COUNT FIELD FOR NEW BUFFER 19540000 * ************************************************ 19560000 * 19580000 * 19600000 * TEST IF LAST BUFFR FILLED WAS EOT 19620000 * 19640000 CR R7,R5 TEST REG C VS REG A 19660000 BE ISLPA20 B IF EOT 19680000 * 19700000 * 19720000 * STEP REG A TO NEXT R ON CURRENT TRACK 19740000 * 19760000 A R5,ISLONEF C(R5)=000R+1 19780000 * 19800000 * TEST IF NEXT BUFFR TO BE FILLED IS AVAILABLE (STATUS BITS) 19820000 * 19840000 ISLPA50 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 19860000 LA R3,0(R3) C(R3)=A(STATUS BITS) 19880000 TM 0(R3),X'60' TEST BITS 1 AND 2 19900000 BC 8,ISLPA70 B IF 00 = BUFFR AVAILABLE 19920000 * 19940000 * BITS 1 AND 2 = 11 OR 10 19960000 * 19980000 * WAIT FOR CP18, AND/OR CP20, AND/OR CP21 BEFORE RE-FILLING BUFFER 20000000 * 20020000 ISLPA60 L R4,IOBECBAD C(R4)=A(ECB) 20040000 TM 0(R4),X'40' TEST ECB BIT 1 (C-BIT) 20060000 BC 1,ISLPA70 B IF 1, I/O COMPLETE-DONT WAIT 20080000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 20100000 LR R3,R1 SAVE R1 20120000 LR R1,R4 C(R1)=A(ECB) 20140000 LR R4,R0 SAVE R0 20160000 WAIT ECB=(1) WAIT 20180000 LR R0,R4 RESTORE R0 20200000 LR R1,R3 RESTORE R1 20220000 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 20240000 LA R3,0(R3) C(R3)=A(STATUS BITS) 20260000 * 20280000 * 20300000 * TEST DCBEXCD1 BIT 5 FOR PREVIOUS UNCORRECTABLE WRITE ERROR 20320000 * 20340000 ISLPA70 TM DCBEXCD1,X'04' TEST EXCD1 BIT 5 20360000 BC 8,ISLPA72 B IF NOT ON 20380000 TM IOBFLAGS,X'10' TEST FLAGS BIT 3 (CLOSE) 20400000 BC 1,ISLPA72 B IF ON = CLOSE 20420000 L R10,DCBWKPT6 C(R10)=A(VPTRS) FROM VPTR10 20440000 L R13,ISLVRSAV+4 C(R13)=A(USERS SAVE AREA) 20460000 L R0,36(R10) C(R0)=A(BAD BUF) FROM VPTR10 20480000 ST R0,24(R13) STORE A(BAD BUF) IN USERS R1 20500000 LA R0,ISLIOBA C(R0)=A(IOBA) 20520000 ST R0,20(R13) STORE A(IOBA) IN USERS R0 20540000 MVC 40(4,R10),DCBSYNAD SET VPTR 11 = A(SYNAD) 20560000 B ISLFX05 B TO TAKE SYNAD 20580000 * 20600000 ISLPA72 EQU * 20620000 LA R2,ISLIOBB C(R2)=A(IOBB) 20640000 TM 0(R3),X'04' TEST BIT 5 (C-BIT) 20660000 BC 7,ISLPA60 BR IF 1 - C-BIT ON 20680000 * 20700000 * C-BIT OFF 20720000 LA R2,ISLIOBA C(R2)=A(IOBA) 20740000 * 20760000 * TEST IF NEXT BUFFER TO BE FILLED WILL BE EOT (AND EOC) 20780000 * IF EOT, TURN ON T-BIT IF EOC, TURN ON C-BIT 20800000 * 20820000 ISLPA80 CR R7,R5 TEST REG C VS REG A 20840000 BNE ISLPA84 B IF NOT EOT 20860000 * 20880000 * NEXT BUFFER EOT 20900000 OI 0(R3),X'08' TURN T-BIT ON (STATUS BIT 4) 20920000 ST R6,ISLFXWK1 C(FXWK1)= CCHH FROM REG B 20940000 ISLPA8A NC ISLFXWK1+3(1),DCBFIRSH+3 REDUCE TO TRACK FROM REG B 20960000 ISLPA8B CLC DCBLDT+1(1),ISLFXWK1+3 H OF LDT VS H FROM REG B 20980000 BNE ISLPA84 B IF NOT LDT 21000000 OI 0(R3),X'04' TURN C-BIT ON (STATUS BIT 5) 21020000 * 21040000 * ENTER NEW COUNT IN BUFFER USING REG A AND REG B AND UPDATE LPDA 21060000 * 21080000 ISLPA84 L R3,0(R3) C(R3)=C(SLOT S)=A(NEXT BUFFR) 21100000 LA R3,0(R3) 21120000 ST R6,ISLFXWK2 STORE CCHH FROM REG B 21140000 MVC 0(4,R3),ISLFXWK2 21160000 STC R5,4(R3) STORE R FROM REG A 21180000 MVC DCBLPDA+3(5),0(R3) STORE CCHHR FROM BUF IN LPDA 21200000 L R14,ISLF9WK1 RESTORE R14 FOR RETURN TO FX 21220000 BR R14 *EXIT 21240000 *---------------------------------------------------------------------- 21260000 * 21280000 * LAST BUFFR FILLED EOT 21300000 * SET REG 7 (REG C) = HIRPD, NEXT TRACK CANT BE SHARED 21320000 * 21340000 ISLPA20 IC R7,DCBHIRPD NOT A SHARED TRACK, C(R7)=HIRPD 21360000 ST R6,ISLFXWK1 C(FXWK1)=CCHH FROM REG B 21380000 * 21400000 * TEST FOR OUT-OF-SPACE 21420000 * 21440000 CLC DCBLPDA(1),DCBMSWA CURRENT M VS HI M 21460000 BNE ISLPA21 B IF NOT HI PRIME M 21480000 CLC ISLFXWK1(4),DCBMSWA+3 CURRENT CCHH VS HI CCHH 21500000 BL ISLPA21 BR LESS THAN HIGH PRIME A27810 21510019 * CCHH A27810 21520019 TM IOBFLAGS,X'10' TEST FOR CLOSE 21540000 BO ISLPA21 IF IN CLOSE,BRANCH TO GET 17925 21560000 * COUNT,ELSE OUT OF SPACE 17925 21580000 * *---------OUT-OF-SPACE---------* 21620000 ISLPA205 EQU * 21640000 OI DCBEXCD1,X'20' SET EXCD1 BIT 2 ON = SPACE ERR 21660000 B ISLFX05 B TO TAKE SYNAD 21680000 * 21700000 * TEST IF LAST BUFFER FILLED WAS EOT AND EOC 21720000 * 21740000 ISLPA21 EQU * 21760000 EX R0,ISLPA8A EXECUTE NC 21780000 EX R0,ISLPA8B EXECUTE CLC 21800000 BE ISLPA30 B IF EOT AND EOC 21820000 * 21840000 * EOT NOT EOC 21860000 * STEP REG B TO NEXT HH AND SET REG A TO R = 1 21880000 * 21900000 A R6,ISLONEF C(R6)=CCHH+1 21920000 L R5,ISLONEF C(R5)=000R, R = 1 21940000 B ISLPA50 21960000 * 21980000 * 22000000 * EOT,EOC 22020000 * NEXT BUFFER TO BE FILLED WILL BE THE 1ST BUFFR ON A NEW CYLINDER 22040000 * 22060000 * TEST IF SHARED TRACKS 22080000 * 22100000 ISLPA30 CLI DCBHIRSH,X'00' HIRSH VS 0 22120000 BE ISLPA31 B IF 0, NOT SHARED 22140000 * 22160000 * SHARED TRACKS 22180000 * IF SHARED TRACKS, 1ST PRIME DATA ON NEW CYLINDER IS ON A SHARED TRACK 22200000 * 22220000 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 22240000 OI 0(R3),X'02' TURN PF-BIT ON (STATUS BIT 6) 22260000 * 22280000 * SET REG 7 (REG C) = HIRSH 22300000 * 22320000 IC R7,DCBHIRSH SHARED TRACK NEXT, C(R7)=HIRSH 22340000 * 22360000 * TEST IF LAST BUFFER FILLED WAS EOT, EOC, AND EOE 22380000 * 22400000 ISLPA31 L R8,DCBDEBAD C(R8)=A(DEB) 22420000 L R3,DEBFPEAD C(R3)=A(1ST PRIME EXTENT ENTRY) 22440000 LA R3,0(R3) 22460000 L R4,DCBLPDA C(R4)=MBBC 22480000 SRL R4,24 C(R4)=000M 22500000 BCTR R4,0 C(R4)=M-1 22520013 SLL R4,4 C(R4)=000M-1 X 16 (USE AS INDX) 22540000 L R8,12(R4,R3) C(R8)=HHXX-END HH OF CURR EXTNT 22560000 SRL R8,16 C(R8)=00HH 22580000 CLI DCBDEVT,X'02' IS IT 2301 22600000 BE ISLPA32 BR IF 2301 22620000 CLI DCBDEVT,X'05' IS IT 2321 22640000 BE ISLPA321 BRANCH IF 2321 22660000 * 22680000 L R8,8(R4,R3) C(R8)=END HHCC OF CURR EXTENT 22700000 SLL R8,16 C(R8)=CC00 22720000 SRL R8,16 C(R8)=00CC=END CC OF EXTENT 22740000 LR R5,R6 C(R5)=CCHH 22760000 SRL R5,16 C(R5)=00CC=CC JUST FILLED 22780000 CR R8,R5 COMPARE FOR LAST CYLINDER 22800000 BH ISLPA33 B IF END CC IS HIGH 22820000 * 22840000 * EOT, EOC, AND EOE 22860000 * 22880000 * SET REG 6 (REG B) TO CC FROM NEXT EXTENT 22900000 * 22920000 LA R4,16(R4) C(R4)=MX16 INDEX TO NEXT EXTNT 22940000 L R8,4(R4,R3) C(R8)=STR BBCC OF NEXT EXTENT 22960000 SLL R8,16 C(R8)=CC00 22980000 LR R6,R8 C(R6)=CC00, HH SET LATER 23000000 * 23020000 * SET M IN DCBLPDA = M+1 23040000 * 23060000 SRL R4,4 C(R4)=000M 23080000 A R4,ISLONEF C(R4)=000M+1 (M=1 FOR EXTENT 0) 23100000 STC R4,DCBLPDA C(LPDA)=000M+1 23120000 * 23140000 * SET STATUS BIT-3 ON = NEW EXTEN STARTS WITH THIS BUFFR 23160000 * 23180000 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 23200000 LA R3,0(R3) C(R3)=A(STATUS BITS) 23220000 OI 0(R3),X'10' TURN STATUS BIT-3 ON 23240000 * 23260000 B ISLPA34 23280000 * 23300000 *END OF EXTENT TEST FOR 2301 AND 2321 23320000 * 2301 - FIND CYL ADDR OF END OF EXTENT 23340000 ISLPA32 EQU * 23360000 N R8,CONSF8 C(R8)=000H REDUCED TO CYL ADDR 23380000 LR R5,R6 C(R5)=CCHH FROM REG B 23400000 N R5,CONSF8 C(R5)=000H REDUCE TO CYL ADDR 23420000 BC 15,ISLPA322 23440000 * 2321 - FIND CYL-ADDR OF END OF EXTENT 23460000 ISLPA321 EQU * 23480000 L R5,8(R4,R3) C(R5)=XXCC CC FROM END-ADDR 23500000 SLL R5,16 C(R5)=CC00 23520000 OR R8,R5 C(R8)=CCHH ADDR END OF EXTENT 23540000 IC R8,CONSF8 C(R8)=CCH0 ZERO TRACK ADDR 23560000 * FIND ADDR OF CYL JUST FILLED - REG B 23580000 LR R5,R6 C(R5)=CCHH FROM REG B 23600000 IC R5,CONSF8 C(R5)=CCH0 ZERO TRACK ADDR 23620000 * 23640000 ISLPA322 EQU * 23660000 CR R8,R5 COMPARE EOE AND CURR CYL. 23680000 BC 13,ISLPA327 BR IF EOE LO OR EQ - AT EOE 23700000 * 23720000 * NOT END OF EXTENT - SET REG B TO NEXT CYL, TAKE TRACK FROM FIRSH 23740000 * 23760000 CLI DCBDEVT,X'05' IS IT 2321 23780000 BC 8,ISLPA323 BRANCH IF 2321 23800000 * 2301 23820000 LA R5,8(R5) ADD 8 TRKS FOR NEXT LOGCL CYL 23840000 STC R5,ISLFXWK1 C(FXWK1)=H CYL ONLY (CYL+1) 23860000 OC ISLFXWK1(1),DCBFIRSH+1 SET TRACK FROM FIRSH 23880000 IC R5,ISLFXWK1 C(R5)=CCHH NXT CYL & FIRSH TRK 23900000 BC 15,ISLPA32E BR TO SET REG B 23920000 * 2321 23940000 ISLPA323 EQU * 23960000 SRL R5,8 C(R5)=0CCH ADDR FROM REG B 23980000 ST R5,ISLFXWK1 C(FXWK1)=0CCH 24000000 CLI ISLFXWK1+3,X'04' TEST FOR LAST CYL IN STRIP 24020000 BC 8,ISLPA325 BRANCH IF EQ - AT END OF STRIP 24040000 LA R5,1(R5) NOT LAST CYL - SET TO NEXT 24060000 SLL R5,8 C(R5)=CC(H+1)0 24080000 * 24100000 ISLPA324 EQU * 24120000 IC R5,DCBFIRSH+1 TAKE TRACK ADDR FROM FIRSH 24140000 ISLPA32E EQU * 24160000 LR R6,R5 SET REG B FOR NEW CYLINDER 24180000 BC 15,ISLPA35 BR TO SET R5 TO R FROM FIRSH 24200000 * 24220000 ISLPA325 EQU * 24240000 CLI ISLFXWK1+2,X'09' TEST FOR LAST STRIP IN SUBCELL 24260000 BC 8,ISLPA326 BR IF EQ - AT END OF SUBCELL 24280000 SRL R5,8 C(R5)=00CC 24300000 LA R5,1(R5) NOT LAST STRIP - ADD 1 FOR NXT 24320000 SLL R5,16 C(R5)=C(C+1)00 24340000 BC 15,ISLPA324 24360000 * 24380000 ISLPA326 EQU * 24400000 SRL R5,16 C(R5)=000C 24420000 LA R5,1(R5) ADD 1 FOR NEXT SUBCELL 24440000 SLL R5,24 C(R5)=(C+1)000 24460000 BC 15,ISLPA324 24480000 * 24500000 * END OF EXTENT - SET REG B TO NEXT EXTENT 24520000 * 24540000 ISLPA327 EQU * 24560000 LA R4,16(R4) C(R4)=000(MX16)INDX TO NXT EXT 24580000 L R5,8(R4,R3) C(R5)=HHXX START OF NEXT EXTNT 24600000 L R8,4(R4,R3) C(R8)=BBCC START OF NEXT EXTNT 24620000 * UPDATE M AND BB IN DCBLPDA 24640000 ST R8,ISLFXWK1 C(FXWK1)=BBCC 24660000 SRL R4,4 C(R4)=000M 24680000 A R4,ISLONEF C(R4)=000M+1 M=1 FOR EXTENT 0 24700000 STC R4,DCBLPDA C(LPDA)=MXXXXXXX 24720000 MVC DCBLPDA+1(4),ISLFXWK1 C(LPDA)=MBBXXXXX 24740000 * SET REG B FOR NEXT EXTENT 24760000 SLL R8,16 C(R8)=CC00 NEXT EXTENT 24780000 SRL R5,16 C(R5)=00HH NEXT EXTENT 24800000 OR R8,R5 C(R8)=CCHH START OF NEXT EXTNT 24820000 TM DCBDEVT,X'02' IS IT 2301 24840000 BC 1,ISLPA328 BRANCH IF 2301 24860000 * 2321 24880000 IC R8,DCBFIRSH+1 SET TRACK FROM FIRSH 24900000 BC 15,ISLPA329 BR TO SET STATUS BIT-3 24920000 * 2301 24940000 ISLPA328 EQU * 24960000 ST R8,ISLFXWK1 24980000 NI ISLFXWK1+3,X'F8' C(FXWK1+3)=XXXXX000 25000000 OC ISLFXWK1+3(1),DCBFIRSH+1 C(FXWK1+3)=XXXXXYYY FIRSH TRK 25020000 IC R8,ISLFXWK1+3 C(R8)=CCHH START OF DATA IN 25040000 * NEXT EXTENT 25060000 ISLPA329 EQU * 25080000 LR R6,R8 25100000 * SET STATUS BIT-3 ON - NEW EXTENT STARTS 25120000 * WITH THIS BUFFER 25140000 L R3,IOBPTRB C(R3)=PTR B=A(NEXT SLOT) OR-- 25160000 LA R3,0(R3) C(R3)=A(STATUS BITS) 25180000 OI 0(R3),X'10' TURN ON BIT 3 25200000 BC 15,ISLPA35 BR TO SET R FROM FIRSH 25220000 * 25240000 * SET REG 6 (REG B) TO CC +1 EOT, EOC, NOT EOE 25260000 * 25280000 ISLPA33 A R5,ISLONEF C(R5)=00CC+1, PREVIOUS CC +1 25300000 SLL R5,16 C(R5)=CC00 25320000 LR R6,R5 C(R6)=CC00, HH SET BELOW 25340000 * 25360000 * SET REG 6 (REG B) TO HH FROM FIRSH 25380000 * 25400000 ISLPA34 ST R6,ISLFXWK1 C(FXWK1)=CC00 25420000 MVC ISLFXWK1+2(2),DCBFIRSH C(FXWK1)=CCHH, HH FROM FIRSH 25440000 L R6,ISLFXWK1 C(R6)=CCHH 25460000 * 25480000 * SET REG 5 (REG A) TO R FROM FIRSH 25500000 * 25520000 ISLPA35 EQU * 25540000 SR R5,R5 25560000 IC R5,DCBFIRSH+2 C(R5)=000R, R FROM FIRSH 25580000 * 25600000 * PREFORMAT SHARED TRACK OF NEW CYLINDER IF NECESSARY 25620000 * 25640000 TM DCBOPTCD,X'08' TEST OPTCD BIT-4 FOR CYL OVFL 25660000 BC 1,ISLPA40 B IF ON = CYL OVFL 25680000 CLC DCBHIRSH(1),ISLZEROF TEST HIRSH VS 0 25700000 BE ISLPA50 B IF 0, NOT SHARED 25720000 * 25740000 * SHARED TRACKS - PREFORMAT 25760000 * 25780000 * INITIALIZE CP19 25800000 ***************** 25820000 * 25840000 ISLPA40 LA R2,ISLIOBC C(R2)=A(IOBC) 25860000 * 25880000 * BE SURE CP19 NOT IN USE 25900000 * 25920000 L R4,IOBECBAD C(R4)=A(ECB) 25940000 TM 0(R4),X'40' TEST ECB BIT 1 (C-BIT) 25960000 BC 1,ISLPA41 B IF 1, I/O COMPLETE-DONT WAIT 25980000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 26000000 LR R3,R1 SAVE R1 26020000 LR R1,R4 C(R1)=A(ECB) 26040000 LR R4,R0 SAVE R0 26060000 WAIT ECB=(1) WAIT 26080000 LR R0,R4 RESTORE R0 26100000 LR R1,R3 RESTORE R1 26120000 ISLPA41 STM R2,R11,ISLVRSAV+28 SAVE REGS 2-11 26140000 * 26160000 * 1. SET IOBC+32 TO NEW CC AND NEW M IF ANY 26180000 * 26200000 ST R6,ISLFXWK2 C(FXWK2)=CCHH FROM REG B 26220000 MVC 32(3,R2),DCBLPDA MOVE MBB FROM LPDA 26240000 MVC 35(3,R2),ISLFXWK2 MOVE CCH FROM REG B 22619 26260018 CLI DCBDEVT,X'02' TEST FOR 2301 26280000 BC 7,ISLPA41A ITS NOT, BRANCH 26300000 STC R6,ISLFXWK1 26320000 NI ISLFXWK1,X'F8' REDUCE TO CYL. BOUNDARY 26340000 NI 38(R2),X'07' REDUCE TO TRK BOUNDARY 26360000 OC 38(1,R2),ISLFXWK1 COMBINE 2301 CYL. & TRK 26380000 * HR IS SET UP BY CE APPENDAGE 26400000 * 26420000 * 2. SET CM27 TO NEW CC AND NEW M IF ANY 26440000 * 26460000 ISLPA41A EQU * 26480000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 26500000 L R10,16(R10) C(R10)=A(CP19) 26520000 USING CM1,R10 ADDRESSABILITY CP19 S20201 26530020 MVC CM27(L3),DCBLPDA MOVE MBB FROM LPDA S20201 26540020 MVC CM27+K3(L4),ISLFXWK2 MOVE CCHH FROM FXWK2 S20201 26550020 DROP R10 S20201 26560020 * 26580000 * 3. SET UP AREA Z WITH NEW CC 26600000 * 26620000 LA R9,ISLAREAZ C(R9)=A(AREA Z) 26640000 L R3,ISL10 C(R3)=10 = COUNT 26660000 LA R4,6(R9) C(R4)=A(Z+6) 26680000 ISLPA42 MVC 0(4,R4),ISLFXWK2 STORE CCHH IN Z 26700000 A R4,ISL8 STEP Z 26720000 BCT R3,ISLPA42 LOOP 26740000 * 26760000 * 26780000 * EXECUTE CP19 - PREFORMAT NEW CYLINDER 26800000 *************************************** 26820000 * 26840000 LM R2,R11,ISLVRSAV+28 RESTORE REGS 2-11 26860000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 26880000 LR R3,R0 SAVE R0 26900000 LR R4,R1 SAVE R1 26920000 EXCP IHAIOB EXECUTE CHANNEL PROGRAM 26940000 LR R0,R3 RESTORE R0 26960000 LR R1,R4 RESTORE R1 26980000 LA R2,ISLIOBA C(R2)=A(IOBA) 27000000 * 27020000 B ISLPA50 27040000 * 27060000 *---------------------------------------------------------------------- 27080000 * 27100000 EJECT 27120000 *********************************************************************** 27140000 * CHART PB - SET FBW * 27160000 *********************************************************************** 27180000 * 27200000 * 27220000 * C(R7)=A(LAST SLOT SCHED) AS IT WAS FROZEN BEFORE I/O 27240000 * SET REG 8 = NO OF BUFFRS NEEDED TO COMPLETE TRACK - REG C 27260000 * 27280000 ISLPB01 L R6,0(R7) C(R6)=A(LAST BUFF) 27300000 LA R6,0(R6) 27320000 SR R3,R3 27340000 SR R8,R8 27360000 IC R3,4(R6) C(R3)=LAST R 27380000 * 27400000 * TEST IF SHARED TRACKS ARE USED 27420000 * 27440000 IC R8,DCBHIRPD C(R8)=HIRPD 27460000 CLI DCBHIRSH,X'00' HIRSH VS 0 27480000 BE ISLPB02 B IF 0, NO SHARED TRACKS 27500000 * 27520000 * TEST IF CURRENT TRACK SHARED 27540000 * 27560000 ISLPB01A MVC ISLFXWK1(1),3(R6) H (TRK BYTE) FROM BUFFER CNT 27580000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 27600000 EX R0,ISLPA01B H OF FIRSH VS H OF BUFFER CNT 27620000 BE ISLPB03 B IF EQUAL, TRACK SHARED 27640000 * 27660000 * TEST IF LAST BUFF WAS EOC, IF SO- NEXT TRACK IS SHARED 27680000 * 27700000 TM 0(R7),X'04' TEST S BIT 5 VS 1 (C-BIT) 27720000 BC 1,ISLPB05 B IF 1, EOC 27740000 * 27760000 * 1. SHARED TRACKS- 27780000 * CURR TRACK NOT SHARED AND NOT EOC 27800000 * 2. SHARED TRACKS NOT USED- 27820000 * 27840000 ISLPB02 EQU * 27860000 TM 0(R7),X'08' TEST S BIT 4 VS 1 (T-BIT) 27880000 BC 1,ISLPB06 B IF 1, EOT 27900000 B ISLPB06A 27920000 * 27940000 * 3. SHARED TRACKS- 27960000 * CURR TRACK SHARED 27980000 * 28000000 ISLPB03 TM 0(R7),X'08' TEST S BIT 4 VS 1 (T-BIT) 28020000 BC 1,ISLPB06 B IF 1, EOT 28040000 IC R8,DCBHIRSH C(R8)=HIRSH 28060000 B ISLPB06A 28080000 * 28100000 * 4. SHARED TRACKS- 28120000 * CURR TRACK NOT SHARED, BUT EOC 28140000 * 28160000 ISLPB05 IC R8,DCBHIRSH C(R8)=HIRSH 28180000 IC R3,DCBFIRSH+2 C(R3)=FIRSH R 28200000 A R8,ISLONEF C(R8)=HIRSH-FIRSH R +1 28220000 * 28240000 ISLPB06A SR R8,R3 C(R8)=HIRSH-FIRSH R OR R+1 28260000 * REG C = HI R IF FULL TRACK TO BE WRITTEN 28280000 * REG C = HI R - R IF PARTIAL TRACK TO BE WRITTEN 28300000 * R = NO. OF BUFFERS WRITTEN SO FAR ON THIS TRACK 28320000 * 28340000 ISLPB06 ST R8,ISLFBW R8 = REG C, C(FBW)=C(REG C) 28360000 * 28380000 * TEST NEW FBW VS BUFNO AND ADJUST FBW IF NECESSARY 28400000 * 28420000 LA R4,1 C(R4)=1 28440000 CLC ISLFBW+3(1),ISLBUFNO TEST FBW VS BUFNO 28460000 BL ISLPB20 B IF FBW LOW 28480000 * 28500000 * FBW HI OR EQ - 28520000 * 28540000 CLC ISLBUFNO(1),ISLONEF+3 TEST BUFNO VS 1 28560000 BE ISLPB10 B IF BUFNO = 1 28580000 * 28600000 IC R4,ISLBUFNO BUFNO NOT 1, C(R4)=BUFNO 28620000 BCTR R4,0 C(R4)-BUFNO-1 P4701 28640000 * 28660000 * BUFNO=1 28680000 ISLPB10 EQU * 28700000 ST R4,ISLFBW C(FBW)=1 28720000 * 28740000 ISLPB20 B ISLFY41 *EXIT 28760000 EJECT 28780000 *********************************************************************** 28800000 * CHART F8 - INITIALIZE CP18 FOR CURRENT BUFFER SET * 28820000 *********************************************************************** 28840000 * 28860000 * 28880000 * SET OFFST AND D ACCORDING TO RECFM (IOBA FLAGS BIT 7) 28900000 * 28920000 ISLF801 L R10,DCBWKPT6 C(R10)=A(VPTRS) 28940000 * 29080000 * CALC FSTBF = # OF SLOTS SLOT X IS FROM SLOT #1 IN BUF CTRL TABLE 29100000 * 29120000 ISLF803 L R3,IOBPTRA C(R3)=C(PTR A)=A(SLOT X) 29140000 LA R3,0(R3) 29160000 LA R4,IOBS C(R4)=A(SLOT #1) 29180000 SR R3,R4 C(R3)= # OF BYTES X IS FROM #1 29200000 SRA R3,2 DIV BY 4, C(R3)= DIFF IN SLOTS 29220000 ST R3,ISLFSTBF C(FSTBF)= # OF SLOTS FROM #1 29240000 * THAT FIRST BUF SCHED IS 29260000 * 29280000 * CALC ADDR OF WR CKD X (SCHED TO WR FIRST) FOR TIC IN CP18 29300000 * 29320000 L R5,ISLOFFST C(R4+R5)=OFFST 29340000 MR R4,R3 FSTBF X OFFST, C(R5)= THE # OF 29360000 * BYTES WR CKD X IS FROM THE 29380000 * FIRST BYTE OF WR CKD #1 29400000 L R10,12(R10) C(R10)=A(CP18) 29420000 LA R4,24(R10) C(R4)=A(WR CKD #1) 29440000 AR R4,R5 C(R4)=A(WR CKD X) 29460000 IC R6,16(R10) C(R6)=TIC OP CODE AT CP18+16 29480000 ST R4,16(R10) C(CP18+16)=A(WR CKD X),4 BYTES 29500000 STC R6,16(R10) C(CP18+16)=TIC OP CODE,1 BYTE 29520000 * 29540000 * LOCATE CC FLAG IN LAST WR CKD THAT WAS EXECUTED (WR CKD X -1) AND 29560000 * TURN CC FLAG ON (CP18) 29580000 * 29600000 LTR R3,R3 FSTBF VS 0 29620000 BC 7,ISLF805 B IF NOT ZERO 29640000 IC R3,ISLBUFNO C(R3)=NO OF BUFFERS 29660000 ISLF805 EQU * 29680000 BCTR R3,0 C(R3)=BUF N-1 29700000 L R5,ISLOFFST C(R4+R5)=OFFST 29720000 MR R4,R3 PREV LAST BUF X OFFST, C(R5)= 29740000 * THE # OF BYTES LAST WR CKD 29760000 * EXECUTED IS FROM THE FIRST 29780000 * BYTE OF WR CKD #1 29800000 A R5,ISLD C(R5)=# OF BYTES TO CC FLAG 29820000 AR R5,R10 C(R5)=A(CC FLAG OF LAST WR CKD) 29840000 * IN CP18 THAT WAS EXECUTED 29860000 OI 0(R5),X'40' TURN ON CC BIT 29880000 * 29900000 * CALC LSTBF = FBW SLOTS FROM FSTBF -1, MAY WRAPAROUND 29920000 * 29940000 L R3,ISLFSTBF C(R3)=# OF SLOTS FROM SLOT #1 29960000 A R3,ISLFBW C(R3)= FSTBF + FBW 29980000 BCTR R3,0 C(R3)=FSTBF + FBW-1 = LSTBF 30000000 SR R4,R4 C(R4)= 0000 30020000 IC R4,ISLBUFNO C(R4)=NO OF BUFFRS 30040000 CR R3,R4 LSTBF VS BUFNO, TEST WRAPAROUND 30060000 BL ISLF806 B IF NO WRAPAROUND, LSTBF OK 30080000 SR R3,R4 C(R3)=LSTBF-BUFNO = LSTBF 30100000 * LSTBF SET FOR WRAPAROUND 30120000 ISLF806 ST R3,ISLLSTBF C(LSTBF)= # OF SLOTS FROM #1 30140000 * THAT LAST BUF SCHED IS 30160000 * 30180000 * LOCATE CC FLAG IN LAST WR CKD TO BE EXECUTED(WR CKD X + FBW) AND 30200000 * TURN CC FLAG OFF (CP18) 30220000 * 30240000 L R5,ISLOFFST C(R4+R5)=OFFST 30260000 MR R4,R3 LSTBF X OFFST, C(R5)= THE # OF 30280000 * BYTES LAST WR CKD TO BE 30300000 * EXECUTED IS FROM THE FIRST 30320000 * BYTE OF WR CKD #1 30340000 A R5,ISLD C(R5)=# OF BYTES TO CC FLAG 30360000 AR R5,R10 C(R5)=A(CC FLAG OF LAST WR CKD) 30380000 * IN CP18 TO BE EXECUTED 30400000 NI 0(R5),X'BF' TURN OFF CC BIT 30420000 ST R5,ISLCCFAD C(CCFAD)=A(CC FLAG OF LAST WR) 30440000 EJECT 30460000 *********************************************************************** 30480000 * CHART F9 - INITIALIZE CP20 FOR CURRENT TRACK * 30500000 *********************************************************************** 30520000 * 30540000 USING ISLY,R9 30560000 * 30580000 * F9 HOUSEKEEPING 30600000 * 30620000 ISLF901 L R6,IOBPTRA C(R6)=C(PTR A)=A(SLOT X) 30640000 L R6,0(R6) C(R6)=C(SLOT X)=A(1ST BUF) 30660000 LA R6,0(R6) 30680000 MVC ISLFXWK1(4),1(R6) C(FXWK1)=CHHR OF CNT IN 1ST BUF 30700000 L R7,ISLFXWK1 C(R7)=CHHR 30720000 BCTR R7,0 C(R7)=CCHR-1 30740000 * 30760000 * TEST LAST BUFFER FOR END OF TRACK (T-BIT ON) 30780000 * 30800000 L R3,ISLLSTBF C(R3)=LSTBF 30820000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 30840000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT) 30860000 TM 0(R3),X'08' TEST S BIT 4 VS 1 (T-BIT) 30880000 BC 1,ISLF902 B IF T-BIT ON 30900000 * 30920000 * T-BIT OFF, NO CP20 YET 30940000 * 30960000 * SET IOBA+32 (IOBDADAD) = COUNT OF 1ST BUF SCHED, R=R-1 FOR SRCH ID 30980000 * 31000000 MVC IOBDADAD+3(1),0(R6) C(IOBA+35)=C FROM 1ST BUF 31020000 ST R7,IOBDADAD+4 C(IOBA+35)=CCHHR WITH R=R-1 31040000 IC R4,IOBCPSAD SAVE SIOCC 31060000 ST R10,IOBCPSAD C(CPSAD)=CP18 START ADR 31080000 STC R4,IOBCPSAD RESTORE SIOCC 31100000 * 31120000 * SET CL1 IN CP18 TO REFERENCE IOBA+35 31140000 * 31160000 LA R3,IOBDADAD+3 C(R3)=A(IOBA+35) 31180000 IC R4,0(R10) SAVE OP 31200000 ST R3,0(R10) STORE A(IOBA+35) 31220000 STC R4,0(R10) RESTORE OP 31240000 * 31260000 B ISLG260 31280000 * 31300000 * T-BIT ON, INITL CP20 31320000 * CLEAR TWO SW 31340000 * 31360000 ISLF902 NI IOBFLAGS,X'FB' SET FLAGS BIT 5 = 0 (TWOSW OFF) 31380000 OI ISLIXLT,X'08' SET IXLT LEV1 BIT-4 ON- TRK IX 31400000 * 31420000 * GET KEY ADR FROM CP18 ACCORDING TO RECFM (IOBA FLAGS BIT 7) 31440000 * 31460000 TM IOBFLAGS,X'01' TEST FLAGS BIT 7 (1=F,RKP 0) 31480000 BC 1,ISLF903 B IF RECFM IS F,RKP 0 31500000 * RECFM NOT F,RKP 0 31520000 L R3,ISLCCFAD C(R3)=CC FLAG ADR LAST WR CKD 31540000 S R3,ISL12 C(R3)=A(CCW WORD 1 OF WR K) 31560000 L R3,0(R3) C(R3)=C(CCW WORD 1 OF WR K) 31580000 LA R3,0(R3) C(R3)=A(KEY OF LAST WR CKD) 31600000 B ISLF904 31620000 * RECFM IS F,RKP 0 31640000 ISLF903 L R3,ISLCCFAD C(R3)=CC FLAG ADR LAST WR CKD 31660000 S R3,ISL4 C(R3)=A(CCW WORD 1 OF WR CKD) 31680000 L R3,0(R3) C(R3)=C(CCW WORD 1 OF WR CKD) 31700000 LA R3,0(R3) C(R3)=A(COUNT OF LAST WR CKD) 31720000 A R3,ISL8 C(R3)=A(KEY OF LAST WR CKD) 31740000 * 31760000 ISLF904 ST R3,ISLKEYAD C(KEYAD)=A(KEY OF LAST WR CKD) 31780000 * 31800000 * SET CP20 LINE CQ14A = CCHHR FROM COUNT OF 1ST BUF SCHED, R=R-1 31820000 * MBB FROM IOBA+32 (IOBDADAD) 31840000 * 31860000 LR R5,R10 C(R5)=A(CP18,CL1) 31880000 * 31900000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 31920000 L R10,20(R10) C(R10)=A(CP20) 31940000 USING CQ1,R10 ADDRESSABILITY ON CP20 S20201 31950020 MVC 112(3,R10),IOBDADAD C(CQ14A)=MBB FROM IOBA+32 31960000 MVC 115(1,R10),0(R6) C(CQ14A)=C FROM 1ST BUF 31980000 ST R7,116(R10) C(CQ14A)=MBBCCHHR WITH R=R-1 32000000 * 32020000 * SET CL1 IN CP18 TO REFERENCE CQ14A+3 32040000 * 32060000 LA R3,115(R10) C(R3)=A(CQ14A+3) 32080000 IC R4,0(R5) SAVE OP 32100000 ST R3,0(R5) STORE A(CQ14A+3) 32120000 STC R4,0(R5) RESTORE OP 32140000 * 32160000 * TEST COUNT OF 1ST BUFFR SCHED, HH VS FIRSH HH, FOR NEW CYLINDER 32180000 * 32200000 EX R0,ISLPB01A H FROM COUNT 32220000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 32240000 EX R0,ISLPA01B COUNT VS FIRSH 32260000 BE ISLF909 B IF EQUAL, NEW CYLINDER 32280000 * 32300000 * TEST IF LAST IX ENTRY IS ON A SHARED TRACK 32320000 * 32340000 CLI DCBHIRSH,X'00' HIRSH VS 0 32360000 BE ISLF905 B IF 0, NOT SHARED 32380000 ISLF904A MVC ISLFXWK1(1),ISLOCNT+3 H FROM OVFLO COUNT 32400000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 32420000 EX R0,ISLPA01B OVFLO CNT VS FIRSH 32440000 BNE ISLF905 B IF NOT EQUAL, NOT SHARED 32460000 * SHARED TRACK 32480000 * 32500000 * CALC - NO ENTRIES REMAINING = (FIRSH-1) - LAST IX ENTRY, R-R 32520000 * 32540000 MVC ISLF9WK1+3(1),DCBFIRSH+2 32560000 L R3,ISLF9WK1 C(R3)=000R FROM FIRSH 32580000 BCTR R3,0 C(R3)=000R-1 FROM FIRSH 32600000 * =R OF LAST IX ENTRY ON TRACK 32620000 B ISLF906A 32640000 * NOT A SHARED TRACK 32660000 * 32680000 * CALC - NO ENTRIES REMAINING = HIRT - LAST IX ENTRY, R-R 32700000 * 32720000 ISLF905 MVC ISLF9WK1+3(1),ISLHIRT 32740000 L R3,ISLF9WK1 C(R3)=000R FROM HIRT 32760000 ISLF906A EQU * 32780000 * = R OF LAST IX ENTRY ON TRACK 32800000 MVC ISLF9WK1+3(1),ISLOCNT+4 32820000 * = R OF LAST IX ENTRY 32840000 S R3,ISLF9WK1 C(R3)=HIRT-OCNT 32860000 ST R3,ISLNOENT C(NOENT)=HIRT-OCNT 32880000 * 32900000 * TEST NO ENTRIES 32920000 * 32940000 ISLF906 EQU * 32960000 LTR R3,R3 TEST NOENT VS 0 32980000 BC 8,ISLF908 B IF ZERO - END OF IX TRACK 33000000 C R3,ISLTWOF TEST NOENT VS 2 33020000 BL ISLG101 BR LOW - NOENT=1 33040000 BNE ISLF907 B NOT 2, ROOM FOR MORE THAN 2 33060000 * 33080000 * NO ENTRIES = 2, SET TWO SW ON 33100000 * 33120000 OI IOBFLAGS,X'04' SET FLAGS BIT 5 = 1 (TWOSW ON) 33140000 * 33160000 * NO ENTRIES = 2 OR MORE, BUMP R IN NORMAL AND OVERFLOW COUNTS 33180000 * 33200000 ISLF907 SR R3,R3 33220000 IC R3,ISLOCNT+4 C(R3)=R FROM OCNT 33240000 LA R3,1(R3) C(R3)=R+1 33260000 STC R3,ISLNCNT+4 C(NCNT)=CCHHR, R=R+1 33280000 LA R3,1(R3) C(R3)=R+2 33300000 STC R3,ISLOCNT+4 C(OCNT)=CCHHR, R=R+2 33320000 MVC ISLNCNT+2(2),ISLOCNT+2 C(NCNT)=CCHHR, HH FROM OCNT 33340000 B ISLG201 33360000 * 33380000 * NO ENTRIES = 0, BUMP HH IN NORMAL AND OVERFLOW COUNTS AND SET R = 1 33400000 * 33420000 ISLF908 L R3,ISLNCNT C(R3)=CCHH FROM NCNT 33440000 A R3,ISLONEF C(R3)=CCHH+1 33460000 ST R3,ISLNCNT C(NCNT)=CCHH+1 33480000 B ISLF9095 33500000 * 33520000 * NEW CYLINDER, NORMAL AND OVERFLOW COUNTS RESET USING 1ST BUFFR SCHED 33540000 * 33560000 ISLF909 EQU * 33580000 MVC ISLNCNT(4),0(R6) C(NCNT)=CCHH FROM 1ST BFR 33600000 * SET TRACK = 0 33620000 CLI DCBDEVT,X'02' IS IT 2301 33640000 BC 8,ISLF9091 BR IF EQUAL - 2301 33660000 CLI DCBDEVT,X'05' IS IT 2321 33680000 BC 8,ISLF9093 BR EQUAL - 2321 33700000 * 33720000 MVC ISLNCNT+2(2),ISLZEROF C(NCNT)=CCHH WITH HH=00 33740000 ISLF9095 EQU * 33760000 MVI ISLNCNT+4,X'01' C(NCNT)=CCHHR WITH R=1 33780000 MVC ISLOCNT(4),ISLNCNT C(OCNT)=CCHH FROM NCNT 33800000 MVI ISLOCNT+4,X'02' C(OCNT)=CCHHR WITH R=2 33820000 B ISLG201 33840000 * 33860000 ISLF9091 EQU * 2301 33880000 NI ISLNCNT+3,X'F8' SET TRACK = 0 33900000 B ISLF9095 BR TO PICK UP R, ETC. 33920000 * 33940000 ISLF9093 EQU * 2321 33960000 MVI ISLNCNT+3,X'00' SET TRACK = 0 33980000 B ISLF9095 BR TO PICK UP R, ETC. 34000000 EJECT 34020000 * * 34040000 * CHART G1 - CONTINUATION OF CHART F9, INDEX ENTRIES SPLIT * 34060000 *********************************************************************** 34080000 * 34100000 * NO ENTRIES = 1, BUMP R IN NORMAL COUNT AND HH IN OVERFLOW COUNT 34120000 * SET R = 1 IN OVERFLOW COUNT 34140000 * 34160000 ISLG101 IC R3,ISLNCNT+4 C(R3)-R FROM NCNT P4701 34180000 LA R3,2(0,R3) R=R+2 P4701 34200000 STC R3,ISLNCNT+4 C(NCNT)=CCHHR, R=R+2 34240000 L R3,ISLOCNT C(R3)=CCHH FROM OCNT 34260000 A R3,ISLONEF C(R3)=CCHH+1 34280000 ST R3,ISLOCNT C(OCNT)=CCHH+1 34300000 MVI ISLOCNT+4,X'01' C(OCNT)=CCHHR, R=1 34320000 * 34340000 * SET IOBA+35 (IOBDADAD) = NORMAL CCHHR, R=R-1 FOR SRCH ID 34360000 * 34380000 MVC IOBDADAD+3(5),ISLNCNT C(IOBA+35)=CCHHR FROM NCNT 34400000 L R3,IOBDADAD+4 C(R3)=CHHR 34420000 BCTR R3,0 C(R3)=CHHR-1 34440000 ST R3,IOBDADAD+4 C(DADAD)=MBBCCHHR WITH R=R-1 34460000 * 34480000 * TEST IF OVFLO HH IS ON A SHARED TRACK (IS IT FORMATTED) 34500000 * 34520000 CLI DCBHIRSH,X'00' HIRSH VS 0 34540000 BE ISLG102 BR IF 0, NOT SHARED 34560000 EX R0,ISLF904A C(FXWK1)=H FROM OVFLO CNT 34580000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 34600000 EX R0,ISLPA01B H OF FIRSH VS C(FXWK1) H OFL CT 34620000 BNE ISLG102 B IF NOT EQUAL, NOT SHARED 34640000 * SHARED TRACK 34660000 * 34680000 * INITL CP20 FOR SHARED TRACK (FORMATTED TRACK) 34700000 * 34720000 LA R3,CQ15 C(R3)=A(CQ15) S20201 34740020 IC R4,IOBCPSAD SAVE SIOCC 34760000 ST R3,IOBCPSAD C(CPSAD)=CP20 START ADR, CQ15 34780000 STC R4,IOBCPSAD RESTORE SIOCC 34800000 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 34820000 IC R4,48(R10) SAVE OP AT CQ7 34840000 ST R3,48(R10) STORE KEY ADR AT CQ7 34860000 STC R4,48(R10) RESTORE OP 34880000 IC R4,CQ18 SAVE OP AT CQ18 S20201 34900020 ST R3,CQ18 STORE KEY ADR AT CQ18 S20201 34920020 STC R4,CQ18 RESTORE OP S20201 34940020 LA R3,32(R10) C(R3)=A(CQ5) 34960000 IC R4,CQ20 SAVE OP AT CQ20 S20201 34980020 ST R3,CQ20 STORE A(CQ5) AT CQ20 S20201 35000020 STC R4,CQ20 RESTORE OP S20201 35020020 B ISLG202 35040000 *---------------------------------------------------------------------- 35060000 * 35080000 * NOT A SHARED TRACK 35100000 * 35120000 * INITL CP20 FOR UNSHARED TRACK (NON-FORMATTED TRACK) 35140000 * 35160000 ISLG102 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 35180000 IC R4,CQ18 SAVE OP AT CQ18 S20201 35200020 ST R3,CQ18 STORE KEY ADR AT CQ18 S20201 35220020 STC R4,CQ18 RESTORE OP S20201 35240020 IC R4,CQ22 SAVE OP AT CQ22 S20201 35260020 ST R3,CQ22 STORE KEY ADR AT CQ22 S20201 35280020 STC R4,CQ22 RESTORE OP S20201 35300020 * 35320000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 35340000 * 35360000 L R3,ISLLSTBF C(R3)=LSTBF 35380000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 35400000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT 35420000 TM 0(R3),X'04' TEST S BIT 5 VS 1 (C-BIT) 35440000 BC 1,ISLG103 B IF C-BIT ON 35460000 * 35480000 * C-BIT OFF 35500000 LA R3,96(R10) C(R3)=A(CQ13) 35520000 ISLG104 IC R4,CQ24 SAVE OP A CQ24 S20201 35540020 ST R3,CQ24 STORE A(CQ13) AT CQ24 S20201 35560020 STC R4,CQ24 RESTORE OP S20201 35580020 LA R3,CQ27 C(R3)=A(CQ27) S20201 35600020 IC R4,CQ20 SAVE OP AT CQ20 S20201 35620020 ST R3,CQ20 STORE A(CQ27) AT CQ20 S20201 35640020 STC R4,CQ20 RESTORE OP S20201 35660020 LA R3,CQ21 C(R3)=A(CQ21) S20201 35680020 IC R4,CQ29 SAVE OP AT CQ29 S20201 35700020 ST R3,CQ29 STORE A(CQ21) AT CQ29 S20201 35720020 STC R4,CQ29 RESTORE OP S20201 35740020 B ISLG221 35760000 *---------------------------------------------------------------------- 35780000 * 35800000 * 35820000 * C-BIT ON 35840000 ISLG103 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 35860000 SR R3,R3 35880000 IC R3,ISLDCNT+4 C(R3)=R FROM DCNT 35900000 LA R3,1(R3) C(R3)=R+1 35920000 STC R3,ISLDCNT+4 C(DCNT)=CCHHR, R=R+1 35940000 LA R3,CQ25 C(R3)=A(CQ25) S20201 35960020 B ISLG104 35980000 EJECT 36000000 * * 36020000 * CHART G2 - CONTINUATION OF CHARTS F9 AND G1 * 36040000 *********************************************************************** 36060000 * 36080000 * TEST IF OVFLO HH IS ON A SHARED TRACK (IS IT FORMATTED) 36100000 * 36120000 ISLG201 EQU * 36140000 CLI DCBHIRSH,X'00' HIRSH VS 0 36160000 BE ISLG210 BR IF 0, NOT SHARED 36180000 EX R0,ISLF904A C(FXWK1)=H FROM OVFLO CNT 36200000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 36220000 EX R0,ISLPA01B H OF FIRSH VS H OF OVFLO CNT 36240000 BNE ISLG210 B IF NOT EQUAL, NOT SHARED 36260000 * SHARED TRACK 36280000 * 36300000 * INITL CP20 FOR SHARED TRACK (FORMATTED TRACK) AND SET IOBA+35 36320000 * 36340000 IC R4,IOBCPSAD SAVE SIOCC 36360000 ST R10,IOBCPSAD C(CPSAD)=CP20 START ADR, CQ1 36380000 STC R4,IOBCPSAD RESTORE SIOCC 36400000 * SET IOBA+35 = NORMAL CCHHR 36420000 MVC IOBDADAD+3(5),ISLNCNT C(IOBA+35)=CCHHR FROM NCNT 36440000 * 36460000 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 36480000 IC R4,16(R10) SAVE OP AT CQ3 36500000 ST R3,16(R10) STORE KEY ADR AT CQ3 36520000 STC R4,16(R10) RESTORE OP 36540000 IC R4,48(R10) SAVE OP AT CQ7 36560000 ST R3,48(R10) STORE KEY ADR AT CQ7 36580000 STC R4,48(R10) RESTORE OP 36600000 * 36620000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 36640000 * 36660000 ISLG202 L R3,ISLLSTBF C(R3)=LSTBF 36680000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 36700000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT) 36720000 TM 0(R3),X'04' TEST S BIT 5 VS 1 (C-BIT) 36740000 BC 1,ISLG203 B IF C BIT ON 36760000 * 36780000 * C-BIT OFF 36800000 LA R3,96(R10) C(R3)=A(CQ13) 36820000 B ISLG203A 36840000 * 36860000 * C-BIT ON 36880000 ISLG203 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 36900000 IC R3,ISLDCNT+4 C(R3)=R FROM DCNT 36940000 LA R3,1(0,R3) C(R3)-R+1 P4701 36960000 STC R3,ISLDCNT+4 C(DCNT)=CCHHR, R=R+1 36980000 LA R3,72(R10) C(R3)=A(CQ10) 37000000 ISLG203A EQU * 37020000 IC R4,64(R10) SAVE OP A CQ9 37040000 ST R3,64(R10) STORE C(R3) AT CQ9 37060000 STC R4,64(R10) RESTORE OP 37080000 B ISLG250 37100000 * 37120000 * NOT A SHARED TRACK 37140000 * 37160000 * INITL CP20 FOR UNSHARED TRACK (NON FORMATTED) AND SET IOBA+35 37180000 * 37200000 * SET IOBA+35 = NORMAL CCHHR-1 37220000 ISLG210 MVC IOBDADAD+3(5),ISLNCNT C(IOBA+35)=CCHHR FROM NCNT 37240000 L R3,IOBDADAD+4 C(R3)=CHHR 37260000 BCTR R3,0 C(R3)=CHHR-1 37280000 ST R3,IOBDADAD+4 C(DADAD)=MBBCCHHR WITH R=R-1 37300000 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 37320000 IC R4,144(R10) SAVE OP AT CQ18 37340000 ST R3,CQ18 STORE KEY ADR AT CQ18 S20201 37360020 STC R4,CQ18 RESTORE OP S20201 37380020 IC R4,CQ22 SAVE OP AT CQ22 S20201 37400020 ST R3,CQ22 STORE KEY ADR AT CQ22 S20201 37420020 STC R4,CQ22 RESTORE OP S20201 37440020 * 37460000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 37480000 * 37500000 L R3,ISLLSTBF C(R3)=LSTBF 37520000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 37540000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT) 37560000 TM 0(R3),X'04' TEST S BIT 5 VS 1 (C-BIT) 37580000 BC 1,ISLG211 B IF C BIT ON 37600000 * 37620000 * C-BIT OFF 37640000 LA R3,CQ13 C(R3)=A(CQ13) S20201 37660020 IC R4,CQ24 SAVE OP AT CQ24 S20201 37680020 ST R3,CQ24 STORE A(CQ13) AT CQ24 S20201 37700020 STC R4,CQ24 RESTORE OP S20201 37720020 ISLG220 LA R3,CQ21 C(R3)=A(CQ21) S20201 37740020 IC R4,CQ20 SAVE OP AT CQ20 S20201 37760020 ST R3,CQ20 STORE A(CQ21) AT CQ20 S20201 37780020 STC R4,CQ20 RESTORE OP S20201 37800020 * 37820000 ISLG221 LA R3,CQ15 C(R3)=A(CQ15) S20201 37840020 IC R4,IOBCPSAD SAVE SIOCC 37860000 ST R3,IOBCPSAD C(CPSAD)=CP20 START ADR, CQ15 37880000 STC R4,IOBCPSAD RESTORE SIOCC 37900000 MVC CQ30,IOBDADAD C(CQ30)=MBBCCHH FROM S20201 37910020 * IOBA+32 S20201 37920020 MVI CQ30+K7,K0 C(CQ30)=MBBCCHHR, R=0 S20201 37940020 L R3,CQ30+K4 C(R3)=CHHR S20201 37960020 A R3,ISLTENF C(R3)=CHHR, HH=HH+1 37980000 ST R3,CQ30+K4 C(CQ30)=MBBCCHHR, HH+1, S20201 37990020 * R=0 S20201 38000020 * 38020000 * SET NORMAL DATA = COUNT FROM 1ST BUF SCHED (BOTH SHARED AND UNSHARED) 38040000 * 38060000 ISLG250 MVC ISLNDAT(3),IOBDADAD C(NDAT)=MBB FROM IOBA+32 38080000 MVC ISLNDAT+3(4),0(R6) C(NDAT)=CCHH FROM 1ST BUF 38100000 MVC ISLODAT(7),ISLNDAT C(ODAT)=MBBCCHH FROM NDAT 38120000 MVC ISLNDAT+7(2),ISLZEROF NORMAL DATA F=00 (SHARED) 38140000 * R=00 38160000 * 38180000 CLI DCBHIRSH,X'00' HIRSH VS 0 38200000 BE ISLG252 BR IF 0, NOT SHARED 38220000 MVC ISLFXWK1(1),ISLNDAT+6 C(FXWK1)=H OF NORMAL DATA ENTRY 38240000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 38260000 EX R0,ISLPA01B H OF FIRSH VS C(FXWK1) 38280000 BNE ISLG252 38300000 * 38320000 MVI ISLNDAT+8,X'08' NORMAL DATA F = 08 (SHARED) 38340000 MVC ISLNDAT+7(1),DCBFIRSH+2 NORMAL DATA R = FIRSH R 38360000 * 38380000 * SET UP AREA Y 38400000 * 38420000 ISLG252 L R10,DCBWKPT6 C(R10)=A(VPTRS) 38440000 L R9,0(R10) C(R9)=A(Y) 38460000 MVC ISLY+18(8),ISLNCNT C(Y+18)=NORM COUNT 38480000 MVC ISLY+26(10),ISLNDAT C(Y+26)=NORM DATA 38500000 MVC ISLY+36(8),ISLOCNT C(Y+36)=OVFL COUNT 38520000 MVC ISLY+44(10),ISLODAT C(Y+44)=OVFL DATA 38540000 MVC ISLY+54(8),ISLDCNT C(Y+54)=DUMM COUNT 38560000 * 38580000 * END OF EXPANSION 38600000 * 38620000 ISLG260 B ISLFY21 RETURN TO FY 38640000 *---------------------------------------------------------------------- 38660000 * 38680000 * 38700000 * C-BIT ON 38720000 * 38740000 * TEST TWO SW, IS THERE ROOM FOR JUST 2 MORE ENTRIES AT END OF CYLINDER 38760000 * 38780000 ISLG211 TM IOBFLAGS,X'04' TEST FLAGS BIT 5 VS 1 (TWOSW) 38800000 BC 1,ISLG212 B IF ON 38820000 * 38840000 * TWOSW OFF 38860000 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 38880000 SR R3,R3 38900000 IC R3,ISLDCNT+4 C(R3)=R FROM DCNT 38920000 LA R3,1(R3) C(R3)=R+1 38940000 STC R3,ISLDCNT+4 C(DCNT)=CCHHR, R=R+1 38960000 LA R3,CQ25 C(R3)=A(CQ25) S20201 38980020 B ISLG213A 39000000 * 39020000 * TWOSW ON 39040000 ISLG212 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 39060000 L R3,ISLDCNT C(R3)=CCHH FROM DCNT 39080000 A R3,ISLONEF C(R3)=CCHH+1 39100000 ST R3,ISLDCNT C(DCNT)=CCHH+1 39120000 MVI ISLDCNT+4,X'01' C(DCNT)=CCHHR, R=1 39140000 * 39160000 * TEST IF DUMMY HH IS A SHARED TRACK (FORMATTED) 39180000 * 39200000 CLI DCBHIRSH,X'00' HIRSH VS 0 39220000 BE ISLG213 B IF 0, NOT SHARED 39240000 MVC ISLFXWK1(1),ISLDCNT+3 C(FXWK1)=H FROM DUMMY COUNT 39260000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 39280000 EX R0,ISLPA01B FIRSH VS C(FXWK1) 39300000 BNE ISLG213 B IF NOT EQUAL, NOT SHARED 39320000 * 39340000 * SHARED TRACK (FORMATTED) 39360000 LA R3,72(R10) C(R3)=A(CQ10) 39380000 B ISLG213A 39400000 * 39420000 * NOT A SHARED TRACK 39440000 ISLG213 LA R3,CQ25 C(R3)=A(CQ25) S20201 39460020 IC R4,CQ29 SAVE OP A CQ29 S20201 39480020 ST R3,CQ29 STORE C(R3) AT CQ29 S20201 39500020 STC R4,CQ29 RESTORE OP S20201 39520020 * 39540000 LA R3,CQ27 C(R3)=A(CQ27) S20201 39560020 ISLG213A EQU * 39580000 IC R4,CQ24 HAVE OP A CQ24 S20201 39600020 ST R3,CQ24 STORE C(R3) AT CQ24 S20201 39620020 STC R4,CQ24 RESTORE OP S20201 39640020 B ISLG220 39660000 * 39680000 EJECT 39700000 * 39720000 * F8 CONSTANTS 39740000 * 39760000 ISL8 DC F'0008' 39780000 ISL10 DC F'0010' 39800000 ISL24 DC F'0024' 39820000 CONSF8 DC F'248' 39840000 ISL28 DC F'0028' 39860000 ISL44 DC F'0044' 39880000 ISL255 DC F'0255' 39900000 ISLABEND DC X'80031000' ABEND CODE - NO SYNAD P4701 39910000 * 39920000 * F9 CONSTANTS 39940000 * 39960000 ISL4 DC F'0004' 39980000 ISL12 DC F'0012' 40000000 ISLZEROF DC F'0000' 40020000 ISLONEF DC F'0001' 40040000 ISLTWOF DC F'0002' 40060000 ISLTENF DC X'00000100' 40080000 * 40100000 * FX CONSTANTS 40120000 * 40140000 ISLFX02A CLC 0(1,R4),0(R5) KEY COMP TO BE EXECUTED (L) 40160000 ISLFX06A MVC 0(1,R5),0(R4) MOVE KEY TO BE EXECUTED (L) 40180000 ISLFX08A CLC 0(1,R5),0(R4) KEY COMP TO BE EXECUTED (M) 40200000 ISLFX21A MVC 0(1,R4),0(R5) MOVE RCD TO BE EXECUTED (M) 40220000 * 40240000 * 40280000 EJECT 40300000 END 40320000 ./ ADD SSI=21790419,NAME=IGG019GB,SOURCE=0 COPY LCGASMSW 00010000 TITLE 'IGG019GB - PUT, WR CHK' 00020000 IGG019GB CSECT 00028000 * RELEASE 16 DELETIONS * 00036000 *1671289400-289600,290200-290400,295200-298600,301600-302200, 13334 00036616 *1671304200,312600,314000-317600,322400,409600-410200,411400 13334 00037216 *1671157800-158800,163000,178400,178800-179200 13165 00038016 *1671 13711 00040016 *1671061000-061200 14251 00042016 *1671135400 16305 00043016 * RELEASE 17 DELETIONS * 00044000 *1650001100,082400,102000-102400,115600-116000,286200, P4701 00046000 *1650342800-343200,376200,376600,414000 P4701 00048000 *1650215400-215800 17925 00050000 *1650 7M402 00051000 *1650063400,063800,069600,411600 20852 00051500 *1650175400,175800 7M568 00051700 * RELEASE 18 DELETIONS * 00052000 *0381320000-321000,370600-371400 21826 00056018 *0381262400 22619 00058018 *0381036600-038040,064200-064600 25463 00058518 *0381097000-097200,176800-177400,193800-194000,256800,410400 8M800 00059018 * RELEASE 19 DELETIONS * 00060000 *2182215000 A27810 00064019 * RELEASE 20 DELETIONS * 00068000 *0751357400,363400,374800,378600,386700,398100 M5864 00068320 *0751344300,357200-358200,363200-363600,371000,374600-375400, A37537 00068620 *0751378000-379200,382900,386200-387200,397600-398600 A37537 00069220 *0751062860-062880,066200-066600,082260-082440 A32496 00070020 *0751062840,063400-063600 A31998 00072020 *0751069600-069700 M1857 00074020 * S20201 00084020 *1202289500-290300 M0170 00086021 *1202106400-106600 A42181 00089021 *1202282400 A41405 00094021 *1202147500 A46109 00099021 *D062920 XM6075 00101000 * STATUS CHANGE LEVEL 009 00104021 *FUNCTION/OPERATION- THIS MODULE CONTAINS THE BASIC LOAD MODE PUT * 00120000 * ROUTINES. THESE ROUTINES INVOLVE RECORD PROCESSING FOR MOVE MODE * 00140000 * AND FOR LOCATE MODE, BUFFER MANAGEMENT, CHANNEL PROGRAM INITIAL- * 00160000 * IZATION, AND CHANNEL PROGRAM EXECUTION. * 00180000 * * 00200000 *ENTRY POINTS- 'IGG019GB' (ISLFX01) IS THE ENTRY FOR A LOAD MODE PUT * 00220000 * MACRO INSTRUCTION. THE GENERATED CALLING SEQUENCE IS, * 00240000 * LA 1,DCB * 00260000 * LA 0,RECORD FOR MOVE MODE * 00280000 * L 15,48(0,1) * 00300000 * BALR 14,15 * 00320000 * * 00340000 *INPUT- REGISTER 0 -POINTS TO USERS RECORD IN WORK AREA (MOVE MODE). * 00360000 * REGISTER 1 -POINTS TO DCB. * 00380000 * REGISTER 13 -POINTS TO USER SAVE AREA. * 00400000 * REGISTER 14 -POINTS TO RETURN FROM PUT * 00420000 * * 00440000 *OUTPUT- REGISTER 1 -POINTS TO NEXT AVAILABLE SPACE IN OUTPUT BUFFER * 00460000 * (LOCATE MODE). * 00480000 * REGISTER 1 -POINTS TO BAD BUFFER IF WRITE ERROR OCCURRED. * 00500000 * REGISTER 0 -POINTS TO IOB IF WRITE ERROR OCCURRED. * 00520000 * REGISTER 14-POINTS TO RETURN TO CLOSE IF WRITE ERROR * 00540000 * OCCURRED DURING CLOSE. * 00560000 * * 00580000 *EXTERNAL ROUTINES- 'IGG019GD'-CHANNEL PROGRAM APPENDAGE ROUTINES * 00600000 * USED TO PROCESS I/O RETURNS. ALSO, CHANNEL PROGRAMS AND IOS. * 00620000 * * 00640000 *EXITS-NORMAL- (ISLFX13), USER RECORD HAS BEEN PROCESSED SUCCESSFULLY.* 00660000 * -ERROR- (ISLFX05), AN ERROR OCCURRED DURING THE PROCESSING OF * 00680000 * THE USER RECORD. THE ERROR CONDITION IS FLAGGED AS FOLLOWS, * 00700000 * DCBEXCD1 BIT 5 ON = WRITE ERROR, REG 1 POINTS TO BAD BUFFER * 00720000 * REG 0 POINTS TO IOB * 00740000 * DCBEXCD1 BIT 2 ON = SPACE ERROR, NOT ENOUGH SPACE FOR DATA SET. * 00760000 * DCBEXCD2 BIT 1 ON = DUPLICATE KEY. * 00780000 * DCBEXCD2 BIT 0 ON = KEY OUT OF SEQUENCE. * 00800000 * REG 0 POINTS TO HIGH KEY 20852 00810000 * * 00820000 *TABLES/WORK AREAS- * 00840000 * DCB - COMMUNICATION WITH USER. * 00860000 * DEB - COMMUNICATION WITH IOS * 00880000 * ISLCOMON - COMMUNICATION WITHIN LOAD MODE. * 00900000 * ISLIOBA - COMMUNICATION WITH I/O FOR CP18 AND 20. * 00920000 * ISLIOBB - COMMUNICATION WITH I/O FOR CP21. * 00940000 * ISLIOBC - COMMUNICATION WITH I/O FOR CP19. * 00960000 * ISLAREAZ - WORK AREA USED FOR PREFORMATTING. * 00980000 * ISLIXLT - INDEX LOCATION TABLE, LOCATES HI-LEVEL INDICIES. * 01000000 * ISLY - WORK AREA USED WHEN WRITING INDICIES. * 01020000 * ISLVPTRS - VARIABLE POINTERS, REFERENCE VARIABLE LENGTH BLOCKS. * 01040000 * IOBBCT - BUFFER CONTROL TABLE, CONTROLS BUFFER USAGE. * 01060000 * * 01080000 *ATTRIBUTES- READ ONLY, REENTRANT, REUSABLE. * 01100000 * * 01120000 *NOTES- THIS MODULE, TOGETHER WITH THE APPENDAGE MODULE 'IGG019GD', * 01140000 * AND THE CHANNEL PROGRAMS, CREATE THE ISAM DATA SET WHEN WRITE- * 01160000 * CHECKING IS SPECIFIED. ALL OTHER LOAD MODE MODULES MERELY PROVIDE * 01180000 * THE OPEN AND CLOSE FUNCTIONS. * 01200000 * SECTIONS OF THE PROCESSING IN THIS MODULE ARE ENTERED * 01220000 * DIRECTLY FROM CLOSE PROCESSING. IN SUCH CASES, PROCESSING IS * 01240000 * CARRIED ON AS THOUGH IT WAS PART OF CLOSE. * 01260000 * ENTRY POINTS - ISLFX01 * 01280000 * - ISLFX20 * 01300000 * - ISLFY01 * 01320000 * - ISLFZ01 * 01340000 * - ISLPA01 * 01360000 * * 01380000 * ****************************************************************** 01400000 * THE FOLLOWING NOTATION IS FREQUENTLY USED THROUGHOUT COMMENTS - * 01420000 * C(FIELD X) = A(FIELD Y) * 01440000 * CONTENTS OF FIELD X = ADDRESS OF FIELD Y * 01460000 * 01480000 * * 01500000 EJECT 01520000 IGG019GB CSECT 01540000 ******************** 01560000 * DCB REFERENCE * 01580000 ******************** 01600000 * 01620000 DCBD DSORG=(IS) 01640000 USING IHADCB,R1 01660000 EJECT 01680000 ******************** 01700000 * DEB REFERENCE * 01720000 ******************** 01740000 * 01760000 IHADEB IGGDEBD 01770020 USING IHADEB,R8 S20201 01780020 EJECT 02480000 ISLCOMON IGGLOAD 02490020 USING ISLCOMON,R12 S20201 02500020 * 03840000 * IOBBCT REFERENCE C(ISLVPTRS+8)=A(IOBBCT) 03860000 * 03880000 IOBBCT DSECT 03900000 USING IOBBCT,R11 03920000 DS 0D 03940000 IOBFLAGS DS 0CL1 FLAGS 03960000 IOBPTRA DS A PTR A 03980000 IOBB DS 0CL1 B 04000000 IOBPTRB DS A PTR B 04020000 IOBS DS 0CL1 S - STATUS FIELD FOR BUF NO 1 04040000 IOBABUF DS A A(BUF NO 1) - ADR OF BUF NO 1 04060000 * 04080000 *------------------ VARIABLE AREA ------------------------------------ 04100000 * 04120000 * -- 04140000 * -- 04160000 * -- 04180000 * -- 04200000 * 04220000 * ISLY REFERENCE C(ISLVPTRS)=A(ISLY) 04240000 * 04260000 ISLY DSECT 04280000 USING ISLY,R9 04300000 DS 0D 04320000 DS CL8 CYL-MAST IX COUNT Y+0 04340000 DS CL10 DATA Y+8 04360000 DS CL8 TRK IX NORM COUNT Y+18 04380000 DS CL10 DATA Y+26 04400000 DS CL8 TRK IX OVFL COUNT Y+36 04420000 DS CL10 DATA Y+44 04440000 DS CL8 TRK IX DUMM COUNT Y+54 04460000 * DS CL(IL) KEY 1S Y+62 04480000 * DS CL10 DATA Y+62+IL 04500000 * 04520000 EJECT 04540000 IHAIOB DSECT 04560000 USING IHAIOB,R2 04580000 DS 0D 04600000 IOBFLG1 DS CL1 FLAGS 1 04620000 IOBFLG2 DS CL1 FLAGS 2 04640000 DS CL1 04660000 IOBSENSE DS CL1 SENSE 04680000 IOBECBAD DS A ECB POINTER 04700000 IOBCSW DS CL8 CHANNEL STATUS WORD 04720000 IOBSIOCC DS 0CL1 SIO CC 04740000 IOBCPSAD DS A CHANNEL PROG START ADR 04760000 IOBWT DS 0CL1 WEIGHT 04780000 IOBDCBAD DS A DCB POINTER 04800000 IOBCPRAD DS A CHANNEL PROG RESTART ADR 04820000 IOBBCTI DS CL2 BLK CTR INCR 04840000 IOBECT DS CL2 ERROR CTR 04860000 IOBDADAD DS CL8 DIR ACCESS DEV ADR MBBCCHHR 04880000 * 04900000 IXLT DSECT 04920000 USING IXLT,R7 04940000 DS 0D 04960000 IXLTIND DS CL1 INDICATOR 04980000 IXLBEG DS CL8 BEGINING COUNT MBBCCHHR 05000000 IXLSTP DS CL8 STEPPING COUNT MBBCCHHR 05020000 IXLEND DS CL8 ENDING COUNT NBBCCHHR 05040000 DS CL1 05060000 DS CL26 LEV2 05080000 DS CL26 LEV3 05100000 DS CL26 LEV4 05120000 EJECT 05125020 CPSX DSECT 05130020 IGGLDCP OPTCD=W,RECFM=F LOAD CHANNEL PROGRAMS S20201 05135020 EJECT 05140000 *********************************************************************** 05160000 * ISL PUT - BEGIN * 05180000 *********************************************************************** 05200000 * 05220000 * 05240000 IGG019GB CSECT 05260000 ISLF800 SAVE (14,12) SAVE USERS REGS 05280000 BALR R15,0 05300000 USING *,R15 05320000 B ISLFX01 05340000 B ISLFX20 05360000 B ISLFY01 05380000 B ISLFZ01 05400000 B ISLPA01 05420000 * 05440000 * EQUATE SYMBOLIC REGISTERS 05460000 * 05480000 R0 EQU 0 05500000 R1 EQU 1 05520000 R2 EQU 2 05540000 R3 EQU 3 05560000 R4 EQU 4 05580000 R5 EQU 5 05600000 R6 EQU 6 05620000 R7 EQU 7 05640000 R8 EQU 8 05660000 R9 EQU 8 05680000 R10 EQU 10 05700000 R11 EQU 11 05720000 R12 EQU 12 05740000 R13 EQU 13 05760000 R14 EQU 14 05780000 R15 EQU 9 05800000 R16 EQU 15 05820000 CVTPTR EQU 16 05840000 RSLOAD EQU X'20' DCBST - RESUME LOAD S20201 05842020 * * INDICATOR 05844020 K1 EQU 1 CONSTANT S20201 05846020 L3 EQU 3 LENGTH S20201 05848020 K3 EQU 3 CONSTANT S20201 05850020 K24 EQU 24 CONSTANT S20201 05852020 K8 EQU 8 CONSTANT S20201 05854020 K7 EQU 7 CONSTANT S20201 05856020 K4 EQU 4 CONSTANT S20201 05858020 * 05860000 L4 EQU 4 LENGTH S20201 05866020 K0 EQU 0 CONSTANT S20201 05872020 COMPLETE EQU X'40' IOB COMPLETED A42181 05872621 IOERROR EQU X'04' DCBEXCD1 - I/O ERROR A42181 05873221 CQT5ATIC EQU CQT5A+5 TIC TO SEEK M5864 05874020 CQT5ANOP EQU CQT4A+5 TIC TO CQT5B M5864 05876020 ISLKEYVL EQU X'04' KEY SEQUENCE VALID XM6075 05878000 EJECT 05880000 *********************************************************************** 05900000 * CHART FX - PUT (MOVE/LOCATE) * 05920000 *********************************************************************** 05940000 * 05960000 USING IHADEB,R8 05980000 * 06000000 * FX HOUSEKEEPING 06020000 * 06040000 ISLFX01 L R12,DCBWKPT1 C(R12)=A(COMMON) 06060000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 14251 06065016 L R11,8(R10) C(R11)=A(BCT) 14251 06070016 TM IOBFLAGS,X'10' DID WE COME FROM CLOSE 14251 06075016 BO CONTINUE YES TAKE BRANCH 14251 06080016 ST R13,ISLVRSAV+4 14251 06085016 CONTINUE EQU * 14251 06090016 LA R2,ISLIOBA C(R2)=A(IOBA) 06140000 NI DCBEXCD2,X'3F' SET EXCD2 BITS 0 AND 1 = 00 06160000 * 06180000 TM DCBEXCD1,X'04' HAS AN OUTPUT ERROR A31998 06185020 * * OCCURRED$ 06190020 BO ISLFX02 YES TAKE SYNAD A31998 06195020 * TEST DCBST BIT 1 FOR LOAD MODE (FIRST TIME SW) 06200000 * 06220000 TM DCBST,X'40' TEST ST BIT 1 (1=NOT FRST TIME) 06240000 BC 14,ISLFX10A BRANCH NOT ON 06260000 LH R5,DCBRKP RELATIVE KEY POSITION A32496 06270020 * 06280000 TM DCBST,X'20' RESUME LOAD P4701 06282000 BZ ISLFX022 NOT RESUME LOAD A31998 06284020 TM DCBMACRF+1,X'08' PUT - LOCATE MODE P4701 06290000 BO ISLFX07A BR-YES XM6075 06292000 L R4,4(R10) PT TO HIGH KEY A32496 06294020 B ISLFY022 BRANCH TO CHECK SEQUENCE A32496 06296020 * TEST DCBEXCD1 BIT 5 FOR PREVIOUS UNCORRECTABLE WRITE ERROR 06300000 * 06320000 ISLFX02 L R13,ISLVRSAV+4 C(R13)=A(USERS SAVE AREA) 20852 06330000 MVC 24(4,R13),ISLVPTRA A(BAD BUFFER) IN USER R1 25463 06420018 LA R0,ISLIOBA C(R0)=A(IOBA) 06480000 ST R0,20(R13) STORE A(IOBA) IN USERS R0 06500000 B ISLFX05 B TO TAKE SYNAD 06520000 * 06540000 * SEQUENCE CHECK 06560000 **************** 06580000 * 06600000 ISLFX022 EQU * * A32496 06610020 L R4,ISLCBF A32496 06620020 AR R4,R5 PT TO KEY A32496 06630020 ISLFY022 EQU * A32496 06640020 SR R3,R3 06680000 IC R3,DCBKEYLE C(R3)=KEYLEN, 000000NN 06700000 BCTR R3,0 C(R3)=KEYLEN-1, FOR EXECUTE 06720000 * 06740000 * TEST FOR MOVE OR LOCATE PUT 06760000 * 06780000 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 06800000 BC 1,ISLFX08 B IF ON = MOVE PUT 06820000 * 06840000 * LOCATE PUT *** 06860000 * 06880000 L R5,4(R10) C(R5)=A(KEYSAVE)=A(PREV KEY) 06900000 EX R3,ISLFX02A C(CBF+RKP) VS C(KEYSAVE) 06920000 BH ISLFX06 B IF NEW KEY HIGH 06940000 BE ISLFX023 BR - SEQUENCE CORRECT 20852 06950000 LR R4,R5 PTR TO KEY M1857 06960020 B ISLFX041 BR TO POST ERROR M1857 06970020 * 06980000 * LOCATE PUT,KEYS EQUAL- TEST IF 2ND PUT (SEQ CHK ONLY AFTER 2ND PUT) 07000000 * 07020000 ISLFX023 EQU * 20852 07030000 L R6,DCBNREC C(R6)=NREC 07040000 C R6,ISLONEF TEST NREC VS 1 07060000 BE ISLFX06 B IF NREC = 1, ONLY 2ND PUT 07080000 * 07100000 * DUPLICATE RECORDS = ERROR 07120000 * 07140000 ISLFX03 OI DCBEXCD2,X'40' SET EXCD2 BIT 1 ON = DUPLICATE 07160000 B ISLFX05 07180000 * 07200000 * MOVE PUT *** 07220000 * 07240000 ISLFX08 AR R5,R0 C(R5)=C(AREA+RKP)=A(NEW KEY) 07260000 EX R3,ISLFX08A C(NEW KEY) VS C(CBF+RKP) 07280000 BH ISLFX07 BRANCH IF NEW KEY HIGH 07300000 BE ISLFX03 BR IF KEYS EQUAL=DUPLIC ATES 07320000 ISLFX041 EQU * * M1857 07322020 TM IOBFLAGS,X'10' IN CLOSE M1857 07324020 BO ISLFX04 YES - DON'T SAVE KEY M1857 07326020 ST R4,20(R13) HI KEY ADDR INTO USER R0 20852 07330000 * 07340000 * SEQUENCE ERROR 07360000 * 07380000 ISLFX04 OI DCBEXCD2,X'80' SET EXCD2 BIT 0 ON = SEQ ERR 07400000 * 07420000 * TAKE SYNAD EXIT 07440000 * 07460000 ISLFX05 LR R4,R14 SAVE RETURN IN R4 07480000 L R16,DCBSYNAD 07500000 C R16,ISLONEF TEST SYNAD VS 1 07520000 BE ISLFX052 BR IF 1 - NO SYNAD 07540000 TM IOBFLAGS,X'10' TEST FLAGS BIT 3 (CLOSE) 07560000 BC 1,ISLFX051 B IF ON = CLOSE 07580000 L R13,ISLVRSAV+4 RESTORE USER R13 07600000 L R14,12(R13) RESTORE USER R14 07620000 LM 0,12,20(R13) RESTORE REGS 07640000 BR R16 TAKE SYNAD EXIT 07660000 ISLFX051 TM DCBEXCD2,X'20' TEST EXCD2 BIT 2 ***CLOSE*** 07680000 BC 1,0(R4) B IF ON, RETURN TO CLOSE 07700000 L R5,CVTPTR FIND USERS SAVE AREA 07720000 L R5,0(R5) 07740000 L R5,4(R5) 07760000 L R5,0(R5) 07780000 LR R3,R1 SAVE R1 07800000 STM 2,13,96(R5) SAVE PUTS REGS 2 - 13 07820000 OI DCBEXCD2,X'20' SET EXCD2 BIT 2 ON = CLOSE 07840000 LM 0,1,20(R13) SET REGS 0 AND 1 07860000 LM 2,13,40(R5) RESTORE USERS REGS 2 - 13 07880000 SYNCH (15) TAKE SYNAD EXIT (RETURN VIA 14) 07900000 L R5,CVTPTR FIND USERS SAVE AREA 07920000 L R5,0(R5) 07940000 L R5,4(R5) 07960000 L R5,0(R5) 07980000 LM 2,13,96(R5) RESTORE PUTS REGS 2 - 13 08000000 LR R1,R3 RESTORE R1 08020000 BR R4 RETURN TO CLOSE 08040000 ISLFX052 L R1,ISLABEND NO SYNAD = ABEND 31 08060000 ABEND (1) ABEND 08080000 * 08100000 * LOCATE PUT,SEQUENCE OK- MOVE KEY TO KEYAVE AREA 08120000 * 08140000 ISLFX06 EX R3,ISLFX06A MOVE C(CBF+RKP) TO C(KEYSAVE) 08160000 * 08180000 * BUMP CBF 08200000 * 08220000 ISLFX07 EQU * * A32496 08230020 OI ISLIXLT,ISLKEYVL VALID RECORD ADDED M6075 08232000 ISLFX07A L R7,ISLCBF C(R7)=A(CURR BUFR PTR) S20201 08240020 * P470 S20201 08250020 A R7,ISLBMPR C(R7)=CBF+BMPR S20201 08260020 ST R7,ISLCBF C(CBF)=CBF+BMPR 08280000 B ISLFX10 08300000 * 08320000 * BUMP NREC 08340000 * 08360000 ISLFX10A OI DCBST,X'40' SET ST BIT ON 08380000 CLC DCBLPDA(1),DCBMSWA TEST FOR SAME M 16305 08383016 BNE KEEPGOIN 16305 08386016 CLC DCBLPDA+3(4),DCBMSWA+3 TEST FOR OUT OF SPACE 16305 08389016 BH ISLPA205 BRANCH NO SPACE 16305 08392016 KEEPGOIN EQU * 16305 08395016 ISLFX10 L R3,DCBNREC C(R3)=NREC 08400000 A R3,ISLONEF C(R3)=NREC+1 08420000 ST R3,DCBNREC C(NREC)=NREC+1 08440000 * 08460000 * TEST BOB SWITCH (APPLIES ONLY TO MOVE PUT, BOBSW = 1 FOR LOCATE PUT) 08480000 * 08500000 TM IOBFLAGS,X'08' TEST FLAGS BIT 4 VS 1 (BOBSW) 08520000 BC 1,ISLFX11 B IF ON = NOT 0 08540000 * 08560000 * BOBSW = 0 08580000 OI IOBFLAGS,X'08' SET FLAGS BIT 4 = 1 (BOBSW ON) 08600000 BAL R14,ISLPA01 *LINK TO BOB ROUTINE 08620000 * 08640000 TM DCBST,RSLOAD IS IT RESUME LOAD S20201 08645020 BZ ISLFX11 NO - O.K. S20201 08650020 MVC IOBPTRA+K1(L3),IOBPTRB+K1 MAKE IT THE FIRST S20201 08655020 * BOBSW = 1 08660000 * TEST FOR MOVE OR LOCATE PUT 08680000 * 08700000 ISLFX11 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 08720000 BC 1,ISLFX20 B IF ON = MOVE PUT 08740000 * 08760000 * LOCATE PUT 08780000 * TEST FOR EOB, HAS USERS LAST RCD FILLED A BUFFER - 08800000 * 08820000 L R7,ISLCBF C(R7)=CBF 08840000 C R7,ISLEOB TEST CBF VS EOB 08860000 BNL ISLFX24 B IF EOB 08880000 * 08900000 * NOT EOB 08920000 ISLFX12 TM IOBFLAGS,X'40' TEST FLAGS BIT 1 08940000 BC 1,ISLFX14 B IF ON = WRITE SHOULD BE 08960000 * ATTEMPTED 08980000 * 09000000 * NOT EOB, FLAGS BIT 1 OFF, RESTORE REGS AND RETURN TO USER 09020000 * 09040000 * EXIT PUT 09060000 * 09080000 ISLFX13 TM IOBFLAGS,X'10' TEST FLAGS BIT-3 (CLOSE) 09100000 BC 1,0(R14) B IF ON = CLOSE 09120000 * * INDICATOR 09122020 TM DCBST,RSLOAD RESUME LOAD S20201 09124020 BZ ISLFX13R NO - BUFFERS CORRECT S20201 09126020 NI DCBST,X'FF'-RSLOAD TURN OFF RESUME LOAD S20201 09128020 MVC IOBPTRA+K1(L3),IOBPTRB+K1 CORRECT PTRS S20201 09130020 ISLFX13R EQU * * S20201 09132020 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 (MOVE PUT) 09140000 BC 1,ISLFX132 B IF ON = MOVE PUT 09160000 L R1,ISLCBF C(R1)=CBF, FOR LOCATE PUT 09180000 ISLFX132 L R13,ISLVRSAV+4 09200000 L R14,12(R13) RESTORE R14 09220000 RETURN (2,12) RESTORE USERS REGS AND EXIT 09240000 * 09260000 * 09280000 * 09300000 * NOT EOB, FLAGS BIT 1 ON, SET FLAGS BIT 1 OFF AND ATTEMPT WRITE 09320000 * 09340000 ISLFX14 NI IOBFLAGS,X'BF' SET FLAGS BIT 1 OFF 09360000 OI IOBFLAGS,X'20' SET FLAGS BIT 2 ON (NOT EOB) 09380000 B ISLFY02 * 09400000 * 09420000 * 09440000 * 09460000 * MOVE PUT 09480000 * MOVE RECORD FROM USER AREA TO CURRENT BUFFER VIA CBF 09500000 * 09520000 ISLFX20 L R3,ISLMVC C(R3)=COUNT OF EXECUTED MOVE 09540000 L R4,ISLCBF C(R4)=CBF=MOVE DESTINATION 09560000 LR R5,R0 C(R5)=MOVE ORIGIN 09580000 L R6,ISLMVCT C(R6)=NBR OF 255 BYTE MOVES 09600000 ISLFX21 BCT R6,ISLFX22 TO MOVE 255 BYTES 09620000 EX R3,ISLFX21A MOVE RCD AT R0 TO CBF 09640000 B ISLFX23 MOVE COMPLETED 09660000 ISLFX22 MVC 0(255,R4),0(R5) MOVE 255 BYTES OF RECORD 09680000 LA R4,255(R4) BUMP DESTINATION 8M800 09700018 LA R5,255(R5) BUMP ORIGIN 8M800 09720018 B ISLFX21 TO MOVE REST OF RECORD 09740000 * 09760000 * TEST FOR EOB, HAS RCD JUST MOVED FILLED A BUFFER 09780000 * 09800000 ISLFX23 L R7,ISLCBF C(R7)=CBF 09820000 A R7,ISLBMPR C(R7)=CBF+BMPR 09840000 C R7,ISLEOB TEST CBF+BMPR VS EOB 09860000 BL ISLFX12 B IF NOT EOB 09880000 * 09900000 * 09920000 * EOB 09940000 * 09960000 * SET BOB SW TO ZERO (RESET) 09980000 * 10000000 NI IOBFLAGS,X'F7' SET FLAGS BIT 4 = 0 (BOBSW OFF) 10020000 NI DCBST,X'FF'-RSLOAD TURN OFF RESUME LOAD S20201 10030020 * 10040000 * MARK CURRENT BUFFER AND BUMP B IN BCT. 10060000 * 10080000 ISLFX24 L R3,IOBPTRB C(R3)=PTR B = A(CURRENT SLOT) 10100000 TM DCBST,RSLOAD RESUME LOAD S20201 10106020 BO ISLFY01 YES - DON'T SCHEDULE S20201 10112020 NI 0(R3),X'DF' SET STATUS BIT 2 = 0 10120000 OI 0(R3),X'40' SET STATUS BIT 1 = 1 10140000 * STATUS BITS 1 AND 2 = 10 10160000 * =BUF FULL BUT NOT SCHED 10180000 IC R4,IOBB C(R4)-000N, FULL BUFRS P4701 10200000 LA R4,1(0,R4) C(R4)-000000NN+1 P4701 10220000 STC R4,IOBB C(PTRB)=NNAAAAAA, NN = B 10260000 * 10300000 EJECT 10320000 *********************************************************************** 10340000 * CHART FY - PUT (EOB) * 10360000 *********************************************************************** 10380000 * 10400000 * TEST B VS FBW (ARE WE READY TO ATTEMPT TO WRITE) 10420000 * 10440000 ISLFY01 SR R3,R3 10460000 IC R3,IOBB C(R3)=000N N=NO. FILLED, 10480000 * UNSCHEDULED BUFFERS 10500000 C R3,ISLFBW TEST B VS FBW 10520000 BL ISLFY41 B IF NOT ENOUGH BUFFERS FILLED 10540000 * 10560000 * B G.E. FBW, ATTEMPT WRITE 10580000 * TEST FLAGS BIT 0 VS 1, (IWR)-IS CP AVAILABLE 10600000 * 10620000 ISLFY02 EQU * * A42181 10628021 TM ISLECBA,COMPLETE IOB AVAILABLE A42181 10636021 BZ ISLFY41A NO - SCHEDULE LATER A42181 10644021 TM DCBEXCD1,IOERROR HAS AN I/O ERROR A42181 10652021 * OCCURRED A42181 10660021 BO ISLFX02 YES - TERMINATE LOAD. A42181 10668021 * 10680000 * B GE FBW AND FLAGS BIT 0 = 0 (CP AVAILABLE), SET UP TO WRITE 10700000 * 10720000 ISLFY03 SR R3,R3 10740000 IC R3,IOBB C(R3)=000N 10760000 S R3,ISLFBW C(R3)=B-FBW, WE WILL SCHED FBW 10780000 * BUFFRS 10800000 STC R3,IOBB C(PTRB)=NNAAAAAA, NN = B 10820000 * 10840000 NI IOBFLAGS,X'BF' SET FLAGS BIT 1 OFF 10860000 * 10880000 * 10900000 * 10920000 * WAIT FOR PREVIOUS I/O TO COMPLETE 10940000 * 10960000 * 10980000 * 11000000 * MAKE SURE CP21 HAS COMPLETED 11020000 * 11040000 LA R2,ISLIOBB SET BASE FOR IOB FOR CP21 11060000 BAL R4,ISLFY99 BR TO WAIT SUBROUTINE 11080000 * 11100000 * TEST STATUS BIT-6 (PF BIT) PERTAING TO 1ST BFR. IF PF BIT ON, THIS 11120000 * IS THE 1ST BUFFER TO BE WRITTEN ON A NEW CYLINDER WITH SHARED TRACKS 11140000 * 11160000 TM 0(R3),X'02' TEST STATUS BIT-6 11180000 BC 8,ISLFY08 B IF PF NOT ON 11200000 * 11220000 * STATUS BIT-6 (PF BIT) IS ON. WE ARE ABOUT TO SCHED THE 1ST WRITE ON 11240000 * A NEW, SHARED-TRACK, CYLINDER. FIRST WE MUST BE SURE CP19 HAS 11260000 * FINISHED PRE-FORMATTING. 11280000 * 11300000 LA R2,ISLIOBC SET BASE FOR IOB FOR CP19 11320000 BAL R4,ISLFY99 BR TO WAIT SUBROUTINE 11340000 NI 0(R3),X'FD' SET STATUS BIT 6 (PF BIT) OFF 11360000 * 11380000 * 11400000 * SCHED FBW BUFFRS FOR WRITING VIA PTR A (STATUS BITS 1,2 ON) 11420000 * AT THE SAME TIME TEST STATUS BYTES FOR BIT-3 ON = NEW EXTENT 11440000 * 11460000 ISLFY08 L R4,ISLFBW C(R4)= NO OF SLOTS TO SCHED 11480000 ISLFY10 OI 0(R3),X'60' SET STATUS BITS 1,2 = 11 11500000 TM 0(R3),X'10' TEST STATUS BIT-3 11520000 BC 8,ISLFY11 B IF 0, SAME EXTENT 11540000 IC R5,IOBDADAD C(R5)-M P4701 11560000 LA R5,1(0,R5) C(R5)-M+1 P4701 11580000 STC R5,IOBDADAD C(IOBA+32)=MBBCCHHR, M=M+1 11620000 BAL R5,ISLFZ21 11630013 NI 0(R3),X'EF' SET STATUS BIT-3 = 0 11640000 ISLFY11 A R3,ISL4 BUMP R3 TO ADR NEXT SLOT 11660000 C R3,ISLBUFN TEST FOR ADR OF NTH SLOT 11680000 BC 13,ISLFY20A BR IF NOT HIGH 11700000 ISLFY12 BCT R4,ISLFY13 WRAPAROUND POSSIBLE 11720000 B ISLFY20 OUT, SLOT N WAS LAST 11740000 ISLFY13 LA R3,IOBABUF WRAPAROUND REAL, C(R3)=A(SLOT1) 11760000 B ISLFY10 LOOP AGAIN 11780000 * 11800000 * SAVE ADR OF LAST SLOT IN REG 7 11820000 ISLFY20A BCT R4,ISLFY10 11840000 ISLFY20 LR R7,R3 C(R7)=A(LAST SLOT SCHED + 4) 11860000 S R7,ISL4 C(R7)=A(LAST SLOT SCHED) 11880000 * 11900000 * INITIALIZE CP18 AND CP20 IN SUBROUTINE 11920000 * 11940000 * 11960000 STM R2,R11,ISLVRSAV+28 SAVE REGS 2-11 11980000 B ISLF801 12000000 ISLFY21 LM R2,R11,ISLVRSAV+28 RESTORE REGS 2-11 12020000 * 12040000 * SAVE CONTENTS OF BCT SLOT WITH STATUS AND POINTER OF LAST BUFF SCHED 12060000 * 12080000 MVC ISLF9WK1(4),0(R7) SAVE SLOT CONTENTS OF 16305 12100016 * LAST BCT SLOT 16305 12120016 * 12140000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 12160000 * 12180000 TM 0(R7),X'04' TEST S BIT 5 VS 1 (C-BIT) 12200000 BC 1,ISLFZ01 B IF ON 12220000 * 12240000 * 12260000 * EXECUTE CP18 (CP20) 12280000 * 12300000 * 12320000 ISLFY30 LA R13,ISLVRSAV C(R13)=A(VRSAV) 12340000 LR R3,R0 SAVE R0 12360000 LR R4,R1 SAVE R1 12380000 LR R5,R14 SAVE R14 12400000 * 8791 12420000 * 8791 12440000 * 8791 12460000 * SET FLAGS BIT-0 (IWR BIT)=1, CP IS NOT AVAIL 8791 12480000 * 8791 12500000 OI IOBFLAGS,X'80' TURN ON FLAGS BIT 0 8791 12520000 * 8791 12540000 EXCP IHAIOB EXECUTE CHANNEL PROGRAM 12560000 LR R0,R3 RESTORE R0 12580000 LR R1,R4 RESTORE R1 12600000 LR R14,R5 RESTORE R14 12620000 * 12640000 * SET FBW IN SUBROUTINE 12660000 * 12680000 LA R7,ISLF9WK1 C(R7)=A(LAST SLOT) FROZEN 12700000 B ISLPB01 GO TO SUBROUTINE 12720000 ISLFY41A OI IOBFLAGS,X'40' SET FLAGS BIT 1 ON TO ATTEMPT 12740000 * TO WRITE LATER 12760000 * 12780000 * 12800000 * 12820000 * TEST FLAGS BIT 2 (NOT EOB INDICATOR) 12840000 * 12860000 ISLFY41 TM IOBFLAGS,X'20' TEST FLAGS BIT 2 12880000 BC 8,ISLFY42 B IF NOT ON (EOB) 12900000 NI IOBFLAGS,X'DF' TURN FLAGS BIT 2 OFF 12920000 B ISLFX13 RTRN TO FX (DONT GET LOC BUFF) 12940000 * 12960000 * TEST FOR MOVE OR LOCATE PUT 12980000 * 13000000 ISLFY42 TM DCBMACRF+1,X'10' TEST MACRF BIT 11 13020000 BC 1,ISLFX13 B IF ON = MOVE PUT, RTRN TO FX 13040000 * 13060000 * LOCATE PUT 13080000 * 13100000 BAL R14,ISLPA01 *LINK TO BOB ROUTINE 13120000 B ISLFX13 RETURN TO FX 13140000 * 13160000 * 13180000 ***WAIT SUBROUTINE*** 13200000 * THIS SUBROUTINE DETERMINES IF A CHANNEL PROGRAM IS AVAILABLE, AND 13220000 * IF IT IS NOT, WAITS UNTIL IT IS. THE ROUTINE EXPECTS THE FOLLOWING 13240000 * INPUT - R2 = ADDR OF IOB FOR CHANNEL PROGRAM TO BE TESTED 13260000 * R4 = RETURN ADDRESS 13280000 * 13300000 ISLFY99 EQU * 13320000 ST R4,ISLVRSAV SAVE RETURN ADDRESS 0700 13340000 LR R3,R1 SAVE R1 13360000 L R1,IOBECBAD C(R1)=A(ECB) 13380000 TM 0(R1),X'40' TEST ECB BIT 1 (C-BIT) 13400000 BC 1,ISLFY995 B IF 1, I/O COMPLETE-DON'T WAIT 13420000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 13440000 LR R4,R0 SAVE R0 13460000 LR R5,R14 SAVE R14 13480000 WAIT ECB=(1) 13500000 LR R0,R4 RESTORE R0 13520000 LR R14,R5 RESTORE R14 13560000 * 13580000 ISLFY995 LA R2,ISLIOBA C(R2)=A(IOBA) 13600000 LR R1,R3 RESTORE R1 13620000 L R3,IOBPTRA C(R3)=A(1ST SLOT TO SCHED) 13640000 LA R3,0(R3) 13660000 L R4,ISLVRSAV GET RETURN ADDRESS 0700 13680000 BCR 15,R4 RETURN 13700000 * 13720000 EJECT 13740000 *********************************************************************** 13760000 * CHART FZ - CYLINDER INDEX ENTRY SETUP * 13780000 *********************************************************************** 13800000 * 13820000 * 13840000 * STORE ADDR OF STATUS BYTE WITH C-BIT ON IN CP21 AT CQ41 13860000 * -THIS IS DONE TO PERMIT APPENDAGE TO TURN OFF C-BIT- 13880000 * * R7 CONTAINS ADDR OF THE STATUS BYTE * 13900000 * 13920000 ISLFZ01 L R10,DCBWKPT6 C(R10)=A(VPTRS) 13940000 L R10,24(R10) C(R10)=A(CP21-CQ40) 13960000 ST R7,12(R10) C(CQ41+4)=A(LAST SLOT SCHED) 13980000 NI ISLIXLT,X'F7' SET IXLT LEV1 BIT-4 OFF- TRK IX 14000000 * 14020000 * 14040000 * LOCATE LEVEL IN INDEX LOCATION TABLE AT CYLINDER INDEX 14060000 * 14080000 LA R7,ISLIXLT C(R7)=A(IXLT) 14100000 OI 0(R7),X'20' IXLTIND BIT-2 ON IN LEV1 14120000 NI 26(R7),X'DF' BIT-2 OFF IN LEV2 14140000 NI 52(R7),X'DF' LEV3 14160000 NI 78(R7),X'DF' LEV4 14180000 * 14200000 * CONSTRUCT COUNT FOR CYLINDER INDEX ENTRY IN AREA Y, Y+0 14220000 * 14240000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 14260000 L R9,0(R10) C(R9)=A(AREA Y) 14280000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT S0 14300000 SR R3,R3 14320000 IC R3,16(R7) C(R3)=R FROM IXLT S0, 000N 14340000 A R3,ISLONEF C(R3)=R+1 14360000 STC R3,4(R9) COUNT = CCHHR WITH R=R+1 14380000 * 14400000 * CONSTRUCT DATA FOR CYLINDER INDEX ENTRY IN AREA Y, Y+8 14420000 * 14440000 TM 0(R7),X'40' TEST IXLTIND BIT 1 (DUMMY SW) 14460000 BC 1,ISLFZ10 B IF ON 14480000 * 14500000 * DUMMY SW OFF 14520000 * A. NORMAL DATA 14540000 * 14560000 MVC 8(7,R9),IOBDADAD DATA=MBBCCHH FROM IOBA+32 14580000 NI 14(R9),X'F8' FOR 2301 SET TO TRACK 0 14590013 CLI DCBDEVT,X'02' IS IT 2301 14600000 BE ISLFZ012 B IF YES 14640013 MVI 14(R9),X'00' FOR 2321 SET TO TRACK 0 14680013 ISLFZ012 EQU * 14720000 CLI DCBFIRSH+1,X'00' H OF FIRSH VS 0 A46109 14760021 MVI 15(R9),X'00' DATA = MBBCCHHR WITH R=0 A46109 14800021 BNE ISLFZ03 BIF HH NOT 00 A46109 14840021 * HH OF FIRSH = 00 14880021 MVC 15(1,R9),DCBFIRSH+2 DATA = MBBCCHHR WITH R A46109 14920021 * OF FIRSH 14960021 ISLFZ03 MVI 16(R9),X'01' DATA = MBBCCHHRF WITH F = 01 15000000 * 15020000 SR R6,R6 15040000 IC R6,9(R7) C(R6) = M FROM IXLT S0 15060000 BCTR R6,0 C(R6)=M-1 15080013 SLL R6,4 C(R6) = M-1 X 16 (USE AS INDX) 15100000 * 15120000 SR R5,R5 15140000 IC R5,IOBDADAD C(R5) = M FROM IOBA+32 15160000 BCTR R5,0 C(R5)=M-1 15180013 SLL R5,4 C(R5) = M-1 X 16 (USE AS INDX) 15200000 * 15220000 L R8,DCBDEBAD C(R8)=A(DEB) 15240000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 15280000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTENT ENTRY) 15300000 L R3,DEBFPEAD C(R3)=A(1ST PRIM EXTENT ENTRY) 15320000 LA R3,0(R5,R3) C(R3)=A(CURR PRIM EXTENT ENTRY) 15340000 L R9,0(R10) C(R9)=A(AREA Y) 15360000 * 15380000 CLC 1(3,R3),1(R4) COMP UCB ADDRS, PRIM VS INDX 15400000 BNE ISLFZ04 B IF NOT EQUAL 15420000 * 15440000 * UCBS EQUAL 15460000 CLI DCBDEVT,X'05' IS IT A 2321 15480000 BC 7,ISLFZ04A BR IF NOT A 2321 15500000 CLC 0(2,R9),11(R9) COMPARE CC OF IX ENTRY 15520000 * WITH CC OF REF'D TRACK 15540000 BNE ISLFZ04 BRANCH IF UNEQUAL TO SET P=07 15560000 ISLFZ04A EQU * 15580000 MVI 17(R9),X'0B' DATA = MBBCCHHRFP WITH P=0B 15600000 B ISLFZ05 15620000 * 15640000 * UCBS UNEQUAL 15660000 ISLFZ04 MVI 17(R9),X'07' DATA = MBBCCHHRFP WITH P=07 15680000 * 15700000 * SET CQ43 (CP21) TO ADDRESS KEY 15720000 * OF LAST RECORD IN LAST BUFFER 15740000 * 15760000 ISLFZ05 L R4,ISLKEYAD =A(KEY OF LAST WR CKD) 13165 15830016 B ISLFZ20 15900000 * 15920000 * DUMMY SW ON = END OF CYLINDER 15940000 * B. DUMMY DATA 15960000 * 15980000 * TEST CC+1 VS DEBENDCC FOR 16000000 * POSSIBLE END OF INDEX EXTENT 16020000 * 16040000 ISLFZ10 EQU * 16060000 SR R6,R6 16080000 IC R6,9(R7) C(R6)=M FROM IXLT S0, 000M 16100000 BCTR R6,0 16120000 SLL R6,4 C(R6)=16(M-1) FOR USE AS INDEX 16140013 * TO DEB ENTRY FOR CURR IX EXTNT 16160000 * 16180000 L R8,DCBDEBAD C(R8)=A(DEB) 16200000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 16240000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTNT ENTRY) 16260000 * 16280000 L R9,0(R10) C(R9)=A(AREA Y) 16320000 MVC ISLFXWK1(4),12(R7) C(FXWK1)=CCHH OF IXLT SO 13165 16340016 L R3,ISLFXWK1 C(R3)=CCHH 16360000 MVC ISLFXWK2(4),10(R4) C(FXWK2)=CCHH FROM DEBENDCC 16380000 CLI ISLAREAZ+86,X'02' IS IT 2301 16400000 BC 8,ISLFZ103 BR IF EQ - IT IS 2301 16420000 * 16440000 CLI ISLAREAZ+86,X'05' IS IT 2321 16460000 BC 8,ISLFZ105 BR EQ - 2321 16480000 * 16500000 SRL R3,16 C(R3)=00CC 16520000 LA R3,1(R3) ADD 1 FOR NEXT CYL C(R3)=00CC+1 16540000 SLL R3,16 C(R3)=CC+100 16560000 ST R3,ISLFXWK1 C(FXWK1)=CC+100 16580000 CLC ISLFXWK1(2),ISLFXWK2 CC+1 VS ENDCC 16600000 BH ISLFZ11 BR IF CC+1 HI - IN NEW EXTENT 16620000 * 16640000 * CC+1 IN CURRENT EXTENT 16660000 ISLFZ11A MVC 8(3,R9),9(R7) DATA=MBB FROM IXLT S0 16680000 MVC 11(4,R9),ISLFXWK1 DATA=MBBCCHH CC=CC+1 HH=00 16700000 BC 15,ISLFZ12 BR TO PICK UP R, ETC. 16720000 * 16740000 * COMPUTE CYL+1 FOR 2301 16760000 ISLFZ103 N R3,CONSF8 C(R3)=000H H=CYL 16780000 LA R3,8(R3) C(R3)=CYL+1 16800000 NC ISLFXWK2(4),CONSF8 C(FXWK2)=000H H=END CYL OF EXT 16820000 * 16840000 * COMPARE CYL+1 VS END CYL OF CURRENT EXTENT 16860000 ISLFZ107 ST R3,ISLFXWK1 C(FXWK1)=CYL+1 16880000 CLC ISLFXWK1(4),ISLFXWK2 CYL+1 VS END CYL 16900000 BH ISLFZ11 CYL+1 HI - BR TO GET NEXT EXTNT 16920000 B ISLFZ11A CYL+1 IN CURRENT EXTENT 16940000 * 16960000 * COMPUTE CYL+1 FOR 2321 16980000 ISLFZ105 MVI ISLFXWK2+3,X'00' ZERO TRACK BYTE IN EXTNT END 17000000 SRL R3,8 C(R3)=0CCH ADR FROM IOB+32 17020000 ST R3,ISLFXWK1 C(FXWK1)=0CCH 17040000 CLI ISLFXWK1+3,X'04' TEST FOR LAST CYL IN STRIP 17060000 BC 8,ISLFZ1A5 BR EQ - AT END OF STRIP 17080000 LA R3,1(R3) NOT LAST CYL - SET TO NEXT 17100000 SLL R3,8 C(R3)=CC(H+1)0 17120000 B ISLFZ107 BR TO COMPARE 17140000 * 17160000 ISLFZ1A5 EQU * 17180000 CLI ISLFXWK1+2,X'09' TEST FOR LAST STRIP IN SUBCELL 17200000 BC 8,ISLFZ1B5 BR EQ - AT END OF SUBCELL 17220000 SRL R3,8 C(R3)=00CC 17240000 LA R3,1(R3) NOT LAST STRIP - STEP TO NEXT 17260000 SLL R3,16 C(R3)=CC+100 17280000 B ISLFZ107 BR TO COMPARE 17300000 * 17320000 ISLFZ1B5 EQU * 17340000 SRL R3,16 C(R3)=000C 17360000 LA R3,1(R3) AT END OF SUBCELL-SET TO NEXT 17380000 SLL R3,24 C(R3)=C+1000 17400000 B ISLFZ107 BR TO COMPARE 17420000 * 17440000 * 17460000 ISLFZ11 EQU * 17480000 L R8,DCBDEBAD C(R8)=A(DEB) 13165 17500016 LA R6,16(R6) INDEX TO NEXT EXTENT 7M402 17510000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 17520000 LA R4,0(R6,R4) C(R4)=A(NEXT INDEX EXT) 7M568 17540000 * 17560000 L R9,0(R10) C(R9)=A(AREA Y) 13165 17570016 MVC 11(4,R9),6(R4) DATA=CCHH OF NEW EXTENT 7M568 17580000 SRL R6,4 C(R6) = M FOR NEXT EXTENT 17600000 A R6,ISLONEF C(R6) = M+1 (M=1 FOR EXTENT 0) 17620000 STC R6,8(R9) DATA = MBBCCHH OF NEW EXTENT 17640000 * 17660000 ISLFZ12 MVC 15(3,R9),ISLRFP RFP=002907 8M800 17710018 * 17760000 * SET CQ43(CP21) TO ADDRESS KEY 17780000 * OF ALL ONES AT AREA Y +62 17800000 * 17820000 LA R4,62(R9) C(R4)=A(AREA Y +62) 17860000 * 17940000 * PLACE IXLT S0 IN IOBB+32 17960000 * 17980000 ISLFZ20 L R10,24(R10) C(R10)=A(CP21-CQ40) 13165 17984016 IC R5,24(R10) SAVE OP 13165 17988016 ST R4,24(R10) PTR TO REAL OR DUMMY KEY 13165 17992016 STC R5,24(R10) RESTORE OP 13165 17996016 LA R2,ISLIOBB C(R2)=A(IOBB) 13165 18000016 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT SO) 13165 18004016 BAL R5,ISLFZ21 18010013 * 18020000 * 18040000 * 18060000 * EXECUTE CP21 18080000 * 18100000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 18120000 LR R3,R0 SAVE R0 18140000 LR R4,R1 SAVE R1 18160000 LR R5,R14 SAVE R14 18180000 EXCP IHAIOB EXECUTE CHANNEL PROGRAM 18200000 LR R0,R3 RESTORE R0 18220000 LR R1,R4 RESTORE R1 18240000 LR R14,R5 RESTORE R14 18260000 * 18280000 LA R2,ISLIOBA C(R2)=A(IOBA) 18300000 TM IOBFLAGS,X'12' TEST FLAGS BITS 3&6 (CLOSE X) 18320000 BCR 1,R14 BR IF ON = CLOSE 18340000 B ISLFY30 EXIT 18360000 * 18380000 ISLFZ21 EQU * 18382013 L R13,DCBDEBAD 18384013 LA R13,32(R13) START MOVE OF DEB BB INTO IOB 18386013 SR R8,R8 18388013 IC R8,IOBDADAD 18390013 SLL R8,4 18392013 AR R8,R13 18394013 MVC IOBDADAD+2(1),5(R8) 18396013 BR R5 18398013 EJECT 18400000 *********************************************************************** 18420000 * CHART PA - BEGINING OF BUFFER * 18440000 *********************************************************************** 18460000 * 18480000 * 18500000 * USING PTR B TO REFERENCE COUNT IN LAST BUFFER FILLED - 18520000 * SET REG 5 = R - REG A = 000R 18540000 * SET REG 6 = CCHH - REG B = CCHH 18560000 * SET REG 7 = HI-RCD ON TRACK - REG C = 000R 18580000 * 18600000 ISLPA01 ST R14,ISLF9WK1 SAVE R14 FOR RETURN TO FX 18620000 MVC DCBFTMI3(8),DCBLPDA SAVE PREVIOUS LPDA FOR CLOSE 18640000 L R3,IOBPTRB C(R3)=C(PTRB) 18660000 LA R3,0(R3) C(R3)=A(SLOT S) 18680000 L R4,0(R3) C(R4)=C(SLOT S)=A(BUF B) 18700000 SR R5,R5 18720000 IC R5,4(R4) C(R5)=000R 18740000 MVC ISLFXWK2(4),0(R4) C(FXWK2)=CCHH 18760000 L R6,ISLFXWK2 C(R6)=CCHH 18780000 * 18800000 * TEST HH FOR SHARED TRACK 18820000 SR R7,R7 18840000 CLI DCBHIRSH,X'00' HIRSH VS 0 18860000 BE ISLPA02 BR IF 0 - NO SHARED TRACKS 18880000 STC R6,ISLFXWK1 C(FXWK1)= H FROM BUF CNT 18900000 ISLPA01A NC ISLFXWK1(1),DCBFIRSH+3 REDUCE TO TRACK 18920000 ISLPA01B CLC DCBFIRSH+1(1),ISLFXWK1 H OF FIRSH VS H OF BUFR CNT 18940000 IC R7,DCBHIRSH C(R7)=HIRSH 18960000 BE ISLPA03 BR EQ, SHARED TRK - R7=HIRSH 18980000 ISLPA02 IC R7,DCBHIRPD NOT A SHARED TRACK, C(R7)=HIRPD 19000000 * 19020000 * STEP PTR B TO NEXT SLOT IN BCT (MAY WRAPAROUND) 19040000 * 19060000 ISLPA03 C R3,ISLBUFN TEST FOR ADR OF NTH SLOT 19080000 LA R3,4(R3) STEP TO NEXT SLOT 19100000 BNE ISLPA05 NOT NTH SLOT, GO UPDATE PTR B 19120000 ISLPA04 LA R3,IOBABUF C(R3)=0AAA, AAA= ADR 1ST SLOT 19140000 ISLPA05 IC R4,IOBB SAVE B 19160000 ST R3,IOBPTRB STORE UPDATED PTR B 19180000 STC R4,IOBB RESTORE B 19200000 * 19220000 * UPDATE CBF AND EOB FOR NEW BUFFER VIA PTR B 19240000 * 19260000 L R4,0(R3) C(R4)=C(SLOT S)=A(BUFF B) 19280000 LA R4,0(R4) 19300000 LR R3,R4 C(R3)=A(BUFF B) 19320000 A R3,ISL8 C(R3)=A(BUFF B)+8 19340000 ST R3,ISLCBF C(CBF)=A(BUFF B)+8 19360000 LH R3,DCBBUFL C(R3)=00NN 8M800 19390018 BCTR R3,0 C(R3)=00NN-1 19420013 AR R3,R4 C(R3)=A(BUFF B)+BUFL-1 19440000 ST R3,ISLEOB C(EOB)=A(BUFF B)+BUFL-1 19460000 * 19480000 * 19500000 * ROUTINE TO SET UP NEW COUNT FIELD FOR NEW BUFFER 19520000 * ************************************************ 19540000 * 19560000 * 19580000 * TEST IF LAST BUFFR FILLED WAS EOT 19600000 * 19620000 CR R7,R5 TEST REG C VS REG A 19640000 BE ISLPA20 B IF EOT 19660000 * 19680000 * 19700000 * STEP REG A TO NEXT R ON CURRENT TRACK 19720000 * 19740000 A R5,ISLONEF C(R5)=000R+1 19760000 * 19780000 * TEST IF NEXT BUFFR TO BE FILLED IS AVAILABLE (STATUS BITS) 19800000 * 19820000 ISLPA50 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 19840000 LA R3,0(R3) C(R3)=A(STATUS BITS) 19860000 TM 0(R3),X'60' TEST BITS 1 AND 2 19880000 BC 8,ISLPA70 B IF 00 = BUFFR AVAILABLE 19900000 * 19920000 * BITS 1 AND 2 = 11 OR 10 19940000 * 19960000 * WAIT FOR CP18, AND/OR CP20, AND/OR CP21 BEFORE RE-FILLING BUFFER 19980000 * 20000000 ISLPA60 L R4,IOBECBAD C(R4)=A(ECB) 20020000 TM 0(R4),X'40' TEST ECB BIT 1 (C-BIT) 20040000 BC 1,ISLPA70 B IF 1, I/O COMPLETE-DONT WAIT 20060000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 20080000 LR R3,R1 SAVE R1 20100000 LR R1,R4 C(R1)=A(ECB) 20120000 LR R4,R0 SAVE R0 20140000 WAIT ECB=(1) WAIT 20160000 LR R0,R4 RESTORE R0 20180000 LR R1,R3 RESTORE R1 20200000 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 20220000 LA R3,0(R3) C(R3)=A(STATUS BITS) 20240000 * 20260000 * 20280000 * TEST DCBEXCD1 BIT 5 FOR PREVIOUS UNCORRECTABLE WRITE ERROR 20300000 * 20320000 ISLPA70 TM DCBEXCD1,X'04' TEST EXCD1 BIT 5 20340000 BC 8,ISLPA72 B IF NOT ON 20360000 TM IOBFLAGS,X'10' TEST FLAGS BIT 3 (CLOSE) 20380000 BC 1,ISLPA72 B IF ON = CLOSE 20400000 L R10,DCBWKPT6 C(R10)=A(VPTRS) FROM VPTR10 20420000 L R13,ISLVRSAV+4 C(R13)=A(USERS SAVE AREA) 20440000 MVC 24(4,R13),36(R10) STORE A(BAD BUF) IN USERS R1) 20470013 LA R0,ISLIOBA C(R0)=A(IOBA) 20500000 ST R0,20(R13) STORE A(IOBA) IN USERS R0 20520000 MVC 40(4,R10),DCBSYNAD SET VPTR 11 = A(SYNAD) 20540000 B ISLFX05 B TO TAKE SYNAD 20560000 * 20580000 ISLPA72 EQU * 20600000 LA R2,ISLIOBB C(R2)=A(IOBB) 20620000 TM 0(R3),X'04' TEST BIT 5 (C-BIT) 20640000 BC 7,ISLPA60 BR IF 1 - C-BIT ON 20660000 * 20680000 * C-BIT OFF 20700000 LA R2,ISLIOBA C(R2)=A(IOBA) 20720000 * 20740000 * TEST IF NEXT BUFFER TO BE FILLED WILL BE EOT (AND EOC) 20760000 * IF EOT, TURN ON T-BIT IF EOC, TURN ON C-BIT 20780000 * 20800000 ISLPA80 CR R7,R5 TEST REG C VS REG A 20820000 BNE ISLPA84 B IF NOT EOT 20840000 * 20860000 * NEXT BUFFER EOT 20880000 OI 0(R3),X'08' TURN T-BIT ON (STATUS BIT 4) 20900000 ST R6,ISLFXWK1 C(FXWK1)= CCHH FROM REG B 20920000 ISLPA8A NC ISLFXWK1+3(1),DCBFIRSH+3 REDUCE TO TRACK FROM REG B 20940000 ISLPA8B CLC DCBLDT+1(1),ISLFXWK1+3 H OF LDT VS H FROM REG B 20960000 BNE ISLPA84 B IF NOT LDT 20980000 OI 0(R3),X'04' TURN C-BIT ON (STATUS BIT 5) 21000000 * 21020000 * ENTER NEW COUNT IN BUFFER USING REG A AND REG B AND UPDATE LPDA 21040000 * 21060000 ISLPA84 L R3,0(R3) C(R3)=C(SLOT S)=A(NEXT BUFFR) 21080000 LA R3,0(R3) 21100000 ST R6,ISLFXWK2 STORE CCHH FROM REG B 21120000 MVC 0(4,R3),ISLFXWK2 21140000 STC R5,4(R3) STORE R FROM REG A 21160000 MVC DCBLPDA+3(5),0(R3) STORE CCHHR FROM BUF IN LPDA 21180000 L R14,ISLF9WK1 RESTORE R14 FOR RETURN TO FX 21200000 BR R14 *EXIT 21220000 *---------------------------------------------------------------------- 21240000 * 21260000 * LAST BUFFR FILLED EOT 21280000 * SET REG 7 (REG C) = HIRPD, NEXT TRACK CANT BE SHARED 21300000 * 21320000 ISLPA20 IC R7,DCBHIRPD NOT A SHARED TRACK, C(R7)=HIRPD 21340000 ST R6,ISLFXWK1 C(FXWK1)=CCHH FROM REG B 21360000 * 21380000 * TEST FOR OUT-OF-SPACE 21400000 * 21420000 CLC DCBLPDA(1),DCBMSWA CURRENT M VS HI M 21440000 BNE ISLPA21 B IF NOT HI PRIME M 21460000 CLC ISLFXWK1(4),DCBMSWA+3 CURRENT CCHH VS HI CCHH 21480000 BL ISLPA21 BR LESS THAN HIGH PRIME A27810 21490019 * CCHH A27810 21500019 TM IOBFLAGS,X'10' TEST FOR CLOSE 21520000 BO ISLPA21 IF CLOSE, GET COUNT 17925 21540000 * ELSE OUT OF SPACE 17925 21560000 * *---------OUT-OF-SPACE---------* 21600000 ISLPA205 EQU * 21620000 OI DCBEXCD1,X'20' SET EXCD1 BIT 2 ON = SPACE ERR 21640000 B ISLFX05 B TO TAKE SYNAD 21660000 * 21680000 * TEST IF LAST BUFFER FILLED WAS EOT AND EOC 21700000 * 21720000 ISLPA21 EQU * 21740000 EX R0,ISLPA8A EXECUTE NC 21760000 EX R0,ISLPA8B EXECUTE CLC 21780000 BE ISLPA30 B IF EOT AND EOC 21800000 * 21820000 * EOT NOT EOC 21840000 * STEP REG B TO NEXT HH AND SET REG A TO R = 1 21860000 * 21880000 A R6,ISLONEF C(R6)=CCHH+1 21900000 L R5,ISLONEF C(R5)=000R, R = 1 21920000 B ISLPA50 21940000 * 21960000 * 21980000 * EOT,EOC 22000000 * NEXT BUFFER TO BE FILLED WILL BE THE 1ST BUFFR ON A NEW CYLINDER 22020000 * 22040000 * TEST IF SHARED TRACKS 22060000 * 22080000 ISLPA30 CLI DCBHIRSH,X'00' HIRSH VS 0 22100000 BE ISLPA31 B IF 0, NOT SHARED 22120000 * 22140000 * SHARED TRACKS 22160000 * IF SHARED TRACKS, 1ST PRIME DATA ON NEW CYLINDER IS ON A SHARED TRACK 22180000 * 22200000 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 22220000 OI 0(R3),X'02' TURN PF-BIT ON (STATUS BIT 6) 22240000 * 22260000 * SET REG 7 (REG C) = HIRSH 22280000 * 22300000 IC R7,DCBHIRSH SHARED TRACK NEXT, C(R7)=HIRSH 22320000 * 22340000 * TEST IF LAST BUFFER FILLED WAS EOT, EOC, AND EOE 22360000 * 22380000 ISLPA31 L R8,DCBDEBAD C(R8)=A(DEB) 22400000 L R3,DEBFPEAD C(R3)=A(1ST PRIME EXTENT ENTRY) 22420000 LA R3,0(R3) 22440000 L R4,DCBLPDA C(R4)=MBBC 22460000 SRL R4,24 C(R4)=000M 22480000 BCTR R4,0 C(R4)=M-1 22500013 SLL R4,4 C(R4)=000M-1 X 16 (USE AS INDX) 22520000 L R8,12(R4,R3) C(R8)=HHXX-END HH OF CURR EXTNT 22540000 SRL R8,16 C(R8)=00HH 22560000 CLI DCBDEVT,X'02' IS IT 2301 22580000 BE ISLPA32 BR IF 2301 22600000 CLI DCBDEVT,X'05' IS IT 2321 22620000 BE ISLPA321 BRANCH IF 2321 22640000 * 22660000 L R8,8(R4,R3) C(R8)=END HHCC OF CURR EXTENT 22680000 SLL R8,16 C(R8)=CC00 22700000 SRL R8,16 C(R8)=00CC=END CC OF EXTENT 22720000 LR R5,R6 C(R5)=CCHH 22740000 SRL R5,16 C(R5)=00CC=CC JUST FILLED 22760000 CR R8,R5 COMPARE FOR LAST CYLINDER 22780000 BH ISLPA33 B IF END CC IS HIGH 22800000 * 22820000 * EOT, EOC, AND EOE 22840000 * 22860000 * SET REG 6 (REG B) TO CC FROM NEXT EXTENT 22880000 * 22900000 LA R4,16(R4) C(R4)=MX16 INDEX TO NEXT EXTNT 22920000 L R8,4(R4,R3) C(R8)=STR BBCC OF NEXT EXTENT 22940000 SLL R8,16 C(R8)=CC00 22960000 LR R6,R8 C(R6)=CC00, HH SET LATER 22980000 * 23000000 * SET M IN DCBLPDA = M+1 23020000 * 23040000 SRL R4,4 C(R4)=000M 23060000 A R4,ISLONEF C(R4)=000M+1 (M=1 FOR EXTENT 0) 23080000 STC R4,DCBLPDA C(LPDA)=000M+1 23100000 * 23120000 * SET STATUS BIT-3 ON = NEW EXTEN STARTS WITH THIS BUFFR 23140000 * 23160000 L R3,IOBPTRB C(R3)=PTR B = A(NEXT SLOT) OR- 23180000 LA R3,0(R3) C(R3)=A(STATUS BITS) 23200000 OI 0(R3),X'10' TURN STATUS BIT-3 ON 23220000 * 23240000 B ISLPA34 23260000 * 23280000 *END OF EXTENT TEST FOR 2301 AND 2321 23300000 * 2301 - FIND CYL-ADDR OF END OF EXTENT 23320000 ISLPA32 EQU * 23340000 N R8,CONSF8 C(R8)=000H REDUCED TO CYL ADDR 23360000 LR R5,R6 C(R5)=CCHH FROM REG B 23380000 N R5,CONSF8 C(R5)=000H REDUCE TO CYL ADDR 23400000 BC 15,ISLPA322 23420000 * 2321 - FIND CYL-ADDR OF END OF EXTENT 23440000 ISLPA321 EQU * 23460000 L R5,8(R4,R3) C(R5)=XXCC CC FROM END-ADDR 23480000 SLL R5,16 C(R5)=CC00 23500000 OR R8,R5 C(R8)=CCHH ADDR END OF EXTENT 23520000 IC R8,CONSF8 C(R8)=CCH0 ZERO TRACK ADDR 23540000 * FIND ADDR OF CYL JUST FILLED - REG B 23560000 LR R5,R6 C(R5)=CCHH FROM REG B 23580000 IC R5,CONSF8 C(R5)=CCH0 ZERO TRACK ADDR 23600000 * 23620000 ISLPA322 EQU * 23640000 CR R8,R5 COMPARE EOE AND CURR CYL. 23660000 BC 13,ISLPA327 BR IF EOE LO OR EQ - AT EOE 23680000 * 23700000 * NOT END OF EXTENT - SET REG B TO NEXT CYL, TAKE TRACK FROM FIRSH 23720000 * 23740000 CLI DCBDEVT,X'05' IS IT 2321 23760000 BC 8,ISLPA323 BRANCH IF 2321 23780000 * 2301 23800000 LA R5,8(R5) ADD 8 TRKS FOR NEXT LOGCL CYL 23820000 STC R5,ISLFXWK1 C(FXWK1)=H CYL ONLY (CYL+1) 23840000 OC ISLFXWK1(1),DCBFIRSH+1 SET TRACK FROM FIRSH 23860000 IC R5,ISLFXWK1 C(R5)=CCHH NXT CYL & FIRSH TRK 23880000 BC 15,ISLPA32E BR TO SET REG B 23900000 * 2321 23920000 ISLPA323 EQU * 23940000 SRL R5,8 C(R5)=0CCH ADDR FROM REG B 23960000 ST R5,ISLFXWK1 C(FXWK1)=0CCH 23980000 CLI ISLFXWK1+3,X'04' TEST FOR LAST CYL IN STRIP 24000000 BC 8,ISLPA325 BRANCH IF EQ - AT END OF STRIP 24020000 LA R5,1(R5) NOT LAST CYL - SET TO NEXT 24040000 SLL R5,8 C(R5)=CC(H+1)0 24060000 * 24080000 ISLPA324 EQU * 24100000 IC R5,DCBFIRSH+1 TAKE TRACK ADDR FROM FIRSH 24120000 ISLPA32E EQU * 24140000 LR R6,R5 SET REG B FOR NEW CYLINDER 24160000 BC 15,ISLPA35 BR TO SET R5 TO R FROM FIRSH 24180000 * 24200000 ISLPA325 EQU * 24220000 CLI ISLFXWK1+2,X'09' TEST FOR LAST STRIP IN SUBCELL 24240000 BC 8,ISLPA326 BR IF EQ - AT END OF SUBCELL 24260000 SRL R5,8 C(R5)=00CC 24280000 LA R5,1(R5) NOT LAST STRIP - ADD 1 FOR NXT 24300000 SLL R5,16 C(R5)=C(C+1)00 24320000 BC 15,ISLPA324 24340000 * 24360000 ISLPA326 EQU * 24380000 SRL R5,16 C(R5)=000C 24400000 LA R5,1(R5) ADD 1 FOR NEXT SUBCELL 24420000 SLL R5,24 C(R5)=(C+1)000 24440000 BC 15,ISLPA324 24460000 * 24480000 * END OF EXTENT - SET REG B TO NEXT EXTENT 24500000 * 24520000 ISLPA327 EQU * 24540000 LA R4,16(R4) C(R4)=000(MX16)INDX TO NXT EXT 24560000 L R5,8(R4,R3) C(R5)=HHXX START OF NEXT EXTNT 24580000 L R8,4(R4,R3) C(R8)=BBCC START OF NEXT EXTNT 24600000 * UPDATE M AND BB IN DCBLPDA 24620000 ST R8,ISLFXWK1 C(FXWK1)=BBCC 24640000 SRL R4,4 C(R4)=000M 24660000 A R4,ISLONEF C(R4)=000M+1 M=1 FOR EXTENT 0 24680000 STC R4,DCBLPDA C(LPDA)=MXXXXXXX 24700000 MVC DCBLPDA+1(4),ISLFXWK1 C(LPDA)=MBBXXXXX 24720000 * SET REG B FOR NEXT EXTENT 24740000 SLL R8,16 C(R8)=CC00 NEXT EXTENT 24760000 SRL R5,16 C(R5)=00HH NEXT EXTENT 24780000 OR R8,R5 C(R8)=CCHH START OF NEXT EXTNT 24800000 TM DCBDEVT,X'02' IS IT 2301 24820000 BC 1,ISLPA328 BRANCH IF 2301 24840000 * 2321 24860000 IC R8,DCBFIRSH+1 SET TRACK FROM FIRSH 24880000 BC 15,ISLPA329 BR TO SET STATUS BIT-3 24900000 * 2301 24920000 ISLPA328 EQU * 24940000 ST R8,ISLFXWK1 24960000 NI ISLFXWK1+3,X'F8' C(FXWK1+3)=XXXXX000 24980000 OC ISLFXWK1+3(1),DCBFIRSH+1 C(FXWK1+3)=XXXXXYYY FIRSH TRK 25000000 IC R8,ISLFXWK1+3 C(R8)=CCHH START OF DATA IN 25020000 * NEXT EXTENT 25040000 ISLPA329 EQU * 25060000 LR R6,R8 25080000 * SET STATUS BIT-3 ON - NEW EXTENT STARTS 25100000 * WITH THIS BUFFER 25120000 L R3,IOBPTRB C(R3)=PTR B=A(NEXT SLOT) OR-- 25140000 LA R3,0(R3) C(R3)=A(STATUS BITS) 25160000 OI 0(R3),X'10' TURN ON BIT 3 25180000 BC 15,ISLPA35 BR TO SET R FROM FIRSH 25200000 * 25220000 * SET REG 6 (REG B) TO CC +1 EOT, EOC, NOT EOE 25240000 * 25260000 ISLPA33 A R5,ISLONEF C(R5)=00CC+1, PREVIOUS CC +1 25280000 SLL R5,16 C(R5)=CC00 25300000 LR R6,R5 C(R6)=CC00, HH SET BELOW 25320000 * 25340000 * SET REG 6 (REG B) TO HH FROM FIRSH 25360000 * 25380000 ISLPA34 ST R6,ISLFXWK1 C(FXWK1)=CC00 25400000 MVC ISLFXWK1+2(2),DCBFIRSH C(FXWK1)=CCHH, HH FROM FIRSH 25420000 L R6,ISLFXWK1 C(R6)=CCHH 25440000 * 25460000 * SET REG 5 (REG A) TO R FROM FIRSH 25480000 * 25500000 ISLPA35 EQU * 25520000 SR R5,R5 25540000 IC R5,DCBFIRSH+2 C(R5)=000R, R FROM FIRSH 25560000 * 25580000 * PREFORMAT SHARED TRACK OF NEW CYLINDER IF NECESSARY 25600000 * 25620000 TM DCBOPTCD,X'08' TEST OPTCD BIT-4 FOR CYL OVFL 25640000 BC 1,ISLPA40 B IF ON = CYL OVFL 25660000 CLI DCBHIRSH,X'00' TEST HIRSH VS 0 8M800 25680018 BE ISLPA50 B IF 0, NOT SHARED 25700000 * 25720000 * SHARED TRACKS - PREFORMAT 25740000 * 25760000 * INITIALIZE CP19 25780000 ***************** 25800000 * 25820000 ISLPA40 LA R2,ISLIOBC C(R2)=A(IOBC) 25840000 * 25860000 * BE SURE CP19 NOT IN USE 25880000 * 25900000 L R4,IOBECBAD C(R4)=A(ECB) 25920000 TM 0(R4),X'40' TEST ECB BIT 1 (C-BIT) 25940000 BC 1,ISLPA41 B IF 1, I/O COMPLETE-DONT WAIT 25960000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 25980000 LR R3,R1 SAVE R1 26000000 LR R1,R4 C(R1)=A(ECB) 26020000 LR R4,R0 SAVE R0 26040000 WAIT ECB=(1) WAIT 26060000 LR R0,R4 RESTORE R0 26080000 LR R1,R3 RESTORE R1 26100000 ISLPA41 STM R2,R11,ISLVRSAV+28 SAVE REGS 2-11 26120000 * 26140000 * 1. SET IOBC+32 TO NEW CC AND NEW M IF ANY 26160000 * 26180000 ST R6,ISLFXWK2 C(FXWK2)=CCHH FROM REG B 26200000 MVC 32(3,R2),DCBLPDA MOVE MBB FROM LPDA 26220000 MVC 35(3,R2),ISLFXWK2 MOVE CCH FROM REG B 22619 26240018 CLI DCBDEVT,X'02' TEST FOR 2301 26260000 BC 7,ISLPA41A ITS NOT, BRANCH 26280000 STC R6,ISLFXWK1 26300000 NI ISLFXWK1,X'F8' REDUCE TO CYL. BOUNDARY 26320000 NI 38(R2),X'07' REDUCE TO TRK BOUNDARY 26340000 OC 38(1,R2),ISLFXWK1 COMBINE 2301 CYL. & TRK 26360000 * HR IS SET UP BY CE APPENDAGE 26380000 * 26400000 * 2. SET CM27 TO NEW CC AND NEW M IF ANY 26420000 * 26440000 ISLPA41A EQU * 26460000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 26480000 L R10,16(R10) C(R10)=A(CP19) 26500000 USING CM1,R10 ADDRESSABILITY CP19 S20201 26510020 MVC CM27(L3),DCBLPDA MOVE MBB FROMLPDA S20201 26520020 MVC CM27+L3(L4),ISLFXWK2 MOVE IN CCHH S20201 26530020 DROP R10 S20201 26540020 * 26560000 * 3. SET UP AREA Z WITH NEW CC 26580000 * 26600000 LA R9,ISLAREAZ C(R9)=A(AREA Z) 26620000 LA R3,10 C(R3) = 10 = COUNT 26640000 LA R4,6(R9) C(R4)=A(Z+6) 26660000 ISLPA42 MVC 0(4,R4),ISLFXWK2 STORE CCHH IN Z 26680000 A R4,ISL8 STEP Z 26700000 BCT R3,ISLPA42 LOOP 26720000 * 26740000 * 26760000 * EXECUTE CP19 - PREFORMAT NEW CYLINDER 26780000 *************************************** 26800000 * 26820000 LM R2,R11,ISLVRSAV+28 RESTORE REGS 2-11 26840000 LA R13,ISLVRSAV C(R13)=A(VRSAV) 26860000 LR R3,R0 SAVE R0 26880000 LR R4,R1 SAVE R1 26900000 EXCP IHAIOB EXECUTE CHANNEL PROGRAM 26920000 LR R0,R3 RESTORE R0 26940000 LR R1,R4 RESTORE R1 26960000 LA R2,ISLIOBA C(R2)=A(IOBA) 26980000 * 27000000 B ISLPA50 27020000 * 27040000 *---------------------------------------------------------------------- 27060000 * 27080000 EJECT 27100000 *********************************************************************** 27120000 * CHART PB - SET FBW * 27140000 *********************************************************************** 27160000 * 27180000 * 27200000 * C(R7)=A(LAST SLOT SCHED) AS IT WAS FROZEN BEFORE I/O 27220000 * SET REG 8 = NO OF BUFFRS NEEDED TO COMPLETE TRACK - REG C 27240000 * 27260000 ISLPB01 L R6,0(R7) C(R6)=A(LAST BUFF) 27280000 LA R6,0(R6) 27300000 SR R3,R3 27320000 SR R8,R8 27340000 IC R3,4(R6) C(R3)=LAST R 27360000 * 27380000 * TEST IF SHARED TRACKS ARE USED 27400000 * 27420000 IC R8,DCBHIRPD C(R8)=HIRPD 27440000 CLI DCBHIRSH,X'00' HIRSH VS 0 27460000 BE ISLPB02 B IF 0, NO SHARED TRACKS 27480000 * 27500000 * TEST IF CURRENT TRACK SHARED 27520000 * 27540000 ISLPB01A MVC ISLFXWK1(1),3(R6) H (TRK BYTE) FROM BUFFER CNT 27560000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 27580000 EX R0,ISLPA01B H OF FIRSH VS H OF BUFFER CNT 27600000 BE ISLPB03 B IF EQUAL, TRACK SHARED 27620000 * 27640000 * TEST IF LAST BUFF WAS EOC, IF SO- NEXT TRACK IS SHARED 27660000 * 27680000 TM 0(R7),X'04' TEST S BIT 5 VS 1 (C-BIT) 27700000 BC 1,ISLPB05 B IF 1, EOC 27720000 * 27740000 * 1. SHARED TRACKS- 27760000 * CURR TRACK NOT SHARED AND NOT EOC 27780000 * 2. SHARED TRACKS NOT USED- 27800000 * 27820000 ISLPB02 EQU * 27840000 TM 0(R7),X'08' TEST S BIT 4 VS 1 (T-BIT) 27860000 BC 1,ISLPB06 B IF 1, EOT 27880000 B ISLPB06A 27900000 * 27920000 * 3. SHARED TRACKS- 27940000 * CURR TRACK SHARED 27960000 * 27980000 ISLPB03 TM 0(R7),X'08' TEST S BIT 4 VS 1 (T-BIT) 28000000 BC 1,ISLPB06 B IF 1, EOT 28020000 IC R8,DCBHIRSH C(R8)=HIRSH 28040000 B ISLPB06A 28060000 * 28080000 * 4. SHARED TRACKS- 28100000 * CURR TRACK NOT SHARED, BUT EOC 28120000 * 28140000 ISLPB05 IC R8,DCBHIRSH C(R8)=HIRSH 28160000 IC R3,DCBFIRSH+2 C(R3)=FIRSH R 28180000 A R8,ISLONEF C(R8)=HIRSH-FIRSH R +1 28200000 * 28220000 ISLPB06A CR R8,R3 END OF TRACK? A41405 28225021 BNE SUBTR NO, CALCULATE FBW A41405 28230021 IC R8,DCBHIRPD YES,LAST REC UNSHARED A41405 28235021 * TRK A41405 28240021 B ISLPB06 STORE HIRPD IN ISLFBW A41405 28245021 SUBTR SR R8,R3 CALCULATE FBW A41405 28250021 * REG C = HI R IF FULL TRACK TO BE WRITTEN 28260000 * REG C = HI R - R IF PARTIAL TRACK TO BE WRITTEN 28280000 * R = NO. OF BUFFERS WRITTEN SO FAR ON THIS TRACK 28300000 * 28320000 ISLPB06 ST R8,ISLFBW R8 = REG C, C(FBW)=C(REG C) 28340000 * 28360000 * TEST NEW FBW VS BUFNO AND ADJUST FBW IF NECESSARY 28380000 * 28400000 LA R4,1 C(R4)=1 28420000 CLC ISLFBW+3(1),ISLBUFNO TEST FBW VS BUFNO 28440000 BL ISLPB20 B IF FBW LOW 28460000 * 28480000 * FBW HI OR EQ - 28500000 * 28520000 CLC ISLBUFNO(1),ISLONEF+3 TEST BUFNO VS 1 28540000 BE ISLPB10 B IF BUFNO = 1 28560000 * 28580000 IC R4,ISLBUFNO BUFNO NOT 1, C(R4)=BUFNO 28600000 BCTR R4,0 C(R4)-BUFNO-1 P4701 28620000 * 28640000 * BUFNO=1 28660000 ISLPB10 EQU * 28680000 ST R4,ISLFBW C(FBW)=1 28700000 * 28720000 ISLPB20 B ISLFY41 *EXIT 28740000 EJECT 28760000 *********************************************************************** 28780000 * CHART F8 - INITIALIZE CP18 FOR CURRENT BUFFER SET * 28800000 *********************************************************************** 28820000 * 28840000 * 28860000 * SET OFFST AND D ACCORDING TO RECFM (IOBA FLAGS BIT 7) 28880000 * 28900000 ISLF801 L R10,DCBWKPT6 C(R10)=A(VPTRS) 28920000 * 29060000 * CALC FSTBF = # OF SLOTS SLOT X IS FROM SLOT #1 IN BUF CTRL TABLE 29080000 * 29100000 ISLF803 L R3,IOBPTRA C(R3)=C(PTR A)=A(SLOT X) 29120000 LA R3,0(R3) 29140000 LA R4,IOBS C(R4)=A(SLOT #1) 29160000 SR R3,R4 C(R3)= # OF BYTES X IS FROM #1 29180000 SRA R3,2 DIV BY 4, C(R3)= DIFF IN SLOTS 29200000 ST R3,ISLFSTBF C(FSTBF)= # OF SLOTS FROM #1 29220000 * THAT FIRST BUF SCHED IS 29240000 * 29260000 * CALC ADDR OF WR CKD X (SCHED TO WR FIRST) FOR TIC IN CP18 29280000 * 29300000 L R5,ISLOFFST C(R4+R5)=OFFST 29320000 MR R4,R3 FSTBF X OFFST, C(R5)= THE # OF 29340000 * BYTES WR CKD X IS FROM THE 29360000 * FIRST BYTE OF WR CKD #1 29380000 L R10,12(R10) C(R10)=A(CP18) 29400000 LA R4,24(R10) C(R4)=A(WR CKD #1) 29420000 AR R4,R5 C(R4)=A(WR CKD X) 29440000 IC R6,16(R10) C(R6)=TIC OP CODE AT CP18+16 29460000 ST R4,16(R10) C(CP18+16)=A(WR CKD X),4 BYTES 29480000 STC R6,16(R10) C(CP18+16)=TIC OP CODE,1 BYTE 29500000 * 29880000 * CALC LSTBF = FBW SLOTS FROM FSTBF -1, MAY WRAPAROUND 29900000 * 29920000 L R3,ISLFSTBF C(R3)=# OF SLOTS FROM SLOT #1 29940000 A R3,ISLFBW C(R3)= FSTBF + FBW 29960000 BCTR R3,0 C(R3)=FSTBF + FBW-1 = LSTBF 29980000 SR R4,R4 C(R4)= 0000 30000000 IC R4,ISLBUFNO C(R4)=NO OF BUFFRS 30020000 CR R3,R4 LSTBF VS BUFNO, TEST WRAPAROUND 30040000 BL ISLF806 B IF NO WRAPAROUND, LSTBF OK 30060000 SR R3,R4 C(R3)=LSTBF-BUFNO = LSTBF 30080000 * LSTBF SET FOR WRAPAROUND 30100000 ISLF806 ST R3,ISLLSTBF C(LSTBF)= # OF SLOTS FROM #1 30120000 * THAT LAST BUF SCHED IS 30140000 L R5,ISLOFFST C(R4+R5)=OFFST 30240000 MR R4,R3 LSTBF X OFFST, C(R5)= THE # OF 30260000 * BYTES LAST WR CKD TO BE 30280000 * EXECUTED IS FROM THE FIRST 30300000 * BYTE OF WR CKD #1 30320000 AR R5,R10 * 13334 30324016 IC R4,ISLBUFNO * C(6)=BUFFER NUMBER 13334 30328016 LR R3,R10 * C(R3)=A(CP18) 13334 30332016 ISLF811 AL R3,ISLOFFST *C(R3)=A OF 1ST WRT. COMD 13334 30336016 MVC 17(3,R3),21(R3) * RESTORE ORIGN. TIC ADDR.13334 30340016 BCT R4,ISLF811 * LOOP , UNTIL ALL DONE 13334 30344016 TM IOBFLAGS,X'01' * RKP=0 ? 13334 30348016 BC 1,ISLF808 * BRANCH IF RKP=0 13334 30352016 MVC 49(3,R5),13(R10) * SET TIC BRANCH TO WRT.CK13334 30356016 MVC ISLKEYAD+1(3),33(R5) * SET LAST WRITE KEY ADDR.13334 30360016 ISLF809 L R5,12(R10) * C(R5)=A(TIC CCW) 13334 30364016 L R3,ISLFBW * C(R3)=NO. OF BUF. TO WRT13334 30368016 L R4,20(R10) * C(R4)=A(READ BACK CCW) 13334 30372016 ISLF807 SL R4,ISL8 * C(R4)=A(FIRST READ CCW) 13334 30376016 BCT R3,ISLF807 * LOOP,IF MORE THAN 1 BUFR13334 30380016 ST R4,K24(R5) * C(R4)=A(FIRST READ S20201 30382020 * CCW) S20201 30384020 OI K24(R5),TIC * RESTORE TIC OP CODE S20201 30388020 B ISLF901 13334 30392016 * 13334 30396016 ISLF808 MVC 33(3,R5),13(R10) * SET TIC BRANCH TO WRT.CK13334 30400016 L R4,24(R5) * C(R4)=A(CKD OF LAST WRT)13334 30404016 LA R4,8(R4) * C(R4)=A(KEY OF LAST WRT)13334 30408016 ST R4,ISLKEYAD * SET UP LAST KEY ADDR. 13334 30412016 B ISLF809 * RETURN TO MAIN LINE 13334 30416016 EJECT 30440000 *********************************************************************** 30460000 * CHART F9 - INITIALIZE CP20 FOR CURRENT TRACK * 30480000 *********************************************************************** 30500000 * 30520000 USING ISLY,R9 30540000 * 30560000 * F9 HOUSEKEEPING 30580000 * 30600000 ISLF901 L R6,IOBPTRA C(R6)=C(PTR A)=A(SLOT X) 30620000 L R6,0(R6) C(R6)=C(SLOT X)=A(1ST BUF) 30640000 LA R6,0(R6) 30660000 MVC ISLFXWK1(4),1(R6) C(FXWK1)=CHHR OF CNT IN 1ST BUF 30680000 L R7,ISLFXWK1 C(R7)=CHHR 30700000 BCTR R7,0 C(R7)=CCHR-1 30720000 * 30740000 * TEST LAST BUFFER FOR END OF TRACK (T-BIT ON) 30760000 * 30780000 L R3,ISLLSTBF C(R3)=LSTBF 30800000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 30820000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT) 30840000 TM 0(R3),X'08' TEST S BIT 4 VS 1 (T-BIT) 30860000 BC 1,ISLF902 B IF T-BIT ON 30880000 * 30900000 * T-BIT OFF, NO CP20 YET 30920000 * 30940000 * SET IOBA+32 (IOBDADAD) = COUNT OF 1ST BUF SCHED, R=R-1 FOR SRCH ID 30960000 * 30980000 MVC IOBDADAD+3(1),0(R6) C(IOBA+35)=C FROM 1ST BUF 31000000 ST R7,IOBDADAD+4 C(IOBA+35)=CCHHR WITH R=R-1 31020000 IC R4,IOBCPSAD SAVE SIOCC 31040000 ST R10,IOBCPSAD C(CPSAD)=CP18 START ADR 31060000 STC R4,IOBCPSAD RESTORE SIOCC 31080000 * 31100000 * SET CL1 IN CP18 TO REFERENCE IOBA+35 31120000 * 31140000 LA R3,IOBDADAD+3 C(R3)=A(IOBA+35) 31160000 O R3,SCHCOM *COMBINE SCH OP CODER. 13334 31180016 ST R3,0(R10) *UPDATE CP18 SCH COMD. 13334 31200016 ST R3,CL1-CL0(R5) *UPDATE CP18 WRT. CK. S20201 31210020 * SCH S20201 31220020 B ISLFY21 * RETURN TO FYRT. CK. SCH 13334 31240016 * 31280000 * T-BIT ON, INITL CP20 31300000 * CLEAR TWO SW 31320000 * 31340000 ISLF902 NI IOBFLAGS,X'FB' SET FLAGS BIT 5 = 0 (TWOSW OFF) 31360000 OI ISLIXLT,X'08' SET IXLT LEV1 BIT-4 ON- TRK IX 31380000 * 31780000 * SET CP20 LINE CQ14A = CCHHR FROM COUNT OF 1ST BUF SCHED, R=R-1 31800000 * MBB FROM IOBA+32 (IOBDADAD) 31820000 * 31840000 LR R5,R10 C(R5)=A(CP18,CL1) 31860000 * 31880000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 31900000 L R10,20(R10) C(R10)=A(CP20) 31920000 USING CQ1,R10 ADDRESSABILITY CP20 S20201 31930020 MVC 112(3,R10),IOBDADAD C(CQ14A)=MBB FROM IOBA+32 31940000 MVC 115(1,R10),0(R6) C(CQ14A)=C FROM 1ST BUF 31960000 ST R7,116(R10) C(CQ14A)=MBBCCHHR WITH R=R-1 31980000 * 32120000 * SET CL1 IN CP18 TO REFERENCE CQ14A+3 32140000 * 32160000 LA R3,115(R10) C(R3)=A(CQ14A+3) 32180000 O R3,SCHCOM *COMBINE SCH OP CODER. 13334 32190016 ST R3,0(R5) *UPDATE CP18 SCH COMD. 13334 32200016 L R4,12(R5) *C(R4)=A(SCHCMD.OF CP18) 13334 32210016 ST R3,K8(R4) *UPDATE SCH CMD. ADDR. S20201 32230020 * 32260000 * TEST COUNT OF 1ST BUFFR SCHED, HH VS FIRSH HH, FOR NEW CYLINDER 32280000 * 32300000 EX R0,ISLPB01A H FROM COUNT 32320000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 32340000 EX R0,ISLPA01B COUNT VS FIRSH 32360000 BE ISLF909 B IF EQUAL, NEW CYLINDER 32380000 * 32400000 * TEST IF LAST IX ENTRY IS ON A SHARED TRACK 32420000 * 32440000 CLI DCBHIRSH,X'00' HIRSH VS 0 32460000 BE ISLF905 B IF 0, NOT SHARED 32480000 ISLF904A MVC ISLFXWK1(1),ISLOCNT+3 H FROM OVFLO COUNT 32500000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 32520000 EX R0,ISLPA01B OVFLO CNT VS FIRSH 32540000 BNE ISLF905 B IF NOT EQUAL, NOT SHARED 32560000 * SHARED TRACK 32580000 * 32600000 * CALC - NO ENTRIES REMAINING = (FIRSH-1) - LAST IX ENTRY, R-R 32620000 * 32640000 MVC ISLF9WK1+3(1),DCBFIRSH+2 32660000 L R3,ISLF9WK1 C(R3)=000R FROM FIRSH 32680000 BCTR R3,0 C(R3)=000R-1 FROM FIRSH 32700000 * = R OF LAST IX ENT ON TRK 32720000 B ISLF906A 32740000 * NOT A SHARED TRACK 32760000 * 32780000 * CALC - NO ENTRIES REMAINING = HIRT - LAST IX ENTRY, R-R 32800000 * 32820000 ISLF905 MVC ISLF9WK1+3(1),ISLHIRT 32840000 L R3,ISLF9WK1 C(R3)=000R FROM HIRT 32860000 * = R OF LAST IX ENTRY ON TRACK 32880000 ISLF906A EQU * 32900000 MVC ISLF9WK1+3(1),ISLOCNT+4 32920000 * = R OF LAST IX ENTRY 32940000 S R3,ISLF9WK1 C(R3)=HIRT-OCNT 32960000 ST R3,ISLNOENT C(NOENT)=HIRT-OCNT 32980000 * 33000000 * TEST NO ENTRIES 33020000 * 33040000 ISLF906 EQU * 33060000 LTR R3,R3 TEST NOENT VS 0 33080000 BC 8,ISLF908 B IF ZERO - END OF IX TRACK 33100000 C R3,ISLTWOF TEST NOENT VS 2 33120000 BL ISLG101 BR LOW - NOENT=1 33140000 BNE ISLF907 B NOT 2, ROOM FOR MORE THAN 2 33160000 * 33180000 * NO ENTRIES = 2, SET TWO SW ON 33200000 * 33220000 OI IOBFLAGS,X'04' SET FLAGS BIT 5 = 1 (TWOSW ON) 33240000 * 33260000 * NO ENTRIES = 2 OR MORE, BUMP R IN NORMAL AND OVERFLOW COUNTS 33280000 * 33300000 ISLF907 SR R3,R3 33320000 IC R3,ISLOCNT+4 C(R3)=R FROM OCNT 33340000 LA R3,1(R3) C(R3)=R+1 33360000 STC R3,ISLNCNT+4 C(NCNT)=CCHHR, R=R+1 33380000 LA R3,1(R3) C(R3)=(R+1)+1=R+2 33400000 STC R3,ISLOCNT+4 C(OCNT)=CCHHR, R=R+2 33420000 MVC ISLNCNT+2(2),ISLOCNT+2 C(NCNT)=CCHHR, HH FROM OCNT 33440000 B ISLG201 33460000 * 33480000 * NO ENTRIES = 0, BUMP HH IN NORMAL AND OVERFLOW COUNTS AND SET R = 1 33500000 * 33520000 ISLF908 L R3,ISLNCNT C(R3)=CCHH FROM NCNT 33540000 A R3,ISLONEF C(R3)=CCHH+1 33560000 ST R3,ISLNCNT C(NCNT)=CCHH+1 33580000 B ISLF9095 33600000 * 33620000 * NEW CYLINDER, NORMAL AND OVERFLOW COUNTS RESET USING 1ST BUFFR SCHED 33640000 * 33660000 ISLF909 EQU * 33680000 MVC ISLNCNT(4),0(R6) C(NCNT)=CCHH FROM 1ST BFR 33700000 * SET TRACK=0 33720000 CLI DCBDEVT,X'02' IS IT 2301 33740000 BC 8,ISLF9091 BR IF EQUAL - 2301 33760000 CLI DCBDEVT,X'05' IS IT 2321 33780000 BC 8,ISLF9093 BR IF EQUAL - 2321 33800000 * 33820000 MVC ISLNCNT+2(2),ISLZEROF C(NCNT)=CCHH WITH HH=00 33840000 ISLF9095 EQU * 33860000 MVI ISLNCNT+4,X'01' C(NCNT)=CCHHR WITH R=1 33880000 MVC ISLOCNT(4),ISLNCNT C(OCNT)=CCHH FROM NCNT 33900000 MVI ISLOCNT+4,X'02' C(OCNT)=CCHHR WITH R=2 33920000 B ISLG201 33940000 * 33960000 ISLF9091 EQU * 2301 33980000 NI ISLNCNT+3,X'F8' SET TRACK=0 34000000 B ISLF9095 BR TO PICK UP R,ETC. 34020000 * 34040000 ISLF9093 EQU * 2321 34060000 MVI ISLNCNT+3,X'00' SET TRACK=0 34080000 B ISLF9095 BR TO PICK UP R,ETC. 34100000 EJECT 34120000 * * 34140000 * CHART G1 - CONTINUATION OF CHART F9, INDEX ENTRIES SPLIT * 34160000 *********************************************************************** 34180000 * 34200000 * NO ENTRIES = 1, BUMP R IN NORMAL COUNT AND HH IN OVERFLOW COUNT 34220000 * SET R = 1 IN OVERFLOW COUNT 34240000 * 34260000 ISLG101 IC R3,ISLNCNT+4 C(R3)-R FROM NCNT P4701 34280000 LA R3,2(0,R3) R=R+2 P4701 34300000 STC R3,ISLNCNT+4 C(NCNT)=CCHHR, R=R+2 34340000 L R3,ISLOCNT C(R3)=CCHH FROM OCNT 34360000 A R3,ISLONEF C(R3)=CCHH+1 34380000 ST R3,ISLOCNT C(OCNT)=CCHH+1 34400000 MVI ISLOCNT+4,X'01' C(OCNT)=CCHHR, R=1 34420000 * 34440000 * SET IOBA+35 (IOBDADAD) = NORMAL CCHHR, R=R-1 FOR SRCH ID 34460000 * 34480000 MVC IOBDADAD+3(5),ISLNCNT C(IOBA+35)=CCHHR FROM NCNT 34500000 L R3,IOBDADAD+4 C(R3)=CHHR 34520000 BCTR R3,0 C(R3)=CCHR-1 34540000 ST R3,IOBDADAD+4 C(DADAD)=MBBCCHHR WITH R=R-1 34560000 * 34580000 * TEST IF OVFLO HH IS ON A SHARED TRACK (IS IT FORMATTED) 34600000 * 34620000 CLI DCBHIRSH,X'00' HIRSH VS 0 34640000 BE ISLG102 BR IF 0, NOT SHARED 34660000 EX R0,ISLF904A C(FXWK1)=H FROM OVFLO CNT 34680000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 34700000 EX R0,ISLPA01B H OF FIRSH VS C(FXWK1) OVFLO CT 34720000 BNE ISLG102 B IF NOT EQUAL, NOT SHARED 34740000 * SHARED TRACK 34760000 * 34780000 * INITL CP20 FOR SHARED TRACK (FORMATTED TRACK) 34800000 * 34820000 LA R3,CQ15 C((R3)=A(CQ15) S20201 34840020 IC R4,IOBCPSAD SAVE SIOCC 34860000 ST R3,IOBCPSAD C(CPSAD)=CP20 START ADR, CQ15 34880000 STC R4,IOBCPSAD RESTORE SIOCC 34900000 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 34920000 IC R4,48(R10) SAVE OP AT CQ7 34940000 ST R3,48(R10) STORE KEY ADR AT CQ7 34960000 STC R4,48(R10) RESTORE OP 34980000 IC R4,CQ18 SAVE OP AT CQ18 S20201 35000020 ST R3,CQ18 STORE KEY ADR AT CQ18 S20201 35020020 STC R4,CQ18 RESTORE OP S20201 35040020 LA R3,32(R10) C(R3)=A(CQ5) 35060000 IC R4,CQ20 SAVE OP AT CQ20 S20201 35080020 ST R3,CQ20 STORE A(CQ5) AT CQ20 S20201 35100020 STC R4,CQ20 RESTORE OP S20201 35120020 B ISLG202 35140000 *---------------------------------------------------------------------- 35160000 * 35180000 * NOT A SHARED TRACK 35200000 * 35220000 * INITL CP20 FOR UNSHARED TRACK (NON-FORMATTED TRACK) 35240000 * 35260000 ISLG102 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 35280000 IC R4,CQ18 SAVE OP AT CQ18 S20201 35300020 ST R3,CQ18 STORE KEY ADR AT CQ18 S20201 35320020 STC R4,CQ18 RESTORE OP S20201 35340020 IC R4,CQ22 SAVE OP AT CQ22 S20201 35360020 ST R3,CQ22 STORE KEY ADR AT CQ22 S20201 35380020 STC R4,CQ22 RESTORE OP S20201 35400020 * 35420000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 35440000 * 35460000 L R3,ISLLSTBF C(R3)=LSTBF 35480000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 35500000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT 35520000 TM 0(R3),X'04' TEST S BIT 5 VS 1 (C-BIT) 35540000 BC 1,ISLG103 B IF C-BIT ON 35560000 * 35580000 * C-BIT OFF 35600000 LA R3,96(R10) C(R3)=A(CQ13) 35620000 IC R4,CQ24 SAVE OP AT CQ24 S20201 35640020 ST R3,CQ24 STORE A(CQ13) AT CQ24 S20201 35660020 STC R4,CQ24 RESTORE OP S20201 35680020 * 35700000 MVC CQT5A+1(3),CQT5ATIC SKIP INACTIVE CHECK M5864 35740020 ISLG104 EQU * * A37537 35780020 * 35840000 LA R3,CQ27 C(R3)=A(CQ27) S20201 35860020 IC R4,CQ20 SAVE OP AT CQ20 S20201 35880020 ST R3,CQ20 STORE A(CQ27) AT CQ20 S20201 35900020 STC R4,CQ20 RESTORE OP S20201 35920020 LA R3,CQ21 C(R3)=A(CQ21) S20201 35940020 IC R4,CQ29 SAVE OP AT CQ29 S20201 35960020 ST R3,CQ29 STORE A(CQ21) AT CQ29 S20201 35980020 STC R4,CQ29 RESTORE OP S20201 36000020 B ISLG221 36020000 *---------------------------------------------------------------------- 36040000 * 36060000 * 36080000 * C-BIT ON 36100000 ISLG103 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 36120000 SR R3,R3 36140000 IC R3,ISLDCNT+4 C(R3)=R FROM DCNT 36160000 LA R3,1(R3) C(R3)=R+1 36180000 STC R3,ISLDCNT+4 C(DCNT)=CCHHR, R=R+1 36200000 LA R3,CQ25 C(R3)=A(CQ25) S20201 36220020 IC R4,CQ24 SAVE OP AT CQ24 S20201 36240020 ST R3,CQ24 STORE A(CQ25) AT CQ24 S20201 36260020 STC R4,CQ24 RESTORE OP S20201 36280020 * 36300000 MVC CQT5A+1(3),CQT5ANOP CHECK INACTIVE ENTRY M5864 36340020 * 36380000 B ISLG104 36400000 EJECT 36420000 * * 36440000 * CHART G2 - CONTINUATION OF CHARTS F9 AND G1 * 36460000 *********************************************************************** 36480000 * 36500000 * TEST IF OVFLO HH IS ON A SHARED TRACK (IS IT FORMATTED) 36520000 * 36540000 ISLG201 EQU * 36560000 CLI DCBHIRSH,X'00' HIRSH VS 0 36580000 BE ISLG210 BR IF 0 - NOT SHARED 36600000 EX R0,ISLF904A C(FXWK1)=H FROM OVFLO CNT 36620000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 36640000 EX R0,ISLPA01B H OF FIRSH VS H OF OVFLO CNT 36660000 BNE ISLG210 B IF NOT EQUAL, NOT SHARED 36680000 * SHARED TRACK 36700000 * 36720000 * INITL CP20 FOR SHARED TRACK (FORMATTED TRACK) AND SET IOBA+35 36740000 * 36760000 IC R4,IOBCPSAD SAVE SIOCC 36780000 ST R10,IOBCPSAD C(CPSAD)=CP20 START ADR, CQ1 36800000 STC R4,IOBCPSAD RESTORE SIOCC 36820000 * SET IOBA+35 = NORMAL CCHHR 36840000 MVC IOBDADAD+3(5),ISLNCNT C(IOBA+35)=CCHHR FROM NCNT 36860000 * 36880000 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 36900000 IC R4,16(R10) SAVE OP AT CQ3 36920000 ST R3,16(R10) STORE KEY ADR AT CQ3 36940000 STC R4,16(R10) RESTORE OP 36960000 IC R4,48(R10) SAVE OP AT CQ7 36980000 ST R3,48(R10) STORE KEY ADR AT CQ7 37000000 STC R4,48(R10) RESTORE OP 37020000 * 37040000 * 37160000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 37180000 * 37200000 ISLG202 L R3,ISLLSTBF C(R3)=LSTBF 37220000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 37240000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT) 37260000 TM 0(R3),X'04' TEST S BIT 5 VS 1 (C-BIT) 37280000 BC 1,ISLG203 B IF C BIT ON 37300000 * 37320000 * C-BIT OFF 37340000 LA R3,96(R10) C(R3)=A(CQ13) 37360000 IC R4,64(R10) SAVE OP AT CQ9 37380000 ST R3,64(R10) STORE A(CQ13) AT CQ9 37400000 STC R4,64(R10) RESTORE OP 37420000 * 37440000 MVC CQT5A+1(3),CQT5ATIC SKIP INACTIVE CHECK M5864 37480020 B ISLG250 BR - SET UP N,O DAT A37537 37520020 * 37560000 * C-BIT ON 37580000 ISLG203 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 37600000 IC R3,ISLDCNT+4 C(R3)=R FROM DCNT 37640000 LA R3,1(0,R3) C(R3)-R+1 P4701 37660000 STC R3,ISLDCNT+4 C(DCNT)=CCHHR, R=R+1 37680000 LA R3,72(R10) C(R3)=A(CQ10) 37700000 IC R4,64(R10) SAVE OP AT CQ9 37720000 ST R3,64(R10) STORE A(CQ10) AT CQ9 37740000 STC R4,64(R10) RESTORE OP 37760000 * 37780000 MVC CQT5A+1(3),CQT5ANOP CHECK INACTIVE ENTRY M5864 37860020 * 37940000 B ISLG250 37960000 * 37980000 * NOT A SHARED TRACK 38000000 * 38020000 * INITL CP20 FOR UNSHARED TRACK (NON FORMATTED) AND SET IOBA+35 38040000 * 38060000 * SET IOBA+35 = NORMAL CCHHR-1 38080000 ISLG210 MVC IOBDADAD+3(5),ISLNCNT C(IOBA+35)=CCHHR FROM NCNT 38100000 L R3,IOBDADAD+4 C(R3)=CHHR 38120000 BCTR R3,0 C(R3)=CHHR-1 38140000 ST R3,IOBDADAD+4 C(DADAD)=MBBCCHHR WITH R=R-1 38160000 L R3,ISLKEYAD C(R3)=A(KEY OF LAST WR CKD) 38180000 IC R4,CQ18 SAVE OP AT CQ18 S20201 38200020 ST R3,CQ18 STORE KEY ADR AT CQ18 S20201 38220020 STC R4,CQ18 RESTORE OP S20201 38240020 IC R4,CQ22 SAVE OP AT CQ22 S20201 38260020 ST R3,CQ22 STORE KEY ADR AT CQ22 S20201 38270020 STC R4,CQ22 RESTORE OP S20201 38280020 * 38320000 * TEST LAST BUFFER FOR END OF CYLINDER (C-BIT ON) 38340000 * 38360000 L R3,ISLLSTBF C(R3)=LSTBF 38380000 SLA R3,2 MULT BY 4, C(R3)=LSTBF IN BYTES 38400000 LA R3,IOBS(R3) C(R3)=A(LSTBF SLOT IN BCT) 38420000 TM 0(R3),X'04' TEST S BIT 5 VS 1 (C-BIT) 38440000 BC 1,ISLG211 B IF C BIT ON 38460000 * 38480000 * C-BIT OFF 38500000 LA R3,96(R10) C(R3)=A(CQ13) 38520000 IC R4,CQ24 SAVE OP AT CQ24 S20201 38540020 ST R3,CQ24 STORE A(CQ13) AT CQ24 S20201 38560020 STC R4,CQ24 RESTORE OP S20201 38580020 * 38600000 MVC CQT5A+1(3),CQT5ATIC SKIP INACTIVE CHECK M5864 38670020 * 38740000 ISLG220 LA R3,CQ21 C(R3)=A(CQ21) S20201 38760020 IC R4,CQ20 SAVE OP AT CQ20 S20201 38780020 ST R3,CQ20 STORE A(CQ21) AT CQ20 S20201 38800020 STC R4,CQ20 RESTORE OP S20201 38820020 * 38840000 ISLG221 LA R3,CQ15 C(R3)=A(CQ15) S20201 38860020 IC R4,IOBCPSAD SAVE SIOCC 38880000 ST R3,IOBCPSAD C(CPSAD)=CP20 START ADR, CQ15 38900000 STC R4,IOBCPSAD RESTORE SIOCC 38920000 MVC CQ30,IOBDADAD C(CQ30)=MBBCCHH FROM S20201 38930020 * IOBA+32 S20201 38940020 MVI CQ30+K7,K0 C(CQ30)=MBBCCHHR, R=0 S20201 38960020 L R3,CQ30+K4 C(R3)=CHHR S20201 38980020 A R3,ISLTENF C(R3)=CHHR, HH=HH+1 39000000 ST R3,CQ30+K4 C(CQ30)=MBBCCHHR, HH+1, S20201 39010020 * R=0 S20201 39020020 * 39040000 * SET NORMAL DATA = COUNT FROM 1ST BUF SCHED (BOTH SHARED AND UNSHARED) 39060000 * 39080000 ISLG250 MVC ISLNDAT(3),IOBDADAD C(NDAT)=MBB FROM IOBA+32 39100000 MVC ISLNDAT+3(4),0(R6) C(NDAT)=CCHH FROM 1ST BUF 39120000 MVC ISLODAT(7),ISLNDAT C(ODAT)=MBBCCHH FROM NDAT 39140000 MVC ISLNDAT+7(2),ISLZEROF NORMAL DATA F=0 (SHARED) 39160000 * R=0 39180000 * 39200000 CLI DCBHIRSH,X'00' HIRSH VS 0 39220000 BE ISLG252 BR IF 0, NOT SHARED 39240000 MVC ISLFXWK1(1),ISLNDAT+6 C(FXWK1)=H OF NORMAL DATA ENTRY 39260000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 39280000 EX R0,ISLPA01B H OF FIRSH VS C(FXWK1) 39300000 BNE ISLG252 39320000 * 39340000 MVI ISLNDAT+8,X'08' NORMAL DATA F = 08 (SHARED) 39360000 MVC ISLNDAT+7(1),DCBFIRSH+2 NORMAL DATA R = FIRSH R 39380000 * 39400000 * SET UP AREA Y 39420000 * 39440000 ISLG252 L R10,DCBWKPT6 C(R10)=A(VPTRS) 39460000 L R9,0(R10) C(R9)=A(Y) 39480000 MVC ISLY+18(8),ISLNCNT C(Y+18)=NORM COUNT 39500000 MVC ISLY+26(10),ISLNDAT C(Y+26)=NORM DATA 39520000 MVC ISLY+36(8),ISLOCNT C(Y+36)=OVFL COUNT 39540000 MVC ISLY+44(10),ISLODAT C(Y+44)=OVFL DATA 39560000 MVC ISLY+54(8),ISLDCNT C(Y+54)=DUMM COUNT 39580000 * 39600000 * END OF EXPANSION 39620000 * 39640000 ISLG260 B ISLFY21 RETURN TO FY 39660000 *---------------------------------------------------------------------- 39680000 * 39700000 * 39720000 * C-BIT ON 39740000 ISLG211 MVC CQT5A+1(3),CQT5ANOP CHECK INACTIVE ENTRY M5864 39810020 * 39880000 * 39900000 * TEST TWO SW, IS THERE ROOM FOR JUST 2 MORE ENTRIES AT END OF CYLINDER 39920000 * 39940000 TM IOBFLAGS,X'04' TEST FLAGS BIT 5 VS 1 (TWOSW) 39960000 BC 1,ISLG212 B IF ON 39980000 * 40000000 * TWOSW OFF 40020000 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 40040000 SR R3,R3 40060000 IC R3,ISLDCNT+4 C(R3)=R FROM DCNT 40080000 LA R3,1(R3) C(R3)=R+1 40100000 STC R3,ISLDCNT+4 C(DCNT)=CCHHR, R=R+1 40120000 LA R3,CQ25 C(R3)=A(CQ25) S20201 40140020 B ISLG213A 40160000 * 40180000 * TWOSW ON 40200000 ISLG212 MVC ISLDCNT(5),ISLOCNT C(DCNT)=CCHHR FROM OCNT 40220000 L R3,ISLDCNT C(R3)=CCHH FROM DCNT 40240000 A R3,ISLONEF C(R3)=CCHH+1 40260000 ST R3,ISLDCNT C(DCNT)=CCHH+1 40280000 MVI ISLDCNT+4,X'01' C(DCNT)=CCHHR, R=1 40300000 * 40320000 * TEST IF DUMMY HH IS A SHARED TRACK (FORMATTED) 40340000 * 40360000 CLI DCBHIRSH,X'00' HIRSH VS 0 40380000 BE ISLG213 B IF 0, NOT SHARED 40400000 MVC ISLFXWK1(1),ISLDCNT+3 C(FXWK1)=H FROM DUMMY COUNT 40420000 EX R0,ISLPA01A REDUCE TO TRACK ADDR 40440000 EX R0,ISLPA01B FIRSH VS C(FXWK1) 40460000 BNE ISLG213 B IF NOT EQUAL, NOT SHARED 40480000 * 40500000 * SHARED TRACK (FORMATTED) 40520000 LA R3,72(R10) C(R3)=A(CQ10) 40540000 B ISLG213A 40560000 * 40580000 * NOT A SHARED TRACK 40600000 ISLG213 LA R3,CQ25 C(R3)=A(CQ25) S20201 40620020 IC R4,CQ29 SAVE OP AT CQ29 S20201 40640020 ST R3,CQ29 STORE C(R3) AT CQ29 S20201 40660020 STC R4,CQ29 RESTORE OP S20201 40680020 * 40700000 LA R3,CQ27 C(R3)=A(CQ27) S20201 40720020 ISLG213A EQU * 40740000 IC R4,CQ24 SAVE OP A CQ24 S20201 40760020 ST R3,CQ24 STORE C(R3) AT CQ24 S20201 40780020 STC R4,CQ24 RESTORE OP S20201 40800020 B ISLG220 40820000 * 40840000 EJECT 40860000 * 40880000 * F8 CONSTANTS 40900000 * 40920000 ISL8 DC F'0008' 40940000 CONSF8 DC F'248' 13334 40990016 ISLABEND DC X'80031000' ABEND CODE - NO SYNAD P4701 41050000 * 41060000 * F9 CONSTANTS 41080000 * 41100000 ISL4 DC F'0004' 41120000 ISLONEF DC F'0001' 41180000 ISLTWOF DC F'0002' 41200000 SCHCOM DC X'31000000' 13334 41210016 ISLZEROF EQU SCHCOM+1 ISLZEROF=4 BYTES OF ZEROS 20852 41215000 ISLTENF DC X'00000100' 41220000 ISLRFP EQU ISLTENF+3 RFP OF MBBCCHHRFP = 8M800 41225018 * 002907 8M800 41230018 ISLFP DC X'2907' FP OF ISLRFP 8M800 41235018 * 41240000 * FX CONSTANTS 41260000 * 41280000 ISLFX02A CLC 0(1,R4),0(R5) KEY COMP TO BE EXECUTED (L) 41300000 ISLFX06A MVC 0(1,R5),0(R4) MOVE KEY TO BE EXECUTED (L) 41320000 ISLFX08A CLC 0(1,R5),0(R4) KEY COMP TO BE EXECUTED (M) 41340000 ISLFX21A MVC 0(1,R4),0(R5) MOVE RCD TO BE EXECUTED (M) 41360000 * 41380000 * 41420000 EJECT 41440000 END 41460000 ./ ADD SSI=09010390,NAME=IGG019GC,SOURCE=0 TITLE 'IGG019GC - APPENDAGE ROUTINES, W/O WR CHK' 00020000 COPY LCGASMSW 00030001 IGG019GC CSECT 00040000 * RELEASE 14 DELETIONS * 00042000 * RELEASE 15 DELETIONS * 00044000 *1633 11643 00044515 *1633 11877 00045015 * RELEASE 16 DELETIONS * 00046000 *3630 13711 00047016 *3630 15924 00047516 * RELEASE 17 DELETIONS * 00048000 * RELEASE 18 DELETIONS * 00050000 *1650001800,033800,035240,108800 VLR 00050518 *1650107600,108800 21347 00051018 *1650034000-035240,196600-196800 25463 00051518 * RELEASE 19 DELETIONS * 00052000 *2182068600-069000 A28706 00052519 *2182034800-034900 O19110 00053019 *2182065800 A27321 00053519 * RELEASE 20 DELETIONS * 00054000 *0492 A30945 00055020 *0492015000,015200-021800,022200,022400,022600-035400,072800, S20201 00055220 *0492074200,074600,076000,077200,077400,077600,080400,080800, S20201 00055420 *0492081600,085400,085600,089200,089400,089700,095400,095600, S20201 00055620 *0492095800,096000,190800,192000 S20201 00055820 * RELEASE 21 DELETIONS * 00056000 *3523046000,052200,052600 S21045 00057021 *D069100 SA55487 00057400 *A196500-196620, D196800 XA04602 00058000 * VS2 APAR YA03702 AND OS APAR SA69201 ARE FLAGED AS XA04602 00060000 *STATUS CHANGE LEVEL 010 00068021 * * 00080000 *FUNCTION/OPERATION- THIS MODULE CONTAINS THE APPENDAGE ROUTINES FOR * 00100000 * PROCESSING ALL LOAD MODE I/O RETURNS. THE CHANNEL END APPENDAGE * 00120000 * ROUTINES SIGNAL THE COMPLETION OF INDEX AND/OR BUFFER WRITING. * 00140000 * THE ABNORMAL APPENDAGE ROUTINE PREPARES FOR AN ABNORMAL TERMIN- * 00160000 * ATION OF THE JOB. THIS MODULE SUPPORTS BOTH FIXED AND 00170018 * VARIABLE LENGTH RECORD FORMATS. 00180018 * * 00200000 *ENTRY POINTS- 'IGG019GC' IS THE ENTRY POINT WHEN NO APPENDAGE * 00220000 * PROCESSING IS REQUIRED. * 00240000 * 'IGG019GC+4' IS THE ENTRY POINT FOR CHANNEL END * 00260000 * APPENDAGE PROCESSING. * 00280000 * 'IGG019GC+12' IS THE ENTRY POINT FOR ABNORMAL END * 00300000 * APPENDAGE PROCESSING. * 00320000 * ACCESS TO THIS MODULE IS PROVIDED BY A VECTOR OF FIVE ADDRESSES * 00340000 * LOCATED AT DEB-36. * 00360000 * * 00380000 *INPUT- REGISTER 2 -POINTS TO IOB. * 00400000 * REGISTER 3 -POINTS TO DEB. * 00420000 * REGISTER 4 -POINTS TO DCB. * 00440000 * REGISTER 14 -POINTS TO RETURN FROM APPENDAGE. * 00460000 * * 00480000 *OUTPUT- SAME REGISTER SETTING AS INPUT. * 00500000 * * 00520000 *EXTERNAL ROUTINES- THIS MODULE WORKS IN CONJUNCTION WITH LOAD MODE * 00540000 * PUT (IGGO19GA), CHANNEL PROGRAMS, AND IOS. * 00560000 * * 00580000 *EXITS-NORMAL- (ISLF115) FOR NORMAL RETURN TO IOS, CHANNEL END. * 00600000 * (ISLF340) FOR EXCP RETURN TO IOS - CP19. * 00620000 * (ISLF440) FOR EXCP RETURN TO IOS - CP21. * 00640000 * (ISLF505) FOR EXCP RETURN TO IOS - CP21 CYL DUMMY. * 00660000 * (ISLF604) FOR EXCP RETURN TO IOS - CP21 MAST DUMMY. * 00680000 * (ISLF125) FOR NORMAL RETURN TO IOS, ABNORMAL. * 00700000 * * 00720000 *TABLES/WORK AREAS- * 00740000 * DCB - COMMUNICATION WITH USER. * 00760000 * DEB - COMMUNICATION WITH IOS. * 00780000 * ISLCOMON - COMMUNICATION WITHIN LOAD MODE. * 00800000 * ISLIOBA - COMMUNICATION WITH I/O FOR CP18 AND CP20. * 00820000 * ISLIOBB - COMMUNICATION WITH I/O FOR CP21. * 00840000 * ISLIOBC - COMMUNICATION WITH I/O FOR CP19. * 00860000 * ISLAREAZ - WORK AREA USED FOR PREFORMATTING. * 00880000 * ISLIXLT - INDEX LOCATION TABLE, LOCATES HI-LEVEL INDICIES. * 00900000 * ISLY - WORK AREA USED WHEN WRITING INDICIES. * 00920000 * ISLVPTRS - VARIABLE POINTERS, REFERENCE VARIABLE LENGTH BLOCKS. * 00940000 * IOBBCT - BUFFER CONTROL TABLE, CONTROLS BUFFER USAGE. * 00960000 * * 00980000 *ATTRIBUTES- READ ONLY, REENTRANT, PRIVILEGED, DISABLED, REUSABLE. * 01000000 * * 01020000 *NOTES- SECTIONS OF THE PROCESSING IN THIS MODULE ARE ENTERED * 01040000 * DIRECTLY FROM CLOSE PROCESSING. IN SUCH CASES, PROCESSING IS * 01060000 * CARRIED ON AS THOUGH IT WAS PART OF CLOSE. * 01080000 * ENTRY POINT - ISLF110 * 01100000 * * 01120000 * ****************************************************************** 01140000 * THE FOLLOWING NOTATION IS FREQUENTLY USED THROUGHOUT COMMENTS - * 01160000 * C(FIELD X) = A(FIELD Y) * 01180000 * CONTENTS OF FIELD X = ADDRESS OF FIELD Y * 01200000 * ****************************************************************** 01220000 * * 01240000 EJECT 01260000 ******************** 01300000 * DCB REFERENCE * 01320000 ******************** 01340000 DCBD DSORG=(IS) 01360000 USING IHADCB,R1 01380000 EJECT 01400000 ******************** 01420000 * DEB REFERENCE * 01440000 ******************** 01460000 * 01480000 IHADEB IGGDEBD 01490020 EJECT 02200000 ISLCOMON IGGLOAD 02210020 USING ISLCOMON,R12 S20201 02220020 EJECT 02240020 * 03560000 * IOBBCT REFERENCE C(ISLVPTRS+8)=A(IOBBCT) 03580000 * 03600000 IOBBCT DSECT 03620000 USING IOBBCT,R11 03640000 DS 0D 03660000 IOBFLAGS DS 0CL1 FLAGS 03680000 IOBPTRA DS A PTR A 03700000 IOBB DS 0CL1 B 03720000 IOBPTRB DS A PTR B 03740000 IOBS DS 0CL1 S - STATUS FIELD FOR BUF NO 1 03760000 IOBABUF DS A A(BUF NO 1) - ADR OF BUF NO 1 03780000 EJECT 03785020 LOADCPS DSECT 03790020 IGGLDCP 03795020 EJECT 03800000 ******************** 03820000 * IOB REFERENCE * 03840000 ******************** 03860000 * 03880000 IHAIOB DSECT 03900000 USING IHAIOB,R2 03920000 DS 0D 03940000 IOBFLAG1 DS CL1 FLAGS 1 15924 03960016 IOBFLAG2 DS CL1 FLAGS 2 15924 03980016 DS CL1 04000000 IOBSENSE DS CL1 SENSE 04020000 IOBECBAD DS A ECB POINTER 04040000 IOBCSW DS CL8 CHANNEL STATUS WORD 04060000 IOBSIOCC DS 0CL1 SIO CC 04080000 IOBCPSAD DS A CHANNEL PROGRAM START ADR 04100000 IOBWT DS 0CL1 WEIGHT 04120000 IOBDCBAD DS A DCB POINTER 04140000 IOBCPRAD DS A CHANNEL PROGRAM RESTART ADR 04160000 IOBBCTI DS CL2 BLK CTR INCR 04180000 IOBERRCT DS CL2 ERROR COUNT 15924 04200016 IOBDADAD DS CL8 DIR ACESS DEV ADR MBBCCHHR 04220000 * 04240000 ******************** 04260000 * IXLT REFERENCE * 04280000 ******************** 04300000 * 04320000 IXLT DSECT 04340000 USING IXLT,R7 04360000 DS 0D 04380000 IXLTIND DS CL1 INDICATOR LEV1 04400000 IXLBEG DS CL8 BEGINING COUNT MBBCCHHR 04420000 IXLSTP DS CL8 STEPPING COUNT MBBCCHHR 04440000 IXLEND DS CL8 ENDING COUNT MBBCCHHR 04460000 DS CL1 04480000 DS CL26 LEV2 04500000 DS CL26 LEV3 04520000 DS CL26 LEV4 04540000 EJECT 04560000 IGG019GC CSECT 04580000 * 04620000 * EQUATE SYMBOLIC REGISTERS 04640000 * 04660000 R0 EQU 0 04680000 R1 EQU 1 04700000 R2 EQU 2 04720000 R3 EQU 3 04740000 R4 EQU 4 04760000 R5 EQU 5 04780000 R6 EQU 6 04800000 R7 EQU 7 04820000 R9 EQU 8 04860000 R10 EQU 10 04880000 R11 EQU 11 04900000 R12 EQU 12 04920000 R13 EQU 13 04940000 R14 EQU 14 04960000 R15 EQU 9 04980000 R16 EQU 15 05000000 EXCP EQU 8 15924 05010016 ALL EQU X'FF' ALL SWS ON S20201 05011020 CM24X EQU CM2+4 COUNT FOR MULTIPLE CP19 S20201 05012020 * * EXECUTIONS. 05013020 CM64 EQU CM6+4 FIRST TIME INDICATOR S20201 05014020 CM264 EQU CM26+4 LAST CC SPOT S20201 05015020 CM273 EQU CM27+3 CCHHR FOR CM5 S20201 05016020 TWO EQU 2 * 05016400 ONE EQU 1 * 05016800 L4 EQU 4 LENGTH S20201 05017020 FOUR EQU 4 MISC 05017400 RQESAV EQU ISLAPSAV+36 RQE POINTER SAVED HERE 05018000 RQEDEB EQU 8 DEB ADDRESS 05019000 * 05020000 AIF ('&LIB' EQ 'LIB1').NOT00 05022001 FLAGS EQU 10 FLAG BYTE IN TISA 05024001 CP20CNXT EQU X'02' SCHEDULE CP20C NEXT 05026001 CP18NEXT EQU X'01' SCHEDULE CP18 NEXT 05028001 CP20LAST EQU CP18NEXT+CP20CNXT LAST CP SCHEDULED 05030001 .NOT00 ANOP 05032001 EJECT 05040000 *********************************************************************** 05060000 * GENERAL APPENDAGE ROUTINE * 05080000 *********************************************************************** 05100000 * 05120000 * 05140000 * APPENDAGE ROUTINE ENTRANCES 05160000 * 05180000 B 0(R14) NO APPENDAGE RT, RETURN TO IOS 05200000 USING *+8,R15 S21045 05208021 CE LA R15,TWOINSTR(R16) SET COMMON BASE S21045 05216021 TWOINSTR EQU 8 LENGTH OF TWO S21045 05224021 * INSTRUCTIONS S21045 05232021 B ISLF110 B TO CE RT 05240000 ABE LR R15,R16 SET COMMON BASE S21045 05260021 B ISLF120 B TO AE RT 05280000 * 05300000 EJECT 05320000 * 05340000 * CE ENTRANCE AND EXIT 05360000 ********************** 05380000 * 05400000 ISLF110 BAL R13,ISLF130 LINK TO COMMON HSK 05420000 * 05440000 * LOCATE PROPER CHANNEL END APPENDAGE ROUTINE 05460000 * 05480000 LA R3,0(R2) C(R3)=A(IOBX) 05500000 LA R4,ISLIOBB C(R4)=A(IOBB) 05520000 CR R3,R4 COMP IOBX VS IOBB 05540000 BH ISLF301 B IF IOBX = IOBC (CP19) 05560000 BE ISLF401 B IF IOBX = IOBB (CP21) 05580000 B ISLF201 B IF IOBX = IOBA (CP18-CP20) 05600000 * 05620000 * 05640000 ISLF115 BAL R13,ISLF140 LINK TO COMMON END 05660000 B 0(R14) NORMAL RETURN TO IOS 05680000 * 05700000 * 05720000 * AE ENTRANCE AND EXIT 05740000 ********************** 05760000 * 05780000 ISLF120 BAL R13,ISLF130 LINK TO COMMON HSK 05800000 TM DCBEXCD1,X'04' TEST EXCD1 BIT 5 FOR PREV ERR 05820000 BC 1,ISLF125 B IF ON, ONLY 1 ERR PER JOB 05840000 B ISLF701 B TO ABNORMAL APPENDAGE 05860000 * 05880000 ISLF125 BAL R13,ISLF140 LINK TO COMMON END 05900000 B 0(R14) NORMAL RETURN TO IOS 05920000 * 05940000 * 05960000 * COMMON APPENDAGE HOUSEKEEPING 05980000 *********************************************************************** 06000000 * 06020000 ISLF130 LR R11,R1 SAVE 12* ADR 06040000 LR R1,R4 C(R1)=A(DCB) 06060000 L R12,DCBWKPT1 C(R12)=A(COMMON) 06080000 STM R2,R11,ISLAPSAV SAVE REGS 2-11 06100000 ST R0,ISLAPSAV+(R15-R2)*FOUR SAVE R0 06110000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 06120000 L R11,8(R10) C(R11)=A(IOBBCT) 06140000 * C(R2)=A(IOB) - GIVEN 06160000 LR R0,R3 DEB ADDRESSABILITY 06160500 * 06180000 * 06200000 BR R13 EXIT 06220000 * 06222016 * 06224016 EXCPRTRN XC IOBFLAG2(3),IOBFLAG2 CLEAR FLAG2,SENSE BYTES 15924 06226016 XC IOBCSW(9),IOBCSW CLEAR FLAG3,CSW,SIOCC 15924 06228016 XC IOBERRCT(2),IOBERRCT CLEAR ERROR COUNT 15924 06230016 NI IOBFLAG1,X'C2' RESET FLAG1 15924 06232016 * 06240000 * 06260000 * COMMON APPENDAGE END 06280000 *********************************************************************** 06300000 * 06320000 ISLF140 LM R2,R11,ISLAPSAV RESTORE REGS 2-11 06340000 LR R1,R11 C(R1)=12* ADR 06360000 L R0,ISLAPSAV+(R15-R2)*FOUR RESTORE R0 06370000 SR R15,R15 CLEAR 9 06380000 * 06400000 BR R13 EXIT 06420000 EJECT 06440000 *********************************************************************** 06460000 * CHART F2 - APPENDAGE, CP18 AND CP20 CHANNEL END * 06480000 *********************************************************************** 06500000 * 06520000 * SET FLAGS BIT 0 = 0, (IWR)- CP(S) IS NOW AVAILABLE 06540000 * 06560000 ISLF201 EQU * A27321 06570019 * 06581019 * FOR FULL TRACK INDEX WRITE OPTION - IF CP20 06582019 * WAS EXECUTED WITHOUT CP18 (BIT 4 OF FLAG FIELD 06583019 * IN THE TRACK INDEX SAVE AREA IS ON) THEN RETURN 06584019 * TO IOS WITHOUT UPDATING BUFFER POINTER. 06585019 * 06586019 TM 36(R10),X'C0' SUCCESSFUL GETMAIN FOR O19110 06587019 * FULL TRACK INDEX WRITE 06588019 BNO ISLF2014 NO - BR TO CONTINUE O19110 06589019 L R4,36(R10) C(R4)=A(FTIW TI SAVE O19110 06590019 * AREA) 06591001 AIF ('&LIB' EQ 'LIB1').NOT01 06591101 * IF AOS CP20A OF B ,CP20C AND CP18 ARE SCHEDULED SEPARATELY AND 06591201 * MUST BE RESTARTED FROM THIS APPENDAGE. 06591301 TM FLAGS(R4),CP20LAST WAS CP18 LAST SCHEDULED 06591401 BO ISLF2014 YES - DONE 06591501 AOSNT20C EQU * SCHEDULE CP18 IF NECESSARY 06591601 .NOT01 ANOP 06591701 TM 10(R4),X'08' CP20 EXECUTED ALONE O19110 06592019 BO ISLF115 YES-RETURN TO IOS EXIT O19110 06593019 AIF ('&LIB' EQ 'LIB1').NOT02 06593601 * START CP 18 IF NECESSARY. 06594201 TM FLAGS(R4),CP18NEXT SHOULD CP18 BE SCHE 06594801 BNO ISLF2014 NO - FINISHED 06595401 MVC IOBCPSAD,ISLVPTR4 ASSUME CP18 NEXT 06596001 MVC IOBDADAD,0(R4) * 06596601 OI FLAGS(R4),CP20LAST MARK CP20 SCHEDULED 06597201 BAL R13,EXCPRTRN REFRESH IOB 06597801 B EXCP(R14) LINK TO IOS TO EXCP 06598401 .NOT02 ANOP 06599001 * 06600000 * SET OFF STATUS BITS 1 AND 2, 00 = BUFFER AVAILABLE 06620000 * SET OFF STATUS BIT 4, 0 = T-BIT OFF 06640000 * DO THIS FOR EACH BUFFER THAT WAS JUST WRITTEN AND UPDATE PTR A AT THE 06660000 * SAME TIME. AT FINISH, PTR A WILL POINT TO NEXT SLOT TO SCHEDULE FOR 06680000 * WRITING. 06700000 * 06720000 ISLF2014 EQU * O19110 06730019 L R3,IOBPTRA C(R3)=A(1ST SLOT WRITTEN) 06740000 LA R3,0(R3) 06760000 ISLF202 TM 0(R3),X'60' TEST BITS 1 AND 2 VS 11 06780000 BC 1,ISLF203 B IF BITS 1 AND 2 = 11 06800000 * 06820000 * BITS 1 AND 2 NOT 11, FINISHED 06840000 ST R3,ISLVRSAV+24 A28706 06860019 MVC IOBPTRA+1(3),ISLVRSAV+25 MOVE INTO PTRA A28706 06880019 B ISLF115 NORMAL RETURN TO IOS EXIT 06920000 *---------------------------------------------------------------------- 06940000 * 06960000 ISLF203 NI 0(R3),X'97' TURN BITS 1,2 AND 4 (IF ON) OFF 06980000 A R3,ISL4 BUMP R3 TO ADR NEXT SLOT 07000000 C R3,ISLBUFN TEST FOR ADR OF NTH SLOT 07020000 BH ISLF204 B IF OUTSIDE TBL = WRAPAROUND 07040000 B ISLF202 LOOP AGAIN 07060000 * 07080000 * WRAPAROUND 07100000 ISLF204 LA R3,IOBABUF C(R3)=A(SLOT 1) 07120000 B ISLF202 LOOP AGAIN 07140000 EJECT 07160000 *********************************************************************** 07180000 * CHART F3 - APPENDAGE, CP19 CHANNEL END * 07200000 *********************************************************************** 07220000 * 07240000 ISLF301 L R10,16(R10) C(R10)=A(CP19) 07260000 USING CM1,R10 ADDRESSABILITY ON CP19 S20201 07270020 CLC CM24X(L4),ISL0 TEST CM2+4 VS 0000 = 10 S20201 07280020 * OR LESS. 07290020 BE ISLF115 B IF TEN OR LESS ENTRIES TO BE 07300000 * PREFORMATTED FOR NORMAL IOS 07320000 * RETURN. 07340000 * 07360000 * MORE THAN TEN ENTRIES TO PREFORMAT 07380000 * 07400000 CLC CM64(L4),ISL0 TEST CM6+4 VS 0000 = 1ST S20201 07410020 * CE S20201 07420020 BE ISLF302 B IF 1ST CE FOR THIS CYLINDER 07440000 CLC CM64(L4),ISLFF TEST FOR CM6+4 FOR END S20201 07460020 BNE ISLF303 B IF PREFORMATTING IN PROCESS 07480000 B ISLF320 B IF END 07500000 * 07520000 * 07540000 * 1ST CE WHILE PREFORMATTING THIS CYLINDER 07560000 * 07580000 ISLF302 LA R4,CM5 C(R4)=A(CM5) S20201 07600020 IC R5,IOBSIOCC SAVE SIOCC 07620000 ST R4,IOBCPSAD STORE A(CM5) IN IOBC CP START 07640000 STC R5,IOBSIOCC RESTORE SIOCC 07660000 * 07680000 LA R4,35(R2) CM5 07700000 IC R5,CM5 S20201 07720020 ST R4,CM5 STORE ADR IOBC+35 S20201 07740020 STC R5,CM5 S20201 07760020 * 07780000 * CALCULATE COUNT OF NO. OF EXECUTES OF CP19 FROM APPENDAGE 07800000 * 07820000 SR R4,R4 07840000 SR R5,R5 07860000 IC R5,DCBFIRSH+2 C(R5)=R OF FIRSH 07880000 S R5,ISL1 DIVIDEND = 0000000N IN R4-R5 07900000 D R4,ISL10 DIVISOR = 000A 07920000 * C(R4) = REMAINDER R = 000R 07940000 * C(R5) = QUOTIENT Q 07960000 C R4,ISL0 TEST R VS 0 07980000 BNE ISLF3025 B IF R NOT 0 08000000 S R5,ISL1 R=0, ADJUST Q DOWNWARDS 08020000 ISLF3025 ST R5,CM64 C(CM6+4)=Q, Q GR 0 S20201 08040020 * 08060000 ISLF303 L R5,CM64 C(R5) = COUNT Q S20201 08080020 C R5,ISL1 TEST FOR LAST EXECUTE 08100000 BE ISLF305 B IF LAST EXECUTE 08120000 S R5,ISL1 DECREMENT COUNT Q 08140000 ST R5,CM64 C(CM6+4) = Q, Q GR 0 S20201 08160020 * 08180000 * PREPARE TO EXECUTE PREFORMAT 08200000 * 08220000 ISLF304 LA R9,ISLAREAZ C(R9)=A(AREA Z) 08240000 MVC 37(3,R2),80(R9) C(IOBC+37)=HHR FROM COUNT 10 08260000 SR R5,R5 08280000 IC R5,82(R9) C(R5)=R FROM COUNT 10 08300000 BAL R13,ISLF310 B TO SET UP AREA Z 08320000 * 08340000 * EXCP RETURN TO IOS - EXECUTE CP19 AGAIN 08360000 * 08380000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 08400016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 08420016 * 08440000 * 08460000 * PREPARE TO EXECUTE LAST PREFORMAT FOR THIS CYLINDER 08480000 * 08500000 ISLF305 L R4,ISLFF C(R4)=FFFF 08520000 ST R4,CM64 C(CM6+4) = FFFF = END S20201 08540020 L R4,CM24X C(R4)=C(CM2+4)=A(CC S20201 08550020 * FLAG) S20201 08560020 NI 0(R4),X'BF' TURN CC FLAG OFF 08580000 B ISLF304 B TO COMMON PREPARE 08600000 * 08620000 * SUBROUTINE TO SET UP AREA Z 08640000 * 08660000 ISLF310 L R3,ISL10 C(R3)=10 = LOOP COUNT 08680000 LA R4,10(R9) C(R4)=A(Z+10) = 1ST R 08700000 ISLF311 A R5,ISL1 STEP R 08720000 STC R5,0(R4) STORE R IN Z 08740000 A R4,ISL8 STEP Z 08760000 BCT R3,ISLF311 LOOP 08780000 BR R13 EXIT 08800000 * 08820000 * 08840000 * END OF APPENDAGE - RESET CONDITIONS 08860000 * 08880000 ISLF320 SR R5,R5 08900000 ST R5,CM64 C(CM6+4) = 0000 S20201 08920020 L R4,CM24X C(R4)=C(CM2+4)=A(CC S20201 08930020 * FLAG) S20201 08940020 OI 0(R4),X'40' TURN CC FLAG BACK ON 08960000 NI CM264,ALL-CC TURN OFF TENTH CC FLAG S20201 08966020 * 1187 S20201 08972020 LA R9,ISLAREAZ C(R9)=A(AREA Z) 08980000 BAL R13,ISLF310 B TO SET UP AREA Z, 1ST R = 1 09000000 * 09020000 TM DCBOPTCD,X'08' TEST OPTCD BIT-4 FOR CYL OVFL 09040000 BC 8,ISLF325 B IF NO CYL OVFL 09060000 * 09080000 * CYL OVFL ON 09100000 IC R5,IOBSIOCC SAVE SIOCC 09120000 ST R10,IOBCPSAD STORE A(CM1) IN IOBC CP START 09140000 STC R5,IOBSIOCC RESTORE SIOCC 09160000 * 09180000 NI 38(R2),X'F8' SET TO TRACK 0 - ASSUME 2301 09200000 MVI 39(R2),X'00' SET R=0 09220000 CLI DCBDEVT,X'02' IS IT 2301 09240000 BE ISLF3205 BR IF 2301 09260000 MVI 38(R2),X'00' SET TRACK TO ZERO - 2321 09280000 CLI DCBDEVT,X'05' IS IT 2321 09300000 BE ISLF3207 09320000 ISLF3205 MVI 37(R2),X'00' SET 1ST H TO ZERO 09340000 * 09360000 ISLF3207 EQU * 09380000 CLI DCBFIRSH+1,X'00' FIRSH TRACK VS 0 09400000 BE ISLF115 B IF CYL OVFL RCD IS ON SHARED 09420000 * TRACK = CM5 OK - EXIT,NORM RTRN 09440000 * 09460000 * CYL OVFL RCD NOT ON SHARED TRK 09480000 TM IOBFLAGS,X'10' CP 91 IN CONTROL 09500000 BO ISLF115 YES, CP 91 IN CONTROL RETURN TO IOS 09520000 LA R4,CM273 CM5 S20201 09540020 IC R5,CM5 S20201 09560020 ST R4,CM5 STORE ADR CM27+3 S20201 09580020 STC R5,CM5 S20201 09600020 * 09620000 B ISLF115 EXIT,NORM RTRN 09640000 * 09660000 * NO CYL OVFL - CP START OK 09680000 ISLF325 EQU * 09700000 MVI 39(R2),X'00' SET R=0 IN IOBC+39 09720000 CLI DCBDEVT,X'02' IS IT 2301 09740000 BNE ISLF326 BR IF NOT 2301 09760000 NI 38(R2),X'F8' ZERO TRACK BITS 09780000 OC 38(1,R2),DCBFIRSH+1 SET IOBC+38 TO TRACK FROM FIRSH 09800000 B ISLF115 EXIT, NORMAL RETURN 09820000 * 09840000 ISLF326 MVC 38(1,R2),DCBFIRSH+1 SET IOBC+38 TO TRACK FROM FIRSH 09860000 * CM5 OK 09880000 B ISLF115 EXIT,NORM RTRN 09900000 EJECT 09920000 *********************************************************************** 09940000 * CHART F4 - APPENDAGE, CP21 CHANNEL END * 09960000 *********************************************************************** 09980000 * 10000000 ISLF401 LA R7,ISLIXLT C(R7)=A(IXLT) 10020000 L R9,0(R10) C(R9)=A(AREA Y) 10040000 LR R6,R7 C(R6)=A(IXLT)=A(LEV1) 10060000 L R5,ISL1 C(R5)=0001 FOR CURRENT LEVEL 10080000 L R3,24(R10) C(R3)=A(CP21) 10100000 TM 20(R3),X'80' TEST CQ42 FOR DC 10120000 BC 8,ISLF115 B IF OFF = EOF, NORMAL RETURN 10140000 * 10160000 * LOCATE CURRENT LEVEL IN IXLT 10180000 * 10200000 TM 0(R7),X'20' TEST LEVEL IND BIT-2 10220000 BC 1,ISLF403 B IF LEVEL 1, CYL IX 10240000 ISLF402 A R7,ISL26 STEP TO NEXT LEVEL IN IXLT 10260000 A R5,ISL1 C(R5)=CURRENT LEVEL 10280000 TM 0(R7),X'20' TEST LEVEL IND BIT-2 10300000 BC 8,ISLF402 B IF NOT THIS LEVEL (LOOP) 10320000 * 10340000 * MASTER INDEX, TEST FOR DUMMY ENTRY 10360000 * 10380000 TM 0(R7),X'40' TEST LEVEL IND BIT-1 10400000 BC 1,ISLF601 B IF MST DUMMY 10420000 B ISLF410 10440000 * 10460000 * CYLINDER INDEX, TEST FOR DUMMY ENTRY 10480000 * 10500000 ISLF403 TM 0(R7),X'40' TEST LEVEL IND BIT-1 10520000 BC 1,ISLF501 B IF CYL DUMMY 10540000 * 10560000 EJECT 10580000 * 10600000 * NORMAL ENTRY APPENDAGE ROUTINE, CYLINDER OR MASTER INDEX 10620000 * * R6 POINTS TO CYLNDER IXLT LEVEL * 10640000 * * R7 POINTS TO CURRENT IXLT LEVEL * 10660000 * 10680000 * TEST R IN COUNT FIELD IN AREA Y FOR END OF TRACK 10700000 * 10720000 ISLF410 CLC 4(1,R9),DCBHIRCM TEST R VS HI R 10740000 BNE CONTINUE BRANCH NOT EQUAL 21347 10746018 CLI 16(R7),X'00' IS R OF SX = 0 ? 21347 10752018 BE ISLF420 BRANCH IF EQUAL 21347 10758018 B ISLF415 21347 10764018 CONTINUE EQU * 21347 10770018 * 10780000 * NOT END OF TRACK 10800000 * REPLACE R OF STEPPING COUNT BY R OF Y 10820000 * 10840000 MVC 16(1,R7),4(R9) R OF SX = R OF Y 10860000 TM IOBFLAGS,X'12' ARE WE IN CLOSE VLR 10880018 BC 1,ISLF420 B IF ON = CLOSE 10900000 * 10920000 * TEST HH OF STEPPING COUNT FOR END OF CYLINDER 10940000 * 10960000 MVC TSTWK1C(1),15(R7) GET CURRENT TRK FROM IXLT 10980000 MVC TSTWK1C+2(1),23(R6) GET HI TRK FROM IXLT 11000000 NC TSTWK1C(1),ISLAREAZ+87 REDUCE CURRENT TO TRACK 11020000 NC TSTWK1C+2(1),ISLAREAZ+87 REDUCE HIGH TO TRACK 11040000 CLC TSTWK1C(1),TSTWK1C+2 CURRENT TRACK VS HI TRACK 11060000 BNE ISLF450 B IF NOT END OF CYLINDER - EXIT 11080000 * 11100000 * LAST TRACK ON CYLINDER 11120000 * 11140000 * TEST R OF STEPPING COUNT FOR NEXT-TO-LAST R ON LAST TRACK 11160000 * 11180000 SR R3,R3 11200000 IC R3,DCBHIRCM C(R3)=HI R 11220000 S R3,ISL1 C(R3)=HI R -1 11240000 SR R4,R4 11260000 IC R4,16(R7) C(R4)=R OF SX 11280000 CR R3,R4 TEST HI R -1 VS R OF SX 11300000 BNE ISLF450 B IF NOT NEXT-TO-LAST R - EXIT 11320000 * 11340000 * NEXT TO LAST R ON LAST TRACK OF A CYLINDER HAS BEEN WRITTEN FOR THIS 11360000 * LEVEL INDEX. THE LAST SLOT IN A HI-LEVEL INDEX ON A GIVEN CYLINDER 11380000 * MUST CONTAIN A DUMMY ENTRY. SET DUMMY SW ON FOR THIS LEVEL INDEX SO 11400000 * NEXT WRITE WILL PRODUCE DUMMY ENTRY. 11420000 * 11440000 OI 0(R7),X'40' SET LEVEL IND BIT-1 ON 11460000 B ISLF420 11480000 * 11500000 * 11520000 * LAST R WRITTEN WAS END OF TRACK- STEP STEPPING COUNT TO NEXT TRACK 11540000 * 11560000 ISLF415 MVI 16(R7),X'00' R OF SX = 0 11580000 LH R3,14(R7) C(R3)=HH OF SX 11600000 A R3,ISL1 C(R3)=HH+1 11620000 STH R3,14(R7) C(SX)=MBBCCHHR, HH=HH+1, R=0 11640000 * 11660000 * TEST FOR ANY HIGHER LEVEL INDEXES 11680000 * 11700000 ISLF420 TM 0(R7),X'80' TEST LEVEL IND BIT-0 11720000 BC 1,ISLF450 11740000 * 11760000 * HIGHER LEVEL INDEX PRESENT, STEP TO NEXT LEVEL IN IXLT 11780000 * 11800000 NI 0(R7),X'DF' TURN BIT-2 IN CURR LEV IND OFF 11820000 A R7,ISL26 STEP R7 TO REF NEXT LEVEL 11840000 A R5,ISL1 C(R5)=CURRENT LEVEL 11860000 OI 0(R7),X'20' TURN BIT-2 IN CURR LEV IND ON 11880000 * 11900000 * CONSTRUCT COUNT FOR MASTER INDEX ENTRY IN AREA Y, Y+0 11920000 * 11940000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT SX 11960000 SR R3,R3 11980000 IC R3,16(R7) C(R3)=R FROM IXLT SX, 00NN 12000000 A R3,ISL1 C(R3)=R+1 12020000 STC R3,4(R9) COUNT = CCHHR WITH R=R+1 12040000 * 12060000 * CONSTRUCT DATA FOR MASTER INDEX ENTRY IN AREA Y, Y+8 12080000 * 12100000 STC R5,16(R9) STORE LEVEL IN F-BYTE 00000III 12120000 * 12140000 TM 0(R7),X'40' TEST IXLTIND BIT 1 (DUMMY SW) 12160000 BC 1,ISLF430 B IF ON 12180000 * 12200000 * DUMMY SW OFF 12220000 * A. NORMAL DATA 12240000 * 12260000 MVC 8(7,R9),IOBDADAD DATA=MBBCCHH FROM IOBB+32 12280000 MVI 15(R9),X'00' DATA=MBBCCHHR WITH R=0 12300000 * DATA=MBBCCHHRF, F=00000III 12320000 MVC TSTWK1C(4),IOBDADAD+3 MOVE CCH FROM IOBB+32 12340000 MVC TSTWK2C(4),12(R7) MOVE CCH FROM IXLT SX 12360000 CLI ISLAREAZ+86,X'02' IS IT 2301 12380000 BE ISLF421A 12400000 MVI TSTWK1C+3,X'00' ZERO TRACK NO. 12420000 MVI TSTWK2C+3,X'00' ZERO TRACK NO. 12440000 B ISLF421 12460000 * 12480000 ISLF421A NI TSTWK1C+3,X'F8' ZERO TRACK NO. 12500000 NI TSTWK2C+3,X'F8' ZERO TRACK NO. 12520000 * 12540000 ISLF421 CLC TSTWK1C(4),TSTWK2C CC IN IOBB+32 VS CC IN SX 12560000 BNE ISLF4215 BR IF NOT EQUAL 12580000 * 12600000 * CCS EQUAL 12620000 MVI 17(R9),X'1B' DATA=MBBCCHHRFP WITH P=1B 12640000 B ISLF424 12660000 * 12680000 * UNEQUAL 12700000 ISLF4215 CLI ISLAREAZ+86,X'05' IS IT 2321 12720000 BNE ISLF422 NOT 2321, BR TO SET P=0B 12740000 CLC TSTWK1C(2),TSTWK2C 2321, TEST FOR SAME STRP & SBCL 12760000 BE ISLF422 BR EQ TO SET P=0B 12780000 MVI 17(R9),X'07' SET P=07 12800000 B ISLF424 12820000 * 12840000 ISLF422 MVI 17(R9),X'0B' DATA=MBBCCHHRFP WITH P=0B 12860000 * 12880000 * SET CQ43 (CP21) TO ADDRESS KEY 12900000 * OF LAST RECORD IN LAST BUFFER 12920000 * 12940000 ISLF424 L R10,24(R10) C(R10)=A(CP21-CQ40) 12960000 L R4,ISLKEYAD C(R4)=A(KEY OF LAST WR CKD) 12980000 IC R5,24(R10) SAVE OP 13000000 ST R4,24(R10) STORE ADDR OF KEY 13020000 STC R5,24(R10) RESTORE OP 13040000 * 13060000 B ISLF440 13080000 * 13100000 * 13120000 * DUMMY SW ON 13140000 * B. DUMMY DATA 13160000 * 13180000 * TEST CC+1 VS DEBENDCC FOR 13200000 * POSSIBLE END OF INDEX EXTENT 13220000 * 13240000 ISLF430 EQU * 13260000 SR R6,R6 13280000 IC R6,9(R7) C(R6) = M FROM IXLT SX, 000M 13300000 S R6,ISL1 C(R6) = M-1 (M=1 FOR EXTENT 0) 13320000 SLL R6,4 C(R6) = M-1 X 16 (USE AS INDX) 13340000 * 13360000 LR R9,R0 RESTORE DEB POINTER 13410000 USING IHADEB,R9 * 13412000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 13420000 DROP R9 13430000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTENT ENTRY) 13440000 * 13460000 MVC TSTWK1C(4),10(R4) CCHH - END OF CURRENT EXTENT 13480000 NI TSTWK1C+3,X'F8' 13500000 L R4,TSTWK1C C(R4)=CCHH TRK=0 FOR 2301 13520000 MVC TSTWK1C(4),12(R7) CCHH FROM IXLT 13540000 NI TSTWK1C+3,X'F8' TRACK=0 FOR 2301 13560000 L R3,TSTWK1C C(R3)=CCHH CURRENT CYL ADDR. 13580000 CLI ISLAREAZ+86,X'02' IS IT 2301 13600000 BNE ISLF4202 BR IF NOT 2301 13620000 * 13640000 LA R3,8(R3) CYL+1 13660000 B ISLF4305 BR TO COMPARE 13680000 * 13700000 ISLF4202 IC R4,ISL0 NOT 2301 - SET TRACK=0 13720000 SRL R3,8 C(R3)=0CCH 13740000 CLI ISLAREAZ+86,X'05' IS IT 2321 13760000 BNE ISLF4204 BR TO ADD 1 TO CYL AND COMPARE 13780000 CLI TSTWK1C+2,X'04' LAST CYL OF STRIP 13800000 BE ISLF4203 BR IF LAST CYL 13820000 LA R3,1(R3) C(R3)=0CCH+1 NEXT CYL 13840000 SLL R3,8 C(R3)=CCH+10 13860000 B ISLF4305 BR TO COMPARE 13880000 * 13900000 ISLF4203 CLI TSTWK1C+1,X'09' IS IT END OF SUBCELL 13920000 BNE ISLF4204 BR IF NOT END OF SUBCELL 13940000 SRL R3,16 C(R3)=000C 13960000 LA R3,1(R3) CYL+1 (NEXT SUBCELL) 13980000 SLL R3,24 C(R4)=C+1000 14000000 B ISLF4305 BR TO COMPARE 14020000 * 14040000 ISLF4204 SRL R3,8 C(R3)=00CC 14060000 LA R3,1(R3) CYL+1 14080000 SLL R3,16 C(R3)=CC00 CC= CYL=1 14100000 * 14120000 ISLF4305 EQU * 14140000 CR R3,R4 COMP NEXT CC VS END CC IN DEB 14160000 BH ISLF431 B IF NEXT CC HIGH 14180000 * 14200000 * NEXT CC IS IN CURRENT EXTENT 14220000 L R9,0(R10) C(R9)=A(AREA Y) 14240000 MVC 8(3,R9),9(R7) DATA = MBB FROM IXLT SX 14260000 ST R3,TSTWK1C 14280000 MVC 11(4,R9),TSTWK1C DATA=MBBCCHH CYL+1, TRK=0 14300000 B ISLF432 14320000 * 14340000 * NEXT CC IS IN NEW EXTENT 14360000 ISLF431 SRL R6,4 C(R6) = M-1 14380000 A R6,ISL1 C(R6) = M FOR NEXT EXTENT 14400000 SLL R6,4 C(R6) = M X 16 (USE AS INDX) 14420000 LR R9,R0 RESTORE DEB POINTER 14430000 USING IHADEB,R9 * 14432000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 14440000 DROP R9 14450000 LA R4,0(R6,R4) C(R4)=A(NEXT INDX EXTENT ENTRY) 14460000 * 14480000 L R9,0(R10) C(R9)=A(AREA Y) 14500000 MVC 9(6,R9),4(R4) DATA = BBCCHH FROM NEW EXTENT 14520000 SRL R6,4 C(R6) = M FOR NEXT EXTENT 14540000 A R6,ISL1 C(R6) = M+1 (M=1 FOR EXTENT 0) 14560000 STC R6,8(R9) DATA = MBBCCHH OF NEW EXTENT 14580000 * 14600000 ISLF432 MVI 15(R9),X'00' DATA=MBBCCHHR, R=0 14620000 OI 16(R9),X'28' DATA=MBBCCHHRF, F=00101III 14640000 MVI 17(R9),X'07' DATA=MBBCCHHRFP WITH P=07 14660000 * 14680000 * SET CQ43 (CP21) TO ADDRESS KEY 14700000 * OF ALL ONES AT Y+62 14720000 * 14740000 L R10,24(R10) C(R10)=A(CP21-CQ40) 14760000 LA R4,62(R9) C(R4)=A(AREA Y +62) 14780000 IC R5,24(R10) SAVE OP 14800000 ST R4,24(R10) STORE ADDR OF KEY OF ONES 14820000 STC R5,24(R10) RESTORE OP 14840000 * 14860000 * 14880000 * PLACE IXLT SX IN IOBB+32 14900000 * 14920000 ISLF440 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT SX), MBBCCHHR 14940000 ISLF441 EQU * 14942013 SR R13,R13 14948000 IC R13,IOBDADAD 14950000 SLL R13,4 14952000 LR R9,R0 RESTORE DEB POINTER 14952400 LA R13,32(R9,R13) POINT TO EXTENT 14952500 MVC IOBDADAD+2(1),5(R13) MOVE BB 14956000 * 14960000 * 14980000 * EXCP RETURN TO IOS - EXECUTE CP21 TO WRITE MASTER INDEX 15000000 * 15020000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 15040016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 15060016 * 15080000 * 15100000 * NORMAL RETURN TO IOS - SET C-BIT OFF AND EXIT 15120000 * * ADDR OF STATUS BYTE WITH CURRENT 15140000 * C-BIT IS IN CP21 AT CQ41 * 15160000 * 15180000 ISLF450 L R10,24(R10) C(R10)=A(CP21-CQ41) 15200000 L R7,12(R10) C(R7)=A(LAST SLOT SCHED) 15220000 NI 0(R7),X'FB' TURN S BIT 5 OFF (C-BIT) 15240000 B ISLF115 *NORMAL EXIT 15260000 * 15280000 EJECT 15300000 *********************************************************************** 15320000 * CHART F5 - APPENDAGE CYL DUMMY, CP21 CHANNEL END - ENTERED FROM F4 * 15340000 *********************************************************************** 15360000 * 15380000 * A DUMMY-CYLINDER INDEX ENTRY HAS JUST BEEN WRITTEN AS THE LAST ENTRY 15400000 * ON THE PREVIOUS TRACK. THE DATA PORTION OF THAT ENTRY CONTAINS THE 15420000 * CYLINDER AND TRACK ADDRESS OF THE REAL CYLINDER INDEX ENTRY. THE REAL 15440000 * CYLINDER INDEX ENTRY MUST NOW BE WRITTEN ON THE NEW TRACK. 15460000 * * R7 POINTS TO CYLINDER IXLT LEVEL * 15480000 * 15500000 * TURN DUMMY SW OFF 15520000 * 15540000 ISLF501 NI 0(R7),X'BF' SET LEVEL IND BIT-1 OFF 15560000 * 15580000 * 15600000 * UPDATE STEPPING COUNT USING DUMMY DATA CONTENTS, PLACE IN IOBB+32 15620000 * 15640000 MVC 9(8,R7),8(R9) C(S0)=MBBCCHHR FROM AREA Y +8 15660000 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT S0), MBBCCHHR 15680000 * 15700000 * CONSTRUCT COUNT FOR CYLINDER INDEX ENTRY IN AREA Y, Y+0 15720000 * 15740000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT SX 15760000 MVI 4(R9),X'01' COUNT = CCHHR WITH R=1 15780000 * 15800000 * CONSTRUCT DATA FOR CYLINDER INDEX ENTRY IN AREA Y, Y+8 15820000 * 15840000 LA R2,ISLIOBA C(R2)=A(IOBA) 15860000 MVC 8(7,R9),IOBDADAD DATA=MBBCCHH FROM IOBA+32 15880000 NI 14(R9),X'F8' SET TO TRACK 0 FOR 2301 15900000 CLI DCBDEVT,X'02' IS IT 2301 15920000 BE ISLF5017 BR IF 2301 15940000 MVI 14(R9),X'00' NOT 2301, SET TO TRACK 0 15960000 * 15980000 ISLF5017 EQU * 16000000 CLC DCBFIRSH(2),ISL0 TEST HH OF FIRSH VS 00 16020000 BNE ISLF502 B IF HH NOT 00 16040000 * HH OF FIRSH = 00 16060000 MVC 15(1,R9),DCBFIRSH+2 DATA = MBBCCHHR WITH R OF FIRSH 16080000 B ISLF503 16100000 * HH OF FIRSH NOT 00 16120000 ISLF502 MVI 15(R9),X'00' DATA = MBBCCHHR WITH R=00 16140000 ISLF503 MVI 16(R9),X'01' DATA = MBBCCHHRF WITH F = 01 16160000 * 16180000 SR R6,R6 16200000 IC R6,9(R7) C(R6) = M FROM IXLT S0 16220000 S R6,ISL1 C(R6) = M-1 (M=1 FOR EXTENT 0) 16240000 SLL R6,4 C(R6) = M-1 X 16 (USE AS INDX) 16260000 * 16280000 SR R5,R5 16300000 IC R5,IOBDADAD C(R5) = M FROM IOBA+32 16320000 S R5,ISL1 C(R5) = M-1 (M=1 FOR EXTENT 0) 16340000 SLL R5,4 C(R5) = M-1 X 16 (USE AS INDX) 16360000 * 16380000 LR R9,R0 RESTORE DEB POINTER 16430000 USING IHADEB,R9 * 16432000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 16440000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTENT ENTRY) 16460000 L R3,DEBFPEAD C(R3)=A(1ST PRIM EXTENT ENTRY) 16480000 LA R3,0(R5,R3) C(R3)=A(CURR PRIM EXTENT ENTRY) 16500000 DROP R9 16510000 L R9,0(R10) C(R9)=A(AREA Y) 16520000 * 16540000 LA R2,ISLIOBB 16545013 MVC IOBDADAD+1(2),4(R4) MOVE DEB BB TO IOB 16550013 * 16555013 CLC 1(3,R3),1(R4) COMP UCB ADDRS, PRIM VS INDX 16560000 BNE ISLF504 B IF NOT EQUAL 16580000 * 16600000 * UCBS EQUAL 16620000 CLI DCBDEVT,X'05' IS IT 2321 16640000 BC 7,ISLF5039 BR IF NOT 16660000 CLC 0(2,R9),11(R9) COMP COUNT CC VS DATA CC 16680000 BNE ISLF504 BR IF NOT EQ TO SET P=07 16700000 * 16720000 ISLF5039 EQU * 16740000 MVI 17(R9),X'0B' DATA = MBBCCHHRFP WITH P=0B 16760000 B ISLF505 16780000 * 16800000 * UCBS UNEQUAL 16820000 ISLF504 MVI 17(R9),X'07' DATA = MBBCCHHRFP WITH P=07 16840000 * 16860000 * SET CQ43 (CP21) TO ADDRESS KEY 16880000 * OF LAST RECORD IN LAST BUFFER 16900000 * 16920000 ISLF505 L R10,24(R10) C(R10)=A(CP21-CQ40) 16940000 L R4,ISLKEYAD C(R4)=A(KEY OF LAST WR CKD) 16960000 IC R5,24(R10) SAVE OP 16980000 ST R4,24(R10) STORE ADR OF KEY 17000000 STC R5,24(R10) RESTORE OP 17020000 * 17040000 * 17060000 * EXCP RETURN TO IOS - EXECUTE CP21 TO WRITE CYLINDER INDEX 17080000 * 17100000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 17120016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 17140016 * 17160000 EJECT 17180000 *********************************************************************** 17200000 * CHART F6 - APPENDAGE MST DUMMY, CP21 CHANNEL END - ENTERED FROM F4 * 17220000 *********************************************************************** 17240000 * 17260000 * A DUMMY MASTER INDEX ENTRY HAS JUST BEEN WRITTEN AS THE LAST ENTRY 17280000 * ON THE PREVIOUS TRACK. THE DATA PORTION OF THAT ENTRY CONTAINS THE 17300000 * CYLINDER AND TRACK ADDRESS OF THE REAL MASTER INDEX ENTRY. THE REAL 17320000 * MASTER INDEX ENTRY MUST NOW BE WRITTEN ON THE NEW TRACK. 17340000 * * R7 POINTS TO CURRENT IXLT LEVEL * 17360000 * 17380000 * TURN DUMMY SW OFF 17400000 * 17420000 ISLF601 NI 0(R7),X'BF' SET LEVEL IND BIT-1 OFF 17440000 * 17460000 * 17480000 * UPDATE STEPPING COUNT USING DUMMY DATA CONTENTS, PLACE IN IOBB+32 17500000 * 17520000 MVC 9(8,R7),8(R9) C(SX)=MBBCCHHR FROM AREA Y +8 17540000 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT SX), MBBCCHHR 17560000 * 17580000 * CONSTRUCT COUNT FOR MASTER INDEX ENTRY IN AREA Y, Y+0 17600000 * 17620000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT SX 17640000 MVI 4(R9),X'01' COUNT = CCHHR WITH R=1 17660000 * 17680000 * CONSTRUCT DATA FOR MASTER INDEX ENTRY IN AREA Y, Y+8 17700000 * 17720000 STC R5,16(R9) STORE LEVEL IN F-BYTE 00000III 17740000 * 17760000 MVI 15(R9),X'00' DATA WITH R=0 17780000 * 17800000 LR R5,R7 C(R5)=A(CURRENT LEVEL IXLT) 17820000 S R5,ISL26 C(R5)=A(NEXT LOWER LEVEL IXLT) 17840000 MVC 8(6,R9),9(R5) DATA=MBBCCH OF LOWER LEVEL SX 17860000 IC R4,15(R5) C5R4)=H OF LOWER LEVEL SX 17880000 TM 0(R5),X'40' IS DUMMY BIT ON NEXT A30945 17885020 * * LOWER LEVEL 17890020 BO ISLF6011 YES - INDEX ENTRY OK A30945 17895020 BCTR R4,0 C(R4)=H-1 17900000 ISLF6011 EQU * * A30945 17910020 STC R4,14(R9) DATA=MBBCCHH-1 OF LOWER SX 17920000 NI 14(R9),X'F8' ZERO TRACK FOR 2301 17940000 MVC TSTWK1C(4),12(R7) MOVE CCHH FROM IXLT SX 17960000 NI TSTWK1C+3,X'F8' ZERO TRACK FOR 2301 17980000 CLI ISLAREAZ+86,X'02' IS IT 2301 18000000 BE ISLF6015 BR IF 2301 TO COMPARE 18020000 * 18040000 MVI 14(R9),X'00' NOT 2301, SET TRACK=0 18060000 MVI TSTWK1C+3,X'00' SET TRACK=0 18080000 * 18100000 ISLF6015 CLC 11(4,R9),TSTWK1C CCH0 IN IOBB+32 VS CCH0 IN SX 18120000 STC R4,14(R9) SET H BACK TO TRACK ADDRESS 18140000 BNE ISLF6017 18160000 * 18180000 * CCS EQUAL 18200000 MVI 17(R9),X'1B' DATA=MBBCCHHRFP WITH P=1B 18220000 B ISLF604 18240000 * 18260000 * UNEQUAL 18280000 ISLF6017 EQU * 18300000 CLI ISLAREAZ+86,X'05' IS IT 2321 18320000 BNE ISLF602 NOT 2321, BR TO SET P=0B 18340000 * 2321 18360000 CLC 11(2,R9),TSTWK1C TEST FOR SAME STRIP & SUBCELL 18380000 BE ISLF602 BR IF SAME, SET P=0B 18400000 MVI 17(R9),X'07' SET P=07 18420000 B ISLF604 18440000 * CCS UNEQUAL 18460000 ISLF602 MVI 17(R9),X'0B' DATA=MBBCCHHRFP WITH P=0B 18480000 * 18500000 * SET CQ43 (CP21) TO ADDRESS KEY 18520000 * OF LAST RECORD IN LAST BUFFER 18540000 * 18560000 ISLF604 L R10,24(R10) C(R10)=A(CP21-CQ40) 18580000 L R4,ISLKEYAD C(R4)=A(KEY OF LAST WR CKD) 18600000 IC R5,24(R10) SAVE OP 18620000 ST R4,24(R10) STORE ADDR OF KEY 18640000 STC R5,24(R10) RESTORE OP 18660000 * 18680000 * 18700000 * EXCP RETURN TO IOS - EXECUTE CP21 TO WRITE MASTER INDEX 18720000 * 18740000 B ISLF441 GO GET DEB BB 18760013 * AND EXCP RETURN 18780013 * 18800000 EJECT 18820000 *********************************************************************** 18840000 * CHART F7 - APPENDAGE, ABNORMAL END * 18860000 *********************************************************************** 18880000 * 18900000 * TEST IOB FOR PERMENANT ERROR 18920000 * 18940000 ISLF701 TM IOBECBAD,X'20' TEST BIT 2 OF ECBCC 11643 18960015 BZ ISLF702 B IF PERMANENT ERROR 11643 18980015 B ISLF115 NON-PERM ERR = NORMAL RETURN 19000000 * 19020000 * TEST IF CP18 HUNG ON A WR CKD 19040000 * 19060000 ISLF702 L R3,IOBCSW C(R3)=COMMAND ADDR+8 S20201 19080020 LA R3,0(R3) 19100000 S R3,ISL8 C(R3)=COMMAND ADDR OF LAST CCW 19120000 L R4,12(R10) C(R4)=A(CP18) 19140000 LA R4,24(R4) C(R4)=A(CP18, 1ST WR CKD) 19160000 L R5,16(R10) C(R5)=A(CP19) 19180000 S R5,ISL16 C(R5)=RA(CP18, LAST WR S20201 19190020 * CKD) S20201 19200020 CR R3,R4 LAST CCW VS CP18 CCW 1 19220000 BL ISLF710 B IF NOT IN CP18 19240000 CR R3,R5 LAST CCW VS CP18 CCW N 19260000 BH ISLF710 B IF NOT IN CP18 19280000 * 19300000 * CP18 HUNG ON A WR CKD - GET ADDR OF LAST BUFFER WRITTEN 19320000 * 19340000 TM 0(R3),X'1D' TEST FOR CCW WITH OP CODE 19360000 BC 1,ISLF703 B IF FOUND 19380000 S R3,ISL8 BACK UP 1 CCW 19400000 TM 0(R3),X'1D' TEST FOR CCW WITH OP CODE 19420000 BC 1,ISLF703 B IF FOUND 19440000 S R3,ISL8 BACK UP 1 CCW 19460000 * 19480000 ISLF703 L R6,0(R3) C(R6)=DATA ADDR OF LAST WR CKD 19500000 LA R6,0(R6) 19520000 B ISLF711 19540000 * 19560000 ISLF710 SR R6,R6 ERROR NOT IN CP18, C(R6)=0 19580000 * 19600000 ISLF711 NI IOBFLAG1,X'FB' TURN OFF EXCEPTION FLAG 15924 19620016 OI DCBEXCD1,X'04' SET EXCD1 BIT 5 ON = WR ERROR 19640000 STH R6,ISLVPTRA+TWO (SHIFT SO FTIW FLAGES XA04602 19650000 SRL R6,16 WON'T BE DESTROYED) XA04602 19660000 STC R6,ISLVPTRA+ONE SAVE A(BAD BUFFER) XA04602 19662000 LA R3,IOBS C(R3)=A(BUF 1 STATUS) 19700000 * 19720000 ISLF712 NI 0(R3),X'B0' TURN BIT 1 OFF 19740000 OI 0(R3),X'20' TURN BIT 2 ON 19760000 A R3,ISL4 BUMP R3 TO NEXT SLOT 19780000 C R3,ISLBUFN TEST FOR NTH SLOT 19800000 BNH ISLF712 LOOP UNTIL ALL STATUS = 01 19820000 * 19840000 B ISLF125 19860000 * 19880000 EJECT 19900000 * 19920000 * CONSTANTS 19940000 * 19960000 ISL0 DC F'0000' 19980000 ISL1 DC F'0001' 20000000 ISL4 DC F'0004' 20020000 ISL8 DC F'0008' 20040000 ISL10 DC F'0010' 20060000 ISL16 DC H'16' CONSTANT S20201 20070020 ISL26 DC F'0026' 20080000 ISLFF DC F'8888' 20100000 * 20120000 EJECT 20140000 END 20160000 ./ ADD SSI=07010390,NAME=IGG019GD,SOURCE=0 TITLE 'IGG019GD - APPENDAGE ROUTINES, WR CHK' 00020000 COPY LCGASMSW 00022001 IGG019GD CSECT 00030000 * RELEASE 14 DELETIONS * 00042000 * RELEASE 15 DELETIONS * 00044000 *1633 11877 00045015 * RELEASE 16 DELETIONS * 00046000 *0137072000-082200,215400-215600 13334 00046516 *0137 13711 00047016 *0137 15924 00047516 * RELEASE 17 DELETIONS * 00048000 *1650000680,224600,225000 MC0V 00049000 * RELEASE 18 DELETIONS * 00050000 *2980034000,035440,129600 VLR 00050518 *2980128400,129600 21347 00051018 *2980034200-035440,218400-218600 25463 00051518 * RELEASE 19 DELETIONS * 00052000 *2182068800-069200 A28706 00052519 *2182035000-035100,223200,234800-235000,236800 O19110 00053019 *2182066000 A27321 00053519 * RELEASE 20 DELETIONS * 00054000 *0492 A30945 00054520 *0492223200,234800,236800 A32559 00055020 *0492015000,015200-022000,022400,022600,022800-035600,085000, S20201 00055120 *0492085400,086800,088000,088200,088400,091200,091600,092400, S20201 00055220 *0492096200,096400,100000,100200,100500,106200,106400,106600, S20201 00055320 *0492106800,111600,112600,112800,113000,113400,114000,114200, S20201 00055420 *0492114400,116800,117000,117200,117600,118200,118400,118600, S20201 00055520 *0492213000,231600,232200,232400,232600,233000,233600,233800, S20201 00055620 *0492234000,240200 S20201 00055720 * RELEASE 21 DELETIONS * 00056000 *3529046200,052400,052800 S21045 00057021 *3529210200-211200,221800-222000,223000-223400,225600-225800, A42170 00057321 *3529226000-229950,234800-234900,235800,236800 A42170 00057621 *D069300 SA55487 00057700 *A218300-218420,D218500 XA04602 00058000 * VS2 APAR YA03702 AND OS APAR SA69201 APPEAR AS XA04602 00060000 *STATUS CHANGE LEVEL 011 00068021 * * 00080000 *FUNCTION/OPERATION- THIS MODULE CONTAINS THE APPENDAGE ROUTINES FOR * 00100000 * PROCESSING ALL LOAD MODE I/O RETURNS. THE CHANNEL END APPENDAGE * 00120000 * ROUTINES SIGNAL THE COMPLETION OF INDEX AND/OR BUFFER WRITING. * 00140000 * THE ABNORMAL APPENDAGE ROUTINE PREPARES FOR AN ABNORMAL TERMIN- * 00160000 * ATION OF THE JOB. THIS MODULE SUPPORTS BOTH FIXED AND 00186018 * VARIABLE LENGTH RECORD FORMATS. 00192018 * * 00200000 *ENTRY POINTS- 'IGG019GD' IS THE ENTRY POINT WHEN NO APPENDAGE * 00220000 * PROCESSING IS REQUIRED. * 00240000 * 'IGG019GD+4' IS THE ENTRY POINT FOR CHANNEL END * 00260000 * APPENDAGE PROCESSING. * 00280000 * 'IGG019GD+12' IS THE ENTRY POINT FOR ABNORMAL END * 00300000 * APPENDAGE PROCESSING. * 00320000 * ACCESS TO THIS MODULE IS PROVIDED BY A VECTOR OF FIVE ADDRESSES * 00340000 * LOCATED AT DEB-36. * 00360000 * * 00380000 *INPUT- REGISTER 2 -POINTS TO IOB. * 00400000 * REGISTER 3 -POINTS TO DEB. * 00420000 * REGISTER 4 -POINTS TO DCB. * 00440000 * REGISTER 14 -POINTS TO RETURN FROM APPENDAGE. * 00460000 * * 00480000 *OUTPUT- SAME REGISTER SETTING AS INPUT. * 00500000 * * 00520000 *EXTERNAL ROUTINES- THIS MODULE WORKS IN CONJUNCTION WITH LOAD MODE * 00540000 * PUT (IGG019GB), CHANNEL PROGRAMS, AND IOS. * 00560000 * * 00580000 *EXITS-NORMAL- (ISLF115) FOR NORMAL RETURN TO IOS, CHANNEL END. * 00600000 * (ISLF340) FOR EXCP RETURN TO IOS - CP19. * 00620000 * (ISLF440) FOR EXCP RETURN TO IOS - CP21. * 00640000 * (ISLF505) FOR EXCP RETURN TO IOS - CP21 CYL DUMMY. * 00660000 * (ISLF604) FOR EXCP RETURN TO IOS - CP21 MAST DUMMY. * 00680000 * (ISLF761) FOR EXCP RETURN TO IOS - WR ERR RETRY. * 00700000 * (ISLF125) FOR NORMAL RETURN TO IOS, ABNORMAL. * 00720000 * * 00740000 *TABLES/WORK AREAS- * 00760000 * DCB - COMMUNICATION WITH USER. * 00780000 * DEB - COMMUNICATION WITH IOS. * 00800000 * ISLCOMON - COMMUNICATION WITHIN LOAD MODE. * 00820000 * ISLIOBA - COMMUNICATION WITH I/O FOR CP18 AND CP20. * 00840000 * ISLIOBB - COMMUNICATION WITH I/O FOR CP21. * 00860000 * ISLIOBC - COMMUNICATION WIT I/O FOR CP19. * 00880000 * ISLAREAZ - WORK AREA USED FOR PREFORMATTING. * 00900000 * ISLIXLT - INDEX LOCATION TABLE, LOCATES HI-LEVEL INDICIES. * 00920000 * ISLY - WORK AREA USED WHEN WRITING INDICIES. * 00940000 * ISLVPTRS - VARIABLE POINTERS, REFERENCE VARIABLE LENGTH BLOCKS. * 00960000 * IOBBCT - BUFFER CONTROL TABLE, CONTROLS BUFFER USAGE. * 00980000 * * 01000000 *ATTRIBUTES- READ ONLY, REENTRANT, PRIVILEGED, DISABLED, REUSABLE. * 01020000 * * 01040000 *NOTES- SECTIONS OF THE PROCESSING IN THIS MODULE ARE ENTERED * 01060000 * DIRECTLY FROM CLOSE PROCESSING. IN SUCH CASES, PROCESSING IS * 01080000 * CARRIED ON AS THOUGH IT WAS PART OF CLOSE. * 01100000 * ENTRY POINT - ISLF110 * 01120000 * * 01140000 * ****************************************************************** 01160000 * THE FOLLOWING NOTATION IS FREQUENTLY USED THROUGHOUT COMMENTS - * 01180000 * C(FIELD X) = A(FIELD Y) * 01200000 * CONTENTS OF FIELD X = ADDRESS OF FIELD Y * 01220000 * ****************************************************************** 01240000 * * 01260000 EJECT 01280000 ******************** 01320000 * DCB REFERENCE * 01340000 ******************** 01360000 DCBD DSORG=(IS) 01380000 USING IHADCB,R1 01400000 EJECT 01420000 ******************** 01440000 * DEB REFERENCE * 01460000 ******************** 01480000 IHADEB IGGDEBD 01490020 EJECT 02220000 ISLCOMON IGGLOAD 02230020 USING ISLCOMON,R12 S20201 02240020 EJECT 02260020 * 03580000 * IOBBCT REFERENCE C(ISLVPTRS+8)=A(IOBBCT) 03600000 * 03620000 IOBBCT DSECT 03640000 USING IOBBCT,R11 03660000 DS 0D 03680000 IOBFLAGS DS 0CL1 FLAGS 03700000 IOBPTRA DS A PTR A 03720000 IOBB DS 0CL1 B 03740000 IOBPTRB DS A PTR B 03760000 IOBS DS 0CL1 S - STATUS FIELD FOR BUF NO 1 03780000 IOBABUF DS A A(BUF NO 1) - ADR OF BUF NO 1 03800000 EJECT 03804020 LDCPS DSECT 03808020 IGGLDCP OPTCD=W LOAD CHANNEL S20201 03812020 * PROGRAMS S20201 03816020 EJECT 03820000 ******************** 03840000 * IOB REFERENCE * 03860000 ******************** 03880000 * 03900000 IHAIOB DSECT 03920000 USING IHAIOB,R2 03940000 DS 0D 03960000 IOBFLAG1 DS CL1 FLAGS 1 15924 03980016 IOBFLAG2 DS CL1 FLAGS 2 15924 04000016 DS CL1 04020000 IOBSENSE DS CL1 SENSE 04040000 IOBECBAD DS A ECB POINTER 04060000 IOBCSW DS CL8 CHANNEL STATUS WORD 04080000 IOBSIOCC DS 0CL1 SIO CC 04100000 IOBCPSAD DS A CHANNEL PROGRAM START ADR 04120000 IOBWT DS 0CL1 WEIGHT 04140000 IOBDCBAD DS A DCB POINTER 04160000 IOBCPRAD DS A CHANNEL PROGRAM RESTART ADR 04180000 IOBBCTI DS CL2 BLK CTR INCR 04200000 IOBERRCT DS CL2 ERROR COUNT 15924 04220016 IOBDADAD DS CL8 DIR ACESS DEV ADR MBBCCHHR 04240000 * 04260000 ******************** 04280000 * IXLT REFERENCE * 04300000 ******************** 04320000 * 04340000 IXLT DSECT 04360000 USING IXLT,R7 04380000 DS 0D 04400000 IXLTIND DS CL1 INDICATOR LEV1 04420000 IXLBEG DS CL8 BEGINING COUNT MBBCCHHR 04440000 IXLSTP DS CL8 STEPPING COUNT MBBCCHHR 04460000 IXLEND DS CL8 ENDING COUNT MBBCCHHR 04480000 DS CL1 04500000 DS CL26 LEV2 04520000 DS CL26 LEV3 04540000 DS CL26 LEV4 04560000 EJECT 04580000 IGG019GD CSECT 04600000 * 04640000 * EQUATE SYMBOLIC REGISTERS 04660000 * 04680000 R0 EQU 0 04700000 R1 EQU 1 04720000 R2 EQU 2 04740000 R3 EQU 3 04760000 R4 EQU 4 04780000 R5 EQU 5 04800000 R6 EQU 6 04820000 R7 EQU 7 04840000 R9 EQU 8 04880000 R10 EQU 10 04900000 R11 EQU 11 04920000 R12 EQU 12 04940000 R13 EQU 13 04960000 R14 EQU 14 04980000 R15 EQU 9 05000000 R16 EQU 15 05020000 RQESAV EQU ISLAPSAV+36 RQE POINTER SAVED HERE 05023000 RQEDEB EQU 8 DEB ADDRESS 05026000 EXCP EQU 8 15924 05030016 ALL EQU X'FF' ALL SWS ON S20201 05030920 CM24X EQU CM2+4 COUNT FOR MULTIPLE CPQ9 S20201 05031820 * * EXECUTIONS. 05032720 CM64 EQU CM6+4 FIRST TIME INDICATOR S20201 05033620 CM264 EQU CM26+4 LAST CC SPOT S20201 05034520 CM273 EQU CM27+3 CCHHR FOR CM5 S20201 05035420 L4 EQU 4 LENGTH S20201 05036320 FOUR EQU 4 MISC 05036700 ONE EQU 1 * 05037100 TWO EQU 2 * 05039000 CM34 EQU CM3+4 CONTROL BYTE OF READ S20201 05041020 CM74 EQU CM7+4 CONTROL BYTE OF READ S20201 05042920 CM84 EQU CM8+4 CONTROL BYTE S20201 05044820 AIF ('&LIB' EQ 'LIB1').NOT00 05046701 FLAGS EQU 10 FLAG BYTE IN TISA 05048601 CP20CNXT EQU X'02' SCHEDULE CP20C NEXT 05050501 CP18NEXT EQU X'01' SCHEDULE CP18 NEXT 05052401 CP20LAST EQU CP18NEXT+CP20CNXT LAST CP SCHEDULED 05054301 .NOT00 ANOP 05056201 * 05058100 EJECT 05060000 *********************************************************************** 05080000 * GENERAL APPENDAGE ROUTINE * 05100000 *********************************************************************** 05120000 * 05140000 * 05160000 * APPENDAGE ROUTINE ENTRANCES 05180000 * 05200000 B 0(R14) NO APPENDAGE RT, RETURN TO IOS 05220000 USING *+8,R15 S21045 05228021 CE LA R15,TWOINSTR(R16) SET COMMON BASE S21045 05236021 TWOINSTR EQU 8 LENGTH OF TWO S21045 05244021 * INSTRUCTIONS S21045 05252021 B ISLF110 B TO CE RT 05260000 ABE LR R15,R16 SET COMMON BASE S21045 05280021 B ISLF120 B TO AE RT 05300000 * 05320000 EJECT 05340000 * 05360000 * CE ENTRANCE AND EXIT 05380000 ********************** 05400000 * 05420000 ISLF110 BAL R13,ISLF130 LINK TO COMMON HSK 05440000 * 05460000 * LOCATE PROPER CHANNEL END APPENDAGE ROUTINE 05480000 * 05500000 LA R3,0(R2) C(R3)=A(IOBX) 05520000 LA R4,ISLIOBB C(R4)=A(IOBB) 05540000 CR R3,R4 COMP IOBX VS IOBB 05560000 BH ISLF331 B IF IOBX = IOBC (CP19) 05580000 BE ISLF401 B IF IOBX = IOBB (CP21) 05600000 B ISLF201 * B IF IOBY=IOBA(CP18-20) 13334 05620016 * 05640000 * 05660000 ISLF115 BAL R13,ISLF140 LINK TO COMMON END 05680000 B 0(R14) NORMAL RETURN TO IOS 05700000 * 05720000 * 05740000 * AE ENTRANCE AND EXIT 05760000 ********************** 05780000 * 05800000 ISLF120 BAL R13,ISLF130 LINK TO COMMON HSK 05820000 TM DCBEXCD1,X'04' TEST EXCD1 BIT 5 FOR PREV ERR 05840000 BC 1,ISLF125 B IF ON, ONLY 1 ERR PER JOB 05860000 B ISLF731 B TO ABNORMAL APPENDAGE 05880000 * 05900000 ISLF125 BAL R13,ISLF140 LINK TO COMMON END 05920000 B 0(R14) NORMAL RETURN TO IOS 05940000 * 05960000 * 05980000 * COMMON APPENDAGE HOUSEKEEPING 06000000 *********************************************************************** 06020000 * 06040000 ISLF130 LR R11,R1 SAVE 12* ADR 06060000 LR R1,R4 C(R1)=A(DCB) 06080000 L R12,DCBWKPT1 C(R12)=A(COMMON) 06100000 STM R2,R11,ISLAPSAV SAVE REGS 2-11 06120000 ST R0,ISLAPSAV+(R15-R2)*FOUR SAVE R0 06130000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 06140000 L R11,8(R10) C(R11)=A(IOBBCT) 06160000 * C(R2)=A(IOB) - GIVEN 06180000 LR R0,R3 DEB ADDRESSABILITY 06190000 * 06200000 * 06220000 BR R13 EXIT 06240000 * 06242016 * 06244016 EXCPRTRN XC IOBFLAG2(3),IOBFLAG2 CLEAR FLAG2,SENSE BYTES 15924 06246016 XC IOBCSW(9),IOBCSW CLEAR FLAG3,CSW,SIOCC 15924 06248016 XC IOBERRCT(2),IOBERRCT CLEAR ERROR COUNT 15924 06250016 NI IOBFLAG1,X'C2' RESET FLAG1 15924 06252016 * 06260000 * 06280000 * COMMON APPENDAGE END 06300000 *********************************************************************** 06320000 * 06340000 ISLF140 LM R2,R11,ISLAPSAV RESTORE REGS 2-11 06360000 LR R1,R11 C(R1)=12* ADR 06380000 L R0,ISLAPSAV+(R15-R2)*FOUR RESTORE R0 06390000 SR R15,R15 CLEAR 9 06400000 * 06420000 BR R13 EXIT 06440000 EJECT 06460000 *********************************************************************** 06480000 * CHART F2 - APPENDAGE, CP18 AND CP20 CHANNEL END * 06500000 *********************************************************************** 06520000 * 06540000 * SET FLAGS BIT 0 = 0, (IWR)- CP(S) IS NOW AVAILABLE 06560000 * 06580000 ISLF201 EQU * A27321 06590019 MVI DCBWKPT2,X'0A' RESET RETRY COUNT A42170 06595021 * 06601019 * FOR FULL TRACK INDEX WRITE OPTION - IF CP20 06602019 * WAS EXECUTED WITHOUT CP18 (BIT 4 OF FLAG FIELD 06603019 * IN THE TRACK INDEX SAVE AREA IS ON) THEN RETURN 06604019 * TO IOS WITHOUT UPDATING BUFFER POINTER. 06605019 * 06606019 TM 36(R10),X'C0' SUCCESSFUL GETMAIN FOR O19110 06607019 * FULL TRACK INDEX WRITE 06608019 BNO ISLF2014 NO - BR TO CONTINUE O19110 06609019 L R4,36(R10) C(R4)=A(FTIW TI SAVE O19110 06610019 * AREA) 06610101 AIF ('&LIB' EQ 'LIB1').NOT01 06610201 * IF AOS CP20A OF B ,CP20C AND CP18 ARE SCHEDULED SEPARATELY AND 06610301 * MUST BE RESTARTED FROM THIS APPENDAGE. 06610401 TM FLAGS(R4),CP20LAST FINISHED SCHEDULING 06610501 BO ISLF2014 YES - DONE 06610601 TM FLAGS(R4),CP20CNXT IS IT NEXT 06610701 BZ AOSNT20C NO - DON'T SCHEDULE IT 06610801 MVC IOBCPSAD,ISLVPTRC ASSUME CP20C NEXT 06610901 NI FLAGS(R4),X'FF'-CP20CNXT RESET SW 06611001 OI FLAGS(R4),CP18NEXT SCHEDULE CP18 AFTERWORD 06611101 AOSEXCP EQU * EXCP CP 18 OR CP20C 06611201 BAL R13,EXCPRTRN REFRESH IOB 06611301 B EXCP(R14) LINK TO IOS TO EXCP 06611401 AOSNT20C EQU * SCHEDULE CP18 IF NECESSARY 06611501 .NOT01 ANOP 06611601 TM 10(R4),X'08' CP20 EXECUTED ALONE O19110 06612019 BO ISLF115 YES-RETURN TO IOS EXIT O19110 06613019 AIF ('&LIB' EQ 'LIB1').NOT02 06613701 * START CP 18 IF NECESSARY. 06614401 TM FLAGS(R4),CP18NEXT SHOULD CP18 BE SCHE 06615101 BNO ISLF2014 NO - FINISHED 06615801 MVC IOBCPSAD,ISLVPTR4 ASSUME CP18 NEXT 06616501 MVC IOBDADAD,0(R4) * 06617201 OI FLAGS(R4),CP20LAST MARK CP20 SCHEDULED 06617901 B AOSEXCP EXCP CP18 06618601 .NOT02 ANOP 06619301 * 06620000 * SET OFF STATUS BITS 1 AND 2, 00 = BUFFER AVAILABLE 06640000 * SET OFF STATUS BIT 4, 0 = T-BIT OFF 06660000 * DO THIS FOR EACH BUFFER THAT WAS JUST WRITTEN AND UPDATE PTR A AT THE 06680000 * SAME TIME. AT FINISH, PTR A WILL POINT TO NEXT SLOT TO SCHEDULE FOR 06700000 * WRITING. 06720000 * 06740000 ISLF2014 EQU * O19110 06750019 L R3,IOBPTRA C(R3)=A(1ST SLOT WRITTEN) 06760000 LA R3,0(R3) 06780000 ISLF202 TM 0(R3),X'60' TEST BITS 1 AND 2 VS 11 06800000 BC 1,ISLF203 B IF BITS 1 AND 2 = 11 06820000 * 06840000 * BITS 1 AND 2 NOT 11, FINISHED 06860000 ST R3,ISLVRSAV+24 A28706 06880019 MVC IOBPTRA+1(3),ISLVRSAV+25 MOVE INTO PTRA A28706 06900019 B ISLF115 NORMAL RETURN TO IOS EXIT 06940000 *---------------------------------------------------------------------- 06960000 * 06980000 ISLF203 NI 0(R3),X'97' TURN BITS 1,2 AND 4 (IF ON) OFF 07000000 A R3,ISL4 BUMP R3 TO ADR NEXT SLOT 07020000 C R3,ISLBUFN TEST FOR ADR OF NTH SLOT 07040000 BH ISLF204 B IF OUTSIDE TBL = WRAPAROUND 07060000 B ISLF202 LOOP AGAIN 07080000 * 07100000 * WRAPAROUND 07120000 ISLF204 LA R3,IOBABUF C(R3)=A(SLOT 1) 07140000 B ISLF202 LOOP AGAIN 07160000 EJECT 07180000 EJECT 08240000 *********************************************************************** 08260000 * CHART F3 - APPENDAGE, CP19 CHANNEL END * 08280000 *********************************************************************** 08300000 * 08320000 ISLF301 L R10,16(R10) C(R10)=A(CP19) 08340000 USING CM1,R10 ADDRESSABILITY ON CP19 S20201 08350020 CLC 12(4,R10),ISL0 TEST CM2+4 VS 0000 = 10 OR LESS 08360000 BE ISLF115 B IF TEN OR LESS ENTRIES TO BE 08380000 * PREFORMATTED FOR NORMAL IOS 08400000 * RETURN. 08420000 * 08440000 * MORE THAN TEN ENTRIES TO PREFORMAT 08460000 * 08480000 CLC CM64(L4),ISL0 TEST CM6+4 VS 0000 = 1ST S20201 08490020 * CE S20201 08500020 BE ISLF302 B IF 1ST CE FOR THIS CYLINDER 08520000 CLC CM64(L4),ISLFF TEST CM6+4 VS FFFF = END S20201 08540020 BNE ISLF303 B IF PREFORMATTING IN PROCESS 08560000 B ISLF320 B IF END 08580000 * 08600000 * 08620000 * 1ST CE WHILE PREFORMATTING THIS CYLINDER 08640000 * 08660000 ISLF302 LA R4,CM5 C(R4)=A(CM5) S20201 08680020 IC R5,IOBSIOCC SAVE SIOCC 08700000 ST R4,IOBCPSAD STORE A(CM5) IN IOBC CP START 08720000 STC R5,IOBSIOCC RESTORE SIOCC 08740000 * 08760000 LA R4,35(R2) CM5 08780000 IC R5,CM5 S20201 08800020 ST R4,CM5 STORE ADR IOBC+35 S20201 08820020 STC R5,CM5 S20201 08840020 * 08860000 * CALCULATE COUNT OF NO. OF EXECUTES OF CP19 FROM APPENDAGE 08880000 * 08900000 SR R4,R4 08920000 SR R5,R5 08940000 IC R5,DCBFIRSH+2 C(R5)=R OF FIRSH 08960000 S R5,ISL1 DIVIDEND = 0000000N IN R4-R5 08980000 D R4,ISL10 DIVISOR = 000A 09000000 * C(R4) = REMAINDER R = 000R 09020000 * C(R5) = QUOTIENT Q 09040000 C R4,ISL0 TEST R VS 0 09060000 BNE ISLF3025 B IF R NOT 0 09080000 S R5,ISL1 R=0, ADJUST Q DOWNWARDS 09100000 ISLF3025 ST R5,CM64 C(CM6+4)=Q, Q GR 0 S20201 09120020 * 09140000 ISLF303 L R5,CM64 C(R5) = COUNT Q S20201 09160020 C R5,ISL1 TEST FOR LAST EXECUTE 09180000 BE ISLF305 B IF LAST EXECUTE 09200000 S R5,ISL1 DECREMENT COUNT Q 09220000 ST R5,CM64 C(CM6+4) = Q, Q GR 0 S20201 09240020 * 09260000 * PREPARE TO EXECUTE PREFORMAT 09280000 * 09300000 ISLF304 LA R9,ISLAREAZ C(R9)=A(AREA Z) 09320000 MVC 37(3,R2),80(R9) C(IOBC+37)=HHR FROM COUNT 10 09340000 SR R5,R5 09360000 IC R5,82(R9) C(R5)=R FROM COUNT 10 09380000 BAL R13,ISLF310 B TO SET UP AREA Z 09400000 * 09420000 * EXCP RETURN TO IOS - EXECUTE CP19 AGAIN 09440000 * 09460000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 09480016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 09500016 * 09520000 * 09540000 * PREPARE TO EXECUTE LAST PREFORMAT FOR THIS CYLINDER 09560000 * 09580000 ISLF305 L R4,ISLFF C(R4)=FFFF 09600000 ST R4,CM64 C(CM6+4) = FFFF = END S20201 09620020 L R4,CM24X C(R4)=C(CM2+4)=A(CC S20201 09630020 * FLAG) S20201 09640020 NI 0(R4),X'BF' TURN CC FLAG OFF 09660000 B ISLF304 B TO COMMON PREPARE 09680000 * 09700000 * SUBROUTINE TO SET UP AREA Z 09720000 * 09740000 ISLF310 L R3,ISL10 C(R3)=10 = LOOP COUNT 09760000 LA R4,10(R9) C(R4)=A(Z+10) = 1ST R 09780000 ISLF311 A R5,ISL1 STEP R 09800000 STC R5,0(R4) STORE R IN Z 09820000 A R4,ISL8 STEP Z 09840000 BCT R3,ISLF311 LOOP 09860000 BR R13 EXIT 09880000 * 09900000 * 09920000 * END OF APPENDAGE - RESET CONDITIONS 09940000 * 09960000 ISLF320 SR R5,R5 09980000 ST R5,CM64 C(CM6+4) = 0000 S20201 10000020 L R4,CM24X C(R4)=C(CM2+4)=A(CC S20201 10010020 * FLAG) S20201 10020020 OI 0(R4),X'40' TURN CC FLAG BACK ON 10040000 NI CM264,ALL-CC TURN OFF TENTH CC FLAG S20201 10046020 * 1187 S20201 10052020 LA R9,ISLAREAZ C(R9)=A(AREA Z) 10060000 BAL R13,ISLF310 B TO SET UP AREA Z, 1ST R = 1 10080000 * 10100000 TM DCBOPTCD,X'08' TEST OPTCD BIT-4 FOR CYL OVFL 10120000 BC 8,ISLF325 B IF NO CYL OVFL 10140000 * 10160000 * CYL OVFL ON 10180000 IC R5,IOBSIOCC SAVE SIOCC 10200000 ST R10,IOBCPSAD STORE A(CM1) IN IOBC CP START 10220000 STC R5,IOBSIOCC RESTORE SIOCC 10240000 * 10260000 NI 38(R2),X'F8' SET TO TRACK 0-ASSUME 2301 10280000 MVI 39(R2),X'00' SET R=0 10300000 CLI DCBDEVT,X'02' IS IT 2301 10320000 BE ISLF3205 BR IF 2301 10340000 MVI 38(R2),X'00' SET TRACK=0 10360000 CLI DCBDEVT,X'05' IS IT 2321 10380000 BE ISLF3207 10400000 ISLF3205 MVI 37(R2),X'00' SET 1ST H TO ZERO 10420000 * 10440000 ISLF3207 EQU * 10460000 CLI DCBFIRSH+1,X'00' FIRSH VS 0 10480000 BE ISLF115 B IF CYL OVFL RCD IS ON SHARED 10500000 * TRACK = CM5 OK - EXIT,NORM RTRN 10520000 * 10540000 * CYL OVFL RCD NOT ON SHARED TRK 10560000 TM IOBFLAGS,X'10' CP 91 IN CONTROL 10580000 BO ISLF115 YES, CP 91 IN CONTROL RETURN TO IOS 10600000 LA R4,CM273 CM5 S20201 10620020 IC R5,CM5 S20201 10640020 ST R4,CM5 STORE ADR CM27+3 S20201 10660020 STC R5,CM5 S20201 10680020 * 10700000 B ISLF115 EXIT,NORM RTRN 10720000 * 10740000 * NO CYL OVFL - CP START OK 10760000 ISLF325 EQU * 10780000 MVI 39(R2),X'00' SET R=0 IN IOBC+39 10800000 CLI DCBDEVT,X'02' IS IT 2301 10820000 BNE ISLF326 BRANCH IF NOT 2301 10840000 NI 38(R2),X'F8' ZERO TRACK BITS 10860000 OC 38(1,R2),DCBFIRSH+1 SET IOBC+38 TO TRACK FROM FIRSH 10880000 B ISLF115 EXIT, NORMAL RETURN 10900000 * 10920000 ISLF326 MVC 38(1,R2),DCBFIRSH+1 SET IOBC+38 TO TRACK FROM FIRSH 10940000 * CM5 OK 10960000 B ISLF115 EXIT,NORM RTRN 10980000 EJECT 11000000 * 11020000 * CHART F3 - EXTENTION FOR WR CHK 11040000 * 11060000 ISLF331 SR R3,R3 11080000 MVI DCBWKPT2+2,X'0A' RESET RETRY COUNT A42170 11090021 IC R3,ISL10+3 C(R3)=NO OF WR CKD CCWS 11100000 * 11120000 L R10,16(R10) C(R10)=A(CP19) 11140000 CLI CM3,X'06' TEST CM3 OP CODE FOR S20201 11150020 * READ D S20201 11160020 BE ISLF341 B IF CM3 = READ 11180000 * 11200000 * SET UP CP19 TO READ BACK WHAT WAS JUST WRITTEN 11220000 * 11240000 MVI CM3,RDATA SET CM3 OP CODE TO READ S20201 11250020 * D S20201 11260020 OI CM34,SKIP SET CM3 FLAGS TO SKIP S20201 11280020 CLI CM7,X'0D' TEST CM7 FOR WR KD S20201 11290020 * (CLOSE) S20201 11300020 BNE ISLF332 B IF NOT WR KD 11320000 MVI CM7,RKD SET CM7 TO RD KD S20201 11340020 B ISLF333 11360000 * 11380000 ISLF332 MVI CM7,RCKD SET CCW OP CODE TO READ S20201 11390020 * CKD S20201 11400020 ISLF333 OI CM74,SKIP SET CCW FLAGS TO SKIP S20201 11420020 OI CM84,SKIP SET CCW FLAGS TO SKIP S20201 11440020 A R10,ISL16 STEP R10 TO NEXT CCW 11460000 BCT R3,ISLF332 LOOP 11480000 * 11500000 * EXCP RETURN TO IOS - EXECUTE CP19 TO READ BACK WHAT WAS WRITTEN 11520000 * 11540000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 11560016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 11580016 * 11600000 * 11620000 * RESET CP19 FOR WRITING 11640000 * 11660000 ISLF341 MVI CM3,WD SET CM3 OP CODE TO WRITE S20201 11670020 * D S20201 11680020 NI CM34,ALL-SKIP SET CM3 FLAGS NOT TO S20201 11690020 * SKIP S20201 11700020 CLI CM7,X'0E' TEST CM7 FOR RD KD S20201 11710020 * (CLOSE) S20201 11720020 BNE ISLF342 B IF NOT RD KD 11740000 MVI CM7,WKD SET CM7 TO WR KD S20201 11760020 B ISLF343 11780000 * 11800000 ISLF342 MVI CM7,WCKD SET CCW OP CODE TO WRITE S20201 11810020 * CKD S20201 11820020 ISLF343 NI CM74,ALL-SKIP SET CCW FLAGSNOT TO SKIP S20201 11840020 NI CM84,ALL-SKIP SET CCW FLAGS NOT TO S20201 11850020 * SKIP S20201 11860020 A R10,ISL16 STEP R10 TO NEXT CCW 11880000 BCT R3,ISLF342 LOOP 11900000 * 11920000 L R10,DCBWKPT6 C(R10)=A(VPTRS) 11940000 B ISLF301 B TO CE PROCESSING 11960000 * 11980000 EJECT 12000000 *********************************************************************** 12020000 * CHART F4 - APPENDAGE, CP21 CHANNEL END * 12040000 *********************************************************************** 12060000 * 12080000 ISLF401 LA R7,ISLIXLT C(R7)=A(IXLT) 12100000 MVI DCBWKPT2+1,X'0A' RESET RETRY COUNT A42170 12110021 L R9,0(R10) C(R9)=A(AREA Y) 12120000 LR R6,R7 C(R6)=A(IXLT)=A(LEV1) 12140000 L R5,ISL1 C(R5)=0001 FOR CURRENT LEVEL 12160000 L R3,24(R10) C(R3)=A(CP21) 12180000 TM 20(R3),X'80' TEST CQ42 FOR DC 12200000 BC 8,ISLF115 B IF OFF = EOF, NORMAL RETURN 12220000 * 12240000 * LOCATE CURRENT LEVEL IN IXLT 12260000 * 12280000 TM 0(R7),X'20' TEST LEVEL IND BIT-2 12300000 BC 1,ISLF403 B IF LEVEL 1, CYL IX 12320000 ISLF402 A R7,ISL26 STEP TO NEXT LEVEL IN IXLT 12340000 A R5,ISL1 C(R5)=CURRENT LEVEL 12360000 TM 0(R7),X'20' TEST LEVEL IND BIT-2 12380000 BC 8,ISLF402 B IF NOT THIS LEVEL (LOOP) 12400000 * 12420000 * MASTER INDEX, TEST FOR DUMMY ENTRY 12440000 * 12460000 TM 0(R7),X'40' TEST LEVEL IND BIT-1 12480000 BC 1,ISLF601 B IF MST DUMMY 12500000 B ISLF410 12520000 * 12540000 * CYLINDER INDEX, TEST FOR DUMMY ENTRY 12560000 * 12580000 ISLF403 TM 0(R7),X'40' TEST LEVEL IND BIT-1 12600000 BC 1,ISLF501 B IF CYL DUMMY 12620000 * 12640000 EJECT 12660000 * 12680000 * NORMAL ENTRY APPENDAGE ROUTINE, CYLINDER OR MASTER INDEX 12700000 * * R6 POINTS TO CYLNDER IXLT LEVEL * 12720000 * * R7 POINTS TO CURRENT IXLT LEVEL * 12740000 * 12760000 * TEST R IN COUNT FIELD IN AREA Y FOR END OF TRACK 12780000 * 12800000 ISLF410 CLC 4(1,R9),DCBHIRCM TEST R VS HI R 12820000 BNE CONTINUE BRANCH NOT EQUAL 21347 12826018 CLI 16(R7),X'00' IS R OF SX = 0 ? 21347 12832018 BE ISLF420 BRANCH IF EQUAL 21347 12838018 B ISLF415 21347 12844018 CONTINUE EQU * 21347 12850018 * 12860000 * NOT END OF TRACK 12880000 * REPLACE R OF STEPPING COUNT BY R OF Y 12900000 * 12920000 MVC 16(1,R7),4(R9) R OF SX = R OF Y 12940000 TM IOBFLAGS,X'12' ARE WE IN CLOSE VLR 12960018 BC 1,ISLF420 B IF ON = CLOSE 12980000 * 13000000 * TEST HH OF STEPPING COUNT FOR END OF CYLINDER 13020000 * 13040000 MVC TSTWK1C(1),15(R7) GET CURRENT TRK FROM IXLT 13060000 MVC TSTWK1C+2(1),23(R6) GET HI TRACK FROM IXLT 13080000 NC TSTWK1C(1),ISLAREAZ+87 REDUCE CURRENT TO TRACK 13100000 NC TSTWK1C+2(1),ISLAREAZ+87 REDUCE HIGH TO TRACK 13120000 CLC TSTWK1C(1),TSTWK1C+2 CURRENT TRACK VS HI TRACK 13140000 BNE ISLF450 B IF NOT END OF CYLINDER - EXIT 13160000 * 13180000 * LAST TRACK ON CYLINDER 13200000 * 13220000 * TEST R OF STEPPING COUNT FOR NEXT-TO-LAST R ON LAST TRACK 13240000 * 13260000 SR R3,R3 13280000 IC R3,DCBHIRCM C(R3)=HI R 13300000 S R3,ISL1 C(R3)=HI R -1 13320000 SR R4,R4 13340000 IC R4,16(R7) C(R4)=R OF SX 13360000 CR R3,R4 TEST HI R -1 VS R OF SX 13380000 BNE ISLF450 B IF NOT NEXT-TO-LAST R - EXIT 13400000 * 13420000 * NEXT TO LAST R ON LAST TRACK OF A CYLINDER HAS BEEN WRITTEN FOR THIS 13440000 * LEVEL INDEX. THE LAST SLOT IN A HI-LEVEL INDEX ON A GIVEN CYLINDER 13460000 * MUST CONTAIN A DUMMY ENTRY. SET DUMMY SW ON FOR THIS LEVEL INDEX SO 13480000 * NEXT WRITE WILL PRODUCE DUMMY ENTRY. 13500000 * 13520000 OI 0(R7),X'40' SET LEVEL IND BIT-1 ON 13540000 B ISLF420 13560000 * 13580000 * 13600000 * LAST R WRITTEN WAS END OF TRACK- STEP STEPPING COUNT TO NEXT TRACK 13620000 * 13640000 ISLF415 MVI 16(R7),X'00' R OF SX = 0 13660000 LH R3,14(R7) C(R3)=HH OF SX 13680000 A R3,ISL1 C(R3)=HH+1 13700000 STH R3,14(R7) C(SX)=MBBCCHHR, HH=HH+1, R=0 13720000 * 13740000 * TEST FOR ANY HIGHER LEVEL INDEXES 13760000 * 13780000 ISLF420 TM 0(R7),X'80' TEST LEVEL IND BIT-0 13800000 BC 1,ISLF450 13820000 * 13840000 * HIGHER LEVEL INDEX PRESENT, STEP TO NEXT LEVEL IN IXLT 13860000 * 13880000 NI 0(R7),X'DF' TURN BIT-2 IN CURR LEV IND OFF 13900000 A R7,ISL26 STEP R7 TO REF NEXT LEVEL 13920000 A R5,ISL1 C(R5)=CURRENT LEVEL 13940000 OI 0(R7),X'20' TURN BIT-2 IN CURR LEV IND ON 13960000 * 13980000 * CONSTRUCT COUNT FOR MASTER INDEX ENTRY IN AREA Y, Y+0 14000000 * 14020000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT SX 14040000 SR R3,R3 14060000 IC R3,16(R7) C(R3)=R FROM IXLT SX, 00NN 14080000 A R3,ISL1 C(R3)=R+1 14100000 STC R3,4(R9) COUNT = CCHHR WITH R=R+1 14120000 * 14140000 * CONSTRUCT DATA FOR MASTER INDEX ENTRY IN AREA Y, Y+8 14160000 * 14180000 STC R5,16(R9) STORE LEVEL IN F-BYTE 00000III 14200000 * 14220000 TM 0(R7),X'40' TEST IXLTIND BIT 1 (DUMMY SW) 14240000 BC 1,ISLF430 B IF ON 14260000 * 14280000 * DUMMY SW OFF 14300000 * A. NORMAL DATA 14320000 * 14340000 MVC 8(7,R9),IOBDADAD DATA=MBBCCHH FROM IOBB+32 14360000 MVI 15(R9),X'00' DATA=MBBCCHHR WITH R=0 14380000 * DATA=MBBCCHHRF, F=00000III 14400000 MVC TSTWK1C(4),IOBDADAD+3 MOVE CCH FROM IOBB+32 14420000 MVC TSTWK2C(4),12(R7) MOVE CCH FROM IXLT SX 14440000 CLI ISLAREAZ+86,X'02' IS IT 2301 14460000 BE ISLF421A 14480000 MVI TSTWK1C+3,X'00' ZERO TRACK NO. 14500000 MVI TSTWK2C+3,X'00' ZERO TRACK NO. 14520000 B ISLF421 14540000 * 2301 14560000 ISLF421A NI TSTWK1C+3,X'F8' ZERO TRACK NO -CURRENT 14580000 NI TSTWK2C+3,X'F8' ZERO TRACK NO -HI 14600000 * 14620000 ISLF421 CLC TSTWK1C(4),TSTWK2C CC IN IOBB+32 VS CC IN SX 14640000 BNE ISLF4215 BR IF NOT EQ 14660000 * 14680000 * CCS EQUAL 14700000 MVI 17(R9),X'1B' DATA=MBBCCHHRFP WITH P=1B 14720000 B ISLF424 14740000 * 14760000 * UNEQUAL 14780000 ISLF4215 CLI ISLAREAZ+86,X'05' IS IT 2321 14800000 BNE ISLF422 NOT 2321, BR TO SET P=0B 14820000 CLC TSTWK1C(2),TSTWK2C 2321-TEST FOR SAME STRP & SBCL 14840000 BE ISLF422 BR EQ TO SET P=0B 14860000 MVI 17(R9),X'07' SET P=07 14880000 B ISLF424 14900000 * 14920000 ISLF422 MVI 17(R9),X'0B' DATA=MBBCCHHRFP WITH P=0B 14940000 * 14960000 * SET CQ43 (CP21) TO ADDRESS KEY 14980000 * OF LAST RECORD IN LAST BUFFER 15000000 * 15020000 ISLF424 L R10,24(R10) C(R10)=A(CP21-CQ40) 15040000 L R4,ISLKEYAD C(R4)=A(KEY OF LAST WR CKD) 15060000 IC R5,24(R10) SAVE OP 15080000 ST R4,24(R10) STORE ADDR OF KEY 15100000 STC R5,24(R10) RESTORE OP 15120000 * 15140000 B ISLF440 15160000 * 15180000 * 15200000 * DUMMY SW ON 15220000 * B. DUMMY DATA 15240000 * 15260000 * TEST CC+1 VS DEBENDCC FOR 15280000 * POSSIBLE END OF INDEX EXTENT 15300000 * 15320000 ISLF430 EQU * 15340000 SR R6,R6 15360000 IC R6,9(R7) C(R6) = M FROM IXLT SX, 000M 15380000 S R6,ISL1 C(R6) = M-1 (M=1 FOR EXTENT 0) 15400000 SLL R6,4 C(R6) = M-1 X 16 (USE AS INDX) 15420000 * 15440000 LR R9,R0 RESTORE DEB POINTER 15490000 USING IHADEB,R9 * 15492000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 15500000 DROP R9 15510000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTENT ENTRY) 15520000 * 15540000 MVC TSTWK1C(4),10(R4) CCHH - END OF CURRENT EXTENT 15560000 NI TSTWK1C+3,X'F8' ZERO TRACK BITS 15580000 L R4,TSTWK1C C(R4)=CCHH TRK=0 FOR 2301 15600000 MVC TSTWK1C(4),12(R7) CCHH FROM IXLT 15620000 NI TSTWK1C+3,X'F8' ZERO TRACK BITS 15640000 L R3,TSTWK1C C(R3)=CCHH TRK=0 FOR 2301 15660000 CLI ISLAREAZ+86,X'02' IS IT 2301 15680000 BNE ISLF4202 BR IF NOT 2301 15700000 * 2301 15720000 LA R3,8(R3) 15740000 B ISLF4305 BR TO COMPARE 15760000 * 15780000 ISLF4202 IC R4,ISL0 NOT 2301 - SET TRACK=0 15800000 SRL R3,8 C(R3)=0CCH 15820000 CLI ISLAREAZ+86,X'05' IS IT 2321 15840000 BNE ISLF4204 BR TO ADD 1 TO CYL AND COMPARE 15860000 * 2321 15880000 CLI TSTWK1C+2,X'04' LAST CYL OF STRIP 15900000 BE ISLF4203 BR IF LAST CYL 15920000 LA R3,1(R3) C(R3)=0CCH+1 CYL+1 15940000 SLL R3,8 C(R3)=CC(H+1)0 15960000 B ISLF4305 BR TO COMPARE 15980000 * 16000000 ISLF4203 CLI TSTWK1C+1,X'09' IS IT END OF A SUBCELL 16020000 BNE ISLF4204 BR IF NOT LAST STRIP IN SUBCELL 16040000 SRL R3,16 C(R3)=000C 16060000 LA R3,1(R3) C(R3)=C+1 NEXT SUBCELL 16080000 SLL R3,24 C(R3)=(C+1)000 16100000 B ISLF4305 BR TO COMPARE 16120000 * 16140000 ISLF4204 SRL R3,8 C(R3)=00CC 16160000 LA R3,1(R3) CYL+1, ALSO NEXT STRIP 16180000 SLL R3,16 C(R3)=CC00 16200000 * 16220000 ISLF4305 EQU * 16240000 CR R3,R4 COMP NEXT CC VS END CC IN DEB 16260000 BH ISLF431 B IF NEXT CC HIGH 16280000 * 16300000 * NEXT CC IS IN CURRENT EXTENT 16320000 L R9,0(R10) C(R9)=A(AREA Y) 16340000 MVC 8(3,R9),9(R7) DATA = MBB FROM IXLT SX 16360000 ST R3,TSTWK1C 16380000 MVC 11(4,R9),TSTWK1C DATA=MBBCCHH CYL+1, TRACK=0 16400000 B ISLF432 16420000 * 16440000 * NEXT CC IS IN NEW EXTENT 16460000 ISLF431 SRL R6,4 C(R6) = M-1 16480000 A R6,ISL1 C(R6) = M FOR NEXT EXTENT 16500000 SLL R6,4 C(R6) = M X 16 (USE AS INDX) 16520000 LR R9,R0 RESTORE DEB POINTER 16530000 USING IHADEB,R9 * 16532000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 16540000 DROP R9 16550000 LA R4,0(R6,R4) C(R4)=A(NEXT INDX EXTENT ENTRY) 16560000 * 16580000 L R9,0(R10) C(R9)=A(AREA Y) 16600000 MVC 9(6,R9),4(R4) DATA = BBCCHH FROM NEW EXTENT 16620000 SRL R6,4 C(R6) = M FOR NEXT EXTENT 16640000 A R6,ISL1 C(R6) = M+1 (M=1 FOR EXTENT 0) 16660000 STC R6,8(R9) DATA = MBBCCHH OF NEW EXTENT 16680000 * 16700000 ISLF432 MVI 15(R9),X'00' DATA=MBBCCHHR, R=0 16720000 OI 16(R9),X'28' DATA=MBBCCHHRF, F=00101III 16740000 MVI 17(R9),X'07' DATA=MBBCCHHRFP WITH P=07 16760000 * 16780000 * SET CQ43 (CP21) TO ADDRESS KEY 16800000 * OF ALL ONES AT Y+62 16820000 * 16840000 L R10,24(R10) C(R10)=A(CP21-CQ40) 16860000 LA R4,62(R9) C(R4)=A(AREA Y +62) 16880000 IC R5,24(R10) SAVE OP 16900000 ST R4,24(R10) STORE ADDR OF KEY OF ONES 16920000 STC R5,24(R10) RESTORE OP 16940000 * 16960000 * 16980000 * PLACE IXLT SX IN IOBB+32 17000000 * 17020000 ISLF440 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT SX), MBBCCHHR 17040000 ISLF441 EQU * 17042013 SR R13,R13 17048000 IC R13,IOBDADAD 17050000 SLL R13,4 17052000 LR R9,R0 DEB POINTER 17052400 LA R13,32(R9,R13) POINT TO BB 17054000 MVC IOBDADAD+2(1),5(R13) 17056000 * 17060000 * 17080000 * EXCP RETURN TO IOS - EXECUTE CP21 TO WRITE MASTER INDEX 17100000 * 17120000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 17140016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 17160016 * 17180000 * 17200000 * NORMAL RETURN TO IOS - SET C-BIT OFF AND EXIT 17220000 * * ADDR OF STATUS BYTE WITH CURRENT 17240000 * C-BIT IS IN CP21 AT CQ41 * 17260000 * 17280000 ISLF450 L R10,24(R10) C(R10)=A(CP21-CQ41) 17300000 L R7,12(R10) C(R7)=A(LAST SLOT SCHED) 17320000 NI 0(R7),X'FB' TURN S BIT 5 OFF (C-BIT) 17340000 B ISLF115 *NORMAL EXIT 17360000 * 17380000 EJECT 17400000 *********************************************************************** 17420000 * CHART F5 - APPENDAGE CYL DUMMY, CP21 CHANNEL END - ENTERED FROM F4 * 17440000 *********************************************************************** 17460000 * 17480000 * A DUMMY-CYLINDER INDEX ENTRY HAS JUST BEEN WRITTEN AS THE LAST ENTRY 17500000 * ON THE PREVIOUS TRACK. THE DATA PORTION OF THAT ENTRY CONTAINS THE 17520000 * CYLINDER AND TRACK ADDRESS OF THE REAL CYLINDER INDEX ENTRY. THE REAL 17540000 * CYLINDER INDEX ENTRY MUST NOW BE WRITTEN ON THE NEW TRACK. 17560000 * * R7 POINTS TO CYLINDER IXLT LEVEL * 17580000 * 17600000 * TURN DUMMY SW OFF 17620000 * 17640000 ISLF501 NI 0(R7),X'BF' SET LEVEL IND BIT-1 OFF 17660000 * 17680000 * 17700000 * UPDATE STEPPING COUNT USING DUMMY DATA CONTENTS, PLACE IN IOBB+32 17720000 * 17740000 MVC 9(8,R7),8(R9) C(S0)=MBBCCHHR FROM AREA Y +8 17760000 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT S0), MBBCCHHR 17780000 * 17800000 * CONSTRUCT COUNT FOR CYLINDER INDEX ENTRY IN AREA Y, Y+0 17820000 * 17840000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT SX 17860000 MVI 4(R9),X'01' COUNT = CCHHR WITH R=1 17880000 * 17900000 * CONSTRUCT DATA FOR CYLINDER INDEX ENTRY IN AREA Y, Y+8 17920000 * 17940000 LA R2,ISLIOBA C(R2)=A(IOBA) 17960000 MVC 8(7,R9),IOBDADAD DATA=MBBCCHH FROM IOBA+32 17980000 NI 14(R9),X'F8' SET TO TRACK 0 FOR 2301 18000000 CLI DCBDEVT,X'02' IS IT 2301 18020000 BE ISLF5017 BR IF 2301 18040000 MVI 14(R9),X'00' NOT 2301, SET TO TRACK 0 18060000 * 18080000 ISLF5017 EQU * 18100000 CLC DCBFIRSH(2),ISL0 TEST HH OF FIRSH VS 00 18120000 BNE ISLF502 B IF HH NOT 00 18140000 * HH OF FIRSH = 00 18160000 MVC 15(1,R9),DCBFIRSH+2 DATA = MBBCCHHR WITH R OF FIRSH 18180000 B ISLF503 18200000 * HH OF FIRSH NOT 00 18220000 ISLF502 MVI 15(R9),X'00' DATA = MBBCCHHR WITH R=00 18240000 ISLF503 MVI 16(R9),X'01' DATA = MBBCCHHRF WITH F = 01 18260000 * 18280000 SR R6,R6 18300000 IC R6,9(R7) C(R6) = M FROM IXLT S0 18320000 S R6,ISL1 C(R6) = M-1 (M=1 FOR EXTENT 0) 18340000 SLL R6,4 C(R6) = M-1 X 16 (USE AS INDX) 18360000 * 18380000 SR R5,R5 18400000 IC R5,IOBDADAD C(R5) = M FROM IOBA+32 18420000 S R5,ISL1 C(R5) = M-1 (M=1 FOR EXTENT 0) 18440000 SLL R5,4 C(R5) = M-1 X 16 (USE AS INDX) 18460000 LR R9,R0 RESTORE DEB POINTER 18470000 USING IHADEB,R9 * 18472000 * 18480000 L R4,DEBFPEAD C(R4)=A(1ST PRIM EXTENT ENTRY) 18540000 LA R4,0(R6,R4) C(R4)=A(CURR INDX EXTENT ENTRY) 18560000 L R3,DEBFPEAD C(R3)=A(1ST PRIM EXTENT ENTRY) 18580000 DROP R9 18590000 LA R3,0(R5,R3) C(R3)=A(CURR PRIM EXTENT ENTRY) 18600000 L R9,0(R10) C(R9)=A(AREA Y) 18620000 * 18640000 LA R2,ISLIOBB 18645013 MVC IOBDADAD+1(2),4(R4) MOVE DEB BB TO IOB 18650013 * 18655013 CLC 1(3,R3),1(R4) COMP UCB ADDRS, PRIM VS INDX 18660000 BNE ISLF504 B IF NOT EQUAL 18680000 * 18700000 * UCBS EQUAL 18720000 CLI DCBDEVT,X'05' IS IT 2321 18740000 BC 7,ISLF5039 BR IF NOT 18760000 CLC 0(2,R9),11(R9) COMP COUNT CC VS DATA CC 18780000 BNE ISLF504 BR IF NOT EQUAL, SET P=07 18800000 * 18820000 ISLF5039 EQU * 18840000 MVI 17(R9),X'0B' DATA = MBBCCHHRFP WITH P=0B 18860000 B ISLF505 18880000 * 18900000 * UCBS UNEQUAL 18920000 ISLF504 MVI 17(R9),X'07' DATA = MBBCCHHRFP WITH P=07 18940000 * 18960000 * SET CQ43 (CP21) TO ADDRESS KEY 18980000 * OF LAST RECORD IN LAST BUFFER 19000000 * 19020000 ISLF505 L R10,24(R10) C(R10)=A(CP21-CQ40) 19040000 L R4,ISLKEYAD C(R4)=A(KEY OF LAST WR CKD) 19060000 IC R5,24(R10) SAVE OP 19080000 ST R4,24(R10) STORE ADR OF KEY 19100000 STC R5,24(R10) RESTORE OP 19120000 * 19140000 * 19160000 * EXCP RETURN TO IOS - EXECUTE CP21 TO WRITE CYLINDER INDEX 19180000 * 19200000 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 19220016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 19240016 * 19260000 EJECT 19280000 *********************************************************************** 19300000 * CHART F6 - APPENDAGE MST DUMMY, CP21 CHANNEL END - ENTERED FROM F4 * 19320000 *********************************************************************** 19340000 * 19360000 * A DUMMY MASTER INDEX ENTRY HAS JUST BEEN WRITTEN AS THE LAST ENTRY 19380000 * ON THE PREVIOUS TRACK. THE DATA PORTION OF THAT ENTRY CONTAINS THE 19400000 * CYLINDER AND TRACK ADDRESS OF THE REAL MASTER INDEX ENTRY. THE REAL 19420000 * MASTER INDEX ENTRY MUST NOW BE WRITTEN ON THE NEW TRACK. 19440000 * * R7 POINTS TO CURRENT IXLT LEVEL * 19460000 * 19480000 * TURN DUMMY SW OFF 19500000 * 19520000 ISLF601 NI 0(R7),X'BF' SET LEVEL IND BIT-1 OFF 19540000 * 19560000 * 19580000 * UPDATE STEPPING COUNT USING DUMMY DATA CONTENTS, PLACE IN IOBB+32 19600000 * 19620000 MVC 9(8,R7),8(R9) C(SX)=MBBCCHHR FROM AREA Y +8 19640000 MVC IOBDADAD(8),9(R7) C(IOBB+32)=C(IXLT SX), MBBCCHHR 19660000 * 19680000 * CONSTRUCT COUNT FOR MASTER INDEX ENTRY IN AREA Y, Y+0 19700000 * 19720000 MVC 0(4,R9),12(R7) COUNT = CCHH FROM IXLT SX 19740000 MVI 4(R9),X'01' COUNT = CCHHR WITH R=1 19760000 * 19780000 * CONSTRUCT DATA FOR MASTER INDEX ENTRY IN AREA Y, Y+8 19800000 * 19820000 STC R5,16(R9) STORE LEVEL IN F-BYTE 00000III 19840000 * 19860000 MVI 15(R9),X'00' DATA WITH R=0 19880000 * 19900000 LR R5,R7 C(R5)=A(CURRENT LEVEL IXLT) 19920000 S R5,ISL26 C(R5)=A(NEXT LOWER LEVEL IXLT) 19940000 MVC 8(6,R9),9(R5) DATA=MBBCCH OF LOWER LEVEL SX 19960000 IC R4,15(R5) C5R4)=H OF LOWER LEVEL SX 19980000 TM 0(R5),X'40' IS DUMMY BIT ON NEXT A30945 19985020 * * LOWER LEVEL 19990020 BO ISLF6011 YES - INDEX ENTRY OK A30945 19995020 BCTR R4,0 C(R4)=H-1 20000000 ISLF6011 EQU * * A30945 20010020 STC R4,14(R9) DATA=MBBCCHH-1 OF LOWER SX 20020000 NI 14(R9),X'F8' ZERO TRACK FOR 2301 20040000 MVC TSTWK1C(4),12(R7) MOVE CCHH FROM IXLT SX 20060000 NI TSTWK1C+3,X'F8' ZERO TRACK FOR 2301 20080000 CLI ISLAREAZ+86,X'02' IS IT 2301 20100000 BE ISLF6015 BR IF 2301 TO COMPARE 20120000 * 20140000 MVI 14(R9),X'00' NOT 2301, SET TRACK=0 20160000 MVI TSTWK1C+3,X'00' SET TRACK=0 20180000 * 20200000 ISLF6015 CLC 11(4,R9),TSTWK1C CCH0 IN IOBB+32 VS CCH0 IN SX 20220000 STC R4,14(R9) SET H BACK TO TRACK ADDRESS 20240000 BNE ISLF6017 20260000 * 20280000 * CCS EQUAL 20300000 MVI 17(R9),X'1B' DATA=MBBCCHHRFP WITH P=1B 20320000 B ISLF604 20340000 * 20360000 * UNEQUAL 20380000 ISLF6017 EQU * 20400000 CLI ISLAREAZ+86,X'05' IS IT 2321 20420000 BNE ISLF602 NOT 2321, B TO SET P=0B 20440000 * 2321 20460000 CLC 11(2,R9),TSTWK1C TEST FOR SAME STRIP & SUBCELL 20480000 BE ISLF602 BR IF SAME, SET P=0B 20500000 MVI 17(R9),X'07' SET P=07 20520000 B ISLF604 20540000 * CCS UNEQUAL 20560000 ISLF602 MVI 17(R9),X'0B' DATA=MBBCCHHRFP WITH P=0B 20580000 * 20600000 * SET CQ43 (CP21) TO ADDRESS KEY 20620000 * OF LAST RECORD IN LAST BUFFER 20640000 * 20660000 ISLF604 L R10,24(R10) C(R10)=A(CP21-CQ40) 20680000 L R4,ISLKEYAD C(R4)=A(KEY OF LAST WR CKD) 20700000 IC R5,24(R10) SAVE OP 20720000 ST R4,24(R10) STORE ADDR OF KEY 20740000 STC R5,24(R10) RESTORE OP 20760000 * 20780000 * 20800000 * EXCP RETURN TO IOS - EXECUTE CP21 TO WRITE MASTER INDEX 20820000 * 20840000 B ISLF441 GO GET DEB BB 20860013 * AND EXCP RETURN 20880013 * 20900000 EJECT 20920000 *********************************************************************** 20940000 * CHART F7 - APPENDAGE, ABNORMAL END * 20960000 *********************************************************************** 20980000 * 21000000 * TEST IF CP18 HUNG ON A WR CKD 21140000 * 21160000 ISLF702 L R3,IOBCSW C(R3)=COMMAND ADDR+8 21180000 LA R3,0(R3) 21200000 S R3,ISL8 C(R3)=COMMAND ADDR OF LAST CCW 21220000 L R4,12(R10) C(R4)=A(CP18) 21240000 LA R4,24(R4) C(R4)=A(CP18, 1ST WR CKD) 21260000 L R5,16(R10) C(R5)=A(CP19) 21280000 S R5,ISL16 C(R5)=RA(CP18, LAST WR S20201 21290020 * CKD) S20201 21300020 CR R3,R4 LAST CCW VS CP18 CCW 1 21320000 BL ISLF710 B IF NOT IN CP18 21340000 CR R3,R5 LAST CCW VS CP18 CCW N 21360000 BH ISLF710 B IF NOT IN CP18 21380000 * 21400000 * CP18 HUNG ON A WR CKD - GET ADDR OF LAST BUFFER WRITTEN 21420000 * 21440000 TM 0(R3),X'1E' *LAST CCW IS READ CKD 13334 21450016 BC 1,ISLF703 * YES,BRANCH 13334 21460016 LA R6,R3 *C(R6)=3 13334 21470016 ISLF704 TM 0(R3),X'1D' *LAST CCW IS WRT. CKD 13334 21480016 BC 1,ISLF703 *YES, BRANCH 13334 21490016 S R3,ISL8 *NO, BACK UP 1 CCW 13334 21500016 BCT R6,ISLF704 *LOOP THREE TIMES ONLY 13334 21510016 B ISLF710 *NEITHER READ NOR WRITE 13334 21520016 * 21580000 ISLF703 L R6,0(R3) C(R6)=DATA ADDR OF LAST WR CKD 21600000 LA R6,0(R6) 21620000 B ISLF711 21640000 * 21660000 ISLF710 SR R6,R6 ERROR NOT IN CP18, C(R6)=0 21680000 * 21700000 ISLF711 NI IOBFLAG1,X'FB' TURN OFF EXCEPTION FLAG 15924 21720016 SR R3,R3 21740000 STC R3,IOBFLAG2 FLAG2=0 15924 21760016 STC R3,IOBCSW CSW BYTE 1 = 0 21780000 ST R3,IOBBCTI BLK CT INCR & ERROR CTR = 0 21800000 OI DCBEXCD1,X'04' SET EXCD1 BIT 5 ON = WR ERROR 21820000 STH R6,ISLVPTRA+TWO (SHIFT SO FTIW FLAGES XA04602 21830000 SRL R6,16 WON'T BE DESTROYED) XA04602 21840000 STC R6,ISLVPTRA+ONE SAVE A(BAD BUFFER) XA04602 21842000 LA R3,IOBS C(R3)=A(BUF 1 STATUS) 21880000 * 21900000 ISLF712 NI 0(R3),X'B0' TURN BIT 1 OFF 21920000 OI 0(R3),X'20' TURN BIT 2 ON 21940000 A R3,ISL4 BUMP R3 TO NEXT SLOT 21960000 C R3,ISLBUFN TEST FOR NTH SLOT 21980000 BNH ISLF712 LOOP UNTIL ALL STATUS = 01 22000000 * 22020000 B ISLF125 22040000 EJECT 22060000 * 22080000 * CHART F7 - EXTENTION FOR WR CHK 22100000 * 22120000 ISLF731 LA R3,0(R2) C(R3)=A(IOBX) 22140000 LA R4,ISLIOBB C(R4)=A(IOBB) 22160000 * 22220000 * TEST IOB FOR PERMENANT ERROR 22240000 * 22260000 TM IOBECBAD,X'20' TEST BYTE 4, BIT 2 22280000 BO ISLF115 NON PERM ERR--NORMAL A42170 22300021 * EXIT A42170 22330021 * 22360000 * PERMANENT ERROR, SET UP TO RETRY TEN TIMES 22380000 * 22400000 ISLF7312 NI IOBFLAG1,X'FB' TURN OFF EXCEPTION FLAG 15924 22420016 SR R6,R6 22440000 STC R6,IOBFLAG2 FLAG2=0 MC0V 22460000 STC R6,IOBCSW CSW BYTE 1 = 0 22480000 ST R6,IOBBCTI BLK CT INCR # ERROR CTR=0 MC0V 22500000 LA R13,2 INDICATE IOBC RETRY A42170 22510021 CR R3,R4 COMP IOBX VS IOBB 22520000 BH ISLF741 B IF IOBX = IOBC (CP19) 22540000 LA R13,1 INDICATE IOBB RETRY A42170 22560021 BE ISLF732 BR--IOBX = IOBB A42170 22570021 SR R13,R13 INDICATE IOBA RETRY A42170 22580021 ISLF732 EQU * IOBX = IOBA OR IOBB A42170 22590021 * SEE IF CP18 OR CP21 FAILED ON READ BACK 22600021 * 22650021 L R3,IOBCSW C(R3) = COMMAND ADDR + 8 A42170 22700021 S R3,ISL8 C(R3) = ADDR LAST CCW A42170 22750021 TM 0(R3),RKD IS LAST CCW A READ CKD A42170 22800021 BNO ISLF754 NO, BRANCH TO ERROR EXIT A42170 22850021 SR R3,R3 CLEAR REGISTER A42170 22900021 B ISLF753 B TO AE PROCESSING 23000000 * 23020000 * 23040000 * RESET CP19 FOR WRITING (IF IT IS READING) 23060000 * 23080000 ISLF741 L R10,16(R10) C(R10)=A(CP19) 23100000 SR R3,R3 23120000 USING CM1,R10 ADDRESSABILITY ON CP19 S20201 23130020 IC R3,ISL10+3 C(R3)=NO OF WR CKD CCWS 23140013 CLI CM3,X'05' TEST CM3 OP CODE FOR WR S20201 23150020 * D S20201 23160020 BE ISLF754 B IF WR TO AE PROCESSING 23180000 * 23200000 MVI CM3,WD SET CM3 OP CODE TO WRITE S20201 23210020 * D S20201 23220020 NI CM34,ALL-SKIP SET CM3 FLAGS TO SKIP S20201 23240020 CLI CM7,X'0E' TEST CM7 FOR RD KD S20201 23250020 * (CLOSE) S20201 23260020 BNE ISLF742 B IF NOT RD KD 23280000 MVI CM7,WKD SET CM7 TO WR KD S20201 23300020 B ISLF743 23320000 * 23340000 ISLF742 MVI CM7,WCKD SET CCW OP CODE TO WRITE S20201 23350020 * CKD S20201 23360020 ISLF743 NI CM74,ALL-SKIP SET CCW FLAGSNOT TO SKIP S20201 23380020 NI CM84,ALL-SKIP SET CCW FLAGS NOT TO S20201 23390020 * SKIP S20201 23400020 A R10,ISL16 STEP R10 TO NEXT CCW 23420000 BCT R3,ISLF742 LOOP 23440000 * 23460000 ISLF753 EQU * O19110 23470019 IC R3,DCBWKPT2(R13) GET APPROP RETRY COUNT A42170 23480021 BCT R3,ISLF761 B TO EXCP AGAIN 23520000 * 23540000 ISLF754 L R10,DCBWKPT6 RESET R10, C(R10)=A(VPTRS) 23560000 B ISLF702 BRANCH TO ABNORMAL END A42170 23580021 * 23600000 * 23620000 * EXCP RETURN TO IOS IN ORDER TO RETRY WRITE AND READ 23640000 * 23660000 ISLF761 EQU * O19110 23670019 STC R3,DCBWKPT2(R13) STORE NEW VALUE A42170 23680021 BAL R13,EXCPRTRN EXCP HOUSEKEEP 15924 23700016 B EXCP(R14) TAKE EXCP IOS RETURN 15924 23720016 * 23740000 EJECT 23760000 * 23780000 * CONSTANTS 23800000 * 23820000 ISL0 DC F'0000' 23840000 ISL1 DC F'0001' 23860000 ISL4 DC F'0004' 23880000 ISL8 DC F'0008' 23900000 ISL10 DC F'0010' 23920000 ISL16 DC F'0016' 23940000 ISL26 DC F'0026' 23960000 ISLFF DC F'8888' 23980000 * 24000000 END 24040000 ./ ADD SSI=01013523,NAME=IGG019GE,SOURCE=0 TITLE 'IGG019GE - CHANNEL PROGRAMS, W/O WR CHK' 00020000 * * 00040000 *1042009000,009200-029200 S20201 00050020 *STATUS CHANGE LEVEL 001 00060020 * * 00080000 *FUNCTION/OPERATION- THIS MODULE CONTAINS THE CHANNEL PROGRAM * 00100000 * SKELETON CODE WHICH IS USED BY OPEN TO CREATE CP18, CP19, CP20, * 00120000 * AND CP21. * 00140000 * * 00160000 *ENTRY POINTS- THIS MODULE IS USED TO CREATE CHANNEL PROGRAMS. IT * 00180000 * IS NEVER ENTERED. THIS MODULE IS LOADED AND DELETED DURING OPEN. * 00200000 * * 00220000 *INPUT-N/A * 00240000 * * 00260000 *OUTPUT- N/A * 00280000 * * 00300000 *EXTERNAL ROUTINES- THIS MODULE IS REFERENCED BY OPEN LOADS - * 00320000 * IGG0192R, 2S, AND 2T. * 00340000 * * 00360000 *EXITS-NORMAL- N/A * 00380000 * -ERROR- N/A * 00400000 * * 00420000 *TABLES/WORK AREAS- N/A * 00440000 * * 00460000 *ATTRIBUTES- REUSABLE * 00480000 * * 00500000 *NOTES- THE SKELETON CODE FOR CP91 (INDEX PADDING) IS CONTAINED IN * 00520000 * CLOSE MODULE- 'IGG0202K'. * 00540000 * * 00560000 EJECT 00580000 IGG019GE CSECT 00600000 ******************** 00620000 * * 00640000 ******************** 00660000 * 00680000 * 00700000 IGG019GE CSECT 00720000 * 00740000 * 00760000 *********************************************************************** 00780000 * CHANNEL PROGRAMS W/O WRCK * 00800000 *********************************************************************** 00820000 * 00840000 * THE FOLLOWING SKELETON CODE IS INITIALIZED IN OPEN EXECUTORS 00860000 * 00880000 IGGLDCP 00900020 EJECT 02940000 END 02960000 ./ ADD SSI=03010983,NAME=IGG019GF,SOURCE=0 TITLE 'IGG019GF - CHANNEL PROGRAMS, WR CHK' 00020000 IGG019GF CSECT 00026000 * RELEASE 16 DELETIONS * 00032000 *1042 13334 00035016 * RELEASE 17 DELETIONS * 00038000 * RELEASE 18 DELETIONS * 00044000 *1171028600-029000 21826 00047018 * RELEASE 19 DELETIONS * 00050000 * RELEASE 20 DELETIONS * 00056000 * A37537 00057020 *0858009000,009200-032800 S20201 00059020 * RELEASE 21 DELETIONS * 00062000 * RELEASE 22 DELETIONS * 00068000 * RELEASE 23 DELETIONS * 00074000 * RELEASE 24 DELETIONS * 00080000 *STATUS CHANGE LEVEL 003 00090020 *FUNCTION/OPERATION- THIS MODULE CONTAINS THE CHANNEL PROGRAM * 00100000 * SKELETON CODE WHICH IS USED BY OPEN TO CREATE CP18, CP19, CP20, * 00120000 * AND CP21. * 00140000 * * 00160000 *ENTRY POINTS- THIS MODULE IS USED TO CREATE CHANNEL PROGRAMS. IT * 00180000 * IS NEVER ENTERED. THIS MODULE IS LOADED AND DELETED DURING OPEN. * 00200000 * * 00220000 *INPUT- N/A * 00240000 * * 00260000 *OUTPUT- N/A * 00280000 * * 00300000 *EXTERNAL ROUTINES- THIS MODULE IS REFERENCED BY OPEN LOADS - * 00320000 * IGG0192U, 2S, AND 2V. * 00340000 * * 00360000 *EXITS-NORMAL- N/A * 00380000 * -ERROR- N/A * 00400000 * * 00420000 *TABLES/WORK AREAS- N/A * 00440000 * * 00460000 *ATTRIBUTES- REUSABLE * 00480000 * * 00500000 *NOTES- THE SKELETON CODE FOR CP91 (INDEX PADDING) IS CONTAINED IN * 00520000 * CLOSE MODULE- 'IGG0202K'. * 00540000 * * 00560000 EJECT 00580000 * 00740000 * 00760000 *********************************************************************** 00780000 * CHANNEL PROGRAMS W/O WRCK * 00800000 *********************************************************************** 00820000 * 00840000 * THE FOLLOWING SKELETON CODE IS INITIALIZED IN OPEN EXECUTORS 00860000 * 00880000 IGGLDCP OPTCD=W S20201 00900020 EJECT 03300000 END 03320000 ./ ADD SSI=02012872,NAME=IGG019GG,SOURCE=0 TITLE 'IGG019GG - SIO APPENDAGE FOR RPS CHAN PGM INIT' 00100020 IGG019GG CSECT 00200020 *0194 A44446 00250021 * 00300020 * FUNCTION/ OPERATION- THIS MODULE IS THE APPENDAGE ROUTINE THAT 00400020 * INITIALIZES THE LOAD MODE CHANNEL PROGRAMS TO UTILIZE THE ROTATIONAL 00500020 * POSITION SENSING (RPS) FEATURE OR NOT. THE PRESENCE OF THE FEATURE 00600020 * IS DETERMINED BY THE UCB. THE RPS FEATURE IS EXPLOITED BY 00700020 * CHANGING CERTAIN CCW'S IN THE LOAD MODE CHANNEL PROGRAMS FROM 00800020 * NOP TO SET SECTOR, WITH ATTENDANT CALCULATION OF THE PROPER 00900020 * SECTOR VALUE. ADDITIONALLY SOME TIC ADDRESSES MUST BE CHANGED 01000020 * TO BRING THE SET SECTOR CCW'S INTO USE. 01100020 * ENTRY POINT- IGG019GG IS THE ONLY ENTRY POINT. THE MODULE IS 01200020 * ENTERED AT SIO TIME BY IOS VIA THE DEB APPENDAGE 01300020 * VECTOR TABLE. 01400020 * INPUT- THE IOS REGISTER INTERFACE IS THE PRINCIPAL INPUT 01500020 * TO THE MODULE. THEY PROVIDE ADDRESSABILITY FOR THE DCB. 01600020 * WORK AREA, IOB, DEB, CHANNEL PROGRAMS , ETC. 01700020 * OUTPUT- THE CHANNEL PROGRAM TO BE EXECUTED ON THIS SIO WILL BE 01800020 * INITIALIZED ACCORDING TO THE DEVICE FEATURE (RPS OR 01900020 * NON RPS) IN THE UCB. 02000020 * EXTERNAL ROUTINES- IEA0SCRL VIA CVT0SCRL. THE ROUTINE 02100020 * DOES CONVERSION OF THE INPUT PARAMETERS TO A SECTOR 02200020 * VALUE 02300020 * EXITS- NORMAL RETURN TO IOS, TO PROCEED WITH SIO. 02400020 * TABLES/WORK AREAS - DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB, 02500020 * CVT, PART 2 VECTOR TABLE. 02600020 * SEE DSECTS AT FRONT OF MODULE FOR FORMAT AND DESCRIPTIONS. 02700020 * 02800020 EJECT 02900020 DCBD DSORG=(IS) 03000020 EJECT 03100020 IHADEB IGGDEBD 03200020 EJECT 03300020 ISLCOMON IGGLOAD 03400020 EJECT 03500020 IHAIOB IGGIOBD 03600020 EJECT 03700020 LOADCPS DSECT 03800020 IGGLDCP OPTCD=W 03900020 EJECT 04000020 CVTAREA DSECT 04100020 CVT 04200020 EJECT 04300020 * MISCELLANEOUS EQUATES 04400020 WRTCHK EQU X'80' 04500020 VLR EQU X'40' 04600020 FTIW EQU X'C0' FTIW OPTION + SUCCESSFUL GETMAIN 04700020 ISL8 EQU 8 04800020 FIRSTIME EQU X'80' FIRST TIME SWITCH FOR CP18V 04900020 ZERO EQU 0 05000020 ONE EQU 1 05100020 TWO EQU 2 05200020 THREE EQU 3 05300020 FOUR EQU 4 05400020 TEN EQU 10 05500020 TWOBYTES EQU 16 05600020 RESET EQU 255 05700020 ADDR EQU 1 05800020 AL3 EQU 3 05900020 CPSTART EQU IOBSTART-ONE 06000020 CAW EQU X'48' POINTER TO CP START A44446 06050021 * 06100020 IHARQE DSECT 06200020 DS 0F 06300020 RQELINK DS H A(NEXT RQE) 06400020 RQEUCB DS H A(UCB) 06500020 RQEIOB DS F A(IOB) 06600020 RQEDEB DS F A(DEB) 06700020 TISA DSECT 06800020 ORG TISA+10 DEFINE THE FLAG 06900020 TISAFLAG DS C B0=RESUME LOAD 07000020 * B1=CLOSE USES 07100020 * B2=END OF T.I. TRK 07200020 * B3=END OF CYL 07300020 * B4=EXCP CP20 ALONE 07400020 CP20ONLY EQU X'08' TEST B4 OF TISAFLAG 07500020 CCW DSECT 07600020 OPCODE DS 1C COMMAND CODE 07700020 DS AL3 DATA ADDRESS 07800020 ADDRESS EQU OPCODE 07900020 FLAGS DS BL1 CCW FLAGS 08000020 NULL DS 1C UNUSED 08100020 COUNT DS H BYTE COUNT 08200020 COUNTFLD DSECT 08300020 CYL DS CL2 CC 08400020 HEAD DS CL2 HH 08500020 RECORD DS C R 08600020 IHAUCB DSECT 08700020 ORG IHAUCB+16 DEFINE THE TYPE FLD 08800020 UCBTYP DS F UCB TYPE FIELD 08900020 TYPOPTN EQU UCBTYP+ONE OPTIONAL FEATURES 09000020 TYPDEV EQU UCBTYP+TWO DEVICE CLASS 09100020 TYPUNIT EQU UCBTYP+THREE UNIT TYPE 09200020 * 09300020 RPSFEAT EQU X'10' 09400020 * 09500020 * DEVICE TABLE ENTRY FORMAT 09600020 DEVENTRY DSECT 09700020 DS 0H MERLIN IS TYPICAL 09800020 CCMAX DC H'411' MAX CYL 09900020 HHMAX DC H'19' MAX HEAD 10000020 TRKCAP DC H'13060' TRACK CAPACITY 10100020 OVHDI DC AL1(179) NOT LAST RCD OVHD 10200020 OVHDL DC AL1(179) LAST RCD OVHD 10300020 OVHDK DC AL1(54) KEY OVHD 10400020 FLAG DC X'00' FLAGS 10500020 TOLRNCE DC H'512' TOLERANCE FACTOR 10600020 ALTTRK DC H'152' OCIP 58 10700020 OVHDR0 DC H'221' ZEUS 10800020 NOSECT DC AL1(128) ZEUS 10900020 DS C ZEUS (RESERVED) 11000020 * 11100020 IOSCP DSECT 11110021 * IOS CHANNEL PROGRAM PREFIX. 11120021 IOSSEEK CCW 0,0,0,0 SEEK A44446 11130021 IOSSFM CCW 0,0,0,0 SET FILE MASK A44446 11140021 IOSTIC CCW 0,0,0,0 TIC TO CP A44446 11150021 EJECT 11200020 * GENERAL REGISTERS ARE USED AS FOLLOWS 11300020 * 11400020 R0 EQU 0 * ----- 11500020 R1 EQU 1 * 12* ADDRESS 11600020 R2 EQU 2 * IOB 11700020 R3 EQU 3 * DEB 11800020 R4 EQU 4 * DCB 11900020 R5 EQU 5 * ----- 12000020 R6 EQU 6 * ----- 12100020 R7 EQU 7 * UCB 12200020 R8 EQU 8 * ----- 12300020 R9 EQU 9 ** WORK REGISTER 12400020 R10 EQU 10 CHANNEL PROGRAM POINTER 12500020 R11 EQU 11 DECB 12600020 R12 EQU 12 WORK REGISTER 12700020 R13 EQU 13 BASE REGISTER 12800020 R14 EQU 14 IOS RETURN VECTOR TABLE 12900020 R15 EQU 15 WORK REGISTER 13000020 * 13100020 * * MEANS THIS REGISTER IS SET UP UPON ENTRY FROM IOS, 13200020 * AND ITS CONTENTS MUST BE RESTORED UPON RETURN TO IOS 13300020 * ** MEANS THIS REGISTER MAY BE CHANGED, BUT UPON RETURN TO IOS 13400020 * MUST CONTAIN ZEROES IN THE THREE HIGH ORDER BYTES 13500020 * 13600020 IGG019GG CSECT 13700020 USING IGG019GG,R15 13800020 USING IHAIOB,R2 13900020 USING IHADEB,R3 14000020 USING IHADCB,R4 14100020 USING IHARQE,R1 14200020 USING IHAUCB,R7 14300020 * 14400020 L R10,DCBWKPT1 A(COMON) 14500020 USING ISLCOMON,R10 14600020 ST R2,ISLAPSAV SAVE R2 (IOB) 14700020 STM R8,R0,ISLAPSAV+FOUR 1 AND 3-7 NOT SAVED 14800020 LR R12,R10 ADDRESSABILITY ON WORKAREA 14900020 DROP R10 15000020 USING ISLCOMON,R12 * 15100020 LR R13,R15 CLEAN UP THE EXT. RTN INTERFACE 15200020 USING IGG019GG,R13 15300020 DROP R15 15400020 LA R2,0(R2) C(R2)=A(IOBX) 15500020 LA R8,ISLIOBB C(R8)=A(IOBB) 15600020 CR R2,R8 IOBX VS IOBB 15700020 BH ISLFIOBC CP 19 15800020 BE ISLFIOBB CP 21 15900020 B ISLFIOBA CP 18-20 16000020 * 16100020 ISLFRETN L R2,ISLAPSAV RESTORE IOB REG 16200020 * REPOINT IOS PREFIX TO CORRECT CP START ADDRESS. 16205021 L R9,CAW ADDRESSABILITY IOS A44446 16210021 * PREFIX A44446 16215021 USING IOSCP,R9 * A44446 16220021 TESTCCW EQU * * A44446 16225021 CLI IOSSEEK,SEEK START OF IOS PREFIX A44446 16230021 BE PREFIX YES - CHECK PREFIX A44446 16235021 LA R9,CCWLEN(R9) POINT TO NEXT CCW A44446 16240021 B TESTCCW CHECK NEXT CCW A44446 16245021 PREFIX EQU * * A44446 16250021 TM IOSSEEK+4,CC IS IT A STAND ALONE SEEK A44446 16255021 BZ SASEEK YES FINISHED A44446 16260021 MVC IOSTIC+1(L'IOBSTART),IOBSTART NEW STARTING ADDRESS. 16265021 DROP R9 A44446 16270021 SASEEK EQU * * A44446 16275021 * 16280021 LM R8,R0,ISLAPSAV+FOUR RESTORE 8-15 AND 0 16300020 SR R9,R9 RESTORE R9 16400020 BR R14 NORMAL RETURN TO IOS 16500020 EJECT 16600020 * 16700020 ISLTHETA EQU * INTERFACE WITH THE RESIDENT 16800020 * SECTOR CONVERT ROUTINE. 16900020 * THE FOLLOWING FORMULAE ARE USED TO CALCULATE THE SECTOR VALUE FOR 17000020 * MERLIN, ZEUS-ATHENS, AND ZEUS-CORINTH- 17100020 * 17200020 * FIXED RECORD LENGTHS=== 17300020 * SECTOR = (N/T)(RO + (R-1)(Y-K) + (R-1)(KL+DL)) 17400020 * 17500020 * VARIABLE LENGTH RECORDS=== 17600020 * SECTOR = (N/T)(RO + (R-1)(Y-K) + BB) 17700020 * 17800020 * WHERE N= NUMBER OF SECTORS PER DEVICE 17900020 * T= TRACK CAPACITY 18000020 * RO= OVERHEAD FOR R0(RECORD 0) 18100020 * R= TARGET RECORD NUMBER 18200020 * Y= OVERHEAD FOR KEYED RECORDS (EITHER I OR L FROM DEV TAB) 18300020 * K= OVERHEAD TO SUBTRACT FOR NON-KEYED RECORDS 18400020 * (K=0 FOR ISAM) 18500020 * KL= KEY LENGTH 18600020 * DL= DATA LENGTH 18700020 * BB= TOTAL NUMBER OF KEY AND DATA BYTES UP TO BUT NOT 18800020 * INCLUDING THE TARGET RECORD. 18900020 * ISLTHETA CALLING SEQUENCE 19000020 * 19100020 * REGISTERS ARE LOADED AS FOLLOWS- 19200020 * FIXED VARIABLE 19300020 * C(R0) +DD -BB (2 BYTES, RIGHT JUSTIFIED) 19400020 * C(R10) 000K 000I 19500020 * C(R11) 000R 000R 19600020 * C(R2) 0AAA 0AAA 19700020 * BAL R14,ISLTHETA 19800020 * 19900020 SLL R0,TWOBYTES C(R0)= +DD00 OR -BB00 20000020 OR R0,R11 C(R0)= +DD0R OR -BB0R 20100020 SLL R10,8 C(R10)= 00K0 OR 00I0 20200020 OR R0,R10 C(R0)= +DDKR OR -BBIR 20300020 IC R9,TYPUNIT C(R9)= 000T 20400020 SLL R9,24 C(R9)= T000 20500020 OR R2,R9 C(R2)= TAAA OR TAAA 20600020 * 20700020 L R9,CVTPTR C(R9)=A(CVT) 20800020 USING CVTAREA,R9 20900020 L R15,CVT0SCR1 C(R15)=A(IEA0SCR1) 21000020 LR R12,R14 SAVE CALLER 21100020 BALR R14,R15 TO SECTOR CONVERT RTN 21200020 LR R14,R12 RECOVER RETURN ADDR 21300020 L R12,DCBWKPT1 RECOVER WK AREA ADDR 21400020 L R2,ISLAPSAV RECOVER IOB ADDR 21500020 LA R2,0(R2) 21600020 BR R14 RETURN TO CALLER 21700020 * 21800020 ISLSUB8 EQU * ADJUST IOBSTART BY -8 21900020 * ADJUSTMENT BY -8 IS USED TO POINT THE IOBSTART ADDR AT THE SET 22000020 * SECTOR CCW AS PART OF INITIALIZATION FOR AN RPS DEVICE. 22100020 L R9,CPSTART PICK UP ADDR 22200020 LA R9,0(R9) CLEAR HI BYTE 22300020 S R9,ISLEIGHT SUBTRACT 8 22400020 IC R10,IOBSIOCC SAVE SIO CODE 22500020 ST R9,CPSTART PUT ADDR BACK 22600020 STC R10,IOBSIOCC PUT CODE BACK 22700020 BR R14 RETURN TO CALLER 22800020 ISLEIGHT DC F'8' CONSTANT 22900020 VARIND DC H'0',X'8000' MAKES BB INTO -BB 23000020 * 23100020 EJECT 23200020 ISLFIOBA EQU * CP 18-20 INITIALIZATION 23300020 TM TYPOPTN,RPSFEAT IS DEV=RPS 23400020 BO ISL20RPS BIF YES 23500020 * 23600020 * NON-RPS INITIALIZATION. 23700020 * IN ESSENCE, IT REQUIRES THE TIC ADDRESSES THAT WERE BACKED UP 23800020 * (FROM SCH ID CCW'S TO SET SECTORS) FOR RPS TO BE RESET (BUMPED +8), 23900020 * AND OP CODES CHANGED FROM SETSECT TO NOP. SEE THE RPS INITIALIZATION 24000020 * CODE FOR A DESCRIPTION OF THE CHANNEL PGM SETUPS EXPECTED BY THIS MOD 24100020 * 24200020 CLC IOBSTART,ISLVPTR4+ONE IS IT EXCP FOR CP18 ALONE 24300020 BE ISL18NON BIF YES 24400020 * 24500020 TM ISLVPTRA,FTIW IS IT FTIW 24600020 BNO ISL20FVN BIF NOT. GO INIT CP20(F AND V) 24700020 * NON-RPS INITIALIZATION OF FTIW CP'S 24800020 TM DCBOPTCD,WRTCHK IS CP20C REQ'D 24900020 BO ISL20CNO BIF YES 25000020 * NON-RPS INITIALIZATION OF CP20A/B 25100020 L R8,CPSTART R8=A(CP20A OR CP20B) 25200020 USING CQ1,R8 25300020 L R9,CQ2+FOUR R9=A(TIC CP18) 25400020 USING CCW,R9 25500020 L R10,ADDRESS R10=TIC CP18 25600020 USING CL0,R10 25700020 CLI CL0,SETSECT DOES TIC GO TO A SETSECT 25800020 BNE ISL20TST BIF NOT 25900020 LA R10,CCWLEN(R10) BUMP TIC ADDR +8 26000020 ST R10,ADDRESS TIC NOW POINTS TO CQ1(CP18) 26100020 B ISL20TST TEST FOR CP20 ALONE 26200020 DROP R9,R10 26300020 ISL20CNO EQU * NON-RPS INITIALIZATION OF CP20C 26400020 L R8,ISLVPTRC C(R8)=A(CP20C(CQ1)) 26500020 S R8,ISLEIGHT BACK UP TO CQ0. 26600020 USING CQ0,R8 26700020 CLI CQ0,SETSECT IS CP20C SET FOR RPS 26800020 BNE ISL20TST BIF NOT 26900020 * INITIALIZE CP20C FOR NON- RPS 27000020 MVI CQ0,NOP SET FOR NON-RPS 27100020 L R9,CQ2+FOUR C(R9)=A(TIC CP18) 27200020 USING CCW,R9 27300020 L R10,ADDRESS C(R10)=TIC CL0 (CP18) 27400020 A R10,ISLEIGHT C(R10)=TIC CL1 (CP18) 27500020 ST R10,ADDRESS TIC NOW GOES TO CL1(CP18) 27600020 ISL20TST EQU * TEST EXCP FOR CP20 ALONE 27700020 L R9,ISLVPTRA C(R9)=A(TISA) 27800020 USING TISA,R9 27900020 TM TISAFLAG,CP20ONLY CP20 ALONE 28000020 BO ISLFRETN BIF YES 28100020 EJECT 28200020 ISL18NON EQU * CP18 NON RPS INIT 28300020 L R8,ISLVPTR4 A(CP18) 28400020 USING CL1,R8 28500020 L R9,CL2+FOUR GET PTR TO WRT CHK SEG(CL0*) 28600020 DROP R8 28700020 USING CL0,R9 28800020 TM DCBOPTCD,WRTCHK IS CL0* THERE 28900020 BNO ISLFRETN BIF NOT 29000020 MVI CL0,NOP NON-RPS INIT 29100020 B ISLFRETN EXIT 29200020 DROP R9 29300020 ISL20FVN EQU * CP20 NON-RPS INITIALIZATION 29400020 L R8,ISLVPTR6 C(R8)=A(CP20) 29500020 USING CQ1,R8 29600020 TM DCBOPTCD,WRTCHK ARE CQ24,26, AND CQ9(F) THERE 29700020 BNO ISLCQ14N BIF NOT 29800020 ISLCQ24N L R9,CQ24 C(R9)=CQ24(L.H.) 29900020 USING CCW,R9 30000020 CLI OPCODE,SETSECT DOES CQ24 TIC TO CQT0 30100020 BNE ISLCQ26N BIF NO 30200020 A R9,ISLEIGHT BUMP TIC ADDR +8 30300020 ST R9,CQ24 CQ24=TIC CQT1 30400020 ISLCQ26N L R9,CQ26 C(R9)=CQ26(L.H.) 30500020 CLI OPCODE,SETSECT DOES CQ26 TIC TO CQT0 30600020 BNE ISLCQ9 BIF NOT 30700020 A R9,ISLEIGHT BUMP TIC ADDR +8 30800020 ST R9,CQ26 CQ26=TIC CQT1 30900020 ISLCQ9 TM DCBRECFM,VLR IS CQ9 THERE 31000020 BO ISLCQ14N BIF NOT 31100020 ISLCQ9N L R9,CQ9 C(R9)=CQ9(L.H.) 31200020 CLI OPCODE,SETSECT DOES CQ9 TIC TO CQT0 31300020 BNE ISLCQ14N BIF NOT 31400020 A R9,ISLEIGHT BUMP TIC ADDR +8 31500020 ST R9,CQ9 CQ9=TIC CQT1 31600020 ISLCQ14N L R9,CQ14 C(R9)=CQ14(L.H.) 31700020 CLI OPCODE,SETSECT DOES CQ14 TIC TO A SETSECT 31800020 BNE ISL18NON BIF NOT. CP 20 OK FOR RPS 31900020 A R9,ISLEIGHT BUMP TIC ADDR +8 32000020 ST R9,CQ14 CQ14=TIC CQT1 OR CL1 32100020 ISLCQ4N TM DCBRECFM,VLR DOES CQ4 NEED WORK 32200020 BNO ISL18NON BIF NOT 32300020 L R9,CQ4 PICK UP CQ4(L.H.) 32400020 A R9,ISLEIGHT BUMP TIC ADDR +8 32500020 ST R9,CQ4 CQ4 TIC'S TO CL1 32600020 TM DCBOPTCD,WRTCHK IS CQT8* THERE 32700020 BNO ISL18NON BIF NOT 32800020 L R9,CQT8 PICK UP TIC ADDR. 32900020 CLI OPCODE,SETSECT DOES IT TIC TO SET SECTOR 33000020 BNE ISL18NON BIF NO. LEAVE AS IS. 33100020 A R9,ISLEIGHT BUMP ADDR +8 33200020 ST R9,CQT8 CQT8 TIC'S TO CQ1. 33300020 B ISL18NON DO CP18 NON-RPS 33400020 DROP R9 33500020 EJECT 33600020 ISL20RPS EQU * INITIALIZE CP 20 FOR RPS 33700020 L R8,CPSTART C(R8)=A(CP18 OR CP20) 33800020 LA R8,0(R8) CLEAR HIGH ORDER BYTE 33900020 USING CCW,R8 34000020 CLI OPCODE,SETSECT IS FIRST CCW A SET SECTOR 34100020 BE ISL18PRC YES. IOBSTART IS OK. 34200020 BAL R14,ISLSUB8 BACK UP TO THE SET SECT CCW. 34300020 B ISL18PRO R8 POINTS TO CL1 (OR CQ1) 34400020 ISL18PRC LA R8,CCWLEN(R8) BUMP R8 FROM CL0 (OR CQ0) TO 34500020 * CL1 (OR CQ1) 34600020 ISL18PRO EQU * 34700020 C R8,ISLVPTR4 IS IT EXCP FOR CP18 ALONE 34800020 BE ISL18RPS BIF YES 34900020 DROP R8 35000020 * 35100020 TM ISLVPTRA,FTIW IS IT FTIW 35200020 BNO ISL20FVR BIF NOT. GO DO CP20 (F + V) 35300020 * 35400020 * RPS INITIALIZATION FOR FTIW CP'S. CP 18 AND/OR 20 MAY BE EXCP'D 35500020 * SEPARATELY OR TOGETHER. IN ADDITION, CP20 IS DIVIDED INTO A,B, AND C, 35600020 * AS BELOW- 35700020 * 35800020 * 35900020 * INITIALIZE CP20(FTIW) FOR RPS 36000020 * POSSIBLE SETUPS OF CP20A,B, AND C ARE- 36100020 * SETUP 1 SETUP 2 SETUP 3 SETUP 4 36200020 * ------------------------------------------ 36300020 * 20A* 20B* 20A 20B 36400020 * 20C* 20C* 36500020 * *= INITIALIZATION REQUIRED 36600020 * RPS INITIALIZATION OF 20A AND 20B ARE IDENTICAL. IF CP20C IS USED 36700020 * NO INITIALIZATION OF CP20A/B IS REQUIRED. 36800020 * 36900020 TM DCBOPTCD,WRTCHK IS CP20C REQ'D 37000020 BO ISLCP20C BIF YES 37100020 L R8,CPSTART C(R8)=A(CP20A OR CP20B) 37200020 USING CQ0,R8 37300020 L R9,CQ2+FOUR C(R9)=A(TIC CP18) 37400020 USING CCW,R9 37500020 L R10,ADDRESS C(R10)=TIC CP18 37600020 USING CL0,R10 37700020 CLI CL0,SETSECT DOES IT TIC CL0 37800020 BE ISL20UPD BIF YES. GO UPDATE THETA. 37900020 S R10,ISLEIGHT C(R10)=TIC CL0 38000020 ST R10,ADDRESS TIC NOW GOES TO CL0(CP18) 38100020 B ISL20UPD UPDATE THETA 38200020 DROP R9,R10 38300020 * 38400020 ISLCP20C EQU * RPS INITIALIZATION OF CP20C 38500020 L R8,ISLVPTRC C(R8)=A(CP20C(CQ1)) 38600020 S R8,ISLEIGHT BACK UP TO CQ0. 38700020 USING CQ0,R8 38800020 CLI CQ0,SETSECT IS CP20C SET FOR RPS 38900020 BE ISL20UPD BIF YES. GO UPDATE THETA. 39000020 MVI CQ0,SETSECT RPS INIT 39100020 L R9,CQ2+FOUR C(R9)=A(TIC CL1) 39200020 USING CCW,R9 39300020 L R10,ADDRESS C(R10)=TIC CL1 (CP18) 39400020 S R10,ISLEIGHT C(R10)=TIC CL0 (CP18) 39500020 ST R10,ADDRESS TIC NOW GOES TO CL0(CP18) 39600020 DROP R9 39700020 * CALL ISLTHETA(FIXED) 39800020 ISL20UPD EQU * UPDATE THETA FOR CP20(ALL) 39900020 L R8,CPSTART C(R8)=A(CP20) 40000020 USING CQ0,R8 40100020 SR R11,R11 40200020 L R10,CQ1 C(R10)=A(CCHHR) 40300020 USING COUNTFLD,R10 40400020 IC R11,RECORD C(R11)=000R 40500020 LA R0,TEN C(R0)=+DD 40600020 SR R10,R10 40700020 DROP R10 40800020 IC R10,DCBKEYLE C(R10)=000K 40900020 LA R2,ISLRPSSS+TWO C(R2)=0AAA 41000020 BAL R14,ISLTHETA CALL SECTOR CONVERT RTN 41100020 * TEST EXCP FOR CP20 ALONE. 41200020 L R9,ISLVPTRA C(R9)=A(TISA) 41300020 USING TISA,R9 41400020 TM TISAFLAG,CP20ONLY ONLY CP20 41500020 BO ISLFRETN BIF YES 41600020 DROP R9 41700020 EJECT 41800020 ISL18RPS EQU * CP 18 RPS INIT RTN 41900020 L R8,ISLVPTR4 A(CP18) 42000020 USING CL1,R8 42100020 L R9,CL2+FOUR GET PTR TO WRT CHK SEG(CL0*) 42200020 DROP R8 42300020 USING CL0,R9 42400020 TM DCBOPTCD,WRTCHK IS CL0* THERE 42500020 BNO ISL18UPD BIF NOT 42600020 MVI CL0,SETSECT RPS INIT 42700020 DROP R9 42800020 USING CL1,R8 42900020 ISL18UPD EQU * UPDATE SECTOR VALUE 43000020 TM DCBRECFM,VLR DIFFERENT SECTOR CONVERT 43100020 * PARM FOR VLR. 43200020 BO ISLCP18V BIF YES 43300020 * TEST FOR SHARED TRACK 43400020 * SHARED TRACK SECTOR CALCULATIONS WILL USE THE VARIABLE FORM. 43500020 L R9,CL1 PICK UP SEARCH ARG ADDR 43600020 USING COUNTFLD,R9 43700020 CLC HEAD,DCBFIRSH TEST FOR SHARED TRK CANDIDATE 43800020 BNE ISL18FXD BIF NOT ON SHARED TRK 43900020 CLI DCBFIRSH+TWO,ONE R=1 ONLY IF NOT SHARED TRK. 44000020 BE ISL18FXD BIF NOT SHARED TRK. 44100020 * 44200020 * CALCULATE BB- SHARED TRACK 44300020 * PARAMETERS F=RECORD NUMBER FROM DCBFIRSH 44400020 * R=TARGET RECORD NUMBER FROM THE SEARCH ARGUMENT 44500020 * 44600020 * BB=(F-2)(KL+10) WHEN R=F-1 44700020 * BB=(F-1)(KL+10) WHEN R=F 44800020 * BB=(F-1)(KL+10)+(R-F-1)(KL+BS) WHEN R GT F 44900020 SR R10,R10 45000020 SR R11,R11 45100020 IC R11,DCBFIRSH+TWO C(R11)=F 45200020 LA R0,ONE 45300020 SR R11,R0 C(R11)=F-1 45400020 IC R10,RECORD C(R10)=R 45500020 CR R10,R11 IS R=F-1 45600020 BNE ISL18BB2 BIF NOT 45700020 SR R11,R0 C(R11)=F-2 45800020 ISL18BB2 EQU * C(R11)=Z, (F-1) OR (F-2) 45900020 IC R10,DCBKEYLE C(R10)=KL 46000020 LA R10,TEN(R10) C(R10)=KL+10 46100020 MR R10,R10 C(R11)=Z(KL+10) 46200020 LR R0,R11 C(R0)=Z(KL+10) 46300020 SR R10,R10 46400020 SR R11,R11 46500020 IC R11,DCBFIRSH+TWO C(R11)=F 46600020 IC R10,RECORD C(R10)=R 46700020 CR R10,R11 IS R GT F 46800020 BNH ISLBBOK BIF NOT. BB IS OK. 46900020 SR R10,R11 C(R10)=R-F 47000020 LA R11,ONE 47100020 SR R10,R11 C(R10)=R-F-1 47200020 IC R11,DCBKEYLE C(R11)=KL 47300020 AH R11,DCBBLKSI C(R11)=KL+BS 47400020 MR R10,R10 C(R11)= (R-F-1)(KL+BS) 47500020 AR R0,R11 C(R0)=(F-1)(KL+10)+(R-F-1)(KL+BS) 47600020 ISLBBOK EQU * C(R0)=BB AS PER 1 OF THE 3 47700020 * ALGORITHMS. 47800020 SR R11,R11 47900020 IC R11,RECORD C(R11)=R (TARGET RCD) 48000020 LA R10,ONE C(R10)=000I 48100020 LA R2,ISLRPSSS C(R2)=0AAA 48200020 O R0,VARIND C(R0)=-BB 48300020 BAL R14,ISLTHETA GO TO CONVERT 48400020 B ISLFRETN EXIT 48500020 DROP R9 48600020 * CALL ISLTHETA (FIXED) 48700020 ISL18FXD SR R11,R11 C(R11)=0000 48800020 L R10,CL1 C(R10)=A(CCHHR) 48900020 USING COUNTFLD,R10 49000020 IC R11,RECORD C(R11)=000R 49100020 LH R0,DCBBLKSI C(R0)=+DD 49200020 SR R10,R10 49300020 DROP R10 49400020 IC R10,DCBKEYLE C(R10)=000K 49500020 LA R2,ISLRPSSS C(R2)=0AAA 49600020 BAL R14,ISLTHETA UPDATE SECTOR VALUE 49700020 B ISLFRETN EXIT 49800020 EJECT 49900020 ISLCP18V EQU * 50000020 * CALL ISLTHETA (VARIABLE) 50100020 * BB (PARAMETER FOR SECTOR CONVERT RTN) IS FOUND BY THE FOLLOWING 50200020 * ALGORITHM- ALL THE WRITE CCW LENGTHS IN CP 18 ARE TOTALED, AND 50300020 * ADDED TO THE RUNNING TOTAL HELD IN CQ10 (2 BYTES) 50400020 * 50500020 * CQ10 (CP20V) HOLDS THE CURRENT BB TOTAL. IT IS UPDATED BEFORE EXIT 50600020 * FROM THIS MODULE, AND RESET TO ZERO WHEN THE TARGET RECORD 50700020 * IS RECORD NUMBER ONE. 50800020 * CQ10+2 HOLDS THE BB TOTAL THAT IS ONE BLOCK BEHIND THE CURRENT TOTAL. 50900020 * 51000020 BBTOTAL EQU CQ10 HOLDS TOTAL NUMBER OF KEY AND 51100020 * DATA BYTES USED ON CURRENT TRK 51200020 BBTARGET EQU CQ10+2 SAME AS BBTOTAL, BUT ONE BLOCK 51300020 * BEHIND IT. NEEDED FOR SEARCH 51400020 * PREVIOUS CP LOGIC. 51500020 * TEST FOR FIRST ENTRY TO SIO APPENDAGE. FIRST TIME SWITCH IS SET BY 51600020 * VLR PUT MODULES. CL2 OP CODE IS USED FOR THE SWITCH. 51700020 TM CL2,FIRSTIME IS THIS FIRST ENTRY 51800020 BZ ISLFRETN BIF NOT. NO WORK TO DO. 51900020 NI CL2,RESET-FIRSTIME THIS IS FIRST ENTRY. RESET SW 52000020 L R2,CL1 C(R2)=A(CCHHR) 52100020 USING COUNTFLD,R2 52200020 SR R11,R11 52300020 IC R11,RECORD C(R11)=TARGET RECORD 52400020 DROP R2 52500020 L R9,ISLVPTR6 C(R9)=A(CP20V) 52600020 USING CQ1,R9 52700020 LTR R11,R11 IS TARGET RCD NUMBER=1 52800020 BNZ ISL18CAL BIF NOT. BB IS OK. 52900020 STH R11,BBTOTAL SET BBTOTAL=ZERO 53000020 STH R11,BBTARGET SET TARGET=ZERO 53100020 ISL18CAL EQU * 53200020 LH R0,BBTARGET C(R0)=00BB 53300020 * SET OTHER REGS 53400020 * C(R11)=000R (TARGET RECORD) 53500020 ISL18VAR LA R10,ONE C(R10)=000I 53600020 LA R2,ISLRPSSS C(R2)=0AAA 53700020 O R0,VARIND C(R0)=-BB 53800020 BAL R14,ISLTHETA GO TO CONVERT 53900020 DROP R9 DESTROYED BY CONVERT RTN 54000020 L R9,ISLVPTR6 C(R9)=A(CP20) 54100020 USING CQ1,R9 54200020 * BB TOTALLING ROUTINE 54300020 LA R2,CL3 INITIALIZE CCW LOCATOR 54400020 USING CCW,R2 54500020 ISL18VBB EQU * 54600020 CLI OPCODE,TIC DOES LOCATOR POINT TO A TIC 54700020 BNE ISL18WRT BIF NO. TEST THIS CCW 54800020 L R2,ADDRESS LOCATE NEXT CCW. 54900020 ISL18WRT EQU * 55000020 CLI OPCODE,WCKD IS THIS A WRITE CCW 55100020 BNE ISL18VEX BIF NOT. TOTAL ONLY WRT CCW'S. 55200020 MVC BBTARGET(TWO),BBTOTAL MAKES TARGET FOLLOW 1 BLOCK 55300020 * BEHIND TOTAL. 55400020 TM FLAGS,DC IF DATA CHAINED, THIS IS CL6. 55500020 BO ISL18CL6 BRANCH TO TOTAL CL7 AND 8 LENS 55600020 ISL18CL4 EQU * THIS CCW IS CL4. 55700020 LH R10,COUNT COUNT FROM CL4 55800020 S R10,ISLEIGHT SUBTRACT COUNT FLD LEN, 55900020 * LEAVES KL+DL 56000020 AH R10,BBTOTAL ADD LAST TOTAL 56100020 STH R10,BBTOTAL UPDATE RUNNING TOTAL OF BB 56200020 ISL18VCC EQU * 56300020 TM FLAGS,CC TEST FOR MORE CCW'S 56400020 BNO ISL18VEX EXIT. NO MORE TOTALLING 56500020 LA R2,CCWLEN(R2) BUMP LOCATOR TO NEXT CCW. 56600020 CCWLEN EQU 8 56700020 B ISL18VBB GO FOR NEXT WRT SEGMENT 56800020 ISL18CL6 EQU * TOTAL CL7 AND CL8 LENGTHS. 56900020 LA R2,CCWLEN(R2) BUMP LOCATOR 57000020 LH R10,COUNT PICK UP COUNT 57100020 AH R10,BBTOTAL ADD LAST TOTAL 57200020 STH R10,BBTOTAL UPDATE TOTAL 57300020 TM FLAGS,DC LOOP IF DATA CHAINED. 57400020 BO ISL18CL6 BACK FOR THE NEXT CCW 57500020 B ISL18VCC FINISHED WITH CL7 AND 8 57600020 DROP R2 57700020 ISL18VEX EQU * 57800020 B ISLFRETN EXIT 57900020 DROP R9 58000020 EJECT 58100020 * RPS INITIALIZATION FOR CP20(FIXED AND VLR) 58200020 ISL20FVR EQU * CP20(F+V) 58300020 * 58400020 L R8,ISLVPTR6 C(R8)=A(CP20) 58500020 USING CQ1,R8 58600020 * 58700020 * CQ24, 26, AND 9 ARE ALWAYS INITIALIZED BECAUSE THEY MAY TIC TO 58800020 *OTHER PLACES(THAN THE WRITE CHECK SEGMENT) WHILE ON AN RPS DEVICE. 58900020 * 59000020 TM DCBOPTCD,WRTCHK ARE CQ24,26, AND CQ9(F) THERE 59100020 BNO ISL20DET BIF NOT 59200020 * 59300020 ISLCQ24R CLC CQT2+ADDR(AL3),CQ24+ADDR DOES CQ24 TIC TO CQT1 59400020 BNE ISLCQ26R BIF NOT 59500020 L R9,CQ24 C(R9)=CQ24(L.H.) 59600020 S R9,ISLEIGHT C(R9)=C(R9)-8 59700020 ST R9,CQ24 CQ24 TIC'S TO CQT0 59800020 ISLCQ26R CLC CQT2+ADDR(AL3),CQ26+ADDR DOES CQ24 TIC CQT1 59900020 BNE ISLCQ9R BIF NOT 60000020 L R9,CQ26 C(R9)=CQ26(L.H.) 60100020 S R9,ISLEIGHT DECREMENT R9 60200020 ST R9,CQ26 CQ26 TIC'S TO CQT0 60300020 ISLCQ9R TM DCBRECFM,VLR IS CQ9 THERE 60400020 BO ISL20DET BIF NOT 60500020 CLC CQT2+ADDR(AL3),CQ9+ADDR DOES CQ9 TIC TO CQT1 60600020 BNE ISL20DET BIF NOT 60700020 L R9,CQ9 C(R9)=CQ9(L.H.) 60800020 S R9,ISLEIGHT DECREMENT R9 60900020 ST R9,CQ9 CQ9 TIC'S TO CQT0 61000020 * DETERMINE IF CP20 IS IN RPS OR NON-RPS STATE. 61100020 ISL20DET EQU * 61200020 L R9,CQ14 C(R9)=CQ14(L.H.) 61300020 USING CCW,R9 61400020 CLI OPCODE,SETSECT DOES CQ14 TIC TO A SET SECTOR 61500020 BE ISL20UPD BIF YES. CP20 IS SET FOR RPS. 61600020 * GO TO UPDATE THETA. 61700020 * CP20(F+V) RPS INITIALIZATION REQUIRED. 61800020 ISLCQ14R S R9,ISLEIGHT POINT CQ14 AT THE SETSECT 61900020 ST R9,CQ14 CQ14 TIC'S TO CQT0 OR CL0 62000020 ISLCQ4R TM DCBRECFM,VLR IS CQ4 THERE 62100020 BNO ISL20UPD BIF NOT. CP20 OK FOR RPS. 62200020 L R9,CQ4 C(R9)=CQ4(L.H.) 62300020 S R9,ISLEIGHT DECREMENT R9 62400020 ST R9,CQ4 CQ4 TICS TO CL0 62500020 TM DCBOPTCD,WRTCHK IS CQT8* THERE 62600020 BNO ISL20UPD BIF NOT. 62700020 L R9,CQT8 PICK UP TIC ADDR. 62800020 CLI OPCODE,SIDEQ DOES IT TIC TO SIDEQ 62900020 BNE ISL20UPD BIF NO. LEAVE AS IS. 63000020 S R9,ISLEIGHT TIC TO PREVIOUS CCW. 63100020 ST R9,CQT8 TIC'S TO CQ0. 63200020 B ISL20UPD UPDATE SECTOR VALUE 63300020 DROP R9 63400020 EJECT 63500020 ISLFIOBC EQU * CP 19 INITIALIZATION 63600020 USING IHAIOB,R2 63700020 L R8,ISLVPTR5 A(CP19) 63800020 USING CM1,R8 63900020 TM TYPOPTN,RPSFEAT IS DEV=RPS 64000020 BO ISL19RPS BIF YES 64100020 * 64200020 MVI CM40,NOP SET FOR NON-RPS 64300020 B ISLFRETN EXIT 64400020 * 64500020 ISL19RPS EQU * RPS INIT 64600020 MVI CM40,SETSECT RPS INIT 64700020 L R11,CPSTART PICK UP IOBSTART ADDR 64800020 USING CCW,R11 64900020 CLI OPCODE,SIDEQ DOES IOB POINT TO SIDEQ 65000020 BNE ISL19UPD BIF NOT. DON'T ADJUST IOBSTART. 65100020 DROP R11 65200020 BAL R14,ISLSUB8 IOBSTART POINTS TO A SIDEQ. 65300020 * PREVIOUS CCW SHOULD BE A SET 65400020 * SECTOR. BACK UP TO IT. 65500020 * 65600020 * CALL ISLTHETA (FIXED) 65700020 ISL19UPD EQU * 65800020 SR R11,R11 C(R11)=0000 65900020 L R10,CM5 C(R10)=A(CCHHR) 66000020 USING COUNTFLD,R10 66100020 IC R11,RECORD C(R11)=000R 66200020 LA R0,TEN C(R0)=+DD 66300020 SR R10,R10 66400020 DROP R10 66500020 IC R10,DCBKEYLE C(R10)=000K 66600020 DROP R2 66700020 LA R2,ISLRPSSS+ONE C(R2)=0AAA 66800020 BAL R14,ISLTHETA UPDATE SECTOR VALUE 66900020 B ISLFRETN EXIT 67000020 EJECT 67100020 ISLFIOBB EQU * CP21 67200020 USING IHAIOB,R2 67300020 L R8,ISLVPTR7 A(CP21) 67400020 USING CQ40,R8 67500020 * 67600020 TM TYPOPTN,RPSFEAT IS DEV=RPS 67700020 BO ISL21RPS BIF YES 67800020 * 67900020 DROP R8 68000020 L R11,CPSTART C(R11)=A(CHAN PGM) 68100020 USING CQ39A,R11 68200020 CLI CQ39A,SETSECT IS CP SET UP FOR NON-RPS 68300020 BNE ISLFRETN BIF YES. 68400020 DROP R11 68500020 USING CQ40,R8 68600020 * CHAN PGM IS SET UP FOR RPS. CHANGE IT TO NON-RPS. 68700020 ST R8,CPSTART START AT CQ40 68800020 TM DCBOPTCD,WRTCHK IS CQ44A THERE 68900020 BNO ISLFRETN BIF NOT 69000020 * 69100020 MVI CQ44A,NOP SET FOR NON-RPS 69200020 B ISLFRETN 69300020 * 69400020 ISL21RPS EQU * RPS INIT 69500020 DROP R8 69600020 L R11,CPSTART C(R11)=A(CHAN PGM) 69700020 USING CQ39A,R11 69800020 CLI CQ39A,SETSECT IS CP SET UP FOR RPS 69900020 BE ISL21UPD BIF YES. 70000020 DROP R11 70100020 USING CQ40,R8 70200020 BAL R14,ISLSUB8 SET C(IOBSTART)=A(CQ39A) 70300020 * 70400020 TM DCBOPTCD,WRTCHK IS CQ44A THERE 70500020 BNO ISL21UPD BIF NOT 70600020 * 70700020 MVI CQ44A,SETSECT RPS INIT 70800020 ISL21UPD EQU * UPDATE SECTOR VALUE 70900020 * CALL ISLTHETA (FIXED) 71000020 SR R11,R11 C(R11)=0000 71100020 L R10,CQ40 C(R10)=A(CCHHR) 71200020 USING COUNTFLD,R10 71300020 IC R11,RECORD C(R11)=000R 71400020 LA R0,TEN C(R0)=+DD 71500020 SR R10,R10 71600020 IC R10,DCBKEYLE C(R10)=000K 71700020 LA R2,ISLRPSSS+THREE C(R2)=0AAA 71800020 DROP R2 71900020 BAL R14,ISLTHETA UPDATE SECTOR VALUE 72000020 B ISLFRETN 72100020 END 72200020 72300020 IEF314I SYSIO 72400020 ./ ADD SSI=06010981,NAME=IGG019GL,SOURCE=0 * 00003020 GBLC &LIB DEFINE GLOBAL CHARACTER 00006020 * * VARIABLE. 00009020 &LIB SETC 'LIB1' SET VALUE FOR &LIB 00012020 * 00015020 TITLE 'IGG019GL - APPENDAGES-PART 2,WRITE KN,NO WRT CHK' 00020000 IGG019GL CSECT 00040000 * RELEASE 14 DELETIONS * 00042000 * RELEASE 15 DELETIONS * 00044000 *2081 13270 00044515 *2081 11081 00045015 * RELEASE 16 DELETIONS * 00046000 *3485018200,115740,118400-119000,124400-125000,128800 15924 00046616 *3485102800 16384 00047216 * RELEASE 17 DELETIONS * 00048000 *1695000680 17516 00048600 *1695 P4700 00049200 *1695042800-043400,118300-118400,118700-118800,124300-124400 19374 00049400 * 124700,124800 19374 00049600 * RELEASE 18 DELETIONS * 00050000 *3123067600-069400 23596 00051018 *3123079920,115780,116000 17332 00051518 * RELEASE 19 DELETIONS * 00052000 * RELEASE 20 DELETIONS * 00054000 *2183086000,101400-101600 A34932 00055020 *2183017000,030800,031800,032000,032200,032400,037800,040800, S20201 00055120 *2183045600,049400,050600,051600,052000-052800,053000-054600, S20201 00055220 *2183067500,068100,073600,074000,075200,080600,081000,087800, S20201 00055320 *2183088200,099600,108200,109600,109800-110000,112800,113000- S20201 00055420 *2183113200,115000,115600,132000-139800,140000-147800,148000- S20201 00055520 *2183156000,162000-167800,168000-174800,175200-177000,177200- S20201 00055620 *2183180360,180600-183400,183600-188000 S20201 00055720 * RELEASE 21 DELETIONS * 00056000 * RELEASE 22 DELETIONS * 00058000 *STATUS CHANGE LEVEL 006 00068020 * 00080000 * FUNCTION/OPERATION- APPENDAGE ROUTINES FOR BISAM 00100000 * WHEN READ AND UPDATE IS NOT USED, 00120000 * WHEN WRITE KN IS USED, 00140000 * WHEN WRITE VALIDITY CHECKING IS NOT REQUESTED, 00160000 * (PART 2) 00180000 * 00200000 * 00220000 * CEND - IF CHANNEL PROGRAM ENDS 00240000 * **WITHOUT ERROR, EITHER 00260000 * PROCESSING COMPLETION WILL BE SCHEDULED, 00280000 * PROCESSING CONTINUATION WILL BE SCHEDULED, 00300000 * OR PROCESSING WILL CONTINUE. 00320000 * **WITH A LENGTH CHECK, TESTS DETERMINE WHETHER 00340000 * OR NOT TO TREAT THE SITUATION AS A REAL 00360000 * ERROR. 00380000 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 00400000 * BLOCK' IS INDICATED IN THE DECB, AND 00420000 * PROCESSING COMPLETION WILL BE SCHEDULED. 00440000 * 00460000 * ABEND - IF CHANNEL PROGRAM ENDS ABNORMALLY BECAUSE OF 00480000 * **PERMANENT ERROR, 'UNCORRECTABLE I/O ERROR' 00500000 * IS INDICATED IN THE DECB, AND PROCESSING 00520000 * COMPLETION WILL BE SCHEDULED. 00540000 * **NON-PERMANENT ERROR, ONE RE-TRY IS MADE 00560000 * BEFORE INDICATING A PERMANENT ERROR. 00580000 * **FILE PROTECTION, TESTS DETERMINE WHETHER 00600000 * OR NOT TO TREAT THE SITUATION AS A REAL 00620000 * ERROR. 00640000 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 00660000 * BLOCK' IS INDICATED IN THE DECB, AND 00680000 * PROCESSING COMPLETION WILL BE SCHEDULED. 00700000 EJECT 00720000 * ENTRY POINTS- 00740000 * ANY POINT IN THE VECTOR TABLE AT THE BEGINNING OF THE MODULE. 00760000 * 00780000 * INPUT - N/A 00800000 * OUTPUT - N/A 00820000 * EXTERNAL ROUTINES - N/A 00840000 * EXITS- 1. RETURN TO IOS VIA THE APPENDAGE RETURN VECTOR TABLE POINTED 00860000 * TO BY REGISTER 14. SEE THE DSECT LABELED APPRV FOR THE 00880000 * FORMAT OF THIS TABLE AND THE USE OF EACH EXIT. 00900000 * USED TO CONTINUE PROCESSING. 00920000 * 2. SCHEDULE AN ASYNCHRONOUS ROUTINE - BRANCH VIA THE EXIT 00940000 * EFFECTOR ADDRESS IN THE COMMUNICATION VECTOR TABLE. 00960000 * USED TO SCHEDULE PROCESSING COMPLETION OR CONTINUATION. 00980000 * 01000000 * TABLES/WORK AREAS - DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB, 01020000 * COMMUNICATION VECTOR TABLE. 01040000 * SEE DSECTS AT END OF MODULE FOR FORMAT AND DESCRIPTIONS. 01060000 * 01080000 * ATTRIBUTES- REENTRANT. DISABLED. 01100000 * NOTES - NONE 01120000 EJECT 01140000 * GENERAL REGISTERS ARE USED AS FOLLOWS 01160000 * 01180000 R0 EQU 0 * ----- 01200000 R1 EQU 1 * 12* ADDRESS 01220000 R2 EQU 2 * IOB 01240000 R3 EQU 3 * DEB 01260000 R4 EQU 4 * DCB 01280000 R5 EQU 5 * ----- 01300000 R6 EQU 6 * ----- 01320000 R7 EQU 7 * UCB 01340000 R8 EQU 8 * ----- 01360000 R9 EQU 9 # WORK REGISTER 01380000 R10 EQU 10 CHANNEL PROGRAM POINTER 01400000 R11 EQU 11 DECB 01420000 R12 EQU 12 WORK REGISTER 01440000 R13 EQU 13 WORK REGISTER 01460000 R14 EQU 14 IOS RETURN VECTOR TABLE 01480000 R15 EQU 15 BASE REGISTER 01500000 * 01520000 * * MEANS THIS REGISTER IS SET UP UPON ENTRY FROM IOS, 01540000 * AND ITS CONTENTS MUST BE RESTORED UPON RETURN TO IOS 01560000 * # MEANS THIS REGISTER MAY BE CHANGED, BUT UPON RETURN TO IOS 01580000 * MUST CONTAIN ZEROES IN THE THREE HIGH ORDER BYTES 01600000 * 01620000 PERRMASK EQU X'20' TO TEST FOR PERMANENT ERROR, TEST 01640000 PERRYES EQU 8 IOBECBAD, B2. IF OFF (CONDITION CODE 8) 01660000 PERRNO EQU 7 THERE IS A PERM ERR. ELSE B2 ON ( CD 7) 01680000 BYP EQU 12 RETURN TO IOS/BYPASS 15924 01685016 EXCP EQU 8 RETURN TO IOS/EXCP 15924 01690016 NORMAL EQU 0 RETURN TO IOS/NORMAL 15924 01695016 ZERO EQU 0 S20201 01695820 K1 EQU 1 S20201 01696620 K2 EQU 2 S20201 01697420 K3 EQU 3 S20201 01698220 K4 EQU 4 S20201 01699020 K5 EQU 5 S20201 01704020 K6 EQU 6 S20201 01709020 USING IHAIOB,R2 IOB POINTER S20201 01714020 USING IHADEB,R3 DEB POINTER 01720000 USING IHADCB,R4 DCB POINTER 01740000 USING IHAWKNCP,R10 CHANNEL PROGRAM POINTER 01760000 USING IHADECB,R11 DECB POINTER 01780000 USING IHADCW,R12 DCB WA POINTER ONLY AS WORK REG 01800000 USING IGG019GL,R15 BASE 01840000 USING CVT,R13 COMMUNICATION VECTOR TABLE 01860000 EJECT 01880000 * VECTOR TABLE. BRANCH TO THE ROUTINE SELECTED IN THE 01900000 * APPENDAGE ROUTINE, PART 1. 01920000 * ROUTINE FOR CODE CEND COMPLETION OF 01940000 LR R15,R13 01960000 B APPM67CE 7 CP1 OR CP2, WRITE KN 01980000 LR R15,R13 02000000 B APPN7B2 9,23 CP10A 02020000 LR R15,R13 02040000 B APPN8A2 10,11 CP10B 02060000 LR R15,R13 02080000 B APPM4A2 12 CP14 - SETUPS 1, 2, OR 5 02100000 LR R15,R13 02120000 B APPM5A2 13 CP14 - SETUPS 3, 4, OR 6 02140000 LR R15,R13 02160000 B APPM2B2 15 CP16 - SITUATION 2 02180000 LR R15,R13 02200000 B APPM3B2 16 CP16 - SITUATION 3 02220000 LR R15,R13 02240000 B APPN9A2 17,18,19 CP17 02260000 LR R15,R13 17332 02266018 B APPAFB CP14 PART2 17332 02272018 * ROUTINE FOR CODE ABEND COMPLETION OF 02280000 LR R15,R13 02300000 B APPM67AE 7 CP1 OR CP2, WRITE KN 02320000 LR R15,R13 02340000 B APPN7J2 9,23 CP10A 02360000 LR R15,R13 02380000 B APPN8G2 10,11 CP10B 02400000 LR R15,R13 02420000 B APPM4E2 12 CP14 - SETUPS 1, 2, OR 5 02440000 LR R15,R13 02460000 B APPM5E2 13 CP14 -SETUPS 3, 4, OR 6 02480000 LR R15,R13 02500000 B APPM2H2 15,16 CP16 02520000 LR R15,R13 02540000 B APPN9G4 17,18,19 CP17 02560000 LR R15,R13 17332 02566018 B APPAEB CP14 PART2 17332 02572018 B APPN7A3 CONTINUE ROUTINES BEGUN IN 02580000 B APPN7B4 PART 1 02600000 EJECT 02620000 * BRANCH TO M6 OR M7 02640000 APPM67CE L R13,DCBWKPT2 CHAN END OF CP1 OR CP2 02660000 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 02680000 BE APPM6B2 NO MASTER INDEX - CP2 WAS USED 02700000 B APPM7A2 YES MASTER INDEX - CP1 WAS USED 02720000 APPM67AE L R13,DCBWKPT2 ABNORMAL END OF CP1 OR CP2 02740000 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 02760000 BE APPM6J4 NO MASTER INDEX - CP2 WAS USED 02780000 B APPM7J2 YES MASTER INDEX - CP1 WAS USED 02800000 EJECT 02820000 * CHANNEL END CP1, APPENDAGE CODE 7, CHART M7 02840000 APPM7A2 LA R13,C6+8 DID CHAN PROG STOP AT C6 02860000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 02880000 BE APPM7B2 YES - END OF MASTER INDEX SRCH 02900000 LA R13,C16+8 DID CHAN PROG STOP AT C16 02920000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 02940000 BNE APPN3B3 NO - RECORD IS UNREACHABLE 02960000 TM C18,X'20' END OF CYLINDER SEARCH. 02980000 BZ APPM7C4 TEST FOR DUMMY OR INACTIVE 03000000 TM C18,X'08' 03020000 BZ APPM7B3 BRANCH IF INACTIVE OR DUMMY-END 03040000 MVC IOBDADAD,C17 DUMMY CHAINED. 03060000 LA R12,C10A RESTART CP TO SEARCH CYL S20201 03080020 ST R12,IOBSTART-1 03100000 B APPRVXCP RETURN TO IOS TO EXCP 03120000 APPM7C4 MVC IOBDADAD(7),C17 ACTIVE. 03140000 APPM7C45 EQU * S20201 03150020 MVI IOBDADAD+7,X'00' SET UP IOB FOR CP8 03160000 MVI IOBAPP,CODE8 M--R IS ADDR FOUND, R=0 S20201 03170020 L R10,DCBWKPT3 GET STARTING ADDR OF CP8 S20201 03180020 ST R10,CPSTART STORE IN IOB AS CP START S20201 03190020 ST R10,IOBCCWAD AND FOR USE AS BASE REG S20201 03200020 MVC CB23+K3(K5),IOBDADAD+K3 CCHH OF FIRST TRACK, R=0 S20201 03210020 OC CB23+K5(K3),DCBFIRSH SET HHR TO FIRSH S20201 03220020 MVI IOBFLAG1,X'42' APP CODE 8 03260000 LA R12,IOBDADAD+3 INITIALIZE CP8 03280000 STH R12,CB1+2 CB1 SET TO SEEK CCHHR OF IOB 03300000 SRL R12,16 03320000 STC R12,CB1+1 03340000 MVC CB5+1(3),DECBKEY+1 CB5, CB15, CB19 ALL SET TO 03360000 MVC CB19+1(3),DECBKEY+1 03380000 APPM7G4 SR R12,R12 CHECK WITH DEB TO SEE IF NEXT 03400000 IC R12,IOBDADAD ADDRESS ON SAME MODULE 03420000 SLL R12,4 03440000 L R12,32(R3,R12) 03460000 LA R12,0(R12) 03480000 CLR R12,R7 03500000 BE APPRVXCP IF SO, EXECUTE CP RETURN TO IOS 03520000 APPM7G5 MVI IOBASYN,X'01' IF NOT, SCHEDULE ASYNCHRONOUS 03540000 B APPN3B5 ROUTINE TO EXCP 03560000 APPM7B2 TM C9+7,X'20' END MASTER INDEX SEARCH. 03580000 BZ APPM7C2 TEST FOR DUMMY OR INACTIVE 03600000 APPM7B3 TM C9+7,X'08' 03620000 BO APPM7E2 BRANCH IF INACTIVE OR DUMMY-END 03640000 IC R12,C9+7 DUMMY CHAINED. 03660000 SLL R12,29 IF LEVEL INDEX NOT HIGHEST LVL, 03680000 IC R13,DCBNLEV ERROR OF SOME SORT 03700000 SLL R13,29 03720000 CLR R12,R13 03740000 BNE APPN3B3 03760000 APPM7E3 MVI IOBAPP,CODE14 TRK FULL--CP15 CODE S20201 03780020 MVC IOBDADAD(3),DCBLPDA SET UP IOB FOR CP15 03800000 MVI IOBDADAD+7,X'00' INSERT ZERO INTO R 03820000 MVC IOBDADAD+3(4),DCBLETI PUT DCBLETI CCHH INTO IOB 03840000 OC IOBDADAD+6(1),DCBFIRSH+3 03860000 XC IOBDADAD+6(1),DCBFIRSH+3 INCR TO NEXT CYL 03880000 L R10,DCBWKPT3 HHR ZERO 03900000 ST R10,IOBCCWAD START ADDR CI1 03920000 LA R12,CI1 REL CCW 0 CP8 03940000 ST R12,IOBSTART-1 FLAGS INDICATE CC,NO DC 03960000 MVI IOBFLAG1,X'42' 03980000 LA R12,IOBDADAD+3 INITIALIZE CP15 04000000 STH R12,CI1+2 CI1 POINTS TO IOB CCHHR 04020000 SRL R12,16 04040000 STC R12,CI1+1 04060000 MVC CI5+K2(K5),DCBLETI PUT DCB LETI IN CI5 S20201 04070020 MVC CI5(K2),DCBLPDA+K1 PUT IN BB FOR HEAD SEEK S20201 04080020 B APPM7G4 BRANCH TO EXCP 04100000 APPM7C2 TM C9+7,X'04' ACTIVE ENTRY. 04120000 BO APPM7E2 IF LVL 2 MAST IND JUST SRCHED 04140000 OI C6+4,X'40' CC ON TO CHN FROM LVL 1 TO CYL 04160000 APPM7E2 MVC IOBDADAD,C8+7 SEEK ADDR IN IOB IS FND ADDR 04180000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 04200000 B APPRVXCP EXCP RETURN TO IOS 04220000 EJECT 04240000 * ABNORMAL END CP1, APPENDAGE CODE 7, CHART M7 04260000 APPM7J2 EQU * 19374 04270000 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 04280000 BO APPM7J3 YES--BRANCH 19374 04290000 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 04300000 BC PERRYES,APPN3B3 YES--BRANCH 19374 04310000 B APPRVNOR NO--RETRY CHANNEL PROGRAM 19374 04320000 APPM7J3 LA R13,C10+8 DID CHAN PROG STOP AT C10 04380000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 04400000 BNE APPN3B3 NO - RECORD IS UNREACHABLE 04420000 MVI IOBFLAG1,X'42' RESTORE IOB FLAG & ERR CTR 04440000 MVI IOBFLAG2,X'00' UNRELATED FLAG ON 04460000 MVI IOBCSW,X'00' OTHERS OFF 04480000 XC IOBERRCT,IOBERRCT 04500000 TM C9+7,X'20' 04520000 BO APPM7B3 BRANCH IF DUMMY OR INACTIVE 04540000 LA R12,C10A SET UP IOB TO RESTART S20201 04560020 ST R12,IOBSTART-1 RESET EXCEPTION FLAG 04580000 B APPM7E2 BRANCH 04600000 EJECT 04620000 * CHANNEL END CP2, APPENDAGE CODE 7, CHART M6 04640000 APPM6B2 LA R13,C35+8 DID CHAN PROG STOP AT C35 04660000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 04680000 BNE APPN3B3 NO - RECORD IS UNREACHABLE 04700000 TM C37,X'20' WAS ENTRY DUMMY OR INACTIVE 04720000 BZ APPM6D2 BZ IF NO 04740000 TM C37,X'28' WAS ENTRY DUMMY CHAINED 04760000 BO APPM6D3 BO IF YES 04780000 TM DCBNLEV,X'01' DCBNLEV SHOULD = F, WHICH IS 1 04800000 BZ APPN3B3 BZ IF MYSTERIOUS ERROR 04820000 MVI IOBDADAD+7,X'00' ZERO R SET UP CP 15 04840000 MVC IOBDADAD(3),DCBLPDA PUT DCBLPDA MBB IN IOB 04860000 MVC IOBDADAD+3(4),DCBLETI PUT DCBLETI CCHH INTO IOB 04880000 OC IOBDADAD+6(1),DCBFIRSH+3 04900000 XC IOBDADAD+6(1),DCBFIRSH+3 INCREMENT TO A CYL BOUNDRY 04920000 MVI IOBAPP,CODE14 SET CODE 14 FOR CP15 S20201 04940020 L R10,DCBWKPT3 CP8 POINTER 04960000 LA R12,CI1 START AT CI1 04980000 ST R12,IOBSTART-1 05000000 ST R10,IOBCCWAD REL CCW 0 = CB1 05020000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 05040000 MVC CI5+K2(K5),DCBLETI PUT DCB LETI IN CI5 S20201 05050020 MVC CI5(K2),DCBLPDA+K1 PUT IN BB FOR HEAD SEEK S20201 05060020 IC R9,CI1 SAVE 05080000 LA R12,IOBDADAD+3 05100000 ST R12,CI1 PUT IOB ADDRESS IN CI1 05120000 STC R9,CI1 SAVE 05140000 B APPM7G4 IS ASYNC NEEDED S20201 05160020 APPM6D2 MVC IOBDADAD(7),C36 MOVE C36 MBBCCHH TO IOB 05180000 B APPM7C45 SET UP CP 8 S20201 05240020 APPM6D3 MVC IOBDADAD,C36 PUT C36 MBBCCHHR IN IOB 05480000 B APPRVXCP EXCP RETURN TO IOS 05500000 EJECT 05520000 * ABNORMAL END CP2, APPENDAGE CODE 7, CHART M6 05540000 APPM6J4 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 05560000 BC PERRYES,APPN3B3 YES B3 05580000 B APPRVNOR NO - NORMAL RETURN TO IOS 05600000 EJECT 05620000 * CHANNEL END CP10A, APPENDAGE CODE 9, 23, CHART N7 05640000 APPN7B2 LA R13,CB50+8 DID CHAN PROG STOP AT CB50 05660000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 05680000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 05700000 APPN7A3 L R12,DCBWKPT2 SET ON SAME MODULE SWITCH 05720000 OI DCWWKNI,X'20' 05740000 IC R9,IOBDADAD+7 ADD 1 TO R IN IOB 05760000 LA R12,1(R0,R9) 05780000 STC R12,IOBDADAD+7 05800000 STC R12,DCBLPDA+7 PUT NEW R IN LPDA 11081 05820015 APPN7B4 CLI DCBHIRSH,X'00' ARE ALL TRACKS UNSHARED 11081 05840015 BE APPN7C4 YES C4 05860000 IC R9,DCBLPDA+6 IS THIS TRACK SHARED 05880000 IC R12,DCBFIRSH+3 (AND H AND MASK TO GET 05900000 NR R9,R12 REAL TRACK NO.) 05920000 EX R9,CLIFIRSH EXECUTE THE COMPARE 05940000 BNE APPN7C4 NO C4 05960000 CLC DCBHIRSH,DCBLPDA+7 TRK IS SHARED. IS IT LAST RCD 05980000 BNE APPN7C2 NO C2 06000000 APPN7D3 IC R9,IOBDADAD+6 IS THIS LAST 06020000 IC R12,DCBFIRSH+3 06040000 NR R12,R9 DATA TRACK OF THIS 06060000 EX R12,CLILDT CYLINDER 06080000 BE APPN7D4 YES, GO FIND NEXT CYL 06100000 LA R9,1(0,R9) NO, 06120000 STC R9,IOBDADAD+6 ADD 1 TO TRACK 06140000 MVI IOBDADAD+7,X'00' NO - ZERO OUT R IN IOB 06160000 APPN7G2 TM DCBST,X'02' IS LAST BLOCK FULL 06180000 BZ APPN7C2 NO C2 06200000 OI DCBST,X'01' YES - SET ON LAST TRACK FULL SW 06220000 B APPN7C2 06240000 APPN7D4 SR R12,R12 06260000 IC R12,IOBDADAD FIND CURRENT 06280000 SLL R12,4 EXTENT 06300000 AR R12,R3 06320000 OC IOBDADAD+6(1),DCBFIRSH+3 SET TRACK TO MAX 06340000 CLC IOBDADAD+6(1),DEBENDHH+1-IHADEB(R12) LAST TRACK IN EXT 06360000 BNL APPCCH YES 06380000 IC R9,IOBDADAD+6 ONLY THE 2301 WILL GO THIS PATH 06400000 LA R9,1(0,R9) TO ADD 1 TO CYLINDER 06420000 STC R9,IOBDADAD+6 06440000 B APPN7G4 06460000 APPCCH CLC IOBDADAD+3(3),DEBENDCC-IHADEB(R12) LAST CYL OF 06480000 BL APPN7E4A EXTENT (CCH) 06500000 IC R9,IOBDADAD 06520000 LA R9,1(0,R9) PUT NEW M IO IOB 06540000 STC R9,IOBDADAD 06560000 LA R12,16(0,R12) ACCESS NEXT EXTENT INTRY IN DEB 06580000 MVC IOBDADAD+1(6),DEBBINUM-IHADEB(R12) MOVE NEW BBCCHH 06600000 L R13,DEBUCBAD-IHADEB(R0,R12) IS NEW CYL ON SAME MODULE 06620000 LA R13,0(R0,R13) 06640000 CLR R13,R7 06660000 BE APPN7G4 YES G4 06680000 L R12,DCBWKPT2 NO - SET OFF SAME MODULE SW 06700000 NI DCWWKNI,X'DF' 06720000 B APPN7G4 06740000 APPN7E4A MVI IOBDADAD+K6,ZERO SET TRACK TO ZERO S20201 06741020 CLI DCBDEVT,MERLIN IS CYL A TWO BYTE FIELD S20201 06742020 BNE APPN7E4B NO, BR--BYTE ADDRESSING S20201 06743020 IC R13,IOBDADAD+K3 PICK UP C1 OF CC S20201 06744020 SLL R13,8 SHIFT S20201 06745020 IC R13,IOBDADAD+K4 PICK UP C2 OF CC S20201 06746020 LA R13,K1(R0,R13) ADD ONE TO CYL VALUE S20201 06747020 STC R13,IOBDADAD+K4 RESTORE C2 S20201 06748020 SRL R13,8 SHIFT S20201 06749020 STC R13,IOBDADAD+K3 RESTORE C1 S20201 06751020 B APPN7G4 GO SET TO FIRSH-1'S HR S20201 06753020 APPN7E4B L R13,CVTPTR GET CVT ADDRESS S20201 06755020 IC R9,DCBDEVT PICK UP DEVICE TYPE. 23596 06760018 L R13,CVTZDTAB(0,R13) POINT TO DEVICE TABLE. 23596 06770018 IC R9,0(R9,R13) LOCATE PROPER ENTRY. 23596 06780018 LA R12,2(R9,R13) SET INDEX TO H OF CCH. 23596 06790018 LA R13,IOBDADAD+5 R13=A(H OF CHANGE FIELD). 23596 06800018 ADDONE IC R9,0(0,R13) ADD ONE TO SOME BYTE 23596 06820018 LA R9,1(0,R9) OF CCH. 23596 06830018 STC R9,0(0,R13) 23596 06840018 CLC 0(1,R13),0(R12) IS THE NEW VALUE VALID? 23596 06850018 BL APPN7G4 YES, BRANCH. 23596 06860018 MVI 0(R13),0 NO, ZERO THIS BYTE. 23596 06870018 BCTR R12,0 DECREMENT BOTH INDICES 23596 06880018 BCT R13,ADDONE AND TRY NEXT BYTE. 23596 06890018 APPN7G4 OC IOBDADAD+6(1),DCBFIRSH+1 06960000 IC R9,DCBFIRSH+2 06980000 BCTR R9,0 07000000 STC R9,IOBDADAD+7 07020000 B APPN7G2 07040000 CLILDT CLI DCBLDT+1,0 07060000 CLIFIRSH CLI DCBFIRSH+1,0 07080000 APPN7C4 CLC DCBHIRPD,DCBLPDA+7 TRK IS UNSHARED. IS IT LAST RCD 07100000 BE APPN7D3 YES D3 07120000 APPN7C2 MVC CB55(4),IOBDADAD+3 NO - MOVE IOB CCHH TO CB55 07140000 IC R9,IOBDADAD+7 MOVE IOB (R+1) TO CB55 07160000 LA R12,1(R0,R9) 07180000 STC R12,CB55+4 07200000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 07220000 LA R12,CB52 START AT CB52 07240000 ST R12,IOBSTART-1 07260000 LA R13,IOBDADAD+3 07280000 STH R13,CB52+2 07300000 SRL R13,16 07320000 STC R13,CB52+1 PUT IOB ADDRESS IN CB52 07340000 CLI IOBAPP,CODE9 IS APPENDAGE CODE 9 S20201 07360020 BE APPN7E1 YES E1 07380000 MVI IOBAPP,CODE11 SET APPENDAGE CODE TO 11 S20201 07400020 APPN7F1 L R12,DCBWKPT2 IS SAME MODULE SWITCH ON 07420000 TM DCWWKNI,X'20' 07440000 BO APPRVXCP YES EXCP RETURN TO IOS 07460000 MVI IOBASYN,X'01' 07480000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 07500000 APPN7E1 MVI IOBAPP,CODE10 SET APPENDAGE CODE TO 10 S20201 07520020 B APPN7F1 07540000 EJECT 07560000 * ABNORMAL END CP10A, APPENDAGE CODE 9, 23, CHART N7 07580000 APPN7J2 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 07600000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 07620000 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 07640000 BZ APPM1B3 NO M1B3 07660000 LA R13,CB48+8 DID CHAN PROG STOP AT CB48 07680000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 07700000 BE APPN7J5 YES - UNCORRECTABLE I/O ERROR 07720000 LA R13,CB49+8 DID CHAN PROG STOP AT CB49 07740000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 07760000 BE APPN7J5 YES - UNCORRECTABLE I/O ERROR 07780000 LA R13,CB50+8 DID CHAN PROG STOP AT CB50 07800000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 07820000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 07840000 APPN7J5 OI DECBEXC1,X'08' UNCORRECTABLE I/O ERROR 07860000 B APPM1B4 07880000 EJECT 07900000 * CHANNEL END CP10B, APPENDAGE CODE 10, 11, CHART N8 07920000 APPN8A2 LA R13,CB54+8 DID CHAN PROG STOP AT CB54 07940000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 07960000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 07980000 TM CB53+4,X'20' EOF FOR CP14? 13270 07986015 BO APPM426 17332 07993018 L R12,DCBNREC 08000000 LA R12,1(R0,R12) 08020000 ST R12,DCBNREC ADD 1 TO NUMBER OF PRIME RCDS 08040000 CLI IOBAPP,CODE10 IS APPENDAGE CODE 10 S20201 08060020 BE APPM1B4 YES M1B4 08080000 MVI IOBAPP,CODE18 NO, SET APP CODE TO 18 S20201 08100020 OI IOBFLAG1,X'C0' USE DATA AND COMMAND CHAINING 08120000 LA R12,CK1 START AT CK1 08140000 ST R12,IOBSTART-1 08160000 MVC IOBDADAD+3(5),DCBLETI PUT CCHHR OF DCBLETI IN IOB 08180000 MVC IOBDADAD(3),DCBLPDA 08200000 LA R12,IOBDADAD+3 PUT IOB ADDRESS IN CK1 AND CK4 08220000 ST R12,CK1 08240000 MVI CK1,X'31' 08260000 ST R12,CK4 08280000 MVI CK4,X'31' 08300000 MVC CK6+1(3),DECBKEY+1 08320000 B APPM7G4 BRANCH = GO CHECK DEB 08340000 EJECT 08360000 * ABNORMAL END CP10B, APPENDAGE CODE 10, 11, CHART N8 08380000 APPN8G2 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 08400000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 08420000 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 08440000 BZ APPM1B3 NO M1B3 08460000 LA R13,CB55+8 DID CHAN PROG STOP AT CB55 08480000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08500000 BE APPN7J5 YES - UNCORRECTABLE I/O ERROR 08520000 B APPM1B3 NO - RECORD IS UNREACHABLE 08540000 EJECT 08560000 * CHANNEL END CP17, APPENDAGE CODE 17, 18, 19, CHART N9 08580000 APPN9A2 LA R13,CK1 CP START MAY HAVE BEEN A34932 08588020 * CHANGED A34932 08596020 ST R13,IOBSTART-1 FOR RETRY ON ERROR. A34932 08604020 LA R13,CK7+8 A2 STOP AT CK70 A34932 08612020 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08620000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 08640000 CLI CK9,X'00' TEST F IN CK9 08660000 BE APPN9B3 BE IF NORMAL ENTRY 08680000 CLI CK9,X'08' 08700000 BE APPN9B3 BE IF SHARED 08720000 APPN9B2 EQU * 08740000 L R12,DCBWKPT2 08760000 CLI IOBAPP,CODE17 IS APPENDAGE CODE 17 S20201 08780020 BE APPM1B4 YES M1B4 08800000 CLI IOBAPP,CODE18 IS APPENDAGE CODE 18 S20201 08820020 BE APPN9C2 YES C2 08840000 CLC DCWNLEVC,DCBNLEV MUST BE 19 08860000 BE APPN9F1 BE IF LAST TIME THROUGH LOOP 08880000 IC R13,DCWNLEVC NOT LAST TIME. ADD TO LOOP CNTR 08900000 LA R13,1(R0,R13) 08920000 STC R13,DCWNLEVC 08940000 CLI DCWNLEVC,X'02' DOES NLEV COUNTER = 2 08960000 BE APPN9E3 YES E3 08980000 CLI DCWNLEVC,X'03' DOES NLEV COUNTER = 3 09000000 BE APPN9F3 YES F3 09020000 MVC IOBDADAD+3(5),DCBLEMI3 PUT LEMI3 CCHHR IN IOB 09040000 CLI DCBFTMI3+1,X'00' 09060000 BE *+14 09080000 MVC IOBDADAD(1),DCBFTMI3+1 09100000 B APPN9C5 09120000 MVC IOBDADAD(1),DCBFTMI3 09140000 B APPN9C5 09160000 APPN9E3 MVC IOBDADAD+3(5),DCBLEMI1 PUT LEMI1 CCHHR IN IOB 09180000 CLI DCBFTMI1+1,X'00' 09200000 BE *+14 09220000 MVC IOBDADAD(1),DCBFTMI1+1 09240000 B APPN9C5 09260000 MVC IOBDADAD(1),DCBFTMI1 09280000 B APPN9C5 09300000 APPN9F3 MVC IOBDADAD+3(5),DCBLEMI2 PUT LEMI2 CCHHR IN IOB 09320000 CLI DCBFTMI2+1,X'00' 09340000 BE *+14 09360000 MVC IOBDADAD(1),DCBFTMI2+1 09380000 B *+10 09400000 MVC IOBDADAD(1),DCBFTMI2 09420000 XC IOBDADAD+1(2),IOBDADAD+1 09440000 B APPN9C5 09460000 APPN9B3 CLI CB26,X'10' TEST F IN CB26 09480000 BNE APPN9B2 BNE IF NOT OVERFLOW END 09500000 MVC IOBDADAD+3(5),CB24 RE-EXECUTE WITH OFLO ENTRY 09520000 B APPRVXCP EXCP RETURN TO IOS 09540000 APPN9F1 TM DCWHIAV,X'40' IS HIGHEST INDEX IN CORE 09560000 BZ APPN9H1 09580000 L R12,DCWMSHIL YES - CHANGE ITS LAST KEY 09600000 L R11,DECBKEY 09620000 IC R9,DCBKEYLE 09640000 LA R13,0(R0,R9) 09660000 BCTR R13,R0 09680000 EX R13,APPN9G1A 09700000 APPN9H1 MVI IOBASYN,X'08' 09720000 B APPM1B5 SCHEDULE COMPLETION 09740000 APPN9C2 CLI DCBNLEV,X'00' IS THERE ONLY A TRACK INDEX 09760000 BE APPM1B4 YES M1B4 09780000 L R12,DCBWKPT2 09800000 MVI DCWNLEVC,X'01' INITIALIZE COUNTER TO 1 09820000 MVC IOBDADAD+3(5),DCBLECI PUT DCBLECI CCHHR IN IOB 09840000 CLI DCBFTCI+1,X'00' 09860000 BE *+14 09880000 MVC IOBDADAD(1),DCBFTCI+1 09900000 B APPMVI 09920000 MVC IOBDADAD(1),DCBFTCI 09940000 APPMVI MVI IOBAPP,CODE19 SET APPENDAGE CODE TO 19 S20201 09960020 OI IOBFLAG1,X'C0' USE DATA AND COMMNND CHAINING 09980000 LA R12,CK1 START AT CK1 10000000 ST R12,IOBSTART-1 10020000 APPN9C5 MVI IOBASYN,X'01' 10040000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 10060000 EJECT 10080000 * ABNORMAL END CP17, APPENDAGE CODE 17, 18, 19, CHART N9 10100000 APPN9G4 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 10120000 BC PERRYES,APPM1B3 YES M1B3 A34932 10126020 * THIS IS A FIRST ENTRY ON AN ERROR. 10132020 LA R11,CK4 TEST FOR STOP PRIOR TO A34932 10138020 * CK4 A34932 10144020 CLR R12,R11 DID IT STOP BEFORE CK4? A34932 10150020 BNH APPRVNOR BIF YES. RETRY FROM CK1. A34932 10156020 ST R11,IOBSTART-1 RETRY FROM CK4 A34932 10162020 B APPRVNOR RETURN TO IOS. A34932 10168020 APPN9G1A MVC 0(0,R12),0(R11) 10180000 EJECT 10200000 * COMMON ROUTINE TO SCHEDULE ASYNCHRONOUS ROUTINE 10220000 APPM1B3 OI DECBEXC1,X'04' RECORD IS UNREACHABLE 10240000 APPM1B4 MVI IOBASYN,X'08' SCHEDULE PROCESSING COMPLETION 10260000 APPM1B5 LA R14,BYP(R14) SCHEDULE ASYNCH ROUTINE 15924 10280016 L R13,CVTPTR 10300000 L R13,CVTEXEF 10320000 BR R13 10340000 EJECT 10360000 * CHANNEL END CP16, APPENDAGE CODE 15, CHART M2 10380000 APPM2B2 LA R13,CJ10+8 DID CHAN PROG STOP AT CJ10 10400000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 10420000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 10440000 L R12,DCBMSWA WAS OFLO END ENTRY READ IN 10460000 TM 8(R12),X'08' 10480000 BZ APPM2D3 YES D3 10500000 MVC IOBDADAD,0(R12) NO - SET SEEK ADDRESS FROM LINK 10520000 B APPM7G4 BRANCH = GO CHECK DEB 10540000 APPM2D3 MVC CJ11,IOBDADAD PUT IOB MBBCCHHR IN CJ11 10560000 MVI IOBASYN,X'0B' SET ASYNCHRONOUS CODE TO 11 10580000 NI IOBINDCT,X'DF' INDICATE OFLO RCD IN AREA 10600000 B APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 10620000 EJECT 10640000 * ABNORMAL END CP16, APPENDAGE CODE 15, 16, CHART M2 10660000 APPM2H2 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 10680000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 10700000 B APPM1B3 YES M1B3 10720000 EJECT 10740000 * CHANNEL END CP16, APPENDAGE CODE 16, CHART M3 10760000 APPM3B2 LA R13,CJ10+8 DID CHAN PROG STOP AT CJ10 10780000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 10800000 BNE APPM3B3 NO - TRY CJ9 S20201 10810020 MVC CJ11,IOBDADAD PUT IOB MBBCCHHR IN CJ11 10840000 L R12,DCBMSWA SET SEEK ADDRESS FROM LINK 10860000 MVC IOBDADAD,0(R12) 10880000 L R12,DCBWKPT2 SET OFF FIRST TIME ONLY SW 10900000 NI DCWWKNI,X'BF' 10920000 B APPM7G4 BRANCH = GO CHECK DEB 10940000 APPM3B3 LA R13,CJ9+L'CJ9 STOP AT CJ9 10950020 CLR R12,R13 S20201 10960020 BNE APPM3B4 NO - TRY CJ8 S20201 10970020 MVC CJ11,IOBDADAD SAVE IOB MBBCCHHR IN CJ11 11020000 TM DCBOPTCD,X'02' IS DELETE OPTION TAKEN 11040000 BZ APPM3C4 NO C4 11060000 L R12,DCBMSWA IS RCD MARKED FOR DELETION 11080000 LA R13,10(R0,R12) 11100000 CLI 0(R13),X'FF' 11120000 BNE APPM3C4 NO C4 11140000 MVI IOBASYN,X'0E' SET ASYNCHRONOUS CODE TO 14 11160000 APPM3E4 NI IOBINDCT,X'DF' INDICATE OFLO RCD IN AREA 11180000 B APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 11200000 APPM3C4 OI DECBEXC1,X'01' INDICATE DUPLICATE RECORD 11220000 MVI IOBASYN,X'08' SCHEDULE PROCESSING COMPLETION 11240000 B APPM1B5 11260000 APPM3B4 LA R13,CJ8+L'CJ8 SEE IF STOPPED AT CJ8 11270020 CLR R12,R13 S20201 11280020 BNE APPM1B3 IF NOT, UNREACHABLE BLK S20201 11290020 L R12,DCBWKPT2 IS FIRST TIME ONLY SWITCH ON 11340000 TM DCWWKNI,X'40' 11360000 BO APPM3B5 YES B5 11380000 MVI IOBASYN,X'0C' SET ASYNCHRONOUS CODE TO 12 11400000 B APPM3E4 11420000 APPM3B5 MVI IOBASYN,X'0D' SET ASYNCHRONOUS CODE TO 13 11440000 MVC IOBDADAD(7),CJ11 RESTORE TRK INDEX MBBCCHH 11460000 B APPM3E4 11480000 EJECT 11500020 * CHANNEL END CP14, APPENDAGE CODE 12, CHART M4 11520000 APPM4A2 LA R13,CH18+8 DID CHAN PROG STOP AT CH18 11540000 APPM4A21 EQU * 13270 11542015 TM CB53+4,X'20' EOF WRITTEN 13270 11544015 BZ APPM4A22 BRANCH IF NO 13270 11546015 MVC IOBDADAD,DCBLIOV INITIALIZE IOBDADAD SEEK 13270 11548015 MVC DCBLIOV(3),CH23 RESET LIOV FROM 13270 11550015 MVC DCBLIOV+3(5),CH24 CP14 13270 11552015 CLR R12,R13 13270 11554015 BNE APPM1B3 B = UNREACHABLE 13270 11556015 MVI IOBFLAG1,X'42' CC SET ON 13270 11558015 MVI IOBAPP,CODE10 SET APPENDAGE CODE 10 S20201 11560020 LA R12,CB52 13270 11562015 ST R12,IOBSTART-1 13270 11564015 LA R13,IOBDADAD+3 13270 11566015 STH R13,CB52+2 13270 11568015 SRL R13,16 13270 11570015 STC R13,CB52+1 13270 11572015 SR R13,R13 16384 11572316 IC R13,IOBDADAD GET M 16384 11572616 SLL R13,4 TIMES 16 16384 11572916 LA R13,32(R3,R13) ALLOW FOR BASIC DEB TOO 16384 11573216 L R12,0(0,R13) GET UCB POINTER 16384 11573516 LA R12,0(0,R12) ZERO HIGH ORDER BYTE 16384 11573816 CR R7,R12 SAME UNIT 16384 11574116 BE APPRVXCP YES--EXCP RETURN 16384 11574416 MVI IOBASYN,X'01' NO--SET ASYNCH CODE = 1 16384 11574716 B APPM1B5 SCHEDULE ASYNCHRONOUS RTN 16384 11575016 APPM426 CLI CK9+7,12 INSERT TO MIDDLE OVFL CH 17332 11575218 MVI CB53+4,X'00' RESET EOF FLAG 17332 11575418 BE APPM1B4 IF YES POST COMPLETION 17332 11575618 APPM4A22 EQU * 13270 11576015 CLR R12,R13 13270 11580015 BNE APPM1B3 B = UNREACHABLE 13270 11582015 TM CH8E+4,X'40' TEST FOR UWA 17332 11582618 BZ APPM425 IF NO-BRANCH 17332 11583218 NI CH8E+4,X'42' RESET FLAG 17332 11583818 CLI CK9+7,14 ASYN CODE=14 17332 11584418 BE APPM1B4 IF YES-POST COMPLETION 17332 11585018 CLI CK9+7,9 ASYN CODE=9 17332 11585618 BE APPM4A23 IF YES BRANCH 17332 11586218 MVI IOBAPP,X'04' SET UP CP14 PART2 17332 11586818 MVC IOBSTART,CH21+4 TO UPDATE TRACK 17332 11587418 MVC IOBDADAD,CH14 RESTORE IOBSEEK 17332 11588018 MVI CH14,X'03' SET NOP IN CH14 17332 11588618 MVI CH14+4,X'20' 17332 11589218 MVI CH14+7,X'01' 17332 11589818 B APPN9C5 17332 11590418 APPM4A23 MVI IOBCOUNT,X'01' ERROR COUNT=1 17332 11591018 MVC IOBDADAD(3),CB10+7 IOBSEEK ADDR 17332 11591618 MVC IOBDADAD+3(5),CB23+3 17332 11592218 IC R12,IOBDADAD+7 REDUCE R BY 1 17332 11592818 BCTR R12,R0 17332 11593418 STC R12,IOBDADAD+7 17332 11594018 TM DCBRECFM,X'10' TEST FOR BLOCKED 17332 11594618 BO APPM424 IF YES-BRANCH 17332 11595218 L R12,CH6+4 RESTORE 10 BYTES 17332 11595818 L R13,DECBAREA USED FOR LINK FIELD IN 17332 11596418 MVC 0(10,R12),0(R13) OVFL RECORD 17332 11597018 APPM424 MVC IOBSTART,CD2+5 START OF CP12B 17332 11597618 MVI IOBAPP,X'15' APP CODE 15 17332 11598218 OI IOBFLAG1,X'C0' 17332 11598818 B APPN9C5 17332 11599418 APPM425 L R12,DCBWKPT2 17332 11609418 TM DCWWKNI,X'10' IS ADD-TO-END INDICATOR ON 11620000 BZ APPM1B4 NO - SCHEDULE COMPLETION 11640000 APPM4C2 MVC CK6+1(3),DECBKEY+1 PUT I ADDRESS IN CK6 11660000 LA R12,IOBDADAD+3 11680000 STH R12,CK1+2 11700000 SRL R12,16 11720000 STC R12,CK1+1 IOB ADDRESS TO CK1 AND CK4 11740000 MVC CK4+1(3),CK1+1 11760000 B APPN9C2 CP17/CP17W APPENDAGE 11780000 EJECT 11800000 * ABNORMAL END CP14, APPENDAGE CODE 12, CHART M4 11820000 APPM4E2 EQU * 19374 11830000 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 11850016 BO APPM4I2 YES, BRANCH 15924 11860016 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 11880000 BC PERRNO,APPRVNOR NO--RETRY CHANNEL PGM 19374 11900000 TM IOBSENSE,X'08' 11920000 BZ APPM1B3 BRANCH IF CAUSE NOT DATA CHECK 11940000 APPM4G2 LA R13,CH16+8 IF STOP NOT AT CH16, CH17, OR 11960000 CLR R12,R13 CH18, BRANCH 11980000 BE APPM4H2 12000000 LA R13,CH17+8 12020000 CLR R12,R13 12040000 BE APPM4H2 12060000 LA R13,CH18+8 12080000 CLR R12,R13 12100000 BNE APPM1B3 12120000 APPM4H2 OI DECBEXC1,X'08' IF SO, SET UNCORRECTABLE I/O 12140000 B APPM1B4 ERROR IN EXCEP CODE IN DECB 12160000 APPM4I2 LA R13,CH14+8 DID CHAN PROG STOP AT CH14 12180000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 12200000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 12220000 MVC IOBDADAD,CH23 MOVE CH23 MBBCCHHR TO IOB 12240000 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH15 12260000 MVI IOBASYN,X'01' 12280000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 12300000 EJECT 12320000 * CHANNEL END CP14, APPENDAGE CODE 13, CHART M5 12340000 APPM5A2 LA R13,CH22+8 DID CHAN PROG STOP AT CH22 12360000 B APPM4A21 12380000 EJECT 12400000 * ABNORMAL END CP14, APPENDAGE CODE 13, CHART M5 12420000 APPM5E2 EQU * 19374 12430000 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 12450016 BO APPM5I2 YES, BRANCH 15924 12460016 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 12480000 BC PERRNO,APPRVNOR NO--RETRY CHAN PGM 19374 12500000 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 12520000 BZ APPM1B3 NO - RECORD IS UNREACHABLE 12540000 LA R13,CH22+8 DID CHAN PROG STOP AT CH22 12560000 CLR R12,R13 12580000 BE APPM4H2 YES - UNCPRRECTABLE I/O ERROR 12600000 B APPM4G2 NO - TRY OTHER PLACES 12620000 APPM5I2 LA R13,CH19+8 DID CHAN PROG STOP AT CH19 12640000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 12660000 BNE APPM4I2 NO - BUT TRY AT CH14 12680000 MVC IOBDADAD,CJ11 MOVE CJ11 MBBCCHHR TO IOB 12700000 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH20 12720000 MVI IOBASYN,X'01' 12740000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 12760000 APPRVXCP SR R12,R12 GET BB 12780000 IC R12,IOBDADAD 12800000 SLL R12,4 12820000 LA R12,32(R12,R3) 12840000 MVC IOBDADAD+1(2),4(R12) 12860000 LA R14,EXCP(R14) SETUP EXCP IOS RETURN 15924 12865016 XC IOBFLAG2(3),IOBFLAG2 CLEAR FLAG2,SENSE BYTES 15924 12870016 XC IOBCSW(9),IOBCSW CLEAR FLAG3,CSW,AND SIOCC 15924 12875016 XC IOBERRCT(2),IOBERRCT CLEAR ERROR COUNT 15924 12880016 NI IOBFLAG1,X'C2' RESET FLAG1 15924 12885016 APPRVNOR BR R14 RETURN TO IOS 15924 12890016 EJECT , 17332 12890418 * NORMAL END APPENDAGE CODE 4 12890818 * UPDATE TRACK INDICES WITH 2ND PART CP14 12891218 * 12891618 * 12892018 APPAFB LA R13,CH14+8 DID CP END AT CH14 17332 12892418 CLR R12,R13 17332 12892818 BNE APPN3B3 NO-RECORD IS UNREACHABLE 17332 12893218 MVC IOBASYN,CK9+7 17332 12893618 CLI IOBASYN,10 ADD TO END 17332 12894018 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 12894418 CLI IOBASYN,11 ADD TO END 17332 12894818 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 12895218 B APPM1B4 POST COMPLETION 17332 12895618 EJECT , 17332 12896018 * 12896418 * ABNORMAL END APPENDAGE CODE 4 12896818 * UPDATE TRACK INDICES 12897218 * 12897618 APPAEB TM IOBECBAD,PERRMASK PERM ERROR 17332 12898018 BC PERRNO,APPRVNOR IF NO-NORMAL RET TO IOS 17332 12898418 B APPM1B3 POST UNREACHABLE BLOCK 17332 12898818 EJECT 12900000 APPN3B3 EQU APPM1B3 LABELS USED IN COMMON ROUTINE TO 12920000 APPN3B5 EQU APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 12940000 * ADDRESS OF COMMUNICATION VECTOR TABLE 12960000 CVTPTR EQU 16 12980000 CODE8 EQU 8 CHAN PGM 8 APP CODE S20201 12981020 CODE9 EQU 9 CHAN PGM 10A APP CODE S20201 12982020 CODE10 EQU 10 CHAN PGM 10B APP CODE S20201 12983020 CODE11 EQU 11 CHAN PGM 10B APP CODE S20201 12984020 CODE14 EQU 14 CHAN PGM 15 APP CODE S20201 12985020 CODE17 EQU 17 CHAN PGM 17 APP CODE S20201 12986020 CODE18 EQU 18 CHAN PGM 17 APP CODE S20201 12987020 CODE19 EQU 19 CHAN PGM 17 APP CODE S20201 12988020 CVTZDTAB EQU X'40' CVT'S DEV CHAR TABLE PTR 23596 12990018 MERLIN EQU X'09' DEVICE CODE S20201 12995020 * RETURN TO IOS VECTOR TABLE 13000000 CVT DSECT 13120000 DS F COMMUNICATION VECTOR TABLE EXIT EFFECTOR 13140000 CVTEXEF DS F USED WITH REG 13 TO SCHED ASYNC ROUTINES 13160000 EJECT 13180000 * WRITE KEY NEW CHANNEL PROGRAM REFERENCES (NO WRITE CHECK) 13580020 IHAWKNCP IGGWKNCP 13880020 IGGCP12C 14180020 IGGCP12A 14480020 EJECT 15620000 * DATA EVENT CONTROL BLOCK 15640000 IHADECB DSECT 15660000 DS 0F 15680000 DECBECB DS CL4 EVENT CONTROL BLOCK (ECB) 15700000 DECBTYP1 DS BL1 TYPE B6 - 1 IF LENGTH IS S 15720000 * B7 - 1 IF AREA IS S 15740000 DECBTYP2 DS BL1 B0 - 1 IF READ K 15760000 * B1 - 1 IF READ KX 15780000 * B2 - 1 IF READ KU 15800000 * B4 - 1 IF WRITE K 15820000 * B5 - 1 IF WRITE KN 15840000 DECBLGTH DS CL2 LENGTH OF BLOCK 15860000 DECBDCBA DS A POINTER TO DCB 15880000 DECBAREA DS A ADDRESS OF AREA 15900000 DECBLOGR DS A POINTER TO LOGICAL RECORD 15920000 DECBKEY DS A POINTER TO KEY 15940000 DECBEXC1 DS BL1 EXCPTN CD B0-RECORD NOT FOUND 15960000 * B1-RECORD LGTH CHK 15980000 * B2-NO SPACE 16000000 * B3-INVALID REQUEST 16020000 * B4-UNCORRECTABLE IO 16040000 * B5-UNREACHABLE BLOCK 16060000 * B6-OVERFLOW RECORD 16080000 * B7-DUPLICATE 16100000 DECBEXC2 DS BL1 B7-READ KU 16120000 EJECT 16140000 DCBD DSORG=(IS) 16160000 EJECT 16180000 IHAIOB IGGIOBD 16380020 CPSTART EQU IOBSTART-1 S20201 16580020 EJECT 17500000 IHADCW IGGBISAM 17600020 EJECT 18040000 IHADEB IGGDEBD 18140020 EJECT 18820000 END 18840000 ./ ADD SSI=22070602,NAME=IGG019GM,SOURCE=0 TITLE 'IGG019GM - APPENDAGES-PART 2,WRITE KN,WITH WRT CHK' 00020000 COPY LCGASMSW 00030001 IGG019GM CSECT 00040000 * RELEASE 14 DELETIONS * 00042000 * RELEASE 15 DELETIONS * 00044000 *1633 13270 00044515 *1633 11081 00045015 * RELEASE 16 DELETIONS * 00046000 *3485018800,043400-044200,127600-128000,137800-138200,149000, 15924 00046516 *3485150200-151000 15924 00047016 *3485124760 16384 00047516 * RELEASE 17 DELETIONS * 00048000 *1695000680 17516 00048600 *1695 P4700 00049200 *1695043400-044000,127500-127600,127900-128000,137700-137800 19374 00049400 * 138100,138200 19374 00049600 * RELEASE 18 DELETIONS * 00050000 *3123068000-069800 23596 00051018 *3123083320,125000 17332 00051518 *3123124780 M3216 00051718 * RELEASE 19 DELETIONS * 00052000 * RELEASE 20 DELETIONS * 00054000 *2371031400,031600,032000,032400,032600,032800,033000,038400, S20201 00054120 *2371041400,046200,049800,051000,052000,052400-053200,053400- S20201 00054220 *2371055000,067900,068500,074000,074400,076000,084000,084400, S20201 00054320 *2371093800,094200,105800,117200,118600,118800-119000,121800, S20201 00054420 *2371122000-122200,124600,152000-160800,161000-169800,170000, S20201 00054520 *2371170200-180800,186800-192600,192800-199600,200000-201800, S20201 00054620 *2371202000-208200,208400-212800 S20201 00054720 *2371092000,107700-107800 A34932 00055020 *2371092120 M3299 00055520 * M5592 00055720 * M5905 00055820 * RELEASE 21 DELETIONS * 00056000 * RELEASE 22 DELETIONS * 00058000 *STATUS CHANGE LEVEL 007 00068020 * 00080000 * FUNCTION/OPERATION- APPENDAGE ROUTINES FOR BISAM 00100000 * WHEN READ AND UPDATE IS NOT USED, 00120000 * WHEN WRITE KN IS USED, 00140000 * WHEN WRITE VALIDITY CHECKING IS REQUESTED, 00160000 * (PART 2) 00180000 * 00200000 * 00220000 * CEND - IF CHANNEL PROGRAM ENDS 00240000 * **WITHOUT ERROR, EITHER 00260000 * PROCESSING COMPLETION WILL BE SCHEDULED, 00280000 * PROCESSING CONTINUATION WILL BE SCHEDULED, 00300000 * OR PROCESSING WILL CONTINUE. 00320000 * **WITH A LENGTH CHECK, TESTS DETERMINE WHETHER 00340000 * OR NOT TO TREAT THE SITUATION AS A REAL 00360000 * ERROR. 00380000 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 00400000 * BLOCK' IS INDICATED IN THE DECB, AND 00420000 * PROCESSING COMPLETION WILL BE SCHEDULED. 00440000 * 00460000 * ABEND - IF CHANNEL PROGRAM ENDS ABNORMALLY BECAUSE OF 00480000 * **PERMANENT ERROR, 'UNCORRECTABLE I/O ERROR' 00500000 * IS INDICATED IN THE DECB, AND PROCESSING 00520000 * COMPLETION WILL BE SCHEDULED. 00540000 * USE OF WRITE VALIDITY CHECKING OPTION 00560000 * ALLOWS A LIMITED NUMBER OF RE-EXECUTIONS 00580000 * BEFORE INDICATING AN ERROR. 00600000 * **NON-PERMANENT ERROR, ONE RE-TRY IS MADE 00620000 * BEFORE INDICATING A PERMANENT ERROR. 00640000 * **FILE PROTECTION, TESTS DETERMINE WHETHER 00660000 * OR NOT TO TREAT THE SITUATION AS A REAL 00680000 * ERROR. 00700000 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 00720000 * BLOCK' IS INDICATED IN THE DECB, AND 00740000 * PROCESSING COMPLETION WILL BE SCHEDULED. 00760000 EJECT 00780000 * ENTRY POINTS- 00800000 * ANY POINT IN THE VECTOR TABLE AT THE BEGINNING OF THE MODULE. 00820000 * 00840000 * INPUT - N/A 00860000 * OUTPUT - N/A 00880000 * EXTERNAL ROUTINES - N/A 00900000 * EXITS- 1. RETURN TO IOS VIA THE APPENDAGE RETURN VECTOR TABLE POINTED 00920000 * TO BY REGISTER 14. SEE THE DSECT LABELED APPRV FOR THE 00940000 * FORMAT OF THIS TABLE AND THE USE OF EACH EXIT. 00960000 * USED TO CONTINUE PROCESSING. 00980000 * 2. SCHEDULE AN ASYNCHRONOUS ROUTINE - BRANCH VIA THE EXIT 01000000 * EFFECTOR ADDRESS IN THE COMMUNICATION VECTOR TABLE. 01020000 * USED TO SCHEDULE PROCESSING COMPLETION OR CONTINUATION. 01040000 * 01060000 * TABLES/WORK AREAS - DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB, 01080000 * COMMUNICATION VECTOR TABLE. 01100000 * SEE DSECTS AT END OF MODULE FOR FORMAT AND DESCRIPTIONS. 01120000 * 01140000 * ATTRIBUTES- REENTRANT. DISABLED. 01160000 * NOTES - NONE 01180000 EJECT 01200000 K0 EQU 0 S20201 01202020 K1 EQU 1 S20201 01204020 K2 EQU 2 S20201 01206020 K3 EQU 3 S20201 01208020 K4 EQU 4 S20201 01210020 K5 EQU 5 S20201 01212020 K6 EQU 6 S20201 01214020 K7 EQU 7 S20201 01216020 * GENERAL REGISTERS ARE USED AS FOLLOWS 01220000 * 01240000 R0 EQU 0 * ----- 01260000 R1 EQU 1 * 12* ADDRESS 01280000 R2 EQU 2 * IOB 01300000 R3 EQU 3 * DEB 01320000 R4 EQU 4 * DCB 01340000 R5 EQU 5 * ----- 01360000 R6 EQU 6 * ----- 01380000 R7 EQU 7 * UCB 01400000 R8 EQU 8 * ----- 01420000 R9 EQU 9 # WORK REGISTER 01440000 R10 EQU 10 CHANNEL PROGRAM POINTER 01460000 R11 EQU 11 DECB 01480000 R12 EQU 12 WORK REGISTER 01500000 R13 EQU 13 WORK REGISTER 01520000 R14 EQU 14 IOS RETURN VECTOR TABLE 01540000 R15 EQU 15 BASE REGISTER 01560000 * 01580000 * * MEANS THIS REGISTER IS SET UP UPON ENTRY FROM IOS, 01600000 * AND ITS CONTENTS MUST BE RESTORED UPON RETURN TO IOS 01620000 * # MEANS THIS REGISTER MAY BE CHANGED, BUT UPON RETURN TO IOS 01640000 * MUST CONTAIN ZEROES IN THE THREE HIGH ORDER BYTES 01660000 * 01680000 PERRMASK EQU X'20' TO TEST FOR PERMANENT ERROR, TEST 01700000 PERRYES EQU 8 IOBECBAD, B2. IF OFF (CONDITION CODE 8) 01720000 PERRNO EQU 7 THERE IS A PERM ERR. ELSE B2 ON ( CD 7) 01740000 BYP EQU 12 RETURN TO IOS/BYPASS 15924 01745016 EXCP EQU 8 RETURN TO IOS/EXCP 15924 01750016 NORMAL EQU 0 RETURN TO IOS/NORMAL 15924 01755016 MIS EQU PERRMASK MASTER IDX SRCH MASK 01756000 CCOFF EQU X'BF' TURN OFF CC MASK 01757000 USING IHAIOB,R2 IOB POINTER 01760000 USING IHADEB,R3 DEB POINTER 01780000 USING IHADCB,R4 DCB POINTER 01800000 USING IHAWKNCP,R10 CHANNEL PROGRAM POINTER 01820000 USING IHADECB,R11 DECB POINTER 01840000 USING IHADCW,R12 DCB WA POINTER ONLY AS WORK REG 01860000 USING IGG019GM,R15 BASE 01900000 EJECT 01920000 * VECTOR TABLE. BRANCH TO THE ROUTINE SELECTED IN THE 01940000 * APPENDAGE ROUTINE, PART 1. 01960000 * ROUTINE FOR CODE CEND COMPLETION OF 01980000 LR R15,R13 02000000 B APPM67CE 7 CP1 OR CP2 FOR WRITE KN 02020000 LR R15,R13 02040000 B APPN7B2 9,23 CP10AW 02060000 LR R15,R13 02080000 B APPN8A2 10,11 CP10BW 02100000 LR R15,R13 02120000 B APPM4A2 12 CP14W - SETUPS 1, 2, OR 5 02140000 LR R15,R13 02160000 B APPM5A2 13 CP14W - SETUPS 3, 4, OR 6 02180000 LR R15,R13 02200000 B APPM2B2 15 CP16 - SITUATION 2 02220000 LR R15,R13 02240000 B APPM3B2 16 CP16 - SITUATION 3 02260000 LR R15,R13 02280000 B APPN9A2 17,18,19 CP17W 02300000 LR R15,R13 17332 02306018 B APPAFB CP14 PART2 17332 02312018 * ROUTINE FOR CODE ABEND COMPLETION OF 02320000 LR R15,R13 02340000 B APPM67AE 7 CP1 OR CP2, WRITE KN 02360000 LR R15,R13 02380000 B APPJ3B2 9,23 CP10AW 02400000 LR R15,R13 02420000 B APPJ4B2 10,11 CP10BW 02440000 LR R15,R13 02460000 B APPJ5B2 12 CP14W - SETUPS 1, 2, OR 5 02480000 LR R15,R13 02500000 B APPJ6B2 13 CP14W - SETUPS 3, 4, OR 6 02520000 LR R15,R13 02540000 B APPM2H2 15,16 CP16 02560000 LR R15,R13 02580000 B APPJ7B2 17,18,19 CP17W 02600000 LR R15,R13 17332 02606018 B APPAEB CP14 PART2 17332 02612018 B APPN7A3 CONTINUE ROUTINES BEGUN IN 02620000 B APPN7B4 PART 1 02640000 USING CVT,R13 COMMUNICATION VECTOR TABLE 02660000 EJECT 02680000 * BRANCH TO M6 OR M7 02700000 APPM67CE L R13,DCBWKPT2 CHAN END OF CP1 OR CP2 02720000 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 02740000 BE APPM6B2 NO MASTER INDEX - CP2 WAS USED 02760000 B APPM7A2 YES MASTER INDEX - CP1 WAS USED 02780000 APPM67AE L R13,DCBWKPT2 ABNORMAL END OF CP1 OR CP2 02800000 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 02820000 BE APPM6J4 NO MASTER INDEX - CP2 WAS USED 02840000 B APPM7J2 YES MASTER INDEX - CP1 WAS USED 02860000 EJECT 02880000 * CHANNEL END CP1, APPENDAGE CODE 7, CHART M7 02900000 APPM7A2 LA R13,C6+8 DID CHAN PROG STOP AT C6 02920000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 02940000 BE APPM7B2 YES - END OF MASTER INDEX SRCH 02960000 LA R13,C16+8 DID CHAN PROG STOP AT C16 02980000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 03000000 BNE APPN3B3 NO - RECORD IS UNREACHABLE 03020000 TM C18,X'20' END OF CYLINDER SEARCH. 03040000 BZ APPM7C4 TEST FOR DUMMY OR INACTIVE 03060000 TM C18,X'08' 03080000 BZ APPM7B3 BRANCH IF INACTIVE OR DUMMY-END 03100000 MVC IOBDADAD,C17 DUMMY CHAINED. 03120000 LA R12,C10A RESTART CP TO SEARCH CYL S20201 03140020 ST R12,CPSTART INDEX ON CHAIN. S20201 03160020 B APPRVXCP RETURN TO IOS TO EXCP 03180000 APPM7C4 MVC IOBDADAD(K7),C17 ACTIVE. S20201 03190020 APPM7C45 EQU * S20201 03200020 MVI IOBDADAD+7,X'00' SET UP IOB FOR CP8 03220000 MVI IOBAPP,CODE8 M--R IS ADDR FOUND, R=0 S20201 03230020 L R10,DCBWKPT3 GET STARTING ADDR OF CP8 S20201 03240020 ST R10,CPSTART STORE IN IOB AS CP START S20201 03250020 ST R10,IOBCCWAD AND FOR USE AS BASE REG S20201 03260020 MVC CB23+K3(K5),IOBDADAD+K3 CCHH OF FIRST TRACK, R=0 S20201 03270020 OC CB23+K5(K3),DCBFIRSH SET HHR TO FIRSH S20201 03280020 MVI IOBFLAG1,X'42' APP CODE 8 03320000 LA R12,IOBDADAD+3 INITIALIZE CP8 03340000 STH R12,CB1+2 CB1 SET TO SEEK CCHHR OF IOB 03360000 SRL R12,16 03380000 STC R12,CB1+1 03400000 MVC CB5+1(3),DECBKEY+1 CB5, CB15, CB19 ALL SET TO 03420000 MVC CB19+1(3),DECBKEY+1 03440000 APPM7G4 SR R12,R12 CHECK WITH DEB TO SEE IF NEXT 03460000 IC R12,IOBDADAD ADDRESS ON SAME MODULE 03480000 SLL R12,4 03500000 L R12,32(R3,R12) 03520000 LA R12,0(R12) 03540000 CLR R12,R7 03560000 BE APPRVXCP IF SO, EXECUTE CP RETURN TO IOS 03580000 APPM7G5 MVI IOBASYN,X'01' IF NOT, SCHEDULE ASYNCHRONOUS 03600000 B APPN3B5 ROUTINE TO EXCP 03620000 APPM7B2 EQU * * 03640000 AIF ('&LIB' EQ 'LIB1').NOTAOS1 03642000 TM C6+K5,CC WAS C6 CHAINED 03644000 BZ APPAOS1 NO, CONTINUE 03646000 NI C6+K5,CCOFF TURN OFF INDICATOR 03648000 OI C6+K4,CC RECHAIN C6 03650000 B APPAOSJ3 RESCHEDULE CP1 03652000 APPAOS1 EQU * * 03654000 .NOTAOS1 ANOP 03656000 TM C9+K7,MIS END MASTER INDEX SEARCH. 03658000 BZ APPM7C2 TEST FOR DUMMY OR INACTIVE 03660000 APPM7B3 TM C9+7,X'08' 03680000 BO APPM7E2 BRANCH IF INACTIVE OR DUMMY-END 03700000 IC R12,C9+7 DUMMY CHAINED. 03720000 SLL R12,29 IF LEVEL INDEX NOT HIGHEST LVL, 03740000 IC R13,DCBNLEV ERROR OF SOME SORT 03760000 SLL R13,29 03780000 CLR R12,R13 03800000 BNE APPN3B3 03820000 APPM7E3 MVI IOBAPP,CODE14 TRK FULL--CP15 CODE S20201 03840020 MVC IOBDADAD(3),DCBLPDA SET UP IOB FOR CP15 03860000 MVI IOBDADAD+7,X'00' INSERT ZERO INTO R 03880000 MVC IOBDADAD+3(4),DCBLETI PUT DCBLETI CCHH INTO IOB 03900000 OC IOBDADAD+6(1),DCBFIRSH+3 03920000 XC IOBDADAD+6(1),DCBFIRSH+3 INCR TO NEXT CYL 03940000 L R10,DCBWKPT3 HHR ZERO 03960000 ST R10,IOBCCWAD START ADDR CI1 03980000 LA R12,CI1 REL CCW 0 CP8 04000000 ST R12,IOBSTART-1 FLAGS INDICATE CC, NO DC 04020000 MVI IOBFLAG1,X'42' 04040000 LA R12,IOBDADAD+3 INITIALIZE CP15 04060000 STH R12,CI1+2 CI1 POINTS TO IOB CCHHR 04080000 SRL R12,16 04100000 STC R12,CI1+1 04120000 MVC CI5+K2(K5),DCBLETI PUT DCB LETI IN CI5 S20201 04130020 MVC CI5(K2),DCBLPDA+K1 PUT IN BB FOR HEAD SEEK S20201 04140020 B APPM7G4 BRANCH TO EXCP 04160000 APPM7C2 TM C9+7,X'04' ACTIVE ENTRY. 04180000 BO APPM7E2 IF LVL 2 MAST IND JUST SRCHED 04200000 OI C6+4,X'40' CC ON TO CHN FROM LVL 1 TO CYL 04220000 APPM7E2 MVC IOBDADAD,C8+7 SEEK ADDR IN IOB IS FND ADDR 04240000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 04260000 B APPRVXCP EXCP RETURN TO IOS 04280000 EJECT 04300000 * ABNORMAL END CP1, APPENDAGE CODE 7, CHART M7 04320000 APPM7J2 EQU * 19374 04330000 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 04340000 BO APPM7J3 YES--BRANCH 19374 04350000 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 04360000 BC PERRYES,APPN3B3 YES--BRANCH 19374 04370000 B APPRVNOR NO--RETRY CHANNEL PROGRAM 19372 04380000 APPM7J3 LA R13,C10+8 DID CHAN PROG STOP AT C10 04440000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 04460000 BNE APPN3B3 NO - RECORD IS UNREACHABLE 04480000 AIF ('&LIB' EQ 'LIB1').NOTAOS2 04485000 APPAOSJ3 EQU * * 04490000 .NOTAOS2 ANOP 04495000 MVI IOBFLAG1,X'42' RESTORE IOB FLGS & ERR CTR 04500000 MVI IOBFLAG2,X'00' UNRELATED FLAG ON 04520000 MVI IOBCSW,X'00' OTHERS OFF 04540000 XC IOBERRCT,IOBERRCT 04560000 TM C9+7,X'20' 04580000 BO APPM7B3 BRANCH IF DUMMY OR INACTIVE 04600000 LA R12,C10A SET UP IOB TO RESTART S20201 04620020 ST R12,IOBSTART-1 RESET EXCEPTION FLAG 04640000 B APPM7E2 04650013 EJECT 04660000 * CHANNEL END CP2, APPENDAGE CODE 7, CHART M6 04680000 APPM6B2 LA R13,C35+8 DID CHAN PROG STOP AT C35 04700000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 04720000 BNE APPN3B3 NO - RECORD IS UNREACHABLE 04740000 TM C37,X'20' WAS ENTRY DUMMY OR INACTIVE 04760000 BZ APPM6D2 BZ IF NO 04780000 TM C37,X'28' WAS ENTRY DUMMY CHAINED 04800000 BO APPM6D3 BO IF YES 04820000 TM DCBNLEV,X'01' DCBNLEV SHOULD = F, WHICH IS 1 04840000 BZ APPN3B3 BZ IF MYSTERIOUS ERROR 04860000 MVI IOBDADAD+7,X'00' ZERO R SET UP CP 15 04880000 MVC IOBDADAD(3),DCBLPDA PUT DCBLPDA MBB IN IOB 04900000 MVC IOBDADAD+3(4),DCBLETI PUT DCBLETI CCHH INTO IOB 04920000 OC IOBDADAD+6(1),DCBFIRSH+3 04940000 XC IOBDADAD+6(1),DCBFIRSH+3 INCREMENT TO A CYL BOUNDRY 04960000 MVI IOBAPP,CODE14 SET CODE 14 FOR CP15 S20201 04980020 L R10,DCBWKPT3 CP8 POINTER 05000000 LA R12,CI1 START AT CI1 05020000 ST R12,IOBSTART-1 05040000 ST R10,IOBCCWAD REL CCW 0 = CB1 05060000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 05080000 MVC CI5+K2(K5),DCBLETI PUT DCBLETI CCHHR IN CI5 S20201 05090020 MVC CI5(K2),DCBLPDA+K1 MOVE IN BB FOR HEAD SEEK S20201 05100020 IC R9,CI1 SAVE 05120000 LA R12,IOBDADAD+3 05140000 ST R12,CI1 PUT IOB ADDRESS IN CI1 05160000 STC R9,CI1 SAVE 05180000 B APPM7G4 DO AN EXCP S20201 05200020 APPM6D2 MVC IOBDADAD(7),C36 MOVE C36 MBBCCHH TO IOB 05220000 B APPM7C45 SET UP CP8 S20201 05280020 APPM6D3 MVC IOBDADAD,C36 PUT C36 MBBCCHHR IN IOB 05520000 B APPRVXCP EXCP RETURN TO IOS 05540000 EJECT 05560000 * ABNORMAL END CP2, APPENDAGE CODE 7, CHART M6 05580000 APPM6J4 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 05600000 BC PERRYES,APPN3B3 YES B3 05620000 B APPRVNOR NO - NORMAL RETURN TO IOS 05640000 EJECT 05660000 * CHANNEL END CP10AW, APPENDAGE CODE 9, 23, CHART N7 05680000 APPN7B2 LA R13,CB50C+8 DID CHAN PROG STOP AT CB50C 05700000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 05720000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 05740000 APPN7A3 L R12,DCBWKPT2 SET ON SAME MODULE SWITCH 05760000 OI DCWWKNI,X'20' 05780000 IC R9,IOBDADAD+7 ADD 1 TO R IN IOB 05800000 LA R12,1(R0,R9) 05820000 STC R12,IOBDADAD+7 05840000 STC R12,DCBLPDA+7 PUT NEW R IN LPDA 11081 05860015 APPN7B4 CLI DCBHIRSH,X'00' ARE ALL TRACKS UNSHARED 11081 05880015 BE APPN7C4 YES C4 05900000 IC R9,DCBLPDA+6 TRACK SHARED 05920000 IC R12,DCBFIRSH+3 AND H AND MASK TO GET 05940000 NR R9,R12 REAL TRACK NO. 05960000 EX R9,CLIFIRSH EXECUTE THE COMPARE 05980000 BNE APPN7C4 NO C4 06000000 CLC DCBHIRSH,DCBLPDA+7 TRK IS SHARED. IS IT LAST RCD 06020000 BNE APPN7C2 NO C2 06040000 APPN7D3 IC R9,IOBDADAD+6 IS THIS LAST 06060000 IC R12,DCBFIRSH+3 06080000 NR R12,R9 DATA TRACK OF THIS 06100000 EX R12,CLILDT CYLINDER 06120000 BE APPN7D4 YES, GO FIND NEXT CYL 06140000 LA R9,1(0,R9) NO, 06160000 STC R9,IOBDADAD+6 ADD 1 TO TRACK 06180000 MVI IOBDADAD+7,X'00' NO - ZERO OUT R IN IOB 06200000 APPN7G2 TM DCBST,X'02' IS LAST BLOCK FULL 06220000 BZ APPN7C2 NO C2 06240000 OI DCBST,X'01' YES - SET ON LAST TRACK FULL SW 06260000 B APPN7C2 06280000 APPN7D4 SR R12,R12 06300000 IC R12,IOBDADAD FIND CURRENT 06320000 SLL R12,4 EXTENT 06340000 AR R12,R3 06360000 OC IOBDADAD+6(1),DCBFIRSH+3 SET TRACK TO MAX 06380000 CLC IOBDADAD+6(1),DEBENDHH+1-IHADEB(R12) LAST TRACK IN EXT 06400000 BNL APPCCH YES 06420000 IC R9,IOBDADAD+6 ONLY THE 2301 WILL THIS PATH 06440000 LA R9,1(0,R9) TO ADD 1 TO CYLINDER 06460000 STC R9,IOBDADAD+6 06480000 B APPN7G4 06500000 APPCCH CLC IOBDADAD+3(3),DEBENDCC-IHADEB(R12) LAST CYL OF 06520000 BL APPN7E4A EXTENT (CCH) 06540000 IC R9,IOBDADAD 06560000 LA R9,1(0,R9) PUT NEW M IO IOB 06580000 STC R9,IOBDADAD 06600000 LA R12,16(0,R12) ACCESS NEXT EXTENT INTRY IN DEB 06620000 MVC IOBDADAD+1(6),DEBBINUM-IHADEB(R12) MOVE NEW BBCCHH 06640000 L R13,DEBUCBAD-IHADEB(R0,R12) IS NEW CYL ON SAME MODULE 06660000 LA R13,0(R0,R13) 06680000 CLR R13,R7 06700000 BE APPN7G4 YES G4 06720000 L R12,DCBWKPT2 NO - SET OFF SAME MODULE SW 06740000 NI DCWWKNI,X'DF' 06760000 B APPN7G4 06780000 APPN7E4A MVI IOBDADAD+K6,K0 SET TRACK TO ZERO S20201 06781020 CLI DCBDEVT,MERLIN IS CYL A TWO BYTE FIELD S20201 06782020 BNE APPN7E4B NO, BR--BYTE ADDRESSING S20201 06783020 IC R13,IOBDADAD+K3 PICK UP C1 OF CC S20201 06784020 SLL R13,8 SHIFT S20201 06785020 IC R13,IOBDADAD+K4 PICK UP C2 OF CC S20201 06786020 LA R13,K1(R0,R13) ADD ONE TO CYL VALUE S20201 06787020 STC R13,IOBDADAD+K4 RESTORE C2 S20201 06788020 SRL R13,8 SHIFT S20201 06789020 STC R13,IOBDADAD+K3 RESTORE C1 S20201 06791020 B APPN7G4 GO SET TO FIRSH-1'S HR S20201 06793020 APPN7E4B L R13,CVTPTR GET CVT ADDRESS S20201 06795020 IC R9,DCBDEVT PICK UP DEVICE TYPE. 23596 06800018 L R13,CVTZDTAB(0,R13) POINT TO DEVICE TABLE. 23596 06810018 IC R9,0(R9,R13) LOCATE PROPER ENTRY. 23596 06820018 LA R12,2(R9,R13) SET INDEX TO H OF CCH. 23596 06830018 LA R13,IOBDADAD+5 R13=A(H OF CHANGE FIELD). 23596 06840018 ADDONE IC R9,0(0,R13) ADD ONE TO SOME BYTE 23596 06860018 LA R9,1(0,R9) OF CCH. 23596 06870018 STC R9,0(0,R13) 23596 06880018 CLC 0(1,R13),0(R12) IS THE NEW VALUE VALID? 23596 06890018 BL APPN7G4 YES, BRANCH. 23596 06900018 MVI 0(R13),0 NO, ZERO THIS BYTE. 23596 06910018 BCTR R12,0 DECREMENT BOTH INDICES 23596 06920018 BCT R13,ADDONE AND TRY NEXT BYTE. 23596 06930018 APPN7G4 OC IOBDADAD+6(1),DCBFIRSH+1 07000000 IC R9,DCBFIRSH+2 07020000 BCTR R9,0 07040000 STC R9,IOBDADAD+7 07060000 B APPN7G2 07080000 CLILDT CLI DCBLDT+1,0 07100000 CLIFIRSH CLI DCBFIRSH+1,0 07120000 APPN7C4 CLC DCBHIRPD,DCBLPDA+7 TRK IS UNSHARED. IS IT LAST RCD 07140000 BE APPN7D3 YES D3 07160000 APPN7C2 MVC CB55(4),IOBDADAD+3 NO - MOVE IOB CCHH TO CB55 07180000 IC R9,IOBDADAD+7 07200000 LA R12,1(R0,R9) 07220000 STC R12,CB55+4 MOVE IOB (R+1) TO CB55 07240000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 07260000 LA R12,CB52 START AT CB52 07280000 ST R12,IOBSTART-1 07300000 LA R13,IOBDADAD+3 07320000 STH R13,CB52+2 07340000 SRL R13,16 07360000 STC R13,CB52+1 PUT IOB ADDRESS IN CB52 07380000 CLI IOBAPP,CODE9 IS APPENDAGE CODE 9 S20201 07400020 BE APPN7E1 YES E1 07420000 MVI IOBAPP,CODE11 SET APPENDAGE CODE TO 11 S20201 07440020 APPN7F1 L R12,DCBWKPT2 IS SAME MODULE SWITCH ON 07460000 TM DCWWKNI,X'20' 07480000 MVC CB54A+1(3),CB52+1 PUT IOB ADDRESS IN CB54A 07500000 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 07520000 BO APPRVXCP YES EXCP RETURN TO IOS 07540000 MVI IOBASYN,X'01' 07560000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 07580000 APPN7E1 MVI IOBAPP,CODE10 SET APPENDAGE CODE TO 10 S20201 07600020 B APPN7F1 07620000 EJECT 07640000 * ABNORMAL END CP10AW, APPENDAGE CODE 9, 23, CHART J3 07660000 APPJ3B2 EQU * 07670013 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 07680013 BC PERRNO,APPRVNOR NO-NORMAL RETURN TO IOS 07690013 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 07700013 BZ APPM1B3 NO-M1B3 RECORD UNREACHABLE 07710013 LA R13,CB50C+8 DID CHAN PROG STOP AT CB50C 07720000 LA R12,0(R0,R12) CLEAR HIGH ORDER ZERO 07740000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 07760000 BE APPJ3E3 YES- E3 I/O ERROR 07860013 LA R13,CB48+8 DID CHAN PROG STOP AT CB48 08020000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08040000 BE APPJ3E3 YES - UNCORRECTABLE I/O ERROR 08060000 LA R13,CB49+8 DID CHAN PROG STOP AT CB49 08080000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08100000 BE APPJ3E3 YES - UNCORRECTABLE I/O ERROR 08120000 LA R13,CB50+8 DID CHAN PROG STOP AT CB50 08140000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08160000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 08180000 APPJ3E3 OI DECBEXC1,X'08' UNCORRECTABLE I/O ERROR 08200000 B APPM1B4 08220000 EJECT 08240000 * CHANNEL END CP10BW, APPENDAGE CODE 10, 11, CHART N8 08260000 APPN8A2 LA R13,CB54C+8 DID CHAN PROG STOP AT CB54C 08280000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08300000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 08320000 TM CB53+4,X'20' EOF FOR CP14? 13270 08326015 BO APPM426 17332 08333018 L R12,DCBNREC 08340000 LA R12,1(R0,R12) 08360000 ST R12,DCBNREC ADD 1 TO NUMBER OF PRIME RCDS 08380000 CLI IOBAPP,CODE10 IS APPENDAGE CODE 10 S20201 08400020 BE APPM1B4 YES M1B4 08420000 MVI IOBAPP,CODE18 NO, SET APP CODE TO 18 S20201 08440020 OI IOBFLAG1,X'C0' USE DATA AND COMMAND CHAINING 08460000 LA R12,CK1 START AT CK1 08480000 ST R12,IOBSTART-1 08500000 MVC IOBDADAD+3(5),DCBLETI PUT CCHHR OF DCBLETI IN IOB 08520000 MVC IOBDADAD(3),DCBLPDA 08540000 LA R12,IOBDADAD+3 PUT IOB ADDRESS IN CK1 AND CK4 08560000 ST R12,CK1 08580000 MVI CK1,X'31' 08600000 ST R12,CK4 08620000 MVI CK4,X'31' 08640000 ST R12,CK7A PUT IOB ADDR IN CK7A 08646013 MVI CK7A,X'31' 08652013 MVC CK6+1(3),DECBKEY+1 08660000 B APPM7G4 BRANCH = GO CHECK DEB 08680000 EJECT 08700000 * ABNORMAL END CP10BW, APPENDAGE CODE 10, 11, CHART J4 08720000 APPJ4B2 EQU * 08730013 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 08740013 BC PERRNO,APPRVNOR NO-NORMAL RETURN TO IOS 08750013 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 08760013 BZ APPM1B3 NO-M1B3 RECORD UNREACHABLE 08770013 LA R13,CB54C+8 DID CHAN PROG STOP AT CB54C 08780000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 08800000 BE APPJ4E3 YES- E3 I/O ERROR 08900013 LA R13,CB54+8 DID CHAN PROG STOP AT CB54 09060000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 09080000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 09100000 APPJ4E3 OI DECBEXC1,X'08' UNCORRECTABLE I/O ERROR 09120000 B APPM1B4 09140000 EJECT 09160000 * CHANNEL END CP17W, APPENDAGE CODE 17, 18, 19, CHART N9 09180000 APPN9A2 LA R13,CK1 CP START MAY HAVE BEEN A34932 09188020 * CHANGED A34932 09196020 ST R13,IOBSTART-1 FOR RETRY ON ERROR. A34932 09204020 LA R13,CK7C+8 STOP AT CK70 M3299 09212020 CLR R12,R13 BE MEANS YES, BNE MEANS NO 09220000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 09240000 CLI CK9,X'00' TEST F IN CK9 09260000 BE APPN9B3 BE IF NORMAL ENTRY 09280000 CLI CK9,X'08' 09300000 BE APPN9B3 BE IF SHARED 09320000 APPN9B2 EQU * 09340000 L R12,DCBWKPT2 09360000 CLI IOBAPP,CODE17 IS APPENDAGE CODE 17 S20201 09380020 BE APPM1B4 YES M1B4 09400000 CLI IOBAPP,CODE18 IS APPENDAGE CODE 18 S20201 09420020 BE APPN9C2 YES C2 09440000 CLC DCWNLEVC,DCBNLEV MUST BE 19 09460000 BE APPN9F1 BE IF LAST TIME THROUGH LOOP 09480000 IC R13,DCWNLEVC NOT LAST TIME. ADD TO LOOP CNTR 09500000 LA R13,1(R0,R13) 09520000 STC R13,DCWNLEVC 09540000 CLI DCWNLEVC,X'02' DOES NLEV COUNTER = 2 09560000 BE APPN9E3 YES E3 09580000 CLI DCWNLEVC,X'03' DOES NLEV COUNTER = 3 09600000 BE APPN9F3 YES F3 09620000 MVC IOBDADAD+3(5),DCBLEMI3 PUT LEMI3 CCHHR IN IOB 09640000 CLI DCBFTMI3+1,X'00' 09660000 BE *+14 09680000 MVC IOBDADAD(1),DCBFTMI3+1 09700000 B APPN9C5 09720000 MVC IOBDADAD(1),DCBFTMI3 09740000 B APPN9C5 09760000 APPN9E3 MVC IOBDADAD+3(5),DCBLEMI1 PUT LEMI1 CCHHR IN IOB 09780000 CLI DCBFTMI1+1,X'00' 09800000 BE *+14 09820000 MVC IOBDADAD(1),DCBFTMI1+1 09840000 B APPN9C5 09860000 MVC IOBDADAD(1),DCBFTMI1 09880000 B APPN9C5 09900000 APPN9F3 MVC IOBDADAD+3(5),DCBLEMI2 PUT LEMI2 CCHHR IN IOB 09920000 CLI DCBFTMI2+1,X'00' 09940000 BE *+14 09960000 MVC IOBDADAD(1),DCBFTMI2+1 09980000 B *+10 10000000 MVC IOBDADAD(1),DCBFTMI2 10020000 XC IOBDADAD+1(2),IOBDADAD+1 10040000 B APPN9C5 10060000 APPN9B3 CLI CB26,X'10' TEST F IN CB26 10080000 BNE APPN9B2 BNE IF NOT OVERFLOW END 10100000 MVC IOBDADAD+3(5),CB24 RE-EXECUTE WITH OFLO ENTRY 10120000 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 10140000 B APPRVXCP EXCP RETURN TO IOS 10160000 APPN9F1 TM DCWHIAV,X'40' IS HIGHEST INDEX IN CORE 10180000 BZ APPN9H1 NO H1 10200000 L R12,DCWMSHIL YES - CHANGE ITS LAST KEY 10220000 L R11,DECBKEY 10240000 IC R9,DCBKEYLE 10260000 LA R13,0(R0,R9) 10280000 BCTR R13,R0 10300000 EX R13,APPN9G1A 10320000 APPN9H1 MVI IOBASYN,X'08' 10340000 B APPM1B5 SCHEDULE COMPLETION 10360000 APPN9C2 CLI DCBNLEV,X'00' IS THERE ONLY A TRACK INDEX 10380000 BE APPM1B4 YES M1B4 10400000 L R12,DCBWKPT2 10420000 MVI DCWNLEVC,X'01' INITIALIZE COUNTER TO 1 10440000 MVC IOBDADAD+3(5),DCBLECI PUT DCBLECI CCHHR IN IOB 10460000 CLI DCBFTCI+1,X'00' 10480000 BE *+14 10500000 MVC IOBDADAD(1),DCBFTCI+1 10520000 B APPMVI 10540000 MVC IOBDADAD(1),DCBFTCI 10560000 APPMVI MVI IOBAPP,CODE19 SET APPENDAGE CODE TO 19 S20201 10580020 OI IOBFLAG1,X'C0' USE DATA AND COMMAND CHAINING 10600000 LA R12,CK1 START AT CK1 10620000 ST R12,IOBSTART-1 10640000 APPN9C5 MVI IOBASYN,X'01' 10660000 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 10680000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 10700000 EJECT 10720000 * ABNORMAL END CP17W, APPENDAGE CODE 17, 18, 19, CHART J7 10740000 APPJ7B2 EQU * 10750013 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 10760013 BC PERRYES,APPJ7B7 A34932 10763020 * THIS IS A FIRST ENTRY ON AN ERROR. 10766020 LA R11,CK4 TEST FOR STOP PRIOR TO A34932 10769020 * CK4 A34932 10772020 CLR R12,R11 DID IT STOP BEFORE CK4? A34932 10775020 BNH APPRVNOR BIF YES. RETRY FROM CK1. A34932 10778020 ST R11,IOBSTART-1 RETRY FROM CK4 A34932 10781020 B APPRVNOR RETURN TO IOS. A34932 10784020 APPJ7B7 TM IOBSENSE,X'08' UNCORRECTABLE I/O ERROR A34932 10787020 BZ APPM1B3 NO-M1B3 RECORD UNREACHABLE 10790013 LA R13,CK7C+8 DID CHAN PROG STOP AT CK7C 10800000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 10820000 BNE APPM1B3 NO-RECORD UNREACHABLE 10920013 APPJ7E3 OI DECBEXC1,X'08' UNCORRECTABLE I/O ERROR 11020000 B APPM1B4 11040000 EJECT 11060000 APPN9G1A MVC 0(0,R12),0(R11) 11080000 EJECT 11100000 * COMMON ROUTINE TO SCHEDULE ASYNCHRONOUS ROUTINE 11120000 APPM1B3 OI DECBEXC1,X'04' RECORD IS UNREACHABLE 11140000 APPM1B4 MVI IOBASYN,X'08' SCHEDULE PROCESSING COMPLETION 11160000 APPM1B5 LA R14,BYP(R14) SCHEDULE ASYNCH ROUTINE 15924 11180016 L R13,CVTPTR 11200000 L R13,CVTEXEF 11220000 BR R13 11240000 EJECT 11260000 * CHANNEL END CP16, APPENDAGE CODE 15, CHART M2 11280000 APPM2B2 LA R13,CJ10+8 DID CHAN PROG STOP AT CJ10 11300000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 11320000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 11340000 L R12,DCBMSWA WAS OFLO END ENTRY READ IN 11360000 TM 8(R12),X'08' 11380000 BZ APPM2D3 YES D3 11400000 MVC IOBDADAD,0(R12) NO - SET SEEK ADDRESS FROM LINK 11420000 B APPM7G4 GO CHECK DEB 11440000 APPM2D3 MVC CJ11,IOBDADAD PUT IOB MBBCCHHR IN CJ11 11460000 MVI IOBASYN,X'0B' SET ASYNCHRONOUS CODE TO 11 11480000 NI IOBINDCT,X'DF' INDICATE OFLO RCD IN AREA 11500000 B APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 11520000 EJECT 11540000 * ABNORMAL END CP16, APPENDAGE CODE 15, 16, CHART M2 11560000 APPM2H2 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 11580000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 11600000 B APPM1B3 YES M1B3 11620000 EJECT 11640000 * CHANNEL END CP16, APPENDAGE CODE 16, CHART M3 11660000 APPM3B2 LA R13,CJ10+8 DID CHAN PROG STOP AT CJ10 11680000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 11700000 BNE APPM3B3 NO - TRY CJ9 S20201 11710020 MVC CJ11,IOBDADAD PUT IOB MBBCCHHR IN CJ11 11740000 L R12,DCBMSWA SET SEEK ADDRESS FROM LINK 11760000 MVC IOBDADAD,0(R12) 11780000 L R12,DCBWKPT2 SET OFF FIRST TIME ONLY SW 11800000 NI DCWWKNI,X'BF' 11820000 B APPM7G4 11840000 APPM3B3 LA R13,CJ9+L'CJ9 STOP AT CJ9 11850020 CLR R12,R13 S20201 11860020 BNE APPM3B4 NO - TRY CJ8 S20201 11870020 MVC CJ11,IOBDADAD SAVE IOB MBBCCHHR IN CJ11 11920000 TM DCBOPTCD,X'02' IS DELETE OPTION TAKEN 11940000 BZ APPM3C4 NO C4 11960000 L R12,DCBMSWA IS RCD MARKED FOR DELETION 11980000 LA R13,10(R0,R12) 12000000 CLI 0(R13),X'FF' 12020000 BNE APPM3C4 NO C4 12040000 MVI IOBASYN,X'0E' SET ASYNCHRONOUS CODE TO 14 12060000 APPM3E4 NI IOBINDCT,X'DF' INDICATE OFLO RCD IN AREA 12080000 B APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 12100000 APPM3C4 OI DECBEXC1,X'01' INDICATE DUPLICATE RECORD 12120000 MVI IOBASYN,X'08' SCHEDULE PROCESSING COMPLETION 12140000 B APPM1B5 12160000 APPM3B4 LA R13,CJ8+L'CJ8 SEE IF STOPPED AT CJ8 12170020 CLR R12,R13 S20201 12180020 BNE APPM1B3 IF NOT, UNREACHABLE BLK S20201 12190020 L R12,DCBWKPT2 IS FIRST TIME ONLY SWITCH ON 12240000 TM DCWWKNI,X'40' 12260000 BO APPM3B5 YES B5 12280000 MVI IOBASYN,X'0C' SET ASYNCHRONOUS CODE TO 12 12300000 B APPM3E4 12320000 APPM3B5 MVI IOBASYN,X'0D' SET ASYNCHRONOUS CODE TO 13 12340000 MVC IOBDADAD(7),CJ11 RESTORE TRK INDEX MBBCCHH 12360000 B APPM3E4 12380000 EJECT 12400000 * CHANNEL END CP14W, APPENDAGE CODE 12, CHART M4 12420000 APPM4A2 LA R13,CH18C+8 DID CHAN PROG STOP AT CH18C 12440000 APPM4A21 EQU * 13270 12442015 TM CB53+4,X'20' EOF WRITTEN 13270 12444015 BZ APPM4A22 BRANCH IF NO 13270 12446015 MVC IOBDADAD,DCBLIOV INITIALIZE IOBDADAD SEEK 13270 12448015 MVC DCBLIOV(3),CH23 RESET LIOV FROM 13270 12450015 MVC DCBLIOV+3(5),CH24 CP14 13270 12452015 CLR R12,R13 13270 12454015 BNE APPM1B3 B = UNREACHABLE 13270 12456015 MVI IOBFLAG1,X'42' CC SET ON 13270 12458015 MVI IOBAPP,CODE10 SET APPENDAGE CODE 10 S20201 12460020 LA R12,CB52 13270 12462015 ST R12,IOBSTART-1 13270 12464015 LA R13,IOBDADAD+3 13270 12466015 STH R13,CB52+2 13270 12468015 SRL R13,16 13270 12470015 STC R13,CB52+1 13270 12472015 MVC CB54A+1(3),CB52+1 WRITE CHECK SEARCH 13270 12474015 SR R13,R13 16384 12474316 IC R13,IOBDADAD GET M 16384 12474616 SLL R13,4 TIMES 16 16384 12474916 LA R13,32(R3,R13) ALLOW FOR BASIC DEB TOO 16384 12475216 L R12,0(0,R13) GET UCB POINTER 16384 12475516 LA R12,0(0,R12) ZERO HIGH ORDER BYTE 16384 12475816 CR R7,R12 SAME UNIT 16384 12476116 BE APPRVXCP YES--EXCP RETURN 16384 12476416 MVI IOBASYN,X'01' NO--SET ASYNCH CODE = 1 16384 12476716 B APPM1B5 SCHEDULE ASYNCHRONOUS RTN 16384 12477016 APPM426 CLI CK9+7,12 INSERT TO MIDDLE OVFL CH 17332 12478518 MVI CB53+4,X'00' RESET EOF FLAG 17332 12479018 BE APPM1B4 IF YES POST COMPLETION 17332 12479518 APPM4A22 EQU * M3216 12479718 MVI CB53+4,X'00' RESET EOF SWITCH 13270 12480015 CLR R12,R13 13270 12482015 BNE APPM1B3 B = UNREACHABLE 13270 12484015 TM CH8E+4,X'40' TEST FOR UWA 17332 12485018 BZ APPM425 IF NO-BRANCH 17332 12486018 NI CH8E+4,X'42' RESET FLAG 17332 12487018 CLI CK9+7,14 ASYN CODE=14 17332 12488018 BE APPM1B4 IF YES-POST COMPLETION 17332 12489018 CLI CK9+7,9 ASYN CODE=9 17332 12490018 BE APPM4A23 IF YES BRANCH 17332 12491018 MVI IOBAPP,X'04' SET UP CP14 PART2 17332 12492018 MVC IOBSTART,CH21+4 TO UPDATE TRACK 17332 12493018 MVC IOBDADAD,CH14 RESTORE IOBSEEK 17332 12494018 MVI CH14,X'03' SET NOP IN CH14 17332 12495018 MVI CH14+4,X'20' 17332 12496018 MVI CH14+7,X'01' 17332 12497018 B APPN9C5 17332 12498018 APPM4A23 MVI IOBCOUNT,X'01' ERROR COUNT=1 17332 12499018 MVC IOBDADAD(3),CB10+7 IOBSEEK ADDR 17332 12500018 MVC IOBDADAD+3(5),CB23+3 17332 12501018 IC R12,IOBDADAD+7 REDUCE R BY 1 17332 12502018 BCTR R12,R0 17332 12503018 STC R12,IOBDADAD+7 17332 12504018 TM DCBRECFM,X'10' TEST FOR BLOCKED 17332 12505018 BO APPM424 IF YES-BRANCH 17332 12506018 L R12,CH6+4 RESTORE 10 BYTES 17332 12507018 L R13,DECBAREA USED FOR LINK FIELD IN 17332 12508018 MVC 0(10,R12),0(R13) OVFL RECORD 17332 12509018 APPM424 MVC IOBSTART,CD2+5 START OF CP12B 17332 12510018 MVI IOBAPP,X'15' APP CODE 15 17332 12511018 OI IOBFLAG1,X'C0' 17332 12512018 B APPN9C5 17332 12513018 APPM425 L R12,DCBWKPT2 17332 12514018 TM DCWWKNI,X'10' IS ADD-TO-END INDICATOR ON 12520000 BZ APPM1B4 NO - SCHEDULE COMPLETION 12540000 APPM4C2 MVC CK6+1(3),DECBKEY+1 PUT I ADDR IN CK6 12560000 LA R12,IOBDADAD+3 12580000 STH R12,CK1+2 12600000 SRL R12,16 12620000 STC R12,CK1+1 IOB ADDRESS TO CK1 AND CK4 12640000 MVC CK4+1(3),CK1+1 12660000 MVC CK7A+1(3),CK1+1 IOB ADDRESS TO CK7A 12680000 B APPN9C2 CP17/CP17W APPENDAGE 12700000 EJECT , 17332 12700818 * NORMAL END APPENDAGE CODE 4 12701618 * UPDATE TRACK INDICES WITH 2ND PART CP14 12702418 * 12703218 * 12704018 APPAFB LA R13,CH14+8 DID CP END AT CH14 17332 12704818 CLR R12,R13 17332 12705618 BNE APPN3B3 NO-RECORD IS UNREACHABLE 17332 12706418 MVC IOBASYN,CK9+7 17332 12707218 CLI IOBASYN,10 ADD TO END 17332 12708018 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 12708818 CLI IOBASYN,11 ADD TO END 17332 12709618 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 12710418 B APPM1B4 POST COMPLETION 17332 12711218 EJECT , 17332 12712018 * 12712818 * ABNORMAL END APPENDAGE CODE 4 12713618 * UPDATE TRACK INDICES 12714418 * 12715218 APPAEB TM IOBECBAD,PERRMASK PERM ERROR 17332 12716018 BC PERRNO,APPRVNOR IF NO-NORMAL RET TO IOS 17332 12716818 B APPM1B3 POST UNREACHABLE BLOCK 17332 12717618 EJECT 12720000 * ABNORMAL END CP14W, APPENDAGE CODE 12, CHART J5 12740000 APPJ5B2 EQU * 19374 12750000 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 12770016 BO APPJ5I2 YES, BRANCH 15924 12780016 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 12790000 BC PERRNO,APPRVNOR NO--RETRY CHAN PGM 19374 12800000 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 12810013 BZ APPM1B3 NO-M1B3 RECORD UNREACHABLE 12820013 LA R13,CH3C+8 DID CHAN PROG STOP AT CH3C 12840000 CLR R12,R13 12860000 BE APPJ5D2 YES D2 12880000 LA R13,CH8C+8 DID CHAN PROG STOP AT CH8C 12900000 CLR R12,R13 12920000 BE APPJ5D2 YES D2 12940000 LA R13,CH13C+8 DID CHAN PROG STOP AT CH13C 12960000 CLR R12,R13 12980000 BE APPJ5D2 YES D2 13000000 LA R13,CH18C+8 DID CHAN PROG STOP AT CH18C 13020000 CLR R12,R13 13040000 BE APPJ5D2 YES- D2 I/O ERROR 13140013 LA R13,CH16+8 DID CHAN PROG STOP AT CH16 13300000 CLR R12,R13 13320000 BE APPJ5E3 YES E3 13340000 LA R13,CH17+8 DID CHAN PROG STOP AT CH17 13360000 CLR R12,R13 13380000 BE APPJ5E3 YES E3 13400000 LA R13,CH18+8 DID CHAN PROG STOP AT CH18 13420000 CLR R12,R13 13440000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 13460000 APPJ5D2 EQU * 13470013 APPJ5E3 OI DECBEXC1,X'08' UNCORRECTABLE I/O ERROR 13480000 B APPM1B4 SCHEDULE PROCESSING COMPLETION 13500000 APPJ5I2 LA R13,CH14+8 DID CHAN PROG STOP AT CH14 13520000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 13540000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 13560000 MVC IOBDADAD,CH23 MOVE CH23 MBBCCHHR TO IOB 13580000 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH15 13600000 MVI IOBASYN,X'01' 13620000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 13640000 EJECT 13660000 * CHANNEL END CP14W, APPENDAGE CODE 13, CHART M5 13680000 APPM5A2 LA R13,CH22C+8 DID CHAN PROG STOP AT CH22C 13700000 B APPM4A21 13720000 EJECT 13740000 * ABNORMAL END CP14W, APPENDAGE CODE 13, CHART J6 13760000 APPJ6B2 EQU * 19374 13770000 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 13790016 BO APPJ6I2 YES, BRANCH 15924 13800016 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 13810000 BC PERRNO,APPRVNOR NO--RETRY CHAN PGM 19374 13820000 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 13830013 BZ APPM1B3 NO-M1B3 RECORD UNREACHABLE 13840013 LA R13,CH3C+8 DID CHAN PROG STOP AT CH3C 13860000 CLR R12,R13 13880000 BE APPJ6D2 YES D2 13900000 LA R13,CH8C+8 DID CHAN PROG STOP AT CH8C 13920000 CLR R12,R13 13940000 BE APPJ6D2 YES D2 13960000 LA R13,CH13C+8 DID CHAN PROG STOP AT CH13C 13980000 CLR R12,R13 14000000 BE APPJ6D2 YES D2 14020000 LA R13,CH18C+8 DID CHAN PROG STOP AT CH18C 14040000 CLR R12,R13 14060000 BE APPJ6D2 YES D2 14080000 LA R13,CH22C+8 DID CHAN PROG STOP AT CH22C 14100000 CLR R12,R13 14120000 BE APPJ6D2 YES- E3 I/O ERROR 14220013 LA R13,CH16+8 DID CHAN PROG STOP AT CH16 14380000 CLR R12,R13 14400000 BE APPJ6E3 YES E3 14420000 LA R13,CH17+8 DID CHAN PROG STOP AT CH17 14440000 CLR R12,R13 14460000 BE APPJ6E3 YES E3 14480000 LA R13,CH18+8 DID CHAN PROG STOP AT CH18 14500000 CLR R12,R13 14520000 BE APPJ6E3 YES E3 14540000 LA R13,CH22+8 DID CHAN PROG STOP AT CH22 14560000 CLR R12,R13 14580000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 14600000 APPJ6D2 EQU * 14610013 APPJ6E3 OI DECBEXC1,X'08' UNCORRECTABLE I/O ERROR 14620000 B APPM1B4 SCHEDULE PROCESSING COMPLETION 14640000 APPJ6I2 LA R13,CH19+8 DID CHAN PROG STOP AT CH19 14660000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 14680000 BNE APPJ5I2 NO - BUT TRY AT CH14 14700000 MVC IOBDADAD,CJ11 MOVE CJ11 MBBCCHHR TO IOB 14720000 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH20 14740000 MVI IOBASYN,X'01' 14760000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 14780000 APPRVXCP SR R12,R12 14800000 IC R12,IOBDADAD GET BB 14820000 SLL R12,4 14840000 LA R12,32(R12,R3) 14860000 MVC IOBDADAD+1(2),4(R12) 14880000 LA R14,EXCP(R14) SETUP EXCP IOS RETURN 15924 14885016 XC IOBFLAG2(3),IOBFLAG2 CLEAR FLAG2,SENSE BYTES 15924 14890016 XC IOBCSW(9),IOBCSW CLEAR FLAG3,CSW,AND SIOCC 15924 14895016 XC IOBERRCT(2),IOBERRCT CLEAR ERROR COUNT 15924 14900016 NI IOBFLAG1,X'C2' RESET FLAG1 15924 14905016 APPRVNOR BR R14 RETURN TO IOS 15924 14910016 APPN3B3 EQU APPM1B3 LABELS USED IN COMMON ROUTINE TO 14920000 APPN3B5 EQU APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 14940000 * ADDRESS OF COMMUNICATION VECTOR TABLE 14960000 CVTPTR EQU 16 14980000 CODE8 EQU 8 CHAN PGM 8 APP CODE S20201 14981020 CODE9 EQU 9 CHAN PGM 10A APP CODE S20201 14982020 CODE10 EQU 10 CHAN PGM 10B APP CODE S20201 14983020 CODE11 EQU 11 CHAN PGM 10B APP CODE S20201 14984020 CODE14 EQU 14 CHAN PGM 15 APP CODE S20201 14985020 CODE17 EQU 17 CHAN PGM 17 APP CODE S20201 14986020 CODE18 EQU 18 CHAN PGM 17 APP CODE S20201 14987020 CODE19 EQU 19 CHAN PGM 17 APP CODE S20201 14988020 CVTZDTAB EQU X'40' CVT'S DEV CHAR TABLE PTR 23596 14990018 MERLIN EQU X'09' DEVICE CODE S20201 14995020 * RETURN TO IOS VECTOR TABLE 15000000 CVT DSECT 15120000 DS F COMMUNICATION VECTOR TABLE EXIT EFFECTOR 15140000 CVTEXEF DS F USED WITH REG 13 TO SCHED ASYNC ROUTINES 15160000 EJECT 15180000 * WRITE KEY NEW CHANNEL PROGRAM REFERENCES (WRITE CHECK) 15580020 IHAWKNCP IGGWKNCP OPTCD=W S20201 15980020 IGGCP12C OPTCD=W S20201 16380020 IGGCP12A 16680020 EJECT 18100000 * DATA EVENT CONTROL BLOCK 18120000 IHADECB DSECT 18140000 DS 0F 18160000 DECBECB DS CL4 EVENT CONTROL BLOCK (ECB) 18180000 DECBTYP1 DS BL1 TYPE B6 - 1 IF LENGTH IS S 18200000 * B7 - 1 IF AREA IS S 18220000 DECBTYP2 DS BL1 B0 - 1 IF READ K 18240000 * B1 - 1 IF READ KX 18260000 * B2 - 1 IF READ KU 18280000 * B4 - 1 IF WRITE K 18300000 * B5 - 1 IF WRITE KN 18320000 DECBLGTH DS CL2 LENGTH OF BLOCK 18340000 DECBDCBA DS A POINTER TO DCB 18360000 DECBAREA DS A ADDRESS OF AREA 18380000 DECBLOGR DS A POINTER TO LOGICAL RECORD 18400000 DECBKEY DS A POINTER TO KEY 18420000 DECBEXC1 DS BL1 EXCPTN CD B0-RECORD NOT FOUND 18440000 * B1-RECORD LGTH CHK 18460000 * B2-NO SPACE 18480000 * B3-INVALID REQUEST 18500000 * B4-UNCORRECTABLE IO 18520000 * B5-UNREACHABLE BLOCK 18540000 * B6-OVERFLOW RECORD 18560000 * B7-DUPLICATE 18580000 DECBEXC2 DS BL1 B7-READ KU 18600000 EJECT 18620000 DCBD DSORG=(IS) 18640000 EJECT 18660000 IHAIOB IGGIOBD 18860020 CPSTART EQU IOBSTART-1 START OF CHANNEL PROGRAM S20201 19060020 EJECT 19980000 IHADCW IGGBISAM 20080020 IHADEB IGGDEBD 20380020 EJECT 21300000 END 21320000 ./ ADD SSI=08010235,NAME=IGG019GN,SOURCE=0 TITLE 'IGG019GN - APPENDAGES-PART 2,COMBINED,NO WRT CHK' 00020000 COPY LCGASMSW 00030001 IGG019GN CSECT 00040000 * RELEASE 14 DELETIONS * 00042000 * RELEASE 15 DELETIONS * 00044000 *1053 13270 00044515 *1053 11081 00045015 * RELEASE 16 DELETIONS * 00046000 *0183171800 16072 00047016 *0183015400,120200-120800,126400-127000,156000,157400-157600, 15924 00047216 *0183180600-180800,184600-184800,194200,219600-220400 15924 00047416 *0183117540 16384 00047616 * RELEASE 17 DELETIONS * 00048000 *1695000680,174800,175000 P4700 00048600 *1695 17516 00049200 *1695043600-044200,120100-120200,120500-120600,126300-126400, 19374 00049400 * 126700-126800,157300-157600,180500-180800 19374 00049600 *1695041600 7S004 00049800 * RELEASE 18 DELETIONS * 00050000 *0233148200,149600 25000 00050518 *0233069000-070800 23596 00051018 *0233081520,117580,117800 17332 00051518 * RELEASE 19 DELETIONS * 00052000 *2180150800 A29939 00053019 * RELEASE 20 DELETIONS * 00054000 *0568087600,103200-103400 A34932 00054520 *0568182400-183000 A34619 00055020 *0568014200,031400,032400,032600,032800,033000,038600,041600, S20201 00055120 *0568046400,050800,052000,053000,053400-053800,054000-056000, S20201 00055220 *0568068900,069500,075000,075400,076600,082200,082600,089400, S20201 00055320 *0568089800,101400,105800,109600,110000,111400,111600-111800, S20201 00055420 *0568114600,114800-115000,117400,130600,151800,152000-152800, S20201 00055520 *0568153000-155600,160400,164200,170300,172600,176800,177000, S20201 00055620 *0568200600-202400,202600-206400,206600-210400,210600-219400, S20201 00055720 *0568221200-224000,224200-228000,228200-233000,233200-237000, S20201 00055820 *0568237200-241000,241200-243000,243200-255200 S20201 00055920 * RELEASE 21 DELETIONS * 00056000 *D151900 SA65011 00056103 *C176820 SA65011 00056403 * RELEASE 22 DELETIONS * 00058000 AIF ('&LIB' EQ 'LIB1').LIB2GN0 00060003 * VS1 RELEASE 3 DELETIONS 00062003 * XL03145 00066003 * VS APARS OX02338 AND OY02194 ARE FLAGGED AS SA65011. 00066103 .LIB2GN0 ANOP 00066403 *STATUS CHANGE LEVEL 008 00068020 * FUNCTION/OPERATION' APPENDAGE ROUTINES FOR BISAM WHEN READ AND UPDATE 00080000 * IS USED WITH WRITE KN, WHEN WRITE VALIDITY CHECKING IS 00100000 * NOT REQUESTED. 00120000 * (PART 2) 00140000 * CEND - IF CHANNEL PROGRAM ENDS 00160000 * **WITHOUT ERROR, EITHER 00180000 * PROCESSING COMPLETION WILL BE SCHEDULED, 00200000 * PROCESSING CONTINUATION WILL BE SCHEDULED, 00220000 * OR PROCESSING WILL CONTINUE. 00240000 * **WITH A LENGTH CHECK, TESTS DETERMINE WHETHER 00260000 * OR NOT TO TREAT THE SITUATION AS A REAL 00280000 * ERROR. 00300000 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 00320000 * BLOCK' IS INDICATED IN THE DECB, AND 00340000 * PROCESSING COMPLETION WILL BE SCHEDULED. 00360000 * 00380000 * ABEND - IF CHANNEL PROGRAM ENDS ABNORMALLY BECAUSE OF 00400000 * **PERMANENT ERROR, 'UNCORRECTABLE I/O ERROR' 00420000 * IS INDICATED IN THE DECB, AND PROCESSING 00440000 * COMPLETION WILL BE SCHEDULED. 00460000 * **NON-PERMANENT ERROR, ONE RE-TRY IS MADE 00480000 * **FILE PROTECTION, TESTS DETERMINE WHETHER 00500000 * OR NOT TO TREAT THE SITUATION AS A REAL 00520000 * ERROR. 00540000 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 00560000 * BLOCK' IS INDICATED IN THE DECB, AND 00580000 * PROCESSING COMPLETION WILL BE SCHEDULED. 00600000 * 00620000 * ENTRY POINTS- 00640000 * ANY POINT IN THE VECTOR TABLE AT THE BEGINNING OF THE MODULE. 00660000 * INPUT - N/A 00680000 * OUTPUT - N/A 00700000 * EXTERNAL ROUTINES - N/A 00720000 * EXITS 1. RETURN TO IOS VIA THE APPENDAGE RETURN VECTOR TABLE POINTED 00740000 * TO BY REGISTER 14. SEE THE DSECT LABELED IHAAPPRV FOR THE 00760000 * FORMAT OF THIS TABLE AND THE USE OF EACH EXIT. 00780000 * 2. SCHEDULE AN ASYNCHRONOUS ROUTINE - BRANCH VIA THE EXIT 00800000 * EFFECTOR ADDRESS IN THE COMMUNICATION VECTOR TABLE. 00820000 * TABLES/WORK AREAS ' DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB, 00840000 * COMMUNICATION VECTOR TABLE. 00860000 * SEE DSECTS AT END OF MODULE FOR FORMAT AND DESCRIPTIONS. 00880000 * ATTRIBUTES' REENTRANT. DISABLED. 00900000 * NOTES - NONE 00920000 * GENERAL REGISTERS ARE USED AS FOLLOWS BY THE CEND AND ABEND ROUTINES 00940000 R0 EQU 0 * ----- 00960000 R1 EQU 1 * 12* ADDRESS 00980000 R2 EQU 2 * IOB 01000000 R3 EQU 3 * DEB 01020000 R4 EQU 4 * DCB 01040000 R5 EQU 5 * ----- 01060000 R6 EQU 6 * ----- 01080000 R7 EQU 7 * UCB 01100000 R8 EQU 8 * ----- 01120000 R9 EQU 9 # WORK REGISTER 01140000 R10 EQU 10 CHANNEL PROGRAM 01160000 R11 EQU 11 DECB 01180000 R12 EQU 12 WORK REGISTER 01200000 R13 EQU 13 WORK REGISTER 01220000 R14 EQU 14 IOS RETURN VECTOR TABLE 01240000 R15 EQU 15 BASE REGISTER 01260000 * * MEANS THIS REGISTER IS SET UP UPON ENTRY AND MAY NOT BE 01280000 * DESTROYED BECAUSE OF THE NEEDS OF IOS 01300000 * # MEANS THIS REGISTER MAY BE CHANGED, BUT UPON RETURN MUST 01320000 * BE IN THE FORM 000X BECAUSE OF THE NEEDS OF IOS 01340000 PERRMASK EQU X'20' TO TEST FOR PERMANENT ERROR, TEST 01360000 PERRYES EQU 8 IOBECBAD, B2. IF OFF (CONDITION CODE 8) 01380000 PERRNO EQU 7 THERE IS A PERM ERR. ELSE B2 ON ( CD 7) 01400000 BYP EQU 12 RETURN TO IOS/BYPASS 15924 01405016 EXCP EQU 8 RETURN TO IOS/EXCP 15924 01410016 NORMAL EQU 0 RETURN TO IOS/NORMAL 15924 01415016 K0 EQU 0 MISC OFFSETS S20201 01415820 K1 EQU 1 * S20201 01416620 K2 EQU 2 * S20201 01417420 K3 EQU 3 * S20201 01418220 K4 EQU 4 * S20201 01419020 K5 EQU 5 * S20201 01421020 K6 EQU 6 * S20201 01423020 K7 EQU 7 * S20201 01425020 K10 EQU 10 * S20201 01427020 NOT EQU 255 MASK OF ALL BITS ON S20201 01429020 OFLORCD EQU 2 S20201 01431020 BLOCKED EQU X'10' S20201 01433020 MIS EQU PERRMASK MASTER IDX SRCH MASK 01433401 CCOFF EQU X'BF' TURN OFF CC MASK 01433801 READKU EQU X'20' READ KEY FOR UPDATE SA65011 01434203 USING IHAIOB,R2 S20201 01435020 USING IHADEB,R3 01440000 USING IHADCB,R4 01460000 USING IHAWKNCP,R10 01480000 USING IHADECB,R11 01500000 USING IHADCW,R12 01520000 USING IGG019GN,R15 01560000 USING IHACVTEX,R13 CVT 01580000 * VECTOR TABLE. BRANCH TO THE ROUTINE SELECTED IN THE 01600000 * APPENDAGE ROUTINE, PART 1. 01620000 * ROUTINE FOR CODE CEND COMPLETION OF 01640000 LR R15,R13 01660000 B APPM67CE 7 CP1 OR CP2 FOR WRITE KN 01680000 LR R15,R13 01700000 B APPN7B2 9,23 CP10A 01720000 LR R15,R13 01740000 B APPN8A2 10,11 CP10B 01760000 LR R15,R13 01780000 B APPM4A2 12 CP14 - SETUPS 1, 2, OR 5 01800000 LR R15,R13 01820000 B APPM5A2 13 CP14 - SETUPS 3, 4, OR 6 01840000 LR R15,R13 01860000 B APPM2B2 15 CP16 - SITUATION 2 01880000 LR R15,R13 01900000 B APPM3B2 16 CP16 - SITUATION 3 01920000 LR R15,R13 01940000 B APPN9A2 17,18,19 CP17 01960000 LR R15,R13 17332 01966018 B APPAFB CP14 PART2 17332 01972018 * ROUTINE FOR CODE ABEND COMPLETION OF 01980000 LR R15,R13 02000000 B APPM67AE 7 CP1 OR CP2, WRITE KN 02020000 LR R15,R13 02040000 B APPN7J2 9,23 CP10A 02060000 LR R15,R13 02080000 B APPN8G2 10,11 CP10B 02100000 LR R15,R13 02120000 B APPM4E2 12 CP14 - SETUPS 1, 2, OR 5 02140000 LR R15,R13 02160000 B APPM5E2 13 CP14 -SETUPS 3, 4, OR 6 02180000 LR R15,R13 02200000 B APPM2H2 15,16 CP16 02220000 LR R15,R13 02240000 B APPN9G4 17,18,19 CP17 02260000 LR R15,R13 17332 02266018 B APPAEB CP14 PART2 17332 02272018 B APPN7A3 CONTINUE ROUTINES BEGUN IN 02280000 B APPN7B4 PART 1 02300000 * ROUTINE FOR CODE CEND COMPLETION OF 02320000 LR R15,R13 02340000 B APPABA2 0,1 CP4/CP5 02360000 LR R15,R13 02380000 B APPADB2 2 CP7 02400000 LR R15,R13 02420000 B APPAAB2 3 CP1 OR CP2, READ AND UPDATE 02440000 LR R15,R13 02460000 B APPACA2 5 CP6 02480000 * ROUTINE FOR CODE ABEND COMPLETION OF 02500000 LR R15,R13 02520000 B APPABD2 0,1 CP4/CP5 02540000 LR R15,R13 02560000 B APPADE2 2 CP7 02580000 LR R15,R13 02600000 B APPAAA2 3 CP1 OR CP2, READ AND UPDATE 02620000 LR R15,R13 02640000 B APPACE2 5 CP6 02660000 * BRANCH TO M6 OR M7 02680000 APPM67CE L R13,DCBWKPT2 CHAN END OF CP1 OR CP2 02700000 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 02720000 BE APPM6B2 CYLINDER - M6 (CP2) 02740000 B APPM7A2 MASTER - M7 (CP1) 02760000 APPM67AE L R13,DCBWKPT2 ABNORMAL END OF CP1 OR CP2 02780000 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 02800000 BE APPM6J4 CYLINDER - M6 (CP2) 02820000 B APPM7J2 MASTER - M7 (CP1) 02840000 EJECT 02860000 * CHART M7 CP1 FOR WRITE KN, CODE 7 02880000 * CHANNEL END 02900000 APPM7A2 LA R13,C6+8 02920000 CLR R12,R13 TEST STOP AT C6 - END OF SEARCH 02940000 BE APPM7B2 OF MASTER INDEX. BRANCH IF YES 02960000 LA R13,C16+8 02980000 CLR R12,R13 TEST STOP AT C16 - END OF SRCH 03000000 BNE APPN3B3 OF CYLINDER INDEX. BRANCH NO 03020000 TM C18,X'20' END OF CYLINDER SEARCH. 03040000 BZ APPM7C4 TEST FOR DUMMY OR INACTIVE 03060000 TM C18,X'08' 03080000 BZ APPM7B3 BRANCH IF INACTIVE OR DUMMY-END 03100000 MVC IOBDADAD,C17 DUMMY CHAINED. 03120000 LA R12,C10A RESTART CP TO SEARCH CYL S20201 03140020 ST R12,IOBSTART-1 INDEX ON CHAIN. 03160000 B APPRVXCP RETURN TO IOS TO EXCP 03180000 APPM7C4 MVC IOBDADAD(7),C17 ACTIVE. 03200000 APPM7C45 EQU * S20201 03210020 MVI IOBDADAD+7,X'00' SET UP IOB FOR CP8 03220000 MVI IOBAPP,CODE8 M--R IS ADDR FOUND, R=0 S20201 03230020 L R10,DCBWKPT3 GET STARTING ADDR OF CP8 S20201 03240020 ST R10,CPSTART STORE IN IOB AS CP START S20201 03250020 ST R10,IOBCCWAD AND FOR USE AS BASE REG S20201 03260020 MVC CB23+K3(K5),IOBDADAD+K3 CCHH OF FIRST TRACK, R=0 S20201 03270020 OC CB23+K5(K3),DCBFIRSH SET HHR TO FIRSH S20201 03280020 MVI IOBFLAG1,X'42' APP CODE 8 03320000 LA R12,IOBDADAD+3 INITIALIZE CP8 03340000 STH R12,CB1+2 CB1 SET TO SEEK CCHHR OF IOB 03360000 SRL R12,16 03380000 STC R12,CB1+1 03400000 MVC CB5+1(3),DECBKEY+1 CB5, CB15, CB19 ALL SET TO 03420000 MVC CB19+1(3),DECBKEY+1 03440000 APPM7G4 SR R12,R12 CHECK WITH DEB TO SEE IF NEXT 03460000 IC R12,IOBDADAD ADDRESS ON SAME MODULE 03480000 SLL R12,4 03500000 L R12,32(R3,R12) 03520000 LA R12,0(R12) 03540000 CLR R12,R7 03560000 BE APPRVXCP IF SO, EXECUTE CP RETURN TO IOS 03580000 MVI IOBASYN,X'01' IF NOT, SCHEDULE ASYNCHRONOUS 03600000 B APPN3B5 ROUTINE TO EXCP 03620000 APPM7B2 EQU * * 03640001 AIF ('&LIB' EQ 'LIB1').NOTAOS1 03650001 TM C6+K5,CC WAS C6 CHAINED 03652001 BZ APPAOS1 NO, CONTINUE 03654001 NI C6+K5,CCOFF TURN OFF INDICATOR 03656001 OI C6+K4,CC RECHAIN C6 03658001 B APPAOSJ3 RESCHEDULE CP1 03658401 APPAOS1 EQU * * 03658801 .NOTAOS1 ANOP 03659201 TM C9+K7,MIS END MASTER INDEX SEARCH. 03659601 BZ APPM7C2 TEST FOR DUMMY OR INACTIVE 03660000 APPM7B3 TM C9+7,X'08' 03680000 BO APPM7E2 BRANCH IF INACTIVE OR DUMMY-END 03700000 IC R12,C9+7 DUMMY CHAINED. 03720000 SLL R12,29 IF LEVEL INDEX NOT HIGHEST LVL, 03740000 IC R13,DCBNLEV ERROR OF SOME SORT 03760000 SLL R13,29 03780000 CLR R12,R13 03800000 BNE APPN3B3 03820000 * ALWAYS DO CP15 03840000 APPM7E3 MVI IOBAPP,CODE14 TRK FULL--CP15 CODE S20201 03860020 MVC IOBDADAD(3),DCBLPDA SET UP IOB FOR CP15 03880000 MVI IOBDADAD+7,X'00' INSERT ZERO INTO R 03900000 MVC IOBDADAD+3(4),DCBLETI PUT DCBLETI CCHH INTO IOB 03920000 OC IOBDADAD+6(1),DCBFIRSH+3 03940000 XC IOBDADAD+6(1),DCBFIRSH+3 INCR TO NEXT CYL 03960000 L R10,DCBWKPT3 HHR ZERO 03980000 ST R10,IOBCCWAD START ADDR CI1 04000000 LA R12,CI1 REL CCW 0 CP8 04020000 ST R12,IOBSTART-1 FLAGS INDICATE CC, NO DC 04040000 MVI IOBFLAG1,X'42' 04060000 LA R12,IOBDADAD+3 INITIALIZE CP15 04080000 STH R12,CI1+2 CI1 POINTS TO IOB CCHHR 04100000 SRL R12,16 04120000 STC R12,CI1+1 04140000 MVC CI5+K2(K5),DCBLETI GET CCHHR OF INDEX ENTRY S20201 04150020 MVC CI5(K2),DCBLPDA+K1 MOVE IN BB FOR HEAD SEEK S20201 04160020 B APPM7G4 BRANCH TO EXCP 04180000 APPM7C2 TM C9+7,X'04' ACTIVE ENTRY. 04200000 BO APPM7E2 IF LVL 2 MAST IND JUST SRCHED 04220000 OI C6+4,X'40' CC ON TO CHN FROM LVL 1 TO CYL 04240000 APPM7E2 MVC IOBDADAD,C8+7 SEEK ADDR IN IOB IS FND ADDR 04260000 MVI IOBFLAG1,X'42' 04280000 B APPRVXCP RETURN TO IOS TO EXCP 04300000 EJECT 04320000 * ABNORMAL END 04340000 APPM7J2 EQU * 19374 04350000 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 04360000 BO APPM7J3 YES--BRANCH 19374 04370000 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 04380000 BC PERRYES,APPN3B3 YES--BRANCH 19374 04390000 B APPRVNOR NO--RETRY CHANNEL PROGRAM 19374 04400000 APPM7J3 LA R13,C10+8 FILE PROTECT 04460000 CLR R12,R13 04480000 BNE APPN3B3 BRANCH IF STOP NOT AT C10 04500000 AIF ('&LIB' EQ 'LIB1').NOTAOS2 04510001 APPAOSJ3 EQU * * 04512001 .NOTAOS2 ANOP 04514001 MVI IOBFLAG1,X'42' RESTORE IOB FLGS & ERR CTR 04520000 MVI IOBFLAG2,X'00' UNRELATED FLAG ON 04540000 MVI IOBCSW,X'00' OTHERS OFF 04560000 XC IOBERRCT,IOBERRCT 04580000 TM C9+7,X'20' 04600000 BO APPM7B3 BRANCH IF DUMMY OR INACTIVE 04620000 LA R12,C10A SET UP IOB TO RESTART S20201 04640020 ST R12,IOBSTART-1 04660000 NI IOBFLAG1,X'FB' RESET EXCEPTION FLAG 04680000 B APPM7E2 BRANCH 04700000 EJECT 04720000 * M6 - CP2 FOR WRITE KN, CODE 7 04740000 * CHANNEL END 04760000 APPM6B2 LA R13,C35+8 B2 STOP AT C350 04780000 CLR R12,R13 04800000 BNE APPN3B3 NO 04820000 TM C37,X'20' C2 DUMMY OR INACTIVE{ 04840000 BZ APPM6D2 NO D2 04860000 TM C37,X'28' C3 DUMMY CHAINED{ 04880000 BO APPM6D3 YES D3 04900000 TM DCBNLEV,X'01' C4 NLEV=F{ F MUST BE 1 04920000 BZ APPN3B3 NO 04940000 * ALWAYS DO CP15 04960000 MVI IOBDADAD+7,X'00' ZERO R SET UP CP15 04980000 MVC IOBDADAD(3),DCBLPDA MBB FROM LPDA 05000000 MVC IOBDADAD+3(4),DCBLETI CCHH FROM LETI 05020000 OC IOBDADAD+6(1),DCBFIRSH+3 05040000 XC IOBDADAD+6(1),DCBFIRSH+3 INCREMENT TO A CYL BOUNDRY 05060000 MVI IOBAPP,CODE14 SET CODE 14 FOR CP15 S20201 05080020 L R10,DCBWKPT3 E5 CP8 ADDR 05100000 LA R12,CI1 CP15 START 05120000 ST R12,IOBSTART-1 CHAN PROG START 05140000 ST R10,IOBCCWAD CCW O 05160000 MVI IOBFLAG1,X'42' USE COMMAND CHAINING 05180000 MVC CI5+K2(K5),DCBLETI COUNT ADDR S20201 05190020 MVC CI5(K2),DCBLPDA+K1 MOVE IN BB FOR HEAD S20201 05200020 * SEEK S20201 05210020 IC R9,CI1 SAVE 05220000 LA R12,IOBDADAD+3 05240000 ST R12,CI1 IDENT ADDR 05260000 STC R9,CI1 SAVE 05280000 B APPM7G4 DO AN EXCP S20201 05300020 APPM6D2 MVC IOBDADAD(7),C36 D2 C36 MBBCCHH 05320000 B APPM7C45 SET UP CP8 S20201 05360020 APPM6D3 MVC IOBDADAD,C36 D3 C36 MBBCCHHR 05620000 B APPRVXCP E3 EXCP RETURN TO IOS 05640000 EJECT 05660000 * ABNORMAL END 05680000 APPM6J4 TM IOBECBAD,PERRMASK J4 PERMANENT ERROR TEST 05700000 BC PERRYES,APPN3B3 YES B3 05720000 B APPRVNOR J5 NORMAL RETURN TO IOS 05740000 EJECT 05760000 * CHANNEL END APP CODES 9&23 (CP10A) CHART N7 05780000 APPN7B2 LA R13,CB50+8 B2 STOP AT CB500 05800000 CLR R12,R13 05820000 BNE APPM1B3 NO M1B3 05840000 APPN7A3 L R12,DCBWKPT2 YES SET SAME MODULE SWITCH ON 05860000 OI DCWWKNI,X'20' 05880000 IC R9,IOBDADAD+7 B3 ADD 1 TO R IN IOB 05900000 LA R12,1(R0,R9) 05920000 STC R12,IOBDADAD+7 05940000 STC R12,DCBLPDA+7 PUT NEW R IN LPDA 11081 05960015 APPN7B4 CLI DCBHIRSH,X'00' ARE ALL TRACKS UNSHARED 11081 05980015 BE APPN7C4 YES C4 06000000 IC R9,IOBDADAD+6 TRK SHARED 06020000 IC R12,DCBFIRSH+3 AND H AND MASK TO GET 06040000 NR R9,R12 REAL TRK NO. 06060000 EX R9,CLIFIRSH 06080000 BNE APPN7C4 NO C4 06100000 CLC DCBHIRSH,DCBLPDA+7 YES HIRSH R = LPDA R { 06120000 BNE APPN7C2 NO C2 06140000 APPN7D3 IC R9,IOBDADAD+6 IS THIS LAST 06160000 IC R12,DCBFIRSH+3 06180000 NR R12,R9 DATA TRACK OF THIS 06200000 EX R12,CLILDT CYLINDER 06220000 BE APPN7D4 YES, GO FIND NEXT CYL 06240000 LA R9,1(0,R9) NO, 06260000 STC R9,IOBDADAD+6 ADD 1 TO TRACK 06280000 MVI IOBDADAD+7,X'00' E2 NO SET IOB R TO ZERO 06300000 APPN7G2 TM DCBST,X'02' G2 LAST BLOCK FULL{ 06320000 BZ APPN7C2 NO C2 06340000 OI DCBST,X'01' G3 YES SET LAST TRACK FULL SW ON 06360000 B APPN7C2 06380000 APPN7D4 SR R12,R12 06400000 IC R12,IOBDADAD FIND CURRENT 06420000 SLL R12,4 EXTENT 06440000 AR R12,R3 06460000 OC IOBDADAD+6(1),DCBFIRSH+3 SET TRACK TO MAX 06480000 CLC IOBDADAD+6(1),DEBENDHH+1-IHADEB(R12) LAST TRACK IN EXT 06500000 BNL APPCCH YES 06520000 IC R9,IOBDADAD+6 ONLY 2301 WILL GO THIS PATH 06540000 LA R9,1(0,R9) TO ADD 1 TO CYLINDER 06560000 STC R9,IOBDADAD+6 06580000 B APPN7G4 06600000 APPCCH CLC IOBDADAD+3(3),DEBENDCC-IHADEB(R12) LAST CYL OF 06620000 BL APPN7E4A EXTENT (CCH) 06640000 IC R9,IOBDADAD 06660000 LA R9,1(0,R9) PUT NEW M IO IOB 06680000 STC R9,IOBDADAD 06700000 LA R12,16(0,R12) ACCESS NEXT EXTENT INTRY IN DEB 06720000 MVC IOBDADAD+1(6),DEBBINUM-IHADEB(R12) MOVE NEW BBCCHH 06740000 L R13,DEBUCBAD-IHADEB(R0,R12) IS NEW CYL ON SAME MODULE 06760000 LA R13,0(R0,R13) 06780000 CLR R13,R7 06800000 BE APPN7G4 YES G4 06820000 L R12,DCBWKPT2 F5 NO SET SAME MOD SW OFF 06840000 NI DCWWKNI,X'DF' 06860000 B APPN7G4 G4 06880000 APPN7E4A MVI IOBDADAD+K6,K0 SET TRACK TO ZERO S20201 06881020 AIF ('&LIB' NE 'LIB1').LIB2GN1 06881403 CLI DCBDEVT,MERLIN IS CYL A TWO BYTE FIELD S20201 06882020 BNE APPN7E4B NO, BR--BYTE ADDRESSING S20201 06883020 .LIB2GN1 ANOP 06883403 IC R13,IOBDADAD+K3 PICK UP C1 OF CC S20201 06884020 SLL R13,8 SHIFT S20201 06885020 IC R13,IOBDADAD+K4 PICK UP C2 OF CC S20201 06886020 LA R13,K1(R0,R13) ADD ONE TO CYL VALUE S20201 06887020 STC R13,IOBDADAD+K4 RESTORE C2 S20201 06888020 SRL R13,8 SHIFT S20201 06889020 STC R13,IOBDADAD+K3 RESTORE C1 S20201 06891020 AIF ('&LIB' NE 'LIB1').LIB2GN2 06891403 B APPN7G4 GO SET TO FIRSH-1'S HR S20201 06893020 APPN7E4B L R13,CVTPTR GET CVT ADDRESS S20201 06895020 IC R9,DCBDEVT PICK UP DEVICE TYPE. 23596 06900018 L R13,CVTZDTAB(0,R13) POINT TO DEVICE TABLE. 23596 06910018 IC R9,0(R9,R13) LOCATE PROPER ENTRY. 23596 06920018 LA R12,2(R9,R13) SET INDEX TO H OF CCH. 23596 06930018 LA R13,IOBDADAD+5 R13=A(H OF CHANGE FIELD). 23596 06940018 ADDONE IC R9,0(0,R13) ADD ONE TO SOME BYTE 23596 06960018 LA R9,1(0,R9) OF CCH. 23596 06970018 STC R9,0(0,R13) 23596 06980018 CLC 0(1,R13),0(R12) IS THE NEW VALUE VALID? 23596 06990018 BL APPN7G4 YES, BRANCH. 23596 07000018 MVI 0(R13),0 NO, ZERO THIS BYTE. 23596 07010018 BCTR R12,0 DECREMENT BOTH INDICES 23596 07020018 BCT R13,ADDONE AND TRY NEXT BYTE. 23596 07030018 .LIB2GN2 ANOP 07080003 APPN7G4 OC IOBDADAD+6(1),DCBFIRSH+1 07100000 IC R9,DCBFIRSH+2 07120000 BCTR R9,0 07140000 STC R9,IOBDADAD+7 07160000 B APPN7G2 07180000 CLILDT CLI DCBLDT+1,0 OBJECT OF EXECUTE 07200000 CLIFIRSH CLI DCBFIRSH+1,0 OBJECT OF EXECUTE 07220000 APPN7C4 CLC DCBHIRPD,DCBLPDA+7 C4 HIRPD R = LPDA R { 07240000 BE APPN7D3 YES D3 07260000 APPN7C2 MVC CB55(4),IOBDADAD+3 C2 NO 07280000 IC R9,IOBDADAD+7 07300000 LA R12,1(R0,R9) 07320000 STC R12,CB55+4 07340000 MVI IOBFLAG1,X'42' SET B1 ON (CC) 07360000 LA R12,CB52 SET IOB START TO CP10B 07380000 ST R12,IOBSTART-1 07400000 LA R13,IOBDADAD+3 07420000 STH R13,CB52+2 07440000 SRL R13,16 07460000 STC R13,CB52+1 07480000 CLI IOBAPP,CODE9 IS APPENDAGE CODE 9 S20201 07500020 BE APPN7E1 YES E1 07520000 MVI IOBAPP,CODE11 SET APPENDAGE CODE TO 11 S20201 07540020 APPN7F1 L R12,DCBWKPT2 F1 SAME MODULE SW ON{ 07560000 TM DCWWKNI,X'20' 07580000 BO APPRVXCP YES EXCP RETURN TO IOS 07600000 MVI IOBASYN,X'01' NO SET ASYNC CODE 1 07620000 B APPM1B5 SCHED ASYNC ROUTINE 07640000 APPN7E1 MVI IOBAPP,CODE10 SET APPENDAGE CODE TO 10 S20201 07660020 B APPN7F1 F1 07680000 EJECT 07700000 * ABNORMAL END APP CODE 9&23 (CP10A)CHARTN7 07720000 APPN7J2 TM IOBECBAD,PERRMASK J2 PERMANENT ERROR TEST 07740000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 07760000 TM IOBSENSE,X'08' J3 YES CAUSE DATA CHECK{ 07780000 BZ APPM1B3 NO M1B3 07800000 LA R13,CB48+8 07820000 CLR R12,R13 07840000 BE APPN7J5 YES N7J5 07860000 LA R13,CB49+8 07880000 CLR R12,R13 07900000 BE APPN7J5 YES N7J5 07920000 LA R13,CB50+8 07940000 CLR R12,R13 07960000 BE APPN7J5 YES N7J5 07980000 B APPM1B3 NO M1B3 08000000 APPN7J5 OI DECBEXC1,X'08' J5 IND UNCOR I/O ERR 08020000 B APPM1B4 08040000 EJECT 08060000 * CHANNEL END APP CODES 10&11(CP10B)CHARTN8 08080000 APPN8A2 LA R13,CB54+8 08100000 CLR R12,R13 08120000 BNE APPM1B3 NO M1B3 08140000 TM CB53+4,X'20' EOF FOR CP14? 13270 08146015 BO APPM426 17332 08153018 L R12,DCBNREC 08160000 LA R12,1(R0,R12) 08180000 ST R12,DCBNREC ADD 1 TO PRIME COUNT 08200000 CLI IOBAPP,CODE10 IS APPENDAGE CODE 10 S20201 08220020 BE APPM1B4 YES M1B4 08240000 MVI IOBAPP,CODE18 NO, SET APP CODE TO 18 S20201 08260020 OI IOBFLAG1,X'C0' SET B0&B1 ON (CC&DC) 08280000 LA R12,CK1 SET IOB START TO CP17 08300000 ST R12,IOBSTART-1 08320000 MVC IOBDADAD+3(5),DCBLETI SET SEEK ADDR IN IOB 08340000 MVC IOBDADAD(3),DCBLPDA 08360000 LA R12,IOBDADAD+3 D2 INITIALIZE CP17 08380000 ST R12,CK1 08400000 MVI CK1,X'31' 08420000 ST R12,CK4 08440000 MVI CK4,X'31' 08460000 MVC CK6+1(3),DECBKEY+1 08480000 B APPM7G4 08500000 EJECT 08520000 * ABNORMAL END APP CODES 10&11 (CP10B) CHART N8 08540000 APPN8G2 TM IOBECBAD,PERRMASK G2 PERMANENT ERROR TEST 08560000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 08580000 TM IOBSENSE,X'08' G3 YES CAUSE DATA CHECK{ 08600000 BZ APPM1B3 NO M1B3 08620000 LA R13,CB55+8 08640000 CLR R12,R13 08660000 BE APPN7J5 YES N7J5 08680000 B APPM1B3 NO M1B3 08700000 EJECT 08720000 * CHANNEL END APP CODES 17,18,19 (CP17) CHART N9 08740000 APPN9A2 LA R13,CK1 CP START MAY HAVE BEEN A34932 08748020 * CHANGED A34932 08756020 ST R13,IOBSTART-1 FOR RETRY ON ERROR. A34932 08764020 LA R13,CK7+8 A2 STOP AT CK70 A34932 08772020 CLR R12,R13 08780000 BNE APPM1B3 NO M1B3 08800000 CLI CK9,X'00' A3 TEST F IN CK9 08820000 BE APPN9B3 NORMAL TRACK INDEX 08840000 CLI CK9,X'08' 08860000 BE APPN9B3 SHARED 08880000 APPN9B2 EQU * 08900000 L R12,DCBWKPT2 08920000 CLI IOBAPP,CODE17 IS APPENDAGE CODE 17 S20201 08940020 BE APPM1B4 YES M1B4 08960000 CLI IOBAPP,CODE18 IS APPENDAGE CODE 18 S20201 08980020 BE APPN9C2 YES C2 09000000 CLC DCWNLEVC,DCBNLEV E2 NO (19)NLEV CTR = DCBNLEV³ 09020000 BE APPN9F1 YES 09040000 IC R13,DCWNLEVC G2 NO ADD 1 TO NLEV COUNTER 09060000 LA R13,1(R0,R13) 09080000 STC R13,DCWNLEVC 09100000 CLI DCWNLEVC,X'02' TEST NLEV COUNTER = 2 09120000 BE APPN9E3 BRANCH IF YES 09140000 CLI DCWNLEVC,X'03' TEST NLEV COUNTER = 3 09160000 BE APPN9F3 BRANCH IF YES, ELSE = 4 09180000 MVC IOBDADAD+3(5),DCBLEMI3 G3 SET SEEK ADDR TO LEMI3 09200000 CLI DCBFTMI3+1,X'00' 09220000 BE *+14 09240000 MVC IOBDADAD(1),DCBFTMI3+1 09260000 B APPN9C5 09280000 MVC IOBDADAD(1),DCBFTMI3 09300000 B APPN9C5 09320000 APPN9E3 MVC IOBDADAD+3(5),DCBLEMI1 E3 SET SEEK ADDR TO LEMI1 09340000 CLI DCBFTMI1+1,X'00' 09360000 BE *+14 09380000 MVC IOBDADAD(1),DCBFTMI1+1 09400000 B APPN9C5 09420000 MVC IOBDADAD(1),DCBFTMI1 09440000 B APPN9C5 09460000 APPN9F3 MVC IOBDADAD+3(5),DCBLEMI2 F3 SET SEEK ADDR TO LEMI2 09480000 CLI DCBFTMI2+1,X'00' 09500000 BE *+14 09520000 MVC IOBDADAD(1),DCBFTMI2+1 09540000 B *+10 09560000 MVC IOBDADAD(1),DCBFTMI2 09580000 XC IOBDADAD+1(2),IOBDADAD+1 09600000 B APPN9C5 C5 09620000 APPN9B3 CLI CB26,X'10' B3 TEST F IN CB26 09640000 BNE APPN9B2 NOT OVERFLOW END 09660000 MVC IOBDADAD+3(5),CB24 C3 OVERFLOW ENTRY 09680000 B APPRVXCP C4 EXCP RETURN TO IOS 09700000 APPN9F1 TM DCWHIAV,X'40' HIGH IND IN CORE? 09720000 BZ APPN9H1 NO H1 09740000 L R12,DCWMSHIL G1 YES CHNG KEY OF LST CORE INDEX 09760000 L R11,DECBKEY 09780000 IC R9,DCBKEYLE 09800000 LA R13,0(R0,R9) 09820000 BCTR R13,R0 09840000 EX R13,APPN9G1A 09860000 APPN9H1 MVI IOBASYN,X'08' H1 SET ASYNC CODE 8 09880000 B APPM1B5 SCHED ASYNC ROUTINE 09900000 APPN9C2 CLI DCBNLEV,X'00' C2 DCBNLEV = 0 { 09920000 BE APPM1B4 YES M1B4 09940000 L R12,DCBWKPT2 R12 ADDRESS DCB WA 09960000 MVI DCWNLEVC,X'01' D2 NO SET NLEV COUNTER TO 1 09980000 MVC IOBDADAD+3(5),DCBLECI D3 SET SEEK ADDR TO LECI 10000000 CLI DCBFTCI+1,X'00' 10020000 BE *+14 10040000 MVC IOBDADAD(1),DCBFTCI+1 10060000 B APPMVI 10080000 MVC IOBDADAD(1),DCBFTCI 10100000 XC IOBDADAD+1(2),IOBDADAD+1 10120000 APPMVI MVI IOBAPP,CODE19 SET APPENDAGE CODE TO 19 S20201 10140020 OI IOBFLAG1,X'C0' SET B0&B1 ON (CC&DC) 10160000 LA R12,CK1 SET IOBSTART TO CK1 10180000 ST R12,IOBSTART-1 10200000 APPN9C5 MVI IOBASYN,X'01' C5 SET ASYNC CODE 1 10220000 B APPM1B5 SCHED ASYNC ROUTINE 10240000 EJECT 10260000 * ABNORMAL END APP CODES 17,18,19 (CP17)CHART N9 10280000 APPN9G4 TM IOBECBAD,PERRMASK G4 PERMANENT ERROR TEST 10300000 BC PERRYES,APPM1B3 YES M1B3 A34932 10306020 * THIS IS A FIRST ENTRY ON AN ERROR. 10312020 LA R11,CK4 TEST FOR STOP PRIOR TO A34932 10318020 * CK4 A34932 10324020 CLR R12,R11 DID IT STOP BEFORE CK4? A34932 10330020 BNH APPRVNOR BIF YES. RETRY FROM CK1. A34932 10336020 ST R11,IOBSTART-1 RETRY FROM CK4 A34932 10342020 B APPRVNOR RETURN TO IOS. A34932 10348020 APPN9G1A MVC 0(0,R12),0(R11) 10360000 EJECT 10380000 * COMMON ROUTINE TO SCHEDULE ASYNCHRONOUS ROUTINE 10400000 APPM1B3 OI DECBEXC1,X'04' B3 SET DECB EXCD TO UNRCHABLE 10420000 APPM1B4 MVI IOBASYN,X'08' B4 SET ASYNC CODE TO 8 10440000 APPM1B5 LA R14,BYP(R14) SCHEDULE ASYNCH ROUTINE 15924 10460016 L R13,CVTPTR 10480000 L R13,CVTEXEF 10500000 BR R13 10520000 EJECT 10540000 * CHANNEL END APP CODE 15 (CP16) CHART M2 10560000 APPM2B2 LA R13,CJ10+L'CJ10 B2 STOP AT CJ100 10580020 CLR R12,R13 10600000 BNE APPM1B3 NO M1B3 10620000 L R12,DCBMSWA C2 YES OFLO END ENTRY? 10640000 TM 8(R12),X'08' 10660000 BZ APPM2D3 YES D3 10680000 MVC IOBDADAD,0(R12) E2 NO SET SEEK ADDR FROM LINK 10700000 B APPM7G4 10720000 APPM2D3 MVC CJ11,IOBDADAD D3 PUT SEEK ADDR IN CJ11 10740000 MVI IOBASYN,X'0B' SET ASYNC CODE 11 10760000 NI IOBINDCT,X'DF' SET B2-OFLO RCD FR AREA 10780000 B APPM1B5 SCHED ASYNC ROUTINE 10800000 EJECT 10820000 * ABNORMAL END APP CODES 15,16,(CP16) CHART M2 10840000 APPM2H2 TM IOBECBAD,PERRMASK H2 PERMANENT ERROR TEST 10860000 BC PERRNO,APPRVNOR NO CONTINUE, NORMAL IOS 10880000 B APPM1B3 YES M1B3 10900000 EJECT 10920000 * CHANNEL END APP CODE 16 (CP16) CHART M3 10940000 APPM3B2 LA R13,CJ10+L'CJ10 B2 STOP AT CJ10 10960020 CLR R12,R13 10980000 BNE APPM3B3 NO - TRY CJ9 S20201 10990020 MVC CJ11,IOBDADAD SAVE SEEK ADDR IN CJ11 11020000 L R12,DCBMSWA D2 YES SET IOB SEEK FROM LINK 11040000 MVC IOBDADAD,0(R12) 11060000 L R12,DCBWKPT2 E2 SET FIRST TIME ONLY SW OFF 11080000 NI DCWWKNI,X'BF' 11100000 B APPM7G4 11120000 APPM3B3 LA R13,CJ9+L'CJ9 STOP AT CJ9 11130020 CLR R12,R13 S20201 11140020 BNE APPM3B4 NO - TRY CJ8 S20201 11150020 MVC CJ11,IOBDADAD SAVE SEEK ADDR IN CJ11 11200000 TM DCBOPTCD,X'02' C3 YES DELETE OPTION{ 11220000 BZ APPM3C4 NO C4 11240000 L R12,DCBMSWA D3 YES RCD MARKED FOR DELETION{ 11260000 LA R13,10(R0,R12) 11280000 CLI 0(R13),X'FF' 11300000 BNE APPM3C4 NO C4 11320000 MVI IOBASYN,X'0E' E3 YES SET ASYNC CODE 14 11340000 APPM3E4 NI IOBINDCT,X'DF' E4 SET B2-OFLO RCD FR AREA 11360000 B APPM1B5 E5 SCHED ASYNC ROUTINE 11380000 APPM3C4 OI DECBEXC1,X'01' C4 SET EXCEP CODE TO IND DUPL 11400000 MVI IOBASYN,X'08' D4 SET ASYNC CODE 8 11420000 B APPM1B5 SCHED ASYNC ROUTINE 11440000 APPM3B4 LA R13,CJ8+L'CJ8 SEE IF STOPPED AT CJ8 11450020 CLR R12,R13 S20201 11460020 BNE APPM1B3 IF NOT, UNREACHABLE BLK S20201 11470020 L R12,DCBWKPT2 C5 YES FIRST TIME ONLY SW ON{ 11520000 TM DCWWKNI,X'40' 11540000 BO APPM3B5 YES B5 11560000 MVI IOBASYN,X'0C' D5 NO SET ASYNC CODE 12 11580000 B APPM3E4 E4 11600000 APPM3B5 MVI IOBASYN,X'0D' B5 SET ASYNC CODE 13 11620000 MVC IOBDADAD(7),CJ11 RESTORE TRK INDEX MBBCCHH 11640000 B APPM3E4 11660000 EJECT 11680000 * CHANNEL END APP CODE 12 (CP14) CHART M4 11700000 APPM4A2 LA R13,CH18+8 DID CHAN PROG STOP AT CH18 11720000 APPM4A21 EQU * 13270 11722015 TM CB53+4,X'20' EOF WRITTEN 13270 11724015 BZ APPM4A22 BRANCH IF NO 13270 11726015 MVC IOBDADAD,DCBLIOV INITIALIZE IOBDADAD SEEK 13270 11728015 MVC DCBLIOV(3),CH23 RESET LIOV FROM 13270 11730015 MVC DCBLIOV+3(5),CH24 CP14 13270 11732015 CLR R12,R13 13270 11734015 BNE APPM1B3 B = UNREACHABLE 13270 11736015 MVI IOBFLAG1,X'42' CC SET ON 13270 11738015 MVI IOBAPP,CODE10 SET APPENDAGE CODE 10 S20201 11740020 LA R12,CB52 13270 11742015 ST R12,IOBSTART-1 13270 11744015 LA R13,IOBDADAD+3 13270 11746015 STH R13,CB52+2 13270 11748015 SRL R13,16 13270 11750015 STC R13,CB52+1 13270 11752015 SR R13,R13 16384 11752316 IC R13,IOBDADAD GET M 16384 11752616 SLL R13,4 TIMES 16 16384 11752916 LA R13,32(R3,R13) ALLOW FOR BASIC DEB TOO 16384 11753216 L R12,0(0,R13) GET UCB POINTER 16384 11753516 LA R12,0(0,R12) ZERO HIGH ORDER BYTE 16384 11753816 CR R7,R12 SAME UNIT 16384 11754116 BE APPRVXCP YES--EXCP RETURN 16384 11754416 MVI IOBASYN,X'01' NO--SET ASYNCH CODE = 1 16384 11754716 B APPM1B5 SCHEDULE ASYNCHRONOUS RTN 16384 11755016 APPM426 CLI CK9+7,12 INSERT TO MIDDLE OVFL CH 17332 11755218 MVI CB53+4,X'00' RESET EOF FLAG 17332 11755418 BE APPM1B4 IF YES POST COMPLETION 17332 11755618 APPM4A22 EQU * 13270 11756015 CLR R12,R13 13270 11760015 BNE APPM1B3 B = UNREACHABLE 13270 11762015 TM CH8E+4,X'40' TEST FOR UWA 17332 11762618 BZ APPM425 IF NO-BRANCH 17332 11763218 NI CH8E+4,X'42' RESET FLAG 17332 11763818 CLI CK9+7,14 ASYN CODE=14 17332 11764418 BE APPM1B4 IF YES-POST COMPLETION 17332 11765018 CLI CK9+7,9 ASYN CODE=9 17332 11765618 BE APPM4A23 IF YES BRANCH 17332 11766218 MVI IOBAPP,X'04' SET UP CP14 PART2 17332 11766818 MVC IOBSTART,CH21+4 TO UPDATE TRACK 17332 11767418 MVC IOBDADAD,CH14 RESTORE IOBSEEK 17332 11768018 MVI CH14,X'03' SET NOP IN CH14 17332 11768618 MVI CH14+4,X'20' 17332 11769218 MVI CH14+7,X'01' 17332 11769818 B APPN9C5 17332 11770418 APPM4A23 MVI IOBCOUNT,X'01' ERROR COUNT=1 17332 11771018 MVC IOBDADAD(3),CB10+7 IOBSEEK ADDR 17332 11771618 MVC IOBDADAD+3(5),CB23+3 17332 11772218 IC R12,IOBDADAD+7 REDUCE R BY 1 17332 11772818 BCTR R12,R0 17332 11773418 STC R12,IOBDADAD+7 17332 11774018 TM DCBRECFM,X'10' TEST FOR BLOCKED 17332 11774618 BO APPM424 IF YES-BRANCH 17332 11775218 L R12,CH6+4 RESTORE 10 BYTES 17332 11775818 L R13,DECBAREA USED FOR LINK FIELD IN 17332 11776418 MVC 0(10,R12),0(R13) OVFL RECORD 17332 11777018 APPM424 MVC IOBSTART,CD2+5 START OF CP12B 17332 11777618 MVI IOBAPP,X'15' APP CODE 15 17332 11778218 OI IOBFLAG1,X'C0' 17332 11778818 B APPN9C5 17332 11779418 APPM425 L R12,DCBWKPT2 17332 11789418 TM DCWWKNI,X'10' IS ADD-TO-END INDICATOR ON 11800000 BZ APPM1B4 NO - SCHEDULE COMPLETION 11820000 APPM4C2 MVC CK6+1(3),DECBKEY+1 IF SO, SET ADDR OF CK6 TO DECB KEY 11840000 LA R12,IOBDADAD+3 SET UP CP17 11860000 STH R12,CK1+2 11880000 SRL R12,16 11900000 STC R12,CK1+1 11920000 MVC CK4+1(3),CK1+1 11940000 B APPN9C2 BRANCH 11960000 EJECT 11980000 * ABNORMAL END APP CODE 12 (CP14) CHART M4 12000000 APPM4E2 EQU * 19374 12010000 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 12030016 BO APPM4I2 YES BRANCH 15924 12040016 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 12060000 BC PERRNO,APPRVNOR NO--RETRY CHANNEL PROG 19374 12080000 TM IOBSENSE,X'08' 12100000 BZ APPM1B3 BRANCH IF CAUSE NOT DATA CHECK 12120000 APPM4G2 LA R13,CH16+8 IF STOP NOT AT CH16, CH17, OR 12140000 CLR R12,R13 CH18, BRANCH 12160000 BE APPM4H2 12180000 LA R13,CH17+8 12200000 CLR R12,R13 12220000 BE APPM4H2 12240000 LA R13,CH18+8 12260000 CLR R12,R13 12280000 BNE APPM1B3 12300000 APPM4H2 OI DECBEXC1,X'08' IF SO, SET UNCORRECTABLE I/O 12320000 B APPM1B4 ERROR IN EXCEP CODE IN DECB 12340000 APPM4I2 LA R13,CH14+8 DID CHAN PROG STOP AT CH14 12360000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 12380000 BNE APPM1B3 NO - RECORD IS UNREACHABLE 12400000 MVC IOBDADAD,CH23 MOVE CH23 MBBCCHHR TO IOB 12420000 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH15 12440000 MVI IOBASYN,X'01' 12460000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 12480000 EJECT 12500000 * CHART M5 COMPLETION OF CP14, CODE 13 12520000 * CHANNEL END 12540000 APPM5A2 LA R13,CH22+8 DID CHAN PROG STOP AT CH22 12560000 B APPM4A21 12580000 EJECT 12600000 * ABNORMAL END 12620000 APPM5E2 EQU * 19374 12630000 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 12650016 BO APPM5I2 YES BRANCH 15924 12660016 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 12680000 BC PERRNO,APPRVNOR NO--RETRY CHAN PROG 19374 12700000 TM IOBSENSE,X'08' IF YES, 12720000 BZ APPM1B3 BRANCH IF CAUSE NOT DATA CHECK 12740000 LA R13,CH22+8 12760000 CLR R12,R13 12780000 BE APPM4H2 BRANCH IF STOP AT CH22 12800000 B APPM4G2 BRANCH OTHERWISE. 12820000 APPM5I2 LA R13,CH19+8 DID CHAN PROG STOP AT CH19 12840000 CLR R12,R13 BE MEANS YES, BNE MEANS NO 12860000 BNE APPM4I2 NO - BRANCH TO TEST FOR CH14 12880000 MVC IOBDADAD,CJ11 MOVE CJ11 MBBCCHHR TO IOB 12900000 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH20 12920000 MVI IOBASYN,X'01' 12940000 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 12960000 EJECT , 17332 12960818 * NORMAL END APPENDAGE CODE 4 12961618 * UPDATE TRACK INDICES WITH 2ND PART CP14 12962418 * 12963218 * 12964018 APPAFB LA R13,CH14+8 DID CP END AT CH14 17332 12964818 CLR R12,R13 17332 12965618 BNE APPN3B3 NO-RECORD IS UNREACHABLE 17332 12966418 MVC IOBASYN,CK9+7 17332 12967218 CLI IOBASYN,10 ADD TO END 17332 12968018 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 12968818 CLI IOBASYN,11 ADD TO END 17332 12969618 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 12970418 B APPM1B4 POST COMPLETION 17332 12971218 EJECT , 17332 12972018 * 12972818 * ABNORMAL END APPENDAGE CODE 4 12973618 * UPDATE TRACK INDICES 12974418 * 12975218 APPAEB TM IOBECBAD,PERRMASK PERM ERROR 17332 12976018 BC PERRNO,APPRVNOR IF NO-NORMAL RET TO IOS 17332 12976818 B APPM1B3 POST UNREACHABLE BLOCK 17332 12977618 EJECT 12980000 * READ AND UPDATE APPENDAGE MODULES ********* 13000000 * 13020000 APPHCA14 DC A(CA14-IHACP47+8) 13040000 APPHCA20 DC A(CA20-IHACP47+8) CA20 OFFSET S20201 13060020 APPHCA23 DC A(CA23-IHACP47+8) 13080000 APPHCA24 DC A(CA24-IHACP47+8) 13100000 APPHCA31 DC A(CA31-IHACP47+8) 13120000 APPCA31B DC A(CA31B-IHACP47+8) CA31B OFFSET S20201 13130020 APPHCA36 DC A(CA36-IHACP47+8) 13140000 APPHCA43 DC A(CA43-IHACP47+8) 13160000 AIF ('&LIB' EQ 'LIB1').NOTAOS3 13170001 APPHCA10 DC A(CA10-IHACP47+8) CA10 OFFSET 13172001 .NOTAOS3 ANOP 13174001 * CHANNEL END APP CODE 3 (CP2) CHART AA 13180000 USING CP2,R10 13200000 APPAAB2 L R13,DCBWKPT2 R13 ADDR DCB WA 13220000 USING IHADCW,R13 13240000 CLI DCWNLSD,X'01' BRANCH IF NLSD NOT 1, I.E. 13260000 BH APPAEB2 IF CP1 IS BEING USED 13280000 LA R13,C35+8 13300000 CLR R12,R13 13320000 BNE APPAAB3 NO B3 13340000 TM C37,X'20' YES DUMMY OR INACTIVE TEST 13360000 BO APPAAC3 YES C3 13380000 MVC IOBDADAD,C36 NO C36 TO IOBDADAD 13400000 MVI IOBASYN,X'03' E2 ASYNC CD SET=3 (G CP1,2) 13420000 B APPABSAR 13440000 APPAAC3 TM C37,X'08' TEST DUMMY CHAINED 13460000 BO APPAAD3 YES D3 13480000 IC R12,C37 NO TEST NLEV PER F = DCBNLEV 13500000 NI C37,X'07' 13520000 CLC DCBNLEV,C37 13540000 STC R12,C37 13560000 BNE APPAAB3 NO B3 13580000 OI DECBEXC1,X'80' C5 YES DECB EXCEP SET=NO RCD FND 13600000 APPAAD4 MVI IOBASYN,X'07' D4 ASYNC CD SET=7 (NG CP1,2) 13620000 B APPABSAR SAR 13640000 APPAAD3 MVC IOBDADAD,C36 C36 TO IOBDADAD 13660000 B APPRVXCP EXCP RETURN TO IOS 13680000 APPAAB3 OI DECBEXC1,X'04' B3 DECB EXCEP SET=UNREACHABLE 13700000 B APPAAD4 D4 13720000 * ABNORMAL END APP CODE 3 (CP2) CHART AA 13740000 * 13760000 APPAAA2 L R13,DCBWKPT2 R13 ADDR DCB WA 13780000 CLI DCWNLSD,X'01' BRANCH IF NLSD NOT 1, I.E. 13800000 BNE APPAEJ2 IF CP1 IS BEING USED 13820000 APPAAA3 TM IOBECBAD,PERRMASK TEST PERM ERR 13840000 BO APPRVNOR NO, NORMAL IOS RETURN 15924 13860016 B APPAAB3 YES BRANCH TO INDICATE UNRCHBLE 13880000 DROP R13 13900000 * 13920000 * CHART AE END CP1 13940000 * CHANNEL END 13960000 USING CP1,R10 13980000 APPAEB2 LA R13,C6+8 TEST FINAL CCW EQUAL C6 14000000 CLR R12,R13 14020000 BE APPAEC2 BRANCH IF YES 14040000 LA R13,C16+8 TEST EQUAL C16 14060000 CLR R12,R13 14080000 BE APPAEC4 BRANCH IF YES 14100000 B APPAAB3 ERROR IF NO 14120000 * INTERRUPT AT C6 14140000 APPAEC2 EQU * * 14160001 AIF ('&LIB' EQ 'LIB1').NOTAOS8 14170001 TM C6+K5,CC WAS C6 CHAINED 14172001 BZ APPAOS8 NO, CONTINUE 14174001 NI C6+K5,CCOFF TURN OFF INDICATOR 14176001 OI C6+K4,CC RECHAIN C6 14178001 CLI C10,SEEKHH C10 SET TO DO SEEK HEAD 14178401 BNE APPAOSJ4 NO, FILE PROTECT 14178801 LA R13,C10A RESET IOBSTART TO 14179201 ST R13,IOBSTART-K1 RESTART AT C10A 14179601 B APPAEG2 RESCHEDULE CP1 14179701 APPAOS8 EQU * * 14179801 .NOTAOS8 ANOP 14179901 TM C9+K7,MIS END MASTER INDEX SEARCH. 14186601 BO APPAEC3 BRANCH IF YES 14193301 TM C9+7,X'04' IF LEVEL OF INDEX IS 3 14200000 BO APPAEG2 SET CC IN CP1 TO CHAIN TO 14220000 OI C6+4,X'40' SEARCH CYLINDER INDEX 14240000 APPAEG2 MVC IOBDADAD,C8+7 ADDR NEXT SRCH ADDR IN IOB 14260000 B APPRVXCP RETURN TO EXCP 14280000 * DUMMY OR INACTIVE 14300000 APPAEC3 TM C9+7,X'08' TEST DUMMY ENTRY CHAINED 14320000 BO APPAEG2 BRANCH IF YES 14340000 IC R12,C9+7 COMPARE LEVEL OF INDEX READ TO 14360000 SLL R12,29 DCB INDEX LEVEL 14380000 IC R13,DCBNLEV 14400000 SLL R13,29 14420000 CLR R12,R13 14440000 BNE APPAAB3 BRANCH IF NOT EQUAL 14460000 OI DECBEXC1,X'80' SET NO REC FND IN EXCEPTION CD 14480000 B APPAAD4 14500000 * END OF CYLINDER SEARCH 14520000 APPAEC4 TM C18,X'20' TEST DUMMY OR INACTIVE 14540000 BO APPAEC5 BRANCH IF YES 14560000 MVC IOBDADAD,C17 ADDR NEXT SRCH IN IOB 14580000 MVI IOBASYN,X'03' SET ASYNC CODE 14600000 B APPABSAR SCHEDULE ASYNCH RTN 14620000 APPAEC5 TM C18,X'08' IF DUMMY ENTRY NOT CHAINED, 14640000 BZ APPAAB3 BRANCH TO INDICATE UNRCHBLE 14660000 MVC IOBDADAD,C17 OTHERWISE, RESTART CHAN PROG 14680000 LA R12,C11 WITH NEW SRCH ADDRESS 14700000 STH R12,IOBSTART+1 14720000 SRL R12,16 14740000 STC R12,IOBSTART 14760000 B APPRVXCP RETURN TO IOS 14780000 * ABNORMAL END 14800000 APPAEJ2 TM IOBSENSE+1,X'04' FILE PROTECT 25000 14820018 BZ APPAAA3 BRANCH IF NO. 14840000 LA R12,C10+8 TEST STOP AT C10 14860000 L R13,IOBCSW 14880000 LA R13,0(R13) 14900000 CLR R12,R13 BRANCH TO INDICATE UNREACHABLE 14920000 BNE APPAAB3 IF NO. 14940000 AIF ('&LIB' EQ 'LIB1').NOTAOS7 14942001 APPAOSJ4 EQU * * 14944001 .NOTAOS7 ANOP 14946001 TM C9+7,X'20' IF DUMMY OR INACTIVE 25000 14950018 * RECORD 25000 14960018 BO APPAEC3 BRANCH TO SAME PROCEDURE AS 14980000 LA R12,C11 CHANNEL END 15000000 STH R12,IOBSTART+1 OTHERWISE, RESTART CHAN PROG 15020000 SRL R12,16 15040000 STC R12,IOBSTART 15060000 B APPAEG2 15100000 * 15120000 * CHANNEL END APP CODE O,1 (CP4,5) CHART AB 15140000 USING CP4,R10 15160000 APPABA2 EQU * S20201 15180020 L R12,IOBCSW CP STOP ADDR 15200001 LA R12,0(R12) CLEAR HI BYTE 15210001 SR R12,R10 OFFSET OF CCW 15212001 * 15212103 CL R12,APPHCA23 STOP AT CCW CA23 SA65011 15212203 BNE NOTCA23 BRANCH IF NO SA65011 15212303 TM DECBTYP2,READKU READ K FOR UPDATE SA65011 15212703 BZ NOTCA23 BRANCH IF NO SA65011 15213103 CLI CA24,RDSECT CA24 READ SECTOR CCW SA65011 15214703 BE APPABF3 BR IF YES - SET UNREACH SA65011 15215103 * BLK, ASYN CODE OF 4 SA65011 15215503 NOTCA23 EQU * CONTINUE - CP OK SA65011 15215603 AIF ('&LIB' EQ 'LIB1').NOTAOS4 15216003 CL R12,APPHCA10 STOP AT CA10 15217203 BNE APPAOSA2 NO 15218803 TM CA10+K5,CC WAS CA10 COMMAND CHAINED 15220403 BZ APPAOSA2 NO 15222003 OI CA10+K4,CC TURN CC BACK ON 15223603 NI CA10+K5,CCOFF TURN INDICATOR OFF 15225203 CLI CA14,SEEKHH CA14 SEEK HEAD 15226803 BNE APPAOS21 NO, FILE PROTECT 15228403 MVC IOBDADAD,CA12+K7 RESET IOBSEEK 15230003 LA R12,CA16A RESET IOBSTART TO 15231603 ST R12,IOBSTART-K1 START AT CA16A 15233201 B APPRVXCP GO DO AN EXCP 15243201 APPAOSA2 EQU * * 15245201 .NOTAOS4 ANOP 15245601 NI DECBEXC1,NOT-OFLORCD DECB EXCEP SET=NOT S20201 15246701 * OFLORCD S20201 15260020 MVC IOBDADAD+K5(K3),CA25+K5 S20201 15360020 APPABB3 MVI IOBASYN,X'00' B3 ASYNC CD SET=0 (G CP4,5,6) 15580000 APPABSAR LA R14,BYP(R14) SCHEDULE ASYNCH ROUTINE 15924 15600016 L R13,CVTPTR 15620000 USING IHACVTEX,R13 15640000 L R13,CVTEXEF 15660000 BR R13 15680000 * ABNORMAL END APP CODE 0,1 (CP4,5) CHART AB 15700000 * 15720000 APPABD2 EQU * 19374 15727000 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 15734000 BO APPABD21 BRANCH IF SO 19374 15741000 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 15748000 BC PERRYES,APPABD3 YES--BRANCH 19374 15755000 B APPRVNOR NO--RETRY CHANNEL PROGRAM 19374 15762000 APPABD21 EQU * 19374 15769000 L R12,IOBCSW E2 YES STOP AT CA14 TEST 15780000 LA R12,0(R12) 15800000 SR R12,R10 15820000 CL R12,APPHCA14 15840000 BNE APPABF3 NO F3 15860000 AIF ('&LIB' EQ 'LIB1').NOTAOS5 15870001 APPAOS21 EQU * * 15872001 .NOTAOS5 ANOP 15874001 TM CA13+7,X'20' F2 YES DUMMY OR INAC TEST 15880000 BO APPABF1 YES F1 15900000 MVC IOBDADAD,CA12+7 G2 NO CA12+7 TO IOBDADAD 15920000 MVC CA34+7(8),CA12+7 CA12+7 TO CA34+7 15940000 LA R12,IOBDADAD+3 G1 ADIOBDADAD(CCHH)TO CA26 15960000 ST R12,CA26 15980000 MVI CA26,X'31' 16000000 MVC CA28+1(3),DECBKEY+1 H1 DECBKEY+1 TO CA28 AD 16020000 CLI IOBAPP,CODE0 TEST FOR A READ S20201 16040020 BE APPABJ2 READ J2 16060000 LA R12,CA40 K1 WRITE CA30 TIC TO CA40 16080000 STH R12,CA30+2 16100000 SRL R12,16 16120000 STC R12,CA30+1 16140000 L R12,DECBAREA K2 AREA+6 TO CA40 AD 16160000 LA R12,6(R12) 16180000 ST R12,CA40 16200000 MVI CA40,X'06' 16220000 MVC CA43+1(3),CA40+1 K3 AREA+6 TO CA43 AD 16240000 LA R13,CA43+6 LENGTH+10 TO CA43 CNT 16260000 APPABK2 MVI CA28,SKEQ SCH EQ FOR WRITE S20201 16270020 APPABK4 TM DECBTYP1,X'02' DECBLGTH SPECIFIED{ 16280000 BZ APPABK4A YES K4A 16300000 LH R12,DCBLRECL NO USE DCBLRECL 16320000 B APPABK4B 16340000 APPABK4A LH R12,DECBLGTH DECB LENGTH OVERRIDING 16360000 APPABK4B LA R12,10(R12) 16380000 STH R12,0(R13) 16400000 APPABK5 MVI IOBAPP,CODE5 SET CODE 5 FOR CP6 S20201 16420020 LA R12,CA26 J5 AD CA26 TO IOBSTART 16440000 IC R13,IOBSIOCC 16460000 ST R12,IOBSIOCC 16480000 STC R13,IOBSIOCC 16500000 MVI IOBFLAG1,X'42' H5 RESTORE IOB FLAGS AND ERR CTR 16520000 MVI IOBFLAG2,X'00' CC AND UNRELATED FLAGS ON 16540000 MVI IOBCSW,X'00' OTHERS OFF 16560000 XC IOBERRCT,IOBERRCT 16580000 SR R12,R12 G5 TEST OFLO SAME VOLUMN 16600000 IC R12,IOBDADAD 16620000 SLL R12,4 16640000 L R12,DEBUCBAD(R12) 16660000 LA R7,0(R7) 16680000 LA R12,0(R12) 16700000 CLR R7,R12 16720000 BE APPRVXCP IF SAME, EXCP RET TO IOS 16740000 MVI IOBASYN,X'01' G4 NO ASYNC CD SET=1 (EXCP) 16760000 B APPABSAR SAR 16780000 APPABJ2 LA R12,CA31 J2 CA30 TIC TO CA31 16800000 STH R12,CA30+2 16820000 SRL R12,16 16840000 STC R12,CA30+1 16860000 L R12,DECBAREA AREA+6 TO CA31 ADDRESS 16880000 LA R12,6(R12) 16900000 ST R12,CA31 16920000 MVI CA31,X'06' 16940000 LA R13,CA31+6 LENGTH+10 TO CA31 COUNT 16960000 SR R12,R12 S20201 16962020 AH R12,DCBRKP RKP=0 S20201 16964020 BNZ APPABJ4 BIF NOT = 0 S20201 16966020 TM DCBRECFM,BLOCKED RECFM=BLOCKED S20201 16968020 BZ APPABK2 BIF NOT BLOCKED S20201 16970020 APPABJ4 MVI CA28,SKEQHI SCH EQHI FOR (READ AND S20201 16972020 * RKP NE 0 S20201 16974020 * OR (READ AND RKP=0 AND BLKD) 16976020 B APPABK4 K4 16980000 APPABF1 CLI DCBNLEV,X'00' F1 DCBNLEV=0{ 17000000 BE APPABD5 YES D5 17020000 APPABF3 OI DECBEXC1,X'04' F3 NO DECB EXCEP SET=UNREACHABLE 17040000 APPABG3 MVI IOBASYN,X'04' G3 ASYNC CD SET=4(NG CP4,5,6) 17060000 B APPABSAR SAR 17080000 APPABD3 EQU * 17110016 TM IOBSENSE+1,X'08' NO RECORD FOUND 16072 17140016 BZ APPABB1 NO--BRANCH 16072 17160016 APPABE4 L R12,IOBCSW E4 STOP AT CA21 TEST 17200000 LA R12,0(R12) 17220000 SR R12,R10 17240000 CL R12,APPHCA20 S20201 17260020 BNE APPABF3 NO F3 17280000 CLI CA21,X'69' D4,C4 READ FORMAT BLOCKED TEST 17300000 BE APPABF3 YES F3 17320000 APPABD5 OI DECBEXC1,X'80' D5 NO DECB EXCEP SET=NO RCD FND 17340000 B APPABG3 G3 17360000 APPABB1 L R12,IOBCSW B1 STOP AT CA23 17380000 LA R12,0(R12) 17400000 SR R12,R10 17420000 CL R12,APPHCA23 17440000 BNE APPABF3 NO F3 17460000 APPABD1 OI DECBEXC1,X'08' D1 YES DECB EXCEP SET=UNCOR IO ER 17520000 B APPABG3 G3 17540000 * 17560000 * CHANNEL END APP CODE 5 (CP6) CHART AC 17580000 USING CP4,R10 17600000 APPACA2 L R12,IOBCSW A2 TEST STOP AT CA31 17620000 LA R12,0(R12) 17640000 SR R12,R10 17660000 CL R12,APPHCA31 NON-RPS HALT. S20201 17670020 BE APPACA6 BIF HALT ON CA31 S20201 17673020 CL R12,APPCA31B RPS HALT. S20201 17676020 BNE APPACA3 BIF NO HALT HERE. S20201 17679020 B APPACA6A COMPARE KEYS SA65011 17681003 * 17681403 APPACA6 TM DECBTYP2,READKU READ K FOR UPDATE SA65011 17681503 BZ APPACA6A BRANCH IF NO SA65011 17681603 TM CA31+4,CC CA31 COMMAND CHAINED SA65011 17681803 BO APPABF3 BR IF YES - SET UNREACH SA65011 17681903 * BLK, ASYN CODE OF 4 SA65011 17685303 APPACA6A CLI CA28,SKEQHI SEARCH HI USED. SA65011 17689003 BNE APPACA8 BIF NOT S20201 17692403 * COMPARE KEYS. IF THE RECORD'S KEY IS HIGHER, TERMINATE 17695803 * THE SEARCH OF THE OVERFLOW CHAIN. 17699203 IC R9,CA28+K7 GET KEY LENGTH. S20201 17702603 BCTR R9,R0 EXECUTED LENGTH S20201 17706003 L R12,CA28 GET KEY ADDR. S20201 17709403 L R13,CA31 GET DATA ADDR. S20201 17712803 AH R13,DCBRKP FIND THE KEY IN THE S20201 17716203 * RECORD. S20201 17719603 LA R13,K10(R13) KEY FOUND. S20201 17723003 EX R9,COMPARE CHECK FOR MATCH. S20201 17726403 BNE APPACG3 BIF NO MATCH. S20201 17729803 APPACA8 EQU * S20201 17733203 CLC CA34+7(8),CA12+7 FIRST RECORD IN CHAIN OY00310 17736603 BE APPACB3 YES B3 17740000 L R12,DCBRORG3 NO ADD 1 TO DCBRORG3 17760000 LA R12,1(R12) 17780000 ST R12,DCBRORG3 17800000 TM DECBTYP2,X'20' B2 TEST READ FOR UPDATE 17820000 BZ APPACB3 NO B3 17840000 MVC IOBDADAD,CA34+7 YES IOBDADAD SET FOR WRITEBACK 17860000 APPACB3 OI DECBEXC1,X'02' B3 DECB EXCEP SET=OFLO RCD 17880000 MVI IOBASYN,X'00' B4 ASYNC CD SET=0 (G CP4,5,6) 17900000 B APPABSAR SAR 17920000 APPACA3 CL R12,APPHCA43 A3 STOP AT CA43 TEST 17940000 BNE APPACF4 NO F4 17960000 B APPACB3 YES B3 17980000 * 18000000 * ABNORMAL END APP CODE 5 (CP6) CHART AC 18020000 * 18040000 APPACE2 EQU * 19374 18047000 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 18054000 BO APPACE21 YES--BRANCH 19374 18061000 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 18068000 BC PERRYES,APPACE3 YES--BRANCH 19374 18075000 B APPRVNOR NO--RETRY CHANNEL PROGRAM 19374 18082000 APPACE21 EQU * 19374 18089000 L R12,IOBCSW F2 YES STOP AT CA36 TEST 18100000 LA R12,0(R12) 18120000 SR R12,R10 18140000 CL R12,APPHCA36 18160000 BNE APPACF4 NO F4 18180000 AIF ('&LIB' EQ 'LIB1').NOTAOS6 18190001 CLI CA36,SEEKHH CA36 SET TO SEEK HEAD 18192001 BNE APPAOSE2 NO 18194001 MVC IOBDADAD,CA34+K7 RESET IOBSEEK 18196001 B APPRVXCP GO DO AN EXCP 18198001 APPAOSE2 EQU * * 18198401 .NOTAOS6 ANOP 18198801 TM CA35+7,X'08' G2 YES END OR CHAINED TEST 18200000 BZ APPACG3 END G3 18220000 MVI IOBASYN,X'01' J2 ASYNC CD SET=1 (EXCP) 18320000 MVI IOBFLAG1,X'42' J3 RESTORE IOB FLAGS AND ERR CTR 18340000 MVI IOBFLAG2,X'00' CC AND UNRELATED FLAGS ON 18360000 MVI IOBCSW,X'00' OTHERS OFF 18380000 XC IOBERRCT,IOBERRCT 18400000 MVC IOBDADAD,CA34+7 SET SEEK SEARCH ADDRESS 18420000 B APPABSAR SAR 18440000 APPACE3 EQU * 18470016 L R12,IOBCSW E4 YES TEST STOP AT CA31 OR CA43 18500000 LA R12,0(R12) 18520000 SR R12,R10 18540000 CL R12,APPHCA31 18560000 BE APPACE5 YES E5 18580000 CL R12,APPHCA43 18600000 BE APPACE5 YES E5 18620000 APPACF4 OI DECBEXC1,X'04' F4 NO DECB EXCEP SET=UNREACHABLE 18640000 APPACG4 MVI IOBASYN,X'04' G4 ASYNC CD SET=4(NG CP4,5,6) 18660000 B APPABSAR SAR 18680000 APPACG3 OI DECBEXC1,X'80' G3 DECB EXCEP SET=NO RCD FND 18700000 B APPACG4 G4 18720000 APPACE5 TM IOBSENSE,X'08' E5 DATA CHK{ 18740000 BZ APPACF4 NO F4 18760000 OI DECBEXC1,X'08' F5 YES DECB EXCEP SET=UNCOR IO ER 18780000 B APPACG4 G4 18800000 * CHART AD CHANNEL END + NORMAL END CP7 18820000 * CHANNEL END 18840000 USING CP7,R10 18860000 APPADB2 LA R13,CA46+8 TEST STOP AT CA46 18880000 L R12,IOBCSW 18900000 LA R12,0(R12) 18920000 CLR R12,R13 18940000 BNE APPADB3 18960000 MVI IOBASYN,X'02' IF SO, SET ASYN CODE AND BRANCH 18980000 B APPABSAR SCHEDULE ASYN ROUTINE 19000000 APPADB3 OI DECBEXC1,X'04' IF NOT, INDICATE UNREACHABLE IN 19020000 APPADB4 MVI IOBASYN,X'06' DECB AND SET ASYNCH CODE 19040000 B APPABSAR SCHEDULE ASYNCH ROUTINE 19060000 * ABNORMAL END 19080000 APPADE2 TM IOBECBAD,PERRMASK IF NOT PERM ERR, 19100000 BO APPRVNOR NO, NORM IOS RETURN 15924 19120016 LA R12,CA46+8 IF STOP AT CA46 AND 19140000 L R13,IOBCSW CAUSE IN NOT DATA CHECK, 19160000 LA R13,0(R13) OR IF STOP NOT AT CA46 19180000 CLR R13,R12 GO TO APPADB3 19200000 BNE APPADB3 19220000 TM IOBCSW+5,X'08' 19240000 BZ APPADB3 19260000 OI DECBEXC1,X'08' DATA CHECK, SET IO UNCORRTABLE 19280000 B APPADB4 ERROR BIT IN DECB 19300000 APPRVXCP SR R12,R12 19320000 IC R12,IOBDADAD GET BB 19340000 SLL R12,4 19360000 LA R12,32(R12,R3) 19380000 MVC IOBDADAD+1(2),4(R12) 19400000 LA R14,EXCP(R14) SETUP FOR EXCP IOS RETURN 15924 19405016 XC IOBFLAG2(3),IOBFLAG2 CLEAR FLAG2,SENSE BYTES 15924 19410016 XC IOBCSW(9),IOBCSW CLEAR FLAG3,CSW,AND SIOCC 15924 19415016 XC IOBERRCT(2),IOBERRCT CLEAR ERROR COUNT 15924 19420016 NI IOBFLAG1,X'C2' RESET FLAG1 15924 19425016 APPRVNOR BR R14 RETURN TO IOS 15924 19430016 COMPARE CLC K0(K1,R12),K0(R13) EXECUTED INSTRUCTION S20201 19435020 EJECT 19440000 APPN3B3 EQU APPM1B3 LABELS USED IN COMMON ROUTINE TO 19460000 APPN3B5 EQU APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 19480000 CVTPTR EQU 16 ADDR COMMUNICATION VECTOR TABLE 19500000 CODE0 EQU 0 CHAN PGM 4-5 APPEND CODE S20201 19500920 CODE5 EQU 5 CHAN PGM 6 APPEND CODE S20201 19501820 CODE8 EQU 8 CHAN PGM 8 APP CODE S20201 19502720 CODE9 EQU 9 CHAN PGM 10A APP CODE S20201 19503620 CODE10 EQU 10 CHAN PGM 10B APP CODE S20201 19504520 CODE11 EQU 11 CHAN PGM 10B APP CODE S20201 19505420 CODE14 EQU 14 CHAN PGM 15 APP CODE S20201 19506320 CODE17 EQU 17 CHAN PGM 17 APP CODE S20201 19507220 CODE18 EQU 18 CHAN PGM 17 APP CODE S20201 19508120 CODE19 EQU 19 CHAN PGM 17 APP CODE S20201 19509020 CVTZDTAB EQU X'40' CVT'S DEV CHAR TABLE PTR 23596 19510018 MERLIN EQU X'09' DEVICE CODE S20201 19515020 * 19520000 * 19540000 * DATA EVENT CONTROL BLOCK 19560000 IHADECB DSECT 19580000 DS 0F 19600000 DECBECB DS CL4 EVENT CONTROL BLOCK (ECB) 19620000 DECBTYP1 DS BL1 TYPE B6 - 1 IF LENGTH IS S 19640000 * B7 - 1 IF AREA IS S 19660000 DECBTYP2 DS BL1 B0 - 1 IF READ K 19680000 * B1 - 1 IF READ KX 19700000 * B2 - 1 IF READ KU 19720000 * B4 - 1 IF WRITE K 19740000 * B5 - 1 IF WRITE KN 19760000 DECBLGTH DS CL2 LENGTH OF BLOCK 19780000 DECBDCBA DS A POINTER TO DCB 19800000 DECBAREA DS A ADDRESS OF AREA 19820000 DECBLOGR DS A POINTER TO LOGICAL RECORD 19840000 DECBKEY DS A POINTER TO KEY 19860000 DECBEXC1 DS BL1 EXCPTN CD B0-RECORD NOT FOUND 19880000 * B1-RECORD LGTH CHK 19900000 * B3-INVALID REQUEST 19920000 * B4-UNCORRECTABLE IO 19940000 * B5-UNREACHABLE BLOCK 19960000 * B6-OVERFLOW RECORD 19980000 * B7-DUPLICATE REC 20000000 DECBEXC2 DS BL1 B7-READ KU 20020000 DCBD DSORG=(IS) 20040000 IHAIOB IGGIOBD 20110020 CPSTART EQU IOBSTART-1 S20201 20180020 IHADCW IGGBISAM 20380020 IHADEB IGGDEBD 20680020 IHACVTEX DSECT COMMUNICATION VECTOR TABLE 22060000 DS A 22080000 CVTEXEF DS A 22100000 * READ K, READ KU, AND WRITE K CHANNEL PGMS(NO WRITE CHK) 22200020 IHACP47 IGGCP47 22500020 * WRITE KEY NEW CHANNEL PROGRAM REFERENCES (NO WRITE CHECK) 22900020 IHAWKNCP IGGWKNCP 23300020 IGGCP12C 23700020 IGGCP12A 24000020 END 25540000 ./ ADD SSI=10010235,NAME=IGG019GO,SOURCE=0 TITLE 'IGG019GO - APPENDAGES-PART 2,COMBINED,WITH WRT CHK' 00070020 COPY LCGASMSW 00120001 IGG019GO CSECT 00140020 * 00210020 * 00280020 * RELEASE 23 DELETIONS/CHANGES 00350020 * RELEASE 22 DELETIONS/CHANGES 00420020 AIF ('&LIB' EQ 'LIB1').LIB2GO0 00470003 * VS1 RELEASE 3 DELETIONS * 00480003 * XL03145 00482003 * VS APARS OX02338 AND OY02194 ARE FLAGGED AS SA65011. 00482403 .LIB2GO0 ANOP 00484003 * RELEASE 21 DELETIONS/CHANGES 00490020 *C677700 SA62417 00540021 *D657800 SA65011 00550003 *C751100 SA65011 00552003 * RELEASE 20 DELETIONS * 00560020 *0568090200,105900-106000 A34932 00630020 *0568200200-200800 A34619 00700020 *0568090320 M3299 00770020 * S20201 00790020 * 00810020 * THIS MODULE WAS REWRITTEN IN RELEASE 20.2 TO 00840020 * UTILIZE CHANNEL PROGRAM AND WORK AREA 00910020 * MACRO EXPANSIONS 00980020 * 01050020 *STATUS CHANGE LEVEL 010 01120020 * FUNCTION/OPERATION' APPENDAGE ROUTINES FOR BISAM 01190020 * WHEN READ AND UPDATE IS USED WITH WRITE KN, 01260020 * WHEN WRITE VALIDITY CHECKING IS REQUESTED, 01330020 * (PART 2) 01400020 * CEND - IF CHANNEL PROGRAM ENDS 01470020 * **WITHOUT ERROR, EITHER 01540020 * PROCESSING COMPLETION WILL BE SCHEDULED, 01610020 * PROCESSING CONTINUATION WILL BE SCHEDULED, 01680020 * OR PROCESSING WILL CONTINUE. 01750020 * **WITH A LENGTH CHECK, TESTS DETERMINE WHETHER 01820020 * OR NOT TO TREAT THE SITUATION AS A REAL 01890020 * ERROR. 01960020 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 02030020 * BLOCK' IS INDICATED IN THE DECB, AND 02100020 * PROCESSING COMPLETION WILL BE SCHEDULED. 02170020 * 02240020 * ABEND - IF CHANNEL PROGRAM ENDS ABNORMALLY BECAUSE OF 02310020 * **PERMANENT ERROR, 'UNCORRECTABLE I/O ERROR' 02380020 * IS INDICATED IN THE DECB, AND PROCESSING 02450020 * COMPLETION WILL BE SCHEDULED. 02520020 * USE OF WRITE VALIDITY CHECKING OPTION 02590020 * ALLOWS A LIMITED NUMBER OF RE-EXECUTIONS 02660020 * BEFORE INDICATING AN ERROR. 02730020 * **NON-PERMANENT ERROR, ONE RE-TRY IS MADE 02800020 * BEFORE INDICATING A PERMANENT ERROR. 02870020 * **FILE PROTECTION, TESTS DETERMINE WHETHER 02940020 * OR NOT TO TREAT THE SITUATION AS A REAL 03010020 * ERROR. 03080020 * **ANY OTHER ERROR, IN GENERAL, 'UNREACHABLE 03150020 * BLOCK' IS INDICATED IN THE DECB, AND 03220020 * PROCESSING COMPLETION WILL BE SCHEDULED. 03290020 * 03360020 * ENTRY POINTS- 03430020 * ENTRY POINT FUNCTION 03500020 * ANY POINT IN THE VECTOR TABLE AT THE BEGINNING OF THE MODULE. 03570020 * INPUT - N/A 03640020 * OUTPUT - N/A 03710020 * EXTERNAL ROUTINES - N/A 03780020 * EXITS 1. RETURN TO IOS VIA THE APPENDAGE RETURN VECTOR TABLE POINTED 03850020 * TO BY REGISTER 14. SEE THE DSECT LABELED APPRV FOR THE 03920020 * FORMAT OF THIS TABLE AND THE USE OF EACH EXIT. 03990020 * 2. SCHEDULE AN ASYNCHRONOUS ROUTINE - BRANCH VIA THE EXIT 04060020 * EFFECTOR ADDRESS IN THE COMMUNICATION VECTOR TABLE. 04130020 * TABLES/WORK AREAS ' DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB, 04200020 * COMMUNICATION VECTOR TABLE. 04270020 * SEE DSECTS AT END OF MODULE FOR FORMAT AND DESCRIPTIONS. 04340020 * ATTRIBUTES- REENTRANT. DISABLED. 04410020 * NOTES - NONE 04480020 * GENERAL REGISTERS ARE USED AS FOLLOWS 04550020 R0 EQU 0 * ----- 04620020 R1 EQU 1 * 12* ADDRESS 04690020 R2 EQU 2 * IOB 04760020 R3 EQU 3 * DEB 04830020 R4 EQU 4 * DCB 04900020 R5 EQU 5 * ----- 04970020 R6 EQU 6 * ----- 05040020 R7 EQU 7 * UCB 05110020 R8 EQU 8 * ----- 05180020 R9 EQU 9 # WORK REGISTER 05250020 R10 EQU 10 CHANNEL PROGRAM POINTER 05320020 R11 EQU 11 DECB 05390020 R12 EQU 12 WORK REGISTER 05460020 R13 EQU 13 WORK REGISTER 05530020 R14 EQU 14 IOS RETURN VECTOR TABLE 05600020 R15 EQU 15 BASE REGISTER 05670020 * * MEANS THIS REGISTER IS SET UP UPON ENTRY FROM IOS, 05740020 * AND ITS CONTENTS MUST BE RESTORED UPON RETURN TO IOS 05810020 * # MEANS THIS REGISTER MAY BE CHANGED, BUT UPON RETURN TO IOS 05880020 * MUST CONTAIN ZEROES IN THE THREE HIGH ORDER BYTES 05950020 PERRMASK EQU X'20' TO TEST FOR PERMANENT ERROR, TEST 06020020 PERRYES EQU 8 IOBECBAD, B2. IF OFF (CONDITION CODE 8) 06090020 PERRNO EQU 7 THERE IS A PERM ERR. ELSE B2 ON ( CD 7) 06160020 NORECFND EQU X'08' NO RECORD FOUND SENSE BIT 19323 06230020 BYP EQU 12 RETURN TO IOS/BYPASS 15924 06300020 EXCP EQU 8 RETURN TO IOS/EXCP 15924 06370020 NORMAL EQU 0 RETURN TO IOS/NORMAL 15924 06440020 K0 EQU 0 S20201 06510020 K1 EQU 1 S20201 06580020 K2 EQU 2 S20201 06650020 K3 EQU 3 S20201 06720020 K4 EQU 4 S20201 06790020 K5 EQU 5 S20201 06860020 K6 EQU 6 S20201 06930020 K7 EQU 7 S20201 07000020 K10 EQU 10 S20201 07070020 NOT EQU 255 S20201 07140020 OFLORCD EQU 2 S20201 07210020 DATACHK EQU 8 S20201 07280020 TWOBYTES EQU 16 S20201 07350020 BLOCKED EQU X'10' S20201 07420020 NRF EQU 8 S20201 07490020 MIS EQU PERRMASK MASTER IDX SRCH MASK 07540001 CCOFF EQU X'BF' TURN OFF CC MASK 07550001 READKU EQU X'20' READ KEY FOR UPDATE SA65011 07552003 USING IHAIOB,R2 S20201 07560020 USING IHADEB,R3 S20201 07630020 USING IHADCB,R4 07700020 USING IHAWKNCP,R10 07770020 USING IHADECB,R11 07840020 USING IHADCW,R12 07910020 USING IGG019GO,R15 BASE 07980020 USING IHACVTEX,R13 CVT 08050020 * VECTOR TABLE. BRANCH TO THE ROUTINE SELECTED IN THE 08120020 * APPENDAGE ROUTINE, PART 1. 08190020 * ROUTINE FOR CODE CEND COMPLETION OF 08260020 LR R15,R13 08330020 B APPM67CE 7 CP1 OR CP2 FOR WRITE KN 08400020 LR R15,R13 08470020 B APPN7B2 9,23 CP10AW 08540020 LR R15,R13 08610020 B APPN8A2 10,11 CP10BW 08680020 LR R15,R13 08750020 B APPM4A2 12 CP14W - SETUPS 1, 2, OR 5 08820020 LR R15,R13 08890020 B APPM5A2 13 CP14W - SETUPS 3, 4, OR 6 08960020 LR R15,R13 09030020 B APPM2B2 15 CP16 - SITUATION 2 09100020 LR R15,R13 09170020 B APPM3B2 16 CP16 - SITUATION 3 09240020 LR R15,R13 09310020 B APPN9A2 17,18,19 CP17W 09380020 LR R15,R13 17332 09450020 B APPAFB CP14 PART2 17332 09520020 * ROUTINE FOR CODE ABEND COMPLETION OF 09590020 LR R15,R13 09660020 B APPM67AE 7 CP1 OR CP2, WRITE KN 09730020 LR R15,R13 09800020 B APPJ3B2 9,23 CP10AW 09870020 LR R15,R13 09940020 B APPJ4B2 10,11 CP10BW 10010020 LR R15,R13 10080020 B APPJ5B2 12 CP14W - SETUPS 1, 2, OR 5 10150020 LR R15,R13 10220020 B APPJ6B2 13 CP14W - SETUPS 3, 4, OR 6 10290020 LR R15,R13 10360020 B APPM2H2 15,16 CP16 10430020 LR R15,R13 10500020 B APPJ7B2 17,18,19 CP17W 10570020 LR R15,R13 17332 10640020 B APPAEB CP14 PART2 17332 10710020 B APPN7A3 CONTINUE ROUTINES BEGUN IN 10780020 B APPN7B4 PART 1 10850020 * ROUTINE FOR CODE CEND COMPLETION OF 10920020 LR R15,R13 10990020 B APPABA2 0,1 CP4/CP5W 11060020 LR R15,R13 11130020 B APPADB2 2 CP7W 11200020 LR R15,R13 11270020 B APPAAB2 3 CP1 OR CP2, READ AND UPDATE 11340020 LR R15,R13 11410020 B APPACA2 5 CP6W 11480020 DC 3H'0' INVALID CODE 6 S20201 11550020 * ROUTINE FOR CODE ABEND COMPLETION OF 11620020 LR R15,R13 11690020 B APPABD2 0,1 CP4/CP5W 11760020 LR R15,R13 11830020 B APPAIB2 2 CP7W 11900020 LR R15,R13 11970020 B APPAAA2 3 CP1 OR CP2, READ AND UPDATE 12040020 LR R15,R13 12110020 B APPACE2 5 CP6W 12180020 DC 3H'0' INVALID CODE 6 S20201 12250020 * BRANCH TO M6 OR M7 12320020 APPM67CE L R13,DCBWKPT2 CHAN END OF CP1 OR CP2 12390020 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 12460020 BE APPM6B2 CYLINDER - M6 (CP2) 12530020 B APPM7A2 MASTER - M7 (CP1) 12600020 APPM67AE L R13,DCBWKPT2 ABNORMAL END OF CP1 OR CP2 12670020 CLI 11(R13),X'01' NLSD=1 MEANS NO MAST IX 12740020 BE APPM6J4 CYLINDER - M6 (CP2) 12810020 B APPM7J2 MASTER - M7 (CP1) 12880020 EJECT 12950020 * CHART M7 CP1 FOR WRITE KN, CODE 7 13020020 * CHANNEL END 13090020 APPM7A2 EQU * 13160020 LA R13,C6+8 13230020 CLR R12,R13 TEST STOP AT C6 - END OF SEARCH 13300020 BE APPM7B2 OF MASTER INDEX. BRANCH IF YES 13370020 LA R13,C16+8 13440020 CLR R12,R13 TEST STOP AT C16 - END OF SRCH 13510020 BNE APPN3B3 OF CYLINDER INDEX. BRANCH NO 13580020 TM C18,X'20' END OF CYLINDER SEARCH. 13650020 BZ APPM7C4 TEST FOR DUMMY OR INACTIVE 13720020 TM C18,X'08' 13790020 BZ APPM7B3 BRANCH IF INACTIVE OR DUMMY-END 13860020 MVC IOBDADAD,C17 DUMMY CHAINED. 13930020 LA R12,C10A RESTART CP TO SEARCH CYL S20201 14000020 STH R12,IOBSTART+1 INDEX ON CHAIN. 14070020 SRL R12,16 14140020 STC R12,IOBSTART 14210020 B APPRVXCP RETURN TO IOS TO EXCP 14280020 APPM7C4 MVC IOBDADAD(7),C17 ACTIVE. 14350020 APPM7C4A MVI IOBDADAD+7,X'00' SET UP IOB FOR CP8 14420020 MVI IOBAPP,CODE8 M--R IS ADDR FOUND, R=0 S20201 14490020 L R10,DCBWKPT3 GET STARTING ADDR OF CP8 S20201 14560020 ST R10,CPSTART STORE IN IOB AS CP START S20201 14630020 ST R10,IOBCCWAD AND FOR USE AS BASE REG S20201 14700020 MVC CB23+K3(K5),IOBDADAD+K3 CCHH OF FIRST TRACK, R=0 S20201 14770020 OC CB23+K5(K3),DCBFIRSH SET HHR TO FIRSH S20201 14840020 MVI IOBFLAG1,X'42' APP CODE 8 14910020 LA R12,IOBDADAD+3 INITIALIZE CP8 14980020 STH R12,CB1+2 CB1 SET TO SEEK CCHHR OF IOB 15050020 SRL R12,16 15120020 STC R12,CB1+1 15190020 MVC CB5+1(3),DECBKEY+1 CB5, CB15, CB19 ALL SET TO 15260020 MVC CB19+1(3),DECBKEY+1 15330020 APPM7G4 SR R12,R12 CHECK WITH DEB TO SEE IF NEXT 15400020 IC R12,IOBDADAD ADDRESS ON SAME MODULE 15470020 SLL R12,4 15540020 L R12,32(R3,R12) 15610020 LA R12,0(R12) 15680020 CLR R12,R7 15750020 BE APPRVXCP IF SO, EXECUTE CP RETURN TO IOS 15820020 MVI IOBASYN,X'01' IF NOT, SCHEDULE ASYNCHRONOUS 15890020 B APPN3B5 ROUTINE TO EXCP 15960020 APPM7B2 EQU * * 16030001 AIF ('&LIB' EQ 'LIB1').NOTAOS1 16080001 TM C6+K5,CC WAS C6 CHAINED 16090001 BZ APPAOS1 NO, CONTINUE 16092001 NI C6+K5,CCOFF TURN OFF INDICATOR 16094001 OI C6+K4,CC RECHAIN C6 16096001 B APPAOSJ3 RESCHEDULE CP1 16098001 APPAOS1 EQU * * 16098401 .NOTAOS1 ANOP 16098801 TM C9+K7,MIS END MASTER INDEX SEARCH. 16099201 BZ APPM7C2 TEST FOR DUMMY OR INACTIVE 16100020 APPM7B3 TM C9+7,X'08' 16170020 BO APPM7E2 BRANCH IF INACTIVE OR DUMMY-END 16240020 IC R12,C9+7 DUMMY CHAINED. 16310020 SLL R12,29 IF LEVEL INDEX NOT HIGHEST LVL, 16380020 IC R13,DCBNLEV ERROR OF SOME SORT 16450020 SLL R13,29 16520020 CLR R12,R13 16590020 BNE APPN3B3 16660020 * ALWAYS DO CP15 16730020 APPM7E3 MVI IOBAPP,CODE14 TRK FULL--CP15 CODE S20201 16800020 MVC IOBDADAD(3),DCBLPDA SET UP IOB FOR CP15 16870020 MVC IOBDADAD+3(4),DCBLETI APP CODE 14,MOVE FR LETI CCHH 16940020 MVI IOBDADAD+7,X'00' ZERO R 17010020 OC IOBDADAD+6(1),DCBFIRSH+3 17080020 XC IOBDADAD+6(1),DCBFIRSH+3 INCREMENT TO A CYL BOUNDRY 17150020 L R10,DCBWKPT3 HHR ZERO 17220020 ST R10,IOBCCWAD START ADDR CI1 17290020 LA R12,CI1 REL CCW 0 CP8 17360020 ST R12,IOBSTART-1 FLAGS INDICATE CC, NO DC 17430020 MVI IOBFLAG1,X'42' 17500020 LA R12,IOBDADAD+3 INITIALIZE CP15 17570020 STH R12,CI1+2 CI1 POINTS TO IOB CCHHR 17640020 SRL R12,16 17710020 STC R12,CI1+1 17780020 MVC CI5+K2(K5),DCBLETI COUNT ADDR S20201 17850020 MVC CI5(K2),DCBLPDA+K1 MOVE IN BB FOR HEAD SEEK S20201 17920020 B APPM7G4 BRANCH TO EXCP 17990020 APPM7C2 TM C9+7,X'04' ACTIVE ENTRY. 18060020 BO APPM7E2 IF LVL 2 MAST IND JUST SRCHED 18130020 OI C6+4,X'40' CC ON TO CHN FROM LVL 1 TO CYL 18200020 APPM7E2 MVC IOBDADAD,C8+7 SEEK ADDR IN IOB IS FND ADDR 18270020 NI IOBFLAG1,X'7F' B0 OFF NO DC 18340020 OI IOBFLAG1,X'40' B1 ON YES DC 18410020 B APPRVXCP RETURN TO IOS TO EXCP 18480020 EJECT 18550020 * ABNORMAL END 18620020 APPM7J2 EQU * 19374 18690020 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 18760020 BO APPM7J3 YES--BRANCH 19374 18830020 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 18900020 BC PERRYES,APPN3B3 YES--BRANCH 19374 18970020 BR R14 NO--RETRY CHANNEL S20201 19040020 * PROGRAM 1937 S20201 19110020 APPM7J3 LA R13,C10+8 FILE PROTECT 19180020 CLR R12,R13 19250020 BNE APPN3B3 BRANCH IF STOP NOT AT C10 19320020 AIF ('&LIB' EQ 'LIB1').NOTAOS2 19370001 APPAOSJ3 EQU * * 19380001 .NOTAOS2 ANOP 19382001 MVI IOBFLAG1,X'42' RESTORE IOBFLAGS & ERR CTR 19390020 MVI IOBFLAG2,X'00' UNRELATED FLAG ON 19460020 MVI IOBCSW,X'00' OTHERS OFF 19530020 XC IOBERRCT,IOBERRCT 19600020 TM C9+7,X'20' 19670020 BO APPM7B3 BRANCH IF DUMMY OR INACTIVE 19740020 LA R12,C10A SET UP IOB TO RESTART S20201 19810020 ST R12,IOBSTART-1 19880020 B APPM7E2 BRANCH 19950020 EJECT 20020020 * M6 - CP2 FOR WRITE KN, CODE 7 20090020 * CHANNEL END 20160020 APPM6B2 LA R13,C35+8 B2 STOP AT C350 20230020 CLR R12,R13 20300020 BNE APPN3B3 NO 20370020 TM C37,X'20' C2 DUMMY OR INACTIVE{ 20440020 BZ APPM6D2 NO D2 20510020 TM C37,X'28' C3 DUMMY CHAINED{ 20580020 BO APPM6D3 YES D3 20650020 TM DCBNLEV,X'01' C4 NLEV=F{ F MUST BE 1 20720020 BZ APPN3B3 NO 20790020 B APPM7E3 20860020 APPM6D2 MVC IOBDADAD(7),C36 D2 C36 MBBCCHH 20930020 B APPM7C4A 21000020 APPM6D3 MVC IOBDADAD,C36 D3 C36 MBBCCHHR 21070020 B APPRVXCP E3 EXCP RETURN TO IOS 21140020 EJECT 21210020 * ABNORMAL END 21280020 APPM6J4 TM IOBECBAD,PERRMASK J4 PERMANENT ERROR TEST 21350020 BC PERRYES,APPN3B3 YES B3 21420020 BR R14 NORMAL RETURN TO IOS S20201 21490020 EJECT 21560020 * CHANNEL END APP CODES 9&23 (CP10A) CHART N7 21630020 APPN7B2 LA R13,CB50C+8 TEST STOP AT CB50C 21700020 CLR R12,R13 21770020 BNE APPM1B3 NO M1B3 21840020 APPN7A3 L R12,DCBWKPT2 YES SET SAME MODULE SWITCH ON 21910020 OI DCWWKNI,X'20' 21980020 IC R9,IOBDADAD+7 B3 ADD 1 TO R IN IOB 22050020 LA R12,1(R0,R9) 22120020 STC R12,IOBDADAD+7 22190020 STC R12,DCBLPDA+7 PUT NEW R IN LPDA 11081 22260020 APPN7B4 CLI DCBHIRSH,X'00' ARE ALL TRACKS UNSHARED 11081 22330020 BE APPN7C4 YES C4 22400020 IC R9,DCBLPDA+6 IS THIS TRK SHARED 22470020 IC R12,DCBFIRSH+3 AND H AND MASK TO GET 22540020 NR R9,R12 REAL TRK NO. 22610020 EX R9,CLIFIRSH EXECUTE THE COMPARE 22680020 BNE APPN7C4 NO C4 22750020 CLC DCBHIRSH,DCBLPDA+7 YES HIRSH R = LPDA R { 22820020 BNE APPN7C2 NO C2 22890020 APPN7D3 IC R9,IOBDADAD+6 IS THIS LAST 22960020 IC R12,DCBFIRSH+3 23030020 NR R12,R9 DATA TRACK OF THIS 23100020 EX R12,CLILDT CYLINDER 23170020 BE APPN7D4 YES, GO FIND NEXT CYL 23240020 LA R9,1(0,R9) NO, 23310020 STC R9,IOBDADAD+6 ADD 1 TO TRACK 23380020 MVI IOBDADAD+7,X'00' E2 NO SET IOB R TO ZERO 23450020 APPN7G2 TM DCBST,X'02' G2 LAST BLOCK FULL{ 23520020 BZ APPN7C2 NO C2 23590020 OI DCBST,X'01' G3 YES SET LAST TRACK FULL SW ON 23660020 B APPN7C2 23730020 APPN7D4 SR R12,R12 23800020 IC R12,IOBDADAD FIND CURRENT 23870020 SLL R12,4 EXTENT 23940020 AR R12,R3 24010020 OC IOBDADAD+6(1),DCBFIRSH+3 SET TRACK TO MAX 24080020 CLC IOBDADAD+6(1),DEBENDHH+1-IHADEB(R12) LAST TRACK IN EXT 24150020 BNL APPCCH YES 24220020 IC R9,IOBDADAD+6 24290020 LA R9,1(0,R9) ONLY THE 2301 WILL GO THIS PATH 24360020 STC R9,IOBDADAD+6 TO ADD 1 TO CLYINDER 24430020 B APPN7G4 24500020 APPCCH CLC IOBDADAD+3(3),DEBENDCC-IHADEB(R12) LAST CYL OF 24570020 BL APPN7E4A EXTENT (CCH) 24640020 IC R9,IOBDADAD 24710020 LA R9,1(0,R9) PUT NEW M IO IOB 24780020 STC R9,IOBDADAD 24850020 LA R12,16(0,R12) ACCESS NEXT EXTENT INTRY IN DEB 24920020 MVC IOBDADAD+1(6),DEBBINUM-IHADEB(R12) MOVE NEW BBCCHH 24990020 L R13,DEBUCBAD-IHADEB(R0,R12) IS NEW CYL ON SAME MODULE 25060020 LA R13,0(R0,R13) 25130020 CLR R13,R7 25200020 BE APPN7G4 YES G4 25270020 L R12,DCBWKPT2 F5 NO SET SAME MOD SW OFF 25340020 NI DCWWKNI,X'DF' 25410020 B APPN7G4 G4 25480020 APPN7E4A MVI IOBDADAD+K6,K0 SET TRACK TO ZERO S20201 25550020 AIF ('&LIB' NE 'LIB1').LIB2GO1 25600003 CLI DCBDEVT,MERLIN IS CYL A TWO BYTE FIELD S20201 25620020 BNE APPN7E4B NO, BR--BYTE ADDRESSING S20201 25690020 .LIB2GO1 ANOP 25740003 IC R13,IOBDADAD+K3 PICK UP C1 OF CC S20201 25760020 SLL R13,8 SHIFT S20201 25830020 IC R13,IOBDADAD+K4 PICK UP C2 OF CC S20201 25900020 LA R13,K1(R0,R13) ADD ONE TO CYL VALUE S20201 25970020 STC R13,IOBDADAD+K4 RESTORE C2 S20201 26040020 SRL R13,8 SHIFT S20201 26110020 STC R13,IOBDADAD+K3 RESTORE C1 S20201 26180020 AIF ('&LIB' NE 'LIB1').LIB2GO2 26230003 B APPN7G4 GO SET TO FIRSH-1'S HR S20201 26250020 APPN7E4B L R13,CVTPTR GET CVT ADDRESS S20201 26320020 IC R9,DCBDEVT PICK UP DEVICE TYPE. 23596 26390020 L R13,CVTZDTAB(0,R13) POINT TO DEVICE TABLE. 23596 26460020 IC R9,0(R9,R13) LOCATE PROPER ENTRY. 23596 26530020 LA R12,2(R9,R13) SET INDEX TO H OF CCH. 23596 26600020 LA R13,IOBDADAD+5 R13=A(H OF CHANGE FIELD). 23596 26670020 ADDONE IC R9,0(0,R13) ADD ONE TO SOME BYTE 23596 26740020 LA R9,1(0,R9) OF CCH. 23596 26810020 STC R9,0(0,R13) 23596 26880020 CLC 0(1,R13),0(R12) IS THE NEW VALUE VALID? 23596 26950020 BL APPN7G4 YES, BRANCH. 23596 27020020 MVI 0(R13),0 NO, ZERO THIS BYTE. 23596 27090020 BCTR R12,0 DECREMENT BOTH INDICES 23596 27160020 BCT R13,ADDONE AND TRY NEXT BYTE. 23596 27230020 .LIB2GO2 ANOP 27280003 APPN7G4 OC IOBDADAD+6(1),DCBFIRSH+1 27300020 IC R9,DCBFIRSH+2 27370020 BCTR R9,0 27440020 STC R9,IOBDADAD+7 27510020 B APPN7G2 27580020 CLILDT CLI DCBLDT+1,0 27650020 CLIFIRSH CLI DCBFIRSH+1,0 27720020 APPN7C4 CLC DCBHIRPD,DCBLPDA+7 C4 HIRPD R = LPDA R { 27790020 BE APPN7D3 YES D3 27860020 APPN7C2 MVC CB55(4),IOBDADAD+3 C2 NO 27930020 IC R9,IOBDADAD+7 28000020 LA R12,1(R0,R9) 28070020 STC R12,CB55+4 28140020 MVI IOBFLAG1,X'42' SET B1 ON (CC) 28210020 LA R12,CB52 SET IOB START TO CP10B 28280020 ST R12,IOBSTART-1 28350020 LA R13,IOBDADAD+3 28420020 STH R13,CB52+2 28490020 SRL R13,16 28560020 STC R13,CB52+1 28630020 CLI IOBAPP,CODE9 IS APPENDAGE CODE 9 S20201 28700020 BE APPN7E1 YES E1 28770020 MVI IOBAPP,CODE11 SET APPENDAGE CODE TO 11 S20201 28840020 APPN7F1 L R12,DCBWKPT2 F1 SAME MODULE SW ON{ 28910020 TM DCWWKNI,X'20' 28980020 MVC CB54A+1(3),CB52+1 WRITE CHECK SEARCH 29050020 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 29120020 BO APPRVXCP YES EXCP RETURN TO IOS 29190020 MVI IOBASYN,X'01' NO SET ASYNC CODE 1 29260020 B APPM1B5 SCHED ASYNC ROUTINE 29330020 APPN7E1 MVI IOBAPP,CODE10 SET APPENDAGE CODE TO 10 S20201 29400020 B APPN7F1 F1 29470020 EJECT 29540020 * CHART J3, ABNORMAL END APP CODE9,23(CP10AW) 29610020 APPJ3B2 EQU * 29680020 TM IOBECBAD,PERRMASK PERMANENT ERROR 29750020 BCR PERRNO,R14 NO,NORM IOS S20201 29820020 TM IOBSENSE,X'08' YES DATA CHECK 29890020 BZ APPM1B3 29960020 LA R13,CB50C+8 TEST STOP AT CB50C 30030020 CLR R12,R13 30100020 BE APPJ3E3 YES E3 30170020 LA R13,CB48+8 STOP AT CB48? 30240020 CLR R12,R13 30310020 BE APPJ3E3 YES E3 30380020 LA R13,CB49+8 STOP AT CB49? 30450020 CLR R12,R13 30520020 BE APPJ3E3 YES E3 30590020 LA R13,CB50+8 STOP AT CB50? 30660020 CLR R12,R13 30730020 BNE APPM1B3 NO N3B3 30800020 APPJ3E3 OI DECBEXC1,X'08' E3 YES IND UNCOR I/O ERROR 30870020 B APPM1B4 N3B4 30940020 EJECT 31010020 * CHANNEL END APP CODES 10&11(CP10B)CHARTN8 31080020 APPN8A2 LA R13,CB54C+8 TEST STOP AT CB54C 31150020 CLR R12,R13 31220020 BNE APPM1B3 NO M1B3 31290020 TM CB53+4,X'20' EOF FOR CP14? 13270 31360020 BO APPM426 17332 31430020 L R12,DCBNREC 31500020 LA R12,1(R0,R12) 31570020 ST R12,DCBNREC ADD 1 TO PRIME COUNT 31640020 CLI IOBAPP,CODE10 IS APPENDAGE CODE 10 S20201 31710020 BE APPM1B4 YES M1B4 31780020 MVI IOBAPP,CODE18 NO, SET APP CODE TO 18 S20201 31850020 OI IOBFLAG1,X'C0' SET B0&B1 ON (CC&DC) 31920020 LA R12,CK1 SET IOB START TO CP17 31990020 ST R12,IOBSTART-1 32060020 MVC IOBDADAD+3(5),DCBLETI SET SEEK ADDR IN IOB 32130020 MVC IOBDADAD(3),DCBLPDA 32200020 LA R12,IOBDADAD+3 D2 INITIALIZE CP17 32270020 ST R12,CK1 32340020 MVI CK1,X'31' 32410020 ST R12,CK4 32480020 MVI CK4,X'31' 32550020 ST R12,CK7A PUT IOB ADDR IN CK7A 32620020 MVI CK7A,X'31' 32690020 MVC CK6+1(3),DECBKEY+1 32760020 B APPM7G4 32830020 EJECT 32900020 * CHART J4, ABNORMAL END APP CODE 10,11(CP10BW) 32970020 APPJ4B2 EQU * 33040020 TM IOBECBAD,PERRMASK PERMANENT ERROR 33110020 BCR PERRNO,R14 NO,NORMAL IOS RETURN S20201 33180020 TM IOBSENSE,X'08' YES DATA CHECK 33250020 BZ APPM1B3 33320020 LA R13,CB54C+8 TEST STOP AT CB54C 33390020 CLR R12,R13 33460020 BE APPJ4E3 YES E3 33530020 LA R13,CB54+8 STOP AT CB54? 33600020 CLR R12,R13 33670020 BNE APPM1B3 NO N3B3 33740020 APPJ4E3 OI DECBEXC1,X'08' E3 YES IND UNCOR I/O ERROR 33810020 B APPM1B4 N3B4 33880020 EJECT 33950020 * CHANNEL END APP CODES 17,18,19 (CP17) CHART N9 34020020 APPN9A2 LA R13,CK1 CP START MAY HAVE BEEN A34932 34090020 * CHANGED A34932 34160020 ST R13,IOBSTART-1 FOR RETRY ON ERROR. A34932 34230020 LA R13,CK7C+8 A2 STOP AT CK70 M3299 34300020 CLR R12,R13 34370020 BNE APPM1B3 NO M1B3 34440020 CLI CK9,X'00' A3 TEST F IN CK9 34510020 BE APPN9B3 NORMAL TRACK INDEX 34580020 CLI CK9,X'08' 34650020 BE APPN9B3 SHARED 34720020 APPN9B2 EQU * 34790020 L R12,DCBWKPT2 34860020 CLI IOBAPP,CODE17 IS APPENDAGE CODE 17 S20201 34930020 BE APPM1B4 YES M1B4 35000020 CLI IOBAPP,CODE18 IS APPENDAGE CODE 18 S20201 35070020 BE APPN9C2 YES C2 35140020 CLC DCWNLEVC,DCBNLEV E2 NO (19)NLEV CTR = DCBNLEV³ 35210020 BE APPN9F1 YES 35280020 IC R13,DCWNLEVC G2 NO ADD 1 TO NLEV COUNTER 35350020 LA R13,1(R0,R13) 35420020 STC R13,DCWNLEVC 35490020 CLI DCWNLEVC,X'02' H2 NLEV COUNTER = 2{ 35560020 BE APPN9E3 YES E3 35630020 CLI DCWNLEVC,X'03' NO NLEV COUNTER = 3{ 35700020 BE APPN9F3 YES F3 35770020 MVC IOBDADAD+3(5),DCBLEMI3 G3 SET SEEK ADDR TO LEMI3 35840020 CLI DCBFTMI3+1,X'00' 35910020 BE *+14 35980020 MVC IOBDADAD(1),DCBFTMI3+1 36050020 B APPN9C5 36120020 MVC IOBDADAD(1),DCBFTMI3 36190020 B APPN9C5 C5 36260020 APPN9E3 MVC IOBDADAD+3(5),DCBLEMI1 E3 SET SEEK ADDR TO LEMI1 36330020 CLI DCBFTMI1+1,X'00' 36400020 BE *+14 36470020 MVC IOBDADAD(1),DCBFTMI1+1 36540020 B APPN9C5 36610020 MVC IOBDADAD(1),DCBFTMI1 36680020 B APPN9C5 C5 36750020 APPN9F3 MVC IOBDADAD+3(5),DCBLEMI2 F3 SET SEEK ADDR TO LEMI2 36820020 CLI DCBFTMI2+1,X'00' 36890020 BE *+14 36960020 MVC IOBDADAD(1),DCBFTMI2+1 37030020 B *+10 37100020 MVC IOBDADAD(1),DCBFTMI2 37170020 XC IOBDADAD+1(2),IOBDADAD+1 37240020 B APPN9C5 C5 37310020 APPN9B3 CLI CB26,X'10' B3 TEST F IN CB26 37380020 BNE APPN9B2 NOT OVERFLOW END 37450020 MVC IOBDADAD+3(5),CB24 C3 OVERFLOW ENTRY 37520020 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 37590020 B APPRVXCP C4 EXCP RETURN TO IOS 37660020 APPN9F1 TM DCWHIAV,X'40' HIGH IND IN CORE? 37730020 BZ APPN9H1 NO H1 37800020 L R12,DCWMSHIL G1 YES CHNG KEY OF LST CORE INDEX 37870020 L R11,DECBKEY 37940020 IC R9,DCBKEYLE 38010020 LA R13,0(R0,R9) 38080020 BCTR R13,R0 38150020 EX R13,APPN9G1A 38220020 APPN9H1 MVI IOBASYN,X'08' H1 SET ASYNC CODE 8 38290020 B APPM1B5 SCHED ASYNC ROUTINE 38360020 APPN9C2 CLI DCBNLEV,X'00' C2 DCBNLEV = 0 { 38430020 BE APPM1B4 YES M1B4 38500020 L R12,DCBWKPT2 R12 ADDRESS DCB WA 38570020 MVI DCWNLEVC,X'01' D2 NO SET NLEV COUNTER TO 1 38640020 MVC IOBDADAD+3(5),DCBLECI D3 SET SEEK ADDR TO LECI 38710020 CLI DCBFTCI+1,X'00' 38780020 BE *+14 38850020 MVC IOBDADAD(1),DCBFTCI+1 38920020 B APPMVI 38990020 MVC IOBDADAD(1),DCBFTCI 39060020 APPMVI MVI IOBAPP,CODE19 SET APPENDAGE CODE TO 19 S20201 39130020 OI IOBFLAG1,X'C0' SET B0&B1 ON (CC&DC) 39200020 LA R12,CK1 SET IOBSTART TO CK1 39270020 ST R12,IOBSTART-1 39340020 APPN9C5 MVI IOBASYN,X'01' C5 SET ASYNC CODE 1 39410020 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 39480020 B APPM1B5 SCHED ASYNC ROUTINE 39550020 EJECT 39620020 * CHART J7, ABNORMAL END APP CODE17,18,19(CP17W) 39690020 APPJ7B2 EQU * 39760020 TM IOBECBAD,PERRMASK PERMANENT ERROR 39830020 BC PERRYES,APPJ7B7 A34932 39900020 * THIS IS A FIRST ENTRY ON AN ERROR. 39970020 LA R11,CK4 TEST FOR STOP PRIOR TO A34932 40040020 * CK4 A34932 40110020 CLR R12,R11 DID IT STOP BEFORE CK4? A34932 40180020 BNH APPRVNOR BIF YES. RETRY FROM CK1. A34932 40250020 ST R11,IOBSTART-1 RETRY FROM CK4 A34932 40320020 B APPRVNOR RETURN TO IOS. A34932 40390020 APPJ7B7 TM IOBSENSE,X'08' UNCORRECTABLE I/O ERROR A34932 40460020 BZ APPM1B3 40530020 LA R13,CK7C+8 40600020 CLR R12,R13 40670020 BNE APPM1B3 40740020 APPJ7E3 OI DECBEXC1,X'08' E3 YES IND UNCOR I/O ERROR 40810020 B APPM1B4 N3B4 40880020 EJECT 40950020 APPN9G1A MVC 0(0,R12),0(R11) 41020020 EJECT 41090020 * COMMON ROUTINE TO SCHEDULE ASYNCHRONOUS ROUTINE 41160020 APPM1B3 OI DECBEXC1,X'04' B3 SET DECB EXCD TO UNRCHABLE 41230020 APPM1B4 MVI IOBASYN,X'08' B4 SET ASYNC CODE TO 8 41300020 APPM1B5 LA R14,BYP(R14) SCHEDULE ASYNCH ROUTINE 15924 41370020 L R13,CVTPTR 41440020 L R13,CVTEXEF 41510020 BR R13 41580020 EJECT 41650020 * CHANNEL END APP CODE 15 (CP16) CHART M2 41720020 APPM2B2 LA R13,CJ10+8 TEST STOP AT CJ10 41790020 CLR R12,R13 41860020 BNE APPM1B3 NO M1B3 41930020 L R12,DCBMSWA C2 YES OFLO END ENTRY? 42000020 TM 8(R12),X'08' 42070020 BZ APPM2D3 YES D3 42140020 MVC IOBDADAD,0(R12) E2 NO SET SEEK ADDR FROM LINK 42210020 B APPM7G4 42280020 APPM2D3 MVC CJ11,IOBDADAD D3 PUT SEEK ADDR IN CJ11 42350020 MVI IOBASYN,X'0B' SET ASYNC CODE 11 42420020 NI IOBINDCT,X'DF' SET B2-OFLO RCD FR AREA 42490020 B APPM1B5 SCHED ASYNC ROUTINE 42560020 EJECT 42630020 * ABNORMAL END APP CODES 15,16,(CP16) CHART M2 42700020 APPM2H2 TM IOBECBAD,PERRMASK H2 PERMANENT ERROR TEST 42770020 BCR PERRNO,R14 NO CONTINUE, NORMAL IOS S20201 42840020 B APPM1B3 YES M1B3 42910020 EJECT 42980020 * CHANNEL END APP CODE 16 (CP16) CHART M3 43050020 APPM3B2 LA R13,CJ10+8 TEST STOP AT CJ10 43120020 CLR R12,R13 43190020 BNE APPM3B3 NO - TRY CJ9 S20201 43260020 MVC CJ11,IOBDADAD SAVE SEEK ADDR IN CJ11 43330020 L R12,DCBMSWA D2 YES SET IOB SEEK FROM LINK 43400020 MVC IOBDADAD,0(R12) 43470020 L R12,DCBWKPT2 E2 SET FIRST TIME ONLY SW OFF 43540020 NI DCWWKNI,X'BF' 43610020 B APPM7G4 GO TO TEST DEB 43680020 APPM3B3 LA R13,CJ9+L'CJ9 STOP AT CJ9 43750020 CLR R12,R13 S20201 43820020 BNE APPM3B4 NO - TRY CJ8 S20201 43890020 MVC CJ11,IOBDADAD SAVE SEEK ADDR IN CJ11 43960020 TM DCBOPTCD,X'02' C3 YES DELETE OPTION{ 44030020 BZ APPM3C4 NO C4 44100020 L R12,DCBMSWA D3 YES RCD MARKED FOR DELETION{ 44170020 LA R13,10(R0,R12) 44240020 CLI 0(R13),X'FF' 44310020 BNE APPM3C4 NO C4 44380020 MVI IOBASYN,X'0E' E3 YES SET ASYNC CODE 14 44450020 APPM3E4 NI IOBINDCT,X'DF' E4 SET B2-OFLO RCD FR AREA 44520020 B APPM1B5 E5 SCHED ASYNC ROUTINE 44590020 APPM3C4 OI DECBEXC1,X'01' C4 SET EXCEP CODE TO IND DUPL 44660020 MVI IOBASYN,X'08' D4 SET ASYNC CODE 8 44730020 B APPM1B5 SCHED ASYNC ROUTINE 44800020 APPM3B4 LA R13,CJ8+L'CJ8 SEE IF STOPPED AT CJ8 44870020 CLR R12,R13 S20201 44940020 BNE APPM1B3 IF NOT, UNREACHABLE BLK S20201 45010020 L R12,DCBWKPT2 C5 YES FIRST TIME ONLY SW ON{ 45080020 TM DCWWKNI,X'40' 45150020 BO APPM3B5 YES B5 45220020 MVI IOBASYN,X'0C' D5 NO SET ASYNC CODE 12 45290020 B APPM3E4 E4 45360020 APPM3B5 MVI IOBASYN,X'0D' B5 SET ASYNC CODE 13 45430020 MVC IOBDADAD(7),CJ11 RESTORE TRK INDEX MBBCCHH 45500020 B APPM3E4 45570020 EJECT 45640020 * CHANNEL END APP CODE 12 (CP14) CHART M4 45710020 APPM4A2 LA R13,CH18C+8 DID CHAN PROG STOP AT CH18C 45780020 APPM4A21 EQU * 13270 45850020 TM CB53+4,X'20' EOF WRITTEN 13270 45920020 BZ APPM4A22 BRANCH IF NO 13270 45990020 MVC IOBDADAD,DCBLIOV INITIALIZE IOBDADAD SEEK 13270 46060020 MVC DCBLIOV(3),CH23 RESET LIOV FROM 13270 46130020 MVC DCBLIOV+3(5),CH24 CP14 13270 46200020 CLR R12,R13 13270 46270020 BNE APPM1B3 B = UNREACHABLE 13270 46340020 MVI IOBFLAG1,X'42' CC SET ON 13270 46410020 MVI IOBAPP,CODE10 SET APPENDAGE CODE 10 S20201 46480020 LA R12,CB52 13270 46550020 ST R12,IOBSTART-1 13270 46620020 LA R13,IOBDADAD+3 13270 46690020 STH R13,CB52+2 13270 46760020 SRL R13,16 13270 46830020 STC R13,CB52+1 13270 46900020 MVC CB54A+1(3),CB52+1 WRITE CHECK SEARCH 13270 46970020 SR R13,R13 16384 47040020 IC R13,IOBDADAD GET M 16384 47110020 SLL R13,4 TIMES 16 16384 47180020 LA R13,32(R3,R13) ALLOW FOR BASIC DEB TOO 16384 47250020 L R12,0(0,R13) GET UCB POINTER 16384 47320020 LA R12,0(0,R12) ZERO HIGH ORDER BYTE 16384 47390020 CR R7,R12 SAME UNIT 16384 47460020 BE APPRVXCP YES--EXCP RETURN 16384 47530020 MVI IOBASYN,X'01' NO--SET ASYNCH CODE = 1 16384 47600020 B APPM1B5 SCHEDULE ASYNCHRONOUS RTN 16384 47670020 APPM426 CLI CK9+7,12 INSERT TO MIDDLE OVFL CH 17332 47740020 MVI CB53+4,X'00' RESET EOF FLAG 17332 47810020 BE APPM1B4 IF YES POST COMPLETION 17332 47880020 APPM4A22 EQU * 13270 47950020 CLR R12,R13 13270 48020020 BNE APPM1B3 B = UNREACHABLE 13270 48090020 TM CH8E+4,X'40' TEST FOR UWA 17332 48160020 BZ APPM425 IF NO-BRANCH 17332 48230020 NI CH8E+4,X'42' RESET FLAG 17332 48300020 CLI CK9+7,14 ASYN CODE=14 17332 48370020 BE APPM1B4 IF YES-POST COMPLETION 17332 48440020 CLI CK9+7,9 ASYN CODE=9 17332 48510020 BE APPM4A23 IF YES BRANCH 17332 48580020 MVI IOBAPP,X'04' SET UP CP14 PART2 17332 48650020 MVC IOBSTART,CH21+4 TO UPDATE TRACK 17332 48720020 MVC IOBDADAD,CH14 RESTORE IOBSEEK 17332 48790020 MVI CH14,X'03' SET NOP IN CH14 17332 48860020 MVI CH14+4,X'20' 17332 48930020 MVI CH14+7,X'01' 17332 49000020 B APPN9C5 17332 49070020 APPM4A23 MVI IOBCOUNT,X'01' ERROR COUNT=1 17332 49140020 MVC IOBDADAD(3),CB10+7 IOBSEEK ADDR 17332 49210020 MVC IOBDADAD+3(5),CB23+3 17332 49280020 IC R12,IOBDADAD+7 REDUCE R BY 1 17332 49350020 BCTR R12,R0 17332 49420020 STC R12,IOBDADAD+7 17332 49490020 TM DCBRECFM,X'10' TEST FOR BLOCKED 17332 49560020 BO APPM424 IF YES-BRANCH 17332 49630020 L R12,CH6+4 RESTORE 10 BYTES 17332 49700020 L R13,DECBAREA USED FOR LINK FIELD IN 17332 49770020 MVC 0(10,R12),0(R13) OVFL RECORD 17332 49840020 APPM424 MVC IOBSTART,CD2+5 START OF CP12B 17332 49910020 MVI IOBAPP,X'15' APP CODE 15 17332 49980020 OI IOBFLAG1,X'C0' 17332 50050020 B APPN9C5 17332 50120020 APPM425 L R12,DCBWKPT2 17332 50190020 TM DCWWKNI,X'10' IS ADD-TO-END INDICATOR ON 50260020 BZ APPM1B4 NO - SCHEDULE COMPLETION 50330020 APPM4C2 MVC CK6+1(3),DECBKEY+1 IF SO, SET ADDR OF CK6 TO DECB KEY 50400020 LA R12,IOBDADAD+3 SET UP CP17 50470020 STH R12,CK1+2 50540020 SRL R12,16 50610020 STC R12,CK1+1 50680020 MVC CK4+1(3),CK1+1 50750020 MVC CK7A+1(3),CK1+1 50820020 B APPN9C2 BRANCH 50890020 EJECT 50960020 * CHART J5, ABNORMAL END APP CODE 12 (CP14W) 51030020 APPJ5B2 EQU * 19374 51100020 TM IOBSENSE+1,X'04' FILE PROTECT 15924 51170020 BO APPJ5I2 YES, BRANCH 15924 51240020 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 51310020 BCR PERRNO,R14 NO--RETRY CHAN PGM S20201 51380020 * 1937 S20201 51450020 TM IOBSENSE,X'08' YES DATA CHECK 51520020 BZ APPM1B3 51590020 LA R13,CH3C+8 TEST STOP AT CH3C 51660020 CLR R12,R13 51730020 BE APPJ5D2 YES D2 51800020 LA R13,CH8C+8 STOP AT CH8C? 51870020 CLR R12,R13 51940020 BE APPJ5D2 YES D2 52010020 LA R13,CH13C+8 STOP AT CH13C? 52080020 CLR R12,R13 52150020 BE APPJ5D2 YES D2 52220020 LA R13,CH18C+8 STOP AT CH18C? 52290020 CLR R12,R13 52360020 BE APPJ5D2 YES D2 52430020 LA R13,CH16+8 STOP AT CH16? 52500020 CLR R12,R13 52570020 BE APPJ5E3 YES E3 52640020 LA R13,CH17+8 STOP AT CH17? 52710020 CLR R12,R13 52780020 BE APPJ5E3 YES E3 52850020 LA R13,CH18+8 STOP AT CH18? 52920020 CLR R12,R13 52990020 BNE APPM1B3 NO N3B3 53060020 APPJ5D2 EQU * 53130020 APPJ5E3 OI DECBEXC1,X'08' E3 YES IND UNCOR I/O ERROR 53200020 B APPM1B4 N3B4 53270020 APPJ5I2 LA R13,CH14+8 DID CHAN PROG STOP AT CH14 53340020 L R12,IOBCSW CSW = STOP ADDRESS PLUS 8 53410020 LA R12,0(R0,R12) CLEAR HIGH ORDER ZERO 53480020 CLR R12,R13 BE MEANS YES, BNE MEANS NO 53550020 BNE APPM1B3 NO - RECORD IS UNREACHABLE 53620020 MVC IOBDADAD,CH23 MOVE CH23 MBBCCHHR TO IOB 53690020 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH15 53760020 MVI IOBASYN,X'01' 53830020 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 53900020 EJECT 53970020 * CHART M5 COMPLETION OF CP14, CODE 13 54040020 * CHANNEL END 54110020 APPM5A2 LA R13,CH22C+8 DID CHAN PROG STOP AT CH22C 54180020 B APPM4A21 54250020 EJECT 54320020 * CHART J6, ABNORMAL END APP CODE 13 (CP14W) 54390020 APPJ6B2 EQU * 19374 54460020 TM IOBSENSE+1,X'04' FILE PROTECT? 15924 54530020 BO APPJ6I2 YES, BRANCH 15924 54600020 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 54670020 BCR PERRNO,R14 NO--RETRY CHAN PGM S20201 54740020 * 1937 S20201 54810020 TM IOBSENSE,X'08' YES DATA CHECK 54880020 BZ APPM1B3 54950020 LA R13,CH3C+8 TEST STOP AT CH3C 55020020 CLR R12,R13 55090020 BE APPJ6D2 YES D2 55160020 LA R13,CH8C+8 STOP AT CH8C? 55230020 CLR R12,R13 55300020 BE APPJ6D2 YES D2 55370020 LA R13,CH13C+8 STOP AT CH13C? 55440020 CLR R12,R13 55510020 BE APPJ6D2 YES D2 55580020 LA R13,CH18C+8 STOP AT CH18C? 55650020 CLR R12,R13 55720020 BE APPJ6D2 YES D2 55790020 LA R13,CH22C+8 STOP AT CH22C? 55860020 CLR R12,R13 55930020 BE APPJ6D2 YES D2 56000020 LA R13,CH16+8 STOP AT CH16? 56070020 CLR R12,R13 56140020 BE APPJ6E3 YES E3 56210020 LA R13,CH17+8 STOP AT CH17? 56280020 CLR R12,R13 56350020 BE APPJ6E3 YES E3 56420020 LA R13,CH18+8 STOP AT CH18? 56490020 CLR R12,R13 56560020 BE APPJ6E3 YES E3 56630020 LA R13,CH22+8 STOP AT CH22? 56700020 CLR R12,R13 56770020 BNE APPM1B3 NO N3B3 56840020 APPJ6D2 EQU * 56910020 APPJ6E3 OI DECBEXC1,X'08' E3 YES IND UNCOR I/O ERROR 56980020 B APPM1B4 N3B4 57050020 APPJ6I2 LA R13,CH19+8 DID CHAN PROG STOP AT CH19 57120020 L R12,IOBCSW CSW = STOP ADDRESS PLUS 8 57190020 LA R12,0(R0,R12) CLEAR HIGH ORDER ZERO 57260020 CLR R12,R13 BE MEANS YES, BNE MEANS NO 57330020 BNE APPJ5I2 NO - BRANCH TO TEST FOR CH14 57400020 MVC IOBDADAD,CJ11 MOVE CJ11 MBBCCHHR TO IOB 57470020 MVC IOBSTART,IOBCSW+1 RESUME PROCESSING AT CH20 57540020 MVI IOBASYN,X'01' 57610020 B APPM1B5 EXCP IN ASYNCHRONOUS ROUTINE 57680020 EJECT 57750020 * READ AND UPDATE APPENDAGE MODULES ********* 57820020 APPHCA14 DC A(CA14-IHACP47+8) 57890020 APPHCA20 DC A(CA20-IHACP47+8) CA20 OFFSET S20201 57960020 APPHCA23 DC A(CA23-IHACP47+8) 58030020 APPHCA24 DC A(CA24-IHACP47+8) 58100020 APPHCA31 DC A(CA31-IHACP47+8) 58170020 APPCA31B DC A(CA31B-IHACP47+8) CA31B OFFSET S20201 58240020 APPHCA36 DC A(CA36-IHACP47+8) 58310020 APPHCA43 DC A(CA43-IHACP47+8) 58380020 APHCA43C DC A(CA43C-IHACP47+8) 58450020 AIF ('&LIB' EQ 'LIB1').NOTAOS3 58500001 APPHCA10 DC A(CA10-IHACP47+8) CA10 OFFSET 58510001 .NOTAOS3 ANOP 58512001 * CHANNEL END APP CODE 3 (CP2) CHART AA 58520020 USING CP2,R10 58590020 APPAAB2 L R13,DCBWKPT2 R13 ADDR DCB WA 58660020 USING IHADCW,R13 58730020 CLI DCWNLSD,X'01' BRANCH IF NLSD NOT 1, I.E. 58800020 BH APPAEB2 IF CP1 IS BEING USED 58870020 LA R13,C35+8 TEST STOP AT C35 58940020 CLR R12,R13 59010020 BNE APPAAB3 NO B3 59080020 TM C37,X'20' YES DUMMY OR INACTIVE TEST 59150020 BO APPAAC3 YES C3 59220020 MVC IOBDADAD,C36 NO C36 TO IOBDADAD 59290020 MVI IOBASYN,X'03' E2 ASYNC CD SET=3 (G CP1,2) 59360020 B APPABSAR 59430020 APPAAC3 TM C37,X'08' TEST DUMMY CHAINED 59500020 BO APPAAD3 YES D3 59570020 IC R12,C37 NO TEST NLEV PER F = DCBNLEV 59640020 NI C37,X'07' 59710020 CLC DCBNLEV,C37 59780020 STC R12,C37 59850020 BNE APPAAB3 NO B3 59920020 OI DECBEXC1,X'80' C5 YES DECB EXCEP SET=NO RCD FND 59990020 APPAAD4 MVI IOBASYN,X'07' D4 ASYNC CD SET=7 (NG CP1,2) 60060020 B APPABSAR SAR 60130020 APPAAD3 MVC IOBDADAD,C36 C36 TO IOBDADAD 60200020 B APPRVXCP EXCP RETURN TO IOS 60270020 APPAAB3 OI DECBEXC1,X'04' B3 DECB EXCEP SET=UNREACHABLE 60340020 B APPAAD4 D4 60410020 * ABNORMAL END APP CODE 3 (CP2) CHART AA 60480020 * 60550020 APPAAA2 L R13,DCBWKPT2 R13 ADDR DCB WA 60620020 CLI DCWNLSD,X'01' BRANCH IF NLSD NOT 1, I.E. 60690020 BNE APPAEJ2 IF CP1 IS BEING USED 60760020 APPAAA3 TM IOBECBAD,PERRMASK TEST PERM ERR 60830020 BCR 1,R14 NO, NORM RETURN TO IOS S20201 60900020 * 1592 S20201 60970020 B APPAAB3 YES BRANCH TO INDICATE UNRCHBLE 61040020 DROP R13 61110020 * 61180020 * CHART AE END CP1 61250020 * CHANNEL END 61320020 USING CP1,R10 61390020 APPAEB2 L R12,IOBCSW R12 ADDRESS OF FINAL CCW+8 61460020 LA R12,0(R12) WITH HIGH ORDER BYTE ZERO 61530020 LA R13,C6+8 TEST FINAL CCW EQUAL C6 61600020 CLR R12,R13 61670020 BE APPAEC2 BRANCH IF YES 61740020 LA R13,C16+8 TEST EQUAL C16 61810020 CLR R12,R13 61880020 BE APPAEC4 BRANCH IF YES 61950020 B APPAAB3 ERROR IF NO 62020020 * INTERRUPT AT C6 62090020 APPAEC2 EQU * * 62160001 AIF ('&LIB' EQ 'LIB1').NOTAOS8 62210001 TM C6+K5,CC WAS C6 CHAINED 62220001 BZ APPAOS8 NO, CONTINUE 62222001 NI C6+K5,CCOFF TURN OFF INDICATOR 62224001 OI C6+K4,CC RECHAIN C6 62226001 CLI C10,SEEKHH C10 SET TO DO SEEK HEAD 62228001 BNE APPAOSJ4 NO, FILE PROTECT 62228401 LA R13,C10A RESET IOBSTART TO 62228801 ST R13,IOBSTART-K1 RESTART AT C10A 62229201 B APPAEG2 RESCHEDULE CP1 62229601 APPAOS8 EQU * * 62229701 .NOTAOS8 ANOP 62229801 TM C9+K7,MIS END MASTER INDEX SEARCH. 62229901 BO APPAEC3 BRANCH IF YES 62230020 TM C9+7,X'04' IF LEVEL OF INDEX IS 3 62300020 BO APPAEG2 SET CC IN CP1 TO CHAIN TO 62370020 OI C6+4,X'40' SEARCH CYLINDER INDEX 62440020 APPAEG2 MVC IOBDADAD,C8+7 ADDR NEXT SRCH ADDR IN IOB 62510020 B APPRVXCP RETURN TO EXCP 62580020 * DUMMY OR INACTIVE 62650020 APPAEC3 TM C9+7,X'08' TEST DUMMY ENTRY CHAINED 62720020 BO APPAEG2 BRANCH IF YES 62790020 IC R12,C9+7 COMPARE LEVEL OF INDEX READ TO 62860020 SLL R12,29 DCB INDEX LEVEL 62930020 IC R13,DCBNLEV 63000020 SLL R13,29 63070020 CLR R12,R13 63140020 BNE APPAAB3 BRANCH IF NOT EQUAL 63210020 OI DECBEXC1,X'80' SET NO REC FND IN EXCEPTION CD 63280020 B APPAAD4 63350020 * END OF CYLINDER SEARCH 63420020 APPAEC4 TM C18,X'20' TEST DUMMY OR INACTIVE 63490020 BO APPAEC5 BRANCH IF YES 63560020 MVC IOBDADAD,C17 ADDR NEXT SRCH IN IOB 63630020 MVI IOBASYN,X'03' SET ASYNC CODE 63700020 B APPABSAR SCHEDULE ASYNCH RTN 63770020 APPAEC5 TM C18,X'08' IF DUMMY ENTRY NOT CHAINED, 63840020 BZ APPAAB3 BRANCH TO INDICATE UNRCHBLE 63910020 MVC IOBDADAD,C17 OTHERWISE, RESTART CHAN PROG 63980020 LA R12,C11 WITH NEW SRCH ADDRESS 64050020 STH R12,IOBSTART+1 64120020 SRL R12,16 64190020 STC R12,IOBSTART 64260020 B APPRVXCP RETURN TO IOS 64330020 * ABNORMAL END 64400020 APPAEJ2 TM IOBSENSE+1,X'04' FILE PROTECT 25000 64470020 BZ APPAAA3 BRANCH IF NO. 64540020 LA R12,C10+8 TEST STOP AT C10 64610020 L R13,IOBCSW 64680020 LA R13,0(R13) 64750020 CLR R12,R13 BRANCH TO INDICATE UNREACHABLE 64820020 BNE APPAAB3 IF NO. 64890020 AIF ('&LIB' EQ 'LIB1').NOTAOS7 64940001 APPAOSJ4 EQU * * 64950001 .NOTAOS7 ANOP 64952001 TM C9+7,X'20' IF DUMMY OR INACTIVE 25000 64960020 * RECORD 25000 65030020 BO APPAEC3 BRANCH TO SAME PROCEDURE AS 65100020 LA R12,C11 CHANNEL END 65170020 STH R12,IOBSTART+1 OTHERWISE, RESTART CHAN PROG 65240020 SRL R12,16 65310020 STC R12,IOBSTART 65380020 B APPAEG2 65450020 * 65520020 * CHANNEL END APP CODE 0,1 (CP4,5) CHART AB 65590020 USING CP4,R10 65660020 APPABA2 EQU * S20201 65730020 L R12,IOBCSW CP STOP ADDR 65790001 LA R12,0(R12) CLEAR HI BYTE 65792001 SR R12,R10 OFFSET OF CCW 65794001 * 65794103 CL R12,APPHCA23 STOP AT CCW CA23 SA65011 65794203 BNE NOTCA23 BRANCH IF NO SA65011 65794303 TM DECBTYP2,READKU READ K FOR UPDATE SA65011 65796303 BZ NOTCA23 BRANCH IF NO SA65011 65796403 CLI CA24,RDSECT CA24 READ SECTOR CCW SA65011 65799103 BE APPABF3 BR IF YES - SET UNREACH SA65011 65799203 * BLK, ASYN CODE OF 4 SA65011 65799303 NOTCA23 EQU * CONTINUE - CP OK SA65011 65799403 AIF ('&LIB' EQ 'LIB1').NOTAOS4 65799603 CL R12,APPHCA10 STOP AT CA10 65801603 BNE APPAOSA2 NO 65804003 TM CA10+K5,CC WAS CA10 COMMAND CHAINED 65806403 BZ APPAOSA2 NO 65808803 OI CA10+K4,CC TURN CC BACK ON 65811203 NI CA10+K5,CCOFF TURN INDICATOR OFF 65813603 CLI CA14,SEEKHH CA14 SEEK HEAD 65816003 BNE APPAOS21 NO, FILE PROTECT 65818403 MVC IOBDADAD,CA12+K7 RESET IOBSEEK 65820803 LA R12,CA16A RESET IOBSTART TO 65823201 ST R12,IOBSTART-K1 START AT CA16A 65833201 B APPRVXCP GO DO AN EXCP 65843201 APPAOSA2 EQU * * 65845201 .NOTAOS4 ANOP 65845601 NI DECBEXC1,NOT-OFLORCD DECB EXECP CD SET NOT S20201 65846701 * OFLO S20201 65870020 MVC IOBDADAD+K5(K3),CA25+K5 S20201 65940020 APPABB3 MVI IOBASYN,X'00' B3 ASYNC CD SET=0 (G CP4,5,6) 66010020 APPABSAR LA R14,BYP(R14) SCHEDULE ASYNCH ROUTINE 15924 66080020 L R13,CVTPTR 66150020 USING IHACVTEX,R13 66220020 L R13,CVTEXEF 66290020 BR R13 66360020 * ABNORMAL END APP CODE 0,1 (CP4,5) CHART AB 66430020 * 66500020 APPABD2 EQU * 19374 66570020 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 66640020 BO APPABD21 YES--BRANCH 19374 66710020 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 66780020 BC PERRYES,APPABD3 YES--INDICATE PERMANENT 19374 66850020 TM IOBSENSE,DATACHK WAS ABEND DUE TO DATA S20201 66920020 * CHECK S20201 66990020 BCR ZERO,R14 NO-NORMAL RETURN TO IOS S20201 67060020 ZERO EQU 8 TM COND CODE FOR ==ZERO S20201 67130020 LA R13,CA24C+L'CA24C TEST STOP AT 24C 67200020 CLR R12,R13 S20201 67270020 BCR NOTEQ,R14 NO-NORMAL RETURN TO IOS S20201 67340020 NOTEQ EQU 7 COMPARE COND CODE FOR S20201 67410020 * NOT EQUA S20201 67480020 LA R13,CA24D START ADDRESS = CA24D S20201 67550020 STH R13,IOBSTART+K1 S20201 67620020 SRL R13,TWOBYTES S20201 67690020 STC R13,IOBSTART S20201 67760020 MVC IOBDADAD+3(5),CA25+3 RESET IOBSEEK SA62417 67770021 BR R14 NORMAL RETURN TO IOS S20201 67830020 APPABD21 EQU * S20201 67900020 * 1937 S20201 67970020 SR R12,R10 TEST STOP AT CA14 68040020 CL R12,APPHCA14 68110020 BNE APPABF3 NO F3 68180020 AIF ('&LIB' EQ 'LIB1').NOTAOS5 68230001 APPAOS21 EQU * * 68240001 .NOTAOS5 ANOP 68242001 TM CA13+7,X'20' F2 YES DUMMY OR INAC TEST 68250020 BO APPABF1 YES F1 68320020 MVC IOBDADAD,CA12+7 G2 NO CA12+7 TO IOBDADAD 68390020 MVC CA34+7(8),CA12+7 CA12+7 TO CA34+7 68460020 LA R12,IOBDADAD+3 G1 ADIOBDADAD(CCHH)TO CA26 68530020 ST R12,CA26 68600020 MVI CA26,X'31' 68670020 MVC CA28+1(3),DECBKEY+1 H1 DECBKEY+1 TO CA28 AD 68740020 CLI IOBAPP,CODE0 TEST FOR A READ S20201 68810020 BE APPABJ2 READ J2 68880020 LA R12,CA40 K1 WRITE CA30 TIC TO CA40 68950020 STH R12,CA30+2 69020020 SRL R12,16 69090020 STC R12,CA30+1 69160020 L R12,DECBAREA K2 AREA+6 TO CA40 AD 69230020 LA R12,6(R12) 69300020 ST R12,CA40 69370020 MVI CA40,X'06' 69440020 MVC CA43+1(3),CA40+1 K3 AREA+6 TO CA43 AD 69510020 LA R13,CA43+6 LENGTH+10 TO CA43 CNT 69580020 APPABK2 MVI CA28,SKEQ SCH EQ FOR WRITE S20201 69650020 APPABK4 TM DECBTYP1,X'02' DECBLGTH SPECIFIED{ 69720020 BZ APPABK4A YES K4A 69790020 LH R12,DCBLRECL NO USE DCBLRECL 69860020 B APPABK4B 69930020 APPABK4A LH R12,DECBLGTH DECB LENGTH OVERRIDING 70000020 APPABK4B LA R12,10(R12) 70070020 STH R12,0(R13) 70140020 MVC CA43C+6(2),CA43+6 SET COUNT IN CA43C 70210020 APPABK5 MVI IOBAPP,CODE5 SET CODE 5 FOR CP6 S20201 70280020 LA R12,CA26 J5 AD CA26 TO IOBSTART 70350020 IC R13,IOBSIOCC 70420020 ST R12,IOBSIOCC 70490020 STC R13,IOBSIOCC 70560020 MVI IOBFLAG1,X'42' H5 RESTORE IOB FLAGS AND ERR CTR 70630020 MVI IOBFLAG2,X'00' CC AND UNRELATED FLAGS ON 70700020 MVI IOBCSW,X'00' OTHERS OFF 70770020 XC IOBERRCT,IOBERRCT 70840020 MVI IOBCOUNT,X'0A' INITIALIZE ERR CTR FOR 10 TRIES 70910020 SR R12,R12 G5 TEST OFLO SAME VOLUMN 70980020 IC R12,IOBDADAD 71050020 SLL R12,4 71120020 L R12,DEBUCBAD(R12) 71190020 LA R7,0(R7) 71260020 LA R12,0(R12) 71330020 CLR R7,R12 71400020 BE APPRVXCP IF SAME, EXCP RET TO IOS 71470020 MVI IOBASYN,X'01' G4 NO ASYNC CD SET=1 (EXCP) 71540020 B APPABSAR SAR 71610020 APPABJ2 LA R12,CA31 J2 CA30 TIC TO CA31 71680020 STH R12,CA30+2 71750020 SRL R12,16 71820020 STC R12,CA30+1 71890020 L R12,DECBAREA AREA+6 TO CA31 ADDRESS 71960020 LA R12,6(R12) 72030020 ST R12,CA31 72100020 MVI CA31,X'06' 72170020 LA R13,CA31+6 LENGTH+10 TO CA31 COUNT 72240020 SR R12,R12 S20201 72310020 AH R12,DCBRKP TEST IF RKP=0 S20201 72380020 BNZ APPABJ4 BIF RKP NOT =0 S20201 72450020 TM DCBRECFM,BLOCKED RECFM=BLOCKED S20201 72520020 BZ APPABK2 BIF NOT BLOCKED S20201 72590020 APPABJ4 MVI CA28,SKEQHI SCH EQ+HI FOR (READ AND S20201 72660020 * RKP NE S20201 72730020 * 0) OR (READ AND RKP=0 AND BLKD) 72800020 B APPABK4 K4 72870020 APPABF1 CLI DCBNLEV,X'00' F1 DCBNLEV=0{ 72940020 BE APPABD5 YES D5 73010020 APPABF3 OI DECBEXC1,X'04' F3 NO DECB EXCEP SET=UNREACHABLE 73080020 APPABG3 MVI IOBASYN,X'04' G3 ASYNC CD SET=4(NG CP4,5,6) 73150020 B APPABSAR SAR 73220020 APPABD3 EQU * 73290020 L R12,IOBCSW S20201 73360020 LA R12,0(R12) 73430020 SR R12,R10 73500020 TM SENSE1,NRF NO RECORD FOUND S20201 73570020 * 1607 S20201 73640020 BZ APPABB1 NO--BRANCH S20201 73710020 * 1607 S20201 73780020 CL R12,APPHCA20 STOP AT CA20 TEST S20201 73850020 BNE APPAHH2 NO H2 S20201 73920020 CLI CA21,X'69' D4,C4 READ FORMAT BLOCKED TEST 73990020 BE APPABF3 YES F3 74060020 APPABD5 OI DECBEXC1,X'80' D5 NO DECB EXCEP SET=NO RCD FND 74130020 B APPABG3 G3 74200020 APPABB1 CL R12,APPHCA23 B1 STOP AT CA23 S20201 74270020 BNE APPAHH2 NO H2 S20201 74340020 APPABD1 OI DECBEXC1,X'08' D1 YES DECB EXCEP SET=UNCOR IO ER 74410020 B APPABG3 G3 74480020 * 74550020 * CHANNEL END APP CODE 5 (CP6) CHART AC 74620020 USING CP4,R10 74690020 APPACA2 SR R12,R10 TEST STOP AT CA31 74760020 CL R12,APPHCA31 NON-RPS HALT. S20201 74830020 BE APPACA6 BIF STOP ON CA31 S20201 74900020 CL R12,APPCA31B RPS HALT. S20201 74970020 BNE APPACA3 BIF NO HALT HERE. S20201 75040020 B APPACA6A COMPARE KEYS SA65011 75090003 * 75100003 APPACA6 TM DECBTYP2,READKU READ K FOR UPDATE SA65011 75100403 BZ APPACA6A BRANCH IF NO SA65011 75100803 TM CA31+4,CC CA31 COMMAND CHAINED SA65011 75102003 BO APPABF3 BR IF YES - SET UNREACH SA65011 75104003 * BLK, ASYN CODE OF 4 SA65011 75106003 APPACA6A CLI CA28,SKEQHI SEARCH HI USED. SA65011 75110003 BNE APPACA8 BIF NOT SCH HI S20201 75180020 * COMPARE KEYS. IF THE RECORD'S KEY IS HIGHER, TERMINATE THE 75250020 * SEARCH OF THE OVFLO CHAIN. 75320020 IC R9,CA28+K7 GET KEY LENGTH S20201 75390020 SH R9,HWDONE EXECUTED LENGTH S20201 75460020 L R12,CA28 GET KEY ADDR S20201 75530020 L R13,CA31 GET DATA ADDR S20201 75600020 AH R13,DCBRKP FIND THE KEY IN S20201 75670020 LA R13,K10(R13) THE RECORD S20201 75740020 EX R9,COMPARE CHECK FOR MATCH S20201 75810020 BNE APPACG3 BIF NO MATCH S20201 75880020 APPACA8 EQU * S20201 75950020 CLC CA34+7(8),CA12+7 FIRST RECORD IN CHAIN OY00310 76020000 BE APPACB3 YES B3 76090020 L R12,DCBRORG3 NO ADD 1 TO DCBRORG3 76160020 LA R12,1(R12) 76230020 ST R12,DCBRORG3 76300020 TM DECBTYP2,X'20' B2 TEST READ FOR UPDATE 76370020 BZ APPACB3 NO B3 76440020 MVC IOBDADAD,CA34+7 YES IOBDADAD SET FOR WRITEBACK 76510020 APPACB3 OI DECBEXC1,X'02' B3 DECB EXCEP SET=OFLO RCD 76580020 MVI IOBASYN,X'00' B4 ASYNC CD SET=0 (G CP4,5,6) 76650020 B APPABSAR SAR 76720020 APPACA3 CL R12,APHCA43C A3 TEST - STOP AT CA43C 76790020 BNE APPACF4 NO F4 76860020 B APPACB3 YES B3 76930020 * 77000020 * ABNORMAL END APP CODE 5 (CP6) CHART AC 77070020 * 77140020 APPACE2 EQU * 19374 77210020 TM IOBSENSE+1,X'04' FILE PROTECT? 19374 77280020 BO APPACE21 YES--BRANCH 19374 77350020 TM IOBECBAD,PERRMASK PERMANENT ERROR? 19374 77420020 BC PERRYES,APPAGH3 YES--BRANCH 19374 77490020 B APPAGG2 GO SEE IF DATA CHECK 24075 77560020 APPACE21 EQU * 19374 77630020 SR R12,R10 TEST STOP AT CA36 77700020 CL R12,APPHCA36 77770020 BNE APPACF4 NO F4 77840020 AIF ('&LIB' EQ 'LIB1').NOTAOS6 77890001 CLI CA36,SEEKHH CA36 SET TO SEEK HEAD 77900001 BNE APPAOSE2 NO 77902001 MVC IOBDADAD,CA34+K7 RESET IOBSEEK 77904001 B APPRVXCP GO DO AN EXCP 77906001 APPAOSE2 EQU * * 77908001 .NOTAOS6 ANOP 77908401 TM CA35+7,X'08' G2 YES END OR CHAINED TEST 77910020 BZ APPACG3 END G3 77980020 MVI IOBASYN,X'01' J2 ASYNC CD SET=1 (EXCP) 78050020 MVI IOBFLAG1,X'42' J3 RESTORE IOB FLAGS AND ERR CTR 78120020 MVI IOBFLAG2,X'00' CC AND UNRELATED FLAGS ON 78190020 MVI IOBCSW,X'00' OTHERS OFF 78260020 XC IOBERRCT,IOBERRCT 78330020 MVC IOBDADAD,CA34+7 SET SEEK SEARCH ADDRESS 78400020 B APPABSAR SAR 78470020 APPACE3 EQU * 78540020 L R12,IOBCSW E4 YES TEST STOP AT CA31 OR CA43 78610020 LA R12,0(R12) 78680020 SR R12,R10 78750020 CL R12,APPHCA31 78820020 BE APPACE5 YES E5 78890020 CL R12,APPHCA43 78960020 BE APPACE5 YES E5 79030020 APPACF4 OI DECBEXC1,X'04' F4 NO DECB EXCEP SET=UNREACHABLE 79100020 APPACG4 MVI IOBASYN,X'04' G4 ASYNC CD SET=4(NG CP4,5,6) 79170020 B APPABSAR SAR 79240020 APPACG3 OI DECBEXC1,X'80' G3 DECB EXCEP SET=NO RCD FND 79310020 B APPACG4 G4 79380020 APPACE5 TM IOBSENSE,X'08' E5 DATA CHK{ 79450020 BZ APPACF4 NO F4 79520020 APPACF5 OI DECBEXC1,X'08' F5 YES DECB EXCP SET UNCOR IO ERR 79590020 B APPACG4 G4 79660020 * CHART AD CHANNEL END + NORMAL END CP7 79730020 * CHANNEL END 79800020 USING CP7,R10 79870020 APPADB2 LA R13,CA46C+8 TEST STOP AT CA46C 79940020 CLR R12,R13 TEST STOP AT CA46C 80010020 BNE APPADB3 80080020 MVI IOBASYN,X'02' IF SO, SET ASYN CODE AND BRANCH 80150020 B APPABSAR SCHEDULE ASYN ROUTINE 80220020 APPADB3 OI DECBEXC1,X'04' IF NOT, INDICATE UNREACHABLE IN 80290020 APPADB4 MVI IOBASYN,X'06' DECB AND SET ASYNCH CODE 80360020 B APPABSAR SCHEDULE ASYNCH ROUTINE 80430020 * CHART AI ABNORMAL END, CODE 2 , CP7 , WRITE CHECK 80500020 APPAIB2 EQU * 80570020 TM IOBECBAD,PERRMASK WAS ABEND DUE TO PERM ERROR 80640020 BCR 1,R14 NO, NORM RETURN TO IOS S20201 80710020 * 1592 S20201 80780020 L R13,IOBCSW ADDRESS+8 OF CCW WHERE 19323 80850020 LA R13,0(R13) CP STOPPED 19323 80920020 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 80990020 BZ APPADG4 NO- TEST FOR RETRY 19323 81060020 LA R12,CA46+8 IF STOP AT CA46 AND 81130020 CLR R13,R12 GO TO APPADB3 81200020 BE APPADG3 YES - I/O ERROR 81270020 LA R12,CA46C+8 81340020 CLR R13,R12 CHECK STOP AT 46C 81410020 BNE APPADB3 NO-INDICATE UNREACHABLE 81480020 APPADG3 OI DECBEXC1,X'08' DATA CHECK, SET IO UNCORRTABLE 81550020 B APPADB4 ERROR BIT IN DECB 81620020 APPADG4 EQU * 19323 81690020 TM IOBSENSE+1,NORECFND NO RECORD FOUND 19323 81760020 BZ APPADB3 FALSE-INDICATE UNREACHABLE 19323 81830020 LA R12,CA46A+8 19323 81900020 CLR R13,R12 STOP AT CA46A 19323 81970020 BNE APPADB3 NO- INDICATE UNREACHABLE 19323 82040020 CLI IOBCOUNT,X'0A' FIRST TIME THROUGH 19323 82110020 BL APPADB3 NO- INDICATE UNREACHABLE 19323 82180020 MVI IOBCOUNT,X'00' INDICATE RETRY 19323 82250020 B APPRVXCP RETRY CHANNEL PROGRAM 19323 82320020 * CHART AG ABNORMAL END, NOT FILE PROT CHK 82390020 USING CP4,R10 S20201 82460020 APPAGG2 EQU * 82530020 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 82600020 BCR 8,R14 NO - NORMAL RETURN TO S20201 82670020 * IOS S20201 82740020 LA R12,CA43C+8 82810020 L R13,IOBCSW 82880020 LA R13,0(R13) 82950020 CLR R12,R13 83020020 BCR 7,R14 NO-NORMAL RETURN TO IOS S20201 83090020 MVC IOBDADAD,CA34+7 83160020 LA R12,CA41 83230020 STH R12,IOBSTART+1 83300020 SRL R12,16 83370020 STC R12,IOBSTART 83440020 BR R14 TAKE NORMAL RETURN TO S20201 83510020 * IOS S20201 83580020 APPAGH3 EQU * 83650020 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 83720020 BZ APPACE3 NO-BRANCH 83790020 LA R13,CA43C+8 TEST STOP AT 43C 83860020 CLR R12,R13 83930020 BNE APPACE3 BRANCH IF NO 84000020 B APPACF5 UNCORRECTABLE I/O ERROR 84070020 APPAHH2 EQU * 84140020 AR R12,R10 GET STOPPING ADDR S20201 84210020 TM IOBSENSE,X'08' WAS ABEND DUE TO DATA CHECK 84280020 BZ APPABF3 NO-BRANCH 84350020 LA R13,CA24C+8 TEST STOP AT 24C 84420020 CLR R12,R13 84490020 BE APPABD1 YES- I/O ERROR 84560020 LA R13,CA24F+8 IF PERMANENT, WAS STOP AT 84630020 CLR R12,R13 CA24F 84700020 BNE APPABF3 BRANCH IF NO 84770020 B APPABD1 UNCORRECTABLE I/O ERROR 84840020 APPRVXCP SR R12,R12 84910020 IC R12,IOBDADAD GET BB 84980020 SLL R12,4 85050020 LA R12,32(R12,R3) 85120020 MVC IOBDADAD+1(2),4(R12) 85190020 LA R14,EXCP(R14) SETUP FOR EXCP IOS RETURN 15924 85260020 XC IOBFLAG2(3),IOBFLAG2 CLEAR FLAG2,SENSE BYTES 15924 85330020 XC IOBCSW(9),IOBCSW CLEAR FLAG3,CSW,AND SIOCC 15924 85400020 XC IOBERRCT(2),IOBERRCT CLEAR ERROR COUNT 15924 85470020 NI IOBFLAG1,X'C2' RESET FLAG1 15924 85540020 APPRVNOR BR R14 RETURN TO IOS 15924 85610020 * 85680020 EJECT , 17332 85750020 * NORMAL END APPENDAGE CODE 4 85820020 * UPDATE TRACK INDICES WITH 2ND PART CP14 85890020 * 85960020 * 86030020 USING IHAWKNCP,R10 S20201 86100020 APPAFB LA R13,CH14+8 DID CP END AT CH14 17332 86170020 CLR R12,R13 17332 86240020 BNE APPN3B3 NO-RECORD IS UNREACHABLE 17332 86310020 MVC IOBASYN,CK9+7 17332 86380020 CLI IOBASYN,10 ADD TO END 17332 86450020 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 86520020 CLI IOBASYN,11 ADD TO END 17332 86590020 BE APPM4C2 IF YES-GO UPDATE MSTR INDICES 17332 86660020 B APPM1B4 POST COMPLETION 17332 86730020 EJECT , 17332 86800020 * 86870020 * ABNORMAL END APPENDAGE CODE 4 86940020 * UPDATE TRACK INDICES 87010020 * 87080020 APPAEB TM IOBECBAD,PERRMASK PERM ERROR 17332 87150020 BCR PERRNO,R14 IF NO-NORMAL RET TO IOS S20201 87220020 * 1733 S20201 87290020 B APPM1B3 POST UNREACHABLE BLOCK 17332 87360020 COMPARE CLC K0(K1,R12),K0(R13) EXECUTED INSTRUCTION S20201 87430020 EJECT 87500020 HWDONE DC H'1' CONSTANT FOR EXECUTE S20201 87570020 APPN3B3 EQU APPM1B3 LABELS USED IN COMMON ROUTINE TO 87640020 APPN3B5 EQU APPM1B5 SCHEDULE ASYNCHRONOUS ROUTINE 87710020 CODE0 EQU 0 CHAN PGM 4-5 APPEND CODE S20201 87780020 CODE5 EQU 5 CHAN PGM 6 APPEND CODE S20201 87850020 CODE6 EQU 6 CP5W APPEND CODE FOR WC S20201 87920020 CODE8 EQU 8 CHAN PGM 8 APP CODE S20201 87990020 CODE9 EQU 9 CHAN PGM 10A APP CODE S20201 88060020 CODE10 EQU 10 CHAN PGM 10B APP CODE S20201 88130020 CODE11 EQU 11 CHAN PGM 10B APP CODE S20201 88200020 CODE14 EQU 14 CHAN PGM 15 APP CODE S20201 88270020 CODE17 EQU 17 CHAN PGM 17 APP CODE S20201 88340020 CODE18 EQU 18 CHAN PGM 17 APP CODE S20201 88410020 CODE19 EQU 19 CHAN PGM 17 APP CODE S20201 88480020 IHACVTEX DSECT COMMUNICATION VECTOR TABLE 88550020 DS A 88620020 CVTEXEF DS A USED WITH R13 TO EFFECT EXIT 88690020 * ADDRESS OF COMMUNICATION VECTOR TABLE 88760020 CVTPTR EQU 16 88830020 CVTZDTAB EQU X'40' CVT'S DEV CHAR TABLE PTR 23596 88900020 MERLIN EQU X'09' DEVICE CODE S20201 88970020 EJECT 89040020 * READ K, READ KU, AND WRITE K CHANNEL PGMS(WRITE CHK) 89110020 IHACP47 IGGCP47 OPTCD=W S20201 89180020 * WRITE KEY NEW CHANNEL PROGRAM REFERENCES (WRITE CHECK) 89250020 IHAWKNCP IGGWKNCP OPTCD=W S20201 89320020 IGGCP12C OPTCD=W S20201 89390020 IGGCP12A 89460020 EJECT 89530020 * DATA EVENT CONTROL BLOCK 89600020 IHADECB DSECT 89670020 DS 0F 89740020 DECBECB DS CL4 EVENT CONTROL BLOCK (ECB) 89810020 DECBTYP1 DS BL1 TYPE B6 - 1 IF LENGTH IS S 89880020 * B7 - 1 IF AREA IS S 89950020 DECBTYP2 DS BL1 B0 - 1 IF READ K 90020020 * B1 - 1 IF READ KX 90090020 * B2 - 1 IF READ KU 90160020 * B4 - 1 IF WRITE K 90230020 * B5 - 1 IF WRITE KN 90300020 DECBLGTH DS CL2 LENGTH OF BLOCK 90370020 DECBDCBA DS A POINTER TO DCB 90440020 DECBAREA DS A ADDRESS OF AREA 90510020 DECBLOGR DS A POINTER TO LOGICAL RECORD 90580020 DECBKEY DS A POINTER TO KEY 90650020 DECBEXC1 DS BL1 EXCPTN CD B0-RECORD NOT FOUND 90720020 * B1-RECORD LGTH CHK 90790020 * B2-NO SPACE 90860020 * B3-INVALID REQUEST 90930020 * B4-UNCORRECTABLE IO 91000020 * B5-UNREACHABLE BLOCK 91070020 * B6-OVERFLOW RECORD 91140020 * B7-DUPLICATE 91210020 DECBEXC2 DS BL1 B7-READ KU 91280020 EJECT 91350020 DCBD DSORG=(IS) 91420020 EJECT 91490020 IHAIOB IGGIOBD 91560020 CPSTART EQU IOBSTART-1 S20201 91630020 SENSE1 EQU IOBSENSE+1 S20201 91700020 IHADCW IGGBISAM 91770020 IHADEB IGGDEBD 91840020 EJECT 91910020 END 91980020 ./ ADD SSI=21270159,NAME=IGG019GV,SOURCE=0 TITLE 'IGG019GV - ASYNC ROUTINES WRITE KN WITH WRT CHK' 00020000 COPY LCGASMSW 00030001 IGG019GV CSECT 00040000 * RELEASE 14 DELETIONS * 00042000 * RELEASE 15 DELETIONS * 00044000 *1896 13270 00045015 * RELEASE 16 DELETIONS * 00046000 * RELEASE 17 DELETIONS * 00048000 *3630000780,020200 18106 00048500 *3630021800,022800,023000 P4700 00049000 *3630 17516 00049500 * RELEASE 18 DELETIONS * 00050000 *2768023110 VLR 00051018 *2768032800,091800,103600 17332 00051518 *2768033830-033940,066800 M3262 00051718 * RELEASE 19 DELETIONS * 00052000 *2593039200,043400,048000,049010,077400 O19113 00053019 *2593023080 A26738 00053519 *2593022670 M4599 00053719 * RELEASE 20 DELETIONS * 00054000 *1060010400,023110,043300,043400,067400,068800,072400,073400, S20201 00054120 *1060095200,100200,103800,104000,104200-143800,149520-155400, S20201 00054220 *1060155600-162400,168200,168400-175600 S20201 00054320 *1060024600,162800,163000,163200,163400,163600,163800,164000, A35340 00054420 *1060164200,164400,164600,164800,165000,165200,165400,165600, A35340 00054820 *1060024505-024519,024568-024575 M6132 00055020 *1060165800,166000,166200,166400,166600,166800,167000,167200, A35340 00055220 *1060167400,167600,167800,167840,167880,167920,167960 A35340 00055620 *1060023600-023800 A35818 00055820 *1060019700-019800 M3217 00055920 * RELEASE 21 DELETIONS * 00056000 *1244043260 A43886 00056121 *1244 A44111 00056221 *1244 S21045 00056521 *1244019750,022000,023140,024421,024645 A41652 00056721 *1244018200,019600,020200,021600 A33533 00057021 *1244082200,083000 A42240 00057121 *1244024407 A42909 00057221 *1244019900,024407 A43885 00057521 *1244 M1792 00057921 *1244067600 A50698 00062900 *1244024526 A51488 00063000 * RELEASE 22 DELETIONS * 00068000 * RELEASE 22 DELETIONS * 00068100 *1244067600 A50698 00073000 *STATUS CHANGE LEVEL 010 00078021 * 00100000 * FUNCTION/OPERATION- ASYNCHRONOUS ROUTINE FOR BISAM WRITE KN 00120000 * WITHOUT READ AND UPDATE WHEN WRITE VALIDITY CHECKING IS 00140000 * REQUESTED. 00160000 * CP14W IS INITIALIZED TO ADD A RECORD TO AN OVERFLOW CHAIN AND 00180000 * SET THE INDICES AND LINK FIELDS RELATING TO THAT RECORD. 00200000 * UPON COMPLETION OF THE LAST CP NEEDED TO ADD A RECORD TO THE 00220000 * DATA SET, COMPLETION IS POSTED AND THE NEXT IOB AWAITING 00240000 * THIS COMPLETION (IF ANY) IS SCHEDULED. 00260000 * 00280000 * ENTRY POINT- REL POS 0 00300000 * INPUT - N/A 00320000 * OUTPUT - N/A 00340000 * EXTERNAL ROUTINES 00360000 * THE FIRST CHANNEL PROGRAM NEEDED FOR A WRITE KN MACRO IS 00380000 * SELECTED AND INITIALIZED BY A SUB-ROUTINE WITHIN THE 00400000 * PRIVILEGED MACRO-TIME ROUTINE. THE POINTER TO THE PRIVILEGED 00420000 * MACRO-TIME ROUTINE IS IN DEBDISAD (SEE DEB DSECT). 00440000 * ENTRY POINT TO THIS ROUTINE IS RELATIVE ADDRESS 4 00460000 * 00480000 * EXITS- RETURN TO SUPERVISOR VIA REGISTER 14. 00500000 * 00520000 * TABLES/WORK AREAS- DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB 00540000 * SEE DSECTS AT END OF MODULE FOR FORMAT AND DESCRIPTIONS 00560000 * 00580000 * ATTRIBUTES- REENTRANT. DISABLED UPON ENTRY AND EXIT. ENABLED AT 00600000 * VARIOUS POINTS WITHIN THE MODULE. 00620000 * NOTES - NONE 00640000 EJECT 00660000 * GENERAL REGISTERS ARE USED AS FOLLOWS 00680000 * 00700000 R0 EQU 0 WORK REGISTER 00720000 R1 EQU 1 12 STAR ON ENTRY, THEN IOB 00740000 R2 EQU 2 DECB 00760000 R3 EQU 3 WORK REGISTER OR DEB 00780000 R4 EQU 4 DCB 00800000 R5 EQU 5 CHANNEL PROGRAMS 00820000 R6 EQU 6 WORK REGISTER 00840000 R7 EQU 7 WORK REGISTER 00860000 R8 EQU 8 WORK REGISTER OR DCB WA 00880000 R9 EQU 9 WORK REGISTER 00900000 R10 EQU 10 WORK REGISTER 00920000 R11 EQU 11 WORK REGISTER 00940000 R12 EQU 12 WORK REGISTER OR DISABLE RTN 00960000 R13 EQU 13 WORK REGISTER 00980000 R14 EQU 14 RETURN ADDRESS 01000000 R15 EQU 15 BASE 01020000 MERLIN EQU X'09' MERLIN DEVICE TYPE S20201 01023020 K0 EQU 0 S20201 01026020 K1 EQU 1 S20201 01029020 K2 EQU 2 S20201 01032020 K3 EQU 3 S20201 01035020 K4 EQU 4 S20201 01038020 K5 EQU 5 S20201 01041020 K6 EQU 6 S20201 01044020 K7 EQU 7 S20201 01047020 K10 EQU 10 S20201 01050020 * 01053020 * CHART LD ASYNCHRONOUS ROUTINE FOR WRITE KN 01060000 USING IHAIOB,R1 01080000 USING IHADECB,R2 01100000 USING IHADEB,R3 01120000 USING IHADCB,R4 01140000 USING IHAWKNCP,R5 01160000 USING IHADCW,R8 01180000 USING ASYNCH,R15 01200000 ASYNCH EQU * 01220000 ASYLDB2A L R3,8(R0,R1) R3 DEB POINTER 01240000 L R1,4(R1) R1 IOB 01260000 L R2,IOBECBAD R2 DECB 01280000 L R4,IOBDCBAD-1 R4 DCB POINTER 01300000 L R5,IOBCCWAD R5 CHANNEL PROGRAM POINTER 01320000 XC DCBPUTX,DCBPUTX CLEAR DECB SAVE AREA A41652 01330021 SR R9,R9 R9 ASYNCH CODE TIMES 4 01340000 IC R9,IOBASYN 01360000 SLL R9,2 01380000 ASYLDC2 B ASYTAB1(R9) 01400000 ASY01 DC X'FF' 01420000 ASY02 DC X'00' 01440000 CONF8 DC X'F8F8' 01460000 ASYTAB1 B ASYLDC2 CODE 0 INVALID 01480000 B ASYLDD3 1 EXCP 01500000 B ASYLDC2 2 INVALID 01520000 B ASYLDC2 3 INVALID 01540000 B ASYLDC2 4 INVALID 01560000 B ASYLDC2 5 INVALID 01580000 B ASYLDC2 6 INVALID 01600000 B ASYLDC2 7 INVALID 01620000 B ASYL1B1 8 END WRITE KN MACRO 01640000 B ASYL4B2 9 CP14 PRIME REC BUMPED 01660000 B ASYL5B2 10 CP14 ADD TRK AT END 01680000 B ASYL8B2 11 CP14 ADD END, OVERFLO 01700000 B ASYL7B2 12 CP14 MIDDLE VRFL CHN 01720000 B ASYL6B2 13 CP14 AT BEG OF VRFLCH 01740000 B ASYL9B2 14 CP14 NEW REPLACE DEL 01760000 EJECT 01780000 * EXECUTE CHANNEL PROGRAM 01800000 ASYLDD3 EQU * * A33533 01808021 MVC IOBBCHAD+1(3),IOBECBAD+1 SAVE ECB A33533 01816021 LA R9,IOBCSW IOS WILL ZERO OUT A33533 01824021 ST R9,IOBECBAD CSW INSTEAD OF ECB A33533 01832021 SR R9,R9 01840000 IC R9,IOBDADAD EXTENT FROM IOB 01860000 SLL R9,4 LENGTH OF 1 EXTENT = 16 01880000 LA R9,32(R9,R3) ADDRESS OF CURRENT EXTENT 01900000 MVC IOBDADAD+1(2),4(R9) MOVE CURRENT BB TO IOB 01920000 LR R8,R15 SAVE ADDRESSABILITY M3217 01926020 LR R9,R14 SAVE RETURN M3217 01932020 LR R10,R1 SAVE IOB ADDRESS M1792 01934021 EXCP (1) 01940000 LR R1,R10 RESTORE IOB ADDRESS M1792 01942021 MVC IOBECBAD+1(3),IOBBCHAD+1 RESTORE ECB A33533 01950021 CLI IOBASYN,X'01' TEST ASYNC CODE FOREXCP A35340 01965020 LR R14,R9 RESTORE RETURN M3217 01970020 * * UNNECESSARY 01980020 LR R15,R8 RESTORE ADDRESSABILITY M3217 01985020 BC 8,ASYFINIS RETURN DCBFA REFRESH A41652 01985521 * FOLLOWING IS A FIX FOR PTM 6629 01986021 L R8,DCBWKPT2 WORK AREA ADDRESSABILITY S21045 01987021 B ASYL1C4A DCBFA - REFRESH NEEDED A43885 01993021 * 02000000 ASYLDD4 SSM ASY02 DISABLE INTERRUPTS 18106 02010000 MVC IOBBCHAD+1(3),IOBECBAD+1 SAVE ECB A33533 02017021 LA R9,IOBCSW IOS WILL ZERO OUT A33533 02024021 ST R9,IOBECBAD CSW INSTEAD OF ECB A33533 02031021 SR R9,R9 02040000 IC R9,IOBDADAD M EXTENT FROM IOB 02060000 SLL R9,4 02080000 LA R9,32(R9,R3) POINT TO EXTENT OF M 02100000 MVC IOBDADAD+1(2),4(R9) MOVE BB TO IOB 02120000 LR R6,R1 SAVE IOB ADDRESS M1792 02122021 LR R9,R15 SAVE BASE A41652 02130021 EXCP (1) 02140000 LR R1,R6 RESTORE IOB ADDRESS M1792 02150021 MVC IOBECBAD+1(3),IOBBCHAD+1 RESTORE ECB A33533 02170021 LR R15,R9 RESTORE BASE A41652 02180021 B ASYFINIS RETURN VIA EXIT A41652 02200021 EJECT 02220000 * CHART L1 COMPLETION OF WRITE KN MACRO, CODE 8 02240000 ASYL1B1 LR R9,R15 SAVE BASE REG 02260000 ASYASE5B TM DECBEXC1,X'FD' TEST FOR ERRORS P4700 02263000 BZ ASYASE50 NO ERRORS - ISSUE FREEMAINP4700 02266000 L R8,DCBWKPT2 ADDRESS OF WORK AREA P4700 02269000 * UPDATE POINTERS P4700 02272000 IC R0,DCWFIOBE M4599 02273019 L R6,DCWLIOBE UPDATE ERROR QUEUE-ADD ON P4700 02275000 LTR R6,R6 IS QUEUE EMPTY ? P4700 02278000 BE ASYASE52 BRANCH IF EMPTY P4700 02281000 ST R1,IOBFCHAD-IHAIOB(0,R6) INITIALIZE FORWARD CHAIN P4700 02284000 * OF LAST IOB P4700 02287000 B ASYASE53 CONTINUE INITIALIZATION P4700 02290000 ASYASE52 ST R1,DCWFIOBE INITIALIZE QUEUE POINTER P4700 02293000 ASYASE53 MVC IOBBCHAD-IHAIOB(4,R1),DCWLIOBE BACKCHAIN THIS IOB P4700 02296000 ST R1,DCWLIOBE P4700 02299000 XC IOBFCHAD-IHAIOB(4,R1),IOBFCHAD-IHAIOB(R1) ZERO FOR-P4700 02302000 * WARD CHAIN ADDRESS P4700 02305000 BCTR R0,0 INDICATE ONE LESS SLOT A26738 02305519 STC R0,DCWFIOBE A26738 02306019 CLI DCWFIOBE,X'FF' A26738 02306519 BNE ASYASF5 BR IF AMOUNT NOT MINUS A26738 02307019 * TO RETAIN ALL IOBS 02307519 L R1,DCWFIOBE POINT TO FIRST ERROR IOB A26738 02308019 L R15,IOBFCHAD GET SECOND IOB, IF ANY A26738 02308519 MVC IOBBCHAD-IHAIOB(4,R15),IOBBCHAD ZERO BACK CHAIN A26738 02309019 ST R15,DCWFIOBE MAKE SECOND IOB FIRST A26738 02309519 LR R15,R9 RESET BASE A44111 02309721 MVI DCWFIOBE,X'00' STILL NO SPACE IN QUEUE A26738 02310019 ASYASE50 L R0,SP250IOB GET SIZE OF BASIC IOB S20201 02310520 TM DEBRPSID,RPS TEST IF RPS DEVICE USED. S20201 02311020 BZ ASYASE55 BIF NOT RPS. S20201 02311520 AH R0,RPSCCW ADD LENGHT OF RPS CCWS. S20201 02312020 ASYASE55 FREEMAIN R,LV=(0),A=(1) FREE IOB AREA S20201 02312520 * P470 S20201 02313020 ASYASF5 EQU * A41652 02315021 ST R2,DCBPUTX DECB TO BE POSTED A41652 02317021 LR R15,R9 RESTORE BASE REG 02320000 L R8,DCBWKPT2 R8 DCB WORK AREA 02340000 CLI DCWNUWKN,X'00' ANOTHER IOB AWAITING WRITE KN 02400000 BNE ASYL1E3 IF SO, BRANCH 02420000 ASYL1C4 NI DCWWKNI,X'7F' IF NOT, INDICATE WKN CPS AVAIL 02440000 ASYL1C4A EQU * DCBFA REFRESH A43885 02440721 TM DCWDCBFA,X'80' TEST FOR SHR A35340 02441420 BZ ASYFINIS IF NOT GO TO EXIT A41652 02442121 L R8,DCWDCBFA ADDRESS OF DCBFA A35340 02442820 USING DCBFA,R8 * 02443501 AIF ('&LIB' EQ 'LIB1').NOT003 02443601 LR R3,R15 SAVE BASE 02443701 MODESET KEY=ZERO ALLOW STORE IN FIELD AREA 02443801 LR R15,R3 RESTORE BASE 02443901 AGO .AOS003 02444001 .NOT003 ANOP 02444101 LA R9,0(R8) PTR TO DCB FIELD AREA A35340 02444220 LA R10,0(R4) PTR TO DCB A35340 02444920 SRL R9,4 CLEAR OUT LOWER 4 BITS A35340 02445620 * OF ADDR A35340 02446320 SLL R9,4 A35340 02447020 SRL R10,4 CLEAR LOW ORDER 3 BITS A35340 02447720 SLL R10,4 OF DCB ADDR A35340 02448420 ISK R11,R9 STORAGE KEY FOR DCBFA A35340 02449120 SLL R11,8 SHIFT LEFT TO SAVE A35340 02449820 SSM DISABLE DISABLE WHILE SQS HAS M6132 02450020 * DCB KEY M6132 02450220 ISK R10,R10 STORAGE KEY OF DCB M6132 02450420 SSK R10,R9 DCBFA START HAS DCB KEY M6132 02450620 LA R9,DCBFASIZ(R8) END ADDR OF DCBFA M6132 02450820 SRL R9,4 M6132 02451020 SLL R9,4 CLEAR LOW ORDER BYTE M6132 02451220 ISK R11,R9 KEY OF DCBFA END ADDR M6132 02451420 SSK R10,R9 DCBFA END HAS DCB KEY M6132 02451620 .AOS003 ANOP 02452101 MVC DFARORG3(9),DCBRORG3 DCB A35340 02453320 MVC DFALPDA,DCBLPDA FIELDS A35340 02454020 MVC DFANBOV,DCBNBOV INTO A35340 02454720 MVC DFARORG2,DCBRORG2 DCBFA A35340 02455420 MVC DFANOREC(12),DCBNOREC A35340 02456120 AIF ('&LIB' EQ 'LIB1').NOT004 02456301 MODESET KEY=NZERO DISABLE INTERRRUPTS 02456501 AGO .AOS004 02456701 .NOT004 ANOP 02457001 SSK R11,R9 END DCBFA KEY RESTORED M6132 02457201 SRL R11,8 POSITION START KEY M6132 02458120 LA R9,0(R8) DCBFA START ADDRESS M6132 02459120 SRL R9,4 CLEAR LOW ORDER BYTE M6132 02460120 SLL R9,4 M6132 02461120 SSK R11,R9 RESTORE DCBFA KEY M6132 02462120 SSM ENABLE RE-ENABLE M6132 02463120 .AOS004 ANOP 02463801 B ASYFINIS RETURN VIA EXIT A41652 02467121 USING IHADCW,R8 A35340 02471520 ASYL1E3 L R1,DCWFIOBU FIND UNSCHEDULED IOB ON Q 02480000 USING IHAIOB,R1 S20201 02490020 ASYL1E31 TM IOBUNSQR,X'10' AND REMOVE IT FROM Q 02500000 BO ASYL1D3 02520000 L R1,IOBFCHAD 02540000 B ASYL1E31 02560000 ASYL1D3 L R6,IOBBCHAD 02580000 LTR R6,R6 02600000 BZ ASYL1D31 02620000 MVC IOBFCHAD-IHAIOB(4,R6),IOBFCHAD 02640000 B ASYL1D32 02660000 ASYL1D31 MVC DCWFIOBU(4),IOBFCHAD 02680000 ASYL1D32 L R6,IOBFCHAD 02700000 LTR R6,R6 02720000 BZ ASYL1D33 02740000 MVC IOBBCHAD-IHAIOB(4,R6),IOBBCHAD 02760000 B ASYL1D34 02780000 ASYL1D33 MVC DCWLIOBU(4),IOBBCHAD 02800000 ASYL1D34 IC R6,DCWNUWKN SUBTRACT 1 FROM NUMBER ON Q 02820000 BCTR R6,R0 02840000 STC R6,DCWNUWKN 02860000 L R12,DEBEXPTR GET ADDR OF DEB EXT PTR S21045 02866021 USING DEBEXT,R12 S21045 02872021 L R12,DEBDISAD ADDR OF MODULE WITH SUB-ROUTINE 02880000 L R2,IOBECBAD 02900000 DROP R12 S21045 02910021 BAL R11,4(R0,R12) SET UP FIRST CHANNEL PROGRAM 02920000 B ASYLDD3 BRANCH TO EXCP RTN 02940000 EJECT 02960000 * SUB-ROUTINE CHARTS L2-L3 02980000 * USE 1 ENTRANCE 03000000 ASYL2A2 TM IOBINDCT,X'20' R6 = RCD ADDR, R7 = KEY ADDR 03020000 BO ASYL2B1 BIT 2 ON MEANS RCD IS IN W + IL 03040000 TM CH8E+4,X'80' TEST IF UNBL,PRIME REC 17332 03045018 * BUMPED 17332 03050018 BO ASYL2C3 BRANCH IF YES 17332 03055018 XC DECBLOGR,DECBLOGR RECORD IS IN DECB AREA 03060000 L R6,DECBAREA BIT 2 OFF MEANS RCD IS IN AREA 03080000 LA R6,6(R6) RCD IS IN AREA (PLUS SIX) 03100000 TM IOBINDCT,X'10' BIT 3 ON MEANS KEY IS IN W+8 03120000 BO ASYL2A4 03140000 L R7,DECBKEY KEY IS IN I 03160000 B ASYL2C2 03180000 ASYL2A4 L R7,DCBMSWA R7 = ADDRESS OF KEY 03200000 LA R7,8(R0,R7) KEY IS IN W + 8 03220000 B ASYL2C2 03240000 ASYL2B1 L R7,DCBMSWA KEY IS IN W 03260000 ASYL2B2 SR R6,R6 17332 03280018 IC R6,DCBKEYLE 03300000 AR R6,R7 RCD IS IN W +IL 03320000 MVC DECBLOGR,DCBMSWA RCD IS NOT IN AREA 03340000 ASYL2C2 MVC 0(10,R6),CB25 LINK PER R6 FROM CB25 03360000 B ASYL2D2 03380000 ASYL2C3 L R7,CH6+4 KEY ADDR OF OVFL REC 17332 03381018 B ASYL2B2 17332 03382018 * USE 2 ENTRANCE 03400000 ASYL2D1 SR R6,R6 R6 ZERO 03420000 ASYL2D2 TM DCBOPTCD,X'08' DETERMINE WHICH OVERFLOW AREA 03440000 MVI CB53+4,X'00' CLEAR EOF SW. IN CP10B 13270 03450015 BZ ASYL2E3 BZ IF NO CYLINDER OFLO AREA 03460000 CLI CB22+5,X'00' 03480000 BNE ASYL2H2 BNE IF CYL OFLO AREA NOT FULL 03500000 ASYL2E3 TM DCBOPTCD,X'10' 03520000 BZ ASYL2E4 BZ IF NO INDEPENDENT OFLO AREA 03540000 LH R10,DCBRORG2 TEST INDEPENDENT AREA FULL. 03560000 LTR R10,R10 03580000 BNE ASYL3C1 BNE IF IND OFLO AREA NOT FULL 03600000 ASYL2E4 OI DECBEXC1,X'20' INDICATE NO SPACE FOUND 03620000 TM IOBINDCT,X'20' BRANCH IF THE RECORD FOR WHICH 03640000 BO ASYL2E5 THERE IS NO SPACE IS IN W. 03660000 TM IOBINDCT,X'10' RECORD IS IN DECB AREA. 03680000 BZ ASYL2E5 BRANCH IF THE KEY IS IN DECBKEY 03700000 SR R11,R11 IF NOT, MOVE IT FROM W TO THE 03720000 IC R11,DCBKEYLE DECB KEY AREA. THIS IS 03740000 BCTR R11,0 NECESSARY SO THAT THE USER 03760000 L R6,DECBKEY WILL KNOW WHERE TO FIND THE 03780000 EX R11,ASYL2E6 LOST KEY. 03800000 ASYL2E5 EQU * 03820000 SSM ASY02 SET SYSTEM MASK OFF 03840000 B ASYL1B1 INDICATE COMPLETION 03860000 ASYL2E6 MVC 0(0,R6),0(R7) 03880000 ASYL3C1 LA R11,4(R11) INDEPENDENT OVERFLOW AREA. 03900000 CLC DCBLIOV+7(1),DCBHIIOV LAST REC ON TRK O19113 03920019 BNE ASYL3B2 NO -- MBBCCHH ALL SET, BRANCH 03940000 LA R12,ASYL3B2 LOAD R12 FOR EXIT 13270 03950015 ASYL3C1A SR R10,R10 13270 03960015 IC R10,DCBLIOV 03980000 SLL R10,4 04000000 AR R10,R3 04020000 SR R9,R9 INITIALIZE R9 TO ZERO 04040000 MVI DCBLIOV+7,0 SET RECORD NO. TO ZERO 04060000 CLC DCBLIOV+6(1),DEBENDHH+1-IHADEB(R10) LAST TRACK OF CYL. 04080000 BNE ASYL3C3 NO, GO INCREMENT TRACK NO. 04100000 MVI DCBLIOV+6,0 YES, SET TRACK NO. TO ZERO 04120000 CLC DCBLIOV+3(3),DEBENDCC-IHADEB(R10) LAST TRACK OF EXTENT 04140000 BNE ASYL3A3 NO, GO TO INCREMENT CCH 04160000 IC R9,DCBLIOV GO TO NEXT EXTENT 04180000 LA R9,1(0,R9) M+1 04200000 STC R9,DCBLIOV 04220000 CLC DCBLIOV(1),DEBNMEXT RUN OUT OF DEB (WILL NOT OCCUR) 04240000 BE ASYL2E4 YES, GO SET NO SPACE INDICATION 04260000 MVC DCBLIOV+1(6),DEBBINUM+16-IHADEB(R10) MOVE NEW BBCCHH 04280000 BR R12 EXIT 13270 04300015 * 04320000 ASYL3A3 CLI DCBOVDEV,MERLIN TWO BYTES OF CYL ADDR IF A43886 04326021 * MERLI S20201 04332020 BNE ASYL3A3A BIF NOT MERLIN S20201 04334020 IC R9,DCBLIOV+K3 PICK UP C1 OF CC S20201 04336020 SLL R9,8 MAKE ROOM FOR C2 S20201 04338020 IC R9,DCBLIOV+K4 PICK UP C2 OF CC S20201 04340020 LA R9,K1(,R9) BUMP CYL VALUE BY 1 S20201 04342020 STC R9,DCBLIOV+K4 RESTORE C2 S20201 04344020 SRL R9,8 MOVE C1 OVER FOR STORE S20201 04346020 STC R9,DCBLIOV+3 RESTORE C1 S20201 04348020 BR R12 EXIT S20201 04350020 ASYL3A3A IC R9,DCBOVDEV LOCATE ENTRY IN THE S20201 04352020 * 019113 S20201 04354020 L R8,CVTPTR DEVICE CHARACTERISTICS 04360000 L R8,CVTZDTAB-CVTDEF(0,R8) TABLE. 04380000 IC R9,0(R8,R9) 04400000 LA R10,2(R9,R8) SET AN INDEX TO H OF CCH 04420000 LA R8,DCBLIOV+5 SET INDEX TO H 04440000 * 04460000 ADDONE IC R9,0(0,R8) INCREMENT AND STORE 04480000 LA R9,1(0,R9) SOME BYTE OF CCH 04500000 STC R9,0(0,R8) 04520000 CLC 0(1,R8),0(R10) IS THE NEW VALUE VALID 04540000 BCR 4,R12 YES,BRANCH 13270 04560015 MVI 0(R8),0 NO, ZERO THIS BYTE 04580000 BCTR R10,0 DECREMENT BOTH INDEXES 04600000 BCT R8,ADDONE AND LOOP. 04620000 * 04640000 ASYL3C3 IC R9,DCBLIOV+6 INCREMENT TRACK NUMBER 04660000 LA R9,1(R9) 04680000 STC R9,DCBLIOV+6 04700000 BR R12 EXIT 13270 04710015 ASYL3B2 MVC CH23(8),DCBLIOV SET CH23 MBBCCHHR FROM DCBLIOV 04720000 IC R8,DCBLIOV+7 ADD 1 TO R IN DCBLIOV 04740000 LA R8,1(R8) 04760000 STC R8,DCBLIOV+7 04780000 CLC DCBLIOV+7(1),DCBHIIOV IF NEW ADDR LAST ON TRK, O19113 04800019 BNE ASYL3E2 THIS REC FILLS AN OVERFLOW 04820000 LH R8,DCBRORG2 AREA. THEREFORE, SUBTRACT 1 04840000 BCTR R8,R0 FROM NUMBER OF AREAS. 04860000 STH R8,DCBRORG2 04880000 ASYL3E2 MVC CH24(5),DCBLIOV+3 SET CCHHR IN CH24 FROM DCBLIOV 04900000 CLC DCBLIOV+7(1),DCBHIIOV NEW ADDRESS LAST IN TRK O19113 04901019 BNE ASYL3E2B BRANCH IF NO 13270 04902015 SR R8,R8 13270 04903015 CH R8,DCBRORG2 ANY IND OFL LEFT 13270 04904015 BE ASYL2E4 BRANCH TO NO SPACE FND IF 13270 04905015 BAL R12,ASYL3C1A GO SET EOF ADDRESS 13270 04906015 ASYL3E2B MVC CB55(5),DCBLIOV+3 MOVE SEARCH ADDR TO CB55 13270 04907015 MVI CB53+4,X'20' SET EOF SWITCH IN CP10B 13270 04908015 IC R12,DCBLIOV+7 R=R+1 FOR EOF 13270 04909015 LA R12,1(R12) 13270 04910015 STC R12,CB55+4 13270 04911015 LTR R6,R6 TEST USE 2 04920000 BZ ASYL2B5 EXIT IF YES 04940000 CLC CH23(1),IOBDADAD M IOB = M IN CH23 04960000 BE ASYL3F4 04980000 MVI CH14,X'07' NO - SEEK BBCCHH IN CH14 05000000 B ASYL3F3 05020000 ASYL3F4 MVI CH14,X'0B' YES - SEEK CCHH IN CH14 05040000 ASYL3F3 TM CB26,X'08' WAS OFLO ENTRY END OR CHAINED 05060000 BZ ASYL2K5 BZ IF END ENTRY 05080000 CLC CB25(1),CH23 COMP CH23 TO CB25, SET P IN 05100000 BNE ASYL3K2 LINK PER REG 6 ACCORDINGLY 05120000 L R8,DCBWKPT2 GET DCW WORK AREA ADDR 0699 05140000 LH R13,DCWNACT+1 SAVE DCWSIZE 0699 05160000 MVC DCWNACT+1(1),CB25+6 GET HEAD 0699 05180000 BAL R9,DEVTEST GO TO DEVICE TEST ROUTINE 05200000 CLC CB25+3(3),CH23+3 MCCH =, GO TO P = SEEK HH 05220000 STH R13,DCWNACT+1 RESTORE SIZE 0699 05240000 BE ASYL2J3 M =, SET P = SEEK CCHH 05260000 MVI 9(R6),X'0B' M NOT =, SET P = SEEK BBCCHH 05280000 B ASYL2J2 05300000 ASYL3K2 MVI 9(R6),X'07' SET P IN LINK PER R6 TO SEEK BB 05320000 B ASYL2J2 05340000 ASYL2H2 MVC CH23(6),IOBDADAD CYL OFLOW AREA 05360013 CLC DCBHIROV,CB22+2 SET CH23 MBBCC FROM IOB 05380000 BNE ASYL2G2 IF CB22 R INDICATES HI REC IN 05400000 LH R8,CB22 OVERFLOW TRACK, 05420000 LA R8,1(R8) CB22 HH OLD HH PLUS 1 05440000 STH R8,CB22 R ZERO 05460000 MVI CB22+2,X'00' 05480000 ASYL2G2 MVC CH23+6(2),CB22+1 SET CH23 HR FROM CB22+1 05500013 IC R8,CB22+2 ADD 1 TO R IN CB22 05520000 LA R8,1(R8) IF RESULT INDICATES HI REC IN 05540000 STC R8,CB22+2 OVERFLOW TRACK, SUBT 1 FROM 05560000 CLC DCBHIROV,CB22+2 T IN CB22 TO INDICATE ONE LESS 05580000 BNE ASYL2G4 TRACK. IF THIS RESULT IS ZERO 05600000 IC R8,CB22+5 ADD ONE TO RORG1 TO INDICATE 05620000 BCTR R8,R0 ONE MORE FULL CYLINDER OVER- 05640000 STC R8,CB22+5 FLOW AREA 05660000 CLI CB22+5,X'00' 05680000 BNE ASYL2G4 05700000 LH R8,DCBRORG1 05720000 LA R8,1(R8) 05740000 STH R8,DCBRORG1 05760000 ASYL2G4 MVC CH24(3),IOBDADAD+3 CH24 CCH FROM IOB 05780013 MVC CH24+3(2),CB22+1 HR FROM CB22+1 05800013 LA R9,CH1 SET IOB START PTR. TO CH1 05820000 ST R9,IOBSTART-1 05840000 LA R12,IOBDADAD+3 CCHHR FOR SEARCH 7829 05860000 ST R12,CH1 STORE INTO CCW 7829 05880000 MVI CH1,X'31' REINITIALIZE SEARCH 7829 05900000 MVC CH3A+1(3),CH1+1 SET UP WRT CK CCW 9445 05920000 LTR R6,R6 EXIT IF USE 2. 05940000 BZ ASYL2B5 05960000 MVI CH14,X'1B' CH14 SET TO SEEK HH 05980000 TM CB26,X'08' BRANCH IF CHAINED IN F OF CB26 06000000 BO ASYL2J3 06020000 ASYL2K5 LA R9,CH9 SET CH4 TO TIC TO CH9 06040000 ST R9,CH4 06060000 MVI CH4,X'08' MOVE TIC COMMAND 06080000 OI CB26,X'08' RESET F TO INDICATE CHAINED 06100000 LR R9,R7 PLACE REG 7 IN ADDR OF CH12 06120000 STH R9,CH12+2 06140000 SRL R9,16 06160000 STC R9,CH12+1 06180000 B ASYL2J1 BRANCH 06200000 ASYL2J3 MVI 9(R6),X'1B' SET P IN LINK PER R6 TO SEEK HH 06220000 ASYL2J2 LA R9,CH8D SET CH4 TO TIC TO CH8D 06240000 ST R9,CH4 06260000 MVI CH4,X'08' MOVE TIC COMMAND 06280000 ASYL2J1 MVC CB25(3),CH23 06300000 NI CH18C+4,X'BF' CH18C CC OFF 06320000 MVC CB25+3(5),CH24 06340000 LR R9,R6 PLACE R6 IN ADDR CH18 06360000 STH R9,CH18+2 06380000 SRL R9,16 06400000 STC R9,CH18+1 06420000 LR R9,R7 PLACE R7 IN ADDR CH17 06440000 STH R9,CH17+2 06460000 SRL R9,16 06480000 STC R9,CH17+1 06500000 ASYL2B5 LH R9,DCBNOREC ADD 1 TO NORECS 06520000 LA R9,1(R9) 06540000 STH R9,DCBNOREC 06560000 BR R11 RETURN 06580000 EJECT 06600000 * ASYNCH CODE 9, BUMP A PRIME RECORD CHART L4 06620000 ASYL4B2 BAL R11,MYSUBRTN 06640000 SSM ASY01 SYSTEM MASK ON 06660000 TM CH8E+4,X'80' TEST IF UNBL AND UWA M3262 06663018 BZ ASYL4D7 IF NO-BRANCH M3262 06666018 L R11,CH6+4 M3262 06669018 LA R6,2 M3262 06672018 SR R11,R6 SAVE 10 BYTES M3262 06675018 ST R11,CH6+4 FOR OVFL REC LINK FLD M3262 06678018 L R6,DECBAREA USE DECB AREA TO SAVE M3262 06681018 MVC 0(10,R6),0(R11) 10 PRIOR BYTES OF RECORD M3262 06684018 IC R6,DCBKEYLE M3262 06687018 BCTR R6,R0 M3262 06690018 EX R6,APPSDAT SAVE DATA M3262 06693018 ASYL4D7 BAL R11,ASYL2A2 M3262 06696018 B ASYL4C4 CYLINDER AREA RETURN. BRANCH. 06700000 MVC IOBDADAD+5(2),CB23 INDEPENDENT AREA. HH FROM CB23 06720000 NI CH55,X'FF'-MT MT OFF S20201 06740020 LA R6,CH55 CHAN PROG START AT CH55 A50698 06760000 ST R6,IOBSTART-1 06780000 B ASYL4D5 BRANCH 06800000 ASYL4C4 LA R6,CH5 CYLINDER VRFLO AREA. SET CH4 TO 06820000 ST R6,CH4 06840000 MVI CH4,X'08' MOVE TIC COMMAND 06860000 CLC IOBDADAD+K6(K1),CB23+K1 H(COCR) = H(TRK IX) S20201 06861020 * S2020 S20201 06862020 BE ASYL4C5 YES, BR--NO HEAD SEEK S20201 06863020 * S2020 S20201 06864020 LA R6,CI5 GET SEEK ADDRESS S20201 06865020 * S2020 S20201 06866020 ST R6,CH5 AND PUT IN CH5 S20201 06867020 * S2020 S20201 06868020 MVI CH5,SEEKHH SET UP COMMAND CODE S20201 06869020 * S2020 S20201 06870020 MVI CH5+K7,SIX SET COUNT TO SIX S20201 06871020 * S2020 S20201 06872020 MVC CI5(K2),IOBDADAD+K1 SET BB S20201 06875020 * S2020 S20201 06878020 MVC CI5+K2(K4),CB22+K6 SET UP CCHH S20201 06881020 * S2020 S20201 06884020 B ASYL4D5 CONTINUE CP 14 SET UP S20201 06887020 * S2020 S20201 06890020 ASYL4C5 MVI CH5,NOP CONVERT TO NO-OP S20201 06893020 * S2020 S20201 06896020 ASYL4D5 OI CH8D,X'80' MT ON 06900000 ASYL4D5A MVI IOBAPP,12 APPEND CODE OF 12 9445 06920000 LA R6,IOBDADAD+3 06940000 STH R6,CH1+2 06960000 SRL R6,16 06980000 STC R6,CH1+1 07000000 MVC CH3A+1(3),CH1+1 WRITE CHECK SEARCH 07020000 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 07040000 ASYLD5B TM CH8E+4,X'40' TEST IF USER WA 17332 07042018 BZ ASYLDD5 17332 07044018 MVC CH14,IOBDADAD SAVE SEEK ADDR PART 2 17332 07046018 MVC CH21+4(3),IOBSTART SAVE IOBSTART 17332 07048018 LA R9,CH15 START CP14 TO 17332 07050018 ST R9,IOBSTART-1 WRITE OVERFLOW RECORD 17332 07052018 MVC IOBDADAD,CH23 SET IOBSEEK=OVERFLOW REC 17332 07054018 ASYLDD5 EQU * 17332 07056018 MVC CK9+7(1),IOBASYN SAVE ASYN CODE 17332 07058018 B ASYLDD4 07060000 EJECT 07080000 * ASYNCH CODE 10, ADD TO END NO OFLO CHAIN EXISTS CHART L5 07100000 ASYL5B2 BAL R11,MYSUBRTN 07120000 SSM ASY01 SYSTEM MASK ON 07140000 ASYL5C3 BAL R11,ASYL2A2 SUB-ROUTINE CHARTS L2-L3, USE 1 07160000 B ASYL5D4 CYLINDER AREA RETURN. BRANCH 07180000 MVC IOBDADAD+5(2),CB24+2 INDEPENDENT AREA. HH FROM CB24 07200000 NI CH8D,X'7F' MT OFF 07220000 NI CH95,X'FF'-MT MT OFF S20201 07240020 L R9,CH4 START AT ADDR INDICATED BY CH4 07260000 ST R9,IOBSTART-1 07280000 B ASYL5F4 BRANCH 07300000 ASYL5D4 OI CH8D,X'80' MT ON 07320000 OI CH95,MT MT ON S20201 07370020 ASYL5F4 B ASYL4D5A 9445 07420000 EJECT 07500000 * ASYNCH CODE 13, INSERT BECOME 1ST IN OFLO CHAIN CHART L6 07520000 ASYL6B2 BAL R11,MYSUBRTN 07540000 SSM ASY01 07560000 MVC CB24(5),CB22+6 07580000 MVC CB25(10),CB10+7 07600000 B ASYL5C3 07620000 MYSUBRTN OC IOBDADAD+6(1),DCBFIRSH+3 TRACK MASK 07640000 XC IOBDADAD+6(1),DCBFIRSH+3 REDUCE TO CYL BNDRY OR ZERO 07660000 MVI IOBDADAD+7,0 07680000 BR R11 07700000 DEVTEST MVC DCWNACT+2(1),CH23+6 GET HEAD 0699 07720000 CLI DCBOVDEV,X'02' TEST FOR 2301 O19113 07740019 BCR 7,R9 RETURN IF NOT 2301 07760000 LA R9,6(R9) 07780000 NC DCWNACT+1(2),CONF8 REDUCE TO CYL BOUNDRY 0699 07800000 CLC DCWNACT+1(1),DCWNACT+2 COMPARE 2301 CYLS 0699 07820000 STH R13,DCWNACT+1 RESTORE SIZE 0699 07840000 BR R9 RETURN TO BRACNH INTRUCTION 07860000 EJECT 07880000 * ASYNCH CODE 12, INSERT IN OFLO CHAIN CHART L7 07900000 ASYL7B2 L R6,DECBAREA R6 ADDR OF AREA DECB POINTS TO 07920000 L R7,CJ10 R7 ADDR PER CJ10 07940000 MVC 6(10,R6),0(R7) MOVE LINK FIELD FROM CJ10 AREA 07960000 BAL R11,MYSUBRTN 07980000 SSM ASY01 SYSTEM MASK OFF 08000000 BAL R11,ASYL2D1 SUB-ROUTINE CHARTS L2-L3, USE 2 08020000 B ASYL7E3 CYLINDER OVERFLOW AREA USED. 08040000 MVC IOBDADAD,CH23 INDEPENDENT OVERFLOW AREA. 08060000 LA R10,CH15 SET UP IOB, MBBCCHHR FROM CH23 08080000 ST R10,IOBSTART-1 08100000 MVC 0(3,R7),CH23 MOVE LIOV TO LINK OF PREV 13270 08110015 MVC 3(5,R7),CH24 RECD FROM CP14 13270 08120015 CLC CH23(1),CJ11 TEST SAME MCC CJ23 AND CJ11 08140000 BNE ASYL7K4A 08160000 L R8,DCBWKPT2 GET DCW WORK AREA ADDR 0699 08180000 LH R13,DCWNACT+1 SAVE DCWSIZE 0699 08200000 MVC DCWNACT+1(1),CJ11+6 HEAD OF PREVIOUS A42240 08220021 BAL R9,DEVTEST GO TO DEVICE TEST ROUTINE 08240000 CLC CH23+3(3),CJ11+3 08260000 STH R13,DCWNACT+1 RESTORE DCWSIZE 0699 08280000 BNE ASYL7K4A NO MEANS NOT SAME A42240 08290021 MVI 9(R7),X'1B' SEEK HEAD OLD P BYTE A42240 08300021 B ASYL7G3 NEW P BYTE SET ALREADY A42240 08310021 ASYL7K4A EQU * 08320000 L R6,DECBAREA 08340000 CLC CH23(1),6(R6) SET P IN DECB AREA TO 08360000 BNE ASYL7K3 SEEK BBCCHH IF DIFF DEVICE(M) 08380000 L R8,DCBWKPT2 GET DCW WORK AREA ADDR 0699 08400000 LH R13,DCWNACT+1 SAVE DCWSIZE 0699 08420000 MVC DCWNACT+1(1),12(R6) GET HEAD 0699 08440000 BAL R9,DEVTEST GO TO DEVICE TEST ROUTINE 08460000 CLC CH23+3(3),9(R6) SEEK CCHH IF SAME DEVICE, 08480000 STH R13,DCWNACT+1 RESTORE DCWSIZE 0699 08500000 BNE ASYL7K4 DIFF CYL (MCC) 08520000 MVI 15(R6),X'1B' SEEK HH IF SAME DEVICE 08540000 B ASYL7F4 AND CYL(MCC) 08560000 ASYL7K4 MVI 15(R6),X'0B' 08580000 B ASYL7F4 08600000 ASYL7K3 MVI 15(R6),X'07' 08620000 ASYL7F4 L R7,CJ10 TEST SAME M CJ23 AND CJ11 08640000 CLC CH23(1),CJ11 08660000 BE ASYL7G5 08680000 MVI CH19,X'07' NOT SAME, P IN CH19 AND IN AREA 08700000 MVI 9(R7),X'07' PER CJ10 MUST BE SEEK BBCCHH 08720000 B ASYL7G2 08740000 ASYL7G5 MVI CH19,X'0B' SAME, P IN CH19 AND IN AREA PER 08760000 MVI 9(R7),X'0B' CJ10 MUST BE SEEK CCHH 08780000 B ASYL7G2 08800000 * CYLINDER OVERFLOW AREA. 08820000 ASYL7E3 MVC 0(3,R7),CH23 SET MBB OF LINK FIELD PER CJ10 08840000 MVC 3(5,R7),CH24 SET CCHHR OF LINK FLD PER CJ10 08860000 LA R10,CH14 CH4 MUST TIC TO CH14 08880000 ST R10,CH4 08900000 MVI CH4,X'08' MOVE TIC COMMAND 08920000 ASYL7F3 MVI CH14,X'1B' CH14 MUST SEEK HH 08940000 ASYL7G3 MVI CH19,X'1B' CH19 MUST SEEK HH 08960000 ASYL7G2 OI CH18C+4,X'40' CH18C CC FLAG ON 08980000 MVC CH22+1(3),CJ10+1 ADRESS IN CH22, SAME AS CJ10 09000000 L R10,DECBAREA ADDRESS CH18, DECB AREA + 6 09020000 LA R10,6(R10) 09040000 STH R10,CH18+2 09060000 SRL R10,16 09080000 STC R10,CH18+1 09100000 MVC CH17+1(3),DECBKEY+1 CH18 ADDRESS DECB KEY 09120000 MVI IOBAPP,13 APPENDAGE CODE 13 09140000 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 09160000 B ASYLD5B 17332 09170018 APPSDAT MVC 0(0,R11),10(R11) 17332 09180018 EJECT 09200000 * ASYNCH CODE 11, ADD TO END AN OFLO CHAIN EXISTS CHART L8 09220000 ASYL8B2 BAL R11,MYSUBRTN 09240000 SSM ASY01 SYSTEM MASK ON 09260000 MVC CH12+1(3),DECBKEY+1 SET ADDR IN CH12 TO DECB KEY 09280000 L R6,DECBAREA R6 ADDR OF DECB AREA 09300000 L R7,CJ10 R7 ADDR AREA PER CJ10 09320000 MVC 6(10,R6),0(R7) MBBCCHHR IN AREA+6 FROM CJ10 09340000 OI 8(R7),X'18' F NOW = OFLO CHAINED, NOT END 09360000 BAL R11,ASYL2D1 SUB-ROUTINE CHARTS L2-L3, USE 2 09380000 B ASYL8D2 CYLINDER OVERFLOW AREA 09400000 MVC IOBDADAD(3),DCBLPDA INDEPENDENT AREA. 09420000 MVC IOBDADAD+3(5),CB24 SEEK-SRCH ADDR =LAST OFLO ENTRY 09440000 MVC 0(3,R7),CH23 SET LINK TO LAST IND OFLO 13270 09450015 MVC 3(5,R7),CH24 RECD FROM CP14 13270 09460015 LA R10,CH9 START AT CH9 09480000 ST R10,IOBSTART-1 09500000 NI CH95,X'FF'-MT CH95 MT OFF S20201 09520020 CLC DCBLPDA(1),CH23 M OF CH23 = LST PRM DATA 09540000 BE ASYL8G3 09560000 MVI CH14,X'07' NO - CH14 OP-CODE SEEK BBCCHH 09580000 B ASYL8H4 09600000 ASYL8G3 MVI CH14,X'0B' YES- CH14 OP-CODE SEEK CCHH 09620000 ASYL8H4 CLC CH23(1),CJ11 MCC CH23 AND CJ11 09640000 BNE ASYL7F4 09660000 L R8,DCBWKPT2 GET DCW WORK AREA ADDR 0699 09680000 LH R13,DCWNACT+1 SAVE DCWSIZE 0699 09700000 MVC DCWNACT+1(1),CJ11+6 GET HEAD 0699 09720000 BAL R9,DEVTEST GO TO DEVICE TEST ROUTINE 09740000 CLC CH23+3(3),CJ11+3 09760000 STH R13,DCWNACT+1 RESTORE DCWSIZE 0699 09780000 BNE ASYL7F4 NO - BRANCH 09800000 L R7,CJ10 09820000 MVI 9(R7),X'1B' YES - LINK PER CJ10 P = SEEK HH 09840000 B ASYL7G3 AND BRANCH 09860000 ASYL8D2 L R7,CJ10 CYLINDER VRFLO AREA. 09880000 MVI 9(R7),X'1B' 09900000 MVC 0(3,R7),CH23 LINK PER CJ10 P = SEEK HH 09920000 MVC 3(5,R7),CH24 MBB FROM CH23 09940000 LA R10,CH9 CCHHR FROM CH24 09960000 ST R10,CH4 09980000 MVI CH4,X'08' MOVE TIC COMMAND 10000000 OI CH95,MT CH95 MT ON S20201 10020020 B ASYL7F3 10040000 EJECT 10060000 * ASYNCH CODE 14, REPLACEMENT IN OFLO CHAIN CHART L9 10080000 ASYL9B2 SSM ASY01 SYSTEM MASK ON 10100000 LA R10,CH20 IOB START POINTS TO CH20 10120000 ST R10,IOBSTART-1 10140000 L R6,DECBAREA LINK FIELD PER CJ10 MOVED TO 10160000 L R7,CJ10 DECB AREA + 6 10180000 MVC 6(10,R6),0(R7) 10200000 MVC IOBDADAD,CJ11 RESTORE SEEK ADDRESS FROM CJ11 10220000 LA R10,6(R0,R6) 10240000 STH R10,CH22+2 10260000 SRL R10,16 10280000 STC R10,CH22+1 10300000 MVI IOBAPP,13 APPENDAGE CODE 13 10320000 MVI IOBCOUNT,X'0A' SET COUNTER TO 10 10340000 B ASYLDD5 17332 10360018 EJECT 10360321 * THE FOLLOWING IS THE COMMON EXIT TO BE USED FOR 10360621 * RETURNING TO THE SUPERVISOR AFTER POSTING 10360921 * A COMPLETED REQUEST IF NECESSARY 10361221 ASYFINIS EQU * A41652 10361521 NC DCBPUTX,DCBPUTX DECB TO BE POSTED A41652 10361821 BZ NOPOST NO - EXIT A41652 10362121 L R2,DCBPUTX GET SAVED DECB ADDR A41652 10362421 POST DECBECB POST COMPLETION A41652 10362721 * DO NOT INSERT CODE BETWEEN POST AND RETURN 10363021 NOPOST EQU * A41652 10363321 RETURN , RETURN TO SUPERVISOR A41652 10363621 EJECT 10363921 RPS EQU X'E0' RPS MASK-BIT 0=P,1=I,2=O S20201 10365020 SIX EQU 6 BYTES FOR SEEK HH S20201 10370020 * S2020 S20201 10375020 RPSCCW DC H'16' LENGTH OF RPS CCW'S. S20201 10383020 DS 0F S20201 10391020 SP250IOB DC AL1(250),AL3(56) BASIC IOB=56 BYTES IN SP S20201 10400020 * 250 S20201 10409020 DISABLE DC X'00' DISABLE MASK M6132 10459020 ENABLE DC X'FF' ENABLE MASK M6132 10509020 DCBFASIZ EQU 40 SIAE OF DCBFA M6132 10559020 EJECT 10609020 IHAWKNCP IGGWKNCP OPTCD=W S20201 10809020 CP9A EQU * S20201 11009020 IGGCP9A 11209020 IGGCP9B OPTCD=W S20201 11409020 IGGCP9C OPTCD=W S20201 11609020 ORG CP9A CP 11 S20201 11809020 IGGCP11A 12009020 IGGCP11B OPTCD=W S20201 12209020 ORG CP9A CP 12A S20201 12409020 IGGCP12A 12609020 ORG CP9A CP 12B S20201 12809020 IGGCP12B 13009020 ORG CP9A CP 13A S20201 13209020 IGGCP13A 13409020 ORG CP9A CP 13B S20201 13609020 IGGCP13B 13809020 EJECT 14009020 * DATA EVENT CONTROL BLOCK 14400000 IHADECB DSECT 14420000 DS 0F 14440000 DECBECB DS CL4 EVENT CONTROL BLOCK (ECB) 14460000 DECBTYP1 DS BL1 TYPE B6 - 1 IF LENGTH IS S 14480000 * B7 - 1 IF AREA IS S 14500000 DECBTYP2 DS BL1 B0 - 1 IF READ K 14520000 * B1 - 1 IF READ KX 14540000 * B2 - 1 IF READ KU 14560000 * B4 - 1 IF WRITE K 14580000 * B5 - 1 IF WRITE KN 14600000 DECBLGTH DS CL2 LENGTH OF BLOCK 14620000 DECBDCBA DS A POINTER TO DCB 14640000 DECBAREA DS A ADDRESS OF AREA 14660000 DECBLOGR DS A POINTER TO LOGICAL RECORD 14680000 DECBKEY DS A POINTER TO KEY 14700000 DECBEXC1 DS BL1 EXCPTN CD B0-RECORD NOT FOUND 14720000 * B1-RECORD LGTH CHK 14740000 * B2-NO SPACE 14760000 * B3-INVALID REQUEST 14780000 * B4-UNCORRECTABLE IO 14800000 * B5-UNREACHABLE BLOCK 14820000 * B6-OVERFLOW RECORD 14840000 * B7-DUPLICATE 14860000 DECBEXC2 DS BL1 B7-READ KU 14880000 EJECT 14900000 DCBD DSORG=(IS) 14920000 EJECT 14940000 DCBFA IGGDCBFA 14946020 IHAIOB IGGIOBD 15246020 EJECT 16260000 IHADCW IGGBISAM 16270020 EJECT 16800000 IHADEB IGGDEBD 16820020 EJECT 17580000 CVTDEF DSECT 17600000 CVT 17620000 END 17640000 ./ ADD SSI=09011981,NAME=IGG019GW,SOURCE=0 TITLE 'IGG019GW - ASYNC ROUTINES COMBINED WITH WRT CHK' 00090020 COPY LCGASMSW 00140001 IGG019GW CSECT 00180020 * RELEASE 21 DELETIONS/CHANGES 00630020 *1253119700,143100,184500,205200,456300,604800,711000,745200, A41652 00630121 *1253787500,800100,806400,844200,848700 A41652 00630221 *1253504000,507600 A42240 00630521 *1253275400 A43886 00631021 *1253171900,615600,714600,763200,795600,872100 S21045 00632021 *1253885600,889200 A33533 00635021 *1253 M1792 00637021 *XXXX204600 A48664 00637400 *1253415800 A50698 00637800 *1253198000 A51488 00638200 *1253198000 A51488 00638300 *1253199760 A53751 00638602 *A205000 A57232 00638702 * SA61539 00638821 * C798300,850500, A850100,890170-890279 SA63253 00639403 * A74800-748700,C765900 SA71613 00639821 * RELEASE 20 DELETIONS/CHANGES 00640020 *0713194400-196200,203400-204300 M6132 00645020 * S20201 00650020 * 00660020 AIF ('&LIB' EQ 'LIB1').LIB2GW0 00662003 * OS/VS RELEASE 2 DELETIONS 00662403 *A151820 XM1269 00662803 * OS/VS RELEASE 3 DELETIONS 00664003 * XL03145 00666003 * VS1 APAR OX01977 AND VS2 APAR OY00779 APPEARS AS SA63253 00666403 * *** VS1 APAR OX05458 AND VS2 APAR OY04562 APPEAR AS SA71613 00666821 .LIB2GW0 ANOP 00668003 * 00670020 * 00680020 *STATUS CHANGE LEVEL 010 00740021 * 00810020 * THIS MODULE WAS REWRITTEN IN RELEASE 20.2 TO 00900020 * UTILIZE CHANNEL PROGRAM AND WORK AREA 00990020 * MACRO EXPANSIONS 01080020 * 01170020 * FUNCTION/OPERATION ASYNCHRONOUS ROUTINE FOR BISAM WRITE KN 01260020 * WITH READ AND UPDATE WHEN WRITE VALIDITY CHECKING IS 01350020 * REQUESTED. 01440020 * WRITE KN 01530020 * CP14W IS INITIALIZED TO ADD A RECORD TO AN OVERFLOW CHAIN AND 01620020 * SET THE INDICES AND LINK FIELDS RELATING TO THAT RECORD. 01710020 * UPON COMPLETION OF THE LAST CP NEEDED TO ADD A RECORD TO THE 01800020 * DATA SET, COMPLETION IS POSTED AND THE NEXT IOB AWAITING 01890020 * THIS COMPLETION (IF ANY) IS SCHEDULED. (R=U IF NO WRITE KN) 01980020 * READ AND UPDATE 02070020 * UPON COMPLETION OF CP1 OR CP2, THE NEXT IOB AWAITING THE CP 02160020 * (IF ANY) IS SCHEDULED AND, IF COMPLETION WAS SUCCESSFUL, CP4- 02250020 * CP5 IS SCHEDULED FOR THE IOB FOR WHICH CP1 OR CP2 JUST 02340020 * COMPLETED. IF UNSUCCESSFUL, COMPLETION IS POSTED. 02430020 * UPON COMPLETION OF CP5, CP6 OR CP7, THE NEXT IOB AWAITING THE 02520020 * CP (IF ANY) IS SCHEDULED AND COMPLETION IS POSTED FOR THIS IOB 02610020 * IF NO MORE READ AND UPDATE REQUESTS ARE MADE, THE FIRST 02700020 * WRITE KN MACRO (IN ANY) IS SCHEDULED. 02790020 * INPUT - N/A 02880020 * OUTPUT - N/A 02970020 * ENTRY POINT' REL POS 0 03060020 * EXTERNAL ROUTINES 03150020 * CP1 OR CP2, CP4 AND CP5, AND CP7 ARE INITIALIZED AND CP4-CP5- 03240020 * CP6 REMOVED FROM THE CP QUEUE IN SUB-ROUTINES WITHIN THE 03330020 * PRIVILEGED MACRO-TIME ROUTINE. 03420020 * THE FIRST CHANNEL PROGRAM NEEDED FOR A WRITE KN MACRO IS 03510020 * SELECTED AND INITIALIZED BY A SUB-ROUTINE WITHIN THE 03600020 * PRIVILEGED MACRO-TIME ROUTINE. 03690020 * WHEN ALL WRITE KN MACROS ARE COMPLETE, THE PENDING READ AND 03780020 * UPDATE MACROS ARE SCHEDULED OR ARE REPLACED ON THE UNSCHEDULED 03870020 * QUEUE ACCORDING TO THE CHANNEL PROGRAM EACH AWAITS BY A SUB- 03960020 * ROUTINE WITHIN THE PRIVILEGED MACRO-TIME ROUTINE. 04050020 * ENTRY POINT NAMES ARE 04140020 * DISCP45 - INITIALIZE CP4 AND CP5 04230020 * DISCP7 - INITIALIZE CP7 04320020 * DISCPS - INITIALIZE CP1 OR CP2 04410020 * DISCPWKN- INITIALIZE WKN CP 04500020 * DISPRIV - SCHEDULE OR RE-QUEUE READ AND UPDATE CP'S 04590020 * SEE THE DSECT LABELED IHADIS FOR THE RELATIVE ADDRESSES OF THE 04680020 * ENTRY POINTS OF THESE ROUTINES. THE POINTER TO THE PRIVILEGED 04770020 * MACRO-TIME ROUTINE IS IN DEBDISAD (SEE DEB DSECT). 04860020 * THE DYNAMIC BUFFERING ROUTINE WHICH FREES A BUFFER 04950020 * UPON COMPLETION OF A WRITE K MACRO IS ENTERED VIA 'BUFASYN'. 05040020 * SEE THE DSECT LABELED IHABUF FOR THE RELATIVE ADDRESS OF THE 05130020 * ENTRY POINT OF THIS ROUTINE. THE POINTER TO THE DYNAMIC 05220020 * BUFFERING MODULE IS IN DCBFREED (SEE DCB DSECT). 05310020 * EXITS' RETURN TO SUPERVISOR VIA REGISTER 14. 05400020 * TABLES/WORK AREAS' DECB, DCB, IOB AND EXTENTION, DCB WA (DCW), DEB 05490020 * SEE DSECTS AT END OF MODULE FOR FORMAT AND DESCRIPTIONS 05580020 * ATTRIBUTES' REENTRANT. DISABLED UPON ENTRY AND EXIT. ENABLED AT 05670020 * VARIOUS POINTS WITHIN THE MODULE. 05760020 * NOTES - NONE 05850020 * GENERAL REGISTERS ARE USED AS FOLLOWS 05940020 R0 EQU 0 WORK REGISTER 06030020 R1 EQU 1 12 STAR ON ENTRY, THEN IOB 06120020 R2 EQU 2 DECB 06210020 R3 EQU 3 WKN USED FOR WORK REG OR DEB 06300020 * R+U USED BASE REGISTER 06390020 R4 EQU 4 DCB 06480020 R5 EQU 5 CHANNEL PROGRAMS 06570020 R6 EQU 6 WORK REGISTER 06660020 R7 EQU 7 WORK REGISTER 06750020 R8 EQU 8 WORK REGISTER OR DCB WA 06840020 R9 EQU 9 WORK REGISTER 06930020 R10 EQU 10 WORK REGISTER 07020020 R11 EQU 11 WORK REGISTER 07110020 R12 EQU 12 WORK REGISTER OR DISABLE RTN 07200020 R13 EQU 13 WORK REGISTER 07290020 R14 EQU 14 RETURN ADDRESS 07380020 R15 EQU 15 BASE ON ENTRY 07470020 * R+U USES AS WORK REGISTER 07560020 MERLIN EQU X'09' MERLIN DEVICE TYPE S20201 07650020 K0 EQU 0 S20201 07740020 K1 EQU 1 S20201 07830020 K2 EQU 2 S20201 07920020 K3 EQU 3 S20201 08010020 K4 EQU 4 S20201 08100020 K5 EQU 5 S20201 08190020 K6 EQU 6 S20201 08280020 K7 EQU 7 S20201 08370020 K10 EQU 10 S20201 08460020 USING IHAIOB,1 S20201 08550020 USING IHADECB,2 08640020 USING IHADEB,3 08730020 USING IHADCB,4 08820020 USING IHAWKNCP,5 08910020 USING IHADCW,8