CSV TITLE 'DMKCSV (CP) VM/370 - RELEASE 6' 00001000 ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000 *. 00003000 * MODULE NAME - 00004000 * 00005000 * DMKCSV 00006000 * 00007000 * FUNCTION - 00008000 * 00009000 * DMKCSV CONTAINS THREE SPOOLING COMMAND FUNCTIONS AVAILABLE TO 00010000 * TO CLASS G USERS. THE COMMANDS ARE ALSO PROCESSED 00011000 * FOR CLASS D USERS IN A SLIGHTLY DIFFERENT FORMAT 00012000 * 00013000 * ATTRIBUTES - 00014000 * 00015000 * REENTRANT, PAGEABLE, CALLED VIA SVC 00016000 * 00017000 * ENTRY POINTS - 00018000 * 00019000 * DMKCSVOR - ORDER COMMAND 00020000 * DMKCSVPU - PURGE COMMAND 00021000 * DMKCSVTR - TRANSFER COMMAND 00022000 * 00023000 * ENTRY CONDITIONS - 00024000 * 00025000 * GPR9 = ADDRESS OF THE COMMAND LINE BUFFER; MUST BE PRESERVED 00026000 * FOR CALLS TO DMKSCNFD 00027000 * GPR12 = ADDRESS OF ENTRY POINT 00028000 * GPR13 = ADDRESS OF SAVEAREA 00029000 * 00030000 * EXIT CONDITIONS - 00031000 * 00032000 * NORMAL - 00033000 * GPR2 = 0 00034000 * 00035000 * ERROR - 00036000 * 00037000 * GPR2 = CONTAINS THE BINARY MESSAGE NUMBER 00038000 * - EITHER AN OPTION IS ILLEGAL OR SOME CONDITION 00039000 * EXISTS THAT MAKES IT IMPOSSIBLE TO EXECUTE THE COMMAND 00040000 * A MESSAGE IS TYPED TO DESCRIBE THE ERROR; THE ERROR 00041000 * MESSAGES THAT MAY OCCUR ARE LISTED WITH EACH COMMAND 00042000 EJECT 00043000 * 00044000 * CALLS TO OTHER ROUTINES - 00045000 * 00046000 * DMKSCNFD - SCAN THE COMMAND LINE BUFFER FOR OPTIONS 00047000 * DMKSTKIO - TO STACK A IOBLOK 00048000 * DMKSPLDL - DELETE PURGED FILES FROM THE SYSTEM 00049000 * DMKCVTDB - CONVERT DECIMAL SPOOLID NUMBERS TO BINARY 00050000 * DMKCVTBD - CONVERT BINARY TO DECIMAL 00051000 * DMKERMSG - WRITE ERROR MESSAGES 00052000 * DMKCSOSD - TO START PUNCH OR PRINTER 00053000 * DMKSCNAU - TO LOCATE USERID VMBLOK 00054000 * DMKQCNWT - TO WRITE A MESSAGE AT CONSOLE 00055000 * DMKUDRFU - TO VERIFY A USER 00056000 * DMKFREE - TO OBTAIN A BLOCK OF FREE STORAGE 00057000 * DMKFRET - TO RETURN A BLOCK OF STORAGE 00058000 * DMKCKSPL - CHECKPOINT THE SFBLOK 00059000 * EXTERNAL REFERENCES - 00060000 * 00061000 * DMKRSPRD - (ARSPRD) READER FILE CHAIN ANCHOR 00062000 * DMKRSPPR - (ARSPPR) PRINTER FILE CHAIN ANCHOR 00063000 * DMKRSPPU - (ARSPPU) PUNCH FILE CHAIN ANCHOR 00064000 * DMKRSPDL - SPOOL DELETE CHAIN ANCHOR 00065000 * DMKVIOIN - IOBIRA FOR IOBLOK 00066000 * 00067000 * TABLES / WORKAREAS - 00068000 * 00069000 * IOBLOK 00070000 * VDEVBLOK AND SFBLOKS ARE UPDATED, ALTERED OR DELETED 00071000 * 00072000 * THE SAVEWRK FIELDS IN THE STANDARD SAVEAREA ARE USED BY THE 00073000 * OPTION PROCESSING SUBROUTINES FOR THE FOLLOWING VALUES - 00074000 * 00075000 * SAVEWRK1 - FILE OUTPUT CLASS (1 BYTE) 00076000 * SAVEWRK1+1 - NUMBER OF COPIES (1 BYTE) 00077000 * SAVEWRK1+2 - SPOOLID NUMBER (HALF-WORD) 00078000 * SAVEWRK2,3 - USERID OF FILE'S OWNER 00079000 * SAVEWRK4 - ADDRESS OF FNAME FTYPE (24 BYTES) 00080000 * SAVEWRK5 - USE VARIES WITH COMMAND 00081000 * SAVEWRK6,7 - SAVE AREA FOR R0,R1 SCAN OPTIONS 00082000 * SAVEWRK8,9 - USE VARIES WITH COMMAND 00083000 * 00084000 * REGISTER USAGE - 00085000 * 00086000 * ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00087000 * ANY INDIVIDUAL DEVIATIONS OR EXTENSIONS ARE LISTED WITH THE 00088000 * COMMAND DESCRIPTION 00089000 * 00090000 * GPR0 = LENGTH OF OPTION - RETURNED FROM DMKSCNFD 00091000 * GPR1 = ADDRESS OF OPTION - RETURNED FROM DMKSCNFD 00092000 * GPR2 = SCRATCH 00093000 * GPR3 = INTERNAL LINKAGE - 2ND LEVEL 00094000 * GPR4 = INTERNAL LINKAGE - 1ST LEVEL 00095000 * GPR5 = DEVICE TYPE FLAGS - LOGICAL SUM OF TYPES 00096000 * GPR6 = POINTER TO PREVIOUS SFBLOK ON CHAIN 00097000 * GPR7 = SFBLOK BASE 00098000 * GPR8 = VDEVBLOK BASE 00099000 * GPR9 = INPUT COMMAND LINE ADDRESS 00100000 * GPR10 = ADDRESS OF IOBLOK 00101000 * GPR11 = VMBLOK BASE 00102000 * GPR12 = DMKCSV BASE 00103000 * GPR13 = SAVEAREA BASE 00104000 * GPR14 = EXTERNAL LINKAGE 00105000 * GPR15 = EXTERNAL LINKAGE 00106000 * 00107000 * NOTES - 00108000 * 00109000 * NONE 00110000 * 00111000 * OPERATION - 00112000 * 00113000 * EACH COMMAND PROCESSOR IS ENTERED VIA A CALL FROM DMKCSV. THE 00114000 * PROCESSING LOGIC IS EMBODIED IN A SERIES OF INTERNAL CALLS TO 00115000 * A SET OF OPTION PROCESSORS AND LIST SCANNERS. IN GENERAL, 00116000 * THE OPTION PROCESSORS ARE CALLED WHEN IT IS KNOWN, EITHER BY 00117000 * POSITION OR KEYWORD, WHAT TYPE OF OPTION MUST APPEAR NEXT ON 00118000 * THE COMMAND LINE. THE OPTION PROCESSORS SCAN FOR THE NEXT 00119000 * FIELD, VERIFY ITS VALIDITY, AND SET UP INFORMATION FOR USE BY 00120000 * THE LIST SCANNERS. SINCE THE OPERATIONAL DESCRIPTION OF EACH 00121000 * OF EACH COMMAND PROCESSOR REFERENCES THESE SUBROUTINES, A LIST 00122000 * OF THEIR NAMES AND FUNCTIONS IS GIVEN HERE; A DESCRIPTION OF 00123000 * THE OPERATIONAL LOGIC AND REGISTER SETS FOR EACH SUBROUTINE 00124000 * APPEAR AT THE END OF THE MODULE 00125000 * 00126000 * OPTION PROCESSORS - 00127000 * 1. GETUSER - SAVE THE USER ID OF THE FILE'S OWNER 00128000 * 2. GETYPE - SAVE THE FILE TYPE (OR DEVICE TYPE) 00129000 * 3. GETCOPY - LOCATE AND SAVE THE NUMBER OF COPIES REQUESTED 00130000 * 4. GETNAME - LOCATE AND SAVE THE FILE NAME (AND TYPE) 00131000 * 5. GETID - LOCATE AND SAVE THE SPOOLID OR CLASS 00132000 * 6. GETCLASS - LOCATE AND VERIFY THE CLASS REQUESTED (2ND LEVEL 00133000 * ROUTINE) 00134000 * 00135000 * LIST SCANNING ROUTINES - 00136000 * 2. GETFILE - LOCATE THE NEXT FILE OF THE CORRECT CLASS, ID, 00137000 * AND OWNER 00138000 * 3. GETCHAIN - LOCATE THE NEXT FILE CHAIN TO SEARCH (2ND 00139000 * LEVEL ROUTINE) 00140000 * 4. SETPEND - LOCATE AN AVAILABLE VIRTUAL READER AND 00141000 * POST AN PENDING DEVICE END INTERRUPT 00142000 * 00143000 *. 00144000 EJECT 00145000 COPY OPTIONS 00146000 SPACE 2 00147000 COPY LOCAL OPTIONS 00148000 DMKCSV CSECT 00149000 ID DC CL8'DMKCSV' MODULE NAME 00150000 SPACE 3 00151000 EXTRN DMKSCNFD 00152000 EXTRN DMKCKSPL @V304298 00153000 EXTRN DMKCVTDB,DMKCVTBD,DMKSPLDL 00154000 EXTRN DMKUDRFU,DMKERMSG 00155000 EXTRN DMKCSOSD,DMKSCNAU 00156000 EXTRN DMKVIOIN,DMKSTKIO @VM01016 00157000 SPACE 3 00158000 USING PSA,R0 00159000 USING SFBLOK,R7 00160000 USING BUFFER,R9 00161000 USING VMBLOK,R11 00162000 USING SAVEAREA,R13 00163000 USING VDEVBLOK,R8 @VA09639 00163500 EJECT 00164000 *. 00165000 * 00166000 * SUBROUTINE NAME - 00167000 * 00168000 * DMKCSVOR 00169000 * 00170000 * FUNCTION - 00171000 * 00172000 * TO PLACE THE CLOSED SPOOL FILES FOR A GIVEN DEVICE TYPE 00173000 * IN A SPECIFIED ORDER. FOR READER FILES, THE FILES WILL THEN 00174000 * BE READ IN BY THE VIRTUAL READER IN THE SPECIFIED SEQUENCE; 00175000 * FOR PRINTER OR PUNCH FILES, THEY WILL BE PROCESSED IN THAT 00176000 * SEQUENCE, BUT NOT NECESSARILY AT ONCE. SPOOLID CAN BE 00177000 * REPLACED BY CLASS. 00178000 * 00179000 * COMMAND LINE FORMAT - 00180000 * 00181000 * +-------+------------------------------------+ 00182000 * | ORDER | READER CLASS A ...... | 00183000 * | ORD | PRINTER SPOOLID ...... | 00184000 * | | PUNCH | 00185000 * +-------+------------------------------------+ 00186000 * 00187000 * READER PRINTER PUNCH CLASS 00188000 * R RDR P PRT PU PCH CL 00189000 * 00190000 * AND ARE CLASS D USER OPTIONS 00191000 * 00192000 * OPERATION - 00193000 * 00194000 * 1. IF CLASS D USER, CALL GETUSER. 00195000 * 2. CALL GETYPE- IF TYPE = 'ALL', EXIT 00196000 * GIVING ERROR MSG006E. 00197000 * 3. OR01- CALL GETID- IF NONE, GO TO STEP 6. 00198000 * 4. OR01A,OR02,OR03- IF NOT CLASS D USER, GO TO STEP 6. 00199000 * CALL GETFILE - TO LOCATE NEXT REQUESTED FILE. 00200000 * IF NONE AND SEARCH IS BY SPOOLID, EXIT GIVING 00201000 * MSG042E. IF NONE, GO TO STEP 3. 00202000 * UNCHAIN THE SELECTED SPOOL FILE AND RECHAIN 00203000 * TO THE PREVIOUS SELECTED FILE. 00204000 * 5. OR04- IF SEARCH IS BY CLASS, GO TO STEP 4: 00205000 * OTHERWISE, GO TO STEP 4. 00206000 * 6. OR05- IF NO SPOOLID OR CLASS OPTION PRESENT, EXIT 00207000 * GIVING MSG027E: OTHERWISE EXIT. 00208000 * 7. OR06- CALL GETFILE - IF NONE AND 00209000 * SEARCH IS BY SPOOLID, EXIT, GIVING MSG042E. 00210000 * OTHERWISE GO TO STEP 3. 00211000 * 8. OR06A- CALL INITSCAN TO LOCATE FIRST FILE FOR THIS 00212000 * USER. UPDATE SEARCH START ADDRESS. IF THE FILE 00213000 * IS THE REQUESTED FILE AND SEARCH IS BY SPOOLID, GO 00214000 * TO STEP 3. IF SEARCH BY CLASS GO STEP 7. 00215000 * UNCHAIN THE SELECTED SPOOL FILE BLOK, SAVE ADDRESS 00216000 * OF SLOT IN CHAIN. 00217000 * 9. CALL SFBSCAN TO LOCATE THE NEXT SPOOL FILE BLOK FOR 00218000 * THIS USER. IF NONE, RECHAIN THE PREVIOUS UNCHAINED 00219000 * SFBLOK. 00220000 * UNCHAIN THIS SFBLOK AND CHAIN THE PREVIOUS UNCHAINED 00221000 * BLOK IN TO THIS SLOT. 00222000 * IF THE CURRENT UNCHAINED BLOK IS THE REQUESTED 00223000 * SFBLOK, CHAIN IT INTO THE SLOT SAVED BY STEP 8, 00224000 * AND GO TO STEP 8. OTHERWISE GO TO STEP 9. 00225000 * 00226000 * RESPONSE - 00227000 * 00228000 * NNNN FILES ORDERED 00229000 * NO 00230000 * 00231000 * ERROR MESSAGES - 00232000 * 00233000 * DMKCSV003E INVALID OPTION - (OPTION) 00234000 * DMKCSV006E INVALID DEVICE TYPE - (ADDR) 00235000 * DMKCSV008E INVALID SPOOLID - (SPOOLID) 00236000 * DMKCSV026E OPERAND MISSING OR INVALID 00237000 * DMKCSV027E SPOOLID MISSING OR INVALID 00238000 * DMKCSV028E CLASS MISSING OR INVALID 00239000 * DMKCSV035E DEVICE TYPE MISSING OR INVALID 00240000 * DMKCSV042E SPOOLID NNNN DOES NOT EXIST 00241000 * 00242000 *. 00243000 EJECT 00244000 DMKCSVOR RELOC 00245000 SPACE 00246000 BAL R4,CLEAR CLEAR SAVEWRK1,4-9, 00247000 * SET VMUSER TO SAVEWK2-3, AND 00248000 * SAVEWRK5(2) TO FFFF 00249000 TM VMCLEVEL,VMCLASSD CLASS D USER ?? 00250000 BZ OR00 NO -- 00251000 L R3,FFS INDICATE TEST FOR USERID AND SYSTEM 00252000 BAL R4,GETUSER GET USERID @V200930 00253000 OR00 EQU * 00254000 BAL R4,GETYPE GET DEVICE TYPE @V200930 00255000 EX R5,CLIALL TYPE = ALL ?? 00256000 BE MSG006E YES - INVALID TYPE 00257000 SPACE 00258000 LR R2,R7 SET WORK START REGISTER 00259000 ST R7,SAVEWRK8 SAVE ADDRESS OF ANCHOR CHAIN 00260000 BAL R4,COUNT UPDATE FILE COUNT 00261000 SPACE 00262000 OR01 EQU * 00263000 BAL R4,GETID GET SPOOL ID @V200930 00264000 BNZ OR05 NO MORE SPOOLID'S 00265000 SPACE 00266000 CLC SAVEWRK1+2(2),ZEROES OPTION = ALL ?? 1ST CHECK 00267000 BNE OR01A NO 00268000 CLI SAVEWRK1,X'00' OPTION = ALL ?? 2ND CHECK 00269000 BE MSG008E OPTION WAS ALL - INVALID 00270000 OR01A OI SAVEWRK5+3,X'80' INDICATE AT LEAST ONE SPOOLID 00271000 CLI SAVEWRK2,X'40' CLASS D USER AND 'SYSTEM' ?? 00272000 BH OR06 NO -- NORMAL PROCESSING 00273000 OR02 EQU * 00274000 SLR R15,R15 NOT COUNT ONLY IN GETFILE HRC022DK 00274690 BAL R4,GETFILE GET NEXT SPOOL FILE @V200930 00275000 LTR R7,R7 SFBLOK PRESENT ?? 00276000 BNZ OR03 YES - PROCESS 00277000 LR R7,R2 RESET SEARCH ADDRESS 00278000 CLI SAVEWRK1,X'00' SEARCH BY CLASS 00279000 BNE OR01 YES -- 00280000 B MSG042E SPOOL ID NOT FOUND 00281000 SPACE 00282000 * GPR2 ADDRESS OF LAST SELECTED FILE 00283000 OR03 EQU * GPR6 ADDRESS OF PREVIOUS SFBLOK 00284000 * GPR7 ADDRESS OF CURRENT SFBLOK 00285000 SPACE 00286000 BAL R4,COUNT UPDATE FILE COUNT 00287000 C R7,0(R2) IS THIS BLOK NEXT ON CHAIN 00288000 BE OR04 YES - JUST UPDATE ADDRESS 00289000 L R3,0(R2) ADDRESS OF FIRST FILE ON SEARCH 00290000 * CHAIN 00291000 MVC 0(4,R6),0(R7) UNCHAIN SELECTED FILE 00292000 ST R3,0(R7) AND CHAIN BETWEEN THE 00293000 ST R7,0(R2) END OF THE SELECTED AND SEARCH 00294000 * CHAIN 00295000 OR04 EQU * 00296000 LR R2,R7 UPDATE SEARCH ADDRESS 00297000 CLI SAVEWRK1,X'00' IS SEARCH BY CLASS ?? 00298000 BNE OR02 YES -- GET NEXT FILE 00299000 B OR01 GET NEXT SPOOLID 00300000 SPACE 00301000 OR05 EQU * 00302000 TM SAVEWRK5+3,X'80' ANY SPOOLID ?? 00303000 BZ MSG027E NO -- SPOOLID MISSING 00304000 B CSVEXIT ALL DONE 00305000 SPACE 3 00306000 OR06 EQU * HERE TO PROCESS CLASS G USER ORDER COMMAND AND 00307000 * CLASS D USER WITHOUT 'SYSTEM' OPTION 00308000 L R7,SAVEWRK8 STARTING SEARCH ADDRESS 00309000 SLR R15,R15 NOT COUNT ONLY IN GETFILE HRC022DK 00309690 BAL R4,GETFILE GET NEXT SPOOL FILE @V200930 00310000 LTR R7,R7 ANY FILE FOUND ?? 00311000 BNZ OR06A YES --- 00312000 CLI SAVEWRK1,X'00' SEARCH BY CLASS ?? 00313000 BNE OR01 YES -- GET NEXT OPTION 00314000 B MSG042E SPOOLID NOT FOUND 00315000 SPACE 00316000 OR06A BAL R14,INITSCAN LOCATE 1ST FILE FOR THIS USER 00317000 SPACE 00318000 ST R7,SAVEWRK8 SAVE ADDRESS OF FIRST USER BLOK 00319000 BAL R4,COUNT UPDATE FILE COUNT 00320000 CLC SAVEWRK1(1),SFBCLAS RIGHT CLASS ?? 00321000 BE OR06 YES -- INORDER GET NEXT FILE 00322000 CLC SAVEWRK1+2(2),SFBFILID RIGHT SPOOLID ?? 00323000 BE OR01 YES -- GET NEXT SPOOLID 00324000 BCTR R14,0 COUNT -1 00325000 STH R14,SAVEWRK5 AND STORE 00326000 * 00327000 * SHIFT EACH FILE DOWN ONE TILL WE LOCATE CLASS OR ID EQUAL 00328000 * 00329000 MVC 0(4,R6),0(R7) UNCHAIN SPOOL FILE BLOK 00330000 LR R2,R6 SAVE ADDRESS OF PREVIOUS SFBLOK 00331000 SFBLOOP LR R3,R7 SAVE ADDRESS OF UNCHAIN SFBLOK 00332000 BAL R14,SFBSCAN LOCATE THE NEXT FILE FOR THIS USER 00333000 LTR R7,R7 FILE FOUND 00334000 BZ RECHAIN NO - BETTER RECHAIN THE LAST BLOK 00335000 * BACK 00336000 MVC 0(4,R3),0(R7) UNCHAIN THIS BLOK AND 00337000 ST R3,0(R6) AND CHAIN PREVIOUS UNCHAINED BLOK 00338000 * INTO THIS SLOT- 00339000 CLC SAVEWRK1(1),SFBCLAS IS THIS THE RIGHT CLASS ?? 00340000 BE FILEQ YES -- 00341000 CLC SAVEWRK1+2(2),SFBFILID IS THIS THE RIGHT SPOOLID ?? 00342000 BE FILEQ YES - 00343000 LR R6,R3 RESET SEARCH ADDRESS 00344000 B SFBLOOP KEEPING SHIFTING AND LOOKING 00345000 * FOR A EQUAL BLOK 00346000 SPACE 2 00347000 RECHAIN EQU * HERE TO RECHAIN THE UNCHAINED SFBLOK - 00348000 * NO MORE FILES FOR THIS USER 00349000 L R0,0(R2) ADDRESS OF SLOT FOR UNCHAINED SFBLOK 00350000 ST R3,0(R2) RECHAIN UNCHAINED SFBLOK 00351000 B OR01 GET NEXT OPTION - 00352000 SPACE 2 00353000 INITSCAN EQU * HERE TO LOCATE EACH SPOOL 00354000 * FILE FOR THIS USER AND RETURN THE 00355000 * ADDRESS IN GPR7 AND ADDRESS 00356000 * OF PREVIOUS SFBLOK IN GPR6 00357000 SPACE 00358000 L R6,SAVEWRK8 ADDRESS TO START SEARCH 00359000 SFBSCAN LR R7,R6 LOAD ADDRESS OF SEARCH START 00360000 L R7,0(R7) ADDRESS OF NEXT SFBLOK 00361000 LTR R7,R7 ANY MORE SFBLOKS ?? 00362000 BCR 8,R14 NO - RETURN WITH R7 ZERO 00363000 CLC SAVEWRK2(8),SFBUSER SFBLOK FOR THIS USER ?? 00364000 BCR 8,R14 YES - GPR7 ADDRESS OF SPFLOK 00365000 LR R6,R7 UPDATE PREVIOUS ADDRESS 00366000 B SFBSCAN KEEP LOOKING 00367000 SPACE 2 00368000 FILEQ EQU * HERE IF ORDER FILE FOUND AND IS NOT IN CORRECT ORDER 00369000 BAL R4,COUNT UPDATE FILE COUNT 00370000 L R0,0(R2) CHAIN THE SELECTED FILE INTO 00371000 ST R0,0(R7) CORRECT SLOT TO BE IN ORDER AS 00372000 ST R7,0(R2) REQUESTED BY THE USER 00373000 LR R6,R3 UPDATE ADDRESSES 00374000 LR R2,R3 .. 00375000 ST R7,SAVEWRK8 UPDATE NEW SEARCH START ADDRESS 00376000 CLI SAVEWRK1,X'00' WAS SEARCH BY CLASS ?? 00377000 BE OR01 NO - GET NEXT OPTION 00378000 B OR06 SEARCH BY CLASS - GET NEXT FILE 00379000 SPACE 00380000 EJECT 00381000 *. 00382000 * 00383000 * SUBROUTINE NAME - 00384000 * 00385000 * DMKCSVPU 00386000 * 00387000 * FUNCTION - 00388000 * 00389000 * TO DELETE SPOOL FILES FROM THE SYSTEM. FILES MAY BE PURGED BY 00390000 * SPECIFIC DEVICE, BY DEVICE TYPE, OR BY SPOOLID. SPOOLID MAY BE 00391000 * THE SPOOLID NUMBER(S), THE FILE CLASS, OR THE KEYWORD ALL. 00392000 * 00393000 * COMMAND LINE FORMAT - 00394000 * 00395000 * +-------+------------------------------------+ 00396000 * | | READER CLASS A ..... | 00397000 * | PURGE | PRINTER SPOOLID ..... | 00398000 * | PUR | PUNCH ALL | 00399000 * | | ALL --- | 00400000 * +-------+------------------------------------+ 00401000 * 00402000 * READER PRINTER PUNCH ALL CLASS 00403000 * R RDR P PRT PU PCH ALL CL 00404000 * 00405000 * 00406000 * AND ARE CLASS D USER OPTIONS 00407000 * 00408000 * OPERATION - 00409000 * 00410000 * 1. IF CLASS D USER, CALL GETUSER. 00411000 * 2. CALL GETYPE - IF TYPE = 'ALL', CALL DMKSCNFD TO LOCATE 00412000 * SPOOLID, IF NONE OR IF 'ALL' AND LAST OPERAND, GO TO 00413000 * STEP 4. 00414000 * 3. PU02- CALL GETID- IF NONE AND NO PREVIOUS SPOOLID, 00415000 * DEFAULT TO 'ALL' AND GO TO STEP 4. 00416000 * IF SPOOLID IS 'ALL' AND IS THE LAST SPOOLID, GO TO 00417000 * STEP 4. OTHERWISE, EXIT GIVING MSG003E. 00418000 * 4. PU03,PU04,PU06- CALL GETFILE: IF NONE AND SEARCH IS 00419000 * BY SPOOLID, EXIT GIVING ERROR MSG042E. IF SEARCH 00420000 * BY CLASS GO TO STEP 6. 00421000 * 5. PU05- UNCHAIN THE REQUESTED SPOOL FILE BLOK 00422000 * AND CALL DMKSPLDL TO DELETE THE FILE. 00423000 * IF SEARCH BY SPOOLID GO TO STEP 3: OTHERWISE, 00424000 * GO TO STEP 4. 00425000 * 6. PU07,PU08- IF TYPE = 'ALL', CALL GETCHAIN AND GO TO 00426000 * STEP 4. 00427000 * 7. PU09- EXIT 00428000 * 00429000 * RESPONSE - 00430000 * 00431000 * NNNN FILES PURGED 00432000 * NO 00433000 * 00434000 * ERROR MESSAGES - 00435000 * 00436000 * DMKCSV003E INVALID OPTION - (OPTION) 00437000 * DMKCSV006E INVALID DEVICE TYPE - (ADDR) 00438000 * DMKCSV008E INVALID SPOOLID - (SPOOLID) 00439000 * DMKCSV026E OPERAND MISSING OR INVALID 00440000 * DMKCSV028E CLASS MISSING OR INVALID 00441000 * DMKCSV035E DEVICE TYPE MISSING OR INVALID 00442000 * DMKCSV042E SPOOLID NNNN DOES NOT EXIST 00443000 *. 00444000 SPACE 3 00445000 DMKCSVPU RELOC 00446000 SPACE 00447000 BAL R4,CLEAR CLEAR SAVEWRK1,4-7, 00448000 * VMUSER TO SAVEWRK2-3, 00449000 * SAVEWRK5(2) TO FFFF 00450000 TM VMCLEVEL,VMCLASSD CLASS D USER ?? 00451000 BZ PU01 NO -- 00452000 L R3,FFS INDICATE TEST FOR 'SYSTEM' 00453000 BAL R4,GETUSER GET USERID @V200930 00454000 PU01 EQU * 00455000 BAL R4,GETYPE @V200930 00456000 ST R7,SAVEWRK9 SAVE FILE ANCHOR ADDRESS 00457000 EX R5,CLIALL TYPE = ALL ?? 00458000 BNE PU01A NO -- 00459000 OI SAVEWRK5+3,X'C0' SET SPOOLID AND ALL 00460000 * TYPE EQUAL ALL NEXT OPTION MUST BE NONE OR ALL 00461000 CALL DMKSCNFD 00462000 BNZ IDBLK NONE -- 00463000 C R0,F3 LENGTH OF 3 FOR 'ALL' 00464000 BNE MSG003E NO -- INVALID OPTION 00465000 CLC =C'ALL',0(R1) SPOOLID = 'ALL' ?? 00466000 BNE MSG003E NO - INVALID OPTION 00467000 IDBLK BAL R4,COUNT ZERO COUNT FIELD 00468000 B PU02B CHECK FOR EXTRA OPTION 00469000 PU01A EQU * 00470000 BAL R4,COUNT ZERO COUNT FIELD 00471000 PU02 EQU * 00472000 BAL R4,GETID GET SPOOL ID @V200930 00473000 BZ PU02A CLASS OR SPOOLID PRESENT 00474000 TM SAVEWRK5+3,X'80' CLASS OR SPOOLID PROCESSED ?? 00475000 BO PU09 YES -- 00476000 OI SAVEWRK5+3,X'A0' DEFAULT TO ALL 00477000 * SET 'ALL' AND SPOOLID PRESENT 00478000 B PU03 GO GET FILE 00479000 SPACE 00480000 PU02A OI SAVEWRK5+3,X'80' INDICATE AT LEAST ON SPOOLID 00481000 CLI SAVEWRK1,X'00' SPOOLID EQU ALL ?? 00482000 BNE PU03 NO - 00483000 CLC SAVEWRK1+2(2),ZEROES .. 00484000 BNE PU03 NO -- SPOOLID NOT 'ALL' 00485000 PU02B EQU * 00486000 OI SAVEWRK5+3,X'20' INDICATE SPOOLID 'ALL' 00487000 CALL DMKSCNFD CHECK FOR EXTRA OPTION 00488000 BZ MSG003E YES -- INVALID OPTION 00489000 PU03 L R7,SAVEWRK9 RESTORE FILE CHAIN POINTER 00490000 PU04 EQU * 00491000 SLR R15,R15 NOT COUNT ONLY IN GETFILE HRC022DK 00491690 BAL R4,GETFILE GET NEXT SPOOL FILE @V200930 00492000 LTR R7,R7 SFBLOK PRESENT ?? 00493000 BZ PU06 NO - 00494000 PU05 MVC 0(4,R6),SFBPNT UNCHAIN CURRENT SFBLOK 00495000 CALL DMKSPLDL PURGE THIS FILE 00496000 BAL R4,COUNT UPDATE FILE COUNT 00497000 CLC SAVEWRK1+2(2),ZEROES SPOOLID PRESENT?? 00498000 BNE PU02 YES -- GET NEXT OPTION 00499000 B PU03 GET NEXT FILE 00500000 SPACE 00501000 PU06 CLC SAVEWRK1+2(2),ZEROES SPOOLID PRESENT ?? 00502000 BNE MSG042E YES - SPOOL FILE NOT FOUND 00503000 SPACE 00504000 PU07 TM SAVEWRK5+3,X'40' TYPE = 'ALL' ?? 00505000 BO PU08 YES -- 00506000 TM SAVEWRK5+3,X'20' SPOOLID DEFAULT 'ALL' 00507000 BO PU09 YES -- EXIT - NO MORE SPOOLIDS 00508000 B PU02 NO - GET NEXT SPOOLID 00509000 SPACE 00510000 PU08 EQU * 00511000 BAL R3,GETCHAIN GET NEXT ORDERED CHAIN @V200930 00512000 LTR R6,R6 END OF PUNCH CHAIN 00513000 BZ PU09 YES- EXIT 00514000 ST R7,SAVEWRK9 SAVE ADDRESS OF NEW CHAIN 00515000 B PU04 GET NEXT FILE 00516000 SPACE 00517000 SPACE 00518000 PU09 B CSVEXIT 00519000 EJECT 00520000 SPACE 3 00521000 * ***EXECUTED INSTRUCTIONS*** 00522000 CLIALL CLI =AL1(CSVRDR+TYPPRT+TYPPUN),X'00' MASK = READER PRINTER 00523000 * PUNCH 00524000 TMRDR TM =AL1(CSVRDR),X'00' MASK = READER 00525000 TMPRT TM =AL1(TYPPRT),X'00' MASK = PRINTER 00526000 TMPUN TM =AL1(TYPPUN),X'00' MASK = PUNCH 00527000 EJECT 00528000 *. 00529000 * 00530000 * SUBROUTINE NAME - 00531000 * 00532000 * DMKCSVTR 00533000 * 00534000 * FUNCTION - 00535000 * 00536000 * TO TRANSFER A SPOOL FILE TO ANOTHER USER AND/OR HRC022DK 00537290 * ANOTHER TYPE OF UNIT RECORD DEVICE WITHOUT PROCESSING HRC022DK 00537580 * BY THE VIRTUAL MACHINE. SPOOLID MAY BE ID NUMBER, HRC022DK 00537870 * CLASS, OR THE KEYWORD ALL. ONLY PRT FILES WILL BE HRC022DK 00538160 * TRANSFERRED TO A PRINTER, AND ONLY PUN FILES TO A HRC022DK 00538450 * PUNCH. DMP (SYSTEM DUMP) FILES AND RDR FILES MAY HRC022DK 00538740 * ONLY BE TRANSFERRED TO ANOTHER READER. HRC022DK 00539030 * 00540000 * COMMAND LINE FORMAT - 00541000 * 00542000 * +----------+--------------------------------------------+HRC022DK 00543790 * | TRANSFER | SPOOLID < TO > USERID |HRC022DK 00544580 * | TRAN | CLASS A ALL |HRC022DK 00545370 * | | ALL |HRC022DK 00546160 * | | --- --- |HRC022DK 00546950 * +----------+--------------------------------------------+HRC022DK 00547740 * HRC022DK 00548530 * HRC022DK 00549320 * CLASS ALL TO FROM READER PRINTER PUNCH HRC022DK 00550110 * CL ALL T F R RDR P PRT PU PCH HRC022DK 00550900 * 00552000 * 00553000 * AND ARE CLASS D USER OPTIONS 00554000 * 00555000 * OPERATION - 00556000 * 00557000 * 1. IF CLASS D USER, CALL GETUSER. 00558000 * 2. CALL GETID 00559000 * 3. CALL GETUSER 00560000 * 4. CALL GETFILE: IF NONE AND SEARCH IS BY SPOOLID, 00561000 * EXIT GIVING ERROR MSG042E. IF NONE, EXIT. 00562000 * MOVE USERID TO SFBUSER. BAL R4 SETPEND TO LOCATE 00563000 * VIRTUAL READER AND POST DEVICE END INTERRUPT. 00564000 * NOTIFY SENDER AND RECEIVER. IF SEARCH BY CLASS OR ALL, 00565000 * GO TO STEP 4: OTHERWISE EXIT 00566000 * 00567000 * RESPONSE - 00568000 * 00569000 * XXX FILE NNNN TRANSFERRED FROM USERID HRC022DK 00570390 * FILE NNNN TRANSFERRED TO USERID XXX HRC022DK 00570780 * HRC022DK 00571170 * FILE NNNN CANNOT BE TRANSFERRED TO XXX HRC022DK 00571560 * 00572000 * NNNN FILES TRANSFERRED 00573000 * NO 00574000 * 00575000 * ERROR MESSAGES - 00576000 * 00577000 * DMKCSV003E INVALID OPTION - (OPTION) 00578000 * DMKCSV007E INVALID USERID - (USERID) 00579000 * DMKCSV008E INVALID SPOOLID - (SPOOLID) 00580000 * DMKCSV020E USERID MISSING OR INVALID 00581000 * DMKCSV026E OPERAND MISSING OR INVALID 00582000 * DMKCSV027E SPOOLID MISSING OR INVALID 00583000 * DMKCSV028E CLASS MISSING OR INVALID 00584000 * DMKCSV042E SPOOLID NNNN DOES NOT EXSIT 00585000 * DMKCSV053E (USERID) NOT IN CP DIRECTORY 00586000 *. 00587000 EJECT 00588000 DMKCSVTR RELOC 00589000 SPACE 00590000 BAL R4,CLEAR CLEAR SAVEWRK1,4-9, 00591000 * VMUSER TO SAVEWRK2-3, 00592000 * SAVEWRK5(2) TO X'FFFF' 00593000 TM VMCLEVEL,VMCLASSD IS THIS A CLASS D USER ?? @V200930 00594000 BZ TR01 NO, CONT @V200930 00595000 L R3,FFS SET R3 TO SEARCH FOR USERID OR @V200930 00596000 * SYSTEM 00597000 BAL R4,GETUSER FIND USERID OR SYSTEM OR NEITHER @V200930 00598000 TR01 EQU * HRC022DK 00599090 MVC SAVEWRK8(8),BUFNXT-BUFFER(R9) SAVE SCAN POINTERSHRC022DK 00599180 L R3,X40FFS SIGNAL TRANSFER CHAIN 1 HRC022DK 00599270 BAL R4,GETYPE GET TYPE OF CHAIN 1 HRC022DK 00599360 ST R7,SAVEWRK9 SAVE FOR LATER HRC022DK 00599450 LR R10,R7 DUMMY CHAIN 2 ANCHOR FOR 'FROM' HRC022DK 00599540 BAL R4,GETID GET SPOOL ID HRC022DK 00599630 BZ TR02 SPOOLID PRESENT 00600000 SPACE 00601000 C R3,FFS CLASS D AND 1ST OPERAND UNKNOWN ?? 00602000 BE MSG026E YES - OPERAND MISSING OR INVALID 00603000 B MSG027E SPOOLID MISSING OR INVALID 00604000 SPACE 00605000 TR02 EQU * HRC022DK 00606990 MVC SAVEWRK6(8),SAVEWRK2 SAVE SENDER ID 00609000 CALL DMKSCNFD LOCATE KEYWORD 'TO' 00610000 BNZ MSG020E USERID MISSING 00611000 LR R3,R0 COUNT 00612000 BCTR R3,0 -1 00613000 EX R3,CLCTO TO ??? 00614000 BE TR04 YES, TO USERID @V200930 00615000 C R0,F4 MORE THAN 4 CHARS ?? @V200930 00616000 BH TR05 YES, MUST BE USERID @V200930 00617000 EX R3,CLCFROM IS IT FROM USERID ?? @V200930 00618000 BNE TR05 NO, MUST BE USERID FOR TO @V200930 00619000 OI SAVEWRK5+3,X'40' FLAG TO RECLAIM FILES @V200930 00620000 B TR04 GET USERID @V200930 00621000 SPACE 00622000 TR05 BAL R4,GU02 VALIDATE THE USERID @V200930 00623000 B TR05A CONT @V200930 00624000 TR04 BAL R4,GETUSER GET AND VALIDATE THE USERID @V200930 00625000 TR05A TM SAVEWRK5+3,X'40' IS IT A RECLAIM OF FILES ?? @V200930 00626000 BO RC02 YES, DO RECLAIM @V200930 00627000 BAL R4,COUNT ZERO COUNT FIELD 00628000 L R10,SAVEWRK9 save chain 1 address HRC311DK 00628100 MVC SAVEWRK8(8),SAVEWRK2 SAVE USER ID 00629000 MVC SAVEWRK2(8),SAVEWRK6 MOVE IN SENDER ID 00630000 L R3,XRIGHT24 SIGNAL TRANSFER CHAIN 2 HRC022DK 00630200 BAL R4,GETYPE GET TYPE OF CHAIN 2 HRC022DK 00630400 LR R4,R10 save chain 1 address HRC311DK 00630410 LR R1,R10 save chain 1 address HRC311DK 00630420 LR R10,R7 SAVE ANCHOR CHAIN 2 HRC022DK 00630600 LR R7,R4 restore chain 1 address HRC311DK 00630810 XC SAVEWRK7(4),SAVEWRK7 CLEAR FOR COUNT @VA06206 00631000 L R15,X2048BND TELL GETFILE WE ARE COUNTING HRC022DK 00632690 BAL R4,GETFILE COUNT FILES TO BE TRANSFERRED @VA06206 00633000 SR R15,R15 RESET THE COUNTING SWITCH HRC022DK 00634590 LR R7,R1 restore chain 1 address HRC311DK 00634689 B TR06 START SEARCH HRC022DK 00634770 SPACE , HRC022DK 00634860 TRNOT EQU * HRC022DK 00634950 LA R0,TRBADSIZ LENGTH IN DWDS WE NEED HRC022DK 00635040 CALL DMKFREE GET THE MESSAGE BUFFER HRC022DK 00635130 ST R8,TRANCH1-TRBADMSG(R1) SAVE CHAIN1 PTR IN BUFF HRC022DK 00635220 LR R8,R1 MOVE THE MESSAGE BUFF ADDR HRC022DK 00635310 USING TRBADMSG,R8 MESSAGE TO FREE STORAGE HRC022DK 00635400 MVC TRBADMSG(L'MSG2INIT),MSG2INIT DITTO HRC022DK 00635490 LH R1,SFBFILID GET FILEID HRC022DK 00635580 CALL DMKCVTBD CONVERT TO DECIMAL HRC022DK 00635670 STCM R1,B'1111',TRBADID STORE SPOOLID IN MESSAGE HRC022DK 00635760 MVC TRBADC,=C'PRT' ASSUME TRYING TO GO TO PRT QUEUE HRC022DK 00635850 EX R5,TMPRT WERE WE RIGHT ? HRC022DK 00635940 BO TRNOTSET YES - SETUP MESSAGE HRC022DK 00636030 MVC TRBADC,=C'PUN' NO - MUST HAVE BEEN GOING TO PCH HRC022DK 00636120 TRNOTSET LA R0,TRBADL LENGTH OF MESSAGE HRC022DK 00636210 LA R1,TRBADMSG POINT TO MESSAGE HRC022DK 00636300 LA R2,NORET+DFRET TELL QCNWT TO RELEASE BUFF HRC022DK 00636390 LA R3,TRBADSIZ NR DW'S IN MSG HRC022DK 00636480 L R8,TRANCH1 RESTORE R8 AS CHAIN POINTER HRC022DK 00636570 DROP R8 , HRC022DK 00636660 CALL DMKQCNWT,PARM=NORET WRITE MESSAGE TO USER HRC022DK 00636750 TR06 EQU * HRC022DK 00636840 BAL R4,GETFILE GET NEXT SPOOL FILE @V200930 00638000 LTR R7,R7 LAST SFBLOK ?? 00639000 BZ TR09 YES - 00640000 OI SAVEWRK5+3,X'80' INDICATE AT LEAST ONE FILE 00641000 LR R9,R6 NOTE CURRENT PLACE IN THE QUEUE HRC022DK 00641040 CR R8,R10 CHAIN 1 = CHAIN 2 ? HRC022DK 00641080 BE GOTONE YES - GO MOVE THIS FILE HRC022DK 00641120 EX R5,TMRDR GOING TO A RDR ? HRC022DK 00641160 BO DEQUEUE YES - GO AND DEQUEUE HRC022DK 00641200 TM SFBFLAG,SFBDUMP SYSTEM DUMP FILE ? HRC022DK 00641240 BO TRNOT YES - MUST STAY ON RDR QUEUE HRC022DK 00641280 CLI SFBTYPE,TYPRDR FILE OF TYPE RDR ? HRC022DK 00641320 BE TRNOT YES - MUST STAY ON RDR QUEUE HRC022DK 00641360 EX R5,TMPRT GOING TO A PRT ? HRC022DK 00641400 BO CHKPRT YES - CHECK IT'S A PRT FILE HRC022DK 00641440 TM SFBTYPE,TYPPRT FILE OF TYPE PRT ? HRC022DK 00641480 BZ DEQUEUE NO - MUST BE A REAL PCH FILE HRC022DK 00641520 B TRNOT YES - CAN'T GO TO A PCH QUEUE HRC022DK 00641560 CHKPRT TM SFBTYPE,TYPPRT FILE OF TYPE PRT ? HRC022DK 00641600 BZ TRNOT NO - CAN'T GO TO A PRT QUEUE HRC022DK 00641640 DEQUEUE EQU * HRC022DK 00641680 MVC 0(4,R6),SFBPNT UNCHAIN IT HRC022DK 00641720 LR R6,R10 POINT TO CHAIN 2 HRC022DK 00641760 B TR06A GO AND RECHAIN IT HRC022DK 00641800 SPACE , HRC022DK 00641840 GOTONE EQU * HRC022DK 00641880 CLC SFBUSER(8),SAVEWRK8 USER TRAN OWN TO SELF 00642000 BE TR06 NO -- MSG 00643000 SPACE 00644000 TR06C CLC SFBPNT,ZEROES LAST SFBLOK ON CHAIN ?? @V200930 00645000 BE TR07 YES -- 00646000 MVC 0(4,R6),SFBPNT UNCHAIN SELECTED SFBLOK 00647000 TR06A L R14,0(R6) ADDRESS OF NEXT SFBLOK 00648000 LTR R14,R14 IS THERE ONE ?? 00649000 BZ TR06B NO -- 00650000 LR R6,R14 UPDATE TO NEXT SFBLOK 00651000 B TR06A KEEP LOOKING FOR END 00652000 SPACE 00653000 TR06B ST R7,0(R6) CHAIN SELECTED SFBLOK TO END 00654000 SR R15,R15 CLEAR FORWARD 00655000 ST R15,SFBPNT POINTER 00656000 SPACE 00657000 TR07 BAL R4,COUNT UPDATE FILE COUNT 00658000 OI SFBFLAG,SFBINUSE TELL EVERYONE WE HAVE THE FILE HRC022DK 00658010 LA R0,TRANSIZE LENGTH IN DWDS WE NEED @VA10097 00658020 CALL DMKFREE GET THE MESSAGE BUFFER @VA10097 00658030 ST R8,TRANCH1-TRANMSG(R1) SAVE CHAIN1 PTR IN BUFF @VA10097 00658040 LR R8,R1 MOVE THE MESSAGE BUFF ADDR @VA10097 00658050 USING TRANMSG,R8 MESSAGE TO FREE STORAGE @VA10097 00658060 LA R3,1 INITIALIZE R3 @VA10097 00658070 MVC TRANMSG(MSGINITL),MSGINIT INITIALIZE MESSAGE @VA10097 00658080 OI SFBFLAG,SFBINUSE TELL EVERYONE WE HAVE THE FILE @VA09638 00658500 MVC TRMSGUR(8),SFBUSER MOVE IN SENDER ID 00659000 MVC SFBUSER(8),SAVEWRK8 MOVE USER ID TO SFBLOK 00660000 LA R2,RDRCHN ASSUME FILE IS NOW ON RDR HRC022DK 00660100 EX R5,TMRDR ARE WE CORRECT ? HRC022DK 00660200 BO TRCKS YES - GO DO CHECKPOINT HRC022DK 00660300 LA R2,PRTCHN ASSUME FILE IS NOW ON PRT HRC022DK 00660400 EX R5,TMPRT ARE WE CORRECT ? HRC022DK 00660500 BO TRCKS YES - GO DO CHECKPOINT HRC022DK 00660600 LA R2,PCHCHN MUST BE NOW ON PCH HRC022DK 00660700 TRCKS LA R2,CHGSFB(,R2) SIGNAL CHANGE FUNCTION HRC022DK 00660800 CALL DMKCKSPL,PARM=CHGSFB CHECKPOINT @V304298 00661000 LH R1,SFBFILID GET AND CONVERT NEW FILID 00662000 CALL DMKCVTBD 00663000 STCM R1,B'1111',TRMSGID STORE SPOOLID IN MSG 00664000 MVC TRMSGF,=C'RDR' ASSUME NOW A RDR FILE HRC022DK 00664100 EX R5,TMRDR WERE WE RIGHT ? HRC022DK 00664200 BO MSGSET YES - GO SETUP MSG HRC022DK 00664300 MVC TRMSGF,=C'PRT' ASSUME NOW A PRT FILE HRC022DK 00664400 EX R5,TMPRT WERE WE RIGHT ? HRC022DK 00664500 BO MSGSET YES - GO SETUP MSG HRC022DK 00664600 MVC TRMSGF,=C'PUN' MUST BE NOW A PCH FILE HRC022DK 00664700 MSGSET EQU * HRC022DK 00664800 LA R0,8 LENGTH OF USERID 00665000 LA R1,SAVEWRK8 ADDRESS OF THE TO 'USERID' 00666000 CALL DMKSCNAU LOCATE USERID VMBLOK 00667000 BNZ TRNOMSG @VA09926 00667500 SWTCHVM SWITCH TO RECEIVER @VA09685 00668100 TM VMMLEVEL,VMMSGON RECEIVER RECEIVING MESSAGES ?? 00672000 BZ TRNOMSG NO - 00673000 TM VMMLVL2,VMMIMSG USER WANT INFORMATION MSG ? @VM03039 00674000 BZ TRNOMSG NO - SUPPRESS IT @VM03039 00675000 MVC TRMCONST(6),=C' FROM ' 00676000 LA R0,TRANL LENGTH OF MESSAGE 00678000 LA R1,TRANMSG ADDRESS OF MESSAGE 00679000 L R2,=A(NOTRESP) SET NON-RESPONSE MESSAGE @V60C2B8 00680000 CALL DMKQCNWT,PARM=NORET(,R2) WRITE MSG TO RECEIVER @V60C2B8 00681000 SPACE 00682000 TRNOMSG EQU * 00683000 L R1,SAVER11 GET CALLERS VMBLOK @V407510 00684000 SWTCHVM SWITCH BACK TO CALLER @V407510 00685000 MVC TRMCONST(6),=C' TO ' 00686000 MVC TRMSGUR(8),SAVEWRK8 MOVE TO USER ID 00687000 MVC TRMSGT,TRMSGF MOVE IN CORRECT CHAIN NAME HRC022DK 00687200 TM SAVEWRK5+3,X'40' RECLAIMING FILE ? HRC022DK 00687400 BO TR08 YES - SKIP MESSAGE HRC022DK 00687600 CLC VMUSER(8),SAVEWRK8 TRANS TO SELF NO MSG 00688000 BE TR08 YES - 00689000 TM VMMLVL2,VMMIMSG USER WANT INFORMATION MSG ? @VM03039 00690000 BZ TR08 NO - SUPPRESS IT @VM03039 00691000 LA R0,TRANL LENGTH OF MESSAGE 00692000 LR R1,R8 ADDRESS OF THE MESSAGE @VA10097 00693100 LA R3,TRANSIZE NR DW'S IN MSG @VA10097 00693200 LA R2,NORET+DFRET TELL QCNWT TO RELEASE BUFF @VA10097 00693300 L R8,TRANCH1 RESTORE R8 AS CHAIN POINTER @VA10097 00693400 CALL DMKQCNWT TELL SENDER @VA10097 00693500 SLR R3,R3 THE BUFFER HAS BEEN FRETTED @VA10097 00693600 TR08 EQU * 00695000 LTR R1,R3 DO WE NEED TO RELEASE BUFF @VA10097 00695010 BZ TR08A ALREADY GONE @VA10097 00695015 LR R1,R8 GET BUFFER ADDR FOR DMKFRET @VA10097 00695020 L R8,TRANCH1 RESTORE R8 AS CHAIN POINTER @VA10097 00695025 DROP R8 FINISHED @VA10097 00695030 LA R0,TRANSIZE NR OF DWDS IN MESSAGE BUFFER @VA10097 00695035 CALL DMKFRET RELEASE MESSAGE BUFFER @VA10097 00695040 TR08A DS 0H @VA10097 00695045 TM VMCLEVEL,VMCLASSD IS THIS USER CLASS D? @VA10097 00695050 BZ TR08AB NO; GO INDICATE THIS @VA10097 00695055 L R3,FFS YES; LOAD 'CLASS D' FLAG @VA10097 00695060 B *+8 NOW CONTINUE PROCESSING @VA10097 00695065 TR08AB L R3,XRIGHT24 NOT CLASS D USER @VA10097 00695070 EX R5,TMRDR GOING TO RDR ? HRC022DK 00695110 BZ *+8 NO - SKIP THE INTERRUPT HRC022DK 00695150 BAL R4,SETPEND POST DEVICE END INTERRUPT @VA09134 00695200 NI SFBFLAG,255-SFBINUSE WE ARE DONE WITH THIS FILE @VA09638 00695500 EX R5,TMRDR GOING TO A RDR ? HRC022DK 00695550 BO NOSTART YES - DON'T TRY TO START READER HRC022DK 00695600 TM SFBFLAG,SFBUHOLD+SFBSHOLD IS FILE HELD ? HRC022DK 00695650 BNZ NOSTART YES - SKIP THE START HRC022DK 00695700 C R10,SAVEWRK9 CHAIN 2 = CHAIN 1 HRC022DK 00695750 BE NOSTART YES - NO NEED TO TRY STARTING HRC022DK 00695800 CALL DMKCSOSD TRY TO START REAL PRT/PCH HRC022DK 00695850 NOSTART EQU * HRC022DK 00695900 CLC SAVEWRK1+2(2),ZEROES SPOOLID ?? 00696000 BNE CSVEXIT YES EXIT -- 00697000 LR R7,R9 RESUME AT SAME PLACE IN QUEUE HRC022DK 00698490 TM SAVEWRK5+3,X'40' TRANSFER FILE FROM? @VA01375 00699000 BO RC04 YES -- @VA01375 00700000 CLC SAVEWRK5(2),SAVEWRK7 ARE THE COUNTS EQUAL @VA06206 00701000 BNL CSVEXIT SURE ARE GET OUT @VA06206 00702000 B TR06 TRANS FILE TO @VA01375 00703000 TR09 CLC SAVEWRK1+2(2),ZEROES SEARCH BY SPOOLID ?? 00704000 BE CSVEXIT NO -- EXIT 00705000 TM SAVEWRK5+3,X'80' FILE FOUND ?? 00706000 BZ MSG042E NO -- ERROR MSG DMKCSV042E 00707000 B CSVEXIT EXIT 00708000 SPACE 00709000 MSGINIT DC C'RDR ' @VA10097 00710000 DC C'FILE ' @VA10097 00710100 DC CL5' ' @VA10097 00710200 DC C'TRANSFERRED' @VA10097 00710300 DC C' FROM ' @VA10097 00710400 DC CL8' ' @VA10097 00710500 MSGINITL EQU *-MSGINIT @VA10097 00710600 DS 0H 00724000 MSG2INIT DC C'FILE NNNN CANNOT BE TRANSFERRED TO XXX' HRC022DK 00724500 SPACE 00725000 RC02 BAL R4,COUNT ZERO COUNT @V200930 00726000 L R7,SAVEWRK9 SET TO READER CHAIN HRC022DK 00727690 RC04 DS 0H @VA09640 00728400 SLR R15,R15 NOT COUNT ONLY IN GETFILE HRC022DK 00728690 BAL R4,GETFILE GET A SPOOL FILE @VA09640 00728800 LTR R7,R7 TEST FOR A FILE @V200930 00729000 BZ TR09 NONE, RETURN @V200930 00730000 OI SAVEWRK5+3,X'80' SHOW ONE FILE FOUND @V200930 00731000 LR R9,R6 NOTE CURRENT PLACE IN THE QUEUE HRC022DK 00731500 CLI SAVEWRK6,C' ' SYSTEM SEARCH FOR ALL USERS ?? @V200930 00732000 BE RC03 YES .... WOW !! @V200930 00733000 CLC SFBORIG,SAVEWRK6 DID THIS USER ORIGINATE FILE ??@V200930 00734000 BNE RC04 NO, CONT @V200930 00735000 RC03 CLC SFBUSER,SFBORIG DOES HE OWN IT ALREADY ?? @V200930 00736000 BE RC04 YES, CONT @V200930 00737000 MVC SAVEWRK8(8),SFBORIG SET NEW OWNER IN SAVEWRK8 @V200930 00738000 B TR06C TRANSFER LOGIC @V200930 00739000 EJECT 00740000 *. 00741000 **************************************** 00742000 * 00743000 * SUBROUTINES 00744000 * 00745000 **************************************** 00746000 * 00747000 * 00748000 * 00749000 * OPERATION OF GETUSER - 00750000 * 00751000 * 1. CALL DMKSCNFD TO LOCATE USERID: 00752000 * IF NONE, EXIT GIVING ERROR MSG020E. 00753000 * 2. IF GPR3 = FFS AND OPTION = 'SYSTEM', RETURN TO CALLER 00754000 * 3. CALL DMKUDRFU: VERIFY USERID. 00755000 * IF INVALID AND GPR3 = FFS, RETURN TO CALLER 00756000 * IF INVALID OR MISSING EXIT GIVING ERROR MSG020E. 00757000 * 4. MOVE USERID TO SAVEWRK2,3 AND RETURN TO CALLER. 00758000 *. 00759000 SPACE 3 00760000 GETUSER EQU * HERE TO MOVE USERID TO SAVEWRK2,3 00761000 SPACE 00762000 GU01 EQU * 00763000 C R3,FFS TEST FOR 'SYSTEM' OR 1ST USERID ? 00764000 BNE *+10 NO -- 00765000 MVC SAVEWRK6(8),BUFNXT-BUFFER(R9) SAVE SCAN POINTERS 00766000 CALL DMKSCNFD LOCATE USERID 00767000 BZ GU02 OPTION PRESENT 00768000 C R3,FFS TEST FOR SYSTEM ?? 00769000 BE GU02C YES -- 00770000 B MSG020E USERID MISSING 00771000 SPACE 00772000 GU02 MVC SAVEWRK2(8),BLANKS RESET USERID SAVE AREA 00773000 C R0,F8 LENGTH GREATER THAN EIGHT ?? 00774000 BNH GU02A 00775000 C R3,FFS TEST FOR 'SYSTEM' OR FIRST USERID ?? 00776000 BE GU02C YES -- 00777000 B MSG007E INVALID USERID MESSAGE 00778000 SPACE 00779000 GU02A C R3,FFS TEST FOR 'SYSTEM' ?? 00780000 BNE GU02B NO -- 00781000 C R0,F6 LENGTH OF 'SYSTEM' 00782000 BNE GU02B NO -- WRONG LENGTH 00783000 CLC =C'SYSTEM',0(R1) OPTION = 'SYSTEM' ?? 00784000 BNE GU02B NO -- CONT 00785000 BALR R3,R4 RESET GPR3 AND RETURN 00786000 SPACE 00787000 GU02B EQU * HRC022DK 00788080 CL R0,F1 A ONE-CHARACTER USERID? HRC022DK 00788160 BNE GU02E NO... HRC022DK 00788240 CLI 0(R1),C'*' IS FOR MYSELF? HRC022DK 00788320 BNE GU02E NO... HRC022DK 00788400 LA R0,8 SETUP FOR 8 BYTE MOVE HRC022DK 00788480 LA R1,VMUSER POINT TO MY OWN USERID HRC022DK 00788560 B GU03 SKIP UN-NECESSARY VALIDATION HRC022DK 00788640 GU02E EQU * HRC022DK 00788720 SR R2,R2 PARM REG HRC022DK 00788800 CALL DMKUDRFU VERIFY USER 00789000 BZ GU03 VALID USERID 00790000 TM SAVEWRK5+3,X'40' IS IT A RECLAIM FUNCTION ?? @V200930 00791000 BZ GU02D NO, CONT @V200930 00792000 C R0,F3 IS IT 3 CHARS ?? @V200930 00793000 BNE GU02D NO, CONT @V200930 00794000 CLC 0(3,R1),=CL3'ALL' IS IT ALL OPTION ?? @V200930 00795000 BNE GU02D NO, CONT @V200930 00796000 BALR R3,R4 RETURN WITH USERID BLANK @V200930 00797000 GU02D DS 0H @V200930 00798000 C R3,FFS CLASS D WITH USERID ?? 00799000 BNE MSG053E NO -- INDICATE ERROR 00800000 GU02C MVC SAVEWRK2(8),VMUSER MOVE IN CLASS D USERID 00801000 MVC BUFNXT-BUFFER(8,R9),SAVEWRK6 RESET SCAN POINTERS 00802000 BR R4 RETURN TO CALLER 00803000 GU03 LR R14,R0 COUNT 00804000 BCTR R14,0 -1 00805000 EX R14,MVCID MOVE USER ID FROM COMMAND LINE TO 00806000 * SAVEWRK2,3 00807000 BALR R3,R4 RESET GPR3 AND RETURN TO CALLER 00808000 SPACE 00809000 MVCID MVC SAVEWRK2(0),0(R1) ***EXECUTED*** 00810000 SPACE 3 00811000 CLEAR XC SAVEWRK4(24),SAVEWRK4 CLEAR SAVEWRK AREA 00812000 XC SAVEWRK1(4),SAVEWRK1 00813000 MVC SAVEWRK2(8),VMUSER MOVE IN USERID 00814000 MVC SAVEWRK5(2),FFS SET TO X'FFFF' 00815000 BR R4 RETURN TO CALLER 00816000 SPACE 3 00817000 COUNT EQU * HERE TO UPDATE FILE COUNT 00818000 LH R14,SAVEWRK5 GET COUNT 00819000 LA R14,1(R14) UPDATE BY ONE AND 00820000 STH R14,SAVEWRK5 STORE 00821000 BR R4 RETURN TO CALLER 00822000 EJECT 00823000 *. 00824000 * 00825000 * OPERATION OF GETYPE - 00826000 * 00827000 * 1. CALL DMKSCNFD TO LOCATE DEVICE TYPE FIELD 00828000 * 2. IF OPTION = 'READER', 'PRINT', 'PUNCH' OR 'ALL', SET 00829000 * GPR5 = APPROPRIATE DEVICE TYPE AND GO TO STEP 3. 00830000 * IF OPTION = 'ALL', SET GPR5 EQUAL TO CSVRDR+TYPPRT+ 00831000 * TYPPUN, AND GO TO STEP 3. 00832000 * IF TEST FOR SYSTEM OR 1ST USERID, EXIT GIVING MSG003E. 00833000 * OTHERWISE EXIT GIVING MSG0006E. 00834000 * 3. SET GPR6 TO FFS, CALL GETCHAIN (GPR6 WILL BE FILLED BY 00835000 * GETCHAIN WITH THE APPROPRIATE FILE CHAIN ANCHOR) 00836000 * 4. EXIT 00837000 *. 00838000 SPACE 3 00839000 GETYPE EQU * 00840000 SPACE 00841000 GT01 LA R5,CSVRDR+TYPPRT+TYPPUN SET FOR ALL TYPE 00842000 CALL DMKSCNFD LOCATE DEVICE TYPE FIELD 00843000 STM R0,R1,SAVEWRK6 SAVE COUNT AND ADDRESS OF TYPE 00844000 BZ GT02 OPTION PRESENT 00845000 C R3,XRIGHT24 TRANS CHAIN 2? HRC022DK 00845300 BE TRCHRDR2 YES, DEFAULT TO RDR HRC022DK 00845600 C R3,FFS CLASS D USER ?? 00846000 BE MSG026E YES -- OPERAND MISSING 00847000 B MSG035E DEVICE TYPE MISSING 00848000 SPACE 00849000 GT02 EQU * 00850000 * GPR1 ADDRESS OF TYPE 00851000 LR R14,R0 GET OPTION COUNT 00852000 BCTR R14,0 -1 00853000 C R0,F2 COUNT LENGTH OF 2 00854000 BE GT02A VALID FOR PUNCH 00855000 BL GT02B VALID FOR READER PRINTER 00856000 EX R14,CLCALL ALL ?? 00857000 BE TYPALL YES, CHECK IF ITS TRANSFER HRC022DK 00858490 LA R5,CSVRDR SET R5 TO READER TYPE 00859000 EX R14,CLCRDR RDR ?? 00860000 BE DEVIC YES 00861000 LA R5,TYPPRT PRINTER MASK 00862000 EX R14,CLCPRT PRT ?? 00863000 BE DEVIC YES - 00864000 SPACE 00865000 LA R5,TYPPUN SET GPR5 TO PUNCH TYPE 00866000 EX R14,CLCPCH PCH ?? 00867000 BE DEVIC YES 00868000 GT02A LA R5,TYPPUN PUNCH MASK 00869000 EX R14,CLCPUN PUNCH ?? 00870000 BE DEVIC YES - 00871000 SPACE 00872000 GT02B LA R5,TYPPRT SET GPR5 TO PRINTER TYPE 00873000 EX R14,CLCPRINT PRINTER ?? 00874000 BE DEVIC YES - 00875000 SPACE 00876000 LA R5,CSVRDR TYPE MASK FOR READER 00877000 EX R14,CLCREAD READER ?? 00878000 BE DEVIC 00879000 C R3,X40FFS TRANSFER CHAIN 1? HRC022DK 00879300 BE TRCHRDR1 YES, DEFAULT TO READER HRC022DK 00879600 C R3,FFS TEST FOR 'SYSTEM' OR 1ST USERID ? 00880000 BE MSG003E YES -- INVALID OPTION 00881000 B MSG006E INVALID DEVICE TYPE 00882000 SPACE 00883000 TYPALL C R3,XRIGHT24 TRANSFER CHAIN 2? HRC022DK 00883100 BE MSG006E YES, INVALID DEVICE TYPE HRC022DK 00883200 C R3,X40FFS TRANSFER CHAIN 1? HRC022DK 00883300 BNE DEVIC NO, NORMAL CALL HRC022DK 00883400 TRCHRDR1 MVC BUFNXT-BUFFER(8,R9),SAVEWRK8 RESTORE POINTER HRC022DK 00883500 TRCHRDR2 LA R5,CSVRDR SETUP DEFAULT READER HRC022DK 00883600 DEVIC EQU * HERE TO SET UP FILE POINTER 00884000 SPACE 00885000 GT05 L R6,FFS SET 1ST TIME SWITCH FOR GETCHAIN 00886000 BAL R3,GETCHAIN GET NEXT ORDERED CHAIN @V200930 00887000 SPACE 00888000 GT06 CR R2,R2 SET CC = ZERO 00889000 BR R4 RETURN TO CALLER 00890000 SPACE 3 00891000 SPACE 3 00892000 CLCALL CLC 0(0,R1),=C'ALL ' COMPARE FOR ALL 00893000 CLCRDR CLC 0(0,R1),=C'RDR ' COMPARE FOR RDR 00894000 CLCPCH CLC 0(0,R1),=C'PCH ' COMPARE FOR PCH 00895000 CLCPRT CLC 0(0,R1),=C'PRT ' COMPARE FOR PRT 00896000 CLCPRINT CLC 0(0,R1),=C'PRINTER ' COMPARE FOR PRINTER 00897000 CLCPUN CLC 0(0,R1),=C'PUNCH ' COMPARE FOR PUNCH 00898000 CLCREAD CLC 0(0,R1),=C'READER ' COMPARE FOR READER 00899000 CLCCLASS CLC 0(0,R1),=C'CLASS ' COMPARE FOR CLASS 00900000 CLCFROM CLC 0(0,R1),=C'FROM ' COMPARE FOR FROM @V200930 00901000 CLCTO CLC 0(0,R1),=C'TO ' COMPARE FOR TO 00902000 EJECT 00903000 *. 00904000 * OPERATION OF GETCLASS - 00905000 * 00906000 * 1. CALL DMKSCNFD TO LOCATE THE DESIRED CLASS 00907000 * 2. VERIFY THAT ONLY ONE CLASS IS GIVEN, AND TRT THE CLASS 00908000 * AGAINST A TABLE OF VALID CLASSES TO VERIFY ITS VALIDITY; 00909000 * THE FUNCTION TABLE IS SET TO STORE THE VALID CLASS IN GPR2 00910000 * IF CLASS IS MISSING OR INVALID, EXIT GIVING MSG028E. 00911000 * 3. IF ENTRY IS GTCLASSB, STORE CLASS IN SAVEWRK8, 00912000 * OTHERWISE STORE THE CLASS IN SAVEWRK1 AND EXIT. 00913000 * 4. NOTE THAT GETCLASS IS A 2ND LEVEL ROUTINE; LINKAGE IS VIA 00914000 * GPR3 00915000 *. 00916000 SPACE 3 00917000 GTCLASSB MVI SAVEWRK5+2,X'FF' INDICATE CLASS NOT SPOOLID 00918000 GETCLASS EQU * HERE TO LOCATE AND VERIFY CLASS 00919000 SPACE 00920000 GCL01 CALL DMKSCNFD 00921000 BNZ MSG028E CLASS MISSING - EXIT 00922000 SPACE 00923000 GCL02 C R0,F1 MUST BE ONLY ON CLASS COUNT=1 00924000 BNE MSG028E NO-- 00925000 CLI 0(R1),C'A' CLASS LOWER THAN A 00926000 BL MSG028E YES - INVALID CLASS 00927000 ST R2,TEMPR2 SAVE GPR2 00928000 TRT 0(1,R1),CLTABLE CLASS VALID ?? 00929000 BH GCL03 VALID 00930000 B MSG028E NO - INVALID CLASS 00931000 SPACE 00932000 GCL03 CLI SAVEWRK5+2,X'FF' STORE CLASS IN SAVEWRK5+2 ?? 00933000 BNE GCL04 NO STORE IN SAVEWRK1 00934000 STC R2,SAVEWRK5+2 SAVE CLASS CHARACTER 00935000 B GCL05 00936000 SPACE 00937000 GCL04 EQU * 00938000 STC R2,SAVEWRK1 SAVE CLASS 00939000 GCL05 CR R1,R1 CC = ZERO 00940000 L R2,TEMPR2 RESTORE GPR2 00941000 BR R3 RETURN TO CALLER 00942000 SPACE 3 00943000 ORG *-193 00944000 CLTABLE EQU * 00945000 ORG 00946000 DC C'ABCDEFGHI' 00947000 DC XL7'00' 00948000 DC C'JKLMNOPQR' 00949000 DC XL8'00' 00950000 DC C'STUVWXYZ' 00951000 DC XL6'00' 00952000 DC C'0123456789' 00953000 DC XL6'00' 00954000 DS 0H 00955000 SPACE 00956000 EJECT 00957000 *. 00958000 * 00959000 * OPERATION OF GETFILE - 00960000 * 00961000 * 1. UPON ENTRY, GPR7 = ADDRESS OF A POINTER TO THE NEXT SFBLOK 00962000 * TO TEST 00963000 * 2. LOAD GPR7 WITH POINTER TO NEXT BLOK; IF ZERO, EXIT 00964000 * 3. IF SAVEWRK2,3 EQUALS ZERO OR SFBUSER, GO TO STEP 4; 00965000 * OTHERWISE GO TO STEP 6 00966000 * 4. IF SAVEWRK1(1) EQUALS ZERO OR SFBCLAS,GO TO STEP 5; 00967000 * OTHERWISE GO TO STEP 6 00968000 * 5. IF SAVEWRK1+2(2) EQUALS ZERO OR SFBFILID, EXIT 00969000 * 5.5 IF R15(SWITCH) = X2048BND HRC022DK 00970690 * COUNT THE NUMBER OF SPOOL SPOOL FILE BLOCKS HRC022DK 00971280 * 6. IF NO MATCH, GO TO STEP 2 00972000 *. 00973000 SPACE 00974000 GETFILE EQU * HERE TO LOCATE THE REQUESTED FILE 00975000 * OR TO GET A COUNT OF THE NUMBER OF FILES TO 00976000 * BE TRANSFERRED,R10 FF IS SWITCH 00977500 SPACE 00978000 GF01 EQU * GPR7 = POINTER TO NEXT SFBLOK 00979000 GF02 LR R6,R7 SFBLOK PRESENT ?? 00980000 L R7,0(R7) 00981000 LTR R7,R7 00982000 BCR 8,R4 NO -RETURN TO CALLER WITH GPR7 ZERO 00983000 SPACE 00984000 GF03 TM SFBFLAG,SFBINUSE FILE IN USE ?? 00985000 BO GF02 GET NEXT FILE 00986000 CLI SAVEWRK2,X'40' USERID PRESENT ?? 00987000 BNH GF04 NO -- USE ALL FILES 00988000 CLC SAVEWRK2(8),SFBUSER USERID EQUALS ?? 00989000 BNE GF02 NO 00990000 SPACE 00991000 GF04 CLI SAVEWRK1,X'00' SEARCH BY CLASS ?? 00992000 BE GF05 NO 00993000 CLC SAVEWRK1(1),SFBCLAS CLASS EQUALS ?? 00994000 BNE GF02 NO - 00995000 SPACE 00996000 GF05 CLC SAVEWRK1+2(2),ZEROES SEARCH BY SPOOLID 00997000 BE TOTAL NO @VA06206 00998000 CLC SAVEWRK1+2(2),SFBFILID SPOOLID EQUAL ?? 00999000 BNE GF02 NO - 01000000 TOTAL EQU * @VA06206 01001000 C R15,X2048BND ARE WE COUNTING? (FROM TR05A) HRC022DK 01002690 BNE GF06 NOT TODAY @VA07375 01003000 LH R14,SAVEWRK7 GET THE COUNT @VA06206 01004000 LA R14,1(R14) UPDATE BY ONE @VA06206 01005000 STH R14,SAVEWRK7 STORE IT AWAY @VA06206 01006000 B GF02 KEEP ON TRUCKING @VA06206 01007000 SPACE 01009000 GF06 EQU * 01010000 BR R4 RETURN TO CALLER 01011000 EJECT 01012000 *. 01013000 * OPERATION OF GETID - 01014000 * 01015000 * 1. CALL DMKSCNFD TO LOCATE THE SPOOLID; ACCEPTABLE ID'S ARE - 01016000 * - A SPOOLID NUMBER 01017000 * - THE KEYWORD 'CLASS' FOLLOWED BY A VALID SPOOL CLASS 01018000 * - THE KEYWORD 'ALL' 01019000 * 2. SET SAVEWRK1, SAVEWRK1+2(2) = 0 01020000 * 3. IF OPTION = 'ALL', EXIT TO CALLER 01021000 * 4. IF OPTION = 'CL', CALL GETCLASS AND SAVE THE CLASS 01022000 * RETURNED IN GPR2 IN SAVEWRK1; THEN EXIT 01023000 * 5. IF OPTION = A SPOOLID NUMBER, CONVERT TO BINARY AND STORE 01024000 * IN SAVEWRK1+2(2) 01025000 * 6. RETURN TO CALLER. 01026000 *. 01027000 SPACE 3 01028000 GETID EQU * HERE TO LOCATE SPOOLID 01029000 SPACE 01030000 GI01 MVI SAVEWRK1,X'00' SET TO ALL 01031000 XC SAVEWRK1+2(2),SAVEWRK1+2 01032000 SPACE 01033000 GI02 CALL DMKSCNFD LOCATE SPOOLID 01034000 STM R0,R1,SAVEWRK6 SAVE COUNT AND ADDRESS 01035000 BCR 7,R4 NO MORE FILID, RETURN WITH CC 01036000 * NON-ZERO 01037000 SPACE 01038000 LR R14,R0 COUNT 01039000 BCTR R14,0 -1 01040000 C R0,F2 MIN FOR CLASS 01041000 BL GI05 NO - MUST BE FILE ID 01042000 BE GI04 YES - MIN FOR CLASS 01043000 SPACE 01044000 GI03 EX R14,CLCALL IS IT ALL ?? 01045000 BE GI06 YES GO TO RETURN 01046000 SPACE 01047000 GI04 EX R14,CLCCLASS IS IT CLASS ?? 01048000 BNE GI05 NO 01049000 BAL R3,GETCLASS GET CLASS AND VERIFY @V200930 01050000 B GI06 GO RETURN 01051000 SPACE 01052000 GI05 EQU * OPTION MUST BE FILED 01053000 C R0,F4 LENGTH GREATER THAN 4 ? 01054000 BH GI05A YES -- INVALID SPOOLID 01055000 CALL DMKCVTDB CONVERT TO BINARY 01056000 BZ VALID VALID SPOOLID 01057000 GI05A LM R0,R1,SAVEWRK6 RESTORE COUNT AND ADDRESS 01058000 C R3,FFS TEST FOR 'SYSTEM' OR 1ST USERID ? 01059000 BE MSG003E YES -- DMKCSV003E 01060000 B MSG008E INVALID SPOOLID 01061000 VALID STH R1,SAVEWRK1+2 SAVE BINARY VALUE (SPOOLID) 01062000 LTR R1,R1 SPOOLID ZERO ?? 01063000 BZ GI05A YES -- INVALID 01064000 SPACE 01065000 GI06 CR R12,R12 SET CC ZERO 01066000 BR R4 RETURN TO CALLER 01067000 EJECT 01068000 *. 01069000 * OPERATION OF GETCHAIN - 01070000 * 01071000 * 1. IF GPR5 = 0, SET GPR6 = 0 AND EXIT; 01072000 * 2. IF GPR6 = FFS, GO TO STEP 6; 01073000 * 3. IF GPR5 HAS CSVRDR BIT ON,REMOVE BIT, GO TO STEP 7; 01074000 * 4. IF GPR5 HAS TYPPRT BIT ON,REMOVE BIT, GO TO STEP 8; 01075000 * 5. REMOVE TYPPUN BIT IN GPR5, SET GPR6 TO ZERO, EXIT 01076000 * 6. IF GPR5 HAS CSVRDR BIT ON, LOAD GPR6 WITH ARSPRD, EXIT; 01077000 * 7. IF GPR5 HAS TYPPRT BIT ON, LOAD GPR6 WITH ARSPPR, EXIT; 01078000 * 8. IF GPR5 HAS TYPPUN BIT ON, LOAD GPR6 WITH ARSPPU,EXIT; 01079000 * 9. SET GPR6 = 0, EXIT 01080000 *. 01081000 SPACE 3 01082000 GETCHAIN EQU * HERE TO GET NEXT FILE CHAIN ANCHOR POINTER 01083000 SPACE 01084000 GC01 LTR R5,R5 FILE TYPE ZERO ?? 01085000 BNZ GC02 NO-- 01086000 SR R6,R6 YES - ZERO GPR6 01087000 BR R3 RETURN TO CALLER 01088000 SPACE 01089000 GC02 C R6,FFS 1ST TIME SWITCH ON ?? 01090000 BE GC06 YES - DO NOT RESET ANY BITS, JUST 01091000 * LOAD GPR6 01092000 SPACE 01093000 GC03 LR R6,R5 SAVE R5 FOR CHANGE COMPARE 01094000 N R5,=A(255-CSVRDR) REMOVE READER BIT 01095000 CR R6,R5 WAS IT ON ?? 01096000 BNE GC07 NO 01097000 SPACE 01098000 GC04 N R5,=A(255-TYPPRT) REMOVE PRINTER BIT 01099000 CR R6,R5 WAS IT ON ?? 01100000 BNE GC08 NO 01101000 SPACE 01102000 GC05 SR R5,R5 REMOVE PUNCH BIT 01103000 SR R6,R6 SET GPR6 TO ZERO 01104000 BR R3 RETURN TO CALLER - END OF CHAIN 01105000 SPACE 01106000 GC06 L R7,ARSPRD LOAD READER FILE CHAIN POINTER 01107000 * ANCHOR 01108000 EX R5,TMRDR READER BIT ON ?? 01109000 BCR 7,R3 YES - RETURN TO CALLER 01110000 SPACE 01111000 GC07 L R7,ARSPPR LOAD PRINTER FILE CHAIN POINTER 01112000 * ANCHOR 01113000 EX R5,TMPRT PRINTER BIT ON ?? 01114000 BCR 7,R3 YES - RETURN TO CALLER 01115000 SPACE 01116000 GC08 L R7,ARSPPU LOAD PUNCH FILE CHAIN POINTER ANCHOR 01117000 EX R5,TMPUN PUNCH BIT ON ?? 01118000 BCR 7,R3 YES - RETURN TO CALLER 01119000 GC09 SLR R6,R6 SET GPR6 = ZERO - ALL DONE @VA01375 01120000 SLR R7,R7 .. @VA01375 01121000 BR R3 RETURN TO CALLER @VA01375 01122000 EJECT 01123000 *. 01124000 * OPERATOR OF SETPEND - 01125000 * 01126000 * 1. IF SPOOL FILE (SFBLOK) IS IN USER HOLD STATUS; 01127000 * RETURN TO CALLER. 01128000 * 2. LOCATE AN AVAILABLE VIRTUAL READER, CONSTRUCT AN 01129000 * IOBLOK CONTAINING A DEVICE END INTERRUPT AND STACK IT 01130000 * FOR THE OPPROPRIATE VIRTUAL DEVICE VIA CALL TO 01131000 * DMKSTKIO. 01132000 *. 01133000 SPACE 3 01134000 SETPEND EQU * HERE TO POST PENDIN INTERRUPT @VM01016 01135000 SPACE 01136000 USING VCHBLOK,R6 @VM01016 01137000 USING VCUBLOK,R9 @VM01016 01138000 USING IOBLOK,R10 @VM01016 01139000 USING VDEVBLOK,R8 @VA10097 01139500 SPACE 01141000 ST R11,TEMPR3 SAVE CALLERS VMBLOK POINTER @VA04139 01142000 CLC SFBUSER,VMUSER ONLY THE OWNER GETS THE INT. @VA04139 01143000 BE SAMEUSER BRANCH IF SAME USER, ALL OK! @VA04139 01144000 LA R0,8 SET UP TO ... @VA04139 01145000 LA R1,SFBUSER FIND THE VMBLOK OF... @VA04139 01146000 CALL DMKSCNAU THE USER TO GET THE INT. @VA04139 01147000 BNZR R4 IF NOT LOGED ON RETURN @VA04139 01148000 ST R11,TEMPR3 RESAVE CALLERS VMBLOK POINTER @VA04139 01149000 CHARGE SWITCH,1 SWITCH TIMING TO RECEIVER @V407510 01150000 SAMEUSER STM R4,R5,TEMPR4 SAVE CALLERS REGS @VA04139 01151000 STM R8,R10,TEMPR8 SAVE CALLERS R8 THUR R10 HRC022DK 01151500 SR R1,R1 CLEAR CHANNEL TABLE INDEX @VM01016 01152000 LA R4,2 GET GENERAL INDEX INCREMENT @VM01016 01153000 LA R5,30 GET GENERAL COMPARAND FOR BXLE @VM01016 01154000 SPACE 01155000 NEXTCH LH R6,VMCHTBL(R1) GET INDEX TO NEXT VIRTUAL CHANNEL@VM01016 01156000 LTR R6,R6 IS THERE ONE AT THIS ADDRESS @VM01016 01157000 BM CHINDEX NO -- @VM01016 01158000 A R6,VMCHSTRT POINT TO VCHBLOK @VM01016 01159000 SR R2,R2 CLEAR CU TABLE INDEX @VM01016 01160000 NEXTCU LH R9,VCHCUTBL(R2) GET INDEX TO VIRTUAL CU BLOK @VM01016 01161000 LTR R9,R9 IS THERE ONE AT THIS ADDRESS ? @VM01016 01162000 BM CUINDEX NO -- @VM01016 01163000 A R9,VMCUSTRT POINT TO VCUBLOK @VM01016 01164000 SR R3,R3 CLEAR DEVICE BLOK TABLE INDEX @VM01016 01165000 NEXTDEV LH R8,VCUDVTBL(R3) GET INDEX TO DEVICE BLOK @VM01016 01166000 LTR R8,R8 IS THERE ONE AT THIS ADDRESS @VM01016 01167000 BM DEVINDEX NO -- @VM01016 01168000 A R8,VMDVSTRT POINT TO DEVICE BLOK @VM01016 01169000 SPACE 01170000 CLI VDEVTYPC,CLASURI INPUT DEVICE @VM01016 01171000 BNE DEVINDEX NO - @VM01016 01172000 TM VDEVTYPE,TYPRDR IS IT THE RIGHT TYPE ?? @VM01016 01173000 BZ DEVINDEX NO -- @VM01016 01174000 TM VDEVSTAT,X'FF' ANY STATUS PENDING ?? @VM01016 01175000 BNZ DEVINDEX YES, CHECK NEXT DEVICE @VM01016 01176000 CLI VDEVCLAS,C'*' ALL CLASS READER ? @VM01016 01177000 BE TSTBUSY YES, TEST FOR ACTIVE DEVICE @VM01016 01178000 CLC VDEVCLAS(1),SFBCLAS FILE CLASS SAME AS DEVICE ? @VM01016 01179000 BNE DEVINDEX NO - @VM01016 01180000 TSTBUSY ICM R14,B'1111',VDEVSPL IS THE DEVICE BUSY ?? @VM01016 01181000 BZ RDRPEND NO -- FINALLY FOUND A DEVICE @VM01016 01182000 SPACE 01183000 DEVINDEX BXLE R3,R4,NEXTDEV INDEX TO NEXT DEVICE ON CONTROL @VM01016 01184000 * UNIT 01185000 CUINDEX BXLE R2,R4,NEXTCU INDEX TO NEXT CONTROL UNIT ON @VM01016 01186000 * CHANNEL 01187000 CHINDEX BXLE R1,R4,NEXTCH INDEX TO NEXT CHANNEL ON MACHINE @VM01016 01188000 LM R3,R5,TEMPR3 GET CALLERS R11(IN R3), R4 & R5 @VA04139 01189000 SR R8,R8 RESET SWITCH AT THIS TIME IF @VA09755 01189100 * SET DUE TO NOT FINDING DEVICE 01189200 B INTEXIT RETURN @VA04139 01190000 SPACE 01191000 RDRPEND EQU * HERE TO QUEUE DEVICE END @VM01016 01192000 LH R2,VDEVADD GET FULL ADDRESS OF DEVICE @VM01016 01193000 LH R5,VCUADD .. @VM01016 01194000 OR R2,R5 .. @VM01016 01195000 AH R2,VCHADD .. @VM01016 01196000 LM R3,R5,TEMPR3 GET CALLERS R11(IN R3), R4 & R5 @VA04139 01197000 LA R0,IOBSIZE BUILD IOBLOK @VM01016 01198000 CALL DMKFREE .. @VM01016 01199000 LR R10,R1 ADDRESS OF IOBLOK @VM01016 01200000 XC IOBLOK(IOBSIZE*8),IOBLOK CLEAR BLOK @VM01016 01201000 ST R10,IOBLINK INDICATE ORIGINAL COPY @VM01016 01202000 MVI IOBCSW+4,DE FAKE DEVICE END CSW @VM01016 01203000 ST R11,IOBUSER MOVE USER ADDRESS OF VMBLOK @VM01016 01204000 MVC IOBIRA,=A(DMKVIOIN) RETURN ADDRESS @VM01016 01205000 STH R2,IOBVADD PUT ADDRESS IN IOBLOK @VM01016 01206000 OI VDEVSTAT,VDEVPEND SET PENDING FLAG @VM01016 01207000 MVC VDEVCSW(8),IOBCSW MOVE IN DEVICE END CSW @VM01016 01208000 CALL DMKSTKIO GO STACK IO @VM01016 01209000 INTEXIT EQU * HRC022DK 01210190 LM R8,R10,TEMPR8 RESTORE CALLERS R8-R10 HRC022DK 01210380 CLR R11,R3 ORIGINAL CALLER? HRC022DK 01210570 BER R4 YES- RETURN @VA04139 01211000 CHARGE SWITCH,3 SWITCH BACK TO CALLER @V407510 01212000 BR R4 RETURN TO CALLER @VM01016 01213000 DROP R6 @VM01016 01214000 DROP R9 @VM01016 01215000 DROP R10 @VM01016 01216000 DROP R8 @VA10097 01216500 SPACE 3 01217000 ********************************** 01218000 * 01219000 * ERROR EXITS FROM DMKCSV 01220000 * 01221000 ********************************** 01222000 SPACE 2 01223000 MSG003E EQU * HERE IF INVALID OPTION FOR THIS @VA01375 01224000 * COMMAND 01225000 LA R2,003 ERROR MSG DMKCSV003E @VA01733 01226000 B EXIT8 EXIT TO ERROR MODULE 01227000 SPACE 2 01228000 MSG006E EQU * HERE IF DEVICE TYPE IS INVALID 01229000 LA R2,006 ERROR MSG DMKCSV006E 01230000 LM R0,R1,SAVEWRK6 COUNT AND ADDRESS OF INVALID TYPE 01231000 B EXIT8 EXIT TO ERROR MODULE 01232000 SPACE 2 01233000 MSG007E EQU * HERE IF USERID IS INVALID 01234000 LA R2,007 ERROR MSG DMKCSV007E 01235000 B EXIT8 01236000 SPACE 2 01237000 MSG008E EQU * HERE IF SPOOLID IS INVALID 01238000 LA R2,008 ERROR MSG DMKCSV008E 01239000 LM R0,R1,SAVEWRK6 COUNT AND ADDRESS OF SPOOLID 01240000 B EXIT8 EXIT TO ERROR MODULE 01241000 SPACE 2 01242000 MSG020E EQU * HERE IF USERID IS MISSING OR INVALID 01243000 LA R2,020 ERROR MSG DMKCSV020E 01244000 B EXIT8R1 EXIT TO ERROR MODULE 01245000 SPACE 2 01246000 MSG026E EQU * HERE IF OPERAND MISSING OR INVALID 01247000 LA R2,026 ERROR MSG DMKCSV026E 01248000 B EXIT8R1 EXIT TO ERROR MODULE 01249000 SPACE 2 01250000 MSG027E EQU * HERE IF SPOOLID MISSING OR INVALID 01251000 LA R2,027 ERROR MSG DMKCSV027E 01252000 B EXIT8R1 01253000 SPACE 2 01254000 MSG028E EQU * HERE IF CLASS IS MISSING OR INVALID 01255000 LA R2,028 ERROR MSG DMKCSV028E 01256000 B EXIT8R1 01257000 SPACE 01258000 MSG029E EQU * HERE IF FNAME FTYPE MISSING OR INVALID 01259000 LA R2,029 ERROR MSG DMKCSV029E 01260000 B EXIT8R1 EXIT TO ERROR MODULE 01261000 SPACE 2 01262000 MSG030E EQU * HERE IF COPIES IS MISSING OR INVALID 01263000 LA R2,030 ERROR MSG DMKCSV030E 01264000 B EXIT8R1 EXIT TO ERROR MODULE 01265000 SPACE 2 01266000 MSG035E EQU * HERE IF DEVICE TYPE MISSING OR INVALID 01267000 LA R2,035 ERROR MSG DMKCSV035E 01268000 B EXIT8R1 EXIT TO ERROR MODULE 01269000 SPACE 2 01270000 MSG042E EQU * HERE IF SPOOL FILE NOT FOUND 01271000 LH R1,SAVEWRK1+2 GET SPOOLID OF FILE 01272000 BAL R2,CVTBD AND CONVERT 01273000 LA R2,042 ERROR MSG DMKCSV032E 01274000 B EXIT8R0 01275000 SPACE 2 01276000 MSG053E EQU * HERE IF USERID NOT IN CP DIRECTORY 01277000 LA R2,053 ERROR MSG DMKCSV053E 01278000 B EXIT8 01279000 SPACE 2 01280000 CVTBD EQU * HERE TO CONVERT BINARY TO DECIMAL 01281000 CALL DMKCVTBD 01282000 BR R2 01283000 SPACE 01284000 SPACE 2 01285000 EJECT 01286000 **************************************** 01287000 * 01288000 * FINAL EXIT BACK TO DMKCFM 01289000 * 01290000 **************************************** 01291000 SPACE 3 01292000 CSVEXIT EQU * HERE FOR NORMAL EXIT FROM DMKCSV 01293000 SR R2,R2 CLEAR ERROR REGISTER 01294000 B EXIT1 NOW EXIT 01295000 SPACE 2 01296000 EXIT8R1 SR R1,R1 01297000 EXIT8R0 SR R0,R0 01298000 EXIT8 ICM R0,14,ID+3 MOVE IN MODULE ID 01299000 EXIT1 LR R3,R0 SAVE GPR 0-2 01300000 LR R4,R1 .. 01301000 LR R5,R2 .. @VA09563 01302100 TM VMMLVL2,VMMIMSG NO - SUPPRESS INFO MSGS? @V2A3663 01304000 BZ NOMSG YES @V2A3663 01305000 REGXIT EQU * NO @V2A3663 01306000 LH R2,SAVEWRK5 GET FILE COUNT @VA10097 01306100 LTR R2,R2 PROCESSING STARTED? @VA10097 01306130 BM NOMSG NO; DON'T SEND MESSAGE @VA10097 01306160 LA R0,TRANSIZE NR OF DWDS IN MESSAGE BUFFER @VA10097 01306190 CALL DMKFREE GET THE MESSAGE BUFFER @VA10097 01306220 LR R8,R1 WE DON'T NEED R8 ANYMORE @VA10097 01306250 USING CNTMSG,R8 THIS ONE NOW, PLEASE @VA10097 01306280 MVI 0(R8),C' ' THERE'S THE FIRST BLANK @VA10097 01306310 MVC 1(CNTMSGL-1,R8),0(R8) CLEAR 'EM ALL @VA10097 01306340 LH R1,SAVEWRK5 GET FILE COUNT 01307000 MVC MSGCNT(4),=C' NO ' SET MESSAGE 01310000 LTR R1,R2 DO WE WANT A FILE MESSAGE ? @VA10097 01310101 BZ NOCNT NO FILE MSG 01311000 CALL DMKCVTBD CONVERT COUNT FOR MSG 01312000 STCM R1,15,MSGCNT STORE COUNT IN MESSAGE 01313000 NOCNT MVC MSGFILE(5),=C'FILES' .. 01314000 C R1,=C'0001' ONE FILE ?? 01315000 BNE *+8 NO 01316000 MVI MSGFILE+4,C' ' CHANGE FILES TO FILE 01317000 MVC MSGCMD+3(8),BLANKS BLANK COMMAND NAME AREA @VA04869 01318000 MVC MSGCMD(8),VMCOMND MOVE IN COMMAND NAME 01319000 TRYPURGE CLI MSGCMD,C'P' PURGE COMMAND? @VA04869 01320000 BNE TRYORDER NO, CHECK FURTHER @V60B9BA 01321000 MVI MSGCMD+5,C'D' CHANGE PURGE TO PURGED @VA04869 01322000 B MSGLEN GO PREPARE TO PUT OUT MSG @VA04869 01323000 TRYORDER CLI MSGCMD,C'O' ORDER COMMAND? @VA04869 01324000 BNE XFERRED NO, MUST BE TRANSFER REQUEST @VA04869 01325000 MVC MSGCMD+5(2),=C'ED' CHANGE ORDER TO ORDERED @VA04869 01326000 B MSGLEN PREPARE TO PUT OUT MSG @VA04869 01327000 XFERRED MVC MSGCMD+8(3),=C'RED' CHANGE TO TRANSFERRED @VA04869 01328000 MSGLEN LA R0,CNTMSGL SET UP MSG LENGTH @VA04869 01329000 LR R1,R8 GET THE MESSAGE ADDRESS @VA10097 01330001 LR R8,R3 WE HAVE TO SAVE R3 NOW. @VA10097 01330002 LA R3,TRANSIZE NR OF DW'S TO RETURN @VA10097 01330003 LA R2,NORET+DFRET TELL QCNWT TO RELEASE BUFF @VA10097 01330004 CALL DMKQCNWT SEND MSG AND RELEASE MSG BUF @VA10097 01330005 LR R3,R8 PUT IT BACK LIKE WE FOUND IT @VA10097 01330006 NOMSG EQU * 01332000 L R1,SAVEWRK4 ADDRESS OF 24 BYTE AREA 01333000 LTR R1,R1 ADDRESS PRESENT ?? 01334000 BZ EXIT2 NO --- 01335000 LA R0,3 LENGTH OF AREA 01336000 CALL DMKFRET RETURN AREA TO FREE STORAGE 01337000 EXIT2 LR R0,R3 RESTORE REG 0-2 01338000 LR R1,R4 .. 01339000 LR R2,R5 .. 01340000 LTR R2,R2 ERROR CODE PRESENT ?? 01341000 BNZ ERREXIT YES -- 01342000 EXIT - EXIT -- NO ERROR 01343000 SPACE 01344000 ERREXIT EQU * HERE TO CALL ERROR MESSAGE MODULE 01345000 CALL DMKERMSG EXIT TO MESSAGE MODULE 01346000 SPACE 01347000 * MODULE DMKERMSG WILL GIVE SVC16 AND RETURN CONTROL TO DMKCFM 01348000 EJECT 01349000 **************************************** 01350000 * 01351000 * MESSAGES AND CONSTANTS 01352000 * 01353000 **************************************** 01354000 SPACE 2 01355000 LTORG 01356000 EJECT 01357000 TRANMSG DSECT , @VA10097 01357100 TRMSGF DC C'XXX' RDR/PRT/PUN HRC022DK 01357115 DC C' ' @VA10097 01357120 TRANMSGT DC C'FILE ' SPOOLID @VA10097 01357130 TRMSGID DC C' ' SPOOLID @VA10097 01357140 DC C' TRANSFERRED' @VA10097 01357150 TRMCONST DC C' FROM ' @VA10097 01357160 TRMSGUR DC CL8' ' @VA10097 01357170 TRANL EQU *-TRANMSG @VA10097 01357180 DC C' ' @VA10097 01357190 TRMSGT DC C'XXX' RDR/PRT/PUN @VA10097 01357200 TRANLT EQU *-TRANMSGT LN OF MSG TO SEND @VA10097 01357210 DS 0H HRC022DK 01357221 SPACE , HRC022DK 01357222 TRBADMSG DC C'FILE ' HRC022DK 01357223 TRBADID DC C'NNNN' HRC022DK 01357224 DC C' CANNOT BE TRANSFERRED TO ' HRC022DK 01357225 TRBADC DC C'XXX' HRC022DK 01357226 TRBADL EQU *-TRBADMSG HRC022DK 01357227 DS 0H HRC022DK 01357228 TRANCH1 DS A SAVE CHAIN 1 ADR HRC022DK 01357229 TRANSIZE EQU (*-TRANMSG+7)/8 DW LN FOR FREE/FRET @VA10097 01357230 TRBADSIZ EQU (*-TRBADMSG+7)/8 DW LN FOR FREE/FRET HRC022DK 01357235 SPACE 1 01357240 CNTMSG DSECT , NUMBER OF FILES PROCESSED MESSAGE@VA10097 01357250 MSGCNT DC CL5' ' PLACE FOR COUNT OR NO @VA10097 01357260 MSGFILE DC CL6' ' FOR FILES OR FILE @VA10097 01357270 MSGCMD DC CL11' ' PLACE FOR COMMAND @VA10097 01357280 CNTMSGL EQU *-CNTMSG @VA10097 01357290 CSVRDR EQU X'20' 01358000 PSA , @V306638 01359000 COPY CONBUF @V306638 01360000 COPY DEVTYPES @V306638 01361000 COPY EQU @V306638 01362000 COPY IOBLOKS @V306638 01363000 COPY RBLOKS @V306638 01364000 COPY SAVE @V306638 01365000 COPY SPOOL @V306638 01366000 COPY UDIRECT @V306638 01367000 COPY VBLOKS @V306638 01368000 COPY VMBLOK @V306638 01369000 END 01370000