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