ibm:vm370-lib:cp:dmkrsp.assemble_src
Table of Contents
DMKRSP Source
References
- Fixes Applied : 21
- This Source Date : Wednesday, January 10, 1979
- Last Fix ID : [HRC106DK]
Source Listing
- DMKRSP.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkrsp.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator