RNM TITLE 'DMSRNM (CMS) VM/370 - RELEASE 6' 00001000 * 00004000 * MODULE NAME: 00005000 * 00006000 * DMSRNM (RENAME) 00007000 * 00008000 * FUNCTION: 00009000 * 00010000 * RENAME COMMAND. CHANGES THE FILEID OF THE SPECIFIED 00011000 * FILE. 00012000 * 00013000 * ATTRIBUTES: 00014000 * 00015000 * TRANSIENT 00016000 * NOTE: RENAME MUST BE GENMOD'D WITH THE SYSTEM OPTION 00016100 * 00017000 * ENTRY POINTS: 00018000 * 00019000 * DMSRNM - SEE FUNCTION DESCRIPTION 00020000 * 00021000 * ENTRY CONDITIONS: 00022000 * 00023000 * RENAME - GPR1 = A(PLIST) 00024000 * GPR14 = RETURN ADDRESS 00025000 * GPR15 = A(CALLED ROUTINE) 00026000 * PLIST = CL8 - CALLED ROUTINE 00027000 * CL8 - OFILENAME|* 00028000 * CL8 - OFILETYPE|* 00029000 * CL8 - OFILEMODE|* 00030000 * CL8 - NFILENAME|= 00031000 * CL8 - NFILETYPE|= 00032000 * CL8 - NFILEMODE|= 00033000 * CL8 - '(' - START OF OPTIONS, IF ANY 00034000 * 00035000 * OPTIONAL AND IN ANY ORDER (DEFAULTS APPEAR FIRST): 00036000 * CL8'NOTYPE'|'TYPE' 00037000 * CL8'UPDIRT'|'NOUPDIRT' 00038000 * 00039000 * XL8 - FENCE 00040000 * 00041000 * EXIT CONDITIONS: 00042000 * 00043000 * NORMAL - 00044000 * 00045000 * GPR15 = 0 : THE FILE ID IS CHANGED AS SPECIFIED. 00046000 * 00047000 * ERROR - 00048000 * 00049000 * GPR15 = XXX: 00050000 * 28 FILE NOT FOUND 00051000 * 28 NEW SPECIFIED FILE ALREADY EXISTS 00052000 * 24 INVALID MODE 00053000 * 28 IDENTICAL FILEIDS 00054000 * 24 MODE CHANGE NOT ALLOWED 00055000 * 36 DISK NOT READ/WRITE 00056000 * 36 TARGET DISK NOT ACCESSED @VA12416 00056500 * 24 INCOMPLETE FILEID 00057000 * 28 SPECIFIED FILE IS ACTIVE 00058000 * 24 INVALID OPTION 00059000 * 00060000 * CALLS TO OTHER ROUTINES - 00061000 * 00062000 * DMSLAFP - SEARCHES THE ACTIVE FILE TABLE 00063000 * 00064000 * DMSLFSW - SEARCHES FOR THE SPECIFIED FILE STATUS 00065000 * TABLE ENTRY. 00066000 * 00067000 * DMSLADP - FIND THE ACTIVE DISK TABLE BLOCK WHOSE MODE 00068000 * MATCHES. 00069000 * 00070000 * DMSFNSC - TO TEMPORARILY CLOSE A GIVEN FILE OR ACTIVE 00071000 * DISK TABLE FOR THE PURPOSE OF UPDATING THE 00072000 * FILE DIRECTORY. 00073000 * 00074000 * DMSAUDK - TO RESERVE SPACE ON DISK FOR REWRITING A 00075000 * NEW COPY OF THE USER FILE DIRECTORY ON 00076000 * DISK, AND THEN TO UPDATE THE UFD ON DISK. 00077000 * 00078000 * EXTERNAL REFERENCES - 00079000 * 00080000 * SYSREF - TABLE OF CMS ADDRESS CONSTANTS 00081000 * FVSECT - FIXED/VARIABLE STORAGE 00082000 * AFTSECT- ACTIVE FILE TABLE BLOCK 00083000 * ADTSECT- ACTIVE DISK TABLE BLOCK 00084000 * FSTSECT- FILE STATUS TABLE (FILE DIRECTORY) BLOCK 00085000 * 00086000 * TABLES / WORKAREAS - 00087000 * 00088000 * SEE EXTERNAL REFERENCES 00089000 * 00090000 * REGISTER USAGE - 00091000 * 00092000 * GPR1 = A(PLIST), A(ADTSECT), A(AFTSECT) 00093000 * GPR12= ADDRESSABILITY 00094000 * GPR2= A(PLIST) 00095000 * GPR13= A(FVSECT) 00096000 * 00097000 * NOTES: 00098000 * 00099000 * | RENAME IS TREATED AS A "COMMAND" OR A "FUNCTION" 00099100 * | ACCORDING TO THE HIGH-ORDER BYTE OF R1 AT INPUT, VIZ: 00099200 * | IF = X'0C', IT WAS ISSUED AS A COMMAND FROM DMSINT. 00099300 * | IF = X'0D', IT WAS ISSUED FROM AN EXEC FILE (DMSEXT), 00099400 * | WITH "&CONTROL" SET TO EITHER "CMS" OR "ALL". 00099500 * | IF = X'0E', IT WAS ISSUED FROM AN EXEC FILE (DMSEXT), 00099600 * | WITH "&CONTROL OFF" IN EFFECT. 00099700 * | IF < X'0C' OR > X'0E', IT IS ASSUMED TO BE A FUNCTION. 00099800 * 00099900 * | IF DMSERS IS CALLED AS A FUNCTION, THERE IS NO CHECK FOR 00100000 * | THE "(TYPE" OPTION, AND ALL ERROR MESSAGES ARE OMITTED. 00100100 * 00100200 * | ALSO, IF RENAME IS CALLED FROM EXEC WITH "&CONTROL OFF" IN 00100300 * | EFFECT, THE "FILE NOT FOUND" ERROR MESSAGE IS OMITTED. 00100400 * 00101000 * OPERATION: 00102000 * 00103000 * RENAME CHECKS THE PARAMETER LIST FOR VARIOUS TYPES OF 00104000 * ERRORS, AND GIVES ERROR RETURNS, WITH MESSAGES, FOR 00105000 * ANY ERROR DETECTED. 00106000 * 00107000 * ONLY READ-WRITE DISK(S) ARE CHECKED FOR THE FILES 00108000 * SPECIFIED; READ-ONLY DISKS ARE IGNORED. 00109000 * 00110000 * WHEN THE PARAMETER LIST HAS BENN CHECKED AND 00111000 * APPROPRIATE FLAG-BITS SET AS NEEDED, RENAME CHECKS 00112000 * FOR EXISTENCE OF THE GIVEN FILE(S), AND CHANGES THE 00113000 * FILE IDENTIFICATION, AS FOLLOWS: 00114000 * 00115000 * 1. ACTLKP IS CALLED TO CHECK IF THE FILE TO BE 00116000 * CHANGED HAPPENS TO BE ACTIVE - THAT IS, IN THE 00117000 * ACTIVE FILE TABLE. THIS IS TREATED AS AN ERROR. 00118000 * IN A COUPLE OF CASES WHERE THIS ERROR HAS BEEN 00119000 * KNOWN TO OCCUR, THE CALLING PROGRAM EITHER 00120000 * FORGOT TO CLOSE THE FILE BEFORE CHANGING IT, OR 00121000 * TRIED TO RENAME IT FIRST AND CLOSE IT 00122000 * AFTERWARDS. THUS, IF THIS ERROR SHOULD OCCUR (A 00123000 * MESSAGE IS TYPED TO WARN THE USER), LOOK FOR 00124000 * THIS TYPE OF BUG IN THE CALLING PROGRAM. 00125000 * 00126000 * 2. IF THE GIVEN FILE IS NOT IN THE ACTIVE FILE TABLE, 00127000 * RENAME CHECKS FOR THE FILE BY A CALL TO FSTLKW. 00128000 * IF NOT FOUND, RENAME EXITS WITH A NORMAL RETURN 00129000 * IF AT LEAST ONE FFILE WAS CHANGED, OR WITH AN 00130000 * ERROR (WITH MESSAGE) IF NO FILES AT ALL WERE 00131000 * CHANGED. 00132000 * 00133000 * 3. IF THE GIVEN FILE WAS FOUND BY FSTLKW, A CHECK IS 00134000 * MADE TO ENSURE THAT THE FILE IDENTIFIED BY THE 00135000 * NEW NAME AND TYPE DOES NOT ALREADY EXIST IN THE 00136000 * ACTIVE FILE TABLE FOR THE SAME DISK (VIA ACTLKP 00137000 * CALL - RETURN CODE 8 IF FOUND), OR IN THE FST 00138000 * TABLES FOR THE SAME DISK (VIA FSTLKW). IF IT IS 00139000 * FOUND, AN ERROR IS RETURNED BY RENAME. 00140000 * 00141000 * 4. IF NOT, THE FILE IDENTIFICATION IS ALTERED AS 00142000 * SPECIFIED BY THE CALLER'S PARAMETER LIST, AND A 00143000 * FLAG-BIT IS SET IF A CHANGE WAS ACTUALLY MADE 00144000 * (FOR THE SUBSEQUENT EXIT AS DESCRIBED ABOVE IN 00145000 * STEP 2). 00146000 * 00147000 * 5. RENAME THEN CHECKS THE NOUPDIRT FLAG BIT OF 00148000 * ALTRFLG TO DETERMINE IF THAT OPTION - TO 00149000 * PROHIBIT THE UPDATING OF THE FILE DIRECTORY - 00150000 * WAS SPECIFIED. IF SO, THE FLAG BIT USED TO 00151000 * SIGNAL THAT THE FILE DIRECTORY IS TO BE UPDATED 00152000 * VIA A CALL TO UPDISK IS NOT TURNED ON. 00153000 * 00154000 * 6. RENAME THEN CHECKS THE FLAG BIT IN ALTRFLG TO 00155000 * DETERMINE IF THE TYPE OPTION - TO TYPE THE 00156000 * IDENTIFIER(S) OF THE FILE(S) ALTERED TO THE 00157000 * CONSOLE - WAS SPECIFIED. IF TYPE WAS SPECIFIED, 00158000 * THE PLIST IS SET UP, AND A CALL TO CONWRITE 00159000 * TYPES THE IDENTIFIER OF THE FILE. 00160000 * 00161000 * 7. THEN A CALL TO THE TFINIS ROUTINE IS MADE (IF 00162000 * NECESSARY) TO TEMPORARILY CLOSE ALL OUTPUT FILES 00163000 * FOR THE DISK INVOLVED, AND THEN UPDISK IS CALLED 00164000 * TO UPDATE THE FILE DIRECTORY. 00165000 * 00166000 * 8. FINALLY, IF THE PARAMETER LIST SPECIFIED ALL NAMES 00167000 * AND/OR TYPES, THE PROCESS IS REPEATED, STARTING 00168000 * AT STEP 1, TO ALTER ALL APPROPRIATE FILENAMES, 00169000 * TYPES, OR MODES AS DESIRED. 00170000 * 00171000 *. 00172000 EJECT 00173000 DMSRNM START X'E000' TRANSIENT-DISK-RESIDENT 00174000 LR R12,R15 @VA03668 00174100 USING DMSRNM,R12 SET R12 BASE REG @VA03668 00174300 * 00175000 * ENTER HERE ... 00176000 USING NUCON,R0 00178000 L R15,AFVS A(FVS) INTO R15 00181000 USING FVSECT,R15 00182000 STM R0,R14,REGSAV1 -- SAVE R0 THRU 14 00183000 XC ERRCOD1-3(4),ERRCOD1-3 CLEAR ERRCOD1 @VA03668 00183050 LA R1,0(,R1) CLEAR HIGH ORDER BYTE @VA01154 00183100 LR R10,R13 SAVE R13 PROVIDED BY SVCINT IN R10 00184000 DROP R15 00185000 LR R13,R15 -- REFERENCE 'FVS' INTO 00186000 USING FVSECT,R13 00187000 MVI MSGSWT,0 CLEAR ERROR MSG FLAG 00190000 OI UFDBUSY,ERBIT SET 'OUR' BIT IN 'UFDBUSY' FLAG 00191000 XC STATEFST(STFSTSIZ),STATEFST Clear STATEFST info HRC015DS 00192100 XC FVSERAS0(12),FVSERAS0 CLEAR 3 WORDS OF ALTER STORAGE, 00193000 ST R1,FVSERAS1 STORE R1 FOR USE BY ACTLKP & FSTLKW, 00194000 MVI ERSFLAG,00 AND CLEAR ALTER-FLAG. 00195000 CLI REGSAV1+4,X'0C' CALLED AS COMMAND FROM "INIT" ? @VA01154 00196100 BL LETSGO IF < X'0C', TREAT AS A FUNCTION @VA01154 00197100 CLI REGSAV1+4,X'0E' CALLED AS COMMAND FROM "EXEC" ? @VA01154 00198100 BH LETSGO IF > X'0E', TREAT AS A FUNCTION @VA01154 00199100 TURNON OI MSGSWT,PRINT YES - PRINT ALL ERROR MSGS 00204000 * NOTE - 'ALTRFLG' = FIRST BYTE OF 'FVSERAS2' IS ALREADY CLEAR 00205000 * CHECK FOR PARAMETER-LIST ERRORS ... 00206000 LETSGO EQU * @VA08141 00207000 MVC 8(18,R10),NEWNAM(R1) MOVE END OF LIST TO BUFFER @VA08141 00207500 LR R2,R1 POINT TO PARAMETER-LIST VIA R2 00208000 LA R9,ERR54E (FOR BCR'S BELOW) 00209000 ***** LINES 210000 AND 211000 DELETED BY VM10652 ***** 00210000 CLI PNAME(R2),X'FF' IS NAME PROVIDED ? 00212000 BCR 8,R9 BAD P-LIST IF FENCE THERE INSTEAD 00213000 CLI PNAME(R2),C'*' IS NAME = * ? 00214000 BNE CHKTYP OK IF NOT. 00215000 CLI PNAME+1(R2),C' ' IF NAME *, NEXT BYTE MUST BE A BLANK. 00216000 BNE CHKTYP MUST BE OLD FILENAME 00217000 OI ERSFLAG,ALLNAMES SET FLAG FOR ALL NAMES 00218000 CHKTYP CLI PTYPE(R2),X'FF' IS TYPE PROVIDED ? 00219000 BCR 8,R9 BAD P-LIST IF FENCE THERE INSTEAD 00220000 CLI PTYPE(R2),C'*' IS TYPE = * ? 00221000 BNE CHKMOD OK IF NOT 00222000 CLI PTYPE+1(R2),C' ' IF TYPE *, NEXT BYTE MUST BE A BLANK. 00223000 BNE CHKMOD MUST BE OLD FILETYPE 00224000 OI ERSFLAG,ALLTYPES SET FLAG FOR ALL TYPES 00225000 CHKMOD CLI PMODE(R2),X'FF' IS MODE PROVIDED? @VA10652 00226000 BCR 8,R9 BAD P-LIST IF FENCE @VA10652 00226100 CLI PMODE(R2),C'*' '*' MEANS ALL MODES @VA10652 00226200 BNE STATC GO DO STATE ON FIRST FILEID @VA10652 00226300 CLI PMODE+1(R2),C' ' COULD BE AN OLD FILEMODE 00228000 BNE STATC YES, DO STATE ON 1ST FILEID @VA03000 00229100 OI ERSFLAG,ANYMODE IF NOT, REMEMBER ALL MODES 00230000 TM ERSFLAG,ALLNAMES+ALLTYPES IF MODE '*', CAN'T HAVE ALL 00231000 BCR 1,R9 NAMES & TYPES TOO ("BO ERR54E" IF YES) 00232000 STATC EQU * @VA08053 00232025 TM MSGSWT,PRINT COMMAND ? @VA08053 00232050 BZ STATE NO ,SKIP MODE CHECK @VA08053 00232075 CLI PMODE+2(R2),C' ' MORE THAN TWO CHARACTERS? @VA08053 00232100 BNE ERR48E1 ERROR IF MORE THAN TWO @VA08053 00232125 STATE EQU * @VA08053 00232150 MVC STATFN(18),PNAME(R2) GET FIRST FILEID FOR STATE @VA03000 00232175 LA R1,STATLST GET ADDRESS OF PLIST @VA03000 00232200 L R15,ASTATEW STATEW @V305066 00232300 BALR R14,R15 ... @V305066 00232310 XC STATEFST(STFSTSIZ),STATEFST Clear STATEFST info HRC015DS 00232510 LTR R15,R15 IS EVERYTHING OKAY? @VA03000 00232600 BZ CKNEWNAM YES @VA03000 00232700 CH R15,=H'36' DISK NOT ACCESSED @VA12416 00232750 BE ERRMSG36 YES, ISSUE MSG69E @VA12416 00232760 CH R15,=H'28' IS THIS A SYNTAX ERROR? @VA03000 00232800 BE CKNEWNAM @VA03668 00232910 ST R15,ERRCOD1-3 LOAD ERROR CODE @VA03668 00232920 B EXIT EXIT W/ERRCODE @VA03668 00232930 CKNEWNAM CLI NEWNAM(R2),X'FF' NEW NAME OMITTED ? 00233000 BCR 8,R9 THAT'S AN ERROR 00234000 MVC STATFN(18),NEWNAM(R2) INITIAL. STATE PLIST 00235000 CLI NEWNAM(R2),C'*' '*' IS NO GOOD IN FILEID2 00236000 BE ERR62E 00237000 CLI NEWNAM(R2),C'=' IS NEW NAME ' = ' (EQUAL SIGN) 00238000 BNE CKNEWTYP IF NOT, NO PROBLEM. 00239000 NAMESAM CLI NEWNAM+1(R2),C' ' IF YES, NEXT CHAR. MUST BE BLANK 00240000 BNE STATCALL 00241000 MVC STATFN(8),PNAME(R2) GET FILENAME FOR '=' @VA03000 00242100 OI ERSFLAG,NEWNAME SET FLAG-BIT IF NO NAME-CHANGE WANTED 00243000 CKNEWTYP CLI NEWTYP(R2),X'FF' NEW TYPE OMITTED ? 00244000 BCR 8,R9 THAT'S AN ERROR 00245000 CLI NEWTYP(R2),C'*' 00246000 BE ERR62E 00247000 CLI NEWTYP(R2),C'=' IS NEW TYPE ' = ' (EQUAL SIGN) 00248000 BNE CKNEWMOD IF NOT, NO PROBLEM. 00249000 TYPESAM CLI NEWTYP+1(R2),C' ' IF YES, NEXT CHAR. MUST BE BLANK 00250000 BE GETTYPE YES, THIS IS OKAY @VA03000 00251100 MVC STATFN(8),NEWNAM(R2) GET ORIGINAL FILEID @VA03000 00251200 B STATCALL LET STATE GET IT @VA03000 00251300 GETTYPE MVC STATFT(8),PTYPE(R2) GET FILETYPE FOR '=' @VA03000 00251400 OI ERSFLAG,NEWTYPE SET FLAG-BIT IF NO TYPE-CHANGE WANTED 00253000 CKNEWMOD CLI NEWMOD(R2),X'FF' NEW MODE OMITTED? 00254000 BCR 8,R9 YES, ERROR 00255000 CLI NEWMOD(R2),C'=' SAME MODE WANTED? 00256000 BE SAMODE YES P3057 00257000 CLI NEWMOD(R2),C'*' MAKE SURE P3057 00258000 BNE MODENUM P3057 00259000 SAMODE EQU * SAME MODE IS WANTED P3057 00260000 CLI NEWMOD+1(R2),C' ' BETTER BE BLANK 00261000 BE GETFM YES, THIS IS OKAY @VA03000 00262100 MVC STATFN(8),NEWNAM(R2) GET ORIGINAL FILEID @VA03000 00262200 MVC STATFT(8),NEWTYP(R2) GET ORIGINAL FILEID @VA03000 00262300 B STATCALL LET STATE GET IT @VA03000 00262400 GETFM TM ERSFLAG,NEWNAME+NEWTYPE IS EVERYTHING SAME? @VA03000 00263100 BO ERR19E COULDN'T CHAGE ANYTHING... 00264000 OI ERSFLAG,NEWMODE OTHERWISE O.K. 00265000 MVC STATFM(2),PMODE(R2) GET FILEMODE FOR '=' @VA03000 00266100 B STATCALL 00267000 MODENUM EQU * IT'S A NORMAL MODE 00268000 TM ERSFLAG,ANYMODE OLD MODE GIVEN DIRECTLY? 00273000 BO STATCALL NO - O.K. 00274000 CLC PMODE(1,R2),NEWMOD(R2) IF SO, BETTER MATCH 00275000 BNE ERR51E ERROR IF MODE CHANGE 00276000 STATCALL EQU * 00277000 TM MSGSWT,PRINT COMMAND @VA08053 00277015 BZ CALLSTAT NO ,SKIP MODE CHECK @VA08053 00277030 CLI NEWMOD+2(R2),C' ' MORE THAN TWO CHARACTERS? @VA08053 00277045 BNE ERR48E2 YES, ERROR IF MORE THAN TWO @VA08053 00277060 CALLSTAT EQU * @VA08053 00277075 LA R1,STATLST STATE NEW FILE FOR SYNTAX 00278000 L R15,ASTATEW STATEW @V305066 00279100 BALR R14,R15 ... @V305066 00279200 XC STATEFST(STFSTSIZ),STATEFST Clear STATEFST info HRC015DS 00280200 LTR R15,R15 00281000 BZ PLISTOK IGNORE IF FILE FOUND 00282000 CH R15,=H'36' DISK NOT ACCESSED @VA12416 00282500 BE ERRMSG36 YES, ISSUE MSG69E @VA12416 00282600 CH R15,=H'28' 00283000 BE PLISTOK @VA03668 00284100 ST R15,ERRCOD1-3 LOAD ERROR CODE @VA03668 00284200 B EXIT EXIT W/ERRCODE @VA03668 00284300 SPACE 2 00285000 * 00286000 PLISTOK CLI OPTSTART(R2),X'FF' FENCE NEXT ? 00287000 BE ALTR01 YES, NO OPTIONS.. TRANSFER 00288000 CLI OPTSTART(R2),C'(' ARE THERE ANY OPTIONS ????? 00289000 BNE ERR3A NO, WHO KNOWS WHAT ... 00290000 * 00291000 LA R3,OPTION1(,R2) SKIP BY '('... 00292000 * 00293000 OPTSCAN CLC PARTYP(8),0(R3) 'TYPE' OPTION? 00294000 BE SETYP 00295000 CLC 0(2,R3),=CL2'T' ABBREV. ? 00296000 BNE NOUPDCHK NEITHER 00297000 SETYP OI ALTRFLG,TYPEM SET TYPING FLAG 00298000 B NEXT 00299000 NOUPDCHK CLC PARNOUPD(8),0(R3) 'NOUPDIRT' OPTION? 00300000 BE SETNOUP 00301000 CLC 0(5,R3),=CL5'NOUP' ABBREV.? 00302000 BNE NOTYPCHK NEITHER 00303000 SETNOUP OI ALTRFLG,NOUPD SET NO-UPDATE FLAG 00304000 B NEXT 00305000 NOTYPCHK CLC PARNOTYP(8),0(R3) 'NOTYPE' OPTION? 00306000 BE SETNOTYP 00307000 CLC 0(4,R3),=CL4'NOT' ABBREV.? 00308000 BNE UPDCHK NEITHER 00309000 SETNOTYP NI ALTRFLG,255-TYPEM SHUT OFF TYPING 00310000 B NEXT 00311000 UPDCHK CLC PARUPD(8),0(R3) 'UPDIRT' OPTION? 00312000 BE SETUPD 00313000 CLC 0(3,R3),=CL3'UP' ABBREV.? 00314000 BNE ERR3E BAD OPTION 00315000 SETUPD NI ALTRFLG,255-NOUPD UPDATE FILE DIRECTORY 00316000 * 00317000 NEXT LA R3,8(,R3) NEXT OPTION, PLEASE 00318000 CLI 0(R3),X'FF' END OF PLIST ? 00319000 BE ALTR01 YES - CONTINUE 00320000 CLI 0(R3),C')' NO - END OF OPTIONS ? 00321000 BNE OPTSCAN NO - PLAY IT AGAIN, SAM... 00322000 * 00323000 * 00324000 ALTR01 SR R0,R0 SR=0 TO SEARCH FROM THE BEGINNING 00325000 TM ERSFLAG,ANYMODE MODE SPECIFIED? 00326000 BO ALTR02 NO. 00327000 L R1,FVSERAS1 POINT TO 'OLD' FILEID P3057 00328000 L R15,VCADTLKP LETS MAKE SURE IT'S R/W DISK @VM03093 00329100 BALR R14,R15 00330000 USING ADTSECT,R1 00331000 TM ADTFLG1,ADTFRO WELL? 00332000 BO ERR37E IT'S R/O 00333000 DROP R1 00334000 * 00335000 ALTR02 L R1,FVSERAS1 SEARCH ACTIVE-TABLE 00336000 L R15,AACTLKP CALL ACTLKP 00337000 BALR R14,R15 ... 00338000 BZ FOUND1 BRANCH IF ACTLKP FOUND IT. 00339000 ALTR04 LM R0,R1,FVSERAS0 IF NOT, RE-LOAD R0 AND R1 AND 00340000 L R15,VCFSTLKW CALL 'FSTLKW' @VM03093 00341100 BALR R14,R15 ... 00342000 BZ FOUND2 'FOUND' IF CONDITION-CODE = 0 00343000 * 00344000 ALTR05 TM ERSFLAG,FOUNDIT DID WE FIND ANYTHING AT ALL ? 00345000 BZ ERR2E ERROR 2E IF WE DIDN'T. 00346000 TM ERSFLAG,SUCCESS DID WE ALTER ANYTHING AT ALL ? 00347000 BZ ERR19E ERROR 19E IF NOT 00348000 SR R15,R15 CLEAR RETURN-CODE IF WE ALTERED SOMETHING 00349000 TM ALTRFLG,UPNEED DO WE NEED TO UPDATE A DIRECTORY ? 00350000 BZ EXIT TRF IF NOT (FORGET IT). 00351000 L R0,FVSERAS0 R0 MUST POINT TO ACTIVE-DISK-TABLE 00352000 SR R1,R1 CLEAR R1 (AS NECESSARY) 00353000 L R15,ATFINIS CALL 'TFINIS' FOR THIS DISK 00354000 BALR R14,R15 ... 00355000 LA R1,1 R1 = 'PLUS' (ANYTHING) 00356000 L R15,AUPDISK UPDATE THE DIRECTORY FOR GIVEN DISK 00357000 BALR R14,R15 VIA 'UPDISK' 00358000 EXIT KXCHK ERBIT CHECK FOR 'KX' WANTED... 00359000 LM R0,R15,REGSAV1 RESTORE REGS @VA03668 00363100 LTR R15,R15 SET CC @VA03668 00363400 BR R14 RETURN TO SVCINT OR CALLER. 00364000 * 00365000 * 00366000 FOUND1 DS 0H FILE-TO-BE-ALTERED 'FOUND' BY ACTLKP ... 00367000 USING AFTSECT,R1 (BRIEFLY) 00368000 L R11,AFTADT GET POINTER TO ACTIVE-DISK-TABLE 00369000 USING ADTSECT,R11 REFERENCE SAME 00370000 TM ADTFLG1,ADTFRW IS THIS A READ-WRITE DISK ? 00371000 LR R0,R1 IF NOT, SET UP R0 AS NEEDED 00372000 BZ ALTR02 AND RESUME SEARCHING. 00373000 B ERR30E ERROR 30E IF ACTIVE-READ-WRITE FILE 00374000 DROP R1 00375000 * 00376000 * 00377000 FOUND2 OI FVSERAS1,X'80' SET SIGN-BIT 'ON' IN 'R1' FOR NEXT TIME 00378000 LR R11,R0 REFERENCE THE ACTIVE-DISK-TABLE 00379000 TM ERSFLAG,NEWMODE WAS NEW MODE SPECIFIED ? 00380000 BO FOUND3 BO IF WAS '*' (ASSUME CORRECT DISK) 00381000 CLC NEWMOD(1,R2),ADTM DOES MODE FROM DISK MATCH P-LIST ? 00382000 BE FOUND3 IF YES, WE HAVE RIGHT DISK & FILE. 00383000 ST R0,FVSERAS0 IF NOT, WRONG DISK, SET UP TO 00384000 B ALTR04 RESUME SEARCHING, & GO TO IT. 00385000 EJECT 00386000 FOUND3 OI ERSFLAG,FOUNDIT FILE-TO-BE-ALTERED 'FOUND' BY FSTLKW 00387000 LR R3,R1 REFERENCE THE FST-ENTRY VIA R3 00388000 USING FSTSECT,R3 ... 00389000 LM R7,R8,ADTCHBA PRESERVE KEY INFO. FOR CONTINUING, 00390000 SR R0,R0 R0 = 0, 00391000 LR R1,R10 R1 POINTS TO 'NEW' NAME-TYPE-MODE, ETC. 00392000 TM ERSFLAG,NEWNAME NEW NAME = * ? 00393000 BZ ALTR06 BZ IF NOT (WAS GIVEN) 00394000 MVC PNAME(8,R1),FSTN SUBSTITUTE FOUND NAME FOR '*' 00395000 ALTR06 TM ERSFLAG,NEWTYPE NEW TYPE = * ? 00396000 BZ ALTR08 BZ IF NOT (WAS GIVEN) 00397000 MVC PTYPE(8,R1),FSTT SUBSTITUTE FOUND TYPE FOR '*' 00398000 ALTR08 TM ERSFLAG,NEWMODE NEW MODE = * ? 00399000 BZ ALTR10 BZ IF NOT (WAS GIVEN) 00400000 MVC PMODE(1,R1),ADTM SUBSTITUTE ACTIVE-DISK-TBL MODE 00401000 MVI PMODE+1(R1),C' ' AND A BLANK 00402000 ALTR10 L R15,AACTLKP BETTER NOT BE IN ACTIVE-TABLE, 00403000 BALR R14,R15 ... 00404000 LA R4,8(,R10) (R4 -> FILEID2 IN CASE ERROR) @VA05244 00405000 BZ ALTR22 THAT'S PROBABLY AN ERROR 00406000 LR R1,R10 MAKE SURE R1 SET AGAIN, AND 00407000 L R15,VCFSTLKW LOOK UP ON R/W DISK(S) @VM03093 00408100 BALR R14,R15 ... 00409000 BNZ NEWOK GOOD SHOW IF 'ERROR' FROM FSTLKW 00410000 * IF NEW FILE ALREADY EXISTS, MAYBE IT THE SAME AS THE 'OLD', 00411000 * BUT A MODE-CHANGE IS WANTED ? 00412000 CLC 0(16,R1),FSTN NAME & MODE THE SAME ? 00413000 BNE ERR24E BNE IF NOT THE SAME, DEFINITELY ERROR 2. 00414000 * 00415000 NEWOK LA R5,ALTR16 SET R5 FOR NO CHANGES MADE YET 00416000 CLC FSTN(16),PNAME(R10) NAME & TYPE ANY DIFFERENT ? 00417000 BE ALTR12 BE IF THE SAME (NO CHANGE THERE) 00418000 LA R5,ALTR15 SIGNAL CHANGE MADE 00419000 MVC FSTN(16),PNAME(R10) SUBSTITUTE NEW NAME AND/OR TYPE 00420000 LM R0,R1,FSTT NEW FILETYPE INTO R0-R1, 00421000 L R15,ATYPSRCH CHECK NEW FILETYPE 00422000 BALR R14,R15 VIA "TYPSRCH" 00423000 O R15,ADTFTYP-3 "OR" IN THE POSSIBLE BITS 00424000 ST R15,ADTFTYP-3 FOR THE FILETYPE. 00425000 ALTR12 TM ERSFLAG,NEWMODE WAS NEW MODE SIMPLY '*' ? 00426000 BO ALTR14 BO IF YES, LEAVE MODE 'AS IS' 00427000 CLC FSTM+1(1),PMODE+1(R10) ANY CHANGE TO MAKE IN MODE ? 00428000 BE ALTR14 BE IF NOT (IT'S THE SAME) 00429000 CLI PMODE+1(R10),C' ' MODE LETTER SPECIFIED ? @VA04965 00429330 BE ALTR14 YES, LEAVE IT AS IT WAS @VA04965 00429660 MVC FSTM+1(1),PMODE+1(R10) MAKE THE CHANGE 00430000 B ALTR15 AND GO UPDATE DISK, ETC. 00431000 ALTR14 BR R5 CONTINUE, OR BRANCH TO ALTR16 00432000 ALTR15 L R1,FVSERAS0 "OLD" ACTIVE-DISK-TABLE (IF ANY) INTO R1, 00433000 CR R11,R1 IS "THIS" ADT THE SAME AS THE OLD ONE ? 00434000 BE ALTR17 TRF IF YES - NO UPDISK NEEDED NOW 00435000 LTR R0,R1 DOES OLD ACTIVE-DISK-TABLE EXIST AT ALL ? 00436000 BZ ALTR17 IF NOT, FORGET IT. 00437000 TM ALTRFLG,UPNEED IF YES, DID THE UFD WANT UPDATING ? 00438000 BZ ALTR17 TRF IF NOT (FORGET IT). 00439000 SR R1,R1 CLEAR R1 (AS NECESSARY) 00440000 L R15,ATFINIS CALL 'TFINIS' FOR PREVIOUS DISK 00441000 BALR R14,R15 ... 00442000 LA R1,1 R1 = 'PLUS' (ANYTHING) 00443000 L R15,AUPDISK THEN CALL 'UPDISK' 00444000 BALR R14,R15 ... 00445000 NI ALTRFLG,255-UPNEED CLEAR FLAG (UFD ALREADY UPDATED) 00446000 * 00447000 ALTR17 OI ERSFLAG,SUCCESS INDICATE WE ALTERED SOMETHING 00448000 TM ALTRFLG,NOUPD DID WE WANT TO UPDATE DIRECTORY ? 00449000 BO ALTR16 NO, TRANSFER OUT. DON'T UPDATE. 00450000 OI ALTRFLG,UPNEED SIGNAL: UFD NEEDS UPDATING LATER PLEASE 00451000 * 00452000 ALTR16 STM R7,R8,ADTCHBA RESTORE KEY INFO FROM 1ST FSTLKW, 00453000 ST R11,FVSERAS0 MAKE SURE FVSERAS0 POINTS TO 'THIS' DISK 00454000 TM ERSFLAG,ALLNAMES+ALLTYPES+ANYMODE ANY MORE TO BE DONE ? 00455000 BZ ALTR05 BZ IF NOT, GO EXIT. 00456000 SSM ON PERMIT TIMER AND/OR TERMINAL INTERRUPT(S) 00457000 SSM *+1 NOW INHIBIT ALL INTERRUPTS AGAIN. 00458000 TM ALTRFLG,TYPEM IF 'ALL' SOMETHING, WAS TYPING WANTED ? 00459000 BZ ALTR04 TRF IF NOT (FORGET IT). 00460000 B TYPGO GET AROUND CONSTANTS 00461000 * 00462000 * SET UP TYPLIN PLIST RIGHT HERE ***** 00463000 * 00464000 DS 0F 00465000 TYPOPT DC CL8'TYPLIN' 00466000 DC AL1(1) 00467000 DC AL3(TYPFIL) 00468000 DC C'B' 00469000 DC AL3(20) 00470000 TYPFIL DS 5F 00471000 * 00472000 TYPGO MVI TYPFIL,X'40' TO CLEAR BUFFER 00473000 MVC TYPFIL+1(19),TYPFIL 00474000 MVC TYPFIL(8),FSTN MOVE IN NAME. 00475000 MVC TYPFIL+18(1),ADTM MOVE IN MODE LETTER. 00476000 MVC TYPFIL+19(1),FSTM+1 MOVE IN MODE NUMBER. 00477000 OPT2 MVC TYPFIL+9(8),FSTT MOVE IN TYPE 00478000 * 00479000 * READY TO GO TO TYPLIN VIA 'SVC' 00480000 * 00481000 TYPIT LA R1,TYPOPT PUT IN ADDRESS OF TYPLIN PLIST 00482000 SVC X'CA' GO TYPE IT 00483000 * 00484000 * ALL DONE WITH TYPLIN CONTINUE WITH ALTER. 00485000 SPACE 00486000 B ALTR04 GO CHECK FOR ADDITIONAL FILES TO ALTER. 00487000 DROP R11 00488000 SPACE 2 00489000 * IF NEW FILE FOUND IN ACTIVE-TABLE, THAT'S PROBABLY AN ERROR... 00490000 ALTR22 DS 0H 00491000 USING AFTSECT,R1 (BRIEFLY) 00492000 L R6,AFTADT GET POINTER TO ACTIVE-DISK-TABLE, 00493000 USING ADTSECT,R6 REFERENCE SAME, 00494000 TM ADTFLG1,ADTFRW IS THIS A READ-WRITE DISK ? 00495000 LR R0,R1 IF NOT, SET UP R0 AS NEEDED 00496000 BZ ALTR10 AND RESUME SEARCHING 00497000 B ERR24E BUT ERROR 24E IF MATCHES A READ-WRITE DIS 00498000 DROP R1,R6 00499000 * 00500000 ON DC X'81' PERMIT TIMER AND/OR TERMINAL INTERRUPT(S) 00501000 MSGSWT DC X'00' ERROR MSG PRINT FLAG 00502000 PRINT EQU X'80' 00503000 EJECT 00504000 ERR2E TM MSGSWT,PRINT SUPPRESS ERROR MSGS? 00505000 BZ RET2 YES 00506000 CLI REGSAV1+4,X'0E' WAS RENAME INVOKED FROM EXEC @VA01154 00506100 * WITH "&CONTROL OFF" IN EFFECT ? 00506200 BE RET2 IF YES, OMIT THE ERROR MESSAGE @VA01154 00506300 * JUST AS IF IT HAD BEEN A FUNCTION CALL. 00506400 * NO - USE THE USUAL ERROR MESSAGE ROUTINE: 00506500 LA R2,PNAME(,R2) POINT TO FILEID 00507000 DMSERR NUM=2,LET=E,SUB=(CHAR8A,(R2)),TEXT='FILE ''............*00508000 ........'' NOT FOUND' 00509000 RET2 MVI ERRCOD1,28 RETURN CODE = 28 @VA03668 00510100 B EXIT 00511000 SPACE 2 00512000 ERR3A LA R3,OPTSTART(,R2) OPTION WITHOUT PARENS 00513000 ERR3E TM MSGSWT,PRINT SUPPRESS MSGS? 00514000 BZ RET3 YES 00515000 DMSERR NUM=3,LET=E,SUB=(CHARA,(R3)),TEXT='INVALID OPTION ''...*00516000 .....''' 00517000 RET3 MVI ERRCOD1,24 RETURN CODE = 24 @VA03668 00518100 B EXIT 00519000 SPACE 2 00520000 ERR19E TM MSGSWT,PRINT SUPPRESS ERR MSGS? 00521000 BZ RET19 YES 00522000 DMSERR NUM=19,LET=E,TEXT='IDENTICAL FILEIDS' 00523000 RET19 MVI ERRCOD1,24 RETURN CODE = 24 @VA03668 00524100 B EXIT 00525000 SPACE 2 00526000 ERR24E TM MSGSWT,PRINT SUPPRESS MSGS? 00527000 BZ RET24 YES 00528000 DMSERR NUM=24,LET=E,SUB=(CHAR8A,(R4)),TEXT='FILE ''...........*00529000 .........'' ALREADY EXISTS' 00530000 RET24 MVI ERRCOD1,28 RETURN CODE = 28 @VA03668 00531100 B ALTR17 FINISH RENAME LIST @VA03668 00532100 SPACE 2 00533000 ERR30E TM MSGSWT,PRINT SUPPRESS MSGS? 00534000 BZ RET30 YES 00535000 LA R2,PNAME(,R2) POINT TO OLD FILEID 00536000 DMSERR NUM=30,LET=E,SUB=(CHAR8A,(R2)),TEXT='FILE ''...........*00537000 .........'' ALREADY ACTIVE' 00538000 RET30 MVI ERRCOD1,28 RETURN CODE = 28 @VA03668 00539100 B EXIT 00540000 ERR37E TM MSGSWT,PRINT SUPPRESS MSGS? 00541000 BZ RET37 00542000 LA R2,PMODE(,R2) POINT TO OLD MODE 00543000 DMSERR NUM=37,LET=E,SUB=(CHARA,(R2)),TEXT='DISK ''..'' IS READ*00544000 /ONLY' 00545000 RET37 MVI ERRCOD1,36 RETURN CODE = 36 @VA03668 00546100 B EXIT 00547000 SPACE 2 00548000 ERR62E TM MSGSWT,PRINT SUPPRESS MSGS? 00549000 BZ RET62 00550000 DMSERR NUM=62,LET=E,TEXT='INVALID ''*'' IN OUTPUT FILEID' 00551100 RET62 MVI ERRCOD1,20 RETURN CODE = 20 @VA03668 00552100 B EXIT 00553000 SPACE 2 00554000 SPACE 2 00555000 SPACE 2 00556000 ERR51E TM MSGSWT,PRINT SUPPRESS MSGS? 00557000 BZ RET51 YES 00558000 DMSERR NUM=51,LET=E,TEXT='INVALID MODE CHANGE' 00559000 RET51 MVI ERRCOD1,24 RETURN CODE = 24 @VA03668 00560100 B EXIT 00561000 SPACE 2 00562000 ERR54E TM MSGSWT,PRINT SUPPRESS MSGS? 00563000 BZ RET54 YES 00564000 DMSERR NUM=54,LET=E,TEXT='INCOMPLETE FILEID SPECIFIED' 00565000 RET54 MVI ERRCOD1,24 RETURN CODE = 24 @VA03668 00566100 B EXIT 00567000 ERR48E1 LA R2,PMODE(,R2) POINT TO INVALID INPUT MODE @VA05622 00567100 B ERR48E JOIN COMMAND CODE @VA05622 00567200 ERR48E2 LA R2,NEWMOD(,R2) POINTS TO INVALID OUTPUT MODE @VA05622 00567300 ERR48E TM MSGSWT,PRINT SUPPRESS ERROR MSGS? @VA05622 00567400 BZ RET48 YES,SKIP ERRMSG CALL @VA05622 00567500 DMSERR NUM=48,LET=E,SUB=(CHARA,(R2)), *00567600 TEXT='INVALID FILE MODE ''........''' 00567700 RET48 MVI ERRCOD1,24 RETURN CODE 24 @VA05622 00567800 B EXIT @VA05622 00567900 SPACE 2 00568000 ERRMSG36 EQU * @VA12416 00568100 LA R2,PMODE(,R2) @VA12416 00568200 DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X00568300 LET=E,SUB=(CHARA,((R2),1)) @VA12416 00568400 MVI ERRCOD1,36 RETURN CODE = 36 @VA12416 00568500 B EXIT @VA12416 00568600 * DISPLACEMENTS REFERENCING CALLER'S PARAMETER-LIST... 00569000 PNAME EQU 8 00570000 PTYPE EQU 16 00571000 PMODE EQU 24 00572000 NEWNAM EQU 32 00573000 NEWTYP EQU 40 00574000 NEWMOD EQU 48 00575000 OPTSTART EQU 56 START OF OPTIONS ('(')...IF ANY 00576000 OPTION1 EQU 64 FIRST OPTION...IF ANY 00577000 * 00578000 * 00579000 PARTYP DC CL8'TYPE' CONSTANTS FOR OPTIONS... 00580000 PARNOTYP DC CL8'NOTYPE' 00581000 PARUPD DC CL8'UPDIRT' 00582000 PARNOUPD DC CL8'NOUPDIRT' 00583000 * 00584000 DUMMY DC CL8'DUMMY' SUBSTITUTE FOR '=' 00585000 ANYMD DC CL2'*' DITTO 00586000 STATLST DS 0D 'STATE' PLIST 00587000 DC CL8'STATEW' TO SYNTAX-CHECK NEW NAME @VA01560 00588100 STATFN DC CL8' ' 00589000 STATFT DC CL8' ' 00590000 STATFM DC CL2' ' 00591000 DC CL2' ' 00592000 DC A(*-*) 00593000 SPACE 00593100 LTORG 00593200 EJECT 00594000 NUCON 00595000 FVS 00596000 SPACE 00597000 ALTRFLG EQU FVSERAS2 NEEDED FLAG = FIRST BYTE OF 'FVSERAS2' 00598000 * 00599000 * 'ALTRFLG' DEFINITIONS: 00600000 * 00601000 UPNEED EQU X'80' UPDATE OF UFD NEEDED BEFORE WE EXIT 00602000 TYPEM EQU X'40' TYPING WANTED PLEASE 00603000 NOUPD EQU X'20' NO UPDATE OF DIRECTORY.. 00604000 SPACE 3 00605000 * 'ERSFLAG' DEFINITIONS: 00606000 * 00607000 ALLNAMES EQU X'80' ALL OLD NAMES 00608000 ALLTYPES EQU X'40' ALL OLD TYPES 00609000 ANYMODE EQU X'20' ANY OLD MODE 00610000 NEWNAME EQU X'10' NEW NAME = * 00611000 NEWTYPE EQU X'08' NEW TYPE = * 00612000 NEWMODE EQU X'04' NEW MODE = * 00613000 FOUNDIT EQU X'02' WE FOUND SOMETHING 00614000 SUCCESS EQU X'01' WE ALTERED SOMETHING 00615000 EJECT 00616000 AFT 00617000 EJECT 00618000 ADT 00619000 FSTB 00621000 REGEQU 00623000 SPACE 00624000 END 00625000