ibm:vm370-lib:cms:dmsrnm.assemble_src
Table of Contents
DMSRNM Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC015DS]
Source Listing
- DMSRNM.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsrnm.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator