PRV TITLE 'DMSPRV (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME 00004000 * 00005000 * DMSPRV ( PSERV ) 00006000 * 00007000 * FUNCTION 00008000 * 00009000 * PROVIDE THE FACILITY TO COPY PROCEDURES IN THE 00010000 * DOS/VS SYSTEM PROCEDURE LIBRARY TO A SPECIFIED 00011000 * OUTPUT DEVICE. VALID OUTPUT DEVICES ARE VIRTUAL 00012000 * PRINTER, CMS DISK FILE, USER'S CONSOLE, AND/OR 00013000 * VIRTUAL PUNCH. 00014000 * 00015000 * ATTRIBUTES 00016000 * 00017000 * DISK RESIDENT MODULE 00018000 * EXECUTES IN USER AREA 00019000 * 00020000 * ENTRY POINTS 00021000 * 00022000 * DMSPRV 00023000 * 00024000 * ENTRY CONDITIONS 00025000 * 00026000 * R1 = PARAMETER LIST 00027000 * 00028000 * DC CL8'PSERV' COMMAND 00029000 * DC CL8'FNAME' NAME OF PROCEDURE TO COPY 00030000 * DC CL8'FTYPE' FILETYPE OF CMS DISK FILE 00031000 * ... ( ONLY APPLICABLE FOR DISK ) 00032000 * ... ( DEFAULTS TO PROC ) 00033000 * DC CL8'(' BEGIN OF OPTIONS IF ANY 00034000 * DC CL8'TERM'|'DISK'|'PRINT'|'PUNCH' ..OPTIONS.. 00035000 * 00036000 * OPTIONS 00037000 * 00038000 * TERM - DIRECT PROCEDURE FILE TO USER'S CONSOLE 00039000 * DISK - DIRECT PROCEDURE FILE TO USER'S 'A' DISK 00040000 * - DISK IS DEFAULT ('FN' PROC A1) 00041000 * PRINT - DIRECT PROCEDURE FILE TO SPOOLED PRINTER 00042000 * PUNCH - DIRECT PROCEDURE FILE TO SPOOLED PUNCH 00043000 * 00044000 * EXIT CONDITIONS 00045000 * 00046000 * RETURN TO CALLER WITH RETURN CODE IN R15 00047000 * 00048000 * RETURN CODES AND MESSAGES: 00049000 * 00050000 * 24 - NO PROCEDURE NAME SPECIFIED 00051000 * 24 - INVALID OPTION SPECIFIED 00052000 * 24 - INVALID PARAMETER SPECIFIED 00053000 * 28 - SPECIFIED PROCEDURE FILE NOT FOUND 00054000 * 32 - CMS/DOS ENVIRONMENT NOT ACTIVE 00055000 * 36 - NO READ/WRITE 'A' DISK ACCESSED 00056000 * 36 - NO SYSRES VOLUME ACTIVE 00057000 * 100 - SPECIFIED DISK IS NOT ATTACHED 00058000 * 100 - INPUT ERROR ON SYSRES OR SYSRLB 00059000 * 100 - ERROR WRITING FILE TO DISK 00060000 * 00061000 * CALLS TO OTHER ROUTINES 00062000 * 00063000 * DMSERR, DMSERS, DMSKEY, DMKGIO, DMSPIO 00064000 * DMSBWR, DMSCWR, DMSCIO, DMSCPF, DMSFNS 00065000 * 00066000 * EXTERNAL REFERENCES 00067000 * 00068000 * NUCON, BGCOM, MAPPUB 00069000 * 00070000 * TABLES/WORK AREAS 00071000 * 00072000 * NONE 00073000 * 00074000 * REGISTER USAGE 00075000 * 00076000 * R0 NUCON ADDRESSABILITY & WORK 00077000 * R1 COMMAND LINE POINTER & PLIST(S) POINTER 00078000 * R2 DIRECTORY BUFFER POINTER & WORK 00079000 * R3 WORK 00080000 * R4 NOT USED 00081000 * R5 NOT USED 00082000 * R6 NOT USED 00083000 * R7 NOT USED 00084000 * R8 NOT USED 00085000 * R9 NOT USED 00086000 * R10 INTERNAL LINKAGE 00087000 * R11 NOT USED 00088000 * R12 DMSPRV 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 INITIALIZE REUSABILITY FIELDS. VERIFY IF 00098000 * IN CMS/DOS ENVIRONMENT. 00099000 * 00100000 * 2. CHECK THE COMMAND LINE FOR VALID ARGUMENTS 00101000 * AND OPTIONS. ENSURE THAT A PROC. NAME WAS 00102000 * SPECIFIED. SET APPROPIATE SWITCHES FOR EACH 00103000 * OPTION SPECIFIED. IF THE 'DISK' OPTION IS 00104000 * SPECIFIED OR IMPLIED, ERASE ANY OLD FILE ON 00105000 * THE 'A' DISK. IF ERASE RETURNS A CODE OF 36, 00106000 * EITHER THE 'A' DISK IS R/O OR IS NOT ATTACHED. 00107000 * 00108000 * 3. DETERMINE IF THE SYSTEM PROCEDURE LIBRARY IS 00109000 * ACTIVE (IF IT EXISTS) AND START READING THE 00110000 * APPROPIATE LIBRARY DIRECTORY RECORDS TO FIND 00111000 * THE SPECIFIED PROCEDURE. ONCE THE PROCEDURE 00112000 * ENTRY IS FOUND, COMPUTE THE DISK ADDRESS OF 00113000 * THE PROCEDURE DATA BLOCKS. 00114000 * 00115000 * 4. READ THE PROCEDURE DATA BLOCKS ONE AT A TIME. 00116000 * DECODE EACH DATA BLOCK INTO CARD IMAGES, AND 00117000 * WRITE EACH CARD IMAGE ( AS IS ) TO THE OUTPUT 00118000 * DEVICE. 00119000 * 00120000 * 5. WHEN ALL PROCESSING HAS BEEN DONE, ALL OUTPUT 00121000 * DEVICES ARE CLOSED. 00122000 * 00123000 * 6. A SWITCH TO PROBLEM PROGRAM KEY IS DONE, AND A 00124000 * RETURN TO THE CALLER IS MADE PASSING IN REG. 15 00125000 * THE RETURN CODE OF THE COMMAND. 00126000 *. 00127000 EJECT 00128000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00129000 * * 00130000 * INITIALIZATION... ESTABLISH BASE REG. AND SAVE RETURN. * 00131000 * VERIFY CMS/DOS ENVIRONMENT ACTIVE * 00132000 * * 00133000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00134000 SPACE 2 00135000 DMSPRV CSECT @V305001 00136000 USING DMSPRV,R12 @V305001 00137000 USING NUCON,R0 @V305001 00138000 LR R12,R15 ESTABLISH BASE @V305001 00139000 ST R14,SAVE14 SAVE RETURN REGISTER @V305001 00140000 DMSKEY NUCLEUS @V305001 00141000 TM DOSFLAGS,DOSMODE IN CMS/DOS MODE ? @V305001 00142000 BZ ERR099 NO, ERROR @V305001 00143000 XC SSW,SSW CLEAR INTERNAL SWITCH @V305001 00144000 MVC FTYPE,PROC SET DEFAULT FILE TYPE @V305001 00145000 EJECT 00146000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00147000 * * 00148000 * CHECK COMMAND LINE FOR VALID ARGUMENTS AND OPTIONS. * 00149000 * SET APROPIATE SWITCHES FOR EACH OPTION SPECIFIED. * 00150000 * IF NO OPTIONS SPECIFIED, 'DISK' IS DEFAULT. * 00151000 * * 00152000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00153000 SPACE 2 00154000 LA R1,8(,R1) BUMP TO PROCEDURE NAME @V305001 00155000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00156000 BE ERR001 NO, ERROR @V305001 00157000 CLI 0(R1),LPAR DITTO ? @V305001 00158000 BE ERR001 NO, ERROR @V305001 00159000 MVC PCNAME,0(R1) SAVE PROCEDURE NAME @V305001 00160000 LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00161000 CLI 0(R1),FENCE ANY MORE ON LINE ? @V305001 00162000 BE OPTSOK NO, BRANCH @V305001 00163000 CLI 0(R1),LPAR LEFT PARENS ? @V305001 00164000 BE OPTLUP YES, PROCESS OPTIONS @V305001 00165000 MVC FTYPE,0(R1) SET USER'S FILE TYPE @V305001 00166000 LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00167000 CLI 0(R1),FENCE ANY MORE ? @V305001 00168000 BE OPTSOK NO, BRANCH @V305001 00169000 CLI 0(R1),LPAR LEFT PARENS ? @V305001 00170000 BNE ERR070 NO, ERROR @V305001 00171000 OPTLUP LA R1,8(,R1) BUMP TO OPTION @V305001 00172000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00173000 BE OPTSOK NO, ALL DONE WITH OPTIONS @V305001 00174000 CLI 0(R1),RPAR END OF OPTIONS ? @V305001 00175000 BE OPTSOK YES, ALL DONE WITH OPTIONS @V305001 00176000 CLC CDISK,0(R1) DISK OPTION ? @V305001 00177000 BNE CKPRT NO, CHECK PRINT @V305001 00178000 OI SSW,DISK SET DISK FLAG @V305001 00179000 B OPTLUP KEEP LOOKING @V305001 00180000 CKPRT CLC CPRINT,0(R1) PRINT OPTION ? @V305001 00181000 BNE CKPUN NO, CHECK PUNCH @V305001 00182000 OI SSW,PRINT SET PRINT FLAG @V305001 00183000 B OPTLUP KEEP LOOKING @V305001 00184000 CKPUN CLC CPUNCH,0(R1) PUNCH OPTION ? @V305001 00185000 BNE CKTRM NO, CHECK TERM @V305001 00186000 OI SSW,PUNCH SET PUNCH FLAG @V305001 00187000 B OPTLUP KEEP LOOKING @V305001 00188000 CKTRM CLC CTERM,0(R1) TERM OPTION ? @V305001 00189000 BNE ERR003 NO, ERROR @V305001 00190000 OI SSW,TERM SET TERM FLAG @V305001 00191000 B OPTLUP KEEP LOOKING @V305001 00192000 EJECT 00193000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00194000 * * 00195000 * IF 'DISK' OPTION SPECIFIED OR IMPLIED, ERASE ANY OLD * 00196000 * FILE ON THE 'A' DISK WITH THE SAME FILEID. IF ERASE * 00197000 * RETURNS A CODE OF 36, EITHER THE 'A' DISK IS R/O OR IS * 00198000 * NOT ATTACHED. IN EITHER CASE A MESSAGE IS ISSUED. * 00199000 * * 00200000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00201000 SPACE 2 00202000 OPTSOK CLI SSW,ZERO ANY OPTIONS SPECIFIED? @VA09217 00203000 BNE READDIR NOT DEFAULT - GO CHECK DIRECTORY @VA09217 00203600 OI SSW,DISK TURN ON DISK OPTION @VA09217 00204200 B READDIR GO CHECK DIRECTORY @VA09217 00204800 CHKDSK EQU * @VA09217 00205400 TM SSW,DISK WAS DISK SPECIFIED? @VA09217 00206000 BZ FNDENT NOT DISK - DONT BOTHER TO ERASE @VA09217 00206600 ERSOLD MVC FNAME,PCNAME SET UP FILENAME @VA09217 00207200 LA R1,DSKLST GET ERASE PLIST @V305001 00208000 L R15,AERASE GET DMSERS ADDRESS @V305001 00209000 BALR R14,R15 ERASE OLD FILE @V305001 00210000 CH R15,=H'36' ANY DISK PROBLEM ? @V305001 00211000 BE ERR006 YES,GIVE ERROR @VA09217 00212000 B FNDENT CONTINUE @VA09217 00213000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00214000 * * 00215000 * DETERMINE IF READING FROM SYSTEM PROCEDURE LIBRARY * 00216000 * AND READ LIBRARY DIRECTORY TO INITIATE SEARCH FOR * 00217000 * SPECIFIED PROCEDURE. ONCE THE PROCEDURE ENTRY IS * 00218000 * FOUND, COMPUTE THE DISK ADDRESS OF THE PROCEDURE * 00219000 * DATA BLOCKS. * 00220000 * * 00221000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00222000 SPACE 2 00223000 READDIR LA R3,SYSRES GET SYSRES LUB INDEX @V305001 00224000 L R1,ASYSREF GET BGCOM ADDRESS @V305001 00225000 USING BGCOM,R1 @V305001 00226000 AH R3,LUBPT POINT TO CORRECT LUB ENTRY @V305001 00227000 TM 0(R3),UNASSGN UNIT ASSIGNED ? @V305001 00228000 BO ERR097 NO, ERROR @V305001 00229000 LH R3,0(,R3) LUB ENTRY TO REG 3 @V305001 00230000 SRL R3,8 ISOLATE PUB POINTER @V305001 00231000 SLL R3,3 MULTIPLY BY 8 @V305001 00232000 AH R3,PUBPT POINT TO CORRECT PUB ENTRY @V305001 00233000 USING PUBADR,R3 @V305001 00234000 MVC CUU,PUBCUU SAVE SYSRES DEVICE ADDRESS @V305001 00235000 DROP R1,R3 @V305001 00236000 MVC CCHHR(5),SPRDIR SET TO FIND SPR DIRECTORY @V305001 00237000 BAL R10,DISKIO GO READ POINTER TO SPR @V305001 00238000 MVC SPRADR(5),BUFFER+2 SET SPR DIRECTORY ADDR. @V305001 00239000 CLC SPRADR(5),ZEROS PROC. LIBRARY AVAILABLE ? @V305001 00240000 BE ERR002 NO, ERROR @V305001 00241000 MVC CCHHR(5),SPRADR SET UP SEEK/SEARCH ADDRESS @V305001 00242000 LA R3,DIRBL DIRECTORY BLOCK LENGTH @V305001 00243000 STH R3,READCCW+6 TO READ CCW @V305001 00244000 NXTBLK BAL R10,DISKIO READ DIRECTORY @V305001 00245000 LA R2,BUFFER POINT TO BUFFER @V305001 00246000 TM SSW,PASS1 1ST. TIME HERE ? @V305001 00247000 BO TSTEND NO, BRANCH @V305001 00248000 LA R2,80(,R2) BUMP PAST DIRECTORY @V305001 00249000 OI SSW,PASS1 SET 1ST. TIME SWITCH @V305001 00250000 TSTEND CLI 0(R2),DIREND END OF DIRECTORY ? @V305001 00251000 BE ERR002 YES, PROCEDURE NOT FOUND @V305001 00252000 CLI 0(R2),ZERO END OF BLOCK ? @V305001 00253000 BE NXTBLK YES, GET ANOTHER BLOCK @V305001 00254000 CLC PCNAME,0(R2) PROC NAME MATCH ? @VA09217 00255000 BE CHKDSK FOUND - GO CHECK FOR ERASE @VA09217 00256000 LA R2,16(,R2) BUMP TO NEXT ENTRY @VA09217 00257000 B TSTEND KEEP LOOKING @V305001 00258000 EJECT 00259000 FNDENT SR R3,R3 CLEAR REGISTER @V305001 00260000 ICM R3,M8,11(R2) GET C1 AND H2 INTO HI-ORDER @V305001 00261000 SRL R3,6 PLACE C1 PROPERLY @V305001 00262000 STCM R3,M14,CCHHR SAVE FOR NOW @V305001 00263000 MVC CHHR(1),10(R2) NOW MOVE C2 @V305001 00264000 MVC HR(2),11(R2) NOW MOVE H2 AND R @V305001 00265000 NI HR,CLRH2 CLEAR 2 HI-BITS H2 @V305001 00266000 LA R3,BLKLN GET PROC DATA BLOCKS LENGTH @V305001 00267000 STH R3,READCCW+6 SAVE IN READ CCW @V305001 00268000 SPACE 2 00269000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00270000 * * 00271000 * READ A DATA BLOCK AND OUTPUT THE RECORD. * 00272000 * END OF PROCEDURE IS DETERMINED BY A '/+' IN COLS. * 00273000 * 1-2 OF THE LAST RECORD. * 00274000 * * 00275000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00276000 SPACE 2 00277000 NXTBUF BAL R10,DISKIO READ 1ST DATA BLOCK @V305001 00278000 BAL R10,OUTLINE GO OUTPUT THIS LINE @V305001 00279000 CLC EOPR,BUFFER END OF PROCEDURE ? @V305001 00280000 BE ALLDONE YES, EXIT @V305001 00281000 B NXTBUF GO GET NEXT RECORD @V305001 00282000 EJECT 00283000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00284000 * * 00285000 * ROUTINE TO READ FROM SYSTEM PROCEDURE LIBRARY. * 00286000 * THE I/O IS DIAGNOSED TO CP AND UPON RETURN ONLY * 00287000 * END-OF-CYLINDER IS ACCEPTED. ANY OTHER ERROR WILL * 00288000 * TERMINATE THIS COMMAND. * 00289000 * * 00290000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00291000 SPACE 2 00292000 DISKIO LA R0,SEEKCCW GET CHANNEL PGM ADDR @V305001 00293000 LH R1,CUU GET DISK DEVICE ADDR @V305001 00294000 DC X'83100020' DIAGNOSE I/O TO CP @V305001 00295000 BZR R10 RETURN WITH GOOD I/O @V305001 00296000 BM ERR113 DISK NOT ATTACHED EXIT @V305001 00297000 BP ERR411 I/O ERROR @V305066 00298000 STH R0,SENSE SAVE SENSE INFO. @V305001 00299000 TM SENSE+1,EOC IS IT END-OF-CYLINDER @V305001 00300000 BZ ERR411 NO, UNRECOVERABLE ERROR @V305066 00301000 LH R1,CCHHR GET CURRENT CYLINDER @V305001 00302000 LA R1,1(,R1) UP BY ONE @V305001 00303000 STH R1,CCHHR SAVE NEW CYLINDER @V305001 00304000 LA R1,ONE GET HEAD 0, REC 1 CONSTANT @V305001 00305000 STCM R1,M7,HHR SAVE NEW HEAD AND REC @V305001 00306000 BR R10 RETURN TO CALLER @V305001 00307000 EJECT 00308000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00309000 * * 00310000 * ROUTINE TO DETERMINE TO WHAT DEVICE OR DEVICES THE * 00311000 * OUTPUT SHOULD GO. SWITCH 'SSW' CONTAINS INFORMATION * 00312000 * TO DETERMINE THIS. ALL I/O IS DONE THROUGH CMS FUNCTIONS. * 00313000 * * 00314000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00315000 SPACE 2 00316000 OUTLINE TM SSW,DISK+PRINT+PUNCH+TERM ANY OPTIONS ? @V305001 00317000 BZ OUTDSK NO, DEFAULT TO DISK @V305001 00318000 TM SSW,PUNCH PUNCH SPECIFIED ? @V305001 00319000 BZ TSTPRT NO, CHECK PRINT @V305001 00320000 LA R1,PUNLST POINT TO PUNCH PLIST @V305001 00321000 SVC 202 PUNCH THIS CARD @V305001 00322000 DC AL4(*+4) ... @V305001 00323000 CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00324000 BE EXIT YES, GET OUT @V305001 00325000 SPACE 1 00326000 TSTPRT TM SSW,PRINT PRINT SPECIFIED ? @V305001 00327000 BZ TSTCON NO, CHECK TERM @V305001 00328000 PRT LA R1,PRTLST POINTER TO PRINT PLIST @V305066 00329000 SVC 202 PRINT THIS CARD @V305001 00330000 DC AL4(*+4) ... @V305001 00331000 CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00332000 BE EXIT YES, GET OUT @V305001 00333000 TM SSW,FIRST FIRST TIME FLAG ON? @V305066 00334000 BO TSTCON NO @V305066 00335000 OI SSW,FIRST FIRST TIME INDICATOR @V305066 00336000 MVI CHAR,BLANK CONTROL CHAR @V305066 00337000 B PRT GO TO PRINT @V305066 00338000 SPACE 1 00339000 TSTCON TM SSW,TERM TERM SPECIFIED ? @V305001 00340000 BZ TSTDSK NO, CHECK DISK @V305001 00341000 LA R1,TYPLST POINT TO TERM PLIST @V305001 00342000 SVC 202 DISPLAY THIS LINE @V305001 00343000 SPACE 1 00344000 TSTDSK TM SSW,DISK DISK SPECIFIED ? @V305001 00345000 BZR R10 NO, RETURN @V305001 00346000 OUTDSK LA R1,DSKLST POINT TO DISK PLIST @V305001 00347000 L R15,AWRBUF GET DMSBWR ADDRESS @V305001 00348000 BALR R14,R15 WRITE THIS RECORD @V305001 00349000 LTR R15,R15 ANY ERRORS ? @V305001 00350000 BNZ ERR105 YES, BRANCH @V305001 00351000 BR R10 @V305001 00352000 EJECT 00353000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00354000 * * 00355000 * CLOSE ANY OUTPUT FILE USED BY THIS COMMAND, THEN * 00356000 * RETURN BACK TO CALLER PASSING IN REGISTER 15 THE * 00357000 * RETURN CODE OF THIS COMMAND. * 00358000 * * 00359000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00360000 SPACE 2 00361000 ALLDONE SR R15,R15 ZERO RETURN CODE @V305001 00362000 EXIT LR R10,R15 TEMP SAVE RETURN CODE @V305001 00363000 TM SSW,DISK+PRINT+PUNCH+TERM ANY OPTIONS ? @V305001 00364000 BZ CLDSK2 NO, CLOSE DISK FILE @V305001 00365000 TM SSW,PRINT PRINT OPTION ? @V305001 00366000 BZ CLPUN NO, CHECK PUNCH @V305001 00367000 MVC CLDEV,CPRINT SET UP DEVICE @V305001 00368000 LA R1,CLOSE GET CLOSE PLIST @V305001 00369000 SVC 202 CLOSE PRINTER @V305001 00370000 DC AL4(*+4) NO-OP @V305001 00371000 CLPUN TM SSW,PUNCH PUNCH OPTION ? @V305001 00372000 BZ CLDSK NO, CHECK DISK @V305001 00373000 MVC CLDEV,CPUNCH SET UP DEVICE @V305001 00374000 LA R1,CLOSE GET CLOSE PLIST @V305001 00375000 SVC 202 CLOSE PUNCH @V305001 00376000 DC AL4(*+4) NO-OP @V305001 00377000 CLDSK TM SSW,DISK DISK OPTION ? @V305001 00378000 BZ EXIT2 NO, RETURN @V305001 00379000 CLDSK2 LA R1,DSKLST GET FINIS PLIST @V305001 00380000 L R15,AFINIS GET DMSFNS ADDRESS @V305001 00381000 BALR R14,R15 CLOSE OUTPUT FILE @V305001 00382000 EXIT2 L R14,SAVE14 LOAD RETURN REGISTER @V305001 00383000 DMSKEY RESET @V305001 00384000 LR R15,R10 RESTORE RETURN CODE @V305001 00385000 BR R14 RETURN TO CALLER @V305001 00386000 EJECT 00387000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00388000 * * 00389000 * STORAGE AND CONSTANT AREAS * 00390000 * * 00391000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00392000 SPACE 2 00393000 ZEROS DC D'0' CONSTANT OF ZEROS @V305001 00394000 SAVE14 DS F SAVE FOR RETURN REGISTER @V305001 00395000 SPRADR DC 3H'0' ADDRESS OF SYS PROC DIRECTORY @V305001 00396000 SPRDIR DC H'0',H'1',X'4' POINTER TO SYS PROC DIRECTORY @V305001 00397000 SSW DS X INTERNAL SWITCH @V305001 00398000 CUU DS H SYSRES DISK ADDRESS @V305001 00399000 SENSE DS H SENSE INFO. FROM BAD DIAGNOSE @V305001 00400000 EOPR DC CL2'/+' END OF PROCEDURE INDICATOR @V305001 00401000 CDISK DC CL8'DISK' DISK OPTION @V305001 00402000 CPRINT DC CL8'PRINT' PRINT OPTION @V305001 00403000 CPUNCH DC CL8'PUNCH' PUNCH OPTION @V305001 00404000 CTERM DC CL8'TERM' TERM OPTION @V305001 00405000 PROC DC CL8'PROC' DEFAULT FILE TYPE @V305001 00406000 PCNAME DC CL8' ' PROCEDURE NAME @V305001 00407000 DS 0H @V305001 00408000 BBCCHHR DC H'0' SEEK ADDRESS @V305001 00409000 CCHHR DS X SEARCH ADDRESS @V305001 00410000 CHHR DS X ... @V305001 00411000 HHR DS X ... @V305001 00412000 HR DS X ... @V305001 00413000 R DS X ... @V305001 00414000 DS XL3 ... @V305001 00415000 EJECT 00416000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00417000 * * 00418000 * CHANNEL PROGRAMS AND COMMON EQUATES * 00419000 * * 00420000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00421000 SPACE 2 00422000 SEEKCCW CCW SEEK,BBCCHHR,CC+SLI,6 @V305001 00423000 SRCHCCW CCW SEARCH,CCHHR,CC+SLI,5 @V305001 00424000 CCW TIC,SRCHCCW,0,1 @V305001 00425000 READCCW CCW RDDATA,BUFFER,CC,80 @V305001 00426000 CCW RDCOUNT,CCHHR,SLI,8 @V305001 00427000 * 00428000 SEEK EQU X'07' SEEK CCW CODE @V305001 00429000 SEARCH EQU X'31' SEARCH CCW CODE @V305001 00430000 TIC EQU X'08' TIC CCW CODE @V305001 00431000 RDDATA EQU X'06' READ DATA CCW CODE @V305001 00432000 RDCOUNT EQU X'92' READ COUNT MT CCW CODE @V305001 00433000 CC EQU X'40' COMMAND CHAIN FLAG @V305001 00434000 SLI EQU X'20' SUPPRESS I.L. FLAG @V305001 00435000 FENCE EQU X'FF' PLIST FENCE CODE @V305001 00436000 LPAR EQU C'(' LEFT PARENS CODE @V305001 00437000 RPAR EQU C')' RIGHT PARENS CODE @V305001 00438000 BLANK EQU C' ' BLANK CHARACTER CODE @V305001 00439000 SYSRES EQU 12 SYSRES LUB INDEX @V305001 00440000 EOC EQU X'20' END OF CYLINDER @V305001 00441000 BLKLN EQU 80 PROCEDURE BLOCK LENGTH @V305001 00442000 UNASSGN EQU X'FE' LOGICAL UNIT UNASSIGNED @V305001 00443000 DIREND EQU C'*' DIRECTORY BLOCK END CODE @V305001 00444000 DIRBL EQU 160 DIRECTORY BLOCK LENGTH @V305001 00445000 CLRH2 EQU X'3F' MASK TO CLEAR 2 HI BITS HEAD2 @V305001 00446000 ZERO EQU 0 CONSTANT @V305001 00447000 ONE EQU 1 CONSTANT @V305001 00448000 M7 EQU B'0111' ICM/STCM MASK @V305001 00449000 M8 EQU B'1000' ICM/STCM MASK @V305001 00450000 M14 EQU B'1110' ICM/STCM MASK @V305001 00451000 RC24 EQU 24 RETURN CODE @V305001 00452000 RC28 EQU 28 RETURN CODE @V305001 00453000 RC36 EQU 36 RETURN CODE @V305001 00454000 RC40 EQU 40 RETURN CODE @V305001 00455000 RC100 EQU 100 RETURN CODE @V305001 00456000 * 00457000 * FLAGS FOR INTERNAL SWITCH 'SSW' 00458000 * 00459000 DISK EQU X'80' DISK OUTPUT @V305001 00460000 PRINT EQU X'40' PRINT OUTPUT @V305001 00461000 PUNCH EQU X'20' PUNCH OUTPUT @V305001 00462000 TERM EQU X'10' TERM OUTPUT @V305001 00463000 PASS1 EQU X'08' DIRECTORY BY-PASS FLAG @V305001 00464000 FIRST EQU X'04' FIRST TIME SWITCH @V305066 00465000 EJECT 00466000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00467000 * * 00468000 * BUFFERS AND CMS FUNCTION'S PLISTS * 00469000 * * 00470000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00471000 SPACE 2 00472000 DS 0F @V305001 00473000 DC C' ' @V305066 00474000 CHAR DC X'8B' EJECT ON FIRST PRINT @V305066 00475000 BUFFER DS CL160 WORK BUFFER @V305001 00476000 SPACE 2 00477000 DS 0D @V305001 00478000 PUNLST DC CL8'CARDPH' COMMAND NAME @V305001 00479000 DC AL4(BUFFER) BUFFER ADDRESS @V305001 00480000 DC AL4(80) BUFFER LENGTH @V305001 00481000 SPACE 1 00482000 PRTLST DC CL8'PRINTR' COMMAND NAME @V305001 00483000 DC AL4(BUFFER-1) BUFFER ADDRESS @V305001 00484000 FLAG DC H'1',H'81' FLAG AND BUFFER LENGTH @V305066 00485000 DC 8X'FF' FENCE @V305001 00486000 SPACE 1 00487000 DS 0D @V305001 00488000 TYPLST DC CL8'TYPLIN' COMMAND NAME @V305001 00489000 DC AL1(1) FLAG @V305001 00490000 DC AL3(BUFFER) BUFFER ADDRESS @V305001 00491000 DC CL1'B' FLAG @V305001 00492000 DC AL3(80) BUFFER LENGTH @V305001 00493000 SPACE 1 00494000 DS 0D @V305001 00495000 DSKLST DC CL8' ' COMMAND NAME @V305001 00496000 FNAME DC CL8' ' FILE NAME @V305001 00497000 FTYPE DC CL8' ' FILE TYPE @V305001 00498000 DC CL2'A1' FILE MODE @V305001 00499000 DC H'0' ITEM NUMBER @V305001 00500000 DC A(BUFFER) BUFFER ADDRESS @V305001 00501000 DC A(80) BUFFER LENGTH @V305001 00502000 DC CL2'F' F/V FLAG @V305001 00503000 DC H'1' NUMBER OF ITEMS @V305001 00504000 SPACE 1 00505000 DS 0D @V305001 00506000 CLOSE DC CL8'CP' COMMAND NAME @V305001 00507000 DC CL8'CLOSE' ACTION @V305001 00508000 CLDEV DC CL8' ' DEVICE TO CLOSE @V305001 00509000 DC 8X'FF' PLIST FENCE @V305001 00510000 EJECT 00511000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00512000 * * 00513000 * ERROR MESSAGES * 00514000 * * 00515000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00516000 SPACE 2 00517000 ERR001 EQU * @V305001 00518000 DMSERR TEXT='NO PROCEDURE NAME SPECIFIED',NUM=98,LET=E 00519000 LA R15,RC24 RETURN CODE @V305001 00520000 B EXIT GET OUT @V305001 00521000 SPACE 1 00522000 ERR002 LA R2,PCNAME POINT TO PROCEDURE NAME @V305001 00523000 DMSERR TEXT='PROCEDURE ''........'' NOT FOUND',NUM=4,LET=E, *00524000 SUB=(CHARA,(R2)) @V305001 00525000 LA R15,RC28 RETURN CODE @V305001 00526000 B EXIT GET OUT @V305001 00527000 EJECT 00528000 ERR003 LR R2,R1 POINT TO OPTION @V305001 00529000 DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, *00530000 SUB=(CHARA,(R2)) @V305001 00531000 LA R15,RC24 RETURN CODE @V305001 00532000 B EXIT GET OUT @V305001 00533000 SPACE 1 00534000 ERR006 EQU * @V305001 00535000 DMSERR TEXT='NO READ/WRITE ''A'' DISK ACCESSED',NUM=6,LET=E 00536000 LA R15,RC36 RETURN CODE @V305001 00537000 B EXIT GET OUT @V305001 00538000 EJECT 00539000 ERR070 LR R2,R1 POINT TO PARAMETER @V305001 00540000 DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70,LET=E, *00541000 SUB=(CHARA,(R2)) @V305001 00542000 LA R15,RC24 RETURN CODE @V305001 00543000 B EXIT GET OUT @V305001 00544000 SPACE 1 00545000 ERR113 LH R2,CUU GET DISK ADDRESS @V305001 00546000 DMSERR TEXT='DISK (....) NOT ATTACHED',NUM=113,LET=S, @V305001*00547000 SUB=(HEX,(R2)) @V305001 00548000 LA R15,RC100 RETURN CODE @V305001 00549000 B EXIT GET OUT @V305001 00550000 EJECT 00551000 ERR411 LR R2,R15 I/O ERROR CODE @V305066 00552000 DMSERR TEXT='INPUT ERROR CODE ''..'' ON ''SYSRES''',NUM=411, *00553000 LET=S,SUB=(DEC,(R2)) @V305001 00554000 LA R15,RC100 RETURN CODE @V305001 00555000 B EXIT GET OUT @V305001 00556000 SPACE 1 00557000 ERR099 EQU * @V305001 00558000 DMSERR TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE',NUM=99,LET=E 00559000 LA R15,RC40 RETURN CODE = 40 @V305066 00560000 B EXIT GET OUT @V305001 00561000 EJECT 00562000 ERR105 LR R2,R15 WRBUF ERROR CODE @V305001 00563000 DMSERR TEXT='ERROR ''..'' WRITING FILE ''....................'*00564000 ' TO DISK',NUM=105,LET=S,SUB=(DEC,(R2),CHAR8A,FNAME), *00565000 RENT=NO @V305001 00566000 LA R15,RC100 RETURN CODE @V305001 00567000 B EXIT GET OUT @V305001 00568000 SPACE 1 00569000 ERR097 EQU * @V305001 00570000 DMSERR TEXT='NO ''SYSRES'' VOLUME ACTIVE',NUM=97,LET=E 00571000 LA R15,RC36 RETURN CODE @V305001 00572000 B EXIT GET OUT @V305001 00573000 EJECT 00574000 NUCON @V305001 00575000 BGCOM @V305001 00576000 MAPPUB @V305001 00577000 REGEQU @V305001 00578000 END 00579000