ibm:vm370-lib:cp:dmkcsv.assemble_src
Table of Contents
DMKCSV Source
References
- Fixes Applied : 12
- This Source Date : Thursday, December 14, 1978
- Last Fix ID : [HRC311DK]
Source Listing
- DMKCSV.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkcsv.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator