SPL TITLE 'DMKSPL (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
*. 00003000
* 00004000
* MODULE NAME - 00005000
* 00006000
* DMKSPL 00007000
* 00008000
* CONTENTS - 00009000
* 00010000
* DMKSPLOV - OPEN A VIRTUAL SPOOLED PRINTER OR PUNCH FILE 00011000
* DMKSPLOR - OPEN A REAL INPUT READER FILE 00012000
* DMKSPLCV - CLOSE A VIRTUAL PRINTER OR PUNCH FILE 00013000
* DMKSPLCR - CLOSE A REAL INPUT READER FILE 00014000
* DMKSPLDL - TO STACK A SPOOL FILE TO BE DELETED 00015000
* DMKSPLDR - TO DELETE SPOOL FILE BUFFERS 00016000
* 00017000
*. 00018000
EJECT 00019000
COPY OPTIONS 00020000
COPY LOCAL OPTIONS 00021000
SPACE 3 00022000
DMKSPL CSECT 00023000
SPACE 3 00024000
EXTRN DMKPGTSR,DMKPGTSD 00025000
EXTRN DMKSYSOW,DMKSTKCP,DMKVIOIN 00026000
EXTRN DMKSTKIO,DMKPGTVG 00027000
EXTRN DMKPGTSG,DMKCVTDT,DMKSCNAU 00028000
EXTRN DMKIOSQR,DMKRSPHQ 00029000
EXTRN DMKRSPID,DMKCVTBD 00030000
EXTRN DMKUDRFU,DMKUDRRD,DMKUDRRV @V200930 00031000
EXTRN DMKDRDDD,DMKRSPDL,DMKPTRUL 00032000
EXTRN DMKSYSOC @VM08815 00033000
EXTRN DMKCKSPL @V304298 00034000
EXTRN DMKRPAGT,DMKRPAPT @V293598 00035000
EXTRN DMKUDRMD @V407466 00035100
EXTRN DMKPGTVR @VA11232 00035200
SPACE 3 00036000
USING PSA,R0 00037000
USING SPLINK,R2 00038000
USING SFBLOK,R7 00039000
USING IOBLOK,R10 00040000
USING VMBLOK,R11 00041000
USING SAVEAREA,R13 00042000
EJECT 00043000
*. 00044000
* 00045000
* SUBROUTINE NAME - 00046000
* 00047000
* DMKSPLOV 00048000
* 00049000
* FUNCTION - 00050000
* 00051000
* INITIALIZE CONTROL BLOKS AND BUFFERS FOR VIRTUAL PRINTER AND 00052000
* PUNCH OUTPUT SPOOL FILES 00053000
* 00054000
* ATTRIBUTES - 00055000
* 00056000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00057000
* 00058000
* ENTRY POINTS - 00059000
* 00060000
* DMKSPLOV 00061000
* 00062000
* ENTRY CONDITIONS - 00063000
* 00064000
* GPR8 = DISP ADDRESS OF VDEVBLOK FOR VIRTUAL DEVICE 00065000
* GPR12 = BASE ADDRESS OF DMKSPLOV 00066000
* GPR13 = ADDRESS OF STANDARD SAVEAREA 00067000
* 00068000
* EXIT CONDITIONS - 00069000
* 00070000
* SFBLOK AND VSPLCTL WORKAREA ARE CONSTRUCTED, AND CALLER'S 00071000
* REGISTERS MODIFIED AS FOLLOWS - 00072000
* 00073000
* GPR7 = ADDRESS OF NEW SFBLOK 00074000
* GPR9 = ADDRESS OF VSPLCTL WORKAREA 00075000
* 00076000
* CALLS TO OTHER ROUTINES - 00077000
* 00078000
* DMKFREE - TO OBTAIN STORAGE FOR CONTROL BLOKS 00079000
* DMKPTRAN - TO RESERVE A REAL STORAGE PAGE BUFFER 00080000
* DMKPGTVG - TO OBTAIN A VIRTUAL STORAGE BUFFER 00081000
* DMKPGTSG - TO OBTAIN THE ADDRESS OF A DASD PAGE 00082000
* DMKCVTDT - TO OBTAIN THE DATE AND TIME OF THE FILES CREATION 00083000
* 00084000
* EXTERNAL REFERENCES - 00085000
* 00086000
* NONE 00087000
* 00088000
* TABLE / WORKAREAS - 00089000
* 00090000
* NONE 00091000
* 00092000
* REGISTER USAGE - 00093000
* 00094000
* GPR1 = VIRTUAL ADDRESS OF PAGE BUFFER 00095000
* GPR2 = REAL ADDRESS OF PAGE BUFFER 00096000
EJECT 00097000
* GPR6 = SUBROUTINE LINKAGE RETURN 00098000
* GPR7 = ADDRESS OF SFBLOK 00099000
* GPR8 = ADDRESS OF VDEVBLOK 00100000
* GPR9 = ADDRESS OF VSPLCTL WORKAREA 00101000
* GPR12 = DMKSPL MODULE BASE 00102000
* GPR13 = ADDRESS OF SAVEAREA 00103000
* GPR14,15 BALR ROUTINE LINKAGE 00104000
* GPR0 = SCRATCH 00105000
* GPR3,4,5,10,11 NOT USED 00106000
* 00107000
* 00108000
* OPERATION - 00109000
* 00110000
* 1. CALL BUILDCTL SUBROUTINE TO CONSTRUCT SFBLOK AND VSPCTL 00111000
* WORKAREA; IF NO DASD SPACE IS AVAILABLE, EXIT; OTHERWISE, 00112000
* CONTINUE 00113000
* 00114000
* 2, MOVE ORIGINATING USERID INTO SFBLOK; CALL DMKPTRAN VIA 00115000
* TRANS MACRO TO LOCATE AND RESERVE A REAL PAGE BUFFER 00116000
* 00117000
* 3. CLEAR BUFFER LINK FIELD; SET UP LOGICAL RECORD SIZE; 00118000
* CLEAR END OF FIRST DASD BUFFER; 00118100
* MODIFY CALLER'S REGS 7 AND 9 TO POINT TO NEW BLOKS, AND 00119000
* EXIT TO CALLER 00120000
* 00121000
*. 00122000
EJECT 00123000
ID DC CL8'DMKSPL' MODULE NAME 00124000
SPACE 3 00125000
DMKSPLOV RELOC 00126000
SPACE 00127000
USING VDEVBLOK,R8 00128000
USING VSPLCTL,R9 00129000
SPACE 00130000
LA R0,VSPSIZE GET SIZE OF CONTROL BLOK 00131000
BAL R6,BUILDCTL GO BUILD VSPLCTL AND SFBLOK 00132000
AL R8,VMDVSTRT VDEVBLOK ADDRESS @VA01460 00133000
ST R9,VDEVSPL SAVE ADDRESS OF VSPLCTL 00134000
BAL R6,GETID GET SPOOL ID NUMBER 00135000
MVC SFBTYPE,VDEVTYPE MOVE DEVICE TYPE TO SFBBLOK 00136000
CLI VDEVTYPE,TYP3210 CONSOLE DEVICE ? 00137000
BNE SPNOCON NOT CONSOLE CONTINUE @VA11560 00138100
MVI SFBTYPE,TYPPRT FLAG AS CONSOLE PRINTER TYPE @V200930 00139000
TM VDEVSFLG,VDEVHOLD HOLD ON DEVICE @VA11560 00139100
BZ SPNOCON NO-HOLD CONTINUE @VA11560 00139150
OI SFBFLAG,SFBUHOLD SET USER HOLD @VA11560 00139200
SPNOCON EQU * @VA11560 00139250
SPACE 00140000
MVC SFBORIG,VMUSER SET UP ORIGINATING USER 00141000
MVC SFBUSER,VMUSER AND OWNING USER 00142000
ICM R1,15,VMACOUNT GET ACCOUNT BLOK IF ANY @V200930 00143000
BZ SPLCLASS NONE, GET CLASS @V200930 00144000
USING ACCTBLOK,R1 @V200930 00145000
MVC SFBUSER,ACCTUSER SET OWNER USERID @V200930 00146000
DROP R1 @V200930 00147000
SPLCLASS MVC SFBCLAS,VDEVCLAS SET CLASS FROM DEVICE @V200930 00148000
L R1,VSPVPAGE GET LOGICAL BUFFER ADDRESS 00149000
TRANS 2,1,OPT=(DEFER,BRING,SYSTEM) RESERVE A CORE BUFFER 00150000
L R8,SAVER8 VDEVBLOK DISP @VA01460 00151000
AL R8,VMDVSTRT VDEVBLOK ADDRESS @VA01460 00152000
XC SPLINK(SPSIZE),SPLINK CLEAR OUT LINKAGE AREA 00153000
XC SPCHAR(SPENDSIZ),SPCHAR CLEAR OUT END, TOO @V60B9BA 00153100
LA R1,80 GET RECORD SIZE FOR PUNCH 00154000
TM VDEVTYPE,TYPPUN IS IT A PUNCH ?? 00155000
BO STORSIZE YES -- 00156000
LA R1,150 RECORD SIZE FOR 3211 PRINTER 00157000
CLI VDEVTYPE,TYP3211 3211 PRINTER ?? 00158000
BE STORSIZE YES 00159000
LA R1,132 GET RECORD SIZE FOR ALL @V386298 00160000
* OTHER PRINTERS INCLUDING 00160100
* 3203 PRINTER 00160200
STORSIZE STH R1,SFBRECSZ AND SAVE IN SFBLOK 00161000
B OPENXIT EXIT TO CALLER 00162000
SPACE 00163000
DROP R8,R9 00164000
EJECT 00165000
*. 00166000
* 00167000
* SUBROUTINE NAME - 00168000
* 00169000
* DMKSPLOR 00170000
* 00171000
* FUNCTION - 00172000
* 00173000
* INITIALIZE CONTROL BLOKS AND BUFFERS FOR REAL INPUT READER 00174000
* FILES 00175000
* 00176000
* ATTRIBUTES - 00177000
* 00178000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00179000
* 00180000
* ENTRY POINTS - 00181000
* 00182000
* DMKSPLOR 00183000
* 00184000
* ENTRY CONDITIONS - 00185000
* 00186000
* GPR8 = ADDRESS OF RDEVBLOK FOR DEVICE 00187000
* GPR12 = DMKSPLOR BASE ADDRESS 00188000
* GPR13 = ADDRESS OF STANDARD SAVEAREA 00189000
* 00190000
* EXIT CONDITIONS - 00191000
* 00192000
* SFBLOK AND RSPLCTL WORKAREA ARE CONSTRUCTED, AND CALLER'S 00193000
* REGISTERS ARE MODIFIED AS FOLLOWS - 00194000
* 00195000
* GPR7 = ADDRESS OF NEW SFBLOK 00196000
* GPR9 = ADDRESS OF RSPLCTL WORKAREA 00197000
* 00198000
* CALLS TO OTHER ROUTINES - 00199000
* 00200000
* SAME AS DMKSPLOV, ABOVE 00201000
* 00202000
* EXTERNAL REFERENCES - 00203000
* 00204000
* NONE 00205000
* 00206000
* TABLES / WORKAREAS - 00207000
* 00208000
* NONE 00209000
* 00210000
* REGISTER USAGE - 00211000
* 00212000
* SAME AS DMKSPLOV, ABOVE, EXCEPT THAT 00213000
* GPR9 = ADDRESS OF RSPLCTL WORKAREA 00214000
* 00215000
* OPERATION - 00216000
* 00217000
* 1. CALL BUILDCTL SUBROUTINE TO CONSTRUCT SFBLOK AND RSPLCTL 00218000
* WORKAREA; IF NO DASD SPACE IS AVAILABLE, EXIT; OTHERWISE, 00219000
* CONTINUE 00220000
* 00221000
* 00222000
* 2. CALL DMKPTRAN VIA TRANS MACRO TO RESERVE AND LOCK A REAL 00223000
* CORE PAGE BUFFER; CLEAR THE BUFFER LINKAGE FIELD 00224000
* AND CLEAR END OF FIRST DASD BUFFER. 00224100
* 00225000
* 3. SET RECORD SIZE FOR READER FILE, MODIFY CALLER'S REGISTERS 00226000
* TO POINT TO NEW SFBLOK AND VSPCTL, AND EXIT 00227000
* 00228000
*. 00229000
SPACE 3 00230000
DMKSPLOR RELOC 00231000
USING RDEVBLOK,R8 00232000
USING RSPLCTL,R9 00233000
LA R0,RSPSIZE GET SIZE OF RSPLCTL CONTROL BLOK 00234000
BAL R6,BUILDCTL GO CONSTRUCT THE BLOKS 00235000
ST R9,RDEVSPL SAVE ADDRESS OF CONTROL BLOK 00236000
ST R7,RSPSFBLK SAVE ADDRESS OF SFBLOK 00237000
BAL R6,GETID GET SPOOL ID NUMBER 00238000
SPACE 00239000
L R1,RSPVPAGE GET LOGICAL BUFFER ADDRESS 00240000
TRANS 2,1,OPT=(BRING,LOCK,DEFER,SYSTEM) 00241000
ST R2,RSPRPAGE SAVE REAL ADDRESS OF BUFFER 00242000
XC SPLINK(SPSIZE),SPLINK CLEAR OUT THE LINKAGE DATA 00243000
XC SPCHAR(SPENDSIZ),SPCHAR CLEAR END, TOO @V60B9BA 00243100
MVC SPCHAR,BLANKS CLEAR CHAR ARR TBL @V60B9BA 00243200
MVC SPFCB,BLANKS CLEAR FCB @V60B9BA 00243300
MVC SPCMOD,BLANKS CLEAR COPY MODIFICATION @V60B9BA 00243400
MVI SFBRECSZ+1,80 SET RECORD SIZE FOR READER 00244000
SPACE 3 00245000
OPENXIT ICM R1,B'1111',SFBSTART SET CONDIION CODE 00246000
* CC = 0 NO DASD SPACE - CC = NONZERO DASD ADDRESS PRESENT 00247000
ST R7,SAVER7 RETURN ADDRESS OF SFBLOK @VA01460 00248000
ST R9,SAVER9 RETURN ADDRESS OF CONTROL BLOK @VA01460 00249000
EXIT -- AND RETURN TO CALLER 00250000
SPACE 2 00251000
DROP R8,R9 00252000
EJECT 00253000
*. 00254000
* 00255000
* SUBROUTINE NAME - 00256000
* 00257000
* DMKSPLCV 00258000
* 00259000
* FUNCTION - 00260000
* 00261000
* TO CLOSE AND QUEUE FOR PROCESSING A VIRTUAL PRINTER OR PUNCH 00262000
* SPOOL FILE 00263000
* 00264000
* ATTRIBUTES - 00265000
* 00266000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00267000
* 00268000
* ENTRY POINTS - 00269000
* 00270000
* DMKSPLCV 00271000
* 00272000
* ENTRY CONDITIONS - 00273000
* 00274000
* GPR7 = SFBLOK FOR FILE TO BE CLOSED 00275000
* GPR8 = DISP ADDRESS OF VDEVBLOK FOR OUTPUT DEVICE 00276000
* GPR9 = ADDRESS OF VIRTUAL SPOOL CONTROL BLOCK 00277000
* GPR11 = ADDRESS OF VMBLOK FOR USER OUTPUTTING FILE 00278000
* GPR12 = DMKSPLCV BASE ADDRESS 00279000
* GPR13 = ADDRESS OF STANDARD SAVEAREA 00280000
* 00281000
* EXIT CONDITIONS - 00282000
* 00283000
* FILE IS QUEUED FROM PROPER CHAIN FOR EITHER REAL OUTPUT, OR, 00284000
* IF IT IS XFERED, FOR INPUT TO THE XFERED-TO USER 00285000
* 00286000
* CALLS TO OTHER ROUTINES - 00287000
* 00288000
* DMKFREE - TO BUILD DUMMY IOBLOKS IN WHICH TO DELIVER DEVICE 00289000
* END INTERRUPTS TO DMKRSPEX 00290000
* DMKQCNWT - TO SEND MESSAGE TO USERS INFOMING THEM OF FILES 00291000
* THAT HAVE BEEN XFERED 00292000
* DMKSTKIO - TO STACK THE IOBLOK FOR DELIVERY TO DMKRSPEX 00293000
* DMKSCNAU - LOCATE RECEIVER VMBLOK 00294000
* DMKUDRFU - TO SEARCH FOR A USERID 00295000
* DMKUDRRD - TO READ THE USERS ACCOUNT RECORD 00296000
* DMKUDRRV - TO RESET THE DIRECTORY AFTER READING 00297000
* DMKCKSPL - CHECKPOINT THE SFBLOK 00298000
* 00299000
* EXTERNAL REFERENCES - 00300000
* 00301000
* DMKRIODV - START OF REAL DEVICE TABLE - REFERENCED VIA ADCON 00302000
* ARIODV IN PSA 00303000
* DMKVIOMK - TABLE OF HALF-WORD PENDING FLAGS IN VIOEXEC USED 00304000
* TO POST PENDING INTERRUPTS FOR RECEIVERS OF 00305000
* XFERED FILES 00306000
* 00307000
* TABLES / WORKAREAS - 00308000
* 00309000
* DMKRSPID - SYSTEM SPOOLID COUNTER 00310000
* DMKRSPHQ - ANCHOR FOR SYSTEM HOLD QUEUE 00311000
* 00312000
EJECT 00313000
* 00314000
* REGISTER USAGE - 00315000
* 00316000
* GPR0-5 ARE WORK REGISTERS 00317000
* GPR6 = INTERNAL SUBROUTINE LINKAGE AND VCHBLOK ADDRESS 00318000
* GPR7 = ADDRESS OF SFBLOK 00319000
* GPR8 = ADDRESS OF VDEVBLOK 00320000
* GPR9 = ADDRESS OF VSPLCTL 00321000
* GPR10 = ADDRESS OF IOBLOK 00322000
* GPR11 = ADDRESS OF VMBLOK 00323000
* GPR12 = DMKSPL BASE REGISTER 00324000
* GPR13 = ADDRESS OF SAVEAREA 00325000
* GPR14,15 ARE FOR BALR LINKAGE AND SCRATCH 00326000
* 00327000
* OPERATION - 00328000
* 00329000
* 0. MOVE INTO THE FIRST DASD BUFFER, THE TAG, AND ALL FIELDS 00330000
* THAT OCCUR AT THE END OF THE FIRST DASD BUFFER. 00331000
* 00332000
* 1. IF FILE IS XFERED (SPOOLED), CONTINUE; OTHERWISE, 00333000
* GO TO STEP 6. 00334000
* 00335000
* 2. PLACE USERID OF XFERED 'TO USER' IN SFBLOK, 00336000
* AND SEND MESSAGE TO SENDER VERIFYING XFER 00337000
* 00338000
* 3. LOCATE THE VMBLOK FOR THE XFERED-TO USER; IF HE IS NOT 00339000
* LOGGED IN, EXIT; OTHERWISE CONTINUE 00340000
* 00341000
* 4. IF THE XFERED-TO USER IS THE SAME AS THE SENDER, GO TO STEP 00342000
* 5; OTHERWISE, SEND HIM A MESSAGE 00343000
* 00344000
* 5. LOCATE AN AVAILABLE READER DEVICE TO RECIEVE THE XFERED 00345000
* FILE AND POST IT WITH A DEVICE END INTERRUPT; THEN EXIT 00346000
* 00347000
* 6. IF FILE IS TO BE QUEUED FOR REAL OUTPUT, CHAIN THE SFBLOK 00348000
* TO THE PROPER CHAIN, IF FILE IS HELD BY USER OR 00349000
* SYSTEM: EXIT, OTHERWISE TRY TO FIND AN AVAILABLE PRINTER 00350000
* OR PUNCH WITH THE SAME CLASS SPECIFICATIONS AS THE FILE 00351000
* 00352000
* 7. IF NO PRINTER IS FOUND, EXIT; OTHERWISE, CONSTRUCT AN 00353000
* IOBLOK CONTAINING A DEVICE END INTERRUPT AND STACK IT FOR 00354000
* THE APPROPRIATE REAL DEVICE VIA A CALL TO DMKSTKIO; 00355000
* THEN EXIT 00356000
* 00357000
* 00358000
* RESPONSE - 00359000
* 00360000
* CON FOR 00361000
* PUN FILE (SPOOLID) TO (USERID) COPY NN NOHOLD 00362000
* PRT FROM HOLD 00363000
* 00364000
* 00365000
* 00366000
*. 00367000
SPACE 3 00368000
DMKSPLCV RELOC 00369000
USING VDEVBLOK,R8 00370000
AL R8,VMDVSTRT VDEVBLOK ADDRESS @VA01460 00371000
L R6,VDEVEXTN XBLOK ADDRESS @V293598 00372000
SR R5,R5 CLEAR COUNT REG @V293598 00375000
IC R5,VSPXTGLN-VSPXBLOK(R6) SET TAG CHAR COUNT @V293598 00376000
L R0,SFBSTART DASD ADDR OF FIRST PAGE BUFFER @V293598 00379000
L R1,VDEVSPL SPOOL CONTROL BLOK @V293598 00380000
L R1,VSPVPAGE-VSPLCTL(R1) SYS VIRT PAGE ADDR @V293598 00381000
CALL DMKRPAGT,PARM=BRING+SYSTEM READ IN PAGE BUFFER @V293598 00382000
BNZ SKIPALL FORGET SETTING SPLINK FIELDS @V60B9BA 00383000
CLI 16(R2),X'03' HAS A TAG RECORD BEEN INITIALIZED ?@V293598 00384000
BNE SKIPTAG FORGET IT IF NOT @V293598 00385000
TM 20(R2),SKIP IS THERE A DATA FIELD HERE ?? @V293598 00386000
BO SKIPTAG DON'T TRY TO SET TAG IF NOT @V293598 00387000
LTR R5,R5 IS THE TAG LENGTH ZERO @V60B9BA 00387100
BZ SKIPTAG XFER IF SO @V60B9BA 00387200
BCTR R5,0 TAG DATA COUNT -1 @V293598 00388000
EX R5,TAGMOVE MOVE IN THE CURRENT TAG DATA@V293598 00389000
SPACE 00389010
USING VSPXBLOK,R6 ADDRESSIBILITY @V60B9BA 00389020
SKIPTAG MVC SPCHAR,VSPXCHAR CHAR ARR TABLE @V60B9BA 00389030
MVC SPFCB,VSPXFCB FCB VALUE @V60B9BA 00389040
MVC SPCMOD,VSPXCMOD COPY MODIFICATION VALUE @V60B9BA 00389050
MVC SPFLSHC,VSPXFLSH FLASH COUNT @V60B9BA 00389060
TM VSPXFLG1,VSPXCPYF COPY FLAG SET ? @V60B9BA 00389070
BZ *+8 XFER IF NOT @V60B9BA 00389080
OI SPFLAG1,SPCOPYFG SET IT ON DASD BUFFER @V60B9BA 00389090
MVC SFBFLASH,VSPXOVLY SET FLASH NAME IN SFBLOK @V60B9BA 00389100
DROP R6 NO LONGER NEEDED @V60B9BA 00389110
CALL DMKRPAPT,PARM=SYSTEM AND REWRITE THE BUFFER @V293598 00390000
SKIPALL EQU * @V60B9BA 00391000
L R8,SAVER8 GET VDEVBLOK ADDR @V293598 00392000
AL R8,VMDVSTRT . . . @V293598 00393000
MVC SFBCOPY,VDEVCOPY SET COPIES @V200930 00394000
CLI SFBDIST,C' ' IS DIST IN FILE ?? @V200930 00395000
BH SPLTEST YES, SKIP PUTTING IT IN @V200930 00396000
MVC SFBDIST,VMDIST SET USERS DIST CODE @V200930 00397000
ICM R1,15,VMACOUNT GET ACCOUNT BLOK IF ANY @V200930 00398000
BZ SPLTEST NONE, CONT @V200930 00399000
USING ACCTBLOK,R1 @V200930 00400000
MVC SFBDIST,ACCTDIST SET OWNERS DISTCODE @V200930 00401000
DROP R1 @V200930 00402000
SPLTEST TM VDEVSFLG,VDEVFOR+VDEVXFER 'FOR' OR 'TO' USERID @V200930 00403000
BZ SETHOLD NO, CONT @V200930 00404000
TM VDEVSFLG,VDEVXFER SPOOL TO ? @VA09714 00404100
BO SETHOLD IF SO, DON'T CHANGE DISTCODE AND @VA09714 00404200
* NO NEED TO SEARCH DIRECTORY 00404300
LA R0,UDBFSIZE GET DIRECT BUFFER SIZE @V200930 00405000
CALL DMKFREE @V200930 00406000
LR R2,R1 BUFFER ADDRESS @V200930 00407000
USING UDBFBLOK,R2 @V200930 00408000
XC UDBFVADD(8),UDBFVADD CLEAR FOR CALL @V200930 00409000
LA R0,8 USERID SIZE @V200930 00410000
L R6,VDEVEXTN XBLOK ADDRESS @V293598 00411000
* USERID TO SEARCH 00412000
MVC SAVEWRK8(8),VSPXXUSR-VSPXBLOK(R6) @V293598 00413000
LA R1,SAVEWRK8 .. @VA01460 00414000
CALL DMKUDRFU FIND THE USER @V200930 00415000
BZ UDRDIST OK, CHECK THE DIST CODE @V200930 00416000
B NODIST1 DIDNT FIND HIM @V200930 00417000
SPACE 00418000
TAGMOVE MVC 28(0,R2),VSPXTAG-VSPXBLOK(R6) EXECUTED ABOVE @V293598 00419000
SPACE 2 00420000
UNDIST CALL DMKUDRRV RELEASE DIRECTORY @V200930 00421000
NODIST1 LA R0,UDBFSIZE SIZE @V200930 00422000
LR R1,R2 BUFFER @V200930 00423000
CALL DMKFRET RETURN @V200930 00424000
B SETHOLD CONT @V200930 00425000
SPACE 00426000
USING UDIRBLOK,R2 @V200930 00427000
UDRDIST LA R1,UDIRDISP GET DASD DISP @V200930 00428000
CALL DMKUDRMD READ ACCOUNT BLOCK @V407466 00429000
BNZ UNDIST NO GO, GET OUT @V200930 00430000
USING UMACBLOK,R2 @V200930 00431000
MVC SFBDIST,UMACDIST SET FOR USERID DIST @V200930 00432000
B UNDIST RETRUN BUFFER AND CONT @V200930 00433000
DROP R2 @V200930 00434000
SPACE 00435000
SETHOLD NI SFBFLAG,X'FF'-SFBUHOLD NO USER HOLD @V200930 00436000
L R8,SAVER8 VDEVBLOK DISP @VA01460 00437000
AL R8,VMDVSTRT VDEVBLOK ADDRESS @VA01460 00438000
TM SFBFLAG2,SFBHOLD HOLD WITH CLOSE ?? @V200930 00439000
BO UHOLD YES, HOLD FILE @V200930 00440000
TM SFBFLAG2,SFBNOHLD NOHOLD WITH CLOSE ?? @V200930 00441000
BO NOHOLD YES, NOHOLD FILE @V200930 00442000
TM VDEVSFLG,VDEVHOLD HOLD ON DEVICE ?? @V200930 00443000
BZ NOHOLD NO, CONT @V200930 00444000
UHOLD OI SFBFLAG,SFBUHOLD SET USER HOLD @V200930 00445000
NOHOLD NI SFBFLAG2,X'FF'-SFBHOLD-SFBNOHLD-SFBREQUE @V200930 00446000
NI SFBFLAG2,X'FF'-SFBRSTRT @V200930 00447000
LA R0,6 GET STORAGE FOR MSG BUFFER @VA03327 00448000
CALL DMKFREE @VA03327 00449000
LR R2,R1 MSG BUFFER ADDR. IN R2 @VA03327 00450000
ST R2,SAVEWRK2 SAVE ADDR. @VA03327 00451000
USING XFRMSGCT,R2 @VA03327 00452000
MVI XFRMSG1,C' ' BLANK OUT MSG BUFFER @VA03327 00453000
MVC XFRMSG1+1(41),XFRMSG1 @VA03327 00454000
MVC XFRMSGFI,=C'FILE' INITIALIZE MESSAGE @VA03327 00455000
MVC XFRMSGID,=C'0000' @VA03327 00456000
MVC XFRMSGCP,=C'COPY' @VA03327 00457000
L R15,ARSPPR GET PRINTER CHAIN @VA03327 00458000
L R5,ARIOPR GET PRINTER SPOOL LIST @VA03327 00459000
MVC XFRMSG1,=C'PRT' ASSUME PRINTER @V200930 00460000
TM VDEVTYPE,TYPPRT IS IT A PRINTER ?? @V200930 00461000
BO TSTXFR YES, TEST FOR XFER @V200930 00462000
MVC XFRMSG1,=C'CON' ASSUME CONSOLE @V200930 00463000
CLI VDEVTYPE,TYP1052 IS IT A CONSOLE ?? @V200930 00464000
BE TSTXFR YES, TSET FOR XFER @V200930 00465000
L R15,ARSPPU GET PUNCH CHAIN @V200930 00466000
L R5,ARIOPU GET PUNCH SPOOL LIST @V200930 00467000
MVC XFRMSG1,=C'PUN' PUNCH DEVICE @V200930 00468000
TSTXFR TM VDEVSFLG,VDEVXFER+VDEVFOR TO OR FOR USERID ?? @V200930 00469000
BZ CHAINIT NO, SCHEDULE FOR REAL OUTPUT @V200930 00470000
L R6,VDEVEXTN XBLOK ADDRESS @V293598 00471000
MVC SFBUSER,VSPXXUSR-VSPXBLOK(R6) SET NEW OWNER ID @V293598 00472000
TM VDEVSFLG,VDEVXFER TO USERID ?? @V200930 00473000
BZ CHAINIT NO, CHAIN TO CORRECT LIST @V200930 00474000
L R15,ARSPRD GET READER CHAIN @V200930 00475000
B CHAINIT GO CHAIN THIS SPOOL FILE @V200930 00476000
SPACE 00477000
MSGRECVR BAL R6,GETUSER GO LOCATE VMBLOK OF RECEIVING USER 00478000
BNZ FRETMSG2 USER NOT CURRENTLY LOGGED IN @VA03327 00479000
CR R1,R11 XFERED TO SELF ?? 00480000
BE FRETMSG1 YES -- NO MESSAGE @VA03327 00481000
SWTCHVM OPT=STAY SWITCH VMBLOK LOCKING & CHARGING @V407511 00482100
TM VMMLEVEL,VMMSGON RECEIVING MESSAGES ?? 00485000
BZ FRETMSG1 NO -- GO FRET MSG BUFFER @VA03327 00486000
L R2,SAVEWRK2 MAKE SURE R2 POINTS TO MSG. @VA03327 00487000
MVC XFRMSG3,SFBORIG MOVE IN ID OF FILE SENDER 00488000
MVC XFRMSG2(5),=C'FROM ' 00489000
LA R0,XFRMSG1L LENGTH 00490000
LR R1,R2 MSG BUFFER ADDR. IN R1 @VA03327 00491000
L R2,=A(NOTRESP) INDICATE A NON-COMMAND MSG @V60C2B8 00492100
CALL DMKQCNWT,PARM=NORET(,R2) WRITE MSG @V60C2B8 00492200
FRETMSG1 LA R6,SETPEND RETURN TO MAINLINE ADDR. @VA03327 00493000
B FRETMSG DO FRET @VA03327 00494000
FRETMSG2 LA R6,CLEXIT RETURN TO MAINLINE ADDR. @VA03327 00495000
FRETMSG L R1,SAVEWRK2 MAKE SURE WE HAVE MSG ADDR. @VA03327 00496000
LA R0,6 MSG BUFFER SIZE (DBLWRDS) @VA03327 00497000
CALL DMKFRET @VA03327 00498000
BR R6 RETURN TO PROPER MAINLINE CODE @VA03327 00499000
EJECT 00500000
CHAINIT ST R15,SAVEWRK1 SAVE THE ANCHOR FOR LATER @V304298 00501000
LA R2,RDRCHN ASSUME IT GOES ON RDR CHAIN @V304298 00502000
C R15,ARSPRD DOES IT ? @V304298 00503000
BE CHAINIT2 XFER IF SO @V304298 00504000
LA R2,PCHCHN ASSUME IT GOES ON PUNCH CHAIN @V304298 00505000
C R15,ARSPPU DOES IT ? @V304298 00506000
BE CHAINIT2 XFER IF SO @V304298 00507000
LA R2,PRTCHN THEN IT GOES ON PRINT CHAIN @V304298 00508000
CHAINIT2 CLI VDEVTYPE,TYP1052 CLOSING A CONSOLE FILE ? @VM02132 00509000
BNE CHAINIT3 NO, THEN THIS IS AN ADD @VM02132 00510000
LA R2,CHGSFB(,R2) YES, THEN THIS IS A CHANGE @VM02132 00511000
B CHAINIT4 CHECKPOINT IT ........ @VM02132 00512000
CHAINIT3 LA R2,ADDSFB(,R2) SET FLAG TO ADD SFBLOK @VM02132 00513000
CHAINIT4 SL R8,VMDVSTRT VDEVBLOK DISPLACEMENT @VM02132 00514000
CALL DMKCKSPL PERFORM CHECKPOINT @VM02132 00515000
AL R8,VMDVSTRT VDEVBLOK DISPLACEMENT @V304298 00516000
L R15,SAVEWRK1 RESTORE THE ANCHOR @V304298 00517000
BAL R6,SFBCHAIN GO CHAIN THE BLOCK @V304298 00518000
USING VSPLCTL,R9 @VA01375 00519000
XC VSPSFBLK(4),VSPSFBLK CLEAR SFBLOK POINTER @VA01375 00520000
DROP R9 @VA01375 00521000
SPACE 00522000
LH R1,SFBCOPY GET NUMBER OF COPIES 00523000
CALL DMKCVTBD CONVERT COPY NUMBER 00524000
L R2,SAVEWRK2 RESTORE R2 WITH MSG BUFFER ADDR.@VA03327 00525000
STCM R1,3,XFRCOPY SAVE COPIES @V200930 00526000
LH R1,SFBFILID GET AND CONVERT SPOOLID 00527000
CALL DMKCVTBD .. 00528000
STCM R1,15,XFRMSGID MOVE SPOOLID INTO MSG 00529000
MVC XFRHOLD,=C'NOHOLD' ASSUME NOHOLD @V200930 00530000
TM SFBFLAG,SFBUHOLD ANY USER HOLD ?? @V200930 00531000
BZ *+10 NO, CONT @V200930 00532000
MVC XFRHOLD(2),BLANKS FLAG HOLD @V200930 00533000
MVC XFRMSG3,VMUSER ASSUME NO TO OR FOR USERID @V200930 00534000
LA R6,SPLCONT SET CONT ADDRESS @V200930 00535000
MVC XFRMSG2,=C' FOR ' ASSUME FOR USERID @V200930 00536000
TM VDEVSFLG,VDEVXFER+VDEVFOR TO OR FOR USERID ?? @V200930 00537000
BZ TSTCPY NO, TEST FOR MORE THAN 1 COPY @V200930 00538000
MVC XFRMSG3,SFBUSER SET TO USERID @V200930 00539000
TM VDEVSFLG,VDEVXFER IS IT TO USERID ?? @V200930 00540000
BZ TSTMSG NO, TEST FOR MESSAGE @V200930 00541000
MVC XFRMSG2,=C' TO ' SET TO @V200930 00542000
LA R6,MSGRECVR SET CONT ADDRESS @V200930 00543000
TSTMSG TM VMMLEVEL,VMMSGON RECIEVING MESSAGES ?? @V200930 00544000
BCR 8,R6 NO, CONTINUE @V200930 00545000
TM VDEVFLAG,VDEVCSPL CONSOLE SPOOLED ? @VA04213 00545250
BNO *+8 NO...NO DELAY @VA04213 00545500
OI VDEVFLAG,VDEVDLY DELAY MSG INTO SPOOL FILE @VA04213 00545750
LA R0,XFRMSG1L GET SIZE @V200930 00546000
LR R1,R2 MSG BUFFER ADDR. IN R1 @VA03327 00547000
DROP R2 @VA03327 00548000
CALL DMKQCNWT,PARM=NORET OUTPUT MESSAGE @V200930 00549000
L R8,SAVER8 VDEVBLOK DISP @VA01460 00550000
AL R8,VMDVSTRT VDEVBLOK ADDRESS @VA01460 00551000
BR R6 CONTINUE @V200930 00552000
TSTCPY LH R1,SFBCOPY GET COPIES @V200930 00553000
C R1,F1 MORE THAN 1 ?? @V200930 00554000
BE TSTHLD NO, TEST FOR HOLD @V200930 00555000
B TSTMSG TES AND SEND MESSAGE @V200930 00556000
TSTHLD TM SFBFLAG,SFBUHOLD USER HOLD ON FILE ?? @V200930 00557000
BO TSTMSG YES, TEST AND SEND MESSAGE @V200930 00558000
SPLCONT DS 0H @V200930 00559000
BAL R6,FRETMSG GO FRET MSG BUFFER @VA03327 00560000
SPACE 00561000
USING SHQBLOK,R2 00562000
SPACE 00563000
SR R1,R1 GET DEVICE 00564000
IC R1,SFBTYPE TYPE 00565000
L R14,=A(DMKRSPHQ) ADDRESS OF SPOOL HOLD QUEUE 00566000
* POINTER 00567000
NEXTSHQ L R2,0(R14) LOAD ADDRESS OF THE FIRST BLOK 00568000
LTR R2,R2 POINTER ZERO ?? 00569000
BZ TSTHOLD YES -THE LIST IS EMPTY OR NO HOLD 00570000
* BLOK FOR THIS USER. GO CHECK SYSTEM 00571000
SPACE 00572000
CLC SHQUSER(8),SFBUSER IS THIS HOLD Q BLOK FOR THIS USER ?? 00573000
BE SHQEQUAL YES 00574000
LR R14,R2 SAVE CURRENT BLOK ADDRESS 00575000
B NEXTSHQ GO CHECK NEXT BLOK 00576000
SPACE 00577000
SHQEQUAL EX R1,USERSYS IS USER 'SYS HOLD' FLAG ON ?? 00578000
BZ *+8 NO-- CHECK ANY HOLD 00579000
OI SFBFLAG,SFBSHOLD SET SYS HOLD IN SFBLOK 00580000
* FILE BEING HELD BY USER REQUEST 00581000
TSTHOLD TM SFBFLAG,SFBUHOLD+SFBSHOLD IS FILE BEING HELD BY 00582000
* USER AND/OR CLASS D USER ?? 00583000
BNZ CLOSEXIT YES - NO DEVICE END TO DEVICE 00584000
SPACE 00585000
* TRY TO FIND AN AVAILABLE OUTPUT DEVICE 00586000
ICM R0,B'1111',0(R5) GET DEVICE COUNT (PRINTERS OR 00587000
* PUNCHES) 00588000
BZ CLOSEXIT NO AVAILABLE DEVICE -- 00589000
NEXTRDEV SWITCH ENSURE WE ARE ON THE MAIN PROC @V407511 00590100
LA R5,4(,R5) POINT TO NEXT LIST ENTRY @V407511 00590600
LH R6,0(,R5) GET RDEVTABLE INDEX 00591000
SLL R6,3(0) CONVERT TO BYTE INDEX @V200820 00592000
A R6,ARIODV POINT TO REAL DEVICE BLOK 00593000
USING RDEVBLOK,R6 TEMPORARY ADDRESSABILITY 00594000
L R1,RDEVSPL IS THE DEVICE BUSY WITH A FILE 00595000
LTR R1,R1 ??? 00596000
BNZ RDEVCNT YES -- 00597000
TM RDEVSTAT,RDEVDISA+RDEVDED IS THE DEVICE AVAILABLE ?? 00598000
BNZ RDEVCNT NO -- 00599000
TM RDEVFLAG,RDEVDRAN+RDEVACNT IS THE DEVCIE AVAILABLE ?? 00600000
BNZ RDEVCNT NO -- 00601000
SPACE 00602000
GETCLASS L R3,RDEVCLAS GET THE DEVICES CLASSES 00603000
SPACE 00604000
CLASTEST SLDL R2,8 ISOLATE THE NEXT CLASS 00605000
EX R2,CLICLASS DO THE CLASSES MATCH ?? 00606000
BE RDVFOUND YES -- 00607000
EX R2,CLIANY TEST FOR ANY CLASS @V200930 00608000
BE RDVFOUND YES, FOUND A DEVICE @V200930 00609000
LTR R3,R3 ANY MORE CLASSES TO TEST ?? 00610000
BNZ CLASTEST YES -- 00611000
SPACE 00612000
RDEVCNT BCT R0,NEXTRDEV GO LOOK AT NEXT DEVICE ON LIST 00613000
B CLOSEXIT NO AVAILABLE DEVICE -- 00614000
SPACE 00615000
CLICLASS CLI SFBCLAS,0 COMPARE CLASS 00616000
CLIANY CLI =C'*',0 EXECUTED FOR ANY CLASS @V200930 00617000
SPACE 00618000
RDVFOUND LA R0,IOBSIZE GET CORE FOR 00619000
CALL DMKFREE AN IOBLOK 00620000
LR R10,R1 ADDRESSABILITY IN GPR10 00621000
XC IOBLOK(IOBSIZE*8),IOBLOK CLEAR IT OUT 00622000
ST R10,IOBLINK IOBLOK POINTS TO ITSELF (= ORIGINAL COPY) 00623000
MVI IOBCSW+4,DE FAKE A DEVIC END 00624000
L R1,ASYSVM LOAD ADDR NEW VMBLOK @V407511 00625100
SWTCHVM OPT=UNLOCK SWITCH VMBLOK LOCKING & CHARGING @V407511 00625600
ST R11,IOBUSER STORE ADDRESS OF SYSTEM 00628000
MVC IOBRADD,2(R5) FOR THE RIGHT DEVICE 00629000
MVC IOBIRA,=V(DMKRSPEX) SEND THE 00630000
CALL DMKSTKIO IOBLOK TO DMKRSPEX 00631000
SPACE 00632000
B CLOSEXIT AND LEAVE 00633000
SPACE 00634000
* 00635000
* TYPPUN EQU TO PUNCH 00636000
* TYPPRT EQU TO PRINTER 00637000
* 00638000
USERSYS TM SHQSHOLD,X'00' TEST FOR SYSTEM HOLD 00639000
* SHQBLOK 00640000
SPACE 00641000
DROP R2 00642000
DROP R8 00643000
DROP R6 @VM01016 00644000
EJECT 00645000
*. 00646000
* 00647000
* SUBROUTINE NAME - 00648000
* 00649000
* DMKSPLCR 00650000
* 00651000
* FUNCTION - 00652000
* 00653000
* TO CLOSE AND QUEUE FOR VIRTUAL INPUT A REAL READER SPOOL 00654000
* FILE 00655000
* 00656000
* ATTRIBUTES - 00657000
* 00658000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00659000
* 00660000
* ENTRY POINTS - 00661000
* 00662000
* DMKSPLCR 00663000
* 00664000
* ENTRY CONDITIONS - 00665000
* 00666000
* GPR7 = ADDRESS OF SFBLOK FOR FILE THAT IS TO BE CLOSED 00667000
* GPR8 = ADDRESS OF RDEVBLOK FOR REAL READER FILE 00668000
* GPR9 = ADDRESS OF REAL SPOOL CONTROL BLOCK 00669000
* GPR12 = BASE REGISTER FOR DMKSPLCR 00670000
* GPR13 = ADDRESS OF STANDARD SAVEAREA 00671000
* 00672000
* EXIT CONDITIONS - 00673000
* 00674000
* THE SFBLOK IS QUEUED FROM THE READERS CHAIN, AND IF THE 00675000
* FILES OWNER IS CURRENTLY LOGGED ON TO THE SYSTEM HIS CARD 00676000
* READER IS POSTED WITH A DEVICE END 00677000
* 00678000
* CALLS TO OTHER ROUTINES - 00679000
* 00680000
* SAME AS DMKSPLCV ABOVE. 00681000
* 00682000
* EXTERNAL REFERENCES - 00683000
* 00684000
* DMKVIOMK 00685000
* 00686000
* TABLES /WORKAREAS - 00687000
* 00688000
* NONE 00689000
* 00690000
* REGISTER USAGE - 00691000
* 00692000
* GPR8 = ADDRESS OF RDEVBLOK FOR REAL READER, AND ADDRESS OF 00693000
* VDEVBLOK FOR VIRTUAL READER IF THE FILE'S OWNER IS 00694000
* LOGGED ON TO THE SYSTEM 00695000
* FOR THE REMAINDER OF THE REGISTERS, USAGE IS THE SAME AS IN 00696000
* DMKSPLCV DESCRIBED ABOVE 00697000
EJECT 00698000
* 00699000
* OPERATION - 00700000
* 00701000
* 1. CHAIN THE SFBLOK TO THE READERS CHAIN, ESTABLISHING THE 00702000
* PROPER FILE ID 00703000
* 00704000
* 2. LOCATE THE VMBLOK FOR THE FILES OWNER; IF HE IS NOT LOGGED 00705000
* ON AT THIS TIME, EXIT; OTHERWISE, CONTINUE 00706000
* 00707000
* 3. LOCATE AND AVAILABLE READER, CONSTRUCT AN 00708000
* IOBLOK CONTAINING A DEVICE END INTERRUPT AND 00709000
* STACK IT FOR THE APPROPRIATE VIRTUAL DEVICE VIA CALL 00710000
* TO DMKSTKIO. 00711000
* 00712000
* RESPONSE - 00713000
* 00714000
* RDR FILE (SPOOLID) HAS BEEN READ 00715000
* 00716000
*. 00717000
SPACE 3 00718000
DMKSPLCR RELOC 00719000
L R15,ARSPRD POINT TO READER FILE CHAIN 00720000
BAL R6,SFBCHAIN AND CHAIN THE BLOK 00721000
MVI SFBTYPE,TYPRDR SET DEVICE TYPE @VA07699 00721500
CALL DMKCKSPL,PARM=ADDSFB+RDRCHN CHECKPOINT @V304298 00722000
USING RSPLCTL,R9 @VA01375 00723000
XC RSPSFBLK(4),RSPSFBLK CLEAR SFBLOK POINTER @VA01375 00724000
DROP R9 @VA01375 00725000
BAL R6,GETUSER SEE IF DESTINATION USER IS ON THE 00727000
* SYSTEM 00728000
BNZ CLEXIT NOT LOGGED ON NOW - 00729000
SWTCHVM OPT=STAY SWITCH VMBLOK LOCKING & CHARGING @V407511 00730100
TM VMMLEVEL,VMMSGON IS THE USER RECEIVING ?? 00733000
BZ SETPEND NO - 00734000
LA R0,4 SIZE OF MSG BUFFER @VA03327 00735000
CALL DMKFREE @VA03327 00736000
LR R2,R1 MSG BUFFER ADDR. IN R2 @VA03327 00737000
ST R2,SAVEWRK2 SAVE IT @VA03327 00738000
LH R1,SFBFILID GET AND CONVERT SPOOLID 00739000
CALL DMKCVTBD 00740000
L R2,SAVEWRK2 MAKE SURE R2 IS CORRECT @VA03327 00741000
USING RDRMSGCT,R2 @VA03327 00742000
MVI RDRMSG,C' ' BLANK OUT MSG BUFFER @VA03327 00743000
MVC RDRMSG+1(26),RDRMSG @VA03327 00744000
MVC RDRMSG,=C'RDR FILE' INITIALIZE MESSAGE @VA03327 00745000
MVC RDRMSGE,=C'HAS BEEN READ' @VA03327 00746000
STCM R1,15,RDRMSGF SET SPOOLID @V200930 00747000
LA R0,RDRMSGL SET SIZE @V200930 00748000
LR R1,R2 MSG BUFFER ADDR. IN R2 @VA03327 00749000
DROP R2 @VA03327 00750000
L R2,=A(NOTRESP) INDICATE A NON-COMMAND MSG @V60C2B8 00751100
CALL DMKQCNWT,PARM=NORET(,R2) WRITE MSG @V60C2B8 00751200
L R1,SAVEWRK2 ADDR. TO BE FRETTED @VA03327 00752000
LA R0,4 SIZE IN R0 @VA03327 00753000
CALL DMKFRET @VA03327 00754000
SPACE 3 00755000
SETPEND EQU * HERE TO POST PENDIN INTERRUPT @VM01016 00756000
SPACE 00757000
USING VCHBLOK,R6 @VM01016 00758000
USING VCUBLOK,R9 @VM01016 00759000
USING VDEVBLOK,R8 @VM01016 00760000
SPACE 00761000
SR R1,R1 CLEAR CHANNEL TABLE INDEX @VM01016 00762000
LA R4,2 GET GENERAL INDEX INCREMENT @VM01016 00763000
LA R5,30 GET GENERAL COMPARAND FOR BXLE @VM01016 00764000
SPACE 00765000
NEXTCH LH R6,VMCHTBL(R1) GET INDEX TO NEXT VIRTUAL CHANNEL@VM01016 00766000
LTR R6,R6 IS THERE ONE AT THIS ADDRESS @VM01016 00767000
BM CHINDEX NO -- @VM01016 00768000
A R6,VMCHSTRT POINT TO VCHBLOK @VM01016 00769000
SR R2,R2 CLEAR CU TABLE INDEX @VM01016 00770000
NEXTCU LH R9,VCHCUTBL(R2) GET INDEX TO VIRTUAL CU BLOK @VM01016 00771000
LTR R9,R9 IS THERE ONE AT THIS ADDRESS ? @VM01016 00772000
BM CUINDEX NO -- @VM01016 00773000
A R9,VMCUSTRT POINT TO VCUBLOK @VM01016 00774000
SR R3,R3 CLEAR DEVICE BLOK TABLE INDEX @VM01016 00775000
NEXTDEV LH R8,VCUDVTBL(R3) GET INDEX TO DEVICE BLOK @VM01016 00776000
LTR R8,R8 IS THERE ONE AT THIS ADDRESS @VM01016 00777000
BM DEVINDEX NO -- @VM01016 00778000
A R8,VMDVSTRT POINT TO DEVICE BLOK @VM01016 00779000
SPACE 00780000
CLI VDEVTYPC,CLASURI INPUT DEVICE @VM01016 00781000
BNE DEVINDEX NO - @VM01016 00782000
TM VDEVTYPE,TYPRDR IS IT THE RIGHT TYPE ?? @VM01016 00783000
BZ DEVINDEX NO -- @VM01016 00784000
TM VDEVSTAT,X'FF' ANY STATUS PENDING ?? @VM01016 00785000
BNZ DEVINDEX YES, CHECK NEXT DEVICE @VM01016 00786000
CLI VDEVCLAS,C'*' ALL CLASS READER ? @VM01016 00787000
BE TSTBUSY YES, TEST FOR ACTIVE DEVICE @VM01016 00788000
CLC VDEVCLAS(1),SFBCLAS FILE CLASS SAME AS DEVICE ? @VM01016 00789000
BNE DEVINDEX NO - @VM01016 00790000
TSTBUSY ICM R14,B'1111',VDEVSPL IS THE DEVICE BUSY ?? @VM01016 00791000
BZ RDRPEND NO -- FINALLY FOUND A DEVICE @VM01016 00792000
SPACE 00793000
DEVINDEX BXLE R3,R4,NEXTDEV INDEX TO NEXT DEVICE ON CONTROL @VM01016 00794000
* UNIT 00795000
CUINDEX BXLE R2,R4,NEXTCU INDEX TO NEXT CONTROL UNIT ON @VM01016 00796000
* CHANNEL 00797000
CHINDEX BXLE R1,R4,NEXTCH INDEX TO NEXT CHANNEL ON MACHINE @VM01016 00798000
B CLOSEXIT NO DEVICE FOUND @VM01016 00799000
SPACE 00800000
RDRPEND EQU * HERE TO QUEUE DEVICE END @VM01016 00801000
LA R0,IOBSIZE @VM01016 00802000
CALL DMKFREE @VM01016 00803000
LR R10,R1 ADDRESS OF IOBLOK @VM01016 00804000
XC IOBLOK(IOBSIZE*8),IOBLOK CLEAR BLOK @VM01016 00805000
ST R10,IOBLINK INDICATE ORIGINAL COPY @VM01016 00806000
MVI IOBCSW+4,DE FAKE DEVICE END CSW @VM01016 00807000
ST R11,IOBUSER MOVE USER ADDRESS OF VMBLOK @VM01016 00808000
MVC IOBIRA,=A(DMKVIOIN) RETURN ADDRESS @VM01016 00809000
LH R5,VDEVADD GET FULL ADDRESS OF DEVICE @VM01016 00810000
LH R4,VCUADD .. @VM01016 00811000
OR R5,R4 .. @VM01016 00812000
AH R5,VCHADD .. @VM01016 00813000
STH R5,IOBVADD PUT ADDRESS IN IOBLOK @VM01016 00814000
OI VDEVSTAT,VDEVPEND SET PENDING FLAG @VM01016 00815000
OI IOBSPEC,IOBUNSL INDICATE UNSOLICITED INTERRUPT 00815050
MVC VDEVCSW(8),IOBCSW MOVE IN DEVICE END CSW @VM01016 00816000
CALL DMKSTKIO GO STACK IO @VM01016 00817000
SPACE 3 00818000
DROP R6 @VM01016 00819000
DROP R8 @VM01016 00820000
DROP R9 @VM01016 00821000
DROP R10 @VM01016 00822000
CLOSEXIT EQU * @VM01016 00823000
L R1,SAVER11 LOAD ADDR NEW VMBLOK @V407511 00824100
SWTCHVM OPT=STAY SWITCH VMBLOK LOCKING & CHARGING @V407511 00824600
CLEXIT EXIT 00827000
EJECT 00828000
BUILDCTL EQU * HERE TO BUILD SPOOLING CONTROL BLOKS 00829000
CALL DMKFREE GET CORE FOR SPOOLING CONTROL 00830000
LR R9,R1 SAVE IT 00831000
LR R1,R0 GET LENGTH OF BLOK IN DOUBLE WORDS 00832000
SLL R1,3 GET LENGTH IN BYTES 00833000
BCTR R1,0 LESS ONE FOR EXECUTE 00834000
EX R1,CLEAR CLEAR THE BLOK TO ZERO 00835000
LA R0,SFBSIZE GET CORE FOR A SPOOL FILE BLOK 00836000
CALL DMKFREE 00837000
LR R7,R1 SAVE IT 00838000
XC SFBLOK(SFBSIZE*8),SFBLOK CLEAR IT OUT 00839000
CALL DMKPGTVG OBTAIN A LOGICAL BUFFER 00840000
ST R1,RSPVPAGE-RSPLCTL(,R9) SAVE ITS ADDRESS 00841000
CALL DMKPGTSG GET A DASD BUFFER 00842000
ST R1,SFBSTART SAVE DASD PAGE ADDRESS 00843000
ST R1,SFBLAST IN SFBLOK 00844000
ST R1,RSPDPAGE-RSPLCTL(,R9) AND IN CONTROL BLOK 00845000
LA R1,1(R0) SET R1 = 1 @VA06262 00845250
STH R1,SFBCOPY INIT. COPY CNT TO 1 @VA06262 00845500
STC R1,SFBSTCPY STARTING COPY NUMBER IS ALSO 1 @V60B9BA 00845600
LA R1,SFBDATE SET UP DATE 00846000
LA R2,SFBTIME AND TIME 00847000
MVI SFBFNAME,C' ' CLEAR NAME AND TYPE 00848000
MVC SFBFNAME+1(23),SFBFNAME 00849000
CALL DMKCVTDT FILL THEM IN 00850000
LTR R6,R6 SET CONDITION CODE (NON-ZERO) 00851000
BR R6 AND RETURN TO CALLER 00852000
SPACE 3 00853000
CLEAR XC 0(*-*,R9),0(R9) EXECUTED TO CLEAR OUT THE BLOK 00854000
EJECT 00855000
SFBCHAIN EQU * HERE TO CHAIN COMPLETED SFBLOK 00856000
SR R2,R2 CLEAR FORWARD POINTER @VA01375 00857000
ST R2,SFBPNT .. @VA01375 00858000
SFBLOOP L R14,0(,R15) POINT TO NEXT SFBLOK IN CHAIN 00859000
LTR R14,R14 AT END OF CHAIN YET ?? 00860000
BZ SFBDONE YES -- 00861000
LR R15,R14 SAVE POINTER 00862000
B SFBLOOP AND KEEP LOOKING FOR END OF CHAIN 00863000
SFBDONE ST R7,SFBPNT-SFBLOK(,R15) CHAIN NEW BLOK TO END OF CHAIN 00864000
BR R6 RETURN TO CALLER 00865000
SPACE 00866000
GETID L R14,=A(DMKRSPID) ADDRESS OF UNIQUE SPOOLID 00867000
LH R1,0(R14) NEXT AVAILABLE SPOOLID 00868000
STH R1,SFBFILID SAVE IN SFBLOK 00869000
LA R1,1(R1) UPDATE BY ONE 00870000
CH R1,=H'9900' HAS THE ID REACHED MAX 9900 00871000
BNH *+8 NO- @VA06444 00872000
LA R1,1 YES - START AT ONE 00873000
STH R1,0(R14) STORE NEXT SPOOLID BACK IN RSPID 00874000
BR R6 00875000
SPACE 3 00876000
GETUSER EQU * HERE TO LOCATE 'SFBUSER' 00877000
LA R1,SFBUSER POINT TO USERID FIELD 00878000
LA R0,8 GET LENGTH 00879000
CALL DMKSCNAU AND GO FIND VMBLOK 00880000
BR R6 RETURN TO CALLER 00881000
SPACE 3 00882000
EJECT 00882100
*. 00882110
* 00882120
* SUBROUTINE NAME - 00882130
* 00882140
* DMKSPLSP 00882150
* 00882160
* FUNCTION - 00882170
* 00882180
* LOCATE THE USERS VMBLOK, LOCATE A VIRTUAL READER 00882190
* AND SET DEVICE END PENDING AND EXIT VIA CLOSEXIT 00882200
* 00882210
* ATTRIBUTES - 00882220
* 00882230
* REENTRANT, PAGEABLE, CALLED VIA SVC 00882240
* 00882250
* ENTRY POINTS - 00882260
* 00882270
* DMKSPLSP 00882280
* 00882290
* ENTRY CONDITIONS - 00882300
* 00882310
* GPR7 = ADDRESS OF SFBLOK 00882320
* 00882330
* EXIT CONDITIONS - 00882340
* 00882350
* NONE 00882360
* 00882370
* CALLS TO OTHER ROUTINES - 00882380
* 00882390
* DMKSCNAU - TO LOCATE THE USERS VMBLOK 00882400
* 00882410
* EXTERNAL REFERENCES - 00882420
* 00882430
* NONE 00882440
* 00882450
* TABLES/WORKAREAS 00882460
* 00882470
* NONE 00882480
* 00882490
* REGISTER USAGE - 00882500
* 00882510
* GPR0 = PARAMETER FOR DMKSCNAU 00882520
* GPR1 = USER ID FOR DMKSCNAU 00882530
* GPR7 = ADDRESS OF SFBLOK 00882540
* 00882550
* OPERATION - 00882560
* 00882570
* CALL DMKSCNAU TO LOCATE USERS VMBLOK AND GO TO 00882580
* SETPEND TO LOCATE A VIRTUAL READER AND SET VIRTUAL 00882590
* DEVICE END PENDING. EXIT IS FROM CLOSEXIT. 00882600
* 00882610
*. 00882620
EJECT 00882630
DMKSPLSP RELOC @VA07887 00882640
* R7 = ADDRESS OF SFBLOK 00882650
LA R1,SFBUSER USER ID @VA07887 00882660
LA R0,8 LENGTH @VA07887 00882670
CALL DMKSCNAU LOCATE VMBLOK @VA07887 00882680
BNZ CLEXIT EXIT..NOT LOGGED ON @VA07887 00882690
SWTCHVM OPT=STAY @VA07887 00882700
B SETPEND LOCATE READER AND SET PENDING @VA07887 00882710
* AND EXIT VIA CLOSEXIT 00882720
EJECT 00883000
*. 00884000
* 00885000
* SUBROUTINE NAME - 00886000
* 00887000
* DMKSPLDL 00888000
* 00889000
* FUNCTION - 00890000
* 00891000
* TO DELETE USED FILES FROM THE SYSTEM AND TO 00892000
* DE-ALLOCATE THE DASD PAGE SPACE. 00893000
* 00894000
* ATTRIBUTES - 00895000
* 00896000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00897000
* 00898000
* ENTRY POINTS - 00899000
SPACE 00900000
* DMKSPLDL - ENTRY POINT TO STACK A SFBLOK 00901000
* DMKSPLDR - ENTRY POINT TO DELETE SPOOL FILE BUFFERS 00902000
* (FROM CPEXBLOK SET UP BY DMKSPLDL) 00903000
* 00904000
* ENTRY CONDITIONS - 00905000
* 00906000
* GPR7 = ADDRESS OF SFBLOK FOR FILE TO BE DELETED 00907000
* GPR11 = ADDRESS OF USER VMBLOK BASE ADDRESS 00908000
* GPR12 = ENTRY POINT ADDRESS 00909000
* GPR13 = ADDRESS OF STANDARD SAVEAREA 00910000
* 00911000
* EXIT CONDITIONS - 00912000
* 00913000
* NONE 00914000
* 00915000
* CALLS TO OTHER ROUTINE - 00916000
* 00917000
* DMKFREE - TO ABTAIN STORAGE FOR WORKAREA 00918000
* DMKFRET - TO RETURN STORAGE FOR WORKAREA AND BLOKS 00919000
* DMKIOSQR - TO READ LINKAGE INFORMATION 00920000
* DMKPGTSR - TO RELEASE SPOOL DASD BUFFER 00921000
* DMKSTKCP - TO STACK CPEXBLOK 00922000
* DMKPTRLK - TO LOCK PROGRAM MODULE IN STORAGE 00923000
* DMKPGTSD - TO DE-ALLOCATE BUFFER PAGE 00924000
* DMKDRDDD - TO DELETE ACTUAL FILE 00925000
* DMKPTRUL - TO UNLOCK PROGRAM MODULE FROM STORAGE 00926000
* DMKCKSPL - CHECKPOINT THE SFBLOK 00927000
* 00928000
* DMKDSPCH - GO TO DISPATCHER 00929000
* EXTERNAL REFERENCES - 00930000
* 00931000
* DMKRSPDL - ANCHOR FOR SPOOL DELETE CHAIN 00932000
* DMKCPEND - HIGH ADDRESS OF RESIDENT NUCLEUS 00933000
* DMKSYSOW - ADDRESS OF SYSTEM OWNED LIST 00934000
* 00935000
* TABLES / WORKAREAS - 00936000
* 00937000
* 00938000
EJECT 00939000
* 00940000
* REGISTER USAGE - 00941000
* 00942000
* GPR7 = SFBLOK BASE 00943000
* GPR8 = ADDRESS OF OWNDLIST 00944000
* GPR10 = ADDRESS OF IOBLOK 00945000
* GPR11 = ADDRESS OF VMBLOK 00946000
* GPR12 = BASE ADDRESS 00947000
* GPR13 = ADDRESS OF STANDARD SAVEAREA 00948000
* 00949000
* OPERATION - 00950000
* 00951000
* 1. CHAIN THE SFBLOK TO THE DELETE CHAIN (DMKRSPDL). 00952000
* IF DELETE ROUTINE (DMKSPLDR) IS RUNNING: EXIT. 00953000
* 2. GET STORAGE AND BUILD AN CPEXBLOK WITH AN ENTRY 00954000
* POINT ADDRESS OF DMKSPLDR. CALL DMKSTKCP TO STACK 00955000
* THE BLOK TO BE DISPATCHED. 00956000
* 3. CALL DMKPTRLK TO LOCK THE MODULE IN STORAGE AND EXIT. 00957000
* 4. DMKSPLDR - LOCATE THE SFBLOK ON DELETE FILE CHAIN 00958000
* (DMKRSPDL), IF NONE: RESET DELETE RUNNING SWITCH, 00959000
* UNLOCK PAGE AND EXIT. 00960000
* 5. IF SFBLOK IS A DUMPFILE: CALL DMKDRDDD TO DELETE THE 00961000
* DASD PAGES AND ON RETURN GO TO STEP9. 00962000
* 6. IF SFBLOK ALLOCATION CHAIN IS COMPETE (SFBRECER=0) 00963000
* AND VALID DUMMY ALLOCATION CHAIN, CALL DMKPGTSR TO 00964000
* DE-ALLOCATE THE FILE, ON RETURN GO TO STEP9. 00965000
* 7. IF ALLOCATION CHAIN INCOMPLETE (SFBRECER=1) OR 00966000
* ALLOCATION CHAIN ADDRESS = ZERO, BUILD AN IOBLOK 00967000
* TO READ AND PASS DMKPGTSD THE FIRST 00968000
* 8 BYTES OF EACH BUFFER. WHEN THE LAST BUFFER IS 00969000
* FINISHED GO TO STEP 9. 00970000
* 8. IF AN IO ERROR ACCURS WHILE READING BUFFER INFORMATION, 00971000
* RESET THE POINTER TO READ THE LAST BUFFER FIRST AND 00972000
* FOLLOW THE CHAIN BACKWARD TO THE ERROR. WHEN THE 00973000
* ERROR IS REACHED GOING BACKWARD, GO TO STEP 9. 00974000
* 9. CALL DMKFRET TO FRET THE SFBLOK AND GO TO STEP3. 00975000
* 00976000
*. 00977000
EJECT 00978000
USING RECBLOK,R1 00979000
USING SFBLOK,R7 00980000
USING OWNDLIST,R8 00981000
USING IOBLOK,R10 00982000
SPACE 3 00983000
DMKSPLDL RELOC 00984000
CHARGE SWITCH,ASYSVM START CHARGING SYSTEM @V407511 00985100
SPACE 00988000
L R3,=A(DMKRSPDL) ADDRESS OF DELETE CHAIN ANCHOR 00989000
LTR R7,R7 SPFBLOK ADDRESS PRESENT ??? 00990000
BZ TSTCHAIN NO -- CHECK FOR FILES IN CHAIN @V304298 00991000
L R4,0(R3) ADDRESS OF FIRST SFBLOK @V304298 00992000
ST R7,0(R3) CHAIN NEW BLOK FIRST AND 00993000
ST R4,0(R7) CHAIN OLD BLOKS LAST 00994000
TSTCHAIN ICM R1,B'1111',0(R3) ANY FILES IN DELETE CHAIN ?? @V304298 00995000
BZ DLEXIT NO -- LEAVE 00996000
TM DELSW,X'80' DELETE ROUTINE RUNNING ?? 00997000
BO DLEXIT YES -- 00998000
SPACE 00999000
USING CPEXBLOK,R1 01000000
LA R0,CPEXSIZE LENGTH OF BLOK 01001000
CALL DMKFREE 01002000
XC CPEXBLOK(CPEXSIZE*8),CPEXBLOK CLEAR BLOK 01003000
SPACE 01004000
LA R15,DMKSPLDR ADDRESS OF DELETE ROUTINE 01005000
ST R15,CPEXADD SET ENTRY POINT IN CPEXBLOK 01006000
STM R0,R15,CPEXREGS SAVE ALL REGS 01007000
OI DELSW,X'80' INDICATE DELETE ROUTINE RUNNING 01008000
SPACE 01009000
CALL DMKSTKCP HAVE CP STACK BLOK 01010000
L R15,APAGCP GET END OF RESIDENT NUCLEUS @VA11259 01011100
CR R12,R15 IS THIS MODULE PAGEABLE ? @VA11259 01011200
BL DLEXIT YES...DON'T ISSUE CALL TO LOCK @VA11259 01011300
* PAGE 01011400
SPACE 01018000
LR R2,R12 LOCK PAGE 01019000
CALL DMKPTRLK FOR DMKSPLDR ROUTINE 01020000
DLEXIT DS 0H @V407511 01021100
CHARGE SWITCH,SAVER11 START CHARGING USER @V407511 01021600
EXIT 01024000
EJECT 01025000
SPACE 3 01026000
****************************************** 01027000
* 01028000
* THIS ROUTINE WHEN STARTED BY THE CPEXBLOK WILL DELETE 01029000
* ALL SFBLOKS ON THE DMKRSPDL CHAIN AND EXIT TO DISPATCH 01030000
* 01031000
****************************************** 01032000
SPACE 01033000
ENTRY DMKSPLDR 01034000
DMKSPLDR EQU * 01035000
SPACE 01036000
LA R0,DELSIZE SIZE OF IOBLOK 01037000
CALL DMKFREE GET STORAGE FOR IOBLOK 01038000
LR R10,R1 BASE FOR IOBLOK 01039000
NEXTSFB XC IOBLOK(DELSIZE*8),IOBLOK CLEAR BLOK 01040000
SPACE 01041000
* LOCATE THE FIRST SFBLOK IN CHAIN AND START PROCESSING 01042000
* 01043000
L R4,=A(DMKRSPDL) ADDRESS OF DELETE CHAIN ANCHOR 01044000
L R7,0(R4) 01045000
LTR R7,R7 CHAIN ENPTY ?? 01046000
BZ DREXIT YES - LEAVE 01047000
MVC 0(4,R4),0(R7) REMOVE THIS SFBLOK FROM THE CHAIN 01048000
ST R7,IOBMISC2 SAVE ADDRESS OF SFBLOK IN IOBLOK 01049000
TM SFBFLAG2,SFBPURGE IS THIS A PURGE OF AN OPEN @VA11439 01049200
* SPOOL FILE? 01049400
BO NOCKPT YES THEN IT HASNT BEEN CHECK @VA11439 01049600
* POINTED 01049800
CALL DMKCKSPL,PARM=DELSFB CHECKPOINT @V304298 01050000
NOCKPT DS 0H @VA11439 01050500
L R1,SFBRECS GET ADDRESS OF ALLOCATION CHAIN 01051000
TM SFBFLAG,SFBDUMP SYSTEM DUMP OR VMDUMP? @V67CAH7 01052000
BNO NOTDUMP NO...CONTINUE PROCESSING @V67CAH7 01052200
* NOW TEST IF IT IS VMDUMP...IF SO CONTINUE NORMAL PROCESSING 01052400
CLI SFBMISC1+1,C'V' IS THIS DUMP FILE A VMDUMP? @V67CAH7 01052600
BNE DUMPFILE NO...IT'S A CP DUMP, BRANCH @V67CAH7 01052800
* YES...DELETE AS NORMAL FILE 01053000
NOTDUMP DS 0H @V67CAH7 01053200
TM SFBFLAG2,SFBPURGE PROCESSING OPEN SPOOL FILE ? 01054000
BO DELOPEN YES -- DELETE OPEN FILE 01055000
TM SFBFLAG,SFBRECER ALLOCATION CHAIN IN-COMPLETE ?? 01056000
BO BADCHAIN YES -- 01057000
SPACE 01058000
LTR R1,R1 IS SFBRECS PRESENT ?? 01059000
BZ DELSTART NO -- GO DO IT THE HARD WAY 01060000
SPACE 01061000
CALL DMKPGTSR GPR1 HAS ADDRESS OF RECBLOK CHAIN 01062000
B FRETSFB GO FRET SFBLOK 01063000
SPACE 3 01064000
BADCHAIN EQU * HERE TO DELETE THE CURRENT SFBRECS CHAIN 01065000
USING RECBLOK,R1 01066000
LTR R1,R1 IS RECBLOK ADDRESS PRESENT ?? 01067000
BZ DELRESET NO - GO GET LINKABE INFORMATION 01068000
L R2,RECPNT GET ADDRESS OF NEXT RECBLOK 01069000
LA R0,RECSIZE SIZE OF RECBLOK 01070000
CALL DMKFRET RETURN STORAGE 01071000
LR R1,R2 SET UP FOR NEXT RECBLOK 01072000
ST R1,SFBRECS UPDATE ADDRESS IN SFBLOK 01073000
B BADCHAIN CONT WITH CHAIN TILL END 01074000
SPACE 3 01075000
SPACE 01076000
DELOPEN EQU * HERE FOR OPEN SPOOL FILE 01077000
TM SFBFLAG2,SFBMON IS IT A MONITOR FILE @V50A2B5 01077050
BNO LABXX NO @V50A2B5 01077100
LA R5,DELSWAP PREPARE TO RELEASE PAGES @V50A2B5 01077150
CLC SFBSTART(4),SFBLAST ONE OR TWO BUFFERS? @V50A2B5 01077200
BE MONONE ONLY ONE @V50A2B5 01077250
MVC DELSWAP+4(4),SFBSTART DELETE FIRST @V50A2B5 01077300
CALL DMKPGTSD DELETE ROUTINE @V50A2B5 01077350
MONONE MVC DELSWAP+4(4),SFBLAST DELETE THE OTHER @V50A2B5 01077400
CALL DMKPGTSD DELETE ROUTINE @V50A2B5 01077450
B FRETSFB NOW GIVE UP THE SDB @V50A2B5 01077500
LABXX EQU * @V50A2B5 01077550
CLC SFBSTART(4),SFBLAST ONE PAGE FILE ? 01078000
BNE LASTBUFF NO, BRANCH @VA03437 01079000
TM SFBFLAG2,SFBFIRST IS IT FIRST? @VA03437 01080000
BZ DELSTART NO, THEN BRANCH @VA03437 01081000
LASTBUFF OI DELSW,X'10' INDICATE 1 BUFFER BEYOND LAST @VA03437 01082000
MVC SFBRECNO,SFBSTART SAVE START FOR LATER @VA08481 01082500
B DELSTART .. 01083000
SPACE 2 01084000
DELRESET EQU * HERE TO FIND FIRST BUFFER OF FILE 01085000
TM SFBFLAG2,SFBMON IS THIS A MONITOR SPOOL FILE @VA08245 01085500
BO DELSTART @VA08245 01085600
CLI SFBTYPE,TYPRDR REAL RDR FILE @VA11232 01085700
BE TRYLAST YES, SPRMISC MAY NOT = START CCPD@VA11232 01085725
L R0,SFBSTART IS STARTING CCPD = ZERO ? @VA11232 01085750
LTR R0,R0 ZERO @VA11232 01085775
BZ TRYLAST INVALID SFBSTART - TRY SFBLAST @VA11232 01085800
USING SPLINK,R2 ADDRESSABILITY @VA11232 01085825
CALL DMKPGTVG GET A VIRTUAL BUFFER @VA11232 01085850
LTR R1,R1 DID WE GET A BUFFER ? @VA11232 01085875
BZ TRYLAST NO, MUST START BY READING SFBLAST@VA11232 01085900
TRANS 2,1,OPT=(BRING,DEFER,LOCK,SYSTEM),IOER=RELVIRT @VA11232 01085925
CALL DMKRPAGT,PARM=(BRING+SYSTEM) BRING IN START CCPD@VA11232 01085950
BNZ RELBUFF BUFFER READ ERROR @VA11232 01085975
L R3,SPRMISC START CCPD SAVED IN SPRMISC? @VA11232 01086000
SLR R0,R0 ... @VA11232 01086025
CALL DMKRPAGT,PARM=SYSTEM RELEASE STORAGE PAGE @VA11232 01086050
CALL DMKPGTVR RELEASE VIRTUAL BUFFER @VA11232 01086075
LTR R3,R3 SPRMISC CONTAIN START CCPD ? @VA11232 01086100
BZ TRYLAST NO, MUST USE SFBLAST @VA11232 01086125
ST R3,SFBSTART BE SAFE AND USE SPRMISC @VA11232 01086150
B DELSTART CONTINUE TO DEALLOCATE CCPDS @VA11232 01086175
DROP R2 @VA11232 01086200
SPACE 01086225
RELBUFF SLR R0,R0 ... @VA11232 01086250
CALL DMKRPAGT,PARM=SYSTEM RELEASE STORAGE PAGE @VA11232 01086275
RELVIRT CALL DMKPGTVR RELEASE VIRTUAL BUFFER @VA11232 01086300
SPACE 01086325
TRYLAST MVC SFBSTART,SFBLAST POINT TO LAST BUFFER OF FILE @VA11232 01086350
OI DELSW,X'20' INDICATE READING LAST BUFFER 01087000
SPACE 2 01088000
DELSTART EQU * HERE TO BEGIN DELETING THE FILE 01089000
CLC SFBLAST(4),ZEROES CCPD PRESENT ?? @VA01460 01090000
BE FRETSFB NO - JUST FRET SFBLOK @VA01460 01091000
LA R1,DELIRA GET ADDRESS OF IRA 01092000
ST R1,IOBIRA AND SAVE IN IOBLOK 01093000
LA R1,DELSEEK ADDRESS OF START OF CHANNEL PROGRAM 01094000
ST R1,IOBCAW SAVE IN IOBLOK 01095000
ST R11,IOBUSER SYSTEM AS OWNER OF TASK 01096000
XC DELADDR,DELADDR AND THE RECORD ADDRESS 01097000
LM R2,R7,SEEK GET MODEL CCWS (SEEK,SEARCH AND TIC) 01098000
AR R2,R10 POINT DATA ADDRESS IN SEEK TO DATA 01099000
AR R4,R10 ADJUST DATA ADDRESS IN SEARCH 01100000
AR R6,R10 ADJUST DATA ADDRESS IN TIC 01101000
STM R2,R7,DELSEEK STORE CHANNEL PROGRAM IN IOBLOK 01102000
* EXTENSION 01103000
L R7,IOBMISC2 RESTORE ADDRESS OF SFBLOK 01104000
SPACE 01105000
LA R1,SFBSTART SET DATA ADDRESS FOR READ 01106000
LM R2,R3,READ AND MODEL CCW 01107000
AR R2,R1 ADJUST DATA ADDRESS IN CCW 01108000
STM R2,R3,DELREAD AND STORE IN CHANNEL PROGRAM 01109000
DELPAGET L R1,SFBSTART GET DASD ADDRESS OF NEXT BUFFER 01110000
DELPAGE ST R1,DELSWAP+4 AND SAVE IN DUMMY SWAPTABLE ENTRY 01111000
C R1,F0 CCPD ZEROES ?? @VA01460 01112000
BE FRETSFB YES - JUST FRET SFBLOK @VA01460 01113000
ST R1,SFBDIST SAVE CURRENT CCPD ADDRESS 01114000
LTR R1,R1 VALID DASD CCPD ADDRESS ? 01115000
BZ FRETSFB NO -- FRET SFBLOK 01116000
STCM R1,2,DELREC STORE RECORD NUMBER 01117000
STCM R1,12,DELCYL STORE CYLINDER NUMBER 01118000
STCM R1,B'1100',IOBCYL STORE CYLINDER FOR ORDER SEEKING 01119000
LA R8,X'FF' MASK TO GET DEVICE CODE NUMBER 01120000
NR R8,R1 GET DEVICE CODE IN GPR8 01121000
L R3,=A(DMKSYSOC) DEVICE INDEX GREATER @VM08815 01122000
CL R8,0(R3) THAN SYSOWN COUNT ? @VM08815 01123000
BNL FRETSFB YES -- BUFFER ERROR @VM08815 01124000
SLL R8,3 TIMES 8 01125000
A R8,=A(DMKSYSOW) POINT TO CORRECT OWNED LIST ENTRY 01126000
LH R8,OWNDRDEV-OWNDLIST(,R8) 01127000
SLL R8,3(0) CONVERT TO BYTE INDEX @V200820 01128000
A R8,ARIODV POINT TO RDEVBLOK 01129000
USING RDEVBLOK,R8 01130000
LA R3,X'FF' MASK TO GET PAGE NUMBER 01131000
SRL R1,8 PUT PAGE IN LOW ORDER BYTE 01132000
NR R3,R1 PUT PAGE NUMBER IN GPR3 01133000
SR R2,R2 CLEAR FOR DIVIDE 01134000
LTR R3,R3 PAGE NUMBER EQUAL ZERO ?? 01135000
BZ FRETSFB YES -- FRET SFBLOK AND GET NEXT 01136000
BCTR R3,0 PAGE NUMBER -1 01137000
CLI RDEVTYPE,TYP2314 PAGING 2314 ?? 01138000
BE SP2314 YES - 01139000
CLI RDEVTYPE,TYP3340 3340 TYPE ? @V2A2029 01140000
BE SP3340 YES - GO @V2A2029 01141000
CLI RDEVTYPE,TYP3350 PAGING 3350 ? @V304498 01142000
BE SP3350 YES - @V304498 01143000
CLI RDEVTYPE,TYP3375 Paging 3375 ? HRC106DK 01143100
BE SP3375 Yes - HRC106DK 01143200
CLI RDEVTYPE,TYP3380 Paging 3380 ? HRC106DK 01143300
BE SP3380 Yes - HRC106DK 01143400
* CONVERT PAGE NUMBER TO HEAD NUMBER FOR 3330 AND 2305 01144000
D R2,F3 DIVIDE BY 3 01145000
B STOREHD GO STORE HEAD 01146000
SP3375 EQU * Convert page to head(3375) HRC106DK 01146100
D R2,F8 Divide by 8 pages/track HRC106DK 01146200
B STOREHD Go store head HRC106DK 01146300
SP3380 EQU * Convert page to head(3380) HRC106DK 01146400
D R2,F10 Divide by 10 pages/track HRC106DK 01146500
B STOREHD Go store head HRC106DK 01146600
SP3350 EQU * CONVERT PAGE TO HEAD(3350) @V304498 01147000
D R2,F4 DIVIDE BY 4 PAGES/TRACK @V304498 01148000
B STOREHD GO STORE HEAD @V304498 01149000
SP3340 TM RDEVFTR,FTR70MB 70MB DATA MODULE MOUNTED ? @V2A2029 01150000
BZ *+8 NO -- MUST BE 35MB @V2A2029 01151000
NI IOBCYL+1,X'FE' QUEUE ON LOWEST LOGICAL CYL @V2A2029 01152000
D R2,F2 DIVIDE BY 2 PAGE PER TRACK @V2A2029 01153000
B STOREHD GO STORE HEAD @V2A2029 01154000
SP2314 EQU * HERE TO CONVERT PAGE TO HEAD (2314) 01155000
IC R3,HDTABLE(R3) GET HEAD NUMBER FROM TABLE 01156000
STOREHD STC R3,DELHEAD+1 STORE HEAD NUMBER 01157000
MVI IOBFLAG,IOBCP CLEAR AND SET IOBFLAG 01158000
MVI IOBSTAT,0 CLEAR IOB STATUS 01159000
CALL DMKIOSQR READ LINKAGE INFO FOR NEXT PAGE 01160000
GOTO DMKDSPCH WAIT FOR IO TO COMPLETE 01161000
SPACE 2 01162000
DELIRA EQU * HERE WHEN LINKAGE DATA FROM BUFFER HAS BEEN READ IN 01163000
USING *,R12 TEMPORARY ADDRESSABILITY 01164000
S R12,=A(DELIRA-DMKSPL) RESTORE BASE ADDRESS 01165000
USING DMKSPL,R12 01166000
L R7,IOBMISC2 RESTORE BASE ADDRESS OF SFBLOK 01167000
TM IOBSTAT,IOBFATAL IO ERROR READING DATA IN ?? 01168000
BO DELBACK YES -- START DELETING FROM THE BACK 01169000
TM DELSW,X'20' FIRST PAGE BUFFER FOUND ?? 01170000
BZ DELCONT YES -- 01171000
NI DELSW,X'FF'-X'20' RESET FIRST BUFFER SEARCH FLAG 01172000
B DELPAGET START DELETING BUFFERS 01173000
DELCONT LA R5,DELSWAP PAGERELS 01174000
* CALL DMKPGTSD RELEASE THE BUFFER 01175000
L R15,=A(DMKPGTSD) 01176000
BALR R14,R15 01177000
CLC SFBLAST,SFBDIST WAS THAT THE LAST BUFFER ?? 01178000
BNE DELPAGET NO -- GO GET NEXT BUFFER 01179000
TM SFBFLAG2,SFBPURGE PROCESSING OPEN SPOOL FILE ? 01180000
BZ FRETSFB NO -- 01181000
TM DELSW,X'10' ONE BUFFER FILE ??? 01182000
BZ FRETSFB YES -- 01183000
NI DELSW,X'FF'-X'10' RESET FLAG 01184000
L R5,SFBSTART GET CCPD @VA05909 01185100
C R5,F0 IS IT ZERO ?? @VA05909 01185200
BE FRETSFB YES, DONE WITH THIS SFBLOK CHAIN @VA05909 01185300
C R5,SFBRECNO CHECK START IF PSEUDO CLOSE @VA08481 01185320
BE FRETSFB IF YES,ALL DONE,NO EXTRA PAGE @VA08481 01185370
ST R5,DELSWAP+4 NO, ONE MORE TIME AROUND @VA05909 01185400
B DELCONT GO DELETE BUFFER 01186000
SPACE 2 01187000
DELBACK EQU * HERE IF AN IOERROR OCCURS WHILE READING A BUFFER 01188000
TM SFBFLAG2,SFBPURGE PROCESSING OPEN SPOOL FILE ? 01189000
BO FRETSFB YES -- CAN'T BACK UP 01190000
TM DELSW,X'40' ALREADY BACKING UP THE FILE ?? 01191000
BO FRETSFB YES - 01192000
OI DELSW,X'40' INDICATE BACKING UP 01193000
SPACE 01194000
L R1,DELREAD GET DATA ADDRESS OF READ 01195000
S R1,=F'4' AND POINT TO START OF SFBLOK 01196000
ST R1,DELREAD THE READ WILL NOW CAUSE THE BACK 01197000
* CHAIN LINK TO BE READ INTO SFBSTART 01198000
L R1,SFBLAST MAKE THE LAST BUFFER ADDRESS 01199000
ST R1,SFBSTART NOW THE FIRST BUFFER ADDRESS 01200000
MVC SFBLAST(4),SFBDIST AND MAKE CURRENT ERROR BUFFER LAST 01201000
B DELPAGE CONTINUE FROM THE REAR 01202000
SPACE 3 01203000
SPACE 3 01204000
DUMPFILE EQU * HERE TO DELETE A DUMP FILE - 01205000
* A CALL IS MADE TO DMKDRD TO DELETE THE ACTUAL FILE 01206000
CALL DMKDRDDD 01207000
SPACE 2 01208000
FRETSFB EQU * HERE TO DELETE SFBLOK 01209000
LR R1,R7 ADDRESS OF SFBLOK 01210000
LA R0,SFBSIZE GET SIZE OF SFBLOK 01211000
CALL DMKFRET FRET BLOK 01212000
NI DELSW,X'9F' RESET BACKING AND FIRST BUFFER FLAGS 01213000
B NEXTSFB GO GET AND PROCESS THE NEXT SFBLOK 01214000
* ON THE DELETE CHAIN 01215000
SPACE 2 01216000
DREXIT EQU * HERE TO FRET IOBLOK AND EXIT TO DISPATCHER 01217000
LA R0,DELSIZE LENGTH AND 01218000
LR R1,R10 ADDRESS OF IOBLOK 01219000
CALL DMKFRET 01220000
SPACE 01221000
MVI DELSW,X'00' INDICATE DELETE ROUTINE FINISHED 01222000
L R15,APAGCP GET END OF RESIDENT NUCLEUS @VA11259 01223100
CR R12,R15 IS MODULE RESIDENT ? @VA11259 01223200
BL DRDSP YES...DON'T UNLOCK IT @VA11259 01223300
LR R2,R12 UNLOCK PAGE 01230000
CALL DMKPTRUL .. 01231000
DRDSP EQU * HERE TO EXIT TO DISPATCHER 01232000
GOTO DMKDSPCH EXIT 01233000
SPACE 3 01234000
PRINT DATA 01235000
HDTABLE DS 0H TABLE OF HEAD NUMBER FOR 2314 PAGES 01236000
DC AL1(00,00,01,01,02,03,03,04) 01237000
DC AL1(05,05,06,06,07,08,08,09) 01238000
DC AL1(10,10,11,11,12,13,13,14) 01239000
DC AL1(15,15,16,16,17,18,18,19) 01240000
PRINT NODATA 01241000
SPACE 3 01242000
SEEK CCW 7,DELADDR-IOBLOK,CC,6 MODEL SEEK CCW 01243000
SEARCH CCW 49,DELCYL-IOBLOK,CC,5 MODEL SEARCH CCW 01244000
TIC CCW 8,DELSERCH-IOBLOK,0,0 MODEL TIC CCW 01245000
READ CCW 6,*-*,SILI,12 MODEL READ CCW @VA11232 01246000
SPACE 2 01247000
DELSW DC X'00' SWITCH FOR DELETE ROUTINE 01248000
LTORG 01249000
EJECT 01250000
XFRMSGCT DSECT @VA03327 01251000
XFRMSG1 DS CL3 @VA03327 01252000
DS C @VA03327 01253000
XFRMSGFI DS CL4 @VA03327 01254000
DS C @VA03327 01255000
XFRMSGID DS CL4 @VA03327 01256000
DS C @VA03327 01257000
XFRMSG2 DS CL5 @VA03327 01258000
XFRMSG3 DS CL8 @VA03327 01259000
DS C @VA03327 01260000
XFRMSGCP DS CL4 @VA03327 01261000
DS C @VA03327 01262000
XFRCOPY DS CL3 @VA03327 01263000
XFRHOLD DS CL6 @VA03327 01264000
XFRMSG1L EQU *-XFRMSG1 @VA03327 01265000
SPACE 2 01266000
RDRMSGCT DSECT @VA03327 01267000
RDRMSG DS CL8 @VA03327 01268000
DS C @VA03327 01269000
RDRMSGF DS CL4 @VA03327 01270000
DS C @VA03327 01271000
RDRMSGE DS CL13 @VA03327 01272000
RDRMSGL EQU *-RDRMSG @VA03327 01273000
EJECT 01274000
COPY UDIRECT @V200930 01275000
COPY ALLOC 01276000
COPY RBLOKS 01277000
COPY VBLOKS 01278000
PSA 01279000
COPY ACCOUNT 01280000
COPY VMBLOK 01281000
COPY SAVE 01282000
COPY EQU 01283000
COPY DEVTYPES 01284000
COPY IOBLOKS 01285000
IOBLOK DSECT CONTINUE THE IOBLOK 01286000
ORG , MAKE SURE WE'RE AT THE END @V200820 01287000
DELSEEK DS D SPACE FOR SEEK CCW 01288000
DELSERCH DS D SPACE FOR SEARCH CCW 01289000
DELTIC DS D SPACE FOR TIC CCW 01290000
DELREAD DS D SPACE FOR READ CCW 01291000
DELSWAP DS D DUMMY SWAPTABLE ENTRY 01292000
DELADDR DS D SEEK/SEARCH DATA 01293000
ORG DELADDR 01294000
DS 2X BB 01295000
DELCYL DS 2X CC 01296000
DELHEAD DS 2X HH 01297000
DELREC DS X R 01298000
DS X UNUSED 01299000
ORG 01300000
DELSIZE EQU (*-IOBLOK)/8 SIZE OF EXTENDED IOBLOK 01301000
EJECT 01302000
COPY IOER 01303000
COPY SPOOL 01304000
END 01305000