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