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