ARE TITLE 'DMSARE (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* 00004000
* MODULE NAME: 00005000
* 00006000
* DMSARE (RELEASE) 00007000
* 00008000
* FUNCTION: 00009000
* 00010000
* TO RELEASE ALL RESIDENT TABLES PERTAINING TO A GIVEN 00011000
* DISK AND ASSOCIATE DIRECTORIES WHEN IT IS NO LONGER 00012000
* NEEDED. 00013000
* 00014000
* ATTRIBUTES: 00015000
* 00016000
* TRANSIENT; SERIALLY REUSABLE. 00017000
* 00018000
* ENTRY POINTS 00019000
* 00020000
* DMSARE 00021000
* 00022000
* ENTRY CONDITIONS: 00023000
* 00024000
* LA R1,PLIST 00025000
* SVC X'CA' 00026000
* DC AL4(ERROR) 00027000
* 00028000
* 00029000
* R1 MUST POINT TO THE PARAMETER LIST AS USUAL: 00030000
* 00031000
* DS 0F 00032000
* 00033000
* PLIST DC CL8'RELEASE' 00034000
* DC CL8'CCU'|'MODE' DISK ADDRESS, OR DISK MODE 00035000
* DC CL8'(' OPTION LIST DELIMETER 00036000
* DC CL8'DET' DETACH OPTION 00037000
* DC 8X'FF' ENDING FENCE 00038000
* 00039000
* EXIT CONDITIONS: 00040000
* 00041000
* NORMAL RETURN - 00042000
* 00043000
* R15 = 0 00044000
* 00045000
* ERROR RETURNS - 00046000
* 00047000
* R15 = 24: SYNTAX ERROR 00048000
* INVALID RELEASE PARAMETER LIST (DISK ADDRESS NOT 00049000
* HEX NUMBER UP TO FFF, DISK MODE NOT LETTER FROM A 00050000
* TO G,Y, OR Z, SPECIFIED OPTION IS NOT 'DET' OR 00051000
* EXCESS PARAMETER(S) ENCOUNTERED). 00052000
* 00053000
* R15 = 36: NOT ACCESSED 00054000
* THE PLIST SPECIFICATION DOES NOT CORRESPOND TO ANY 00055000
* DEVICE CURRENTLY ACCESSED. 00056000
* 00057000
* CALLS TO OTHER ROUTINES: 00058000
* 00059000
* DMSALU, DMSLAD, DMSERR 00060000
* 00061000
* EXTERNAL REFERENCES: 00062000
* 00063000
* ADT 00064000
* 00065000
* TABLES/WORK AREAS: 00066000
* 00067000
* NONE 00068000
* 00069000
* 00070000
* REGISTER USAGE 00071000
* 00072000
* R12 BASE 00073000
* REST WORK 00074000
* 00075000
* OPERATION: 00076000
* 00077000
* THE PARAMETER LIST IS CHECKED FOR ERRORS. THE 00078000
* DISK-ADDRESS MUST BE A HEX NUMBER (DIGITS 0-9, A-F, 00079000
* WITH A VALUE NO MORE THAN X'FFF'. NOTE: X'000' IS NOT 00080000
* VALID). THE DISK MODE MUST BE ALPHABETIC. IT IS NOT 00081000
* LEGAL TO RELEASE THE S-DISK. 00082000
* DMSLAD IS CALLED TO FIND THE ACTIVE DISK TABLE (ADT) 00083000
* BLOCK. IF THE BLOCK WAS FOUND AND A MODE LETTER HAD 00084000
* BEEN SPECIFIED, DMSALU IS CALLED FOR THIS 00085000
* DISK, AND THE ADTFRO AND ADTFRW READ-ONLY AND 00086000
* READ-WRITE FLAG BITS IN THE ADTFLG1 FLAG BYTE IN THE 00087000
* ADT BLOCK ARE ALSO CLEARED, TO SIGNAL THAT NO DISK IS 00088000
* REFERENCED BY THE ADT BLOCK. IF THE 'DET' OPTION 00089000
* WAS SPECIFIED THE DISK ADDRESS IS OBTAINED AND ALL 00090000
* ACCESSES TO THAT ADDRESS ARE RELEASED IN THE SAME 00091000
* FASHION AS IF THE CCU FORM HAD BEEN SPECIFIED. 00092000
* CONTROL RETURNS TO THE CALLER. 00093000
* 00094000
* OTHERWISE, IF A DEVICE ADDRESS IS SPECIFIED, DMSLAD 00095000
* IS CALLED FOR THE FIRST ADT BLOCK AND A CHECK IS MADE 00096000
* FOR THE SUPPLIED DEVICE ADDRESS. IF THERE IS NOT A 00097000
* MATCH, THE NEXT ADT BLOCK IS CHECKED, UNTIL ALL ADT 00098000
* BLOCKS HAVE BEEN CHECKED. PROCESSING FOR A DEVICE 00099000
* ADDRESS PROCEEDS AS WITH THE MODE SPECIFICATION - BUT 00100000
* CONTROL IS NOT RETURNED TO THE CALL ER UNTIL ALL ADT 00101000
* INSTANCES OF DEVICE ADDRESS HAVE BEEN VERIFIED AND 00102000
* RELEASED IF APPROPRIATE. 00103000
* 00104000
* IN EITHER CASE, IF THE PLIST SPECIFICATION IS NOT 00105000
* VERIFIED THE USER RECEIVES AN ERROR INDICATION. 00106000
* AFTER RELEASE PROCESSING IS COMPLETE, IF THE DETACH 00107000
* ('DET') OPTION WAS SPECIFED, A DIAGNOSE REQUEST IS 00108000
* PASSED TO CP TO DETACH THE DISK. 00109000
* RELEASE IS TREATED AS A COMMAND OR A FUNCTION ACCORDING TO THE 00110000
* HIGH-ORDER BYTE OF REGISTER 1 AT INPUT. IF THE BYTE IS LESS 00111000
* THAN X'0C' OR GREATER THAN X'0E', IT IS ASSUMED TO BE A 00112000
* FUNCTION, I.E., CALLED BY ANOTHER PROGRAM, AND NO ERROR 00113000
* MESSAGE IS ISSUED IF THE DISK IS NOT ACCESSED. 00114000
* 00115000
*. 00116000
EJECT 00117000
DMSARE START 00118000
RELEASE EQU * 00119000
EXTRN RELUFD 00120000
USING *,R12 00121000
USING NUCON,R0 00122000
LR R12,R15 SET UP A BASE REGISTER 00123000
LR R10,R14 SAVE THE RETURN REGISTER 00124000
CLI 8(R1),X'FF' ARE THERE ANY PARAMETERS AT ALL? 00125000
BE ERROR1 IF NOT, COMPLAIN. 00126000
LR R11,R1 REMEMBER R1 AT INPUT @V304332 00127000
LA R7,8(,R1) POINT AT THE FIRST ARGUMENT. 00128000
LR R3,R7 AND SETUP A WORK REGISTER. 00129000
CLI 3(R3),C' ' MORE THAN THREE CHARACTERS? 00130000
BNE ERROR2 ERROR IF SO. 00131000
MVC DIAGMSG+8(3),0(R3) MOVE IN DEV ADDR IN CASE @VA08082 00132000
* CCU FORM 00133000
MVI AREFLAG,ZERO CLEAR FLAGBYTE @VM03204 00134000
CLI 0(R3),C'0' IS IT NUMERIC? 00135000
BNL NUMOK YES. WORK ON IT. 00136000
CLI 1(R3),C' ' ONLY ONE CHARACTER? 00137000
BE CKMODE ASSUME IT IS A MODE-LETTER. 00138000
NUMOK SR R4,R4 EMPTY A WORK REGISTER. 00139000
SR R5,R5 ...AND ANOTHER. 00140000
B CKBYTE NOW, GO BUTCHER IT. 00141000
SPACE 00142000
TESTIT CLI 0(R3),C'A' MATCH IT WITH 'A'. 00143000
BL ERROR2 ERROR IF LOW. 00144000
CLI 0(R3),C'F' AND NOW WITH AN 'F'. 00145000
BH ERROR2 ERROR IF HIGH 00146000
IC R5,0(,R3) STUFF IT INTO A REGISTER. 00147000
SH R5,=XL2'00B7' BEND IT. 00148000
R5OK SLL R4,4 MAKE ROOM. 00149000
OR R4,R5 MARRY 00150000
GETBYTE LA R3,1(,R3) POINT TO THE NEXT CHARACTER. 00151000
CKBYTE CLI 0(R3),C'0' COMPARE WITH ZERO. 00152000
BL TESTA IF LOW, CAN BE ALPHA. 00153000
IC R5,0(,R3) STUFF IT INTO A REGISTER. 00154000
SH R5,=XL2'00F0' BEND IT. 00155000
CLI 0(R3),C'9' NUMERIC? 00156000
BNH R5OK ONLY IF NOT HIGH. 00157000
B ERROR2 NO GOOD AT ALL. 00158000
TESTA CLI 0(R3),C' ' DONE YET? 00159000
BNE TESTIT NOPE. 00160000
CLI 16(R1),X'FF' ANY EXTRAS? 00161000
LA R14,NOOPTS RETURN ADDRESS @V305038 00162000
OPCHK LA R6,* INDICATE NO DETACH OPTION, @V305038 00163000
* DEFAULT 00164000
BER R14 NO OPTIONS @V305038 00165000
CLI 16(R1),LTPAREN OPTIONS SPECIFIED? @V305032 00166000
BNE ERROR5 NOPE, SHOW ERROR @V305038 00167000
CLC 24(4,R1),=C'DET ' DETACH OPTION? @V305038 00168000
BNE ERROR5C NOPE, SHOW ERROR @V305032 00169000
CLI 32(R1),FF END? @V305032 00170000
BE SETOPT YUP, OK AS IS, BR @V305038 00171000
CLI 32(R1),RTPAREN CLOSE PAREN? @V305032 00172000
BNE ERROR5B NOPE, MORE OPTS, NOT ACCEPTABLE @V305032 00173000
CLI 40(R1),FF NOW THE END? @V305032 00174000
BNE ERROR5A NOPE, SHOW ERROR @V305032 00175000
SETOPT LA R6,DIAGMSG INDICATE DETACH OPTION TAKEN @V305038 00176000
BR R14 RETURN/NSI @V305038 00177000
SPACE 00178000
NOOPTS EQU * @V305038 00179000
C R4,MAXPOSS IS IT GREATER THAN X'FFF'? @VA04296 00180000
BH ERROR2 NO IT CAN'T. 00181000
LTR R4,R4 =X'000'? @VA01991 00182000
BZ ERROR2 ERROR IF SO @VA01991 00183000
DOALL SLR R2,R2 SET UP A SIGNAL @V305038 00184000
SR R1,R1 START AT TOP. 00185000
SCANLOOP L R15,VCADTNXT LOCATE ADTNXT @VM03093 00186000
BALR R14,R15 GO THERE. 00187000
BNZ DONE BRANCH IF NONE LEFT. 00188000
USING ADTSECT,R1 00189000
L R5,ADTDTA GET DEVICE-TABLE ADDRESS. 00190000
CH R4,DTAD(,R5) COMPARE ADDRESS WITH THAT SUPPLIED. 00191000
BNE SCANLOOP NOT YET. 00192000
TM ADTFLG1,ADTFRO+ADTFRW HAS IT BEEN ACCESSED? 00193000
BNZ TESTS CHECK FOR S-DISK @V201101 00194000
TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00195000
BZ ERROR3P NO ... POSSIBLE ERROR 3 @VM03204 00196000
TESTS EQU * @V201101 00197000
CLI ADTM,C'S' IS IT THE SYSTEM DISK? 00198000
BE CAREFULS YES - BE CAREFUL WITH S-DISK @VM03204 00199000
LA R2,SCANLOOP SET RETURN...(ALSO SIGNAL) 00200000
RELIT LR R9,R1 LET R9 POINT TO THE ADT @VA01696 00201000
USING ADTSECT,R9 ... @VA01696 00202000
* CLOSE ANY FILES WHICH MIGHT BE ACTIVE ON THIS DISK: 00203000
IC R1,ADTM PICK UP MODE LETTER, @VA01696 00204000
STC R1,THISDISK STORE IN 'FINISALL' P-LIST @VA01696 00205000
LA R1,FINISALL POINT TO 'FINIS * * X' PLIST @VA01696 00206000
L R15,AFINIS CLOSE ALL/ANY OPEN FILES @V305032 00207000
BALR R14,R15 ... @V305032 00208000
LR R0,R9 LET R0 POINT TO ACTIVE DISK TBL @V305032 00209000
LR R1,R9 DITTO R1 (FOR VARIOUS USE) @V305032 00210000
TM ADTFLG1,ADTFRW IS IT A CMS READ-WRITE DISK ? @V305032 00211000
BZ CLRELUFD NO - CALL RELUFD FORTHWITH @V305032 00212000
SR R15,R15 PERCHANCE NO FILES ? @V305032 00213000
C R15,ADTFSTC (E.G. ACCESS'D WITH ERASE OPT.) @V305032 00214000
BE CLRELUFD YES - DON'T UPDATE DIRECTORY. @V305032 00215000
CLM R11,B'1000',COMM ISSUED AS A FUNCTION CALL ? @V304332 00216000
BL CLRELUFD YES - OMIT SORT & UPDISK CALLS @V304332 00217000
CLM R11,B'1000',EXEC CHECK FURTHER ... @V304332 00218000
BH CLRELUFD BRANCH IF IT WAS A FUNCTION. @V304332 00219000
L R15,=V(SORTFST) NO - SORT ALL THE FST ENTRIES @V305032 00220000
BALR R14,R15 (VIA SUBROUTINE IN DMSALU) @V305032 00221000
OI ADTFLG3,ADTFNOAB SIGNAL "NO ABEND WANTED" @VM03177 00222000
L R15,AUPDISK AND CALL DMSAUD ("UPDISK") @V305032 00223000
BALR R14,R15 TO UPDATE THE (SORTED) DIRECTORY @V305032 00224000
DROP R9 NOTE: R0 STILL POINTS TO THE ADT @V305032 00225000
CLRELUFD L R15,ARELUFD NOW REALLY RELEASE THE DISK @V305032 00226000
BALR R14,R15 VIA THE "RELUFD" ROUTINE @V305032 00227000
OI AREFLAG,RELTHISD REMEMBER WE RELEASED THIS DISK @VM03204 00228000
L R8,ADTDTA GET THE DEVICE TABLE ADDRESS 00229000
SR R15,R15 00230000
ST R15,DTAD(,R8) AND ZERO IT OUT 00231000
BR R2 AND RETURN (POSSIBLY FOR MORE?). 00232000
SPACE 00233000
CAREFULS OI AREFLAG,RELSDISK SIGNAL DISK MATCHES S-DISK @VM03204 00234000
B SCANLOOP AND EXAMINE REMAINING ADT BLOCKS @VM03204 00235000
SPACE 00236000
DONE LTR R2,R2 DID WE FIND IT? 00237000
BNZ EXIT IF R2 NONZERO, WE'RE ALL DONE. @VM03204 00238000
TM AREFLAG,RELSDISK DID WE FIND S-DISK IN SEARCH? @VM03204 00239000
BO ERROR2 IF YES, MAKE THAT ERROR2 @VM03204 00240000
B ERROR3MS OTHERWISE, CHECK IF ERROR @VA04877 00241000
* MESSAGE NEEDED 00242000
SPACE 00243000
CKMODE CLI 0(R3),C'A' MODE LESS THAN 'A'? 00244000
BL ERROR4 YES, ERROR. 00245000
CLI 0(R3),C'Z' HIGHER THAN 'Z'? 00246000
BH ERROR4 YES, ALSO ERROR. 00247000
CLI 0(R3),C'S' IS IT THE SYSTEM-DISK? 00248000
BE ERROR4 ERROR FOR NOW. 00249000
CLI 16(R1),X'FF' ANY EXTRA PARAMETERS? 00250000
BAL R14,OPCHK GO CHECK FOR DETACH OPTION @V305038 00251000
LA R4,16 GET A HANDY CONSTANT. 00252000
SR R1,R4 ...TO BACK UP THE P-LIST POINTER. 00253000
L R15,VCADTLKP SEE IF IT IS KNOWN. @VM03093 00254000
BALR R14,R15 IS IT? 00255000
BNZ ERROR4 NO. 00256000
USING ADTSECT,R1 00257000
TM ADTFLG1,ADTFRO+ADTFRW IS IT ACCESSED? 00258000
BNZ FREEIT YES..BRANCH @V201101 00259000
TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00260000
BZ ERROR6 NO...ERROR @V201101 00261000
FREEIT EQU * @V201101 00262000
L R4,ADTDTA ADDR OF ACTIVE DISK TABLE @V305038 00263000
UNPK DIAGMSG+8(4),0(3,R4) CONVERT DEVICE ADDRESS @VA08082 00264000
TR DIAGMSG+8(3),HEXTAB-C'0' TO HEX @VA08082 00265000
CLI 0(R6),DETOPT DETACH OPTION SPECIFIED? @V305032 00266000
BNE ONLYONE NOPE, ONLY RELEASE SPECIFIED @V305038 00267000
* DEVICE 00268000
LH R4,DTAD(R4) IF DET, DO ALL DEVICES WITH @V305038 00269000
* SAME CCU 00270000
B DOALL ... @V305038 00271000
DROP R1 00272000
ONLYONE BAL R2,RELIT @V305038 00273000
EXIT CLI 0(R6),DETOPT WAS DETACH OPTION SPECIFIED? @V305032 00274000
BNE NODIAG NOPE, SKIP @V305038 00275000
TM AREFLAG,RELSDISK WAS THIS REALLY THE S-DISK ? @VM03204 00276000
BO NODIAG YES - IGNORE THE 'DET' OPTION. @VM03204 00277000
TM BATFLAGS,BATRUN+BATLOAD BATCH RUNNING @VA08082 00278000
BC 11,NOTBAT NO, SKIP BTP @VA08082 00279000
TM BATFLAGS,BATUSEX BATCH USER JOB @VA08082 00280000
BZ NOTBAT NO, SKIP BTP EXIT @VA08082 00281000
OI BATFLAGS,BATCPEX CP FUNCTION (CPF) CALL @VA08082 00282000
LA R1,CPDET POINT TO PLIST @VA08082 00283000
MVI DIAGMSG+11,X'40' PAD BLANK FOR BTP @VA08082 00284000
LR R2,R10 SAVE ACROSS CALL TO BTP @VA08082 00285000
L R15,ABATPROC BTP ADDRESS @VA08082 00286000
BALR R14,R15 CALL BTP @VA08082 00287000
LR R10,R2 RESTORE R10 @VA08082 00288000
LTR R15,R15 GOOD RETURN @VA08082 00289000
BNZ GETOUT NO, SAVE RETURN @VA08082 00290000
NOTBAT EQU * @VA08082 00291000
LA R1,=CL8'CONWAIT' SYNCHRONIZE CP DETACH MESSAGE @VM03214 00292000
SVC SVC202 ... @VM03214 00293000
LA R7,L'DIAGMSG-1 LENGTH OF MSG @V305038 00294000
DC X'83670008' ISSUE DETACH REQUEST @V305038 00295000
NODIAG SLR R15,R15 CLEAR AND EXIT @V305038 00296000
B GETOUT AND GETOUT. 00297000
EXIT1 LA R15,24 (MOST COMMON RETURN CODE). 00298000
GETOUT LR R14,R10 REMEMBER THE RETURN. 00299000
BR R14 LEAVE. 00300000
DS 0F @VA01696 00301000
FINISALL DC CL8'FINIS' CLOSE ALL... @VA01696 00302000
DC CL8'*' FILENAMES, @VA01696 00303000
DC CL8'*' FILETYPES, @VA01696 00304000
THISDISK DC CL2'X ' ON "THIS" DISK. @VA01696 00305000
SPACE 00306000
AREFLAG DC X'00' FLAGBYTE, USED AS FOLLOWS: @VM03204 00307000
RELTHISD EQU X'80' WE ALREADY RELEASED THIS DISK @VM03204 00308000
RELSDISK EQU X'40' S-DISK (AS ANOTHER) RELEASED @VM03204 00309000
SPACE 00310000
ZERO EQU X'00' (FOR CLEARING THE FLAG) @VM03204 00311000
SPACE 00312000
DC X'00' FOR ALIGNMENT/FUTURE USE @VM03204 00313000
SPACE 00314000
COMM DC X'0C' ISSUED AS A COMMAND @V304332 00315000
EXEC DC X'0E' ISSUED AS AN EXEC @V304332 00316000
EJECT 00317000
ERROR1 DMSERR NUM=28,LET=E,TEXT='NO DEVICE SPECIFIED' 00318000
B EXIT1 GETOUT 00319000
SPACE 00320000
ERROR2 DMSERR NUM=17,LET=E,SUB=(CHARA,(7)), X00321000
TEXT='INVALID DEVICE ADDRESS ''........''' 00322000
B EXIT1 GETOUT 00323000
SPACE 00324000
ERROR3P DS 0H POSSIBLE ERROR 3: @VM03204 00325000
TM AREFLAG,RELTHISD HAVE WE ALREADY RELEASED THIS? @VM03204 00326000
BO TESTS IF YES, FORGET IT. @VM03204 00327000
* NO - A TRUE ERROR 3; CONTINUE ... 00328000
ERROR3MS EQU * @VA04877 00329000
CLM R11,B'1000',COMM ISSUED AS A FUNCTION CALL? @VA04877 00330000
BL SET36 IF YES, BRANCH AND OMIT ERROR @VA04877 00331000
* MESSAGE 00332000
CLM R11,B'1000',EXEC CHECK FURTHER FOR FUNCTION CALL@VA04877 00333000
BH SET36 IF IT IS, OMIT ERROR MESSAGE @VA04877 00334000
ERROR3 DMSERR NUM=69,LET=E,SUB=(CHARA,(7)), P0814X00335000
TEXT='DISK ''...'' NOT ACCESSED' P0814 00336000
SET36 EQU * @VA04877 00337000
LA R15,36 00338000
B GETOUT SINCE WE SUPPLIED THE RETURN CODE. 00339000
SPACE 00340000
ERROR4 DMSERR NUM=48,LET=E,SUB=(CHARA,(7)), X00341000
TEXT='INVALID MODE ''..''' 00342000
B EXIT1 00343000
SPACE 00344000
ERROR5A LA R7,8(,R7) BUMP P-LIST PTR IF 40(R1) NG @V305032 00345000
ERROR5B LA R7,8(,R7) BUMP P-LIST PTR IF 32(R1) NG @V305032 00346000
ERROR5C LA R7,8(,R7) BUMP P-LIST PTR IF 24(R1) NG @V305032 00347000
ERROR5 LA R7,8(,R7) 00348000
DMSERR NUM=70,LET=E,SUB=(CHARA,(7)), X00349000
TEXT='INVALID PARAMETER ''........''' 00350000
B EXIT1 00351000
SPACE 00352000
ERROR6 DMSERR NUM=69,LET=E,SUB=(CHARA,(7)), X00353000
TEXT='DISK ''..'' NOT ACCESSED' 00354000
LA R15,36 00355000
B GETOUT SINCE WE HAVE THE RETURN CODE SET 00356000
SPACE 2 00357000
CPDET DS 0D PARM LIST FOR BTP @VA08082 00358000
DC CL8'CP' DUMMY HEADER @VA08082 00359000
DIAGMSG DC CL12'DETACH XXXY' DETACH (Y IS FOR UNPACK) @VA08082 00360000
DC CL4' ' PADDING @VA08082 00361000
HEXTAB DC C'0123456789ABCDEF' BINHEX CONVERT @V305038 00362000
ARELUFD DC A(RELUFD) 00363000
MAXPOSS DC XL4'FFF' MAXIMUM VIRTUAL DEVICE ADDRESS @VA04296 00364000
LTORG OTHER CONSTANTS... @VA01696 00365000
SPACE 00366000
* NEEDED EQUATES: 00367000
LTPAREN EQU C'(' LEFT PARENTHESIS @V305032 00368000
RTPAREN EQU C')' RIGHT PARENTHESIS @V305032 00369000
DETOPT EQU C'D' 'D' FOR 'DETACH' OPTION @V305032 00370000
FF EQU X'FF' INDICATES END OF P-LIST @V305032 00371000
SVC202 EQU 202 @VM03214 00372000
EJECT 00373000
NUCON 00374000
ADT 00375000
REGEQU 00376000
END 00377000