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