TITLE  'READ-A-CMS-FILE-AND-SHIP-IT-TO-A-UTS ROUTINE'          REA00010
*********************************************************************** REA00020
*                                                                     * REA00030
*  MODULE NAME =  READ                                                * REA00040
*                                                                     * REA00050
*  FUNCTION =  READ THE SPECIFIED CMS FILE ON THE USER'S MINIDISK     * REA00060
*              AND SHIP THE SPECIFIED NUMBER OF BYTES TO THE          * REA00070
*              REQUESTOR AT THE UTS MACHINE.                          * REA00080
*                                                                     * REA00090
*  ENTRY POINTS =  READ                                               * REA00100
*                                                                     * REA00110
*  LINKAGE =  BALR R14,R15 FROM ICATS MAINLINE.                       * REA00120
*                                                                     * REA00130
*  REGISTER CONTENTS UPON ENTRY =                                     * REA00140
*      R2  = POINTS TO THE ICATS COMMON DATA AREA, AS ALWAYS.         * REA00150
*      R14 = RETURN ADDRESS BACK TO ICATS MAINLINE                    * REA00160
*      R15 = ENTRY POINT TO THIS MODULE                               * REA00170
*                                                                     * REA00180
*  REGISTER USAGE =                                                   * REA00190
*      R0-R1 = USED TO PASS PARAMETERS TO SUBROUTINES.                * REA00200
*      R2 =  USED TO ADDRESS THE ICATS COMMON DATA AREA.              * REA00210
*      R3 =  USED TO TEMPORARILY ADDRESS THE FILE STATUS TABLE (FST). * REA00220
*      R4 =  USED TO ADDRESS CURRENT UTS CONTROL BLOCK.               * REA00230
*      R5 =  USED TO ADDRESS CURRENT USER CONTROL BLOCK.              * REA00240
*      R6 =  USED TO ADDRESS CURRENT DISK CONTROL BLOCK.              * REA00250
*      R11 = MY BASE REGISTER                                         * REA00260
*      R14 = MY RETURN ADDRESS WHEN I CALL SOMEBODY                   * REA00270
*      R15 = SUBROUTINE ADDRESS                                       * REA00280
*                                                                     * REA00290
*                                                                     * REA00300
*  MODULE LOGIC:                                                      * REA00310
*      1)  CALL THE ACCESS ROUTINE TO                                 * REA00320
*          A)  LOCATE THE CORRECT UTSCB,                              * REA00330
*          B)  LOCATE THE CORRECT USERCB,                             * REA00340
*          C)  LOCATE THE CORRECT DISKCB,                             * REA00350
*          D)  AND TO ACCESS THE CORRECT MINIDISK.                    * REA00360
*      2)  CHECK THE READ PASSWORD THE UTS USER SUPPLIED WITH         * REA00370
*          THE ONE HE'S SUPPOSE TO SUPPLY FOR THIS MINIDISK.          * REA00380
*          A)  CL8'ALL' = HE DOESN'T NEED A PASSWORD TO READ IT.      * REA00390
*          B)  CL8'NONE' = HE CAN'T READ IT NO MATTER WHAT PASSWORD   * REA00400
*                          HE GAVE US.                                * REA00410
*          C)  ELSE VERIFY THE PASSWORD HE GAVE US.                   * REA00420
*      3)  MAKE SURE THE FILE EXISTS ON THE MINIDISK.  DO A FSSTATE.  * REA00430
*      4)  START READING WITH THE SPECIFIED RECORD NUMBER (GIVEN IN   * REA00440
*          THE REQUEST CONTROL BLOCK (RCB)).  DO A FSPOINT.           * REA00450
*      5)  START READING THE CMS FILE, PUTTING THE DATA INTO THE      * REA00460
*          SPECIFIED OUTPUT RECORD FORMAT (FIXED BLOCK, VARIABLE      * REA00470
*          LENGTH, OR SOURCE FORMAT).  STOP WHEN THE SPECIFIED        * REA00480
*          NUMBER OF BYTES ARE READ OR UNTIL THE END OF FILE IS       * REA00490
*          REACHED.                                                   * REA00500
*      6)  COLLECT THE ENDING STATUS INFORMATION TO RETURN TO THE     * REA00510
*          UTS.  INCLUDE NUMBER OF BYTES FOR COMPLETE RECORDS IN      * REA00520
*          OUTPUT DATA, NUMBER OF COMPLETE RECORDS (OR BLOCKS IF      * REA00530
*          SOURCE FORMAT), AND BIGGEST RECORD FOUND IN CMS FILE.      * REA00540
*      7)  GIVE REPLY AND DATA TO THE UTS MACHINE.                    * REA00550
*                                                                     * REA00560
*  NORMAL EXIT =                                                      * REA00570
*      R15 = 0                                                        * REA00580
*                                                                     * REA00590
*  EXTERNAL REFERENCES = NONE                                         * REA00600
*                                                                     * REA00610
*  MACROS =  ICDATA = ICATS COMMON DATA AREA                          * REA00620
*            ETTE   = ENTER TRACE TABLE ENTRY SUBROUTINE              * REA00630
*                                                                     * REA00640
*  CHANGE ACTIVITY                                                    * REA00650
*    DATE        NAME       REASON FOR CHANGE                         * REA00660
*  02/11/83  RICK JASPER    INITIAL PROGRAM CREATION                  * REA00670
*  05/05/83  RICK JASPER    ADDED SUPPORT FOR UTS SOURCE FORMAT       * REA00680
*  08/23/83  RICK JASPER    IF UTS USER ASKS TO READ A FILE WHOSE     * REA00690
*                           NAME STARTS WITH A CENT SIGN, THEN LOOK   * REA00700
*                           FOR A CMS FILE WHOSE FILENAME STARTS      * REA00710
*                           WITH A POUND SIGN.  THE UTS FILE SYSTEM   * REA00720
*                           LIKES CENT SIGN, CMS DOESN'T.             * REA00730
*                                                                     * REA00740
*********************************************************************** REA00750
         PRINT GEN,NODATA                                               REA00760
READ     CSECT                                                          REA00770
         USING ICDATA,R2            ADDRESS ICATS COMMON DATA AREA      REA00780
         USING FSTD,R3              FST BASE REGISTER                   REA00790
         USING CBUTS,R4          USE R4 TO ADDRESS UTS CONTROL BLOCK    REA00800
         USING CBUSER,R5         USE R5 TO ADDRESS USER CONTROL BLOCK   REA00810
         USING CBDISK,R6         USE R6 TO ADDRESS DISK CONTROL BLOCK   REA00820
         USING *,R15      USE R15 FOR BASE REG NEXT INSTRUCTION ONLY    REA00830
         STM   R0,R14,REGSAVE       SAVE CALLER'S REGISTERS             REA00840
         DROP  R15                                                      REA00850
         USING READ,R11             R11 WILL BE BASE REGISTER           REA00860
         LR    R11,R15              ESTABLISH BASE REGISTER             REA00870
*                                                                       REA00880
*    READ COMMANDS CAN ONLY COME FROM A UTS MACHINE                     REA00890
         TM    FLAGB,UTSCMD      DID THIS COMMAND COME FROM A UTS ??    REA00900
         BO    CON50             YEP, GOOD.  CONTINUE ON.               REA00910
         L     R15,AREJECT       ELSE, REJECT THIS REQUEST.             REA00920
         BALR  R14,R15                                                  REA00930
         B     READBYE                                                  REA00940
*    SET UP THE REPLY CONTROL BLOCK AND INITIALIZE ALL THE PARMS THAT   REA00950
*    GET SENT IN IT.  THE REPLY CB WILL PRECEDE THE DATA.               REA00960
CON50    L     R9,ABUFFER          THE REPLY CONTROL BLOCK CONSISTS     REA00970
         MVC   0(128,R9),PARM0     MOSTLY OF THE REQUEST CONTROL BLOCK  REA00980
         XC    UTSPARMS,UTSPARMS       CLEAR ALL THE PARMS AT ONCE      REA00990
         MVI   READFLAG,X'00'           CLEAR READ STATUS FLAGS         REA01000
*    PREPARE FOR ACCESS ROUTINE.                                        REA01010
         MVC   THISUSER,PARM0    MOVE IN UTS USER ID                    REA01020
         MVC   THISDISK,PARM6    MOVE IN THE DISK HE WANTED             REA01030
         L     R15,AACCESS                                              REA01040
         BALR  R14,R15           GO FIND ALL THE CONTROL BLOCKS         REA01050
*    UPON RETURN, IF THERE WAS AN ERROR, THEN R15 > 0,                  REA01060
*                 ELSE R15 = 0 AND R4, R5, AND R6 ALL POINT TO THE      REA01070
*                 CORRECT UTSCB, USERCB, AND DISKCB RESPECTIVELY.       REA01080
         LTR   R15,R15                                                  REA01090
         BNZ   READERRA          GO FIGURE OUT WHAT THE ERROR WAS       REA01100
*    NOW CHECK THE READ PASSWORD THIS GUY GAVE ME FOR THIS DISK         REA01110
         CLC   CBDSKRPW,=CL8'ALL'    DOES HE REQUIRE A PASSWORD ??      REA01120
         BE    CON100                NOPE, CONTINUE ON                  REA01130
         CLC   CBDSKRPW,=CL8'NONE'   IS HE ALLOWED TO READ THIS DISK ?  REA01140
         BE    CANTREAD              NOPE, TELL HIM SO                  REA01150
         CLC   CBDSKRPW,PARM7   NOT SPECIAL CASE - COMPARE PASSWORD     REA01160
         BNE   WRONGPW          PASSWORD IS INCORRECT                   REA01170
CON100   DS    0H                                                       REA01180
*    SUPPORT FILE NAMES STARTING WITH A CENT SIGN.  MAKE A POUND SIGN.  REA01190
         CLI   PARM4,C''      CMS DOESN'T LIKE CENT SIGNS              REA01200
         BNE   CON110                                                   REA01210
         MVI   PARM4,C'#'      PRETEND HE HAD A POUND SIGN ALL ALONG    REA01220
CON110   DS    0H                                                       REA01230
*    NOW INSURE THE FILE EXISTS ON THAT DISK                            REA01240
         LA    R8,PARM4        GET ADDRESS OF FILE ID (FN FT FM)        REA01250
         FSSTATE (R8)          DOES THIS FILE EXIST ??                  REA01260
         LTR   R15,R15                                                  REA01270
         BNZ   READERRB        NO, IT DOESN'T.  GO FIGURE OUT WHY.      REA01280
         LR    R3,R1           ESTABLISH FILE STATUS TABLE BASE REG     REA01290
*    FIGURE OUT WHAT WE'RE GOING TO DO.                                 REA01300
*    DOES THE CMS FILE HAVE FIXED- OR VARIABLE-LENGTH RECORDS ??        REA01310
         CLI   FSTRECFM,C'V'            IS IT A VARIABLE-LENGTH FILE ?? REA01320
         BE    CON150                   YEP, DON'T TURN ON FIXED BIT    REA01330
         OI    READFLAG,FIXEDCMS        ELSE REMEMBER IT'S FIXED-LENGTH REA01340
CON150   DS    0H                                                       REA01350
*    DOES HE WANT THE DATA IN UTS FIXED, VARIABLE, OR SOURCE FORMAT ??  REA01360
*    IF PARM8 = 'V', HE WANTS THE DATA IN VARIABLE FORMAT               REA01370
*    IF PARM8 = 'S', HE WANTS THE DATA IN SOURCE   FORMAT               REA01380
*                        ELSE IT'LL BE IN FIXED    FORMAT               REA01390
         CLI   PARM8,C'S'           DID HE WANT UTS SOURCE FORMAT ??    REA01400
         BNE   CON170               NO, CHECK OTHERS                    REA01410
         OI    READFLAG,SFORMAT     REMEMBER OUTPUT IS IN SOURCE FRMT   REA01420
         B     CON190               CONTINUE ON                         REA01430
CON170   CLI   PARM8,C'V'           DID HE WANT UTS VARIABLE FORMAT ??  REA01440
         BE    CON190               YEP, ALL SET THEN.                  REA01450
         OI    READFLAG,FIXEDUTS    FIXED OUTPUT IS THE EASIEST TO DO   REA01460
*    SINCE HE WANTS THE OUTPUT DATA IN FIXED-LENGTH FORMAT, SEE WHAT    REA01470
*    LRECL HE WANTS THE DATA BLOCKED TO.  I WILL BLOCK BOTH FIXED-      REA01480
*    AND VARIABLE-LENGTH CMS RECORDS TO THAT LRECL.                     REA01490
         LA    R1,PARM9       PARM 9 = LRECL                            REA01500
         L     R15,ACONDEC                                              REA01510
         BALR  R14,R15        GO CONVERT LRECL TO A NORMAL NUMBER       REA01520
*    IF THE LRECL WASN'T GIVEN, THEN DEFAULT TO THE CMS FILE LRECL.  IF REA01530
*    THE LRECL HAD AN INVALID CHARACTER IN IT, THEN DON'T DEFAULT,      REA01540
*    'CAUSE WHAT IF HE SAID '80X' AND THE CMS FILE LRECL IS 60 ??       REA01550
*    IF I DON'T SHOW AN ERROR, THEN HE MAY THINK THE DATA IS BLOCKED    REA01560
*    AT 800 BYTES, NOT 80 BYTES, OR VICE-VERSA.                         REA01570
         C     R15,=F'4'      WAS THE LRECL SPECIFIED AT ALL ??         REA01580
         BE    CON180         IF NOT, THEN DEFAULT TO CMS FILE LRECL    REA01590
         LTR   R15,R15        DID THE CONVERSION GO OK ??               REA01600
         BNZ   READERRC       IF NOT, THEN LET HIM KNOW OF THE ERROR    REA01610
         LTR   R0,R0          DID HE SPECIFY A LRECL OF 0 ??            REA01620
         BNZ   CON185         IF NOT, THEN USE HIS LRECL                REA01630
*                                                                       REA01640
CON180   DS    0H             IF OUTPUT LRECL IS ZERO OR WASN'T GIVEN,  REA01650
         L     R0,FSTLRECL    THEN DEFAULT TO THE LRECL OF THE FILE     REA01660
CON185   DS    0H                                                       REA01670
         ST    R0,UTSLRECL    REMEMBER OUTPUT LRECL                     REA01680
*    CONVERT THE-NUMBER-OF-BYTES-THE-UTS-USER-WANTS TO A HEX NUMBER     REA01690
CON190   DS    0H                                                       REA01700
         LA    R1,PARM3       PARM 3 = NUMBER OF BYTES THE UTS WANTS    REA01710
         L     R15,ACONDEC                                              REA01720
         BALR  R14,R15        GO CONVERT PARM TO NORMAL NUMBER          REA01730
         LTR   R15,R15        DID THE CONVERSION GO OK ??               REA01740
         BNE   READERRD       NOPE, GO FIGURE OUT WHY                   REA01750
         ST    R0,NUMWANTS    REMEMBER IT                               REA01760
         A     R0,ABUFFER              COMPUTE THE ADDRESS OF THE LAST  REA01770
         AH    R0,=H'128'              BYTE OF DATA IN THE OUTPUT       REA01780
         ST    R0,AEODATA                                               REA01790
         MVC   PADCHAR,PARM6+7   LAST BYTE IN PARM 6 = PAD CHARACTER    REA01800
*    OPEN THE FILE AND POINT TO THE SPECIFIED STARTING RECORD NUMBER    REA01810
         FSOPEN  (R8),FSCB=MYFSCB                                       REA01820
         LTR   R15,R15        FSOPEN SHOULD NEVER FAIL, BUT ....        REA01830
         BNE   READERRE                                                 REA01840
         LA    R1,PARM10      PARM10 = STARTING RECORD NUMBER IN EBCDIC REA01850
         L     R15,ACONDEC    GET ADDRESS OF DECIMAL CONVERSION ROUTINE REA01860
         BALR  R14,R15        GO CONVERT PARM TO NORMAL NUMBER          REA01870
*    IF THE STARTING RECORD NUMBER WASN'T GIVEN, THEN DEFAULT TO THE    REA01880
*    BEGINNING OF THE CMS FILE.  IF IT HAD AN INVALID CHARACTER IN IT,  REA01890
*    THEN DON'T DEFAULT, 'CAUSE WHAT IF HE SAID '42*' ?  IF I DON'T     REA01900
*    SHOW AN ERROR, HE'LL THINK HE STARTED AT RECORD 42, NOT 422.       REA01910
         C     R15,=F'4'      WAS THE STARTING RECORD # ALL BLANKS ??   REA01920
         BE    CON195         OK THEN, DEFAULT TO START OF FILE         REA01930
         LTR   R15,R15        DID THE CONVERSION GO OK OTHERWISE ??     REA01940
         BNZ   READERRF       IF NOT, THEN TELL HIM ABOUT THE ERROR.    REA01950
         LTR   R0,R0          IF STARTING RECORD NUMBER = 0, THAT MEANS REA01960
         BNZ   CON198         TO START WITH THE FIRST RECORD, SO CHANGE REA01970
CON195   DS    0H                                                       REA01980
         LA    R0,1           THE STARTING RECORD NUMBER TO A 1         REA01990
CON198   DS    0H                                                       REA02000
         ST    R0,STARTRCD    SAVE STARTING RECORD NUMBER               REA02010
         CH    R0,FSTRECCT    INSURE STARTING REC # <= # RECS IN FILE   REA02020
         BH    READERRG       STARTING RECORD NUMBER IS TOO BIG.        REA02030
         LR    R7,R0          DON'T USE R0 FOR THE FSPOINT              REA02040
         FSPOINT FSCB=MYFSCB,RDPNT=(R7)                                 REA02050
         LTR   R15,R15        SHOULDN'T EVER FAIL, BUT JUST IN CASE     REA02060
         BNZ   READERRI                                                 REA02070
*    NOW START READING THE CMS FILE AND FORMATING THE OUTPUT.           REA02080
*    SINCE THERE ARE 3 DIFFERENT OUTPUT FORMAT TYPES (FIXED-LENGTH,     REA02090
*    VARIABLE LENGTH, AND SOURCE FORMAT), EACH FORMAT GOES OFF AND      REA02100
*    DOES THEIR OWN READ LOOP FOR THIS STEP.  COME BACK TOGETHER        REA02110
*    AGAIN AT CON800 WHEN YOU'VE                                        REA02120
*    A)  HIT THE END OF THE CMS FILE BEFORE FULFILLING THE              REA02130
*        REQUESTED NUMBER OF BYTES WANTED (NUMWANTS),                   REA02140
*    B)  FILLED THE OUTPUT BUFFER WITH AS MANY BYTES OF DATA            REA02150
*        THAT THE UTS REQUESTED,                                        REA02160
*    C)  OR GOT SOME KIND OF ERROR REQUIRING US TO ABORT                REA02170
*        THIS REQUEST.                                                  REA02180
*    SEE THE COMMENTS AT CON800 FOR A DESCRIPTION OF WHAT THINGS        REA02190
*    ARE SET WHEN YOU GET THERE.                                        REA02200
         TM    READFLAG,SFORMAT                                         REA02210
         BO    READSFMT                                                 REA02220
         TM    READFLAG,FIXEDUTS                                        REA02230
         BO    READFFMT                                                 REA02240
*    MUST BE VARIABLE FORMAT THEN.                                      REA02250
*                                                                       REA02260
*    V   V     A     RRRR    IIIII     A     BBBB    L       EEEEE      REA02270
*    V   V    A A    R   R     I      A A    B   B   L       E          REA02280
*    V   V   AAAAA   RRRR      I     AAAAA   BBBB    L       EEE        REA02290
*     V V    A   A   R  R      I     A   A   B   B   L       E          REA02300
*      V     A   A   R   R   IIIII   A   A   BBBB    LLLLL   EEEEE      REA02310
*                                                                       REA02320
*    START READING THE CMS FILE.  KEEP TRACK OF                         REA02330
*      1)  NUMBER OF RECORDS READ IN THUS FAR (R7),                     REA02340
*      2)  NUMBER OF BYTES READ IN THUS FAR (R8),                       REA02350
*      3)  WHERE NEXT RECORD GETS READ INTO (R9),                       REA02360
*      4)  LENGTH OF INPUT BUFFER REMAINING (R10),                      REA02370
*      5)  LENGTH OF BIGGEST RECORD THUS FAR (BIGGEST),                 REA02380
*    QUIT WHEN END OF FILE REACHED OR # BYTES READ >= # BYTES WANTED.   REA02390
*                                                                       REA02400
         SR    R7,R7           INITIALIZE # RECORDS READ THUS FAR       REA02410
         SR    R8,R8           INITIALIZE # BYTES READ THUS FAR         REA02420
*    THE BYTE COUNT OF THE NUMBER OF BYTES READ IN THUS FAR (IN R8)     REA02430
*    DOESN'T GET BUMPED 'CAUSE THE 128 BYTES OF THE REPLY CONTROL       REA02440
*    BLOCK IS NOT COUNTED AGAINST THE NUMBER OF BYTES HE ASKED FOR.     REA02450
         L     R9,ABUFFER      GET ADDRESS OF READ INPUT BUFFER         REA02460
         LA    R9,128(R9)      DATA STARTS AFTER REPLY CONTROL BLOCK    REA02470
         L     R10,LBUFFER     INITIALIZE # BYTES LEFT IN BUFFER        REA02480
         SH    R10,=H'128'     LESS ROOM IN OUTPUT BUFFER NOW           REA02490
*                                                                       REA02500
*    REMEMBER, EACH OUTPUT RECORD IS PREFIXED BY A 2-BYTE LENGTH FIELD. REA02510
*    SO START PUTTING THE DATA 2 BYTES DOWN THE LINE, SO THAT LATER     REA02520
*    WE CAN PUT THIS RECORD'S LENGTH IN THOSE 2 BYTES.                  REA02530
         LA    R8,2(R8)        ADD 2 BYTES FOR THIS LENGTH POINTER      REA02540
         LA    R9,2(R9)        PUT DATA PAST THE RECORD LENGTH          REA02550
         BCTR  R10,R0          ADJUST BUFFER LENGTH ALSO                REA02560
         BCTR  R10,R0                                                   REA02570
CON210   DS    0H              CONTINUE READING CMS RECORDS             REA02580
         TM    TEST0108,TEST1                                           REA02590
         BNO   NOTEST1A                                                 REA02600
         LR    R3,R0                                                    REA02610
         LINEDIT TEXT='BYTE COUNT THUS FAR IS .........., NUMWANTS IS S-REA02620
               TILL .........',SUB=(DEC,(R8),DECA,NUMWANTS),RENT=NO     REA02630
         LR    R0,R3                                                    REA02640
NOTEST1A DS    0H                                                       REA02650
         FSREAD FSCB=MYFSCB,BUFFER=(R9),BSIZE=(R10)                     REA02660
         LA    R7,1(R7)        BUMP RECORD COUNTER NOW FOR ERROR MSG    REA02670
         LTR   R15,R15         DID EVERYTHING GO OK ??                  REA02680
         BZ    CON220          YEP, NO ERROR AND NOT END OF FILE YET    REA02690
         C     R15,=F'12'      IS IT JUST THE END OF FILE ??            REA02700
         BNE   READERRH        NOPE, SOMETHING REALLY WENT WRONG        REA02710
         OI    READFLAG,EOF      REMEMBER WE'VE HIT THE END-OF-FILE     REA02720
         BCTR  R9,R0             SINCE WE'RE DOING THIS IN VARIABLE     REA02730
         BCTR  R9,R0             LENGTH FORMAT, BACK UP AND PUT IN      REA02740
         MVC   0(2,R9),=X'0000'  THE END-OF-FILE MARKER                 REA02750
         BCTR  R7,R0             DEC RCD COUNTER - THIS ISN'T A RCD     REA02760
         ST    R7,DONE#R         STORE # COMPLETE RECORDS WE'VE DONE    REA02770
         ST    R8,DONE#B         STORE # BYTES IN THE COMPLETED RECORDS REA02780
         B     CON800                                                   REA02790
CON220   DS    0H                                                       REA02800
         TM    TEST0108,TEST2                                           REA02810
         BNO   NOTEST2A                                                 REA02820
         LR    R3,R0                                                    REA02830
         LINEDIT TEXT='RECORD NUMBER .... IS ..... BYTES BIG',SUB=(DEC,-REA02840
               (R7),DEC,(R3)),RENT=NO                                   REA02850
         LR    R0,R3                                                    REA02860
NOTEST2A DS    0H                                                       REA02870
         C     R0,BIGGEST      IS THIS RECORD THE BIGGEST THUS FAR?     REA02880
         BNH   CON230          NOPE                                     REA02890
         ST    R0,BIGGEST      WE'VE GOT A NEW BIGGEST RECORD           REA02900
CON230   DS    0H                                                       REA02910
         C     R0,=F'65535'    RECORD THAT ARE 65535 LARGE OVERFLOW     REA02920
         BNL   READERRJ        TO X'10000' WHEN PAD CHAR IS ADDED ON    REA02930
         LR    R15,R0               IN CASE THIS RECORD'S BYTE COUNT    REA02940
         AR    R15,R9               IS ODD, GO APPEND THE PAD CHARACTER REA02950
         MVC   0(1,R15),PADCHAR     AT THE END OF THE RECORD            REA02960
*    GET THIS RECORD'S LENGTH INTO UTS FORMAT (1/2 OF THE BYTE COUNT).  REA02970
*    WHICH MEANS THERE'LL ALWAYS BE AN EVEN NUMBER OF BYTES IN A RECORD REA02980
*    IF R0 = EVEN, THEN   (R0)/2 = CORRECT LENGTH                       REA02990
*       R0 = ODD,  THEN (R0+1)/2 = CORRECT LENGTH WITH PAD CHARACTER.   REA03000
         AH    R0,=H'1'        MAKE LENGTH INCLUDE ANY ODD BYTE         REA03010
         SRL   R0,1            DIVIDE RECORD COUNT BY 2                 REA03020
         BCTR  R9,R0           BACK UP TO THE RECORD LENGTH POINTER     REA03030
         BCTR  R9,R0                                                    REA03040
         STH   R0,0(R9)        PUT IN RECORD LENGTH POINTER             REA03050
         LA    R9,2(R9)        ADD THOSE TWO BYTES BACK IN AGAIN        REA03060
         SLL   R0,1            GO BACK TO RECORD BYTE COUNT AGAIN       REA03070
*    UPDATE THE COUNTERS IN THE OTHER REGISTERS ACCORDINGLY.            REA03080
         AR    R8,R0           BUMP # BYTES READ THUS FAR               REA03090
         AR    R9,R0           MOVE READ BUFFER DOWN A WAYS             REA03100
         SR    R10,R0          READ BUFFER IS NOW SMALLER               REA03110
*    ALL DONE WITH THIS RECORD.  DO WE HAVE TO GO READ ANOTHER ??       REA03120
         LA    R8,2(R8)        ADD 2 BYTES FOR NEXT LENGTH POINTER      REA03130
         LA    R9,2(R9)        PUT NEXT DATA PAST ITS LENGTH FIELD      REA03140
         BCTR  R10,R0          ADJUST BUFFER LENGTH ALSO                REA03150
         BCTR  R10,R0                                                   REA03160
         C     R8,NUMWANTS     HAVE WE READ ENOUGH YET ??               REA03170
         BL    CON210          NOPE, GO READ ANOTHER RECORD             REA03180
*    WE'VE READ IN ENOUGH DATA FROM THE CMS FILE AND WE DIDN'T HIT      REA03190
*    THE END OF THE FILE YET.  NOW WE'VE GOT TO PUT THE FINISHING       REA03200
*    TOUCHES ON THE OUTPUT AREA.  THERE ARE 2 CASES:                    REA03210
*    1)  IT CAME OUT JUST RIGHT (R8 = NUMWANTS).  WE'VE READ IN SOME    REA03220
*        NUMBER OF RECORDS (R7) AND THE LAST RECORD READ (PLUS THE TWO  REA03230
*        BYTES FOR THE END-OF-BLOCK MARKER) IS GOING TO JUST FIT IN THE REA03240
*        NUMBER OF BYTES HE SAID HE WANTED (NUMWANTS).                  REA03250
*             PUT EITHER THE END-OF-BLOCK MARKER OR THE END-OF-FILE     REA03260
*                 MARKER AFTER THIS LAST RECORD DEPENDING ON WHETHER    REA03270
*                 THIS LAST RECORD READ IS THE LAST IN THE FILE OR NOT  REA03280
*             DONE#R = R7                                               REA03290
*             DONE#B = R8.                                              REA03300
*             BIGGEST AND RETCODE ARE ALREADY SET.                      REA03310
*    2)  IT DIDN'T COME OUT RIGHT (R8 > NUMWANTS).  WE'VE READ IN       REA03320
*        SOME NUMBER OF RECORDS (R7) AND THE LAST RECORD READ           REA03330
*        (INCLUDING THE TWO BYTES FOR THE END-OF-BLOCK MARKER) WON'T    REA03340
*        FIT IN THE NUMBER OF BYTES HE SAID HE WANTED (NUMWANTS).       REA03350
*             PUT THE EOB MARKER AFTER THIS LAST RECORD                 REA03360
*             DONE#R = R7 - 1                                           REA03370
*             DONE#B = R8 - R0 (THE LENGTH OF THIS LAST RECORD)         REA03380
*             BIGGEST AND RETCODE ARE ALREADY SET.                      REA03390
*                                                                       REA03400
         C     R8,NUMWANTS     HAVE WE TRUNCATED THE LAST RECORD ??     REA03410
         BNE   CON250          YES, CASE 2).                            REA03420
*    CASE 1)  THE LAST OUTPUT RECORD JUST FIT IN THE OUTPUT AREA.       REA03430
*    DO ONE MORE READ TO SEE IF THAT WAS THE LAST RECORD OR NOT.        REA03440
*    IF SO, PUT AN END-OF-FILE MARKER AT THE END OF THE OUTPUT,         REA03450
*    ELSE, USE AN END-OF-BLOCK MARKER.                                  REA03460
         FSREAD FSCB=MYFSCB,BUFFER=(R9),BSIZE=(R10)                     REA03470
         BCTR  R9,R0               BACK UP BUFFER POINTER TO PREVIOUS   REA03480
         BCTR  R9,R0               TO LAST 2 BYTES IN OUTPUT AREA       REA03490
         C     R15,=F'12'          EOF HIT ??  IGNORE ANY ERRORS.       REA03500
         BNE   CON240              NO, BRANCH.                          REA03510
         OI    READFLAG,EOF        REMEMBER THAT END-OF-FILE WAS HIT    REA03520
         MVC   0(2,R9),=X'0000'    PUT IN END-OF-FILE MARKER            REA03530
         B     CON245                                                   REA03540
CON240   MVC   0(2,R9),=X'FFFF'    PUT IN END-OF-BLOCK MARKER           REA03550
CON245   ST    R7,DONE#R                                                REA03560
         ST    R8,DONE#B                                                REA03570
         B     CON800                                                   REA03580
*    CASE 2)  THE LAST OUTPUT RECORD WILL BE INCOMPLETE.                REA03590
CON250   OI    READFLAG,LASTINC     REMEMBER THAT FACT                  REA03600
         SR    R9,R0                BACK UP BUFFER POINTER TO           REA03610
         SH    R9,=H'4'             PREVIOUS RECORD'S LENGTH POINTER    REA03620
         MVC   0(2,R9),=X'FFFF'     PUT IN THE END-OF-BLOCK MARKER      REA03630
         BCTR  R7,R0         DECREMENT AND SAVE THE NUMBER OF           REA03640
         ST    R7,DONE#R     COMPLETE RECORDS IN THE OUTPUT             REA03650
         SR    R8,R0         DECREMENT THE BYTE COUNT OF THE LAST       REA03660
         BCTR  R8,R0         RECORD (INCLUDING TWO FOR IT'S LENGTH      REA03670
         BCTR  R8,R0         FIELD) AND SAVE IT AWAY AS THE NUMBER      REA03680
*                            OF BYTES IN THE COMPLETED RECORDS.         REA03690
*    NOTE:  IN NO CASE SHOULD DONE#B BE GREATER THAN NUMWANTS.  THIS    REA03700
*           MIGHT HAPPEN IS NUMWANTS IS 0 OR 1.  THEN WE WOULD HAVE     REA03710
*           READ IN THE FIRST RECORD AND IT DIDN'T FIT, SO WE           REA03720
*           DECREMENTED R8 AND GOT 2, WHICH IS BIGGER THAN NUMWANTS.    REA03730
         C     R8,NUMWANTS     SO, IF R8 > NUMWANTS, REPLACE IT         REA03740
         BNH   CON255          WITH NUMWANTS.  ONLY GIVE HIM THE        REA03750
         L     R8,NUMWANTS     NUMBER OF BYTES HE WANTED.               REA03760
CON255   ST    R8,DONE#B                                                REA03770
         B     CON800                                                   REA03780
         EJECT                                                          REA03790
*                                                                       REA03800
*    FFFFF   IIIII   X   X   EEEEE   DDDD                               REA03810
*    F         I      X X    E       D   D                              REA03820
*    FFF       I       X     EEE     D   D                              REA03830
*    F         I      X X    E       D   D                              REA03840
*    F       IIIII   X   X   EEEEE   DDDD                               REA03850
*                                                                       REA03860
*    START READING THE CMS FILE.  KEEP TRACK OF                         REA03870
*      1)  NUMBER OF RECORDS READ IN THUS FAR (R7),                     REA03880
*      2)  NUMBER OF BYTES READ IN THUS FAR (R8),                       REA03890
*      3)  WHERE NEXT RECORD GETS READ INTO (R9),                       REA03900
*      4)  LENGTH OF INPUT BUFFER REMAINING (R10),                      REA03910
*      5)  LENGTH OF BIGGEST RECORD THUS FAR (BIGGEST),                 REA03920
*    QUIT WHEN END OF FILE REACHED OR # BYTES READ >= # BYTES WANTED.   REA03930
*                                                                       REA03940
READFFMT DS    0H                                                       REA03950
         SR    R7,R7           INITIALIZE # RECORDS READ THUS FAR       REA03960
         SR    R8,R8           INITIALIZE # BYTES READ THUS FAR         REA03970
*    THE BYTE COUNT OF THE NUMBER OF BYTES READ IN THUS FAR (IN R8)     REA03980
*    DOESN'T GET BUMPED 'CAUSE THE 128 BYTES OF THE REPLY CONTROL       REA03990
*    BLOCK IS NOT COUNTED AGAINST THE NUMBER OF BYTES HE ASKED FOR.     REA04000
         L     R9,ABUFFER      GET ADDRESS OF READ INPUT BUFFER         REA04010
         LA    R9,128(R9)      DATA STARTS AFTER REPLY CONTROL BLOCK    REA04020
         L     R10,LBUFFER     INITIALIZE # BYTES LEFT IN BUFFER        REA04030
         SH    R10,=H'128'     LESS ROOM IN OUTPUT BUFFER NOW           REA04040
*                                                                       REA04050
CON410   DS    0H              CONTINUE READING CMS RECORDS             REA04060
         TM    TEST0108,TEST1                                           REA04070
         BNO   NOTEST1B                                                 REA04080
         LR    R3,R0                                                    REA04090
         LINEDIT TEXT='BYTE COUNT THUS FAR IS .........., NUMWANTS IS S-REA04100
               TILL .........',SUB=(DEC,(R8),DECA,NUMWANTS),RENT=NO     REA04110
         LR    R0,R3                                                    REA04120
NOTEST1B DS    0H                                                       REA04130
         FSREAD FSCB=MYFSCB,BUFFER=(R9),BSIZE=(R10)                     REA04140
         LA    R7,1(R7)        BUMP RECORD COUNTER NOW FOR ERROR MSG    REA04150
         LTR   R15,R15         DID EVERYTHING GO OK ??                  REA04160
         BZ    CON420          YEP, NO ERROR AND NOT END OF FILE YET    REA04170
         C     R15,=F'12'      IS IT JUST THE END OF FILE ??            REA04180
         BNE   READERRH        NOPE, SOMETHING REALLY WENT WRONG        REA04190
         OI    READFLAG,EOF      REMEMBER WE'VE HIT THE END-OF-FILE     REA04200
         BCTR  R7,R0             DEC RCD COUNTER - THIS ISN'T A RCD     REA04210
         ST    R7,DONE#R         STORE # COMPLETE RECORDS WE'VE DONE    REA04220
         ST    R8,DONE#B         STORE # BYTES IN THE COMPLETED RECORDS REA04230
         B     CON800                                                   REA04240
CON420   DS    0H                                                       REA04250
         TM    TEST0108,TEST2                                           REA04260
         BNO   NOTEST2B                                                 REA04270
         LR    R3,R0                                                    REA04280
         LINEDIT TEXT='RECORD NUMBER .... IS ..... BYTES BIG',SUB=(DEC,-REA04290
               (R7),DEC,(R3)),RENT=NO                                   REA04300
         LR    R0,R3                                                    REA04310
NOTEST2B DS    0H                                                       REA04320
         C     R0,BIGGEST      IS THIS RECORD THE BIGGEST THUS FAR?     REA04330
         BNH   CON430          NOPE                                     REA04340
         ST    R0,BIGGEST      WE'VE GOT A NEW BIGGEST RECORD           REA04350
*    THE CMS RECORD IS NOW IN PLACE WHERE IT BELONGS.  IN CASE THE      REA04360
*    RECORD LENGTH IS SMALLER THAN THE LRECL HE SAID HE WANTED THIS     REA04370
*    FIXED-LENGTH OUTPUT IN, WE'VE GOT TO PAD THE DIFFERENCE WITH       REA04380
*    THE PAD CHARACTER HE'S SUPPLIED.  IF THE CMS RECORD IS BIGGER      REA04390
*    THAN THE OUTPUT LRECL, THEN SOME DATA WILL BE LOST.  SET A BIT     REA04400
*    SO THAT LATER WE CAN INFORM HIM THAT SOME DATA WAS LOST.           REA04410
CON430   DS    0H                                                       REA04420
         C     R0,UTSLRECL        COMPARE RECORD SIZE WITH OUTPUT LRECL REA04430
         BE    CON450             JUST RIGHT, NORMAL CASE.  DON'T PAD.  REA04440
         BL    CON440             SMALL RECORD, WILL NEED TO PAD        REA04450
*                                 BIG RECORD, WE'LL LOSE SOME DATA      REA04460
         OI    READFLAG,TRUNC     REMEMBER WE'VE LOST SOME DATA         REA04470
         BNP   CON450             RECORD'S SO BIG, NO NEED TO PAD       REA04480
*    THE CMS RECORD IS SMALLER THAN HIS OUTPUT LRECL.  I'M GOING TO     REA04490
*    HAVE TO PAD THE DIFFERENCE WITH THE PAD CHARACTER.  I HAVE TO USE  REA04500
*    MVCL INSTEAD OF MVC BECAUSE I MIGHT HAVE TO PAD MORE THAN 255      REA04510
*    CHARACTERS.  SO, FOR THE MVCL,                                     REA04520
*        R14 = DESTINATION ADDRESS (RIGHT AFTER CMS RECORD),            REA04530
*        R15 = DESTINATION LENGTH (DIFFERENCE OF RECORD SIZES),         REA04540
*        R12 = SOURCE ADDRESS (THIS IS UNIMPORTANT), AND                REA04550
*        R13 = PAD CHARACTER AND SOURCE LENGTH (WHICH WILL BE 0).  ALL  REA04560
*              I WANT TO DO IS PAD WITH THE PADDING CHARACTER (PADCHAR) REA04570
CON440   DS    0H                                                       REA04580
         L     R15,UTSLRECL    GET THIS OUTPUT RECORD'S LENGTH          REA04590
         SR    R15,R0          SUBTRACT HOW BIG IT REALLY IS            REA04600
*                              WHAT'S LEFT IS HOW MUCH YOU NEED TO PAD. REA04610
         LR    R14,R9             START PADDING AFTER RECORD'S DATA     REA04620
         AR    R14,R0             WHICH WILL BE R9 + R0                 REA04630
         SR    R13,R13                SET THE SOURCE LENGTH = 0         REA04640
         ICM   R13,B'1000',PADCHAR    GET THE PADDING CHARACTER         REA04650
         MVCL  R14,R12                PAD THE BLOODY THING (WHEW)       REA04660
CON450   DS    0H                                                       REA04670
*    UPDATE THE COUNTERS IN THE OTHER REGISTERS ACCORDINGLY.            REA04680
         A     R8,UTSLRECL     BUMP # BYTES READ THUS FAR               REA04690
         A     R9,UTSLRECL     MOVE READ BUFFER DOWN A WAYS             REA04700
         S     R10,UTSLRECL    READ BUFFER IS NOW SMALLER               REA04710
*    ALL DONE WITH THIS RECORD.  DO WE HAVE TO GO READ ANOTHER ??       REA04720
         C     R8,NUMWANTS     HAVE WE READ ENOUGH YET ??               REA04730
         BL    CON410          NOPE, GO READ ANOTHER RECORD             REA04740
*    WE'VE READ IN ENOUGH DATA FROM THE CMS FILE AND WE DIDN'T HIT      REA04750
*    THE END OF THE FILE YET.  NOW WE'VE GOT TO PUT THE FINISHING       REA04760
*    TOUCHES ON THE OUTPUT AREA.  THERE ARE 2 CASES:                    REA04770
*    1)  IT CAME OUT JUST RIGHT (R8 = NUMWANTS).  WE'VE READ IN SOME    REA04780
*        NUMBER OF RECORDS (R7) AND THE LAST RECORD READ JUST FITS IN   REA04790
*        THE NUMBER OF BYTES HE SAID HE WANTED (NUMWANTS).              REA04800
*        SET THE EOF BIT ON IF THIS LAST RECORD IS                      REA04810
*                THE LAST ONE IN THE CMS FILE OR NOT.                   REA04820
*            DONE#R = R7                                                REA04830
*            DONE#B = R8.                                               REA04840
*            BIGGEST AND RETCODE ARE ALREADY SET.                       REA04850
*    2)  IT DIDN'T COME OUT RIGHT (R8 > NUMWANTS).  WE'VE READ IN SOME  REA04860
*        NUMBER OF RECORDS (R7) AND THE LAST RECORD READ DOESN'T FIT    REA04870
*        IN THE NUMBER OF BYTES HE SAID HE WANTED (NUMWANTS).           REA04880
*        SET DONE#R = R7 - 1                                            REA04890
*            DONE#B = R8 - R0 (THE LENGTH OF THIS LAST RECORD)          REA04900
*            BIGGEST AND RETCODE ARE ALREADY SET.                       REA04910
*                                                                       REA04920
         C     R8,NUMWANTS     HAVE WE TRUNCATED THE LAST RECORD ??     REA04930
         BNE   CON490          YES, CASE 2).                            REA04940
*    CASE 1)  THE LAST OUTPUT RECORD JUST FIT IN THE OUTPUT AREA.       REA04950
*    DO ONE MORE READ TO SEE IF THAT WAS THE LAST RECORD OR NOT.        REA04960
*    IF SO, SET THE EOF BIT.  IF NOT, DON'T.                            REA04970
         FSREAD FSCB=MYFSCB,BUFFER=(R9),BSIZE=(R10)                     REA04980
         C     R15,=F'12'          EOF HIT ??  IGNORE ANY ERRORS.       REA04990
         BNE   CON480              NO, BRANCH.                          REA05000
         OI    READFLAG,EOF        REMEMBER THAT END-OF-FILE WAS HIT    REA05010
CON480   DS    0H                                                       REA05020
         ST    R7,DONE#R                                                REA05030
         ST    R8,DONE#B                                                REA05040
         B     CON800                                                   REA05050
*    CASE 2)  THE LAST OUTPUT RECORD WILL BE INCOMPLETE.                REA05060
CON490   OI    READFLAG,LASTINC     REMEMBER THAT FACT                  REA05070
         BCTR  R7,R0         DECREMENT AND SAVE THE NUMBER OF           REA05080
         ST    R7,DONE#R     COMPLETE RECORDS IN THE OUTPUT             REA05090
         SR    R8,R0         DECREMENT THE BYTE COUNT OF THE LAST       REA05100
*                            RECORD AND SAVE IT AWAY AS THE NUMBER      REA05110
         ST    R8,DONE#B     OF BYTES IN THE COMPLETED RECORDS.         REA05120
         B     CON800                                                   REA05130
         EJECT                                                          REA05140
READSFMT DS    0H                                                       REA05150
*                                                                       REA05160
*     SSSS    OOO    U   U   RRRR     CCCC   EEEEE                      REA05170
*    SS      O   O   U   U   R   R   C       E                          REA05180
*     SS     O   O   U   U   RRRR    C       EEEE                       REA05190
*      SS    O   O   U   U   R  R    C       E                          REA05200
*    SSSS     OOO     UUU    R   R    CCCC   EEEEE                      REA05210
*                                                                       REA05220
*    START READING THE CMS FILE.  REGISTER USAGE IS                     REA05230
*      R0  = THIS CMS RECORD'S LENGTH (AND LATER ITS LENGTH PLUS        REA05240
*            TWO FOR THE LENGTH FIELD).                                 REA05250
*      R7  = NUMBER OF RECORDS IN THIS BLOCK.                           REA05260
*      R8  = NUMBER OF DATA BYTES USED IN THIS BLOCK THUS FAR.          REA05270
*      R9  = ADDRESS OF WHERE TO READ THE NEXT CMS RECORD INTO          REA05280
*            (INCLUDING ITS LENGTH FIELD).                              REA05290
*      R10 = LENGTH OF INPUT BUFFER REMAINING.                          REA05300
*      R12 = ADDRESS OF THE START OF THIS BLOCK.                        REA05310
*      R13 = ADDRESS OF WHERE TO MOVE THIS LENGTH FIELD AND RECORD      REA05320
*            INTO THIS BLOCK IF IT FITS.                                REA05330
*      R14 = NUMBER OF BYTES LEFT FOR DATA IN THIS BLOCK.               REA05340
*    ALSO THESE VARIABLES ARE USED                                      REA05350
*      THISBLK# = THIS BLOCK NUMBER.  STARTS WITH 1, GOES TO N.         REA05360
*      PRLINCNT = PREVIOUS LINE COUNT.  THIS IS THE NUMBER OF LINES     REA05370
*                 IN THE CMS FILE BEFORE THIS BLOCK.                    REA05380
*      OLDPLC   = OLD PREVIOUS LINE COUNT.  THIS IS THE PREVIOUS        REA05390
*                 VALUE OF PRLINCNT BEFORE IT GOT UPDATED LAST.         REA05400
*      BIGGEST  = THE LENGTH OF THE BIGGEST CMS RECORD WE'VE SEEN.      REA05410
*      RETCODE  = THE RETURN CODE TO PASS BACK TO THE UTS.              REA05420
*      BLKWANTS = THE NUMBER OF BLOCKS HE WANTS = (NUMWANTS+1739)/1740. REA05430
*    QUIT WHEN END OF FILE REACHED OR WE DON'T NEED TO FILL ANY MORE    REA05440
*    BLOCKS OR WE GET SOME KIND OF READ ERROR.                          REA05450
*                                                                       REA05460
         MVC   THISBLK#,=F'1'  INITIALIZE THIS FIRST BLOCK NUMBER       REA05470
         L     R15,STARTRCD            THE NUMBER OF RECORDS BEFORE     REA05480
         BCTR  R15,R0                  THIS FIRST BLOCK IS SIMPLY THE   REA05490
         ST    R15,PRLINCNT            STARTING RECORD NUMBER - 1       REA05500
         SR    R14,R14         COMPUTE THE NUMBER OF BLOCKS HE WANTS;   REA05510
         L     R15,NUMWANTS            IF HE SAYS HE WANTS SAY,         REA05520
         LA    R15,1739(R15)           4 AND A HALF BLOCKS, LET'S       REA05530
         D     R14,=F'1740'            PREPARE 5.  THE FIFTH BLOCK      REA05540
         ST    R15,BLKWANTS            WILL GET TRUNCATED.              REA05550
         SR    R7,R7     INITIALIZE # RECORDS READ IN THIS BLK THUS FAR REA05560
         SR    R8,R8     INITIALIZE # BYTES READ IN THIS BLOCK THUS FAR REA05570
         L     R12,ABUFFER          PUT FIRST BLOCK RIGHT AFTER         REA05580
         LA    R12,128(R12)         THE REPLY CONTROL BLOCK             REA05590
         L     R10,LBUFFER    BUFFER LENGTH REMAINING IS LESS 'CAUSE OF REA05600
         SH    R10,=H'140'    THE REPLY CONTROL BLOCK & FIRST FEW BYTES REA05610
*    READ NEXT BLOCK:  AT THIS POINT, WE'RE READY TO START READING CMS  REA05620
*        RECORDS TO FILL THIS BLOCK UP.  THERE'S ONE RECORD IN THIS     REA05630
*        BLOCK ALREADY (UNLESS THIS IS THE FIRST TIME THROUGH, IN WHICH REA05640
*        CASE, R7 AND R8 ARE SET AS IF THERE'S A NULL RECORD IN THERE). REA05650
*        WE'RE GOING TO BE READING THE RECORDS INTO THE NEXT BLOCK, NOT REA05660
*        THIS ONE.  IN OTHER WORDS, ASSUME THE NEXT RECORD WON'T FIT IN REA05670
*        THIS BLOCK, IT'LL HAVE TO GO INTO THE NEXT ONE.  IF WE'RE      REA05680
*        WRONG (WHICH WE'LL BE MOST OF THE TIME), WE'LL MOVE THE RECORD REA05690
*        INTO THIS BLOCK.  THE LOGIC IS EASIER THIS WAY.                REA05700
*            R7  = NUMBER OF RECORDS IN THIS BLOCK ALREADY (0 OR 1)     REA05710
*            R8  = NUMBER OF BYTES USED UP IN THIS BLOCK ALREADY        REA05720
*            R12 = ADDRESS OF THE START OF THIS BLOCK                   REA05730
CON600   DS    0H                                                       REA05740
         LA    R9,1750(R12)    READ RECORDS INTO NEXT BLOCK             REA05750
         SH    R10,=H'1740'    ADJUST LENGTH OF INPUT BUFFER REMAINING  REA05760
         LA    R13,10(R8,R12)  COMPUTE ADDRESS OF WHERE TO PUT NEXT     REA05770
*                              CMS RECORD (PLUS ITS LENGTH FIELD)       REA05780
         LA    R14,1710               COMPUTE REMAINING LENGTH OF       REA05790
         SR    R14,R8                 DATA FIELD OF THIS BLOCK          REA05800
*    READ NEXT RECORD:  CONTINUE READING CMS RECORDS INTO THE NEXT      REA05810
*        BLOCK.  SEE IF IT'LL FIT INTO THIS BLOCK.                      REA05820
CON610   DS    0H                                                       REA05830
         TM    TEST0108,TEST1                                           REA05840
         BNO   NOTEST1C                                                 REA05850
         LINEDIT TEXT='BYTE COUNT THUS FAR IS ....., NUMBER OF BYTES LE-REA05860
               FT IN THIS BLOCK IS .....',SUB=(DEC,(R8),DEC,(R7)),RENT=-REA05870
               NO                                                       REA05880
NOTEST1C DS    0H                                                       REA05890
         LA    R9,2(R9)        PUT RECORD PAST ITS LENGTH FIELD         REA05900
         FSREAD FSCB=MYFSCB,BUFFER=(R9),BSIZE=(R10)                     REA05910
         SH    R9,=H'2'        PUT R9 BACK TO POINT TO LENGTH FIELD     REA05920
         LTR   R15,R15         EVERYTHING GO OK ??                      REA05930
         BZ    CON630          YEAH, CONTINUE ON.                       REA05940
         C     R15,=F'12'      END OF FILE HIT ??                       REA05950
         BNE   CON620          NOPE, CONTINUE ON.                       REA05960
         OI    READFLAG,EOF        ELSE REMEMBER END-OF-FILE WAS HIT    REA05970
         BAL   R15,CLOSEBLK        AND TIDY UP THIS LAST BLOCK          REA05980
         B     CON700              WE'RE DONE, GO WRAP IT UP.           REA05990
*                                  RETURN CODE WILL BE SET LATER.       REA06000
CON620   DS    0H                                                       REA06010
         BAL   R15,CLOSEBLK    GO TIDY UP THIS BLOCK                    REA06020
         C     R15,=F'8'       DID THIS RECORD OVERFLOW OUR BUFFER ??   REA06030
         BNE   CON625          NO, SOMETHING REALLY WENT WRONG.         REA06040
         MVC   RETCODE,=X'00005014'     RETURN CODE = 5014.             REA06050
         B     CON700                                                   REA06060
CON625   MVC   RETCODE,=X'00005010'     RETURN CODE = 5010.             REA06070
         B     CON700                                                   REA06080
*                                                                       REA06090
CON630   DS    0H                                                       REA06100
*    THE READ WENT NORMALLY.  FIRST SEE IF THE RECORD STARTS WITH       REA06110
*    EXACTLY 6 BLANKS.  IF SO, THE RECORD WILL BE TABBED.               REA06120
         TM    TEST0108,TEST2                                           REA06130
         BNO   NOTEST2C                                                 REA06140
         LR    R3,R0                                                    REA06150
         LINEDIT TEXT='RECORD NUMBER .... IS ..... BYTES BIG',SUB=(DEC,-REA06160
               (R7),DEC,(R3)),RENT=NO                                   REA06170
         LR    R0,R3                                                    REA06180
NOTEST2C DS    0H                                                       REA06190
         CLC   2(6,R9),=CL6' '  DOES THIS RECORD START WITH 6 BLANKS ?? REA06200
         BNE   CON635           NO, DON'T WORRY ABOUT IT.               REA06210
         OI    READFLAG,TAB                                             REA06220
         STM   R4,R7,TEMPA      FREE UP SOME REGISTERS FOR THE MVCL     REA06230
         LA    R4,2(R9)             R4 = DESTINATION ADDRESS            REA06240
         LR    R5,R0                R5 = DESTINATION LENGTH             REA06250
         LA    R6,8(R9)             R6 = SOURCE ADDRESS                 REA06260
         LR    R7,R0                R7 = PAD CHARACTER (X'00') AND      REA06270
         MVCL  R4,R6                     SOURCE LENGTH                  REA06280
         LM    R4,R7,TEMPA      RESTORE THOSE REGISTERS                 REA06290
         SH    R0,=H'6'         LENGTH DOES NOT INCLUDE THE 6 BLANKS    REA06300
CON635   DS    0H                                                       REA06310
         LA    R15,2(R9)            IN CASE THIS RECORD'S BYTE COUNT    REA06320
         AR    R15,R0               IS ODD, GO APPEND THE PAD CHARACTER REA06330
         MVC   0(1,R15),PADCHAR     AT THE END OF THE RECORD            REA06340
*    GET THIS RECORD'S LENGTH INTO UTS FORMAT (1/2 OF THE BYTE COUNT).  REA06350
*    WHICH MEANS THERE'LL ALWAYS BE AN EVEN NUMBER OF BYTES IN A RECORD REA06360
*    IF R0 = EVEN, THEN   (R0)/2 = CORRECT LENGTH                       REA06370
*       R0 = ODD,  THEN (R0+1)/2 = CORRECT LENGTH WITH PAD CHARACTER.   REA06380
         AH    R0,=H'1'        MAKE LENGTH INCLUDE ANY ODD BYTE         REA06390
         SRL   R0,1            DIVIDE RECORD COUNT BY 2                 REA06400
*    SET THIS RECORD'S LENGTH IN FRONT OF THE RECORD (IN ITS LENGTH     REA06410
*    FIELD) AND SET THE TAB BIT IF NEED BE.                             REA06420
         STH   R0,0(R9)           STORE IN FRONT OF RECORD DATA         REA06430
         TM    READFLAG,TAB       SHOULD TAB BIT BE TURNED ON ??        REA06440
         BNO   CON640             NOPE.                                 REA06450
         OI    0(R9),X'80'        ELSE TURN IT ON THEN.                 REA06460
         NI    READFLAG,ALL-TAB   RESET TAB BIT FOR NEXT RECORD.        REA06470
CON640   DS    0H                                                       REA06480
         SLL   R0,1            GO BACK TO RECORD BYTE COUNT AGAIN       REA06490
         C     R0,BIGGEST      IS THIS RECORD THE BIGGEST THUS FAR?     REA06500
         BNH   CON650          NOPE                                     REA06510
         ST    R0,BIGGEST      WE'VE GOT A NEW BIGGEST RECORD           REA06520
CON650   DS    0H                                                       REA06530
*    BUMP R0 = THIS RECORD'S LENGTH TO INCLUDE LENGTH FIELD.            REA06540
         AH    R0,=H'2'        INCLUDE LENGTH FIELD IN RECORD LENGTH    REA06550
         C     R0,=F'1710'     RECORDS BIGGER THAN 1710 WON'T FIT IN    REA06560
         BNH   CON655          ONE SOURCE FORMAT BLOCK.                 REA06570
         BAL   R15,CLOSEBLK             GO TIDY UP THIS BLOCK           REA06580
         MVC   RETCODE,=X'00002020'     RETURN CODE = 2020.             REA06590
         B     CON700                   TIME TO QUIT.                   REA06600
CON655   DS    0H                                                       REA06610
*    NOW, WILL THIS RECORD FIT INTO THIS BLOCK ??                       REA06620
         CR    R0,R14    IS THIS RECORD LENGTH < ROOM LEFT IN BLOCK ??  REA06630
         BH    CON660    NOPE, WON'T FIT.  DONE WITH THIS BLOCK THEN.   REA06640
*    ELSE, MOVE THIS RECORD INTO THIS BLOCK.                            REA06650
         STM   R4,R7,TEMPA      FREE UP SOME REGISTERS FOR THE MVCL     REA06660
         LR    R4,R13               R4 = DESTINATION ADDRESS            REA06670
         LR    R5,R0                R5 = DESTINATION LENGTH             REA06680
         LA    R6,0(R9)             R6 = SOURCE ADDRESS                 REA06690
         LR    R7,R0                R7 = PAD CHARACTER (X'00') AND      REA06700
         MVCL  R4,R6                     SOURCE LENGTH                  REA06710
         LM    R4,R7,TEMPA      RESTORE THOSE REGISTERS                 REA06720
*    NOW, UPDATE THE REGISTERS TO REFLECT THIS ADDITIONAL RECORD IN     REA06730
         AR    R8,R0           THIS BLOCK.  UPDATE BYTE COUNT.          REA06740
         LA    R7,1(R7)        UPDATE RECORD COUNT.                     REA06750
         SR    R14,R0          LESS ROOM LEFT IN BLOCK NOW.             REA06760
         AR    R13,R0          MOVE NEXT RECORD UPSTREAM IF IT FITS.    REA06770
         B     CON610          CONTINUE READING CMS RECORDS.            REA06780
*    THIS LAST CMS RECORD WOULDN'T FIT INTO THIS BLOCK.  THAT MEANS     REA06790
*    THAT THIS BLOCK IS FILLED UP.  FINISH IT OFF, AND SEE IF WE'VE     REA06800
*    GOT ANOTHER BLOCK TO DO.                                           REA06810
CON660   DS    0H                                                       REA06820
         BAL   R15,CLOSEBLK    GO TIDY UP THIS BLOCK                    REA06830
         CLC   THISBLK#,BLKWANTS  HAVE WE FINISHED ENOUGH BLOCKS YET ?? REA06840
         BNL   CON700             YEP, ALL DONE READING THEN.           REA06850
         L     R7,THISBLK#        INCREMENT THIS BLOCK NUMBER.  WE'RE   REA06860
         LA    R7,1(R7)           GOING TO BE DOING THE NEXT BLOCK.     REA06870
         ST    R7,THISBLK#                                              REA06880
         LA    R12,1740(R12)      BUMP BLOCK BASE POINTER TO NEXT BLOCK REA06890
         LA    R7,1               INITIALIZE # RECORDS IN THIS BLOCK    REA06900
         LR    R8,R0              INITIALIZE # BYTES USED IN THIS BLOCK REA06910
         B     CON600          GO START DOING THIS BLOCK.               REA06920
*                                                                       REA06930
CON700   DS    0H                                                       REA06940
*    WE'VE DECIDED TO STOP READING CMS RECORDS.  THERE ARE 4 WAYS       REA06950
*    WE COULD GET HERE.                                                 REA06960
*    1)  WE HIT END-OF-FILE ON THE CMS FILE (MOST NORMAL CASE).         REA06970
*        THE EOF BIT IS SET IN READFLAG.                                REA06980
*    2)  WE FILLED UP AS MANY BLOCKS OF OUTPUT AS HE SAID HE WANTED     REA06990
*        (SECOND MOST NORMAL CASE).                                     REA07000
*    3)  WE FOUND A CMS RECORD THAT WAS LARGER THAN 1708 BYTES.         REA07010
*        (MOST LIKELY ERROR).  THIS CMS RECORD IS TOO LARGE TO FIT IN   REA07020
*        A SOURCE FORMAT OUTPUT BLOCK.                                  REA07030
*    4)  WE GOT SOME OTHER KIND OF ERROR (MAYBE WE RAN OUT OF INPUT     REA07040
*        BUFFER SPACE) WHEN WE DID THE FSREAD (MOST UNLIKELY CASE).     REA07050
*                                                                       REA07060
*    REGARDLESS OF HOW WE GOT HERE, WE ARE DONE READING RECORDS.        REA07070
*    NOW WE'VE GOT TO DETERMINE THE ENDING VARIABLES TO PASS BACK TO    REA07080
*    THE UTS MACHINE, VIZ,                                              REA07090
*        THE NUMBER OF COMPLETE BLOCKS WE CAN GIVE HIM (DONE#R),        REA07100
*        THE NUMBER OF BYTES IN THOSE COMPLETED BLOCKS (DONE#B),        REA07110
*        THE NUMBER OF BYTES WE'RE GOING TO GIVE HIM (GAVE#B),          REA07120
*        AND THE NEXT STARTING RECORD NUMBER (NEXTSR#).                 REA07130
*                                                                       REA07140
         L     R15,THISBLK#        MULTIPLY NUMBER OF BLOCKS WE'VE      REA07150
         MH    R15,=H'1740'        DONE BY EACH BLOCK'S LENGTH          REA07160
         C     R15,NUMWANTS    ARE WE TRUNCATING THE LAST BLOCK ??      REA07170
         BNH   CON710          NO, NORMAL CASE.                         REA07180
*    THIS WOULD ONLY HAPPEN IF THE NUMBER OF BYTES HE ASKED FOR WAS     REA07190
*    NOT A MULTIPLE OF 1740 AND WE DID NOT HIT THE END OF THE CMS       REA07200
*    FILE.  IN THAT CASE, SINCE BLKWANTS = (NUMWANTS+1739) / 1740,      REA07210
*    BLKWANTS IS ONE MORE THAN THE NUMBER OF COMPLETE BLOCKS WE'RE      REA07220
*    GOING TO SEND HIM.  SO WE WENT AHEAD AND FILLED THE N+1ST          REA07230
*    BLOCK AND NOW WE'VE GOT TO TRUNCATE IT.                            REA07240
         L     R15,THISBLK#       DONE#R = THISBLK# - 1                 REA07250
         BCTR  R15,R0                                                   REA07260
         ST    R15,DONE#R                                               REA07270
         MH    R15,=H'1740'       DONE#B = DONE#R * 1740                REA07280
         ST    R15,DONE#B                                               REA07290
         MVC   GAVE#B,NUMWANTS    GO AHEAD AND GIVE HIM THE EXTRA       REA07300
*                                 GARBAGE OF THE PARTIAL BLOCK.         REA07310
         L     R15,OLDPLC     THE NEXT STARTING RECORD NUMBER IS        REA07320
         LA    R15,1(R15)     THE PREVIOUS BLOCK'S LINE COUNT + 1.      REA07330
         ST    R15,NEXTSR#                                              REA07340
         B     CON720                                                   REA07350
*                                                                       REA07360
CON710   DS    0H                                                       REA07370
*    THIS IS THE NORMAL CASE.  THE NUMBER OF BYTES IN THE BLOCKS WE'VE  REA07380
*    FILLED WAS LESS THAN OR EQUAL TO THE NUMBER OF BYTES HE WANTED.    REA07390
         L     R15,THISBLK#       DONE#R = THISBLK#                     REA07400
         ST    R15,DONE#R                                               REA07410
         MH    R15,=H'1740'       DONE#B = DONE#R * 1740                REA07420
         ST    R15,DONE#B                                               REA07430
         ST    R15,GAVE#B         ONLY GIVE HIM THE NUMBER OF BYTES     REA07440
*                                 WE'VE DONE, NOT WHAT HE ASKED FOR.    REA07450
         L     R15,PRLINCNT          THE NEXT STARTING RECORD NUMBER    REA07460
         LA    R15,1(R15)            IS THIS BLOCK'S LINE COUNT + 1.    REA07470
         ST    R15,NEXTSR#                                              REA07480
*    THE END-OF-FILE CODE UP ABOVE LEFT IT UP TO ME HERE TO SET THE     REA07490
*    RETURN CODE.  THE REASON BEING IS THAT WE WANT A ZERO RETURN       REA07500
*    CODE IF THIS LAST BLOCK WASN'T GOING TO BE TRANSFERRED (AS IT      REA07510
*    WOULDN'T BE IF NUMWANTS = 10 AND THE FILE FIT INTO ONE BLOCK).     REA07520
         TM    READFLAG,EOF          ONLY CHANGE THE RETURN CODE IF     REA07530
         BNO   CON720                1)  WE HIT END-OF-FILE AND         REA07540
         CLC   RETCODE,=X'00000000'  2)  THE RETURN CODE HASN'T         REA07550
         BNE   CON720                    ALREADY BEEN SET TO SOMETHING  REA07560
         MVC   RETCODE,=X'00000004'                                     REA07570
*                                                                       REA07580
CON720   DS    0H                                                       REA07590
         L     R7,NEXTSR#      GET STARTING RECORD # FOR NEXT READ      REA07600
         CVD   R7,TEMPA                                                 REA07610
         OI    TEMPA+7,X'0F'                                            REA07620
         UNPK  TEMPB,TEMPA                                              REA07630
         L     R9,ABUFFER      POINT TO START OF REPLY CONTROL BLOCK    REA07640
         MVC   80(8,R9),TEMPB  MOVE IN STARTING RCD # FOR NEXT READ     REA07650
         B     CON810                                                   REA07660
         EJECT                                                          REA07670
*    THIS BLOCK HAS BEEN FINISHED.  NOW CLEAN IT UP BY PUTTING THE      REA07680
*    BEGINNING AND ENDING INFORMATIONAL DATA AROUND THE ACTUAL FILE     REA07690
*    DATA LIKE SO.                                                      REA07700
*    -------------------------------------------------------------      REA07710
*    | FID | FIRST 5 CHARS FROM FILENAME |  X'F900'  |  # BYTES  |      REA07720
*    -------------------------------------------------------------      REA07730
*    |                                                           |      REA07740
*    |    ---------- A C T U A L   F I L E   D A T A -------     |      REA07750
*    |    1710 BYTES OF FILE DATA IN VARIABLE LENGTH FORMAT.     |      REA07760
*    |    2 BYTES FOR THE LENGTH FIELD (WITH THE HIGH ORDER      |      REA07770
*  --/--  BIT INDICATING A TABBED RECORD) FOLLOWED BY UP TO    --/--    REA07780
*    |    1708 BYTES OF DATA IN THIS RECORD.  THE REST OF        |      REA07790
*    |    THIS FIELD IS PADDED WITH HEX ZEROS.                   |      REA07800
*    |                                                           |      REA07810
*    -------------------------------------------------------------      REA07820
*    |  BLOCK #  | # RECORDS |  # BYTES  | BLOCK #+1 | LINE COUNT|      REA07830
*    -------------------------------------------------------------      REA07840
*    |                10 BYTES OF HEX ZEROS                      |      REA07850
*    -------------------------------------------------------------      REA07860
*                                                                       REA07870
CLOSEBLK DS    0H                                                       REA07880
         MVC   0(1,R12),CBUSRFID    USER'S FILE ID (FROM CONFIG FILE)   REA07890
         MVC   1(5,R12),PARM4       FIRST 5 CHARACTERS OF FILE NAME     REA07900
         MVC   6(2,R12),=X'F900'                                        REA07910
         STM   R4,R7,TEMPA      FREE UP SOME REGISTERS FOR THE MVCL     REA07920
         LR    R4,R8                                                    REA07930
         SRL   R4,1                                                     REA07940
         STH   R4,8(R12)            BYTE COUNT IN THIS BLOCK            REA07950
         STH   R4,1724(R12)         NUMBER BYTES IN THIS BLOCK AGAIN    REA07960
*    PAD THE REST OF THE INPUT AREA IN THIS BLOCK IF NEEDED.            REA07970
         LTR   R14,R14          IF BLOCK IS COMPLETELY FILLED,          REA07980
         BZ    CLOSCONA         THEN PADDING IS NOT NECESSARY           REA07990
         LR    R4,R13               R4 = DESTINATION ADDRESS            REA08000
         LR    R5,R14               R5 = DESTINATION LENGTH             REA08010
         SR    R6,R6                R6 = SOURCE ADDRESS (UNIMPORTANT)   REA08020
         SR    R7,R7                R7 = PAD CHARACTER (X'00') AND      REA08030
         MVCL  R4,R6                     SOURCE LENGTH (ALSO ZERO)      REA08040
CLOSCONA LM    R5,R7,TEMPA+4    RESTORE SOME OF THOSE REGISTERS BACK    REA08050
         MVC   1720(2,R12),THISBLK#+2    THIS BLOCK NUMBER              REA08060
         STH   R7,1722(R12)              NUMBER RECORDS IN THIS BLOCK   REA08070
         TM    READFLAG,EOF              IF END OF FILE,                REA08080
         BNO   CLOSCONB                                                 REA08090
         XC    1726(2,R12),1726(R12)     THEN NEXT BLOCK NUMBER = 0     REA08100
         B     CLOSCONC                                                 REA08110
CLOSCONB L     R4,THISBLK#               NEXT BLOCK NUMBER              REA08120
         LA    R4,1(R4)                                                 REA08130
         STH   R4,1726(R12)                                             REA08140
CLOSCONC L     R4,PRLINCNT                                              REA08150
         STH   R4,1728(R12)              PREVIOUS LINE COUNT            REA08160
         ST    R4,OLDPLC       SAVE OLD PREVIOUS LINE COUNT             REA08170
         AR    R4,R7                                                    REA08180
         ST    R4,PRLINCNT     SAVE NEW PREVIOUS LINE COUNT             REA08190
         L     R4,TEMPA        RESTORE THE LAST OF THOSE REGISTERS BACK REA08200
         XC    1730(10,R12),1730(R12)                                   REA08210
         BR    R15                                                      REA08220
*                                                                       REA08230
CON800   DS    0H                                                       REA08240
*    AT THIS POINT, WE'VE READ IN ALL THE DATA HE WANTED TRANSFERRED    REA08250
*    AND ITS ALL SITTING IN THE OUTPUT BUFFER, WAITING TO GO.           REA08260
*    ALSO DONE#R = THE NUMBER OF RECORDS WE'VE READ IN (COULD BE 0)     REA08270
*         DONE#B  = THE TOTAL NUMBER OF BYTES WE'VE READ IN             REA08280
*         BIGGEST = THE LENGTH OF THE BIGGEST CMS RECORD WE CAME ACROSS REA08290
*         RETCODE = 0                                                   REA08300
*    AND  EOF IS SET IF WE GOT THE LAST RECORD IN THE CMS FILE TO       REA08310
*             COMPLETELY FIT IN THE OUTPUT AREA.                        REA08320
*                                                                       REA08330
*    WE MUST NOW FIGURE OUT A FEW MORE VARIABLES TO PASS BACK TO        REA08340
*    THE UTS, NAMELY                                                    REA08350
*        1)  STARTING RECORD NUMBER FOR NEXT READ (IF ANY):             REA08360
*            SIMPLY STARTRCD + DONE#R.                                  REA08370
*        2)  NUMBER OF BYTES WE'RE GOING TO TRANSFER:                   REA08380
*            IF EOF = ON, THEN ONLY TRANSFER DONE#B NUMBER OF BYTES,    REA08390
*            ELSE GIVE HIM ALL HE ASKED FOR (NUMWANTS).                 REA08400
*        3)  RETCODE:  IF RETCODE = 0 AND EOF = ON,                     REA08410
*                      THEN RETCODE = 0004,                             REA08420
*                      ELSE USE THE NON-ZERO RETCODE.                   REA08430
*                                                                       REA08440
         A     R7,STARTRCD     GET STARTING RECORD # FOR NEXT READ      REA08450
         CVD   R7,TEMPA                                                 REA08460
         OI    TEMPA+7,X'0F'                                            REA08470
         UNPK  TEMPB,TEMPA                                              REA08480
         L     R9,ABUFFER      POINT TO START OF REPLY CONTROL BLOCK    REA08490
         MVC   80(8,R9),TEMPB  MOVE IN STARTING RCD # FOR NEXT READ     REA08500
         MVC   GAVE#B,NUMWANTS      ASSUME WE DID NOT HIT END-OF-FILE   REA08510
         TM    READFLAG,EOF         WAS I RIGHT ??                      REA08520
         BNO   CON810               YEP, BRANCH.  RETCODE IS GOOD AS IS REA08530
         MVC   GAVE#B,DONE#B        ELSE JUST GIVE HIM # BYTES IN FILE  REA08540
         CLC   RETCODE,=X'00000000'     IF WE DID HIT THE END-OF-FILE   REA08550
         BNE   CON810                   AND THE RETURN CODE IS NOW 0,   REA08560
         MVC   RETCODE,=X'00000004'     THEN MAKE THE RETURN CODE = 4.  REA08570
CON810   DS    0H                                                       REA08580
*    ALL THE WORK SHOULD BE DONE AT THIS POINT.  NOW FILL IN THE        REA08590
*    REPLY CONTROL BLOCK WITH ALL THE DATA YOU'VE BEEN COLLECTING.      REA08600
*    ALL THE VARIABLES GET PUT AT THE END OF THE REPLY CONTROL          REA08610
*    BLOCK LIKE SO (ALL IN HEX)                                         REA08620
*    |     |     |     |     |     |     |     |     |                  REA08630
*    |     |     |     |     |     |     |     |     |                  REA08640
*    |-----------------------------------------------|                  REA08650
*    |        TODAY'S DATE IN MM/DD/YY FORMAT        |                  REA08660
*    |-----------------------------------------------|                  REA08670
*    |        CURRENT TIME IN HH:MM:SS FORMAT        |                  REA08680
*    |-----------------------------------------------|                  REA08690
*    |        DONE#B         |  DONE#R   |  BIGGEST  |                  REA08700
*    |-----------------------------------------------|                  REA08710
*    |  RETCODE  |              GAVE#B               |                  REA08720
*    |-----------------------------------------------|                  REA08730
         L     R9,ABUFFER      POINT TO START OF REPLY CONTROL BLOCK    REA08740
*-------------------------------------------------------------*         REA08750
*    GET THE TIME AND DATE FROM CP                            *         REA08760
*-------------------------------------------------------------*         REA08770
         LA    R1,CPDATA           ADDRESS OF DATA FROM DIAG            REA08780
         DIAG  R1,R0,X'000C'       REQUEST DATE AND TIME FROM CP        REA08790
*-------------------------------------------------------------*         REA08800
*    CPDATA IS NOW IN THE FORMAT OF                           *         REA08810
*           DC    CL8'MM/DD/YY'                               *         REA08820
*           DC    CL8'HH:MM:SS'                               *         REA08830
*           DS    2D     THE REST IS JUNK                     *         REA08840
*-------------------------------------------------------------*         REA08850
         MVC    96(8,R9),CPDATA                                         REA08860
         MVC   104(8,R9),CPDATA+8                                       REA08870
         MVC   112(4,R9),DONE#B                                         REA08880
         MVC   116(2,R9),DONE#R+2                                       REA08890
         MVC   118(2,R9),BIGGEST+2                                      REA08900
         MVC   120(2,R9),RETCODE+2                                      REA08910
*                                  I'M RESERVING 6 BYTES FOR GAVE#B     REA08920
         XC    122(2,R9),122(R9)   'CAUSE THE LENGTH FIELD IN A CCW     REA08930
         MVC   124(4,R9),GAVE#B    IS 6 BYTES.  ONE DAY WE MAY NEED IT. REA08940
*                                                                       REA08950
*    NOW GIVE ALL THE DATA TO THE UTS MACHINE.                          REA08960
*                                                                       REA08970
         L     R0,GAVE#B                                                REA08980
         AH    R0,=H'128'                                               REA08990
         L     R1,ABUFFER                                               REA09000
         L     R15,AWRITUTS                                             REA09010
         BALR  R14,R15                                                  REA09020
         LTR   R15,R15                                                  REA09030
         BZ    RCISGOOD                                                 REA09040
         LR    R12,R15                                                  REA09050
         LINEDIT TEXT='BAD RETURN CODE INSIDE READ ASSEMBLE FROM AWRITU-REA09060
               TS ROUTINE - RC = ....',SUB=(HEXA,(R12)),RENT=NO         REA09070
         EJECT                                                          REA09080
*                                                                       REA09090
*                                                                       REA09100
*       END OF PROGRAM THUS FAR                                         REA09110
*                                                                       REA09120
*                                                                       REA09130
RCISGOOD EQU   *                                                        REA09140
 PRINT GEN,NODATA                                                       REA09150
         TM    TEST0108,TEST7                                           REA09160
         BNO   NOTRACB                                                  REA09170
         LINEDIT TEXT='DONE FOR NOW.  RETURN CODE = ...., # BYTES TRANS-REA09180
               FERRED = ..........',SUB=(HEXA,RETCODE,DECA,GAVE#B),RENT-REA09190
               =NO                                                      REA09200
         LINEDIT TEXT='# COMPLETED RECORDS = ........, # COMPLETED BYTE-REA09210
               S = ..........',SUB=(DECA,DONE#R,DECA,DONE#B),RENT=NO    REA09220
         LINEDIT TEXT='# BYTES YOU WANTED = ........, UTS LRECL = .....-REA09230
               .,STARTING RECORD # = ....',SUB=(DECA,NUMWANTS,DECA,UTSL-REA09240
               RECL,DECA,STARTRCD),RENT=NO                              REA09250
         LA    R12,PADCHAR-3                                            REA09260
         LINEDIT TEXT='THE PAD CHARACTER WAS HEX .., AND THE BIGGEST RE-REA09270
               CORD SIZE I FOUND WAS .......',SUB=(HEXA,(R12),DECA,BIGG-REA09280
               EST),RENT=NO                                             REA09290
         L     R12,ABUFFER       BUFFER START                           REA09300
         A     R12,GAVE#B        + NUMBER OF BYTES I GAVE HIM           REA09310
         BCTR  R12,R0            - 1 = THE END OF THE OUTPUT BUFFER     REA09320
         LINEDIT TEXT='BUFFER ENDS AT ......',SUB=(HEX,(R12))           REA09330
         TM    READFLAG,EOF                                             REA09340
         BO    EOPA                                                     REA09350
         LINEDIT TEXT='END OF FILE WAS NOT HIT'                         REA09360
         B     EOPB                                                     REA09370
EOPA     LINEDIT TEXT='END OF FILE WAS HIT'                             REA09380
EOPB     TM    READFLAG,LASTINC                                         REA09390
         BO    EOPC                                                     REA09400
         LINEDIT TEXT='LAST RECORD IS NOT INCOMPLETE'                   REA09410
         B     EOPD                                                     REA09420
EOPC     LINEDIT TEXT='LAST RECORD IS INCOMPLETE'                       REA09430
EOPD     EQU   *                                                        REA09440
NOTRACB  EQU   *                                                        REA09450
 PRINT   GEN,NODATA                                                     REA09460
READBYE  EQU   *                                                        REA09470
         FSCLOSE FSCB=MYFSCB                                            REA09480
         LM    R0,R14,REGSAVE    RESTORE CALLER'S REGISTERS             REA09490
         BR    R14               GOODBYE.                               REA09500
*                                                                       REA09510
CANTREAD DS    0H                                                       REA09520
*    THIS GUY TRIED TO READ A DISK THAT HAD A READ PASSWORD OF C'NONE'  REA09530
*    MEANING THAT HE'S NOT ALLOWED TO READ IT (KINDA LIKE WRITE-ONLY    REA09540
*    MEMORY).  RETCODE = X'2004'                                        REA09550
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA09560
         MVC   RETCODE,=X'00002004'                                     REA09570
         B     CON810                                                   REA09580
         SPACE 4                                                        REA09590
WRONGPW  DS    0H                                                       REA09600
*    THIS GUY GAVE ME THE WRONG PASSWORD TO READ THIS DISK.  THAT'S A   REA09610
*    NO-NO.  RETCODE = X'1010'                                          REA09620
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA09630
         MVC   RETCODE,=X'00001010'                                     REA09640
         B     CON810                                                   REA09650
         EJECT                                                          REA09660
READERRA DS    0H                                                       REA09670
*    WE GOT AN ERROR FROM THE ACCESS ROUTINE.                           REA09680
*    IF R15 = 04, THEN THIS UTS WAS NOT FOUND IN THE UTSCB CHAIN        REA09690
*                 (CAN NEVER HAPPEN).  RETCODE = X'6004'                REA09700
*    IF R15 = 08, THEN THIS USER WAS NOT FOUND IN THE USERCB CHAIN      REA09710
*                 FOR THIS UTS.  RETCODE = X'4004'                      REA09720
*    IF R15 = 12, THEN THIS DISK WAS NOT FOUND IN THE DISKCB CHAIN      REA09730
*                 FOR THIS USER.  RETCODE = X'100C'                     REA09740
*    IF R15 = 16, THEN THE DISK WAS FOUND, BUT THERE'S NOT A MINIDISK   REA09750
*                 AT THAT ADDRESS (CONFIGURATION ERROR).                REA09760
*                 RETCODE = X'4008'                                     REA09770
*    IF R15 = 20, THEN SOME OTHER ERROR HAPPENED IN THE ACCESS          REA09780
*                 ROUTINE.  RETCODE = X'5004'                           REA09790
*    IF R15 = ??, THEN PROGRAMMING ERROR.  RETCODE = X'7004'            REA09800
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA09810
         C     R15,=F'4'                                                REA09820
         BNE   ERRA1                                                    REA09830
         MVC   RETCODE,=X'00006004'                                     REA09840
         B     ERRABYE                                                  REA09850
ERRA1    C     R15,=F'8'                                                REA09860
         BNE   ERRA2                                                    REA09870
         MVC   RETCODE,=X'00004004'                                     REA09880
         B     ERRABYE                                                  REA09890
ERRA2    C     R15,=F'12'                                               REA09900
         BNE   ERRA3                                                    REA09910
         MVC   RETCODE,=X'0000100C'                                     REA09920
         B     ERRABYE                                                  REA09930
ERRA3    C     R15,=F'16'                                               REA09940
         BNE   ERRA4                                                    REA09950
         MVC   RETCODE,=X'00004008'                                     REA09960
         B     ERRABYE                                                  REA09970
ERRA4    C     R15,=F'20'                                               REA09980
         BNE   ERRA5                                                    REA09990
         MVC   RETCODE,=X'00005004'                                     REA10000
         B     ERRABYE                                                  REA10010
ERRA5    MVC   RETCODE,=X'00007004'                                     REA10020
ERRABYE  B     CON810                                                   REA10030
         EJECT                                                          REA10040
READERRB DS    0H                                                       REA10050
*    WE GOT A BAD RETURN CODE FROM THE FSSTATE MACRO                    REA10060
*    IF R15 = 20, INVALID CHARACTER IN FILE ID.  RETCODE = X'1008'      REA10070
*    IF R15 = 28, FILE DOES NOT EXIST.  RETCODE = X'2008'               REA10080
*    IF R15 = ??, INVALID FILEMODE, DISK NOT ACCESSED, OR OTHER         REA10090
*                 FSSTATE ERROR.  RETCODE = X'5008'                     REA10100
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10110
         C     R15,=F'20'                                               REA10120
         BNE   ERRB1                                                    REA10130
         MVC   RETCODE,=X'00001008'                                     REA10140
         B     ERRBBYE                                                  REA10150
ERRB1    C     R15,=F'28'                                               REA10160
         BNE   ERRB2                                                    REA10170
         MVC   RETCODE,=X'00002008'                                     REA10180
         B     ERRBBYE                                                  REA10190
ERRB2    MVC   RETCODE,=X'00005008'                                     REA10200
ERRBBYE  B     CON810                                                   REA10210
         EJECT                                                          REA10220
READERRC DS    0H                                                       REA10230
*    WE GOT A BAD RETURN CODE WHILE CONVERTING THE OUTPUT RECORD        REA10240
*    LENGTH.  RETCODE = X'1018'                                         REA10250
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10260
         MVC   RETCODE,=X'00001018'                                     REA10270
         B     CON810                                                   REA10280
         SPACE 4                                                        REA10290
READERRD DS    0H                                                       REA10300
*    WE GOT A BAD RETURN CODE WHILE CONVERTING THE NUMBER OF BYTES      REA10310
*    THE UTS WANTS TO A BINARY NUMBER.  SO, I DON'T KNOW HOW MANY       REA10320
*    BYTES TO READ.  RETCODE = X'1004'                                  REA10330
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10340
         MVC   RETCODE,=X'00001004'                                     REA10350
         B     CON810                                                   REA10360
         SPACE 4                                                        REA10370
READERRE DS    0H                                                       REA10380
*    WE GOT A BAD RETURN CODE FROM THE FSOPEN MACRO (SHOULD NEVER       REA10390
*    HAPPEN).  RETCODE = X'500C'                                        REA10400
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10410
         MVC   RETCODE,=X'0000500C'                                     REA10420
         B     CON810                                                   REA10430
         EJECT                                                          REA10440
READERRF DS    0H                                                       REA10450
*    WE GOT AN ERROR CONVERTING THE STARTING RECORD NUMBER TO A         REA10460
*    BINARY NUMBER.  RETCODE = X'1014'                                  REA10470
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10480
         MVC   RETCODE,=X'00001014'                                     REA10490
         B     CON810                                                   REA10500
         SPACE 4                                                        REA10510
READERRG DS    0H                                                       REA10520
*    THE STARTING RECORD NUMBER HE GAVE ME IS LARGER THAN THE           REA10530
*    NUMBER OF RECORDS IN THIS CMS FILE.  RETCODE = X'200C'             REA10540
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10550
         MVC   RETCODE,=X'0000200C'                                     REA10560
         B     CON810                                                   REA10570
         EJECT                                                          REA10580
READERRH DS    0H                                                       REA10590
*    WE GOT A NON-ZERO RETURN CODE BACK FROM THE FSREAD MACRO AND       REA10600
*    IT'S NOT JUST THE END-OF-FILE.                                     REA10610
*    IF R15 = 8, WE RAN OUT OF BUFFER SPACE.  CURRENTLY, MY OUTPUT      REA10620
*    BUFFER IS JUST OVER 192 K (BIG ENOUGH TO READ 3 64-K RECORDS       REA10630
*    IN VARIABLE LENGTH FORMAT).  IF HE'S GONE OVER THAT, FIRST OF      REA10640
*    ALL THIS IS A HUGE FILE, AND SECONDLY, THE UTS PROBABLY DOESN'T    REA10650
*    HAVE THAT MUCH MEMORY.  RETCODE = X'5014'                          REA10660
         C     R15,=F'8'         DID I RUN OUT OF BUFFER SPACE ??       REA10670
         BNE   ERRHC             NO, SOME OTHER KIND OF ERROR.          REA10680
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10690
         MVC   RETCODE,=X'00005014'                                     REA10700
         B     CON810                                                   REA10710
ERRHC    EQU   *                                                        REA10720
*    IT IS A REAL I/O ERROR.  RETCODE = X'5018'.                        REA10730
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10740
         MVC   RETCODE,=X'00005018'                                     REA10750
         B     CON810                                                   REA10760
         EJECT                                                          REA10770
READERRI DS    0H                                                       REA10780
*    WE GOT AN ERROR FROM THE FSPOINT MACRO.  SHOULD NEVER HAPPEN,      REA10790
*    THEREFORE RETCODE = X'600C'                                        REA10800
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10810
         MVC   RETCODE,=X'0000600C'                                     REA10820
         B     CON810                                                   REA10830
         SPACE 4                                                        REA10840
READERRJ DS    0H                                                       REA10850
*    WE TRIED TO READ A CMS RECORD THAT WAS TOO BIG TO PUT INTO         REA10860
*    VARIABLE LENGTH FORMAT.  CMS ALLOWS RECORD LENGTHS UP TO 65535     REA10870
*    WHICH, SINCE IT'S ODD, GETS 1 BYTE PADDED AT THE END.  THIS        REA10880
*    MAKES THE LENGTH 65536 WHICH IS X'10000' - TOO BIG TO FIT INTO     REA10890
*    A 2-BYTE FIELD LENGTH.  THEREFORE RETCODE = X'2020'                REA10900
         OI    READFLAG,ERROR           YES, WE HAD AN ERROR            REA10910
         MVC   RETCODE,=X'00002020'                                     REA10920
         B     CON810                                                   REA10930
         SPACE 4                                                        REA10940
CPDATA   DS    4D        DATA AREA FOR CP TO RETURN THE DATE & TIME     REA10950
REGSAVE  DS    15F       READ ROUTINE REGISTER SAVE AREA                REA10960
UTSPARMS DS    0CL56     DIFFERENT VARIABLES USED IN THIS ROUTINE       REA10970
STARTRCD DS    F      1. STARTING RECORD NUMBER IN THE CMS FILE         REA10980
NEXTSR#  DS    F      2. NEXT STARTING RECORD NUMBER                    REA10990
NUMWANTS DS    F      3. NUMBER OF BYTES THE UTS WANTS                  REA11000
BLKWANTS DS    F      4. NUMBER OF BLOCKS HE WANTS WHEN SOURCE FORMAT   REA11010
AEODATA  DS    F      5. ADDRESS OF LAST POSSIBLE DATA BYTE IN OUTPUT   REA11020
UTSLRECL DS    F      6. LRECL OF FIXED-LENGTH UTS DATA                 REA11030
THISBLK# DS    F      7. CURRENT SOURCE BLOCK NUMBER (1-N)              REA11040
PRLINCNT DS    F      8. NUMBER OF LINES BEFORE THIS SOURCE BLOCK       REA11050
OLDPLC   DS    F      9. OLD VALUE OF PRLINCNT                          REA11060
RETCODE  DS    F     10. RETURN CODE                                    REA11070
GAVE#B   DS    F     11. NUMBER OF BYTES I GAVE HIM THIS TIME           REA11080
BIGGEST  DS    F     12. BIGGEST RECORD LENGTH I FOUND IN THIS CMS FILE REA11090
DONE#R   DS    F     13. NUMBER OF COMPLETE RECORDS READ THIS TIME      REA11100
DONE#B   DS    F     14. NUMBER OF BYTES IN THOSE COMPLETE RECORDS      REA11110
*                                                                       REA11120
TEMPA    DS    D         TEMPORARY WORK AREAS FOR UNPACKING, ETC        REA11130
TEMPB    DS    D                                                        REA11140
MYFSCB   FSCB   'ICATS CONFIG A'                                        REA11150
PADCHAR  DS    C         PAD CHARACTER IN CASE WE'RE PASSING A VARIABLE REA11160
*                        LENGTH CMS FILE IN FIXED UTS FORMAT AND THE    REA11170
*                        RECORD LENGTH FOR THIS CMS RECORD < LRECL      REA11180
READFLAG DC    X'00'        STATUS FLAG FOR READ ROUTINE                REA11190
FIXEDCMS     EQU   X'80'      1 = THE CMS FILE HAS FIXED LENGTH RECORDS REA11200
*                                 ELSE IT HAS VARIABLE LENGTH RECORDS   REA11210
FIXEDUTS     EQU   X'40'      1 = HE WANTS THE DATA IN UTS FIXED FORMAT REA11220
*                                 ELSE HE WANTS DATA IN VARIABLE FORMAT REA11230
TRUNC        EQU   X'20'      1 = TRUNCATION HAS OCCURED                REA11240
LASTINC      EQU   X'10'      1 = LAST OUTPUT RECORD IS INCOMPLETE      REA11250
*                                 CAUSE HIS BYTE COUNT WAS TOO SMALL    REA11260
EOF          EQU   X'08'      1 = END OF FILE WAS HIT DURING THIS READ  REA11270
ERROR        EQU   X'04'      1 = THERE WAS AN ERROR DURING THIS READ   REA11280
SFORMAT      EQU   X'02'      1 = HE WANTS THE OUTPUT IN SOURCE FORMAT  REA11290
TAB          EQU   X'01'      1 = THIS RECORD WILL BE TABBED            REA11300
         LTORG                                                          REA11310
*                                                                       REA11320
         FSTD                                                           REA11330
READ     CSECT            GO BACK TO NORMAL CSECT                       REA11340
         ICDATA                                                         REA11350
         END                                                            REA11360