TITLE  'ICATS CAT COMMAND ROUTINE'                             CAT00010
*********************************************************************** CAT00020
*                                                                     * CAT00030
*  MODULE NAME =  CAT                                                 * CAT00040
*                                                                     * CAT00050
*  FUNCTION =  DO A LISTFILE ON THE SPECIFIED USER'S MINIDISK         * CAT00060
*              AND SHIP THE SPECIFIED NUMBER OF BYTES TO THE          * CAT00070
*              REQUESTOR AT THE UTS MACHINE.                          * CAT00080
*                                                                     * CAT00090
*  ENTRY POINTS =  CAT                                                * CAT00100
*                                                                     * CAT00110
*  LINKAGE =  BALR R14,R15 FROM ICATS MAINLINE.                       * CAT00120
*                                                                     * CAT00130
*  REGISTER CONTENTS UPON ENTRY =                                     * CAT00140
*      R2  = POINTS TO THE ICATS COMMON DATA AREA, AS ALWAYS.         * CAT00150
*      R14 = RETURN ADDRESS BACK TO ICATS MAINLINE                    * CAT00160
*      R15 = ENTRY POINT TO THIS MODULE                               * CAT00170
*                                                                     * CAT00180
*  REGISTER USAGE =                                                   * CAT00190
*      R0-R1 = USED TO PASS PARAMETERS TO SUBROUTINES.                * CAT00200
*      R2 =  USED TO ADDRESS THE ICATS COMMON DATA AREA.              * CAT00210
*      R3 =  FREE                                                     * CAT00220
*      R4 =  USED TO ADDRESS CURRENT UTS CONTROL BLOCK.               * CAT00230
*      R5 =  USED TO ADDRESS CURRENT USER CONTROL BLOCK.              * CAT00240
*      R6 =  USED TO ADDRESS CURRENT DISK CONTROL BLOCK.              * CAT00250
*      R11 = MY BASE REGISTER                                         * CAT00260
*      R14 = MY RETURN ADDRESS WHEN I CALL SOMEBODY                   * CAT00270
*      R15 = SUBROUTINE ADDRESS                                       * CAT00280
*                                                                     * CAT00290
*                                                                     * CAT00300
*  MODULE LOGIC:                                                      * CAT00310
*      1)  INSURE THIS REQUEST CAME FROM A UTS.  IF NOT,              * CAT00320
*          GIVE A REJECTION NOTICE.                                   * CAT00330
*      2)  CALL THE ACCESS ROUTINE TO                                 * CAT00340
*          A)  LOCATE THE CORRECT UTSCB,                              * CAT00350
*          B)  LOCATE THE CORRECT USERCB,                             * CAT00360
*          C)  LOCATE THE CORRECT DISKCB,                             * CAT00370
*          D)  AND TO ACCESS THE CORRECT MINIDISK.                    * CAT00380
*      3)  CHECK THE READ PASSWORD THE UTS USER SUPPLIED WITH         * CAT00390
*          THE ONE HE'S SUPPOSE TO SUPPLY FOR THIS MINIDISK.          * CAT00400
*          A)  CL8'ALL' = HE DOESN'T NEED A PASSWORD TO READ IT.      * CAT00410
*          B)  CL8'NONE' = HE CAN'T READ IT NO MATTER WHAT PASSWORD   * CAT00420
*                          HE GAVE US.                                * CAT00430
*          C)  ELSE VERIFY THE PASSWORD HE GAVE US.                   * CAT00440
*      4)  DO THE CMS COMMAND LISTFILE WITH THE STACK AND DATE        * CAT00450
*          OPTIONS.  THIS'LL STACK N LINES WHICH I'LL THEN READ.      * CAT00460
*          IF ERROR WITH THE LISTFILE COMMAND (ONLY POSSIBLE          * CAT00470
*          ERROR IS RC = 24 = FILE NOT FOUND), THEN QUIT.             * CAT00480
*      5)  START READING THE STACKED LINES.  SINCE THE LISTFILE       * CAT00490
*          COMMAND STACKS THE LINES LIFO, IT'S IN REVERSE             * CAT00500
*          ALPHABETICAL ORDER.  I'LL HAVE TO RE-REVERSE THEM.         * CAT00510
*      6)  GIVE DATA TO THE UTS MACHINE.  IF HE DIDN'T ALLOCATE       * CAT00520
*          ENOUGH ROOM FOR THIS REPLY, GIVE HIM A BAD RETURN CODE.    * CAT00530
*          ELSE, RETURN CODE = 0.                                     * CAT00540
*          INCLUDE - # FILES SATISFYING CAT SEARCH ARGUMENTS          * CAT00550
*                  - # COMPLETE FILES YOU GOT WITH THIS CAT REQUEST   * CAT00560
*                  - # BYTES IN REPLY FOR COMPLETE FILES              * CAT00570
*                  - # BYTES YOU ACTUALLY GAVE TO THE UTS             * CAT00580
*                                                                     * CAT00590
*  NORMAL EXIT =                                                      * CAT00600
*      R15 = 0                                                        * CAT00610
*                                                                     * CAT00620
*  EXTERNAL REFERENCES = NONE                                         * CAT00630
*                                                                     * CAT00640
*  MACROS =  ICDATA = ICATS COMMON DATA AREA                          * CAT00650
*            ETTE   = ENTER TRACE TABLE ENTRY SUBROUTINE              * CAT00660
*                                                                     * CAT00670
*  CHANGE ACTIVITY                                                    * CAT00680
*    DATE        NAME       REASON FOR CHANGE                         * CAT00690
*  03/29/83  RICK JASPER    INITIAL PROGRAM CREATION                  * CAT00700
*                                                                     * CAT00710
*********************************************************************** CAT00720
         PRINT   GEN,NODATA                                             CAT00730
CAT      CSECT                                                          CAT00740
         USING ICDATA,R2            ADDRESS ICATS COMMON DATA AREA      CAT00750
         USING NUCON,R0          NUCON DOESN'T NEED A BASE REGISTER     CAT00760
         USING CBUTS,R4          USE R4 TO ADDRESS UTS CONTROL BLOCK    CAT00770
         USING CBUSER,R5         USE R5 TO ADDRESS USER CONTROL BLOCK   CAT00780
         USING CBDISK,R6         USE R6 TO ADDRESS DISK CONTROL BLOCK   CAT00790
         USING *,R15      USE R15 FOR BASE REG NEXT INSTRUCTION ONLY    CAT00800
         STM   R0,R14,REGSAVE       SAVE CALLER'S REGISTERS             CAT00810
         DROP  R15                                                      CAT00820
         USING CAT,R11              R11 WILL BE BASE REGISTER           CAT00830
         LR    R11,R15              ESTABLISH BASE REGISTER             CAT00840
         LA    R13,SAVEAREA         MY 20 FULLWORD SAVE AREA            CAT00850
*                                                                       CAT00860
*    CAT COMMANDS CAN ONLY COME FROM A UTS MACHINE                      CAT00870
         TM    FLAGB,UTSCMD      DID THIS COMMAND COME FROM A UTS ??    CAT00880
         BO    CATCONT           YEP, GOOD.  CONTINUE ON.               CAT00890
         L     R15,AREJECT       ELSE, REJECT THIS COMMAND.             CAT00900
         BALR  R14,R15                                                  CAT00910
         B     QUICKBYE                                                 CAT00920
*    SET UP THE REPLY CONTROL BLOCK AND INITIALIZE ALL THE PARMS THAT   CAT00930
*    GET SENT IN IT.  THE REPLY CB WILL PRECEDE THE DATA.  THIS ALSO    CAT00940
*    FREES THE PARM1-PARM15 AREA FOR ME TO USE LATER TO PARSE INTO.     CAT00950
CATCONT  L     R9,ABUFFER        THE REPLY CONTROL BLOCK CONSISTS       CAT00960
         MVC   0(128,R9),PARM0   MOSTLY OF THE REQUEST CONTROL BLOCK.   CAT00970
         ST    R9,AOUTDATA       REMEMBER WHERE IT IS IN CASE OF ERROR  CAT00980
         XC    UTSPARMS,UTSPARMS       CLEAR ALL THE PARMS AT ONCE      CAT00990
*    PREPARE FOR ACCESS ROUTINE.                                        CAT01000
         MVC   THISUSER,PARM0    MOVE IN UTS USER ID                    CAT01010
         MVC   THISDISK,PARM6    MOVE IN THE DISK HE WANTED             CAT01020
         L     R15,AACCESS       GET ADDRESS OF ACCESS ROUTINE          CAT01030
         BALR  R14,R15           GO FIND ALL THE CONTROL BLOCKS         CAT01040
*    UPON RETURN, IF THERE WAS AN ERROR, THEN R15 > 0,                  CAT01050
*                 ELSE R15 = 0 AND R4, R5, AND R6 ALL POINT TO THE      CAT01060
*                 CORRECT UTSCB, USERCB, AND DISKCB RESPECTIVELY.       CAT01070
         LTR   R15,R15                                                  CAT01080
         BNZ   CATERRA           GO FIGURE OUT WHAT THE ERROR WAS       CAT01090
*    CONVERT THE-NUMBER-OF-BYTES-THE-UTS-USER-WANTS TO A HEX NUMBER     CAT01100
         LA    R1,PARM3       PARM 3 = NUMBER OF BYTES THE UTS WANTS    CAT01110
         L     R15,ACONDEC    GET ADDRESS OF DECIMAL CONVERSION ROUTINE CAT01120
         BALR  R14,R15        GO CONVERT PARM TO NORMAL NUMBER          CAT01130
         LTR   R15,R15        DID THE CONVERSION GO OK ??               CAT01140
         BNE   CATERRB        NOPE, GO FIGURE OUT WHY                   CAT01150
         ST    R0,NUMWANTS    REMEMBER IT                               CAT01160
*    NOW CHECK THE READ PASSWORD THIS GUY GAVE ME FOR THIS DISK         CAT01170
         CLC   CBDSKRPW,=CL8'ALL'    DOES HE REQUIRE A PASSWORD ??      CAT01180
         BE    CATCONA               NOPE, CONTINUE ON                  CAT01190
         CLC   CBDSKRPW,=CL8'NONE'   IS HE ALLOWED TO READ THIS DISK ?  CAT01200
         BE    CANTREAD              NOPE, TELL HIM SO                  CAT01210
         CLC   CBDSKRPW,PARM7   NOT SPECIAL CASE - COMPARE PASSWORD     CAT01220
         BNE   WRONGPW          PASSWORD IS INCORRECT                   CAT01230
CATCONA EQU   *                                                         CAT01240
*    OK, THE PASSWORD CHECKS.  NOW LET'S DO THE LISTFILE COMMAND.       CAT01250
         MVC   CMDFN,PARM4           MOVE THE FILE ID INTO THE          CAT01260
         MVC   CMDFT,PARM5           LISTFILE COMMAND STRING            CAT01270
         MVC   CMDFM(1),PARM6                                           CAT01280
         LA    R1,LISTCMD                                               CAT01290
         SVC   202             DO THE LISTFILE COMMAND                  CAT01300
         DC    AL4(*+4)                                                 CAT01310
         LTR   R15,R15         DID EVERYTHING GO OK ??                  CAT01320
         BNZ   CATERRC         NOPE, GO FIGURE OUT WHAT WENT WRONG      CAT01330
*    SINCE THE RESPONSE FROM THE LISTFILE COMMAND IS STACKED IN         CAT01340
*    REVERSE ALPHABETICAL ORDER, THEN I'M GOING TO HAVE TO PUT          CAT01350
*    LINES FROM THE BOTTOM OF MEMORY AND WORK UP TOWARD THE REPLY       CAT01360
*    CONTROL BLOCK.  SO, FIGURE OUT WHERE TO START PUTTING THE          CAT01370
*    LISTFILE RESPONSE LINES.                                           CAT01380
         L     R3,ABUFFER      GET START OF OUTPUT BUFFER               CAT01390
         A     R3,LBUFFER      ADD ITS LENGTH TO GET END OF BUFFER      CAT01400
         SH    R3,=H'64'       BACK UP LENGTH OF ONE LINE               CAT01410
         N     R3,=X'FFFFFF40'      START ON EVEN 64-BYTE BOUNDARY      CAT01420
*    NOW, R3 = ADDRESS OF WHERE THE FIRST (LAST ALPHABETICALLY) LINE    CAT01430
*    SHOULD BE PUT.  START READING THE LINES UNTIL THE CONSOLE          CAT01440
*    STACK IS EXHAUSTED, PARSING THE LINE, AND PUTTING THE RESPONSE     CAT01450
*    IN THE OUTPUT BUFFER, BACKING UP R3 ON EACH REPETITION AND         CAT01460
*    KEEPING A COUNT OF THE NUMBER OF LINES YOU PROCESS IN R12.         CAT01470
         L      R12,ABUFFER         IN THE IMPOSSIBLE CHANCE THAT       CAT01480
         LA     R12,128(R12)        WE FILL OUR OUTPUT BUFFER, USE      CAT01490
         ST     R12,BUFRFILD        THIS TO CHECK R3 AS WE GO           CAT01500
         SR     R12,R12             INITIALIZE COUNTER                  CAT01510
CATLOOP  EQU    *                                                       CAT01520
         CLC    NUMFINRD,=X'0000'                                       CAT01530
         BE     EXITLOOP                                                CAT01540
         C      R3,BUFRFILD         WE SHOULD NEVER OVERFILL OUR        CAT01550
         BL     QUITLOOP            BUFFER, BUT IF WE DO, .......       CAT01560
         RDTERM INBUFR                                                  CAT01570
         LA     R12,1(R12)          BUMP LINE COUNTER                   CAT01580
         STC    R0,INBUFRL        SAVE LINE LENGTH                      CAT01590
         LA     R0,PARM1          PUT TOKENS IN PARM1-15 (WHY NOT?)     CAT01600
         LA     R1,INBUFRL        GET ADDRESS OF LINE LENGTH & DATA     CAT01610
         L      R15,APARSE        GO PARSE THIS LINE AND PUT IN         CAT01620
         BALR   R14,R15           PARM1 - PARM15                        CAT01630
*    AT THIS POINT, THIS UNSTACKED LINE IS PARSED, SITTING IN PARM1     CAT01640
*    THROUGH PARM15.  STARTING WITH PARM1, WE'VE GOT THE FILE NAME,     CAT01650
*    THE FILE TYPE, FILE MODE, C'F' OR C'V', LRECL, # RECORDS IN THE    CAT01660
*    FILE, # CMS BLOCKS IT TAKES UP (WHICH WE DON'T NEED), DATE, AND    CAT01670
*    TIME.                                                              CAT01680
*         THERE'S AN INCOMPATIBILITY PROBLEM BETWEEN CMS FILES FROM     CAT01690
*    RELEASE 6 TO RELEASE 5 OF CMS (THIS IS TO THE BEST OF MY KNOW-     CAT01700
*    LEDGE) WHERE THE DATE COULD BE BLANK.  THIS MEANS THAT PARM8,      CAT01710
*    WHICH IS USUALLY THE DATE, COULD BE THE TIME INSTEAD.  IF THIS     CAT01720
*    IS THE CASE, THEN I'LL BLANK OUT THE DATE, AND PUT PARM8 WHERE     CAT01730
*    THE TIME GOES.                                                     CAT01740
         MVC    0(48,R3),PARM1    MOVE FILE NAME THROUGH # RECORDS      CAT01750
         CLI    PARM8+1,C':'      TIME IS IN THE FORMAT 1:00 OR 11:00   CAT01760
         BE     CATCONB           SO, LOOK FOR C':' IN BOTH PLACES      CAT01770
         CLI    PARM8+2,C':'                                            CAT01780
         BE     CATCONB                                                 CAT01790
*    NORMAL CASE.  DATE MUST BE OK.                                     CAT01800
         MVC    48(16,R3),PARM8        MOVE DATE AND TIME               CAT01810
         B      CATCONC                                                 CAT01820
*    ABNORMAL CASE.  DATE WASN'T THERE.                                 CAT01830
CATCONB  EQU   *                                                        CAT01840
         MVC    48(8,R3),=CL8' '       MAKE DATE ALL BLANKS             CAT01850
         MVC    56(8,R3),PARM8         MOVE IN TIME                     CAT01860
CATCONC  EQU   *                                                        CAT01870
         SH    R3,=H'64'     PREPARE OUTPUT LINE POINTER FOR NEXT LINE  CAT01880
         B     CATLOOP                                                  CAT01890
QUITLOOP EQU   *             WE'VE FILLED OUR OUTPUT BUFFER - ABORT     CAT01900
         MVC   RETCODE,=X'00005014'      GIVE BAD RETURN CODE AND       CAT01910
CATLOOP2 EQU    *                        FLUSH OUT THE PROGRAM STACK    CAT01920
         CLC    NUMFINRD,=X'0000'                                       CAT01930
         BE     EXITLOOP                                                CAT01940
         RDTERM INBUFR                                                  CAT01950
         LA     R12,1(R12)          BUMP LINE COUNTER                   CAT01960
         B      CATLOOP2                                                CAT01970
EXITLOOP EQU   *                                                        CAT01980
*    AT THIS POINT, ALL THE STACKED LINES FROM THE LISTFILE COMMAND     CAT01990
*    HAVE BEEN UNSTACKED AND PUT IN THE OUTPUT BUFFER.                  CAT02000
*    R3 = 64 BYTES BEFORE THE LAST LINE WE PUT IN THE OUTPUT BUFFER     CAT02010
*    NOW MOVE THE REPLY CONTROL BLOCK UP TO THE OUTPUT DATA, COMPUTE    CAT02020
*    THE VARIABLES THAT GO IN THE REPLY CONTROL BLOCK, AND FINISH UP.   CAT02030
*        MAX#R  = R12                                                   CAT02040
*        GAVE#B = SMALLER OF (64 * MAX#R) OR NUMWANTS                   CAT02050
*        DONE#R = GAVE#B / 64                                           CAT02060
*        DONE#B = DONE#R * 64                                           CAT02070
         ST    R12,MAX#R         SAVE NUMBER OF FILES FOUND             CAT02080
         SH    R3,=H'64'         BACK UP TO WHERE THE REPLY CB GOES     CAT02090
         L     R9,ABUFFER                                               CAT02100
         MVC   0(128,R3),0(R9)   MOVE REPLY CB TO OUTPUT DATA           CAT02110
         ST    R3,AOUTDATA       REMEMBER WHERE IT STARTS               CAT02120
         L     R3,MAX#R                                                 CAT02130
         SLL   R3,6                                                     CAT02140
         CLC   RETCODE,=F'0'     IF ALREADY NON-ZERO RETURN CODE,       CAT02150
         BNE   CATCOND           THEN DON'T CHANGE IT.                  CAT02160
         C     R3,NUMWANTS                                              CAT02170
         BNH   CATCOND                                                  CAT02180
         L     R3,NUMWANTS              HE DIDN'T ASK FOR ENOUGH BYTES  CAT02190
         MVC   RETCODE,=X'00000004'     SO, SOME DATA WILL BE LOST      CAT02200
CATCOND  EQU   *                                                        CAT02210
         ST    R3,GAVE#B                                                CAT02220
         SRL   R3,6                                                     CAT02230
         ST    R3,DONE#R                                                CAT02240
         SLL   R3,6                                                     CAT02250
         ST    R3,DONE#B                                                CAT02260
CATBYE   EQU   *                                                        CAT02270
*    ALL THE WORK SHOULD BE DONE AT THIS POINT.  NOW FILL IN THE        CAT02280
*    REPLY CONTROL BLOCK WITH ALL THE DATA YOU'VE BEEN COLLECTING.      CAT02290
*    1)  THE VARIABLES GET PUT AT THE END OF THE REPLY                  CAT02300
*        CONTROL BLOCK LIKE SO (ALL IN HEX)                             CAT02310
*    |     |     |     |     |     |     |     |     |                  CAT02320
*    |     |     |     |     |     |     |     |     |                  CAT02330
*    |-----------------------------------------------|                  CAT02340
*    |        TODAY'S DATE IN MM/DD/YY FORMAT        |                  CAT02350
*    |-----------------------------------------------|                  CAT02360
*    |        CURRENT TIME IN HH:MM:SS FORMAT        |                  CAT02370
*    |-----------------------------------------------|                  CAT02380
*    |        DONE#B         |   DONE#R  |   MAX#R   |                  CAT02390
*    |-----------------------------------------------|                  CAT02400
*    |  RETCODE  |              GAVE#B               |                  CAT02410
*    |-----------------------------------------------|                  CAT02420
         L     R9,AOUTDATA     POINT TO START OF REPLY CONTROL BLOCK    CAT02430
*-------------------------------------------------------------*         CAT02440
*    GET THE TIME AND DATE FROM CP                            *         CAT02450
*-------------------------------------------------------------*         CAT02460
         LA    R1,CPDATA           ADDRESS OF DATA FROM DIAG            CAT02470
         DIAG  R1,R0,X'000C'       REQUEST DATE AND TIME FROM CP        CAT02480
*-------------------------------------------------------------*         CAT02490
*    CPDATA IS NOW IN THE FORMAT OF                           *         CAT02500
*           DC    CL8'MM/DD/YY'                               *         CAT02510
*           DC    CL8'HH:MM:SS'                               *         CAT02520
*           DS    2D     THE REST IS JUNK                     *         CAT02530
*-------------------------------------------------------------*         CAT02540
         MVC    96(8,R9),CPDATA                                         CAT02550
         MVC   104(8,R9),CPDATA+8                                       CAT02560
         MVC   112(4,R9),DONE#B                                         CAT02570
         MVC   116(2,R9),DONE#R+2                                       CAT02580
         MVC   118(2,R9),MAX#R+2                                        CAT02590
         MVC   120(2,R9),RETCODE+2                                      CAT02600
*                                  I'M RESERVING 6 BYTES FOR GAVE#B     CAT02610
         XC    122(2,R9),122(R9)   'CAUSE THE LENGTH FIELD IN A CCW     CAT02620
         MVC   124(4,R9),GAVE#B    IS 6 BYTES.  ONE DAY WE MAY NEED IT. CAT02630
*                                                                       CAT02640
*    NOW GIVE ALL THE DATA TO THE UTS MACHINE.                          CAT02650
*                                                                       CAT02660
         L     R0,GAVE#B                                                CAT02670
         AH    R0,=H'128'                                               CAT02680
         L     R1,AOUTDATA                                              CAT02690
         L     R15,AWRITUTS                                             CAT02700
         BALR  R14,R15           IGNORE ANY ERRORS                      CAT02710
         EJECT                                                          CAT02720
*                                                                       CAT02730
QUICKBYE EQU   *                                                        CAT02740
         LM    R0,R14,REGSAVE    RESTORE CALLER'S REGISTERS             CAT02750
         BR    R14               GOODBYE.                               CAT02760
*                                                                       CAT02770
CANTREAD DS    0H                                                       CAT02780
*    THIS GUY TRIED TO DO A CAT ON A DISK THAT HAD A READ PASSWORD OF   CAT02790
*    C'NONE' MEANING THAT HE'S NOT ALLOWED TO READ IT (KINDA LIKE       CAT02800
*    WRITE-ONLY MEMORY).  RETCODE = X'2004'                             CAT02810
         MVC   RETCODE,=X'00002004'                                     CAT02820
         B     CATBYE                                                   CAT02830
         SPACE 4                                                        CAT02840
WRONGPW  DS    0H                                                       CAT02850
*    THIS GUY GAVE ME THE WRONG READ PASSWORD FOR THIS DISK.  THAT'S A  CAT02860
*    NO-NO.  RETCODE = X'1010'                                          CAT02870
         MVC   RETCODE,=X'00001010'                                     CAT02880
         B     CATBYE                                                   CAT02890
         EJECT                                                          CAT02900
CATERRA  DS    0H                                                       CAT02910
*    WE GOT AN ERROR FROM THE ACCESS ROUTINE.                           CAT02920
*    IF R15 = 04, THEN THIS UTS WAS NOT FOUND IN THE UTSCB CHAIN        CAT02930
*                 (CAN NEVER HAPPEN).  RETCODE = X'6004'                CAT02940
*    IF R15 = 08, THEN THIS USER WAS NOT FOUND IN THE USERCB CHAIN      CAT02950
*                 FOR THIS UTS.  RETCODE = X'4004'                      CAT02960
*    IF R15 = 12, THEN THIS DISK WAS NOT FOUND IN THE DISKCB CHAIN      CAT02970
*                 FOR THIS USER.  RETCODE = X'100C'                     CAT02980
*    IF R15 = 16, THEN THE DISK WAS FOUND, BUT THERE'S NOT A MINIDISK   CAT02990
*                 AT THAT ADDRESS (CONFIGURATION ERROR).                CAT03000
*                 RETCODE = X'4008'                                     CAT03010
*    IF R15 = 20, THEN SOME OTHER ERROR HAPPENED IN THE ACCESS          CAT03020
*                 ROUTINE.  RETCODE = X'5004'                           CAT03030
*    IF R15 = ??, THEN PROGRAMMING ERROR.  RETCODE = X'7004'            CAT03040
         C     R15,=F'4'                                                CAT03050
         BNE   ERRA1                                                    CAT03060
         MVC   RETCODE,=X'00006004'                                     CAT03070
         B     ERRABYE                                                  CAT03080
ERRA1    C     R15,=F'8'                                                CAT03090
         BNE   ERRA2                                                    CAT03100
         MVC   RETCODE,=X'00004004'                                     CAT03110
         B     ERRABYE                                                  CAT03120
ERRA2    C     R15,=F'12'                                               CAT03130
         BNE   ERRA3                                                    CAT03140
         MVC   RETCODE,=X'0000100C'                                     CAT03150
         B     ERRABYE                                                  CAT03160
ERRA3    C     R15,=F'16'                                               CAT03170
         BNE   ERRA4                                                    CAT03180
         MVC   RETCODE,=X'00004008'                                     CAT03190
         B     ERRABYE                                                  CAT03200
ERRA4    C     R15,=F'20'                                               CAT03210
         BNE   ERRA5                                                    CAT03220
         MVC   RETCODE,=X'00005004'                                     CAT03230
         B     ERRABYE                                                  CAT03240
ERRA5    MVC   RETCODE,=X'00007004'                                     CAT03250
ERRABYE  B     CATBYE                                                   CAT03260
         EJECT                                                          CAT03270
CATERRB  DS    0H                                                       CAT03280
*    WE GOT A BAD RETURN CODE WHILE CONVERTING THE NUMBER OF BYTES      CAT03290
*    THE UTS WANTS TO A BINARY NUMBER.  SO, I DON'T KNOW HOW MANY       CAT03300
*    BYTES TO READ.  RETCODE = X'1004'                                  CAT03310
         MVC   RETCODE,=X'00001004'                                     CAT03320
         B     CATBYE                                                   CAT03330
         SPACE 4                                                        CAT03340
CATERRC  DS    0H                                                       CAT03350
*    WE GOT AN ERROR DOING THE LISTFILE COMMAND.                        CAT03360
*    THE ONLY POSSIBLE ERROR IS                                         CAT03370
*        RC = 28 = FILE NOT FOUND          RETCODE = X'2008'            CAT03380
*    OTHER ERRORS SHOULD BE IMPOSSIBLE SO, RETCODE = X'6010'            CAT03390
         C     R15,=F'28'                                               CAT03400
         BNE   ERRB1          SHOULD NEVER TAKE THIS BRANCH             CAT03410
         MVC   RETCODE,=X'00002008'         FILE NOT FOUND              CAT03420
         B     ERRBBYE                                                  CAT03430
ERRB1    MVC   RETCODE,=X'00006010'                                     CAT03440
ERRBBYE  B     CATBYE                                                   CAT03450
         EJECT                                                          CAT03460
CPDATA   DS    4D                                                       CAT03470
REGSAVE  DS    15F       READ ROUTINE SAVE AREA                         CAT03480
SAVEAREA DS    20F       MY SAVE AREA FOR WHEN I CALL OTHER SUBROUTINES CAT03490
UTSPARMS DS    CL24      SENT TO THE UTS IN THE REPLY CONTROL BLOCK     CAT03500
BUFRFILD DS    F         LOWER LIMIT OF OUTPUT BUFFER                   CAT03510
AOUTDATA DS    F         ADDRESS OF REPLY CONTROL BLOCK & OUTPUT DATA   CAT03520
         ORG   UTSPARMS                                                 CAT03530
NUMWANTS DS    F         NUMBER OF BYTES THE UTS WANTS                  CAT03540
RETCODE  DS    F         RETURN CODE                                    CAT03550
GAVE#B   DS    F         NUMBER OF BYTES I GAVE HIM THIS TIME           CAT03560
DONE#B   DS    F         NUMBER OF BYTES IN COMPLETE FILES              CAT03570
DONE#R   DS    F         NUMBER OF COMPLETE FILES FOUND THIS TIME       CAT03580
MAX#R    DS    F         NUMBER OF FILES SATISFYING THIS CAT REQUEST    CAT03590
         ORG                                                            CAT03600
INBUFRL  DC    X'00'     LINE LENGTH FOR PARSE ROUTINE                  CAT03610
INBUFR   DS    CL130                                                    CAT03620
LISTCMD  DS    0D                                                       CAT03630
         DC    CL8'LISTFILE'                                            CAT03640
CMDFN    DC    CL8' '                                                   CAT03650
CMDFT    DC    CL8' '                                                   CAT03660
CMDFM    DC    CL8' '                                                   CAT03670
         DC    CL8'('                                                   CAT03680
         DC    CL8'DATE'                                                CAT03690
         DC    CL8'STACK'                                               CAT03700
         DC    8X'FF'                                                   CAT03710
         LTORG                                                          CAT03720
         ICDATA                                                         CAT03730
CAT      CSECT            GO BACK TO NORMAL CSECT                       CAT03740
         NUCON                                                          CAT03750
CAT      CSECT            GO BACK TO NORMAL CSECT                       CAT03760
         END                                                            CAT03770