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