CSO TITLE 'DMKCSO (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMKCSO 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* DMKCSO CONTAINS THE SPOOLING COMMANDS USED TO CONTROL THE REAL 00010000
* SPOOLING UNIT RECORD DEVICES ATTACHED TO THE SYSTEM. THE FUNC- 00011000
* TION OF EACH COMMAND IS DESCRIBED SEPARATELY 00012000
* 00013000
* ATTRIBUTES - 00014000
* 00015000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00016000
* 00017000
* ENTRY POINTS - 00018000
* 00019000
* DMKCSOFL - FLUSH COMMAND 00020000
* DMKCSOSP - SPACE COMMAND 00021000
* DMKCSODR - DRAIN COMMAND 00022000
* DMKCSOST - START COMMAND 00023000
* DMKCSOSD - START DEVICE BY TYPE 00024000
* DMKCSORP - REPEAT COMMAND 00025000
* DMKCSOBS - BACK SPACE COMMAND 00026000
* 00027000
* ENTRY CONDITIONS - 00028000
* 00029000
* GPR9 = ADDRESS OF THE COMMAND LINE BUFFER; MUST BE PRESERVED 00030000
* FOR CALLS TO DMKSCNFD 00031000
* GPR12 = ADDRESS OF ENTRY POINT 00032000
* GPR13 = ADDRESS OF SAVEAREA 00033000
* 00034000
* EXIT CONDITIONS - 00035000
* 00036000
* NORMAL - 00037000
* GPR2 = 0 00038000
* SOME COMMANDS WRITE A VERIFYING MESSAGE TO THE OPERA- 00039000
* TOR; THESE MESSAGES ARE DESCRIBED WITH THE COMMANDS 00040000
* THAT ISSUE THEM 00041000
* 00042000
* ERROR - 00043000
* GPR2 = CONTAINS THE BINARY ERROR MESSAGE NUMBER 00044000
* - EITHER AN OPTION IS ILLEGAL, OR SOME CONDITION 00045000
* EXISTS THAT MAKES IT IMPOSSIBLE TO EXECUTE THE COMMAND 00046000
* A MESSAGE IS PRINTED TO DESCRIBE THE ERROR; THE ERROR 00047000
* MESSAGES THAT MAY OCCUR ARE LISTED WITH EACH COMMAND 00048000
* 00049000
* CALLS TO OTHER ROUTINES - 00050000
* 00051000
* DMKSCNRU - TO LOCATE THE RDEVBLOK FOR A SPOOLING DEVICE 00052000
* DMKSTKIO - TO STACK IOBLOKS USED TO START OUTPUT DEVICES 00053000
* DMKSCNFD - TO SCAN THE COMMAND LINE BUFFER FOR OPTIONS 00054000
* DMKSPLDL - TO DELETE FILES ON DELETE CHAIN (DMKRSPDL) 00055000
* DMKDSPCH - EXIT VIA GOTO TO WAIT FOR INTERRUPT FROM I/O 00056000
* DMKFREE - TO OBTAIN FREE STORAGE FOR MESSAGE BUFFERS AND 00057000
* IOBLOKS 00058000
* DMKFRET - TO RETURN USED BLOKS TO FREE STORAGE 00059000
* DMKQCNWT - TO WRITE ERROR AND VERIFICATION MESSAGES 00060000
* DMKCVTBH - TO CONVERT BINARY UNIT ADDRESSES INTO PRINTABLE HEX 00061000
* CHARACTERS FOR ERROR MESSAGES 00062000
* DMKCVTHB - TO CONVERT HEX OPTIONS TO BINARY ADDRESSES 00063000
* DMKCVTDB - TO CONVERT DECIMAL TO BINARY 00064000
* DMKERMSG - TO WRITE ERROR MESSAGES 00065000
* DMKCKSPL - CHECKPOINT THE REAL DEVICE STATUS 00066000
* DMKPTRAN - BRING IN THE 3800 IMAGELIB TABLE 00067000
* 00068000
* EXTERNAL REFERENCES - 00069000
* 00070000
* DMKRSPEX - USED AS IOBIRA FOR IOBLOKS USED TO START UNIT 00071000
* RECORD OUTPUT UNITS 00072000
* DMKQNTBL - ANCHOR FOR 3800 NAMED SYSTEMS USED AS 00073000
* IMAGE LIBRARIES 00074000
* 00075000
* TABLES / WORKAREAS - 00076000
* 00077000
* 00078000
* REGISTER USAGE - 00079000
* 00080000
* ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00081000
* ANY INDIVIDUAL DIFFERENCES OR EXTENSIONS ARE LISTED WITH THE 00082000
* COMMAND DESCRIPTION 00083000
* 00084000
* GPR0 = OPTION LENGTH - RETURNED FROM DMKSCNFD 00085000
* GPR1 = OPTION ADDRESS - RETURNED FROM DMKSCNFD 00086000
* GPR2 = SCRATCH 00087000
* GPR3 = LENGTH FIELD FOR EXECUTED MVC'S AND TRT'S 00088000
* GPR4 = INTERNAL SUBROUTINE LINKAGE 00089000
* GPR5 = INDICATOR FOR MULTIPURPOSE ROUTINES (START/DRAIN) 00090000
* GPR6 = SCRATCH 00091000
* GPR7 = SCRATCH 00092000
* GPR8 = RDEVBLOK BASE 00093000
* GPR9 = RSPLCTL BASE 00094000
* GPR10 = IOBLOK BASE 00095000
* GPR11 = VMBLOK BASE FOR SYSVMBK 00096000
* GPR12 = DMKCSO BASE 00097000
* GPR13 = SAVEAREA BASE 00098000
* GPR14 = EXTERNAL LINKAGE 00099000
* GPR15 = EXTERNAL LINKAGE 00100000
* 00101000
* NOTES - NONE 00102000
* 00103000
* OPERATION - 00104000
* 00105000
* ALL COMMAND PROCESSORS ARE ENTERED VIA A CALL FROM DMKCFM; THE 00106000
* THE FUNCTION, FORMAT AND OPERATION OF EACH COMMAND ARE DESCRI- 00107000
* BED IN THE FOLLOWING SECTIONS 00108000
*. 00109000
EJECT 00110000
COPY OPTIONS 00111000
COPY LOCAL OPTIONS 00112000
SPACE 3 00113000
DMKCSO CSECT 00114000
SPACE 3 00115000
EXTRN DMKCVTBH,DMKCVTHB,DMKRSPEX 00116000
EXTRN DMKSCNFD,DMKCVTDB,DMKERMSG,DMKSTKIO,DMKSCNRU @V396298 00117000
EXTRN DMKSPLDL 00118000
EXTRN DMKCKSPL @V304298 00119000
EXTRN DMKQCNWT @V4075A0 00120000
EXTRN DMKQNTBL @V60B9BA 00121000
SPACE 3 00122000
USING PSA,R0 00123000
USING VMBLOK,R11 00124000
USING SAVEAREA,R13 00125000
EJECT 00126000
*. 00127000
* SUBROUTINE NAME - 00128000
* 00129000
* DMKCSOFL 00130000
* 00131000
* FUNCTION - 00132000
* 00133000
* TO IMMEDIATELY TERMINATE THE OUTPUT ON THE SPECIFIED REAL 00134000
* SPOOL PRINTER OR PUNCH. IF THE DEVICE HAS BEEN DRAINED, OUTPUT 00135000
* OUTPUT WILL STOP; OTHERWISE, THE NEXT FILE OR THE NEXT COPY OF 00136000
* THE CURRENT FILE WILL BE STARTED. IF HOLD IS SPECIFIED 00137000
* THE FILE WILL BE HELD: OTHERWISE DELETE THE FILE. 00138000
* 00139000
* COMMAND LINE FORMAT - 00140000
* 00141000
* +-------+------------------------+ 00142000
* | FLUSH | RADDR <ALL> <HOLD> | 00143000
* | F | ALL HO | 00144000
* +-------+------------------------+ 00145000
* 00146000
* OPERATION - 00147000
* 00148000
* 1. BAL TO GETDEVIC TO LOCATE THE RDEVBLOK FOR THE OUTPUT DEV 00149000
* 2. IF DEVICE NOT PRT OR PCH: EXIT GIVING MSG021E. 00150000
* IF DEVICE DEDICATED: EXIT GIVING MSG140E. 00151000
* IF DEVICE IF OFFLINE: EXIT GIVING MSG046E. 00152000
* IF DEVICE NO ACTIVE: EXIT GIVING MSG141E. 00153000
* 3. SET THE RDEVTERM BIT IN RDEVFLAG 00154000
* 4. CALL DMKSCNFD TO LOCATE NEXT OPTION: 00155000
* IF 'ALL', LOCATE SFBLOK AND SET SFBCOPY TO 1 00156000
* AND GO TO STEP4. 00157000
* IF 'HOLD': SET SFBSHOLD FLAG AND GO TO STEP4. 00158000
* IF NONE: EXIT. 00159000
* 00160000
* RESPONSE - 00161000
* 00162000
* PRT RAD FLUSHED USERID FILE RECDS COPY STAT 00163000
* PUN 00164000
* 00165000
* PRT RAD FILE HELD USERID FILE RECDS COPY STAT 00166000
* PUN 00167000
* 00168000
* ERROR MESSAGES - 00169000
* 00170000
* DMKCSO003E INVALID OPTION - (OPTION) 00171000
* DMKCSO006E INVALID DEVICE TYPE - (ADDR) 00172000
* DMKCSO013E CONFLICTING OPTION - (OPTION) 00173000
* DMKCSO021E RADDR MISSING OR INVALID 00174000
* DMKCSO040E DEV (ADDR) DOES NOT EXIST 00175000
* DMKCSO046E (TYPE) (RADDR) OFFLINE 00176000
* DMKCSO140E (TYPE) (RADDR) ATTACHED TO (USERID) 00177000
* DMKCSO141E (TYPE) (RADDR) NOT ACTIVE 00178000
*. 00179000
EJECT 00180000
ID DC CL8'DMKCSO' MODULE NAME 00181000
SPACE 2 00182000
DMKCSOFL RELOC 00183000
BAL R4,CLEAR CLEAR SAVEWRK1,2-9 00184000
BAL R4,GETDEVIC GO LOCATE DEVICE BLOK 00185000
USING RDEVBLOK,R8 R8 POINTS TO RDEVBLOK 00186000
SPACE 2 00187000
FLSCAN EQU * 00188000
CALL DMKSCNFD IS NEXT OPTION ALL ?? 00189000
BNZ FLCONT NO - NONE PRESENT 00190000
LR R14,R0 COUNT 00191000
BCTR R14,0 -1 00192000
C R0,F2 COUNT OF 2 00193000
BL MSG003E INVALID OPTION 00194000
BE TESTHLD MIN FOR HOLD 00195000
EX R14,CLCALL ALL ?? 00196000
BNE TESTREQ NO - 00197000
TM SAVEWRK1,X'40' COPY OPTION PRESENT ?? 00198000
BO MSG013E CONFLICTING OPTION 00199000
OI SAVEWRK1,X'40' SET COPIES TO ONE 00200000
B FLSCAN CHECK FOR MORE OPTIONS 00201000
SPACE 00202000
TESTREQ DS 0H @V200930 00203000
SPACE 00204000
TESTHLD EX R14,CLCHOLD HOLD ?? 00205000
BNE MSG003E INVALID OPTION 00206000
TM SAVEWRK1,X'80' HOLD FLAG SET ?? 00207000
BO MSG013E YES -- CONFLICTING OPTION 00208000
OI SAVEWRK1,X'80' YES - FILE TO BE HELD 00209000
B FLSCAN 00210000
SPACE 00211000
USING SFBLOK,R7 00212000
USING RSPLCTL,R9 00213000
FLCONT ICM R9,B'1111',RDEVSPL IS THERE A ACTIVE FILE ?? @VA00716 00214000
BZ MSG141E NO ACTIVE FILE 00215000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00216000
TM RDEVFLAG,RDEVACNT PUNCHING ACCOUNTING CARDS ?? 00217000
BO MSG141E YES -- GIVE INACTIVE MSG 00218000
OI RDEVFLAG,RDEVTERM SET TERMINATE FLAG 00219000
SPACE 00220000
LR R7,R9 SET SFBLOK ADDRESS IF 00221000
CLI 0(R9),X'FF' THIS IS THE SFBLOK ADDRESS 00222000
BE *+8 YES -- PLACE HERE BY WARM START 00223000
L R7,RSPSFBLK SPOOL FILE BLOCK PRESENT ?? 00224000
LTR R7,R7 ?? 00225000
BZ CSOEXIT NO - LEAVE 00226000
FLHOLD TM SAVEWRK1,X'80' HOLD OPTION SET ?? 00227000
BZ *+8 NO - 00228000
OI SFBFLAG,SFBSHOLD SET SFBLOK SYSTEM HOLD 00229000
FLCOPY TM SAVEWRK1,X'40' SET COPIES TO ONE ?? 00230000
BZ *+10 NO - LEAVE COPIES AS IS @VA00716 00231000
MVC SFBCOPY(2),F1+2 SET COPY TO ONE @VA00716 00232000
OI SFBFLAG,SFBRECER INDICATE RECORD ALLOCATION IN ERROR 00233000
B CSOEXIT AND EXIT 00234000
SPACE 00235000
EJECT 00236000
*. 00237000
* SUBROUTINE NAME - 00238000
* 00239000
* DMKCSOSP 00240000
* 00241000
* FUNCTION - 00242000
* 00243000
* TO FORCE THE SPECIFIED REAL SPOOL PRINTER TO SINGLE-SPACED 00244000
* OUTPUT FOR THE REMAINDER OF THE CURRENT SPOOL FILE. A START 00245000
* COMMAND TO RADDR WILL RESET THE SPACE FLAG. 00246000
* 00247000
* COMMAND LINE FORMAT - 00248000
* 00249000
* +-------+-------+ 00250000
* | SPACE | RADDR | 00251000
* | SPA | | 00252000
* +-------+-------+ 00253000
* 00254000
* OPERATION - 00255000
* 00256000
* 1. BAL TO GETDEVIC TO LOCATE RDEVBLOK FOR PRINTER 00257000
* 2. IF DEVICE NOT PRINTER, EXIT GIVING MSG021E. 00258000
* IF DEVICE DEDICATED: EXIT GIVING MSG140E. 00259000
* IF DEVICE OFFLINE: EXIT GIVING MSG046E. 00260000
* IF DEVICE NOT ACTIVE: EXIT GIVING MSG141E. 00261000
* 3. SET THE RDEVSPAC BIT IN RDEVFLAG 00262000
* 4. EXIT 00263000
* 00264000
* RESPONSE - 00265000
* 00266000
* NONE 00267000
* 00268000
* 00269000
* ERROR MESSAGES - 00270000
* 00271000
* DMKCSO006E INVALID DEVICE TYPE - (ADDR) 00272000
* DMKCSO021E RADDR MISSING OR INVALID 00273000
* DMKCSO040E DEV (ADDR) DOES NOT EXIST 00274000
* DMKCSO046E (TYPE) (RADDR) OFFLINE 00275000
* DMKCSO140E (TYPE) (RADDR) ATTACHED TO (USERID) 00276000
* DMKCSO141E (TYPE) (RADDR) NOT ACTIVE 00277000
*. 00278000
EJECT 00279000
DMKCSOSP RELOC 00280000
BAL R4,CLEAR CLEAR SAVEWRK1,2-9 00281000
BAL R4,GETDEVIC GO LOCATE RDEVBLOK 00282000
USING RDEVBLOK,R8 R8 POINTS TO RDEVBLOK 00283000
TM RDEVTYPE,TYPPRT IS IT A PRINTER ?? 00284000
BZ MSG006E NO -- INVALID ADDRESS 00285000
SPACE 00286000
ICM R2,B'1111',RDEVSPL GET ACTIVE FILE POINTER @VA00716 00287000
BZ MSG141E NO ACTIVE FILE - BRANCH @VA00716 00288000
SPACE 00289000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00290000
OI RDEVFLAG,RDEVSPAC SET SPACE REQUEST 00291000
B CSOEXIT AND LEAVE 00292000
EJECT 00293000
*. 00294000
* SUBROUTINE NAME - 00295000
* 00296000
* DMKCSODR 00297000
* 00298000
* FUNCTION - 00299000
* 00300000
* TO HALT THE OPERATION OF THE SPECIFIED DEVICE(S) AFTER THEY 00301000
* HAVE COMPLETED PROCESSING THE CURRENTLY ACTIVE FILE 00302000
* 00303000
* COMMAND LINE FORMAT - 00304000
* 00305000
* +-------+----------+ 00306000
* | DRAIN | READER | 00307000
* | DR | PRINTER | 00308000
* | | PUNCH | 00309000
* | | ALL | 00310000
* | | --- | 00311000
* | | RADDR ...| 00312000
* +-------+----------+ 00313000
* 00314000
* READER PRINTER PUNCH ALL 00315000
* R RDR P PRT PU PCH ALL 00316000
* 00317000
* 00318000
* OPERATION - 00319000
* 00320000
* 1. SET RDEVDRAN FLAG IN GPR5 00321000
* 2. SET 'DRAINED' IN MESSAGE AREA OF SAVEAREA 00322000
* 3. JOIN COMMON START/DRAIN CODE AT STEP 3 FOR DMKCSOST 00323000
* 00324000
* RESPONSE - 00325000
* 00326000
* PRT XXX DRAINED SYSTEM CLASS = ABCD NOSEP 00327000
* PUN SEP 00328000
* RDR XXX DRAINED SYSTEM 00329000
* 00330000
* MESSAGE ISSUED BY THIS MODULE IF DEVICE IS 00331000
* NOT ACTIVE. IF DEVICE IS ACTIVE, MODULE 00332000
* DMKRSP WILL ISSUE THE MESSAGE WHEN CURRENT 00333000
* FILE IS FINISHED. 00334000
* 00335000
* ERROR MESSAGES - 00336000
* 00337000
* DMKCSO003E INVALID OPTION _ (OPTION) 00338000
* DMKCSO006E INVALID DEVICE TYPE - (ADDR) 00339000
* DMKCSO021E RADDR MISSING OR INVALID 00340000
* DMKCSO040E DEV (ADDR) DOES NOT EXIST 00341000
* DMKCSO046E (TYPE) (RADDR) OFFLINE 00342000
* DMKCSO140E (TYPE) (RADDR) ATTACHED TO (USERID) 00343000
*. 00344000
EJECT 00345000
DMKCSODR RELOC 00346000
BAL R4,CLEAR CLEAR SAVEWRK1,2-9 00347000
LA R5,RDEVDRAN SET DRAIN OPTION 00348000
LA R0,HLDSIZE GET STORAGE FOR THE WRKAREA @V60B9BA 00349000
CALL DMKFREE GO GET IT @V60B9BA 00350000
ST R1,SAVEWRK3 SAVE THE POINTER TO IT @V60B9BA 00351000
XC 0(HLDSIZE*8,R1),0(R1) CLEAR THE AREA @V60B9BA 00352000
B STARTX AND JOIN COMMON DRAIN/START CODE 00353000
EJECT 00354000
*. 00355000
* SUBROUTINE NAME - 00356000
* 00357000
* DMKCSOST 00358000
* 00359000
* FUNCTION - 00360000
* 00361000
* TO RESTART A SPOOLING DEVICE AFTER IT HAS BEEN DRAINED, 00362000
* AND/OR TO CHANGE THE OUTPUT CLASSES THAT IT MAY SERVICE. IF 00363000
* THE NOSEP OPTION IS SPECIFIED, NO OUTPUT SEPARATOR WILL BE 00364000
* PRINTED OR PUNCHED BETWEEN JOBS. 00365000
* 00366000
* COMMAND LINE FORMAT - 00367000
* 00368000
* +-------+-------------------------------+ 00369000
* | START | READER | 00370000
* | STA | PRINTER | 00371000
* | | PUNCH | 00372000
* | | ALL | 00373000
* | | --- | 00374000
* | | RADDR <CLASS ABCD> <NOSEP>... | 00375000
* | | ... <FLASH FFFF> ... | 00376000
* | | ... <CHARS CCCC> <PURGE>... | 00377000
* | | ...<FCB 6|8|12> ... | 00378000
* | | ...<IMAGE IIIIIIII> | 00379000
* +-------+-------------------------------+ 00380000
* 00381000
* READER PRINTER PUNCH ALL CLASS NOSEP 00382000
* R RDR P PRT PU PCH ALL CL NOS 00383000
* 00384000
* FLASH CHARS PURGE FCB IMAGE 00385000
* FL CH PU FCB IM 00386000
* 00387000
* CLASS (ABCD) ABCD 1 TO 4 CLASSES (A-Z OR 0-9) 00388000
* 00389000
* FLASH (FFFF) 1 TO 4 CHARACTERS (FLASH OVERLAY NAME) 00390000
* 00391000
* CHARS (CCCC) 1 TO 4 CHARACTERS (CHAR ARR TBL FOR SEP) 00392000
* 00393000
* FCB 6, 8, OR 12 LINES/INCH (SEP PAGE) 00394000
* 00395000
* IMAGE 1 TO 8 CHARACTERS (IMAGE LIBRARY NAME) 00396000
* 00397000
* PURGE PURGE FILES HAVING INVALID MODULE NAMES 00398000
* FOR A 3800 00399000
* 00400000
* 00401000
* OPERATION - 00402000
* 00403000
* 1. ENTRY DMKCSOSD- SAVE DEVICE TYPE IN SAVEWRK1+1 AND 00404000
* INDICATE THAT ERROR, DRAIN OR START MESSAGES ARE NOT 00405000
* TO BE PRINTED. CLEAR DRAIN FLAG FROM GPR5. 00406000
* 2. IF TYPE = X'FF' OR X'FE', GO TO STEP 11A. 00407000
* IF TYPE = PUNCH AND PRINTER: GO TO STEP 13. 00408000
* IF TYPE = PUNCH: GO TO STEP 15. 00409000
* OTHERWISE GO TO STEP 14. 00410000
* 3. ENTRY DMKCSOST- CLEAR DRAIN FLAG FROM GPR5. 00411000
* 4. STARTX- CALL DMKFREE TO OBTAIN WORK AREA. 00412000
* CALL DMKSCNFD TO LOCATE DEVICE OPTION 00413000
* IF 'ALL' OR NONE: GO TO STEP 12. 00414000
* IF 'RDR': GO TO STEP 16. 00415000
* IF 'PCH': GO TO STEP 15. 00416000
* IF 'PRT': GO TO STEP 14. 00417000
* 5. BAL TO GETDVIC2 TO LOCATE RDEVBLOK. SAVE THE REAL 00418000
* DEVICE ADDRESS IN SAVEWRK4. 00419000
* IF NONE: EXIT. 00420000
* 6. CALL DMKSCNFD TO LOCATE NEXT OPTION - 00421000
* IF 'CLASS' CALL DMKSCNFD TO LOCATE CLASS, 00422000
* IF NONE OR CLASS INVALID: EXIT 00423000
* GIVING MSG028E. OTHERWISE SAVE CLASS 00424000
* IN SAVEWRK2 AND GO TO STEP 6. 00425000
* IF 'NOSEP': INDICATE BY FLAG IN SAVEWRK1 AND GO TO STEP 6. 00426000
* IF 'FLASH': FIND FLASH NAME AND IF INVALID EXIT W/ERROR. 00427000
* ELSE SAVE NAME IN HLDFLASH AND GO TO STEP 6. 00428000
* IF 'CHARS': FIND CHARS NAME AND IF INVALID EXIT W/ERROR. 00429000
* ELSE SAVE NAME IN HLDCHARS AND GO TO STEP 6. 00430000
* IF 'FCB': FIND IF 6, 8, OR 12. IF NOT EXIT W/ERROR. 00431000
* ELSE SAVE VALUE IN HLDFCB AND GO TO STEP 6. 00432000
* IF 'IMAGE': FIND IMAGE NAME AND IF INVALID EXIT W/ERROR. 00433000
* ELSE SAVE VALUE IN HLDIMAGE AND GOTO STEP 6. 00434000
* IF 'PURGE': SET THE HLDPURGE FLAG AND GOTO STEP 5. 00435000
* OTHERWISE RESET SCAN POINTERS TO PREVIOUS OPTION. 00436000
* 7. IF DEVICE IS INVALID TYPE: EXIT GIVING MSG021E. 00437000
* IF DEVICE IS DEDICATED: EXIT GIVING MSG140E. 00438000
* IF DEVICE IS OFFLINE: EXIT GIVING MSG046E. 00439000
* 8. IF NEW CLASS IS PRESENT: MOVE CLASSES TO RDEVCLAS. 00440000
* SET RDEVSEP - TURN ON SEPARATOR FLAG. 00441000
* IF NOSEP: RESET RDEVSEP- TURN OFF SEPARATOR FLAG. 00442000
* IF FLASH, CHARS, FCB, IMAGE, OR PURGE ARE PRESENT, 00443000
* STORE THEIR VALUES IN THE IN THE PROPER LOCATIONS 00444000
* IN THE RDEVBLOK. 00445000
* 9. IF START COMMAND GIVE STARTED MESSAGES FOR ALL DEVICES. 00446000
* IF DRAIN COMMAND AND DEVICE NOT BUSY GIVE DRAINED MSG. 00447000
* 10. IF DEVICE IS NOT BUSY: BUILD IOBLOK WITH A 00448000
* DUMMY DEVICE END INTERRUPT AND STACK IT VIA A CALL 00449000
* TO DMKSTKIO. 00450000
* 11. IF TYPE = RADDR: GO TO STEP 5. OTHERWISE GO TO STEP4. 00451000
* 11A. DODEL - CALL DMKSPLDL TO DELETE FILES ON DELETE CHAIN 00452000
* 12. DOALL- SET GPR6 TO READER DEVICE CHAIN. 00453000
* BAL TO SCANDEV. 00454000
* 13. STPUPR- SET GPR6 TO PUNCH DEVICE CHAIN. 00455000
* BAL TO SCANDEV. 00456000
* 14. STPRT- SET GPR6 TO PRINTER DEVICE CHAIN. 00457000
* BAL TO SCANDEV AND ON RETURN EXIT. 00458000
* 15. STPCH- SET GPR6 TO PUNCH DEVICE CHAIN. 00459000
* BAL TO SCANDEV AND ON RETURN EXIT. 00460000
* 16. STRDR- SET GPR6 TO READER DEVICE CHAIN 00461000
* BAL TO SCANDEV AND ON RETURN EXIT. 00462000
* 17. SCANDEV- LOCATE EACH RDEVBLOK ON THE 00463000
* DEVICE CHAIN GIVEN IN GPR6 AND 00464000
* GO TO STEP 10. 00465000
* 18. DONEXT- IF TYPE IS REAL ADDRESS: GO TO STEP 4. 00466000
* IF NOT LAST DEVICE ON DEVICE CHAIN: GO TO 00467000
* STEP 17. OTHERWISE RETURN TO CALLER. 00468000
* 00469000
* RESPONSE - 00470000
* 00471000
* PRT XXX STARTED SYSTEM CLASS = ABCD NOSEP 00472000
* PUN SEP 00473000
* RDR XXX STARTED SYSTEM 00474000
* 00475000
* ERROR MESSAGES - 00476000
* 00477000
* DMKCSO003E INVALID OPTION - (OPTION) 00478000
* DMKCSO006E INVALID DEVICE TYPE - (ADDR) 00479000
* DMKCSO013E CONFLICTING OPTION - (OPTION) 00480000
* DMKCSO021E RADDR MISSING OR INVALID 00481000
* DMKCSO028E CLASS MISSING OR INVALID 00482000
* DMKCSO040E DEV (ADDR) DOES NOT EXIST 00483000
* DMKCSO046E (TYPE) (RADDR) OFFLINE 00484000
* DMKCSO140E (TYPE) (RADDR) ATTACHED TO (USERID) 00485000
*. 00486000
EJECT 00487000
DMKCSOSD RELOC 00488000
USING BUFFER,R9 00489000
USING RDEVBLOK,R8 00490000
BAL R4,CLEAR CLEAR SAVE WORK AREA 00491000
STC R5,SAVEWRK1+1 SAVE DEVICE TYPE 00492000
SR R5,R5 INDICATE START 00493000
OI SAVEWRK1,X'01' INDICATE NO MESSAGES TO BE PRINTED 00494000
LA R0,HLDSIZE GET STORAGE FOR THE WRKAREA @V60B9BA 00495000
CALL DMKFREE GO GET IT @V60B9BA 00496000
ST R1,SAVEWRK3 SAVE THE POINTER TO IT @V60B9BA 00497000
XC 0(HLDSIZE*8,R1),0(R1) CLEAR THE AREA @V60B9BA 00498000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00499000
CLI SAVEWRK1+1,X'FE' SET BY DMKCPI TO START ALL 00500000
* X'FF' START ALL DEVICES 00501000
* X'FE' START ALL DEVICES EXCEPT DRAINED DEVICES 00502000
BNL DODEL YES -- 00503000
TM SAVEWRK1+1,TYPPUN+TYPPRT PUNCH AND PRINTER 00504000
BO STPUPR YES - START BOTH 00505000
TM SAVEWRK1+1,TYPPUN PUNCH ?? 00506000
BO STPCH 00507000
B STPRT 00508000
SPACE 00509000
SPACE 00510000
DMKCSOST RELOC 00511000
BAL R4,CLEAR CLEAR SAVEWRK1,2-9 00512000
SR R5,R5 CLEAR DRAIN CODE REGISTER 00513000
LA R0,HLDSIZE GET STORAGE FOR THE WRKAREA @V60B9BA 00514000
CALL DMKFREE GO GET IT @V60B9BA 00515000
ST R1,SAVEWRK3 SAVE THE POINTER TO IT @V60B9BA 00516000
STARTX EQU * DRAIN JOINS HERE -- 00517000
L R1,SAVEWRK3 RESTORE WORKAREA POINTER @V60B9BA 00518000
XC 0(HLDSIZE*8,R1),0(R1) CLEAR THE AREA @V60B9BA 00519000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00520000
CALL DMKSCNFD PICK UP FIRST OPTION 00521000
BNZ DOALL DEFAULT ALL 00522000
LR R14,R0 COUNT 00523000
BCTR R14,0 -1 00524000
C R0,F3 LENGTH OF 3 ?? 00525000
BNE CNT1 NO - 00526000
SPACE 00527000
CLC =C'RDR',0(R1) RDR ?? 00528000
BE STRDR YES - 00529000
CLC =C'PRT',0(R1) PRT ?? 00530000
BE STPRT YES - 00531000
CLC =C'PCH',0(R1) PCH ?? 00532000
BE STPCH YES - 00533000
CLC =C'ALL',0(R1) ALL ?? 00534000
BE DOALL YES - 00535000
SPACE 00536000
CNT1 EX R14,CLCREAD READER ?? 00537000
BE STRDR YES - 00538000
EX R14,CLCPRINT PRINTER ?? 00539000
BE STPRT YES - 00540000
C R0,F2 COUNT OF 2 00541000
BL RADDR NO - COULD BE RADDR 00542000
EX R14,CLCPUN PUNCH ?? 00543000
BE STPCH YES - 00544000
SPACE 00545000
RADDR MVI SAVEWRK1+2,X'02' CLEAR WORK BYTE 00546000
SPACE 00547000
BAL R4,GETDVIC2 LOCATE RDEVBLOK 00548000
ST R1,SAVEWRK4 SAVE REAL DEVICE ADDRESS 00549000
STSCAN MVC SAVEWRK8(8),BUFNXT SAVE COMMAND LINE INFO 00550000
SPACE 00551000
CALL DMKSCNFD LOCATE NEXT OPTION 00552000
BNZ PROCESS NONE PROCESS 00553000
LR R14,R0 COUNT 00554000
BCTR R14,0 -1 00555000
TM RDEVTYPC,CLASURI READER TYPE DEVICE ?? 00556000
BO CKRADD YES - FURTHER OPTS INVALID @V60B9BA 00557000
L R3,SAVEWRK3 WE NEED THE WORK AREA @V60B9BA 00558000
USING HLDAREA,R3 ADDRESSIBILITY @V60B9BA 00559000
C R0,F2 MIN COUNT FOR CLASS 00560000
BL CKRADD NO -- CHECK FOR VALID RADDR 00561000
BE TSTFLASH YES - TEST FLASH @V60B9BA 00562000
SPACE 00563000
TSTFCB CLI RDEVTYPE,TYP3800 IS THIS A 3800 ? @V60B9BA 00564000
BNE TSTNOSEP FCB ONLY VALID FOR 3800 @V60B9BA 00565000
EX R14,CLCFCB FCB OPTION ? @V60B9BA 00566000
BNE TSTNOSEP XFER IF NOT @V60B9BA 00567000
CLI HLDFCB,X'00' FCB ALREADY SET ? @V60B9BA 00568000
BNE MSG013E YES - CONFLICTING OPTIONS @V60B9BA 00569000
CALL DMKSCNFD GET THE FCB VALUE @V60B9BA 00570000
BNZ MSG246E ERROR - MISSING @V60B9BA 00571000
CALL DMKCVTDB DECIMAL TO BINARY @V60B9BA 00572000
BNZ MSG246E XFER IF INVALID @V60B9BA 00573000
STC R1,HLDFCB SAVE IT FOR NOW @V60B9BA 00574000
C R1,F6 IS IT A 6 ? @V60B9BA 00575000
BE STSCAN YES - GET NEXT OPTION @V60B9BA 00576000
C R1,F8 IS IT AN 8 ? @V60B9BA 00577000
BE STSCAN YES - GET NEXT OPTION @V60B9BA 00578000
C R1,=F'12' IS IT A 12 ? @V60B9BA 00579000
BE STSCAN YES - GET NEXT OPTION @V60B9BA 00580000
B MSG246E INVALID FCB VALUE @V60B9BA 00581000
SPACE 00582000
TSTNOSEP EX R14,CLCNOS NOSEP ?? @V60B9BA 00583000
BNE TSTFLASH NO - @V60B9BA 00584000
TM SAVEWRK1+2,X'80' NOSEP FLAG SET ?? 00585000
BO MSG013E YES - CONFLICTING OPTION 00586000
OI SAVEWRK1+2,X'80' INDICATE NOSEP 00587000
B STSCAN GET NEXT OPTION 00588000
SPACE 00589000
TSTFLASH CLI RDEVTYPE,TYP3800 IS THIS A 3800 ? @V60B9BA 00590000
BNE TSTCLASS SKIP ESOTERIC STUFF IF NOT @V60B9BA 00591000
EX R14,CLCFLASH TEST FOR FLASH @V60B9BA 00592000
BNE TSTCHARS XFER IF NOT FLASH @V60B9BA 00593000
CLI HLDFLASH,X'00' FLASH SET ? @V60B9BA 00594000
BNE MSG013E YES - CONFLICTING OPTION @V60B9BA 00595000
MVC HLDFLASH,BLANKS INITIALIZE @V60B9BA 00596000
CALL DMKSCNFD GET THE FLASH NAME @V60B9BA 00597000
BNZ MSG243E MISSING FLASH NAME @V60B9BA 00598000
C R0,F4 MOVE THAN 4 CHARS ? @V60B9BA 00599000
BH MSG243E ERROR IF SO @V60B9BA 00600000
LR R2,R0 THE EXECUTE TARGET @V60B9BA 00601000
BCTR R2,0 DECREMENT FOR MVC @V60B9BA 00602000
EX R2,MVCFLASH MOVE IT INTO WORK AREA @V60B9BA 00603000
B STSCAN GET NEXT OPTION @V60B9BA 00604000
SPACE 00605000
TSTCHARS EX R14,CLCCHARS TEST FOR CHARS @V60B9BA 00606000
BNE TSTIMAGE XFER IF NOT CHARS @V60B9BA 00607000
CLI HLDCHARS,X'00' CHARS SET ? @V60B9BA 00608000
BNE MSG013E YES - CONFLICTING OPTION @V60B9BA 00609000
MVC HLDCHARS,BLANKS INITIALIZE @V60B9BA 00610000
CALL DMKSCNFD GET THE CHARS NAME @V60B9BA 00611000
BNZ MSG245E MISSING CHARS NAME @V60B9BA 00612000
C R0,F4 MOVE THAN 4 CHARS ? @V60B9BA 00613000
BH MSG245E ERROR IF SO @V60B9BA 00614000
LR R2,R0 THE EXECUTE TARGET @V60B9BA 00615000
BCTR R2,0 DECREMENT FOR MVC @V60B9BA 00616000
EX R2,MVCCHARS MOVE IT INTO WORK AREA @V60B9BA 00617000
B STSCAN GET NEXT OPTION @V60B9BA 00618000
SPACE 00619000
TSTIMAGE EX R14,CLCIMAGE TEST FOR IMAGE @V60B9BA 00620000
BNE TSTPURGE XFER IF NOT IMAGE @V60B9BA 00621000
CLI HLDIMAGE,X'00' IMAGE SET ? @V60B9BA 00622000
BNE MSG013E YES - CONFLICTING OPTION @V60B9BA 00623000
MVC HLDIMAGE,BLANKS INITIALIZE @V60B9BA 00624000
CALL DMKSCNFD GET THE IMAGE NAME @V60B9BA 00625000
BNZ MSG244E MISSING IMAGE NAME @V60B9BA 00626000
C R0,F8 MOVE THAN 8 CHARS ? @V60B9BA 00627000
BH MSG244E ERROR IF SO @V60B9BA 00628000
LR R2,R0 THE EXECUTE TARGET @V60B9BA 00629000
BCTR R2,0 DECREMENT FOR MVC @V60B9BA 00630000
EX R2,MVCIMAGE MOVE IT INTO WORK AREA @V60B9BA 00631000
B STSCAN GET NEXT OPTION @V60B9BA 00632000
SPACE 00633000
TSTPURGE EX R14,CLCPURGE PURGE OPTION ? @V60B9BA 00634000
BNE TSTCLASS XFER IF NOT @V60B9BA 00635000
TM HLDFLAG1,HLDPURGE SET ALREADY ? @V60B9BA 00636000
BO MSG013E YES - CONFLICTING OPTION @V60B9BA 00637000
OI HLDFLAG1,HLDPURGE SET THE FLAG @V60B9BA 00638000
B STSCAN GET NEXT OPTION @V60B9BA 00639000
DROP R3 NO LONGER NEEDED @V60B9BA 00640000
SPACE 00641000
TSTCLASS EQU * 00642000
EX R14,CLCCLASS CLASS ?? 00643000
BE CLASSOK YES -- 00644000
CKRADD CALL DMKCVTHB IS IT A VALID REAL ADDRESS 00645000
LM R0,R1,BALRSAVE RESTORE LENGTH AND ADDRESS 00646000
BNZ MSG003E NO -- INVALID OPTION 00647000
B RSTSCAN YES -- 00648000
CLASSOK TM SAVEWRK1+2,X'40' CLASS PRESENT ?? 00649000
BO MSG013E YES -- CONFLICTING OPTION 00650000
OI SAVEWRK1+2,X'40' INDICATE CLASSES 00651000
SPACE 00652000
CALL DMKSCNFD GET CLASSES 00653000
BNZ MSG028E CLASSES MISSING 00654000
C R0,F4 MAX OF 4 CLASSES 00655000
BH MSG028E TO MANY CLASSES 00656000
LR R3,R0 COUNT 00657000
MVC SAVEWRK2(4),BLANKS BLANK AREA TO SAVE CLASSES 00658000
LA R4,SAVEWRK2 ADDRESS OF AREA 00659000
SPACE 00660000
CLASSTRT IC R2,0(R1) GET CLASS IN R2 @V200930 00661000
CLI 0(R1),C'*' IS IT CLASS ALL ?? @V200930 00662000
BE SETCLAS YES, SET IT @V200930 00663000
CLI 0(R1),C'A' VALIDATE CLASS @V200930 00664000
BL MSG028E INVALID CLASS 00665000
TRT 0(1,R1),ALPHANUM TEST CLASS 00666000
BH *+8 VALID - 00667000
B MSG028E ALL OTHERS INVALID 00668000
SETCLAS DS 0H @V200930 00669000
STC R2,0(R4) STORE CLASS IN SAVEWRK2 AREA 00670000
LA R1,1(R1) UPDATE 00671000
LA R4,1(R4) ADDRESS 00672000
BCT R3,CLASSTRT AND COUNT DOWN 00673000
B STSCAN GET NEXT OPTION 00674000
SPACE 00675000
RSTSCAN MVC BUFNXT(8),SAVEWRK8 RESTORE BUFFER POINTERS 00676000
PROCESS EQU * HERE TO PROCESS THE CURRENT DEVICE 00677000
SPACE 00678000
BAL R4,TSTSTAT CHECK FOR DEDICATED OR OFFLINE @VA00716 00679000
* CASE OF MORE RADDRESSES 00680000
MVC SAVEWRK1+3(1),RDEVFLAG SAVE ITS ORIG VALUE @V60B9BA 00681000
LTR R5,R5 START COMMAND ? 00682000
BNZ TESTSTAT NO -- DRAIN COMMAND 00683000
CLI SAVEWRK2,C' ' NEW CLASS PRESENT ?? 00684000
BNH *+10 NO -- LEAVE ALONE 00685000
MVC RDEVCLAS(4),SAVEWRK2 MOVE IN NEW CLASSES 00686000
OI RDEVFLAG,RDEVSEP TURN ON SEPERATOR FLAG 00687000
TM SAVEWRK1+2,X'80' NOSEP INDICATOR ON ?? 00688000
BZ *+8 NO -- LEAVE SEP FLAG ON - 00689000
NI RDEVFLAG,X'FF'-RDEVSEP TURN OFF SEP FLAG 00690000
XC SAVEWRK2(4),SAVEWRK2 CLEAR CLASS SAVE AREA 00691000
NI SAVEWRK1+2,X'7F' CLEAR SEP FLAG 00692000
CLI RDEVTYPE,TYP3800 IS IT A 3800 PRINTER ? @V60B9BA 00693000
BNE TESTSTAT XFER IF NOT @V60B9BA 00694000
L R3,SAVEWRK3 POINT TO WORK AREA @V60B9BA 00695000
USING HLDAREA,R3 ADDRESSIBILITY @V60B9BA 00696000
CLI HLDFCB,X'00' FCB RESET ? @V60B9BA 00697000
BE *+10 XFER IF NOT @V60B9BA 00698000
MVC RDEVFSEP,HLDFCB MOVE IN NEW VALUE @V60B9BA 00699000
CLI HLDFLASH,X'00' FLASH NAME RESET ? @V60B9BA 00700000
BE *+10 XFER IF NOT @V60B9BA 00701000
MVC RDEVOVLY,HLDFLASH NEW FLASH NAME @V60B9BA 00702000
CLI HLDCHARS,X'00' CHARS RESET ? @V60B9BA 00703000
BE *+10 XFER IF NOT @V60B9BA 00704000
MVC RDEVXSEP,HLDCHARS NEW CHAR ARR TBL FOR SEP @V60B9BA 00705000
NI RDEVSTA2,X'FF'-RDEVPURG RESET IT FIRST @V60B9BA 00706000
TM HLDFLAG1,HLDPURGE PURGE SET ? @V60B9BA 00707000
BZ TESTSTAT XFER IF NOT @V60B9BA 00708000
OI RDEVSTA2,RDEVPURG SET THE PURGE OPTION @V60B9BA 00709000
B TESTSTAT .. 00710000
SPACE 00711000
TESTDEV EQU * HERE TO TEST DEVICE FOR DEVICE INTERRUPT 00712000
TM SAVEWRK1,X'03' FROM DMKCSU OR DMKCPI AND/OR 00713000
* NO INVALID OPTION ??? 00714000
BNZ TESTSTAT YES -- 00715000
CALL DMKSCNFD ANY MORE OPTIONS ?? 00716000
BZ MSG003E YES -- INVALID OPTION 00717000
OI SAVEWRK1,X'02' SET NO INVALID OPTIONS 00718000
TESTSTAT TM RDEVSTAT,RDEVDED+RDEVDISA DEDICATED OR OFFLINE ?? 00719000
BNZ DONEXT1 YES, DON'T TOUCH OR CHECKPOINT @VA09477 00720000
CLI SAVEWRK1+1,X'FF' START ALL - FROM DMKCPI 00721000
BE STARTALL YES - START ALL DEVICES 00722000
TM SAVEWRK1,X'01' CALLED FROM DMKCSU OR DMKCPI 00723000
BZ STARTALL NO - 00724000
TM RDEVFLAG,RDEVDRAN DEVICE DRAINED ?? 00725000
BO DONEXT1 YES, DON'T TOUCH OR CHECKPOINT @VA09477 00726000
STARTALL DS 0H @VA11294 00727100
NI RDEVFLAG,X'FF'-RDEVLOAD RESET LOAD FLAG @VA11294 00727200
LTR R5,R5 DRAIN COMMAND ? @VA11294 00727300
BZ NOTDRAIN NO - NORMAL PATH @VA11294 00727400
TM RDEVFLAG,RDEVDRAN ALREADY DRAINED ? @VA11294 00727500
BO TESTDEV1 YES - 3800 ACT COUNT CORRECT @VA11294 00727600
NOTDRAIN DS 0H @VA11294 00727700
NI RDEVFLAG,X'FF'-RDEVDRAN RESET DRAIN FLAG @VA11294 00727800
EX R5,SETDRAIN SET START / DRAIN OPTIONS @VA11294 00727900
CLI RDEVTYPE,TYP3800 3800 ? @V60B9BA 00729000
BNE TESTDEV1 XFER IF NOT @V60B9BA 00730000
LTR R5,R5 DRAIN COMMAND? @VA09264 00730100
BZ START2 XFER IF NOT @VA09264 00730200
L R3,RDEVEXTN POINT TO RDEVBLOK EXTENSION @VA09264 00730300
USING RSPXBLOK,R3 ADDRESSIBILITY @VA09264 00730400
XC RSPXBLOK(RSPXSIZE*8),RSPXBLOK CLEAR IT @VA09264 00730500
DROP R3 NO LONGER NEEDED @VA09264 00730600
START2 DS 0H @VA09264 00730700
SPACE 00731000
*. 00732000
* AT THIS POINT, THE IMAGE LIBRARY ACTIVITY COUNTS MUST BE 00733000
* UPDATED FOR BOTH THE DRAIN AND START COMMANDS. 00734000
* 1. FOR THE DRAIN COMMAND, DECREMENT THE ACTIVITY COUNT 00735000
* OF THE SYSTEM NAMED IN RDEVIMAG IF THE 3800 IS NOT 00736000
* ALREADY DRAINED. 00737000
* 2. FOR THE START COMMAND WHEN A NEW IMAGE LIBRARY IS NOT 00738000
* SPECIFIED, INCREMENT THE ACTIVITY COUNT OF THE SYSTEM 00739000
* IN RDEVIMAG ONLY IF THE DEVICE IS CURRENTLY DRAINED. 00740000
* 3. FOR THE START COMMAND WHEN A NEW IMAGE LIBRARY NAME 00741000
* IS SPECIFIED: 00742000
* A. IF THE DEVICE IS ALREADY STARTED,DECREMENT THE 00743000
* COUNT FOR THE SYSTEM SSPECIFIED IN RDEVIMAG AND 00744000
* INCREMENT THE COUNT FOR THE SYSTEM IN HLDIMAGE, 00745000
* UNLESS THEY ARE THE SAME SYSTEM, IN WHICH CASE 00746000
* DO NOTHING. 00747000
* B. IF THE DEVICE IS CURRENTLY DRAINED, JUST INCREMENT 00748000
* THE ACTIVITY COUNT OF THE SYSTEM STORED IN HLDIMAGE. 00749000
* 4. IN ANY CASE WHERE THE NEW IMAGE LIBRARY IS NOT FOUND, 00750000
* EXIT WITH ERROR MESSAGE DMKCSO244E. 00751000
*. 00752000
SPACE 00753000
L R3,SAVEWRK3 POINT TO WORK AREA @V60B9BA 00754000
USING HLDAREA,R3 ADDRESSIBILITY @V60B9BA 00755000
L R1,=A(DMKQNTBL) START OF 3800 IMAGE LIBS @V60B9BA 00756000
LTR R1,R1 ARE THERE ANY ? @V60B9BA 00757000
BZ MSG244E THERE SHOULD BE ONE @V60B9BA 00758000
TRANS 2,1,OPT=(BRING,DEFER,SYSTEM) GET IT IN @V60B9BA 00759000
LR R14,R2 POINT TO EACH SYSTEM ENTRY @V60B9BA 00760000
USING NPRTBL,R14 ADDRESSIBILITY @V60B9BA 00761000
LTR R14,R14 ANY IMAGE LIBS EXIST? @V60B9BA 00762000
BZ CKIMAGE2 XFER IF NOT @V60B9BA 00763000
CKIMAGE0 CLC HLDIMAGE,NPRNAME IS IT THE NEW ONE ? @V60B9BA 00764000
BNE CKIMAG0A XFER IF NOT @V60B9BA 00765000
ST R14,HLDPTRN SAVE THE POINTER @V60B9BA 00766000
CKIMAG0A CLC RDEVIMAG,NPRNAME IS THIS THE OLD ONE ? @V60B9BA 00767000
BNE CKIMAGE1 XFER IF NOT @V60B9BA 00768000
ST R14,HLDPTRO SAVE THE POINTER @V60B9BA 00769000
CKIMAGE1 AL R14,NPRPNT NEXT ONE @V60B9BA 00770000
CLC NPRPNT,ZEROES IS IT THE DUMMY LAST ENTRY? @V60B9BA 00771000
BNE CKIMAGE0 TRY NEXT ONE IF NOT @V60B9BA 00772000
CKIMAGE2 CLI HLDIMAGE,X'00' NEW IMAGE SPECIFIED ? @V60B9BA 00773000
BE CKIMAG2A XFER IF NOT @V60B9BA 00774000
OC HLDPTRN,HLDPTRN DID WE FIND ITS NAME ? @V60B9BA 00775000
BZ MSG244E ERROR IF NOT @V60B9BA 00776000
SPACE 00777000
CKIMAG2A LTR R5,R5 DRAIN COMMAND ? @V60B9BA 00778000
BNZ DECRDV XFER IF SO @V60B9BA 00779000
CLI HLDIMAGE,X'00' NEW IMAGE SPECIFIED ? @V60B9BA 00780000
BNE NEWIMAGE XFER IF SO @V60B9BA 00781000
TM SAVEWRK1+3,RDEVDRAN ORIGINALLY DRAINED? @V60B9BA 00782000
BZ TESTDEV1 XFER IF NOT @V60B9BA 00783000
L R14,HLDPTRO INCREMENT RDEVIMAG @V60B9BA 00784000
LTR R14,R14 DID WE FIND IT ? @V60B9BA 00785000
BZ MSG244E ERROR-WE CAN'T INCR IT @V60B9BA 00786000
B INCRMNT GO DO IT @V60B9BA 00787000
NEWIMAGE L R14,HLDPTRN HLDIMAGE WILL BE INCR'ED @V60B9BA 00788000
MVC RDEVIMAG,HLDIMAGE ALSO MOVE NEW ONE IN @V60B9BA 00789000
TM SAVEWRK1+3,RDEVDRAN ORIGINALLY DRAINED? @V60B9BA 00790000
BO INCRMNT XFER IF SO @V60B9BA 00791000
CLC HLDPTRN,HLDPTRO OLD AND NEW THE SAME ? @V60B9BA 00792000
BE TESTDEV1 FINISHED IF SO @V60B9BA 00793000
INCRMNT SR R15,R15 INITIALIZE @V60B9BA 00794000
IC R15,NPRCNT CURRENT COUNT @V60B9BA 00795000
LA R15,1(R15) INCREMENT @V60B9BA 00796000
STC R15,NPRCNT SAVE IT @V60B9BA 00797000
TM SAVEWRK1+3,RDEVDRAN ORIGINALLY DRAINED? @V60B9BA 00798000
BO TESTDEV1 XFER IF SO @V60B9BA 00799000
DECRDV L R14,HLDPTRO RDEVIMAGE POINTER @V60B9BA 00800000
LTR R14,R14 DID WE FIND IT ? @V60B9BA 00801000
BZ TESTDEV1 DON'T DECR, BUT GO ON @V60B9BA 00802000
SR R15,R15 ZERO IT @V60B9BA 00803000
IC R15,NPRCNT OLD COUNT @V60B9BA 00804000
LTR R15,R15 ALREADY ZERO ?? @V60B9BA 00805000
BZ TESTDEV1 XFER IF SO @V60B9BA 00806000
BCTR R15,0 DECREMENT IT @V60B9BA 00807000
STC R15,NPRCNT NEW COUNT @V60B9BA 00808000
DROP R14,R3 NO LONGER NEEDED @V60B9BA 00809000
SPACE 00810000
SPACE 00811000
TESTDEV1 BAL R3,STARTMSG GO GIVE START/DRAIN MSG 00812000
TM RDEVFLAG,RDEVACNT IS IT BUSY WITH ACCOUNT FILE 00813000
BO DONEXT YES - 00814000
ICM R4,B'1111',RDEVSPL IS DEVICE ACTIVE ?? @VA00716 00815000
BZ STARTDEV NO - START IT 00816000
CLI 0(R4),X'FF' IS SFBLOK ADDRESS IN RDEVSPL ?? 00817000
* ACTIVE FILE WHEN CHECKPOINT WAS TAKEN. 00818000
BE STARTDEV YES -- GIVE DEVICE END 00819000
TM RDEVSTAT,RDEVNRDY NOT READY FLAG SET ?? 00820000
BO STARTDEV YES --GIVE DEVICE END 00821000
TM RDEVFLAG,RDEVTERM FILE TO BE FLUSHED ?? 00822000
BZ DONEXT NO -- 00823000
ICM R3,B'1111',RDEVAIOB IS THERE A ACTIVE IOB ?? @VA00716 00824000
BNZ DONEXT YES - 00825000
ICM R14,B'1111',RSPSFBLK-RSPLCTL(R4) PRT GOING IDLE @VA13341 00825400
BZ DONEXT YES,NO NEED FOR NEW ONE. @VA13341 00825800
TM RDEVSTA2,RDEVINTL SFBLOK ALREADY EXIST? @VA05941 00826000
BZ STARTDEV NO. @VA05941 00827000
BALR R3,R0 @VA05941 00828000
RDEVINTL EQU X'08' @VA05941 00829000
SPACE 00830000
STARTDEV LA R0,IOBSIZE GET CORE FOR AN 00831000
CALL DMKFREE IOBLOK 00832000
L R2,SAVEWRK4 RESTORE ADDRESS OF DEVICE 00833000
USING IOBLOK,R1 TEMPORARY ADDRESSABILITY 00834000
XC IOBLOK(IOBSIZE*8),IOBLOK CLEAR IOBLOK 00835000
ST R1,IOBLINK IOBLOK POINTS TO ITSELF (= ORIGINAL COPY) 00836000
STH R2,IOBRADD STORE DEVICE ADDRESS 00837000
MVI IOBCSW+4,DE INSERT DUMMY DEVICE END @VA00716 00838000
MVC IOBUSER(4),ASYSVM USE ADDRESS OF SYSTEM VMBLOK 00839000
MVI IOBFLAG,IOBCP SET FLAGS AND STATUS 00840000
LTR R3,R3 SHOULD FATAL FLAG BE SET 00841000
BNZ SETIRA NO -- 00842000
OI IOBSTAT,IOBFATAL CLEAR DEVICE AND RECHAIN FILE 00843000
ICM R3,B'1111',RSPSFBLK-RSPLCTL(R4) SPOOL FILE @VA00716 00844000
* BLOK PRESENT? 00845000
BZ SETIRA NO -- 00846000
OI SFBFLAG2-SFBLOK(R3),SFBREQUE FORCE REQUEUING OF FILE 00847000
SETIRA L R3,=A(DMKRSPEX) SET DMKRSPEX AS 00848000
ST R3,IOBIRA INTERRUPT RETURN ADDRESS 00849000
MVC IOBMISC(3),ID+3 INDICATE CALL FROM CSO 00850000
LR R10,R1 SET UP IOB REG FOR CALL 00851000
CALL DMKSTKIO AND STACK THE BLOK FOR DISPATCH 00852000
B DONEXT 00856000
SPACE 3 00857000
DODEL EQU * HERE TO DELETE FILES ON DELETE CHAIN 00858000
SR R7,R7 INDICATE NO SPOOL FILE 00859000
CALL DMKSPLDL,AFFINITY START DELETE ROUTINE @V4075A0 00860000
DOALL EQU * HERE TO START OR DRAIN ALL DEVICES 00861000
TM SAVEWRK1+2,X'02' RADDRESS AND ALL DONE ?? 00862000
BO STEXIT YES -- 00863000
L R6,ARIORD POINTER TO READER CHAIN @VA00716 00864000
MVC SAVEWRK6(3),=C'RDR' SET UP FOR MESSAGE 00865000
BAL R10,SCANDEV 00866000
STPUPR L R6,ARIOPU POINTER TO PUNCH CHAIN 00867000
MVC SAVEWRK6(3),=C'PUN' SET UP FOR MESSAGE 00868000
BAL R10,SCANDEV 00869000
STPRT L R6,ARIOPR POINTER TO PRINTER CHAIN 00870000
MVC SAVEWRK6(3),=C'PRT' SET UP FOR MESSAGE 00871000
B SCANEXIT SCAN FOR DEVICE AND EXIT @VA00716 00872000
SPACE 00873000
STPCH L R6,ARIOPU POINTER TO PUNCH CHAIN 00874000
MVC SAVEWRK6(3),=C'PUN' SET UP FOR MESSAGE 00875000
B SCANEXIT SCAN FOR DEVICE AND EXIT @VA00716 00876000
SPACE 00877000
STRDR L R6,ARIORD POINTER TO READER CHAIN @VA00716 00878000
MVC SAVEWRK6(3),=C'RDR' SET UP MESSAGE 00879000
SCANEXIT BAL R10,SCANDEV SCAN FOR DEVICE @VA00716 00880000
B STEXIT AND EXIT @VA00716 00881000
SPACE 00882000
ALL EQU X'80' 00883000
SPACE 00884000
SETDRAIN OI RDEVFLAG,0 EXECUTED TO SET DRAIN FLAG 00885000
TMTYPE TM RDEVTYPE,X'00' EXECUTED TO TEST TYPE 00886000
SPACE 00887000
SPACE 2 00888000
ORG *-193 00889000
ALPHANUM EQU * TRT TABLE TO VALIDATE THE 36 LEGAL OUTPUT CLASSES 00890000
ORG 00891000
DC C'ABCDEFGHI' VALID CLASSES 00892000
DC 7X'00' ILLEGAL CLASSES 00893000
DC C'JKLMNOPQR' VALID CLASSES 00894000
DC 8X'00' ILLEGAL CLASSES 00895000
DC C'STUVWXYZ' VALID CLASSES 00896000
DC 6X'00' ILLEGAL CLASSES 00897000
DC C'0123456789' VALID CLASSES 00898000
DC 6X'00' ILLEGAL CLASSES 00899000
SPACE 2 00900000
DS 0H 00901000
SPACE 00902000
SCANDEV ST R10,SAVEWRK5 SAVE RETURN ADDRESS 00903000
ICM R7,B'1111',0(R6) GET NUMBER OF LIST ENTRIES @VA00716 00904000
BZ ZEROCNT BRANCH IF ZERO ENTRIES @VA00716 00905000
NEXTDEV LA R6,4(,R6) POINT TO NEXT LIST ENTRY 00906000
LH R8,0(,R6) GET INDEX INTO DEVICE TABLE 00907000
SLL R8,3(0) CONVERT TO BYTE INDEX @V200820 00908000
A R8,ARIODV POINT TO RDEVLBOK 00909000
LH R2,2(,R6) GET DEVICE ADDRESS 00910000
ST R2,SAVEWRK4 SAVE DEVICE ADDRESS 00911000
MVC SAVEWRK1+3(1),RDEVFLAG MOVE IN ORIGINAL STATUS @V60B9BA 00912000
B TESTDEV RETURN TO TEST DEVICE 00913000
SPACE 00914000
DONEXT CALL DMKCKSPL,AFFINITY,PARM=CHGRDV CHKPNT THE CHANGE @V4075A0 00915000
DONEXT1 EQU * @VA09477 00915100
TM SAVEWRK1+2,X'02' REAL ADDRESS ?? @V304298 00916000
BO STARTX YES -- 00917000
BCT R7,NEXTDEV COUNT DOWN LIST TO NEXT DEVICE 00918000
ZEROCNT L R10,SAVEWRK5 RESTORE RETURN ADDRESS 00919000
BR R10 RETURN 00920000
SPACE 3 00921000
STEXIT L R1,SAVEWRK3 GET RID OF THE WORK AREA @V60B9BA 00922000
LTR R1,R1 IS THERE ONE ? @V60B9BA 00923000
BZ STEXIT2 XFER IF NOT @V60B9BA 00924000
LA R0,HLDSIZE NUMBER OF DBL WDS @V60B9BA 00925000
CALL DMKFRET GIVE BACK THE STORAGE @V60B9BA 00926000
STEXIT2 EXIT , @V60B9BA 00927000
SPACE 3 00928000
STARTMSG EQU * HERE TO PRINT MSG DRAINED OR STARTED 00929000
TM SAVEWRK1,X'01' WAS CALLER DMKCSU OR DMKCPI ?? 00930000
BCR 1,R3 YES -- RETURN WITHOUT GIVING MSG 00931000
ICM R4,B'1111',RDEVSPL DEVICE ACTIVE WITH FILE ? @VA00716 00932000
BZ MOVETYPE NO - 00933000
LTR R5,R5 DRAIN OR START MSG 00934000
BZ MOVETYPE START MSG ONLY ON ACTIVE 00935000
TM RDEVSTAT,RDEVNRDY NOTREADY FLAG SET ?? 00936000
BZ DONEXT NO -- DO NEXT DEVICE 00937000
TM RDEVFLAG,RDEVTERM FLUSH COMMAND GIVEN TO THIS DEVICE ? 00938000
BZ DONEXT NO -- DO NEXT DEVICE 00939000
NI RDEVSTAT,X'FF'-RDEVBUSY RESET DEVICE BUSY FLAG 00940000
SR R3,R3 INDICATE FATAL ERROR IN NEW IOBLOK 00941000
ST R3,RDEVAIOB CLEAR ACTIVE IOBLOK ADDRESS 00942000
ST R3,RDEVIOER CLEAR IOERBLOK ADDRESS 00943000
B STARTDEV GO GIVE DEVICE END INTERRUPT 00944000
MOVETYPE MVC DEVTYPE(3),SAVEWRK6 FILE IN MSG DEVICE TYPE 00945000
MVC DEVCLASS(4),RDEVCLAS MOVE IN CLASSES 00946000
OC DEVCLASS(4),BLANKS EDIT FOR UCASE @V200930 00947000
L R1,SAVEWRK4 GET DEVICE ADDRESS 00948000
CALL DMKCVTBH AND CONVERT 00949000
STCM R1,B'0111',DEVADDR AND STORE IN MSG 00950000
MVC DEVMSG(7),=C'STARTED' 00951000
LTR R5,R5 STARTING ?? 00952000
BZ *+10 00953000
MVC DEVMSG(7),=C'DRAINED' 00954000
MVC DEVSEP(3),=C' NO' SET NOSEP @V200930 00955000
TM RDEVFLAG,RDEVSEP TEST FOR NOSEP @V200930 00956000
BZ *+10 YES IT IS NOSEP @V200930 00957000
MVC DEVSEP(3),BLANKS MARK AS SEP @V200930 00958000
LA R0,STARTLR READER MSG SIZE @V200930 00959000
TM RDEVTYPC,CLASURI IS IT A READER TYPE ?? @V200930 00960000
BO *+8 YES, CONT @V200930 00961000
LA R0,STARTL LENGTH AND 00962000
LA R1,STMSG AND ADDRESS OF MESSAGE 00963000
CALL DMKQCNWT,AFFINITY,PARM=(NORET+OPERATOR) @V4075A0 00964000
NI RDEVFLAG,X'FF'-RDEVSPAC RESET SPACE FLAG 00965000
TM VMOSTAT,VMSYSOP IS USER SYSTEM OPERATOR ?? 00966000
BCR 1,R3 YES -- RETURN TO CALLER 00967000
CALL DMKQCNWT,AFFINITY,PARM=NORET SEND MSG TO USER @V4075A0 00968000
BR R3 RETURN TO CALLER 00969000
SPACE 00970000
STMSG DS 0H @V200930 00971000
DEVTYPE DC CL5' ' @V200930 00972000
DEVADDR DC CL3' ' @V200930 00973000
DC CL1' ' @V200930 00974000
DEVMSG DC CL7' ' STARTED OR DRAINED @V200930 00975000
DC CL3' ' @V200930 00976000
DEVUSER DC CL8'SYSTEM ' @V200930 00977000
STARTLR EQU *-STMSG READER MSG SIZE @V200930 00978000
DC CL9' CLASS = ' @V200930 00979000
DEVCLASS DC CL4' ' @V200930 00980000
DEVSEP DC CL6' NOSEP' @V200930 00981000
STARTL EQU *-STMSG @V200930 00982000
DS 0H 00983000
EJECT 00984000
*. 00985000
* SUBROUTINE NAME - 00986000
* 00987000
* DMKCSORP 00988000
* 00989000
* FUNCTION - 00990000
* 00991000
* TO REPEAT THE CURRENTLY ACTIVE FILE ON THE SPECIFIED DEVICE A 00992000
* SPECIFIED NUMBER OF TIMES. THE NUMBER OF COPIES SPECIFIED IS 00993000
* ADDED TO THE NUMBER SPECIFIED BY THE USER. IF 'HOLD' IS 00994000
* SPECIFIED THE FILE WILL BE HELD AFTER PRINTING THE 00995000
* LAST COPY REQUESTED. 00996000
* 00997000
* COMMAND LINE FORMAT - 00998000
* 00999000
* +--------+-----------------------+ 01000000
* | REPEAT | RADDR <COPY> <HOLD> | 01001000
* | REP | HO | 01002000
* +--------+-----------------------+ 01003000
* 01004000
* OPERATION - 01005000
* 01006000
* 1. BAL TO GETDEVIC TO LOCATE THE RDEVBLOK FOR THE DEVICE ON 01007000
* WHICH THE FILE IS TO BE REPEATED 01008000
* 2. IF DEVICE NOT PRINTER OR PUNCH: EXIT GIVING MSG021E. 01009000
* IF DEVICE IS DEDICATE: EXIT GIVING MSG140E. 01010000
* IF DEVICE IS OFFLINE: EXIT GIVING MSG046E. 01011000
* IF DEVICE NOT ACTIVE: EXIT GIVING MSG141E. 01012000
* 3. CALL DMKSCNFD TO LOCATE THE NUMBER OF COPIES REQUESTED 01013000
* OR KEYWORD 'HOLD'. IF 'HOLD' SET SFBSHOLD AND 01014000
* GO TO STEP 3. 01015000
* 4. IF NO NUMBER IS GIVEN, 1 IS ASSUMED 01016000
* 5. CONVERT THE NUMBER TO BINARY AND VERIFY THAT THE NUMBER 01017000
* REQUESTED IS LESS THAN 100 01018000
* 6. ADD THE NUMBER GIVEN TO THE COPIES FIELD IN THE SFBLOK 01019000
* IF NONE: GO TO STEP 7. 01020000
* IF TOTAL COPIES IN SFBLOK IS OVER 99, RESET TO 99 COPIES 01021000
* 7. EXIT 01022000
* 01023000
* RESPONSE - 01024000
* 01025000
* TYPE XXX REPEATED USERID FILE= NNNN RECDS=NNNNNN COPY= NN C TYP 01026000
* 01027000
* 01028000
* ERROR MESSAGES - 01029000
* 01030000
* DMKCSO003E INVALID OPTION - (OPTION) 01031000
* DMKCSO006E INVALID DEVICE TYPE - (ADDR) 01032000
* DMKCSO013E CONFLICTING OPTION - (OPTION) 01033000
* DMKCSO021E RADDR MISSING OR INVALID 01034000
* DMKCSO030E COPIES MISSING OR INVALID 01035000
* DMKCSO040E DEV (ADDR) DOES NOT EXIST 01036000
* DMKCSO046E (TYPE) (RADDR) OFFLINE 01037000
* DMKCSO140E (TYPE) (RADDR) ATTACHED TO (USERID) 01038000
* DMKCSO141E (TYPE) (RADDR) NOT ACTIVE 01039000
*. 01040000
SPACE 01041000
DMKCSORP RELOC 01042000
BAL R4,CLEAR CLEAR SAVEWRK1,2-9 01043000
BAL R4,GETDEVIC LOCATE REAL DEVICE BLOK FOR FILE 01044000
* TO BE REPEATED 01045000
ST R1,SAVEWRK2 SAVE DEVICE ADDRESS 01046000
USING RDEVBLOK,R8 01047000
LA R2,1 DEFAULT NUMBER FOR REPEAT 01048000
REPSCAN EQU * 01049000
CALL DMKSCNFD DID USER SPECIFY NUMBER OF REPEATS ? 01050000
BNZ SETRPEAT NO -- 01051000
TM SAVEWRK1,X'C0' HOLD AND COPY SET ?? 01052000
BO MSG003E YES -- INVALID OPTION 01053000
LR R14,R0 COUNT 01054000
BCTR R14,0 -1 01055000
C R0,F2 VALID COUNT FOR HOLD 01056000
BL CVTCOPY MUST BE COUNT 01057000
EX R14,CLCHOLD HOLD OPTION ?? 01058000
BNE CVTCOPY NO - 01059000
TM SAVEWRK1,X'80' HOLD OPTION SET ?? 01060000
BO MSG013E YES -- CONFLICTING OPTION 01061000
OI SAVEWRK1,X'80' SET SWITCH 01062000
B REPSCAN 01063000
SPACE 01064000
CVTCOPY C R0,F2 LENGTH GREATER THAN 2 ?? 01065000
BH MSG003E YES ---INVALID OPTION 01066000
TM SAVEWRK1,X'40' COPY OPTION PRESENT ?? 01067000
BO MSG013E YES -- CONFLICTING OPTION 01068000
CALL DMKCVTDB CONVERT NUMBER OF REPEATS 01069000
BNZ MSG030E NUMBER OF COPIES MISSING 01070000
LR R2,R1 GET NUMBER OF TIMES TO REPAET 01071000
C R2,=F'99' MORE THAN 99 COPIES REQUESTED ?? 01072000
BH MSG030E YES -- NUMBER OF COPIES INVALID 01073000
LTR R1,R1 COPIES EQUAL ZERO ?? 01074000
BZ MSG030E YES - 01075000
OI SAVEWRK1,X'40' INDICATE COPY OPTION PRESENT 01076000
B REPSCAN LOCATE NEXT OPTION 01077000
SPACE 01078000
USING SFBLOK,R7 01079000
USING RSPLCTL,R9 01080000
SETRPEAT L R1,SAVEWRK2 GET DEVICE ADDRESS @VA00716 01081000
ICM R9,B'1111',RDEVSPL FILE POINTER PRESENT ?? @VA00716 01082000
BZ MSG141E NO - CANNOT REPEAT 01083000
TM RDEVFLAG,RDEVACNT PUNCHING ACCOUNTING CARDS ?? 01084000
BO MSG141E YES -- GIVE INACTIVE MSG 01085000
LR R7,R9 SET UP SFBLOK ADDRESS 01086000
CLI 0(R9),X'FF' IF FILE IS ACTIVE ON WARM START 01087000
BE *+8 YES -- 01088000
L R7,RSPSFBLK GET ADDRESS OF SFBLOK 01089000
LTR R7,R7 SPOOL FILE PRESENT ?? 01090000
BZ MSG141E NO - 01091000
SPACE 01092000
TM SAVEWRK1,X'80' HOLD INDICATED ?? 01093000
BZ ADDCOPY NO - 01094000
OI SFBFLAG,SFBSHOLD+SFBRECOK SET SYSTEM HOLD AND RECORD 01095000
* ALLOCATION OK 01096000
SPACE 01097000
ADDCOPY TM SAVEWRK1,X'80' HOLD PRESENT ?? 01098000
BZ SETCOPY NO -- 01099000
TM SAVEWRK1,X'40' COPY PRESENT ?? 01100000
BZ CSOEXIT NO - 01101000
SETCOPY AH R2,SFBCOPY ADD REPEAT TO NUMBER OF COPIES 01102000
C R2,=F'99' TOTAL COPIES LARGER THAN 99 ? @VW01227 01103000
BNH *+8 NO -- 01104000
LA R2,99 SET TO 99 COPIES 01105000
STH R2,SFBCOPY AND STORE IN SFBLOK 01106000
B CSOEXIT EXIT 01107000
SPACE 01108000
EJECT 01109000
*. 01110000
* SUBROUTINE NAME - 01111000
* 01112000
* DMKCSOBS 01113000
* 01114000
* FUNCTION - 01115000
* 01116000
* TO BACKSPACE THE OUTPUT OF A REAL SPOOL PRINTER A SPECIFIED 01117000
* NUMBER OF FORMS PAGES, OR TO BACK UP THE OUTPUT OF A PRINTER 01118000
* OR PUNCH TO THE BEGINNING OF THE CURRENT FILE 01119000
* 01120000
* COMMAND LINE FORMAT - 01121000
* 01122000
* PUNCHES 01123000
* 01124000
* +-----------+----------------+ 01125000
* | BACKSPACE | RADDR <FILE> | 01126000
* | BA | ---- | 01127000
* +-----------+----------------+ 01128000
* 01129000
* PRINTERS 01130000
* 01131000
* +-----------+---------------------------+ 01132000
* | BACKSPACE | RADDR <FILE> | 01133000
* | BA | <PAGES> <EOF> | 01134000
* | | 1 | 01135000
* | | - | 01136000
* +-----------+---------------------------+ 01137000
* 01138000
* FILE EOF 01139000
* F EOF 01140000
* 01141000
* OPERATION - 01142000
* 01143000
* 1. BAL TO GETDEVIC TO LOCATE THE RDEVBLOK FOR THE DEVICE 01144000
* TO BE BACKSPACED 01145000
* 2. IF DEVICE NOT PRINTER OR PUNCH: EXIT GIVING MSG021E. 01146000
* IF DEVICE DEDICATE: EXIT GIVING MSG140E. 01147000
* IF DEVICE NOT ACTIVE: EXIT GIVING MSG141E. 01148000
* IF DEVICE OFFLINE: EXIT GIVING MSG046E. 01149000
* 3. CALL DMKSCNFD TO LOCATE BACKSPACE OPTION 01150000
* 4. IF NO OPTION IS GIVEN, ASSUME 1 PAGE 01151000
* 5. IF THE 'FILE' OPTION IS SPECIFIED, SET THE RDEVRSTR FLAG 01152000
* AND EXIT 01153000
* 6. IF A NUMERIC OPTION IS SPECIFIED, CONVERT IT TO BINARY. 01154000
* IF THE EOF OPTION IS ALSO GIVEN, OBTAIN THE 01155000
* NEGATIVE OF THE BACKUP COUNT AND 01156000
* SAVE IT IN THE RSPLCTL CONTROL BLOK; THEN SET THE RDEVBACK 01157000
* FLAG AND EXIT 01158000
* 01159000
* RESPONSE - 01160000
* 01161000
* TYPE XXX BACKSPACE USERID FILE= NNNN RECDS=NNNNNN COPY= NN C TYP 01162000
* 01163000
* ERROR MESSAGES - 01164000
* 01165000
* DMKCSO003E INVALID OPTION - (OPTION) 01166000
* DMKCSO006E INVALID DEVICE TYPE - (ADDR) 01167000
* DMKCSO021E RADDR MISSING OR INVALID 01168000
* DMKCSO040E DEV (ADDR) DOES NOT EXIST 01169000
* DMKCSO046E (TYPE) (RADDR) OFFLINE 01170000
* DMKCSO140E (TYPE) (RADDR) ATTACHED TO (USERID) 01171000
* DMKCSO141E (TYPE) (RADDR) NOT ACTIVE 01172000
* DMKCSO441E NOT ACCEPTED. PREVIOUS BACKSPACE STILL BEING 01172010
* PROCESSED. @VA13377 01172020
*. 01173000
SPACE 01174000
DMKCSOBS RELOC 01175000
BAL R4,CLEAR CLEAR SAVEWRK1,2-9 01176000
BAL R4,GETDEVIC LOCATE RDEVBLOK FOR FILE TO BE 01177000
* BACKSPACED 01178000
USING RDEVBLOK,R8 01179000
ICM R4,B'1111',RDEVSPL ACTIVE FILE POINTER PRESENT ?@VA00716 01180000
BZ MSG141E NO - CANNOT BACKSPACE 01181000
TM RDEVFLAG,RDEVBACK SEE IF ALREADY BACKSPACING @VA13377 01181300
BO MSG441E YES, CAN'T DO IT AGAIN YET @VA13377 01181600
TM RDEVFLAG,RDEVACNT PUNCHING ACCOUNTING CARDS ?? 01182000
BO MSG141E YES -- GIVE INACTIVE MSG 01183000
LA R2,1 DEFAULT OF 1 FOR BACKSPACE NUMBER 01184000
SWITCH @VA08060 01185000
CALL DMKSCNFD DID USER SPECIFY NUMBER OF PAGES ?? 01186000
BNZ SETBACK NO -- USE ONE 01187000
C R0,F8 LENGTH GREATER THAN 8 ? 01188000
BH MSG003E YES -- ERROR MSG DMKCSO003E 01189000
LR R14,R0 COUNT 01190000
BCTR R14,0 -1 01191000
EX R14,CLCFILE IS IT BACKSPACE FILE ?? 01192000
BE SETFILE YES - 01193000
STM R0,R1,SAVEWRK8 SAVE LENGTH AND ADDRESS OF OPTION 01194000
TM RDEVTYPE,TYPPUN PUNCH ?? 01195000
BO MSG003E INVALID OPTION 01196000
CALL DMKCVTDB CONVERT USER REQUEST 01197000
BZ CNTGOOD PAGE COUNT GOOD 01198000
BSERR LM R0,R1,SAVEWRK8 GET LENGTH AND ADDRESS 01199000
B MSG003E ERROR MSG INVALID OPTION 01200000
* 'FILE' 01201000
CNTGOOD EQU * 01202000
LTR R1,R1 COUNT ZERO ?? 01203000
BZ BSERR YES - INVALID OPTION 01204000
LR R2,R1 GET NUMBER TO BACKSPACE 01205000
SETBACK TM RDEVTYPE,TYPPUN IS IT PUNCH 01206000
BO SETFILE YES - HAS TO BE FILE 01207000
CALL DMKSCNFD ANY MORE OPTIONS ?? 01208000
BNZ NOTEOF NO, IT'S A NORMAL BACKSPAC @V60B9BA 01209000
C R0,F3 SEE IF IT IS EOF OPTION @V60B9BA 01210000
BNE MSG003E NOPE, IT MUST BE INVALID @V60B9BA 01211000
CLC 0(3,R1),=C'EOF' IS IT REALLY EOF ? @V60B9BA 01212000
BNE MSG003E NOPE, IT IS INVALID @V60B9BA 01213000
LNR R2,R2 LOAD NEGATIVE BACKSP CNT @V60B9BA 01214000
* TO INDICATE EOF OPTION 01215000
NOTEOF ST R2,RSPMISC-RSPLCTL(R4) SAVE BACKSPACE NUMBER IN @V60B9BA 01216000
* RSPLCTL 01217000
OI RDEVFLAG,RDEVBACK SET BACKSPACE 01218000
B CSOEXIT AND EXIT 01219000
SPACE 01220000
SETFILE EQU * 01221000
CALL DMKSCNFD ANY MORE OPTIONS ?? 01222000
BZ MSG003E YES -- INVALID OPTION 01223000
OI RDEVFLAG,RDEVRSTR YES - SET RESTART FLAG IN RDEVBLOK 01224000
B CSOEXIT AND LEAVE 01225000
EJECT 01226000
*. 01227000
* OPERATION OF GETDEVIC SUBROUTINE - 01228000
* 01229000
* 1. CALL DMKSCNFD TO LOCATE THE DEVICE ADDRESS FIELD 01230000
* 2. IF NO OPTION IS FOUND: EXIT GIVING MSG021E. 01231000
* 3. CONVERT THE ADDRESS TO BINARY 01232000
* 4. IF THE CONVERSION FAILS, EXIT GIVING MSG021E. 01233000
* 5. CALL DMKSCNRU TO LOCATE THE DEVICE BLOK FOR THE SPECIFIED 01234000
* UNIT; IF NOT FOUND, EXIT GIVING MSG040E. 01235000
* 6. OTHERWISE, RETURN TO CALLER WITH GPR8 = RDEVBLOK 01236000
*. 01237000
SPACE 01238000
USING RDEVBLOK,R8 01239000
GETDEVIC EQU * HERE TO LOCATE THE DEVICE SPECIFIED IN THE COMMAND 01240000
CALL DMKSCNFD LOCATE NEXT OPTION 01241000
BNZ MSG021E DEVICE ADDRESS IS MISSING 01242000
SPACE 01243000
GETDVIC2 C R0,F3 LENGTH GREATER THAN 3 ?? 01244000
BH MSG021E YES -- INVALID RADDRESS 01245000
LR R14,R0 GET LENGTH 01246000
BCTR R14,0 -1 01247000
EX R14,MVCADDR MOVE ADDRESS TO SAVEWRK7 01248000
CALL DMKCVTHB CONVERT TO BINARY 01249000
BNZ MSG021E INVALID HEX CHARACTERS IN ADDRESS 01250000
CALL DMKSCNRU 01251000
BNZ MSG040E COULDN'T FIND A DEVICE AT THAT 01252000
* ADDRESS 01253000
L R14,ARIORD POINT TO LIST OF SYSTEM READERS 01254000
MVC SAVEWRK6(3),=C'RDR' SET FOR ERROR MSG 01255000
TM RDEVTYPC,CLASURI READER TYPE ?? 01256000
BO VALDEV VALIDATE DEVICE FOR SPOOLING 01257000
L R14,ARIOPR POINT TO LIST OF SYSTEM PRINTERS 01258000
MVC SAVEWRK6(3),=C'PRT' PRINTER TYPE ?? 01259000
TM RDEVTYPE,TYPPRT PRINTER ?? 01260000
BO VALDEV VALIDATE DEVICE FOR SPOOLING 01261000
L R14,ARIOPU POINT TO LIST OF SYSTEM PUNCHES 01262000
MVC SAVEWRK6(3),=C'PUN' SET FOR PUNCH 01263000
SPACE 01264000
VALDEV ICM R15,B'1111',0(R14) GET NUMBER OF DEVICES 01265000
BZ MSG006E NO DEVICES - INVALID TYPE 01266000
GETDEVLP LA R14,4(R14) UPDATE TO NEXT ENTRY 01267000
CH R1,2(R14) IS THIS DEVICE ON LIST ?? 01268000
BE DEVAVAIL YES -- CHECK FOR DEVICE @VA00716 01269000
* AVAILABILITY 01270000
BCT R15,GETDEVLP TRY NEXT ENTRY 01271000
B MSG006E -- INVALID DEVICE TYPE 01272000
SPACE 01273000
DEVAVAIL TM SAVEWRK1+2,X'02' START OR DRAIN COMMAND ? @VA00716 01274000
BCR 1,R4 YES - BRANCH (RETURN) @VA00716 01275000
TM RDEVTYPC,CLASURO UNIT RECORD OUTPUT TYPE ? @VA00716 01276000
BZ MSG006E NO - INVALID ADDRESS @VA00716 01277000
TSTSTAT TM RDEVSTAT,RDEVDED IS THE DEVICE DEDICATED ? @VA00716 01278000
BO MSG140E YES -- ERROR @VA00716 01279000
TM RDEVSTAT,RDEVDISA IS THE DEVICE OFFLINE ? @VA00716 01280000
BO MSG046E YES -- ERROR @VA00716 01281000
BR R4 RETURN TO CALLER @VA00716 01282000
SPACE 01283000
MVCADDR MVC SAVEWRK7(0),0(R1) MOVE NAME TO SAVEWRK7 01284000
SPACE 3 01285000
CLEAR XC SAVEWRK2(32),SAVEWRK2 CLEAR WORK AREA 01286000
XC SAVEWRK1(4),SAVEWRK1 01287000
BR R4 RETURN 01288000
SPACE 3 01289000
EJECT 01290000
****************************************************** 01291000
* 01292000
* ERROR EXITS FROM DMKCSO 01293000
* 01294000
****************************************************** 01295000
SPACE 3 01296000
MSG003E EQU * HERE IF OPTION IS INVALID 01297000
LA R2,003 ERROR MSG DMKCSO003E 01298000
B EXIT8 01299000
SPACE 01300000
MSG006E EQU * HERE IF INVALID DEVICE TYPE 01301000
LA R2,006 ERROR MSG DMKCSO006E 01302000
B EXIT1 01303000
SPACE 01304000
MSG013E EQU * HERE IF CONFLICTING OPTIONS 01305000
LA R2,013 ERROR MSG DMKCSO013E 01306000
B EXIT8 .. 01307000
SPACE 01308000
MSG021E EQU * HERE IF RADDR MISSING OR INVALID 01309000
LA R2,021 ERROR MSG DMKCSO021E 01310000
B EXIT8R1 01311000
SPACE 01312000
SPACE 01313000
MSG028E EQU * HERE IF CLASS IS MISSING OR INVALID 01314000
LA R2,028 ERROR MSG DMKCSO028E 01315000
B EXIT8R1 EXIT 01316000
SPACE 01317000
MSG030E EQU * HERE IF COPIES MISSING OR INVALID 01318000
LA R2,030 ERROR MSG DMKCSO030E 01319000
B EXIT8R1 EXIT 01320000
SPACE 01321000
SPACE 2 01322000
MSG040E EQU * HERE IF DEVICE ADDRESS DOES NOT EXIST 01323000
LA R2,040 ERROR MSG DMKCSO040E 01324000
B EXIT1 SET UP MESSAGE 01325000
SPACE 01326000
SPACE 01327000
MSG046E EQU * HERE IF DEVICE IS OFFLINE 01328000
LA R2,046 ERROR MSG DMKCSO046E 01329000
B EXIT2 SET GPR0 AND GPR1 01330000
SPACE 01331000
MSG140E EQU * HERE IF DEVICE IS ATTACHED TO USER 01332000
L R14,RDEVUSER ADDRESS OF USER VMBLOK 01333000
MVC SAVEWRK8(8),VMUSER-VMBLOK(R14) GET USER ID 01334000
LA R0,16 LENGTH OF DATA FOR ERROR MSG 01335000
LA R1,SAVEWRK6 ADDRESS OF DATA 01336000
LA R2,140 ERROR MSG DMKCSO140E 01337000
B EXIT8 EXIT 01338000
SPACE 01339000
MSG141E EQU * HERE IF DEVICE NOT ACTIVE 01340000
LA R2,141 ERROR MSG DMKCSO141E 01341000
B EXIT2 SET UP GPR0 AND GPR1 01342000
SPACE 01343000
MSG243E EQU * HERE IF FLASH MISSING OR INVALID @V60B9BA 01344000
LA R2,243 ERR MSG DMKCSO243E @V60B9BA 01345000
B EXIT8R1 EXIT @V60B9BA 01346000
SPACE 01347000
MSG244E EQU * HERE IF IMAGE LIBRARY MISSING OR INVALID @V60B9BA 01348000
TM SAVEWRK1,X'01' CALLED FROM DMKCPI?? @V60B9BA 01349000
BO DONEXT IGNORE ERROR IF SO @V60B9BA 01350000
LA R2,244 ERR MSG DMKCSO244E @V60B9BA 01351000
B EXIT8R1 EXIT @V60B9BA 01352000
SPACE 01353000
MSG245E EQU * HERE IF CHARS MISSING OR INVALID @V60B9BA 01354000
LA R2,245 ERR MSG DMKCSO245E @V60B9BA 01355000
B EXIT8R1 EXIT @V60B9BA 01356000
SPACE 01357000
MSG246E EQU * HERE IF FCB MISSING OR INVALID @V60B9BA 01358000
LA R2,246 ERR MSG DMKCSO246E @V60B9BA 01359000
B EXIT8R1 EXIT @V60B9BA 01360000
SPACE 01361000
MSG441E EQU * HERE ON BACKSPACE WHEN ALREADY BACKSPACING @VA13377 01361100
LA R2,441 ERR MSG DMKCSO441E @VA13377 01361200
LA R1,BACKSPAC VARIABLE FOR SUBSTITUTION @VA13377 01361300
LA R0,L'BACKSPAC LENGTH TO SUBSTITUTE @VA13377 01361400
B EXIT8 GO PROCESS THE MSG @VA13377 01361500
SPACE 1 01361600
EXIT1 LA R0,3 LENGTH OF REAL ADDRESS 01362000
LA R1,SAVEWRK7 ADDRESS OF REAL ADDRESS 01363000
B EXIT8 EXIT 01364000
SPACE 01365000
EXIT2 LA R0,8 LENGTH OF TYPE AND REAL ADDRESS 01366000
LA R1,SAVEWRK6 ADDRESS OF DATA 01367000
B EXIT8 EXIT 01368000
SPACE 3 01369000
CLCALL CLC 0(0,R1),=C'ALL ' 01370000
CLCHOLD CLC 0(0,R1),=C'HOLD ' 01371000
CLCPRINT CLC 0(0,R1),=C'PRINTER ' 01372000
CLCREAD CLC 0(0,R1),=C'READER ' 01373000
CLCPUN CLC 0(0,R1),=C'PUNCH ' 01374000
CLCFILE CLC 0(0,R1),=C'FILE ' 01375000
CLCNOS CLC 0(0,R1),=C'NOSEP ' 01376000
CLCCLASS CLC 0(0,R1),=C'CLASS ' 01377000
CLCFLASH CLC 0(0,R1),=C'FLASH ' @V60B9BA 01378000
CLCCHARS CLC 0(0,R1),=C'CHARS ' @V60B9BA 01379000
CLCFCB CLC 0(0,R1),=C'FCB ' @V60B9BA 01380000
CLCIMAGE CLC 0(0,R1),=C'IMAGE ' @V60B9BA 01381000
CLCPURGE CLC 0(0,R1),=C'PURGE ' @V60B9BA 01382000
MVCFLASH MVC HLDFLASH-HLDAREA(0,R3),0(R1) @V60B9BA 01383000
MVCCHARS MVC HLDCHARS-HLDAREA(0,R3),0(R1) @V60B9BA 01384000
MVCIMAGE MVC HLDIMAGE-HLDAREA(0,R3),0(R1) @V60B9BA 01385000
EJECT 01386000
*********************************** 01388000
* 01389000
* FINAL EXIT BACK TO DMKCFM OR DMKERM 01390000
* 01391000
*********************************** 01392000
SPACE 3 01393000
DS 0H 01394000
SPACE 2 01395000
EXIT8R1 SR R1,R1 NO DATA IN R0 AND R1 01396000
SR R0,R0 NO DATA IN RO BUT DATA IN R1 01397000
EXIT8 ICM R0,B'1110',ID+3 LOAD MODULE ID (CSO) 01398000
STM R0,R1,SAVEWRK4 SAVE REGS NOW @VMI0010 01399000
L R1,SAVEWRK3 GIVE BACK THE WORK AREA @V60B9BA 01400000
LTR R1,R1 IS THERE ONE ? @V60B9BA 01401000
BZ EXIT8A XFER IF NOT @V60B9BA 01402000
LA R0,HLDSIZE SIZE IN DBL WDS @V60B9BA 01403000
CALL DMKFRET GIVE IT BACK @V60B9BA 01404000
EXIT8A LM R0,R1,SAVEWRK4 RESTORE THE REGS @VMI0010 01405000
CALL DMKERMSG GO TO ERROR MSG MODULE 01406000
* 01407000
* DMKERMSG WILL EXIT TO DMKCFM VIA SVC 16 01408000
* 01409000
SPACE 2 01410000
CSOMSG EQU * HERE TO PRINT COMMAND COMPLETED MESSAGE 01411000
LA R0,16 MSG LENGTH 01412000
LA R1,CMDMSG ADDRESS OF MSG 01413000
CALL DMKQCNWT,PARM=NORET 01414000
SPACE 2 01415000
CSOEXIT EQU * HERE TO EXIT 01416000
EXIT 01417000
EJECT 01418000
CMDMSG DC C'COMMAND COMPLETE' 01420000
BACKSPAC DC C'BACKSPACE' @VA13377 01421000
LTORG 01422000
EJECT 01423000
HLDAREA DSECT , WORK AREA FOR START COMMAND @V60B9BA 01424000
HLDFLASH DS CL4 FLASH OVERLAY NAME @V60B9BA 01425000
HLDCHARS DS CL4 CHAR ARR TBL FOR SEP PAGE @V60B9BA 01426000
HLDIMAGE DS CL8 IMAGE LIBRARY FOR LOADS @V60B9BA 01427000
HLDPTRO DS A PTR TO NPRTBL FOR RDEVIMAG @V60B9BA 01428000
HLDPTRN DS A PTR TO NPRTBL FOR HLDIMAGE @V60B9BA 01429000
HLDFCB DS 1X FCB FOR SEP PAGE (6|8|12) @V60B9BA 01430000
HLDFLAG1 DS 1X FLAG BYTE @V60B9BA 01431000
HLDPURGE EQU X'80' PURGE SPECIFIED FLAG @V60B9BA 01432000
DS 6X RESERVED @V60B9BA 01433000
HLDSIZE EQU (*-HLDAREA)/8 WORK AREA SIZE (DBL WDS) @V60B9BA 01434000
SPACE 01435000
PSA , @V306638 01436000
COPY CONBUF @V306638 01437000
COPY DEVTYPES @V306638 01438000
COPY EQU @V306638 01439000
COPY IOBLOKS @V306638 01440000
COPY IOER @V306638 01441000
COPY RBLOKS @V306638 01442000
COPY SAVE @V306638 01443000
COPY SPOOL @V306638 01444000
COPY NPRTBL @V60B9BA 01445000
COPY UDIRECT @V306638 01446000
COPY VBLOKS @V306638 01447000
COPY VMBLOK @V306638 01448000
SPACE 4 01449000
END 01450000