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