FCH2 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...FETCH WORK AREA.' 00030037 MACRO 00060002 &NAME IHAFETWK &DSECT=YES 00090002 AIF ('&DSECT' EQ 'NO').NODSECT 00120002 WKAREA DSECT 00150002 .NODSECT ANOP 00180002 WKFETCH EQU * FETCH WORKAREA 00210002 * THE FOLLOWING SEGMENT DESCRIBES THE STRUCTURE OF THE 00240002 * WORK AREA USED BY FETCH. 00270002 * 00300002 FTIOB DS 8F IOB USED FOR EXCP REQUESTS 00330002 FTIOBSK DS 2F IOB SEEK ADDRESS 00360002 ********************* 00390002 XAREA DS 0F 00420002 XKEY DC CL4'FTWA' FETCH IDENTIFICATION KEY 00450002 XFLAGS DS 0XL4 FETCH CONTROL FLAGS Y02081 00480002 XFLAG1 DS X TRANSLATE/FIX CONTROL FLAGS 00510002 * ---------- XFLAG1 BIT DEFINITIONS 00540002 NEWIOFLG EQU X'80' FRESH I/O REQUEST ISSUED 00570002 ACTXTFLG EQU X'40' READ-TEXT CCW IS ACTIVE IN CURRENT CP 00600002 SYNRDFLG EQU X'20' SYNC READ ISSUED (NO PCI) 00630002 USDEBFLG EQU X'10' USERS DEB COPIED INTO GOTTON CORE 00660002 TXTREAD EQU X'08' SIO APPENDAGE TXT READ INDICATOR YM2867 00690002 VAMDEV EQU X'04' ** UCB INDICATES A VIRTUAL Y02081 00720002 * IF ON ** DEVICE IS BEING FETCHED Y02081 00750002 * ** FROM (VAM DATA SET) Y02081 00780002 RPSDEV EQU X'02' ** DEVICE BEING FETCHED FROM Y02081 00810002 * IF ON ** SUPPORTS ROTATIONAL Y02081 00840002 * ** POSITION SENSING (RPS) Y02081 00870002 RELERR EQU X'01' ** AN INVALID ADCON ADDRESS Y02081 00900002 * IF ON ** WAS ENCOUNTERED IN THE Y02081 00930002 * ** DIE RELOCATE ROUTINE Y02081 00960002 * -------------- 00990002 XFLAG2 DS X CONTROL FLAGS - BYTE 2 Y02081 01020002 * ---------- XFLAG2 BIT DEFINITIONS Y02081 01050002 BADREC EQU X'80' ** AN INVALID RECORD Y02081 01080002 * IF ON ** TYPE WAS ENCOUNTERED Y02081 01110002 * ** IN THE DIE ROUTINE Y02081 01140002 TXTFIX EQU X'40' ** THE DIE ROUTINE FOUND THE Y02081 01170002 * IF ON ** NEXT TEXT RECORD TO BE Y02081 01200002 * ** OUTSIDE THE PGFIX'D AREA Y02081 01230002 ONETXT EQU X'20' ** THE MODULE BEING READ Y02081 01260002 * IF ON ** CONTAINS ONE TEXT RECORD Y02081 01290002 * ** WITH NO RLD RECORDS Y02081 01320002 PRGFREE EQU X'10' ** PURGE SUBROUTINE Y02081 01340002 * IF ON ** HAS ALREADY Y02081 01340402 * ** FREED RESOURCES. Y02081 01342002 ACRRELOC EQU X'08' ** WHEN WE BRANCH TO PCI APG Y02081 01344002 * IF ON ** AFTER COMMAND RETRY Y02081 01346002 * ** RELOCATION IS REQD Y02081 01348002 CPLOOP EQU X'04' ** CHANNEL PROGRAM LOOP HAS Y02081 01348402 * IF ON ** BEEN DETECTED BY POST Y02081 01348802 * ** STATUS NORMAL EXIT RTN Y02018 01349202 CTLERR EQU X'02' ** AN INVALID ADDRESS WAS Y02081 01349602 * IF ON ** FOUND IN A CONTROL RECORD Y02081 01349702 * ** BY THE DIE ROUTINE Y02018 01349802 IOSBFREE EQU X'01' ** IOSB/SRB HAS BEEN YM8279 01349902 * IF ON ** FREEMAINED IN TERMNATION YM8279 01359902 * -------------- Y02081 01370002 DS 2X - RESERVED - Y02081 01380002 ********************* 01410002 FTSKBUF1 DS 2F Y02081 01440002 FTSKBUF2 DS 2F Y02081 01470002 FTSKBUF3 DS 2F Y02081 01500002 FTSKBUF4 DS 2F Y02081 01530002 FTCPSRCH DS 4D SEARCH AND TIC CCWS Y02081 01560002 FTRBUF1 DS 32D RLD BUFFER 1 Y02081 01590002 FTCP1 DS 6D CHAN PROG 1 Y02081 01620002 FTRBUF2 DS 32D RLD BUFFER 2 Y02081 01650002 FTCP2 DS 6D CHAN PROG 2 Y02081 01680002 FTRBUF3 DS 32D RLD BUFFER 3 Y02081 01710002 FTCP3 DS 6D CHAN PROG 3 Y02081 01740002 FTECB DS 1F 01770002 FTFXECB DS 1F ECB FOR PGFIX REQUESTS Y02081 01800002 FTTBLPTR DS 1F POINTER TO CURRENT FTTBL ENTRY Y02081 01830002 FTTBL DS 9F BUFFER TABLE 01860002 FTTBL2 EQU FTTBL+12 2ND ENTRY IN BUFFER TABLE Y02081 01870002 FTTBL3 EQU FTTBL+24 3RD ENTRY IN BUFFER TABLE Y02081 01880002 FTREGSV DS 16F REGISTER SAVE AREA 01890002 FTRPTR DS 1F ADDR OF R POINTER 01920002 FTFLAGS DS 0FL8 FETCH CONTROL FLAGS Y02081 01950002 FTFLG1 DS XL1 FLAG BYTE 1 Y02081 01980002 FTFLG2 DS XL1 FLAG BYTE 2 Y02081 02010002 FTFLG3 DS XL1 FLAG BYTE 3 Y02081 02040002 FTFLG4 DS XL1 FLAG BYTE 4 Y02081 02070002 FTRESTRT DS 1F ADDR OF PREVIOUS RBUF USED Y02081 02100002 * IN THE DIE ROUTINE TO LOCATE Y02081 02130002 * LAST TIC-TO ADDR TO SET UP Y02081 02160002 * THE TIC IN THE SRCHID CP FOR Y02081 02190002 * RESTART Y02081 02220002 FTLASTBF DS 1F PTR TO PRIOR BUFR TABLE ENTRY 02250002 * 02280002 * EXTENSION TO FETCH WORK AREA 02310002 * 02340002 XSOMAD DS F LOWER CORE LIMIT FOR LOAD MODULE 02370002 XEOMAD DS F UPPER CORE LIMIT FOR LOAD MODULE 02400002 XLOFIX DS F LOWER BOUND FOR TEXT AREA FIX REQ 02430002 XHIFIX DS F UPPER BOUND FOR TEXT AREA FIX REQ 02460002 XNEXTLOC DS F LOCATION OF NEXT TEXT BYTE READ 02490002 XTRANTAB DS 0XL8 CCW TRANSLATION DATA -- 02520002 XCCWAD DS F POINTER TO CCW REQ TRANSLATION 02550002 XTXTAD DS F VIRTUAL ADDRESS IN THE CCW 02580002 XIDALP1 DS AL4(XALAREA1) POINTER TO IDAL BUILD AREA 02610002 XIDALP2 DS AL4(XALAREA2) POINTER TO ALTERNATE IDAL AREA 02640002 XALAREA1 DS 10F IDAL AREA 02670002 XALAREA2 DS 10F IDAL AREA 02700002 XGMLIST DS 4F GETMAIN LIST AREA 02730002 XORGDCB DS 1F ORIGINAL LOAD DCB ADDRESS 02760002 XIOSBAD DS 1F ADDR OF IOSB/SRB TO BE FREED 02790002 XDEBLEN DS 1F SIZE OF MS OBTAINED FOR DEB(INC SP) 02820002 XRETSAV DS 1F REGISTER 14 SAVE AREA Y02081 02850002 XREGSV3 DS 1F REGISTER 3 SAVE AREA YM1070 02880002 XREGSV6 DS 1F REGISTER 6 SAVE AREA YM1070 02910002 XSECTAD DS 1X BUFFER FOR READ/SET Y02081 02940002 * SECTOR COMMANDS WHEN Y02081 02970002 * WHEN FETCHING FROM AN RPS Y02081 03000002 * DEVICE Y02081 03030002 DS 3X RESERVED Y02081 03060002 XFTCBAD DS 1F ADDRESS OF TCB FETCH IS Y02081 03090002 * RUNNING UNDER (SAVED FOR Y02081 03120002 * USE BY PURGE SUBROUTINE) Y02081 03150002 *----PSEUDO DCB DEFINITION (USED WITH THE COPIED DEB). 03180002 XDCBDEBO EQU 44 OFFSET OF DEB ADDR IN DCB Y02081 03190002 ORG *-XDCBDEBO ORG BACK OVER UNUSED FIELDS 03210002 XDCBCOPY EQU * START OF DCB 03240002 ORG *+XDCBDEBO RESTORE LOC COUNTER 03270002 XDCBDEBA DS 1F PSEUDO 'DCBDEBAD' FIELD 03300002 *----END OF PSEUDO DCB DEFINITION. 03330002 XESTAEPT DS 1F ADDRESS SAVED IOSB/SDWA Y02081 03340002 XESTLIST DS 1F ESTAE MACRO PARAMETER LIST Y02081 03350002 XIOBSEK1 DS XL5 IOBSEEK SAVE 1 Y02081 03352002 XIOBSEK2 DS XL5 IOBSEEK SAVE 2 Y02081 03354002 DS 2X RESERVED Y02081 03356002 *---PSUEDO SVRB FETCH W.A. POINTER USED TO SET UP CORRECTLY IN ESTAE 03356402 * WHEN WE HAVE AN OVERLAY SUPERVISOR REQUEST. THE FOLLOWING WORD 03356802 * POINTS TO THE FETCH WORK AREA AND IS SET UP AT ESTAE MACRO TIME 03357202 * FOR AN OVERLAY SUPERVISOR REQUEST. THE ORG BEHIND IT MAKES IT 03357602 * LOOK LIKE ITS IN THE SVRB BY ORGING TO THE SAME OFFSET THE 03357702 * WORK AREA POINTER IS STORED AT IN THE SVRB BY CONTENTS 03357802 * SUPERVISOR. 03357902 XESTAWKA DS 1F ESTAE PTR TO FETCH W.A. Y02081 03358002 XESTAORG EQU XESTAWKA-X'74' OV SUPVR ESTAE PTR Y02081 03358402 SPACE 03360002 *---------------MISC. EQUATES 03390002 IDALNTRY EQU 4 SIZE OF EACH IDAL ENTRY 03420002 FIXLOENT EQU 0 OFFSET TO LOW ENTRY PORTION 03450002 FIXHIENT EQU 4 OPPSET TO HIGH ENTRY PORTION 03480002 FIXENTSZ EQU 8 SIZE OF SIX-LIST ENTRY 03510002 ECBERRIN EQU FTFXECB+3 ECB ERROR INDICATOR 03520037 ********************* PROGRAM MANAGER WORK AREA 03540002 PGMMGR EQU X'0594' *TEMP* 03570002 ORG WKFETCH+PGMMGR OVERLAY PGM MGR WORK AREA AT *TEMP* 03600002 * CORRECT OFFSET *TEMP* 03630002 WKPGMMGR EQU * PROGRAM MANAGER WORK AREA 03660002 WKCDADDR DS A ADDRESS OF CDE 03690002 WKIOADDR DS A ADDRESS OF AREA GETMAINED. FETCH 03720002 * WILL DO I/O INTO THIS AREA 03750002 WKFLAG DS C TASKLIB SEARCH INDICATOR 03780002 FLAG EQU WKFLAG USED FOR COMPATIBILITY 03810002 WKFLG1 DS C FLAGS FIELDS 03840002 WKAUTH EQU X'80' FETCH PLACES THE LIBRARY 03870002 * AUTHORIZATION FORM THE DEB HERE 03900002 WKSYSREQ EQU X'40' USER IS SYSTEM REQUEST 03930002 WKFLGS2 DS 2C RESERVED 03960002 WKREGIS DS 4F USED TO SAVE REGISTERS ACROSS BLDL 03990002 WKTCBSE DS A ADDRESS OF TCB CONTAINING LAST DCB 04020002 WKDCBSE DS A ADDRESS OF LAST DCB SEARCH ARGUMENT 04050002 ********************* BLDL ENTRY AND MASK 04080002 WKBLDE EQU * BLDL LIST 04110002 WKPREFX DS 4C MASK FOR BLDL REQUEST 04140002 WKNAME DS 8C THIS IS THE BASE 04170002 WKTTRN DS 4C AREA OF A 04200002 WKZBYTE DS 1C FORMAT 2 PDS 04230002 WKCBYTE DS 1C DIRECTORY ENTRY WITH 04260002 WKTTESD DS 8C 2 BYTE MODIFIED 04290002 WKATTR DS 2C BY BLDL 04320002 WKLNTH DS 5C * 04350002 WKENTPT DS 3C * 04380002 WKTXORG DS 3C * 04410002 WKAPFSSI DS CL6 APF AND SSI INFO IF PRESENT 04440002 ORG WKAPFSSI OVERLAY FOR ALISA, NO SCATTER 04470002 WKENTBK DS 3C USED IF THE MODULE IS AN ALIAS 04500002 WKNAMBK DS 8C AND HAS RENT OR REUS ATTRIBUTES 04530002 * AND NO SCATTER 04560002 DS CL6 APF AND SSI INFO IF PRESENT 04590002 ORG WKAPFSSI * OVERLAY FOR WKENTBK 04620002 WKSCATR DS 8C USED FOR MODULES 04650002 WKSCAPSI DS CL6 APF AND SSI IF SCATTER ONLY 04680002 ORG WKSCAPSI OVERLAY FOR SCATTER ALIAS 04710002 WKNAMSC DS 8C HAVE RENT OR REUS ATTRIBUTES 04740002 WKENTSC DS 3C WHICH ARE SCATTER LOADED 04770002 DS CL6 APF AND SSI INFO IF PRESENT 04800002 WKMAINEP DS 4C USED TO MAKE DSECT CONSISTANT 04830002 WKMAINAM DS 8C REGARDLESS OF ATTRIBUTES 04860002 WKEND EQU * END OF BLDL FETCH WORK AREA 04890002 WKSIZE EQU WKEND-WKFETCH SIZE OF WORK AREA 04920002 MEND 04950002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...EQUATES' 04980002 IEWFETCH CSECT 05010002 ENTRY IEWFBOSV 05040002 ENTRY IEWMSEPT 05070002 ENTRY IEWFTPRG Y02081 05100002 ENTRY IEWFTXCK Y02081 05130002 SPACE 05160002 *------- ID FLAGS FOR MODULE RECORDS. 05190002 CTLFLG EQU X'01' CONTROL RECORD 05220002 RLDFLG EQU X'02' RLD RECORD 05250002 ENDFLG EQU X'04' END OF MODULE OR END OF SEGMENT 05280002 CTLCCW EQU 8 OFFSET OF RD-TXT CCW IN CONTROL REC 05310002 RLDATA EQU 16 OFFSET TO START OF RLD DATA Y02081 05312002 * ON AN RLD RECORD Y02081 05314002 RLDLEN EQU 6 OFFSET TO RLD DATA BYTE COUNT Y02081 05316002 * FIELD ON AN RLD RECORD Y02081 05318002 RELREQ EQU X'E0' MASK FOR BIT PATTERN IN AN Y02081 05318402 * RLD DATA ITEM WHICH MUST BE Y02081 05318802 * ALL ZEROES TO INDICATE THAT Y02081 05319202 * RELOCATION IS REQUIRED Y02081 05319602 ADCLEN EQU X'0F' IMMEDIATE BYTE USED FOR Y02081 05319702 * ISOLATING ADCON LENGTH Y02081 05319802 RELNEG EQU X'02' NEGATIVE RELOCATION INDICATOR Y02081 05319902 SAMERP EQU X'01' BIT INDICATING NEXT RLD ITEM Y02081 05323202 * HAS SAME R&P POINTERS AS THE Y02081 05325202 * CURRENT ITEM Y02081 05325602 TSTBITS EQU X'F0' MASK FOR UNUSED BITS IN 1ST Y02081 05326702 * BYTE OF CTL/RLD RECORDS (MUST Y02081 05330002 * BE ZERO -- TESTED TO DETECT Y02081 05332002 * INVALID RECORD TYPES) Y02081 05334002 * 05340037 *------- FETCH RETURN CODES. 05370002 RCNORMAL EQU X'00' SUCCESSFUL LOAD 05400002 RCPRGCHK EQU X'0B' PROG CHECK OR LOOP IN FETCH Y02081 05430002 RCNOCORE EQU X'0C' NOT ENOUGH STOR SPACE FOR MOD Y02081 05460002 RCBADREC EQU X'0D' INVALID RECORD TYPE ENCOUNTERED 05490002 RCBADADR EQU X'0E' INVALID ADDRESS ENCOUNTERED 05520002 RCIOERR EQU X'0F' PERMANENT I/O ERROR 05550002 * 05580037 *------- DCB OFFSETS 05610002 DCBDEBAD EQU 44 OFFSET TO DEB ADDRESS FIELD IN DCB 05640002 DCBFIX EQU 4 SIZE OF FIX REQMNT FOR DCB 05670002 AVTPTR EQU 28 AVT POINTERS IN DEB Y02081 05680002 * 05700037 *------- VOID (VECTOR OF IOS DRIVERS) OFFSETS Y02081 05710002 VOIDFTPG EQU 84 OFFSET TO VOID ENTRY FOR Y02081 05720002 * FETCH PURGE RTN ADDR Y02081 05722002 VOIDFTXK EQU 92 OFFSET TO VOID ENTRY FOR Y02081 05724002 * FETCH EXTENT CHECK RTN ADDR Y02081 05726002 * 05728037 *------- STRING LENGTH OF FETCH CHANL PGMS(INTERNAL CCWS ONLY). 05730002 CPSRCHCT EQU 4 SEARCH CCW COUNT 05760002 CP1CT EQU 5 FIRST CP CCW COUNT 05790002 CP2CT EQU 5 SECOND CP CCW COUNT 05820002 CP3CT EQU 5 THIRD CP CCW COUNT 05850002 * 05880037 *------- EQUATES FOR CCW HANDLING. 05910002 CCWOPR EQU 0 COMMAND FIELD 05940002 CCWADR EQU 1 ADDRESS FIELD Y02081 05970002 CCWFLG EQU 4 CCW FLAGS 06000002 CCWLEN EQU 6 COUNT FIELD 06030002 CCWSZ EQU 8 SIZE OF CCW 06060002 READOP EQU X'06' READ-DATA COMMAND CODE 06090002 IDALFLAG EQU X'04' IDAL FLAG (BIT 37 OF CCW) 06120002 PCI EQU X'08' PCI BIT FOR CCW FLAGS YM1082 06150002 CMCH EQU X'40' CMD CHAIN BIT FOR CCW FLAGS YM1082 06160002 SILI EQU X'20' SILI BIT FOR CCW FLAGS YM1082 06170002 SRCHTIC EQU 24 OFFSET TO TIC CCW IN SRCH CP Y02081 06180002 CPRDRLD EQU 16 OFFSET TO READ-RLD CCW IN REG CP 06210002 TICOFFST EQU 32 OFFSET TO TIC FROM CCW START YM2867 06240002 RDCT1AD EQU 9 OFFSET TO ADDRESS FIELD OF Y02081 06250002 * FIRST READ COUNT CCW Y02081 06260002 RDCT1FL EQU 12 OFFSET TO FLAG FIELD OF Y02081 06260402 * FIRST READ COUNT CCW Y02081 06260802 RDCT2AD EQU 25 OFFSET TO ADDRESS FIELD OF Y02081 06262002 * SECOND READ COUNT CCW Y02081 06264002 RDCT2FL EQU 28 OFFSET TO FLAG FIELD OF Y02081 06264102 * SECOND READ COUNT CCW Y02081 06264202 RDCNT2 EQU 24 OFFSET TO 2ND READ COUNT CCW Y02081 06264402 RDRLDAD EQU 17 OFFSET TO ADDRESS FIELD OF Y02081 06266002 * READ RLD/CTL RECORD CCW Y02081 06268002 RDRLDFL EQU 20 OFFSET TO FLAG FIELD OF Y02081 06268102 * READ RLD/CTL RECORD CCW Y02081 06268202 RDSECAD EQU 41 OFFSET TO ADDRESS FIELD OF Y02081 06268402 * READ SECTOR CCW Y02081 06268802 SCHTICAD EQU 25 OFFSET TO ADDRESS FIELD OF Y02081 06269202 * 2ND TIC IN SEARCH CH PGM Y02081 06269602 SCHIDAD EQU 9 OFFSET TO ADDRESS FIELD OF Y02081 06269702 * SEARCH ID CCW Y02081 06269802 TIC EQU X'08' TIC-CCW COMMAND CODE YM2867 06270002 RLDTICOF EQU 16 OFFSET-CTL/RLD TO NOP/TIC YM2867 06300002 NOP EQU X'03' NOP-CCW COMMAND CODE YM2867 06330002 * 06370037 *------- EQUATES FOR VAM CHANNEL PROGRAM CCW HANDLING. 06372002 VAMRDRLD EQU 8 OFFSET TO RD RLD IN VAM C.P. Y02081 06380002 VAMNOPTC EQU 16 OFFSET TO NOP/TIC IN VAM C.P. Y02081 06384002 VAMNOPAD EQU 17 ADDRESS IN NOP/TIC CCW Y02081 06388002 * IN VAM C.P. Y02081 06388102 VAMFLAGS EQU 4 OFFSET TO CCW FLAGS Y02081 06388402 * IN VAM C.P. Y02081 06391402 VAMTXTAD EQU 1 OFFSET TO ADDRESS IN TXT Y02081 06391502 * RECORD Y02081 06391902 VAMCNT EQU 6 OFFSET TO TXT COUNT Y02081 06392902 * IN VAM C.P. Y02081 06393302 RDOPMULT EQU X'86' OP CODE FOR MULTI-TRACK READ YM5962 06393702 CPADDRES EQU 16 CHANNEL PGM ADDRESS IN IOB Y02081 06394302 DCBADDRS EQU 20 DCB ADDRESS IN IOB Y02081 06395702 ECBADDRS EQU 4 ECB ADDRESS IN ECB Y02081 06397102 SRCHADDR EQU 1 ADDR PORTION OF SEARCH CCW Y02081 06398502 SRCHCCW EQU 9 ADDR PORTION OF 1ST TIC CCW Y02081 06399902 TICTOADD EQU 17 ADDR PORTION OF 2ND TIC CCW Y02081 06409902 RLDBUFAD EQU 9 ADDR PORTION OF READ RLD CCW Y02081 06413202 * 06416737 *------- MISC DEFINITIONS 06420002 ALL EQU X'FF' MASK FOR ALL BITS IN A BYTE 06450002 DEBCORE EQU 254 SUBPOOL NUMBER FOR DEB CORE 06480002 ADDR EQU B'0111' MASK FOR ADDRESS PART OF REGISTER 06510002 HIBYT EQU B'1000' REGISTER HIGH-ORDER BYTE MASK Y02081 06540037 KEYZERO EQU X'0F' MASK FOR DEB KEY ZERO 06570002 TBLBUFAD EQU 8 OFFSET OF BUFR PTR IN TBL ENTRY 06600002 TBLCPAD EQU 4 OFFSET OF CH PGM PTR IN TBL ENTRY 06610002 MBB EQU 3 EXTENT/BIN PART OF DISK ADDRESS 06630002 CCHHR EQU 3 CYL/HEAD/REC PART OF DISK ADDRESS 06660002 SKSIZ EQU 5 LNGTH OF A SEEK FIELD (CCHHR) Y02081 06662002 ZERO EQU 0 ZERO OFFSET Y02081 06670002 R14 EQU 56 OFFSET TO REG 14 Y02081 06680002 R1OFFSET EQU 4 OFFSET TO R1 IN SAVEAREA Y02018 06682002 R2OFFSET EQU 8 OFFSET TO R2 IN SAVEAREA Y02018 06684002 CVTADDR EQU 16 PTR TO CVT ADDR. Y02081 06686002 CURRTCB EQU 4 CURRENT TCB PTR. Y02081 06688002 EXCP EQU 0 SVC NUMBER FOR EXCP 06688402 XLISTADR EQU 16 OFFSET TO EXTENT LIST ADDR IN CDE 06688802 REC0 EQU 0 INIT VALUE OF R IN CCHHR A34466 06689202 TWENTY EQU 20 OFFSET OF DCB ADDR IN IOB 7157 06689602 SIXTYEG EQU X'68' IMMEDIATE OPERAND 7157 06689702 JOBLIBOF EQU 40 JOBLIB DCB PTR IN TCB A34037 06689802 MRZEUSBT EQU X'01' USED IN DEB FILE MASK M6068 06699902 * TO SHOW MER/ZEUS DEVICE M6068 06709902 RETRY EQU 4 ESTAE-INDICATE RETRY Y02081 06713202 FLAGBYTE EQU 0 1ST BYTE(FLAGS) IN SEGTAB YM4648 06715602 LISTSIZ EQU 16 LENGTH OF XGMLIST YM3247 06716002 LASTCTL EQU X'40' LAST CTL RECORD IN BUFFER Y02081 06716402 LASTREC EQU X'80' LAST RECORD HAS BEEN READ Y02081 06716502 RLDEND EQU X'0F' LAST RLD HAS BEEN READ Y02081 06716602 FTIOBFL EQU X'02' PCI FETCH FLAG IN IOB Y02081 06716702 SPINBYTE EQU 13 OFFSET TO BYTE ON WHICH BIT Y02081 06729202 * SPIN IS PERFORMED IN RLD BUF Y02081 06739202 CNTWT EQU X'80' COUNT BUF PSEUDO WAIT 06741202 IOERRBT EQU X'20' BIT IN I/O ECB TESTED AFTER Y02081 06741602 * EXCP -- 0=ERROR, 1=NORMAL Y02081 06742002 SGTBNTLS EQU 4 OFFSET IN SEGTAB FOR NOTELIST Y02081 06742102 * ADDRESS Y02081 06746302 SGTBTST EQU X'40' SEGTAB TEST INDICATOR BIT Y02081 06748302 SVRBWKA EQU X'74' OFFSET TO FETCH WORKAREA Y02081 06750302 * POINTER IN PROG MGR SVRB Y02081 06750402 POSTIOSB EQU X'7F' IOSB NORMAL COMP. @ZA10583 YM8292 06750537 DEBFREE EQU X'EF' TURN OFF DEB GM FLAG ZA0135 06754702 PGMASK EQU B'0001' PGFIX RETURN MASK @ZA07064 06756737 EJECT 06759037 *------- GENERAL REGISTER EQUATES 06763202 WKREGF EQU 0 WORK REGISTER 06767402 WKREGA EQU 1 WORK REGISTER 06780002 WKREGB EQU 2 WORK REGISTER 06840002 WKREGD EQU 4 WORK REGISTER 06870002 WKREGC EQU 5 WORK REGISTER Y02081 06900002 DCBREG EQU 7 DCB PTR PASSED TO FETCH BY CALLER 06960002 LISTREG EQU 8 NOTELIST PTR PASSED BY OVLY SUP 06990002 SEGREG EQU 9 SEGMENT NO. PASSED BY OVLY SUP 07020002 FTBASETR EQU 9 WORK REGISTER 07050002 IDREG EQU 10 SUBPOOL ID FOR GETMAIN 07080002 FTBASE1 EQU 11 BASE REGISTER FOR MAINLINE 07110002 WKREGE EQU 12 WORK REGISTER 07140002 FTBASE2 EQU 13 BASE REGISTER FOR WORK AREA 07170002 LINKREG EQU 14 RETURN ADDR FOR SUBRTN LINKAGE 07200002 CODEREG EQU 15 ENTRY POINT ADDR REGISTER 07230002 * 07290002 * THE FOLLOWING REGISTERS ARE USED BY FETCH APPENDAGE ROUTINES 07320002 * 07350002 WKRG0 EQU 0 WORK REGISTER 07380002 WKRG1 EQU 1 WORK REGISTER 07410002 IOSREG EQU 1 POINTER TO IOSB Y02081 07440002 IOBREG EQU 2 IOB PTR ON ENTRY TO APPENDAGES 07470002 WKRG2 EQU 2 WORK REGISTER Y02081 07500002 DEBREG EQU 3 POINTER TO DEB 07530002 WKRG3 EQU 3 WORK REGISTER 07560002 WKRG4 EQU 4 WORK REGISTER 07590002 WKRG5 EQU 5 WORK REGISTER 07620002 WKBASE EQU 6 WORKAREA BASE IN DIE Y02081 07650002 WKRG6 EQU 6 WORK REGISTER Y02081 07680002 UCBREG EQU 7 POINTER TO UCB 07710002 WKRG7 EQU 7 WORK REGISTER Y02081 07740002 WKRG8 EQU 8 WORK REGISTER Y02081 07770002 WKRG9 EQU 9 WORK REGISTER 07800002 WKRG10 EQU 10 WORK REGISTER 07830002 WKRG11 EQU 11 WORK REGISTER 07860002 WKRG12 EQU 12 WORK REGISTER 07890002 WKRG13 EQU 13 WORK REGISTER 07920002 WKRG14 EQU 14 WORK REGISTER 07950002 RETURNRG EQU 14 RETURN ADDR TO IOS FROM APPENDAGES 07980002 WKRG15 EQU 15 WORK REGISTER 08010002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...PROLOGUE' 09420002 *********************************************************************** 09430002 * MODULE SPECIFICATIONS * 09440002 *********************************************************************** 09440402 * * 09440802 * MODULE-NAME = IEWFETCH * 09442002 * * 09444002 * DESCRIPTIVE-NAME = PROGRAM FETCH * 09446002 * * 09496002 * STATUS = CHANGE-LEVEL 00 * 09646002 * * 09656002 * FUNCTION = THIS MODULE LOADS AND RELOCATES EXECUTABLE * 09666002 * PROGRAM MODULES AND OVERLAY SEGMENTS INTO VIRTUAL * 09676002 * STORAGE FOR: * 09686002 * 1) PROGRAM MANAGER * 09780002 * 2) OVERLAY SUPERVISOR * 09810002 * * 09860002 * NOTES = * 09910002 * * 09920002 * DEPENDENCIES = N/A * 09922002 * * 09924002 * RESTRICTIONS = N/A * 09926002 * * 09928002 * REGISTER-CONVENTIONS = SEE REGISTER EQUATES ABOVE * 09928402 * * 09928802 * PATCH-LABEL = THIS MODULE CONTAINS THE FOLLOWING * 09929202 * TWO MAINTENANCE AREAS: * 09929602 * 1) FETCHPA1 FOR USE IN MAINLINE CODE * 09929702 * 2) FETCHPA2 FOR APPENDAGE ROUTINES * 09929802 * * 09929902 * MODULE-TYPE = PROCEDURE * 09939902 * * 09949902 * PROCESSOR = SYSTEM/370 OS/VS2 ASSEMBLER * 09953202 * * 09955202 * MODULE-SIZE = APPROXIMATELY 6K BYTES * 09955602 * * 09956002 * ATTRIBUTES = REENTRANT, REUSABLE, REFRESHABLE, * 09956402 * PRIVILEDGED, SUPERVISOR STATE, KEY ZERO, * 09956502 * RESIDENT IN PAGEABLE LINK PACK AREA, * 09956602 * DISABLED (IN DIE ROUTINE ONLY) * 09964902 * * 09966902 * ENTRY-POINT = IEWMSEPT * 09968902 * * 09970902 * PURPOSE = TO LOAD A PROGRAM MODULE * 09973302 * * 09984602 * LINKAGE = BRANCH ENTRY FROM PROGRAM MANAGER * 09986602 * THE ENTRY SEQUENCE IS: * 09988602 * L CVTBASE,16(0,0) * 09990602 * L R15,CVTFETCH(CVTBASE) * 09991002 * BALR R14,R15 * 09991402 * * 09991802 * ENTRY-POINT = IEWFBOSV * 09991902 * * 09994202 * PURPOSE = TO LOAD AN OVERLAY SEGMENT * 09996202 * * 09998202 * LINKAGE = BRANCH ENTRY FROM OVERLAY SUPERVISOR * 09998602 * THE ENTRY SEQUENCE IS: * 09999002 * L CVTBASE,16(0,0) * 10001302 * L R15,CVTFBOSV(CVTBASE) * 10003302 * BALR R14,R15 * 10005302 * * 10005702 * INPUT = 1) PARAMETERS PASSED IN GENERAL REGISTERS * 10015702 * (DESCRIBED IN DETAIL BELOW) * 10025702 * 2) COMBINED FETCH/PROGRAM MANAGER WORK AREA * 10035702 * (SEE DSECT GENERATED BY MAPPING MACRO IHAFETWK) * 10045702 * * 10047702 * OUTPUT = SEE DETAILED MODULE DESCRIPTION BELOW * 10049702 * * 10049802 * EXIT-NORMAL = L R15,=F'0' * 10049902 * BR R14 * 10059902 * SEE BELOW FOR FURTHER DETAIL * 10069902 * * 10073202 * EXIT-ERROR = L R15,NON-ZERO ERROR CODE * 10075202 * BR R14 * 10075602 * SEE EQUATES ABOVE FOR FURTHER DETAIL * 10076002 * * 10076402 * EXTERNAL-REFERENCES = * 10076502 * * 10076602 * ROUTINES = PROGRAM FETCH BRANCH ENTERS THE * 10084902 * FOLLOWING SUPERVISOR ROUTINES: * 10086902 * 1) TTR CONVERT ROUTINE * 10088902 * 2) ECB POST ROUTINE * 10090902 * 3) PURGE/RESTORE IPIB QUIESE COUNT * 10092902 * DECREMENT/POST SUBROUTINE * 10093302 * 4) PGFREE/PGFIX ROUTINES * 10102602 * * 10104602 * DATA-AREAS = THE FOLLOWING DATA AREAS ARE USED AND/OR * 10106602 * MODIFIED BY PROGRAM FETCH: * 10108602 * 1) PROGRAM MANAGER/FETCH WORK AREA * 10110602 * 2) OVERLAY SEGMENT TABLE (SEGTAB) * 10111002 * 3) PDS DIRECTORY ENTRY * 10111402 * 4) COMMUNICATION VECTOR TABLE (CVT) * 10111802 * 5) FIXED LOW CORE AREA (PSA) * 10111902 * * 10112002 * CONTROL-BLOCKS = THE FOLLOWING CONTROL BLOCKS ARE * 10112102 * CREATED, USED, AND/OR MODIFIED BY * 10121602 * PROGRAM FTECH: * 10123602 * 1) PROGRAM EXTENT LIST/NOTELIST * 10125602 * 2) DASD ERP WORKAREA * 10127602 * 3) DATA EXETENT BLOCK (DEB) * 10131102 * 4) DATA CONTROL BLOCK (DCB) * 10131502 * 5) UNIT CONTROL BLOCK (UCB) * 10134302 * 6) CONTENTS DIRECTORY ENTRY (CDE) * 10136302 * 7) TASK CONTROL BLOCK (TCB) * 10138302 * 8) I/O SUPERVISOR BLOCK (IOSB) * 10138702 * 9) SERVICE REQUEST BLOCK (SRB) * 10139102 * 10) ADDR SPACE CONTROL BLOCK (ASCB) * 10139502 * 11) ASCB EXTENSION (ASXB) * 10139902 * 12) I/O COMMUNICATION AREA (IOCM) * 10148402 * 13) I/O PURGE INTERFACE BLOCK (IPIB) * 10150402 * 14) RECOVERY WORKAREA (SDWA) * 10152402 * 15) SUPERVISOR REQUEST BLOCK (SVRB). * 10152802 * 16) WINDOW INTERCEPT CONTROL BLOCK(WICB).* 10153202 * * 10154402 * TABLES = SEE DETAILED DESCRIPTION BELOW * 10156402 * * 10156802 * MACROS = PROGRAM FETCH USES THE FOLLOWING SYSTEM MACROS: * 10157202 * ESTAE, DEBCHK, GETMAIN, PGFIX, SETLOCK, STARTIO, * 10157302 * WAIT, FREEMAIN, PGFREE, SETRP, ABEND * 10157402 * * 10158402 * CHANGE-ACTIVITY = SEE FLAGGING IN COL.66 OF AFFECTED LINES * 10158802 * CHANGES TO VS2 RELEASE 3 * 10159237 * 057567,338700-5,338850-95,339688-98,339728-48,426419,035200 ZA07064* 10159337 * 339584-339628,418781-95,429579-91,430624-30,699000-80 ZA05457* 10159437 * 561250,78270002 ZA06138* 10159537 * 728410 ZA08241* 10159637 * 404400-404680,745200 @ZA10266* 10159737 * 067505 @ZA10583* 10159837 * 377205 @ZA12206* 10159937 * 429510,696600,699080 @ZA10542* 10160037 * MOVED 430788 AHEAD OF 430740 @ZA19135* 10160137 *429504,429510,430560,430566 @ZA19735* 10160637 *D067152,161500-161696,421900-422092,426281,C161400 @ZA25996* 10160837 *A376448-376464,C376468,A376472 @ZA26964* 10160937 * @ZA27769* 10161037 * @ZA29550* 10161137 * @ZA29740* 10161237 * @ZA30699* 10161337 ************************END OF SPECIFICATIONS************************** 10161437 EJECT 10162137 ******** PROGRAM FETCH DETAILED MODULE DESCRIPTION 10163137 * 10164137 * 1) ON ENTRY TO FETCH PROGRAM MANAGER WILL PROVIDE THE 10166002 * FOLLOWING PARAMETERS 10174502 * 10183002 * REG 5 ADDRESS OF SVRB FETCH IS RUNNING UNDER 10193502 * REG 7 ADDRESS OF DCB 10197502 * REG 9 COMLIMENTED ADDRESS OF THE CONTENTS 10200002 * DIRECTORY ENTRY FOR THE MODULE TO BE 10230002 * LOADED (IN WHICH FETCH WILL INSERT 10260002 * THE LENGTH AND ADDRESS OF THE EXTENT 10290002 * LIST/NOTE LIST) 10320002 * REG 10 SUB POOL ID FOR PROB PROG STORAGE 10350002 * REG 13 ADDR OF THE FETCH WORK AREA 10380002 * REG 14 RETURN ADDRESS 10410002 * REG 15 ENTRY POINT ADDRESS INTO FETCH 10440002 * 10470002 * WHEN RETURNING TO PROGRAM MANAGER FETCH WILL PROVIDE THE 10500002 * FOLLOWING PARAMETERS: 10530002 * 10560002 * REG 3 SAVED ACROSS FETCH 10570002 * REG 6 SAVED ACROSS FETCH 10580002 * REG 12 RELOCATED ENTRY POINT 10582002 * REG 15 CONDITION CODE 10584002 * 10586002 * AT AN OFFSET OF 32 BYTES FROM THE START OF THE 10590002 * AREA WHOSE COMPLIMENTED ADDRESS IS IN REG 9 10620002 * (PROVIDED BY PROGRAM MANAGER ON ENTRY TO 10650002 * FETCH) THERE IS AN 8 BYTE FIELD WHICH 10680002 * FETCH WILL INITIALIZE TO CONTAIN THE LENGTH 10710002 * OF THE EXTENT LIST (INCLUDING THE NOTE LIST 10740002 * WHEN NEEDED), THE ADDRESS OF THE EXTENT LIST 10770002 * AND A FLAG BYTE WHICH WHEN BIT 2 IS SET 10800002 * INDICATES THAT THE EXTENT LIST CONTAINS VALID 10830002 * INFORMATION. IF THESE 8 BYTES ARE ZERO THEN 10860002 * BECAUSE OF AN ERROR CONDITION FETCH DID NOT 10890002 * BUILD AN EXTENT LIST. 10920002 * 10950002 * ADDR IN REG 9 ----->********************** 10980002 * * * 11010002 * * * 11040002 * ... 11070002 * ... 11100002 * * * 11130002 * ********************** 11160002 * ADDR IN REG 9 +32 * * X LIST SIZE * 11190002 * ********************** 11220002 * *FLGS* X LIST ADDR * 11250002 * ********************** 11280002 * 11310002 EJECT 11340002 * 11370002 * EXTENT LIST ********************** 11400002 * * TOTAL SIZE OF LIST * 11430002 * ********************** 11460002 * *NO. OF RELOC FACTORS* 11490002 * ********************** 11520002 * * * 11550002 * * LIST OF LENGTHS * 11580002 * * OF NON-CONTIGUOUS * 11610002 * * CORE BLOCKS * 11640002 * * * 11670002 * ... 11700002 * ... 11730002 * * * 11760002 * ********************** 11790002 * * * 11820002 * * LIST OF ADDRESSES * 11850002 * * OF CORE BLOCKS * 11880002 * * * 11910002 * ... 11940002 * ... 11970002 * * * 12000002 * NOTE LIST ********************** 12030002 * (FOR OVERLAY PGMS ONLY) * * RELOC FACTOR * 12060002 * ********************** 12090002 * * PGM CORE SIZE * ID * 12120002 * ********************** 12150002 * * T * T * R * 0 * SEG 1 12180002 * ********************** 12210002 * * T * T * R * 0 * SEG 2 12240002 * ********************** 12270002 * * * 12300002 * ... 12330002 * ... 12360002 * * * 12390002 * ********************** 12420002 * * T * T * R * 0 * SEG N 12450002 * ********************** 12480002 EJECT 12660002 * 2) ON ENTRY TO FETCH OVERLAY SUPERVISOR WILL PROVIDE THE 12690002 * FOLLOWING PARAMETERS 12720002 * REG 3 ADDRESS OF THE FETCH WORK AREA 12750002 * REG 7 ADDRESS OF DCB 12780002 * REG 8 ADDRESS OF NOTE LIST 12810002 * REG 9 SHIFTED SEGMENT NUMBER 12840002 * REG 14 RETURN ADDRESS 12870002 * 12900002 * WHEN RETURNING TO OVERLAY SUPERVISOR FETCH WILL PROVIDE 12930002 * THE FOLLOWING PARAMETERS 12960002 * 12990002 * REG 3 ADDRESS OF FETCH WORK CORE INITALLY 13020002 * PROVIDED BY OVERLAY SUPERVISOR 13050002 * REG 6 SAVED ACROSS FETCH 13080002 * REG 15 CONDITION CODE 13110002 * 13140002 SPACE 5 13170002 * 13200002 * FETCH BUFFER TABLE - FTTBL 13230002 * 13260002 * ************************************************************** 13290002 * * BUF* * * * * * 13320002 * 1 * * PTR TO NEXT * TIC* ADDR OF CHPG2* * ADDR OF RBUF1 * 13350002 * *CODE* (2) * * * * * 13380002 * ************************************************************** 13410002 * * BUF* * * * * * 13440002 * 2 * * PTR TO NEXT * TIC* ADDR OF CHPG3* * ADDR OF RBUF2 * 13470002 * *CODE* (3) * * * * * 13500002 * ************************************************************** 13530002 * * BUF* * * * * * 13560002 * 3 * * PTR TO NEXT * TIC* ADDR OF CHPG1* * ADDR OF RBUF3 * 13590002 * *CODE* (1) * * * * * 13620002 * ************************************************************** 13650002 * 13680002 * FTTBLPTR POINTS TO TABLE ENTRY WHOSE RBUF IS CURRENTLY 13710002 * BEING LOADED 13740002 * 13770002 EJECT 13800002 * FLAGS WHICH ARE SET AND USED BY PROGRAM FETCH 13830002 * FLAGS ARE AT OFFSET X'488' IN THE WORK 13860002 * AREA OBTAINED FOR EACH MODULE TO BE LOADED 13890002 SPACE 13920002 * FTFLAG1 = BYTE 1 RESERVED 13950002 * 13980002 * FTFLAG2 = BYTE 2 RESERVED 14010002 * 14040002 * FTFLAG3 = BYTE 3 14070002 * 14100002 * X'FF' ALL BUFFERS FULL. CHAN PROG REQUIRES 14130002 * RESTART. SET BY PCI APPENDAGE 14160002 * 14190002 * X'0F' CE APPENDAGE UNABLE TO RESTART BECAUSE 14220002 * ALL BUFFERS WERE FULL WHEN CE OCCURRED. 14250002 * RESTART WILL COME FROM MAIN LINE FETCH 14280002 * VIA EXCPVR AFTER AT LEAST ONE BUFFER IS 14310002 * EMPTIED. SET BY CE APPENDAGE 14340002 * 14370002 * X'00' NORMAL OPERATING CONDITION. THER IS AT 14400002 * LEAST ON EMPTY BUFFER 14430002 * 14460002 * FTFLAG4 = BYTE 4 14490002 * 14520002 * X'FF' END CONDITION. ONLY TERMINATION PROCESSING 14550002 * IS REQUIRED IN MAIN LINE FETCH. SET BY 14580002 * MAIN LINE FETCH 14610002 * 14640002 * X'0F' END CONDITION. BUFFER PROCESSING REQUIRED 14670002 * BY MAIN LINE FETCH IN ADDITION TO 14700002 * TERMINATION PROCESSING. SET BY EITHER PCI 14730002 * OR CE APPENDAGE 14760002 * 14790002 * FTRESTRT = BYTES 5-8 14820002 * 14850002 * SET BY PCI APPENDAGE. IF THERE IS AN ADDRESS 14880002 * THEN READ JUST COMPLETED WAS AN RLD READ ONLY 14910002 * AND RESTART SEEK ADDRESS BUFFER IS SAVED TO BE 14940002 * USED WHEN A RESTART IS NEEDED. IF CONTENTS IS 14970002 * ZERO THEN READ JUST COMPLETED WAS TEXT/RLD READ 15000002 * AND RESTART ADDRESS BUFFER IS LAST ONE FILLED 15030002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...INITIALIZATION' 15060002 *********************************************************************** 15090002 * * 15120002 * ENTRY POINT TO FETCH FROM PROGRAM MANAGER * 15150002 * AND OVERLAY SUPERVISOR * 15180002 * Y02081 * 15210002 *********************************************************************** 15240002 SPACE 15250002 IEWMSEPT EQU * ENTRY POINT FOR PROGRAM Y02081 15252002 * MANAGER Y02081 15254002 IEWFBOSV EQU * ENTRY POINT FOR OVERLAY Y02081 15256002 * SUPERVISOR Y02081 15258002 USING *,CODEREG USE REG 15 FOR TEMPORARY Y02081 15260002 * ADDRESSABILITY Y02081 15262002 B FETCH001 BRANCH AROUND MODULE ID Y02081 15264002 FETIDENT DC C'IEWFETCH ' MODULE NAME Y02081 15266002 DC C'OS/VS2 ' SYSTEM NAME Y02081 15268002 DC C'REL 037 ' RELEASE NUMBER Y02081 15268437 DC C'LAST UPDATE 02/02/78' DATE LAST UPDATED Y02081 15268537 * THE LATEST CODE CHANGE IS -- Y02081 15268637 * APAR OZ29740 Y02081 15268737 DROP CODEREG DROP TEMP ADDRESSABILITY Y02081 15269202 SPACE 15269602 DS 0H ALIGN TO HALF WORD 15269737 FETCH001 BALR FTBASE1,0 ESTABLISH ADDRESSABILITY Y02081 15270002 USING FT001,FTBASE1 DEFINE BASE REG FOR CODE Y02081 15330002 USING WKFETCH,FTBASE2 DSECT BASE FOR WORK AREA Y02081 15360002 USING FLC,WKREGF ADDRESSABILITY FOR FIXED Y02081 15390002 * LOCATIONS IN LOW CORE Y02081 15420002 SPACE 2 15450002 FT001 EQU * START OF CODE 15460002 LTR SEGREG,SEGREG TEST OVLY OR CONT SUPER 15480002 BM FT00101 BR NOT OVLY 15510002 LR FTBASE2,WKRG3 SET WORK BASE FROM OVLY Y02081 15540002 LPR DCBREG,DCBREG MAKE REG 7 POSITIVE IF YM1070 15570002 * SET NEGATIVE TO INDICATE YM1070 15600002 * AN ASYNCHRONOUS SEGLD YM1070 15630002 LA WKREGC,XESTAORG PLACE PSUEDO SVRB ADDR OF Y02081 15632002 * WORKAREA IN REG 5 TO INDICATE Y02081 15634002 * OVERLAY SUPV CALL TO ESTAE Y02081 15636002 ST FTBASE2,XESTAWKA SAVE W.A. PTR FOR ESTAE Y02081 15636402 SPACE 15638002 FT00101 EQU * INITIALIZATION 15640002 XC FTFLAGS,FTFLAGS CLEAR FLAGS Y02081 15660002 XC XFLAGS,XFLAGS CLEAR EXTENDED CONTROL FLAGS 15690002 XC XIOBSEK1(L'XIOBSEK1+L'XIOBSEK2),XIOBSEK1 CLEAR YM5025 15700002 * SEEK ADDRESS SAVEAREAS YM5025 15710002 XC XLOFIX,XLOFIX CLEAR LOW PGFIX ADDRESS YM6928 15712002 XC XIOSBAD,XIOSBAD CLEAR IOSB/SRB ADDRESS FIELD YM6928 15714002 XC XESTAEPT,XESTAEPT CLEAR SAVED IOSB POINTER 15714437 MVC XKEY,FTKEY SET FETCH ID KEY IN WORKAREA YM6928 15716002 ST RETURNRG,XRETSAV SAVE RETURN ADDRESS Y02081 15720002 ST WKRG3,XREGSV3 SAVE REGISTER 3 YM1070 15750002 ST WKRG6,XREGSV6 SAVE REGISTER 6 YM1070 15780002 SPACE 2 15790002 * ISSUE ESTAE MACRO TO GIVE FETCH CONTROL IF SYSTEM GOES DOWN. 15800002 SPACE 15802002 L WKREGB,ESTAEADD ADDR OF FETCH ESTAE Y02081 15804002 XC XGMLIST(LISTSIZ),XGMLIST CLEAR FOR ESTAE YM3247 15806102 SPACE 15806202 *** IF THE CALLER IS PGM MGR, WKREGC (REG 5) WILL CONTAIN ADDR 15806302 *** OF THE PGM MGR SVRB WHICH CONTAINS ADDR OF FETCH WORKAREA 15808502 *** AT AN OFFSET OF HEX 74 -- IF THE CALLER IS OVLY SUP, WKREGC 15810502 *** WILL CONTAIN THE COMPLEMENTED ADDR OF THE FETCH WORKAREA. 15810902 *** IN EITHER CASE, THIS IS THE PARAMETER TO BE PASSED TO THE 15811002 *** ESTAE EXIT RTN IN THE EVENT OF ABNORMAL TERMINATION. Y02081 15811102 SPACE 15811202 ESTAELST ESTAE (WKREGB),CT,PARAM=(WKREGC),PURGE=HALT,ASYNCH=NO, X15813402 ESTAR=NO,TERM=YES,BRANCH=NO,RECORD=NO,MF=(E,XGMLIST) 15815602 EJECT 15817802 ********************************************************************* 15820002 * CONSTRUCT A DUPLICATE DEB COPY TO ENSURE FETCH I/O INTEGRITY 15840002 * WHEN THE LOAD DCB IS NOT SYSTEM PROVIDED. THUS AVOIDS DEB 15870002 * CONTENTION AND ENSURES ENTRY TO THE PROPER APPENDAGES FOR 15900002 * PAGE FIX AND CCW TRANSLATE SERVICES REQUIRED FOR FETCH I/O. 15930002 ********************************************************************* 15932002 SPACE 15934002 * TEST IF CURRENT REQUEST IS USING A SYSTEM DEB--IF YES WE 15936002 * DON'T NEED TO COPY IT. 15938002 SPACE 15938402 L WKREGB,CVTPTR GET CVT PTR Y21179 15940002 SPACE 15940402 USING CVT,WKREGB CVT ADDRESSABILITY Y21179 15942002 SPACE 15952002 ST DCBREG,XORGDCB SAVE ORIGINAL DCB ADDRESS 15960002 CLM DCBREG,ADDR,CVTSVDCB+1 IS DCB FOR SVCLIB ? YM6990 15990002 BE FT002 BR IF SYSTEM SVCLIB DCB 16020002 CLM DCBREG,ADDR,CVTLINK+1 IS DCB FOR LINKLIB ? YM6990 16050002 BE FT002 BR IF SYSTEM LINKLIB DCB 16080002 SPACE 16082002 DROP WKREGB DROP CVT BASE Y21179 16090002 SPACE 16100002 LTR SEGREG,SEGREG OVLY SUPVR CALL? Y02081 16110002 BP FT00102 GO IF OVERLAY SUPVR @ZA25996 16140037 TM WKFLG1,WKSYSREQ IS THIS A SYSTEM REQUEST? Y02081 16170002 BO FT002 IF SO, BYPASS DEB COPY Y02081 16200002 FT00102 EQU * JOBLIB TEST Y02081 16230002 L WKREGC,PSATOLD GET LOCATION OF CURRENT Y02081 16260002 * TCB (FROM FIXED LOW CORE) Y02081 16290002 ** IF THIS IS THE JOBSTEP TCB WE DONT NEED TO CHECK THE DCB IT'S 16320002 ** IN PROTECTED CORE 16350002 USING TCB,WKREGC SET TCB BASE REG 16380002 L WKREGC,TCBJSTCB R3=ADDR OF JS TCB OR ITSELF 16410002 CLM DCBREG,ADDR,TCBJLB+1 IS DCB FOR JOBLIB ? 16440002 BE FT002 BR IF JOBLIB DCB 16470002 DROP WKREGC DROP TCB BASE 16500002 EJECT 16530037 *********************************************************************** 16531037 * FIX FOR REFER BACK OF PROGRAM NAME @ZA29550 16532037 *********************************************************************** 16533037 LTR SEGREG,SEGREG OVLY SUPVR CALL? 16534037 BM RB020 GO IF NOT OVLY SUPVR @ZA30699 16535037 DROP FTBASE1 16535237 BALR WKREGE,0 ESTABLISH ROUTINE BASE 16535437 USING RB001,WKREGE DEFINE BASE REG FOR CODE 16535637 RB001 EQU * 16535837 STM 0,15,FTREGSV SAVE REGISTERS 16536037 L IDREG,PSATOLD GET CURRENT TCB ADDRESS 16537037 L WKREGA,X'2C'(DCBREG) GET DEB ADDRESS 16538037 LA WKREGA,0(WKREGA) ZERO HIGH BYTE 16539037 CLM DCBREG,ADDR,X'19'(WKREGA) DOES DEB POINT TO DCB 16540037 BNE RB008 NO, GO LET DEBCHECK FAIL 16541037 L CODEREG,X'148'(WKREGB) GET CVT EXT ADDRESS 16542037 L CODEREG,8(CODEREG) GET ENTRY POINT TO DEBCHECK 16543037 LR WKREGC,CODEREG SAVE ENTRY POINT IN REG 5 16544037 BALR 14,15 GO DO DEBCHECK 16545037 B RB008 OK FOR USER'S DEB, DO NORMAL DEBCHK 16546037 L IDREG,PSATOLD GET CURRENT TCB ADDRESS 16546537 L IDREG,X'B4'(IDREG) GET JSCB ADDRESS 16547037 L IDREG,X'D0'(IDREG) GET INITIATOR'S TCB ADDRESS 16548037 LR CODEREG,WKREGC GET ENTRY POINT TO DEBCHECK 16549037 BALR 14,15 TRY AGAIN 16550037 B RB009 OK, MUST BE PROGRAM REFER BACK DCB 16551037 * 16551337 * GO DO DEB CHECK WHICH SHOULD FAIL 16552037 * BECAUSE OF AN INVALID DCB/DEB 16553037 RB008 EQU * 16554037 LM 0,15,FTREGSV RESTORE REGISTERS 16555037 DROP WKREGE DROP ROUTINE BASE 16556037 USING FT001,FTBASE1 DEFINE BASE REG FOR CODE 16556137 B RB020 16556237 RB009 EQU * 16556337 LM 0,15,FTREGSV RESTORE REGISTERS 16556437 B FT002 OK, MUST BE PROGRAM REFER BACK DCB 16556537 RB020 EQU * 16556637 *********************************************************************** 16557037 EJECT 16558037 * NOT A SYSTEM DCB...OBTAIN SPACE AND BUILD A DEB COPY AFTER 16560002 * VALIDATING DEB AND CALCULATING SIZE. 16580002 SPACE 16590002 STM CODEREG,WKREGA,FTREGSV SAVE REG 15, 0, 1 16620002 SPACE 16630002 VALIDATE DEBCHK (DCBREG),TYPE=VERIFY 16650002 SPACE 16660002 LR WKREGB,WKREGA DEB ADDR IS RETURNED IN R1 16680002 LM CODEREG,WKREGA,FTREGSV RESTORE REG 15, 0, 1 16710002 SPACE 16720002 USING DEBBASIC,WKREGB EST DEB BASE REG 16740002 SPACE 16770002 SR WKREGC,WKREGC CLEAR WORK REGISTER 16800002 IC WKREGC,DEBNMEXT NUMBER OF DEB EXTENTS 16830002 IC WKREGA,FTDEBMSK EXTENT SCALE 16860002 SLL WKREGC,0(WKREGA) CALC LEN OF EXTENTS SECTION 16890002 LA WKREGC,DEBBASND-DEBBASIC(WKREGC) ADD SIZE OF BASE 16920002 SPACE 16930002 * INCREMENT DEB SIZE FOR CONCATENATED PRIVATE DATA SETS-1 BYTE/D.S. 16950002 SPACE 16960002 SR WKREGF,WKREGF RESET YM0681 16980002 LTR SEGREG,SEGREG OVLY SUPVR CALL? Y02081 17010002 BM FT00103 IF NOT, BRANCH Y02081 17040002 SPACE 17050002 USING NOTELIST,LISTREG NOTELIST ADDRESSABILITY Y02081 17070002 IC WKREGF,NLCONCAT GET CONCATENATION NO. Y02081 17100002 DROP LISTREG DROP NOTELIST BASE Y02081 17130002 SPACE 17140002 B FT00104 BYPASS PGM MGR CODE Y02081 17160002 SPACE 17170002 FT00103 EQU * PGM MGR CALL Y02081 17190002 IC WKREGF,WKTTRN+3 GET CONCATENATION NO. Y02081 17220002 SPACE 17230002 FT00104 EQU * SETUP FOR GETMAIN Y02081 17250002 AR WKREGC,WKREGF ADD CONCN COUNT TO TOTAL Y02081 17280002 ST WKREGC,XDEBLEN SAVE TOTAL SIZE OF DEB AND 17310002 MVI XDEBLEN,DEBCORE THE SUBPOOL ID FOR FREEMAIN 17340002 * AT TERMINATION. 17370002 SPACE 17380002 * --- GET SPACE FOR DEB COPY --- 17400002 SPACE 17410002 GETMAIN EC,MF=(E,XGMLIST),LV=(WKREGC),A=XDCBDEBA,SP=DEBCORE 17430002 SPACE 17440002 LTR CODEREG,CODEREG TEST GETMAIN SUCCESSFUL Y02081 17460002 BNZ FT027C IF NOT, TERMINATE Y02081 17490002 SPACE 17500002 * COPY DEB IN GETMAIN'ED SPACE 17510002 SPACE 17512002 L WKREGF,XDCBDEBA GET NEW DEB ADR IN PSEUDO DCB Y02081 17520002 * -- SET UP MOVE REG (TO-LOC) Y02081 17550002 LR WKREGA,WKREGC SET UP MOVE REG (TO-LEN) 17580002 MVCL WKREGF,WKREGB COPY OLD DEB TO NEW AREA 17610002 L WKREGB,XDCBDEBA RESET DEB BASE REG TO 17640002 * ADDRESS THE NEW DEB. 17670002 LA DCBREG,XDCBCOPY ADDR OF PSUEDO DCB 17700002 STCM DCBREG,ADDR,DEBDCBB CHAIN PSEUDO DCB TO NEW DEB 17730002 NI DEBPROTG,KEYZERO SET DEB KEY TO ZERO 17760002 XC DEBQSCNT,DEBQSCNT CLEAR PURGE COUNT 17790002 XC DEBUSRPB,DEBUSRPB CLEAR PURGE CHAIN FIELD 17820002 OI XFLAG1,USDEBFLG DENOTE USER DEB COPIED 17850002 SPACE 17880002 DROP WKREGB ABANDON TEMP DEB BASE 17910002 EJECT 17940002 ********************************************************************* 17950002 * 17970002 * SET UP THE DEB FILE MASK IF ACR(AUTOMATIC COMMAND RETRY) DEVICES 18000002 * ARE BEING USED AND DETERMINE IF WE ARE USING RPS DEVICES 18010002 * AND/OR VAM DATA SETS AND SET SWITCHES ACCORDINGLY. 18020002 * 18030002 ********************************************************************* 18040002 SPACE 18050002 FT002 EQU * DEB PROCESSING Y02081 18060002 L WKREGA,DCBDEBAD(DCBREG) GET DEB ADDR 18090002 SPACE 18100002 USING DEBBASIC,WKREGA SET DEB ADDRESSABLILITY Y02081 18120002 TM DEBFLGS1,DEBAPFIN LOADING FROM AN APF YM1088 18150002 * AUTHORIZED LIBRARY? YM1088 18180002 BZ FT0021 IF NOT, BRANCH YM1088 18210002 OI WKFLG1,WKAUTH SET AUTHORIZED LIBRARY YM1088 18240002 * INDICATOR FOR PROG MGR YM1088 18270002 SPACE 3 18280002 * GET TO THE FIRST EXTENT IN THE DEB WE WILL BE FETCHING FROM 18290002 * PRIOR TO STARTING TO SCAN THE DEB EXTENTS FOR ACR/RPS DEVICES. 18292002 SPACE 18294002 FT0021 EQU * DEB SCAN YM1088 18300002 SR WKREGB,WKREGB CLEAR WORK REGISTER Y02081 18330002 STH WKREGB,XTNTSAVE INIT STARTING EXTENT NO. Y02081 18360002 SPACE 18370002 LTR SEGREG,SEGREG OVLY SUPVR CALL? Y02081 18390002 BM FT0022 IF NOT, BRANCH Y02081 18420002 SPACE 18430002 USING NOTELIST,LISTREG NOTELIST ADDRESSABILITY Y02081 18450002 IC WKREGB,NLCONCAT GET CONCATENATION NO. Y02081 18480002 DROP LISTREG DROP NOTELIST BASE Y02081 18510002 SPACE 18520002 B FT0023 BYPASS PGM MGR CODE Y02081 18540002 SPACE 18550002 FT0022 EQU * USE BLDL ENTRY Y02081 18570002 IC WKREGB,WKTTRN+3 GET CONCATENATION NO. Y02081 18600002 SPACE 18610002 FT0023 EQU * TEST CONCATENATION NO. Y02081 18630002 LTR WKREGB,WKREGB IS IT 1ST CONCATENATION? Y02081 18660002 BNZ FT00235 GO IF CONCATENATION YM1172 18690002 SPACE 18700002 MVC NMEXTSV(L'DEBNMEXT),DEBNMEXT SAVE THE NUMBER YM3984 18710002 * OF EXTENTS IN THE DEB YM3984 18710402 B FT0024 CONTINUE IF NON-COCATN D.S. YM1172 18712002 SPACE 18712402 FT00235 EQU * CONTINUE YM1172 18714002 BCTR WKREGB,0 SUBTRACT 1 FOR INDEX Y02081 18720002 SR WKREGF,WKREGF CLEAR WORK REGISTER Y02081 18750002 IC WKREGF,DEBNMEXT GET NUM OF EXTENTS IN DEB Y02081 18780002 STC WKREGF,NMEXTSV SAVE NO.OF DEB EXTENTS Y02081 18810002 SLL WKREGF,4 MULT. BY ENTRY SIZE Y02081 18840002 AR WKREGA,WKREGF INDEX TO END OF EXT SECT Y02081 18870002 SR WKREGF,WKREGF ZERO WORK REGISTER Y02081 18900002 IC WKREGF,DEBBASND-DEBBASIC(WKREGA,WKREGB) GET THE Y02081 18930002 * STARTING M-VALUE FOR THIS Y02081 18960002 * CONCATENATION NUMBER Y02081 18990002 STH WKREGF,XTNTSAVE SAVE STARTING EXTENT NO. Y02081 19020002 SLL WKREGF,4 INDEX TO THAT EXTENT Y02081 19050002 L WKREGA,DCBDEBAD(DCBREG) POINT TO START OF DEB Y02081 19080002 AR WKREGA,WKREGF POINT TO CORRECT EXTENT Y02081 19110002 SPACE 19132002 FT0024 EQU * SETUP FOR DEB SCAN Y02081 19140002 SR WKREGB,WKREGB ZERO WORK REGISTER Y02081 19170002 IC WKREGB,DEBBASND GET DEB FILE MASK Y02081 19200002 STC WKREGB,FMSKSAVE SAVE FILE MASK FOR IOSB Y02081 19230002 ICM WKREGB,ADDR,(DEBBASND+L'DEBDVMOD) GET UCB ADDR Y02081 19260002 USING UCBOB,WKREGB SET UCB ADDRESSABILITY Y02081 19290002 TM UCBJBNR,UCBVRDEV IS THE LIBRARY BEING Y02081 19320002 * FETCHED FROM ON A VIRTUAL Y02081 19350002 * DEVICE? Y02081 19380002 BO FT0028 IF SO, BRANCH (DO NOT ALTER Y02081 19410002 * FILE MASK) Y02081 19440002 SR WKREGF,WKREGF CLEAR WORK REG AND GET M60688 19470002 IC WKREGF,NMEXTSV NUM OF EXTENTS IN DEB M60688 19500002 SH WKREGF,XTNTSAVE SUBTRACT STARTING EXT.NO. Y02081 19530002 MVC UCBSAVE(L'DEBUCBA),(DEBBASND+L'DEBDVMOD) SAVE Y02081 19560002 * THE UCB ADDRESS Y02081 19562002 SPACE 19570002 * SCAN THE DEB EXTENTS FOR RPS DEVICE. 19580002 SPACE 19582002 FT0025 ICM WKREGB,ADDR,(DEBBASND+L'DEBDVMOD) GET UCB ADDR Y02081 19590002 CLI UCBTBYT4,X'06' TEST UCB FOR DEVICE TYPE M60688 19620002 BL FT0029 IF NOT MER OR ZEUS DO M60688 19650002 CLI UCBTBYT4,X'08' NOT ALTER FILE MASK M60688 19680002 BE FT0029 FIELDS IN DEB M60688 19710002 OI DEBBASND,MRZEUSBT ALTER FILE MASK IN DEB M60688 19740002 OI FMSKSAVE,MRZEUSBT ALTER FILE MASK FOR IOSB Y02081 19770002 SPACE 19772037 CLI UCBTBYT4,X'0A' IS IT A 3340? ZA3192 19780037 BNE FT0026 GO IF NOT 3340 ZA3192 19790037 TM UCBTBYT2,UCBRPS DOES THIS 3340 HAVE RPS? ZA3192 19792037 BNO FT00265 GO IF NOT RPS ZA3192 19794037 SPACE 19794437 FT0026 EQU * RPS ON ZA3192 19796037 OI XFLAG1,RPSDEV INDICATE AN RPS DEVICE IS Y02081 19800002 * BEING FETCHED FROM Y02081 19830002 SPACE 2 19840002 FT00265 EQU * CONTINUE ZA3192 19842037 USING DEBDASD,WKREGA SET BASE REG FOR DEB YM1172 19850002 LA WKREGA,EXTVALUE POINT TO NEXT POTENTIAL YM1172 19860002 * EXTENT AREA IN DEB YM1172 19890002 SPACE 19910002 BCT WKREGF,FT0025 BR IF ANOTHER EXTENT M60688 19920002 SPACE 19930002 B FT0029 SINCE THIS IS NOT A VAM Y02081 19950002 * DATA SET, DO NOT USE IOB Y02081 19980002 DROP WKREGA DROP DEB BASE M60688 20010002 DROP WKREGB DROP UCB BASE Y02081 20040002 EJECT 20070002 *********************************************************************** 20100002 * * 20130002 * INIALIZATION FOR VAM DATA SETS * 20160002 * Y02081 * 20190002 *********************************************************************** 20220002 SPACE 2 20250002 FT0028 EQU * BEGIN VAM INITIALIZATION Y02081 20280002 OI XFLAG1,VAMDEV INDICATE A VIRTUAL DEVICE IS Y02081 20310002 * BEING FETCHED FROM Y02081 20340002 LA WKREGB,FTAPNDG ADDR OF APPENDAGE 20370002 O WKREGB,FTDEBMSK SET FILE MASK 22125 20400002 L WKREGA,DCBDEBAD(DCBREG) POINT TO START OF DEB Y02081 20430002 ST WKREGB,AVTPTR(WKREGA) STORE AVT POINTERS 22125 20460002 OI FTIOB,FTIOBFL INIT IOB FLAGS 20490002 LA WKREGA,FTCPSCH2 ADDR OF CHAN PROG 20520002 ST WKREGA,FTIOB+CPADDRES ADDR OF CHANNL PGM TO IOB Y02081 20550002 ST DCBREG,FTIOB+DCBADDRS DCB ADDR TO IOB 20580002 LA WKREGA,FTECB GET ECB ADDRESS Y02081 20610002 ST WKREGA,FTIOB+ECBADDRS ECB ADDR TO IOB 20640002 * 20670002 *------ SET UP VAM CHANNEL PROGRAM Y02081 20700002 * 20730002 MVC FTCPSCH2(VAMSCHLN),FTCCW2 SET SEARCH CHAN.PROG. Y02081 20760002 LA WKREGB,FTIOBSK+CCHHR GET SEARCH ADDRESS Y02081 20790002 STCM WKREGB,ADDR,FTCPSCH2+SRCHADDR SEARCH ADDR.IN CP Y02081 20820002 LA WKREGA,FTCPSCH2 ADDRESS OF CHANEL PROG. Y02081 20850002 STCM WKREGA,ADDR,FTCPSCH2+SRCHCCW 1ST TIC-TO COMMAND Y02081 20880002 LA WKREGA,FTCP1 GET ADDR OF READ TEXT CCW Y02081 20910002 STCM WKREGA,ADDR,FTCPSCH2+TICTOADD 2ND TIC-TO ADDRESS Y02081 20940002 MVC FTCP1(VAMCPLN),FTCCW4 SET VAM CHANNEL PROGRAM Y02081 20970002 LA WKREGA,FTRBUF1 GET ADDR OF RLD BUFFER Y02081 21000002 STCM WKREGA,ADDR,FTCP1+RLDBUFAD STORE IN READ RLD CCW Y02081 21030002 SPACE 21040002 LTR SEGREG,SEGREG OVERLAY SUPERVISOR REQUEST? Y02081 21050002 BM FT004 GO IF PROGRAM MANAGER Y02081 21052002 B FT003 GO IF OVERLAY SUPERVISOR Y02081 21054002 EJECT 21060002 *********************************************************************** 21090002 * * 21120002 * INITIALIZE THE I/O CONTROL BLOCKS (SRB AND IOSB) REQUIRED * 21150002 * FOR FETCH'S INTERFACE WITH IOS THROUGH THE 'STARTIO' * 21180002 * FUNCTION AND THE VSL TO BE USED FOR INTERFACING WITH * 21210002 * THE SYSTEM PGFIX AND PGFREE FUNCTIONS. * 21240002 * Y02081 * 21270002 *********************************************************************** 21300002 FT0029 EQU * BEGIN IOSB INITIALIZATION Y02081 21330002 * --- GET IOSB/SRB STORAGE --- Y02081 21360002 GETMAIN EC,MF=(E,XGMLIST),LV=GLOBREQ,A=XIOSBAD,SP=SQASP 21390002 LTR CODEREG,CODEREG TEST GETMAIN SUCCESSFUL Y02081 21420002 BNZ FT027C IF NOT, TERMINATE Y02081 21450002 L WKREGA,XIOSBAD GET ADDR OF IOSB/SRB Y02081 21480002 USING IOSB,WKREGA ADDRESSABILITY FOR IOSB Y02081 21510002 XC IOSB(GLOBREQ),IOSB INITIALIZE ENTIRE IOSB AND Y02081 21540002 * SRB TO ZEROES Y02081 21570002 OI IOSFLA,IOSCCHN+IOSSMDB SET COMMAND CHAINING AND Y02081 21600002 * PCI FETCH INDICATORS ON Y02081 21630002 OI IOSDVRID,IOSFCHID SET FETCH VOID INDEX Y02081 21660002 MVC IOSUCB+1(L'DEBUCBA),UCBSAVE MOVE THE UCB ADDRESS Y02081 21690002 * (SAVED PREVIOUSLY) INTO THE Y02081 21720002 * IOSB Y02081 21770002 L WKREGB,PSAAOLD GET ASCB POINTER Y02081 21780002 USING ASCB,WKREGB ADDRESSABILITY FOR ASCB Y02081 21810002 LH WKREGB,ASCBASID GET OUR ADDR SPACE ID Y02081 21840002 DROP WKREGB DROP ASCB BASE Y02081 21870002 STH WKREGB,IOSASID SET ASID IN IOSB Y02081 21900002 LA WKREGB,IEWFTSRB GET ADDRESS OF FETCH SRB Y02081 21930002 * COMPLETION ROUTINE Y02081 21960002 ST WKREGB,IOSPGAD SET SRB EXIT ROUTINE POINTER Y02081 21990002 * IN IOSB Y02081 22020002 *------ PROTECT KEY OF SRB COMPLETION RTN IN IOSPKEY = 0 Y02081 22050002 LA WKREGB,FTCE01 GET ADDRESS OF THE FETCH Y02081 22080002 * POST STATUS NORMAL Y02081 22110002 * SUBROUTINE (CHANNEL END) Y02081 22140002 ST WKREGB,IOSNRM SET POST STATUS NORMAL Y02081 22170002 * ROUTINE POINTER IN IOSB Y02081 22200002 LA WKREGB,FTRETURN GET ADDR OF BR 14 INSTRUCTION Y02081 22230002 ST WKREGB,IOSABN USE AS FETCH POST STATUS Y02081 22260002 * ABNORMAL END EXIT ROUTINE Y02081 22290002 L WKREGB,FTPCIADD GET ADDRESS OF THE FETCH Y02081 22330002 * DISABLED INTERUPT EXIT Y02081 22350002 * SUBROUTINE (PCI PROCESSOR) Y02081 22380002 ST WKREGB,IOSDIE SET DIE RTN PTR IN IOSB Y02081 22410002 L WKREGB,DCBDEBAD(DCBREG) GET DEB ADDRESS Y02081 22440002 ST WKREGB,IOSDSID SET DEB ADR AS DSID FOR PURGE Y02081 22470002 MVC IOSFMSK,FMSKSAVE SET DEB FILE MASK IN IOSB Y02081 22500002 *------ CHANNEL PROGRAM PROTECT KEY IN IOSCKEY = 0 Y02081 22530002 ST FTBASE2,IOSUSE SAVE POINTER TO FETCH WORK Y02081 22560002 * AREA IN IOSB USER FIELD FOR Y02081 22590002 * USE IN I/O SUBROUTINES Y02081 22620002 * 22680002 *------ INITIALIZE SRB WITH POINTER TO IOSB FOR 'STARTIO' Y02081 22710002 * 22740002 LA WKREGB,SRBSTART GET ADDRESS OF FETCH SRB Y02081 22770002 USING SRBSECT,WKREGB ADDRESSABILITY FOR SRB Y02081 22800002 ST WKREGB,IOSSRB SET SRB POINTER IN IOSB Y02081 22830002 ST WKREGA,SRBPARM SET PTR TO IOSB IN SRB Y02081 22860002 * PARAMETER FIELD Y02081 22890002 DROP WKREGA DROP IOSB BASE Y02081 22920002 DROP WKREGB DROP SRB BASE Y02081 22950002 SPACE 22980002 MVC XFTCBAD,PSATOLD SAVE ADDR OF CURRENT TCB TO Y02081 23010002 * BE TESTED FOR APPLICABILITY Y02081 23040002 * FOR A TCB PURGE BY THE PURGE Y02081 23070002 * SUBROUTINE Y02081 23130002 EJECT 23160002 * 23190002 *------ INIALIZE FETCH CHANNEL PROGRAM 23220002 * 23250002 SPACE 23280002 MVC FTCPSRCH(FTSCHLN),FTCCW1 SET SEARCH CHAN PROG Y02081 23310002 LA WKREGB,XSECTAD GET ADDR. FOR SET SECTOR Y02081 23340002 STCM WKREGB,ADDR,FTCPSRCH+CCWADR STORE IN SEARCH Y02081 23370002 * CHANNEL PROGRAM Y02081 23380002 LA WKREGB,FTIOBSK+CCHHR GET SEARCH ADDR Y02081 23400002 STCM WKREGB,ADDR,FTCPSRCH+SRCHCCW STORE SEARCH Y02081 23430002 * ADDRESS IN CHANNEL PROGRAM Y02081 23440002 LA WKREGA,FTCPSRCH+CCWSZ ADDR OF SEARCH ID COMMAND Y02081 23460002 STCM WKREGA,ADDR,FTCPSRCH+TICTOADD STORE IN 1ST TIC Y02081 23490002 MVC FTCP1(FTCPLN),FTCCW3 SET CHAN PROG1 Y02081 23520002 LA WKREGA,FTSKBUF1 ADDR OF FETCH SEEK BUF1 Y02081 23550002 STCM WKREGA,ADDR,FTCP1+RDCT1AD STORE IN 1ST RD COUNT Y02081 23580002 LA WKREGA,FTSKBUF2 ADDR OF FETCH SEEK BUF2 Y02081 23610002 STCM WKREGA,ADDR,FTCP1+RDCT2AD STORE IN 2ND RD COUNT Y02081 23640002 LA WKREGA,FTRBUF1 ADDR OF RLD BUFFER 1 Y02081 23670002 STCM WKREGA,ADDR,FTCP1+RDRLDAD STORE IN RD DATA CCW Y02081 23700002 ST WKREGA,FTTBL+TBLBUFAD STOR BUF1 ADDR IN BUF TBL Y02081 23730002 LA WKREGA,XSECTAD GET SET SECTOR BUF ADDR Y02081 23760002 STCM WKREGA,ADDR,FTCP1+RDSECAD STORE IN RD SECTOR CCW Y02081 23790002 MVC FTCP2(FTCPLN),FTCP1 SET CHAN PROG2 Y02081 23820002 LA WKREGA,FTRBUF2 ADDR OF RLD BUFFER2 Y02081 23850002 STCM WKREGA,ADDR,FTCP2+RDRLDAD STORE IN RD DATA CCW Y02081 23880002 ST WKREGA,FTTBL2+TBLBUFAD STOR BUF2 ADDR IN BUF TBL Y02081 23910002 LA WKREGA,FTSKBUF3 2ND COUNT BUF Y02081 23940002 STCM WKREGA,ADDR,FTCP2+RDCT2AD TO 2ND CHAN PROG Y02081 23970002 MVC FTCP3(FTCPLN),FTCP2 SET CHAN PROG3 Y02081 24000002 LA WKREGA,FTRBUF3 ADDR OF RLD BUFFER3 Y02081 24030002 STCM WKREGA,ADDR,FTCP3+RDRLDAD STOR IN RD DATA CCW Y02081 24060002 ST WKREGA,FTTBL3+TBLBUFAD STOR BUF3 ADDR IN BUF TBL Y02081 24090002 LA WKREGA,FTSKBUF4 3RD COUNT BUF Y02081 24120002 STCM WKREGA,ADDR,FTCP3+RDCT2AD FOR 3RD CHAN PROG Y02081 24150002 * MVI FTREGSV+39,X'00' INIT EOX FLAG FOR C.E. 5758 24180002 ********************************************************************** 24210002 XC FTLASTBF,FTLASTBF INIT LAST BUF PTR TO ZERO Y02081 24240002 MVI FTRBUF1+SPINBYTE,ALL INIT 1ST BUF TO PSEUDO WT 24270002 MVI FTSKBUF1+CCHHR,CNTWT SET CNT PSEUDO WT S20201,Y02081 24300002 ********************************************************************** 24330002 TM XFLAG1,RPSDEV FETCH ON AN RPS DEVICE? Y02081 24360002 BO FT029A IF SO, BRANCH Y02081 24390002 NI FTCP1+36,ALL-CMCH TURN OFF COMMAND OY03649,Y02081 24420002 NI FTCP2+36,ALL-CMCH CHAINING BETWEEN OY03649,Y02081 24450002 NI FTCP3+36,ALL-CMCH NOP CCW'S AND READ OY03649,Y02081 24480002 * SECTOR CCW'S OY03649,Y02081 24490002 FT029A EQU * IF RPS, CONTINUE Y02081 24510002 EJECT 24540002 *********************************************************************** 24570002 * * 24600002 * INITIALIZATION OF FETCH BUFFER TABLE * 24630002 * * 24660002 *********************************************************************** 24690002 SPACE 2 24720002 LA WKREGA,FTTBL ADDR OF BUFFER TABLE 24750002 ST WKREGA,FTTBLPTR INIT TABL POINTER 24780002 ST WKREGA,FTTBL3 LAST TBL ENT PTS TO FIRST 24810002 LA WKREGA,FTCP1 ADDR OF FIRST CHAN PROG 24840002 ST WKREGA,FTTBL3+TBLCPAD LAST ENT PTS TO FIRST CP 24870002 MVI FTTBL3+4,TIC SET TIC OP CODE IN TABLE 24900002 LA WKREGA,FTTBL2 ADDR OF 2ND ENT IN BUFTBL 24930002 ST WKREGA,FTTBL FIRST TBL ENT PTS TO 2ND 24960002 LA WKREGA,FTCP2 ADDR OF 2ND CHAN PROG 24990002 ST WKREGA,FTTBL+TBLCPAD 1ST ENT PTS TO 2ND CP 25020002 MVI FTTBL+TBLCPAD,TIC SET TIC OP CODE IN TABLE 25050002 LA WKREGA,FTTBL3 ADDR OF 3RD ENT IN BUFTBL 25080002 ST WKREGA,FTTBL2 2ND TBL ENT POINTS TO 3RD 25110002 LA WKREGA,FTCP3 ADDR OF 3RD CHAN PROG 25140002 ST WKREGA,FTTBL2+TBLCPAD 2ND ENT PTS TO 3RD CP 25170002 MVI FTTBL2+TBLCPAD,TIC SET TIC OP CODE IN TABLE 25200002 EJECT 25230002 * 25260002 * INITIALIZATION OF FETCH WORK AREA EXTENSION. 25290002 * 25320002 LA WKREGA,XALAREA1 ADDR OF IDAL BUILD AREA 25350002 ST WKREGA,XIDALP1 SAVE AS PTR TO PRIMARY IDAL 25380002 LA WKREGA,XALAREA2 ADDR OF IDAL BUILD AREA 25410002 ST WKREGA,XIDALP2 SAVE AS PTR TO AUX IDAL 25440002 SPACE 25500002 * END OF COMMON INITIALIZATION... 25530002 * IDENTIFY CALLER AND PROVIDE INITIALIZATION 25560002 * UNIQUE TO THAT REQUESTER. 25590002 LTR SEGREG,SEGREG CALLED BY OVLY SUPVR? Y02081 25620002 BM FT004 BRANCH IF NOT (CALLED BY Y02081 25650002 * PROGRAM MANAGER) Y02081 25680002 EJECT 25740002 * 25770002 * THIS REQUEST IS FROM OVERLAY SUPERVISOR 25800002 * 25830002 USING NOTELIST,LISTREG 25860002 SPACE 25890002 FT003 L WKREGA,NLRELFAC GET MODULE RELOCATION FACTOR 25920002 LA WKREGA,0(WKREGA) CLEAR THE HIGH BYTE 25950002 ST WKREGA,FTRPTR SAVE FOR RELOCATION USE 25980002 ST WKREGA,XSOMAD ALSO USE AS MODULE START ADDR 26010002 L WKREGF,NLCORSIZ GET MODULE CORE SIZE 26040002 SRL WKREGF,8 SHIFT OUT CONCAT NUMBER 26070002 AR WKREGF,WKREGA ADD START ADDR TO MODULE SIZE 26100002 ST WKREGF,XEOMAD SAVE END-OF-MODULE LOCATION 26130002 ST WKREGF,XNEXTLOC USE EOM AS DEFAULT TXT PTR 26160002 * TO BYPASS PAGE FIX FOR TEXT 26190002 * ON FIRST READ SINCE TEXT LOC 26220002 * IS NOT KNOWN UNTIL THE FIRST 26250002 * CONTROL RECORD HAS BEEN READ. 26280002 XC XTRANTAB,XTRANTAB CLEAR CCW XLATE TABLE FOR SIO 26310002 NI XFLAG1,ALL-ACTXTFLG TURN OFF ACTIVE TEXT-READ FLG 26340002 SPACE 26370002 DROP LISTREG 26400002 SPACE 26430002 L WKREGF,4(SEGREG,LISTREG) SEG TTR FROM NOTE LIST 26460002 LTR WKREGF,WKREGF TEST ZERO TTR 26490002 * 26520002 BC 8,FT027 0 TTR TO NORMAL COMPLETE 26550037 * 26580002 IC WKREGF,NLCONCAT-NOTELIST(LISTREG) INSERT CONCAT FACTOR 26610002 SPACE 26620002 TM XFLAG1,VAMDEV VIRTUAL DEVICE? Y02081 26630002 BO FTVAM04 GO IF VAM Y02081 26632002 SPACE 26634002 BAL WKREGE,CVRTSET TO CONVERT RTN SET UP 26640002 L WKREGA,XIOSBAD GET IOSB ADDRESS Y02081 26670002 USING IOSB,WKREGA ADDRESSABILITY FOR IOSB Y02081 26700002 MVC IOSEEK,FTIOBSK SET IOSB STATIC SEEK ADDR Y02081 26730002 DROP WKREGA DROP IOSB BASE Y02081 26760002 LA WKREGA,FTCP1+CPRDRLD SET FOR FIRST OVERLY RD 26790002 STCM WKREGA,ADDR,FTCPSRCH+SCHTICAD POINT TO READ Y02081 26800002 * CTL/RLD RECORD CCW Y02081 26850002 MVC FTSKBUF1(8),FTIOBSK SET IOBSEEK Y02081 26880002 MVI FTCP1+RDRLDFL,CMCH+SILI+PCI SET PCI IN RD-CTL Y02081 26910002 B FT010 BRANCH AROUND PROG MGR INIT 26940002 * 26970002 *------- END OF INITIALIZATION FOR OVERLAY SUPERVISOR. 27000002 EJECT 27030002 * 27060002 * THIS REQUEST IS FROM PROGRAM MANAGER. 27090002 * 27120002 SPACE 27150002 * OBTAIN MAIN STORAGE FOR EXTENT/NOTE LIST- 27180002 FT004 LA WKREGB,EXLSIZE EXTENT LIST SIZE (BYTES) 27210002 TM WKATTR,PDS2OVLY IS MODULE IN OVERLAY ? Y02081 27240002 BZ FT005 BRANCH NOT OVERLAY 27270002 SR WKREGD,WKREGD CLEAR WORK REGISTER 27300002 IC WKREGD,WKTTESD+7 NUMBER OF NOTE ENTRIES Y02081 27330002 SLL WKREGD,NLENTSZ GET NOTE ENTRY SIZE (BYTES) 27360002 LA WKREGB,NLPFXSZ(WKREGD,WKREGB) COMPUTE TOTAL CORE 27390002 * REQD FOR XLIST+NOTELIST 27420002 FT005 LA WKREGE,FTREGSV LOC FOR GM TO PLACE ADDR 27450002 GETMAIN EC,MF=(E,XGMLIST),LV=(WKREGB),A=(WKREGE),SP=255 27480002 LTR CODEREG,CODEREG TEST GETMAIN SUCCESSFUL Y02081 27510002 BNZ FT027C IF NOT, RETURN WITH RC=12 Y02081 27540002 SPACE 27570002 * INITIALIZE CDE+EXTENT LIST- 27600002 LPR WKREGE,SEGREG ESTABLISH CDE BASE REG 27630002 USING CDENTRY,WKREGE SET CDE ADDRESSABILITY 27660002 L LISTREG,FTREGSV ESTABLISH EXTENT LIST BASE 27690002 USING EXLIST,LISTREG SET EXT LIST ADDRESSABILITY 27720002 SPACE 27750002 ST WKREGB,EXLLNTH SAVE LIST SIZE IN XLIST 27780002 LA WKREGA,1 CORE BLK COUNT 27810002 ST WKREGA,EXLRELFC STORE BLOCK COUNT IN XLIST 27840002 MVI EXLSZIND,SZIND SET BLK SIZE FLAG 27870002 MVC EXLSZBLK,WKLNTH MOVE BLK SIZE INTO XLIST Y02081 27900002 * CLEAR EXLCORAD IN CASE GETMAIN FAILS-ALLOWS ABEND CLEANUP 27930002 XC EXLCORAD,EXLCORAD CLEAR ADDR OF CORE BLOCK YM2608 27960002 MVC CDENTPT,EXLLNTH+1 COPY XLIST SIZE INTO CDE 27990002 MVC CDXLMJP,FTREGSV SAVE XLIST ADDR IN CDE YM2078 28020002 OI CDATTR2,CDXLE TURN ON XLIST CREATED BIT 28050002 SPACE 28080002 DROP WKREGE DROP CDE BASE 28110002 SPACE 28140002 * OBTAIN MAIN STORAGE FOR LOAD MODULE- 28170002 L WKREGB,WKIOADDR GET ADDR OF MODULE FOR YM1088 28200002 * EXPLICIT LOAD, IF ANY YM1088 28230002 LTR WKREGB,WKREGB IS IT EXPLICIT LOAD? YM1088 28260002 BZ FT0055 IF NOT, BRANCH YM1088 28290002 ST WKREGB,EXLCORAD SET MODULE ADDR IN XLIST YM1088 28320002 B FT00601 BRANCH AROUND GETMAIN YM1088 28350002 FT0055 EQU * PREPARE FOR GETMAIN YM1088 28380002 L WKREGB,EXLCORSZ CORE SIZE OF MODULE 28410002 LA WKREGB,0(WKREGB) CLEAR HIGH BYTE 28440002 LA WKREGC,EXLCORAD LOC FOR GM TO STORE CORE ADDR 28470002 TM WKATTR+1,PDS2ORG0 IS TXT ORG AT ZERO ? Y02081 28500002 BZ FT006 NO, SKIP PAGE ALIGN TEST 28530002 TM WKTXORG,PDS2PAGA IS PAGE ALIGNMENT REQ'D ? Y02081 28560002 BZ FT006 NO,BRANCH FOR NORMAL GM 28590002 * YES,GM ON A PAGE BOUNDARY 28620002 GETMAIN EC,MF=(E,XGMLIST),LV=(WKREGB),A=(WKREGC), *28650002 SP=(IDREG),BNDRY=PAGE 28680002 LTR CODEREG,CODEREG TEST GETMAIN SUCCESSFUL Y02081 28710002 BNZ FT027C IF NOT, RETURN WITH RC=12 Y02081 28740002 SPACE 28770002 B FT00601 BYPASS NORMAL GETMAIN 28800002 SPACE 28830002 FT006 EQU * PERFORM NON-PAGE BOUNDARY GETMAIN 28860002 GETMAIN EC,MF=(E,XGMLIST),LV=(WKREGB),A=(WKREGC), *28890002 SP=(IDREG),BNDRY=DBLWD 28920002 LTR CODEREG,CODEREG TEST GETMAIN SUCCESSFUL Y02081 28950002 BNZ FT027C IF NOT, RETURN WITH RC=12 Y02081 28980002 SPACE 29010002 FT00601 EQU * CONTINUE INITIALIZATION 29040002 MVI EXLADIND,ADIND SET ADDR FLAG IN XLIST 29070002 MVC FTRPTR,EXLCORAD SAVE CORE ADDR AS THE RELOC 29100002 * FACTOR FOR LOAD MODULE. 29130002 * INITIALIZE THE NOTE LIST PREFIX- 29160002 TM WKATTR,PDS2OVLY IS MODULE IN OVERLAY ? Y02081 29190002 BZ FT00701 BRANCH NOT OVLY TO FIRST READ 29220002 MVC NLRELFAC,FTRPTR MOVE RELOC FACTOR INTO NL 29250002 MVC NLCORSIZ,WKLNTH SAVE MOD CORE SIZE IN NL Y02081 29280002 MVC NLCONCAT,WKTTRN+3 SAVE CONCAT NUMBER IN NL Y02081 29310002 SPACE 29340002 * PREPARE FOR READING NOTE LIST TTR ENTRIES- 29370002 STH WKREGD,FTCPSRCH+SRCHTIC+CCWLEN PUT NL SIZE INTO 29400002 * CCW FOR NL READ 29430002 LA WKREGA,NLENTRYS LOC OF NL 29460002 ST WKREGA,FTCPSRCH+SRCHTIC NL ADDR INTO READ CCW 29490002 MVI FTCPSRCH+SRCHTIC,READOP SET READ COMMAND CODE 29520002 SPACE 29550002 XC XLOFIX,XLOFIX CLEAR PAGE-FIX REQUIREMENTS 29580002 ST WKREGA,XTXTAD SET READ LOC FOR CCW XLATE FN 29610002 AR WKREGA,WKREGD ADD LENGTH TO START OF NL Y02081 29640002 ST WKREGA,XNEXTLOC SAVE AS HIGH ADDR FOR FIX Y02081 29670002 LA WKREGA,FTCPSRCH+SRCHTIC LOC OF READ CCW 29700002 ST WKREGA,XCCWAD SAVE FOR CCW XLATE FN 29730002 * OI XFLAG1,SYNRDFLG DENOTE SYNC-READ AND 29760002 * NEW I/O FOR XLATE FN. 29790002 ICM WKREGF,B'1110',WKTTESD+4 EXTRACT TTR FOR NL Y02081 29820002 IC WKREGF,WKTTRN+3 INCLUDE CONCAT NUMBER Y02081 29850002 TM XFLAG1,VAMDEV IS THIS A VAM DS? 29860002 BO FTVAM01 YES GO ISSUE I/O FOR VAM 29870002 BAL WKREGE,CVRTSET GO CONVERT TTRC TO ABSOLUTE 29880002 MVC FTSKBUF1+CCHHR(5),FTIOBSK+CCHHR MOVE CCHHR FOR Y02081 29910002 * NOTELIST READ Y02081 29920002 L WKREGA,XIOSBAD GET IOSB ADDRESS Y02081 29940002 USING IOSB,WKREGA ADDRESSABILITY FOR IOSB Y02081 29970002 MVC IOSEEK,FTIOBSK SET IOSB STATIC SEEK ADDR Y02081 30000002 DROP WKREGA DROP IOSB BASE Y02081 30030002 LA WKREGA,FTSKBUF1+CCHHR GET ADDR OF CCHHR FOR NL Y02081 30060002 STCM WKREGA,ADDR,FTCPSRCH+SRCHCCW SET SRCH ADR FOR NL Y02081 30090002 SPACE 30120002 * NI XFLAG1,ALL-SYNRDFLG CLEAR SYNC-READ CONDITION 30150002 DROP LISTREG DROP EXTENT LIST BASE 30180002 * 30210002 * PREPARE TO READ FIRST MODULE RECORD. 30240002 * 30270002 FT00701 EQU * CHANNEL PROGRAM SETUP 30280002 TM XFLAG1,VAMDEV IS THIS A VAM DS? 30290002 BO FTVAM021 YES GET TTR FOR VAM DS 30292002 ICM WKREGF,B'1110',WKTTESD TTR FOR FIRST TEXT Y02081 30300002 IC WKREGF,WKTTRN+3 CONCAT FACTOR Y02081 30330002 BAL WKREGE,CVRTSET TO CONVERT RTN SET UP 30360002 CLI FTCPSRCH+SRCHTIC,READOP READING THE NOTELIST? Y02081 30390002 BE FT00702 IF SO, BYPASS TIC SETUP Y02081 30420002 LA WKREGA,FTCP1 POINT TO 1ST CHAN PROG Y02081 30450002 STCM WKREGA,ADDR,FTCPSRCH+SCHTICAD STORE TIC TO LOC Y02081 30480002 L WKREGA,XIOSBAD GET IOSB ADDRESS Y02081 30510002 USING IOSB,WKREGA ADDRESSABILITY FOR IOSB Y02081 30540002 MVC IOSEEK,FTIOBSK SET IOSB STATIC SEEK ADDR Y02081 30570002 DROP WKREGA DROP IOSB BASE Y02081 30600002 FT00702 EQU * CONTINUE SETUP FOR 1ST READ Y02081 30630002 L WKREGA,FTRPTR POINT TO START OF MOD IN CORE 30660002 TM WKATTR+1,PDS2ORG0 TEST ED ASSIG ORIGN FOR 0 Y02081 30690002 BC 1,FT008 BRANCH NOT ZERO 30720002 L WKREGB,WKTXORG ORIGN OF FIRST TEXT Y02081 30750002 SRL WKREGB,8 SHIFT OUT EXTRA BYTE 30780002 AR WKREGA,WKREGB ADD RELOC FACTOR TO ORIGIN 30810002 FT008 STCM WKREGA,ADDR,FTCP1+CCWADR RELOC ORIGIN TO CH PGM Y02081 30840002 MVC FTCP1+6(2),WKLNTH+3 COUNT OF FIRST TEXT TO CP Y02081 30870002 SPACE 30900002 * PLACE TEXT-READ DATA IN THE SIO TRANSLATE TABLE. 30930002 * (BYPASS IF WE ARE GOING TO READ THE NOTELIST) Y02081 30960002 * 30990002 CLI FTCPSRCH+SRCHTIC,READOP READING THE NOTELIST? Y02081 31020002 BE FT00801 IF SO, BYPASS TRANS SETUP Y02081 31050002 ST WKREGA,XTXTAD ADDRESS OF DATA READ 31080002 LA WKREGB,FTCP1 GET TXT-READ CCW 31110002 ST WKREGB,XCCWAD ADDRESS OF CCW TO XLATE 31140002 AH WKREGA,FTCP1+CCWLEN ADD READ COUNT TO READ LOC 31170002 ST WKREGA,XNEXTLOC SAVE AS DEFAULT TEXT POINTER 31200002 FT00801 EQU * CONTINUE SETUP FOR 1ST READ Y02081 31230002 SPACE 31260002 * INITIALIZE MODULE LIMIT VALUES FOR VALIDITY CHECKING. 31290002 MVC XSOMAD,FTRPTR SAVE START-OF-MODULE LOC 31320002 L WKREGB,WKLNTH GET MODULE SIZE 31350002 SRL WKREGB,8 SHIFT TO RIGHT JUSTIFY 31380002 A WKREGB,FTRPTR ADD START-OF-MODULE LOC 31410002 ST WKREGB,XEOMAD SAVE AS END-OF-MODULE LOC 31440002 * DENOTE AN ACTIVE READ-TEXT CCW IS IN CURRENT CHANL PGM. 31470002 OI XFLAG1,ACTXTFLG SET ON TXT-RD INDICATOR 31500002 * 31530002 * TEST MODULE ATTRIBUTES FOR ONLY ONE TEXT RECORD 31560002 * AND NO RLD. 31590002 * 31620002 TM WKATTR,PDS21BLK TEST 1 TXT NO RLDS 31650002 BZ FT009 BRANCH MULTI RECS 31680002 MVI FTCP1+CCWFLG,ALL-ALL CLEAR CC 31710002 MVI FTFLG4,ALL SET LAST INDICATOR 31740002 * OI XFLAG1,SYNRDFLG TURN ON SYNC READ FLAG 31770002 OI XFLAG2,ONETXT SET 1 TXT NO RLD FLAG Y02081 31800002 FT009 EQU * CONTINUE WITH MAINLINE CODE 31830002 SPACE 31860002 * 31890002 *-------- END OF INITIALIZATION FOR PROGRAM MANAGER. 31920002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...MAIN LINE' 31950002 * 31980002 * MAINLINE ROUTINE FOR LOADING MODULE RECORDS. 32010002 * 32040002 SPACE 32070002 FT010 EQU * START OF MAINLINE CODE Y02081 32100002 * 32130002 * PREPARE PAGE FIX LIMITS FOR I/O REQUEST. 32160002 * 32190002 CLI FTCPSRCH+SRCHTIC,READOP READING THE NOTELIST? Y02081 32220002 BNE FT010A1 BRANCH IF NOT Y02081 32250002 L WKREGA,XTXTAD GET NOTELIST START ADDR Y02081 32280002 ST WKREGA,XLOFIX USE AS START ADDR FOR FIX Y02081 32310002 L WKREGA,XNEXTLOC GET NOTELIST END ADDR Y02081 32340002 B FT010D BYPASS VALIDITY CHECK Y02081 32370002 FT010A1 EQU * CONTINUE SETUP FOR PGFIX Y02081 32400002 TM XFLAG1,ACTXTFLG IS A TXT-READ ACTIVE IN CP ? 32430002 BO FT010B IF SO, GO BUILD FIX UPON IT 32460002 L WKREGA,XNEXTLOC BASE FIX REQ ON DEFAULT PTR 32490002 C WKREGA,XEOMAD IS DEFAULT PTR WITHIN MODULE 32520002 BNL FT010A BRANCH IF NOT 32550002 ST WKREGA,XLOFIX SET LOWER BNDRY 32580002 A WKREGA,FIXLIMTM ADD LIMIT TO GE UPPER BNDRY 32610002 B FT010C GO ADJUST UPPER BNDRY TO PG 32640002 * SET UP FOR NO FIX IN TEXT AREA. 32670002 FT010A XC XLOFIX,XLOFIX CLEAR FIX REQUIREMENTS 32700002 XC XHIFIX,XHIFIX CLEAR FIX REQUIREMENTS 32730002 B FT010Z GO REQUEST I/O 32760002 SPACE 32790002 * SET UP FIX BASED ON CURRENT TEXT RECORD (IN TRANSLATE TABLE). 32820002 FT010B L WKREGA,XTXTAD TEXT RECORD ADDRESS 32850002 C WKREGA,XSOMAD IS IT WITHIN MODULE LIMITS ? 32880002 BL FT027E BRANCH IF NOT VALID 32910002 C WKREGA,XEOMAD ADDR IN MODULE LIMITS ? 32940002 BNL FT027E BRANCH NOT VALID 32970002 ST WKREGA,XLOFIX SAVE LOWER FIX BNDRY 33000002 L WKREGA,XNEXTLOC GET END OF REC ADDR 33030002 C WKREGA,XEOMAD IS IT WITHIN MODULE ? 33060002 BNH FT010B5 BRANCH IF VALID ZM0130 33090003 * INVALID ADDRESS-GO GIVE 106E 33100003 XC XLOFIX,XLOFIX CLEAR PGFIX REQMENTS ZM0130 33110003 B FT027E GO GIVE 106E ZM0130 33112003 FT010B5 EQU * 33114003 L WKREGA,XTXTAD GET RECORD ADDR 33120002 A WKREGA,FIXLIMTM ADD MAX FIX RANGE 33150002 C WKREGA,XNEXTLOC DOES MAX RANGE COVER THE REC ? 33180002 BH FT010C IF YES,BRANCH 33210002 L WKREGA,XNEXTLOC IF NOT,USE END OF REC INSTEAD 33240002 SPACE 33270002 * ADJUST UPPER BOUNDARY TO NEXT PAGE ADDRESS. 33300002 FT010C BCTR WKREGA,0 POINT TO ACTUAL LAST BYTE 33330002 A WKREGA,PAGESIZM BUMP TO NEXT PAGE LOC 33360002 N WKREGA,PAGEMSKM TRUNC TO PRIOR PAGE BNDRY 33390002 C WKREGA,XEOMAD DOES RESULT EXCEED END OF MOD 33420002 BL FT010D BRANCH IF WITHIN MODULE 33450002 L WKREGA,XEOMAD EOM IS EXCEEDED SO USE EOM 33480002 FT010D ST WKREGA,XHIFIX STORE UPPER FIX BOUNDARY 33510002 * 33540002 * INITIATE THE I/O REQUEST. 33570002 * 33600002 FT010Z EQU * SETUP FOR STARTIO 33610002 * OI XFLAG1,NEWIOFLG SET FRESH I/O INDICATOR 33630002 L WKREGA,XLOFIX GET START ADDR FOR FIX Y02081 33660002 L WKREGB,XHIFIX GET END ADDR FOR TEXT FIX Y02081 33690002 LTR WKREGA,WKREGA ANYTHING TO FIX? Y02081 33720002 BZ FT010E IF NOT, BRANCH AROUND Y02081 33750002 XC FTFXECB,FTFXECB CLEAR ECB FOR PGFIX Y02081 33780002 LA WKREGF,FTFXECB POINT TO ECB FOR PGFIX Y02081 33810002 PGFIX R,A=(1),EA=(2),ECB=(0),LONG=N FIX TEXT PAGES Y02081 33840002 CLM CODEREG,PGMASK,PGFXDONE PGFIX COMPLETE? @ZA07064 33870037 BNE FT010Z1 BRANCH IF PGFIX COMP @ZA07064 33875037 WAIT 1,ECB=FTFXECB WAIT FOR PGFIX COMPLETION Y02081 33880037 * TEST IF PAGES REALLY FIXED @ZA07064 33885037 FT010Z1 TM ECBERRIN,X'04' ERROR BIT ON IN ECB @ZA07064 33890037 BO FT027E BRANCH IF ERROR @ZA07064 33895037 SPACE 33900002 FT010E EQU * CONTINUE I/O SETUP Y02081 33930002 SPACE 33932002 ********************************************************************** 33940002 * * 33950002 * FIX THE ROUTINE USED AS THE DISABLED * 33952002 * INTERRUPT EXIT FROM IOS. 33954002 * * 33956002 L WKREGA,FTPCIADD GET START ADDR FOR FIX Y21179 33958002 L WKREGB,FTFXADDR GET END ADDR FOR FIX Y21179 33958402 L WKREGC,CVTPTR GET CVT ADDRESS @ZA05457 33958837 USING CVT,WKREGC CVT ADDRESSABILITY @ZA05457 33959837 CLM WKREGB,B'0111',CVTNUCB+1 DIE RTN IN FIXED LPA? @ZA05457 33960837 DROP WKREGC @ZA05457 33961837 BNH FT010F BRANCH IF IN FIXED LPA @ZA05457 33962837 SPACE 33963837 XC FTFXECB,FTFXECB CLEAR ECB FOR FIX Y21179 33964837 LA WKREGF,FTFXECB POINT TO ECB FOR FIX Y21179 33965837 SPACE 33966837 PGFIX R,A=(1),EA=(2),ECB=(0),LONG=N FIX DIE ROUTINE Y21179 33967837 CLM CODEREG,PGMASK,PGFXDONE IS PGFIX COMP? @ZA07064 33968837 BNE FT010E1 BRANCH IF PGFIX COMP @ZA07064 33969837 SPACE 2 33970837 WAIT 1,ECB=FTFXECB WAIT FOR PGFIX TO COMPLETE 33971837 * TEST IF PAGES REALLY FIXED @ZA07064 33972837 FT010E1 TM ECBERRIN,X'04' ERROR BIT ON IN ECB? @ZA07064 33973837 BO FT027E BRANCH IF ERROR @ZA07064 33974837 SPACE 2 33975837 ****** ****** 33976837 * THE LOCAL LOCK IS OBTAINED AT THIS POINT TO GUARANTEE * 33990002 * THAT THE MEMORY FETCH IS RUNNING UNDER CANNOT BE SWAPPED * 34020002 * OUT. IF THIS WERE NOT DONE THE REAL ADDRESSES OF THE * 34050002 * DATA AREAS REFERENCED BY THE FETCH CHANNEL PROGRAMS COULD * 34080002 * CHANGE BECAUSE OF A SWAP-OUT BEFORE THE I/O WAS INIATED * 34110002 * AND THE CHANNEL PROGRAMS WOULD BE IN ERROR. Y02081 * 34140002 ****** ****** 34170002 SPACE 34200002 FT010F LR WKREGD,FTBASE1 SAVE FETCH BASE REG Y02081 34230037 LR WKREGC,FTBASE2 SAVE WORK AREA BASE Y02081 34260002 GETLCK SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, X34290002 RELATED=(FTLOCLK,IEWFETCH(FREELCK)) Y02081 34320002 LR FTBASE1,WKREGD RESTORE FETCH BASE REG Y02081 34350002 LR FTBASE2,WKREGC RESTORE WORK AREA BASE Y02081 34380002 SPACE 34410002 ****** ****** 34440002 * AT THIS POINT THE VIRTUAL ADDRESSES IN THE FETCH CHANNEL * 34470002 * PROGRAMS CAN SAFELY BE TRANSLATED TO REAL ADDRESSES. THE * 34500002 * PAGES REFERENCED HAVE ALL BEEN FIXED AND THE LOCAL LOCK * 34530002 * IS HELD TO PREVENT SWAP-OUTS. Y02081 * 34560002 ****** ****** 34590002 LA WKREGA,FTCPSRCH POINT TO THE SEARCH CP Y02081 34620002 LA WKREGB,CPSRCHCT SET CCW COUNT FOR TRANS Y02081 34650002 BAL WKRG12,FTINTRN GO TO TRANSLATE IT Y02081 34680002 LA WKREGA,FTCP1+CCWSZ POINT TO 2ND CCW IN CP1 Y02081 34710002 LA WKREGB,CP1CT SET CCW COUNT FOR CP1 Y02081 34740002 BAL WKRG12,FTINTRN GO TO TRANSLATE IT Y02081 34770002 LA WKREGA,FTCP2+CCWSZ POINT TO 2ND CCW IN CP2 Y02081 34800002 LA WKREGB,CP2CT SET CCW COUNT FOR CP2 Y02081 34830002 BAL WKRG12,FTINTRN GO TO TRANSLATE IT Y02081 34860002 LA WKREGA,FTCP3+CCWSZ POINT TO 2ND CCW IN CP3 Y02081 34890002 LA WKREGB,CP3CT SET CCW COUNT FOR CP3 Y02081 34920002 BAL WKRG12,FTINTRN GO TO TRANSLATE IT Y02081 34950002 STM WKRG7,WKRG10,FTREGSV SAVE REGISTERS 7 - 10 Y02081 34980002 BAL WKRG12,FTTRN01 TRANSLATE THE READTXT CCW Y02081 35010002 LM WKRG7,WKRG10,FTREGSV RESTORE REGISTERS 7 - 10 Y02081 35040002 SPACE 2 35050002 EJECT 35079902 ********************************************************************** 35089902 * INITIALIZE THE PURGE AND END OF EXTENT ROUTINE * 35093202 * ADDRESSES IN THE VOID. * 35095202 ********************************************************************** 35095602 SPACE 35096002 L WKREGB,CVTPTR GET CVT ADDR Y21179 35096102 USING CVT,WKREGB CVT ADDRESSABILITY Y21179 35096202 L WKREGA,CVTIXAVL GET POINTER TO IOSCOM Y21179 35096402 LA WKREGA,0(WKREGA) CLEAR HI ORDER BYTE Y21179 35096502 DROP WKREGB DROP CVT BASE Y21179 35097602 USING IOCOM,WKREGA IOSCOM ADDRESSABILITY Y21179 35100002 L WKREGB,IOCVOID GET ADDRESS OF VOID Y21179 35104902 LA WKREGB,0(WKREGB) CLEAR HI ORDER BYTE Y21179 35106902 DROP WKREGA DROP IOCOM BASE 35108902 L WKREGA,PURGERTN GET ADDR OF PURGE Y21179 35111302 ST WKREGA,VOIDFTPG(WKREGB) INIT VOID PURGE ADDR Y21179 35112902 L WKREGA,EOXRTN GET ADDR OF EOX RTN Y21179 35115302 ST WKREGA,VOIDFTXK(WKREGB) INIT VOID EOX ADDR Y21179 35122602 EJECT 35132102 *********************************************************************** 35141402 * ISSUE THE STARTIO MACRO TO INITIATE IOS PROCESSING OF THE * 35150702 * FETCH I/O REQUEST AS A SYSTEM EVENT (DRIVEN BY AN SRB) * 35160002 * Y02081 * 35190002 *********************************************************************** 35220002 SPACE 35250002 XC FTECB,FTECB CLEAR FETCH I/O ECB Y02081 35280002 L WKREGA,XIOSBAD GET IOSB ADDRESS Y02081 35310002 USING IOSB,WKREGA IOSB ADDRESSABILITY Y02081 35340002 MVC IOSEEKA,IOSEEK SET IOSB DYNAMIC SEEK Y02081 35370002 * 35400002 *------ PLACE REAL AND VIRTUAL POINTERS TO THE FETCH CHANNEL Y02081 35430002 * PROGRAM IN THE IOSB Y02081 35460002 * 35490002 LRA WKREGB,FTCPSRCH+CCWSZ REAL ADDR OF CHAN PROG Y02081 35520002 ST WKREGB,IOSRST SET CP REAL ADDR IN IOSB Y02081 35550002 LA WKREGB,FTCPSRCH+CCWSZ VIRTUAL ADDR OF CHAN PROG Y02081 35580002 ST WKREGB,IOSVST SET CP VIRT ADDR IN IOSB Y02081 35610002 DROP WKREGA DROP IOSB BASE Y02081 35640002 LA WKREGA,IOSBSIZE(WKREGA) GET SRB POINTER Y02081 35670002 LR WKREGB,FTBASE2 SAVE WORK AREA BASE Y02081 35700002 L FTBASE2,PSAAOLD GET ASCB POINTER Y02081 35730002 L FTBASE2,ASCBASXB-ASCB(FTBASE2) GET ASXB POINTER Y02081 35760002 USING ASXB,FTBASE2 ADDRESSABILITY FOR ASXB Y02081 35790002 STM WKRG14,WKRG12,ASXBFLSA+12 SAVE REGISTERS IN THE Y02081 35820002 * ASXB SAVE AREA ACROSS STARTIO Y02081 35850002 * CALL SO THERE IS NO CONFLICT Y02081 35880002 * WITH THE USE OF THE SAVE AREA Y02081 35910002 * IN THE FETCH WORK AREA BY THE Y02081 35940002 * ASYNCHRONOUS I/O APPENDAGE Y02081 36000002 * ROUTINES Y02081 36030002 STARTIO SRB=(1),TCB=0 INITIATE I/O Y02081 36060002 * 36090002 LM WKRG14,WKRG12,ASXBFLSA+12 RESTORE REGISTERS Y02081 36120002 SPACE 36150002 ****** ****** 36180002 * THE LOCAL LOCK CAN NOW BE RELEASED BECAUSE THE I/O HAS * 36210002 * BEEN SCHEDULED UNDER AN SRB AND, AS SUCH, THE MEMORY CANNOT * 36240002 * BE SWAPPED OUT UNTIL THE I/O IS COMPLETE AND THE SRB HAS * 36270002 * BEEN TERMINATED. Y02081 * 36300002 ****** ****** 36330002 SPACE 36360002 LR WKREGA,FTBASE1 SAVE FETCH BASE REG Y02081 36390002 FREELCK SETLOCK RELEASE,TYPE=LOCAL, X36420002 RELATED=(FTLOCLK,IEWFETCH(GETLCK)) Y02081 36450002 LR FTBASE1,WKREGA RESTORE FETCH BASE REG Y02081 36480002 LR FTBASE2,WKREGB RESTORE WORK AREA BASE Y02081 36510002 USING WKFETCH,FTBASE2 RESET WORK AREA BASE REG Y02081 36540002 SPACE 36570002 WAIT 1,ECB=FTECB WAIT FOR I/O COMPLETION Y02081 36600002 * (POSTED BY SRB EXIT RTN) Y02081 36630002 * 36660002 TM XFLAG2,CPLOOP WAS CHAN PROG LOOP DETECTED Y02081 36670002 * IN NORMAL END EXIT? Y02081 36680002 BZ FT011 IF NOT, CONTINUE Y02081 36682002 * IF A CHANNEL PROGRAM LOOP HAS BEEN DETECTED, ISSUE A C0D Y02081 36684002 * ABEND TO CAUSE INVOKATION OF FETCH'S ESTAE EXIT ROUTINE Y02081 36686002 ABEND X'C0D',,STEP,SYSTEM ISSUE THE ABEND Y02081 36688002 FT011 EQU * CONTINUE TESTING FOR ERRORS Y02081 36690002 TM XFLAG2,BADREC WAS AN INVALID RECORD Y02081 36720002 * TYPE FOUND? Y02081 36750002 BO FT027D IF SO, TERMINATE Y02081 36780002 TM XFLAG1,RELERR WAS AN INVALID RLD Y02081 36810002 * ADDRESS FOUND? Y02081 36840002 BO FT027E IF SO, TERMINATE Y02081 36870002 TM XFLAG2,CTLERR WAS A BAD CTL REC ADDR FOUND? Y02081 36880002 BO FT027E IF SO, TERMINATE Y02081 36890002 * 36900002 CLI FTECB,X'7F' TEST I/O COMPLETION CODE Y02081 36930002 BNE FT027F BRANCH ON ANY ERROR Y02081 36960002 TM XFLAG2,ONETXT 1 TXT NO RLDS? Y02081 36990002 BO FT027 IF SO, TERMINATE Y02081 37020002 L WKRG3,FTLASTBF POINT TO LAST TABLE ENTRY Y02081 37050002 LTR WKRG3,WKRG3 WAS THERE ANY? Y02081 37080002 BZ FT027 IF NOT, TERMINATE Y02081 37110002 L WKREGA,TBLBUFAD(WKRG3) POINT TO LAST BUFFER Y02081 37140002 TM 0(WKREGA),TSTBITS TEST INVALID RECORD TYPE Y02081 37170002 BNZ FT027D IF FOUND, BRANCH Y02081 37200002 STM WKRG0,WKRG15,FTREGSV SAVE REGISTERS Y02081 37230002 LR WKBASE,FTBASE2 SET WORKAREA BASE FOR Y02081 37260002 * THE RELOCATE SUBROUTINE Y02081 37290002 L CODEREG,RELOCAD POINT TO RELOCATE SUBRTN Y02081 37320002 BALR LINKREG,CODEREG LINK TO RELOCATE SUBRTN Y02081 37350002 LM WKRG0,WKRG15,FTREGSV-WKFETCH(WKBASE) RESTOR REGS Y02081 37380002 TM XFLAG1,RELERR BAD ADDR FOUND BY RELOC? Y02081 37410002 BO FT027E IF SO, BRANCH Y02081 37440002 B FT027 IF NOT, GO TO NORMAL Y02081 37470002 * FETCH TERMINATION Y02081 37500002 SPACE 2 37530002 RELOCAD DC A(DIERELOC) ADDR OF RELOCATE SUBRTN Y02081 37560002 PURGERTN DC A(IEWFTPRG) ADDR OF PURGE ROUTINE Y21179 37562002 EOXRTN DC A(IEWFTXCK) ADDR OF EOX ROUTINE Y21179 37564002 FTFXADDR DC A(FTFXEND) ADDR OF DIE FIX END Y21179 37566002 FTPCIADD DC A(FTPCI01) ADDR OF DIE FIX START Y21179 37568002 EJECT 37570002 *********************************************************************** 37580002 * 37582002 * THIS ROUTINE WILL ISSUE THE I/O FOR VAM DATA SETS. IT WILL 37584002 * ISSUE AN EXCP TO READ THE NOTE LIST AND ANOTHER EXCP FOR 37586002 * THE READING OF THE MODULE TEXT. THE I/O OPERATION FOR 37588002 * VAM DATA SETS APPEARS NAD ACTS JUST AS A REGULAR EXCP. 37588402 * Y02081 37588802 SPACE 37589202 FTVAM01 EQU * START OF VAM MAINLINE CODE Y02081 37589302 SPACE 37589402 * SET UP FOR AND GO TO TTR CONVERT FOR NOTELIST CONVERT. 37589502 SPACE 37591202 L WKREGA,FTIOB+TWENTY GET THE DCB ADDRESS Y02081 37591602 L WKREGA,DCBDEBAD(WKREGA) GET THE DEB ADDRESS Y02081 37592002 LA WKREGA,0(WKREGA) CLEAR HI BYTE Y02081 37592102 SPACE 37592402 BAL WKREGE,CVRTSET1 GO CONVERT TTR Y02081 37592802 SPACE 37592902 * READ THE NOTELIST 37594702 SPACE 37596702 XC FTECB,FTECB CLEAR ECB Y02081 37597302 LA WKREGA,FTIOB ADDRESS OF IOB Y02081 37599102 SPACE 37600902 SVC EXCP ISSUE I/O FOR NOTE LIST Y02081 37602702 SPACE 2 37604502 WAIT 1,ECB=FTECB WAIT ON I/O COMPLETION Y02081 37606302 SPACE 2 37608102 TM FTECB,IOERRBT I/O ERROR OCCUR? Y02081 37609902 BZ FT027F BR TO INDICATE I/O ERROR Y02081 37613202 SPACE 37615202 * UPDATE THE CHANNEL PROGRAM FROM READ THE NOTELIST TO READ 37615402 * A TEXT RECORD. 37615802 SPACE 37615902 LA WKREGA,FTCP1 ADDRESS OF READ TEXT CCW Y02081 37616002 STCM WKREGA,ADDR,FTCPSRCH+SRCHTIC+CCWADR UPDATE Y02081 37616202 * SEARCH CHAN PROG TO READ TEXT Y02081 37616302 MVI FTCPSRCH+SRCHTIC,TIC MAKE IT 31-08-08 Y02081 37616602 FTVAM021 EQU * SETUP FOR 1ST TEXT READ Y02081 37617602 L WKREGA,FTRPTR GET RELOC FACTOR Y02081 37618202 ST WKREGA,XSOMAD SET UP MODULE START Y02081 37618602 SR WKREGB,WKREGB RESET Y02081 37618702 ICM WKREGB,ADDR,WKLNTH GET MODULE SIZE Y02081 37622102 AR WKREGB,WKREGA GET END OF MODULE Y02081 37624102 ST WKREGB,XEOMAD AND SET UP MODULE END Y02081 37626102 SPACE 37626502 TM WKATTR+1,PDS2ORG0 TEST ED ASSIGN ORIG FOR 0 Y02081 37627802 BO FTVAM03 BRANCH IF ZERO Y02081 37631202 L WKREGB,WKTXORG ORIGIN OF FIRST TEXT Y02081 37634602 SRL WKREGB,8 SHIFT OUT EXTRANEOUS BYTE Y02081 37636602 AR WKREGA,WKREGB ADD RELOCATION FACTOR Y02081 37638002 SPACE 37641402 FTVAM03 EQU * @ZA26964 37644837 CLM WKREGA,ADDR,XSOMAD+VAMTXTAD WITHIN LOWER LIMIT @ZA26964 37645237 BL FT027E BRANCH IF NOT @ZA26964 37645637 CLM WKREGA,ADDR,XEOMAD+VAMTXTAD WITHIN UPPER LIMIT @ZA26964 37646037 BNL FT027E BRANCH IF NOT @ZA26964 37646437 STCM WKREGA,ADDR,FTCP1+VAMTXTAD RELOC ORIGIN @ZA26964 37646837 * TO CH PGM @ZA26964 37647237 MVC FTCP1+VAMCNT(L'PDS2FTBL),WKLNTH+3 COUNT OF Y02081 37648202 * FIRST TEXT BLOCK TO CH PGM Y02081 37650202 SPACE 37650602 * SET UP AND GO TO CONVERT THE FIRST RECORD TTR 37651002 SPACE 37651402 ICM WKREGF,B'1110',WKTTESD GET TTR FOR RD TXT Y02081 37651602 IC WKREGF,WKTTRN+3 CONCAT FACTOR Y02081 37655002 TM WKATTR,PDS21BLK IS MODULE SINGLE TEXT RECORD Y02081 37655102 * WITH NO RLD'S? Y02081 37655202 BZ FTVAM04A IF NOT, BRANCH AROUND Y02081 37655302 MVI FTCP1+VAMFLAGS,ALL-ALL TURN OFF COMMAND CHAINING Y02081 37658402 * IN READ TEXT CCW FLAGS Y02081 37660402 B FTVAM04A BRANCH AROUND OVLY SUP SETUP Y02081 37664602 FTVAM04 EQU * CALLER IS OVLY SUPV Y02081 37667702 LA WKREGA,FTCP1+VAMRDRLD POINT TO READ RLD CCW Y02081 37670802 STCM WKREGA,ADDR,FTCPSRCH+SRCHTIC+CCWADR SET TO READ Y02081 37673902 * A CONTROL RECORD FIRST WHEN Y02081 37677002 * LOADING AN OVERLAY SEGMENT Y02081 37680102 FTVAM04A EQU * GET SEEK ADDR FOR 1ST READ Y02081 37683202 L WKREGA,FTIOB+TWENTY GET DCB ADDR Y21179 37686302 L WKREGA,DCBDEBAD(WKREGA) GET DEB ADDR Y21179 37689402 LA WKREGA,0(WKREGA) CLEAR HI ORDER BYTE Y21197 37692502 BAL WKREGE,CVRTSET1 TO CONVERT ROUTINE FOR VAM Y02081 37695602 SPACE 37698702 * READ THE FIRST RECORD. 37701802 SPACE 37704902 MVI FTECB,REC0 INITIALIZE ECB Y02081 37708002 LA WKREGA,FTIOB GET IOB ADDRESS Y02081 37711102 SPACE 37714202 SVC EXCP ISSUE I/O FOR READ TEXT Y02081 37717302 SPACE 2 37720402 TM FTECB,X'40' ECB POSTED COMP? @ZA12206 37723537 BC 1,FTVAM04B BRANCH IF YES @ZA12206 37724537 WAIT 1,ECB=FTECB WAIT ON I/O COMPLETION Y02081 37725537 SPACE 37726537 FTVAM04B TM FTECB,IOERRBT I/O ERROR OCCUR? Y02081 37727537 BZ FT027F YES GO TO ERROR Y02081 37732802 TM XFLAG2,BADREC INVALIK REC TYPE? Y02081 37735902 BC 1,FT027D YES, ISSUE CODE Y02081 37739002 TM XFLAG1,RELERR INVALID ADDRESS? Y02081 37742102 BO FT027E ISSUE INVLD ADDR CODE Y02081 37745202 B FT027 POST SUCCESSFUL LOAD Y02081 37748302 EJECT 37751402 *********************************************************************** 37754502 * SUBROUTINE TO TRANSLATE TEXT READ CCW * 37757602 * TEST THE TEXT READ CCW TO DETERMINE IF AN INDIRECT ADDRESS * 37760702 * LIST IS REQUIRED (TEXT WILL CROSS PAGE BOUNDARIES WHEN READ) * 37763802 * IF SO, BUILD THE IDAL AND POINT THE CCW TO IT; IF NOT, SET * 37766902 * THE REAL ADDRESS OF THE TEXT READ-IN AREA INTO THE CCW. * 37770002 * REGISTER USAGE: * 37800002 * REGS 7 - 10 USED AS WORK REGISTERS * 37830002 * REG 11 IS BASE REGISTER =A(FT001) * 37860002 * REG 12 IS RETURN REGISTER * 37890002 * REG 13 IS WORK AREA BASE REGISTER * 37920002 * Y02081 * 37950002 *********************************************************************** 37980002 SPACE 2 38010002 FTTRN01 L WKRG9,XCCWAD LOAD CCW PTR FROM TRN TBL Y02081 38040002 L WKRG10,XTXTAD LOAD TXT PTR FROM TRN TBL Y02081 38070002 LTR WKRG7,WKRG10 TEST NO CCW TO PROCESS Y02081 38100002 BZ FTTRN06 BRNCH NO CCW TO TRANSLATE Y02081 38130002 AH WKRG7,CCWLEN(WKRG9) POINT TO END OF TEXT LOC Y02081 38160002 BCTR WKRG7,0 POINT TO LAST BYTE OF TXT Y02081 38190002 N WKRG7,PAGEMSKM ADJST TO PRIOR PAGE BNDRY Y02081 38220002 CR WKRG7,WKRG10 IS TXT REC IN ONE PAGE? Y02081 38250002 BH FTTRN04 BRNCH IF PAGE IS CROSSED Y02081 38280002 SPACE 38310002 * SET UP CCW WITH ACTUAL DATA ADDRESS. 38340002 LRA WKRG7,0(WKRG10) GET REAL ADDR OF TEXT Y02081 38370002 STCM WKRG7,ADDR,CCWADR(WKRG9) STORE IN CCW Y02081 38400002 NI CCWFLG(WKRG9),ALL-IDALFLAG TURN OFF IDAL BIT Y02081 38430002 B FTTRN06 GO TO RETURN Y02081 38460002 SPACE 38490002 * SET UP CCW WITH IDAL ADDRESS. 38520002 FTTRN04 L WKRG8,XIDALP1 GET IDAL POINTER Y02081 38550002 LRA WKRG8,0(WKRG8) CONVERT POINTER TO REAL Y02081 38580002 STCM WKRG8,ADDR,CCWADR(WKRG9) STORE IN TEXT CCW Y02081 38610002 OI CCWFLG(WKRG9),IDALFLAG TURN ON IDAL BIT IN CCW Y02081 38640002 SPACE 38670002 * BUILD THE IDAL. 38700002 LR WKRG7,WKRG10 LOC OF TEXT RECORD Y02081 38730002 AH WKRG7,CCWLEN(WKRG9) ADD TXT SIZE FOR REC END Y02081 38760002 BCTR WKRG7,0 DECR TO LAST BYTE Y02081 38790002 N WKRG7,BLOKMSKM TRUNC TO GET LST 2K BNDRY Y02081 38820002 L WKRG8,XIDALP1 SET IDAL AREA POINTER Y02081 38850002 LRA WKRG9,0(WKRG10) READ ADDR OF TEXT RECORD Y02081 38880002 N WKRG10,BLOKMSKM ADJUST TO PRIOR 2K BNDRY Y02081 38910002 FTTRN05 ST WKRG9,0(WKRG8) STORE REAL ADDR IN IDAL Y02081 38940002 A WKRG10,BLOKSIZM INCR TO NEXT 2K BLOCK Y02081 38970002 CR WKRG10,WKRG7 IS IT PAST LST PAGE ADDR? Y02081 39000002 BH FTTRN06 IF SO, RETURN Y02081 39030002 LA WKRG8,IDALNTRY(WKRG8) BUMP TO NEXT IDAL WORD Y02081 39060002 LRA WKRG9,0(WKRG10) GET REAL ADR OF DATA PAGE Y02081 39090002 B FTTRN05 CONTINUE IDAL BUILD Y02081 39120002 FTTRN06 BR WKRG12 RETURN TO CALLER Y02081 39150002 EJECT 39180002 *********************************************************************** 39210002 * SUBROUTINE TO TRANSLATE INTERNAL CCW'S * 39240002 * TRANSLATES VIRTUAL ADDRESSES IN CCW'S TO REAL ADDRESSES -- * 39270002 * ONLY FOR CCW'S WHICH REFERENCE ADDRESSES WITHIN THE FETCH * 39300002 * WORK AREA (NO TEST IS MADE FOR CCW'S REQUIRING IDAL'S) * 39330002 * REGISTER USAGE: * 39360002 * REG 1 POINTS TO 1ST CCW TO BE TRANSLATED * 39390002 * REG 2 = NUMBER OF CCW'S TO BE TRANSLATED * 39420002 * REG 5 USED AS A WORK REGISTER * 39450002 * REG 12 IS THE RETURN REGISTER * 39480002 * Y02081 * 39510002 *********************************************************************** 39540002 SPACE 2 39570002 FTINTRN EQU * START OF CCW TRANSLATE SUBRTN Y02081 39600002 ICM WKREGC,ADDR,CCWADR(WKREGA) GET CCW ADDRESS Y02081 39630002 LRA WKREGC,0(WKREGC) TRANSLATE VIRTUAL TO REAL Y02081 39660002 STCM WKREGC,ADDR,CCWADR(WKREGA) SET REAL ADDR IN CCW Y02081 39690002 LA WKREGA,CCWSZ(WKREGA) POINT TO NEXT CCW Y02081 39720002 BCT WKREGB,FTINTRN LOOP UNTIL CCW COUNT IS Y02081 39750002 * EXHAUSTED Y02081 39780002 BR WKRG12 RETURN TO CALLER Y02081 39810002 EJECT 39840002 ********************************************************************** 39850002 * 39870002 * SUBROUTINE TO SET PARAMS. FOR TTR CONVERT RTN 39900002 * 39930002 ********************************************************************** 39940002 SPACE 39950002 CVRTSET STM FTBASETR,CODEREG,FTREGSV SAVE REGS FOR CONVERT RTN 39960002 L WKREGA,XIOSBAD GET IOSB ADDRESS Y02081 39990002 USING IOSB,WKREGA IOSB ADDRESSABILITY Y02081 40020002 L WKREGA,IOSDSID GET DEB ADDR FROM IOSB Y02081 40050002 DROP WKREGA DROP IOSB BASE Y02081 40080002 SPACE 40090002 B CVRTSET3 CONTINUE AROUND STORE YM5763 40100002 CVRTSET1 EQU * ENTRY FROM VAM MAINLINE YM5763 40102002 STM FTBASETR,CODEREG,FTREGSV SAVE VAM REGS YM5763 40104002 CVRTSET3 EQU * CONTINUE NON-VAM LOGIC YM5763 40106002 XC FTIOBSK(8),FTIOBSK ZERO IOB SEEK BUF 40110002 LA WKREGB,FTIOBSK IOB SEEK TO CONVERT RTN 40140002 L CODEREG,CVTPTR GET CVT PTR Y21179 40180002 USING CVT,CODEREG CVT ADDRESSABILITY Y21179 40182002 L CODEREG,CVTPCNVT ADDR OF CONVERT RTN Y21179 40184002 DROP CODEREG DROP CVT BASE Y21179 40186002 LR WKREGD,FTBASE2 SAVE WORKAREA BASE 40200002 BALR LINKREG,CODEREG TO CONVERT RTN 40230002 LTR CODEREG,CODEREG TEST SUCCESSFUL CONVERT Y02081 40260002 LM FTBASETR,CODEREG,FTREGSV-WKFETCH(WKREGD) RESTORE M022 40270002 BNZ FT027E IF NOT, TERMINATE FETCH WITH Y02081 40290002 * RC=14 (I/O ERROR WOULD RESULT Y02081 40320002 * FROM BAD SEEK ADDRESS) Y02081 40350002 * 40440037 * IF FIRST READ NOT FROM 1ST EXTENT, MUST UPDATE FILE MASK @ZA10266 40442037 * 40444037 CLC FTIOBSK(1),XTNTSAVE+1 CURRENT M VALUE = FIRST? @ZA10266 40446037 BE CVRTSET4 YES--BRANCH--FILE MASK OK@ZA10266 40448037 L WKREGA,XIOSBAD GET IOSB ADDRESS @ZA10266 40450037 USING IOSB,WKREGA IOSB ADDRESSABILITY @ZA10266 40452037 L WKREGB,IOSDSID DEB ADDRESS FROM IOSB @ZA10266 40454037 USING DEBBASIC,WKREGB DEB ADDRESSABILITY @ZA10266 40456037 SR WKREGD,WKREGD CLEAR REGISTER @ZA10266 40458037 IC WKREGD,FTIOBSK GET CURRENT M VALUE @ZA10266 40460037 SLL WKREGD,4 INDEX TO CURRENT EXTENT @ZA10266 40462037 LA WKREGC,DEBBASND-DEBBASIC(WKREGD,WKREGB) @ZA10266 40464037 USING DEBDASD,WKREGC ADDRESSABILITY CURR EXT @ZA10266 40465037 MVC IOSFMSK(1),DEBDVMOD UPDATE FILE MASK @ZA10266 40466037 DROP WKREGA DROP IOSB BASE @ZA10266 40466537 DROP WKREGB DROP DEB BASE @ZA10266 40467037 DROP WKREGC DROP EXTENT BASE @ZA10266 40467537 CVRTSET4 MVC FTREGSV+36(1),FTIOBSK INIT EXT SAVEAREA FOR C.E@ZA10266 40468037 BR WKREGE RETURN TO CALLER 40470002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...TERMINATION' 40826402 ********************************************************************* 40827602 * 40828802 * FETCH TERMINATION ROUTINE 40830002 * 40831202 ********************************************************************* 40832402 SPACE 3 40833602 ********************************************************************* 40834802 * CONTROL IS RECEIVED AT FT027BAA FROM THE ESTAE SUBROUTINE TO ALLOW 40836002 * FETCH TO TERMINATE ITSELF. WHEN ENTERED HERE ESTAE HAS PASSED 40837202 * R1 POINTING TO THE FETCH WORK AREA AND R15 IS BASE FOR FT027BAA. 40838402 SPACE 40839602 USING FT027BAA,CODEREG R15=BASE Y02081 40840802 SPACE 40842002 FT027BAA EQU * ENTRY FROM ESTAE ROUTINE Y02081 40843202 LR FTBASE2,WKREGA R13=FETCH WORK AREA Y02081 40844402 L FTBASE1,BASEMAIN MAINLINE ADDRESSABILITY Y02081 40845602 SPACE 40846802 DROP CODEREG RETURN R15 TO ASSEMBLER Y02081 40848002 USING FT001,FTBASE1 RESET MAINLINE BASE Y02081 40849202 SPACE 3 40850402 FT027B LA CODEREG,RCPRGCHK PROG CHK OR LOOP IN FETCH Y02081 40851602 B FT02701 BR TO RESUME TERMINATION Y02081 40852802 FT027C LA CODEREG,RCNOCORE NOT ENOUGH STORAGE SPACE Y02081 40854002 B FT02701 BR TO RESUME TERMINATION Y02081 40855202 FT027D LA CODEREG,RCBADREC INVALID RECORD TYPE FOUND 40856402 B FT02701 BR TO RESUME TERMINATION 40857602 FT027E LA CODEREG,RCBADADR INVALID ADDRESS ENCOUNTERED 40858802 B FT02701 BR TO RESUME TERMINATION 40860002 FT027F LA CODEREG,RCIOERR PERMANENT I/O ERROR 40890002 SPACE 40940037 FT02701 EQU * CONTINUE TERMINATION PROCESS 41010002 STC CODEREG,XKEY DENOTE WORK AREA NO LONGER 41040002 * UNDER FETCH CONTROL. USE 41070002 * RETURN CODE TO INVALIDATE 41100002 * THE FETCH ID KEY. 41130002 SPACE 41132037 * SAVE A COPY OF THE IOSB/SRB FOR DEBUGGING PURPOSES WHEN WE HAVE 41134037 * AN ABNORMAL TERMINATION. 41136037 SPACE 41138037 L CODEREG,XESTAEPT GET IOSB/SRB COPY POINTER 41138137 LTR CODEREG,CODEREG IOSB COPIED ALREADY 41139037 BNZ FT027017 GO IF IOSB ALREADY COPIED 41142937 L CODEREG,XIOSBAD GET IOSB ADDRESS 41143837 LTR CODEREG,CODEREG IOSB CREATED YET? 41144737 BZ FT027017 GO IF NO IOSB 41145637 SPACE 41146537 GETMAIN EC,MF=(E,XGMLIST),LV=IOSBSIZE,A=XESTAEPT,SP=230 41147437 SPACE 2 41148337 LTR CODEREG,CODEREG SUCCESSFUL GETMAIN 41149237 BZ FT02701E GO IF SUCCESSFUL GETMAIN 41150137 XC XESTAEPT,XESTAEPT ELSE INDICATE UNSUCCESSFUL G'M 41151037 B FT027017 41151937 SPACE 41152837 FT02701E EQU * SAVE IOSB 41153737 L WKRG2,XESTAEPT POINT TO COPY AREA 41154637 L WKRG3,XIOSBAD POINT TO IOSB 41155537 MVC 0(IOSBSIZE,WKRG2),0(WKRG3) COPY IOSB 41156437 B FT027017 AND CONTINUE 41157337 SPACE 41158237 FT027 EQU * NORMAL TERMINATION.... Y02081 41159137 LA CODEREG,RCNORMAL SET NORMAL-END CODE 41160037 STC CODEREG,XKEY DENOTE WORK AREA NO LONGER 41168537 * UNDER FETCH CONTROL. USE 41172837 * RETURN CODE TO INVALIDATE 41177137 * THE FETCH ID KEY. 41181437 FT027017 EQU * CONTINUE 41183437 L RETURNRG,XRETSAV RESTORE RETURN ADDRESS Y02081 41185737 L WKRG3,XREGSV3 RESTORE REGISTER 3 YM1070 41190002 L WKRG6,XREGSV6 RESTORE REGISTER 6 YM1070 41220002 L DCBREG,XORGDCB RESTORE ORIGINAL DCB POINTER 41250002 TM XFLAG1,USDEBFLG WAS A DEB COPY USED ? 41280002 BZ FT02702 BRANCH IF NO COPIED DEB 41310002 L WKREGF,XDEBLEN SIZE OF DEB COPY CORE 41340002 L WKREGA,XDCBDEBA ADDR OF DEB COPY CORE 41370002 NI XFLAG1,DEBFREE INDICATE DEB FREED ZA0135 41380002 FREEMAIN R,LV=(0),A=(1) FREE DEB COPY CORE 41400002 SPACE 41430002 FT02702 EQU * CONTINUE TERMINATION Y02081 41460002 TM XFLAG1,VAMDEV WAS FETCH FROM A VAM D/S? Y02081 41490002 BO FT02703 IF SO, BRANCH AROUND Y02081 41520002 TM XFLAG2,PRGFREE RESOURCES ALREADY FREED? Y02081 41530002 BO FT02703 GO IF ALREADY FREED Y02081 41540002 L WKREGF,IOBLKS GET SUBPOOL ID AND SIZE OF Y02081 41550002 * GLOBAL STORAGE BLOCKS Y02081 41580002 * (IOSB AND SRB) Y02081 41610002 TM XFLAG2,IOSBFREE FREED YET? @ZA29740 41620037 BO FT02702A GO IF ALREADY FREED @ZA29740 41630037 L WKREGA,XIOSBAD GET ADDR OF IOSB AND SRB Y02081 41640002 LTR WKREGA,WKREGA IS THERE ANY IOSB AND SRB? YM6928 41650002 BZ FT02702A IF NOT, DON'T TRY TO FREE IT YM6928 41660002 SPACE 41662002 * INDICATE IOSB/SRB FREEMAINED IN CASE WE GET CONTROL 41664002 * IN ESTAE 41666002 SPACE 41668002 OI XFLAG2,IOSBFREE IOSB/SRB FREED YM8279 41668402 FREEMAIN R,LV=(0),A=(1) FREE FETCH GLOBAL STORAGE Y02081 41670002 FT02702A EQU * CLEANUP PAGEFIXED STORAGE YM6928 41680002 L WKREGA,XLOFIX GET STARTING ADDR OF FIXED Y02081 41700002 * TEXT AREA FOR PGFREE Y02081 41730002 LTR WKREGA,WKREGA ANYTHING FIXED? Y02081 41760002 BZ FT02703 IF NOT, BYPASS PGFREE Y02081 41790002 SPACE 41800002 * INDICATE PAGE FREE ISSUED IN CASE OF ESTAE. 41810002 SPACE 41812002 XC XLOFIX,XLOFIX INDICATE PAGEFREE YM8279 41814002 L CODEREG,XHIFIX GET END ADDR OF FIX AREA Y02081 41820002 PGFREE R,A=(1),EA=(15) FREE THE FIXED AREA Y02081 41850002 SPACE 41860002 * 41870002 * UNFIX THE DISABLE INTERRUPT ROUTINE 41872002 * 41874002 L WKREGA,FTPCIADD GET START ADDR TO UNFIX Y21179 41878002 L WKREGB,FTFXADDR GET END ADDR TO UNFIX Y21179 41878102 * IF DIE ROUTINE IS IN FIXED LPA, PAGES WERE NOT FIXED--THEREFORE 41878837 * BRANCH AROUND PGFREE 41878937 SPACE 41879037 L WKREGE,CVTPTR GET CVT ADDRESS @ZA05457 41879137 USING CVT,WKREGE CVT ADDRESSABILITY @ZA05457 41879237 CLM WKREGB,B'0111',CVTNUCB+1 DIE RTN IN FIXED LPA? @ZA05457 41879337 DROP WKREGE @ZA05457 41879437 BNH FT02703 BRANCH IF IN FIXED LPA @ZA05457 41879537 SPACE 41879637 PGFREE R,A=(1),EA=(2) UNFIX DIE ROUTINE 41879737 SPACE 41879837 *** REG 15 IS DESTROYED BY FREEMAIN AND PGFREE 41880002 FT02703 EQU * CONTINUE TERMINATION Y02081 41910002 SPACE 41912002 * ISSUE ESTAE TO CANCEL ESTAE ISSUANCE AT START OF THIS MODULE LOAD 41920002 ESTAE 0 CANCEL ESTAE Y02081 41932002 SPACE 41934002 SR CODEREG,CODEREG RESET YM0697 41940002 IC CODEREG,XKEY REINSERT COMPLETION CODE YM0697 41970002 LTR CODEREG,CODEREG TEST COMPLETION CODE 42000002 BNZ FT029 BRANCH IF ERROR CONDITION 42030002 L WKREGE,FTRPTR BLK RELOC FACTOR 42060002 LTR SEGREG,SEGREG TEST FETCH'S CALLER 42090002 BP FT029 BRANCH ENTRY FROM OVERLAY 42120002 TM WKATTR,PDS2OVLY TEST PROG IN OVERLAY 42150002 BZ FT028 BRANCH NOT IN OVERLAY 42180002 ST DCBREG,0(WKREGE) DCB ADDR TO SEGTAB 42210002 LA WKREGA,EXLSIZE(LISTREG) POINT TO NOTELIST 42240002 ST WKREGA,SGTBNTLS(WKREGE) PLACE NOTELIST ADDR IN SEGTAB 42270002 TM WKATTR,PDS2TEST PROG IN TEST 42300002 BZ FT028 BRANCH NOT IN TEST 42330002 OI 0(WKREGE),SGTBTST SET TEST BIT IN SEGTAB 42360002 FT028 TM WKATTR+1,PDS2EP0 ED ASSIG ENT PT = ZERO 42390002 BCR 1,LINKREG RETURN 42420002 L WKREGA,WKENTPT-1 ED ASSIG ENT PT 42450002 LA WKREGE,0(WKREGA,WKREGE) DETERMINE RELOCATED EPA 42480002 FT029 EQU * TERMINATION IS COMPLETE YM1070 42510002 RETURN 42540002 DROP FTBASE1 DROP MAINLINE BASE REGISTER Y02081 42570002 DROP FTBASE2 DROP WORKAREA BASE REGISTER Y02081 42600002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...FETCH MAINLINE C42602002 CONSTANTS.' 42604002 * 42610002 * FETCH CONSTANTS 42620002 * 42622002 DS 0F FORCE FULLWORD ALIGNMENT 247 42624002 FTDEBMSK DC X'04000000' PCI FETCH MODE FILEMASK BIT 22125 42628002 BASEMAIN DC A(FT001) MAINLINE ADDRESS Y02081 42636502 ESTAEADD DC A(IEWFTSTA) ESTAE ROUTINE ADDRESS Y02081 42639802 FTKEY DC CL4'FTWA' FETCH ID KEY 42639902 PGFXDONE DC X'08' INDICATES PGFIX IN PROCESS @ZA07064 42641937 SPACE 2 42644902 *------- THE FOLLOWING FETCH CONSTANTS PRESUME 42649902 * PAGE SIZE FOR THE SYSTEM IS 4K. 42653202 * 42655202 PAGESIZM DC F'4096' SYSTEM PAGE SIZE 42655602 PAGEMSKM DC XL4'FFFFF000' MASK FOR REMOVING THE BYTE 42656002 * PORTION OF AN ADDRESS. 42656402 * (IE. ADJUSTS TO A PAGE BNDRY) 42656502 *---------------------------------- 42668902 SPACE 2 42670902 *------- THE FOLLOWING CONSTANT DEFINES THE 42672902 * MAXIMUM NUMBER OF BYTES FETCH MAY FIX 42673302 * FOR AN I/O OPERATION DURING THE LOAD. 42682602 * 42684602 FIXLIMTM DC F'18432' 18K BYTE FIX LIMIT 42686602 *---------------------------------- 42688602 SPACE 2 42690602 *-------- THE FOLLOWING CONSTANTS FOR IDAL CONSTRUCTION 42691002 * ARE BASED ON 2K LIST ENTRIES USED BY CHANNEL. 42691402 * 42691802 BLOKSIZM DC F'2048' 2K BLOCK LENGTH 42691902 BLOKMSKM DC XL4'FFFFF800' MASK FOR TRUNC TO 2K BNDRY 42692002 EJECT 42701602 * 42703602 * FETCH CHANNEL PROGRAM 42705602 * 42707602 FTCCW1 CCW X'23',X'00',X'40',1 SET SECTOR (RPS DEVICES) CC Y02081 42709602 FTCCW2 CCW X'31',X'00',X'40',5 SEARCH ON ID EQUAL CC 42710002 CCW X'08',FTCCW1,X'00',1 TIC TO SEARCH ID CCW 42710402 CCW X'08',FTCCW3,X'00',1 TIC TO A READ DATA CCW 42710802 FTSCHLN EQU *-FTCCW1 LENGTH OF SEARCH CHAN PROG Y02081 42710902 VAMSCHLN EQU *-FTCCW2 LENGTH OF VAM SEARCH CH PROG Y02081 42711002 FTCCW3 CCW X'06',X'00',X'40',1024 RD TEXT DATA CC 42711202 CCW X'92',X'00',X'48',8 READ COUNT MULTI-TRACK CC,PCI 42711302 CCW X'06',X'00',X'60',256 READ RLD/CTL DATA CC,SILI 42711402 CCW X'92',X'00',X'40',8 READ COUNT MULTI-TRACK CC 42711502 CCW X'03',X'00',X'60',1 TIC/NOP SWITCH CC(RPS ONLY),SILI 42714302 * ABOVE LINE CHANGED FOR -- OY03649 42714702 CCW X'22',X'00',X'00',1 READ SECTOR (RPS DEVICES) Y02081 42716302 FTCPLN EQU *-FTCCW3 LENGTH OF FETCH CHANNEL PROG Y02081 42716702 SPACE 2 42718302 * 42718702 * CHANNEL PROGRAM USED WHEN FETCHING FROM A VAM DATA SET Y02081 42719102 * 42719502 * CCW'S MUST BE MULTI-TRACK READS SINCE MULTI-TRACK READ-COUNT 42719602 * CCW'S ARE NOT USED AND FILE PROTECT UNIT CHECK WILL NOT OCCUR 42719702 * IF THE VAM DATA SET HAS BEEN ALLOCATED IN CYLINDERS; THEREFORE 42719802 * THE DASD ERP WILL NOT BE INVOKED TO UPDATE THE TRACK ADDRESS 42720902 * WHEN WE CROSS A TRACK BOUNDARY AND WE WILL RE-READ THE FIRST 42722902 * RECORD ON THE SAME TRACK AND CAUSE AN I/O ERROR YM5962 42724902 FTCCW4 CCW X'86',X'00',X'40',1024 READ TEXT CCW Y02081 42728002 * (READ DATA MULTI-TRACK) YM5962 42729102 CCW X'86',X'00',X'68',256 READ CONTROL/RLD CCW Y02081 42730202 * (READ DATA MULTI-TRACK) YM5962 42731302 CCW X'08',X'00',X'00',1 TRANSFER IN CHANNEL CCW Y02081 42732402 VAMCPLN EQU *-FTCCW4 LENGTH OF VAM CHANNEL PROGRAM Y02081 42732802 SPACE 2 42733502 IOBLKS DS 0A STORAGE REQUIREMENT FOR Y02081 42734602 * FIXED GLOBAL STORAGE Y02081 42736402 DC AL1(SQASP) SUBPOOL ID (FOR SQA) Y02081 42736802 DC AL3(GLOBREQ) TOTAL REQUIREMENT FOR Y02081 42737902 * FETCH IOSB AND SRB Y02081 42739002 SPACE 3 42740102 DC CL8'FETCHPA1' PATCH AREA 1 ID Y02081 42741202 FTPATCH DC 25F'0' MAINLINE FETCH PATCH AREA Y02081 42742302 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...ESTAE EXIT.' 42743402 ********************************************************************* 42746402 * 42748402 * FETCH ESTAE SUBROUTINE. 42750402 * 42752402 * ESTAE IS ENTERED BY RECOVERY MANAGEMENT TO ALLOW EXTENDED 42754402 * PROCESSING BY FETCH DURING ABNORMAL TERMINATION. ESTAE IS 42754802 * MADE ACTIVE FOR THE DURATION OF A FETCH REQUEST BY THE ISSUANCE 42755202 * OF THE ESTAE MACRO AT FETCH INITIALIZATION AND IS DISCONTINUED 42755602 * BY THE ISSUANCE OF THE ESTAE MACRO DURING FETCH TERMINATION. 42755702 * 42755802 * 42755902 * THERE ARE TWO MAIN PROCESSING PATHS THRU ESTAE DEPENDENT UPON 42758202 * THE PRESENCE OR ABSENCE OF THE SDWA WHEN FETCH IS ENTERED IN 42760202 * ESTAE. 42762202 * 1. IF AN SDWA IS AVAILABLE AT ESTAE TIME, THE REGISTERS ARE 42762602 * SAVED IN THE SAVEAREA PROVIDED BY RECOVERY MANAGEMENT. IF 42762702 * RETRY IS POSSIBLE(I.E. CONTINUE PROCESSING AFTER COMPLETING 42762802 * ESTAE PROCESSING) THE IOSB AND SDWA ARE SAVED IN A GETMAINED 42763202 * AREA AND ESTAE SETS UP TO RETURN CONTROL TO FETCH MAINLINE 42765002 * IN IT'S TERMINATION ROUTINE(FT027B). 42767002 * 42769002 * IF RETRY IS NOT POSSIBLE(I.E. WE ARE TERMINATING IN ESTAE 42769102 * AND CONTROL MUST BE RETURNED TO RECOVERY MANAGEMENT) FETCH'S 42769202 * RESOURCES ARE FREED(IF NOT PREVIOUSLY FREED) AND RETURN IS 42769802 * MADE TO RECOVERY MANAGEMENT TO CONTINUE TERMINATION. 42771402 * 42773402 * 2. IF THERE IS NO SDWA AVAILABLE, THE REGISTERS ARE SAVED IN 42775402 * THE FETCH WORK AREA. IF RETRY IS POSSIBLE(I.E. PROCESSING 42775502 * MAY CONTINUE AFTER ESTAE) ESTAE SETS UP TO GIVE CONTROL 42775602 * TO FETCH MAINLINE IN IT'S TERMINATION ROUTINE(FT027BAA). 42776402 * 42782802 * IF RETRY IS NOT POSSIBLE(I.E. CONTROL MUST BE RETURNED 42784802 * TO RECOVERY MANAGEMENT) FETCH'S RESOURCES ARE FREED(IF 42786802 * NOT PREVIOUSLY FREED) AND RETURN IS MADE TO RECOVERY 42788802 * MANAGEMENT INDICATING CONTINUE TERMINATION. 42789202 * 42789602 ********************************************************************* 42790002 SPACE 42790102 USING *,WKRG15 ESTABLISH ADDRESSABILITY Y02081 42791202 USING SDWA,WKRG1 SET BASE REG FOR SDWA Y02081 42791602 USING WKFETCH,WKRG2 SET WORKAREA BASE REG Y02081 42791702 SPACE 42791802 IEWFTSTA EQU * START OF ESTAE ROUTINE Y02081 42791902 SPACE 42794102 LR WKRG11,WKRG15 SET NORMAL FETCH BASE Y02081 42796102 SPACE 42798102 DROP WKRG15 CHANGE ASSEMBLER BASE Y02081 42798502 USING IEWFTSTA,WKRG11 NOTIFY ASSEMBLER Y02081 42798602 SPACE 42798702 SPACE 42800902 * TEST IF THE SDWA WORK AREA WAS OBTAINED. R0=12 INDICATES NO SDWA 42802902 * WORK AREA OBTAINED. 42804902 SPACE 42805302 C WKRG0,F12 ANY WORK AREA? Y02081 42805402 BE FTSTA200 GO IF NO SDWA W. A. Y02081 42805502 SPACE 42811902 ********************************************************************** 42813902 * WE HAVE THE SDWA AVAILABLE TO US. AFTER SAVING REGISTERS IN 42815902 * RECOVERY MGT SAVE AREA, PROCESS AS FOLLOWS. 42817902 * 1 42818302 * IF WE HAVE BEEN ENTERED FOR TERMINATION ONLY, FREE OUR 42818702 * RESOURCES IF PURGE HAS NOT ALREADY FREED THEM AND CONTINUE 42820402 * WITH TERMINATION. 42822402 * 2 42822802 * IF RETRY IS POSSIBLE WE WILL SET UP THE SDWA TO GIVE CONTROL 42823202 * TO FETCH IN IT'S MAINLINE TERMINATION BY SETTING UP IT'S 42823602 * BASE REGISTER AND PASSING THE FETCH WORK AREA ADDRESS. 42824002 * WE WILL ALSO SAVE THE SDWA AND THE IOSB IN A GETMAIN'ED 42824402 * AREA FOR DEBUGGING PURPOSES. 42824802 ********************************************************************** 42824902 SPACE 42825002 STM WKRG0,WKRG15,ZERO(WKRG13) SAVE REGS Y02081 42825102 SPACE 42826602 * R1 POINTS TO THE SDWA AND THE FIRST WORD OF THE SDWA POINTS TO 42828602 * THE SVRB(CONTENTS SUPERVISOR) OR PSUEDO SVRB(OVERLAY SUPERVISOR) 42829002 SPACE 42829402 L WKRG2,ZERO(WKRG1) GET ESTAE PARAMETER Y02081 42829802 SPACE 42831802 * LOAD FETCH WORK AREA ADDRESS FROM PSUEDO SVRB IF OVERLAY 42832202 * SUPERVISOR, OR REAL SVRB IF CONTENTS SUPERVISOR. 42832602 SPACE 42833002 L WKRG2,SVRBWKA(WKRG2) GET FETCH W.A. ADDRESS Y02081 42833302 SPACE 42835202 * TEST IF WE ARE IN ESTAE FOR A TERMINATING CONDITION ONLY, 42836402 * OR IF WE CAN RETRY. 42837602 SPACE 42838802 TM SDWAERRD,SDWACLUP TERMINATING? Y02081 42840002 BO FTSTA100 GO IF TERMINATION Y02081 42841202 SPACE 42842402 * TEST IF ITS REALLY FETCH WHICH IS CAUSING THE PROBLEM BY SEEING 42842837 * IF ESTAE IS RUNNING UNDER FETCH'S RB 42843237 SPACE 42843337 TM SDWAERRD,SDWANRBE RUNNING UNDER OUR RB? ZA2508 42843437 BO FTSTA100 GO IF NOT FETCH'S RB ZA2508 42843537 SPACE 42844737 * SET UP TO RETRY BY UPDATING THE REGISTERS IN THE SDWA SAVEAREA 42848437 * TO POINT TO FETCH WORK AREA AND FETCH MAINLINE. 42849637 SPACE 42850837 L WKRG3,FTMAIN R3=FETCH BASE ADDRESS Y02081 42852037 ST WKRG3,SDWASR11 AND STORE IN SDWA Y02081 42853237 ST WKRG2,SDWASR13 AND SAVE FETCH W.A. Y02081 42854437 SPACE 42855637 * SAVE A COPY OF THE IOSB AND THE SDWA FOR DEBUGGING PURPOSES. ISSUE 42856837 * A GETMAIN FROM SBPOOL 230(SYSTEM,TASK RELATED,PAGEABLE,SWAPPABLE) 42858037 * AND PUT A POINTER TO THIS AREA IN THE FETCH WORK AREA. 42859237 SPACE 42860437 FTSTA050 EQU * OBTAIN TASK-RELATED STORAGE Y02081 42861637 SPACE 42862837 GETMAIN EC,MF=(E,XGMLIST),LV=IOSBSDWA,A=XESTAEPT,SP=230 Y02081 42864037 SPACE 42865237 LTR WKRG15,WKRG15 SUCCESSFUL GETMAIN? Y02081 42866437 BZ FTSTA060 GO IF SUCCESSFUL Y02081 42867637 XC XESTAEPT,XESTAEPT INDICATE UNSUCCESSFUL Y02081 42868837 B FTSTA070 AND CONTINUE Y02081 42870037 SPACE 42871237 * SAVE IOSB AND SDWA IN GETMAIN'ED AREA. 42872437 SPACE 42873637 FTSTA060 EQU * COPY IOSB AND SDWA Y02081 42874837 SPACE 42876037 L WKRG8,XESTAEPT POINT TO SAVE AREA Y02081 42877237 L WKRG4,XIOSBAD POINT TO IOSB Y02081 42878437 MVC 0(IOSBSIZE,WKRG8),0(WKRG4) SAVE IOSB YM6761 42879637 SPACE 42880837 LA WKRG8,IOSBSIZE(WKRG8) INCREMENT SAVE AREA Y02081 42882037 LA WKRG9,SDWALEN SET THE -TO- LENGTH Y02081 42883237 LA WKRG5,SDWALEN SET THE -FROM- LEN Y02081 42884437 L WKRG4,R1OFFSET(WKRG13) POINT TO THE SDWA Y02081 42885637 SPACE 42886837 MVCL WKRG8,WKRG4 SAVE THE SDWA Y02081 42888037 SPACE 42889237 L WKRG1,R1OFFSET(WKRG13) RESET SDWA BASE FOR SETRP YM5739 42890437 SPACE 42891637 * ISSUE SETRP MACRO TO GIVE CONTROL AT FETCH TERMINATION TO ALLOW 42892837 * RETRY(RC=4). INDICATE WE HAVE UPDATED THE REGISTERS IN THE SDWA 42894037 * TO ALLOW USE OF THESE REGISTERS UPON ENTRY TO MAINLINE. INDICATE 42895237 * FREE THE SDWA. 42896437 SPACE 42897637 FTSTA070 EQU * CONTINUE SETUP FOR RETRY Y02081 42898837 SPACE 42900037 L WKRG1,R1OFFSET(WKRG13) RESTORE R1 AFTER G'MAIN Y02081 42901237 L WKRG3,PROGCHK ADDRESS OF FT027B Y02081 42902437 SPACE 42903637 SETRP RETADDR=(WKRG3),RETREGS=YES,RC=4,FRESDWA=YES 42904837 SPACE 42906037 LM WKRG0,WKRG15,ZERO(WKRG13) RESTORE Y02081 42907237 SPACE 42908437 BR RETURNRG RETURN Y02081 42909637 SPACE 6 42910837 ********************************************************************* 42912037 * NO RETRY POSSIBLE SO FREE OUR RESOURCES. FREEMAIN THE IOSB AND 42913237 * SRB AND PAGEFREE THE TEXT READ-IN AREA (IF REQUIRED) PRIOR TO 42914437 * ISSUEING THE SETRP MACRO AND RETURNING. 42915637 SPACE 42916837 FTSTA100 EQU * PRE-TERMINATION CLEANUP Y02081 42918037 SPACE 42919237 TM XFLAG2,PRGFREE RESOURCES ALREADY FREED? Y02081 42920437 BO FTSTA120 GO IF FREED Y02081 42921637 SPACE 42922837 TM XFLAG1,VAMDEV VAM DATA SET? Y02081 42924037 BO FTSTA120 GO IF YES-NO FREEING Y02081 42925237 SPACE 42926437 * TEST IF IOSB/SRB ALREADY FREED IN TERMINATION. 42927637 SPACE 42928837 TM XFLAG2,IOSBFREE PREVIOUSLY FREED? YM8279 42930037 BO FTSTA110 GO IF ALREADY FREED YM8279 42931237 SPACE 42932437 * FREE THE IOSB AND SRB FROM SQA STORAGE 42933637 SPACE 42934837 L WKRG1,XIOSBAD R1=ADDRESS OF IOSB AND SRB Y02081 42936037 LTR WKRG1,WKRG1 TEST IF ANY IOSB ZA1345 42936437 BZ FTSTA110 GO IF NO IOSB ZA1345 42936837 SPACE 42937237 * INDICATE IOSB/SRB FREEMAINED IN CASE WE GET CONTROL IN TERMINATION 42937537 SPACE 42937837 OI XFLAG2,IOSBFREE IOSB/SRB FREED @ZA29740 42938137 FREEMAIN R,LV=GLOBREQ,A=(1),SP=SQASP ISSUE FREEMAIN YM7587 42938437 SPACE 2 42939637 * PAGE FREE THE TEXT READ-IN AREA. 42940837 SPACE 42942037 FTSTA110 EQU * YM8279 42943237 SPACE 42944437 L WKRG1,XLOFIX START ADDR OF FIXED Y02081 42945637 LTR WKRG1,WKRG1 ANYTHING FIXED? Y02081 42946837 BZ FTSTA120 GO IF NOTHING FIXED Y02081 42948037 SPACE 42949237 XC XLOFIX,XLOFIX INDICATE TEST FREED @ZA10542 42950437 L WKRG2,XHIFIX END OF FIXED AREA Y02081 42950837 SPACE 42951637 PGFREE R,A=(WKRG1),EA=(WKRG2) ISSUE PAGEFREE Y02081 42952837 SPACE 2 42954037 * PAGE FREE THE DIE APPENDAGE 42955237 * IF DIE ROUTINE IS IN FIXED LPA, PAGES WERE NOT FIXED-- 42956437 * THEREFORE, BRANCH AROUND PAGEFREE 42956737 SPACE 42957037 L WKRG1,FTSTASTT FIX START ADDRESS Y02081 42957337 L WKRG2,FTSTAEND FIX END ADDRESS Y02081 42957637 L WKRG12,CVTPTR GET CVT ADDRESS @ZA05457 42957937 USING CVT,WKRG12 CVT ADDRESSABILITY @ZA05457 42958237 CLM WKRG2,B'0111',CVTNUCB+1 DIE RTN IN FIXED LPA? @ZA05457 42958537 DROP WKRG12 @ZA05457 42958837 BNH FTSTA120 BRANCH IF IN FIXED LPA @ZA05457 42959137 SPACE 42960037 PGFREE R,A=(WKRG1),EA=(WKRG2) FREE THE DIE APPENDAGE Y02081 42961237 SPACE 2 42962437 * ISSUE SETRP MACRO-INDICATE CONTINUE WITH TERMINATION. 42963637 SPACE 42964837 FTSTA120 EQU * COMMUNICATE WITH RECOVERY MGR Y02081 42966037 SPACE 42967237 LM WKRG0,WKRG15,ZERO(WKRG13) RESTORE REGS Y02081 42968437 SPACE 42969437 SETRP RC=0 CONTINUE TERMINATION Y02081 42970437 SPACE 2 42971437 * RETURN TO CALLER 42972437 SPACE 42974437 BR RETURNRG RETURN Y02081 42975637 SPACE 6 42976837 ********************************************************************* 42978037 * NO SDWA WAS SUPPLIED BY THE CALLER-WE HAVE TWO OPTIONS 42979237 * 1 42980437 * WE HAVE BEEN CALLED FOR TERMINATION ONLY--IN THIS CASE 42981637 * WE WILL FREE OUR CURRENT RESOURCES AND RETURN. 42982837 * 2 42984037 * RETRY IS POSSIBLE-SET REGISTERS TO GIVE CONTROL TO FETCH IN 42985237 * IT'S TERMINATION ROUTINE BY PASSING THE ADDRESS OF THE 42986437 * FETCH WORK AREA AND THE ADDRESS OF THE ROUTINE TO GAIN CONTROL 42987637 * (FETCH TERMINATION). 42988837 ********************************************************************* 42990037 SPACE 2 42991237 * SAVE REGISTERS IN FETCH'S WORK AREA. 42992437 SPACE 42993637 FTSTA200 EQU * START OF LOGIC FOR NO SDWA Y02081 42994837 SPACE 42996037 * REG 2 CONTAINS ESTAE PARAM Y02081 42997237 SPACE 42998437 * LOAD FETCH WORK AREA ADDRESS FROM THE SVRB IF A CONTENTS 42999637 * SUPERVISOR REQUEST OR FROM THE PSUEDO SVRB IF AN OVERLAY 43000837 * SUPERVISOR REQUEST. 43002037 SPACE 43003237 L WKRG2,SVRBWKA(WKRG2) GET FETCH W.A. ADDRESS Y02081 43004437 SPACE 43005637 STM WKRG0,WKRG15,FTREGSV SAVE REGS Y02081 43006837 SPACE 43008037 * TEST IF WE ARE IN A TERMINATING CONDITION. 43009237 SPACE 43010437 L WKRG1,XFTCBAD R1=CURRENT TCB Y02081 43011637 SPACE 43012837 USING TCB,WKRG1 GAIN ADDRESSABILITY Y02081 43014037 SPACE 43015237 TM TCBESTRM,TCBETERM TERMINATING? Y02081 43016437 BO FTSTA250 GO IF NOT TERMINATING Y02081 43017637 SPACE 43018837 TM TCBNSTAE,TCB33E TERMINATING? Y02081 43020037 BZ FTSTA250 GO IF NOT TERMINATING Y02081 43021237 SPACE 43022437 * TERMINATING CONDITION--FREE RESOURCES AND RETURN 43023637 SPACE 43024837 TM XFLAG2,PRGFREE RESOURCES FREED? Y02081 43026037 BO FTSTA220 GO IF ALREADY FREED Y02081 43027237 SPACE 43028437 TM XFLAG1,VAMDEV VAM DATA SET? Y02081 43029637 BO FTSTA220 GO IF VAM D.S. Y02081 43030837 SPACE 43032037 * TEST IF IOSB/SRB ALREADY FREED IN TERMINATION. 43033237 SPACE 43034437 TM XFLAG2,IOSBFREE FREED BY TERMINATION YM8279 43035637 BO FTSTA210 GO IF ALREADY FREED YM8279 43036837 SPACE 43038037 * FREE THE IOSB AND SRB FROM SQA STORAGE 43039237 SPACE 43040437 L WKRG1,XIOSBAD R1=ADDRESS OF IOSB AND SRB Y02081 43041637 LTR WKRG1,WKRG1 TEST IF ANY IOSB ZA1345 43042037 BZ FTSTA210 GO IF NO IOSB ZA1345 43042437 SPACE 43042837 * INDICATE IOSB/SRB FREEMAINED IN CASE WE GET CONTROL IN TERMINATION 43043137 SPACE 43043437 OI XFLAG2,IOSBFREE IOSB/SRB FREED @ZA29740 43043737 FREEMAIN R,LV=GLOBREQ,A=(1),SP=SQASP ISSUE FREEMAIN YM7587 43044037 SPACE 43045237 * PAGE FREE THE TEXT RECORD READ-IN AREA. 43046437 SPACE 43047637 FTSTA210 EQU * YM8279 43048837 SPACE 43050037 L WKRG1,XLOFIX START ADDR OF FIXED Y02081 43051237 LTR WKRG1,WKRG1 ANYTHING FIXED? Y02081 43052437 BZ FTSTA220 GO IF NOTHING FIXED Y02081 43053637 SPACE 43054837 XC XLOFIX,XLOFIX INDICATE PAGE FREED @ZA10542 43056037 L WKRG2,XHIFIX ENDING ADDR OF FIXED Y02081 43056437 SPACE 43057237 PGFREE R,A=(WKRG1),EA=(WKRG2) ISSUE PAGE FREE Y02081 43058437 SPACE 2 43059637 * PAGE FREE THE DIE APPENDAGE. 43060837 SPACE 43062037 L WKRG1,FTSTASTT FIX START ADDRESS 43062237 L WKRG2,FTSTAEND FIX END ADDRESS 43062337 L WKRG12,CVTPTR GET CVT ADDRESS @ZA05457 43062437 USING CVT,WKRG12 CVT ADDRESSABILITY @ZA05457 43062537 CLM WKRG2,B'0111',CVTNUCB+1 DIE RTN IN FIXED LPA? @ZA05457 43062637 DROP WKRG12 @ZA05457 43062837 BNH FTSTA220 @ZA05457 43063037 SPACE 43065637 PGFREE R,A=(WKRG1),EA=(WKRG2) FREE THE TEXT RECORD Y02081 43066837 SPACE 2 43068037 * SET RETURN CODE IN R15 TO INDICATE CONTINUE TERMINATION. 43069237 SPACE 43070437 FTSTA220 EQU * CLEANUP COMPLETE Y02081 43071637 SPACE 43072837 SR WKRG15,WKRG15 ZERO=CONTINUE TERMINATION Y02081 43074037 SPACE 2 43075237 * RETURN 43076437 SPACE 43077637 LM WKRG0,WKRG14,FTREGSV RESET REURN ADDRESS Y02081 43078837 BR RETURNRG RETURN Y02081 43080037 SPACE 4 43081237 ********************************************************************* 43082437 * TERMINATION NOT FORCED IN ESTAE--SET UP THE REGISTERS TO GIVE 43083637 * CONTROL TO FETCH MAINLINE TO ALLOW TERMINATION FROM FETCH. 43084837 * INDICATE RETRY REQUESTED(RETURN CODE=4). 43086037 * 43087237 * R1=FETCH WORK AREA. 43088437 * R0=FETCH MAINLINE-ESTAE TERMINATION. 43089637 SPACE 43090837 FTSTA250 EQU * SETUP FOR RETRY Y02081 43092037 SPACE 43093237 LR WKRG1,WKRG2 R1=FETCH WORK AREA Y02081 43094437 L WKRG0,FT027BST R0=FETCH MAINLINE ADDR Y02081 43095637 LA WKRG15,RETRY INDICATE RETRY REQUESTED Y02081 43096837 SPACE 43098037 * RETURN 43099237 SPACE 43100437 LM WKRG2,WKRG14,FTREGSV+R2OFFSET RESTORE Y02081 43101637 SPACE 43102837 BR RETURNRG RETURN Y02081 43104037 SPACE 43105237 DROP WKRG1 SDWA OR TCB Y02081 43106437 DROP WKRG2 FETCH WORK AREA Y02081 43107637 SPACE 6 43108837 * ESTAE CONSTANTS. 43110037 SPACE 43111237 PROGCHK DC A(FT027B) ADDR TO GET CTL-MAINLINE Y02081 43112437 F12 DC F'12' SDWA-NO SDWA CONSTANT Y02081 43113637 FT027BST DC A(FT027BAA) ADDR TO GET CTL-MAINLINE Y02081 43114837 FTSTASTT DC A(FTPCI01) DIE START ADDRESS Y02081 43116037 FTSTAEND DC A(FTFXEND) DIE END ADDRESS Y02081 43117237 SPACE 3 43118437 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...SRB COMPLETION ROUTINE' 43119637 *********************************************************************** 43120837 * ----- FETCH SRB COMPLETION ROUTINE ----- * 43122037 * RECEIVES CONTROL WHEN ALL FETCH I/O IS COMPLETE (END OF * 43123237 * MODULE HAS BEEN FOUND OR AN ERROR HAS OCCURRED) AND THE * 43124437 * FETCH REQUEST IS TO BE TERMINATED. IT OBTAINS THE LOCAL * 43125637 * LOCK, POSTS THE ECB THAT MAINLINE FETCH IS WAITING ON, * 43126837 * GOES TO THE PURGE/RESTORE SUBROUTINE WHICH HANDLES THE * 43128037 * PURGE QUIESE COUNT IN THE IPIB, IF ANY, RELEASES THE LOCAL * 43129237 * LOCK AND RETURNS TO THE SRB DISPATCHER. * 43130437 * Y02081 * 43131637 *********************************************************************** 43132837 SPACE 43134037 IEWFTSRB EQU * START OF SRB EXIT ROUTINE Y02081 43135237 LR WKRG9,CODEREG SET UP BASE REGISTER Y02081 43136437 USING IEWFTSRB,WKRG9 SET ADDRESSABILITY Y02081 43137637 LR WKRG4,WKREGA RESET IOSB BASE REG Y02081 43138837 USING IOSB,WKRG4 ADDRESSABILITY FOR IOSB Y02081 43140002 L WKREGB,IOSUSE GET WORK AREA POINTER Y02081 43170002 USING WKFETCH,WKREGB WORKAREA ADDRESSABILITY Y02081 43200002 LR WKRG3,LINKREG SAVE RETURN ADDRESS Y02081 43230002 GETLOCK SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, X43260002 RELATED=(FTPOST,IEWFETCH(FREELOCK)) Y02081 43290002 LA WKRG11,FTECB POINT TO ECB FOR POST Y02081 43320002 SR WKRG10,WKRG10 SET ECB COMPLETION CODE Y02081 43350002 ICM WKRG10,B'1000',IOSCOD IN HI BYTE OF REG 10 Y02081 43380002 L CODEREG,CVTPTR GET CVT PTR Y21179 43390002 USING CVT,CODEREG CVT ADDRESSABILITY Y21179 43392002 L CODEREG,CVT0PT02 GET POST RTN ADDR Y21179 43394002 DROP CODEREG DROP CVT BASE Y21179 43396002 BALR LINKREG,CODEREG LINK TO POST ROUTINE Y02081 43440002 L WKREGA,IOSIPIB GET IOSB IPIB POINTER Y02081 43470002 LTR WKREGA,WKREGA IS THERE AN IPIB? Y02081 43500002 BZ FTSRB05 IF NOT, BRANCH Y02081 43530002 SR WKREGF,WKREGF INDICATE LOCAL LOCK HELD Y02081 43560002 L CODEREG,CVTPTR GET CVT PTR Y21179 43570002 USING CVT,CODEREG CVT ADDRESSABILITY Y21179 43572002 L CODEREG,CVTIXAVL IOCOM ADDRESS Y21179 43576002 USING IOCOM,CODEREG IOCOM ADDRESSABILITY Y21179 43582002 L CODEREG,IOCQCNT PURGE/RESTORE ADDR Y21179 43584002 DROP CODEREG DROP CVT/IOCOM BASE 43586002 * POINT TO PURGE RESTORE Y02081 43588002 * ROUTINE TO DECREMENT/POST Y02081 43620002 * THE IPIB QUIESE COUNT/ECB Y02081 43650002 BALR LINKREG,CODEREG CALL THE IPIB ROUTINE Y02081 43680002 FTSRB05 EQU * RELEASE THE LOCAL LOCK Y02081 43710002 FREELOCK SETLOCK RELEASE,TYPE=LOCAL, X43740002 RELATED=(FTPOST,IEWFETCH(GETLOCK)) Y02081 43770002 LR LINKREG,WKRG3 RESTORE RETURN ADDRESS Y02081 43800002 BR LINKREG RETURN TO DISPATCHER Y02081 43830002 SPACE 2 43860002 DROP WKRG9 DROP SRB BASE Y02081 43890002 DROP WKRG4 DROP IOSB BASE Y02081 43920002 DROP WKREGB DROP FETCH WORKAREA BASE Y02081 43950002 EJECT 44220002 * 44250002 * PROGRAM FETCH APPENDAGE VECTOR TABLE (VAM DATA SETS ONLY) 44280002 * Y02081 44310002 FTAPNDG DC A(FTRETURN) END OF EXTENT ****************** 44340002 DC A(FTRETURN) START I/O * ALL APPENDAGES * 44370002 DC A(VPCI01) PCI APPENDAGE * EXCEPT PCI ARE * 44400002 DC A(FTRETURN) CHANNEL END * BR 14 * 44430002 DC A(FTRETURN) ABNORMAL END ****************** 44460002 * Y02081 44490002 SPACE 44520002 FTRETURN BR RETURNRG RETURN TO IOS 44550002 SPACE 44580002 * 44610002 * THE FOLLOWING REGISTER SETTINGS EXIST WHEN IOS TURNS CONTROL 44640002 * OVER TO AN APPENDAGE ROUTINE 44670002 * 44700002 * GEN REG 1 ADDRESS OF 12* 44730002 * GEN REG 2 ADDRESS OF IOB 44760002 * GEN REG 3 ADDRESS OF DEB 44790002 * GEN REG 4 ADDRESS OF DCB 44820002 * GEN REG 7 ADDRESS OF UCB (IN DIE) 44850002 * GEN REG 9 MUST BE CLEARED IF USED 44880002 * GEN REGS 10-13 SUGGESTED WORK REGISTERS 44910002 * GEN REG 14 RETURN REGISTER 44940002 * GEN REG 15 ADDRESS OF APPENDAGE RTN 44970002 * 45000002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...POST STATUS NORMAL EXIT' 45030002 *********************************************************************** 45060002 * * 45090002 * POST STATUS NORMAL EXIT ROUTINE (CHANNEL END PROCESSING) * 45120002 * * 45150002 * POST STATUS WILL PASS CONTROL TO THIS ROUTINE AT NORMAL * 45180002 * CHANNEL END TIME. WHEN CONTROL IS RECEIVED BY THIS ROUTINE * 45210002 * IT WILL: (1) CHECK FOR A WRONG LENGTH RECORD OR UNIT * 45240002 * EXCEPTION CONDITION AND, IF FOUND, RETURN TO IOS FOR NORMAL * 45270002 * PROCESSING. (2) TEST IF CHANNEL END IS THE RESULT OF A NOTE * 45300002 * LIST READ AND, IF SO, SET UP THE CHANNEL PROGRAM TO BEGIN * 45330002 * READING TEXT AND TAKE THE RETURN TO IOS WHICH WILL CAUSE A * 45360002 * RESTART OF THE CHANNEL PROGRAM. (3) TEST IF AN ERROR FLAG * 45390002 * HAS BEEN SET BY THE DIE ROUTINE (INVALID RECORD TYPE OR * 45420002 * INVALID ADDRESS IN AN RLD RECORD) AND, IF SO, RETURN TO IOS * 45450002 * FOR NORMAL PROCESSING. (4) TEST IF THE DIE ROUTINE FOUND THE * 45480002 * NEXT TEXT RECORD TO BE READ TO BE OUTSIDE OF THE AREA FIXED * 45510002 * FOR IT AND, IF SO, FREE THE CURRENTLY FIXED AREA, FIX AS * 45540002 * MUCH AS POSSIBLE OF THE REMAINING TEXT AREA AND TAKE THE * 45570002 * RETURN TO IOS WHICH WILL CAUSE A RESTART OF THE CHANNEL * 45600002 * PROGRAM. (5) CHECK FOR END CONDITION AND IF FLAG IS SET * 45630002 * RETURN TO IOS FOR NORMAL PROCESSING. (6) TEST IF CHANNEL END * 45660002 * IS DUE TO AUTOMATIC COMMAND RETRY AND, IF SO AND IF THE * 45690002 * RETRY OCCURRED ON A READ CONTROL RECORD CCW, BRANCH TO THE * 45720002 * DIE ROUTINE TO RE-PROCESS THE CONTROL RECORD SINCE ERRONEOUS * 45750002 * DATA MAY HAVE BEEN PROCESSED THE FIRST TIME. (7) IF NONE OF * 45780002 * THE ABOVE CONDITIONS ARE MET, THE ASSUMPTION IS MADE THAT * 45810002 * PCI PROCESSING ON THE CURRENT CHANNEL PROGRAM WAS TOO LATE * 45840002 * IN SETTING THE TIC CCW TO SUCCESSFULLY COMPLETE THE CCW * 45870002 * CHAIN AND THE POST STATUS NORMAL ROUTINE WILL TAKE THE * 45900002 * RETURN TO IOS WHICH WILL CAUSE A RESTART OF THE CHANNEL * 45930002 * PROGRAM. * 45960002 * Y02081 * 45990002 *********************************************************************** 46020002 SPACE 46050002 USING IOSB,WKRG1 ADDRESSABILITY FOR IOSB Y02081 46080002 FTCE01 EQU * START OF POST STATUS Y02081 46110002 * NORMAL EXIT ROUTINE Y02081 46140002 TM IOSFLA,IOSEX IS THE EXCEPTION FLAG ON? Y02081 46170002 * (UNIT EXCEPTION OR WRONG Y02081 46200002 * LENGTH RECORD PRESENT) Y02081 46230002 BCR 1,WKRG14 IF SO, RETURN TO IOS Y02081 46260002 STM WKRG0,WKRG15,0(WKRG13) SAVE REGISTERS Y02081 46290002 BALR WKRG11,0 ESTABLISH ADDRESSABILITY Y02081 46320002 USING *,WKRG11 SET LOCAL BASE REGISTER Y02081 46350002 FTCE0101 L WKRG6,IOSUSE GET FETCH WORKAREA BASE Y02081 46380002 USING WKFETCH,WKRG6 WORKAREA ADDRESSABILITY Y02081 46410002 CLI FTCPSRCH+SRCHTIC,READOP IS THE CURRENT CHANNEL Y02081 46440002 * PROGRAM READING THE NOTE Y02081 46470002 * LIST FOR AN OVLY MODULE? Y02081 46500002 BE FTCE030 IF SO, BRANCH Y02081 46530002 CLI IOSCOD,IOSFTCHC IS THIS A COMMAND S20201,Y02081 46560002 * RETRY (ECF)? S20201,Y02081 46590002 BE FTCE020 IF SO, BRANCH S20201 46620002 TM XFLAG2,BADREC INVALID REC FOUND IN DIE? Y02081 46650002 BO NRMEXIT IF SO, EXIT NORMALLY Y02081 46680002 TM XFLAG1,RELERR INVALID RLD ADDR FOUND? Y02081 46710002 BO NRMEXIT IF SO, EXIT NORMALLY Y02081 46740002 TM XFLAG2,CTLERR INVALID CTL REC ADDR FOUND? Y02081 46750002 BO NRMEXIT IF SO, EXIT NORMALLY Y02081 46760002 TM XFLAG2,TXTFIX PGFIX NEEDED FOR TEXT? Y02081 46770002 BO FTCE040 IF SO, BRANCH TO PROCESS Y02081 46800002 TM FTFLG4,RLDEND TEST FOR RLD END 46830002 BO NRMEXIT IF SO, EXIT NORMALLY Y02081 46860002 TM FTFLG4,LASTREC TEST PCI END 46890002 BO NRMEXIT NO TO SIO YM2881 46920002 SPACE 46950002 * *** *** *** *** *** *** *** *** 46980002 * *** BY PROCESS OF ELIMINATION IT IS *** 47010002 * *** ASSUMED THAT POST STATUS NORMAL HAS BEEN *** 47040002 * *** ENTERED BECAUSE THE CCWS WERE NOT *** 47070002 * *** CHAINED IN TIME TO CONTINUE *** 47080002 * *** THEIR EXECUTION *** 47090002 * *** *** *** *** *** *** *** *** Y02081 47100002 SPACE 47130002 SR WKRG7,WKRG7 CLEAR WORK REGISTER Y02081 47160002 ICM WKRG7,ADDR,IOSCSWCA GET ADDRESS OF THE LAST READ Y02081 47190002 * COUNT CCW EXECUTED Y02081 47220002 TM XFLAG1,RPSDEV RPS CHANNEL PROGRAM? Y02081 47250002 BZ FTCE010A BRANCH IF NOT Y02081 47280002 SPACE 47282002 * RESET TO POINT TO THE SET SECTOR 47284002 SPACE 47286002 LRA WKREGB,FTCPSRCH REAL ADDR OF CH. PROG Y02081 47290002 ST WKREGB,IOSRST STORE IN IOSB Y02081 47300002 LA WKREGB,FTCPSRCH VIRTUAL ADDR OF CH. PROG Y02081 47302002 ST WKREGB,IOSVST SAVE IN IOSB Y02081 47304002 SPACE 47306002 S WKRG7,F24 POINT TO READ COUNT CCW Y02081 47310002 B FTCE010B BYPASS NEXT SUBTRACT Y02081 47340002 FTCE010A S WKRG7,F16 POINT TO READ COUNT CCW Y02081 47370002 SPACE 47400002 * DONT UPDATE THE 31-08-08 IF WE MISSED THE PCI APPENDAGE UPDATING. 47430002 SPACE 47460002 FTCE010B EQU * TEST IF CP WAS UPDATED 47490002 CLI CCWSZ(WKRG7),TIC NOP UPDATED TO A TIC? YM1078 47520002 BNE RESTRT GO IF NO-REEXECUTE PCI YM1078 47550002 SPACE 47580002 * WE CAN UPDATE THE 31-08-08 AT THIS TIME TO POINT TO THE NEXT 47610002 * CHANNEL PROGRAM STRING TO SAVE US RE-EXECUTING THE CURRENT 47640002 * STRING OF CHANNEL PROGRAMS. 47670002 SPACE 47700002 ICM WKRG8,ADDR,CCWSZ+CCWADR(WKRG7) GET LAST CHANNEL Y02081 47730002 * PROGRAM TIC-TO ADDRESS Y02081 47740002 STCM WKRG8,ADDR,FTCPSRCH+SCHTICAD UPDATE SRCH TIC CP Y02081 47760002 L WKRG10,0(WKRG7) GET ADDR OF COUNT BUFFER Y02081 47790002 SPACE 47820002 * CONVERT THE REAL ADDRESS OF THE COUNT BUFFER TO VIRTUAL 47850002 * SO IT CAN BE REFERENCED. 47880002 LA WKRG9,WKFETCH GET VIRT ADDR OF WORKAREA Y02081 47910002 N WKRG9,PAGEMASK TRUNC TO PRIOR PAGE BNDRY Y02081 47940002 N WKRG10,STRIPMSK GET BYTE ADDR OF CNT BUFF Y02081 47970002 OR WKRG10,WKRG9 ADD SEG/PAGE TO GET FULL Y02081 48000002 * VIRTUAL ADDRESS. 48030002 MVC IOSEEK+CCHHR(SKSIZ),0(WKRG10) SET IOSB A43723,Y02081 48060002 * RESTART ADDRESS 48070002 MVC FTIOBSK+CCHHR(SKSIZ),IOSEEK+CCHHR UPDATE Y02081 48090002 * SEARCH-ID SEEK ADDRESS Y02081 48100002 MVC IOSEEKA+CCHHR(SKSIZ),IOSEEK+CCHHR UPDATE IOSB Y02081 48120002 * DYNAMIC SEEK ADDRESS Y02081 48122002 SPACE 48130002 * CHECK IF WE ARE IN A CHANNEL PROGRAM LOOP BY SEEING IF WE 48140002 * REITERATIVELY KEEP ISSUING THE SAME IOBSEEK ADDRESS 48142002 SPACE 48144002 CLC FTIOBSK+3(SKSIZ),XIOBSEK2 SAME IOBSEEK ADDRESS? Y02018 48146002 BNE FTCE010F GO IF NO LOOP Y02081 48148002 SPACE 48148102 * SET ON INDICATOR IN WORK AREA TO CAUSE MAINLINE CODE TO 48150102 * ISSUE ABEND X'COD' TO GIVE CONTROL TO FETCH ESTAE ROUTINE 48158102 * WHEN FETCH IS IN A LOOP AND TERMINATE. 48158502 SPACE 48158602 OI XFLAG2,CPLOOP SET LOOP INDICATOR Y02081 48158702 B NRMEXIT ACCEPT CH END (TERMINATE I/O) Y02081 48158802 SPACE 48159002 FTCE010F EQU * SETUP FOR LOOP DETECTION Y02018 48162502 MVC XIOBSEK2,XIOBSEK1 UPDATE SAVED IOBSEEK Y02018 48166002 MVC XIOBSEK1,FTIOBSK+3 SAVE CURRENT IOBSEEK Y02018 48169502 SPACE 48173002 RESTRT LM WKRG0,WKRG15,0(WKRG13) RESTORE REGISTERS Y02081 48176502 B 8(RETURNRG) RETURN TO RESTART REQUEST YM2881 48180002 NRMEXIT EQU * ACCEPT CHANNEL END 48250002 LM WKRG0,WKRG15,0(WKRG13) RESTORE REGISTERS Y02081 48270002 BR RETURNRG RETURN TO IOS FOR NORMAL Y02081 48300002 * COMPLETION OF THE I/O Y02081 48330002 SPACE 2 48340002 * ACR(AUTOMATIC COMMAND RETRY). 48350002 * ACR HAS OCCURED. WE HAVE TO DETERMINE IF ACR OCCURRED ON THE 48352002 * CCW WHICH WAS READING THE CONTROL/RLD RECORD. IF THIS 48354002 * CONDITION IS TRUE, THEN WE HAVE TO GO BACK TO THE PCI APPENDAGE 48356002 * AND REUPDATE THE NEXT CCW STRING AS WE MAY HAVE UPDATED DURING 48358002 * OUR PCI PROCESSING WHILE COMMAND RETRY WAS OCCURRING. THE 48358402 * CONTROL/RLD DATA AT THAT TIME MAY HAVE BEEN BAD CAUSING US TO 48358802 * UPDATE OUR NEXT CHANNEL PROGRAM INCORRECTLY. 48359202 SPACE 48359602 FTCE020 EQU * START OF ACR LOGIC 48359702 TM XFLAG1,RELERR RELOCATE ERROR? Y02081 48359802 BCR 1,RETURNRG GO IF RELOCATE ERROR Y02081 48359902 SPACE 48369902 SR WKRG7,WKRG7 CLEAR WORK REGISTER Y02081 48390002 ICM WKRG7,ADDR,IOSCSWCA LOAD CSW CCW PTR A45572,Y02081 48420002 LRA WKRG8,0(WKRG7) REAL ADDR FOR TIC CCW 48450002 STCM WKRG8,ADDR,FTCPSRCH+SRCHTIC+1 STORE IN CHAN PGM Y02081 48480002 SPACE 48490002 * UPDATE THE SEEK ADDRESS TO CORRESPOND TO THE 31-08-08 TIC ADDRESS 48500002 SPACE 48510002 L WKRG9,IOSERP POINT TO ERP WORK AREA Y02081 48520002 SPACE 48520802 USING EWA,WKRG9 SET ERP WORKAREA BASE 48522002 SPACE 48524002 MVC IOSEEK+CCHHR(SKSIZ),EWDSNS8 UPDATE SEEK ADDRESS Y02081 48530002 MVC FTIOBSK+CCHHR(SKSIZ),EWDSNS8 UPDATE SEEK ADDRESS Y02081 48530402 MVC IOSEEKA+CCHHR(SKSIZ),EWDSNS8 UPDATE SEEK ADDRESS Y02081 48530802 MVC XSECTAD,EWDSNS13 UPDATE SECTOR ADDRESS Y02081 48530902 SPACE 48531202 DROP WKRG9 DROP ERP WORKAREA BASE Y02081 48532002 SPACE 48532402 * LH WKRG11,2(WKRG1) ACTIVE UCB FROM RQE A45572 48534002 * L WKRG11,24(WKRG11) GET SEEK ADDRESS AND A45572 48540002 * MVC 35(5,IOBREG),8(WKRG11) STORE IN IOB A45572 48570002 L WKRG9,FTTBLPTR LOAD TBL POINTER A45572 48600002 L WKRG12,TBLBUFAD(WKRG9) LOAD LOC OF CURR RLD BUF A45572 48630002 LA WKRG12,(FTCP1+RDCNT2)-FTRBUF1(WKRG12) GET A45572,Y02081 48660002 * LOCATION OF LAST READ A45572,Y02081 48690002 * COUNT CCW A45572,Y02081 48720002 CR WKRG12,WKRG7 TEST IF RETRY ON LAST RD RLD A45572 48750002 BNE FTCE021 AND BR IF NOT A45572 48810002 ST WKRG9,FTLASTBF UPDATE BUFFER POINTER Y02081 48880002 OI XFLAG2,ACRRELOC INDICATE RELOCATE REQD Y02081 48890002 B FTCE022 GO REDO PCI PROCESSING Y02081,A45572 49050002 SPACE 49100002 FTCE021 L WKRG9,FTLASTBF LOAD LAST TBL POINTER A45572 49170002 L WKRG12,TBLBUFAD(WKRG9) LOAD LOC OF LAST RLD BUF A45572 49200002 LA WKRG12,(FTCP1+RDCNT2)-FTRBUF1(WKRG12) GET A45572,Y02081 49230002 * LOCATION OF LAST A45572,Y02081 49260002 * READ COUNT CCW A45572,Y02081 49290002 CR WKRG12,WKRG7 TEST IF RETRY ON RD RLD A45572 49320002 BE FTCE022 AND BR IF YES A45572 49350002 TM FTFLG4,LASTREC AS MODULE END BEEN FOUND? OS69131 49370402 BZ RESTRT NO,RETURN ON RETRY VECTOR Y02081 49370502 SPACE 49370602 * POST IOSB WITH NORMAL COMPLETION. THIS IS INSTEAD OF 49370702 * PSNE POSTING. THEY DIDN'T WANT TO ADD CODE TO TEST 49370802 * FOR FETCH RETURNING FROM HERE. RETURN ON +0 VECTOR 49388002 * TO GET CONTROL IN MAINLINE AS FETCH IS FINISHED. 49390002 SPACE 49398002 MVI IOSCOD,POSTIOSB NORMAL COMPLETION CODE YM8292 49400002 B NRMEXIT IF SO, TAKE CHANNEL END OS69131 49405402 SPACE 49422702 FTCE022 EQU * SET TO RE-EXEC PCI UPDATING Y02081 49440002 LA WKRG15,FTPCI01 PCI APPENDAGE ADDRESS A45572 49490002 LM WKRG10,WKRG12,0(WKRG9) SET REGS FOR PCI APPNDAGE A45572 49620002 NI XFLAG2,ALL-(TXTFIX+BADREC+CTLERR) RESET ALL BIT Y02081 49630002 * SWITCHES WHICH MIGHT HAVE Y02081 49640002 * BEEN SET INCORRECTLY DUE TO Y02081 49642002 * A COMMAND RETRY DATA ERROR Y02081 49644002 SPACE 49694002 DROP WKRG11 DROP PSNE BASE YM6999 49704002 USING FTPCI01,CODEREG SET BASE TO PCI YM6999 49706002 SPACE 49708002 B FTPCI014 GO TO PCI APPENDAGE A45572 49710002 SPACE 49720002 DROP CODEREG DROP PCI BASE REGISTER YM6999 49730002 SPACE 2 49730402 USING FTCE0101,WKRG11 RESET ADDRESSABILITY Y02081 49732002 SPACE 3 49740002 ********************************************************************* 49750002 *---- CHANNEL END OCCURRED ON A NOTELIST READ...SET TO READ TEXT Y02081 49770002 SPACE 49800002 FTCE030 EQU * START OF NOTELIST READ LOGIC Y02081 49830002 ST WKRG1,FTREGSV SAVE REG 1 (IOSB PTR) Y02081 49920002 LRA WKRG7,FTCP1 POINT TO 1ST CHAN PROG Y02081 49950002 ST WKRG7,FTCPSRCH+SRCHTIC SET TIC ADDR IN SEARCH CP Y02081 49980002 MVI FTCPSRCH+SRCHTIC,TIC SET TIC OP CODE Y02081 50010002 LRA WKRG7,FTIOBSK+3 POINT TO TEXT SEEK ADDR Y02081 50040002 STCM WKRG7,ADDR,FTCPSRCH+SCHIDAD SET SEARCH ID ADDR Y02081 50070002 FTCE030A L WKRG1,XLOFIX POINT TO START OF FIX Y02081 50100002 L WKRG2,XHIFIX POINT TO END OF FIX Y02081 50130002 LTR WKRG1,WKRG1 ANYTHING TO FREE? Y02081 50160002 BZ FTCE030C IF NOT, BRANCH Y02081 50190002 LA WKRG0,FTFXECB POINT TO ECB YM1726 50220002 L WKRG4,XFTCBAD POINT TO TCB YM1726 50250002 L WKRG15,CVTPTR GET CVT PTR Y21179 50290002 USING CVT,WKRG15 CVT ADDRESSABILITY Y21179 50292002 L WKRG15,CVTVPSIB PAGE SERVICE RTN EP Y21179 50294002 DROP WKRG15 DROP CVT BASE 50296002 ICM WKRG1,HIBYT,PGFREE SET PGFREE INDICATOR Y02081 50310002 BALR WKRG14,WKRG15 GO TO PGFREE ROUTINE TO FREE Y02081 50340002 * THE NOTELIST Y02081 50370002 FTCE030C TM XFLAG2,TXTFIX HANDLING TXT OUT OF FIX? Y02081 50400002 BO FTCE030B IF SO, BRANCH Y02081 50430002 L WKRG1,FTCP1 POINT TO START OF TEXT Y02081 50460002 LA WKRG1,0(WKRG1) CLEAR HIGH-ORDER BYTE Y02081 50490002 ST WKRG1,XTXTAD SAVE ADDR FOR TRANSLATE Y02081 50520002 LH WKRG7,FTCP1+CCWLEN GET LENGTH OF TXT TO READ Y02081 50550002 AR WKRG7,WKRG1 GET ADDR OF NEXT TEXT LOC Y02081 50580002 ST WKRG7,XNEXTLOC SAVE FOR CCW TRANSLATE Y02081 50610002 LA WKRG7,FTCP1 POINT TO READ TEXT CCW Y02081 50640002 ST WKRG7,XCCWAD SAVE ADDR FOR TRANSLATE Y02081 50670002 FTCE030B L WKRG1,XTXTAD RESET TXT START ADDR Y02081 50700002 LR WKRG2,WKRG1 GET TEXT START ADDRESS Y02081 50730002 A WKRG2,FIXLIMIT ADD MAX AMOUNT TO FIX Y02081 50760002 C WKRG2,XEOMAD COMPARE TO END OF MODULE Y02081 50790002 BNH FTCE031 IF HIGH, USE EOM AS LIMIT Y02081 50820002 L WKRG2,XEOMAD POINT TO END OF MODULE Y02081 50850002 FTCE031 EQU * CONTINUE Y02081 50880002 C WKRG2,XNEXTLOC WILL FIX COVER THE REC? Y02081 50910002 BNL FTCE032 IF SO, BRANCH Y02081 50940002 L WKRG2,XNEXTLOC IF NOT, USE REC SIZE FIX Y02081 50970002 FTCE032 EQU * CONTINUE Y02081 51000002 ST WKRG1,XLOFIX SAVE FIX START ADDR Y02081 51030002 ST WKRG2,XHIFIX SAVE FIX END ADDR Y02081 51060002 FTCE033 NI 0(WKRG1),ALL FORCE A PAGE REFERENCE Y02081 51090002 A WKRG1,PAGESIZE POINT TO NEXT PAGE Y02081 51120002 CR WKRG1,WKRG2 END OF FIX AREA? Y02081 51150002 BL FTCE033 IF NOT, CONTINUE LOOP Y02081 51180002 BCTR WKRG2,0 POINT TO LAST BYTE Y02081 51210002 NI 0(WKRG2),ALL REFERENCE THE LAST BYTE Y02081 51240002 LA WKRG2,1(WKRG2) RESET FIX AREA END PTR Y02081 51270002 L WKRG1,XLOFIX RESET START OF FIX AREA Y02081 51300002 XC FTFXECB,FTFXECB SET ECB TO ZEROES YM1726 51330002 LA WKRG0,FTFXECB POINT TO ECB YM1726 51360002 L WKRG4,XFTCBAD POINT TO TCB YM1726 51390002 L WKRG15,CVTPTR GET CVT PTR Y21179 51430002 USING CVT,WKRG15 CVT ADDRESSABILITY Y21179 51432002 L WKRG15,CVTVPSIB PAGE SERVICE RTN EP Y21179 51434002 DROP WKRG15 DROP CVT BASE Y21179 51436002 ICM WKRG1,HIBYT,PGFIX SET PGFIX INDICATOR Y02081 51450002 BALR WKRG14,WKRG15 GO TO PGFIX ROUTINE TO Y02081 51480002 * FIX THE TEXT AREA Y02081 51510002 LA WKRG1,0(WKRG1) CLEAR HIGH-ORDER BYTE YM1795 51516002 LTR WKRG15,WKRG15 TEST PGFIX COMPLETE Y02081 51540002 BZ FTCE035 IF SO, BRANCH Y02081 51570002 * IF NOT, REFERENCE ALL THE Y02081 51600002 * PAGES AGAIN TO FORCE THE Y02081 51630002 * PGFIX TO COMPLETE (TO RESOLVE Y02081 51660002 * THE PAGE FAULTS) Y02081 51690002 FTCE034 NI 0(WKRG1),ALL FORCE A PAGE REFERENCE Y02081 51720002 A WKRG1,PAGESIZE POINT TO NEXT PAGE Y02081 51750002 CR WKRG1,WKRG2 END OF FIX AREA? Y02081 51780002 BL FTCE034 IF NOT, CONTINUE LOOP Y02081 51810002 BCTR WKRG2,0 POINT TO LAST BYTE Y02081 51840002 NI 0(WKRG2),ALL REFERENCE THE LAST BYTE Y02081 51870002 FTCE035 LR WKRG1,FTBASE2 SAVE REGISTER 13 Y02081 51900002 LR FTBASE2,WKBASE SET WORK AREA BASE FOR MAIN Y02081 51930002 * LINE SUBROUTINE Y02081 51960002 LR WKRG2,FTBASE1 SAVE REGISTER 11 Y02081 51990002 L FTBASE1,FTMAIN SET MAINLINE BASE REG Y02081 52020002 USING FT001,FTBASE1 MAINLINE ADDRESSABILITY Y02081 52050002 BAL WKRG12,FTTRN01 TRANSLATE THE RDTEXT CCW Y02081 52080002 LR FTBASE2,WKRG1 RESTORE REGISTER 13 Y02081 52110002 LR FTBASE1,WKRG2 RESTORE REGISTER 11 Y02081 52140002 DROP FTBASE1 DROP MAINLINE BASE Y02081 52170002 USING FTCE0101,WKRG11 RESET ADDRESSABILITY Y02081 52200002 SPACE 52230002 TM XFLAG2,TXTFIX HANDLING TXT OUT OF FIX? Y02081 52260002 BO FTCE043 IF SO, BRANCH Y02081 52290002 L WKRG1,FTREGSV RESTORE IOSB POINTER Y02081 52320002 MVC IOSEEK,FTIOBSK UPDATE IOSB STATIC SEEK Y02081 52350002 MVC IOSEEKA,IOSEEK UPDATE IOSB DYNAMIC SEEK Y02081 52380002 LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 52410002 B 8(RETURNRG) RETURN TO RESTART CHN PGM Y02081 52440002 SPACE 52470002 *---- CHANNEL END OCCURRED AFTER THE DIE ROUTINE DISCOVERED THAT THE 52500002 *---- NEXT TEXT RECORD WILL NOT FIT WITHIN THE AREA CURRENTLY FIXED 52530002 *------ SET UP NEW FIX, RESET CHANNEL PROGRAM, AND RE-DRIVE Y02081 52560002 SPACE 52590002 FTCE040 STM WKRG0,WKRG15,FTREGSV SAVE REGISTERS Y02081 52620002 L WKRG1,FTRESTRT GET ADDR OF LAST RLD BUF Y02081 52650002 LA CODEREG,DIERELOC POINT TO RELOCATE RTN Y02081 52680002 LTR WKRG1,WKRG1 ANYTHING TO RELOCATE? Y02081 52710002 BZ FTCE041 IF NOT, BRANCH Y02081 52740002 BALR LINKREG,CODEREG RELOCATE THE BUFFER Y02081 52770002 LM WKRG0,WKRG14,FTREGSV RESTORE REGISTERS Y02081 52800002 TM XFLAG1,RELERR ERROR FOUND? Y02081 52830002 BZ FTCE041 IF NOT, BRANCH Y02081 52860002 B NRMEXIT TOWARD TERMINATION Y02081 52890002 FTCE041 L WKRG2,FTTBLPTR POINT TO CURRENT TAB ENT Y02081 52920002 L WKRG1,TBLBUFAD(WKRG2) POINT TO CURRENT RLD BUF Y02081 52950002 TM 0(WKRG1),ENDFLG IS NEXT TXT LAST OF MOD? Y02081 52980002 BZ FTCE042 IF NOT, BRANCH Y02081 53010002 L WKRG2,TBLCPAD(WKRG2) POINT TO NEXT CHAN PROG Y02081 53040002 MVI RDCT1FL(WKRG2),PCI SET NEXT RDCNT CCW TO PCI Y02081 53070002 * WITH NO COMMAND CHAINING Y02081 53100002 MVI FTFLG4,LASTCTL SET PCI END FLAG ON Y02081 53130002 FTCE042 BALR LINKREG,CODEREG PROCESS CURRENT BUFFER Y02081 53160002 LM WKRG0,WKRG15,FTREGSV RESTORE REGISTERS Y02081 53190002 TM XFLAG1,RELERR RELOCATE ERROR FOUND? Y02081 53220002 BO NRMEXIT IF SO, GO RETURN Y02081 53250002 B FTCE030A GO TO RESET FIX AND Y02081 53280002 * TRANSLATE RDTXT CCW Y02081 53310002 FTCE043 L WKRG1,FTTBLPTR POINT TO CURRENT TAB ENT Y02081 53340002 LM WKRG2,WKRG4,0(WKRG1) LOAD CURRENT TABLE ENTRY Y02081 53370002 TM FTFLG4,LASTCTL END OF MODULE FOUND? Y02081 53400002 BO FTCE043A IF SO, BRANCH Y02081 53430002 MVI RDCT1FL(WKRG3),CMCH+PCI SET PCI IN NEXT CH PGM Y02081 53460002 MVI TICOFFST(WKRG3),NOP SET NOP IN NEXT CHAN PROG Y02081 53490002 FTCE043A LRA WKRG5,0(WKRG3) REAL ADDR OF NEXT CHN PGM Y02081 53520002 STCM WKRG5,ADDR,FTCPSRCH+SCHTICAD UPDATE SRCH CH PGM Y02081 53550002 OI XFLAG1,ACTXTFLG SET ACTIVE TXT READ FLAG Y02081 53580002 ST WKRG2,FTTBLPTR UPDATE CURRENT TAB PTR Y02081 53610002 MVI (FTCP1+RDCT1FL)-FTRBUF1(WKRG4),CMCH TURN OFF Y02081 53640002 * PCI IN LAST CHAN PROG Y02081 53650002 MVI (FTCP1+20)-FTRBUF1(WKRG4),CMCH+SILI TURN OFF Y02081 53670002 * PCI IN LAST CHAN PROG Y02081 53680002 L WKRG5,(FTCP1+RDCNT2)-FTRBUF1(WKRG4) GET REAL Y02081 53700002 * ADDR OF THE LAST RDCNT BUFFER Y02081 53730002 LR WKRG7,WKBASE GET VIRT ADDR OF WORKAREA Y02081 53760002 N WKRG7,PAGEMASK TRUNCATE TO PAGE START Y02081 53790002 N WKRG5,STRIPMSK BYTE ADDR OF RDCNT BUFFER Y02081 53820002 OR WKRG5,WKRG7 VIRTUAL ADDR OF RDCNT BUF Y02081 53850002 L WKRG1,FTREGSV+4 RESTORE IOSB POINTER Y02081 53880002 MVC FTIOBSK+CCHHR(SKSIZ),0(WKRG5) RESET SEARCH-ID Y02081 53910002 * SEEK ADDRESS Y02081 53920002 MVC IOSEEK+CCHHR(SKSIZ),FTIOBSK+CCHHR RESET IOSB Y02081 53940002 * STATIC SEEK ADDRESS Y02081 53950002 MVC IOSEEKA+CCHHR(SKSIZ),IOSEEK+CCHHR RESET IOSB Y02081 53970002 * DYNAMIC SEEK ADDRESS Y02081 53980002 XC FTRESTRT,FTRESTRT CLEAR RESTART POINTER Y02081 54000002 XC FTLASTBF,FTLASTBF CLEAR LAST BUFFER PTR Y02081 54030002 NI XFLAG2,ALL-TXTFIX CLEAR TXT OUT OF FIX FLAG Y02081 54060002 LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 54120002 B 8(RETURNRG) GO TO RE-DRIVE CHAN PROG Y02081 54150002 SPACE 54180002 FTMAIN DC A(FT001) MAINLINE FETCH BASE ADDR Y02081 54210002 PGFIX DC B'01000000' FLAG BYTE FOR A PGFIX Y02081 54270002 PGFREE DC B'00100000' FLAG BYTE FOR A PGFREE Y02081 54300002 SPACE 54330002 DROP WKRG1 DROP IOSB BASE Y02081 54360002 DROP WKRG6 DROP FETCH WORKAREA BASE Y02081 54390002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...DISABLED INTERRUPT X54420002 EXIT(DIE) ROUTINE (PCI PROCESSING)' 54430002 *********************************************************************** 54450002 * * 54480002 * DISABLED INTERUPT EXIT (DIE) ROUTINE (PCI PROCESSING) * 54510002 * * 54540002 * IOS WILL GIVE CONTROL TO THIS ROUTINE EACH TIME AN INTERUPT * 54570002 * IS FIELDED WHICH IS ASSOCIATED WITH A FETCH CHANNEL PROGRAM * 54600002 * (I.E. AN INTERUPT ASSOCIATED WITH AN IOSB GENERATED BY * 54630002 * FETCH). THE DIE ROUTINE WILL IMMEDIATELY RETURN TO IOS FOR * 54660002 * NORMAL PROCESSING TO CONTINUE ON ALL INTERUPT CONDITIONS * 54690002 * OTHER THAN A FETCH GENERATED PCI INTERRUPT. WHEN ENTERED * 54720002 * THIS ROUTINE WILL FIRST ASCERTAIN THAT REQUIRED PORTION OF * 54750002 * CONTROL/RLD RECORD CURRENTLY BEING READ IS PRESENT IN THE * 54780002 * BUFFER. THIS IS DONE BY PRIMING THE THIRTEENTH BYTE OF THE * 54810002 * BUFFER WITH X'FF'. THE THIRTEENTH BYTE OF A CONTROL/RLD * 54840002 * RECORD WILL ALWAYS CONTAIN X'00'. THE DIE ROUTINE USES A * 54870002 * DISABLED BIT SPIN (FOR WHICH A PERMANENT STANDARDS DEVIATION * 54900002 * EXISTS) TO WAIT UNTIL X'FF' IS NO LONGER FOUND IN THAT BYTE * 54930002 * POSITION OF THE BUFFER. AT THIS POINT, THE FIRST BYTE OF THE * 54960002 * BUFFER WHICH WAS JUST FILLED WILL INDICATE THE TYPE OF THE * 54990002 * NEXT RECORD. IF THE NEXT RECORD IS A TEXT RECORD THEN THE * 55020002 * NEXT CHANNEL PROGRAM WILL BE INITIALIZED WITH THE SIZE AND * 55050002 * ADDRESS AT WHICH THE RECORD WILL BE READ AND THE NOP IN THIS * 55080002 * CHANNEL PROGRAM WILL BE ALTERED TO TIC TO THE READ TEXT CCW * 55110002 * IN THE NEXT CHANNEL PROGRAM. IF THE NEXT RECORD IS AN RLD * 55140002 * RECORD THEN THE NOP IN THIS CHANNEL PROGRAM WILL BE ALTERED * 55170002 * TO TIC TO THE READ RLD CCW IN THE NEXT CHANNEL PROGRAM. * 55200002 * BEFORE RETURNING TO IOS THE RLD RECORD, IF ANY, READ BY THE * 55230002 * PREVIOUS CHANNEL PROGRAM IS RELOCATED BY THE DIE RELOCATE * 55260002 * ROUTINE AND THE TIC TO ADDRESS IN THE SEARCH ID CHANNEL * 55290002 * PROGRAM IS RE-INITIALIZED (FOR RESTART). * 55320002 * Y02081 * 55350002 *********************************************************************** 55380002 USING *,CODEREG ESTABLISH ADDRESSABILITY Y02081 55410002 FTPCI01 EQU * START OF THE DIE ROUTINE Y02081 55440002 USING IOSB,IOBREG ESTABLISH ADDRESSABILITY Y02081 55470002 * FOR THE IOSB Y02081 55500002 TM IOSTSB,PCIFLG DETERMINE IF THE DIE HAS Y02081 55530002 * BEEN ENTERED FOR A PCI Y02081 55560002 BCR 8,RETURNRG IF NOT, RETURN TO IOS Y02081 55590002 STM WKRG0,WKRG15,0(WKRG13) SAVE REGISTERS FOR IOS Y02081 55620002 L WKBASE,IOSUSE GET ADDRESS OF FETCH WORK Y02081 55650002 * AREA (SAVED IN IOSB) Y02081 55680002 USING WKFETCH,WKBASE ESTABLISH ADDRESSABILITY Y02081 55710002 * FOR THE FETCH WORK AREA Y02081 55740002 TM XFLAG1,RELERR WAS AN INVALID ADDR FOUND Y02081 55770002 * ON THE LAST DIE ENTRY? Y02081 55800002 BO FTPCI015 IF SO, GO RETURN TO IOS Y02081 55830002 L WKRG8,FTTBLPTR LOAD TABLE ENTRY PTR Y02081 55860002 LM WKRG10,WKRG12,0(WKRG8) LOAD TABLE ENTRY Y02081 55890002 SPACE 55920037 ********************************************************************** 55980002 NI (FTCP1+RDCT2FL)-FTRBUF1(WKRG12),ALL-PCI YM1209,YM1082 56010002 * TURN OFF PCI BIT IN 2ND YM1082 56040002 * RD-CNT CCW (MAY BE SET BY YM1082 56070002 * EXTENT VERIFICATION ROUTINE) YM1082 56100002 SPACE 56110002 USING UCB,UCBREG SET ADDRESSABILITY FOR UCB Y02081 56120037 * ZA06138 56125037 LH WKRG9,UCBCHAN GET CHAN ADDRESS FROM UCB Y02081 56130002 DROP UCBREG DROP UCB BASE Y02081 56140002 FTPCI011 TM SPINBYTE(WKRG12),ALL PSEUDO WAIT Y02081 56160002 BZ FTPCI012 BR REC IN CORE 56190002 BM FTPCI021 IF MIXED, BRANCH TO INDICATE OS57077 56200002 * AN INVALID RECORD OS57077 56210002 TM FTFLG4,LASTCTL TEST LAST TXT INDIC 56220002 BZ FTPCI013 IF NOT ON, CONTINUE BIT SPIN 56250002 MVI FTFLG4,LASTREC IF LST-TXT SW ON, SET END PCI 56280002 FTPCI015 LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 56310002 BR RETURNRG AND RETURN TO IOS Y02081 56340002 FTPCI013 TCH 0(WKRG9) TEST FOR CHANNEL BUSY Y02081 56370002 BC 2,FTPCI011 BRANCH IF CHAN STILL BUSY 56400002 TM SPINBYTE(WKRG12),ALL HAS RECORD COME IN WHILE YM1082 56430002 * WE WERE GOING TO TSTCHN? YM1082 56460002 BZ FTPCI012 IF SO, PROCESS IT YM1082 56490002 BM FTPCI021 IF MIXED, BRANCH TO INDICATE OS57077 56500002 * AN INVALID RECORD OS57077 56510002 LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 56520002 BR RETURNRG AND RETURN TO IOS Y02081 56550002 FTPCI012 EQU * BEGIN PROCESSING CTL/RLD DATA Y02081 56580002 ST WKRG8,FTLASTBF SAVE THIS BUF AS LAST M6068,Y02081 56610037 SPACE 56820002 FTPCI014 EQU * ENTER HERE FROM CHAN END FOR ACR 56850002 L WKRG9,TBLBUFAD(WKRG10) ADDRESS OF NEXT RLD Y02081 56880002 * BUFFER FROM NEXT TBL ENTRY 56910002 MVI SPINBYTE(WKRG9),ALL SET PSEUDO WAIT FLAG Y02081 56940002 ********************************************************************** 56970002 SPACE 57000037 *FTPCI019 EQU * 57100037 TM 0(WKRG12),TSTBITS TEST FOR INVALID RECORD Y02081 57390002 BZ FTPCI02 GO IF VALID Y02081 57420002 FTPCI021 OI XFLAG2,BADREC INDICATE INVALID RECORD Y02081 57450002 FTPCI022 EQU * TERMINATE FETCH I/O 57480002 LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 57510002 BR RETURNRG AND RETURN TO IOS Y02081 57540002 FTPCI02 TM 0(WKRG12),CTLFLG TEST BUF FOR CONTROL REC Y02081 57570002 BZ FTPCI05 IF NOT, GO TO PROCESS AS RLD A43723 57600002 * 57630002 * VERIFY THE NEW TEXT RECORD IS WITHIN THE CURRENT FIXED AREA 57660002 * BEFORE CHAINING THE NEXT CHANNEL PROGRAM TO READ IT. 57690002 * 57720002 LM WKRG8,WKRG9,CTLCCW(WKRG12) GET CCW FROM CTL REC Y02081 57750002 ST WKRG9,CCWFLG(WKRG11) STORE FLAGS/COUNT IN CCW Y02081 57780002 LA WKRG8,0(WKRG8) CLEAR HIGH BYTE Y02081 57810002 A WKRG8,FTRPTR RELOCATE TEXT DATA ADDR Y02081 57840002 C WKRG8,XLOFIX TEST RECORD LOCATION Y02081 57870002 BNL FTPCI023 BRANCH IF TXT NOT BELOW Y02081 57900002 * LOWER FIX BOUNDARY Y02081 57930002 FTPCI028 OI XFLAG2,TXTFIX SET INDICATOR THAT TEXT TO BE Y02081 57960002 * READ IS OUTSIDE FIXED AREA Y02081 57990002 ST WKRG8,XTXTAD UPDATE TEXT TRANSLATE PTR Y02081 58050002 ST WKRG11,XCCWAD UPDATE CCW TRANSLATE PTR Y02081 58080002 AH WKRG8,CCWLEN(WKRG11) ADD TEXT LEN TO TEXT ADDR Y02081 58110002 ST WKRG8,XNEXTLOC SAVE AS NEXT TEXT LOC PTR Y02081 58140002 B FTPCI042 GO TO RETURN Y02081 58170002 FTPCI023 LR WKRG9,WKRG8 GET TEXT START ADDRESS Y02081 58200002 AH WKRG9,CCWLEN(WKRG11) ADD TXT LEN TO TXT ADDR Y02081 58230002 SPACE 58240002 * TEST IF NEXT TEXT RECORD EXCEEDS END OF MODULE. 58250002 SPACE 58252002 C WKRG9,XEOMAD GREATER THAN MODULE? Y02081 58254002 BNH FTPCI02D GO IF WITHIN MODULE Y02081 58256002 SPACE 58258002 OI XFLAG2,CTLERR ELSE INDICATE ERROR Y02081 58258402 B FTPCI022 GO TAKE ERROR IN MAINLINE Y02081 58258802 SPACE 58259202 FTPCI02D EQU * TEST IF CURRENTLY FIXED AREA 58259602 * WILL HOLD THE TEXT TO BE READ 58259702 C WKRG9,XHIFIX TEST END OF RECORD LOC Y02081 58260002 BH FTPCI028 BRANCH IF BEYOND FIX Y02081 58290002 ST WKRG9,XNEXTLOC SAVE TEXT POINTER Y02081 58320002 * 58350002 * TRANSLATE THE NEW TEXT-READ CCW. 58380002 * 58410002 BCTR WKRG9,0 POINT TO LAST BYTE OF RECORD Y02081 58440002 N WKRG9,PAGEMASK ADJUST TO PRIOR PAGE BOUNDARY Y02081 58500002 CR WKRG9,WKRG8 COMPARE LAST PAGE ADDR TO THE Y02081 58560002 * FIRST DATA BYTE ADDRESS Y02081 58590002 BH FTPCI024 BRANCH IF A PAGE IS CROSSED 58620002 SPACE 58650002 * RECORD IS CONTAINED IN A SINGLE PAGE...NO IDAL REQ'D. 58680002 LRA WKRG9,0(WKRG8) GET REAL TEXT ADDRESS Y02081 58710002 STCM WKRG9,ADDR,CCWADR(WKRG11) STORE READ ADDR IN CCW Y02081 58740002 NI CCWFLG(WKRG11),ALL-IDALFLAG CLEAR IDAL INDICATOR Y02081 58770002 B FTPCI027 GO SET UP REST OF NEXT CP 58800002 SPACE 58830002 * PREPARE CCW FOR IDAL USE. 58860002 FTPCI024 STM WKRG3,WKRG4,FTREGSV SAVE REGS NEEDED FOR XLATE Y02081 58890002 L WKRG3,XIDALP2 GET AUX IDAL BUILD AREA 58920002 MVC XIDALP2,XIDALP1 EXCHANGE IDALS FOR NEXT PCI 58950002 ST WKRG3,XIDALP1 EXCHANGE IDALS FOR NEXT PCI 58980002 LRA WKRG4,0(WKRG3) GET IDAL REAL ADDRESS 59010002 STCM WKRG4,ADDR,CCWADR(WKRG11) REAL ADDR IN RDTXT CCW Y02081 59040002 OI CCWFLG(WKRG11),IDALFLAG TURN ON IDAL FLAG IN CCW Y02081 59070002 * BUILD IDAL ENTRIES 59100002 LR WKRG9,WKRG8 LOC OF TEXT RECORD Y02081 59130002 AH WKRG9,CCWLEN(WKRG11) ADD SIZE OF TEXT RECORD Y02081 59160002 BCTR WKRG9,0 DECR TO ADDRESS LAST BYTE Y02081 59190002 N WKRG9,BLOKMASK TRUNCATE TO GET LAST 2K Y02081 59220002 * BOUNDARY Y02081 59250002 LRA WKRG4,0(WKRG8) GET REAL ADDRESS OF 1ST Y02081 59280002 * TEXT BYTE Y02081 59310002 N WKRG8,BLOKMASK ADJUST DATA POINTER TO NEXT Y02081 59340002 * LOWER 2K BOUNDARY Y02081 59370002 FTPCI025 ST WKRG4,0(WKRG3) STORE REAL ADDR IN IDAL 59400002 A WKRG8,BLOKSIZE ADDRESS OF NEXT 2K BLOCK Y02081 59430002 CR WKRG8,WKRG9 IS NEXT PAGE BEYOND LAST Y02081 59460002 * PAGE OF TEXT ? Y02081 59490002 BH FTPCI026 BRANCH IF TRANSLATE DONE 59520002 LA WKRG3,IDALNTRY(WKRG3) INDEX TO NEXT IDAL ENTRY 59550002 LRA WKRG4,0(WKRG8) OBTAIN REAL ADDRESS OF PAGE Y02081 59580002 B FTPCI025 CONTINUE LIST CREATION 59640002 * END OF TRANSLATION 59670002 FTPCI026 LM WKRG3,WKRG4,FTREGSV RESTORE TRANSLATE REGS Y02081 59700002 FTPCI027 EQU * UPDATE FETCH CHANNEL PROGRAM 59730002 SPACE 59760002 MVI RDCT1FL(WKRG11),CMCH+PCI SET NEXT PCI Y02081 59790002 MVI TICOFFST(WKRG11),NOP NXT CH PRG TO NOP Y02081 59820002 SPACE 59850002 * BUFFER HAS CONTROL DATA..CHAIN THE NEXT CP TO READ TXT+RLD. 59880002 LRA WKRG8,0(WKRG11) GET REAL ADDR FOR TIC CCW Y02081 59910002 O WKRG8,FTPCIMSK INCLUDE TIC COMMAND CODE Y02081 59940002 ST WKRG8,(FTCP1+TICOFFST)-FTRBUF1(WKRG12) PLACE Y02081 59970002 * REAL TIC ADDR IN CHANNEL PROG Y02081 60000002 OI XFLAG1,ACTXTFLG SET ACTIVE TXT CCW FLAG ON 60030002 SPACE 60060002 ST WKRG10,FTTBLPTR UPDATE TABLE PTR Y02081 60090002 TM 0(WKRG12),ENDFLG TEST END Y02081 60120002 BZ FTPCI032 BRANCH NOT END S20201 60150002 MVI RDCT1FL(WKRG11),PCI PCI WITH NO CC Y02081 60180002 MVI FTFLG4,LASTCTL SET LAST TXT INDIC 60210002 * 60240002 * INTERFACE TO DIE RELOCATE ROUTINE 60270002 * 60300002 FTPCI032 CLI IOSCOD,IOSFTCHC TEST FOR COMMAND RETRY A45572,Y02081 60330002 BNE FTPCI033 BRANCH IF NOT ACR A45572 60390002 SPACE 60392002 TM XFLAG2,ACRRELOC ALREADY RELOCATED? Y02081 60400002 BZ FTPCI04 GO IF PREV RELOCATED Y02081 60410002 SPACE 60410402 NI XFLAG2,ALL-ACRRELOC RELOCATE SWITCH OFF Y02081 60412002 SPACE 60414002 FTPCI033 EQU * SETUP FOR RELOCATION 60416002 STM WKRG0,WKRG15,FTREGSV SAVE REGS ACROSS POST A45572 60420002 L WKRG1,FTRESTRT POINT TO LAST RLD OR CONTROL Y02081 60450002 * RECORD READ Y02081 60480002 LTR WKRG1,WKRG1 WAS THERE A PREVIOUS RLD? Y02081 60510002 BZ FTPCI034 IF NOT, BRANCH Y02081 60540002 LA CODEREG,DIERELOC POINT TO RELOCATE ROUTINE Y02081 60630002 BALR LINKREG,CODEREG LINK TO RELOCATE ROUTINE Y02081 60660002 FTPCI034 EQU * CONTINUE CHAN PROG UPDATING Y02081 60690002 LM WKRG0,WKRG15,FTREGSV RESTORE REGS AFTER RELOCATE 60720002 TM XFLAG1,RELERR WAS AN ERROR ENCOUNTERED? Y02081 60750002 BO FTPCI022 IF SO, BRANCH Y02081 60780002 FTPCI04 MVI (FTCP1+RDCT1FL)-FTRBUF1(WKRG12),CMCH CLEAR PCI Y02081 60810002 MVI (FTCP1+RDRLDFL)-FTRBUF1(WKRG12),CMCH+SILI CLEAR Y02081 60840002 * PCI ON READ RLD CCW Y02081 60850002 L WKRG9,FTRESTRT GET ADDRESS OF LAST CHANNEL Y02081 60870002 * PROGRAM RESTART Y02081 60900002 LTR WKRG9,WKRG9 0=1ST RD NO RESTART SETUP Y02081 60930002 BZ FTPCI041 IF ZERO, BYPASS Y02081 60960002 CLI IOSCOD,IOSFTCHC IS THIS AN ECF ERROR? S20201,Y02081 60990002 BE FTPCI041 IF SO, BYPASS RESET A45572 61050002 L WKRG10,(FTCP1+TICOFFST)-FTRBUF1(WKRG9) S20201,Y02081 61080002 * LAST TIC ADDRESS FOR RESTART Y02081 61110002 SPACE 61120002 * IF AN EXTENT HAS BEEN CROSSED IN THE CURRENT CHANNEL PROGRAM, 61140002 * THE RESTART SEQUENCE WILL HAVE BEEN SET TO TIC DIRECTLY TO 61170002 * THE READ COUNT CCW WHICH RECEIVED THE UNIT CHECK AND THE 61200002 * ARGUMENT OF THE SEARCH-ID CCW WILL BE CORRECT FOR THE NEW 61230002 * EXTENT. IN THIS CASE, THE FOLLOWING CODE SHOULD BE BYPASSED 61260002 * TO AVOID RESETTING THE SEARCH-ID AND TIC SEQUENCE TO RE-READ 61290002 * THE LAST RECORD OF THE OLD EXTENT ON A RESTART AND CAUSE THE 61320002 * UNIT CHECK TO RE-APPEAR IN A LOOP. YM1209 61350002 A WKRG10,F8 POINT TO RDCNT CCW YM1209 61380002 C WKRG10,FTCPSRCH+SRCHTIC IS RESTART ALREADY SET YM1209 61410002 * TO GO TO THE RDCNT IN THE YM1209 61440002 * CURRENT CHANNEL PROGRAM? YM1209 61470002 BE FTPCI041 IF SO, BYPASS RESET YM1209 61500002 A WKRG10,F16 POINT TO 2ND RDCNT CCW YM1209 61530002 C WKRG10,FTCPSRCH+SRCHTIC IS RESTART SET TO GO TO YM1209 61560002 * 2ND RDCNT IN CURRENT CP? YM1209 61590002 BE FTPCI041 IF SO, BYPASS RESET YM1209 61620002 S WKRG10,F24 POINT BACK TO RD DATA CCW YM1209 61650002 ST WKRG10,FTCPSRCH+SRCHTIC STORE FOR RESTART Y02081 61680002 L WKRG10,(FTCP1+RDCNT2)-FTRBUF1(WKRG9) ADDRESS OF Y02081 61710002 * SEEK ADDRESS BUFFER Y02081 61720002 SPACE 61740002 * CONVERT THE REAL ADDRESS OF THE COUNT BUFFER TO VIRTUAL 61770002 * SO IT CAN BE REFERENCED. 61800002 LA WKRG9,WKFETCH GET VIRT ADDR OF WORKAREA Y02081 61830002 N WKRG9,PAGEMASK TRUNC TO PRIOR PAGE BNDRY Y02081 61860002 N WKRG10,STRIPMSK GET BYTE ADDR OF CNT BUFF Y02081 61890002 OR WKRG10,WKRG9 ADD SEG/PAGE TO GET FULL Y02081 61920002 * VIRTUAL ADDRESS. 61950002 MVC IOSEEK+CCHHR(SKSIZ),0(WKRG10) SET IOSB A43723,Y02081 61980002 * RESTART ADDRESS Y02081 61990002 MVC FTIOBSK+CCHHR(SKSIZ),IOSEEK+CCHHR UPDATE Y02081 62010002 * SEARCH-ID SEEK ADDRESS Y02081 62020002 MVC IOSEEKA+CCHHR(SKSIZ),IOSEEK+CCHHR UPDATE IOSB YM1082 62040002 * DYNAMIC SEEK ADDR Y02081 62050002 FTPCI041 ST WKRG12,FTRESTRT SAV ADR FOR NXT PCI RESTR Y02081 62070002 FTPCI042 LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 62100002 CLI IOSCOD,IOSFTCHC TEST FOR COMMAND RETRY Y02081 62110002 BE 8(RETURNRG) IF SO, RETRN ON RESTRT VECTOR Y02081 62120002 RETURN 62130002 * 62160002 * BUFFER HAS RLD DATA ONLY...CHAIN THE NEXT CP TO READ RLD. 62190002 * 62220002 FTPCI05 TM 0(WKRG12),RLDFLG DOES BUFFR HAVE RLD DATA? Y02081 62250002 BZ FTPCI021 IF NOT,BRANCH-INVALID REC Y02081 62280002 ST WKRG10,FTTBLPTR UPDATE CURRENT TABLE PTR Y02081 62310002 FTPCI05A TM 0(WKRG12),ENDFLG TEST FOR END OF MODULE Y02081 62340002 BZ FTPCI06 IF NOT, BRANCH 62370002 MVI FTFLG4,LASTREC IF SO, SET END COND 62400002 B FTPCI032 GO TO RELOCATE INTERFACE S20201 62430002 FTPCI06 LA WKRG9,CPRDRLD(WKRG11) POINT TO NEXT RD-RLD CCW Y02081 62460002 MVI TICOFFST(WKRG11),NOP SET NOP IN NEXT CHAN PROG Y02081 62490002 MVI RDRLDFL(WKRG11),CMCH+SILI+PCI SET NEXT PCI Y02081 62520002 NI XFLAG1,ALL-ACTXTFLG TURN OFF ACTIVE TXT FLAG 62550002 LRA WKRG9,0(WKRG9) GET REAL ADDR FOR TIC CCW Y02081 62580002 O WKRG9,FTPCIMSK SET OP CODE 247,Y02081 62610002 ST WKRG9,(FTCP1+TICOFFST)-FTRBUF1(WKRG12) UPDATE Y02081 62640002 * NOP CCW TO A TIC 247,Y02081 62670002 B FTPCI032 GO TO RELOCATE INTERFACE S20201 62700002 SPACE 62710002 DROP IOBREG DROP IOSB BASE Y02081 62730002 DROP CODEREG DROP APPENDAGE BASE Y02081 62760002 DROP WKBASE DROP FETCH WORKAREA BASE Y02081 62790002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...APPENDAGES C62840002 CONSTANTS.' 62842002 * 62850002 * APPENDAGE CONSTANTS 62880002 * 62910002 DS 0F FORCE FULLWORD ALIGNMENT 247 62940002 FTPCIMSK DC X'08000000' MASK FOR TIC OP-CODE 247 62970002 F8 DC F'8' USED FOR SUBTRACT YM1209 63030002 F16 DC F'16' USED FOR SUBTRACT Y02081 63060002 F24 DC F'24' USED FOR SUBTRACT Y02081 63090002 SPACE 2 63210002 *------- THE FOLLOWING FETCH CONSTANTS PRESUME 63240002 * PAGE SIZE FOR THE SYSTEM IS 4K. 63270002 * 63300002 PAGESIZE DC F'4096' SYSTEM PAGE SIZE 63330002 PAGEMASK DC XL4'FFFFF000' MASK FOR REMOVING THE BYTE 63360002 * PORTION OF AN ADDRESS. 63390002 * (IE. ADJUSTS TO A PAGE BNDRY) 63420002 STRIPMSK DC XL4'FF000FFF' MASK FOR REMOVING THE SEG/PG 63450002 * PORTION OF AN ADDRESS. 63480002 * (IE. YIELDS THE BYTE ADDRESS) 63510002 *---------------------------------- 63540002 SPACE 2 63570002 *------- THE FOLLOWING CONSTANT DEFINES THE 63600002 * MAXIMUM NUMBER OF BYTES FETCH MAY FIX 63630002 * FOR AN I/O OPERATION DURING THE LOAD. 63660002 * 63690002 FIXLIMIT DC F'18432' 18K BYTE FIX LIMIT 63720002 *---------------------------------- 63750002 SPACE 2 63780002 *-------- THE FOLLOWING CONSTANTS FOR IDAL CONSTRUCTION 63810002 * ARE BASED ON 2K LIST ENTRIES USED BY CHANNEL. 63840002 * 63870002 BLOKSIZE DC F'2048' 2K BLOCK LENGTH 63900002 BLOKMASK DC XL4'FFFFF800' MASK FOR TRUNC TO 2K BNDRY 63930002 EJECT 64860002 *********************************************************************** 64890002 * DIE RELOCATE ROUTINE * 64920002 * THE FOLLOWING SUBROUTINE PERFORMS ADCON RELOCATION IN A * 64950002 * DISABLED STATE IN THE DISABLED INTERUPT EXIT (DIE) ROUTINE * 64980002 * OF PRGRAM FETCH. WHEN A PCI CAUSES THE DIE ROUTINE TO * 65010002 * RECEIVE CONTROL, THE RLD OR CONTROL RECORD READ BY THE * 65040002 * PREVIOUS SUB-CHANNEL PROGRAM (THE ONE PRIOR TO THE ONE * 65070002 * GENERATING THE PCI) IS NECESSARILY COMPLETELY READ INTO * 65100002 * THE APPROPRIATE RLD BUFFER AND THERFORE READY TO BE * 65130002 * PROCESSED. THIS IS DONE IN THE DIE ROUTINE BECAUSE IT IS * 65160002 * IMPOSSIBLE TO OBTAIN IN A DISABLED STATE THE LOCK REQUIRED * 65190002 * TO BE HELD IN ORDER TO POST TO MAIN LINE FETCH AND * 65220002 * THEREFORE NO PRACTICAL MEANS OF SUB-PROGRAM COMMUNICATION * 65250002 * EXISTS TO ALLOW ENABLED RLD PROCESSING TO HAVE ANY * 65280002 * LIKELIHOOD OF BEING COMPLETED IN TIME TO FREE THE BUFFER * 65310002 * FOR THE NEXT TIME IT IS NEEDED. * 65340002 * Y02081 * 65370002 * REGISTER USAGE. 65380002 * 65390002 * 0=END OF RLD RECORD. 65392002 * 1=RELOCATION ADDRESS(MODULE START ADDRESS) 65394002 * 2=INTERNAL BRANCH LABEL 65396002 * 3=INTERNAL BRANCH LABEL 65398002 * 4=INTERNAL BRANCH LABEL 65398402 * 5=INTERNAL BRANCH LABEL 65398802 * 6=FETCH WORK AREA BASE 65399202 * 7=START OF MODULE ADDRESS FOR RLD VALIDATION(XSOMAD) 65399602 * 8=END OF MODULE ADDRESS FOR RLD VALIDATION(XEOMAD) 65399702 * 9=ADCON MANIPULATION 65399802 * 10=ADCON MANIPULATION 65399902 * 11=ADCON MANIPULATION 65409902 * 12=RLD SIZE FOR STEPPING ACROSS RLD RECORDS 65419902 * 13=USED TO POINT TO EACH RLD ITEM IN RLD RECORD 65423202 * 14=RETURN ADDRESS 65425202 * 15=DIE RELOCATE BASE 65425602 * 65426002 *********************************************************************** 65426702 SPACE 2 65430002 USING *,CODEREG SET ADDRESSABILITY Y02081 65460002 USING WKFETCH,WKBASE WORK AREA ADDRESSABILITY Y02081 65490002 DIERELOC EQU * REG 1 POINTS TO THE RLD Y02081 65520002 * BUFFER TO BE PROCESSED Y02081 65550002 TM 0(WKRG1),RLDFLG DOES IT CONTAIN RLD'S? Y02081 65580002 BCR 8,WKRG14 IF NOT, RETURN TO CALLER Y02081 65610002 LA WKRG13,RLDATA(WKRG1) POINT TO 1ST RLD ITEM Y02081 65640002 LR WKRG0,WKRG13 POINT TO START OF RLD'S Y02081 65670002 AH WKRG0,RLDLEN(WKRG1) ADD LENGTH OF RLD DATA Y02081 65700002 * TO POINT TO END OF RLD'S Y02081 65730002 LA WKRG2,RELOC02 POINT TO RELOC02 FOR BCR Y02081 65760002 LA WKRG3,RELOC03 POINT TO RELOC03 FOR BCR Y02081 65790002 LA WKRG4,RELOC04 POINT TO RELOC04 FOR BCR Y02081 65820002 LA WKRG5,RELOC05 POINT TO RELOC05 FOR BCR Y02081 65850002 L WKRG1,FTRPTR GET MODULE RELOCATION FACTOR Y02081 65880002 LA WKRG12,4 SET INCREMENT FOR SCANNING Y02081 65940002 * THE RLD RECORD Y02081 65970002 SR WKRG9,WKRG9 CLEAR WORK REGISTER Y02081 66000002 SR WKRG10,WKRG10 CLEAR WORK REGISTER Y02081 66030002 L WKRG7,XSOMAD POINT TO START OF MODULE Y02081 66060002 * FOR RLD VALIDATION Y02081 66090002 L WKRG8,XEOMAD POINT TO END OF MODULE Y02081 66120002 * Y02081 66150002 * THE MAIN PROCESSING LOOP BEGINS HERE Y02081 66180002 * Y02081 66210002 RELOC02 AR WKRG13,WKRG12 POINT TO FLAG/ADDR FIELD Y02081 66240002 CR WKRG13,WKRG0 END OF THE RLD'S? Y02081 66270002 BCR 10,WKRG14 IF SO, RETURN Y02081 66300002 TM 0(WKRG13),RELREQ RELOCATION REQUIRED? Y02081 66330002 BCR 7,WKRG5 IF NOT, GO TO RELOC05 Y02081 66360002 ICM WKRG9,ADDR,1(WKRG13) GET ADDR OF ADCON Y02081 66390002 AR WKRG9,WKRG1 RELOCATE ADDR OF ADCON Y02081 66420002 CR WKRG9,WKRG7 IS ADCON WITHIN MODULE? Y02081 66450002 BL RELOCERR IF NOT, RETURN WITH AN Y02081 66480002 * INDICATION THAT AN INVALID Y02081 66510002 * ADDRESS WAS ENCOUNTERED Y02081 66540002 NI 0(WKRG13),ADCLEN ISOLATE LENGTH BITS OF Y02081 66600002 IC WKRG10,0(WKRG13) RLD FLAG FIELD Y02081 66630002 SRL WKRG10,2 SHIFT LENGTH TO LOW ORDER Y02081 66660002 LA WKRG11,0(WKRG9,WKRG10) POINT TO END OF ADCON Y02081 66690002 CR WKRG11,WKRG8 IS ADCON WITHIN MODULE? Y02081 66720002 BNL RELOCERR IF NOT, RETURN WITH ERROR Y02081 66750002 IC WKRG10,BITMSK(WKRG10) GET MASK FOR ICM INSTRCTN Y02081 66780002 EX WKRG10,GETADCN LOAD THE ADCON Y02081 66810002 TM 0(WKRG13),RELNEG POSITIVE RELOCATION? Y02081 66840002 BCR 8,WKRG3 IF SO, GO TO RELOC03 Y02081 66870002 SR WKRG11,WKRG1 SUBTRACT RELOC FACTOR Y02081 66900002 BR WKRG4 GO TO RELOC04 Y02081 66930002 RELOC03 AR WKRG11,WKRG1 ADD RELOCATION FACTOR Y02081 66960002 RELOC04 EX WKRG10,STRADCN STORE THE RELOCATED ADCON Y02081 66990002 RELOC05 TM 0(WKRG13),SAMERP SAME R&P POINTERS? Y02081 67020002 BCR 1,WKRG2 IF SO, GO TO RELOC02 Y02081 67050002 AR WKRG13,WKRG12 IF NOT, ADD LENGTH OF R&P Y02081 67080002 * POINTER FIELD Y02081 67110002 BR WKRG2 AND GO TO RELOC02 Y02081 67140002 RELOCERR OI XFLAG1,RELERR INDICATE THAT AN INVALID Y02081 67170002 * ADCON ADDRESS WAS FOUND Y02081 67200002 * IN THE RLD RECORD BEING Y02081 67230002 * PROCESSED Y02081 67260002 BR WKRG14 AND RETURN TO CALLER Y02081 67290002 SPACE 2 67320002 BITMSK DC B'00000000',B'00000011',B'00000111',B'00001111' Y02081 67350002 * MASKS FOR ICM INSTRUCTIONS TO LOAD 2,3 OR 4 BYTE Y02081 67380002 * ADCONS Y02081 67410002 SPACE 67420002 GETADCN ICM WKRG11,B'0000',0(WKRG9) EXECUTED INSTRUCTION TO Y02081 67440002 * LOAD AN ADCON Y02081 67470002 STRADCN STCM WKRG11,B'0000',0(WKRG9) EXECUTED INSTRUCTION TO Y02081 67500002 * STORE A RELOCATED ADCON Y02081 67530002 FTFXEND EQU * LAST BYTE FOR DIE FIX Y21179 67540002 DROP WKBASE DROP FETCH WORKAREA BASE Y02081 67560002 DROP CODEREG DROP SUBROUTINE BASE Y02081 67590002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...PURGE SUBROUTINE' 67620002 *********************************************************************** 67650002 * * 67680002 * IEWFTPRG -- PURGE SUBROUTINE FOR FETCH * 67710002 * * 67740002 * THIS SUBROUTINE RECEIVES CONTROL FROM IOS WHENEVER THE * 67770002 * SYSTEM IS UNDERGOING A PURGE. IF ANY SRB/IOSB'S WHICH * 67800002 * BELONG TO FETCH ARE FOUND ON ANY OF IOS'S QUEUES, THEY * 67830002 * ARE PASSED TO THE PURGE SUBROUTINE CHAIED TO THE IPIB. * 67860002 * IF THE PURGE IS A QUIESE REQUEST, FETCH DOES NOTHING AND * 67890002 * IMMEDIATELY RETURNS (BR 14). IF IT IS A HALT REQUEST, * 67920002 * THE SUBROUTINE SEARCHES THE CHAIN OF SRB/IOSB'S TO FIND * 67950002 * ANY WHICH BELONG TO AN ACTIVE FETCH REQUEST AND MATCH THE * 67980002 * ARGUMENT OF THE PUGE (MEMORY, DATA SET OR TASK). ALL * 68010002 * MATCHING SRB/IOSB'S ARE FREED AND DELETED FROM THE CHAIN * 68040002 * BEFORE RETURNING. * 68070002 * Y02081 * 68100002 *********************************************************************** 68130002 SPACE 2 68160002 USING *,CODEREG TEMPORARY ADDRESSABILITY Y02081 68190002 USING IPIB,WKREGA SET IPIB BASE REGISTER Y02081 68220002 USING SRB,WKREGB SET SRB BASE REGISTER Y02081 68250002 IEWFTPRG EQU * START OF PURGE LOGIC Y02081 68280002 TM IPIBOPT,IPIBHALT IS THIS A HALT REQUEST? Y02081 68310002 BCR 8,RETURNRG IF NOT, RETURN Y02081 68340002 STM WKREGF,CODEREG,0(WKRG13) SAVE REGISTERS Y02081 68370002 SPACE 2 68380002 LR WKRG11,WKRG15 RESET BASE Y02081 68390002 DROP WKRG15 NOTIFY ASSEMBLER Y02081 68392002 SPACE 68394002 USING IEWFTPRG,WKRG11 TELL ASSEMBLER NEW BASE Y02081 68396002 LR WKREGD,WKREGA RESET IPIB POINTER REG Y02081 68400002 DROP WKREGA DROP CURRENT IPIB BASE Y02081 68430002 USING IOSB,WKREGA SET IOSB BASE REGISTER Y02081 68460002 USING IPIB,WKREGD RESET IPIB BASE REGISTER Y02081 68490002 LA WKRG6,IPIBSRB POINT TO IPIB CHAIN FIELD Y02081 68520002 L WKREGB,IPIBSRB POINT TO 1ST SRB IN CHAIN Y02081 68550002 LTR WKREGB,WKREGB IS CHAIN EMPTY? Y02081 68580002 BNZ FTPRG20 IF NOT, BRANCH Y02081 68610002 FTPRG10 LM WKREGF,CODEREG,0(WKRG13) RESTORE REGISTERS Y02081 68640002 BR RETURNRG AND RETURN Y02081 68670002 FTPRG20 L WKREGA,SRBPARM POINT TO IOSB Y02081 68700002 CLI IOSDVRID,IOSFCHID DOES IT BELONG TO FETCH? Y02081 68730002 BE FTPRG40 IF SO, BRANCH Y02081 68760002 FTPRG30 LA WKRG6,SRBFLNK POINT TO LAST CHAIN PTR Y02081 68790002 L WKREGB,SRBFLNK POINT TO NEXT SRB Y02081 68820002 LTR WKREGB,WKREGB END OF CHAIN? Y02081 68850002 BNZ FTPRG20 IF NOT, BRANCH Y02081 68880002 B FTPRG10 GO TO RETURN IF END Y02081 68910002 FTPRG40 L WKRG7,IOSUSE POINT TO FETCH WORKAREA Y02081 68940002 USING WKFETCH,WKRG7 WORKAREA ADDRESSABILITY Y02081 68970002 TM IPIBOPT,IPIBMEM IS IT A MEMORY PURGE? Y02081 69000002 BZ FTPRG50 IF NOT, BRANCH Y02081 69030002 LH WKRG5,IOSASID GET IOSB MEMORY ID Y02081 69060002 CH WKRG5,IPIBARG+2 SAME AS MEMORY PURGED? Y02081 69090002 BNE FTPRG30 IF NOT, GO TO CONTINUE Y02081 69120002 * SEARCHING THE CHAIN Y02081 69150002 FTPRG45 EQU * REMOVE I/O REQUEST FROM CHAIN Y02081 69160002 LR WKRG9,WKREGA SAVE IOSB POINTER Y02081 69270002 L WKREGA,IOSIPIB POINT TO IPIB @ZA27769 69272037 LTR WKREGA,WKREGA TEST FOR ZERO @ZA27769 69272537 BZ FTPRG46 NOT HERE SO BRANCH @ZA27769 69273037 LA WKREGF,1(0) MAKE REG O NONZERO @ZA27769 69274037 L CODEREG,CVTPTR GET CVT PTR @ZA27769 69276037 USING CVT,CODEREG CVT ADDRESSABILITY @ZA27769 69278037 L CODEREG,CVTIXAVL IOCOM ADDRESS @ZA27769 69280037 USING IOCOM,CODEREG IOCOM ADDRESSABILITY @ZA27769 69282037 L CODEREG,IOCQCNT PURGE/RESTORE ADDR @ZA27769 69284037 DROP CODEREG DROP CVT/IOCOM BASE @ZA27769 69286037 * POINT TO PURGE RESTORE @ZA27769 69288037 * ROUTINE TO DECREMENT/POST @ZA27769 69290037 * THE IPIB QUIESE COUNT/ECB @ZA27769 69292037 BALR LINKREG,CODEREG CALL THE IPIB ROUTINE @ZA27769 69294037 FTPRG46 EQU * @ZA27769 69297037 L WKREGB,SRBFLNK POINT TO NEXT SRB Y02081 69300002 ST WKREGB,0(WKRG6) RESET CHAIN POINTER IN Y02081 69330002 * PREVIOUS SRB (OR IPIB) Y02081 69360002 * TO POINT AROUND SRB TO Y02081 69390002 * BE FREED Y02081 69420002 L WKRG1,XLOFIX GET START ADDR OF FIXED Y02081 69450002 * TEXT READ-IN AREA Y02081 69480002 LTR WKRG1,WKRG1 ANY TEXT FIXED? Y02081 69510002 BZ FTPRG45A IF NOT, DON'T FREE ANY Y02081 69540002 L WKRG15,XHIFIX GET END ADDR FOR PGFREE Y02081 69570002 *------ NOTE -- ABOVE INSTRUCTION DESTROYS WORKAREA PTR Y02081 69600002 SPACE 69610002 * FREE THE TEXT FIXED AREA. 69620002 SPACE 69622002 PGFREE R,A=(WKRG1),EA=(WKRG15) FREE THE TEXT AREA Y02081 69630002 SPACE 2 69650002 * FREEING OF DIE ROUTINE MOVED TO THIS LOCATION BY APAR @ZA10542 69660037 * FREE THE DIE ROUTINE. BRANCH AROUND PGFREE IF DIE RTN WAS 69890037 * NOT FIXED. 69892037 SPACE 69894037 L WKRG1,FTPRGFXS POINT TO START ADDRESS Y02081 69896037 L WKRG15,FTPRGFXE POINT TO END ADDRESS Y02081 69898037 L WKRG5,CVTPTR GET CVT ADDRESS @ZA05457 69900037 USING CVT,WKRG5 CVT ADDRESSABILITY @ZA05457 69902037 CLM WKRG15,B'0111',CVTNUCB+1 DIE RTN IN FIXED LPA? @ZA05457 69904037 DROP WKRG5 @ZA05457 69906037 XC XLOFIX,XLOFIX INIDCATE TEXT UNFIXED 69908037 BNH FTPRG45A BRANCH IF IN FIXED LPA @ZA05457 69908537 SPACE 69909037 PGFREE R,A=(WKRG1),EA=(WKRG15) LET IT GO Y02081 69909537 SPACE 2 69910037 FTPRG45A EQU * CONTINUE 69910537 LR WKRG1,WKRG9 RESTORE REGISTER 1 Y02081 69911037 SPACE 69911537 * FREE THE SRB/IOSB. 69912037 SPACE 69912537 FREEMAIN R,LV=GLOBREQ,A=(WKRG1),SP=SQASP FREE SRB/IOSB Y02081 69913037 SPACE 2 69913537 OI XFLAG2,PRGFREE INDICATE RESOURCES FREED Y02081 69914037 LTR WKREGB,WKREGB END OF THE CHAIN FOUND? Y02081 69914537 BZ FTPRG10 IF SO, RETURN Y02081 69915037 SPACE 69915537 FTPRG51 B FTPRG20 IF NOT, CONTINUE SEARCH Y02081 69916037 FTPRG50 TM IPIBOPT,IPIBTASK IS IT TCB OR DSID PURGE? Y02081 69930002 BO FTPRG60 IF TCB PURGE, BRANCH Y02081 69960002 SPACE 69970002 L WKRG5,XORGDCB GET ORIGINAL DCB ADDRESS Y02081 70000002 L WKRG5,DCBDEBAD(WKRG5) GET ORIGINAL DEB ADDRESS Y02081 70010002 C WKRG5,IPIBARG SAME AS DSID PURGED? Y02081 70020002 BNE FTPRG30 IF NOT, GO TO CONTINUE Y02081 70050002 B FTPRG45 IF SO, GO TO FREE THE SRB Y02081 70080002 FTPRG60 L WKRG5,XFTCBAD GET FETCH TCB ADDRESS Y02081 70110002 C WKRG5,IPIBARG SAME AS TCB PURGED? Y02081 70140002 BNE FTPRG30 IF NOT, GO TO CONTINUE Y02081 70170002 B FTPRG45 IF SO, GO TO FREE THE SRB Y02081 70200002 SPACE 70230002 FTPRGFXS DC A(FTPCI01) ADDRESS OF DIE START Y02081 70240002 FTPRGFXE DC A(FTFXEND) ADDRESSOF DIE END Y02081 70250002 SPACE 2 70252002 DROP WKRG11 DROP BASE Y02081 70260002 SPACE 70270002 DROP WKREGA DROP IOSB BASE Y02081 70290002 DROP WKREGB DROP SRB BASE Y02081 70320002 DROP WKREGD DROP IPIB BASE Y02081 70350002 DROP WKRG7 DROP FETCH WORKAREA BASE Y02081 70380002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...EXTENT CHECK SUBROUTINE' 70410002 *********************************************************************** 70440002 * * 70470002 * EXTENT VERIFICATION ROUTINE (END-OF-EXTENT PROCESSING) * 70500002 * * 70530002 * THIS ROUTINE WILL RECEIVE CONTROL FROM THE DIRECT ACCESS * 70560002 * ERROR RECOVERY PROCEDURE WHENEVER THE DYNAMIC SEEK ADDRESS * 70590002 * (CCHH) CHANGES (I.E. AN END-OF-TRACK OR END-OF-CYLINDER * 70620002 * CONDITION IS ENCOUNTERED). THE FUNCTION OF THIS ROUTINE IS * 70650002 * FIRST TO DETERMINE IF THE CCHH ADDRESS OF THE NEXT RECORD * 70680002 * IS WITHIN THE CURRENT EXTENT BOUNDARIES. IF SO, CONTROL IS * 70710002 * RETURNED TO THE ADDRESS IN REGISTER 14 (NORMAL RETURN). IF * 70740002 * NOT, THE BOUNDARIES OF THE NEXT EXTENT, IF ONE EXITS, ARE * 70770002 * DETERMINED AND THE LOWER EXTENT BOUNDARY IS STORED IN THE * 70800002 * DYNAMIC SEEK ADDRESS FIELD OF THE IOSB. IF THE CURRENT EXTENT* 70830002 * WAS THE LAST EXTENT OF THE DATA SET, AN ABNORMAL RETURN IS * 70860002 * INDICATED BY RETURNING CONTROL TO THE ADDRESS IN REGISTER * 70890002 * 14 PLUS AN OFFSET OF 4. * 70920002 * * 70950002 * THE ROUTINE STARTS BY DETERMINING THE EXTENT, OR -M- * 70980002 * NUMBER, OF THE OLD EXTENT. THE UPDATED -M- NUMBER, M+1, IS * 71010002 * ALSO STORED IN THE DYNAMIC SEEK ADDRESS FIELD OF THE IOSB. * 71040002 * Y02081 * 71070002 *********************************************************************** 71100002 SPACE 71130002 USING *,CODEREG ESTABLISH ADDRESSABILITY A34466 71160002 SPACE 2 71190002 IEWFTXCK EQU * FETCH EXTENT CHECK EP Y02081 71220002 FTEOX01 EQU * START OF EXTENT CHECK RTN Y02081 71250002 USING IOSB,IOSREG ESTABLISH ADDRESSABILITY Y02081 71280002 * FOR THE IOSB Y02081 71310002 L IOBREG,IOSUSE GET THE ADDRESS OF THE Y02081 71340002 * FETCH WORK AREA FROM THE Y02081 71370002 * IOSB USER FIELD Y02081 71400002 USING WKFETCH,IOBREG ESTABLISH ADDRESSABILITY Y02081 71430002 * FOR THE FETCH WORK AREA Y02081 71460002 L DEBREG,IOSDSID GET DEB ADDRESS FROM IOSB Y02081 71490002 USING DEBBASIC,DEBREG ESTABLISH ADDRESSABILITY Y02081 71520002 * FOR THE DEB Y02081 71550002 STM WKRG10,WKRG12,FTREGSV SAVE WORK REGISTERS Y02081 71580002 SR WKRG11,WKRG11 CLEAR WORK REGISTER Y02081 71610002 IC WKRG11,IOSEEKA GET CURRENT M VALUE Y02081 71640002 SLL WKRG11,4 MULTIPLY BY FIELD SIZE Y02081 71670002 LA WKRG10,DEBBASND-DEBBASIC(WKRG11,DEBREG) POINT Y02081 71700002 * TO CURRENT DEB EXTENT FIELD Y02081 71710002 USING DEBDASD,WKRG10 ESTABLISH ADDRESSABILITY Y02081 71730002 * FOR THE DEB EXTENT DSECT Y02081 71760002 CLC IOSSKCC(L'DEBENDCC+L'DEBENDHH),DEBENDCC COMPARE Y02081 71790002 * CCHH OF NEXT RECORD TO UPPER Y02081 71820002 * BOUNDARY OF THE CURRENT DEB Y02081 71850002 * EXTENT 71860002 BH FTEOX05 IF NEXT RECORD IS OUTSIDE Y02081 71880002 * THE EXTENT, CONTINUE Y02081 71910002 B FTEOX10 GO TO ADJUST CHAN PROG AND YM1082 71940002 * TAKE THE NORMAL RETURN IF Y02081 71970002 * THE NEXT RECORD IS WITHIN Y02081 72000002 * CURRENT EXTENT BOUNDARIES Y02081 72030002 FTEOX05 EQU * GO TO NEXT EXTENT (IF ANY) Y02081 72090002 SR WKRG12,WKRG12 CLEAR REG USED TO DETERMINE A34466 72120002 * EXTENT NUMBER A34466 72150002 SR WKRG11,WKRG11 SAVE QTY OF EXTENTS IN DEB A34466 72210002 * ERROR IN THE EOX APPENDAGE WAS CORRECTED IN M3979 72270002 * PTM 3545. THIS PTM REMOVED A LINE OF BAD CODE. M3979 72300002 IC WKRG12,IOSSKM GET LAST M VALUE M3545,Y02081 72330002 LA WKRG12,1(WKRG12) INCREMENT TO NEW VALUE M3545 72360002 IC WKRG11,DEBNMEXT GET TOTAL NUMBER OF EXTENTS M3545 72390002 CR WKRG12,WKRG11 IS THERE ANOTHER EXTENT M3545 72450002 BL FTEOX08 YES, BRANCH M3545,Y02081 72480002 MVI IOSCOD,IOSEXTC INDICATE EXTENT VIOLATION Y02081 72510002 * AS I/O COMPLETION CODE Y02081 72540002 LM WKRG10,WKRG12,FTREGSV RESTORE WORK REGISTERS Y02081 72570002 B 4(RETURNRG) AND TAKE ERROR RETURN Y02081 72600002 FTEOX08 EQU * UPDATE TO NEXT EXTENT Y02081 72630002 STC WKRG12,IOSSKM PUT EXTENT OR -M- M3545,Y02081 72660002 * VALUE IN IOSB M3545,Y02081 72690002 SLL WKRG12,4 POINT TO PROPER Y02081 72720002 LA WKRG10,DEBBASND-DEBBASIC(WKRG12,DEBREG) M3545,YM1795 72750002 * EXTENT TABLE IN DEB M3545,Y02081 72756002 MVC IOSSKBB(DEBENDCC-DEBBINUM),DEBBINUM MOVE M3545,Y02081 72780002 * BEGINNING LOCATION OF NEXT Y02081 72810002 * EXTENT TO IOSB SEEK FIELD Y02081 72840002 MVC IOSFMSK(1),DEBDVMOD UPDATE FILE MASK IN IOSB @ZA08241 72850037 FTEOX10 EQU * SETUP TO RESTART FETCH I/O YM1082 72870002 MVI IOSSKR,REC0 SET R VALUE IN IOSB A34466,Y02081 72900002 * TO ZERO A34466,Y02081 72930002 SPACE 72960002 DROP WKRG10 DROP DEB EXTENT BASE A34466 72990002 SPACE 73020002 ICM WKRG10,ADDR,IOSCSWCA GET ADDR OF NEXT CCW Y02081 73050002 S WKRG10,EIGHT POINT TO LST CCW EXECUTED Y02081 73080002 TM CCWFLG(WKRG10),PCI IS PCI ON IN THE CCW YM1082 73110002 * RECEIVING FILE PROTECT? YM1082 73140002 BO FTEOX12 IF SO, BRANCH YM1082 73170002 CLI CCWSZ(WKRG10),NOP IS THE NEXT CCW A NOP? YM1082 73200002 BNE FTEOX12 IF NOT, BRANCH YM1082 73230002 TM FTFLG4,LASTREC HAS END OF SEGMENT BEEN YM1082 73260002 * FOUND IN DIE? YM1082 73290002 BO FTEOX12 IF SO, BRANCH YM1082 73320002 OI CCWFLG(WKRG10),PCI IF ALL THE ABOVE TESTS ARE YM1082 73350002 * SATISFIED, TURN ON THE PCI YM1082 73380002 * BIT IN THE CCW YM1082 73410002 *************************************************************** YM1082 73440002 * THE ABOVE CODE HANDLES THE CASE WHERE FILE PROTECT OCCURS ON YM1082 73470002 * THE 2ND RD-CNT CCW AFTER THE DIE RETURNS WITHOUT PROCESSING YM1082 73500002 * THE CONTROL RECORD. SETTING ON PCI IN THAT CCW GIVES THE DIE YM1082 73530002 * A SECOND CHANCE TO PROCESS THE RECORD. IF THIS WERE NOT DONE, YM1082 73560002 * POST STATUS NORMAL WOULD ATTEMPT TO RE-START THE CHANNEL YM1082 73590002 * PROGRAM WITH THE SEEK ADDRESS OUT OF PHASE. YM1082 73620002 *************************************************************** YM1082 73650002 FTEOX12 EQU * CONTINUE RESTART SETUP YM1082 73680002 LRA WKRG10,0(WKRG10) MAKE IT A REAL ADDRESS Y02081 73710002 STCM WKRG10,ADDR,FTCPSRCH+SCHTICAD UPDATE TIC IN Y02081 73740002 * SEARCH CHAN PROG Y02081 73750002 MVC IOSEEK,IOSEEKA UPDATE STATIC SEEK ADDR Y02081 73770002 MVC FTIOBSK(L'IOSEEKA),IOSEEKA UPDATE SRCH ARGUMENT Y02081 73800002 LM WKRG10,WKRG12,FTREGSV RESTORE WORK REGISTERS Y02081 73830002 BR RETURNRG AND TAKE THE NORMAL RETURN Y02081 73860002 * TO THE DASD ERP Y02081 73890002 SPACE 73920002 EIGHT DC F'8' USED FOR SUBTRACTION Y02081 73950002 SPACE 73980002 DROP IOSREG DROP IOSB BASE Y02081 74130002 DROP IOBREG DROP FETCH WORKAREA BASE Y02081 74160002 DROP DEBREG DROP DEB BASE Y02081 74190002 DROP CODEREG DROP APPENDAGE BASE Y02081 74220002 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...VAM PCI APPENDAGE' 74230002 ********************************************************************* 74240002 * 74242002 * 74244002 * PCI APPENDAGE FOR VAM DATA SETS 74246002 * 74248002 * 74248402 * FETCH'S PCI APPENDAGE FOR VAM DATA SETS IS GIVEN CONTROL 74248802 * EACH TIME FETCH'S CHANNEL PROGRAM GENERATES A PCI INTERRUPT. 74249202 * WHEN ENTERED, THIS ROUTINE WILL EXAMINE THE RECORD TYPE IN 74249602 * THE RLD/CTRL BUFFER. IF THE RECORD IS A RLD, IT WILL BRANCH 74249702 * TO A CLOSED SUB-ROUTINE TO RELOCATE ADCONS. THE RLD/CTRL 74249802 * BUFFER WILL ALSO BE EXAMINED TO DETERMINE IF CONTROL 74249902 * INFORMATION IS PRESENT. IF CONTROL INFORMATION IS PRESENT 74259902 * THE CHANNEL PROGRAM WILL BUILD NEXT READ TXT CCW FROM THE 74269902 * CONTROL RECORD INFORMATION. IF CONTROL INFROMATION ISN'T 74273202 * PRESENT, THE CHANNEL PROGRAM WILL BE SET TO READ THE NEXT 74275202 * RLD/CTRL RECORD. WHEN ALL PROCESSING IS COMPLETED, AN END 74275602 * OF MODULE INDICATOR IS SET AND A BRANCH IS TAKEN BACK TO IOS. 74276002 * 74276402 * 74276502 SPACE 74276602 USING *,WKRG15 BASE FOR PCI APPENDAGE Y02081 74284902 USING WKAREA,IOBREG BASE FOR WKCORE Y02081 74286902 SPACE 74287302 VPCI01 EQU * START OF VAM PCI APPENDAGE Y02081 74288902 SPACE 74289002 **** WHEN A RECOVERABLE ERROR OCCURS ON THE READ CTL/RLD CCW, 74289102 **** INCLUDING FILE PROTECT, THE PCI APPENDAGE IS GIVEN CONTROL 74289202 **** BEFORE THE DASD ERP GETS CONTROL AND RETRIES THE READ AND, 74291302 **** THEREFORE, BEFORE THE RECORD HAS BEEN READ CORRECTLY. IN 74293302 **** SUCH A CASE, THE APPENDAGE SHOULD IGNORE THE SITUATION AND 74293702 **** WAIT UNTIL IT IS RE-ENTERED AFTER THE ERP HAS RETRIED AND 74294102 **** THE RECORD HAS BEEN READ CORRECTLY. 74294502 SPACE 74294602 USING WICB,WKRG6 SET ADDRESSABILITY FOR WINDOW YM6928 74295802 * INTERCEPT CONTROL BLOCK (REG. YM6928 74297802 * 6 ALWAYS POINTS TO WICB ON YM6928 74297902 * ENTRY TO PCI APPENDAGE) YM6928 74298002 CLC WICERDSP,=H'12' IS THIS A RECOVERABLE ERROR YM6928 74298102 * SITUATION? YM6928 74298302 BCR 2,WKRG14 IF THE ERROR CODE IS GREATER YM6928 74298702 * THAN 12, IT IS, AND WE MUST YM6928 74298802 * RETURN TO VIO TO ALLOW THE YM6928 74299402 * ERP TO GET CONTROL YM6928 74299802 DROP WKRG6 DROP WICB BASE YM6928 74300202 SPACE 74300602 STM WKRG0,WKRG15,0(WKRG13) SAVE IOS REGISTERS Y02081 74301102 TM FTRBUF1,RLDFLG RECORD TYPE EQU RLD? Y02081 74301702 BZ VPCI02 BRANCH IF NO RLDS Y02081 74302302 STM WKRG0,WKRG15,FTREGSV SAVE REGS ACROSS RELOC Y02081 74302902 LA WKRG1,FTRBUF1 PASS BUFF ADDR TO RELOC Y02081 74303102 L WKRG15,VPCILOC GET ADDRESS OF RELOC Y02081 74305202 SPACE 74307302 LR WKBASE,IOBREG SET W.A. BASE FOR RELOC Y02081 74309402 SPACE 74311502 BALR WKRG14,WKRG15 BRANCH TO RELOC Y02081 74313602 * 74315702 * AFTER RELOCATION IS PERFORMED, VALIDITY CHECKING OF TH RLD 74317802 * ADDRESS AND THE SET UP OF THE NEXT CCW IS PERFORMED HERE. 74319902 * 74322002 SPACE 74324102 DROP IOBREG CHANGE TO RELOCATE BASE Y02081 74326202 SPACE 74328302 USING WKAREA,WKBASE WORKAREA BASE FOR RELOC RTN Y02081 74330402 LM WKRG0,WKRG15,FTREGSV RESTORE REGS AFTER RELOC Y02081 74332502 DROP WKBASE DROP RELOC RTN WORKAREA BASE Y02081 74334602 SPACE 74336702 USING WKAREA,IOBREG RESET FETCH W.A. BASE Y02081 74338802 SPACE 74340902 TM XFLAG1,RELERR INVALID RLD ADDRESS? Y02081 74343002 BO VPCIIVAL BRANCH INVALID ADDRESS Y02081 74345102 TM FTRBUF1,CTLFLG DOES CTRL INFO EXIST? Y02081 74347202 BO VPCICTRL YES, GO TO BUILD CCW Y02081 74349302 TM FTRBUF1,ENDFLG LAST RECORD? Y02081 74351402 BO VPCI03 SET END OF MODULE INDICATOR Y02081 74353502 LA WKREGA,FTCP1+VAMRDRLD GET ADDRESS OF RD RLD CCW Y02081 74355602 STCM WKREGA,ADDR,FTCP1+VAMNOPAD SET TIC TO READ RLD Y02081 74357702 B VPCIRET RETURN TO IOS Y02081 74359802 SPACE 74361902 VPCI03 MVI FTCP1+VAMNOPTC,NOP SET NEXT CCW TO NOP Y02081 74364002 B VPCIRET RETURN TO IOS Y02081 74366102 SPACE 74368202 VPCIIVAL MVI FTCP1+VAMNOPTC,NOP SET NOP IN NEXT CCW Y02081 74370302 OI XFLAG1,RELERR SET INVALID ADDR SWITCH Y02081 74372402 B VPCIRET RETURN TO IOS Y02081 74374502 SPACE 74376602 VPCI02 TM FTRBUF1,CTLFLG ANY CONTROL INFO? Y02081 74378702 BO VPCICTRL YES GO TO BUILD CCW Y02081 74380802 SPACE 74382902 * IT'S NEITHER CONTROL OR RLD, SO GIVE AN ERROR. 74385002 SPACE 74387102 MVI FTCP1+VAMNOPTC,NOP SET NOP IN NEXT CCW Y02081 74389202 OI XFLAG2,BADREC SET INVALID REC TYPE Y02081 74391302 B VPCIRET RETURN TO IOS Y02081 74393402 SPACE 74395502 ********************************************************************* 74397602 * 74399702 * THIS ROUTINE WILL BUILD THE CHANNEL PROGRAM TO READ THE NEXT 74401802 * TEXT RECORD. IT WILL ALSO VALIDITY CHECK THE MODULES BOUNDS. 74403902 * 74406002 * 74408102 VPCICTRL EQU * PROCESS CONTROL RECORD Y02081 74410202 LM WKRG9,WKRG10,FTRBUF1+CTLCCW LD NEXT TEXT CCW Y02081 74412302 A WKRG9,FTRPTR RELOC TEXT CCW Y02081 74414402 STM WKRG9,WKRG10,FTCP1 STORE CCW FOR NEXT TEXT RD Y02081 74416502 MVI FTCP1,RDOPMULT MAKE IT MULTI-TRACK YM5962 74418602 SPACE 74420702 LA WKRG9,0(WKRG9) CLEAR HIGH ORD BYTE (OP CODE) Y02081 74422802 L WKRG7,XSOMAD POINT TO START OF MODULE Y02081 74424902 CR WKRG9,WKRG7 IS DDR WITHIN MODULE? Y02081 74427002 BL VPCIIVAL IF NO, RETURN WITH AN Y02081 74429102 * INVALID ADDRESS INDICATOR Y02081 74431202 L WKRG7,XEOMAD POINT TO END OF MODULE Y02081 74433302 CR WKRG9,WKRG7 IS ADDR WITHIN MODULE Y02081 74435402 BNL VPCIIVAL IF NOT, RETURN WITH AN Y02081 74437502 * INVALID ADDRESS INDICATOR Y02081 74439602 LA WKRG7,FTCP1 GET ADDR OF RD TXT CCW Y02081 74441702 STCM WKRG7,ADDR,FTCP1+VAMNOPAD SET TIC TO RD NEXT TXT Y02081 74443802 SPACE 74445902 TM FTRBUF1,ENDFLG LAST RECORD? Y02081 74448002 BO VPCI04 YES,GO SET END SWITCH Y02081 74450102 B VPCIRET NO, RETURN TO IOS Y02081 74452202 VPCI04 NI FTCP1+VAMFLAGS,ALL-CMCH TURN OFF CMND CHAIN BIT Y02081 74454302 SPACE 2 74456402 VPCIRET LM WKRG0,WKRG15,0(WKRG13) RESTORE IOS REGISTERS Y02081 74458502 BR WKRG14 RETURN TO IOS Y02081 74460602 SPACE 2 74462702 VPCILOC DC A(DIERELOC) ADDR OF RELOCATE SUBRTN Y02081 74464802 SPACE 3 74466902 DC CL8'FETCHPA2' FETCH PATCH FOR APPG I.D. Y02081 74469002 APGPATCH DC 25F'0' APPG PATCH AREA Y02081 74471102 TITLE 'IEWFETCH...PROGRAM LOADING ROUTINE...DSECTS' 74473202 * 74475302 * DSECT FOR FETCH WORK CORE 74477402 * 74479502 * 74481602 * THE FOLLOWING DSECT DESCRIBES THE STRUCTURE OF THE 74483702 * WORK AREA USED BY FETCH. 74485802 * 74487902 IHAFETWK , FETCH WORKAREA MAPPING MACRO Y02081 74490002 XTNTSAVE EQU XHIFIX TEMPORARY SAVE FOR NO. OF @ZA10266 74520037 * STARTING DEB EXTENT Y02081 74550002 FMSKSAVE EQU FTCPSRCH+2 TEMPORARY SAVE FOR DEB FILE Y02081 74580002 * MASK TO GO IN IOSB Y02081 74610002 UCBSAVE EQU FTCPSRCH+3 TEMPORARY SAVE FOR UCB Y02081 74640002 * ADDRESS TO GO IN IOSB Y02081 74670002 NMEXTSV EQU FTCPSRCH+6 TEMPORARY SAVE FOR TOTAL Y02081 74700002 * NUMBER OF DEB EXTENTS Y02081 74730002 FTCPSCH2 EQU FTCPSRCH+8 START OF VAM CHANNEL PROGRAM Y02081 74740002 * (I.E. 31 CCW) Y02081 74750002 EJECT 74760002 ORG WKNAME 74790002 IHAPDS DSECT=NO 74820002 AGO .AROUND 74850002 FTWKCORE DS 0CL1150 A34466 74880002 FTIOB DS 8F IOB 74910002 FTIOBSK DS 2F IOB SEEK ADDRESS 74940002 ******************** M0155 74970002 XAREA DS 0F M0155 75000002 XKEY DC CL4'FTWA' FETCH IDENTIFICATION KEY M0155 75030002 XFLAGS DS X TRANSLATE / FIX CONTROL FLAGS M0155 75060002 * ---------- XFLAGS BIT DEFINITIONS M0155 75090002 NEWIOFLG EQU X'80' FRESH I/O REQUEST ISSUED M0155 75120002 ACTXTFLG EQU X'40' READ-TEXT CCW IS ACTIVE IN CURRENT CP M0155 75150002 SYNRDFLG EQU X'20' SYNC READ ISSUED (NO PCI) M0155 75180002 USDEBFLG EQU X'10' USERS DEB COPIED INTO GOTTON CORE M0155 75210002 TXTREAD EQU X'08' SIO APPENDAGE TXT READ INDICATOR YM2867 75240002 * ---------- M0155 75270002 DS 3X - RESERVED - M0155 75300002 ******************** M0155 75330002 FTSKBUF1 DS 3F 75360002 FTSKBUF2 DS 3F 75390002 FTSKBUF3 DS 3F 75420002 FTSKBUF4 DS 3F 75450002 FTCPSRCH DS 3D SEARCH AND TIC CCWS 75480002 FTRBUF1 DS 33D RLD BUFFER 1 75510002 FTCP1 DS 5D CHAN PROG 1 75540002 FTRBUF2 DS 33D RLD BUFFER 2 75570002 FTCP2 DS 5D CHAN PROG 2 75600002 FTRBUF3 DS 33D RLD BUFFER 3 75630002 FTCP3 DS 5D CHAN PROG 3 75660002 FTIOECB DS 1F 75690002 FTECB DS 1F 75720002 FTTBLPTR DS 2F 75750002 FTTBL DS 9F BUFFER TABLE 75780002 FTREGSV DS 16F REGISTER SAVE AREA 75810002 FTTRANS DS 1F ADDR OF TRANSLATION TABLE 75840002 FTSCAT DS 1F ADDR OF SCATTER LIST 75870002 FTRPTR DS 1F ADDR OF R POINTER 75900002 FTPPTR DS 1F ADDR OF P POINTER 75930002 FTRBDWRD DS 1F BOUNDARY WORD FOR RELOC 75960002 FTFLAGS DS 2F FETCH CONTROL FLAGS 75990002 FTECBLST DS 2F ECB LIST FOR MULTIPLE WAIT 76020002 FTLASTBF DS 1F PTR TO PRIOR BUFR TBL ENTRY 76050002 * 76080002 * EXTENSION TO FETCH WORK AREA 76110002 * 76140002 XSOMAD DS F LOWER CORE LIMIT FOR LOAD MODULE 76170002 XEOMAD DS F UPPER CORE LIMIT FOR LOAD MODULE 76200002 XLOFIX DS F LOWER BOUND FOR TEXT AREA FIX REQ 76230002 XHIFIX DS F UPPER BOUND FOR TEXT AREA FIX REQ 76260002 XNEXTLOC DS F LOCATION OF NEXT TEXT BYTE READ 76290002 XFIXLIST DS 5D FIX LIST AREA PASSED TO IOS 76320002 XWKCORPG DS F REAL ADDRESS OF WORK AREA PAGE 76350002 XTRANTAB DS 0XL8 CCW TRANSLATE DATA- 76380002 XCCWAD DS F POINTER TO CCW REQ TRANSLATION 76410002 XTXTAD DS F VIRTUAL ADDRESS IN THE CCW 76440002 XIDALP1 DS AL4(XALAREA1) POINTER TO IDAL BUILD AREA 76470002 XIDALP2 DS AL4(XALAREA2) POINTER TO ALTERNATE IDAL AREA 76500002 XALAREA1 DS 10F IDAL AREA 76530002 XALAREA2 DS 10F IDAL AREA 76560002 XGMLIST DS 4F GETMAIN LIST AREA 76590002 XORGDCB DS 1F ORIGINAL LOAD DCB ADDRESS 76620002 XDEBLEN DS 1F SIZE OF MS OBTAINED FOR DEB(INC SP) 76650002 *----PSEUDO DCB DEFINITION (USED WITH THE COPIED DEB). 76680002 ORG *-DCBDEBAD ORG BACK OVER UNUSED FIELDS 76710002 XDCBCOPY EQU * START OF DCB 76740002 ORG *+DCBDEBAD RESTORE LOC COUNTER 76770002 XDCBDEBA DS 1F PSEUDO 'DCBDEBAD' FIELD 76800002 *----END OF PSEUDO DCB DEFINITION. 76830002 SPACE 76860002 *----------- MISC. EQUATES 76890002 IDALNTRY EQU 4 SIZE OF EACH IDAL ENTRY 76920002 FTWORKSZ EQU *-FTWKCORE SIZE OF ENTIRE WORK AREA 76950002 FIXLOENT EQU 0 OFFSET TO LOW ENTRY PORTION 76980002 FIXHIENT EQU 4 OFFSET TO HIGH ENTRY PORTION 77010002 FIXENTSZ EQU 8 SIZE OF FIX-LIST ENTRY 77040002 ECBERRIN EQU FTFXECB+3 INDICATED PGFIX IN PROCESS @ZA07064 77050037 .AROUND ANOP 77070002 EJECT 77100002 * 77130002 * COMBINED EXTENT LIST / NOTE LIST CONSTRUCTED BY FETCH 77160002 * WHEN INVOKED BY CONTENTS SUPERVISOR. THE NOTE LIST 77190002 * PORTION EXISTS ONLY FOR MODULES IN OVERLAY STRUCTURE. 77220002 * 77250002 EXLNL DSECT 77280002 EXLIST DS 0F START OF EXTENT LIST 77310002 EXLLNTH DS F LENGTH OF EXTENT (PLUS NOTE) LIST 77340002 EXLRELFC DS F NUMBER OF CORE BLKS FOR MODULE 77370002 EXLCORSZ DS 0F SIZE OF CORE BLK ALLOC TO MODULE 77400002 EXLSZIND DS XL1 - FLAG TO IND A SIZE FIELD 77430002 EXLSZBLK DS FL3 - SIZE IN BYTES 77460002 EXLCORAD DS 0F ADDRESS OF CORE BLOCK ALLOCATED 77490002 EXLADIND DS XL1 - FLAG TO IND AN ADDRESS FIELD 77520002 EXLADBLK DS AL3 - ADDRESS OF FIRST BYTE 77550002 * 77580002 SZIND EQU X'80' SIZE INDICATOR 77610002 ADIND EQU X'00' ADDR INDICATOR 77640002 EXLSIZE EQU *-EXLIST LENGTH OF XTENT LIST PORTION 77670002 * 77700002 * NOTE LIST FOR OVERLAY MODULES. 77730002 * 77760002 NOTELIST DS 0F BEGINNING OF NOTELIST 77790002 NLRELFAC DS F RELOCATION FACTOR FOR THE MODULE 77820002 * (ALSO, THE ADDRESSS OF THE SEGTAB) 77850002 NLCORSIZ DS XL3 MS CORE REQUIREMENT OF THE MODULE 77880002 NLCONCAT DS XL1 CONCATENATION NUMBER OF MODULE DATA SET 77910002 NLENTRYS DS 0F NOTELIST ENTRIES(ONE/SEGMENT)... 77940002 NLSEGTTR DS XL3 TTR FOR READING THE SEGMENT 77970002 NLZERO DC X'00' ZERO 78000002 *-------- 78030002 NLENTSZ EQU 2 ENTRY SIZE (FOR SHIFT-MULTIPLY) 78060002 NLPFXSZ EQU 8 LENGTH OF NL PREFIX PORTION 78090002 PRINT NOGEN 78090402 EJECT 78092002 IECDERWA 78094002 EJECT 78120002 IEZDEB 78150002 DEBDASD DSECT YM1172 78160002 EXTVALUE EQU * SIZE OF A DASD EXTENT YM1172 78170002 EJECT 78180002 IHACDE 78210002 EJECT 78240002 UCBCB DSECT 78270002 IEFUCBOB PREFIX=YES LIST=YES 78300037 EJECT 78330002 IKJTCB 78360002 EJECT 78390002 IECDIOSB 78420002 SRBSTART EQU * START OF FETCH SRB Y02081 78450002 IOSBSIZE EQU IOSEND-IOSB SIZE OF IOSB Y02081 78480002 EJECT 78510002 IHASRB 78540002 SPACE 2 78570002 GLOBREQ EQU IOSBSIZE+SRBSIZE TOTAL FETCH REQUIREMENT Y02081 78600002 * FOR FIXED GLOBAL STORAGE Y02081 78630002 SQASP EQU 245 SUBPOOL USED FOR GLOBREQ Y02081 78660002 PCIFLG EQU X'80' FLAG IN IOSTSB SHOWING Y02081 78690002 * ENTRY TO DIE FOR A PCI Y02081 78720002 EJECT 78750002 IHAPSA 78780002 EJECT 78810002 IHAASCB 78840002 EJECT 78870002 IHAASXB 78900002 EJECT 78930002 CVT DSECT=YES 78960002 EJECT 78990002 IECDIOCM 79020002 EJECT 79050002 IECDIPIB 79080002 EJECT 79090002 IDDWICB 79092002 EJECT 79094002 IHASDWA 79100002 IOSBSDWA EQU IOSBSIZE+SDWALEN LENGTH OF IOSB + SDWA Y02081 79102002 END 79110002