RRV TITLE 'DMSRRV (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME 00004000 * 00005000 * DMSRRV ( RSERV ) 00006000 * 00007000 * FUNCTION 00008000 * 00009000 * PROVIDE THE FACILITY TO COPY MODULES IN THE DOS/VS 00010000 * SYSTEM OR PRIVATE RELOCATABLE LIBRARY TO A SPECIFIED 00011000 * OUTPUT DEVICE. VALID OUTPUT DEVICES ARE CMS DISK FILE, 00012000 * VIRTUAL PRINTER, VIRTUAL PUNCH, AND/OR USER'S CONSOLE. 00013000 * 00014000 * ATTRIBUTES 00015000 * 00016000 * DISK RESIDENT MODULE 00017000 * EXECUTES IN USER AREA 00018000 * 00019000 * ENTRY POINTS 00020000 * 00021000 * DMSRRV 00022000 * 00023000 * ENTRY CONDITIONS 00024000 * 00025000 * R1 = PARAMETER LIST 00026000 * 00027000 * DC CL8'RSERV' COMMAND 00028000 * DC CL8'FNAME' NAME OF MODULE TO COPY 00029000 * DC CL8'FTYPE' FILETYPE OF CMS DISK FILE 00030000 * ... ( ONLY APPLICABLE FOR DISK ) 00031000 * ... ( DEFAULTS TO TEXT ) 00032000 * DC CL8'(' BEGIN OF OPTIONS IF ANY 00033000 * DC CL8'TERM'|'DISK'|'PRINT'|'PUNCH' ..OPTIONS.. 00034000 * 00035000 * OPTIONS 00036000 * 00037000 * TERM - DIRECT MODULE FILE TO USER'S CONSOLE 00038000 * DISK - DIRECT MODULE FILE TO USER'S 'A' DISK 00039000 * - DISK IS DEFAULT ('FN' TEXT A1) 00040000 * PRINT - DIRECT MODULE FILE TO SPOOLED PRINTER 00041000 * PUNCH - DIRECT MODULE FILE TO SPOOLED PUNCH 00042000 * 00043000 * EXIT CONDITIONS 00044000 * 00045000 * RETURN TO CALLER WITH RETURN CODE IN R15 00046000 * 00047000 * RETURN CODES AND MESSAGES: 00048000 * 00049000 * 24 - NO MODULE NAME SPECIFIED 00050000 * 24 - INVALID OPTION SPECIFIED 00051000 * 24 - INVALID PARAMETER SPECIFIED 00052000 * 28 - SPECIFIED MODULE FILE NOT FOUND 00053000 * 32 - CMS/DOS ENVIRONMENT NOT ACTIVE 00054000 * 36 - NO READ/WRITE 'A' DISK ACCESSED 00055000 * 36 - NO SYSRES VOLUME ACTIVE 00056000 * 100 - SPECIFIED DISK IS NOT ATTACHED 00057000 * 100 - INPUT ERROR ON SYSRES OR SYSRLB 00058000 * 100 - ERROR WRITING FILE TO DISK 00059000 * 00060000 * CALLS TO OTHER ROUTINES 00061000 * 00062000 * DMSSTT, DMSERR, DMSERS, DMSKEY, DMKGIO, DMSPIO 00063000 * DMSBWR, DMSCWR, DMSCIO, DMSCPF, DMSFNS 00064000 * 00065000 * EXTERNAL REFERENCES 00066000 * 00067000 * NUCON, BGCOM, DOSCB, OSFST 00068000 * 00069000 * TABLES/WORK AREAS 00070000 * 00071000 * NONE 00072000 * 00073000 * REGISTER USAGE 00074000 * 00075000 * R0 NUCON ADDRESSABILITY 00076000 * R1 COMMAND LINE POINTER & PLIST(S) POINTER 00077000 * R2 INPUT BUFFER POINTER & WORK 00078000 * R3 WORK 00079000 * R4 OUTPUT BUFFER POINTER 00080000 * R5 ESID POINTER & WORK 00081000 * R6 ESID COUNT & WORK 00082000 * R7 WORK 00083000 * R8 WORK 00084000 * R9 DOSCB & OSFST POINTER 00085000 * R10 INTERNAL LINKAGE 00086000 * R11 BCT COUNTER 00087000 * R12 DMSRRV ADDRESSABILITY 00088000 * R13 NOT USED 00089000 * R14 EXTERNAL LINKAGE 00090000 * R15 ADDRESS LINKING ROUTINE & RETURN CODE 00091000 * 00092000 * OPERATION 00093000 * 00094000 * 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00095000 * THE RETURN REGISTER. ACQUIRE SUPERVISOR KEY 00096000 * AND INITIALIZE REUSABILITY FIELDS. VERIFY IF 00097000 * IN CMS/DOS ENVIRONMENT. 00098000 * 00099000 * 2. CHECK THE COMMAND LINE FOR VALID ARGUMENTS 00100000 * AND OPTIONS. ENSURE THAT A MODULE NAME WAS 00101000 * SPECIFIED. SET APPROPIATE SWITCHES FOR EACH 00102000 * OPTION SPECIFIED. IF THE 'DISK' OPTION IS 00103000 * SPECIFIED OR IMPLIED, ERASE ANY OLD FILE ON 00104000 * THE 'A' DISK. IF ERASE RETURNS A CODE OF 36, 00105000 * EITHER THE 'A' DISK IS R/O OR IS NOT ATTACHED. 00106000 * 00107000 * 3. DETERMINE IF READING FROM THE SYSTEM OR PRIVATE 00108000 * RELOCATABLE LIBRARY (PRIVATE IS SEARCHED FIRST) 00109000 * & START READING THE APPROPIATE LIBRARY DIRECTORY 00110000 * RECORDS TO LOCATE THE SPECIFIED MODULE. ONCE THE 00111000 * MODULE ENTRY IS FOUND, COMPUTE THE DISK ADDRESS 00112000 * OF THE MODULE DATA BLOCKS. 00113000 * 00114000 * 4. READ THE MODULE DATA BLOCKS ONE AT A TIME. DECODE 00115000 * EACH DATA BLOCK INTO CARD IMAGES. 'ESD', 'RLD', 00116000 * AND 'TXT' CARD IMAGES ARE PROCESSED INDIVIDUALLY. 00117000 * ALL OTHER TYPE OF CARDS ARE JUST WRITTEN TO THE 00118000 * OUTPUT 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 DMSRRV CSECT @V305001 00136000 USING DMSRRV,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 XC PCHNO,PCHNO ZERO CARD SERIAL NUMBER @V305001 00145000 MVC FTYPE,TEXT SET DEFAULT FILE TYPE @V305001 00146000 EJECT 00147000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00148000 * * 00149000 * CHECK COMMAND LINE FOR VALID ARGUMENTS AND OPTIONS. * 00150000 * SET APROPIATE SWITCHES FOR EACH OPTION SPECIFIED. * 00151000 * IF NO OPTIONS SPECIFIED, 'DISK' IS DEFAULT. * 00152000 * * 00153000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00154000 SPACE 2 00155000 LA R1,8(,R1) BUMP TO MODULE NAME @V305001 00156000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00157000 BE ERR001 NO, ERROR @V305001 00158000 CLI 0(R1),LPAR DITTO ? @V305001 00159000 BE ERR001 NO, ERROR @V305001 00160000 MVC MDNAME,0(R1) SAVE MODULE NAME @V305001 00161000 LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00162000 CLI 0(R1),FENCE ANY MORE ON LINE ? @V305001 00163000 BE OPTSOK NO, BRANCH @V305001 00164000 CLI 0(R1),LPAR LEFT PARENS ? @V305001 00165000 BE OPTLUP YES, PROCESS OPTIONS @V305001 00166000 MVC FTYPE,0(R1) SET USER'S FILE TYPE @V305001 00167000 LA R1,8(,R1) BUMP TO POSS. OPTIONS @V305001 00168000 CLI 0(R1),FENCE ANY MORE ? @V305001 00169000 BE OPTSOK NO, BRANCH @V305001 00170000 CLI 0(R1),LPAR LEFT PARENS ? @V305001 00171000 BNE ERR070 NO, ERROR @V305001 00172000 OPTLUP LA R1,8(,R1) BUMP TO OPTION @V305001 00173000 CLI 0(R1),FENCE ANY SPECIFIED ? @V305001 00174000 BE OPTSOK NO, ALL DONE WITH OPTIONS @V305001 00175000 CLI 0(R1),RPAR END OF OPTIONS ? @V305001 00176000 BE OPTSOK YES, ALL DONE WITH OPTIONS @V305001 00177000 CLC CDISK,0(R1) DISK OPTION ? @V305001 00178000 BNE CKPUN NO, CHECK PUNCH @V305001 00179000 OI SSW,DISK SET DISK FLAG @V305001 00180000 B OPTLUP KEEP LOOKING @V305001 00181000 CKPUN CLC CPUNCH,0(R1) PUNCH OPTION ? @V305001 00182000 BNE CKPRT NO, CHECK PRINT @V305001 00183000 OI SSW,PUNCH SET PUNCH FLAG @V305001 00184000 B OPTLUP KEEP LOOKING @V305001 00185000 CKPRT CLC CPRINT,0(R1) PRINT OPTION ? @V305001 00186000 BNE CKTRM NO, CHECK TERM @V305001 00187000 OI SSW,PRINT SET PRINT FLAG @V305001 00188000 B OPTLUP KEEP LOOKING @V305001 00189000 CKTRM CLC CTERM,0(R1) TERM OPTION ? @V305001 00190000 BNE ERR003 NO, ERROR @V305001 00191000 OI SSW,TERM SET TERM FLAG @V305001 00192000 B OPTLUP KEEP LOOKING @V305001 00193000 EJECT 00194000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00195000 * * 00196000 * IF 'DISK' OPTION SPECIFIED OR IMPLIED, ERASE ANY OLD * 00197000 * FILE ON THE 'A' DISK WITH THE SAME FILEID. IF ERASE * 00198000 * RETURNS A CODE OF 36, EITHER THE 'A' DISK IS R/O OR IS * 00199000 * NOT ATTACHED. IN EITHER CASE A MESSAGE IS ISSUED. * 00200000 * * 00201000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00202000 SPACE 2 00203000 OPTSOK CLI SSW,ZERO ANY OPTIONS SPECIFIED? @VA08978 00203600 BNE READDIR NOT DEFAULT - GO CHECK DIRECTORY @VA08978 00204200 OI SSW,DISK TURN ON DISK OPTION @VA08978 00204800 B READDIR GO CHECK DIRECTORY @VA08978 00205400 CHKDSK EQU * @VA08978 00206000 TM SSW,DISK WAS DISK SPECIFIED? @VA08978 00206600 BZ FNDMOD NOT DISK - DON'T BOTHER TO ERASE @VA08978 00207200 ERSOLD MVC FNAME,MDNAME SET UP FILE NAME @VA08978 00207800 LA R1,DSKLST GET ERASE PLIST @V305001 00209000 L R15,AERASE GET DMSERS ADDRESS @V305001 00210000 BALR R14,R15 ERASE OLD FILE @V305001 00211000 CH R15,=H'36' ANY DISK PROBLEM ? @V305001 00212000 BE ERR006 YES,GIVE ERROR @VA08978 00212800 B FNDMOD CONTINUE @VA08978 00213600 EJECT 00214400 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00215200 * * 00216000 * DETERMINE IF READING FROM SYSTEM RELO. OR FROM PRIVATE * 00217000 * RELO., READ APPROPIATE LIBRARY DIRECTORY AND INITIATE * 00218000 * SEARCH FOR SPECIFIED MODULE. ONCE THE MODULE ENTRY IS * 00219000 * FOUND, COMPUTE THE DISK ADDRESS OF THE MODULE DATA BLOCKS. * 00220000 * * 00221000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00222000 SPACE 2 00223000 READDIR BAL R10,CKPRLL CHECK IF PRIV. RELO. ACTIVE @V305001 00224000 TM SSW,PRLLA IS LIBRARY ACTIVE ? @V305001 00225000 BO SETLEN YES, BRANCH @V305001 00226000 READSYS NI SSW,255-PRLLA NO MORE PRIVATE LIBRARY @V305001 00227000 LA R3,SYSRES GET SYSRES LUB INDEX @V305001 00228000 BAL R10,TSTUNIT SEE IF SYSRES ACTIVE @V305001 00229000 BZ ERR002 BRANCH IF NOT ACTIVE @V305001 00230000 OI SSW,RLLA SET SYSRES ACTIVE @V305001 00231000 MVC CUU(2),0(R3) SAVE SYSRES DEVICE ADDRESS @V305001 00232000 LA R3,DIRPL SRL DIRECTORY POINTER LENGTH @V305001 00233000 STH R3,READCCW+6 TO SAVE IN READ CCW @V305001 00234000 MVC CCHHR(5),SRLDIR SET TO FIND SRL DIRECTORY @V305001 00235000 BAL R10,DISKIO GO READ POINTER TO SRL @V305001 00236000 MVC SRLADR(5),INBUF+2 GET SRL DIRECTORY ADDR. @V305001 00237000 MVC CCHHR(5),SRLADR SET UP SEEK/SEARCH ADDRESS @V305001 00238000 SETLEN LA R3,DIRBL DIRECTORY BLOCK LENGTH @V305001 00239000 STH R3,READCCW+6 TO SAVE IN READ CCW @V305001 00240000 NXTBLK BAL R10,DISKIO READ DIRECTORY @V305001 00241000 LA R2,INBUF POINT TO BUFFER @V305001 00242000 TSTEND CLI 0(R2),DIREND END OF DIRECTORY ? @V305001 00243000 BE ERR002 YES, MODULE NOT FOUND @V305001 00244000 C R2,ENDDIR END OF BLOCK ? @V305001 00245000 BNL NXTBLK YES, GET ANOTHER BLOCK @V305001 00246000 CLC MDNAME,0(R2) MODULE NAME MATCH? @VA08978 00247000 BE CHKDSK FOUND - GO CHECK FOR ERASE @VA08978 00248000 LA R2,16(,R2) BUMP TO NEXT ENTRY @VA08978 00249000 B TSTEND KEEP LOOKING @V305001 00250000 SPACE 1 00251000 FNDMOD MVC CHHR(4),10(R2) INITIALIZE ADDRESS @V305001 00252000 MVC CCHHR(1),HHR MOVE H1 TO C1 @V305001 00253000 MVI HHR,ZERO SET H1 TO ZERO @V305001 00254000 LA R3,DATABL DATA BLOCKS LENGTH @V305001 00255000 STH R3,READCCW+6 TO SAVE IN READ CCW @V305001 00256000 EJECT 00257000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00258000 * * 00259000 * DECODE EACH BLOCK READ INTO CARD IMAGES RECORDS. * 00260000 * * 00261000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00262000 SPACE 2 00263000 NXTBUF BAL R10,DISKIO READ 1ST DATA BLOCK @V305001 00264000 LA R1,INBUF+2 POINT TO INPUT BUFFER @V305001 00265000 NXTREC MVC BLOCK,0(R1) MOVE RECORD TO BLOCK AREA @V305001 00266000 IC R2,INBUF GET RECORD COUNT @V305001 00267000 BCTR R2,0 LESS ONE @V305001 00268000 STC R2,INBUF RESTORE NEW COUNT @V305001 00269000 LA R1,160(,R1) POINT TO NEXT RECORD @V305001 00270000 B ENDTST GO TEST FOR END CARD @V305001 00271000 TSTEOM TM SSW,EOM END CARD READ ? @V305001 00272000 BO ALLDONE YES, ALL DONE THEN @V305001 00273000 CLI INBUF,ZERO ANY MORE LEFT IN THIS BUFFER ? @V305001 00274000 BNE NXTREC YES, KEEP LOOKING @V305001 00275000 B NXTBUF GO READ NEXT DATA BLOCK @V305001 00276000 SPACE 1 00277000 ENDTST CLC BLOCK(4),END IS THIS END CARD ? @V305001 00278000 BNE NOEND NO, BRANCH @V305001 00279000 OI SSW,EOM SET END CARD READ @V305001 00280000 NOEND EQU * @VA08978 00280500 LA R4,OUTBUF POINT TO CARD COLUMN 1 @VA08978 00281000 MVI OUTBUF,BLANK PUT BLANK IN FIRST BYTE @VA08978 00281500 MVC 1(79,R4),0(R4) BLANK 80 BYTES FOR RECORD @VA08978 00282000 BCTR R4,0 ADJUST POINTER TO BUFFER @VA08978 00282500 MVC 1(16,R4),BLOCK INITIAL HEADER @V305001 00283000 MVC BYTECNT,BLOCK+10 SAVE BLOCK BYTE COUNT @V305001 00284000 CLC BLOCK(4),ESD ESD CARD ? @V305001 00285000 BE ESDREC YES, BRANCH @V305001 00286000 CLC BLOCK(4),TXT TXT CARD ? @V305001 00287000 BE TXTREC YES, BRANCH @V305001 00288000 CLC BLOCK(4),RLD RLD CARD ? @V305001 00289000 BE RLDREC YES, BRANCH @V305001 00290000 MVC 1(80,R4),BLOCK SET UP CARD IMAGE @V305001 00291000 BAL R10,OUTLINE GO OUTPUT THIS LINE @V305001 00292000 B TSTEOM GO SEE IF MORE... @V305001 00293000 EJECT 00294000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00295000 * * 00296000 * PROCESS 'ESD' RECORDS INTO CARD IMAGES * 00297000 * * 00298000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00299000 SPACE 2 00300000 ESDREC CLC BLOCK+14(2),BLANKS IS ESID NO. BLANK ? @V305001 00301000 BNE EDPCLA NO, BRANCH @V305001 00302000 MVI AREA,BLANK BLANK OUT ESID AREA @V305001 00303000 MVC AREA+1(5),AREA ... @V305001 00304000 EDPCAI LA R5,AREA INITIALIZE ADDRESSES @V305001 00305000 LA R8,BLOCK+16 ... @V305001 00306000 EDPCBA SR R3,R3 CLEAR @V305001 00307000 MVC 15(2,R4),0(R5) MOVE ESID NO. TO BUFFER @V305001 00308000 LA R5,2(,R5) BUMP @V305001 00309000 EDPCCS CLC BLOCK+10(2),=H'48' BYTE COUNT LESS THAN 48 ? @V305001 00310000 BH EDPCIR NO, INITIALIZE REGISTER @V305001 00311000 CLC BLOCK+10(2),=H'0' IS BYTE COUNT ZERO ? @V305001 00312000 BE REINT1 YES, BRANCH @V305001 00313000 * 00314000 LH R3,BLOCK+10 MOVE ESD BYTES TO BUFFER @V305001 00315000 SH R3,=H'1' LESS ON FOR EXECUTE @V305001 00316000 EX R3,MVPCH MOVE IT @V305001 00317000 MVC 11(2,R4),BLOCK+10 MOVE BYTE COUNT TO BUFFER @V305001 00318000 EDCPGP BAL R10,OUTLINE OUTPUT THIS LINE @V305001 00319000 * 00320000 REINT1 MVC BLOCK+10(2),BYTECNT RESTORE BLOCK BYTE COUNT @V305001 00321000 B TSTEOM CHECK FOR END OF MODULE @V305001 00322000 EJECT 00323000 EDPCIR LA R3,BYTECNT1-1 BYTE COUNT - 1 @V305001 00324000 EX R3,MVPCH MOVE IT @V305001 00325000 LA R8,BYTECNT1(,R8) UPDATE BLOCK ADDRESS @V305001 00326000 MVC 11(2,R4),=H'48' MOVE BYTE COUNT TO BUFFER @V305001 00327000 BAL R10,OUTLINE OUTPUT THIS LINE @V305001 00328000 LH R3,BLOCK+10 REDUCE BYTE COUNT BY 48 @V305001 00329000 SH R3,=H'48' ... @V305001 00330000 STH R3,BLOCK+10 SAVE NEW BYTE COUNT @V305001 00331000 B EDPCBA GO TO BRANCH ADDRESS @V305001 00332000 * 00333000 EDPCLA LA R5,AREA LOAD ADDRESS @V305001 00334000 MVC 0(2,R5),BLOCK+14 MOVE ESID NUMBER @V305001 00335000 LH R9,BLOCK+10 DIVIDE NO OF BYTES BY 16 @V305001 00336000 SRL R9,4 ... @V305001 00337000 LA R7,BLOCK+24 LOAD ESD TYPE ADDRESS @V305001 00338000 EDPCLI LA R11,THREE GET MAX ENTRIES IN BLOCK @V305001 00339000 LA R6,ZERO ... @V305001 00340000 EDPCLT CLI 0(R7),LDTYPE TEST FOR LD TYPE @V305001 00341000 BE EDPCNA YES, GO TO INCREMENT ADDR @V305001 00342000 LA R6,1(,R6) INCREMENT ESD COUNT @V305001 00343000 EDPCNA LA R7,16(,R7) INCREMENT ADDRESS @V305001 00344000 BCT R9,EDPCRT LOOP THRU REGISTER TEST @V305001 00345000 * 00346000 CH R6,=H'0' TEST FOR ZERO @V305001 00347000 BNE EDPCAI ZERO, GO TO ADDRESS INIT @V305001 00348000 MVC 0(2,R5),BLANKS BLANK OUT AREA @V305001 00349000 B EDPCAI GO TO ADDRESS INIT @V305001 00350000 * 00351000 EDPCRT BCT R11,EDPCLT LOOP TEST @V305001 00352000 CH R6,=H'0' IS ESID COUNT ZERO ? @V305001 00353000 BNE EDPCSC NO, GO TO STORE COUNT @V305001 00354000 MVC 2(2,R5),0(R5) MOVE ESID OF AREA TO AREA2 @V305001 00355000 MVC 0(2,R5),BLANKS MOVE BLANKS TO AREA @V305001 00356000 B EDPCSI GO TO STORE INDEX INCREMENT @V305001 00357000 * 00358000 EDPCSC AH R6,0(,R5) COMPUTE ESID COUNT @V305001 00359000 STH R6,2(,R5) STORE IN AREA+2 @V305001 00360000 EDPCSI LA R5,2(,R5) ... @V305001 00361000 B EDPCLI GO TO LOOP INITIALIZATION @V305001 00362000 EJECT 00363000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00364000 * * 00365000 * PROCESS 'TXT' RECORDS INTO CARD IMAGES * 00366000 * * 00367000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00368000 SPACE 2 00369000 TXTREC LA R7,BLOCK+16 INITIALIZE BLOCK ADDRESS @V305001 00370000 MVC BYTECNT+2(3),BLOCK+5 @V305001 00371000 TXPCIM SR R8,R8 INITIALIZE REGISTER @V305001 00372000 MVC 1(16,R4),BLOCK INITIAL HEADER @V305001 00373000 CLC BLOCK+10(2),=H'56' IS BYTE COUNT OVER 56 ? @V305001 00374000 BH TXPCSC YES, GO TO SPLIT CARD @V305001 00375000 CLC BLOCK+10(2),=H'0' IS BYTE COUNT ZERO ? @V305001 00376000 BE REINT1 YES, GO TO NEXT CARD @V305001 00377000 * 00378000 LH R8,BLOCK+10 MOVE TEXT TO BUFFER @V305001 00379000 SH R8,=H'1' LESS ONE FOR EXECUTE @V305001 00380000 EX R8,MVPCH2 MOVE IT @V305001 00381000 MVC BLOCK+5(3),BYTECNT+2 RESTORE ORIGIN @V305001 00382000 B EDCPGP PUT THIS CARD OUT @V305001 00383000 * 00384000 TXPCSC MVC 11(2,R4),=H'56' MOVE 56 BYTES TO BUFFER @V305001 00385000 LA R8,BYTECNT2-1 56 - 1 = 55 @V305001 00386000 EX R8,MVPCH2 MOVE IT @V305001 00387000 LA R7,BYTECNT2(,R7) UPDATE BLOCK ADDRESS @V305001 00388000 BAL R10,OUTLINE OUTPUT THIS LINE @V305001 00389000 L R8,BLOCK+4 UPDATE ORIGIN @V305001 00390000 AH R8,=H'56' UPDATE BYTE COUNT @V305001 00391000 ST R8,BLOCK+4 SAVE IT @V305001 00392000 LH R8,BLOCK+10 UPDATE BYTE COUNT @V305001 00393000 SH R8,=H'56' SUBTRACT 56 @V305001 00394000 STH R8,BLOCK+10 SAVE IT @V305001 00395000 B TXPCIM GO TO INITIALIZE AND MOVE @V305001 00396000 EJECT 00397000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00398000 * * 00399000 * PROCESS 'RLD' RECORDS INTO CARD IMAGES * 00400000 * * 00401000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00402000 SPACE 2 00403000 RLDREC LA R7,BLOCK+24 INITIALIZE ADDRESSES @V305001 00404000 LA R8,BLOCK+20 ... @V305001 00405000 MVC SAVERP(4),BLOCK+16 SAVE RP @V305001 00406000 MVC 17(8,R4),BLOCK+16 MOVE 8 BYTES TO BUFFER @V305001 00407000 RDPCAI LA R6,EIGHT ADDRESS INITIALIZATION @V305001 00408000 LA R5,25(,R4) ... @V305001 00409000 CLC BLOCK+10(2),=H'56' BLOCK COUNT OVER 56 ? @V305001 00410000 BH RDPCBB YES, GO TO BREAK BLOCK @V305001 00411000 CLC BLOCK+10(2),=H'0' IS BYTE COUNT ZERO @V305001 00412000 BE REINT1 YES, GET NEXT CARD @V305001 00413000 * 00414000 LH R3,BLOCK+10 GET REMAINING BYTES @V305001 00415000 SH R3,=H'9' ... @V305001 00416000 BM RDPCAJ IF NOT POSITIVE, BRANCH @V305001 00417000 EX R3,MVPCH1 MOVE THEM TO BUFFER @V305001 00418000 RDPCAJ MVC 11(2,R4),BLOCK+10 MOVE BYTE COUNT TO BUFFER @V305001 00419000 B EDCPGP PUT THIS LINE OUT @V305001 00420000 * 00421000 RDPCBB LH R3,BLOCK+10 GET BYTE COUNT OF BLOCK @V305001 00422000 SH R3,=H'56' SUBTRACT 56 BYTES @V305001 00423000 STH R3,BLOCK+10 SAVE NEW COUNT @V305001 00424000 RDPCCT TM 0(R8),ONE IS CONTINUATION BIT ON ? @V305001 00425000 BO RDPCTS YES, GO TO TEST @V305001 00426000 MVC SAVERP(4),0(R7) SAVE NEW RP @V305001 00427000 CH R6,=H'48' COMP TO BUFFER BYTE COUNT @V305001 00428000 BH RDPCS8 IF HIGH, STORE 8 BYTES @V305001 00429000 LA R3,EIGHT-1 MOVE 8 BYTES TO BUFFER @V305001 00430000 EX R3,MVPCH1 MOVE IT @V305001 00431000 LA R7,8(,R7) UPDATE ADDRESSES @V305001 00432000 LA R8,8(,R8) UPDATE FLAG POINTER @V305001 00433000 LA R5,8(,R5) ... @V305001 00434000 LA R6,8(,R6) ... @V305001 00435000 B RDPCCT GO TO CONTINUATION TEST @V305001 00436000 EJECT 00437000 RDPCS4 STC R6,12(,R4) STORE BUFFER BYTE COUNT @V305001 00438000 LR R3,R5 BACKSPACE TO LAST @V305001 00439000 SH R3,=H'4' FLAG AND DELETE @V305001 00440000 NI 0(R3),255-ONE CONTINUATION BIT @V305001 00441000 BAL R10,OUTLINE OUTPUT THIS CARD @V305001 00442000 MVC 17(4,R4),SAVERP MOVE SAVED RP TO BUFFER @V305001 00443000 MVC 21(4,R4),0(R7) MOVE FOUR BYTES TO BUFFER @V305001 00444000 LA R7,4(,R7) UPDATE ADDRESSES @V305001 00445000 LA R8,4(,R8) ... @V305001 00446000 INCRIT LH R3,BLOCK+10 INCREASE COUNT @V305001 00447000 LA R3,4(,R3) FOR ADDED @V305001 00448000 STH R3,BLOCK+10 R AND P POINTERS @V305001 00449000 B RDPCAI GO TO ADDR INITIALIZATION @V305001 00450000 * 00451000 RDPCS8 STC R6,12(,R4) STORE BYTE COUNT IN BUFFER @V305001 00452000 BAL R10,OUTLINE OUTPUT THIS CARD @V305001 00453000 MVC 17(8,R4),0(R7) MOVE 8 BYTES TO BUFFER @V305001 00454000 LA R7,8(,R7) UPDATE ADDRESSES @V305001 00455000 LA R8,8(,R8) ... @V305001 00456000 CH R6,=H'52' IF COUNT NOT 56, INCREASE @V305001 00457000 BE INCRIT REMAINING RECORD COUNT. @V305001 00458000 B RDPCAI GO TO ADDR INITIALIZATION @V305001 00459000 * 00460000 RDPCTS CH R6,=H'52' COMPARE BUFFER COUNT TO 5 @V305001 00461000 BH RDPCS4 IF HIGH GO TO SAVE 4 @V305001 00462000 LA R3,FOUR-1 4 - 1 = 3 @V305001 00463000 EX R3,MVPCH1 MOVE 4 BYTES TO BUFFER @V305001 00464000 LA R5,4(,R5) UPDATE ADDRESSES @V305001 00465000 LA R7,4(,R7) ... @V305001 00466000 LA R8,4(,R8) ... @V305001 00467000 LA R6,4(,R6) ... @V305001 00468000 B RDPCCT GO TO CONTINUATION TEST @V305001 00469000 EJECT 00470000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00471000 * * 00472000 * ROUTINE TO READ EITHER FROM SYSRES OR SYSRLB. * 00473000 * THE I/O IS DIAGNOSED TO CP AND UPON RETURN ONLY * 00474000 * END-OF-CYLINDER IS ACCEPTED. ANY OTHER ERROR WILL * 00475000 * TERMINATE THIS COMMAND. * 00476000 * * 00477000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00478000 SPACE 2 00479000 DISKIO LA R0,SEEKCCW GET CHANNEL PGM ADDR @V305001 00480000 LH R1,CUU GET DISK DEVICE ADDR @V305001 00481000 DC X'83100020' DIAGNOSE I/O TO CP @V305001 00482000 BZR R10 RETURN WITH GOOD I/O @V305001 00483000 BM ERR113 DISK NOT ATTACHED EXIT @V305001 00484000 BP ERR411 I/O ERROR @V305001 00485000 STH R0,SENSE SAVE SENSE INFO. @V305001 00486000 TM SENSE+1,EOC IS IT END-OF-CYLINDER @V305001 00487000 BZ ERR411 NO, UNRECOVERABLE ERROR @V305001 00488000 LH R1,CCHHR GET CURRENT CYLINDER @V305001 00489000 LA R1,1(,R1) UP BY ONE @V305001 00490000 STH R1,CCHHR SAVE NEW CYLINDER @V305001 00491000 LA R1,ONE GET HEAD 0, REC 1 CONSTANT @V305001 00492000 STCM R1,M7,HHR SAVE NEW HEAD AND REC @V305001 00493000 BR R10 RETURN TO CALLER @V305001 00494000 EJECT 00495000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00496000 * * 00497000 * ROUTINE TO DETERMINE TO WHAT DEVICE OR DEVICES THE * 00498000 * OUTPUT SHOULD GO. SWITCH 'SSW' CONTAINS INFORMATION * 00499000 * TO DETERMINE THIS. ALL I/O IS DONE THROUGH CMS FUNCTIONS. * 00500000 * * 00501000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00502000 SPACE 2 00503000 OUTLINE ST R1,SAVE1 SAVE REG. 1 @V305001 00504000 L R1,PCHNO GET LAST SERIAL NO. @V305001 00505000 LA R1,1(,R1) UP BY ONE @V305001 00506000 ST R1,PCHNO SAVE FOR NEXT CARD @V305001 00507000 CVD R1,WORK CONVERT TO DECIMAL @V305001 00508000 UNPK 77(4,R4),WORK UNPACK NO. TO BUFFER @V305001 00509000 MVZ 80(1,R4),79(R4) SET ZONE @V305001 00510000 TM SSW,DISK+PUNCH+PRINT+TERM ANY OPTIONS ? @V305001 00511000 BZ OUTDSK NO, DEFAULT TO DISK @V305001 00512000 TM SSW,PUNCH PUNCH SPECIFIED ? @V305001 00513000 BZ TSTPRT NO, CHECK PRINT @V305001 00514000 LA R1,PUNLST POINT TO PUNCH PLIST @V305001 00515000 SVC 202 PUNCH THIS CARD @V305001 00516000 DC AL4(*+4) ... @V305001 00517000 CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00518000 BE EXIT YES, GET OUT @V305001 00519000 SPACE 1 00520000 TSTPRT TM SSW,PRINT PRINT SPECIFIED ? @V305001 00521000 BZ TSTCON NO, CHECK TERM @V305001 00522000 PRT LA R1,PRTLST POINT TO PRINT PLIST @V305066 00523000 SVC 202 PRINT THIS LINE @V305001 00524000 DC AL4(*+4) ... @V305001 00525000 CH R15,=H'100' NOT ATT OR INT REQ ? @V305001 00526000 BE EXIT YES, GET OUT @V305001 00527000 TM SSW,FIRST FIRST TIME THROUGH? @V305066 00528000 BO TSTCON NO, NOT FIRST PRINT @V305066 00529000 OI SSW,FIRST FIRST TIME INDICATOR @V305066 00530000 MVI CHAR,BLANK PRINT AND SPACE @V305066 00531000 B PRT GO PRINT FIRST RECORD @V305066 00532000 SPACE 1 00533000 TSTCON TM SSW,TERM TERM SPECIFIED ? @V305001 00534000 BZ TSTDSK NO, CHECK DISK @V305001 00535000 LA R1,TYPLST POINT TO TERM PLIST @V305001 00536000 SVC 202 DISPLAY THIS LINE @V305001 00537000 SPACE 1 00538000 TSTDSK TM SSW,DISK DISK SPECIFIED ? @V305001 00539000 BZ OUTXIT NO, RETURN @V305001 00540000 OUTDSK LA R1,DSKLST POINT TO DISK PLIST @V305001 00541000 L R15,AWRBUF GET DMSBWR ADDRESS @V305001 00542000 BALR R14,R15 WRITE THIS RECORD @V305001 00543000 LTR R15,R15 ANY ERRORS ? @V305001 00544000 BNZ ERR105 YES, BRANCH @V305001 00545000 OUTXIT L R1,SAVE1 RESTORE REG. 1 @V305001 00546000 MVI 17(R4),BLANK BLANK PUNCH AREA @V305001 00547000 MVC 18(63,R4),17(R4) ... @V305001 00548000 BR R10 @V305001 00549000 EJECT 00550000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00551000 * * 00552000 * VERIFY IF PRIVATE RELO. IS ASSIGNED, AND IF SO, ISSUE * 00553000 * DUMMY DLBL FOR IJSYSRL TO ACQUIRE USER ISSUED DLBL. * 00554000 * VERIFY THAT AN OSFST EXIST TO GET THE STARTING CCHHR OF * 00555000 * THE DATA SET AND THE VIRTUAL DEVICE ADDRESS. * 00556000 * * 00557000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00558000 SPACE 2 00559000 CKPRLL ST R10,SAVE10 SAVE RETURN REGISTER @V305001 00560000 LA R3,SYSRLB GET SYSRLB LUB INDEX NO. @V305001 00561000 BAL R10,TSTUNIT SEE IF UNIT ASSIGNED @V305001 00562000 BZ NOPRLL BRANCH IF NOT ASSIGNED @V305001 00563000 SR R9,R9 ... @V305001 00564000 ICM R9,M7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305001 00565000 USING DOSSECT,R9 @V305001 00566000 PRLL1 BZ NOPRLL IF ZERO, NO MORE DOSCB @V305001 00567000 CLC IJSYSRL,DOSDD MATCHING DDNAME ? @V305001 00568000 BE PRLL2 YES, BRANCH @V305001 00569000 ICM R9,M7,1(R9) GET NEXT DOSCB ADDRESS @V305001 00570000 B PRLL1 BRANCH @V305001 00571000 PRLL2 CLI DOSDEV,DOSDSK IS DEVICE DISK ? @V305001 00572000 BNE NOPRLL NO, BRANCH @V305001 00573000 LA R1,DOSOP USE DOSCB FOR STATE PLIST @V305001 00574000 MVC DOSOP,=CL8'STATE' MOVE STATE COMMAND TO PLIST @V305001 00575000 L R15,ASTATE GET STATE ADDRESS @V305001 00576000 BALR R14,R15 SEE IF FILE EXISTS @V305001 00577000 LTR R15,R15 FILE FOUND ? @V305001 00578000 BNZ NOPRLL BRANCH IF NOT FOUND @V305001 00579000 L R9,DOSOSFST GET OSFST FOR PRIV RELO @V305001 00580000 DROP R9 @V305001 00581000 LTR R9,R9 ANY AVAILABLE ? @V305001 00582000 BZ NOPRLL NO, BRANCH @V305001 00583000 USING OSFST,R9 @V305001 00584000 MVC CCHHR(4),OSFSTXTN+2 SAVE PRIV. RELO. CCHHR @V305001 00585000 MVI R,ONE RECORD ONE @V305001 00586000 MVC CUU(2),OSFSTDSK SAVE PRIV. RELO. CUU @V305001 00587000 DROP R9 @V305001 00588000 OI SSW,PRLLA SET PRLLA FLAG IN SSW @V305001 00589000 NOPRLL L R10,SAVE10 RESTORE RETURN REG. @V305001 00590000 BR R10 RETURN @V305001 00591000 EJECT 00592000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00593000 * * 00594000 * CHECK IF SYSRLB OR SYSRES HAS BEEN ASSIGNED. * 00595000 * REG 3 = 0 MEANS UNIT NOT ASSIGNED, OTHERWISE REG 3 * 00596000 * CONTAINS THE POINTER TO THE CORRECT PUB ENTRY. * 00597000 * * 00598000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00599000 SPACE 2 00600000 TSTUNIT EQU * @V305001 00601000 USING BGCOM,R1 @V305001 00602000 L R1,ASYSREF GET BGCOM ADDRESS @V305001 00603000 AH R3,LUBPT POINT TO CORRECT LUB ENTRY @V305001 00604000 TM 0(R3),UNASSGN UNIT ASSIGNED ? @V305001 00605000 BO NOTASSGN NO, BRANCH @V305001 00606000 LH R3,0(,R3) LUB ENTRY TO REG 3 @V305001 00607000 SRL R3,8 ISOLATE PUB POINTER @V305001 00608000 SLL R3,3 MULTIPLY BY 8 @V305001 00609000 AH R3,PUBPT POINT TO CORRECT PUB ENTRY @V305001 00610000 LTR R3,R3 SET CONDITION CODE @V305001 00611000 BR R10 RETURN TO CALLER @V305001 00612000 NOTASSGN SR R3,R3 ZERO REG 3 @V305001 00613000 LTR R3,R3 SET CONDITION CODE @V305001 00614000 BR R10 RETURN TO CALLER @V305001 00615000 DROP R1 @V305001 00616000 EJECT 00617000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00618000 * * 00619000 * CLOSE ANY OUTPUT FILE USED BY THIS COMMAND, THEN * 00620000 * RETURN BACK TO CALLER PASSING IN REGISTER 15 THE * 00621000 * RETURN CODE OF THIS COMMAND. * 00622000 * * 00623000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00624000 SPACE 2 00625000 ALLDONE SR R15,R15 ZERO RETURN CODE @V305001 00626000 EXIT LR R10,R15 TEMP SAVE RETURN CODE @V305001 00627000 TM SSW,DISK+PUNCH+PRINT+TERM ANY OPTIONS ? @V305001 00628000 BZ CLDSK2 NO, CLOSE DISK FILE @V305001 00629000 TM SSW,PUNCH PUNCH OPTION ? @V305001 00630000 BZ CLPRT NO, CHECK PRINT @V305001 00631000 MVC CLDEV,CPUNCH SET UP DEVICE @V305001 00632000 LA R1,CLOSE GET CLOSE PLIST @V305001 00633000 SVC 202 CLOSE PUNCH @V305001 00634000 DC AL4(*+4) NO-OP @V305001 00635000 CLPRT TM SSW,PRINT PRINT OPTION ? @V305001 00636000 BZ CLDSK NO, CHECK DISK @V305001 00637000 MVC CLDEV,CPRINT SET UP DEVICE @V305001 00638000 LA R1,CLOSE GET CLOSE PLIST @V305001 00639000 SVC 202 CLOSE PRINTER @V305001 00640000 DC AL4(*+4) NO-OP @V305001 00641000 CLDSK TM SSW,DISK DISK OPTION ? @V305001 00642000 BZ EXIT2 NO, RETURN @V305001 00643000 CLDSK2 LA R1,DSKLST GET FINIS PLIST @V305001 00644000 L R15,AFINIS GET DMSFNS ADDRESS @V305001 00645000 BALR R14,R15 CLOSE OUTPUT FILE @V305001 00646000 EXIT2 L R14,SAVE14 LOAD RETURN REGISTER @V305001 00647000 DMSKEY RESET @V305001 00648000 LR R15,R10 RESTORE RETURN CODE @V305001 00649000 BR R14 RETURN TO CALLER @V305001 00650000 EJECT 00651000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00652000 * * 00653000 * STORAGE AND CONSTANT AREAS * 00654000 * * 00655000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00656000 SPACE 2 00657000 WORK DS D CVD/UNPK AREA @V305001 00658000 SAVE14 DS F SAVE FOR RETURN REGISTER @V305001 00659000 SAVE10 DS F TEMP. SAVE FOR REG 10 @V305001 00660000 SAVE1 DS F TEMP. SAVE FOR REG 1 @V305001 00661000 PCHNO DS F CARD SERIAL NUMBER @V305001 00662000 SAVERP DS F SAVE FOR RP @V305001 00663000 ENDDIR DC A(INBUF+320) END ADDRESS OF DIR. BLOCK @V305001 00664000 ENDBUF DC A(INBUF+322) END ADDRESS OF DATA BLOCK @V305001 00665000 SRLADR DC 3H'0' ADDRESS OF SYS RELO DIRECTORY @V305001 00666000 SRLDIR DC H'0',H'1',X'2' POINTER TO SYS RELO DIRECTORY @V305001 00667000 SSW DS X INTERNAL SWITCH @V305001 00668000 CUU DS H DISK VIRTUAL ADDRESS @V305001 00669000 BYTECNT DS 3H LOGICAL REC. BYTE COUNT @V305001 00670000 AREA DS 3H ... @V305001 00671000 SENSE DS H SENSE INFO. FROM BAD DIAGNOSE @V305001 00672000 ESD DC X'02',C'ESD' ESD CARD @V305001 00673000 TXT DC X'02',C'TXT' TXT CARD @V305001 00674000 RLD DC X'02',C'RLD' RLD CARD @V305001 00675000 END DC X'02',C'END' END CARD @V305001 00676000 MVPCH MVC 17(0,R4),0(R8) @V305001 00677000 MVPCH1 MVC 0(0,R5),0(R7) @V305001 00678000 MVPCH2 MVC 17(0,R4),0(R7) @V305001 00679000 CDISK DC CL8'DISK' DISK OPTION @V305001 00680000 CPUNCH DC CL8'PUNCH' PUNCH OPTION @V305001 00681000 CPRINT DC CL8'PRINT' PRINT OPTION @V305001 00682000 CTERM DC CL8'TERM' TERM OPTION @V305001 00683000 TEXT DC CL8'TEXT' DEFAULT FILE TYPE @V305001 00684000 IJSYSRL DC CL8'IJSYSRL' PRIV. RELO. DDNAME @V305001 00685000 MDNAME DC CL8' ' MODULE NAME @V305001 00686000 DS 0H @V305001 00687000 BBCCHHR DC H'0' SEEK ADDRESS @V305001 00688000 CCHHR DS X SEARCH ADDRESS @V305001 00689000 CHHR DS X ... @V305001 00690000 HHR DS X ... @V305001 00691000 HR DS X ... @V305001 00692000 R DS X ... @V305001 00693000 DS XL3 ... @V305001 00694000 EJECT 00695000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00696000 * * 00697000 * CHANNEL PROGRAMS AND COMMON EQUATES * 00698000 * * 00699000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00700000 SPACE 2 00701000 SEEKCCW CCW SEEK,BBCCHHR,CC+SLI,6 @V305001 00702000 SRCHCCW CCW SEARCH,CCHHR,CC+SLI,5 @V305001 00703000 CCW TIC,SRCHCCW,0,1 @V305001 00704000 READCCW CCW RDDATA,INBUF,CC,80 @V305001 00705000 CCW RDCOUNT,CCHHR,SLI,8 @V305001 00706000 * 00707000 SEEK EQU X'07' SEEK CCW CODE @V305001 00708000 SEARCH EQU X'31' SEARCH CCW CODE @V305001 00709000 TIC EQU X'08' TIC CCW CODE @V305001 00710000 RDDATA EQU X'06' READ DATA CCW CODE @V305001 00711000 RDCOUNT EQU X'92' READ COUNT MT CCW CODE @V305001 00712000 CC EQU X'40' COMMAND CHAIN FLAG @V305001 00713000 SLI EQU X'20' SUPPRESS I.L. FLAG @V305001 00714000 FENCE EQU X'FF' PLIST FENCE CODE @V305001 00715000 LPAR EQU C'(' LEFT PARENS CODE @V305001 00716000 RPAR EQU C')' RIGHT PARENS CODE @V305001 00717000 BLANK EQU C' ' BLANK CHARACTER CODE @V305001 00718000 SYSRES EQU 12 SYSRES LUB INDEX @V305001 00719000 SYSRLB EQU 16 SYSRLB LUB INDEX @V305001 00720000 DIRPL EQU 80 DIRECTORY POINTER LENGHT @V305001 00721000 DIRBL EQU 320 DIRECTORY BLOCK LENGTH @V305001 00722000 DIREND EQU C'*' DIRECTORY END CODE @V305001 00723000 DATABL EQU 322 RELO. LIB. DATA BLOCK LENGHT @V305001 00724000 BYTECNT1 EQU 48 BYTE COUNT 1 @V305001 00725000 BYTECNT2 EQU 56 BYTE COUNT 2 @V305001 00726000 EOC EQU X'20' END OF CYLINDER @V305001 00727000 UNASSGN EQU X'FE' LOGICAL UNIT UNASSIGNED @V305001 00728000 LDTYPE EQU C'1' LD CARD TYPE CODE @V305001 00729000 M7 EQU B'0111' ICM/STCM MASK @V305001 00730000 ZERO EQU 0 CONSTANT @V305001 00731000 ONE EQU 1 CONSTANT @V305001 00732000 THREE EQU 3 CONSTANT @V305001 00733000 FOUR EQU 4 CONSTANT @V305001 00734000 SEVEN EQU 7 CONSTANT @V305001 00735000 EIGHT EQU 8 CONSTANT @V305001 00736000 RC24 EQU 24 RETURN CODE @V305001 00737000 RC28 EQU 28 RETURN CODE @V305001 00738000 RC36 EQU 36 RETURN CODE @V305001 00739000 RC40 EQU 40 RETURN CODE @V305001 00740000 RC100 EQU 100 RETURN CODE @V305001 00741000 EJECT 00742000 * 00743000 * FLAGS FOR INTERNAL SWITCH 'SSW' 00744000 * 00745000 DISK EQU X'80' DISK OUTPUT @V305001 00746000 PUNCH EQU X'40' PUNCH OUTPUT @V305001 00747000 PRINT EQU X'20' PRINT OUTPUT @V305001 00748000 TERM EQU X'10' TERM OUTPUT @V305001 00749000 EOM EQU X'08' END CARD READ @V305001 00750000 PRLLA EQU X'04' SYSRLB VOLUME ACTIVE @V305001 00751000 RLLA EQU X'02' SYSRES VOLUME ACTIVE @V305001 00752000 FIRST EQU X'01' FIRST PRINT INDICATOR @V305066 00753000 EJECT 00754000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00755000 * * 00756000 * BUFFERS AND CMS FUNCTION'S PLISTS * 00757000 * * 00758000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00759000 SPACE 2 00760000 DS 0F @V305001 00761000 BLANKS DC CL3' ' CONSTANT @V305066 00762000 CHAR DC X'8B' EJECT ON FIRST PRINT @V305066 00763000 OUTBUF DS CL80 OUTPUT BUFFER @V305001 00764000 BLOCK DS CL160 LOGICAL RECORDS BLOCK @V305001 00765000 INBUF DS CL320 INPUT BUFFER @V305001 00766000 SPACE 2 00767000 DS 0D @V305001 00768000 PUNLST DC CL8'CARDPH' COMMAND NAME @V305001 00769000 DC AL4(OUTBUF) BUFFER ADDRESS @V305001 00770000 DC AL4(80) BUFFER LENGTH @V305001 00771000 SPACE 1 00772000 DS 0D @V305001 00773000 PRTLST DC CL8'PRINTR' COMMAND NAME @V305001 00774000 DC AL4(OUTBUF-1) BUFFER ADDRESS @V305001 00775000 FLAG DC H'1',H'81' FLAG AND BUFFER LENGTH @V305066 00776000 DC 8X'FF' PLIST FENCE @V305001 00777000 SPACE 1 00778000 DS 0D @V305001 00779000 TYPLST DC CL8'TYPLIN' COMMAND NAME @V305001 00780000 DC AL1(1) FLAG @V305001 00781000 DC AL3(OUTBUF) BUFFER ADDRESS @V305001 00782000 DC CL1'B' FLAG @V305001 00783000 DC AL3(80) BUFFER LENGTH @V305001 00784000 SPACE 1 00785000 DS 0D @V305001 00786000 DSKLST DC CL8' ' COMMAND NAME @V305001 00787000 FNAME DC CL8' ' FILE NAME @V305001 00788000 FTYPE DC CL8' ' FILE TYPE @V305001 00789000 DC CL2'A1' FILE MODE @V305001 00790000 DC H'0' ITEM NUMBER @V305001 00791000 DC A(OUTBUF) BUFFER ADDRESS @V305001 00792000 DC A(80) BUFFER LENGTH @V305001 00793000 DC CL2'F' F/V FLAG @V305001 00794000 DC H'1' NUMBER OF ITEMS @V305001 00795000 SPACE 1 00796000 DS 0D @V305001 00797000 CLOSE DC CL8'CP' COMMAND NAME @V305001 00798000 DC CL8'CLOSE' ACTION @V305001 00799000 CLDEV DC CL8' ' DEVICE TO CLOSE @V305001 00800000 DC 8X'FF' PLIST FENCE @V305001 00801000 EJECT 00802000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00803000 * * 00804000 * ERROR MESSAGES * 00805000 * * 00806000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00807000 SPACE 2 00808000 ERR001 EQU * @V305001 00809000 DMSERR TEXT='NO MODULE NAME SPECIFIED',NUM=98,LET=E @V305001 00810000 LA R15,RC24 RETURN CODE @V305001 00811000 B EXIT GET OUT @V305001 00812000 SPACE 1 00813000 ERR002 TM SSW,PRLLA PRIV. RELO. ACTIVE ? @V305001 00814000 BO READSYS YES, READ SYSRES THEN... @V305001 00815000 TM SSW,RLLA SYSRES VOLUME ACTIVE ? @V305001 00816000 BZ ERR097 NO, ANOTHER ERROR @V305001 00817000 LA R2,MDNAME POINT TO MODULE NAME @V305001 00818000 DMSERR TEXT='MODULE ''........'' NOT FOUND',NUM=4,LET=E, *00819000 SUB=(CHARA,(R2)) @V305001 00820000 LA R15,RC28 RETURN CODE @V305001 00821000 B EXIT GET OUT @V305001 00822000 EJECT 00823000 ERR003 LR R2,R1 POINT TO OPTION @V305001 00824000 DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, *00825000 SUB=(CHARA,(R2)) @V305001 00826000 LA R15,RC24 RETURN CODE @V305001 00827000 B EXIT GET OUT @V305001 00828000 SPACE 1 00829000 ERR006 EQU * @V305001 00830000 DMSERR TEXT='NO READ/WRITE ''A'' DISK ACCESSED',NUM=6,LET=E 00831000 LA R15,RC36 RETURN CODE @V305001 00832000 B EXIT GET OUT @V305001 00833000 EJECT 00834000 ERR070 LR R2,R1 POINT TO PARAMETER @V305001 00835000 DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70,LET=E, *00836000 SUB=(CHARA,(R2)) @V305001 00837000 LA R15,RC24 RETURN CODE @V305001 00838000 B EXIT GET OUT @V305001 00839000 SPACE 1 00840000 ERR113 LH R2,CUU GET DISK ADDRESS @V305001 00841000 DMSERR TEXT='DISK (....) NOT ATTACHED',NUM=113,LET=S, @V305001*00842000 SUB=(HEX,(R2)) @V305001 00843000 LA R15,RC100 RETURN CODE @V305001 00844000 B EXIT GET OUT @V305001 00845000 EJECT 00846000 ERR411 LA R3,=CL8'SYSRES' SYSRES TO MSG. @V305001 00847000 TM SSW,PRLLA SYSRLB ACTIVE ? @V305001 00848000 BZ ERR411B NO, BRANCH @V305001 00849000 LA R3,=CL8'SYSRLB' SYSRLB TO MSG. @V305001 00850000 ERR411B LR R2,R15 I/O ERROR CODE @V305001 00851000 DMSERR TEXT='INPUT ERROR CODE ''..'' ON ''........''',NUM=411,*00852000 LET=S,SUB=(DEC,(R2),CHARA,(R3)),RENT=NO @V305001 00853000 LA R15,RC100 RETURN CODE @V305001 00854000 B EXIT GET OUT @V305001 00855000 SPACE 1 00856000 ERR099 EQU * @V305001 00857000 DMSERR TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE',NUM=99,LET=E 00858000 LA R15,RC40 RETURN CODE = 40 @V305066 00859000 B EXIT GET OUT @V305001 00860000 EJECT 00861000 ERR105 LR R2,R15 WRBUF ERROR CODE @V305001 00862000 DMSERR TEXT='ERROR ''..'' WRITING FILE ''....................'*00863000 ' TO DISK',NUM=105,LET=S,SUB=(DEC,(R2),CHAR8A,FNAME), *00864000 RENT=NO @V305001 00865000 LA R15,RC100 RETURN CODE @V305001 00866000 B EXIT GET OUT @V305001 00867000 SPACE 1 00868000 ERR097 EQU * @V305001 00869000 DMSERR TEXT='NO ''SYSRES'' VOLUME ACTIVE',NUM=97,LET=E 00870000 LA R15,RC36 RETURN CODE @V305001 00871000 B EXIT GET OUT @V305001 00872000 EJECT 00873000 NUCON @V305001 00874000 BGCOM @V305001 00875000 DOSCB @V305001 00876000 OSFST @V305001 00877000 REGEQU @V305001 00878000 END 00879000