Table of Contents

DMSCMP Source

References

Source Listing

DMSCMP.ASSEMBLE.txt
  1. CMP TITLE 'DMSCMP (CMS) VM/370 - RELEASE 6' 00001000
  2. SPACE 2 00002000
  3. *. 00003000
  4. * MODULE NAME: 00004000
  5. * 00005000
  6. * DMSCMP (COMPARE) 00006000
  7. * 00007000
  8. * FUNCTION: 00008000
  9. * 00009000
  10. * TO COMPARE TWO DISK FILES 00010000
  11. * 00011000
  12. * ATTRIBUTES: 00012000
  13. * 00013000
  14. * TRANSIENT (WITH SYSTEM OPTION); SERIALLY REUSABLE. 00014000
  15. * 00015000
  16. * ENTRY POINTS: 00016000
  17. * 00017000
  18. * COMPARE 00018000
  19. * 00019000
  20. * ENTRY CONDITIONS: 00020000
  21. * 00021000
  22. * COMPARE: 00022000
  23. * GPR1 - A(PLIST) 00023000
  24. * PLIST 00024000
  25. * CL8'COMPARE' 00025000
  26. * CL8 FILENAME1 00026000
  27. * CL8 FILETYPE1 00027000
  28. * CL8 FILEMODE1 00028000
  29. * CL8 FILENAME2 00029000
  30. * CL8 FILETYPE2 00030000
  31. * CL8 FILEMODE2 00031000
  32. * OPTIONAL 00032000
  33. * CL8'(' START OF OPTIONS 00033000
  34. * CL8'COL' DEFINING COMPARE FIELD 00034000
  35. * CL8'MM',CL8'NN MM IS START POSITION 00035000
  36. * AND NN IS END POSITION 00036000
  37. * OR 00037000
  38. * CL8'MM-NN' USE SINGLE FIELD FOR 00038000
  39. * START AND END POSITIONS 00039000
  40. * CL8')' END OF OPTION LIST 00040000
  41. * XL8'FF' END OF PARAMETER LIST 00041000
  42. * 00042000
  43. * EXIT CONDITIONS: 00043000
  44. * 00044000
  45. * NORMAL - 00045000
  46. * GPR15 = 0 : FILES ARE IDENTICAL 00046000
  47. * 00047000
  48. * ERROR - 00048000
  49. * GPR15 = XX: 00049000
  50. * 4 - FILES ARE NOT EQUAL 00050000
  51. * 20 - INVALID * IN FILEID 00051000
  52. * 24 - INVALID OPTION 00052000
  53. * IDENTICAL FILEIDS 00053000
  54. * COL EXCEEDS RECORD LENGTH 00054000
  55. * INVALID PARAMETER IN COLUMN FIELD 00055000
  56. * INCOMPLETE FILEID 00056000
  57. * 28 - FILE NOT FOUND 00057000
  58. * 32 - CONFLICTING FILE FORMATS 00058000
  59. * 36 - TARGET DISK NOT ACCESSED @VA12416 00058500
  60. * 100- DISK READ ERROR 00059000
  61. * 00060000
  62. * CALLS TO OTHER ROUTINES: 00061000
  63. * 00062000
  64. * DMSSTT - VERIFY EXISTENCE OF A GIVEN FILE: LOCATE FST ENTRY 00063000
  65. *|DMSRDB - READ A DISK RECORD 00064000
  66. *|DNSFNS - CLOSE A GIVEN FILE, SCRATCH ENTRY FROM AFT 00065000
  67. *| 00066000
  68. *|EXTERNAL REFERENCES: 00067000
  69. * 00068000
  70. * NUCON - NUCLEUS CONSTANT AREA TABLE 00069000
  71. * 00070000
  72. * TABLES | WORKAREAS - 00071000
  73. * 00072000
  74. * SEE EXTERNAL REFERENCES 00073000
  75. * 00074000
  76. * REGISTER USAGE: 00075000
  77. * 00076000
  78. * GPR1 - A (PLIST) FOR SVC CALLS 00077000
  79. * GPR10 - MODULE ADDRESSABILITY 00078000
  80. * GPR14 - CMS RETURN 00079000
  81. * GPR15 - ERROR CODE (RETURN) 00080000
  82. * 00081000
  83. * NOTES: 00082000
  84. * 00083000
  85. * "COMPARE" MUST BE GENMOD'D WITH THE "SYSTEM" OPTION, E.G.: 00084000
  86. * LOAD DMSCMP (ORIGIN TRANS 00085000
  87. * GENMOD COMPARE (SYSTEM 00086000
  88. * 00087000
  89. * OPERATION: 00088000
  90. * 00089000
  91. *| THE COMPARE PARAMETER LIST IS CHECKED FOR ERRORS. IF ALL 00090000
  92. * PARAMETERS ARE PRESENT, COMPARE CHECKS TO SEE IF THE USER 00091000
  93. * SPECIFIED THE OPTIONAL COLUMN DELIMITERS, IF SPECIFIED 00092000
  94. * THE LIMITS ARE CHECKED AND IF VALID THE COMPARE IS PERFORMED 00093000
  95. * WITHIN THE SPECIFIED COLUMN LIMITS. IF COL IS NOT SPECIFIED, 00094000
  96. * THE ENTIRE RECORD LENGTH IS USED FOR A RANGE. A STATE IS 00095000
  97. * THEN DONE ON EACH FILE IN THE PARAMETER LIST AND IF THEY BOTH 00096000
  98. * EXIST A CHECK IS MADE TO INSURE THAT THE FILE IS NOT 00097000
  99. * BEING COMPARED TO ITSELF OR THAT A FIXED AND VARIABLE 00098000
  100. * FORMAT FILE ARE NOT COMPARED. IF THERE ARE NO ERRORS, DMSBRD 00099000
  101. * IS ENTERED TO GET A RECORD FROM EACH FILE. A COMPARISON 00100000
  102. * IF MADE ON A BYTE TO BYTE BASIS. IS A DISCREPANCY IS FOUND 00101000
  103. * THE RECORDS THAT WERE BEING CHECKED ARE TYPED ON THE TERMINAL 00102000
  104. * THIS PROCESS IS REPEATED UNTIL AN EOF IS ENCOUNTERED. IF BOTH 00103000
  105. * FILES ARE NOT AT END OF FILE A MESSAGE IS GIVEN. PRIOR TO 00104000
  106. * RETURNING TO THE USER OR CALLER, NUCON IS REFERENCED AND THE 00105000
  107. * PAGE RELEASE FLAG IS TURNED ON. FINIS IS THEN CALLED TO CLOSE 00106000
  108. * THE FILE AND AN EXIT IS MADE TO THE CALLER WITH THE FINAL 00107000
  109. * RESULT CODE IN REGISTER 15. 00108000
  110. * 00109000
  111. *. 00110000
  112. EJECT 00111000
  113. MACRO 00112000
  114. &LABEL FBLKS &NAME,&AREA 00113000
  115. &LABEL DS 0D 00114000
  116. DC CL8' ' 00115000
  117. DC CL8'&NAME(1) ' 00116000
  118. DC CL8'&NAME(2) ' 00117000
  119. DC CL2'A1' 00118000
  120. DC H'0' 00119000
  121. DC A(&AREA) 00120000
  122. DC F'80' 00121000
  123. DC CL2'F' 00122000
  124. DC H'1' 00123000
  125. DC F'0' 00124000
  126. S&LABEL DC CL8'STATE' 00125000
  127. DC CL8'&NAME(1) ' 00126000
  128. DC CL8'&NAME(2) ' 00127000
  129. DC CL2'A1' 00128000
  130. DC H'0' 00129000
  131. DC F'0' 00130000
  132. MEND 00131000
  133. DMSCMP START X'E000' TRANSIENT MODULE @V305032 00132000
  134. COMPARE EQU DMSCMP 00133000
  135. ENTRY COMPARE SO WE CAN CALL BY COMMAND NAME 00134000
  136. * 00135000
  137. USING NUCON,R0 STANDARD NUCON ADDRESSABILITY @V305032 00136000
  138. USING *,R15 (TEMPORARY) 00137000
  139. STM R0,R14,SAVE SAVE REGISTERS (NOT REALLY NECESSARY) 00138000
  140. DROP R15 00139000
  141. LR R12,R15 ADDRESSABILITY IN R12 V0363 00140000
  142. USING COMPARE,R12 V0363 00141000
  143. SSM ENABLE ENABLE INTERRUPTS @VA06295 00142000
  144. LA R6,0 INITIALIZE RETURN CODE 00143000
  145. LR R2,R1 00144000
  146. LA R4,5 TO INSURE FILEIDS ASRE PRESENT 00145000
  147. MVI SWS,X'00' CLEAR SWITCHES 00146000
  148. LA R3,0 00147000
  149. ST R3,COL1 INITIALIZE 00148000
  150. ST R3,COL2 00149000
  151. ST R3,AREA1 RESET FREE STORAGE POINTER1 @VA05505 00150000
  152. ST R3,AREA2 RESET FREE STORAGE POINTER2 @VA05505 00151000
  153. LA R2,8(R2) 00152000
  154. CLI 0(R2),X'FF' ANY FILEIDS 00153000
  155. BE ERR01 NO V0306 00154000
  156. CLC 0(8,R2),=CL8'*' ASTERISK IN FILENAME? @VA04010 00155000
  157. BE ERR07 YES, ERROR @VA04010 00156000
  158. COMP1 EQU * 00157000
  159. LA R2,8(,R2) *CHECK FOR BOTH FILEIDS 00158000
  160. CLC 0(8,R2),=8X'FF' * 00159000
  161. BE ERR01 00160000
  162. CLC 0(8,R2),=CL8'*' IS * SPECIFIED IN FILEID? @VA02445 00161000
  163. BE ERR07 YES, ERROR @VA02445 00162000
  164. BCT R4,COMP1 00163000
  165. LA R1,8(,R1) MOVE UP PARM LIST 00164000
  166. LA R4,1 R4=1 FOR FULL COMPARISON 00165000
  167. MVC SFCB1+8(18),0(R1) MOVE IN 1ST FILE NAME, TYPE, & MODE 00166000
  168. * 00167000
  169. OKMODE MVC SFCB2+8(18),24(R1) MOVE IN 2ND FILE NAME, TYPE, & MODE 00168000
  170. LA R4,48(R1) POINT TO START OF OPTIONS 00169000
  171. CLI 0(R4),C'(' '(' AFTER 6TH PARAMETER? V0141 00170000
  172. BE CK YES V0141 00171000
  173. CLI 0(R4),X'FF' FENCE? V0141 00172000
  174. BE SETOPT2A YES V0141 00173000
  175. LR R0,R4 POINT TO UNKNOWN V0141 00174000
  176. B ERR02A THEN LIST ERROR V0141 00175000
  177. * 00176000
  178. * CHECK OPTIONS AND SET LIMITS FOR COMPARE 00177000
  179. CK CLI 8(R4),X'FF' END? 00178000
  180. BE SETOPT2A 00179000
  181. CLI 8(R4),C')' END? 00180000
  182. BE SETOPT2A YES 00181000
  183. CKOPTS CLC 8(8,R4),=CL8'COL' IS OPTION 'COL'? 00182000
  184. BNE ERR02 00183000
  185. OI SWS,COL SET SWITCH FOR COLUMNS 00184000
  186. LA R2,LOOP8 TEST 8-POSITION OPTION FIELD @VA06292 00185000
  187. MVC SETCOL,16(R4) COPY PARAMTERT 00186000
  188. LA R1,SETCOL POINT TO OPTION 00187000
  189. CLI 0(R1),X'FF' IS IT END 00188000
  190. BE ERR06 ERROR IF IT IS 00189000
  191. CLI 0(R1),C')' END OF PARMS 00190000
  192. BE ERR06 ERROR 00191000
  193. CKOPTS1A CLI 0(R1),C'-' IS IT DELIMITER? 00192000
  194. BE SETOPT1B YES @VA06292 00193000
  195. CLI CURR(R1),BLANK IS IT BLANK? @VA06292 00194000
  196. BE SETOPT1A YES, HYPHEN NOT USED @VA06292 00195000
  197. LA R1,1(R1) POINT TO NEXT CHAR 00196000
  198. BCT R2,CKOPTS1A 00197000
  199. SETOPT1A EQU * @VA06292 00198000
  200. OI SWS,NOHYPH INDICATE '-' OMITTED @VA06292 00199000
  201. B SETOPT1C SET UP FOR CONVERSION @VA06292 00200000
  202. * 00201000
  203. SETOPT1B EQU * @VA06292 00202000
  204. LR R2,R1 SAVE DELIMITER @VA06292 00203000
  205. MVI CURR(R1),BLANK BLANK DELIMITER FOR CONVERT RTNE @VA06292 00204000
  206. SETOPT1C EQU * @VA06292 00205000
  207. LA R1,SETCOL POINT TO CHAR STRING 00206000
  208. BAL R7,CONVRT ROUTINE TO CONVERT TO USABLE FORM 00207000
  209. ST R1,COL1 COL TO START COMPARE 00208000
  210. LTR R1,R1 WAS FIRST CHAR ZERO 00209000
  211. BZ ERROPT YES,THIS IS AN ERROR 00210000
  212. LA R1,1(R2) POINT TO NEXT CHAR 00211000
  213. TM SWS,NOHYPH WAS HYPHEN OMITTED? @VA06292 00212000
  214. BO CHKOPTS2 YES @VA06292 00213000
  215. CLI CURR(R1),BLANK SPACE AFTER HYPHEN? @VA06292 00214000
  216. BNE ENDCOL NO @VA06292 00215000
  217. CHKOPTS2 EQU * @VA06292 00216000
  218. MVC SETCOL(8),OP24(R4) COPY NEXT PARAMETER @VA06292 00217000
  219. LA R1,SETCOL POINT TO CHARACTER STRING @VA06292 00218000
  220. CLI 0(R1),ENDPARM END OF PARAMETERS? @VA06292 00219000
  221. BE SETOPT2A SET TO LRECL @VA06292 00220000
  222. CLI 0(R1),ENDOPT END OF OPTIONS? @VA06292 00221000
  223. BE SETOPT2A SET TO LRECL @VA06292 00222000
  224. TM SWS,NOHYPH HYPHEN OMITTED? @VA06292 00223000
  225. BO ENDCOL YES @VA06292 00224000
  226. B ERR03 GO TO ERROR @VA06292 00225000
  227. * 00226000
  228. ENDCOL EQU * @VA06292 00227000
  229. BAL R7,CONVRT CONVERT ENDING ADDRESS 00228000
  230. LTR R1,R1 WAS IT SPECIFIED 00229000
  231. BZ SETOPT2A NO, GO SET TO LRECL 00230000
  232. * 00231000
  233. SETOPT2 ST R1,COL2 STOP COMPARE COL 00232000
  234. CLC COL1(4),COL2 IS START COL BEYOND STOP COL 00233000
  235. BNH GO NO 00234000
  236. B ERR08 GO TO ERROR @VA06292 00235000
  237. ERROPT LA R0,ZERO POINT TO ERROR 00236000
  238. B ERR03A GO TO TELL USER 00237000
  239. * 00238000
  240. SETOPT2A OI SWS,LRECL 00239000
  241. * 00240000
  242. GO LA R1,SFCB1 CHECK EXISTENCE OF 1ST FILE 00241000
  243. SVC 202 00242000
  244. DC AL4(FATAL1) 00243000
  245. L R1,SFCB1+28 SET UP READ PARM LIST 00244000
  246. MVC FCB1+8(16),SFCB1+8 00245000
  247. MVC FCB1+24(2),24(1) 00246000
  248. MVC FCB1+32(4),32(1) 00247000
  249. MVC FCB1+36(2),30(1) 00248000
  250. USING STATEFST,R1 HRC015DS 00249100
  251. L R5,FVSFSTAC Remember actual address of file HRC015DS 00249200
  252. MVC FILEID1(16),SFCB1+8 GET FN & FT FOR MSG @VA03132 00250000
  253. L R10,FVSFSTAD Get address of ADT HRC015DS 00251100
  254. DROP R1 HRC015DS 00251200
  255. USING ADTSECT,R10 @VA03132 00252000
  256. MVC FM1(1),ADTM GET ACTUAL FILEMODE @VA03132 00253000
  257. DROP R10 @VA03132 00254000
  258. LA R1,SFCB2 CHECK EXISTENCE OF 2ND FILE 00255000
  259. SVC 202 00256000
  260. DC AL4(FATAL1) 00257000
  261. L R1,SFCB2+28 SET UP READ PARM LIST 00258000
  262. MVC FCB2+8(16),SFCB2+8 00259000
  263. MVC FCB2+24(2),24(1) 00260000
  264. MVC FCB2+32(4),32(1) 00261000
  265. MVC FCB2+36(2),30(1) P0914 00262000
  266. MVC FILEID2(16),SFCB2+8 GET 2ND FN & FT FOR MSG @VA03132 00263000
  267. USING STATEFST,R1 HRC015DS 00264100
  268. L R10,FVSFSTAD Get ADT for file HRC015DS 00264200
  269. USING ADTSECT,R10 @VA03132 00265000
  270. MVC FM2(1),ADTM GET ACTUAL FILEMODE @VA03132 00266000
  271. DROP R10 @VA03132 00267000
  272. LR R10,R1 SAVE FILE ADDRESS @VA03132 00268000
  273. LA R1,=CL8'CONWAIT' MAKE SURE COMPARE MESSAGE @VM03083 00269000
  274. SVC 202 APPEARS BEFORE COMMAND IS ALL FINISHED@VM03083 00270000
  275. DMSERR NUM=179,LET=I,TEXT='COMPARING ''...................'' W*00271000
  276. ITH ''...................''', *00272000
  277. SUB=(CHAR8A,FILEID1,CHAR8A,FILEID2),RENT=NO @VA03132 00273000
  278. LR R1,R10 GET ORIGINAL ADDRESS @VA03132 00274000
  279. C R5,FVSFSTAC Is this the same file as before? HRC015DS 00275100
  280. DROP R1 HRC015DS 00275200
  281. BE SAMEFILE IF YES, THAT'S RIDICULOUS. 00276000
  282. L R2,FCB1+32 GET FILE 1 LRECL @VA07886 00276300
  283. LA R10,1 SET STARTING POSITION @VA07886 00276600
  284. TM SWS,COL IS COL OPT ON? @VA06435 00277000
  285. BO SETCOL1 YES,CHECK LRECL AND COL @VA07886 00278000
  286. CLC FCB2+32(4),FCB1+32 COMPARE LENGTHS 00279000
  287. BNE FNEQ 00280000
  288. COLOPTON CLC FCB2+36(1),FCB1+36 FILE F/V FLAG MUST BE EQUAL @VA06435 00281000
  289. BNE FNEQ 00282000
  290. L R0,FCB1+32 SET LENGTH 00283000
  291. LA 1,7 00284000
  292. AR 0,1 00285000
  293. SRL 0,3 00286000
  294. ST R0,ALEN 00287000
  295. DMSFREE DWORDS=(0),TYPCALL=BALR,ERR=NOSPACE @VA05505 00288000
  296. ST R1,AREA1 00289000
  297. ST R1,FCB1+28 SET FILE CONTROL BLOCK 00290000
  298. L R0,FCB2+32 FILE2 LRECL @VA07853 00290150
  299. LA R1,R7 USE COUNT OF SEVEN @VA07853 00290300
  300. AR R0,R1 TO ROUND UP LRECL @VA07853 00290450
  301. SRL R0,R3 TO NEXT DOUBLE WORD @VA07853 00290600
  302. ST R0,ALEN2 SAVE FILE2 LENGTH TO FRET @VA07853 00290750
  303. DMSFREE DWORDS=(0),TYPCALL=BALR,ERR=NOSPACE @VA05505 00291000
  304. ST R1,AREA2 SAVE START ADDR 00292000
  305. ST R1,FCB2+28 SET FILE 2 CONTROL BLOCK 00293000
  306. LR R1,R10 START POSITION @VA07886 00294000
  307. B SETADDR1 CONTINUE @VA07886 00295000
  308. SETCOL1 EQU * @VA07886 00296000
  309. CLC FCB1+32(4),FCB2+32 FILE1 LRECL LT FILE2 LRECL @VA07886 00297000
  310. BL SETLEN1 YES @VA07886 00298000
  311. L R2,FCB2+32 NO, USE FILE2 LRECL @VA07886 00299000
  312. SETLEN1 EQU * @VA07886 00300000
  313. L R10,COL1 START POSITION @VA07886 00301000
  314. LA R0,COL1 SET UP FOR ERROR MSG 00302000
  315. C R10,FCB1+32 COL1 GT FILE1 LRECL @VA07886 00302600
  316. BH ERR05 YES, ERROR @VA07886 00303200
  317. C R10,FCB2+32 COL1 GT FILE2 LRECL @VA07886 00303800
  318. BH ERR05 YES, ERROR @VA07886 00304400
  319. TM SWS,LRECL WAS COL2 BLANK? V0411 00305000
  320. BO SETCOL2A YES V0411 00306000
  321. L R2,COL2 NO, GET LAST COL V0411 00307000
  322. SETCOL2A EQU * V0411 00308000
  323. LA R0,COL2 SET UP FOR ERROR MSG 00311000
  324. C R2,FCB1+32 COL2 GT FILE 1 LRECL @VA07886 00311500
  325. BH ERR05 YES, ERROR @VA07886 00312000
  326. C R2,FCB2+32 COL2 GT FILE 2 LRECL @VA07886 00312500
  327. BH ERR05 YES, ERROR @VA07886 00313000
  328. B COLOPTON GOOD, CONTINUE @VA07886 00313500
  329. SETADDR1 L R8,AREA1 START AREA 1ST FILE 00314000
  330. L R9,AREA2 START AREA 2ND FILE 00315000
  331. BCTR R1,0 00316000
  332. AR R8,R1 START COMPARE BUFFER 1 00317000
  333. AR R9,R1 START COMPARE BUFFER 2 00318000
  334. * 00319000
  335. SETEND SR R2,R1 GET LENGTH FOR COMPARE 00320000
  336. LR R7,R2 * 00321000
  337. LR R11,R7 V0306 00322000
  338. ST R7,CMPLNTH STORE COMPARE LENGTH @VA01243 00323000
  339. STM R8,R9,BUFAREA SAVE BUFFER START ADDRS 00324000
  340. READ EQU * 00325000
  341. LA R1,FCB1 00326000
  342. L R15,ARDBUF READ RECORD FROM FIRST FILE @V305032 00327000
  343. SSM DISABLE DISABLE INTERRUPTS @VA06295 00328000
  344. BALR R14,R15 (VIA BALR) @V305032 00329000
  345. BNZ RDERR1 BEWARE OF ERROR (E.G. EOF) @V305032 00330000
  346. SSM ENABLE ENABLE INTERRUPTS @VA06295 00331000
  347. LA R1,FCB2 00332000
  348. SSM DISABLE DISABLE INTERRUPTS @VA06295 00333000
  349. L R15,ARDBUF READ RECORD FROM SECOND FILE @V305032 00334000
  350. BALR R14,R15 (VIA BALR) @V305032 00335000
  351. BNZ RDERR2 BEWARE OF ERROR (E.G. EOF) @V305032 00336000
  352. SSM ENABLE ENABLE INTERRUPTS @VA06295 00337000
  353. L R2,BUFAREA+4 SET BUFFER ADDR FOR COMPARE 00338000
  354. L R8,BUFAREA SET BUF ADDR FOR COMPARE 00339000
  355. CLI FCB1+36,C'F' FIXED LENGTH? V0363 00340000
  356. BE VCOLON YES, COMPARE RECORDS @VA07852 00341000
  357. TM SWS,COL WERE COLS SPECIFIED? V0363 00342000
  358. BO SETCOMP YES, CALCULATE LENGTH @VA03530 00343000
  359. L R7,FCB1+40 GET BYTES READ OF 1ST FILE @VA03530 00344000
  360. L R11,FCB2+40 GET BYTES READ OF 2ND FILE @VA03530 00345000
  361. B CHECK START COMPARING @VA03530 00346000
  362. * 00347000
  363. * NO MAKE SURE COMPARE LENGTHS FALL WITHIN 00348000
  364. * THE VARIABLE RECORD. 00349000
  365. * 00350000
  366. SETCOMP SR R7,R7 CLEAR IT OUT @VA03530 00351000
  367. CLC COL1(4),FCB1+40 IS START > LRECL? @VA03530 00352000
  368. BH COMPMORE YES, CHECK 2ND FILE @VA03530 00353000
  369. L R7,FCB1+40 GET BYTES READ @VA03530 00354000
  370. S R7,COL1 LESS START OF COMPARE @VA03530 00355000
  371. LA R7,1(,R7) AVOID INCORRECT LENGTH @VA03530 00356000
  372. COMPMORE CLC COL1(4),FCB2+40 IS START > LRECL? @VA03530 00357000
  373. BNH SET2 NO, CALCULATE LENGTH @VA03530 00358000
  374. LTR R7,R7 IS START > LRECL FOR 1ST FILE? @VA03530 00359000
  375. BZ READ YES, IGNORE THIS COMPARE @VA03530 00360000
  376. SR R11,R11 INDICATE START > LRECL @VA03530 00361000
  377. B STOPSW CHECK FOR STOP @VA03530 00362000
  378. SET2 L R11,FCB2+40 GET BYTES READ @VA03530 00363000
  379. S R11,COL1 LESS START OF COMPARE @VA03530 00364000
  380. LA R11,1(,R11) AVOID INCORRECT LENGTH @VA03530 00365000
  381. STOPSW TM SWS,LRECL IS STOP SPECIFIED? @VA03530 00366000
  382. BO CHECK NO, START COMPARING @VA03530 00367000
  383. CLC FCB1+40(4),FCB2+40 LRECL1 GREATER THAN LRECL2 @VA07852 00367500
  384. BH SETLEN YES, CHECK RECORD 2 LRECL @VA07852 00367600
  385. CLC COL2(4),FCB1+40 IS STOP > LRECL? @VA03530 00368000
  386. BH CHECK YES, USE LRECL FOR STOP. @VA12650 00369000
  387. L R7,CMPLNTH GET COMPARE LENGTH @VA03530 00370000
  388. LR R11,R7 PUT LENGTH IN R11 FOR ERROR MSG @VA12060 00370500
  389. B VCOLON USE COL OPT FOR COMPARE @VA06435 00371000
  390. SETLEN CLC COL2(4),FCB2+40 IS STOP > LRECL? @VA03530 00372000
  391. BH CHECK YES, USE LRECL FOR STOP. @VA12650 00373000
  392. L R11,CMPLNTH GET COMPARE LENGTH @VA03530 00374000
  393. LR R7,R11 PUT LENGTH IN R7 FOR COMP LENGTH @VA12060 00374250
  394. B VCOLON COMPARE RECORDS @VA07852 00374500
  395. CHECK EQU * V0363 00375000
  396. CLC FCB1+40(4),FCB2+40 COMPARE FILE LENGTHS V0363 00376000
  397. BNE CMPERR NOT EQUAL P0914 00377000
  398. VCOLON LR R3,R7 SET UP LENGTH FOR COMPARE @VA06435 00378000
  399. LR R9,R7 SET UP LENGTH FOR COMPARE 00379000
  400. CLCL R2,R8 COMPARE 2 RECORDS 00380000
  401. BE READ 00381000
  402. CMPERR LM R8,R9,BUFAREA RESTORE START ADDRS OF BUFFERS P0914 00382000
  403. LTR R7,R7 ANY RECORD 1 LENGTH @VA07852 00382200
  404. BNZ TYPERR1 YES , TYPE RECORD 1 MESSAGE @VA07852 00382400
  405. L R7,FCB1+40 NO, USE RECORD LENGTH READ @VA07852 00382600
  406. TYPERR1 EQU * @VA07852 00382800
  407. STH R7,TYPE+14 TYPE LENGTH @VA01243 00383000
  408. ST R8,TYPBUF-1 BUFFER AREA 00384000
  409. MVI TYPBUF-1,X'01' 00385000
  410. LA R1,TYPE SET PARM POINTER 00386000
  411. SVC 202 00387000
  412. DC AL4(*+4) ERROR 00388000
  413. * 00389000
  414. ST R9,TYPBUF-1 BUFFER AREA 2 00390000
  415. LTR R11,R11 ANY RECORD 2 LENGTH @VA07852 00390200
  416. BNZ TYPERR2 YES,TYPE RECORD 2 MESSAGE @VA07852 00390400
  417. L R11,FCB2+40 NO, USE RECORD LENGTH READ @VA07852 00390600
  418. TYPERR2 EQU * @VA07852 00390800
  419. STH R11,TYPE+14 TYPE LENGTH @VA01243 00391000
  420. MVI TYPBUF-1,X'01' 00392000
  421. LA R1,=CL8'CONWAIT' GIVE ERROR MESSAGES A ... @VM03083 00393000
  422. SVC 202 CHANCE TO "CATCH UP" @VM03083 00394000
  423. LA R1,TYPE PARM POINTER 00395000
  424. SVC 202 00396000
  425. LA R6,4 SET FOR CODE 4 ON EXIT. 00397000
  426. B READ 00398000
  427. EJECT 00399000
  428. ********************************************************************** 00400000
  429. * INTERNAL CONVERSION ROUTINE 00401000
  430. * 00402000
  431. ********************************************************************** 00403000
  432. * 00404000
  433. * AT ENTRY R1 POINTS TO BEGINNING OF NUMERIC FIELD 00405000
  434. * AT EXIT R1 HOLDS THE ANSWER 00406000
  435. * (CONVERTS WHILE SCANNING FOR BLANK AND POSSIBLE ILLEGAL CHARS) 00407000
  436. * 00408000
  437. CONVRT SR R8,R8 CLEAR PARTIAL SUM 00409000
  438. SR R9,R9 CLEAR A REG 00410000
  439. LA R15,LOOP3 ALLOW SPACE FOR LEADING ZEROES @VA06292 00411000
  440. CHKLDZ EQU * @VA06292 00412000
  441. CLI CURR(R1),LEADZ IS THIS A LEADING ZERO? @VA06292 00413000
  442. BNE LOOPCTRL NO @VA06292 00414000
  443. LA R1,NEXT1(R1) GO TO NEXT POSITION @VA06292 00415000
  444. BCT R15,CHKLDZ LIMIT TEST TO 3 POSITIONS @VA06292 00416000
  445. LOOPCTRL EQU * @VA06292 00417000
  446. LA R15,LOOP6 MAXIMUM EFFECTIVE LENGTH 5 BYTES @VA06292 00418000
  447. CVTLOOP CLI 0(R1),C' ' BLANK? 00419000
  448. BE CVTDONE YES, FINISHED 00420000
  449. CLC 0(,R1),ENDTEMP END OF OPTION FIELD? @VA06292 00421000
  450. BNL CVTDONE YES, FINISHED @VA06292 00422000
  451. IC R9,0(,R1) PICK UP BYTE 00423000
  452. SH R9,K0 SUBTRACK C'0' 00424000
  453. BM CVTERR ERROR IF NOT 0-9 00425000
  454. MH R8,TEN MULTIPLY OLD PARTIAL SUM BY TEN 00426000
  455. AR R8,R9 ADD NEW DIGIT 00427000
  456. LA R1,1(R1) BUMP FOR NEXT DIGIT 00428000
  457. BCT R15,CVTLOOP ITERATE TO BLANK OR 8TH CHAR 00429000
  458. CVTERR LA R0,SETCOL SET UP ERROR POINTER 00430000
  459. B ERR03A GO OUTPUT MSG 00431000
  460. CVTDONE LR R1,R8 ANSWER INTO R1 @VA06292 00432000
  461. BR R7 RETURN @VA06292 00433000
  462. TEN DC H'10' 00434000
  463. K0 DC X'00',C'0' C'0' FOR SUBTRACT 00435000
  464. EJECT 00436000
  465. * 00437000
  466. * ERROR MESSAGE 00438000
  467. * 00439000
  468. SPACE 1 00440000
  469. RDERR1 CH 15,=H'12' IS IT EOF 00441000
  470. BNE FATAL NO 00442000
  471. * 00443000
  472. LA R1,FCB2 READ 2ND FILE AGAIN 00444000
  473. L R15,ARDBUF ... @V305032 00445000
  474. SSM DISABLE DISABLE INTERRUPTS @VA06295 00446000
  475. BALR R14,R15 (VIA BALR) @V305032 00447000
  476. BNZ RETURN1 ERROR RETURN @V305032 00448000
  477. SSM ENABLE ENABLE INTERRUPTS @VA06295 00449000
  478. LA R0,FCB1+8 00450000
  479. RDERR1A DMSERR NUM=010,LET=E,TEXT='PREMATURE EOF ON FILE ''............00451000
  480. .........''',SUB=(CHAR8A,(0)) V0414 00452000
  481. LA R15,40 00453000
  482. B RETURN 00454000
  483. RETURN1 CH R15,=H'12' IS IT END OF FILE 00455000
  484. BNE FATAL IF NOT, BAD ERROR 00456000
  485. LR R15,R6 SET CODE 00457000
  486. B RETURN GO FINISH UP 00458000
  487. RDERR3 CH R15,=H'12' IS IT EOF 00459000
  488. BNE FATAL NO 00460000
  489. B CLOSEM GO CLOSE THE FILES & EXIT. 00461000
  490. RDERR2 CH R15,=H'12' IS IT EOF 00462000
  491. BNE FATAL NO 00463000
  492. LA R0,FCB2+8 00464000
  493. B RDERR1A 00465000
  494. FATAL1 EQU * @VA12416 00466000
  495. C R15,=F'36' WAS DISK NOT ACCESSED? @VA12416 00466250
  496. BE ERRMSG36 GIVE MSG @VA12416 00466500
  497. C R15,=F'28' FILE NOT FOUND FROM STATE? @VA12416 00466750
  498. BNE FATAL1A IF NOT, MSG WAS GIVEN BY STATE 00467000
  499. LA R0,8(R1) 00468000
  500. DMSERR NUM=02,LET=E,TEXT='FILE ''....................'' NOT X00469000
  501. FOUND. ',SUB=(CHAR8A,(0)) V0146 00470000
  502. LA R15,28 CODE FOR FILE NOT FOUND 00471000
  503. FATAL1A TM FILE2,X'FF' IF 2ND FILE, FINIS 1ST ONE 00472000
  504. BO EXIT1 00473000
  505. B EXIT 00474000
  506. ERRMSG36 EQU * @VA12416 00474150
  507. LA R0,24(R1) POINT TO MODE LETTER @VA12416 00474300
  508. DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X00474450
  509. LET=E,SUB=(CHARA,((R0),1)),TYPCALL=SVC @VA12416 00474600
  510. LA R15,36 GIVE RETCODE @VA12416 00474750
  511. B FATAL1A AND GO RETURN TO CALLER @VA12416 00474900
  512. SAMEFILE DMSERR NUM=19,LET=E,TEXT='IDENTICAL FILEIDS' P3019 00475000
  513. LA R15,24 RETURN CODE 00476000
  514. B EXIT GO EXIT. 00477000
  515. FATAL LA R0,8(R1) 00478000
  516. LR R10,R15 GET RETURN CODE FROM DMSBRD 00479000
  517. DMSERR NUM=104,LET=S,TEXT='ERROR ''..'' READING FILE ''.......X00480000
  518. .............'' FROM DISK',SUB=(DEC,(10),CHAR8A,(0)), X00481000
  519. RENT=NO 00482000
  520. LA R15,100 00483000
  521. B RETURN 00484000
  522. SPACE 1 00485000
  523. NOSPACE EQU * @VA10242 00486000
  524. DMSERR NUM=109,LET=S,TEXT='VIRTUAL STORAGE *00486350
  525. CAPACITY EXCEEDED' @VA10242 00486700
  526. LA R15,104 @VA05505 00488000
  527. B CLOSEM @VA05505 00489000
  528. SPACE 1 00490000
  529. FNEQ DMSERR NUM=11,LET=E,TEXT='CONFLICTING FILE FORMATS' 00491000
  530. LA R15,32 RETURN CODE 00492000
  531. B EXIT 00493000
  532. * 00494000
  533. ERR01 DMSERR NUM=54,LET=E,TEXT='INCOMPLETE FILEID SPECIFIED' 00495000
  534. LA R15,24 00496000
  535. B EXIT 00497000
  536. * 00498000
  537. ERR02 LA R0,8(R4) POINT TO INVALID OPTION 00499000
  538. ERR02A EQU * V0141 00500000
  539. DMSERR NUM=3,LET=E,TEXT='INVALID OPTION ''........'' ',SUB=(CH,00501000
  540. ARA,(0)) 00502000
  541. LA R15,24 00503000
  542. B EXIT 00504000
  543. * 00505000
  544. ERR03 LA R0,16(R4) 00506000
  545. ERR03A DMSERR NUM=29,LET=E,TEXT='INVALID PARAMETER ''........'' IN THX00507000
  546. E COLUMN FIELD',SUB=(CHARA,(0)) V0306 00508000
  547. LA R15,24 00509000
  548. B EXIT 00510000
  549. * 00511000
  550. ERR05 DMSERR NUM=9,LET=E,TEXT='COLUMN ''........'' EXCEEDS RECORD X00512000
  551. LENGTH',SUB=(DECA,(0)) V0306 00513000
  552. LA R15,24 00514000
  553. B EXIT 00515000
  554. * 00516000
  555. ERR06 DMSERR NUM=5,LET=E,TEXT='NO COLUMN SPECIFIED' V0306 00517000
  556. LA R15,24 00518000
  557. B EXIT 00519000
  558. ERR07 DMSERR NUM=62,LET=E,TEXT='INVALID * IN FILEID' @VA02445 00520000
  559. LA R15,20 @VA02445 00521000
  560. B EXIT @VA02445 00522000
  561. ERR08 DMSERR NUM=211,LET=E,TEXT='COLUMN FIELDS OUT OF SEQUENCE' 00523000
  562. LA R15,RC24 RET CODE 24 @VA06292 00524000
  563. B EXIT RETURN @VA06292 00525000
  564. EJECT 00526000
  565. * 00527000
  566. * EXIT PROCESSING 00528000
  567. * 00529000
  568. SPACE 1 00530000
  569. CLOSEM EQU * GO CLOSE THE TWO FILES @VA05505 00531000
  570. RETURN LR R6,R15 SAVE ERROR CODE 00532000
  571. LA R1,FCB2 CLOSE "FILE TWO" @V305032 00533000
  572. L R15,AFINIS ... @V305032 00534000
  573. BALR R14,R15 (VIA BALR) @V305032 00536000
  574. SSM ENABLE ENABLE INTERRUPTS @VA06295 00537000
  575. L R0,ALEN2 USE FILE2 LENGTH(DW) @VA07853 00538000
  576. ICM R1,B'1111',AREA2 LOAD FILE2 STORAGE POINTER @VA05505 00539000
  577. BZ FREE1 NONE ALLOCATED TRY FILE1 @VA05505 00540000
  578. DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00541000
  579. FREE1 ICM R1,B'1111',AREA1 LOAD FILE1 STORAGE POINTER @VA05505 00542000
  580. BZ RESTRETC NONE ALLOCATED. EXIT. @VA05505 00543000
  581. L R0,ALEN USE FILE1 LENGTH(DWORDS) @VA07853 00543500
  582. DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00544000
  583. RESTRETC EQU * @VA05505 00545000
  584. SSM ENABLE ENABLE @VA07793 00545100
  585. LR R15,R6 RESTORE RET CODE 00546000
  586. EXIT1 LR R6,R15 SAVE RETURN CODE, @V305032 00547000
  587. LA R1,FCB1 CLOSE "FILE ONE" @V305032 00548000
  588. L R15,AFINIS ... @V305032 00549000
  589. SSM DISABLE DISABLE INTERRUPTS @VA06295 00550000
  590. BALR R14,R15 (VIA BALR) @V305032 00551000
  591. SSM ENABLE ENABLE INTERRUPTS @VA06295 00552000
  592. LR R15,R6 RESTORE CODE 00553000
  593. EXIT EQU * 00554000
  594. LR R6,R15 SAVE ERROR RETURN CODE 00555000
  595. C R6,=F'4' WAS THERE A NO-COMPARE? P0788 00556000
  596. BNE EXIT2 P0788 00557000
  597. DMSERR NUM=209,LET=W,TEXT='FILES DO NOT COMPARE' P0788 00558000
  598. EXIT2 LR R15,R6 RESTORE RETURN CODE P0788 00559000
  599. LM R0,R14,SAVE RESTORE R0-R14 00560000
  600. BR R14 AND RETURN TO CALLER. 00561000
  601. * 00562000
  602. R0 EQU 0 00563000
  603. R1 EQU 1 00564000
  604. R2 EQU 2 00565000
  605. R3 EQU 3 00566000
  606. R4 EQU 4 00567000
  607. R5 EQU 5 00568000
  608. R6 EQU 6 00569000
  609. R7 EQU 7 00570000
  610. R8 EQU 8 00571000
  611. R9 EQU 9 00572000
  612. R10 EQU 10 00573000
  613. R11 EQU 11 V0363 00574000
  614. R12 EQU 12 V0363 00575000
  615. R14 EQU 14 00576000
  616. R15 EQU 15 00577000
  617. FCB1 FBLKS ,* V0363 00578000
  618. FCB2 FBLKS ,* V0363 00579000
  619. TYPE DS 0F 00580000
  620. DC CL8'TYPLIN' 00581000
  621. DC AL1(1) 00582000
  622. TYPBUF DC AL3(*) BUFFER ADDR 00583000
  623. DC C'B' 00584000
  624. DC AL3(0) 00585000
  625. DS 0D (DOUBLE-WORD ALIGNED IS BEST): 00586000
  626. FILE2 DC F'0' SWITCH 00587000
  627. ALEN DS 1F 00588000
  628. ALEN2 DS 1F SAVE FILE2 LENGTH(DWORDS) @VA07853 00588500
  629. AREA1 DS 1F 00589000
  630. AREA2 DS 1F 00590000
  631. BUFAREA DS 2F AREA TO SAVE BUF ADDRS 00591000
  632. CMPLNTH DS 1F LENGTH OF COMPARE @VA01243 00592000
  633. SAVE DS 15F R0-R14 SAVED HERE. 00593000
  634. COL1 DS 1F 00594000
  635. COL2 DS 5C 00595000
  636. SWS DC 1X'00' FLAG BYTE @VA06292 00596000
  637. LRECL EQU X'80' LAST COLUMN EQUAL TO LRECL @VA06292 00597000
  638. NOHYPH EQU X'40' NO HYPHEN IN MM-NN OPTION @VA06292 00598000
  639. COL EQU X'20' COLUMN OPTION SPECIFIED @VA06292 00599000
  640. SETCOL DS CL8 TEMP AREA FOR 'COL' OPTION 00600000
  641. ENDTEMP DC X'FA' FENCE FOR TEMP AREA @VA06292 00601000
  642. ZERO DC CL8'0' ZERO CHARACTER FOR ERROR MSG 00602000
  643. FILEID1 DC CL8' ' @VA03132 00603000
  644. DC CL8' ' @VA03132 00604000
  645. FM1 DC CL1' ' @VA03132 00605000
  646. FILEID2 DC CL8' ' @VA03132 00606000
  647. DC CL8' ' @VA03132 00607000
  648. FM2 DC CL1' ' @VA03132 00608000
  649. ENABLE DC X'FF' FOR SET SYSTEM MASK @VA06295 00609000
  650. DISABLE DC X'00' FOR SET SYSTEM MASK @VA06295 00610000
  651. BLANK EQU C' ' BLANK SPACE @VA06292 00611000
  652. ENDPARM EQU X'FF' END OF PARAMETER LIST @VA06292 00612000
  653. ENDOPT EQU C')' END OF OPTION LIST @VA06292 00613000
  654. CURR EQU 0 ZERO DISPLACEMENT @VA06292 00614000
  655. LEADZ EQU C'0' LEADING ZERO @VA06292 00615000
  656. LOOP8 EQU 8 LOOP COUNT OF 8 @VA06292 00616000
  657. LOOP6 EQU 6 LOOP COUNT OF 6 @VA06292 00617000
  658. LOOP3 EQU 3 LOOP COUNT OF 3 @VA06292 00618000
  659. NEXT1 EQU 1 1-BYTE DISPLACEMENT @VA06292 00619000
  660. OP24 EQU 24 24-BYTE DISPLACEMENT @VA06292 00620000
  661. RC24 EQU 24 RET CODE 24 @VA06292 00621000
  662. NUCON @VA06292 00622000
  663. ADT @VA06292 00623000
  664. FVS HRC015DS 00623100
  665. EJECT 00624000
  666. END 00625000