* /* START OF SPECIFICATIONS **** 00050002 *01* PROCESSOR = ASSEMXF-370R 00060002 **** END OF SPECIFICATIONS ***/ 00070002 TITLE 'IGG0197B OPEN EXECUTOR ' 00100019 IGG0197B CSECT 00200019 *********************************************************** @YM00638 00250002 *MODULE-NAME @YM00638 00260002 * IGG0197B @YM00638 00270002 * @YM00638 00280002 *DESCRIPTIVE-NAME @YM00638 00290002 * OCR OPEN EXECUTOR, STAGE 3 @YM00638 00292002 * @YM00638 00294002 *COPYRIGHT @ZA00775 00296003 * NONE @YM00638 00298002 * @YM00638 00298402 *CHANGE-ACTIVITY @YM00638 00298802 * 00300019 * RELEASE 20 ADDITIONS/CHANGES/DELETIONS 00400001 * RELEASE 21 ADDITIONS/CHANGES/DELETIONS 00500001 * RELEASE 22 ADDITIONS/CHANGES/DELETIONS 00600001 * RELEASE 23 ADDITIONS/CHANGES/DELETIONS 00700001 * RELEASE 24 ADDITIONS/CHANGES/DELETIONS 00800001 * RELEASE 25 ADDITIONS/CHANGES/DELETIONS 00900001 * RELEASE 26 ADDITIONS/CHANGES/DELETIONS 01000001 * RELEASE 27 ADDITIONS/CHANGES/DELETIONS 01100001 *A069500,150500,252300,252600,314300,314600,320500,359300, Y02967$ 01120002 *A359600,361500,390100 - 390600,404500 Y02967* 01140002 *C148000,277000 - 277600,439000 - 440200,463000 - 473000, Y02967* 01160002 *C477000 - 478200 Y02967* 01180002 * * 01200019 * STATUS - CHANGE LEVEL 00 RELEASE 20 01300001 * * 01400019 *FUNCTION/OPERATION * 01500019 * IT LOADS DEVICE DEPENDENT ROUTINES IDENTIFIED BY A MASK SET IN STAGE* 01600019 * 2 IN DCBCNTRL * 01700019 * IT ENTERS THE ADDRESS OF THESE ROUTINES INTO THE DCB * 01800019 * IT ENTERS THE IDENTIFICATION OF EACH ROUTINE LOADED INTO THE DEBSUBED 01900019 * FIELD OF THE DEB * 02000019 * IT COMPLETES THE CHANNEL PROGRAMS BY INSERTING.A BUFFER ADDRESS INTO* 02100019 * EACH CCW (QSAM) * 02200019 * IT WRITES A MOUNT MESSAGE TO THE OPERATOR INDICATING THE NAME * 02300019 * ASSOCIATED WITH THE VOLUME TO BE MOUNTED. IF NO NAME IS SPECIFIED * 02400019 * IN THE VOLUME PARAMETER ON THE USERS DD CARD, THE NAME OCRINP IS * 02500019 * USED * 02600019 * IT ISSUES A NO-OP COMMAND TO CLEAR STATUS AND SENSE 02700019 * IT SEARCHES THE WTG TABLE TO PASS CONTROL TO ANOTHER EXECUTOR. * 02800019 * IF THE WTG TABLE HAS NO OTHER ENTRIES, THE EXECUTOR RETURNS CONTROL 02900019 * TO THE OPEN ROUTINE. * 03000019 * * 03100019 *ENTRY POINT 03200019 * LABEL OCR010 03300019 *ENTRY METHOD- ENTERED FROM IGG0197A BY USE OF THE XCTL MACRO * 03400019 * * 03500019 *INPUT SEE DESCRIPTION OF REGISTERS, USER'S DCB AND IOB'S * 03600019 * * 03700019 *OUTPUT SEE DESCRIPTION OF REGISTERS, USER'S DCB AND IOB'S, WRITE TO * 03800019 * OPERATOR MESSAGE * 03900019 * * 04000019 *EXITS-NORMAL XCTL TO IGG0190S (OPEN) * 04100019 * * 04200019 *EXITS-ABNORNAL SVC 13, ABEND 013 -INSUFFICIENT BUFFERS AVAILABLE * 04300019 * IN BUFFER POOL TO SATISFY DCB BUFFER REQUIREMENTS * 04400019 * * 04500019 *TABLES/WORKAREAS-WHERE TO GO TABLE * 04600019 * * 04700019 *ATTRIBUTES REENTRANT, REUSABLE * 04800019 *********************************************************************** 04900019 * * 05000019 *REGISTER CONVENTIONS USED THROUGH OUT ALL OPEN PASSES * 05100019 * * 05200019 *********************************************************************** 05300019 RE EQU 0 WORK REG 5 05400019 RF EQU 1 WORK REG 6 05500019 RDCB EQU 2 DCB REGISTER 05600019 RBASE EQU 3 BASE REGISTER 05700019 RCORE EQU 4 WORK AREA ADDRESS 05800019 RPAR EQU 5 TOP OF PARAMETER LIST 05900019 RWTG EQU 6 TOP OF WTG TABLE 06000019 RPARC EQU 7 CURRENT PARAMETER 06100019 RWTGC EQU 8 CURRENT TRANS LOAD 06200019 RTIOT EQU 9 USED HERE AS WRK REG AND COMM VECT 06300019 RUCB EQU 10 USED ASICOUNTER AND UCB ADDRESS 06400019 RDEB EQU 11 DEB ADDRESS 06500019 RB EQU 12 WORK REG 1 06600019 RC EQU 13 WORK REG 2 06700019 RD EQU 14 WORK REG 3 06800019 RJ EQU 15 WORK REG 4 06900019 RTCB EQU 15 TCB REGISTER Y02967 06950002 *********************************************************************** 07000019 * 07100019 * OFFSET EQUATES FOR WTG AND XCTL TABLES 07200019 * ALSO FOR MOUNT MESSAGE AND UCB 07300019 * 07400019 *********************************************************************** 07500019 WKAOFF EQU 4 OFFSET TO WORK AREA IN WTG TABLE 07600019 WTGID EQU 6 OFFSET TO ID IN WTG TABLE 07700019 WTGTTR14 EQU 14 OFFSET TOTTR IN WTG TABLE 07800002 TEMP0 EQU 24 OFFSET TO TEMP STORAGE IN WTG TABLE 07900019 TOTALOFF EQU 24 OFFSET OF TOTAL TEXT LNGH IN WTG TAB 08000019 TEMP EQU 25 OFFSET TO TEMP STORAGE IN WTG TABLE 08100019 TEXTOFF EQU 27 OFFSET TO FIRST TEXT IN WTG TAB 08200019 WAOFF EQU 32 OFFSET OF WTG TABLE FROM BLDL TABLE 08300019 IDOFF EQU 0 OFFSET TO ID IN IDTTRL ENTRY 08400019 TTROFF EQU 2 OFFSET TO TTR IN IDTTRL ENTRY 08500019 LOFF EQU 5 OFFSET TO L IN IDTTRL ENTRY 08600019 UNIT EQU 14 UNIT POSITION IN MESSAGE 08700019 VOLID EQU 18 VOLUME PARAMETER IN MESSAGE 08800019 UNAME EQU 13 UNIT OFFSET IN UCB 08900019 QSAMCP EQU 48 OFFSET OF QSAM CHANNEL PROGRAM IS 48 09000019 *********************************************************************** 09100019 * 09200019 * LENGTHS 09300019 * 09400019 *********************************************************************** 09500019 WGOFF EQU 8 LENGTH OF ENTRY IN WTG TABLE 09600019 PLOFF EQU 4 LENGTH OF ENTRY IN OPEN PARAM LIST 09700019 DEBSIZE EQU 32 SIZE OF THE DEB 09800019 ADDRESS EQU 3 LENGTH OF AN ADDRESS 09900019 CCWL EQU 8 LENGTH OF ONE CCW 10000019 CCWL2 EQU 16 LENGTH OF A PAIR OF CCWS 10100019 WORD EQU 4 LENGTH OF DCBCNTRL - 4 BYTES 10200019 DOUBLEWD EQU 8 DOUBLE WORD LENGTH IS 8 BYTES 10300019 UNITL EQU 3 LENGTH OF UNIT ADDRESS IS 3 10400019 VOLUMEL EQU 6 LENGTH OF VOLUME PARAMETER IS 6 10500019 IDLNGH EQU 2 LENGTH OF OPEN EXECUTOR ID 10600019 TTRLNGH EQU 3 LENGTH OF OPEN EXECUTOR TTR 10700019 IDTTRLL EQU 6 LENGTH OF IDTTRLL FIELD 10800019 TOTALL EQU 3 INDICATES LENGTH OF TOTAL TEXT 10900019 TEXTL EQU 2 INDICATES LENGTH OF FIRST TEXT REC 11000019 TXTOTL EQU 5 LENGTH OF TEXTL AND TOTALL 11100019 *********************************************************************** 11200019 * 11300019 * SHIFTS 11400019 * 11500019 *********************************************************************** 11600019 BITS8 EQU 8 USED TO SHIFT ONE BYTE 11700019 MULT8 EQU 3 SHIFT TO MULTIPLY BY 8 11800019 BITS12 EQU 12 USED TO SHIFT LEFT 12 BITS 11900019 *********************************************************************** 12000019 * 12100019 * CONSTANTS 12200019 * 12300019 *********************************************************************** 12400019 QSAMB EQU X'01' QSAM INDICATOR 12500019 ABENDCOD EQU X'13' OPEN ABEND SYSTEM CODE 12600019 BLANK EQU X'40' USED TO CHECK FOR A BLANK CHARACTER 12700019 X5C EQU X'5C' 1288 DEVD ENTRY IN DCB 12800019 ZERO EQU 0 USED AS A ONE BYTE HEX 0 CONSTANT 12900019 ONE EQU 1 USED AS A CONSTANT OF 1 13000019 *********************************************************************** 13100019 * 13200019 * EQUATES FOR EXCP OF NO-OP COMMAND 13300019 * 13400019 *********************************************************************** 13500019 ECB EQU 4 OFFSET OF ECB IN THE IOB 13600019 IOSIOB EQU 8 OFFSET OF THE IOS IOB IN THE ACCESS 13700019 * METHOD IOB 13800019 CPADR EQU 24 OFFSET OF CHAN PROG ADDR IN IOB 13900019 TEMCCW EQU 40 OFFSET OF NO-OP CCW IN IOB 14000019 ERRFLGS EQU X'3F' USED TO TURN OFF IOS ERRFLGS 14100019 *********************************************************************** 14200019 *********************************************************************** 14300019 EJECT 14400019 BALR RBASE,0 LOAD BASE REGISTER 14500019 USING OCR010,RBASE MODULE BASE 14600019 USING IHADCB,RDCB DCB BASE 14700019 USING DEBBASIC,RDEB DEB BASE REGISTER Y02967 14800002 USING FORCORE,RCORE CORE BASE 14900019 USING CVT,RF CVT BASE 15000019 USING TCB,RTCB TCB BASE Y02967 15050002 USING WTG,RWTG @YM02503 15070002 * 15100019 OCR010 L RDCB,0(RPARC) GET DCB ADDRESS 15200019 LA RDCB,0(RDCB) CLEAR HIGH ORDER BYTE 15300019 L RDEB,DCBDEBAD GET DEB ADDRESS 15400019 L RCORE,WKAOFF(RWTGC) GET WORK AREA ADDRESS 15500019 * 15600019 SR RUCB,RUCB CLEAR REGISTER 15700019 SR RF,RF CLEAR REGISTER 15800019 IC RUCB,DEBNMEXT GET NUMBER OF EXTENTS 15900019 IC RF,DEBEXSCL GET SCALING FACTOR 16000019 SLL RUCB,0(RF) SHIFT ACCORDING TO EXTENT SIZE 16100019 IC RF,DEBAMLNG GET ACCESS METHOD LENGTH 16200019 LA RUCB,0(RF,RUCB) ADD TO POINT TO SUBRT ID FIELD 16300019 LA RUCB,DEBSIZE(RUCB,RDEB) ADD BASIC DEB SZ TO DEB ADDRESS 16400019 * 16500019 * RUCB NOW POINTS TO THE SUBROUTINE ID FIELD IN THE DEB 16600019 *********************************************************************** 16700019 * 16800019 * LOAD ACCESS METHOD MODULES 16900019 * 17000019 *********************************************************************** 17100019 * 17200019 MVI 0(RWTGC),ZERO ZERO CURRENT ID ENTRY 17300019 * 17400019 BAL RF,POINT2ID POINT TO THE END OF BLOCK ROUTINE 17500019 * 17600019 BAL RC,LOADMOD LOAD THE EOB ROUTINE 17700019 * 17800019 TM DCBCIND2,QSAMB IS QSAM USED 17900019 BZ OCR020 NO,BRANCH 18000019 MVC DCBEOB+1(ADDRESS),TEMP(RWTG) MOVE EOB ADDRESS TO DCB 18100019 B OCR030 BRANCH TO CONTINUE PROCESSING 18200019 * 18300019 OCR020 MVC DCBEOBR+1(ADDRESS),TEMP(RWTG) MOVE EOB ADDRESS TO DCB 18400019 * 18500019 OCR030 BAL RF,POINT2ID POINT TO GET/READ ROUTINE 18600019 * 18700019 BAL RC,LOADMOD LOAD GET/READ MODULE 18800019 * 18900019 MVC DCBGET+1(ADDRESS),TEMP(RWTG) MOVE GET/READ ADDRESS 2 DCB 19000019 * 19100019 BAL RF,POINT2ID POINT TO GERR/CHECK ROUTINE 19200019 * 19300019 BAL RC,LOADMOD LOAD GERR/CHECK MODULE 19400019 * 19500019 MVC DCBGERR+1(ADDRESS),TEMP(RWTG) MOVE GERR/CHECK ADDRESS TO 19600019 * DCB 19700019 BAL RF,POINT2ID POINT TO CNTRL ROUTINE 19800019 * 19900019 LTR RC,RC IS THERE A CNTRL ID 20000019 BNZ OCR040 YES, BRANCH 20100019 * 20200019 XC DCBCNTRL(WORD),DCBCNTRL CLEAR PARAMETER LIST 20300019 OI DCBCNTRL+3,ONE SET VECTOR TO 1 20400019 B OCR050 BRANCH TO CONT PROCESSING 20500019 * 20600019 OCR040 BAL RC,LOADMOD LOAD CNTRL ROUTINE 20700019 * 20800019 MVC DCBCNTRL+1(ADDRESS),TEMP(RWTG) MOVE CNTRL ROUTINE TO DCB 20900019 OCR050 MVC DCBEROPT(ONE),DXCCW6 REPLACE QSAM ERROR OPTIONS 21000019 TM DCBCIND2,QSAMB THIS A QSAM DCB 21100019 BZ OCR060 NO, BRANCH 21200019 * 21300019 LA RB,RDLNEID LOAD ADDRESS OF RDLNE ID 21400019 BAL RC,LOADMOD LOAD THE RDLNE ROUTINE 21500019 * 21600019 MVC DCBRDLNE+1(ADDRESS),TEMP(RWTG) MOVE RDLNE ADDRESS TO DCB 21700019 * 21800019 B OCR080 BRANCH TO CONT PROCESSING 21900019 * 22000019 OCR060 CLI DCBDEVT,X5C IS THE DEVICE A 1288 22100019 BE OCR070 YES, BRANCH 22200019 * 22300019 LA RB,DSPLYID GET THE ADDRESS OF THE DSPLY ID 22400019 BAL RC,LOADMOD LOAD THE DSPLY ROUTINE 22500019 * 22600019 MVC DCBDSPLY+1(ADDRESS),TEMP(RWTG) MOVE DSPLY ADDRESS TO DCB 22700019 * 22800019 OCR070 LA RB,RESCNID GET THE ADDRESS OF THE RESCN ID 22900019 BAL RC,LOADMOD LOAD THE RESCN ID 23000019 * 23100019 MVC DCBRESCN+1(ADDRESS),TEMP(RWTG) MOVE RESCN 23200019 * 23300019 OCR080 L RUCB,DCBIOBA LOAD FIRST IOB ADDRESS 23400019 LR RTIOT,RUCB SAVE ADDRESS IN WORK REGISTER 23500019 * 23600019 TM DCBCIND2,QSAMB THIS DCB USING QSAM 23700019 BZ OCR095 NO,BRANCH 23800019 * 23900019 XC DCBEOBAD(DOUBLEWD),DCBEOBAD FORCE EOB CONDITION 24000019 SR RB,RB CLEAR REGISTER TO INSERT COUNT 24100019 IC RB,DCBBUFNO GET NUMBER OF BUFFERS 24200019 LR RD,RTIOT SAVE FIRST IOB ADDRESS 24300019 OCR085 LA RTIOT,QSAMCP(RTIOT) POINT TO CHANNEL PROGRAM 24400019 * ASSUME NORMAL SCHEDULINGG=8 24500019 * ASSUME IOB=32 24600019 * ASSUME CNTRL & RDLNE CCWS =8 24700019 SR RE,RE CLEAR DIVIDE REGISTER 24800019 LH RF,DCBBUFL LOAD BUFFER LENGTH 24900019 LH RJ,DCBLRECL LOAD RECORD LENGTH 25000019 DR RE,RJ CALC NUMBER OF LINES PER BUFFER 25100019 L RC,DCBBUFCB LOAD ADDRESS OF BUFFER CONTROL BLOCK 25200019 MODESET KEYADDR=DXUKEY,WORKREG=15 GET USER KEY @YM02503 25230002 L RJ,0(RC) GET A BUFFER ADDRESS 25300019 LTR RJ,RJ VALID BUFFER ADDRESS 25400019 BZ OCRABEND NO, BRANCH TO ABEND 25500019 MVC ONE(ADDRESS,RC),ONE(RJ) UPDATE BUFCB ADDRESS 25600019 AH RJ,DCBLRECL ADJUST BUFFER FOR READ BACKWARD 25700019 BCTR RJ,0 DECREMENT BY ONE 25800019 * 25900019 OCR090 IC RE,0(RTIOT) SAVE OP CODE 26000019 ST RJ,0(RTIOT) STORE BUFFER ADDRESS TO CCW 26100019 STC RE,0(RTIOT) RESTORE OP CODE 26200019 * 26300019 AH RJ,DCBLRECL UPDATE BUFFER ADDRESS 26400019 LA RTIOT,CCWL2(RTIOT) UPDATE CCW ADDRESS 26500019 BCT RF,OCR090 IF MORE CCWS, CONTINUE 26600019 * 26700019 L RTIOT,0(RD) GET NEXT IOB TO INITIALIZE 26800019 LR RD,RTIOT UPDATE IOB POINTER 26900019 BCT RB,OCR085 IF MORE IOBS, CONTINUE 27000019 * 27100019 *********************************************************************** 27200019 * 27300019 * WRITE MOUNT MESSAGE 27400019 * 27500019 *********************************************************************** 27600019 OCR095 EQU * Y02967 27700002 MODESET EXTKEY=DATAMGT PUT SYSTEM IN OPEN KEY Y02967 27730002 LA RF,MESSAGEA+48 GET WTO AREA @YM02503 27760002 * 28000019 MVC 0(WTOSIZE,RF),WTOBEGIN MOVE WTO LIST FORM TO CORE 28100019 * 28200019 * 28300019 L RUCB,DEBTCBAD+32 GET UCB ADDRESS Y02967 28400002 MVC UNIT(UNITL,RF),UNAME(RUCB) MOVE UNITNAME TO MESSAGE 28500019 * 28600019 * 28700019 CLI JFCBVOLS,BLANK IS VOLID SPECIFIED 28800019 BE OCR100 NO,BRANCH 28900019 * 29000019 MVC VOLID(VOLUMEL,RF),JFCBVOLS MOVE SPECIFIED VOLID TO MESAG 29100019 B OCR110 BRANCH TO CONT PROCESSING 29200019 * 29300019 OCR100 MVC VOLID(VOLUMEL,RF),OCRINP MOVE DEFAULT ID TO MESSAGE 29400019 * 29500019 OCR110 LR RUCB,RF SAVE ADDRESS OF GETMAIN CORE 29600019 *********************************************************************** 29700019 * 29800019 WTO MF=(E,(RF)) PARAMETER LIST ADDRESS IN REG.1 29900019 * 30000019 *********************************************************************** 30100019 ST RF,DCBWTOID STORE WTO MESSAGE IDENTIFICATION 30200019 *********************************************************************** 30800019 * 30900019 * ISSUE NO-OP TO CLEAR STATUS AND SENSE 31000019 * BY BUILDING AN IOB IN THE OPEN WORKAREA AND PUTTING @YM02503 31010002 * THE DATA MANAGEMENT COPIED DCB ADDRESS INTO THE IOB. THIS 31020002 * HAS TO BE DONE BECAUSE THE DEB HAS DATA MANAGEMENT DCB 31030002 * ADDRESS IN IT AT THIS TIME.THE USER IOB CANNOT BE USED 31040002 * AT THIS TIME BECAUSE THE IOD AND DCB WOULD BE IN TWO @YM02503 31050002 * DIFFERENT PROTECT KEYS.THIS CONDITION WOULD CAUSE @YM02503 31060002 * A PROTECTION CHECK AT EXCP TIME @YM02503 31070002 * 31100019 *********************************************************************** 31200019 LA RB,MESSAGEA GET IOB ADDRESS @YM02503 31300002 XC 0(40,RB),0(RB) ZERO OUT IOB AREA @YM02503 31310002 ST RB,0(RB) ONLY IOB IN CHAIN @YM02503 31320002 OI 0(RB),1 FIRST IOB @YM02503 31330002 LA RD,4(RB) GET ECB ADDRESS @YM02503 31340002 ST RD,12(RB) PUT ECB ADDRESS IN IOB @YM02503 31350002 OI 0(RD),X'7F' SET ECB COMPLETE @YM02503 31360002 OI 8(RB),X'02' SET UNRELATED FLAG ON IN IOB 31370002 ST RDCB,X'1C'(RB) PUT D.M. DCB ADDR IN IOB 31380002 LA RD,40(RB) GET IOB CCW ADDR @YM02503 31390002 ST RD,X'18'(RB) PUT CCW ADDR IN IOB @YM02503 31400002 MVC TEMCCW(CCWL,RB),NOPCCW SET UP NO-OP CCW 31500019 LA RD,TEMCCW(RB) LOAD ADDRESS OF NO-OP CCW 31600019 ST RD,CPADR(RB) STORE ADDRESS OF NO-OP IN IOB 31700019 EXCP IOSIOB(RB) EXECUTE THE NO-OP 31800019 WAIT ECB=ECB(RB) WAIT FOR COMPLETION 31900019 NI DCBIFLGS,ERRFLGS RESET ERROR FLAGS IF ANY 32100019 IECRES INIT,DCBCOPY=FRWKAR,STM=(0,14,WTGPREFX) @YM02503 32120002 L RDEB,DCBDEBAD GET DEB ADDRESS @YM02503 32140002 MVC DEBDCBAD+1(3),DXUDCBAD+1 PUT USER DCB ADDR IN DEB 32160002 *********************************************************************** 32200019 * 32300019 * GO TO NEXT EXECUTOR OR DO THIS ONE AGAIN 32400019 * 32500019 *********************************************************************** 32600019 * 32700019 RELOOP LA RWTGC,WGOFF(RWTGC) INCREMENT CURRENT WTG ENTRY 32800019 LA RPARC,PLOFF(RPARC) INCREMENT CURRENT DCB ENTRY 32900019 CLC 0(IDLNGH,RWTGC),AMIDCNST THIS ROUTINE NEEDED AGAIN 33000019 BCR 8,RBASE YES, BRANCH TO BEGINNING 33100019 * 33200019 CLC 0(IDLNGH,RWTGC),OPIDCNST END OF TABLE 33300019 BC 7,RELOOP NO,CHECK NEXT ENTRY 33400019 * 33500019 LR RPARC,RPAR REINITIALIZE DCB LIST POINTER 33600019 LA RWTGC,WAOFF(RWTG) REINITIALIZE WTG LIST POINTER 33700019 CHECK00 CLI 0(RWTGC),ZERO IS THIS ENTRY COMPLETE 33800019 BC 7,XCTLRTN IF NOT, TRANSFER CONTROL 33900019 * 34000019 LA RWTGC,WGOFF(RWTGC) GET NEXT WTG ENTRY 34100019 LA RPARC,PLOFF(RPARC) GET NEXT DCB ENTRY 34200019 BC 15,CHECK00 BRANCH TO CHECK NEXT ENTRY 34300019 *********************************************************************** 34400019 * 34500019 * SUBROUTINE TO LOAD MODULES 34600019 * 34700019 *********************************************************************** 34800019 LOADMOD EQU * @YM02503 34900002 MVC WTGTTR14(TTRLNGH,RWTG),TTROFF(RB) TTR TO DE @YM02503 34950002 MVC WTGID(IDLNGH,RWTG),IDOFF(RB) MOVE ID TO DE 35000019 SR RF,RF CLEAR RF 35100019 IC RF,LOFF(RB) LOAD DOUBLE WORD LENGTH 35200019 SLL RF,MULT8 MULTPY BY EIGHT FOR BYTE LENGTH 35300019 ST RF,TEMP0(RWTG) TEMP. STORE OF LENGTH 35400019 MVC TOTALOFF(TOTALL,RWTG),TEMP(RWTG) STORE 3 BYTE TOTAL LNGH 35500019 MVC TEXTOFF(TEXTL,RWTG),TEMP(RWTG) STORE 2 BYTE TEXT LENGTH 35600019 L RF,CVTPTR GET COMM VECTOR POINTER 35700019 L RF,CVTSVDCB GET SVC LIBS DCB ADR 35800019 * 35900019 MODESET KEYADDR=DXUKEY,WORKREG=15 GET USER KEY @YM02503 35930002 LOAD DE=(RWTG),DCB=(RF) LOAD ACCESS METHOD ROUTINE 36000019 * 36100019 MODESET EXTKEY=DATAMGT PUT SYSTEM IN OPEN KEY Y02967 36150002 ST RE,TEMP0(RWTG) TEMP STORE OF ROUTINE ADDRESS 36200019 MVC 0(IDLNGH,RUCB),0(RB) STORE ROUTINES ID IN DEB 36300019 LA RUCB,IDLNGH(RUCB) UPDATE SUBROUTINE POINTER 36400019 SR RD,RD CLEAR REG 36500019 IC RD,DEBNMSUB GET NO.OF SUBRTNS LOADED SO FAR 36600019 LA RD,ONE(RD) ONE MORE SUBROUTINE LOADED 36700019 STC RD,DEBNMSUB STORE NEW TOTAL OF SUBRTNS LOADED 36800019 BR RC RETURN TO CALLING ROUTINE 36900019 ********************************************************************** 37000019 * 37100019 * SUBROUTINE TO CONVERT THE 2 BYTE IDS IN DCBCNTRL TO ID 37200019 * ADDRESSES IN THE XCTL TABLE 37300019 * 37400019 ********************************************************************** 37500019 POINT2ID SR RC,RC CLEAR RC 37600019 LA RE,TABLE GET ADDRESS OF TTR TABLE 37700019 LA RB,IDTTRLL SIX BYTE FIELD 37800019 IC RC,DCBCNTRL+3 GET TTR NO. FROM DCBCNTRL+3 37900019 L RJ,DCBCNTRL SHIFT IDS 38000019 SRL RJ,BITS8 RIGHT BY 38100019 ST RJ,DCBCNTRL ONE BYTE 38200019 MR RB,RB CALCULATE WHERE TTR IS (6 XID) 38300019 LR RB,RC LOAD THE PRODUCT 38400019 AR RB,RE ADD THE BEGINNING ADDR OF THE TTR 38500019 BR RF TABLE, AND RETURN 38600019 * 38700019 ********************************************************************** 38800019 * 38900019 XCTLRTN MVC TEMP0(TXTOTL,RWTG),XCTLCON RESTORE TOTAL AND TEST LNGHS 39000019 MVC WTGID(IDLNGH,RWTG),IDOFF(RWTGC) STORE ID IN WTG TABLE 39100019 MVC WTGTTR14(TTRLNGH,RWTG),TTROFF(RWTGC) TTR TO WTG TABLE 39200002 * 39300019 LA RJ,DXCCW12 SET UP FOR XCTL 39400019 * 39500019 XCTL DE=(RWTG),SF=(E,(RJ)) TRANSFER CONTROL TO NXT EXECUTOR 39600019 * 39700019 ********************************************************************** 39800019 * 39900019 * 40000019 OCRABEND LA RF,ABENDCOD GET ABEND CODE 40100019 SLL RF,BITS12 SET UP REG FOR ABEND 40200019 ABEND (RF),DUMP ABEND WITH A SYSTEM COMPLETION CODE 40300019 * 40400019 MOVEDCB MVC 0(0,RJ),0(RDCB) MOVE D.M. DCB TO USER AREAY02967 40450002 ********************************************************************** 40500019 OPIDCNST DC C'0S' END OF TABLE ID 40600019 AMIDCNST DC C'7B' ID OF THIS EXECUTOR 40700019 OCRINP DC C'OCRINP' DEFAULT VOLUME PARAMETER 40800019 XCTLCON DC X'0004000400' TOTAL AND TEXT LENGTH OF OPEN MODS 40900019 ********************************************************************** 41000019 **** WTO LIST FORM--MOVED TO GOTTEN CORE, THE MESSAGE COMPLETED, 41100019 **** AND THEN EXECUTED 41200019 CNOP 0,8 FORCE TO A DOUBLE WORD BOUNDARY 41300019 WTOBEGIN EQU * WTO BEGINS ON A DOUBLE WORD 41400019 WTO 'IEC001E M , ',MF=L,ROUTCDE=7,DESC=3 @ZA00775 41500003 CNOP 0,8 FORCE TO A DOUBLE WORD BOUNDARY 41600019 WTOEND EQU * WTO ENDS ON A DOUBLE WORD BOUNDARY 41700019 *********************************************************************** 41800019 NOPCCW DC X'0300000000000001' NO-OP COMMAND ON DOUBLE WORD BNDARY 41900019 *********************************************************************** 42000019 WTOSIZE EQU WTOEND-WTOBEGIN LENGTH OF WTO LIST FORM 42100019 * +0 1 BYTE 42200019 * +1 2 BYTES MESSAGE LENGTH 42300019 * +3 1 BYTE MCSFLAGS 42400019 * +4 MAX OF 72 BYTES MESSAGE ID 42500019 * MESSAGE TEXT 42600019 * TOTAL = 24 BYTES 42700019 * +28 2 BYTES DESCRIPTOR CODE 42800019 * +30 2 BYTES ROUTING CODE 42900019 * +32 2 BYTES SVC 35 43000019 * 43100019 * NOTE UNIT ADDRESS AT +14 43200019 * VOLUME PARAM AT +18 43300019 ********************************************************************** 43400019 * 43500019 * BELOW ARE ROUTINES USED BY OCR PROCESSING 43600019 * 43700019 *********************************************************************** 43800019 * Y02967 43900002 * Y02967 43960002 ZAPSZAPS DC 8C'ZAPSZAPS' WORKAREA SPACE Y02967 44020002 * 44100019 TABLE DC C' ' FIRST ENTRY FILLER 44200019 * 44300019 GETLFID DC C'VA ' ID-TTR-L 1 44400019 GETLVUID DC C'VB ' ID-TTR-L 2 44500019 GETMFID DC C'VC ' ID-TTR-L 3 44600019 GETMVUID DC C'VD ' ID-TTR-L 4 44700019 SYNCHID DC C'VE ' ID-TTR-L 5 44800019 READID DC C'VF ' ID-TTR-L 6 44900019 CHECKID DC C'VG ' ID-TTR-L 7 45000019 CNTRLID DC C'VH ' ID-TTR-L 8 45100019 RDLNEID DC C'VI ' ID-TTR-L 9 45200019 DSPLYID DC C'VJ ' ID-TTR-L 10 45300019 RESCNID DC C'VK ' ID-TTR-L 11 45400019 EOBID DC C'CC ' ID-TTR-L 12 45500019 DC H'0' END OF TABLE 45600019 DC 2H'0' FILLER 45700019 DC C'019' OPEN SVC 45800019 DC AL1(117) START OF TABLE FROM BEGINNING OF 45900019 * MODULE 46000019 ********************************************************************** 46100019 *********************************************************************** 46200019 IEZDEB LIST=YES Y02967 46300002 ********************************************************************** 47400019 DCBD DSORG=PS,DEVD=OR @YM00635 47500002 ********************************************************************** 47600019 IECDSECS MAIN,WTG,PREFX,EXPAND=YES @YM02503 47700002 IKJTCB Y02967 47760002 IHARB Y02967 47820002 ********************************************************************** 47900019 CVT DSECT 48000019 CVT 48100019 END 48200019 END 90600019