ibm:vm370-lib:cms:dmscmp.assemble_src
Table of Contents
DMSCMP Source
References
- Fixes Applied : 6
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC015DS]
Source Listing
- DMSCMP.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmscmp.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator