ibm:vm370-lib:cms:dmsrne.assemble_src
Table of Contents
DMSRNE Source
References
- Fixes Applied : 1
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R11046DS]
Source Listing
- DMSRNE.ASSEMBLE.txt
- RNE TITLE 'DMSRNE (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * MODULE NAME 00004000
- * 00005000
- * DMSRNE 00006000
- * 00007000
- * FUNCTION 00008000
- * 00009000
- * PROVIDE INTERFACE BETWEEN CMS EDITOR AND TSO'S 00010000
- * ICDQRNMS ROUTINE. DMSRNE AND ICDQRNMS GENMODED 00011000
- * TOGHETER AS 'RENUM' MODULE, WILL RENUMBER ANY 00012000
- * VSBASIC OR FREEFORT SOURCE PROGRAM CURRENTLY 00013000
- * BEING EDITED. 00014000
- * 00015000
- * ATTRIBUTES 00016000
- * 00017000
- * SERIALLY REUSEABLE 00018000
- * TRANSIENT MODULE 00019000
- * DISK RESIDENT 00020000
- * NOTE: RENUM MUST BE GENMOD'D WITH THE SYSTEM OPTION 00020100
- * 00021000
- * ENTRY POINTS 00022000
- * 00023000
- * DMSRNE 00024000
- * 00025000
- * ENTRY CONDITIONS 00026000
- * 00027000
- * R1 = PARAMETER LIST 00028000
- * 00029000
- * DC CL8'RENUM' COMMAND 00030000
- * DC CL8'FTYPE' FILETYPE ( VSBASIC OR FREEFORT ) 00031000
- * DC CL8'FMODE' FILEMODE 00032000
- * DS F STRTNO 00033000
- * DS F INCRNO 00034000
- * DS F AINCORE 00035000
- * DS F FSIZE 00036000
- * 00037000
- * PARAMETERS 00038000
- * 00039000
- * STRTNO - STARTING SEQ. NUMBER ( DEFAULTS TO 10 ) 00040000
- * INCRNO - INCREMENT AMOUNT ( DEFAULTS TO STRTNO ) 00041000
- * AINCORE - ADDRESS EDITED INCORE FILE 00042000
- * FSIZE - ITEM LENGTH OF EDITED FILE 00043000
- * 00044000
- * EXIT CONDITIONS 00045000
- * 00046000
- * RETURN TO CALLER WITH RETURN CODE IN R15 00047000
- * 00048000
- * RETURN CODES: 00049000
- * 00050000
- * 0 AND 100 00051000
- * 00052000
- * MESSAGES: 00053000
- * 00054000
- * - WRONG FILE FORMAT FOR RENUM 00055000
- * - SET NEW FILEMODE AND RETRY 00056000
- * - MAXIMUM LINE NUMBER EXCEEEDED 00057000
- * - VSBASIC STATEMENT OVERFLOW 00058000
- * - INVALID SYNTAX IN VSBASIC STATEMENT 00059000
- * - INVALID LINE NUMBER REFERENCE 00060000
- * - STATEMENT REFERENCED NOT FOUND 00061000
- * - ERROR READING/WRITING TO DISK 00062000
- * 00063000
- * CALLS TO OTHER ROUTINES 00064000
- * 00065000
- * DMSERS, DMSLADW, DMSBWR, DMSBRD, DMSFNS, 00066000
- * AND ICDQRNMS ( TSO'S CONVERT ) 00067000
- * 00068000
- * EXTERNAL REFERENCES 00069000
- * 00070000
- * NUCON 00071000
- * 00072000
- * TABLES/WORK AREAS 00073000
- * 00074000
- * INTERNAL 00075000
- * 00076000
- * REGISTER USAGE 00077000
- * 00078000
- * R0 NUCON ADDRESSABILITY 00079000
- * R1 COMMAND ADDRESS 00080000
- * R2 WORK 00081000
- * R3 WORK AND INCORE COPY ADDRESS 00082000
- * R4 WORK 00083000
- * R5 WORK 00084000
- * R6 WORK 00085000
- * R7 WORK 00086000
- * R8 WORK 00087000
- * R9 WORK 00088000
- * R10 INTERNAL LINKAGE 00089000
- * R11 WORK 00090000
- * R12 RENUM ADDRESSABILITY 00091000
- * R13 SAVE AREA ADDRESS 00092000
- * R14 EXTERNAL LINKAGE 00093000
- * R15 ADDRESS LINKING ROUTINE 00094000
- * 00095000
- * OPERATION 00096000
- * 00097000
- * 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00098000
- * THE EDITOR'S REGISTERS. 00099000
- * 00100000
- * 2. ENSURE THE FILETYPE IS VSBASIC OR FREEFORT 00101000
- * AND SAVE THE STRTNO, INCRNO, AINCORE AND FSIZE. 00102000
- * 00103000
- * 3. COMPUTE THE SIZE OF THE NUMBER TABLE AND INITIA- 00104000
- * LIZE THE WRBUF PLIST (WORK FILE). 00105000
- * 00106000
- * 4. VERIFY THAT THE DISK ORIGIN OF THE INPUT FILE 00107000
- * IS A READ/WRITE DISK (FOR VSBASIC FILES ONLY). 00108000
- * 00109000
- * 5. ACQUIRE THE NUMBER TABLE FORM FREE STORAGE, AND 00110000
- * INITIALIZE THE TABLE WITH THE OLD NUMBERS BY CON- 00111000
- * VERTING TO BINARY THE SEQUENCE NUMBER OF EACH RECORD 00112000
- * IN THE FILE. 00113000
- * 00114000
- * 6. ONCE THE OLD NUMBERS HAVE BEEN CONVERTED, THE 00115000
- * NEW NUMBERS ARE COMPUTED FROM THE STRTNO AND INCRNO 00116000
- * SPECIFIED BY THE USER, AND THE TABLE IS INITIALIZED 00117000
- * WITH THE COMPUTED NEW NUMBERS. IF PROCESSING A FREE 00118000
- * FORT FILE, SKIP TO STEP 10. 00119000
- * 00120000
- * 7. ONCE THE NUMBER TABLE IS BUILT, A RECORD IS 00121000
- * OBTAINED ( ONE AT A TIME ) AND A CALL IS MADE 00122000
- * TO ICDQRNMS TO CONVERT THE LINE USING THE NUMBER 00123000
- * TABLE PASSED AS A PARAMETER. ICDQRNMS WILL RETURN 00124000
- * THE UPDATED RECORD IN AN OUTPUT BUFFER, AND ANY 00125000
- * ERROR CONDITION FOUND IS DETECTED BY CHECKING A 00126000
- * RETURN CODE IN THE RNMSRC FIELD OF THE ICDQRNMS 00127000
- * PLIST. THE UPDATED RECORD IS WRITTEN TO A WORK FILE 00128000
- * WITH THE FILEID 'RENUM CMSUT1 FM'. 00129000
- * 00130000
- * 8. WHEN ALL RECORDS HAVE BEEN RENUMBERED, THE OUTPUT 00131000
- * FILE IS CLOSED. 00132000
- * 00133000
- * 9. NOW, THE WORK FILE IS READ AND THE INCORE COPY IS 00134000
- * UPDATED TO CONTAIN THE RENUMBERED FILE. THEN THE 00135000
- * WORK FILE IS ERASED AND CONTROL RETURNS TO EDIT. 00136000
- * 00137000
- * 10. IF RENUMBERING A FREEFORT FILE, COLUMNS 1 THRU 00138000
- * 8, OF EACH RECORD IN THE INCORE COPY, ARE UPDATED 00139000
- * TO THE NEW LINE NUMBERS COMPUTED IN STEP 6. 00140000
- * THE UPDATE IS DONE IN-PLACE AND CONTROL RETURNS 00141000
- * TO EDIT. 00142000
- *. 00143000
- EJECT 00144000
- *********************************************************************** 00145000
- * 00146000
- * ADDRESSABILITY AND REGISTER SAVE 00147000
- * 00148000
- *********************************************************************** 00149000
- SPACE 00150000
- DMSRNE CSECT @V242801 00151000
- USING NUCON,R0 NUCON ADDRESSABILITY @V242801 00152000
- USING DMSRNE,R15 TEMP. ADDRESSABILITY @V242801 00153000
- STM R0,R14,SAVREGS SAVE ALL REGISTERS @V242801 00154000
- DROP R15 @V242801 00155000
- USING DMSRNE,R12 RENUM ADDRESSABILITY @V242801 00156000
- LR R12,R15 LOAD BASE REGISTER @V242801 00157000
- XC RCODE,RCODE CLEAR RETURN CODE @V242801 00158000
- XC RNMSW,RNMSW CLEAR INTERNAL FLAGS @V242801 00159000
- MVC MAXNO,VBMAX SET DEFAULT TO VSBASIC'S @V242801 00160000
- EJECT 00161000
- *********************************************************************** 00162000
- * 00163000
- * CHECK THE FILETYPE AND SAVE THE PARAMETERS 00164000
- * 00165000
- *********************************************************************** 00166000
- SPACE 00167000
- LA R3,8(,R1) POINT TO THE FILETYPE @V242801 00168000
- CLC VSBASIC,0(R3) VSBASIC FILETYPE SPECIFIED ? @V242801 00169000
- BE FTYPEOK YES..LOOKS OK @V242801 00170000
- CLC FREEFORT,0(R3) FREEFORT FILETYPE SPECIFIED ? @V242801 00171000
- BNE ERR1 NO..ERROR @V242801 00172000
- OI RNMSW,FFORT SET FREEFORT FLAG @V242801 00173000
- MVC MAXNO,FFMAX SET MAXNO TO FREEFORT'S @V242801 00174000
- FTYPEOK LA R3,8(,R3) BUMP TO FILEMODE @V242801 00175000
- MVC FMODE,0(R3) FILEMODE TO PLIST @V242801 00176000
- LA R3,4(,R3) BUMP TO PARAMETERS @V242801 00177000
- LM R4,R7,0(R3) GET STRT/INCR/AINCORE/FSIZE @V242801 00178000
- STM R4,R6,STRTNO SAVE STRT/INCR/AINCORE @V242801 00179000
- ST R7,FSIZE AND THE RECORD LENGTH @V242801 00180000
- LTR R6,R6 ANY RECORDS INCORE ? @V242801 00181000
- BZ END NO..NULL FILE..JUST RETURN @V242801 00182000
- LA R2,1 INITIALIZE RECORD COUNT @V242801 00183000
- CHKNOIT L R6,0(,R6) POINT TO NEXT RECORD @V242801 00184000
- LTR R6,R6 DOES IT EXISTS ? @V242801 00185000
- BZ TABLEN NO..THIS IS IT THEN @V242801 00186000
- LA R2,1(,R2) UP COUNT BY ONE @V242801 00187000
- B CHKNOIT KEEP COUNTING @V242801 00188000
- EJECT 00189000
- *********************************************************************** 00190000
- * 00191000
- * SET-UP THE NUMBER TABLE LENGTH AND INITIALIZE 00192000
- * THE ICDQRNMS OUTPTR FIELD 00193000
- * 00194000
- *********************************************************************** 00195000
- SPACE 00196000
- TABLEN LA R2,1(,R2) PLUS ONE FOR NUMBER TABLE @V242801 00197000
- SLL R2,3 GET SIZE IN BINARY @V242801 00198000
- ST R2,LNUMTAB SAVE AS NUM TABLE LENGTH @V242801 00199000
- TM RNMSW,FFORT PROCESSING FREEFORT FILE ? @V242801 00200000
- BO GETNUMT YES..BRANCH THEN @V242801 00201000
- LA R2,OUTBUFF GET OUTPUT BUFFER ADDR @V242801 00202000
- ST R2,FBUFF SAVE IN WRBUF PLIST @V242801 00203000
- LA R2,5(,R2) BUMP PAST SEQ. NUMBER @V242801 00204000
- ST R2,OUTPTR SAVE AS RNMS OUTPUT BUFFER @V242801 00205000
- SPACE 00206000
- *********************************************************************** 00207000
- * 00208000
- * VERIFY THE DISK ORIGIN IS READ/WRITE 00209000
- * 00210000
- *********************************************************************** 00211000
- SPACE 00212000
- LA R1,FMODE-24 GET ADTLKW PLIST @V242801 00213000
- L R15,VCADTLKW GET ADTLKW ADDRESS @VM03093 00214100
- BALR R14,R15 CHECK IF R/W DISK @V242801 00215000
- BC 2,ERR2 DISK ORIGIN NOT R/W @V242801 00216000
- EJECT 00217000
- *********************************************************************** 00218000
- * 00219000
- * ACQUIRE THE NUMBER TABLE. TABLE SIZE IS A D-WORD 00220000
- * FOR EACH RECORD. 1ST WORD TO CONTAIN THE CURRENT 00221000
- * LINE NUMBER, SECOND WORD TO CONTAIN THE NEW LINE 00222000
- * NUMBER. THE INPUT FILE IS READ 'TILL EOF AND THE 00223000
- * FIRST 5 CHAR. ARE ASSUMED TO BE THE LINE NUMBER. 00224000
- * 00225000
- *********************************************************************** 00226000
- SPACE 00227000
- GETNUMT L R0,LNUMTAB GET NUMBER TABLE SIZE @V242801 00228000
- SRL R0,3 SIZE IN DBLE. WORDS @V242801 00229000
- DMSFREE DWORDS=(0),TYPE=USER @V242801 00230000
- ST R1,ANUMTAB SAVE NUMBER TABLE ADDR @V242801 00231000
- OI RNMSW,TABGOT REMEMBER TABLE ACQUIRED @V242801 00232000
- XC 4(4,R1),4(R1) ZERO 2ND WORD IN TABLE @V242801 00233000
- L R0,LNUMTAB GET TABLE LENGTH @V242801 00234000
- SH R0,H8 TABLE SIZE LESS 8 BYTES @V242801 00235000
- ST R0,0(R1) SAVE AS REAL TABLE LENGTH @V242801 00236000
- LH R5,H5 GET SEQ. NUM LEN (VSBASIC) @V242801 00237000
- TM RNMSW,FFORT PROCESSING FREEFORT FILE ? @V242801 00238000
- BZ SAVLEN NO..USE LEN IN R5 @V242801 00239000
- LH R5,H8 SEQ. NUM LEN FOR FREEFORT @V242801 00240000
- SAVLEN STH R5,SEQLEN SAVE THE SEQ. NUM LEN @V242801 00241000
- LA R2,8(,R1) POINT TO FIRST ENTRY @V242801 00242000
- L R3,AINCORE GET INCORE FILE ADDRESS @V242801 00243000
- LOOP BAL R10,GETREC GO GET A RECORD @V242801 00244000
- B ITISEOF EOF EXIT FROM GETREC @V242801 00245000
- LA R1,INBUFF GET BUFFER ADDRESS @V242801 00246000
- LH R5,SEQLEN GET NUMBER LENGTH @V242801 00247000
- LOOP1 CLI 0(R1),BLANK IS DIGIT A BLANK ? @V242801 00248000
- BE DIGITOK YES..BRANCH THEN @V242801 00249000
- CLI 0(R1),X'F0' IS DIGIT LESS THAN ZERO ? @V242801 00250000
- BL ERR1 YES..ERROR @V242801 00251000
- CLI 0(R1),X'F9' IS DIGIT OVER NINE ? @V242801 00252000
- BH ERR1 YES..ERROR @V242801 00253000
- DIGITOK LA R1,1(,R1) BUMP TO NEXT DIGIT @V242801 00254000
- BCT R5,LOOP1 CHECK ALL DIGITS @V242801 00255000
- LA R1,INBUFF GET BUFFER ADDRESS @V242801 00256000
- LH R5,SEQLEN GET NUMBER LENGTH @V242801 00257000
- BCTR R5,0 LESS 1 FOR EXECUTE @V242801 00258000
- EX R5,OC MAKE ALL BLANKS ZEROS @V242801 00259000
- EX R5,PACK PACK THE LINE NUMBER @V242801 00260000
- CVB R1,WORK NOW, CONVERT TO BINARY @V242801 00261000
- ST R1,0(,R2) SAVE IN OLD LIST @V242801 00262000
- LA R2,8(,R2) BUMP LIST TO NEXT ENTRY @V242801 00263000
- B LOOP KEEP READING 'TILL EOF @V242801 00264000
- EJECT 00265000
- *********************************************************************** 00266000
- * 00267000
- * THE NEW NUMBERS ARE COMPUTED AND THE NUMBER 00268000
- * TABLE IS INITIALIZED WITH THE NEW NUMBERS 00269000
- * 00270000
- *********************************************************************** 00271000
- SPACE 00272000
- ITISEOF L R2,LNUMTAB GET NUMBER TABLE LENGTH @V242801 00273000
- SRL R2,3 COMPUTE DOBLE. WORDS @V242801 00274000
- BCTR R2,0 LESS ONE (TABLE HEADER) @V242801 00275000
- L R1,ANUMTAB GET NUMBER TABLE ADDRESS @V242801 00276000
- LA R1,12(,R1) POINT TO FIRST ENTRY @V242801 00277000
- LM R3,R4,STRTNO GET START LINE NO. @V242801 00278000
- LOOP2 C R3,MAXNO EXCEEDS MAX ALLOWED ? @V242801 00279000
- BH ERR3 YES..ERROR @V242801 00280000
- ST R3,0(,R1) SAVE AS NEW LINE NUMBER @V242801 00281000
- AR R3,R4 UP LINE NUMBER BY INCR @V242801 00282000
- LA R1,8(,R1) BUMP TABLE TO NEXT ENTRY @V242801 00283000
- BCT R2,LOOP2 LOOP 'TILL TABLE DONE @V242801 00284000
- TM RNMSW,FFORT PROCESSING FREEFORT FILE ? @V242801 00285000
- BO RENFREE YES..GO RENUMBER FILE @V242801 00286000
- LA R1,INBUFF GET ADDRESS INPUT BUFFER @V242801 00287000
- LA R1,5(,R1) BUMP PAST SEQ. NUMBER @V242801 00288000
- ST R1,INPTR SAVE AS RNMS INPUT BUFFER @V242801 00289000
- MVC ERSFILE(18),FNAME SET UP ERASE FILEID @V242801 00290000
- LA R1,ERASE GET ERASE PLIST @V242801 00291000
- L R15,AERASE ERASE @V305066 00292000
- BALR R14,R15 (IF ANY) @V305066 00292100
- L R2,ANUMTAB GET NUMBER TABLE ADDR @V242801 00294000
- LA R2,8(,R2) POINT TO 1ST ENTRY @V242801 00295000
- L R3,AINCORE GET INCORE COPY ADDRESS @V242801 00296000
- EJECT 00297000
- *********************************************************************** 00298000
- * 00299000
- * THE INPUT FILE IS READ ONE RECORD AT A TIME. RNMS IS 00300000
- * CALLED TO CONVERT THE RECORD (USING THE NUMBER TABLE) 00301000
- * AND THE UPDATED RECORD IS WRITTEN TO DISK. 00302000
- * 00303000
- *********************************************************************** 00304000
- SPACE 00305000
- LOOP3 BAL R10,GETREC GO GET A RECORD @V242801 00306000
- B RETURN EOF EXIT FROM GETREC @V242801 00307000
- L R4,FSIZE GET RECORD LENGTH @V242801 00308000
- SH R4,H5 LESS LINE NUMBER LENGTH @V242801 00309000
- ST R4,INLEN SAVE FOR RNMS USE @V242801 00310000
- LA R5,OUTBUFF+5 POINT TO RNMS OUTPUT BUFFER @V242801 00311000
- MVI 0(R5),BLANK PREPARE TO BLANK @V242801 00312000
- EX R4,MVC1 BLANK ENOUGH FOR THIS LRECL @V242801 00313000
- BAL R10,CALLRNMS GO CONVERT THIS LINE @V242801 00314000
- L R5,OUTLEN GET OUTPUT REC LENGTH @V242801 00315000
- LA R5,5(,R5) ADD LINE NUMBER LENGTH @V242801 00316000
- C R5,FSIZE IS THERE OVERFLOW ? @V242801 00317000
- BNH RECOK NO..BRANCH @V242801 00318000
- L R2,0(,R2) GET STMNT NUMBER IN ERROR @V242801 00319000
- B ERR4 GIVE ERROR MSG @V242801 00320000
- RECOK L R5,4(,R2) GET NEW LINE NUMBER @V242801 00321000
- CVD R5,WORK CONVERT IT @V242801 00322000
- UNPK OUTBUFF(5),WORK UNPACK IT @V242801 00323000
- OI OUTBUFF+4,X'F0' SET ZONE @V242801 00324000
- LA R5,OUTBUFF GET OUPUT BUFFER ADDR @V242801 00325000
- LOOP4 CLI 0(R5),X'F0' IS DIGIT ZERO ? @V242801 00326000
- BNE WRITEIT NO..LEADING ZEROS BLANK @V242801 00327000
- NI 0(R5),X'4F' MAKE ZERO A BLANK @V242801 00328000
- LA R5,1(,R5) BUMP TO NEXT DIGIT @V242801 00329000
- B LOOP4 KEEP LOOKING @V242801 00330000
- WRITEIT LA R1,PLIST GET WRBUF PLIST @V242801 00331000
- L R15,AWRBUF GET WRBUF ADDRESS @V242801 00332000
- BALR R14,R15 GO TO IT @V242801 00333000
- BNZ ERR104W BRANCH IF ERROR @V242801 00334000
- LA R2,8(,R2) BUMP TO NEXT ENTRY @V242801 00335000
- B LOOP3 KEEP LOOPING 'TILL EOF @V242801 00336000
- EJECT 00337000
- *********************************************************************** 00338000
- * 00339000
- * CLOSE THE WORK FILE AND RELEASE THE NUMBER TABLE FROM 00340000
- * FREE STORAGE. IF RENUMBERING A VSBASIC FILE, THE WORK 00341000
- * FILE IS READ AND THE INCORE COPY OF THE FILE IS UPDA- 00342000
- * TED. THEN THE WORK FILE IS ERASED AND CONTROL RETURNS 00343000
- * TO THE EDITOR. 00344000
- * 00345000
- *********************************************************************** 00346000
- SPACE 00347000
- RETURN LA R1,PLIST GET FINIS PLIST @V242801 00348000
- L R15,AFINIS FINIS @V305066 00349000
- BALR R14,R15 ... @V305066 00349100
- RETURN2 TM RNMSW,TABGOT HAS NUM TABLE BEEN ACQUIRED ? @V242801 00351000
- BZ END NO..JUST GET OUT @V242801 00352000
- L R0,LNUMTAB GET SIZE NUMBER TABLE @V242801 00353000
- SRL R0,3 IN DOBLE. WORDS @V242801 00354000
- L R1,ANUMTAB GET NUMBER TABLE ADDRESS @V242801 00355000
- DMSFRET DWORDS=(0),LOC=(1) @V242801 00356000
- TM RNMSW,FFORT PROCESSING FREEFORT FILE ? @V242801 00357000
- BO END YES..JUST GET OUT @V242801 00358000
- L R15,RCODE GET POSSIBLE ERROR CODE @V242801 00359000
- LTR R15,R15 ANY FOUND ? @V242801 00360000
- BNZ ERSOUT YES..ERASE OUTPUT FILE @V242801 00361000
- L R2,AINCORE GET POINTER TO INCORE FILE @V242801 00362000
- L R3,FSIZE GET LRECL @V242801 00363000
- BCTR R3,0 LESS 1 FOR LATER EXECUTE @V242801 00364000
- READNEW LA R1,PLIST GET RDBUF PLIST @V242801 00365000
- L R15,ARDBUF GET RDBUF ADDRESS @V242801 00366000
- BALR R14,R15 GO READ A RECORD @V242801 00367000
- BNZ CHKEOF POSSIBLE ERROR OR EOF @V242801 00368000
- EX R3,MOVEUP MOVE RECORD TO INCORE @V242801 00369000
- L R2,0(,R2) BUMP TO NEXT LOCATION @V242801 00370000
- B READNEW READ 'TILL EOF @V242801 00371000
- CHKEOF CH R15,EOF IS IT END-OF-FILE ? @V242801 00372000
- BNE ERR104R NO..MUST BE OTHER ERROR @V242801 00373000
- ERSOUT LA R1,ERASE GET ERASE PLIST @V242801 00374000
- L R15,AERASE ERASE @V305066 00375000
- BALR R14,R15 ... @V305066 00375100
- END L R15,RCODE GET ERROR CODE @V242801 00377000
- LM R0,R14,SAVREGS RESTORE ALL REGS @V242801 00378000
- BR R14 RETURN TO CALLER @V242801 00379000
- EJECT 00380000
- *********************************************************************** 00381000
- * 00382000
- * CONVERT STMNT NUMBERS TO EBCDIC (FOR ERROR MSGS) 00383000
- * 00384000
- *********************************************************************** 00385000
- SPACE 00386000
- CONVERT LA R4,8 PREPARE TO BLANK @V242801 00387000
- LA R5,OUTBUFF SOME OF WORK AREA @V242801 00388000
- MVI 0(R5),BLANK TO LEFT JUSTIFY @V242801 00389000
- EX R4,MVC1 THE CONVERTED NUMBER. @V242801 00390000
- CVD R2,WORK NOW CONVERT THE NUMBER @V242801 00391000
- UNPK OUTBUFF(5),WORK AND UNPACK IT @V242801 00392000
- OI OUTBUFF+4,X'F0' SET ZONE LAST DIGIT @V242801 00393000
- LOOP5 CLI 0(R5),X'F0' CHECK FOR 1ST. NON-ZERO @V242801 00394000
- BNER R10 RETURN IF SO @V242801 00395000
- LA R5,1(,R5) BUMP TO NEXT DIGIT @V242801 00396000
- B LOOP5 KEEP LOOKING @V242801 00397000
- SPACE 00398000
- *********************************************************************** 00399000
- * 00400000
- * READ A RECORD FROM CORE INTO INBUFF 00401000
- * 00402000
- *********************************************************************** 00403000
- SPACE 00404000
- GETREC LTR R3,R3 ANYTHING LEFT @V242801 00405000
- BZR R10 NO..THAT IS ALL @V242801 00406000
- L R4,FSIZE GET RECORD LENGTH @V242801 00407000
- BCTR R4,0 LESS 1 FOR EXECUTE @V242801 00408000
- EX R4,MVEDOWN MOVE INCORE REC TO BUFFER @V242801 00409000
- L R3,0(,R3) POINT TO NEXT REC @V242801 00410000
- B 4(,R10) RETURN @V242801 00411000
- EJECT 00412000
- *********************************************************************** 00413000
- * 00414000
- * ROUTINE TO CALL RNMS - CONVERT VSBASIC SOURCE 00415000
- * 00416000
- *********************************************************************** 00417000
- SPACE 00418000
- CALLRNMS L R15,ARNMS GET RNMS ADDRESS @V242801 00419000
- LA R13,RNMSAV GET SAVE AREA ADDR @V242801 00420000
- LA R1,A1RNMSPL GET RNMS PLIST ADDR/ADDR @V242801 00421000
- BALR R14,R15 GO TO CONVERT LINE @V242801 00422000
- L R5,RNMSRC GET RETURN CODE @V242801 00423000
- LTR R5,R5 ANY ERRORS ? @V242801 00424000
- CALLOK BZR R10 NO..RETURN @V242801 00425000
- L R2,0(,R2) GET STMNT NUMBER IN ERROR @V242801 00426000
- B RNMSERR(R5) GO TO SPECIFIED ERROR MSG @V242801 00427000
- RNMSERR B CALLOK JUST IN CASE @V242801 00428000
- B ERR5 RETURN CODE = 4 @V242801 00429000
- B ERR4 RETURN CODE = 8 @V242801 00430000
- B ERR5 RETURN CODE = 12 @V242801 00431000
- B ERR6 RETURN CODE = 16 @V242801 00432000
- B ERR7 RETURN CODE = 20 @V242801 00433000
- SPACE 00434000
- *********************************************************************** 00435000
- * 00436000
- * ROUTINE TO RENUMBER AND UPDATE THE INCORE COPY 00437000
- * OF THE FREEFORT FILE. 00438000
- * 00439000
- *********************************************************************** 00440000
- SPACE 00441000
- RENFREE L R3,AINCORE GET INCORE COPY ADDRESS @V242801 00442000
- LM R4,R5,STRTNO GET STRTNO/INCRNO VALUES @V242801 00443000
- LOOP6 CVD R4,WORK CONVERT NUMBER @V242801 00444000
- UNPK 8(8,R3),WORK UNPACK IT @V242801 00445000
- OI 15(R3),X'F0' SET ZONE LAST DIGIT @V242801 00446000
- L R3,0(,R3) BUMP TO NEXT RECORD @V242801 00447000
- LTR R3,R3 IS THIS IT ? @V242801 00448000
- BZ RETURN2 YES..JUST GET OUT @V242801 00449000
- AR R4,R5 COMPUTE NEXT SEQ. NUMBER @V242801 00450000
- B LOOP6 KEEP LOOPING 'TILL DONE @V242801 00451000
- EJECT 00452000
- *********************************************************************** 00453000
- * 00454000
- * ERROR MESSAGES 00455000
- * 00456000
- *********************************************************************** 00457000
- SPACE 00458000
- ERR1 LA R15,ERR1LST GET ERROR LIST ADDRESS @V242801 00459000
- ST R15,RCODE SAVE AS RETURN CODE @V242801 00460000
- B RETURN2 EXIT @V242801 00461000
- * 00462000
- ERR2 LA R15,ERR2LST GET ERROR LIST ADDRESS @V242801 00463000
- ST R15,RCODE SAVE AS RETURN CODE @V242801 00464000
- B END EXIT @V242801 00465000
- * 00466000
- ERR3 LA R15,ERR3LST GET ERROR LIST ADDRESS @V242801 00467000
- ERREXIT ST R15,RCODE SAVE AS RETURN CODE @V242801 00468000
- B RETURN EXIT @V242801 00469000
- * 00470000
- ERR4 LA R15,ERR4LST GET ERROR LIST ADDRESS @V242801 00471000
- ST R15,RCODE SAVE AS RETURN CODE @V242801 00472000
- BAL R10,CONVERT CONVERT THE STMNT NUMBER @V242801 00473000
- MVC ERR4SUB,0(R5) MOVE TO MSG AS SUB. @V242801 00474000
- B RETURN EXIT @V242801 00475000
- * 00476000
- ERR5 LA R15,ERR5LST GET ERROR LIST ADDRESS @V242801 00477000
- ST R15,RCODE SAVE AS RETURN CODE @V242801 00478000
- BAL R10,CONVERT CONVERT THE STMNT NUMBER @V242801 00479000
- MVC ERR5SUB,0(R5) MOVE TO MSG AS SUB. @V242801 00480000
- B RETURN EXIT @V242801 00481000
- * 00482000
- ERR6 LA R15,ERR6LST GET ERROR LIST ADDRESS @V242801 00483000
- ST R15,RCODE SAVE AS RETURN CODE @V242801 00484000
- BAL R10,CONVERT CONVERT THE STMNT NUMBER @V242801 00485000
- MVC ERR6SUB,0(R5) MOVE TO MSG AS SUB. @V242801 00486000
- B RETURN EXIT @V242801 00487000
- * 00488000
- ERR7 LA R15,ERR7LST GET ERROR LIST ADDRESS @V242801 00489000
- ST R15,RCODE SAVE AS RETURN CODE @V242801 00490000
- BAL R10,CONVERT CONVERT THE STMNT NUMBER @V242801 00491000
- MVC ERR7SUB2,0(R5) MOVE TO MSG AS SUB2. @V242801 00492000
- L R2,OUTLEN GET TARGET LINE NUMBER @V242801 00493000
- BAL R10,CONVERT CONVERT THE STMNT NUMBER @V242801 00494000
- MVC ERR7SUB1,0(R5) MOVE TO MSG AS SUB1. @V242801 00495000
- B RETURN EXIT @V242801 00496000
- EJECT 00497000
- ERR104R LA R3,READING GET OPERATION @V242801 00498000
- LA R4,FROM MAKE IT PRETTY @V242801 00499000
- LA R6,104 GET MESSAGE NUMBER @V242801 00500000
- B ERR104 GIVE MESSAGE @V242801 00501000
- ERR104W CH R15,DSKFUL IS IT DISK FULL ? @V242801 00502000
- BE ERREXIT YES..JUST GET OUT @V242801 00503000
- LA R3,WRITING GET OPERATION @V242801 00504000
- LA R4,TO MAKE IT PRETTY @V242801 00505000
- LA R6,105 GET MESSAGE NUMBER @V242801 00506000
- ERR104 LR R5,R15 GET ERROR CODE IN REG 5 @V242801 00507000
- LA R2,PLIST+8 POINT TO FILEID @V242801 00508000
- DMSERR TEXT='ERROR ''....'' ........ FILE ''..................*00509000
- ..'' .... DISK',NUM=(R6),LET=S,RENT=NO,CSECT=EDI, *00510000
- SUB=(DEC,(R5),CHARA,(R3),CHAR8A,(R2),CHARA,(R4)) 00511000
- MVI RCODE+3,100 SET RETURN CODE @V242801 00512000
- B RETURN RELEASE TABLES @V242801 00513000
- EJECT 00514000
- *********************************************************************** 00515000
- * 00516000
- * PLISTS FOR RDBUF, WRBUF, RNMS AND ERASE 00517000
- * 00518000
- *********************************************************************** 00519000
- SPACE 00520000
- DS 0D @V242801 00521000
- PLIST DC CL8'FINIS' RDBUF/WRBUF/FINIS COMMAND @V242801 00522000
- FNAME DC CL8'RENUM' FILENAME @V242801 00523000
- FTYPE DC CL8'CMSUT1' FILETYPE @V242801 00524000
- FMODE DS CL2 FILEMODE @V242801 00525000
- FITNO DC H'0' ITEM NUBER @V242801 00526000
- FBUFF DS A BUFFER ADDRESS @V242801 00527000
- FSIZE DS A RECORD LENGTH @V242801 00528000
- FVF DC CL2'F' FIXED/VARIABLE FLAG @V242801 00529000
- FNOIT DC H'1' NUMBER OF ITEMS TO READ @V242801 00530000
- * 00531000
- RNMSPL DS 0D @V242801 00532000
- INPTR DS F ADDR INPUT BUFFER @V242801 00533000
- OUTPTR DS F ADDR OUTPUT BUFFER @V242801 00534000
- ANUMTAB DS F ADDR NUMBER TABLE @V242801 00535000
- LNUMTAB DS F LEN NUMBER TABLE @V242801 00536000
- INLEN DS F LEN INPUT BUFFER @V242801 00537000
- RNMSRC DS F RNMS RETURN CODE @V242801 00538000
- OUTLEN DS F LEN OUTPUT BUFFER @V242801 00539000
- DS1FLG DC AL1(1),AL3(0) FLAG FOR DATA SET 1 @V242801 00540000
- DS 14F RNMS WORK @V242801 00541000
- DS 260CL1 RNMS WORK @V242801 00542000
- DS 260CL1 RNMS WORK @V242801 00543000
- * 00544000
- DS 0D ERASE PLIST @V242801 00545000
- ERASE DC CL8'ERASE' COMMAND @V242801 00546000
- ERSFILE DC CL24' ' FILEID @V242801 00547000
- DC 8X'FF' FENCE @V242801 00548000
- EJECT 00549000
- *********************************************************************** 00550000
- * 00551000
- * MESSAGES TEXT AND LENGTH 00552000
- * 00553000
- *********************************************************************** 00554000
- SPACE 00555000
- ERR1LST DC A(LERR1TXT),A(ERR1TXT) LENGTH AND TEXT ADDRESS @V242801 00556000
- ERR2LST DC A(LERR2TXT),A(ERR2TXT) LENGTH AND TEXT ADDRESS @V242801 00557000
- ERR3LST DC A(LERR3TXT),A(ERR3TXT) LENGTH AND TEXT ADDRESS @V242801 00558000
- ERR4LST DC A(LERR4TXT),A(ERR4TXT) LENGTH AND TEXT ADDRESS @V242801 00559000
- ERR5LST DC A(LERR5TXT),A(ERR5TXT) LENGTH AND TEXT ADDRESS @V242801 00560000
- ERR6LST DC A(LERR6TXT),A(ERR6TXT) LENGTH AND TEXT ADDRESS @V242801 00561000
- ERR7LST DC A(LERR7TXT),A(ERR7TXT) LENGTH AND TEXT ADDRESS @V242801 00562000
- * 00563000
- ERR1TXT DC C'WRONG FILE FORMAT FOR RENUM' @V242801 00564000
- LERR1TXT EQU *-ERR1TXT @V242801 00565000
- * 00566000
- ERR2TXT DC C'SET NEW FILEMODE AND RETRY' @V242801 00567000
- LERR2TXT EQU *-ERR2TXT @V242801 00568000
- * 00569000
- ERR3TXT DC C'MAXIMUM LINE NUMBER EXCEEDED' @V242801 00570000
- LERR3TXT EQU *-ERR3TXT @V242801 00571000
- * 00572000
- ERR4TXT DC C'OVERFLOW AT STMNT ' @V242801 00573000
- ERR4SUB DS CL5 @V242801 00574000
- LERR4TXT EQU *-ERR4TXT @V242801 00575000
- * 00576000
- ERR5TXT DC C'INVALID SYNTAX IN STMNT ' @V242801 00577000
- ERR5SUB DS CL5 @V242801 00578000
- LERR5TXT EQU *-ERR5TXT @V242801 00579000
- * 00580000
- ERR6TXT DC C'INVALID LINE NUMBER REFERENCE IN STMNT ' @V242801 00581000
- ERR6SUB DS CL5 @V242801 00582000
- LERR6TXT EQU *-ERR6TXT @V242801 00583000
- * 00584000
- ERR7TXT DC C'LINE ' @V242801 00585000
- ERR7SUB1 DS CL5 @V242801 00586000
- DC C'REFERENCED IN STMNT ' @V242801 00587000
- ERR7SUB2 DS CL5 @V242801 00588000
- DC C', NOT FOUND' @V242801 00589000
- LERR7TXT EQU *-ERR7TXT @V242801 00590000
- EJECT 00591000
- *********************************************************************** 00592000
- * 00593000
- * EQUATES, CONSTANTS, WORKAREA AND LITERALS 00594000
- * 00595000
- *********************************************************************** 00596000
- SPACE 00597000
- BLANK EQU C' ' BLANK CODE @V242801 00598000
- WORK DS D WORK ARE FOR PACK/UNPACK @V242801 00599000
- RNMSAV DS 18F RNMS SAVE AREA @V242801 00600000
- A1RNMSPL DC A(A2RNMSPL) RNMS PLIST ADDRESS/ADDRESS @V242801 00601000
- A2RNMSPL DC A(RNMSPL) RNMS PLIST ADDRESS @V242801 00602000
- ARNMS DC V(ICDQRNMS) ADDRESS CONVERT ROUTINE @V242801 00603000
- SAVREGS DS 15F SAVE AREA FOR CALLERS REGS @V242801 00604000
- RCODE DS F RETURN CODE SAVE @V242801 00605000
- STRTNO DS F STARTING SEQ. NO. @V242801 00606000
- INCRNO DS F INCREMENTS @V242801 00607000
- AINCORE DS F ADDRESS EDIT INCORE FILE @V242801 00608000
- MAXNO DS F MAX STRT/INCR ALLOWED @V242801 00609000
- VBMAX DC F'99999' MAXNO FOR VSBASIC @V242801 00610000
- FFMAX DC F'99999999' MAXNO FOR FREEFORT @V242801 00611000
- EOF DC H'12' END-OF-FILE RETURN CODE @V242801 00612000
- DSKFUL DC H'13' DISK FULL RETURN CODE @V242801 00613000
- H5 DC H'5' CONSTANT OF FIVE @V242801 00614000
- H8 DC H'8' CONSTANT OF EIGHT @V242801 00615000
- SEQLEN DC H'0' SEQ. NUMBER LENGTH @V242801 00616000
- OC OC 0(1,R1),ZEROS CHANGE ALL BLANKS TO ZERO @V242801 00617000
- PACK PACK WORK,0(1,R1) PACK THE LINE NUMBER @V242801 00618000
- MVC1 MVC 1(0,R5),0(R5) MVC TO BLANK PLIST @V242801 00619000
- MOVEUP MVC 8(0,R2),OUTBUFF MVC TO MOVE BUFFER TO INCORE @V242801 00620000
- MVEDOWN MVC INBUFF(1),8(R3) MVC TO MOVE INCORE TO BUFFER @V242801 00621000
- * 00622000
- VSBASIC DC CL8'VSBASIC' FILETYPE FOR VSBASIC INPUT @V242801 00623000
- FREEFORT DC CL8'FREEFORT' FILETYPE FOR FREEFORT INPUT @V242801 00624000
- READING DC CL8'READING' MSG 104R OPERATION @V242801 00625000
- WRITING DC CL8'WRITING' MSG 104W OPERATION @V242801 00626000
- FROM DC CL4'FROM' MSG 104R FROM @V242801 00627000
- TO DC CL4'TO' MSG 104W TO @V242801 00628000
- ZEROS DC CL8'00000000' CHANGE ALL BLANKS TO ZEROS @V242801 00629000
- INBUFF DS CL168 RNMS INPUT BUFFER @VA11046 00630000
- OUTBUFF DS CL168 RNMS OUTPUT BUFFER @VA11046 00631000
- RNMSW DS CL1 INTERNAL SWITCH @V242801 00632000
- FFORT EQU X'80' FREEFORT FILE @V242801 00633000
- TABGOT EQU X'04' NUMBER TABLE ACQUIRED @V242801 00634000
- EJECT 00635000
- NUCON @V242801 00636000
- REGEQU @V242801 00637000
- END 00638000
ibm/vm370-lib/cms/dmsrne.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator