DSL TITLE 'DMSDSL (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME 00004000
* 00005000
* DMSDSL ( DOSLIB ) 00006000
* 00007000
* FUNCTION 00008000
* 00009000
* PROVIDE THE FACILITY TO DELETE MEMBERS (PHASES) 00010000
* OF A 'DOSLIB' LIBRARY, OR TO COMPRESS A 'DOSLIB' 00011000
* LIBRARY, OR TO LIST THE MEMBERS (PHASES) OF A 00012000
* SPECIFIED 'DOSLIB' LIBRARY. 00013000
* 00014000
* ATTRIBUTES 00015000
* 00016000
* DISK RESIDENT MODULE 00017000
* EXECUTES IN USER AREA 00018000
* 00019000
* ENTRY POINTS 00020000
* 00021000
* DMSDSL 00022000
* 00023000
* ENTRY CONDITIONS 00024000
* 00025000
* R1 = PARAMETER LIST 00026000
* 00027000
* DC CL8'DOSLIB' COMMAND 00028000
* DC CL8'DEL'|'COMP'|'MAP' FUNCTION 00029000
* DC CL8'FNAME' NAME OF DOSLIB LIBRARY 00030000
* DC CL8'PHASE1' (FIRST PHASE TO BE DEL.)... 00031000
* ... ONLY ALLOWED FOR 'DEL' 00032000
* DC CL8'PHASEN' ...(LAST PHASE TO BE DEL.) 00033000
* DC CL8'TERM'|'DISK'|'PRINT' OPTIONS..(FOR MAP ONLY) 00034000
* 00035000
* OPTIONS 00036000
* 00037000
* TERM - DIRECT MAP FILE TO USER'S CONSOLE 00038000
* DISK - DIRECT MAP FILE TO USER'S 'A' DISK 00039000
* - DISK IS DEFAULT ('FN' MAP A1) 00040000
* PRINT - DIRECT MAP FILE TO SPOOLED PRINTER 00041000
* 00042000
* EXIT CONDITIONS 00043000
* 00044000
* RETURN TO CALLER WITH RETURN CODE IN R15 00045000
* 00046000
* RETURN CODES AND MESSAGES: 00047000
* 00048000
* 4 - REQUESTED PHASE NOT IN SPECIFIED LIBRARY 00049000
* 4 - SPECIFIED LIBRARY NOT CREATED 00050000
* 24 - NO PHASE NAME SPECIFIED 00051000
* 24 - INVALID OPTION SPECIFIED 00052000
* 24 - INVALID FUNCTION FOR THIS COMMAND 00053000
* 24 - NO LIBRARY NAME SPECIFIED 00054000
* 24 - NO FUNCTION SPECIFIED 00055000
* 24 - INVALID PARAMETER SPECIFIED 00056000
* 28 - SPECIFIED DOSLIB FILE NOT FOUND 00057000
* 36 - DISK OF LIBRARY ORIGIN IS R/O 00058000
* 100 - ERROR READING FILE FROM DISK 00059000
* 100 - ERROR WRITING FILE TO DISK 00060000
* 00061000
* CALLS TO OTHER ROUTINES 00062000
* 00063000
* DMSERR, DMSERS, DMSFLD, DMSKEY, DMSRNE, 00064000
* DMSSBS, DMSSOP, DMSSTT, DMSSVT 00065000
* 00066000
* EXTERNAL REFERENCES 00067000
* 00068000
* NUCON, DCBD, CMSCB, ADT 00069000
* 00070000
* TABLES/WORK AREAS 00071000
* 00072000
* INTERNAL DCBS 00073000
* 00074000
* REGISTER USAGE 00075000
* 00076000
* R0 NUCON ADDRESSABILITY 00077000
* R1 DCB ADDRESSABILITY 00078000
* R2 COMMAND LINE POINTER 00079000
* R3 WORK 00080000
* R4 WORK 00081000
* R5 WORK 00082000
* R6 NOT USED 00083000
* R7 NOT USED 00084000
* R8 CMSCB ADDRESSABILITY 00085000
* R9 NOT USED 00086000
* R10 INTERNAL LINKAGE 00087000
* R11 NOT USED 00088000
* R12 DMSDSL ADDRESSABILITY 00089000
* R13 NOT USED 00090000
* R14 EXTERNAL LINKAGE 00091000
* R15 ADDRESS LINKING ROUTINE & RETURN CODE 00092000
* 00093000
* OPERATION 00094000
* 00095000
* 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00096000
* THE RETURN REGISTER. ACQUIRE SUPERVISOR KEY 00097000
* AND CLEAR ALL NON PERMANENT FCB'S. 00098000
* 00099000
* 2. VERIFY THAT THE SPECIFIED FUNCTION IS VALID 00100000
* (MAP, DEL, OR COMP). VERIFY THAT A LIBRARY 00101000
* NAME IS ALSO SPECIFIED. IF THE 'DEL' FUNCTION 00102000
* IS SPECIFIED, ENSURE THERE IS AT LEAST ONE 00103000
* MEMBER (PHASE) SPECIFIED IN THE COMMAND LINE. 00104000
* 00105000
* 3. PROCESSING OF THE 'DEL' FUNCTION STARTS BY 00106000
* VERIFYING THE EXISTANCE OF THE LIBRARY ON 00107000
* A R/W DISK. THE OUTPUT DCB IS OPENED AND THE 00108000
* SPECIFIED PHASES ARE DELETED ISSING THE O/S 00109000
* 'STOW' MACRO. A WARNING MESSAGE IS ISSUED FOR 00110000
* ALL NOT FOUND PHASES SPECIFIED IN THE COMMAND. 00111000
* 00112000
* 4. PROCESSING OF THE 'COMP' FUNCTION STARTS BY 00113000
* VERIFYING THE EXISTANCE OF THE LIBRARY ON A 00114000
* R/W DISK. THE INPUT AND OUTPUT DCB'S ARE OPENED 00115000
* AND ALL ACTIVE MEMBERS ON THE INPUT LIBRARY ARE 00116000
* COPIED TO THE OUTPUT WORK FILE. ALL I/O IS DONE 00117000
* USING THE O/S 'FIND', 'READ', 'WRITE' AND 'STOW' 00118000
* MACROS. ONCE THE OLD LIBRARY HAS BEEN COPIED, 00119000
* THE OLD LIBRARY IS ERASED AND THE WORK FILE IS 00120000
* RENAMED TO THE SAME NAME AS THE OLD LIBRARY. IF 00121000
* THE OLD LIBRARY HAS NO ACTIVE MEMBERS, THE NEW 00122000
* LIBRARY IS NOT CREATED AND THE OLD LIBRARY IS 00123000
* ERASED. A WARNING MESSAGE IS ALSO ISSUED. 00124000
* 00125000
* 5. PROCESSING OF THE 'MAP' FUNCTION STARTS BY 00126000
* VERIFYING THE EXISTANCE OF THE INPUT LIBRARY. 00127000
* ONLY ONE OPTION IS ALLOWED ('DISK', 'PRINT' 00128000
* OR 'TERM'). DEPENDING ON THE OPTION SPECIFIED, 00129000
* OR DEFAULTED, THE OUTPUT FILE IS DETERMINED. 00130000
* IF THE OPTION IS 'DISK', A TEST IS MADE TO 00131000
* CHECK IF THE 'A' DISK IS R/W. THE INPUT AND 00132000
* OUTPUT DCB'S ARE OPENED AND BY USING THE O/S 00133000
* 'FIND' MACRO, THE DIRECTORY FOR EACH MEMBER 00134000
* IS ACQUIRED AND ALL NECESSARY INFORMATION IS 00135000
* WRITTEN TO THE OUTPUT FILE. 00136000
* 00137000
* 6. WHEN ALL PROCESSING HAS BEEN DONE FOR ANY OF 00138000
* THE FUNCTIONS, THE INPUT AND/OR OUTPUT DCB(S) 00139000
* IS/ARE CLOSED. ANY ACQUIRED FCB(S) ARE CLEARED. 00140000
* 00141000
* 7. A SWITCH TO PROBLEM PROGRAM KEY IS DONE, AND A 00142000
* RETURN TO THE CALLER IS MADE PASSING IN REG. 15 00143000
* THE RETURN CODE OF THE COMMAND. 00144000
*. 00145000
EJECT 00146000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00147000
* * 00148000
* INITIALIZATION... ESTABLISH ADDRESSABILITIES * 00149000
* CLEAR ALL NON-PERM FCBS * 00150000
* ENSURE 'DOSSVC' ENVIRONMENT NOT ACTIVE * 00151000
* * 00152000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00153000
SPACE 2 00154000
DMSDSL CSECT @V305001 00155000
USING NUCON,R0 @V305001 00156000
USING IHADCB,R1 @V305001 00157000
USING DIRNAME,R2 @V305001 00158000
USING FCBSECT,R8 @V305001 00159000
USING DMSDSL,R12 @V305001 00160000
LR R12,R15 ESTABLISH BASE @V305001 00161000
ST R14,SAVE14 SAVE RETURN REGISTER @V305001 00162000
DMSKEY NUCLEUS @V305001 00163000
LR R2,R1 SAVE COMMAND LINE PTR @V305001 00164000
LA R1,FCLEAR FILEDEF PLIST TO R1 @V305001 00165000
SVC 202 CLEAR NON-PERM FCBS @V305001 00166000
DC AL4(*+4) NO-OP @V305001 00167000
MVC SAVEDOS,DOSFLAGS SAVE DOS FLAGS FOR NOW @V305001 00168000
NI DOSFLAGS,255-DOSSVC TURN DOSSVC OFF @V305001 00169000
EJECT 00170000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00171000
* * 00172000
* CHECK COMMAND LINE FOR VALID ARGUMENTS. * 00173000
* * 00174000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00175000
SPACE 2 00176000
LA R1,8(,R2) BUMP TO FUNCTION @V305001 00177000
CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00178000
BE ERR047 NO, ERROR @V305001 00179000
CLC MAP,0(R1) IS FUNCTION MAP ? @V305001 00180000
BNE CKCOMP NO, CHECK COMP @V305001 00181000
OI SSW,OMAP SET MAP FLAG @V305001 00182000
B CKLIBN GO CHECK LIBNAME @V305001 00183000
CKCOMP CLC COMP,0(R1) IS FUNCTION COMP ? @V305001 00184000
BNE CKDEL NO, CHECK DEL @V305001 00185000
OI SSW,OCOMP SET COMP FLAG @V305001 00186000
B CKLIBN GO CHECK LIBNAME @V305001 00187000
CKDEL CLC DEL,0(R1) IS FUNCTION DEL ? @V305001 00188000
BNE ERR014 NO, ERROR @V305001 00189000
OI SSW,ODEL SET DEL FLAG @V305001 00190000
CKLIBN LA R1,8(,R1) POINT TO LIBNAME @V305001 00191000
CLI 0(R1),FENCE ANY MORE ON LINE ? @V305001 00192000
BE ERR046 NO, ERROR @V305001 00193000
CLI 0(R1),LPAR LEFT PARENS ? @V305001 00194000
BE ERR046 YES, ERROR @V305001 00195000
CLI 0(R1),RPAR RIGHT PARENS ? @V305001 00196000
BE ERR070 YES, ERROR @V305001 00197000
MVC FNAME1,0(R1) SET USER'S LIBNAME @V305001 00198000
LA R1,8(,R1) BUMP TO NEXT PARAM @V305001 00199000
ST R1,SAVE1 SAVE PARAM POINTER @V305001 00200000
TM SSW,OMAP MAP SPECIFIED ? @V305001 00201000
BO PMAP PROCESS MAP REQUEST @V305001 00202000
TM SSW,OCOMP COMP SPECIFIED ? @V305001 00203000
BO PCOMP PROCESS COMP REQUEST @V305001 00204000
SR R2,R2 CLEAR MEMBER COUNT @V305001 00205000
MEMLUP CLI 0(R1),FENCE ANY MORE ? @V305001 00206000
BE PDEL NO, BRANCH @V305001 00207000
CLI 0(R1),LPAR LEFT PARENS ? @V305001 00208000
BE ERR070 YES, ERROR @V305001 00209000
CLI 0(R1),RPAR RIGHT PARENS ? @V305001 00210000
BE ERR070 YES, ERROR @V305001 00211000
LA R1,8(,R1) BUMP TO OPTION @V305001 00212000
LA R2,1(,R2) INCREMENT COUNT @V305001 00213000
B MEMLUP KEEP CHECKING 'TILL EOL @V305001 00214000
EJECT 00215000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00216000
* * 00217000
* PROCESS DEL (DELETE) FUNCTION * 00218000
* * 00219000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00220000
SPACE 2 00221000
PDEL LTR R2,R2 ANY MEMBERS ? @V305001 00222000
BZ ERR098 NO, ERROR @V305066 00223000
BAL R10,CHKIPT CHECK INPUT FILE @V305001 00224000
L R3,SAVE1 GET POINTER TO MEMBERS @V305001 00225000
SR R4,R4 ZERO RETURN CODE @V305001 00226000
PDEL2 MVC MEMBER,0(R3) MOVE NAME TO STOW FIELD @V305001 00227000
STOW DOSIN,MEMBER,D DELETE THE MEMBER ENTRY @V305001 00228000
LTR R15,R15 MEMBER FOUND ? @V305001 00229000
BZ PDEL3 YES, BRANCH @V305001 00230000
BAL R10,ERR013 GIVE WARNING TO USER @V305001 00231000
LA R4,RC4 SET UP RETURN CODE @V305066 00232000
PDEL3 LA R3,8(,R3) POINT TO NEXT MEMBER @V305001 00233000
BCT R2,PDEL2 KEEP LOOPING @V305001 00234000
LR R15,R4 RETURN CODE TO R15 @V305001 00235000
B EXIT ALL DONE... @V305001 00236000
EJECT 00237000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00238000
* * 00239000
* PROCESS COMP (COMPRESS) FUNCTION * 00240000
* * 00241000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00242000
SPACE 2 00243000
PCOMP CLI 0(R1),FENCE ANY MORE ON LINE ? @V305001 00244000
BNE ERR070 IF MORE, ERROR @V305001 00245000
BAL R10,CHKIPT CHECK INPUT FILE @V305001 00246000
MVC FMODE2,FMODE1 SET UP OUTPUT FILE MODE @V305001 00247000
MVC FMODE3,FMODE2 SET UP ERASE FILE MODE @V305001 00248000
LA R1,ERASE ERASE PLIST TO R1 @V305001 00249000
L R15,AERASE GET DMSERS ADDRESS @V305001 00250000
BALR R14,R15 ERASE ANY OLD WORK FILE @V305001 00251000
LA R1,OUTFDEF FILEDEF PLIST TO R1 @V305001 00252000
SVC 202 FILEDEF OUTPUT FILE @V305001 00253000
DC AL4(*+4) NO-OP @V305001 00254000
OPEN (DOSOUT,OUTPUT) @V305001 00255000
TM DCBOFLGS,OPNOK DCB OPENED OK ? @V305066 00256000
BZ EXIT NO, JUST GET OUT @V305001 00257000
PCOMP2 FIND DOSIN,MEMBER,D @V305001 00258000
LTR R15,R15 RETURN OK FROM FIND ? @V305001 00259000
BNZ PCOMP5 NO, THAT IS ALL @V305001 00260000
OI SSW,MEMFND SET MEMBER FOUND FLAG @V305001 00261000
PCOMP3 BAL R10,READ GO READ RECORD @V305001 00262000
LA R1,DOSIN POINT TO INPUT DCB @V305001 00263000
L R1,DCBIOBA GET IOB ADDRESS @V305001 00264000
LH R1,22(,R1) GET RESIDUAL COUNT @V305001 00265000
LA R2,BLOCKL GET MAX BLOCK LENGTH @V305001 00266000
SR R2,R1 COMPUTE BYTES READ @V305001 00267000
BAL R10,WRITE WRITE THIS RECORD @V305001 00268000
B PCOMP3 LOOP 'TILL MEMBER EOF @V305001 00269000
PCOMP4 STOW DOSOUT,MEMBER,R @V305001 00270000
B PCOMP2 GO GET NEXT MEMBER @V305001 00271000
PCOMP5 OI SSW,COMPOK SIGNAL COMP ALL DONE @V305001 00272000
TM SSW,MEMFND ANY MEMBER FOUND ? @V305001 00273000
BZ ERR213 NO, GIVE MSG TO USER @V305001 00274000
B ALLDONE ALL DONE... @V305001 00275000
EJECT 00276000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00277000
* * 00278000
* PROCESS MAP FUNCTION * 00279000
* * 00280000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00281000
SPACE 2 00282000
PMAP CLI 0(R1),FENCE ANY MORE ON LINE ? @V305001 00283000
BE PMAP2 NO, GOOD LINE THEN @V305001 00284000
CLI 0(R1),LPAR BEGIN OF OPTIONS ? @V305001 00285000
BNE ERR070 NO, ERROR @V305001 00286000
LA R1,8(,R1) BUMP TO OPTION @V305001 00287000
CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00288000
BE PMAP2 NO, GOOD LINE THEN @V305001 00289000
CKTERM CLC 0(5,R1),=CL5'TERM' TERM OPTION ? @VM03240 00290000
BNE CKDSK NO, CHECK FOR DISK @V305001 00291000
NI SSW,255-OPRINT SET PRINT OFF IF ON.. @VM03240 00292000
OI SSW,OTERM SET TERM OPTION @V305001 00293000
B CKLAST CHECK FOR MORE ARGUMENTS @V305001 00294000
CKDSK CLC 0(5,R1),=CL5'DISK' DISK OPTION ? @VM03240 00295000
BNE CKPRT NO, CHECK FOR PRINT @VM03240 00296000
NI SSW,255-(OTERM+OPRINT) SET TERM AND PRINT OFF @VM03240 00297000
B CKLAST CHECK FOR MORE ARGUMENTS @VM03240 00298000
CKPRT CLC 0(6,R1),=CL6'PRINT' PRINT OPTION ? @VM03240 00299000
BNE ERR003 NO, ERROR @V305001 00300000
NI SSW,255-OTERM SET TERM OFF IF ON.. @VM03240 00301000
OI SSW,OPRINT SET PRINT OPTION @V305001 00302000
CKLAST LA R1,8(,R1) BUMP TO NEXT PARAMETER @V305001 00303000
CLI 0(R1),FENCE IS THIS ALL ? @V305001 00304000
BE PMAP2 YES, GOOD LINE @V305001 00305000
CLI 0(R1),RPAR DITTO @V305001 00306000
BNE CKTERM IF NOT RPAR, CHECK NEXT OPTN. @VM03240 00307000
EJECT 00308000
PMAP2 BAL R10,CHKIPT CHECK INPUT FILE @V305001 00309000
TM SSW,OPRINT MAP TO PRINTER ? @V305001 00310000
BO PMAP4 YES, BRANCH @V305001 00311000
TM SSW,OTERM MAP TO TERMINAL ? @V305001 00312000
BO PMAP5 YES, BRANCH @V305001 00313000
MVC FNAME2,FNAME1 SET UP DISK FILE NAME @V305001 00314000
MVC FTYPE2,MAP DITTO FOR FILE TYPE @V305001 00315000
MVI FMODE2,MODEA MODE TO 'A' DISK @V305066 00316000
MVC FNAME3(24),FNAME2 SET UP ERASE PLIST @V305001 00317000
LA R1,FMODE3-24 POINT AT FM FOF A-DISK @V305066 00318000
L R15,VCADTLKP AND MAKE SURE IT IS ACCESSED @VM03093 00319000
BALR R14,R15 ... @V305066 00320000
BNZ ERR069 ERROR IF NOT FOUND @V305066 00321000
USING ADTSECT,R1 ADT ADDRESSABILITY @V305066 00322000
TM ADTFLG1,ADTFRW MAKE SURE RW @V305066 00323000
BZ RO ERROR IF NOT R/W @V305066 00324000
USING IHADCB,R1 DCB ADDRESSABILITY @V305001 00325000
LA R1,ERASE ERASE PLIST TO R1 @V305001 00326000
L R15,AERASE GET DMSERS ADDRESS @V305001 00327000
BALR R14,R15 ERASE ANY OLD MAP FILE @V305001 00328000
PMAP2A LA R1,OUTFDEF FILEDEF PLIST TO R1 @V305001 00329000
SVC 202 FILEDEF MAP FILE @V305001 00330000
DC AL4(*+4) NO-OP @V305001 00331000
LA R1,DOSOUT POINT TO OUTPUT DCB @V305001 00332000
MVI DCBRECFM,FXD RECFM = FXD @V305001 00333000
MVI DCBDSORG,PS DSORG = PS @V305001 00334000
LA R2,TWENTY4 BLOCK SIZE OF 24 FOR MAP.. @V305066 00335000
STH R2,DCBBLKSI BLKSI = 24 @V305001 00336000
OPEN (DOSOUT,OUTPUT) @V305001 00337000
TM DCBOFLGS,OPNOK DCB OPENED OK ? @V305066 00338000
BZ EXIT NO, GET OUT @V305001 00339000
PMAP3 BAL R10,OUTLINE DO HEADING FIRST @V305001 00340000
FIND DOSIN,MEMBER,D @V305001 00341000
LTR R15,R15 MEMBER FOUND ? @V305001 00342000
BNZ ALLDONE NO, THAT IS ALL THEN @V305001 00343000
LH R3,FCBITEM GET INDEX TO PHASE @V305001 00344000
XC BUFFER(34),BUFFER ZERO ENOUGH FOR DIRECTORY @V305001 00345000
BAL R10,READ GO READ DIRECTORY @V305001 00346000
LA R2,BUFFER POINT TO DIRECTORY @V305001 00347000
LH R4,DIRTT GET NO. TEXT BLOCKS @V305001 00348000
SR R5,R5 ... @V305001 00349000
IC R5,DIRR GET NO. EXTRA RLD BLOCKS @V305001 00350000
LA R4,1(R5,R4) NUMBER TOTAL BLOCKS @V305001 00351000
B PMAP3 KEEP LOOKING FOR MORE @V305001 00352000
EJECT 00353000
PMAP4 LA R1,PRTLST PRINTER FILEDEF @V305001 00354000
B PMAP6 GO OVERLAY FILEDEF PLIST @V305001 00355000
PMAP5 LA R1,TYPLST TERMINAL FILEDEF @V305001 00356000
PMAP6 MVC FDEV2(16),0(R1) SET UP PROPER FILEDEF @V305001 00357000
B PMAP2A GO ISSUE FILEDEF @V305001 00358000
RO LA R2,FMODE3 POINT TO DISK MODE @V305066 00359000
B ERR37E BRANCH TO PRINT MSG @V305066 00360000
EJECT 00361000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00362000
* * 00363000
* BPAM I/O ROUTINES * 00364000
* * 00365000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00366000
SPACE 2 00367000
READ EQU * @V305001 00368000
READ RDECB,SF,DOSIN,BUFFER,BLOCKL @V305001 00369000
CHECK RDECB @V305001 00370000
BR R10 RETURN TO CALLER @V305001 00371000
SPACE 1 00372000
WRITE EQU * @V305001 00373000
WRITE WRECB,SF,DOSOUT,BUFFER,(R2) @V305001 00374000
CHECK WRECB @V305001 00375000
BR R10 RETURN TO CALLER @V305001 00376000
EJECT 00377000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00378000
* * 00379000
* CHECK EXISTANCE OF INPUT LIBRARY. VERIFY THAT LIBRARY * 00380000
* RESIDES ON R/W DISK. FILDEF INPUT DDNAME AND IN CASE * 00381000
* OF 'COMP' OR 'MAP', SET 'MOVE PDS' FLAG IN INPUT DCB. * 00382000
* OPEN THE 'DOSIN' DCB FOR INPUT ( COMP OR MAP) OR FOR * 00383000
* OUTPUT (DEL ONLY). IF DCB DID NOT OPEN, JUST RETURN TO * 00384000
* TO CALLER WITH NO MSG, SINCE SOP ALREADY TYPED ONE. * 00385000
* * 00386000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00387000
SPACE 2 00388000
CHKIPT MVC STTFILE,FNAME1 SET UP STATE FILEID @V305001 00389000
LA R1,STATE STATE PLIST TO R1 @V305001 00390000
L R15,ASTATE GET DMSSTT ADDRESS @V305001 00391000
BALR R14,R15 SEE IF FILE EXISTS @V305001 00392000
LTR R15,R15 FILE FOUND ? @V305001 00393000
BNZ ERR002 NO, ERROR @V305001 00394000
L R1,STTFST GET FILE'S FST BLOCK @V305001 00395000
USING FSTSECT,R1 @V305001 00396000
L R1,FSTL(,R1) GET POINTER TO FILE'S ADT @V305001 00397000
DROP R1 @V305001 00398000
USING ADTSECT,R1 @V305001 00399000
MVC FMODE1(1),ADTM SAVE FILE'S MODE @V305001 00400000
TM SSW,OMAP JUST DOING MAP ? @V305001 00401000
BO NORWCK YES, DON'T CHECK R/W STATUS @V305001 00402000
TM ADTFLG1,ADTFRW IS DISK R/W ? @V305001 00403000
BZ ERR037 NO, ERROR @V305001 00404000
DROP R1 @V305001 00405000
NORWCK LA R1,INFDEF FILEDEF PLIST TO R1 @V305001 00406000
SVC 202 FILEDEF INPUT FILE @V305001 00407000
DC AL4(*+4) NO-OP @V305001 00408000
LPR R8,R0 GET FCB ADDRESS @V305001 00409000
NI FCBIOSW2,255-FCBMVPDS CLEAR FLAG @V305001 00410000
TM SSW,ODEL DELETING ? @V305001 00411000
BO OPENOUT YES, BRANCH @V305001 00412000
OI FCBIOSW2,FCBMVPDS SET MOVE PDS FLAG IN FCB @V305001 00413000
USING IHADCB,R1 @V305001 00414000
LA R1,DOSIN POINT TO INPUT DCB @V305001 00415000
XC DCBMACR+1(1),DCBMACR+1 ZERO WRITE MACRF @V305001 00416000
OPEN (DOSIN,INPUT) @V305001 00417000
TM SSW,OMAP ARE WE DOING MAP ? @V305066 00418000
BZ CHKOPEN NO, LEAVE EODAD ADDRESS ALONE @V305066 00419000
LA R15,ERR104 POINT TO ERR104 ADDRESS @V305066 00420000
ST R15,DCBEODAD AND USE AS MAP'S EODAD ROUTINE @V305066 00421000
B CHKOPEN GO CHECK IF OPEN OK @V305001 00422000
EJECT 00423000
OPENOUT OPEN (DOSIN,OUTPUT) @V305001 00424000
CHKOPEN TM DCBOFLGS,OPNOK DCB OPENED OK ? @V305066 00425000
BOR R10 YES, RETURN TO CALLER @V305001 00426000
LA R15,RC100 RETURN CODE = 100 @V305066 00427000
B EXIT GET OUT @V305001 00428000
EJECT 00429000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00430000
* * 00431000
* SET UP BUFFER CONTAINING NECCESSARY INFORMATION FOR * 00432000
* THE MAP REQUEST. DIRECT OUTPUT TO DISK, TERMINAL OR * 00433000
* PRINTER AS SPECIFIED BY THE USER. THE DEFAULT IS DISK * 00434000
* PRODUCING A CMS FILE WITH A FILENAME OF LIBNAME AND A * 00435000
* FILETYPE OF 'MAP' DIRECTED TO THE A-DISK. IF AN OLD * 00436000
* FILE WITH THAT SAME NAME EXISTS, IT IS ERASED. * 00437000
* * 00438000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00439000
SPACE 2 00440000
OUTLINE MVI BUFFER,BLANK INIT TO BLANK BUFFER @V305001 00441000
MVC BUFFER+1(79),BUFFER BLANK OUTPUT BUFFER @V305001 00442000
TM SSW,PASS1 HEADING OUT ALREADY ? @V305001 00443000
BO NOHEAD YES, BRANCH @V305001 00444000
MVC BUFFER(L'HEADING),HEADING SET UP HEADING @V305001 00445000
OI SSW,PASS1 SET HEADING DONE @V305001 00446000
B WRITE OUT THIS LINE @V305001 00447000
NOHEAD MVC BUFFER(8),MEMBER MOVE MEMBER NAME TO BUFFER @V305001 00448000
MVC BUFFER+8(L'MASK),MASK SET 'ED' MASK @V305001 00449000
N R3,MAXHW CLEAR POSS. PROPAGATE @V305001 00450000
CVD R3,WORK CONVERT INDEX TO DEC. @V305001 00451000
ED BUFFER+8(6),WORK+5 INDEX TO BUFFER @V305001 00452000
N R4,MAXHW CLEAR POSS. PROPAGATE @V305001 00453000
CVD R4,WORK CONVERT SIZE TO DEC. @V305001 00454000
ED BUFFER+14(6),WORK+5 SIZE TO BUFFER @V305001 00455000
B WRITE OUTPUT THIS LINE @V305001 00456000
EJECT 00457000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00458000
* * 00459000
* CLOSE ALL FILES OPENED, AND CLEAR ALL NON-PERM FCBS. * 00460000
* FOR COMPRESS, ERASE THE OLD LIBRARY, AND RENAME THE * 00461000
* THE WORK FILE TO THE SAME NAME AS THE OLD LIBRARY. * 00462000
* IF COMPRESS DID NOT TERMINATE NORMALLY, ONLY ERASE * 00463000
* THE WORK FILE. RESTORE THE PROPER SETTING OF 'DOSSVC' * 00464000
* AND RETURN BACK TO CALLER WITH PROPER RETURN CODE. * 00465000
* * 00466000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00467000
SPACE 2 00468000
ALLDONE SR R15,R15 ZERO RETURN CODE @V305001 00469000
EXIT LR R10,R15 TEMP SAVE RETURN CODE @V305001 00470000
LA R1,DOSIN GET INPUT DCB ADDR. @V305001 00471000
TM DCBOFLGS,OPNOK IS DCB OPEN ? @V305066 00472000
BZ CLSOUT NO, CHECK OUTPUT DCB @V305001 00473000
CLOSE DOSIN @V305001 00474000
CLSOUT LA R1,DOSOUT GET OUTPUT DCB ADDR. @V305001 00475000
TM DCBOFLGS,OPNOK IS DCB OPEN ? @V305066 00476000
BZ EXIT2 NO, GET OUT @V305001 00477000
CLOSE DOSOUT @V305001 00478000
EJECT 00479000
EXIT2 TM SSW,COMPOK COMP ALL DONE ? @V305001 00480000
BZ EXIT3 NO, EXIT3 @V305001 00481000
MVC FNAME3(24),FNAME1 SET UP ERASE FILEID @V305001 00482000
LA R1,ERASE ERASE PLIST TO R1 @V305001 00483000
L R15,AERASE GET DMSERS ADDRESS @V305001 00484000
BALR R14,R15 ERASE WORK FILE @V305001 00485000
TM SSW,MEMFND ANY MEMBER FOUND ? @V305001 00486000
BZ EXIT3 NO, BYPASS RENAME @V305001 00487000
MVC RNFILE1,FNAME2 SET UP RENAME PLIST @V305001 00488000
MVC RNFILE2,FNAME1 ... @V305001 00489000
LA R1,RENAME RENAME PLIST TO R1 @V305001 00490000
SVC 202 RENAME WORK TO OLD FILE @V305001 00491000
DC AL4(*+4) NO-OP @V305001 00492000
B EXIT4 BRANCH AROUND NEXT ERASE @V305001 00493000
EXIT3 TM SSW,OCOMP DOING COMPRESS ? @V305001 00494000
BZ EXIT4 NO, BRANCH @V305001 00495000
MVC FNAME3(24),FNAME2 SET TO ERASE WORK FILE @V305001 00496000
LA R1,ERASE ERASE PLIST TO R1 @V305001 00497000
L R15,AERASE GET DMSERS ADDRESS @V305001 00498000
BALR R14,R15 ERASE OLD FILE @V305001 00499000
EXIT4 LA R1,FCLEAR FILEDEF CLEAR @V305001 00500000
SVC 202 ALL NON-PERM FCB S @V305001 00501000
DC AL4(*+4) NO-OP @V305001 00502000
MVC DOSFLAGS,SAVEDOS RESTORE DOS FLAGS @V305001 00503000
DMSKEY RESET @V305001 00504000
L R14,SAVE14 LOAD RETURN REGISTER @V305001 00505000
LR R15,R10 RESTORE RETURN CODE @V305001 00506000
BR R14 RETURN TO CALLER @V305001 00507000
EJECT 00508000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00509000
* * 00510000
* STORAGE AND CONSTANT AREAS * 00511000
* * 00512000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00513000
SPACE 2 00514000
WORK DS D CVD/UNPK AREA @V305001 00515000
MEMBER DC D'0' PDS MEMBER NAME @V305001 00516000
ZEROS DC F'0' CONSTANT (MUST BE AFTER MEMBER) @V305001 00517000
MAXHW DC X'0000FFFF' SET UP NON NEG. HALF-WORD @V305001 00518000
SAVE14 DS F SAVE FOR RETURN REGISTER @V305001 00519000
SAVE1 DS F TEMP. SAVE FOR REG 1 @V305001 00520000
MASK DC X'402020202021402020202021' EDIT MASK @V305001 00521000
COMP DC CL8'COMP' FUNCTION @V305001 00522000
DEL DC CL8'DEL' FUNCTION @V305001 00523000
MAP DC CL8'MAP' FUNCTION @V305001 00524000
HEADING DC C'PHASE INDEX BLOCKS' MAP HEADING @V305001 00525000
* 00526000
FENCE EQU X'FF' FENCE CODE @V305001 00527000
LPAR EQU C'(' LEFT PARENS @V305001 00528000
RPAR EQU C')' RIGHT PARENS @V305001 00529000
BLANK EQU C' ' BLANK CODE @V305001 00530000
BLOCKL EQU 1024 MAX. BLOCK LENGTH @V305001 00531000
OPNOK EQU X'10' DCB OPEN BIT @V305066 00532000
MODEA EQU C'A' MODE LETTER 'A' @V305066 00533000
TWENTY4 EQU 24 MAP BLOCK SIZE @V305066 00534000
* 00535000
RC4 EQU 4 RETURN CODE @V305066 00536000
RC24 EQU 24 RETURN CODE @V305066 00537000
RC28 EQU 28 RETURN CODE @V305066 00538000
RC36 EQU 36 RETURN CODE @V305066 00539000
RC100 EQU 100 RETURN CODE @V305066 00540000
* 00541000
SAVEDOS DS X TEMP SAVE FOR DOS FLAGS @V305001 00542000
SSW DC X'00' INTERNAL SWITCH @V305001 00543000
* 00544000
* FLAGS FOR INTERNAL SWITCH 'SSW' 00545000
* 00546000
MEMFND EQU X'80' MEMBER FOUND BY COMP @V305001 00547000
OPRINT EQU X'40' PRINT OUTPUT @V305001 00548000
OTERM EQU X'20' TERM OUTPUT @V305001 00549000
PASS1 EQU X'10' HEADING DONE @V305001 00550000
OMAP EQU X'08' MAP FUNCTION @V305001 00551000
ODEL EQU X'04' DEL FUNCTION @V305001 00552000
OCOMP EQU X'02' COMP FUNCTION @V305001 00553000
COMPOK EQU X'01' COMP TERMINATED OK @V305001 00554000
EJECT 00555000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00556000
* * 00557000
* CMS FUNCTIONS PLISTS * 00558000
* * 00559000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00560000
SPACE 2 00561000
DS 0D @V305001 00562000
INFDEF DC CL8'FILEDEF' INPUT FILEDEF @V305001 00563000
DC CL8'DOSIN' DDNAME @V305001 00564000
DC CL8'DISK' DEVICE @V305001 00565000
FNAME1 DC CL8' ' FILE NAME @V305001 00566000
DC CL8'DOSLIB' FILE TYPE @V305001 00567000
FMODE1 DC CL8' ' FILE MODE @V305001 00568000
DC 8X'FF' FENCE @V305001 00569000
SPACE 1 00570000
DS 0D @V305001 00571000
OUTFDEF DC CL8'FILEDEF' OUTPUT FILEDEF @V305001 00572000
DC CL8'DOSOUT' DDNAME @V305001 00573000
FDEV2 DC CL8'DISK' DEVICE @V305001 00574000
FNAME2 DC CL8'DOSLIB' FILE NAME @V305001 00575000
FTYPE2 DC CL8'CMSUT1' FILE TYPE @V305001 00576000
FMODE2 DC CL8' ' FILE MODE @V305001 00577000
DC 8X'FF' FENCE @V305001 00578000
SPACE 1 00579000
DS 0D @V305001 00580000
STATE DC CL8'STATE' STATE COMMAND @V305001 00581000
STTFILE DC CL16' ' FILE NAME & TYPE @V305001 00582000
STTMODE DC CL2'*' FILE MODE @V305001 00583000
DC H'0' FILLER @V305001 00584000
STTFST DC A(0) ADDRESS OF FST @V305001 00585000
SPACE 1 00586000
DS 0D @V305001 00587000
ERASE DC CL8'ERASE' ERASE COMMAND @V305001 00588000
FNAME3 DC CL8'DOSLIB' FILE NAME @V305001 00589000
DC CL8'CMSUT1' FILE TYPE @V305001 00590000
FMODE3 DC CL8' ' FILE MODE @V305001 00591000
DC 8X'FF' FENCE @V305001 00592000
SPACE 1 00593000
DS 0D @V305001 00594000
RENAME DC CL8'RENAME' RENAME COMMAND @V305001 00595000
RNFILE1 DC CL24' ' FILE ID 1 @V305001 00596000
RNFILE2 DC CL24' ' FILE ID 2 @V305001 00597000
DC 8X'FF' FENCE @V305001 00598000
SPACE 1 00599000
FCLEAR DC CL8'FILEDEF' FILEDEF CLEAR PLIST @V305001 00600000
DC CL8'*' DDNAME @V305001 00601000
DC CL8'CLEAR' FUNCTION @V305001 00602000
DC 8X'FF' FENCE @V305001 00603000
EJECT 00604000
DS 0D @V305001 00605000
TYPLST DC CL8'TERMINAL' DEVICE NAME @V305001 00606000
DC 8X'FF' FENCE @V305001 00607000
SPACE 1 00608000
DS 0D @V305001 00609000
PRTLST DC CL8'PRINTER' DEVICE NAME @V305001 00610000
DC 8X'FF' FENCE @V305001 00611000
EJECT 00612000
DOSIN DCB DDNAME=DOSIN,DSORG=PO,RECFM=U,BLKSIZE=1024,MACRF=(R,W), *00613000
EODAD=PCOMP4,SYNAD=ERR104 @V305001 00614000
EJECT 00615000
DOSOUT DCB DDNAME=DOSOUT,DSORG=PO,RECFM=U,BLKSIZE=1024,MACRF=W, *00616000
SYNAD=ERR105 @V305001 00617000
EJECT 00618000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00619000
* * 00620000
* ERROR MESSAGES * 00621000
* * 00622000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00623000
SPACE 2 00624000
ERR098 EQU * @V305066 00625000
DMSERR TEXT='NO PHASE NAME SPECIFIED',NUM=98,LET=E @V305066 00626000
LA R15,RC24 RETURN CODE = 24 @V305066 00627000
B EXIT GET OUT @V305001 00628000
SPACE 1 00629000
ERR002 LA R2,FNAME1 POINT TO INPUT FILE @V305001 00630000
DMSERR TEXT='FILE ''....... DOSLIB'' NOT FOUND',NUM=2,LET=E, *00631000
SUB=(CHARA,(R2)) @V305001 00632000
LA R15,RC28 RETURN CODE = 28 @V305066 00633000
B EXIT GET OUT @V305001 00634000
EJECT 00635000
ERR003 LR R2,R1 POINT TO OPTION @V305001 00636000
DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, *00637000
SUB=(CHARA,(R2)) @V305001 00638000
LA R15,RC24 RETURN CODE = 24 @V305066 00639000
B EXIT GET OUT @V305001 00640000
SPACE 1 00641000
ERR013 EQU * @V305001 00642000
DMSERR TEXT='PHASE ''........'' NOT FOUND IN LIBRARY ''.......*00643000
.............''',NUM=13,LET=W, @V305001*00644000
SUB=(CHARA,(R3),CHAR8A,FNAME1),RENT=NO @V305001 00645000
BR R10 RETURN TO CALLER @V305001 00646000
EJECT 00647000
ERR014 LR R2,R1 POINT TO PARAMETER @V305001 00648000
DMSERR TEXT='INVALID FUNCTION ''........''',NUM=14,LET=E, *00649000
SUB=(CHARA,(R2)) @V305001 00650000
LA R15,RC24 RETURN CODE = 24 @V305066 00651000
B EXIT GET OUT @V305001 00652000
SPACE 1 00653000
ERR037 LA R2,FMODE1 POINT TO DISK MODE @V305001 00654000
ERR37E DMSERR TEXT='DISK ''..'' IS READ/ONLY',NUM=37,LET=E, @V305001*00655000
SUB=(CHARA,(R2)) @V305001 00656000
LA R15,RC36 RETURN CODE = 36 @V305066 00657000
B EXIT GET OUT @V305001 00658000
EJECT 00659000
ERR046 EQU * @V305001 00660000
DMSERR TEXT='NO LIBRARY NAME SPECIFIED',NUM=46,LET=E @V305001 00661000
LA R15,RC24 RETURN CODE = 24 @V305066 00662000
B EXIT GET OUT @V305001 00663000
SPACE 1 00664000
ERR047 EQU * @V305001 00665000
DMSERR TEXT='NO FUNCTION SPECIFIED',NUM=47,LET=E @V305001 00666000
LA R15,RC24 RETURN CODE = 24 @V305066 00667000
B EXIT GET OUT @V305001 00668000
ERR069 EQU * @V305066 00669000
LA R2,FMODE3 FILEMODE @V305066 00670000
DMSERR NUM=69,LET=E,SUB=(CHARA,((R2),1)),TEXT='DISK ''..'' NOT*00671000
ACCESSED' @V305066 00672000
LA R15,RC36 RETURN CODE = 36 @V305066 00673000
B EXIT GET OUT @V305066 00674000
EJECT 00675000
ERR070 LR R2,R1 POINT TO PARAMETER @V305001 00676000
DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70,LET=E, *00677000
SUB=(CHARA,(R2)) @V305001 00678000
LA R15,RC24 RETURN CODE = 24 @V305066 00679000
B EXIT GET OUT @V305001 00680000
SPACE 1 00681000
ERR213 LA R2,FNAME1 POINT TO LIBRARY @V305001 00682000
DMSERR TEXT='LIBRARY ''....................'' NOT CREATED', *00683000
NUM=213,LET=W,SUB=(CHAR8A,(R2)) @V305001 00684000
LA R15,RC4 RETURN CODE = 4 @V305066 00685000
B EXIT GET OUT @V305001 00686000
EJECT 00687000
ERR104 LH R2,RDECB+2 RDBUF ERROR CODE @V305001 00688000
DMSERR TEXT='ERROR ''..'' READING FILE ''.................... *00689000
''FROM DISK',NUM=104,LET=S,SUB=(DEC,(R2),CHAR8A,FNAME1),*00690000
RENT=NO @V305001 00691000
LA R15,RC100 RETURN CODE = 100 @V305066 00692000
B EXIT GET OUT @V305001 00693000
SPACE 1 00694000
ERR105 TM SSW,OPRINT+OTERM MAP PRINT OR TERM ? @V305001 00695000
BNZ ERR105E YES, DON'T ISSUE MESSAGE @V305001 00696000
LH R2,WRECB+2 WRBUF ERROR CODE @V305001 00697000
DMSERR TEXT='ERROR ''..'' WRITING FILE ''....................'*00698000
' TO DISK',NUM=105,LET=S,SUB=(DEC,(R2),CHAR8A,FNAME2), *00699000
RENT=NO @V305001 00700000
ERR105E LA R15,RC100 RETURN CODE = 100 @V305066 00701000
B EXIT GET OUT @V305001 00702000
EJECT 00703000
FCHTAB @V305001 00704000
NUCON @V305001 00705000
DCBD DSORG=PO,DEVD=DA @V305001 00706000
EJECT 00707000
CMSCB @V305001 00708000
FSTB @V305001 00709000
ADT @V305001 00710000
REGEQU @V305001 00711000
DMSDSL CSECT @V305001 00712000
DC CL2' ' @V305001 00713000
BUFFER DS CL1024 BUFFER @V305001 00714000
END 00715000