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 | <USERID> READER CLASS A ...... | 00183000
* | ORD | <SYSTEM> PRINTER SPOOLID ...... | 00184000
* | | PUNCH | 00185000
* +-------+------------------------------------+ 00186000
* 00187000
* READER PRINTER PUNCH CLASS 00188000
* R RDR P PRT PU PCH CL 00189000
* 00190000
* <USERID> AND <SYSTEM> 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 | <USERID> PRINTER SPOOLID ..... | 00398000
* | PUR | <SYSTEM> PUNCH ALL | 00399000
* | | ALL --- | 00400000
* +-------+------------------------------------+ 00401000
* 00402000
* READER PRINTER PUNCH ALL CLASS 00403000
* R RDR P PRT PU PCH ALL CL 00404000
* 00405000
* 00406000
* <USERID> AND <SYSTEM> 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 | <USERID> <PRT> SPOOLID < TO > USERID <PRT> |HRC022DK 00544580
* | TRAN | <SYSTEM> <PCH> CLASS A <FROM> ALL <PCH> |HRC022DK 00545370
* | | <RDR> ALL <RDR> |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
* <USERID> AND <SYSTEM> 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