TITLE 'IGG0196L - OPEN EXECUTOR - STAGE 2 - FINISH IOB''S FROM 191J' 00025021 IGG0196L CSECT 00025103 *MODULE NAME - IGG0196L Y02072 00025402 * 00025802 *DESCRIPTIVE NAME - BUILD IOBS Y02072 00026202 * 00026602 *COPYRIGHT - NONE Y02072 00026702 * 00026802 *CHANGE ACTIVITY - AS FOLLOWS: Y02072 00026902 * 00029802 * VS2 RELEASE 2 DELETIONS Y02072 00032902 *050430,050490,050550,050820-050940,078880,058600,059000,062800, Y02072 00035802 *063800 Y02072 00037802 *D51150-51364 YA3136 00038202 * 00038603 * VS2 RELEASE 3 DELETIONS 00042003 * @Z30TSCF 00044003 * RELEASE 21 DELETIONS * 00045403 *0000058400 M0466 00048803 *0000084800-085800 M0091 00052203 * 00055603 * STATUS CHANGE LEVEL 001 00059002 * 00079021 * THIS MODULE CREATED IN RELEASE 21 BY SPLIT OF IGG0191J 00099021 * 00119021 *FUNCTION/OPERATION: THIS ROUTINE CONTINUES CONSTRUCTING THE IOB'S 00139021 * 'GETMAINED' IN IGG0191J. 00159021 * 00179021 *ENTRY POINTS: ENTERED FROM IGG0191J BY USE OF XCTL MACRO. 00199021 * 00260021 *INPUT: SEE DESCRIPTION OF REGISTERS, DCB(USERS). 00280021 * 00300021 *OUTPUT: SEE DESCRIPTION OF REGISTERS, DCB(USERS), IOB(USERS). 00320021 * 00340021 *EXTERNAL ROUTINES : NONE 00360021 * 00380021 *EXITS-NORMAL: XCTL TO IGG01910 OR IGG01915 TO LOAD ROUTINES 00400021 * 00420021 *EXITS-ERROR: NONE 00440021 * 00450002 *MACROS : ACTION - MODESET, XCTL, XCTLTABL Y02072 00452002 * 00460021 *TABLES/WORKAREAS: DUPE WTG TABLE************************************** 00480021 * SEE DEVICETB DSECT. 00500021 * 00520021 *ATTRIBUTES: REENTRANT, REUSABLE, RUNS IN USER KEY UNLESS Y02072 00540002 * OTHERWISE SPECIFIED, SUPER STATE Y02072 00550002 * 00560021 * NOTES- THIS EXECUTOR DEALS WITH DIRECT ACCESS FOR IN/OUT - OUT/IN. 00580021 * 00600021 SPACE 1 00620021 * 00640021 * * 00660021 * 2841 OP CODES * 00680021 * * 00700021 WRCNKEDA EQU X'1D' WRITE COUNT KEY AND DATA 00720021 TIC EQU X'08' TIC OP CODE 00740021 WRTCK EQU X'80' 00760021 SRCHE EQU X'31' SEARCH OP CODE 00780021 READKEDA EQU X'8E' READ KEY AND DATA OP CODE 00840021 RDCOUNT EQU X'92' READ COUNT CMND CODE Y02072 00860002 SETSC EQU X'23' SET SECTOR COMMAND S20201 00885021 RDSC EQU X'22' READ SECTOR COMMAND S20201 00890021 * * 00900021 *********************************************************************** 00920021 * * 00940021 * CCW CONSTRUCTION EQUATES * 00960021 * * 00980021 DATASILI EQU X'A0' DATA CHAIN AND SILI FLAG 01000021 SILI EQU X'20' SILI FLAG 01020021 COMSILI EQU X'60' COMMAND AND SILI 01060021 COMCHAIN EQU X'40' COMMAND CHAIN BIT 01120021 DATACHAN EQU X'80' DATA CHAIN BIT 01140021 SKIPSILI EQU X'30' SKIP AND SILI 01160021 SECNDTIC EQU 0 OFFSET TO SECOND TIC CCW Y02072 01162002 ONE EQU 1 01180021 FIVE EQU 5 01220021 RDKDCCW EQU 8 OFFSET TO READ DATA CCW Y02072 01222002 ATE8 EQU 8 01260021 RDCNTCCW EQU 16 OFFSET TO READ COUNT CCW Y02072 01262002 CNTFLD2 EQU 32 OFFSET TO SECOND COUNT Y02072 01264002 * FIELD FOR SEARCH DIRECT Y02072 01266002 CC EQU X'40' COMMAND CHAIN S20201 01280021 *********************************************************************** 01300021 * * 01320021 * MISC EQUATES * 01340021 * * 01360021 FORMATV EQU X'40' FIXED RECORD FORMAT DM0I 01420021 FIRSTIOB EQU 1 01560021 NONCARN EQU X'20' NO DISCONNECT USED S20201 01612021 SDOPT EQU X'08' SEARCH DIRECT OPTION S20201 01614021 * BYTE S20201 01616021 SDTIC EQU X'40' SEARCH DIR TIC PREFIX S20201 01618021 RPSOFSET EQU 6 OFFSET IN JFCB FOR RPS BIT 01618221 RPSTIC EQU 8 TO BE ADDED TO IOB POINTER FOR 01618421 * RPS DEVICES BECAUSE OF X'23' 01618621 * OP CODE 01618821 NTRPSTIC EQU X'58' OFF SET TO NON-RPS TIC 01619021 UNRELFLG EQU X'02' 01619221 *********************************************************************** 01620021 * 01621021 * DISPLACEMENTS AS EQUATES 01622021 * 01623021 D0 EQU 0 DISPLACEMENT OF ZERO S20201 01624021 D1 EQU 1 DISPLACEMENT OF ONE S20201 01625021 D4 EQU 4 DISPLACEMENT OF FULLWORD S20201 01628021 D5 EQU 5 DISPLACEMENT OF FIVE S20201 01629021 D6 EQU 6 DISPLACEMENT OF SIX S20201 01630021 D7 EQU 7 DISPLACEMENT OF SEVEN S20201 01631021 D8 EQU 8 DISPLACEMENT OF DW S20201 01632021 D12 EQU 12 DISPLACEMENT OF THREE S20201 01633021 * WORDS S20201 01634021 D16 EQU 16 DISPLACEMENT OF 16 S20201 01636021 D23 EQU 23 DISPLACEMENT OF 23 S20201 01637021 D24 EQU 24 DISPLACEMENT OF SIX S20201 01638021 * WORDS S20201 01639021 D43 EQU 43 DISPLACEMENT OF CCHHR S20201 01642021 * IOB S20201 01643021 FLAGOFF EQU 4 CCW FLAG OFFSET S20201 01645021 CNTOFF EQU 7 CCW COUNT OFFSET S20201 01646021 *********************************************************************** 01660021 *********************************************************************** 01680021 * 01700021 * 01750021 * REGISTER CONVENTIONS USED THROUGHOUT ALL OPEN PASSES 01800021 * 01850021 * 01900021 *********************************************************************** 01920021 * 01940021 RE EQU 0 01960021 RF EQU 1 WORK REG ONE S20201 01963021 RDCB EQU 2 DCB REGISTER S20201 01966021 RBASE EQU 3 BASE REGISTER S20201 01969021 RCORE EQU 4 WORK AREA ADDR S20201 01972021 RWTG EQU 6 01980021 RPARC EQU 7 CURRENT PARAMETER S20201 01990021 * 02000021 RWTGC EQU 8 02020021 RUCB EQU 10 ADDRESS OF UCB S20201 02100021 RDEB EQU 11 ADDRESS OF DEB S20201 02140021 RB EQU 12 2 02180021 RC EQU 13 3 02200021 RD EQU 14 4 02220021 RJ EQU 15 5 02240021 * 02260021 * 02280021 *********************************************************************** 02300021 * 02320021 *********************************************************************** 02340021 * 02360021 * 02380021 USING SOP810,RBASE S20201 02410021 USING IHADCB,RDCB REG 2 IS DCB S20201 02420021 USING FORCORE,RCORE REG 4 IS WORK AREA ADDR S20201 02430021 BALR RBASE,RE REG 3 IS BASE RE=0 S20201 02440021 * 02450021 SOP810 EQU * S20201 02460021 * 02462002 B BEGIN Y02072 02464002 DC C'IGG0196L' MOD NAME Y02072 02466002 DC C'@Z30TSCF' LAST SHIP CODE @Z30TSCF 02468003 DC C'10/22/74' LAST DATE MODIFIED @Z30TSCF 02468403 BEGIN DS 0H 02468802 * 02470021 MODESET KEYADDR=DXUKEY,WORKREG=9 GET INTO USER KEY Y02072 02472002 L RDCB,D0(RPARC) GET DCB ADDR S20201 02480021 LA RDCB,D0(RDCB) CLEAR HI BYTE S20201 02490021 L RCORE,D4(RWTGC) GET WORK AREA ADDR S20201 02500021 * 02560021 SR RUCB,RUCB CLEAR REG S20201 03330021 IC RUCB,DCBNCP GET NO. OF CHPS S20201 03340021 LTR RUCB,RUCB BEEN SPECIFIED S20201 03350021 BNZ SOP817 BRANCH IF SPECIFIED S20201 03360021 LA RUCB,ONE FURNISH ONE IF NOT S20201 03370021 SOP817 EQU * S20201 03380021 SR RE,RE GET IOB LENGTH -- STORED BY 03460021 IC RE,DCBIOBL IGG0191J 03540021 SLL RE,3(0) IOB LNG IN BYTES 03620021 LA RDEB,ATE8 CONSTANT OF EIGHT 03700021 * THE ADDRESS OF THE FIRST IOB IS IN THE DCBIOBA FIELD. IT WAS 03780021 * STORED THERE AFTER GETMAIN IN IGG0191J. 03860021 L RB,DCBIOBA ADDR OF FIRST IOB 03940021 SOP829 EQU * 04020021 LR RF,RB SAVE IOB ADDR 04100021 * MUST ADD TO FIRST IOB ADDRESS TO POSITION AT FIRST TIC CCW -- 04180021 * THIS IS WHERE WE WERE IN IGG0191J -- 04260021 * X'60' FOR RPS DEVICES (3330, 2305) -- 04340021 * X'58' FOR NON RPS DEVICES -- 04420021 LA RB,NTRPSTIC(RB) GET TO FIRST TIC 04500021 TM JFCBMASK+RPSOFSET,NONCARN DEVICE NOT RPS? 04580021 BO NONRPS YES, NOT RPS DEVICE 04660021 LA RB,RPSTIC(RB) NO, RPS DEVICE USE X'60' 04740021 NONRPS EQU * 04820021 TM JFCBMASK+D6,SDOPT SEARCH DIRECT SPECIFIED S20201 05022021 BZ SOP833A BRANCH IF NO S20201 05025021 * SD S20201 05028021 SH RB,CON32 BACK UP TO FIRST TIC S20201 05031021 OI D0(RB),SDTIC INDICATE A SCH DIR C. P. S20201 05034021 AR RB,RDEB INCREMENT S20201 05037021 LA RC,RDKDCCW(,RB) POINT TO READ DATA CCW Y02072 05040002 ST RC,SECNDTIC(,RB) SET UP TIC ADDRESS Y02072 05046002 MVI SECNDTIC(RB),TIC MOVE IN TIC COMMAND Y02072 05052002 LA RC,CNTFLD2(,RB) PT TO SECOND COUNT FIELD Y02072 05052502 TM JFCBMASK+6,JFCNRPS IF RPS IS NOT SPECIFIED Y02072 05052902 BO NOTRPS THEN DON'T INCREMENT Y02072 05053302 AR RC,RDEB ELSE INCR BEYOND THE RD Y02072 05053702 * SECTOR CCW Y02072 05054102 NOTRPS EQU * Y02072 05054502 C RF,DCBIOBA IS THIS THE FIRST IOB Y02072 05054902 BNE NOTFIRST BRANCH IF NOT Y02072 05055302 ST RC,SECNDTIC(,RB) SET UP RD CNT DATA ADDR Y02072 05055702 MVI SECNDTIC(RB),RDCOUNT MOVE IN READ COUNT CMND Y02072 05056102 * 05056502 NOTFIRST EQU * Y02072 05056902 MVI D4(RB),COMSILI SILI AND CMND CHAIN S20201 05058021 MVI D7(RB),ATE8 BYTE CNT EQS EIGHT S20201 05064021 * SD S20201 05067021 MVC D8(ATE8,RB),D16(RB) MOVE UP RD DATA CCW S20201 05070021 * SD S20201 05073021 OI D12(RB),COMSILI SET COMMAND CHAINING S20201 05076021 * &SLI S20201 05079021 SR RC,RDEB PT TO FIRST COUNT FIELD Y02072 05089002 ST RC,D16(RB) PUT IN CCW ADDR S20201 05097021 * SD S20201 05100021 MVI RDCNTCCW(RB),RDCOUNT PUT IN MT RD CNT CMND Y02072 05103002 MVI D23(RB),ATE8 SET BYTE CNT TO EIGHT S20201 05109021 * SD S20201 05112021 AH RB,CON24 RESTORE POINTER S20201 05139021 SOP833A EQU * S20201 05142021 * SD S20201 05145021 * 05148021 * UPON RETURN CHECK FOR DISCONNECT FEATURE 05151021 * 05154021 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 05157021 * DISCONNECT S20201 05160021 BO SOP835 BRANCH IF YES S20201 05163021 BAL RD,SOP8RTA OTHERWISE GO BUILD RD S20201 05166021 * THETA S20201 05169021 AR RB,RDEB INCREMENT POINTER S20201 05172021 SOP835 EQU * S20201 05175021 * 05178021 * SET UP FOR WRITE CHP 05181021 * 05184021 TM JFCBMASK+D6,SDOPT FOR SEARCH DIRECT, IT IS S20201 05187021 BNO SOP835A IS NECESSARY TO HAVE TWO S20201 05190021 AR RB,RDEB DOUBLEWORDS BETWEEN THE S20201 05193021 AR RB,RDEB INPUT C.P. AND THE S20201 05196021 * OUTPUT S20201 05199021 * CHANNEL PROGRAM 05202021 SOP835A EQU * S20201 05205021 SR RB,RF GET WRITE CHP OFFSET S20201 05208021 MODESET EXTKEY=DATAMGT BACK TO DATA MANAG KEY Y02072 05208402 STC RB,DCBWCPO PUT IN DCB S20201 05211021 MODESET KEYADDR=DXUKEY,WORKREG=9 GET INTO USER KEY Y02072 05211402 AR RB,RF RESTORE PTR S20201 05214021 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O RCD S20201 05217021 * READY S20201 05220021 BO SOP836 BRANCH IF YES S20201 05223021 BAL RD,SOP8STA GO BUILD SET SECTOR CCW S20201 05226021 SOP836 EQU * S20201 05229021 LA RC,D43(RF) PT TO CCHHR FIELD S20201 05232021 BAL RD,SOP8SRTC GO BUILD SEARCH AND TIC S20201 05235021 * 05238021 * UPON RETURN INCREMENT PTR, OBTAIN WRITE CCW OFFSET 05241021 * 05244021 AR RB,RDEB INCREMENT PTR S20201 05247021 AR RB,RDEB S20201 05250021 * 05253021 * CONSTRUCT REMAINING WRITE CHANNEL PROGRAM 05256021 * 05259021 LR RC,RF GET IOB PTR S20201 05262021 AR RC,RE INCREMENT TO NEXT IOB S20201 05265021 * DM S20201 05268021 SR RC,RDEB BACK UP ONE DW S20201 05271021 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 05274021 * DISCONNECT S20201 05277021 BO SOP837 BRANCH IF YES S20201 05280021 SR RC,RDEB BACK UP POINTER ONE MORE S20201 05283021 * DW S20201 05286021 SOP837 EQU * S20201 05289021 MVI CNTOFF(RB),ATE8 SET BYTE CNT TO 8 S20201 05292021 OI FLAGOFF(RB),DATASILI DATA CHAIN AND SILI S20201 05295021 ST RC,D0(RB) PUT IN ADDR S20201 05298021 MVI D0(RB),WRCNKEDA WRITE CNT, KEY, DATA S20201 05301021 * CMND S20201 05304021 AR RB,RDEB INCREMENT POINTER S20201 05307021 SR RB,RF OBTAIN WRITE CCW OFF SET S20201 05310021 MODESET EXTKEY=DATAMGT BACK TO DATA MANAG KEY Y02072 05310402 STC RB,DCBOFFSW PUT IN DCB S20201 05313021 MODESET KEYADDR=DXUKEY,WORKREG=9 GET INTO USER KEY Y02072 05313402 AR RB,RF RESTORE PTR S20201 05316021 OI FLAGOFF(RB),SILI SET SILI FLAG S20201 05319021 AR RB,RDEB INCREMENT POINTER S20201 05322021 * 05328021 * CHECK FOR WRITE CHK SPECIFIED AND BUILD COMMAND 05331021 * 05334021 TM DCBOPTCD,WRTCK WRITE CHK USED S20201 05337021 BNO SOP874 IF NOT BRANCH S20201 05340021 SR RB,RDEB BACK UP PTR TO PRE CCW S20201 05343021 OI FLAGOFF(RB),CC CMND CHAIN S20201 05346021 AR RB,RDEB RESTORE PTR S20201 05349021 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O S20201 05352021 * DISCONNECT S20201 05355021 BO SOP851 BRANCH IF YES S20201 05358021 BAL RD,SOP8RTA GO BUILD READ SECTOR S20201 05361021 OI FLAGOFF(RB),CC COMMAND CHAIN CCW S20201 05364021 AR RB,RDEB INCR POINTER S20201 05367021 BAL RD,SOP8STA OTHERWISE GO BUILD SET S20201 05370021 * THET S20201 05373021 * 05376021 * MUST OBTAIN SEARCH ADDR FOR SEARCH SUBROUTINE 05379021 * 05382021 LR RC,RF GET ICB POINTER S20201 05385021 AR RC,RE POINT TO NEXT IOB S20201 05388021 SR RC,RDEB BACKUP A DW S20201 05391021 SR RC,RDEB SINCE RCD READY ONE MORE S20201 05394021 * DW S20201 05397021 SOP851 EQU * S20201 05400021 * 05403021 * GO BUILD SEARCH AND TIC COMMAND FOR WRT CHK 05406021 * 05409021 BAL RD,SOP8SRTC CONSTRUCT SEARCH AND TIC 05440021 MVI 16(RB),READKEDA READ KEY AND DATA CCW 05460021 MVI 20(RB),SKIPSILI SKIP AND SILI 05480021 LA RB,24(0,RB) POINT TO NEXT CCW 05500021 ******* 05520021 B SOP877 GO FINISH IO S20201 05526021 SOP874 EQU * S20201 05532021 * 05538021 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O RCD S20201 05544021 * READY S20201 05550021 BO SOP877 BRANCH IF YES S20201 05556021 BAL RD,SOP8RTA GO BUILD READ SECTOR S20201 05562021 AR RB,RDEB INCR PTR S20201 05568021 * 05574021 SOP877 EQU * S20201 05580021 MVC D5(D1,RB),DCBKEYL MOVE KEY LEN TO S20201 05586021 * CCHHRDDLL S20201 05592021 * 05600021 * HAVE ALL IOBS BEEN CONSTRUCTED 05620021 * 05640021 AR RB,RDEB INCR PTR FOR SRCH ARGU S20201 05650021 TM JFCBMASK+D6,NONCARN ANY DEVICES W/O RCD S20201 05655021 * READY S20201 05660021 BO SOP888 BRANCH IF YES S20201 05665021 AR RB,RDEB INCR PTR FOR ADD SRCH S20201 05670021 * ARGU S20201 05675021 SOP888 EQU * S20201 05680021 BCT RUCB,SOP829 IF ALL IOBS NOT FINISHED S20201 05685021 * BR S20201 05690021 L RC,DCBIOBA IF FINISHED GET PTR TO S20201 05695021 * FRST S20201 05700021 ST RC,D0(RF) LINK LAST TO FIRST S20201 05705021 * 05720021 L RB,DCBIOBA GET IOB ADDRESS 05740021 OI 0(RB),FIRSTIOB TURN ON FIRST IOB BIT 05760021 MODESET EXTKEY=DATAMGT BACK TO DATA MANAG KEY Y02072 05762002 TM DCBRECFM,FORMATV FIXED RECORD FORMAT DM0I 05780021 BC 8,SOP8ENDD BRANCH, IF FIXED FORMAT DM0I 05800021 TM DCBRECFM,DATACHAN UNDEFINED RECORD FORMAT DM0I 05820021 BO SOP8ENDD BRANCH IF UNDEFINED M0466 05840021 USING WTGENTRY,RWTGC Y02072 05850002 MVC WTGIDTTR,SOPSLDVT VAR, GET 1915 @Z30TSCF 05852003 B NEXT BACK TO LOADING DM0I 05880021 SOP8ENDD MVC WTGIDTTR,SOPSLDA GET SLDA @Z30TSCF 05890003 NEXT EQU * VARIABLE FORMAT, COME TO HEDM0I 05910021 LR RSTART,RBASE RESTORE BASE REG S20201 05920021 * 05940021 RELOOP LA RCWG,WGOFF(0,RCWG) INCREMENT CURR WTG ENTRY 05960021 LA RCPL,PLOFF(0,RCPL) INCR CURRENT DCB ENTRY POINTER 05980021 CLC 0(2,RCWG),AMIDCNST THIS RT NEEDED AGAIN 06000021 BCR EGHT,RSTART BACK TO OPEN AGAIN DM0I 06020021 CLC 0(2,RCWG),OPIDCNST END OF WTG TABLE 06040021 BC 7,RELOOP NO,CHECK NEXT ENTRY 06060021 LR RCPL,RPL 06080021 LA RCWG,WAOFF(0,RWG) REINITIALIZE WTG LIST PTR 06100021 ZCHEK CLI 0(RWTGC),X'00' IS THIS ENTRY COMPLETE 06120021 BC 7,TCTLRTN IF NOT TRANSFER CONTROL 06140021 LA RCWG,WGOFF(0,RCWG) GET NEXT ENTRY 06160021 LA RCPL,PLOFF(0,RCPL) 06180021 B ZCHEK ZERO CHECK DM0I 06200021 ** 06220021 TCTLRTN EQU * 06240021 USING WTG,RWTG 06290003 IECRES LOAD,PREFIX=WTGPREFX,BRANCH=DIRECT, @Z30TSCF*06340003 MODID=WTGENTRY @Z30TSCF 06390003 DROP RWTGC,RWTG @Z30TSCF 06392003 ** 06400021 RPL EQU 5 06520021 RWG EQU 6 06540021 RCPL EQU 7 06560021 RCWG EQU 8 06580021 RSTART EQU 11 06600021 WAOFF EQU 32 06620021 PLOFF EQU 4 OFFSET OF DCB ENTRIES DM0I 06640021 WGOFF EQU 8 OFFSET OF WTG ENTRIES 06660021 * 06670002 * MOD ID'S 06680002 * 06690002 OPIDCNST DC C'0S' ID DM0I 06700021 AMIDCNST DC C'6L' ID THIS MODULE 06720021 SOPSLDA DC C'10',VL3(IGG01910) FIXED, UNDEFINED @Z30TSCF 06730003 SOPSLDVT DC C'15',VL3(IGG01915) VAR RECS @Z30TSCF 06732003 * 06740021 * 07440021 *********************************************************************** 07460021 * 07480021 * THIS SECTION OF CODE BUILDS A SEARCH AND TIC CCW * 07500021 * 07520021 * 07540021 * RC POINTS TO SEARCH ADDRESS-- RB POINTS TO NEXT CCW ON ENTRY * 07560021 * RB IS NOT CHANGED IN ROUTINE.-- RD IS RETURN-- * 07580021 * * 07600021 *********************************************************************** 07620021 SOP8SRTC ST RC,0(0,RB) SEARCH ADDRESS 07640021 MVI 0(RB),SRCHE SEARCH OP CODE 07660021 MVI 7(RB),FIVE COUNT 07680021 MVI 4(RB),COMCHAIN COMMAND CHAIN 07700021 * 07720021 * TIC 07740021 * 07760021 LA RC,5(0,RC) SEARCH ADDRESS 07780021 ST RB,8(0,RB) TIC TO SEARCH 07800021 MVI 8(RB),TIC TIC OP CODE 07820021 BR RD EXIT DM0I 07840021 *********************************************************************** 07860021 * 07861021 * THIS RTN BUILDS SET THETA COMMANDS, RB POINTS TO CCW 07862021 * 07863021 SOP8STA EQU * S20201 07864021 L RC,DXCCW11 GET SET THETA ADDR S20201 07865021 ST RC,D0(RB) PUT IN CCW S20201 07866021 OI FLAGOFF(RB),CC TURN ON COMMAND CHAIN S20201 07867021 * FLAG S20201 07868021 MVI CNTOFF(RB),ONE SET COUNT TO ONE S20201 07869021 MVI D0(RB),SETSC PUT IN COMMAND S20201 07870021 AR RB,RDEB INCREMENT PTR S20201 07871021 BR RD RETURN S20201 07872021 *********************************************************************** 07880021 * 07881021 * THIS RTN BUILDS READ THETA COMMANDS, RB POINTS TO CCW 07882021 SOP8RTA EQU * S20201 07883021 SR RB,RDEB BACK UP CCW PTR S20201 07884021 OI FLAGOFF(RB),COMSILI SET CC AND SIL IN PREV S20201 07885021 * CCW S20201 07886021 AR RB,RDEB RESTORE PTR S20201 07887021 L RC,DXCCW11 GET RD THETA ADDR Y02072 07888002 ST RC,D0(RB) PUT IN CCW S20201 07889021 MVI CNTOFF(RB),ONE SET BYTE COUNT TO ONE S20201 07891021 MVI D0(RB),RDSC PUT IN COMMAND S20201 07892021 BR RD RETURN S20201 07893021 * 07894021 ******************************************************************* 07895021 *** 07896021 CON24 DC H'24' 24 BYTE DISPLACEMENT S20201 07897021 CON32 DC H'32' 32 BYTE DISPLACEMENT S20201 07898021 EGHT EQU 8 DM0I 08380021 PATCH DC 0H'0',50X'00' PATCH AREA Y02072 08390002 *** 08420021 *********************************************************************** 08440021 ***** 08460021 DCBD DSORG=PS 08600021 IECDSECS MAIN,WTG,PREFX,EXPAND=YES @Z30TSCF 08614003 ORG WTGIDTTR Y02072 08616002 WTGID DS CL2 NEXT MODS ID Y02072 08618002 EJECT 08618403 CVT DSECT @Z30TSCF 08618803 CVT @Z30TSCF 08619203 DCBKEYL EQU DCBKEYLE 08620021 * 08640021 * 08660021 * 08680021 * DEB 08700021 * 08720021 DEBDEF DSECT 08740021 DS 9F SPACE RESERVED DM0I 08760021 DEBSTRBB DS H START BIN NO. DM0I 08780021 DEBSTRCC DS CL4 START CYCL. DM0I 08800021 * 08820021 PARMDEF DSECT 08840021 PARMDEF1 DS 3F PARAMETER DM0I 08860021 * 08880021 * 08900021 SPACE 2 08920021 SPACE 3 08940021 DEVICETB DSECT 08960021 DEVCONST DC X'04000000' DEVICE CONSTANT DM0I 08980021 DEVCYLST DC X'00' LIST DM0I 09000021 DEVCYLEN DC X'CA' END CYLINDER 09020021 DEVTRKST DC X'00' START TRACK 09040021 DEVTRKEN DC X'09' TRACK END 09060021 DEVTKLEN DC FL2'3649' TRACK LENGTH - R0 09080021 DEVOVHI DC FL1'82' NORMAL OVERHEAD 09100021 DEVOVHL DC FL1'55' LAST RECORD OVERHEAD 09120021 DEVOVHK DC FL1'20' KEY ID OVERHEAD 09140021 DEVFLAG DC FL1'1' FLAG 09160021 DEVTOLR DC FL2'269' TOLERANCE 09180021 SPACE 3 09200021 END 09220021