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