ICFBIF00 TITLE 'POWER WARNING FEATURE INITIALIZATION MODULE'            00040002
*********************************************************************** 00080002
*                                                                     * 00120002
*   THIS MODULE IS PART OF THE POWER WARNING FEATURE SUPPORT            00160002
*                                                                     * 00200002
*                                                                     * 00240002
*                                                                     * 00280002
* FUNCTION - A. CHECK THE PWF TIME PARAMETER IN THE CVT TO SEE IF THE * 00320002
*               FUNCTION IS SUPPORTED.                                * 00360002
*                                                                     * 00400002
*            B. GETMAIN A 2K COMMUNICATION AREA FROM SUBPOOL 245 AND  * 00440002
*               STORE ITS ADDRESS IN THE CVT.                         * 00480002
*                                                                     * 00520002
*            C. ADJUST TIME PARAMETER ACCORDING TO ENGINEERING SPECS  * 00560002
*               AND SAVE IT IN THE COMMUNICATION AREA.                * 00600002
*                                                                     * 00640002
*            D. IF T=1 SPECIFIED SET 'COMMIT TO DUMP' FLG IN COMM.AREA* 00680002
*               AND NOTIFY THE OPERATOR THAT DUMP WILL OCCUR ON FIRST * 00720002
*               WARNING.                                              * 00760002
*                                                                     * 00800002
*            E. LOCATE THE WARN DATASETS. MAKE SURE THAT EACH WARN    * 00840002
*               DATASET RESIDES ON A SINGLE VOLUME AND THAT BOTH OF   * 00880002
*               THEM DON'T RESIDE ON THE SAME VOLUME.                 * 00920002
*                                                                     * 00960002
*            F. DYNAMICALLY ALLOCATE THE WARN DATASETS, THEN          * 01000002
*               FIND THE UCB'S FOR THE WARN DATASETS. MAKE SURE THEY  * 01040002
*               ARE D.A.DEVICES, UPS SUPPORTED AND OF THE SAME TYPE.  * 01080002
*                                                                     * 01120002
*            G. USING THE DEVTYPE MACRO                               * 01160002
*                     GET THE PHYSICAL CHARACTERISTICS OF THE DEVICE  * 01200002
*               ON WHICH THE WARN DATASETS RESIDE. SAVE THESE DATA IN * 01240002
*               THE COMM.AREA.                                        * 01280002
*                                                                     * 01320002
*            H. OPEN THE WARN DATASETS AND GET THE START AND SIZE OF  * 01360002
*               THE EXTENT FROM THE DEB. SAVE THE START OF EXTENT IN  * 01400002
*               THE COMM.AREA.                                        * 01440002
*                                                                     * 01480002
*            I. FROM THE CVT GET THE STORAGE SIZE AND MAKE SURE THAT  * 01520002
*               BOTH DATASETS ARE LARGE ENOUGH TO CONTAIN ALL STORAGE.* 01560002
*                                                                     * 01600002
*            J. READ THE CONTROL TRACK. MAKE SURE THE DATASET IS EMPTY* 01640002
*               BY CHECKING THE APPROPRIATE FLAG IN THE CNTL TRK.     * 01680002
*                                                                     * 01720002
*            K. IF MORE THAN 24 HOURS HAVE ELAPSED SINCE THE LAST     * 01760002
*               FORMATTING OF THE DATASETS, REFORMAT THEM.            * 01800002
*                                                                     * 01840002
*            L. INITIALIZE AND WRITE THE CONTROL TRACK TO REFLECT THE * 01880002
*               ENVIRONMENT AT THIS IPL.                              * 01920002
*            M. FIND AN AVAILABLE PATH TO THE WARN DEVICE (VIA IOSGEN * 01960002
*               MACRO) AND SAVE DEVICE ADDRESS AND UCB ADDRESS IN THE * 02000002
*               COMM.AREA.                                            * 02040002
*                                                                     * 02080002
*            N. COMPLETE INITIALIZATION OF THE COMM.AREA BY SETTING   * 02120002
*               UP THE CCW CHAIN (FOR FULL CYLINDER WRITE) AND THE    * 02160002
*               SEEK/SEARCH ADDRESSES FOR THE DUMP ROUTINE.           * 02200002
*                                                                     * 02240002
*            O. SET 'VOLUME BIT' IN THE WARN UCB'S. FLAG THE WARN UCBS* 02280002
*               'PERMANENTLY RESIDENT'.                               * 02320002
*                                                                     * 02360002
*            P. RESET THE 'WARN NOT INITIALIZED' FLAG IN THE CVT AND  * 02400002
*               TURN ON THE WARNING MASK IN CONTROL REGISTER 14.      * 02440002
*                                                                     * 02480002
*            Q. WRITE THE 'PWF INITIALIZATION COMPLETE' MESSAGE AND   * 02520002
*               RETURN TO THE CALLING MODULE.                         * 02560002
*                                                                     * 02600002
*            R. IF A WARN DATASET CONTAINS A VALID DUMP, ASK THE      * 02640002
*               OPERATOR IF HE WANTS TO RESTORE STORAGE OR ERASE THE  * 02680002
*               DUMP FROM THE DATASET.                                * 02720002
*                                                                     * 02760002
*            S. IF THE OPERATOR REQUESTS A RESTORE MAKE SURE THAT     * 02800002
*               THE STORAGE CONFIGURATION PRESENTLY ONLINE IS NOT     * 02840002
*               SMALLER THAN THE ONE ONLINE AT DUMP TIME, SET UP THE  * 02880002
*               INTERFACE TO THE RESTORE ROUTINE AND GIVE IT CONTROL  * 02920002
*               IN B.C.MODE, FULLY DISABLED AND WITH S.P.K.=0.        * 02960002
*                                                                     * 03000002
*            T. IF ANY UNUSUAL CONDITION IS ENCOUNTERED, NOTIFY THE   * 03040002
*               OPERATOR GIVING HIM THE CHOICE OF CONTINUING SYSTEM   * 03080002
*               OPERATION WITHOUT PWF SUPPORT OR TO STOP THE SYSTEM,  * 03120002
*               CORRECT THE PROBLEM AND RE-IPL.                       * 03160002
*                                                                     * 03200002
*            U. MAINTAIN AN INTERNAL 'FOOTPRINT TABLE'.               * 03240002
*                                                                     * 03280002
*                                                                     * 03320002
*                                                                     * 03360002
* ENTRY -    THE ONLY ENTRY TO THIS MODULE IS ICFBIE00.               * 03400002
*                                                                     * 03440002
*                                                                     * 03480002
*                                                                     * 03520002
* INPUT -    REGISTER 14 CONTAINS RETURN ADDRESS.                     * 03560002
*            CVTVOLF2 = 'WARN NOT INITIALIZED' FLAG.                  * 03600002
*            CVTVOLT2 = USER SUPPLIED TIME PARAMETER.                 * 03640002
*                                                                     * 03680002
*                                                                     * 03720002
*                                                                     * 03760002
* OUTPUT -   CVTVOLF2 RESET TO ZERO.                                  * 03800002
*            CVTVOLT2 CONTAINING ADDRESS OF PWF COMMUNICATION AREA.   * 03840002
*            WARN UCB'S MARKED AS 'PERMANENTLY RESIDENT' AND WITH     * 03880002
*               THE VOLUME BIT SET.                                   * 03920002
*            PWF COMMUNICATION AREA FULLY INITIALIZED.                * 03960002
*            WARN DATASETS FORMATTED AND WITH INITIALIZED CONTROL TRK.* 04000002
*                                                                     * 04040002
*                                                                     * 04080002
*                                                                     * 04120002
* EXTERNAL                                                            * 04160002
*  ROUTINES- GETMAIN.                                                 * 04200002
*            WTO.                                                     * 04240002
*            FREEMAIN.                                                * 04280002
*            WTOR.                                                    * 04320002
*            WAIT.                                                    * 04360002
*            STIMER.                                                  * 04400002
*            LOCATE.                                                  * 04440002
*            OBTAIN.                                                  * 04480002
*            DEVTYPE.                                                 * 04520002
*            OPEN.                                                    * 04560002
*            EXCP.                                                    * 04600002
*            CLOSE.                                                   * 04640002
*            IGF01MMM.                                                * 04680002
*            ESTAE.                                                   * 04720002
*                                                                     * 04760002
*                                                                     * 04800002
*                                                                     * 04840002
* REGISTER                                                            * 04880002
*  USAGE -   REGISTER 10 - BASE FOR COMMUNICATION AREA.               * 04920002
*                     11 - FIRST BASE FOR MODULE.                     * 04960002
*                     12 - SECOND BASE FOR MODULE.                    * 05000002
*                     13 - BASE FOR REGISTER SAVE AREA AND WORK AREA. * 05040002
*                     14 - RETURN REGISTER AND WORK REGISTER.         * 05080002
*                     15 - BASE FOR RESTORE ROUTINE AND WORK.         * 05120002
*                                                                     * 05160002
*                                                                     * 05200002
*                                                                     * 05240002
* MACROS -   GETMAIN.                                                 * 05280002
*            WTO.                                                     * 05320002
*            FREEMAIN.                                                * 05360002
*            IOSGEN.                                                  * 05400002
*            WTOR.                                                    * 05440002
*            WAIT.                                                    * 05480002
*            STIMER.                                                  * 05520002
*            LOCATE.                                                  * 05560002
*            OBTAIN.                                                  * 05600002
*            DEVTYPE.                                                 * 05640002
*            OPEN.                                                    * 05680002
*            EXCP.                                                    * 05720002
*            CLOSE.                                                   * 05760002
*            DCB.                                                     * 05800002
*            CAMLST.                                                  * 05840002
*            CVT.                                                     * 05880002
*            ICFWORK.                                                 * 05920002
*            IEFUCBOB.                                                * 05960002
*            IKJTCB.                                                  * 06000002
*            DCBD.                                                    * 06040002
*            IEZDEB.                                                  * 06080002
*            IEZJSCB.                                                 * 06120002
*            IEFTIOT1.                                                * 06160002
*            IECDLCH.                                                 * 06200002
*            IHAPSA.                                                  * 06240002
*            IECDCAT.                                                 * 06280002
*            IHAPCCA.                                                 * 06320002
*            IHACSD.                                                  * 06360002
*            IHASDWA.                                                 * 06400002
*            ESTAE.                                                   * 06440002
*            SETRP.                                                   * 06480002
*                                                                     * 06520002
*                                                                     * 06560002
* STATUS -                                                              06600000
*          APARS FIXED @ZA00760,@ZA00521,@ZA30392                       06610003
*                                                                       06612003
*       R 256800-257200                                        @ZA30392 06614003
*                                                                       06620000
*********************************************************************** 06640002
         SPACE 5                                                        06680002
ICFBIE00 CSECT                                                          06720002
         SPACE 5                                                        06760002
*              REGISTER EQUATES                                         06800002
         SPACE                                                          06840002
R0       EQU   0                                                        06880002
R1       EQU   1                                                        06920002
R2       EQU   2                                                        06960002
R3       EQU   3                                                        07000002
R4       EQU   4                                                        07040002
R5       EQU   5                                                        07080002
R6       EQU   6                                                        07120002
R7       EQU   7                                                        07160002
R8       EQU   8                                                        07200002
R9       EQU   9                                                        07240002
R10      EQU   10            *BASE FOR ICFWORKA                         07280002
R11      EQU   11            *BASE FOR MODULE                           07320002
R12      EQU   12            *SECOND BASE FOR MODULE                    07360002
R13      EQU   13            *BASE FOR REGISTER SAVE AREA & WORK AREA   07400002
R14      EQU   14            *RETURN REGISTER                           07440002
R15      EQU   15                                                       07480002
         SPACE 3                                                        07520002
*              DECIMAL EQUATES                                          07560002
         SPACE                                                          07600002
D0       EQU   0                                                        07640002
D1       EQU   1                                                        07680002
D2       EQU   2                                                        07720002
D3       EQU   3                                                        07760002
D4       EQU   4                                                        07800002
D5       EQU   5                                                        07840002
D6       EQU   6                                                        07880002
D7       EQU   7                                                        07920002
D8       EQU   8                                                        07960002
D9       EQU   9                                                        08000002
D10      EQU   10                                                       08040002
D11      EQU   11                                                       08080002
D12      EQU   12                                                       08120002
D13      EQU   13                                                       08160002
D15      EQU   15                                                       08200002
D16      EQU   16                                                       08240002
D18      EQU   18                                                       08280002
D20      EQU   20                                                       08320002
D23      EQU   23                                                       08360002
D24      EQU   24                                                       08400002
D25      EQU   25                                                       08440002
D26      EQU   26                                                       08480002
D27      EQU   27                                                       08520002
D28      EQU   28                                                       08560002
D30      EQU   30                                                       08600002
D32      EQU   32                                                       08640002
D33      EQU   33                                                       08680002
D34      EQU   34                                                       08720002
D35      EQU   35                                                       08760002
D36      EQU   36                                                       08800002
D37      EQU   37                                                       08840002
D39      EQU   39                                                       08880002
D40      EQU   40                                                       08920002
D43      EQU   43                                                       08960002
D44      EQU   44                                                       09000002
D46      EQU   46                                                       09040002
D48      EQU   48                                                       09080002
D56      EQU   56                                                       09120002
D76      EQU   76                                                       09160002
D119     EQU   119                                                      09200002
D127     EQU   127                                                      09240002
D128     EQU   128                                                      09280002
D223     EQU   223                                                      09320002
D244     EQU   244                                                      09360002
D380     EQU   380                                                      09400002
D2047    EQU   2047                                                     09440002
D4095    EQU   4095                                                     09480002
D12288   EQU   12288                                                    09520002
         SPACE 3                                                        09560002
*              CHARACTER EQUATES                                        09600002
         SPACE                                                          09640002
CA       EQU   C'A'                                                     09680002
CB       EQU   C'B'                                                     09720002
CBLK     EQU   C' '                                                     09760002
         SPACE 3                                                        09800002
*              HEXADECIMAL EQUATES                                      09840002
         SPACE                                                          09880002
X00      EQU   X'00'                                                    09920002
X01      EQU   X'01'                                                    09960002
X02      EQU   X'02'                                                    10000002
X04      EQU   X'04'                                                    10040002
X05      EQU   X'05'                                                    10080002
X06      EQU   X'06'                                                    10120002
X07      EQU   X'07'                                                    10160002
X08      EQU   X'08'                                                    10200002
X0C      EQU   X'0C'                                                    10240002
X0F      EQU   X'0F'                                                    10280002
X10      EQU   X'10'                                                    10320002
X20      EQU   X'20'                                                    10360002
X31      EQU   X'31'                                                    10400002
X40      EQU   X'40'                                                    10440002
X50      EQU   X'50'                                                    10480002
X60      EQU   X'60'                                                    10520002
X7F      EQU   X'7F'                                                    10560002
X80      EQU   X'80'                                                    10600002
X87      EQU   X'87'                                                    10640002
X8C      EQU   X'8C'                                                    10680002
XDF      EQU   X'DF'                                                    10720002
XEE      EQU   X'EE'                                                    10760002
XF0      EQU   X'F0'                                                    10800002
XF9      EQU   X'F9'                                                    10840002
XFC      EQU   X'FC'                                                    10880002
XFE      EQU   X'FE'                                                    10920002
XFF      EQU   X'FF'                                                    10960002
         EJECT                                                          11000002
         STM   R14,R12,D12(R13)   *SAVE REGS IN ATTACHOR'S SAVE AREA    11040002
         LR    R11,R15       *LOAD BASE REGISTER FOR MODULE             11080002
         USING ICFBIE00,R11,R12     *ESTABLISH MODULE ADDRESSABILITY    11120002
         LA    R12,D4095(R11)     *LOAD SECOND BASE                     11160002
         LA    R12,D1(R12)   *REGISTER FOR MODULE                       11200002
         GETMAIN R,LV=ICFDSSIZ    *GETMAIN SAVE & WORK AREA             11240002
         ST    R1,D8(R13)    *FORWARD CHAINING OF SAVE AREAS            11280002
         ST    R13,D4(R1)    *BACKWARD CHAINING OF SAVE AREAS           11320002
         LR    R13,R1        *INITIALIZE POINTER TO OUR SAVE AREA       11360002
         USING ICFTIFDS,R13  *ESTABLISH ADDRESSABILITY TO WORK AREA     11400002
*****************************************************************       11440002
         XC    ICFESTPR(ICFPRMLS-ICFESTPR),ICFESTPR  *CLEAN ESTAE PARM  11480002
         LA    R10,ICFINRTR  *GET ADDRESS OF ERROR RETURN 1             11520002
         ST    R10,ICFESTPR  *SAVE IT IN ESTAE PARM AREA                11560002
         LA    R10,ICFEREX   *GET ADDRESS OF ERROR RETURN 2             11600002
         ST    R10,ICFESTPR+D4    *SAVE IT IN ESTAE PARM AREA           11640002
         LA    R10,ICFFREMB  *GET ADDRESS OF ERROR RETURN 3             11680002
         ST    R10,ICFESTPR+D8    *SAVE IT IN ESTAE PARM AREA           11720002
         LA    R10,ICFESTPR  *GET POINTER TO ESTAE PARAM AREA           11760002
         ESTAE ICFESTAE,CT,PARAM=(R10),RECORD=YES  *SETUP ESTAE ENV.    11800002
*****************************************************************       11840002
         GETMAIN R,LV=2048,SP=245      *GETMAIN COMMUNICATION AREA      11880002
         LR    R10,R1        *SAVE POINTER TO COMMUNICATION AREA        11920002
         USING ICFWORKA,R10  *ESTABLISH COMM.AREA ADDRESSABILITY        11960002
         MVI   ICFFLAGA,X80  *SET 'FUNCTION INOPER.' FLAG IN COMM.AREA  12000002
         L     R14,CVTPTR    *GET CVT POINTER                           12040002
         USING CVT,R14       *ESTABLISH CVT ADDRESSABILITY              12080002
         L     R8,CVTCSD     *GET REAL ADDRESS OF CSD                   12120002
         LRA   R8,D0(R8)     *DITTO                                     12160002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  12200002
         ST    R8,ICFADR3    *SAVE IT IN COMM. AREA                     12240002
         L     R8,CVTPCCAT   *GET REAL ADDRESS OF PCCA VECTOR TABLE     12280002
         LRA   R8,D0(R8)     *DITTO                                     12320002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  12360002
         ST    R8,ICFADR2    *SAVE IT IN COMM. AREA                     12400002
         L     R8,CVTTCBP    *GET POINTER TO NEW/OLD TCB                12440002
         MVC   ICFTCBSV,D4(R8)    SAVE OUR TCB ADDRESS                  12480002
         MVC   ICFLRDAT,CVTDATE   *COPY DATE TO COMM. AREA              12520002
         XC    ICFLRTIM,ICFLRTIM  *SET TIME TO ZERO IN COMM. AREA       12560002
         STIDP ICFLRCPU      *STORE CPU ID IN COMM. AREA                12600002
         L     R8,CVTDCB     *GET POINTER TO LOGREC DCB                 12640002
         S     R8,CF8        *LOGREC DCB - 8 CONTAINS POINTER           12680002
         L     R8,D0(R8)     *TO CHANNEL ASSIGNMENT TABLE               12720002
         MVC   ICFLRCHA,D0(R8)    *SAVE CHAN ASSGNMNT TBL IN COMM.AREA  12760002
         MVC   ICFFLAGB,CVTDCB    *COPY SYSTEM TYPE TO COMM.AREA        12800002
         LA    R8,CVTVOLF2-CVTTCBP  *GET DISPLACEMENT FOR MVT,SVM,MVM   12840002
         L     R9,D0(R8,R14) *GET CONTENTS OF OUR CVT SLOT              12880002
         ST    R10,D0(R8,R14) *SET PNTR TO COMM.AREA IN OUR CVT SLOT    12920002
         AR    R8,R14        *GET ADDR. OF OUR CVT SLOT                 12960002
         NI    D0(R8),X7F         *RESET 'WARN NOT INIT.' FLAG IN CVT   13000002
         XC    ICFTRMSA(D12),ICFTRMSA  *CLEAR FOOTPRINT TABLE           13040002
         LA    R8,ICFTRMSA   *GET ADDRESS OF FOOTPRINT TABLE            13080002
         ST    R8,ICFADR1    *SAVE IT IN FIRST SLOT OF COMM.AREA        13120002
         ST    R13,ICFTRDMP  ***SAVE PTR TO WORKAREA FOR DEBUG*******   13160002
******************************************************************      13200002
         OI    ICFTRMSA+D0,X80    *UPDATE FOOTPRINT TABLE***********    13240002
******************************************************************      13280002
         ST    R11,ICFADR4   *SAVE MODULE E.P.A. IN COMM.AREA           13320002
         DROP  R14                                                      13360002
         SPACE 3                                                        13400002
*        THIS COMPLETES THE INITIAL HOUSEKEEPING                        13440002
         SPACE 3                                                        13480002
         LA    R9,D0(R9)     *GET RID OF FLAG                           13520002
         LTR   R9,R9         *IS WARN FUNCTION INOPERATIVE?             13560002
         BZ    ICFSFI        *YES, GO SET FLAG FOR OTHER MODULES        13600002
         BCTR  R9,R0         *GET CORRECT TIME IN MSEC                  13640002
         ST    R9,ICFTME00   *SAVE IT IN COMM AREA                      13680002
         LTR   R9,R9         *WAS ORIGINAL TIME 1?                      13720002
         BZ    ICFCMTDP      *YES, GO SEND MESSAGE                      13760002
ICFSEMTD EQU   *                                                        13800002
         C     R9,ICFEMTD    *IS SPECIFIED T N.L.THAN ENG.MINIMUM?      13840002
         BNL   ICFSKCCW      YES, SPECIFIED T IS OK                     13880002
         MVC   ICFTME00,ICFEMTD   *NO, SET T TO ENGINEERING MINIMUM     13920002
******************************************************************      13960002
         OI    ICFTRMSA+D0,X40    *UPDATE FOOTPRINT TABLE***********    14000002
******************************************************************      14040002
         SPACE 5                                                        14080002
ICFSKCCW EQU   *             *BUILD SKELETON OF CCW CHAIN IN WORK AREA  14120002
         LRA   R9,ICFCHR00   *GET SK/SRCH REAL ADDRESS                  14160002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  14200002
         ST    R9,ICFCCW1    *STORE IN SEEK CCW                         14240002
         LA    R9,D2(R9)     *GET SEARCH REAL ADDRESS                   14280002
         ST    R9,ICFCCW2    *STORE IN SEARCH CCW                       14320002
         LRA   R9,ICFSRC00   *GET TIC REAL ADDRESS                      14360002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  14400002
         ST    R9,ICFCCW3    *STORE IN TIC CCW                          14440002
         SR    R9,R9         *ZERO FOR DATA ADDRESS                     14480002
         ST    R9,ICFCCW4    *STORE IN WRITE CCW                        14520002
         LA    R9,D6         *COUNT FOR SEEK                            14560002
         ST    R9,ICFCCW1+D4 *STORE IN SEEK CCW                         14600002
         LA    R9,D5         *COUNT FOR SEARCH                          14640002
         ST    R9,ICFCCW2+D4 *STORE IN SEARCH CCW                       14680002
         LA    R9,D1         *COUNT FOR TIC                             14720002
         ST    R9,ICFCCW3+D4 *STORE IN TIC CCW                          14760002
         MVI   ICFCCW1,X07   *SEEK COMMAND IN PLACE                     14800002
         MVI   ICFCCW1+D4,X60     *CC & SLI FLAGS IN PLACE              14840002
         MVI   ICFCCW2,X31   *SEARCH COMMAND IN PLACE                   14880002
         MVI   ICFCCW2+D4,X60     *FLAGS IN PLACE                       14920002
         MVI   ICFCCW3,X08   *TIC COMMAND IN PLACE                      14960002
         MVI   ICFCCW3+D4,X60     *FLAGS IN PLACE                       15000002
         MVI   ICFCCW4,X05   *WRITE COMMAND IN PLACE                    15040002
         MVI   ICFCCW4+D4,X40     *CC FLAG IN PLACE                     15080002
         EJECT                                                          15120002
*        LOCATE SYS1.WARN DATASETS AND DYNAMICALLY ALLOCATE THEM,    *  15160002
*                                      OPEN THEM, CHCK THE           *  15200002
*        CONTROL TRACKS, WRITE FORMAT AND CLOSE THEM.                *  15240002
*        ALSO FIND PATH STATUS AND UPDATE COMMUNICATION AREA.        *  15280002
         SPACE                                                          15320002
         MVI   ICFDSN,CBLK   *CLEAN DSN AREA FOR LOCATE                 15360002
         MVC   ICFDSN+D1(D43),ICFDSN   *DITTO                           15400002
         MVC   ICFDSN(D9),CCWARN  *BUILD DSN FOR LOCATE                 15440002
         MVI   ICFDSN+D9,CA  *SET DSN FOR LOCATE TO WARNA               15480002
******************************************************************      15520002
         OI    ICFTRMSA+D0,X02    *UPDATE FOOTPRINT TABLE*************  15560002
****************************************************************        15600002
         BAL   R8,ICFWRNCH   *GO TO CHECKOUT SUBROUTINE                 15640002
         SPACE 3                                                        15680002
         ST    R7,ICFWAUCB   *SAVE WARNA UCB ADDR IN COMM AREA          15720002
         LA    R5,ICFIOMAP   *PREPARE TO FIND AVAILABLE PATH            15760002
         LR    R8,R13        *SAVE POINTER TO OUR SAVE & WORK AREA      15800002
         LA    R13,D12(R13)  *ADJUST POINTER TO SAVE AREA FOR IOSGEN    15840002
         BAL   R14,ICFNDPTH  *GO FIND AVAILABLE PATH                    15880002
         LR    R13,R8        *RESET POINTER TO OUR SAVE & WORK AREA     15920002
******************************************************************      15960002
         OI    ICFTRMSA+D2,X08    *UPDATE FOOTPRINT TABLE*************  16000002
******************************************************************      16040002
         XC    ICFWADEV,ICFWADEV  *CLEAN ICFWADEV FIELD                 16080002
         LA    R7,ICFWADEV   *PREPARE TO CHECK WARNA PATHS              16120002
         BAL   R8,ICFSDADD   *GO CHECK WARNA PATHS                      16160002
         MVC   ICFWACHR(D6),ICFDEBCH   *SAVE INITIAL CCHH IN COMM AREA  16200002
         MVI   ICFWACHR+D6,X01    *SET INITIAL R = 1 IN COMM AREA       16240002
******************************************************************      16280002
         OI    ICFTRMSA+D2,X04    *UPDATE FOOTPRINT TABLE*************  16320002
******************************************************************      16360002
         EJECT                                                          16400002
*        REPEAT SAME PROCEDURE FOR SYS1.WARNB.                       *  16440002
         SPACE                                                          16480002
         MVI   ICFDSN+D9,CB  *SET DSN FOR LOCATE TO WARNB               16520002
******************************************************************      16560002
         OI    ICFTRMSA+D0,X01    *UPDATE FOOTPRINT TABLE*************  16600002
******************************************************************      16640002
         BAL   R8,ICFWRNCH   *GO TO CHECKOUT SUBROUTINE                 16680002
         SPACE 3                                                        16720002
         ST    R7,ICFWBUCB   *SAVE UCB ADDRESS IN COMM AREA             16760002
         LA    R5,ICFIOMAP   *PREPARE TO FIND AVAILABLE PATH            16800002
         LR    R8,R13        *SAVE POINTER TO OUR SAVE & WORK AREA      16840002
         LA    R13,D12(R13)  *ADJUST POINTER TO SAVE AREA FOR IOSGEN    16880002
         BAL   R14,ICFNDPTH  *GO FIND AVAILABLE PATH                    16920002
         LR    R13,R8        *RESET POINTER TO OUR SAVE & WORK AREA     16960002
******************************************************************      17000002
         OI    ICFTRMSA+D2,X08    *UPDATE FOOTPRINT TABLE*************  17040002
******************************************************************      17080002
         XC    ICFWBDEV,ICFWBDEV  *CLEAN ICFWBDEV FIELD                 17120002
         LA    R7,ICFWBDEV   *PREPARE TO CHECK WARNB PATHS              17160002
         BAL   R8,ICFSDADD   *GO CHECK WARNB PATHS                      17200002
         MVC   ICFWBCHR(D6),ICFDEBCH   *SAVE INITIAL CCHH IN COMM AREA  17240002
         MVI   ICFWBCHR+D6,X01    *SET INITIAL R = 1 IN COMM. AREA      17280002
******************************************************************      17320002
         OI    ICFTRMSA+D2,X08    *UPDATE FOOTPRINT TABLE*************  17360002
******************************************************************      17400002
         EJECT                                                          17440002
*        THIS SECTION COMPLETES THE INITIALIZATION OF THE            *  17480002
*         COMMUNICATION AREA.                                        *  17520002
         SPACE 3                                                        17560002
         L     R9,ICFTRSIZ   *GET TRACK SIZE                            17600002
         ST    R9,ICFCCW4+D4 *COMPLETE SKELETON CCWS. COUNT IN WRT CCW  17640002
         MVI   ICFCCW4+D4,X40     *CC FLAG IN PLACE                     17680002
         L     R9,ICFTPC     *GET TRACKS PER CYLINDER                   17720002
         BCTR  R9,R0         *LESS 1                                    17760002
         LA    R8,ICFSEK00   *POINT TO CCW CHAIN IN COMM AREA           17800002
ICFCCWLP EQU   *             *SET CCW CHAIN IN COMMUNICATION AREA       17840002
         MVC   D0(D32,R8),ICFCCW1 *COPY ONE SET OF CCWS                 17880002
         L     R7,ICFCCW1    *GET SEEK ADRESS FROM SEEK CCW             17920002
         A     R7,CF8        *UPDATE IT                                 17960002
         ST    R7,ICFCCW1    *SET IT BACK                               18000002
         A     R7,CF2        *UPDATE SRC ADDRESS                        18040002
         ST    R7,ICFCCW2    *STORE IT IN SRCH CCW                      18080002
         MVI   ICFCCW2,X31   *DON'T FORGET COMMAND                      18120002
         L     R7,ICFCCW3    *GET TIC ADDRESS                           18160002
         A     R7,CF32       *UPDATE IT                                 18200002
         ST    R7,ICFCCW3    *SET IT BACK                               18240002
         LA    R8,D32(R8)    *POINT TO NEXT SET OF CCWS                 18280002
         BCT   R9,ICFCCWLP   *REPEAT IF NOT FINISHED                    18320002
         S     R8,CF32       *GO BACK TO LAST CCW SET                   18360002
         MVI   D28(R8),X00   *BREAK CCW CHAIN - CC FLAG OFF             18400002
******************************************************************      18440002
         OI    ICFTRMSA+D0,X20    *UPDATE FOOTPRINT TABLE***********    18480002
******************************************************************      18520002
         MVC   ICFCHR,ICFWACHR    *INITIALIZE SET OF SK/SRC ADDRESSES   18560002
         MVI   ICFCHR+D7,X00 *CLEAN LOW ORDER BYTE                      18600002
         L     R9,ICFTPC     *GET TRACKS PER CYLINDER                   18640002
         BCTR  R9,R0         *LESS 1                                    18680002
         LA    R8,ICFCHR00   *POINT TO FIRST SK/SRC ADDR FIELD          18720002
ICFCHRLP EQU   *                                                        18760002
         MVC   D0(D8,R8),ICFCHR   *FILL IN SK/SRC ADDRESS               18800002
         L     R7,ICFCHR+D4  *GET HHHHRR00                              18840002
         A     R7,CF65536    *UPDATE HHHH BY 1                          18880002
         ST    R7,ICFCHR+D4  *STORE IT BACK                             18920002
         LA    R8,D8(R8)     *UPDATE POINTER TO NEXT SK/SRC ADDR FLD    18960002
         BCT   R9,ICFCHRLP   *REPEAT IF NOT FINISHED                    19000002
******************************************************************      19040002
         OI    ICFTRMSA+D0,X10    *UPDATE FOOTPRINT TABLE***********    19080002
******************************************************************      19120002
         SR    R8,R8         *CONVERT                                   19160002
         L     R9,ICFTME00   *ORIGINAL                                  19200002
         M     R8,CF1000     *TIME IN                                   19240002
         SLDL  R8,D12        *TOD CLOCK                                 19280002
         STM   R8,R9,ICFTME01     *UNITS AND SAVE                       19320002
ICFRTRN  EQU   *             *WRITE INITIALIZATION COMPLETE MESSAGES    19360002
         B     ICFNXMSG      *PETE DOESN'T WANT THIS MESSAGE            19400002
         LA    R1,ICFEXTMS   *VOLUME+START-OF-EXTENT MESSAGE            19440002
         WTO   MF=(E,(1))                                               19480002
ICFNXMSG EQU   *                                                        19520002
         USING UCBD,R7       *ESTABLISH UCB ADDRESSABILITY              19560002
         L     R7,ICFWAUCB   *GET WARNA UCB                             19600002
         OI    UCBTYP+D1,X02 *SET VOLUME BIT FOR DDR                    19640002
         NI    SRTESTAT,XDF  *RESET RESERVED BIT IN UCB                 19680002
         OI    SRTESTAT,X04  *SET PERM.RES. BIT IN UCB                  19720002
         L     R7,ICFWBUCB   *GET WARNB UCB                             19760002
         OI    UCBTYP+D1,X02 *SET VOLUME BIT FOR DDR                    19800002
         NI    SRTESTAT,XDF  *RESET RESERVED BIT IN UCB                 19840002
         OI    SRTESTAT,X04  *SET PERM.RES. BIT IN UCB                  19880002
         DROP  R7                                                       19920002
******************************************************************      19960002
         OI    ICFTRMSA+D0,X08    *UPDATE FOOTPRINT TABLE***********    20000002
******************************************************************      20040002
         LA    R1,ICFICMSG   *INITIALIZATION COMPLETE MESSAGE           20080002
         WTO   MF=(E,(R1))                                              20120002
         NI    ICFFLAGA,X7F  *RESET 'FUNCTION INOP.' FLAG IN COMM.AREA  20160002
         STCTL R14,R14,ICFSV8     *GET CONTENTS OF OUR CONTROL REG. 14  20200002
         TM    ICFSV8,X01    *IS WARNING BIT ON?                        20240002
         BZ    ICFWRHIT      *NO, GO SEND 'WARNING BEFORE INIT' MSG     20280002
         EJECT                                                          20320002
ICFRTRN2 EQU  *              *RETURN SEQUENCE                           20360002
******************************************************************      20400002
         OI    ICFTRMSA+D0,X04    *UPDATE FOOTPRINT TABLE***********    20440002
******************************************************************      20480002
         LR    R1,R13        *GET POINTER TO SAVE & WORK AREA           20520002
         L     R13,D4(R13)   *GET BACWARD POINTER                       20560002
         FREEMAIN R,LV=ICFDSSIZ,A=(1)                                   20600002
*****************************************************************       20640002
         ESTAE 0             *CANCEL ESTAE ENVIRONMENT                  20680002
*****************************************************************       20720002
         L     R15,ICFTIFRC  *SET RETURN CODE                           20760002
         L     R14,D12(R13)  *RESTORE RETURN REG                        20800002
         LM    R0,R12,D20(R13)    *RESTORE OTHER REGISTERS              20840002
         BR    R14           *RETURN                                    20880002
         EJECT                                                          20920002
ICFNDPTH EQU   *             *FIND AVAILABLE PATH                       20960002
         IOSGEN MAP,TABLE=(R5),UCB=(R7),VAR=1                           21000002
         SPACE 5                                                        21040002
ICFSDADD EQU   *         *SET DEVICE ADDR.AND PATH FLAGS IN ICFWXDEV    21080002
         CLC   D2(D2,R5),CF1 *PRIMARY PATH ONLINE ON EITHER CPU?        21120002
         BNE   ICFPAXX       *YES, GO SEE ON WHICH CPU                  21160002
         LA    R5,D4(R5)     *NO, TRY SECONDARY PATHS                   21200002
         CLC   D2(D2,R5),CF1 *SECONDARY PATH ONLINE ON EITHER CPU?      21240002
         BE    ICFPNA        *NO, GO SEND MESSAGE                       21280002
ICFPAXX  EQU   *                                                        21320002
         TM    D2(R5),X01    *PATH ONLINE ON CPU 0?                     21360002
         BNO   ICFSOPC1      *NO, GO SET 'PATH ON CPU 1' FLAG           21400002
         OI    D1(R7),X01    *SET 'PATH ON CPU 0' FLAG                  21440002
         TM    D3(R5),X01     *PATH ONLINE ON CPU 1?                    21480002
         BNO   ICFSDEVA      *NO, GO SAVE DEVICE ADDRESS                21520002
ICFSOPC1 EQU   *                                                        21560002
         OI    D1(R7),X02    *SET 'PATH ON CPU 1' FLAG                  21600002
ICFSDEVA EQU   *                                                        21640002
         MVC   D2(D2,R7),D0(R5)   *SAVE DEVICE ADDRESS IN ICFWXDEV      21680002
         BR    R8            *BACK WHERE WE CAME FROM                   21720002
         SPACE 5                                                        21760002
ICFSFI   EQU   *             *TELL OPERATOR FUNCTION IS INOPERATIVE     21800002
         LA    R8,ICFINPMS   *MSG TEXT POINTER                          21840002
         LA    R5,ICFINRTR   *RETURN ADDR                               21880002
         B     ICFMSGR       *TO MESSAGE ROUTINE                        21920002
         SPACE 5                                                        21960002
ICFCMTDP EQU   *                                                        22000002
         OI    ICFFLAGA,X40  *SET COMMIT TO DUMP FLAG                   22040002
         LA    R8,ICFCTDMS   *LOAD MSG POINTER                          22080002
         BAL   R5,ICFMSGR    *GO TO MSG ROUT                            22120002
         LA    R1,ICFCTDM    *PREPARE COMMIT TO DUMP MSG                22160002
         WTO   MF=(E,(R1))                                              22200002
         B     ICFSEMTD      *BACK TO MAINLINE                          22240002
         SPACE 5                                                        22280002
ICFPNA   EQU   *                                                        22320002
         LA    R8,ICFPNAMS   *LOAD MSG POINTER                          22360002
         LA    R5,ICFINRTR   *PREPARE FOR RETURN                        22400002
         B     ICFMSGR       *TO MSG ROUT                               22440002
         SPACE 5                                                        22480002
ICFINRTR EQU   *             *'FUNCTION INOPERATIVE' RETURN             22520002
         OI    ICFFLAGA,X80  *SET FUNCTION INOPERATIVE FLAG             22560002
         LA    R1,ICFQUITM   *GET POINTER TO MSG                        22600002
         WTO   MF=(E,(R1))                                              22640002
         B     ICFRTRN2      *BACK TO MASTER SCHEDULER INITIALIZATION   22680002
         SPACE 5                                                        22720002
ICFWRHIT EQU   *                                                        22760002
         LA    R1,ICFWHMSG   *GET POINTER TO 'WARNING BEFOR INIT' MSG   22800002
         WTO   MF=(E,(1))    *SEND THE MESSAGE OUT                      22840002
         B     ICFWAITR      *GO QUIT WITH CODE 027                     22880002
         SPACE 5                                                        22920002
ICFMSGR  EQU   *             *WTOR MESSAGE ROUTINE                      22960002
         MVC   ICFMSWRD(D43),D0(R8)    *SET MESSAGE IN WTOR             23000002
ICFMSGR2 EQU   *              * RE-WRITE MESSAGE               @ZA00521 23010000
         LA    R1,ICFWTOR    *GET MSG POINTER                           23040002
         XC    ICFANSW(D4),ICFANSW     *CLEAN REPLY AREA                23080002
         MVC   ICFWTOR+D1(D3),ICFANSAD *PUT REPLY AREA ADDR IN WTOR     23120002
         MVC   ICFWTOR+D4(D4),ICFREPAD *SET ECB ADDR IN WTOR            23160002
         XC    ICFREPLY,ICFREPLY  *ZERO ECB                             23200002
         WTOR  MF=(E,(R1))                                              23240002
         WAIT  ECB=ICFREPLY  *WAIT FOR REPLY                            23280002
         OC    ICFANSW,C4BLK *XLATE TO UPPER CASE                       23320002
         CLC   ICFANSW(D4),CCGO   *IS REPLY GO?                @ZA00521 23360000
         BCR   D8,R5         *YES, GO BACK TO CALLER                    23400002
         CLC   ICFANSW(D4),CCSTOP *Q. IS REPLY STOP?           @ZA00521 23450000
         BE    ICFWAITR           *YES, STOP WITH 027 WAIT     @ZA00521 23460000
         B     ICFMSGR2           *REPLY INVALID - REISSUE MSG @ZA00521 23470000
         EJECT                                                          23480002
ICFWRNCH EQU   *                                                        23520002
         ST    R8,ICFSV8     *SAVE REG 8                                23560002
         LOCATE ICFWVOL      *LOCATE SYS1.WARNX DATASET                 23600002
         LTR   R15,R15       *WAS LOCATE SUCCESSFUL?                    23640002
         BNZ   ICFNCVOL      *NO, GO SEND MSG                           23680002
*****************************************************************       23720002
         OI    ICFTRMSA+D1,X80    *UPDATE FOOTPRINT TABLE************** 23760002
*****************************************************************       23800002
         CLC   ICFNVOL,CH1   *MORE THAN 1 VOLUME?                       23840002
         BNE   ICFMULTV      *YES, GO SEND MSG                          23880002
         CLC   ICFVOLS,ICFPREV    *ON SAME VOLUME AS OTHER DATASET?     23920002
         BE    ICFSAMV       *YES, GO SEND MSG                          23960002
         MVC   ICFPREV,ICFVOLS    *SAVE VOLSER FOR NEXT TIME AROUND     24000002
         MVC   ICFTUDSN+D15(D1),ICFDSN+D9  *SET CORRECT DSN FOR DYNALL  24040002
         MVC   ICFTUDDN+D12(D1),ICFDSN+D9  *SET CORRECT DDN FOR DYNALL  24080002
         MVC   ICFPDSIN+D6(D1),ICFDSN+D9   *SET CORRECT DDN FOR DEVTYP  24120002
*  THE FOLLOWING CODE IS TEMPORARY UNTIL MAST SCHED DYNALL IS FIXED     24160002
         L     R6,ICFTCBSV   *GET OUR TCB ADDRESS                       24200002
         USING TCB,R6        *ESTABLISH TCB ADDRESSABILITY              24240002
         L     R7,TCBJSCB    *GET OUR JSCB ADDRESS                      24280002
         ST    R7,ICFJSCBS   *SAVE IT FOR LATER                         24320002
         USING IEZJSCB,R7    *ESTABLISH JSCB ADDRESSABILITY             24360002
         MVC   ICFJSTCS,JSCBTCBP  *SAVE ORIGINAL JSCBTCBP               24400002
         ST    R6,JSCBTCBP   *SET MAST.SCHED. TCB ADDR.INTO JSCBTCBP    24440002
         DROP  R6,R7                                                    24480002
*  END OF THE TEMPORARY CODE FOR MAST.SCHED. DYNALL ***************     24520002
         LA    R1,ICFRBPTR   *SET POINTER TO OUR IRB PTR FOR DYNALLOC   24560002
         DYNALLOC                                                       24600002
         L     R6,ICFTCBSV   *GET OUR TCB ADDRESS                       24640002
         USING TCB,R6        *ESTABLISH TCB ADDRESSABILITY              24680002
         L     R6,TCBTIO     *GET OUR TIOT ADDRESS                      24720002
         USING TIOT1,R6      *ESTABLISH TIOT ADDRESSABILITY             24760002
         ST    R6,ICFTIOTS   *SAVE TIOT ADDRESS FOR LATER               24800002
         SR    R7,R7         *CLEAR R7                                  24840002
ICFTIOLP EQU   *             *LOOK FOR THE TIOT ENTRY FOR THIS DATASET  24880002
         IC    R7,TIOELNGH   *IS THIS THE END OF THE TIOT?              24920002
         LTR   R7,R7         *IT IS IF ZERO                             24960002
         BZ    ICFNOTON      *VOLSER NOT MOUNTED - GO SEND MSG          25000002
         CLC   ICFPDSIN,TIOEDDNM  *IS THIS OUR DD ENTRY?                25040002
         BE    ICFGOTDD      *YES, GO HANDLE IT                         25080002
         AR    R6,R7         *GET NEXT TIOT ENTRY                       25120002
         B     ICFTIOLP      *GO TAKE CARE OF IT                        25160002
ICFGOTDD EQU   *                                                        25200002
         L     R7,TIOESTTB   *GET UCB POINTER                           25240002
         DROP  R6                                                       25280002
         LA    R7,D0(R7)     *CLEAR HI ORDER BYTE                       25320002
ICFUCBFD EQU   *                                                        25360002
         USING UCBD,R7       *ESTABLISH UCB ADDRESSABILITY              25400002
         TM    UCBTYP+D2,X20 *IS THIS A DA DEVICE?                      25440002
         BNO   ICFNSDEV      *NO, SEND 'UNSUPP.DEVICE' MSG              25480002
         CLC   SRTEVOLI(D6),ICFPREV    *IS THIS OUR VOLUME?             25520002
         BNE   ICFNCVOL      *NO, SEND 'VOLUME NOT FOUND' MSG           25560002
         TM    UCBTYP+D1,X01 *IS IT UPS SUPPORTED?                      25600002
         BNO   ICFNOUPS      *NO, GO SEND MSG                           25640002
* /* TEST FOR SYSRES DEVICE REMOVED BY OZ30392               @ZA30392*/ 25680003
         CLI   ICFDSN+D9,CA  *WARNA DATASET?                            25760002
         BE    ICFSVDT       *YES, GO SAVE DEVICE TYPE                  25800002
         CLC   ICFDVPRE+D3(D1),UCBTYP+D3  *IS WARNB ON SAME UNTTYP AS A 25840002
         BNE   ICFDDT        *NO, GO SEND MSG                           25880002
ICFBLJFC EQU   *                                                        25920002
         OBTAIN ICFWDSN      *OBTAIN SYS1.WARNX DSCB                    25960002
         LTR   R15,R15       *WAS OBTAIN SUCCESSFUL?                    26000002
         BNZ   ICFNCVOL      *NO, GO SEND MESSAGE                       26040002
*****************************************************************       26080002
         OI    ICFTRMSA+D1,X40    *UPDATE FOOTPRINT TABLE************** 26120002
*****************************************************************       26160002
         MVC   ICFJFCB(D10),ICFDSN     *SET DSN IN JFCB                 26200002
         L     R9,ICFTIOTS   *GET OUR TIOT ADDRESS                      26240002
         LA    R3,ICFPRMLS   *GET ADDRESS OF PARM LIST FOR OPEN         26280002
         DEVTYPE ICFPDSIN,ICFDVTYP,DEVTAB                               26320002
         L     R6,ICFDVTYP+D4     *GET TRACK CAPACITY                   26360002
         SRL   R6,D11        *ROUND DOWN                                26400002
         SLL   R6,D11        *TO NEXT 2K                                26440002
         ST    R6,ICFTRSIZ   *SAVE IN COMMUNICATION AREA                26480002
         LH    R6,ICFDVTYP+D10    *GET TRACKS PER CYLINDER              26520002
         LA    R5,D20        *GET MAXIMUM TRKS/CYL SUPPORTED BY PWF     26560002
         CR    R6,R5         *DOES THE WARNX DEVICE SATISFY THIS LIMIT? 26600002
         BH    ICFNSDEV      *NO, GO SEND 'UNSUPPORTED DEVICE' MSG      26640002
         ST    R6,ICFTPC     *SAVE IN COMM AREA                         26680002
*****************************************************************       26720002
         OI    ICFTRMSA+D1,X20    *UPDATE FOOTPRINT TABLE************** 26760002
*****************************************************************       26800002
         SPACE 3                                                        26840002
*        PREPARE TO OPEN SYS1.WARNX.                                    26880002
         SPACE                                                          26920002
         ST    R9,D12(R3)    *SAVE TIOT POINTER                         26960002
         MVC   ICFPRVOL(D6),SRTEVOLI   *VOLSER FROM UCB TO JFCB         27000002
         LA    R5,ICFDCB     *GET DCB POINTER                           27040002
         USING IHADCB,R5     *ESTABLISH DCB ADDRESSABILITY              27080002
         MVC   DCBDDNAM+D6(D1),ICFDSN+D9  *SET CORRECT DDN IN DCB       27120002
         ST    R3,D0(R3)     *POINTER TO PARM LIST                      27160002
         MVC   DCBEXLST+D1(D3),D1(R3)  *INTO DCB                        27200002
         LA    R6,ICFJFCB    *GET JFCB POINTER                          27240002
         ST    R6,D0(R3)     *GOES TO FIRST WORD PLACE                  27280002
         MVI   D0(R3),X87    *'LAST ONE' INDICATOR                      27320002
         MVI   D4(R3),X80    *DITTO                                     27360002
         LA    R1,D4(R3)     *PARM AREA FOR USE OF MACRO EXPANSION      27400002
         OPEN  ((R5),INOUT),TYPE=J,MF=(E,(1))                           27440002
         TM    DCBOFLGS,X10   *WAS OPEN SUCCESSFUL?                     27480002
         BNO   ICFNOPN       *NO, GO SEND MSG                           27520002
         STM   R3,R5,ICFSV35 *SAVE REGS 3 TO 5                          27560002
         OI    ICFESTPR,X0F  *SET FLAG FOR RETURN FROM ESTAE            27600002
         L     R6,DCBDEBAD    *GET DEB ADDRESS FROM DCB                 27640002
         DROP  R5                                                       27680002
         USING DEBBASIC,R6   *ESTABLISH BASIC DEB ADDRESSABILITY        27720002
         LA    R6,DEBBASND-DEBBASIC(R6)  *POINT TO DASD SECTION         27760002
         USING DEBDASD,R6    *ESTABLISH DASD SECT. ADDRESSABILITY       27800002
         MVC   ICFDEBCH,DEBBINUM   *SAVE START BBCCHH                   27840002
*****************************************************************       27880002
         OI    ICFTRMSA+D1,X10    *UPDATE FOOTPRINT TABLE************** 27920002
*****************************************************************       27960002
         L     R3,X10        *GET CVT POINTER                           28000002
         USING CVT,R3        *ESTABLISH CVT ADDRESSABILITY              28040002
         L     R3,CVTEORM    *GET REAL STORAGE SIZE FROM CVT            28080002
         DROP  R3                                                       28120002
         ST    R3,ICFSTSIZ   *STORE IT IN COMM AREA                     28160002
         SR    R2,R2         *CLEAR REG 2                               28200002
         D     R2,ICFTRSIZ   *DIVIDE STRG SIZE BY TRACK CAPACITY        28240002
         LTR   R2,R2         *IS THERE A REMAINDER?                     28280002
         BZ    ICFNORMD      *NO, WE HAVE THE NUMBER OF TRACKS NEEDED   28320002
         LA    R3,D1(R3)     *YES, ADD 1 TO NO OF TRCKS REQRD           28360002
         SR    R2,R2         *AND CLEAN REMAINDER                       28400002
ICFNORMD EQU   *                                                        28440002
         L     R4,ICFTPC     *GET TRACKS PER CYLINDER                   28480002
         BCTR  R4,R0         *MINUS 1                                   28520002
         DR    R2,R4         *FIND NO OF CYLINDERS REQRD                28560002
         LTR   R2,R2         *ANY REMAINDER?                            28600002
         BZ    ICFNOCRM      *NO, WE HAVE NO OF CYLINDERS REQRD         28640002
         LA    R3,D1(R3)     *YES, ADD 1 TO NO CYL REQRD                28680002
         SR    R2,R2         *AND CLEAN REMAINDER                       28720002
ICFNOCRM EQU   *                                                        28760002
         LA    R3,D1(R3)     *ADD 1 CYLINDER FOR CNTRL TRK              28800002
         LA    R4,D1(R4)     *RESTORE CORRECT NO TRKS PER CYL           28840002
         MR    R2,R4         *TRACKS REQUIRED IN DATASET                28880002
         LR    R2,R3         *SAVE THIS VALUE                           28920002
         CH    R2,DEBNMTRK    *COMPARE WITH TRKS IN EXTENT              28960002
         BH    ICFSMEXT      *EXTENT TOO SMALL. GO SEND MSG             29000002
         SPACE 3                                                        29040002
*        PREPARE TO USE EXCP TO READ CONTROL TRACK.                     29080002
         SPACE                                                          29120002
         MVC   ICFIOB+D33(D6),ICFDEBCH *SET SK/SRC ADDR IN IOB          29160002
         MVI   ICFIOB+D39,X01     *SET R = 1                            29200002
         LA    R3,ICFCNTRK   *GET ADDR OF CNTRL TRK BUFFER              29240002
         O     R3,ICFRDCMD   *SET RD COMMAND IN PLACE                   29280002
         ST    R3,ICFCCWS+D24     *STORE IN RD/WR CCW                   29320002
         MVC   ICFCCWS+D30(D2),CH512   *SET COUNT IN RD/WR CCW          29360002
ICFRCT   EQU   *                                                        29400002
         XC    ICFECB,ICFECB *ZERO OUT ECB                              29440002
         EXCP  ICFIOB                                                   29480002
         WAIT  ECB=ICFECB    *WAIT FOR COMPL. OF READ                   29520002
         TM    ICFECB,X7F    *WAS READ SUCCESSFUL?                      29560002
         BNO   ICFRDERR      *NO, GO TRY NEXT TRK OR SEND MSG           29600002
ICFGOTCT EQU   *                                                        29640002
         CLC   ICFCTID,CCCNTL     *IS IT GOOD CNTRL TRK?                29680002
         BNE   ICFRDERR      *NO, GO TRY NEXT TRK OR SEND MSG           29720002
ICFGODCT EQU   *                                                        29760002
*****************************************************************       29800002
         OI    ICFTRMSA+D1,X08    *UPDATE FOOTPRINT TABLE************** 29840002
*****************************************************************       29880002
         TM    ICFCTFLA,X80  *DOES DATASET STILL CONTAIN DUMP?          29920002
         BO    ICFDMPIN      *YES, GO TAKE CARE OF IT                   29960002
         STCK  ICFCTED       *GET CURRENT DATE/TIME                     30000002
         L     R4,ICFCTED    *PUT IT IN GPR                             30040002
         S     R4,ICFCTST    *SUBTRACT DATE/TIME OF LAST FORMAT         30080002
         BM    ICFORMAT      *SOMETHING'S WRONG - GO FORMAT             30120002
         C     R4,CTOD24HR   *IS DIFFERENCE SMALLER THAN 24 HRS?        30160002
         BL    ICFSKFRM      *YES, SKIP FORMATTING                      30200002
         SPACE 3                                                        30240002
*        THE FOLLOWING SECTION WILL FORMAT THE WARNX DATASET.           30280002
         SPACE                                                          30320002
ICFORMAT EQU   *                                                        30360002
         MVC   ICFIOB+D33(D6),ICFDEBCH *SK/SRC ADDRESS IN IOB           30400002
         MVI   ICFIOB+D39,X00     *RR = 0 IN IOB                        30440002
         L     R4,ICFTRSIZ   *GET TRACK SIZE                            30480002
         LA    R4,D8(R4)     *INCREMENT BY 8 FOR COUNT FIELD            30520002
         GETMAIN R,LV=(R4)   *GET FORMAT BUFFER                         30560002
         OI    ICFESTPR,XF0  *SET FLAG FOR RETURN FROM ESTAE            30600002
         ST    R1,ICFRMBUF   *SAVE ADDRESS OF BUFFER                    30640002
         MVC   D0(D4,R1),ICFIOB+D35    *SET CCHH IN COUNT FIELD         30680002
         MVI   D4(R1),X01    *SET RR IN COUNT FIELD                     30720002
         MVI   D5(R1),X00    *SET KL IN COUNT FIELD                     30760002
         LA    R4,D5(R1)     *ADDRESS OF SECOND OPERAND                 30800002
         LA    R2,D8(R1)     *ADDRESS OF FIRST OPERAND                  30840002
         L     R3,ICFTRSIZ   *LNGTH OF FIRST OPERAND                    30880002
         LA    R5,D1         *LNGTH OF SECND OPRND & PADDING            30920002
         MVCL  R2,R4         *CLEAN ALL FORMAT BUFFER                   30960002
         LA    R1,D0(R1)     *CLEAN HIGH ORDER BYTE                     31000002
         LR    R2,R1         *SAVE POINTER TO BUFFER                    31040002
         O     R1,ICFWRCMD   *SET WRITE CKD COMMAND                     31080002
         ST    R1,ICFCCWS+D24     *STORE IN RD/WR CCW                   31120002
*****************************************************************       31160002
         OI    ICFTRMSA+D1,X04    *UPDATE FOOTPRINT TABLE************** 31200002
*****************************************************************       31240002
         SPACE 3                                                        31280002
*        WRITE FORMAT FOR THE CONTROL TRACK                             31320002
         SPACE                                                          31360002
         MVC   ICFCCWS+D30(D2),CH520   *SET COUNT IN RD/WR CCW          31400002
         MVC   D6(D2,R2),CH512         *SET D L IN COUNT FIELD          31440002
         XC    ICFECB,ICFECB           *CLEAR ECB                       31480002
         EXCP  ICFIOB        *WRITE FORMAT FOR CNTRL TRK                31520002
         WAIT  ECB=ICFECB                                               31560002
         TM    ICFECB,X7F    *ANY ERRORS?                               31600002
         BNO   ICFWRER2      *YES, GO SEND MSG                          31640002
*****************************************************************       31680002
         OI    ICFTRMSA+D1,X02    *UPDATE FOOTPRINT TABLE************** 31720002
*****************************************************************       31760002
         SPACE 3                                                        31800002
*        WRITE FORMAT FOR THE REST OF THE DATASET                       31840002
         SPACE                                                          31880002
         L     R3,ICFIOB+D36      *GET CCHHHHRR                         31920002
         A     R3,CF256           *INCREMENT HHHH BY 1                  31960002
         ST    R3,ICFIOB+D36      *SET BACK IN IOB                      32000002
         MVC   D0(D4,R2),ICFIOB+D35    *SET CCHH IN COUNT FIELD         32040002
         L     R4,ICFTRSIZ        *GET TRACK SIZE                       32080002
         STH    R4,D6(R2)         *SET D L IN COUNT FIELD               32120002
         LA    R4,D8(R4)          *INCREMENT BY 8 FOR COUNT FIELD       32160002
         STH   R4,ICFCCWS+D30     *SET COUNT IN RD/WR CCW               32200002
         LH    R4,DEBNMTRK    *GET NO. TRKS IN EXTENT                   32240002
         DROP  R6                                                       32280002
         BCTR  R4,R0         *LESS 1 (CNTRL TRK)                        32320002
         L     R5,ICFTPC     *GET TRKS PER CYL                          32360002
         BCTR  R5,R0         *LESS 1 (CNTRL TRK)                        32400002
ICFFMTLP EQU   *                                                        32440002
         XC    ICFECB,ICFECB *CLEAR ECB                                 32480002
         EXCP  ICFIOB        *WRITE COUNT, KEY AND DATA                 32520002
         WAIT  ECB=ICFECB                                               32560002
         TM    ICFECB,X7F    *ANY ERRORS?                               32600002
         BNO   ICFWRER2      *YES, GO SEND MSG                          32640002
         L     R3,ICFIOB+D36 *GET CCHHHHRR FROM IOB                     32680002
         A     R3,CF256      *INCREMENT HHHH BY 1                       32720002
         ST    R3,ICFIOB+D36      *SET IT BACK                          32760002
         MVC   D0(D4,R2),ICFIOB+D35    *SET CCHH IN COUNT FIELD         32800002
         BCT   R4,ICFWRT01   *MORE TRACKS TO FORMAT?                    32840002
*****************************************************************       32880002
         OI    ICFTRMSA+D1,X01    *UPDATE FOOTPRINT TABLE************** 32920002
*****************************************************************       32960002
         L     R1,ICFRMBUF   *NO, PREPARE TO FREEMAIN                   33000002
         LH    R4,ICFCCWS+D30     *LNGTH OF BUFFER AREA                 33040002
         FREEMAIN R,LV=(R4),A=(R1)     *FREE IT                         33080002
         NI    ICFESTPR,X0F  *RESET FLAG FOR RETURN FROM ESTAE          33120002
ICFSKFRM EQU   *                                                        33160002
         SPACE 3                                                        33200002
*        THE FOLLOWING SECTION WILL INITIALIZE                          33240002
*        AND WRITE THE CONTROL TRACK.                                   33280002
         SPACE                                                          33320002
         MVC   ICFCTID,CCCNTL     *SET CNTRL TRK IDENTIFIER             33360002
         L     R2,ICFTPC     *GET NO. TRKS PER CYL                      33400002
         BCTR  R2,R0         *LESS 1 - LAST TRK NO.                     33440002
         STC   R2,ICFCTCF    *INITIALIZE:                               33480002
         MVC   ICFCTCF+D1(D127),ICFCTCF      *CYLINDER FLAGS            33520002
         MVI   ICFCTFLA,X00  *FLAG A FIELD                              33560002
         MVC   ICFCTTS,ICFTRSIZ   *NO. BYTES PER TRACK                  33600002
         LRA   R3,D0(R10)    *GET REAL ADDR. OF COMM.AREA               33640002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  33680002
         ST    R3,ICFCTAWA   *COMMUNICATION AREA ADDR                   33720002
         XC    ICFCTB11,ICFCTB11  *S.O.B. STORAGE ADDRESS               33760002
         MVC   ICFCTB12,ICFDEBCH+D2    *S.O.B. CCCCHHHH                 33800002
         MVI   ICFCTB13,XFF  *ALL OTHER                                 33840002
         MVC   ICFCTB13+D1(D119),ICFCTB13    *STORAGE BLOCKS            33880002
         STCK  ICFCTST       *DATE/TIME OF FORMAT                       33920002
         XC    ICFCTED(D48),ICFCTED     *ICFCTED THRU ICFCTCHA          33960002
         MVC   ICFCTTPC,ICFTPC    *SAVE TRKS/CYL IN CNTL TRK            34000002
         MVC   ICFCTSTS,ICFSTSIZ  *SAVE HIGHEST STRG ADDR IN CNTL TRK   34040002
         MVC   ICFCTDAT(D8),ICFLRDAT   *DATE & TIME OF DUMP -           34080002
*        THESE TWO FIELDS WILL BE UPDATED BY MCH APPNDG AT PROPER TIME. 34120002
         MVC   ICFCTCPU,ICFLRCPU  *CPU ID                               34160002
         MVC   ICFCTCHA,ICFLRCHA  *CHANNEL ASSIGNMENT                   34200002
         MVI   ICFCTRSV,XEE     *TO EASE IDENTIFICATION OF              34240002
         MVC   ICFCTRSV+D1(ICFCTEND-ICFCTRSV-D1),ICFCTRSV *CNTL TRK     34280002
*****************************************************************       34320002
         OI    ICFTRMSA+D2,X80    *UPDATE FOOTPRINT TABLE************** 34360002
*****************************************************************       34400002
         XC    ICFECB,ICFECB *CLEAR ECB                                 34440002
         MVC   ICFIOB+D33(D6),ICFDEBCH *SET SK/SRC ADDR IN IOB          34480002
         MVI   ICFIOB+D39,X01     *SET RR = 1 IN IOB                    34520002
         LA    R3,ICFCNTRK   *GET ADDR OF CNTRL TRK BUFFER              34560002
         O     R3,ICFWDCMD   *SET WRITE DATA COMMAND                    34600002
         ST    R3,ICFCCWS+D24      *STORE IN RD/WR CCW                  34640002
         MVC   ICFCCWS+D30(D2),CH512   *SET COUNT IN RD/WR CCW          34680002
         EXCP  ICFIOB                                                   34720002
         WAIT  ECB=ICFECB                                               34760002
         TM    ICFECB,X7F    *ANY ERRORS?                               34800002
         BNO   ICFWRERR      *YES, GO SEND MSG                          34840002
*****************************************************************       34880002
         OI    ICFTRMSA+D2,X40    *UPDATE FOOTPRINT TABLE************** 34920002
*****************************************************************       34960002
         MVO   ICFMVO,ICFDEBCH+D2(D2)  *CONVERT CCCC TO                 35000002
         UNPK  ICFUNPK,ICFMVO     *PRINTABLE CHARACTERS                 35040002
         SR    R3,R3         *TAKE                                      35080002
         LA    R4,ICFUNPK    *CARE*                                     35120002
         BAL   R8,ICFTRBYT   *OF                                        35160002
         LA    R4,ICFUNPK+D1 *ALPHA                                     35200002
         BAL   R8,ICFTRBYT   *NUMBERS                                   35240002
         LA    R4,ICFUNPK+D2 *BYTE                                      35280002
         BAL   R8,ICFTRBYT   *BY                                        35320002
         LA    R4,ICFUNPK+D3 *BYTE                                      35360002
         BAL   R8,ICFTRBYT   *SAME                                      35400002
         CLI   ICFDSN+D9,CA  *IS THIS WARNA?                            35440002
         BNE   ICFWRNB       *NO, GO HANDLE WARNB                       35480002
         MVC   ICFEXTMS+D13(D6),ICFPREV   *SET VOLSER IN OPR MSG        35520002
         MVC   ICFEXTMS+D20(D4),ICFUNPK   *SET CCCC IN OPR MSG          35560002
         B     ICFEXMDN      *ALL DONE FOR WARNA                        35600002
ICFWRNB  EQU   *             *HANDLE WARNB MSG PORTION                  35640002
         MVC   ICFEXTMS+D27(D6),ICFPREV   *SET VOLSER IN OPR MSG        35680002
         MVC   ICFEXTMS+D34(D4),ICFUNPK   *SET CCCC IN OPR MSG          35720002
ICFEXMDN EQU   *             *ALL DONE FOR WARNB TOO                    35760002
         LM    R3,R5,ICFSV35   *RESTORE REGS 3 TO 5                     35800002
         L     R8,ICFSV8     *RESTORE REG 8                             35840002
*****************************************************************       35880002
         OI    ICFTRMSA+D2,X20    *UPDATE FOOTPRINT TABLE************** 35920002
*****************************************************************       35960002
ICFEREX  EQU   *                                                        36000002
         LA    R1,D4(R3)     *SETUP TO CLOSE                            36040002
         MVI   D4(R3),X80    *'LAST ONE' INDICATOR                      36080002
         CLOSE ((R5)),MF=(E,(1))  *CLOSE WARNX DATASET                  36120002
         NI    ICFESTPR,XF0  *RESET FLAG FOR RETURN FROM ESTAE          36160002
*  THE FOLLOWING CODE IS TEMPORARY UNTIL MAST.SCHED.DYNALL IS FIXED     36200002
         L     R6,ICFJSCBS   *GET POINTER TO OUR JSCB                   36240002
         USING IEZJSCB,R6    *ESTABLISH JSCB ADDRESSABILITY             36280002
         MVC   JSCBTCBP,ICFJSTCS  *RESTORE JSCBTCBP FIELD               36320002
         DROP  R6                                                       36360002
*  END OF THE TEMPORARY CODE FOR MAST.SCHED. DYNALL *********           36400002
*****************************************************************       36440002
         OI    ICFTRMSA+D2,X10    *UPDATE FOOTPRINT TABLE************** 36480002
*****************************************************************       36520002
         BR    R8       *ALL DONE WITH THIS DATASET. BACK TO MAINLINE   36560002
         EJECT                                                          36600002
ICFWRT01 EQU   *                                                        36640002
         BCT   R5,ICFFMTLP   *END OF CYLINDER?                          36680002
         LM    R2,R3,ICFIOB+D32   *YES, UPDATE CCCC                     36720002
         SLDL  R2,D8         *PUT BBBBCCCC IN R2                        36760002
         A     R2,CF1        *INCREMENT CCCC BY 1                       36800002
         SRDL  R2,D8         *REALIGN                                   36840002
         STM   R2,R3,ICFIOB+D32   *PUT BACK IN IOB                      36880002
         XC    ICFIOB+D37(D2),ICFIOB+D37   *ZERO HHHH IN IOB            36920002
         L     R2,ICFRMBUF   *RESTORE PTR TO BUFFER                     36960002
         MVC   D0(D4,R2),ICFIOB+D35   *SET CCHH IN COUNT FLD            37000002
         L     R5,ICFTPC     *INIT BCT REG FOR NEXT CYL                 37040002
         B     ICFFMTLP      *BACK FOR NEXT CYLINDER                    37080002
         SPACE 5                                                        37120002
ICFSVDT  EQU   *                                                        37160002
         MVC   ICFDVPRE,UCBTYP    *SAVE DEVICE TYPE                     37200002
         B     ICFBLJFC      *BACK TO MAINLINE                          37240002
         SPACE 5                                                        37280002
ICFTRBYT EQU   *                                                        37320002
         IC    R3,D0(R4)     *GET BYTE TO BE XLATED                     37360002
         C     R3,CFF9       *IS THIS ALPHA NUMBER?                     37400002
         BNH   ICFTREXT      *NO, LEAVE IT ALONE                        37440002
         S     R3,CF39       *YES, XLATE IT TO PRINTABLE CHAR           37480002
         STC   R3,D0(R4)     *PUT BACK XLATED BYTE                      37520002
ICFTREXT EQU   *                                                        37560002
         BR    R8            *BACK TO MAINLINE                          37600002
         SPACE 5                                                        37640002
ICFNCVOL EQU   *                                                        37680002
         LA    R8,ICFNCVMS   *LOAD MSG PTR                              37720002
         MVC   ICFNCVMS+D37(D1),ICFDSN+D9   *SET DS IDENT IN MSG        37760002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           37800002
         B     ICFMSGR       *GO TO MSG ROUTINE                         37840002
         SPACE 5                                                        37880002
ICFMULTV EQU   *                                                        37920002
         LA    R8,ICFMVMSG   *LOAD MSG POINTER                          37960002
         MVC   ICFMVMSG+D12(D1),ICFDSN+D9   *SET DS IDENT IN MSG        38000002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           38040002
         B     ICFMSGR       *GO TO MSG ROUTINE                         38080002
         SPACE 5                                                        38120002
ICFSAMV  EQU   *                                                        38160002
         LA    R8,ICFSVMSG   *LOAD MSG PTR                              38200002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           38240002
         B     ICFMSGR       *GO TO MSG ROUTINE                         38280002
         SPACE 5                                                        38320002
ICFNOTON EQU   *                                                        38360002
         LA    R8,ICFNOMSG   *LOAD MSG PTR                              38400002
         MVC   ICFNOMSG+D10(D6),ICFPREV           *FILL IN              38440002
         MVC   ICFNOMSG+D30(D1),ICFDSN+D9         *MESSAGE              38480002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           38520002
         B     ICFMSGR       *GO TO MSG ROUTINE                         38560002
         SPACE 5                                                        38600002
ICFNSDEV EQU   *                                                        38640002
         LA    R8,ICFNSDMS   *LOAD MSG POINTER                          38680002
         MVC   ICFNSDMS+D12(D1),ICFDSN+D9  *FILL IN MSG                 38720002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           38760002
         B     ICFMSGR       *GO TO MSG ROUTINE                         38800002
         SPACE 5                                                        38840002
ICFNOUPS EQU   *                                                        38880002
         LA    R8,ICFNPMSG   *LOAD MSG PTR                              38920002
         MVC   ICFNPMSG+D10(D6),ICFPREV      *FILL IN MSG               38960002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           39000002
         B     ICFMSGR       *GO TO MSG ROUTINE                         39040002
         SPACE 5                                                        39080002
ICFDDT   EQU   *                                                        39120002
         LA    R8,ICFDDTMS   *LOAD MSG PTR                              39160002
         LA    R5,ICFINRTR   *PREPARE TO QUIT                           39200002
         B     ICFMSGR       *GO TO MSG ROUTINE                         39240002
         SPACE 5                                                        39280002
ICFNOPN  EQU   *                                                        39320002
         LA    R8,ICFNOPMS   *LOAD MSG PTR                              39360002
         MVC   ICFNOPMS+D27(D1),ICFDSN+D9   *SET DSN IN MSG             39400002
         BAL   R5,ICFMSGR    *GO TO MSG ROUTINE                         39440002
         B     ICFINRTR      *GO QUIT                                   39480002
         SPACE 5                                                        39520002
ICFSMEXT EQU   *                                                        39560002
         LA    R8,ICFSEMSG   *LOAD MSG PTR                              39600002
         MVC   ICFSEMSG+D12(D1),ICFDSN+D9   *SET DSN IN MSG             39640002
ICFCLRTR EQU   *             *CLOSE BEFORE QUITTING                     39680002
         BAL   R5,ICFMSGR    *GO TO MSG ROUTINE                         39720002
         LA    R8,ICFINRTR   *PREPARE TO QUIT (AFTER CLOSING)           39760002
         LM    R3,R5,ICFSV35      *RESTORE REGS 3 TO 5                  39800002
         B     ICFEREX       *GO TO APPROPRIATE POINT IN MAINLINE       39840002
         SPACE 5                                                        39880002
ICFRDERR EQU   *             *READ ERROR MSG ROUTINE                    39920002
         MVC   ICFWH1,ICFIOB+D37  *GET HHHH OF CNTL TRK                 39960002
         LH    R8,ICFWH1     *PUT IT IN GPR                             40000002
         LA    R8,D1(R8)     *BUMP IT BY 1                              40040002
         C     R8,ICFTPC     *TRYED ALL CYLINDER?                       40080002
         BNL   ICFREMR       *YES, GO SEND ERROR MSG                    40120002
         STH   R8,ICFWH1     *UPDATE HHHH                               40160002
         MVC   ICFIOB+D37(D2),ICFWH1   *IN IOB                          40200002
         B     ICFRCT        *TRY READ NEXT TRACK                       40240002
ICFREMR  EQU   *                                                        40280002
         LA    R8,ICFREMSG   *LOAD MSG PTR                              40320002
         MVC   ICFREMSG+D30(D1),ICFDSN+D9   *SET DSN IN MSG             40360002
         LA    R5,ICFORMAT   *PREPARE TO FORMAT  (WAS ICFCLRTR)         40400002
         B     ICFMSGR       *GO SEND MSG                               40440002
         SPACE 5                                                        40480002
ICFDMPIN EQU   *             *DATASET CONTAINS VALID DUMP               40520002
         MVC   ICFVDMSG+D44(D1),ICFDSN+D9   *DSN IN MSG                 40560002
ICFRFMR  EQU   *                                                        40600002
         LA    R1,ICFVDMSG   *GET MSG POINTER                           40640002
         XC    ICFANSW(D4),ICFANSW     *CLEAN REPLY AREA                40680002
         MVC   ICFVDMSG+D1(D3),ICFANSAD   *PUT REPLY ADDR IN WTOR       40720002
         MVC   ICFVDMSG+D4(D4),ICFREPAD   *PUT ECB ADDR IN WTOR         40760002
         XC    ICFREPLY,ICFREPLY  *ZERO ECB                             40800002
         WTOR  MF=(E,(R1))                                              40840002
         WAIT  ECB=ICFREPLY  *WAIT FOR REPLY                            40880002
         OC    ICFANSW,C4BLK *XLATE TO UPPER CASE                       40920002
         CLC   ICFANSW(D4),CCREST *IS RESTORE REQUESTED?                40960002
         BE    ICFREST       *YES, GO DO IT                             41000002
         CLC   ICFANSW(D4),CCFORM *IS FORMAT REQUESTED?                 41040002
         BNE   ICFRFMR       *NO, REISSUE THIS MESSAGE                  41080002
         SPACE 3                                                        41120002
**************************************************************          41160002
*                                                                     * 41200002
*        WRITE ENTRY ON LOGREC TO RECORD PREVIOUS POWER FAILURE       * 41240002
*                                                                     * 41280002
**************************************************************          41320002
         SPACE                                                          41360002
         XC    ICFLRBUF(D56),ICFLRBUF  *CLEAN LOGREC BUFFER             41400002
         L     R1,X10        *GET CVT POINTER                           41440002
         S     R1,CF4        *GET POINTER TO CVTRELNO                   41480002
         MVC   ICFLRBUF+D5(D1),D2(R1)  *SET RELEASE LEVEL               41520002
         PACK  ICFLRBUF+D48(D8),D0(D2,R1)   *PACK RELEASE NO.           41560002
         CVB   R1,ICFLRBUF+D48    *CONVERT RELEASE NO. TO BINARY        41600002
         MVI   ICFLRBUF,X50  *SET RECORD TYPE                           41640002
         STC   R1,ICFLRBUF+D1     *RELEASE NO.                          41680002
         MVI   ICFLRBUF+D2,X08    *WHATEVER IT IS                       41720002
         MVC   ICFLRBUF+D8(D16),ICFCTDAT    *DATE, TIME & CPU ID        41760002
         MVI   ICFLRBUF+D24,X10   *WHATEVER IT IS                       41800002
         MVC   ICFLRBUF+D24(D2),CCEN     *DITTO                         41840002
         MVC   ICFLRBUF+D32(D8),ICFCTCHA   *CHAN. ASSIGNMNT             41880002
         MVC   ICFLRBUF+D40(D4),ICFCTSTS   *HIGHEST STRG ADDR           41920002
         LA    R0,D48        *GET RECORD LENGTH                         41960002
         LNR   R0,R0         *MAKE IT NEGATIVE                          42000002
         LA    R1,ICFLRBUF   *GET POINTER TO RECORD                     42040002
         SVC   D76           *GO WRITE LOGREC RECORD                    42080002
         SPACE 3                                                        42120002
**************************************************************          42160002
*                                                                     * 42200002
*        SET UP FOR AND GO TO USER EXIT ROUTINE                       * 42240002
*                                                                     * 42280002
**************************************************************          42320002
         SPACE                                                          42360002
         ST    R9,ICFUSPRM   *SAVE IT IN USER PARM LIST                 42400002
         LA    R1,ICFUSPRM   *LOAD POINTER TO PARM LIST FOR USER        42440002
         L     R15,ICFTIUEP  *GET USER ROUTINE E.P.A.                   42480002
         BALR  R14,R15       *PASS CONTROL TO USER ROUTINE              42520002
         B     ICFORMAT      *NOW GO FORMAT THE DATASET                 42560002
         SPACE 3                                                        42600002
ICFWRER2 EQU   *                                                        42640002
         LA    R8,ICFWEMSG   *LOAD MSG PTR                              42680002
         MVC   ICFWEMSG+D30(D1),ICFDSN+D9   *DSN IN MSG                 42720002
         BAL   R5,ICFMSGR    *GO TO MSG ROUTINE                         42760002
ICFFREMB EQU   *             *                                          42800002
         L     R1,ICFRMBUF   *PREPARE TO FREEMAIN                       42840002
         LH    R4,ICFCCWS+D30     *LNGTH OF AREA TO FREE                42880002
         FREEMAIN R,LV=(R4),A=(R1)     *FREE IT                         42920002
         NI    ICFESTPR,X0F  *RESET FLAG FOR RETURN FROM ESTAE          42960002
         LA    R8,ICFINRTR   *PREPARE TO QUIT                           43000002
         LM    R3,R5,ICFSV35      *RESTORE REGS 3 TO 5                  43040002
         B     ICFEREX       *GO QUIT (AFTER CLOSING THOUGH)            43080002
         SPACE 5                                                        43120002
ICFWRERR EQU   *                                                        43160002
         LA    R8,ICFWEMSG   *LOAD MSG POINTER                          43200002
         MVC   ICFWEMSG+D30(D1),ICFDSN+D9   *DSN IN MSG                 43240002
         B     ICFCLRTR      *GO QUIT AFTER CLOSING                     43280002
         EJECT                                                          43320002
********************************************************************    43360002
*                                                                     * 43400002
*              ESTAE EXIT ROUTINE                                     * 43440002
*                                                                     * 43480002
********************************************************************    43520002
         SPACE 1                                                        43560002
ICFESTAE EQU   *                                                        43600002
         STM   R14,R12,D12(R13)   *SAVE REGISTERS AT ABEND              43640002
         USING SDWA,R1       *ESTABLISH SDWA ADDRESSABILITY             43680002
         LM    R2,R13,SDWASR02      *REINIT REGISTERS FOR THIS MODULE   43720002
         SETRP RETADDR=ICFRETRY,DUMP=YES,RC=4  *SET UP FOR RETRY ROUT.  43760002
         LM    R1,R12,D24(R13)   *RESTORE APPROPRIATE REGISTERS         43800002
         LA    R15,D4        *INDICATE RETRY HAS TO TAKE PLACE          43840002
         BR    R14           *GO BACK TO TERMINATION PROCESSING         43880002
         SPACE 5                                                        43920002
ICFRETRY EQU   *                                                        43960002
         USING SDWA,R1       *ESTABLISH SDWA ADDRESSABILITY             43970002
         LM    R2,R13,SDWASR02      *REINIT REGISTERS FOR THIS MODULE   44000002
         LA    R1,ICFUNEMS   *GET 'UNEXPECTED ERROR' MESSAGE POINTER    44040002
         WTO   MF=(E,(1))    *WRITE MESSAGE OUT                         44080002
         TM    ICFESTPR,XF0  *DO WE HAVE TO FREEMAIN FORMAT BUFFER?     44120002
         BO    ICFSER01      *YES, GO SET CORRECT RETURN ADDRESS        44160002
         TM    ICFESTPR,X0F  *DO WE HAVE TO CLOSE WARNX DCB?            44200002
         BO    ICFSER02      *YES, GO SET CORRECT RETURN ADDRESS        44240002
         L     R14,ICFESTPR+D0    *PREPARE RETURN TO MASTER SCHEDULER   44280002
         BR    R14           *GO SET FUNCTION INOPERATIVE               44320002
         SPACE 3                                                        44360002
ICFSER01 EQU   *                                                        44400002
         L     R14,ICFESTPR+D8    *PREPARE RETURN TO MASTER SCHEDULER   44440002
         BR    R14           *GO FREEMAIN FORMAT BUFFER,CLOSE WARNX AND 44480002
*                            *SET FUNCTION INOPERATIVE                  44520002
         SPACE 3                                                        44560002
ICFSER02 EQU   *                                                        44600002
         LA    R8,ICFINRTR        *PREPARE CORRECT RETURN               44640002
         L     R14,ICFESTPR+D4    *PATH BACK TO MASTER SCHEDULER        44680002
         BR    R14           *GO CLOSE WARNX AND SET FUNCTION INOPER.   44720002
         SPACE 3                                                        44760002
         EJECT                                                          44800002
*        JOB FILE CONTROL BLOCK                                         44840002
         SPACE                                                          44880002
ICFJFCB  EQU   *                                                        44920002
         DC    CL44' '       *DATASET NAME                              44960002
         DC    CL8' '        *EL. NAME, GEN#                            45000002
         DC    B'00001000'   JOB-DATA MGMT INTFC                        45040002
         DC    XL13'0'       SYSTEM CODE                                45080002
         DC    X'01'         NO LABEL                                   45120002
         DC    X'0'          SPARE                                      45160002
         DC    XL2'0'        FILE SEQUENCE                              45200002
         DC    XL2'0'        *VOLUME SEQUENCE                           45240002
         DC    XL8'0'        *DATA MGMT MASK                            45280002
         DC    XL6'0'        *DATES                                     45320002
         DC    X'0'          *INDICATOR 1                               45360002
         DC    X'40'         *INDICATOR 2 - OLD                         45400002
         DC    XL28'0'       *DCB FIELDS                                45440002
         DC    X'0'          *BLOCK & TRACK                             45480002
         DC    X'0'          *VOL SER COUNT                             45520002
ICFPRVOL DC    CL30' '       *VOL SERS                                  45560002
         DC    XL4'0'        *VOL INFO                                  45600002
         DC    XL3'0'        *PRIMARY DA QUANT.                         45640002
         DC    X'0'          *DA QUANT.                                 45680002
         DC    XL3'0'        *2NDARY DA QUANT.                          45720002
         DC    X'0'          *INDICATOR EXTENT                          45760002
         DC    XL3'0'        *DIRECTORY QUANT.                          45800002
         DC    XL3'0'        *SPLIT JFCB                                45840002
         DC    XL2'0'        *TTR 1ST ALLOC                             45880002
         DC    XL3'0'        *JFCB SUB ALLOC                            45920002
         DC    XL3'0'        *AV REC LENGTH                             45960002
         DC    X'1'          *VOL COUNT                                 46000002
         DC    X'0'          *SPLIT                                     46040002
         EJECT                                                          46080002
         SPACE 3                                                        46120002
*        DATA CONTROL BLOCK                                             46160002
         SPACE                                                          46200002
ICFDCB   DCB  DSORG=PS,DEVD=DA,MACRF=(E),IOBAD=ICFIOB,DDNAME=DDWARNX    46240002
         EJECT                                                          46280002
         SPACE 3                                                        46320002
*        IOB, ECB AND CCWS                                              46360002
         SPACE                                                          46400002
         DS    0D            *FOR ALIGNMENT                             46440002
ICFIOB   DS    0CL40                                                    46480002
         DC    X'42'         *+00 COMM CHAIN & UNRELATED                46520002
         DC    XL4'0'        *+01                                       46560002
         DC    AL3(ICFECB)   *+05 ECB ADDRESS                           46600002
         DC    XL9'0'        *+08                                       46640002
         DC    AL3(ICFCCWS)  *+17 CCW CHAIN ADDR                        46680002
         DC    X'0'          *+20                                       46720002
         DC    AL3(ICFDCB)   *+21 DCB ADDRESS                           46760002
         DC    XL8'0'        *+24                                       46800002
         DC    X'0'          *+32                                       46840002
         DC    XL7'1'        *+33 SEEK/SEARCH ADDR. WITH RR=01          46880002
         SPACE 5                                                        46920002
ICFECB   DC    F'0'          *ECB FOR EXCP                              46960002
         SPACE 5                                                        47000002
ICFCCWS  DS    0D                                                       47040002
         DC    X'1B',AL3(ICFIOB+D33),X'6000',XL2'6'   *SEEK CCW         47080002
         DC    X'31',AL3(ICFIOB+D35),X'6000',XL2'5'   *SEARCH CCW       47120002
         DC    X'08',AL3(ICFCCWS+D8),X'6000',XL2'1'   *TIC CCW          47160002
         DC    X'06',AL3(0),XL2'0',H'512'             *RD/WR CCW        47200002
         SPACE 5                                                        47240002
ICFRDCMD DC    XL4'06000000' *READ COMMAND                              47280002
ICFWRCMD DC    XL4'1D000000' *WRITE CKD COMMAND                         47320002
ICFWDCMD DC    XL4'05000000' *WRITE DATA COMMAND                        47360002
         EJECT                                                          47400002
         SPACE 3                                                        47440002
*        MISCELLANEOUS CONSTANTS AND FIELDS                             47480002
         SPACE                                                          47520002
         DS    0D            *ALIGN TO DOUBLEWORD                       47560002
ICFRBPTR DC    X'80'                                                    47600002
         DC    AL3(ICFRBLNG)                                            47640002
*                                                                       47680002
ICFRBLNG DC    X'14'         *RB LENGTH                                 47720002
ICFRBVRB DC    X'01'         *   VERB CODE                              47760002
ICFRBFL1 DC    X'2000'       *   FLAGS1 - S99NOMNT=1                    47800002
ICFRBERC DC    H'0'          *   ERROR CODE                             47840002
ICFRBINF DC    H'0'          *   INFO CODE                              47880002
ICFRBTXP DC    A(ICFTPTU1)   *   TEXT POINTERS                          47920002
ICFRBRSV DC    F'0'          *   RESERVED                               47960002
ICFRBFL2 DC    X'20000000'   *   FLAGS2 -S99NORES=1                     48000002
*                                                                       48040002
ICFTPTU1 DC    A(ICFTUDSN)   *TEXT POINTER 1                            48080002
ICFTPTU2 DC    A(ICFTUDSS)   *TEXT POINTER 2                            48120002
ICFTPTU3 DC    X'80'         *TEXT POINTER 3                            48160002
         DC    AL3(ICFTUDDN) *DITTO                                     48200002
*                                                                       48240002
ICFTUDSN DC    XL2'2'        *TEXT UNIT 1 - DATASET NAME                48280002
         DC    XL2'1'        *                                          48320002
         DC    XL2'A'        *                                          48360002
         DC    C'SYS1.WARNX'                                            48400002
ICFTUDSS DC    XL2'4'        *TEXT UNIT 2 - DATASET STATUS              48440002
         DC    XL2'1'        *                                          48480002
         DC    XL2'1'        *                                          48520002
         DC    X'01'         *                                          48560002
         DS    0F                                                       48600002
ICFTUDDN DC    XL2'1'        *TEXT UNIT 3 - DDNAME                      48640002
         DC    XL2'1'        *                                          48680002
         DC    XL2'7'        *                                          48720002
         DC    C'DDWARNX'    *                                          48760002
         DS    0D                                                       48800002
ICFDDWA  DC    CL8'DDWARNA'  *                                          48840002
ICFDDWB  DC    CL8'DDWARNB'  *                                          48880002
ICFDEBCH DC    XL6'0'        *                                          48920002
ICFDEBTS DC    XL2'0'        *                                          48960002
CF8      DC    F'8'          *                                          49000002
CF1      DC    F'1'          *                                          49040002
CF2      DC    F'2'          *                                          49080002
CF3      DC    F'3'          *                                          49120002
CF4      DC    F'4'          *                                          49160002
CF65536  DC    F'65536'      *                                          49200002
CF32     DC    F'32'         *                                          49240002
CF256    DC    F'256'        *                                          49280002
CF1000   DC    F'1000'       *                                          49320002
CTOD24HR DC    F'86400'      *APRROX. 24 HRS IN TOD SECS                49360002
ICFEMTD  DC    F'10'          *ENGINEERING MINIMUM TIME PARAM. 10 MSEC  49400002
CF6      DC    F'6'          *                                          49440002
CFF9     DC    X'000000F9'   *                                          49480002
CF39     DC    X'00000039'   *                                          49520002
CH1      DC    H'1'          *                                          49560002
CH520    DC    H'520'        *                                          49600002
CH512    DC    H'512'        *                                          49640002
ICFUNPK  DC    XL4'0'        *                                          49680002
ICFMVO   DC    XL3'F'        *                                          49720002
CCWARN   DC    C'SYS1.WARN'  *                                          49760002
CCCNTL   DC    C'CNTL'       *                                          49800002
ICFTIFRC DC    F'0'          *RETURN CODE FIELD                         49840002
ICFPDSIN DC    CL8'DDWARNX'  *FOR DEVTYPE MACRO                         49880002
ICFPREV  DC    CL6' '        *VOLSER SAVE FIELD                         49920002
CCEN     DC    C'EN'         *                                          49960002
CCGO     DC    C'GO  '       *                                 @ZA00521 50000000
CCSTOP   DC    C'STOP'       *                                 @ZA00521 50010000
C4BLK    DC    CL4' '        *                                          50040002
CCFORM   DC    C'FORM'       *                                          50080002
CCREST   DC    C'REST'       *                                          50120002
ICFBRFEP DC    A(ICFBRE00)   *RESTORE E.P.A.                            50160002
ICFTIUEP DC    A(ICFBIE50)   *USER EXIT ROUTINE ENTRY POINT             50200002
         SPACE 3                                                        50240002
ICFWDSN  CAMLST SEARCH,ICFDSN,ICFPREV,ICFWKA                            50280002
         SPACE 3                                                        50320002
ICFWVOL  CAMLST NAME,ICFDSN,,ICFWKA                                     50360002
         SPACE 3                                                        50400002
ICFDSN   DS    CL44          *DSNAME FOR LOCATE                         50440002
         DS    F             *                                          50480002
         DS    0D            *                                          50520002
ICFWKA   DS    0CL265        *WORK AREA FOR LOCATE MACRO                50560002
ICFNVOL  DS    CL2           *DITTO                                     50600002
ICFDEVCD DS    CL4           *DITTO                                     50640002
ICFVOLS  DS    CL6           *DITTO                                     50680002
ICFSEQN  DS    CL2           *DITTO                                     50720002
ICFOTVOL DS    19CL12        *DITTO                                     50760002
ICFZERS1 DS    CL10          *DITTO                                     50800002
ICFTTR1  DS    CL3           *DITTO                                     50840002
ICFZER2  DS    CL1           *DITTO                                     50880002
ICFTTR2  DS    CL3           *DITTO                                     50920002
ICFBLKVL DS    CL6           *DITTO                                     50960002
         EJECT                                                          51000002
         SPACE 3                                                        51040002
*        MESSAGES AND RELATED COSTANTS AND FIELDS                       51080002
         SPACE                                                          51120002
ICFANSW  DC    CL4'STOP'     *FIELD FOR OPERATOR REPLY                  51160002
ICFREPLY DC    F'0'          *ECB FOR WTOR                              51200002
ICFREPAD DC    A(ICFREPLY)   *ITS ADDRESS                               51240002
ICFANSAD DC    AL3(ICFANSW)  *REPLY FLD ADDRESS                         51280002
ICFINPMS DC    CL43'11 WARN TIME PARAMETER IS ZERO'                     51320002
ICFCTDMS DC    CL43'12 WARN TIME PARAMETER IS ONE'                      51360002
ICFNCVMS DC    CL43'13 LOCATE/OBTAIN FAILED FOR SYS1.WARNX'             51400002
ICFMVMSG DC    CL43'14 SYS1.WARNX RESIDES ON MORE THAN 1 VOLUME'        51440002
ICFSVMSG DC    CL43'15 BOTH SYS1.WARN DATASETS ON SAME VOLUME'          51480002
ICFNOMSG DC    CL43'16 VOLUME XXXXXX FOR SYS1.WARNX NOT MOUNTED'        51520002
ICFNPMSG DC    CL43'17 VOLUME XXXXXX ON UNPOWERED DEVICE'               51560002
ICFDDTMS DC    CL43'18 WARN DATASETS ON DIFFERENT DEVICE TYPES'         51600002
ICFNOPMS DC    CL43'19 COULD NOT OPEN SYS1.WARNX'                       51640002
ICFSEMSG DC    CL43'20 SYS1.WARNX TOO SMALL FOR STORAGE SIZE'           51680002
ICFPNAMS DC    CL43'22 PATH NOT AVAILABLE FOR WARN DATASET'             51720002
ICFNSDMS DC    CL43'23 SYS1.WARNX RESIDES ON UNSUPPORTED DEVICE'        51760002
ICFREMSG DC    CL43'31 I/O ERROR READING SYS1.WARNX'                    51800002
ICFWEMSG DC    CL43'32 I/O ERROR WRITING SYS1.WARNX'                    51840002
         SPACE 5                                                        51880002
ICFWTOR  WTOR  'ICFTIMXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - REPC51920002
               LY STOP OR GO',,4,ROUTCDE=(1,2,10),DESC=2,MF=L           51960002
ICFVDMSG WTOR  'ICFTIM21 VALID DUMP IN SYS1.WARNX - REPLY FORM OR REST'C52000002
               ,,4,ROUTCDE=(1,2,10),DESC=2,MF=L                         52040002
ICFCTDM  WTO   'ICFTIM51 WARN WILL DUMP AT FIRST WARNING',             C52080002
               ROUTCDE=(1),DESC=2,MF=L                                  52120002
ICFQUITM WTO   'ICFTIM99 POWER WARNING FEATURE  - FUNCTION INOPERATIVE'C52160002
               ,ROUTCDE=(1,10),DESC=2,MF=L                              52200002
ICFEXTMS WTO   'ICFTIM58 XXXXXX CCCC - YYYYYY CCCC',                   C52240002
               ROUTCDE=(1),DESC=2,MF=L                                  52280002
ICFICMSG WTO   'ICFTIM59 POWER WARNING FEATURE - INITIALIZATION COMPLETC52320002
               E',ROUTCDE=(2),DESC=4,MF=L                               52360002
ICFUNEMS WTO   'ICFTIM90 POWER WARNING FEATURE - UNEXPECTED ERROR',DESCC52400002
               =2,ROUTCDE=(1),MF=L                                      52440002
ICFWHMSG WTO   'ICFTIM91 WARNING DETECTED BEFORE PWF INITIALIZATION',DEC52480002
               SC=2,ROUTCDE=(1),MF=L                                    52520002
         SPACE 3                                                        52560002
ICFPATCH DC    25CL4'DDDD'   *PATCH AREA                                52600002
         EJECT                                                          52640002
ICFTIFDS DSECT                                                          52680002
ICFSAVEA DS    18F           *SAVE AREA                                 52720002
ICFIOSGS DS    F             *FOR IOSGEN SAVING MECHANISM               52760002
ICFSV35  DS    3F            *SAVE AREA FOR REGS 3 TO 5                 52800002
ICFSV8   DS    F             *SAVE AREA FOR REG 8                       52840002
ICFSV5   DS    F             *SAVE AREA FOR REG 5                       52880002
ICFCCW1  DS    D             *WORK AREA FOR SEEK CCW                    52920002
ICFCCW2  DS    D             *WORK AREA FOR SEARCH CCW                  52960002
ICFCCW3  DS    D             *WORK AREA FOR TIC CCW                     53000002
ICFCCW4  DS    D             *WORK AREA FOR WRITE CCW                   53040002
ICFCHR   DS    D             *                                          53080002
ICFRMBUF DS    F             *SAVE FORMAT BUFFER POINTER                53120002
ICFDVTYP DS    5F            *WORK AREA FOR DEVTYPE MACRO               53160002
ICFDVPRE DS    F             *SAVE DEVICE TYPE                          53200002
ICFWH1   DS    H             *WORK HALFWORD 1                           53240002
ICFWH2   DS    H             *WORK HALFWORD 2                           53280002
ICFLRBUF DS    7D            *LOGREC BUFFER                             53320002
ICFUSPRM DS    F             *PARAMETER LIST FOR USER                   53360002
ICFTIOTS DS    F             *SAVE AREA FOR OUR TIOT POINTER            53400002
ICFTCBSV DS    F             *SAVE AREA FOR OUR TCB POINTER             53440002
ICFJSCBS DS    F             *SAVE AREA FOR OUR JSCBTCBP POINTER        53480002
ICFJSTCS DS    F             *SAVE AREA FOR OUR JSCBTCBP FIELD          53520002
ICFESTPR DS    3F            *PARAMETER AREA FOR ESTAE                  53560002
ICFPRMLS DS    4F            *PARAMETER LIST FOR OPEN                   53600002
ICFDSEND EQU   *             *END OF WORK AREA                          53640002
         EJECT                                                          53680002
         CVT   DSECT=YES                                                53720002
         EJECT                                                          53760002
         ICFWORK                                                        53800002
         EJECT                                                          53840002
UCBD     DSECT                                                          53880002
         IEFUCBOB                                                       53920002
         EJECT                                                          53960002
         IKJTCB                                                         54000002
         EJECT                                                          54040002
         PRINT ON,NOGEN                                                 54080002
         DCBD  DSORG=(PS)                                               54120002
         PRINT ON,GEN                                                   54160002
         EJECT                                                          54200002
TIOTDSEC DSECT                                                          54240002
         IEFTIOT1                                                       54280002
         EJECT                                                          54320002
         IEZJSCB                                                        54360002
         EJECT                                                          54400002
         IEZDEB                                                         54440002
         EJECT                                                          54480002
         IECDLCH                                                        54520002
         EJECT                                                          54560002
         IHAPSA                                                         54600002
         EJECT                                                          54640002
         IHASDWA                                                        54680002
         EJECT                                                          54720002
         IECDCAT                                                        54760002
         EJECT                                                          54800002
         IHAPCCA                                                        54840002
         EJECT                                                          54880002
         IHACSD                                                         54920002
         EJECT                                                          54960002
ICFBIE00 CSECT                                                          55000002
         SPACE 5                                                        55040002
ICFDSSIZ EQU   ICFDSEND-ICFSAVEA                                        55080002
ICFMSWRD EQU   ICFWTOR+D18                                              55120002
         DROP  R10                                                      55160002
         DROP  R11                                                      55200002
         DROP  R12                                                      55240002
         DROP  R13                                                      55280002
         TITLE 'POWER WARNING FEATURE - RESTORE ROUTINE'                55320002
*********************************************************************** 55360002
*********************************************************************** 55400002
*                                                                     * 55440002
*                                                                     * 55480002
*  THIS ROUTINE RESTORES STORAGE FROM DISK PREVIOUSLY DUMPED BY       * 55520002
*        ICFBDF00--DUMP ROUTINE                                       * 55560002
*                                                                     * 55600002
*  TERMINATIONS--PSW WAIT, IC=26 SUCCESSFUL RESTORE                   * 55640002
*                PSW WAIT, IC=27 ALL OR PART NOT RESTORED             * 55680002
*                                                                     * 55720002
*  LINKAGE--REGISTER 15, ENTRY AND BASE REG                           * 55760002
*           REGISTER 10, TABLE POINTER-COMMUNICATION AREA             * 55800002
*           REGISTER  9, CCCCHHHH CONTROL TRACK                       * 55840002
*                                                                     * 55880002
*           REGISTER 14--POINTS TO A FOOTPRINT TABLE(1 WORD),         * 55920002
*                        FOLLOWED BY A RECORD OF TRACKS AND           * 55960002
*                        STORAGE THAT FAILED TO RESTORE               * 56000002
*          TRACK RECORDS-(3 WORDS EACH TRACK)                         * 56040002
*                WORD 1.-CCCCHHHH FAILING TRACK                       * 56080002
*                     2.-00AAAAAA BEGINNING ADR                       * 56120002
*                     3.-00AAAAAA ENDING ADR                          * 56160002
*                                                                     * 56200002
*          SENSE INFORMATION FROM LAST UNIT CHECK MAY BE              * 56240002
*          FOUND 24 BYTES PRECEDING FOOTPRINT TABLE                   * 56280002
*                                                                     * 56320002
*********************************************************************** 56360002
         EJECT                                                          56400002
*********************************************************************** 56440002
*                                                                     * 56480002
*  FOOTPRINT TABLE-(ADR IN REG 14)-(1 WORD, BIT ON CONDITION)         * 56520002
*                                                                     * 56560002
*                HISTORICAL                                           * 56600002
*                 BIT 0.-RESTORE STARTED                              * 56640002
*                     1.-MOVED TO HEX 1000                            * 56680002
*                     2.-INITIALIZATION COMPLETE-START SP RESTORE     * 56720002
*                     3.-SP KEYS RESTORED-START DATA RESTORE          * 56760002
*                      X                                              * 56800002
*                     4.-DATA(LESS FIRST TRACK) RESTORED-MOVE PROGRAM * 56840002
*                     5.-PROGRAM MOVED TO DUMP WORK AREA              * 56880002
*                     6.-RE-INITIALIZATION COMPLETE-START FIRST TRK   * 56920002
*                     7.-FIRST TRK RESTORE COMPLETE-RESTORE COMPLETE  * 56960002
*                 SUB-HISTORY                                         * 57000002
*                 BIT 8.-1 OR BOTH SP TRKS READ                       * 57040002
*                     9.-1 OR MORE DATA TRKS RESTORED                 * 57080002
*                    1O.-1 OR MORE CYLS RESTORED                      * 57120002
*                    11.-1 OR MORE STORAGE BLOCKS RESTORED            * 57160002
*                      X                                              * 57200002
*                    12.-SP END FLAGGED BY LAST STORAGE BLOCK         * 57240002
*                    13.-SP END FLAGGED BY LAST SP KEY                * 57280002
*                    14.-DATA END FLAGGED BY LAST STORAGE BLOCK       * 57320002
*                    15.-DATA END FLAGGED BY LAST CYL FLAG            * 57360002
*                 CURRENT                                             * 57400002
*                BIT 16.-IN I/O ROUTINE                               * 57440002
*                    17.-GOING TO TIO                                 * 57480002
*                    18.-UNIT CHECK-DOING SENSE                       * 57520002
*                    19.-IN CORRECTABLE ERROR ROUTINE                 * 57560002
*                      X                                              * 57600002
*                    20.-IN TRACK RETRY                               * 57640002
*                    21.-IN CHANNEL ERROR HANDLER                     * 57680002
*                 ERROR RECORD                                        * 57720002
*                BIT 22.-1 OR MORE CORRECTABLE ERRORS OCCURRED        * 57760002
*                    23.-1 OR MORE TRACKS RETRIED                     * 57800002
*                      X                                              * 57840002
*                    24.-1 OR MORE TRACKS FAILED TO RESTORE           * 57880002
*                    25.-FIRST TRACK NOT RESTORED                     * 57920002
*                    26.-SP KEYS NOT RESTORED                         * 57960002
*                    27.-1 OR MORE CHANNEL ERRORS                     * 58000002
*                 TERMINATIONS                                        * 58040002
*                BIT 28.-UNIT CHECK ON SENSE                          * 58080002
*                    29.-10 TRACKS UNRESTORABLE                       * 58120002
*                    30.-10 CHANNEL ERRORS                            * 58160002
*                    31.-DEVICE NOT OPERATIVE                         * 58200002
*                                                                     * 58240002
*********************************************************************** 58280002
         EJECT                                                          58320002
         SPACE 3                                                        58360002
* * * EQUATES * * *                                                     58400002
RZ       EQU   0                                                        58440002
RTAB     EQU   10                                                       58480002
RCH      EQU   9                                                        58520002
RCW      EQU   12                                                       58560002
RBL      EQU   13                                                       58600002
RM       EQU   8                                                        58640002
Q0       EQU   0                                                        58680002
Q1       EQU   1                                                        58720002
Q2       EQU   2                                                        58760002
Q3       EQU   3                                                        58800002
Q4       EQU   4                                                        58840002
Q5       EQU   5                                                        58880002
Q6       EQU   6                                                        58920002
Q8       EQU   8                                                        58960002
Q12      EQU   12                                                       59000002
Q14      EQU   14                                                       59040002
Q16      EQU   16                                                       59080002
QX12     EQU   X'12'                                                    59120002
Q24      EQU   24                                                       59160002
Q20      EQU   X'20'                                                    59200002
Q40      EQU   X'40'                                                    59240002
Q42      EQU   X'42'                                                    59280002
Q80      EQU   X'80'                                                    59320002
Q128     EQU   128                                                      59360002
Q136     EQU   136                                                      59400002
Q3F      EQU   X'3F'                                                    59440002
QC0      EQU   X'C0'                                                    59480002
QEE      EQU   X'EE'                                                    59520002
QFF      EQU   255                                                      59560002
M7       EQU   7                                                        59600002
ICFPGNEW EQU   104                                                      59640002
ICFCAW   EQU   72                                                       59680002
ICFCSW   EQU   64                                                       59720002
ICFMCH   EQU   112                                                      59760002
ICFMCHA  EQU   116                                                      59800002
ICFION   EQU   120                                                      59840002
BUSY     EQU   2                                                        59880002
STAT     EQU   4                                                        59920002
NOTOP    EQU   1                                                        59960002
         EJECT                                                          60000002
         SPACE 3                                                        60040002
* * * RELOCATION AND INITIALIZATION * * *                               60080002
         SPACE 1                                                        60120002
ICFBRE00 DS    0D             ****ENTRY****                             60160002
         USING ICFBRE00,R15                                             60200002
         USING ICFWORKA,RTAB                                            60240002
ICFFIRST EQU   *                                                        60280002
         B     ICFIDER                                                  60320002
         DC    C'RESTORE PROGRAM ' IDENTIFY PROGRAM FOR DUMPS           60360002
ICFIDER  EQU   *                                                        60400002
         LA    R14,ICFFOOT        FOOTPRINT ADR                         60440002
         XC    ICFFOOT,ICFFOOT    CLEAR FOOTPRINT                       60480002
***FOOTPRINT--BIT 0--RESTORE STARTED***                                 60520002
         OI    Q0(R14),Q80                                              60560002
         MVC   ICFPGNEW(Q16),ICFBUM SET PROG, MCH PSWS                  60600002
         L     R2,ICFX1000         SET MOVE TO ADDRESS                  60640002
         L     R3,ICFX800          MOVE 2048 BYTES                      60680002
         LR    R4,R15              FROM ADDRESS                         60720002
         L     R5,ICFPCT          COUNT OF PROGRAM                      60760002
         MVCL  R2,R4              MOVE FROM PRESENT ADR TO HEX 1000     60800002
         L     R15,ICFX1000       SHIFT AND RUN AT 1000                 60840002
         B     *+4                                                      60880002
         LA    R14,ICFFOOT        FOOTPRINT ADR                         60920002
***FOOTPRINT--BIT 1--MOVED TO X1000***                                  60960002
         OI    Q0(R14),Q40                                              61000002
         MVC   ICFCYFL(Q128),ICFCTCF   CONTROL INFO                     61040002
         MVC   ICFBPT(Q136),ICFCTTS MORE INFO                           61080002
         MVC   ICFTRPC(Q4),ICFCTTPC                                     61120002
         MVC   ICFPX(Q4),ICFCTPXR                                       61160002
         MVC   ICFSIOA+2(Q2),ICFCTRDA+2 DEVICE ADR                      61200002
         MVC   ICFTIOA+2(Q2),ICFCTRDA+2                                 61240002
         CLI   ICFTIOA+2,Q6       SET MASK TO ENABLE RESTORE CHANNEL    61280002
         BNL   ICFHI              CH6 OR HIGHER                         61320002
         MVC   ICFMCH(Q1),ICFTIOA+2                                     61360002
         TR    ICFMCH(Q1),ICFMASK  TRANSLATE CHANNEL TO MASK            61400002
         EJECT                                                          61440002
         SPACE 3                                                        61480002
ICFHI    EQU   *                                                        61520002
         LA    RM,ICFCCH          CCHH ADR                              61560002
         STCM  RM,M7,ICFSEEK+1    SET IN SEEK CCW                       61600002
         LA    RM,Q2(RM)          BUMP BY 2                             61640002
         STCM  RM,M7,ICFSERCH+1   SET IN SEARCH CCW                     61680002
         LA    RM,ICFSERCH        ADR OF SERCH CCW                      61720002
         STCM  RM,M7,ICFTIC+1     SET IN TIC CCW                        61760002
         LA    RM,ICFCCHX         DUMMY CCHH ADR                        61800002
         STCM  RM,M7,ICFSEEKX+1   DUMMY SEEK CCW                        61840002
         MVC   ICFREAD+6(Q2),ICFBPT+2 SET CCW COUNT                     61880002
         MVC   ICFREAD+2(Q2),ICFBPT+2 SET CCW ADR                       61920002
         LA    RM,ICFSDAT         SENSE FIELD                           61960002
         STCM  RM,M7,ICFSENSE+1   SET IN SENSE CCW                      62000002
         ST    RCH,ICFCCHA        CCCCHHHH OF CNTL TRACK                62040002
         LA    RM,ICFEINT         SET PSWS                              62080002
         ST    RM,ICFMCHA         ENABLE PSW                            62120002
         MVC   ICFION(Q8),ICFMCH  I/O NEW                               62160002
         MVC   ICFPSAVE(Q24),ICFPGNEW    *SAVE PSWS                     62200002
         LA    RM,ICFDINT                                               62240002
         ST    RM,ICFDPSW+4       DISABLE PSW                           62280002
         SPACE 1                                                        62320002
* * * RESTORE SP KEYS * * *                                             62360002
         SPACE 1                                                        62400002
***FOOTPRINT BIT 2-INITIALIZATION COMPLETE-START SP RESTORE***          62440002
         OI    Q0(R14),Q20                                              62480002
ICFSPMOR EQU   *                                                        62520002
         L     RCH,ICFCCHA        CCCCHHHH OF SP TRACK                  62560002
         LA    RCH,Q1(RCH)        UP TRACK BY 1 FOR SP KEYS             62600002
         ST    RCH,ICFCCHA        SET IN CCHH                           62640002
         BAL   RBL,ICFSIO         GO READ SP KEYS                       62680002
         B     ICFSPOK            NO ERROR                              62720002
         BAL   RBL,ICFERR         ERROR                                 62760002
***FOOTPRINT BIT 26-SP KEYS NOT RESTORED***                             62800002
         OI    Q3(R14),Q20                                              62840002
         NI    Q2(R14),Q3                                               62880002
         XC    ICFRTCT,ICFRTCT CLEAAR RETRY CTR                         62920002
         XC    Q4(Q8,RCW),Q4(RCW) NO ADR FOR SP TRACK RECORDS           62960002
         MVC   ICFGOOD(Q8),ICFBUM SET WAIT CODE TO PARTIAL              63000002
         B     ICFSPNG                                                  63040002
         EJECT                                                          63080002
         SPACE 3                                                        63120002
ICFSPOK  EQU   *                                                        63160002
***FOOTPRINT BIT 8-1 OR MORE SP TRACKS READ***                          63200002
         OI    Q1(R14),Q80                                              63240002
         NI    Q2(R14),Q3                                               63280002
         XC    ICFRTCT,ICFRTCT    CLEAR RETRY CTR                       63320002
         L     R1,ICFBPT          ADR FIRST SP KEY                      63360002
         LA    R2,Q1              INCREMENTER                           63400002
         L     R3,ICF4095         MAX SP ON ONE TRACK                   63440002
         AR    R3,R1              SET COMPARAND                         63480002
         TS    ICFKFLAG           FIRST TIME                            63520002
         BM    ICFSPSET           NO-CK KEY                             63560002
         LA    RM,ICFCONF         GET CONFIGURATION MAP ADR             63600002
         SR    R1,R2              ADJUST R1 FOR BXH                     63640002
ICFCFIN  EQU   *                                                        63680002
         TM    Q0(RM),QFF         USED?                                 63720002
         BO    ICFSPEN1           LAST OF SP                            63760002
         L     R5,Q0(RM)          STARTING STOR ADR                     63800002
         L     R6,ICFX800         INCREMENT                             63840002
         L     R7,Q8(RM)          ENDING STOR ADR                       63880002
         LA    RM,Q16(RM)         TRY NEXT                              63920002
         BXH   R1,R2,ICFSPMOR                                           63960002
ICFSPSET EQU   *                                                        64000002
         TM    Q0(R1),QFF         LAST KEY                              64040002
         BO    ICFSPEN2           YES                                   64080002
         IC    RZ,Q0(R1)          GET KEY                               64120002
         SSK   RZ,R5              SET                                   64160002
         BXH   R5,R6,ICFCFIN      NEXT STORAGE BLOCK                    64200002
         BXLE  R1,R2,ICFSPSET     NEXT KEY                              64240002
         B     ICFSPMOR           GET MORE SP KEYS                      64280002
***FOOTPRINT BIT 12-SP END FLAGGED BY LAST STORAGE BLOCK***             64320002
ICFSPEN1 EQU   *                                                        64360002
         OI    Q1(R14),Q8                                               64400002
         B     ICFSPEN                                                  64440002
***FOOTPRINT BIT 13-SP END FLAGGED BY LAST SP KEY***                    64480002
ICFSPEN2 EQU   *                                                        64520002
         OI    Q1(R14),Q4                                               64560002
         B     ICFSPEN                                                  64600002
         EJECT                                                          64640002
         SPACE 3                                                        64680002
* * * THIS SECTION RESTORES ALL BUT FIRST TRACK * * *                   64720002
ICFSPEN  EQU   *                                                        64760002
***FOOTPRINT BIT 3-SP KEYS RESTORED-START DATA RESTORE***               64800002
        OI    Q0(R14),Q16                                               64840002
        SPACE 1                                                         64880002
*R1 STORAGE ADDRESS                                                     64920002
*R2 INCREMENT BY TRACK SIZE                                             64960002
*R3 END OF STORAGE BLOCK                                                65000002
*R4 CYL FLAG ADDRESS                                                    65040002
*R5 0000HHHH                                                            65080002
*R6 INCREMENT HEAD BY 1                                                 65120002
*R7 NO. TRACKS PER CYL                                                  65160002
*RCH 0000CCCC                                                           65200002
*RM CONFIGURATION MAP ADDRESS                                           65240002
         SPACE 1                                                        65280002
ICFSPNG   EQU   *                                                       65320002
         LA    RM,ICFCONF         CONFIGURATION MAP                     65360002
         LA    R4,ICFCYFL         CYL FLAGS                             65400002
         LA    R6,Q1                                                    65440002
         L     R1,ICFBPT          SKIP FIRST TRACK                      65480002
         LR    R5,R6              **                                    65520002
         MVC   ICFCHSV(Q4),Q4(RM) SAVE FIRST TRACK ADDRESS              65560002
         TM    Q0(R4),Q3F         IS FIRST TRACK SPARE?                 65600002
         BNZ   ICFSR              NO                                    65640002
         STH   R5,ICFCHSV+2       UPDATE THIS                           65680002
         AR    R5,R6              SELECT NEXT TRACK                     65720002
ICFSR    EQU   *                                                        65760002
         STH   R5,Q6(RM)           POINT AT 2ND TRACK                   65800002
         ST    R1,Q0(RM)           ADR 0 + BYTES PER TRACK              65840002
ICFSR1   EQU   *      * NEW BLOCK *                                     65880002
         TM    Q0(RM),QFF         LAST BLOCK USED?                      65920002
         BO    ICFLT1             YES                                   65960002
         MVI   ICFBFLAG,Q0        CLEAR BLOCK FLAG                      66000002
         LH    R5,Q6(RM)          STARTING TRACK                        66040002
         L     R1,Q0(RM)          STARTING ADR                          66080002
         L     R3,Q8(RM)          ENDING ADR                            66120002
         ST    R3,ICFTOP          FOR ERR COR                           66160002
         LH    RCH,Q4(RM)         STARTING CYL                          66200002
         EJECT                                                          66240002
         SPACE 3                                                        66280002
ICFSR2   EQU   *      * NEW CYL *                                       66320002
         TM    Q0(R4),QC0         CYL USED?                             66360002
         BZ    ICFLT2             NO-END                                66400002
         L     R2,ICFBPT          BYTES PER TRACK                       66440002
         LH    R7,Q14(RM)         LAST TRACK TO BE USED                 66480002
         CH    RCH,Q12(RM)        IS THIS LAST CYL?                     66520002
         BE    ICFSR3             YES                                   66560002
         L     R7,ICFTRPC         TRACKS PER CYL                        66600002
         S     R7,ICF2            DOWN 2-ADJUST FOR BXLE                66640002
         TM    Q0(R4),Q80         BAD TRACK THIS CYL?                   66680002
         BZ    ICFSR3             NO                                    66720002
         LA    R7,Q1(R7)          YES-BUMP COUNT BY 1                   66760002
        SPACE 1                                                         66800002
ICFSR3   EQU   *                                                        66840002
         NI    Q0(R4),Q3F         CLEAR FLAG--GET SPARE TRACK           66880002
ICFSR4   EQU   *                                                        66920002
         STH   RCH,ICFCCHA        SET CCCC                              66960002
         STH   R5,ICFCCHA+2       SET TRACK TO READ                     67000002
         CLC   ICFCCHA+3(Q1),Q0(R4) IS THIS SPARE TRACK                 67040002
         BNE   ICFSR5             NO                                    67080002
         LA    R5,Q1(R5)          YES-GO TO NEXT TRACK                  67120002
         B     ICFSR4                                                   67160002
ICFSR5   EQU   *                                                        67200002
         STCM  R1,M7,ICFREAD+1    SET ADR IN CCW                        67240002
         BXH   R1,R2,ICFLST       UPDATE ADR                            67280002
ICFSR6   EQU   *                                                        67320002
         STH   R2,ICFREAD+6       SET COUNT IN CCW                      67360002
         BAL   RBL,ICFSIO        GO RAED A TRACK                        67400002
         B     ICFTROK           TRACK OK                               67440002
         MVC   ICFGOOD(Q8),ICFBUM SET PARTIAL RESTORE                   67480002
         B     ICFTROK1                                                 67520002
         EJECT                                                          67560002
         SPACE 3                                                        67600002
ICFTROK  EQU   *                                                        67640002
***FOOTPRINT BIT 9-1 OR MORE DATA TRACKS RESTORED***                    67680002
        OI    Q1(R14),Q40                                               67720002
ICFTROK1 EQU   *                                                        67760002
         XC    ICFRTCT,ICFRTCT    CLEAR RETRY CTR                       67800002
         NI    Q2(R14),Q3                                               67840002
         TM    ICFBFLAG,Q80        NEED NEW BLOCK?                      67880002
         BO    ICFSR1              YES                                  67920002
         BXLE  R5,R6,ICFSR4                                             67960002
         SR    R5,R5               START NEXT AT TRACK 0                68000002
         LA    R4,Q1(R4)           NEXT CYL FLAG                        68040002
         LA    RCH,Q1(RCH)         NEXT CYL                             68080002
***FOOTPRINT BIT 10-1 OR MORE CYLS RESTORED***                          68120002
         OI    Q1(R14),Q20                                              68160002
         B     ICFSR2                                                   68200002
ICFLST   EQU   *                                                        68240002
         SR    R1,R3              GET COUNT DIFFERENT                   68280002
         SR    R2,R1              SET IN R2                             68320002
         LA    RM,Q16(RM)         SET FOR NEW BLOCK                     68360002
         TS    ICFBFLAG                                                 68400002
***FOOTPRINT BIT 11-1 OR MORE STORAGE BLOCKS RESTORED***                68440002
         OI    Q1(R14),Q16                                              68480002
         B     ICFSR6                                                   68520002
***FOOTPRINT BIT 14-DAT END FLAGGED BY LAST STOR BLOCK***               68560002
ICFLT1   EQU   *                                                        68600002
         OI    Q1(R14),Q2                                               68640002
         B     ICFLT                                                    68680002
***FOOTPRINT BIT 15-DATA FLAGGED BY LAST CYL FLAG***                    68720002
ICFLT2   EQU   *                                                        68760002
         OI    Q1(R14),Q1                                               68800002
         EJECT                                                          68840002
ICFLT    EQU   *                                                        68880002
* * * THIS SECTION RESTORES FIRST TRACK--ADR 0 * * *                    68920002
***FOOTPRINT BIT 4-DATA(LESS FIRST TRACK) RESTORED***                   68960002
        OI    Q0(R14),Q8                                                69000002
         L     R2,ICFRADR          GET RAEDY TO MOVE                    69040002
         L     R3,ICFX800          2048 BYTES                           69080002
         LR    R4,R15              FROM PRESENT LOCATION                69120002
         LR    R5,R3               2048 BYTES                           69160002
         MVCL  R2,R4               MOVE                                 69200002
         L     R15,ICFRADR         SET BASE REG TO NEW LOCATION         69240002
         B     *+4                 CHANGE                               69280002
         LA    R14,ICFFOOT         KEEP FOOTPRINT HANDY                 69320002
***FOOTPRINT BIT 5-PROGRAM MOVED TO DUMP WORK AREA***                   69360002
         OI    Q0(R14),Q4                                               69400002
         LA    RM,ICFCCH           EXTENT ADR                           69440002
         STCM  RM,M7,ICFSEEK+1     SET IN SEEK CCW                      69480002
         LA    RM,Q2(RM)                                                69520002
         STCM  RM,M7,ICFSERCH+1    SET IN SEARCH CCW                    69560002
         LA    RM,ICFSERCH         ADR OF SEARCH                        69600002
         STCM  RM,M7,ICFTIC+1      SET IN TIC                           69640002
         LA    RM,ICFCCHX          DUMMY EXTENT                         69680002
         STCM  RM,M7,ICFSEEKX+1                                         69720002
         MVC   ICFREAD+6(Q2),ICFBPT+2 CCW COUNT                         69760002
         XC    ICFREAD+1(Q3),ICFREAD+1 READ TO ADR 0                    69800002
         LA    RM,ICFSDAT          SENSE                                69840002
         STCM  RM,M7,ICFSENSE+1                                         69880002
         MVC   ICFCCHA(Q4),ICFCHSV  EXTENT FIRST TRACK                  69920002
         LA    RM,ICFEINT         RE-INIT PSWS                          69960002
         ST    RM,ICFMCHA                                               70000002
         MVC   ICFION(Q8),ICFMCH                                        70040002
         LA    RM,ICFDINT                                               70080002
         ST    RM,ICFDPSW+4                                             70120002
         ICM   RCW,M7,ICFPX+1      CHECK FOR PREFIX                     70160002
         BZ    ICFNPX              NONE                                 70200002
         MVC   ICFPGNEW(Q24,RCW),ICFPGNEW MOVE PSWS IF PREFIXING        70240002
*        SPX   ICFPX               SET PREFIX                           70280002
         DC    X'B210',S(ICFPX) TEMP DC FOR ASM                         70320002
ICFNPX   EQU   *                                                        70360002
         MVC   ICFPSAVE(Q24),ICFPGNEW    *SAVE PSWS                     70400002
***FOOTPRINT BIT 6-RE-INITIALIZATION COMPLETE***                        70440002
         OI    Q0(R14),Q2                                               70480002
         BAL   RBL,ICFSIO           READ                                70520002
         B     ICFLTOK                                                  70560002
         BAL   RBL,ICFERR                                               70600002
***FOOTPRINT BIT 25-FIRST TRACK NOT RESTORED***                         70640002
         OI    Q3(R14),Q40                                              70680002
         LPSW  ICFBUM                                                   70720002
         EJECT                                                          70760002
ICFLTOK  EQU   *                                                        70800002
***FOOTPRINT BIT 7-FIRST TRACK RESTORE COMPLETE-RESTORE COMPLETE***     70840002
         OI    Q0(R14),Q1                                               70880002
         LPSW  ICFGOOD                                                  70920002
         SPACE 2                                                        70960002
* ERROR HANDLING *                                                      71000002
        SPACE 1                                                         71040002
ICFERR   EQU   *                                                        71080002
         TM    ICFSDAT,QC0        COMMAND REJECT OR INTERVENTION?       71120002
         BNZ   ICFBOMB1           YES-QUIT                              71160002
         TM    ICFSDAT,Q8          DATA ERROR?                          71200002
         BZ    ICFERND             NO-GO TO RETRY                       71240002
         TM    ICFSDAT+2,Q40       CORRECTABLE?                         71280002
         BO    ICFERC              YES-GO CORRECT                       71320002
ICFERND  EQU   *                                                        71360002
         ST    RBL,ICFRBLSV       SAVE LINK REG                         71400002
***FOOTPRINT BIT 20-IN TRACK RETRY***                                   71440002
***FOOTPRINT BIT 23-1 OR MORE TRACKS RETRIED***                         71480002
         OI    Q2(R14),Q8                                               71520002
         OI    Q2(R14),Q1                                               71560002
         LH    RCW,ICFRTCT         GET RETRY COUNT                      71600002
         LA    RCW,Q1(RCW)         ADD 1                                71640002
         STH   RCW,ICFRTCT         SAVE                                 71680002
         CH    RCW,ICFTEN          TEN RETRIES?                         71720002
         BH    ICFFAIL             YES-GIVE UP ON THIS TRACK            71760002
         L     RBL,ICFCCHA         PICK FAILING TRACK                   71800002
         C     RCW,ICF2           FIRST OR SECOND RETRY?                71840002
         BH    ICFSTAY            NEITHER                               71880002
         BE    ICFDOWN            SECOND                                71920002
         LA    RBL,Q1(RBL)        UP NEXT TRACK                         71960002
         B     ICFSTAY                                                  72000002
ICFDOWN  EQU   *                                                        72040002
         S     RBL,ICF1           DOWN 1 TRACK                          72080002
ICFSTAY  EQU   *                                                        72120002
         ST    RBL,ICFCCHXA       SET TRACK EXTENT                      72160002
         LA    RCW,ICFSEEKX       DO DUMMY SEEK                         72200002
         BAL   RBL,ICFSIO0                                              72240002
         NOP   *                  IGNORE ERRORS                         72280002
         L     RBL,ICFRBLSV                                             72320002
         S     RBL,ICF12                                                72360002
         BR    RBL                RETURN TO ORIGIN                      72400002
         EJECT                                                          72440002
ICFERC   EQU   *                                                        72480002
         TM    ICFSDAT+1,Q1        INCOMPLETE?                          72520002
         BO    ICFERND             YES-RETRY                            72560002
***FOOTPRINT BIT 19-IN CORRECTABLE ERROR ROUTINE***                     72600002
***FOOTPRINT BIT 22-1 OR MORE CORRECTABLE ERRORS OCCURRED***            72640002
         OI    Q2(R14),QX12                                             72680002
         ICM   RCW,M7,ICFSDAT+15   GET RESTART DISPLACEMENT             72720002
         LH    RZ,ICFSDAT+18       GET ERROR DISPLACEMENT               72760002
         SR    RCW,RZ              COMPUTE FORWARD DISPLACEMENT         72800002
         ICM   RZ,M7,ICFREAD+1     GET STARTING ADR                     72840002
         AR    RCW,RZ              ADR OF ERROR                         72880002
         L     RZ,ICFTOP           TOP OF STORAGE?                      72920002
         SR    RZ,RCW              GET DIFFERENCE                       72960002
         C     RZ,ICF3             LESS THAN 3?                         73000002
         BNL   ICFERC1             NO                                   73040002
         STC   RZ,ICFXOR+1         YES-CHANGE COUNT                     73080002
ICFERC1  EQU   *                                                        73120002
ICFXOR   XC    Q0(Q3,RCW),ICFSDAT+20 CORRECT ERROR                      73160002
         MVI   ICFXOR+1,Q2                                              73200002
         S     RBL,ICF8                                                 73240002
         BR    RBL                                                      73280002
         SPACE 1                                                        73320002
* * *MAPS UNRESTORABLE TRACKS* * *                                      73360002
         SPACE 1                                                        73400002
ICFFAIL  EQU   *                                                        73440002
***FOOTPRINT BIT 24-1 OR MORE TRACKS FAILED TO RESTORE***               73480002
         OI    Q3(R14),Q80                                              73520002
         LH    RCW,ICFTFCT        COUNT TRACK FAILURES                  73560002
         LA    RCW,Q1(RCW)        ADD  1                                73600002
         STH   RCW,ICFTFCT        SAVE                                  73640002
         CH    RCW,ICFTEN         TEN TRACKS FAILED?                    73680002
         BH    ICFBOMB4           YES-QUIT                              73720002
         LA    RCW,ICFLAST        FIND SPOT TO MAP                      73760002
ICFFAIL1 EQU   *                                                        73800002
         CLI   Q0(RCW),QEE        USED SPOT?                            73840002
         BE    ICFFAIL2           NO-USE IT                             73880002
         LA    RCW,Q12(RCW)       YES-LOOK AT NEXT                      73920002
         B     ICFFAIL1                                                 73960002
ICFFAIL2 EQU   *                                                        74000002
         MVC   Q0(Q4,RCW),ICFCCHA SAVE CCCCHHHH                         74040002
         MVI   Q4(RCW),Q0                                               74080002
         MVC   Q5(Q3,RCW),ICFREAD+1 SAVE STARTING ADR                   74120002
         L     RZ,Q4(RCW)                                               74160002
         A     RZ,ICFBPT         COMPUTE ENDING ADR                     74200002
         ST    RZ,Q8(RCW)                                               74240002
         BR    RBL               RETURN                                 74280002
ICFBOMB4 EQU   *                                                        74320002
***FOOTPRINT BIT 29-10 TRACKS FAILED TO RESTORE***                      74360002
         OI    Q3(R14),Q4                                               74400002
         LPSW  ICFBUM                                                   74440002
         EJECT                                                          74480002
* * *I/O SUB-ROUTINE* * *                                               74520002
        SPACE 1                                                         74560002
ICFSIO   EQU   *                                                        74600002
***FOOTPRINT BIT 16-CURRENT-IN I/O ROUTINE***                           74640002
         OI    Q2(R14),Q80                                              74680002
         ST    RBL,ICFRBLSV                                             74720002
         LA    RCW,ICFSEEK                                              74760002
         NI    ICFSFLAG,Q0                                              74800002
ICFSIO0  EQU   *                                                        74840002
         ST    RCW,ICFCAW                                               74880002
ICFSIOA  SIO   Q0                                                       74920002
         BC    BUSY,ICFSIOA       CC=2 BUSY                             74960002
         BC    STAT,ICFSTIO       CC=1 STATUS STORED                    75000002
         BC    NOTOP,ICFBOMB1     CC=3 NOT OPERATIONAL                  75040002
ICFTIO   EQU   *                                                        75080002
***FOOTPRINT BIT 17-GOING TO TIO***                                     75120002
         OI    Q2(R14),Q40                                              75160002
ICFTIOA  TIO   Q0                                                       75200002
         BC    BUSY,ICFTIOA                                             75240002
         BC    STAT,ICFSTIO                                             75280002
         BC    NOTOP,ICFBOMB1                                           75320002
         NI    Q2(R14),Q3F                                              75360002
         BR    RBL                                                      75400002
ICFBOMB1 EQU   *                                                        75440002
***FOOTPRINT BIT 31-DEVICE NOT OPERATIVE***                             75480002
         OI    Q3(R14),Q1                                               75520002
         LPSW  ICFBUM                                                   75560002
ICFBOMB8 EQU   *                                                        75600002
***FOOTPRINT BIT 28-UNIT CHECK ON SENSE***                              75640002
         OI    Q3(R14),Q8                                               75680002
         LPSW  ICFBUM                                                   75720002
ICFSTIO  EQU   *                                                        75760002
         NC    ICFCSW+4(Q2),ICFENMSK ANY ENDING STATUS?                 75800002
         BZ    ICFTIO             NO-LOOP UNTIL END                     75840002
         TM    ICFCSW,Q4          LOGOUT PENDING?                       75880002
         BO    ICFTRY             YES                                   75920002
         TM    ICFCSW+5,Q3F       CHANNEL ERRORS?                       75960002
         BNZ   ICFTRY             YES-GO CLEAR                          76000002
         TM    ICFCSW+4,Q42       UNIT CHECK-STATUS MODIFIER?           76040002
         BZ    ICFTIO             NO-CLEAR AND RETURN                   76080002
         TM    ICFCSW+4,Q40       STATUS MODIFIER?                      76120002
         BZ    ICFCK              NO-ASSUME UNIT CK                     76160002
         B     ICFLPSWE           GO ENABLE FOR I/O INTERRUPT           76200002
         EJECT                                                          76240002
         SPACE 3                                                        76280002
* * * UNIT CHECK * * *                                                  76320002
         SPACE 1                                                        76360002
ICFCK    EQU   *                                                        76400002
         TS    ICFSFLAG                                                 76440002
         BM    ICFBOMB8                                                 76480002
***FOOTPRINT BIT 18-UNIT CHECK, DOING SENSE***                          76520002
         OI    Q2(R14),Q20                                              76560002
         LA    RBL,Q4(RBL)                                              76600002
         LA    RCW,ICFSENSE                                             76640002
         XC    ICFSDAT,ICFSDAT    CLEAR SENSE FIELD                     76680002
         B     ICFSIO0                                                  76720002
         SPACE 1                                                        76760002
* * *THIS SECTION ENABLES CHANNELS TO CLEAR CHANNEL ERRORS* * *         76800002
***FOOTPRINT BIT 21-IN CHANNEL ERROR HANDLER***                         76840002
***FOOTPRINT BIT 27-1 OR MORE CHANNEL ERRORS***                         76880002
ICFTRY   EQU   *                                                        76920002
         OI    Q2(R14),Q4                                               76960002
         OI    Q3(R14),Q16                                              77000002
         LH    RCW,ICFCECT        GET ERROR COUNT                       77040002
         LA    RCW,Q1(RCW)        ADD 1                                 77080002
         STH   RCW,ICFCECT        SAVE                                  77120002
         CH    RCW,ICFTEN         TEN ERRORS?                           77160002
         BNL   ICFBOMB2           YES-QUIT                              77200002
ICFLPSWE EQU   *                                                        77240002
         MVC   ICFPGNEW(Q24),ICFPSAVE    *RESTORE PSWS                  77280002
         LPSW  ICFMCH            ENABLE                                 77320002
ICFEINT  EQU   *                                                        77360002
         BAL   RBL,ICFTIO        GO DO TIO AGAIN                        77400002
         LPSW  ICFDPSW           DISABLE                                77440002
ICFDINT  EQU   *                                                        77480002
         L     RBL,ICFRBLSV                                             77520002
         B     ICFSIO          GO TO SIO                                77560002
ICFBOMB2 EQU   *                                                        77600002
***FOOTPRINT BIT 30-10 CHANNEL ERRORS***                                77640002
         OI    Q3(R14),Q2                                               77680002
         LPSW  ICFBUM                                                   77720002
         EJECT                                                          77760002
* * * DOUBLE WORDS, CCW S, ETC. * * *                                   77800002
*     *=MUST BE CONTIGUOUS                                              77840002
ICFSEEK  CCW   7,0,X'60',6        *                                     77880002
ICFSERCH CCW   X'31',0,X'60',5    *                                     77920002
ICFTIC   CCW   8,0,X'60',0        *                                     77960002
ICFREAD  CCW   6,0,X'20',0        *                                     78000002
ICFSENSE CCW   4,0,X'20',24                                             78040002
ICFSEEKX CCW   7,0,X'60',6        *                                     78080002
ICFREADX CCW   6,0,X'30',1        *                                     78120002
ICFGOOD  DC    X'0002000000000026'                                      78160002
ICFBUM   DC    X'0002000000000027'                                      78200002
ICFEPSW  DC    X'0204000000000000'                                      78240002
ICFDPSW  DC    D'0'                                                     78280002
ICFPSAVE DC    3D'0'         *                                          78320002
         DC    H'0'               *SPACER                               78360002
ICFCCH   DC    H'0'               *                                     78400002
ICFCCHA  DC    C'CCHH'            *                                     78440002
         DC    X'0100'            *                                     78480002
ICFCCHX  DC    H'0'               *                                     78520002
ICFCCHXA DC    C'CCHH'            *                                     78560002
         DC    X'0100'            *                                     78600002
* * * FULL WORDS * * *                                                  78640002
         DS    0F                                                       78680002
ICFPCT   DC    X'EE'               PADDING CHARACTER MVCL               78720002
         DC    AL3(ICFLAST-ICFFIRST) COUNT OF PROG                      78760002
ICFX800  DC    F'2048'                                                  78800002
ICF4095  DC    F'4095'                                                  78840002
ICFX1000 DC    F'4096'                                                  78880002
ICFCHSV  DC    F'0'                                                     78920002
ICFRBLSV DC    F'0'                                                     78960002
ICF1     DC    F'1'                                                     79000002
ICF2    DC    F'2'                                                      79040002
ICF3    DC    F'3'                                                      79080002
ICF4    DC    F'4'                                                      79120002
ICF8    DC    F'8'                                                      79160002
ICF12   DC    F'12'                                                     79200002
ICFENMSK DC    X'463F0000'                                              79240002
ICFTOP   DC    F'0'                                                     79280002
         EJECT                                                          79320002
         SPACE 3                                                        79360002
* * * MISCELLANEOUS * * *                                               79400002
ICFFLAG  DC    F'0'                FLAGS                                79440002
ICFSFLAG EQU   ICFFLAG            UNIT CHECK                            79480002
ICFBFLAG EQU   ICFFLAG+1          STORAGE BLOCK                         79520002
ICF1FLAG EQU   ICFFLAG+2          FIRST TRACK                           79560002
ICFKFLAG EQU   ICFFLAG+3          STOR PROT                             79600002
ICFTEN   DC    H'10'                                                    79640002
ICFRTCT  DC    H'0'                                                     79680002
ICFCECT  DC    H'0'                                                     79720002
ICFTFCT  DC    H'0'                                                     79760002
ICFMASK  DC    X'8040201008040200'                                      79800002
ICFCYFL  DC    32F'0'             * CYL FLAGS                           79840002
ICFBPT   DC    F'0'               * BYTES PER TRACK                     79880002
ICFRADR  DC    F'0'               * OVERLAY ADDRESS                     79920002
ICFCONF  DC    32F'0'             * CONFIG MAP                          79960002
ICFTRPC  DC    F'0'               * TRKS PER CYL                        80000002
ICFPX    DC    F'0'                                                     80040002
ICFRSPTC DC    100X'EE'    *******PATCH AREA*******                     80080002
ICFSDAT  DC    XL24'0'            SENSE FIELD                           80120002
ICFFOOT  DC    F'0'                                                     80160002
ICFLAST  EQU   *                                                        80200002
         DS    30F                                                      80240002
         TITLE 'POWER WARNING FEATURE INITIALIZATION MODULE'            80280002
         DROP  R15                                                      80320002
         DROP  RTAB                                                     80360002
         USING ICFBIE00,R11,R12   *REESTABLISH MODULE ADDRESSABILITY    80400002
         USING ICFTIFDS,R13  *REESTABLISH ADDRESSABILITY TO WORK AREA   80440002
         USING ICFWORKA,R10  *REESTABLISH COMM.AREA ADDRESSABILITY      80480002
         SPACE 3                                                        80520002
ICFREST  EQU   *             *SET UP FOR RESTORE                        80560002
         LA    R5,ICFIOMAP   *PREPARE TO FIND AVAILABLE PATH            80600002
         LR    R8,R13        *SAVE POINTER TO OUR SAVE & WORK AREA      80640002
         LA    R13,D12(R13)  *ADJUST POINTER TO SAVE AREA FOR IOSGEN    80680002
         BAL   R14,ICFNDPTH  *GO FIND AVLBL PATH TO WARN DEVICE         80720002
         LR    R13,R8        *RESET POINTER TO OUR SAVE & WORK AREA     80760002
         XC    ICFCTRDA,ICFCTRDA  *CLEAN ICFCTRDA FIELD                 80800002
         LA    R7,ICFCTRDA   *PREPARE TO CHECK RESTORE PATH             80840002
         BAL   R8,ICFSDADD   *GO CHECK PATH FOR RESTORE                 80880002
         MVC   ICFSV8,ICFIOB+D35  *GET CCCCHHHH OF CNTL TRK             80920002
         L     R9,ICFSV8     *PUT IT IN R9 FOR RESTORE ROUTINE          80960002
*******************************************************************     81000002
         ESTAE 0    *CANCEL ESTAE  (LEAVING THE SYSTEM BEHIND)          81040002
*******************************************************************     81080002
         SPACE 3                                                        81120002
*   MAKE SURE THAT THE RESTORE ROUTINE IS ALL CONTAINED               * 81160002
*   WHITHIN A 4K PAGE. IF IT CROSSES A 4K PAGE BOUNDARY               * 81200000
*   RELOCATE IT WITHIN A PAGE OVERLAYING THE INITIAL                  * 81240002
*   PART OF ICFBIF00.                                                 * 81280002
         SPACE 1                                                        81320002
         LA    R4,ICFBRE00   *GET START OF RESTORE ROUTINE              81360002
         LR    R14,R4        *SAVE FOR LATER USE                        81400002
         LR    R15,R4         SAVE FOR LATER                   @ZA00760 81410000
         LA    R6,ICFBCODE   *GET END OF CODE TO BE RELOCATED           81440002
         LR    R7,R6         *SAVE IT FOR LATER USE                     81480002
         SRL   R4,D12         ALIGN TO 4K PAGE BOUNDARY        @ZA00760 81520000
         SRL   R6,D12         ALIGN TO 4K PAGE BOUNDARY        @ZA00760 81560000
         CR    R4,R6          DOES ROUTINE CROSS PAGE BOUNDARY @ZA00760 81600000
         BE    ICFNOREL      *NO, DON'T RELOCATE RESTORE ROUTINE        81640002
**********************************************************************  81680002
         OI    ICFTRMSA+D3,X80    *UPDATE FOOTPRINT TABLE***********    81720002
**********************************************************************  81760002
         LA    R4,ICFBIE00   *GET START OF MODULE                       81800002
         LA    R4,D4095(R4)   ALIGN TO NEXT 4K BOUNDARY        @ZA00760 81840000
         SRL   R4,D12                                          @ZA00760 81880000
         SLL   R4,D12                                          @ZA00760 81920000
         LR    R15,R4        *SET UP BASE REGISTER FOR RESTORE          81960002
         SR    R14,R15       *COMPUTE RELOCATION FACTOR                 82000002
         LA    R6,ICFBRE00   *GET START OF RESTORE ROUTINE              82040002
         SR    R7,R6         *GET LENGTH OF RESTORE ROUTINE             82080002
         LR    R5,R7         *IN BOTH LENGTH REGISTERS                  82120002
         MVCL  R4,R6         *RELOCATE RESTORE ROUTINE SO THAT          82160002
*                            *IT FITS WITHIN A 2K PAGE                  82200002
         SR    R11,R14       *ADJUST FIRST BASE REGISTER                82240002
         SR    R12,R14       *ADJUST SECOND BASE REGISTER               82280002
         B     ICFNOREL      *START EXECUTING RELOCATED CODE            82320002
ICFNOREL EQU   *                                                        82360002
         SPACE 3                                                        82400002
         LRA   R7,ICFMCIL    *GET REAL ADDR.OF STRG.CHK INNER LOOP      82440002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  82480002
         LRA   R15,D0(R15)   *RESTORE NEEDS REAL ADDRESS                82520002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  82560002
         LRA   R2,ICFCTB11   *GET REAL ADDR.OF 1ST STRG BLK FLD         82600002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  82640002
         LRA   R8,ICFMCOL    *GET REAL ADDR.OF OUTER LOOP               82680002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  82720002
         ST    R8,ICFBCPSW+D4     *SET REAL INST.ADDR.IN B.C. MODE PSW  82760002
         LA    R4,ICFBRE00   *COMPUTE DISPLACEMENT OF                   82800002
         SR    R4,R11        *RESTORE ROUTINE ENTRY POINT               82840002
         LRA   R3,ICFBRE00   *GET REAL ADDRESS OF RESTORE ROUTINE E.P.  82880002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  82920002
         SR    R3,R4         *NOW BACK UP TO MODULE ENTRY POINT         82960002
         ST    R3,ICFADR4    *SAVE REAL ADDRESS OF THIS MODULE'S E.P.   83000002
         LRA   R10,D0(R10)   *GET REAL ADDR.OF COMM. AREA               83040002
         BNZ   ICFLRAER      *IF ERROR GO SEND MESSAGE                  83080002
         USING PSA,R0        *ESTABLISH PSA ADDRESSABILITY              83120002
         MVC   ICFSVPIN,PINPSW  *SAVE PGM NEW PSW                       83160002
         LA    R3,ICFMCR     *GET POINTER TO OUR PGM INTR ROUT          83200002
         ST    R3,PINPSW+D4  *SET IT IN PGM NEW PSW                     83240002
         STOSM PINPSW,X00    *SET CURRENT SYSTEM MASK IN PGM NEW PSW    83280002
         NI    PINPSW,XFC     *DISABLE AGAINST I/O AND EXTERNALS        83320002
         STOSM ICFRSM+D1,X00 *SAVE CURRENT SYSTEM MASK FOR LATER USE    83360002
         LPSW  ICFBCPSW      *NOW SWITCH TO B.C. MODE                   83400002
ICFMCOL  EQU   *                                                        83440002
         L     R3,D0(R2)     *GET STRG ADR OF S.O.B.                    83480002
         LA    R4,D4         *SET INCREMENT FOR BXLE                    83520002
         L     R5,D8(R2)     *GET STRG ADR OF E.O.B.                    83560002
         BCTR  R5,D0         *DON'T GO                                  83600002
         BCTR  R5,D0         *OUT OF                                    83640002
         BCTR  R5,D0         *STORAGE BLOCK                             83680002
ICFMCIL  EQU   *                                                        83720002
         L     R6,D0(R3)     *ACCESS 1 WORD OF STRG - IF STRG IS NOT    83760002
*              ONLINE A PGM CHK INTERRUPT WILL OCCUR GIVING CONTROL TO  83800002
*              ICFMCR. OTHERWISE CONTROL WILL GO TO NEXT INSTRUCTION.   83840002
         BXLE  R3,R4,D0(R7)  *KEEP SCANNING STRG BLOCK                  83880002
         LA    R2,D16(R2)     *GET NEXT STRG BLK FIELD                  83920002
         TM    D0(R2),XFF    *ARE WE FINISHED?                          83960002
         BNO   D0(R8)        *NO, GO HANDLE NEXT STRG BLK               84000002
         SPACE 3                                                        84040002
         L     R11,ICFADR4   *ADJUST THE BASE REGISTERS                 84080002
         LA    R12,D4095(R11)     *OF THIS MODULE                       84120002
         LA    R12,D1(R12)   *FOR BASIC CONTROL MODE                    84160002
         MVC   PINPSW(D8),ICFPSW27     *NO PGM CHKS SHOULD OCCUR        84200002
         L     R2,ICFADR3    *GET REAL POINTER TO CSD FROM COMM.AREA    84240002
         USING CSD,R2        *ESTABLISH CSD ADDRESSABILITY              84280002
         CLI   CSDCPUOL+D1,X01    *IS MORE THAN ONE CPU ONLINE?         84320002
         BH    ICFRMPPR       *YES, GO TO MP INTERFACE PROCESSING       84360002
         TM    CSDFLAGS,CSDMP     *ARE WE ON MP SYST?                   84400002
         BO    ICFCPUOK       *YES, GO SET PREFIX REGISTER TO ZERO      84440002
         B     ICFNOTMP      *NO, BYPASS MP CODE                        84480002
         DROP  R2                                                       84520002
ICFRMPPR EQU   *    *SET UP RESTORE INTFC.FOR MP                        84560002
*        STAP  ICFIOMAP+D10  *STORE CPU ADDRESS                         84600002
         DC    X'B212',S(ICFIOMAP+D10) *SIMULATE STAP INSTR.            84640002
         MVC   ICFIOMAP+D8(D2),ICFIOMAP+D10  *SAVE IT FOR LATER         84680002
         XI    ICFIOMAP+D11,X01   *GET OTHER CPU'S ADDRESS              84720002
         LH    R3,ICFIOMAP+D10    *SET IT IN REGISTER FOR SIGP          84760002
         SLL   R3,D2         *MULTIPLY BY 4 TO INDEX PCCA VECTOR TABLE  84800002
         L     R6,ICFADR2    *GET REAL ADDRESS OF PCCA VECTOR TABLE     84840002
         L     R6,D0(R3,R6)  *GET VIRTUAL ADDR. OF OTHER CPU'S PCCA     84880002
         SRL   R3,D2         *RESET OTHER CPU'S ADDR. FOR SIGP          84920002
         LRA   R6,D0(R6)     *GET REAL ADDR. OF OTHER CPU'S PCCA        84960002
         USING PCCA,R6       *ESTABLISH PCCA ADDRESSABILITY             85000002
         L     R6,PCCAPSAR   *GET REAL ADDRESS OF PSA                   85040002
         DROP  R6                                                       85080002
         MVC   D0(D8,R6),ICFPSW26 *PREPARE TO PUT OTHER CPU IN WAIT 026 85120002
         SR    R2,R2         *CLEAN STATUS REGISTER FOR SIGP            85160002
ICFIROCP EQU   *                                                        85200002
*        SIGP  R2,R3,ICFSIGPR     *ISSUE 'PRGM RESET' SIGP              85240002
         DC    X'AE230008'   *SIMULATE SIGP INSTRUCTION                 85280002
         BNZ   ICFIROCP      *IF NOT ACCEPTED TRY IT AGAIN              85320002
         SR    R2,R2         *CLEAN STATUS REGISTER FOR SIGP            85360002
ICFISOCP EQU   *                                                        85400002
*        SIGP  R2,R3,ICFSIGPS     *ISSUE 'RESTART' TO OTHER CPU         85440002
         DC    X'AE230006'   *SIMULATE SIGP INSTRUCTION                 85480002
         BNZ   ICFISOCP      *IF NOT ACCEPTED TRY IT AGAIN              85520002
         LH    R5,ICFIOMAP+D8     *GET ADDRESS OF OUR CPU               85560002
         LA    R4,D1         *SET MASK BIT IN R4                        85600002
*        USING THE CPU ADDRESS TO INDEX THE 'PATH ON CPU' FLAGS         85640002
*        IN ICFCTRDA, SEE IF WE HAVE A PATH TO THE                      85680002
         SLL   R4,D0(R5)     *RESTORE DEVICE FROM THIS CPU              85720002
         EX    R4,ICFTMINS   *DO WE HAVE A PATH FOR RESTORE ON THIS CPU 85760002
         BO    ICFCPUOK      *YES, WE ARE NOW READY TO RESTORE          85800002
         MVC   D0(D8,R6),ICFBCPSW *SET RESTART PSW FOR OTHER CPU        85840002
         MVI   D7(R6),X8C    *SET INSTR.ADDR. IN RESTART PSW            85880002
         XC    D4(D3,R6),D4(R6)   *CLEAN REST OF INSTR.ADDR.            85920002
         MVC   X8C(D12,R6),ICFRSCOD    *SET RESTART CODE FOR OTHER CPU  85960002
         STM   R10,R12,X80(R6)    *SAVE BASE REGISTERS IN OTHER PSA     86000002
         STM   R13,R9,ICFIOMAP+D12     *SAVE OTHER GPR'S IN COMM.AREA   86040002
         SR    R2,R2         *CLEAR STATUS REGISTER FOR SIGP            86080002
ICFROCPU EQU   *                                                        86120002
*        SIGP  R2,R3,ICFSIGPR  *ISSUE 'PRGM RESET' TO OTHER CPU         86160002
         DC    X'AE230008'   *SIMULATE SIGP INSTRUCTION                 86200002
         BNZ   ICFROCPU      *IF NOT ACCEPTED TRY IT AGAIN              86240002
         SR    R2,R2         *CLEAR STATUS REGISTER FOR SIGP            86280002
ICFSOCPU EQU   *                                                        86320002
*        SIGP  R2,R3,ICFSIGPS     *ISSUE 'RESTART' TO OTHER CPU.        86360002
         DC    X'AE230006'   *SIMULATE SIGP INSTRUCTION                 86400002
         BNZ   ICFSOCPU      *IF NOT ACCEPTED TRY IT AGAIN              86440002
*                                                                       86480002
*        AT THIS POINT THE OTHER CPU (WHICH HAS A PATH TO THE           86520002
*        RESTORE DEVICE) WILL LOAD ITS GPR'S FROM WHERE WE              86560002
*        JUST SAVED THEM AND BRANCH TO ICFCPUOK TO ENTER THE            86600002
*        RESTORE ROUTINE.                                               86640002
*                                                                       86680002
         LPSW  ICFPSW26  *THIS CPU WILL GO TO THE WAIT STATE (CODE 026) 86720002
         SPACE 3                                                        86760002
ICFCPUOK EQU   *             *WE ARE NOW RUNNING ON THE RIGHT CPU       86800002
*        SPX   ICFBCPSW      *SET PREFIX REGISTER TO ZERO               86840002
         DC    X'B210',S(ICFBCPSW)  *SIMULATE SPX INSTRUCTION           86880002
ICFNOTMP EQU   *                                                        86920002
         BR    R15           *GO TO RESTORE IN B.C.MODE & DISABLED      86960002
         SPACE 3                                                        87000002
ICFMCR   EQU   *             *CONTROL WILL BE GIVEN TO THIS CODE IF     87040002
*              DURING A STORAGE SCAN A PROGRAM INTERRUPT OCCURRED.      87080002
*              THIS MEANS THAT WE DON'T HAVE THE SAME REAL STORAGE      87120002
*              CONFIGURATION AS AT THE TIME OF DUMP. THIS SECTION WILL  87160002
*              NOTIFY THE OPERATOR AND GO TO WAIT STATE (CODE 027).     87200002
         MVC   PINPSW(D8),ICFSVPIN     *RESTORE PGM NEW PSW             87240002
ICFRSM   STOSM ICFSVPIN,X00  *RESET ORIGINAL SYSTEM MASK (ENABLED)      87280002
         LA    R1,ICFISCMS   *GET MSG POINTER                           87320002
         WTO   MF=(E,(R1))   *SEND 'INVALID STRG CONFIG' MSG            87360002
         B     ICFWAITR      *GO QUIT WITH WAIT 027                     87400002
         SPACE 3                                                        87440002
ICFLRAER EQU   *             *LRA INSTRUCTION FAILED                    87480002
         LA    R1,ICFLRAMS   *GET MESSAGE POINTER                       87520002
         WTO   MF=(E,(1))    *SEND 'LRA ERROR' MESSAGE                  87560002
         SPACE 1                                                        87600002
ICFWAITR EQU   *                                                        87640002
         LA    R1,ICFREIPL   *SEND REIPL MESSAGE                        87680002
         WTO   MF=(E,(1))                                               87720002
         STIMER WAIT,BINTVL=CFBI20S    *GIVE MSG TIME TO BE DISPLAYED   87760002
         LPSW  ICFPSW27      *LOAD DISABLED WAIT PSW (CODE 027)         87800002
         SPACE 5                                                        87840002
ICFRSCOD EQU   *             *RESTART CODE TO BE MOVED TO OTHER PSA     87880002
         LM    R10,R12,X80(R0)    *INITIALIZE BASE REGISTERS            87920002
         LM    R13,R9,ICFIOMAP+D12     *INITIALIZE OTHER GPR'S          87960002
         B     ICFCPUOK      *GO TO RESTORE ROUTINE                     88000002
*        END OF THE RESTART CODE TO BE MOVED TO OTHER PSA               88040002
ICFTMINS TM    ICFCTRDA+D1,X00    *IS PATH ON THIS CPU AVAILABLE        88080002
ICFSIGPR EQU   X08           *SIGP CODE FOR PROGRAM RESET               88120002
ICFSIGPS EQU   X06           *SIGP CODE FOR RESTART                     88160002
         SPACE 5                                                        88200002
ICFSVPIN DC    D'0'          *SAVE AREA FOR PGM NEW PSW                 88240002
ICFBCPSW DC    D'0'          *PSW USED TO SWITCH TO B.C. MODE           88280002
ICFPSW27 DC    X'0002000000000027'  *DISABLED WAIT PSW (CODE 027)       88320002
ICFPSW26 DC    X'0002000000000026'  *SUCCESSFUL COMPLETION PSW          88360002
CFBI20S  DC    F'300'        *3 SECS IN BINARY INTERVALS                88400002
ICFREIPL WTO   'ICFTIM98 CORRECT PROBLEM AND RE-IPL',                  C88440002
               DESC=2,ROUTCDE=(1),MF=L                                  88480002
ICFISCMS WTO   'ICFTIM97 INVALID STORAGE CONFIGURATION FOR RESTORE',DESC88520002
               C=2,ROUTCDE=(1),MF=L                                     88560002
ICFLRAMS WTO   'ICFTIM96 ERROR DURING EXECUTION OF LRA INSTRUCTION',DESC88600002
               C=2,ROUTCDE=(1),MF=L                                     88640002
ICFBCODE EQU   *             *END OF CODE TO BE RELOCATED               88680002
         DROP  R10                                                      88720002
         DROP  R11                                                      88760002
         DROP  R12                                                      88800002
         DROP  R13                                                      88840002
         TITLE 'ICFBIX50 - DUMMY USER EXIT ROUTINE FOR PWF'             88880002
*********************************************************************** 88920002
*                                                                     * 88960002
*  THIS MODULE IS PART OF THE POWER WARNING FEATURE SUPPORT.          * 89000002
*                                                                     * 89040002
* FUNCTION-IMMEDIATELY RETURN CONTROL TO THE CALLING MODULE           * 89080002
*          WHEN THE USER DOES NOT SUPPLY HIS EXIT ROUTINE.            * 89120002
*                                                                     * 89160002
*********************************************************************** 89200002
         SPACE 5                                                        89240002
ICFBIE50 EQU  *                                                         89280002
         USING ICFBIE50,R15  *ESTABLISH ADDRESSABILITY FOR USER EXIT    89320002
         SR    R15,R15        .SET RETURN CODE TO ZERO                  89360002
         BR    R14            RETURN TO CALLER                          89370002
         DROP  R15                                                      89400002
         TITLE 'POWER WARNING FEATURE INITIALIZATION MODULE'            89440002
         END                                                            89480002
