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