RSP TITLE 'DMKRSP (CP) VM/370 - RELEASE 6' 00001000
*. 00002000
* 00003000
* MODULE NAME - 00004000
* 00005000
* DMKRSP 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* TO MANAGE ALL SPOOLING OPERATIONS ON THE REAL SYSTEM UNIT 00010000
* RECORD DEVICES, INCLUDING PRINTING AND PUNCHING USER-CREATED 00011000
* SPOOL FILES AND READING AND QUEUEING UP READER FILES 00012000
* FROM THE REAL CARD READER(S). 00013000
* 00014000
* ATTRIBUTES - 00015000
* 00016000
* RESIDENT, REENTRANT, ENTERED VIA GOTO 00017000
* 00018000
* ENTRY POINTS - 00019000
* 00020000
* DMKRSPEX - ENTERED VIA A GOTO WHEN DMKDSPCH UNSTACKS AN 00021000
* IOBLOK WITH AN INTERRUPT FOR SPOOLING UNIT 00022000
* RECORD DEVICE 00023000
* DMKRSPUR - TO FORMAT ACTIVE FILE MESSAGE 00024000
* DMKRSPER - ENTERED FROM DMKIOS FOR SPOOLING IO ERRORS 00025000
* 00026000
* ENTRY POINTS - DATA POINTERS 00027000
* 00028000
* DMKRSPRD - THE ANCHOR FOR THE CHAIN OF SFBLOKS FOR ALL 00029000
* READER FILES WAITING TO BE PROCESSED 00030000
* DMKRSPPR - THE ANCHOR FOR PRINTER FILE CHAIN 00031000
* DMKRSPPU - THE ANCHOR FOR THE PUNCH FILE CHAIN 00032000
* DMKRSPAC - THE ANCHOR FOR ALL ACCOUNTING CARD BUFFERS THAT 00033000
* ARE WAITING TO BE PUNCHED 00034000
* DMKRSPDL - THE ANCHOR FOR SPOOL FILE DELETE CHAIN 00035000
* DMKRSPID - SPOOL FILE ID COUNTER 00036000
* DMKRSPCV - TIME OF DAY CLOCK VALUE USED BY DMKCKP 00037000
* DMKRSPHQ - THE ANCHOR FOR SYSTEM HOLD QUEUE 00038000
* DMKRSP83 - RESET CCW FOR 3811 PRINTER CONTROL UNIT 00039000
* DMKRSPMN - ACTIVE MONITOR SFBLOK ADDRESS 00039100
* 00040000
* ENTRY CONDITIONS - 00041000
* 00042000
* GPR10 = ADDRESS OF IOBLOK CONTAINING THE INTERRUPT 00043000
* GPR12 = MODULE ADDRESSABILITY 00044000
* 00045000
* NOTE THAT SINCE DMKRSPEX IS ENTERED VIA A GOTO, NO STANDARD 00046000
* SAVEAREA IS AVAILABLE AND THE ENTER AND EXIT MACROS 00047000
* MAY NOT BE USED 00048000
* 00049000
* EXIT CONDITIONS - 00050000
* 00051000
* NORMAL - 00052000
* DMKRSP IS COMPLETELY INTERRUPT DRIVEN, AND EXITS ONLY TO 00053000
* DMKDSPCH VIA A GOTO TO AWAIT INTERRUPTS ASSOCIATED WITH 00054000
* UNIT RECORD FILE PROCESSING, OR DEVICE ENDS ASSOCIATED WITH 00055000
* DEVICES THAT ARE MADE READY FOR INPUT OR OUTPUT 00056000
* 00057000
* ERROR - 00058000
* 00059000
* SEE ERROR MESSAGES 00060000
* 00061000
EJECT 00062000
* CALLS TO OTHER ROUTINES - 00063000
* 00064000
* DMKCSOSD - TO START A OTHER OUTPUT DEVICE FOR REQUEUE 00065000
* DMKPGTSG - TO OBTAIN DASD PAGE RECORDS FOR READER FILES 00066000
* DMKPGTVG - TO OBTAIN SPOOL BUFFER SPACE IN VIRTUAL MEMORY 00067000
* DMKPGTVR - TO RELEASE VIRTUAL BUFFER SPACE 00068000
* DMKUDRFU - TO VERIFY THE VALDITY OF THE USERID ON THE ID CARD 00069000
* FOR THE REAL CARD READER 00070000
* DMKSCNFD - TO LOCATE THE PARAMETERS ON THE USERID CARD 00071000
* DMKSPLOR - TO PERFORM INPUT INITIALIZATION FOR READER FILES 00072000
* DMKSPLCR - TO CLOSE OFF AND QUEUE UP READER FILES FOR VIRTUAL 00073000
* MACHINE PROCESSING 00074000
* DMKSCNRU - TO LOCATE THE RDEVBLOK FOR THE UNIT RECORD DEVICE 00075000
* CAUSING THE INTERRUPT 00076000
* DMKSPLDL - TO PURGE PARTIALLY COMPLETE FILES 00077000
* DMKSEPSP - TO PRINT OUTPUT SEPARATOR PAGES 00078000
* DMKRPAGT - TO READ SPOOL FILE PAGES INTO VIRTUAL MEMORY 00079000
* DMKRPAPT - TO WRITE SPOOL FILE PAGES FROM VIRTUAL MEMORY TO 00080000
* DASD SECONDARY STORAGE 00081000
* DMKSTKCP - TO STACK A CPEXBLOK 00082000
* DMKIOSQR - TO REQUEST SIO PROCESSING FOR THE UNIT RECORD 00083000
* DEVICES 00084000
* DMKSCNRD - TO GET DEVICE ADDRESS 00085000
* DMKSCNRN - TO GET DEVICE NAME 00086000
* DMKACOPU - PUNCH ACCOUNTING DATA 00087000
* DMKERMSG - WRITE ERROR MESSAGES 00088000
* DMKRSERR - SPOOLING ERROR ROUTINES 00089000
* DMKFREE,DMKFRET,DMKCVTDT,DMKQCNWT,DMKCVTBD,DMKCVTBH 00090000
* DMKCKSPL - CHECKPOINT THE SFBLOK 00091000
* DMKTCSET - SET UP A 3800 PRINTER 00091300
* DMKTCSCO - SET UP FOR MULTIPLE COPIES ON 3800 PRINTER 00091600
* 00092000
* EXTERNAL REFERENCES - 00093000
* 00094000
* DMKGRAWT - ADDRESS OF CONSOLE WRITE ROUTINE 00095000
* DMKSYSOW - ADDRESS OF SYSTEM OWNLIST 00096000
* DMKSYSTP - POINTER TO SYSTEM SYSRES DEVICE TYPE 00097000
* DMKSYSWM - POINTER TO WARM START CYLINDER 00098000
* DMKSYSOC - POINTER TO NUMBER OF ENTRIES IN OWNLIST 00099000
* DMKTMRPT - POINTER TO VMVTIME CONVERT ROUTINE 00100000
* DMKSYSRM - ADDRESS OF REAL STORAGE SIZE 00101000
* DMKQNTBL - ANCHOR FOR 3800 NAMED SYSTEMS (IMAGLIBS) 00101100
* 00102000
* TABLES / WORKAREAS - 00103000
* 00104000
* NONE 00105000
* 00106000
* REGISTER USAGE - 00107000
* 00108000
* GPR2 = REAL ADDRESS OF SPOOLING PAGE BUFFER 00109000
* GPR5 = INTERNAL SUBROUTINE LINKAGE REGISTER 00110000
* GPR7 = ADDRESS OF SFBLOK 00111000
* GPR8 = ADDRESS OF RDEVBLOK 00112000
* GPR9 = ADDRESS OF RSPLCTL WORKAREA 00113000
* GPR10 = ADDRESS OF IOBLOK 00114000
* GPR11 = ADDRESS OF SYSTEM VMBLOK FOR CP PAGING 00115000
* GPR12 = BASE REGISTER 00116000
* GPR13 = 2ND BASE REGISTER 00117000
* 00118000
* NOTES - 00119000
* 00120000
* NONE 00121000
* 00122000
EJECT 00123000
* OPERATION - 00124000
* 00125000
* 1. LOCATE THE RDEVBLOK FOR THE DEVICE CAUSING THE INTERRUPT 00126000
* 00127000
* 2. DETERMINE VIA THE DEVICE TYPE FLAGS WHETHER THE DEVICE 00128000
* IS AN INPUT DEVICE (CARD READER) OR AN OUTPUT DEVICE 00129000
* (PRINTER OR PUNCH). BRANCH TO HANDLE EACH TYPE 00130000
* SEPARATELY. 00131000
* 00132000
* RESPONSE - 00133000
* 00134000
* RDR (RADDR) SPOOL CLS (1 TO 4 CLASSES) STARTED 00135000
* PRT 00136000
* PUN 00137000
* 00138000
* PUN (RADDR) START FOR OUTPUT 00139000
* 00140000
* (DEV) (RADDR) (FUNCTION) (USERID) FILE = (SPOOLID) 00141000
* RECDS = (RECNT) COPY = (CNT) (CL) (TYPE) 00142000
* WHERE THE ITEMS IN PARENS ARE: 00143000
* (DEV) - RDR PRT PUN 00144000
* (RADDR) - REAL DEVICE ADDRESS IN HEX - CCU 00145000
* (FUNCTION) - OUTPUT OF, INPUT FOR, REPEATED, BACKSPACE, 00146000
* FLUSHED, FILE HELD, PRINTING, PUNCHING, READING 00147000
* (USERID) - USERID OF THE FILE OWNER 00148000
* (SPOOLID) - SPOOL FILE NUMBER 00149000
* (RECNT) - RECORD COUNT - LINES OR CARDS 00150000
* (CNT) - NUMBER OF COPIES 00151000
* (CL) - OUTPUT CLASS OF THE FILE 00152000
* (TYPE) - FILE TYPE - PRT, PUN, RDR, CON 00153000
* 00154000
* FOR A RDR DEVICE ONLY THE DATA TO (SPOOLID) IS GIVEN 00155000
* 00156000
* ERROR MESSAGES - 00157000
* 00158000
* DMKRSP426E RDR (RADDR) SYSTEM SPOOL SPACE FULL; FILE PURGED 00159000
* DMKRSP428E (TYPE) (RADDR) SPOOL ERROR; FILE HELD 00160000
* DMKRSP428E (TYPE) (RADDR) SPOOL ERROR; FILE PURGED 00161000
* DMKRSP430A (TYPE) (RADDR) FATAL I/O ERROR; NOW OFFLINE, 00162000
* FILE HELD 00163000
* DMKRSP431A RDR (RADDR) ID CARD MISSING OR INVALID 00164000
* DMKRSP432A RDR (RADDR) ID CARD; (USERID) NOT IN CP DIRECTORY 00165000
* DMKRSP433A RDR (RADDR) ID CARD; INVALID DATA - (DATA) 00166000
* DMKRSP434A RDR (RADDR) FATAL I/O ERROR; FILE PURGED 00167000
*. 00168000
EJECT 00169000
COPY OPTIONS 00170000
COPY LOCAL OPTIONS 00171000
EJECT 00172000
DMKRSP CSECT LOADER CONTROL ONLY @V306638 00173000
SPACE 3 00174000
ENTRY DMKRSPEX,DMKRSPHQ,DMKRSPID,DMKRSPDL 00175000
ENTRY DMKRSPRD,DMKRSPPR,DMKRSPPU,DMKRSPAC 00176000
ENTRY DMKRSPUR @V200930 00177000
ENTRY DMKRSPDP @V67CAH7 00177500
ENTRY DMKRSPCV 00178000
ENTRY DMKRSPMN 00178100
EXTRN DMKPGTSG,DMKRSERR,DMKPGTVG,DMKPGTVR,DMKPGTSD @VA11232 00179000
EXTRN DMKUDRFU,DMKSCNFD 00180000
EXTRN DMKSTKCP @VA00701 00181000
EXTRN DMKSPLOR,DMKSPLCR 00182000
EXTRN DMKCSOSD 00183000
EXTRN DMKSPLDL,DMKSEPSP,DMKSCNRU 00184000
EXTRN DMKRPAGT,DMKRPAPT,DMKCVTDT 00185000
EXTRN DMKSCNRD,DMKSCNRN @V200930 00186000
EXTRN DMKACOPU,DMKIOSQR,DMKERMSG,DMKCVTBH,DMKCVTBD 00187000
EXTRN DMKCKSPL @V304298 00188000
EXTRN DMKQNTBL @VA09471 00188100
EXTRN DMKTCSET,DMKTCSCO @V60B9BA 00188500
SPACE 3 00189000
USING PSA,R0 00190000
USING SPLINK,R2 00191000
USING SFBLOK,R7 00192000
USING RDEVBLOK,R8 00193000
USING RSPLCTL,R9 00194000
USING IOBLOK,R10 00195000
USING VMBLOK,R11 00196000
SPACE 3 00197000
SPACE 3 00198000
DMKRSPEX DS 0H @V200930 00199000
USING DMKRSP,R12 BASE @V200930 00200000
LR R13,R12 SET SECOND BASE REG @V200930 00201000
A R13,F4096 .. @V200930 00202000
USING DMKRSP+4096,R13 @V200930 00203000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00203100
LH R1,IOBRADD GET DEVICE ADDRESS @V200930 00204000
CALL DMKSCNRU LOCATE RCH, RCU, RDEVBLOKS 00205000
BNZ RSPLEXIT COULDN'T FIND ONE OR MORE BLOKS 00206000
CLI RDEVTYPC,CLASURI INPUT UNIT RECORD DEVICE TYPE ?? 00207000
BE RSPLIN YES -- 00208000
SPACE 00209000
TM RDEVTYPE,TYPPRT+TYPPUN IS IT AN OUTPUT DEVICE ?? 00210000
BNZ RSPLOUT YES -- 00211000
B RSPLEXIT EXIT 00212000
ID DC CL8'DMKRSP' @V200930 00213000
EJECT 00214000
*. 00215000
* 00216000
* REAL CARD READER PROCESSING - 00217000
* 00218000
* 1. DETERMINE IF A FILE IS CURRENTLY ACTIVE ON THE DEVICE; IF 00219000
* SO, GO TO STEP 5; OTHERWISE, CONTINUE 00220000
* 00221000
* 2. IF NO FILE IS ACTIVE AND THE READER IS AVAILABLE FOR SPOOL- 00222000
* ING, CALL DMKSPLOR TO INITIALIZE THE BLOCKS NECESSARY 00223000
* TO START PROCESSING 00224000
* 00225000
* 3. GET A TEMPORARY ID CARD BUFFER, AND BUILD THE CHANNEL 00226000
* PROGRAM TO READ IN THE ID CARD 00227000
* 00228000
* 4. CALL DMKIOSQR TO START THE READER, AND GO TO DMKDSPCH TO 00229000
* AWAIT THE INTERRUPT 00230000
* 00231000
* 5. AFTER CARDS HAVE BEEN READ, TEST TO SEE IF A USERID CARD 00232000
* HAS BEEN READ. IF IT HAS, CONTINUE; OTHERWISE GO TO STEP 00233000
* 7 TO VALIDATE THE ID CARD 00234000
* 00235000
* 6. SEE IF PHYSICAL END OF FILE ON THE READER HAS BEEN REACHED. 00236000
* IF IT HAS, GO TO STEP 8; OTHERWISE, WRITE THE FULL BUFFER 00237000
* TO DASD, OBTAIN A NEW BUFFER, AND CALL DMKIOSQR TO READ THE 00238000
* NEXT BATCH OF CARDS. GOTO DMKDSPCH TO WAIT FOR THE INTER- 00239000
* RUPT 00240000
* 00241000
* 7. IF THE CARD IS BLANK OR A PUNCH SEPARATOR CARD, 00242000
* GO TO STEP 4. 00243000
* IF VALID ID CARD, EXTRACT CLASS AND/OR NAME PARAMETERS, 00244000
* AND SET UP TO FILL BUFFER AND GO TO STEP 4. 00245000
* OTHERWISE, NOTIFY OPERATOR AND FLUSH THE FILE. 00246000
* 00247000
* 8. WHEN END OF FILE IS REACHED, WRITE THE FINAL BUFFER TO 00248000
* DASD, CALL DMKSPLCR TO FINISH HOUSEKEEPING AND QUEUE THE 00249000
* FILE FOR INPUT TO THE VIRTUAL USER, AND EXIT 00250000
* 00251000
*. 00252000
SPACE 3 00253000
RSPLIN EQU * 00254000
* 00255000
TM RDEVSTAT,RDEVDED IS THE DEVICE DEDICATED ?? 00256000
BO RDRIOB YES - FRET IOB AND LEAVE 00257000
L R9,RDEVSPL PICK UP ACTIVE FILE POINTER 00258000
TM IOBCSW+4,CE+UE IS IT CHANNEL END OR UNIT EXCEPTION? 00259000
BNZ RDRCARDS YES -- CARDS HAVE BEEN READ 00260000
SPACE 3 00261000
* HERE ON DEVICE END DUE TO READER BECOMING READY 00262000
SPACE 00263000
TM IOBSTAT,IOBFATAL FATAL IO ERROR ?? 00264000
BO RDRCARDS YES -- 00265000
TM RDEVFLAG,RDEVDRAN DEVICE DRAINED ?? 00266000
BO RDRIOB YES - FRET IOB AND LEAVE 00267000
TM IOBCSW+5,X'FF' ANY CHANNEL ERRORS WITH DEVICE @VA00701 00268000
* END ? 00269000
BNZ RDRCARDS YES -- FATAL I/O ERROR @VA00701 00270000
LTR R9,R9 IS THERE ALREADY A FILE ?? 00271000
* (ACTIVE FILE) 00272000
BNZ RDRIOB YES -- IGNORE THE INTERRUPT 00273000
IC R2,RDEVFLAG SAVE FLAG BYTE 00274000
TM RDEVFLAG,X'01' OPEN ROUTINE IN CONTROL ?? 00275000
BO RDRIOB YES -- FORGET THIS DEVICE END 00276000
OI RDEVFLAG,X'01' INDICATE OPEN ROUTINE IN CONTROL 00277000
CALL DMKSPLOR,AFFINITY @V4075A0 00278100
STC R2,RDEVFLAG RESET FLAG BYTE TO NORMAL 00279000
BZ MSG426E SYSTEM SPOOL SPACE FULL - 00280000
L R2,RSPRPAGE GET ADDRESS OF PAGE BUFFER 00281000
LA R0,BUFSIZE GET CORE FOR A 00282000
CALL DMKFREE TEMPORARY ID CARD BUFFER 00283000
USING BUFFER,R1 00284000
ST R1,SPRMISC SAVE A POINTER TO THE BUFFER 00285000
XC 0(BUFSIZE*8,R1),0(R1) CLEAR BUFFER AREA 00286000
LM R3,R4,RDRCCWS PICK UP MODEL READER CCW 00287000
ALR R3,R1 POINT DATA ADDRESS IN READ TO TEMP 00288000
* BUFFER AREA 00289000
ST R3,BUFNXT POINT TO FIRST CHARACTER IN CARD 00290000
LA R0,80 GET LENGTH OF CARD 00291000
ST R0,BUFCNT SAVE FOR DMKSCNFD 00292000
LA R5,96(R1) SET UP TIC ADDRESS TO SENSE CCW 00293000
STM R3,R5,0(R1) SAVE READ CCW AND HALF TIC IN BUFFER 00294000
CLI RDEVTYPE,TYP2540R 2540 READER ?? 00295000
BNE *+8 NO - LEAVE OP-CODE AS X'02' 00296000
OI 0(R1),X'40' MAKE OP-CODE X'42' SS R2 00297000
CLC IOBMISC(3),=C'CSO' IOB FROM START COMMAND ?? 00298000
* MUST FIND OUT IF READER IS READY 00299000
BNE CLRCSO NO -- CONTINUAL 00300000
MVI 4(R1),SILI SET SILI FLAG ONLY 00301000
MVI 0(R1),X'04' CHANGE OP-CODE TO SENSE 00302000
CLRCSO ST R1,IOBMISC CLEAR 'CSO' 00303000
MVC 96(8,R1),SENSECCW MOVE IN DUMMY SENSE CCW 00304000
MVI 8(R1),8 MOVE IN TIC OP-CODE 00305000
LA R2,SPSIZE(,R2) POINT R2 TO 1ST PAGE BUFFER CCW 00306000
SETCCWS ST R1,IOBCAW ADDRESS OF STARTING CCW 00307000
LM R3,R5,RDRCCWS RE-LOAD MODEL CCWS 00308000
CLI RDEVTYPE,TYP2540R 2540 READER ?? 00309000
BNE *+8 NO -- LEAVE OP-CODE AS X'02' 00310000
O R3,=X'40000000' MAKE OP-CODE X'42' SS R2 00311000
LA R14,96 SIZE OF READER RECORD,INCLUDING CCWS 00312000
LA R15,41*96(,R2) POINTER TO LAST CCW TO BE BUILT 00313000
ALR R3,R2 SET CORRECT DATA ADDRESSES IN 00314000
ALR R5,R2 FIRST SET OF CCWS 00315000
SPACE 2 00316000
CCWLOOP STM R3,R5,0(R2) STORE CCWS IN BUFFER 00317000
ALR R3,R14 INCREMENT DATA ADDRESSES 00318000
ALR R5,R14 IN CCWS 00319000
BXLE R2,R14,CCWLOOP AND LOOP THRU BUFFER,STORING CCWS 00320000
MVC 0(8,R2),SENSECCW FORCE CE+DE BY FINISHING WITH A 00321000
* PHONY SENSE COMMAND 00322000
OI IOBFLAG,IOBCP FLAG AS CP-GENERATED IO 00323000
B SIO AND GO CALL FOR SIO 00324000
SPACE 3 00325000
SENSECCW CCW 4,*-*,SKIP+SILI,1 DUMMY SENSE TO FORCE CE + DE 00326000
PUNCCWS CCW X'41',12,CC+SILI,80 MODEL PUNCH CCW 00327000
RDRCCWS DS 0XL12 SUPPLY A LENGTH FACTOR 00328000
CCW 2,12,CC,80 READ, FEED, AND SS INTO R1 00329000
DC AL1(8) TIC OP-CODE 00330000
DC AL3(96) RELATIVE ADDRESS OF NEXT CCW 00331000
EJECT 00332000
RDRCARDS EQU * HERE TO HANDLE INTERRUPT AFTER CARDS HAVE BEEN READ 00333000
SPACE 3 00334000
LTR R9,R9 ACTIVE FILE ?????? 00335000
BZ RDRIOB NO -- EXIT - CAREFULLY 00336000
TM IOBSTAT,IOBFATAL FIRST, CHECK FOR FATAL IO ERROR 00337000
BO RDRFLUSH FATAL ERROR - GO FLUSH THE FILE 00338000
TM IOBCSW+5,255-IL PCI,CDC,CCC,ICC,PROT,PROG,CHAIN @VA03478 00339000
BNZ RDRFLUSH YES, FATAL ERROR @VA03478 00340000
ICM R15,B'1111',IOBCAW UNSOLICITED AND CE INTERRUPT @VA01299 00341000
BZ RDRIOB YES - EXIT @VA01299 00342000
TM IOBCSW+4,UE IS IT UNIT EXCEPTION? @VA03478 00343000
BO KEEPGO YES, KEEP PROCESSING @VA03478 00344000
TM IOBCSW+5,IL INCORRECT LENGTH? @VA03478 00345000
BO RDRFLUSH YES, FATAL ERROR @VA03478 00346000
KEEPGO L R7,RSPSFBLK GET PTR TO SPOOL FILE BLOK @VA03478 00347000
L R2,RSPRPAGE AND REAL PAGE BUFFER 00348000
CLI SFBUSER,0 HAS THE ID CARD BEEN PROCESSED YET? 00349000
BE RDRGETID NO -- GO DO IT NOW 00350000
SPACE 2 00351000
RDREFTST EQU * HERE TO TEST FOR END OF FILE 00352000
XC IOBRCNT,IOBRCNT CLEAR RETRY COUNT 00353000
TM IOBCSW+4,UE IS UNIT EXCEPTION ON? 00354000
BO RDREOF YES -- END-OF-FILE REACHED IN THIS 00355000
* BUFFER 00356000
SR R1,R1 CHECK IF SENSE IS LAST CCW @VA00701 00357000
ICM R1,B'0111',IOBCSW+1 ADDRESS OF LAST CCW +8 @VA00701 00358000
BZ RDRFLUSH LAST ADDRESS IS ZERO, FLUSH @VA03478 00359000
S R1,F8 POINT TO LAST CCW @VA00701 00360000
CLI 0(R1),X'04' SENSE OP CODE CCW ? @VA00701 00361000
BNE RDRFLUSH NO, INCOMPLETE CHANNEL PROGRAM ? @VA03478 00362000
LA R6,10 RETRY COUNT 00363000
GETDASD CALL DMKPGTSG GO OBTAIN THE NEXT DASD PAGE BUFFER 00364000
BZ MSG426E SYSTEM SPOOL SPACE FULL - 00365000
ST R1,SPNXTPAG AND IN BUFFER LINKAGE FIELD 00367000
LR R3,R1 SAVE ADDRESS OF NEXT PAGE @VA11232 00368000
L R1,SFBSTART START CCPD @VA11232 00368050
L R0,SPPREPAG IS THIS THE FIRST BUFFER ? @VA11232 00368100
LTR R0,R0 IF BACK PTR = ZERO, IT IS @VA11232 00368150
BNZ STSTRT WE ARE NOT REWRITING FIRST BUFFER@VA11232 00368200
C R1,RSPDPAGE FIRST TIME WRITING FIRST BUFFER? @VA11232 00368250
BE STSTRT YES, SFBSTART IS GOOD @VA11232 00368300
L R1,RSPDPAGE GET NEW CCPD FOR FIRST BUFFER @VA11232 00368350
ST R1,SFBSTART SAVE NEW START CCPD IN SFBSTART @VA11232 00368400
ST R1,SFBLAST AND SFBLAST @VA11232 00368450
STSTRT ST R1,SPRMISC SPRMISC CONTAINS START CCPD @VA11232 00368500
LA R0,42 GET NUMBER OF CARDS IN A FULL BUFFER 00369000
ST R0,SPRECNUM AND SAVE IN BUFFER 00370000
A R0,SFBRECNO ADD NUMBER OF RECORDS IN THE 00371000
* BUFFER TO 00372000
ST R0,SFBRECNO TOTAL FOR THE FILE, AND SAVE IT 00373000
LM R0,R1,RSPDPAGE GET VIRTUAL AND DASD BUFFER ADDRESS 00374000
CALL DMKRPAPT,PARM=(SYSTEM) 00375000
L R2,RSPRPAGE RESTORE REAL PAGE ADDRESS 00376000
BZ WRGOOD SUCCESSFUL WRITE 00377000
OI RSPFLAG2,RSPERR INDICATE WRITE ERROR @VA11232 00378000
MVC RSPDPAGE(4),SPNXTPAG USE NEXT CCPD AS CURRENT @VA11232 00379000
L R0,SFBRECNO GET TOTAL RECORD COUNT 00380000
S R0,=F'42' AND RESTORE TO CORRECT VALUE 00381000
ST R0,SFBRECNO .. 00382000
BCT R6,GETDASD RETRY 10 TIMES 00383000
B MSG428 LIMIT REACHED - PURGE FILE 00384000
WRGOOD ST R3,RSPDPAGE SAVE ADDRESS OF NEXT BUFFER 00385000
L R3,SPPREPAG SAVE CCPD OF BUFFER TO BE UPDATED 00386000
ST R0,SPPREPAG SAVE ADDRESS OF PREVIOUS BUFFER 00387000
SR R1,R1 CLEAR OUT 00388000
ST R1,SPRECNUM RECORD COUNTER IN BUFFER 00389000
TM RSPFLAG2,RSPERR STILL IN ERROR RECOVERY ? @VA11232 00390000
BZ RDRSIO NO -- 00391000
NI RSPFLAG2,X'FF'-RSPERR RESET ERROR FLAG @VA11232 00392000
LTR R0,R3 ANY PREVIOUS BUFFERS ?? 00393000
BZ RDRSIO NO PREVIOUS BUFFER TO UPDATE @VA11232 00394000
SPACE 00397000
* 00398000
* HERE TO CORRECT FORWARD POINTER (SPNXTPAG) IN 00399000
* PREVIOUS BUFFER 00400000
* 00401000
UPDTPNT LR R4,R2 SAVE ADDRESS OF STORAGE BUFFER 00402000
CALL DMKPGTVG GET VIRTUAL BUFFER ADDRESS 00403000
LTR R1,R1 VIRTUAL ADDRESS PRESENT ?? 00404000
BZ MSG428A NO VIRTUAL ADDRESSES @VA11232 00405000
ST R1,RSPVPG2 SAVE SEC. VIRTUAL BUFF FOR FRET @VA11232 00405500
TRANS 2,1,OPT=(BRING,DEFER,LOCK,SYSTEM),IOER=MSG428A @VA11232 00406000
* BUFFER 00407000
CALL DMKRPAGT,PARM=(SYSTEM+BRING+LOCK) GET BUFFER 00408000
BNZ MSG428A ERROR READING PREVIOUS BUFFER @VA11232 00409000
MVC SPNXTPAG(4),4(R4) UPDATE FORWARD POINTER IN PREVIOUS 00410000
* BUFFER 00411000
CALL DMKRPAPT,PARM=SYSTEM WRITE BUFFER OUT 00412000
BNZ MSG428A BUFFER WRITE ERROR @VA11232 00413000
LR R2,R4 RESTORE ORIGINAL BUFFER ADDRESS @VA11232 00413100
L R0,SPPREPAG UPDATE SFBPNT AND SFBLAST @VA11232 00413200
ST R0,SFBPNT ... @VA11232 00413300
ST R0,SFBLAST SFBLAST ALSO @VA11232 00413400
SLR R0,R0 RELEASE STORAGE PAGE @VA11232 00413500
CALL DMKRPAGT,PARM=SYSTEM .. 00415000
CALL DMKPGTVR RELEASE VIRTUAL BUFFER 00416000
LR R2,R4 POINT TO ORIGINAL BUFFER @VA11232 00417000
ST R0,RSPVPG2 CLEAR PTR TO SECOND VIRTUAL BUFF @VA11232 00417100
B STARTIO CALL FOR SIO @VA11232 00417200
RDRSIO MVC SFBLAST,SPPREPAG SAVE LAST GOOD BUFFER @VA11232 00417300
RDRSIO2 MVC SFBPNT,SPPREPAG AND IN LAST TOO @VA11232 00417400
STARTIO NI IOBFLAG,X'FF'-IOBRSTRT CLR RESTART FLAG @VA11232 00417500
B SIO AND GO CALL FOR SIO 00419000
EJECT 00420000
RDRGETID EQU * HERE TO PROCESS CP USERID CARD 00421000
SPACE 3 00422000
L R9,SPRMISC POINT TO TEMPORARY BUFFER 00423000
CLI 0(R9),X'04' SENSE OPERATION ?? 00424000
BNE NOTSNSE NO -- 00425000
CLI 12(R9),X'40' READER READY --?? 00426000
BE FRETBUFF NO -- LEAVE 00427000
MVI 0(R9),X'02' RESTORE READ OP-CODE 00428000
CLI RDEVTYPE,TYP2540R 2540 READER ?? 00429000
BNE *+8 NO -- LEAVE AS X'02' 00430000
OI 0(R9),X'40' MAKE OP-CODE X'42' SS INTO R2 00431000
MVI 4(R9),CC SET COMMAND CHAINING FLAG ONLY 00432000
B BLKCARD GO READ ID CARD - 00433000
SPACE 00434000
NOTSNSE EQU * 00435000
TM IOBCSW+4,UE UNIT EXCEPTION ?? 00436000
BO FRETBUFF YES -- LEAVE 00437000
CALL DMKSCNFD PICK UP FIRST FIELD 00438000
BNZ BLKCARD BLANK CARD - SKIP IT 00439000
CLC =C'USERID ',0(R1) USERID CARD ?? 00440000
BE FINDUSR YES -- 00441000
CLC =C'CP67USERID ',0(R1) CP67USERID ?? 00442000
BE FINDUSR YES - 00443000
CLC =C'ID ',0(R1) ID CARD ?? 00444000
BE FINDUSR YES - 00445000
CLC 85(7,R9),=XL7'04040404040404' SEPARATOR CARD ?? 00446000
BNE MSG431A ID CARD MISSING OR INVALID 00447000
BLKCARD LA R3,12(R9) SET SCAN POINTERS 00448000
LR R1,R9 SET BASE FOR BUFFER 00449000
ST R3,BUFNXT .. 00450000
LA R3,80 .. 00451000
ST R3,BUFCNT .. 00452000
B RDRSIO2 GO READ NEXT CARD @VA11232 00453000
SPACE 00454000
FINDUSR EQU * 00455000
CALL DMKSCNFD PICK UP THE USERID 00456000
BNZ MSG431A ID CARD (USERID MISSING ) 00457000
C R0,F8 USERID LENGTH GREATER THAN 8 ?? 00458000
BH MSG432A USERID NOT IN CP DIRECTORY 00459000
LR R14,R0 GET COUNT OF USERID 00460000
MVI SFBCLAS,C'A' MOVE IN DEFAULT CLASS (A) 00461000
MVC SFBUSER(8),BLANKS BLANK OUT SFBUSER 00462000
BCTR R14,R0 -1 FOR MOVE 00463000
EX R14,MOVEID MOVE USERID TO SFBLOK 00464000
MVC SFBORIG(8),SFBUSER FILL IN SFBORIG 00465000
SR R2,R2 CLEAR PARM REG 00466000
CALL DMKUDRFU VERIFY USERID IN CP DIRECTORY 00467000
BNZ MSG432A USERID NOT IN CP DIRECTORY 00468000
SPACE 00469000
GETARG EQU * HERE TO GET ADDITIONAL OPTIONS 00470000
CALL DMKSCNFD 00471000
BNZ IDMSG NONE GIVEN 00472000
CLC =C'CLASS ',0(R1) IS IT CLASS ?? 00473000
BE GETCLASS YES - 00474000
CLC =C'NAME ',0(R1) IS IT A FILE NAME ?? 00475000
BE GETNAME YES -- GET FNAME AND FTYPE 00476000
CLI 2(R1),C'/' IS IT DATE ?? 00477000
BE IDMSG YES -- LEAVE NAME BLANK 00478000
B MSG433A ID CARD INVALID DATA 00479000
SPACE 00480000
GETNAME EQU * HERE TO LOCATE FNAME AND FTYPE 00481000
CALL DMKSCNFD GET THE FILE NAME 00482000
BNZ IDMSG NONE -- LEAVE BLANK 00483000
LA R5,SFBFNAME POINT TO NAME FIELD -- 00484000
BAL R4,MOVENAME AND MOVE IN THE NAME 00485000
CALL DMKSCNFD IS A TYPE GIVEN ?? 00486000
BNZ IDMSG NO -- 00487000
CLI 2(R1),C'/' DATE STAMP ?? 00488000
BE IDMSG YES -- 00489000
CLI SFBFNAME+8,C' ' DSNAME ?? 00490000
BNE MSG433A YES -- INVALID DATA 00491000
C R0,F8 FTYPE OVER 8 BYTES ?? 00492000
BH MSG433A YES -- INVALID DATA 00493000
LA R5,SFBFTYPE POINT TO TYPE FIELD 00494000
BAL R4,MOVENAME AND MOVE IN THE NEW TYPE 00495000
B GETARG GO GET NEXT ARG, IF ANY 00496000
SPACE 2 00497000
MOVEID MVC SFBUSER(0),0(R1) MOVE ID TO SFBLOK 00498000
SPACE 00499000
MOVENAME EQU * HERE TO MOVE FILE NAME AND TYPE 00500000
SPACE 00501000
CLI 2(R1),C'/' IS IT DATE ?? 00502000
BE IDMSG LEAVE NAME BLANK 00503000
LR R15,R0 GET LENGTH OF FIELD 00504000
BCTR R15,0 DECREMENT FOR MOVE 00505000
C R0,F24 OVER MAX. LENGTH FOR DSNAME 00506000
BH MSG433A YES -- ERROR MSG DMKRSP433A 00507000
CLI 0(R5),C' ' 'TO' FIELD BLANK ?? 00508000
BNE MSG433A NO - INVALID DATA 00509000
EX R15,MOVE MOVE IN DESIRED FIELD 00510000
BR R4 AND RETURN TO CALLER 00511000
SPACE 00512000
MOVE MVC 0(*-*,R5),0(R1) EXECUTED.. 00513000
SPACE 2 00514000
GETCLASS CALL DMKSCNFD LOCATE CLASS ARG 00515000
BNZ IDMSG NONE GIVEN 00516000
CLI 0(R1),C'A' BINARY VALUE BELOW 'A' ?? 00517000
BL MSG433A ID CARD - INVALID CLASS 00518000
LR R5,R1 SAVE ADDRESS OF CLASS 00519000
TRT 0(1,R1),ALPHANUM TEST FOR VALID CLASS 00520000
LR R1,R5 RESTORE ADDRESS OF CLASS 00521000
BNH MSG433A ID CARD - INVALID CLASS 00522000
STC R2,SFBCLAS MOVE CLASS TO SFBLOK 00523000
B GETARG 00524000
SPACE 2 00525000
MSG433A EQU * HERE IF ID CARD HAS INVALID DATA FOR 00526000
* CLASS OR FNAME OR FTYPE 00527000
LR R2,R0 SAVE COUNT AND 00528000
LR R6,R1 ADDRESS OF INVALID DATA 00529000
BAL R5,TYPERADD GET TYPE AND DEVICE ADDRESS 00530000
XC 8(24,R3),8(R3) CLEAR DATA AREA 00531000
C R2,F24 COUNT OVER 24 BYTES ?? 00532000
BNH *+8 NO -- 00533000
LA R2,24 YES - FORCE TO 24 00534000
BCT R2,*+10 -1 FOR MOVE 00535000
MVCDATA MVC 8(0,R3),0(R6) MOVE INVALID DATA TO MESSAGE AREA 00536000
EX R2,MVCDATA EXCUTE MOVE OF DATA 00537000
LA R0,28 LENGTH OF MESSAGE 00538000
LA R2,433 ERROR MSG DMKRSP433A 00539000
ICM R2,B'0100',=C'A' ACTION CODE 00540000
BAL R5,RSPMSG WRITE MESSAGE TO OPERATOR 00541000
B FRETBUFF CLEAN UP AND EXIT 00542000
SPACE 2 00543000
MSG431A EQU * HERE IF ID CARD IS MISSING OR INVALID 00544000
BAL R5,TYPERADD GET TYPE AND REAL DEVICE ADDRESS 00545000
LA R2,431 ERROR MSG DMKRSP431A 00546000
ICM R2,B'0100',=C'A' ACTION CODE 00547000
BAL R5,RSPMSG WRITE ERROR MESSAGE 00548000
B FRETBUFF CLEAN UP AND EXIT 00549000
SPACE 2 00550000
SPACE 00551000
MSG432A EQU * HERE IF USERID NOT IN CP DIRECTORY 00552000
BAL R5,TYPERADD GET TYPE AND REAL ADDRESS 00553000
MVC 8(8,R3),SFBUSER MOVE USERID TO MESSAGE 00554000
LA R0,28 LENGTH OF MESSAGE DATA 00555000
LA R2,432 ERROR MSG DMKRSP432A 00556000
ICM R2,B'0100',=C'A' ACTION CODE 00557000
BAL R5,RSPMSG WRITE ERROR MSG 00558000
B FRETBUFF GO - FRET BUFFER 00559000
SPACE 00560000
IDMSG LA R2,80 FUNCTION INDEX @V200930 00561000
BAL R6,SETMSG SETUP MESSAGE @V200930 00562000
CALL DMKQCNWT,PARM=OPERATOR+NORET @V200930 00563000
SR R3,R3 INDICATE ID CARD COMPLETE 00564000
B *+6 GO FRET ID BUFFER AND CONTINUAL 00565000
SPACE 00566000
FRETBUFF EQU * HERE TO FREE TEMPORARY BUFFER 00567000
LR R3,R12 INDICATE ID CARD NOT COMPLETE 00568000
LR R1,R9 POINT TO IT 00569000
LA R0,BUFSIZE GET ITS SIZE 00570000
CALL DMKFRET AND FRET IT 00571000
SPACE 00572000
L R9,RDEVSPL GET RSPLCTL CONTROL BLOCK @VA11232 00573000
L R2,RSPRPAGE GET REAL BUFFER ADDRESS @VA11232 00573100
SLR R15,R15 CLEAR @VA11232 00573200
ST R15,SPRMISC RESET TO ZERO FOR NOW @VA11232 00573300
* BLOK 00574000
LTR R3,R3 ID CARD COMPLETE AND CORRECT 00575000
BNZ RDREXIT2 NO FLUSH FILE @VA03478 00576000
SPACE 00577000
LA R1,SPSIZE(,R2) POINT TO FIRST CCW IN BUFFER 00579000
ST R1,IOBCAW SAVE ADDRESS 00580000
B RDRSIO2 FILL BUFFER @VA11232 00581000
SPACE 2 00582000
EJECT 00583000
RDREOF EQU * HERE FOR PHYSICAL END OF FILE ON CARD READER 00584000
SPACE 3 00585000
SR R1,R1 CLEAR GPR1 00586000
TM IOBSTAT,IOBCC1 CSW STORED ?? 00587000
BO EMPTYBUF YES -- BUFFER EMPTY 00588000
ICM R1,B'0111',IOBCSW+1 ADDR OF LAST USED CCW+8 @VA01863 00589000
BZ EMPTYBUF BRANCH IF 0 CSW ADDRESS @VA01863 00590000
SR R1,R2 GET DISPLACEMENT FROM START OF 00591000
* BUFFER 00592000
SR R0,R0 CLEAR HIGH-ORDER WORD OF DIVIDEND 00593000
D R0,=F'96' DIVIDE BY LOGICAL RECORD LENGTH 00594000
EMPTYBUF L R0,RSPDPAGE RESTORE ADDRESS OF DASD PAGE 00595000
SPACE 3 00596000
RDRCLOSE EQU * 00597000
ST R1,SPRECNUM STORE RECORD COUNT FOR THIS BUFFER 00598000
A R1,SFBRECNO ADD NUMBER OF RECORDS IN LAST BUFFER 00599000
ST R1,SFBRECNO AND SAVE IT 00600000
LTR R1,R1 EMPTY FILE ?? 00601000
BZ RDRFLUSH YES -- FLUSH FILE 00602000
LA R5,10 RETRY COUNT OF 10 00603000
CLWRITE L R1,SFBSTART GET ORIGINAL START CCPD @VA11232 00604000
L R6,SPPREPAG SEE IF FIRST PAGE IS BEING @VA11232 00604100
LTR R6,R6 RE-WRITTEN @VA11232 00604200
BNZ USESTRT NO, USE SFBSTART @VA11232 00604300
C R1,RSPDPAGE RE-WRITTEN IN SAME SPOT ? @VA11232 00604400
BE USESTRT YES, USE SFBSTART @VA11232 00604500
L R1,RSPDPAGE SPRMISC MUST EQUAL NEW START @VA11232 00604600
ST R1,SFBSTART SAVE NEW START CCPD @VA11232 00604700
ST R1,SFBLAST MAKE IT LAST TOO @VA11232 00604800
USESTRT ST R1,SPNXTPAG CHAIN TAIL TO HEAD @VA11232 00604900
ST R1,SPRMISC SAVE IN SPRMISC ALSO @VA11232 00605000
LM R0,R1,RSPDPAGE GET BUFF ADDRESS AND SLOT @VA11232 00605100
CALL DMKRPAPT,PARM=(SYSTEM) WRITE OUT BUFFER 00606000
L R2,RSPRPAGE RESTORE BUFFER ADDRESS @VA11232 00607000
BZ RDRGOOD BUFFER WRITE SUCCESSFUL @VA11232 00607100
OI RSPFLAG2,RSPERR INDICATE WRITE ERROR @VA11232 00607200
CALL DMKPGTSG GET DASD BUFFER ADDRESS 00609000
BZ MSG426E SPOOL SPACE FULL 00610000
ST R1,RSPDPAGE SAVE CCPD 00611000
BCT R5,CLWRITE RETRY UP TO TEN TIMES 00612000
B MSG428 LIMIT REACHED - PURGE FILE 00613000
RDRGOOD TM RSPFLAG2,RSPERR IN ERROR RECOVERY ? @VA11232 00614000
BZ CHFILE NO - CONT 00617000
NI RSPFLAG2,X'FF'-RSPERR RESET ERROR INDICATOR @VA11232 00618000
LR R4,R2 SAVE BUFFER ADDRESS @VA11232 00618100
L R1,RSPVPAGE GET VIRTUAL BUFFER ADDRESS 00619000
ICM R15,B'1111',SPPREPAG GET PREVIOUS BUFFER ADDRESS 00620000
BZ CHFILE CHAIN FILE @VA11232 00621000
UPDPREV LR R0,R15 GET LAST BUFFER ADDRESS @VA11232 00621100
CALL DMKRPAGT,PARM=(SYSTEM+BRING+LOCK) GET BUFFER 00623000
BNZ BUFFERR PAGE READ ERROR @VA11232 00624000
WRLAST MVC SPNXTPAG(4),RSPDPAGE UPDATE FORWARD POINTER @VA11232 00625000
CALL DMKRPAPT,PARM=SYSTEM WRITE BUFFER OUT 00626000
BZ CHFILE CHAIN COMPLETED SPOOL FILE @VA11232 00627000
BUFFERR LR R2,R4 RE-ESTABLISH BUFFER @VA11232 00627100
MVC SPNXTPAG(4),RSPDPAGE UPDATE FORWARD POINTER @VA11232 00627200
B MSG428B DEALLOCATE BUFFER @VA11232 00627300
EJECT 00628000
CHFILE EQU * HERE TO CHAIN THE COMPLETED SPOOL FILE BLOCK 00629000
L R2,RSPDPAGE RESTORE REAL BUFFER CCPD @VA11232 00629100
ST R2,SFBLAST MAKE IT LAST CCPD @VA11232 00629200
SPACE 00630000
CALL DMKSPLCR CALL THE FILE CLOSE ROUTINE 00631000
TM RDEVFLAG,RDEVDRAN DEVICE TO BE DRAINED ?? 00632000
BZ RDREXIT4 NO - 00633000
BAL R6,DRAINMSG TYPE DRAIN MESSAGE @V200930 00634000
B RDREXIT4 AND LEAVE 00635000
SPACE 2 00636000
MSG426E EQU * HERE SYSTEM INPUT SPOOLING SPACE IS FULL 00637000
L R0,SFBSTART ANY BUFFERS IN THE FILE ?? 00638000
LTR R0,R0 ?? 00639000
BZ MSG426 NO -- NO BUFFERS TO DELETE 00640000
SPACE 00641000
BAL R5,DELETE GO DELETE SPOOL FILE 00642000
SPACE 00643000
MSG426 BAL R5,TYPERADD GET TYPE AND REAL ADDRESS 00644000
LA R2,426 ERROR MSG DMKRSP426E 00645000
BAL R5,RSPMSG WRITE ERROR MSG 00646000
B RDREXIT3 EXIT 00647000
SPACE 00647100
MSG428A EQU * @VA11232 00647200
XC RSPSWAP(8),RSPSWAP PREPARE DUMMY SWAPTABLE @VA11232 00647300
LR R2,R4 RESTORE ORIGINAL BUFFER @VA11232 00647400
L R4,SPPREPAG FIRST OF TWO CCPDS TO RELEASE @VA11232 00647500
ST R4,RSPSWAP+4 SAVE IN DUMMY SWAPTABLE ENTRY @VA11232 00647600
LA R5,RSPSWAP POINT TO DUMMY SWAPTABLE ENTRY @VA11232 00647700
CALL DMKPGTSD RELEASE SLOT @VA11232 00647800
B MSG428C GO DEALLOCATE SECOND SLOT @VA11232 00647900
MSG428B XC RSPSWAP(8),RSPSWAP CLEAR DUMMY SWAPTABLE @VA11232 00648000
LR R2,R4 RE-ESTABLISH BUFFER PTR. @VA11232 00648100
LA R5,RSPSWAP POINT TO DUMMY SWAPTABLE ENTRY @VA11232 00648200
MSG428C L R4,SPNXTPAG NEXT CCPD TO DEALLOCATE @VA11232 00648300
XC RSPSWAP(8),RSPSWAP CLEAR DUMMY SWAPTABLE ENTRY @VA11232 00648400
ST R4,RSPSWAP+4 STORE IN DUMMY SWAPTABLE ENTRY @VA11232 00648500
CALL DMKPGTSD DEALLOCATE PAGE @VA11232 00648600
SPACE 00648700
MSG428 EQU * HERE FOR SPOOL PAGING ERROR 00649000
ICM R0,B'1111',SFBPNT BUFFER ADDRESS OF LAST GOOD WRITE 00650000
ST R0,SFBLAST SET UP LAST ADDRESS FOR FILE PURGE 00651000
BZ *+8 PURGE BUFFERS OF FILE - NO 00652000
BAL R5,DELETE PURGE BUFFERS AND SFBLOK 00653000
BAL R5,TYPERADD GET TYPE AND ADDRESS FOR MSG 00654000
LA R2,428 SET UP DATA FOR MESSAGE 00655000
LA R0,16 LENGTH 00656000
LR R1,R3 ADDRESS OF MSG DATA 00657000
BAL R5,RSPMSG WRITE ERROR MSG 00658000
B RDREXIT3 NOW EXIT 00659000
SPACE 3 00660000
DELETE EQU * HERE TO DELETE SPOOL FILE 00661000
L R7,RSPSFBLK ADDRESS OF SPOOL BLOK 00662000
LTR R7,R7 ONE PRESENT ?? 00663000
BCR 8,R5 NO - RETURN TO CALLER 00664000
NI RSPFLAG2,X'FF'-RSPERR RESET BUFFER ERROR FLAG @VA11232 00665000
LA R0,CPEXSIZE LENGTH OF BLOK @VA00701 00666000
CALL DMKFREE GET STORAGE @VA00701 00667000
USING CPEXBLOK,R1 @VA00701 00668000
XC CPEXBLOK(CPEXSIZE*8),CPEXBLOK CLEAR BLOK @VA00701 00669000
BAL R15,DELSTK SET UP ENTRY POINT AND STACK @VA00701 00670000
CALL DMKSPLDL CALL FILE DELETER @VA00701 00671000
GOTO DMKDSPCH EXIT @VA00701 00672000
SPACE 00673000
DELSTK STM R15,R13,CPEXADD SAVE REGS AND ENTRY POINT @VA00701 00674000
CALL DMKSTKCP STACK CPEXBLOK @VA00701 00675000
SR R7,R7 CLEAR SFBLOK REG @VA00701 00676000
ST R7,RSPSFBLK AND POINTER @VA00701 00677000
BR R5 RETURN TO CALLER @VA00701 00678000
SPACE 2 00679000
SPACE 1 00680000
RDRFLUSH EQU * HERE TO FLUSH AND DELETE PARTIALLY COMPLETE FILE 00681000
BAL R5,DELETE DELETE FILE 00682000
BAL R5,TYPERADD GET TYPE AND REAL ADDRESS 00683000
LA R2,434 ERROR MSG DMKRSP434A 00684000
* RDR FATAL I/O ERROR FILE PURGED 00685000
ICM R2,B'0100',=C'A' ACTION CODE 00686000
BAL R5,RSPMSG WRITE ERROR MSG 00687000
B RDREXIT3 00688000
RDREXIT2 BAL R5,DELETE FLUSH FILE @VA03478 00689000
SPACE 2 00690000
EJECT 00691000
RDREXIT3 EQU * @V4075A0 00692100
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00692200
NI RDEVSTAT,X'FF'-RDEVNRDY RESET NOT READY FLAG @V4075A0 00692300
LTR R1,R7 POINT TO SPOOL FILE BLOK 00693000
BZ RDREXIT4 NONE PRESENT 00694000
LA R0,SFBSIZE SIZE OF BLOK 00695000
CALL DMKFRET FRET SFBLOK IF FILE NO GOOD 00696000
SPACE 00697000
RDREXIT4 EQU * HERE FOR NORMAL EXIT AT END OF FILE 00698000
ICM R9,B'1111',RDEVSPL RSP CONTROL BLOK PRESENT ? @VA00701 00699000
BZ RDRIOB NO -- 00700000
L R1,RSPVPAGE GET VIRUAL PAGE ADDRESS 00701000
SR R0,R0 DUMMY PAGE ADDRESS 00702000
CALL DMKRPAGT,PARM=(SYSTEM) HERE TO FREE CORE PAGE 00703000
CALL DMKPGTVR RELEASE VIRTUAL ADDRESS SPACE 00704000
L R1,RSPVPG2 SECOND VIRTUAL BUFFER ADDRESS @VA11232 00705000
LTR R1,R1 IS THERE ONE ? @VA11232 00705100
BZ NOBUFF2 NO, NOTHING TO RELEASE @VA11232 00705200
CALL DMKRPAGT,PARM=SYSTEM RELEASE CORE PAGE @VA11232 00705300
CALL DMKPGTVR AND RELEASE VIRTUAL BUFFER @VA11232 00705400
NOBUFF2 LR R1,R9 PTR TO RSPLCTL WORKAREA @VA11232 00705500
LA R0,RSPSIZE AND ITS SIZE FOR 00706000
CALL DMKFRET CALL TO FRET 00707000
SR R9,R9 CLEAR ACTIVE 00708000
ST R9,RDEVSPL POINTER IN DEVICE BLOK 00709000
RDRIOB LA R0,IOBSIZE SIZE OF IOBLOK -- 00710000
LR R1,R10 AND ITS ADDRESS 00711000
CALL DMKFRET FREE IT 00712000
B RSPLEXIT AND EXIT 00713000
SPACE 3 00714000
ORG *-193 00715000
ALPHANUM EQU * TRT TABLE TO VALIDATE THE 36 LEGAL CLASSES 00716000
ORG 00717000
DC C'ABCDEFGHI' VALID CLASSES 00718000
DC 7X'00' ILLEGAL CLASSES 00719000
DC C'JKLMNOPQR' VALID CLASSES 00720000
DC 8X'00' ILLEGAL CLASSES 00721000
DC C'STUVWXYZ' VALID CLASSES 00722000
DC 6X'00' ILLEGAL CLASSES 00723000
DC C'0123456789' VALID CLASSES 00724000
DC 6X'00' ILLEGAL CLASSES 00725000
DS 0H 00726000
EJECT 00727000
*. 00728000
* 00729000
* REAL PRINTER AND PUNCH HANDLING - 00730000
* 00731000
* 1. DETERMINE IF A FILE IS ALREADY ACTIVE ON THE DEVICE. IF 00732000
* SO, GO TO STEP 6; OTHERWISE, CONTINUE 00733000
* 00734000
* 2. IF THE DEVICE IS AVAILABLE, BUILD THE CONTROL BLOKS NEC- 00735000
* ESSARY TO PROCESS A FILE, AND ATTEMPT TO LOCATE AN SFBLOK 00736000
* ON THE PROPER FILE CHAIN (DMKRSPPR OR DMKRSPPU) WHOSE CLASS 00737000
* (AND OPTIONALLY DIRECTED ADDRESS) MATCH THOSE OF THE REAL 00738000
* DEVICE BEING PROCESSED. IN THE CASE OF A 3800 PRINTER, 00739000
* TWO VIRTUAL STORAGE AND REAL STORAGE BUFFERS ARE OBTAINED 00739250
* WHEREAS FOR OTHER DEVICES, ONLY ONE IS OBTAINED. 00739500
* IF A FILE IS FOUND, CONTINUE; 00739750
* OTHERWISE, EXIT VIA A GOTO TO DMKDSPCH 00740000
* IN THE CASE OF A 3800, IF THE SFBFLASH FIELD IS NOT ALL 00740250
* ZEROES, IT MUST ALSO MATCH THE RDEVOVLY FIELD FOR A SPOOL 00740500
* FILE TO BE CONSIDERED FOR PRINTING. 00740750
* 00741000
* 3. UNCHAIN THE SFBLOK FROM THE FILE CHAIN AND HOOK IT TO THE 00742000
* RSPLCTL BLOK; WRITE A MESSAGE TO THE OPERATOR INDICATING 00743000
* THE OWNERSHIP OF THE FILE; IF THE DEVICE IS A PUNCH, ASK 00744000
* THE OPERATOR TO READY THE PUNCH, AND CONTINUE 00745000
* 00746000
* 4. PRINT OR PUNCH AN OUTPUT SEPARATOR RECORD 00747000
* 00748000
* 5. READ IN THE FIRST BUFFER OF THE FILE AND TEST FOR A BACK- 00749000
* CHAIN FIELD OF ZERO. IF THE BACKCHAIN IS ZERO, THIS IS 00750000
* REALLY THE FIRST BUFFER - IF THE DEVICE IS A 3800, 00751000
* CALL DMKTCSET TO SET IT UP FOR THE FILE. IN ANY CASE, 00751300
* CONTINUE TO NEXT STEP; IF BACK CHAIN IS 00751600
* NOT ZERO, THE FILE IS BEING RESTARTED - LOCATE THE 00752000
* NEAREST SKIP TO CHANNEL ONE AND CONTINUE 00753000
* 00754000
* 6. TEST TO SEE IF THE LAST PAGE BUFFER HAS BEEN PROCESSED. IF 00755000
* IT HAS, GO TO STEP 8; OTHERWISE, CONTINUE 00756000
* 00757000
* 7. LOOP THRU THE CCWS IN THE BUFFER, ADJUSTING THEIR DATA 00758000
* ADDRESSES TO CORRESPOND TO THE REAL PAGE ADDRESS OF THE 00759000
* BUFFER AND FORCE SINGLE SPACE FOR PRINTER FILES IF DESIRED 00760000
* WHEN ALL CCWS ARE SET, CALL DMKIOSQR TO START THE DEVICE AN 00761000
* GO TO DMKDSPCH TO AWAIT THE INTERRUPT 00762000
* EXCEPT IF THE DEVICE IS A 3800 PRINTER WHICH UTILIZES 00762150
* DOUBLE BUFFERING. IN THIS CASE, SET UP THE SECOND BUFFER 00762300
* IF IT DOESN'T HAVE I/O PENDING AND HAS VALID DATA 00762450
* WAITING TO BE PRINTED. IN ADDITION, LOAD THE NEXT DASD 00762600
* PAGE INTO THE BUFFER THAT JUST COMPLETED PRINTING. 00762750
* 00763000
* 8. WHEN THE LAST BUFFER HAS BEEN PROCESSED, TEST TO SEE IF 00764000
* MORE COPIES OF THE FILE REMAIN TO BE MADE; 00765000
* IF SO AN NOT A 3800, GO TO STEP 5; IF SO AND A 3800, 00765300
* ISSUE THE 'END OF TRANSMISSION' CCW, SET UP THE FLASHING 00765600
* AND COPY NUMBER INFORMATION AND CALL DMKTCSCO; IF NOT 00765900
* AND IT IS A 3800, ISSUE THE 'MARK FORMS' CCW AND PUT THE 00766200
* FILE ON THE DELAYED PURGE QUEUE. IF THE QUEUE HAS REACHED 00766500
* MAXIMUM SIZE, RELEASE THE DASD BUFFERS FOR THE FIRST 00766800
* FILE ON THE QUEUE. 00767100
* OTHERWISE CALL DMKSPLDL TO RELEASE THE DASD BUFFERS 00767400
* THAT CONTAINED THE FILE, AND GO TO STEP 2 00767700
* 00768000
*. 00769000
SPACE 3 00770000
RSPLOUT EQU * 00771000
NI IOBFLAG,X'FF'-IOBRSTRT RESET RESTART FLAG 00772000
TM RDEVSTAT,RDEVDED IS DEVICE DEDICATED TO ONE @VA00701 00773000
* USER ? 00774000
BO FRETIOB YES -- FRET IOBLOK AND LEAVE @VA00701 00775000
TM RDEVFLAG,RDEVACNT DEVICE BUSY WITH ACCOUNTING ? @VA00701 00776000
BO FRETIOB YES -- FRET IOBLOK AND LEAVE @VA00701 00777000
XC IOBRCNT,IOBRCNT CLEAR RESTART COUNTER @VA00701 00778000
L R9,RDEVSPL PICK UP ACTIVE FILE POINTER 00779000
TM IOBSTAT,IOBFATAL FATAL FLAG ?? 00780000
BO PRNXTPAG YES - 00781000
TM IOBCSW+4,CE+UE CHANNEL END OR UNIT EXCEPTION ?? 00782000
* NORMAL INTERRUPT 00783000
BNZ PRNXTPAG YES -- GO PROCESS NEXT PAGE BUFFER 00784000
TM IOBCSW+4,DE DEVICE END ????? 00785000
BO OUTDE YES -- 00786000
OI IOBSTAT,IOBFATAL ERROR AND NOT UNIT CHECK 00787000
B PRNXTPAG GO TO FATAL ROUTINE 00788000
OUTDE EQU * 00789000
* HERE ON INITIAL DEVICE END 00790000
SR R7,R7 00791000
LTR R9,R9 IS A FILE ALREADY OPEN ?? 00792000
BZ RSPINIT NO - 00793000
CLI 0(R9),X'FF' ADDRESS OF SFBLOK ?? (WARM START) 00794000
* SET FOR ACTIVE FILE IN WARM START 00795000
BE RSPINIT1 YES -- 00796000
TM RDEVSTAT,RDEVNRDY INTERVENTION REQUIRED 00797000
BZ FRETIOB NO -- 00798000
TM RDEVTYPE,TYPPUN PUNCH TYPE ?? 00799000
BZ FRETIOB NO -- LEAVE 00800000
TM RDEVSTAT,RDEVBUSY IS IT REALLY NOT READY ?? 00801000
BO FRETIOB YES -- FRET IOB AND LEAVE 00802000
B PCHHDR DEVICE END FOR NOSEP CONDITION 00803000
RSPINIT TM RDEVFLAG,RDEVDRAN DEVICE DRAINED ? @VA00701 00804000
BNZ FRETIOB YES -- LEAVE 00805000
RSPINIT1 LR R7,R9 SET SFBLOK ADDRESS TO CORRECT GPR 00806000
* THIS FOR ACTIVE FILE ON WARM START 00807000
LA R0,RSPSIZE GET CORE FOR 00808000
CALL DMKFREE RSPLCTL WORKAREA 00809000
LR R9,R1 SAVE ITS ADDRESS 00810000
ST R9,RDEVSPL IN DEVICE BLOK ACTIVE FILE POINTER 00811000
XC RSPLCTL(RSPSIZE*8),RSPLCTL CLEAR WORKAREA 00812000
CALL DMKPGTVG OBTAIN VIRTUAL ADDRESS SPACE 00813000
LTR R1,R1 VIRTUAL ADDRESS PRESENT ?? 00814000
BZ RSP003 NO -- LEAVE 00815000
ST R1,RSPVPAGE AND SAVE ITS ADDRESS 00816000
TRANS 2,1,OPT=(BRING,DEFER,LOCK,SYSTEM) 00817000
ST R2,RSPRPAGE AND SAVE ITS ADDRESS 00818000
CLI RDEVTYPE,TYP3800 IS IT A 3800 PRINTER ? @V60B9BA 00818200
BNE RSPINIT2 XFER IF NOT @V60B9BA 00818400
CALL DMKPGTVG GET ANOTHER BUFFER @V60B9BA 00818600
LTR R1,R1 ADDRESS PRESENT ? @V60B9BA 00818800
BZ RSP003A XFER IF NOT @V60B9BA 00819000
ST R1,RSPVPAG2 SAVE ADDR OF 2ND VIRT BUFF @V60B9BA 00819200
TRANS 2,1,OPT=(BRING,DEFER,LOCK,SYSTEM) LOCK IT IN @V60B9BA 00819400
ST R2,RSPRPAG2 AND SAVE ITS ADDRESS @V60B9BA 00819600
RSPINIT2 LTR R7,R7 WARM START ACTIVE FILE ?? @V60B9BA 00819800
BNZ ACTFILE YES - 00820000
SPACE 3 00821000
PRNXTFIL EQU * HERE TO FIND THE NEXT FILE TO PROCESS 00822000
L R5,RDEVCLAS PICK UP DEVICE OUTPUT CLASS(ES) 00823000
L R2,RSPRPAGE RESTORE REAL DPAGE ADDRESS 00824000
PRESCAN SLDL R4,8 GET CLASS IN GPR8 00825000
LA R15,DMKRSPPR POINT TO START OF PRINTER FILE CHAIN 00826000
TM RDEVTYPE,TYPPRT IS IT A PRINTER? 00827000
BO SFBLOOP2 YES -- 00828000
LA R15,DMKRSPPU START OF PUNCH FILE CHAIN 00829000
SPACE 00830000
SFBLOOP2 L R7,SFBPNT-SFBLOK(,R15) POINT TO NEXT SFBLOK 00831000
LTR R7,R7 IS THERE ONE? 00832000
BZ CLASSCNT NO -- GO SEE IF MORE CLASSES TO 00833000
* TESTED 00834000
TM SFBFLAG,SFBUHOLD+SFBSHOLD SHOULD THE FILE BE HELD ? 00835000
BNZ NEXTSFB2 YES -- SKIP IT 00836000
TM SFBFLAG,SFBINUSE THIS FILE IN USE ?? @VA08075 00836300
BO NEXTSFB2 YES, IGNORE THIS FILE @VA08075 00836600
SPACE 2 00837000
CLASTEST EX R4,CLICLASS COMPARE REQUESTED OUTPUT CLASS TO 00838000
* DEVICE 00839000
BE FILFOUND FOUND A FILE 00840000
EX R4,TSTANY TEST FOR * CLASS @V200930 00841000
BE FILFOUND YES, DO THIS FILE @V200930 00842000
SPACE 2 00843000
NEXTSFB2 LR R15,R7 SAVE POINTER TO LAST BLOK 00844000
B SFBLOOP2 AND CONTINUE DOWN THE CHAIN 00845000
SPACE 00846000
CLASSCNT EQU * HERE IF NO MORE SFBLOKS -- RESCAN CHAIN WITH NEW CLASS 00847000
LTR R5,R5 ANY MORE CLASSES TO LOOK AT? 00848000
BZ PRTIDLE NO 00849000
B PRESCAN YES -- GO SCAN CHAIN AGAIN 00850000
SPACE 2 00851000
CLICLASS CLI SFBCLAS,0 EXECUTED COMPARE 00852000
TSTANY CLI =C'*',0 EXECUTED COMPARE @V200930 00853000
SPACE 3 00854000
FILFOUND EQU * HERE IF A VALID OUTPUT FILE IS LOCATED 00855000
CLI RDEVTYPE,TYP3800 IS IT A 3800 PRINTER ? @V60B9BA 00855250
BNE FILFND2 XFER IF NOT @V60B9BA 00855500
CLI SFBFLASH,X'00' FLASHING SPECIFIED ? @V60B9BA 00855750
BE FILFND2 XFER IF NOT @V60B9BA 00856000
CLC SFBFLASH,RDEVOVLY IS THIS THE RIGHT OVERLAY? @V60B9BA 00856250
BNE NEXTSFB2 TRY NEXT FILE IF NOT @V60B9BA 00856500
FILFND2 MVC SFBPNT-SFBLOK(4,R15),SFBPNT UNCHAIN THE SFBLOK @V60B9BA 00856750
ACTFILE L R5,SFBSTART SAVE START OF FILE 00857000
ST R5,SFBPNT IN NEXTPNT 00858000
ST R7,RSPSFBLK SAVE ADDRESS OF SPOOL FILE BLOK 00859000
* CLEAR OUT THE FILE DEPENDENT OPTIONS 00860000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00860100
NI RDEVFLAG,X'FF'-(RDEVSPAC+RDEVTERM+RDEVBACK) 00861000
SPACE 00862000
SPACE 2 00863000
PRTOPMSG LA R2,70 FUNCTION INDEX @V200930 00864000
BAL R6,SETMSG SETUP MESSAGE @V200930 00865000
CALL DMKQCNWT,PARM=OPERATOR+NORET @V200930 00866000
L R2,RSPRPAGE GET ADDRESS OF LOCKED BUFFER 00867000
TM RDEVFLAG,RDEVSEP PRINT OR PUNCH JOB SEPARATOR ?? 00868000
BO CALLSEP YES -- 00869000
TM RDEVTYPE,TYPPRT PRINTER ?? 00870000
BZ STARTPUN NO -- 00871000
TM SFBFLAG2,SFBRSTRT SYSTEM RESTART ?? 00872000
BO CALLSEP YES -- 00873000
TM RDEVFLAG,RDEVLOAD UCS VERIFIED ?? 00874000
BO PROCESS1 YES -- 00875000
CLI RDEVTYPE,TYP3800 IS IT A 3800 PRINTER ? @V60B9BA 00875300
BE PROCESS1 XFER IF SO @V60B9BA 00875600
SPACE 00876000
CALLSEP CALL DMKSEPSP CALL SEPARATOR ROUTINE 00877000
TM IOBSTAT,IOBFATAL FATAL I/O ERROR ?? 00878000
BZ PROCESS NO -- 00879000
CALLSEP2 BAL R5,RECHAIN RECHAIN FILE @V60B9BA 00880000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00880100
BAL R5,DRAINPRT DO EMERG DRAIN @VA09471 00881100
B PRTDRAN AND GIVE DRAIN MESSAGE 00882000
SPACE 00883000
PROCESS TM RDEVTYPE,TYPPRT PRINTER ?? 00884000
BO PROCESS1 YES -- 00885000
SPACE 3 00886000
STARTPUN EQU * HERE TO START THE PUNCH 00887000
TM RDEVFLAG,RDEVSEP GIVE START DEV MSG ?? 00888000
BO PCHHDR NO PUNCH HEADER 00889000
CALL DMKSCNRD GET DEV ADDRESS @V200930 00890000
CALL DMKCVTBH CONVERT TO HEX @V200930 00891000
STCM R1,7,STARTADR AND STORE IN OPERATOR MESSAGE 00892000
LA R1,STARTMSG POINT TO MESSAGE 00893000
LA R0,STARTMSZ GET SIZE OF MESSAGE 00894000
CALL DMKQCNWT,PARM=OPERATOR+ALARM+NORET HAVE OPERATOR START 00895000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00895100
* PUNCH 00896000
OI RDEVSTAT,RDEVNRDY INDICATE INTERVENTION REQUIRED 00897000
* FROM READY 00898000
B FRETIOB LEAVE - 00899000
SPACE 00900000
PCHHDR L R1,RSPRSTRT GET POINTER TO RSTRT CARD SAVEAREA 00901000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 00901100
NI RDEVSTAT,X'FF'-RDEVNRDY RESET INTERVENTION REQUIRED 00902000
L R7,RSPSFBLK ADDRESS OF SPOOL FILE BLOK 00903000
LTR R1,R1 IS THERE ONE YET? 00904000
BNZ PUNCHDR YES -- GO SET UP HEADER CARD 00905000
LA R0,12 GET CORE FOR A SAVEAREA 00906000
CALL DMKFREE -- 00907000
ST R1,RSPRSTRT AND SAVE IN RSPLCTL 00908000
PUNCHDR EQU * HERE TO SET UP THE PUNCH HEADER CARD 00909000
LM R3,R4,PUNCCWS PICK UP MODEL PUNCH CCWS 00910000
ALR R3,R1 ADJUST DATA ADDRESS OF PUNCH CCW 00911000
SR R5,R5 CLEAR TIC REG 00912000
* BUFFER 00913000
STM R3,R5,0(R1) SET PUNCH CCWS IN SAVEAREA 00914000
MVI 8(R1),8 SET UP TIC OP-CODE IN SAVEAREA 00915000
MVI 12(R1),C' ' BLANK OUT 00916000
MVC 13(79,R1),12(R1) THE PUNCH SAVEAREA 00917000
ST R5,92(,R1) -- 00918000
SPACE 3 00919000
MVC 12(6,R1),=C'USERID' MOVE IN KEYWORD 'USERID' 00920000
MVC 19(8,R1),SFBUSER MOVE IN USERID 00921000
ST R1,IOBRCAW SET UP IOBRCAW WITH POINTER TO 1ST 00922000
* CCW 00923000
MVC 28(5,R1),=C'CLASS' MOVE CLASS KEYWORD 00924000
MVC 34(1,R1),SFBCLAS MOVE CLASS IN 00925000
OI IOBFLAG,IOBRSTRT FAKE A RESTART TO PICK UP HEADER 00926000
CLI SFBFNAME,C' ' FILE NAME PRESENT ?? 00927000
BE PCHDATE NO -- FORGET KEYWORD 00928000
MVC 36(4,R1),=C'NAME' MOVE KEYWORD NAME 00929000
MVC 41(24,R1),SFBFNAME MOVE IN FILE NAME AND FILE TYPE 00930000
PCHDATE LA R1,70(,R1) POINT TO DATE FIELD 00931000
LA R2,10(,R1) POINT TO TIME FIELD 00932000
CALL DMKCVTDT AND FILL THEM IN 00933000
PROCESS1 EQU * 00934000
CLI RDEVTYPE,TYP3800 IS IT A 3800 ? @V60B9BA 00934050
BNE PROCESS2 XFER IF NOT @V60B9BA 00934100
CALL DMKTCSET SET UP THE 3800 @V60B9BA 00934150
BZ PROCESS3 TRANSFER IF EVERYTHING OK @VA10572 00934200
BM MSG428E SPOOL PAGING ERROR @VA12900 00934225
TM IOBSTAT,IOBFATAL WAS IT A HARDWARE ERROR ? @V60B9BA 00934250
BO CALLSEP2 DRAIN THE PRINTER @V60B9BA 00934300
TM RDEVFLAG,RDEVSEP SEPARATOR PRINTED? @VMI0080 00934350
BZ NOMKFM XFER IF NOT @VMI0080 00934400
NI IOBFLAG,X'FF'-IOBRSTRT RESET RESTART IN IOBLOK @VA10572 00934405
LH R5,SFBCOPY SAVE NUMBER OF COPIES @VMI0080 00934450
MVC SFBCOPY,=H'1' FORCE IT TO 1 @VMI0080 00934500
CALL DMKTCSCO DO THE 'MARK FORM' @VMI0080 00934550
STH R5,SFBCOPY RESTORE NUMBER OF COPIES @VMI0080 00934600
NOMKFM TM RDEVSTA2,RDEVPURG PURGE ON MODULE ERROR? @VMI0080 00934650
BO DELFILE2 XFER IF SO @V60B9BA 00934700
OI SFBFLAG,SFBUHOLD PUT FILE IN USER HOLD @V60B9BA 00934750
BAL R5,RECHAIN RECHAIN THE FILE @V60B9BA 00934800
B TSTDRAIN SEE IF PRINTER DRAINED @V60B9BA 00934850
PROCESS3 DS 0H @VA10572 00934855
NI IOBFLAG,X'FF'-IOBRSTRT RESET RESTART IN IOBLOK @VA10572 00934860
PROCESS2 OI RDEVSTA2,RDEVINTL PREVENT SFBLOK CHANGES @V60B9BA 00934900
NI RSPFLAG1,X'FF'-(RSPBF1IO+RSPBF2IO+RSPBF1VL+RSPBF2VL) X00934950
RESET THE I/O FLAGS @VA09263 00934975
SPACE 1 00935000
L R0,SFBSTART GET SPOOLING FILE START 00936000
L R1,RSPVPAGE GET ADDRESS OF VIRTUAL BUFFER 00937000
CALL DMKRPAGT,PARM=(BRING+SYSTEM+LOCK) 00938000
BNZ MSG428E SPOOL PAGING ERROR 00939000
NI RDEVSTA2,255-RDEVINTL NO LONGER NEEDED @VA05941 00939500
OI RSPFLAG1,RSPBF1VL MARK BFR 1 VALID @V60B9BA 00939750
BAL R6,NEXTBUFF GET 1ST BUFFER AND REC BLOCK 00940000
LA R1,SPSIZE(,R2) POINT TO 1ST CCW IN THE BUFFER 00941000
ST R1,IOBCAW AND SAVE AS NORMAL CAW 00942000
LA R15,1 INSERT A BACKSPACE 00943000
ST R15,RSPMISC COUNT OF 1 PAGE 00944000
TM RDEVTYPE,TYPPUN IS IT PUNCH ?? 00945000
BZ CKPREPAG NO -- 00946000
L R6,RSPRSTRT SET UP TIC ADDRESS 00947000
STCM R1,7,9(R6) TO POINT TO FIRST BUFFER 00948000
B CKPREPAG MAKE THIS IS FIRST PAGE 00949000
RDEVINTL EQU X'08' @VA05941 00949500
SPACE 3 00950000
NEXTBUFF EQU * FIND RECBLOK AND UPDATE 00951000
CL R1,RSPVPAGE ARE WE ON FIRST BUFFER? @V60B9BA 00951250
BE NXTBF1 XFER IF SO @V60B9BA 00951500
ST R2,RSPRPAG2 SAVE REAL ADDR IN BFR 2 @V60B9BA 00951750
ST R0,RSPDPAG2 SAVE DASD ADDR IN BFR 2 @V60B9BA 00952000
B NXTBF2 CONTINUE @V60B9BA 00952250
NXTBF1 ST R2,RSPRPAGE SAVE REAL PAGE ADDRESS @V60B9BA 00952500
ST R0,RSPDPAGE SAVE DASD PAGE ADDRESS 00953000
NXTBF2 SRL R0,16 GET CYLINDER NUMBER IN LOW HALFWORD 00954000
LA R1,SFBRECS POINT TO ALLOCATION STRING 00955000
USING RECBLOK,R1 00956000
TM SFBFLAG,SFBRECOK+SFBRECER ARE ALLOCATION RECORDS 00957000
* COMPLETE OR IN ERROR ?? 00958000
BCR 7,R6 YES - DO NOT PROCESS 00959000
SPACE 00960000
FINDBLOK LR R4,R1 SAVE BACKCHAIN POINTER 00961000
L R1,RECPNT POINT TO NEXT RECBLOK ON CHAIN 00962000
LTR R1,R1 IS THERE ONE ?? 00963000
BNZ TESTCYL YES -- SEE IF ITS FOR THIS CYLINDER 00964000
SPACE 00965000
LA R0,RECSIZE BUILD A NEW BLOK 00966000
CALL DMKFREE 00967000
ST R1,RECPNT-RECBLOK(,R4) CHAIN NEW BLOK 00968000
XC RECBLOK(RECSIZE*8),RECBLOK CLEAR TO ZEROES 00969000
L R0,RSPDPAGE GET CYLINDER NUMBER 00970000
C R2,RSPRPAGE IS IT THE FIRST BUFFER? @V60B9BA 00970250
BE *+8 XFER IF SO @V60B9BA 00970500
L R0,RSPDPAG2 WE WANT 2ND BFR DASD ADDR @V60B9BA 00970750
ST R0,RECCYL AND STORE IN BLOK 00971000
MVI RECUSED,X'00' ZERO OUT PAGE NUMBER 00972000
B SETREC AND GO MARK RECORD 00973000
SPACE 00974000
TESTCYL CH R0,RECCYL IS RECBLOK FOR THIS CYLINDER 00975000
BNE FINDBLOK NO -- KEEP LOOKING 00976000
C R2,RSPRPAGE IS IT THE FIRST BUFFER? @VMI0090 00976100
BNE TESTCYL2 XFER IF NOT @VMI0090 00976200
CLC RECCYL+3(1),RSPDPAGE+3 CORRECT DEVICE ?? 00977000
BNE FINDBLOK NO - KEEP LOOKING 00978000
B SETREC WE FOUND THE BLOCK @VMI0090 00978100
SPACE 00978200
TESTCYL2 CLC RECCYL+3(1),RSPDPAG2+3 CORRECT DEV FOR BFR 2? @VMI0090 00978300
BNE FINDBLOK NO -- KEEP LOOKING @VMI0090 00978400
SETREC EQU * FOUND THE BLOK -- 00979000
SR R14,R14 00980000
IC R14,RSPDPAGE+2 GET PAGE NUMBER 00981000
C R2,RSPRPAGE IS IT THE FIRST BUFFER ? @V60B9BA 00981250
BE *+8 XFER IF SO @V60B9BA 00981500
IC R14,RSPDPAG2+2 GET PAGE FROM BFR 2 @V60B9BA 00981750
BCTR R14,0 -1 00982000
SRDL R14,3 DIVIDE BY 8 00983000
SRL R15,29 AND SAVE THE REMAINDER 00984000
LA R14,RECMAP(R14) POINT TO BYTE TO UPDATE 00985000
IC R15,ALOCTABL(R15) AND GET BIT MASK 00986000
EX R15,TSTALLOC SEE IF PAGE ALREADY ALLOCATED @VA11232 00986100
BOR R6 YES, DON'T ALLOCATE AGAIN @VA11232 00986200
EX R15,ALOCATE MARK THE PAGE 00987000
IC R15,RECUSED GET NUMBER OF RECORDS FOUND 00988000
LA R15,1(,R15) INCREMENT 00989000
STC R15,RECUSED AND SAVE 00990000
BR R6 RETURN TO CALLER 00991000
SPACE 3 00992000
CKBKMSG EQU * 00993000
SPACE 00993200
* IF 'BACKSPACE EOF' WAS SPECIFIED, MAKE SFBLAST THE 00993400
* CURRENT BUFFER AND BACK UP FROM THERE. 00993600
SPACE 00993800
NI RSPFLAG1,X'FF'-(RSPBF1VL+RSPBF1IO+RSPBF2VL+RSPBF2IO) X00993850
TURN OFF BUFFER FLAGS @VA11068 00993870
LR R3,R2 SAVE BUFFER ADDRESS 00994000
LA R2,10 FUNCTION INDEX @V200930 00995000
BAL R6,SETMSG SETUP MESSAGE @V200930 00996000
CALL DMKQCNWT,PARM=OPERATOR+NORET @V200930 00997000
LR R2,R3 RESTORE BUFFER ADDRESS 00998000
L R3,RSPMISC SEE IF BACKSPAC EOF @V60B9BA 00998150
LTR R3,R3 IF SO, IT'S NEGATIVE @V60B9BA 00998300
BNM NOTBKEOF XFER IF NOT NEGATIVE @V60B9BA 00998450
LPR R3,R3 MAKE IT POSITIVE @V60B9BA 00998600
ST R3,RSPMISC STORE IT BACK @V60B9BA 00998750
SR R6,R6 ZERO DISPLACEMENT OF CCW @V60B9BA 00998900
CLC SFBSTART,SFBLAST ARE WE ON LAST PAGE NOW? @V60B9BA 00999050
BE CKBK2 XFER IF SO @V60B9BA 00999200
MVC SFBSTART,SFBLAST MAKE LAST PAGE CURRENT @V60B9BA 00999350
LR R3,R2 NON-ZERO VALUE IN R3 @V60B9BA 00999500
B REFPAGE START BACKING UP @V60B9BA 00999650
NOTBKEOF L R6,IOBCSW GET ADDRESS OF LAST CCW EXEC@V60B9BA 00999800
N R6,F4095 GET DISPLACEMENT INTO PAGE 01000000
CKBK2 L R3,SPPREPAG GET PREVIOUS PAGE BUFFER ADDRESS 01001000
B REFPAGE START WITH CURRENT PAGE 01002000
SPACE 2 01003000
CKPREPAG L R0,SPPREPAG GET PREVIOUS PAGE BUFFER ADDRESS 01004000
SR R6,R6 ZERO DISPLACEMENT OF LAST CCW 01005000
LTR R3,R0 WAS THERE ONE ?? 01006000
BZ BACKCOMP NO -- THIS IS FIRST PAGE 01007000
ST R0,SFBSTART SAVE NEW STARTING PAGE ADDRESS 01008000
REFPAGE L R1,RSPVPAGE GET VIRTUAL BUFFER ADDRESS 01009000
L R0,SFBSTART REFRESH R0 01010000
CALL DMKRPAGT,PARM=(BRING+SYSTEM+LOCK) 01011000
BNZ MSG428E SPOOL PAGING ERROR 01012000
ST R2,RSPRPAGE STORE REAL PAGE ADDRESS 01013000
ST R0,RSPDPAGE STORE DASD PAGE ADDRESS 01014000
LTR R3,R3 FIRST PAGE ?? 01015000
BZ BACKCOMP YES -- START PROCESSING 01016000
OI SFBFLAG,SFBRECER INDICATE ALLOCATE 01017000
* CHAIN INCOMPLETE 01018000
TM RDEVFLAG,RDEVRSTR RESTART REQUESTED? 01019000
BO CKPREPAG YES -- FIND FIRST PAGE OF FILE 01020000
TM RDEVTYPE,TYPPUN IS IT A PUNCH? 01021000
BO CKPREPAG YES -- RESTART FROM THE TOP 01022000
SR R3,R3 CLEAR SKIP COUNTER 01023000
SR R4,R4 SET DUMMY 01024000
BCTR R4,0 BACKSPACE COMPARE REGISTER 01025000
LTR R6,R6 LAST CCW ADDRESS PRESENT ?? 01026000
BZ *+6 NO -- 01027000
ALR R6,R2 ADD BUFFER ADDRESS TO DISPLACEMENT 01028000
LA R1,SPSIZE(,R2) POINT TO FIRST CCW 01029000
LR R15,R2 SET UP FOR TIC CHAIN TEST 01030000
A R15,F4095 POINT TO END OF BUFFER 01031000
L R0,SPRECNUM AND GET NUMBER OF CCWS IN BUFFER 01032000
CKSKIP1 EQU * HERE TO TRY TO RESTART AT THE TOP OF A PAGE 01033000
CLR R1,R2 CCW ADDRESS WITHIN BUFFER PAGE 01034000
BL MSG428D NO -- INVALID TIC CHAIN 01035000
CLR R1,R15 CCW ADDRESS WITHIN BUFFER PAGE 01036000
BNL MSG428D NO -- INVALID TIC CHAIN 01037000
LTR R6,R6 ARE WE CHECKING FOR PART OF PAGE 01038000
BZ TSTSKIP NO -- SKIP COMPARE 01039000
CLR R1,R6 HAVE WE REACH LAST CCW EXECUTED 01040000
BNL ZERO6 YES -- DONT SCAN THE REST OF BUFFER 01041000
TSTSKIP CLI 0(R1),X'89' IS IT A PRINT AND SKIP TO CHANNEL 01042000
* ONE? 01043000
BE CKBACKSP YES -- GO RESTART 01044000
CLI 0(R1),X'8B' IS IT AN IMMEDIATE SKIP TO ONE? 01045000
BE CKBACKSP YES -- 01046000
CKIMMED TM 4(R1),SKIP IS THIS RECORD IMMEDIATE ?? @V293598 01047000
BO ADD8 YES -- NEXT CCW IS ADJACENT @V293598 01048000
AH R1,10(R1) POINT TO NEXT CCW 01049000
B SKIP8 01050000
ADD8 LA R1,8(,R1) POINT TO NEXT CCW 01051000
SKIP8 BCT R0,CKSKIP1 AND KEEP LOOKING FOR A SKIP 01052000
SPACE 01053000
ZERO6 SR R6,R6 CHECK ONLY FIRST BUFFER 01054000
L R0,SPRECNUM RESTORE CCW COUNTER 01055000
S R3,RSPMISC SUBTRACT NUMBER OF PAGES REMAINING 01056000
* TO BACK UP 01057000
LTR R3,R3 ARE WE FINISHED YET ?? 01058000
BNM SETBACK YES -- ENOUGH SKIPS IN THIS BUFFER 01059000
LPR R3,R3 GET NUMBER OF ADDITIONAL SKIPS 01060000
* NEEDED 01061000
ST R3,RSPMISC AND SAVE IT 01062000
B CKPREPAG GO CONTINUE TO BACK UP 01063000
SPACE 2 01064000
SETBACK LA R1,SPSIZE(,R2) POINT TO 1ST CCW IN THE BUFFER 01065000
LR R4,R3 GET NUMBER OF SKIPS TO BYPASS 01066000
TM SFBFLAG2,SFBRSTRT+SFBREQUE FILE RESTARTED OR REQUEUED ? 01067000
BZ *+6 NO -- LEAVE COUNT AS IS 01068000
SR R4,R4 START AT FIRST SKIP ON PAGE 01069000
SR R3,R3 AND ZERO THE SKIP COUNTER 01070000
B CKSKIP1 GO FIND RESTART CCW 01071000
SPACE 3 01072000
CKBACKSP CR R3,R4 HAVE ENOUGH SKIPS BEEN BYPASSED ?? 01073000
BE SETCAW YES -- GO SET UP RESTART CAW 01074000
LA R3,1(,R3) ADD ONE TO NUMBER OF SKIPS 01075000
B CKIMMED AND GO TEST FOR CCW LENGTH 01076000
SPACE 2 01077000
SETCAW ST R1,IOBRCAW SET UP RESTART CAW 01078000
OI IOBFLAG,IOBRSTRT SET RESTART FLAG TO USE RESTART CAW 01079000
BACKCOMP EQU * @V4075A0 01080100
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01080200
NI RDEVFLAG,X'FF'-(RDEVBACK+RDEVRSTR) @V4075A0 01080300
* RESET BACKSPACE AND RESTART FLAG 01081000
NI SFBFLAG2,X'FF'-(SFBRSTRT+SFBREQUE) RESET FLAGS 01082000
OC RSPVPAG2,RSPVPAG2 DOUBLE BUFFERING ACTIVE? @VA11068 01082100
BZ *+8 NO @VA11068 01082200
OI RSPFLAG1,RSPBF1VL MARK BUFFER VALID @VA11068 01082300
B PRCCWS GO PROCESS BUFFER 01083000
SPACE 3 01084000
TYPERADD EQU * HERE TO GET DEVICE TYPE AND 01085000
* ADDRESS FOR ERROR MESSAGES 01086000
LA R0,5 LENGTH OF AREA FOR MESSAGE DATA @VA00701 01087000
CALL DMKFREE GET STORAGE 01088000
LR R3,R1 SAVE ADDRESS OF AREA 01089000
XC 0(40,R3),0(R3) CLEAR AREA @VA00701 01090000
MVC 0(3,R3),=C'RDR' SET TYPE FOR MESSAGE 01091000
MVC 8(6,R3),=C'PURGED' .. 01092000
TM RDEVTYPC,CLASURI READER TYPE ?? 01093000
BO RADDR YES -- 01094000
MVC 8(6,R3),=C'HELD ' .. 01095000
MVC 0(3,R3),=C'PRT' .. 01096000
TM RDEVTYPE,TYPPRT PRINTER TYPE ?? 01097000
BO RADDR YES -- 01098000
MVC 0(3,R3),=C'PUN' .. 01099000
RADDR LH R1,IOBRADD GET DEVICE ADDRESS 01100000
CALL DMKCVTBH AND CONVERT 01101000
STCM R1,B'0111',4(R3) MOVE ADDRESS TO MESSAGE AREA 01102000
LA R0,4 LENGTH OF DATA 01103000
LA R1,4(R3) ADDRESS OF DEVICE ADDRESS DATA 01104000
BR R5 RETURN TO CALLER 01105000
SPACE 3 01106000
RSPMSG EQU * HERE TO CALL DMKERMSG TO WRITE ERROR MSG 01107000
ICM R0,B'1110',ID+3 INSERT MODEULE ID 01108000
O R2,=X'B0000000' INDICATE RETURN, ALARM 01109000
* AND OPERATOR 01110000
STM R0,R1,32(R3) SAVE PARM R0 AND R1 @VA00701 01111000
LA R0,CPEXSIZE LENGTH OF CPEXBLOK @VA00701 01112000
CALL DMKFREE GET STORAGE @VA00701 01113000
USING CPEXBLOK,R1 @VA00701 01114000
XC CPEXBLOK(CPEXSIZE*8),CPEXBLOK CLEAR BLOK @VA00701 01115000
BAL R15,MSGSTK SET UP ENTRY POINT AND STACK @VA00701 01116000
LM R0,R1,32(R3) RESTORE R0 AND R1 @VA00701 01117000
CALL DMKERMSG CALL MESSAGE WRITER @VA00701 01118000
LA R0,5 LENGTH OF DATA AREA @VA00701 01119000
LR R1,R3 ADDRESS OF DATA AREA @VA00701 01120000
CALL DMKFRET RETURN STORAGE @VA00701 01121000
GOTO DMKDSPCH AND EXIT @VA00701 01122000
SPACE 01123000
MSGSTK STM R15,R13,CPEXADD SAVE REGS AND ENTRY POINT @VA00701 01124000
CALL DMKSTKCP STACK CPEXBLOK @VA00701 01125000
BR R5 @VA00701 01126000
SPACE 3 01127000
EJECT 01128000
*. 01129000
* 01130000
* DMKRSPUR - FORMAT ACTIVE FILE MESSAGE 01131000
* 01132000
* 1. SET BASE REGS FOR MODULE DMKRSP 01133000
* 2. SET FUNCTION INDEX FOR DEVICE TYPE 01134000
* 3. USE SUBROUTINE SETMSG TO FORMAT MESSAGE 01135000
* 4. SET RETURN REGS R0 AND R1 01136000
* 5. EXIT TO CALLER 01137000
* 01138000
*. 01139000
SPACE 2 01140000
USING SAVEAREA,R13 @V200930 01141000
USING *,R12 @V200930 01142000
DMKRSPUR ENTER SAVE REGS @V200930 01143000
LR R10,R13 SAVE SAVEARAE ADDRESS @V200930 01144000
L R12,=A(DMKRSP) SET R12 BASE @V200930 01145000
USING DMKRSP,R12 @V200930 01146000
LR R13,R12 SET R13 BASE @V200930 01147000
A R13,F4096 SET BASE @V200930 01148000
USING DMKRSP+4096,R13 @V200930 01149000
LA R2,60 SET FUNCTION INDEX @V200930 01150000
TM RDEVTYPC,CLASURI IS IT A READER ?? @V200930 01151000
BO MSGA YES, CONT @V200930 01152000
LA R2,40 SET FUNCTION INDEX @V200930 01153000
TM RDEVTYPE,TYPPRT IS IT A PRINTER ?? @V200930 01154000
BO *+8 YES, CONT @V200930 01155000
LA R2,50 SET FUNCTION INDEX @V200930 01156000
MSGA BAL R6,SETMSG FORMAT MESSAGE @V200930 01157000
LR R13,R10 RESTORE SAVEARAE ADDRESS @V200930 01158000
USING SAVEAREA,R13 @V200930 01159000
STM R0,R1,SAVER0 RETURN VALUES @V200930 01160000
EXIT RETURN TO CALLER @V200930 01161000
USING DMKRSP+4096,R13 BASE ADDRESSING @V200930 01162000
SPACE 3 01163000
SETMSG CALL DMKSCNRN GET DEVICE NAME @V200930 01164000
STCM R1,15,MSGDEV SET NAME @V200930 01165000
CALL DMKSCNRD GET DEVICE ADDRESS @V200930 01166000
CALL DMKCVTBH CONVERT TO HEX @V200930 01167000
STCM R1,7,MSGADR SET DEV ADDRESS @V200930 01168000
LA R2,MSGLIST(R2) PICK UP FUNCTION BY INDEX IN R2 @V200930 01169000
MVC MSGCONS(10),0(R2) SET FUNCTION @V200930 01170000
MVC MSGUSR(8),SFBUSER SET USERID @V200930 01171000
LH R1,SFBFILID GET SPOOL FILE ID @V200930 01172000
CALL DMKCVTBD CONVERT TO DEC @V200930 01173000
STCM R1,15,MSGFILE SET FILE NUMBER @V200930 01174000
LA R0,MSGSIZ1 SET RDR SIZE @V200930 01175000
TM RDEVTYPC,CLASURI IS IT A READER ?? @V200930 01176000
BO MSGEND YES, DONE @V200930 01177000
L R1,SFBRECNO GET RECORD COUNT @V200930 01178000
CALL DMKCVTBD CONVERT TO DEC @V200930 01179000
STCM R0,3,MSGRECS SET RECORD COUNT @V200930 01180000
STCM R1,15,MSGRECS+2 .. @V200930 01181000
LH R1,SFBCOPY GET COPY COUNT @V200930 01182000
CALL DMKCVTBD CONVERT TO DEC @V200930 01183000
STCM R1,3,MSGCNT SET COUNT @V200930 01184000
MVC MSGCLS(1),SFBCLAS SET FILE CLASS @V200930 01185000
MVC MSGCLS+2(3),=C'CON' SET FILE TYPE @V200930 01186000
CLI SFBTYPE,TYPPRT IS IT CON ?? @V200930 01187000
BE SETMSGL YES @V200930 01188000
MVC MSGCLS+2(3),=C'RDR' SET RDR TYPE @V200930 01189000
CLI SFBTYPE,TYPRDR IS IT RDR ?? @V200930 01190000
BE SETMSGL YES @V200930 01191000
MVC MSGCLS+2(3),=C'PRT' SET PRT TYPE @V200930 01192000
TM SFBTYPE,TYPPRT IS IT PRT ?? @V200930 01193000
BO SETMSGL YES @V200930 01194000
MVC MSGCLS+2(3),=C'PUN' SET PUNCH TYPE @V200930 01195000
SETMSGL LA R0,MSGL SET SIZE @V200930 01196000
MSGEND LA R1,MSG1 SET NESSAGE ADDRESS @V200930 01197000
BR R6 RETURN TO CALLER @V200930 01198000
SPACE 3 01199000
SPACE 3 01200000
SPACE 3 01201000
STARTMSG EQU * ALIGN PUNCH START MESSAGE 01202000
DC C'PUN ' 01203000
STARTADR DC C' ' SPACE FOR DEVICE ADDRESS 01204000
DC C' START FOR OUTPUT' 01205000
STARTMSZ EQU *-STARTMSG LENGTH OF MESSAGE 01206000
SPACE 01207000
DS 0H 01208000
EJECT 01209000
PRNXTPAG EQU * HERE GET THE NEXT SPOOLING PAGE BUFFER FOR A FILE 01210000
ICM R9,B'1111',RDEVSPL ACTIVE FILE ???? @VA00701 01211000
BZ RSPLEXIT NO - EXIT CAREFULLY 01212000
L R7,RSPSFBLK AND POINTER TO SPOOL FILE BLOK 01213000
L R2,RSPRPAGE GET ADDRESS OF REAL PAGE BUFFER 01214000
TM IOBSTAT,IOBFATAL FATAL IO ERROR ? 01215000
BO MSG430A YES - SAVE FILE 01216000
ICM R15,B'1111',IOBCAW UNSOLICITED AND CE INTERRUPT @VA01299 01217000
BZ FRETIOB YES - FRET IOB AND EXIT @VA01299 01218000
ICM R15,B'0111',IOBCSW+1 CCW ADDRESS ZERO ? @VA01299 01219000
BZ MSG430A YES - INVALID CSW - ERROR @VA01299 01220000
OC RSPVPAG2,RSPVPAG2 DOUBLE BUFFERING ACTIVE? @V60B9BA 01220250
BZ NODOUBL1 XFER IF NOT @V60B9BA 01220500
TM RSPFLAG1,RSPBF1IO INTERRUPT FROM BFR 1 ? @V60B9BA 01220750
BO NODOUBL1 XFER IF SO @V60B9BA 01221000
L R2,RSPRPAG2 WE WANT THE SECOND BUFFER @V60B9BA 01221250
NODOUBL1 TM RDEVTYPE,TYPPRT IS THIS A PRINTER? @V60B9BA 01221500
BO CKRESTRT YES -- TEST FOR UNIT EXCEPTION 01222000
TM RDEVFLAG,RDEVRSTR+RDEVBACK+RDEVTERM FLUSH OR BACKSPACE? 01223000
BNZ CKRESTRT YES--TEST WHICH 01224000
L R1,RSPRSTRT GET POINTER TO LAST CARD SAVEAREA 01225000
L R3,IOBCSW AND ADDRESS+8 OF LAST CCW EXECUTED 01226000
SH R3,=H'12' POINT TO DATA AREA OF LAST CARD 01227000
LTR R3,R3 ADDRESS ZERO ?? 01228000
BNP CKRESTRT YES - USE SAME INFORMATION 01229000
L R3,0(R3) PUNCHED 01230000
LTR R3,R3 ANY LAST RECORD ?? 01231000
BNP CKRESTRT NO - 01232000
L R3,8(R3) PICK UP TIC ADDRESS 01233000
LA R3,0(R3) CLEAR TIC OP CODE 01234000
LH R14,6(R3) CCW DATA COUNT 01235000
MVI 12(R1),C' ' CLEAR DATA AREA 01236000
MVC 13(79,R1),12(R1) 01237000
BCTR R14,0 - 1 FOR MOVE 01238000
EX R14,MVCPCH MOVE DATA TO LAST CARD SAVE 01239000
SPACE 3 01240000
CKRESTRT EQU * HERE TO TEST FOR FLUSH, RESTART 01241000
OC RSPVPAG2,RSPVPAG2 DOUBLE BUFFERING ACTIVE? @VMI0035 01241060
BZ DORSTRT XFER IF NOT @VMI0035 01241120
SPACE 01241180
* SEE IF RESTART HAS BEEN INDICATED 01241240
SPACE 01241300
TM RSPFLAG1,RSPBF1VL HAS IT BEEN TURNED OFF? @VMI0035 01241360
BO TRYBFR2 TRY FOR BUFFER 2 IF NOT @VMI0035 01241420
TM RSPFLAG1,RSPBF1IO IS THIS ON? @VMI0035 01241480
BO DORSTRT IF SO, THEN TRY RESTART @VMI0035 01241540
TRYBFR2 TM RSPFLAG1,RSPBF2VL HAS IT BEEN TURNED OFF? @VMI0035 01241600
BO NORSTRT IF NOT, NO RESTART INDICATED@VMI0035 01241660
TM RSPFLAG1,RSPBF2IO THIS MUST ALSO BE ON @VMI0035 01241720
BZ NORSTRT IF NOT, NO RESTART @VMI0035 01241780
DORSTRT DS 0H @VMI0035 01241840
TM RDEVFLAG,RDEVTERM FLUSH COMMAND ?? 01242000
BO PRTERM YES -- FLUSH CURRENT FILE 01243000
TM RDEVFLAG,RDEVRSTR+RDEVBACK BACKSPACE COMMAND ?? 01244000
BNZ CKBKMSG YES -- GO START BACKING UP 01245000
NORSTRT TM IOBCSW+4,UE UNIT EXCEPTION ?? @VMI0035 01246000
BO UNITEX YES -- 01247000
L R0,SPNXTPAG GET POINTER TO NEXT PAGE BUFFER 01248000
ST R0,SFBSTART AND SAVE IN SFBLOK 01249000
OC RSPVPAG2,RSPVPAG2 DOUBLE BUFFERING ACTIVE? @V60B9BA 01249070
BZ NODOUBL2 XFER IF NOT @V60B9BA 01249140
C R2,RSPRPAGE IS IT BUFFER 1 ? @V60B9BA 01249210
BNE DBLBFR2 XFER IF NOT @V60B9BA 01249280
DBLBFR1 NI RSPFLAG1,X'FF'-(RSPBF1IO+RSPBF1VL) RESET FLAGS @V60B9BA 01249350
CLC RSPDPAGE,SFBLAST FINISHED WITH FILE? @V60B9BA 01249420
BE PRENDFIL XFER IF SO @V60B9BA 01249490
TM RSPFLAG1,RSPBF2VL BFR 2 VALID? @V60B9BA 01249560
BZ RSPLEXIT EXIT IF NOT @V60B9BA 01249630
L R2,RSPRPAG2 REAL ADDR OF BFR 2 @V60B9BA 01249700
LA R1,SPSIZE(,R2) ADDR OF FIRST CCW @V60B9BA 01249770
ST R1,IOBCAW PUT IT IN THE IOB @V60B9BA 01249840
B BFR2SIO START THE I/O ON BFR 2 @V60B9BA 01249910
SPACE 01249980
DBLBFR2 NI RSPFLAG1,X'FF'-(RSPBF2IO+RSPBF2VL) RESET FLAGS @V60B9BA 01250050
CLC RSPDPAG2,SFBLAST FINISHED WITH FILE? @V60B9BA 01250120
BE PRENDFIL XFER IF SO @V60B9BA 01250190
TM RSPFLAG1,RSPBF1VL BUFFER 1 VALID? @V60B9BA 01250260
BZ RSPLEXIT EXIT IF NOT @V60B9BA 01250330
L R2,RSPRPAGE REAL ADDR OF BFR 1 @V60B9BA 01250400
LA R1,SPSIZE(,R2) ADDR OF FIRST CCW @V60B9BA 01250470
ST R1,IOBCAW SAVE IT IN THE IOB @V60B9BA 01250540
B BFR1SIO START I/O ON BUFFER 1 @V60B9BA 01250610
SPACE 2 01250680
NODOUBL2 CLC RSPDPAGE,SFBLAST FINISHED WITH FILE? @V60B9BA 01250750
BE PRENDFIL YES -- 01251000
ST R0,RSPDPAGE SAVE NEW PAGE ADDRESS 01252000
L R1,RSPVPAGE GET VIRTUAL BUFFER ADDRESS 01253000
CALL DMKRPAGT,PARM=(BRING+SYSTEM+LOCK) 01254000
BNZ MSG428E SPOOL PAGING ERROR 01255000
BAL R6,NEXTBUFF ALL BUFFERS EXCEPT FIRST 01256000
PRCCWS EQU * HERE TO ADJUST PRINTER/PUNCH CCWS 01257000
L R14,SPRECNUM GET NUMBER OF CCWS IN BUFFER 01258000
LA R1,SPSIZE(,R2) POINT TO 1ST CCW IN BUFFER 01259000
LR R15,R2 SET UP FOR VALID ADDRESS TEST 01260000
A R15,F4095 POINT TO END OF BUFFER 01261000
OC RSPVPAG2,RSPVPAG2 DOUBLE BUFFERING ACTIVE? @VA09263 01261100
BNZ PRCCWS2 XFER IF SO @VA09263 01261200
ST R1,IOBCAW ADDRESS OF CHANNEL PROGRAM 01262000
PRCCWS2 TM RDEVTYPE,TYPPUN IS IT A PUNCH? @VA09263 01263000
BZ SPACTEST NO -- GO TEST FOR FORCED SPACING 01264000
L R6,RSPRSTRT POINT TO SAVED CARD FROM LAST BUFFER 01265000
STCM R1,B'0111',9(R6) UPDATE TIC ADDRESS 01266000
B GETCCWS AND CONTINUE WITH THE BUFFER 01267000
SPACE 2 01268000
SPACE 2 01269000
SPACTEST CLR R1,R2 CCW ADDRESS BELOW BUFFER ?? 01270000
BL MSG428D YES -- INVALID DATA IN BUFFER 01271000
CLR R1,R15 CCW ADDRESS ABOVE BUFFER ?? 01272000
BNL MSG428D YES -- INVALID DATA IN BUFFER 01273000
TM RDEVFLAG,RDEVSPAC FORCE SINGLE SPACING ?? 01274000
BZ NORMAL NO -- NORMAL CARRIAGE CONTROL 01275000
TM 0(R1),X'80' SKIP COMMAND ?? 01276000
BZ NORMAL NO -- 01277000
NI 0(R1),X'0B' TURN OFF CHANNEL SKIP BITS 01278000
OI 0(R1),X'08' FORCE SPACING 01279000
NORMAL TM 4(R1),SKIP IS THIS RECORD IMMEDIATE ?? @V293598 01280000
BO IMMEDOP YES -- 01281000
GETCCWS LM R3,R5,0(R1) PICK UP CCWS IN BUFFER 01282000
ALR R3,R1 RELOCATE DATA ADDRESS 01283000
ALR R5,R1 RELOCATE TIC ADDRESS 01284000
STM R3,R5,0(R1) AND REPLACE IN THE BUFFER 01285000
TM RDEVTYPE,TYPPUN IS IT A PUNCH? 01286000
BZ SAVEPT NO -- NO BACK CHAIN NEEDED 01287000
LA R4,0(R5) POINT TO END OF RECORD -4 01288000
SH R4,=H'4' 01289000
CLR R4,R1 BELOW START OF RECORD ?? @VA02778 01290000
BL MSG428D YES -- PRINT MESSAGE @VA02778 01291000
CLM R15,B'0111',9(R1) TIC ADDRESS WITHIN PAGE ?? @VA02778 01292000
BNH MSG428D NO -- PRINT MESSAGE @VA02778 01293000
ST R6,0(R4) SAVE POINTER TO PREVIOUS RECORD 01294000
* FOR RESTART 01295000
SAVEPT LA R6,0(R1) SAVE POINTER TO THIS RECORD 01296000
LA R1,0(R5) ADJUST TO NEXT CCW BY TIC ADDRESS 01297000
CKNEXT BCT R14,SPACTEST AND CONTINUE THRU THE BUFFER 01298000
CLR R1,R2 ADDRESS BELOW BUFFER ??? @VA06118 01298100
BL MSG428D YES, SEND MESSAGE @VA06118 01298200
CLR R1,R15 ADDRESS ABOVE BUFFER ??? @VA06118 01298300
BNL MSG428D YES, SEND MESSAGE @VA06118 01298400
MVC 0(8,R1),SENSECCW FINISH OFF THE PROGRAM WITH A PHONY 01299000
OC RSPVPAG2,RSPVPAG2 DBL BUFFERING ACTIVE? @V60B9BA 01299030
BZ NODOUBL3 XFER IF NOT @V60B9BA 01299060
SPACE 01299090
CL R2,RSPRPAGE FILLING FIRST BFR? @V60B9BA 01299120
BNE BFR2FILL XFER IF NOT @V60B9BA 01299150
BFR1FILL TM RSPFLAG1,RSPBF2IO IO PENDING ON BFR 2? @V60B9BA 01299180
BO RSPLEXIT EXIT IF SO @V60B9BA 01299210
BFR1SIO ST R12,IOBIRA STORE INT RETURN ADDR @V60B9BA 01299240
L R2,RSPRPAGE GET THE DASD BUFFER ADDRESS @VA09263 01299247
LA R1,SPSIZE(,R2) POINT TO FIRST CCW @VA09263 01299253
ST R1,IOBCAW ADDRESS OF CHANNEL PROGRAM @VA09263 01299259
NI IOBSTAT,X'FF'-IOBFATAL RESET FATAL FLAG @V60B9BA 01299270
OI RSPFLAG1,RSPBF1IO SET BFR 1 I/O PENDING @V60B9BA 01299300
CALL DMKIOSQR START THE I/O GOING @V60B9BA 01299330
CLC RSPDPAGE,SFBLAST IS THIS THE LAST @V60B9BA 01299360
BE RSPLEXIT EXIT IF SO @V60B9BA 01299390
TM RDEVFLAG,RDEVTERM+RDEVBACK+RDEVRSTR @VMI0035 01299420
* FLUSH OR BACKSPAC COMMAND? 01299450
BZ BFR1SIO2 XFER IF NOT @VMI0035 01299480
NI RSPFLAG1,X'FF'-RSPBF1VL RESET - INDICATE RESTART@VMI0035 01299510
B RSPLEXIT WAIT FOR INTERRUPT @VMI0035 01299540
BFR1SIO2 L R0,SPNXTPAG GET NEXT DASD BUFFER @VMI0035 01299570
ST R0,SFBSTART SAVE ITS DASD ADDRESS @V60B9BA 01299600
ST R0,RSPDPAG2 SAVE IT THERE ALSO @V60B9BA 01299630
L R1,RSPVPAG2 LET'S BRING IN BFR 2 @V60B9BA 01299660
CALL DMKRPAGT,PARM=(BRING+SYSTEM+LOCK) BRING IT IN @V60B9BA 01299690
BNZ MSG428E PAGING ERROR @V60B9BA 01299720
OI RSPFLAG1,RSPBF2VL BFR 2 NOW VALID @V60B9BA 01299750
BAL R6,NEXTBUFF SET UP ALLOC RECDS @V60B9BA 01299780
B PRCCWS NOW ADJUST CCWS IN BFR 2 @V60B9BA 01299810
SPACE 01299840
BFR2FILL TM RSPFLAG1,RSPBF1IO IO PENDING ON BFR 1 ? @V60B9BA 01299870
BO RSPLEXIT EXIT IF SO @V60B9BA 01299900
BFR2SIO ST R12,IOBIRA SET INT RETURN ADDR @V60B9BA 01299930
L R2,RSPRPAG2 GET THE DASD BUFFER ADDRESS @VA09263 01299937
LA R1,SPSIZE(,R2) POINT TO FIRST CCW @VA09263 01299943
ST R1,IOBCAW ADDRESS OF CHANNEL PROGRAM @VA09263 01299949
NI IOBSTAT,X'FF'-IOBFATAL RESET FATAL FLAG @V60B9BA 01299960
OI RSPFLAG1,RSPBF2IO SET BFR 2 IO PENDING @V60B9BA 01299990
CALL DMKIOSQR START THE IO GOING @V60B9BA 01300020
CLC RSPDPAG2,SFBLAST IS THIS THE LAST? @V60B9BA 01300050
BE RSPLEXIT EXIT IF SO @V60B9BA 01300080
TM RDEVFLAG,RDEVTERM+RDEVBACK+RDEVRSTR @VMI0035 01300110
* FLUSH OR BACKSPAC COMMAND? 01300140
BZ BFR2SIO2 XFER IF NOT @VMI0035 01300170
NI RSPFLAG1,X'FF'-RSPBF2VL RESET - INDICATE RESTART@VMI0035 01300200
B RSPLEXIT WAIT FOR INTERRUPT @VMI0035 01300230
BFR2SIO2 L R0,SPNXTPAG GET NEXT DASD BUFFER @VMI0035 01300260
ST R0,SFBSTART AND SAVE IN SFBLOK @V60B9BA 01300290
ST R0,RSPDPAGE GET SET TO BRING IT INTO @V60B9BA 01300320
L R1,RSPVPAGE ... BUFFER 1 @V60B9BA 01300350
CALL DMKRPAGT,PARM=(BRING+SYSTEM+LOCK) BRING IT IN @V60B9BA 01300380
BNZ MSG428E PAGING ERROR @V60B9BA 01300410
OI RSPFLAG1,RSPBF1VL MARK BFR 1 AS VALID @V60B9BA 01300440
BAL R6,NEXTBUFF SET UP ALLOC RECDS @V60B9BA 01300470
B PRCCWS NOW ADJUST CCWS IN BFR 1 @V60B9BA 01300500
SPACE 2 01300530
NODOUBL3 ST R12,IOBIRA STORE INTERRUPT RETURN ADDRESS 01300560
* SENSE TO FORCE CE+DE TOGETHER 01301000
NI IOBSTAT,X'FF'-IOBFATAL RESET FATAL FLAG 01302000
B SIO AND GO DO START IO 01303000
SPACE 01304000
IMMEDOP LA R1,8(R1) POINT TO NEXT CCW 01305000
B CKNEXT 01306000
SPACE 01307000
SPACE 3 01308000
PRTERM EQU * HERE TO TERMINATE PRINTER AND PUNCH OUTPUT FILES 01309000
LA R2,20 SET FUNCTION INDEX @V200930 01310000
BAL R6,SETMSG FORMAT MESSAGE @V200930 01311000
CALL DMKQCNWT,PARM=OPERATOR+NORET @V200930 01312000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01312100
OI SFBFLAG,SFBRECER SET ALLOCATION RECORD IN-COMPLETE 01313000
L R2,RSPRPAGE RESTORE ADDRESS OF RDEVBLOK 01314000
TM RDEVSTAT,RDEVNRDY NOT READY FLAG SET ?? 01315000
BO PRTEOF YES -- FORGET TERM MESSAGE 01316000
TM RDEVTYPE,TYPPUN IS IT A PUNCH FILE ?? 01317000
BO PCHBLK YES -- PUNCH BLANK CARD 01318000
NI RDEVFLAG,X'FF'-RDEVTERM RESET FLUSH FLAG 01319000
LA R1,TERMIRA GET NEW IRA FOR TERMINATE MESSAGE 01320000
ST R1,IOBIRA AND STORE IN IOBLOK 01321000
ST R8,IOBMISC SAVE ADDRESS OF RDEVBLOK 01322000
LA R1,SPSIZE(,R2) POINT TO FIRST CCW 01323000
LM R3,R6,TERMCCW1 LOAD 1ST TWO CCWS 01324000
ALR R5,R1 UPDATE DATA ADDRESS 01325000
STM R3,R6,0(R1) STORE IN BUFFER 01326000
LM R3,R6,TERMCCW2 LOAD NEXT TWO CCWS 01327000
ALR R3,R1 UPDATE DATA ADDRESSES 01328000
ALR R5,R1 01329000
STM R3,R6,16(R1) STORE CCWS NEXT IN BUFFER 01330000
MVC 32(8,R1),TERMCCW3 MOVE IN SENSE CCW 01331000
MVI 40(R1),C'*' FILL THE BUFFER WITH * 01332000
MVC 41(238,R1),40(R1) 01333000
MVI 172(R1),C' ' CLEAR SPOT FOR MSG 01334000
MVC 173(81,R1),172(R1) 01335000
MVC 198(29,R1),=C'OUTPUT TERMINATED BY OPERATOR' 01336000
TERMSIO ST R1,IOBCAW SAVE IN NORMAL CAW 01337000
B SIO GO PRINT TERMINATE MESSAGE 01338000
DROP R12,R13 @VA08952 01338500
SPACE 3 01339000
TERMIRA EQU * HERE ON INTERRUPT FOR TERM MSG 01340000
USING *,R12 TEMPORARY ADDRESSABILITY 01341000
S R12,TERMDSP STANDARD 01342000
USING DMKRSP,R12,R13 @VA08952 01343100
LR R13,R12 .. 01344000
A R13,F4096 .. 2ND BASE REGISTER 01345000
L R8,IOBMISC RESTORE ADDRESS OF RDEVBLOK 01346000
L R9,RDEVSPL RESTORE ADDRESS OF RSPLCTL WORKAREA 01347000
L R7,RSPSFBLK RESTORE ADDRESS OF SFBLOK 01348000
TM IOBCSW+4,UE UNIT EXCEPTION ?? 01349000
BZ PRTEOF NO -- 01350000
L R1,IOBCSW GET ADDRESS OF NEXT CCW 01351000
LA R1,0(R1) .. 01352000
B TERMSIO FINISH PROCESSING 01353000
SPACE 3 01354000
TERMDSP DC A(TERMIRA-DMKRSP) DISPLACEMENT 01355000
SPACE 2 01356000
ALOCATE OI 0(R14),0 EXECUTED TO MARK PAGE AS ALLOCATED 01357000
TSTALLOC TM 0(R14),0 TEST IS PAGE ALLOCATED @VA11232 01357100
SPACE 01358000
ALOCTABL DC X'8040201008040201' BIT MASKS FOR ALLOCATION 01359000
SPACE 3 01360000
TERMCCW1 CCW X'1B',*-*,CC+SILI,1 SPACE 3 @VA09992 01361200
CCW X'09',40,CC+SILI,132 PRINT AND SPACE 1 01362000
TERMCCW2 CCW X'09',147,CC+SILI,132 PRINT AND SPACE 1 01363000
CCW X'09',40,CC+SILI,132 01364000
TERMCCW3 CCW X'04',*-*,SKIP+SILI,1 PHONY SENSE 01365000
SPACE 2 01366000
MVCPCH MVC 12(0,R1),12(R3) MOVE DATA SAVEAREA 01367000
EJECT 01368000
DS 0H 01369000
MSG428D EQU * HERE IF TIC CHAIN IN BUFFER IS INVALID 01370000
OI SFBFLAG2,SFBTICER SET TIC ERROR FLAG 01371000
MSG428E EQU * HERE FOR SPOOL PAGING ERROR 01372000
NI RDEVSTA2,255-RDEVINTL NO LONGER NEEDED @VA05941 01372500
OI SFBFLAG,SFBSHOLD SET FILE IN SYSTEM HOLD 01373000
BAL R5,RECHAIN RECHAIN FILE 01374000
BAL R5,TYPERADD GET TYPE AND ADDRESS FOR ERROR MSG 01375000
LA R2,428 ERROR MSG DMKRSP428E 01376000
LA R0,16 SET LENGTH TO 16 01377000
LR R1,R3 AND ADDRESS TO TYPE DATA 01378000
BAL R5,RSPMSG WRITE ERROR MSG 01379000
B PRNXTFIL GO START NEXT FILE 01380000
SPACE 01381000
MSG430A EQU * HERE ON FATAL I/O ERROR 01382000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01382100
OI RDEVSTAT,RDEVDISA SET DEVICE OFFLINE 01383000
BAL R5,DRAINPRT DO EMERG DRAIN @VA09471 01384100
LTR R7,R7 SFBLOK PRESENT ? @VA01299 01385000
BZ TYPE430A NO - SKIP CHAIN ROUTINE @VA01299 01386000
OI SFBFLAG,SFBSHOLD SET FILE IN SYSTEM HOLD STATUS 01387000
MVC SFBSTART,SFBPNT RESTORE FIRST DASD BUFFER @V60B9BA 01387500
BAL R5,RECHAIN RECHAIN THE FILE 01388000
TYPE430A BAL R5,TYPERADD GET TYPE AND ADDRESS @VA01299 01389000
LA R2,430 ERROR MSG DMKRSP430A 01390000
ICM R2,B'0100',=C'A' ACTION CODE 01391000
AR R0,R0 LENGTH OF 8 FOR DATA 01392000
LR R1,R3 ADDRESS OF TYPE 01393000
BAL R5,RSPMSG WRITE ERROR MSG 01394000
B PRTIDLE GO FREE UP BUFFERS 01395000
SPACE 3 01396000
RECHAIN LA R1,DMKRSPPR POINT TO START OF PRINTER FILE CHAIN 01397000
OI SFBFLAG,SFBRECER INDICATE ALLOCATION INCOMPLETE 01398000
TM RDEVTYPE,TYPPRT IS IT IN FACT A PRINTER?? 01399000
BO *+8 YES -- 01400000
LA R1,DMKRSPPU POINT TO START OF PUNCH CAHIN 01401000
L R2,0(,R1) SAVE POINTER TO FIRST ON CHAIN 01402000
ST R7,0(,R1) RE-CHAIN INTERRUPTED FILE 01403000
ST R2,SFBPNT AND CHAIN OTHER FILE BEHIND IT 01404000
* THE CALL TO DMKCKSPL HAS BEEN MOVED FROM ROUTINE SAVEFILE 01404100
* SO THAT SYSTEM HOLD AND USER HOLD STATUS SET HERE IN DMKRSP 01404200
* AS A RESULT OF SOME KIND OF ERROR IN PRINTING THESE FILES 01404300
* WILL BE CHECKPOINTED. NOTE: SAVEFILE ALWAYS COMES HERE. 01404400
CALL DMKCKSPL,PARM=CHGSFB CHECKPOINT @VA11799 01404500
TM RDEVFLAG,RDEVDRAN DEVICE BEING DRAINED ?? 01405000
BCR 8,R5 BZ - YES RETURN 01406000
TM SFBFLAG,SFBSHOLD+SFBUHOLD FILE TO BE SAVED ?? 01407000
BCR 7,R5 BNZ - YES 01408000
LR R2,R5 SAVE RETURN ADDRESS 01409000
IC R5,RDEVTYPE GET DEVICE TYPE FOR START COMMAND 01410000
CALL DMKCSOSD START FILE ON A AN OTHER DEVICE 01411000
BR R2 RETURN TO CALLER 01412000
SPACE 3 01413000
PRENDFIL EQU * HERE ON END OF FILE FOR PRINTER/PUNCH 01414000
ST R0,SFBPNT SAVE STARTING CCPD FOR REPEAT (HOLD) 01415000
* AND FLUSH (HOLD) 01416000
L R6,SPRMISC LOOK FOR NON-ZERO START CCPD @VA11232 01416200
LTR R6,R6 HAS SFBSTART BEEN SAVED THERE @VA11232 01416400
BZ PCHTST NO, USE VALUE IN SPNXTPAG @VA11232 01416600
ST R6,SFBPNT USE START CCPD @VA11232 01416800
PCHTST TM RDEVTYPE,TYPPUN PUNCH DEVICE @VA11232 01417000
BZ PRTEOF NO -- 01418000
SPACE 01419000
PCHBLK LA R0,LASTCARD SET UP IRA FOR PUNCHING BLANK CARD 01420000
ST R0,IOBIRA -- 01421000
ST R8,IOBMISC SAVE ADDRESS OF RDEVBLOK 01422000
LA R3,SPSIZE(,R2) ADDRESS OF FIRST CCW 01423000
ST R3,IOBCAW STORE CAW 01424000
MVI 7(R3),X'01' SET COUNT TO ONE 01425000
MVI 0(R3),X'01' PUNCH NO STACKER SELECT 01426000
L R6,8(R3) LOAD ADDRESS IN TIC 01427000
LA R6,0(R6) CLEAR HIGH ORDER BYTE 01428000
MVI 12(R3),C' ' SET UP BLANK CARD 01429000
MVC 0(8,R6),SENSECCW MOVE IN PHONY SENSE 01430000
S R6,F4 POINT TO BACK CHAIN ADDRESS 01431000
MVC 0(4,R6),RSPRSTRT MOVE IN ADDRESS OF LAST CARD PUNCHED 01432000
B SIO AND GO PUNCH BLANK CARD 01433000
SPACE 3 01434000
LASTCARD EQU * HERE ON INTERRUPT AFTER PUNCHING BLANK LAST CARD 01435000
DROP R12,R13 @VA02106 01436000
USING *,R12 TEMPORARY ADDRESSABILITY 01437000
S R12,LASTDSP STANDARD ADDRESSABILITY 01438000
USING DMKRSP,R12,R13 @VA02106 01439000
LR R13,R12 .. 01440000
A R13,F4096 .. 2ND BASE REGISTER 01441000
MVI IOBFLAG,IOBCP ZERO IOBFLAG @VA02975 01442000
L R8,IOBMISC RESTORE ADDRESS OF RDEVBLOK 01443000
SR R7,R7 CLEAR SFBLOK POINTER @VA01299 01444000
ICM R9,B'1111',RDEVSPL RESTORE ADDRESS OF RSPLCTL @VA01299 01445000
BZ MSG430A CTL MISSING - ERROR @VA01299 01446000
L R7,RSPSFBLK RESTORE ADDRES OF SFBLOK 01447000
SPACE 01448000
PRTEOF EQU * @V4075A0 01449100
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01449200
TM RDEVFLAG,RDEVTERM @V4075A0 01449300
BZ TSTCOPY NO -- TEST FOR MORE COPIES 01450000
NI RDEVFLAG,X'FF'-RDEVTERM RESET FLUSH FLAG 01451000
TM SFBFLAG,SFBSHOLD HOLD DUE TO FLUSH COMMAND ?? 01452000
BO PRDELET YES -- 01453000
TSTCOPY LH R1,SFBCOPY GET NUMBER OF COPIES REQUESTED 01454000
TM SFBFLAG2,SFBREQUE REQUEUE THE FILE ?? 01455000
BO PRDELET YES -- 01456000
BCT R1,PREPEAT DECREMENT BY 1 AND TEST FOR REPEAT 01457000
SPACE 01458000
PRDELET CLI RDEVTYPE,TYP3800 IS IT A 3800 PRINTER ? @V60B9BA 01458400
BNE PRDELET2 XFER IF NOT @V60B9BA 01458800
TM SFBFLAG,SFBSHOLD IS FILE TO BE SAVED? @VA09343 01458840
BO SAVEFILE XFER IF SO @VA09343 01458875
TM RDEVFLAG,RDEVSEP SEPARATOR PRINTED? @VA09343 01458910
BZ PRDELET2 XFER IF NOT @VA09343 01458945
LH R2,SFBCOPY SAVE NUMBER OF COPIES @VA09343 01458980
MVC SFBCOPY,=H'1' FORCE IT TO 1 @VA09343 01459015
CALL DMKTCSCO ISSUE THE 'MARK FORMS' CCW @V60B9BA 01459200
STH R2,SFBCOPY RESTORE NUMBER OF COPIES @VA09343 01459300
PRDELET2 TM SFBFLAG,SFBSHOLD IS THE FILE TO BE SAVED ?? 01459600
BO SAVEFILE YES - GO RECHAIN THE FILE 01460000
TM SFBFLAG2,SFBREQUE REQUEUE FILE AND NO HOLD 01461000
BZ DELFILE NO -- 01462000
BAL R5,RECHAIN RECHAIN FILE AND NOHOLD 01463000
NI SFBFLAG2,X'FF'-SFBREQUE RESET REQUEUE FLAG 01464000
B TSTDRAIN TEST FOR DRAIN REQUEST 01465000
DELFILE XC RSPSFBLK(4),RSPSFBLK CLEAR POINTER TO SFBLOK 01466000
CLI RDEVTYPE,TYP3800 IS IT A 3800 PRINTER ? @V60B9BA 01466080
BNE DELFILE2 XFER IF NOT @V60B9BA 01466160
SPACE 01466240
* ADD THIS FILE TO DELAYED PURGE QUEUE AND, IF THE QUEUE 01466320
* HAS REACHED MAXIMUM SIZE, PURGE THE FIRST FILE ON 01466400
* THE QUEUE. 01466480
SPACE 01466560
OI SFBFLAG,SFBSHOLD PUT IN SYS HOLD NOW @V60B9BA 01466640
LA R1,RDEVDELP ADDR OF DELAY PURGE ANCHOR @V60B9BA 01466720
SR R2,R2 COUNTER FOR NUM OF FILES @V60B9BA 01466800
DELPLOOP LR R5,R1 SAVE PREVIOUS POINTER @V60B9BA 01466880
L R1,SFBPNT-SFBLOK(,R1) PTR TO NEXT SFBLOK @V60B9BA 01466960
LTR R1,R1 IS THERE ONE? @V60B9BA 01467040
BZ DELPOUT XFER IF AT END OF QUEUE @V60B9BA 01467120
LA R2,1(,R2) ONE MORE FILE ON THE QUEUE @V60B9BA 01467200
B DELPLOOP TRY AGAIN @V60B9BA 01467280
DELPOUT XC SFBPNT,SFBPNT OUR NEW ONE GOES ON END OF Q@V60B9BA 01467360
ST R7,SFBPNT-SFBLOK(,R5) POINT OLD LAST TO US @V60B9BA 01467440
CLM R2,B'0001',RDEVMAXP HAVE WE REACHED MAXIMUM? @V60B9BA 01467520
BL TSTDRAIN XFER IF NOT @V60B9BA 01467600
L R7,RDEVDELP DELETE FIRST ONE ON QUEUE @V60B9BA 01467680
MVC RDEVDELP,SFBPNT A NEW FIRST ONE @V60B9BA 01467760
DELFILE2 CALL DMKSPLDL CALL FILE DELETER @V60B9BA 01467840
TSTDRAIN TM RDEVFLAG,RDEVDRAN DRAIN REQUESTED? 01468000
BZ PRNXTFIL NO -- GO PROCESS NEXT FILE 01469000
PRTDRAN BAL R6,DRAINMSG TYPE DRAIN MESSAGE @V200930 01470000
B PRTIDLE AND PRINTER IS IDLE 01471000
SPACE 01472000
LASTDSP DC A(LASTCARD-DMKRSP) DISPLACEMENT 01473000
EJECT 01474000
PREPEAT CLI RDEVTYPE,TYP3800 IS IT A 3800 ? @V60B9BA 01474250
BNE PREPEAT2 XFER IF NOT @V60B9BA 01474500
CALL DMKTCSCO DO THE 3800 HOUSEKEEPING @V60B9BA 01474750
BNZ PRDELET2 NOTHING MORE TO DO @V60B9BA 01475000
B *+8 SFBCOPY ALREADY STORED @V60B9BA 01475250
PREPEAT2 STH R1,SFBCOPY SAVE NBR OF COPIES LEFT @V60B9BA 01475500
TM RDEVFLAG,RDEVDRAN IS DEVICE DRAINING ?? @V200930 01476000
BO SAVEFILE YES, STOP AFTER THIS COPY @V200930 01477000
OI SFBFLAG,SFBRECOK INDICATE ALLOCATIONS RECORDS 01478000
LA R2,0 SET FUNCTION INDEX @V200930 01479000
BAL R6,SETMSG FORMAT MESSAGE @V200930 01480000
CALL DMKQCNWT,PARM=OPERATOR+NORET @V200930 01481000
L R2,RSPRPAGE RESTORE ADDRESS OF REAL PAGE @VA11232 01482200
L R0,SPRMISC LOOK FOR NON-ZERO START CCPD @VA11232 01482400
LTR R0,R0 HAS SFBSTART BEEN SAVED THERE @VA11232 01482600
BNZ BEGCCPD USE START CCPD FROM SPRMISC @VA11232 01482800
L R0,SPNXTPAG GET CCPD OF FIRST PAGE @VA11232 01483000
BEGCCPD ST R0,RSPDPAGE STORE START CCPD @VA11232 01483200
ST R0,SFBSTART AND STORE IN SPOOL FILE BLOK 01485000
CALL DMKCKSPL,PARM=CHGSFB CHECKPOINT @V304298 01486000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01487100
OI RDEVFLAG,RDEVRSTR INDICATE FILE RESTART 01488000
NI IOBFLAG,X'FF'-IOBRSTRT RESET RESTART IN IOBLOK @VA09859 01488100
CLI RDEVTYPE,TYP3800 IS IT A 3800 ? @V60B9BA 01488300
BE PROCESS2 AFTER CALL TO DMKTCSET @V60B9BA 01488600
B PROCESS AND REPEAT 01489000
SPACE 3 01490000
SAVEFILE EQU * HERE IF THE OPERATOR WANTS THE FILE SAVED 01491000
L R5,SFBPNT GET STARTING CCPD SAVED DURING OPEN 01492000
ST R5,SFBSTART AND STORE IN SPOOL FILE START 01493000
TM RDEVFLAG,RDEVSEP SEPARATOR PRINTED? @VA09263 01495050
BZ SAVEFIL2 XFER IF NOT @VA09263 01495100
CLI RDEVTYPE,TYP3800 IS IT 3800 ? @VA10003 01495110
BNE SAVEFIL2 NO,CONTINUE AS BEFORE @VA10003 01495120
LH R2,SFBCOPY SAVE NUMBER OF COPIES @VA09263 01495150
MVC SFBCOPY,=H'1' FORCE IT TO 1 @VA09263 01495200
CALL DMKTCSCO DO THE 'MARK FORM' @VA09263 01495250
STH R2,SFBCOPY RESTORE NUMBER OF COPIES @VA09263 01495300
SAVEFIL2 BAL R5,RECHAIN RECHAIN THE FILE @VA09313 01495400
LA R2,30 SET FUNCTION INDEX @VA09313 01496000
BAL R6,SETMSG FORMAT MESSAGE @V200930 01497000
CALL DMKQCNWT,PARM=OPERATOR+NORET @V200930 01498000
B TSTDRAIN 01499000
SPACE 01500000
PRTIDLE EQU * HERE WHEN PRINTER/PUNCH HAS NO MORE WORK TO DO 01501000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01501100
NI RDEVSTAT,X'FF'-RDEVNRDY RESET NOT READY FLAG 01502000
NI RDEVFLAG,RDEVLOAD+RDEVSEP+RDEVDRAN RESET FILE FLAGS 01503000
ICM R9,B'1111',RDEVSPL RSPLCTL PRESENT ? @VA01299 01504000
BZ FRETIOB NO - FRET IOB AND EXIT @VA01299 01505000
XC RDEVSPL,RDEVSPL CLEAR POOINTER TO RSPLCTL @VA13267 01505500
RSP003A L R1,RSPVPAGE POINT TO VIRTUAL BUFFER @V60B9BA 01506000
SR R0,R0 DUMMY DASD ADDRESS FOR RAPGEGET 01507000
CALL DMKRPAGT,AFFINITY,PARM=(SYSTEM) @V4075A0 01508100
CALL DMKPGTVR RELEASE VIRTUAL ADDRESS SPACE 01509000
L R1,RSPVPAG2 SECOND BUFFER ADDRESS @V60B9BA 01509250
LTR R1,R1 IS THERE ONE ? @V60B9BA 01509500
BZ RSP003B XFER IF NOT @V60B9BA 01509750
SR R0,R0 DUMMY DASD ADDRESS @V60B9BA 01510000
CALL DMKRPAGT,AFFINITY,PARM=(SYSTEM) @V60B9BA 01510250
CALL DMKPGTVR RELEASE SYSTEM VIRT ADDRESS @V60B9BA 01510500
RSP003B L R1,RSPRSTRT GET PTR TO RESTART SAVEAREA @V60B9BA 01510750
LTR R1,R1 IS THERE ONE?? 01511000
BZ RSP003 NO -- 01512000
LA R0,12 GET SIZE OF AREA 01513000
CALL DMKFRET AND FRET THE BUFFER 01514000
RSP003 LR R1,R9 POINT TO RSPLCTL WORKAREA 01515000
LA R0,RSPSIZE AND GET ITS SIZE 01516000
CALL DMKFRET FREE IT 01517000
SR R9,R9 CLEAR THE ACTIVE FILE PTR @VA13267 01518000
TM RDEVTYPE,TYPPUN IS IT A PUNCH?? 01520000
BZ FRETIOB NO -- GO FREE THE IOB 01521000
L R4,DMKRSPAC GET POINTER TO CHAIN OF ACNTBLOKS 01522000
LTR R4,R4 ARE THERE ANY TO PUNCH?? 01523000
BZ FRETIOB NO -- 01524000
TM RDEVSTAT,RDEVDISA IS THE DEVICE DISABLED?? 01525000
BO FRETIOB YES -- DON'TRY TO RESTART -- 01526000
SPACE 01527000
LA R4,4 CHECK TO SEE IF THIS PUNCH IS 01528000
LA R14,RDEVCLAS+3 CLASS C FOR PUNCHING ACCOUNTING 01529000
PUNLP CLI 0(R14),C'C' RECORDS ?? 01530000
BE PUACNT YES -- GO START 01531000
BCTR R14,0 STEP TO NEXT CLASS 01532000
BCT R4,PUNLP NO -- CHECK NEXT CLASS 01533000
B FRETIOB NOT CLASS C - LEAVE 01534000
SPACE 01535000
PUACNT OI RDEVFLAG,RDEVACNT FLAG PUNCH AS BUSY WITH ACCOUNTING 01536000
MVI IOBFLAG,IOBCP ZERO IOBFLAG @VA02975 01537000
CALL DMKACOPU,AFFINITY @V4075A0 01538100
NI RDEVFLAG,X'FF'-RDEVACNT RESET BUSY WITH ACCOUNTING 01539000
TM RDEVFLAG,RDEVDRAN DRAIN REQUESTED ?? 01540000
BO PRTDRAN YES -- GO GIVE DRAIN MSG 01541000
L R4,DMKRSPAC GET ADDRESS OF FIRST ACNTBLOK 01542000
LTR R4,R4 ANY ACCOUNTING CARDS TO PUNCH ?? 01543000
BNZ PUACNT YES -- GO PUNCH THEM 01544000
L R14,DMKRSPPU GET PUNCH FILE CHAIN ADDRESS 01545000
LTR R14,R14 ANY PUNCH FILES ?? 01546000
BZ FRETIOB NO -- LEAVE 01547000
B RSPINIT1 GO GET NEXT FILE 01548000
SPACE 3 01549000
UNITEX EQU * HERE TO RESTART ON UNIT EXCEPTION 01550000
L R1,IOBCSW GET ADDRESS OF NEXT CCW 01551000
LA R1,0(R1) CLEAR HIGH ORDER BYTE 01552000
CLI 0(R1),X'08' OP-CODE TIC ?? 01553000
BNE *+8 NO - START WITH THIS CCW 01554000
L R1,0(R1) GET TIC ADDRESS TO NEXT CCW 01555000
LA R1,0(R1) CLEAR HIGH ORDER BYTE 01556000
ST R1,IOBCAW SET IOBLOK 01557000
ST R12,IOBIRA RESTORE RETURN ADDRESS 01558000
B SIO 01559000
SPACE 3 01560000
FRETIOB LR R1,R10 POINT TO IOBLOK 01561000
LA R0,IOBSIZE AND GET ITS SIZE 01562000
CALL DMKFRET FREE IT 01563000
B RSPLEXIT 01574000
EJECT 01575000
* 01576000
* 01577000
* 01578000
* MISCELLANEOUS SUBROUTINES 01579000
* 01580000
SPACE 3 01581000
DRAINMSG EQU * HERE TO WRITE DEVICE DRAINED MESSAGE 01582000
CALL DMKSCNRN GET DEVICE NAME @V200930 01583000
STCM R1,15,DRANMSG SET NAME @V200930 01584000
MVC DRANCLS(4),RDEVCLAS GET CLASSES @V200930 01585000
OC DRANCLS(4),BLANKS EDIT @V200930 01586000
CALL DMKSCNRD GET DEVICE ADDRESS @V200930 01587000
CALL DMKCVTBH CONVERT TO HEX @V200930 01588000
STCM R1,7,DRANADDR SET ADDRESS @V200930 01589000
MVC DRANSEP(3),=C' NO' FLAG NOSEP @V200930 01590000
TM RDEVFLAG,RDEVSEP TEST FOR NOSEP @V200930 01591000
BZ *+10 YES IT IS NOSEP @V200930 01592000
MVC DRANSEP(3),BLANKS FLAG SEP @V200930 01593000
LA R0,DRANMSZR READER MESSAGE SIZE @VA09027 01593300
TM RDEVTYPC,CLASURI IS IT A READER TYPE? @VA09027 01593600
BO GOMSG YES, DON'T RELOAD SIZE @VA09027 01593900
LA R0,DRANMSZ GET LENGTH OF MESSAGE 01594000
GOMSG EQU * @VA09027 01594500
LA R1,DRANMSG AND ITS ADDRESS 01595000
CALL DMKQCNWT,PARM=OPERATOR+NORET 01596000
BR R6 RETURN TO CALLER 01597000
SPACE 3 01598000
DRAINPRT DS 0H @VA09471 01598020
TM RDEVFLAG,RDEVDRAN ALREADY DRAINED ? @VA09471 01598040
BOR R5 YES - 3800 ACT COUNT CORRECT @VA09471 01598060
OI RDEVFLAG,RDEVDRAN SET DEVICE AS DRAINED @VA09471 01598080
CLI RDEVTYPE,TYP3800 IS IT A 3800 ? @VA09471 01598100
BNER R5 NO - RETURN TO CALLER @VA09471 01598120
L R14,RDEVEXTN POINT TO RDEVBLOK EXT @VA09471 01598140
USING RSPXBLOK,R14 @VA09471 01598160
XC RSPXBLOK(RSPXSIZE*8),RSPXBLOK CLEAR BLOCK @VA09471 01598180
DROP R14 @VA09471 01598200
* NOW DECR ACT COUNT FOR IMAGELIB CONTAINED IN RDEVIMAG 01598220
L R1,=A(DMKQNTBL) START OF 3800 IMAGELIBS @VA09471 01598240
LTR R1,R1 ARE THERE ANY ? @VA09471 01598260
BZR R5 NO - GET OUT FAST @VA09471 01598280
TRANS 2,1,OPT=(BRING,DEFER,SYSTEM) GET IT IN @VA09471 01598300
LR R14,R2 POINT TO FIRST SYSTEM ENTRY @VA09471 01598320
USING NPRTBL,R14 @VA09471 01598340
LTR R14,R14 ANY IMAGELIBS ? @VA09471 01598360
BZR R5 NO - GET OUT FAST @VA09471 01598380
NXTIMAG DS 0H @VA09471 01598400
CLC RDEVIMAG,NPRNAME IS THIS CURRENT SYSTEM ? @VA09471 01598420
BE GOTIMAG YES - GO DECR ACT COUNT @VA09471 01598440
AL R14,NPRPNT NEXT SYSTEM @VA09471 01598460
CLC NPRPNT,ZEROES IS IT DUMMY LAST ENTRY ? @VA09471 01598480
BNE NXTIMAG NO GO CHECK IT OUT @VA09471 01598500
BR R5 YES - GET OUT FAST @VA09471 01598520
GOTIMAG DS 0H @VA09471 01598540
SR R15,R15 CLEAR WORK REGISTER @VA09471 01598560
IC R15,NPRCNT GET OLD ACT COUNT @VA09471 01598580
LTR R15,R15 ALREADY ZERO ? @VA09471 01598600
BZR R5 YES - GET OUT FAST @VA09471 01598620
BCTR R15,0 DECR COUNT @VA09471 01598640
STC R15,NPRCNT SAVE NEW COUNT @VA09471 01598660
BR R5 RETURN TO CALLER @VA09471 01598680
DROP R14 @VA09471 01598700
SPACE 3 01598720
SIO CALL DMKIOSQR HERE TO CALL FOR START IO 01599000
SPACE 3 01600000
RSPLEXIT GOTO DMKDSPCH GENERAL EXIT FROM DMKRSP 01601000
SPACE 3 01602000
MSG1 DS 0H @V200930 01603000
MSGDEV DC CL5' ' @V200930 01604000
MSGADR DC CL4' ' @V200930 01605000
MSGCONS DC CL10' ' @V200930 01606000
MSGUSR DC CL8' ' @V200930 01607000
DC C' FILE = ' @V200930 01608000
MSGFILE DC CL4' ' @V200930 01609000
MSGSIZ1 EQU *-MSG1 SIZE FOR READERS @V200930 01610000
DC C' RECDS= ' @V200930 01611000
MSGRECS DC CL6' ' @V200930 01612000
DC C' COPY= ' @V200930 01613000
MSGCNT DC CL2' ' @V200930 01614000
DC CL2' ' @V200930 01615000
MSGCLS DC CL6' ' @V200930 01616000
MSGL EQU *-MSG1 @V200930 01617000
SPACE 01618000
MSGLIST DC CL10'REPEATED ' 0 @V200930 01619000
DC CL10'BACKSPACE ' 10 @V200930 01620000
DC CL10'FLUSHED ' 20 @V200930 01621000
DC CL10'FILE HELD ' 30 @V200930 01622000
DC CL10'PRINTING ' 40 @V200930 01623000
DC CL10'PUNCHING ' 50 @V200930 01624000
DC CL10'READING ' 60 @V200930 01625000
DC CL10'OUTPUT OF ' 70 @V200930 01626000
DC CL10'INPUT FOR ' 80 @V200930 01627000
DS 0H 01628000
SPACE 2 01629000
DRANMSG DC CL5' ' @V200930 01630000
DRANADDR DC CL3' ' @V200930 01631000
DC CL11' DRAINED ' @V200930 01632000
DRANUSR DC CL8'SYSTEM ' @V200930 01633000
DRANMSZR EQU *-DRANMSG @VA09027 01633500
DC CL9' CLASS = ' @V200930 01634000
DRANCLS DC CL4' ' @V200930 01635000
DRANSEP DC CL6' NOSEP' @V200930 01636000
DRANMSZ EQU *-DRANMSG @V200930 01637000
DS 0H 01638000
LTORG 01639000
EJECT 01640000
* 01641000
* SPOOLING AND ACCOUNTING FILE ANCHORS 01642000
* 01643000
SPACE 3 01644000
DS 0F 01645000
DC CL4'PRT' 01646000
DMKRSPPR DC A(0) START OF PRINTER FILE CHAIN 01647000
DC CL4'PUN' 01648000
DMKRSPPU DC A(0) START OF PUNCH FILE CHAIN 01649000
DC CL4'RDR' 01650000
DMKRSPRD DC A(0) START OF READER FILE CHAIN 01651000
DC CL4'DEL' 01652000
DMKRSPDL DC A(0) START OF DELETE FILE CHAIN 01653000
DC CL4'ACNT' 01654000
DMKRSPAC DC A(0) START OF ACCOUNT FILE CHAIN 01655000
DC CL4'DUMP' @V67CAH7 01655200
DMKRSPDP DC A(0) ANCHOR OF DUMP IN @V67CAH7 01655400
* PROGRESS CHAIN 01655600
DC CL4'HOLD' 01656000
DMKRSPHQ DC A(0) START OF SPOOL HOLD QUEUE 01657000
DC CL4'ID' 01658000
DMKRSPID DC X'0001' SYSTEM SPOOL ID COUNTER 01659000
DC X'FFFF' 01660000
* 01661000
* THE FOLLOWING POINTERS USED BY DMKCKP 01662000
* 01663000
DC V(DMKOPRWT) ADDRESS OF CONSOLE WRITE ROUTINE @V200820 01664000
DC V(DMKSYSOW) ADDRESS OF SYSTEM OWNLIST 01665000
DC V(DMKSYSOC) POINTER TO NUMBER OF ENTRIES 01666000
DC V(DMKSYSTP) POINTER TO SYSRES DEVICE TYPE 01667000
DC V(DMKSYSWM) POINTER TO WARMSTART CYLINDER 01668000
DC V(DMKTMRPT) POINTER TO VMVTIME CONVERT ROUTINE 01669000
DMKRSPCV DC 2F'0' TIME OF DAY CLOCK VALUE 01670000
DC V(DMKSYSRM) ADDRESS OF REAL STORAGE SIZE @VA02884 01671000
DMKRSPMN DC F'0' ACTIVE MONITOR SFBLOK ADDRESS @V50A2B5 01671100
SPACE 01672000
* 01673000
* THE ORDER OF THE ABOVE POINTERS MUST NOT CHANGE. 01674000
* 01675000
EJECT 01676000
DS 0H 01677000
******************************************* 01678000
*. 01679000
* 01680000
* DMKRSPER CALLED BY DMKIOS WHEN AN ERROR IS DETECTED BY THE 01681000
* LAST IO OPERATION. THIS ROUTINE WILL HANDLE ONLY 01682000
* SPOOL OUTPUT DEVICES WITH CHANNEL 9 PUNCH 01683000
* ALL OTHER ERRORS WILL BE HANDLED BY DMKRSERR. DMKRSERR 01684000
* WILL BE CALLED BY THIS ROUTINE, BUT DMKRSERR 01685000
* WILL RETURN DIRECTLY TO DMKIOS 01686000
* 01687000
*. 01688000
******************************************* 01689000
SPACE 01690000
USING SAVEAREA,R13 01691000
USING RDEVBLOK,R8 01692000
USING IOERBLOK,R9 01693000
SPACE 01694000
DMKRSPER EQU * 01695000
ENTRY DMKRSPER 01696000
USING *,R12 01697000
SWITCH MAKE SURE WE ARE ON THE IO PROCESSOR @V4075A0 01697100
STM R0,R11,SAVEREGS SAVE REGS R0 THRU R11 01698000
ICM R9,B'1111',RDEVIOER PROCESSING IOERBLOK ? 01699000
BZ UNSOL NO - CHECK FOR UNSOLICITED @VA00701 01700000
* INTERRUPT 01701000
TM IOERFLG1,IOERERP DMKSPLER IN CONTROL OF IOERBLOK 01702000
BZ CALLSPL NO -- GIVE HIM CONTROL 01703000
TM IOERFLG1,IOERDEPD DEVICE END PENDING ?? @VA00701 01704000
BZ SVC16 NO -- LEAVE - UNWANTED INTERRUPT @VA00701 01705000
OI IOERFLG1,IOERDERD INDICATE DEVICE END RECEIVED @VA00701 01706000
ICM R1,B'1111',IOBIOER ADDRESS OF NEW IOERBLOK @VA00701 01707000
BZ SVC16 BRANCH IF NONE @VA00701 01708000
BAL R5,CKIOER FRET IOERBLOK @VA01254 01709000
SVC16 SVC 16 RETURN SAVE AREA 01710000
GOTO DMKDSPCH LEAVE - UNWANTED INTERRUPT 01711000
UNSOL EQU * HERE TO CHECK FOR UNSOLICITED @VA00701 01712000
* INTERRUPT 01713000
TM IOBSPEC,IOBUNSL UNSOLICITED INTERUPT ?? @VA04976 01714100
BZ TESTIOB NO, HANDLE SOLICITED @VA04976 01714200
MVC RDEVIOER(4),IOBIOER MOVE IOERBLOK POINTER @VA01299 01716000
XC IOBIOER,IOBIOER CLEAR IOERBLOK ADDRESS IN IOBLOK@VA07121 01717500
MVC IOBCSW+4(2),=X'0400' FORCE DEVICE ALONE @VA00701 01718000
B NOCMD TO IOS TO RECORD ERROR AND @VA00701 01719000
* UNSTACK IOBLOK 01720000
SPACE 01721000
TESTIOB ICM R9,B'1111',IOBIOER IOERBLOK PRESENT IN IOBLOK ? 01722000
BZ SPLER NO -- GO TO DMKSPLER 01723000
TM IOERFLG1,IOERDERD DEVICE END RECEIVED FOR THIS BLOK ? 01724000
BO SVC16 YES -- FORGET INTERRUPT 01725000
TM IOERFLG1,IOERERP DMKSPLER IN CONTROL ? @VA01299 01726000
BO SVC16 YES - FORGET INTERRUPT @VA01299 01727000
TM IOERDATA,1 IS IT CHANNEL 9 PUNCH (PRINTER) 01728000
BZ CALLSPL NO -- 01729000
TM RDEVTYPC,CLASURO UNIT RECORD OUTPUT ?? 01730000
BZ CALLSPL NO - CALL DMKSPLER 01731000
TM RDEVTYPE,TYPPUN IS IT PUNCH TYPE ?? 01732000
BO CALLSPL YES - 01733000
CLC RDEVTYPC(2),=AL1(CLASURO,TYP3203) 3203? @VA10868 01733050
BNE NOT3203 NO, DON'T CARE @VA10868 01733100
TM IOERDATA,X'FE' CHANNEL 9 ALONE ? @VA10868 01733150
BZ NOT3203 YES, DON'T UPDATE CSW @VA10868 01733200
L R15,IOERCSW GET FAILING CCW ADDR @VA10868 01733250
CLI 0(R15),X'08' IS NEXT CCW A TIC ? @VA10868 01733300
BNE SAVECSW NO, GO BUMP CSW @VA10868 01733350
L R15,0(R15) GET CORRECT CCW ADDR @VA10868 01733400
SAVECSW LA R15,8(R15) ADJUST CSW FOR RSE @VA10868 01733450
STCM R15,7,IOERCSW+1 SAVE UPDATED CSW @VA10868 01733500
B CALLSPL AND CALL DMKRSERR @VA10868 01733550
NOT3203 DS 0H @VA10868 01733600
TM IOBCSW+4,UC+DE UNIT CHECK AND DEVICE END 01734000
BNO CALLSPL NO -- 01735000
TM IOBSTAT,IOBCC1 CONDITION CODE 1 01736000
BZ IGNORE NO -- GET NEXT CCW 01737000
CALLSPL OI IOERFLG1,IOERERP INDICATE DMKRSERR IN CONTROL 01738000
SPLER CALL DMKRSERR CALL U/R ERROR ROUTINE 01739000
* NO RETURN FROM DMKSPLER. DMKSPLER WILL EXIT TO 01740000
* DMKIOS VIA THE SVC 16 01741000
SPACE 01742000
IGNORE EQU * HERE TO IGNORE THE ERROR 01743000
L R1,IOBCSW POINT TO TIC 01744000
LA R1,0(R1) CLEAR HIGH BYTE 01745000
CLI 0(R1),X'08' IS IT A TIC ?? 01746000
BNE *+8 NO - USE THIS CCW 01747000
L R1,0(,R1) GET TRANSFER ADDRESS 01748000
LA R1,0(R1) CLEAR HIGH ORDER BYTE 01749000
ST R1,IOBRCAW STORE RESTART CAW 01750000
LR R1,R9 SET TO FRET IOBERBLOK 01751000
BAL R5,CKIOER FRET IOERBLOK @VA01254 01752000
OI IOBFLAG,IOBRSTRT SET RESTART FLAG @VA01254 01753000
CLC =C'SEP ',IOBMISC2 PRINTING SEPARATOR PAGE 01754000
BE NOCMD YES -- DO NOT FLUSH OR BACKSPACE 01755000
TM RDEVFLAG,RDEVTERM+RDEVBACK+RDEVRSTR FLUSH OR BACKSPACE 01756000
BZ NOCMD NO --CONT 01757000
NI IOBFLAG,X'FF'-IOBRSTRT RESET RESTART FLAG 01758000
MVC IOBCSW(4),IOBRCAW SET ENDING ADDRESS FOR BACK SPACE 01759000
OI IOBCSW+4,CE FORCE RETURN TO DMKRSP 01760000
NOCMD EQU * 01761000
NI IOBFLAG,X'FF'-IOBERP RESET ERP IN CONTROL FLAG @VA00701 01762000
NI IOBSTAT,X'FF'-IOBFATAL AND RESET FATAL FLAG 01763000
EXIT RETURN TO CALLER (DMKIOS) 01764000
********************************************************************* 01765000
* FRET IOERBLOK AND CHANNEL CHECK RECORD 01766000
******************************************************************** 01767000
SPACE 2 01768000
CKIOER EQU * @VA01254 01769000
TM IOERCSW+5-IOERBLOK(R1),IFCC+CCC+CDC IS CHANNEL @VA01254 01770000
* ERROR INDICATED ? 01771000
BZ CKEND NO, GO FRET IOERBLOK @VA01254 01772000
LR R3,R1 SAVE IOERBLOK POINTER @VA01254 01773000
L R1,IOERCCRA-IOERBLOK(R3) CHANNEL REC ADDR @V508690 01774500
L R0,IOERCCRL-IOERBLOK(R3) CHANNEL REC LENGTH @V508690 01775500
CALL DMKFRET RELEASE STORAGE @VA01254 01778000
LR R1,R3 GET IOERBLOK POINTER @VA01254 01779000
CKEND EQU * @VA01254 01780000
LA R0,IOERSIZE LENGTH OF IOERBLOK @VA01254 01781000
AH R0,IOEREXT-IOERBLOK(R1) ADD SIZE OF EXT BLOK @VA01254 01782000
CALL DMKFRET RELEASE STORAGE @VA01254 01783000
SR R0,R0 CLEAR REGISTER 0 @VA01254 01784000
ST R0,IOBIOER CLEAR IOERBLOK POINTER @VA01254 01785000
BR R5 RETURN TO IN LINE CODE @VA01254 01786000
******************************************************************** 01787000
SPACE 4 01788000
********************************************************************** 01789000
SPACE 2 01790000
DS 0D 01791000
ENTRY DMKRSP83 01792000
DMKRSP83 CCW X'83',*-*,CC+SILI,1 3211 RESET COMMAND 01793000
CCW 4,*-*,SILI+SKIP,1 01794000
SPACE 01795000
LTORG 01796000
EJECT 01797000
COPY SPOOL 01798000
COPY RBLOKS 01799000
COPY VBLOKS 01800000
PSA 01801000
COPY VMBLOK 01802000
COPY SAVE 01803000
COPY ACCOUNT 01804000
COPY EQU 01805000
COPY DEVTYPES 01806000
COPY IOBLOKS 01807000
COPY CONBUF 01808000
COPY UDIRECT 01809000
COPY ALLOC 01810000
COPY IOER 01811000
COPY NPRTBL @VA09471 01811100
END 01812000