./ ADD SSI=06010302,NAME=IGG0191D,SOURCE=0 TITLE 'IGG0191D-IECOSOP2 OPEN EXECUTOR(BASIC DIRECT ACCESS)' 00020000 COPY LCGASMSW 00020400 * RELEASE 17 DELETIONS * 00021000 *1634000400,023000-023200,026000,034400,043800,049800-050200, DM0I 00022000 * 058600,059400,063800,072400,076200,086400,086600,091800, DM0I 00023000 * 092400,096000,100000,102200,107400-107600,123200,125200, DM0I 00024000 * 126600,129000,134000,135400,135600,136800,139000,139600, DM0I 00025000 * 140000,140400,141800-146600 DM0I 00026000 *1634004800 M1552 00026700 * RELEASE 18 DELETIONS * 00027000 *0451082840-082880 21476 00027118 *0451058200,058400,104800-105000 20185 00027218 *0451000265,082920 17363 00027518 *0451 MCS 00027718 *0451004700,134680 8M616 00027818 * RELEASE 19 DELETIONS * 00028000 *1401084200-105200,139600 S19015 00028519 *1401082890-082960 A25961 00028719 * RELEASE 20 DELETIONS * 00029000 *0973032600-032800,058400-058600,061600,070800,073520-073540, S20201 00029220 *0973081600-083000,108200-110600,111600-112200,113400-119800, S20201 00029420 *0973136200-137600,139000,139400,140000 S20201 00029620 * RELEASE 21 DELETIONS * 00030000 *0091074000,118800,120300 M0131 00030121 *0091004700,130800,134680-134760,139000-140000,140200,147400- S21042 00030321 *0091147600 S21042 00030621 *0091073502-073506,074600-076400,120000-121000 A37507 00030821 * REFER TO CODE FLAGGED XA02335 SA62466 00030900 * VS1 DELETIONS 00031000 *D073404-073416 XA02335 00032000 *STATUS CHANGE LEVEL 008 00043003 *FUNCTION/OPERATION: THIS ROUTINE WILL SET UP A CODE IN THE DCBCNTRL 00060000 * FIELD OF THE DCB FOR IGG01910. IGG01910 WILL FROM THIS CODE 00080000 * DETERMINE WHAT INPUT/OUTPUT ROUTINES WILL BE BROUGHT INTO CORE 00100000 * AT OPEN TIME. (BASIC) 00120000 * IT WILL DETERMINE HOW MANY IOB'S ARE TO BE CREATED, USE'GETMAIN' 00140000 * TO GET CORE FOR THE IOB'S, AND CLEAR THE CORE. 00160000 * IF THE DCB IS BEING OPENED FOR OUTPUT 00170019 * IT WILL LINK THE IOB'S AND INITIALIZE THEM. 00180000 * IT WILL CONSTRUCT CHANNEL PROGRAMS NEEDED FOR PROPER EXECUTION. 00200000 * IT WILL SET UP THE NUMBER OF EXTENTS NEEDED AND PLACE THE 00220000 * ADDRESSES IN THE DCB AND IOB'S. 00240000 * 00260000 * THIS MODULE WAS SPLIT FOR RELEASE 19. THE RESULTING MODULE 00265019 * IS IGG0191O. 00270019 * 00275019 *ENTRY POINTS: ENTERED FROM IGG0191A BY USE OF THE XCTL MACRO. 00280000 * 00300000 *INPUT: SEE DESCRIPTION OF REGISTERS, DCB(USERS). 00320000 *OUTPUT: IOB(USER), SEE DESCRIPTION OF THE REGISTERS, DCB(USERS) 00340000 * 00360000 * 00380000 *EXTERNAL ROUTINES: NONE. 00400000 * 00420000 *EXITS-NORMAL: XCTL TO IGG01910(IECOSLDA) TO LOAD ROUTINES 00440000 * 00460000 *EXITS-ERROR-CALL PROB DET (IGG0196M) FOR WTP AND 013 ABEND, 00466021 * INSUFFICIENT BUFFERS AVAILABLE IN 00472021 * BUFFER POOL TO SATISFY DCB BUFFER REQUIREMENTS M1552 00480000 * 00500000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00520000 * 00540000 * BYTE 0-7 NAME 00560000 * BYTE 8-10 RELATIVE DISK ADDRESS (TTR) OF FIRST RECORD 00580000 * BYTE 11 CONCATENATION NUMBER 00600000 * BYTE 12 ZERO 00620000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR: 00640000 * ALIAS INDICATOR 1 BIT 00660000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00680000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00700000 * BYTE 17 ZERO 00720000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00740000 * BYTE 20 TRANSLATION TABLE 00760000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00780000 * BYTE 22-23 ATTRIBUTES 00800000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00820000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00840000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00860000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00880000 * BYTE 32-34 IDTTR OF EXECUTOR FOR 1ST DCB 00900000 * BYTE 35 WORKAREA ADDRESS FOR 1ST DCB 00920000 * BYTE 36-39 TABLE OF IDTTR'S 00940000 * 00960000 * 32+N(8) IDTTR OF EXECUTOR FOR NTH DCB (3 BYTES) 00980000 * WORKAREA ADDRESS FOR NTH DCB (1 BYTE) 01000000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01020000 * NOT USED (1 BYTE) 01040000 * 01060000 * 01080000 *********************************************************************** 01100000 *ATTRIBUTES: REENTRANT,REUSABLE. 01120000 * 01140000 * 01160000 *********************************************************************** 01180000 * 01200000 * 01220000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01240000 * 01260000 *********************************************************************** 01280000 * 01300000 RDCB EQU 2 DCB REGISTER 01320000 RBASE EQU 3 BASE REGISTER 01340000 RCORE EQU 4 WORK AREA ADDRESS 01360000 RPAR EQU 5 TOP OF PARAMETER LIST 01380000 RWTG EQU 6 TOP OF WTG TABLE 01400000 RPARC EQU 7 CURRENT PARAMETER 01420000 RWTGC EQU 8 CURRENT TRANS LOAD 01440000 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECTOR ADDR. 01460000 RUCB EQU 10 USED HERE AS A COUNTER IN IOB GENERATION 01480000 RDEB EQU 11 DEB ADDRESS 01500000 RB EQU 12 WORK REG1 ** 01520000 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 01540000 RD EQU 14 WORK REG3 ** 01560000 RJ EQU 15 WORK REG4 01580000 RE EQU 0 WORK REG5 01600000 RF EQU 1 WORK REG6 01620000 * 01640000 * 01660000 PARAR EQU RPARC 01680000 * 01700000 *********************************************************************** 01720000 * 01740000 * 01760000 * 01780000 ********************************************************************* 01800000 * MASK'S TO TEST PARAMETER LIST WITH 01820000 INP EQU X'0F' 01840000 OUTP EQU X'0F' 01860000 UPDATE EQU X'04' 01880000 INOUT EQU X'03' 01900000 OUTIN EQU X'07' 01920000 RDBACK EQU X'01' 01940000 * 01960000 * 01980000 ********************************************************************* 02000000 * 02020000 * 02040000 * OFFSET FOR PARAMETER TESTS 02060000 * 02080000 ONE EQU X'01' 02100000 FRTYATE EQU 48 02120000 DISPSN EQU X'0' 02140000 * 02160000 * 02180000 ********************************************************************* 02200000 * 02220000 * OFFSETS FOR DEB REFERENCE 02240000 * 02260000 * 02280000 BIN EQU 36 BIN NOS. DM0I 02300000 BEXT EQU 38 BIN EXTENT DM0I 02320000 * 02340000 * 02360000 * 02380000 ********************************************************************* 02400000 * 02420000 * MASK'S USED TO TEST OPTION FIELDS IN DCB 02440000 * 02460000 * 02480000 * 02500000 DOUBLE EQU X'01' 02520000 * 02540000 * 02560000 STOWB EQU X'80' 02580000 WRTCK EQU X'80' WRITE CHECK DM0I 02600000 OVRFLO EQU X'20' 02620000 PCI EQU X'20' 02640000 MINKEY EQU X'01' 02660000 CONCAT EQU X'FF' 02680000 * 02700000 ********************************************************************* 02720000 * 02740000 * MASKS FOR ACCESS METHODS IN SAM 02760000 * 02780000 QSAMB EQU X'01' 02800000 BSAMBIT EQU X'00' 02820000 PAM EQU X'02' 02840000 * 02860000 * 02880000 * MASKS FOR MACRO'S TO BE USED 02900000 * 02920000 GETB EQU X'40' 02940000 PUTB EQU X'40' 02960000 READB EQU X'20' 02980000 WRITEB EQU X'20' 03000000 POINTB EQU X'04' 03020000 CNTRLB EQU X'02' 03040000 * 03060000 * 03080000 ********************************************************************* 03100000 * 03120000 * MASKS FOR DEVICES TO BE SUPPORTED 03140000 * 03160000 * 03180000 * 03200000 ********************************************************************* 03220000 * 03240000 * 03242020 * DISPLACEMENTS AND BYTE COUNTS AS EQUATES 03244020 * 03246020 D0 EQU 0 DISPLACEMENTS OF ZERO S20201 03248020 D5 EQU 5 DISPLACEMENTS OF FIVE S20201 03250020 D6 EQU 6 DISPLACEMENTS OF SIX S20201 03252020 B1 EQU 1 BYTE COUNT OF ONE S20201 03254020 B8 EQU 8 BYTE COUNT OF EIGHT S20201 03256020 B16 EQU 16 BYTE COUNT OF SIXTEEN S20201 03258020 B24 EQU 24 BYTE COUNT OF TWENTYFOUR S20201 03260020 * 03262020 FIVE EQU 5 BYTE COUNT OF FIVE S20201 03264020 SIX EQU 6 LNGH CHP WITH RCD READY S20201 03266020 * DW S20201 03268020 TEN EQU X'0A' LNGH CHP WRT CHK + RCD S20201 03270020 * RDY S20201 03272020 MAX EQU 255 MAX COUNT FOR EXEC INST S20201 03274020 INPBIOB EQU 80 BASIC INPUT IOB SIZE S20201 03276020 * 03278020 * 03280020 * 03282020 FLAGOFF EQU 4 OFFSET IN CCW TO FLAGS S20201 03284020 CNTOFF EQU 7 OFFSET IN CCW TO CNT FLD S20201 03286020 SDFLG EQU X'08' SEARCH DIRECT INDICATOR S20201 03288020 SDOPT EQU X'01' SEARCH DIRECT MASK S20201 03290020 * 03292020 * 03300000 ********************************************************************* 03320000 * 03340000 * MASKS FOR STATUS BITS TO BE TESTED 03360000 * 03380000 * 03400000 EXCPN EQU X'30' 03420000 COMPLETE EQU X'60' COMPLETE MASK DM0I 03440000 FIRSTIOB EQU X'01' 03460000 * 03480000 * 03500000 * 03520000 ********************************************************************* 03540000 * 03560000 * MASKS FOR BUFFER TECHNIQUE'S 03580000 * 03600000 CYCLICB EQU X'20' 03620000 EXCHANGB EQU X'10' 03640000 SIMPLEB EQU X'40' 03660000 EXCHCYCL EQU X'30' 03680000 * 03700000 ********************************************************************* 03720000 * 03740000 * 03760000 * MODES OF OPERATION FOR QSAM 03780000 * 03800000 LOCATEB EQU X'08' 03820000 MOVEB EQU X'10' 03840000 SUBSTUTB EQU X'04' 03860000 * 03880000 * 03900000 ********************************************************************* 03920000 * 03940000 * 03960000 * COMMAND BYTES FOR THE 2841 03980000 * 04000000 * CONTROL UNIT 04020000 * 04040000 * 04060000 * 04080000 SRCHE EQU X'31' 04100000 WRTCKD EQU X'1D' 04120000 RDC EQU X'92' 04140000 RDKD EQU X'8E' 04160000 RDD EQU X'86' 04180000 TIC EQU X'08' 04200000 SETSC EQU X'23' SET SECTOR CCW CMND S20201 04205020 RDSC EQU X'22' READ SECTOR CCW CMND S20201 04210020 * 04215020 * 04220000 * 04240000 ********************************************************************* 04260000 * 04280000 * 04300000 * MASKS FOR RECORD FORMATS 04320000 * 04340000 * 04360000 STANDRDF EQU X'88' STANDARD FORMORT DM0I 04380000 FORMATU EQU X'C0' 04400000 FORMATF EQU X'80' 04420000 FORMATV EQU X'40' 04440000 BLOCKED EQU X'10' 04460000 * 04480000 * 04500000 ********************************************************************* 04520000 * 04540000 * 04560000 * CHANNEL CONTROL WORD FLAGS 04580000 * 04600000 SKIP EQU X'10' 04620000 SLI EQU X'20' 04640000 CC EQU X'40' 04660000 DATACH EQU X'A0' 04680000 SLICC EQU X'60' 04700000 SLICCSK EQU X'70' 04720000 * 04740000 * 04760000 ********************************************************************* 04780000 * 04800000 * 04820000 KEYS EQU X'01' 04840000 QSAM EQU X'01' 04860000 NORCDRY EQU X'20' NO RECORD READY S20201 04865020 * INDICATOR S20201 04870020 * MASK 04875020 * 04880000 * 04900000 ********************************************************************* 04920000 * 04940000 GETMAIN EQU 4 04960000 QSAMZ EQU X'05' MASK DM0I 04980000 COMMTABL EQU 16 MASK DM0I 05000000 IDTTR EQU 5 LENGTH OF IDTTR FOR MVC S19015 05005019 CPINCR EQU 24 CP INCREMENT--OFFSET S19015 05010019 * READ S19015 05015019 NOROUT EQU 0 TO INDICATE NO EOB S19015 05020019 * NEEDED S19015 05025019 BFTEKR EQU X'20' BDAM VS SUPPORT S19015 05030019 VSBITS EQU X'48' VS BITS IN DCBRECFM S19015 05035019 UNRELFLG EQU X'02' IOB UNRELATED FLAG A37507 05037021 ********************************************************************* 05040000 OABD060 EQU 60 S21042 05050021 * 05060000 * 05080000 * 05100000 * 05120000 * 05140000 IGG0191D CSECT 05160000 * 05180000 * 05200000 * 05220000 BALR RBASE,0 REG 3 IS BASE 05240000 USING SOP2,RBASE 05260000 USING IHADCB,RDCB REG 2 IS DCB 05280000 USING CVT,RTIOT REG 9 IS COMM UECT TABLE 05300000 USING FORCORE,RCORE REG 4 IS WORK AREA ADDR 05320000 USING BLDEB,RDEB REG 11 IS DEB 05340000 * 05360000 * 05380000 * 05400000 * 05420000 SOP2 EQU * 05440000 * 05460000 L RDCB,0(RPARC) GET DCB ADDRESS 05480000 LA RDCB,0(RDCB) CLEAR HI BYTE 05500000 L RCORE,4(RWTGC) GET WORK AREA ADDRESS 05520000 * 05540000 SR RC,RC READY A WORK REG 05560000 TM DISPSN(RPARC),INP FILE FOR INPUT 05580000 BC 7,SOP230 NO BRANCH 05600000 * 05620000 TM DCBMACRF,POINTB POINT MACRO USED 05640000 BC 1,SOP220A YES BRANCH TO STANDARD F RECS 05660000 * 05680000 SOP220 TM DCBRECFM,STANDRDF STANDARD F RECORDS USED 05700000 BC 1,SOP221 YES BRANCH 05720000 * 05740000 * 05760000 SOP220A EQU * 05780000 MVI DCBCNTRL+3,2 EGP2 ID NUMBER 05800000 LA RC,8 INCREMENT FOR NON SF RECS 20185 05820018 TM DCBCIND2,QSAMB DATA SET FOR QSAM S19015 05822019 BO SOP221 YES--BRANCH S19015 05824019 TM DCBBFTEK,BFTEKR OFFSET READ S19015 05826019 BZ SOP221 NO--BRANCH S19015 05828019 LA RC,CPINCR(RC) INCREMENT FOR OFFSET S19015 05830019 * READ S19015 05832019 MVI DCBCNTRX,NOROUT NO EOB ROUT NEEDED S19015 05834019 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 05837020 * READY S20201 05840020 BO SOP225 BRANCH IF YES, EXTRA S20201 05843020 * SPACE S20201 05846020 * ALREADY ACQUIRED BY OFFSET 05849020 * REA 05852020 SOP221 EQU * S20201 05855020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 05858020 * READY S20201 05861020 BO SOP225 BRANCH IF YES S20201 05864020 LA RC,B24(RC) INCR FOR RCD READY S20201 05867020 SOP225 EQU * S20201 05870020 LA RC,INPBIOB(RC) INCR FOR READ IOB S20201 05873020 B SOP235 GO TO GET CORE S20201 05876020 * 05880000 * 05900000 SOP230 LA RC,88 AMT CORE NEEDED FOR OUTPUT IOB 05920000 MVI DCBCNTRX,QSAM MOVE ID DM0I 05940000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 05943020 * READY S20201 05946020 BO SOP233 BRANCH IF YES S20201 05949020 LA RC,B16(RC) INCR FOR RCD READY S20201 05952020 SOP233 EQU * S20201 05955020 TM DCBOPTCD,WRTCK WRITE VALIDITY CHECK USED 05960000 BC 14,SOP235 NO BRANCH 05980000 * 06000000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06002020 * READY S20201 06004020 BO SOP233A BRANCH IF YES S20201 06006020 LA RC,B8(RC) INCR FOR RCD READY S20201 06008020 SOP233A EQU * S20201 06010020 * 06012020 LA RC,24(RC) AMT SPACE NEEDED FOR WRT CK CP. 06020000 * 06040000 * 06060000 * AT THIS POINT RC=REG.13 HAS THE SIZE OF AN IOB IN IT 06080000 * 06100000 * 06120000 SOP235 EQU * 06140000 TM JFCBMASK+D6,SDFLG SEARCH DIRECT S20201 06145020 BNO NOSD1 BRANCH NO S20201 06150020 LA RC,B16(RC) INCR IOB SIZE S20201 06155020 * 06160020 NOSD1 EQU * S20201 06165020 * 06170020 SRL RC,3 IOB IN DOUBLE WORDS 06180000 STC RC,DCBIOBL STORE IN DCB 06200000 SLL RC,3 RESET IOB SIZE 06220000 * 06240000 SR RF,RF 06260000 TM DCBCIND2,QSAMB DATA SET FOR QSAM 06280000 BC 14,SOP237 NO BRANCH 06300000 * 06320000 * 06340000 IC RF,DCBBUFNO GET NUMBER OF IOBS TO BUILD 06360000 B SOP239 SKIP TO NEXT DM0I 06380000 * 06400000 * 06420000 SOP237 EQU * 06440000 * 06460000 IC RF,DCBNCP GET NUMBER OF IOBS TO BUILD 06480000 LTR RF,RF HAS THIS BEEN SPECIFIED 06500000 BC 7,SOP239 YES BRANCH 06520000 * 06540000 LA RF,1 SUPPLY 1 FOR USER 06560000 STC RF,DCBNCP SAVE FOR NOW 06580000 * 06600000 SOP239 EQU * 06620000 * 06640000 LR RUCB,RF 06660000 * 06680000 * 06700000 *********************************************************************** 06720000 * 06740000 MR RE,RC COMPUTE TOTAL AMT SPACE NEEDED 06760000 * 06762020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06764020 * READY S20201 06766020 BO SOP239A BRANCH IF YES S20201 06768020 LA RF,B8(RF) INCR FOR THETA VALUES S20201 06770020 SOP239A EQU * S20201 06772020 LR RD,RF 06780000 LR RB,RF SAVE FOR FUTURE USE 06800000 * 06820000 ********************************************************************** 06840000 * 06860000 GETMAIN R,LV=(RD),SP=250 06880000 * 06900000 ********************************************************************** 06920000 ** 06940000 * THIS SECTION CLEARS THE SPACE RECIEVED FROM GETMAIN 06960000 ** 06980000 * 07000000 LR RJ,RB RESTORE LENGTH TO CLEAR 07020000 LA RE,B8 CONSTANT OF EIGHT S20201 07030020 ST RF,DCBIOBA SAVE FIRST IOB ADDRESS 07040000 BCTR RJ,0 REDUCE AMT BT ONE 07060000 * 07064020 * OBTAIN THETA ADDRESSES MAY BE USED LATER 07068020 * 07072020 AR RB,RF GET ADDR TOTAL AREA + 1 S20201 07076020 SR RB,RE BACK UP A DW S20201 07080020 ST RB,DXCCW11 TEMP STORE SET SECT ADDR S20201 07084020 LA RB,B1(RB) GET READ SECT ADD S20201 07088020 ST RB,DXCCW12 TEMP STORE S20201 07092020 LA RB,MAX GET MAX EXECUTE VALVE S20201 07096020 COMPARE CR RJ,RB IS AMT TO CLEAR GREATER 255 07100000 BC 12,ONECLEAR NO BRANCH 07120000 * 07140000 EX RB,CLEAR CLEAR 256 BYTES 07160000 SR RJ,RB SUBT 255 FROM AMT TO BE CLEARED 07180000 BCTR RJ,0 SUBT ONE MORE BYTE 07200000 LA RF,256(RF) UPDATE AREA ADDR BY 256 07220000 B COMPARE CHECK AGAIN DM0I 07240000 * 07260000 CLEAR XC 0(1,RF),0(RF) ACTUAL CLEAR INSTRUCTION 07280000 * 07300000 ONECLEAR EX RJ,CLEAR CLEARS LESS THAN 256 07320000 * 07340000 L RB,DCBIOBA GET IOB ADDR A37507 07340221 TM DISPSN(RPARC),INP FILE FOR INPUT S19015 07342019 BO SOP240A NO--CP WILL BE BUILT S19015 07344019 * HERE S19015 07346019 MVC DISPSN(IDTTR,RWTGC),SOPSLDIN CP TO BE BUILT IN S19015 07348019 * 1O S19015 07350019 L RF,DXCCW11 GET THETA ADDR A37507 07350121 USING IOBQSAMD,RB ESTABLISH ADDR FOR IOB A37507 07350221 * DSECT A37507 07350321 ST RF,IOBNIOBA PUT ADDR IN AREA IN A37507 07350421 DROP RB A37507 07350521 * DMO S20201 07350820 * SINCE THIS IS TO BE AN DMOR 07351020 * INPUT IOB AND IS BUILT IN DMOR 07351220 * IGG0191O 07351420 TM JFCBMASK+D6,SDFLG SEARCH DIRECT USED S20201 07352420 BNO NOSD5 BRANCH NO S20201 07353420 MVC DISPSN(IDTTR,RWTGC),SOPSD MOVE IN SEARCH DIRECT S20201 07354420 * ID S20201 07355420 * 07356420 NOSD5 EQU * S20201 07357420 B RELOOP GO PROCESS DCBS S20201 07358420 * 07360000 * 07380000 SOP240A EQU * S19015 07390019 LR RC,RB SET UP WORK REG 07420000 LR RD,RB SET UP WORK REG 07440000 SPACE 2 07660000 * 07680000 SOP242 EQU * 07700000 * 07720000 ST RB,0(RD) LINK NEW IOB TO LAST ONE BUILT 07740000 LR RD,RB UPDATE CURRENT IOB POINTER 07760000 LA RB,4(RB) POINT TO ECB SLOT 07780000 OI 0(RB),X'7F' SET ECB COMPLETE WITHOUT ERROR 07800000 ST RB,12(RD) STORE ECB ADDR IN IOB 07820000 LA RB,20(RB) POINT TO CP POINTER SLOT 07840000 LR RC,RB SAVE ADDR 07860000 LA RB,24(RB) POINT TO CP START ADDR 07880000 SOP243 EQU * 07900000 ST RB,0(RC) STORE CP STARTAD IN IOB 07920000 ST RDCB,4(RC) STORE DCB ADDR IN IOB 07940000 MVC 40(8,RD),DCBFDAD INITIALIZE IOBFDAD. 07950013 * 07960000 *********************************************************************** 07980000 * 08000000 * CONSTRUCTION OF CHANNEL PROGRAM FOLLOWS 08020000 * 08040000 *********************************************************************** 08060000 * 08080000 SOP255 EQU * 08100000 * 08120000 LA RC,19(RC) POINT TO CCHHR FIELD IN IOB 08140000 * 08148020 * CHECK FOR RCD READY FEATURE ON ALL DEVICES FOR DATA SET AND IF ON 08156020 * ALL DEVICES BUILD RCD READY CHPS, BIT 2 OF JFCBMASK BEING A ONE 08164020 * SAYS ALL DEVICES DO NOT HAVE RCD READY FEATURE 08172020 * 08180020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 08188020 * READY S20201 08196020 BO SOP257 BRANCH IF YES S20201 08204020 BAL RJ,SOP2STA GO BUILD SET SECTOR CMND S20201 08212020 SOP257 EQU * S20201 08220020 * 08228020 BAL RJ,SOP2SCH GO BUILD SRCH AND TIC S20201 08236020 * 08244020 SR RC,RC CLEAR REG S20201 08252020 IC RC,DCBKEYLE GET KL S20201 08260020 AH RC,DCBBLKSI ADD DL S20201 08268020 SR RB,RE BACK UP CCW PTR S20201 08276020 STH RC,D6(RB) KL+DL IN RH OF TIC FOR S20201 08284020 * EOB S20201 08292020 * ROUTINE 08300020 AR RB,RE RESTORE CCW PTR S20201 08308020 * 08320000 * SRCH AND TIC CCWS HAVE BEEN GENERATED AT THIS POINT 08340000 * 08360000 *********************************************************************** 08380000 * 08400000 * 10540000 *********************************************************************** 10560000 * 10580000 * CONSTRUCTION OF WRITE CHANNEL PROGRAMS FOLLOW 10600000 * 10620000 *********************************************************************** 10640000 * 10660000 * 10680000 SOP260 EQU * 10700000 TM DCBMACRF+1,POINTB NOTE-POINT NEEDED 10720000 BZ AA BRANCH IF ZEROS DM0I 10730000 MVI DCBCNTRZ,QSAMZ MOVE ID DM0I 10740000 AA EQU * COME HERE DM0I 10750000 MVI DCBWCPO,48 OFFSET FOR START OF CP. 10780000 MVI DCBWCPL,X'04' WRT C.P. LEN IN DBLE WRDS 10800000 LR RC,RB TEMP HOLD ADDR OF WCKD S20201 10820020 OI FLAGOFF(RB),DATACH SET FLAGS S20201 10840020 MVI CNTOFF(RB),B8 SET BYTE COUNT TO EIGHT S20201 10860020 AR RB,RE INCR CCW PTR S20201 10880020 * 10900020 LR RF,RB GET ADDR OF WRT CCW S20201 10920020 SR RB,RD GET WRT CCW OFFSET S20201 10940020 STC RB,DCBOFFSW PUT IN DCB S20201 10960020 AR RB,RD RESTORE PTR S20201 10980020 * 11080000 TM DCBCIND2,QSAMB IS QSAM USED 11100000 BC 14,SOP262 NO BRANCH 11120000 * 11140000 * 11146020 * 11152020 BAL RJ,SOP2QBF GO GET CCW ADDR S20201 11158020 LA RE,B8 RESTORE CONSTANT REG S20201 11164020 SOP262 EQU * S20201 11170020 AR RB,RE INCR PTR S20201 11176020 * 11182020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 11188020 * READY S20201 11194020 BO SOP265 BRANCH IF YES S20201 11200020 BAL RJ,SOP2RTA GO BUILD RD SECTOR CMND S20201 11206020 MVI DCBWCPL,SIX SET CHP LENGTH TO S20201 11212020 * INCLUDE S20201 11218020 * RCD RDY 11224020 SOP265 EQU * S20201 11230020 TM DCBOPTCD,WRTCK IS WRITE VALIDITY CHECK SPEC 11240000 BC 14,SOP263 NO. BRANCH 11260000 * 11280000 MVI DCBWCPL,X'07' WRITE CHAN PORG LENGTH IF 11300000 * WRITE CHECK IS SPECIFIED 11320000 SR RB,RE BACK UP CCW PTR S20201 11330020 OI FLAGOFF(RB),CC SET CMND CHAIN IN S20201 11340020 * PREVIOUS S20201 11350020 * CCW 11360020 AR RB,RE RESTORE PTR S20201 11370020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 11380020 * READY S20201 11390020 BO SOP262A BRANCH IF YES S20201 11400020 BAL RJ,SOP2RTA GO TO RD SECT BUILD RTN S20201 11410020 SR RB,RE BACKUP CCW PTR S20201 11420020 OI FLAGOFF(RB),CC TURN ON CMND CHAIN S20201 11430020 MVI D0(RB),SETSC CHANGE CMND TO SET SECT S20201 11440020 AR RB,RE RESTORE PTR S20201 11450020 MVI DCBWCPL,TEN SET CHP SIZE TO INCLD. S20201 11460020 * RCD S20201 11470020 SOP262A EQU * S20201 11480020 LA RF,B24(RB) PT RF TO CNT FIELD AT S20201 11490020 * END S20201 11500020 * CHANNEL PROG 11510020 * 11520020 ST RF,D0(RC) PUT ADD IN WRT CKD CCW S20201 11530020 MVI D0(RC),WRTCKD PUT IN CCW CMND S20201 11540020 * 11550020 LR RC,RF PUT ADDR IN REG FOR SRCH S20201 11560020 * AND TIC RTN 11570020 BAL RJ,SOP2SCH GO BLD SCH CCW S20201 11580020 * 11590020 MVI D0(RB),RDKD SET READ CMND FOR WRT S20201 11600020 * CHK S20201 11610020 OI FLAGOFF(RB),SKIP TURN ON SKIP FLAG S20201 11620020 AR RB,RE INCR PTR S20201 11630020 * 11640020 B SOP266 GO TO FIN IOB S20201 11650020 SOP263 EQU * S20201 11660020 ST RB,D0(RC) PUT ADDR IN WRT CKD S20201 11670020 MVI D0(RC),WRTCKD PUT IN WRT CKD CMND S20201 11680020 * 11690020 * 11700020 SOP266 EQU * S20201 11710020 MVC D5(B1,RB),DCBKEYLE INIT KEY LENGTH S20201 11720020 AR RB,RE INCR PTR S20201 11730020 BCT RUCB,SOP242 NOT LAST IOB - BRANCH A37507 11780021 L RB,DCBIOBA LAST IOB - LINK IOB'S A37507 11830021 USING IOBQSAMD,RD ESTABLISH ADDR FOR IOB M0131 11880021 * DSECT A37507 11930021 ST RB,IOBNIOBA FIRST TO LAST A37507 11980021 DROP RD M0131 12050021 * 12120000 *********************************************************************** 12140000 * 12160000 SOP2END EQU * 12180000 * 12200000 * 12220000 *********************************************************************** 12240000 TM DCBDSORG,X'02' DCB FOR PO 12260000 BC 8,SOP2ENDA NO, BRANCH 12280000 * 12300000 MVI DCBCNTRZ,QSAMZ DM0I 12320000 * 12340000 SOP2ENDA EQU * 12360000 * 12380000 L RB,DCBIOBA GET FIRST IOB 12400000 OI 0(RB),FIRSTIOB SET INDICATOR ON FOR CLOSE 12420000 LR RC,RB SAVE ADDR FOR QSAM USE 12440000 TM DCBRECFM,FORMATV VARIABLE FORMAT ? DM0I 12450000 BZ SOP2STOP BRANCH NOT V FORMAT DM0I 12460000 TM DCBRECFM,FORMATF FIXED FORMAT DM0I 12470000 BC 1,SOP2STOP YES, BRANCH DM0I 12480000 MVC 0(5,RWTGC),SOPSLDVT VARIABLE, GET 1915 DM0I 12490000 B RELOOP BACK TO MAIN LINE DM0I 12500000 SOP2STOP EQU * 12540000 MVC 0(5,RWTGC),SOPSLDFT GET LOAD EXEC 12560000 * 12580000 RELOOP LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURR WTG ENTRY 12600000 LA RPARC,PLOFF(0,RPARC) INCR CURRENT DCB ENTRY PRTR 12620000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 12640000 BCR RWTGC,RBASE BACK TO OPEN CONTROL ROUTINDM0I 12660000 * 12680000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 12700000 BC 7,RELOOP NO,CHECK NEXT ENTRY 12720000 * 12740000 LR RPARC,RPAR 12760000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE WTG LIST PTR 12780000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 12800000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 12820000 * 12840000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 12860000 LA RPARC,PLOFF(0,RPARC) 12880000 B ZCHEK TO ZERO CHECK DM0I 12900000 * 12920000 TCTLRTN EQU * 12940000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 12960000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 12980000 * 13000000 * 13020000 ******************************************************************** 13040000 * 13060000 LA 15,DXXCTL SET UP FOR XCTL S21042 13080021 ** 13100000 XCTL DE=(RWTG),SF=(E,(15)) 13120000 ** 13140000 * 13160000 ********************************************************************* 13180000 * 13200000 * THE FOLLOWING CODE SET UP THE CCW WITH COUNT AND ADDRESS. 13220000 SOP2QBF EQU * 13240000 LR RE,RJ 13260000 L RTIOT,DCBBUFCB 13280000 L RJ,0(RTIOT) 13300000 LTR RJ,RJ VALID BUFFER ADDRESS M1552 13306000 BE BUFERR NO, BRANCH TO ABEND M1552 13312000 MVC 1(3,RF),1(RTIOT) 13320000 MVC 1(3,RTIOT),1(RJ) 13340000 MVC 6(2,RF),DCBBLKSI 13360000 LR RJ,RE 13380000 BR RJ EXIT DM0I 13400000 * 13420000 ********************************************************************** 13440000 * * 13460000 BUFERR EQU * M1552 13464000 DMABCOND OABD060,PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X13468021 CALL PROBLEM DETERMINATION 13472021 B TCTLRTN S21042 13476021 WAOFF EQU 32 13480000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 13500000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 13520000 OPIDCNST DC C'0S' ID DM0I 13540000 AMIDCNST DC C'1D' ID DM0I 13560000 ONEIOB DC H'1' TEST FOR ONE IOB A37507 13570021 * 13580000 *********************************************************************** 13600000 * 13604020 * SEARCH AND TIC BUILDING RTN 13608020 * 13612020 SOP2SCH EQU * S20201 13616020 ST RC,D0(RB) STORE SRCH ADDR IN CCW S20201 13620020 MVI CNTOFF(RB),FIVE SET CNT TO FIVE S20201 13624020 OI FLAGOFF(RB),CC SET CMND CHAIN FLAG S20201 13628020 MVI D0(RB),SRCHE PUT IN SRCH CMND S20201 13632020 ST RB,B8(RB) PUT SRCH ADDR IN NEXT S20201 13636020 * CCW S20201 13640020 AR RB,RE INCR PTR FOR SEARCH S20201 13644020 MVI D0(RB),TIC PUT IN TIC CMND S20201 13648020 AR RB,RE INCR PTR FOR TIC S20201 13652020 BR RJ RETURN S20201 13656020 * 13660020 * SET SECTOR BUILD RTN 13664020 * 13668020 SOP2STA EQU * S20201 13672020 L RF,DXCCW11 GET THETA ADDR S20201 13676020 ST RF,D0(RB) PUT IN CCW S20201 13680020 OI FLAGOFF(RB),CC TURN ON CMND CHAIN S20201 13684020 MVI D0(RB),SETSC PUT IN CMND S20201 13688020 B SOP2FIN GO TO FINISH CCW S20201 13692020 * 13696020 * 13700020 * 13704020 * READ SECTOR BUILD RTN 13708020 * 13712020 SOP2RTA EQU * S20201 13716020 L RF,DXCCW12 GET THETA ADDR S20201 13720020 ST RF,D0(RB) PUT IN CCW S20201 13724020 SR RB,RE BACK UP PTR S20201 13728020 OI FLAGOFF(RB),CC TURN CMND CHAIN ON IN S20201 13732020 AR RB,RE RESTORE PTR S20201 13736020 MVI D0(RB),RDSC PUT IN CCW CMND S20201 13740020 SOP2FIN EQU * S20201 13744020 MVI CNTOFF(RB),B1 SET BYTE CNT TO ONE S20201 13748020 AR RB,RE INCR PTR S20201 13752020 BR RJ RETURN S20201 13756020 * 13780000 * 13800000 * 13820000 * 13840000 * 13860000 * 13880000 XCTLTABL ID=(SOPSLDFT,10,SOPSLDVT,15,SOPSLDIN,1O, S21042,13910021 PDLOAD,6M, S21042,13940021 SOPSD,9O),SVC=019 S21042 13970021 IECDSECS DCB,MAIN,EXPAND=YES S21042 13990021 * A37507 13992021 * PREFIX FOR NORMAL SCHEDULING IOB A37507 13994021 * A37507 13996021 ORG DXIOB-8 LOCATION OF NORMAL SCHEDULING A37507 13998021 * PREFIX A37507 14000021 IOBQSAMD DS 0D BEGIN PREFIX A37507 14002021 IOBNIOBA DS 0A LINK FIELD A37507 14004021 IOBNFLG1 DS B I/O FLAGS A37507 14006021 IOBPRTOV EQU X'80' PRINTER OVERFLOW LAST I/O A37507 14008021 IOBWRITE EQU X'40' LAST I/O WAS A WRITE A37507 14010021 IOBREAD EQU X'20' LAST I/O WAS A READ A37507 14012021 IOBUPDAT EQU X'10' THIS BLOCK TO BE UPDATED A37507 14014021 IOBBKSPC EQU X'08' LAST I/O BSP,N/P,CNTRL A37507 14016021 IOBSPAN EQU X'04' LOGICAL REC INTERFACE A37507 14018021 IOBFIRST EQU X'01' FIRST IOB IN CHAIN A37507 14020021 IOBNIOBB DS AL3 THREE BYTE LINK ADDR A37507 14022021 IOBNECB DS 1F EVENT CONTROL BLOCK A37507 14024021 DCBCNTRZ EQU DCBCNTRL+1 DM0I 14026000 DCBCNTRX EQU DCBCNTRL+3 DM0I 14032000 CVT DSECT 14040000 CVT 14060000 * 14080000 * 14100000 * DATA EXTENT BLOCK 14120000 CNOP 0,4 FULL WORD ALIGN DM0I 14140000 BLDEB DSECT 14160000 DEBNMSUB DS 0CL1 NO. OF SUB. DM0I 14180000 DEBTCBAD DS CL4 TCB ADDR. DM0I 14200000 DEBAMLNG DS 0CL1 ACCESS METHOD LEN. DM0I 14220000 DEBDEBAD DS CL4 DEB ADDR. DM0I 14240000 DEBOGLGS DS 0CL1 OPTION DM0I 14260000 DEBIRBAD DS CL4 IRB ADDRESS DM0I 14280000 DEBOPATB DS 0CL1 OPTION DM0I 14300000 DEBSYSPG DS CL4 SYS ABEND DM0I 14320000 DEBNMEXT DS 0CL1 NO. OF EXTENT DM0I 14340000 DEBUSRPG DS CL4 USER PROG. DM0I 14360000 DEBPRIOR DS 0CL1 PRIORITY DM0I 14380000 DEBECBAD DS CL4 ECB ADDRESS. DM0I 14400000 DEBPROTG DS 0CL1 PROTECTION KEY DM0I 14420000 DEBDEBID DS 0CL1 DEB ID DM0I 14440000 DEBDCBAD DS CL4 DCB ADDRESS DM0I 14460000 DEBEXSCL DS 0CL1 EXCEPTION DM0I 14480000 DEBAPPAD DS CL4 APPENDAGE ADDRESS DM0I 14500000 DEBDVMOD DS 0CL1 DEVICE DM0I 14520000 DEBUCBAD DS CL4 UCB ADDRESS DM0I 14540000 DEBBINUM DS CL2 BIN NUMBER DM0I 14560000 DEBSTRCC DS CL2 START CYC. DM0I 14580000 DEBSTRHH DS CL2 START TRACK DM0I 14600000 DEBENDCC DS CL2 END CYCLINDER DM0I 14620000 DEBENDHH DS CL2 END TRACK DM0I 14640000 DEBNMTRK DS CL2 NO. OF TRACKS DM0I 14660000 TITLE 'FORMAT OF GOTTEN CORE' 14680000 * 14700000 * 14720000 END 14780000 ./ ADD SSI=21340161,NAME=IGG0191E,SOURCE=0 TITLE 'IGG0191E OPEN INPUT EXECUTOR EXCHANGE BUFFER DA, TAPE' 00020021 * RELEASE 18 DELETIONS 00021018 *3004 8M616 00022018 * RELEASE 19 DELETIONS 00023018 * RELEASE 20 DELETIONS 00024018 *1396 S20038 00024220 *1396017600,017800,025400,026800,030600-030800,036400,038200, S20201 00024420 *1396039200,042200,045600-046400,059000,059600,060000-060200, S20201 00024620 *1396060600,062200-062400,062800,063000,063400,065800,069000, S20201 00024820 *1396069400,070200-075200,076800-077400,077600,079000,079400- S20201 00025020 *1396079600,079800,080600-080800,081200-082200,089400-089800, S20201 00025220 *1396090800-091000,091800,092400 S20201 00025420 * RELEASE 21 DELETIONS 00026421 *0113030700 A44816 00026921 * A37507 00027421 *0113091160-092400 M0091 00027921 *0113083800 A46361 00028321 * RELEASE 22 DELETIONS 00028421 * RELEASE 23 DELETIONS 00029421 * * 00032018 *STATUS CHANGE LEVEL 002 00033020 * * 00034018 * THIS MODULE SPLIT INTO IGG0196J FOR RELEASE 21 00037021 *FUNCTION * 00040000 * 1 CALCULATE AMT OF CORE NEEDED FOR IOB'S/ICB'S FOR MOD 00060021 * IGG0196J 00080021 * 2 ISSUE GETMAIN FOR REQUIRED AMT OF CORE 00100021 * 3 CLEAR CORE 00120021 * 4 TESTS FOR MODES & RECFM NOT ALLOWED WITH EXCH BUFFERING 00140021 * 5 SETS CODES IN DCBCNTRL FIELD FOR PROPER LOADING OF EOB RTNS 00160021 * 00180021 * * 00240000 *ENTRY POINT * 00260000 * IGG0191E BY XCTL FROM IGG0196B OR IGG0193I 00280021 * * 00300000 *INPUT * 00320000 * SEE REGISTER DESCRIPTION,DCB * 00340000 * * 00360000 *OUTPUT * 00380000 * SEE REGISTER DESCRIPTION * 00400000 * * 00420000 * USERS DCB * 00440000 *EXTERNAL ROUTINES-NONE * 00460000 * * 00480000 *EXITS * 00500000 * NORMAL IGG0196J TO CONSTRUCT IOB'S 00510021 * ABNORMAL IGG0191D FOR DISK WHEN EXCHANGE BUFFERING NOT SUPPORTED 00520021 * ABNORMAL IGG0191G FOR TAPE WHEN EXCHANGE BUFFERING NOT SUPPORTED 00530021 * * 00540000 * ERROR-NONE * 00560000 * * 00580000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00600000 * 00620000 * BYTE 0-7 NAME 00640000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00660000 * BYTE 11 CONCATENATION NUMBER 00680000 * BYTE 12 ZERO 00700000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00720000 * ALIAS INDICATOR 1 BIT 00740000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00760000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00780000 * BYTE 17 ZERO 00800000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00820000 * BYTE 20 TRANSLATION TABLE 00840000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00860000 * BYTE 22-23 ATTRIBUTES 00880000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00900000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00920000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00940000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00960000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00980000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 01000000 * BYTE 36-39 TABLE OF IDTTR'S 01020000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01040000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01060000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01080000 * NOT USED (1 BYTE) 01100000 * * 01120000 *ATTRIBUTES * 01140000 * REENTRANT,REUSABLE * 01160000 *NOTES * 01180000 * ALL REG EQUATES HAVE AN 'R' AT BEGINNING OR END OF SYMBOL * 01200000 * THIS EXECUTOR IS TO BE USED ONLY WHEN EXCHANGE BUFFERING IS * 01220000 * INDICATED IN DCB * 01240000 * * 01260000 RDCB EQU 2 DCB 01280000 RBASE EQU 3 BASE 01300000 RCORE EQU 4 WORK AREA ADDRESS 01320000 RPAR EQU 5 TOP OF PARAMETER LIST 01340000 RWTG EQU 6 TOP OF WTG TABLE 01360000 RPARC EQU 7 CURRENT PARAMETER 01380000 RWTGC EQU 8 CURRENT TRANSFER LOAD 01400000 RTIOT EQU 9 WORK REG & COMM VECTOR TABLE 01420000 * IOB COUNTER DURING IOB CONST * 01440000 RDEB EQU 11 01480000 RB EQU 12 01500000 RD EQU 14 01540000 RJ EQU 15 CCW ADDRESS 01560000 RE EQU 0 BLOCKING FACTOR DURING CHP CONST 01580000 RF EQU 1 IOB ADDRESS 01600000 DISK EQU X'20' 01640000 FSTD EQU X'88' 01660000 FORMATD EQU X'20' D FORMAT RECORDS S20038 01683020 USASCII EQU X'08' USASCII TAPE S20038 01692020 ZERO EQU X'0' CONSTANT OF ZERO S20038 01695020 * 01700000 ********************************************************************** 01720000 * 01758520 * MASKS, INDICATORS, DISPLACEMENTS, AND CCW COMMANDS 01759020 * 01759520 SDOPT EQU X'08' SEARCH DIRCT OPTION S20201 01760020 NONCARN EQU X'20' NON DISCONNECT FEAT MASK S20201 01761020 * 01761520 D1 EQU 1 DISP OF ONE S20201 01762520 D2 EQU 2 DISP OF 2 S20201 01763020 D3 EQU 3 DISP OF THREE S20201 01763520 D6 EQU 6 DISP OF SIX S20201 01764520 B4 EQU 4 BYTE COUNT OF 4 S20201 01768020 * 01768520 CCWLEN EQU 8 CCW LENGTH S20201 01770020 SLI EQU X'20' SILI FLAG S20201 01773520 * 01788020 * 01789020 IGG0191E CSECT 01789521 * 01790020 BALR RBASE,RE ESTABLISH ADDRESSING S20201 01791020 USING ENTRY1,RBASE 01800000 USING IHADCB,RDCB 01820000 USING FORCORE,RCORE 01840000 * * 01860000 ENTRY1 EQU * 01880000 * * 01900000 L RDCB,0(0,RPARC) DCB ADDRESS 01920000 L RCORE,B4(RWTGC) INIT O/C/E WORK AREA S20201 01930020 LA RDCB,0(0,RDCB) CLEAR BYTE ZERO 01940000 OI DCBCIND1,X'01' TURN ON EXCHANGE BIT 01960000 *********************************************************************** 01980000 * TEST FOR MODES AND RECORD FORMATS NOT ALLOWED WITH EXC * 02000000 * BUFFERING 02020000 *********************************************************************** 02040000 * 02060000 TM DCBMACRF,X'10' TEST FOR MOVE MODE 02080000 BO OUT GO TO SIMPLE BUFFERING EXEC 02100000 TM DCBOPTCD,USASCII USASCII TAPE S20038 02102020 BZ NEXTCHEK NO, BRANCH S20038 02104020 TM DCBRECFM,FORMATD D-FORMAT RECORDS S20038 02106020 BO OUT YES, GIVE SIMPLE BUFFER S20038 02108020 CLI DCBBUFOF,ZERO BLOCK PREFIX EQUAL ZERO S20038 02110020 BNE OUT NO, BRANCH-GIVE SIMPLE S20038 02112020 * BUFFERING 02114020 NEXTCHEK EQU * S20038 02116020 * 02120000 TM DCBRECFM,X'C0' TEST FOR U RCD 02140000 BC 9,CONTINUE CONTINUE FOR U RCD 02160000 * 02180000 TM DCBRECFM,X'40' TEST FOR V RECORD 02200000 BZ FRCD CONTINUE FOR F RECORD 02220000 * 02240000 TM DCBRECFM,X'10' BLOCKED V RECORD 02260000 BO OUT YES BRANCH 02280000 TM DCBMACRF,X'08' TEST FOR LOCATE MODE 02300000 BO FRCD V WITH SUB NOT ALLOWED 02320000 OUT EQU * 02340000 NI DCBCIND1,X'FE' TURN OFF EXC BIT GOING TO SIMPL 02360000 MVC 0(5,RWTGC),SOP2 ID DISK SIMPLE EXECUTOR 02380000 * 02400000 TM DCBDEVT,DISK IS DEVICE A DISK 02420000 BO RELOOP YES TRANSFER CONTROL 02440000 * 02460000 MVC 0(5,RWTGC),SOP5 ID FOR TAPE EXEC 02480000 B RELOOP TRANSFER CONTROL 02500000 CONTINUE EQU * 02520000 OI DCBQSWS,SLI SILI FLG FOR U RECS S20201 02540020 FRCD EQU * 02560000 TM DCBRECFM,X'10' USING BLOCKED RECORDS 02580000 BO EA00 BRANCH ON YES 02600000 * 02620000 MVC DCBLRECL(2),DCBBLKSI USE BLOCKSIZE FOR ALL UNBLOCKED 02640000 EA00 EQU * 02660000 LA RDEB,CCWLEN CONSTANT OF 8 USED LATER S20201 02680020 * 02700000 * THIS SECTION DOWN TO GET MAIN DETERMINES AMT OF CORE TO GET 02720000 * BLOCKING FACTOR,SEGMENTED LENGTH,ADDRESSES DD ROUTINE 02740000 * * 02760000 * * 02780000 * DETERMINE BLOCKING FACTOR,BLOCKSIZE DIVIDED BY LRECL 02800000 * * 02820000 * * 02840000 * * 02860000 LH RJ,DCBBLKSI BLOCKSIZE IN ODD REG 02880000 LH RE,DCBLRECL LOGICAL RECORD LENGTH 02900000 SR RD,RD CLEAR REG 02920000 DR RD,RE 02940000 STH RJ,DCBEROPT+4 SAVE BLOCKING FACTOR 02960000 * * 02980000 * * 03000000 * DETERMINE SEGMENT SIZE,BUFFERSIZE DIVIDED BY BLOCKING FACTOR * 03020000 * * 03040000 SR RF,RF ZERO REG FOR LOAD A44816 03050021 AH RF,DCBBUFL GET BUFL AND SET A44816 03060021 * CONDITION CODE A44816 03070021 BC 6,E0000 BRANCH THERE IS A BUFFER LENGTH 03100000 * 03120000 LH RF,DCBLRECL ASSUME LRECL AS SEG LENGTH 03140000 * AS THERE IS NO BUFFER LENGTH 03160000 B E0001 BRANCH TO STORE LENGTH 03180000 * 03200000 E0000 EQU * 03220000 SR RE,RE CLEAR REG 03240000 DR RE,RJ 03260000 E0001 EQU * 03280000 STH RF,DCBPRECL SAVE SEGMENTED LENGTH 03300000 TM DCBBFALN,X'03' IS ALIGNMENT SPECIFIED 03320000 BZ E0002 BRANCH ON NO 03340000 * 03360000 TM DCBRECFM,X'90' TEST FOR FB RECORD 03380000 BC 14,E0002 NOT FB NO ALIGNMENT PERFORMED 03400000 * 03420000 NI DCBPRECL+1,X'F8' ROUND SEG LENGTH TO DBL WORDS 03440000 CLC DCBPRECL(2),DCBLRECL COMPARE LRECL TO SEG LENGTH 03460000 BL OUT SUPPLY SIMPLE BUFFERING 03480000 E0002 EQU * 03500000 * * 03520000 * DETERMINE NO OF BUFFERS TIMES EIGHT AND HOLD IN REG * 03540000 * * 03560000 SR RF,RF CLEAR REG 03580000 IC RF,DCBBUFNO GET BUFNO 03600000 LR RTIOT,RF COPY BUFNO 03620000 MR RE,RDEB EIGHT TIMES VALUE S20201 03640020 * * 03660000 * AT THIS POINT RF=8N,RJ=BLOCK FACTOR,RTIOT=BUFNO * 03680000 * * 03700000 * USE RB FOR COUNTER TO DETERMINE AMT OF CORE TO GET * 03720000 * 03740000 MVI DCBCNTRL+3,X'02' INDICATE EOB MODULE FOR LOAD 03760000 LR RB,RJ COPY BLOCK FACTOR 03780000 LA RB,5(0,RB) ADD 5 TO BF FOR TAPE 03800000 * 03840000 TM DCBDEVT,DISK IS IT DISK 03860000 BZ E0004 BRANCH IF NOT DISK 03880000 * 03900000 * 03940000 LA RB,3(0,RB) ADD 3 TO BF FOR SRCH PREV 03960000 * 03980000 TM DCBRECFM,FSTD Q-F STD CHP WANTED 04000000 BC 14,E0003 NO WANT SEARCH PREV 04020000 * 04040000 MVI DCBCNTRL+3,X'01' INDICATE EOB MODULE FOR FSTD 04060000 B E0004 04080000 * 04100000 E0003 EQU * 04120000 LA RB,2(0,RB) ADD 2 TO BF FOR SRCH PREV 04140000 TM JFCBMASK+D6,SDOPT IS SEARCH DIRECT USED S20201 04142020 BZ NODIRECT BRANCH IF NO S20201 04144020 LA RB,D2(RB) INCR CCW COUNT S20201 04146020 OI DCBQSWS,SLI SET SILI FOR SCH DIR S20201 04148020 * 04150020 NODIRECT EQU * S20201 04152020 E0004 EQU * 04160000 * 04162020 * CHECK FOR DISCONNECT FEATURE ON ALL DEVICES, IF YES 1 MORE CCW 04164020 * 04166020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 04168020 * DISCONNECT S20201 04170020 BO E0005 BRANCH IF YES S20201 04172020 LA RB,D3(RB) INCREMENT FOR 3 CCWS S20201 04174020 E0005 EQU * S20201 04176020 STC RB,DCBIOBL PUT IN DCB NO. OF DWS S20201 04178020 MR RE,RB CALCULATE AMOUNT OF CORE TO GET 04180000 * AMOUNT IN REG F 04200000 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 04205020 * DISCONNECT S20201 04210020 BO E0006 BRANCH IF YES S20201 04215020 AR RF,RDEB INCR TOTAL SPACE BY 8 S20201 04220020 E0006 EQU * S20201 04225020 LR RB,RF SAVE AMOUNT FOR CLEARING S20201 04230020 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04240000 * * 04260000 * * 04280000 GETMAIN R,LV=(RB),SP=250 04300000 * * 04320000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04340000 * 04360000 * THIS SECTION CLEARS CORE,INITILIZES DCB FOR IOB OR ICB 04380000 * ADDRESS SETS IOBL SO CLOSE CAN FREE CORRECT AMT OF CORE 04400000 * 04420000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04440000 * 04460000 ST RF,DCBIOBA ADDRESS OF IOB TO DCB 04480000 LR RD,RF COPY ADDRESS USE WHEN CLEARING 04500000 * 04501020 * SET UP THETA ADDRS FOR POSSIBLE USE LATER 04502020 * 04503020 LR RJ,RB COPY CORE AMOUNT S20201 04504020 AR RJ,RF OBTAIN WORK AREA+1 ADDR S20201 04505020 SR RJ,RDEB BACKUP ONE DW S20201 04506020 ST RJ,DXCCW11 TEMP STORE SET THETA S20201 04507020 * ADDR S20201 04508020 LA RJ,D1(RJ) INCREMENT BY ONE BYTE S20201 04509020 ST RJ,DXCCW12 TEMP STORE RD THETA ADDR S20201 04510020 LR RJ,RB COPY AMT FOR CLEARING 04520000 * * 04540000 * 04660000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04680000 * CLEAR CORE HERE 04700000 * * 04720000 * RJ HAS AMT TO CLEAR RD = ADDRESS OF CORE 04740000 * * 04760000 LA RB,256 CONSTANT 256 04780000 B CLEAR 04800000 LO XC 0(1,RD),0(RD) CLEARS REMAINING BYTES 04820000 HI XC 0(256,RD),0(RD) CLEARS 256 BYTES 04840000 AR RD,RB ADD 256 TO ADDRESS 04860000 CLEAR SR RJ,RB SUBTRACT 256 FROM AMOUNT 04880000 BH HI IF MORE THAN 256 TO CLEAR BRANCH 04900000 AR RJ,RB TO CORRECT THE AMOUNT 04920000 BCTR RJ,0 TO CORRECT THE AMOUNT 04940000 EX RJ,LO CLEAR REMAINING BYTES 04960000 * * 04980000 * * 05000000 * * 05020000 MVI DCBCCCW,X'02' CMND BYTE FOR TAPE 05040000 MVC 0(5,RWTGC),NXTEXEC XCTL TO LOAD EXECUTOR 08320000 * 08340000 RELOOP EQU * 08360000 LA RWTGC,8(0,RWTGC) INCREMENT CURR WTG ENTRY 08400000 LA RPARC,4(0,RPARC) INC CURRENT DCB ENTRY PTR 08420000 CLC 0(2,RWTGC),AMIDCNST Q- THIS RT NEEDED AGAIN 08440000 BCR 8,RBASE 08460000 * 08480000 CLC 0(2,RWTGC),OPIDCNST Q- END OF TABLE 08500000 BC 7,RELOOP NO-CHECK NEXT ENTRY 08520000 * 08540000 LR RPARC,RPAR 08560000 LA RWTGC,32(0,RWTG) REINIT WTG LIST PTR 08580000 ZCHEK EQU * 08600000 CLI 0(RWTGC),X'00' Q-IS THIS ENTRY COMPLETE 08620000 BC 7,TCTLRTN 08640000 * 08660000 LA RWTGC,8(0,RWTGC) GET NEXT ENTRY 08680000 LA RPARC,4(0,RPARC) 08700000 B ZCHEK 08720000 * 08740000 TCTLRTN EQU * 08760000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 08780000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 08800000 LA RJ,DXXCTL SET UP FOR XCTL 08820021 * 08840000 XCTL DE=(RWTG),SF=(E,(15)) 08860000 * 08880000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08900000 * 09020000 AMIDCNST DC C'1E' THIS ID 09040000 OPIDCNST DC C'0S' END ID 09060000 * 09104020 * 09108020 * 09112020 XCTLTABL ID=(SOP2,1D,SOP5,1G,NXTEXEC,6J),SVC=019 M0091 09182021 DCBD DSORG=PS 09260000 IECDSECS MAIN,EXPAND=YES 09290021 END 09320000 ./ ADD SSI=03011832,NAME=IGG0191F,SOURCE=0 TITLE 'IGG0191F OUTPUT EXC BUFFER EXECUTOR ' 00020000 * RELEASE 18 DELETIONS 00021018 *3004090400 8M616 00021518 *3004 21476 00022018 * RELEASE 19 DELETIONS 00023018 *1396079640-079760 A25961 00023519 * RELEASE 20 DELETIONS 00024018 *0972 S20038 00024520 *0972024600-024800,033800,052400,060600-060800,064200,067200, S20201 00024620 *0972076600,082200,085400,085800 S20201 00024720 * RELEASE 21 DELETIONS 00025018 *0082004400,074200,090400-090800,091600-093000,093200-093600 S21042 00025520 * RELEASE 22 DELETIONS 00026018 * RELEASE 23 DELETIONS 00027018 * RELEASE 24 DELETIONS 00028018 * RELEASE 25 DELETIONS 00029018 * RELEASE 26 DELETIONS 00030018 *STATUS CHANGE LEVEL 003 00035020 *FUNCTION * 00040000 * 1.GET CORE FOR IOB'S AND CHANNEL PROGRAMS 00060000 * 2 CLEAR CORE 00080000 * 3 CONSTRUCT IOBS AND CHANNEL PROGRAMS FOR DISK AND TAPE 00100000 * * 00120000 *ENTRY POINT * 00140000 * IGG0191F BY XCTL 00160000 * * 00180000 *INPUT * 00200000 * SEE REGISTER DESCRIPTION * 00220000 * * 00240000 *OUTPUT * 00260000 * SEE REGISTER DESCRIPTION * 00280000 * IOBS AND CHANNEL PROGRAMS * 00300000 * * 00320000 *EXTERNAL ROUTINES-NONE * 00340000 * * 00360000 *EXITS * 00380000 * NORMAL BY XCTL TO IGG01924 LOAD EXECUTOR 00400000 * * 00420000 * ERROR - XCTL TO PROB DET (IGG0196M) FOR WTP AND 013 ABEND 00440020 * * 00460000 *TABLES/WORKAREAS * 00480000 * * 00500000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00520000 * 00540000 * BYTE 0-7 NAME 00560000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00580000 * BYTE 11 CONCATENATION NUMBER 00600000 * BYTE 12 ZERO 00620000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00640000 * ALIAS INDICATOR 1 BIT 00660000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00680000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00700000 * BYTE 17 ZERO 00720000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00740000 * BYTE 20 TRANSLATION TABLE 00760000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00780000 * BYTE 22-23 ATTRIBUTES 00800000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00820000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00840000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00860000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00880000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00900000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 00920000 * BYTE 36-39 TABLE OF IDTTR'S 00940000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 00960000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 00980000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01000000 * NOT USED (1 BYTE) 01020000 * 01040000 *ATTRIBUTES * 01060000 * REENTRANT,REUSABLE * 01080000 * * 01100000 *NOTES * 01120000 * ALL REG EQUATES HAVE AN 'R' AT BEGINNING OR END OF SYMBOL * 01140000 * THIS ROUTINE IS ONLY USED FOR EXCHANGE BUFFERING.IMBEDDED 01160000 * CONSTANTS FROM THE INSTRUCTION STREAM ARE USED 01180000 * * 01200000 RDCB EQU 2 DCB 01220000 RBASE EQU 3 BASE 01240000 RCORE EQU 4 WORK AREA ADDRESS 01260000 RPAR EQU 5 TOP OF PARAMETER LIST 01280000 RWTG EQU 6 TOP OF WTG TABLE 01300000 RPARC EQU 7 CURRENT PARAMETER 01320000 RWTGC EQU 8 CURRENT TRANSFER LOAD 01340000 RTIOT EQU 9 IOB COUNTER 01360000 RUCB EQU 10 BRANCH REG TO DD SUBRT 01380000 RDEB EQU 11 01400000 RB EQU 12 CONSTANT 1(TAPE)RD CNT ADDR DISK 01420000 RC EQU 13 BUFFER ADDRESS 01440000 RD EQU 14 01460000 RJ EQU 15 CCW ADDRESS 01480000 RE EQU 0 BLK FACTOR DURING CHP CONST 01500000 RF EQU 1 IOB ADDRESS 01520000 DISK EQU X'20' 01540000 PCI EQU X'20' 01560000 DOUBLE EQU X'02' 01580000 ***************************************************************** DMOR 01580120 * DMOR 01580220 * OFFSETS, MASKS, INDICATORS, AND CCW COMMAND CODES 01580320 * DMOR 01580420 FLAGOFF EQU 4 CCW FLAG OFFSET S20201 01580520 CNTOFF EQU 7 CCW BYTE COUNT OFFSET S20201 01580620 CCWOFF EQU 8 CCW LENGTH S20201 01580720 CHPOFF EQU 24 OFFSET TO CHP START ADDR S20201 01580820 D0 EQU 0 DISP OF ZERO S20201 01580920 D1 EQU 1 DISP OF ONE S20201 01581020 D2 EQU 2 DISP OF TWO S20201 01581120 D4 EQU 4 DISP OF FOUR S20201 01581220 D6 EQU 6 DISP OF SIX S20201 01581320 D8 EQU 8 DISP OF EIGHT S20201 01581420 CC EQU X'40' COMMAND CHAINING FLAG S20201 01581520 SETSC EQU X'23' SET SECTOR CCW COMMAND S20201 01581620 RDSC EQU X'22' READ SECTOR CCW COMMAND S20201 01581720 NONCARN EQU X'20' NOW DISCONNECT INDICATOR S20201 01581820 FORMATD EQU X'20' D FORMAT RECORDS S20038 01583020 L EQU X'40' BUFOFF=(L) S20038 01586020 BLOCKED EQU X'10' BLOCKED RECORDS S20038 01589020 USASCII EQU X'08' USASCII TAPE S20038 01592020 ZERO EQU X'0' CONSTANT OF ZERO S20038 01595020 OABD063 EQU 63 S21042 01597020 IGG0191F CSECT 01600000 * 01602018 * 01604018 * 01606018 * 01608018 * 01610018 * 01612018 * 01614018 * 01616018 * 01618018 BALR RBASE,0 01620000 USING ENTRY1,RBASE 01640000 USING IHADCB,RDCB 01660000 USING FORCORE,RCORE 01680000 * * 01700000 *********************************************************************** 01720000 * THIS SECTION DETERMINES AMT OF CORE NEEDED FOR IOBS 01740000 * AND CHANNEL PROGRAMS 01760000 * * 01780000 *********************************************************************** 01800000 * * 01820000 ENTRY1 EQU * 01840000 L RDCB,0(0,RPARC) DCB ADDRESS 01860000 L RCORE,D4(RWTGC) INIT O/C/E WORK AREA S20201 01870020 LA RDCB,0(0,RDCB) CLEAR BYTE ZERO 01880000 ********************************************************************** 01900000 * TEST FOR MODES AND RECORD FORMATS NOT SUPPORTED FOR EXC BUFF 01920000 ********************************************************************** 01940000 * 01960000 TM DCBOPTCD,USASCII USASCII TAPE S20038 01962020 BZ NEXTCHEK NO, BRANCH S20038 01964020 TM DCBRECFM,FORMATD D-FORMAT RECORDS S20038 01966020 BO NOALLOW YES, GIVE SIMPLE BUFFER S20038 01968020 CLI DCBBUFOF,ZERO BLOCK PREFIX EQUAL ZERO S20038 01970020 BNE NOALLOW NO, BRANCH - GIVE S20038 01972020 * SIMPLE BUFFERING. 01974020 NEXTCHEK EQU * S20038 01976020 TM DCBMACRF+1,X'04' TEST FOR SUBSTITUTE MODE 01980000 BZ MMODE BRANCH NOT SUBSTITUTE 02000000 * 02020000 TM DCBRECFM,X'C0' TEST FOR U RECORD 02040000 BC 9,CONTINUE BRANCH ON YES 02060000 * 02080000 TM DCBRECFM,X'40' TEST FOR V RECORD 02100000 BO NOALLOW 'V' NOT ALLOWED 02120000 * 02140000 MMODE EQU * 02160000 TM DCBMACRF+1,X'14' TEST FOR MOVE OR SUBS MODE 02180000 BM CONTINUE CONTINUE IF EITHER ONE 02200000 * 02220000 NOALLOW EQU * 02240000 NI DCBCIND1,X'FE' TURN OFF EXC BIT GOING TO SIMPL 02260000 MVC 0(5,RWTGC),SOP2 MOVE DISK ID TO WTG 02280000 TM DCBDEVT,DISK TEST FOR DISK 02300000 BO RELOOP 02320000 MVC 0(5,RWTGC),SOP5 MOVE TAPE ID TO WTG 02340000 B RELOOP 02360000 CONTINUE EQU * 02380000 TM DCBRECFM,X'50' TEST FOR VB RECORD NOT ALLOWED 02400000 * WITH MOVE MODE 02420000 BO NOALLOW YES BRANCH 02440000 LA RDEB,CCWOFF LOAD CCW LENGTH CONSTANT S20201 02470020 MVI DCBCNTRL+3,X'01' SET EOB IND FOR LOAD 02500000 * * 02520000 * DETERMINE BLOCKING FACTOR,BLOCKSIZE DIVIDED BY LRECL * 02540000 * * 02560000 LH RJ,DCBBLKSI BLOCKSIZE IS ODD REG 02580000 SR RD,RD CLEAR REG 02600000 LH RB,DCBLRECL LOGICAL RECORD LENGTH 02620000 DR RD,RB GET BLOCK FACTOR IN RJ 02640000 TM DCBRECFM,X'90' TEST FOR FB RECORD 02660000 BO E000 BRANCH YES 02680000 LA RJ,1 GET CONSTANT 1 FOR BLOCK FACTOR 02700000 E000 EQU * 02720000 STH RJ,DCBEROPT+4 PLACE BLOCKING FACTOR IN DCB 02740000 * * 02760000 * * 02780000 * DETERMINE SEGMENT SIZE,BUFFERSIZE DIVIDED BY BLOCKING FACTOR * 02800000 * * 02820000 * * 02840000 SR RC,RC CLEAR REG 02860000 AH RC,DCBBUFL GET BUFFER LENGTH 02880000 BC 6,F0000 BRANCH THERE IS A BUFFER LENGTH 02900000 * 02920000 STH RB,DCBPRECL USE LRECL AS SEG LENGTH 02940000 B F000A 02960000 F0000 EQU * 02980000 SR RB,RB CLEAR REG 03000000 DR RB,RJ GET SEGMENTED LENGTH 03020000 STH RC,DCBPRECL PLACE SEG LENGTH IN DCB 03040000 F000A EQU * 03060000 TM DCBBFALN,X'03' IS ALIGNMENT SPECIFIED 03080000 BZ F0001 NO-BRANCH 03100000 TM DCBRECFM,X'90' TEST FOR FB RECORD 03120000 BC 14,F0001 BRANCH NOT FB NO ALIGNMENT 03140000 * 03160000 NI DCBPRECL+1,X'F8' ROUND SEG LENGTH TO DBL WORDS 03180000 CLC DCBPRECL(2),DCBLRECL COMPARE SEG LENGTH TO LRECL 03200000 BL NOALLOW SUPPLY SIMPLE BUFFERING 03220000 * * 03240000 * DETERMINE NO OF BUFFERS TIMES EIGHT AND HOLD IN REG * 03260000 * * 03280000 F0001 EQU * 03300000 SR RTIOT,RTIOT CLEAR REG 03320000 IC RTIOT,DCBBUFNO GET NO. OF BUFFERS 03340000 LR RF,RTIOT COPY BUFNO 03360000 MR RE,RDEB MULTIPLY BY EIGHT S20201 03380020 * 03400000 * AT THIS POINT RJ=BLKF,RF=8N,RC=PRECL,RTIOT=BUFNO 03420000 * 03440000 LR RB,RJ COPY BLOCK F 03460000 * 03480000 LA RUCB,E2F4 LOAD DISK DD SUBRT ADDR 03500000 TM DCBDEVT,DISK Q-DISK SUPPORTED 03520000 BO E1B2 YES-BRANCH 03540000 * 03560000 LA RUCB,E2A21 NO-LOAD TAPE DD SUBRT ADDRESS 03580000 MVI DCBCNTRL+3,X'02' TAPE EOB ID FOR LOAD MODULE 03600000 * * 03620000 LA RB,5(0,RB) ADD 5 TO BF FOR TAPE 03640000 B E1B3 BRANCH TO CALC AMT OF CORE 03660000 * 03680000 E1B2 EQU * 03700000 LA RB,10(0,RB) ADD 10 TO BF FOR DISK 03720000 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 03723020 * DISCONNECT S20201 03726020 BO E1B2A BRANCH IF YES S20201 03729020 LA RB,D2(D0,RB) INCREMENT FOR 2 CCWS S20201 03732020 E1B2A EQU * S20201 03735020 TM DCBOPTCD,X'80' Q- WRITE VALIDITY CHECK 03740000 BZ E1B3 NO BRANCH 03760000 * 03780000 LA RB,3(0,RB) ADD 3 TO BF FOR WRITE CHECK 03800000 TM JFCBMASK+D6,NONCARN ANY DEVICE W/O S20201 03804020 * DISCONNECT S20201 03808020 BO E1B3 BRANCH IF YES S20201 03812020 LA RB,D1(D0,RB) INCREMENT FOR 1 CCW S20201 03816020 E1B3 EQU * 03820000 LR RC,RF BF + CONSTANTS TIMES 8N 03840000 MR RB,RB CALCULATE AMT OF CORE NEEDED 03860000 * ANSWER IN REG C 03880000 LR RB,RC COPY AMT USE WHEN CLEARING 03900000 * 03902020 * CHECK FOR DISCONNECT AND GET 1 DW IF FEATURE IS AVAILABLE DMOR 03904020 * 03906020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 03908020 * DISCONNECT S20201 03910020 BO E1B3A BRANCH IF YES S20201 03912020 LA RC,CCWOFF(D0,RC) OTHERWISE INCREMENT S20201 03914020 LR RB,RC COPY AMOUNT FOR CLEARING S20201 03916020 E1B3A EQU * S20201 03918020 * 03920000 *********************************************************************** 03940000 * 03960000 * AMT TO GET IN RC 03980000 *********************************************************************** 04000000 * 04020000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04040000 GETMAIN R,LV=(RC),SP=250 04060000 * * 04080000 *********************************************************************** 04100000 * THIS SECTION CLEARS CORE GOT,SETS IOBL SO CLOSE CAN REL CORE 04120000 *********************************************************************** 04140000 ST RF,DCBIOBA ADDRESS OF FIRST IOB 04160000 * * 04180000 LR RC,RF COPY ADDRESS FOR CLEARING 04200000 LR RJ,RB COPY AMOUNT 04220000 * 04221020 * SET UP THETA ADDRESS IN CASE DISCONNECT FEATURE AVAILABLE DMOR 04222020 * 04223020 AR RJ,RF GET LAST AREA ADDR S20201 04224020 SR RJ,RDEB SUB ONE DW S20201 04225020 ST RJ,DXCCW11 TEMP STORE SET THETA S20201 04226020 * ADDR S20201 04227020 LA RJ,D1(D0,RJ) INCREMENT BY ONE BYTE S20201 04228020 ST RJ,DXCCW12 TEMP STORE READ THETA S20201 04229020 * ADDR S20201 04230020 LR RJ,RB RESTORE AMOUNT S20201 04231020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 04232020 * DISCONNECT S20201 04233020 BO NOTDISCT BRANCH YES S20201 04234020 SR RJ,RDEB DECREMENT ONE DW S20201 04235020 NOTDISCT EQU * S20201 04236020 SR RD,RD CLEAR REG 04240000 DR RD,RTIOT DIVIDE BY NO.OF BUFFERS 04260000 SRL RJ,3 CONVERT TO DBL WORDS 04280000 STC RJ,DCBIOBL STORE AMT FOR CLOSE 04300000 * * 04320000 * RB HAS AMOUNT TO CLEAR * 04340000 * * 04360000 BCTR RB,0 REDUCE AMOUNT BY ONE 04380000 LA RJ,255 LOAD 255 04400000 COMPARE EQU * 04420000 CR RB,RJ Q-AMT TO CLEAR GREATER THAN 255 04440000 BC 12,ONECLEAR NO-BRANCH 04460000 EX RJ,CLEAR CLEAR 256 BYTES 04480000 SR RB,RJ AMT TO CLEAR MINUS 255 04500000 BCTR RB,0 SUBTRACT ONE MORE 04520000 LA RC,256(0,RC) UPDATE AREA ADDRESS 04540000 * 04560000 B COMPARE TRY AGAIN 04580000 * * 04600000 CLEAR EQU * 04620000 XC 0(1,RC),0(RC) CLEAR CORE 04640000 * 04660000 ONECLEAR EQU * 04680000 EX RB,CLEAR CLEARS LESS THAN 256 04700000 * 04720000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04740000 * 04760000 * 04780000 * 04800000 * * 04820000 * AT THIS POINT RF IS ADDRESS OF CLEARED CORE * 04840000 * * 04860000 LR RJ,RF REDUNDANT FOR 1 IOB BUT NEEDED 04880000 * 04900000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04920000 * 04940000 * 04960000 * CONSTRUCT COMMON IOB,ICB FIELDS HERE 04980000 * 05000000 * RF= RJ= FIRST IOB ADDRESS 05020000 * OFFSET0 LINK ADDRESS TO NEXT ICB,IOB 05040000 * OFFSET4 E C B 05060000 * OFFSET8 IOS FLAGS 05080000 * OFFSET12 ECB ADDRESS 05100000 * OFFSET 16 CSW 05120000 * OFFSET24 CHP START ADDRESS 05140000 * OFFSET28 DCB ADDRESS 05160000 * 05180000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05200000 E1H3 EQU * * 05220000 LR RF,RJ POSITION FOR NEXT IOB,ICB 05260000 LA RJ,4(0,RF) ECB ADDRESS 05280000 ST RJ,12(0,RF) STORE IN IOB,ICB 05300000 MVI 0(RJ),X'7F' INDICATE COMPLETE NO ERROR 05320000 ST RDCB,28(0,RF) DCB ADDRESS TO IOB 05340000 TM DCBRECFM,X'10' USING BLOCKED RECORDS 05360000 BZ E1H4 NO-BRANCH 05380000 * 05400000 OI 8(RF),X'80' TURN ON DC FLAG FOR IOS ERROR 05420000 * RECOVERY ROUTINE 05440000 E1H4 EQU * 05460000 * 05480000 L RB,DCBBUFCB BUFFER CONTROL BLOCK ADDRESS 05500000 L RC,0(0,RB) BUFFER ADDRESS 05520000 * 05540000 LTR RC,RC TEST FOR NO BUFFER 05560000 BE ABEND BRANCH IF NO BUFFER 05580000 MVC 1(3,RB),1(RC) REINITILIZE BUFFER CONTROL BL 05600000 * 05620000 * RC CONTAINS BUFFER ADDRESS 05640000 * 05660000 LA RJ,32(RDEB,RF) STARTAD FOR TAPE MB--R FOR DISK 05680000 MVI 37(RF),X'01' INC COUNT FOR LABELS 05700000 * * 05720000 E1K4 EQU * 05740000 ST RJ,24(0,RF) STORE STARTAD 05760000 BR RUCB 05780000 * * 05800000 * * 05820000 * * 05840000 * * 05860000 E2A2 EQU * 05880000 * * 05900000 LH RE,DCBEROPT+D4 GET BLOCKING FACTOR S20201 05910020 E2B4 EQU * 05920000 ST RC,0(0,RJ) STORE BFR ADD IN CCW 05940000 MVI 0(RJ),X'01' CMND BYTE FOR TAPE 05960000 * NOT USED BY DISK CHP 05980000 OI DCBQSWS,X'20' SLI FLAG FOR CCW 06000000 MVC 4(4,RJ),DCBQSWS MOVE FLAG AND LRECL TO CCW 06020000 AH RC,DCBPRECL ADD SEG LENGTH TO ADDRESS 06040000 AR RJ,RDEB ADD 8 TO POS CCW S20201 06043020 BCT RE,E2B4 MORE CCW'S TO BUILD S20201 06046020 * 06049020 * CHECK FOR DISCONNECT FEATURE AND SET UP READ THETA CMND DMOR 06052020 * 06055020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 06058020 * DISCONNECT S20201 06061020 BO E2B5 BRANCH IF YES S20201 06064020 SR RJ,RDEB DECREMENT CCW PTR S20201 06067020 OI FLAGOFF(RJ),CC SET COMMAND CHAIN FLAG S20201 06070020 AR RJ,RDEB RESTORE CCW PTR S20201 06073020 L RE,DXCCW12 RETRIEVE RD THETA ADDR S20201 06076020 ST RE,D0(D0,RJ) PUT IN RD THETA ADDR S20201 06079020 MVI CNTOFF(RJ),D1 SET BYTE COUNT TO ONE S20201 06082020 MVI D0(RJ),RDSC MOVE IN RD SECTOR S20201 06085020 * COMMAND S20201 06088020 AR RJ,RDEB INCR POINTER S20201 06091020 E2B5 EQU * S20201 06094020 * * 06100000 TM DCBDEVT,DISK Q-DISK 06120000 BZ E1H2 BRANCH ON NO 06140000 * 06160000 TM DCBOPTCD,X'80' WRITE CHECK PRESENT 06180000 BO E2D3 BRANCH ON YES 06200000 * 06220000 * * 06240000 E2E3 EQU * 06260000 E2F2 EQU * 06280000 * * 06300000 TM DCBDEVT,DISK Q-DISK 06320000 BZ E1H2 BRANCH NOT DISK 06340000 * 06360000 ST RJ,0(0,RB) WRT CKD ADDRESS TO PROPER CCW 06380000 MVI 0(RB),X'1D' PLACE CMND BYTE 06400000 AR RJ,RDEB POS PTR TO NEXT ICB,IOB S20201 06420020 * 06440000 E1H2 EQU * * 06460000 ST RJ,0(0,RF) STORE LINKAD IN IOB 06480000 OI 0(RF),X'40' TURN ON WRITE BIT FOR EOB RT 06500000 BCT RTIOT,E1H3 BRANCH IF MORE IOB,ICB TO MAKE 06520000 * * 06540000 L RC,DCBIOBA GET FIRST IOB ADDRESS 06560000 MVC 1(3,RF),DCBIOBA+1 PLACE LAST LINKAD 06580000 MVI 0(RC),X'41' FIRST IOB AND WRITE BITS ON 06600000 L RB,24(0,RF) GET STARTAD 06620000 LR RD,RB COPY ADDRESS 06640000 SR RB,RF GET WCPO 06660000 STC RB,DCBWCPO STORE WRITE CHP OFFSET 06680000 SR RJ,RD GET WCPL 06700000 SR RJ,RDEB CORRECT VALUE S20201 06720020 SRL RJ,3 DIVIDE BY EIGHT 06740000 STC RJ,DCBWCPL STORE WRITE CHP LENGTH 06760000 XC DCBPRECL(2),DCBPRECL CLEAR COUNTER 06780000 * * 06800000 * 06820000 * 06840000 * 06860000 * 06880000 XCTL EQU * 06900000 MVC 0(5,RWTGC),NXTEXEC XCTL TO LOAD EXECUTOR 06920000 * 06940000 RELOOP EQU * 06960000 L RCORE,4(0,RWTGC) LOAD RCORE BASE 06980000 LA RWTGC,8(0,RWTGC) INCREMENT CURR WTG ENTRY 07000000 LA RPARC,4(0,RPARC) INC CURRENT DCB ENTRY PTR 07020000 CLC 0(2,RWTGC),AMIDCNST Q- THIS RT NEEDED AGAIN 07040000 BCR 8,RBASE 07060000 * 07080000 CLC 0(2,RWTGC),OPIDCNST Q- END OF TABLE 07100000 BC 7,RELOOP NO-CHECK NEXT ENTRY 07120000 * 07140000 LR RPARC,RPAR 07160000 LA RWTGC,32(0,RWTG) REINIT WTG LIST PTR 07180000 ZCHEK EQU * 07200000 CLI 0(RWTGC),X'00' Q-IS THIS ENTRY COMPLETE 07220000 BC 7,TCTLRTN 07240000 * 07260000 LA RWTGC,8(0,RWTGC) GET NEXT ENTRY 07280000 LA RPARC,4(0,RPARC) 07300000 B ZCHEK 07320000 * 07340000 TCTLRTN EQU * 07360000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 07380000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 07400000 LA RJ,DXXCTL SET UP FOR XCTL S21042 07420020 * 07440000 XCTL DE=(RWTG),SF=(E,(15)) 07460000 * 07480000 * 07500000 * 07520000 * 07540000 * 07560000 * 07580000 E2F4 EQU * 07600000 MVC 0(8,RJ),DCBFDAD MOVE MBBCCHHR FROM DCB TO IOB 07620000 LA RB,3(0,RJ) ADDRESS FOR SRCH CCW 07640000 AR RJ,RDEB ADD 8 TO POSITION CCW S20201 07660020 ST RJ,24(0,RF) STORE STARTAD 07680000 * 07700000 * TO CONSTRUCT WRT(CKD) CCW 07720000 * * 07740000 * MAKE SRCH TIC CCWS HERE * 07760000 * * 07780000 * 07781020 * IF DISCONNECT FEATURE ON ALL DEVICES, SET SECT USED IN CHP DMOR 07782020 * 07783020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 07784020 * DISCONNECT S20201 07785020 BO E2J3 BRANCH IF YES S20201 07786020 L RE,DXCCW11 RETRIEVE SET THETA ADDR S20201 07787020 ST RE,D0(D0,RJ) PUT ADDR IN CCW S20201 07788020 OI FLAGOFF(RJ),CC SET CMND CHAIN BIT S20201 07789020 MVI CNTOFF(RJ),D1 SET BYTE CNT TO ONE S20201 07790020 MVI D0(RJ),SETSC SET SECTOR CMND S20201 07791020 AR RJ,RDEB INCREMENT CCW PTR S20201 07792020 E2J3 EQU * S20201 07793020 ST RB,0(0,RJ) STORE SEARCH ADDRESS 07800000 MVI 0(RJ),X'31' PLACE SEARCH CMND BYTE 07820000 MVI 4(RJ),X'40' TURN ON CC FLAG 07840000 MVI 7(RJ),X'05' SET COUNT OF 5 07860000 * * 07880000 * SEARCH CCW COMPLETED * 07900000 * * 07920000 ST RJ,8(0,RJ) STORE TIC ADDRESS 07940000 MVI 8(RJ),X'08' PLACE TIC CMND BYTE 07960000 * * 07980000 * TIC CCW COMPLETED * 08000000 * * 08020000 LA RJ,16(0,RJ) POSITION POINTER AT WR CKD CCW 08040000 E2J4 EQU * 08060000 * CONSTRUCT RIGHT HALF OF WRT CKD CCW HERE * 08080000 * CMND BYTE & ADDRESS OF CCHHRKDLDL COMES LAST * 08100000 * AT E2G2 ADDRESS * 08120000 LR RB,RJ COPY WRT(CKD) ADDRESS 08140000 MVI 7(RJ),X'08' PLACE COUNT OF EIGHT 08160000 MVI 4(RJ),X'A0' SET DC AND SIL FLAG ON 08180000 E1J4 EQU * 08200000 AR RJ,RDEB POSITION FOR WRITE CCW S20201 08220020 * * 08240000 * NO DC FLAGS NEEDED ACCESS METHOD SETS FLAGS * 08260000 E2A21 EQU * * 08280000 SR RJ,RF DERIVE OFFSW 08300000 STC RJ,DCBOFFSW STORE OFFSET IN DCB 08320000 AR RJ,RF RESTORE CCW ADDRESS 08340000 B E2A2 08360000 * * 08380000 * * 08400000 * * 08420000 E2D3 EQU * 08440000 *********************************************************************** 08460000 * MAKE CHP FOR CHECKING WRITE HERE * 08480000 *********************************************************************** 08500000 * * 08520000 SR RJ,RDEB BACKUP POINTER S20201 08540020 MVI 4(RJ),X'40' TURN ON CC FLAG IN LAST CCW 08560000 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 08561020 * DISCONNECT S20201 08562020 BO E2D3A BRANCH IF YES S20201 08563020 * 08564020 * IF DISCONNECT FEATURE ON ALL DEVICES USE SET SECT COMMAND DMOR 08565020 * 08566020 MVC D8(CCWOFF,RJ),D0(RJ) MOVE READ SECTOR ONE CCW S20201 08567020 AR RJ,RDEB RESTORE CCW PTR S20201 08568020 MVI D0(RJ),SETSC CHANGE CMND TO SET S20201 08569020 * SECTOR S20201 08570020 E2D3A EQU * S20201 08571020 AR RJ,RDEB POSITION AT SRCH CCW S20201 08581020 MVI 7(RJ),X'05' LENGTH FOR SRCH CCW 08600000 MVI 4(RJ),X'40' TURN ON CC FLAG 08620000 * * 08640000 * ADDRESS OF CCHHRKDLDL & CMND BYTE DONE LATER * 08660000 * * 08680000 ST RJ,8(0,RJ) TIC ADDRESS 08700000 MVI 8(RJ),X'08' PLACE TIC OP 08720000 MVC 22(2,RJ),DCBBUFL MOVE BUFFER SIZE TO READ CCW 08740000 MVI 20(RJ),X'10' MOVE SKIP FLAG TO CCW 08760000 MVI 16(RJ),X'86' MOVE RD(D) CMND BYTE TO CCW 08780000 * * 08800000 E2E51 EQU * 08820000 * 08840000 LA RD,24(0,RJ) ADDR OF CCHHRKDD FOR SRCH 08860000 E2E5 EQU * 08880000 ST RD,0(0,RJ) STORE IN SRCH CCW 08900000 MVI 0(RJ),X'31' PLACE SEARCH CMND BYTE 08920000 LA RJ,24(0,RJ) ADDRESS CCHHRKLDLDL 08940000 B E2E3 08960000 * 08980000 * 09000000 ABEND EQU * 09020000 DMABCOND OABD063,PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X09040020 CALL PROBLEM DETERMINATION 09060020 B TCTLRTN S21042 09080020 AMIDCNST DC C'1F' THIS ID 09100000 OPIDCNST DC C'0S' END ID 09120000 * 09140000 XCTLTABL ID=(SOP2,1D,SOP5,1G,NXTEXEC,14,PDLOAD,6M), S21042,09200020 SVC=019 S21042 09260020 IECDSECS MAIN,DCB,EXPAND=YES S21042 09320020 END 09380000 ./ ADD SSI=05010302,NAME=IGG0191G,SOURCE=0 TITLE 'IGG0191G - OPEN EXECUTOR - STAGE 2 - MAG AND PAPER TAPE' 00002021 COPY LCGASMSW 00012003 * RELEASE 19 DELETIONS * 00020000 * RELEASE 20 DELETIONS * 00022000 *2380121680 S20038 00023020 * RELEASE 21 DELETIONS * 00024000 *2590065960 M0129 00024121 *2590000020,001200,002000-002200,002400-002600,003000,004600, A37507 00024221 *2590011800,015600,019800-020000,021600-021800,022200,024200- A37507 00024421 *2590024400,025200-027000,027800-028000,028400,029600-029800, A37507 00024621 *2590030200-030600,032200,034400-035400,036800,037800-038400, A37507 00024821 *2590039200-043800,045600-047000,065600,073000-073600,074800, A37507 00025021 *2590088800-117600,118400-118600,121000-121600,132800 A37507 00025221 *2590065800-066000,066200 A37507 00025421 *2590 M0063 00025621 *2590132700-134200 M0091 00025821 *D065405-065425 SA58602 00025901 * REFER TO CODE FLAGGED XA02335 SA62466 00027903 * VS1 DELETIONS 00035903 *D065100-065200,065400,065430,065684,065688 XA02335 00037903 *STATUS CHANGE LEVEL 008 00040003 * 00060000 *FUNCTION/OPERATION: THIS ROUTINE WILL GET CORE(GETMAIN) TO SET UP THE 00080000 * NECESSARY IOB'S. IT WILL CLEAR THE CORE AND LINK THE IOB'S 00100000 * TOGETHER FOR TAPE & UNIT RECORD. (FOR UNIT RECORD, THEN XCTL 00110021 * TO IGG0196K. FOR TAPE CONTINUE PROCESSING). 00120021 * IT WILL SET UP THE NECESSARY BUFFERS IF NOT AVAILABLE. 00140000 * IT WILL CONNECT THE DCB AND IOB. 00160000 * IT WILL DETERMINE WHAT ROUTINES ARE NEEDED FOR PROPER EXECUTION 00180000 * AND SET A CODE IN THE DCBCNTRL FIELD OF THE DCB. 00210021 * IT WILL SET UP CCW'S FOR TAPE. 00220021 * 00230021 * THIS MODULE WAS SPLIT INTO IGG0196K FOR REL 21. 00240021 * 00280000 *ENTRY POINTS: ENTERED FROM IGG0196B, IGG0193I, IGG0191T, IGG0191U, 00285021 * IGG0191V (NORMAL CONDITIONS) 00290021 * ENTERED FROM IGG0191E - (ABNORMAL CONDITION - 00295021 * EXCHANGE BUFFERING NOT SUPPORTABLE) 00300021 * ENTERED FROM IGG0191F, IGG0191Q, IGG0191R - 00305021 * (ABNORMAL CONDITIONS - PCI CANNOT BE SUPPORTED) 00310021 * 00320000 *INPUT: SEE DESCRIPTION OF REGISTERS, DCB(USERS). 00340000 * 00360000 *OUTPUT: SEE DESCRIPTION OF REGISTERS, IOB(USERS), DCB(USERS). 00380000 * 00400000 *EXTERNAL ROUTINES: NONE. 00420000 * 00440000 *EXITS- NORMAL: XCTL TO IGG0196K FOR UNIT RECORD AFTER GETMAIN 00450021 * : XCTL TO IGG01910, IGG01912, IGG01914, IGG01915 TO LOAD 00460021 * ACCESS METHOD ROUTINES 00470021 *EXITS-ERROR: NONE. 00480000 * 00500000 * 00520000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00540000 * 00560000 * BYTE 0-7 NAME 00580000 * BYTE 8-10 RELATIVE DISK ADDRESS (TTR) OF FIRST RECORD 00600000 * BYTE 11 CONCATENATION NUMBER 00620000 * BYTE 12 ZERO 00640000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR: 00660000 * ALIAS INDICATOR 1 BIT 00680000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00700000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00720000 * BYTE 17 ZERO 00740000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00760000 * BYTE 20 TRANSLATION TABLE 00780000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00800000 * BYTE 22-23 ATTRIBUTES 00820000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00840000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00860000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00880000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00900000 * BYTE 32-36 IDTTR OF EXECUTOR FOR FIRST DCB 00920000 * BYTE 37-39 WORKAREA ADDRESS FOR FIRST DCB 00940000 * BYTE 40- TABLE OF IDTTR'S 00960000 * 00980000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (5 BYTES) 01000000 * WORKAREA ADDRESS FOR N TH DCB (3 BYTES) 01020000 * IDTTR OF LAST ROUTINE LOAD (5 BYTES) 01040000 * NOT USED (3 BYTES) 01060000 * 01080000 * 01100000 * 01120000 *ATTRIBUTES: REENTRANT, REUSABLE. 01140000 * 01160000 *NOTES: THIS ROUTINE GETS CORE FOR MAG & PAPER TAPE AND UNIT RECORD. 01168021 * XCTL'S TO IGG0196K TO CONSTRUCT IOB'S FOR UNIT RECORD. 01176021 * THIS MODULE SAVES THE NUMBER OF IOB'S TO BE BUILT IN THE 01184021 * HIGH ORDER BYTE OF DCBIOBA FOR MODULE IGG0196K. 01192021 * FOR THE 3886 OCR DEVICE, ADDITIONAL CORE IS GOTTEN FOR 01194003 * A 152 BYTE BUFFER ALONG WITH THE IOB. 01196003 * 01200000 * 01220000 * 01240000 *********************************************************************** 01260000 * 01280000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01300000 * 01320000 *********************************************************************** 01340000 * 01360000 RDCB EQU 2 DCB REGISTER 01380000 RBASE EQU 3 BASE REGISTER 01400000 RCORE EQU 4 WORK AREA ADDRESS 01420000 RPAR EQU 5 TOP OF PARAMETER LIST 01440000 RWTG EQU 6 TOP OF WTG TABLE 01460000 RPARC EQU 7 CURRENT PARAMETER 01480000 RWTGC EQU 8 CURRENT TRANS LOAD 01500000 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECTOR ADDR. 01520000 RUCB EQU 10 USED HERE AS A COUNTER IN IOB GENERATION 01540000 RB EQU 12 WORK REG1 ** 01580000 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 01600000 RD EQU 14 WORK REG3 ** 01620000 RJ EQU 15 WORK REG4 01640000 RE EQU 0 WORK REG5 01660000 RF EQU 1 WORK REG6 01680000 * 01700000 * 01720000 PARAR EQU RPARC 01740000 * 01760000 *********************************************************************** 01780000 * 01800000 * 01820000 * 01840000 * MASKS FOR DEVICES TO BE SUPPORTED 01860000 * 01880000 * 01900000 * 01920000 TAPEB EQU X'80' 01940000 URBITS EQU X'40' 01960000 PTBITS EQU X'50' 02020000 OCR3886 EQU X'57' DCBDEVT CODE FOR 3886 XL03127 02030003 * 02040000 * 02060000 ********************************************************************* 02080000 * 02100000 * OPEN INDICATORS 02120000 * 02140000 INP EQU X'0F' 02200000 OUTP EQU X'0F' 02240000 * 02260000 ********************************************************************* 02280000 * 02300000 * OPERATIONS 02320000 * 02340000 WRITE EQU X'01' 02360000 READ EQU X'02' 02380000 READBACK EQU X'0C' 02400000 EOR EQU X'04' END OF RECORD DM0I 02460000 * 02480000 ********************************************************************* 02500000 * 02720000 * CCW FLAGS USED 02740000 * 02760000 SLI EQU X'20' 02820000 * 02860000 ********************************************************************* 02880000 * 02900000 * TEST INDICATORS 02920000 * 02940000 FIRSTIOB EQU X'01' 03000000 TRANS EQU X'7E' TRANSCRIBE DM0I 03080000 * 03100000 ********************************************************************* 03120000 * OFFSET FOR PARAMETER TESTS 03140000 DISPSN EQU X'0' 03160000 FORTY EQU 40 03180000 FORTYATE EQU 48 03200000 * 03240000 ********************************************************************* 03260000 * 03280000 * 03300000 * 03320000 ********************************************************************* 03340000 * 03360000 * MASK'S USED TO TEST OPTION FIELDS IN DCB 03380000 * 03400000 PTFLGS EQU X'00' 03420000 * 03560000 ********************************************************************* 03580000 * 03600000 * MASKS FOR ACCESS METHODS IN SAM 03620000 * 03640000 QSAMB EQU X'01' 03660000 * 03700000 * 03720000 * MASKS FOR MACRO'S TO BE USED 03740000 * 03760000 POINTB EQU X'04' 03860000 CNTRLB EQU X'02' 03880000 * 03900000 ********************************************************************* 04400000 * 04420000 * 04440000 * MASKS FOR RECORD FORMATS 04460000 * 04480000 FORMATF EQU X'80' 04500000 FORMATV EQU X'40' 04520000 FORMATU EQU X'C0' 04540000 FORMATD EQU X'20' D FORMAT RECORDS S20038 04550020 * 04720000 ********************************************************************* 04730003 * GENERAL EQUATES 04732003 * 04734003 OCRIBSZ EQU 216 SIZE FOR 3886 OCR XL03127 04736003 * IOB&BUFR (40+24+152) XL03127 04738003 ********************************************************************* 04740000 IGG0191G CSECT 04760000 * 04762000 * 04764000 * 04766000 * 04768000 * 04770000 * 04772000 * 04774000 * 04776000 * 04778000 * 04800000 BALR RBASE,RE SET BASE DM0I 04820000 USING SOP5,RBASE 04840000 USING IHADCB,RDCB 04860000 USING FORCORE,RCORE 04880000 * 04900000 * 04920000 SOP5 EQU * 04940000 * 04960000 SR RE,RE INITIALIZE 04980000 L RDCB,0(RPARC) GET DCB ADDRESS 05000000 LA RDCB,0(RDCB) CLEAR HI BYTE 05020000 L RCORE,4(RWTGC) GET WRK AREA ADDRESS 05040000 LA RF,48 SIZE OF IOB + CCW 05060000 * 05080000 TM DCBDEVT,TAPEB DCB USING TAPE 05100000 BC 1,SOP52 YES BRANCH 05120000 * 05140000 TM DISPSN(PARAR),INP DCB FOR INPUT ONLY 05160000 BC 7,SOP51 NO BRANCH 05180000 * 05200000 TM DCBMACRF,CNTRLB IS THE CNTRL MACRO USED 05220000 BC 1,SOP54 YES BRANCH 05240000 B SOP55 SKIP TO NEXT DM0I 05260000 * 05280000 SOP51 TM DISPSN(PARAR),OUTP DCB SOLEY FOR OUTPUT 05300000 BC 1,SOP54 YES BRANCH 05320000 B SOP53 SKIP TO NEXT DM0I 05340000 * 05360000 * 05380000 *********************************************************************** 05400000 SOP52 TM DISPSN(PARAR),X'0E' DCB FOR IN/OUT 05420000 BC 4,SOP54 YES BRANCH 05440000 B SOP55 SKIP TO NEXT DM0I 05460000 * 05480000 SOP53 LA RF,8(RF) ADD 8 TO IOB SIZE 05500000 SOP54 LA RF,8(RF) ADD 8 TO IOB SIZE 05520000 * 05530003 * 05532003 * IF THE DEVICE IS THE 3886 OCR, ESTABLISH SIZE FOR THE IOB XL03127 05534003 * AND SPECIAL CONTIGUOUS BUFFER. 40(BASIC)+24(CP)+152(BUFR) XL03127 05536003 * 05538003 CLI DCBDEVT,OCR3886 IS DEVICE A 3886 XL03127 05538403 BNE SOP55 NO,BRANCH AROUND XL03127 05538803 LA RF,OCRIBSZ YES,SET REQ'D SIZE XL03127 05539203 * 05540000 SOP55 EQU * 05560000 SRL RF,3 DIVIDE BY 8 05580000 STC RF,DCBIOBL STORE LENGTH 05600000 SLL RF,3 RESET 05620000 * 05640000 SOP56 TM DCBCIND2,QSAMB DCB USING QSAM 05660000 BC 1,SOP57 YES BRANCH 05680000 * 05700000 IC RE,DCBNCP GET NO. BUFFER TO GEN 05720000 LTR RE,RE HAS NO. BEEN SPEC. 05740000 BC 7,SOP58 YES BRANCH 05760000 * 05780000 LA RE,1 SUPPLY 1 IOB 05800000 STC RE,DCBNCP SAVE 05820000 B SOP58 SKIP TO NEXT DM0I 05840000 * 05860000 SOP57 IC RE,DCBBUFNO GET NO OF IOBS TO BUILD 05880000 * 05900000 * 05920000 SOP58 LR RUCB,RE SAVE NO AS COUNTER 05940000 MR RE,RE COMPUTE SPACE REQUIRED 05960000 LR RB,RF SAVE FOR FUTURE USE 05980000 * 06000000 * 06020000 *********************************************************************** 06040000 * 06060000 GETMAIN R,LV=(RF),SP=250 06080000 * 06100000 *********************************************************************** 06120000 * 06140000 * 06160000 LR RJ,RB RESTORE LENGTH TO CLEAR 06180000 ST RF,DCBIOBA SAVE FIRST IOB ADDR 06200000 LR RC,RF SAVE IOB ADDRESS A37507 06210021 LR RD,RF SAVE IOB ADDRESS M0129 06215021 BCTR RJ,0 REDUCE AMOUNT BY ONE 06220000 LA RB,255 GET MAX AMT CAN CLEAR 06240000 COMPARE CR RJ,RB IS AMT TO CLEAR GREATER 255 06260000 BC 12,ONECLEAR NO BRANCH 06280000 * 06300000 EX RB,CLEAR CLEAR 256 BYTES 06320000 SR RJ,RB SUBT 255 FROM AMT TO BE CLEARED 06340000 BCTR RJ,0 SUBT ONE MORE BYTE 06360000 LA RF,256(RF) UPDATE AREA ADDR 06380000 B COMPARE TRY AGAIN 06400000 * 06420000 CLEAR XC 0(1,RF),0(RF) CLEAR INSTRUCTION 06440000 * 06460000 ONECLEAR EX RJ,CLEAR CLEARS LESS THAN 256 06480000 * 06500000 CLI DCBDEVT,OCR3886 DCB FOR 3886 OCR? XL03127 06543403 BE SOP500 YES,GOTO UR EXEC XL03127 06543803 TM DCBDEVT,PTBITS DCB FOR PAPER TAPE? A37507 06544021 BO SOP505 YES, CONTINUE THIS MODULE A37507 06548021 TM DCBDEVT,URBITS DCB FOR UNIT RECORD? A37507 06552021 BZ SOP505 NO, CONTINUE THIS MODULE A37507 06556021 SOP500 MVC 0(5,RWTGC),SOPUNREC YES, LOAD ID OF UNIT A37507 06560003 * RECORD A37507 06564021 * MODULE IGG0196K 06568021 STC RUCB,DCBIOBA SAVE NO. OF IOB'S FOR M0063 06569021 * MOD IGG0196K M0063 06570021 B RELOOP A37507 06572021 SOP505 EQU * A37507 06576021 LR RB,RD SAVE IOB ADDRESS M0129 06586021 B SOP512 MUST BE AT LEAST ONE A37507 06606021 * IOB, THEREFORE BYPASS A37507 06616021 * FOLLOWING TEST A37507 06626021 SOP510 LTR RUCB,RUCB HAVE ALL IOBS BEEN GEN 06640000 BC 7,SOP512 NO BRANCH 06660000 * 06680000 L RB,DCBIOBA GET FIRST IOB ADDR 06700000 ST RB,0(RD) LINK FIRST IOB TO LAST 06720000 OI 0(RB),FIRSTIOB SET INDICATOR 06740000 TM JFCBTSDM,X'20' SYSIN OR SYSOUT 06760000 BC 8,SOP5180 NO BRANCH 06780000 CLI DCBCNTRL+1,X'06' NOTE/POINT SPECIFIED 06800000 BC 8,SOP511 YES BRANCH 06820000 CLI DCBCNTRL,X'09' CONTROL SPECIFIED 06840000 BC 7,SOP5180 NO BRANCH 06860000 * 06880000 SOP511 MVI DCBCNTRL+1,10 STORE DUMMY ID 06900000 B SOP5180 CHECK FOR QSAM DM0I 06920000 * 06940000 * 06960000 SOP512 EQU * 06980000 * 07000000 ST RB,0(RD) LINK THIS IOB TO LAST 07020000 LR RD,RB UPDATE WORK REG 07040000 LA RB,4(RB) POINT TO ECB 07060000 OI 0(RB),X'7F' SET ECB COMPLETE WITHOUT ERROR 07080000 ST RB,12(RD) STORE ECB IN POINTER 07100000 LA RC,20(RB) POINT TO CHANNEL PROGRAM START 07120000 * ADDRESS 07140000 LA RB,16(RC) POINT TO CHANNEL PROGRAM (CP) 07160000 ST RB,0(RC) STORE CP ADDRESS IN IOB 07180000 ST RDCB,4(RC) STORE DCB ADDRESS 07200000 MVI 13(RC),X'01' STORE INCREMENT AMOUNT 07220000 * 07240000 * 07260000 LR RC,RB UPDATE REG 07280000 * 07380000 *********************************************************************** 07400000 * 07420000 * THIS SECTION DEALS WITH TAPE CHANNEL PROGRAMS 07440000 *********************************************************************** 07460000 * 07470021 * 07480021 MVI DCBCNTRL+3,2 EGP2 ID NUMBER 07500000 MVI DCBWCPO,FORTY STORE FIRST OFFSET 07520000 MVC DCBWCPL(3),DCBWCPO STORE REMAINING TREE 07540000 MVI DCBWCPL,X'01' CHANNEL PROG.IN DOUBLE WORDS 07560000 TM DISPSN(RPARC),OUTP DCB SOLEY FOR OUTPUT 07580000 BC 1,SOP523 YES BRANCH 07600000 * 07620000 TM DCBRECFM,FORMATU U RECORDS USED 07640000 BC RTIOT,SOP520E YES,BRANCH DM0I 07660000 TM DCBDEVT,PTBITS TEST FOR DEVICE CODE DM0I 07680000 BC RD,SOP5201 NO ,BRANCH DM0I 07700000 TM DCBCIND2,QSAMB TEST DM0I 07720000 BC RD,SOP5201 NO,BRANCH DM0I 07740000 TM DCBCODE,TRANS TEST DCB CODE DM0I 07760000 BZ SOP5201 NO DM0I 07780000 B SOP520M YES DM0I 07800000 * REMARKS DM0I 07820000 SOP520E EQU * ZERO DM0I 07840000 TM DCBDEVT,PTBITS PAPER TAPE DM0I 07860000 BC RD,SOP520M NO DM0I 07880000 OI RE(RB),EOR SET BIT IN READ CCW DM0I 07900000 SOP520M EQU * HERE AGAIN DM0I 07920000 OI RCORE(RB),SLI SET SLI BIT FOR TYPE 4 REC.DM0I 07940000 * PAPER TAPE FIXED TRANSLATE. 07980000 SOP5201 EQU * 08000000 CLI DXCCW12+1,X'F1' BACKWARDS INPUT 08020000 BC 7,SOP521 NO BRANCH 08040000 * 08060000 MVI 0(RB),READBACK STORE RD BACK CMD BYTE 08080000 * 08100000 B SOP521+4 08120000 * 08140000 SOP521 EQU * 08160000 OI 0(RB),READ SET READ OP CODE 08180000 TM DCBMACRF,POINTB NOTE-POINT NEEDED 08200000 BC 8,SOP521A NO BRANCH TO TEST CONTROL 08220000 TM DCBDEVT,PTBITS DCB FOR PAPER TAPE 08240000 BC 1,SOP522 YES, LEAVE DUMMY ID 08260000 * IN DCBCNTRL+1 08280000 MVI DCBCNTRL+1,6 TAPE NOTE/POINT ID 08300000 B SOP522 GO ON DM0I 08320000 SOP521A EQU * 08340000 TM DCBMACRF,CNTRLB CNTRL FOR TAPE NEEDED 08360000 BC 8,SOP522 NO BRANCH 08380000 MVI DCBCNTRL,9 CNTRL TAPE ID NUMBER 08400000 * 08420000 SOP522 LA RB,8(RB) UPDATE CP.ADDRESS 08440000 TM DISPSN(RPARC),X'0E' DCB FOR IN/OUT 08460000 BC 8,SOP524 NO BRANCH 08480000 * 08500000 MVI DCBCNTRL+2,2 SECOND EOB RT (IN-OUT) 08520000 MVI DCBWCPO,FORTYATE CHANGE OFFSETS ACCORDINGLY 08540000 MVI DCBOFFSW,FORTYATE 08560000 SOP523 MVI 0(RB),WRITE STORE WRT CMD BYTE 08580000 OI 4(RB),SLI SET SLI FLAG IN WRT CCW 08600000 LA RB,8(RB) UPDATE TO NEXT IOB 08620000 TM DCBMACRF+1,POINTB NOTE-POINT NEEDED 08640000 BC 8,SOP523A NO BR TO TEST FOR CNTRL 08660000 MVI DCBCNTRL+1,6 NPT2 ID NUMBER 08680000 B SOP524 GO ON DM0I 08700000 SOP523A TM DCBMACRF+1,CNTRLB CNTRL MACRO USED 08720000 BC 8,SOP524 NO BRANCH 08740000 MVI DCBCNTRL,9 CNTRL TAPE ID NUMBER 08760000 * 08780000 SOP524 EQU * 08800000 * 08820000 BCTR RUCB,0 DECREMENT COUNTER 08840000 B SOP510 LOOP BACK 08860000 * 11780000 SOP5180 EQU * 11800000 * 11820000 MVC 0(5,RWTGC),SOPEXLD SET ID IN WTG TABLE DM0I 11880000 TM DCBCIND1,X'01' TEST FOR QSAM DM0I 11900000 BO RELOOP GO ON FOR MORE ENTRY DM0I 11920000 * 11960000 * 11980000 * 12000000 *********************************************************************** 12020000 * 12040000 * 12060000 * 12080000 NEXT MVC 0(5,RWTGC),SOPSLDFT XCTL TO LOAD 1910 DM0I 12162000 TM DCBRECFM,FORMATF FIX FORMAT DM0I 12164000 BO SOP5STOP YES, BRANCH DM0I 12166000 TM DCBRECFM,FORMATV+FORMATD V OR D FORMAT RECORDS S20038 12168020 BZ SOP5STOP NO, BRANCH DM0I 12170000 SOXX MVC 0(5,RWTGC),SOPSLDVT XCTL TO LOAD 1915 DM0I 12172000 *********************************************************************** 12180000 * 12200000 * 12220000 *********************************************************************** 12240000 * 12260000 SOP5STOP EQU * 12280000 * 12300000 TM DCBDEVT,PTBITS PAPER TAPE DEVICE 12340000 BC 14,RELOOP BRANCH ON NO 12360000 MVC 0(5,RWTGC),SOPPTLD YES, USE ALTERNATE LOAD ID 12380000 MVI DCBDEVT+2,PTFLGS INITIALIZE PAPER TAPE FLAGS 12400000 * 12420000 * 12440000 *********************************************************************** 12460000 * 12480000 * 12500000 RELOOP LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURR WTG ENTRY 12520000 LA RPARC,PLOFF(0,RPARC) INCR CURRENT DCB ENTRY PRTR 12540000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 12560000 BCR RWTGC,RBASE BACK TO OPEN CONTROL ROUTINDM0I 12580000 * 12600000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 12620000 BC 7,RELOOP NO,CHECK NEXT ENTRY 12640000 * 12660000 LR RPARC,RPAR 12680000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE WTG LIST PTR 12700000 ZCHEK CLI 0(RWTGC),X'00' ENTRY COMPLETE DM0I 12720000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 12740000 * 12760000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 12780000 LA RPARC,PLOFF(0,RPARC) 12800000 B ZCHEK ZERO CHECK DM0I 12820000 * 12840000 TCTLRTN EQU * 12860000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 12880000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 12900000 * 12920000 LA 15,DXCCW12 SET UP FOR XCTL 12940000 ** 12960000 XCTL DE=(RWTG),SF=(E,(15)) 12980000 ** 13000000 * 13020000 ********************************************************************* 13040000 * 13060000 WAOFF EQU 32 13080000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 13100000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 13120000 OPIDCNST DC C'0S' ID DM0I 13140000 AMIDCNST DC C'1G' ID DM0I 13160000 ONE DC H'1' FOR ONE IOB TEST A37507 13170021 * 13180000 *********************************************************************** 13200000 * 13220000 * 13240000 * 13260000 XCTLTABL ID=(SOPUNREC,6K,SOPSLDFT,10,SOPPTLD,12, M0091 ,13300021 SOPEXLD, M0091 ,13340021 14,SOPSLDVT,15),SVC=019 M0091 13380021 DCBD DSORG=PS 13440000 DCBCNTRZ EQU DCBCNTRL+3 DM0I 13450000 * 13460000 IOBADD EQU DCBIOBA IOB ADDR. DM0I 13480000 TITLE 'FORMAT OF GOTTEN CORE' 13500000 FORCORE DSECT 13520000 IECDSECT 13540000 * A37507 13541021 * PREFIX FOR NORMAL SCHEDULING IOB A37507 13542021 * A37507 13543021 ORG DXIOB-8 LOCATION OF NORMAL SCHEDULING A37507 13544021 * PREFIX A37507 13545021 IOBQSAMD DS 0D BEGIN PREFIX A37507 13546021 IOBNIOBA DS 0A LINK FIELD A37507 13547021 IOBNFLG1 DS B I/O FLAGS A37507 13548021 IOBPRTOV EQU X'80' PRINTER OVERFLOW LAST I/O A37507 13549021 IOBWRITE EQU X'40' LAST I/O WAS A WRITE A37507 13550021 IOBREAD EQU X'20' LAST I/O WAS A READ A37507 13551021 IOBUPDAT EQU X'10' THIS BLOCK TO BE UPDATED A37507 13552021 IOBBKSPC EQU X'08' LAST I/O BSP,N/P,CNTRL A37507 13553021 IOBSPAN EQU X'04' LOGICAL REC INTERFACE A37507 13554021 IOBFIRST EQU X'01' FIRST IOB IN CHAIN A37507 13555021 IOBNIOBB DS AL3 THREE BYTE LINK ADDR A37507 13556021 IOBNECB DS 1F EVENT CONTROL BLOCK A37507 13557021 END 13560000 ./ ADD SSI=06011800,NAME=IGG0191H,SOURCE=0 MACRO 00020000 &NAME IF &A,&IS=,&ISNOT=,&GOTO= 00040000 LCLB &NOERR 00060000 &NOERR SETB 1 00080000 AIF ('&A' NE '').SKIP 00100000 MNOTE 'TEST ADDRESS NOT SPECIFIED.' 00120000 &NOERR SETB 0 00140000 .SKIP AIF ('&GOTO' NE '').SKIP2 00160000 MNOTE 'BRANCH ADDRESS MISSING.' 00180000 &NOERR SETB 0 00200000 .SKIP2 AIF ('&IS' NE '' OR '&ISNOT' NE '').SKIP3 00220000 MNOTE 'TEST CONDITION NOT SPECIFIED.' 00240000 &NOERR SETB 0 00260000 .SKIP3 AIF (&NOERR).SKIP4 00280000 MEXIT 00300000 .SKIP4 AIF ('&IS' EQ '').NOIS 00320000 *** 00340000 &NAME TM &A,&IS 00360000 BO &GOTO 00380000 *** 00400000 MEXIT 00420000 .NOIS AIF ('&ISNOT' EQ '').ERROR 00440000 *** 00460000 &NAME TM &A,&ISNOT 00480000 BZ &GOTO 00500000 *** 00520000 MEND 00540000 IGG0191H CSECT 00560000 * 00580000 TITLE 'IGG0191H, LEVEL 2 EXEC FOR D.A. WITH TRK OVFLOW.' 00600000 * SOP6 D.A. LEVEL 2 EXECUTOR FOR BSAM/QSAM OUTPUT WITH TRACK OVFLO. 00620000 * RELEASE 17 DELETIONS * 00621000 *1634060300,090800,095800,098800,108600,121200,123600,129000, DM0I 00622000 * 132000,132200,133000-133200,134000,135400,135800,136200, DM0I 00623000 * 136600,137000,139000,139400,139600,140600,140800,145000, DM0I 00624000 * 146800,147200-147600,148400-148600,149000,149800-150000, DM0I 00625000 * 150200,150800,151000,151400,156200,160600,161200,162400. DM0I 00626000 * RELEASE 18 DELETIONS * 00627000 *2437 21476 00627118 *2437 MCS 00627218 *2437120250,120300 22688 00627518 *2437127600 8M616 00627718 * RELEASE 19 DELETIONS * 00628000 *1394070830-070950 A25961 00628519 * RELEASE 20 DELETIONS * 00629000 *0973020200-020800,043000,044600,045000-059800,063000,064200, S20201 00629120 *0973067800-068000,068200,069200,070400,075800,076800,077800, S20201 00629220 *0973079600,089200,092400,093400,097200,099200,100600,102200- S20201 00629320 *0973102400,110400,111000,111400-111600,119600,125600-125800, S20201 00629420 *0973126000-126200,129400,134800-135200,138000-138400,145600- S20201 00629520 *0973145800 S20201 00629620 * RELEASE 21 DELETIONS * 00630000 *0091042300,043000,075700,110360,120000,125000,127600-127700, S21042 00630321 *0091132900,157400 S21042 00630621 * RELEASE 22 DELETIONS * 00631000 * RELEASE 23 DELETIONS * 00632000 * RELEASE 24 DELETIONS * 00633000 *STATUS CHANGE LEVEL 006 00636021 * 00640000 * 00660000 * THIS EXECUTOR RUNS IN TANDEM WITH IGG0191S, WHICH COMPLETES DCB 00680000 * FIELDS THAT ARE KNOWN PRIOR TO GETTING CORE FOR THE IOB/CP'S. 00700000 * 00720000 * THE MAJOR FUNCTIONS OF THIS EXEC ARE- 00740000 * 00760000 * 1. COMPLETE CALCULATIONS FOR THE CORE REQ'D FOR ALL IOB/CP'S. 00780000 * GET AND CLEAR THE CORE. 00800000 * 2. STRUCTURE EACH IOB/CP WITH THE ADDRESSES AND FLAGS THAT ARE 00820000 * KNOWN AT OPEN TIME. 00840000 * 3. COMPLETE THE RELATED DCB FIELDS. 00860000 * 4. REPEAT FOR EACH DCB BEING OPENED. 00880000 * 00900000 * ENTRY POINTS- FROM IGG0191S BY XCTL. 00920000 * EXITS- TO IGG01913 BY XCTL. 00940000 * 00960000 * 00980000 *INPUT-REGISTERS WITH THE ADDRESSES OF THE FOLLOWING- 01000000 * THE PARAMETER LIST (POINTERS TO TOP AND CURRENT ENTRY). 01020000 * THE WHERE-TO-GO TABLE (WTG) (POINTERS TO TOP AND CURRENT). 01040000 * EXTERNAL ROUTINES- NONE. 01060000 * ATTRIBUTES- REENTRANT AND REUSABLE. 01080000 * TABLES/WORKAREAS- 01100000 * 01120000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 01140000 * BYTE 0-7 NAME 01160000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 01180000 * BYTE 11 CONCATENATION NUMBER 01200000 * BYTE 12 ZERO 01220000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 01240000 * ALIAS INDICATOR 1 BIT 01260000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 01280000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 01300000 * BYTE 17 ZERO 01320000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 01340000 * BYTE 20 TRANSLATION TABLE 01360000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 01380000 * BYTE 22-23 ATTRIBUTES 01400000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 01420000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 01440000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 01460000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 01480000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 01500000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 01520000 * BYTE 36-39 TABLE OF IDTTR'S 01540000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01560000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01580000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01600000 * NOT USED (1 BYTE) 01620000 * 01640000 * WORKAREA- SEE 'FORCORE DSECT' (IECDSECT) IN THIS LISTING 01660000 * 01680000 *TABLES/WORKAREAS- PARAMETER LIST 01700000 * 01720000 *WORD ZERO 01740000 * BYTE 0 OPEN ATTRIBUTE (INPUT, OUTPUT, UPDATE, IN/OUT, 01760000 * OUT/IN, READ BACKWD, LEAVE , REREAD) 01780000 * BYTES 1-3 DCB ADDRESS FOR FIRST DCB BEING OPENED. 01800000 * 01820000 *THE PARAMETER LIST HAS A ONE WORD ENTRY FOR EACH DCB BEING OPENED. THE 01840000 *FORMAT IS THE SAME AS WORD ZERO. 01860000 *END PARAMETER LIST. 01880000 * 01900000 * REGISTER CONVENTIONS USED IN ALL OF OPEN- 01920000 * 01940000 RDCB EQU 2 DCB REGISTER 01960000 RBASE EQU 3 BASE REGISTER 01980000 RCORE EQU 4 I/O SUPPORT WORK AREA 02000000 RPAR EQU 5 TOP OF PARAMETER LIST 02100000 RWTG EQU 6 TOP OF WTG TABLE 02120000 RPARC EQU 7 CURRENT PARAMETER 02140000 RWTGC EQU 8 CURRENT LOAD IN TRANSIENT AREA 02160000 RTIOT EQU 9 USED AS A WORK REG 02180000 RIOB EQU RTIOT USED AS IOB BASE REG WITH THE 02200000 * IOB OVERLAY FROM FORECORE. 02220000 RUCB EQU 10 USED AS A WORK REG 02240000 RCPSIZE EQU RUCB USED TO CALCULATE AND HOLD THE 02260000 * CHANNEL PGM SIZE. 02280000 RDEB EQU 11 DEB BASE REG. 02300000 RB EQU 12 WORK REG. 02320000 RCPBASE EQU RB CHANNEL PGM BASE REG USED WITH 02340000 * 'CPSEGMAP' DUMMY SECTION. 02360000 RC EQU 13 WORK REG. 02380000 RSTEPPER EQU RC POINTS TO THE CURRENT SEARCH 02400000 * ADDRESS OR COUNT FIELD BEING 02420000 * USED FOR CP CONSTRUCTION. WHEN 02440000 * POINTING TO A COUNT FLD THE 02460000 * 'COUNTFLD' DUMMY SECTION IS 02480000 * USED BASED ON THIS REG. 02500000 * 02520000 RE EQU 0 WORK REG. VOLATILE ACCROSS SVC. 02540000 RF EQU 1 WORK REG. VOLATILE ACCROSS SVC. 02560000 RD EQU 14 WORK REG. VOLATILE ACCROSS SVC. 02580000 RJ EQU 15 WORK REG. VOLATILE ACCROSS SVC. 02600000 RA EQU RJ USED AS WORK REG S20201 02605020 RVALCHK EQU RA VALIDITY CHK CP BASEREG, S20201 02610020 * USES 'VCMAP' DSECT. 02615020 * 02620000 * 02640000 * MASK CONFIGURATIONS FOR TESTING THE HI ORDER BYTE OF EACH PARAMETER 02660000 * LIST ENTRY. SIGNIFICANCE IS THE SAME AS THE DEB OPEN ATTRIBUTE FIELD. 02680000 * 02700000 INPUT EQU X'0F' TEST MASKED BITS FOR ZEROS. 02720000 OUTPUT EQU X'0F' TEST MASKED BITS FOR ONES. 02740000 INOUT EQU X'03' 02760000 OUTIN EQU X'07' 02780000 RDBACK EQU X'01' 02800000 UPDAT EQU X'04' 02820000 LEAVE EQU X'10' 02840000 REREAD EQU X'30' 02860000 * 02880000 * COMMAND CODES FOR THE 2841 CONTROL UNIT. 02900000 * 02920000 SRCHEQ EQU X'31' SEARCH EQUAL ID. 02940000 SRCHEQMT EQU X'B1' SEARCH EQUAL ID IN MULTI-TRACK. 02960000 TIC EQU X'08' TRANSFER IN CHANNEL. 02980000 WCKD EQU X'1D' WRITE COUNT, KEY, AND DATA. 03000000 WSCKD EQU X'01' WRITE SPECIAL, COUNT,KEY,DATA. 03020000 SEEKCYL EQU X'0B' SEEK CYLINDER. 03040000 READDATA EQU X'06' READ DATA SINGLE TRACK. 03060000 RDDATAMT EQU 86 MULTI-TRACK READ DATA. 03080000 READKD EQU 14 READ KEY AND DATA. 03100000 READCT EQU X'92' READ COUNT M/T MODE. 03120000 RDSC EQU X'22' SET THETA CCW COMMAND S20201 03126020 SETSC EQU X'23' READ THETA CCW COMMAND S20201 03132020 * 03140000 * CHANNEL COMMAND WORD FLAGS. 03160000 * 03180000 SKIP EQU X'10' SKIP FLAG. 03200000 SILI EQU X'20' SUPPRESS INCORRECT LENGTH IND. 03220000 CC EQU X'40' COMMAND CHAIN. 03240000 DC EQU X'80' DATA CHAIN. 03260000 SILICC EQU X'60' SILI AND CC TOGETHER 03280000 SILICCSK EQU X'70' SILI, CC, AND SKIP. 03300000 * END CCW FLAGS. 03320000 * 03340000 * DISPLACEMENTS AS EQUATES 03341020 * 03342020 D0 EQU 0 DISPLACEMENT OF ZERO S20201 03343020 D1 EQU 1 DISPLACEMENT OF ONE S20201 03344020 D2 EQU 2 DISPLACEMENT OF TWO S20201 03345020 D4 EQU 4 DISPLACEMENT OF FOUR S20201 03346020 D6 EQU 6 DISPLACEMENT OF SIX S20201 03347020 D8 EQU 8 DISPLACEMENT OF EIGHT S20201 03348020 D12 EQU 12 DISPLACEMENT OF TWELVE S20201 03349020 D15 EQU 15 DISPLACEMENT OF FIFTEEN S20201 03350020 CNTOFF EQU 7 CCW COUNT FIELD OFFSET S20201 03351020 SXTN EQU 16 ADDITIONAL CHP LENGTH S20201 03352020 * FOR S20201 03353020 * RECORD READY FEATURE 03354020 * 03360000 * MISCELLANEOUS ITEMS. 03380000 * 03400000 COMPNOER EQU X'7F' USED TO INIT. ECB. 03420000 DCANDCC EQU X'C0' USED TO SET IOBFLAG1. 03440000 IDLENGTH EQU X'05' NMBR OF BYTES IN A 'CCHHR'. 03460000 POINT EQU X'04' DCBMACRF IF NOTE/POINT USED. 03480000 QSAM EQU X'01' QSAM BIT IN DCBIND2. 03500000 * 03520000 NPD2 EQU 5 NOTE/POINT FOR PCI,UPD,T.O. 03540000 EPDT EQU 9 EOB FOR T.O. 03560000 EGP2 EQU 8 EOB FOR D.A. INPUT. 03580000 * 03600000 * 03620000 VALCHK EQU X'80' MASK TO DETERMINE IF WRITE 03640000 * VALIDITY CHECK OPTION CALLED. 03660000 IOBSIZE EQU 48 LENGTH OF A STANDARD IOB WITH 03680000 * BSAM/QSAM/BPAM EXTENSION. 03700000 IOBDBLWD EQU 6 NMBR OF DBL WDS IN IOB. 03720000 OFFSW EQU 24 OFFSET OF CCW THAT WRITES DATA. 03740000 OFFSR EQU 32 OFFSET OF THE READ CCW THAT 03760000 * RECEIVES THE BLOCK LENGTH TO 03780000 * BE READ. 03800000 CPSEGLEN EQU 32 LENGTH OF ONE CP SEGMENT. 03820000 NOTZERO EQU 7 CONDITION MASK USED AFTER 03840000 * ARITHMETIC INSTRUCTIONS FOR THE 03860000 * NOT-ZERO TEST. 03880000 BBCCHH EQU 6 MIN. SEEK LENGTH. 03900000 * 03920000 ZERO EQU X'00' AN IMMEDIATE BYTE OF ZERO'S. 03940000 B1 EQU 1 BYTE COUNT OF ONE S20201 03941020 TWO EQU 2 CONST OF TWO S20201 03942020 B5 EQU 5 BYTE COUNT OF FIVE S20201 03943020 * 03944020 NORCDRY EQU X'20' NO RECORD READY MASK S20201 03945020 RCDRYSL EQU 48 SEG LENGTH WHEN USING S20201 03946020 * RCD S20201 03947020 * READY FEATURE 03948020 * 03949020 * 03950020 * 03951020 VRCDS EQU X'40' V TYPE RCD MSK S20201 03952020 * 03953020 * 03954020 EIGHT EQU 8 LENGTH OF A COUNT FIELD. 03960000 ANYZERO EQU 14 MASK FOR MIXED OR ZEROS. 03980000 FIRST EQU X'01' USED TO SET IOB FLAG IN FIRST 04000000 * IOB AND INIT. 'R'. 04020000 READCPL EQU 40 NMBR OF BYTES IN READ CP. 04040000 RCPDBLWD EQU 5 NMBR OF DBL WDS IN RCP. 04060000 REMNANT EQU READCPL-OFFSR OFFSR+REMNANT=READCPL. 04080000 OPCODE EQU 0 OFFSET OF CCW OPCODE(IN CCW). 04100000 ADDRESS EQU 0 OFFSET OF ADDRESS IN CCW 04120000 * (IMPLIES THAT THE ADDRESS MUST 04140000 * BE PUT IN BEFORE THE OP CODE) 04160000 FLAGS EQU 4 CCW FLAG BYTE. 04180000 LENFLD EQU 6 START OF LENGTH FLD IN CCW. 04200000 U EQU X'C0' CODE FOR DCBRECFM=U 04220000 OABD062 EQU 62 S21042 04230021 * 04240000 BALR RBASE,0 ESTABLISH ADDRESSABILITY. 04260000 USING SOP6,RBASE 04280000 USING FORCORE,RCORE OPEN COMMON WKAREA S21042 04300021 USING IHADCB,RDCB DCB ADDRESSABILITY. 04320000 * 04340000 * 04360000 SOP6 EQU * 04380000 * 04400000 L RDCB,0(RPARC) GET DCB ADDRESS FROM PARM. LIST 04420000 L RDEB,DCBDEBAD DEB ADDRESSABILITY. 04440000 L RCORE,D4(RWTGC) GET WORK AREA ADDR S20201 04450020 LA RDCB,0(RDCB) HOUSEKEEP HI BYTE. 04480000 SR RUCB,RUCB CLEAR REG S20201 04680020 IC RUCB,DCBNCP GET NO. OF IOBS REQUIRED S20201 04880020 IF DCBCIND2,ISNOT=QSAM,GOTO=SOP6L12 S20201 05080020 IC RUCB,DCBBUFNO IF QSAM USE BUFNO S20201 05280020 SOP6L12 EQU * S20201 05480020 L RIOB,DCBIOBA GET FIRST IOB ADDRESS. 06000000 L RF,D0(RIOB) RETRIEVE THETA ADDR S20201 06003020 ST RF,DXCCW11 PUT IN TEMP STORAGE S20201 06006020 LA RF,D1(RF) OBTAIN READ THETA ADDR S20201 06009020 ST RF,DXCCW12 TEMP STORE S20201 06012020 XC D0(D4,RIOB),D0(RIOB) CLEAR WORD OF IOB S20201 06015020 USING SAMSIOB,RIOB IOB ADDRESSABILITY READY. 06020000 MVI FLAG,FIRST FLAG FIRST IOB DM0I 06030000 * 06040000 BUILDIOB EQU * 06060000 * 06080000 * RIOB POINTS TO START OF AN IOB. USING THIS AS A BASE, GET THE CP 06100000 * START ADDRESS AND THE ADDRESS OF THE COUNT FIELDS AND S.A.'S. 06120000 * 06140000 * 06160000 MVI ECB,COMPNOER INIT. ECB FOR QSAM. 06180000 LA RF,ECB INITIALIZE THE 06200000 ST RF,IOBECBPT ECB POINTER. 06220000 * 06240000 OI IOBFLAG1,DCANDCC INDICATE COMMAND AND DATA CHAIN 06260000 ST RDCB,IOBDCBPT-1 INIT DCB PT IN IOB. 06280000 MVC IOBSEEK(8),DCBFDAD INIT. ALL IOB FDAD'S. SUPPORTS 06286013 * EVERYBODY INCLUDING 2321. 06292013 LA RCPBASE,CHANPGM GET CHP ADDR S20201 06296020 ST RCPBASE,IOBSTART-D1 PUT IN IOB S20201 06300020 * 06304020 * TEST FOR INPUT ONLY 06308020 * 06312020 USING DEB,RDEB DEB ADDRESSABILITY S20201 06316020 IF DEBOPATB,ISNOT=OUTPUT,GOTO=RCPREQD 06320000 DROP RDEB S20201 06330020 BUILDWCP EQU * 06340000 SR RCPBASE,RCPBASE NEEDED ON 2ND PASS. 06360000 IC RCPBASE,DCBWCPO NEED OFFSET TO BUILD 06380000 AR RCPBASE,RIOB WRITE CP BASE ADDRESS. 06400000 USING WCPMAP,RCPBASE 06440000 SR RSTEPPER,RSTEPPER NEEDED ON 2ND PASS. 06460000 IC RSTEPPER,DCBWCPL BUILD ADDRESS OF COUNT FIELDS 06480000 SLL RSTEPPER,3 APPENDED TO WCP. 06500000 AR RSTEPPER,RCPBASE ADDRESS OF FIRST COUNT FIELD. 06520000 USING COUNTFLD,RSTEPPER 06540000 * 06560000 * RIOB = IOB ADDRESS. 06580000 * RCPBASE = CHANNEL PROGRAM ADDRESS. 06600000 * RSTEPPER = COUNT FIELD AND S.A. ADDRESS. 06620000 * 06640000 * IOB INITIALIZED EXCEPT FOR LINK FIELD. 06660000 * 06680000 * BUILD WRITE CHANNEL PROGRAMS. THE CORRECT NUMBER OF CP SEGMENTS IS 06700000 * THAT WHICH CAN BE BUILT UP TO THE FIRST COUNT FIELD APPENDED TO THIS 06720000 * IOB. 06740000 * 06760000 * 06770020 * CHECK FOR RCD READY FEATURE AND SET UP SET THETA COMMAND IF 06780020 * THE FEATURE IS ON ALL THE DATA SETS DEVICES 06790020 * 06800020 * 06805020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06810020 * READY S20201 06815020 BO NOFET3 BRANCH IF YES S20201 06820020 BAL RD,SOP6STA GO BUILD SET SECTOR CCW S20201 06825020 AH RCPBASE,DBLWDLEN INCR BASE FOR SET SECTOR S20201 06830020 NOFET3 EQU * S20201 06835020 CCW1 EQU * 06840000 LA RD,IOBSEEK+3 GET ADDRESS OF CCHHR IN IOB. 06860000 ST RD,SRCHADDR PUT IN FIRST SEARCH COMMAND. 06880000 MVI SRCHOPCD,SRCHEQ SET OP CODE = SEARCH. 06900000 * 06940000 * BUILD FIRST TIC CCW. 06960000 * 06980000 CCW2 EQU * 07000000 ST RCPBASE,TICADDR STORE ADDRESS OF PREVIOUS SRCH. 07020000 MVC SRCHFLAG(B5),FLAGLEN FLAGS, LEN, TIC OP CODE S20201 07040020 * 07060000 * 07080000 LR RVALCHK,RSTEPPER COPY PTR TO BEGINNING OF COUNTS 07100000 * AND S.A.'S. WILL BE USED FOR 07120000 * VAL CHK CP ADDRESSABILITY (IF 07140000 * NEEDED) AND TO FLAG THE LAST 07160000 * CCW OF THE WRITE SEGMENTS. 07180000 * 07200000 IF DCBOPTCD,ISNOT=VALCHK,GOTO=FLAGLAST 07220000 * 07240000 * VALIDITY CHECK IS CALLED. BUILD THE VAL CHK CP SEGMENT WHILE ADDR- 07260000 * ESSABILITY IS AVAILABLE. CCW'S TO BE BUILT ARE A SEEK (CCW7), SEARCH 07280000 * (CCW8), TIC (CCW9) AND READ DATA (CCW10). 07300000 * 07320000 SH RVALCHK,VALCKLEN BACK UP TO BEGINNING OF VAL CHK 07340000 * CP. 07360000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 07362020 * READY S20201 07364020 BO FEAT7 BRANCH IF YES S20201 07366020 SH RVALCHK,DBLWDLEN DECREMENT ADDITIONAL CCW S20201 07368020 * SINCE FEATURES WRITE CHK 07370020 * CHP LARGER 07372020 FEAT7 EQU * S20201 07374020 USING VCMAP,RVALCHK VAL CHK SEGMENT ADDRESSABILITY. 07380000 * 07400000 CCW7 EQU * BUILD SEEK COMMAND. SEEK 07420000 * ADDRESS SAME AS CCHH IN FIRST 07440000 * COUNT FIELD. 07460000 LA RD,IOBSEEK+1 POINTS TO IOB SEEK ADDR. 07480000 ST RD,SEEKADDR 07500000 MVI SEEKOPCD,SEEKCYL 07520000 MVI SEEKFLAG,CC COMMAND CHAIN. 07540000 MVI SEEKLEN,BBCCHH LENGTH OF A 'BBCCHH'. 07560000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 07562020 * READY S20201 07564020 BO NOFET9 BRANCH IF YES S20201 07566020 DROP RIOB S20201 07568020 USING FORCORE,RCORE OPEN COMMON WKAREA S21042 07570021 L RD,DXCCW12 GET SECTOR ADDR S20201 07572020 USING SAMSIOB,RIOB S20201 07574020 ST RD,D8(RVALCHK) PUT IN CCW S20201 07576020 OI D12(RVALCHK),CC TURN ON COMMAND CHAIN S20201 07578020 MVI D15(RVALCHK),B1 SET BYTE COUNT TO ONE S20201 07580020 MVI D8(RVALCHK),SETSC PUT IN CCW CMND S20201 07582020 AH RVALCHK,DBLWDLEN INCREMENT RVALCHK BASE S20201 07584020 * REG S20201 07586020 * TO ELIMINATE SET SECTOR 07588020 * OFFSETS IN DSECT 07590020 NOFET9 EQU * S20201 07592020 CCW8 EQU * BUILD SEARCH ID EQUAL WITH SAME 07600000 * CCHH AS THE SEEK. 07620000 ST RSTEPPER,VCSRCHAD ADDRESS OF FIRST COUNT FIELD. 07640000 MVI VCSRCHOP,SRCHEQ OP CODE. 07660000 * 07700000 CCW9 EQU * BUILD A TIC BACK TO CCW8. 07720000 LA RD,VCSRCH ADDRESS OF SEARCH. 07740000 ST RD,VCTICAD PUT IN TIC ADDRESS. 07760000 MVC VCSRCHFL(B5),FLAGLEN FLAGS, LEN, TIC OP CODE S20201 07780020 * TIC COMPLETE. NO FLAGS REQ'D. 07800000 * 07820000 CCW10 EQU * BUILD READ DATA WITH SKIP. 07840000 MVI VCRDOP,READKD TO READ DATA + KEYS (IF ANY). 07860000 MVI VCRDFLAG,SKIP SKIP FLAG. 07880000 * SKIP ON MAKES ADDRESS IMMATERIAL, LENGTH WILL BE SET AT EOB TIME. 07900000 * 07920000 * VALIDITY CHECK CP IS BUILT. 07940000 * 07943020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 07946020 * READY S20201 07949020 BO FEATL17 BRANCH IF YES S20201 07952020 SH RVALCHK,DBLWDLEN IF YES RVALCHK WAS INCR S20201 07955020 * TO WRT CHK PGM PLUS 8 TO 07958020 * ELIMINATE SET SECTOR OFF- 07961020 * SETS AND NOW MUST BE RE- 07964020 * STORED 07967020 FEATL17 EQU * S20201 07970020 ST RVALCHK,PARASITE PUT VAL CHK CP ADDRESS IN 07980000 * R.H. OF CCW2. 08000000 MVI PARASITE,TIC PUT IN TIC OP CODE, OK BECAUSE 08020000 * BITS 37-39=0. 08040000 * 08060000 * PARASITE TIC IN CCW2 WILL BE USED TO TRANSFER-IN-CHANNEL AROUND ANY 08080000 * UNUSED CP SEGMENTS WHEN WRITE CHECK IS CALLED. 08100000 * 08120000 DROP RVALCHK RELINQUISH VC CP ADDRESS. 08140000 * 08160000 FLAGLAST EQU * 08180000 * 08200000 SH RVALCHK,DBLWDLEN THE CCW BEFOR THE VAL CHK CP 08220000 * (OR THE S.A.'S AND COUNT FLDS) 08240000 * IS THE END OF THE WRITE SEGMENT 08260000 * CP'S. POINT TO IT. 08280000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 08282020 * READY S20201 08284020 BO NOFETFLG BRANCH IF YES S20201 08286020 ST RVALCHK,PARASITE PUT RD SECT ADDR IN S20201 08288020 * PARASIT S20201 08290020 MVI PARASITE,TIC PUT IN TIC CMND S20201 08292020 SH RVALCHK,DBLWDLEN BACK UP TO NULL OP CD S20201 08294020 NOFETFLG EQU * S20201 08296020 MVI 0(RVALCHK),WSCKD FLAG LAST CCW4 OP CODE BYTE 08300000 * WITH A NON-ZERO VALUE. 08320000 * 08340000 LA RF,NULLOPCD ADDRESS OF CCW WHICH RECEIVES 08360000 BAL RE,GETBUFAD BUFFER ADDRESS. 08380000 * 08400000 MVC KEYLENTH(1),DCBKEYLE KEY WILL BE WRITTEN ON FIRST 08420000 * RECORD SEGMENT ONLY. 08440000 * 08460000 CCW3 EQU * ALL FIRST TIME LOGIC IS DONE. 08480000 * BEGIN HERE WITH A LOOP TO BUILD 08500000 * THE REST OF CP SEG 1 (CCW'S 3 08520000 * AND 4) AND ALL REMAINING SEG- 08540000 * MENTS (MADE UP OF CCW'S 5,6,3,4 08560000 * IN THAT ORDER.) 08580000 * 08600000 ST RSTEPPER,COUNTADR FILL IN COUNT FIELD ADDRESS. 08620000 MVI COUNTLEN,EIGHT LENGTH OF A COUNT FIELD. 08640000 MVI WRTFLAG,DC DATA CHAIN TO NEXT CCW. 08660000 * 08680000 CCW4 EQU * THIS IS THE CCW THAT WRITES THE 08700000 * DATA. NOTHING IS KNOWN AT OPEN 08720000 * TIME EXCEPT THAT IT IS COMMAND 08740000 * CHAINED, AND THE FIRST CCW4 08760000 * WILL HAVE THE BUFFER ADDRESS IF 08780000 * QSAM IS USED 08800000 * IF IT IS THE LAST CCW4, THE OP 08820000 * CODE BYTE HAS BEEN SET TO NON- 08840000 * ZERO. 08860000 * 08880000 MVI RECORD,FIRST INIT. 'R' TO 1. 08900000 CLI NULLOPCD,ZERO IS THIS THE LAST CP SEGMENT? 08940000 BNE THRULOOP YES. BRANCH TO DO FINAL LOGIC. 08960000 * 08980000 * PREPARE TO BUILD NEXT CP SEGMENT. ADVANCE THE CP ADDR REG TO NEXT CP, 09000000 * AND MOVE THE COUNT FIELD AND S.A. POINTER TO NEXT S.A. 09020000 * 09040000 LA RCPBASE,CPSEGLEN(RCPBASE) POINT TO NEXT SEGMENT. 09060000 LA R13,EIGHT(R13) POINT TO NEXT S.A. DM0I 09070000 R13 EQU 13 13 DM0I 09080000 * THE COUNT FIELD OVERLAY IS NOT 09100000 * VALID UNTIL RSTEPPER IS BUMPED 09120000 * 8 MORE. 09140000 * 09160000 CCW5 EQU * SEARCH 09180000 * 09200000 ST RSTEPPER,SRCHADDR PUT IN POINTER TO SEARCH ADDR. 09220000 * 09260000 CCW6 EQU * TIC 09280000 * 09300000 ST RCPBASE,TICADDR STORE ADDRESS OF CCW5. 09320000 MVC SRCHFLAG(B5),FLAGLEN FLAGS, LEN, AND TIC OP S20201 09330020 * CODE S20201 09340020 * 09360000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 09365020 * READY S20201 09370020 BNO FEATAX BRANCH IF NO S20201 09375020 IF DCBOPTCD,ISNOT=VALCHK,GOTO=PTRUPBY8 09380000 * 09400000 * VAL CHK CALLED. NEED A PARASITE SEARCH ADDRESS IN CCW6 (TIC) TO BE 09420000 * USED FOR RECONSTRUCTION OF CCW5 AT EOB TIME. 09440000 FEATAX EQU * S20201 09450020 * 09460000 ST RSTEPPER,PARASITE PUT IN SEARCH ADDRESS. 09480000 * SEARCH OP CODE IS IMPLIED, AND 09500000 * FILLED IN AT EOB. 09520000 * 09540000 PTRUPBY8 EQU * 09560000 LA R13,EIGHT(R13) POINT TO NEXT COUNT FIELD DM0I 09580000 * OVERLAY NOW APPLIES. 09600000 * 09620000 B CCW3 CLOSE THE LOOP FOR BUILDING 09640000 * CCW'S. 09660000 * 09680000 THRULOOP EQU * CCW'S ARE BUILT. FINAL LOGIC TO 09700000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 09705020 * READY S20201 09710020 BO NOFET19 BRANCH IF YES S20201 09715020 BAL RD,SOP6RTA GO BUILD READ SECTOR CCW S20201 09720020 NOFET19 EQU * S20201 09725020 USING DEB,RDEB S20201 09730020 * 09740000 * 09760000 * 09780000 IF DEBOPATB,IS=OUTPUT,GOTO=NEXTIOB 09800000 * MUST DROP RDEB BECAUSE THE FORECORE DSECT LAYOUT PRODUCES A 09820000 * SMALLER OFFSET WITH RDEB FOR 'CHANPGM'. RIOB IS THE DESIRED REG. 09840000 DROP RDEB 09860000 B BUILDRCP TO BUILD RECORD READ CHAN.DM0I 09880000 RCPREQD EQU * 09900000 USING RCPOVLAY,RCPBASE 09940000 LA RSTEPPER,RDCCW STEPPER+8=NEXT IOB. 09960000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 09963020 * READY S20201 09966020 BO NOFET25 BRANCH IF YES S20201 09969020 LA RSTEPPER,SXTN(RSTEPPER) INCR FOR RCD READY S20201 09972020 NOFET25 EQU * S20201 09975020 BUILDRCP EQU * 09980000 LA RCPBASE,CHANPGM READ CP CONTIG. TO IOB. 10000000 USING RCPOVLAY,RCPBASE 10020000 USING DEB,RDEB 10040000 TM JFCBMASK+D6,NORCDRY ANY DEVICESW/O RCD READY S20201 10046020 BO NOTRR2A BRANCH IF YES S20201 10052020 BAL RD,SOP6STA GO BUILD SET SECTOR CCW S20201 10058020 AH RCPBASE,DBLWDLEN INCR BASE FOR SET SECTOR S20201 10064020 NOTRR2A EQU * S20201 10070020 CCWA EQU * 10080000 LA RD,IOBSEEK+3 SEARCH ON IOB FDAD. 10100000 ST RD,SRCHCCW+ADDRESS FILL IN SEARCH ADDRESS. 10120000 MVI SRCHCCW+OPCODE,SRCHEQ SEARCH OP CODE . 10140000 MVC SRCHCCW+FLAGS(4),FLAGLEN SET COMMAND CHAIN ON, LENGTH= 10160000 * 5=L'CCHHR. 10180000 CCWB EQU * 10200000 LA RD,SRCHCCW GET SEARCH CCW ADDR S20201 10210020 ST RD,TICCCW+ADDRESS PUT IN TIC CCW S20201 10220020 MVC SRCHCCW+FLAGS(B5),FLAGLEN FLAGS,LEN TIC OP CODE S20201 10230020 CCWC EQU * 10260000 MVI SKIPCCW+OPCODE,READDATA CCW TO SKIP OVER PREVIOUS. 10280000 MVI SKIPCCW+FLAGS,SKIP+SILI+CC 10300000 MVI SKIPCCW+LENFLD+1,NOTZERO 10320000 CCWD EQU * 10340000 IF DCBCIND2,IS=QSAM,GOTO=TESTBUF 10360000 MVI RKDCCW+OPCODE,READKD CCWE, USING THE QSAM DECISION. 10380000 CLI DCBNCP,ZERO+1 10400000 B DECIDE IF MORE THAN ONE IOB. 10420000 TESTBUF MVI RDCCW+OPCODE,READDATA CCWE, USING THE QSAM DECISION. 10440000 CLI DCBBUFNO,ZERO+1 10460000 DECIDE BH IOBAREQD READ INTO NEXT IOB IF THERE 10480000 * IS ONE. 10500000 LA RD,DCBFDAD+3 ONLY ONE IOB. READ COUNT INTO 10520000 * DCBFDAD. 10540000 B STOREIT 10560000 IOBAREQD EQU * 10580000 DROP RIOB 10600000 USING SAMSIOB-8,RSTEPPER STEPPER+8=NEXT IOB. 10620000 LA RD,IOBSEEK+3 NEXT IOB SEEK. 10640000 DROP RSTEPPER 10660000 USING SAMSIOB,RIOB RESUME ON CURRENT IOB. 10680000 STOREIT ST RD,RDCTCCW+ADDRESS 10700000 MVI RDCTCCW+OPCODE,READCT 10720000 MVI RDCTCCW+FLAGS,CC+SILI COMMAND CHAIN AND SILI FLAGS ON 10740000 MVI RDCTCCW+LENFLD+1,IDLENGTH 10760000 CCWE EQU * 10780000 * OP CODE ALREADY SET AS REQ'D BY BSAM OR QSAM. MAY BE CHANGED AS 10800000 * REQ'D BY KEY LENGTH, ACCORDING TO WHETHER IT IS OR IS NOT ZERO. 10820000 CLI DCBKEYLE,ZERO 10840000 BNE OPCODEOK OP CODE OK DM0I 10860000 MVI RDCCW+OPCODE,READDATA 10880000 OPCODEOK EQU * 10900000 TM DCBRECFM,U 10920000 BC ANYZERO,NOSILI BRANCH IF NOT 'U' RECORDS. 10940000 OI RDCCW+FLAGS,SILI NEED SILI BIT FOR 'U' RCDS. 10960000 NOSILI EQU * 10980000 LA RF,RDCCW POINT TO CCW WHICH RECEIVES 11000000 BAL RE,GETBUFAD BUFFER ADDRESS. 11020000 * 11021020 * IF RCD READY FEATURE USED BUILD A READ SECTOR COMMAND 11022020 * 11023020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 11024020 * READY S20201 11025020 BO NOFET29 BRANCH IF YES S20201 11026020 TM DCBRECFM,VRCDS V TYPE RCDS S20201 11027020 BZ NOSILIX BRANCH IF NO S20201 11028020 OI RDCCW+FLAGS,SILI TURN ON SILI BIT S20201 11029020 NOSILIX EQU * S20201 11030020 * 11031020 * MUST DROP RIOB AND RDEB TO USE RCORE 11032020 DROP RIOB S20201 11033020 DROP RDEB S20201 11034020 * 11035020 USING FORCORE,RCORE OPEN COMMON WKAREA S21042 11036021 L RD,DXCCW12 GET THETA ADDR S20201 11037020 ST RD,RRSADDR PUT IN CCW S20201 11038020 OI RDCCW+FLAGS,CC CMND CHAIN PREVIOUS CCW S20201 11039020 MVI RRSCNT,B1 SET BYTE COUNT TO ONE S20201 11040020 MVI RRSCMND,RDSC PUT IN CCW CMND S20201 11041020 DROP RCORE S20201 11042020 NOFET29 EQU * S20201 11043020 USING SAMSIOB,RIOB S20201 11044020 NEXTIOB EQU * TEST FOR ANOTHER IOB TO BE 11060000 * BUILT. 11080000 BCTR RUCB,RE DECR IOB COUNT S20201 11090020 LTR RUCB,RUCB HAVE ALL IOBS BEEN BUILT S20201 11100020 * FLAGGED. 11120000 BNP ALLBUILT YES BRANCH TO CLOSE IOB S20201 11150020 * CHAIN AND THEN DO WTG LOGIC. 11180000 * MORE IOB'S TO BE BUILT. 11200000 LA RD,EIGHT(RSTEPPER) NEXT IOB STARTS AFTER LAST 11220000 * COUNT FLD OF THE PREVIOUS. 11240000 O RD,LINK FORWARD CHAIN TO NEXT IOB. 11260000 * OR'ING PRESERVES THE FLAG. 11280000 ST RD,LINK STORE THE PREPARED LINK FIELD. 11300000 * 11320000 LR RIOB,RD NOW HAVE ADDRESSABILITY FOR THE 11340000 * NEXT IOB. 11360000 * 11380000 B BUILDIOB GO BACK AND BUILD IT. 11400000 * 11420000 ALLBUILT EQU * 11440000 MVC LINK+1(3),DCBIOBA+1 LINK LAST IOB TO THE FIRST. 11460000 USING DEB,RDEB S20201 11470020 * 11480000 * TEST FOR OUTPUT ONLY. 11500000 IF DEBOPATB,IS=OUTPUT,GOTO=ALLTHRU 11520000 DROP RDEB S20201 11530020 * LINK LAST IOB'S READ COUNT CCW TO FIRST IOB. NOT DONE IF ONLY 1 IOB. 11540000 L RA,DCBIOBA GET FIRST IOB'S ADDRESS. 11560000 CR RA,RIOB ONLY 1 IOB IF CURRENT = FIRST. 11580000 BE ALLTHRU BRANCH IF 1 IOB. 11600000 LA RA,IOBSEEK-SAMSIOB+3(RA) FIRST IOB'S SEEK ADDRESS. 11620000 ST RA,RDCTCCW+ADDRESS 11640000 MVI RDCTCCW+OPCODE,READCT OP CODE GOES IN AFTER ADDRESS. 11660000 ALLTHRU EQU * EVERY THING DONE. 11680000 * 11700000 * 11860000 DROP RIOB 11880000 ******************* WTG LOGIC GOES HERE. ********************** 11900000 * 11920000 STOPSOP6 EQU * 11940000 L RCORE,4(RWTGC) GET WORK AREA ADDRESSABILITY. 11980000 USING FORCORE,RCORE OPEN COMMON WKAREA S21042 12000021 MVC 0(5,RWTGC),LOADEXEC GET LOAD EXEC ID. 12020000 TM DCBRECFM,X'80' VARIABLE RECORD FORMAT 22688 12025018 BO RELOOP NO,BRANCH 22688 12030018 MVC 0(5,RWTGC),OPENVREC YES LOAD IGG01916 DM0I 12035000 * 12040000 RELOOP LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURRENT WTG ENTRY. 12060000 LA RPARC,PLOFF(0,RPARC) INCREMENT CURRENT DCB ENTRY PTR 12080000 CLC 0(2,RWTGC),AMIDCNST IS THIS RTN NEEDED AGAIN? 12100000 BCR EGP2,RBASE RETURN TO OPEN DM0I 12120000 * 12140000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE? 12160000 BC 7,RELOOP NO, CHECK NEXT ENTRY. 12180000 * 12200000 LR RPARC,RPAR 12220000 LA RWTGC,WAOFF(0,RWTG) REINIT. WTG LIST PTR. 12240000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE? 12260000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL. 12280000 * 12300000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY. 12320000 LA RPARC,PLOFF(0,RPARC) 12340000 B ZCHEK ZERO CHECK DM0I 12360000 * 12380000 TCTLRTN EQU * 12400000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE. 12420000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE. 12440000 * 12460000 * 12480000 LA RJ,DXXCTL SET UP FOR XCTL S21042 12500021 * 12520000 XCTL DE=(RWTG),SF=(E,(15)) 12540000 * 12544020 * END WTG LOGIC 12548020 * 12552020 * SET SECTOR BUILD RTN 12556020 * 12560020 SOP6STA EQU * S20201 12564020 * 12568020 L RE,DXCCW11 GET THETA ADDR S20201 12572020 ST RE,D0(RCPBASE) PUT IN CCW S20201 12576020 OI FLAGS(RCPBASE),CC TURN ON CMND CHAIN S20201 12580020 MVI CNTOFF(RCPBASE),B1 SET BYTE COUNT TO ONE S20201 12584020 MVI D0(RCPBASE),SETSC PUT IN SET SECT CMND S20201 12588020 BR RD RETURN S20201 12592020 * 12594020 * READ SECTOR BUILD ROUTINE 12596020 * 12598020 USING WCPMAP,RCPBASE S20201 12600020 SOP6RTA EQU * S20201 12602020 L RE,DXCCW12 GET THETA ADDR S20201 12604020 ST RE,WRSADDR PUT IN CCW S20201 12606020 * 12608020 OI NULLFLAG,CC TURN ON PREVIOUS CCW S20201 12610020 * CMND S20201 12612020 * CHAIN 12614020 MVI WRSCNT,B1 SET BYTE COUNT TO ONE S20201 12616020 MVI WRSCMND,RDSC PUT IN CCW CMND S20201 12618020 BR RD RETURN S20201 12620020 DROP RCPBASE S20201 12622020 * 12624020 GETBUFAD EQU * S20201 12626020 IF DCBCIND2,ISNOT=QSAM,GOTO=RETURN 12640000 L RD,DCBBUFCB GET BUFF CB ADDR. 12660000 L RJ,0(RD) GET ADDR OF CURRENT BUFF. 12680000 LA RJ,0(RJ) CLEAR HI BYTE. 12700000 LTR RJ,RJ TEST FOR BUFFER AVAIL. 12720000 BC NOTZERO,AVAIL BRANCH IF BUFF AD NOT 0. 12740000 DMABCOND OABD062,PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X12760021 013 ABEND 12780021 B TCTLRTN GO XCTL S21042 12800021 AVAIL MVC 1(3,RF),1(RD) MOVE CURRENT AVAIL TO CCW RCVR. 12820000 MVC 1(3,RD),1(RJ) MOVE NEXT AVAIL TO BUFF CB. 12840000 MVC 6(2,RF),DCBBLKSI INIT CCW LENGTH 12860000 RETURN LR RF,RE 12880000 BR RF EXIT DM0I 12900000 * 12920000 TWOCON DC H'2' CONSTANT OF TWO S20201 12940020 DBLWDLEN DC H'8' LENGTH OF A DOUBLE WORD. 12960000 VALCKLEN DC H'32' VALIDITY CHK CP LENGTH. 12980000 FLAGLEN DC X'40' COMMAND CHAIN FLAG. 13000000 DC X'00' SPACER 13020000 DC H'5' LENGTH OF A 'CCHHR'. 13040000 DC X'08' TIC OP CODE S20201 13050020 * 13060000 * 13080000 * WTG CONSTANTS AND EQUATES. 13100000 * 13120000 WAOFF EQU 32 13140000 PLOFF EQU 4 13160000 WGOFF EQU 8 13180000 OPIDCNST DC C'0S' ID DM0I 13200000 AMIDCNST DC C'1H' ID DM0I 13220000 * 13240000 * END WTG CONSTANTS. 13260000 * 13280000 XCTLTABL ID=(LOADEXEC,13,OPENVREC,16,PDLOAD,6M),SVC=019 S21042 13350021 * 13420000 * READ CHANNEL PROGRAM OVERLAY. CCW FIELDS ARE ACCESSED BY ABSOLUTE 13440000 * OFFSETS FROM THE CCW NAME. 13460000 * 13480020 RCPOVLAY DSECT 13500020 SRCHCCW DS D SEARCH CCW DM0I 13540000 * TIC (CCWB) 13560000 TICCCW DS D TIC DM0I 13580000 * READ DATA WITH SKIP (CCWC) 13600000 SKIPCCW DS D SKIP CCW DM0I 13620000 * READ COUNT (CCWD) 13640000 RDCTCCW DS D READCCW DM0I 13660000 * READ DATA (CCWE) 13680000 RDCCW DS D READ CCW DM0I 13700000 * READ KEY AND DATA (ALTERNATE CCWE) 13720000 RKDCCW EQU RDCCW 13740000 * 13741020 * READ SECTOR COMMAND, USED ONLY WITH RECORD READY FEATURE 13742020 * 13743020 RRSCMND DS F READ SECTOR COMMAND S20201 13744020 RRSADDR EQU RRSCMND SECTOR ADDR S20201 13745020 RRSFLAG DS XL1 FLAG FIELD S20201 13746020 DS CL2 FILLER S20201 13747020 RRSCNT DS XL1 BYTE COUNT ONLY ONE BYTE S20201 13748020 RCCHHR DS D ADDR OF READ CNT WHEN S20201 13749020 * USING S20201 13750020 * RECORD READY FEATURE 13751020 * 13752020 * END READ CP CCW DEFINITION 13760000 * FOLLOWING IS A MAP OF A WRITE CHANNEL PROGRAM (WCP) SEGMENT. 13780000 * 13800020 WCPMAP DSECT 13820020 * 13840020 * SEARCH (CCW1 OR 5) 13860000 * 13880000 SRCHADDR DS F SEARCH DM0I 13900000 SRCHOPCD EQU SRCHADDR OP CODE IS HI ORDER BYTE. 13920000 SRCHFLAG DS XL1 SEARCH FLAG DM0I 13940000 DS CL2 FLAG DM0I 13960000 SRCHLEN DS XL1 LENGTHS NORMALLY FIT IN 1 BYTE. 13980000 * 14000000 * TIC (CCW2 OR 6) 14020000 * 14040000 TICADDR DS F TIC DM0I 14060000 TICOPCD EQU TICADDR TIC OP DM0I 14080000 UNUSED DS F ONLY REQUIRES BITS 37-39 = 0. 14100000 PARASITE EQU UNUSED MAY BE USED TO STORE AN ADDRESS 14120000 * BUT THE ABOVE RESTRICTION 14140000 * LIMITS THE OP CODES THAT MAY 14160000 * BE STORED IN THE HI BYTE. 14180000 * 14200000 * WRITE (CCW3) 14220000 * 14240000 COUNTADR DS F COUNT FIELD ADDRESS. 14260000 WRTOPCD EQU COUNTADR 14280000 WRTFLAG DS XL1 FLAG FIELD. 14300000 DS CL2 SPACER. 14320000 COUNTLEN DS XL1 COUNT FIELD LENGTH (NORMALLY 8) 14340000 * 14360000 * NULL OP CODE (CCW4) OP PROPAGATED FROM WRITE CCW. 14380000 * 14400000 DATAADDR DS F ADDRESS OF BLOCK OF DATA TO BE 14420000 * WRITTEN. 14440000 NULLOPCD EQU DATAADDR USED AS A FLAG TO SIGNAL LAST 14460000 * SEGMENT. 14480000 NULLFLAG DS XL1 NULL FLAG DM0I 14500000 DS XL1 SPACER. 14520000 DATALEN DS H 2 BYTES HOLDS DATA LENGTH. 14540000 * 14544020 * READ SECTOR COMMAND USED ONLY WITH RECORD READY FEATURE 14548020 * 14552020 WRSCMND DS F READ SECTOR COMMAND S20201 14556020 WRSADDR EQU WRSCMND SECTOR ADDR S20201 14560020 WRSFLAG DS XL1 FLAG FIELD S20201 14564020 DS CL2 FILLER S20201 14568020 WRSCNT DS XL1 BYTE COUNT FIELD S20201 14572020 * 14576020 * 14580020 * 14584020 * 14588020 * FOLLOWING IS THE VALIDITY CHECK CHANNEL PROGRAM OVERLAY. 14600000 * 14620000 VCMAP DSECT 14640000 * SEEK (CCW7) 14660000 SEEKADDR DS F SEEK ADDRESS DM0I 14680000 SEEKOPCD EQU SEEKADDR 14700000 SEEKFLAG DS XL1 FLAG DM0I 14720000 DS CL2 COUNT DM0I 14740000 SEEKLEN DS XL1 SEEK LENGTH DM0I 14760000 * 14780000 * SEARCH (CCW8) LABELS PREFIXED BY 'VC' (VAL 14800000 VCSRCH EQU * CHECK). 14820000 VCSRCHAD DS F SEARCH ADDRESS DM0I 14840000 VCSRCHOP EQU VCSRCHAD SEARCH OP DM0I 14860000 VCSRCHFL DS XL1 FLAGS. 14880000 DS CL2 COUNT DM0I 14900000 VCSRCHLE DS XL1 LENGTH. 14920000 * 14940000 * TIC (CCW9) 14960000 VCTICAD DS F TIC DM0I 14980000 VCTICOP EQU VCTICAD TIC ADDRESS DM0I 15000000 NOTUSED DS F NOT USED DM0I 15020000 * 15040000 * READ DATA (CCW10) 15060000 VCRDAD DS F RECORD ADDRESS DM0I 15080000 VCRDOP EQU VCRDAD RECORD ADDR. DM0I 15100000 VCRDFLAG DS XL1 NORMALLY SKIP. 15120000 VCRDLEN DS FL3 RECORD LENGTH DM0I 15140000 * 15160000 * FOLLOWING IS AN OVERLAY OF THE COUNT FIELD. 15180000 * 15200000 COUNTFLD DSECT 15220000 * 15240000 CYLINDER DS H CYLINDER ADDRESS (CC). 15260000 HEAD DS H HEAD ADDRESS (HH). 15280000 RECORD DS XL1 RECORD NUMBER (R). 15300000 KEYLENTH DS XL1 KEY LENGTH (KL). 15320000 DLDL DS H DATA LENGTH (DLDL). 15340000 * 15360000 * END COUNT FIELD. (CCHHRKDD) 15380000 * 15400000 * 15420000 * DIRECT ACCESS DEVICE TABLE OVERLAY 15440000 * 15460000 DEVTAB DSECT 15480000 DEVSIZE DS F MAX SIZ FOR DEVICE. 15500000 TRKCAP DS H TRACK CAPACITY. 15520000 OVERI DS XL1 OVERHEAD FOR NOT-LAST RECORD. 15540000 OVERL DS XL1 OVERHEAD FOR LAST RECORD. 15560000 OVERK DS XL1 OVERHEAD REDUCTION FOR NON-KEY 15580000 * RECORDS. 15600000 DEVFLAG DS XL1 DEVICE FLAG DM0I 15620000 TOLER DS H TOLERANCE/512 USED FOR VARIABLE 15640000 * GAP LENGTH CALCULATIONS. 15660000 * END DEVTAB OVERLAY. 15680000 * 15700000 * 15720000 IECDSECS MAIN,DCB,EXPAND=YES S21042 15800021 * 15880000 * IOB OVERLAY 15900000 * THE FORECORE DSECT IOB OVERLAY IS USED WITH THE FOLOWING ADDITIONS- 15920000 * 15940000 * BSAM/BPAM/QSAM IOB EXTENSION- 15960000 SAMSIOB EQU DXIOB-8 START OF SAM'S IOB. 15980000 LINK EQU SAMSIOB FORWARD CHAIN FIELD (TO NEXT 16000000 * IOB). 16020000 FLAG EQU LINK HI BYTE OF LINK USED AS FLAG. 16040000 ECB EQU DXIOB-4 ECB DM0I 16060000 * END EXTENSION DEFINITIONS 16080000 * 16100000 IOBSEEK EQU DXDAADDR SEEK ADDRESS DM0I 16120000 CHANPGM EQU DXDAADDR+8 START OF CHANNEL PROGRAM. 16140000 * LENGTH MAY VARY. 16160000 * END IOB DEFINITIONS. 16180000 * 16200000 DEB EQU DXDEB 16220000 DEBOPATB EQU DXDEBSYS DEB ADDRESS DM0I 16240000 END 16260000 ./ ADD SSI=05013032,NAME=IGG0191I,SOURCE=0 TITLE ' IGG0191I BUFFER CONSTRUCTION ' 00020000 COPY LCGASMSW Y01021 00022100 IGG0191I CSECT 00024000 * RELEASE 19 DELETIONS * 00048000 *1400078400,081200 S19033 00048619 *1400078400,081200 S19017 00049219 *1400043400,044200 S19015 00050019 *1400 S19015 00051019 *1400 M4879 00051519 *1400078400,080860-080920,081200 M4899 00051719 * RELEASE 20 DELETIONS * 00052000 *0281001400-001600,003000-003100,051400-067200,071200-072800, S20201 00052320 *0281078600-080720,098600 S20201 00052620 *0281036400,038800,039500-040140 A30808 00053020 *0281014600,037000,082800-086800 S20016 00054020 *0281036845-036854 M0017 00055020 *0281063600 A30962 00055520 *0281034800-035400,036809-037151,081260,081290,081320,081350 M3415 00055720 * M5005 00055820 * M4843 00055920 * RELEASE 21 DELETIONS * 00056000 *0892 A48163 00056421 *A SA52300 00060821 * SA56446 00061221 *0892003400,074600-075000,075850,075880,078300-081200,082000- S21042 00064901 *0892082200 S21042 00068801 *D000280-000460,000600,050600-051000,067400-067600 XM6327 00070801 *D036804-036860,037355 YM3034 00072800 * 00076601 *STATUS CHANGE LEVEL 008 00080501 * 00084401 *FUNCTION/OPERATION- THIS ROUTINE SUPPLEMENTS THE INITIAL OPEN ROUTINE. 00088301 * IT PERFORMS GENERAL AND SPECIFIC FUNCTIONS FOR THE SEQUENTIAL 00092201 * ACCESS METHOD 00096101 * IT DETERMINES THE NUMBER OF BUFFERS NEEDED AND ISSUES A'GETMAIN' 00100000 * FOR THE CORRECT AREA AND STORES THE ADDRESS IN THE DCB. 00120000 * 00180000 * IF A RECORD AREA IS NEEDED FOR LOGICAL RECORD PROCESSING 00190021 * OF VARIABLE LENGTH SPANNED RECORDS, IT DETERMINES THE SIZE 00192021 * AND ISSUES A GETMAIN FOR THE RECORD AREA. IT PUTS THE ADDRESS 00194021 * OF THE RECORD AREA IN THE BUFFER CONTROL BLOCK AND SETS FLAGS 00196021 * TO INDICATE THE PRESENCE OF A RECORD AREA. 00198021 *ENTRY POINT- IGG0191I ENTERED FROM IGG0191A BY XCTL 00200000 * 00220000 *INPUT: SEE DESCRIPTION OF REGISTERS. 00240000 *OUTPUT: SEE DESCRIPTION OF REGISTERS. 00260000 *EXTERNAL ROUTINES: NONE. 00280000 *EXIT NORMAL XCTL TO IGG0193I 00300020 * 00320000 *EXITS-ERROR CALL PROB DET (IGG0196M) FOR WTP AND 013 ABEND 00340020 * 00360000 *TABLES/WORKAREAS: WHERE TO GO TABLE(WTG) 00380000 * BYTE 0-7 NAME 00400000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00420000 * BYTE 11 CONCATENATION NUMBER 00440000 * BYTE 12 ZERO 00460000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00480000 * ALIAS INDICATOR 1 BIT 00500000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00520000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00540000 * BYTE 17 ZERO 00560000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00580000 * BYTE 20 TRANSLATION TABLE 00600000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00620000 * BYTE 22-23 ATTRIBUTES 00640000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00660000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00680000 * BYTE 29 LENGTH OF WTG TABLE(IN DOUBLE WORDS) 00700000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00720000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00740000 * BYTE 35 ADDRESS OF STORAGE FOR DCB 00760000 * BYTE 36-39 TABLE OF IDTTR'S 00780000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 00800000 * ADDRESS OF STORAGE FOR DCB (1 BYTE ) 00820000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 00840000 * NOT USED (1 BYTE ) 00860000 * 00880000 * WORKAREA- SEE 'FORCORE DSECT' (IECDSECT) IN THIS LISTING 00900000 * 00920000 *ATTRIBUTES: REENTRANT, REUSABLE. 00940000 *NOTES: PCI IS PARTIALLY INCLUDED BUT CAN NOT BE SPECIFIED. 00960000 * 00980000 * 01000000 * 01020000 * 01040000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01060000 * 01080000 *********************************************************************** 01100000 * 01120000 * 01140000 RE EQU 0 WORK/PARAMETER REGISTER 01160000 RF EQU 1 WORK/PARAMETER REGISTER 01180000 RDCB EQU 2 ADDR OF USERS DCB 01200000 RBASE EQU 3 BASE REGISTER 01220000 RCORE EQU 4 ADDR OF OPEN WORK AREA 01240000 RPAR EQU 5 PARAMETER LIST 01260000 RWTG EQU 6 START OF WTG 01280000 RPARC EQU 7 CURRENT ENTRY IN PARAMETER LIST 01300000 RWTGC EQU 8 CURRENT ENTRY IN WTG TABLE 01320000 RTIOT EQU 9 TIOT ADDR/WORK REGISTER 01340000 RUCB EQU 10 UCB ADDR/WORK REGISTER 01360000 RDEB EQU 11 DEB ADDRESS 01380000 RA EQU 11 01400000 RB EQU 12 WORK REGISTER 01420000 RC EQU 13 WORK REGISTER 01440000 RD EQU 14 TCB ADDR/WORK/PARAMETER S20016 01450020 * REG S20016 01460020 RJ EQU 15 WORK/PARAMETER REGISTER 01480000 * MASK'S TO TEST PARAMETER LIST WITH 01500000 * 01520000 OUTP EQU X'0F' 01540000 * 01560000 ********************************************************************* 01580000 * 01600000 * 01620000 * OFFSET FOR PARAMETER TESTS 01640000 * 01660000 DISPSN EQU X'0' 01680000 * 01700000 * 01720000 ********************************************************************* 01740000 * 01760000 * MASK'S USED TO TEST OPTION FIELDS IN DCB 01780000 * 01800000 * 01820000 * 01840000 DOUBLE EQU X'01' ALIGNMENT BIT 01860021 * 01880000 C2 EQU 2 GENERAL CONSTANT 2 S20201 01886020 C6 EQU 6 GENERAL CONSTANT 6 S20201 01892020 C3 EQU 3 GENERAL CONSTANT 3 S21042 01894020 ZERO EQU 0 GENERAL CONSTANT 0 S21042 01896020 * 01900000 STOWB EQU X'80' 01920000 OVRFLO EQU X'20' 01940000 PCI EQU X'20' 01960000 CONCAT EQU X'FF' 01980000 * 02000000 QSAMODE EQU X'01' DENOTES QSAM IN DCBCIND2 M0017 02010020 BLKFLG EQU X'04' USED TO TELL CLOSE BLKD SA52300 02012021 * BIT TURNED OFF SA52300 02014021 ********************************************************************* 02020000 * 02040000 * MASKS FOR ACCESS METHODS IN SAM 02060000 * 02080000 PAM EQU X'02' 02100000 PSAM EQU X'42' 02120000 QSAMB EQU X'01' 02140000 * 02160000 * 02180000 * MASKS FOR MACRO'S TO BE USED 02200000 * 02220000 GETB EQU X'40' 02240000 PUTB EQU X'40' 02260000 READB EQU X'20' 02280000 WRITEB EQU X'20' 02300000 POINTB EQU X'04' 02320000 CNTRLB EQU X'02' 02340000 * 02360000 * 02380000 ********************************************************************* 02400000 * 02420000 * MASKS FOR DEVICES TO BE SUPPORTED 02440000 * 02460000 DABIT EQU X'20' 02480000 URBIT EQU X'40' 02500000 TAPEB EQU X'80' 02520000 TERM EQU X'4F' DCBDEVT FOR TS TASK S20016 02521020 D1285 EQU X'5A' TEST DCBDEVT FOR 1285 S19017 02523019 * DCBDEVT FOR 1287 IS X'5B' S19017 02526019 D1288 EQU X'5C' TEST DCBDEVT FOR 1288 S19017 02529019 D1419 EQU X'5D' DCBDEVT CODE FOR 1419 S19033 02532019 D1275 EQU X'5F' DCBDEVT CODE FOR 1275 S19033 02535019 * 02540000 * 02560000 * MASKS FOR BUFFER TECHNIQUE'S 02580000 * 02600000 EXCHANGB EQU X'10' 02620000 * 02640000 * SA52300 02650021 * SA52300 02652021 * RECORD FORMATS - USED AGAINST DCBRECFM FIELD SA52300 02654021 * SA52300 02656021 NOTF EQU X'40' USED TO CHECK IF FIXED SA52300 02658021 BLOCKED EQU X'10' USED TO SEE IF BLOCKED SA52300 02658421 * SA52300 02658821 ********************************************************************* 02660000 * 02680000 * 02700000 * MODES OF OPERATION FOR QSAM 02720000 * 02740000 LOCATEB EQU X'08' 02760000 MOVEB EQU X'10' 02780000 * 02800000 * MASKS USED FOR NEW BUFFER CONTROL BLOCK WHICH HAS A RECORD AREA 02800919 * ADDRESS 02801819 * THE RECORD AREA IS PROVIDED IN SUPPORT OF QSAM LOCATE MODE OF 02802719 * OPERATION WITH LOGICAL RECORD INTERFACE FOR VARIABLE LENGTH 02803619 * SPANNED RECORDS 02804519 * 02805419 LRECIND EQU X'60' LOGICAL REC INTERFACE SA56446 02806321 FORMATVS EQU X'48' VARIABLE LENGTH SPANNED S19015 02807219 * RECORD 02808119 CTLINFO EQU 32 LENGTH OF CONTROL INFO S19015 02809019 * IN RECORD AREA 02809919 ADDRLEN EQU 4 LENGTH OF RECORD AREA S19015 02810819 * ADDR S19015 02811719 ADLEN EQU 3 LENGTH OF ADDR S19015 02812619 FLGOFFST EQU 4 OFFSET TO FLAG BYTE IN S19015 02813519 * BCB S19015 02814419 RAFLAG EQU X'80' RECORD AREA PRESENT S19015 02815319 EXTND EQU X'40' BIT ON INCICATES BUFFER A48163 02815721 * CONTROL BLOCK HAS LENGTH 02816121 * OF 16 BYTES 02818021 ONE EQU 1 CONSTANT ONE S19015 02820521 WDLEN EQU 4 FULLWORD LENGTH S19015 02822421 DWDLEN EQU 8 LENGTH OF DOUBLEWORD A48163 02822800 RAADOFST EQU 8 RECORD AREA ADDR OFFSET S19015 02824321 NOT EQU X'FF' MASK TO TURN OFF BITS S19015 02826221 * 02828121 OABD061 EQU 61 S21042 02830020 IDTTR EQU 5 ID, TTR OF MOD FOR WTGT XM6327 02830101 ********************************************************************* 02840000 * 02860000 * 02880000 * 02900000 * 02920000 * 02960000 BALR RBASE,0 02980000 USING START,RBASE 03000000 USING IHADCB,RDCB 03020000 USING FORCORE,RCORE 03040000 USING DEB,RDEB 03060000 USING TCB,RD 03080000 USING CVT,RTIOT 03100000 USING UCBOB,RUCB 03120000 USING WTG,RWTG S21042 03130020 * 03140000 * 03160000 * 03180000 * 03200000 START EQU * 03220000 * 03240000 L RDCB,0(RPARC) GET DCBADDRESS 03260000 L RCORE,4(RWTGC) GET WORK AREA 03280000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 03290001 L RDEB,DCBDEBAD GET DEB ADDRESS 03300000 .DEBCK10 ANOP Y01021 03310000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 03312000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 03314000 .DEBCK20 ANOP Y01021 03320000 * 03340000 * THIS SECTION DETERMINES IF A BUFFER POOL 03360000 * MUST BE ACQUIRED BY OPEN < < < < < < < < < < < < < 03380000 * 03400000 TM DCBBUFCB+ADLEN,ONE BUFCB SPECIFIED S19015 03402019 BNO GETRALEN BRANCH TO GET RECORD A48163 03412000 * AREA ONLY 03412421 A0015 EQU * S19015 03416019 * 03418019 SR RB,RB CLEAR REG 03420000 * 03440000 IC RB,DCBBUFNO GET BUFFER NUMBER 03460000 * 03560000 A0010 EQU * 03580000 LH RC,DCBBUFL GET BUFFER LENGTH EXPECTED 03590021 LTR RC,RC SPECIFIED 03620000 BNZ A0012 YES--USE IT A30808 03640020 * 03660000 AH RC,DCBBLKSI USE BLOCK SIZE IF THERE 03680000 BZ TSOCHK BRANCH IF NO BLOCKSIZE XM5359 03687121 TM DCBCIND2,QSAMB IS IT QSAM XM5359 03688221 BO A0011 YES,BRANCH SA52300 03689321 * 03690421 SR RD,RD 03691521 IC RD,DCBKEYLE GET KEY LENGTH XM5359 03692621 AR RC,RD BUFL EQ KEYLENGTH,BLKSI XM5359 03693721 B A0012 CONTINUE XM5359 03694821 * 03695921 TSOCHK EQU * 03697021 CLI DCBDEVT,TERM CHECK FOR TSO 03698121 BNE DCBERROR BRANCH IF NOT 03699221 * TSO MODIFICATION - WHEN BLKSI IS NOT SPECIFIED, FOR QSAM, LRECL 03700321 * IS ASSUMED IF THERE, OTHERWISE, USER'S TERMINAL LINE SIZE IS 03701421 * ASSUMED, FOR BSAM USER'S TERMINAL LINE SIZE IS ASSUMED. 03702521 * 03703621 * 03704721 TM DCBCIND2,QSAMODE TEST IF BSAM OR QSAM 03705821 BNO USELNSZ BRANCH IF BSAM 03706921 AH RC,DCBLRECL USE LRECL IF THERE 03708021 BNZ A0012 BRANCH IF LRECL THERE 03709121 USELNSZ EQU * 03710221 L RTIOT,CVTPTR LOAD CVT ADDR 03711321 L RD,CVTTCBP LOAD TCB WORD 03712421 L RD,4(,RD) LOAD TCB ADDR 03713521 USING TCB,RD 03714621 L RF,TCBJSCB LOAD JSCB ADDR 03715721 USING IEZJSCB,RF 03716821 LH RF,JSCBTJID GET TJID 03717921 BCTR RF,0 DECREMENT TJID BY 1 03719021 L RTIOT,CVTTSCVT LOAD TSCVT ADDR 03720121 DROP RTIOT 03721221 USING TSCVT,RTIOT 03722321 L RTIOT,TSCVTRPT LOAD TIOTRPT ADDR 03723421 DROP RTIOT 03724521 USING TIOCRPT,RTIOT 03725621 SR RE,RE CLEAR REGISTER 03726721 IC RE,TIOCTSBS GET TSB SIZE 03727821 MR RE,RE GET OFFSET TO TSB TABLE 03728921 L RE,TIOCTSB-1 GET TSB TABLE ADDR 03730021 AR RF,RE GET TSB ADDR 03731121 USING TSB,RF 03732221 SR RC,RC CLEAR REGISTER 03733321 IC RC,TSBLNSZ GET TSB LINE SIZE 03734421 STH RC,DCBLRECL SET LRECL TO LINE SIZE YM3034 03734800 * THIS CODE WAS MOVED FROM IGG0196K. IT CHANGES BLOCKSIZE SA52300 03736421 * TO LRECL IF IT IS OUTPUT TO A UR DEVICE. SA52300 03738421 A0011 EQU * SA52300 03743821 TM DCBRECFM,BLOCKED IS IT BLOCKED FORMAT? SA52300 03745821 BZ A0012 NO CONTINUE SA52300 03747821 TM DCBDEVT,URBIT IS IT UNIT RECORD? SA52300 03748221 BZ A0012 NO CONTINUE SA52300 03748621 TM 0(RPARC),OUTP IS IT OUTPUT? SA52300 03749021 BZ A0012 NO CONTINUE SA52300 03749121 TM DCBRECFM,NOTF IS IT FIXED FORMAT? SA52300 03757221 BO A0011A NO LEAVE BLOCKSIZE SA52300 03759221 LH RC,DCBLRECL USE LRECL TO BUILD BFR SA52300 03761221 STH RC,DCBBLKSI CHANGE BLOCKSIZE SA52300 03761621 A0011A NI DCBRECFM,NOT-BLOCKED TURN OFF BLOCKED BIT SA52300 03768021 OI DCBCIND1,BLKFLG TELL CLOSE SA52300 03770021 * 03774421 * 03780821 * RB HAS NO. OF BUFFERS DESIRED 03787221 * RC HAS BUFFER SIZE TO BE SUPPLIED 03793621 * 03800000 * * 03820000 * AN INDICATOR IS BEING SET SO CLOSE KNOWS WHETHER OR NOT TO 03840000 * FREE THE QSAM BUFFER POOL FOR THE CASE OF CONCATENATION WITH 03860000 * UNLIKE ATTRIBUTES. POOL IS NOW FREED AND REOBTAINED EVEN IF 03870020 * USER SPECIFIES BUFFER LENGTH, SINCE USER HAS NO CHOICE ON DD * 03880020 * 03900000 * 03920000 A0012 EQU * M4899 03930019 OI DCBCIND2,X'08' SET BUFFER POOL INDICATOR 03940000 LA RC,7(0,RC) ADJUST TO DBL WORD BY ADDING 7 04020000 SRL RC,3 ROUND TO 04040000 SLL RC,3 DOUBLE WORD 04060000 * 04080000 * 04100000 * 04120000 LR RD,RB SAVE LNGTH AND NUMBER 04140000 LR RJ,RC OF BUFFERS 04160000 MR RD,RD COMPUTE LENGTH 04180000 LA RJ,8(0,RJ) ADD 8 FOR CNTRL BLK 04200000 TM DCBBFTEK,DOUBLE DOUBLE WD. ALIGN. 04220000 BC 14,A0030 YES, BRANCH A48163 04240021 * 04260000 LA RJ,8(RJ) ADD 8 FOR FW ALIGNMENT 04280021 * 04300000 A0030 EQU * 04320000 TM DCBBFTEK,LRECIND LOGICAL REC INTERFACE SA56446 04325021 BNO GETCORE NO,GOTO GETMAIN SA56446 04335021 * 04335119 * LOGICAL RECORD INTERFACE TEST PRIOR TO GETMAIN. DETERMINE IF 04335219 * BUFFER CONTROL BLOCK HAS TO BE EXTENDED FOR A RECORD AREA. 04335321 * IF SO, ADD 8 BYTES TO THE BUFFER CONTROL BLOCK LENGTH. 04335721 * 04335819 TM DCBCIND2,QSAMB QSAM DATA SET SA56446 04335921 BNO DEFAULT NO,BR TO TURN OFF BITS SA56446 04336021 TM DCBRECFM,FORMATVS IS FORMAT VARIABLE S19015 04336219 * SPANNED S19015 04336319 BNO DEFAULT BRANCH NO TO TURN OFF S19015 04336419 * LOGICAL RECORD 04336519 * INTERFACE INDICATOR 04336619 TM DCBMACRF,LOCATEB LOCATE MODE S19015 04336719 BO TSTFW BRANCH YES TO ADD RA LEN A48163 04336821 TM DCBMACRF+ONE,LOCATEB LOCATE MODE S19015 04336919 BNO DEFAULT BRANCH NO TO TURN OFF S19015 04337019 * LOGICAL RECORD 04337119 * INTERFACE INDICATOR 04337219 TSTFW EQU * A48163 04338400 * LOGICAL RECORD INTERFACE IS SUPPORTED. DETERMINE IF BUFFER A48163 04338821 * CONTROL BLOCK MUST BE EXTENDED TO CONTAIN THE RECORD AREA A48163 04339221 * ADDRESS. 04339621 TM DCBBFTEK,DOUBLE FULL WORD ALIGNMENT 04340021 BO GETCORE BRANCH YES -- BUFFER A48163 04340121 * CONTROL BLOCK HAS SPACE A48163 04340221 * FOR RECORD AREA ADDRESS A48163 04340321 LA RJ,8(RJ) ADD 8 BYTES 04340821 B GETCORE GO GET BUFFER POOL SPACE A48163 04342800 * 04344800 * LOGICAL RECORD INTERFACE PROCESSING IS NOT SUPPORTED. 04346800 * 04346921 DEFAULT NI DCBBFTEK,NOT-LRECIND TURN OFF LOGICAL RECORD A48163 04347221 * INDICATOR 04347600 GETCORE EQU * S19015 04359621 * 04360821 *HIARCHY TEST PRIOR TO GETMAIN. DETERMINE WHETHER CORE WILL BE DM0E 04362021 *GOTTEN FROM HI SPEED STORAGE OR LCS. DM0E 04363221 SR RF,RF HOUSEKEEP PARM REG 1. DM0E 04364421 TM DCBBFTEK,HIARCHY TEST FOR HI SPEED STORAGE OR DM0E 04365621 * LCS. DM0E 04366821 BO GETH1 BRANCH IF LCS DM0E 04368021 GETMAIN R,LV=(15),SP=250,HIARCHY=0 DM0E 04369221 B GETSTADR DM0E 04370421 * 04371621 GETH1 EQU * DM0E 04377621 GETMAIN R,LV=(15),SP=250,HIARCHY=1 DM0E 04378821 * 04380000 * 04400000 GETSTADR EQU * S19015 04401019 * 04402019 TM DCBBUFCB+ADLEN,ONE BUFCB SPECIFIED S19015 04403019 BO GETSTBUF NO, GO FORMAT POOL A48163 04404000 * 04405019 L RJ,DCBBUFCB YES, GET BUFCB ADDR S19015 04406000 OI FLGOFFST(RJ),RAFLAG SET FLAG TO INDICATE S19015 04407019 * RECORD AREA PRESENT 04408000 ST RF,RAADOFST(RJ) STORE RECORD AREA ADDR S19015 04409019 * 04410019 LH RJ,DCBLRECL LOAD LRECL IN WORK REG S19015 04411019 LA RJ,CTLINFO(RJ) ADD 32 BYTES CONTROL S19015 04412019 * INFO S19015 04413019 ST RJ,DISPSN(RF) STORE LRECL IN RECORD S19015 04414019 * AREA S19015 04415019 XC WDLEN(CTLINFO,RF),WDLEN(RF) CLEAR CONTROL FIELD S19015 04416019 * IN RA S19015 04417019 B A0090 EXIT S19015 04418019 * 04419019 GETSTBUF EQU * S19015 04420019 * 04421019 ST RF,DISPSN(RF) STORE START ADDRESS S19015 04422019 * DM0E S19015 04423019 MVC DCBBUFCB+1(3),1(RF) STORE 3 BYTE ADDR. IN DCB 04440000 * 04460000 STH RB,4(0,RF) STORE NO.OF BUF. IN BCB 04480000 STH RC,6(0,RF) STORE LNGTH OF BUF. IN BCB 04500000 * 04520000 LR RUCB,RF GET ADDRESS IN WRK REG 04540000 LA RUCB,DWDLEN(0,RUCB) GET ADDR +8 TO POINT TO 04540400 * FIRST AVAILABLE BUFFER 04540800 * DETERMINE IF BUFFER CONTROL BLOCK IS EXTENDED. IF SO, SET FLAGS 04542200 * AND UPDATE POINTER TO FIRST BUFFER. 04542400 TM DCBBFTEK,DOUBLE FULL WORD ALIGNMENT A48163 04543000 BZ TSTLRI NO, TEST LRI A48163 04543200 LA RUCB,WDLEN(0,RUCB) YES, OFFSET ADDR TO FW A48163 04543400 B EXTEND GO SET EXTEND FLAG A48163 04543600 TSTLRI TM DCBBFTEK,LRECIND LRI SUPPORTED A48163 04543900 BNO ALIGNED NO, BRANCH TO SAVE FIRST A48163 04544100 * BUFFER ADDRESS 04548500 LA RUCB,DWDLEN(0,RUCB) YES, OFFSET TO NEXT DW A48163 04551900 * 04554500 EXTEND OI FLGOFFST(RF),EXTND SET FLAG TO INDICATE A48163 04555721 * BUFFER CONTROL BLOCK EXTENDED 04555800 * 04580000 * THE NEXT SEQUENCE OF INSTRUCTIONS BUILDS A BUFFER POOL 04600000 * 04655019 ALIGNED EQU * S19015 04774019 * 04776019 ST RUCB,0(0,RF) STORE BUFFER ADDRESS 04780000 LR RF,RUCB SAVE NEXT BUFF. ADDR 04800021 * 04820000 A0050 EQU * 04840000 BCT RB,A0060 IF MORE, BRANCH A48163 04842021 B SETLAST EXIT A48163 04844021 A0060 EQU * 04846021 ALR RUCB,RC UPDATE TO NEXT BUFFER 04850000 ST RUCB,0(RF) STORE POINTER 04852000 ALR RF,RC BUFFER LEN + BUFFER ADDR A48163 04854000 B A0050 IF MORE BRANCH 04860021 * 04889619 SETLAST EQU * S19015 04898619 ST RB,0(0,RF) LAST LINK TO ZERO 04900000 TM DCBBFTEK,LRECIND RECORD AREA NEEDED 04910000 BNO A0090 NO,EXIT 04920000 L RJ,DCBBUFCB GET BUFFER CONTROL BLOCK A48163 04930000 TM FLGOFFST(RJ),EXTND SPACE FOR RECORD AREA A48163 04932000 * ADDR AVAILABLE 04934000 BNO DCBERROR N0, ABEND A48163 04936000 * 04938000 GETRALEN EQU * 04938400 LH RJ,DCBLRECL LOAD LRECL IN WORK REG A48163 04938821 LA RJ,CTLINFO(RJ) ADD 32 BYTES FOR CONTROL A48163 04939221 * INFORMATION 04939600 B GETCORE GO GET SPACE FOR RECORD A48163 04939700 * AREA 04939800 * 04940000 A0090 EQU * 05120000 MVC 0(IDTTR,RWTGC),LOAD3I UPDATE WTG ENTRY THIS DCB XM6327 05120101 RELOOP EQU * 06780000 LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURRENT WTG ENTRY 06800000 LA RPARC,PLOFF(0,RPARC) INCR CURRENT DCB ENTRY PTR 06820000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 06840000 BCR 8,RBASE RETURN TO INITIALIZE ANOTHER DCB 06860000 * 06880000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 06900000 BC 7,RELOOP NO, CHECK NEXT ENTRY 06920000 * 06940000 LR RPARC,RPAR 06960000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE WTG LIST PTR 06980000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 07000000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 07020000 * 07040000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 07060000 LA RPARC,PLOFF(0,RPARC) 07080000 BC 15,ZCHEK 07100000 * 07300000 * 07320000 ********************************************************************** 07340000 * 07360000 * 07380000 * 07400000 DCBERROR EQU * 07420000 * 07440000 OI DCBOFLGS,X'90' TURN ON WRITE,OPEN BITS 10929 07450015 DMABCOND OABD061,PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X07460020 CALL PROBLEM DETERMINATION 07470020 MVC XCTMODNM+C6(C2),ZERO(RWTGC) S21042 07480020 * MOVE PD MODULE ID TO WTG TABLE 07490020 MVC XCTTTR(C3),C2(RWTGC) MOVE PD TTR TO WTG TABLE S21042 07500020 B XCTLRTN S21042 07510020 * 07520000 * 07540000 HIARCHY EQU X'80' TEST DCBBFTEK FOR WHICH STORAGE DM0E 07550000 ********************************************************************** 07560000 * 07580000 * 07581020 TCTLRTN EQU * S20201 07582020 * XCTL TO THE NEXT LOAD OF OPEN 07583020 * 07584020 MVC XCTMODNM+C6(C2),LOAD3I STORE ID IN WTG TABLE S20201 07586020 MVC XCTTTR,TTR3I PUT TTR IN TABLE S20201 07587020 XCTLRTN EQU * S21042 07587620 LA RJ,DXXCTL SET UP FOR XCTL S21042 07588220 * 07589020 XCTL DE=(RWTG),SF=(E,(15)) S20201 07590020 * 07591020 WAOFF EQU 32 OFFSET OF FIRST ENTRY IN WTG TABLE 07600000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 07620000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 07640000 OPIDCNST DC C'0S' 07660000 AMIDCNST DC C'1I' THIS ROUTINE ID 07680000 WTGCNST DC C'IGG019 ' 07700000 DC X'00000000' 07720000 * 07740000 ****************************************************R**************** 07760000 * 07780000 * 07800000 * 07820000 XCTLTABL ID=(LOAD3I,3I,PDLOAD,6M),SVC=019 S21042 07920020 TTR3I EQU LOAD3I+C2 TTR OF MODULE 3I S21042 08020020 IKJTCB , S20016 08123020 DCBD DSORG=PS 08140000 * 08160000 * 08180000 IECDSECS MAIN,EXPAND=YES S21042 08210020 * COMMUNICATION VECTOR TABLE (SSS) 08240000 * TASK CONTROL BLOCK 08260000 TIOT DSECT 08700000 TIOELNGH DS CL1 LENGTH OF THIS ENTRY 08720000 TIOESTTA DS CL1 STATUS -A- 08740000 TIOERLOC DS CL2 REL. LOC OF POOL 08760000 TIOEDDNM DS 2F DDNAME 08780000 TIOEJFCB DS 1F JFCB DISK ADDR 08800000 TIOESTTB DS 0CL1 08820000 TIOEFSRT DS CL4 08840000 DS CL1 08860000 * TIOT POOL ENTRY 08880000 TIOPNSLT DS XL1 NR.OF SLOTS FOR POOL 08900000 DS CL1 08920000 TIOPNSRT DS XL1 NR.OF DEVICES (FILLED 08940000 * SLOTS) 08960000 TIOPPOOL DS CL8 POOL NAME 08980000 TIOPSTTB DS XL1 STATUS OF SLOT 09000000 TIOPSLOT DS XL3 SRT ADDRESS OR EMPTY SLOT 09020000 TIOTFEND DS 1F FINAL END OF AN ENTRY 09040000 SPACE 1 09060000 SRT DSECT 09080000 IEFUCBOB 09100000 * DATA EXTENT BLOCK (UNTIL PROTIOS CHANGES) 09120000 DEB DSECT 09140000 DEBNMSUB DS 0CL1 09160000 DEBTCBAD DS CL4 09180000 DEBAMLNG DS 0CL1 09200000 DEBDEBAD DS CL4 09220000 DEBOFLGS DS 0CL1 09240000 DEBIRBAD DS CL4 09260000 DEBOPATB DS 0CL1 09280000 DEBSYSPG DS CL4 09300000 DEBNMEXT DS 0CL1 09320000 DEBUSRPG DS CL4 09340000 DEBPRIOR DS 0CL1 09360000 DEBECBAD DS CL4 09380000 DEBPROTG DS 0CL1 09400000 DEBDEBID DS 0CL1 09420000 DEBDCBAD DS CL4 09440000 DEBEXSCL DS 0CL1 09460000 DEBAPPAD DS CL4 09480000 DEBDVMOD DS 0CL1 09500000 DEBUCBAD DS CL4 09520000 DEBTVLSQ DS 0CL2 VOL SEQ FOR TAPE 09540000 DEBBINUM DS CL2 09560000 DEBTVLNM DS 0CL2 NO OF VOL FOR TAPE 09580000 DEBSTRCC DS CL2 09600000 DEBSTRHH DS CL2 09620000 DEBENDCC DS CL2 09640000 DEBENDHH DS CL2 09660000 DEBNMTRK DS CL2 09680000 * FOR ADDITIONAL EXTENT ON DIRECT ACCESS THE FOLLOWING FIELDS 09700000 * WILL HAVE TO BE OFFSET ANOTHER 16 BYTES 09720000 DEBVOLSQ DS H 09740000 DEBVOLNM DS H 09760000 * FOR EACH SUBROUTINE LOADED BUMP THIS OFFSET BY 2 09780000 DEBSUBID DS H 09800000 CVT DSECT 09820000 CVT 09840000 SPACE 3 10540020 IKJTSCVT 11240020 SPACE 3 11940020 IEZJSCB 12640020 SPACE 3 13340020 IKJTIOCP 14040020 SPACE 3 14740020 IKJTSB 15440020 WTG DSECT 16840020 XCTMODNM DS CL8 MODULE NAME S20201 23840020 DS CL6 * S20201 30840020 XCTTTR DS CL3 TTR S20201 37840020 DS CL5 * S20201 44840020 XCTATTRB DS CL2 ATTRIBUTES S20201 51840020 XCTMODSZ DS CL3 MAIN STORAGE REQUIRED S20201 58840020 XCTTXTLN DS CL2 LENGTH OF FIRST TEXT REC S20201 65840020 XWTGLENG DS C * S20201 72840020 XWTGPATH DS CL2 * S20201 79840020 END 86840020 ./ ADD SSI=07010302,NAME=IGG0191J,SOURCE=0 TITLE 'IGG0191J-IECOSOP8 OPEN EXECUTOR(DIRECT ACCESS)(BSAM)' 00020000 TITLE 'BSAM-STAGE 2 OPEN EXEC-DIRECT ACCESS-OUTIN, INOUT' 00021021 COPY LCGASMSW 00023000 * RELEASE 20 DELETIONS * 00030000 *0973012800,016400,017200-018800,020400-021600,024200-025400, S20201 00030120 *0973026400-027000,029400,030200-037200,037600,038800-041400, S20201 00030220 *0973042200,043600-048400,050000-054200,055400-055800,056600- S20201 00030320 *0973057000,059200,063400,066800,071000,071400,073000,079000- S20201 00030420 *0973083200 S20201 00030520 * RELEASE 21 DELETIONS * 00031000 *0082041400,042700,055190,089010-089160 A37507 00031121 *0082041390-044400,056190,084800-085800 M0081 00031221 * A37507 00031521 * REFER TO CODE FLAGGED XA02335 SA62466 00031903 * VS1 DELETIONS 00032003 *D016180,054690-056190 XA02335 00042003 * STATUS CHANGE LEVEL 009 00043003 * THIS MODULE WAS SPLIT INTO IGG0196L FOR REL 21. 00052021 *FUNCTION/OPERATION: THIS ROUTINE WILL GET CORE(GETMAIN) TO SET UP THE 00060000 * NECESSARY IOB'S. IT WILL CLEAR THE CORE AND LINK THE IOB'S 00080000 * TOGETHER.(DIRECT ACCESS) 00100000 * IT SETS CODES IN THE DCBCNTRL FIELD OF THE DCB. IT WILL 00110021 * CONSTRUCT - THE SET SECTOR COMMAND (MERLIN/ZEUS) 00120021 * - THE SEARCH COMMAND 00130021 * - THE TIC BACK TO SEARCH COMMAND 00140021 * - THE READ COMMANDS 00150021 * IT THEN XCTL'S TO IGG0196L FOR COMPLETION OF THE IOB'S 00160021 * 00220000 *ENTRY POINTS: IGG0191J BY XCTL FROM IGG0193I OR IGG0196B. 00230021 * 00240021 * 00260000 *INPUT: SEE DESCRIPTION OF REGISTERS, DCB(USERS). 00280000 * 00300000 *OUTPUT: SEE DESCRIPTION OF REGISTERS, DCB(USERS), IOB(USERS). 00320000 * 00340000 *EXTERNAL ROUTINES : NONE 00360000 * 00380000 *EXITS-NORMAL: XCTL TO IGG0196L 00400021 * 00420000 *EXITS-ERROR: NONE 00440000 * 00460000 *TABLES/WORKAREAS: DUPE WTG TABLE************************************** 00480000 * SEE DEVICETB DSECT. 00500000 * 00520000 *ATTRIBUTES: REENTRANT, REUSABLE. 00540000 * 00560000 * NOTES- THIS EXECUTOR DEALS WITH DIRECT ACCESS FOR IN/OUT - OUT/IN. 00580000 * 00600000 SPACE 1 00620000 * 00640000 * * 00660000 * 2841 OP CODES * 00680000 * * 00700000 TIC EQU X'08' TIC OP CODE 00740000 WRTCK EQU X'80' 00760000 SRCHE EQU X'31' SEARCH OP CODE 00780000 READATA EQU X'86' READ DATA CCW 00820000 READKEDA EQU X'8E' READ KEY AND DATA OP CODE 00840000 READCOUN EQU X'92' READ COUNT OP CODE 00860000 SETSC EQU X'23' SET SECTOR COMMAND S20201 00885020 VFORMAT EQU X'40' MASK FOR V FORMAT S20201 00895020 * * 00900000 *********************************************************************** 00920000 * * 00940000 * CCW CONSTRUCTION EQUATES * 00960000 * * 00980000 SILI EQU X'20' SILI FLAG 01020000 CMDSKPSL EQU X'70' COMMAND SKIP AND SILI 01040000 COMSILI EQU X'60' COMMAND AND SILI 01060000 COMCHAIN EQU X'40' COMMAND CHAIN BIT 01120000 ONE EQU 1 01180000 FIVE EQU 5 01220000 ATE8 EQU 8 01260000 CC EQU X'40' COMMAND CHAIN S20201 01280020 *********************************************************************** 01300000 * * 01320000 * MISC EQUATES * 01340000 * * 01360000 MINKEY EQU X'01' 01380000 UFORMAT EQU X'C0' U FORMAT TEST MASK 01440000 BWCHP EQU 4 BASIC WRITE CHP LENGTH S20201 01602020 BIOB EQU 16 BASIC IOB LENGTH S20201 01604020 MAX EQU 256 MAX VALUE FOR LENGTH FLD S20201 01606020 NOERR EQU X'7F' ECB INDICATION OF NO S20201 01608020 * ERROR S20201 01610020 NONCARN EQU X'20' NO DISCONNECT USED S20201 01612020 SDOPT EQU X'08' SEARCH DIRECT OPTION S20201 01614020 * BYTE S20201 01616020 *********************************************************************** 01620000 * 01621020 * DISPLACEMENTS AS EQUATES 01622020 * 01623020 D0 EQU 0 DISPLACEMENT OF ZERO S20201 01624020 D1 EQU 1 DISPLACEMENT OF ONE S20201 01625020 D2 EQU 2 DISPLACEMENT OF TWO S20201 01626020 D3 EQU 3 DISPLACEMENT OF THREE S20201 01627020 D4 EQU 4 DISPLACEMENT OF FULLWORD S20201 01628020 D5 EQU 5 DISPLACEMENT OF FIVE S20201 01629020 D6 EQU 6 DISPLACEMENT OF SIX S20201 01630020 D8 EQU 8 DISPLACEMENT OF DW S20201 01632020 D12 EQU 12 DISPLACEMENT OF THREE S20201 01633020 * WORDS S20201 01634020 D15 EQU 15 DISPLACEMENT OF FIFTEEN S20201 01635020 D24 EQU 24 DISPLACEMENT OF SIX S20201 01638020 * WORDS S20201 01639020 D40 EQU 40 DISPLACEMENT OF TEN S20201 01640020 * WORDS S20201 01641020 D43 EQU 43 DISPLACEMENT OF CCHHR S20201 01642020 * IOB S20201 01643020 D44 EQU 44 DISPLACEMENT OF CP PTR S20201 01644020 FLAGOFF EQU 4 CCW FLAG OFFSET S20201 01645020 CNTOFF EQU 7 CCW COUNT OFFSET S20201 01646020 *********************************************************************** 01660000 *********************************************************************** 01680000 * 01700000 * 01750020 * REGISTER CONVENTIONS USED THROUGHOUT ALL OPEN PASSES 01800020 * 01850020 * 01900000 *********************************************************************** 01920000 * 01940000 RE EQU 0 01960000 RF EQU 1 WORK REG ONE S20201 01963020 RDCB EQU 2 DCB REGISTER S20201 01966020 RBASE EQU 3 BASE REGISTER S20201 01969020 RCORE EQU 4 WORK AREA ADDR S20201 01972020 RWTG EQU 6 01980000 RPARC EQU 7 CURRENT PARAMETER S20201 01990020 * 02000000 RWTGC EQU 8 02020000 RUCB EQU 10 ADDRESS OF UCB S20201 02100020 RDEB EQU 11 ADDRESS OF DEB S20201 02140020 RB EQU 12 2 02180000 RC EQU 13 3 02200000 RD EQU 14 4 02220000 RJ EQU 15 5 02240000 * 02260000 * 02280000 *********************************************************************** 02300000 * 02320000 *********************************************************************** 02340000 * 02360000 * 02380000 IGG0191J CSECT 02400000 USING SOP810,RBASE S20201 02410020 USING IHADCB,RDCB REG 2 IS DCB S20201 02420020 USING FORCORE,RCORE REG 4 IS WORK AREA ADDR S20201 02430020 BALR RBASE,RE REG 3 IS BASE RE=0 S20201 02440020 * 02450020 SOP810 EQU * S20201 02460020 * 02470020 L RDCB,D0(RPARC) GET DCB ADDR S20201 02480020 LA RDCB,D0(RDCB) CLEAR HI BYTE S20201 02490020 L RCORE,D4(RWTGC) GET WORK AREA ADDR S20201 02500020 * 02560000 * 02580000 * 02600000 * 02620000 SR RD,RD 02720000 ST RD,DCBCNTRL CLEAR CONTROL S20201 02730020 NI DCBCIND2,X'FE' TURN OFF QSAM BIT IF ON 02740000 MVI DCBCNTRL+3,2 READ EOB RT ID 02760000 MVI DCBCNTRL+2,1 ID OF WRT EOB RT. 02780000 TM DCBMACRF,X'04' NOTE POINT USED 02800000 BC 1,SOP810A YES BRANCH 02820000 TM DCBMACRF+1,X'04' 02840000 BC 14,SOP810B NO BRANCH 02860000 SOP810A EQU * 02880000 MVI DCBCNTRL+1,5 NPDT ID NO. 02900000 SOP810B EQU * 02920000 LA RC,BIOB BASIC IOB SIZE S20201 02930020 LA RD,BWCHP BASIC WRT CHP SIZE S20201 02940020 * 02950020 * 02960000 * 02980000 * BSAM USED 03000000 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 03010020 * DISCONNECT S20201 03020020 BO SOP811 BRANCH IF YES S20201 03030020 LA RC,D5(RC) INCREMENT FOR 5 CCW S20201 03040020 LA RD,D2(RD) INCREMENT FOR 2 CCW S20201 03050020 * 03060020 * 03070020 SOP811 EQU * S20201 03080020 TM DCBOPTCD,WRTCK WRITE CHK USED S20201 03090020 BNO SOP815 BRANCH IF NO S20201 03100020 LA RC,D3(RC) INCREMENT FOR 3 CCW S20201 03110020 LA RD,D3(RD) INCREMENT FOR 3 CCW S20201 03120020 * 03140020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 03150020 * DISCONNECT S20201 03160020 BO SOP815 BRANCH IF YES S20201 03170020 LA RC,D1(RC) IOB+1 DW S20201 03180020 LA RD,D1(RD) WRT CHP +1 DW S20201 03190020 SOP815 EQU * S20201 03200020 * 03210020 TM JFCBMASK+D6,SDOPT SEARCH DIRECT USED S20201 03220020 BZ SOP816 BRANCH IF NO S20201 03230020 * SD S20201 03240020 LA RC,D2(RC) INCREMENT FOR TWO CCWS S20201 03250020 SOP816 EQU * S20201 03260020 * 03270020 * STORE DW LENGTHS THEN CALCULATE IOB SIZE TIMES NO. OF IOBS 03280020 * 03290020 STC RC,DCBIOBL IOB LENGTH S20201 03300020 STC RD,DCBWCPL WRITE CHP LENGTH S20201 03310020 * 03320020 SR RUCB,RUCB CLEAR REG S20201 03330020 IC RUCB,DCBNCP GET NO. OF CHPS S20201 03340020 LTR RUCB,RUCB BEEN SPECIFIED S20201 03350020 BNZ SOP817 BRANCH IF SPECIFIED S20201 03360020 LA RUCB,ONE FURNISH ONE IF NOT S20201 03370020 SOP817 EQU * S20201 03380020 LA RDEB,ATE8 CONSTANT OF EIGHT S20201 03390020 MR RB,RDEB IOB DW SIZE TIMES 8 S20201 03400020 LR RE,RC KEEP SIZE S20201 03410020 MR RB,RUCB SIZE TIMES NO. OF IOBS S20201 03420020 * 03430020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 03440020 * DISCONNENT S20201 03450020 BO SOP821 BRANCH IF YES S20201 03460020 LA RC,D8(RC) INCREMENT 1 DW S20201 03470020 SOP821 EQU * S20201 03480020 LR RB,RC SAVE AMOUNT S20201 03490020 LR RDEB,RE SAVE IOB SIZE S20201 03500020 *********************************************************************** 03740000 GETMAIN R,LV=(RC),SP=250 S20201 03760020 ***** 03780000 ***** 03800000 *********************************************************************** 03820000 * THE FOLLOWING CODE WILL CLEAR STORAGE RECEIVED FROM GETMAIN 03840000 * 03860000 ST RF,DCBIOBA ADDR IOB TO DCB S20201 03878020 LR RD,RF COPY ADDRESS USE TO CLR S20201 03887020 LR RE,RDEB RESTORE IOB SIZE S20201 03896020 LA RDEB,ATE8 CONSTANT OF EIGHT S20201 03905020 * 03914020 * SET UP THETA ADDRS, MAY BE USED LATER 03923020 * 03932020 LR RJ,RB COPY AMOUNT S20201 03941020 AR RJ,RF GET AREA +1 ADDR S20201 03950020 SR RJ,RDEB SUB 1 DW S20201 03959020 ST RJ,DXCCW11 TEMP STORE SET THETA S20201 03968020 * ADDR S20201 03977020 LA RJ,D1(RJ) INCR BY ONE BYTE S20201 03986020 ST RJ,DXCCW12 TEMP STORE READ THETA S20201 03995020 * ADDR S20201 04004020 * 04013020 * CLEAR CORE HERE RB=AMT RD=ADDR 04022020 * 04031020 LA RJ,MAX CONSTANT OF 256 S20201 04040020 B CLEAR GO AROUND EXEC MODELS S20201 04049020 SOP8LO XC D0(ONE,RD),D0(RD) CLEARS REMAINIG BYTES S20201 04058020 SOP8HI XC D0(MAX,RD),D0(RD) CLEARS 256 BYTES S20201 04067020 AR RD,RJ ADD 256 TO ADDR S20201 04076020 CLEAR SR RB,RJ SUB 256 FROM AMT S20201 04085020 BH SOP8HI IF AMT GT 256 BRANCH S20201 04094020 AR RB,RJ CORRECT AMT S20201 04103020 BCTR RB,RE REDUCE BY ONE BYTE S20201 04112020 EX RB,SOP8LO CLEAR REMAINING BYTES S20201 04121020 LR RB,RF COPY ADDR S20201 04130020 USING IOBQSAMD,RF USE IOB PREFIX DSECT A37507 04136021 ST RB,IOBNIOBA STORE FIRST IOB ADDR IN A37507 04142021 * FIRST IOB FOR THE CASE M0081 04150021 * OF ONE IOB - INSTRUCTION M0081 04160021 * UNNECESSARY IF MORE THAN M0081 04170021 * ONE IOB M0081 04180021 DROP RF A37507 04185021 B SOP830 BYPASS LINKING IOB'S M0081 04190021 * 04200021 * BEGIN LOOP TO CONSTRUCT IOB'S 04210021 * 04220021 SOP829 EQU * M0081 04230021 LR RB,RF GET POINTER TO LAST M0081 04240021 * IOB BUILT M0081 04250021 AR RB,RE NEXT IOB TO BE BUILT M0081 04260021 USING IOBQSAMD,RF ADDRESSABILITY FOR DSECT A37507 04265021 ST RB,IOBNIOBA LINK IOB'S A37507 04270021 DROP RF A37507 04275021 LR RF,RB NEXT IOB TO BE BUILT M0081 04280021 SOP830 EQU * COME HERE IF FIRST IOB M0081 04290021 LA RB,D4(RB) PT TO ECB S20201 04460020 ST RB,D12(RF) PUT PTR IN IOB S20201 04480020 MVI D0(RB),NOERR INDICATE COMP NO ERROR S20201 04500020 * 04520020 ST RDCB,D24(RB) PUT DCB ADDR IN IOB S20201 04540020 LA RB,D44(RB) PT TO CHP STARTAD S20201 04560020 ST RB,D24(RF) PUT ADDR IN IOB S20201 04580020 MVC D40(ATE8,RF),DCBFDAD INITIALIZE IOBFDAD S20201 04600020 * 04620020 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 04640020 * DISCONNECT S20201 04660020 BO SOP831 BRANCH IF YES S20201 04680020 BAL RD,SOP8STA IF NO GO BUILD SET CMND S20201 04700020 * 04720020 * UPON RETURN SET UP TO BUILD SRCH CMND AND GO BUILD IT 04740020 * 04760020 SOP831 EQU * S20201 04780020 LA RC,D43(RF) GET PTR TO CCHHR S20201 04800020 BAL RD,SOP8SRTC GO BUILD SRCH AND TIC S20201 04820020 * 04860000 * THE 'SEARCH AND TIC CCWS HAVE NOW BEEN CONSTRUCTED. 04880000 * 04900000 * 04920000 LA RB,16(0,RB) WRITE CCW POINTER 04960000 * 04980000 LA RC,D43(RF) PT TO CCHHR S20201 04983020 AR RC,RE NOW INCREMENT TO NEXT S20201 04986020 * IOB S20201 04989020 CH RUCB,CON1 IS THIS THE LAST IOB S20201 04992020 BNE SOP832A BRANCH IF NO S20201 04995020 L RC,DCBIOBA GET FIRST IOB ADDR S20201 04998020 LA RC,D43(RC) PT TO CCHHR S20201 05001020 SOP832A EQU * S20201 05004020 CLI DCBNCP,ONE ONLY ONE IOB S20201 05007020 BH SOP833 BRANCH IF MORE S20201 05010020 LA RC,DCBFDAD+D3 IF NOT PT TO IOB CCHHR S20201 05013020 SOP833 EQU * S20201 05016020 BAL RD,SOP8READ GO BUILD READ CCWS S20201 05019020 BCT RUCB,SOP829 05319021 USING IOBQSAMD,RF ADDRESSABILITY FOR DSECT A37507 05369021 MVC IOBNIOBB,DCBIOBA+1 LINK LAST TO FIRST A37507 05419021 DROP RF A37507 05669021 MVC 0(5,RCWG),MOD196L ID OF IGG0196L M0081 05719021 LR RSTART,RBASE RESTORE BASE REG S20201 05920020 * 05940000 RELOOP LA RCWG,WGOFF(0,RCWG) INCREMENT CURR WTG ENTRY 05960000 LA RCPL,PLOFF(0,RCPL) INCR CURRENT DCB ENTRY POINTER 05980000 CLC 0(2,RCWG),AMIDCNST THIS RT NEEDED AGAIN 06000000 BCR EGHT,RSTART BACK TO OPEN AGAIN DM0I 06020000 CLC 0(2,RCWG),OPIDCNST END OF WTG TABLE 06040000 BC 7,RELOOP NO,CHECK NEXT ENTRY 06060000 LR RCPL,RPL 06080000 LA RCWG,WAOFF(0,RWG) REINITIALIZE WTG LIST PTR 06100000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 06120000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 06140000 LA RCWG,WGOFF(0,RCWG) GET NEXT ENTRY 06160000 LA RCPL,PLOFF(0,RCPL) 06180000 B ZCHEK ZERO CHECK DM0I 06200000 ** 06220000 TCTLRTN EQU * 06240000 MVC 6(2,RWTG),0(RCWG) STORE ID IN WTG TABLE 06260000 MVC 14(3,RWTG),2(RCWG) MOVE TTR INTO TABLE 06280000 * 06300000 L RCORE,4(RWTGC) GET WORK AREA ADDRESS 06320000 LA RJ,DXXCTL SET UP FOR XCTL 06340021 ** 06360000 XCTL DE=(RWTG),SF=(E,(15)) 06380000 ** 06400000 SPACE 1 06420000 ** 06440000 ***** 06460000 * 06480000 SPACE 3 06500000 RPL EQU 5 06520000 RWG EQU 6 06540000 RCPL EQU 7 06560000 RCWG EQU 8 06580000 RSTART EQU 11 06600000 WAOFF EQU 32 06620000 PLOFF EQU 4 OFFSET OF DCB ENTRIES DM0I 06640000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 06660000 OPIDCNST DC C'0S' ID DM0I 06700000 AMIDCNST DC C'1J' ID DM0I 06720000 * 06740000 *********************************************************************** 06760000 * 06780000 * THIS SECTION OF CODE BUILDS A READ CHANNEL PROGRAM * 06800000 * * 06820000 * R2 POINTS TO NEXT CCW ON ENTRY AND EXIT * 06840000 * * 06860000 * R4 IS RETURN -- R6 POINTS TO COUNT READ IN * 06880000 * 06900000 * * 06920000 *********************************************************************** 06940000 * 06960000 SOP8READ MVI 7(RB),ONE COUNT 06980000 MVI 0(RB),READATA READ DATA OP CODE 07000000 MVI 4(RB),CMDSKPSL COMMAND CHAIN,SKIP,SILI 07020000 * 07040000 MVI 15(RB),FIVE COUNT 07060000 MVI 12(RB),COMSILI COMMAND CHAIN,SILI 07080000 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O RCD S20201 07084020 * READY S20201 07088020 BO SOP8RD7 BRANCH IF YES S20201 07092020 LR RC,RF GET IOB PTR S20201 07096020 AR RC,RE INCR TO NEXT IOB S20201 07100020 SR RC,RDEB BACK UP ONE DW S20201 07104020 MVI D15(RB),ATE8 S20201 07108020 SOP8RD7 EQU * S20201 07112020 ST RC,D8(RB) ADDRESS S20201 07116020 MVI 8(RB),READCOUN READ COUNT OP CODE 07120000 AR RB,RDEB INCREMENT PTR S20201 07126020 AR RB,RDEB INCR PTR S20201 07132020 SR RB,RF GET RD CCW OFFSET S20201 07138020 STC RB,DCBOFFSR PUT IN DCB S20201 07144020 AR RB,RF RESTORE PTR S20201 07150020 * 07160000 SOP8RD10 CLI DCBKEYLE,MINKEY ARE KEYS SPECIFIED 07180000 BC 4,SOP8RD15 BRANCH ON NO (LESS THAN 1) 07200000 MVI 0(RB),READKEDA READ KEY AND DATA OP CODE 07220000 B SOP8RD18 SKIP DM0I 07240000 SOP8RD15 MVI 0(RB),READATA READ DATA OP CODE 07260000 SOP8RD18 TM DCBRECFM,UFORMAT U FORMAT SPECIFIED 07280000 BNM SOP8RDU BRANCH IF U FORMAT S20201 07288020 TM DCBRECFM,VFORMAT IS IT V FORMAT S20201 07296020 BNO SOP8RD20 IF NOT, DONT SET SILI S20201 07304020 SOP8RDU EQU * S20201 07312020 MVI 4(RB),SILI SILI FLAG 07320000 SOP8RD20 LA RB,8(0,RB) INCREMENT CCW POINTER 07340000 BR RD EXIT DM0I 07360000 * 07380000 *********************************************************************** 07400000 * 07420000 * 07440000 *********************************************************************** 07460000 * 07480000 * THIS SECTION OF CODE BUILDS A SEARCH AND TIC CCW * 07500000 * 07520000 * 07540000 * RC POINTS TO SEARCH ADDRESS-- RB POINTS TO NEXT CCW ON ENTRY * 07560000 * RB IS NOT CHANGED IN ROUTINE.-- RD IS RETURN-- * 07580000 * * 07600000 *********************************************************************** 07620000 SOP8SRTC ST RC,0(0,RB) SEARCH ADDRESS 07640000 MVI 0(RB),SRCHE SEARCH OP CODE 07660000 MVI 7(RB),FIVE COUNT 07680000 MVI 4(RB),COMCHAIN COMMAND CHAIN 07700000 * 07720000 * TIC 07740000 * 07760000 LA RC,5(0,RC) SEARCH ADDRESS 07780000 ST RB,8(0,RB) TIC TO SEARCH 07800000 MVI 8(RB),TIC TIC OP CODE 07820000 BR RD EXIT DM0I 07840000 *********************************************************************** 07860000 * 07861020 * THIS RTN BUILDS SET THETA COMMANDS, RB POINTS TO CCW 07862020 * 07863020 SOP8STA EQU * S20201 07864020 L RC,DXCCW11 GET SET THETA ADDR S20201 07865020 ST RC,D0(RB) PUT IN CCW S20201 07866020 OI FLAGOFF(RB),CC TURN ON COMMAND CHAIN S20201 07867020 * FLAG S20201 07868020 MVI CNTOFF(RB),ONE SET COUNT TO ONE S20201 07869020 MVI D0(RB),SETSC PUT IN COMMAND S20201 07870020 AR RB,RDEB INCREMENT PTR S20201 07871020 BR RD RETURN S20201 07872020 ******************************************************************* 07895020 *** 07896020 CON1 DC H'1' CONSTANT OF ONE S20201 08350020 SPACE 2 08360000 EGHT EQU 8 DM0I 08380000 SPACE 2 08400000 *** 08420000 *********************************************************************** 08440000 ***** 08460000 XCTLTABL ID=(MOD196L,6L),SVC=019 M0081 08530021 DCBD DSORG=PS 08600000 IECDSECS MAIN,EXPAND=YES 08610021 * A37507 08610521 * PREFIX FOR NORMAL SCHEDULING IOB A37507 08611021 * A37507 08611521 ORG DXIOB-8 LOCATION OF NORMAL SCHEDULING A37507 08612021 * PREFIX A37507 08612521 IOBQSAMD DS 0D BEGIN PREFIX A37507 08613021 IOBNIOBA DS 0A LINK FIELD A37507 08613521 IOBNFLG1 DS B I/O FLAGS A37507 08614021 IOBPRTOV EQU X'80' PRINTER OVERFLOW LAST I/O A37507 08614521 IOBWRITE EQU X'40' LAST I/O WAS A WRITE A37507 08615021 IOBREAD EQU X'20' LAST I/O WAS A READ A37507 08615521 IOBUPDAT EQU X'10' THIS BLOCK TO BE UPDATED A37507 08616021 IOBBKSPC EQU X'08' LAST I/O BSP,N/P,CNTRL A37507 08616521 IOBSPAN EQU X'04' LOGICAL REC INTERFACE A37507 08617021 IOBFIRST EQU X'01' FIRST IOB IN CHAIN A37507 08617521 IOBNIOBB DS AL3 THREE BYTE LINK ADDR A37507 08618021 IOBNECB DS 1F EVENT CONTROL BLOCK A37507 08618521 DCBKEYL EQU DCBKEYLE 08620000 * 08640000 * 08660000 * 08680000 * DEB 08700000 * 08720000 DEBDEF DSECT 08740000 DS 9F SPACE RESERVED DM0I 08760000 DEBSTRBB DS H START BIN NO. DM0I 08780000 DEBSTRCC DS CL4 START CYCL. DM0I 08800000 * 08820000 PARMDEF DSECT 08840000 PARMDEF1 DS 3F PARAMETER DM0I 08860000 * 08880000 * 08900000 SPACE 2 08920000 SPACE 3 08940000 DEVICETB DSECT 08960000 DEVCONST DC X'04000000' DEVICE CONSTANT DM0I 08980000 DEVCYLST DC X'00' LIST DM0I 09000000 DEVCYLEN DC X'CA' END CYLINDER 09020000 DEVTRKST DC X'00' START TRACK 09040000 DEVTRKEN DC X'09' TRACK END 09060000 DEVTKLEN DC FL2'3649' TRACK LENGTH - R0 09080000 DEVOVHI DC FL1'82' NORMAL OVERHEAD 09100000 DEVOVHL DC FL1'55' LAST RECORD OVERHEAD 09120000 DEVOVHK DC FL1'20' KEY ID OVERHEAD 09140000 DEVFLAG DC FL1'1' FLAG 09160000 DEVTOLR DC FL2'269' TOLERANCE 09180000 SPACE 3 09200000 END 09220000 ./ ADD SSI=04011800,NAME=IGG0191K,SOURCE=0 TITLE ' IGG0191K INPUT DA EXECUTOR FOR PCI SCHEDULING' S20201 00010020 IGG0191K CSECT 00023000 * RELEASE 16 DELETIONS 00026000 *3004 14915 00027016 * RELEASE 17 DELETIONS 00029000 * RELEASE 18 DELETIONS 00032000 *0833141000 8M616 00032218 *0833 21476 00032518 *0833 MCS 00033018 * RELEASE 19 DELETIONS 00035000 *1394129000,152200-153400 A28683 00036019 *1394118800-119000 A27067 00037019 *1394078630-078720 A25961 00037519 *1394043900 M3641 00037719 * RELEASE 20 DELETIONS 00038000 *1242000200,031400,040800-041000,050000-051000,055400-055600, S20201 00038620 *1242056800-059800,068600-069000,084200,085800-086000,097200- S20201 00039220 *1242097600,097800,099200-099400,101200-117600,120200,121000- S20201 00039820 *1242121200,125400-125800 S20201 00040420 * RELEASE 21 DELETIONS 00041000 *0216005200,134400,140800-141400,149810-149930,161200-161400 S21042 00042021 * RELEASE 22 DELETIONS 00044000 * RELEASE 23 DELETIONS 00047000 * RELEASE 24 DELETIONS 00050000 *STATUS CHANGE LEVEL 004 00055021 *FUNCTION/OPERATION -- THIS EXECUTOR BUILDS THE MAIN IOB & ICBS THAT 00060000 * WILL CONTROL THEIR ASSOCIATED CHANNEL PROGRAMS. 00080000 * IT ALSO CONSTRUCTS INPUT OR OUTPUT CHANNEL PROG. 00100000 * AND FILLS IN DEVICE DEPENDANT FIELDS IN THE DCB. 00120000 * FOR QSAM THE CHANNEL PROGRAMS INCLUDE THE BUFFER 00140000 * ADDRESS,THE PHYSICAL BLOCK SIZE AND ASSC FLAGS. 00160000 * ALL ICBS ARE LINKED TOGETHER 00180000 * THE GETMAIN MACRO IS USED TO OBTAIN SPACE FOR 00200000 * THE IOB & ICBS. 00220000 * 00240000 * 00260000 *ENTRY POINTS - ENTERED AT IGG0191K FROM THE LEVEL ONE 00280000 * EXECUTOR IGG0191B VIA THE XCTL MACRO 00300000 * 00320000 *INPUT SUPPLIED- USER DCB AND OPEN PARAMETERS -- SEE REGISTER USAGE 00340000 * 00360000 *OUTPUT GIVEN - MAIN IOB , ICBS AND CHANNEL PROGRAMS , DCB INITIAL 00380000 * 00400000 * 00420000 *EXTERNAL RTS. - NONE 00440000 * 00460000 *EXITS-NORMAL: XCTL TO IGG01910(IECOSLDA) TO LOAD ROUTINES 00480000 * 00500000 *EXITS-ERROR: XCTL TO PROBLEM DETERMINATION FOR WTP AND 013 ABEND 00520021 * 00540000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00560000 * 00580000 * BYTE 0-7 NAME 00600000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00620000 * BYTE 11 CONCATENATION NUMBER 00640000 * BYTE 12 ZERO 00660000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00680000 * ALIAS INDICATOR 1 BIT 00700000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00720000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00740000 * BYTE 17 ZERO 00760000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00780000 * BYTE 20 TRANSLATION TABLE 00800000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00820000 * BYTE 22-23 ATTRIBUTES 00840000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00860000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00880000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00900000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00920000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00940000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 00960000 * BYTE 36-39 TABLE OF IDTTR'S 00980000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01000000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01020000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01040000 * NOT USED (1 BYTE) 01060000 * 01080000 *ATTRIBUTES: REENTRANT,REUSABLE. 01100000 * 01120000 * 01140000 *********************************************************************** 01160000 * 01180000 * 01200000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01220000 * 01240000 *********************************************************************** 01260000 * 01280000 RDCB EQU 2 DCB REGISTER 01300000 RBASE EQU 3 BASE REGISTER 01320000 RCORE EQU 4 WORK AREA ADDRESS 01340000 RPAR EQU 5 TOP OF PARAMETER LIST 01360000 RWTG EQU 6 TOP OF WTG TABLE 01380000 RPARC EQU 7 CURRENT PARAMETER 01400000 RWTGC EQU 8 CURRENT TRANS LOAD 01420000 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECTOR ADDR. 01440000 RUCB EQU 10 USED HERE AS A COUNTER IN IOB GENERATION 01460000 RDEB EQU 11 DEB ADDRESS 01480000 RB EQU 12 WORK REG1 ** 01500000 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 01520000 RD EQU 14 WORK REG3 ** 01540000 RJ EQU 15 WORK REG4 01560000 RE EQU 0 WORK REG5 01580000 RF EQU 1 WORK REG6 01600000 * 01620000 * 01640000 PARAR EQU RPARC 01660000 * 01680000 *********************************************************************** 01700000 * 01720000 * 01740000 * 01760000 ********************************************************************* 01780000 * MASK'S TO TEST PARAMETER LIST WITH 01800000 INP EQU X'0F' 01820000 OUTP EQU X'0F' 01840000 UPDATE EQU X'04' 01860000 INOUT EQU X'03' 01880000 OUTIN EQU X'07' 01900000 RDBACK EQU X'01' 01920000 * 01940000 * 01960000 ********************************************************************* 01980000 * 02000000 * 02020000 * OFFSET FOR PARAMETER TESTS 02040000 * 02060000 ONE EQU X'01' 02080000 FRTYATE EQU 48 02100000 DISPSN EQU X'0' 02120000 * 02140000 * 02160000 ********************************************************************* 02180000 * 02200000 * OFFSETS FOR DEB REFERENCE 02220000 * 02240000 * 02260000 * 02280000 * 02300000 * 02320000 ********************************************************************* 02340000 * 02360000 * MASK'S USED TO TEST OPTION FIELDS IN DCB 02380000 * 02400000 * 02420000 * 02440000 DOUBLE EQU X'01' 02460000 * 02480000 * 02500000 STOWB EQU X'80' 02520000 WRTCK EQU X'80' 02540000 OVRFLO EQU X'20' 02560000 PCIB EQU X'20' 02580000 MINKEY EQU X'01' 02600000 CONCAT EQU X'FF' 02620000 SRCHDIRB EQU X'40' 02640000 ONONYES EQU X'0C' 02660000 * 02680000 ********************************************************************* 02700000 * 02720000 * MASKS FOR ACCESS METHODS IN SAM 02740000 * 02760000 QSAMB EQU X'01' 02780000 BSAMBIT EQU X'00' 02800000 PAM EQU X'02' 02820000 * 02840000 * 02860000 * MASKS FOR MACRO'S TO BE USED 02880000 * 02900000 GETB EQU X'40' 02920000 PUTB EQU X'40' 02940000 READB EQU X'20' 02960000 WRITEB EQU X'20' 02980000 POINTB EQU X'04' 03000000 CNTRLB EQU X'02' 03020000 * 03040000 * 03060000 ********************************************************************* 03080000 * 03100000 * MASKS FOR DEVICES TO BE SUPPORTED 03120000 NORCDRY EQU X'20' NO RECORD READY MASK S20201 03140020 * 03160000 * 03180000 ********************************************************************* 03200000 * 03220000 * MASKS FOR STATUS BITS TO BE TESTED 03240000 * 03260000 * 03280000 EXCPN EQU X'30' 03300000 COMPLETE EQU X'60' 03320000 FIRSTIOB EQU X'01' 03340000 * 03360000 * 03380000 * 03400000 ********************************************************************* 03420000 * 03440000 * MASKS FOR BUFFER TECHNIQUE'S 03460000 * 03480000 EXCHANGB EQU X'10' 03500000 SIMPLEB EQU X'40' 03520000 * 03540000 ********************************************************************* 03560000 * 03580000 * 03600000 * MODES OF OPERATION FOR QSAM 03620000 * 03640000 LOCATEB EQU X'08' 03660000 MOVEB EQU X'10' 03680000 SUBSTUTB EQU X'04' 03700000 * 03720000 * 03740000 ********************************************************************* 03760000 * 03780000 * 03800000 * COMMAND BYTES FOR THE 2841 03820000 * 03840000 * CONTROL UNIT 03860000 * 03880000 * 03900000 * 03920000 SRCHE EQU X'31' 03940000 WRTCKD EQU X'1D' 03960000 RDC EQU X'92' 03980000 RDKD EQU X'8E' 04000000 RDD EQU X'86' 04020000 NOP EQU X'03' 04040000 TIC EQU X'08' 04060000 SETSC EQU X'23' SET SECTOR CCW CMND S20201 04070020 RDSC EQU X'22' RD SECTOR CCW CMND S20201 04080020 TICNOP EQU X'88' RCD READY TIC NOP S20201 04090020 * 04100020 * 04110020 ********************************************************************* 04120000 * 04140000 * 04160000 * MASKS FOR RECORD FORMATS 04180000 * 04200000 * 04220000 STANDRDF EQU X'08' 04240000 FORMATU EQU X'C0' 04260000 FORMATF EQU X'80' 04280000 FORMATV EQU X'40' 04300000 BLOCKED EQU X'10' 04320000 FSTANDRD EQU X'88' 04340000 FIXBKD EQU X'90' 04360000 NOTPNTID EQU X'05' 04380000 FORMATVS EQU X'48' VARIABLE SPANNED M3641 04390019 * 04400000 * 04420000 ********************************************************************* 04440000 * 04460000 * 04480000 * CHANNEL CONTROL WORD FLAGS 04500000 * 04520000 SKIP EQU X'10' 04540000 SLI EQU X'20' 04560000 PCI EQU X'08' 04580000 CC EQU X'40' 04600000 DATACH EQU X'A0' 04620000 SLICC EQU X'60' 04640000 SLICCSK EQU X'70' 04660000 * 04680000 * 04700000 ********************************************************************* 04720000 * 04740000 * 04760000 KEYS EQU X'01' 04780000 QSAM EQU X'01' 04800000 * 04820000 * 04840000 ********************************************************************* 04860000 * 04880000 COMMTABL EQU 16 04900000 OABD065 EQU 65 S21042 04910021 * 04920000 ********************************************************************* 04940000 * 04960000 * 04980000 * 04985020 * MISCELLANEOUS EQUATES AND DISPLACEMENTS 04990020 * 04995020 D0 EQU 0 DISPLACEMENT OF 0 S20201 05000020 D1 EQU 1 DISPLACEMENT OF 1 S20201 05005020 D2 EQU 2 DISPLACEMENT OF 2 S20201 05010020 D3 EQU 3 DISPLACEMENT OF 3 S20201 05015020 D4 EQU 4 DISPLACEMENT OF 4 S20201 05020020 D5 EQU 5 DISPLACEMENT OF 5 S20201 05025020 D6 EQU 6 DISPLACEMENT OF 6 S20201 05030020 D7 EQU 7 DISPLACEMENT OF 7 S20201 05035020 D8 EQU 8 DISPLACEMENT OF 8 S20201 05040020 D15 EQU 15 DISPLACEMENT OF 15 S20201 05045020 * 05050020 D40 EQU 40 DISPLACEMENT OF 40 S20201 05055020 D51 EQU 51 DISPLACEMENT OF 51 S20201 05060020 D52 EQU 52 DISPLACEMENT OF 52 S20201 05065020 * 05070020 B0 EQU 0 BYTE COUNT OF 0 S20201 05075020 B1 EQU 1 BYTE COUNT OF 1 S20201 05080020 B3 EQU 3 BYTE COUNT OF 3 S20201 05085020 B8 EQU 8 BYTE COUNT OF 8 S20201 05090020 B16 EQU 16 BYTE COUNT OF 16 S20201 05095020 * 05100020 RRRDNOP EQU 64 RCD READYS READ NOP S20201 05105020 * OFFSET S20201 05110020 * 05115020 * 05120000 * 05140000 BALR RBASE,0 REG 3 IS BASE 05160000 USING SOPA,RBASE ESTABLISH BASE REGISTER 05180000 USING IHADCB,RDCB REG 2 IS DCB 05200000 USING CVT,RTIOT REG 9 IS COMM UECT TABLE 05220000 USING FORCORE,RCORE REG 4 IS WORK AREA ADDR 05240000 USING BLDEB,RDEB REG 11 IS DEB 05260000 * 05280000 * 05300000 SOPA EQU * FOR ADDRESSABILITY 05320000 * 05340000 * 05360000 L RDCB,0(RPARC) GET DCB ADDRESS 05380000 LA RDCB,0(RDCB) CLEAR HI BYTE 05400000 L RCORE,4(RWTGC) GET WORK AREA ADDRESS 05420000 * 05440000 SR RC,RC READY A WORK REG 05460000 SR RDEB,RDEB 05480000 * 05500000 * 05520000 * 05580000 ST RC,DCBCNTRL 05600000 SR RTIOT,RTIOT 05620000 IC RTIOT,DCBNCP GET NUMBER OF ICBS TO BUILD 05640000 * 05660000 * 06000000 SOPA003 EQU * 06020000 * 06040000 LA RF,64 CONSTANT SIZE FOR ICB & CP. 06060000 * 06062020 * CHECK FOR RCD READY AND IF TO BE USED INCR ICB SIZE 06064020 * 06066020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06068020 * READY S20201 06070020 BO SOPA03A BRANCH IF YES S20201 06072020 LA RF,B8(RF) INCR ICB SIZE S20201 06074020 SOPA03A EQU * S20201 06076020 MVI DCBCNTRL+3,2 STORE INDEX FACTOR FOR PCI EOB 06080000 TM DCBMACRF,POINTB NOTE/POINT TO BE USED 06100000 BC 8,SOPA007 NO BRANCH 06120000 * 06140000 SOPA005 EQU * 06160000 * 06180000 MVI DCBCNTRL+1,5 STORE INDEX FOR NOTE-POINT ID 06200000 * 06220000 SOPA007 EQU * 06240000 * 06260000 TM DCBCIND2,QSAMB IS QSAM BEING USED 06280000 BC 8,SOPA009 NO BRANCH 06300000 * 06320000 IC RTIOT,DCBBUFNO GET NO. OF ICBS TO GENERATE 06340000 SOPA009 EQU * 06360000 * 06380000 LTR RTIOT,RTIOT HAS NO OF CPS BEEN SPECIFIED 06400000 BC 8,NOPCI N O BRANCH 06420000 CH RTIOT,CONONE DOES BUFFER NO = 1 06440000 * 06460000 BC 8,NOPCI YES BRAN CH 06480000 * 06500000 * 06520000 SOPA011 EQU * 06540000 * 06560000 LR RE,RF COPY ICB SIZE 06580000 SRL RE,3 DIVIDE BY EIGHT 06600000 STC RE,DCBIOBL SAVE FOR CLOSE 06620000 LR RE,RTIOT PREPARE TO COMPUTE SPACE REQ. 06640000 MR RE,RE NO. ICBS BY THEIR SIZE 06660000 LA RF,80(RF) ADD SPACE FOR MAIN IOB 06680000 * 06682020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06684020 * READY S20201 06686020 BO SOPA11A BRANCH IF YES S20201 06688020 LA RF,B16(RF) INCR MAIN IOB FOR SET S20201 06690020 * SECTS S20201 06692020 * AND THETA VALUES 06694020 SOPA11A EQU * S20201 06696020 * 06698020 LR RB,RF SAVE FOR CLEARING RT. 06700000 * 06720000 ********************************************************************** 06740000 * 06760000 GETMAIN R,LV=(RF),SP=250 06780000 * 06800000 * 06820000 ********************************************************************** 06840000 * 06845020 * OBTAIN AND TEMP SAVE THETA ADDRS MAY BE USED LATER 06850020 * 06855020 LR RJ,RB GET AREA LENGTH S20201 06860020 AR RJ,RF OBTAIN LAST AREA+1 ADDR S20201 06865020 LA RE,B8 CONSTANT S20201 06870020 SR RJ,RE BACK UP ONE DW S20201 06875020 ST RJ,DXCCW11 TEMP STORE SET SECTORS S20201 06880020 * THETA ADDR 06885020 LA RJ,B1(RJ) OBTAIN RD SECTORS S20201 06890020 ST RJ,DXCCW12 TEMP STORE S20201 06895020 * 06900020 * 06905020 ********************************************************************** 06920000 ** 06940000 * THIS SECTION CLEARS THE SPACE RECIEVED FROM GETMAIN 06960000 ** 06980000 * 07000000 LR RJ,RB RESTORE LENGTH TO CLEAR 07020000 ST RF,DCBIOBAD STORE MAIN IOB ADDRESS 07040000 BCTR RJ,0 REDUCE AMT BT ONE 07060000 LA RB,255 GET MAX AMT CAN CLEAR 07080000 COMPARE CR RJ,RB IS AMT TO CLEAR GREATER 255 07100000 BC 12,ONECLEAR NO BRANCH 07120000 * 07140000 EX RB,CLEAR CLEAR 256 BYTES 07160000 SR RJ,RB SUBT 255 FROM AMT TO BE CLEARED 07180000 BCTR RJ,0 SUBT ONE MORE BYTE 07200000 LA RF,256(RF) UPDATE AREA ADDR BY 256 07220000 B COMPARE 07240000 * 07260000 CLEAR XC 0(1,RF),0(RF) ACTUAL CLEAR INSTRUCTION 07280000 * 07300000 ONECLEAR EX RJ,CLEAR CLEARS LESS THAN 256 07320000 * 07340000 * 07360000 * 07380000 L RB,DCBIOBAD GET MAIN IOB ADDRESS 07400000 LR RC,RB SET UP WORK REG 07420000 LR RD,RB SET UP WORK REG 07440000 * 07460000 * 07480000 * THIS SECTION OF CODE WILL BUILD THE MAIN IOB & CHANNEL PROGRAM 07500000 * 07520000 SOPA013 EQU * 07540000 * 07560000 LA RUCB,80(RB) POINT TO FIRST ICB 07580000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 07583020 * READY S20201 07586020 BO SOPA13AX BRANCH IF YES S20201 07589020 LA RUCB,B8(RUCB) INCR FOR RD SECTOR S20201 07592020 SOPA13AX EQU * S20201 07595020 ST RUCB,8(RB) STORE IN MAIN IOB 07600000 LA RD,4(RB) POINT TO ECB IN MAIN IOB 07620000 * 07640000 MVI 0(RD),X'7F' POST MAINIOB COMPLETE 07660000 * 07680000 LA RF,56(RB) POINT TO CP START ADDRESS 07700000 STM RD,RDCB,20(RB) STORE ECBAD,CP.AD,DCBAD 07720000 MVC 48(8,RB),DCBFDAD MOVE D.A. ADDRESS TO MAIN IOB 07740000 LA RUCB,51(RB) POINT TO CCHHR IN MAIN IOB 07760000 * 07761020 * CHECK FOR RCD READY AND IF USED BUILD SET SECTOR 07762020 * 07763020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 07764020 * READY S20201 07765020 BO SOPA13A BRANCH IF YES S20201 07766020 L RDEB,DXCCW11 GET SET SECTOR ADDR S20201 07767020 ST RDEB,D0(RF) PUT IN CCW S20201 07768020 MVI D0(RF),SETSC PUT SET SECT CCW CMND S20201 07769020 OI D4(RF),CC TURN ON CMND CHAIN S20201 07770020 MVI D7(RF),B1 BYTE CNT EQS ONE S20201 07771020 LA RB,B8(RB) INCREMENT BY EIGHT S20201 07772020 SOPA13A EQU * S20201 07773020 * 07774020 ST RUCB,56(RB) STORE IN SRCH CCW 07780000 MVI 56(RB),SRCHE STORE SRCH EQUAL CMD BYTE 07800000 LA RUCB,56(RB) POINT TO SRCH CCW 07820000 ST RUCB,64(RB) STORE IN TIC CCW 07840000 MVC 60(5,RB),SCCWCNST STORE CC FLG,LEN = 5 ,TIC OP 07860000 * IN TIC 07875018 * 07880000 * 07900000 SOPA015 EQU * 07920000 * 07940000 MVI 72(RB),TIC STORE TIC CMD BYTE 07960000 * 07980000 * 08000000 LA RB,80(RB) POINT TO FIRST ICB 08020000 ST RB,DCBIOBA STORE ICB ADDRESS 08040000 LR RC,RB COPY ICB ADDRESS 08060000 * 08080000 * 08100000 ICBLOOP EQU * 08120000 * 08140000 * 08160000 LTR RTIOT,RTIOT HAVE ALL ICBS BEEN GENERAED 08180000 BC 8,SOPAEND YES BRANCH 08200000 * 08220000 * 08240000 ************** CONSTRUCTION OF ICB & CP COMMENCE ********************** 08260000 * 08280000 * 08300000 ST RC,0(RB) STORE NEXT ICBAD IN LINK FLD. 08320000 LR RB,RC UPDATE TO NEXT ICB 08340000 LA RC,4(RB) POINT TO ECB IN ICB 08360000 ST RC,12(RB) STORE ECB ADDRESS IN ICB 08380000 MVI 4(RB),X'7F' POST ECB COMPLETE FOR NOW 08400000 LA RC,D40(RB) GET ICB CHP ADDR S20201 08420020 ST RC,24(RB) STORE CP ADDRESS IN ICB 08440000 MVC 32(8,RB),DCBFDAD STORE D.A. ADDRESS IN ICB 08460000 * 08480000 * 08500000 * NOTE THAT THE DCB ADDRESS IS NOT STORED IN THE ICB 08520000 * 08540000 * 08560000 * 08620000 * 08640000 SOPA017 EQU * 08660000 * 08680000 * 08700000 SOPA019 EQU * 08720000 * 08740000 MVI DCBOFFSR,48 STORE READ DATA CCW OFFSET 08760000 L RUCB,DCBIOBAD 08780000 MVI 2(RUCB),56 STORE READ NOP OFFSET 08800000 LA RE,99(RB) POINT TO NEXT ICBS CCHHR FLD 08820000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 08822020 * READY S20201 08824020 BO SOPA19A BRANCH IF YES S20201 08826020 LA RDEB,B8 CONSTANT S20201 08828020 AR RE,RDEB INCR CCHHR PTR FOR RD S20201 08830020 * SECT S20201 08832020 SOPA19A EQU * S20201 08834020 * 08836020 ST RE,40(RB) STORE IN THE CURR RD CNT CCW 08840000 MVI 40(RB),RDC STORE READ CMD BYTE (COUNT) 08860000 MVC 44(4,RB),CCWCNSTS STORE PCI,CC,SILI FLGSAND LEN 08880000 MVI 48(RB),RDD STORE READ DATA CMD BYTE 08900000 OI 52(RB),SLICC TURN ON SILI AND CC FLAGS 08920000 TM DCBRECFM,X'C0' U TYPE RECORDS 08940000 BC 9,SOPA020A YES BRANCH 08960000 * 08980000 TM DCBRECFM,X'40' V RECORDS 09000000 BC 1,SOPA020A YES BRANCH 09020000 * 09040000 * 09060000 SOPA020 EQU * 09080000 * 09100000 NI 52(RB),X'DF' TURN SILI FLAG OFF 09120000 * 09140000 SOPA020A EQU * 09160000 * 09180000 * 09200000 TM DCBCIND2,QSAMB DCB USING QSAM 09220000 BC 8,SOPA021 NO BRANCH 09240000 * 09260000 LA RUCB,48(RB) POINT TO READ DATA CCW 09280000 BAL RJ,QSAMBRT GO TO FILL IN BUFAD & LENGTH 09300000 * 09320000 * 09340000 B ICBCOMPT 09360000 * 09380000 SOPA021 EQU * 09400000 * 09420000 SR RE,RE 09440000 IC RE,DCBKEYLE GET KEY LEN IF SPECIFIED 09460000 LTR RE,RE ARE KEYS SPECIFIED ? 09480000 BC 8,ICBCOMPT NO BRANCH 09500000 MVI 48(RB),RDKD STORE READ KEY&DATA CMD BYTE 09520000 * 09540000 ICBCOMPT EQU * 09560000 * 09580000 LA RD,56(RB) POINT TO NOP CCW 09600000 LA RC,64(RB) POINT TO NEXT POSSIBLE ICB 09620000 * 09640000 SOPA023 EQU * 09660000 * 09680000 ICBCOMON EQU * 09700000 * 09708020 * CHECK FOR RCD READY AND IF USED BUILD RD SECTOR 09716020 * 09724020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 09732020 * READY S20201 09740020 BO SOPA023A BRANCH IF YES S20201 09748020 LA RC,B8(RC) INCR ICB PTR S20201 09756020 SOPA023A EQU * S20201 09764020 LA RUCB,D40(RC) PT TO NEXT ICBS CP S20201 09774020 * 09800000 * 09820000 ST RUCB,0(RD) STORE NEXT CP ADDR IN NOP CCW 09840000 MVI 0(RD),NOP STORE NOP CMD BYTE 09860000 OI 4(RD),X'20' SET SILI ON IN CCW 09880000 MVI 7(RD),ONE STORE LENGTH IN CCW 09900000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 09904020 * READY S20201 09908020 BO SOPA023D BRANCH IF YES S20201 09912020 L RUCB,DXCCW12 GET RD SECTOR ADDR S20201 09916020 ST RUCB,D8(RD) PUT IN CCW S20201 09920020 MVI D8(RD),RDSC PUT IN RD SECT CMND S20201 09924020 MVI D15(RD),B1 SET BYTE CNT TO ONE S20201 09928020 MVC D5(B3,RD),D1(RD) MOVE ICB ADDR TO RH OF S20201 09932020 * CCW S20201 09936020 LA RUCB,D8(RD) GET PTR TO RD SECT S20201 09940020 ST RUCB,D0(RD) PUT IN PREV CCW S20201 09944020 MVI D0(RD),TICNOP CHANGE CMND TO TIC S20201 09948020 SOPA023D EQU * S20201 09952020 * 09956020 * AT THIS POINT A COMPLETE ICB AND CHANNEL PROGRAM IS GENERATED 09960000 * 09980000 * 10000000 * 10020000 BCTR RTIOT,0 DECREMENT ICB COUNTER 10040000 B ICBLOOP REPEAT ICB LOOP 10060000 * 10080000 *********************************************************************** 10100000 * 11780000 * 11800000 * 11820000 SOPAEND EQU * 11840000 * 11860000 * 11920000 * 11940000 OI DCBCIND2,X'04' SET PCI INDICATOR 11960000 L RUCB,DCBIOBA GET FIRST ICB GENERATED 11980000 ST RUCB,0(RB) TIE LAST ICB TO FIRST 12000000 LA RDEB,D40(RUCB) GET FRST ICB CHP ADDR S20201 12004020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 12008020 * READY S20201 12012020 BO SOPAXX BRANCH IF YES S20201 12016020 ST RDEB,D4(RD) PUT FIRST ICB CHP ADDR S20201 12020020 * IN S20201 12024020 * RH OF TIC 12028020 B SOPAXZ GO AROUND NEXT S20201 12032020 SOPAXX EQU * S20201 12036020 * 12040000 ST RDEB,0(RD) STORE IN NOP CCW OF LAST ICB 12060000 MVI 0(RD),NOP STORE NOP CMD BYTE 12080000 SOPAXZ EQU * S20201 12090020 * 12140000 LA RDEB,35(RUCB) POINT TO FIRST ICBS CCHHR FLD 12160000 ST RDEB,40(RB) STORE IN RD COUNT CCW 12180000 MVI 40(RB),RDC STORE READ CNT CMD BYTE 12200000 * 12220000 SOPAEND1 EQU * 12240000 * 12260000 TM DCBDSORG,PAM DCB USING PAM 12280000 BC 8,SOPAEND2 NO BRANCH 12300000 * 12320000 MVI DCBCNTRL+1,5 STORE INDEX FOR NOTE-POINT ID 12340000 SOPAEND2 EQU * 12360000 * 12380000 * 12400000 SOPAEND3 EQU * 12420000 * 12440000 L RB,DCBIOBA GET FIRST ICB 12460000 SR RC,RC 12480000 L RUCB,DCBIOBAD 12500000 IC RC,2(RUCB) GET INPUT NOP OFFSET 12520000 * 12600000 NO EQU * 12620000 * 12640000 AR RC,RB POIMT TO NOP CCW 12660000 * 12680000 ST RC,12(RUCB) NOP ADDRESS IN MAIN IOB 12700000 MVC 32(8,RB),DCBFDAD STORE MBBCCHHR IN ICB 12720000 L RB,0(RB) SPECIAL CONSIDERATIONS 12740000 MVC 32(8,RB),DCBFDAD STORE MBBCCHHR IN ICB 12760000 * 12780000 * 12800000 *********************************************************************** 12820000 * 12840000 * 12860000 * 12880000 * SELECT 3RD STAGE EXECUTOR 12884019 TM DCBRECFM,FORMATVS VARIABLE/SPANNED TEST A28683 12888019 BO UTEST POSSIBLE VS A28683 12892019 LOAD13 MVC 0(5,RWTGC),SOPSLDFT GET NON-SPAN LOAD EXEC A28683 12896019 B RELOOP A28683 12900019 UTEST TM DCBRECFM,FORMATU UNDEFINED TEST A28683 12904019 BO LOAD13 NOT VS A28683 12908019 MVC 0(5,RWTGC),SOP3 GET SPAN LOAD EXEC A28683 12912019 * 12920000 RELOOP LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURR WTG ENTRY 12940000 LA RPARC,PLOFF(0,RPARC) INCR CURRENT DCB ENTRY PRTR 12960000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 12980000 BCR 8,RBASE 13000000 * 13020000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 13040000 BC 7,RELOOP NO,CHECK NEXT ENTRY 13060000 * 13080000 LR RPARC,RPAR 13100000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE WTG LIST PTR 13120000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 13140000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 13160000 * 13180000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 13200000 LA RPARC,PLOFF(0,RPARC) 13220000 BC 15,ZCHEK 13240000 * 13260000 TCTLRTN EQU * 13280000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 13300000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 13320000 * 13340000 * 13360000 ******************************************************************** 13380000 * 13400000 USING FORCORE,RCORE 13420000 LA 15,DXXCTL SET UP FOR XCTL S21042 13440021 ** 13460000 XCTL DE=(RWTG),SF=(E,(15)) 13480000 ** 13500000 * 13520000 ********************************************************************* 13540000 * 13560000 * 13580000 * THIS SECTION OF CODE FILLS IN RD/WRT CCW WITH BUFFER AND LENGTH 13600000 * 13620000 *********************************************************************** 13640000 * 13660000 QSAMBRT EQU * 13680000 * 13700000 L RD,DCBBUFCB GET BUFFER POOL CNTRL BLK ADDR 13720000 L RC,0(RD) GET BUFFER FROM POOL 13740000 LTR RC,RC IS THERE A BUFFER AVAILABLE 13760000 BC 8,ABEND NO ABEND BAD DCB SPECIFICATION 13780000 * 13800000 MVC 1(3,RUCB),1(RD) STORE DATA ADDRESS IN CCW 13820000 * 13840000 MVC 1(3,RD),1(RC) UPDATE BUFFER POOL CNTRLBLOCK 13860000 * 13880000 MVC 6(2,RUCB),DCBBLKSI STORE BLOCK SIZE IN CCW 13900000 * 13920000 BR RJ 13940000 * 13960000 * 13980000 * 14000000 ********************************************************************* 14020000 * 14040000 ABEND EQU * 14060000 DMABCOND OABD065,PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X14080021 CALL PROBLEM DETERMINATION 14100021 B TCTLRTN S21042 14120021 * 14160000 * 14180000 *********************************************************************** 14200000 * 14220000 * 14240000 NOPCI EQU * 14260000 * 14280000 MVC 0(5,RWTGC),SOP2 MUST GO TO NON PCI EXECUTOR 14300000 B RELOOP 14320000 * 14340000 * 14360000 * 14380000 ********************************************************************** 14400000 * * 14420000 WAOFF EQU 32 14440000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 14460000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 14480000 AMIDCNST DC C'1K' 14500000 OPIDCNST DC C'0S' 14520000 * 14540000 *********************************************************************** 14560000 * CONSTANTS AND RESERVED STORAGE. 14580000 * 14600000 * 14620000 SXTEN DC H'16' 14640000 CONONE DC H'1' 14660000 * 14680000 * 14700000 * 14720000 * 14740000 CCWCNSTS DC X'68000005' 14760000 WCCWCNST DC X'A8000008' 14780000 RCCWCNST DC X'50000001' 14800000 SCCWCNST DC X'4000000508' 14820000 PCIOFST DC X'28' 14840000 DC X'05' NUMBER OF DBL WRDS IN CP 14860000 DC X'00' READ CCW OFFSET 14880000 DC X'40' WRITE CCW OFFSET 14900000 * 14920000 * 14940000 * 14960000 *********************************************************************** 14980000 XCTLTABL ID=(SOPSLDFT,13,SOP3,16,SOP2,1D,PDLOAD,6M), S21042,14986021 SVC=019 S21042 14992021 * 15000000 * 15020000 * 15040000 * 15060000 * 15080000 * 15100000 * 15120000 * 15140000 * 15160000 * 15180000 * 15200000 * 15360000 * 15380000 DCBD DSORG=PS 15400000 CVT DSECT 15420000 CVT 15440000 * 15460000 * 15480000 * DATA EXTENT BLOCK 15500000 CNOP 0,4 15520000 BLDEB DSECT 15540000 DEBNMSUB DS 0CL1 15560000 DEBTCBAD DS CL4 15580000 DEBAMLNG DS 0CL1 15600000 DEBDEBAD DS CL4 15620000 DEBOFLGS DS 0CL1 15640000 DEBIRBAD DS CL4 15660000 DEBOPATB DS 0CL1 15680000 DEBSYSPG DS CL4 15700000 DEBNMEXT DS 0CL1 15720000 DEBUSRPG DS CL4 15740000 DEBPRIOR DS 0CL1 15760000 DEBECBAD DS CL4 15780000 DEBPROTG DS 0CL1 15800000 DEBDEBID DS 0CL1 15820000 DEBDCBAD DS CL4 15840000 DEBEXSCL DS 0CL1 15860000 DEBAPPAD DS CL4 15880000 DEBDVMOD DS 0CL1 15900000 DEBUCBAD DS CL4 15920000 DEBBINUM DS CL2 15940000 DEBSTRCC DS CL2 15960000 DEBSTRHH DS CL2 15980000 DEBENDCC DS CL2 16000000 DEBENDHH DS CL2 16020000 DEBNMTRK DS CL2 16040000 TITLE 'FORMAT OF GOTTEN CORE' 16060000 * 16080000 * 16100000 IECDSECS MAIN,EXPAND=YES S21042 16130021 END 16160000 ./ ADD SSI=04010302,NAME=IGG0191N,SOURCE=0 TITLE 'IGG0191N-DEB CONSTRUCTION FOR D.A.DEVICE EXTENTS' 00100000 COPY LCGASMSW Y01021 00110000 IGG0191N CSECT 00120021 * 00130021 * RELEASE 19 DELETIONS 00200002 *1020304000-305000,317000-318000 A25961 00210019 * RELEASE 20 DELETIONS 00220000 *0973329000 A33681 00230020 *0973328400,328800,329200,329600 M1055 00235020 * RELEASE 21 DELETIONS 00240000 * 297000-299600 A50696 00240421 *2880 A43880 00242021 *2880 A43880 00245021 *2880 A39782 00250021 *D001400-001980,002600-002800,003200,011000-012000,152000, SA54462 00250121 *D417000-424200,425800-428000,513000 SA54462 00250221 * 00252203 AIF ('&LIB' EQ 'LIB1').APF010 XL03048 00252503 * VS1 RELEASE 030 DELETIONS XL03048 00260203 * XL03048 00260503 * XM4887 00260603 .APF010 ANOP XL03048 00260803 * VS1 RELEASE 2.0 DELETIONS 00261200 * APAR OX02093 IS EQUIVALENT TO OS62806 AND OY02027. XA02093 00262200 *A328500,329000 XA02093 00270200 *C329500 XA02093 00280200 * XL03048 00300003 *STATUS CHANGE LEVEL 007 XL03048 00360003 * 00400000 * FUNCTION - THIS EXECUTOR IS ENTERED FOR USERS OF SAM AND EXCP DURING 00500021 * OPEN FOR THE CONSTRUCTION OF DEBS. THIS EXEC SUPPLEMENTS 00600021 * IGG0191A BY BUILDING THE EXTENT PORTION (DEVICE DEPENDENT 00700021 * SECTION) FOR DIRECT ACCESS DEVICES. 00800021 * 00900000 * ENTRY POINT - IGG0191N (ENTERED FROM IGG0191A VIA XCTL) 01000021 * 01300000 * INPUT - DCB ADDRESS 01400021 * WORK AREA ADDRESS 01500000 * WHERE TO GO TABLE 01600000 * PARAMETER LIST 01700000 * CURRENT ENTRY IN WHERE TO GO TABLE 01800000 * CURRENT PARAMETER (DCB) 01900000 * 02000000 * OUTPUT- DA EXTENT SECTION AS OUTLINED BELOW. 02100021 * 02200000 * 02300000 * BASIC DEB LAYOUT FOR ALL I/O DEVICES SUPPORTED 02400000 * 02500000 * ********************************** 02600000 * -16 *I/OS* I/O SUPPORT DCB ADDRESS * 02700000 * -12 * * RESERVED * 02800000 * -08 * * DCB MODIF MASK * 02900000 * -04 *DEBL* * 03000000 * +00 *SUBL* TCB ADDRESS * 03100000 * +04 *AML * DEB LINK FIELD * 03200000 * +08 *DPAT* IRB ADDRESS * 03300000 * +12 *FLTP* SYSTEM PUTGE CHAIN * 03400000 * +16 *NEXT* USER PURGE CHAIN * 03500000 * +20 *PRTY* ECB ADDRESS * 03600000 * +24 *KEYD* DCB ADDRESS * 03700000 * +28 *SCAL* APPENDAGE ADDRESS * 03800000 * ********************************** 03900000 * 04000000 * 04100000 * DEVICE DEPENDENT SECTION OF DEB 04200000 * 04300000 * TAPE/URE 04400000 * 04500000 * 04600000 * ********************************** 04700000 * +32 *DMOD* UCB ADDRESS * 04800000 * +36 *VOL SEQ NO *NO. OF VOLS. * 04900000 * ********************************** 05000000 * 05100000 * 05200000 * FOLLOWING ARE DA EXTENTS BUILT BY THIS EXEC. 05300000 * 05400000 * D.A.SAM DEB. 05500000 * ********************************** 05600000 * +32 *FMSK* UCB ADDRESS * 05700000 * +36 *EXTENT FIELD BBCCHHCCHH * 05800000 * +40 * * 05900000 * +44 * *NO.TRACKS ALL. * 06000000 * +48 *VOL SEQ NO *NO. OF VOLS * 06100000 * ********************************** 06200000 * 06300000 * 06400000 * NOTE.+32 - +44 IS REPEATED PER EXTENT 06500000 * 06600000 * 06700000 * D.A.TO MEMBER FOR OUTPUT 06800000 * ********************************** 06900000 * +E2 *MEMBER NAME THAT IS OPENING * 07000000 * +56 *MEMBER NAME THAT IS OPENING * 07100000 * ********************************** 07200000 * 07300000 * 07400000 * DA BPAM CONCATENATION (INPUT) 07500000 * ********************************** 07600000 * +48 *DSNO DSNO DSNO DSNO * 07700000 * *EXTU EXT2 EXT3 EXT4 * 07800000 * ********************************** 07900000 * 08000000 * 08100000 * NOTES- BPAM DEB SAME AS SAM DEB WITH EXCLUSSION OF FIELD AT +48 08200021 * 08300000 * USER LABEL EXTENT IS NOT INCLUDED IN F1 EXTENT COUNT 08330018 * AND IS NOT INCLUDED IN DEB EXTENTS. 08360018 * 08400000 * ROUTINE ALSO MERGES CLASS BYTE AND DEVICE BYTE OF UCB/SRT 08500000 * INTO DCB FIELD (DEVT) 08600000 * 08700000 * EXITS NORMAL - XCTL TO IGG0191B SAM MAIN EXECUTOR 08800021 * 08810021 * EXITS ERROR - NONE 08900021 * 09000000 * TABLES/WORKAREA - SEE DSECTS AT END OF LISTING. 09100021 * 09200000 * ATTRIBUTES - REENTRANT,REUSABLE,SUPERVISOR MODE 09300021 * 09400000 * 09500000 * 09600000 * 09700000 ******************************************************************* 09800000 ********************************************************************* 09900000 * 10000000 * MASK'S TO TEST PARAMETER LIST WITH 10100000 DESZEM1 EQU 143 10200000 DESZE EQU 144 10300000 OFFSET EQU 4 10400000 OPIECAPP EQU 20 10500000 OPMDEBID EQU X'0F' 10600000 OPPATRUB EQU 0 10700000 OPMEXSCL EQU 4 10800000 OPMINPUT EQU X'7F' 10900000 OPMDEVT EQU X'40' 11000000 DEBBSLNG EQU 80 11100000 COMMUTAB EQU 16 11200000 UCBDTYPE EQU 5 11300000 SRTOUCBA EQU 0 11400000 NEXTCORE EQU 140 11500000 DUALDEN EQU X'20' 11600000 READB EQU X'20' 11700000 WRITEB EQU X'20' 11800000 ULEXTYP EQU X'40' EXTENT TYPE INDICATOR FOR USER LABEL TRACK UL17 11850000 INMASK EQU X'0E' MASK FOR INPUT TEST UT18 11858018 POTEST EQU X'02' MASK FOR PO DATA SET UT18 11866018 TOTMASK EQU X'02' MASK FOR TOTALING TEST UT18 11874018 HEX08 EQU X'08' PARAMETRIC VALUES OF 8 UT18 11882018 ZERO EQU 0 PARAMETRIC VALUE OF 0 UT18 11890018 ONE EQU 1 CONSTANT OF 1 A50696 11890421 XNTOFSET EQU 6 OFFSET TO EXTENT IN DSCB A43880 11891021 EIGHT EQU 8 8 BYTES A43880 11892021 AIF ('&LIB' EQ 'LIB1').APF006 XL03048 11892303 ADDRLN EQU B'0111' 24 BIT ADDRESS MASK XL03048 11894003 DEBAPFIN EQU X'02' AUTH USER FLAG IN DEB XL03048 11896003 .APF006 ANOP XL03048 11896303 * 11900000 ****************************** ****************************** 12000000 * 12100000 * 12200000 * 12300000 * 12400000 * 12500000 *REGISTERS ARE REFERENCED SYMBOLICALLY WHERE APPROPRIATE 12600000 * 12700000 RDCB EQU 2 DCB REGISTER 12800000 RBASE EQU 3 BASE REGISTER 12900000 RCORE EQU 4 WORK AREA ADDRESS 13000000 RPAR EQU 5 TOP OF PARAMETER LIST 13100000 RWTG EQU 6 TOP OF WTG TABLE 13200000 RPARC EQU 7 CURRENT PARAMETER 13300000 RWTGC EQU 8 CURRENT TRANS LOAD 13400000 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECTOR ADDR. 13500000 RUCB EQU 10 USED HERE AS A COUNTER IN IOB GENERATION 13600000 RDEB EQU 11 DEB ADDRESS 13700000 RB EQU 12 WORK REG1 ** 13800000 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 13900000 RD EQU 14 WORK REG3 ** 14000000 RJ EQU 15 WORK REG4 14100000 RE EQU 0 WORK REG5 14200000 RF EQU 1 WORK REG6 14300000 * 14400000 * 14500000 * 14600000 *********************************************************************** 14700000 * 14800000 * 14900000 * 15000000 * 15100000 * 15300000 BALR RBASE,0 15400000 USING PO,RBASE 15500000 USING IHADCB,RDCB 15600000 USING FORCORE,RCORE 15700000 USING DEB,RDEB 15800000 USING TCB,RD 15900000 USING TIOT,RTIOT 16000000 USING UCBOB,RUCB 16100000 * 16200000 * 16300000 * 16400000 * 16500000 PO EQU * 16600000 * 16700000 L RDCB,0(RPARC) GET DCB ADDRESS 16800000 L RCORE,4(RWTGC) GET WORK AREA 16900000 L RD,COMMUTAB CALCULATE TCB ADDRESS 17000000 L RD,0(0,RD) 17100000 L RD,4(0,RD) TCB ADDR 17200000 L RTIOT,TCBTIO 17300000 AH RTIOT,DCBTIOT RESET TIOT POINTER 17400000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 17450001 L RDEB,DCBDEBAD 17500000 .DEBCK10 ANOP Y01021 17550000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 17560000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 17570000 TM DSCFILTY,POTEST IS DATA SET PO XL03048 17570303 BZ OBPAM150 NO, BRANCH XL03048 17570603 OI DEBFLGS1,DEBAPFIN ASSUME AUTHORIZED USER XL03048 17570903 OBPAM150 EQU * XL03048 17571203 .DEBCK20 ANOP Y01021 17580000 SR RC,RC 17600000 IC RC,DEBNMEXT 17700000 * 17800000 * EXTENTS 17900000 * 18000000 LR RB,RC NO OF EXTENTS 18100000 SLL RB,4 18200000 LA RB,32(RDEB,RB) POINT TO ACCESS METHOD SECTION 18300000 * 18400000 LA RJ,DEBUCBAD FIRST DEB EXTENT 18500000 LR RDCB,RCORE 18600000 SH RDCB,OBPAMK44 FIRST DSCB 18700000 LR RDEB,RDCB SAVE CURRENT DSCB ADDR 18800000 SR RF,RF START M COUNTER WITH ZERO 18900000 SR RD,RD 19000000 ST RD,DXCCW4 SET TOTAL TT CTR TO ZERO 19100000 * 19200000 OBPAM180 EQU * 19300000 * 2321 SUPPORT HERE. 19400000 STH RD,4(0,RJ) ZERO THE BB FIELD. 19500000 L RUCB,TIOEFSRT GET UCB PTR- WILL BE A SUB-UCB 19600000 * IF DEVICE IS 2321 19700000 AIF ('&LIB' EQ 'LIB1').APF001 XL03048 19700303 TM DSCFILTY,POTEST IS DATA SET PO XL03048 19700603 BZ OBPAM186 NO, BRANCH XL03048 19700903 L RD,COMMUTAB GET CVT ADDRESS XL03048 19701203 USING CVTMAP,RD XL03048 19701503 L RD,CVTAUTHL GET ALT ADDRESS XL03048 19701803 DROP RD XL03048 19702103 LTR RD,RD IS THERE AN ALT XL03048 19702403 BZ OBPAM186 NO, BRANCH XL03048 19702703 USING ALTABLE,RD XL03048 19703003 STM RPAR,RWTGC,DXCCW5 SAVE REGS XL03048 19703303 L RWTG,DXPDEBAD GET ADDRESS OF DEB XL03048 19704503 DROP RDEB XL03048 19704603 USING DEB,RWTG XL03048 19705103 SR RWTGC,RWTGC ZERO LOOP CONTROL REG XL03048 19705703 IC RWTGC,ALTNOENT GET NUMBER OF ENTRIES XL03048 19706003 LA RD,ALTENT BUMP TO FIRST ENTRY XL03048 19706303 DROP RD XL03048 19706603 USING ALTENTRY,RD XL03048 19706903 SR RPAR,RPAR ZERO ENTRY LENGTH REG XL03048 19707203 OBPAM182 EQU * XL03048 19707503 IC RPAR,ALTLNENT GET LN OF VOLID + DSNAME XL03048 19707803 CLC ALTVOLID,UCBVOLI ALT VOLID EQ UCB VOLID XL03048 19708103 BNE OBPAM183 NO, BRANCH XL03048 19708403 SH RPAR,DSNOFFST GET DSNAME LENGTH - 1 XL03048 19708703 ICM RPARC,ADDRLN,TIOEJFCB GET JFCB ADDR XL03048 19709003 EX RPAR,CLCINST ALT DSNAME EQ JFCB DSNAMEXL03048 19709303 BE OBPAM185 YES, BRANCH XL03048 19709603 AH RPAR,DSNOFFST RESET ENTRY LENGTH XL03048 19709903 OBPAM183 EQU * XL03048 19710203 LA RD,L'ALTLNENT(RPAR,RD) BUMP TO NEXT ENTRY XL03048 19710503 BCT RWTGC,OBPAM182 BRANCH IF MORE ENTRIES XL03048 19710803 NI DEBFLGS1,X'FF'-DEBAPFIN SET OFF AUTH USER FLAG XL03048 19711703 OBPAM185 EQU * XL03048 19712003 LM RPAR,RWTGC,DXCCW5 RESTORE REGS XL03048 19712303 DROP RWTG XL03048 19712903 USING DEB,RDEB XL03048 19713503 OBPAM186 EQU * XL03048 19713803 .APF001 ANOP XL03048 19714103 AIF ('&LIB' NE 'LIB1').APF002 XL03048 19714403 CLI UCBID,X'FF' CHECK FOR MAIN UCB ID. 19800000 BE BBOK BRANCH IF NO SUB-UCB. 19900000 USING DATACELL,RUCB 20000000 * MOVE BB TO CURRENT EXTENT, THEN CALCULATE MAIN UCB ADDRESS AND STORE. 20100000 LH RD,DCELBBNR PICK UP BB. 20200000 STH RD,4(0,RJ) PUT IN CURRENT EXTENT. 20300000 SLL RD,4 TIMES 16. 20400000 LA RD,DATACELL-UCBOB(RD) 16(BB)+MAIN UCB LENGTH. 20500000 SR RUCB,RD RUCB=MAIN UCB ADDRESS. 20600000 BBOK EQU * 20700000 USING UCBOB,RUCB 20800000 .APF002 ANOP XL03048 20800303 ST RUCB,0(0,RJ) MAIN UCB PTR IN CURRENT EXTENT. 20900000 SR RD,RD 21000000 IC RD,59(0,RDCB) GET NO OF EXTENT ON THIS DS 21100000 LA RDCB,105(0,RDCB) POINT TO 1ST EXTENT ENTRY UL17 21110000 LA RUCB,3 MAX OF 3 EXTENTS UL17 21120000 CLI 0(RDCB),ULEXTYP CHECK,BR IF 1ST EXTENT NOT UL17 21130000 BC 7,OBPAM187 A USER LABEL TRACK UL17 21140000 LA RDCB,10(0,RDCB) POINT TO 2ND EXTENT ENTRY UL17 21150000 BCTR RUCB,0 DEC MAX NO EXTENTS LEFT UL17 21160000 OBPAM187 EQU * UL17 21180000 LTR RD,RD CHECK FOR ZERO 21200000 BC 7,OBPAM190 NO BRANCH 21300000 * 21400000 LA RD,1 TO FORM DUMMY EXTENT 21500000 OBPAM190 EQU * 21600000 * 21700000 TM 0(RPARC),X'0F' CK FOR INPUT 21900000 BC 8,OBPAM200 BR IF YES 22000000 MVI 0(RJ),X'10' INH WR HA, R0 PERM HEAD SEEKS 22100000 BC 15,OBPAM210 22200000 * 22300000 OBPAMK44 DC H'44' 22400000 * 22500000 OBPAM200 EQU * 22600000 MVI 0(RJ),X'50' INH ALL WR PERM HEAD SEEKS 22700000 * 22800000 OBPAM210 EQU * 22900000 SR RE,RE SET FORMAT 3 SW OFF 23000000 * 23200000 OBPAM220 EQU * 23300000 MVC 6(8,RJ),2(RDCB) SET UP ONE EXTENT CCHH TO CCHH 23400000 * APAR 43880 RESULTED FROM THE USER BEING ABLE TO SPECIFY A43880 23410021 * ZERO FOR PRIMARY SPACE ALLOCATION AND THUS GETTING EXTENT A43880 23420021 * SECTION OF DEB ALL ZEROS. A43880 23430021 CLC XNTOFSET(EIGHT,RJ),NOALLOC IS THE EXTENT ALL 0 A43880 23440021 BNE ALLOC IF NOT NO PROBLEM A43880 23450021 MVC XNTOFSET(L'FOXES,RJ),FOXES INVALIDATE DEB SA54462 23460021 ALLOC EQU * A43880 23470021 CLI 0(RDCB),X'81' CHECK FOR CYLINDER BOUNDRY 23500000 BE OBPAM224 YES BRANCH. PERMIT HEAD SEEKS. 23600000 OI 0(RJ),X'18' INHIBIT ALL SEEKS 23700000 OBPAM224 EQU * 23800000 * 23900000 * 24000000 * SET NO OF TRACKS 24100000 * 24200000 STM RE,RJ,DXCCW5 SAVE ALL REGS 24300000 LR RPAR,RJ SAVE CURR EXTNT PNTR 24400000 STC RF,DXDAADDR SET CONST M FOR CONVERT 24500000 MVC DXDAADDR+1(2),4(RJ) BB 24600000 MVC DXDAADDR+3(4),10(RJ) END CCHH IN EXTENT 24700000 * 24800000 * USE CONVERT ROUTINE 24900000 * 25000000 AIF ('&LIB' NE 'LIB1').DEBCK30 TEST FOR LIB1(OS) YM0890 25050001 L RF,0(0,RPARC) DCB PTR 25100000 L RF,DCBOFSET(0,RF) PT TO DEB 25200000 .DEBCK30 ANOP Y01021 25250000 AIF ('&LIB' EQ 'LIB1').DEBCK40 TEST FOR LIB1(OS) Y01021 25260000 L RF,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 25270000 .DEBCK40 ANOP Y01021 25280000 LA RDCB,DXDAADDR PT TO CONST FOR CONVERT RTNE 25300000 L RJ,CVTPTR GET COMM VECTOR ADDRESS 25400000 L RJ,CVTPRLTV-CVT(0,RJ) CONVERT RTNE 25500000 BALR RD,RJ 25600000 * 25700000 LR RF,RE MOVE TTR TO RF 25800000 SRL RF,16 USE TT ONLY 25900000 LA RF,1(0,RF) ADD ONE TO TT 26000000 SH RF,DXCCW4 SUBTRACT TT OF LAST EXTENT 26100000 STH RF,14(0,RPAR) STORE NO OF TRKS IN EXTNT 26200000 AH RF,DXCCW4 RESET TOTAL TT CTR 26300000 STH RF,DXCCW4 26400000 LM RE,RJ,DXCCW5 RESTORE ALL REGS 26500000 * 26600000 LA RF,1(0,RF) ADD 1 TO M CTR, PT TO NEXT EXTNT 26700000 * 26800000 BCT RC,OBPAM260 NEXT 26900000 * 27000000 * 27100000 L RDCB,0(0,RPARC) RE-SET DCB PTR 27200000 AIF ('&LIB' NE 'LIB1').DEBCK50 TEST FOR LIB1(OS) YM0890 27250001 L RDEB,DCBDEBAD RE-SET DEB PTR 27300000 .DEBCK50 ANOP Y01021 27350000 AIF ('&LIB' EQ 'LIB1').DEBCK60 TEST FOR LIB1(OS) Y01021 27360000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 27370000 .DEBCK60 ANOP Y01021 27380000 * 27400000 TM DCBDSORG,POTEST TEST FOR PO DATA SET UT18 27420018 BZ OBPAM227 BR IF NOT SPECIFIED UT18 27440018 * UT18 27460018 SR RC,RC ZERO REG. FOR IC INSTR. 5798 27500000 IC RC,DEBAMLNG PICK UP NO. OF DATA SET 5798 27600000 LTR RC,RC 5798 27700000 BZ OBPAM227 BRANCH IF ZERO 5798 27800000 OI DEBOFLGS,1 SET CONCATENATION IND. 5798 27900000 OBPAM227 EQU * 5798 28000000 * 5798 28100000 TM DCBMACRF,X'80' DCB USING EXCP MACRO 28200000 BC 8,OBPAM230 NO BRANCH 28300000 TM DCBMACRF,X'40' CK FOR FOUND EXT 28400000 BC 1,OBPAM230 YES BRANCH 28500000 * 28600000 TM DSCFILTY,X'02' PO IN DSCB 28700000 BC 8,OBPAM232 NO BRANCH 28800000 B OBPAM250 28900000 * 29000000 OBPAM230 EQU * 29100000 * 29200000 TM DCBDSORG,X'02' CK FOR PO 29300000 BC 1,OBPAM240 BR IF YES 29400000 OBPAM232 EQU * 29500000 SR RD,RD MC0W 29510000 SR RC,RC MC0W 29520000 IC RD,JFCBNVOL PICK UP NO. OF VOLUMES MC0W 29530000 IC RC,JFCBVLCT GET VOLUME COUNT MC0W 29540000 CR RC,RD MC0W 29550000 STH RC,18(RJ) IS VOLUME COUNT GREATER MC0W 29560000 BH OBPAM172 YES USE VOLUME COUNT MC0W 29570000 STH RD,18(RJ) NO USE NUMBER OF VOLUMES MC0W 29580000 OBPAM172 EQU * MC0W 29590000 LH RD,JFCBVLSQ LOAD VOL SEQ NO A50696 29640021 TM JFCBIND2,X'40' TEST FOR OLD OR NEW 6831 29760013 BNE OBPAM234 BIF EITHER. 29820013 TM 0(RPARC),X'07' TEST FOR OUT-OUT/IN. MVT SYSOUT PROB. 29880013 BC 12,OBPAM234 BIF NEITHER. MVT SYSOUT PROB. 29940013 LTR RD,RD TEST FOR ZERO 18987 29980000 BE OBPAM233 YES 18987 30000000 STH RD,16(RJ) STORE VOL SEQ NO. IN DEB 18987 30020000 B OBPAM23A 18987 30040000 OBPAM233 EQU * 18987 30060000 IC RD,JFCBNVOL PICK UP NO. OF VOLUMES 18987 30080000 OBPAM234 EQU * 30100000 LTR RD,RD VOL SEQ ZERO A50696 30150021 BNZ OBPAM235 NO, BR A50696 30200021 LA RD,ONE YES, USE VOL 1 A50696 30210021 OBPAM235 EQU * A50696 30220021 STH RD,16(RJ) USE VOL SEQ FROM JFCB A50696 30230021 OBPAM23A EQU * 18987 30250000 LA RJ,4(RJ) SKIP PS SECTION 30300000 LNR RJ,RJ MAKE NEGATIVE FOR BPAM A25961 30360019 * TEST BELOW 30420019 MVI DEBAMLNG,X'10' 16 BYTE ACCESS METHOD A25961 30480019 * SECTION 30540019 OBPAM240 EQU * 30600000 TM DSCFILTY,X'02' CK PO IN DSCB 30700000 BC 8,DEBFINI BRANCH IF NO 30800000 OBPAM250 EQU * 30900000 * 31000000 TM 0(RPARC),X'0F' CK FOR INPUT 31100000 BC 8,DEBFINI BRANCH IF YES 31200000 * 31300000 CLI JFCBELNM,X'40' CK FOR MEMBER NAME 31400000 BC 8,DEBFINI BRANCH IF NO 31500000 * 31600000 * CHECK FOR GDG RELATIVE GENERATION SPECIFICATION 18185 31610000 CLI JFCBELNM,C'+' 18185 31620000 BC 8,DEBFINI BRANCH IF PLUS 18185 31630000 CLI JFCBELNM,C'-' 18185 31640000 BC 8,DEBFINI BRANCH IF MINUS 18185 31650000 TM JFCBELNM,X'F0' 18185 31660000 BC 1,DEBFINI BRANCH IF NUMERIC 18185 31670000 LTR RJ,RJ TEST FOR BPAM ACCESS A25961 31690019 * METHOD SECTION 31710019 BP OBPAM253 BR IF YES A25961 31730019 LPR RJ,RJ MAKE RJ POSITIVE A25961 31750019 B OBPAM256 ACCESS METHOD LENGTH A25961 31770019 * ALLREADY SET TO 16 31790019 OBPAM253 OI DEBAMLNG,X'08' 8 BYTE BPAM SECTION A25961 31810019 * FOR MEMBER NAME 31830019 OBPAM256 MVC 16(8,RJ),JFCBELNM STORE MEMBER NAME IN A25961 31850019 * DEB 31870019 BC 15,DEBFINI 31900000 * 32000000 * 32100000 * 32200000 OBPAM260 EQU * 32300000 BCT RD,OBPAM280 BR IF MORE EXTENT ON CURRENT DS 32400000 STC RF,0(0,RB) PUT M PTR IN AM SECTION 32500000 LA RB,1(0,RB) NEXT ENTRY IN AM SECTION 32600000 L RDEB,NEXTCORE(0,RDEB) NEXT DSCB ADDR 32700000 LR RDCB,RDEB NEW CORE 32750000 SR RUCB,RUCB ZERO DD POINTER XA02093 32850000 IC RUCB,0(RTIOT) GET LENGTH OF DD ENTRY XA02093 32900000 LA RTIOT,0(RUCB,RTIOT) PT TO NEXT DD ENTRY XA02093 32950000 LA RJ,16(0,RJ) NEXT DEB EXTENT 33000000 BC 15,OBPAM180 33100000 * 33200000 * MORE EXTENTS FOR CURRENT DATA SET 33300000 * 33400000 OBPAM280 EQU * 33500000 LA RDCB,10(0,RDCB) UPDATE DSCB PTR 33600000 BCT RUCB,OBPAM300 BR IF MORE EXT FOR CURR FORMAT 33700000 LA RDCB,1(0,RDCB) UPDATE DSCB EXTNT PNTR 33800000 LTR RE,RE IS IT WORKING ON FORMAT 3 33900000 BC 7,OBPAM320 BR IF YES 34000000 * 34100000 L RDCB,4(RDCB) GET NEXT FORMAT 3 DSCB 34200000 * IF A USER OPENS FOR DSORG=IS & MACRF=E HE CAN CAUSE A BAD A39782 34207021 * DEB TO BE BUILT. FOR ISAM DATA SETS THERE IS A FORMAT 2 DSCBA39782 34214021 * CHAINED TO THE FORMAT 1 DSCB. THE FORMAT 2 DSCB DOES NOT A39782 34221021 * CONTAIN ANY INFORMATION NEEDED FOR BUILDING DEBS & IF USED A39782 34228021 * WILL CAUSE THE 4TH EXTENT TO BE ALL ZEROS. IT IS THEREFORE A39782 34235021 * NECESSARY TO TEST FOR A FORMAT 2 DSCB AND IF SO LINK TO THE A39782 34242021 * FIRST FORMAT 3 DSCB. A39782 34249021 CLI 44(RDCB),X'F2' FORMAT 2 DSCB? (ISAM A39782 34256021 * ONLY) A39782 34263021 BNE NOTF2 IF NOT, CONTINUE A39782 34270021 L RDCB,140(RDCB) IF YES, GET FORMAT 3 DSCB A39782 34277021 NOTF2 EQU * A39782 34284021 LR RDEB,RDCB SAVE CURRENT DSCB ADDR 34300000 LA RDCB,4(0,RDCB) UPDATE DSCB PNTR 34400000 LA RUCB,4 START WITH 4 EXTENTS IN KEY 34500000 LA RE,1 SET FORMAT 3 SW ON 34600000 * 34700000 OBPAM300 EQU * 34800000 MVC 16(6,RJ),0(RJ) MOD,UCB AND BB FOR NEXT EXTENT 34900000 LA RJ,16(0,RJ) NEXT DEB EXTENT 35000000 BC 15,OBPAM220 35100000 * 35200000 * 35300000 OBPAM320 EQU * 35400000 LA RUCB,9 MAX 9 MORE EXTENTS 35500000 SR RE,RE FORMAT 3 SW OFF 35600000 BC 15,OBPAM300 35700000 * 35800000 DEBFINI EQU * 35900000 L RF,DEBAPPAD ADDRESS OF FIRST BYTE OF GOTTEN 36000000 * CORE FOR DEB. USED TO ADDRESS 36100000 * THE DEBDSCBA FIELD IN THE PRE- 36200000 * FIX. 36300000 MVC 21(2,RF),DEBBINUM BB- COMPLETES FDAD FOR F1 DSCB. 36400000 * CCHHR WAS PUT IN BY 191A. 36500000 * 36600000 * 36700000 L RDCB,0(RPARC) RESTORE DCB ADDRESS 36800000 * 36900000 *********************************************************************** 37000000 * 37100000 * TEST FOR USER OF EXCP NOT BSAM OR QSAM 37200000 * 37300000 *********************************************************************** 37400000 * 37500000 TM DCBMACRF,X'80' EXCP BIT ON 37600000 BC 8,SAMOUT NO BRANCH 37700000 MVI 0(RWTGC),0 ZERO NAME FIELD 37800000 B RELOOP 37900000 * 38000000 SAMOUT EQU * 38100000 * 38200000 TM ZERO(RPARC),INMASK TEST FOR INPUT DATA SET UT18 38209018 BZ SAMOUT1 BR IF INPUT UT18 38218018 TM DCBDSORG,POTEST TEST FOR PO DATA SET UT18 38227018 BO SAMOUT1 BR IF PO DATA SET UT18 38236018 TM DCBOPTCD,TOTMASK TEST FOR TOTALING UT18 38245018 BZ SAMOUT1 BR IF NOT SPECIFIED UT18 38254018 MVC ZERO(5,RWTGC),SOP1Y STORE IDTTR IN WTG TBL UT18 38263018 B RELOOP UNCONDITIONAL BRANCH UT18 38272018 * UT18 38281018 SAMOUT1 EQU * SYMBOLIC ADDR UT18 38290018 MVC 0(5,RWTGC),SOP1B STORE NEXT MODULES ID 38300021 ********************************************************************* 38400000 * 38500000 RELOOP LA RWTGC,WGOFF(0,RWTGC) UPDATE WHERE TO GO ENTRY 38600000 LA RPARC,PLOFF(0,RPARC) UPDATE PARA LIST ENTRY 38700000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 38800000 BCR 8,RBASE YES, BRANCH 38801503 * 39000000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 39100000 BC 7,RELOOP NO BRANCH 39200000 * 39300000 LR RPARC,RPAR 39400000 LA RWTGC,WAOFF(0,RWTG) RE INIT WTG LIST 39500000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 39600000 BC 7,TCTLRTN NO XCTL 39700000 * 39800000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 39900000 LA RPARC,PLOFF(0,RPARC) 40000000 BC 15,ZCHEK 40100000 * 40200000 TCTLRTN EQU * 40300000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 40400000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 40500000 * 40600000 LA 15,CCWOFSET(0,RCORE) SET UP FOR XCTL 40700000 ** 40800000 XCTL DE=(RWTG),SF=(E,(15)) 40900000 * 41000000 WAOFF EQU 32 OFFSET OF FIRST ENTRY IN WTG TABLE 41100000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 41200000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 41300000 OPIDCNST DC C'0S' 41400000 AMIDCNST DC C'1N' THIS EXEC'S ID. 41500000 NOALLOC DC 2F'0' COMPARE FOR 0 IN EXTENT A43880 41510021 FOXES DC F'-1' INVALID EXTENT FOR DEB SA54462 41520021 AIF ('&LIB' EQ 'LIB1').APF005 XL03048 41520103 USING INFMJFCB,RPARC XL03048 41520303 CLCINST CLC JFCBDSNM(0),ALTDSNAM XL03048 41520603 * XL03048 41520903 DSNOFFST DC 0H'0',AL2(L'ALTVOLID+L'ALTLNENT) XL03048 41521203 .APF005 ANOP XL03048 41521503 * 41600000 XCTLTABL ID=(SOP1Y,1Y,SOP1B,1B),SVC=019 SA54462 42510021 * 42520021 AIF ('&LIB' EQ 'LIB1').APF011 XL03048 42520103 ALTABLE DSECT XL03048 42520303 ALTLENTH DS X LENGTH OF ALT XL03048 42520603 ALTNOENT DS X NO. OF ENTRIES IN ALT XL03048 42520903 ALTENT EQU * XL03048 42521203 ALTENTRY DSECT ALT ENTRY XL03048 42521503 ALTLNENT DS X LN OF VOLID + DSNAME XL03048 42521803 ALTVOLID DS CL6 ALT ENTRY VOLID XL03048 42522103 ALTDSNAM DS C ALT ENTRY DSNAME XL03048 42522403 * XL03048 42522703 .APF011 ANOP XL03048 42523003 SRT DSECT 42900000 IEFUCBOB 43000000 * 43100000 EJECT 43200000 DCBD DSORG=PS 43300021 CVT DSECT 43400000 AIF ('&LIB' EQ 'LIB1').APF003 XL03048 43400303 CVT DSECT=YES,SYS=AOS1 XL03048 43500003 CVTAUTHL EQU CVT+X'188' XM4887 43500303 .APF003 ANOP XL03048 43500903 AIF ('&LIB' NE 'LIB1').APF004 XL03048 43501003 CVT XL03048 43501203 .APF004 ANOP XL03048 43501503 * TASK CONTROL BLOCK 43600000 CNOP 0,4 43700000 TCB DSECT 43800000 TCBRBP DS F PO9NTER TO EXECUTING RB 43900000 TCBPIE DS F POINTER TO PROG. INTERRUPT EL. 44000000 TCBDEB DS F POINTER TO DEB QUEUE 44100000 TCBTIO DS F POINTER TO TIOT 44200000 TCBCMP DS F TASK COMPLETION CODE 44300000 TCBTRN DS F TESTRAN FIELD 44400000 TCBMSS DS F DATA BLOCK QUEUE ELEMENT POINTER 44500000 TCBPKF DS CL1 RESERVED FOR FUTURE USE 44600000 TCBFLGS DS FL5 FLAG BYTES 44700000 TCBLMP DS CL1 RESERVED FOR FUTURE USE 44800000 TCBDSP DS CL1 RESERVED FOR FUTURE USE 44900000 TCBLLS DS F POINTER TO LOAD LIST 45000000 TCBJLB DS F POINTER TO JOBLIB DCB 45100000 TCBJSE DS F LIST OF INACTIVE PROGRAMS ADDR. 45200000 TCBGRS DS CL64 GENERAL REGISTER SAVE AREA 45300000 TCBIDF DS CL1 TCB IDENTIFIER FIELD 45400000 TCBFSA DS CL3 POINTER TO 1ST PROB.PROG.SAVEAR 45500000 TCBTCB DS F RESERVED FOR FUTURE USE 45600000 TCBTME DS F POINTER TO TIMER ELEMENT 45700000 DS CL24 45800000 TIOT DSECT 45900000 TIOELNGH DS CL1 LENGTH OF THIS ENTRY 46000000 TIOESTTA DS CL1 STATUS -A- 46100000 TIOERLOC DS CL2 REL. LOC OF POOL 46200000 TIOEDDNM DS 2F DDNAME 46300000 TIOEJFCB DS 1F JFCB DISK ADDR 46400000 TIOESTTB DS 0CL1 46500000 TIOEFSRT DS CL4 46600000 DS CL1 46700000 * TIOT POOL ENTRY 46800000 TIOPNSLT DS XL1 NR.OF SLOTS FOR POOL 46900000 DS CL1 47000000 TIOPNSRT DS XL1 NR.OF DEVICES (FILLED 47100000 * SLOTS) 47200000 TIOPPOOL DS CL8 POOL NAME 47300000 TIOPSTTB DS XL1 STATUS OF SLOT 47400000 TIOPSLOT DS XL3 SRT ADDRESS OR EMPTY SLOT 47500000 TIOTFEND DS 1F FINAL END OF AN ENTRY 47600000 SPACE 1 47700000 * DATA EXTENT BLOCK (UNTIL PROTIOS CHANGES) 47800000 DEB DSECT 47900000 DEBNMSUB DS 0CL1 48000000 DEBTCBAD DS CL4 48100000 DEBAMLNG DS 0CL1 48200000 DEBDEBAD DS CL4 48300000 DEBOFLGS DS 0CL1 48400000 DEBIRBAD DS CL4 48500000 DEBOPATB DS CL1 XL03048 48600303 DEBQSCNT DS CL1 XL03048 48600603 DEBFLGS1 DS CL1 XL03048 48600903 DS CL1 XL03048 48601203 DEBNMEXT DS 0CL1 48800000 DEBUSRPG DS CL4 48900000 DEBPRIOR DS 0CL1 49000000 DEBECBAD DS CL4 49100000 DEBPROTG DS 0CL1 49200000 DEBDEBID DS 0CL1 49300000 DEBDCBAD DS CL4 49400000 DEBEXSCL DS 0CL1 49500000 DEBAPPAD DS CL4 49600000 DEBDVMOD DS 0CL1 49700000 DEBUCBAD DS CL4 49800000 DEBTVLSQ DS 0CL2 VOL SEQ FOR TAPE 49900000 DEBBINUM DS CL2 50000000 DEBTVLNM DS 0CL2 NO OF VOL FOR TAPE 50100000 DEBSTRCC DS CL2 50200000 DEBSTRHH DS CL2 50300000 DEBENDCC DS CL2 50400000 DEBENDHH DS CL2 50500000 DEBNMTRK DS CL2 50600000 * FOR ADDITIONAL EXTENT ON DIRECT ACCESS THE FOLLOWING FIELDS 50700000 * WILL HAVE TO BE OFFSET ANOTHER 16 BYTES 50800000 DEBVOLSQ DS H 50900000 DEBVOLNM DS H 51000000 * FOR EACH SUBROUTINE LOADED BUMP THIS OFFSET BY 2 51100000 DEBSUBID DS H 51200000 FORCORE DSECT 51400000 IECDSECT 51500000 CCWOFSET EQU DXCCW12-FORCORE CCW RELOCATABLE OFF SET FOR DXCCW12 51600000 DCBOFSET EQU DCBDEBAD-IHADCB DEB RLCATBL OFFSET IN DCB 51700000 END 51800000 ./ ADD SSI=01010303,NAME=IGG0191O,SOURCE=0 TITLE 'IGG0191O--STAGE 2 OPEN EXECUTOR FOR BSAM INPUT ON DA' 00100019 COPY LCGASMSW 00100403 IGG0191O CSECT 00101019 * 00140019 * RELEASE 20 DELETIONS * 01500019 *3632107000-109000,179000,233000,310100-310400,314000-322000, S20201 01520020 *3632353000-354000,382000-388000,402000-403000,416000,425000- S20201 01540020 *3632438000,440000-449000,452000-453000,457000-459000,466000- S20201 01560020 *3632467000,471000-475000,479100-479200,488000-489000,603000 S20201 01580020 * RELEASE 21 DELETIONS * 01600019 *0091042000,566000,589000-591000,613000-619000,651000,689000- S21042 01630021 *0091690000 S21042 01660021 * RELEASE 22 DELETIONS * 01700019 * RELEASE 23 DELETIONS * 01800019 * RELEASE 24 DELETIONS * 01900019 * RELEASE 25 DELETIONS * 01910019 * RELEASE 26 DELETIONS * 01920019 * RELEASE 27 DELETIONS * 01930019 * RELEASE 28 DELETIONS * 01940019 * VS/1 RELEASE 3 CHANGES 01942003 * XM4401 01942403 *A515700-515900,516500,019420 XA02057 01944003 * 01950019 *STATUS CHANGE LEVEL 003 01980003 * 02010019 *FUNCTION/OPERATION--FOR DCB'S BEING OPENED FOR INPUT 02100019 * IT WILL LINK THE IOB'S AND INITIALIZE THEM. 02700019 * IT WILL CONSTRUCT CHANNEL PROGRAMS NEEDED FOR PROPER EXECUTION. 02800019 * IT WILL SET UP THE NUMBER OF EXTENTS NEEDED AND PLACE THE 02900019 * ADDRESSES IN THE DCB AND IOB'S. 03000019 * 03100019 * THIS MODULE WAS SPLIT FROM IGG0191D FOR RELEASE 19 03110019 * 03120019 *ENTRY POINTS--ENTERED FROM IGG0191D BY USE OF THE XCTL MACRO. 03200019 * 03300019 *INPUT--SEE DESCRIPTION OF REGISTERS, DCB(USERS). 03400019 *OUTPUT--IOB(USER), SEE DESCRIPTION OF THE REGISTERS, DCB(USERS) 03500019 * 03600019 * 03700019 *EXTERNAL ROUTINES--NONE. 03800019 * 03900019 *EXITS-NORMAL--XCTL TO IGG01915 TO LOAD ROUTINES 04000019 * 04100019 *EXITS-ERROR--XCTL TO PROB DET (IGG0196M) FOR WTP AND 013 ABEND 04160021 * INSUFFICIENT BUFFERS AVAILABLE IN 04220021 * BUFFER POOL TO SATISFY DCB BUFFER REQUIREMENTS M1552 04300019 * 04400019 *TABLES/WORKAREAS-- WHERE TO GO TABLE (WTG) 04500019 * 04600019 * BYTE 0-7 NAME 04700019 * BYTE 8-10 RELATIVE DISK ADDRESS (TTR) OF FIRST RECORD 04800019 * BYTE 11 CONCATENATION NUMBER 04900019 * BYTE 12 ZERO 05000019 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR 05100019 * ALIAS INDICATOR 1 BIT 05200019 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 05300019 * BYTE 14-16 TTR OF FIRST TEXT RECORD 05400019 * BYTE 17 ZERO 05500019 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 05600019 * BYTE 20 TRANSLATION TABLE 05700019 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 05800019 * BYTE 22-23 ATTRIBUTES 05900019 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 06000019 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 06100019 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 06200019 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 06300019 * BYTE 32-34 IDTTR OF EXECUTOR FOR 1ST DCB 06400019 * BYTE 35 WORKAREA ADDRESS FOR 1ST DCB 06500019 * BYTE 36-39 TABLE OF IDTTR'S 06600019 * 06700019 * 32+N(8) IDTTR OF EXECUTOR FOR NTH DCB (3 BYTES) 06800019 * WORKAREA ADDRESS FOR NTH DCB (1 BYTE) 06900019 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 07000019 * NOT USED (1 BYTE) 07100019 * 07200019 * 07300019 *********************************************************************** 07400019 *ATTRIBUTES--REENTRANT,REUSABLE. 07500019 * 07600019 * 07700019 *********************************************************************** 07800019 * 07900019 * 08000019 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 08100019 * 08200019 *********************************************************************** 08300019 * 08400019 RDCB EQU 2 DCB REGISTER 08500019 RBASE EQU 3 BASE REGISTER 08600019 RCORE EQU 4 WORK AREA ADDRESS 08700019 RPAR EQU 5 TOP OF PARAMETER LIST 08800019 RWTG EQU 6 TOP OF WTG TABLE 08900019 RPARC EQU 7 CURRENT PARAMETER 09000019 RWTGC EQU 8 CURRENT TRANS LOAD 09100019 RTIOT EQU 9 WRK REG AND COMM VECTOR ADDR. 09200019 RUCB EQU 10 COUNTER IN IOB GENERATION 09300019 RDEB EQU 11 DEB ADDRESS 09400019 RB EQU 12 WORK REG1 ** 09500019 RC EQU 13 WORK REG2 ** IOB GENERATION 09600019 RD EQU 14 WORK REG3 ** 09700019 RJ EQU 15 WORK REG4 09800019 CPR EQU RJ ADDR OF CHANNEL PROG 09900019 RE EQU 0 WORK REG5 10000019 RF EQU 1 WORK REG6 10100019 * 10200019 * 10300019 PARAR EQU RPARC 10400019 * 10500019 *********************************************************************** 10600019 * 10610020 * DISPLACEMENTS AS EQUATES 10620020 * 10630020 D0 EQU 0 DISPLACEMENT OF ZERO S20201 10640020 D1 EQU 1 DISPLACEMENT OF ONE S20201 10650020 D4 EQU 4 DISPLACEMENT OF FOUR S20201 10660020 D6 EQU 6 DISPLACEMENT OF SIX S20201 10670020 D7 EQU 7 DISPLACEMENT OF SEVEN S20201 10680020 D8 EQU 8 DISPLACEMENT OF EIGHT S20201 10690020 D16 EQU 16 DISPLACEMENT OF SIXTEEN S20201 10700020 * DMO S20201 10710020 D24 EQU 24 DISPLACEMENT OF 24 S20201 10720020 D28 EQU 28 DISPLACEMENT OF S20201 10730020 * TWENTYEIGHT S20201 10740020 D31 EQU 31 DISPLACEMENT OF S20201 10750020 * THIRTYONE S20201 10760020 D36 EQU 36 DISPLACEMENT OF S20201 10770020 * THIRTYSIX S20201 10780020 D40 EQU 40 DISPLACEMENT OF FORTY S20201 10790020 D44 EQU 44 DISPLACEMENT OF S20201 10800020 * FORTYFOUR S20201 10810020 D47 EQU 47 DISPLACEMENT OF S20201 10820020 * FORTYSEVEN S20201 10830020 D48 EQU 48 DISPLACEMENT OF 48 S20201 10840020 D64 EQU 64 DISPLACEMENT OF 64 S20201 10850020 * 10860020 * BYTE COUNTS AS EQUATES 10870020 * 10880020 B0 EQU 0 BYTE COUNT OF ZERO S20201 10890020 B1 EQU 1 BYTE COUNT OF ONE S20201 10900020 B8 EQU 8 BYTE COUNT OF EIGHT S20201 10910020 * 10920020 ********************************************************************* 11000019 * MASK'S TO TEST PARAMETER LIST WITH 11100019 INP EQU X'0F' 11200019 OUTP EQU X'0F' 11300019 UPDATE EQU X'04' 11400019 INOUT EQU X'03' 11500019 OUTIN EQU X'07' 11600019 RDBACK EQU X'01' 11700019 * 11800019 * 11900019 ********************************************************************* 12000019 * 12100019 * 12200019 * OFFSET FOR PARAMETER TESTS 12300019 * 12400019 ONE EQU X'01' 12500019 FRTYATE EQU 48 12600019 DISPSN EQU X'0' 12700019 * 12800019 * 12900019 ********************************************************************* 13000019 * 13100019 * OFFSETS FOR DEB REFERENCE 13200019 * 13300019 * 13400019 BIN EQU 36 BIN NOS. DM0I 13500019 BEXT EQU 38 BIN EXTENT DM0I 13600019 * 13700019 * 13800019 * 13900019 ********************************************************************* 14000019 * 14100019 * MASK'S USED TO TEST OPTION FIELDS IN DCB 14200019 * 14300019 * 14400019 * 14500019 DOUBLE EQU X'01' 14600019 * 14700019 * 14800019 STOWB EQU X'80' 14900019 WRTCK EQU X'80' WRITE CHECK DM0I 15000019 OVRFLO EQU X'20' 15100019 PCI EQU X'20' 15200019 MINKEY EQU X'01' 15300019 CONCAT EQU X'FF' 15400019 * 15500019 ********************************************************************* 15600019 * 15700019 * MASKS FOR ACCESS METHODS IN SAM 15800019 * 15900019 QSAMB EQU X'01' 16000019 BSAMBIT EQU X'00' 16100019 PAM EQU X'02' 16200019 * 16300019 * 16400019 * MASKS FOR MACRO'S TO BE USED 16500019 * 16600019 GETB EQU X'40' 16700019 PUTB EQU X'40' 16800019 READB EQU X'20' 16900019 WRITEB EQU X'20' 17000019 POINTB EQU X'04' 17100019 CNTRLB EQU X'02' 17200019 * 17300019 * 17400019 ********************************************************************* 17500019 * 17600019 * MASKS FOR DEVICES TO BE SUPPORTED 17700019 * 17800019 SRCHDRK EQU X'40' SRCH DIRECT MASK S20201 17840020 NOTSILI EQU X'DF' NOT SIL BIT MASK S20201 17880020 NORCDRY EQU X'20' NO RCD READY FOR ENTIRE S20201 17920020 * DATA SET MASK 17960020 * 18000019 ********************************************************************* 18100019 * 18200019 * 18300019 COFFSR EQU 88 OFFSET OF RDCCW IF RCD S20201 18310020 * READY USED 18320020 CSTOFFSR EQU 72 OFFSET OF RDCCW IF RCD S20201 18330020 * READY AND F-STD RCDS 18340020 SRCHD EQU X'40' SEARCH DIRECT MASK S20201 18350020 * DMO S20201 18360020 * DMOR 18370020 * 18400019 * 18500019 ********************************************************************* 18600019 * 18700019 * MASKS FOR STATUS BITS TO BE TESTED 18800019 * 18900019 * 19000019 EXCPN EQU X'30' 19100019 COMPLETE EQU X'60' COMPLETE MASK DM0I 19200019 FIRSTIOB EQU X'01' 19300019 * 19400019 * 19500019 * 19600019 ********************************************************************* 19700019 * 19800019 * MASKS FOR BUFFER TECHNIQUE'S 19900019 * 20000019 BFTEKR EQU X'20' BDAM VS 20100019 VSBITS EQU X'48' VS BITS IN DCBRECFM 20200019 CYCLICB EQU X'20' 20300019 EXCHANGB EQU X'10' 20400019 SIMPLEB EQU X'40' 20500019 EXCHCYCL EQU X'30' 20600019 * 20700019 ********************************************************************* 20800019 * 20900019 * 21000019 * MODES OF OPERATION FOR QSAM 21100019 * 21200019 LOCATEB EQU X'08' 21300019 MOVEB EQU X'10' 21400019 SUBSTUTB EQU X'04' 21500019 * 21600019 * 21700019 ********************************************************************* 21800019 * 21900019 * 22000019 * COMMAND BYTES FOR THE 2841 22100019 * 22200019 * CONTROL UNIT 22300019 * 22400019 * 22500019 * 22600019 SRCHE EQU X'31' 22700019 WRTCKD EQU X'1D' 22800019 RDC EQU X'92' 22900019 RDKD EQU X'8E' 23000019 RDD EQU X'86' 23100019 TIC EQU X'08' 23200019 MTRCT EQU X'92' M/T RD CNT CCW CMND S20201 23240020 SETSC EQU X'23' SET SECTOR CCW CMND S20201 23280020 RDSC EQU X'22' READ SECTOR CCW CMND S20201 23320020 * 23360020 * 23400019 ********************************************************************* 23500019 * 23600019 * 23700019 * MASKS FOR RECORD FORMATS 23800019 * 23900019 * 24000019 STANDRDF EQU X'88' STANDARD FORMORT DM0I 24100019 FORMATU EQU X'C0' 24200019 FORMATF EQU X'80' 24300019 FORMATV EQU X'40' 24400019 BLOCKED EQU X'10' 24500019 * 24600019 * 24700019 ********************************************************************* 24800019 * 24900019 * 25000019 * CHANNEL CONTROL WORD FLAGS 25100019 * 25200019 SKIP EQU X'10' 25300019 SLI EQU X'20' 25400019 SLIBIT EQU X'DF' TO TURN OFF SLI BIT 25500019 CCWNOP EQU X'03' NOP 25600019 CC EQU X'40' 25700019 DATACH EQU X'A0' 25800019 SLICC EQU X'60' 25900019 SLICCSK EQU X'70' 26000019 * 26100019 * 26200019 ********************************************************************* 26300019 * 26400019 * 26500019 KEYS EQU X'01' 26600019 QSAM EQU X'01' 26700019 * 26800019 * 26900019 ********************************************************************* 27000019 * 27100019 GETMAIN EQU 4 27200019 QSAMZ EQU X'05' MASK DM0I 27300019 NRMLEND EQU X'7F' NORMAL END CODE FOR ECB 27310019 SRCHDRCT EQU X'40' SEARCH DIRECT--DCBCIND1 27320019 POBIT EQU X'02' PARTITIONED ORGANIZATION 27330019 ABCODE EQU X'013' ABEND CODE 27340019 COMMTABL EQU 16 MASK DM0I 27400019 NULL EQU 0 CONSTANT 0 27410019 IOBNUM EQU 1 DEFAULT NO OF IOB'S 27500019 K2 EQU 2 CONSTANT 2 27510019 K3 EQU 3 CONSTANT 3 27520019 WORD EQU 4 LENGTH OF A FULL WORD 27530019 K5 EQU 5 CONSTANT 5 27540019 K6 EQU 6 CONSTANT 6 27550019 K7 EQU 7 CONSTANT 7 27551019 K8 EQU 8 CONSTANT 8 27560019 L1CCW EQU 8 LENGTH OF 1 CCW 27600019 K12 EQU 12 CONSTANT 12 27610019 K14 EQU 14 CONSTANT 14 27620019 K16 EQU 16 CONSTANT 16 27630019 L2CCW EQU 16 LENGTH OF 2 CCW'S 27700019 K19 EQU 19 CONSTANT 19 27710019 K20 EQU 20 CONSTANT 20 27720019 K23 EQU 23 CONSTANT 23 27730019 L3CCW EQU 24 LENGTH OF 3 CCW'S 27800019 K24 EQU 24 CONSTANT 24 27810019 K28 EQU 28 CONSTANT 28 27820019 K31 EQU 31 CONSTANT 31 27830019 K32 EQU 32 CONSTANT 32 27840019 K36 EQU 36 CONSTANT 36 27850019 L5CCW EQU 40 LENGTH OF 5 CCW'S 27900019 K40 EQU 40 CONSTANT 40 27910019 K43 EQU 43 CONSTANT 43 27920019 IOBLNGTH EQU 48 LENGTH OF IOB 28000019 K48 EQU 48 CONSTANT 48 28001019 CPLNGTH EQU 64 LENGTH OF CHANNEL PRGM 28010019 K64 EQU 64 CONSTANT 64 28020019 K80 EQU 80 CONSTANT 80 28030019 K83 EQU 83 CONSTANT 83 28040019 K104 EQU 104 CONSTANT 104 28050019 OABD064 EQU 64 S21042 28070021 ********************************************************************* 28100019 * 28200019 * 28300019 * 28400019 * 28500019 * 28600019 * 28800019 * 28900019 * 29000019 BALR RBASE,NULL REG 3 IS BASE 29100019 USING SOP2,RBASE 29200019 USING IHADCB,RDCB REG 2 IS DCB 29300019 USING CVT,RTIOT REG 9 IS COMM UECT TABLE 29400019 USING FORCORE,RCORE REG 4 IS WORK AREA ADDR 29500019 USING BLDEB,RDEB REG 11 IS DEB 29600019 * 29700019 * 29800019 * 29900019 * 30000019 SOP2 EQU * 30100019 * 30200019 L RDCB,NULL(RPARC) GET DCB ADDRESS 30300019 LA RDCB,NULL(RDCB) CLEAR HI BYTE 30400019 L RCORE,WORD(RWTGC) GET WORK AREA ADDRESS 30500019 * 30600019 L RB,DCBIOBA GET FIRST IOB ADDR 30700019 L RC,D0(RB) GET SET THETA ADDR S20201 30720020 ST RC,DXCCW11 TEMP STORE S20201 30740020 LA RC,B1(RC) OBTAIN READ THETA ADDR S20201 30760020 ST RC,DXCCW12 TEMP STORE S20201 30780020 LR RC,RB SET UP WORK REG 30800019 LR RD,RB SET UP WORK REG 30900019 SR RF,RF CLEAR FOR IC 31000019 IC RF,DCBNCP GET NO OF IOB'S 31100019 TM DCBCIND2,QSAMB QSAM USED S20201 31120020 BNO SOP230 BRANCH IF NO S20201 31140020 IC RF,DCBBUFNO USE BUFFER NO FOR IOB S20201 31160020 * CNT S20201 31180020 LR RUCB,RF IOB COUNTER 31200019 * 31300019 SOP230 EQU * S20201 31400020 LR RUCB,RF LOAD REGISTER S20201 31500020 LR RDEB,RUCB PUT COUNT IN DECR REG S20201 31600020 * DMO S20201 31700020 SOPSTART EQU * S20201 31800020 * 31900020 * START OF IOB BUILD ROUTINE 32000020 * 32100020 SPACE 2 32300019 * 32400019 SOP242 EQU * 32500019 * 32600019 ST RB,NULL(RD) LINK NEW IOB TO LAST ONE BUILT 32700019 LR RD,RB UPDATE CURRENT IOB POINTER 32800019 LA RB,WORD(RB) POINT TO ECB SLOT 32900019 OI NULL(RB),NRMLEND SET ECB COMPLETE WITHOUT ERROR 33000019 ST RB,K12(RD) STORE ECB ADDR IN IOB 33100019 LA RB,K20(RB) POINT TO CP POINTER SLOT 33200019 LR RC,RB SAVE ADDR 33300019 LA RB,K24(RB) POINT TO CP START ADDR 33400019 SOP243 EQU * 33500019 ST RB,NULL(RC) STORE CP STARTAD IN IOB 33600019 ST RDCB,WORD(RC) STORE DCB ADDR IN IOB 33700019 MVC K40(L'DCBFDAD,RD),DCBFDAD INITIALIZE IOBFDAD. 33800019 * 33900019 *********************************************************************** 34000019 * 34100019 * CONSTRUCTION OF READ CHANNEL PROGRAM FOLLOWS 34200019 * 34300019 *********************************************************************** 34400019 * 34500019 SOP255 EQU * 34600019 * 34700019 LA RC,K19(RC) POINT TO CCHHR FIELD IN IOB 34800019 TM JFCBMASK+D6,NORCDRY ANY NON RPS DEVICES S20201 34810020 BO SOP2NC1 BRANCH IF YES S20201 34820020 BAL RJ,SOP2STA IF NOT GO BUILD SET S20201 34830020 * SECTOR S20201 34840020 SOP2NC1 EQU * S20201 34850020 ST RC,NULL(RB) STORE ADDR IN SRCH CCW 34900019 MVI NULL(RB),SRCHE STORE CMD BYTE 35000019 MVI K7(RB),K5 STORE COUNT OF 5 IN CCW 35100019 OI WORD(RB),CC SET CMD CHAIN FLAG ON 35200019 ST RB,D8(RB) PUT SEARCH ADDR IN TIC S20201 35270020 * CCW DMO S20201 35340020 LR RC,RB UPDATE PTR S20201 35410020 MVI K8(RB),TIC STORE TIC CMD BYTE 35500019 SR RE,RE 17363 35600019 IC RE,DCBKEYLE OBTAIN KL 17363 35700019 AH RE,DCBBLKSI ADD DL 17363 35800019 * KL+DL TO RH OF TIC FOR USE BY EOB ROUT 17363 35810019 STH RE,K14(RB) 17363 35900019 SOP255B EQU * 17363 36000019 * 36100019 * 36200019 * SRCH AND TIC CCWS HAVE BEEN GENERATED AT THIS POINT 36300019 * 36400019 MVI DCBOFFSR,K80 OFFSET TO RD CCW 36500019 TM DCBMACRF,POINTB POINT MACRO USED ON INPUT 36600019 BZ SOP255A0 NO BRANCH 36700019 MVI DCBCNTRZ,QSAMZ MOVE ID DM0I 36800019 B SOP2550 GO ON DM0I 36900019 * 37000019 SOP255A0 EQU * 37100019 TM DCBRECFM,STANDRDF STANDARD F RECORDS USED 37200019 BO SOP258 YES BRANCH 37300019 * 37400019 SOP2550 EQU * 37500019 LA RE,K24(RB) 37600019 ST RE,K16(RB) 37700019 MVI K16(RB),TIC STORE TIC CMD BYTE 37800019 OI K20(RB),SLICCSK SET SLI,CC,AND SKIP FLAGS 37900019 MVI K23(RB),ONE STORE A COUNT OF ONE 38000019 * 38100019 CH RUCB,CONONE ONE IOB TO BE BUILT S20201 38300020 * DMO S20201 38500020 SOP256 BE SOP256C YES BRANCH 38900019 * 39000019 * 39100019 SOP256A LA RC,K83(RC) POINT TO NEXT DA ADDR FIELD 39200019 SOP256B ST RC,K24(RB) STORE IN RD COUNT CCW 39300019 MVI K24(RB),RDC STORE RD CNT CMD BYTE 39400019 B SOP257 GO ON DM0I 39500019 * 39600019 SOP256C LA RC,DCBFDAD+K3 POINT TO CCHHR IN DCB 39700019 B SOP256B BACK DM0I 39800019 * 39900019 SOP257 MVI K31(RB),K5 STORE COUNT OF 5 IN RDC CCW 40000019 OI K28(RB),SLICC SET SLI AND CC FLAGS 40100019 * 40120020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 40140020 * READY S20201 40160020 BO SOP258A BRANCH IF YES S20201 40180020 MVI D31(RB),B8 SET BYTE COUNT TO EIGHT S20201 40200020 LA RE,D48(RB) GET DW END CHP S20201 40220020 ST RE,D24(RB) PUT AS ADDRESS IN CCW S20201 40240020 MVI D24(RB),RDC PUT IN RD CNT CCW S20201 40260020 MVI DCBOFFSR,COFFSR PUT IN CARN OFFSET S20201 40280020 OI D36(RB),SLI SILI ON FOR ALL BUT S20201 40300020 * STNDRD S20201 40320020 NI D28(RB),NOTSILI CLEAR SILI BIT S20201 40340020 B SOP258A EVER ONWARD S20201 40360020 SOP258 SH RB,SXTEN SUBT 16 FROM START OF CP ADDR 40400019 MVI DCBCNTRL+K3,ONE EPD2 ID NUMBER 40500019 OI DCBCIND1,SRCHDRCT SET SRCH DIRECT FLAG 40600019 * 40700019 SOP258A EQU * 40800019 TM DCBCIND2,QSAMB QSAM USED 40900019 BO SOP259 YES BRANCH 41000019 * 41100019 CLI DCBKEYLE,ONE IS KEY LENGTH SPECIFIED 41200019 BL SOP259A NO BRANCH 41300019 * 41400019 MVI K32(RB),RDKD STORE RD KEY&DATA CMD BYTE 41500019 B SOP259C GO AROUND NEXT S20201 41600020 * 41700019 SOP259 EQU * 41800019 LA RF,K32(RB) POINT TO ACTUAL RD DATA CCW 41900019 BAL RJ,SOP2QBF GO FILL IN QSAM ATTRIBUTES 42000019 * 42100019 SOP259A EQU * 42200019 MVI K32(RB),RDD STORE RD DATA CMD BYTE 42300019 * 42400019 * 42440020 SOP259C EQU * S20201 42480020 * 42520020 TM DCBRECFM,FORMATU FORMAT U RECORDS S20201 42560020 * DMO S20201 42600020 BM SOP259XB BRANCH IF NO S20201 42640020 * DMO S20201 42680020 OI D36(RB),SLI TURN ON SILI FLAG S20201 42720020 * DMO S20201 42760020 SOP259XB EQU * S20201 42800020 TM DCBCIND1,SRCHDRK SERARCH DIRECT USED S20201 42840020 BNO SOP2NST IF NO BRANCH S20201 42880020 MVI DCBOFFSR,D64 SET OFFSET FOR NORM F S20201 42920020 * RCDS S20201 42960020 TM JFCBMASK+D6,NORCDRY STAND F AND RCD READY S20201 43000020 BO SOP259G BRANCH IF NO S20201 43040020 MVI DCBOFFSR,CSTOFFSR IF NO PUT CARNIVAL S20201 43080020 * OFFSET S20201 43120020 MVI D40(RB),MTRCT IF YES PUT IN MT RD CNT S20201 43160020 OI D36(RB),CC TURN ON CMND CHAIN IN S20201 43200020 * PRE- S20201 43240020 * VIOUS CCW 43280020 OI D44(RB),CC+SLI+SKIP CMND CHAIN + SLI + SKIP S20201 43320020 * IN THIS CCW 43360020 MVI D47(RB),B1 SET BYTE CNT TO ONE S20201 43400020 LA RB,B8(RB) INCR PTR S20201 43440020 SOP2NST EQU * S20201 43480020 * 43520020 TM JFCBMASK+D6,NORCDRY NOT STND F, BUT WITH RCD S20201 43560020 * READY 43600020 BO SOP2NRR BRANCH IF NO S20201 43640020 BAL RJ,SOP2RTA GO BUILD RD SECTOR CCW S20201 43680020 SOP2NRR EQU * S20201 43720020 * 43760020 *******************************************************************DMOR 43800020 SOP259D EQU * 43900019 CH RUCB,CONONE ONE IOB TO BE BUILT S20201 44200020 * DMO S20201 44500020 SOP259E1 BE SOP259G YES BRANCH 45000019 * 45100019 CH RDEB,CONONE THIS LAST IOB S20201 45200020 BNE SOP259G BRANCH IF NO S20201 45300020 * 45400019 L RC,DCBIOBA GET FIRST IOB GENERATED 45500019 LA RC,K43(RC) POINT TO CCHHR FIELD 45600019 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 45630020 * READY DMO S20201 45660020 BNO SOP259G BRANCH IF NO S20201 45690020 * DMO S20201 45720020 ST RC,D24(RB) RD CNT OF LAST IOB TO S20201 45750020 * FRST DMO S20201 45780020 MVI D24(RB),RDC RESTORE CCW CMND S20201 45810020 * DMO S20201 45840020 SOP259G EQU * 20185 45910019 TM DCBCIND1,SRCHDRCT IS THIS SRCH DIRECT 20185 46100019 BO SOP259H YES, BRANCH 20185 46200019 TM DCBCIND2,QSAMB QSAM USED 46201019 BO SOP259I YES--BRANCH 46202019 TM DCBBFTEK,BFTEKR OFFSET READ 46210019 BZ SOP259I NO--BRANCH 46220019 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 46225020 * READY DMO S20201 46230020 BNO SOP259I IF NO RCD READY S20201 46235020 * ACCOMPLISH DMO S20201 46240020 * ES OFFSET RD FUNCTION DMOR 46245020 LA RB,CPLNGTH(RB) TO NEXT IOB LOC 46250019 B SOP240 RETURN FOR NEXT IOB 46260019 SOP259I EQU * 46270019 LA RB,K40(RB) TO NEXT POSSIBLE IOB LOC 20185 46300019 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 46310020 * READY DMO S20201 46320020 BO SOP259GX BRANCH IF YES S20201 46330020 * DMO S20201 46340020 LA RB,B8(RB) INCR PTR S20201 46350020 * DMO S20201 46360020 SOP259GX EQU * S20201 46370020 * DMO S20201 46380020 B SOP240 RETURN FOR NEXT IOB 20185 46400019 SOP259H EQU * 20185 46500019 LA RB,D40(RB) PT TO NEXT POSS IOB S20201 46508020 SOP240 EQU * S20201 46516020 SH RDEB,CONONE DECR IOB COUNT S20201 46524020 * DMO S20201 46532020 BP SOPSTART IF MOR IOBS BRANCH S20201 46540020 L RB,DCBIOBA IF NOT LINK LAST TO S20201 46548020 * FIRST DMO S20201 46556020 ST RB,D0(RD) PUT FIRST ADDR IN LAST S20201 46564020 * DMO S20201 46572020 B OFFSETRD GO AROUND INTERNAL S20201 46580020 * SUBROUT DMO S20201 46588020 * 46596020 * SET SECTOR CCW BUILD RTN 46604020 * 46612020 SOP2STA EQU * S20201 46620020 L RE,DXCCW11 GET SET SECTOR ADDR S20201 46628020 ST RE,D0(RB) PUT IN CCW S20201 46636020 MVI D0(RB),SETSC PUT IN CCW CMND S20201 46644020 MVI D7(RB),B1 SET BYTE CNT TO ONE S20201 46652020 OI D4(RB),CC TURN ON CMND CHAIN S20201 46660020 B CMNDFIN GO TO FINISH DETAILS S20201 46668020 * 46676020 * READ SECTOR CCW BUILD RTN 46684020 * 46692020 SOP2RTA EQU * S20201 46700020 L RE,DXCCW12 GET READ SECTOR ADDR S20201 46708020 ST RE,D40(RB) PUT IN CCW S20201 46716020 MVI D40(RB),RDSC PUT IN RD SECT CMND S20201 46724020 OI D36(RB),CC CMND CHAIN PREVIOUS CCW S20201 46732020 MVI D47(RB),B1 SET BYTE CNT TO ONE S20201 46740020 CMNDFIN EQU * S20201 46748020 LA RB,B8(RB) INCR PTR S20201 46756020 BR RJ RETURN S20201 46764020 * 46772020 * 46780020 * 46800019 * 46900019 * 47000019 * 47030020 * 47060020 OFFSETRD EQU * S20201 47090020 * 47120020 * IF RCD READY CHANNEL PROGRAM USED OFFSET RD FUNCTION ALREADY 47150020 * INSTITUTED 47180020 * 47210020 TM DCBCIND2,QSAMB IS IT QSAM S20201 47240020 BO SOP2END YES LEAVE THIS RTN S20201 47270020 SR RE,RE ELSE ZERO OUT A REG S20201 47300020 IC RE,DCBNCP GET NUMBER OF IOBS S20201 47330020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 47360020 * READY S20201 47390020 BNO SOP260 BRANCH IF NO, SINCE CHP S20201 47420020 * AL- S20201 47450020 * READY HAS FUNCTION 47480020 * INCORPORATED IN CHANNEL PROG 47510020 * THE READ CHANNEL PROGRAMS WHICH HAVE JUST BEEN GENERATED MUST BE 47600019 * MODIFIED IF THE DCB IS BEING OPENED FOR OFFSET READ. 47700019 * 47800019 USING CPDEF,CPR 47900019 TM DCBBFTEK,BFTEKR OFFSET READ 48000019 BZ SOP2END NO--BRANCH 48100019 SR RF,RF CLEAR FOR IC 48400019 IC RF,DCBOFFSR OFFSET TO READ CCW 48500019 LA RF,L1CCW(RF) INCREMENT 48600019 STC RF,DCBOFFSR UPDATE OFFSET 48700019 SOP260 EQU * 49000019 LA CPR,IOBLNGTH(RB) ADDR OF CHANNEL PROG 49100019 TM JFCBMASK+D6,NORCDRY IS IT RPS S20201 49120020 BNO SOP2ENDX YES INITIALIZE COUNT S20201 49140020 * FIELD S20201 49160020 * 49200019 * THE TOTAL EFFECT OF THE NEXT THREE INSTRUCTIONS IS TO PUSH 49300019 * THE EXISTING CCW'S DOWN TO MAKE ROOM FOR AN EXTRA CCW AT THE 49400019 * BEGINNING OF THE CHANNEL PROGRAM. 49500019 MVC CPRDKD(L3CCW),CPTIC1 49600019 MVC CPTIC2(L2CCW),CPNOP1 49610019 MVC CPSCH(L5CCW),CPTIC2 49800019 * 49900019 MVI NOP1CC,CCWNOP NOP COMMAND 50000019 OI NOP1FLAG,CC CHAIN CCW 50100019 L RF,CPTIC1 FIRST TIC 50200019 LA RF,L1CCW(RF) UPDATE DATA ADDR 50300019 ST RF,CPTIC1 50400019 MVI CPTIC1,TIC TIC COMMAND 50500019 L RF,CPTIC2 SECOND TIC 50600019 LA RF,L1CCW(RF) UPDATE DATA ADDR 50700019 ST RF,CPTIC2 50800019 MVI CPTIC2,TIC TIC COMMAND 50900019 MVI NOP2CC,CCWNOP NOP COMMAND 51000019 L RF,NULL(RB) NEXT IOB ADDR 51010019 LA RF,K104(RF) AREA TO READ COUNT INTO 51100019 ST RF,RCTDATAD STORE IN READ COUNT CCW 51200019 NI RCTFLAGS,SLIBIT TURN OFF SLI BIT 51300019 MVI RCTBYTCT+ONE,L'CPCOUNT READ ENTIRE COUNT FIELD 51400019 MVI RCTCC,RDC RESTORE COMMAND CODE 51500019 SOP2ENDX EQU * S20201 51550020 TM DCBRECFM,STANDRDF IS THIS FS FORMAT XA02057 51560003 BO SOP2ENDY YES, DON'T INIT BLOCK XA02057 51570003 * ID, CAUSE IT ISN'T THERE 51590003 MVC CPCOUNT(K5),K43(RB) FIRST BLOCK ID 51600019 SOP2ENDY EQU * XA02057 51650003 L RB,NULL(RB) NEXT IOB 51700019 BCT RE,SOP260 NEXT CHANNEL PROG 51800019 SOP2END EQU * 51900019 * 52000019 * 52100019 *********************************************************************** 52200019 TM DCBDSORG,POBIT DCB FOR PO 52300019 BZ SOP2ENDA NO, BRANCH 52400019 * 52500019 MVI DCBCNTRZ,QSAMZ DM0I 52600019 * 52700019 SOP2ENDA EQU * 52800019 * 52900019 L RB,DCBIOBA GET FIRST IOB 53000019 OI NULL(RB),FIRSTIOB SET INDICATOR ON FOR CLOSE 53100019 LR RC,RB SAVE ADDR FOR QSAM USE 53200019 TM DCBRECFM,FORMATV VARIABLE FORMAT DM0I 53300019 BZ SOP2STOP BRANCH NOT V FORMAT DM0I 53400019 TM DCBRECFM,FORMATF FIXED FORMAT DM0I 53500019 BO SOP2STOP YES, BRANCH DM0I 53600019 MVC NULL(K5,RWTGC),SOPSLDVT VARIABLE, GET 1915 DM0I 53700019 B RELOOP BACK TO MAIN LINE DM0I 53800019 SOP2STOP EQU * 53900019 MVC NULL(K5,RWTGC),SOPSLDFT GET LOAD EXEC 54000019 * 54100019 RELOOP LA RWTGC,WGOFF(RE,RWTGC) INCREMENT CURR WTG ENTRY 54200019 LA RPARC,PLOFF(NULL,RPARC) INCR CURRENT DCB ENTRY PRTR 54210019 CLC NULL(L'AMIDCNST,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 54400019 BCR RWTGC,RBASE BACK TO OPEN CONTROL ROUTINDM0I 54500019 * 54600019 CLC NULL(L'OPIDCNST,RWTGC),OPIDCNST END OF TABLE 54700019 BNE RELOOP NO,CHECK NEXT ENTRY 54800019 * 54900019 LR RPARC,RPAR 55000019 LA RWTGC,WAOFF(NULL,RWTG) REINITIALIZE WTG LIST PTR 55100019 ZCHEK CLI NULL(RWTGC),NULL IS THIS ENTRY COMPLETE 55200019 BNE TCTLRTN IF NOT TRANSFER CONTROL 55300019 * 55400019 LA RWTGC,WGOFF(NULL,RWTGC) GET NEXT ENTRY 55500019 LA RPARC,PLOFF(NULL,RPARC) 55600019 B ZCHEK TO ZERO CHECK DM0I 55700019 * 55800019 TCTLRTN EQU * 55900019 MVC K6(K2,RWTG),NULL(RWTGC) STORE ID IN WTG TABLE 56000019 MVC K14(K3,RWTG),K2(RWTGC) MOVE TTR INTO TABLE 56100019 * 56200019 * 56300019 ******************************************************************** 56400019 * 56500019 LA RJ,DXXCTL SET UP FOR XCTL S21042 56600021 ** 56700019 XCTL DE=(RWTG),SF=(E,(15)) 56800019 ** 56900019 * 57000019 ********************************************************************* 57100019 * 57200019 * THE FOLLOWING CODE SET UP THE CCW WITH COUNT AND ADDRESS. 57300019 SOP2QBF EQU * 57400019 LR RE,RJ 57500019 L RTIOT,DCBBUFCB 57600019 L RJ,NULL(RTIOT) 57700019 LTR RJ,RJ VALID BUFFER ADDRESS M1552 57800019 BE BUFERR NO, BRANCH TO ABEND M1552 57900019 MVC ONE(K3,RF),ONE(RTIOT) 58000019 MVC ONE(K3,RTIOT),ONE(RJ) 58100019 MVC K6(L'DCBBLKSI,RF),DCBBLKSI 58200019 LR RJ,RE 58300019 BR RJ EXIT DM0I 58400019 * 58500019 ********************************************************************** 58600019 * * 58700019 BUFERR EQU * M1552 58800019 DMABCOND OABD064,PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X58900021 CALL PROBLEM DETERMINATION 59000021 B TCTLRTN S21042 59100021 WAOFF EQU 32 59200019 PLOFF EQU 4 OFFSET OF DCB ENTRIES 59300019 WGOFF EQU 8 OFFSET OF WTG ENTRIES 59400019 OPIDCNST DC C'0S' ID DM0I 59500019 AMIDCNST DC C'1O' ID DM0I 59600019 * 59700019 *********************************************************************** 59800019 * CONSTANTS AND RESERVED STORAGE. 59900019 * 60000019 * 60100019 SXTEN DC H'16' SIXTEEN DM0I 60200019 CONONE DC H'1' CONSTANT OF ONE S20201 60300020 * 60400019 * 60500019 * 60600019 * 60700019 * 60800019 * 60900019 * 61000019 * 61100019 * 61200019 XCTLTABL ID=(SOPSLDFT,10,SOPSLDVT,15,PDLOAD,6M),SVC=019 S21042 61600021 * 62000019 * 62100019 CPDEF DSECT OFFSET READ CHANNEL PROG 62200019 CPNOP1 DS 0D NOP OR SET SECTOR 62300019 NOP1CC DS 0X COMMAND CODE 62400019 NOP1DATA DS A DATA ADDR 62500019 NOP1FLAG DS BL1 FLAGS 62600019 DS 1X NOT USED 62700019 NOP1BYTC DS 2X BYTE COUNT 62800019 CPSCH DS D SEARCH ID EQUAL 62900019 CPTIC1 DS D TIC TO SEARCH 63000019 CPTIC2 DS D TIC TO READ COUNT 63100019 CPRDCNT DS 0D READ COUNT 63200019 RCTCC DS 0X COMMAND CODE 63300019 RCTDATAD DS A DATA ADDR 63400019 RCTFLAGS DS BL1 FLAGS 63500019 DS 1X NOT USED 63600019 RCTBYTCT DS 2X BYTE COUNT 63700019 CPRDKD DS 0D READ (KEY) DATA 63800019 RKDCC DS 0X COMMAND CODE 63900019 RKDDATAD DS A DATA ADDR 64000019 RKDFLAGS DS BL1 FLAGS 64100019 DS 1X NOT USED 64200019 RKDBYTCT DS 2X BYTE COUNT 64300019 CPNOP2 DS 0D NOP OR READ SECTOR 64400019 NOP2CC DS 0X COMMAND CODE 64500019 NOP2DATA DS A DATA ADDR 64600019 NOP2FLAG DS BL1 FLAGS 64700019 DS 1X NOT USED 64800019 NOP2BYTC DS 2X BYTE COUNT 64900019 CPCOUNT DS D FIELD TO READ COUNT INTO 65000019 IECDSECS DCB,MAIN,EXPAND=YES S21042 65100021 DCBCNTRZ EQU DCBCNTRL+1 DM0I 65200019 DCBCNTRX EQU DCBCNTRL+3 DM0I 65300019 CVT DSECT 65400019 CVT 65500019 * 65600019 * 65700019 * DATA EXTENT BLOCK 65800019 CNOP 0,4 FULL WORD ALIGN DM0I 65900019 BLDEB DSECT 66000019 DEBNMSUB DS 0CL1 NO. OF SUB. DM0I 66100019 DEBTCBAD DS CL4 TCB ADDR. DM0I 66200019 DEBAMLNG DS 0CL1 ACCESS METHOD LEN. DM0I 66300019 DEBDEBAD DS CL4 DEB ADDR. DM0I 66400019 DEBOGLGS DS 0CL1 OPTION DM0I 66500019 DEBIRBAD DS CL4 IRB ADDRESS DM0I 66600019 DEBOPATB DS 0CL1 OPTION DM0I 66700019 DEBSYSPG DS CL4 SYS ABEND DM0I 66800019 DEBNMEXT DS 0CL1 NO. OF EXTENT DM0I 66900019 DEBUSRPG DS CL4 USER PROG. DM0I 67000019 DEBPRIOR DS 0CL1 PRIORITY DM0I 67100019 DEBECBAD DS CL4 ECB ADDRESS. DM0I 67200019 DEBPROTG DS 0CL1 PROTECTION KEY DM0I 67300019 DEBDEBID DS 0CL1 DEB ID DM0I 67400019 DEBDCBAD DS CL4 DCB ADDRESS DM0I 67500019 DEBEXSCL DS 0CL1 EXCEPTION DM0I 67600019 DEBAPPAD DS CL4 APPENDAGE ADDRESS DM0I 67700019 DEBDVMOD DS 0CL1 DEVICE DM0I 67800019 DEBUCBAD DS CL4 UCB ADDRESS DM0I 67900019 DEBBINUM DS CL2 BIN NUMBER DM0I 68000019 DEBSTRCC DS CL2 START CYC. DM0I 68100019 DEBSTRHH DS CL2 START TRACK DM0I 68200019 DEBENDCC DS CL2 END CYCLINDER DM0I 68300019 DEBENDHH DS CL2 END TRACK DM0I 68400019 DEBNMTRK DS CL2 NO. OF TRACKS DM0I 68500019 TITLE 'IGG0191O--FORMAT OF GOTTEN CORE' 68600019 * 68700019 * 68800019 END 69100019 ./ ADD SSI=04010303,NAME=IGG0191P,SOURCE=0 TITLE 'IGG0191P OPEN EXECUTOR (D/A UPDATE)' 00020000 COPY LCGASMSW Y01021 00020400 IGG0191P CSECT 00020520 * RELEASE 19 DELETIONS 00024000 *1022120600,121200,121600 S19015 00024519 * RELEASE 20 DELETIONS 00025000 *2960001600-002200,004200,032800,053200-112200,120600-121600 S20201 00025520 * RELEASE 21 DELETIONS 00026000 * 026600,036800,039400,040000,040600 A31983 00026421 * SA53279 00036421 * RELEASE 1 DELETIONS 00038403 * XA02835 00038803 *STATUS CHANGE LEVEL 007 00040003 *FUNCTION/OPERATION- THIS ROUTINE WILL SET UP A CODE IN THE DCBCNTRL 00060000 * FIELD FOR IGG01912. IGG01912 (LOAD EXECUTOR) WILL DETERMINE 00080000 * FROM THIS CODE WHICH ROUTINES WILL BE BROUGHT INTO CORE AT 00100000 * OPEN TIME. IT WILL DETERMINE HOW MANY IOB'S ARE TO BE CREATED, 00120000 * USE 'GETMAIN' TO GET CORE FOR THE IOB'S, AND CLEAR THE CORE. 00140000 * 00240000 *ENTRY POINTS- ENTERED FROM IGG0191B BY USE OF THE XCTL MACRO. 00260000 * 00280000 *INPUT- SEE DESCRIPTION OF REGISTERS, DCB(USERS). 00300000 * 00320000 *OUTPUT & IOB(USER)- SEE DESCRIPTION OF REGISTERS, DCB(USERS). 00340000 * 00360000 *EXTERNAL ROUTINES- NONE. 00380000 * 00400000 *EXITS NORMAL-XCTL TO IGG0191Z FOR RECORD READY 00410020 * XCTL TO IGG0196P FOR NON RECORD READY 00420020 * 00440000 *EXITS-ERROR- NONE. 00460000 * 00480000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00500000 * 00520000 * BYTE 0-7 NAME 00540000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00560000 * BYTE 11 CONCATENATION NUMBER 00580000 * BYTE 12 ZERO 00600000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00620000 * ALIAS INDICATOR 1 BIT 00640000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00660000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00680000 * BYTE 17 ZERO 00700000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00720000 * BYTE 20 TRANSLATION TABLE 00740000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00760000 * BYTE 22-23 ATTRIBUTES 00780000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00800000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00820000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00840000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00860000 * BYTE 32-36 IDTTR OF EXECUTOR FOR FIRST DCB 00880000 * BYTE 37-39 WORKAREA ADDRESS FOR FIRST DCB 00900000 * BYTE 40- TABLE OF IDTTR'S 00920000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (5 BYTES) 00940000 * WORKAREA ADDRESS FOR N TH DCB (3 BYTES) 00960000 * IDTTR OF LAST ROUTINE LOAD (5 BYTES) 00980000 * NOT USED (3 BYTES) 01000000 * 01020000 * SEE DEVICETB DSECT 01040000 * 01060000 *ATTRIBUTES- REENTRANT,REUSABLE. 01080000 * 01100000 * 01120000 *********************************************************************** 01140000 * 01160000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01180000 * 01200000 *********************************************************************** 01220000 * 01240000 RDCB EQU 2 DCB REGISTER 01260000 RBASE EQU 3 BASE REGISTER 01280000 RCORE EQU 4 WORK AREA ADDRESS 01300000 RPAR EQU 5 TOP OF PARAMETER LIST 01320000 RWTG EQU 6 TOP OF WTG TABLE 01340000 RPARC EQU 7 CURRENT PARAMETER 01360000 RWTGC EQU 8 CURRENT TRANS LOAD 01380000 RTIOT EQU 9 WRK REG AND COMM VECTOR ADDR. 01400000 RUCB EQU 10 COUNTER IN IOB GENERATION 01420000 RDEB EQU 11 DEB ADDRESS 01440000 RB EQU 12 WORK REG1 ** 01460000 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 01480000 RD EQU 14 WORK REG3 ** 01500000 RJ EQU 15 WORK REG4 01520000 RE EQU 0 WORK REG5 01540000 RF EQU 1 WORK REG6 01560000 * 01580000 *********************************************************************** 01600000 * 01620000 * MASKS FOR ACCESS METHODS IN SAM 01640000 * 01660000 QSAMB EQU X'01' 01680000 * 01700000 * 01720000 *********************************************************************** 01740000 * 01760000 * MASKS FOR MACRO'S TO BE USED 01780000 * 01800000 POINTB EQU X'04' 01820000 * 01840000 *********************************************************************** 01860000 * 01880000 * DCB OFFSET CONSTANTS 01900000 * 01920000 WCPO EQU 48 01940000 WCWCPL EQU 7 NO. OF CCW'S IN WRITE CHANNEL 18445 01946000 * PROGRAM IF WRITE CHECK IS SPECIFIED 18445 01952000 WCPL EQU 3 01960000 OFFSR EQU 112 01980000 WCOFFSR EQU 144 OFFSET OF READ CCW FROM START OF 18445 01990000 * IOB PREFIX IF WRITE CHECK IS 18445 02000000 * SPECIFIED WITH QSAM 18445 02010000 OFFSW EQU 64 02020000 OFFSRB EQU 104 02040000 WRTCKL EQU 32 LENGTH OF WRITE CHECK SECTION OF 18445 02050000 * WRITE CHANNEL PROGRAM 18445 02060000 WCOFFSRB EQU 136 OFFSET OF READ CCW FROM START OF 18445 02070000 * IOB PREFIX IF WRITE CHECK IS 18445 02080000 * SPECIFIED WITH BSAM 18445 02090000 * 02100000 *********************************************************************** 02120000 * 02140000 * MASKS USED TO TEST OPTION FIELDS IN DCB 02160000 * 02180000 DOUBLE EQU X'01' 02200000 WRTCK EQU X'80' 02220000 UPDATEB EQU X'80' 02240000 TRKOVFLB EQU X'20' TRACK OVERFLOW OPTION 02260000 * 02280000 *********************************************************************** 02300000 * 02320000 * COMMAND BYTES FOR THE 2841 02340000 * 02360000 * CONTROL UNIT 02380000 * 02400000 SEEK EQU X'0B' 02420000 SRCHE EQU X'31' 02440000 RDC EQU X'92' 02460000 RDD EQU X'86' 02480000 RDDX EQU X'06' 02500000 TIC EQU X'08' 02520000 WRTD EQU X'05' 02540000 WRTKD EQU X'0D' 02560000 RDKD EQU X'8E' 02580000 * 02600000 *********************************************************************** 02620000 * 02640000 NRECREDY EQU X'20' NON RECORD READY MASK S20201 02641020 UFORMAT EQU X'C0' UFORMAT S20201 02642020 TRKOVFL EQU X'20' TRACK OVERFLOW OPTION S20201 02643020 ZERO EQU 0 S20201 02644020 TWO EQU 2 TWO S20201 02645020 THREE EQU 3 THREE S20201 02646020 FOUR EQU 4 FOUR S20201 02647020 FIVE EQU 5 S20201 02648020 SIX EQU 6 SIX S20201 02649020 EIGHT EQU 8 EIGHT S20201 02650020 NINE EQU 9 S20201 02651020 TWENTY4 EQU 24 CONSTANT OF 24 S20201 02652020 FSTDX EQU X'88' FIXED STANDARD BIT SA53279 02653021 QIOBCP EQU 128 QSAM IOB + CHAN PGM LEN A31983 02655021 BIOBCP EQU 120 BSAM IOB + CHAN PGM A31983 02659421 NOSKCYL EQU 24 WRT CHK AND NOT TRK OVFL A31983 02666621 SKCYLCCW EQU 8 WRT CHK AND TRK OVFLOW A31983 02668621 * CHANNEL CONTROL WORD FLAGS 02673321 * 02680000 SLI EQU X'20' 02700000 CC EQU X'40' 02720000 SLICC EQU X'60' 02740000 CCSK EQU X'50' 02760000 SLICCSK EQU X'70' 02780000 * 02800000 *********************************************************************** 02820000 * 02840000 * MASKS FOR RECORD FORMATS 02860000 * 02880000 FORMATU EQU X'C0' 02900000 * 02920000 *********************************************************************** 02940000 * 02960000 * OFFSET FOR PARAMETER TESTS 02980000 * 03000000 ONE EQU 1 03020000 NOT EQU X'FF' 03040000 * 03060000 *********************************************************************** 03080000 * 03100000 * MASKS FOR STATUS BITS TO BE TESTED 03120000 * 03140000 FIRSTIOB EQU X'01' 03160000 READONLY EQU X'20' IOB READ ONLY INDICATOR 03180000 * 03200000 *********************************************************************** 03220000 * 03240000 * MASKS USED TO LOAD IGG01915 IN SUPPORT OF QSAM LOCATE MODE OF 03242019 * OPERATION WITH LOGICAL RECORD INTERFACE FOR VARIABLE LENGTH 03244019 * SPANNED RECORD 03246019 * 03248019 FLGOFFST EQU 4 OFFSET TO FLAG IN BCB S19015 03250019 RAFLAG EQU X'80' RECORD AREA PRESENT S19015 03252019 NULL EQU 0 ZERO DISPLACEMENT S19015 03254019 IDLEN EQU 5 LENGTH OF IDTTR S19015 03256019 * 03260000 * 03282000 * 03284000 * 03286000 * 03288000 * 03290000 * 03292000 * 03294000 * 03296000 * 03298000 * 03300000 * 03320000 BALR RBASE,0 REG 3 IS BASE 03340000 USING SOPB,RBASE 03360000 USING IHADCB,RDCB REG 2 IS DCB 03380000 USING CVT,RTIOT REG 9 IS COMM VECTOR TABLE 03400000 USING FORCORE,RCORE REG 4 IS WORK AREA ADDRESS 03420000 USING BLDEB,RDEB REG 11 IS DEB 03440000 * 03460000 SOPB EQU * 03480000 L RDCB,0(RPARC) GET DCB ADDRESS 03500000 LA RDCB,0(RDCB) CLEAR HI BYTE 03520000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 03530001 L RDEB,DCBDEBAD GET DEB ADDRESS 03540000 .DEBCK10 ANOP Y01021 03550000 L RCORE,4(RWTGC) GET WORK AREA ADDRESS 03560000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 03570000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 03572000 .DEBCK20 ANOP Y01021 03574000 * 03580000 SR RC,RC READY A WORK REG 03600000 ST RC,DCBCNTRL CLEAR PARAMETER LINK FIELD 03620000 MVI DCBCNTRL+3,X'02' EOB RTN ID FOR LD EXEC 03640000 * 03660000 TM DCBRECFM,UFORMAT IS IT FORMAT U S20201 03662020 BM LAB01 NO, BRANCH AROUND S20201 03664020 TM DCBRECFM,TRKOVFL IS IT TRACK OVERFLOW S20201 03666020 BNO LAB01 BRANCH IF NOT S20201 03668020 OI JFCBMASK+SIX,NRECREDY S20201 03670020 LAB01 EQU * S20201 03672020 LA RF,QIOBCP QSAM IOB + CP LEN A31983 03682021 TM DCBCIND2,QSAMB QSAM USED 03700000 BC 1,SOPB12 BRANCH ON YES 03720000 * BSAM USED 03740000 TM DCBMACRF,POINTB NOTE POINT USED 03760000 BC 1,SOPB10 YES, BRANCH 03780000 TM DCBMACRF+1,POINTB NOTE POINT USED 03800000 BC 14,SOPB11 NO, BRANCH 03820000 * 03840000 SOPB10 EQU * 03860000 MVI DCBCNTRL+1,X'05' NPDT ID NUMBER 03880000 * 03900000 SOPB11 EQU * 03920000 LA RF,BIOBCP BSAM IOB + CP LEN A31983 03930021 * 03960000 SOPB12 EQU * 03980000 TM JFCBMASK+SIX,NRECREDY IS IT NON RECORD READY S20201 04002020 BO SOPB14 YES BRANCH AROUND REC S20201 04004020 * READY S20201 04006020 LA RF,TWENTY4(RF) INCREASE FOR RECORD S20201 04008020 * READY S20201 04010020 TM DCBRECFM,TRKOVFLB TRK OVFL SA53279 04012021 BO SOPB14 BRANCH YES SA53279 04014021 TM DCBRECFM,FSTDX FIXED STANDARD? SA53279 04014421 BO SOPB14 BRANCH YES SA53279 04014821 LA RF,EIGHT(RF) BUMP BY EIGHT S20201 04016020 SOPB14 EQU * S20201 04018020 TM DCBOPTCD,WRTCK WRITE CHECK USED 04020000 BC 14,SOPB20 NO, BRANCH 04040000 LA RF,NOSKCYL(RF) WRT CHK, NO TRK OVFLW A31983 04050021 TM DCBRECFM,TRKOVFLB TRK OVFLOW USED? A31983 04060021 BNO NOTRKOVF NO, DON'T ADD FOR SEEK A31983 04062021 * CYLINDER CCW A31983 04062421 LA RF,SKCYLCCW(RF) YES, ADD FOR SK CYL CCW A31983 04062821 NOTRKOVF EQU * A31983 04062921 TM JFCBMASK+SIX,NRECREDY IS IT NON RECORD READY S20201 04063020 BO SOPB20 YES BRANCH AROUND REC S20201 04066020 * READY S20201 04069020 LA RF,EIGHT(RF) INCREASE FOR RECORD S20201 04072020 * READY S20201 04075020 * 04080000 * AT THIS POINT RF=REG.1 CONTAINS THE LENGTH OF ONE IOB 04100000 * 04120000 SOPB20 EQU * 04140000 * 04160000 SRL RF,3 DIVIDE BY 8 (DOUBLE WORDS) 04180000 STC RF,DCBIOBL STORE 1 IOB LGN FOR CLOSE EXEC 04200000 SR RE,RE READY A WORK REG 04220000 TM DCBCIND2,QSAMB QSAM BEING USED 04240000 BC 14,SOPB21 NO, BRANCH 04260000 IC RE,DCBBUFNO OBTAIN NUMBER OF IOB'S TO BUILD 04280000 B SOPB22 04320000 * 04340000 SOPB21 EQU * 04360000 IC RE,DCBNCP OBTAIN NUMBER OF IOB'S TO BUILD 04380000 LTR RE,RE HAS NUMBER BEEN SPEC XA02835 04390003 BNZ SOPB22 BRANCH YES XA02835 04392003 LA RE,1 PROVIDE ONE XA02835 04394003 STC RE,DCBNCP STORE IN DCB XA02835 04396003 * 04420000 SOPB22 EQU * 04440000 LR RUCB,RE RUCB WILL BE USED AS A COUNTER 04560000 * 04580000 SLL RF,3 CONVERT IOB LENGTH TO BYTES 04600000 MR RE,RE COMPUTE TOTAL SPACE NEEDED 04620000 TM JFCBMASK+SIX,NRECREDY IS IT NON RECORD READY S20201 04622020 BO SOPB25 YES BRANCH AROUND S20201 04624020 LR RDEB,RF BYTES FOR IOB'S S20201 04626020 LR RB,RUCB S20201 04628020 LA RB,NINE(RB) S20201 04630020 SRL RB,THREE S20201 04632020 SLL RB,THREE S20201 04634020 AR RF,RB S20201 04636020 SOPB25 EQU * S20201 04638020 LR RD,RF SAVE FOR 04640000 LR RB,RF LATER USE 04660000 * 04680000 *********************************************************************** 04700000 * 04720000 GETMAIN R,LV=(RD),SP=250 04740000 * 04760000 *********************************************************************** 04780000 ** 04800000 * THIS SECTION CLEARS THE SPACE RECEIVED FROM GETMAIN 04820000 ** 04840000 *********************************************************************** 04860000 * 04880000 LR RJ,RB RESTORE LENGTH TO CLEAR 04900000 ST RF,DCBIOBA SAVE FIRST IOB ADDRESS 04920000 BCTR RJ,0 REDUCE AMT BT ONE 04940000 LA RB,255 GET MAX AMT CAN CLEAR 04960000 COMPARE CR RJ,RB IS AMT TO CLEAR GREATER 255 04980000 BC 12,ONECLEAR NO BRANCH 05000000 * 05020000 EX RB,CLEAR CLEAR 256 BYTES 05040000 SR RJ,RB SUBT 255 FROM AMT TO BE CLEARED 05060000 BCTR RJ,0 SUBT ONE MORE BYTE 05080000 LA RF,256(RF) UPDATE AREA ADDR BY 256 05100000 B COMPARE 05120000 * 05140000 CLEAR XC 0(1,RF),0(RF) ACTUAL CLEAR INSTRUCTION 05160000 * 05180000 ONECLEAR EX RJ,CLEAR CLEARS LESS THAN 256 05200000 * 05220000 L RB,DCBIOBA GET FIRST IOB ADDR 05240000 LR RC,RB SET UP WORK REG 05260000 LR RD,RB SET UP WORK REG 05280000 * 05300000 ST RUCB,ZERO(RB) STORE IOB COUNT S20201 05700020 TM JFCBMASK+SIX,NRECREDY IS THIS NON RECORD READY S20201 06100020 BO AROUND NO, FORGET RPS INSTRS S20201 06500020 AR RDEB,RB ADDR OF FIRST SECTOR S20201 06900020 * BYTE S20201 07300020 ST RDEB,FOUR(RB) STORE ADDR OF SECTOR1 S20201 07700020 LA RDEB,ONE(RDEB) ADDR OF SECTOR2 S20201 08100020 ST RDEB,EIGHT(RB) STORE ADDR S20201 08500020 MVC ZERO(FIVE,RWTGC),IGG0191Z S20201 08900020 B RELOOP BR AROUND INSTR FOR 6P S20201 09300020 AROUND EQU * S20201 09700020 MVC ZERO(FIVE,RWTGC),IGG0196P S20201 10100020 * 11240000 RELOOP EQU * 11260000 LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURR WTG ENTRY 11280000 LA RPARC,PLOFF(0,RPARC) INCR CURRENT DCB ENTRY PRTR 11300000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 11320000 BCR 8,RBASE 11340000 * 11360000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 11380000 BC 7,RELOOP NO,CHECK NEXT ENTRY 11400000 * 11420000 LR RPARC,RPAR 11440000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE WTG LIST PTR 11460000 * 11480000 ZCHEK EQU * 11500000 CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 11520000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 11540000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 11560000 LA RPARC,PLOFF(0,RPARC) 11580000 BC 15,ZCHEK 11600000 * 11620000 TCTLRTN EQU * 11640000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 11660000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 11680000 * 11700000 *********************************************************************** 11720000 * 11740000 LA 15,DXCCW12 SET UP FOR XCTL 11760000 ** 11780000 XCTL DE=(RWTG),SF=(E,(15)) 11800000 ** 11820000 * 11840000 *********************************************************************** 11860000 * 11880000 * 11900000 WAOFF EQU 32 11920000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 11940000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 11960000 OPIDCNST DC C'0S' 11980000 AMIDCNST DC C'1P' 12000000 * 12020000 * 12040000 ORG IGG0191P+1000 SET LOC CNTR TO XCTL TBL S20201 12050020 IGG0196P DC C'6P ' IDTTRL S20201 12060020 IGG0191Z DC C'1Z ' IDTTRL S20201 12070020 EOTM DC H'0' END OF TABLE MARKER S20201 12080020 ORG IGG0191P+1020 SET LOC CNTR TO OPEN SVC S20201 12090020 SVCCODE DC C'019' OPEN SVC CODE S20201 12100020 DWOFF DC AL1(125) DOUBLE WD OFFSET TO ID S20201 12110020 * TABL S20201 12120020 DCBD DSORG=PS 12180000 CVT DSECT 12200000 CVT 12220000 * 12240000 * DATA EXTENT BLOCK 12260000 CNOP 0,4 12280000 BLDEB DSECT 12300000 DEBNMSUB DS 0CL1 12320000 DEBTCBAD DS CL4 12340000 DEBAMLNG DS 0CL1 12360000 DEBDEBAD DS CL4 12380000 DEBOFLGS DS 0CL1 12400000 DEBIRBAD DS CL4 12420000 DEBOPATB DS 0CL1 12440000 DEBSYSPG DS CL4 12460000 DEBNMEXT DS 0CL1 12480000 DEBUSRPG DS CL4 12500000 DEBPRIOR DS 0CL1 12520000 DEBECBAD DS CL4 12540000 DEBPROTG DS 0CL1 12560000 DEBDEBID DS 0CL1 12580000 DEBDCBAD DS CL4 12600000 DEBEXSCL DS 0CL1 12620000 DEBAPPAD DS CL4 12640000 DEBDVMOD DS 0CL1 12660000 DEBUCBAD DS CL4 12680000 DEBBINUM DS CL2 12700000 DEBSTRCC DS CL2 12720000 DEBSTRHH DS CL2 12740000 DEBENDCC DS CL2 12760000 DEBENDHH DS CL2 12780000 DEBNMTRK DS CL2 12800000 TITLE 'FORMAT OF GOTTEN CORE' 12820000 * 12840000 * 12860000 FORCORE DSECT 12880000 IECDSECT 12900000 END 12920000 ./ ADD SSI=05011404,NAME=IGG0191Q,SOURCE=0 TITLE ' IGG0191Q - OPEN EXECUTOR FOR PCI SCHEDULING (TAPE-UR)' 00020000 COPY LCGASMSW Y01021 00020400 IGG0191Q CSECT 00021016 * RELEASE 16 DELETIONS 00022016 *3004 17073 00023016 * RELEASE 17 DELETIONS 00024016 *2139000600 17264 00024500 * RELEASE 18 DELETIONS 00025016 *3462054000,055600,074600-074800,092000-092200,111600 19768 00025518 *3462 MCS 00025718 *3462 26004 00025818 * RELEASE 19 DELETIONS 00026016 *2682082060-082120,090060-090120,091900,115200-115400 A27067 00026519 * RELEASE 20 DELETIONS 00027016 *0485130700,131400,131800 M6128 00027220 *0485002800,005000-005200,120400,130800 M5071 00027520 *0485130700 M5898 00027720 *0485120250 M6413 00027820 * RELEASE 21 DELETIONS 00028016 *1300 A45221 00028421 *1300107000-107600 A36955 00037521 * RELEASE 21.8 DELETIONS 00042021 *C111670 XA04419/YA03424/SA68191 00052021 *A083100,083120 XA03621/SA67354 00054021 *C084200 XA03621/SA67354 00054421 * 00055521 *STATUS CHANGE LEVEL 007 SA67354 00060021 * 00080000 *FUNCTION/OPERATION-- THIS ROUTINE GETS THE AMOUNT OF SPACE REQUIRED 00100000 * FOR THE MAIN IOB AND ICBS WITH THEIR CHANNEL 00120000 * PROGRAMS.TAPE AND URE ARE SUPPORTED BY THIS 00140000 * ROUTINE.THE ROUTINE ALSO GENERATES THE CHANNEL 00160000 * PROGRAMS REQUIRED,STORES THE ID'S OF THE EOB 00180000 * RTS NEEDED IN DCB(TEMPORARILY),AND INITIALIZES 00200000 * FIELDS IN THE DCB. 00220000 * 00240000 * 00260000 *ENTRY POINT: IGG0191Q BY XCTL FROM IGG0191T, IGG0191U, 00270020 * IGG0191V, IGG0193I, OR IGG0196B 00280020 * 00300000 *INPUT -- SEE DESCRIPTION OF REGISTERS,USER DCB,WHERE TO GO TABLE 00320000 * CURRENT ENTRY IN WHERE TO GO TABLE,USER PARAMETER LIST, 00340000 * CURRENT ENTRY IN PARAMETER LIST,AND OPEN'S 536 BYTE 00360000 * WORK AREA (SEE FORECORE DSECT) ASSOCIATED WITH EACH DCB 00380000 * 00400000 *OUTPUT -- ICBS AND CHANNEL PROGRAMS ,MAIN IOB ,DCB INITIALIZATION 00420000 * 00440000 *EXTERNAL RTS. NONE 00460000 * 00480000 *EXITS -- NORMAL-XCTL TO IGG01913, IGG01916 00500020 * ABNORMAL - XCTL TO IGG0191G WHEN PCI CANNOT BE SUPPORT 00520020 * 00540000 *TABLES -- SEE FORECORE DSECT ,DCB DSECT ; WHERE TO GO DSECT 00560000 * 00580000 * WHERE TO GO TABLE (WTG) 00600000 * 00620000 * BYTE 0-7 NAME 00640000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00660000 * BYTE 11 CONCATENATION NUMBER 00680000 * BYTE 12 ZERO 00700000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00720000 * ALIAS INDICATOR 1 BIT 00740000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00760000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00780000 * BYTE 17 ZERO 00800000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00820000 * BYTE 20 TRANSLATION TABLE 00840000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00860000 * BYTE 22-23 ATTRIBUTES 00880000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00900000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00920000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00940000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00960000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00980000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 01000000 * BYTE 36-39 TABLE OF IDTTR'S 01020000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01040000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01060000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01080000 * NOT USED (1 BYTE) 01100000 * 01120000 *ATTRIBUTES -- RE-ENTRANT,RE-USABLE,ENABLED, 01140000 * 01160000 * 01180000 * 01200000 *NOTES -- THIS EXECUTOR WILL XCTL TO IGG0191G IF PCI CANNOT BE 01220000 * SUPPORTED BUT THE USER IS CAPABLE OF RUNNING.------- 01240000 * 01260000 * 01280000 * 01300000 * 01320000 * 01340000 * 01360000 *********************************************************************** 01380000 * 01400000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01420000 * 01440000 *********************************************************************** 01460000 * 01480000 RDCB EQU 2 DCB REGISTER 01500000 RBASE EQU 3 BASE REGISTER 01520000 RCORE EQU 4 WORK AREA ADDRESS 01540000 RPAR EQU 5 TOP OF PARAMETER LIST 01560000 RWTG EQU 6 TOP OF WTG TABLE 01580000 RPARC EQU 7 CURRENT PARAMETER 01600000 RWTGC EQU 8 CURRENT TRANS LOAD 01620000 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECTOR ADDR. 01640000 RUCB EQU 10 USED HERE AS A COUNTER IN IOB GENERATION 01660000 RDEB EQU 11 DEB ADDRESS 01680000 RB EQU 12 WORK REG1 ** 01700000 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 01720000 RD EQU 14 WORK REG3 ** 01740000 RJ EQU 15 WORK REG4 01760000 RE EQU 0 WORK REG5 01780000 RF EQU 1 WORK REG6 01800000 * 01820000 * 01840000 PARAR EQU RPARC 01860000 * 01880000 *********************************************************************** 01900000 * 01920000 * 01940000 * 01960000 * MASKS FOR DEVICES TO BE SUPPORTED 01980000 * 02000000 * 02020000 * 02040000 TAPEB EQU X'80' 02060000 URBITS EQU X'40' 02080000 PRINTER EQU X'48' 02100000 R1442 EQU X'43' 02120000 PTBITS EQU X'50' 02140000 * 02160000 * 02180000 ********************************************************************* 02200000 * 02220000 * OPEN INDICATORS 02240000 * 02260000 RDBACK EQU X'01' 02280000 BKREAD EQU X'01' 02300000 INP EQU X'0F' 02320000 INOUT EQU X'07' 02340000 OUTP EQU X'0F' 02360000 * 02380000 ********************************************************************* 02400000 * 02420000 * OPERATIONS 02440000 * 02460000 WRITE EQU X'01' 02480000 READ EQU X'02' 02500000 READBACK EQU X'0C' 02520000 TIC EQU X'08' 02540000 NOP EQU X'03' 02560000 EOR EQU X'04' 02580000 * 02600000 ********************************************************************* 02620000 * 02640000 * 02660000 * MODES 02680000 * 02700000 MODE1 EQU X'80' 02720000 MODE2 EQU X'20' 02740000 STACK1 EQU X'01' 02760000 * 02780000 * 02800000 ********************************************************************* 02820000 * 02840000 * CCW FLAGS USED 02860000 * 02880000 CC EQU X'40' 02900000 CCPCI EQU X'48' 02920000 SLI EQU X'20' 02940000 SLICC EQU X'60' 02960000 SLIPCICC EQU X'68' 02980000 * 03000000 ********************************************************************* 03020000 * 03040000 * TEST INDICATORS 03060000 * 03080000 PCIB EQU X'20' 03100000 ASA EQU X'04' 03120000 FIRSTIOB EQU X'01' 03140000 ONE EQU X'01' 03160000 CNTRCHAR EQU X'00' 03180000 COMPLETE EQU X'60' 03200000 TRANS EQU X'7E' 03220000 ONONYES EQU X'0C' 03240000 ********************************************************************* 03280000 * OFFSET FOR PARAMETER TESTS 03300000 * 03320000 * 03340000 DISPSN EQU X'0' 03360000 FORTY EQU 40 03380000 FORTYATE EQU 48 03400000 FIFTY EQU 50 03420000 * 03440000 ********************************************************************* 03460000 * 03480000 * 03500000 * 03520000 * 03540000 ********************************************************************* 03560000 * 03580000 * MASKS FOR ACCESS METHODS IN SAM 03600000 * 03620000 QSAMB EQU X'01' 03640000 BSAMBIT EQU X'00' 03660000 * 03680000 * 03700000 * MASKS FOR MACRO'S TO BE USED 03720000 * 03740000 GETB EQU X'40' 03760000 PUTB EQU X'40' 03780000 READB EQU X'20' 03800000 WRITEB EQU X'20' 03820000 POINTB EQU X'04' 03840000 CNTRLB EQU X'02' 03860000 * 03880000 * 03900000 ********************************************************************* 03920000 * 03940000 * 03960000 * 03980000 * 04000000 * MASKS FOR BUFFER TECHNIQUE'S 04020000 * 04040000 EXCHANGB EQU X'10' 04060000 SIMPLEB EQU X'40' 04080000 * 04100000 ********************************************************************* 04120000 ********************************************************************* 04140000 * 04160000 * 04180000 * MODES OF OPERATION FOR QSAM 04200000 * 04220000 LOCATEB EQU X'08' 04240000 SUBSTUTB EQU X'04' 04260000 MOVEB EQU X'10' 04280000 * 04300000 * 04320000 ********************************************************************* 04340000 * 04360000 * 04380000 * MASKS FOR RECORD FORMATS 04400000 * 04420000 FORMUORF EQU X'80' FORMAT F OR U RECORDS A36955 04430021 FORMATF EQU X'80' 04440000 FORMATV EQU X'40' 04460000 FORMATU EQU X'C0' 04480000 * 04500000 FSTANDRD EQU X'88' 04520000 FIXBKD EQU X'90' 04540000 BLOCKED EQU X'10' 04560000 * 04580000 ********************************************************************* 04600000 * 04620000 * 04640000 ********************************************************************* 04660000 * 04682000 * 04684000 * 04686000 * 04688000 * 04690000 * 04692000 * 04694000 * 04696000 * 04698000 * 04700000 BALR RBASE,0 04720000 USING SOPC,RBASE 04740000 USING IHADCB,RDCB 04760000 USING FORCORE,RCORE 04780000 * 04800000 * 04820000 SOPC EQU * 04840000 * 04860000 SR RE,RE INITIALIZE 04880000 L RDCB,0(RPARC) GET DCB ADDRESS 04900000 LA RDCB,0(RDCB) CLEAR HI BYTE 04920000 L RCORE,4(RWTGC) GET WRK AREA ADDRESS 04940000 * 04960000 *********************************************************************** 04980000 * 05000000 SOPC001 EQU * 05020000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 05030001 L RDEB,DCBDEBAD 05040000 .DEBCK10 ANOP Y01021 05042000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 05044000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 05046000 .DEBCK20 ANOP Y01021 05048000 L RF,32(RDEB) GET UCB POINTER FROM DEB 05060000 TM 12(RF),X'80' TEST FOR SYSIN 05080000 BC 1,NOPCI IF SYSIN, PCI NOT PERMITTED 05100000 * 05120000 * 05140000 SOPC003 EQU * 05160000 * 05180000 * 05200000 * 05220000 TM 0(RPARC),X'0E' DCB OPENED FOR OUT/IN OR IN/OUT 05240000 BC 4,NOPCI YES BRANCH -- NO PCI SCHEDULE 05260000 * 05280000 BC 1,SOPC005 BRANCH IF OPENED FOR OUTPUT 05300000 * 05320000 TM DCBMACRF,CNTRLB IS CNTRL MACRO USED 05340000 BC 1,NOPCI YES BRANCH NO PCI SCHEDULE 05360000 * 05380000 LA RF,7 ICB SIZE IN DBL WRDS 19768 05400018 B SOPC007 05420000 * 05440000 SOPC005 EQU * 05460000 * 05480000 TM DCBMACRF+1,CNTRLB IS CNTRL MACRO USED 05500000 BC 1,NOPCI YES BRANCH NO PCI SCHEDULE 05520000 * 05540000 LA RF,8 ICB SIZE IN DBL WRDS 19768 05560018 * 05580000 SOPC007 EQU * 05600000 * 05620000 STC RF,DCBIOBL STORE ICB&CP LEN IN DBL.WRDS. 05640000 SLL RF,3 GET LENGTH IN BYTES 05660000 * 05680000 SR RE,RE 05700000 IC RE,DCBBUFNO GET BUFFER NUMBER--QSAM PARA. 05720000 TM DCBCIND2,QSAMB IS QSAM BEING USED 05740000 BC 1,SOPC013 YES BRANCH 05760000 * 05780000 TM DCBMACRF,POINTB IS NOTE/POINT TO BE USED 05800000 BC 1,SOPC009 YES BRANCH 05820000 TM DCBMACRF+1,POINTB IS NOTE/POINT TO BE USED 05840000 BC 8,SOPC011 NO BRANCH 05860000 * 05880000 SOPC009 EQU * 05900000 * 05920000 MVI DCBCNTRL+1,6 STORE PCI NOTE/POINT ID INDEX 05940000 TM DCBDEVT,TAPEB IS DCB USING TAPE 05960000 BC 1,SOPC011 YES BRANCH 05980000 * 06000000 MVI DCBCNTRL+1,10 STORE DUMMY RT ID INDEX VALUE 06020000 * 06040000 SOPC011 EQU * 06060000 * 06080000 IC RE,DCBNCP GET NUMBER OF ICBS TO GEN. 06100000 * 06120000 SOPC013 EQU * 06140000 * 06160000 LR RTIOT,RE SAVE NO. OF ICBS TO BUILD 06180000 * 06200000 LTR RE,RE WAS PARAMETER SPECIFIED 06220000 BC 8,NOPCI NO BRANCH CANT ASSUME NUMBER 06240000 CH RE,CONONE IS NCP EQUAL TO 1 06260000 * 06280000 BC 8,NOPCI YES BRANCH 06300000 * 06320000 MR RE,RE COMPUTE AMT SPACE REQ FOR ICBS 06340000 LA RF,48(RF) SPACE REQ FOR MAIN IOB 06360000 LR RB,RF SAVE AMT TO CLEAR 06380000 * 06400000 *********************************************************************** 06420000 * 06440000 * 06460000 * 06480000 *********************************************************************** 06500000 * 06520000 GETMAIN R,LV=(RF),SP=250 06540000 * 06560000 *********************************************************************** 06580000 * 06600000 * 06620000 LR RJ,RB RESTORE LENGTH TO CLEAR 06640000 ST RF,DCBIOBAD SAVE MAIN IOB ADDRESS 06660000 BCTR RJ,0 REDUCE AMOUNT BY ONE 06680000 LA RB,255 GET MAX AMT CAN CLEAR 06700000 COMPARE CR RJ,RB IS AMT TO CLEAR GREATER 255 06720000 BC 12,ONECLEAR NO BRANCH 06740000 * 06760000 EX RB,CLEAR CLEAR 256 BYTES 06780000 SR RJ,RB SUBT 255 FROM AMT TO BE CLEARED 06800000 BCTR RJ,0 SUBT ONE MORE BYTE 06820000 LA RF,256(RF) UPDATE AREA ADDR 06840000 B COMPARE TRY AGAIN 06860000 * 06880000 CLEAR XC 0(1,RF),0(RF) CLEAR INSTRUCTION 06900000 * 06920000 ONECLEAR EX RJ,CLEAR CLEARS LESS THAN 256 06940000 * 06960000 * 06980000 *********************************************************************** 07000000 L RB,DCBIOBAD GET MAIN IOB ADDRESS 07020000 LR RC,RB SET UP WORK REGS 07040000 LR RD,RB 07060000 * 07080000 * THIS SECTION OF CODE WILL BUILD THE MAIN IOB 07100000 * 07120000 * 07140000 * 07160000 LA RUCB,48(RB) POINT TO FIRST ICB 07180000 ST RUCB,8(RB) STORE IN MAIN IOB 07200000 LA RD,4(RB) POINT TO ECB IN MAIN IOB 07220000 * 07240000 MVI 0(RD),X'7F' POST MAIN IOB COMPLETE 07260000 * 07280000 * 07300000 LA RF,80(RB) POINT TO FIRST ICB CHANNEL PRG 07320000 * 07340000 STM RD,RDCB,20(RB) SAVE ECBAD,CP.AD,DCBAD. 07360000 * 07380000 * 07400000 MVI DCBWCPO,32 MOVE IN FIRST OFFSET AND 07420000 MVC DCBWCPL(3),DCBWCPO PROPAGATE THE BYTE ACROSS 07440000 IOBOFF MVI 2(RB),48 NOP OFFSET IN IOB 19768 07460018 MVI 3(RB),48 NOP OFFSET IN IOB 19768 07480018 * 07500000 OI 16(RB),CC INDICATE COMMAND CHAINING A27067 07510019 * 07520000 * ASSUME TAPE OR CARD READER CHANNEL PROGRAM FOR OFFSETS STORED 07540000 * 07560000 LA RB,48(RB) POINT TO FIRST ICB 07580000 ST RB,DCBIOBA SAVE ADDRESS FOR SUBROUTINES 07600000 LR RC,RB COPY ICB ADDRESS 07620000 * 07640000 * DURING THE FOLLOWING LOOP, RB 07660000 * MUST REMAIN INTACT FOR IT IS 07680000 * NEEDED TO PUT LINK ADDRESS IN 07700000 * 1ST ICB. 07720000 * 07740000 * 07760000 * 07780000 * ICB CONSTRUCTION BEGINS AT THIS POINT 07800000 * 07820000 * 07840000 ICBLOOP EQU * 07860000 * 07880000 LTR RTIOT,RTIOT HAVE ALL ICBS BEEN GENERATED 07900000 BC 8,SOPCEND YES BRANCH 07920000 * 07940000 ST RC,0(RB) 07960000 LR RB,RC LINK LAST ICB TO CURRENT ICB 07980000 LA RC,4(RB) UPDATE LAST ICB POINTER 08000000 ST RC,12(RB) POINT TO ICBS ECB 08020000 MVI 4(RB),X'7F' SAVE IN ECB SLOT 08040000 LA RC,32(RB) POST ICB COMPLETE 08060000 ST RC,24(RB) POINT TO CP START ADDR 08080000 * SAVE IN ICB CP STARTAD 08100000 * NORMAL ICB HAS BEEN GENERATED 08120000 * 08140000 TM DCBDEVT,TAPEB DCB USING TAPE 08160000 BC 1,SOPC043 YES BRANCH 08180000 * 08200000 TM 0(RPARC),OUTP DCB FOR OUTPUT 08220000 BC 8,SOPC029 NO BRANCH 08240000 * 08260000 * SUPPLY AUTOMATIC UNBLOCKING FUNCTION FOR QSAM U.R. OUTPUT 08280000 * 08300000 TM DCBRECFM,DCBRECBR BLOCKED RECORDS SA67354 08310021 BZ SOPC023 NO, BRANCH SA67354 08312021 * 08320000 TM DCBCIND2,X'01' QSAM BEING USED FOR OUTPUT 08340000 BC 8,SOPC023 NO BRANCH 08360000 * 08380000 TM DCBRECFM,X'C0' U RECORDS BEING USED 08400000 BC 9,SOPC023 YES BRANCH SA67354 08420021 TM DCBRECFM,X'80' F RECORDS USED 08440000 BC 8,SOPC021 NO BRANCH 08460000 * 08480000 MVC DCBBLKSI(2),DCBLRECL FORCE UNBLOCKED RECORDS TOBE 08500000 * OUTPUTTO UNIT RECORD EQUIPMENT 08520000 * 08540000 SOPC021 EQU * 08560000 * 08580000 NI DCBRECFM,X'EF' TURN BLOCKED BIT OFF IF ON 08600000 OI DCBCIND1,DCBCNBRM SET BIT FOR CLOSE. MUST A45221 08610021 * KNOW BIT TURNED OFF. A45221 08630021 SOPC023 EQU * 08640000 * 08660000 ********************************************************************* 08680000 * 08700000 * 08720000 * 08740000 * 08760000 MVI 0(RC),NOP STORE NOP CMD BYTE 08780000 MVI 4(RC),CC SET CMD CHAIN FLAG 08800000 MVI 7(RC),ONE SAVE COUNT OF ONE 08820000 * 08840000 * NOP CCW HAS BEEN GENERATED FOR OUTPUT CHANNEL PROGRAM 08860000 * 08880000 LA RC,8(RC) UPDATE CCW POINTER 08900000 MVI 0(RC),X'01' STORE WRITE CMD BYTE 08920000 TM DCBRECFM,ASA ASA CHARACTERS USED 08940000 BC 8,SOPC025 NO BRANCH 08960000 * 08980000 MVI DCBCNTRL+3,4 SAVE DDB'S ID INDEX VALUE 09000000 B SOPC027 09020000 * 09040000 SOPC025 EQU * 09060000 * 09080000 MVI DCBCNTRL+3,3 SAVE DDA'S ID INDEX VALUE 09100000 * 09120000 SOPC027 EQU * 09140000 * 09160000 L RD,DCBIOBAD GET MAIN IOB ADDRESS 09180000 MVI 2(RD),56 NOP OFFSET IN IOB 19768 09200018 MVI 3(RD),56 NOP OFFSET IN IOB 19768 09210018 * 09240000 * 09260000 * 09280000 OI 4(RC),SLIPCICC SET SILI,PCI,AND CMD CHAIN FLG 09300000 TM DCBDEVT,PRINTER DCB USING PRINTER 09320000 BC 1,SOPC037 YES BRANCH 09340000 * 09360000 CLI DCBDEVT,X'43' 1442 BEING USED FOR OUTPUT 09380000 BC 7,SOPC031 NO BRANCH 09400000 * 09420000 OI 0(RC),X'80' TURN ON EJECT MOD. 09440000 B SOPC031 09460000 * 09480000 * 09500000 SOPC029 EQU * 09520000 * 09540000 OI 4(RC),X'68' SET PCI,SILI, CC FLAGS 09560000 MVI DCBCNTRL+3,2 STORE EPG2 INDEX VALUE 09580000 OI 0(RC),X'02' TURN ON READ CMD IN CCW 09600000 SOPC031 EQU * 09620000 * 09640000 TM DCBMODE,MODE1 PROCESSING EBCDIC CHARACTERS 09660000 BC 8,SOPC033 YES BRANCH 09680000 * 09700000 OI 0(RC),MODE2 SET COL BIN MOD ON IN CCW 09720000 SOPC033 EQU * 09740000 * 09760000 TM DCBSTACK,X'02' STACKER TWO SPECIFIED 09780000 BC 8,SOPC061 NO BRANCH 09800000 * 09820000 OI 0(RC),X'40' TURN STACKER TWO MOD ON 09840000 B SOPC061 09860000 * 09880000 * 09900000 SOPC035 EQU * 09920000 * BUILD NOP CCW 09940000 B SOPC061 09960000 * 09980000 * 10000000 SOPC037 EQU * 10020000 * 10040000 MVC 0(1,RC),DCBPRTSP STORE PRINTER CMD IF SPECIFIED 10060000 TM DCBRECFM,ASA ASA CHARACTERS USED 10080000 BC 8,SOPC039 NO BRANCH 10100000 * 10120000 MVI 0(RC),X'01' STORE PRINT SUPPRESS CMD BYTE 10140000 SOPC039 EQU * 10160000 CLI 0(RC),X'00' WAS PRINTER CMD GENERATED 10180000 BC 7,SOPC041 YES BRANCH 10200000 * 10220000 MVI 0(RC),X'09' SAVE PRINT CMD SPACE ONE LINE 10240000 * 10260000 SOPC041 EQU * 10280000 * 10300000 B SOPC061 10320000 * 10340000 SOPC043 EQU * 10360000 MVI DCBCNTRL+3,2 STORE EGP2'S ID VALUE 10380000 MVI 29(RB),X'01' SAVE INCREMENT VALUE 10400000 OI 4(RC),SLIPCICC SET SILI,PCI AND CMD CHAIN FLG 10420000 TM 0(RPARC),OUTP DCB FOR OUTPUT 10440000 BC 1,SOPC051 YES BRANCH 10460000 * 10480000 MVI 0(RC),X'02' STORE READ CMD BYTE 10500000 TM 0(RPARC),X'03' OPENED FOR BACKWARD INPUT 10520000 BC 9,SOPC045 NO BRANCH 10540000 * 10560000 MVI 0(RC),X'0C' SAVE RD BACK CMD BYTE 10580000 MVC 28(2,RB),NEGONE SAVE INCREMENT VALUE NEGATIVE 10600000 * 10620000 * 10640000 SOPC045 EQU * 10660000 * 10680000 * APAR 36955 RESULTED FROM A BAD APAR FIX (17073). THE A36955 10689021 * PROBLEM SYMPTOM WAS THAT THE SILI BIT WAS BEING LEFT ON FOR A36955 10698021 * FIXED UNBLOCKED RECORDS. A36955 10707021 TM DCBRECFM,FORMUORF TEST FOR FIXED OR A36955 10716021 * UNDEFINED A36955 10725021 BNO SOPC061 NO, MUST BE VARIABLE A36955 10734021 * AT THIS POINT RECORDS COULD BE EITHER UNDEFINED OR A36955 10743021 * FIXED. MUST TEST FURTHER. A36955 10752021 TM DCBRECFM,FORMATU RECORDS FORMAT U? A36955 10761021 BO SOPC061 A36955 10770021 * 10780000 * 10800000 SOPC047 EQU * 10820000 * 10840000 NI 4(RC),X'DF' TURN SILI FLAG OFF 10860000 B SOPC061 10880000 * 10900000 * 10920000 * 10940000 SOPC049 EQU * 10960000 * 10980000 * 11000000 * 11020000 SOPC051 EQU * 11040000 * 11060000 MVI 0(RC),X'01' SAVE WRITE CMD BYTE 11080000 * 11100000 SOPC061 EQU * 11120000 * 11140000 * 11143018 * THIS NOP MUST BE INSERTED TO INSURE A SIMULTANEOUS 11146018 * CHANNEL END DEVICE END INTERUPT IN THE EVENT THIS 11149018 * ICB'S CHANNEL PROGRAM IS RESTARTED BY THE ERPS 11152018 * 11155018 LA RC,8(RC) GET NEXT CCW 19768 11158018 MVI 0(RC),NOP NOP COMMAND CODE 19768 11161018 MVI 7(RC),ONE COUNT OF 1 IN CCW 19768 11164018 MVI 4(RC),SLICC CMD CHAIN & SLI FLAGS SA68191 11167021 * 11170018 LA RC,8(RC) POINT TO NOP/TIC 19768 11173018 * 11180000 LA RD,40(RC) POINT TO NEXT POSSIBLE ICB CP. 11200000 ST RD,0(RC) SAVE IN NOP/TIC CCW 11220000 MVI 0(RC),NOP SAVE CMD BYTE 11240000 OI 4(RC),X'20' SET SILI ON IN CCW 11260000 MVI 7(RC),ONE COUNT OF ONE IN CCW 11280000 LA RC,8(RC) POINT TO NEXT POSSIBLE ICB 11300000 BCTR RTIOT,0 DECREMENT ICB COUNTER 11320000 B ICBLOOP 11340000 * 11360000 * 11380000 ********************************************************************** 11400000 * 11420000 * 11440000 SOPCEND EQU * 11460000 * 11480000 * 11500000 * 11560000 L RD,DCBIOBA GET FIRST ICB ADDRESS 11580000 ST RD,0(RB) LINK FIRST ICB TO LAST ICB. 11600000 LA RE,32(RD) POINT TO ICB'S CP START AD. 11620000 LA RF,8 CONSTANT OF EIGHT 11640000 SR RC,RF POINT BACK TO LAST ICB'S NOP 11660000 ST RE,0(RC) STORE FIRST ICB'S CP AD IN NOP 11680000 MVI 0(RC),NOP RESTORE NOP CMD BYTE 11700000 * 11720000 OI DCBCIND2,X'04' SET TRUE PCI INDICATOR 11740000 * 11760000 * 11780000 * 11800000 L RDEB,DCBIOBAD PICK UP MAIN IOB ADDRESS 11820000 * 11840000 IC RF,2(RDEB) PICK UP NOP OFFSET 11860000 AR RD,RF GET NOP ADDRESS AND 11880000 ST RD,12(RDEB) STORE AS 'LAST NOP' IN MAINIOB 11900000 * 11920000 * 11940000 * 11960000 * GENERATION OF ICB'S AND CHANNEL PROGRAMS ARE COMPLETE 11980000 * 12000000 * 12020000 TM DCBRECFM,X'48' VARIABLE SPANNED RECS? M6413 12025020 BO LOAD1916 YES, XCTL TO 1916 M5071 12030020 MVC 0(5,RWTGC),SOPSLDFT NO, XCTL TO 1913 M5071 12035020 B RELOOP M5071 12040020 LOAD1916 EQU * M5071 12045020 MVC 0(5,RWTGC),SOPS1916 M5071 12050020 * 12060000 * 12080000 *********************************************************************** 12100000 * 12120000 * 12140000 RELOOP LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURR WTG ENTRY 12160000 LA RPARC,PLOFF(0,RPARC) INCR CURRENT DCB ENTRY PRTR 12180000 CLC 0(2,RWTGC),AMIDCNST THIS RT NEEDED AGAIN 12200000 BCR 8,RBASE 12220000 * 12240000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE 12260000 BC 7,RELOOP NO,CHECK NEXT ENTRY 12280000 * 12300000 LR RPARC,RPAR 12320000 LA RWTGC,WAOFF(0,RWTG) REINITIALIZE WTG LIST PTR 12340000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 12360000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 12380000 * 12400000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY 12420000 LA RPARC,PLOFF(0,RPARC) 12440000 BC 15,ZCHEK 12460000 * 12480000 TCTLRTN EQU * 12500000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 12520000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 12540000 * 12560000 LA 15,DXCCW12 SET UP FOR XCTL 12580000 ** 12600000 XCTL DE=(RWTG),SF=(E,(15)) 12620000 ** 12640000 * 12660000 ********************************************************************* 12680000 * 12700000 WAOFF EQU 32 12720000 PLOFF EQU 4 OFFSET OF DCB ENTRIES 12740000 WGOFF EQU 8 OFFSET OF WTG ENTRIES 12760000 OPIDCNST DC C'0S' 12780000 AMIDCNST DC C'1Q ' 12800000 NEGONE DC X'FFFF' 12820000 CONONE DC H'1' 12840000 * 12860000 * 12880000 *********************************************************************** 12900000 * 12920000 DS DS 0H 12940000 * 12960000 NOPCI EQU * 12980000 MVC 0(5,RWTGC),SOP5 MUST GO TO SOP5 EXECUTOR 13000000 B RELOOP 13020000 * 13040000 * 13060000 ORG IGG0191Q+1000 M6128 13066020 XCTLTABL EQU * BEGIN XCTL TABLE M6128 13072020 SOPS1916 DC C'16 ' IDTTRL OF IGG01916 M5071 13080020 SOPSLDFT DC C'13 ' 13100000 SOP5 DC C'1G ' 13120000 DC H'0' END OF TABLE MARKER M6128 13130020 ORG IGG0191Q+1020 POSITION TO END OF MODULE M6128 13140020 DC C'019' OPEN SVC CODE 13160000 DC AL1((XCTLTABL-IGG0191Q)/8) DOUBLEWORDS TO M6128 13170020 * START OF XCTL TABLE 13180020 * 13200000 * 13220000 DCBD DSORG=PS 13240000 * 13260000 IOBADD EQU DCBIOBA 13280000 TITLE 'FORMAT OF GOTTEN CORE' 13300000 FORCORE DSECT 13320000 IECDSECT 13340000 END 13360000 ./ ADD SSI=06010190,NAME=IGG0191R,SOURCE=0 TITLE 'IN/OUT,OUT/IN EXECUTOR DISK TAPE BSAM ' 00020000 COPY LCGASMSW Y01021 00020400 * RELEASE 16 DELETIONS * 00021000 *3004 17895 00021716 * RELEASE 17 DELETIONS * 00022000 *2264000215,000340,022600,022800,026800,027800,029200 MC0L 00022500 * RELEASE 18 DELETIONS * 00023000 *2967 21476 00023218 *2967 MCS 00023518 * RELEASE 19 DELETIONS * 00024000 *1020059630-059720 A25961 00024519 * RELEASE 20 DELETIONS * 00025000 *0972001600,016400,020200-020600,023800-030200,041400-041600, S20201 00025220 *0972046000-046200,055800-087400,091000-091200,093400-093600, S20201 00025420 *0972103600,104200 S20201 00025620 *0972090200 A40435 00025820 * RELEASE 21 DELETIONS * 00026000 * 055100-055200,091800,092200,092600-094800 A43732 00026421 * RELEASE 3, VS/1, CHANGES XA01824 00026503 *A030700,030720,030740,030760,030780,030784,030788 XA02035 00026803 *A016300,016400 XA02035 00026903 *D002700-002900 XA01824 00035603 *A045500-047579,016500-016520 XA01824 00037603 *STATUS CHANGE LEVEL 007 00043503 * 00046803 * THIS MOD SPLIT INTO MOD IGG0191X IN REL 20.1 A43732 00050103 * 00053403 *FUNCTION * 00056703 * 1 GET CORE FOR IOB'S AND DATA CHAINED CHANNEL PROGRAMS * 00060000 * 2 CLEAR CORE 00080000 * 3 CONSTRUCT IOBS 00100000 * 4 CONSTRUCT CHANNEL PROGRAMS FOR DISK OR TAPE 00120000 * 3 CLEAR CORE FOR THE ABOVE * 00140000 * 5 CONSTRUCT IOB'S OR ICB'S * 00180000 * * 00200000 *ENTRY POINT * 00220000 * IGG0191R BY XCTL 00240000 * * 00260000 *INPUT * 00280000 * SEE REGISTER DESCRIPTION,DCB * 00300000 * * 00320000 *OUTPUT * 00340000 * SEE REGISTER DESCRIPTION * 00360000 * * 00380000 * USERS DCB * 00400000 *EXTERNAL ROUTINES-NONE * 00420000 * * 00440000 *EXITS * 00460000 * NORMAL BY XCTL TO IGG01913 00480000 * NORMAL BY XCTL TO IGG0191J FOR DISK OR IGG0191G FOR TAPE 00500000 * WHEN ONE BUFFER IS SPECIFIED 00520000 * * 00540000 * ERROR-NONE * 00560000 * * 00580000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00600000 * 00620000 * BYTE 0-7 NAME 00640000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00660000 * BYTE 11 CONCATENATION NUMBER 00680000 * BYTE 12 ZERO 00700000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00720000 * ALIAS INDICATOR 1 BIT 00740000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00760000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00780000 * BYTE 17 ZERO 00800000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00820000 * BYTE 20 TRANSLATION TABLE 00840000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00860000 * BYTE 22-23 ATTRIBUTES 00880000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00900000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00920000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00940000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00960000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00980000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 01000000 * BYTE 36-39 TABLE OF IDTTR'S 01020000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01040000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01060000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01080000 * NOT USED (1 BYTE) 01100000 * * 01120000 *ATTRIBUTES * 01140000 * REENTRANT,REUSABLE * 01160000 *NOTES * 01180000 * ALL REG EQUATES HAVE AN 'R' AT BEGINNING OR END OF SYMBOL * 01200000 * * 01220000 RDCB EQU 2 DCB 01240000 RBASE EQU 3 BASE 01260000 RCORE EQU 4 WORK AREA ADDRESS 01280000 RPAR EQU 5 TOP OF PARAMETER LIST 01300000 RWTG EQU 6 TOP OF WTG TABLE 01320000 RPARC EQU 7 CURRENT PARAMETER 01340000 RWTGC EQU 8 CURRENT TRANSFER LOAD 01360000 RTIOT EQU 9 WORK REG & COMM VECTOR TABLE 01380000 * IOB COUNTER DURING IOB CONST * 01400000 RUCB EQU 10 BRANCH REG 01420000 RDEB EQU 11 01440000 RB EQU 12 01460000 RC EQU 13 BUFFER ADDRESS 01480000 RD EQU 14 01500000 RJ EQU 15 CCW ADDRESS 01520000 RE EQU 0 BLOCKING FACTOR DURING CHP CONST 01540000 RF EQU 1 IOB ADDRESS 01560000 DOUBLE EQU X'02' 01580000 DISK EQU X'20' 01600000 FSTD EQU X'88' 01620000 POINTB EQU X'04' USED IN NOTE/POINT TEST XA02035 01630003 QSAMB EQU X'01' USED FOR QSAM A.M. TEST XA02035 01640003 FORMUORF EQU X'80' RECFM F OR U XA01824 01650003 FORMATU EQU X'C0' RECFM U XA01824 01652003 * 01660000 ********************************************************************** 01680000 IGG0191R CSECT 01700000 * 01702000 * 01704000 * 01706000 * 01708000 * 01710000 * 01712000 * 01714000 * 01716000 * 01718000 * * 01720000 BALR RBASE,0 01740000 USING ENTRY1,RBASE 01760000 USING IHADCB,RDCB 01780000 USING FORCORE,RCORE 01800000 * * 01820000 ENTRY1 EQU * 01840000 * * 01860000 L RDCB,0(0,RPARC) DCB ADDRESS 01880000 L RCORE,0(0,RWTGC) LOAD WORKAREA ADDR Y01021 01890000 * * 01900000 *TEST FOR ONE BUFFER WHICH IS NOT ALLOWED WITH CHAINED SCHEDULING * 01920000 * * 01940000 CLI DCBNCP,X'01' IS NUMBER OF CHP ONE 01960000 BH A0000 NO-BRANCH 01980000 * YES XCTL * 02000000 * * 02080000 MVC 0(5,RWTGC),SOP5 ID FOR TAPE EXEC 02100000 B RELOOP XCTL 02120000 * * 02140000 * * 02160000 A0000 EQU * 02180000 OI DCBCIND2,X'04' SET PCI INDICATOR ON 02200000 * * 02220000 * * 02240000 MVI DCBIOBA,X'28' START TO SET NOP OFFSR MC0L 02260000 MVI DCBIOBA+1,X'38' START TO SET NOP OFFSR MC0L 02280000 LA RF,48 CNST 48 FOR PART OF MIOB LGTH 02300000 SR RD,RD CLEAR ACC REG 02320000 MVI DCBCNTRL+3,X'02' TAPE IN-OUT; DA IN EOB IDS 02340000 * * 02360000 * * 03040000 LA RD,64 LGTH OF ICB PLUS CHP FOR TAPE 03060000 TM DCBCIND2,QSAMB IS QSAM BEING USED XA02035 03070003 BO A0010 YES,BRANCH XA02035 03072003 TM DCBMACRF,POINTB NOTE/POINT REQ (INPUT) XA02035 03074003 BO A0005 YES,BRANCH XA02035 03076003 TM DCBMACRF+1,POINTB NOTE/POINT REQ (OUTPUT) XA02035 03078003 BNO A0010 NO,BRANCH XA02035 03078403 A0005 MVI DCBCNTRL+1,6 PCI NOTE/POINT ID INDEX XA02035 03078803 * * 03080000 A0010 EQU * 03100000 LR RB,RD COPY AMT 03120000 SRL RB,3 DETERMINE IOBL FOR CLOSE 03140000 STC RB,DCBIOBL PLACE IN IOBL 03160000 * * 03180000 SR RJ,RJ CLEAR REG 03200000 IC RJ,DCBNCP GET NUMBER OF CHP 03220000 MR RD,RD AMT SPACE NEEDED MINUS MIOB 03240000 * LENGTH * 03260000 AR RJ,RF TOTAL AMT OF SPACE NEEDED 03280000 LR RD,RJ SAVE LENGTH 03300000 * * 03320000 GETMAIN R,LV=(RJ),SP=250 03340000 * * 03360000 LR RC,RF SAVE ADDRESS RETURNED FROM 03380000 * GETMAIN FOR CLEARING * 03400000 * THIS SECTION CLEARS CORE * 03420000 * * 03440000 LR RJ,RD RESTORE LENGTH 03460000 LA RD,255 CONSTANT 255 03480000 BCTR RJ,0 REDUCE AMOUNT BY ONE 03500000 COMPARE EQU * 03520000 CR RJ,RD AMT TO CLEAR GREATER THAN 255 03540000 BC 12,ONECLEAR NO-BRANCH 03560000 EX RD,CLEAR CLEAR 256 BYTES 03580000 SR RJ,RD AMT TO CLEAR MINUS 255 03600000 BCTR RJ,0 SUBTRACT ONE MORE 03620000 LA RC,256(0,RC) UPDATE AREA ADDRESS 03640000 B COMPARE TRY AGAIN 03660000 * * 03680000 CLEAR EQU * 03700000 XC 0(1,RC),0(RC) CLEAR CORE 03720000 * 03740000 ONECLEAR EQU * 03760000 EX RJ,CLEAR CLEARS LESS THAN 256 03780000 * * 03800000 * CLEARING OF CORE FINISHED HERE RF EQUALS ADDRESS * 03820000 * * 03840000 ST RF,DCBIOBAD THIS IS MAIN IOB ADDRESS 03860000 LR RJ,RF COPY MIOB ADDRESS 03880000 *********************************************************************** 03900000 * START CONSTRUCTION OF MAIN IOB HERE * 03920000 *********************************************************************** 03940000 MVC 2(2,RF),DCBIOBA MOVE NOP OFFSETS TO MIOB 03960000 LA RE,4(0,RF) ECB ADDRESS 03980000 ST RE,20(0,RF) PLACE ADDRESS IN ECB POINTER 04000000 MVI 4(RF),X'7F' INDICATE COMP NO ERROR 04020000 LA RDCB,0(0,RDCB) CLEAR BYTE ZERO 04040000 ST RDCB,36(0,RF) PLACE DCB ADDRESS IN MIOB 04060000 * 04080000 MVC DCBOFFSR(2),OFFSETT TAPE OFFSR,OFFSW TO DCB 04100000 * * 04120000 * * 04180000 LA RD,80(0,RF) TAPE STARTAD 04200000 ST RD,32(0,RF) ADDRESS TO MIOB 04220000 LA RD,48(0,RF) FIRST ICB ADDRESS 04240000 A0020 EQU * ICB ADDRESS TO DCB 04260000 ST RD,DCBIOBA 04280000 ST RD,8(0,RF) FIRST ICBAD TO MIOB 04300000 LR RF,RD COPY ICB ADDRESS FOR FIRST TIME 04320000 SR RE,RE CLEAR REG 04340000 IC RE,DCBNCP NUMBER OF CHP FOR COUNTING 04360000 *********************************************************************** 04380000 * CONSTRUCT ICB HERE * 04400000 *********************************************************************** 04420000 A0025 EQU * 04440000 ST RD,0(0,RF) LINKAD TO ICB 04460000 * REDUNDANT FOR FIRST TIME 04480000 LR RF,RD NEW ADDRESS TO ICB REG 04500000 LA RD,4(0,RF) ECB ADDRESS 04520000 ST RD,12(0,RF) PLACE IN ICB 04540000 MVI 4(RF),X'7F' INDICATE COMP NO ERROR 04560000 * 04580000 * 04640000 MVI 29(RF),X'01' INC COUNT FOR TAPE 04660000 * * 04680000 * CCWS FOR TAPE HERE * 04700000 * * 04720000 MVI 36(RF),X'68' CC,SIL,PCI FLAGS TO CCW 04740000 SPACE 3 XA01824 04750003 * MAY WANT TO LEAVE SILI BIT ON, IF FORMAT F RECORDS 04752003 TM DCBRECFM,FORMUORF FIXED OR UNDEFINED XA01824 04754003 BNO A0100 VARIABLE, LEAVE SILI ON XA01824 04756003 TM DCBRECFM,FORMATU UNDEFINED ONLY XA01824 04758003 BO A0100 YES, LEAVE SILI ON XA01824 04758403 * MUST BE FIXED (BLOCKED OR UN- ), SO TURN OFF SILI BIT 04758803 NI 36(RF),X'DF' TURN OFF SILI BIT XA01824 04759203 SPACE 3 XA01824 04759603 A0100 EQU * XA01824 04759703 MVI 32(RF),X'02' READ CMND BYTE 04760000 * * 04780000 * * 04800000 * * 04820000 MVC 48(8,RF),32(RF) COPY READ CCW INTO WRITE CCW 04840000 MVI 48(RF),X'01' WRITE CMND BYTE 04860000 * * 04880000 * * 04900000 * * 04920000 LA RD,96(0,RF) NOP/TIC ADDRESS FOR CCW 04940000 ST RD,40(0,RF) PLACE ADDRESS IN CCW 04960000 MVI 44(RF),X'20' TURN ON SIL FLAG 04980000 MVI 47(RF),X'01' COUNT OF ONE 05000000 MVI 40(RF),X'03' NOP CMND BYTE 05020000 * * 05040000 * * 05060000 * * 05080000 LA RD,112(0,RF) NOP/TIC ADDRESS FOR CCW 05100000 ST RD,56(0,RF) PLACE IN CCW 05120000 MVC 60(4,RF),44(RF) COPY FLAG AND LGTH FROM NOP RD 05140000 MVI 56(RF),X'03' NOP CMND BYTE 05160000 * * 05180000 * * 05200000 * * 05220000 LA RD,64(0,RF) NXT ICB ADDRESS 05240000 * * 05260000 BCT RE,A0025 MORE ICBS TO MAKE BRANCH 05280000 * * 05300000 * * 05320000 L RD,DCBIOBA GET FIRST ICB ADDRESS 05340000 ST RD,0(0,RF) PLACE AS LAST LINK ADDRESS 05360000 LA RC,32(0,RD) FIRST RD CCW ADDRESS 05380000 ST RC,40(0,RF) PLACE IN LAST RD NOP 05400000 MVI 40(RF),X'03' SET CMND BYTE 05420000 * * 05440000 LA RC,48(0,RD) FIRST WR CCW ADDRESS 05460000 ST RC,56(0,RF) PLACE IN LAST WR NOP 05480000 MVI 56(RF),X'03' SET CMND BYTE 05500000 * * 05540000 *********************************************************************** 05560000 * * 08760000 * THIS FINISHES NOP/TIC ADDRESSES LAST NOW POINTS TO FIRST CHPS * 08780000 * * 08800000 * * 08820000 A0200 EQU * 08840000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 08850001 L RDEB,DCBDEBAD DEB ADDRESS 08860000 .DEBCK10 ANOP Y01021 08870000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 08872000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 08874000 .DEBCK20 ANOP Y01021 08876000 * RD EQUALS FIRST ICB ADDRESS * 08880000 * * 08900000 LA RC,56(0,RD) NOP ADDRESS FOR MIOB * 08920000 * WHEN OPENED FOR IN/OUT * 08940000 * DEVICE DISK OR FOR OUT/IN * 08960000 * WHEN A TAPE * 08980000 * * 09000000 TM 12(RDEB),X'07' IS DCB FOR OUT/IN? A40435 09020020 BC 1,A0220 YES BRANCH 09040000 * * 09060000 * * 09080000 * 09140000 LA RC,40(0,RD) LAST NOP ADDR FOR TAPE 09160000 A0220 EQU * A43732 09180021 ST RC,12(0,RJ) LAST NOP ON Q TO MIOB 09200000 * * 09240000 * * 09500000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09520000 XCTL EQU * 09540000 MVC 0(5,RWTGC),NXTEXEC XCTL TO LOAD EXECUTOR 09560000 * 09580000 RELOOP EQU * 09600000 L RCORE,4(0,RWTGC) LOAD RCORE BASE 09620000 LA RWTGC,8(0,RWTGC) INCREMENT CURR WTG ENTRY 09640000 LA RPARC,4(0,RPARC) INC CURRENT DCB ENTRY PTR 09660000 CLC 0(2,RWTGC),AMIDCNST Q- THIS RT NEEDED AGAIN 09680000 BCR 8,RBASE 09700000 * 09720000 CLC 0(2,RWTGC),OPIDCNST Q- END OF TABLE 09740000 BC 7,RELOOP NO-CHECK NEXT ENTRY 09760000 * 09780000 LR RPARC,RPAR 09800000 LA RWTGC,32(0,RWTG) REINIT WTG LIST PTR 09820000 ZCHEK EQU * 09840000 CLI 0(RWTGC),X'00' Q-IS THIS ENTRY COMPLETE 09860000 BC 7,TCTLRTN 09880000 * 09900000 LA RWTGC,8(0,RWTGC) GET NEXT ENTRY 09920000 LA RPARC,4(0,RPARC) 09940000 B ZCHEK 09960000 * 09980000 TCTLRTN EQU * 10000000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 10020000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 10040000 LA RJ,DXCCW12 SET UP FOR XCTL 10060000 * 10080000 XCTL DE=(RWTG),SF=(E,(15)) 10100000 * 10120000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10140000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10160000 * 10180000 AMIDCNST DC C'1R' THIS ID 10200000 OPIDCNST DC C'0S' END ID 10220000 OFFSET DC X'4005' WCPO,WCPL FOR DISK 10240000 * WCPL IN DOUBLE WORDS 10260000 OFFSETT DC X'2030' TAPE OFFSR,OFFSW 10280000 OFFSETD DC X'3058' DISK OFFSR,OFFSW 10300000 * 10320000 ORG IGG0191R+992 10340000 SOP5 DC C'1G ' TAPE SIMPLE BUFFR EXECUTOR 10380000 NXTEXEC DC C'13 ' PCI LOAD EXECUTOR ID 10400000 FILLER DC 7H'0' FILLER S20201 10420020 DC H'0' FLAG 10440000 DC C'019' SVC CODE 10460000 DC AL1(124) POINTER 10480000 DCBD DSORG=PS 10500000 FORCORE DSECT 10520000 IECDSECT 10540000 END 10560000 ./ ADD SSI=01010303,NAME=IGG0191S,SOURCE=0 MACRO 00020000 &NAME IF &A,&IS=,&ISNOT=,&GOTO= 00040000 LCLB &NOERR 00060000 &NOERR SETB 1 00080000 AIF ('&A' NE '').SKIP 00100000 MNOTE 'TEST ADDRESS NOT SPECIFIED.' 00120000 &NOERR SETB 0 00140000 .SKIP AIF ('&GOTO' NE '').SKIP2 00160000 MNOTE 'BRANCH ADDRESS MISSING.' 00180000 &NOERR SETB 0 00200000 .SKIP2 AIF ('&IS' NE '' OR '&ISNOT' NE '').SKIP3 00220000 MNOTE 'TEST CONDITION NOT SPECIFIED.' 00240000 &NOERR SETB 0 00260000 .SKIP3 AIF (&NOERR).SKIP4 00280000 MEXIT 00300000 .SKIP4 AIF ('&IS' EQ '').NOIS 00320000 *** 00340000 &NAME TM &A,&IS 00360000 BO &GOTO 00380000 *** 00400000 MEXIT 00420000 .NOIS ANOP 00440001 *** 00460000 &NAME TM &A,&ISNOT 00480000 BZ &GOTO 00500000 *** 00520000 MEND 00540000 TITLE 'IGG0191S, LEVEL 2 EXEC FOR D.A. WITH TRACK OVERFLOW.' 00550000 COPY LCGASMSW Y01021 00552000 IGG0191S CSECT 00560000 AIF ('&LIB' EQ 'LIB1').OSLIB CHECK SYSTEM 00562003 * VS1 RELEASE 03 DELETIONS 00562403 * XA02992 00562803 * XM4609 00562903 * XA02335 00564903 .OSLIB ANOP 00570303 * RELEASE 21 DELETIONS 00572303 *0083079040-080000 A37507 00577803 *3004058400,061800,067800-068200,068600,068800-069800,070600, S20201 00585203 *3004079000,080000 S20201 00592603 * REFER TO CODE FLAGGED XA02335 SA62466 00594621 *STATUS CHANGE LEVEL 002 00600001 * THIS EXECUTOR RUNS IN TANDEM WITH IGG0191H, WHICH GETS CORE FOR AND 00620000 * COMPLETES BUILDING THE IOB/CP'S. 00640000 * 00660000 * THE MAJOR FUNCTIONS OF THIS EXEC ARE- 00680000 * 00700000 * 1. STORE THE ID'S FOR THE EOB, NOTE/POINT ROUTINES REQ'D. 00720000 * 2. COMPLETE THE DCB FIELDS KNOWN PRIOR TO GETTING CORE FOR IOB/CP'S. 00740000 * 3. REPEAT FOR EACH DCB BEING OPENED. 00760000 * 00780000 * ENTRY POINTS- FROM IGG0191B BY XCTL. 00800000 * 00820000 * EXITS- TO IGG0191H BY XCTL 00840000 * TO IGG0199K IF SEARCH DIRECT 00850020 * 00860000 *INPUT-REGISTERS WITH THE ADDRESSES OF THE FOLLOWING- 00880000 * THE PARAMETER LIST (POINTERS TO TOP AND CURRENT ENTRY). 00900000 * THE WHERE-TO-GO TABLE (WTG) (POINTERS TO TOP AND CURRENT). 00920000 * EXTERNAL ROUTINES- NONE. 00940000 * ATTRIBUTES- REENTRANT AND REUSABLE. 00960000 * TABLES/WORKAREAS- 00980000 * 01000000 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 01020000 * BYTE 0-7 NAME 01040000 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 01060000 * BYTE 11 CONCATENATION NUMBER 01080000 * BYTE 12 ZERO 01100000 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 01120000 * ALIAS INDICATOR 1 BIT 01140000 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 01160000 * BYTE 14-16 TTR OF FIRST TEXT RECORD 01180000 * BYTE 17 ZERO 01200000 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 01220000 * BYTE 20 TRANSLATION TABLE 01240000 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 01260000 * BYTE 22-23 ATTRIBUTES 01280000 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 01300000 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 01320000 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 01340000 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 01360000 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 01380000 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 01400000 * BYTE 36-39 TABLE OF IDTTR'S 01420000 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01440000 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01460000 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01480000 * NOT USED (1 BYTE) 01500000 * 01520000 * WORKAREA- SEE 'FORCORE DSECT' (IECDSECT) IN THIS LISTING 01540000 * 01560000 *TABLES/WORKAREAS- PARAMETER LIST 01580000 * 01600000 *WORD ZERO 01620000 * BYTE 0 OPEN ATTRIBUTE (INPUT, OUTPUT, UPDATE, IN/OUT, 01640000 * OUT/IN, READ BACKWD, LEAVE , REREAD) 01660000 * BYTES 1-3 DCB ADDRESS FOR FIRST DCB BEING OPENED. 01680000 * 01700000 *THE PARAMETER LIST HAS A ONE WORD ENTRY FOR EACH DCB BEING OPENED. THE 01720000 *FORMAT IS THE SAME AS WORD ZERO. 01740000 *END PARAMETER LIST. 01760000 * 01780000 * REGISTER CONVENTIONS USED IN ALL OF OPEN- 01800000 * 01820000 RDCB EQU 2 DCB REGISTER 01840000 RBASE EQU 3 BASE REGISTER 01860000 RCORE EQU 4 I/O SUPPORT WORK AREA 01880000 RA EQU RCORE USED FOR WORK REG UNTIL RCORE 01900000 * IS NEEDED IN WTG LOGIC. 01920000 RVALCHK EQU RA VALIDITY CHECK CP BASEREG, 01940000 * USES 'VCMAP' DSECT. 01960000 RPAR EQU 5 TOP OF PARAMETER LIST 01980000 RWTG EQU 6 TOP OF WTG TABLE 02000000 RPARC EQU 7 CURRENT PARAMETER 02020000 RWTGC EQU 8 CURRENT LOAD IN TRANSIENT AREA 02040000 RTIOT EQU 9 USED AS A WORK REG 02060000 RIOB EQU RTIOT USED AS IOB BASE REG WITH THE 02080000 * IOB OVERLAY FROM FORECORE. 02100000 RUCB EQU 10 USED AS A WORK REG 02120000 RCPSIZE EQU RUCB USED TO CALCULATE AND HOLD THE 02140000 * CHANNEL PGM SIZE. 02160000 RDEB EQU 11 DEB BASE REG. 02180000 RB EQU 12 WORK REG. 02200000 RCPBASE EQU RB CHANNEL PGM BASE REG USED WITH 02220000 * 'CPSEGMAP' DUMMY SECTION. 02240000 RC EQU 13 WORK REG. 02260000 RSTEPPER EQU RC POINTS TO THE CURRENT SEARCH 02280000 * ADDRESS OR COUNT FIELD BEING 02300000 * USED FOR CP CONSTRUCTION. WHEN 02320000 * POINTING TO A COUNT FLD THE 02340000 * 'COUNTFLD' DUMMY SECTION IS 02360000 * USED BASED ON THIS REG. 02380000 * 02400000 RE EQU 0 WORK REG. VOLATILE ACCROSS SVC. 02420000 RF EQU 1 WORK REG. VOLATILE ACCROSS SVC. 02440000 RD EQU 14 WORK REG. VOLATILE ACCROSS SVC. 02460000 RJ EQU 15 WORK REG. VOLATILE ACCROSS SVC. 02480000 * 02500000 * 02520000 * MASK CONFIGURATIONS FOR TESTING THE HI ORDER BYTE OF EACH PARAMETER 02540000 * LIST ENTRY. SIGNIFICANCE IS THE SAME AS THE DEB OPEN ATTRIBUTE FIELD. 02560000 * 02580000 INPUT EQU X'0F' TEST MASKED BITS FOR ZEROS. 02600000 OUTPUT EQU X'0F' TEST MASKED BITS FOR ONES. 02620000 INOUT EQU X'03' 02640000 OUTIN EQU X'07' 02660000 RDBACK EQU X'01' 02680000 UPDAT EQU X'04' 02700000 LEAVE EQU X'10' 02720000 REREAD EQU X'30' 02740000 * 02760000 * COMMAND CODES FOR THE 2841 CONTROL UNIT. 02780000 * 02800000 SRCHEQ EQU X'31' SEARCH EQUAL ID. 02820000 SRCHEQMT EQU X'B1' SEARCH EQUAL ID IN MULTI-TRACK. 02840000 TIC EQU X'08' TRANSFER IN CHANNEL. 02860000 WCKD EQU X'1D' WRITE COUNT, KEY, AND DATA. 02880000 WSCKD EQU X'01' WRITE SPECIAL, COUNT,KEY,DATA. 02900000 SEEKCYL EQU X'0B' SEEK CYLINDER. 02920000 READDATA EQU X'06' READ DATA SINGLE TRACK. 02940000 RDDATAMT EQU 86 MULTI-TRACK READ DATA. 02960000 READKD EQU 14 READ KEY AND DATA. 02980000 READCT EQU X'92' READ COUNT M/T MODE. 03000000 * 03020000 * CHANNEL COMMAND WORD FLAGS. 03040000 * 03060000 SKIP EQU X'10' SKIP FLAG. 03080000 SILI EQU X'20' SUPPRESS INCORRECT LENGTH IND. 03100000 CC EQU X'40' COMMAND CHAIN. 03120000 DC EQU X'80' DATA CHAIN. 03140000 SILICC EQU X'60' SILI AND CC TOGETHER 03160000 SILICCSK EQU X'70' SILI, CC, AND SKIP. 03180000 * END CCW FLAGS. 03200000 * 03220000 * 03240000 * MISCELLANEOUS ITEMS. 03260000 * 03280000 COMPNOER EQU X'7F' USED TO INIT. ECB. 03300000 DCANDCC EQU X'C0' USED TO SET IOBFLAG1. 03320000 IDLENGTH EQU X'05' NMBR OF BYTES IN A 'CCHHR'. 03340000 POINT EQU X'04' DCBMACRF IF NOTE/POINT USED. 03360000 QSAM EQU X'01' QSAM BIT IN DCBIND2. 03380000 PODSORG EQU X'02' TESTS FOR PO DATA SET OX02992 03390003 * 03400000 NPD2 EQU 5 NOTE/POINT FOR PCI,UPD,T.O. 03420000 EPDT EQU 9 EOB FOR T.O. 03440000 EGP2 EQU 8 EOB FOR D.A. INPUT. 03460000 * 03480000 * 03500000 VALCHK EQU X'80' MASK TO DETERMINE IF WRITE 03520000 * VALIDITY CHECK OPTION CALLED. 03540000 IOBSIZE EQU 48 LENGTH OF A STANDARD IOB WITH 03560000 * BSAM/QSAM/BPAM EXTENSION. 03580000 IOBDBLWD EQU 6 NMBR OF DBL WDS IN IOB. 03600000 OFFSW EQU 24 OFFSET OF CCW THAT WRITES DATA. 03620000 OFFSR EQU 32 OFFSET OF THE READ CCW THAT 03640000 * RECEIVES THE BLOCK LENGTH TO 03660000 * BE READ. 03680000 CPSEGLEN EQU 32 LENGTH OF ONE CP SEGMENT. 03700000 NOTZERO EQU 7 CONDITION MASK USED AFTER 03720000 * ARITHMETIC INSTRUCTIONS FOR THE 03740000 * NOT-ZERO TEST. 03760000 BBCCHH EQU 6 MIN. SEEK LENGTH. 03780000 * 03800000 ZERO EQU X'00' AN IMMEDIATE BYTE OF ZERO'S. 03820000 TWO EQU 2 NO. OF CCWS FOR RCD S20201 03820820 * READY S20201 03821620 * READY FEATURE PER SEGMENT 03822420 THREE EQU 3 NO. OF DW REQUIRED FOR S20201 03823220 * RCD S20201 03824020 D0 EQU 0 NO DISPLACEMENT S20201 03824820 D1 EQU 1 DISPLACEMENT OF ONE S20201 03825620 D2 EQU 2 DISP AND COUNT OF TWO S20201 03826420 WDLEN EQU 4 DISPLACEMENT OF ONE WD S20201 03827220 B5 EQU 5 BYTE COUNT OF FIVE S20201 03828020 D6 EQU 6 DISPLACEMENT OF SIX S20201 03828820 SXTN EQU 16 ADDED LENGTH OF A CHP S20201 03829620 * SEG- S20201 03830420 * MENT IF RCD READY USED 03831220 B24 EQU 24 ADDITIONAL BYTES IN RD S20201 03832020 * PROG S20201 03832820 * FOR RECORD READY FEATURE 03833620 * 03834420 NORCDRY EQU X'20' NO RCD READY MASK S20201 03835220 SDOPT EQU X'01' SEARCH DIRCT OPTION MASK S20201 03836020 SDFLG EQU X'08' SEARCH DIRECT INDICATOR S20201 03836820 * 03837620 MAX EQU 256 MAX COUNT FOR SS INST S20201 03838420 EIGHT EQU 8 LENGTH OF A COUNT FIELD. 03840000 ANYZERO EQU 14 MASK FOR MIXED OR ZEROS. 03860000 FIRST EQU X'01' USED TO SET IOB FLAG IN FIRST 03880000 * IOB AND INIT. 'R'. 03900000 READCPL EQU 40 NMBR OF BYTES IN READ CP. 03920000 RCPDBLWD EQU 5 NMBR OF DBL WDS IN RCP. 03940000 REMNANT EQU READCPL-OFFSR OFFSR+REMNANT=READCPL. 03960000 OPCODE EQU 0 OFFSET OF CCW OPCODE(IN CCW). 03980000 ADDRESS EQU 0 OFFSET OF ADDRESS IN CCW 04000000 * (IMPLIES THAT THE ADDRESS MUST 04020000 * BE PUT IN BEFORE THE OP CODE) 04040000 FLAGS EQU 4 CCW FLAG BYTE. 04060000 LENFLD EQU 6 START OF LENGTH FLD IN CCW. 04080000 U EQU X'C0' CODE FOR DCBRECFM=U 04100000 * 04120000 BALR RBASE,0 ESTABLISH ADDRESSABILITY. 04140000 USING SOP1S,RBASE 04160000 USING FORECORE,RCORE S20201 04170020 * 04180000 USING IHADCB,RDCB DCB ADDRESSABILITY. 04200000 * 04220000 * 04240000 SOP1S EQU * 04260000 * 04280000 L RDCB,0(RPARC) GET DCB ADDRESS FROM PARM. LIST 04300000 L RCORE,WDLEN(RWTGC) COMMON WORK AREA S20201 04310020 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 04312001 L RDEB,DCBDEBAD DEB ADDRESSABILITY. 04320000 .DEBCK10 ANOP Y01021 04330000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 04332000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 04334000 .DEBCK20 ANOP Y01021 04336000 USING DEB,RDEB 04340000 TM DCBRECFM,U U FORMAT S20201 04343020 BM OKRR BRANCH IF NO S20201 04346020 OI JFCBMASK+D6,NORCDRY ASSURE RCD READY NOT S20201 04349020 * USED S20201 04352020 OKRR EQU * S20201 04355020 TM DCBDSORG,PODSORG PARTITIONED DATA SET ? OX02992 04357003 BNO CKSAM BRANCH IF NOT XM4609 04359003 XC DCBCNTRL(4),DCBCNTRL CLEAR FOR MOD KEYS OX02992 04359403 MVI DCBCNTRL+1,NPD2 SET NOTE/POINT FOR DISK OX02992 04359803 B OUTTEST CONTINUE PROCESSING OX02992 04359903 CKSAM EQU * XM4609 04366603 IF DCBCIND2,ISNOT=QSAM,GOTO=CLEARCTL 04373303 ISQSAM IF DEBOPATB,ISNOT=OUTPUT,GOTO=RCPONLY 04380000 B SOMEOUT NOTE/POINT NOT REQ'D. 04400000 CLEARCTL EQU * 04410003 OUTTEST IF DEBOPATB,IS=OUTPUT,GOTO=PEROUT 04440000 PERIN IF DCBMACRF,ISNOT=POINT,GOTO=INTEST 04460000 MVI DCBCNTRL+1,NPD2 SET NOTE/POINT FOR DISK ID. 04480000 INTEST IF DEBOPATB,ISNOT=OUTPUT,GOTO=RCPONLY 04500000 PEROUT IF DCBMACRF+1,ISNOT=POINT,GOTO=SOMEOUT 04520000 MVI DCBCNTRL+1,NPD2 NOTE/POINT LOAD ID. 04540000 SOMEOUT EQU * NPD2 ID SET AS REQ'D. 04560000 * 04580000 * OPEN ATTRIBUTES SPECIFY SOME FORM OF OUTPUT (OUTPUT, IN/OUT, OUT/IN). 04600000 * GET A POINTER TO THE DEVICE CHARACTERISTICS TABLE ENTRY FOR THE 04620000 * DEVICE BEING USED. 04640000 * 04660000 L RD,DCBDVTBL RD POINTS TO THE TABLE ENTRY 04680000 * FOR DEVICE USED. 04700000 * 04720000 USING DEVTAB,RD DEVICE TABLE ADDRESSABILITY. 04740000 * 04760000 * THE DIRECT ACCESS DEVICE TABLE OVERLAY APPLIES TO THE ENTRY BASED ON 04780000 * REGISTER RD. 04800000 * 04820000 *CALCULATE THE MAXIMUM NUMBER OF RECORD SEGMENTS REQUIRED TO WRITE THE 04840000 * SPECIFIED BLOCKSIZE. APPLIES TO BSAM AND QSAM. 04860000 * 04880000 * DIVIDE BLOCKSIZE BY TRACK CAPACITY. 04900000 * REGS RE/RF MUST BE EVEN/ODD PAIR. 04920000 * 04940000 SR RE,RE 04960000 LH RF,DCBBLKSI GET BLOCKSIZE FROM DCB. 04980000 LH RJ,TRKCAP GET TRACK CAP. FROM DEV TABLE. 05000000 * 05020000 * DEVICE TABLE ADDRESSABILITY MAY BE RELINQUISHED 05040000 * 05060000 DROP RD 05080000 * 05100000 * 05120000 DR RE,RJ BLOCKSIZE/TRACK-CAPACITY. 05140000 * RF = QUOTIENT. 05160000 * RE = REMAINDER 05180000 * 05200000 * IF REMAINDER IS GREATER THAN 1, ROUND UP THE QUOTIENT. QUOTIENT 05220000 * VALUE WILL BE ONE LESS THAN MAXIMUM NUMBER OF RECORD SEGMENTS REQ'D. 05240000 * 05260000 CH RE,ONE REMAINDER GREATER THAN ONE. 05280000 BNH GETCORE NO. BRANCH AROUND THE ROUND-UP. 05300000 * 05320000 LA RF,1(RF) ROUND UP THE QUOTIENT. 05340000 * 05360000 GETCORE EQU * 05380000 * 05400000 LA RCPSIZE,1(RF) RF+1 = MAX NMBR OF SEGMENTS. 05420000 * 05440000 IF DCBOPTCD,ISNOT=VALCHK,GOTO=GETCPSIZ 05460000 * 05480000 LA RCPSIZE,1(RCPSIZE) ADJUST FOR WRT CHECK SEGMENT. 05500000 * 05520000 GETCPSIZ EQU * 05540000 * 05560000 * RCPSIZE CONTAINS THE MAX NUMBER OF RECORD SEGMENTS, ADJUSTED FOR WRT 05580000 * CHECK OPTION. THIS NUMBER OF CHANNEL PROGRAM SEGMENTS WILL BE BUILT. 05600000 * THE METHOD WORKS SO LONG AS ALL CHANNEL PROGRAM SEGMENTS ARE EQUAL 05620000 * LENGTHS. 05640000 * RF, THE UNADJUSTED VALUE, IS KEPT FOR USE IN CALCULATING S.A. AND 05660000 * COUNT FIELD CORE SIZE. 05680000 * 05700000 * COMPUTE THE AMOUNT OF CORE (EXPRESSED IN DOUBLE WORDS) NEEDED FOR 05720000 * THE CHANNEL PROGRAM SEGMENTS (FOR ONE IOB). DONE BY- 05740000 * (SEGMENT SIZE) TIMES (NMBR OF SEGMENTS) DIVIDED BY 8. SINCE SEGMENT 05760000 * SIZE IS A MULTIPLE OF 8 (4 CCW'S = 32 BYTES) IT SIMPLIFIES TO 05780000 * 32/8 TIMES (NMBR OF SEGMENTS)= SHIFT NMBR OF SEGMENTS LEFT 2 PLACES. 05800000 SLA RCPSIZE,2 WRITE CP LENGTH (DBL WDS). 05820000 LA RJ,IOBSIZE STARTING POINT FOR BUILDING 05860000 * VARIOUS OFFSETS 05880000 STC RJ,DCBWCPO PUT OFFSET IN DCB S20201 05881020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 05882020 * READY S20201 05883020 BO NOTRR2A BRANCH IF NO S20201 05884020 LA RJ,EIGHT(RJ) INCREMENT OFFSET PTR S20201 05885020 LA RCPSIZE,D2(RCPSIZE) INCR IOB SIZE S20201 05886020 TM DCBOPTCD,VALCHK RCD READY AND VALIDITY S20201 05887020 * CHK S20201 05888020 BZ NOTRR2A BRANCH IF NO S20201 05889020 LA RCPSIZE,D1(RCPSIZE) INCR FOR FEAT IN VAL CHK S20201 05890020 NOTRR2A EQU * S20201 05891020 STC RCPSIZE,DCBWCPL PUT LENGTH IN DCB S20201 05892020 IF DEBOPATB,IS=OUTPUT,GOTO=OUTONLY 05900000 * OPENED FOR IN/OUT OR OUT/IN. 05920000 * 05940000 MVI DCBCNTRL+3,EGP2 EOB ID FOR NON-F INPUT. 05960000 MVI DCBCNTRL+2,EPDT EOB ID FOR T.O. OUTPUT. 05980000 LA RJ,OFFSR(RJ) CCW THAT RECEIVES BLOCK LENGTH. 06000000 STC RJ,DCBOFFSR SAVE IT. 06020000 LA RJ,REMNANT(RJ) MOVE POINTER (RJ) TO WCP. 06040000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06043020 * READY S20201 06046020 BO NOTRR2C BRANCH IF NO S20201 06049020 LA RJ,EIGHT(RJ) INCR OFFSET PTR S20201 06052020 NOTRR2C EQU * S20201 06055020 STC RJ,DCBWCPO SAVE IT. 06060000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06062020 * READY S20201 06064020 BO NOTRR2G BRANCH IF NO S20201 06066020 LA RJ,EIGHT(RJ) INCR OFFSET PTR S20201 06068020 LA RCPSIZE,D2(RCPSIZE) INCR IOB SIZE S20201 06070020 NOTRR2G EQU * S20201 06072020 LA RJ,OFFSW(RJ) CCW THAT RECEIVES BLOCK LENGTH. 06080000 LA RCPSIZE,RCPDBLWD(RCPSIZE) ADD NMBR OF CCW'S IN RCP. 06100000 B STOREWRT 06120000 OUTONLY EQU * 06140000 MVI DCBCNTRL+3,EPDT TRK OVFLO OUTPUT EOB ID. 06160000 LA RJ,OFFSW(RJ) CCW THAT RECEIVES BLOCK LENGTH. 06200000 STC RJ,DCBOFFSR BYPASSED IF RCP PRESENT. 06220000 STOREWRT STC RJ,DCBOFFSW 06240000 LA RCPSIZE,IOBDBLWD(RCPSIZE) ADD NMBR OF DBL WDS IN IOB. 06260000 * RCPSIZE HAS IOBL/8+WCPL/8+(READCPL/8 IF REQ'D). 06280000 * SEARCH ADDRESSES (S.A.) AND COUNT FIELDS ARE 8 BYTES EACH. THERE IS 06300000 * ONE S.A. AND COUNT FIELD FOR EACH C.P. SEGMENT EXCEPT THE FIRST, 06320000 * WHOSE S.A. IS THE IOB FDAD. 06340000 * CALCULATE CORESIZE FOR S.A.'S AND COUNT FIELDS AS FOLLOWS- 06360000 * CALL THE VALUE IN REG RF 'N'. (MAX NMBR OF SEGMENTS MINUS 1) 06380000 * THERE ARE 2N+1 S.A.'S & COUNT FIELDS (NONE REQ'D FOR VAL CHK). 06400000 * BUILD THE CORESIZE VALUE IN REG 1 (=RF) 06420000 * 06440000 SLA RF,1 MULTIPLY BY 2 = 2N. 06460000 LA RF,1(RF) ADD 1 GIVES 2N+1 06480000 * ADD THE IOB LENGTH AND CP SIZE (IN DBL WDS) TO THE NUMBER OF S.A.'S 06500000 * AND COUNT FIELDS. 06520000 * 06540000 AR RF,RCPSIZE (IOB+CP)/8+(2N+1) 06560000 * RE IS FREED. 06580000 * MULITPLICATION BY 8 EXPRESSES THE IOB/CP SIZE IN BYTES, AND 06600000 * MULTIPLIES THE THE NMBR OF S.A.'S AND COUNT FIELDS BY THEIR SIZE. 06620000 * 06640000 B TIMES8 06660000 RCPONLY EQU * 06680000 MVI DCBCNTRL+3,EGP2 EOB ID FOR NON-F INPUT. 06700000 * FILL IN DCB FIELDS REQ'D FOR READING ONLY. 06720000 * DCBOFFSR (SET DCBOFFSW THE SAME). 06740000 * DCBIOBL 06760000 MVI DCBOFFSR,IOBSIZE+OFFSR PUT OFFSET IN DCB S20201 06800020 LA RF,IOBDBLWD+RCPDBLWD GET NMBR OF DBL WD FOR IOB+CP. 06840000 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06842020 * READY S20201 06844020 BO NOTRR2K BRANCH IF NO S20201 06846020 LA RF,D2(RF) INCR IOB DW SIZE S20201 06848020 MVI DCBOFFSR,IOBSIZE+OFFSR+EIGHT PUT NEW OFFSET IN S20201 06850020 * IOB S20201 06852020 NOTRR2K EQU * S20201 06854020 TIMES8 EQU * S20201 06855020 TM DEBOPATB,OUTPUT IF OUT ONLY THEN S20201 06856020 BO NOSDIR DONT INCR OFFSETS S20201 06857020 TM JFCBMASK+D6,SDFLG IS SCH DIR SPECIFIED S20201 06858020 BZ NODIRECT IF NOT, DONT INCR FOR 2 S20201 06859020 * DOUBLE WORDS 06860020 LA RF,D2(RF) NEED TWO MORE CCWS S20201 06861020 SR RE,RE CLEAR REGISTER S20201 06862020 IC RE,DCBOFFSR GET READ OFFSET S20201 06863020 SH RE,CON8 BACK UP A DW S20201 06864020 STC RE,DCBOFFSR RETURN TO DCB S20201 06865020 IC RE,DCBWCPO FOR INOUT OT OUTIN (INPU S20201 06866020 AH RE,SDINCR16 T ONLY DOESNT MATTER) PT S20201 06867020 STC RE,DCBWCPO TO WRT CP MUST BE INCR S20201 06868020 * OVER THE 2 DWS SET ASIDE 06869020 * FOR THE S.D. FEATURE. 06870020 * THEY FOLLOW THE RD C.P. 06871020 IC RE,DCBOFFSW INCREMENT THE OFFSET S20201 06872020 AH RE,SDINCR16 TO THE WRITE CHANNEL PGM S20201 06873020 STC RE,DCBOFFSW IF SEARCH DIRECT IS USED S20201 06874020 NOSDIR EQU * S20201 06875020 NODIRECT EQU * S20201 06876020 SR RE,RE REMOVE GARBAGE S20201 06877020 STC RF,DCBIOBL PUT IOB LENGTH IN DCB S20201 06878020 SLL RF,THREE MULTIPLY BY EIGHT S20201 06880020 IC RE,DCBNCP GET IOB COUNT S20201 06882020 TM DCBCIND2,QSAM QSAM USED S20201 06884020 * 06886020 BZ MULT BRANCH IF YES S20201 06888020 IC RE,DCBBUFNO GET CONT FROM BUFR NO S20201 06890020 MULT EQU * S20201 06892020 LTR RE,RE IOB CNT SPECIFIED S20201 06894020 BP SPECIF BRANCH IF YES S20201 06896020 LA RE,D1 OTHERWISE FURNISH ONE S20201 06898020 SPECIF EQU * S20201 06900020 LR RIOB,RE SAVE NO IOB'S A37507 06901021 MR RE,RE MULTIPLY IOB CNT TIMES S20201 06902020 * NO S20201 06904020 * 06906020 * CHECK FOR RCD READY AND IF USED GET DW FOR THETA VALUES 06908020 * 06910020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD S20201 06912020 * READY S20201 06914020 BO NORRM BRANCH IF YES S20201 06916020 LA RF,EIGHT(RF) INCR SIZE FOR RCD READY S20201 06918020 NORRM EQU * S20201 06920020 LR RC,RF SAVE AMT FOR CLEARING S20201 06922020 * 06924020 * GET MAIN FOR IOBS, RF=RC=AMOUNT 06926020 * 06928020 GETMAIN R,LV=(RF),SP=250 S20201 06930020 ST RF,DCBIOBA PUT FIRST IOB ADDR IN S20201 06932020 * DCB S20201 06934020 LR RB,RF COPY ADDR USE TO CLR S20201 06936020 * 06938020 * CLEAR OF RECEIVED CORE RB=ADDRESS, RC=AMOUNT 06940020 * 06942020 LR RJ,RC COPY AMOUNT S20201 06944020 LA RD,MAX CONSTANT OF 256 S20201 06946020 B CLEAR BRANCH S20201 06948020 SOP1SLO XC D0(D1,RB),D0(RB) CLEARS REMAINING BYTES S20201 06950020 SOP1SHI XC D0(MAX,RB),D0(RB) CLEARS 256 BYTES S20201 06952020 AR RB,RD ADD 256 TO ADDR S20201 06954020 CLEAR SR RC,RD SUB 256 FROM AMT S20201 06956020 BH SOP1SHI IF AMT GT 256 BRANCH S20201 06958020 AR RC,RD CORRECT AMT S20201 06960020 BCTR RC,RE REDUCE BY ONE BYTE, RE=0 S20201 06962020 EX RC,SOP1SLO CLEAR REMAING BYTES S20201 06964020 * 06966020 * SET UP THETA ADDRS, MAY BE USED LATER 06968020 * 06970020 AR RJ,RF GET AREA + 1 ADDR S20201 06972020 LA RD,EIGHT CONSTANT OF EIGHT S20201 06974020 SR RJ,RD BACKUP ONE DW S20201 06976020 ST RJ,D0(RF) TEMP STORE SET THETA S20201 06978020 * ADDR S20201 06980020 * WTG LOGIC GOES HERE 06984020 * 06986020 STOPSOP6 EQU * S20201 06988020 DROP RDEB S20201 06990020 L RCORE,4(RWTGC) GET WORK AREA ADDRESSABILITY. 07000000 USING FORECORE,RCORE 07020000 MVC 0(5,RWTGC),NEXTEXEC GET NEXT EXEC ID. 07040000 * 07044020 TM JFCBMASK+D6,SDFLG IF SCH DIRECT IS NOT S20201 07048020 BZ NODERECT SPECIFIED OR IF DCB IS S20201 07052020 TM DEBOPATB,OUTPUT OPENED FOR OUTPUT ONLY, S20201 07056020 BO NODERECT THEN GO XCTL TO MODULE S20201 07060020 * IGG0191H, ELSE TO MOD 07064020 * IGG0199K 07068020 MVC D0(B5,RWTGC),SDEXEC SEARCH DIRECT EXEC S20201 07072020 NODERECT EQU * S20201 07076020 RELOOP LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURRENT WTG ENTRY. 07080000 LA RPARC,PLOFF(0,RPARC) INCREMENT CURRENT DCB ENTRY PTR 07100000 CLC 0(2,RWTGC),AMIDCNST IS THIS RTN NEEDED AGAIN? 07120000 BCR 8,RBASE 07140000 * 07160000 CLC 0(2,RWTGC),OPIDCNST END OF TABLE? 07180000 BC 7,RELOOP NO, CHECK NEXT ENTRY. 07200000 * 07220000 LR RPARC,RPAR 07240000 LA RWTGC,WAOFF(0,RWTG) REINIT. WTG LIST PTR. 07260000 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE? 07280000 BC 7,TCTLRTN IF NOT TRANSFER CONTROL. 07300000 * 07320000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY. 07340000 LA RPARC,PLOFF(0,RPARC) 07360000 BC 15,ZCHEK 07380000 * 07400000 TCTLRTN EQU * 07420000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE. 07440000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE. 07460000 * 07480000 * 07500000 LA 15,DXCCW12 07520000 * 07540000 XCTL DE=(RWTG),SF=(E,(15)) 07560000 * 07580000 * END WTG LOGIC. ***** 07600000 * 07620000 ONE DC H'1' G.P. CONSTANT. 07640000 * 07660000 * 07680000 * WTG CONSTANTS AND EQUATES. 07700000 * 07720000 WAOFF EQU 32 07740000 PLOFF EQU 4 07760000 WGOFF EQU 8 07780000 OPIDCNST DC C'0S' 07800000 AMIDCNST DC C'1S' IDTTRL 07820000 * 07840000 * END WTG CONSTANTS. 07860000 * 07880000 CON8 DC H'8' CONSTANT OF EIGHT S20201 07886020 SDINCR16 DC H'16' TWO DWS FOR S.D. COUNT S20201 07892020 * FIELD INCREMENT 07898020 XCTLTABL ID=(SDEXEC,9K,NEXTEXEC,1H),SVC=019 A37507 07958021 * 08020000 * READ CHANNEL PROGRAM OVERLAY. CCW FIELDS ARE ACCESSED BY ABSOLUTE 08040000 * OFFSETS FROM THE CCW NAME. 08060000 * 08080000 RCPOVLAY DSECT 08100000 * SEARCH (CCWA) 08120000 SRCHCCW DS D 08140000 * TIC (CCWB) 08160000 TICCCW DS D 08180000 * READ DATA WITH SKIP (CCWC) 08200000 SKIPCCW DS D 08220000 * READ COUNT (CCWD) 08240000 RDCTCCW DS D 08260000 * READ DATA (CCWE) 08280000 RDCCW DS D 08300000 * READ KEY AND DATA (ALTERNATE CCWE) 08320000 RKDCCW EQU RDCCW 08340000 * END READ CP CCW DEFINITION 08360000 * FOLLOWING IS A MAP OF A WRITE CHANNEL PROGRAM (WCP) SEGMENT. 08380000 * 08400000 WCPMAP DSECT 08420000 * 08440000 * SEARCH (CCW1 OR 5) 08460000 * 08480000 SRCHADDR DS F 08500000 SRCHOPCD EQU SRCHADDR OP CODE IS HI ORDER BYTE. 08520000 SRCHFLAG DS XL1 08540000 DS CL2 08560000 SRCHLEN DS XL1 LENGTHS NORMALLY FIT IN 1 BYTE. 08580000 * 08600000 * TIC (CCW2 OR 6) 08620000 * 08640000 TICADDR DS F 08660000 TICOPCD EQU TICADDR 08680000 UNUSED DS F ONLY REQUIRES BITS 37-39 = 0. 08700000 PARASITE EQU UNUSED MAY BE USED TO STORE AN ADDRESS 08720000 * BUT THE ABOVE RESTRICTION 08740000 * LIMITS THE OP CODES THAT MAY 08760000 * BE STORED IN THE HI BYTE. 08780000 * 08800000 * WRITE (CCW3) 08820000 * 08840000 COUNTADR DS F COUNT FIELD ADDRESS. 08860000 WRTOPCD EQU COUNTADR 08880000 WRTFLAG DS XL1 FLAG FIELD. 08900000 DS CL2 SPACER. 08920000 COUNTLEN DS XL1 COUNT FIELD LENGTH (NORMALLY 8) 08940000 * 08960000 * NULL OP CODE (CCW4) OP PROPAGATED FROM WRITE CCW. 08980000 * 09000000 DATAADDR DS F ADDRESS OF BLOCK OF DATA TO BE 09020000 * WRITTEN. 09040000 NULLOPCD EQU DATAADDR USED AS A FLAG TO SIGNAL LAST 09060000 * SEGMENT. 09080000 NULLFLAG DS XL1 09100000 DS XL1 SPACER. 09120000 DATALEN DS H 2 BYTES HOLDS DATA LENGTH. 09140000 * 09160000 * 09180000 * FOLLOWING IS THE VALIDITY CHECK CHANNEL PROGRAM OVERLAY. 09200000 * 09220000 VCMAP DSECT 09240000 * SEEK (CCW7) 09260000 SEEKADDR DS F 09280000 SEEKOPCD EQU SEEKADDR 09300000 SEEKFLAG DS XL1 09320000 DS CL2 09340000 SEEKLEN DS XL1 09360000 * 09380000 * SEARCH (CCW8) LABELS PREFIXED BY 'VC' (VAL 09400000 VCSRCH EQU * CHECK). 09420000 VCSRCHAD DS F 09440000 VCSRCHOP EQU VCSRCHAD 09460000 VCSRCHFL DS XL1 FLAGS. 09480000 DS CL2 09500000 VCSRCHLE DS XL1 LENGTH. 09520000 * 09540000 * TIC (CCW9) 09560000 VCTICAD DS F 09580000 VCTICOP EQU VCTICAD 09600000 NOTUSED DS F 09620000 * 09640000 * READ DATA (CCW10) 09660000 VCRDAD DS F 09680000 VCRDOP EQU VCRDAD 09700000 VCRDFLAG DS XL1 NORMALLY SKIP. 09720000 VCRDLEN DS FL3 09740000 * 09760000 * FOLLOWING IS AN OVERLAY OF THE COUNT FIELD. 09780000 * 09800000 COUNTFLD DSECT 09820000 * 09840000 CYLINDER DS H CYLINDER ADDRESS (CC). 09860000 HEAD DS H HEAD ADDRESS (HH). 09880000 RECORD DS XL1 RECORD NUMBER (R). 09900000 KEYLENTH DS XL1 KEY LENGTH (KL). 09920000 DLDL DS H DATA LENGTH (DLDL). 09940000 * 09960000 * END COUNT FIELD. (CCHHRKDD) 09980000 * 10000000 * 10020000 * DIRECT ACCESS DEVICE TABLE OVERLAY 10040000 * 10060000 DEVTAB DSECT 10080000 DEVSIZE DS F MAX SIZ FOR DEVICE. 10100000 TRKCAP DS H TRACK CAPACITY. 10120000 OVERI DS XL1 OVERHEAD FOR NOT-LAST RECORD. 10140000 OVERL DS XL1 OVERHEAD FOR LAST RECORD. 10160000 OVERK DS XL1 OVERHEAD REDUCTION FOR NON-KEY 10180000 * RECORDS. 10200000 DEVFLAG DS XL1 10220000 TOLER DS H TOLERANCE/512 USED FOR VARIABLE 10240000 * GAP LENGTH CALCULATIONS. 10260000 * END DEVTAB OVERLAY. 10280000 * 10300000 * 10320000 DCBD DSORG=PS 10340000 * 10360000 * 10380000 * 10400000 * 10420000 FORECORE DSECT 10440000 IECDSECT 10460000 * 10480000 * IOB OVERLAY 10500000 * THE FORECORE DSECT IOB OVERLAY IS USED WITH THE FOLOWING ADDITIONS- 10520000 * 10540000 * BSAM/BPAM/QSAM IOB EXTENSION- 10560000 SAMSIOB EQU DXIOB-8 START OF SAM'S IOB. 10580000 LINK EQU SAMSIOB FORWARD CHAIN FIELD (TO NEXT 10600000 * IOB). 10620000 FLAG EQU LINK HI BYTE OF LINK USED AS FLAG. 10640000 ECB EQU DXIOB-4 10660000 * END EXTENSION DEFINITIONS 10680000 * 10700000 IOBSEEK EQU DXDAADDR 10720000 CHANPGM EQU DXDAADDR+8 START OF CHANNEL PROGRAM. 10740000 * LENGTH MAY VARY. 10760000 * END IOB DEFINITIONS. 10780000 * 10800000 DEB EQU DXDEB 10820000 DEBOPATB EQU DXDEBSYS 10840000 END 10860000 ./ ADD SSI=04013444,NAME=IGG0191T,SOURCE=0 TITLE 'IGG0191T - UCS LOAD,FCB PATH DETERMINER' M0191 00100021 COPY LCGASMSW A50376 00101021 IGG0191T CSECT 00102021 * 00180001 * RELEASE 19 DELETIONS 00500000 * M4179 00550019 * RELEASE 20 DELETIONS 00600000 *1355183000,186000,188000,344600-346200 A33665 00650020 *1355020000-023000,027000-028000,041000,045000-048000,052000, S20202 00660020 *1355242000,302000-306000,322000,328000,350000-358000,415000- S20202 00670020 *1355418000,431000,455000-531000,536000,552000,708000,714000- S20202 00680020 *1355717000 S20202 00690020 *1355255000 M5143 00695020 * RELEASE 21 DELETIONS 00700000 *0791276005-276015,287600,566360 M0151 00701021 *0791046400,141001-141002,566480-56662 M1830 00702021 *0791552080-552110,552140-552200,552260-552290,552320-552350, M0009 00710021 *0791552380-552410 M0009 00720021 *0791 S21092 00750021 *0791 M0191 00760021 *0791001200,001400,001500,004000,004500,004600,004700,004800, A50376 00768021 *0791008000,009000,010000,011000,012000,113200,622050,708000, A50376 00776021 *0791709000,710000,711000,712000,713000,713800,714600,715400, A50376 00784021 *0791716200,717000,718000,719000,720000 A50376 00792021 * 01100021 AIF ('&LIB' EQ 'LIB1').OS1 YM3213 01110001 * VS2 RELEASE 01 DELETIONS 01112001 *552440,552470 YM3213 01122001 * OY00103 01124002 .OS1 ANOP YM3213 01132001 *STATUS CHANGE LEVEL 009 01200002 * 01300000 *FUNCTION/OPERATION - EXECUTE BLOCK DATA CHECK OR RESET BLOCK DATA 01400000 * CHECK 01500000 * - DETERMINES WHETHER UCS LOAD IS REQUIRED. 01600000 * - IF THE SPECIFIED UCS IMAGE WAS LOADED BY THE 01700000 * PREVIOUS JOB STEP,DETERMINE THE NEXT EXECUTOR 01800000 * TO BE XCTLED. 01900000 * ._ IF UCS IMAGE SPECIFIED WAS LOADED BY A 01930020 * PREVIOUS JOB STEP OR IF NO UCS SPECIFIED AND 01960020 * UCS IMAGE LOADED IS A 01990020 * (1)DEFAULT _DETERMINE IF 02020020 * (A)A FCB IMAGE HAS TO BE LOADED 02050020 * (B)OPERATOR IS TO SPECIFY FCB IMAGE TO BE USE 02080020 * (C)NO FCB IMAGE IS TO BE LOADED THEN 02110020 * DETERMINE NEXT EXECUTOR TO XCTL TO 02140020 * 02170020 * (2)NON-DEFAULT__ REQUEST OPERATOR TO SPECIFY 02200020 * UCS IMAGE TO BE USED 02230020 * 02260020 * _ISSUES SVC 105 TO BUILD A DCB AND DEB FOR 02290020 * SYS1.IMAGELIB IF A UCS AND/OR FCB HAS TO BE 02320020 * LOADED INTO CORE. 02350020 * 02400000 *ENTRY POINT - ENTERED FROM THE FOLLOWING EXECUTORS BY USE OF THE XCTL 02500000 * MACRO 02600000 * *FROM IGG0196A IF DCB IS EXCP THAT'S BEING OPENED TO 02660020 * A 1403 WITH UCS OR A 3211 PRINTER 02720020 * *FROM IGG0196B IF DCB IS BEING OPENED TO A 1403 WITH 02780020 * UCS OR 3211 PRINTER 02840020 * *FROM 6A OR 6B IF A 2245 PRINTER. 02870021 * 02900000 *INPUT - DCB ADDRESS 03000000 * - OPEN WORK AREA ADDRESS 03100000 * - WHERE-TO-GO TABLE 03200000 * - PARAMETER LIST 03300000 * - CURRENT ENTRY IN W-T-G TABLE 03400000 * - CURRENT PARAMETER(DCB) 03500000 * 03600000 *OUTPUT - IF NO UCS IMAGE IS SPECIFIED AND THE UCS IMAGE LOADED BY 03700000 * PREVIOUS JOB STEP WAS NOT A DEFAULT IMAGE,THE MESSAGE 03800000 * 'IEC123D XXX SPECIFY UCS PARAMETER' IS DISPLAYED. 03900000 * IF NO UCS IS TO BE LOADED AND THE UCS IMAGE IN THE BUFFER IS 03920020 * A DEFAULT THE MESSAGE 'IEC129D XXX,SPECIFY FCB PARAMETERS' 03940020 * IS DISPLAYED 03960020 * 04000000 *EXTERNAL ROUTINES _ A SVC 105 IS ISSUED TO CONSTRUCT A DCB AND A DEB 04050020 * FOR SYS1.IMAGELIB IF A UCS AND/OR A FCB IMAGE 04100020 * HAS TO BE LOADED INTO CORE 04150020 * 04200000 *EXIT - NORMAL - IF THE IMAGE IS TO BE LOADED,XCTL TO SAM OPEN EXECUTOR 04300000 * IGG0191U 04400000 * _ IF THE UCS IMAGE IS NOT TO BE LOADED THEN 04430020 * (1) IF THE FCB IMAGE IS TO BE LOADED,XCTL TO SAM OPEN 04460020 * EXECUTOR IGG0197E 04490020 * (2) IF ONLY FCB FORMS ALIGNMENT IS SPECIFIED,XCTL TO 04520020 * SAM OPEN EXECUTOR IGG0197F 04550020 * (3) IF NO FCB LOAD OR FCB ALIGNMENT IS REQUIRED AND 04580020 * DEVICE IS 3211,XCT1 TO SAM OPEN EXECUTOR IGG0197F 04610020 * TO DETERMINE FIRST STAGE TWO EXECUTOR M1803 04640021 * _ IF IS 1403 AND NO UCS LOAD IS REQUIRED,XCTL TO ONE 04670020 * OF THE FOLLOWING SAM OPEN EXECUTORS 04700020 * * THE LAST EXECUTOR OF OPEN ROUTINE IF DCB IS EXCP 04730020 * * IGG0191I IF BUFFER CONTROL IS SPECIFIED 04760020 * * IGG0191G IF NORMAL SCHEDULING IS SPECIFIED 04790020 * * IGG0191Q IF CHAINED SCHEDULING IS SPECIFIED 04820020 * *IGG0191G IF NORMAL SCHEDULING IS SPECIFIED 04900000 * *IGG0191Q IF CHAINED SCHEDULING IS SPECIFIED 05000000 * 05100000 *EXIT - ERROR - IF AN ERROR OCCURED WHILE DCB AND DEB FOR SYS1.IMAGELIB 05150020 * WERE BEING CONSTRUCTED AN ABEND RETURN CODE IS SET 05200020 * AND AN EXIT IS MADE TO IGG0191V TO ABEND 05250020 * 05300000 *TABLES/WORK AREAS - WHERE-TO-GO TABLE (SEE LISTING OF EXECUTOR 05400000 * IGG0191B) 05500000 * - OPEN WORK AREA (SEE IECDSECT IN THIS LISTING) 05600000 * 05700000 *ATTRIBUTES - REENTRANT,REUSABLE,SUPERVISOR MODE. 05800000 * 05900000 *NOTES - EXCP/WAIT SVCS IS USED TO EXECUTE DATA CHECK COMMAND 06000000 * DATA CHECK. 06100000 * - WTO/WTOR SVC IS USED TO REQUEST AN OPERATOR REPLY 06200000 * - CORE TRANSFER SUPPORT IS INCLUDED BUT NOPED. IN THIS RELEASE. 06300000 * - IOB/ECB IN OPEN WORK AREA IS USED FOR EXCP 06400000 * - IF THE PRINTER IS FOR A COMPOSITE CONSOLE,THE UCS SUPPORT IS 06500000 * NOPED. 06600000 * 06700000 *********************************************************************** 06800000 * 06900000 EJECT 07000000 * 07100000 ********************************************************************** 07200000 * 07300000 * REGISTER CONVENTIONS USED THROUGH OUT OPEN EXECUTORS 07400000 * 07500000 ********************************************************************** 07600000 * 07700000 RE EQU 0 WORK/PARAMETER REGISTER 07800000 RF EQU 1 WORK/PARAMETER REGISTER 07900000 RDCB EQU 2 ADDR OF USERS DCB 08000000 RBASE EQU 3 BASE REGISTER 08100000 RCORE EQU 4 ADDR OF OPEN WORK AREA 08200000 RPAR EQU 5 PARAMETER LIST 08300000 RWTG EQU 6 START OF WTG 08400000 RPARC EQU 7 CURRENT ENTRY IN PARAMETER LIST 08500000 RWTGC EQU 8 CURRENT ENTRY IN WTG TABLE 08600000 RTIOT EQU 9 TIOT ADDR/WORK REGISTER 08700000 RUCB EQU 10 UCB ADDR 08800000 RDEB EQU 11 DEB ADDR 08900000 RB EQU 12 WORK AREA BASE REGISTER 09000000 RC EQU 13 WORK REGISTER 09100000 RD EQU 14 WORK/PARAMETER REGISTER 09200000 RJ EQU 15 WORK/PARAMETER REGISTER 09300000 * 09400000 *********************************************************************** 09500000 * 09600000 *********************************************************************** 09700000 * 09800000 * 09900000 * EQUATE DCB MASK 10000000 * 10100000 PCIMASK EQU X'20' OPTCD=PCI SPECIFIED 10200000 BFCNTRL EQU X'01' BUFFER CNTRL BLOCK 10300000 EXCPMASK EQU X'80' DCB IS EXCP 10400000 * 10500000 * EQUATE WTG OFFSET 10600000 * 10700000 WGOFF EQU 8 OFFSET OF CURRENT WTG ENTRIES 10800000 PLOFF EQU 4 OFFSET OF CURRENT DCB ENTRIES 10900000 WAOFF EQU 32 OFFSET OF 1ST ENTRY IN WTG TBL 11000000 * 11100000 * MASKS 11200000 * 11300000 AIF ('&LIB' EQ 'LIB1').LIB100 A50376 11320021 ACBID EQU X'A0' ACB IDENTIFIER 11340001 .LIB100 ANOP 11360001 TWENTY EQU X'14' X'14' 11400000 SWITCHON EQU X'B0' BLDL, LOAD FROM SVCLIB A50376 11430021 * EXCP ON LOAD UCS 11460021 UNRLMASK EQU X'02' IOB IS UNRELATED 11500000 SILIMASK EQU X'20' SILI BIT IS ON 11600000 ONE EQU X'01' X'01' 11700000 BLOCKCCW EQU X'73' COMMAND CODE = BLOCK DATA CHECK 11800000 UNBLKCCW EQU X'7B' COMMAND CODE = UNBLK DATA CHECK 11900000 BLOCKMSK EQU X'40' DCB OPTCD=U (X'40') 12000000 NULL EQU X'00' X'00' 12100000 THREE EQU X'03' X'03' 12200000 BLANK EQU X'40' X'40' 12300000 FOLD EQU X'40' LOAD MODE = FOLD 12400000 NOIEC120 EQU X'BF' NO IEC120 IS REQUIRED 12500000 VERIFY EQU X'10' VERIFY IS REQUIRED 12600000 VRFYETRY EQU X'AF' ENTRY IS ONLY FOR VERIFICATION 12700000 DEFALT EQU X'80' DEFALT IMAGE IS IN BUFFER 12800000 MSSG33 EQU X'21' MESSAGE LENGTH=33 12900000 UCSEXLST EQU X'06' UCS EXIT LIST 13000000 LSTEXLST EQU X'80' END OF EXIT LIST MARKER 13100000 FOUR EQU X'04' X'04' 13200000 EXLSTUCS EQU X'86' END OF EXIT LIST AND UCS EXIT 13300000 COREMASK EQU X'5F' ENTRY IS FOR CORE TRANSFER 13400000 FFMASK EQU X'FC' SET SWITCH 13500000 IEC120 EQU X'40' IEC120 MESSAGE IS REQUIRED 13600000 NOCORE EQU X'FB' NOT CORE TRANSFER 13700000 CVTOFF EQU X'10' CVT OFF-SET 13800000 PCPMASK EQU X'40' PSP MASK 13900000 JOBSCHDL EQU X'04' JOB SCHEDULER IS IN CONTROL 14000000 ABENDBIT EQU X'80' ABEND TERMINATION IN PROCESS 14100000 STGETWO EQU X'C7' FLAG FOR ENTRY TO 197F M1803 14100121 PRTM3211 EQU X'09' MASK FOR 3211 PRINTER S20202 14100320 FCBIDOFS EQU X'08' FCB ID OFF SET S20202 14100420 SHIFTRHT EQU X'02' FLAG USED TO SET FCB S20202 14100520 * OPTIONS S20202 14100620 SHIFTLFT EQU X'06' FLAG USED TO SET FCB S20202 14100720 * OPTIONS S20202 14100820 FCBOPOFS EQU X'05' FCB OPTION BITS OFF SET S20202 14100920 * IN JFC S20202 14101020 IEC129RQ EQU X'02' MESSAGE IEC129 REQ'D S20202 14101120 FCBALIGN EQU X'80' FCB OPTION BIT FOR ALIGN S20202 14101220 * FORMS S20202 14101320 FCBVERFY EQU X'40' FCB OPTION BIT FOR S20202 14101420 * VERIFY FCB S20202 14101520 UCSIDOFS EQU X'00' UCS ID OFFSET IN UCB EXT S20202 14101620 UCSOPOFS EQU X'04' UCS OPTION BIT OFF SET S20202 14101720 * IN UCBX S20202 14101820 BUFPARER EQU X'01' UCS BUFFER PARITY ERROR S20202 14101920 ABEND EQU X'FF' ABEND SWITCH S20202 14102020 IMRTNCDS EQU X'18' RETURN CODE FOR IMAGELIB S20202 14102120 * ERROR S20202 14102220 ALIGNSWT EQU X'04' ALIGN FORMS ONLY SWITCH S20202 14102320 VERFYSWT EQU X'01' VERIFY FCB ONLY SWITCH S20202 14102420 NOFCB EQU X'F0' NO FCB LOAD REQUIRED S20202 14102520 * SWITCH S20202 14102620 IMCLOSED EQU X'FF' FLAG SET FOR IMAGELIB S20202 14102720 * NOT S20202 14102820 * OPENED 14102920 * EQUATES FOR CONSTANTS 14103020 * 14103120 X7F EQU X'7F' COMPLETION CODE FLAG S20202 14103220 K0 EQU 0 CONSTANT EQUATED TO 0 S20202 14103320 K1 EQU 1 CONSTANT EQUATED TO 1 S20202 14103420 K2 EQU 2 CONSTANT EQUATED TO 2 S20202 14103520 K3 EQU 3 CONSTANT EQUATED TO 3 S20202 14103620 K5 EQU 5 CONSTANT EQUATED TO 5 S20202 14103720 K6 EQU 6 CONSTANT EQUATED TO 6 S20202 14103820 K7 EQU 7 CONSTANT EQUATED TO 7 S20202 14103920 K8 EQU 8 CONSTANT EQUATED TO 8 S20202 14104020 K10 EQU 10 CONSTANT EQUATED TO 10 S20202 14104120 K12 EQU 12 CONSTANT EQUATED TO 12 S20202 14104220 K14 EQU 14 CONSTANT EQUATED TO 14 S20202 14104320 K15 EQU 15 CONSTANT EQUATED TO 15 S20202 14104420 K16 EQU 16 CONSTANT EQUATED TO 16 S20202 14104520 K19 EQU 19 CONSTANT EQUATED TO 19 S20202 14104620 K20 EQU 20 CONSTANT EQUATED TO 20 S20202 14104720 K25 EQU 25 CONSTANT EQUATED TO 25 S20202 14104820 K27 EQU 27 CONSTANT EQUATED TO 27 S20202 14104920 K29 EQU 29 CONSTANT EQUATED TO 29 S20202 14105020 K31 EQU 31 CONSTANT EQUATED TO 31 S20202 14105120 K32 EQU 32 CONSTANT EQUATED TO 32 S20202 14105220 K35 EQU 35 CONSTANT EQUATED TO 35 S20202 14105320 K36 EQU 36 CONSTANT EQUATED TO 36 S20202 14105420 K976 EQU 976 CONSTANT EQUATED TO 976 S20202 14105520 PRT2245 EQU X'0B' MASK FOR 2245 PRINTER S21092 14107521 * DM0Q 14110018 * EQUATES FOR CONSTANTS DM0Q 14120018 * DM0Q 14130018 K4 EQU 4 DM0Q 14140018 K37 EQU 37 DM0Q 14150018 OABD095 EQU 95 INTERNAL CODE 95 M0009 14170021 * 14200000 *********************************************************************** 14300000 * 14400000 * 14500000 *********************************************************************** 14600000 * 14700000 * 14800000 * INITIALIZE REGISTERS 14900000 * 15000000 * 15100000 *********************************************************************** 15200000 * 15300000 BALR RBASE,0 15400000 USING UCSTART,RBASE 15500000 USING IHADCB,RDCB 15600000 USING FORCORE,RCORE 15700000 USING DEB,RDEB 15800000 USING UCBOB,RUCB 15900000 * 16100000 *********************************************************************** 16200000 * 16300000 UCSTART EQU * 16400000 * 16500000 *********************************************************************** 16600000 * 16700000 L RDCB,0(RPARC) GET DCB ADDR 16800000 L RCORE,4(RWTGC) GET WORK AREA 16900000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 16950001 L RDEB,DCBDEBAD GET DEB ADDR 17000000 .DEBCK10 ANOP Y01021 17050000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 17060000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 17070000 .DEBCK20 ANOP Y01021 17080000 L RUCB,DEBUCBAD GET UCB ADDR 17100000 * 17200000 * 17210020 * SET FLAG TO INDICATE THAT DCB AND DEB FOR SYS1.IMAGELIB HAVE NOT 17220020 * BEEN CONSTRUCTED 17230020 * 17240020 MVI DXCCW8,IMCLOSED MOVE IN FLAG FOR S20202 17250020 * IMAGELIB CLOS S20202 17260020 * 17270020 *********************************************************************** 17300000 * 17400000 WTORTN EQU * 17500000 * 17600000 *********************************************************************** 17700000 * 17800000 * INTIALIZE WTO/WTOR AREA IN OPEN WORK AREA 17900000 * 18000000 *********************************************************************** 18100000 * 18200000 LA RD,RPLY LOAD REPLY ADDRESS A33665 18300020 ST RD,REPLYLTH STORE REPLY ADDR 18400000 MVI REPLYLTH,TWENTY MOVE REPLY LENGTH=20 18500000 LA RD,RPLYECB LOAD ADDR OF ECB FOR A33665 18560020 * WTOR A33665 18620020 ST RD,REPLYECB STORE REPLY ECB ADDR 18700000 MVC LOMASK(8),LOWER MOVE X'40'S TO WORK AREA A33665 18800020 * 18810021 *********************************************************************** 18820021 * 18830021 * IS DEVICE A 2245 PRINTER 18840021 * 18850021 *********************************************************************** 18860021 * 18870021 CLI UCBTBYT4,PRT2245 IS DEVICE A 2245 PRINTER S21092 18880021 BE SYSABEND YES, CHECK FOR ABEND S21092 18890021 * 18900000 *********************************************************************** 19000000 * 19100000 BLKDATA EQU * 19200000 * 19300000 ********************************************************************** 19400000 * 19500000 * EXCP BLOCK/RESET BLOCK DATA CHECK ACCORDING TO DCB SPECIFICATION 19600000 * 19700000 *********************************************************************** 19800000 * 19900000 MVI IOBFLAG1,UNRLMASK SET UNRELATED BIT ON 20000000 XC DXCCW1(8),DXCCW1 RESET CCW AREA 20100000 MVI DXCCW1+4,SILIMASK SET SILI FLAG ON 20200000 MVI DXCCW1+7,ONE SET LENGTH=1 20300000 MVI DXCCW1,BLOCKCCW COMMAND CODE = BLOCK DATA CHECK 20400000 * 20961 20410018 * TEST IF OPTCD IN DCB SPECIFIES UCS FEATURE 20961 20420018 * 20961 20430018 TM DCBMACRF,X'80' TEST IF DCB MACRF=E 20961 20440018 BO EXCPGOGO IF YES,GOTO EXCP RTN 20961 20450018 * 20961 20460018 * 20500000 * TEST IF OPTCD IN DCB SPECIFIES RESET BLOCK DATA CHECK 20600000 * 20700000 TM DCBOPTCD,BLOCKMSK TEST IF DCB OPTCD=U 20800000 BC 14,EXCPGOGO IF NOT,GOTO EXCP RTN 20900000 * 21000000 MVI DXCCW1,UNBLKCCW IF YES,SET CCW= UNBLK DATA CHK 21100000 * 21200000 EXCPGOGO EQU * 21300000 * 21400000 LA RF,DXIOB LOAD IOB ADDR 21500000 EXCP (1) EXCP ON DATA CHECK 21600000 * 21700000 LA RF,DXECB LOAD ECB ADDR 21800000 WAIT ECB=(1) WAIT ON EXCP 21900000 TM DXECB,X'20' TEST FOR SUCCESSFUL I/O 8M226 21910018 BO CONSOLE BRANCH IF O.K. 8M226 21920018 NI DCBOFLGS,X'FE' OTHERWISE, TURN OFF BUSY 8M226 21930018 MVI 0(RWTGC),NULL BIT, CLEAR WTG ENTRY, AND 8M226 21940018 B RELOOP CEASE OPENING THIS DCB. 8M226 21950018 * 22000000 *********************************************************************** 22100000 * 22200000 CONSOLE EQU * 22300000 * 22400000 *********************************************************************** 22500000 * 22600000 * THIS ROUTINE CHECKS IF THE OPENING IS FOR COMPOSITE CONSOLE.IF YES, 22700000 * XCTL TO NEXT SAM OPEN EXECUTOR. 22800000 * 22900000 *********************************************************************** 23000000 * 23100000 L RTIOT,CVTOFF(RE) LOAD CVT ADDR 23200000 USING CVT,RTIOT 23300001 L RC,CVTTCBP LOAD TCB POINTER ADDR 23400000 L RTIOT,4(RC) LOAD THE ADDR OF CURRENT TCB 23500000 USING TCB,RTIOT 23600001 * 23700000 L RC,TCBTIO LOAD TIOT ADDRESS 23800001 AH RC,DCBTIOT ADD OFF-SET TO DDNAME IN TIOT 23900000 * 24000000 CLC COMPCNSL(8),4(RC) TEST IF COMPOSITE CONSOLE 24100000 BC 8,TSTEXCP S20202 24200020 * 24300000 *********************************************************************** 24400000 * 24500000 SYSABEND EQU * 24600000 * 24700000 *********************************************************************** 24800000 * 24900000 * THIS ROUTINE CHECKS IF THE ABEND HAS CONTROL.IF YES,SET A SWITCH TO 25000000 * AVOID ISSUING ANOTHER ABEND. 25100000 * 25200000 *********************************************************************** 25300000 * 25400000 XC DXCCW10(16),DXCCW10 RESET SWITCH AND WORKAREA M5143 25500020 * 25600000 TM TCBFLGS1,TCBFA TEST IF ABEND IS IN PROCESS 25700001 BC 14,SWTCHSET IF NO,GOTO SET SWITCHES RTN 25800000 * 25900000 MVI DXCCW11+2,ABENDBIT 26000000 * 26100000 *********************************************************************** 26200000 * 26300000 SWTCHSET EQU * 26400000 * 26500000 *********************************************************************** 26600000 * 26700000 * RESET & SET SWITCHES - 1ST BYTE - SWITCH 2ND BYTE - EROPT 26800000 * 3RD BYTE - UNUSED 4TH BYTE - UCS OP 26900000 * 5-8TH BYTES - UCS ID 27000000 * 27100000 *********************************************************************** 27200000 * 27300000 MVC DXCCW11+1(1),DXCCW6 SAVE DCB EROPT 27400000 MVI DXCCW10,NOFCB INIT FOR NO FCB LOAD M0151 27410021 L RJ,UCBXTADR GET UCB EXT ADDRESS M0151 27420021 CLI UCBTBYT4,PRT2245 CHECK FOR 2245 PRINTER S21092 27430021 BE WKARINFO YES, SKIP UCS CODE S21092 27460021 MVC DXCCW11+4(4),JFCUCSID MOVE UCS ID IN JFCB 27500000 MVC DXCCW11+3(1),JFCUCSOP MOVE UCS OPTION BITS 27600000 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 27602020 * FOR 321 S20202 27602520 BNE UCSIDTST NO GO CK UCS PARAMETER S20202 27603020 * FOR 140 S20202 27603520 * 27604020 *********************************************************************** 27604520 * 27605020 * WORK AREA FOR FCB INFORMATION BYTE1=SWITCH 27605520 * BYTE2 NOT USED 27606020 * BYTE3 ERROR FLAG 27606520 * BYTE4 - FCB OP 27607020 * BYTE5-8 - FCB IMAGE ID 27607520 * 27608020 *********************************************************************** 27608520 * 27609020 WKARINFO EQU * S21092 27609121 * 27609221 *********************************************************************** 27609321 * 27609421 MVC DXCCW10+K4(K4),JFCFCBID MOVE FCB ID TO WKAREA S20202 27609520 * 27610020 * THIS ROUTINE PUTS THE FCB OPTIONS INTO THE FCB WORKAREA FROM JFCB 27610520 * DXCCW10+3 = X'80' ALIGN 27611020 * DXCCW10+3 = X'40' VERIFY 27611520 * 27612020 * 27612520 IC RB,JFCUCSOP LOAD FCB OPTIONS INTO S20202 27613020 * REG 12 S20202 27613520 SRL RB,SHIFTRHT SHIFT OUT BITS 6 & 7 OF S20202 27614020 * BYTE 3 S20202 27614520 SLL RB,SHIFTLFT SHIFT BITS 6 & 7 OF BYTE S20202 27615020 * 3 TO S20202 27615520 * BITS 0 & 1 OF BYTE 3 27616020 STC RB,DXCCW10+K3 LOAD FCB OPT INTO S20202 27616520 * WORKAREA S20202 27617020 * 27617520 * 27618020 *********************************************************************** 27618520 * 27619020 * TEST IF FCB PARAMETERS ARE SPECIFIED IN DD STATEMENT FOR DCB 27619520 * AND SET SWITCHES (DXCCW10) FOR FCB 27620020 * X'00' - FCB LOAD REQUIRED 27620520 * X'01' - ENTRY ONLY FOR FCB VERIFY 27621020 * X'02' - ENTRY FROM WTOR IEC129 27621520 * X'04' - ALIGN FORMS ONLY 27622020 * X'F0' - NO FCB LOAD REQUIRED 27622520 * 27623020 *********************************************************************** 27623520 * 27624020 CLI DXCCW10+K4,NULL CK IF FCB SPECIFIED IN S20202 27624520 * DD ST S20202 27625020 BNE PADFCBID YES GO PAD FCB ID WITH S20202 27625520 * BLANKS S20202 27626020 * 27626520 *********************************************************************** 27627020 * 27627520 * WHEN FCB NOT SPECIFIED IN DD STATEMENT,CHECK IF CURRENT FCB IN THE 27628020 * BUFFER IS A DEFAULT 27628520 * 27629020 *********************************************************************** 27629520 * 27630020 LA RD,WTOR129 SET REG FOR RETURN IF S20202 27630520 * IEC129 R S20202 27631020 CLI FCBIDOFS(RJ),NULL CK IF FCB ID IN UCB S20202 27631520 BCR 8,RD IF NOT, GO WTOR IEC129 27632001 TM FCBOPOFS(RJ),DEFALT CK IF CURRENT FCB IS A S20202 27633020 * DEFAULT S20202 27633520 BZ WTOR129 NO GO TO WTOR IEC129 S20202 27634020 * YES- NO FCB LD REQUIRED 27634520 * CURRENT FCB IS A DEFAULT 27635020 B UCSIDTST GO TEST FOR UCS S20202 27635520 * PARAMETERS S20202 27636020 * 27636520 *********************************************************************** 27637020 * 27637520 * WHEN THE FCB IMAGE IN THE BUFFER IS NOT A DEFAULT OR NO FCB IMAGE 27638020 * LOADED REQUEST OPERATOR TO SPECIFY AN ALTERNATE BY ISSUEING A WTOR 27638520 * 'IEC129D XXX SPECIFY FCB PARAMETER' 27639020 * 27639520 *********************************************************************** 27640020 * 27640520 WTOR129 EQU * S20202 27641020 * 27641520 MVC MSGLSTSZ(K37),DSPLY129 MOVE MESSAGE TEXT FOR S20202 27642020 * IEC129D S20202 27642520 * INTO MESSAGE AREA 27643020 MVI DXCCW10,IEC129RQ SET SWITCH FOR IEC129 S20202 27643520 * REQUIRED S20202 27644020 B UCSIDTST GO TEST UCS PARAMETERS S20202 27644520 * 27645020 *********************************************************************** 27645520 * 27646020 * WHEN FCB SPECIFIED IN DD STATEMENT,PAD FCB IMAGE ID WITH BLANKS 27646520 * 27647020 *********************************************************************** 27647520 * 27648020 * 27648520 * 27649020 PADFCBID EQU * S20202 27649520 * 27650020 * 27650520 LA RB,DXCCW10+K5 LOAD ADDRESS OF FCB ID + S20202 27651020 * 1 S20202 27651520 BAL RD,PADNAME GO PAD FCB ID WITH S20202 27652020 * BLANKS S20202 27652520 * 27653020 *********************************************************************** 27653520 * 27654020 * TEST IF PARAMETERS IN UCB EQ FCB PARAMETERS IN DD STATEMENT 27654520 * 27655020 *********************************************************************** 27655520 CLC FCBIDOFS(K4,RJ),DXCCW10+K4 CK IF FCB IDS ARE S20202 27656020 * EQUAL S20202 27656520 BNE SETFCBLD GO SET SWITCH FOR FCB LD S20202 27657020 CLI DXCCW10+K3,FCBVERFY CK IF VERIFY SPECIFIED S20202 27657520 BE SETVFYB YES SET SWITCH FOR S20202 27658020 * VERIFY ONLY S20202 27658520 CLI DXCCW10+K3,FCBALIGN CK IF ALIGN FORMS S20202 27659020 * SPECIFIED S20202 27659520 BE SETALIGN YES SET ALIGN ONLY BIT S20202 27660020 * FCB SPECIFIED=FCB LOADED AND 27660520 * NO VERIFY OR ALIGN SPECIFIED 27661020 * SO NO FCB LOAD REQUIRED 27661520 B UCSIDTST GO TEST UCS PARAMETERS S20202 27662020 * 27662520 SETALIGN EQU * S20202 27663020 * 27663520 MVI DXCCW10,ALIGNSWT SET SWITCH TO INDICATE S20202 27664020 * ENTRY S20202 27664520 * ONLY TO ALIGN FORMS 27665020 B UCSIDTST GO TEST UCS PARAMETERS S20202 27665520 * 27666020 SETVFYB EQU * S20202 27666520 * 27667020 MVI DXCCW10,VERFYSWT SETSWITCH TO INDICATE S20202 27667520 * ENTRY IS S20202 27668020 * ONLY TO VERIFY FCB&ALIGN FORMS 27668520 B UCSIDTST GO TEST UCS PARAMETERS S20202 27669020 * 27669520 CKFCBLD EQU * S20202 27670020 CLI DXCCW10,VERFYSWT DETERMINE WHICH FCB S20202 27670520 * EXECUTOR S20202 27671020 * IS TO BE XCTLED TO 27671520 BH XCTL197F FOR ALIGN FORMS GO TO S20202 27672020 * IGGO197F S20202 27672520 * OTHERWISE GO TO IGG0197E FOR 27673020 * LOCATING AND LOADING FCB IMAGE 27673520 * 27674020 * LOAD TTR OF IGG0197E AND GO ISSUE SVC 105 TO BUILD DCB AND DEB 27674520 * 27675020 *********************************************************************** 27675520 * 27676020 * 27676520 XCTL197E EQU * S20202 27677020 * 27677520 * 27678020 LA RDEB,MODNM7E LOAD ADDR OF TTR FOR S20202 27678520 * IGG0197E S20202 27679020 B OPENIMLB GO OPEN SYS1.IMAGELIB S20202 27679520 * 27680020 * 27680520 *********************************************************************** 27681020 * 27681520 * XCTL TO EXECUTOR IGG0197F TO ALIGN FORMS (NM 2) 27682020 * 27682520 *********************************************************************** 27683020 * 27683520 XCTL197F LA RF,MODNM7F LOAD ADDR OF TTR FOR S20202 27684020 * IGG0197F S20202 27684520 B MVEIDTTR GO TO MOVE ID TTR S20202 27685020 * ROUTINE S20202 27685520 * 27686020 *********************************************************************** 27686520 * 27687020 SETFCBLD EQU * S20202 27687520 * 27688020 MVI DXCCW10,NULL SET SWITCH FOR FCB LOAD S20202 27688520 * 27689020 *********************************************************************** 27689520 * 27700000 *********************************************************************** 27800000 * 27900000 UCSIDTST EQU * 28000000 * 28100000 *********************************************************************** 28200000 * 28300000 * TEST IF UCS PARAMETER IS SPECIFIED IN DD STATEMENT FOR THE DCB 28400000 * 28500000 ********************************************************************** 28600000 * 28700000 CLI UCBTBYT4,PRT2245 CHECK FOR 2245 PRINTER S21092 28730021 BE UCSEXIT YES, GO TO 197E OR 7F M0151 28760021 CLI DXCCW11+4,NULL TEST IF UCS IS IN DD STATEMENT 28800000 BC 7,PADUCSID IF YES,GOTO PAD UCS ID ROUTINE 28900000 * 29000000 *********************************************************************** 29100000 * 29200000 NOUCSID EQU * 29300000 * 29400000 *********************************************************************** 29500000 * 29600000 * WHEN UCS IS NOT SPECIFIED IN DD STATEMENT,CHECK UCB IF A 29700000 * DEFALT UCS IMAGE IS IN THE BUFFER 29800000 * 29900000 *********************************************************************** 30000000 * 30100000 * 30120020 LA RD,WTOR123 SET REG TO PT MESSAGE S20202 30140020 * IEC123 S20202 30160020 * IF A MESSAGE IS REQUIRED 30180020 CLI UCSIDOFS(RJ),NULL CK IF UCS ID IN UCB S20202 30200020 BCR 8,RD IF NOT, GO WTOR IEC123 30220001 * 30260020 TM UCSOPOFS(RJ),DEFALT TEST IF UCS IMAGE IS A S20202 30280020 * DEFAULT S20202 30300020 BNO WTOR123 NO GO TO WTOR IEC123 S20202 30320020 TM UCSOPOFS(RJ),BUFPARER TEST IF UCS HAD BUFFER S20202 30340020 * PARITY S20202 30360020 * ERROR ON PREVIOUS JOB 30380020 BNO UCSEXIT NO GO TO EXIT ROUTINE S20202 30400020 MVC DXCCW11+K4(K4),UCSIDOFS(RJ) LOAD UCS ID S20202 30420020 MVC DXCCW11+K3(K1),UCSOPOFS(RJ) LOAD UCS IMAGE S20202 30440020 * OPTIONS S20202 30460020 XC UCSIDOFS(K4,RJ),UCSIDOFS(RJ) ZERO UCS ID IN UCS S20202 30480020 * EXT S20202 30500020 OI DXCCW11,SWITCHON SET SWITCHES A50376 30510021 B RSTCORE GO RESET CORE BIT S20202 30520020 * 30540020 * 30560020 * 30700000 *********************************************************************** 33000000 * 33100000 WTOR123 EQU * 33200000 * 33205020 *********************************************************************** 33210020 * 33215020 * SET SWITCH TO INDICATE ENTRY TO IGG191U WILL BE FROM IEC123 33220020 * 33225020 *********************************************************************** 33230020 * 33235020 * 33240020 * 33245020 LA RD,XCTL191U GET ADDRESS OF XCTL191U S20202 33250020 * ROUTINE TO LOAD TTR_ID OF 33255020 * MODULE IGG0191U 33260020 * 33265020 * 33270020 MVI DXCCW11,NULL SET SWITCH FOR ENTRY S20202 33275020 * FROM WTOR S20202 33280020 * 33285020 * 33300000 *********************************************************************** 33400000 * 33500000 * WHEN THE IMAGE IN THE BUFFER IS NOT A DEFALT,REQUEST AND ALTERNATE 33600000 * UCS IMAGE AND CHAIN TO BE MOUNTED 33700000 * WTOR 'IEC123D SPECIFY UCS PARAMETER' 33800000 * 33900000 *********************************************************************** 34000000 * 34100000 MVC MSGLSTSZ(37),DSPLY123 MOVE MESSAGE TEXT 34200000 * 34220020 WTORSEQ EQU * S20202 34240020 * 34260020 MVC MESSAGEA+8(3),UCBNAME MOVE DEVICE NAME TO DISPLAY 34300000 MVC MSGLSTSZ+K37(K4),CODE123D MOVE IN DESC, ROUT CODES DM0Q 34380018 MVI RPLY,BLANK A33665 34460020 MVC RPLY+1(19),RPLY CLEAR REPLY AREA A33665 34540020 MVI RPLYECB,NULL RESET REPLY ECB A33665 34620020 LA RF,REPLYLTH LOAD WTOR ADDR 34700000 * 34800000 SVC 35 ISSUE WTOR SVC 34900000 * 35000020 * 35100020 * 35200020 BR RD GO TO ADDRESS IN S20202 35300020 * REGISTER 14 S20202 35400020 * 35500020 * 35600020 * 35700020 * 35800020 * 35900000 *********************************************************************** 36000000 * 36100000 PADUCSID EQU * 36200000 * 36300000 *********************************************************************** 36400000 * 36500000 * WHEN UCS IS SPECIFIED IN DD STATEMENT,PAD UCS IMAGE ID WITH X'40' 36600000 * 36700000 *********************************************************************** 36800000 * 36900000 LA RD,SETSWTCH SET SWITCHES AFTER PAD S20202 36930020 * UCS ID S20202 36960020 LA RB,DXCCW11+5 LOAD +1(UCS ID) ADDR 37000000 * 37020020 PADNAME EQU * S20202 37040020 * 37060020 * 37080020 LA RC,THREE LOAD X'03' 37100000 * 37200000 COMPBYTE EQU * 37300000 * 37400000 CLI NULL(RB),NULL TEST IF UCS IMAGE HAS X'00' 37500000 BC 7,NEXTBYTE IF NOT,GOTO TEST NEXT BYTE 37600000 * 37700000 MVI NULL(RB),BLANK IF YES,REPLACE X'00' BY X'40' 37800000 * 37900000 NEXTBYTE EQU * 38000000 * 38100000 LA RB,ONE(RB) INCREMENT REG. BY '1' 38200000 BCT RC,COMPBYTE GOTO COMPARE NEXT BYTE 38300000 BR RD BRANCH TO SET SWITCHES S20202 38350020 * 38400000 *********************************************************************** 38500000 * 38600000 SETSWTCH EQU * 38700000 * 38800000 *********************************************************************** 38900000 * 39000000 * SET SWITCHES 39100000 * SWITCHES (DXCCW11) 39200000 * * 1ST BYTE 39300000 * BO-BLDL REQUIRED 39400000 * B1-IEC120 REQUIRED 39500000 * B2-LOAD FROM SYS1.SVCLIB 39600000 * B3-EXCP ON LOAD UCS 39700000 * B4 - VERIFY IS REQUIRED. 39800000 * B5 - CORE TRANSFER. 39900000 * 40000000 *********************************************************************** 40100000 * 40200000 MVI DXCCW11,FFMASK SET SWITCH TO X'FC' 40300000 * 40400000 *********************************************************************** 40500000 * 40600000 COMPUCS EQU * 40700000 * 40800000 *********************************************************************** 40900000 * 41000000 * TEST IF UCS PARAMETERS IN UCB = UCS PARAMETERS IN DD STATEMENT 41100000 * 41200000 *********************************************************************** 41300000 * 41400000 CLC UCSIDOFS(K4,RJ),DXCCW11+K4 CK IF SPECIFIED S20202 41470020 * UCS=CURRENT S20202 41540020 BC K7,RSTCORE GO RESET CORE BIT S20202 41610020 * 41680020 MVC DXCCW1(K1),UCSOPOFS(RJ) IF YES MOVE UCS OPT FROM S20202 41750020 * UCB S20202 41820020 XC DXCCW1(1),DXCCW11+3 TEST IF LOAD MODES ARE EQUAL 41900000 TM DXCCW1,FOLD TEST IF EQUAL 42000000 BC 14,CHCKVRFY IF YES,GOTO TEST VERIFY IS SPEC 42100000 * 42200000 *********************************************************************** 42300000 * 42400000 * WHEN UCS IDS ARE EQUAL BUT LOADS MODES ARE NOT,SET A SWITCH TO 42500000 * INDICATE NO IEC120 IS REQUIRED AND GOTO TEST CORE TRANSFER IS SPEC. 42600000 * 42700000 *********************************************************************** 42800000 * 42900000 NI DXCCW11,NOIEC120 SET SW TO NO IEC120 IS REQUIRED 43000000 B RSTCORE GO RESET CORE BIT S20202 43100020 * 43200000 *********************************************************************** 43300000 * 43400000 CHCKVRFY EQU * 43500000 * 43600000 *********************************************************************** 43700000 * 43800000 * WHEN UCS PARAMETERS ARE EQUAL,TEST IF VERIFIED IS SPECIFIED. 43900000 * 44000000 *********************************************************************** 44100000 * 44200000 TM DXCCW11+3,VERIFY TEST IF VERIFY IS REQUIED 44300000 BC 14,UCSEXIT IF NOT,GOTO EXIT ROUTINE 44400000 * 44500000 *********************************************************************** 44600000 * 44700000 * WHEN VERIFY IS REQUIRED,SET SWITCH TO INDICATE NO IEC120 IS 44800000 * REQUIRED AND ONLY FOR VERIFICATION 44900000 * 45000000 *********************************************************************** 45100000 * 45200000 NI DXCCW11,VRFYETRY NO IEC120 AND ENTRY IS FOR VRFY 45300000 * 45400000 RSTCORE EQU * 53200000 * 53300000 *********************************************************************** 53400000 * 53500000 * SET SWITCH TO INDICATE LOADING FROM SYS1.IMAGELIB 53600020 * 53700000 *********************************************************************** 53800000 * 53900000 NI DXCCW11,NOCORE 54000000 * 54100000 *********************************************************************** 54200000 * 54300000 XCTL191U EQU * 54400000 * 54500000 *********************************************************************** 54600000 * 54700000 * XCTL TO EXECUTOR IGG0191U TO LOAD IMAGE. 54800000 * 54900000 *********************************************************************** 55000000 * 55100000 * 55103020 * 55106020 * 55109020 LA RDEB,MODNM1U LOAD ADDR OF TTR FOR S20202 55112020 * IGG3191U S20202 55115020 * 55118020 * 55121020 * 55124020 OPENIMLB EQU * S20202 55127020 * 55130020 * 55133020 SR RF,RF ZERO OUT REGISTER 1 S20202 55136020 * 55139020 * ISSUE SVC TO OPEN SYS1.IMAGELIB 55142020 * 55145020 SVC 105 ISSUE SVC TO OPEN S20202 55148020 * SYS1.IMAGELI S20202 55151020 LTR RF,RF TEST IF IMAGELIB OPENED S20202 55154020 * SUCCES S20202 55157020 BE IMAGEROR IF NOT GO LOAD TTR OF S20202 55160020 * OPEN MOD S20202 55163020 ST RF,DXCCW8 SAVE ADDRESS OF IMAGELIB S20202 55166020 * DCB A S20202 55169020 * 55172020 * 55175020 * 55178020 LR RF,RDEB GET ADDR OF OPEN S20202 55181020 * EXECUTOR TTR S20202 55184020 BC K15,MVEIDTTR GOTO MOVE ID TTR ROUTINE S20202 55187020 * 55190020 * 55193020 * 55196020 IMAGEROR EQU * S20202 55199020 * 55202020 * 55205020 * THIS ROUTINE CONVERTS RETURN CODE FROM IMAGELIB TO AN 55207021 * INTERNAL CODE FOR PROBLEM DETERMINATION 55209021 * RETURN CODE INTERNAL CODE 55211021 * X'04' 95 55213021 * X'08' 96 55215021 * X'0C' 97 55217021 * 55223020 LA RF,OABD095-K1 PUT INTERNAL CODE IN REG M0009 55227021 SRL RJ,2 DIVIDE RTN CODE BY 4 YM3213 55227401 AR RJ,RF IF REG15=1, THEN M0009 55228021 * INTERNAL CODE IS 95, 55229021 * ABEND CODE IS B13-20 55230021 * IF REG 15=2, THEN 55231021 * INTERNAL CODE IS 96, 55232021 * ABEND CODE IS B13-24 55233021 * IF REG 15=3, THEN 55234021 * INTERNAL CODE IS 97, 55235021 * ABEND CODE IS B13-28 55236021 MVI DXCCW10+K1,ABEND SET ABEND FLAG S20202 55250020 STC RJ,DXCCW11 STORE RETURN CODE S20202 55253020 LA RF,MODNM1V GET IDTTR OF IGGO191V S20202 55256020 B MVEIDTTR GO MOVE IDTTR AND XCTL S20202 55259020 *********************************************************************** 55262020 * 55265020 *********************************************************************** 55268020 * 55271020 BC 15,MVEIDTTR GOTO MOVE ID TTR ROUTINE 55300000 * 55400000 *********************************************************************** 55500000 * 55600000 *********************************************************************** 55700000 * 55800000 UCSEXIT EQU * 55900000 * 56000000 *********************************************************************** 56100000 * 56200000 * EXIT FROM UCS EXECUTORS 56300000 * DETERMINE THE NEXT STAGE 2 EXECUTOR TO BE XCTLED 56400000 * 56500000 *********************************************************************** 56600000 * 56602020 LA RD,XCTL197F GET ADDRESS OF ROUTINE S20202 56604020 * THAT S20202 56606020 * LOADS TTR_ID OF MODULE IGG0197F 56608020 * 56610020 CLI DXCCW10,NOFCB CK IF FCB LOAD REQUIRED S20202 56612020 BE ERPWARTN NO GO GET WORK AREA FOR S20202 56614020 * ERP S20202 56616020 TM DXCCW10,IEC129RQ CK IF AN IEC129 MESSAGE S20202 56618020 * REQURD S20202 56620020 BNO CKFCBLD NO GO CK FCB OPTIONS S20202 56622020 LA RD,XCTL197E GET ADDRESS OF 197E S20202 56624020 B WTORSEQ GO ISSUE SPECIFY FCB S20202 56626020 * MESSAGE S20202 56628020 * 56630020 *********************************************************************** 56632020 * 56634020 * TEST IF A 3211 DCB. IF SO, SET UP 3211 ERP WORK AREA. * 56636021 * 56638020 *********************************************************************** 56640020 * 56642020 * 56644020 ERPWARTN EQU * S20202 56646020 * 56648020 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 56650020 * FOR 321 S20202 56652020 BNE RSTEROPT IF NOT GO RESET EROPT S20202 56654020 * FLAG BIT S20202 56656020 MVI DXCCW10+K2,STGETWO TURN ON 197F ENTRY FLAG M1803 56658021 B XCTL197F GO XCTL TO IGG0197F M1803 56660021 * 56666020 RSTEROPT EQU * S20202 56668020 * 56670020 * 56672020 MVC DXCCW6(K1),DXCCW11+K1 RESTORE EROPT IN DCB S20202 56674020 * 56676020 * 56678020 * 56700000 TSTEXCP EQU * 56800000 * 56900000 *********************************************************************** 57000000 * 57100000 * TEST IF EXCP IS SPECIFIED.IF YES,XCTL TO THE LAST OPEN EXECUTOR 57200000 * 57300000 *********************************************************************** 57400000 * 57500000 TM DCBMACRF,EXCPMASK TEST IF EXCP IS SPECIFIED 57600000 BC 14,TSTBLKBF IF NOT,GOTO BUFFER CNTRL BLK 57700000 * 57800000 MVI 0(RWTGC),NULL IF YES,ZERO NAME FIELD 57900000 BC 15,RELOOP GOTO WTG TABLE UPDATE 58000000 * 58100000 *********************************************************************** 58200000 * 58300000 TSTBLKBF EQU * 58400000 * 58500000 *********************************************************************** 58600000 * 58700000 * TEST IS BUFFER CONTROL BLOCK IS SPECIFIED.IF YES,XCTL TO IGG0911I 58800000 * 58900000 *********************************************************************** 59000000 * 59100000 TM DCBBUFNO+3,BFCNTRL BUFFER CONTROL BLOCK SPECIFIED 59200000 BC 14,TSTPCI IF NOT,GOTO TEST PCI ROUTINE 59300000 * 59400000 SR RE,RE RESET REGISTER 59500000 IC RE,DCBBUFNO GET THE NO OF BUFFER SPECIFIED 59600000 LTR RE,RE TEST IF DCBBUFNO='0' 59700000 BC 8,TSTPCI IF YES,GOTO TEST PCI 59800000 * 59900000 LA RF,MODNM1I LOAD ADDR OF IDTTR OF IGG0191I 60000000 BC 15,MVEIDTTR GOTO MOVE IDTTR ROUTINE 60100000 * 60200000 *********************************************************************** 60300000 * 60400000 TSTPCI EQU * 60500000 * 60600000 AIF ('&LIB' EQ 'LIB1').LIB1AA 60607001 *********************************************************************** 60614001 * 60621001 * TEST FOR VIRTUAL=REAL. PCI IS ONLY HONORED FOR V=R. 60628001 * 60635001 *********************************************************************** 60642001 * 60649001 L RTIOT,DEBTCBAD GET TCB ADDRESS 60656001 USING TCB,RTIOT 60663001 TM TCBFLGS6,TCBRV TEST FOR REAL ADDR SPACE 60670001 BZ BQSAMOUT BRANCH IF VIRTUAL. 60677001 DROP RTIOT 60684001 * 60691001 .LIB1AA ANOP 60698001 *********************************************************************** 60700000 * 60800000 * TEST IF PCI IS SPECIFIED.IF YES,XCTL TO IGG0191Q 60900000 * 61000000 *********************************************************************** 61100000 * 61200000 TM DCBOPTCD,PCIMASK TEST IF PCI SPECIFIED 61300000 BC 14,BQSAMOUT IF NOT,GOTO BSAM/QSAM ROUTINEED 61400000 * 61500000 LA RF,MODNM1Q LOAD ADDR OF IDTTR OF IGG0191Q 61600000 BC 15,MVEIDTTR GOTO MOVE IDTTR ROUTINE 61700000 * 61800000 *********************************************************************** 61900000 * 62000000 BQSAMOUT EQU * 62100000 * 62200000 AIF ('&LIB' EQ 'LIB1').LIB101 A50376 62205021 *********************************************************************** 62210001 * * 62215001 * TEST FOR JES DATA MANAGEMENT * IF YES, XCTL TO OPEN * 62220001 * * 62225001 *********************************************************************** 62230001 CLI DCBRELAD,ACBID IS CONTROL BLOCK AN ACB 62235001 BNE JESOUT NO * GO TO XCTL TO BSAM/QSAM 62240001 MVI 0(RWTGC),NULL YES * ZERO ID IN WTG TABLE 62245001 B RELOOP GO TO XCTL TO OPEN 62250001 JESOUT EQU * 62255001 .LIB101 ANOP 62260001 *********************************************************************** 62300000 * 62400000 * BSAM/QSAM EXIT.XCTL TO IGG0191G 62500000 * 62600000 *********************************************************************** 62700000 * 62800000 LA RF,MODNM1G LOAD ADDR OF IDTTR IF IGG0191G 62900000 * 63000000 *********************************************************************** 63100000 * 63200000 MVEIDTTR EQU * 63300000 * 63400000 *********************************************************************** 63500000 * 63600000 * MOVE IDTTR TO XCTL WTG TABLE 63700000 * 63800000 *********************************************************************** 63900000 * 64000000 MVC 0(5,RWTGC),0(RF) STORE NEXT MODULE ID IN WTG 64100000 * 64200000 *********************************************************************** 64300000 * 64400000 RELOOP EQU * 64500000 * 64600000 *********************************************************************** 64700000 * 64800000 * UPDATE WTG TABLE AND XCTL TO NEXT MODULE 64900000 * 65000000 *********************************************************************** 65100000 * 65200000 LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURRENT WTG ENTRY 65300000 LA RPARC,PLOFF(0,RPARC) INCREMENT CURRENT DCB ENTRY 65400000 CLC 0(2,RWTGC),AMIDCNST IS THE RTN NEEDED AGAIN 65500000 BCR 8,RBASE IF YES,RETURN TO PROCESS 65600000 * 65700000 CLC 0(2,RWTGC),OPIDCNST TEST END OF WTG TABLE 65800000 BC 7,RELOOP IF NOT,CHECK NEXT ENTRY 65900000 * 66000000 LR RPARC,RPAR RESET REG TO '0' 66100000 LA RWTGC,WAOFF(0,RWTG) RESET WTG REG TO POINT +32(WTG) 66200000 ZCHECK CLI 0(RWTGC),X'00' TEST IF THIS ENTRY COMPLETE 66300000 BC 7,TCTLRTN IF NOT,XCTL 66400000 * 66500000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY OF WTG TABLE 66600000 LA RPARC,PLOFF(0,RPARC) GET NEXT ENTRY OF DCB 66700000 BC 15,ZCHECK GOTO TEST COMPLETION 66800000 * 66900000 TCTLRTN EQU * 67000000 * 67100000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 67200000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 67300000 * 67400000 LA RJ,DXCCW12 SET UP XCTL 67500000 * 67600000 XCTL DE=(RWTG),SF=(E,(15)) 67700000 * 67800000 *********************************************************************** 67900000 * 68000000 * 68100000 *********************************************************************** 68200000 * 68300000 * CONSTANTS 68400000 * 68500000 *********************************************************************** 68600000 * 68700000 * FOR WTG TABLE 68800000 * 68900000 OPIDCNST DC C'0S' 69000000 AMIDCNST DC C'1T' 69100000 WTGCNST DC C'IGG019 ' 69200000 * 69300000 * MESSAGE TEXT 69400000 * 69500000 DSPLY123 DC X'00258000' DM0Q 69600018 DC C'IEC123D SPECIFY UCS PARAMETER' 69700000 DSPLY129 DC X'00258000' OY00103 69730002 DC C'IEC129D SPECIFY FCB PARAMETER' S20202 69760020 LOWER DC X'4040404040404040' MASK TO OR REPLY 69800000 COMPCNSL DC C'IEECVTSK' DDNAME FOR COMPOSITE CONSOLE 69900000 CODE123D DC X'40000200' DESCRIPTOR, ROUTING CODES DM0Q 69950018 * 70000000 * 70100000 *********************************************************************** 70200000 * 70300000 * XCTL TABLE 70400000 * 70500000 *********************************************************************** 70600000 * 70700000 XCTLTABL ID=(MODNM1G,1G,MODNM1I,1I,MODNM1Q,1Q,MODNM1U, A50376*70730021 1U,MODNM1V,1V,MODNM7E,7E,MODNM7F,7F),SVC=019 A50376 70760021 * 72100000 *********************************************************************** 72200000 * 72300000 * DSECT 72400000 * 72500000 *********************************************************************** 72600000 * 72700000 * 72800000 DCBD DSORG=PS 72900000 * 73000000 *********************************************************************** 73100000 * 73200000 FORCORE DSECT 73300000 IECDSECT 73400000 ORG REPLYLTH+52 A33665 73440020 RPLY DS 20C A33665 73480020 RPLYECB DS F A33665 73520020 MCSMASK DS H A33665 73560020 LOMASK DS 8C A33665 73600020 UCSID DS 4C A33665 73640020 * 73700000 *********************************************************************** 73800000 * 73900000 SRT DSECT 74000000 IEFUCBOB 74100000 * 74200000 *********************************************************************** 74300000 * 74400000 CVT DSECT 74500000 CVT 74600000 * 74700000 *********************************************************************** 74800000 * 74900000 * DATA EXTENT BLOCK (UNTIL PROTIOS CHANGES) 75000000 DEB DSECT 75100000 DEBNMSUB DS 0CL1 75200000 DEBTCBAD DS CL4 75300000 DEBAMLNG DS 0CL1 75400000 DEBDEBAD DS CL4 75500000 DEBOFLGS DS 0CL1 75600000 DEBIRBAD DS CL4 75700000 DEBOPATB DS 0CL1 75800000 DEBSYSPG DS CL4 75900000 DEBNMEXT DS 0CL1 76000000 DEBUSRPG DS CL4 76100000 DEBPRIOR DS 0CL1 76200000 DEBECBAD DS CL4 76300000 DEBPROTG DS 0CL1 76400000 DEBDEBID DS 0CL1 76500000 DEBDCBAD DS CL4 76600000 DEBEXSCL DS 0CL1 76700000 DEBAPPAD DS CL4 76800000 DEBDVMOD DS 0CL1 76900000 DEBUCBAD DS CL4 77000000 DEBTVLSQ DS 0CL2 VOL SEQ FOR TAPE 77100000 DEBBINUM DS CL2 77200000 DEBTVLNM DS 0CL2 NO OF VOL FOR TAPE 77300000 DEBSTRCC DS CL2 77400000 DEBSTRHH DS CL2 77500000 DEBENDCC DS CL2 77600000 DEBENDHH DS CL2 77700000 DEBNMTRK DS CL2 77800000 * FOR ADDITIONAL EXTENT ON DIRECT ACCESS THE FOLLOWING FIELDS 77900000 * WILL HAVE TO BE OFFSET ANOTHER 16 BYTES 78000000 DEBVOLSQ DS H 78100000 DEBVOLNM DS H 78200000 * FOR EACH SUBROUTINE LOADED BUMP THIS OFFSET BY 2 78300000 DEBSUBID DS H 78400000 * 78500000 EJECT 78510001 IKJTCB 78520001 *********************************************************************** 78600000 * 78700000 END 78800000 ./ ADD SSI=21480003,NAME=IGG0191U,SOURCE=0 TITLE 'IGG0191U - UCS IMAGE RETRIEVAL' 00100000 COPY LCGASMSW 00120001 * 00140001 * 00180001 IGG0191U CSECT 00200000 * RELEASE 17 DELETIONS 00300000 * RELEASE 18 DELETIONS 00400000 *0730306000-308000,319000,337000-338000,340000,344000,347000, DM0Q 00410018 *0730377000,386000,412000,414000,445000,466000,478000, DM0Q 00420018 *0730507000-508000,769000,771000,773000 DM0Q 00430018 *0730 MCS 00450018 * RELEASE 19 DELETIONS 00500000 *1061306600-308200 A27331 00550019 * RELEASE 20 DELETIONS 00600000 *3364511000,514000 M5149 00605020 *3364305400-306200,319000,337000-340000,344000,347000,377000, A33665 00610020 *3364386000,396000,445000,466000,478000,507000-508000 A33665 00620020 *3364412500,774000,783600 A33684 00650020 *3364013000-016000,040000,044000-045000,051000-058000,066000- S20202 00660020 *3364067000,139000,140000-141000,195000,202000-205000,241000, S20202 00670020 *3364249000,314000-315000,354000-365000,479000-495000,530000- S20202 00680020 *3364576000,582000-592000,604000,719000-750000 S20202 00690020 *3364475000 A34950 00695020 * RELEASE 21 DELETIONS 00700000 *1033361800,603930,791000-799000,811000-816000 S21042 00750020 * RELEASE 22 DELETIONS 00800000 * RELEASE 23 DELETIONS 00900000 * RELEASE 24 DELETIONS 01000000 * RELEASE 25 DELETIONS 01100000 *STATUS CHANGE LEVEL 004 01200021 *FUNCTION/OPERATION- ISSUE BLDL MACRO TO LOCATE THE UCS IMAGE 01300020 * IN SYS1.IMAGELIB 01400020 * - DISPLAY IEC120 MESSAGE TO REQUEST AN OPERATOR 01700000 * MOUNT THE CHAIN. 01800000 * - WHEN THE IMAGE IS NOT IN THE SYS1.SVCLIB,DISPLAY 01900000 * - WHEN IMAGE NOT IN SYS1.IMAGELIB DISPLAY MESSAGE 01950020 * IEC122 MESSAGE TO REQUEST AN OPERATOR SPECIFY AN 02000000 * ALTERNATE CHAIN. 02100000 * - ANALIZE REPLY MADE BY AN OPERATOR 02200000 * - DETERMINES WHETHER THE REPLIED IMAGE IS TO BE 02300000 * LOADED. 02400000 * 02500000 *ENTRY POINT - ENTERED FROM IGG0191T BY THE USE OF XCTL MACRO 02600000 * 02700000 *INPUT - DCB ADDRESS 02800000 * - OPEN WORK AREA ADDRESS 02900000 * - WHERE-TO-GO TABLE 03000000 * - PARAMETER LIST 03100000 * - CURRENT ENTRY IN W-T-G TABLE 03200000 * - CURRENT PARAMETER(DCB) 03300000 * - REPLY IN OPEN WORK AREA BY OPERATOR 03400000 * - ADDRESS OF SYS1.IMAGELIB DCB IN OPEN WORKAREA(DXCCW8) 03450020 * 03500000 *OUTPUT - TO REQUEST AN OPERATOR MOUNT PROPER CHAIN 03600000 * 'IEC120A M XXX,YYYY' MESSAGE IS DISPLAYED 03700000 * - TO REQUEST AN OPERATOR SPECIFY AN ALTERNATE UCS IMAGE. 03800000 * 'IEC122D XXX,YYYY IMAGE NOT FOUND' MESSAGE IS DISPLAYED 03900000 * - THE ADDRESS OF UCS IMAGE RETRIEVED FROM SYS1.IMAGELIB 04000020 * 04100000 *EXTERNAL ROUTINES - NONE. 04200000 * 04300000 * IS NOT A 3211 ISSUE SVC 105 TO DELETE SYS1.IMAGELIB 04370020 * DCB AND DEB 04440020 *EXIT - NORMAL - IF UCS OR FCB LOAD IS NOT REQ'D AND PRINTER 04510020 * - IF THE IMAGE IS NOT TO BE LOADED,XCTL TO ONE OF THE 04600000 * FOLLOWINGS 04700000 * *THE LAST LOAD OF OPEN ROUTINE IF THE DCB IS EXCP, 04800000 * *IGG0191I IF BUFFER CNTRL BLOCK IS SPECIFIED. 04900000 * *IGG0191G IF NORMAL SCHEDULING IS SPECIFIED. 05000000 * *OTHERWISE XCTL TO IGG0191V 05090020 * 05180020 *EXIT - ERROR - ABEND SVC (SVC 13) IS ISSUED WHEN ONE OF THE 05270020 * FOLLOWING OCCURES. THE ABEND SWITCH AND CODE IS SET 05360020 * AND A XCTL IS MADE TO IGG0191V TO ABEND 05450020 * 05540020 * *PERMANENT I/O ERROR OCCURED DURING BLDL-RETURN CODE=08 05630020 * *OPERATOR ISSUED CANCEL FOR MESSAGE IEC120,IEC122,OR 05720020 * IEC123. RETURN CODE=04 05810020 * 05900000 *TABLES/WORK AREAS - WHERE-TO-GO TABLE(SEE LISTING OF EXECUTOR 06000000 * IGG0191B) 06100000 * - OPEN WORK AREA (SEE IECDSECT IN THIS LISTING) 06200000 * 06300000 *ATTRIBUTES - REENTRANT,REUSABLE,SUPERVISOR MODE 06400000 * 06500000 *NOTES - BLDL SVC IS ISSUED TO LOCATE UCS IMAGE IN SYS1.IMAGELIB 06600020 * - WTO/WTOR SVC IS USED TO REQUEST OPERATOR REPLY. 06800000 * - DELETE SVC IS USED TO DELETE THE RETRIEVED UCS IMAGE. 06900000 * - THE REPLY IS ORED TO ALLOW LOWER CASE ALPHA 07000000 * 07100000 *********************************************************************** 07200000 * 07300000 EJECT 07400000 * 07500000 *********************************************************************** 07600000 * 07700000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 07800000 * 07900000 *********************************************************************** 08000000 * 08100000 * 08200000 RE EQU 0 WORK/PARAMETER REGISTER 08300000 RF EQU 1 WORK/PARAMETER REGISTER 08400000 RDCB EQU 2 ADDR OF USER'S DCB 08500000 RBASE EQU 3 BASE REGISTER 08600000 RCORE EQU 4 ADDR OF OPEN WORK AREA 08700000 RPAR EQU 5 PARAMETER LIST 08800000 RWTG EQU 6 START OF WTG 08900000 RPARC EQU 7 CURRENT ENTRY IN PARAMETER LIST 09000000 RWTGC EQU 8 CURRENT ENTRY IN WTG TABLE 09100000 RTIOT EQU 9 TIOT ADDR/WORK REGISTER 09200000 RUCB EQU 10 UCB ADDR/WORK REGISTER 09300000 RDEB EQU 11 DEB ADDR 09400000 RB EQU 12 WORK REGISTER/BREG FOR DSECT 09500000 RC EQU 13 WORK REGISTER 09600000 RD EQU 14 WORK/PARAMETER REGISTER 09700000 RJ EQU 15 WORK/PARAMETER REGISTER 09800000 * 09900000 *********************************************************************** 10000000 * 10100000 * 10200000 * EQUATE WTG OFFSET 10300000 * 10400000 WGOFF EQU 8 OFFSET OF CURRENT WTG ENTRIES 10500000 PLOFF EQU 4 OFFSET OF CURRENT DCB ENTRIES 10600000 WAOFF EQU 32 OFFSET OF 1ST ENTRY IN WTG TBL 10700000 * 10800000 * 10900000 AIF ('&LIB' EQ 'LIB1').LIB100 SM1830 10920021 ACBID EQU X'A0' ACB IDENTIFIER 10940001 .LIB100 ANOP 10960001 FOLDC EQU X'40' CURRENT LOAD MODE = FOLD 11000000 VERIFY EQU X'10' VERIFY 11100000 UCSSAVE EQU 24 UCS NAME SAVE AREA 11200000 MSSG27 EQU X'1B' MESSAGE LENGTH = 27 11300000 MSSG34 EQU X'22' MESSAGE LENGTH = 34 11400000 MSSG30 EQU X'1E' MESSAGE LENGTH = 30 11500000 BLDL EQU X'80' BLDL IS REQUIRED 11600000 IEC120 EQU X'40' IEC120 MESSAGE IS REQUIRED 11700000 LOAD EQU X'20' LOAD FROM SYS1.SVCLIB IS REQUIR 11800000 NOIEC120 EQU X'B8' NO IEC120/NO CORE TRANSFER 11900000 ALPHAV EQU X'E5' C'V' 12000000 ALPHAF EQU X'C6' C'F' 12100000 EXCPMASK EQU X'80' DCB IS EXCP 12200000 BFCNTRL EQU X'01' BUFFER CNTRL BLOCK 12300000 PCIMASK EQU X'20' OPTCD=PCI SPECIFIED 12400000 NOEXCP EQU X'EF' NO LOAD UCS EXCP IS REQUIRED 12500000 NULL EQU X'00' X'00' MASK 12600000 VRFYYES EQU X'10' VERIFY = YES 12700000 FOLDMASK EQU X'40' FOLD MASK 12800000 COMMA EQU X'6B' C',' N 12900000 BLANK EQU X'40' C' ' 13000000 REPEATNO EQU 5 NO OF REPEAT IN REPLYRTN 13100000 BLANKMSK EQU X'40' C' ' 13200000 OVERLAP EQU X'02' OVERLAP LOAD WITH WTOR 13300000 NOVERLAP EQU X'FD' RESET OVERLAP BIT 13400000 FOUR EQU X'04' X'04' 13500000 NODELETE EQU X'7F' NO DELETE IS REQUIRED 13600000 RTNCD04 EQU X'04' RETURN CODE = X'04' 13700000 RTNCD08 EQU X'08' RETURN CODE = X'08' 13800000 ABEND EQU X'FF' ABEND CODE OR SWITCH S20202 13820020 USEIMAGE EQU X'E4' SWITCH SET IF OPERATOR S20202 13840020 * REPLY S20202 13860020 * 'U' ON A SPECIFY UCS IMAGE 13880020 UCSXIT EQU X'E7' SWITCH TO NOTIFY MOD 1V S20202 13900020 * THAT I S20202 13920020 * WILL HAVE TO DETERMINE MOD 1U 13940020 * ACTIONS 13960020 LOADIMAG EQU X'D3' LOAD UCS IMAGE SWITCH S20202 13980020 PRTM3211 EQU X'09' MASK FOR 3211 PRINTER S20202 13986020 UCSIDOFS EQU X'00' OFFSET TO UCS ID IN UCB S20202 13992020 * WORK A S20202 13998020 UCSOPOFS EQU X'04' OFFSET TO UCS OPTION S20202 14004020 * BITS S20202 14010020 TWOCON EQU C'2' S20202 14016020 IMCLOSED EQU X'FF' FLAG SET FOR IMAGELIB S20202 14022020 * NOT OPEN S20202 14028020 X7F EQU X'7F' COMPLETION CODE FLAG S20202 14034020 K0 EQU 0 CONSTANT EQUATED TO 0 S20202 14040020 K1 EQU 1 CONSTANT EQUATED TO 1 S20202 14046020 K2 EQU 2 CONSTANT EQUATED TO 2 S20202 14052020 K3 EQU 3 CONSTANT EQUATED TO 3 S20202 14058020 K4 EQU 4 CONSTANT EQUATED TO 4 S20202 14064020 K5 EQU 5 CONSTANT EQUATED TO 5 S20202 14070020 K6 EQU 6 CONSTANT EQUATED TO 6 S20202 14076020 K7 EQU 7 CONSTANT EQUATED TO 7 S20202 14082020 K8 EQU 8 CONSTANT EQUATED TO 8 S20202 14088020 K10 EQU 10 CONSTANT EQUATED TO 10 S20202 14094020 K12 EQU 12 CONSTANT EQUATED TO 12 S20202 14100020 K14 EQU 14 CONSTANT EQUATED TO 14 S20202 14106020 K15 EQU 15 CONSTANT EQUATED TO 15 S20202 14112020 K19 EQU 19 CONSTANT EQUATED TO 19 S20202 14118020 K20 EQU 20 CONSTANT EQUATED TO 20 S20202 14124020 K27 EQU 27 CONSTANT EQUATED TO 27 S20202 14130020 K23 EQU 23 CONSTANT EQUATED TO 23 S20202 14136020 K24 EQU 24 CONSTANT EQUATED TO 24 S20202 14142020 K32 EQU 32 CONSTANT EQUATED TO 32 S20202 14148020 K34 EQU 34 CONSTANT EQUATED TO 34 S20202 14154020 K35 EQU 35 CONSTANT EQUATED TO 35 S20202 14160020 K40 EQU 40 CONSTANT EQUATED TO 40 S20202 14166020 K992 EQU 992 START OF 1U XCTL TABLE S20202 14172020 * 14178020 OABD070 EQU 70 S21042 14180020 OABD071 EQU 71 S21042 14182020 *********************************************************************** 14184020 *********************************************************************** 14200000 * 14300000 BALR RBASE,0 14400000 USING GOGOGO,RBASE 14500000 USING FORCORE,RCORE 14600000 USING UCBOB,RUCB 14700000 USING IHADCB,RDCB 14800000 USING DEB,RDEB 14900000 USING CVT,RTIOT 15000000 * 15100000 *********************************************************************** 15200000 * 15300000 GOGOGO EQU * 15400000 * 15500000 *********************************************************************** 15600000 * 15700000 * INITIALIZE REGISTERS 15800000 * 15900000 *********************************************************************** 16000000 * 16100000 L RDCB,0(RPARC) LOAD CURRENT DCB ADDR 16200000 L RCORE,4(RWTGC) LOAD CURRENT WORK AREA ADDR 16300000 L RDEB,DCBDEBAD LOAD DEB ADDR 16400000 L RUCB,DEBUCBAD LOAD UCB ADDR 16500000 L RTIOT,CVTPTR(0) LOAD CVT ADDR 16600000 * 16700000 *********************************************************************** 16800000 * 16900000 TSTENTRY EQU * 17000000 * 17100000 *********************************************************************** 17200000 * 17300000 * TEST THE ENTRY SWITCH TO DETERMINE REQUIRED OPERATION. 17400000 * * SWITCH(DXCCW11) 17500000 * B0 - BLDL B1 - IEC120 B2 - LOAD IMAGE 17600000 * B3 - LOAD EXCP B4 - VERIFY B5 - CORE TRANSFER 17700000 * 17800000 *********************************************************************** 17900000 * 18000000 TM DXCCW11,BLDL TEST IF BLDL IS REQUIRED 18100000 BC 1,BLDLRTN IF YES,GOTO BLDL ROUTINE 18200000 * 18300000 TM DXCCW11,IEC120 TEST IF IEC120 MESSAGE IS REQ. 18400000 BC 1,WTOR120 IF YES,GOTO IEC120 ROUTINE 18500000 * 18600000 BC 15,RETURN IF BOTH ARE NOT,GOTO WAIT RTN 18700000 * 18800000 *********************************************************************** 18900000 * 19000000 BLDLRTN EQU * 19100000 * 19200000 *********************************************************************** 19300000 * 19400000 * BLDL ROUTINE IS USED TO LOCATE UCS IMAGE IN SYSU.IMAGELIB 19500020 * 19600000 *********************************************************************** 19700000 * 19800000 MVC DXCCW1(4),BLDLCNST MOVE BLDL LENGTH TO BLDL LIST 19900000 MVC DXCCW1+4(4),UCSCONST MOVE 'UCS1' TO BLDL LIST 20000000 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 20010020 * FOR 321 S20202 20020020 BNE CONTBLDL NO GO CONTINUE WITH BLDL S20202 20030020 MVI DXCCW1+K7,TWOCON CHANGE UCS ID PREFIX TO S20202 20040020 * UCS2 S20202 20050020 * 20060020 CONTBLDL EQU * S20202 20070020 * 20080020 MVC DXCCW1+8(4),DXCCW11+4 MOVE UCS NAME IN JFCB TO BLDL 20100000 * 20170020 * GET ADDRESS OF IMAGELIB DCB ADDRESS 20240020 * 20310020 L RF,DXCCW8 GET ADDRESS OF IMAGELIB S20202 20380020 * DCB S20202 20450020 * 20520020 LA RE,DXCCW1 LOAD BLDL LIST ADDR 20600000 * 20700000 BLDL (1),(0) BLDL THE UCS SET 20800000 * 20900000 * 21000000 * TEST RETURN CODE FOR THE ABOVE FIND IN RJ 21100000 * X'00'--- FOUND 21200000 * X'04'--- NOT FOUND 21300000 * X'08'--- PERMANENT I/O ERROR 21400000 * 21500000 LA RD,FOUR LOAD X'04' TO TEST RETURN CODE 21600000 CLR RJ,RD TEST RETURN CODE 21700000 BC 2,ABEND08 IF X'08',GOTO ABEND ROUTINE 21800000 * 21900000 BC 8,WTOR122 IF X'04',GOTO WTOR IEC122 22000000 * 22100000 *********************************************************************** 22200000 * 22300000 CHCK120 EQU * 22400000 * 22500000 *********************************************************************** 22600000 * 22700000 * WHEN THE IMAGE IS FOUND,TEST IF MESSAGE IEC120 IS REQUIRED 22800000 * 22900000 *********************************************************************** 23000000 * 23100000 TM DXCCW11,IEC120 TEST IF IEC120 IS REQUIRED 23200000 BC 14,LOADUCS IF NOT,GOTO LOAD UCS ROUTINE 23300000 * 23400000 *********************************************************************** 23500000 * 23600000 WTOR120 EQU * 23700000 * 23800000 *********************************************************************** 23900000 * 24000000 * WHEN UCS IS FOUND IN SYS1.IMAGELIB BY BLDL 24100020 * WTOR 'IEC120I M XXX,YYYY' TO REQUEST MOUNTING SPECIFIED CHAIN 24200000 * 24300000 *********************************************************************** 24400000 * 24500000 MVC MSGLSTSZ(34),DSPLY120 MOVE MESSAGE TEXT TO DISPLAY 24600000 MVC MESSAGEA+10(3),UCBNAME MOVE DEV. NAME TO DISPLAY 24700000 MVC MESSAGEA+14(4),DXCCW11+4 MOVE UCS IMAGE ID TO DISPLAY 24800000 * 25000000 TM DXCCW11+3,FOLDMASK TEST IF LOAD MODE = FOLD 25100000 BC 14,TESTVRFY IF NOT GOTO TEST VERIFY 25200000 * 25300000 MVC MSGLSTSZ+23(4),FOLDCN MOVE 'FOLD' TO DISPLAY 25400000 * 25500000 TM DXCCW11+3,VERIFY TEST IF VERIFY IS SPECIFIED 25600000 BC 1,MOVEVRFY IF YES,GOTO MOVE 'VERIFY' 25700000 * 25800000 MVI MSGLSTSZ+1,MSSG27 SET MESSAGE LENGTH=27 25900000 BC 15,REPLYRTN GOTO REPLY ANALYSIS RTN 26000000 * 26100000 MOVEVRFY EQU * 26200000 * 26300000 MVI MSGLSTSZ+1,MSSG34 SET MESSAGE LENGTH=34 26400000 BC 15,REPLYRTN GOTO REPLY ANALYSIS RTN 26500000 * 26600000 TESTVRFY EQU * 26700000 * 26800000 TM DXCCW11+3,VERIFY TEST IF VERIFY IS SPECIFIED 26900000 BC 14,REPLYRTN IF NOT,GOTO REPLY ANALYSIS RTN 27000000 * 27100000 MVC MSGLSTSZ+24(6),VERIFYCN MOVE 'VERIFY' TO DISPLAY 27200000 MVI MSGLSTSZ+1,MSSG30 SET MESSAGE LENGTH=30 27300000 * 27400000 * 27500000 BC 15,REPLYRTN GOTO REPLY ANALYSIS ROUTINE 27600000 * 27700000 *********************************************************************** 27800000 * 27900000 WTOR122 EQU * 28000000 * 28100000 *********************************************************************** 28200000 * 28300000 * WTOR 'IEC122D XXX,YYY IMAGE NOT FOUND' TO REQUEST FOR ALTERNATE 28400000 * CHAIN SET 28500000 * 28600000 *********************************************************************** 28700000 * 28800000 MVC MSGLSTSZ(36),DSPLY122 MOVE MESSAGE TEXT TO WORK AREA 28900000 MVC MESSAGEA+12(4),DXCCW11+4 MOVE UCS IMAGE ID TO DISPLAY 29000000 MVC MESSAGEA+8(3),UCBNAME MOVE DEVICE NAME TO DISPLAY 29100000 NI DXCCW11,NODELETE RESET BLDL BIT TO INDICATE THAT 29200000 * NO IMAGE HAS BEEN LOADED 29300000 XC DXCCW11+4(4),DXCCW11+4 RESET UCS IMAGE ID 29400000 * 29500000 *********************************************************************** 29600000 * 29700000 REPLYRTN EQU * 29800000 * 29900000 *********************************************************************** 30000000 * 30100000 * WTOR ROUTINE 30200000 * 30300000 *********************************************************************** 30400000 * 30500000 SR RF,RF A27331 30505019 IC RF,MSGLSTSZ+K1 PICK UP MSG LENGTH A27331 30510019 LA RF,MSGLSTSZ(RF) PT TO DESC AND ROUT CODE A27331 30515019 * AREA A27331 30520019 MVC K0(K4,RF),CODE120A MOVE IN DESC ROUT CODES A27331 30525019 MESSAGO EQU * A27331 30530019 MVI RPLY,BLANK A33665 30620020 MVC RPLY+1(19),RPLY CLEAR REPLY AREA A33665 30710020 MVI RPLYECB,NULL CLEAR REPLY ECB A33665 30800020 * 30900000 LA RF,REPLYLTH LOAD WTOR ADDR 31000000 * 31100000 SVC 35 ISSUE WTOR SVC 31200000 * 31300000 * 31600000 RETURN EQU * 31700000 * 31800000 LA RF,RPLYECB LOAD REPLY ECB ADDRESS A33665 31900020 * 32000000 WAIT ECB=(1) WAIT ON REPLY 32100000 NI DXCCW11,NOVERLAP RESET OVERLAP BIT 32200000 * 32300000 *********************************************************************** 32400000 * 32500000 GOREPLY EQU * 32600000 * 32700000 *********************************************************************** 32800000 * 32900000 * REPLY ANALYSIS 33000000 * (1) 'U' - USE THE ONE ON THE PRINTER 33100000 * (2) 'CANCEL' - CHAIN SET NOT AVAILABLE 33200000 * (3) 'UCS-ID' - UCS ID 33300000 * 33400000 *********************************************************************** 33500000 * 33600000 OC RPLY(8),LOMASK OR IN X'40' TO ALLOW A33665 33700020 OC RPLY+8(8),LOMASK REPLY IN LOWER CASE A33665 33800020 CLC RPLY(2),UBLANK TEST IF REPLY = 'U' A33665 33900020 * 34100000 BC 8,UGOOUT IF YES,GOTO TEST DELETE 34200000 * 34300000 CLC RPLY(6),CANCELCN TEST IF REPLY = 'CANCEL' A33665 34400020 BC 8,CANCELGO IF YES,GOTO CANCEL ROUTINE 34500000 * 34600000 CLC RPLY(2),CBLANK TEST IF REPLY = 'C' A33665 34700020 BC 7,TSTUCSID IF NOT,GOTO UCS ID TEST 34800000 * 34900000 *********************************************************************** 35000000 * 35100000 CANCELGO EQU * 35200000 * 35300000 *********************************************************************** 35380020 * 35460020 * SINCE THE SPECIFIED UCS CHAIN IS NOT AVAILABLE,JOB STEP IS 35540020 * CANCELLED BY OPERATOR. THE ABEND SWITCH AND CODE-X'04'- IS 35620020 * SET,AND A XCTL IS MADE TO IGG0191V TO ABEND,CHECK IF IMAGE UD WAS 35700020 * SPECIFIED CORRECTLY, OR ADD IMAGE TO SYS1.IMAGELIB 35780020 * 35860020 *********************************************************************** 35940020 * 36020020 * 36100020 MVI DXCCW11,OABD071 MOVE INTERNAL CODE TO S21042 36150020 * WKAREA S21042 36200020 MVI DXCCW10+K1,ABEND SET ABEND FLAG S20202 36260020 B XCTL191V GO XCTL TO IGG0191V S20202 36340020 * 36420020 * 36600000 *********************************************************************** 36700000 * 36800000 TSTUCSID EQU * 36900000 * 37000000 *********************************************************************** 37100000 * 37200000 * ANALYZE REPLY UCS PARAMETERS 37300000 * 37400000 *********************************************************************** 37500000 * 37600000 LA RD,RPLY LOAD REPLY ADDRESS A33665 37700020 LA RJ,REPEATNO LOAD 5 IN REG. RJ 37800000 * 37900000 CLI 0(RD),COMMA TEST IF 1ST CHAR=',' 38000000 BC 8,ERRORTN IF YES,GOTO ERROR ROUTINE 38100000 * 38200000 CLI 0(RD),BLANKMSK TEST IF 1ST CHAR=BLANK 38300000 BC 8,ERRORTN IF YES,GOTO ERROR ROUTINE 38400000 * 38500000 MVI MCSMASK,NULL SET LOAD MODE BIT = A33665 38540020 * X'00' A33665 38580020 MVC UCSID(4),BLANKS BLANK OUT AREA TO MOVE A33665 38620020 * REPLY ID INTO 38660020 * 38700000 TSTREPLY EQU * 38800000 * 38900000 CLI 0(RD),BLANKMSK TEST IF CHAR=BLANK 39000000 BC 8,TSTNAME IF YES,GOTO TEST IMAGE IDS. 39100000 * 39200000 CLI 0(RD),COMMA TEST IF CHAR=',' 39300000 BC 8,TSTOPT IF YES,GOTO OPTION TEST ROUTINE 39400000 * 39500000 MVC UCSID-RPLY(1,RD),0(RD) A33665 39600020 * 39700000 LA RD,1(RD) MODIFY REPLY ADDR 39800000 * 39900000 BCT RJ,TSTREPLY GO BACK TO REPLY UCS ID ANALY 40000000 * 40100000 *********************************************************************** 40200000 * 40300000 ERRORTN EQU * 40400000 * 40500000 *********************************************************************** 40600000 * 40700000 * REPLY ERROR ROUTINE 40800000 * 40900000 *********************************************************************** 41000000 * 41100000 MVC MSGLSTSZ(32),DSPLY125 MOVE MESSAGE TEXT TO WORK AREA 41200000 MVC MSGLSTSZ+K32(K4),CODE125A MOVE IN DESC, ROUT A33684 41230020 * CODES A33684 41260020 * 41300000 B MESSAGO DM0Q 41400018 * 41500000 *********************************************************************** 41600000 * 41700000 TSTOPT EQU * 41800000 * 41900000 *********************************************************************** 42000000 * 42100000 * TEST FOLD/VERIFY SPECIFIED 42200000 * 42300000 *********************************************************************** 42400000 * 42500000 CLI 1(RD),COMMA TEST IF NEXT CHAR=',' 42600000 * 42700000 BC 8,TSTVRFY IF YES,GOTO TEST 'VERIFY' 42800000 * 42900000 CLC 1(4,RD),FOLDCN TEST IF FOLD IS SPECIFIED 43000000 BC 7,TSTALPHF IF NOT,GOTO TEST IF 'F' 43100000 LA RD,4(RD) IF YES,SET POINTER TO NEXT WORD 43200000 BC 15,SETFOLD GOTO SET FOLD BIT 43300000 * 43400000 TSTALPHF EQU * 43500000 * 43600000 CLI 1(RD),ALPHAF TEST IF 'F' IS SPECIFIED 43700000 LA RD,1(RD) SET POINTER TO NEXT WORD 43800000 BC 7,ERRORTN IF NOT,GOTO ERROR RTN 43900000 * 44000000 SETFOLD EQU * 44100000 * 44200000 * 44300000 * 44400000 MVI MCSMASK,FOLDMASK SET LOAD MODE = FOLD A33665 44500020 * 44600000 CLI 1(RD),COMMA TEST IF C',' FOLLOWS AFTER FOLD 44700000 BC 8,TSTVRFY IF YES,GOTO TEST VERIFY RTN 44800000 * 44900000 CLI 1(RD),BLANKMSK TEST IF A BLANK FOLLOWS 45000000 BC 8,TSTNAME IF YES,GOTO TEST NAME ROUTINE 45100000 * 45200000 BC 15,ERRORTN IF NOT,GOTO ERROR ROUTINE 45300000 * 45400000 TSTVRFY EQU * 45500000 * 45600000 * TEST VERIFY IS SPECIFIED 45700000 * 45800000 CLC 2(6,RD),VERIFYCN TEST IF 'VERIFY' SPECIFIED 45900000 BC 8,SETVRFY IF YES,GOTO SET VERIFY BIT 46000000 CLC 2(2,RD),VBLANK TEST IF REPLY='V' 46100000 BC 7,ERRORTN IF NOT,GOTO ERROR ROUTINE 46200000 * 46300000 SETVRFY EQU * 46400000 * 46500000 OI MCSMASK,VERIFY SET VERIFY = YES A33665 46600020 * 46700000 *********************************************************************** 46800000 * 46900000 TSTNAME EQU * 47000000 * 47100000 *********************************************************************** 47200000 * 47300000 * TEST IF REPLY ID = REQUESTED ID 47400000 * YES - TEST TO SEE IF OPERATOR SPECIFIED VERIFICATION OF A34950 47430020 * IMAGE. (OPERATORS OPTIONS MIGHT BE DIFFERENT THAN A34950 47460020 * USERS OPTIONS). IF NO, GO TO 191V. IF YES, FOLLOW A34950 47490020 * SAME PATH AS IF NEW IMAGE. A34950 47520020 * A34950 47550020 *********************************************************************** 47600000 * 47700000 CLC DXCCW11+4(4),UCSID A33665 47800020 BNE COMPUCS NOT THE SAME ID'S A34950 48100020 TM MCSMASK,VERIFY OPERATOR SPECIFY VERIFY? A34950 48400020 BC K8,LOADUCS GO SET BIT TO LOAD UCS S20202 48700020 * 49600000 *********************************************************************** 49700000 * 49800000 COMPUCS EQU * 49900000 * 50000000 *********************************************************************** 50100000 * 50200000 * TEST IF SPECIFIED UCS IMAGE IS EQUAL TO REPLIED IMAGE 50300000 * 50400000 *********************************************************************** 50500000 * 50600000 L RJ,UCBXTADR GET ADDRESS OF UCB EXT M5149 50650020 MVC DXCCW11+4(4),UCSID MOVE REPLY UCS NAME A33665 50700020 MVC DXCCW11+3(1),MCSMASK SET LODE MODE A33665 50800020 MVI DXCCW11,NOIEC120 RESET IEC120 BIT IN SWITCH 50900000 * 51000000 CLC NULL(4,RJ),DXCCW11+4 TESTIF UCS IDS ARE EQUAL M5149 51100020 BC 7,BLDLRTN IF NOT,GOTO BLDL ROUTINE 51200000 * 51300000 MVC DXCCW1(1),4(RJ) IF YES MOVE UCS OPT IN M5149 51360020 * UCB EXT M5149 51420020 XC DXCCW1(1),DXCCW11+3 TEST IF LOAD MODES ARE EQUAL 51500000 TM DXCCW1,FOLDMASK TEST IF THEY ARE EQUAL 51600000 BC 1,BLDLRTN IF NOT,GOTO BLDL ROUTINE 51700000 * 51800000 *********************************************************************** 51900000 * 52000000 * WHEN UCS PARAMETERS ARE EQUAL,TEST IF VERIFY IS SPECIFIED. 52100000 * 52200000 *********************************************************************** 52300000 * 52400000 TM DXCCW11+3,VERIFY TEST IF 'VERIFY' IS SPECIFIED 52500000 BC 14,UCSEXIT IF NOT,GOTO EXIT FROM UCS EXEC 52600000 * 52700000 NI DXCCW11,NOEXCP IF YES,RESET EXCP BIT IN SWITCH 52800000 BC 15,BLDLRTN GOTO BLDL ROUTINE 52900000 * 57700000 *********************************************************************** 57800000 * 57900000 UGOOUT EQU * 58000000 * 58100000 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 58200020 * FOR 321 S20202 58300020 BNE DETSTAG2 IF NOT XCTL TO NEXT S20202 58400020 * STAGE 2 EX S20202 58500020 MVI DXCCW10+K1,USEIMAGE SET FLAG FOR USE IM IN S20202 58600020 * BUFFER S20202 58700020 B XCTL191V XCTL TO IGG0191V S20202 58800020 * 59300000 *********************************************************************** 59400000 * 59500000 UCSEXIT EQU * 59600000 * 59700000 *********************************************************************** 59800000 * 59900000 * DETERMINE THE NEXT STAGE 2 EXECUTOR TO BE XCTLED 60000000 * 60100000 *********************************************************************** 60200000 * 60300000 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 60303020 * FOR 321 S20202 60306020 BNE DETSTAG2 NO GO DETERMINE NEXT S20202 60309020 * STAGE 2 S20202 60312020 MVI DXCCW10+K1,UCSXIT FLAG TO NOTIFY NEXT S20202 60315020 * MODULE THA S20202 60318020 * IT WILL HAVE TO DECIDE WHAT 60321020 * ACTIONS SHOULD BE TAKEN 60324020 * 60327020 B XCTL191V GO XCTL TO IGG0191V S20202 60330020 * 60333020 LOADUCS EQU * S20202 60336020 * 60339020 MVI DXCCW10+K1,LOADIMAG FLAG FOR UCS IMAGE S20202 60342020 * LOADED S20202 60345020 B XCTL191V GO XCTL TO IGG0191V S20202 60348020 * 60351020 ABEND08 EQU * S20202 60354020 * 60357020 *********************************************************************** 60360020 * * 60363020 * PERMANENT I/O ERROR WAS FOUND WHEN BLDL WAS ISSUED TO LOCATE AN * 60366020 * UCS IMAGE IN SYS1.IMAGELIB RETURN CODE=X'08' IS STORED 60369020 * ABEND SWITCH IS SET AND A XCTL IS MADE TO IGG0191V TO ABEND 60372020 * IF THE I/O ERROR PRESITS,RUN THE C.E. DIAGNOSTIC FOR THE SYSTEM * 60375020 * RESIDENCE DASD * 60378020 * +368(REG.4) POINTS TO THE BLDL LIST * 60381020 * * 60384020 *********************************************************************** 60387020 * 60390020 MVI DXCCW11,OABD070 MOVE INTERNAL CODE TO S21042 60392020 * WKAREA S21042 60394020 MVI DXCCW10+K1,ABEND SET ABEND FLAG S20202 60396020 * 60399020 * 60402020 * 60405020 XCTL191V EQU * S20202 60408020 * 60411020 *********************************************************************** 60414020 * 60417020 * XCTL TO NEXT EXECUTOR IGG0191V 60420020 * 60423020 *********************************************************************** 60426020 * 60429020 LA RF,MODNM1V LOAD IDTTR NEXT EXECUTOR S20202 60432020 BC K15,MVEIDTTR GO TO XCTL ROUTINE S20202 60435020 * 60438020 * 60441020 DETSTAG2 EQU * S20202 60444020 * 60447020 MVC DXCCW6(K1),DXCCW11+K1 RESTORE DCB EROPT S20202 60450020 * 60453020 * 60456020 * SEE IF SYS1.IMAGELIB HAS BEEN OPENED IF YES CLOSE IT 60459020 * 60462020 CLI DXCCW8,IMCLOSED CK IF IMAGEDLIB CLOSED S20202 60465020 BE TSTEXCP IF NOT GO TEST IF EXCP S20202 60468020 * SPECIFE S20202 60471020 L RF,DXCCW8 GET ADDRESS OF IMAGELIB S20202 60474020 * DCB S20202 60477020 SVC 105 ISSUE SVC TO CLOSE S20202 60480020 * SYS1.IMAGEL S20202 60483020 * 60486020 * 60500000 *********************************************************************** 60600000 * 60700000 TSTEXCP EQU * 60800000 * 60900000 *********************************************************************** 61000000 * 61100000 * TEST IF EXCP IS SPECIFIED.IF YES,XCTL TO THE LAST OPEN EXECUTOR 61200000 * 61300000 *********************************************************************** 61400000 * 61500000 TM DCBMACRF,EXCPMASK TEST IF EXCP IS SPECIFIED 61600000 BC 14,TSTBLKBF IF NOT,GOTO BUFFER CNTRL BLK 61700000 * 61800000 MVI 0(RWTGC),NULL IF YES,ZERO NAME FIELD 61900000 BC 15,RELOOP GOTO WTG TABLE UPDATE 62000000 * 62100000 *********************************************************************** 62200000 * 62300000 TSTBLKBF EQU * 62400000 * 62500000 *********************************************************************** 62600000 * 62700000 * TEST IS BUFFER CONTROL BLOCK IS SPECIFIED.IF YES,XCTL TO IGG0911I 62800000 * 62900000 *********************************************************************** 63000000 * 63100000 TM DCBBUFNO+3,BFCNTRL BUFFER CONTROL BLOCK SPECIFIED 63200000 BC 14,TSTPCI IF YES,GOTO TEST PCI ROUTINE 63300000 * 63400000 SR RE,RE RESET REGISTER 63500000 IC RE,DCBBUFNO GET THE NO OF BUFFER SPECIFIED 63600000 LTR RE,RE TEST IF DCBBUFNO='0' 63700000 BC 8,TSTPCI IF YES,GOTO TEST PCI 63800000 * 63900000 LA RF,MODNM1I LOAD ADDR OF IDTTR OF IGG0191I 64000000 BC 15,MVEIDTTR GOTO MOVE IDTTR ROUTINE 64100000 * 64200000 *********************************************************************** 64300000 * 64400000 TSTPCI EQU * 64500000 * 64600000 AIF ('&LIB' EQ 'LIB1').LIB1AA 64606001 *********************************************************************** 64612001 * 64618001 * TEST FOR VIRTUAL=REAL. PCI IS ONLY HONORED FOR V=R. 64624001 * 64630001 *********************************************************************** 64636001 * 64642001 L RF,DEBTCBAD GET TCB POINTER 64648001 USING TCB,RF ESTABLISH ADDRESSABILITY 64654001 TM TCBFLGS6,TCBRV TEST FOR REAL PARTITION 64660001 BZ BQSAMOUT BRANCH IF VIRTUAL 64666001 DROP RF 64672001 * 64678001 .LIB1AA ANOP 64684001 *********************************************************************** 64700000 * 64800000 * TEST IF PCI IS SPECIFIED.IF YES,XCTL TO IGG0191Q 64900000 * 65000000 *********************************************************************** 65100000 * 65200000 TM DCBOPTCD,PCIMASK TEST IF PCI SPECIFIED 65300000 BC 14,BQSAMOUT IF NOT,GOTO BSAM/QSAM ROUTINEED 65400000 * 65500000 LA RF,MODNM1Q LOAD ADDR OF IDTTR OF IGG0191Q 65600000 BC 15,MVEIDTTR GOTO MOVE IDTTR ROUTINE 65700000 * 65800000 *********************************************************************** 65900000 * 66000000 BQSAMOUT EQU * 66100000 * 66200000 AIF ('&LIB' EQ 'LIB1').LIB101 SM1830 66205021 *********************************************************************** 66210001 * * 66215001 * TEST FOR JES DATA MANAGEMENT * IF YES, XCTL TO OPEN * 66220001 * * 66225001 *********************************************************************** 66230001 CLI DCBRELAD,ACBID IS CONTROL BLOCK AN ACB 66235001 BNE JESOUT NO * GO TO XCTL TO BSAM/QSAM 66240001 MVI 0(RWTGC),NULL YES * ZERO ID IN WTG TABLE 66245001 B RELOOP GO TO XCTL TO OPEN 66250001 JESOUT EQU * 66255001 .LIB101 ANOP 66260001 *********************************************************************** 66300000 * 66400000 * BSAM/QSAM EXIT.XCTL TO IGG0191G 66500000 * 66600000 *********************************************************************** 66700000 * 66800000 LA RF,MODNM1G LOAD ADDR OF IDTTR IF IGG0191G 66900000 * 67000000 *********************************************************************** 67100000 * 67200000 MVEIDTTR EQU * 67300000 * 67400000 *********************************************************************** 67500000 * 67600000 * MOVE IDTTR TO XCTL WTG TABLE 67700000 * 67800000 *********************************************************************** 67900000 * 68000000 MVC 0(5,RWTGC),0(RF) STORE NEXT MODULE ID IN WTG 68100000 * 68200000 *********************************************************************** 68300000 * 68400000 RELOOP EQU * 68500000 * 68600000 *********************************************************************** 68700000 * 68800000 * UPDATE WTG TABLE AND XCTL TO NEXT MODULE 68900000 * 69000000 *********************************************************************** 69100000 * 69200000 LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURRENT WTG ENTRY 69300000 LA RPARC,PLOFF(0,RPARC) INCREMENT CURRENT DCB ENTRY 69400000 CLC 0(2,RWTGC),AMIDCNST IS THE RTN NEEDED AGAIN 69500000 BCR 8,RBASE IF YES,RETURN TO PROCESS 69600000 * 69700000 CLC 0(2,RWTGC),OPIDCNST TEST END OF WTG TABLE 69800000 BC 7,RELOOP IF NOT,CHECK NEXT ENTRY 69900000 * 70000000 LR RPARC,RPAR RESET REG TO '0' 70100000 LA RWTGC,WAOFF(0,RWTG) RESET WTG REG TO POINT +32(WTG) 70200000 ZCHECK CLI 0(RWTGC),X'00' TEST IF THIS ENTRY COMPLETE 70300000 BC 7,TCTLRTN IF NOT,XCTL 70400000 * 70500000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY OF WTG TABLE 70600000 LA RPARC,PLOFF(0,RPARC) GET NEXT ENTRY OF DCB 70700000 BC 15,ZCHECK GOTO TEST COMPLETION 70800000 * 70900000 TCTLRTN EQU * 71000000 * 71100000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 71200000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 71300000 * 71400000 LA RJ,DXCCW12 SET UP XCTL 71500000 * 71600000 XCTL DE=(RWTG),SF=(E,(15)) 71700000 * 71800000 * 75100000 *********************************************************************** 75200000 * 75300000 * 75400000 *********************************************************************** 75500000 * 75600000 * CONSTANTS 75700000 * 75800000 *********************************************************************** 75900000 * 76000000 * FOR WTG TABLE 76100000 * 76200000 OPIDCNST DC C'0S' 76300000 AMIDCNST DC C'1U' 76400000 WTGCNST DC C'IGG019 ' 76500000 * 76600000 * MESSAGE TEXT 76700000 * 76800000 DSPLY120 DC X'00168000' DM0Q 76900018 DC C'IEC120A M , ,, ,VERIFY' 77000000 DSPLY122 DC X'00248000' DM0Q 77100018 DC C'IEC122D , IMAGE NOT FOUND' 77200000 DSPLY125 DC X'00208000' DM0Q 77300018 DC C'IEC125A ERROR - REPEAT REPLY' A33684 77400020 * 77500000 VERIFYCN DC C'VERIFY' REPLY=UCS,,VERIFY 77600000 FOLDCN DC C'FOLD' REPLY=UCS,FOLD 77700000 CANCELCN DC C'CANCEL' REPLY='CANCEL' 77800000 UBLANK DC C'U ' REPLY = 'U' 77900000 CBLANK DC C'C ' REPLY = 'C' 78000000 VBLANK DC C'V ' VERIFY='V' 78100000 UCSCONST DC C'UCS1' UCS IMAGE ID PREFIX 78200000 BLANKS DC 4C' ' FOUR BLANKS A33665 78250020 BLDLCNST DC X'00010046' CONSTANT BLDLIST LENGTH=70 78300000 CODE120A DC X'40000200' DESCRIPTOR, ROUTING CODES DM0Q 78330018 CODE125A DC X'02004000' DESC AND ROUT CODE A33684 78360020 * 78400000 *********************************************************************** 78500000 * 78600000 * XCTL TABLE 78700000 * 78800000 *********************************************************************** 78900000 * 79000000 XCTLTABL ID=(MODNM1G,1G,MODNM1I,1I,MODNM1Q,1Q,MODNM1V, S21042,79200020 1V), S21042,79400020 SVC=019 S21042 79600020 * 80000000 * 80100000 *********************************************************************** 80200000 * 80300000 *********************************************************************** 80400000 * 80500000 * DSECT 80600000 * 80700000 *********************************************************************** 80800000 * 80900000 * 81000000 IECDSECS MAIN,DCB,EXPAND=YES S21042 81200020 FORCORE DSECT 81400020 ORG REPLYLTH+52 A33665 81640020 RPLY DS 20C A33665 81680020 RPLYECB DS F A33665 81720020 MCSMASK DS H A33665 81760020 LOMASK DS 8C A33665 81800020 UCSID DS 4C A33665 81840020 * 81900000 *********************************************************************** 82000000 * 82100000 SRT DSECT 82200000 IEFUCBOB 82300000 * 82400000 *********************************************************************** 82500000 * 82600000 CVT DSECT 82700000 CVT 82800000 * 82900000 *********************************************************************** 83000000 * 83100000 * DATA EXTENT BLOCK (UNTIL PROTIOS CHANGES) 83200000 DEB DSECT 83300000 DEBNMSUB DS 0CL1 83400000 DEBTCBAD DS CL4 83500000 DEBAMLNG DS 0CL1 83600000 DEBDEBAD DS CL4 83700000 DEBOFLGS DS 0CL1 83800000 DEBIRBAD DS CL4 83900000 DEBOPATB DS 0CL1 84000000 DEBSYSPG DS CL4 84100000 DEBNMEXT DS 0CL1 84200000 DEBUSRPG DS CL4 84300000 DEBPRIOR DS 0CL1 84400000 DEBECBAD DS CL4 84500000 DEBPROTG DS 0CL1 84600000 DEBDEBID DS 0CL1 84700000 DEBDCBAD DS CL4 84800000 DEBEXSCL DS 0CL1 84900000 DEBAPPAD DS CL4 85000000 DEBDVMOD DS 0CL1 85100000 DEBUCBAD DS CL4 85200000 DEBTVLSQ DS 0CL2 VOL SEQ FOR TAPE 85300000 DEBBINUM DS CL2 85400000 DEBTVLNM DS 0CL2 NO OF VOL FOR TAPE 85500000 DEBSTRCC DS CL2 85600000 DEBSTRHH DS CL2 85700000 DEBENDCC DS CL2 85800000 DEBENDHH DS CL2 85900000 DEBNMTRK DS CL2 86000000 * FOR ADDITIONAL EXTENT ON DIRECT ACCESS THE FOLLOWING FIELDS 86100000 * WILL HAVE TO BE OFFSET ANOTHER 16 BYTES 86200000 DEBVOLSQ DS H 86300000 DEBVOLNM DS H 86400000 * FOR EACH SUBROUTINE LOADED BUMP THIS OFFSET BY 2 86500000 DEBSUBID DS H 86600000 * 86700000 *********************************************************************** 86800000 IKJTCB 86840001 * 86900000 END 87000000 ./ ADD SSI=04010755,NAME=IGG0191V,SOURCE=0 TITLE 'IGG0191V - UCS LOAD AND VERIFICATION' 00100000 COPY LCGASMSW 00160001 * 00220001 * 00340001 IGG0191V CSECT 00400000 * RELEASE 19 DELETIONS 00490000 *1061128000 A28696 00500019 * RELEASE 20 DELETIONS 00520000 *0216109000 A38811 00525020 *0216609000-611000,615000,620000-621000,624000,627000,629000, A33665 00530020 *0216632000,635000 A33665 00540020 *0216008000-015000,017000,028000-030000,035000,041000-042000, S20202 00542020 *0216045000-048000,123000-133000,177000,189000,231000,235000, S20202 00544020 *0216272000,284000-287000,316000-324000,443000-660000,693000, S20202 00546020 *0216756000-759000,762000-763000,764000-772000,780000,786000 S20202 00548020 *0216109000 M5148 00548520 *0216317800,318200-318500 M5143 00549020 * RELEASE 21 DELETIONS 00550000 *C761800 SA57891 00550401 *0934125600-125800,319800,321600 M1803 00552021 *0934041000,136000,257000,439000,665000-667000,670000-680000, S21042 00560021 *0934734000-738000,780000-786000,802000-803000 S21042 00570021 *0934 M0092 00575021 *A XM5898 00575101 *D192424 SM5451 00625101 *STATUS CHANGE LEVEL 009 00740001 *FUNCTION/OPERATION - DETERMINE THE ACTION 1U SHOULD HAVE TAKEN IF UCS 00810020 * IMAGE LOAD IS REQUIRED OR PRINTER IS 3211 00890020 * - EXECUTE UCS IMAGE LOAD INTO STORAGE ANDTHEN INTO 00970020 * UCS BUFFER IF NECESSARY 01050020 * - UPDATE UCB TO REFLECT STATUS OF IMAGE IN BUFFER 01130020 * IF VERIFY NOT SPECIFIED 01210020 * - DETERMINE NEXT OPEN EXECUTOR TO XCTL TO AND IF 01290020 * NECESSARY ISSUE MESSAGE IEC129 TO OPERATOR 01370020 * - CLOSE SYS1.IMAGELIB IF PRINTER IS 1403 01450020 * 01600000 *ENTRY POINT - ENTERED FROM IGG0191T OR IGG0191U BY USE OF XCTL MACRO 01700020 * 01800000 *INPUT - DCB ADDRESS 01900000 * - OPEN WORK AREA ADDRESS 02000000 * - WHERE-TO-GO TABLE 02100000 * - PARAMETER LIST 02200000 * - CURRENT ENTRY IN W-T-G TABLE 02300000 * - CURRENT PARAMETER(DCB) 02400000 * - THE ADDRESS OF UCS IMAGE RETRIEVED 02500000 * - THE ADDRESS OF SYS1.IMAGELIB DCB IN OPEN WORKAREA(DXCCW8) 02550020 * 02600000 *OUTPUT - UCS BUFFER LOAD 02700000 * - UPDATED UCB TO REFRECT THE STATUS OF UCS BUFFER 03100000 * - ISSUE REQUEST FOR OPERATOR TO SPECIFY FCB IMAGE 03130020 * 'IEC129 XXX,SPECIFY ,FCB PARAMETERS' MESSAGE 03160020 * 03200000 *EXTERNAL ROUTINES - NONE. 03300000 * 03400000 *EXIT - NORMAL - IF VERIFY IS SPECIFIED XCTL TO IGG0197U 03440020 * - XCTL TO ONE OF THE FOLLOWINGS 03480020 * *IGG0197E IF AN FCB IMAGE IS TO BE LOADED 03520020 * *IGG0197F IF ALIGNMENT OF FORMS IS SPECIFIED 03560020 * *THE LAST LOAD OF OPEN ROUTINE IF THE DCB IS EXCP. 03600000 * *IGG0191I IF BUFFER CNTRL BLOCK IS SPECIFIED. 03700000 * *IGG0191G IF NORMAL SCHEDULING IS SPECIFIED. 03800000 * *IGG0191Q IF CHAINED SCHEDULING IS SPECIFIED. 03900000 * 04000000 *EXIT - ERROR - XCTL TO PROBLEM DETERMINATION FOR WTP AND B13 ABEND 04060021 * FOR ONE OF THE FOLLOWING 04120021 * *MODULE IGG0191U SET SWITCH TO ABEND 04200020 * *PERMANENT I/O ERROR OCCURED DURING UCS BUFFER LOAD. 04300000 * RETURN CODE=0C 04400000 * 04900000 *TABLES/WORK AREAS - WHERE-TO-GO TABLE (SEE LISTING OF EXECUTOR 05000000 * IGG0191B) 05100000 * - OPEN WORK AREA (SEE IECDSECT IN THIS LISTING) 05200000 * 05300000 *ATTRIBUTES - REENTRANT,REUSABLE,SUPERVISOR MODE 05400000 * 05500000 *NOTES - EXCP/WAIT SVCS ARE USED TO LOAD UCS BUFFER AND WRITE IMAGE 05600000 * ON THE PRINTER FOR VERIFICATION. 05700000 * - DELETE SVC IS USED TO DELETE THE RETRIEVED IMAGE. 05800000 * - WTOR SVC IS USED TO REQUEST OPERATOR REPLY 05900000 * - IOB/ECB IN OPEN WORK AREA IS USED FOR EXCP 06000000 * - THE REPLY IS ORED TO ALLOW LOWER CASE ALPHA 06100000 * - SYS1.IMAGELIB SVC (105) TO DELETE DCB AND DEB OF SYS1.IMAGELIB 06150020 * 06200000 *********************************************************************** 06300000 * 06400000 EJECT 06500000 * 06600000 *********************************************************************** 06700000 * 06800000 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 06900000 * 07000000 *********************************************************************** 07100000 * 07200000 * 07300000 RE EQU 0 WORK/PARAMETER REGISTER 07400000 RF EQU 1 WORK/PARAMETER REGISTER 07500000 RDCB EQU 2 ADDR OF USER'S DCB 07600000 RBASE EQU 3 BASE REGISTER 07700000 RCORE EQU 4 ADDR OF OPEN WORK AREA 07800000 RPAR EQU 5 PARAMETER LIST 07900000 RWTG EQU 6 START OF WTG 08000000 RPARC EQU 7 CURRENT ENTRY IN PARAMETER LIST 08100000 RWTGC EQU 8 CURRENT ENTRY IN WTG TABLE 08200000 RTIOT EQU 9 TIOT ADDR/WORK REGISTER 08300000 RUCB EQU 10 UCB ADDR/WORK REGISTER 08400000 RDEB EQU 11 DEB ADDR 08500000 RB EQU 12 WORK REGISTER/BREG FOR DSECT 08600000 RC EQU 13 WORK REGISTER 08700000 RD EQU 14 WORK/PARAMETER REGISTER 08800000 RJ EQU 15 WORK/PARAMETER REGISTER 08900000 * 09000000 *********************************************************************** 09100000 * 09200000 * 09300000 * EQUATE WTG OFFSET 09400000 * 09500000 WGOFF EQU 8 OFFSET OF CURRENT WTG ENTRIES 09600000 PLOFF EQU 4 OFFSET OF CURRENT DCB ENTRIES 09700000 WAOFF EQU 32 OFFSET OF 1ST ENTRY IN WTG TBL 09800000 * 09900000 * EQUATE ABEND CODE AND RETURN CODE 10000000 * 10100000 ABCDB13 EQU X'B13' ABEND CODE = X'B13' 10200000 RTNCD0C EQU X'0C' RETURN CODE = X'0C' 10300000 RTNCD10 EQU X'10' RETURN CODE = X'10' 10400000 RTNCD14 EQU X'14' RETURN CODE = X'14' 10500000 * 10600000 AIF ('&LIB' EQ 'LIB1').LIB100 SM1830 10620021 ACBID EQU X'A0' ACB IDENTIFIER 10640001 .LIB100 ANOP 10660001 PCIMASK EQU X'20' OPTCD=PCI SPECIFIED 10700000 BFCNTRL EQU X'01' BUFFER CNTRL BLOCK SPECIFIED 10800000 EXCPMASK EQU X'80' LOAD EXCP A38811 10900020 UNRLMASK EQU X'42' IOB IS UNRELATED AND C.C. 11000000 NULL EQU X'00' X'00' 11100000 CNTRLMSK EQU X'EB' COMMAND CODE = CNTRL 11200000 SILIMASK EQU X'60' C.C. AND SILI ON 11300000 ONEMASK EQU X'01' X'01' 11400000 UCSLNGTH EQU X'F0' UCS IMAGE LENGTH 11500000 TWOMASK EQU X'02' X'02' 11600000 UNFLCCW EQU X'FB' COMMAND CODE = LOAD NO FOLD 11700000 FLDCCW EQU X'F3' COMMAND CODE = LOAD FOLD 11800000 FOLDMASK EQU X'40' LOAD MODE = FOLD 11900000 VERIFY EQU X'10' VERIFY = YES 12000000 RESETMSK EQU X'CF' RESET VERIFY 12100000 SKIPCCW EQU X'8B' CCW = SKIP TO CH 1 12200000 * 12220020 * EQUATES FOR SYS1.IMAGELIB SUPPORT AND 3211 PRINTER SUPPORT 12240020 * 12260020 ABEND EQU X'FF' 1U ABEND SWITCH S20202 12280020 BLDL EQU X'80' BLDL REQUIRED S20202 12300020 USEIMAGE EQU X'E4' USE IMAGE(FLAG) IN UCS S20202 12320020 * BUFFER S20202 12340020 UCSXIT EQU X'E7' 1U ASKS 1V TO DECIDE S20202 12360020 * NEXT TASK S20202 12380020 COREMASK EQU X'04' CORE TRANSFER S20202 12400020 SILLCCW EQU X'20' UCS LOAD S20202 12420020 UCSLDCC EQU X'FB' UCS LOAD COMMAnD S20202 12440020 BLANKS EQU X'40' C' ' S20202 12460020 ABENDBIT EQU X'80' ABEND IN PROCESS SWITCH S20202 12480020 LOADIMAG EQU X'D3' LOAD IMAGE FROM S20202 12500020 * SYS1.IMAGELIB S20202 12520020 DCBEXCP EQU X'80' EXCP OPEN FLAG S20202 12540020 STGETWO EQU X'C7' ENTRY SWITCH FOR 197F M1803 12560021 UCSFLDCC EQU X'43' COMMAND CODE = FOLD UCS S20202 12600020 UCSUNFLD EQU X'23' CMD CODE = UNFOLD UCS SM5451 12610001 PRTM3211 EQU X'09' MASK FOR 3211 PRINTER S20202 12620020 IEC129RQ EQU X'02' MESSAGE IECU29D REQUIRED S20202 12640020 * MASK S20202 12660020 UCSIDOFS EQU X'00' UCS OFFSET FROM START S20202 12680020 * UCB WK A S20202 12700020 UCSOPOFS EQU X'04' UCS OPTIONS OFFSET S20202 12720020 FCBALIGN EQU X'04' ENTRY FOR ALIGNY ONLY S20202 12740020 * MASK S20202 12760020 NOFCB EQU X'F0' NO FCB LOAD REQUIRED S20202 12780020 CMDSKP0 EQU X'83' SKIP TO CH 0 COMMAND S20202 12800020 * CODE S20202 12820020 IMCLOSED EQU X'FF' FLAG SET FOR IMAGELIB S20202 12840020 * NOT OPEN S20202 12860020 X7F EQU X'7F' COMPLETION CODE FLAG S20202 12880020 K0 EQU 0 CONSTANT EQUATED TO 0 S20202 12900020 K1 EQU 1 CONSTANT EQUATED TO 1 S20202 12920020 K2 EQU 2 CONSTANT EQUATED TO 2 S20202 12940020 K3 EQU 3 CONSTANT EQUATED TO 3 S20202 12960020 K4 EQU 4 CONSTANT EQUATED TO 4 S20202 12980020 K5 EQU 5 CONSTANT EQUATED TO 5 S20202 13000020 K6 EQU 6 CONSTANT EQUATED TO 6 S20202 13020020 K7 EQU 7 CONSTANT EQUATED TO 7 S20202 13040020 K8 EQU 8 CONSTANT EQUATED TO 8 S20202 13060020 K12 EQU 12 CONSTANT EQUATED TO 12 S20202 13080020 K14 EQU 14 CONSTANT EQUATED TO 14 S20202 13100020 K15 EQU 15 CONSTANT EQUATED TO 15 S20202 13120020 K16 EQU 16 CONSTANT EQUATED TO 16 S20202 13140020 K19 EQU 19 CONSTANT EQUATED TO 19 S20202 13160020 K20 EQU 20 CONSTANT EQUATED TO 20 S20202 13180020 K25 EQU 25 CONSTANT EQUATED TO 25 S20202 13200020 K27 EQU 27 CONSTANT EQUATED TO 27 S20202 13220020 K31 EQU 31 CONSTANT EQUATED TO 31 S20202 13240020 K32 EQU 32 CONSTANT EQUATED TO 32 S20202 13260020 K35 EQU 35 CONSTANT EQUATED TO 35 S20202 13280020 K36 EQU 36 CONSTANT EQUATED TO 36 S20202 13300020 K37 EQU 37 CONSTANT EQUATED TO 37 S20202 13320020 K54 EQU 54 CONSTANT EQUATED TO 54 S20202 13340020 K976 EQU 976 START OF IGG0191V XCTL S20202 13360020 * TABLE S20202 13380020 *********************************************************************** 13400000 * 13500000 OABD067 EQU 67 S21042 13550021 OABD068 EQU 68 S21042 13600021 OABD069 EQU 69 S21042 13650021 * 13700000 *********************************************************************** 13800000 * 13900000 * HOUSE KEEPING 14000000 * 14100000 *********************************************************************** 14200000 * 14300000 BALR RBASE,0 14400000 USING GOGOGO,RBASE 14500000 USING IHADCB,RDCB 14600000 USING FORCORE,RCORE 14700000 USING DEB,RDEB 14800000 USING UCBOB,RUCB 14900000 * 15000000 *********************************************************************** 15100000 * 15200000 GOGOGO EQU * 15300000 * 15400000 *********************************************************************** 15500000 * 15600000 * INITIALIZE REGISTERS 15700000 * 15800000 *********************************************************************** 15900000 * 16000000 L RDCB,0(RPARC) LOAD CURRENT DCB ADDR 16100000 L RCORE,4(RWTGC) LOAD CURRENT WORK AREA ADDR 16200000 AIF ('&LIB' NE 'LIB1').DEBCK10 TEST FOR LIB1(OS) YM0890 16250001 L RDEB,DCBDEBAD LOAD DEB ADDR 16300000 .DEBCK10 ANOP Y01021 16350000 AIF ('&LIB' EQ 'LIB1').DEBCK20 TEST FOR LIB1(OS) Y01021 16360000 L RDEB,DXPDEBAD LOAD PROTECTED DEB ADDR Y01021 16370000 .DEBCK20 ANOP Y01021 16380000 L RUCB,DEBUCBAD LOAD UCB ADDR 16400000 * 16500000 * 16501020 TST1UFLG EQU * S20202 16502020 * 16503020 *********************************************************************** 16504020 * 16505020 * THIS ROUTINE TEST SWITCHES SET BY 1U TO DETERMINE WHAT ACTIONS 16506020 * ARE TO BE TAKEN BY THIS MODULE 16507020 * 16508020 *********************************************************************** 16509020 * 16510020 CLI DXCCW10+K1,USEIMAGE OPERATOR REPLIED 'U' ON S20202 16511020 * A S20202 16512020 * MOUNT MESSAGE 16513020 BE UCSEXIT IF SO GO DETERMINE NEXT S20202 16514020 * MODULE S20202 16515020 * TO BE XCTL'D TO 16516020 CLI DXCCW10+K1,ABEND ABEND SWITCH ON S20202 16517020 BE ABENROUT GO SET ABEND CODE S20202 16518020 CLI DXCCW10+K1,UCSXIT K1U PASSED CONTROL TO S20202 16519020 * DETERMIN S20202 16520020 * THE NEXT TASK NEEDED FOR THIS 16521020 * DCB 16522020 BE UCSEXIT IF SO GOTO UCSEXIT S20202 16523020 CLI DXCCW10+K1,LOADIMAG K1V REQUESTED TO LOAD AN S20202 16524020 * IMAGE S20202 16525020 BNE BUFLDREQ IF NO GO CK IF BUFFER S20202 16526020 * LOAD REQ S20202 16527020 * 16528020 *********************************************************************** 16529020 * 16530020 * LOAD UCS IMAGE FROM SYS1.IMAGELIB 16531020 * 16532020 *********************************************************************** 16533020 * 16534020 LA RE,DXCCW1+K4 LOAD BLDL LIST ADDR S20202 16535020 * 16536020 L RF,DXCCW8 GET ADDRESS OF IMAGELIB S20202 16537020 * DCB S20202 16538020 * 16539020 LOAD DE=(0),DCB=(1) LOAD UCS SET FROM S20202 16540020 * SYS1.IMAGELI S20202 16541020 * 16542020 LR RB,RE RETAIN LOAD ADDR IN REG. S20202 16543020 * RB S20202 16544020 OI DXCCW11,BLDL SET UCS IMAGE LOADED S20202 16545020 * 16546020 MVC DXCCW6(K8),DXCCW1+K4 MOVE UCS INTO DXCCW6 S20202 16547020 * 16548020 BUFLDREQ EQU * S20202 16549020 * 16550020 * 16551020 * 16600000 *********************************************************************** 16700000 * 16800000 * SET DXCCW1 FOR EXCP AND TEST IF BUFFER LOAD IS REQUIRED 16900000 * 17000000 *********************************************************************** 17100000 * 17200000 MVI IOBFLAG1,UNRLMASK SET IOBFLAG= C.C/UNRELATED 'ON' 17300000 XC DXCCW1(16),DXCCW1 RESET CCW AREA TO X'00' 17400000 * 17500000 TM DXCCW11,EXCPMASK TEST IF EXCP IS REQUIRED 17600000 BC K8,LOAD7U IF NOT GO LOAD ADDR S20202 17660020 * IGG0197U S20202 17720020 * 17800000 *********************************************************************** 17900000 * 18000000 IOBUILD EQU * 18100000 * 18200000 *********************************************************************** 18300000 * 18400000 * WHEN UCS SET HAS BEEN READ,BUILD IOB AND CCWS IN WORK AREA 18500000 * 18600000 *********************************************************************** 18700000 * 18800000 LA RC,TWOMASK LOAD NUMBER OF RETRIES S20202 18900020 * 19000000 * CONSTRUCT CONTROL COMMAND 19100000 * 19200000 *********************************************************************** 19201020 * 19202020 * DETERMINE WHICH CCW CHAIN IS TO BE GENERATED TO LOAD THE UCS 19203020 * (1) FOR 1403/2821 THE SEQ IS A GATE LOAD FOLLOWED BY A LOAD OR 19204020 * LOAD AND FOLD. 19205020 * (2) FOR 3211/3811 THE SEQUENCE IS A LOAD FOLLOWED BY A FOLD OR 19206020 * JUST A LOAD COMMAND 19207020 * 19208020 *********************************************************************** 19209020 * 19210020 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 19211020 * FOR 321 S20202 19212020 BNE GOCNSTGL NO GO CONSTRUCT GATE S20202 19213020 * LOAD SEQ. S20202 19214020 * YES FALLS THROUGH TO FORM LOAD 19215020 * OR LOAD AND FOLD CCW'S 19216020 * 19217020 * DETERMINE ADDRESS OF 432 CHARACTERS IN UCS IMAGE 19218020 * 19219020 SR RF,RF ZERO OUT WORK REGISTER S20202 19220020 IC RF,ONEMASK(RB) INSERT NO. LINES IN S20202 19221020 * IMAGE S20202 19222020 LA RE,TWOMASK(RB) GET ADDRESS OF UCS IMAGE S20202 19223020 * FORMA S20202 19224020 AR RE,RF GET ADDRESS OF UCS IMAGE S20202 19225020 * 19226020 * BUILD CCW'S TO LOAD UCS BUFFER FOR 3211/3811 19227020 * 19228020 ST RE,DXCCW1 STORE ADDRESS OF IMAGE S20202 19229020 * IN CCW S20202 19230020 MVI DXCCW1,UCSLDCC COMMAND CD = LOAD UCS SM5451 19231001 MVC DXCCW1+K6(K2),UCSLTHEX MOVE LENGTH OF UCS TO S20202 19233020 * CCW S20202 19234020 MVI DXCCW1+K4,SILIMASK SET CCW FLAGS FOR CC AND S20202 19235020 * SILI S20202 19236020 TM DXCCW11+K3,FOLDMASK CK IF FOLD SPECIFIED FOR S20202 19237020 * UCS S20202 19238020 BZ CNGCCWFS NO GO CHANGE CCW FLAGS S20202 19239020 * 19240020 * YES FORM CCW TO FOLD UCS IMAGE 19241020 * 19242020 MVI DXCCW2,UCSFLDCC SET CCW2 COMMAND S20202 19243020 * CODE=FOLD S20202 19244020 MVI DXCCW2+K7,ONEMASK MOVE X'K01' TO LENGTH S20202 19245020 * FIELD S20202 19246020 MVI DXCCW2+K4,SILLCCW SET SILI FLAG IN CCW S20202 19247020 B EXCPGOGO GO ISSUE EXCP TO S20202 19248020 * LOAD+FOLD UCS S20202 19249020 * 19250020 CNGCCWFS EQU * S20202 19251020 * 19252020 MVI DXCCW2,UCSUNFLD CMD CODE = UNFOLD SM5451 19252401 MVI DXCCW2+K4,SILLCCW SET SILI FLAG IN CCW SM5451 19253001 MVI DXCCW2+K7,ONEMASK SET LENGTH FIELD SM5451 19253401 B EXCPGOGO GO ISSUE EXCP TO LOAD S20202 19255020 * UCS S20202 19256020 * 19257020 * BUILD CCW'S TO LOAD UCS BUFFER FOR PRINTERS USING 2821 CONTROL UNIT 19258020 * 19259020 GOCNSTGL EQU * S20202 19260020 * 19261020 * CONSTRUCT CONTROL COMMAND 19262020 * 19263020 MVI DXCCW1,CNTRLMSK COMMAND CODE = GATE LOAD 19300000 MVI DXCCW1+4,SILIMASK SET SILI AND C.C ON 19400000 MVI DXCCW1+7,ONEMASK SET LENGTH=X'01' 19500000 * 19600000 TSTFOLD EQU * 19700000 * 19800000 * CONSTRUCT LOAD COMMAND 19900000 * 20000000 MVI DXCCW2+7,UCSLNGTH MOVE UCS IMAGE LENGTH = 240 20100000 * 20200000 * GET THE ADDR OF 240 CHARACTERS UCS IMAGE TO BE LOADED 20300000 * 20400000 SR RF,RF RESET REGISTER 20500000 IC RF,ONEMASK(RB) INSERT NO. OF LINES 20600000 LA RE,TWOMASK(RB) LOAD UCS SET LOAD AREA ADDR 20700000 AR RE,RF DISPLACE BY NO. OF LINES 20800000 ST RE,DXCCW2 STORE WORK AREA ADDR IN CCW 20900000 * 21000000 MVI DXCCW2,UNFLCCW COMMAND CODE = LOAD UCS,UNFOLD 21100000 * 21200000 TM DXCCW11+3,FOLDMASK TEST IF FOLD IS SPECIFIED 21300000 BC 14,EXCPGOGO IF NOT,GOTO EXCP ROUTINE 21400000 * 21500000 MVI DXCCW2,FLDCCW COMMAND CODE = LOAD UCS,FOLD 21600000 * 21700000 EXCPGOGO EQU * 21800000 * 21900000 L RF,UCBXTADR LOAD UCB EXTENSION ADDR M0092 21910021 MVC 0(4,RF),DXCCW11+4 PUT UCS IMAGE ID IN UCB M0092 21920021 * EXTENSION AREA * 21930021 MVI DXECB,NULL ZERO OUT ECB FLAG S20202 21950020 LA RF,DXIOB LOAD IOB ADDR IN REG.1 22000000 EXCP (1) 22100000 * 22200000 LA RF,DXECB LOAD ECB ADDR IN REG.1 22300000 WAIT ECB=(1) WAIT ON THE ABOVE EXCP 22400000 * 22500000 CLI DXECB,X'7F' TEST COMP CODE OF ABOVE EXCP 22600000 BC 8,UCSVRFY IF YES,GOTO TEST VERIFY OPTION 22700000 * 22800000 *********************************************************************** 22900000 * 23000000 * IF ERROR ,REPEAT UCS LOAD EXCP ONE TIME 23100020 * 23200000 *********************************************************************** 23300000 * 23400000 BCT RC,EXCPGOGO IF ERROR REPEAT ONCE S20202 23500020 * 23600000 *********************************************************************** 23700000 * 23800000 ABEND0C EQU * 23900000 * 24000000 *********************************************************************** 24100000 * 24200000 * WHEN THERE WAS AN I/O ERROR DURING LOAD UCS,UPDATE UCB WITH X'00' 24300000 * TO SHOW NO IMAGE IN THE BUFFER.RETURN CODE = X'0C' IN REG.15 24400000 * WTO 'IEC126I XXX UCS PARITY ERROR.COMP CODE=B13' TO AN OPERATOR 24500000 * RUN C.E. DIAGNOSTICS FOR THE UCS FEATURE. 24600000 * +280(REG.4) POINTS TO THE IOB USED FOR THE EXCP ABOVE. 24700000 * 24800000 *********************************************************************** 24900000 * 25000000 MVC MSGLSTSZ(K54),DSPLY126 MOVE IN MSG TEXT DM0Q 25100018 MVC MESSAGEA+8(3),UCBNAME MOVE DEVICE NAME 25200000 MVC MSGLSTSZ+K54(K4),CODE126I MOVE IN DESC, ROUT CODES DM0Q 25250018 * 25300000 LA RF,MSGLSTSZ LOAD WTO ADDR 25400000 SVC 35 ISSUE WTO SVC 25500000 * 25600000 LA RB,OABD069 INTERNAL CODE 69 S21042 25700021 * 25800000 BC 15,UPUCBEND GOTO UPDATE UCB WITH X'00' 25900000 * 26000000 *********************************************************************** 26100000 * 26200000 UCSVRFY EQU * 26300000 * 26400000 *********************************************************************** 26500000 * 26600000 * TEST IF VERIFY OPTION IS SPECIFIED. 26700000 * 26800000 *********************************************************************** 26900000 * 27000000 TM DXCCW11+3,VERIFY TEST IF VERIFY IS SPECIFIED 27100000 BC K8,UPDTUCB IF NO GO UPDATE UCB-UCB S20202 27110020 * FIELDS S20202 27120020 * 27130020 * VERIFY SPECIFIED GO LOAD ADDRESS IGG0197U AND XCTL 27140020 * 27150020 * 27160020 LOAD7U EQU * S20202 27170020 * 27180020 * 27190020 AIF ('&LIB' NE 'LIB1').LIB1AB XM5400 27192001 LA RF,MODNM7U LOAD ' MOD IGG0197U S20202 27200020 B MVEIDTTR GO TO WTG SEQUENCE S20202 27210020 AGO .LIB1AC XM5400 27212001 .LIB1AB ANOP XM5400 27214001 SR RF,RF CLEAR RF XM5400 27270001 IC RF,MODNM7U+5 LOAD DOWBLEWORD LENGTH XM5400 27280001 SLL RF,3 MLPY BY 8 FOR BYTE LEN XM5400 27290001 ST RF,24(RWTG) TEMP. STORE OF LENGTH XM5400 27292001 MVC 24(3,RWTG),25(RWTG) STORE 3 BYTE TOTAL LEN XM5400 27294001 MVC 27(2,RWTG),25(RWTG) STORE 2 BYTE TEXT LENGTH XM5400 27296001 MVC 0(5,RWTGC),MODNM7U STORE '7U' IDTTR XM5400 27298001 B TCTLRTN BRANCH TO XCTL XM5400 27298101 .LIB1AC ANOP XM5400 27298401 * 27300000 *********************************************************************** 27400000 * 27500000 UPDTUCB EQU * 27600000 * 27700000 *********************************************************************** 27800000 * 27900000 * UPDATE UCB - UCS FIELDS 28000000 * 28100000 *********************************************************************** 28200000 * 28300000 L RJ,UCBXTADR GET ADDRESS OF UCB S20202 28350020 * EXTENTION S20202 28400020 MVC UCSIDOFS(K4,RJ),DXCCW11+K4 MOVE UCS IMAGE ID INTO S20202 28450020 * UCB S20202 28500020 MVC UCSOPOFS(K1,RJ),DXCCW11+K3 MOVE UCS OPTION BITS S20202 28550020 * TO UCB S20202 28600020 OC UCSOPOFS(K1,RJ),NULL(RB) SET DEFAULT BIT IF ANY S20202 28650020 NI UCSOPOFS(RJ),RESETMSK RESET VERIFY IF ANY S20202 28700020 * 28800000 *********************************************************************** 28900000 * 29000000 TSTCORE EQU * 29100000 * 29200000 *********************************************************************** 29300000 * 29400000 * TEST IF UCS IMAGE IS CORE TRANSFERED 29500000 * 29600000 *********************************************************************** 29700000 * 29800000 TM DXCCW11,COREMASK TEST IF CORE TRANSFER IS ON 29900000 BC 1,UCSEXIT IF YES,GOTO EXIT ROUTINE 30000000 * 30100000 B DELETUCS GO DELETE UCS IMAGE S20202 30103020 * 30106020 * 30109020 *********************************************************************** 30112020 * 30115020 *********************************************************************** 30118020 * 30121020 UGOOUT EQU * S20202 30124020 * 30127020 *********************************************************************** 30130020 * 30133020 * OPERATOR REPLIED 'U'.TEST DELETE THE IMAGE RETRIEVED 30136020 * 30139020 *********************************************************************** 30142020 * 30145020 TM DXCCW11,BLDL TEST IF IMAGE HAS BEEN S20202 30148020 * LOADED S20202 30151020 BC K14,UCSEXIT IFNOT GO DETERMINE NEXT S20202 30154020 * MODULE S20202 30157020 * TO GET CONTROL 30160020 * 30163020 * 30166020 DELETUCS EQU * S20202 30169020 * 30172020 * 30175020 * 30178020 *********************************************************************** 30200000 * 30300000 * DELETE UCS IMAGE 30400000 * 30500000 *********************************************************************** 30600000 * 30700000 LA RE,DXCCW6 LOAD ADDR OF ENTRY POINT - UCS 30800000 * 30900000 DELETE EPLOC=(0) DELETE UCS IMAGE 31000000 * 31100000 *********************************************************************** 31200000 * 31300000 *********************************************************************** 31400000 * 31500000 * 31510020 UCSEXIT EQU * S20202 31520020 * 31530020 MVI DXCCW10+K1,NULL RESET FCB SWITCH TO BE S20202 31540020 * USED BY S20202 31550020 * IGG0197E 31560020 TM DXCCW10,NOFCB CK IF FCB LOAD REQUIRED S20202 31570020 BO RESTERPT NO GO RESET EROPT S20202 31580020 TM DXCCW10,IEC129RQ CK IF IEC129 MESSAGE S20202 31590020 * REQUIRED S20202 31600020 BO ISSUE129 YES GO ISSUE IEC129 S20202 31610020 * MESSAGE S20202 31620020 TM DXCCW10,FCBALIGN CK IF ALIGN FORMS S20202 31630020 * SPECIFIED S20202 31640020 BO XCTL197F YES GO ALIGN FORMS IN S20202 31650020 * IGG0197F S20202 31660020 B XCTL197E NO GO LOAD FCBIN S20202 31670020 * IGG0197) S20202 31680020 * 31690020 ********************************************************************** 31700020 * 31710020 * ISSUE MESSAGE IEC129 AND XCTL TOIGG0197E 31720020 * 31730020 ********************************************************************** 31740020 * 31750020 ISSUE129 EQU * S20202 31760020 * 31770020 MVC MSGLSTSZ(41),MESAG129 MOVE MESSAGE TEXT INTO M5143 31780020 * DISPLAY S20202 31790020 MVC MESSAGEA+K8(K3),UCBNAME MOVE DEVICE NAME INTO S20202 31800020 * DISPLAY S20202 31810020 XC RPLY(24),RPLY CLEAR REPLY AREA AND ECB M5143 31830020 * COMPLETE S20202 31860020 LA RF,REPLYLTH GET ADDR FOR WTOR S20202 31870020 SVC K35 ISSUE WTOR IEC129 S20202 31880020 * 31890020 XCTL197E EQU * S20202 31900020 * 31910020 LA RF,MODNM7E GET IDTTR ADDR OF S20202 31920020 * IGG3197E S20202 31930020 B MVEIDTTR GO TO WTG SEQ S20202 31940020 * 31950020 SETGETM EQU * S20202 31960020 * 31970020 MVI DXCCW10+K2,STGETWO TURN ON FLAG FOR 197F M1803 31980021 * 32000020 XCTL197F EQU * S20202 32010020 * 32020020 LA RF,MODNM7F GET ADDR OF IDTTR OF S20202 32030020 * IGG0197F S20202 32040020 B MVEIDTTR GO TO WTG SEQ S20202 32050020 *********************************************************************** 32060020 * 32070020 * RESTORE DCB EROPT 32080020 * 32090020 *********************************************************************** 32100020 * 32110020 RESTERPT EQU * S20202 32120020 * 32130020 CLI UCBTBYT4,PRTM3211 CK IF DCB BEING OPENED S20202 32140020 * FOR 321 S20202 32150020 BE SETGETM IF SO SET ENTRY SWITCH M1803 32160021 * FOR MOD IGG0197F M1803 32162021 MVC DXCCW6(K1),DXCCW11+K1 MOVE IN DCB EROPT S20202 32170020 * 32180020 * 32190020 * SEE IF SYS1.IMAGELIB HAS BEEN OPENED IF YES CLOSE IT 32200020 * 32210020 CLI DXCCW8,IMCLOSED CK IF IMAGEDLIB CLOSED S20202 32220020 BE TSTEXCP IF NOT GO TEST IF EXCP S20202 32230020 * SPECIFE S20202 32240020 * 32250020 L RF,DXCCW8 GET ADDRESS OF IMAGELIB S20202 32260020 * DCB S20202 32270020 SVC 105 ISSUE SVC TO CLOSE S20202 32280020 * SYS1.IMAGEL S20202 32290020 * 32500000 *********************************************************************** 32600000 * 32700000 * DETERMINE THE NEXT STAGE 2 EXECUTOR TO BE XCTLED 32800000 * 32900000 *********************************************************************** 33000000 * 33100000 TSTEXCP EQU * 33200000 * 33300000 *********************************************************************** 33400000 * 33500000 * TEST IF EXCP IS SPECIFIED.IF YES,XCTL TO THE LAST OPEN EXECUTOR 33600000 * 33700000 *********************************************************************** 33800000 * 33900000 TM DCBMACRF,EXCPMASK TEST IF EXCP IS SPECIFIED 34000000 BC 14,TSTBLKBF IF NOT,GOTO BUFFER CNTRL BLK 34100000 * 34200000 MVI 0(RWTGC),NULL IF YES,ZERO NAME FIELD 34300000 BC 15,RELOOP GOTO WTG TABLE UPDATE 34400000 * 34500000 *********************************************************************** 34600000 * 34700000 TSTBLKBF EQU * 34800000 * 34900000 *********************************************************************** 35000000 * 35100000 * TEST IS BUFFER CONTROL BLOCK IS SPECIFIED.IF YES,XCTL TO IGG0911I 35200000 * 35300000 *********************************************************************** 35400000 * 35500000 TM DCBBUFNO+3,BFCNTRL BUFFER CONTROL BLOCK SPECIFIED 35600000 BC 14,TSTPCI IF YES,GOTO TEST PCI ROUTINE 35700000 * 35800000 SR RE,RE RESET REGISTER 35900000 IC RE,DCBBUFNO GET THE NO OF BUFFER SPECIFIED 36000000 LTR RE,RE TEST IF DCBBUFNO='0' 36100000 BC 8,TSTPCI IF YES,GOTO TEST PCI 36200000 * 36300000 LA RF,MODNM1I LOAD ADDR OF IDTTR OF IGG0191I 36400000 BC 15,MVEIDTTR GOTO MOVE IDTTR ROUTINE 36500000 * 36600000 *********************************************************************** 36700000 * 36800000 TSTPCI EQU * 36900000 * 37000000 AIF ('&LIB' EQ 'LIB1').LIB1AA 37006001 *********************************************************************** 37012001 * 37018001 * TEST FOR VIRTUAL=REAL. PCI IS ONLY HONORED FOR V=R. 37024001 * 37030001 *********************************************************************** 37036001 * 37042001 L RF,DEBTCBAD GET TCB POINTER 37048001 USING TCB,RF ESTABLISH ADDRESSABILITY 37054001 TM TCBFLGS6,TCBRV TEST FOR REAL ADDR SPACE 37060001 BZ BQSAMOUT BRANCH IF VIRTUAL 37066001 DROP RF 37072001 * 37078001 .LIB1AA ANOP 37084001 *********************************************************************** 37100000 * 37200000 * TEST IF PCI IS SPECIFIED.IF YES,XCTL TO IGG0191Q 37300000 * 37400000 *********************************************************************** 37500000 * 37600000 TM DCBOPTCD,PCIMASK TEST IF PCI SPECIFIED 37700000 BC 14,BQSAMOUT IF NOT,GOTO BSAM/QSAM ROUTINEED 37800000 * 37900000 LA RF,MODNM1Q LOAD ADDR OF IDTTR OF IGG0191Q 38000000 BC 15,MVEIDTTR GOTO MOVE IDTTR ROUTINE 38100000 * 38200000 *********************************************************************** 38300000 * 38400000 BQSAMOUT EQU * 38500000 * 38600000 AIF ('&LIB' EQ 'LIB1').LIB101 SM1830 38605021 *********************************************************************** 38610001 * * 38615001 * TEST FOR JES DATA MANAGEMENT * IF YES, XCTL TO OPEN * 38620001 * * 38625001 *********************************************************************** 38630001 CLI DCBRELAD,ACBID IS CONTROL BLOCK AN ACB 38635001 BNE JESOUT NO * GO TO XCTL TO BSAM/QSAM 38640001 MVI 0(RWTGC),NULL YES * ZERO ID IN WTG TABLE 38645001 B RELOOP GO TO XCTL TO OPEN 38650001 JESOUT EQU * 38655001 .LIB101 ANOP 38660001 *********************************************************************** 38700000 * 38800000 * BSAM/QSAM EXIT.XCTL TO IGG0191G 38900000 * 39000000 *********************************************************************** 39100000 * 39200000 LA RF,MODNM1G LOAD ADDR OF IDTTR IF IGG0191G 39300000 * 39400000 *********************************************************************** 39500000 * 39600000 MVEIDTTR EQU * 39700000 * 39800000 *********************************************************************** 39900000 * 40000000 * MOVE IDTTR TO XCTL WTG TABLE 40100000 * 40200000 *********************************************************************** 40300000 * 40400000 MVC 0(5,RWTGC),0(RF) STORE NEXT MODULE ID IN WTG 40500000 * 40600000 *********************************************************************** 40700000 * 40800000 RELOOP EQU * 40900000 * 41000000 *********************************************************************** 41100000 * 41200000 * UPDATE WTG TABLE AND XCTL TO NEXT MODULE 41300000 * 41400000 *********************************************************************** 41500000 * 41600000 LA RWTGC,WGOFF(0,RWTGC) INCREMENT CURRENT WTG ENTRY 41700000 LA RPARC,PLOFF(0,RPARC) INCREMENT CURRENT DCB ENTRY 41800000 CLC 0(2,RWTGC),AMIDCNST IS THE RTN NEEDED AGAIN 41900000 BCR 8,RBASE IF YES,RETURN TO PROCESS 42000000 * 42100000 CLC 0(2,RWTGC),OPIDCNST TEST END OF WTG TABLE 42200000 BC 7,RELOOP IF NOT,CHECK NEXT ENTRY 42300000 * 42400000 LR RPARC,RPAR RESET REG TO '0' 42500000 LA RWTGC,WAOFF(0,RWTG) RESET WTG REG TO POINT +32(WTG) 42600000 ZCHECK CLI 0(RWTGC),X'00' TEST IF THIS ENTRY COMPLETE 42700000 BC 7,TCTLRTN IF NOT,XCTL 42800000 * 42900000 LA RWTGC,WGOFF(0,RWTGC) GET NEXT ENTRY OF WTG TABLE 43000000 LA RPARC,PLOFF(0,RPARC) GET NEXT ENTRY OF DCB 43100000 B ZCHECK GO CHECK NEXT ENTRY XM5898 43150001 TCTLRTN EQU * 43498801 * 43500000 MVC 6(2,RWTG),0(RWTGC) STORE ID IN WTG TABLE 43600000 MVC 14(3,RWTG),2(RWTGC) MOVE TTR INTO TABLE 43700000 * 43800000 LA RJ,DXXCTL SET UP FOR XCTL S21042 43900021 * 44000000 XCTL DE=(RWTG),SF=(E,(15)) 44100000 * 44200000 * IF THE I/O ERROR PERSISTS,RUN C.E. DIAGNOSTICS ON THE PRINTER 66100000 * 66200000 *********************************************************************** 66300000 * 66400000 * 66710020 ABENROUT EQU * S20202 66720020 * 66730020 SR RB,RB ZERO OUT REG 12 S20202 66740020 IC RB,DXCCW11 PUT COMPLETION CODE INTO S20202 66750020 * REG 1 S20202 66760020 B ABENDRTN GO TO ABEND ROUTINE S20202 66770020 *********************************************************************** 66800000 * 66900000 * 68100000 *********************************************************************** 68200000 * 68300000 UPUCBEND EQU * 68400000 * 68500000 *********************************************************************** 68600000 * 68700000 * UPDATE THE UCB WITH X'00' TO INDICATE THAT THE IMAGE IN THE BUFFER 68800000 * IS NOT USABLE 68900000 * 69000000 *********************************************************************** 69100000 * 69200000 L RJ,UCBXTADR GET ADDRESS OF UCB S20202 69250020 * EXTENTION S20202 69300020 XC NULL(K5,RJ),NULL(RJ) RESET UCS ID/OPT IN UCB S20202 69350020 * 69400000 *********************************************************************** 69500000 * 69600000 CORETST EQU * 69700000 * 69800000 *********************************************************************** 69900000 * 70000000 * TEST IF UCS IMAGE IS CORE TRANSFERED 70100000 * 70200000 *********************************************************************** 70300000 * 70400000 TM DXCCW11,COREMASK TEST IF CORE TRANSFER IS ON 70500000 BC 1,ABENDRTN IF YES,GOTO ABEND ROUTINE 70600000 * 70700000 *********************************************************************** 70800000 * 70900000 DELETE EQU * 71000000 * 71100000 *********************************************************************** 71200000 * 71300000 * DELETE THE UCS IMAGE LOADED 71400000 * 71500000 *********************************************************************** 71600000 * 71700000 LA RE,DXCCW6 LOAD ADDR OF IMAGE ID LOADED 71800000 DELETE EPLOC=(0) 71900000 * 72000000 *********************************************************************** 72100000 * 72200000 ABENDRTN EQU * 72300000 * 72400000 *********************************************************************** 72500000 * 72600000 * ABEND ROUTINE.COMPLETION CODE=B13.RETURN CODE IS IN REG15. 72700000 * 72800000 *********************************************************************** 72900000 * 73000000 TM DXCCW11+2,ABENDBIT TEST IF ABEND IS IN PROCESS 73100000 BC 1,UCSEXIT IF YES,GOTO EXIT ROUTINE 73200000 * 73300000 DMABCOND (RB),PDLOAD,RETURN=NONE,RES=NO,REGSAVE=YES S21042X73400021 XCTL TO PROBLEM DETERMINATION 73500021 B TCTLRTN S21042 73600021 * 73900000 *********************************************************************** 74000000 * 74100000 *********************************************************************** 74200000 * 74300000 * CONSTANTS 74400000 * 74500000 *********************************************************************** 74600000 * 74700000 * FOR WTG TABLE 74800000 * 74900000 OPIDCNST DC C'0S' 75000000 XCTLCON DC X'C378' XCTL ATTR.-REENT.,REUSEABLE 75050001 * NOT IN OV'LAY,NOT TEST,NOT 75050401 * ONLY LOADABLE,BLOCK FORMAT, 75060401 * EXECUTABLE, 1 TEXT,COMPAT., 75070401 * ORIGIN AT 0,ENTRY PT. 0,NO 75080401 * RLD,NO ESD,NO SYMBOL CARDS 75090401 AMIDCNST DC C'1V' 75100000 WTGCNST DC C'IGG019 ' 75200000 * 75300000 * WTO MESSAGE TEXT AND VERIFICATION HEADING 75400000 * 75500000 DSPLY126 DC X'00368000' DM0Q 75970018 DC C'IEC126I UNCORRECTABLE ERROR LOADING UCS ' 20116 76040000 DC C'BUFFER' 20116 76110000 MESAG129 DC X'00258000' SA57891 76180001 DC C'IEC129D SPECIFY FCB PARAMETER' S20202 76250020 CODE121D DC X'40000200' DESCRIPTOR, ROUTING CODES DM0Q 76320018 CODE125I DC X'10000200' DESC AND ROUT CODES DM0Q 76340018 CODE126I EQU CODE125I DM0Q 76360018 UCSLTHEX DC X'0200' UCS LENGTH CONSTANT = S20202 76660020 * 512 S20202 76960020 * 77300000 *********************************************************************** 77400000 * 77500000 * XCTL TABLE 77600000 * 77700000 *********************************************************************** 77800000 * 77900000 XCTLTABL ID=(MODNM1G,1G,MODNM1I,1I,MODNM1Q,1Q,PDLOAD, S21042,78000021 6M, S21042,78100021 MODNM7E,7E,MODNM7F,7F,MODNM7U,7U), S21042*78200021 SVC=019 S21042 78300021 * 78700000 * 78800000 *********************************************************************** 78900000 * 79000000 *********************************************************************** 79100000 * 79200000 * DSECT 79300000 * 79400000 *********************************************************************** 79500000 * 79600000 * 79700000 DCBD DSORG=PS 79800000 * 79900000 *********************************************************************** 80000000 * 80100000 IECDSECS MAIN,EXPAND=YES S21042 80180021 FORCORE DSECT 80260021 ORG REPLYLTH+52 A33665 80340020 RPLY DS 20C A33665 80380020 RPLYECB DS F A33665 80420020 MCSMASK DS H A33665 80460020 LOMASK DS 8C A33665 80500020 UCSID DS 4C A33665 80540020 * 80600000 *********************************************************************** 80700000 * 80800000 SRT DSECT 80900000 IEFUCBOB 81000000 * 81100000 *********************************************************************** 81200000 * 81300000 * DATA EXTENT BLOCK (UNTIL PROTIOS CHANGES) 81400000 DEB DSECT 81500000 DEBNMSUB DS 0CL1 81600000 DEBTCBAD DS CL4 81700000 DEBAMLNG DS 0CL1 81800000 DEBDEBAD DS CL4 81900000 DEBOFLGS DS 0CL1 82000000 DEBIRBAD DS CL4 82100000 DEBOPATB DS 0CL1 82200000 DEBSYSPG DS CL4 82300000 DEBNMEXT DS 0CL1 82400000 DEBUSRPG DS CL4 82500000 DEBPRIOR DS 0CL1 82600000 DEBECBAD DS CL4 82700000 DEBPROTG DS 0CL1 82800000 DEBDEBID DS 0CL1 82900000 DEBDCBAD DS CL4 83000000 DEBEXSCL DS 0CL1 83100000 DEBAPPAD DS CL4 83200000 DEBDVMOD DS 0CL1 83300000 DEBUCBAD DS CL4 83400000 DEBTVLSQ DS 0CL2 VOL SEQ FOR TAPE 83500000 DEBBINUM DS CL2 83600000 DEBTVLNM DS 0CL2 NO OF VOL FOR TAPE 83700000 DEBSTRCC DS CL2 83800000 DEBSTRHH DS CL2 83900000 DEBENDCC DS CL2 84000000 DEBENDHH DS CL2 84100000 DEBNMTRK DS CL2 84200000 * FOR ADDITIONAL EXTENT ON DIRECT ACCESS THE FOLLOWING FIELDS 84300000 * WILL HAVE TO BE OFFSET ANOTHER 16 BYTES 84400000 DEBVOLSQ DS H 84500000 DEBVOLNM DS H 84600000 * FOR EACH SUBROUTINE LOADED BUMP THIS OFFSET BY 2 84700000 DEBSUBID DS H 84800000 * 84900000 IKJTCB 84910001 *********************************************************************** 85000000 * 85100000 END 85200000 ./ ADD SSI=00013032,NAME=IGG0191W,SOURCE=0 TITLE ' IGG0191W OUTPUT DA EXECUTOR FOR PCI SCHEDULING' 00008020 IGG0191W CSECT 00016020 * RELEASE 16 DELETIONS 00026020 *3004 14915 00027020 * RELEASE 17 DELETIONS 00029020 * RELEASE 18 DELETIONS 00032020 *0833141000 8M616 00032220 *0833 21476 00032520 *0833 MCS 00033020 * RELEASE 19 DELETIONS 00035020 *1394129000,152200-153400 A28683 00036020 *1394118800-119000 A27067 00037020 *1394078630-078720 A25961 00037520 *1394043900 M3641 00037720 * RELEASE 20 DELETIONS 00038020 *0000064200 M6190 00038220 *0000002800,052600,058600,058720,059380,064400,064800,066400- M5725 00038520 *0000066600,068760,070200,070600-071000,071600-072000,073200, M5725 00039020 *0000075800,075920,076000,077600,084200,103900,105400,111500, M5725 00039520 *0000128880-129080,136600-138350,142000-143800,146400,146600- M5725 00040020 *0000147600,155000-160400 M5725 00040520 * RELEASE 21 DELETIONS 00041020 * SA57269 00043002 * RELEASE 22 DELETIONS 00044020 * RELEASE 23 DELETIONS 00047020 * RELEASE 24 DELETIONS 00050020 *STATUS CHANGE LEVEL 001 00055020 *FUNCTION/OPERATION -- THIS EXECUTOR BUILDS THE MAIN IOB & ICBS THAT 00060020 * WILL CONTROL THEIR ASSOCIATED CHANNEL PROGRAMS. 00080020 * IT ALSO CONSTRUCTS INPUT OR OUTPUT CHANNEL PROG. 00100020 * AND FILLS IN DEVICE DEPENDANT FIELDS IN THE DCB. 00120020 * FOR QSAM THE CHANNEL PROGRAMS INCLUDE THE BUFFER 00140020 * ADDRESS,THE PHYSICAL BLOCK SIZE AND ASSC FLAGS. 00160020 * ALL ICBS ARE LINKED TOGETHER 00180020 * THE GETMAIN MACRO IS USED TO OBTAIN SPACE FOR 00200020 * THE IOB & ICBS. 00220020 * 00240020 * 00260020 *ENTRY POINTS - ENTERED AT IGG0191W FROM LEVEL ONE 00280020 * EXECUTOR IGG0191B VIA THE XCTL MACRO 00300020 * 00320020 *INPUT SUPPLIED- USER DCB AND OPEN PARAMETERS -- SEE REGISTER USAGE 00340020 * 00360020 *OUTPUT GIVEN - MAIN IOB , ICBS AND CHANNEL PROGRAMS , DCB INITIAL 00380020 * 00400020 * 00420020 *EXTERNAL RTS. - NONE 00440020 * 00460020 *EXITS-NORMAL: XCTL TO IGG01910(IECOSLDA) TO LOAD ROUTINES 00480020 * 00500020 *EXITS-ERROR: NONE. 00520020 * 00540020 *TABLES/WORKAREAS- WHERE TO GO TABLE (WTG) 00560020 * 00580020 * BYTE 0-7 NAME 00600020 * BYTE 8-10 RELATIVE DISK ADDRESS(TTR) OF FIRST RECORD 00620020 * BYTE 11 CONCATENATION NUMBER 00640020 * BYTE 12 ZERO 00660020 * BYTE 13 ALIAS INDICATOR AND USER DATA FIELD DESCRIPTOR. 00680020 * ALIAS INDICATOR 1 BIT 00700020 * NUMBER OF TTRS IN USERS DATA FIELD 2 BITS 00720020 * BYTE 14-16 TTR OF FIRST TEXT RECORD 00740020 * BYTE 17 ZERO 00760020 * BYTE 18-19 TTR OF NOTE LIST OR SCATTER LIST 00780020 * BYTE 20 TRANSLATION TABLE 00800020 * BYTE 21 ZERO OR NUMBER OF ENTRIES IN THE NOTE LIST 00820020 * BYTE 22-23 ATTRIBUTES 00840020 * BYTE 24-26 TOTAL CONTIGUOUS MAIN STORAGE REQUIRED FOR MODULE 00860020 * BYTE 27-28 LENGTH OF FIRST TEXT RECORD 00880020 * BYTE 29 LENGTH OF WTG TABLE (IN DOUBLE WORDS) 00900020 * BYTE 30-31 PATH THROUGH LOADS OF ROUTINES 00920020 * BYTE 32-34 IDTTR OF EXECUTOR FOR FIRST DCB 00940020 * BYTE 35 WORKAREA ADDRESS FOR FIRST DCB 00960020 * BYTE 36-39 TABLE OF IDTTR'S 00980020 * BYTE 32+N(8) IDTTR OF EXECUTOR FOR N TH DCB (3 BYTES) 01000020 * WORKAREA ADDRESS FOR N TH DCB (1 BYTE ) 01020020 * IDTTR OF LAST ROUTINE LOAD (3 BYTES) 01040020 * NOT USED (1 BYTE) 01060020 * 01080020 *ATTRIBUTES: REENTRANT,REUSABLE. 01100020 * 01120020 * 01140020 *********************************************************************** 01160020 * 01180020 * 01200020 * REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES 01220020 * 01240020 *********************************************************************** 01260020 * 01280020 RDCB EQU 2 DCB REGISTER 01300020 RBASE EQU 3 BASE REGISTER 01320020 RCORE EQU 4 WORK AREA ADDRESS 01340020 RPAR EQU 5 TOP OF PARAMETER LIST 01360020 RWTG EQU 6 TOP OF WTG TABLE 01380020 RPARC EQU 7 CURRENT PARAMETER 01400020 RWTGC EQU 8 CURRENT TRANS LOAD 01420020 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECTOR ADDR. 01440020 RUCB EQU 10 USED HERE AS A COUNTER IN IOB GENERATION 01460020 RDEB EQU 11 DEB ADDRESS 01480020 RB EQU 12 WORK REG1 ** 01500020 RC EQU 13 WORK REG2 ** USED IN IOB GENERATION 01520020 RD EQU 14 WORK REG3 ** 01540020 RJ EQU 15 WORK REG4 01560020 RE EQU 0 WORK REG5 01580020 RF EQU 1 WORK REG6 01600020 * 01620020 * 01640020 PARAR EQU RPARC 01660020 * 01680020 *********************************************************************** 01700020 * 01720020 * 01740020 * 01760020 ********************************************************************* 01780020 * MASK'S TO TEST PARAMETER LIST WITH 01800020 INP EQU X'0F' 01820020 OUTP EQU X'0F' 01840020 UPDATE EQU X'04' 01860020 INOUT EQU X'03' 01880020 OUTIN EQU X'07' 01900020 RDBACK EQU X'01' 01920020 * 01940020 * 01960020 ********************************************************************* 01980020 * 02000020 * 02020020 * OFFSET FOR PARAMETER TESTS 02040020 * 02060020 ONE EQU X'01' 02080020 FRTYATE EQU 48 02100020 DISPSN EQU X'0' 02120020 * 02140020 * 02160020 ********************************************************************* 02180020 * 02200020 * OFFSETS FOR DEB REFERENCE 02220020 * 02240020 * 02260020 * 02280020 * 02300020 * 02320020 ********************************************************************* 02340020 * 02360020 * MASK'S USED TO TEST OPTION FIELDS IN DCB 02380020 * 02400020 * 02420020 * 02440020 DOUBLE EQU X'01' 02460020 * 02480020 * 02500020 STOWB EQU X'80' 02520020 WRTCK EQU X'80' 02540020 OVRFLO EQU X'20' 02560020 PCIB EQU X'20' 02580020 MINKEY EQU X'01' 02600020 CONCAT EQU X'FF' 02620020 SRCHDIRB EQU X'40' 02640020 ONONYES EQU X'0C' 02660020 * 02680020 ********************************************************************* 02700020 * 02720020 * MASKS FOR ACCESS METHODS IN SAM 02740020 * 02760020 QSAMB EQU X'01' 02780020 BSAMBIT EQU X'00' 02800020 PAM EQU X'02' 02820020 * 02840020 * 02860020 * MASKS FOR MACRO'S TO BE USED 02880020 * 02900020 GETB EQU X'40' 02920020 PUTB EQU X'40' 02940020 READB EQU X'20' 02960020 WRITEB EQU X'20' 02980020 POINTB EQU X'04' 03000020 CNTRLB EQU X'02' 03020020 * 03040020 * 03060020 ********************************************************************* 03080020 * 03100020 * MASKS FOR DEVICES TO BE SUPPORTED 03120020 * 03140020 NORCDRY EQU X'20' NO RCD READY MASK 03160020 * 03180020 ********************************************************************* 03200020 * 03220020 * MASKS FOR STATUS BITS TO BE TESTED 03240020 * 03260020 * 03280020 EXCPN EQU X'30' 03300020 COMPLETE EQU X'60' 03320020 FIRSTIOB EQU X'01' 03340020 * 03360020 * 03380020 * 03400020 ********************************************************************* 03420020 * 03440020 * MASKS FOR BUFFER TECHNIQUE'S 03460020 * 03480020 EXCHANGB EQU X'10' 03500020 SIMPLEB EQU X'40' 03520020 * 03540020 ********************************************************************* 03560020 * 03580020 * 03600020 * MODES OF OPERATION FOR QSAM 03620020 * 03640020 LOCATEB EQU X'08' 03660020 MOVEB EQU X'10' 03680020 SUBSTUTB EQU X'04' 03700020 * 03720020 * 03740020 ********************************************************************* 03760020 * 03780020 * 03800020 * COMMAND BYTES FOR THE 2841 03820020 * 03840020 * CONTROL UNIT 03860020 * 03880020 * 03900020 * 03920020 SRCHE EQU X'31' 03940020 WRTCKD EQU X'1D' 03960020 RDC EQU X'92' 03980020 RDKD EQU X'8E' 04000020 RDD EQU X'86' 04020020 NOP EQU X'03' 04040020 TIC EQU X'08' 04060020 SETSC EQU X'23' SET SECTOR CCW CMND 04067020 RDSC EQU X'22' READ SECTOR CCW CMND 04074020 RDHA EQU X'1A' READ HOME ADDR 04081020 MTSID EQU X'B1' MULTI-TRK SRCH ID 04088020 TICNOP EQU X'88' RCD READY TIC NOP 04095020 * 04102020 * 04109020 ********************************************************************* 04120020 * 04140020 * 04160020 * MASKS FOR RECORD FORMATS 04180020 * 04200020 * 04220020 STANDRDF EQU X'08' 04240020 FORMATU EQU X'C0' 04260020 FORMATF EQU X'80' 04280020 FORMATV EQU X'40' 04300020 BLOCKED EQU X'10' 04320020 FSTANDRD EQU X'88' 04340020 FIXBKD EQU X'90' 04360020 NOTPNTID EQU X'05' 04380020 FORMATVS EQU X'48' VARIABLE SPANNED M3641 04390020 * 04400020 * 04420020 ********************************************************************* 04440020 * 04460020 * 04480020 * CHANNEL CONTROL WORD FLAGS 04500020 * 04520020 SKIP EQU X'10' 04540020 SLI EQU X'20' 04560020 PCI EQU X'08' 04580020 CC EQU X'40' 04600020 DATACH EQU X'A0' 04620020 SLICC EQU X'60' 04640020 SLICCSK EQU X'70' 04660020 * 04680020 * 04700020 ********************************************************************* 04720020 * 04740020 * 04760020 KEYS EQU X'01' 04780020 QSAM EQU X'01' 04800020 * 04820020 * 04840020 ********************************************************************* 04860020 * 04880020 COMMTABL EQU 16 04900020 * 04920020 ********************************************************************* 04940020 * 04960020 * 04980020 * DISPLACEMENTS, BYTE COUNTS AS EQUATES 04983020 * 04986020 D0 EQU 0 DISPLACEMENT OF 0 04989020 D1 EQU 1 DISPLACEMENT OF 1 04992020 D2 EQU 2 DISPLACEMENT OF 2 04995020 D3 EQU 3 DISPLACEMENT OF 3 04998020 D4 EQU 4 DISPLACEMENT OF 4 05001020 D5 EQU 5 DISPLACEMENT OF 5 05004020 D6 EQU 6 DISPLACEMENT OF 6 05007020 D7 EQU 7 DISPLACEMENT OF 7 05010020 D8 EQU 8 DISPLACEMENT OF 8 05013020 D12 EQU 12 DISPLACEMENT OF 12 05016020 D16 EQU 16 DISPLACEMENT OF 16 05019020 D25 EQU 25 DISPLACEMENT OF 25 05022020 D32 EQU 32 DISPLACEMENT OF 32 05025020 D35 EQU 35 DISPLACEMENT OF 35 05028020 D40 EQU 40 DISPLACEMENT OF 40 05031020 D51 EQU 51 DISPLACEMENT OF 51 05034020 D52 EQU 52 DISPLACEMENT OF 52 05037020 D56 EQU 56 DISPLACEMENT OF 56 05040020 D80 EQU 80 DISPLACEMENT OF 80 M5725 05041020 D255 EQU 255 DISPLACEMENT OF 255 M5725 05042020 * 05043020 * BYTE COUNTS AS EQUATES 05046020 * 05049020 B1 EQU 1 BYTE CNT OF 1 05052020 B2 EQU 2 BYTE CNT OF 2 05055020 B3 EQU 3 BYTE CNT OF 3 05058020 B4 EQU 4 BYTE CNT OF 4 05061020 B5 EQU 5 BYTE CNT OF 5 05064020 B8 EQU 8 BYTE CNT OF 8 05067020 B16 EQU 16 BYTE COUNT OF 16 05070020 B24 EQU 24 BYTE COUNT OF 24 05073020 * 05076020 * MISCELLANEOUS EQUATES 05079020 * 05082020 RRWCHPL EQU 10 RCD READY WRT CHP LEN 05085020 RRNWCHPL EQU 6 RCD READY NORM WRT CHP LEN 05088020 * IN DOUBLE WORDS 05091020 NWNOPOFF EQU 72 NORM NOP OFFSET 05094020 FLAGOFF EQU 4 FLAG OFFSET IN CCW 05097020 CNTOFF EQU 7 CNT FLD OFFSET 05100020 OABD065 EQU 65 INTERNAL ABEND CODE 65 I21042 05102021 * 05103020 * 05106020 * 05120020 * 05140020 BALR RBASE,0 REG 3 IS BASE 05160020 USING SOPA,RBASE ESTABLISH BASE REGISTER 05180020 USING IHADCB,RDCB REG 2 IS DCB 05200020 USING CVT,RTIOT REG 9 IS COMM UECT TABLE 05220020 USING FORCORE,RCORE REG 4 IS WORK AREA ADDR 05240020 * 05280020 * 05300020 SOPA EQU * FOR ADDRESSABILITY 05320020 * 05340020 * 05360020 L RDCB,0(RPARC) GET DCB ADDRESS 05380020 L RCORE,4(RWTGC) GET WORK AREA ADDRESS 05420020 * 05440020 SR RTIOT,RTIOT 05500020 ST RTIOT,DCBCNTRL 05560020 IC RTIOT,DCBNCP GET NUMBER OF ICBS TO BUILD 05640020 MVC D0(B5,RWTGC),SOP2 INIT TO NON PCI EXECUTOR M5725 05650020 * 05660020 TM DCBMACRF+1,POINTB NOTE/POINT MACRO USED 05720020 BC 8,SOPA001 NO BRANCH 05740020 * 05760020 MVI DCBCNTRL+1,NOTPNTID STORE INDEX FOR NOTE/POINT ID. 05780020 * 05800020 SOPA001 EQU * 05820020 LA RF,88 SIZE OF OUTPUT ICB +CP. 05840020 LA RUCB,B8 DOUBLE WORD CONSTANT M5725 05850020 * 05862020 * CHECK FOR RCD READY AND IF USED INCR ICB SIZE 05864020 * 05866020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD READY 05868020 BO SOPA01A BRANCH IF YES 05870020 AR RF,RUCB INCR ICB SIZE M5725 05872020 SOPA01A EQU * 05874020 MVI DCBCNTRL+3,1 STORE INDEX FACTOR FOR PCI EOB 05880020 TM DCBOPTCD,WRTCK WRITE VALIDITY SPECIFIED 05900020 BC 8,SOPA007 NO BRANCH 05920020 TM JFCBMASK+D6,NORCDRY RCD READY WITH WRT CHK 05926020 BO SOPA01D BRANCH IF YES 05932020 AR RF,RUCB INCR ICB SIZE M5725 05938020 SOPA01D EQU * 05944020 * 05950020 LA RF,24(RF) ADD CNST TO ICB & CP LENGTH 05960020 SOPA007 EQU * 06240020 * 06260020 LR RC,RF SAVE ICB SIZE 06270020 TM DCBCIND2,QSAMB IS QSAM BEING USED 06280020 BC 8,SOPA009 NO BRANCH 06300020 * 06320020 IC RTIOT,DCBBUFNO GET NO. OF ICBS TO GENERATE 06340020 SOPA009 EQU * 06360020 * 06380020 CH RTIOT,RCCWCNST+2 BUFFER # =1 ? M6190 06420020 * 06460020 BNH RELOOP BRANCH IF NOT GT ONE M5725 06480020 * 06500020 * 06520020 SOPA011 EQU * 06540020 * 06560020 LR RE,RF COPY ICB SIZE 06580020 SRL RE,3 DIVIDE BY EIGHT 06600020 STC RE,DCBIOBL SAVE FOR CLOSE 06620020 MR RE,RTIOT COMPUTE SPACE REQ M5725 06650020 LA RF,80(RF) ADD SPACE FOR MAIN IOB 06680020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD READY 06682020 BO SOPA11A BRANCH IF YES 06684020 LA RF,B16(RF) INCR FOR THETA VALUES AND 06686020 * SET SECTOR IN MIOB 06688020 SOPA11A EQU * 06690020 * 06692020 LR RB,RF SAVE FOR CLEARING RT. 06700020 * 06720020 ********************************************************************** 06740020 * 06760020 GETMAIN R,LV=(RF),SP=250 06780020 * 06800020 * 06820020 ********************************************************************** 06840020 * 06846020 * OBTAIN THETA ADDRS MAY BE USED LATER 06852020 * 06858020 LR RJ,RB GET AREA SIZE 06864020 AR RJ,RF GET LAST AREA + 1 ADDR 06870020 SR RJ,RUCB BACK UP AREA ADDR ONE DW 06882020 ST RJ,DXCCW11 TEMP STORE SET SECT ADDR 06888020 LA RJ,B1(RJ) OBTAIN RD SECTOR ADDR 06894020 ST RJ,DXCCW12 TEMP STORE 06900020 * 06906020 ********************************************************************** 06920020 ** 06940020 * THIS SECTION CLEARS THE SPACE RECIEVED FROM GETMAIN 06960020 ** 06980020 * 07000020 ST RF,DCBIOBAD STORE MAIN IOB ADDRESS 07040020 BCTR RB,0 REDUCE AMT BY ONE M5725 07060020 LA RJ,D255 GET MAX AMT CAN CLEAR M5725 07080020 COMPARE CR RB,RJ IS AMT TO CLEAR GT 255 M5725 07100020 BC 12,ONECLEAR NO BRANCH 07120020 * 07140020 EX RJ,CLEAR CLEAR 256 BYTES M5725 07150020 SR RB,RJ SUBT 255 FROM AMT TO M5725 07160020 * CLEAR M5725 07170020 BCTR RB,0 SUBT ONE MORE BYTE M5725 07180020 LA RF,256(RF) UPDATE AREA ADDR BY 256 07220020 B COMPARE 07240020 * 07260020 CLEAR XC 0(1,RF),0(RF) ACTUAL CLEAR INSTRUCTION 07280020 * 07300020 ONECLEAR EX RB,CLEAR CLEARS LESS THAN 256 M5725 07320020 * 07340020 * 07360020 * 07380020 L RB,DCBIOBAD GET MAIN IOB ADDRESS 07400020 * 07480020 * THIS SECTION OF CODE WILL BUILD THE MAIN IOB & CHANNEL PROGRAM 07500020 * 07520020 SOPA013 EQU * 07540020 * 07560020 LA RJ,D80(RB) POINT TO FIRST ICB M5725 07570020 TM JFCBMASK+D6,NORCDRY ANY DEVICES W/O RCD READY 07584020 BO SOPA13A BRANCH IF YES 07588020 AR RJ,RUCB INCR ICB PTR M5725 07592020 SOPA13A EQU * 07596020 ST RJ,D8(RB) STORE IN MAIN IOB M5725 07606020 LA RD,4(RB) POINT TO ECB IN MAIN IOB 07620020 * 07640020 MVI 0(RD),X'7F' POST MAINIOB COMPLETE 07660020 * 07680020 LA RF,56(RB) POINT TO CP START ADDRESS 07700020 STM RD,RDCB,20(RB) STORE ECBAD,CP.AD,DCBAD 07720020 MVC 48(8,RB),DCBFDAD MOVE D.A. ADDRESS TO MAIN IOB 07740020 LR RD,RC PUT ICB SIZE IN INDEX REG 07750020 * 07770020 * CHECK FOR RCD READY AND IF USED GO BUILD SET SECTOR 07780020 * 07790020 TM JFCBMASK+D6,NORCDRY ANY DEVICE W/O RCD READY 07800020 BO SOPA13D BRANCH IF YES 07810020 L RE,DXCCW11 GET THETA ADDR 07820020 BAL RJ,SOPASTA GO BUILD SET SECTOR 07830020 SOPA13D EQU * 07840020 * 07850020 * CONSTRUCTION OF SEARCH AND TIC FOLLOWS 07860020 * 07870020 LA RE,D51(RB) PT TO CCHHR IN MAIN IOB 07880020 BAL RJ,SOPSRCH GO BUILD SRCH AND TIC 07890020 * 07900020 AR RF,RUCB CHP PTR TO TIC 07910020 SR RC,RC CLEAR REG 07920020 IC RC,DCBKEYLE GET KEY LENGTH 07930020 AH RC,DCBBLKSI ADD BLOCK SIZE 07940020 ST RC,D4(RF) PUT IN RH OF TIC 07950020 * 07960020 AR RF,RUCB INCR PTR 07970020 MVI D0(RF),TIC PUT TIC CMND IN CCW 07980020 * 07990020 AR RF,RUCB 08000020 * 08010020 * MAIN IOB COMPLETE, FROM HERE ON RB=ICB, RF=CHP PTR, RUCB=8, 08020020 * RD=ICB SIZE,RDEB=16 HERE FOR INDEX TO NORM CHP ADDR 08030020 * 08040020 ST RF,DCBIOBA PUT ICB PTR IN DCB 08050020 LR RB,RF COPY ADDRESS 08060020 ICBLOOP EQU * 08120020 * 08140020 * 08160020 * 08220020 * 08240020 ************** CONSTRUCTION OF ICB & CP COMMENCE ********************** 08260020 * 08280020 * 08300020 ST RF,D0(RB) LINK ICBS, REDUNDANT FOR 08310020 * FIRST SINCE RF=RB 08320020 LR RB,RF UPDATE ICB PTR 08330020 LA RC,4(RB) POINT TO ECB IN ICB 08360020 ST RC,12(RB) STORE ECB ADDRESS IN ICB 08380020 MVI 4(RB),X'7F' POST ECB COMPLETE FOR NOW 08400020 LA RC,56(RB) POINT TO ICBS NORMAL CP M5725 08420020 ST RC,24(RB) STORE CP ADDRESS IN ICB 08440020 MVC 32(8,RB),DCBFDAD STORE D.A. ADDRESS IN ICB 08460020 * 08480020 * 08500020 * NOTE THAT THE DCB ADDRESS IS NOT STORED IN THE ICB 08520020 * 08540020 * 08560020 *********************************************************************** 10100020 * 10120020 SOPA025 EQU * 10140020 * 10160020 MVC DCBWCPO(4),PCIOFST STORE CP OFFSETS IN DCB 10180020 LA RF,D40(RB) PT RF TO CHP START 10190020 L RC,DCBIOBAD GET MAIN IOB PTR 10200020 LA RE,D35(RB) PT TO ICB CCHHR FLD 10210020 BAL RJ,SOPSRCH GO BUILD SRCH AND TIC 10220020 MVI D0(RF),MTSID CHANGE CMND TO MULTI-TRK 10230020 AR RF,RUCB INCR CHP PTR FOR SRCH 10240020 AR RF,RUCB INCR CHP PTR FOR TIC 10250020 * 10260020 * WRT CCW BUILD RTN 10270020 * 10280020 LA RE,D0(RB,RD) PT TO NEXT ICB 10290020 SR RE,RUCB BACK UP ONE DW 10300020 ST RE,D0(RF) PUT IN CHP AS CCHHRKDD FLD 10310020 MVI D0(RF),WRTCKD PUT IN CCW CMND 10320020 MVC FLAGOFF(B4,RF),WCCWCNST FLAGS AND LENT TO CCW 10330020 AR RF,RUCB INCR PTR 10340020 * 10350020 * 10360020 TM DCBCIND2,QSAMB QSAM USED 10370020 BZ SOPA029 BRANCH IF NO 10380020 L RJ,DCBBUFCB GET BFR POOL ADDR M5725 10381020 L RC,D0(RJ) GET BFR ADDR M5725 10382020 LTR RC,RC IS THERE A BUFFER M5725 10383020 * AVAILABLE M5725 10384020 BC 8,ABEND NO, ABEND BAD DCB M5725N 10385020 * SPECIFICATIO M5725 10386020 * 10387020 MVC D1(B3,RF),D1(RJ) PUT DATA ADDR IN CCW M5725 10388020 MVC D1(B3,RJ),D1(RC) UPDATE BFR POOL CNTRL M5725 10389020 * BLK M5725 10390020 MVC D6(B2,RF),DCBBLKSI BLKSIZE TO CCW M5725 10391020 SOPA029 EQU * 10400020 OI FLAGOFF(RF),SLI SET SILI BIT 10410020 AR RF,RUCB INCR PTR FOR 2ND WRT CCW 10420020 * 10430020 * CHECK FOR WRT CHK 10440020 * 10450020 TM DCBOPTCD,WRTCK WRT CHK SPECIFIED 10460020 BZ SOPA444 BRANCH IF NO 10470020 MVI DCBWCPL,B8 SET WRT CHP LEN 10480020 SR RF,RUCB BACK UP CHP PTR 10490020 OI FLAGOFF(RF),CC CMND CHAIN PREVIOUS CCW 10500020 AR RF,RUCB RESTORE PTR 10510020 TM JFCBMASK+D6,NORCDRY ANY DEVICE W/O RCD READY 10520020 BO SOPA29A BRANCH IF YES 10530020 BAL RJ,SOPARTA GO BUILD RD SECT CMND 10550020 OI FLAGOFF(RF),CC CMND CHAIN RD SECT CCW SA57269 10552002 * 10560020 * 10570020 L RE,DXCCW12 GET THETA ADDR 10580020 BAL RJ,SOPASTA GO BUILD SET SECTOR CMND 10590020 MVI DCBWCPL,RRWCHPL SET WRT CHP LEN FOR RCD RDY 10600020 SOPA031 EQU * 10610020 SOPA29A EQU * 10620020 LA RE,D0(RB,RD) PT OT NEXT ICB 10630020 SR RE,RUCB BACK UP TO CCHHRKDD ADDR 10640020 BAL RJ,SOPSRCH GO BUILD SRCH AND TIC 10650020 AR RF,RUCB INCR PTR FOR SRCH 10660020 AR RF,RUCB INCR PTR FOR TIC 10670020 * 10680020 * 10690020 MVI D0(RF),RDD PUT IN RD DATA CMND 10700020 MVC FLAGOFF(B4,RF),RCCWCNST PUT IN FLAGS AND LEN 10710020 * 10720020 TM DCBCIND2,QSAMB QSAM USED 10730020 BO SOPA035 BRANCH IF YES 10740020 CLI DCBKEYLE,B1 KEY LENGTH SPECIFIED 10750020 BNH SOPA035 BRANCH IF NO 10760020 MVI D0(RF),RDKD PUT IN RD KEY DATA CMND 10770020 *