SRV TITLE 'DMSSRV (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME 00004000 * 00005000 * DMSSRV ( SSERV ) 00006000 * 00007000 * FUNCTION 00008000 * 00009000 * PROVIDE THE FACILITY TO COPY BOOKS IN THE DOS/VS 00010000 * SYSTEM OR PRIVATE SOURCE STATEMENT LIBRARY TO A 00011000 * SPECIFIED OUTPUT DEVICE. VALID OUTPUT DEVICES ARE 00012000 * CMS DISK FILE, VIRTUAL PRINTER, USER'S CONSOLE, 00013000 * AND/OR VIRTUAL PUNCH. 00014000 * 00015000 * ATTRIBUTES 00016000 * 00017000 * DISK RESIDENT MODULE 00018000 * EXECUTES IN USER AREA 00019000 * 00020000 * ENTRY POINTS 00021000 * 00022000 * DMSSRV 00023000 * 00024000 * ENTRY CONDITIONS 00025000 * 00026000 * R1 = PARAMETER LIST 00027000 * 00028000 * DC CL8'SSERV' COMMAND 00029000 * DC CL8'FNAME' NAME OF BOOK TO COPY 00030000 * DC CL8'FTYPE' FILETYPE OF CMS DISK FILE 00031000 * ... ( ONLY APPLICABLE FOR DISK ) 00032000 * ... ( DEFAULTS TO COPY ) 00033000 * DC CL8'(' BEGIN OF OPTIONS IF ANY 00034000 * DC CL8'TERM'|'DISK'|'PRINT'|'PUNCH' ..OPTIONS.. 00035000 * 00036000 * OPTIONS 00037000 * 00038000 * TERM - DIRECT BOOK FILE TO USER'S CONSOLE 00039000 * DISK - DIRECT BOOK FILE TO USER'S 'A' DISK 00040000 * - DISK IS DEFAULT ('FN' COPY A1) 00041000 * PRINT - DIRECT BOOK FILE TO SPOOLED PRINTER 00042000 * PUNCH - DIRECT BOOK 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 BOOK NAME SPECIFIED 00051000 * 24 - INVALID OPTION SPECIFIED 00052000 * 24 - INVALID PARAMETER SPECIFIED 00053000 * 28 - SPECIFIED BOOK FILE NOT FOUND 00054000 * 32 - SPECIFIED BOOK CONTAINS BAD RECORDS 00055000 * 32 - CMS/DOS ENVIRONMENT NOT ACTIVE 00056000 * 36 - NO READ/WRITE 'A' DISK ACCESSED 00057000 * 36 - NO SYSRES VOLUME ACTIVE 00058000 * 100 - SPECIFIED DISK IS NOT ATTACHED 00059000 * 100 - INPUT ERROR ON SYSRES OR SYSRLB 00060000 * 100 - ERROR WRITING FILE TO DISK 00061000 * 00062000 * CALLS TO OTHER ROUTINES 00063000 * 00064000 * DMSSTT, DMSERR, DMSERS, DMSKEY, DMKGIO, DMSPIO 00065000 * DMSBWR, DMSCWR, DMSCIO, DMSCPF, DMSFNS 00066000 * 00067000 * EXTERNAL REFERENCES 00068000 * 00069000 * NUCON, BGCOM, DOSCB, OSFST 00070000 * 00071000 * TABLES/WORK AREAS 00072000 * 00073000 * NONE 00074000 * 00075000 * REGISTER USAGE 00076000 * 00077000 * R0 NUCON ADDRESSABILITY & WORK 00078000 * R1 COMMAND LINE POINTER & PLIST(S) POINTER 00079000 * R2 INPUT BUFFER POINTER & WORK 00080000 * R3 WORK 00081000 * R4 OUTPUT BUFFER POINTER 00082000 * R5 WORK 00083000 * R6 NOT USED 00084000 * R7 NOT USED 00085000 * R8 NOT USED 00086000 * R9 DOSCB & OSFST POINTER 00087000 * R10 INTERNAL LINKAGE 00088000 * R11 NOT USED 00089000 * R12 DMSSRV ADDRESSABILITY 00090000 * R13 NOT USED 00091000 * R14 EXTERNAL LINKAGE 00092000 * R15 ADDRESS LINKING ROUTINE & RETURN CODE 00093000 * 00094000 * OPERATION 00095000 * 00096000 * 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00097000 * THE RETURN REGISTER. ACQUIRE SUPERVISOR KEY 00098000 * AND INITIALIZE REUSABILITY FIELDS. VERIFY IF 00099000 * IN CMS/DOS ENVIRONMENT. 00100000 * 00101000 * 2. CHECK THE COMMAND LINE FOR VALID ARGUMENTS 00102000 * AND OPTIONS. ENSURE THAT A BOOK NAME WAS 00103000 * SPECIFIED. SET APPROPIATE SWITCHES FOR EACH 00104000 * OPTION SPECIFIED. IF THE 'DISK' OPTION IS 00105000 * SPECIFIED OR IMPLIED, ERASE ANY OLD FILE ON 00106000 * THE 'A' DISK. IF ERASE RETURNS A CODE OF 36, 00107000 * EITHER THE 'A' DISK IS R/O OR IS NOT ATTACHED. 00108000 * 00109000 * 3. DETERMINE IF READING FROM THE SYSTEM OR PRIVATE 00110000 * SOURCE STMNT LIBRARY (PRIVATE IS SEARCHED FIRST) 00111000 * & START READING THE APPROPIATE LIBRARY DIRECTORY 00112000 * RECORDS TO LOCATE THE SPECIFIED BOOK. ONCE THE 00113000 * BOOK ENTRY IS FOUND, COMPUTE THE DISK ADDRESS OF 00114000 * THE BOOK DATA BLOCKS. 00115000 * 00116000 * 4. READ THE BOOK DATA BLOCKS ONE AT A TIME. DECODE 00117000 * EACH DATA BLOCK INTO CARD IMAGES. DOS/VS REMOVES 00118000 * ALL BLANKS FROM THE CARD IMAGES, THUS THEY MUST 00119000 * REPLACED BEFORE THE OUTPUT BUFFER IS WRITTEN TO 00120000 * THE OUTPUT DEVICE. 00121000 * 00122000 * 5. WHEN ALL PROCESSING HAS BEEN DONE, ALL OUTPUT 00123000 * DEVICES ARE CLOSED. 00124000 * 00125000 * 6. A SWITCH TO PROBLEM PROGRAM KEY IS DONE, AND A 00126000 * RETURN TO THE CALLER IS MADE PASSING IN REG. 15 00127000 * THE RETURN CODE OF THE COMMAND. 00128000 *. 00129000 EJECT 00130000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00131000 * * 00132000 * INITIALIZATION... ESTABLISH BASE REG. AND SAVE RETURN. * 00133000 * VERIFY CMS/DOS ENVIRONMENT ACTIVE * 00134000 * * 00135000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00136000 SPACE 2 00137000 DMSSRV CSECT @V305001 00138000 USING DMSSRV,R12 @V305001 00139000 USING NUCON,R0 @V305001 00140000 LR R12,R15 ESTABLISH BASE @V305001 00141000 ST R14,SAVE14 SAVE RETURN REGISTER @V305001 00142000 DMSKEY NUCLEUS @V305001 00143000 TM DOSFLAGS,DOSMODE IN CMS/DOS MODE ? @V305001 00144000 BZ ERR099 NO, ERROR @V305001 00145000 XC SSW,SSW CLEAR INTERNAL SWITCH @V305001 00146000 MVC FTYPE,COPY SET DEFAULT FILE TYPE @V305001 00147000 EJECT 00148000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00149000 * * 00150000 * CHECK COMMAND LINE FOR VALID ARGUMENTS AND OPTIONS. * 00151000 * SET APROPIATE SWITCHES FOR EACH OPTION SPECIFIED. * 00152000 * IF NO OPTIONS SPECIFIED, 'DISK' IS DEFAULT. * 00153000 * * 00154000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00155000 SPACE 2 00156000 LA R1,8(,R1) BUMP TO SUBLIB QUALIFIER @V305001 00157000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00158000 BE ERR001 NO, ERROR @V305001 00159000 CLI 0(R1),LPAR DITTO @V305001 00160000 BE ERR001 NO, ERROR @V305001 00161000 CLI 1(R1),BLANK ONE SUBLIB CHAR. ONLY ? @V305001 00162000 BNE ERR070 NO, ERROR @V305001 00163000 MVC BKNAME(1),0(R1) SAVE SUBLIB QUALIFIER @V305001 00164000 LA R1,8(,R1) BUMP TO BOOK NAME @V305001 00165000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00166000 BE ERR001 NO, ERROR @V305001 00167000 CLI 0(R1),LPAR DITTO @V305001 00168000 BE ERR001 NO, ERROR @V305001 00169000 MVC BKNAME+1(8),0(R1) SAVE BOOK NAME @V305001 00170000 LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00171000 CLI 0(R1),FENCE ANY OPTIONS ? @V305001 00172000 BE OPTSOK NO, BRANCH @V305001 00173000 CLI 0(R1),LPAR LEFT PARENS ? @V305001 00174000 BE OPTLUP YES, PROCESS OPTIONS @V305001 00175000 MVC FTYPE,0(R1) SET USER'S FILE TYPE @V305001 00176000 LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00177000 CLI 0(R1),FENCE ANY MORE ? @V305001 00178000 BE OPTSOK NO, BRANCH @V305001 00179000 CLI 0(R1),LPAR LEFT PARENS ? @V305001 00180000 BNE ERR070 NO, ERROR @V305001 00181000 OPTLUP LA R1,8(,R1) BUMP TO OPTION @V305001 00182000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00183000 BE OPTSOK NO, ALL DONE WITH OPTIONS @V305001 00184000 CLI 0(R1),RPAR END OF OPTIONS ? @V305001 00185000 BE OPTSOK YES, ALL DONE WITH OPTIONS @V305001 00186000 CLC CDISK,0(R1) DISK OPTION ? @V305001 00187000 BNE CKPUN NO, CHECK PUNCH @V305001 00188000 OI SSW,DISK SET DISK FLAG @V305001 00189000 B OPTLUP KEEP LOOKING @V305001 00190000 CKPUN CLC CPUNCH,0(R1) PUNCH OPTION ? @V305001 00191000 BNE CKPRT NO, CHECK PRINT @V305001 00192000 OI SSW,PUNCH SET PUNCH FLAG @V305001 00193000 B OPTLUP KEEP LOOKING @V305001 00194000 CKPRT CLC CPRINT,0(R1) PRINT OPTION ? @V305001 00195000 BNE CKTRM NO, CHECK TERM @V305001 00196000 OI SSW,PRINT SET PRINT FLAG @V305001 00197000 B OPTLUP KEEP LOOKING @V305001 00198000 CKTRM CLC CTERM,0(R1) TERM OPTION ? @V305001 00199000 BNE ERR003 NO, ERROR @V305001 00200000 OI SSW,TERM SET TERM FLAG @V305001 00201000 B OPTLUP KEEP LOOKING @V305001 00202000 EJECT 00203000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00204000 * * 00205000 * IF 'DISK' OPTION SPECIFIED OR IMPLIED, ERASE ANY OLD * 00206000 * FILE ON THE 'A' DISK WITH THE SAME FILEID. IF ERASE * 00207000 * RETURNS A CODE OF 36, EITHER THE 'A' DISK IS R/O OR IS * 00208000 * NOT ATTACHED. IN EITHER CASE A MESSAGE IS ISSUED. * 00209000 * * 00210000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00211000 SPACE 2 00212000 OPTSOK MVC MSGBOOK(1),BKNAME @V305001 00213000 MVC MSGBOOK+2(8),BKNAME+1 @V305001 00214000 CLI SSW,ZERO ANY OPTIONS? @VA08112 00214050 BNE READDIR YES GO CHECK DIRT @VA08112 00214100 OI SSW,DISK SET DEFAULT @VA08112 00214150 B READDIR GO READ DIRECTORY @VA07631 00214200 CHKDSK EQU * @VA07631 00214300 CLI SSW,ZERO ANY OPTIONS SPECIFIED ? @V305001 00215000 BE ERSOLD NO, DEFAULT TO DISK @V305001 00216000 TM SSW,DISK WAS DISK SPECIFIED ? @V305001 00217000 BZ FNDBOOK NO BYPASS ERASE @VA07631 00218100 ERSOLD MVC FNAME,BKNAME+1 SET UP FILE NAME @V305001 00219000 LA R1,DSKLST GET ERASE PLIST @V305001 00220000 L R15,AERASE GET DMSERS ADDRESS @V305001 00221000 BALR R14,R15 GO ERASE OLD FILE @V305001 00222000 CH R15,=H'36' ANY DISK PROBLEM ? @V305001 00223000 BE ERR006 YES, GIVE ERROR @V305001 00224000 B FNDBOOK PROCESS BOOK ENTRY @VA07631 00224100 EJECT 00225000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00226000 * * 00227000 * DETERMINE IF READING FROM SYSTEM S.S.L. OR FROM PRIVATE * 00228000 * S.S.L. READ APPROPIATE LIBRARY DIRECTORY AND INITIATE * 00229000 * SEARCH FOR SPECIFIED BOOK. ONCE BOOK ENTRY IS FOUND, * 00230000 * COMPUTE THE DISK ADDRESS OF THE BOOK'S DATA BLOCKS. * 00231000 * * 00232000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00233000 SPACE 2 00234000 READDIR BAL R10,CKPSSL SEE IF PRIVATE SSL ASSIGNED @V305001 00235000 TM SSW,PSSLA ACTIVE PRIVATE SSL ? @V305001 00236000 BO SETLEN YES, BRANCH @V305001 00237000 READSYS NI SSW,255-PSSLA NO MORE PRIVATE SSL @V305001 00238000 LA R3,SYSRES GET SYSRES LUB INDEX @V305001 00239000 BAL R10,TSTUNIT SEE IF SYSRES VOLUME ACTIVE @V305001 00240000 BZ ERR002 NOT ASSGN'ED, ERROR @V305001 00241000 OI SSW,SSLA SET SYSRES VOLUME ACTIVE @V305001 00242000 MVC CUU(2),0(R3) SAVE SYSRES DEVICE ADDRESS @V305001 00243000 LA R3,DIRPL SSL DIRECTORY POINTER LENGTH @V305001 00244000 STH R3,READCCW+6 TO SAVE IN READ CCW @V305001 00245000 MVC CCHHR(5),SSLDIR SET TO FIND SSL DIRECTORY @V305001 00246000 BAL R10,DISKIO GO READ POINTER TO SSL @V305001 00247000 MVC CCHHR(5),INBUF+2 SET UP SEEK/SEARCH ADDRESS @V305001 00248000 SETLEN LA R3,DIRBL DIR. & DATA BLOCKS LENGTH @V305001 00249000 STH R3,READCCW+6 TO SAVE IN READ CCW @V305001 00250000 NXTBLK XC INBUF,INBUF ZERO OUT BUFFER @V305001 00251000 MVI INBUF+161,X'FF' TAG END OF BUFFER @V305001 00252000 BAL R10,DISKIO READ DIRECTORY @V305001 00253000 LA R2,INBUF POINT TO BUFFER @V305001 00254000 TM SSW,PASS1 1ST. TIME HERE ? @V305001 00255000 BO TSTEND NO, BRANCH @V305001 00256000 LA R2,80(,R2) BUMP PAST DIRECTORY INFO. @V305001 00257000 OI SSW,PASS1 SET 1ST. TIME SWITCH @V305001 00258000 TSTEND CLI 0(R2),ZERO END OF BUFFER ? @V305001 00259000 BE NXTBLK YES, GET NEXT BLOCK @V305001 00260000 CLI 0(R2),DIREND END OF DIRECTORY ? @V305001 00261000 BE ERR002 YES, BOOK NOT FOUND @V305001 00262000 CLC 0(9,R2),BKNAME BOOK NAME MATCH ? @V305001 00263000 BE CHKDSK GO CHECK FOR ERASE @VA07631 00264100 LA R2,16(,R2) BUMP TO NEXT ENTRY @V305001 00265000 B TSTEND KEEP LOOKING @V305001 00266000 SPACE 1 00267000 FNDBOOK MVC HR(2),10(R2) MOVE H2 AND R TO WORK @V305001 00268000 NI HR,CLRH2 CLEAR 2 HI-BITS H2 @V305001 00269000 SR R3,R3 ... @V305001 00270000 IC R3,10(R2) GET BYTE WITH C1 AND H2 @V305001 00271000 SLL R3,2 POSITION C1 @V305001 00272000 IC R3,9(R2) GET C2 @V305001 00273000 STH R3,CCHHR STORE IN WORK @V305001 00274000 EJECT 00275000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00276000 * * 00277000 * DECODE EACH BLOCK READ INTO CARD IMAGES RECORDS. BLANKS * 00278000 * ARE STRIPPED OFF BY DOS AND MUST BE REPLACED ON THE * 00279000 * OUTPUT BUFFER BEFORE THE RECORD IS WRITTEN OUT. * 00280000 * * 00281000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00282000 SPACE 2 00283000 NXTBUF BAL R10,DISKIO READ 1ST DATA BLOCK @V305001 00284000 LA R1,INBUF POINT TO INPUT BUFFER @V305001 00285000 RECLUP LA R4,OUTBUF POINT TO OUTPUT BUFFER @V305001 00286000 MVI 0(R4),BLANK BLANK OUTPUT BUFFER @V305001 00287000 MVC 1(79,R4),0(R4) ... @V305001 00288000 LA R3,79(,R4) POINT TO END OUTBUF @V305001 00289000 RECLUP1 CLI 0(R1),ZERO END OF BUFFER ? @V305001 00290000 BNE RECLUP2 NO, CONTINUE @V305001 00291000 CLI 1(R1),ZERO END OF BOOK ? @V305001 00292000 BE ALLDONE YES, ALL DONE @V305001 00293000 BAL R10,DISKIO GET NEW BLOCK @V305001 00294000 LA R1,INBUF POINT TO NEW BUFFER @V305001 00295000 B RECLUP1 PROCESS THIS NEW BLOCK @V305001 00296000 RECLUP2 SR R2,R2 ... @V305001 00297000 IC R2,0(R1) GET NO. OF NON-BLANKS @V305001 00298000 LA R0,MASK MASK CODE TO R0 @V305001 00299000 NR R0,R2 GET NO. OF BLANKS @V305001 00300000 SRL R2,4 SHIFT NO. NON-BLANKS @V305001 00301000 AR R0,R2 COMPUTE INCREMENT @V305001 00302000 BCTR R2,0 DECREMENT FOR MOVE @V305001 00303000 LTR R2,R2 COUNT NEGATIVE ? @V305001 00304000 BM INCBUF YES, BRANCH IF NEGATIVE @V305001 00305000 LA R5,0(R2,R4) BXLE HELPER @V305001 00306000 CR R5,R3 ALREADY HIGH ? @V305001 00307000 BH ERR194 YES, ERROR @V305001 00308000 EX R2,EXMVC MOVE NON-BLANKS TO OUTBUF @V305001 00309000 INCBUF LA R1,2(R1,R2) INCREMENT INBUF POINTER @V305001 00310000 LR R2,R0 CHAR. CNT. = INCREMENT @V305001 00311000 BXLE R4,R2,RECLUP1 KEEP MOVING DATA @V305001 00312000 ST R1,SAVE1 SAVE CURRENT BUFF PNTR @V305001 00313000 BAL R10,OUTLINE OUTPUT THE LINE @V305001 00314000 L R1,SAVE1 RESTORE REG. 1 @V305001 00315000 B RECLUP GO GET NEXT CARD IMAGE @V305001 00316000 EJECT 00317000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00318000 * * 00319000 * ROUTINE TO READ EITHER FROM SYSRES OR SYSSLB. * 00320000 * THE I/O IS DIAGNOSED TO CP AND UPON RETURN ONLY * 00321000 * END-OF-CYLINDER IS ACCEPTED. ANY OTHER ERROR WILL * 00322000 * TERMINATE THIS COMMAND. * 00323000 * * 00324000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00325000 SPACE 2 00326000 DISKIO LA R0,SEEKCCW GET CHANNEL PGM ADDR @V305001 00327000 LH R1,CUU GET DISK DEVICE ADDR @V305001 00328000 DC X'83100020' DIAGNOSE I/O TO CP @V305001 00329000 BZR R10 RETURN WITH GOOD I/O @V305001 00330000 BM ERR113 DISK NOT ATTACHED EXIT @V305001 00331000 BP ERR411 I/O ERROR @V305001 00332000 STH R0,SENSE SAVE SENSE INFO. @V305001 00333000 TM SENSE+1,EOC IS IT END-OF-CYLINDER @V305001 00334000 BZ ERR411 NO, UNRECOVERABLE ERROR @V305001 00335000 LH R1,CCHHR GET CURRENT CYLINDER @V305001 00336000 LA R1,1(,R1) UP BY ONE @V305001 00337000 STH R1,CCHHR SAVE NEW CYLINDER @V305001 00338000 LA R1,ONE GET HEAD 0, REC 1 CONSTANT @V305001 00339000 STCM R1,M7,HHR SAVE NEW HEAD AND REC @V305001 00340000 BR R10 RETURN TO CALLER @V305001 00341000 EJECT 00342000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00343000 * * 00344000 * VERIFY IF PRIVATE S.S.L. IS ASSIGNED, AND IF SO, * 00345000 * LOCATE DOSCB FOR IJSYSSL FROM DOSCB CHAIN IN NUCON. * 00346000 * VERIFY THAT AN OSFST EXIST TO GET THE STARTING CCHHR OF * 00347000 * THE DATA SET AND THE VIRTUAL DEVICE ADDRESS. * 00348000 * * 00349000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00350000 SPACE 2 00351000 CKPSSL ST R10,SAVE10 SAVE RETURN REGISTER @V305001 00352000 LA R3,SYSSLB GET SYSSLB LUB INDEX NO. @V305001 00353000 BAL R10,TSTUNIT SEE IF UNIT ASSIGNED @V305001 00354000 BZ NOPSSL BRANCH IF NOT ASSIGNED @V305001 00355000 SR R9,R9 ... @V305001 00356000 ICM R9,M7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305001 00357000 USING DOSSECT,R9 @V305001 00358000 PSSL1 BZ NOPSSL IF ZERO, NO MORE DOSCB @V305001 00359000 CLC IJSYSSL,DOSDD MATCHING DDNAMES ? @V305001 00360000 BE PSSL2 YES, DOSCB FOUND @V305001 00361000 ICM R9,M7,1(R9) GET NEXT DOSCB ADDRESS @V305001 00362000 B PSSL1 BRANCH @V305001 00363000 PSSL2 CLI DOSDEV,DOSDSK IS DEVICE DISK ? @V305001 00364000 BNE NOPSSL NO, BRANCH @V305001 00365000 LA R1,DOSOP USE DOSCB FOR STATE PLIST @V305001 00366000 MVC DOSOP,=CL8'STATE' MOVE STATE COMMAND TO PLIST @V305001 00367000 L R15,ASTATE GET STATE ADDRESS @V305001 00368000 BALR R14,R15 SEE IF FILE FOUND @V305001 00369000 LTR R15,R15 FILE FOUND ? @V305001 00370000 BNZ NOPSSL NO, BRANCH @V305001 00371000 L R9,DOSOSFST GET OSFST FOR P.S.S.L. @V305001 00372000 DROP R9 @V305001 00373000 LTR R9,R9 ANY AVAILABLE ? @V305001 00374000 BZ NOPSSL NO, BRANCH @V305001 00375000 USING OSFST,R9 @V305001 00376000 MVC CCHHR(4),OSFSTXTN+2 SAVE P.S.S.L. CCHHR @V305001 00377000 MVI R,ONE RECORD ONE @V305001 00378000 MVC CUU(2),OSFSTDSK SAVE P.S.S.L. CUU @V305001 00379000 DROP R9 @V305001 00380000 OI SSW,PSSLA SET PSSL FLAG IN SSW @V305001 00381000 NOPSSL L R10,SAVE10 RESTORE RETURN REG. @V305001 00382000 BR R10 RETURN @V305001 00383000 EJECT 00384000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00385000 * * 00386000 * CHECK IF SYSSLB OR SYSRES HAS BEEN ASSIGNED. * 00387000 * REG 3 = 0 MEANS UNIT NOT ASSIGNED, OTHERWISE REG 3 * 00388000 * CONTAINS THE POINTER TO THE CORRECT PUB ENTRY. * 00389000 * * 00390000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00391000 SPACE 2 00392000 TSTUNIT EQU * @V305001 00393000 USING BGCOM,R1 @V305001 00394000 L R1,ASYSREF GET BGCOM ADDRESS @V305001 00395000 AH R3,LUBPT POINT TO CORRECT LUB ENTRY @V305001 00396000 TM 0(R3),UNASSGN UNIT ASSIGNED ? @V305001 00397000 BO NOTASSGN NO, BRANCH @V305001 00398000 LH R3,0(,R3) LUB ENTRY TO REG 3 @V305001 00399000 SRL R3,8 ISOLATE PUB POINTER @V305001 00400000 SLL R3,3 MULTIPLY BY 8 @V305001 00401000 AH R3,PUBPT POINT TO CORRECT PUB ENTRY @V305001 00402000 LTR R3,R3 SET CONDITION CODE @V305001 00403000 BR R10 RETURN TO CALLER @V305001 00404000 NOTASSGN SR R3,R3 ZERO REG 3 @V305001 00405000 LTR R3,R3 SET CONDITION CODE @V305001 00406000 BR R10 RETURN TO CALLER @V305001 00407000 DROP R1 @V305001 00408000 EJECT 00409000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00410000 * * 00411000 * ROUTINE TO DETERMINE TO WHAT DEVICE OR DEVICES THE * 00412000 * OUTPUT SHOULD GO. SWITCH 'SSW' CONTAINS INFORMATION * 00413000 * TO DETERMINE THIS. ALL I/O IS DONE THROUGH CMS FUNCTIONS. * 00414000 * * 00415000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00416000 SPACE 2 00417000 OUTLINE TM SSW,DISK+PRINT+PUNCH+TERM ANY OPTIONS ? @V305001 00418000 BZ OUTDSK NO, DEFAULT TO DISK @V305001 00419000 TM SSW,PUNCH PUNCH SPECIFIED ? @V305001 00420000 BZ TSTPRT NO, CHECK PRINT @V305001 00421000 LA R1,PUNLST POINT TO PUNCH PLIST @V305001 00422000 SVC 202 PUNCH THIS CARD @V305001 00423000 DC AL4(*+4) ... @V305001 00424000 CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00425000 BE EXIT YES, GET OUT @V305001 00426000 SPACE 1 00427000 TSTPRT TM SSW,PRINT PRINT SPECIFIED ? @V305001 00428000 BZ TSTTRM NO, CHECK TERM @V305001 00429000 PRT LA R1,PRTLST POINT TO PRINT PLIST @V305066 00430000 SVC 202 PRINT THIS LINE @V305001 00431000 DC AL4(*+4) ... @V305001 00432000 CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00433000 BE EXIT YES, GET OUT @V305001 00434000 TM SSW,FIRST FIRST TIME TO PRINT ? @V305066 00435000 BO TSTTRM NO @V305066 00436000 OI SSW,FIRST FIRST TIME INDICATOR @V305066 00437000 MVI CHAR,BLANK CONTROL CHAR @V305066 00438000 B PRT GO TO PRINT FIRST LINE @V305066 00439000 SPACE 1 00440000 TSTTRM TM SSW,TERM TERM SPECIFIED ? @V305001 00441000 BZ TSTDSK NO, CHECK DISK @V305001 00442000 LA R1,TYPLST POINT TO TERM PLIST @V305001 00443000 SVC 202 TYPE THIS LINE @V305001 00444000 SPACE 1 00445000 TSTDSK TM SSW,DISK DISK SPECIFIED ? @V305001 00446000 BZR R10 NO, RETURN @V305001 00447000 OUTDSK LA R1,DSKLST POINT TO DISK PLIST @V305001 00448000 L R15,AWRBUF GET DMSBWR ADDRESS @V305001 00449000 BALR R14,R15 GO WRITE TO DISK @V305001 00450000 LTR R15,R15 ANY ERRORS ? @V305001 00451000 BNZ ERR105 YES, BRANCH @V305001 00452000 BR R10 @V305001 00453000 EJECT 00454000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00455000 * * 00456000 * CLOSE ANY OUTPUT FILE USED BY THIS COMMAND, THEN * 00457000 * RETURN BACK TO CALLER PASSING IN REGISTER 15 THE * 00458000 * RETURN CODE OF THIS COMMAND. * 00459000 * * 00460000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00461000 SPACE 2 00462000 ALLDONE SR R15,R15 ZERO RETURN CODE @V305001 00463000 EXIT LR R10,R15 TEMP SAVE RETURN CODE @V305001 00464000 TM SSW,DISK+PRINT+PUNCH+TERM ANY OPTIONS ? @V305001 00465000 BZ CLDSK2 NO, CLOSE DISK FILE @V305001 00466000 TM SSW,PUNCH PUNCH OPTION ? @V305001 00467000 BZ CLPRT NO, CHECK PRINT @V305001 00468000 MVC CLDEV,CPUNCH SET UP DEVICE @V305001 00469000 LA R1,CLOSE GET CLOSE PLIST @V305001 00470000 SVC 202 CLOSE PUNCH @V305001 00471000 DC AL4(*+4) NO-OP @V305001 00472000 CLPRT TM SSW,PRINT PRINT OPTION ? @V305001 00473000 BZ CLDSK NO, CHECK DISK @V305001 00474000 MVC CLDEV,CPRINT SET UP DEVICE @V305001 00475000 LA R1,CLOSE GET CLOSE PLIST @V305001 00476000 SVC 202 CLOSE PRINTER @V305001 00477000 DC AL4(*+4) NO-OP @V305001 00478000 CLDSK TM SSW,DISK DISK OPTION ? @V305001 00479000 BZ EXIT2 NO, RETURN @V305001 00480000 CLDSK2 LA R1,DSKLST GET FINIS PLIST @V305001 00481000 L R15,AFINIS GET DMSFNS ADDRESS @V305001 00482000 BALR R14,R15 GO CLOSE OUTPUT FILE @V305001 00483000 EXIT2 L R14,SAVE14 LOAD RETURN REGISTER @V305001 00484000 DMSKEY RESET @V305001 00485000 LR R15,R10 RESTORE RETURN CODE @V305001 00486000 BR R14 RETURN TO CALLER @V305001 00487000 EJECT 00488000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00489000 * * 00490000 * STORAGE AND CONSTANT AREAS * 00491000 * * 00492000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00493000 SPACE 2 00494000 SAVE14 DS F SAVE FOR RETURN REGISTER @V305001 00495000 SAVE10 DS F TEMP. SAVE FOR REG 10 @V305001 00496000 SAVE1 DS F TEMP. SAVE FOR REG 1 @V305001 00497000 SSLDIR DC H'0',H'1',X'3' POINTER TO SYS SSL DIRECTORY @V305001 00498000 SSW DS X INTERNAL SWITCH @V305001 00499000 CUU DS H DISK VIRTUAL ADDRESS @V305001 00500000 SENSE DS H SENSE INFO. FROM BAD DIAGNOSE @V305001 00501000 EXMVC MVC 0(0,R4),1(R1) MOVE NON-BLANKS TO OUTBUF @V305001 00502000 CDISK DC CL8'DISK' DISK OPTION @V305001 00503000 CPUNCH DC CL8'PUNCH' PUNCH OPTION @V305001 00504000 CPRINT DC CL8'PRINT' PRINT OPTION @V305001 00505000 CTERM DC CL8'TERM' TERM OPTION @V305001 00506000 COPY DC CL8'COPY' DEFAULT FILE TYPE @V305001 00507000 IJSYSSL DC CL8'IJSYSSL' PRIV. S.S.L. DDNAME @V305001 00508000 BKNAME DC CL9' ' BOOK NAME @V305001 00509000 MSGBOOK DC CL10' .' BOKK NAME FOR ERROR MSG @V305001 00510000 DS 0H @V305001 00511000 BBCCHHR DC H'0' SEEK ADDRESS @V305001 00512000 CCHHR DS X SEARCH ADDRESS @V305001 00513000 CHHR DS X ... @V305001 00514000 HHR DS X ... @V305001 00515000 HR DS X ... @V305001 00516000 R DS X ... @V305001 00517000 DS XL3 ... @V305001 00518000 EJECT 00519000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00520000 * * 00521000 * CHANNEL PROGRAMS AND COMMON EQUATES * 00522000 * * 00523000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00524000 SPACE 2 00525000 SEEKCCW CCW SEEK,BBCCHHR,CC+SLI,6 @V305001 00526000 SRCHCCW CCW SEARCH,CCHHR,CC+SLI,5 @V305001 00527000 CCW TIC,SRCHCCW,0,1 @V305001 00528000 READCCW CCW RDDATA,INBUF,CC,80 @V305001 00529000 CCW RDCOUNT,CCHHR,SLI,8 @V305001 00530000 * 00531000 SEEK EQU X'07' SEEK CCW CODE @V305001 00532000 SEARCH EQU X'31' SEARCH CCW CODE @V305001 00533000 TIC EQU X'08' TIC CCW CODE @V305001 00534000 RDDATA EQU X'06' READ DATA CCW CODE @V305001 00535000 RDCOUNT EQU X'92' READ COUNT MT CCW CODE @V305001 00536000 CC EQU X'40' COMMAND CHAIN FLAG @V305001 00537000 SLI EQU X'20' SUPPRESS I.L. FLAG @V305001 00538000 FENCE EQU X'FF' PLIST FENCE CODE @V305001 00539000 LPAR EQU C'(' LEFT PARENS CODE @V305001 00540000 RPAR EQU C')' RIGHT PARENS CODE @V305001 00541000 BLANK EQU C' ' BLANK CHARACTER CODE @V305001 00542000 SYSRES EQU 12 SYSRES LUB INDEX @V305001 00543000 SYSSLB EQU 14 SYSSLB LUB INDEX @V305001 00544000 ZERO EQU 0 CONSTANT @V305001 00545000 ONE EQU 1 CONSTANT @V305001 00546000 DIRPL EQU 80 DIRECTORY POINTER LENGTH @V305001 00547000 DIRBL EQU 160 DIRECTORY BLOCK LENGTH @V305001 00548000 DIREND EQU C'*' DIRECTORY END CODE @V305001 00549000 CLRH2 EQU X'3F' MASK TO CLEAR HI 2 BITS HEAD2 @V305001 00550000 MASK EQU X'0F' MASK @V305001 00551000 EOC EQU X'20' END OF CYLINDER @V305001 00552000 UNASSGN EQU X'FE' LOGICAL UNIT UNASSIGNED @V305001 00553000 M7 EQU B'0111' ICM/STCM MASK @V305001 00554000 RC24 EQU 24 RETURN CODE @V305001 00555000 RC28 EQU 28 RETURN CODE @V305001 00556000 RC36 EQU 36 RETURN CODE @V305001 00557000 RC40 EQU 40 RETURN CODE @V305001 00558000 RC100 EQU 100 RETURN CODE @V305001 00559000 * 00560000 * FLAGS FOR INTERNAL SWITCH 'SSW' 00561000 * 00562000 DISK EQU X'80' DISK OUTPUT @V305001 00563000 PUNCH EQU X'40' PUNCH OUTPUT @V305001 00564000 PRINT EQU X'20' PRINT OUTPUT @V305001 00565000 TERM EQU X'10' TERM OUTPUT @V305001 00566000 PASS1 EQU X'08' FIRST PASS COMPLETE @V305001 00567000 PSSLA EQU X'04' PRIVATE LIBRARY ACTIVE @V305001 00568000 SSLA EQU X'02' SYSRES VOLUME ACTIVE @V305001 00569000 FIRST EQU X'01' FIRST TIME TO PRINT IND. @V305066 00570000 EJECT 00571000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00572000 * * 00573000 * BUFFERS AND CMS FUNCTION'S PLISTS * 00574000 * * 00575000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00576000 SPACE 2 00577000 CHAR DC X'8B' ASA/MACH CHAR FOR PRINT @V305066 00578000 OUTBUF DS CL80 OUTPUT BUFFER @V305001 00579000 INBUF DS CL162 INPUT BUFFER @V305001 00580000 SPACE 2 00581000 DS 0D @V305001 00582000 PUNLST DC CL8'CARDPH' COMMAND NAME @V305001 00583000 DC AL4(OUTBUF) BUFFER ADDRESS @V305001 00584000 DC AL4(80) BUFFER LENGTH @V305001 00585000 SPACE 1 00586000 DS 0D @V305001 00587000 PRTLST DC CL8'PRINTR' COMMAND NAME @V305001 00588000 DC AL4(OUTBUF-1) BUFFER ADDRESS @V305001 00589000 FLAG DC H'1',H'81' FLAG AND BUFFER LENGTH @V305066 00590000 DC 8X'FF' PLIST FENCE @V305001 00591000 SPACE 1 00592000 DS 0D @V305001 00593000 TYPLST DC CL8'TYPLIN' COMMAND NAME @V305001 00594000 DC AL1(1) FLAG @V305001 00595000 DC AL3(OUTBUF) BUFFER ADDRESS @V305001 00596000 DC CL1'B' FLAG @V305001 00597000 DC AL3(80) BUFFER LENGTH @V305001 00598000 SPACE 1 00599000 DS 0D @V305001 00600000 DSKLST DC CL8' ' COMMAND NAME @V305001 00601000 FNAME DC CL8' ' FILE NAME @V305001 00602000 FTYPE DC CL8' ' FILE TYPE @V305001 00603000 DC CL2'A1' FILE MODE @V305001 00604000 DC H'0' ITEM NUMBER @V305001 00605000 DC A(OUTBUF) BUFFER ADDRESS @V305001 00606000 DC A(80) BUFFER LENGTH @V305001 00607000 DC CL2'F' F/V FLAG @V305001 00608000 DC H'1' NUMBER OF ITEMS @V305001 00609000 SPACE 1 00610000 DS 0D @V305001 00611000 CLOSE DC CL8'CP' COMMAND NAME @V305001 00612000 DC CL8'CLOSE' ACTION @V305001 00613000 CLDEV DC CL8' ' DEVICE TO CLOSE @V305001 00614000 DC 8X'FF' PLIST FENCE @V305001 00615000 EJECT 00616000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00617000 * * 00618000 * ERROR MESSAGES * 00619000 * * 00620000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00621000 SPACE 2 00622000 ERR001 EQU * @V305001 00623000 DMSERR TEXT='NO BOOK NAME SPECIFIED',NUM=98,LET=E @V305001 00624000 LA R15,RC24 RETURN CODE @V305001 00625000 B EXIT GET OUT @V305001 00626000 SPACE 1 00627000 ERR002 EQU * @VA04912 00628200 NI SSW,255-PASS1 REMOVE 1ST. TIME SWITCH @VA04912 00628500 TM SSW,PSSLA SEARCHING PRIVATE LIBRARY? @VA04912 00628800 BO READSYS YES, NOW SEARCH SYSRES @V305001 00629000 LA R2,MSGBOOK POINT TO BOOK NAME @V305001 00632000 DMSERR TEXT='BOOK ''..........'' NOT FOUND',NUM=4,LET=E, *00633000 SUB=(CHARA,(R2)) @V305001 00634000 LA R15,RC28 RETURN CODE @V305001 00635000 B EXIT GET OUT @V305001 00636000 EJECT 00637000 ERR003 LR R2,R1 POINT TO OPTION @V305001 00638000 DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, *00639000 SUB=(CHARA,(R2)) @V305001 00640000 LA R15,RC24 RETURN CODE @V305001 00641000 B EXIT GET OUT @V305001 00642000 SPACE 1 00643000 ERR006 EQU * @V305001 00644000 DMSERR TEXT='NO READ/WRITE ''A'' DISK ACCESSED',NUM=6,LET=E 00645000 LA R15,RC36 RETURN CODE @V305001 00646000 B EXIT GET OUT @V305001 00647000 EJECT 00648000 ERR070 LR R2,R1 POINT TO PARAMETER @V305001 00649000 DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70,LET=E, *00650000 SUB=(CHARA,(R2)) @V305001 00651000 LA R15,RC24 RETURN CODE @V305001 00652000 B EXIT GET OUT @V305001 00653000 SPACE 1 00654000 ERR113 LH R2,CUU GET DISK ADDRESS @V305001 00655000 DMSERR TEXT='DISK (....) NOT ATTACHED',NUM=113,LET=S, @V305001*00656000 SUB=(HEX,(R2)) @V305001 00657000 LA R15,RC100 RETURN CODE @V305001 00658000 B EXIT GET OUT @V305001 00659000 EJECT 00660000 ERR411 LA R3,=CL8'SYSRES' SYSRES TO MSG. @V305001 00661000 TM SSW,PSSLA SYSSLB ACTIVE ? @V305001 00662000 BZ ERR411B NO, BRANCH @V305001 00663000 LA R3,=CL8'SYSSLB' SYSSLB TO MSG. @V305001 00664000 ERR411B LR R2,R15 I/O ERROR CODE @V305001 00665000 DMSERR TEXT='INPUT ERROR CODE ''..'' ON ''........''',NUM=411,*00666000 LET=S,SUB=(DEC,(R2),CHARA,(R3)),RENT=NO @V305001 00667000 LA R15,RC100 RETURN CODE @V305001 00668000 B EXIT GET OUT @V305001 00669000 SPACE 1 00670000 ERR194 LA R2,MSGBOOK POINT TO BOOK NAME @V305001 00671000 DMSERR TEXT='BOOK ''..........'' CONTAINS BAD RECORDS',NUM=194*00672000 ,LET=S,SUB=(CHARA,(R2)) @V305001 00673000 LA R15,RC100 RETURN CODE @V305001 00674000 B EXIT GET OUT @V305001 00675000 EJECT 00676000 ERR099 EQU * @V305001 00677000 DMSERR TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE',NUM=99,LET=E 00678000 LA R15,RC40 RETURN CODE = 40 @V305066 00679000 B EXIT GET OUT @V305001 00680000 SPACE 1 00681000 ERR105 LR R2,R15 WRBUF ERROR CODE @V305001 00682000 DMSERR TEXT='ERROR ''..'' WRITING FILE ''....................'*00683000 ' TO DISK',NUM=105,LET=S,SUB=(DEC,(R2),CHAR8A,FNAME), *00684000 RENT=NO @V305001 00685000 LA R15,RC100 RETURN CODE @V305001 00686000 B EXIT GET OUT @V305001 00687000 EJECT 00688000 ERR097 EQU * @V305001 00689000 DMSERR TEXT='NO ''SYSRES'' VOLUME ACTIVE',NUM=97,LET=E 00690000 LA R15,RC36 RETURN CODE @V305001 00691000 B EXIT GET OUT @V305001 00692000 EJECT 00693000 NUCON @V305001 00694000 BGCOM @V305001 00695000 DOSCB @V305001 00696000 OSFST @V305001 00697000 REGEQU @V305001 00698000 END 00699000