ibm:vm370-lib:cms:dmsupd.assemble_src
Table of Contents
DMSUPD Source
References
- Fixes Applied : 9
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC015DS]
Source Listing
- DMSUPD.ASSEMBLE.txt
- UPD TITLE 'DMSUPD (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- * 00003000
- * MACROS FOR INTERFACE WITH CMS V1.0 AND VM/370 00004000
- * 00005000
- SPACE 00006000
- MACRO 00007000
- &NAME CMS &PLIST,&ERR,&BUFF=,&CMD= 00008000
- AIF ('&NAME' EQ '').SKPNM 00009000
- &NAME EQU * - CALL A CMS FUNCTION 00010000
- .SKPNM AIF ('&BUFF' EQ '').SKPBF 00011000
- LA R1,&BUFF - BUFFER ADDRESS 00012000
- ST R1,&PLIST+28 - RESET BUFFER ADDRESS 00013000
- .SKPBF LA R1,&PLIST - PARM LIST ADDRESS 00014000
- AIF ('&CMD' EQ '').SKCMD 00015000
- MVC 0(8,R1),=CL8'&CMD' - FILL IN COMMAND NAME 00016000
- .SKCMD SVC 202 - CALL TO CMS FUNCTION 00017000
- AIF ('&ERR' EQ '').NOERR 00018000
- DC AL4(&ERR) - ERROR RETURN ADDRESS 00019000
- MEXIT 00020000
- .NOERR DC AL4(*+4) - IGNORE ANY ERROR RETURN 00021000
- MEND 00022000
- SPACE 2 00023000
- MACRO 00024000
- WARN &N 00025000
- CLI RC,&N COMPARE WITH OLD RC 00026000
- BH *+8 SKIP IF OLD IS HIGHER 00027000
- MVI RC,&N SET HIGHER RETURN CODE 00028000
- MEND 00029000
- SPACE 3 00030000
- MACRO 00031000
- UPITEM &F 00032000
- LH R1,ITEM+&F GET OLD ITEM NUMBER FROM FSCB 00033000
- LA R1,1(,R1) INCREMENT IT 00034000
- STH R1,ITEM+&F STORE NEW ITEM NUMBER 00035000
- MEND 00036000
- EJECT 00037000
- MACRO 00038000
- &NAME LOG &TEXT,&KEY,&CUTE 00039000
- LCLA &NM 00040000
- AIF ('&NAME' EQ '').SKPNM 00041000
- &NAME EQU * - WRITE A RECORD TO LOGFILE 00042000
- .SKPNM BAL R1,CLRLOGB - CLEAR LOGFILE BUFFER 00043000
- AIF ('&TEXT'(1,1) NE '''').LABL 00044000
- &NM SETA K'&TEXT-2 00045000
- LA R1,=C&TEXT 00046000
- MVC LOGBUFF(&NM),0(R1) - MOVE MSG TO BUFFER 00047000
- .DOIT ANOP 00048000
- BAL R15,LOGIT 00049000
- MEXIT 00050000
- .LABL AIF ('&KEY' NE 'ERR').CCTL 00051000
- MVC LOGBUFF(80),&TEXT - MOVE CARD TO BUFFER 00052000
- AGO .DOIT 00053000
- .CCTL AIF ('&KEY' NE 'CTL').CCUE 00054000
- MVC LOGBUFF+8(72),&TEXT - MOVE CARD TO BUFFER 00055000
- AGO .DOIT 00056000
- .CCUE AIF ('&KEY' NE 'CUE').COL8 00057000
- &NM SETA K'&CUTE-2 00058000
- MVC LOGBUFF(&NM),=C&CUTE - CUEING MESSAGE 00059000
- .COL8 MVC LOGBUFF+16(80),&TEXT - MOVE CARD TO BUFFER 00060000
- AGO .DOIT 00061000
- MEND 00062000
- EJECT 00063000
- MACRO 00064000
- &LABEL OPT &N,&MIN,&CKAD,&DO,&ARG 00065000
- &LABEL DC CL8'&N' - OPTION NAME 00066000
- DC AL2(&MIN-1) - (MINIMUM # LETTERS) - 1 00067000
- DC AL2(&CKAD-CKADS) - CHECK ADDRESS 00068000
- AIF ('&DO' EQ 'ON').ON 00069000
- AIF ('&DO' EQ 'OFF').OFF 00070000
- AIF ('&DO' EQ 'GO').GO 00071000
- MNOTE 8,'ILLEGAL PARAMETER ''&DO''' 00072000
- MEXIT 00073000
- .ON AIF ('&N' EQ 'STOR').ON2 00074000
- OI GLOBALS,&ARG - TURN ON FLAG 00075000
- SPACE 00076000
- MEXIT 00077000
- .ON2 OI UPDFLAG,&ARG - TURN ON FLAG 00078000
- SPACE 00079000
- MEXIT 00080000
- .OFF AIF ('&N' EQ 'NOSTOR').OFF2 00081000
- NI GLOBALS,X'FF'-&ARG - TURN OFF FLAG 00082000
- SPACE 00083000
- MEXIT 00084000
- .OFF2 NI UPDFLAG,X'FF'-&ARG - TURN OFF FLAG 00085000
- SPACE 00086000
- MEXIT 00087000
- .GO B &ARG - BRANCH TO OPTION HANDLER 00088000
- SPACE 00089000
- MEXIT 00090000
- MEND 00091000
- EJECT 00092000
- *. 00093000
- * MODULE NAME - 00094000
- * 00095000
- * DMSUPD (UPDATE COMMAND) 00096000
- * 00097000
- * FUNCTION - 00098000
- * 00099000
- * CMS 'UPDATE' COMMAND -- UPDATE SOURCE FILES ACCORDING 00100000
- * TO SPECIFICATIONS IN UPDATE FILES. MULTIPLE UPDATES 00101000
- * MAY BE MADE, ACCORDING TO SPECIFICATIONS IN CONTROL 00102000
- * FILES WHICH DESIGNATE THE UPDATE FILES. 00103000
- * 00104000
- * ATTRIBUTES - 00105000
- * 00106000
- * DISK RESIDENT, NON-RE-ENTRANT, NON-REUSABLE 00107000
- * 00108000
- * ENTRY POINTS - 00109000
- * 00110000
- * DMSUPD 00111000
- * 00112000
- * ENTRY CONDITIONS - 00113000
- * 00114000
- * LA R1,PLIST 00115000
- * SVC 202 00116000
- * 00117000
- * WHERE THE PLIST HAS THE FORMAT DESCRIBED IN THE COMMAND 00118000
- * LANGUAGE USER'S GUIDE 00119000
- * 00120000
- * EXIT CONDITIONS - 00121000
- * 00122000
- * NORMAL - 00123000
- * RETURN CODE 0 IN REGISTER 15 00124000
- * 00125000
- * ERROR - 00126000
- * RETURN CODE IN REGISTER 15 00127000
- * 4 SEQUENCE ERROR IN INPUT SOURCE FILE 00128000
- * 8 SEQUENCE ERROR INTRODUCED INTO OUTPUT FILE 00129000
- * 12 OTHER NON-FATAL UPDATING ERROR (SUCH AS INVALID 00130000
- * UPDATE FILE CONTROL CARD) 00131000
- * 20-36 FATAL ERROR, CAUSING UPDATE TO ABORT (SUCH AS 00132000
- * INVALID OPTION, MISSING FILENAME, INVALID CONTROL 00133000
- * FILE, ETC.) 00134000
- * 40 NO UPDATE FILES WERE FOUND WITH 'CTL' OPTION 00135000
- * 100 I/O ERROR READING OR WRITING 00136000
- * 00137000
- * CALLS TO OTHER ROUTINES - 00138000
- * 00139000
- * ADTLKP LOOK UP ACTIVE DISK TABLE 00140000
- * ADTLKW LOOK UP READ/WRITE ACTIVE DISK TABLE 00141000
- * FSREAD READ RECORDS FROM INPUT FILES 00142000
- * FSWRITE WRITE RECORDS TO OUTPUT FILES 00143000
- * FSCLOSE CLOSE INPUT AND OUTPUT FILES 00144000
- * FSERASE ERASE OLD COPIES OF OUTPUT FILES 00145000
- * PRINTL PRINT THE LOG FILE 00146000
- * LINEDIT TYPE MESSAGES AND FORM LINES 00147000
- * DMSERR TYPE ERROR MESSAGES 00148000
- * FSSTATE DETERMINE EXISTENCE OF INPUT FILES 00149000
- * ATTN STACK LINES (WITH 'STK' OPTION) 00150000
- * RENAME RENAME WORK FILES 00151000
- * 00152000
- * EXTERNAL REFERENCES - 00153000
- * 00154000
- * NUCON NUCLEUS CONSTANTS AND VARIABLES 00155000
- * ADT ACTIVE DISK TABLE 00156000
- * 00157000
- * TABLES / WORKAREAS - 00158000
- * 00159000
- * NONE -- ALL WORK STORAGE IS IN-LINE 00160000
- * 00161000
- * REGISTER USAGE - 00162000
- * 00163000
- * R12 BASE REGISTER # 1 00164000
- * R11 BASE REGISTER # 2 00165000
- * R9 BASE REGISTER # 3 00166000
- * R10 HOLDS SEQ8/SEQ5 COUNT FOR EX 00167000
- * R2 - R8 WORK REGISTERS 00168000
- * 00169000
- * NOTES - 00170000
- * 00171000
- * NONE 00172000
- * 00173000
- * OPERATION - 00174000
- * 00175000
- * IF A SINGLE UPDATE IS TO BE PERFORMED, THEN THE INPUT 00176000
- * SOURCE FILE AND THE UPDATE FILE ARE OPENED. AS THE 00177000
- * CONTROL CARDS ARE READ FROM THE UPDATE FILE, INSERTIONS 00178000
- * AND DELETIONS ARE MADE TO THE SOURCE FILE, WITH THE 00179000
- * UPDATED VERSION WRITTEN ONTO DISK AS $FNAME. 00180000
- * 00181000
- * IF MULTIPLE UPDATES ARE TO BE PERFORMED, THEN THE CONTROL 00182000
- * FILE IS OPENED, AND USED AS A GUIDE TO THE VARIOUS 00183000
- * UPDATE FILES. UPDATE FILE CONTROL CARDS MAY REFER 00184000
- * TO UPDATE FILES, OR TO 'AUX' FILES CONTAINING 00185000
- * DESIGNATIONS OF UPDATE FILEIDS. (THE EXACT FORMATS OF 00186000
- * THESE FILES IS DESCRIBED IN DETAIL IN THE COMMAND 00187000
- * LANGUAGE USER'S GUIDE.) IF NO UPDATE FILES ARE FOUND 00188000
- * AT ALL, A RETURN CODE OF 40 IS GENERATED (THIS CODE IS 00189000
- * GENERATED IN ONLY THIS WAY). 00190000
- * WHEN MULTIPLE UPDATES ARE BEING PERFORMED, THE INPUT 00191000
- * SOURCE FILE IS READ INTO STORAGE AND THE UPDATES ARE 00192000
- * THEN PERFORMED IN STORAGE. ALL UPDATES ARE DONE 00193000
- * IN STORAGE BEFORE THE OUTPUT FILE IS CREATED 00194000
- * ON DISK. 00195000
- * 00196000
- * AS A FINAL STEP, IF THE 'REP' OPTION WAS SPECIFIED, THEN 00197000
- * THE $FNAME FILE IS RENAMED TO FNAME. 00198000
- *. 00199000
- EJECT 00200000
- * "FSSTATE/FSREAD/FSWRITE/FSCLOSE/FSERASE" MACROS WITH BALR CALLS: 00201000
- SPACE 00202000
- MACRO 00203000
- &LABEL FSSTATE &FILEID,&FSCB=,&ERROR= 00204000
- GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00205000
- AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00206000
- AIF (T'&FILEID EQ 'O').NOID 00207000
- AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00208000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00209000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR4 00210000
- &DMSNAME SETC ' ' 00211000
- &DMSTYPE SETC ' ' 00212000
- &DMSMODE SETC ' ' 00213000
- AIF ('&FILEID'(1,1) EQ '(').SKIP1 00214000
- &DMSMODE SETC 'A1' 00215000
- DMSPID &FILEID 00216000
- AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00217000
- .SKIP1 AIF (T'&FSCB EQ 'O').NOCB 00218000
- .NOID AIF (T'&LABEL EQ 'O').NLBL 00219000
- &LABEL DS 0H 00220000
- .NLBL ANOP 00221000
- AIF ('&FSCB'(1,1) EQ '(').REG1 00222000
- LA 1,&FSCB 00223000
- AGO .CONT1 00224000
- .REG1 AIF ('&FSCB(1)' EQ '1').CONT1 00225000
- LR 1,&FSCB(1) 00226000
- .CONT1 ANOP 00227000
- AIF (T'&FILEID EQ 'O').CONT2 00228000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00229000
- MVC 8(8,1),=CL8'&DMSNAME' 00230000
- MVC 16(8,1),=CL8'&DMSTYPE' 00231000
- MVC 24(2,1),=CL2'&DMSMODE' 00232000
- AGO .CONT2 00233000
- .REG2 ANOP 00234000
- MVC 8(18,1),0(&FILEID(1)) 00235000
- .CONT2 ANOP 00236000
- MVC 40(4,1),28(1) 00237000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00238000
- L R15,ASTATE CALL 'STATE' VIA BALR 00239000
- BALR R14,R15 ... 00240000
- L R14,0(,R1) RECOVER R14 00241000
- AIF (T'&ERROR EQ 'O').NOER 00242000
- BNZ &ERROR 00243000
- AGO .CONT3 00244000
- .NOER ANOP 00245000
- BNZ DMS&SYSNDX.B 00246000
- .CONT3 ANOP 00247000
- L 15,28(,1) 00248000
- MVC 28(4,1),40(1) 00249000
- LR 1,15 00250000
- SR 15,15 00251000
- AIF (T'&ERROR NE 'O').EXIT 00252000
- DMS&SYSNDX.B EQU * 00253000
- .EXIT MEXIT 00254000
- .NOCB ANOP 00255000
- CNOP 0,4 00256000
- &LABEL BAL 1,DMS&SYSNDX.A 00257000
- DC CL8'STATE' 00258000
- DC CL8'&DMSNAME' 00259000
- DC CL8'&DMSTYPE' 00260000
- DC CL2'&DMSMODE' 00261000
- DC CL2' ' 00262000
- DC AL4(0) 00263000
- DMS&SYSNDX.A EQU * 00264000
- AIF ('&FILEID'(1,1) NE '(').SKIP2 00265000
- MVC 8(18,1),0(&FILEID(1)) 00266000
- .SKIP2 ANOP 00267000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00268000
- L R15,ASTATE CALL 'STATE' VIA BALR 00269000
- BALR R14,R15 ... 00270000
- L R14,0(,R1) RECOVER R14 00271000
- AIF (T'&ERROR EQ 'O').NERR 00272000
- BNZ &ERROR 00273000
- AGO .SKIP3 00274000
- .NERR ANOP 00275000
- BNZ *+8 00276000
- .SKIP3 ANOP 00277000
- L 1,28(,1) 00278000
- MEXIT 00279000
- .ERR1 MNOTE 8,'NEITHER FILEID OF FSCB SPECIFIED' 00280000
- MEXIT 00281000
- .ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00282000
- MEXIT 00283000
- .ERR3 MNOTE 8,'REGISTER 1 INVALID FOR FILEID' 00284000
- MEXIT 00285000
- .ERR4 MNOTE 8,'INVALID USE OF REGISTER 0' 00286000
- MEND 00287000
- SPACE 00288000
- MACRO 00289000
- &LABEL FSREAD &FILEID,&FSCB=,&RECFM=,&BUFFER=,&BSIZE=,&RECNO=,&NOREC=X00290000
- ,&ERROR= 00291000
- GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00292000
- AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00293000
- AIF (T'&FILEID EQ 'O').NOID 00294000
- AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00295000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00296000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00297000
- &DMSNAME SETC ' ' 00298000
- &DMSTYPE SETC ' ' 00299000
- &DMSMODE SETC ' ' 00300000
- AIF ('&FILEID'(1,1) EQ '(').CONT1 00301000
- &DMSMODE SETC 'A1' 00302000
- DMSPID &FILEID 00303000
- AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00304000
- .CONT1 AIF (T'&FSCB EQ 'O').NOCB 00305000
- .NOID AIF (T'&LABEL EQ 'O').NLBL 00306000
- &LABEL DS 0H 00307000
- .NLBL ANOP 00308000
- AIF ('&FSCB'(1,1) EQ '(').REG1 00309000
- LA 1,&FSCB 00310000
- AGO .CONT2 00311000
- .REG1 AIF ('&FSCB(1)' EQ '1').CONT2 00312000
- LR 1,&FSCB(1) 00313000
- .CONT2 AIF (T'&FILEID EQ 'O').CONT3 00314000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00315000
- MVC 8(8,1),=CL8'&DMSNAME' 00316000
- MVC 16(8,1),=CL8'&DMSTYPE' 00317000
- MVC 24(2,1),=CL2'&DMSMODE' 00318000
- AGO .CONT3 00319000
- .REG2 ANOP 00320000
- MVC 8(18,1),0(&FILEID(1)) 00321000
- .CONT3 AIF (T'&RECNO EQ 'O').SKIP1 00322000
- AIF ('&RECNO'(1,1) EQ '(').STOR1 00323000
- MVC 26(2,1),=H'&RECNO' 00324000
- AGO .SKIP1 00325000
- .STOR1 ANOP 00326000
- AIF ('&RECNO(1)' EQ '1').ERR4 00327000
- STH &RECNO(1),26(,1) 00328000
- .SKIP1 AIF (T'&BUFFER EQ 'O').SKIP2 00329000
- AIF ('&BUFFER'(1,1) EQ '(').STOR2 00330000
- MVC 28(4,1),=A(&BUFFER) 00331000
- AGO .SKIP2 00332000
- .STOR2 ANOP 00333000
- AIF ('&BUFFER(1)' EQ '1').ERR5 00334000
- ST &BUFFER(1),28(,1) 00335000
- .SKIP2 AIF (T'&BSIZE EQ 'O').SKIP3 00336000
- AIF ('&BSIZE'(1,1) EQ '(').STOR3 00337000
- MVC 32(4,1),=F'&BSIZE' 00338000
- AGO .SKIP3 00339000
- .STOR3 ANOP 00340000
- AIF ('&BSIZE(1)' EQ '1').ERR6 00341000
- ST &BSIZE(1),32(,1) 00342000
- .SKIP3 AIF (T'&RECFM EQ 'O').SKIP4 00343000
- AIF ('&RECFM'(1,1) EQ '(').STOR4 00344000
- AIF ('&RECFM' NE 'F' AND '&RECFM' NE 'V').ERR11 00345000
- MVC 36(2,1),=CL2'&RECFM' 00346000
- AGO .SKIP4 00347000
- .STOR4 ANOP 00348000
- AIF ('&RECFM(1)' EQ '1').ERR7 00349000
- STC &RECFM(1),36(,1) 00350000
- .SKIP4 AIF (T'&NOREC EQ 'O').SKIP5 00351000
- AIF ('&NOREC'(1,1) EQ '(').STOR5 00352000
- MVC 38(2,1),=H'&NOREC' 00353000
- AGO .SKIP5 00354000
- .STOR5 ANOP 00355000
- AIF ('&NOREC(1)' EQ '1').ERR8 00356000
- STH &NOREC(1),38(,1) 00357000
- .SKIP5 ANOP 00358000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00359000
- L R15,ARDBUF CALL 'RDBUF' VIA BALR 00360000
- BALR R14,R15 ... 00361000
- L R14,0(,R1) RECOVER R14 00362000
- AIF (T'&ERROR EQ 'O').NOER 00363000
- BNZ &ERROR BRANCH IF ERROR OCCURRED 00364000
- .NOER ANOP 00365000
- L 0,40(,1) 00366000
- MEXIT 00367000
- .NOCB ANOP 00368000
- AIF (T'&BUFFER EQ 'O').ERR9 00369000
- AIF (T'&BSIZE EQ 'O').ERR10 00370000
- CNOP 0,4 00371000
- &LABEL BAL 1,DMS&SYSNDX.A 00372000
- FSCB &FILEID 00373000
- DMS&SYSNDX.A EQU * 00374000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00375000
- AGO .CONT3 00376000
- .ERR1 MNOTE 8,'NEITHER FILEID OR FSCB SPECIFIED' 00377000
- MEXIT 00378000
- .ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00379000
- MEXIT 00380000
- .ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00381000
- MEXIT 00382000
- .ERR4 MNOTE 8,'REGISTER 1 INVALID FOR RECNO' 00383000
- MEXIT 00384000
- .ERR5 MNOTE 8,'REGISTER 1 INVALID FOR BUFFER' 00385000
- MEXIT 00386000
- .ERR6 MNOTE 8,'REGISTER 1 INVALID FOR BSIZE' 00387000
- MEXIT 00388000
- .ERR7 MNOTE 8,'REGISTER 1 INVALID FOR RECFM' 00389000
- MEXIT 00390000
- .ERR8 MNOTE 8,'REGISTER 1 INVALID FOR NOREC' 00391000
- MEXIT 00392000
- .ERR9 MNOTE 8,'BUFFER ADDRESS NOT SPECIFIED' 00393000
- MEXIT 00394000
- .ERR10 MNOTE 8,'BUFFER SIZE NOT SPECIFIED' 00395000
- MEXIT 00396000
- .ERR11 MNOTE 8,'INVALID RECFM SPECIFICATION' 00397000
- MEND 00398000
- SPACE 00399000
- MACRO 00400000
- &LABEL FSWRITE &FILEID,&FSCB=,&RECFM=,&BUFFER=,&BSIZE=,&RECNO=,&NORECX00401000
- =,&ERROR= 00402000
- GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00403000
- AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00404000
- AIF (T'&FILEID EQ 'O').NOID 00405000
- AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00406000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00407000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00408000
- &DMSNAME SETC ' ' 00409000
- &DMSTYPE SETC ' ' 00410000
- &DMSMODE SETC ' ' 00411000
- AIF ('&FILEID'(1,1) EQ '(').CONT1 00412000
- &DMSMODE SETC 'A1' 00413000
- DMSPID &FILEID 00414000
- AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00415000
- .CONT1 AIF (T'&FSCB EQ 'O').NOCB 00416000
- .NOID AIF (T'&LABEL EQ 'O').NLBL 00417000
- &LABEL DS 0H 00418000
- .NLBL ANOP 00419000
- AIF ('&FSCB'(1,1) EQ '(').REG1 00420000
- LA 1,&FSCB 00421000
- AGO .CONT2 00422000
- .REG1 AIF ('&FSCB(1)' EQ '1').CONT2 00423000
- LR 1,&FSCB(1) 00424000
- .CONT2 AIF (T'&FILEID EQ 'O').CONT3 00425000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00426000
- MVC 8(8,1),=CL8'&DMSNAME' 00427000
- MVC 16(8,1),=CL8'&DMSTYPE' 00428000
- MVC 24(2,1),=CL2'&DMSMODE' 00429000
- AGO .CONT3 00430000
- .REG2 ANOP 00431000
- MVC 8(18,1),0(&FILEID(1)) 00432000
- .CONT3 AIF (T'&RECNO EQ 'O').SKIP1 00433000
- AIF ('&RECNO'(1,1) EQ '(').STOR1 00434000
- MVC 26(2,1),=H'&RECNO' 00435000
- AGO .SKIP1 00436000
- .STOR1 ANOP 00437000
- AIF ('&RECNO(1)' EQ '1').ERR4 00438000
- STH &RECNO(1),26(,1) 00439000
- .SKIP1 AIF (T'&BUFFER EQ 'O').SKIP2 00440000
- AIF ('&BUFFER'(1,1) EQ '(').STOR2 00441000
- MVC 28(4,1),=A(&BUFFER) 00442000
- AGO .SKIP2 00443000
- .STOR2 ANOP 00444000
- AIF ('&BUFFER(1)' EQ '1').ERR5 00445000
- ST &BUFFER(1),28(,1) 00446000
- .SKIP2 AIF (T'&BSIZE EQ 'O').SKIP3 00447000
- AIF ('&BSIZE'(1,1) EQ '(').STOR3 00448000
- MVC 32(4,1),=F'&BSIZE' 00449000
- AGO .SKIP3 00450000
- .STOR3 ANOP 00451000
- AIF ('&BSIZE(1)' EQ '1').ERR6 00452000
- ST &BSIZE(1),32(,1) 00453000
- .SKIP3 AIF (T'&RECFM EQ 'O').SKIP4 00454000
- AIF ('&RECFM'(1,1) EQ '(').STOR4 00455000
- AIF ('&RECFM' NE 'F' AND '&RECFM' NE 'V').ERR11 00456000
- MVC 36(2,1),=CL2'&RECFM' 00457000
- AGO .SKIP4 00458000
- .STOR4 ANOP 00459000
- AIF ('&RECFM(1)' EQ '1').ERR7 00460000
- STC &RECFM(1),36(,1) 00461000
- .SKIP4 AIF (T'&NOREC EQ 'O').SKIP5 00462000
- AIF ('&NOREC'(1,1) EQ '(').STOR5 00463000
- MVC 38(2,1),=H'&NOREC' 00464000
- AGO .SKIP5 00465000
- .STOR5 ANOP 00466000
- AIF ('&NOREC(1)' EQ '1').ERR8 00467000
- STH &NOREC(1),38(,1) 00468000
- .SKIP5 ANOP 00469000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00470000
- L R15,AWRBUF CALL 'WRBUF' VIA BALR 00471000
- BALR R14,R15 ... 00472000
- L R14,0(,R1) RECOVER R14 00473000
- AIF (T'&ERROR EQ 'O').NOER 00474000
- BNZ &ERROR BRANCH IF ERROR OCCURRED 00475000
- .NOER ANOP 00476000
- MEXIT 00477000
- .NOCB ANOP 00478000
- AIF (T'&BUFFER EQ 'O').ERR9 00479000
- AIF (T'&BSIZE EQ 'O').ERR10 00480000
- CNOP 0,4 00481000
- &LABEL BAL 1,DMS&SYSNDX.A 00482000
- SPACE 00483000
- FSCB &FILEID 00484000
- DMS&SYSNDX.A EQU * 00485000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00486000
- AGO .CONT3 00487000
- .ERR1 MNOTE 8,'NEITHER FILEID OR FSCB SPECIFIED' 00488000
- MEXIT 00489000
- .ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00490000
- MEXIT 00491000
- .ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00492000
- MEXIT 00493000
- .ERR4 MNOTE 8,'REGISTER 1 INVALID FOR RECNO' 00494000
- MEXIT 00495000
- .ERR5 MNOTE 8,'REGISTER 1 INVALID FOR BUFFER' 00496000
- MEXIT 00497000
- .ERR6 MNOTE 8,'REGISTER 1 INVALID FOR BSIZE' 00498000
- MEXIT 00499000
- .ERR7 MNOTE 8,'REGISTER 1 INVALID FOR RECFM' 00500000
- MEXIT 00501000
- .ERR8 MNOTE 8,'REGISTER 1 INVALID FOR NOREC' 00502000
- MEXIT 00503000
- .ERR9 MNOTE 8,'BUFFER ADDRESS NOT SPECIFIED' 00504000
- MEXIT 00505000
- .ERR10 MNOTE 8,'BUFFER SIZE NOT SPECIFIED' 00506000
- MEXIT 00507000
- .ERR11 MNOTE 8,'INVALID RECFM SPECIFICATION' 00508000
- MEND 00509000
- SPACE 00510000
- MACRO 00511000
- &LABEL FSCLOSE &FILEID,&FSCB=,&ERROR= 00512000
- GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00513000
- AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00514000
- AIF (T'&FILEID EQ 'O').NOID 00515000
- AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00516000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00517000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00518000
- &DMSNAME SETC ' ' 00519000
- &DMSTYPE SETC ' ' 00520000
- &DMSMODE SETC ' ' 00521000
- AIF ('&FILEID'(1,1) EQ '(').SKIP1 00522000
- &DMSMODE SETC 'A1' 00523000
- DMSPID &FILEID 00524000
- AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00525000
- .SKIP1 AIF (T'&FSCB EQ 'O').NOCB 00526000
- .NOID AIF (T'&LABEL EQ 'O').NLBL 00527000
- &LABEL DS 0H 00528000
- .NLBL ANOP 00529000
- AIF ('&FSCB'(1,1) EQ '(').REG1 00530000
- LA 1,&FSCB 00531000
- AGO .CONT1 00532000
- .REG1 AIF ('&FSCB(1)' EQ '1').CONT1 00533000
- LR 1,&FSCB(1) 00534000
- .CONT1 ANOP 00535000
- AIF (T'&FILEID EQ 'O').CONT2 00536000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00537000
- MVC 8(8,1),=CL8'&DMSNAME' 00538000
- MVC 16(8,1),=CL8'&DMSTYPE' 00539000
- MVC 24(2,1),=CL2'&DMSMODE' 00540000
- AGO .CONT2 00541000
- .REG2 ANOP 00542000
- MVC 8(18,1),0(&FILEID(1)) 00543000
- .CONT2 ANOP 00544000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00545000
- L R15,AFINIS CALL 'FINIS' VIA BALR 00546000
- BALR R14,R15 ... 00547000
- L R14,0(,R1) RECOVER R14 00548000
- AIF (T'&ERROR EQ 'O').NOER1 00549000
- BNZ &ERROR BRANCH IF ERROR OCCURRED 00550000
- .NOER1 ANOP 00551000
- MEXIT 00552000
- .NOCB ANOP 00553000
- CNOP 0,4 00554000
- &LABEL BAL 1,DMS&SYSNDX.A 00555000
- DC CL8'FINIS' 00556000
- DC CL8'&DMSNAME' 00557000
- DC CL8'&DMSTYPE' 00558000
- DC CL2'&DMSMODE' 00559000
- DMS&SYSNDX.A EQU * 00560000
- AIF ('&FILEID'(1,1) NE '(').SKIP2 00561000
- MVC 8(18,1),0(&FILEID(1)) 00562000
- .SKIP2 ANOP 00563000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00564000
- L R15,AFINIS CALL 'FINIS' VIA BALR 00565000
- BALR R14,R15 ... 00566000
- L R14,0(,R1) RECOVER R14 00567000
- AIF (T'&ERROR EQ 'O').NOER2 00568000
- BNZ &ERROR BRANCH IF ERROR OCCURRED 00569000
- .NOER2 ANOP 00570000
- MEXIT 00571000
- .ERR1 MNOTE 8,'NEITHER FILEID OR FSCB SPECIFIED' 00572000
- MEXIT 00573000
- .ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00574000
- MEXIT 00575000
- .ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00576000
- MEND 00577000
- SPACE 00578000
- MACRO 00579000
- &LABEL FSERASE &FILEID,&FSCB=,&ERROR= 00580000
- GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00581000
- AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00582000
- AIF (T'&FILEID EQ 'O').NOID 00583000
- AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00584000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00585000
- AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00586000
- &DMSNAME SETC ' ' 00587000
- &DMSTYPE SETC ' ' 00588000
- &DMSMODE SETC ' ' 00589000
- AIF ('&FILEID'(1,1) EQ '(').SKIP1 00590000
- &DMSMODE SETC 'A1' 00591000
- DMSPID &FILEID 00592000
- AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00593000
- .SKIP1 AIF (T'&FSCB EQ 'O').NOCB 00594000
- .NOID AIF (T'&LABEL EQ 'O').NLBL 00595000
- &LABEL DS 0H 00596000
- .NLBL ANOP 00597000
- AIF ('&FSCB'(1,1) EQ '(').REG1 00598000
- LA 1,&FSCB 00599000
- AGO .CONT1 00600000
- .REG1 AIF ('&FSCB(1)' EQ '1').CONT1 00601000
- LR 1,&FSCB(1) 00602000
- .CONT1 ANOP 00603000
- AIF (T'&FILEID EQ 'O').CONT2 00604000
- AIF ('&FILEID'(1,1) EQ '(').REG2 00605000
- MVC 8(8,1),=CL8'&DMSNAME' 00606000
- MVC 16(8,1),=CL8'&DMSTYPE' 00607000
- MVC 24(2,1),=CL2'&DMSMODE' 00608000
- AGO .CONT2 00609000
- .REG2 ANOP 00610000
- MVC 8(18,1),0(&FILEID(1)) 00611000
- .CONT2 ANOP 00612000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00613000
- L R15,AERASE CALL 'ERASE' VIA BALR 00614000
- BALR R14,R15 ... 00615000
- L R14,0(,R1) RECOVER R14 00616000
- AIF (T'&ERROR EQ 'O').NOER1 00617000
- BNZ &ERROR BRANCH IF ERROR OCCURRED 00618000
- .NOER1 ANOP 00619000
- MEXIT 00620000
- .NOCB ANOP 00621000
- CNOP 0,4 00622000
- &LABEL BAL 1,DMS&SYSNDX.A 00623000
- DC CL8'ERASE' 00624000
- DC CL8'&DMSNAME' 00625000
- DC CL8'&DMSTYPE' 00626000
- DC CL2'&DMSMODE' 00627000
- DC 8X'FF' 00628000
- DMS&SYSNDX.A EQU * 00629000
- AIF ('&FILEID'(1,1) NE '(').SKIP2 00630000
- MVC 8(18,1),0(&FILEID(1)) 00631000
- .SKIP2 ANOP 00632000
- ST R14,0(,R1) PRESERVE R14 (IN P-LIST) 00633000
- L R15,AERASE CALL 'ERASE' VIA BALR 00634000
- BALR R14,R15 ... 00635000
- L R14,0(,R1) RECOVER R14 00636000
- AIF (T'&ERROR EQ 'O').NOER2 00637000
- BNZ &ERROR BRANCH IF ERROR OCCURRED 00638000
- .NOER2 ANOP 00639000
- MEXIT 00640000
- .ERR1 MNOTE 8,'NEITHER FILEID OF FSCB SPECIFIED' 00641000
- MEXIT 00642000
- .ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00643000
- MEXIT 00644000
- .ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00645000
- MEND 00646000
- EJECT 00647000
- DMSUPD START X'20000' @VM03093 00648000
- SPACE 2 00649000
- USING DMSUPD,R12,R11,R9 BASE REGISTERS FOR ROUTINE 00650000
- USING NUCON,R0 00651000
- SPACE 2 00652000
- LR R12,R15 SET FIRST BASE REGISTER 00653000
- ST R14,SAVE14 SAVE RETURN ADDRESS 00654000
- LA R11,2048(0,R12) SET UP SECOND BASE REGISTER 00655000
- LA R11,2048(0,R11) ... 00656000
- LA R9,2048(,R11) SET THIRD BASE REG 00657000
- LA R9,2048(,R9) 00658000
- LR R6,R1 SAVE ADDRESS OF P-LIST BUFFER 00659000
- MVI GLOBALS,SEQ8+NSTK+DISK+TERM SET OPTION DEFAULTS 00660000
- LA R10,7(0,0) DEFAULT = EIGHT-DIGIT SEQUENCE 00661000
- ZAP SEQMAX,=P'100000000' SET MAX SEQ NUMBER P3027 00662000
- MVI UPDFLAG,X'04' INCORE DEFAULT @V2D4821 00663000
- MVI UPDFLAG2,0 ZERO THE FLAG @V2D4821 00664000
- MVI CTLMACS,X'40' BLANK OUT MACLIB BUFFER 00665000
- MVC CTLMACS+1(71),CTLMACS ... 00666000
- * NOW SET DEFAULTS IN THE DISK P-LISTS 00667000
- MVC INPFILE+16(10),=C'ASSEMBLEA1' FTYPE, FMODE 00668000
- MVC UPDFILE+16(10),=C'UPDATE A1' FTYPE,FMODE 00669000
- MVC CTLFILE+16(10),=C'CNTRL A1' FTYPE, FMODE 00670000
- MVC NEWNAME+8(10),=C'ASSEMBLEA1' FTYPE, FMODE 00671000
- MVC LOGFILE+16(8),=CL8'UPDLOG ' FTYPE 00672000
- DMSKEY NUCLEUS NOW RUN WITH NUCLEUS KEY, AND @VM03093 00673000
- SSM NOINTS NO EXTRANEOUS INTERRUPTS PLEASE @VM03093 00674000
- EJECT 00675000
- * NOW WE'RE ALL SET TO EXAMINE THE INPUT PARMS 00676000
- LA R2,8(0,R6) ADVANCE TO FIRST REAL PARAMETER 00677000
- CLC 0(8,R2),FENCED WERE ANY PARMS GIVEN ? 00678000
- BE NOFNAME NOPE - NEED AT LEAST ONE 00679000
- CLC =CL2'( ',0(R2) WERE ONLY OPTIONS SPECIFIED P3059 00680000
- BE NOFNAME YES, TYPE OUT AN ERROR MESSAGE P3059 00681000
- MVC FNAME,0(R2) SET FILENAME 00682000
- MVC INPFILE+8(8),0(R2) FILL IN DISK P-LISTS 00683000
- MVC UPDFILE+8(8),0(R2) ... 00684000
- MVC LOGFILE+8(8),0(R2) ... 00685000
- MVC AUXFILE+8(8),0(R2) ... 00686000
- MVC UPSFILE+8(8),0(R2) ... 00687000
- MVC NEWNAME+1(7),0(R2) DEFAULT NAME FOR UPDATED FILE 00688000
- MVI NEWNAME,C'$' ... IS '$FNAME1' 00689000
- MVC SEQLABL(3),0(R2) DEFAULT THREE-CHAR LABEL 00690000
- SPACE 2 00691000
- BAL R14,OPTSCAN SECOND PARM, IF ANY 00692000
- MVC INPFILE+16(8),0(R2) INPUT FILE FTYPE 00693000
- MVC NEWNAME+8(8),0(R2) ...ALSO OUTPUT FTYPE 00694000
- SPACE 00695000
- BAL R14,OPTSCAN THIRD PARM 00696000
- MVC INPFILE+24(2),0(R2) INPUT FMODE 00697000
- CLI 2(R2),C' ' IS FMOVE > 2 CHARS? 00698000
- BNE BADMODE GO IF IT IS 00699000
- SPACE 00700000
- BAL R14,OPTSCAN CHECK FOR FOURTH PARM... 00701000
- MVC UPDFILE+8(8),0(R2) UPDATE FNAME 00702000
- SPACE 00703000
- BAL R14,OPTSCAN CHECK FOR FIFTH... 00704000
- MVC UPDFILE+16(8),0(R2) UPDATE FTYPE 00705000
- MVC CTLFILE+16(8),0(R2) SET FILETYPE OF CTL FILE 00706000
- SPACE 00707000
- BAL R14,OPTSCAN SIXTH.... 00708000
- MVC UPDFILE+24(2),0(R2) UPDATE FMODE 00709000
- MVC CTLFILE+24(2),0(R2) SET FILEMODE OF CONTROL FILE 00710000
- CLI 2(R2),C' ' IS FMODE > 2 CHARS? 00711000
- BNE BADMODE GO IF IT IS 00712000
- SPACE 00713000
- BAL R14,OPTSCAN PICK UP OPTION LIST 00714000
- B EXCESIV HMMMM... TOO MANY FIELDS 00715000
- EJECT 00716000
- OPTSCAN EQU * SCAN COMMAND INPUT FOR OPTIONS, PARMS 00717000
- LA R2,8(0,R2) NEXT PARM SLOT 00718000
- CLI 0(R2),X'FF' AT END OF LIST YET ? 00719000
- BE OPTEND YES - JUMP INTO PROCESSING 00720000
- CLI 0(R2),C'(' START OF OPTION LIST ? 00721000
- BCR 7,R14 (BNE 0(R14)) NO - JUST RETURN 00722000
- OPTNEXT EQU * START DECODING OPTIONS 00723000
- LA R2,8(0,R2) NEXT OPTION SLOT 00724000
- CLI 0(R2),X'FF' AT END OF PLIST? 00725000
- BE OPTEND YES - START MOVING 00726000
- CLI 0(R2),C')' AT END OF LIST ? 00727000
- BE OPTEND YES 00728000
- SPACE 00729000
- LA R3,7(0,R2) END OF 8-BYTE FIELD 00730000
- OPTBLNK EQU * SCAN BACK TO NON-BLANK 00731000
- CLI 0(R3),X'40' 00732000
- BNE OPTLIST 00733000
- BCT R3,OPTBLNK 00734000
- OPTLIST EQU * SET-UP FOR TABLE LOOK-UP 00735000
- SR R3,R2 GPR 3 = PARM LENGTH - 1 00736000
- LA R7,OPTIONS TABLE START 00737000
- LA R4,16(0) TABLE ENTRY LENGTH 00738000
- LA R5,OPTLAST TABLE END 00739000
- OPTCHEK EQU * MATCH INPUT AGAINST TABLE 00740000
- CH R3,8(0,R7) ABOVE MIN. LEN FOR THIS OPTION ? 00741000
- BL OPTABLE NO - SKIP OVER IT 00742000
- EX R3,OPTCMP DOES IT MATCH ? 00743000
- BE OPTFND GO IF FOUND 00744000
- SPACE 00745000
- OPTABLE EQU * 00746000
- BXLE R7,R4,OPTCHEK 00747000
- B INVOPTN UNRECOGNIZABLE OPTION 00748000
- SPACE 2 00749000
- OPTCMP CLC 0(*-*,R7),0(R2) LENGTH FILLED IN BY EX 00750000
- SPACE 3 00751000
- * COME HERE IF THE OPTION HAS BEEN FOUND IN THE TABLE. 00752000
- OPTFND EQU * 00753000
- LH R3,10(,R7) GET ADDRESS OF CHECK ADDRESS 00754000
- L R4,CKADS(R3) GET VALUE IN CHECK ADDRESS 00755000
- LTR R4,R4 IS THERE ALREADY AN ADDR THERE? 00756000
- BNZ OPTERR THEN WE HAVE DUP OR CONF OPTIONS 00757000
- ST R7,CKADS(R3) STORE ADDRESS OF OPTION TABLE 00758000
- EX 0,12(,R7) EXECUTE OI, NI OR B 00759000
- B OPTNEXT GO FOR NEXT OPTION 00760000
- SPACE 00761000
- * COME HERE IF OPTION ERROR. 00762000
- OPTERR EQU * 00763000
- CLR R7,R4 SAME OPTION SPECIFIED TWICE? 00764000
- BE OPTDUP DUPLICATE OPTION IF SO 00765000
- B OPTCONF CONFLICTING IF NOT 00766000
- SPACE 5 00767000
- * COME HERE AT END OF OPTIONS 00768000
- OPTEND EQU * 00769000
- TM GLOBALS,NSTK 'STK' SPECIFIED? 00770000
- BO OPTEND1 GO IF NOT @V2D4821 00771000
- TM GLOBALS,CTLF 'CTL' SPECIFIED? 00772000
- BZ ERSC ERROR IF 'STK' AND NO 'CTL' 00773000
- OPTEND1 EQU * @V2D4821 00774000
- TM GLOBALS,CTLF 'CTL' IN EFFECT ? @V2D4821 00775000
- BZ OPTEND2 SKIP THIS TEST IF NOT @V2D4821 00776000
- L R4,CKCT POINT TO 'CTL' KEYWORD @V2D4821 00777000
- L R7,CKIN POINT TO 'INC/NOINC' KEYWORD @V2D4821 00778000
- LTR R7,R7 WAS EITHER SPECIFIED @V2D4821 00779000
- BZ OPTEND2 GO IF NEITHER WAS SPECIFIED @V2D4821 00780000
- CLI 0(R7),C'N' WAS IT 'NOINC' ? @V2D4821 00781000
- BE OPTCONF 'NOINC' AND 'CTL' ARE CONFLICTS @V2D4821 00782000
- SPACE 00783000
- SPACE 00784000
- OPTEND2 EQU * 00785000
- B PROCESS START PROCESSING 00786000
- EJECT 00787000
- OPTBASE EQU * OPTION PROCESSOR BASE ADDRESS 00788000
- SPACE 00789000
- OPTSEQ8 EQU * EIGHT-DIGIT SEQUENCING 00790000
- OI GLOBALS,SEQ8 00791000
- LA R10,7(0,0) SEQUENCE FIELD LENGTH = 8 00792000
- ZAP SEQMAX,=P'100000000' SET MAX SEQ NUMBER (8 DIGS)P3027 00793000
- B OPTNEXT 00794000
- SPACE 3 00795000
- OPTNSEQ EQU * FIVE-DIGIT SEQUENCING 00796000
- NI GLOBALS,X'FF'-SEQ8 00797000
- LA R10,4(0,0) FIVE DIGITS ONLY 00798000
- ZAP SEQMAX,=P'100000' MAX SEQ NUMBER FOR 5 DIGS P3027 00799000
- MVC SEQLABL(3),INPFILE+8 DEFAULT THREE-CHAR LABEL 00800000
- B OPTNEXT 00801000
- SPACE 3 00802000
- OPTCNTL EQU * UPDATE CONTROL FILE GIVEN 00803000
- OI GLOBALS,CTLF+INCL CONTROL FILE GIVEN 00804000
- L R3,CKCOR MUST CHECK TO SEE IF NOINCORE WAS SPEC@V2D4821 00805000
- LTR R3,R3 PREVIOUSLY. @V2D4821 00806000
- BZ OPTCNTLA IT WASN'T.. SET DEFAULT OF INCORE @V2D4821 00807000
- CLI 0(R3),C'N' MAYBE IT WAS @V2D4821 00808000
- BE NOINC YES, IT WAS @V2D4821 00809000
- OPTCNTLA OI UPDFLAG,INCOR SET DEFAULT INCORE PROCESSING @V2D4821 00810000
- NOINC MVC CTLFILE+8(8),UPDFILE+8 FNAME2 = CNTRL FNAME @V2D4821 00811000
- MVC UPDFILE+8(8),INPFILE+8 UPDATE FNAME = INPUT FNAME 00812000
- MVC UPDFILE+16(8),=CL8'UPDT....' FTYPE SKELETON 00813000
- B OPTNEXT 00814000
- EJECT 00815000
- * OPTION LIST 00816000
- OPTIONS DS 0D 00817000
- OPT SEQ8,4,CKSE,GO,OPTSEQ8 00818000
- OPT NOSEQ8,6,CKSE,GO,OPTNSEQ 00819000
- OPT INC,3,CKIN,ON,INCL 00820000
- OPT NOINC,5,CKIN,OFF,INCL 00821000
- OPT REP,3,CKRE,ON,REPL P3027 00822000
- OPT NOREP,5,CKRE,OFF,REPL P3027 00823000
- OPT STK,3,CKST,OFF,NSTK 00824000
- OPT NOSTK,5,CKST,ON,NSTK 00825000
- OPT TERM,4,CKTE,ON,TERM 00826000
- OPT NOTERM,6,CKTE,OFF,TERM 00827000
- OPT CTL,3,CKCT,GO,OPTCNTL 00828000
- OPT NOCTL,5,CKCT,OFF,CTLF 00829000
- OPT DISK,4,CKDP,ON,DISK 00830000
- OPT STOR,4,CKCOR,ON,INCOR @V2D4821 00831000
- SPACE 1 00832000
- OPT NOSTOR,6,CKCOR,OFF,INCOR @V2D4821 00833000
- SPACE 1 00834000
- OPTLAST OPT PRINT,5,CKDP,OFF,DISK 00835000
- EJECT 00836000
- * CHECK ADDRESSES FOR DUPLICATE OR CONFLICTING OPTIONS 00837000
- CKADS EQU * 00838000
- CKSE DC A(0) CHECK FOR SEQ8/NOSEQ8 00839000
- CKIN DC A(0) CHECK FOR INC/NOINC 00840000
- CKRE DC A(0) CHECK FOR REPLACE/NOREPLACE 00841000
- CKCT DC A(0) CHECK FOR CTL/NOCTL 00842000
- CKST DC A(0) CHECK FOR STK/NOSTK 00843000
- CKTE DC A(0) CHECK FOR TERM/NOTERM 00844000
- CKDP DC A(0) CHECK FOR DISK/PRINT 00845000
- CKCOR DC A(0) CHECK FOR INCORE/NOINCOR@V2D4821 00846000
- EJECT 00847000
- PROCESS EQU * 00848000
- STC R10,MVCPOSN+1 STORE INTO COUNT FIELDS @V2D4821 00849000
- STC R10,CLCILAST+1 OF SOME PREVIOUSLY 'EX' @V2D4821 00850000
- STC R10,MVCILAST+1 INSTRUCTIONS. @V2D4821 00851000
- STC R10,CLCOLAST+1 @V2D4821 00852000
- LA R1,INPFILE POINT TO FSCB FOR INPUT FILE 00853000
- BAL R14,LOCATE CALL 'STATE' TO SEE IF IT EXISTS 00854000
- B NOFILE FILE NOT FOUND -- ABORT 00855000
- SPACE 00856000
- * WE MUST NOW DETERMINE THE DISK UPON WHICH WE ARE GOING TO PLACE ALL 00857000
- * OUR OUTPUT FILES. THE RULES ARE AS FOLLOWS: 00858000
- SPACE 00859000
- * 1. TRY TO PUT IT ONTO THE DISK FROM WHICH WE ARE TAKING THE ORIGINAL 00860000
- * INPUT FILE. 00861000
- SPACE 00862000
- * 2. IF THAT DISK IS R/O, BUT IT IS AN EXTENSION OF A READ/WRITE DISK, 00863000
- * THEN IT GOES ONTO THAT READ/WRITE DISK. 00864000
- SPACE 00865000
- * 3. IF THOSE TWO STEPS FAIL, PUT IT ONTO THE A-DISK. 00866000
- SPACE 00867000
- USING ADTSECT,R1 00868000
- TM ADTFLG1,ADTFRW IS INPUT DISK READ/WRITE? 00869000
- L R1,INPFILE+PADT POINT TO ADT FOR INPUT DISK 00870000
- TM ADTFLG1,ADTFRW IS THAT DISK READ/WRITE? 00871000
- BO RWFND WE'VE FOUND WHAT WE WANT, IF SO 00872000
- LA R1,ADTMX-24 POINT TO PARENT DISK 00873000
- L R15,VCADTLKW CALL "ADKLKW" @VM03093 00874000
- BALR R14,R15 00875000
- BZ RWFND GO IF IT'S READ/WRITE 00876000
- LA R1,=C'A' POINT TO LETTER FOR 'A'-DISK 00877000
- SH R1,=H'24' 00878000
- L R15,VCADTLKP CALL "ADTLKP" TO @VM03093 00879000
- BALR R14,R15 FIND ACTIVE DISK TABLE @VM03093 00880000
- BNZ NOTACCER ERROR IF NOT ACCESSED P3059 00881000
- TM ADTFLG1,ADTFRO+ADTFRW IS DISK ACCESSED P3059 00882000
- BZ NOTACCER NO, TYPE OUT ERROR MESSAGE P3059 00883000
- TM ADTFLG1,ADTFRW IS 'A' DISK IN R/W STATUS P3059 00884000
- BZ ERRW NO, TYPE OUT ERROR MESSAGE P3059 00885000
- SPACE 00886000
- * R1 NOW POINTS TO THE ADT OF THE DISK ONTO WHICH WE ARE GOING TO 00887000
- * PUT OUR FILES. 00888000
- RWFND EQU * 00889000
- LA R2,C'1' USE MODE NUMBER OF '1' 00890000
- ICM R2,B'0010',ADTM GET MODE LETTER FROM ADT 00891000
- DROP R1 00892000
- STH R2,UT1FILE+24 USE FOR UTILITY FILE 00893000
- STH R2,RENAME+24 00894000
- STH R2,NEWNAME+16 USE FOR NEW NAME 00895000
- STH R2,LOGFILE+24 USE FOR LOG FILE 00896000
- STH R2,UPSFILE+24 USE FOR 'UPDATES' FILE 00897000
- EJECT 00898000
- * NEXT, WE DETERMINE WHETHER THE UTILITY FILE 'FNAME CMSUT1' ALREADY 00899000
- * EXISTS. IF IT DOES, THEN WE ABORT. 00900000
- LA R1,UT1FILE POINT TO FSCB FOR UTILITY FILE 00901000
- BAL R14,LOCATE CALL 'STATE' TO SEE IF IT EXISTS 00902000
- B *+8 SKIP NEXT IF FILE NOT FOUND 00903000
- B ERCMSUT ERROR - ALREADY EXISTS 00904000
- * IF WE ARE PUTTING THE LOG FILE ONTO DISK, WE ERASE THE OLD ONE 00905000
- TM GLOBALS,DISK LOG FILE TO DISK? 00906000
- BZ NOERASE DON'T ERASE IF NOT 00907000
- FSERASE FSCB=LOGFILE ERASE THE OLD LOG FILE, IF ONE 00908000
- SPACE 00909000
- NOERASE EQU * 00910000
- TM GLOBALS,CTLF CONTROL FILE OPTION ? 00911000
- BZ LOCTUPD NO - SINGLE UPDATE 00912000
- LA R1,CTLFILE FIND UPDATE CONTROL FILE 00913000
- BAL R14,LOCATE 00914000
- B NOFILE NOT FOUND 00915000
- B CTLMULT PERFORM MULTI-LEVEL UPDATE 00916000
- SPACE 00917000
- * 'CTL' WAS NOT REQUESTED -- DO A SINGLE UPDATE 00918000
- LOCTUPD EQU * CHECK SINGLE UPDATE FILE 00919000
- NI UPDFLAG,255-INCOR SINGLE UPDATES DON'T BENEFIT @V2D4821 00920000
- LA R1,UPDFILE 00921000
- BAL R14,LOCATE 00922000
- B NOFILE FILE NOT FOUND 00923000
- B SINGUPD UPDATE ONLY ONCE 00924000
- EJECT 00925000
- * 00926000
- * CTLMULT -- MULTI-LEVEL UPDATE CONTROLLED BY DATA FILE 00927000
- * 'FNAME2 CNTRL'. SEARCH THROUGH CONTROL FILE LOOKING 00928000
- * FOR UPDATES AGAINST THE INPUT FILE, APPLYING WHICHEVER 00929000
- * UPDATES OR PTF'S ARE FOUND. 00930000
- * 00931000
- CTLMULT EQU * MULTI-LEVEL UPDATE W/CNTRL FILE 00932000
- L R1,CTLFILE+PFST GET POINTER TO FST FOR CTL FILE 00933000
- LH R8,ITEM(0,R1) TOTAL ITEM COUNT IN FILE 00934000
- SR R2,R2 ITEM COUNT CURRENTLY ZERO 00935000
- SPACE 00936000
- * WE SEARCH THROUGH THE FILE, SKIPPING OVER THE COMMENT CARDS, 00937000
- * LOOKING FOR THE FIRST REAL CONTROL CARD, WHICH HAD BETTER BE A 00938000
- * 'MACS' CARD. 00939000
- * GET AN AREA TO SAVE THE AUXFILE FILETYPES THAT ARE 00944000
- * USED TO INSURE THAT NONE OF THEM WILL BE USED TWICE 00945000
- LR R0,R8 EASIER IF AMOUNT IS IN REG 0 @V60C5CC 00946000
- DMSFREE DWORDS=(0),ERR=CTLRCRD @V60C5CC 00947000
- ST R1,LISTADR ADDRESS OF FREE'D LIST @V60C5CC 00948000
- MVI 0(R1),LISTMARK NEXT AVAILABLE SLOT @V60C5CC 00949000
- CTLRCRD DS 0H ERROR WILL CAUSE NO-CHECKING @V60C5CC 00950000
- LA R2,1(,R2) INCREMENT ITEM COUNT @VA11994 00950100
- CLR R2,R8 ARE WE AT END OF FILE? @VA11994 00950200
- BH ERMACS ERROR -- NO 'MACS' CARD @VA11994 00950300
- FSREAD FSCB=CTLFILE,RECNO=(R2),ERROR=INPERR READ A RECORD 00951000
- CLI CTLBUFF,C'*' IS THIS CARD A COMMENT? 00952000
- BE CTLRCRD LOOP BACK IF IT IS @VA11994 00953000
- ST R2,MACSITEM SAVE ITEM NUMBER OF 'MACS' CARD 00954000
- LA R1,CTLBUFF INITIALIZE FOR SCAN ROUTINE 00955000
- ST R1,CTLBUFF+80 ... 00956000
- BAL R14,SCANCTL FIRST PARM MUST BE THE DEFAULT... 00957000
- BNZ BADCTLC ...LEVEL IDENTIFIER PARM 00958000
- CLI ACTVFLD+5,X'40' FIVE CHARS IS MAX... 00959000
- BNE BADCTLC OOPS...SORRY 00960000
- MVC UPLEVEL(5),ACTVFLD SET THE DEFAULT 00961000
- MVC DFLEVEL(5),ACTVFLD MAKE THIS ID @V2D4821 00962000
- BAL R14,SCANCTL SECOND FIELD... 00963000
- BNZ ERMACS THIS FIELD SHOUL READ 'MACS' P3059 00964000
- CLC ACTVFLD(8),=CL8'MACS ' IF NOT THIS... 00965000
- BNE ERMACS ...IT'S AN INVALID CARD @VA01031 00966000
- L R1,CTLBUFF+80 PICK UP RESIDUAL SCAN POINTER 00967000
- LA R3,CTLBUFF+SEQFELD-1 END OF VALID RECORD 00968000
- SLR R3,R1 COMPUTE LENGTH-1 OF REMAINING DATA 00969000
- LA R2,CTLMACS MOVE THE MACLIB LIST HERE 00970000
- EX R3,MVCR2R1 ... 00971000
- * GPR 8 STILL HOLDS TOTAL ITEM COUNT OF FILE 00972000
- LA R8,1(,R8) POINT ONE RECORD BEYOND 00973000
- STH R8,CTLFILE+ITEM FROM HERE ON, WE READ FROM BOTTOM... 00974000
- * ...TO THE TOP, APPLYING AS WE GO 00975000
- EJECT 00976000
- CTLREAD EQU * READ NEXT LEVEL CONTROL STATEMENT 00977000
- LH R2,CTLFILE+ITEM DECREMENT ITEM NUMBER FOR FILE 00978000
- BCTR R2,0 00979000
- STH R2,CTLFILE+ITEM 00980000
- FSREAD FSCB=CTLFILE,ERROR=INPERR READ CARD FROM CONTROL FILE 00981000
- C R2,MACSITEM HAVE WE JUST RED OUR 'MACS' CARD 00982000
- BNH CTLDONE WE'RE THRU IF WE HAVE 00983000
- CLI CTLBUFF,C'*' COMMENT CARD ? 00984000
- BE CTLREAD YES - READ AGAIN 00985000
- LA R1,CTLBUFF SETUP FOR SCAN ROUTINE 00986000
- ST R1,CTLBUFF+80 ... 00987000
- BAL R14,SCANCTL FIND FIRST FIELD ( LEVEL ID ) 00988000
- BNZ BADCTLC ...OOPS... 00989000
- CLI ACTVFLD+5,X'40' FIVE CHARS IS MAX 00990000
- BNE BADCTLC ... 00991000
- CLC ACTVFLD(4),=C'PTF ' IS THIS A PTF @V2D4821 00992000
- BE CTLIPTF YES SPECIAL PROC @V2D4821 00993000
- MVC DFLEVEL(5),ACTVFLD SAVE LEVEL ID HERE 00994000
- BAL R14,SCANCTL LOOK FOR UPDATE MODIFIER 00995000
- BO CTLREAD DUMMY RECORD FOR LOAD @VA01031 00996000
- BM BADCTLC INVALID CONTROL CARD @VA01031 00997000
- CLC ACTVFLD(8),=CL8'MACS ' 'MACS' RECORD? @VA01031 00998000
- BE ERMACS YES - FINISHED @VA01031 00999000
- MVC UPDFILE+16(8),=CL8'UPDT....' FILETYPE SKELETON 01000000
- CLC ACTVFLD(4),=CL4'UPDT' UPDT TYPE ?? @V200930 01001000
- BNE CTLAUX NO, TEST FOR AUX FILE @V200930 01002000
- CLI ACTVFLD+4,C' ' IS IT UPDT ONLY ?? @V200930 01003000
- BE CTLUP YES, CONT @V200930 01004000
- CTLUPD MVC UPDFILE+16(8),ACTVFLD SET FILETYPE @V200930 01005000
- MVC UPDFILE+24(2),=C'* ' SEARCH ALL DISKS @V200930 01006000
- B CTLOCUP GO FIND FILE @V200930 01007000
- CTLAUX CLC ACTVFLD(3),=CL3'AUX' AUX FILE TYPE ?? @V200930 01008000
- BNE CTLUP NO, CONT @V200930 01009000
- CLI ACTVFLD+3,C' ' IS IT AUX ONLY ?? @V200930 01010000
- BE CTLUP YES, CONT @V200930 01011000
- CLI ACTVFLD+8,C' ' NO RESTRICTION ON FTYPE LENGTH @VA04536 01012000
- BNE BADCTLC @VM03203 01013000
- MVC AUXFILE+16(8),ACTVFLD SET FILETYPE @V200930 01014000
- MVC AUXFILE+24(2),=C'* ' SEARCH ALL DISKS @V200930 01015000
- B AUXFIND GO FIND FILE @V200930 01016000
- CTLUP DS 0H @V200930 01017000
- MVC AUXSAVE,ACTVFLD SAVE THE MODIFIER @VA04536 01018000
- CLI ACTVFLD+5,C' ' FIVE CHARACTERS MAX. @VA04536 01019000
- BNE BADCTLC GREATER THAN 5 = ERROR @VA04536 01020000
- MVC UPDFILE+20(4),ACTVFLD FILL IN MODIFIER 01021000
- MVC UPDFILE+24(2),=C'* ' SEARCH ALL DISKS 01022000
- BAL R14,SCANCTL NOW LOOK FOR OPTIONAL THIRD PARM 01023000
- BO CTLOCUP MISSING - NORMAL UPDATE LEVEL @VA01031 01024000
- BM BADCTLC INVALID CONTROL CARD @VA01031 01025000
- CLC ACTVFLD(4),=C'AUX ' MAY BE THE 'AUX' OPTION 01026000
- BNE CTLOCUP NO - ASSUME IT'S A COMMENT 01027000
- B AUX OTHERWISE, IT'S AUX 01028000
- SPACE 3 01029000
- MACSITEM DS F ITEM NUMBER OF 'MACS' CARD 01030000
- AUXSAVE DC CL5' ' SAVE AREA FOR 5 BYTE MODIFIER@VA04536 01031000
- DS 0H REALIGN @VA04536 01032000
- EJECT 01033000
- * AUXILIARY FILE HAS BEEN SPECIFIED 01034000
- AUX EQU * 01035000
- MVC AUXFILE+19(5),AUXSAVE MOVE IN 5 CHAR. MODIFIER @VA04536 01036000
- MVC AUXSAVE,=C' ' BLANK OUT SAVE AREA FOR NEXT @VA04536 01037000
- MVC AUXFILE+24(2),=C'* ' SEARCH ALL DISKS 01038000
- AUXFIND DS 0H @V200930 01039000
- MVC FTSAVE,AUXFILE+16 SAVE IN CASE NOT AN AUXFILE @V60C5CC 01040000
- AUXFIND1 DS 0H @V60C5CC 01041000
- BAL R14,SCANCTL CHECK FOR ANOTHER PARM @V60C5CC 01042000
- BNZ AUXFIND2 NOT A POSSIBLE FILE-TYPE @V60C5CC 01043000
- CLI ACTVFLD+3,C' ' PARM AT LEASE 4 CHARACTERS? @V60C5CC 01044000
- BE AUXFIND2 NO, USE INDICATED AUXFILE @V60C5CC 01045000
- MVC AUXFILE+16(8),ACTVFLD STATE PREFERRED AUXFILE @V60C5CC 01046000
- LA R1,AUXFILE FST FOR STATE @V60C5CC 01047000
- BAL R14,LOCATE DOES PREFERRED FILE EXIST? @V60C5CC 01048000
- B AUXFIND1 NO, CHECK FOR MORE LEVELS @VA09764 01049000
- B CTLREAD YES, DON'T USE THIS AUXFILE @V60C5CC 01050000
- AUXFIND2 DS 0H @V60C5CC 01051000
- MVC AUXFILE+16(8),FTSAVE PREFERRED ONE. @V60C5CC 01052000
- LA R1,AUXFILE ... 01053000
- BAL R14,LOCATE IF IT'S THERE, WE WILL APPLY THE PTFS 01054000
- B CTLREAD IF IT ISN'T, WE JUST SKIP THE LEVEL 01055000
- * SCAN LIST OF AUXFILE FILETYPES TO 01056000
- * INSURE WE DON'T TRY TO RE-USE ONE 01057000
- L R1,LISTADR START OF LIST (OR 0) @V60C5CC 01058000
- LTR R1,R1 DID WE INITIATE A LIST? @V60C5CC 01059000
- BZ AUXFIND5 NO LIST. USE THE AUXFILE @V60C5CC 01060000
- AUXFIND3 DS 0H @V60C5CC 01061000
- CLI 0(R1),LISTMARK THIS SLOT UNUSED? @V60C5CC 01062000
- BNE AUXFIND4 SLOT IN USE, CHECK THE ENTRY @V60C5CC 01063000
- MVC 0(8,R1),FTSAVE SLOT FREE. INSERT FILETYPE @V60C5CC 01064000
- MVI 8(R1),LISTMARK MARK NEXT SLOT AS AVAILABLE @V60C5CC 01065000
- B AUXFIND5 UNIQUE AUXFILE. USE IT @V60C5CC 01066000
- AUXFIND4 DS 0H CHECK THIS ENTRY @V60C5CC 01067000
- CLC 0(8,R1),FTSAVE AUXFILE APPLIED BEFORE? @V60C5CC 01068000
- BE CTLREAD YES, GET NEXT CNTRL ENTRY @V60C5CC 01069000
- LA R1,8(R1) INCREMENT TO NEXT SLOT @V60C5CC 01070000
- B AUXFIND3 CHECK NEXT LIST ENTRY @V60C5CC 01071000
- AUXFIND5 DS 0H @V60C5CC 01072000
- OI UPDFLAG,AUXF FOUND AN AUXILIARY FILE 01073000
- L R1,AUXFILE+PFST FST POINTER FOR AUX FILE 01074000
- LH R8,ITEM(0,R1) TOTAL ITEM COUNT IN AUX FILE 01075000
- STH R8,AUXFILE+ITEM READ BOTTOM TO TOP 01076000
- MVI TEMPSWT,X'00' RESET THE SWITCH @VA13438 01076500
- EJECT 01077000
- AUXREAD EQU * READ FROM AUXILIARY FILE 01078000
- LH R4,AUXFILE+ITEM CHECK FOR TOP OF FILE 01079000
- LTR R4,R4 AT THE TOP NOW ? 01080000
- BNP AUXFINT YES - AUX LEVEL IS COMPLETE 01081000
- * THE READ MUST BE TO A BUFFER TO ENABLE SAVING THE COMMENTS 01082000
- FSREAD FSCB=AUXFILE,ERROR=INPERR,BUFFER=CTLBUFF @V60C5CC 01083000
- BCTR R4,0 DECREMENT FOR UPWARD READ 01084000
- STH R4,AUXFILE+ITEM RESET FOR NEXT READ 01085000
- CLI CTLBUFF,C'*' COMMENT RECORD ? 01086000
- BE AUXREAD YES - CONTINUE READING 01087000
- LA R1,CTLBUFF SETUP FOR SCAN ROUTINE 01088000
- ST R1,CTLBUFF+80 ... 01089000
- BAL R14,SCANCTL FIND FIRST PARM 01090000
- BNZ BADAUXC BAD CONTROL CARD 01091000
- CLC ACTVFLD(4),=C'PTF ' IS IT THE OPTIONAL KEYWORD ? 01092000
- BNE AUXTYPE NO - MUST BE 'A....6CA' FORMAT 01093000
- BAL R14,SCANCTL SECOND PARM IS FILETYPE 01094000
- BNZ BADAUXC ...OOPS... 01095000
- AUXTYPE EQU * LOOK FOR SPECIFIED PTF 01096000
- MVC UPDFILE+16(8),ACTVFLD FULL FILETYPE 01097000
- MVC UPDFILE+24(2),=CL2'*' SEARCH ALL DISKS FOR PTM FILE 01098000
- LA R1,UPDFILE GO CHECK FILE STATUS 01099000
- BAL R14,LOCATE ... 01100000
- B NOFILEW WARNING MSG IF MISSING 01101000
- MVC UPLEVEL(5),DFLEVEL FOUND AT LEAST ONE UPDATE HERE 01102000
- B CTLUMSG GO GIVE INFO MSG + APPLY UPDATE 01103000
- AUXFINT EQU * FINISHED WITH 'AUX' LEVEL 01104000
- FSCLOSE FSCB=AUXFILE CLOSE THE AUX FILE 01105000
- NI UPDFLAG,X'FF'-AUXF RESET FLAG BIT 01106000
- B CTLREAD AND CONTINUE WITH CONTROL FILE 01107000
- EJECT 01108000
- CTLOCUP EQU * STATE FOR SINGLE UPDATE FILE 01109000
- CLI AUXSAVE+4,C' ' ONLY 4 BYTES FOR 'UPDT' TYPE @VA04536 01110000
- BNE BADCTLC IF 5 = ERROR @VA04536 01111000
- LA R1,UPDFILE SEE IF UPDATE FILE EXISTS 01112000
- BAL R14,LOCATE ... 01113000
- B CTLREAD NO - SKIP TO NEXT LEVEL 01114000
- * FOUND AN UPDATE - NOW LET'S APPLY IT 01115000
- MVC UPLEVEL(5),DFLEVEL SET LEVEL IDENTIFIER 01116000
- B CTLUMSG GO GIVE INFO MSG + APPLY 01117000
- CTLIPTF EQU * SINGLE PTF SPECIFIED IN CNTRL FILE 01118000
- BAL R14,SCANCTL POINT TO PTF NAME @V2D4821 01119000
- BNE CTLREAD SOMETHING FISHY @V2D4821 01120000
- MVC UPDFILE+16(8),ACTVFLD FULL FILETYPE 01121000
- MVC UPDFILE+24(2),=C'* ' SEARCH ALL DISKS 01122000
- LA R1,UPDFILE 01123000
- BAL R14,LOCATE 01124000
- B CTLREAD SKIP TO NEXT LEVEL IF NOT FOUND 01125000
- B CTLUMSG SET MESSAGE @V200930 01126000
- MVC UPLEVEL(5),DFLEVEL MAKE THIS LEV @V2D4821 01127000
- EJECT 01128000
- * WE TYPE OUT THE 'UPDATING' MESSAGE, AND ADD RECORDS TO 'UPDATES' 01129000
- * FILE. 01130000
- CTLUMSG EQU * 01131000
- TM GLOBALS,UPDN HAS AN UPDATE BEEN DONE? 01132000
- BO CTLUMSS IF SO, THEN TYPE SHORT MESSAGE 01133000
- TM UPDFLAG,INCOR IN-CORE PROCESSING WANTED?? @V2D4821 01134000
- BNO SLOPPY NOPE... INCUR SOME OVERHEAD. @VM03203 01135000
- USING NUCON,R0 @VM03203 01136000
- IC R5,DOSFLAGS GET NUCON'S DOSFLAGS @VM03203 01137000
- NI DOSFLAGS,255-DOSSVC TURN OFF DOS SVC HANDLE @VM03203 01138000
- STC R5,DOSF TEMPORARILY STORE DOSFLAGS @VM03203 01139000
- BAL R8,CORINIT GO INITIALIZE STORAGE @VM03203 01140000
- FSSTATE FSCB=INPFILE @VM03203 01141000
- LH R8,26(,R1) NUMBER OF ITEMS IN FILE @V2D4821 01142000
- LA R8,50(,R8) PLUS SOME SLACK @V2D4821 01143000
- C R8,SPARES WILL THE FILE FIT?? @V2D4821 01144000
- BH SMALLCOR NOPE @V2D4821 01145000
- XC INPFILE+ITEM(2),INPFILE+ITEM ZERO ITEM NUMBER @V2D4821 01146000
- LA R0,800 GET STORAGE FOR RDBUF OF 10 RECS. @V2D4821 01147000
- GETMAIN R,LV=(0) @V2D4821 01148000
- ST R1,INPFILE+28 BUFAD @V2D4821 01149000
- ST R0,INPFILE+32 BUFSIZE @V2D4821 01150000
- LA R0,10 NUMBER OF RECS. WE'LL READ @V2D4821 01151000
- STH R0,INPFILE+38 STORE INTO PLIST @V2D4821 01152000
- LR R3,R1 SAVE BUFAD @V2D4821 01153000
- * 01154000
- INPLOOP FSREAD FSCB=INPFILE,ERROR=INPLERR @V2D4821 01155000
- LR R2,R3 BUFFER STARTING ADDR. @V2D4821 01156000
- LR R5,R0 NUM. OF BYTES ACTUALLY READ @V2D4821 01157000
- LA R4,80 ITEM LENGTH @V2D4821 01158000
- AR R5,R2 END ADDR. FOR BXLE @V2D4821 01159000
- SR R5,R4 @V2D4821 01160000
- * 01161000
- INPL002 LR R1,R2 FOR XWRITE (ADDR. OF LINE) @V2D4821 01162000
- BAL R14,XWRITE WRITE LINE INTO CORE @V2D4821 01163000
- BXLE R2,R4,INPL002 @V2D4821 01164000
- B INPLOOP READ SOME MORE STUFF @V2D4821 01165000
- * 01166000
- INPLERR CH R15,=H'12' TRUE E-O-F FROM RDBUF?? @V2D4821 01167000
- BNE INPERR NO... @V2D4821 01168000
- LR R1,R3 BUFFER ADDRESS @V2D4821 01169000
- LA R0,800 BUFFER SIZE @V2D4821 01170000
- FREEMAIN R,LV=(0),A=(1) @V2D4821 01171000
- FSCLOSE FSCB=INPFILE @V2D4821 01172000
- * 01173000
- SLOPPY EQU * @V2D4821 01174000
- LA R1,=CL8'CONWAIT' GIVE MESSAGES A CHANCE @VM03093 01175000
- SVC 202 TO CATCH UP ... @VM03093 01176000
- DMSERR NUM=178,LET=I,RENT=NO, *01177000
- SUB=(CHAR8A,INPFILE+8), *01178490
- TEXT='UPDATING ''....................''' HRC012DS 01178980
- DMSERR NUM=178,LET=I,RENT=NO, *01179470
- SUB=(CHAR8A,UPDFILE+8), *01179960
- TEXT='APPLYING ''....................''' HRC012DS 01180450
- FSERASE FSCB=UPSFILE ERASE ANY EXISTING UPDATES FILE 01181000
- B CTLUF GO FINISH UP 01182000
- SPACE 2 01183000
- * WE HAVE ALREADY DONE A WHOLE UPDATE, SO WE TYPE ONLY THE SHORT 01184000
- * MESSAGE. 01185000
- CTLUMSS EQU * 01186000
- LA R1,=CL8'CONWAIT' GIVE MESSAGES A CHANCE @VM03093 01187000
- SVC 202 TO CATCH UP ... @VM03093 01188000
- DMSERR NUM=178,LET=I,SUB=(CHAR8A,UPDFILE+8), *01189000
- TEXT='APPLYING ''....................''' HRC012DS 01190490
- SPACE 01191000
- * NEXT, WE MUST ADD RECORDS TO THE 'UPDATES' FILE. THE FIRST RECORD IS 01192000
- * THE CARD FROM THE CONTROL FILE, WHILE THE SECOND IS THE DATA ABOUT 01193000
- * THE FILE FROM THE FST. 01194000
- CTLUF EQU * 01195000
- CLI TEMPSWT,X'00' WE WRITE FIRST ONE YET? @V60C5CC 01196000
- BNE TEMP1OK YEP... @V60C5CC 01197000
- MVC TEMPSAVE(2),AUXFILE+ITEM SAVE ITEM NUMBER @V60C5CC 01198000
- MVC AUXFILE+ITEM(2),=H'1' @V60C5CC 01199000
- READNXT EQU * READ THE NEXT ITEM @VA13438 01199500
- FSREAD FSCB=AUXFILE,BUFFER=TEMPBUF,ERROR=TEMP1OK @V60C5CC 01200000
- CLI TEMPBUF,C'*' DONT WRITE IT UNLESS ITS A COMMENT @V60C5CC 01201000
- BNE NOTCOMM NOT A COMMENT.... I DONT KNOW WHY. @V60C5CC 01202000
- FSWRITE FSCB=UPSFILE,BUFFER=TEMPBUF,ERROR=OUTERR @V60C5CC 01203000
- LH R1,AUXFILE+ITEM INCREMENT @VA13438 01203500
- LA R1,1(,R1) ITEM @VA13438 01203550
- STH R1,AUXFILE+ITEM COUNT @VA13438 01203600
- B READNXT READ NEXT ITEM @VA13438 01203650
- NOTCOMM MVC AUXFILE+ITEM(2),TEMPSAVE RESTORE ITEM COUNT @V60C5CC 01204000
- MVI TEMPSWT,X'FF' SIGNAL ITS DONE. @V60C5CC 01205000
- TEMP1OK DS 0H @V60C5CC 01206000
- FSWRITE FSCB=UPSFILE,ERROR=OUTERR,BUFFER=CTLBUFF WRITE CTL CRD 01207000
- L R1,UPDFILE+PFST POINT TO FST FOR FILE 01208000
- L R2,UPDFILE+PADT POINT TO ADT FOR FILE 01209000
- SPACE 01210000
- * THE FOLLOWING CODE IS STOLEN. 01211000
- MVC NAME(8),0(1) FILE NAME 01212000
- MVC TYPE(8),8(1) FILETYPE 01213000
- MVC MODE(2),24(1) FILEMODE 01214000
- UNPK DATE+1(5),16(3,1) MMDD 01215000
- MVC DATE(2),DATE+1 01216000
- MVI DATE+2,C'/' 01217000
- MVI DATE+5,C'/' 01218000
- UNPK TIME+1(5),18(3,1) HHMM 01219000
- MVC TIME(2),TIME+1 01220000
- MVI TIME+2,C':' GO, PRINTER GO @V2D4821 01221000
- MVI TIME+5,C' ' 01222000
- MVC YEAR(2),38(1) YEAR 01223000
- MVC LABEL(6),0(2) DISK LABEL 01224000
- MVC MODE(1),68(2) CORRECT DISK MODE LETTER 01225000
- LH R4,AUXFILE+ITEM GET MODIFIED ITEM COUNT. @V60C5CC 01226000
- STH R4,TEMPSAVE SAVE IT FOR RESTORE. @V60C5CC 01227000
- LA R4,2(R4) POINT TO 1ST POSS. COMMENT. @V60C5CC 01228000
- STH R4,AUXFILE+ITEM POINT AT IT... @V60C5CC 01229000
- TEMPRD FSREAD FSCB=AUXFILE,ERROR=TEMPERR,BUFFER=TEMPBUF @V60C5CC 01230000
- LA R4,1(R4) POINT TO NEXT RECORD. @V60C5CC 01231000
- STH R4,AUXFILE+ITEM POINT AT IT. @V60C5CC 01232000
- CLI TEMPBUF,C'*' COMMENT? @V60C5CC 01233000
- BNE TEMPERR CLEAN UP AND LEAVE @V60C5CC 01234000
- FSWRITE FSCB=UPSFILE,ERROR=OUTERR,BUFFER=TEMPBUF @V60C5CC 01235000
- B TEMPRD GET NEXT ONE. @V60C5CC 01236000
- TEMPERR LH R4,TEMPSAVE GET OLD POINTER. @V60C5CC 01237000
- STH R4,AUXFILE+ITEM RESTORE IT AND BYE... @V60C5CC 01238000
- NOTTEMP DS 0H @V60C5CC 01239000
- FSWRITE FSCB=UPSFILE,ERROR=OUTERR,BUFFER=OUT WRITE OUT LINE 01240000
- FSCLOSE FSCB=AUXFILE CLOSE THE AUX FILE. @VA14010 01240500
- B SINGUPD GO PERFORM AN UPDATE 01241000
- TEMPSAVE DC H'0' TEMPORARY ITEM-COUNT SAVE @V60C5CC 01242000
- TEMPBUF DC CL80' ' MY VERY OWN BUFFER. @V60C5CC 01243000
- TEMPSWT DC X'00' SWITCH FOR FIRST RECORD. @V60C5CC 01244000
- DS 0H ALIGNMENT... @V60C5CC 01245000
- SPACE 01246000
- OUT DC C'*' 01247000
- DC CL9' ' TO ALIGN FIELDS ON LOAD MAP 01248000
- NAME DC CL9' ' 01249000
- TYPE DC CL9' ' 01250000
- MODE DC CL3' ' 01251000
- LABEL DC CL7' ' 01252000
- DATE DC CL6' ' 01253000
- YEAR DC CL4' ' 01254000
- TIME DC CL6' ' 01255000
- DC CL27' ' 01256000
- DS 0H 01257000
- EJECT 01258000
- CTLCONT EQU * MULTI-LEVEL UPDATE CONTINUATION 01259000
- NI UPDFLAG,AUXF+INCOR PRESERVE ONLY TWO BITS. @V2D4821 01260000
- MVI UPDFLAG2,0 RESET FINISH INDICATOR @V2D4821 01261000
- TM UPDFLAG,AUXF WORKING WITH AUX @V2D4821 01262000
- BO AUXREAD YES @V2D4821 01263000
- B CTLREAD CONTINUE WITH CONTROL FILE 01264000
- EJECT 01265000
- CTLDONE EQU * MULTI-LEVEL UPDATE IS COMPLETE 01266000
- * FRET THE AUXFILE-USED LIST IF IT IS PRESENT 01267000
- L R1,LISTADR WAS AUXFILE LIST FREE'D @V60C5CC 01268000
- LTR R1,R1 WAS LIST OBTAINED? @V60C5CC 01269000
- BZ CTLDONE1 NO LIST, CONTINUE @V60C5CC 01270000
- L R1,CTLFILE+PFST FST FOR CNTRL FILE @V60C5CC 01271000
- LH R0,ITEM(0,R1) CNTRL LENGTH (LIST DWORDS) @V60C5CC 01272000
- L R1,LISTADR @V60C5CC 01273000
- DMSFRET DWORDS=(0),LOC=(1) @V60C5CC 01274000
- CTLDONE1 DS 0H @V60C5CC 01275000
- FSCLOSE FSCB=CTLFILE CLOSE THE CONTROL FILE 01276000
- TM GLOBALS,NSTK SHOULD WE STACK THE RESULTS ? 01277000
- BO RETURN NO -- RETURN 01278000
- CMS STACKER SETUP FOR MACLIB LIST ALREADY 01279000
- LA R1,UPLEVEL-2 NOW STACK THE UPDATE LEVEL ID 01280000
- ST R1,STACKER+12 ... 01281000
- MVI STACKER+12,7 LENGTH = 7 01282000
- CMS STACKER ... 01283000
- B RETURN RETURN 01284000
- EJECT 01285000
- UPDFERR EQU * EOF OR ERROR ON UPDATE FILE 01286000
- LA R1,UPDFILE PTR IN CASE OF REAL ERROR 01287000
- CH R15,=H'12' IS IT SIMPLE END OF FILE ? 01288000
- BNE INPERR NO - A REAL ERROR 01289000
- FSCLOSE FSCB=UPDFILE CLOSE THE UPDATE FILE 01290000
- OI UPDFLAG,TAIL PROCESSING NORMAL END OF FILE 01291000
- MVC SEQSTRT(8),FENCED THIS IS MAXIMUM NUMBER 01292000
- TM UPDFLAG,INCOR IN-CORE UPDATE ??? @V2D4821 01293000
- BNO INPUTRD NOPE.. GOT TO FLUSH INPUT FILE TO OUTP@V2D4821 01294000
- TM UPDFLAG,RSEQ ARE WE RE-SEQUENCING ??? @V2D4821 01295000
- BO INPUTRD YES.. WE'LL HAVE TO REPLACE SOME LINES @V2D4821 01296000
- OI UPDFLAG2,FINISH 1 PASS FLAG @V2D4821 01297000
- B INPUTRD TO CHK FOR SEQ ERRS @V2D4821 01298000
- UPDFERR3 LA R15,12 SIM EOF @V2D4821 01299000
- * ON INPUTRD 01300000
- EJECT 01301000
- INPFERR EQU * EOF OR I/O ERROR - INPFILE 01302000
- LA R1,INPFILE PTR IN CASE OF REAL ERROR 01303000
- CH R15,=H'12' SIMPLE END OF FILE ? 01304000
- BNE INPERR NO - A REAL ERROR 01305000
- FSCLOSE FSCB=UT1FILE CLOSE THE UTILITY FILE 01306000
- FSCLOSE FSCB=INPFILE CLOSE THE INPUT FILE 01307000
- TM UPDFLAG,TAIL WAS THIS EOF EXPECTED ? 01308000
- BO UPDEND JUST FINISH UP IF SO 01309000
- SPACE 01310000
- * IF WE REACH A PREMATURE EOF ON A FILE, WE TYPE A WARNING MESSAGE 01311000
- * AND GO ON. 01312000
- BAL R14,CTLTYPE TYPE OUT THE LAST UPDATE CTL CRD 01313000
- LA R14,SEQSTRT POINT TO STARTING SEQ NUMBER 01314000
- TM UPDFLAG,DELT BUT WAS IT A DELETE RANGE? 01315000
- BZ *+8 SKIP IF IT WAS A COPY 01316000
- LA R14,SEQLAST POINT TO LAST SEQ NUM, INSTEAD 01317000
- SPACE 01318000
- LA R10,1(,R10) INCREMENT R10 TEMPORARILY 01319000
- * NOTE THAT R10 CONTAINS THE LENGTH (5 OR 8) OF THE SEQ FIELD. 01320000
- DMSERR DISP=NONE,LET=W,NUM=10,BUFFA=ERRBUFF,RENT=NO, *01321000
- SUB=(CHAR8A,INPFILE+8,CHARA,((R14),(R10))), *01322000
- TEXT='PREMATURE EOF ON FILE ''....................'' -- *01323000
- SEQ NUMBER ''........'' NOT FOUND' 01324000
- BCTR R10,0 RESET REGISTER 10 01325000
- BAL R14,BUFFOUT TYPE AND PRINT MESSAGE 01326000
- WARN 12 SET RETURN CODE TO 12 01327000
- EJECT 01328000
- * WE HAVE FINISHED AN UPDATE. WE CLEAN UP AND GO ON TO NEXT. 01329000
- UPDEND EQU * 01330000
- LA R15,NEWNAME POINT TO NEW NAME 01331000
- TM UPDFLAG,INCOR INCORE UPDATE ??? @V2D4821 01332000
- BO UPDENDA YES @V2D4821 01333000
- FSERASE (R15) ERASE OLD COPY OF IT 01334000
- CMS RENAME RENAME CMSUT FILE TO NEW NAME 01335000
- MVC INPFILE+8(18),NEWNAME INPUT FILE IS NEW SOURCE FILE 01336000
- UPDENDA EQU * @V2D4821 01337000
- BAL R14,XCLOSE REWIND IN-CORE FILE @V2D4821 01338000
- OI GLOBALS,UPDN INDICATE THAT AN UPDATE IS DONE 01339000
- SPACE 01340000
- TM GLOBALS,CTLF IS 'CTL' OPTION IN EFFECT? 01341000
- BO CTLCONT GO FOR NEXT CONTROL CARD 01342000
- EJECT 01343000
- * WE ARE FINISHED ALL UPDATING. 01344000
- RETURN EQU * 01345000
- TM GLOBALS,UPDN WAS ANY UPDATE FILE FOUND? 01346000
- BZ NOUPDATS ERROR IF NOT 01347000
- TM UPDFLAG,INCOR IN-CORE UPDATE ??? @V2D4821 01348000
- BNO RETR002 NOPE.. @V2D4821 01349000
- MVC RDMVC(6),=XL6'470000000700' NO-OP MVC INTO INPL@V2D4821 01350000
- * 01351000
- RETR001 BAL R14,XREAD GET A LINE FRON CORE @V2D4821 01352000
- B RETRD RETURN HERE ON E-O-F @V2D4821 01353000
- LA R6,8(,R1) @V2D4821 01354000
- ST R6,UT1FILE+28 STORE LINE ADDRESS INTO RDBUF PLI@V2D4821 01355000
- FSWRITE FSCB=UT1FILE,ERROR=OUTERR @V2D4821 01356000
- B RETR001 RETURN FOR NEXT @V2D4821 01357000
- * 01358000
- RETRD FSCLOSE FSCB=UT1FILE @V2D4821 01359000
- LA R15,NEWNAME ERASE $FNAME @V2D4821 01360000
- FSERASE (R15) @V2D4821 01361000
- CMS RENAME REN CMSUT1 TO $FNAME @V2D4821 01362000
- RETR002 EQU * @V2D4821 01363000
- CLC RETCODE,=F'0' ANY WARNING MESSAGES ISSUED? 01364000
- BNE WRETURN GO IF YES 01365000
- TM GLOBALS,REPL WAS 'REPLACE' SPECIFIED? 01366000
- BZ RRETURN NOTHING TO DO IT NOT 01367000
- SPACE 01368000
- * OTHERWISE, WE MUST ERASE THE OLD FILE, AND RENAME THE $FNAME FILE TO 01369000
- * THE ORIGINAL FNAME. 01370000
- MVC RENAME+8(18),NEWNAME SET UP RENAME PLIST 01371000
- MVC NEWNAME(8),FNAME 01372000
- LA R15,NEWNAME POINT TO NEWNAME 01373000
- FSERASE (R15) ERASE OLD COPY OF IT 01374000
- CMS RENAME RENAME NEW SOURCE 01375000
- SPACE 01376000
- * RESTORE REG AND RETURN 01377000
- RRETURN EQU * 01378000
- BAL R14,LOGCLOSE CLOSE THE LOG FILE 01379000
- FSCLOSE FSCB=UPSFILE CLOSE THE UPDATES FILE @VA04077 01380000
- L R1,FREEAD GET ADDRESS OF FREE STORAGE BLOCK@VM03203 01381000
- LTR R1,R1 DID WE GETMAIN ??? @VM03203 01382000
- BZ NOFRMN @VM03203 01383000
- IC R5,DOSF GET SAVED DOSFLAGS @VM03203 01384000
- STC R5,DOSFLAGS STORE BACK IN NUCON @VM03203 01385000
- L R0,FREELEN LENGTH OF BLOCK @VM03203 01386000
- FREEMAIN R,LV=(0),A=(1) @VM03203 01387000
- NOFRMN EQU * @VM03203 01388000
- OI MISFLAGS,RELPAGES TELL DMSINT WE CAN GO AWAY, @VM03093 01389000
- DMSKEY RESET UN-DO OUR KEY MANIPULATING, @VM03093 01390000
- L R14,SAVE14 GET RETURN ADDRESS, @VM03093 01391000
- L R15,RETCODE GET RETURN CODE 01392000
- BR R14 AND RETURN TO CALLER 01393000
- SPACE 3 01394000
- SAVE14 DS A SAVE RETURN ADDRESS HERE 01395000
- RETCODE DC F'0' RETURN CODE FROM UPDATE COMMAND 01396000
- RC EQU RETCODE+3 FOR 'MVI' INSTRUCTION 01397000
- EJECT 01398000
- * IN CASE WARNING MESSAGES WERE ISSUED, THEN WE DON'T DO A REPLACE. 01399000
- * FURTHERMORE, IF THE GUY SPECIFIED 'NOTERM', SO HE DIDN'T GET THE 01400000
- * MESSAGES, THEN WE TELL HIM WHAT HAPPENED, WHETHER HE WANTS IT OR NOT. 01401000
- WRETURN EQU * 01402000
- TM GLOBALS,TERM DID HE SPECIFY 'NOTERM' 01403000
- BZ WRETURN1 IF SO, DEFINITELY GIVE HIM A MSG 01404000
- TM GLOBALS,REPL DID HE SPECIFY 'REPLACE'? 01405000
- BZ RRETURN NO MESSAGE NECESSARY IF NOT 01406000
- SPACE 01407000
- WRETURN1 EQU * 01408000
- SR R2,R2 ASSUME SHORT MESSAGE 01409000
- TM GLOBALS,REPL DID HE ASK FOR 'REPLACE'? 01410000
- BZ *+8 SKIP IF NOT 01411000
- LA R2,L'WMSG THEN GIVE HIM THE LONG MSG 01412000
- SPACE 01413000
- DMSERR NUM=177,LET=I,RENT=NO, *01414000
- SUB=(DECA,RETCODE,CHARA,(WMSG,(R2))), *01415000
- TEXT='WARNING MESSAGES ISSUED (SEVERITY = ......).......*01416000
- ...............' P3027 01417000
- B RRETURN 01418000
- SPACE 2 01419000
- WMSG DC C'. ''REP'' OPTION IGNORED' P3027 01420000
- DS 0H 01421000
- EJECT 01422000
- * COME HERE ON ERROR TO ABORT UPDATE PROGRAM. 01423000
- ERETURN EQU * 01424000
- BAL R14,LOGCLOSE CLOSE THE LOG FILE 01425000
- FSCLOSE FSCB=INPFILE CLOSE THE INPUT FILE 01426000
- FSCLOSE FSCB=UPDFILE CLOSE THE UPDATE FILE 01427000
- FSCLOSE FSCB=UT1FILE CLOSE THE CMSUT FILE 01428000
- TM GLOBALS,CTLF 'CTL' OPTION SPECIFIED? 01429000
- BZ RRETURN GO RETURN IF NOT 01430000
- FSCLOSE FSCB=CTLFILE CLOSE THE CONTROL FILE 01431000
- FSCLOSE FSCB=UPSFILE CLOSE THE UPDATES FILE 01432000
- TM UPDFLAG,AUXF 'AUX' FILE IN PROGRESS? 01433000
- BZ RRETURN RETURN IF NOT 01434000
- FSCLOSE FSCB=AUXFILE CLOSE THE AUXILIARY FILE 01435000
- B RRETURN GO RETURN TO COMMAND LEVEL 01436000
- EJECT 01437000
- SINGUPD EQU * INTERNAL SINGLE-UPDATE ROUTINE 01438000
- MVC SEQFOLD(5),PAKZERO START RE-SEQUENCE AT ZERO 01439000
- MVC SEQPOSN(8),CZEROES FILE POSITIONED AT ZERO 01440000
- MVC SEQSTRT(8),CZEROES ... 01441000
- MVC ISEQLAST(8),CZEROES ... 01442000
- MVC OSEQLAST(8),CZEROES ... 01443000
- MVI PASSFLG,0 01444000
- MVC UPDFILE+ITEM(2),=H'0' START WITH ZERO ITEM NUMBER 01445000
- MVC INPFILE+ITEM(2),=H'0' DITTO FOR INPUT FILE P3027 01446000
- MVC CURRLINE,=A(MAXLINE) FORCE PAGE EJECT 01447000
- BAL R14,XCLOSE REWIND POSSIBLE IN-CORE CMSUT1 FILE@V2D4821 01448000
- SPACE 01449000
- UPDREAD EQU * START READING UPDATE CONTROL CARDS 01450000
- UPITEM UPDFILE INCREMENT ITEM NUMBER 01451000
- FSREAD FSCB=UPDFILE,ERROR=UPDFERR READ A CARD 01452000
- UPDCTLC EQU * UPDATE CONTROL CARD IS IN BUFFER 01453000
- NI UPDFLAG,X'FF'-(SGEN+DELT) P3027 01454000
- LA R1,UPDLINE+2 BUFFER START 01455000
- ST R1,UPDLINE+80 SET FOR SCAN ROUTINE 01456000
- SPACE 01457000
- * PUT THE CONTROL CARD INTO THE LOG FILE. 01458000
- LOG UPDLINE,CTL 01459000
- SPACE 01460000
- * SAVE THE CONTROL CARD IN THE 'LAST CONTROL CARD' FIELD, FOR USE IN 01461000
- * ERROR MESSAGES. 01462000
- MVC PREVCTLL(82),LASTCTLL CURRENT LAST BECOMES PREV P3027 01463000
- MVC LASTCTLL,UPDLINE COPY CONTROL CARD 01464000
- MVC LASTCTLI,UPDFILE+ITEM SAVE THE ITEM NUMBER ALSO 01465000
- SPACE 01466000
- CLC UPDLINE(3),=CL3'./ ' UPDATE CONTROL CARD ? 01467000
- BNE INVUPCD NO - MUST BE INVALID 01468000
- MVC UPDLINE+50(22),BLANKS LAST 22 COLUMNS ARE INVALIDP3027 01469000
- BAL R14,SCANUPD SCAN FIRST FIELD ( FUNCTION ) 01470000
- BNZ INVUPCD NO MORE FIELDS - INVALID CARD 01471000
- MVC UPDCODE(1),ACTVFLD MOVE FUNCTION CHARACTER 01472000
- CLI ACTVFLD+1,X'40' MORE THAN ONE CHAR.... 01473000
- BNE INVUPCD ...MAKES IT AN INVALID CARD 01474000
- * 01475000
- * DECODE REQUESTED UPDATE FUNCTION 01476000
- * 01477000
- CLI UPDCODE,C'S' RE-SEQUENCE OUTPUT FILE ? 01478000
- BE FCTRSEQ YES 01479000
- * 01480000
- CLI UPDCODE,C'R' REPLACE SOURCE RECORDS ? 01481000
- BE FCTDELT YES - DELETE + INSERT 01482000
- * 01483000
- CLI UPDCODE,C'I' INSERT NEW RECORDS ? 01484000
- BE FCTINST YES 01485000
- * 01486000
- CLI UPDCODE,C'D' DELETE RECORDS FROM SOURCE ? 01487000
- BE FCTDELT YES 01488000
- * 01489000
- CLI UPDCODE,C'*' IS IT A COMMENT CARD? 01490000
- BE UPDREAD JUST SKIP IT IF SO 01491000
- * OOPS... IT'S AN INVALID CARD 01492000
- EJECT 01493000
- * INVALID CONTROL CARD 01494000
- INVUPCD EQU * 01495000
- BAL R14,CTLTYPE TYPE OUT THE INVALID CARD 01496000
- DMSERR DISP=NONE,BUFFA=ERRBUFF,NUM=207,LET=W, P3059*01497000
- TEXT='INVALID UPDATE FILE CONTROL CARD' 01498000
- SPACE 01499000
- * ENTER HERE FOR OTHER WARNING MESSAGES 01500000
- INVUPCD1 EQU * 01501000
- BAL R14,BUFFOUT TYPE AND PRINT ERROR MESSAGE 01502000
- WARN 12 SET RETURN CODE TO 12 01503000
- UPITEM UPDFILE INCREMENT ITEM NUMBER 01504000
- FSREAD FSCB=UPDFILE,ERROR=UPDFERR READ NEXT RECORD FROM FILE 01505000
- CLC =CL2'./',UPDLINE IS THIS A CONTROL CARD? 01506000
- BE UPDCTLC GO PROCESS IT IF SO 01507000
- SPACE 01508000
- * OTHERWISE, WE LOG THE CARDS WE SKIP WITH THE CUE OF 'IGNORING'. 01509000
- LOG UPDLINE,CUE,'IGNORING...' 01510000
- SPACE 01511000
- INVULUP EQU * 01512000
- UPITEM UPDFILE 01513000
- FSREAD FSCB=UPDFILE,ERROR=UPDFERR READ NEXT UPDATE CARD 01514000
- CLC =CL2'./',UPDLINE IS IT A CONTROL CARD? 01515000
- BE UPDCTLC GO PROCESS IT IF SO 01516000
- LOG UPDLINE LOG THE IGNORED LINE 01517000
- B INVULUP AND GO FOR NEXT RECORD 01518000
- EJECT 01519000
- RSEQERR EQU * 01520000
- BAL R14,CTLTYPE TYPE OUT LAST CONTROL CARD 01521000
- DMSERR NUM=184,LET=W,BUFFA=ERRBUFF,DISP=NONE, *01522000
- TEXT='''./ S'' NOT FIRST CARD IN UPDATE FILE -- IGNORED' 01523000
- B INVUPCD1 01524000
- SPACE 3 01525000
- UPDSERR EQU * 01526000
- BAL R14,CTLTYPE TYPE LAST CONTROL CARD 01527000
- * IF 'DELT' FLAG IS OFF, THEN WE WERE LOOKING FOR FIRST SEQUENCE 01528000
- * NUMBER IN UPDATE CONTROL CARD; OTHERWISE, WE WERE LOOKING FOR 01529000
- * THE 2ND (THE END OF THE DELETE OR REPLACE RANGE). 01530000
- LA R14,SEQSTRT ASSUME FIRST SEQ NUMBER P3027 01531000
- TM UPDFLAG,DELT WERE WE DELETING? P3027 01532000
- BZ *+8 SKIP IF NOT P3027 01533000
- LA R14,SEQLAST ELSE, POINT TO 2ND SEQ # P3027 01534000
- LA R10,1(,R10) INCREMENT REG 10 TEMPORARILP3027 01535000
- DMSERR DISP=NONE,BUFFA=ERRBUFF,LET=W,NUM=186, *01536000
- SUB=(CHARA,((R14),(R10))), P3027*01537000
- TEXT='SEQUENCE NUMBER ''........'' NOT FOUND' P3027 01538000
- BCTR R10,0 RESTORE VALUE IN REG 10 P3027 01539000
- B INVUPCD1 01540000
- SPACE 3 01541000
- INVCHAR EQU * 01542000
- BAL R14,CTLTYPE TYPE LAST CONTROL CARD 01543000
- DMSERR BUFFA=ERRBUFF,DISP=NONE,NUM=185,LET=W, *01544000
- SUB=(CHARA,ACTVFLD), *01545000
- TEXT=('INVALID ', P3059*01546000
- 'CHAR IN SEQUENCE FIELD ''.........''') P3059 01547000
- B INVUPCD1 01548000
- EJECT 01549000
- * TYPE WARNING MESSAGE FOR ZERO SEQUENCE INCREMENT 01550000
- ZERSEQ EQU * 01551000
- ST R14,Z14 SAVE RETURN ADDRESS 01552000
- BAL R14,CTLTYPE TYPE LAST CONTROL CARD 01553000
- DMSERR BUFFA=ERRBUFF,DISP=NONE,NUM=182,LET=W, *01554000
- TEXT='SEQUENCE INCREMENT IS ZERO' 01555000
- BAL R14,BUFFOUT TYPE AND PRINT MESSAGE 01556000
- WARN 8 SET RETURN CODE TO 8 01557000
- L R14,Z14 RESTORE RETURN ADDR 01558000
- BR R14 01559000
- SPACE 01560000
- Z14 DS A 01561000
- EJECT 01562000
- * 01563000
- * RE-SEQUENCE THE OUTPUT FILE - REQUESTED VIA UPDATE CARD: 01564000
- * ./ S STARTNO INCREMENT LABEL 01565000
- * (E.G. -- './ S 100 100 DMK ') 01566000
- * 01567000
- FCTRSEQ EQU * RE-SEQUENCE REQUEST 01568000
- CLC SEQPOSN(8),CZEROES AT BEGINNING OF INPUT FILE ? 01569000
- BNE RSEQERR NO - './ S' MUST BE FIRST 01570000
- BAL R14,SCANUPD FIND STARTING SEQUENCE NO. 01571000
- BO RSEQDEF SET DEFAULTS @VA01031 01572000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01573000
- BAL R14,JUSTIFY JUSTIFY + VALIDATE THE FIELD 01574000
- LA R4,SEQFOLD DESTINATION 01575000
- EX R10,PACKACV PACK ACTIVE FIELD INTO SEQFOLD 01576000
- BAL R14,SCANUPD FIND INCREMENT 01577000
- BO RSEQIDF DEFAULT THE INCREMENT @VA01031 01578000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01579000
- BAL R14,JUSTIFY JUSTIFY + VALIDATE 01580000
- LA R4,SEQINCR DESTINATION 01581000
- EX R10,PACKACV PACK INTO SEQINCR 01582000
- CP SEQINCR,=P'0' IS THE INCREMENT POSITIVE? 01583000
- BP *+8 SKIP IF NON-ZERO INCREMENT 01584000
- BAL R14,ZERSEQ TYPE WARNING MESSAGE 01585000
- BAL R14,SCANUPD FIND THREE-CHARACTER LABEL, IF ANY 01586000
- BO RSEQLDF NONE - SET DEFAULT @VA01031 01587000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01588000
- CLI ACTVFLD+3,X'40' THREE-CHARS IS MAXIMUM 01589000
- BNE INVUPCD BAD CARD 01590000
- MVC SEQLABL(3),ACTVFLD SAVE THE LABEL 01591000
- B RSEQFIN GO FINISH CHECKING 01592000
- RSEQDEF EQU * DEFAULT EVERYTHING 01593000
- ZAP SEQFOLD,=PL4'10' DEFAULT FIVE-DIGIT START 01594000
- TM GLOBALS,SEQ8 IS IT EIGHT-DIGIT ? 01595000
- BZ RSEQIDF NO 01596000
- ZAP SEQFOLD,=PL4'1000' DEFAULT EIGHT-DIGIT START 01597000
- RSEQIDF EQU * DEFAULT INCREMENT + LABEL 01598000
- MVC SEQINCR(5),SEQFOLD INCREMENT = START NUMBER 01599000
- RSEQLDF EQU * DEFAULT THREE-CHAR LABEL 01600000
- MVC SEQLABL(3),INPFILE+8 = FIRST THREE CHARS OF NAME 01601000
- RSEQFIN EQU * FINAL VALIDATION OF PARMS 01602000
- CP SEQMAX,SEQFOLD DOES SEQ. EXCEED MAX P3059 01603000
- BNL CONST NO, CONTINUE PROCESSING P3059 01604000
- ZAP SEQFOLD,SEQINCR RESTART AT BEGINNING P3059 01605000
- LA R0,INPLINE+SEQFELD POINT TO LAST SEQ. NO. P3059 01606000
- BAL R14,WOVF WARN USER OF OVERFLOW P3059 01607000
- CONST EQU * P3059 01608000
- UNPK SEQNEXT(8),SEQFOLD(5) CONSTRUCT FIRST FIELD 01609000
- OI SEQNEXT+7,X'F0' FORCE EBCDIC 01610000
- AP SEQFOLD(5),SEQINCR(5) UPDATE FOR NEXT CARD 01611000
- BNP INVUPCD INVALID UPDATE CARD 01612000
- OI UPDFLAG,RSEQ RE-SEQUENCE THE OUTPUT FILE 01613000
- B UPDREAD ...AND CONTINUE WITH UPDATE FILE 01614000
- EJECT 01615000
- * 01616000
- * INSERT UPDATE RECORDS IN THE SOURCE FILE - REQUESTED VIA: 01617000
- * ./ I SEQNUM $ START INCR 01618000
- * 01619000
- FCTINST EQU * INSERT FUNCTION 01620000
- BAL R14,SCANUPD FIND FIRST FIELD = SEQUENCE NO. 01621000
- BNZ INVUPCD INVALID CARD IF NOT THERE 01622000
- BAL R14,JUSTIFY RIGHT-JUSTIFY 01623000
- LA R8,UPDREAD RETURN IN CASE OF SEQ. ERROR 01624000
- EX R10,SEQCHEK VALIDATE UPDATE SEQUENCE 01625000
- MVC SEQSTRT(8),ACTVFLD MOVE TO STARTING POSITION P3059 01626000
- BH UPDSERR NO GOOD -- SORRY 01627000
- FCTREPL EQU * ENTRY FOR SECOND HALF OF REPLACE 01628000
- BAL R14,SCANUPD SEE IF UPDATE SEQUENCE REQUESTED 01629000
- BO INSTINE NO - JUST A SIMPLE INSERT @VA01031 01630000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01631000
- CLC ACTVFLD(2),=C'$ ' DOLLAR SIGN ? 01632000
- BNE INVUPCD NO - INVALID CARD 01633000
- OI UPDFLAG,SGEN GENERATE SEQUENCE FOR UPDATE 01634000
- ZAP UPDSTRT,PAKZERO INITIALIZE START NUMBER 01635000
- BAL R14,SCANUPD ANY OPTIONS GIVEN ? 01636000
- BO INDFGEN NO - USE DEFAULTS @VA01031 01637000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01638000
- BAL R14,JUSTIFY THIS MUST BE ALL NUMERICS 01639000
- LA R4,UPDSTRT DESTINATION 01640000
- EX R10,PACKACV PACK STARTING NUMBER 01641000
- BAL R14,SCANUPD ANY INCREMENT GIVEN ? 01642000
- BO INDFGEN NO - USE DEFAULT INCREMENT @VA01031 01643000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01644000
- BAL R14,JUSTIFY JUSTIFY + VALIDATE 01645000
- LA R4,UPDINCR DESTINATION 01646000
- EX R10,PACKACV PACK THE INCREMENT 01647000
- CP UPDINCR,=P'0' ZERO INCREMENT???? @VA10579 01648100
- BP *+8 SKIP IF NON-ZERO SEQ NUMBER 01649000
- BAL R14,ZERSEQ TYPE WARNING MESSAGE 01650000
- B INSTINE GO START ACTUAL INSERT 01651000
- INDFGEN EQU * SET DEFAULTS FOR UPDATE SEQUENCING 01652000
- L R4,FENCED GPR 4 = F'-1' 01653000
- LA R3,SEQSTRT(R10) END OF SEQUENCE FIELD 01654000
- LR R5,R3 WE WANT TO LIMIT THE SCAN TO AVOID.. 01655000
- SH R5,=H'3' ...A PROBLEM WITH EVEN-TENS CARDS 01656000
- LA R14,1 FIRST GUESS AT INCREMENT @V2D4821 01657000
- INDFINC EQU * INCREMENT = (LEAST SIGNIFICANT DIGIT)/10 01658000
- CLI 0(R3),C'0' LOOK FOR LAST NON-ZERO DIGIT 01659000
- BNE INDFGOT 01660000
- SLL R14,4 INCREMENT TIMES 10 @V2D4821 01661000
- BXH R3,R4,INDFINC CONTINUE BACKWARD SCAN 01662000
- LA R14,X'100' USE DEFAULT INCREMENT OF P'1000' @V2D4821 01663000
- SLL R14,4 @V2D4821 01664000
- INDFGOT EQU * FOUND LEAST SIG. DIGIT 01665000
- STCM R14,B'1111',UPDINCR+1 SET INCREMENT @V2D4821 01666000
- MVI UPDINCR,X'00' ...FOR GENERATION 01667000
- OI UPDINCR+4,X'0C' ADD DECIMAL SIGN 01668000
- CP UPDSTRT(5),PAKZERO(5) WAS START DEFAULTED ? 01669000
- BNE INSTINE NO - READY TO START INSERTING 01670000
- EX R10,PACKUPD PACK SEQSTRT INTO UPDSTRT 01671000
- AP UPDSTRT(5),UPDINCR(5) SET DEFAULT START NUMBER 01672000
- EJECT 01673000
- INSTINE EQU * START ACTUAL INSERTION 01674000
- CLI UPDCODE,C'I' IS THIS AN EXPLICIT INSERT ? 01675000
- BNE INSLOOP NO - WE'RE IN THE RIGHT PLACE ALREADY 01676000
- LA R8,INSBAL RETURN ADDR FROM INPUTRD... V0026 01677000
- CLC ITEM+INPFILE(2),=H'0' HAS ANY RECORD BEEN READ ? V0026 01678000
- BE INPUTER NO..BEWARE OF SEQ. ALL ZEROS V0026 01679000
- B INPUTRD POSITION THE INPUT FILE. V0026 01680000
- INSBAL EQU * V0026 01681000
- BAL R7,CONDPASS COND. WRITE OUT LAST RECORD @V2D4821 01682000
- INSLOOP EQU * INSERT UNTIL NEXT './' CARD 01683000
- UPITEM UPDFILE INCREMENT ITEM NUMBER 01684000
- FSREAD FSCB=UPDFILE,ERROR=UPDFE001 @V2D4821 01685000
- CLC UPDLINE(3),=CL4'./ ' CONTROL CARD ? 01686000
- BE INSCTL YES -- INSERT IS COMPLETE P3027 01687000
- TM GLOBALS,INCL INCLUDE SEQUENCE FROM UPDATE ? 01688000
- BZ SETSTAR NO - USE ASTERISKS 01689000
- TM UPDFLAG,SGEN GENERATE SEQUENCE ? 01690000
- BZ INSWLOG NO - USE IT AS IS 01691000
- UNPK UPDNEXT(8),UPDSTRT(5) UNPACK SEQUENCE NUMBER 01692000
- OI UPDNEXT+7,X'F0' FORCE NUMERIC 01693000
- MVC UPDLINE+SEQFELD(8),UPDNEXT FULL EIGHT-DIGIT SEQ. 01694000
- TM GLOBALS,SEQ8 CHECK TO MAKE SURE 01695000
- BO INSGSEQ YES 01696000
- MVC UPDLINE+SEQFELD(3),SEQLABL SET LABEL ALSO 01697000
- INSGSEQ EQU * CALCULATE NEXT SEQUENCE FIELD 01698000
- AP UPDSTRT(5),UPDINCR(5) INCREMENT 01699000
- CP UPDSTRT,SEQMAX NEXT SEQ # EXCEED THE MAX? P3027 01700000
- BL INSWLOG BO IF NOT P3027 01701000
- SPACE 1 01702000
- * OTHERWISE, THE HAVE SEQUENCE NUMBER OVERFLOW 01703000
- LA R0,UPDLINE+SEQFELD POINT TO LAST CORRECT SEQ #P3027 01704000
- ZAP UPDSTRT,UPDINCR RESTART AT BEGINNING 01705000
- BAL R14,WOVF GO TYPE OUT WARNING MESSAGE 01706000
- EJECT 01707000
- INSWLOG EQU * SET NEW FILE POSITION 01708000
- LA R4,UPDLINE+SEQFELD+7 01709000
- SLR R4,R10 BACK UP TO START OF FIELD 01710000
- EX R10,MVCPOSN RECORD CURRENT POSITION 01711000
- B INSTLOG 01712000
- SPACE 01713000
- SETSTAR EQU * DO NOT INCLUDE SEQUENCE FIELDS 01714000
- MVC UPDLINE+SEQFELD(8),=CL8'********' 01715000
- INSTLOG EQU * 01716000
- TM UPDFLAG,FULL IS THERE DATA ALREADY IN BUFFER ? 01717000
- BO INSWUT1 YES - THIS IS NOT THE FIRST LINE 01718000
- NI UPDFLAG,X'FF'-FULI INDICATE DATA IS FROM UPDATE FIL 01719000
- LOG UPDLINE,CUE,'INSERTING...' FIRST LINE + CUE MSG 01720000
- B INSETXT GO SETUP FOR CONTINUED INSERT 01721000
- INSWUT1 EQU * WRITE PREVIOUS LINE TO CMSUT1 01722000
- BAL R7,PASSOVR 01723000
- LOG UPDLINE WRITE CURRENT LINE TO LOGFILE 01724000
- INSETXT EQU * MOVE INSERTED LINE TO 'INPLINE' 01725000
- MVC INPLINE(80),UPDLINE THIS IS AN INSERTION 01726000
- OI UPDFLAG,FULL BUFFER CONTAINS DATA 01727000
- B INSLOOP CONTINUE WITH INSERTION 01728000
- SPACE 01729000
- INSCTL EQU * 01730000
- BAL R7,PASSOVR WRITE OUT LAST INSERTED CARD 01731000
- B UPDCTLC GO HANDLE CONTROL CARD 01732000
- UPDFE001 TM UPDFLAG,INCOR IN-CORE UPDATE @V2D4821 01733000
- BNO UPDFERR NOPE @V2D4821 01734000
- BAL R7,PASSOVR WRITE OUT THE LAST RECORD @V2D4821 01735000
- LA R15,12 SIMULATE E-O-F @V2D4821 01736000
- B UPDFERR @V2D4821 01737000
- EJECT 01738000
- * 01739000
- * DELETE RECORDS FROM THE INPUT FILE - CONTROL CARD IMAGE: 01740000
- * ./ D SEQNO1 <SEQNO2> <$> 01741000
- * DELETE FROM SEQNO1 UP TO AND INCLUDING SEQNO2 01742000
- * 01743000
- FCTDELT EQU * DELETE FUNCTION 01744000
- BAL R14,SCANUPD FIND FIRST SEQUENCE FIELD 01745000
- BNZ INVUPCD INVALID IF IT'S MISSING 01746000
- L R1,UPDLINE+80 SAVE SCAN POINTER IN CASE OF REPLACE 01747000
- ST R1,REPSCAN 01748000
- BAL R14,JUSTIFY ADJUST + VALIDATE 01749000
- LA R8,UPDREAD RETURN IN CASE OF SEQ. ERROR 01750000
- EX R10,SEQCHEK VALIDATE UPDATE SEQUENCE 01751000
- MVC SEQSTRT(8),ACTVFLD MOVE TO START SLOT P3059 01752000
- BH UPDSERR NO GOOD -- SORRY 01753000
- MVC SEQLAST(8),ACTVFLD DEFAULT ENDING SLOT, ALSO 01754000
- BAL R14,SCANUPD SEE IF ANY SECOND FIELD 01755000
- BO DELTINE NO - JUST DELETE ONE LINE @VA01031 01756000
- BM INVUPCD INVALID UPDATE CARD @VA01031 01757000
- CLC ACTVFLD(2),=C'$ ' IF IT'S A DOLLAR SIGN... 01758000
- BE DELTINE ...JUST DELETE A SINGLE LINE 01759000
- BAL R14,JUSTIFY OTHERWISE, ADJUST IT 01760000
- MVC SEQLAST(8),ACTVFLD SET LAST SEQUENCE FIELD 01761000
- L R1,UPDLINE+80 SAVE SCAN POINTER IN CASE OF REPLACE 01762000
- ST R1,REPSCAN ... 01763000
- DELTINE EQU * POSITION THE FILE FOR DELETION 01764000
- EX R10,CHKRANG CHECK FOR VALID RANGE SPECIFICATION 01765000
- BH INVUPCD N.G. -- START HIGHER THAN END 01766000
- BAL R8,INPUTRD POSITON FILE AT 'SEQSTRT' 01767000
- OI UPDFLAG,DELT INDICATE DELETE IN PROGRESS 01768000
- NI UPDFLAG,X'FF'-FULL BUFFER SHOULD NOT BE WRITTEN 01769000
- LOG INPLINE,CUE,'DELETING... ' FIRST LINE + CUE MSG 01770000
- TM UPDFLAG,INCOR IN-CORE UPDATE ??? @V2D4821 01771000
- BNO DELTINP NOPE.. @V2D4821 01772000
- BAL R14,XDELE DELETE LINE FROM CHAIN @V2D4821 01773000
- NOP 0 @V2D4821 01774000
- EJECT 01775000
- DELTINP EQU * READ, DO NOT WRITE 01776000
- EX R10,CLCDELT FINISHED YET ? 01777000
- BE DELTFIN YES - CLEAN UP 01778000
- BAL R14,XREAD READ A LINE @V2D4821 01779000
- B INPFERR GO IF ERROR @V2D4821 01780000
- CLC INPLINE+SEQFELD(8),BLANKS IS IT BLANK SEQUENCE ? 01781000
- BE DELTOVR YES - SKIP OVER IT 01782000
- LA R4,INPLINE+SEQFELD+7 01783000
- SLR R4,R10 BACK UP TO START OF SEQUENCE 01784000
- EX R10,MVCPOSN RECORD NEW FILE POSITION 01785000
- EX R10,CLCDELT DID WE MISS SEQNO2 ? @VA05353 01786000
- BNL DELCHEK NO; SKIP @VA05353 01787000
- EX R10,MVCILAST YES; RECORD INPUT FILE'S SEQ # @VA05353 01788000
- OI UPDFLAG,FULL MUSTN'T DELETE THIS LINE @VA05353 01789000
- B UPDSERR BUT TELL 'EM SEQNO2 NOT FOUND @VA05353 01790000
- SPACE 1 01791000
- * WE CHECK TO SEE IF SEQUENCE NUMBERS IN INPUT FILE ARE ASCENDING 01792000
- DELCHEK EX R10,CLCILAST @VA05353 01793000
- BL *+8 SKIP IF NO SEQUENCE ERR P3027 01794000
- BAL R14,INSEQW GO TYPE OUT WARNING MSG P3027 01795000
- EX R10,MVCILAST SAVE VALUE OF INPUT SEQ # P3027 01796000
- DELTOVR TM UPDFLAG,INCOR UPDATING IN STORAGE? @VA05353 01797000
- BZ DELTLOG NO; SKIP @VA05353 01798000
- BAL R14,XDELE YES; REMOVE LINE FROM CHAIN @VA05353 01799000
- NOP 0 @VA05353 01800000
- DELTLOG LOG INPLINE LOG THE DELETED LINE @VA05353 01801000
- B DELTINP DELETE BY PASSING OVER 01802000
- DELTFIN EQU * CLEAN UP AFTER DELETE 01803000
- NI UPDFLAG,X'FF'-DELT-FULL DELETE NOW COMPLETE 01804000
- CLI UPDCODE,C'D' WAS IT A REAL DELETE ? 01805000
- BNE REPFUNC NO REPLACE @V2D4821 01806000
- BAL R14,XREAD UPD LINE PTR @V2D4821 01807000
- B DELTEOF MIGHT BE EOF @VA05353 01808000
- OI UPDFLAG,FULL+FULI BUFFER CONTAINS IP DATA @V2D4821 01809000
- B DELTEND @VA05353 01810000
- DELTEOF LA R1,INPFILE POINT TO PLIST IN CASE REAL ERR @VA05353 01811000
- CH R15,=H'12' EOF? @VA05353 01812000
- BNE INPERR NO; BAD NEWS @VA05353 01813000
- DELTEND LA R4,INPLINE+SEQFELD+7 @VA05353 01814000
- SLR R4,R10 BACK UP TO @V2D4821 01815000
- * START OF SEQUENCE 01816000
- EX R10,MVCPOSN RECORD NEW POS @V2D4821 01817000
- EX R10,MVCILAST @V2D4821 01818000
- B UPDREAD @V2D4821 01819000
- EJECT @VA05353 01820000
- * 01821000
- * FOR REPLACE FUNCTION - SETUP AND TRANSFER TO 'INSERT' 01822000
- * 01823000
- REPFUNC L R1,REPSCAN POINTER TO RE-SCAN CONTROL CARD @VA05353 01824000
- ST R1,UPDLINE+80 SET FOR SCAN ROUTINE 01825000
- MVC SEQPOSN(8),SEQSTRT RESET FILE POSITION FOR 'INSERT' 01826000
- B FCTREPL GO PERFORM INSERT HALF OF REPLACE 01827000
- SPACE 2 01828000
- PACKUPD PACK UPDSTRT(5),SEQSTRT(*-*) FOR INSERT 01829000
- CLCDELT CLC SEQLAST(*-*),SEQPOSN FOR DELETE 01830000
- CHKRANG CLC SEQSTRT(*-*),SEQLAST VALIDITY CHECK 01831000
- SEQCHEK CLC SEQSTRT(*-*),ACTVFLD UPDATE INPUT SEQUENCE CHECK 01832000
- PACKACV PACK 0(5,R4),ACTVFLD(*-*) PACK INTO SOMEWHERE 01833000
- MVCR2R1 MVC 0(*-*,R2),0(R1) 01834000
- MVCOLAST MVC OSEQLAST(*-*),0(R4) MOVE INTO OUTPUT SEQ # FIELD 01835000
- EJECT 01836000
- * 01837000
- * INPUTRD -- SUBROUTINE TO POSITION THE INPUT FILE AT THE 01838000
- * SEQUENCE NUMBER SPECIFIED IN 'SEQSTRT'. INPUT RECORDS 01839000
- * ARE RE-SEQUENCED IF NECESSARY AND WRITTEN OUT TO THE 01840000
- * 'UPDATE CMSUT1' FILE AS THEY ARE PASSED OVER. CHECKS ARE 01841000
- * PERFORMED TO CATCH SEQUENCE ERRORS IN THE INPUT FILE. 01842000
- * 01843000
- INPUTRD EQU * POSITION FILE AT 'SEQSTRT' 01844000
- LA R4,SEQSTRT MAYBE... 01845000
- EX R10,CLCILAST ...WE'RE ALREADY WHERE WE WANT TO BE 01846000
- BCR 8,R8 WHY, LO AND BEHOLD, WE ARE 01847000
- BNL UPDSERR TYPE ERRMSG -- SEQ# NOT FNDP3027 01848000
- SPACE 1 01849000
- INPUTER EQU * READ UNTIL WE FIND IT 01850000
- BAL R7,CONDPASS CONDITIONALLY WRITE DATA TO CMSUT1 @V2D4821 01851000
- BAL R14,XREAD READ SOME INPUT @V2D4821 01852000
- B INPFERR IF ERROR @V2D4821 01853000
- OI UPDFLAG,FULL+FULI BUFFER CONTAINS INPUT FILE DATA 01854000
- CLC INPLINE+SEQFELD(8),BLANKS WE SKIP BLANK CARDS 01855000
- BE INPUTER YES INDEED 01856000
- LA R4,INPLINE+SEQFELD+7 LAST BYTE OF FIELD 01857000
- SLR R4,R10 BACK UP TO START OF NUMERICS 01858000
- MVCPOSN MVC SEQPOSN(*-*),0(R4) UPDATE FILE POSITION @V2D4821 01859000
- CLCILAST CLC ISEQLAST(*-*),0(R4) CHECK FOR LAST INPUT SEQ. #@V2D4821 01860000
- BL *+8 SKIP IF LAST LOWER P3027 01861000
- BAL R14,INSEQW TYPE OUT WARNING MESSAGE P3027 01862000
- MVCILAST MVC ISEQLAST(*-*),0(R4) MOVE INTO INPUT SEQ. # FIEL@V2D4821 01863000
- B INPUTRD GO SEE IF WE'VE FND TARGET P3027 01864000
- EJECT 01865000
- * 01866000
- * PASSOVR -- WRITE A RECORD TO OUTPUT FILE, RE-SEQUENCING 01867000
- * IF REQUESTED. BUFFER ADDRESS IN GPR6, RETURN IN GPR 7. 01868000
- * 01869000
- CONDPASS TM UPDFLAG,FULL IS BUFF FULL? @V2D4821 01870000
- BCR 8,R7 NO RETURN @V2D4821 01871000
- TM UPDFLAG,INCOR INCORE UPD? @V2D4821 01872000
- BZ PASSOVR NO @V2D4821 01873000
- TM UPDFLAG,RSEQ IF SO, ARE WE RESEQUENCING?? @V2D4821 01874000
- BNO PASS1B NOPE.. @V2D4821 01875000
- BAL R14,XDELE DO A LOGICAL REPLACE ON INPLINE @V2D4821 01876000
- NOP 0 @V2D4821 01877000
- B PASSOVR @V2D4821 01878000
- * 01879000
- PASSOVR EQU * WRITE THE RECORD TO CMSUT1 01880000
- TM UPDFLAG,FULL IS THERE DATA IN THE BUFFER ? 01881000
- BCR 8,R7 NO - JUST RETURN 01882000
- TM UPDFLAG,RSEQ ARE WE RE-SEQUENCING ? 01883000
- BZ PASSOUT NO - JUST RE-WRITE IT 01884000
- MVC INPLINE+SEQFELD(8),SEQNEXT RE-SEQUENCE 01885000
- UNPK SEQNEXT(8),SEQFOLD(5) SEQFOLD IS ALL SET 01886000
- OI SEQNEXT+7,X'F0' FORCE TO EBCDIC 01887000
- AP SEQFOLD(5),SEQINCR(5) UPDATE FOR NEXT LAP 01888000
- CP SEQFOLD,SEQMAX COMPARE NEW SEQ# WITH MAX P3027 01889000
- BL PASSNOV SKIP MESSAGE IF NO OVERFLOWP3027 01890000
- ZAP SEQFOLD,SEQINCR RESET SEQUENCE NUMBER P3027 01891000
- LA R0,INPLINE+SEQFELD POINT TO LAST OK SEQ # P3027 01892000
- BAL R14,WOVF GO TYPE OVERFLOW MESSAGE P3027 01893000
- SPACE 1 01894000
- PASSNOV EQU * P3027 01895000
- TM GLOBALS,SEQ8 SHOULD WE ADD THE LABEL ? 01896000
- BO PASSOUT NO - LEAVE IT AS IS 01897000
- MVC INPLINE+SEQFELD(3),SEQLABL ADD THREE-CHAR LABEL 01898000
- PASSOUT EQU * 01899000
- TM UPDFLAG,INCOR INCORE UPDATE ??? @V2D4821 01900000
- BZ PASS1A NO @V2D4821 01901000
- LA R1,INPLINE ADDRESS OF LINE TO BE WRITTEN @V2D4821 01902000
- BAL R14,XWRITE CHAIN LINE INTO LIST @V2D4821 01903000
- B PASS1B @V2D4821 01904000
- PASS1A EQU * @V2D4821 01905000
- FSWRITE FSCB=UT1FILE,ERROR=OUTERR WRITE UTILITY FILE 01906000
- PASS1B EQU * @V2D4821 01907000
- NI UPDFLAG,X'FF'-FULL BUFFER IS NOW EMPTY 01908000
- SPACE 01909000
- * WE NOW CHECK FOR SEQUENCE ERRORS. WE FIRST CHECK TO SEE IF THE NEW 01910000
- * SEQUENCE NUMBER EXCEEDS THE LAST SEQUENCE NUMBER. 01911000
- LA R4,INPLINE+SEQFELD+7 GET CURRENT SEQUENCE NUMBER 01912000
- CLC INPLINE+SEQFELD(8),BLANKS BLANK SEQ. FILED? @VA05075 01913000
- BE PASSSET YES SKIP THIS CARD @VA05075 01914000
- SLR R4,R10 POINT TO ITS ADDR (COL 73 OR 76) 01915000
- CLCOLAST CLC OSEQLAST(*-*),0(R4) MOVE INTO OUTPUT SEQ. # FIE@V2D4821 01916000
- BL PASSSET NOTHING TO DO IF LAST WAS LOWER 01917000
- SPACE 01918000
- SPACE 1 01919000
- * WE HAVE DISCOVERED A SEQUENCE ERROR. WE MUST DETERMINE WHETHER 01920000
- * IT'S A VALID ERROR AND, IF SO, WHAT MESSAGE TO TYPE. 01921000
- * FIRST, IF WE ARE RESEQUENCING (WITH ./ S), THEN IT'S DUE EITHER 01922000
- * TO A ZERO SEQUENCE INCREMENT OR TO A SEQUENCE NUMBER OVERFLOW, 01923000
- * AND SO THERE'S NO NEED FOR AN EXTRA ERROR MESSAGE. 01924000
- TM UPDFLAG,RSEQ ARE WE RESEQUENCING? P3027 01925000
- BO PASSSET GO IF NOT -- NOTHING TO DO P3027 01926000
- SPACE 1 01927000
- * NEXT, IF WE ARE NOT INCLUDING SEQUENCE NUMBERS, THEN WE DON'T 01928000
- * FLAG THE PROBLEM. 01929000
- TM GLOBALS,INCL ARE WE INCLUDING? P3027 01930000
- BZ PASSSET NOTHING TO DO IF NOT P3027 01931000
- SPACE 1 01932000
- * THE NATURE OF THE ACTUAL ERROR DEPENDS UPON WHERE THE LAST TWO 01933000
- * LINES OF OUTPUT CAME FROM -- THE INPUT FILE OR THE UPDATE FILE 01934000
- * (THE LATTER IN THE CASE OF AN INSERT). 01935000
- SR R1,R1 P3027 01936000
- TM UPDFLAG,FULI IS CURRENT LINE FROM INPUT?P3027 01937000
- BZ *+8 SKIP IF IT IS NOT P3027 01938000
- LA R1,4 4 = THIS RECORD FROM INPUT P3027*01939000
- FILE P3027 01940000
- CLI PASSFLG,0 LAST RECORD FROM INPUTFILE?P3027 01941000
- BNE *+8 SKIP IF NOT P3027 01942000
- LA R1,8(,R1) ADD 8 IF PREV RECORD FROM P3027*01943000
- INPUT FILE P3027 01944000
- B *+4(R1) BRANCH BASED ON CASE P3027 01945000
- B PASSUU 0 BOTH RECORDS FROM UPDATE P3027 01946000
- B PASSUI 4 PREV FROM UPDATE, CURRENT P3027*01947000
- FROM INPUT P3027 01948000
- B PASSIU 8 PREV FROM INPUT, THIS FROM P3027*01949000
- UPDATE P3027 01950000
- B PASSSET 12 BOTH FROM INPUT -- A MSG P3027*01951000
- HAS ALREADY BEEN TYPED P3027 01952000
- SPACE 1 01953000
- * COME HERE IF BOTH RECORDS ARE INSERTED FROM THE UPDATE FILE. 01954000
- * THERE ARE TWO CASES HERE. 01955000
- SPACE 1 01956000
- * (1) BOTH CARDS ARE FROM THE SAME INSERT "GROUP". THIS @VA04290 01957000
- * SITUATION CAN ONLY OCCUR IF THE SEQUENCE INCREMENT IS @VA04290 01958000
- * ZERO, WHICH WOULD RESULT IN IDENTICAL SEQUENCE NUMBERS, @VA04290 01959000
- * OR IF THE SEQUENCE NUMBER OVERFLOWED. FOR AN EXPLICIT @VA04290 01960000
- * "INSERT", BOTH OF THESE SITUATIONS WOULD ALREADY HAVE @VA04290 01961000
- * BEEN NOTED VIA AN ERROR MESSAGE, BUT FOR AN INSERTION @VA04290 01962000
- * DUE TO A "REPLACE", NO SUCH MESSAGE WOULD HAVE BEEN @VA04290 01963000
- * ISSUED, SO WE ISSUE ONE VIA "PASSIU". @VA04290 01964000
- SPACE 1 @VA04290 01965000
- * (2) THE TWO CARDS ARE FROM DIFFERENT INSERT GROUPS. IN @VA04290 01966000
- * THIS CASE, BOTH THE PREVIOUS AND CURRENT CONTROL CARDS @VA04290 01967000
- * ARE RELEVANT, SO WE DISPLAY THEM BOTH, THEN ISSUE THE @VA04290 01968000
- * ERROR MESSAGE. @VA04290 01969000
- PASSUU TM UPDFLAG,SGEN "$" IN LAST CONTROL CARD? @VA04290 01970000
- BZ PASSIU NO; CONTINUE @VA04290 01971000
- LH R1,UPDFILE+ITEM GET ITEM NUMBER OF THE @VA04290*01972000
- CURRENT RECORD BEING INSERTED @VA04290 01973000
- LA R1,0(,R1) CLEAR ANY HI-ORDER BYTE @VA04290 01974000
- LH R2,LASTCTLI GET ITEM # OF LAST CONTROL CARD @VA04290 01975000
- LA R2,3(,R2) INCREMENT IT FOR COMPARISON @VA04290 01976000
- CLR R1,R2 MORE THAN 2 CARDS SINCE LAST @VA04290*01977000
- CONTROL CARD? @VA04290 01978000
- BH PASSSET YES; NOTHING ELSE TO DO @VA04290 01979000
- BL PASSUU2 NO; MUST BE 2 DIFFERENT GROUPS @VA04290 01980000
- CLI UPDCODE,C'R' NO; SAME GROUP; WAS IT "REPLACE"?@VA04290 01981000
- BNE PASSSET NO; JUST CONTINUE @VA04290 01982000
- B PASSIU YES; ISSUE MESSAGE THIS TIME @VA04290 01983000
- PASSUU2 BAL R14,CTLPTYPE 2 GROUPS; TYPE PREVIOUS CTL CARD @VA04290 01984000
- SPACE 1 01985000
- * COME HERE IF PREVIOUS CARD WAS FROM THE INPUT FILE AND THE 01986000
- * CURRENT CARD IS BEING INSERTED FROM THE UPDATE FILE. 01987000
- PASSIU EQU * P3027 01988000
- BAL R14,CTLTYPE TYPE LAST CONTROL CARD P3027 01989000
- B PASSW GO TYPE WARNING MESSAGE P3027 01990000
- SPACE 1 01991000
- * COME HERE IF THE PREVIOUS CARD WAS FROM THE UPDATE FILE, BUT 01992000
- * THE CURRENT CARD IS FROM THE INPUT FILE. IN THIS CASE, THERE IS 01993000
- * NO NEED TO TYPE THE LAST CONTROL CARD, SO WE TYPE THE PREVIOUS 01994000
- * CONTROL CARD. 01995000
- PASSUI EQU * P3027 01996000
- TM UPDFLAG,TAIL HAS EOF BEEN REACHED P3059 01997000
- BO PASSIU YES, THEN TYPE OUT CURRENT CARD P3059 01998000
- BAL R14,CTLPTYPE TYPE PREVIOUS CTL CARD P3027 01999000
- SPACE 1 02000000
- PASSW EQU * P3027 02001000
- LA R10,1(,R10) INCREMENT R10 TEMPORARILY 02002000
- DMSERR DISP=NONE,BUFFA=ERRBUFF,NUM=174,LET=W,RENT=NO, *02003000
- SUB=(CHARA,(OSEQLAST,(R10)),CHARA,((R4),(R10))), *02004000
- TEXT='SEQUENCE ERROR INTRODUCED IN OUTPUT FILE: ''......*02005000
- ..'' TO ''........''' 02006000
- BCTR R10,0 RESTORE VALUE IN R10 02007000
- BAL R14,BUFFOUT TYPE AND PRINT MESSAGE 02008000
- WARN 8 SET RETURN CODE TO 8 02009000
- SPACE 3 02010000
- * FINALLY, WE SET PASSFLG TO INDICATE WHETHER THE CURRENT LINE 02011000
- * IS FROM THE INPUT FILE OR FROM THE UPDATE FILE. 02012000
- PASSSET EQU * 02013000
- MVI PASSFLG,0 ASSUME FROM INPUT FILE 02014000
- TM UPDFLAG,FULI WAS IT? 02015000
- BO *+8 SKIP IF SO 02016000
- MVI PASSFLG,X'FF' IT'S FROM THE UPDATE FILE 02017000
- EX R10,MVCOLAST COPY LAST OUTPUT SEQUENCE NUMBER 02018000
- TM UPDFLAG2,FINISH ARE WE FINISHED? @V2D4821 02019000
- BO UPDFERR3 YES @V2D4821 02020000
- BR R7 RETURN TO CALLER 02021000
- SPACE 2 02022000
- * 0 IN THE FOLLOWING FLAG MEANS THAT THE LAST CARD WAS FROM THE INPUT 02023000
- * FILE, WHILE FF MEANS IT WAS FROM THE UPDATE FILE. 02024000
- PASSFLG DC X'00' 02025000
- DS 0H 02026000
- EJECT 02027000
- * SUBROUTINE TO TYPE OUT THE WARNING MESSAGE INDICATING THAT A 02028000
- * SEQUENCE ERROR WAS DETECTED IN THE INPUT FILE. 02029000
- INSEQW EQU * P3027 02030000
- CLC ITEM+INPFILE(2),=H'1' IF THIS IS FIRST RECORD V0026 02031000
- BCR 8,R14 READ,THEN SEQ IS ALL ZEROS V0026 02032000
- TM GLOBALS,UPDN HAVE WE ALREADY DONE AN P3027*02033000
- UPDATE? P3027 02034000
- BCR 1,R14 DON'T MENTION IT AGAIN P3027 02035000
- ST R14,INSW14 SAVE OLD REG 14 P3027 02036000
- BAL R14,CTLTYPE TYPE LAST CONTROL CARD P3027 02037000
- LA R1,INPFILE TYPE CURRENT LINE FROM P3027 02038000
- BAL R14,LINTYPE INPUT FILE P3027 02039000
- LA R10,1(,R10) TEMPORARILY INCREASE R10 P3027 02040000
- DMSERR DISP=NONE,BUFFA=ERRBUFF, P3027*02041000
- LET=W,NUM=210,RENT=NO, P3027*02042000
- SUB=(CHARA,(ISEQLAST,(R10)),CHARA,((R4),(R10))), P3027*02043000
- TEXT=('INPUT FILE SEQUENCE ERROR:', P3027*02044000
- ' ''........'' TO ''........''') P3027 02045000
- BCTR R10,0 RESET R10 P3027 02046000
- BAL R14,BUFFOUT PUT OUT THE MESSAGE P3027 02047000
- WARN 4 SET RETURN CODE TO 4 P3027 02048000
- L R14,INSW14 RESTORE REG 14 P3027 02049000
- BR R14 RETURN TO CALLER P3027 02050000
- SPACE 1 02051000
- INSW14 DS F P3027 02052000
- EJECT 02053000
- * 'LOCATE' SUBROUTINE. CALLS THE CMS 'STATE' FUNCTION TO DETERMINE 02054000
- * THE EXISTENCE OF A FILE. MAKES A NORMAL RETURN IF THE FILE EXISTS, 02055000
- * AND A 'JUMP' RETURN IF IT DOES NOT. OTHER ERRORS (SUCH AS ILLEGAL 02056000
- * FILEMODE) ARE ALSO DETECTED, WITH IMMEDIATE DETECTION AND PROGRAM 02057000
- * TERMINATION. 02058000
- LOCATE EQU * 02059000
- LR R2,R1 SAVE PLIST POINTER 02060000
- FSSTATE FSCB=(1),ERROR=LOCER CALL 'STATE' 02061000
- SPACE 02062000
- * R1 NOW POINTS TO THE STATE FST FOR THE FILE 02063000
- USING STATEFST,R1 HRC015DS 02064100
- L R15,FVSFSTAD Point to ADT for file HRC015DS 02064200
- ST R15,PTRS(,R2) SAVE IN WORD AFTER FSCB 02065000
- USING ADTSECT,R15 02066000
- MVC 24(1,R2),ADTM GET THE RIGHT MODE LETTER 02067000
- L R15,FVSFSTAC Address of real FST HRC015DS 02068100
- DROP R1 HRC015DS 02068200
- ST R15,PTRS+4(,R2) SAVE AFTER ADT POINTER 02069000
- USING FSTSECT,R15 02070000
- MVC 25(1,R2),FSTM+1 GET CORRECT MODE NUMBER 02071000
- CLI FSTFV,C'F' IS THIS FIXED FILE? 02072000
- BNE FMTERR BAD FORMAT IF NOT 02073000
- CLC FSTIL,=F'80' ITEM LENGTH = 80? 02074000
- BNE FMTERR BAD FORMAT IF NOT 02075000
- B 4(,R14) GIVE A 'JUMP' RETURN 02076000
- SPACE 2 02077000
- * COME HERE ON AN ERROR RETURN FROM STATE. 02078000
- LOCER EQU * 02079000
- CH R15,=H'36' DISK NOT ACCESSED @VA12416 02079500
- BE ERRMSG36 YES, ISSUE MSG69E @VA12416 02079600
- CH R15,=H'28' IS IT 'FILE NOT FOUND'? 02080000
- BCR 8,R14 (BE 0(R14)) JUST RETURN IF SO 02081000
- CH R15,=H'1' 02082000
- BCR 8,R14 02083000
- SPACE 02084000
- * OTHERWISE, IT'S SOME IMPORTANT ERROR. 02085000
- STC R15,RC SAVE RETURN CODE FROM 'STATE' 02086000
- B ERETURN GO ABORT 02087000
- EJECT 02088000
- *************************************************************** 02089000
- ** 02090000
- ** XWRITE--INSERT A LINE INTO CORE 02091000
- ** 02092000
- ** INPUT-- 02093000
- ** R1--ADDRESS OF LINE TO BE WRITTEN 02094000
- ** R14--RETURN ADDRESS 02095000
- ** 02096000
- ** OUTPUT-- 02097000
- ** THE UPDATED LIST 02098000
- ** PTR2=>INSERT (AS IF INSERT HAS JUST BEEN READ 02099000
- ** (LINE JUST READ)=>INSERT=>(NEXT LINE) 02100000
- ** 02101000
- ** EXIT-- 02102000
- ** RETURN VIA R14 02103000
- ** RETURN THROUGH CORBUST IF CORE EXHAUSTED 02104000
- ** 02105000
- ** 02106000
- *************************************************************** 02107000
- SPACE 1 02108000
- XWRITE EQU * @V2D4821 02109000
- ST R14,REGSAV SAVE RETURN @V2D4821 02110000
- L R14,SPARES NUMBER OF SPARES LEFT IN CORE @V2D4821 02111000
- LTR R14,R14 ANY? @V2D4821 02112000
- BZ CORBUST BRANCH IF NOT @V2D4821 02113000
- BCTR R14,0 REDUCE BY 1 @V2D4821 02114000
- ST R14,SPARES AND STORE AS NEW VALUE OF SPARES@V2D4821 02115000
- L R15,FPTR LOAD FREE-LIST POINTER @V2D4821 02116000
- LTR R15,R15 IS LIST EMPTY @V2D4821 02117000
- BNZ XWRIT08 NO, WE'RE OK @V2D4821 02118000
- L R15,AEXTEND LIMIT TO WHICH WE'VE GONE SO FAR@V2D4821 02119000
- SR R0,R0 CLEAR FORWARD CHAIN OF NEW LINE@V2D4821 02120000
- ST R0,0(,R15) @V2D4821 02121000
- LR R0,R15 COMPUTE NEW BOUND @V2D4821 02122000
- A R0,CORITEM @V2D4821 02123000
- ST R0,AEXTEND AND SAVE IN AEXTEND @V2D4821 02124000
- SPACE 1 02125000
- XWRIT08 EQU * @V2D4821 02126000
- L R0,0(,R15) LOAD NEXT ENTRY ADDRESS @V2D4821 02127000
- ST R0,FPTR AND UPDATE FREE-LIST POINTER @V2D4821 02128000
- MVC 8(80,R15),0(R1) MOVE IN THE LINE @V2D4821 02129000
- L R1,PTR2 GR1=A(OLD ITEM) @V2D4821 02130000
- ST R15,PTR2 READ PTR POINTS TO ITEM @V2D4821 02131000
- L R14,0(,R1) GR14=A(OLD+1) @V2D4821 02132000
- ST R14,0(,R15) E =>OLD+1 @V2D4821 02133000
- LTR R14,R14 IS OLD+1=EOF @V2D4821 02134000
- BZ SKIPINST YES, SKIP NEXT INS. @V2D4821 02135000
- ST R15,4(,R14) NO, E <= OLD+1 @V2D4821 02136000
- SKIPINST ST R1,4(,R15) OLD <= E @V2D4821 02137000
- ST R15,0(,R1) OLD => E @V2D4821 02138000
- L R14,SPARES @V2D4821 02139000
- LTR R14,R14 HOW MANY SPARES LEFT? @V2D4821 02140000
- BZ CORBUST BRANCH IF NONE @V2D4821 02141000
- SR R15,R15 CLEAR CONDITION CODE @V2D4821 02142000
- XWRITEX EQU * RETURN FROM 'XWRITE' @V2D4821 02143000
- L R14,REGSAV RESTORE RETURN ADDRESS @V2D4821 02144000
- BR R14 RETURN TO CALLER @V2D4821 02145000
- SPACE 2 02146000
- *************************************************************** 02147000
- ** 02148000
- ** XREAD--READ AN LINE FROM CORE 02149000
- ** 02150000
- ** INPUT-- 02151000
- ** R14--RETURN ADDRESS 02152000
- ** 02153000
- ** OUTPUT-- 02154000
- ** THE NEXT LINE IN 'INPLINE' 02155000
- ** 02156000
- ** EXITS-- 02157000
- ** VIA R14 ONLY 02158000
- ** 0(,R14) = END OF FILE 02159000
- ** 4(,R14) = NORMAL READ 02160000
- ** 02161000
- ** 02162000
- *************************************************************** 02163000
- SPACE 1 02164000
- XREAD EQU * @V2D4821 02165000
- UPITEM INPFILE @V2D4821 02166000
- TM UPDFLAG,INCOR IN-CORE FILE?? @V2D4821 02167000
- BNO XREADF NO.. READ FROM DISK @V2D4821 02168000
- ST R14,REGSAV SAVE R14 @V2D4821 02169000
- BAL R14,XNEXT CALL XNEXT TO DO THE WORK @V2D4821 02170000
- B XRDEOF @V2D4821 02171000
- RDMVC MVC INPLINE(80),8(R1) MOVE DATA INTO INPLINE @V2D4821 02172000
- * 02173000
- XREADA EQU * SECONDARY ENTRY POINT @V2D4821 02174000
- L R14,REGSAV RESTORE R14 @V2D4821 02175000
- B 4(,R14) AND RETURN TO CALLER @V2D4821 02176000
- * 02177000
- XRDEOF L R14,REGSAV RESTORE R14 @V2D4821 02178000
- LA R15,12 SET E-O-F RC @V2D4821 02179000
- BR R14 RETURN TO EOF @V2D4821 02180000
- SPACE 1 02181000
- XREADF FSREAD FSCB=INPFILE,ERROR=XREADR @V2D4821 02182000
- B 4(,R14) RETURN @V2D4821 02183000
- XREADR BR R14 @V2D4821 02184000
- EJECT 02185000
- * 02186000
- SPACE 2 02187000
- *************************************************************** 02188000
- ** 02189000
- ** XNEXT -- CHAIN TO NEXT LINE IN CORE 02190000
- ** WITHOUT MOVING THE CONTENTS 02191000
- ** 02192000
- ** CALL: 02193000
- ** BAL 14,XNEXT 02194000
- ** 02195000
- ** ACTION: 02196000
- ** SETS NEW VALUE OF READ POINTER (PTR2); 02197000
- ** 02198000
- ** EXIT: 02199000
- ** BR R14 IF E-O-F DETECTED 02200000
- ** B 4(,R14) NORMALLY 02201000
- ** 02202000
- ** 02203000
- *************************************************************** 02204000
- SPACE 1 02205000
- XNEXT EQU * @V2D4821 02206000
- L R15,PTR2 LOAD POINTER @V2D4821 02207000
- L R1,0(,R15) PTR TO NEXT ITEM @V2D4821 02208000
- LTR R1,R1 EOF? @V2D4821 02209000
- BZ XNEXT1 BRANCH IF SO @V2D4821 02210000
- ST R1,PTR2 SAVE NEW READ PTR @V2D4821 02211000
- B 4(,R14) @V2D4821 02212000
- SPACE 1 02213000
- XNEXT1 EQU * @V2D4821 02214000
- LR R1,R15 RETURN OLD PTR @V2D4821 02215000
- BR R14 RETURN EOF @V2D4821 02216000
- SPACE 2 02217000
- *************************************************************** 02218000
- ** 02219000
- ** XDELE--DELETE LINE FROM CORE 02220000
- ** 02221000
- ** INPUT-- 02222000
- ** R14--RETURN REGISTER 02223000
- ** PTR2-- POINTS TO LINE TO BE REMOVED 02224000
- ** 02225000
- ** OUTPUT-- 02226000
- ** MODIFIED LIST 02227000
- ** 02228000
- ** EXITS-- 02229000
- ** RETURN VIA R14 ONLY 02230000
- ** 02231000
- ** 02232000
- *************************************************************** 02233000
- SPACE 1 02234000
- XDELE EQU * @V2D4821 02235000
- ST R14,REGSAV SAVE RETURN @V2D4821 02236000
- L R1,PTR2 GR1=>DEL-1 @V2D4821 02237000
- L R1,4(,R1) BACKUP ONE @V2D4821 02238000
- ST R1,PTR2 UPDATE POINTER @V2D4821 02239000
- L R15,FPTR LOAD FREE-LIST POINTER @V2D4821 02240000
- L R2,0(,R1) GR2=>DEL @V2D4821 02241000
- L R14,SPARES NUMBER OF SPARES @V2D4821 02242000
- LA R14,1(,R14) ADD ONE @V2D4821 02243000
- ST R14,SPARES AND SAVE AS NEW VALUE @V2D4821 02244000
- L R14,0(,R2) NO, GR14=>DEL+1 @V2D4821 02245000
- ST R14,0(,R1) DEL-1=>DEL+1 @V2D4821 02246000
- LTR R14,R14 IS DEL+1=EOF @V2D4821 02247000
- BZ NOBKCHN YES, DON'T BACK-CHAIN EOF @V2D4821 02248000
- ST R1,4(,R14) NO, DEL-R1<=DEL+R1 @V2D4821 02249000
- NOBKCHN ST R15,0(,R2) DEL=>FREE-LIST @V2D4821 02250000
- ST R2,FPTR FPTR=>DEL @V2D4821 02251000
- B XREADA AND RETURN THROUGH 'XREAD' @V2D4821 02252000
- EJECT 02253000
- * SUBROUTINE TO RIGHT-JUSTIFY AND PAD WITH ZEROES AN EIGHT- 02254000
- * CHARACTER FIELD. ADJUSTED FOR EIGHT OR FIVE-DIGIT SERIALS. 02255000
- * 02256000
- JUSTIFY EQU * 02257000
- STM R0,R5,20(R13) SAVE REGS IN SAVE AREA 02258000
- LA R1,ACTVFLD SCAN THE ACTIVE PARAMETER 02259000
- LA R4,1(0,0) INCREMENT... 02260000
- LA R5,ACTVFLD+7 END OF SCAN 02261000
- LM R2,R3,CZEROES UNPACKED DECIMAL ZEROES 02262000
- JUSTLOP EQU * SCAN INPUT FIELD 02263000
- CLI 0(R1),X'40' STOP ON A BLANK 02264000
- BE JUSTEND 02265000
- CLI 0(R1),C'0' MUST BE VALID NUMERICS 02266000
- BL JUSTSET NO - SET TO ZERO 02267000
- CLI 0(R1),C'9' ...THIS IS UPPER LIMIT 02268000
- BNH JUSTNUM O.K. - LET IT PASS 02269000
- JUSTSET EQU * SET INVALID NUMERIC TO ZERO 02270000
- B INVCHAR INVALID CHAR IN SEQ. NUM P3059 02271000
- JUSTNUM EQU * CONTINUE WITH JUSTIFICATION 02272000
- SLDL R2,8(0) SHIFT LEFT ONE CHARACTER 02273000
- IC R3,0(0,R1) INSERT ONE LOW-ORDER 02274000
- BXLE R1,R4,JUSTLOP ADVANCE + CONTINUE 02275000
- JUSTEND EQU * R2,R3 NOW CONTAIN JUSTIFIED FIELD 02276000
- TM GLOBALS,SEQ8 EIGHT-DIGIT SEQUENCING ? 02277000
- BO *+8 YES - USE FULL FIELD 02278000
- SLDL R2,24(0) LEFT-JUSTIFY FIVE DIGITS FOR COMPARE 02279000
- STM R2,R3,ACTVFLD REPLACE INPUT FIELD 02280000
- LM R0,R5,20(R13) RESTORE REGS USED 02281000
- BR R14 RETURN TO CALLER 02282000
- EJECT 02283000
- * 02284000
- * SUBROUTINE TO SCAN OUT NEXT FIELD FROM UPDATE CONTROL CARD 02285000
- * 02286000
- SCANUPD EQU * SCAN FIELD FROM 'UPDLINE' 02287000
- LA R1,UPDLINE BUFFER START 02288000
- B NXTPARM 02289000
- SCANCTL EQU * SCAN FIELD FROM 'CTLBUFF' 02290000
- LA R1,CTLBUFF BUFFER START 02291000
- SPACE 02292000
- NXTPARM EQU * SCAN OUT BLANK-DELIMITED FIELDS 02293000
- STM R0,R4,20(R13) SAVE VOLATILE REGISTERS 02294000
- LR R4,R1 SAVE BUFFER START ADDRESS 02295000
- LA R3,SEQFELD-1(0,R1) LAST BYTE TO BE SCANNED 02296000
- LA R2,1(0,0) INCREMENT... 02297000
- L R1,80(0,R1) LAST SCANNED BYTE 02298000
- MVC ACTVFLD(9),BLANKS BLANK OUT FIELD P3059 02299000
- CLR R1,R3 ANYTHING LEFT TO SCAN ? 02300000
- BNL NXTPEND NO - HIT END OF LINE 02301000
- NBKSCAN EQU * SCAN TO NON-BLANK 02302000
- CLI 0(R1),X'40' 02303000
- BNE NBKFUND 02304000
- BXLE R1,R2,NBKSCAN ADVANCE + CONTINUE 02305000
- NXTPEND EQU * HIT END OF THE LINE 02306000
- LR R1,R4 RESTORE START ADDRESS 02307000
- ST R1,80(0,R1) RESET POINTERS TO BEGINNING 02308000
- NXTPCC1 EQU * SET CC = 1 02309000
- TM *+1,X'FF' SET COND. CODE ONE 02310000
- B NXTPCCX GO TO RETURN @VA01031 02311000
- NBKFUND EQU * FOUND NON-BLANK START OF FIELD 02312000
- LR R0,R1 REMEMBER WHERE WE ARE 02313000
- LA R1,1(0,R1) SKIP ONE CHARACTER 02314000
- BLKSCAN EQU * SCAN TO BLANK 02315000
- CLI 0(R1),X'40' 02316000
- BE BLKFUND 02317000
- BXLE R1,R2,BLKSCAN ADVANCE + CONTINUE 02318000
- BLKFUND EQU * FOUND END OF FIELD 02319000
- ST R1,80(0,R4) SAVE SCAN POINTER 02320000
- LR R2,R0 START OF FIELD 02321000
- SR R1,R0 FIELD LENGTH 02322000
- BNP NXTPCC1 SET CC = 1 02323000
- CH R1,=H'8' MAXIMUM LENGTH = 8 CHARACTERS 02324000
- BNH MVEPRM O.K. P3059 02325000
- LA R1,8 MOVE 9 CHARACTERS P3059 02326000
- EX R1,NXTPMVC TO ERROR FIELD P3059 02327000
- TM *,X'FF' SET COND. CODE FOUR @VA01031 02328000
- B NXTPCCX GO TO RETURN @VA01031 02329000
- MVEPRM EQU * P3059 02330000
- EX R1,NXTPMVC MOVE DATA TO 'ACTVFLD' 02331000
- CR R1,R1 SET CC = 0 02332000
- NXTPCCX EQU * @VA01031 02333000
- LM R0,R4,20(R13) RESTORE REGISTERS 02334000
- BR R14 02335000
- SPACE 02336000
- NXTPMVC MVC ACTVFLD(*-*),0(R2) MOVE FIELD TO BUFFER 02337000
- EJECT 02338000
- * SUBROUTINES TO TYPE OUT THE LAST CONTROL CARD AND PREVIOUS 02339000
- * CONTROL CARD FROM THE UPDATE FILE 02340000
- * NOTHING IS TYPED IF THE 'NOTERM' OPTION WAS SPECIFIED. 02341000
- CTLTYPE EQU * P3027 02342000
- LA R15,LASTCTLL POINT TO LAST CONTROL CARD P3027 02343000
- B CTL1 GO TO COMMON CODE P3027 02344000
- SPACE 1 02345000
- CTLPTYPE EQU * P3027 02346000
- LA R15,PREVCTLL POINT TO PREV CONTROL CARD P3027 02347000
- SPACE 1 02348000
- * COMMON CODE FOR THE TWO SUBROUTINES. 02349000
- CTL1 EQU * P3027 02350000
- TM GLOBALS,TERM IS 'TERM' IN EFFECT? 02351000
- BCR 8,R14 (BZ 0(R14)) JUST RETURN IF NOT 02352000
- STM R14,R5,LTSAVE SAVE MODIFIED REGISTERS 02353000
- LH R4,LASTCTLI-LASTCTLL(,R15) GET ITEM NUMBER OF THE P3027*02354000
- RECORD TO BE TYPED P3027 02355000
- LR R3,R15 POINT TO TEXT FOR LINE P3027 02356000
- LINEDIT TEXT=' ',DOT=NO 02357000
- LA R2,UPDFILE POINT TO UPDATE FILE FSCB 02358000
- B LINTYPEC ENTER LINTYPE CODE 02359000
- SPACE 3 02360000
- LASTCTLL DS CL80 BUFFER FOR LAST CONTROL CARD 02361000
- LASTCTLI DS H ITEM NUMBER FOR CONTROL CARD 02362000
- PREVCTLL DS CL80 PREVIOUS CONTROL CARD P3027 02363000
- PREVCTLI DS H ITEM NUMBER P3027 02364000
- LTSAVE DS 8F SAVE AREA 02365000
- EJECT 02366000
- * SUBROUTINE TO TYPE A LINE FROM A FILE ON THE TERMINAL. DOES NOT 02367000
- * TYPE IF 'NOTERM' HAS BEEN SPECIFIED. 02368000
- LINTYPE EQU * 02369000
- TM GLOBALS,TERM IS 'TERM' IN EFFECT? 02370000
- BCR 8,R14 (BZ 0(R14)) JUST RETURN IF NOT 02371000
- SPACE 02372000
- * ENTER HERE INSTEAD IF YOU WANT TO TYPE IT EVEN IF 'NOTERM' IS ON. 02373000
- LINTYPEF EQU * 02374000
- STM R14,R5,LTSAVE SAVE REGISTERS 02375000
- LR R2,R1 SAVE POINTER TO FSCB IN R2 02376000
- L R3,BUFF(,R2) POINT TO BUFFER OF FSCB 02377000
- LH R4,ITEM(,R2) LOAD LAST ITEM NUMBER 02378000
- SPACE 3 02379000
- * ENTER HERE FROM CTLTYPE CODE 02380000
- LINTYPEC EQU * 02381000
- LA R1,SHRTLEN ASSUME SHORT LENGTH MESSAGE 02382000
- CLC SEQFELD(8,R3),BLANKS BUT IS THERE A SEQUENCE FIELD? 02383000
- BE *+8 SKIP IF THERE IS NOT 02384000
- LA R1,LNGLEN OTHERWISE, MUST USE LONG MSG 02385000
- STC R1,LINTEXTL SET TEXT LENGTH FOR DMSERR 02386000
- LINEDIT TEXTA=LINTEXTL,RENT=NO, TYPE OUT LINE *02387000
- SUB=(CHAR8A,8(R2),DEC,(R4),CHARA,(R3),CHARA,SEQFELD(R3)) 02388000
- LM R14,R5,LTSAVE RESTORE REGISTERS 02389000
- BR R14 RETURN TO CALLER 02390000
- SPACE 5 02391000
- * TEXT FOR THE LINEDIT CALL 02392000
- LINTEXTL DC AL1(SHRTLEN) TEXT LENGTH 02393000
- LINTEXT DC C'FILE ''',20C'.',C''', REC # ......... = ',72C'.' 02394000
- SHRTLEN EQU *-LINTEXT LENGTH OF SHORT MESSAGE 02395000
- DC C' (........)' 02396000
- LNGLEN EQU *-LINTEXT LENGTH OF LONG MESSAGE 02397000
- DS 0H 02398000
- EJECT 02399000
- * SUBROUTINE TO TYPE AND PRINT THE ERROR MESSAGE IN ERRBUFF. IT IS 02400000
- * NOT PRINTED, HOWEVER, IF THE 'NOTERM' OPTION WAS SPECIFIED. 02401000
- BUFFOUT EQU * 02402000
- TM GLOBALS,TERM IS 'TERM' IN EFFECT? 02403000
- BZ BUFFOUTP GO PRINT IF NOT 02404000
- LINEDIT TEXTA=ERRBUFF,DISP=ERRMSG TYPE OUT ERROR MSG 02405000
- SPACE 02406000
- BUFFOUTP EQU * 02407000
- BAL R1,CLRLOGB CLEAR LOG FILE 02408000
- IC R1,ERRBUFF GET LENGTH OF ERROR MSG 02409000
- BCTR R1,0 GET (LENGTH-1) 02410000
- EX R1,BUFFMVE MOVE INTO LOG BUFFER 02411000
- BAL R15,LOGIT LOG THE LOG BUFFER 02412000
- BR R14 RETURN TO OUR CALLER 02413000
- SPACE 2 02414000
- BUFFMVE MVC LOGBUFF(0),ERRBUFF+1 LENGTH FILLED IN BY EX 02415000
- SPACE 02416000
- ERRBUFF DS 97X,0H 02417000
- EJECT 02418000
- * LOGGING SUBROUTINES 02419000
- SPACE 2 02420000
- * CLEAR THE LOG BUFFER 02421000
- CLRLOGB EQU * 02422000
- MVI LOGBUFF,C' ' 02423000
- MVC LOGBUFF+1(95),LOGBUFF CLEAR THE LOG BUFFER 02424000
- BR R1 RETURN TO CALLER 02425000
- SPACE 5 02426000
- * SUBROUTINE TO LOG A LINE ONTO THE LOG FILE. 02427000
- LOGIT EQU * 02428000
- STM R14,R5,LOGSAVE SAVE IMPORTANT REGISTERS 02429000
- BAL R2,CHKTITL CHECK FOR PAGE OVERFLOW 02430000
- LA R3,LOGBUFF-1 POINT TO LOG BUFFER 02431000
- BAL R2,LOGOUT PUT LINE INTO LOG FILE 02432000
- LM R14,R5,LOGSAVE RESTORE REGS 02433000
- BR R15 RETURN TO CALLER 02434000
- SPACE 2 02435000
- LOGSAVE DS 8F 02436000
- SPACE 1 02437000
- *************************************************************** 02438000
- * 02439000
- * XCLOSE IS A SUBROUTINE WHICH SETS THE TOP LINE AS THE 02440000
- * CURRENT LINE. 02441000
- * 02442000
- * CALL: 02443000
- * BAL 14,XCLOSE 02444000
- * 02445000
- * 02446000
- *************************************************************** 02447000
- SPACE 1 02448000
- XCLOSE EQU * @V2D4821 02449000
- TM UPDFLAG,INCOR IS CMSUT1 IN-CORE ??? @V2D4821 02450000
- BNO 0(,R14) NO, IGNORE THIS CALL @V2D4821 02451000
- LA R1,PTR1 POINT TO 'TOP' OF FILE @V2D4821 02452000
- ST R1,PTR2 RESET READ POINTER @V2D4821 02453000
- BR R14 AND RETURN TO CALLER @V2D4821 02454000
- EJECT 02455000
- ************** 02456000
- * 02457000
- * CORINIT IS A SUBROUTINE WHICH INITIALIZES CORE. 02458000
- * 02459000
- * 1. COMPUTES NO. OF BYTES REQUIRED PER LINE (CORITE 02460000
- * 2. CALLS GETMAIN 02461000
- * 3. COMPUTES NUMBER OF LINES WE CAN FIT IN (SPARES) 02462000
- * 02463000
- * CALL: 02464000
- * BAL R8,CORINIT 02465000
- * 02466000
- * 02467000
- ************** 02468000
- SPACE 1 02469000
- CORINIT EQU * @V2D4821 02470000
- L R0,FFREE ALLOW 5K FOR STACKING & CMS IO @V2D4821 02471000
- DMSFREE DWORDS=(0),ERR=*,MIN=1 @V2D4821 02472000
- LR R2,R1 SAVE STORAGE LOCATION @V2D4821 02473000
- ST R0,FFREE AND NO. DBLWDS OBTAINED @V2D4821 02474000
- GETMAIN VC,LA=LIMITS,A=FREEAD GET ALL WE CAN @V2D4821 02475000
- LR R1,R2 RESTORE STORAGE LOACTION @V2D4821 02476000
- L R0,FFREE AND NO. DBLWDS OBTAINED @V2D4821 02477000
- DMSFRET DWORDS=(0),LOC=(1) GIVE BACK STACKING STORAGE @V2D4821 02478000
- MVC AEXTEND(4),FREEAD @V2D4821 02479000
- L R15,FREELEN @V2D4821 02480000
- SR R14,R14 ZERO FOR DIVIDE @V2D4821 02481000
- D R14,CORITEM NO. OF LINES WE CAN HANDLE @V2D4821 02482000
- ST R15,SPARES SAVE AS SPARES @V2D4821 02483000
- BR R8 RETURN @V2D4821 02484000
- EJECT 02485000
- * SUBROUTINE TO CHECK FOR PAGE OVERFLOW, AND TO PUT A TITLE LINE 02486000
- * INTO THE LOG FILE IF IT OCCURS. 02487000
- CHKTITL EQU * 02488000
- L R1,CURRLINE GET CURRENT LINE NUMBER 02489000
- LA R1,1(,R1) INCREMENT 02490000
- ST R1,CURRLINE 02491000
- C R1,=A(MAXLINE) IS IT LARGER THAN MAX? 02492000
- BCR 13,R2 (BNL 0(R2)) JUST RETURN IF NOT 02493000
- SPACE 02494000
- * OTHERWISE, WE MUST TYPE OUT A TITLE LINE. 02495000
- LA R1,2 RESET LINE NUMBER TO 2 02496000
- ST R1,CURRLINE 02497000
- MVI LOGBCTL,C'0' FORCE NEXT LINE TO DOUBLE SPACE 02498000
- L R1,CURRPAGE INCREMENT PAGE COUNT 02499000
- LA R1,1(,R1) 02500000
- ST R1,CURRPAGE 02501000
- SPACE 02502000
- LINEDIT DISP=NONE,BUFFA=TITLBUFF,TEXTA=TITLEDIT,RENT=NO, *02503000
- DOT=NO,COMP=NO, *02504000
- SUB=(CHAR8A,INPFILE+8,CHAR8A,UPDFILE+8,DECA,CURRPAGE) 02505000
- LA R3,TITLBUFF+1 POINT TO TITLE BUFFER 02506000
- B LOGOUT AND PUT IT INTO LOG BUFFER 02507000
- SPACE 3 02508000
- TITLEDIT DC AL1(97) LENGTH OF BUFFER 02509000
- DC C'1UPDATING ''',20C'.',C''' WITH ''',20C'.',C'''' 02510000
- BLCOUNT EQU 98-25-(*-TITLEDIT) 25 = L'TITUP 02511000
- DC (BLCOUNT)C' ' PAD WITH BLANKS 02512000
- TITUP DC C'UPDATE LOG -- PAGE ......' 02513000
- SPACE 02514000
- TITLBUFF DS AL1(97),C'1',CL96 02515000
- LOGBCTL DC C' ' CONTROL CHAR IS BLANK 02516000
- LOGBUFF DS CL96 02517000
- SPACE 02518000
- BLANKS DC CL97' ' 02519000
- SPACE 02520000
- CURRLINE DC A(MAXLINE) CURRENT LINE NUMBER 02521000
- CURRPAGE DC F'0' CURRENT PAGE NUMBER 02522000
- MAXLINE EQU 60 MAXIMUM LINE NUMBER BEFORE OVFL 02523000
- EJECT 02524000
- * SUBROUTINE TO DO THE ACTUAL READBUF OR PRINTING 02525000
- LOGOUT EQU * 02526000
- TM GLOBALS,DISK IS 'DISK' IN EFFECT, OR 'PRINT'? 02527000
- BO LOGOUTD GO IF 'DISK' 02528000
- SPACE 02529000
- PRINTL (R3),97,ERROR=RETRY @VA03253 02530000
- B LOGOUTX GO FINISH UP 02531000
- RETRY EQU * @VA03253 02532000
- CH R15,=H'2' IS IT 12 PUNCH? @VA03253 02533000
- BE RESTART @VA03253 02534000
- CH R15,=H'3' IS IT 9 PUNCH? @VA03253 02535000
- BE RESTART @VA03253 02536000
- BNE LOGOUTX NO, GET OUT @VA03253 02537000
- RESTART MVI 0(R3),C'+' SUPPRESS SPACE @VA03253 02538000
- PRINTL (R3),97 RETRY @VA03253 02539000
- MVI 0(R3),C' ' RESTORE SINGLE SPACE @VA03253 02540000
- B LOGOUTX RETURN @VA03253 02541000
- SPACE 02542000
- LOGOUTD EQU * 02543000
- FSWRITE FSCB=LOGFILE,BUFFER=(R3),BSIZE=97,ERROR=OUTERR 02544000
- SPACE 2 02545000
- * A KLUDGE: IF WE DOUBLE-SPACED, THEN WE CHANGE CTL CHAR FROM '0' TO 02546000
- * BLANK. 02547000
- LOGOUTX EQU * 02548000
- CLI 0(R3),C'0' DID WE DOUBLE-SPACE? 02549000
- BNE *+8 SKIP IF NOT 02550000
- MVI 0(R3),C' ' RESET TO BLANK 02551000
- BR R2 RETURN TO CALLER 02552000
- EJECT 02553000
- * SUBROUTINE TO CLOSE THE LOG FILE 02554000
- LOGCLOSE EQU * 02555000
- CLC CURRPAGE,=F'0' ANYTHING WRITTEN OUT? 02556000
- BCR 8,R14 (BE 0(R14)) JUST RETURN IF NOT 02557000
- STM R14,R5,LOGSAVE SAVE REGS 02558000
- TM GLOBALS,DISK ARE WE LOGGING TO DISK? 02559000
- BO LOGCLD GO IF WE ARE 02560000
- SPACE 02561000
- * OTHERWISE, WE CLOSE THE PRINTER, SPECIFYING A NAME OF 'FNAME UPDLOG' 02562000
- LINEDIT DISP=CPCOMM,DOT=NO, *02563000
- SUB=(CHAR8A,LOGFILE+8), *02564000
- TEXT='CLOSE PRT NAME .................' 02565000
- B LOGCLC GO RETURN 02566000
- SPACE 02567000
- LOGCLD EQU * 02568000
- FSCLOSE FSCB=LOGFILE CLOSE THE LOG DISK FILE 02569000
- SPACE 02570000
- LOGCLC EQU * 02571000
- LM R14,R5,LOGSAVE RESTORE REGS 02572000
- BR R14 RETURN TO CALLER 02573000
- EJECT 02574000
- * 02575000
- * DATA AREAS, CONSTANTS, STATUS CONTROL, CMS P-LISTS 02576000
- * 02577000
- REPSCAN DS F SCAN SAVE FOR 'REPLACE' FUNCTION 02578000
- SPACE 02579000
- DS 0D 02580000
- SEQSTRT DC CL8'00000000' START SEQ. FOR FUNCTION 02581000
- SEQLAST DC CL8'00000000' ENDNG SEQ. FOR FUNCTION 02582000
- SEQPOSN DC CL8'00000000' FILE POSITION 02583000
- SEQNEXT DC CL8'00000000' NEXT RE-SEQUENCE FIELD 02584000
- ISEQLAST DC CL8'00000000' LAST INPUT FILE SEQUENCE NUMBER 02585000
- OSEQLAST DC CL8'00000000' LAST OUTPUT FILE SEQUENCE NUMBER 02586000
- CORITEM DC F'88' TOTAL ITEM LENGTH IN-CORE @V2D4821 02587000
- FFREE DC F'650' 15K WORTH OF DOUBLE WDS. @V2D4821 02588000
- LIMITS DC F'88' LOWER LIMIT FOR GETMAIN @V2D4821 02589000
- DC X'00FFFFF8' MAX. 16 MEG MACHINE @VA05026 02590000
- FREEAD DC A(0) ADDRESS OF GETMAINED STORAGE @V2D4821 02591000
- FREELEN DC F'0' LENGTH OF GETMAINED STORAGE @V2D4821 02592000
- FPTR DC A(0) START OF FREELIST CHAIN @V2D4821 02593000
- PTR1 DC A(0,0) 'TOP' POINTER @V2D4821 02594000
- PTR2 DC A(PTR1) POINTER TO CURRENT LINE @V2D4821 02595000
- AEXTEND DC A(0) CURRENT LIMIT OF EXTEND @V2D4821 02596000
- SPARES DC F'0' NUMBER OF AVAILABLE LINES LEFT IN CH@V2D4821 02597000
- REGSAV DS 1F REGISTER SAVE AREA @V2D4821 02598000
- SEQFOLD DC PL5'0' NEXT RE-SEQUENCE FIELD VALUE 02599000
- SEQINCR DC PL5'10' RE-SEQUENCE INCREMENT 02600000
- SEQLABL DC CL3'000' THREE-CHAR SEQUENCE ID FIELD 02601000
- SEQFELD EQU 72 SEQUENCE = COLS. 73-80 02602000
- SPACE 02603000
- DC C'* ' MUST PRECEDE 'UPLEVEL' 02604000
- UPLEVEL DC CL5' ' HIGHEST-LEVEL UPDATE APPLIED 02605000
- DFLEVEL DC CL5'TEXT ' CURRENT LEVEL BEING EXAMINED 02606000
- SPACE 02607000
- DS 0F 02608000
- CZEROES DC CL8'00000000' CONSTANT ZEROES FIELD 02609000
- FNAME DS CL8 FILENAME 02610000
- UPDNEXT DC CL8'00000000' NEXT SEQUENCE FIELD FOR UPDATE P3059 02611000
- ACTVFLD DC CL8' ' ACTIVE CONTROL CARD FIELD P3059 02612000
- DC CL1' ' FOR OVERFLOW WHEN TOO MANY CHAR P3059 02613000
- SPACE 2 02614000
- UPDSTRT DC PL5'0' START FOR GENERATING SEQUENCE ON UPDATES 02615000
- UPDINCR DC PL5'1000' GENERATION INCREMENT 02616000
- PAKZERO DC PL5'0' CONSTANT DECIMAL ZERO 02617000
- SEQMAX DC P'100000000' MAX SEQUENCE NUMBER P3027 02618000
- UPDCODE DC C' ' FUNCTION-CODE CHARACTER (I,R,S,D) 02619000
- SPACE 02620000
- DS 0F 02621000
- UPDLINE DC CL80' ',A(UPDLINE) CONTROL BUFFER 02622000
- INPLINE DC CL80' ' SOURCE INPUT BUFFER 02623000
- CTLBUFF DC CL80' ',A(CTLBUFF) CNTRL FILE BUFFER 02624000
- SPACE 02625000
- NOINTS DC X'00' SSM FOR NO EXTRANEOUS INTERRUPTS @VM03093 02626000
- SPACE 02627000
- DC C'* ' MUST PRECEDE 'CTLMACS' 02628000
- CTLMACS DC CL72' ' SAVE BUFFER FOR 'MACS' RECORD 02629000
- SPACE 02630000
- ITEM EQU 26 DISP. IN P-LIST + FST TO ITEM NUMBER 02631000
- BUFF EQU 28 02632000
- EJECT 02633000
- * 'GLOBALS' AND 'UPDFLAG' FLAG BYTES 02634000
- SPACE 02635000
- GLOBALS DC X'00' 02636000
- SPACE 02637000
- UPDN EQU X'80' AN UPDATE HAS BEEN DONE 02638000
- SEQ8 EQU X'40' EIGHT-DIGIT SEQUENCE FIELDS 02639000
- CTLF EQU X'20' CONTROL FILE OPTION WAS SPEC'D 02640000
- INCL EQU X'10' 'INCLUDE' SEQ #'S FROM UPDATES 02641000
- NSTK EQU X'08' DO NOT STACK MULTI-LEVEL RESULTS 02642000
- DISK EQU X'04' UPDATE LOG ON DISK (NOT PRINTED) 02643000
- REPL EQU X'02' 'REPLACE' OPTION SPECIFIED 02644000
- TERM EQU X'01' WARNING MESSAGES TO TERMINAL 02645000
- SPACE 2 02646000
- UPDFLAG DC X'00' 02647000
- SPACE 02648000
- RSEQ EQU X'80' RESEQUENCE THE OUTPUT FILE 02649000
- SGEN EQU X'40' GENERATE SEQ FIELDS FOR UPDATES 02650000
- AUXF EQU X'20' WORKING WITH AUXILIARY FILE 02651000
- DELT EQU X'10' DELETE FUNCTION NOW IN PROGRESS 02652000
- FULL EQU X'08' BUFFER CONTAINS DATA IN LIMBO 02653000
- INCOR EQU X'04' PROCESS CMSUT1 FILE IN-CORE @V2D4821 02654000
- TAIL EQU X'02' PROCESSING NORMAL EOF ON INPUT 02655000
- FULI EQU X'01' LAST BUFFER LINE FROM INPUT FILE 02656000
- SPACE 1 02657000
- UPDFLAG2 DC X'00' @V2D4821 02658000
- SPACE 2 02659000
- * FLAG DOSF IS USED TO SAVE THE CONTENTS OF THE DOS SIMULATION FLAGS 02660000
- * LOCATED IN NUCON. 02661000
- DOSF DS X @V305066 02662000
- SPACE 2 02663000
- RC28 EQU 28 RETURN CODE = 28 @V305066 02664000
- SPACE 1 02665000
- FINISH EQU X'01' @V2D4821 02666000
- EJECT 02667000
- * FSCB'S FOR ALL FILES 02668000
- SPACE 02669000
- * FSCB FOR INPUT FILE 02670000
- INPFILE FSCB 'FNAME ASSEMBLE',BUFFER=INPLINE,BSIZE=80 02671000
- INPPTRS DS 2A POINTERS TO ADT AND FST 02672000
- SPACE 02673000
- * FSCB FOR UPDATE FILE 02674000
- UPDFILE FSCB '$FNAME UPDATE',BUFFER=UPDLINE,BSIZE=80 02675000
- UPDPTRS DS 2A POINTERS TO ADT AND FST 02676000
- SPACE 02677000
- * FSCB FOR UTILITY FILE 02678000
- UT1FILE FSCB 'UPDATE CMSUT1',BUFFER=INPLINE,BSIZE=80 02679000
- SPACE 02680000
- * FSCB FOR LOG-TO-DISK FILE 02681000
- LOGFILE FSCB 'FNAME UPDLOG',BUFFER=LOGBUFF,BSIZE=96 02682000
- SPACE 02683000
- * FSCB FOR 'FNAME UPDATES' FILE 02684000
- UPSFILE FSCB 'FNAME UPDATES',BSIZE=80 02685000
- SPACE 02686000
- * FSCB FOR CONTROL FILE 02687000
- CTLFILE FSCB 'FNAME CNTRL',BUFFER=CTLBUFF,BSIZE=80 02688000
- CTLPTRS DS 2A POINTERS TO ADT AND FST 02689000
- SPACE 02690000
- * FSCB FOR AUXILIARY FILE 02691000
- AUXFILE FSCB 'FNAME AUX....',BUFFER=CTLBUFF,BSIZE=80 02692000
- AUXPTRS DS 2A POINTERS TO ADT AND FST 02693000
- SPACE 02694000
- PTRS EQU INPPTRS-INPFILE 02695000
- PADT EQU PTRS 02696000
- PFST EQU PTRS+4 02697000
- FTSAVE DC CL8' ' FOR PREFERRED AUXFILE @V60C5CC 02698000
- LISTMARK EQU X'FE' MARKS AVAILABLE AUXFILE SLOT @V60C5CC 02699000
- LISTADR DC F'0' AUXFILE LIST ADDRESS @V60C5CC 02700000
- RENAME DS 0D RENAME CMSUT1 FILE 02701000
- DC CL8'RENAME' 02702000
- DC CL8'UPDATE',CL8'CMSUT1',CL8'A1' 02703000
- NEWNAME DC CL8'*-*',CL8'ASSEMBLE',CL8'A1' 02704000
- FENCED DC 2F'-1' CONSTANT = 8X'FF' 02705000
- SPACE 02706000
- EJECT 02707000
- STACKER DS 0D STACK A CONSOLE LINE 02708000
- DC CL8'ATTN' 02709000
- DC CL4'LIFO',AL1(74),AL3(CTLMACS-2) 02710000
- SPACE 02711000
- DTSTAMP DS 0D DATE + TIME STAMP A FILE 02712000
- DC 2CL8'*-*',CL8'A1' FILE TO BE RECORDED 02713000
- DTFNAME DC CL8'*-*',CL8'UPDATES',CL8'A1' 02714000
- DC 2F'-1' 02715000
- EJECT 02716000
- LTORG 02717000
- SPACE 2 02718000
- DS 0D CORRECT ALIGNMENT FROM HERE ON 02719000
- EJECT 02720000
- * WE TYPE OUT A MESSAGE INDICATING THE PROBLEM. 02721000
- WOVF EQU * 02722000
- ST R14,WOVF14 SAVE REG 14 02723000
- ST R0,WOVF0 SAVE REG 0 P3027 02724000
- BAL R14,CTLTYPE TYPE LAST UPDATE CONTROL CARD 02725000
- DMSERR DISP=NONE,BUFFA=ERRBUFF,NUM=176,LET=W, *02726000
- SUB=(CHARA,(R0)), P3027*02727000
- TEXT='SEQUENCING OVERFLOW FOLLOWING SEQ NUMBER ''.......*02728000
- .''' 02729000
- BAL R14,BUFFOUT GO TYPE AND PRINT MESSAGE 02730000
- WARN 8 SET RETURN CODE TO 8 02731000
- L R14,WOVF14 RESTORE REG 14 02732000
- BR R14 RETURN TO CALLER 02733000
- SPACE 02734000
- WOVF14 DS A SAVE REG 14 02735000
- WOVF0 DS A P3027 02736000
- EJECT 02737000
- * ABORT ERROR MESSAGES 02738000
- SPACE 02739000
- NOFNAME EQU * 02740000
- DMSERR NUM=1,LET=E,TEXT='NO FILENAME SPECIFIED' 02741000
- MVI RC,24 02742000
- B ERETURN 02743000
- SPACE 3 02744000
- EXCESIV EQU * 02745000
- DMSERR NUM=70,LET=E,SUB=(CHARA,(R2)), *02746000
- TEXT='INVALID PARAMETER ''........''' 02747000
- MVI RC,24 02748000
- B ERETURN 02749000
- SPACE 3 02750000
- BADMODE EQU * 02751000
- DMSERR NUM=48,LET=E,SUB=(CHARA,(R2)), *02752000
- TEXT='INVALID MODE ''........''' 02753000
- MVI RC,24 02754000
- B ERETURN 02755000
- SPACE 3 02756000
- ERCMSUT EQU * 02757000
- DMSERR NUM=24,LET=E,SUB=(CHAR8A,UT1FILE+8), *02758000
- TEXT='FILE ''....................'' ALREADY EXISTS' 02759000
- MVI RC,RC28 RETURN CODE @V305066 02760000
- B ERETURN 02761000
- SPACE 3 02762000
- FMTERR EQU * 02763000
- DMSERR NUM=7,LET=E,SUB=(CHAR8A,8(R2)), *02764000
- TEXT='FILE ''....................'' IS NOT FIXED, 80 CHA*02765000
- R. RECORDS' 02766000
- MVI RC,32 02767000
- B ERETURN 02768000
- SPACE 3 02769000
- NOFILE EQU * 02770000
- DMSERR NUM=2,LET=E,SUB=(CHAR8A,8(R2)), *02771000
- TEXT='FILE ''....................'' NOT FOUND' 02772000
- MVI RC,28 02773000
- B ERETURN 02774000
- SPACE 3 02775000
- NOFILEW EQU * 02776000
- DMSERR NUM=180,LET=W,SUB=(CHAR8A,8(R2)), *02777000
- TEXT='MISSING PTF FILE ''....................''' 02778000
- WARN 12 02779000
- B AUXREAD 02780000
- SPACE 3 02781000
- INPERR EQU * 02782000
- LR R2,R1 SAVE POINTER TO PLIST 02783000
- LR R3,R15 SAVE RETURN CODE 02784000
- DMSERR NUM=104,LET=S,RENT=NO, *02785000
- SUB=(DEC,(R3),CHAR8A,8(R2)), *02786000
- TEXT='ERROR ''.........'' READING FILE ''...............*02787000
- .....''' 02788000
- MVI RC,100 02789000
- B ERETURN 02790000
- SPACE 3 02791000
- OUTERR EQU * 02792000
- LR R2,R1 SAVE PLIST POINTER 02793000
- LR R3,R15 SAVE WRBUF RETURN CODE 02794000
- DMSERR NUM=105,LET=S,RENT=NO, *02795000
- SUB=(DEC,(R3),CHAR8A,8(R2)), *02796000
- TEXT='ERROR ''.........'' WRITING FILE ''...............*02797000
- .....''' 02798000
- MVI RC,100 02799000
- B ERETURN 02800000
- SPACE 3 02801000
- ERMACS EQU * 02802000
- DMSERR NUM=179,LET=E,SUB=(CHAR8A,CTLFILE+8), *02803000
- TEXT='MISSING OR DUPLICATE ''MACS'' CARD IN CONTROL FILE*02804000
- ''....................''' 02805000
- MVI RC,32 02806000
- B ERETURN 02807000
- SPACE 3 02808000
- NOUPDATS EQU * 02809000
- DMSERR NUM=181,LET=E,TEXT='NO UPDATE FILES WERE FOUND' 02810000
- MVI RC,40 RETURN CODE = 40 02811000
- B ERETURN 02812000
- SPACE 3 02813000
- INVOPTN EQU * 02814000
- DMSERR NUM=3,LET=E,SUB=(CHARA,(R2)), *02815000
- TEXT='INVALID OPTION ''........''' 02816000
- MVI RC,24 02817000
- B ERETURN 02818000
- SPACE 3 02819000
- OPTDUP EQU * 02820000
- DMSERR NUM=65,LET=E,SUB=(CHARA,(R7)), *02821000
- TEXT='''........'' OPTION SPECIFIED TWICE' 02822000
- MVI RC,24 02823000
- B ERETURN 02824000
- SPACE 3 02825000
- OPTCONF EQU * 02826000
- DMSERR NUM=66,LET=E,RENT=NO, *02827000
- SUB=(CHARA,(R4),CHARA,(R7)), *02828000
- TEXT='''........'' AND ''........'' ARE CONFLICTING OPTI*02829000
- ONS' 02830000
- MVI RC,24 02831000
- B ERETURN 02832000
- SPACE 3 02833000
- ERRW EQU * 02834000
- DMSERR NUM=37,LET=E,TEXT='DISK ''A'' IS READ/ONLY' 02835000
- MVI RC,36 RETURN CODE IS 36 02836000
- B ERETURN 02837000
- SPACE 3 02838000
- ERRMSG36 EQU * @VA12416 02838500
- LA R0,24(R2) POINT TO MODE LETTER @VA14398 02838600
- B ERRMS36A @VA14398 02838700
- NOTACCER EQU * P3059 02839000
- LA R0,=C'A' POINT TO MODE LETTER @VA14398 02840000
- ERRMS36A EQU * @VA14398 02840500
- DMSERR TEXT='DISK ".." NOT ACCESSED',NUM=69, @VA14398X02841000
- LET=E,SUB=(CHARA,((R0),1)) @VA14398 02841500
- MVI RC,36 RETURN CODE @VA12416 02842000
- B ERETURN RETURN TO CALLER P3059 02843000
- SPACE 2 02844000
- ERSC EQU * 02845000
- DMSERR NUM=187,LET=E, *02846000
- TEXT='OPTION ''STK'' INVALID WITHOUT ''CTL''' 02847000
- MVI RC,24 02848000
- B ERETURN 02849000
- EJECT 02850000
- * BAD CONTROL FILE CARD OR AUXILIARY FILE CARD. 02851000
- BADCTLC EQU * 02852000
- LA R1,CTLFILE POINT TO CONTROL FILE FSCB 02853000
- LA R2,=CL7'CONTROL' FOR ERROR MESSAGE BELOW 02854000
- B BADCARD GO TYPE MESSAGES 02855000
- SPACE 02856000
- BADAUXC EQU * 02857000
- LA R1,AUXFILE POINT TO AUX FILE FSCB 02858000
- LA R2,=CL7'AUX' FOR ERROR MESSAGE BELOW 02859000
- SPACE 2 02860000
- BADCARD EQU * 02861000
- BAL R14,LINTYPEF TYPE OUT LINE OF FILE 02862000
- DMSERR NUM=183,LET=E,SUB=(CHARA,(R2)), *02863000
- TEXT='INVALID ....... FILE CONTROL CARD' 02864000
- MVI RC,32 RETURN CODE = 32 02865000
- B ERETURN 02866000
- SPACE 1 02867000
- SMALLCOR DMSERR NUM=300,LET=E,TEXT='INSUFFICIENT STORAGE TO BEGIN UPDATX02868000
- E' @V2D4821 02869000
- NI UPDFLAG,255-INCOR RESET IN-CORE FLAG @V2D4821 02870000
- L R3,CKCOR CHECK FOR EXPLICIT INCORE OPTION @V2D4821 02871000
- CLI 0(R3),C'S' WAS IT??? @V2D4821 02872000
- BNE IMPLICIT NO... JUST 'CTL' , DO UPDATE ON DISK @V2D4821 02873000
- MVI RC,41 SET RETURN CODE @VA04473 02874000
- B ERETURN @V2D4821 02875000
- SPACE 1 02876000
- IMPLICIT DMSERR NUM=304,LET=I,TEXT='UPDATE PROCESSING WILL BE DONE USINX02877000
- G DISK' @V2D4821 02878000
- B SLOPPY DO UPDATE USING DISK @V2D4821 02879000
- SPACE 2 02880000
- CORBUST DMSERR NUM=299,LET=E,TEXT='INSUFFICIENT STORAGE TO COMPLETE UP*02881000
- DATE' @V2D4821 02882000
- MVI RC,41 SET RETURN CODE @VA04473 02883000
- B ERETURN @V2D4821 02884000
- EJECT 02885000
- LTORG 02886000
- EJECT 02887000
- REGEQU 02888000
- NUCON 02889000
- FSTB 02890000
- ADT 02891000
- FVS HRC015DS 02891100
- SPACE 2 02892000
- LTORG 02893000
- END DMSUPD 02894000
ibm/vm370-lib/cms/dmsupd.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator