* $$ JOB JNM=VSEPWRS,CLASS=0                                            00000001
* $$ LST DISP=D,CLASS=P                                                 00000002
* $$ PUN DISP=I,CLASS=0                                                 00000003
// JOB VSEPWRS     ASSEMBLY                                             00000004
// EXEC IESINSRT                                                        00000005
$ $$ LST DISP=D,CLASS=P                                                 00000006
// JOB VSEPWRS     LIBR/CATALR                                          00000007
// EXEC LIBR,PARM='MSHP;ACC S=PRD2.BTAM'                                00000008
* $$ END                                                                00000009
// OPTION DECK                                                          00000010
// EXEC ASSEMBLY                                                        00000011
         PUNCH ' CATALR VSEPWRS'                                        00000012
*********************************************************************** 00000013
**       VSE/POWER SPOOL ACCESS SUPPORT                              ** 00000014
*********************************************************************** 00000015
*                                                                     * 00000016
*   THIS PROGRAM - ACTS AS A SPOOL-ACCESS-SERVICE                     * 00000017
*   USER THAT INTERACTS WITH VSE/POWER VIA USING THE AVAILABLE        * 00000018
*   SPOOL-ACCESS SUPPORT.                                             * 00000019
*                                                                     * 00000020
*   THE PROGRAM'S OPERATIONAL STEPS ARE:                              * 00000021
*                                                                     * 00000022
*   1.  IDENTIFY ITSELF TO THE SYSTEM'S XPCC SUPPORT WITH THE USER    * 00000023
*       IDENTIFICATION "VSEPWRS".                                     * 00000024
*                                                                     * 00000025
*   2.  TRY TO ESTABLISH A COMMUNICATION PATH TO VSE/POWER -- TERMIN- * 00000026
*       ATE IF THIS PATH CANNOT BE ESTABLISHED WITHIN ONE MINUTE.     * 00000027
*                                                                     * 00000028
*   3.  USE THE GET SERVICE TO RETRIEVE A PWR QUEUE ENTRY, OR         * 00000029
*                                                                     * 00000030
*   4.  USE THE PUT SERVICE TO SUBMIT A JOB TO THE PWR RDR QUEUE.     * 00000031
*                                                                     * 00000032
*   5.  DISCONNECT THE COMMUNICATION PATH TO VSE/POWER.               * 00000033
*                                                                     * 00000034
*   6.  TERMINATE (LOG OFF FROM) THE VSE XPCC SUPPORT.                * 00000035
*                                                                     * 00000036
*   7.  TERMINATE THE PROGRAM.                                        * 00000037
*                                                                     * 00000038
*   IMPORTANT:                                                        * 00000039
*   ==========                                                        * 00000040
*   CHANGE THE STATEMENT AT LABEL "OWNSPL" TO MATCH THE PWD OPERAND   * 00000041
*   WITH THE MPWD OPERAND SPECIFIED AT YOUR POWER GENERATION MACRO    * 00000042
*   IN ORDER TO ALLOW UNLIMITED ACCESS TO QUEUE ENTRIES.              * 00000043
*                                                                     * 00000044
*********************************************************************** 00000045
*                                                                     * 00000046
*  THE FOLLOWING MACROS ARE REQUIRED:                                 * 00000047
*                                                                     * 00000048
*      SYSTEM MACROS:  XPCC                                           * 00000049
*                      XPCCB                                          * 00000050
*                      MAPXPCCB                                       * 00000051
*                      SETIME                                         * 00000052
*                      WAITM                                          * 00000053
*                      WAIT                                           * 00000054
*                                                                     * 00000055
*      VSE/POWER:      PWRSPL                                         * 00000056
*                                                                     * 00000057
*  NOTE: LINES WITH THE @-SIGN AT THE END REPRESENT THE INTERFACE     * 00000058
*        TO VSE/POWER.                                                * 00000059
*        LINES WITHOUT THE @-SIGN AT THE END REPRESENT THE INTERFACE  * 00000060
*        TO THE SYSTEM'S XPCC SUPPORT.                                * 00000061
*                                                                     * 00000062
*********************************************************************** 00000063
*                                                                       00000064
* ---------------------  REGISTER USAGE  -----------------------------  00000065
*                                                                       00000066
*        R0 - **** - WORK REGISTER                                      00000067
*        R1 - **** - WORK REGISTER, ALSO USED BY PWRSPL MACRO           00000068
*        R2 - **** - WORK REGISTER                                      00000069
*        R3 - **** - WORK REGISTER                                      00000070
*        R4 - **** - ADDR REG FOR CROSS PARTITION CONTROL BLOCK XPCCB   00000071
*        R5 - **** - ADDRESS REGISTER FOR USER DATA TO BE SENT          00000072
*        R6 - **** - ADDRESS REGISTER FOR RECEIVED USER DATA            00000073
*        R7 - **** - ADDRESS REGISTER FOR SPL DSECT                     00000074
*        R8 - **** - BASE REGISTER                                      00000075
*        R9 - **** - WORK REGISTER                                      00000076
*        RA - **** - WORK REGISTER                                      00000077
*        RB - **** - WORK REGISTER                                      00000078
*        RC - **** - WORK REGISTER                                      00000079
*        RD - **** - BRANCH AND LINK REGISTER FOR SENDR SUBROUTINE      00000080
*        RE - **** - BRANCH AND LINK REGISTER FOR DATDSPLY SUBROUTINE   00000081
*        RF - **** - MACRO CALL RETURN CODE REGISTER                    00000082
*                                                                       00000083
         PRINT NOGEN                                                    00000084
VSEPWRS  CSECT                                                          00000085
         USING *,RF                                                     00000086
         STM   RE,RC,12(RD)        STORE REGS IN SAVEAREA               00000087
         DROP  RF                  R15 TO BE USED BY MACROS             00000088
         USING VSEPWRS,R8          R8 NOW BASE REGISTER                 00000089
         LR    R8,RF               ESTABLISH ADDRESSABILITY             00000090
         ST    RD,SAVEAREA+4       STORE MAIN PGM SAVEAREA              00000091
         LR    RA,RD               SAVE R13                             00000092
         LA    RD,SAVEAREA         SAVE AREA FOR THIS TASK              00000093
         ST    RD,8(RA)            STORE EXIT SAVE ADDRESS              00000094
         LA    R4,OWNXPCCB         GET ADDR OF CROSS PART. CONTROL BLK  00000095
         USING IJBXPCCB,R4         ESTABLISH ADDRESSABILITY FOR DSECT   00000096
         LA    R5,IJBXSUSR         GET ADDR OF USER DATA TO BE SENT     00000097
         USING PXUUSER,R5          ESTABLISH ADDRESSABILITY FOR DSECT   00000098
         LA    R6,IJBXRUSR         GET ADDR OF RECEIVED USER DATA       00000099
         USING PXPUSER,R6          ESTABLISH ADDRESSABILITY FOR DSECT   00000100
         LA    R7,OWNSPL           GET ADDR OF SPL                      00000101
         USING OWNSPLDS,R7         ESTABLISH ADDRESSABILITY FOR DSECT   00000102
* --------------------------------------------------------------------  00000103
         L     R2,0(R1)            PARMS ADDRESS                        00000104
         ST    R2,PARMADDR         SAVE                                 00000105
         MVC   PARMS,0(R2)         MOVE JOBNAME, JOBNUM, CLASS, QUEUE   00000106
         MVC   PRETCOD,=C'000'     CLEAR RETURN CODE                    00000107
         MVI   GETFCT,C' '         IDENTIFY DATDSPLY CALLER             00000108
         MVI   NOPREC+1,X'00'      OFF SW TO RETURN RECORD              00000109
         MVC   NEXTREC,PBUFADR     NEXT RECORD IN BUFFER                00000110
*                                                                       00000111
*********************************************************************** 00000112
**                     S T E P :   1                                 ** 00000113
**          >> IDENTIFY VSEPWRS AS VSE/AF XPCC USER <<               ** 00000114
** IF THE MACRO FAILS, THE PROGRAM DISPLAYS A MESSAGE AND TERMINATES.** 00000115
*********************************************************************** 00000116
IDENT    DS    0H                                                       00000117
         XPCC  XPCCB=(R4),FUNC=IDENT   IDENTIFY 'VSEPWRS' TO AF-XPCC    00000118
*                                                                       00000119
         CLM   RF,M1,EIGHTDC       WAS RETURN CODE X'08' GIVEN BACK ?   00000120
         BNO   CONCT               ..NO, CONTINUE WITH CONNECTION       00000121
*                                                                       00000122
         MVC   FAILFUNC,=C'IDENTIFY'  INSERT FAILING FUNCTION INTO MSG  00000123
         BAL   RE,MSGRETC          INSERT XPCC RETURN CODE INTO MSG     00000124
         MVC   FAILLABL,=C'IDENT'  INSERT CODE LABEL FOR DIAGNOSTIC     00000125
         BAL   RE,MSGDSPLY         DISPLAY MESSAGE ON CONSOLE           00000126
         B     FINDUMP             BRANCH TO TERMINATION WITH DUMP      00000127
*                                                                       00000128
*********************************************************************** 00000129
**                     S T E P :   2                                 ** 00000130
**      >> ESTABLISH THE XPCC CONNECTION TO VSE/POWER <<             ** 00000131
** IF THE MACRO FAILS, THE PROGRAM DISPLAYS A FAILURE MESSAGE AND    ** 00000132
** TERMINATES.  THE PROGRAM WAITS UP TO ONE MINUTE FOR THE CONNEC-   ** 00000133
** TION TO BE COMPLETED.                                             ** 00000134
** IF THE CONNECTION IS ESTABLISHED AS REQUESTED, THE PROGRAM DIS-   ** 00000135
** PLAYS A CONFIRMATION MESSAGE.                                     ** 00000136
*********************************************************************** 00000137
CONCT    DS    0H                                                       00000138
         XPCC  XPCCB=(R4),FUNC=CONNECT        CONNECT TO VSE/POWER      00000139
*                                                                       00000140
         LTR   RF,RF               IS CONNECTION ALREADY AVAILABLE ?    00000141
         BZ    CONNOK              ..YES, BYPASS WAIT FOR CONNECTION    00000142
*                                                                       00000143
         CLM   RF,M1,EIGHTDC        WAS RETURN CODE X'08' GIVEN BACK ?  00000144
         BL    WAITCECB            ..NO, MUST BE '04', SO WAIT FOR CECB 00000145
         CLI   IJBXRETC,IJBXQSCE   DID POWER GIVE XPCC TERMQSCE ?       00000146
         BE    TERMQSCE            ..YES, GO TO HANDLE THAT STATE       00000147
         MVC   FAILFUNC,=C'CONNECT '   INSERT FAILING FUNCTION INTO MSG 00000148
         BAL   RE,MSGRETC          INSERT XPCC RETURN CODE INTO MSG     00000149
         MVC   FAILLABL,=C'CONCT'  INSERT CODE LABEL FOR DIAGNOSTIC     00000150
         BAL   RE,MSGDSPLY         DISPLAY MESSAGE ON CONSOLE           00000151
         CLI   IJBXRETC,IJBXNSTO   DID CONNECT FAIL DUE TO NO STOR. ?   00000152
         BE    TERMN               ..YES, GO TO CLOSE XPCC INTERFACE    00000153
         B     FINDUMP             GO TO TERMINATION WITH DUMP          00000154
*                                                                       00000155
TERMQSCE DS    0H                                                       00000156
         LA    R1,FAILM1                                                00000157
         BAL   R9,DISPLAY          ERROR MSG                            00000158
         B     TERMN               GO TO CLOSE XPCC INTERFACE CORRECTLY 00000159
*                                                                       00000160
WAITCECB DS    0H                  CONNECTION IS STILL 'PENDING'        00000161
         SETIME 60,INTECB          INSTALL WAIT INTERVAL OF ONE MIN.    00000162
         LA    R3,IJBXCECB         LOAD ADDRESS OF CONNECTION ECB       00000163
         ST    R3,LISTCECB         COMPLETE WAITLIST                    00000164
         WAITM WAITLIST            WAIT FOR CONNECTION OR 1 MIN. COMPL. 00000165
         TM    IJBXCECB+2,POSTBIT  CONNECTION COMPLETE?                 00000166
         BO    CONNOK              ...YES, CONTINUE AT CONNOK           00000167
         LA    R1,FAILM3                                                00000168
         BAL   R9,DISPLAY          ERROR MSG                            00000169
         MVI   PRETCOD+2,C'8'      $RC 8                                00000170
         B     DISCT               GO TO DISCONNECT AND TERMINATE       00000171
*                                                                       00000172
CONNOK   DS    0H                  NOW, CONNECTION ECB IS POSTED        00000173
*                                                                       00000174
         CLC   PFUNC,=C'GET'       GET REQUEST ?                        00000175
         BNE   PUTA1               NO, ASSUME "SUBMIT"                  00000176
         XC    PNORL,PNORL         YES, CLEAR NO.RECORDS                00000177
*                                                                       00000178
**********************************************************************@ 00000179
**      >>          CONTROL REQUEST                   <<             *@ 00000180
** A FIXED FORMAT PDISPLAY COMMAND IS SUBMITTED IN ORDER TO LOCATE   *@ 00000181
** THE OUTPUT OF JOB IN THE PWR QUEUE.                               *@ 00000182
**********************************************************************@ 00000183
CTLA1    DS    0H                                                     @ 00000184
*                                                                       00000185
         PWRSPL TYPE=UPD,SPL=OWNSPL,REQ=CTL,FUNC=COMMAND,OPT=RESET    @ 00000186
*                                                                       00000187
         MVC   CMDQUEUE(3),PWRQUEUE   SET QUEUE IN COMMAND              00000188
         MVC   CMDBODY(14),PWRJOB  SET JOBNAME,JOBNUM! IN COMMAND      00000189
         MVC   SPLCFLD,JOBCMD      PLUG FREE FORMAT CMD INTO PWRSPL   @ 00000190
*                                                                       00000191
         MVI   PXUBTYP,PXUBTSPL    INDICATE BUFFER TYPE = SPL         @ 00000192
         MVI   PXUACT1,0           CLEAR ACTION BYTE                  @ 00000193
*                                                                       00000194
*        THE UPDATED SPL IS DIRECTLY USED AS XPCC BUFFER.             @ 00000195
*                                                                       00000196
         STCM  R7,M7,IJBXADR       INSERT SPL ADDRESS AS BUFFER ADDR. @ 00000197
*                                                                       00000198
         LA    R3,SPLGLEN          LOAD LENGTH OF SPL                 @ 00000199
         ST    R3,IJBXBLN          INSERT BUFFER LENGTH INTO XPCCB    @ 00000200
*                                                                       00000201
         MVC   FAILLABL,=C'CTLA2'  INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000202
CTLA2    DS    0H                                                     @ 00000203
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000204
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000205
         BE    CTLA3               YES, CONTINUE WITH MSG DISPLAY     @ 00000206
*                                                                       00000207
*   THE PROGRAM TESTS THE POWER RC/FBKCD TO SEE IF THE OUTPUT OF THE  @ 00000208
*   JOB COULD BE LOCATED.                                             @ 00000209
*                                                                       00000210
         CLI   PXPRETCD,PXPRCOKF   WAS POWER RETURN CODE X'04'        @ 00000211
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000212
         CLI   PXPFBKCD,PXP04DNF   WAS JOB NOT FOUND (=NOT YET COMPL.)@ 00000213
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000214
         MVI   PRETCOD+2,C'4'      $RC 4 / JOBNAME NOT FOUND            00000215
         B     DISCT               DISCONN AND TERMIN XPCC LINK, EOJ  @ 00000216
*                                                                       00000217
CTLA3    DS    0H                                                     @ 00000218
         MVI   BNO+1,X'E0'         FORCE BNO                            00000219
         BAL   RE,DATDSPLY         GO TO DISPLAY RETURNED QUEUE ENTRY @ 00000220
*                                                                       00000221
**********************************************************************@ 00000222
**                     S T E P :   3                                 ** 00000223
**            >>   GET REQUEST FROM PWR QUEUE    <<                  *@ 00000224
**  THE GET SERVICE IS USED TO RETRIEVE THE PWR QUEUE ENTRY.         *@ 00000225
**********************************************************************@ 00000226
*                                                                       00000227
*        REGISTER USAGE FOR GET-REQUEST FROM LST QUEUE                @ 00000228
*                                                                       00000229
*        R3 - ****    - WORK REGISTER                                 @ 00000230
*        RA - BUFPTR  - POINTER FOR THE SEND BUFFER                   @ 00000231
*                                                                       00000232
*        ONLY PARAMETERS WHICH ARE DIFFERENT FROM THOSE USED IN THE   @ 00000233
*        PREVIOUS CTL-REQUEST ARE SPECIFIED IN THE UPDATE SPL.        @ 00000234
*                                                                       00000235
GETB1    DS    0H                                                     @ 00000236
         LA    R2,SAVCLAS          CLASS PARM ADDRESS                   00000237
         PACK  DBL,SAVJNUM         CONVERT TO BINARY                    00000238
         CVB   R1,DBL                                                   00000239
         STH   R1,JOBNUM           STORE JOBNUM                         00000240
*                                                                       00000241
         PWRSPL TYPE=UPD,SPL=(R7),QUEUE=LST,REQ=GET,MODE=BROWSE,      @*00000242
               JOBN=PWRJOB,JNUM=JOBNUM,CLASS=(2)                        00000243
*                                                                       00000244
         MVC   SPLGQI-SPLDS(1,R7),PWRQUEUE  SET UP QUEUE ID             00000245
         MVI   PXUBTYP,PXUBTSPL    INDICATE BUFFER TYPE = SPL         @ 00000246
         MVI   PXUACT1,0           CLEAR ACTION BYTE 1                @ 00000247
*                                                                       00000248
         STCM  R7,M7,IJBXADR       INSERT SPL ADDRESS AS BUFFER ADDR. @ 00000249
         LA    R3,SPLGSLEN         LOAD LENGTH OF SPL (SHORT VERSION) @ 00000250
         ST    R3,IJBXBLN          INSERT BUFFER LENGTH INTO XPCCB    @ 00000251
*                                                                       00000252
         MVC   FAILLABL,=C'GETB1'  INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000253
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000254
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000255
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000256
*                                                                       00000257
*   THE VERIFICATION SPL RETURNED BY VSE/POWER, WHICH COULD BE CHECKED@ 00000258
*   FOR USEFUL INFORMATION (SUCH AS FORMSID), IS IGNORED BY VSEPWRS.  @ 00000259
*   THEREFORE, A NULL BUFFER WITH THE 'SEND DATA' REQUEST CAN BE      @ 00000260
*   PASSED TO VSE/POWER IMMEDIATELY.                                  @ 00000261
*                                                                       00000262
GETB2    DS    0H                                                     @ 00000263
         XC    IJBXBLN,IJBXBLN     INDICATE ZERO BUFFER LENGTH        @ 00000264
         MVI   PXUBTYP,0           CLEAR BUFFER TYPE BYTE IN USER DATA@ 00000265
         MVI   PXUACT1,PXUATSDR    INDICATE SEND DATA REQUEST         @ 00000266
         MVC   FAILLABL,=C'GETB2'  INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000267
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000268
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000269
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000270
         MVI   GETFCT,C'G'         INDICATE: DATDSPLY IS CALLED BY GET@ 00000271
*                                                                       00000272
         OI    NOPREC+1,X'F0'      SET SW TO RETURN RECORD              00000273
         BAL   RE,DATDSPLY         GO TO DISPLAY RETURNED DATA        @ 00000274
*                                  AND DO NOT RETURN UNTIL LAST DATA  @ 00000275
*                                  RECORD IS DISPLAYED                @ 00000276
         B     DISCT                                                    00000277
*                                                                       00000278
**********************************************************************@ 00000279
**                     S T E P :   4                                 *@ 00000280
**      >>          PUT-REQUEST TO RDR QUEUE          <<             *@ 00000281
**  THE JOB '???????' IS SUBMITTED TO THE VSE/POWER RDR QUEUE.       *@ 00000282
**********************************************************************@ 00000283
*        REGISTER USAGE FOR PUT-REQUEST TO RDR QUEUE                  @ 00000284
*        R3 -  *****  - WORK REGISTER                                 @ 00000285
*        RA - BUFPTR  - POINTER FOR THE SEND BUFFER                   @ 00000286
*        RB - DATAPTR - POINTER FOR THE INPUT CARDS                   @ 00000287
*        RC -  *****  - TEMPORARY ADDR. REG FOR SPL DSECT             @ 00000288
*                                                                       00000289
*   THE GENERATED SPL (OWNSPL) IS UPDATED INDICATING A PUT OPEN       @ 00000290
*   REQUEST AND IS THEN SENT TO VSE/POWER.                            @ 00000291
*                                                                       00000292
PUTA1    DS    0H                                                     @ 00000293
         L     R2,PBUFADR          INPUT BUFFER ADDRESS                 00000294
         L     R3,PNORL            NO. RECORDS                          00000295
         MH    R3,=H'80'           80 BYTES EACH                        00000296
         AR    R2,R3                                                    00000297
         ST    R2,ENDBUF           SAVE END OF BUFFER ADDRESS           00000298
*                                                                       00000299
*        THE SPL IS UPDATED FOR A 'PUT-OPEN JOB' REQUEST, SPECIFYING  @ 00000300
*         - THE MANDATORY FIELDS 'QUEUE, USERID'                      @ 00000301
*         FOR DETAILS ON MANDAT./OPT. FIELDS SEE PWRSPL REQ=PUT (JOB).@ 00000302
*         NOTE: THE JOB ATTRIBUTES WILL BE EXTRACTED FROM THE JECL    @ 00000303
*               JOB STATEMENT SUBMITTED LATER WITH THE JOB DATA.      @ 00000304
*                                                                       00000305
         PWRSPL TYPE=UPD,SPL=OWNSPL,REQ=PUT,QUEUE=RDR,                @*00000306
               OPT=RESET,MODE=RESET                                   @ 00000307
*                                                                       00000308
         MVC   SPLDLREC(2),=H'80'  MAXIMUM RECORD LENGTH                00000309
         MVI   PXUBTYP,PXUBTSPL    INDICATE BUFFER TYPE = SPL         @ 00000310
         MVI   PXUACT1,0           CLEAR ALL OTHER BYTES IN PXUUSER,  @ 00000311
         MVI   PXUSIGNL,0          WHICH MAY BE CHANGED BY THE USER   @ 00000312
*                                                                       00000313
*        THE SPL IS DIRECTLY USED AS XPCC SEND BUFFER                 @ 00000314
*                                                                       00000315
         STCM  R7,M7,IJBXADR       INSERT SPL ADDRESS AS BUFFER ADDR. @ 00000316
         LA    R3,SPLGLEN          LOAD LENGTH OF SPL                 @ 00000317
         ST    R3,IJBXBLN          INSERT BUFFER LENGTH INTO XPCCB    @ 00000318
*                                                                       00000319
         MVC   FAILLABL,=C'PUTA1 ' INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000320
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000321
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000322
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000323
*                                                                       00000324
*        THE VERIFICATION SPL RETURNED BY VSE/POWER FOR A PUT-OPEN    @ 00000325
*        REQUEST IS IGNORED, THE VERIFICATION SPL RETURNED LATER FOR  @ 00000326
*        A PUT-CLOSE REQUEST MAY BE OF MORE INTEREST.                 @ 00000327
*                                                                       00000328
*        FOR THE SUBSEQUENT 'PUT-SPOOL' REQUESTS THE PXU-USER FIELD   @ 00000329
*        SETTINGS ARE ESTABLISHED, AND                                @ 00000330
*        THE SEND BUFFER IS FILLED WITH INPUT CARDS (EACH CARD        @ 00000331
*        PRECEDED BY A RECORD PREFIX) UNTIL NO MORE CARD FITS.        @ 00000332
*        THE BUFFER IS THEN PASSED TO VSE/POWER IN THE ACTUALLY       @ 00000333
*        USED LENGTH.                                                 @ 00000334
*                                                                       00000335
         MVI   PXUBTYP,PXUBTNDB    BUFFER TYPE = NORMAL DATA BUFFER   @ 00000336
         MVI   PXUACT1,0           CLEAR ACTION BYTE                  @ 00000337
*                                                                       00000338
         LA    BUFPTR,SENDBUF      GET ADDRESS OF SEND BUFFER         @ 00000339
         STCM  BUFPTR,M7,IJBXADR   INSERT BUFFER ADDRESS INTO XPCCB   @ 00000340
         L     DATAPTR,PBUFADR     GET ADDR OF FIRST INPUT CARD, ...  @ 00000341
*                                  USUALLY THE * $$ JOB STATEMENT     @ 00000342
FILLBUF  DS    0H                                                     @ 00000343
         C     DATAPTR,ENDBUF      END OF FILE REACHED?               @ 00000344
         BE    PUTA3               YES, GO TO SEND FINAL BUFFER       @ 00000345
         CL    BUFPTR,LASTPREC     ENOUGH SPACE FOR ONE MORE RECORD?  @ 00000346
         BH    PUTA2               NO, GO TO SEND NORMAL BUFFER       @ 00000347
         USING RECPRFIX,BUFPTR     GET DSECT FOR RECORD LAYOUT        @ 00000348
         XC    0(RECPRFXL,BUFPTR),0(BUFPTR)   CLEAR BYTES FOR PREFIX  @ 00000349
         MVI   RECTYPE,RECTNORM    INSERT REC. TYPE IN REC. PREFIX    @ 00000350
         LA    R3,80               LOAD LENGTH OF DATA CARD             00000351
         STH   R3,RECLNGTH         INSERT LENGTH OF DATA CARD IN PREF.@ 00000352
         LA    BUFPTR,RECPRFXL(,BUFPTR)        SKIP PREFIX IN BUFFER  @ 00000353
         DROP  BUFPTR                                                 @ 00000354
         MVC   0(80,BUFPTR),0(DATAPTR) MOVE DATA INTO BUFFER            00000355
         LA    BUFPTR,80(,BUFPTR)   POINT TO NEXT FREE B.SPACE          00000356
         LA    DATAPTR,80(,DATAPTR) POINT TO NEXT INPUT CARD            00000357
         B     FILLBUF             TRY TO FILL IN NEXT INPUT CARD     @ 00000358
*                                                                       00000359
PUTA2    DS    0H                                                     @ 00000360
         LA    R3,SENDBUF          GET AGAIN START ADDR OF SEND BUFFER@ 00000361
         SR    BUFPTR,R3           CALC. ACTUALLY USED BUFFER LENGTH  @ 00000362
         ST    BUFPTR,IJBXBLN      INSERT ACTUAL BUF.LENGTH INTO XPCCB@ 00000363
         MVC   FAILLABL,=C'PUTA2 ' INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000364
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000365
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000366
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000367
         LA    BUFPTR,SENDBUF      GET AGAIN ADDRESS OF SEND BUFFER   @ 00000368
         B     FILLBUF             GO TO FILL BUFFER AGAIN            @ 00000369
*                                                                       00000370
*        FOR THE SUBSEQUENT 'PUT-CLOSE' REQUEST THE PXU-USER FIELD    @ 00000371
*        IS SET UP WITH THE END-OF-DATA INDICATION, AND               @ 00000372
*        THE BUFFER BEING FILLED WHEN END OF FILE WAS DETECTED        @ 00000373
*        IS PASSED TO VSE/POWER AS FINAL BUFFER.                      @ 00000374
*                                                                       00000375
PUTA3    DS    0H                                                     @ 00000376
         MVI   PXUACT1,PXUATEOD    INDICATE END OF DATA               @ 00000377
         LA    R3,SENDBUF          GET AGAIN START ADDR OF SEND BUFFER@ 00000378
         SR    BUFPTR,R3           CALC. ACTUALLY USED BUFFER LENGTH  @ 00000379
         ST    BUFPTR,IJBXBLN      INSERT ACTUAL BUF.LENGTH INTO XPCCB@ 00000380
         MVC   FAILLABL,=C'PUTA3 ' INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000381
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000382
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000383
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000384
         CLI   PXPFBKCD,PXP00NJB   WAS MISSING /& OR * $$ EOJ ?       @ 00000385
         BE    DISCT               YES, DISCONNECT                    @ 00000386
         CLI   PXPFBKCD,PXP00OK    WAS POWER FEEDBACKCODE ZERO?       @ 00000387
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000388
         TM    PXPINFO,PXPIMSG     ARE MESSAGES QUEUED?               @ 00000389
         BZ    DISCT               NO, DISCONNECT                       00000390
*                                                                       00000391
PUTA4    DS    0H                                                     @ 00000392
         XC    IJBXBLN,IJBXBLN     INDICATE ZERO BUFFER LENGTH        @ 00000393
         MVI   PXUBTYP,0           CLEAR BUFFER TYPE BYTE IN USER DATA@ 00000394
         MVI   PXUACT1,PXUATRMR    INDICATE RETURN MESSAGE REQUEST    @ 00000395
         MVC   FAILLABL,=C'PUTA4 ' INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000396
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000397
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURN CODE ZERO?        @ 00000398
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000399
         BAL   RE,DATDSPLY         YES, GO TO DISPLAY RETURNED MSG'S  @ 00000400
         B     DISCT                                                    00000401
*                                                                       00000402
**********************************************************************@ 00000403
**                  >>   DATDSPLY ROUTINE      <<                    *@ 00000404
**  THIS ROUTINE DISPLAYS MESSAGES AND DATA RETURNED BY VSE/POWER.   *@ 00000405
**********************************************************************@ 00000406
*                                                                       00000407
*        REGISTER USAGE FOR DATDSPLY ROUTINE                          @ 00000408
*                                                                       00000409
*        RA - BUFPTR  - POINTER FOR THE REPLY BUFFER                  @ 00000410
*        RC - BUFLN   - REG TO CALCULATE THE LENGTH OF THE DATA STILL @ 00000411
*                       TO BE DISPLAYED                               @ 00000412
*        R0, R1, R2, R3 - WORK REGISTER                               @ 00000413
*                                                                     @ 00000414
*        CALLED FROM: PUT REQUEST TO RDR QUEUE                        @ 00000415
*                     CTL REQUEST                                     @ 00000416
*                     GET REQUEST                                     @ 00000417
*                     PUT REQUEST TO LST QUEUE                        @ 00000418
*                                                                     @ 00000419
*        EXIT TO CALLER IF ALL AVAILABLE MESSAGES/DATA ARE DISPLAYED  @ 00000420
*                                                                       00000421
DATDSPLY DS    0H                                                     @ 00000422
         SR    R0,R0               SET R0 TO ZERO                     @ 00000423
         CLM   R0,M7,IJBXSLN       NO MORE DATA TO DISPLAY?           @ 00000424
         BER   RE                  RETURN TO CALLER                   @ 00000425
         LA    BUFPTR,REPLBUF      POINT TO REPLY BUFFER              @ 00000426
         SR    BUFLN,BUFLN         CLEAR REGISTER                     @ 00000427
         ICM   BUFLN,M7,IJBXSLN    GET LENGTH OF DATA TO BE DISPLAYED @ 00000428
*                                                                       00000429
*   VSEPWRS RETURN TO THE MAIN PGM RECD AFTER RECD, THE DATA OR MSGS  @ 00000430
*   RETURNED BY VSE/POWER.                                            @ 00000431
*                                                                       00000432
DSPL0    DS    0H                                                     @ 00000433
         USING RECPRFIX,BUFPTR     GET DSECT OF RECORD LAYOUT         @ 00000434
         LH    R2,RECLNGTH         GET LENGTH OF FIRST/NEXT DATA REC. @ 00000435
         LA    BUFPTR,RECPRFXL(,BUFPTR)     SKIP RECORD PREFIX        @ 00000436
*                                                                       00000437
NOPREC   NOP   RETREC                                                   00000438
         L     R1,PENDBUF          END OF BUFFER ADDRESS                00000439
         LA    R3,132                                                   00000440
         CLC   PWRQUEUE,=C'LST'    LST QUEUE RECORDS ?                  00000441
         BE    *+8                 YES, ASSUME 132 BYTES RECORDS        00000442
         LA    R3,80               NO, 80 BYTES                         00000443
         SR    R1,R3                                                    00000444
         ST    R1,ENDBUF           SET LAST POSSIBLE RECORD ADDRESS     00000445
         ST    R3,RECLEN           SET REC LENGTH 80/132                00000446
         SH    R3,=H'2'                                                 00000447
         STC   R3,CLRMVC+1         SET LENGTH TO CLEAR OUT              00000448
         LR    R1,BUFPTR                                                00000449
         STCM  R2,3,LOGCCW+6       MESSAGE LENGTH                       00000450
         TM    16(R1),X'F0'        JOBNUM ?                             00000451
BNO      BNO   DSPL01              NO,                                  00000452
         OI    BNO+1,X'F0'         YES, FORCE NOP                       00000453
         MVC   PWRJOB(8),7(R1)     SAVE JOBNAME                         00000454
         MVC   SAVJNUM(5),16(R1)   SAVE JOBNUM                          00000455
         MVC   SAVCLAS(1),26(R1)   SAVE CLASS                           00000456
DSPL01   BAL   R9,DISPLAY          DISPLAY CURRENT QUEUE ENTRY          00000457
         B     DSPL1                                                    00000458
*                                                                       00000459
RETREC   DS    0H                                                       00000460
         SH    BUFPTR,=H'4'                                             00000461
         LA    R1,4(R2)            R1 = REC LENGTH + 4                  00000462
         STH   R1,0(BUFPTR)        SET REC LENGTH PREFIX                00000463
         MVC   2(2,BUFPTR),=2X'00'                                      00000464
*                                                                       00000465
         L     R3,NEXTREC          NEXT RECORD IN BUFFER                00000466
         C     R3,ENDBUF           REACH END OF BUFFER ?                00000467
         BL    CLROUT              NO,                                  00000468
         MVI   PRETCOD+2,C'9'      YES, $RC 9                           00000469
         B     DISCT               GO TO DISCONNECT AND TERMINATE       00000470
CLROUT   MVI   0(R3),C' '          NO,                                  00000471
CLRMVC   MVC   1(00,R3),0(R3)      CLEAR OUTPUT RECORD                  00000472
         SH    R1,=H'5'            R1 = REC LENGTH - 5                  00000473
         STC   R1,MOVEREC+1        SET MOVE LENGTH                      00000474
MOVEREC  MVC   0(00,R3),4(BUFPTR)  MOVE RECORD TO MAIN PGM BUFFER       00000475
         A     R3,RECLEN           INDEX NEXT RECORD                    00000476
         ST    R3,NEXTREC          SAVE ADDRESS                         00000477
         L     R3,PNORL            NO. RECORDS                          00000478
         LA    R3,1(R3)            UPDATE                               00000479
         ST    R3,PNORL            SAVE                                 00000480
*                                                                       00000481
         LA    BUFPTR,4(BUFPTR)    REPONER BUFPTR                       00000482
*                                                                       00000483
DSPL1    DS    0H                                                     @ 00000484
         LA    R1,RECPRFXL(,R2)    CALC. LENGTH OF RECORD INCL. PREFIX@ 00000485
         SR    BUFLN,R1            CALC.LENGTH OF DATA STILL IN BUFFER@ 00000486
         LA    BUFPTR,0(R2,BUFPTR)     POINT TO NEXT RECORD           @ 00000487
         LTR   BUFLN,BUFLN         ALL DATA IN BUFFER DISPLAYED?      @ 00000488
         BNZ   DSPL0               NO, GO TO DISPLAY NEXT DATA REC.   @ 00000489
*                                                                       00000490
         CLI   PXPFBKCD,PXP00EOD   END OF DATA?                       @ 00000491
         BER   RE                  YES, RETURN TO CALLER              @ 00000492
*                                                                     @ 00000493
*   IF THIS ROUTINE IS CALLED BY THE GET FUNCTION, 'SEND (MORE) DATA' @ 00000494
*   HAS TO BE INDICATED IN THE ACTION BYTE. IN ALL OTHER CASES        @ 00000495
*   'RETURN (MORE) MESSAGES' MUST BE SET.                             @ 00000496
*                                                                     @ 00000497
DSPL2    DS    0H                                                     @ 00000498
         XC    IJBXBLN,IJBXBLN     INDICATE ZERO BUFFER LENGTH        @ 00000499
         MVI   PXUBTYP,0            CLEAR BUFFER TYPE BYTE            @ 00000500
         MVI   PXUACT1,PXUATRMR    INDICATE A 'RETURN MESSAGE' REQUEST@ 00000501
         CLI   GETFCT,C'G'          WAS DATDSPLY CALLED BY GET?       @ 00000502
         BNE   DSPL3                NO, KEEP RETURN MESSAGE INDICATION@ 00000503
         MVI   PXUACT1,PXUATSDR    INDICATE A 'SEND DATA' REQUEST     @ 00000504
DSPL3    DS    0H                                                     @ 00000505
         MVC   FAILLABL,=C'DSPL2'  INSERT CODE LABEL FOR DIAGNOSTIC   @ 00000506
         BAL   RD,SENDR            GO TO SENDR ROUTINE                @ 00000507
         CLI   PXPRETCD,PXPRCOK    WAS POWER RETURNCODE ZERO?         @ 00000508
         BNE   REQFAIL             NO, GO TO HANDLE REQUEST FAILURE   @ 00000509
         B     DATDSPLY            YES, START DISPLAYING AGAIN        @ 00000510
*                                                                       00000511
**********************************************************************@ 00000512
**      >> ROUTINE TO HANDLE REQUEST FAILURES         <<             *@ 00000513
**  THE ROUTINE IS CALLED IF POWER RC/FBKC WAS NOT ZERO              *@ 00000514
**********************************************************************@ 00000515
REQFAIL  DS    0H                                                     @ 00000516
         MVC   FAILFUNC,=C'SENDR   ' INSERT FAILING FUNCTION INTO MSG @ 00000517
         BAL   RE,MSGRCFB          PREPARE RC/FBKC DISPLAY            @ 00000518
         BAL   RE,MSGDSPLY         DISPLAY MESSAGE ON CONSOLE         @ 00000519
         B     FINDUMP             GO TO TERMINATION WITH DUMP        @ 00000520
*                                                                       00000521
*********************************************************************** 00000522
**                     S T E P :   5                                 ** 00000523
**    >> DISCONNECT THE XPCC COMMUNICATION LINK TO VSE/POWER <<      ** 00000524
** IF THE MACRO FAILS, THE PROGRAM DISPLAYS A DIAGNOSTIC MESSAGE AND ** 00000525
** TERMINATES WITH A DUMP.                                           ** 00000526
*********************************************************************** 00000527
DISCT    DS    0H                                                       00000528
         XPCC  XPCCB=(R4),FUNC=DISCONN   DISCONNECT LINK TO VSE/POWER   00000529
*                                                                       00000530
         LTR   RF,RF               WAS DISCONNECT SUCCESSFUL, RF='00' ? 00000531
         BZ    TERMN               ..YES CONTINUE WITH XPCC TERMINATION 00000532
*                                                                       00000533
         MVC   FAILFUNC,=C'DISCONN '   INSERT FAILING FUNCTION          00000534
         BAL   RE,MSGRETC          INSERT XPCC RETURN CODE INTO MSG     00000535
         MVC   FAILLABL,=C'DISCT'  INSERT CODE LABEL FOR DIAGNOSTIC     00000536
         BAL   RE,MSGDSPLY         DISPLAY MESSAGE ON CONSOLE           00000537
         B     FINDUMP             GO TO TERMINATION WITH DUMP          00000538
*                                                                       00000539
*********************************************************************** 00000540
**                     S T E P :   6                                 ** 00000541
**    >> TERMINATE INTERACTION WITH THE VSE/AF XPCC SUPPORT <<       ** 00000542
** IF THE MACRO FAILS, THE PROGRAM DISPLAYS A DIAGNOSTIC MESSAGE AND ** 00000543
** TERMINATES WITH A DUMP.                                           ** 00000544
*********************************************************************** 00000545
TERMN    DS    0H                                                       00000546
*                                                                       00000547
XPCCT    XPCC XPCCB=(R4),FUNC=TERMIN   TERMINATE CROSS PART. INTERFACE  00000548
         LTR   RF,RF               DID WE GET A ZERO RET-CODE ?         00000549
         BZ    FINEND              ..YES, GO TO NORMAL EOJ MACRO        00000550
*                                                                       00000551
         MVC   FAILFUNC,=C'TERMIN  '  INSERT FAILING FUNCTION INTO MSG  00000552
         BAL   RE,MSGRETC          INSERT XPCC RETURN CODE INTO MSG     00000553
         MVC   FAILLABL,=C'TERMN'  INSERT CODE LABEL FOR DIAGNOSTIC     00000554
         BAL   RE,MSGDSPLY         DISPLAY MESSAGE ON CONSOLE           00000555
         B     FINDUMP             GO TO TERMINATION WITH DUMP          00000556
*                                                                       00000557
*********************************************************************** 00000558
**                     S T E P :   7                                 ** 00000559
**                  >> TERMINATE VSEPWRS   <<                        ** 00000560
*********************************************************************** 00000561
FINDUMP  DS    0H                  TERMINATION FORCED DUE TO ERROR      00000562
*        DUMP                      A PARTITION DUMP CAN BE FORCED IF    00000563
*                                  NECESSARY FOR DEBUG PURPOSES         00000564
         MVI   PRETCOD+2,C'8'      $RC 8                                00000565
*                                                                       00000566
FINEND   DS    0H                  NORMAL TERMINATION                   00000567
         L     R2,PARMADDR         RESTORE PARMS ADDRESS                00000568
         MVC   0(L'PARMS,R2),PARMS RETURN PARMS TO MAIN PGM             00000569
*                                                                       00000570
RETURN   EQU   *                   RETURN TO MAIN PROGRAM               00000571
         LA    RD,SAVEAREA         ADDRESS OF OUR  SAVEAREA             00000572
         STM   RE,RC,12(RD)        STORE REGS IN OUR SAVEAREA           00000573
         L     RD,4(RD)            ADDRESS OF MAIN PGM SAVEAREA         00000574
         L     RE,12(RD)           RESTORE RETURN REGISTER              00000575
         LM    R0,RC,20(RD)        RESTORE REGS 0-12                    00000576
         BR    RE                  RETURN TO MAIN PGM                   00000577
*                                                                       00000578
*********************************************************************** 00000579
**     >>       MESSAGE BUILD ROUTINE FOR FAILMSG            <<      ** 00000580
** BRANCHED TO FROM ANY CALLER TO FILL SELECTED FIELDS OF THE DIAG-  ** 00000581
** NOSTIC MESSAGE.  RETURNS TO CALLER VIA REGISTER 14 (RE).          ** 00000582
*********************************************************************** 00000583
*                                                                       00000584
MSGRETC  DS    0H                                                       00000585
         UNPK  HELP,IJBXRETC(2)        UNPACK HEX XPCC RETURN CODE      00000586
         TR    HELP(2),TRTAB           CONVERT TO PRINTABLE HEX-VALUE   00000587
         MVC   FAILRETC,HELP           INSERT PRINTABLE XPCC RET. CODE  00000588
         BR    RE                      RETURN TO CALLER                 00000589
*                                                                       00000590
MSGREAS  DS    0H                                                       00000591
         UNPK  HELP,IJBXREAS(2)        UNPACK HEX XPCC REASON CODE      00000592
         TR    HELP(2),TRTAB           CONVERT TO PRINTABLE HEX-VALUE   00000593
         MVC   FAILREAS,HELP           INSERT PRINTABLE XPCC REAS. CODE 00000594
         BR    RE                      RETURN TO CALLER                 00000595
*                                                                       00000596
MSGRCFB  DS    0H                                                       00000597
         UNPK  HELP,PXPRETCD(2)        UNPACK HEX POWER RETURN CODE     00000598
         TR    HELP(2),TRTAB           CONVERT TO PRINTABLE HEX-VALUE   00000599
         MVC   FAILPWRC,HELP           INSERT PRINTABLE POWER RET. CODE 00000600
         UNPK  HELP,PXPFBKCD(2)        UNPACK HEX POWER FEEDBACK CODE   00000601
         TR    HELP(2),TRTAB           CONVERT TO PRINTABLE HEX-VALUE   00000602
         MVC   FAILPWFB,HELP           INSERT POWER FEEDACK CODE        00000603
         BR    RE                      RETURN TO CALLER                 00000604
*                                                                       00000605
MSGDSPLY DS    0H                                                       00000606
         LA    R1,FAILMSG                                               00000607
         BAL   R9,DISPLAY                                               00000608
         MVC   PMSG,FAILLABL           SET ERR MSG TO MAIN PGM          00000609
         BR    RE                                                       00000610
*                                                                       00000611
DISPLAY  DS    0H                      DISPLAY TO CONSOLE               00000612
         STCM  R1,7,LOGCCW+1                                            00000613
         LA    R1,LOGCCB                                                00000614
         EXCP  (1)                                                      00000615
         WAIT  (1)                                                      00000616
         MVI   LOGCCW+7,72             RESTORE 72 BYTES LENGTH          00000617
         BR    R9                                                       00000618
LOGCCB   CCB   SYSLOG,LOGCCW                                            00000619
LOGCCW   CCW   X'09',*,X'20',72        WRITE TO CONSOLE                 00000620
*                                                                       00000621
*********************************************************************** 00000622
**            >> CENTRAL XPCC SENDR ROUTINE  <<                      ** 00000623
**  BEFORE THIS ROUTINE IS CALLED, THE PROGRAM INSERTS THE CALLING   ** 00000624
**  POINT IN THE DIAGNOSTIC MESSAGE THAT IS ISSUED SHOULD THE SENDR  ** 00000625
**  MACRO FAIL.  THIS ROUTINE:                                       ** 00000626
**   - ISSUES THE XPCC MACRO WITH FUNC=SENDR AND WAITS FOR THE       ** 00000627
**     SECB TO BE POSTED.  IT CHECKS REGISTER 15 (RF) AND THE VSE    ** 00000628
**   - CHECKS REGISTER 15 (RF) AND THE VSE RETURN- AND REASON CODES  ** 00000629
**     IN FIELDS IJBXRETC AND IJBXREAS, RESPECTIVELY.                ** 00000630
**   - CHECKS THE VSE/POWER RETURN CODE IN FIELD PXPRETCD IF         ** 00000631
**     VSE/POWER DISCONNECTS THE COMMUNICATION PATH WITH A PURGE.    ** 00000632
**  THE ROUTINE RETURNS TO THE CALLER IF THE XPCC MACRO CALL COM-    ** 00000633
**  PLETED SUCCESSFULLY OR, IN CASE OF A FAILURE, THE VSE/POWER RE-  ** 00000634
**  TURN CODE IS NOT TOO SEVERE.  RETURN IS PROVIDED VIA REGISTER    ** 00000635
**  13 (RD).                                                         ** 00000636
*********************************************************************** 00000637
*                                                                       00000638
*        REGISTER USAGE FOR SENDR ROUTINE                             @ 00000639
*                                                                       00000640
*        R3 - WORK REGISTER (FOR WAIT)                                @ 00000641
*        RD - REGISTER USED TO RETURN TO CALLER                       @ 00000642
*                                                                     @ 00000643
*        CALLED FROM: PUT REQUEST TO RDR QUEUE                        @ 00000644
*                     CTL REQUEST                                     @ 00000645
*                     GET REQUEST                                     @ 00000646
*                     PUT REQUEST TO LST QUEUE                        @ 00000647
*                     DATDSPLY ROUTINE                                @ 00000648
*                                                                     @ 00000649
*        EXIT TO CALLER (SEE COMMENT ABOVE)                           @ 00000650
*                OR TO DISCT OR FINDUMP IN CASE OF A FAILURE          @ 00000651
*                                                                     @ 00000652
SENDR    DS    0H                                                       00000653
         XPCC  XPCCB=(R4),FUNC=SENDR      SEND BUFFER TO VSE/POWER      00000654
         LTR   RF,RF               DID WE GET A ZERO RETURN CODE ?      00000655
         BZ    WAITSECB            ..YES, THEN WAIT FOR REPLY OF POWER  00000656
*                                                                       00000657
*   IF THE SENDR MACRO COMPLETES WITH RF=X'08', THEN THE ROUTINE:       00000658
*   1.  FILLS THE DIAGNOSTIC MESSAGE ACCORDING TO THE VSE RETURN CODE.  00000659
*   2.  DISPLAYS THE MESSAGE.                                           00000660
*   3.  TERMINATES WITH OR WITHOUT A DUMP.                              00000661
*   THERE IS NO RETURN TO THE CALLER OF SENDR.                          00000662
*                                                                       00000663
TESTRETC DS    0H                                                       00000664
         CLI   IJBXRETC,IJBXNOC3   DID POWER ABNORMALLY TERMINATE ?     00000665
         BE    ABNPOW              ..YES, THEN GO TO STOP VSEPWRS       00000666
         MVC   FAILFUNC,=C'SENDR  '    INSERT 'SENDR ' INTO MSG TEXT    00000667
         BAL   RE,MSGRETC          PUT XPCC RETURN CODE INTO MSG        00000668
         CLI   IJBXRETC,IJBXNOC2   DID POWER GIVE A DISCONNECT PURGE ?  00000669
         BE    TERMCONN            ..YES,THEN GO TO SHOW WHY, TERMINATE 00000670
         BAL   RE,MSGDSPLY         DISPLAY DIAGNOSTIC MESSAGE ON CONS.  00000671
         B     FINDUMP             TERMINATE VSEPWRS WITH PART.DUMP     00000672
*                                                                       00000673
ABNPOW   DS    0H                                                       00000674
         LA    R1,FAILM2                                                00000675
         BAL   R9,DISPLAY          ERROR MSG                            00000676
         MVI   PRETCOD+2,C'8'      $RC 8                                00000677
         B     DISCT               DISCONN AND TERMIN XPCC LINK, EOJ    00000678
*                                                                       00000679
*   THE ROUTINE WAITS FOR THE SEND ECB TO BE POSTED.  IT RETURNS TO THE 00000680
*   CALLER IF THE SYSTEM PASSED A REASON CODE OF ZERO, THAT IS, THE     00000681
*   XPCC CONNECTION IS ERROR FREE.                                      00000682
*   FOR A NON-ZERO REASON CODE, THE ROUTINE DISPLAYS A DIAGNOSTIC       00000683
*   MESSAGE AND TERMINATES WITH OR WITHOUT A DUMP.                      00000684
*                                                                       00000685
WAITSECB DS    0H                                                       00000686
         LA    R3,IJBXSECB         LOAD ADDRESS OF SEND COMPLETION ECB  00000687
         WAIT  (R3)                WAIT FOR COMPLETION  OF SENDR        00000688
         CLI   IJBXREAS,REASOK     DID ANY CONNECTION ERROR OCCUR ?     00000689
         BER   RD                  .. NO, THEN RETURN TO CALLER         00000690
*                                                                       00000691
BADREAS  DS    0H                                                       00000692
         TM    IJBXREAS,IJBXABDC   DID POWER TERMINATE ABNORMALLY ?     00000693
         BO    ABNPOW              .. YES, GIVE MESSAGE AND GO TO EOJ   00000694
         MVC   FAILFUNC,=C'SENDR  '    INSERT 'SENDR ' INTO MSG TEXT    00000695
         BAL   RE,MSGREAS          FILL XPCC REASON CODE INTO MSG       00000696
TERMCONN DS    0H                                                       00000697
         BAL   RE,MSGRCFB          PUT POWER RETURN/FEEDBACK TO MSG     00000698
         BAL   RE,MSGDSPLY         DISPLAY DIAGNOSTIC MESSAGE           00000699
         CLI   PXPRETCD,PXPRCPVL   POWER RC = PROTOCOL VIOLATION?       00000700
         BE    FINDUMP             .. YES, USER ERROR                   00000701
         MVI   PRETCOD+2,C'8'      $RC 8                                00000702
         B     DISCT               SYSTEM ERROR OCCURED        @D23QDIR 00000703
*                                                                       00000704
*********************************************************************** 00000705
**                D E F I N I T I O N S                              ** 00000706
*********************************************************************** 00000707
*                                                                       00000708
TRTAB    EQU   *-240               ENTRY POINT FOR TRANSLATE TABLE      00000709
         DC    X'F0F1F2F3F4F5F6F7F8F9C1C2C3C4C5C6' TRANSLATE TABLE      00000710
*                                                                       00000711
JOBNUM   DC    H'0'                JOBNUM FOR PWRSPL                    00000712
EIGHTDC  DC    X'08'               BYTE TO TEST RETURN CODE             00000713
HELP     DC    CL3' '              FIELD FOR UNPACK RET CODE            00000714
*                                                                       00000715
WAITLIST DC    A(INTECB)           INTECB = 1ST ELEMENT OF WAITLIST     00000716
LISTCECB DC    A(0)                IJBXCECB = 2ND ELEM. OF WAITLIST     00000717
LISTEND  DC    X'FF'               INDICATE END OF WAITLIST             00000718
INTECB   DS    F                   ECB USED TO WAIT FOR TIMER INTERVALS 00000719
*                                                                       00000720
EIGHT    EQU   X'08'               RETURN CODE X'08'                    00000721
POSTBIT  EQU   X'80'               MASK FOR A POSTED ECB                00000722
REASOK   EQU   X'00'               ZERO VSE/AF REASON CODE              00000723
* --------------------------------------------------------------------  00000724
DBL      DS    D                                                        00000725
SAVEAREA DS    18F                                                      00000726
NEXTREC  DS    F                   NEXT RECORD ADDRESS                  00000727
ENDBUF   DS    F                   END BUFFER ADDRESS                   00000728
RECLEN   DS    F                   RECORD LENGTH 80/132                 00000729
PARMADDR DS    F                                                        00000730
*                                                                       00000731
PARMS    DS    0CL102                                                   00000732
PFUNC    DS    CL3                 FUNCTION GET/SUB                     00000733
         DS    C                                                        00000734
PBUFADR  DS    F                   BUFFER ADDRESS                       00000735
PNORL    DS    F                   NO RECORDS                           00000736
PENDBUF  DS    F                   END BUFFER ADDRESS                   00000737
PWRQUEUE DS    CL3                 QUEUE                                00000738
PWRJOB   DS    CL14                JOBNAME,JOBNUM                       00000739
         DS    CL14                                                     00000740
PRETCOD  DS    CL3                                                      00000741
PMSG     DS    CL52                ERROR MSG                            00000742
**********************************************************************@ 00000743
*            DEFINITIONS FOR PUT,CTL AND GET REQUEST                 *@ 00000744
**********************************************************************@ 00000745
M1       EQU   1                   MASK BIT SETTING                   @ 00000746
M7       EQU   7                   MASK BIT SETTING                   @ 00000747
ZERO     EQU   0                                                      @ 00000748
ONE      EQU   1                                                      @ 00000749
BUFPTR   EQU   10                  USE RA AS BUFPOINTER               @ 00000750
DATAPTR  EQU   11                  USE RB AS DATA POINTER             @ 00000751
BUFLN    EQU   12                  USE RC TO CALC REMAINING BUFLEN    @ 00000752
*                                                                       00000753
GETFCT   DC    C' '                FIELD TO IDENTIFY GET AS CALLER OF @ 00000754
*                                                           DATDSPLY  @ 00000755
SAVJNUM  DS    CL5                                                      00000756
SAVCLAS  DS    CL1                                                      00000757
JOBCMD   DS    0CL130              COMMAND AT ITS MAXIMUM LENGTH, TER-  00000758
*                                  MINATED WITH AT LEAST ONE BLANK      00000759
CMDHEAD  DC    CL9'PDISPLAY '      FIXED START OF COMMAND               00000760
CMDQUEUE DC    C'XXX,'             QUEUE TYPE                           00000761
CMDBODY  DC    CL117' '            DYNAMIC BODY/END OF COMMAND          00000762
*********************************************************************** 00000763
*            MESSAGE AREA FOR FAILING MACRO CALLS                     * 00000764
*********************************************************************** 00000765
FAILMSG  DS    0CL72                                                    00000766
F1       DC    C'FUNC='                                                 00000767
FAILFUNC DC    CL8' '              REQUESTED FUNCTION                   00000768
F2       DC    C' FAILED AT: '                                          00000769
FAILLABL DC    CL5' '              CODE LABEL OF FAILING FUNCTION       00000770
F3       DC    C'  VSE-RETC/REAS='                                      00000771
FAILRETC DC    CL2'00'             RETURN CODE RECEIVED IN IJBXRETC     00000772
F4       DC    C'/'                                                     00000773
FAILREAS DC    CL2'00'             REASON CODE RECEIVED IN IJBXREAS     00000774
F5       DC    C' PWR-RC/FDBK='                                         00000775
FAILPWRC DC    CL2'00'             VSE/POWER RETURN CODE IN IJBXRUSR    00000776
F6       DC    C'/'                                                     00000777
FAILPWFB DC    CL2'00'             VSE/POWER FEEDBACK CODE IN IJBXRUSR  00000778
F7       DC    CL3' '                                                   00000779
         DC    CL8' '                                                   00000780
*                                                                       00000781
FAILM1   DC    CL72'VSE/POWER ALREADY IN TERMINATION, NO MORE CONNECTIO*00000782
               N REQUEST ACCEPTED'                                      00000783
FAILM2   DC    CL72'VSE/POWER ABNORMAL TERMINATION, CONNECTION DISRUPTE*00000784
               D'                                                       00000785
FAILM3   DC    CL72'CONNECTION COULD NOT BE COMPLETED WITHIN 1 MINUTE'  00000786
*********************************************************************** 00000787
*        CROSS PARTITION CONTROL BLOCK                                * 00000788
*********************************************************************** 00000789
*                                                                       00000790
OWNXPCCB XPCCB APPL=VSEPWRS,TOAPPL=SYSPWR,                             *00000791
               BUFFER=(SENDBUF,400),REPAREA=(REPLBUF,500)               00000792
*********************************************************************** 00000793
*        STORAGE RESERVATION FOR  XPCC SEND AND REPLY BUFFER          * 00000794
*********************************************************************** 00000795
SENDBUF  DS    CL400              BUFFER USED FOR XPCC SENDR TO POWER   00000796
LASTPREC DC    A(SENDBUF+L'SENDBUF-RECPRFXL-80) LAST POSSIBLE           00000797
*                                 RECORD THAT FITS INTO SEND BUFFER     00000798
REPLBUF  DS    CL500              BUFFER FOR RECEIPT OF DATA FROM POWER 00000799
*********************************************************************** 00000800
         LTORG                                                          00000801
**********************************************************************@ 00000802
**      >>          GENERATE   S P L                  <<             *@ 00000803
**       THIS SPL IS LATER ON UPDATED IN ORDER TO INDICATE A         *@ 00000804
**       GET, PUT, OR CTL REQUEST WITH THE DESIRED PARAMETERS        *@ 00000805
**********************************************************************@ 00000806
*                                                                       00000807
OWNSPL   PWRSPL TYPE=GEN,USERID=VSEPWRS,PRFX=OWN,PWD=PWRMPWD  <======   00000808
*********************************************************************** 00000809
*        DUMMY SECTION OF  VSE/POWER SPOOL PARAMETER LIST (SPL)       * 00000810
*********************************************************************** 00000811
*                                                                       00000812
OWNSPLDS PWRSPL TYPE=MAP                                                00000813
*********************************************************************** 00000814
*        DUMMY SECTION OF  CROSS PARTITION CONTROL BLOCK  (XPCCB)     * 00000815
*********************************************************************** 00000816
*                                                                       00000817
         MAPXPCCB                                                       00000818
*********************************************************************** 00000819
*        GENERAL EQUATES                                              * 00000820
*********************************************************************** 00000821
R0       EQU   0                   WORK REGISTER                        00000822
R1       EQU   1                   WORK REGISTER + USED BY PWRSPL MACRO 00000823
R2       EQU   2                   WORK REGISTER                        00000824
R3       EQU   3                   WORK REGISTER                        00000825
R4       EQU   4                   ADDR REG FOR XPCCB DSECT             00000826
R5       EQU   5                   ADDR REG FOR USER DATA TO BE SENT    00000827
R6       EQU   6                   ADDR REG FOR RECEIVED USER DATA      00000828
R7       EQU   7                   ADDR REG FOR SPL DSECT               00000829
R8       EQU   8                   BASE REGISTER OF VSEPWRS             00000830
R9       EQU   9                   WORK REGISTER                        00000831
RA       EQU   10                  WORK REGISTER                        00000832
RB       EQU   11                  WORK REGISTER                        00000833
RC       EQU   12                  WORK REGISTER                        00000834
RD       EQU   13                  BRANCH AND LINK REGISTER FOR SENDR   00000835
RE       EQU   14                  BRANCH AND LINK REG. FOR DATDSPLY    00000836
RF       EQU   15                  MACRO CALL RETURN CODE REGISTER      00000837
         END                                                            00000838
/*                                                                      00000839
// EXEC IESINSRT                                                        00000840
/*                                                                      00000841
#&                                                                      00000842
* $$ END                                                                00000843
/&                                                                      00000844
* $$ EOJ                                                                00000845
