CMP TITLE 'DMSCMP (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME: 00004000 * 00005000 * DMSCMP (COMPARE) 00006000 * 00007000 * FUNCTION: 00008000 * 00009000 * TO COMPARE TWO DISK FILES 00010000 * 00011000 * ATTRIBUTES: 00012000 * 00013000 * TRANSIENT (WITH SYSTEM OPTION); SERIALLY REUSABLE. 00014000 * 00015000 * ENTRY POINTS: 00016000 * 00017000 * COMPARE 00018000 * 00019000 * ENTRY CONDITIONS: 00020000 * 00021000 * COMPARE: 00022000 * GPR1 - A(PLIST) 00023000 * PLIST 00024000 * CL8'COMPARE' 00025000 * CL8 FILENAME1 00026000 * CL8 FILETYPE1 00027000 * CL8 FILEMODE1 00028000 * CL8 FILENAME2 00029000 * CL8 FILETYPE2 00030000 * CL8 FILEMODE2 00031000 * OPTIONAL 00032000 * CL8'(' START OF OPTIONS 00033000 * CL8'COL' DEFINING COMPARE FIELD 00034000 * CL8'MM',CL8'NN MM IS START POSITION 00035000 * AND NN IS END POSITION 00036000 * OR 00037000 * CL8'MM-NN' USE SINGLE FIELD FOR 00038000 * START AND END POSITIONS 00039000 * CL8')' END OF OPTION LIST 00040000 * XL8'FF' END OF PARAMETER LIST 00041000 * 00042000 * EXIT CONDITIONS: 00043000 * 00044000 * NORMAL - 00045000 * GPR15 = 0 : FILES ARE IDENTICAL 00046000 * 00047000 * ERROR - 00048000 * GPR15 = XX: 00049000 * 4 - FILES ARE NOT EQUAL 00050000 * 20 - INVALID * IN FILEID 00051000 * 24 - INVALID OPTION 00052000 * IDENTICAL FILEIDS 00053000 * COL EXCEEDS RECORD LENGTH 00054000 * INVALID PARAMETER IN COLUMN FIELD 00055000 * INCOMPLETE FILEID 00056000 * 28 - FILE NOT FOUND 00057000 * 32 - CONFLICTING FILE FORMATS 00058000 * 36 - TARGET DISK NOT ACCESSED @VA12416 00058500 * 100- DISK READ ERROR 00059000 * 00060000 * CALLS TO OTHER ROUTINES: 00061000 * 00062000 * DMSSTT - VERIFY EXISTENCE OF A GIVEN FILE: LOCATE FST ENTRY 00063000 *|DMSRDB - READ A DISK RECORD 00064000 *|DNSFNS - CLOSE A GIVEN FILE, SCRATCH ENTRY FROM AFT 00065000 *| 00066000 *|EXTERNAL REFERENCES: 00067000 * 00068000 * NUCON - NUCLEUS CONSTANT AREA TABLE 00069000 * 00070000 * TABLES | WORKAREAS - 00071000 * 00072000 * SEE EXTERNAL REFERENCES 00073000 * 00074000 * REGISTER USAGE: 00075000 * 00076000 * GPR1 - A (PLIST) FOR SVC CALLS 00077000 * GPR10 - MODULE ADDRESSABILITY 00078000 * GPR14 - CMS RETURN 00079000 * GPR15 - ERROR CODE (RETURN) 00080000 * 00081000 * NOTES: 00082000 * 00083000 * "COMPARE" MUST BE GENMOD'D WITH THE "SYSTEM" OPTION, E.G.: 00084000 * LOAD DMSCMP (ORIGIN TRANS 00085000 * GENMOD COMPARE (SYSTEM 00086000 * 00087000 * OPERATION: 00088000 * 00089000 *| THE COMPARE PARAMETER LIST IS CHECKED FOR ERRORS. IF ALL 00090000 * PARAMETERS ARE PRESENT, COMPARE CHECKS TO SEE IF THE USER 00091000 * SPECIFIED THE OPTIONAL COLUMN DELIMITERS, IF SPECIFIED 00092000 * THE LIMITS ARE CHECKED AND IF VALID THE COMPARE IS PERFORMED 00093000 * WITHIN THE SPECIFIED COLUMN LIMITS. IF COL IS NOT SPECIFIED, 00094000 * THE ENTIRE RECORD LENGTH IS USED FOR A RANGE. A STATE IS 00095000 * THEN DONE ON EACH FILE IN THE PARAMETER LIST AND IF THEY BOTH 00096000 * EXIST A CHECK IS MADE TO INSURE THAT THE FILE IS NOT 00097000 * BEING COMPARED TO ITSELF OR THAT A FIXED AND VARIABLE 00098000 * FORMAT FILE ARE NOT COMPARED. IF THERE ARE NO ERRORS, DMSBRD 00099000 * IS ENTERED TO GET A RECORD FROM EACH FILE. A COMPARISON 00100000 * IF MADE ON A BYTE TO BYTE BASIS. IS A DISCREPANCY IS FOUND 00101000 * THE RECORDS THAT WERE BEING CHECKED ARE TYPED ON THE TERMINAL 00102000 * THIS PROCESS IS REPEATED UNTIL AN EOF IS ENCOUNTERED. IF BOTH 00103000 * FILES ARE NOT AT END OF FILE A MESSAGE IS GIVEN. PRIOR TO 00104000 * RETURNING TO THE USER OR CALLER, NUCON IS REFERENCED AND THE 00105000 * PAGE RELEASE FLAG IS TURNED ON. FINIS IS THEN CALLED TO CLOSE 00106000 * THE FILE AND AN EXIT IS MADE TO THE CALLER WITH THE FINAL 00107000 * RESULT CODE IN REGISTER 15. 00108000 * 00109000 *. 00110000 EJECT 00111000 MACRO 00112000 &LABEL FBLKS &NAME,&AREA 00113000 &LABEL DS 0D 00114000 DC CL8' ' 00115000 DC CL8'&NAME(1) ' 00116000 DC CL8'&NAME(2) ' 00117000 DC CL2'A1' 00118000 DC H'0' 00119000 DC A(&AREA) 00120000 DC F'80' 00121000 DC CL2'F' 00122000 DC H'1' 00123000 DC F'0' 00124000 S&LABEL DC CL8'STATE' 00125000 DC CL8'&NAME(1) ' 00126000 DC CL8'&NAME(2) ' 00127000 DC CL2'A1' 00128000 DC H'0' 00129000 DC F'0' 00130000 MEND 00131000 DMSCMP START X'E000' TRANSIENT MODULE @V305032 00132000 COMPARE EQU DMSCMP 00133000 ENTRY COMPARE SO WE CAN CALL BY COMMAND NAME 00134000 * 00135000 USING NUCON,R0 STANDARD NUCON ADDRESSABILITY @V305032 00136000 USING *,R15 (TEMPORARY) 00137000 STM R0,R14,SAVE SAVE REGISTERS (NOT REALLY NECESSARY) 00138000 DROP R15 00139000 LR R12,R15 ADDRESSABILITY IN R12 V0363 00140000 USING COMPARE,R12 V0363 00141000 SSM ENABLE ENABLE INTERRUPTS @VA06295 00142000 LA R6,0 INITIALIZE RETURN CODE 00143000 LR R2,R1 00144000 LA R4,5 TO INSURE FILEIDS ASRE PRESENT 00145000 MVI SWS,X'00' CLEAR SWITCHES 00146000 LA R3,0 00147000 ST R3,COL1 INITIALIZE 00148000 ST R3,COL2 00149000 ST R3,AREA1 RESET FREE STORAGE POINTER1 @VA05505 00150000 ST R3,AREA2 RESET FREE STORAGE POINTER2 @VA05505 00151000 LA R2,8(R2) 00152000 CLI 0(R2),X'FF' ANY FILEIDS 00153000 BE ERR01 NO V0306 00154000 CLC 0(8,R2),=CL8'*' ASTERISK IN FILENAME? @VA04010 00155000 BE ERR07 YES, ERROR @VA04010 00156000 COMP1 EQU * 00157000 LA R2,8(,R2) *CHECK FOR BOTH FILEIDS 00158000 CLC 0(8,R2),=8X'FF' * 00159000 BE ERR01 00160000 CLC 0(8,R2),=CL8'*' IS * SPECIFIED IN FILEID? @VA02445 00161000 BE ERR07 YES, ERROR @VA02445 00162000 BCT R4,COMP1 00163000 LA R1,8(,R1) MOVE UP PARM LIST 00164000 LA R4,1 R4=1 FOR FULL COMPARISON 00165000 MVC SFCB1+8(18),0(R1) MOVE IN 1ST FILE NAME, TYPE, & MODE 00166000 * 00167000 OKMODE MVC SFCB2+8(18),24(R1) MOVE IN 2ND FILE NAME, TYPE, & MODE 00168000 LA R4,48(R1) POINT TO START OF OPTIONS 00169000 CLI 0(R4),C'(' '(' AFTER 6TH PARAMETER? V0141 00170000 BE CK YES V0141 00171000 CLI 0(R4),X'FF' FENCE? V0141 00172000 BE SETOPT2A YES V0141 00173000 LR R0,R4 POINT TO UNKNOWN V0141 00174000 B ERR02A THEN LIST ERROR V0141 00175000 * 00176000 * CHECK OPTIONS AND SET LIMITS FOR COMPARE 00177000 CK CLI 8(R4),X'FF' END? 00178000 BE SETOPT2A 00179000 CLI 8(R4),C')' END? 00180000 BE SETOPT2A YES 00181000 CKOPTS CLC 8(8,R4),=CL8'COL' IS OPTION 'COL'? 00182000 BNE ERR02 00183000 OI SWS,COL SET SWITCH FOR COLUMNS 00184000 LA R2,LOOP8 TEST 8-POSITION OPTION FIELD @VA06292 00185000 MVC SETCOL,16(R4) COPY PARAMTERT 00186000 LA R1,SETCOL POINT TO OPTION 00187000 CLI 0(R1),X'FF' IS IT END 00188000 BE ERR06 ERROR IF IT IS 00189000 CLI 0(R1),C')' END OF PARMS 00190000 BE ERR06 ERROR 00191000 CKOPTS1A CLI 0(R1),C'-' IS IT DELIMITER? 00192000 BE SETOPT1B YES @VA06292 00193000 CLI CURR(R1),BLANK IS IT BLANK? @VA06292 00194000 BE SETOPT1A YES, HYPHEN NOT USED @VA06292 00195000 LA R1,1(R1) POINT TO NEXT CHAR 00196000 BCT R2,CKOPTS1A 00197000 SETOPT1A EQU * @VA06292 00198000 OI SWS,NOHYPH INDICATE '-' OMITTED @VA06292 00199000 B SETOPT1C SET UP FOR CONVERSION @VA06292 00200000 * 00201000 SETOPT1B EQU * @VA06292 00202000 LR R2,R1 SAVE DELIMITER @VA06292 00203000 MVI CURR(R1),BLANK BLANK DELIMITER FOR CONVERT RTNE @VA06292 00204000 SETOPT1C EQU * @VA06292 00205000 LA R1,SETCOL POINT TO CHAR STRING 00206000 BAL R7,CONVRT ROUTINE TO CONVERT TO USABLE FORM 00207000 ST R1,COL1 COL TO START COMPARE 00208000 LTR R1,R1 WAS FIRST CHAR ZERO 00209000 BZ ERROPT YES,THIS IS AN ERROR 00210000 LA R1,1(R2) POINT TO NEXT CHAR 00211000 TM SWS,NOHYPH WAS HYPHEN OMITTED? @VA06292 00212000 BO CHKOPTS2 YES @VA06292 00213000 CLI CURR(R1),BLANK SPACE AFTER HYPHEN? @VA06292 00214000 BNE ENDCOL NO @VA06292 00215000 CHKOPTS2 EQU * @VA06292 00216000 MVC SETCOL(8),OP24(R4) COPY NEXT PARAMETER @VA06292 00217000 LA R1,SETCOL POINT TO CHARACTER STRING @VA06292 00218000 CLI 0(R1),ENDPARM END OF PARAMETERS? @VA06292 00219000 BE SETOPT2A SET TO LRECL @VA06292 00220000 CLI 0(R1),ENDOPT END OF OPTIONS? @VA06292 00221000 BE SETOPT2A SET TO LRECL @VA06292 00222000 TM SWS,NOHYPH HYPHEN OMITTED? @VA06292 00223000 BO ENDCOL YES @VA06292 00224000 B ERR03 GO TO ERROR @VA06292 00225000 * 00226000 ENDCOL EQU * @VA06292 00227000 BAL R7,CONVRT CONVERT ENDING ADDRESS 00228000 LTR R1,R1 WAS IT SPECIFIED 00229000 BZ SETOPT2A NO, GO SET TO LRECL 00230000 * 00231000 SETOPT2 ST R1,COL2 STOP COMPARE COL 00232000 CLC COL1(4),COL2 IS START COL BEYOND STOP COL 00233000 BNH GO NO 00234000 B ERR08 GO TO ERROR @VA06292 00235000 ERROPT LA R0,ZERO POINT TO ERROR 00236000 B ERR03A GO TO TELL USER 00237000 * 00238000 SETOPT2A OI SWS,LRECL 00239000 * 00240000 GO LA R1,SFCB1 CHECK EXISTENCE OF 1ST FILE 00241000 SVC 202 00242000 DC AL4(FATAL1) 00243000 L R1,SFCB1+28 SET UP READ PARM LIST 00244000 MVC FCB1+8(16),SFCB1+8 00245000 MVC FCB1+24(2),24(1) 00246000 MVC FCB1+32(4),32(1) 00247000 MVC FCB1+36(2),30(1) 00248000 USING STATEFST,R1 HRC015DS 00249100 L R5,FVSFSTAC Remember actual address of file HRC015DS 00249200 MVC FILEID1(16),SFCB1+8 GET FN & FT FOR MSG @VA03132 00250000 L R10,FVSFSTAD Get address of ADT HRC015DS 00251100 DROP R1 HRC015DS 00251200 USING ADTSECT,R10 @VA03132 00252000 MVC FM1(1),ADTM GET ACTUAL FILEMODE @VA03132 00253000 DROP R10 @VA03132 00254000 LA R1,SFCB2 CHECK EXISTENCE OF 2ND FILE 00255000 SVC 202 00256000 DC AL4(FATAL1) 00257000 L R1,SFCB2+28 SET UP READ PARM LIST 00258000 MVC FCB2+8(16),SFCB2+8 00259000 MVC FCB2+24(2),24(1) 00260000 MVC FCB2+32(4),32(1) 00261000 MVC FCB2+36(2),30(1) P0914 00262000 MVC FILEID2(16),SFCB2+8 GET 2ND FN & FT FOR MSG @VA03132 00263000 USING STATEFST,R1 HRC015DS 00264100 L R10,FVSFSTAD Get ADT for file HRC015DS 00264200 USING ADTSECT,R10 @VA03132 00265000 MVC FM2(1),ADTM GET ACTUAL FILEMODE @VA03132 00266000 DROP R10 @VA03132 00267000 LR R10,R1 SAVE FILE ADDRESS @VA03132 00268000 LA R1,=CL8'CONWAIT' MAKE SURE COMPARE MESSAGE @VM03083 00269000 SVC 202 APPEARS BEFORE COMMAND IS ALL FINISHED@VM03083 00270000 DMSERR NUM=179,LET=I,TEXT='COMPARING ''...................'' W*00271000 ITH ''...................''', *00272000 SUB=(CHAR8A,FILEID1,CHAR8A,FILEID2),RENT=NO @VA03132 00273000 LR R1,R10 GET ORIGINAL ADDRESS @VA03132 00274000 C R5,FVSFSTAC Is this the same file as before? HRC015DS 00275100 DROP R1 HRC015DS 00275200 BE SAMEFILE IF YES, THAT'S RIDICULOUS. 00276000 L R2,FCB1+32 GET FILE 1 LRECL @VA07886 00276300 LA R10,1 SET STARTING POSITION @VA07886 00276600 TM SWS,COL IS COL OPT ON? @VA06435 00277000 BO SETCOL1 YES,CHECK LRECL AND COL @VA07886 00278000 CLC FCB2+32(4),FCB1+32 COMPARE LENGTHS 00279000 BNE FNEQ 00280000 COLOPTON CLC FCB2+36(1),FCB1+36 FILE F/V FLAG MUST BE EQUAL @VA06435 00281000 BNE FNEQ 00282000 L R0,FCB1+32 SET LENGTH 00283000 LA 1,7 00284000 AR 0,1 00285000 SRL 0,3 00286000 ST R0,ALEN 00287000 DMSFREE DWORDS=(0),TYPCALL=BALR,ERR=NOSPACE @VA05505 00288000 ST R1,AREA1 00289000 ST R1,FCB1+28 SET FILE CONTROL BLOCK 00290000 L R0,FCB2+32 FILE2 LRECL @VA07853 00290150 LA R1,R7 USE COUNT OF SEVEN @VA07853 00290300 AR R0,R1 TO ROUND UP LRECL @VA07853 00290450 SRL R0,R3 TO NEXT DOUBLE WORD @VA07853 00290600 ST R0,ALEN2 SAVE FILE2 LENGTH TO FRET @VA07853 00290750 DMSFREE DWORDS=(0),TYPCALL=BALR,ERR=NOSPACE @VA05505 00291000 ST R1,AREA2 SAVE START ADDR 00292000 ST R1,FCB2+28 SET FILE 2 CONTROL BLOCK 00293000 LR R1,R10 START POSITION @VA07886 00294000 B SETADDR1 CONTINUE @VA07886 00295000 SETCOL1 EQU * @VA07886 00296000 CLC FCB1+32(4),FCB2+32 FILE1 LRECL LT FILE2 LRECL @VA07886 00297000 BL SETLEN1 YES @VA07886 00298000 L R2,FCB2+32 NO, USE FILE2 LRECL @VA07886 00299000 SETLEN1 EQU * @VA07886 00300000 L R10,COL1 START POSITION @VA07886 00301000 LA R0,COL1 SET UP FOR ERROR MSG 00302000 C R10,FCB1+32 COL1 GT FILE1 LRECL @VA07886 00302600 BH ERR05 YES, ERROR @VA07886 00303200 C R10,FCB2+32 COL1 GT FILE2 LRECL @VA07886 00303800 BH ERR05 YES, ERROR @VA07886 00304400 TM SWS,LRECL WAS COL2 BLANK? V0411 00305000 BO SETCOL2A YES V0411 00306000 L R2,COL2 NO, GET LAST COL V0411 00307000 SETCOL2A EQU * V0411 00308000 LA R0,COL2 SET UP FOR ERROR MSG 00311000 C R2,FCB1+32 COL2 GT FILE 1 LRECL @VA07886 00311500 BH ERR05 YES, ERROR @VA07886 00312000 C R2,FCB2+32 COL2 GT FILE 2 LRECL @VA07886 00312500 BH ERR05 YES, ERROR @VA07886 00313000 B COLOPTON GOOD, CONTINUE @VA07886 00313500 SETADDR1 L R8,AREA1 START AREA 1ST FILE 00314000 L R9,AREA2 START AREA 2ND FILE 00315000 BCTR R1,0 00316000 AR R8,R1 START COMPARE BUFFER 1 00317000 AR R9,R1 START COMPARE BUFFER 2 00318000 * 00319000 SETEND SR R2,R1 GET LENGTH FOR COMPARE 00320000 LR R7,R2 * 00321000 LR R11,R7 V0306 00322000 ST R7,CMPLNTH STORE COMPARE LENGTH @VA01243 00323000 STM R8,R9,BUFAREA SAVE BUFFER START ADDRS 00324000 READ EQU * 00325000 LA R1,FCB1 00326000 L R15,ARDBUF READ RECORD FROM FIRST FILE @V305032 00327000 SSM DISABLE DISABLE INTERRUPTS @VA06295 00328000 BALR R14,R15 (VIA BALR) @V305032 00329000 BNZ RDERR1 BEWARE OF ERROR (E.G. EOF) @V305032 00330000 SSM ENABLE ENABLE INTERRUPTS @VA06295 00331000 LA R1,FCB2 00332000 SSM DISABLE DISABLE INTERRUPTS @VA06295 00333000 L R15,ARDBUF READ RECORD FROM SECOND FILE @V305032 00334000 BALR R14,R15 (VIA BALR) @V305032 00335000 BNZ RDERR2 BEWARE OF ERROR (E.G. EOF) @V305032 00336000 SSM ENABLE ENABLE INTERRUPTS @VA06295 00337000 L R2,BUFAREA+4 SET BUFFER ADDR FOR COMPARE 00338000 L R8,BUFAREA SET BUF ADDR FOR COMPARE 00339000 CLI FCB1+36,C'F' FIXED LENGTH? V0363 00340000 BE VCOLON YES, COMPARE RECORDS @VA07852 00341000 TM SWS,COL WERE COLS SPECIFIED? V0363 00342000 BO SETCOMP YES, CALCULATE LENGTH @VA03530 00343000 L R7,FCB1+40 GET BYTES READ OF 1ST FILE @VA03530 00344000 L R11,FCB2+40 GET BYTES READ OF 2ND FILE @VA03530 00345000 B CHECK START COMPARING @VA03530 00346000 * 00347000 * NO MAKE SURE COMPARE LENGTHS FALL WITHIN 00348000 * THE VARIABLE RECORD. 00349000 * 00350000 SETCOMP SR R7,R7 CLEAR IT OUT @VA03530 00351000 CLC COL1(4),FCB1+40 IS START > LRECL? @VA03530 00352000 BH COMPMORE YES, CHECK 2ND FILE @VA03530 00353000 L R7,FCB1+40 GET BYTES READ @VA03530 00354000 S R7,COL1 LESS START OF COMPARE @VA03530 00355000 LA R7,1(,R7) AVOID INCORRECT LENGTH @VA03530 00356000 COMPMORE CLC COL1(4),FCB2+40 IS START > LRECL? @VA03530 00357000 BNH SET2 NO, CALCULATE LENGTH @VA03530 00358000 LTR R7,R7 IS START > LRECL FOR 1ST FILE? @VA03530 00359000 BZ READ YES, IGNORE THIS COMPARE @VA03530 00360000 SR R11,R11 INDICATE START > LRECL @VA03530 00361000 B STOPSW CHECK FOR STOP @VA03530 00362000 SET2 L R11,FCB2+40 GET BYTES READ @VA03530 00363000 S R11,COL1 LESS START OF COMPARE @VA03530 00364000 LA R11,1(,R11) AVOID INCORRECT LENGTH @VA03530 00365000 STOPSW TM SWS,LRECL IS STOP SPECIFIED? @VA03530 00366000 BO CHECK NO, START COMPARING @VA03530 00367000 CLC FCB1+40(4),FCB2+40 LRECL1 GREATER THAN LRECL2 @VA07852 00367500 BH SETLEN YES, CHECK RECORD 2 LRECL @VA07852 00367600 CLC COL2(4),FCB1+40 IS STOP > LRECL? @VA03530 00368000 BH CHECK YES, USE LRECL FOR STOP. @VA12650 00369000 L R7,CMPLNTH GET COMPARE LENGTH @VA03530 00370000 LR R11,R7 PUT LENGTH IN R11 FOR ERROR MSG @VA12060 00370500 B VCOLON USE COL OPT FOR COMPARE @VA06435 00371000 SETLEN CLC COL2(4),FCB2+40 IS STOP > LRECL? @VA03530 00372000 BH CHECK YES, USE LRECL FOR STOP. @VA12650 00373000 L R11,CMPLNTH GET COMPARE LENGTH @VA03530 00374000 LR R7,R11 PUT LENGTH IN R7 FOR COMP LENGTH @VA12060 00374250 B VCOLON COMPARE RECORDS @VA07852 00374500 CHECK EQU * V0363 00375000 CLC FCB1+40(4),FCB2+40 COMPARE FILE LENGTHS V0363 00376000 BNE CMPERR NOT EQUAL P0914 00377000 VCOLON LR R3,R7 SET UP LENGTH FOR COMPARE @VA06435 00378000 LR R9,R7 SET UP LENGTH FOR COMPARE 00379000 CLCL R2,R8 COMPARE 2 RECORDS 00380000 BE READ 00381000 CMPERR LM R8,R9,BUFAREA RESTORE START ADDRS OF BUFFERS P0914 00382000 LTR R7,R7 ANY RECORD 1 LENGTH @VA07852 00382200 BNZ TYPERR1 YES , TYPE RECORD 1 MESSAGE @VA07852 00382400 L R7,FCB1+40 NO, USE RECORD LENGTH READ @VA07852 00382600 TYPERR1 EQU * @VA07852 00382800 STH R7,TYPE+14 TYPE LENGTH @VA01243 00383000 ST R8,TYPBUF-1 BUFFER AREA 00384000 MVI TYPBUF-1,X'01' 00385000 LA R1,TYPE SET PARM POINTER 00386000 SVC 202 00387000 DC AL4(*+4) ERROR 00388000 * 00389000 ST R9,TYPBUF-1 BUFFER AREA 2 00390000 LTR R11,R11 ANY RECORD 2 LENGTH @VA07852 00390200 BNZ TYPERR2 YES,TYPE RECORD 2 MESSAGE @VA07852 00390400 L R11,FCB2+40 NO, USE RECORD LENGTH READ @VA07852 00390600 TYPERR2 EQU * @VA07852 00390800 STH R11,TYPE+14 TYPE LENGTH @VA01243 00391000 MVI TYPBUF-1,X'01' 00392000 LA R1,=CL8'CONWAIT' GIVE ERROR MESSAGES A ... @VM03083 00393000 SVC 202 CHANCE TO "CATCH UP" @VM03083 00394000 LA R1,TYPE PARM POINTER 00395000 SVC 202 00396000 LA R6,4 SET FOR CODE 4 ON EXIT. 00397000 B READ 00398000 EJECT 00399000 ********************************************************************** 00400000 * INTERNAL CONVERSION ROUTINE 00401000 * 00402000 ********************************************************************** 00403000 * 00404000 * AT ENTRY R1 POINTS TO BEGINNING OF NUMERIC FIELD 00405000 * AT EXIT R1 HOLDS THE ANSWER 00406000 * (CONVERTS WHILE SCANNING FOR BLANK AND POSSIBLE ILLEGAL CHARS) 00407000 * 00408000 CONVRT SR R8,R8 CLEAR PARTIAL SUM 00409000 SR R9,R9 CLEAR A REG 00410000 LA R15,LOOP3 ALLOW SPACE FOR LEADING ZEROES @VA06292 00411000 CHKLDZ EQU * @VA06292 00412000 CLI CURR(R1),LEADZ IS THIS A LEADING ZERO? @VA06292 00413000 BNE LOOPCTRL NO @VA06292 00414000 LA R1,NEXT1(R1) GO TO NEXT POSITION @VA06292 00415000 BCT R15,CHKLDZ LIMIT TEST TO 3 POSITIONS @VA06292 00416000 LOOPCTRL EQU * @VA06292 00417000 LA R15,LOOP6 MAXIMUM EFFECTIVE LENGTH 5 BYTES @VA06292 00418000 CVTLOOP CLI 0(R1),C' ' BLANK? 00419000 BE CVTDONE YES, FINISHED 00420000 CLC 0(,R1),ENDTEMP END OF OPTION FIELD? @VA06292 00421000 BNL CVTDONE YES, FINISHED @VA06292 00422000 IC R9,0(,R1) PICK UP BYTE 00423000 SH R9,K0 SUBTRACK C'0' 00424000 BM CVTERR ERROR IF NOT 0-9 00425000 MH R8,TEN MULTIPLY OLD PARTIAL SUM BY TEN 00426000 AR R8,R9 ADD NEW DIGIT 00427000 LA R1,1(R1) BUMP FOR NEXT DIGIT 00428000 BCT R15,CVTLOOP ITERATE TO BLANK OR 8TH CHAR 00429000 CVTERR LA R0,SETCOL SET UP ERROR POINTER 00430000 B ERR03A GO OUTPUT MSG 00431000 CVTDONE LR R1,R8 ANSWER INTO R1 @VA06292 00432000 BR R7 RETURN @VA06292 00433000 TEN DC H'10' 00434000 K0 DC X'00',C'0' C'0' FOR SUBTRACT 00435000 EJECT 00436000 * 00437000 * ERROR MESSAGE 00438000 * 00439000 SPACE 1 00440000 RDERR1 CH 15,=H'12' IS IT EOF 00441000 BNE FATAL NO 00442000 * 00443000 LA R1,FCB2 READ 2ND FILE AGAIN 00444000 L R15,ARDBUF ... @V305032 00445000 SSM DISABLE DISABLE INTERRUPTS @VA06295 00446000 BALR R14,R15 (VIA BALR) @V305032 00447000 BNZ RETURN1 ERROR RETURN @V305032 00448000 SSM ENABLE ENABLE INTERRUPTS @VA06295 00449000 LA R0,FCB1+8 00450000 RDERR1A DMSERR NUM=010,LET=E,TEXT='PREMATURE EOF ON FILE ''............00451000 .........''',SUB=(CHAR8A,(0)) V0414 00452000 LA R15,40 00453000 B RETURN 00454000 RETURN1 CH R15,=H'12' IS IT END OF FILE 00455000 BNE FATAL IF NOT, BAD ERROR 00456000 LR R15,R6 SET CODE 00457000 B RETURN GO FINISH UP 00458000 RDERR3 CH R15,=H'12' IS IT EOF 00459000 BNE FATAL NO 00460000 B CLOSEM GO CLOSE THE FILES & EXIT. 00461000 RDERR2 CH R15,=H'12' IS IT EOF 00462000 BNE FATAL NO 00463000 LA R0,FCB2+8 00464000 B RDERR1A 00465000 FATAL1 EQU * @VA12416 00466000 C R15,=F'36' WAS DISK NOT ACCESSED? @VA12416 00466250 BE ERRMSG36 GIVE MSG @VA12416 00466500 C R15,=F'28' FILE NOT FOUND FROM STATE? @VA12416 00466750 BNE FATAL1A IF NOT, MSG WAS GIVEN BY STATE 00467000 LA R0,8(R1) 00468000 DMSERR NUM=02,LET=E,TEXT='FILE ''....................'' NOT X00469000 FOUND. ',SUB=(CHAR8A,(0)) V0146 00470000 LA R15,28 CODE FOR FILE NOT FOUND 00471000 FATAL1A TM FILE2,X'FF' IF 2ND FILE, FINIS 1ST ONE 00472000 BO EXIT1 00473000 B EXIT 00474000 ERRMSG36 EQU * @VA12416 00474150 LA R0,24(R1) POINT TO MODE LETTER @VA12416 00474300 DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X00474450 LET=E,SUB=(CHARA,((R0),1)),TYPCALL=SVC @VA12416 00474600 LA R15,36 GIVE RETCODE @VA12416 00474750 B FATAL1A AND GO RETURN TO CALLER @VA12416 00474900 SAMEFILE DMSERR NUM=19,LET=E,TEXT='IDENTICAL FILEIDS' P3019 00475000 LA R15,24 RETURN CODE 00476000 B EXIT GO EXIT. 00477000 FATAL LA R0,8(R1) 00478000 LR R10,R15 GET RETURN CODE FROM DMSBRD 00479000 DMSERR NUM=104,LET=S,TEXT='ERROR ''..'' READING FILE ''.......X00480000 .............'' FROM DISK',SUB=(DEC,(10),CHAR8A,(0)), X00481000 RENT=NO 00482000 LA R15,100 00483000 B RETURN 00484000 SPACE 1 00485000 NOSPACE EQU * @VA10242 00486000 DMSERR NUM=109,LET=S,TEXT='VIRTUAL STORAGE *00486350 CAPACITY EXCEEDED' @VA10242 00486700 LA R15,104 @VA05505 00488000 B CLOSEM @VA05505 00489000 SPACE 1 00490000 FNEQ DMSERR NUM=11,LET=E,TEXT='CONFLICTING FILE FORMATS' 00491000 LA R15,32 RETURN CODE 00492000 B EXIT 00493000 * 00494000 ERR01 DMSERR NUM=54,LET=E,TEXT='INCOMPLETE FILEID SPECIFIED' 00495000 LA R15,24 00496000 B EXIT 00497000 * 00498000 ERR02 LA R0,8(R4) POINT TO INVALID OPTION 00499000 ERR02A EQU * V0141 00500000 DMSERR NUM=3,LET=E,TEXT='INVALID OPTION ''........'' ',SUB=(CH,00501000 ARA,(0)) 00502000 LA R15,24 00503000 B EXIT 00504000 * 00505000 ERR03 LA R0,16(R4) 00506000 ERR03A DMSERR NUM=29,LET=E,TEXT='INVALID PARAMETER ''........'' IN THX00507000 E COLUMN FIELD',SUB=(CHARA,(0)) V0306 00508000 LA R15,24 00509000 B EXIT 00510000 * 00511000 ERR05 DMSERR NUM=9,LET=E,TEXT='COLUMN ''........'' EXCEEDS RECORD X00512000 LENGTH',SUB=(DECA,(0)) V0306 00513000 LA R15,24 00514000 B EXIT 00515000 * 00516000 ERR06 DMSERR NUM=5,LET=E,TEXT='NO COLUMN SPECIFIED' V0306 00517000 LA R15,24 00518000 B EXIT 00519000 ERR07 DMSERR NUM=62,LET=E,TEXT='INVALID * IN FILEID' @VA02445 00520000 LA R15,20 @VA02445 00521000 B EXIT @VA02445 00522000 ERR08 DMSERR NUM=211,LET=E,TEXT='COLUMN FIELDS OUT OF SEQUENCE' 00523000 LA R15,RC24 RET CODE 24 @VA06292 00524000 B EXIT RETURN @VA06292 00525000 EJECT 00526000 * 00527000 * EXIT PROCESSING 00528000 * 00529000 SPACE 1 00530000 CLOSEM EQU * GO CLOSE THE TWO FILES @VA05505 00531000 RETURN LR R6,R15 SAVE ERROR CODE 00532000 LA R1,FCB2 CLOSE "FILE TWO" @V305032 00533000 L R15,AFINIS ... @V305032 00534000 BALR R14,R15 (VIA BALR) @V305032 00536000 SSM ENABLE ENABLE INTERRUPTS @VA06295 00537000 L R0,ALEN2 USE FILE2 LENGTH(DW) @VA07853 00538000 ICM R1,B'1111',AREA2 LOAD FILE2 STORAGE POINTER @VA05505 00539000 BZ FREE1 NONE ALLOCATED TRY FILE1 @VA05505 00540000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00541000 FREE1 ICM R1,B'1111',AREA1 LOAD FILE1 STORAGE POINTER @VA05505 00542000 BZ RESTRETC NONE ALLOCATED. EXIT. @VA05505 00543000 L R0,ALEN USE FILE1 LENGTH(DWORDS) @VA07853 00543500 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00544000 RESTRETC EQU * @VA05505 00545000 SSM ENABLE ENABLE @VA07793 00545100 LR R15,R6 RESTORE RET CODE 00546000 EXIT1 LR R6,R15 SAVE RETURN CODE, @V305032 00547000 LA R1,FCB1 CLOSE "FILE ONE" @V305032 00548000 L R15,AFINIS ... @V305032 00549000 SSM DISABLE DISABLE INTERRUPTS @VA06295 00550000 BALR R14,R15 (VIA BALR) @V305032 00551000 SSM ENABLE ENABLE INTERRUPTS @VA06295 00552000 LR R15,R6 RESTORE CODE 00553000 EXIT EQU * 00554000 LR R6,R15 SAVE ERROR RETURN CODE 00555000 C R6,=F'4' WAS THERE A NO-COMPARE? P0788 00556000 BNE EXIT2 P0788 00557000 DMSERR NUM=209,LET=W,TEXT='FILES DO NOT COMPARE' P0788 00558000 EXIT2 LR R15,R6 RESTORE RETURN CODE P0788 00559000 LM R0,R14,SAVE RESTORE R0-R14 00560000 BR R14 AND RETURN TO CALLER. 00561000 * 00562000 R0 EQU 0 00563000 R1 EQU 1 00564000 R2 EQU 2 00565000 R3 EQU 3 00566000 R4 EQU 4 00567000 R5 EQU 5 00568000 R6 EQU 6 00569000 R7 EQU 7 00570000 R8 EQU 8 00571000 R9 EQU 9 00572000 R10 EQU 10 00573000 R11 EQU 11 V0363 00574000 R12 EQU 12 V0363 00575000 R14 EQU 14 00576000 R15 EQU 15 00577000 FCB1 FBLKS ,* V0363 00578000 FCB2 FBLKS ,* V0363 00579000 TYPE DS 0F 00580000 DC CL8'TYPLIN' 00581000 DC AL1(1) 00582000 TYPBUF DC AL3(*) BUFFER ADDR 00583000 DC C'B' 00584000 DC AL3(0) 00585000 DS 0D (DOUBLE-WORD ALIGNED IS BEST): 00586000 FILE2 DC F'0' SWITCH 00587000 ALEN DS 1F 00588000 ALEN2 DS 1F SAVE FILE2 LENGTH(DWORDS) @VA07853 00588500 AREA1 DS 1F 00589000 AREA2 DS 1F 00590000 BUFAREA DS 2F AREA TO SAVE BUF ADDRS 00591000 CMPLNTH DS 1F LENGTH OF COMPARE @VA01243 00592000 SAVE DS 15F R0-R14 SAVED HERE. 00593000 COL1 DS 1F 00594000 COL2 DS 5C 00595000 SWS DC 1X'00' FLAG BYTE @VA06292 00596000 LRECL EQU X'80' LAST COLUMN EQUAL TO LRECL @VA06292 00597000 NOHYPH EQU X'40' NO HYPHEN IN MM-NN OPTION @VA06292 00598000 COL EQU X'20' COLUMN OPTION SPECIFIED @VA06292 00599000 SETCOL DS CL8 TEMP AREA FOR 'COL' OPTION 00600000 ENDTEMP DC X'FA' FENCE FOR TEMP AREA @VA06292 00601000 ZERO DC CL8'0' ZERO CHARACTER FOR ERROR MSG 00602000 FILEID1 DC CL8' ' @VA03132 00603000 DC CL8' ' @VA03132 00604000 FM1 DC CL1' ' @VA03132 00605000 FILEID2 DC CL8' ' @VA03132 00606000 DC CL8' ' @VA03132 00607000 FM2 DC CL1' ' @VA03132 00608000 ENABLE DC X'FF' FOR SET SYSTEM MASK @VA06295 00609000 DISABLE DC X'00' FOR SET SYSTEM MASK @VA06295 00610000 BLANK EQU C' ' BLANK SPACE @VA06292 00611000 ENDPARM EQU X'FF' END OF PARAMETER LIST @VA06292 00612000 ENDOPT EQU C')' END OF OPTION LIST @VA06292 00613000 CURR EQU 0 ZERO DISPLACEMENT @VA06292 00614000 LEADZ EQU C'0' LEADING ZERO @VA06292 00615000 LOOP8 EQU 8 LOOP COUNT OF 8 @VA06292 00616000 LOOP6 EQU 6 LOOP COUNT OF 6 @VA06292 00617000 LOOP3 EQU 3 LOOP COUNT OF 3 @VA06292 00618000 NEXT1 EQU 1 1-BYTE DISPLACEMENT @VA06292 00619000 OP24 EQU 24 24-BYTE DISPLACEMENT @VA06292 00620000 RC24 EQU 24 RET CODE 24 @VA06292 00621000 NUCON @VA06292 00622000 ADT @VA06292 00623000 FVS HRC015DS 00623100 EJECT 00624000 END 00625000